diff --git a/thys/Bicategory/BicategoryOfSpans.thy b/thys/Bicategory/BicategoryOfSpans.thy
--- a/thys/Bicategory/BicategoryOfSpans.thy
+++ b/thys/Bicategory/BicategoryOfSpans.thy
@@ -1,14758 +1,14758 @@
 (*  Title:       BicategoryOfSpans
     Author:      Eugene W. Stark <stark@cs.stonybrook.edu>, 2019
     Maintainer:  Eugene W. Stark <stark@cs.stonybrook.edu>
 *)
 
 section "Bicategories of Spans"
 
 theory BicategoryOfSpans
 imports CanonicalIsos SpanBicategory Category3.ConcreteCategory IsomorphismClass Tabulation
 begin
 
 text \<open>
   In this section, we prove CKS Theorem 4, which characterizes up to equivalence the
   bicategories of spans in a category with pullbacks.
   The characterization consists of three conditions:
   BS1: ``Every 1-cell is isomorphic to a composition \<open>g \<star> f\<^sup>*\<close>, where f and g are maps'';
   BS2: ``For every span of maps \<open>(f, g)\<close> there is a 2-cell \<open>\<rho>\<close> such that \<open>(f, \<rho>, g)\<close>
   is a tabulation''; and
   BS3: ``Any two 2-cells between the same pair of maps are equal and invertible.''
   One direction of the proof, which is the easier direction once it is established that
   BS1 and BS3 are respected by equivalence of bicategories, shows that if a bicategory \<open>B\<close>
   is biequivalent to the bicategory of spans in some category \<open>C\<close> with pullbacks,
   then it satisfies BS1 -- BS3.
   The other direction, which is harder, shows that a bicategory \<open>B\<close> satisfying BS1 -- BS3 is
   biequivalent to the bicategory of spans in a certain category with pullbacks that
   is constructed from the sub-bicategory of maps of \<open>B\<close>.
 \<close>
 
   subsection "Definition"
 
   text \<open>
     We define a \emph{bicategory of spans} to be a bicategory that satisfies the conditions
     \<open>BS1\<close> -- \<open>BS3\<close> stated informally above.
   \<close>
 
   locale bicategory_of_spans =
     bicategory + chosen_right_adjoints +
   assumes BS1: "\<And>r. ide r \<Longrightarrow> \<exists>f g. is_left_adjoint f \<and> is_left_adjoint g \<and> isomorphic r (g \<star> f\<^sup>*)"
   and BS2: "\<And>f g. \<lbrakk> is_left_adjoint f; is_left_adjoint g; src f = src g \<rbrakk>
                       \<Longrightarrow> \<exists>r \<rho>. tabulation V H \<a> \<i> src trg r \<rho> f g"
   and BS3: "\<And>f f' \<mu> \<mu>'. \<lbrakk> is_left_adjoint f; is_left_adjoint f'; \<guillemotleft>\<mu> : f \<Rightarrow> f'\<guillemotright>; \<guillemotleft>\<mu>' : f \<Rightarrow> f'\<guillemotright> \<rbrakk>
                              \<Longrightarrow> iso \<mu> \<and> iso \<mu>' \<and> \<mu> = \<mu>'"
 
   text \<open>
     Using the already-established fact \<open>equivalence_pseudofunctor.reflects_tabulation\<close>
     that tabulations are reflected by equivalence pseudofunctors, it is not difficult to prove
     that the notion `bicategory of spans' respects equivalence of bicategories.
   \<close>
   
   lemma bicategory_of_spans_respects_equivalence:
   assumes "equivalent_bicategories V\<^sub>C H\<^sub>C \<a>\<^sub>C \<i>\<^sub>C src\<^sub>C trg\<^sub>C V\<^sub>D H\<^sub>D \<a>\<^sub>D \<i>\<^sub>D src\<^sub>D trg\<^sub>D"
   and "bicategory_of_spans V\<^sub>C H\<^sub>C \<a>\<^sub>C \<i>\<^sub>C src\<^sub>C trg\<^sub>C"
   shows "bicategory_of_spans V\<^sub>D H\<^sub>D \<a>\<^sub>D \<i>\<^sub>D src\<^sub>D trg\<^sub>D"
   proof -
     interpret C: bicategory_of_spans V\<^sub>C H\<^sub>C \<a>\<^sub>C \<i>\<^sub>C src\<^sub>C trg\<^sub>C
       using assms by simp
     interpret C: chosen_right_adjoints V\<^sub>C H\<^sub>C \<a>\<^sub>C \<i>\<^sub>C src\<^sub>C trg\<^sub>C ..
     interpret D: bicategory V\<^sub>D H\<^sub>D \<a>\<^sub>D \<i>\<^sub>D src\<^sub>D trg\<^sub>D
       using assms equivalent_bicategories_def equivalence_pseudofunctor.axioms(1)
             pseudofunctor.axioms(2)
       by fast
     interpret D: chosen_right_adjoints V\<^sub>D H\<^sub>D \<a>\<^sub>D \<i>\<^sub>D src\<^sub>D trg\<^sub>D ..
     obtain F \<Phi> where F: "equivalence_pseudofunctor
                            V\<^sub>C H\<^sub>C \<a>\<^sub>C \<i>\<^sub>C src\<^sub>C trg\<^sub>C V\<^sub>D H\<^sub>D \<a>\<^sub>D \<i>\<^sub>D src\<^sub>D trg\<^sub>D F \<Phi>"
       using assms equivalent_bicategories_def by blast
     interpret F: equivalence_pseudofunctor
                    V\<^sub>C H\<^sub>C \<a>\<^sub>C \<i>\<^sub>C src\<^sub>C trg\<^sub>C V\<^sub>D H\<^sub>D \<a>\<^sub>D \<i>\<^sub>D src\<^sub>D trg\<^sub>D F \<Phi>
       using F by simp
     interpret G: converse_equivalence_pseudofunctor
                    V\<^sub>C H\<^sub>C \<a>\<^sub>C \<i>\<^sub>C src\<^sub>C trg\<^sub>C V\<^sub>D H\<^sub>D \<a>\<^sub>D \<i>\<^sub>D src\<^sub>D trg\<^sub>D F \<Phi>
       ..
     write V\<^sub>C          (infixr "\<cdot>\<^sub>C" 55)
     write V\<^sub>D          (infixr "\<cdot>\<^sub>D" 55)
     write H\<^sub>C          (infixr "\<star>\<^sub>C" 53)
     write H\<^sub>D          (infixr "\<star>\<^sub>D" 53)
     write \<a>\<^sub>C          ("\<a>\<^sub>C[_, _, _]")
     write \<a>\<^sub>D          ("\<a>\<^sub>D[_, _, _]")
     write C.in_hhom   ("\<guillemotleft>_ : _ \<rightarrow>\<^sub>C _\<guillemotright>")
     write C.in_hom    ("\<guillemotleft>_ : _ \<Rightarrow>\<^sub>C _\<guillemotright>")
     write D.in_hhom   ("\<guillemotleft>_ : _ \<rightarrow>\<^sub>D _\<guillemotright>")
     write D.in_hom    ("\<guillemotleft>_ : _ \<Rightarrow>\<^sub>D _\<guillemotright>")
     write C.isomorphic (infix "\<cong>\<^sub>C" 50)
     write D.isomorphic (infix "\<cong>\<^sub>D" 50)
     write C.some_right_adjoint ("_\<^sup>*\<^sup>C" [1000] 1000)
     write D.some_right_adjoint ("_\<^sup>*\<^sup>D" [1000] 1000)
 
     show "bicategory_of_spans V\<^sub>D H\<^sub>D \<a>\<^sub>D \<i>\<^sub>D src\<^sub>D trg\<^sub>D"
     proof
       show "\<And>r'. D.ide r' \<Longrightarrow>
                  \<exists>f' g'. D.is_left_adjoint f' \<and> D.is_left_adjoint g' \<and> r' \<cong>\<^sub>D g' \<star>\<^sub>D (f')\<^sup>*\<^sup>D"
       proof -
         fix r'
         assume r': "D.ide r'"
         obtain f g where fg: "C.is_left_adjoint f \<and> C.is_left_adjoint g \<and> G.G r' \<cong>\<^sub>C g \<star>\<^sub>C f\<^sup>*\<^sup>C"
           using r' C.BS1 G.G\<^sub>1_props(1) G.G_ide by presburger
         have trg_g: "trg\<^sub>C g = G.G\<^sub>0 (trg\<^sub>D r')"
           using fg r' C.isomorphic_def C.hcomp_simps(2)
           by (metis C.ideD(1) C.isomorphic_implies_hpar(4) C.isomorphic_implies_ide(2)
               C.trg_hcomp D.ideD(1) G.G_props(1) C.in_hhomE)
         have trg_f: "trg\<^sub>C f = G.G\<^sub>0 (src\<^sub>D r')"
           using fg r' C.isomorphic_def C.hcomp_simps(1)
           by (metis C.ideD(1) C.isomorphic_implies_hpar(2-3) C.src_hcomp D.ideD(1) G.G_props(1)
               C.right_adjoint_simps(2) C.in_hhomE)
         interpret e_src: equivalence_in_bicategory V\<^sub>D H\<^sub>D \<a>\<^sub>D \<i>\<^sub>D src\<^sub>D trg\<^sub>D
                            \<open>G.e (src\<^sub>D r')\<close> \<open>G.d (src\<^sub>D r')\<close> \<open>G.\<eta> (src\<^sub>D r')\<close> \<open>G.\<epsilon> (src\<^sub>D r')\<close>
           using r' G.G\<^sub>0_props [of "src\<^sub>D r'"] by simp
         interpret e_trg: equivalence_in_bicategory V\<^sub>D H\<^sub>D \<a>\<^sub>D \<i>\<^sub>D src\<^sub>D trg\<^sub>D
                            \<open>G.e (trg\<^sub>D r')\<close> \<open>G.d (trg\<^sub>D r')\<close> \<open>G.\<eta> (trg\<^sub>D r')\<close> \<open>G.\<epsilon> (trg\<^sub>D r')\<close>
           using r' G.G\<^sub>0_props [of "trg\<^sub>D r'"] by simp
         interpret e: two_equivalences_in_bicategory V\<^sub>D H\<^sub>D \<a>\<^sub>D \<i>\<^sub>D src\<^sub>D trg\<^sub>D
                            \<open>G.e (src\<^sub>D r')\<close> \<open>G.d (src\<^sub>D r')\<close> \<open>G.\<eta> (src\<^sub>D r')\<close> \<open>G.\<epsilon> (src\<^sub>D r')\<close>
                            \<open>G.e (trg\<^sub>D r')\<close> \<open>G.d (trg\<^sub>D r')\<close> \<open>G.\<eta> (trg\<^sub>D r')\<close> \<open>G.\<epsilon> (trg\<^sub>D r')\<close>
           ..
         interpret hom: subcategory V\<^sub>D
                          \<open>\<lambda>\<mu>. \<guillemotleft>\<mu> : src\<^sub>D (G.e (src\<^sub>D r')) \<rightarrow>\<^sub>D src\<^sub>D (G.e (trg\<^sub>D r'))\<guillemotright>\<close>
           using D.hhom_is_subcategory by simp
         interpret hom': subcategory V\<^sub>D
                           \<open>\<lambda>\<mu>. \<guillemotleft>\<mu> : trg\<^sub>D (G.e (src\<^sub>D r')) \<rightarrow>\<^sub>D trg\<^sub>D (G.e (trg\<^sub>D r'))\<guillemotright>\<close>
           using D.hhom_is_subcategory by simp
         interpret e: equivalence_of_categories hom'.comp hom.comp e.F e.G e.\<phi> e.\<psi>
           using e.induces_equivalence_of_hom_categories by simp
 
         define g'
         where "g' = G.d (trg\<^sub>D r') \<star>\<^sub>D F g"
         have g': "D.is_left_adjoint g'"
         proof -
           have "D.equivalence_map (G.d (trg\<^sub>D r'))"
             using D.equivalence_map_def e_trg.dual_equivalence by blast
           hence "D.is_left_adjoint (G.d (trg\<^sub>D r'))"
             using r' D.equivalence_is_adjoint by simp
           moreover have "src\<^sub>D (G.d (trg\<^sub>D r')) = trg\<^sub>D (F g)"
             using fg r' G.G\<^sub>0_props trg_g
             by (simp add: C.left_adjoint_is_ide)
           ultimately show ?thesis
             unfolding g'_def
             using fg r' D.left_adjoints_compose F.preserves_left_adjoint by blast
         qed
         have 1: "D.is_right_adjoint (F f\<^sup>*\<^sup>C \<star>\<^sub>D G.e (src\<^sub>D r'))"
         proof -
           have "D.equivalence_map (G.e (src\<^sub>D r'))"
             using D.equivalence_map_def e_src.equivalence_in_bicategory_axioms by blast
           hence "D.is_right_adjoint (G.e (src\<^sub>D r'))"
             using r' D.equivalence_is_adjoint by simp
           moreover have "D.is_right_adjoint (F f\<^sup>*\<^sup>C)"
             using fg C.left_adjoint_extends_to_adjoint_pair F.preserves_adjoint_pair by blast
           moreover have "src\<^sub>D (F f\<^sup>*\<^sup>C) = trg\<^sub>D (G.e (src\<^sub>D r'))"
             using fg r' G.G\<^sub>0_props trg_f
             by (simp add: C.right_adjoint_is_ide)
           ultimately show ?thesis
             using fg r' D.right_adjoints_compose F.preserves_right_adjoint by blast
         qed
         obtain f' where f': "D.adjoint_pair f' (F f\<^sup>*\<^sup>C \<star>\<^sub>D G.e (src\<^sub>D r'))"
           using 1 by auto
         have f': "D.is_left_adjoint f' \<and> F f\<^sup>*\<^sup>C \<star>\<^sub>D G.e (src\<^sub>D r') \<cong>\<^sub>D (f')\<^sup>*\<^sup>D"
           using f' D.left_adjoint_determines_right_up_to_iso D.left_adjoint_extends_to_adjoint_pair
           by blast
 
         have "r' \<cong>\<^sub>D G.d (trg\<^sub>D r') \<star>\<^sub>D (G.e (trg\<^sub>D r') \<star>\<^sub>D r' \<star>\<^sub>D G.d (src\<^sub>D r')) \<star>\<^sub>D G.e (src\<^sub>D r')"
           using r' e.\<eta>.components_are_iso e.\<phi>_in_hom [of r'] D.isomorphic_def
                 hom.ide_char hom.arr_char hom.iso_char
           by auto
         also have 1: "... \<cong>\<^sub>D (G.d (trg\<^sub>D r') \<star>\<^sub>D F (G.G r') \<star>\<^sub>D G.e (src\<^sub>D r'))"
         proof -
           have "G.e (trg\<^sub>D r') \<star>\<^sub>D r' \<star>\<^sub>D G.d (src\<^sub>D r') \<cong>\<^sub>D F (G.G r')"
             by (simp add: D.isomorphic_symmetric G.G\<^sub>1_props(3) G.G_ide r')
           thus ?thesis
             using r' D.hcomp_isomorphic_ide D.hcomp_ide_isomorphic by simp
         qed
         also have 2: "... \<cong>\<^sub>D G.d (trg\<^sub>D r') \<star>\<^sub>D (F g \<star>\<^sub>D F f\<^sup>*\<^sup>C) \<star>\<^sub>D G.e (src\<^sub>D r')"
         proof -
           have "F (G.G r') \<cong>\<^sub>D F (g \<star>\<^sub>C f\<^sup>*\<^sup>C)"
             using fg F.preserves_iso C.isomorphic_def D.isomorphic_def by auto
           also have "F (g \<star>\<^sub>C f\<^sup>*\<^sup>C) \<cong>\<^sub>D F g \<star>\<^sub>D F f\<^sup>*\<^sup>C"
             using fg
             by (meson C.adjoint_pair_antipar(1) C.hseqE C.ideD(1) C.isomorphic_implies_hpar(2)
                 C.right_adjoint_simps(1) D.isomorphic_symmetric F.weakly_preserves_hcomp)
           finally have "D.isomorphic (F (G.G r')) (F g \<star>\<^sub>D F f\<^sup>*\<^sup>C)"
             by simp
           moreover have "\<And>f g. D.ide (H\<^sub>D f g) \<Longrightarrow> src\<^sub>D f = trg\<^sub>D g"
             by (metis (no_types) D.hseqE D.ideD(1))
           ultimately show ?thesis
               by (meson 1 D.hcomp_ide_isomorphic D.hcomp_isomorphic_ide D.hseqE D.ideD(1)
                   D.isomorphic_implies_hpar(2)
                   e_src.ide_left e_trg.ide_right)
         qed
         also have 3: "... \<cong>\<^sub>D (G.d (trg\<^sub>D r') \<star>\<^sub>D F g) \<star>\<^sub>D F f\<^sup>*\<^sup>C \<star>\<^sub>D G.e (src\<^sub>D r')"
         proof -
           let ?a = "\<a>\<^sub>D\<^sup>-\<^sup>1[G.d (trg\<^sub>D r'), F g, F f\<^sup>*\<^sup>C \<star>\<^sub>D G.e (src\<^sub>D r')] \<cdot>\<^sub>D
                      (G.d (trg\<^sub>D r') \<star>\<^sub>D \<a>\<^sub>D[F g, F f\<^sup>*\<^sup>C, G.e (src\<^sub>D r')])"
           have "\<guillemotleft>?a : G.d (trg\<^sub>D r') \<star>\<^sub>D (F g \<star>\<^sub>D F f\<^sup>*\<^sup>C) \<star>\<^sub>D G.e (src\<^sub>D r')
                          \<Rightarrow>\<^sub>D (G.d (trg\<^sub>D r') \<star>\<^sub>D F g) \<star>\<^sub>D F f\<^sup>*\<^sup>C \<star>\<^sub>D G.e (src\<^sub>D r')\<guillemotright>"
           proof (intro D.comp_in_homI)
             show "\<guillemotleft>G.d (trg\<^sub>D r') \<star>\<^sub>D \<a>\<^sub>D[F g, F f\<^sup>*\<^sup>C, G.e (src\<^sub>D r')] :
                      G.d (trg\<^sub>D r') \<star>\<^sub>D (F g \<star>\<^sub>D F f\<^sup>*\<^sup>C) \<star>\<^sub>D G.e (src\<^sub>D r')
                        \<Rightarrow>\<^sub>D G.d (trg\<^sub>D r') \<star>\<^sub>D F g \<star>\<^sub>D F f\<^sup>*\<^sup>C \<star>\<^sub>D G.e (src\<^sub>D r')\<guillemotright>"
               using fg r' 2 C.left_adjoint_is_ide D.hseqE D.ideD(1) D.isomorphic_implies_ide(2)
                     D.src_hcomp D.assoc_in_hom [of "F g" "F f\<^sup>*\<^sup>C" "G.e (src\<^sub>D r')"]
               apply auto
               by (metis C.hseqE C.ideD(1) C.isomorphic_implies_hpar(2) C.right_adjoint_simps(3)
                   D.hcomp_in_vhom D.ideD(1) D.ide_in_hom(2) e_trg.ide_right trg_f)
             show "\<guillemotleft>\<a>\<^sub>D\<^sup>-\<^sup>1[G.d (trg\<^sub>D r'), F g, F f\<^sup>*\<^sup>C \<star>\<^sub>D G.e (src\<^sub>D r')] :
                      G.d (trg\<^sub>D r') \<star>\<^sub>D F g \<star>\<^sub>D F f\<^sup>*\<^sup>C \<star>\<^sub>D G.e (src\<^sub>D r')
                         \<Rightarrow>\<^sub>D (G.d (trg\<^sub>D r') \<star>\<^sub>D F g) \<star>\<^sub>D F f\<^sup>*\<^sup>C \<star>\<^sub>D G.e (src\<^sub>D r')\<guillemotright>"
             proof -
               have "D.ide (F f\<^sup>*\<^sup>C \<star>\<^sub>D G.e (src\<^sub>D r'))"
                 using f' D.isomorphic_implies_ide by auto
               moreover have "src\<^sub>D (F g) = trg\<^sub>D (F f\<^sup>*\<^sup>C \<star>\<^sub>D G.e (src\<^sub>D r'))"
                 using fg r' f' 2 D.hseqE D.ideD(1) D.isomorphic_implies_ide D.trg_hcomp
                 by metis
               ultimately show ?thesis
                 using fg r' trg_g C.left_adjoint_is_ide D.assoc'_in_hom(2) by simp
             qed
           qed
           moreover have "D.iso ?a"
             using fg r' D.isos_compose
             by (metis 2 C.left_adjoint_is_ide C.right_adjoint_simps(1) D.arrI D.assoc_simps(3)
                 D.iso_hcomp D.hseqE D.ideD(1) D.ide_is_iso D.iso_assoc D.iso_assoc'
                 D.isomorphic_implies_ide(1) D.isomorphic_implies_ide(2) D.trg_hcomp
                 F.preserves_ide calculation e_src.ide_left e_trg.ide_right f')
           ultimately show ?thesis
             using D.isomorphic_def by auto
         qed
         also have "(G.d (trg\<^sub>D r') \<star>\<^sub>D F g) \<star>\<^sub>D F f\<^sup>*\<^sup>C \<star>\<^sub>D G.e (src\<^sub>D r') \<cong>\<^sub>D g' \<star>\<^sub>D f'\<^sup>*\<^sup>D"
           using g'_def f'
           by (metis 3 D.adjoint_pair_antipar(1) D.hcomp_ide_isomorphic D.hseq_char D.ideD(1)
               D.isomorphic_implies_ide(2) g')
         finally have "D.isomorphic r' (g' \<star>\<^sub>D f'\<^sup>*\<^sup>D)"
           by simp
         thus "\<exists>f' g'. D.is_left_adjoint f' \<and> D.is_left_adjoint g' \<and> r' \<cong>\<^sub>D g' \<star>\<^sub>D f'\<^sup>*\<^sup>D"
           using f' g' by auto
       qed
       show "\<And>f f' \<mu> \<mu>'. \<lbrakk> D.is_left_adjoint f; D.is_left_adjoint f';
                            \<guillemotleft>\<mu> : f \<Rightarrow>\<^sub>D f'\<guillemotright>; \<guillemotleft>\<mu>' : f \<Rightarrow>\<^sub>D f'\<guillemotright> \<rbrakk> \<Longrightarrow> D.iso \<mu> \<and> D.iso \<mu>' \<and> \<mu> = \<mu>'"
       proof -
         fix f f' \<mu> \<mu>'
         assume f: "D.is_left_adjoint f"
         and f': "D.is_left_adjoint f'"
         and \<mu>: "\<guillemotleft>\<mu> : f \<Rightarrow>\<^sub>D f'\<guillemotright>"
         and \<mu>': "\<guillemotleft>\<mu>' : f \<Rightarrow>\<^sub>D f'\<guillemotright>"
         have "C.is_left_adjoint (G.G f) \<and> C.is_left_adjoint (G.G f')"
           using f f' G.preserves_left_adjoint by simp
         moreover have "\<guillemotleft>G.G \<mu> : G.G f \<Rightarrow>\<^sub>C G.G f'\<guillemotright> \<and> \<guillemotleft>G.G \<mu>' : G.G f \<Rightarrow>\<^sub>C G.G f'\<guillemotright>"
           using \<mu> \<mu>' G.preserves_hom by simp
         ultimately have "C.iso (G.G \<mu>) \<and> C.iso (G.G \<mu>') \<and> G.G \<mu> = G.G \<mu>'"
           using C.BS3 by blast
         thus "D.iso \<mu> \<and> D.iso \<mu>' \<and> \<mu> = \<mu>'"
           using \<mu> \<mu>' G.reflects_iso G.is_faithful by blast
       qed
       show "\<And>f g. \<lbrakk> D.is_left_adjoint f; D.is_left_adjoint g; src\<^sub>D f = src\<^sub>D g \<rbrakk>
                      \<Longrightarrow> \<exists>r \<rho>. tabulation V\<^sub>D H\<^sub>D \<a>\<^sub>D \<i>\<^sub>D src\<^sub>D trg\<^sub>D r \<rho> f g"
       proof -
         fix f g
         assume f: "D.is_left_adjoint f"
         assume g: "D.is_left_adjoint g"
         assume fg: "src\<^sub>D f = src\<^sub>D g"
         have "C.is_left_adjoint (G.G f)"
           using f G.preserves_left_adjoint by blast
         moreover have "C.is_left_adjoint (G.G g)"
           using g G.preserves_left_adjoint by blast
         moreover have "src\<^sub>C (G.G f) = src\<^sub>C (G.G g)"
           using f g D.left_adjoint_is_ide fg by simp
         ultimately have 1: "\<exists>r \<rho>. tabulation V\<^sub>C H\<^sub>C \<a>\<^sub>C \<i>\<^sub>C src\<^sub>C trg\<^sub>C r \<rho> (G.G f) (G.G g)"
           using C.BS2 by simp
         obtain r \<rho> where \<rho>: "tabulation V\<^sub>C H\<^sub>C \<a>\<^sub>C \<i>\<^sub>C src\<^sub>C trg\<^sub>C r \<rho> (G.G f) (G.G g)"
           using 1 by auto
         interpret \<rho>: tabulation V\<^sub>C H\<^sub>C \<a>\<^sub>C \<i>\<^sub>C src\<^sub>C trg\<^sub>C r \<rho> \<open>G.G f\<close> \<open>G.G g\<close>
           using \<rho> by simp
         obtain r' where
           r': "D.ide r' \<and> D.in_hhom r' (trg\<^sub>D f) (trg\<^sub>D g) \<and> C.isomorphic (G.G r') r"
           using f g \<rho>.ide_base \<rho>.tab_in_hom G.locally_essentially_surjective
           by (metis D.obj_trg G.preserves_reflects_arr G.preserves_trg \<rho>.leg0_simps(2-3)
               \<rho>.leg1_simps(2,4) \<rho>.base_in_hom(1))
         obtain \<phi> where \<phi>: "\<guillemotleft>\<phi> : r \<Rightarrow>\<^sub>C G.G r'\<guillemotright> \<and> C.iso \<phi>"
           using r' C.isomorphic_symmetric by blast
         have \<sigma>: "tabulation V\<^sub>C H\<^sub>C \<a>\<^sub>C \<i>\<^sub>C src\<^sub>C trg\<^sub>C
                    (G.G r') (V\<^sub>C (H\<^sub>C \<phi> (G.G f)) \<rho>) (G.G f) (G.G g)"
           using \<phi> \<rho>.is_preserved_by_base_iso by simp
         have 1: "\<exists>\<rho>'. \<guillemotleft>\<rho>' : g \<Rightarrow>\<^sub>D H\<^sub>D r' f\<guillemotright> \<and>
                       G.G \<rho>' = V\<^sub>C (G.\<Phi> (r', f)) (V\<^sub>C (H\<^sub>C \<phi> (G.G f)) \<rho>)"
         proof -
           have "D.ide g"
             by (simp add: D.left_adjoint_is_ide g)
           moreover have "D.ide (H\<^sub>D r' f)"
             using f r' D.left_adjoint_is_ide by auto
           moreover have "src\<^sub>D g = src\<^sub>D (H\<^sub>D r' f)"
             using fg by (simp add: calculation(2))
           moreover have "trg\<^sub>D g = trg\<^sub>D (H\<^sub>D r' f)"
             using calculation(2) r' by auto
           moreover have
             "\<guillemotleft>V\<^sub>C (G.\<Phi> (r', f)) (V\<^sub>C (H\<^sub>C \<phi> (G.G f)) \<rho>) : G.G g \<Rightarrow>\<^sub>C G.G (H\<^sub>D r' f)\<guillemotright>"
             using f g r' \<phi> G.\<Phi>_in_hom [of r' f] D.left_adjoint_is_ide \<rho>.ide_base
             by (intro C.comp_in_homI, auto)
           ultimately show ?thesis
             using G.locally_full by simp
         qed
         obtain \<rho>' where \<rho>': "\<guillemotleft>\<rho>' : g \<Rightarrow>\<^sub>D H\<^sub>D r' f\<guillemotright> \<and>
                              G.G \<rho>' = V\<^sub>C (G.\<Phi> (r', f)) (V\<^sub>C (H\<^sub>C \<phi> (G.G f)) \<rho>)"
           using 1 by auto
         have "tabulation V\<^sub>D H\<^sub>D \<a>\<^sub>D \<i>\<^sub>D src\<^sub>D trg\<^sub>D r' \<rho>' f g"
         proof -
           have "V\<^sub>C (C.inv (G.\<Phi> (r', f))) (G.G \<rho>') = V\<^sub>C (H\<^sub>C \<phi> (G.G f)) \<rho>"
             using r' f \<rho>' C.comp_assoc C.comp_cod_arr G.\<Phi>_components_are_iso
                   C.invert_side_of_triangle(1)
                     [of "G.G \<rho>'" "G.\<Phi> (r', f)" "V\<^sub>C (H\<^sub>C \<phi> (G.G f)) \<rho>"]
             by (metis (no_types, lifting) D.arrI D.in_hhom_def D.left_adjoint_is_ide G.preserves_arr)
           thus ?thesis
             using \<sigma> \<rho>' G.reflects_tabulation
             by (simp add: D.left_adjoint_is_ide f r')
         qed
         thus "\<exists>r' \<rho>'. tabulation V\<^sub>D H\<^sub>D \<a>\<^sub>D \<i>\<^sub>D src\<^sub>D trg\<^sub>D r' \<rho>' f g"
           by auto
       qed
     qed
   qed
 
   subsection "Span(C) is a Bicategory of Spans"
 
   text \<open>
     We first consider an arbitrary 1-cell \<open>r\<close> in \<open>Span(C)\<close>, and show that it has a tabulation
     as a span of maps.  This is CKS Proposition 3 (stated more strongly to assert that
     the ``output leg'' can also be taken to be a map, which the proof shows already).
   \<close>
 
   locale identity_arrow_in_span_bicategory =
     span_bicategory C prj0 prj1 +
     r: identity_arrow_of_spans C r
     for C :: "'a comp"   (infixr "\<cdot>" 55)
     and prj0 :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"  ("\<p>\<^sub>0[_, _]")
     and prj1 :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"  ("\<p>\<^sub>1[_, _]")
     and r :: "'a arrow_of_spans_data"
   begin
     text \<open>
       CKS say: ``Suppose \<open>r = (r\<^sub>0, R, r\<^sub>1): A \<rightarrow> B\<close> and put \<open>f = (1, R, r\<^sub>0)\<close>, \<open>g = (1, R, r\<^sub>1)\<close>.
       Let \<open>k\<^sub>0, k\<^sub>1\<close> form a kernel pair for \<open>r\<^sub>0\<close> and define \<open>\<rho>\<close> by \<open>k\<^sub>0\<rho> = k\<^sub>1\<rho> = 1\<^sub>R\<close>.''
     \<close>
     abbreviation ra where "ra \<equiv> r.dom.apex"
     abbreviation r0 where "r0 \<equiv> r.dom.leg0"
     abbreviation r1 where "r1 \<equiv> r.dom.leg1"
     abbreviation f where "f \<equiv> mkIde ra r0"
     abbreviation g where "g \<equiv> mkIde ra r1"
     abbreviation k0 where "k0 \<equiv> \<p>\<^sub>0[r0, r0]"
     abbreviation k1 where "k1 \<equiv> \<p>\<^sub>1[r0, r0]"
     text \<open>
       Here \<open>ra\<close> is the apex \<open>R\<close> of the span \<open>(r\<^sub>0, R, r\<^sub>1)\<close>, and the spans \<open>f\<close> and \<open>g\<close> also have
       that same 0-cell as their apex.  The tabulation 2-cell \<open>\<rho>\<close> has to be an arrow of spans
       from \<open>g = (1, R, r\<^sub>1)\<close> to \<open>r \<star> f\<close>, which is the span \<open>(k\<^sub>0, r\<^sub>1 \<cdot> k\<^sub>1)\<close>.
     \<close>
     abbreviation \<rho> where "\<rho> \<equiv> \<lparr>Chn = \<langle>ra \<lbrakk>r0, r0\<rbrakk> ra\<rangle>,
                                Dom = \<lparr>Leg0 = ra, Leg1 = r1\<rparr>,
                                Cod = \<lparr>Leg0 = k0, Leg1 = r1 \<cdot> k1\<rparr>\<rparr>"
 
     lemma has_tabulation:
     shows "tabulation vcomp hcomp assoc unit src trg r \<rho> f g"
     and "is_left_adjoint f" and "is_left_adjoint g"
     proof -
       have ide_f: "ide f"
         using ide_mkIde r.dom.leg_in_hom(1) C.arr_dom C.dom_dom r.dom.apex_def r.dom.leg_simps(1)
         by presburger
       interpret f: identity_arrow_of_spans C f
         using ide_f ide_char' by auto
       have ide_g: "ide g"
         using ide_mkIde r.dom.leg_in_hom
         by (metis C.arr_dom C.dom_dom r.dom.leg_simps(3) r.dom.leg_simps(4))
       interpret g: identity_arrow_of_spans C g
         using ide_g ide_char' by auto
 
       show "is_left_adjoint f"
         using is_left_adjoint_char [of f] ide_f by simp
       show "is_left_adjoint g"
         using is_left_adjoint_char [of g] ide_g by simp
       
       have ide_r: "ide r"
         using ide_char' r.identity_arrow_of_spans_axioms by auto
       have src_r: "src r = mkObj (C.cod r0)"
         by (simp add: ide_r src_def)
       have trg_r: "trg r = mkObj (C.cod r1)"
         by (simp add: ide_r trg_def)
       have src_f: "src f = mkObj ra"
         using ide_f src_def by auto
       have trg_f: "trg f = mkObj (C.cod r0)"
         using ide_f trg_def by auto
       have src_g: "src g = mkObj ra"
         using ide_g src_def by auto
       have trg_g: "trg g = mkObj (C.cod r1)"
         using ide_g trg_def by auto
 
       have hseq_rf: "hseq r f"
         using ide_r ide_f src_r trg_f by simp
       interpret rf: two_composable_arrows_of_spans C prj0 prj1 r f
         using hseq_rf hseq_char by unfold_locales auto
       interpret rf: two_composable_identity_arrows_of_spans C prj0 prj1 r f ..
       interpret rf: identity_arrow_of_spans C \<open>r \<star> f\<close> 
         using rf.ide_composite ide_char' by auto
       let ?rf = "r \<star> f"
       (* TODO: Put this expansion into two_composable_identity_arrows_of_spans. *)
       have rf: "?rf = \<lparr>Chn = r0 \<down>\<down> r0,
                        Dom = \<lparr>Leg0 = k0, Leg1 = r1 \<cdot> k1\<rparr>,
                        Cod = \<lparr>Leg0 = k0, Leg1 = r1 \<cdot> k1\<rparr>\<rparr>"
         unfolding hcomp_def chine_hcomp_def
         using hseq_rf C.comp_cod_arr by auto
 
       interpret Cod_rf: span_in_category C \<open>\<lparr>Leg0 = k0, Leg1 = r1 \<cdot> k1\<rparr>\<close>
         using ide_r ide_f rf C.comp_cod_arr
         by unfold_locales auto
 
       have Dom_g: "Dom g = \<lparr>Leg0 = ra, Leg1 = r1\<rparr>" by simp
       interpret Dom_g: span_in_category C \<open>\<lparr>Leg0 = ra, Leg1 = r1\<rparr>\<close>
         using Dom_g g.dom.span_in_category_axioms by simp
       interpret Dom_\<rho>: span_in_category C \<open>Dom \<rho>\<close>
         using Dom_g g.dom.span_in_category_axioms by simp
       interpret Cod_\<rho>: span_in_category C \<open>Cod \<rho>\<close>
         using rf Cod_rf.span_in_category_axioms by simp
       interpret \<rho>: arrow_of_spans C \<rho>
         using Dom_\<rho>.apex_def Cod_\<rho>.apex_def C.comp_assoc C.comp_arr_dom
         by unfold_locales auto
       have \<rho>: "\<guillemotleft>\<rho> : g \<Rightarrow> r \<star> f\<guillemotright>"
       proof
         show 1: "arr \<rho>"
           using arr_char \<rho>.arrow_of_spans_axioms by simp
         show "dom \<rho> = g"
           using 1 dom_char ideD(2) ide_g by fastforce
         show "cod \<rho> = r \<star> f"
           using 1 cod_char rf Cod_rf.apex_def by simp
       qed
 
       show "tabulation vcomp hcomp assoc unit src trg r \<rho> f g"
       proof -
         interpret T: tabulation_data vcomp hcomp assoc unit src trg r \<rho> f g
           using ide_f \<rho> by unfold_locales auto
         show ?thesis
         proof
           show T1: "\<And>u \<omega>.
                        \<lbrakk> ide u; \<guillemotleft>\<omega> : dom \<omega> \<Rightarrow> r \<star> u\<guillemotright> \<rbrakk> \<Longrightarrow>
                        \<exists>w \<theta> \<nu>. ide w \<and> \<guillemotleft>\<theta> : f \<star> w \<Rightarrow> u\<guillemotright> \<and> \<guillemotleft>\<nu> : dom \<omega> \<Rightarrow> g \<star> w\<guillemotright> \<and> iso \<nu> \<and>
                                T.composite_cell w \<theta> \<bullet> \<nu> = \<omega>"
           proof -
             fix u \<omega>
             assume u: "ide u"
             assume \<omega>: "\<guillemotleft>\<omega> : dom \<omega> \<Rightarrow> r \<star> u\<guillemotright>"
             show "\<exists>w \<theta> \<nu>. ide w \<and> \<guillemotleft>\<theta> : f \<star> w \<Rightarrow> u\<guillemotright> \<and> \<guillemotleft>\<nu> : dom \<omega> \<Rightarrow> g \<star> w\<guillemotright> \<and> iso \<nu> \<and>
                           T.composite_cell w \<theta> \<bullet> \<nu> = \<omega>"
             proof -
               interpret u: identity_arrow_of_spans C u
                 using u ide_char' by auto
               have v: "ide (dom \<omega>)"
                 using \<omega> by auto
               interpret v: identity_arrow_of_spans C \<open>dom \<omega>\<close>
                 using v ide_char' by auto
               interpret \<omega>: arrow_of_spans C \<omega>
                 using \<omega> arr_char by auto
               have hseq_ru: "hseq r u"
                 using u \<omega> ide_cod by fastforce
               interpret ru: two_composable_arrows_of_spans C prj0 prj1 r u
                 using hseq_ru hseq_char by unfold_locales auto
               interpret ru: two_composable_identity_arrows_of_spans C prj0 prj1 r u ..
               text \<open>
                 CKS say:
                 ``We must show that \<open>(f, \<rho>, g)\<close> is a wide tabulation of \<open>r\<close>.
                 Take \<open>u = (u\<^sub>0, U, u\<^sub>1): X \<rightarrow> A\<close>, \<open>v = (v\<^sub>0, V, v\<^sub>1): X \<rightarrow> B\<close>,
                 \<open>\<omega>: v \<Rightarrow> ru\<close> as in \<open>T1\<close>.  Let \<open>P\<close> be the pullback of \<open>u\<^sub>1, r\<^sub>0\<close>.
                 Let \<open>w = (v\<^sub>0, V, p\<^sub>1\<omega>): X \<rightarrow> R\<close>, \<open>\<theta> = p\<^sub>0\<omega>: fw \<Rightarrow> u\<close>,
                 \<open>\<nu> = 1: v \<Rightarrow> gw\<close>; so \<open>\<omega> = (r\<theta>)(\<rho>w)\<nu>\<close> as required.''
               \<close>
               let ?R = "r.apex"
               let ?A = "C.cod r0"
               let ?B = "C.cod r1"
               let ?U = "u.apex"
               let ?u0 = "u.leg0"
               let ?u1 = "u.leg1"
               let ?X = "C.cod ?u0"
               let ?V = "v.apex"
               let ?v0 = "v.leg0"
               let ?v1 = "v.leg1"
               let ?\<omega> = "\<omega>.chine"
               let ?P = "r0 \<down>\<down> ?u1"
               let ?p0 = "\<p>\<^sub>0[r0, ?u1]"
               let ?p1 = "\<p>\<^sub>1[r0, ?u1]"
               let ?w1 = "?p1 \<cdot> ?\<omega>"
               define w where "w = mkIde ?v0 ?w1"
               let ?Q = "?R \<down>\<down> ?w1"
               let ?q1 = "\<p>\<^sub>1[?R, ?w1]"
               let ?\<rho> = "\<langle>?R \<lbrakk>r0, r0\<rbrakk> ?R\<rangle>"
 
               have P: "?P = ru.apex"
                 using ru.apex_composite by auto
 
               have Chn_\<omega>: "\<guillemotleft>?\<omega> : ?V \<rightarrow>\<^sub>C ?P\<guillemotright>"
                 using P Chn_in_hom \<omega> by force
               have p0\<omega>: "\<guillemotleft>?p0 \<cdot> ?\<omega> : ?V \<rightarrow>\<^sub>C ?U\<guillemotright>"
                 using Chn_\<omega> ru.legs_form_cospan by auto
               have w1: "\<guillemotleft>?w1 : ?V \<rightarrow>\<^sub>C ?R\<guillemotright>"
                  using Chn_\<omega> ru.legs_form_cospan r.dom.apex_def by blast
               have r1w1: "r1 \<cdot> ?w1 = ?v1"
                 by (metis C.comp_assoc T.base_simps(3) \<omega> \<omega>.leg1_commutes
                     arrow_of_spans_data.select_convs(3) cod_char dom_char ideD(1) ideD(2)
                     in_homE ru.composite_in_hom ru.leg1_composite u v)
 
               have w: "ide w"
                 unfolding w_def
                 using P \<omega> w1 by (intro ide_mkIde, auto) 
               interpret w: identity_arrow_of_spans C w
                 using w_def w ide_char' by auto
 
               have hseq_fw: "hseq f w"
                 using w_def ide_f w src_def trg_def w1 by auto
               interpret fw: two_composable_arrows_of_spans C prj0 prj1 f w
                 using w_def hseq_fw hseq_char by unfold_locales auto
               interpret fw: two_composable_identity_arrows_of_spans C prj0 prj1 f w ..
 
               have hseq_gw: "hseq g w"
                 using w_def ide_g w src_def trg_def w1 by auto
               interpret gw: two_composable_arrows_of_spans C prj0 prj1 g w
                 using hseq_gw hseq_char by unfold_locales auto
               interpret gw: two_composable_identity_arrows_of_spans C prj0 prj1 g w ..
 
               interpret rfw: three_composable_arrows_of_spans C prj0 prj1 r f w ..
               interpret rfw: three_composable_identity_arrows_of_spans C prj0 prj1 r f w ..
               have arfw: "\<guillemotleft>\<a>[r, f, w] : (r \<star> f) \<star> w \<Rightarrow> r \<star> f \<star> w\<guillemotright>"
                 using fw.composable ide_f ide_r w rf.composable by auto
 
               have fw_apex_eq: "fw.apex = ?R \<down>\<down> ?w1"
                 using w_def fw.dom.apex_def hcomp_def hseq_fw hseq_char \<omega> C.arr_dom_iff_arr
                       C.pbdom_def fw.chine_eq_apex fw.chine_simps(1)
                 by auto
               have gw_apex_eq: "gw.apex = ?R \<down>\<down> ?w1"
                 using w_def \<omega> w1 gw.dom.apex_def hcomp_def hseq_gw hseq_char by auto
               text \<open>
                 Well, CKS say take \<open>\<theta> = p\<^sub>0\<omega>\<close>, but taking this literally and trying to define
                 \<open>\<theta>\<close> so that \<open>Chn \<theta> = ?p\<^sub>0 \<cdot> ?\<omega>\<close>, does not yield the required \<open>dom \<theta> = ?R \<down>\<down> ?w1\<close>.
                 We need \<open>\<guillemotleft>Chn \<theta> : ?R \<down>\<down> ?w1 \<rightarrow>\<^sub>C ?U\<guillemotright>\<close>, so we have to compose with a
                 projection, which leads to:  \<open>Chn \<theta> = ?p0 \<cdot> ?\<omega> \<cdot> \<p>\<^sub>0[?R, ?w1]\<close>.
                 What CKS say is only correct if the projection \<open>\<p>\<^sub>0[?R, ?w1]\<close> is an identity,
                 which can't be guaranteed for an arbitrary choice of pullbacks.
               \<close>
               define \<theta>
                 where
                   "\<theta> = \<lparr>Chn = ?p0 \<cdot> ?\<omega> \<cdot> \<p>\<^sub>0[?R, ?w1], Dom = Dom (f \<star> w), Cod = Cod u\<rparr>"
 
               interpret Dom_\<theta>: span_in_category C \<open>Dom \<theta>\<close>
                 using \<theta>_def fw.dom.span_in_category_axioms by simp
               interpret Cod_\<theta>: span_in_category C \<open>Cod \<theta>\<close>
                 using \<theta>_def u.cod.span_in_category_axioms by simp
 
               have Dom_\<theta>_leg0_eq: "Dom_\<theta>.leg0 = ?v0 \<cdot> \<p>\<^sub>0[?R, ?w1]"
                 using w_def \<theta>_def hcomp_def hseq_fw hseq_char by simp
               have Dom_\<theta>_leg1_eq: "Dom_\<theta>.leg1 = r0 \<cdot> ?q1"
                 using w_def \<theta>_def hcomp_def hseq_fw hseq_char by simp
               have Cod_\<theta>_leg0_eq: "Cod_\<theta>.leg0 = ?u0"
                 using w_def \<theta>_def hcomp_def hseq_fw hseq_char by simp
               have Cod_\<theta>_leg1_eq: "Cod_\<theta>.leg1 = ?u1"
                 using w_def \<theta>_def hcomp_def hseq_fw hseq_char by simp
               have Chn_\<theta>_eq: "Chn \<theta> = ?p0 \<cdot> ?\<omega> \<cdot> \<p>\<^sub>0[?R, ?w1]"
                 using \<theta>_def by simp
 
               interpret \<theta>: arrow_of_spans C \<theta>
               proof
                 show 1: "\<guillemotleft>Chn \<theta> : Dom_\<theta>.apex \<rightarrow>\<^sub>C Cod_\<theta>.apex\<guillemotright>"
                   using \<theta>_def Chn_\<omega> ru.legs_form_cospan fw_apex_eq
                   by (intro C.in_homI, auto)
                 show "Cod_\<theta>.leg0 \<cdot> Chn \<theta> = Dom_\<theta>.leg0"
                 proof -
                   have "Cod_\<theta>.leg0 \<cdot> Chn \<theta> = ?u0 \<cdot> ?p0 \<cdot> ?\<omega> \<cdot> \<p>\<^sub>0[?R, ?w1]"
                     using Cod_\<theta>_leg0_eq Chn_\<theta>_eq by simp
                   also have "... = ?v0 \<cdot> \<p>\<^sub>0[?R, ?w1]"
                   proof -
                     have "?u0 \<cdot> ?p0 \<cdot> ?\<omega> \<cdot> \<p>\<^sub>0[?R, ?w1] = (?u0 \<cdot> ?p0 \<cdot> ?\<omega>) \<cdot> \<p>\<^sub>0[?R, ?w1]"
                       using C.comp_assoc by simp
                     also have "... = ?v0 \<cdot> \<p>\<^sub>0[?R, ?w1]"
                     proof -
                       have "?u0 \<cdot> ?p0 \<cdot> ?\<omega> = (?u0 \<cdot> ?p0) \<cdot> ?\<omega>"
                         using C.comp_assoc by simp
                       also have "... = \<omega>.cod.leg0 \<cdot> ?\<omega>"
                       proof -
                         have "\<omega>.cod.leg0 = ru.leg0"
                           using \<omega> cod_char hcomp_def hseq_ru by auto
                         also have "... = ?u0 \<cdot> ?p0"
                           using hcomp_def hseq_ru by auto
                         finally show ?thesis by simp
                       qed
                       also have "... = \<omega>.dom.leg0"
                         using \<omega>.leg0_commutes by simp
                       also have "... = ?v0"
                         using \<omega> dom_char by auto
                       finally show ?thesis by simp
                     qed
                     finally show ?thesis by simp
                   qed
                   also have "... = Dom_\<theta>.leg0"
                     using Dom_\<theta>_leg0_eq by simp
                   finally show ?thesis by blast
                 qed
                 show "Cod_\<theta>.leg1 \<cdot> Chn \<theta> = Dom_\<theta>.leg1"
                 proof -
                   have "Cod_\<theta>.leg1 \<cdot> Chn \<theta> = ?u1 \<cdot> ?p0 \<cdot> ?\<omega> \<cdot> \<p>\<^sub>0[?R, ?w1]"
                     using Cod_\<theta>_leg1_eq Chn_\<theta>_eq by simp
                   also have "... = r0 \<cdot> ?q1"
                   proof -
                     have "?u1 \<cdot> ?p0 \<cdot> ?\<omega> \<cdot> \<p>\<^sub>0[?R, ?w1] = ((?u1 \<cdot> ?p0) \<cdot> ?\<omega>) \<cdot> \<p>\<^sub>0[?R, ?w1]"
                       using C.comp_assoc by fastforce
                     also have "... = ((r0 \<cdot> ?p1) \<cdot> ?\<omega>) \<cdot> \<p>\<^sub>0[?R, ?w1]"
                       using C.pullback_commutes' ru.legs_form_cospan by simp
                     also have "... = r0 \<cdot> ?w1 \<cdot> \<p>\<^sub>0[?R, ?w1]"
                       using C.comp_assoc by fastforce
                     also have "... = r0 \<cdot> ?R \<cdot> ?q1"
                       using \<omega> C.in_homE C.pullback_commutes' w1 by auto
                     also have "... = r0 \<cdot> ?q1"
                       using \<omega> w1 C.comp_cod_arr by auto
                     finally show ?thesis by simp
                   qed
                   also have "... = Dom_\<theta>.leg1"
                     using Dom_\<theta>_leg1_eq by simp
                   finally show ?thesis by blast
                 qed
               qed
               text \<open>
                 Similarly, CKS say to take \<open>\<nu> = 1: v \<Rightarrow> gw\<close>, but obviously this can't be
                 interpreted literally, either, because \<open>v.apex\<close> and \<open>gw.apex\<close> are not equal.
                 Instead, we have to define \<open>\<nu>\<close> so that \<open>Chn \<nu> = C.inv \<p>\<^sub>0[?R, ?w1]\<close>,
                 noting that \<open>\<p>\<^sub>0[?R, ?w1]\<close> is the pullback of an identity,
                 hence is an isomorphism. Then \<open>?v0 \<cdot> \<p>\<^sub>0[?R, ?w1] \<cdot> Chn \<nu> = ?v0\<close> and
                 \<open>?v1 \<cdot> \<p>\<^sub>1[?R, ?w1] \<cdot> Chn \<nu> = ?v1 \<cdot> ?w1\<close>, showing that \<open>\<nu>\<close> is an arrow
                 of spans.
               \<close>
               let ?\<nu>' = "\<p>\<^sub>0[?R, ?w1]"
               define \<nu>
                 where
                   "\<nu> = \<lparr>Chn = C.inv ?\<nu>', Dom = Dom (dom \<omega>), Cod = Cod (g \<star> w)\<rparr>"
               have iso_\<nu>: "C.inverse_arrows ?\<nu>' (Chn \<nu>)"
                 using \<nu>_def \<omega> w1 C.iso_pullback_ide
                 by (metis C.inv_is_inverse C.seqE arrow_of_spans_data.select_convs(1)
                     r.chine_eq_apex r.chine_simps(1) r.chine_simps(3) r.cod_simps(1)
                     r.dom.apex_def r.dom.ide_apex r.dom.is_span r1w1 v.dom.leg_simps(3))
               text \<open>
 $$
 \xymatrix{
   && X \\
   && V \ar[u]_{v_0} \ar[d]_{\omega}  \ar@/ul50pt/[ddddll]_{v_1} \ar@/l30pt/[dd]_<>(0.7){w_1}\\
   & R\downarrow\downarrow w_1 \ar[ur]^{\nu'} \ar[dd]_{q_1}
   & r_0\downarrow\downarrow u_1 \ar[d]_{p_1} \ar@/dl10pt/[drr]_<>(0.4){p_0}
   & R\downarrow\downarrow w_1 \ar[ul]_{\nu'} \ar[dd]^<>(0.7){q_1} \ar@ {.>}[dr]_{\theta}\\
   && R && U \ar@/ur20pt/[uuull]_{u_0} \ar[dd]^{u_1} \\
   & R \ar[dl]_{r_1} \ar@ {<->}[ur]_{R} \ar@ {.>}[dr]^{\rho} \ar@/dl5pt/[ddr]_<>(0.4){R}
   && R \ar@ {<->}[ul]^{R} \ar[dr]^{r_0} \ar[ur]_{r_1}\\
   B && r_0\downarrow\downarrow r_0 \ar[uu]_{k_0} \ar[d]^{k_1} \ar[uu] \ar[ur]_{k_0} && A \\
   & & R \ar[ull]^{r_1} \ar[urr]_{r_0} \\
 }
 $$
               \<close>
               have w1_eq: "?w1 = ?q1 \<cdot> C.inv ?\<nu>'"
               proof -
                 have "?R \<cdot> ?q1 = ?w1 \<cdot> ?\<nu>'"
                   using iso_\<nu> \<omega> w1 C.pullback_commutes [of ?R ?w1] by blast
                 hence "?q1 = ?w1 \<cdot> ?\<nu>'"
                   using \<omega> w1 C.comp_cod_arr by auto
                 thus ?thesis
                   using iso_\<nu> \<omega> w1 r.dom.apex_def r.cod.apex_def r.chine_eq_apex
                         C.invert_side_of_triangle(2)
                   by (metis C.isoI C.prj1_simps(1) arrow_of_spans_data.select_convs(3)
                       fw.legs_form_cospan(2) span_data.simps(1-2) w_def)
               qed
 
               interpret Dom_\<nu>: span_in_category C \<open>Dom \<nu>\<close>
                 using \<nu>_def v.dom.span_in_category_axioms by simp
               interpret Cod_\<nu>: span_in_category C \<open>Cod \<nu>\<close>
                 using \<nu>_def gw.cod.span_in_category_axioms by simp
               interpret \<nu>: arrow_of_spans C \<nu>
               proof
                 show 1: "\<guillemotleft>Chn \<nu> : Dom_\<nu>.apex \<rightarrow>\<^sub>C Cod_\<nu>.apex\<guillemotright>"
                 proof
                   show "C.arr (Chn \<nu>)"
                     using iso_\<nu> by auto
                   show "C.dom (Chn \<nu>) = Dom_\<nu>.apex"
                     using \<nu>_def iso_\<nu> w1 gw_apex_eq by fastforce
                   show "C.cod (Chn \<nu>) = Cod_\<nu>.apex"
                     using \<nu>_def iso_\<nu> gw_apex_eq C.comp_inv_arr C.pbdom_def
                     by (metis C.cod_comp arrow_of_spans_data.select_convs(3)
                         gw.apex_composite gw.chine_composite gw.chine_simps(1) gw.chine_simps(3))
                 qed
                 show "Cod_\<nu>.leg0 \<cdot> Chn \<nu> = Dom_\<nu>.leg0"
                   using w_def \<nu>_def 1 iso_\<nu> hcomp_def hseq_gw C.comp_arr_inv
                         C.comp_assoc v.leg0_commutes
                   by auto
                 show "Cod_\<nu>.leg1 \<cdot> Chn \<nu> = Dom_\<nu>.leg1"
                   using w_def \<nu>_def hcomp_def hseq_gw C.comp_assoc w1_eq r1w1
                   by auto
               qed
               text \<open>
                 Now we can proceed to establishing the conclusions of \<open>T1\<close>.
               \<close>
               have "ide w \<and> \<guillemotleft>\<theta> : f \<star> w \<Rightarrow> u\<guillemotright> \<and> \<guillemotleft>\<nu> : dom \<omega> \<Rightarrow> dom \<rho> \<star> w\<guillemotright> \<and> iso \<nu> \<and>
                     T.composite_cell w \<theta> \<bullet> \<nu> = \<omega>"
               proof (intro conjI)
                 show ide_w: "ide w"
                   using w by blast
                 show \<theta>: "\<guillemotleft>\<theta> : f \<star> w \<Rightarrow> u\<guillemotright>"
                   using \<theta>_def \<theta>.arrow_of_spans_axioms arr_char dom_char cod_char hseq_fw hseq_char
                         hcomp_def fw.chine_eq_apex
                   by auto
                 show \<nu>: "\<guillemotleft>\<nu> : dom \<omega> \<Rightarrow> dom \<rho> \<star> w\<guillemotright>"
                 proof -
                   have "\<guillemotleft>\<nu> : dom \<omega> \<Rightarrow> g \<star> w\<guillemotright>"
                     using \<nu>_def \<omega> \<nu>.arrow_of_spans_axioms arr_char dom_char cod_char hseq_gw
                           hseq_char hcomp_def gw.chine_eq_apex
                     apply (intro in_homI) by auto
                   thus ?thesis
                     using T.tab_in_hom by simp
                 qed
                 show "iso \<nu>"
                   using iso_\<nu> iso_char arr_char \<nu>.arrow_of_spans_axioms by auto
                 show "T.composite_cell w \<theta> \<bullet> \<nu> = \<omega>"
                 proof (intro arr_eqI)
                   have \<rho>w: "\<guillemotleft>\<rho> \<star> w : g \<star> w \<Rightarrow> (r \<star> f) \<star> w\<guillemotright>"
                     using w_def \<rho> ide_w hseq_rf hseq_fw hseq_gw by auto
                   have r\<theta>: "\<guillemotleft>r \<star> \<theta> : r \<star> f \<star> w \<Rightarrow> r \<star> u\<guillemotright>"
                     using arfw ide_r \<theta> fw.composite_simps(2) rf.composable by auto 
                   have 1: "\<guillemotleft>T.composite_cell w \<theta> \<bullet> \<nu> : dom \<omega> \<Rightarrow> r \<star> u\<guillemotright>"
                     using \<nu> \<rho>w arfw r\<theta> by auto
                   show "par (T.composite_cell w \<theta> \<bullet> \<nu>) \<omega>"
                     using 1 \<omega> by (elim in_homE, auto)
                   show "Chn (T.composite_cell w \<theta> \<bullet> \<nu>) = ?\<omega>"
                   proof -
                     have 2: "Chn (T.composite_cell w \<theta> \<bullet> \<nu>) =
                              Chn (r \<star> \<theta>) \<cdot> Chn \<a>[r, f, w] \<cdot> Chn (\<rho> \<star> w) \<cdot> Chn \<nu>"
                     proof -
                       have "Chn (T.composite_cell w \<theta> \<bullet> \<nu>) =
                             Chn (T.composite_cell w \<theta>) \<cdot> Chn \<nu>"
                         using 1 Chn_vcomp by blast
                       also have "... = (Chn (r \<star> \<theta>) \<cdot> Chn \<a>[r, f, w] \<cdot> Chn (\<rho> \<star> w)) \<cdot> Chn \<nu>"
                       proof -
                         have "seq (r \<star> \<theta>) (\<a>[r, f, w] \<bullet> (\<rho> \<star> w)) \<and> seq \<a>[r, f, w] (\<rho> \<star> w)"
                           using 1 by blast
                         thus ?thesis
                           using 1 Chn_vcomp by presburger
                       qed
                       finally show ?thesis
                         using C.comp_assoc by auto
                     qed
                     also have "... = ?\<omega>"
                     proof -
                       let ?LHS = "Chn (r \<star> \<theta>) \<cdot> Chn \<a>[r, f, w] \<cdot> Chn (\<rho> \<star> w) \<cdot> Chn \<nu>"
                       have Chn_r\<theta>: "Chn (r \<star> \<theta>) = \<langle>r.chine \<cdot> \<p>\<^sub>1[r0, r0 \<cdot> ?q1]
                                                      \<lbrakk>r0, ?u1\<rbrakk>
                                                    \<theta>.chine \<cdot> \<p>\<^sub>0[r0, r0 \<cdot> ?q1]\<rangle>"
                         using r\<theta> hcomp_def \<theta>_def chine_hcomp_def Dom_\<theta>_leg1_eq
                         by (metis arrI arrow_of_spans_data.select_convs(1,3)
                             hseq_char r.cod_simps(2) u.cod_simps(3))
                       have Chn_arfw: "Chn \<a>[r, f, w] = rfw.chine_assoc"
                         using \<alpha>_ide ide_f rf.composable fw.composable w by auto
                       have Chn_\<rho>w: "Chn (\<rho> \<star> w) = \<langle>?\<rho> \<cdot> ?q1 \<lbrakk>k0, ?w1\<rbrakk> ?\<nu>'\<rangle>"
                       proof -
                         have "Chn (\<rho> \<star> w) =
                               chine_hcomp
                                 \<lparr>Chn = ?\<rho>,
                                  Dom = \<lparr>Leg0 = ?R, Leg1 = r1\<rparr>,
                                  Cod = \<lparr>Leg0 = k0, Leg1 = r1 \<cdot> k1\<rparr>\<rparr>
                                 \<lparr>Chn = v.apex,
                                  Dom = \<lparr>Leg0 = ?v0, Leg1 = ?w1\<rparr>,
                                  Cod = \<lparr>Leg0 = ?v0, Leg1 = ?w1\<rparr>\<rparr>"
                           using \<rho> ide_w hseq_rf hseq_char hcomp_def src_def trg_def
                           by (metis (no_types, lifting) \<rho>w arrI arrow_of_spans_data.select_convs(1)
                               v.dom.apex_def w_def)
                         also have "... = \<langle>?\<rho> \<cdot> ?q1 \<lbrakk>k0, ?w1\<rbrakk> ?V \<cdot> ?\<nu>'\<rangle>"
                           unfolding chine_hcomp_def by simp
                         also have "... = \<langle>?\<rho> \<cdot> ?q1 \<lbrakk>k0, ?w1\<rbrakk> ?\<nu>'\<rangle>"
                         proof -
                           have "?V \<cdot> ?\<nu>' = ?\<nu>'"
                             using C.comp_ide_arr v.dom.ide_apex \<rho> w1 by auto
                           thus ?thesis by simp
                         qed
                         finally show ?thesis by blast
                       qed
 
                       have 3: "C.seq ?p1 ?\<omega>"
                         using w1 by blast
                       moreover have 4: "C.seq ?p1 ?LHS"
                       proof
                         show "\<guillemotleft>?LHS : v.apex \<rightarrow>\<^sub>C ru.apex\<guillemotright>"
                           by (metis (no_types, lifting) 1 2 Chn_in_hom ru.chine_eq_apex
                               v.chine_eq_apex)
                         show "\<guillemotleft>?p1 : ru.apex \<rightarrow>\<^sub>C ?R\<guillemotright>"
                           using P C.prj1_in_hom ru.legs_form_cospan by fastforce
                       qed
                       moreover have "?p0 \<cdot> ?LHS = ?p0 \<cdot> ?\<omega>"
                       proof -
                         have "?p0 \<cdot> ?LHS =
                               (?p0 \<cdot> Chn (r \<star> \<theta>)) \<cdot> Chn \<a>[r, f, w] \<cdot> Chn (\<rho> \<star> w) \<cdot> Chn \<nu>"
                           using C.comp_assoc by simp
                         also have "... = (\<theta>.chine \<cdot> \<p>\<^sub>0[r0, r0 \<cdot> ?q1]) \<cdot>
                                            Chn \<a>[r, f, w] \<cdot> Chn (\<rho> \<star> w) \<cdot> Chn \<nu>"
                         proof -
                           have "?p0 \<cdot> Chn (r \<star> \<theta>) = \<theta>.chine \<cdot> \<p>\<^sub>0[r0, r0 \<cdot> ?q1]"
                             by (metis C.prj_tuple(1) Chn_r\<theta> \<theta>_def arrI Dom_\<theta>_leg1_eq
                                 arrow_of_spans_data.select_convs(3) chine_hcomp_props(2)
                                 hseq_char r.cod_simps(2) r\<theta> u.cod_simps(3))
                           thus ?thesis by argo
                         qed
                         also have
                           "... = ?p0 \<cdot> ?\<omega> \<cdot> (rfw.Prj\<^sub>0\<^sub>0 \<cdot> Chn \<a>[r, f, w]) \<cdot> Chn (\<rho> \<star> w) \<cdot> Chn \<nu>"
                           using w_def \<theta>_def C.comp_assoc by simp
                         also have "... = ?p0 \<cdot> ?\<omega> \<cdot> (rfw.Prj\<^sub>0  \<cdot> Chn (\<rho> \<star> w)) \<cdot> Chn \<nu>"
                           using Chn_arfw rfw.prj_chine_assoc C.comp_assoc by simp
                         also have "... = ?p0 \<cdot> ?\<omega> \<cdot> ?\<nu>' \<cdot> Chn \<nu>"
                         proof -
                           have "rfw.Prj\<^sub>0 \<cdot> Chn (\<rho> \<star> w) = \<p>\<^sub>0[k0, ?w1] \<cdot> \<langle>?\<rho> \<cdot> ?q1 \<lbrakk>k0, ?w1\<rbrakk> ?\<nu>'\<rangle>"
                             using w_def Chn_\<rho>w C.comp_cod_arr by simp
                           also have "... = ?\<nu>'"
                             by (metis (no_types, lifting) C.not_arr_null C.prj_tuple(1) C.seqE
                                 C.tuple_is_extensional Chn_\<rho>w 4)
                           finally have "rfw.Prj\<^sub>0 \<cdot> Chn (\<rho> \<star> w) = ?\<nu>'"
                             by blast
                           thus ?thesis by simp
                         qed
                         also have "... = ?p0 \<cdot> ?\<omega>"
                           using iso_\<nu> C.comp_arr_dom
                           by (metis (no_types, lifting) C.comp_arr_inv C.dom_comp \<nu>_def
                               \<omega>.chine_simps(1) 3 arrow_of_spans_data.simps(1) w1_eq)
                         finally show ?thesis by blast
                       qed
                       moreover have "?p1 \<cdot> ?LHS = ?w1"
                       proof -
                         have "?p1 \<cdot> ?LHS =
                               (?p1 \<cdot> Chn (r \<star> \<theta>)) \<cdot> Chn \<a>[r, f, w] \<cdot> Chn (\<rho> \<star> w) \<cdot> Chn \<nu>"
                           using C.comp_assoc by simp
                         also have "... = (r.chine \<cdot> \<p>\<^sub>1[r0, r0 \<cdot> ?q1]) \<cdot> Chn \<a>[r, f, w] \<cdot>
                                            Chn (\<rho> \<star> w) \<cdot> Chn \<nu>"
                           by (metis (no_types, lifting) C.not_arr_null C.prj_tuple(2) C.seqE
                               C.tuple_is_extensional Chn_r\<theta> 4)
                         also have "... = r.chine \<cdot> (rfw.Prj\<^sub>1 \<cdot> Chn \<a>[r, f, w]) \<cdot> Chn (\<rho> \<star> w) \<cdot> Chn \<nu>"
                           using w_def Dom_\<theta>_leg1_eq C.comp_assoc by simp
                         also have "... = r.chine \<cdot> (rfw.Prj\<^sub>1\<^sub>1 \<cdot> Chn (\<rho> \<star> w)) \<cdot> Chn \<nu>"
                           using Chn_arfw rfw.prj_chine_assoc(1) C.comp_assoc by simp
                         also have "... = r.chine \<cdot> ?q1 \<cdot> Chn \<nu>"
                         proof -
                           have "rfw.Prj\<^sub>1\<^sub>1 \<cdot> Chn (\<rho> \<star> w) =
                                  (k1 \<cdot> \<p>\<^sub>1[k0, ?w1]) \<cdot> \<langle>?\<rho> \<cdot> ?q1 \<lbrakk>k0, ?w1\<rbrakk> ?\<nu>'\<rangle>"
                             using w_def Chn_\<rho>w C.comp_cod_arr by simp
                           also have "... = k1 \<cdot> \<p>\<^sub>1[k0, ?w1] \<cdot> \<langle>?\<rho> \<cdot> ?q1 \<lbrakk>k0, ?w1\<rbrakk> ?\<nu>'\<rangle>"
                             using C.comp_assoc by simp
                           also have "... = k1 \<cdot> ?\<rho> \<cdot> ?q1"
                             by (metis (no_types, lifting) C.not_arr_null C.prj_tuple(2)
                                 C.seqE C.tuple_is_extensional Chn_\<rho>w 4)
                           also have "... = (k1 \<cdot> ?\<rho>) \<cdot> ?q1"
                             using C.comp_assoc by presburger
                           also have "... = ?R \<cdot> ?q1"
                             by simp
                           also have "... = ?q1"
                             by (metis Dom_\<theta>_leg1_eq C.comp_ide_arr C.prj1_simps(3)
                                 C.prj1_simps_arr C.seqE C.seqI Dom_\<theta>.leg_simps(3)
                                 r.dom.ide_apex)
                           finally have "rfw.Prj\<^sub>1\<^sub>1 \<cdot> Chn (\<rho> \<star> w) = ?q1"
                             by blast
                           thus ?thesis by simp
                         qed
                         also have "... = (r.chine \<cdot> ?p1) \<cdot> ?\<omega>"
                           using \<nu>_def w1_eq C.comp_assoc by simp
                         also have "... = ?w1"
                           using C.comp_cod_arr r.chine_eq_apex ru.prj_simps(1) by auto
                         finally show ?thesis by blast
                       qed
                       ultimately show ?thesis
                         using ru.legs_form_cospan C.prj_joint_monic by blast
                     qed
                     finally show ?thesis by argo
                   qed
                 qed
               qed
               thus ?thesis
                 using w_def by auto
             qed
           qed
 
           show T2: "\<And>u w w' \<theta> \<theta>' \<beta>.
                        \<lbrakk> ide w; ide w';
                          \<guillemotleft>\<theta> : f \<star> w \<Rightarrow> u\<guillemotright>; \<guillemotleft>\<theta>' : f \<star> w' \<Rightarrow> u\<guillemotright>; \<guillemotleft>\<beta> : g \<star> w \<Rightarrow> g \<star> w'\<guillemotright>;
                          T.composite_cell w \<theta> = T.composite_cell w' \<theta>' \<bullet> \<beta> \<rbrakk> \<Longrightarrow>
                        \<exists>!\<gamma>. \<guillemotleft>\<gamma> : w \<Rightarrow> w'\<guillemotright> \<and> \<beta> = g \<star> \<gamma> \<and> \<theta> = \<theta>' \<bullet> (f \<star> \<gamma>)"
           proof -
             fix u w w' \<theta> \<theta>' \<beta>
             assume ide_w: "ide w"
             assume ide_w': "ide w'"
             assume \<theta>: "\<guillemotleft>\<theta> : f \<star> w \<Rightarrow> u\<guillemotright>"
             assume \<theta>': "\<guillemotleft>\<theta>' : f \<star> w' \<Rightarrow> u\<guillemotright>"
             assume \<beta>: "\<guillemotleft>\<beta> : g \<star> w \<Rightarrow> g \<star> w'\<guillemotright>"
             assume E: "T.composite_cell w \<theta> = T.composite_cell w' \<theta>' \<bullet> \<beta>"
             interpret T: uw\<theta>w'\<theta>'\<beta> vcomp hcomp assoc unit src trg r \<rho> f g u w \<theta> w' \<theta>' \<beta>
               using ide_w ide_w' \<theta> \<theta>' \<beta> E comp_assoc
               by unfold_locales auto
 
             show "\<exists>!\<gamma>. \<guillemotleft>\<gamma> : w \<Rightarrow> w'\<guillemotright> \<and> \<beta> = g \<star> \<gamma> \<and> \<theta> = \<theta>' \<bullet> (f \<star> \<gamma>)"
             proof
               interpret u: identity_arrow_of_spans C u
                 using T.uw\<theta>.u_simps(1) ide_char' by auto
               interpret w: identity_arrow_of_spans C w
                 using ide_w ide_char' by auto
               interpret w': identity_arrow_of_spans C w'
                 using ide_w' ide_char' by auto
               let ?u0 = u.leg0
               let ?u1 = u.leg1
               let ?w0 = w.leg0
               let ?w1 = w.leg1
               let ?wa = "w.apex"
               let ?w0' = w'.leg0
               let ?w1' = w'.leg1
               let ?wa' = "w'.apex"
               let ?R = ra
               let ?p0 = "\<p>\<^sub>0[?R, ?w1]"
               let ?p0' = "\<p>\<^sub>0[?R, ?w1']"
               let ?p1 = "\<p>\<^sub>1[?R, ?w1]"
               let ?p1' = "\<p>\<^sub>1[?R, ?w1']"
 
               interpret fw: two_composable_identity_arrows_of_spans C prj0 prj1 f w
                 using hseq_char by unfold_locales auto
               interpret fw': two_composable_identity_arrows_of_spans C prj0 prj1 f w'
                 using hseq_char by unfold_locales auto
 
               have hseq_gw: "hseq g w"
                 using T.leg1_in_hom by auto
               interpret gw: two_composable_identity_arrows_of_spans C prj0 prj1 g w
                 using hseq_gw hseq_char by unfold_locales auto
 
               have hseq_gw': "hseq g w'"
                 using T.leg1_in_hom by auto
               interpret gw': two_composable_identity_arrows_of_spans C prj0 prj1 g w'
                 using hseq_gw' hseq_char by unfold_locales auto
 
               interpret rfw: three_composable_identity_arrows_of_spans C prj0 prj1 r f w ..
               interpret rfw: identity_arrow_of_spans C \<open>r \<star> f \<star> w\<close>
                 using rfw.composites_are_identities ide_char' by auto
               interpret rfw': three_composable_arrows_of_spans C prj0 prj1 r f w' ..
               interpret rfw': three_composable_identity_arrows_of_spans C prj0 prj1 r f w' ..
               interpret rfw': identity_arrow_of_spans C \<open>r \<star> f \<star> w'\<close>
                 using rfw'.composites_are_identities ide_char' by auto
 
               have \<rho>w: "\<guillemotleft>\<rho> \<star> w : g \<star> w \<Rightarrow> (r \<star> f) \<star> w\<guillemotright>"
                 using \<rho> hseq_gw by blast
               interpret \<rho>w: two_composable_arrows_of_spans C prj0 prj1 \<rho> w
                 using \<rho>w by unfold_locales auto
               have \<rho>w': "\<guillemotleft>\<rho> \<star> w' : g \<star> w' \<Rightarrow> (r \<star> f) \<star> w'\<guillemotright>"
                 using \<rho> hseq_gw' by blast
               interpret \<rho>w': two_composable_arrows_of_spans C prj0 prj1 \<rho> w'
                 using \<rho>w' by unfold_locales auto
 
               have arfw: "\<guillemotleft>\<a>[r, f, w] : (r \<star> f) \<star> w \<Rightarrow> r \<star> f \<star> w\<guillemotright>"
                 using fw.composable ide_f ide_r ide_w rf.composable by auto
               have arfw': "\<guillemotleft>\<a>[r, f, w'] : (r \<star> f) \<star> w' \<Rightarrow> r \<star> f \<star> w'\<guillemotright>"
                 using fw'.composable ide_f ide_r ide_w' rf.composable by auto
 
               have r\<theta>: "\<guillemotleft>r \<star> \<theta> : r \<star> f \<star> w \<Rightarrow> r \<star> u\<guillemotright>"
                 by fastforce
               interpret Dom_\<theta>: span_in_category C \<open>Dom \<theta>\<close>
                 using fw.dom.span_in_category_axioms
                 by (metis \<theta> arrow_of_spans_data.select_convs(2) in_homE dom_char)
               interpret Cod_\<theta>: span_in_category C \<open>Cod \<theta>\<close>
                 using \<theta> u.cod.span_in_category_axioms cod_char by auto
               interpret \<theta>: arrow_of_spans C \<theta>
                 using arr_char by auto
               interpret r\<theta>: two_composable_arrows_of_spans C prj0 prj1 r \<theta>
                 using r\<theta> by unfold_locales auto
 
               have r\<theta>': "\<guillemotleft>r \<star> \<theta>' : r \<star> f \<star> w' \<Rightarrow> r \<star> u\<guillemotright>"
                 by fastforce
               interpret Dom_\<theta>': span_in_category C \<open>Dom \<theta>'\<close>
                 using fw'.dom.span_in_category_axioms
                 by (metis \<theta>' arrow_of_spans_data.select_convs(2) in_homE dom_char)
               interpret Cod_\<theta>': span_in_category C \<open>Cod \<theta>'\<close>
                 using \<theta>' u.cod.span_in_category_axioms cod_char by auto
               interpret \<theta>': arrow_of_spans C \<theta>'
                 using arr_char by auto
               interpret r\<theta>': two_composable_arrows_of_spans C prj0 prj1 r \<theta>'
                 using r\<theta>' by unfold_locales auto
 
               have 7: "\<guillemotleft>T.composite_cell w' \<theta>' \<bullet> \<beta> : g \<star> w \<Rightarrow> r \<star> u\<guillemotright>"
                 using \<beta> \<rho>w' arfw' r\<theta>' by auto
               have 8: "\<guillemotleft>T.composite_cell w \<theta> : g \<star> w \<Rightarrow> r \<star> u\<guillemotright>"
                 using \<rho>w arfw r\<theta> by auto
 
               interpret ru: two_composable_identity_arrows_of_spans C prj0 prj1 r u
                 using hseq_char by unfold_locales auto
 
               interpret Dom_\<beta>: span_in_category C \<open>Dom \<beta>\<close>
                 using \<beta> fw.dom.span_in_category_axioms arr_char
                 by (metis comp_arr_dom in_homE gw.cod.span_in_category_axioms seq_char)
               interpret Cod_\<beta>: span_in_category C \<open>Cod \<beta>\<close>
                 using \<beta> fw.cod.span_in_category_axioms arr_char
                 by (metis (no_types, lifting) comp_arr_dom ideD(2) in_homI
                     gw'.cod.span_in_category_axioms gw'.chine_is_identity hseq_gw' seqI'
                     seq_char ide_char)
               interpret \<beta>: arrow_of_spans C \<beta>
                 using \<beta> arr_char by auto
               text \<open>
                 CKS say: ``Take \<open>u\<close>, \<open>w\<close>, \<open>w'\<close>, \<open>\<theta>\<close>, \<open>\<theta>'\<close> as in \<open>T2\<close> and note that
                 \<open>fw = (w\<^sub>0, W, r\<^sub>0 w\<^sub>1)\<close>, \<open>gw = (w\<^sub>0, W, r\<^sub>1 w\<^sub>1)\<close>, \emph{etc}.
                 So \<open>\<beta>: W \<rightarrow> W'\<close> satisfies \<open>w\<^sub>0 = w\<^sub>0' \<beta>\<close>, \<open>r\<^sub>1 w\<^sub>1 = r\<^sub>1 w\<^sub>1' \<beta>\<close>.
                 But the equation \<open>(r\<theta>)(\<rho>w) = (r\<theta>')(\<rho>w')\<beta>\<close> gives \<open>w\<^sub>1 = w\<^sub>1'\<close>.
                 So \<open>\<gamma> = \<beta> : w \<Rightarrow> w'\<close> is unique with \<open>\<beta> = g \<gamma>, \<theta> = \<theta>' (f \<gamma>).\<close>''
 
                 Once again, there is substantial punning in the proof sketch given by CKS.
                 We can express \<open>fw\<close> and \<open>gw\<close> almost in the form they indicate, but projections
                 are required.
               \<close>
               have cospan: "C.cospan ?R ?w1"
                 using hseq_char [of \<rho> w] src_def trg_def by auto
               have cospan': "C.cospan ?R ?w1'"
                 using hseq_char [of \<rho> w'] src_def trg_def by auto
               have fw: "f \<star> w = \<lparr>Chn = ?R \<down>\<down> ?w1,
                                  Dom = \<lparr>Leg0 = ?w0 \<cdot> ?p0, Leg1 = r0 \<cdot> ?p1\<rparr>,
                                  Cod = \<lparr>Leg0 = ?w0 \<cdot> ?p0, Leg1 = r0 \<cdot> ?p1\<rparr>\<rparr>"
                 using ide_f hseq_char hcomp_def chine_hcomp_def fw.dom.apex_def cospan
                       fw.chine_eq_apex
                 by auto
               have gw: "g \<star> w = \<lparr>Chn = ?R \<down>\<down> ?w1,
                                  Dom = \<lparr>Leg0 = ?w0 \<cdot> ?p0, Leg1 = r1 \<cdot> ?p1\<rparr>,
                                  Cod = \<lparr>Leg0 = ?w0 \<cdot> ?p0, Leg1 = r1 \<cdot> ?p1\<rparr>\<rparr>"
                 using hseq_gw hseq_char hcomp_def chine_hcomp_def gw.dom.apex_def cospan
                       gw.chine_eq_apex
                 by auto
               have fw': "f \<star> w' = \<lparr>Chn = ?R \<down>\<down> ?w1',
                                    Dom = \<lparr>Leg0 = ?w0' \<cdot> ?p0', Leg1 = r0 \<cdot> ?p1'\<rparr>,
                                    Cod = \<lparr>Leg0 = ?w0' \<cdot> ?p0', Leg1 = r0 \<cdot> ?p1'\<rparr>\<rparr>"
                 using ide_f hseq_char hcomp_def chine_hcomp_def fw'.dom.apex_def cospan'
                       fw'.chine_eq_apex
                 by auto
               have gw': "g \<star> w' = \<lparr>Chn = ?R \<down>\<down> ?w1',
                                    Dom = \<lparr>Leg0 = ?w0' \<cdot> ?p0', Leg1 = r1 \<cdot> ?p1'\<rparr>,
                                    Cod = \<lparr>Leg0 = ?w0' \<cdot> ?p0', Leg1 = r1 \<cdot> ?p1'\<rparr>\<rparr>"
                 using hseq_gw' hseq_char hcomp_def chine_hcomp_def gw'.dom.apex_def cospan'
                       gw'.chine_eq_apex
                 by auto
               text \<open>
                 Note that \<open>?p0\<close> and \<open>?p0'\<close> are only isomorphisms, not identities,
                 and we have \<open>?p1\<close> (which equals \<open>?w1 \<cdot> ?p0\<close>) and \<open>?p1'\<close> (which equals \<open>?w1' \<cdot> ?p0'\<close>)
                 in place of \<open>?w1\<close> and \<open>?w1'\<close>.
               \<close>
               text \<open>
                 The following diagram summarizes the
                 various given and defined arrows involved in the proof.
                 We have deviated slightly here from the nomenclature used in in CKS.
                 We prefer to use \<open>W\<close> and \<open>W'\<close> to denote the apexes of
                 \<open>w\<close> and \<open>w'\<close>, respectively.
                 We already have the expressions \<open>?R \<down>\<down> ?w1\<close> and \<open>?R \<down>\<down> ?w1'\<close> for the
                 apexes of \<open>fw\<close> and \<open>fw'\<close> (which are the same as the apexes of
                 \<open>gw\<close> and \<open>gw'\<close>, respectively) and we will not use any abbreviation for them.
               \<close>
               text \<open>
 $$
 \xymatrix{
   &&& X \\
   && W \ar[ur]^{w_0} \ar[dr]_{w_1} \ar@ {.>}[rr]^{\gamma}
   && W' \ar[ul]_{w_0'} \ar[dl]^{w_1'} && U \ar@/r10pt/[dddl]^{u_1} \ar@/u7pt/[ulll]_{u_0}\\
   & R\downarrow\downarrow w_1 \ar[ur]_{p_0} \ar[dr]^{p_1} \ar@/d15pt/[rrrr]_{\beta}
     \ar@/u100pt/[urrrrr]^{\theta}
   && R && R \downarrow\downarrow w_1' \ar[ul]^{p_0'} \ar[dl]^{p_1'} \ar[ur]_{\theta'} \\
   && R \ar@ {.>}[dr]_{\rho} \ar@/dl7pt/[ddr]_{R} \ar[ur]_{R} \ar[dl]_{r_1} \ar@ {<->}[rr]_{R}
   && R \ar[ul]^{R} \ar[dr]_{r_0} \\
   & B && r_0 \downarrow\downarrow r_0 \ar[d]^{k_1} \ar[ur]_{k_0} && A \\
   &&& R \ar@/dr10pt/[urr]_{r_0} \ar@/dl5pt/[ull]^{r_1}
 }
 $$
               \<close>
               have Chn_\<beta>: "\<guillemotleft>\<beta>.chine: ?R \<down>\<down> ?w1 \<rightarrow>\<^sub>C ?R \<down>\<down> ?w1'\<guillemotright>"
                 using gw gw' Chn_in_hom \<beta> gw'.chine_eq_apex gw.chine_eq_apex by force
               have \<beta>_eq: "\<beta> = \<lparr>Chn = \<beta>.chine,
                                Dom = \<lparr>Leg0 = ?w0 \<cdot> ?p0, Leg1 = r1 \<cdot> ?p1\<rparr>,
                                Cod = \<lparr>Leg0 = ?w0' \<cdot> ?p0', Leg1 = r1 \<cdot> ?p1'\<rparr>\<rparr>"
                 using \<beta> gw gw' dom_char cod_char by auto
               have Dom_\<beta>_eq: "Dom \<beta> = \<lparr>Leg0 = ?w0 \<cdot> ?p0, Leg1 = r1 \<cdot> ?p1\<rparr>"
                 using \<beta> gw gw' dom_char cod_char by auto
               have Cod_\<beta>_eq: "Cod \<beta> = \<lparr>Leg0 = ?w0' \<cdot> ?p0', Leg1 = r1 \<cdot> ?p1'\<rparr>"
                 using \<beta> gw gw' dom_char cod_char by auto
 
               have \<beta>0: "?w0 \<cdot> ?p0 = ?w0' \<cdot> ?p0' \<cdot> \<beta>.chine"
                 using Dom_\<beta>_eq Cod_\<beta>_eq \<beta>.leg0_commutes C.comp_assoc by simp
               have \<beta>1: "r1 \<cdot> ?p1 = r1 \<cdot> ?p1' \<cdot> \<beta>.chine"
                 using Dom_\<beta>_eq Cod_\<beta>_eq \<beta>.leg1_commutes C.comp_assoc by simp
 
               have Dom_\<theta>_0: "Dom_\<theta>.leg0 = ?w0 \<cdot> ?p0"
                 using arrI dom_char fw T.uw\<theta>.\<theta>_simps(4) by auto
               have Cod_\<theta>_0: "Cod_\<theta>.leg0 = ?u0"
                 using \<theta> cod_char by auto
               have Dom_\<theta>_1: "Dom_\<theta>.leg1 = r0 \<cdot> ?p1"
                 using arrI dom_char fw T.uw\<theta>.\<theta>_simps(4) by auto
               have Cod_\<theta>_1: "Cod_\<theta>.leg1 = ?u1"
                 using T.uw\<theta>.\<theta>_simps(5) cod_char by auto
               have Dom_\<theta>'_0: "Dom_\<theta>'.leg0 = ?w0' \<cdot> ?p0'"
                 using dom_char fw' T.uw'\<theta>'.\<theta>_simps(4) by auto
               have Cod_\<theta>'_0: "Cod_\<theta>'.leg0 = ?u0"
                 using T.uw'\<theta>'.\<theta>_simps(5) cod_char by auto
               have Dom_\<theta>'_1: "Dom_\<theta>'.leg1 = r0 \<cdot> ?p1'"
                 using dom_char fw' T.uw'\<theta>'.\<theta>_simps(4) by auto
               have Cod_\<theta>'_1: "Cod_\<theta>'.leg1 = ?u1"
                 using T.uw'\<theta>'.\<theta>_simps(5) cod_char by auto
               have Dom_\<rho>_0: "Dom_\<rho>.leg0 = ?R"
                 by simp
               have Dom_\<rho>_1: "Dom_\<rho>.leg1 = r1"
                 by simp
               have Cod_\<rho>_0: "Cod_\<rho>.leg0 = k0"
                 by simp
               have Cod_\<rho>_1: "Cod_\<rho>.leg1 = r1 \<cdot> k1"
                 by simp
 
               have Chn_r\<theta>: "\<guillemotleft>r\<theta>.chine : rfw.chine \<rightarrow>\<^sub>C ru.chine\<guillemotright>"
                 using r\<theta>.chine_composite_in_hom ru.chine_composite rfw.chine_composite
                       Cod_\<theta>_1 Dom_\<theta>_1 fw.leg1_composite
                 by auto
               have Chn_r\<theta>_eq: "r\<theta>.chine = \<langle>\<p>\<^sub>1[r0, r0 \<cdot> ?p1] \<lbrakk>r0, ?u1\<rbrakk> \<theta>.chine \<cdot> \<p>\<^sub>0[r0, r0 \<cdot> ?p1]\<rangle>"
                 using r\<theta>.chine_composite Cod_\<theta>_1 Dom_\<theta>_1 fw.leg1_composite C.comp_cod_arr
                 by (metis arrow_of_spans_data.simps(2) fw r.chine_eq_apex r.cod_simps(2)
                     rfw.prj_simps(10) rfw.prj_simps(16) span_data.simps(2))
 
               have r\<theta>_cod_apex_eq: "r\<theta>.cod.apex = r0 \<down>\<down> ?u1"
                 using Cod_\<theta>_1 r\<theta>.chine_composite_in_hom by auto
               hence r\<theta>'_cod_apex_eq: "r\<theta>'.cod.apex = r0 \<down>\<down> ?u1"
                 using Cod_\<theta>'_1 r\<theta>'.chine_composite_in_hom by auto
  
               have Chn_r\<theta>': "\<guillemotleft>r\<theta>'.chine : rfw'.chine \<rightarrow>\<^sub>C ru.chine\<guillemotright>"
                 using r\<theta>'.chine_composite_in_hom ru.chine_composite rfw'.chine_composite
                       Cod_\<theta>'_1 Dom_\<theta>'_1 fw'.leg1_composite
                 by auto
               have Chn_r\<theta>'_eq: "r\<theta>'.chine =
                                 \<langle>\<p>\<^sub>1[r0, r0 \<cdot> ?p1'] \<lbrakk>r0, ?u1\<rbrakk> \<theta>'.chine \<cdot> \<p>\<^sub>0[r0, r0 \<cdot> ?p1']\<rangle>"
                 using r\<theta>'.chine_composite Cod_\<theta>'_1 Dom_\<theta>'_1 fw'.leg1_composite C.comp_cod_arr
                 by (metis arrow_of_spans_data.simps(2) fw' r.chine_eq_apex r.cod_simps(2)
                     rfw'.prj_simps(10) rfw'.prj_simps(16) span_data.simps(2))
 
               have Chn_\<rho>w: "\<guillemotleft>\<rho>w.chine : ?R \<down>\<down> ?w1 \<rightarrow>\<^sub>C k0 \<down>\<down> ?w1\<guillemotright>"
                 using \<rho>w.chine_composite_in_hom by simp
               have Chn_\<rho>w_eq: "\<rho>w.chine = \<langle>\<rho>.chine \<cdot> ?p1 \<lbrakk>k0, ?w1\<rbrakk> ?p0\<rangle>"
                 using \<rho>w.chine_composite C.comp_cod_arr ide_w
                 by (simp add: chine_hcomp_arr_ide hcomp_def)
               have Chn_\<rho>w': "\<guillemotleft>\<rho>w'.chine : ?R \<down>\<down> ?w1' \<rightarrow>\<^sub>C k0 \<down>\<down> ?w1'\<guillemotright>"
                 using \<rho>w'.chine_composite_in_hom by simp
               have Chn_\<rho>w'_eq: "\<rho>w'.chine = \<langle>\<rho>.chine \<cdot> ?p1' \<lbrakk>k0, ?w1'\<rbrakk> ?p0'\<rangle>"
                 using \<rho>w'.chine_composite C.comp_cod_arr ide_w' Dom_\<rho>_0 Cod_\<rho>_0
                 by (metis \<rho>w'.composite_is_arrow chine_hcomp_arr_ide chine_hcomp_def hseq_char
                     w'.cod_simps(3))
 
               text \<open>
                 The following are some collected commutativity properties that are used
                 subsequently.
               \<close>
               have "C.commutative_square r0 ?u1 ?p1 \<theta>.chine"
                 using ru.legs_form_cospan(1) Dom_\<theta>.is_span Dom_\<theta>_1 Cod_\<theta>_1 \<theta>.leg1_commutes
                 apply (intro C.commutative_squareI) by auto
               have "C.commutative_square r0 ?u1 (?p1' \<cdot> \<beta>.chine) (\<theta>'.chine \<cdot> \<beta>.chine)"
               proof
                 have 1: "r0 \<cdot> ?p1' = ?u1 \<cdot> \<theta>'.chine"
                   using \<theta>'.leg1_commutes Cod_\<theta>'_1 Dom_\<theta>'_1 fw'.leg1_composite by simp
                 show "C.cospan r0 ?u1"
                   using ru.legs_form_cospan(1) by blast
                 show "C.span (?p1' \<cdot> \<beta>.chine) (\<theta>'.chine \<cdot> \<beta>.chine)"
                   using \<beta>.chine_in_hom \<theta>'.chine_in_hom
                   by (metis "1" C.dom_comp C.in_homE C.prj1_simps(1) C.prj1_simps(2)
                       C.seqI Cod_\<theta>'_1 Dom_\<theta>'.leg_simps(3) Chn_\<beta> \<theta>'.leg1_commutes cospan')
                 show "C.dom r0 = C.cod (?p1' \<cdot> \<beta>.chine)"
                   using \<beta>.chine_in_hom
                   by (metis C.cod_comp C.prj1_simps(3)
                       \<open>C.span (?p1' \<cdot> \<beta>.chine) (\<theta>'.chine \<cdot> \<beta>.chine)\<close>
                       cospan' r.dom.apex_def r.chine_eq_apex r.chine_simps(2))
                 show "r0 \<cdot> ?p1' \<cdot> \<beta>.chine = ?u1 \<cdot> \<theta>'.chine \<cdot> \<beta>.chine"
                   using 1 \<beta>.chine_in_hom C.comp_assoc by metis
               qed
               have "C.commutative_square r0 ?u1 \<p>\<^sub>1[r0, r0 \<cdot> ?p1] (\<theta>.chine \<cdot> \<p>\<^sub>0[r0, r0 \<cdot> ?p1])"
                 using ru.legs_form_cospan(1) Dom_\<theta>.is_span Dom_\<theta>_1
                       C.comp_assoc C.pullback_commutes' r\<theta>.legs_form_cospan(1)
                 apply (intro C.commutative_squareI)
                    apply auto
                 by (metis C.comp_assoc Cod_\<theta>_1 \<theta>.leg1_commutes)
               hence "C.commutative_square r0 ?u1 \<p>\<^sub>1[r0, r0 \<cdot> ?p1] (\<theta>.chine \<cdot> \<p>\<^sub>0[r0, r0 \<cdot> ?p1])"
                 using fw.leg1_composite by auto
               have "C.commutative_square r0 ?u1 \<p>\<^sub>1[r0, r0 \<cdot> ?p1'] (\<theta>'.chine \<cdot> \<p>\<^sub>0[r0, r0 \<cdot> ?p1'])"
                 using C.tuple_is_extensional Chn_r\<theta>'_eq r\<theta>'.chine_simps(1) fw' by force
               have "C.commutative_square ra ?w1 rfw.Prj\<^sub>0\<^sub>1 rfw.Prj\<^sub>0"
                 using C.pullback_commutes' gw.legs_form_cospan(1) rfw.prj_simps(2) C.comp_assoc
                       C.comp_cod_arr
                 apply (intro C.commutative_squareI) by auto
               have "C.commutative_square ?R ?w1' rfw'.Prj\<^sub>0\<^sub>1 rfw'.Prj\<^sub>0"
                 using cospan'
                 apply (intro C.commutative_squareI)
                    apply simp_all
                 by (metis C.comp_assoc C.prj0_simps_arr C.pullback_commutes'
                     arrow_of_spans_data.select_convs(2) rfw'.prj_simps(3)
                     span_data.select_convs(1-2))
               have "C.commutative_square r0 (r0 \<cdot> ?p1) rfw.Prj\<^sub>1\<^sub>1 \<langle>rfw.Prj\<^sub>0\<^sub>1 \<lbrakk>ra, ?w1\<rbrakk> rfw.Prj\<^sub>0\<rangle>"
               proof -
                 have "C.arr rfw.chine_assoc"
                   by (metis C.seqE rfw.prj_chine_assoc(1) rfw.prj_simps(1))
                 thus ?thesis
                   using C.tuple_is_extensional rfw.chine_assoc_def by fastforce
               qed
               have "C.commutative_square r0 (r0 \<cdot> ?p1') rfw'.Prj\<^sub>1\<^sub>1 \<langle>rfw'.Prj\<^sub>0\<^sub>1 \<lbrakk>ra, ?w1'\<rbrakk> rfw'.Prj\<^sub>0\<rangle>"
                 by (metis (no_types, lifting) C.not_arr_null C.seqE C.tuple_is_extensional
                     arrow_of_spans_data.select_convs(2) rfw'.chine_assoc_def
                     rfw'.prj_chine_assoc(1) rfw'.prj_simps(1) span_data.select_convs(1-2))
               have "C.commutative_square k0 ?w1 (\<rho>.chine \<cdot> ?p1) ?p0"
                 using C.tuple_is_extensional Chn_\<rho>w_eq \<rho>w.chine_simps(1) by fastforce
               have "C.commutative_square k0 ?w1' (\<rho>.chine \<cdot> ?p1') (w'.chine \<cdot> ?p0')"
                 using C.tuple_is_extensional \<rho>w'.chine_composite \<rho>w'.chine_simps(1) by force
               have "C.commutative_square k0 ?w1' (\<rho>.chine \<cdot> ?p1') ?p0'"
                 using C.tuple_is_extensional Chn_\<rho>w'_eq \<rho>w'.chine_simps(1) by force
               text \<open>
                 Now, derive the consequences of the equation:
                 \[
                   \<open>(r \<star> \<theta>) \<bullet> \<a>[r, ?f, w] \<bullet> (?\<rho> \<star> w) = (r \<star> \<theta>') \<bullet> \<a>[r, ?f, w'] \<bullet> (?\<rho> \<star> w') \<bullet> \<beta>\<close>
                 \]
                 The strategy is to expand and simplify the left and right hand side to tuple form,
                 then compose with projections and equate corresponding components.
 
                 We first work on the right-hand side.
               \<close>
               have R: "Chn (T.composite_cell w' \<theta>' \<bullet> \<beta>) =
                        \<langle>?p1' \<cdot> \<beta>.chine \<lbrakk>r0, ?u1\<rbrakk> \<theta>'.chine \<cdot> \<beta>.chine\<rangle>"
               proof -
                 have "Chn (T.composite_cell w' \<theta>' \<bullet> \<beta>) =
                       r\<theta>'.chine \<cdot> Chn \<a>[r, f, w'] \<cdot> \<rho>w'.chine \<cdot> \<beta>.chine"
                 proof -
                   have 1: "\<guillemotleft>T.composite_cell w' \<theta>' \<bullet> \<beta> : g \<star> w \<Rightarrow> r \<star> u\<guillemotright>"
                     using \<beta> \<rho>w' arfw' r\<theta>' by auto
                   have "Chn (T.composite_cell w' \<theta>' \<bullet> \<beta>) = Chn (T.composite_cell w' \<theta>') \<cdot> \<beta>.chine"
                     using 1 Chn_vcomp by blast
                   also have "... = (r\<theta>'.chine \<cdot> Chn (\<a>[r, f, w'] \<bullet> (\<rho> \<star> w'))) \<cdot> \<beta>.chine"
                   proof -
                     have "seq (r \<star> \<theta>') (\<a>[r, f, w'] \<bullet> (\<rho> \<star> w'))"
                       using 1 by blast
                     thus ?thesis
                       using 1 Chn_vcomp by presburger
                   qed
                   also have "... = (r\<theta>'.chine \<cdot> Chn \<a>[r, f, w'] \<cdot> \<rho>w'.chine) \<cdot> \<beta>.chine"
                   proof -
                     have "seq \<a>[r, f, w'] (\<rho> \<star> w')"
                       using 1 by blast
                     thus ?thesis
                       using 1 Chn_vcomp by presburger
                   qed
                   finally show ?thesis
                     using C.comp_assoc by auto
                 qed
                 also have "... = \<langle>?p1' \<cdot> \<beta>.chine \<lbrakk>r0, ?u1\<rbrakk> \<theta>'.chine \<cdot> \<beta>.chine\<rangle>"
                 proof -
                   let ?LHS = "r\<theta>'.chine \<cdot> Chn \<a>[r, f, w'] \<cdot> \<rho>w'.chine \<cdot> \<beta>.chine"
                   let ?RHS = "\<langle>?p1' \<cdot> \<beta>.chine \<lbrakk>r0, ?u1\<rbrakk> \<theta>'.chine \<cdot> \<beta>.chine\<rangle>"
          
                   have LHS: "\<guillemotleft>?LHS : ?R \<down>\<down> ?w1 \<rightarrow>\<^sub>C r\<theta>'.cod.apex\<guillemotright>"
                   proof (intro C.comp_in_homI)
                     show "\<guillemotleft>\<beta>.chine : ?R \<down>\<down> ?w1 \<rightarrow>\<^sub>C ?R \<down>\<down> ?w1'\<guillemotright>"
                       using Chn_\<beta> by simp
                     show "\<guillemotleft>\<rho>w'.chine : ?R \<down>\<down> ?w1' \<rightarrow>\<^sub>C Cod_\<rho>.leg0 \<down>\<down> w'.cod.leg1\<guillemotright>"
                       using Chn_\<rho>w' by simp
                     show "\<guillemotleft>Chn \<a>[r, f, w'] : Cod_\<rho>.leg0 \<down>\<down> w'.cod.leg1 \<rightarrow>\<^sub>C rfw'.chine\<guillemotright>"
                       using arfw'
                       by (metis (no_types, lifting) Chn_in_hom Cod_\<rho>_0
                           arrow_of_spans_data.simps(2) rf rf.leg0_composite rfw'.chine_composite(1)
                           span_data.select_convs(1) w'.cod_simps(3))
                     show "\<guillemotleft>r\<theta>'.chine : rfw'.chine \<rightarrow>\<^sub>C r\<theta>'.cod.apex\<guillemotright>"
                       using Chn_r\<theta>' by auto
                   qed
                   have 2: "C.commutative_square r0 ?u1
                              (?p1' \<cdot> \<beta>.chine) (\<theta>'.chine \<cdot> \<beta>.chine)"
                     by fact
                   have RHS: "\<guillemotleft>?RHS : ?R \<down>\<down> ?w1 \<rightarrow>\<^sub>C r\<theta>'.cod.apex\<guillemotright>"
                     using 2 Chn_\<beta> r\<theta>'_cod_apex_eq
                           C.tuple_in_hom [of r0 ?u1 "?p1' \<cdot> \<beta>.chine" "\<theta>'.chine \<cdot> \<beta>.chine"]
                     by fastforce
 
                   show ?thesis
                   proof (intro C.prj_joint_monic [of r0 ?u1 ?LHS ?RHS])
                     show "C.cospan r0 ?u1"
                       using ru.legs_form_cospan(1) by blast
                     show "C.seq ru.prj\<^sub>1 ?LHS"
                       using LHS r\<theta>'_cod_apex_eq by auto
                     show "C.seq ru.prj\<^sub>1 ?RHS"
                       using RHS r\<theta>'_cod_apex_eq by auto
                     show "ru.prj\<^sub>0 \<cdot> ?LHS = ru.prj\<^sub>0 \<cdot> ?RHS"
                     proof -
                       have "ru.prj\<^sub>0 \<cdot> ?LHS =
                             (ru.prj\<^sub>0 \<cdot> r\<theta>'.chine) \<cdot> Chn \<a>[r, f, w'] \<cdot> \<rho>w'.chine \<cdot> \<beta>.chine"
                         using C.comp_assoc by simp
                       also have "... = ((\<theta>'.chine \<cdot> \<p>\<^sub>0[r0, r0 \<cdot> ?p1']) \<cdot> Chn \<a>[r, f, w']) \<cdot>
                                          \<rho>w'.chine \<cdot> \<beta>.chine"
                         using Chn_r\<theta>'_eq C.comp_assoc fw'
                               \<open>C.commutative_square r0 ?u1 \<p>\<^sub>1[r0, r0 \<cdot> ?p1']
                                   (\<theta>'.chine \<cdot> \<p>\<^sub>0[r0, r0 \<cdot> ?p1'])\<close>
                         by simp
                       also have "... = \<theta>'.chine \<cdot> (\<p>\<^sub>0[r0, r0 \<cdot> ?p1'] \<cdot> Chn \<a>[r, f, w']) \<cdot>
                                          \<rho>w'.chine \<cdot> \<beta>.chine"
                         using C.comp_assoc by simp
                       also have "... = \<theta>'.chine \<cdot> (\<langle>rfw'.Prj\<^sub>0\<^sub>1 \<lbrakk>?R, ?w1'\<rbrakk> rfw'.Prj\<^sub>0\<rangle> \<cdot> \<rho>w'.chine) \<cdot>
                                          \<beta>.chine"
                         using ide_f hseq_rf hseq_char \<alpha>_ide C.comp_assoc
                               rfw'.chine_assoc_def fw'.leg1_composite C.prj_tuple(1)
                               \<open>C.commutative_square r0 (r0 \<cdot> ?p1')
                                  rfw'.Prj\<^sub>1\<^sub>1 \<langle>rfw'.Prj\<^sub>0\<^sub>1 \<lbrakk>?R, ?w1'\<rbrakk> rfw'.Prj\<^sub>0\<rangle>\<close>
                         by simp
                       also have "... = \<theta>'.chine \<cdot> \<beta>.chine"
                       proof -
                         have "\<langle>rfw'.Prj\<^sub>0\<^sub>1 \<lbrakk>?R, ?w1'\<rbrakk> rfw'.Prj\<^sub>0\<rangle> \<cdot> \<rho>w'.chine = gw'.apex"
                         proof (intro C.prj_joint_monic
                                        [of ?R ?w1' "\<langle>rfw'.Prj\<^sub>0\<^sub>1 \<lbrakk>?R, ?w1'\<rbrakk> rfw'.Prj\<^sub>0\<rangle> \<cdot> \<rho>w'.chine"
                                            gw'.apex])
                           show "C.cospan ?R ?w1'"
                             using fw'.legs_form_cospan(1) by simp
                           show "C.seq ?p1' (\<langle>rfw'.Prj\<^sub>0\<^sub>1 \<lbrakk>?R, ?w1'\<rbrakk> rfw'.Prj\<^sub>0\<rangle> \<cdot> \<rho>w'.chine)"
                           proof (intro C.seqI' C.comp_in_homI)
                             show "\<guillemotleft>\<rho>w'.chine : Dom_\<rho>.leg0 \<down>\<down> w'.leg1 \<rightarrow>\<^sub>C Cod_\<rho>.leg0 \<down>\<down> w'.cod.leg1\<guillemotright>"
                               using \<rho>w'.chine_composite_in_hom by simp
                             show "\<guillemotleft>\<langle>rfw'.Prj\<^sub>0\<^sub>1 \<lbrakk>?R, w'.leg1\<rbrakk> rfw'.Prj\<^sub>0\<rangle> :
                                       Cod_\<rho>.leg0 \<down>\<down> w'.cod.leg1 \<rightarrow>\<^sub>C ?R \<down>\<down> w'.leg1\<guillemotright>"
                               using \<open>C.commutative_square ?R ?w1' rfw'.Prj\<^sub>0\<^sub>1 rfw'.Prj\<^sub>0\<close>
                                     C.tuple_in_hom [of ?R ?w1' rfw'.Prj\<^sub>0\<^sub>1 rfw'.Prj\<^sub>0]
                                     rf rf.leg0_composite
                               by auto
                             show "\<guillemotleft>?p1' : ?R \<down>\<down> w'.leg1 \<rightarrow>\<^sub>C f.apex\<guillemotright>"
                               using fw'.prj_in_hom(1) by auto
                           qed
                           show "C.seq ?p1' gw'.apex"
                             using gw'.dom.apex_def gw'.leg0_composite fw'.prj_in_hom by auto
                           show "?p0' \<cdot> \<langle>rfw'.Prj\<^sub>0\<^sub>1 \<lbrakk>?R, ?w1'\<rbrakk> rfw'.Prj\<^sub>0\<rangle> \<cdot> \<rho>w'.chine =
                                          ?p0' \<cdot> gw'.apex"
                           proof -
                             have "?p0' \<cdot> \<langle>rfw'.Prj\<^sub>0\<^sub>1 \<lbrakk>?R, ?w1'\<rbrakk> rfw'.Prj\<^sub>0\<rangle> \<cdot> \<rho>w'.chine =
                                   (?p0' \<cdot> \<langle>rfw'.Prj\<^sub>0\<^sub>1 \<lbrakk>?R, ?w1'\<rbrakk> rfw'.Prj\<^sub>0\<rangle>) \<cdot> \<rho>w'.chine"
                               using C.comp_assoc by simp
                             also have "... = rfw'.Prj\<^sub>0 \<cdot> \<rho>w'.chine"
                               using \<open>C.commutative_square ?R ?w1' rfw'.Prj\<^sub>0\<^sub>1 rfw'.Prj\<^sub>0\<close> by auto
                             also have
                               "... = \<p>\<^sub>0[k0, ?w1'] \<cdot> \<langle>\<rho>.chine \<cdot> ?p1' \<lbrakk>k0, ?w1'\<rbrakk> w'.chine \<cdot> ?p0'\<rangle>"
                               using \<rho>w'.chine_composite Dom_\<rho>_0 Cod_\<rho>_0 C.comp_cod_arr by simp
                             also have "... = w'.chine \<cdot> ?p0'"
                               using \<open>C.commutative_square k0 ?w1'
                                       (\<rho>.chine \<cdot> ?p1') (w'.chine \<cdot> ?p0')\<close>
                               by simp
                             also have "... = ?p0' \<cdot> gw'.apex"
                               using cospan C.comp_cod_arr C.comp_arr_dom gw'.chine_is_identity
                                     gw'.chine_eq_apex gw'.chine_composite fw'.prj_in_hom
                               by auto
                             finally show ?thesis by simp
                           qed
                           show "?p1' \<cdot> \<langle>rfw'.Prj\<^sub>0\<^sub>1 \<lbrakk>ra, ?w1'\<rbrakk> rfw'.Prj\<^sub>0\<rangle> \<cdot> \<rho>w'.chine =
                                          ?p1' \<cdot> gw'.apex"
                           proof -
                             have "?p1' \<cdot> \<langle>rfw'.Prj\<^sub>0\<^sub>1 \<lbrakk>ra, ?w1'\<rbrakk> rfw'.Prj\<^sub>0\<rangle> \<cdot> \<rho>w'.chine =
                                   (?p1' \<cdot> \<langle>rfw'.Prj\<^sub>0\<^sub>1 \<lbrakk>ra, ?w1'\<rbrakk> rfw'.Prj\<^sub>0\<rangle>) \<cdot> \<rho>w'.chine"
                               using C.comp_assoc by simp
                             also have "... = rfw'.Prj\<^sub>0\<^sub>1 \<cdot> \<rho>w'.chine"
                               using \<open>C.commutative_square ?R ?w1' rfw'.Prj\<^sub>0\<^sub>1 rfw'.Prj\<^sub>0\<close> by simp
                             also have
                               "... = k0 \<cdot> \<p>\<^sub>1[k0, ?w1'] \<cdot> \<langle>\<rho>.chine \<cdot> ?p1' \<lbrakk>k0, ?w1'\<rbrakk> w'.chine \<cdot> ?p0'\<rangle>"
                               using \<rho>w'.chine_composite Cod_\<rho>_0 C.comp_assoc C.comp_cod_arr
                               by simp
                             also have "... = k0 \<cdot> \<rho>.chine \<cdot> ?p1'"
                               using \<open>C.commutative_square k0 ?w1'
                                       (\<rho>.chine \<cdot> ?p1') (w'.chine \<cdot> ?p0')\<close>
                               by simp
                             also have "... = (k0 \<cdot> \<rho>.chine) \<cdot> ?p1'"
                               using C.comp_assoc by metis
                             also have "... = ?p1'"
                               using \<rho>.leg0_commutes C.comp_cod_arr cospan' by simp
                             also have "... = ?p1' \<cdot> gw'.apex"
                               using C.comp_arr_dom cospan' gw'.chine_eq_apex gw'.chine_composite
                               by simp
                             finally show ?thesis by simp
                           qed
                         qed
                         thus ?thesis
                           using Chn_\<beta> C.comp_cod_arr gw'.apex_composite by auto
                       qed
                       also have "... = \<p>\<^sub>0[r0, ?u1] \<cdot> ?RHS"
                         using RHS 2 C.prj_tuple [of r0 ?u1] by simp
                       finally show ?thesis by simp
                     qed
                     show "ru.prj\<^sub>1 \<cdot> ?LHS = ru.prj\<^sub>1 \<cdot> ?RHS"
                     proof -
                       have "ru.prj\<^sub>1 \<cdot> ?LHS =
                             (ru.prj\<^sub>1 \<cdot> r\<theta>'.chine) \<cdot> Chn \<a>[r, f, w'] \<cdot> \<rho>w'.chine \<cdot> \<beta>.chine"
                         using C.comp_assoc by simp
                       also have "... = \<p>\<^sub>1[r0, fw'.leg1] \<cdot> Chn \<a>[r, f, w'] \<cdot> \<rho>w'.chine \<cdot> \<beta>.chine"
                         using Chn_r\<theta>' Chn_r\<theta>'_eq fw'
                               \<open>C.commutative_square r0 ?u1 \<p>\<^sub>1[r0, r0 \<cdot> ?p1']
                                  (\<theta>'.chine \<cdot> \<p>\<^sub>0[r0, r0 \<cdot> ?p1'])\<close>
                         by simp
                       also have "... = (rfw'.Prj\<^sub>1 \<cdot> rfw'.chine_assoc) \<cdot> \<rho>w'.chine \<cdot> \<beta>.chine"
                         using ide_f ide_w' hseq_rf hseq_char \<alpha>_ide fw'.leg1_composite C.comp_assoc
                         by auto
                       also have "... = (rfw'.Prj\<^sub>1\<^sub>1 \<cdot> \<rho>w'.chine) \<cdot> \<beta>.chine"
                         using rfw'.prj_chine_assoc C.comp_assoc by simp
                       also have "... = ((k1 \<cdot> \<p>\<^sub>1[k0, ?w1']) \<cdot> \<rho>w'.chine) \<cdot> \<beta>.chine"
                         using C.comp_cod_arr by simp
                       also have "... = (k1 \<cdot> \<p>\<^sub>1[k0, ?w1'] \<cdot> \<rho>w'.chine) \<cdot> \<beta>.chine"
                         using C.comp_assoc by simp
                       also have "... = (k1 \<cdot> \<rho>.chine \<cdot> ?p1') \<cdot> \<beta>.chine"
                         using Chn_\<rho>w'_eq Dom_\<rho>_0 Cod_\<rho>_0
                               \<open>C.commutative_square k0 ?w1' (\<rho>.chine \<cdot> ?p1') ?p0'\<close>
                         by simp
                       also have "... = (k1 \<cdot> \<rho>.chine) \<cdot> ?p1' \<cdot> \<beta>.chine"
                         using C.comp_assoc by metis
                       also have "... = (?R \<cdot> ?p1') \<cdot> \<beta>.chine"
                         using C.comp_assoc by simp
                       also have "... = ?p1' \<cdot> \<beta>.chine"
                         using C.comp_cod_arr C.prj1_in_hom [of ?R ?w1'] cospan' by simp
                      also have "... = ru.prj\<^sub>1 \<cdot> ?RHS"
                         using RHS 2 by simp
                       finally show ?thesis by simp
                     qed
                   qed
                 qed
                 finally show ?thesis by simp
               qed
 
               text \<open>
                 Now we work on the left-hand side.
               \<close>
               have L: "Chn (T.composite_cell w \<theta>) = \<langle>?p1 \<lbrakk>r0, ?u1\<rbrakk> \<theta>.chine\<rangle>"
               proof -
                 have "Chn (T.composite_cell w \<theta>) = r\<theta>.chine \<cdot> Chn \<a>[r, f, w] \<cdot> \<rho>w.chine"
                   using Chn_vcomp arfw C.comp_assoc by auto
                 moreover have "... = \<langle>?p1 \<lbrakk>r0, ?u1\<rbrakk> \<theta>.chine\<rangle>"
                 proof -
                   let ?LHS = "r\<theta>.chine \<cdot> Chn \<a>[r, f, w] \<cdot> \<rho>w.chine"
                   let ?RHS = "\<langle>?p1 \<lbrakk>r0, ?u1\<rbrakk> \<theta>.chine\<rangle>"
                   have 2: "C.commutative_square r0 ?u1 ?p1 \<theta>.chine" by fact
                   have LHS: "\<guillemotleft>?LHS : ?R \<down>\<down> ?w1 \<rightarrow>\<^sub>C r0 \<down>\<down> ?u1\<guillemotright>"
                     using Chn_r\<theta> Chn_\<rho>w rfw.chine_assoc_in_hom
                     by (metis (no_types, lifting) "8" Chn_in_hom Dom_\<rho>_0
                         arrow_of_spans_data.simps(2) calculation gw.chine_composite
                         r\<theta>_cod_apex_eq ru.chine_composite)
                   have RHS: "\<guillemotleft>?RHS : ?R \<down>\<down> ?w1 \<rightarrow>\<^sub>C r0 \<down>\<down> ?u1\<guillemotright>"
                     using 2 C.tuple_in_hom [of r0 ?u1 "?p1" \<theta>.chine] cospan r\<theta>_cod_apex_eq
                     by simp
                   show ?thesis
                   proof (intro C.prj_joint_monic [of r0 ?u1 ?LHS ?RHS])
                     show "C.cospan r0 ?u1"
                       using ru.legs_form_cospan(1) by blast
                     show "C.seq ru.prj\<^sub>1 ?LHS"
                       using LHS r\<theta>_cod_apex_eq by auto
                     show "C.seq ru.prj\<^sub>1 ?RHS"
                       using RHS r\<theta>_cod_apex_eq by auto
                     show "ru.prj\<^sub>0 \<cdot> ?LHS = ru.prj\<^sub>0 \<cdot> ?RHS"
                     proof -
                       have "ru.prj\<^sub>0 \<cdot> ?LHS = (ru.prj\<^sub>0 \<cdot> r\<theta>.chine) \<cdot> Chn \<a>[r, f, w] \<cdot> \<rho>w.chine"
                         using C.comp_assoc by simp
                       also have "... = (\<theta>.chine \<cdot> \<p>\<^sub>0[r0, f.leg1 \<cdot> fw.prj\<^sub>1]) \<cdot>
                                          Chn \<a>[r, f, w] \<cdot> \<rho>w.chine"
                         using Chn_r\<theta>_eq Dom_\<theta>_1 Cod_\<theta>_1 fw.leg1_composite
                               \<open>C.commutative_square r0 ?u1 \<p>\<^sub>1[r0, r0 \<cdot> ?p1]
                                  (\<theta>.chine \<cdot> \<p>\<^sub>0[r0, r0 \<cdot> ?p1])\<close>
                         by simp
                       also have "... = \<theta>.chine \<cdot> (\<p>\<^sub>0[r0, r0 \<cdot> ?p1] \<cdot> Chn \<a>[r, f, w]) \<cdot> \<rho>w.chine"
                         using C.comp_assoc by simp
                       also have "... = \<theta>.chine \<cdot> \<langle>rfw.Prj\<^sub>0\<^sub>1 \<lbrakk>?R, ?w1\<rbrakk> rfw.Prj\<^sub>0\<rangle> \<cdot> \<rho>w.chine"
                       proof -
                         have "Chn \<a>[r, f, w] = rfw.chine_assoc"
                           using ide_f ide_w hseq_rf hseq_char \<alpha>_ide by auto
                         moreover have "\<p>\<^sub>0[r0, r0 \<cdot> ?p1] \<cdot> rfw.chine_assoc =
                                        \<langle>rfw.Prj\<^sub>0\<^sub>1 \<lbrakk>?R, ?w1\<rbrakk> rfw.Prj\<^sub>0\<rangle>"
                           using rfw.chine_assoc_def
                                 \<open>C.commutative_square r0 (r0 \<cdot> ?p1) rfw.Prj\<^sub>1\<^sub>1
                                    \<langle>rfw.Prj\<^sub>0\<^sub>1 \<lbrakk>?R, ?w1\<rbrakk> rfw.Prj\<^sub>0\<rangle>\<close>
                           by simp
                         ultimately show ?thesis by simp
                       qed
                       also have "... = \<theta>.chine \<cdot> (?R \<down>\<down> ?w1)"
                       proof -
                         have "\<langle>rfw.Prj\<^sub>0\<^sub>1 \<lbrakk>?R, ?w1\<rbrakk> rfw.Prj\<^sub>0\<rangle> \<cdot> \<rho>w.chine = ?R \<down>\<down> ?w1"
                         proof (intro C.prj_joint_monic
                                        [of ?R ?w1 "\<langle>rfw.Prj\<^sub>0\<^sub>1 \<lbrakk>?R, ?w1\<rbrakk> rfw.Prj\<^sub>0\<rangle> \<cdot> \<rho>w.chine"
                                            "?R \<down>\<down> ?w1"])
                           show "C.cospan ?R ?w1" by fact
                           show "C.seq ?p1 (\<langle>rfw.Prj\<^sub>0\<^sub>1 \<lbrakk>?R, ?w1\<rbrakk> rfw.Prj\<^sub>0\<rangle> \<cdot> \<rho>w.chine)"
                           proof -
                             have "C.seq rfw.Prj\<^sub>0\<^sub>1 \<rho>w.chine"
                               by (meson C.seqI' Chn_in_hom \<rho>w rfw.prj_in_hom(2)
                                   \<open>C.commutative_square ?R ?w1 rfw.Prj\<^sub>0\<^sub>1 rfw.Prj\<^sub>0\<close>)
                             thus ?thesis
                               using \<open>C.commutative_square ?R ?w1 rfw.Prj\<^sub>0\<^sub>1 rfw.Prj\<^sub>0\<close>
                               by (metis (no_types) C.comp_assoc C.prj_tuple(2))
                           qed
                           show "C.seq ?p1 (?R \<down>\<down> ?w1)"
                             using gw.dom.apex_def gw.leg0_composite gw.prj_in_hom by auto
                           show "?p0 \<cdot> \<langle>rfw.Prj\<^sub>0\<^sub>1 \<lbrakk>?R, ?w1\<rbrakk> rfw.Prj\<^sub>0\<rangle> \<cdot> \<rho>w.chine =
                                 ?p0 \<cdot> (?R \<down>\<down> ?w1)"
                           proof -
                             have "?p0 \<cdot> \<langle>rfw.Prj\<^sub>0\<^sub>1 \<lbrakk>?R, ?w1\<rbrakk> rfw.Prj\<^sub>0\<rangle> \<cdot> \<rho>w.chine =
                                   (?p0 \<cdot> \<langle>rfw.Prj\<^sub>0\<^sub>1 \<lbrakk>?R, ?w1\<rbrakk> rfw.Prj\<^sub>0\<rangle>) \<cdot> \<rho>w.chine"
                               using C.comp_assoc by simp
                             also have "... = rfw.Prj\<^sub>0 \<cdot> \<rho>w.chine"
                               using \<open>C.commutative_square ?R ?w1 rfw.Prj\<^sub>0\<^sub>1 rfw.Prj\<^sub>0\<close> by simp
                             also have "... = \<p>\<^sub>0[k0, ?w1] \<cdot> \<langle>\<rho>.chine \<cdot> ?p1 \<lbrakk>k0, ?w1\<rbrakk> ?p0\<rangle>"
                               using Chn_\<rho>w_eq C.comp_cod_arr by simp
                             also have "... = ?p0"
                               using \<open>C.commutative_square k0 ?w1 (\<rho>.chine \<cdot> ?p1) ?p0\<close>
                                     C.prj_tuple(1)
                               by blast
                             also have "... = ?p0 \<cdot> (?R \<down>\<down> ?w1)"
                               using C.comp_arr_dom gw.chine_eq_apex gw.chine_is_identity
                               by (metis C.arr_dom_iff_arr C.pbdom_def Dom_g gw.chine_composite
                                   gw.chine_simps(1) span_data.select_convs(1))
                             finally show ?thesis by simp
                           qed
                           show "?p1 \<cdot> \<langle>rfw.Prj\<^sub>0\<^sub>1 \<lbrakk>?R, ?w1\<rbrakk> rfw.Prj\<^sub>0\<rangle> \<cdot> \<rho>w.chine =
                                 ?p1 \<cdot> (?R \<down>\<down> ?w1)"
                           proof -
                             have "?p1 \<cdot> \<langle>rfw.Prj\<^sub>0\<^sub>1 \<lbrakk>?R, ?w1\<rbrakk> rfw.Prj\<^sub>0\<rangle> \<cdot> \<rho>w.chine =
                                   (?p1 \<cdot> \<langle>rfw.Prj\<^sub>0\<^sub>1 \<lbrakk>?R, ?w1\<rbrakk> rfw.Prj\<^sub>0\<rangle>) \<cdot> \<rho>w.chine"
                               using C.comp_assoc by simp
                             also have "... = rfw.Prj\<^sub>0\<^sub>1 \<cdot> \<rho>w.chine"
                               using \<open>C.commutative_square ?R ?w1 rfw.Prj\<^sub>0\<^sub>1 rfw.Prj\<^sub>0\<close> by simp
                             also have "... = (k0 \<cdot> \<p>\<^sub>1[k0, ?w1]) \<cdot> \<langle>\<rho>.chine \<cdot> ?p1 \<lbrakk>k0, ?w1\<rbrakk> ?p0\<rangle>"
                               using Chn_\<rho>w_eq C.comp_cod_arr by simp
                             also have "... = k0 \<cdot> \<p>\<^sub>1[k0, ?w1] \<cdot> \<langle>\<rho>.chine \<cdot> ?p1 \<lbrakk>k0, ?w1\<rbrakk> ?p0\<rangle>"
                               using C.comp_assoc by simp
                             also have "... = k0 \<cdot> \<rho>.chine \<cdot> ?p1"
                               using \<open>C.commutative_square k0 ?w1 (\<rho>.chine \<cdot> ?p1) ?p0\<close> by simp
                             also have "... = (k0 \<cdot> \<rho>.chine) \<cdot> ?p1"
                               using C.comp_assoc by metis
                             also have "... = ?p1 \<cdot> (?R \<down>\<down> ?w1)"
                               using C.comp_arr_dom C.comp_cod_arr cospan by simp
                             finally show ?thesis by blast
                           qed
                         qed
                         thus ?thesis by simp
                       qed
                       also have "... = \<theta>.chine"
                         using C.comp_arr_dom \<theta>.chine_in_hom gw.chine_eq_apex gw.chine_is_identity
                               Dom_\<theta>_0 Cod_\<theta>_0 Dom_\<theta>.apex_def Cod_\<theta>.apex_def
                         by (metis Dom_g \<theta>.chine_simps(1) \<theta>.chine_simps(2) gw.chine_composite
                             gw.dom.apex_def gw.leg0_composite span_data.select_convs(1))
                       also have "... = ru.prj\<^sub>0 \<cdot> ?RHS"
                         using 2 by simp
                       finally show ?thesis by blast
                     qed
                     show "ru.prj\<^sub>1 \<cdot> ?LHS = ru.prj\<^sub>1 \<cdot> ?RHS"
                     proof -
                       have "ru.prj\<^sub>1 \<cdot> ?LHS = (ru.prj\<^sub>1 \<cdot> r\<theta>.chine) \<cdot> Chn \<a>[r, f, w] \<cdot> \<rho>w.chine"
                         using C.comp_assoc by simp
                       also have "... = (r.chine \<cdot> \<p>\<^sub>1[r0, r0 \<cdot> ?p1]) \<cdot> Chn \<a>[r, f, w] \<cdot> \<rho>w.chine"
                       proof -
                         have "r\<theta>.chine \<noteq> C.null \<Longrightarrow>
                                 \<p>\<^sub>1[r.cod.leg0, Cod_\<theta>.leg1] \<cdot> r\<theta>.chine =
                                 r.chine \<cdot> \<p>\<^sub>1[r0, Dom_\<theta>.leg1]"
                           by (metis (lifting) C.prj_tuple(2) C.tuple_is_extensional r.cod_simps(2)
                               r\<theta>.chine_composite)
                         thus ?thesis
                           using Cod_\<theta>_1 Dom_\<theta>_1 r\<theta>.chine_simps(1) fw by fastforce
                       qed
                       also have "... = r.chine \<cdot> (rfw.Prj\<^sub>1 \<cdot> Chn \<a>[r, f, w]) \<cdot> \<rho>w.chine"
                         using C.comp_assoc fw.leg1_composite by simp
                       also have "... = r.chine \<cdot> rfw.Prj\<^sub>1\<^sub>1 \<cdot> \<rho>w.chine"
                         using ide_f ide_w hseq_rf hseq_char \<alpha>_ide
                               rfw.prj_chine_assoc(1)
                         by auto
                       also have "... = r.chine \<cdot> k1 \<cdot> \<p>\<^sub>1[k0, ?w1] \<cdot> \<rho>w.chine"
                         using C.comp_cod_arr C.comp_assoc by simp
                       also have "... = r.chine \<cdot> k1 \<cdot> \<rho>.chine \<cdot> \<p>\<^sub>1[Dom_\<rho>.leg0, ?w1]"
                         using Chn_\<rho>w_eq
                               \<open>C.commutative_square k0 ?w1
                                 (\<rho>.chine \<cdot> \<p>\<^sub>1[ra, w.leg1]) \<p>\<^sub>0[ra, w.leg1]\<close>
                         by auto
                       also have "... = r.chine \<cdot> (k1 \<cdot> \<rho>.chine) \<cdot> ?p1"
                         using C.comp_assoc Dom_\<rho>_0 by metis
                       also have "... = r.chine \<cdot> ra \<cdot> ?p1"
                         by simp
                       also have "... = r.chine \<cdot> ?p1"
                         using C.comp_cod_arr
                         by (metis C.comp_assoc r.cod_simps(1) r.chine_eq_apex r.chine_simps(1)
                             r.chine_simps(3))
                       also have "... = ?p1"
                         using C.comp_cod_arr r.chine_eq_apex r.chine_is_identity
                         by (metis 2 C.commutative_squareE r.dom.apex_def)
                       also have "... = ru.prj\<^sub>1 \<cdot> ?RHS"
                         using 2 by simp
                       finally show ?thesis by simp
                     qed
                   qed
                 qed
                 ultimately show ?thesis
                   by simp
               qed
               text \<open>
                 This is the main point: the equation E boils down to the following:
                 \[
                    \<open>?p1' \<cdot> \<beta>.chine = ?p1 \<and> \<theta>'.chine \<cdot> \<beta>.chine = \<theta>.chine\<close>
                 \]
                 The first equation gets us close to what we need, but we still need
                 \<open>?p1 \<cdot> C.inv ?p0 = ?w1\<close>, which follows from the fact that ?p0 is the
                 pullback of ?R.
               \<close>
               have *: "\<langle>?p1' \<cdot> \<beta>.chine \<lbrakk>r0, ?u1\<rbrakk> \<theta>'.chine \<cdot> \<beta>.chine\<rangle> = \<langle>?p1 \<lbrakk>r0, ?u1\<rbrakk> \<theta>.chine\<rangle>"
                 using L R E by simp
               have **: "?p1' \<cdot> \<beta>.chine = ?p1"
                 by (metis "*" C.in_homE C.not_arr_null C.prj_tuple(2) C.tuple_in_hom
                     C.tuple_is_extensional
                     \<open>C.commutative_square r0 u.leg1
                        (\<p>\<^sub>1[ra, w'.leg1] \<cdot> \<beta>.chine) (\<theta>'.chine \<cdot> \<beta>.chine)\<close>)
               have ***: "\<theta>'.chine \<cdot> \<beta>.chine = \<theta>.chine"
                 by (metis "*" C.prj_tuple(1) \<open>C.commutative_square r0 ?u1
                     (?p1' \<cdot> \<beta>.chine) (\<theta>'.chine \<cdot> \<beta>.chine)\<close>
                     \<open>C.commutative_square r0 ?u1 ?p1 \<theta>.chine\<close>)
               text \<open>
                 CKS say to take \<open>\<gamma> = \<beta>\<close>, but obviously this cannot work as
                 literally described, because \<open>\<guillemotleft>\<beta> : g \<star> w \<Rightarrow> g \<star> w'\<guillemotright>\<close>, whereas we must have
                 \<open>\<guillemotleft>\<gamma> : w \<Rightarrow> w'\<guillemotright>\<close>.  Instead, we have to define \<open>\<gamma>\<close> by transporting \<open>\<beta>\<close> along the
                 projections from \<open>?R \<down>\<down> ?w1\<close> to \<open>?W\<close> and \<open>?R \<down>\<down> ?w1'\<close> to \<open>?W'\<close>.
                 These are isomorphisms by virtue of their being pullbacks of identities,
                 but they are not themselves necessarily identities.
                 Specifically, we take \<open>Chn \<gamma> = ?p0' \<cdot> Chn \<beta> \<cdot> C.inv ?p0\<close>.
               \<close>
               let ?\<gamma> = "\<lparr>Chn = ?p0' \<cdot> \<beta>.chine \<cdot> C.inv ?p0, Dom = Dom w, Cod = Cod w'\<rparr>"
               interpret Dom_\<gamma>: span_in_category C \<open>Dom ?\<gamma>\<close>
                 using w.dom.span_in_category_axioms by simp
               interpret Cod_\<gamma>: span_in_category C \<open>Cod ?\<gamma>\<close>
                 using w'.cod.span_in_category_axioms by simp
               text \<open>
                 It has to be shown that \<open>\<gamma>\<close> is an arrow of spans.
               \<close>
               interpret \<gamma>: arrow_of_spans C ?\<gamma>
               proof
                 show "\<guillemotleft>Chn ?\<gamma> : Dom_\<gamma>.apex \<rightarrow>\<^sub>C Cod_\<gamma>.apex\<guillemotright>"
                 proof -
                   have "\<guillemotleft>Chn \<beta>: gw.apex \<rightarrow>\<^sub>C gw'.apex\<guillemotright>"
                     using Chn_in_hom \<beta> gw'.chine_eq_apex gw.chine_eq_apex by force
                   moreover have "\<guillemotleft>?p0' : gw'.apex \<rightarrow>\<^sub>C w'.apex\<guillemotright>"
                     using cospan' hseq_gw' hseq_char hcomp_def gw'.dom.apex_def w'.dom.apex_def
                     by auto
                   moreover have "\<guillemotleft>C.inv ?p0 : w.apex \<rightarrow>\<^sub>C gw.apex\<guillemotright>"
                     using cospan hseq_gw hseq_char hcomp_def gw.dom.apex_def w.dom.apex_def
                           C.iso_pullback_ide
                     by auto
                   ultimately show ?thesis
                     using Dom_\<gamma>.apex_def Cod_\<gamma>.apex_def by auto
                 qed
                 text \<open>
                   The commutativity property for the ``input leg'' follows directly from that
                   for \<open>\<beta>\<close>.
                 \<close>
                 show "Cod_\<gamma>.leg0 \<cdot> Chn ?\<gamma> = Dom_\<gamma>.leg0"
                   using C.comp_assoc C.comp_arr_dom cospan C.iso_pullback_ide C.comp_arr_inv'
                   by (metis C.invert_side_of_triangle(2) Dom_\<beta>.leg_simps(1) Dom_\<beta>_eq \<beta>0
                       arrow_of_spans_data.select_convs(1,3) arrow_of_spans_data.simps(2)
                       r.dom.ide_apex span_data.select_convs(1) w'.cod_simps(2))
                 text \<open>
                   The commutativity property for the ``output leg'' is a bit more subtle.
                 \<close>
                 show "Cod_\<gamma>.leg1 \<cdot> Chn ?\<gamma> = Dom_\<gamma>.leg1"
                 proof -
                   have "Cod_\<gamma>.leg1 \<cdot> Chn ?\<gamma> = ((?w1' \<cdot> ?p0') \<cdot> \<beta>.chine) \<cdot> C.inv ?p0"
                     using C.comp_assoc by simp
                   also have "... = ((?R \<cdot> ?p1') \<cdot> Chn \<beta>) \<cdot> C.inv ?p0"
                     using cospan' C.pullback_commutes [of ?R ?w1'] by auto
                   also have "... = (?p1' \<cdot> \<beta>.chine) \<cdot> C.inv ?p0"
                     using cospan' C.comp_cod_arr by simp
                   also have "... = ?p1 \<cdot> C.inv ?p0"
                     using ** by simp
                   also have "... = ?w1"
                   text \<open>
                      Sledgehammer found this at a time when I was still struggling to
                      understand what was going on.
                   \<close>
                     by (metis C.comp_cod_arr C.invert_side_of_triangle(2) C.iso_pullback_ide
                         C.prj1_simps(1,3) C.pullback_commutes' cospan r.dom.ide_apex
                         r.chine_eq_apex r.chine_simps(2))
                   also have "... = Dom_\<gamma>.leg1" by auto
                   finally show ?thesis by simp
                 qed
               qed
               text \<open>
                 What remains to be shown is that \<open>\<gamma>\<close> is unique with the properties asserted
                 by \<open>T2\<close>; \emph{i.e.} \<open>\<guillemotleft>\<gamma> : w \<Rightarrow> w'\<guillemotright> \<and> \<beta> = g \<star> \<gamma> \<and> \<theta> = \<theta>' \<bullet> (f \<star> \<gamma>)\<close>.
                 CKS' assertion that the equation \<open>(r\<theta>)(\<rho>w) = (r\<theta>')(\<rho>w')\<beta>\<close> gives \<open>w\<^sub>1 = w\<^sub>1'\<close>
                 does not really seem to be true.  The reason \<open>\<gamma>\<close> is unique is because it is
                 obtained by transporting \<open>\<beta>\<close> along isomorphisms.
               \<close>
               have \<gamma>: "\<guillemotleft>?\<gamma> : w \<Rightarrow> w'\<guillemotright>"
                 using \<gamma>.arrow_of_spans_axioms arr_char dom_char cod_char by auto
               have hseq_f\<gamma>: "hseq f ?\<gamma>"
                 using \<gamma> src_def trg_def arrI fw.composable rf.are_arrows(2) by auto
               have hseq_g\<gamma>: "hseq g ?\<gamma>"
                 using \<gamma> src_def trg_def fw.composable gw.are_arrows(1) src_f by auto
               interpret f\<gamma>: two_composable_arrows_of_spans C prj0 prj1 f ?\<gamma>
                 using hseq_f\<gamma> hseq_char by (unfold_locales, simp)
               interpret f\<gamma>: arrow_of_spans C \<open>f \<star> ?\<gamma>\<close>
                 using f\<gamma>.composite_is_arrow arr_char by simp
               interpret g\<gamma>: two_composable_arrows_of_spans C prj0 prj1 g ?\<gamma>
                 using hseq_g\<gamma> hseq_char by (unfold_locales, simp)
               interpret g\<gamma>: arrow_of_spans C \<open>g \<star> ?\<gamma>\<close>
                 using g\<gamma>.composite_is_arrow arr_char by simp
               have Chn_g\<gamma>: "Chn (g \<star> ?\<gamma>) = \<langle>?p1 \<lbrakk>?R, ?w1'\<rbrakk> ?p0' \<cdot> \<beta>.chine\<rangle>"
               proof -
                 have "Chn (g \<star> ?\<gamma>) = \<langle>?R \<cdot> ?p1 \<lbrakk>?R, ?w1'\<rbrakk> (?p0' \<cdot> \<beta>.chine \<cdot> C.inv ?p0) \<cdot> ?p0\<rangle>"
                     using g\<gamma>.chine_composite by simp
                 also have "... = \<langle>?p1 \<lbrakk>?R, ?w1'\<rbrakk> (?p0' \<cdot> \<beta>.chine \<cdot> C.inv ?p0) \<cdot> ?p0\<rangle>"
                   using C.comp_cod_arr cospan by simp
                 also have "... = \<langle>?p1 \<lbrakk>?R, ?w1'\<rbrakk> ?p0' \<cdot> \<beta>.chine\<rangle>"
                 proof -
                   have "(?p0' \<cdot> \<beta>.chine \<cdot> C.inv ?p0) \<cdot> ?p0 = ?p0' \<cdot> \<beta>.chine"
                     using C.comp_assoc C.iso_pullback_ide [of ?R ?w1] C.comp_inv_arr
                           C.comp_arr_dom Chn_\<beta>
                     by (metis C.comp_inv_arr' C.in_homE C.pbdom_def cospan r.dom.ide_apex)
                   thus ?thesis by simp
                 qed
                 ultimately show ?thesis by simp
               qed
               have Chn_\<beta>_eq: "\<beta>.chine = Chn (g \<star> ?\<gamma>)"
               proof -
                 have "Chn (g \<star> ?\<gamma>) = \<langle>?p1 \<lbrakk>?R, ?w1'\<rbrakk> ?p0' \<cdot> Chn \<beta>\<rangle>"
                   using Chn_g\<gamma> by simp
                 also have "... = \<beta>.chine"
                   text \<open>Here was another score by sledgehammer while I was still trying
                     to understand it.\<close>
                   using ** C.prj_joint_monic
                   by (metis C.prj1_simps(1) C.tuple_prj cospan cospan')
                 finally show ?thesis by simp
               qed
               have \<beta>_eq_g\<gamma>: "\<beta> = g \<star> ?\<gamma>"
               proof (intro arr_eqI)
                 show "par \<beta> (g \<star> ?\<gamma>)"
                 proof -
                   have "\<guillemotleft>g \<star> ?\<gamma> : g \<star> w \<Rightarrow> g \<star> w'\<guillemotright>"
                     using ide_g \<gamma> T.leg1_simps(3)
                     by (intro hcomp_in_vhom, auto)
                   thus ?thesis
                     using \<beta> by (elim in_homE, auto)
                 qed
                 show "\<beta>.chine = Chn (g \<star> ?\<gamma>)"
                   using Chn_\<beta>_eq by simp
               qed
               moreover have "\<theta> = \<theta>' \<bullet> (f \<star> ?\<gamma>)"
               proof (intro arr_eqI)
                 have f\<gamma>: "\<guillemotleft>f \<star> ?\<gamma> : f \<star> w \<Rightarrow> f \<star> w'\<guillemotright>"
                   using \<gamma> ide_f by auto
                 show par: "par \<theta> (\<theta>' \<bullet> (f \<star> ?\<gamma>))"
                   using \<theta> \<theta>' f\<gamma> by (elim in_homE, auto)
                 show "\<theta>.chine = Chn (\<theta>' \<bullet> (f \<star> ?\<gamma>))"
                   using par "***" Chn_vcomp calculation f\<gamma>.chine_composite g\<gamma>.chine_composite
                   by auto
               qed
               ultimately show 2: "\<guillemotleft>?\<gamma> : w \<Rightarrow> w'\<guillemotright> \<and> \<beta> = g \<star> ?\<gamma> \<and> \<theta> = \<theta>' \<bullet> (f \<star> ?\<gamma>)"
                 using \<gamma> by simp
               show "\<And>\<gamma>'. \<guillemotleft>\<gamma>' : w \<Rightarrow> w'\<guillemotright> \<and> \<beta> = g \<star> \<gamma>' \<and> \<theta> = \<theta>' \<bullet> (f \<star> \<gamma>') \<Longrightarrow> \<gamma>' = ?\<gamma>"
               proof -
                 fix \<gamma>'
                 assume 1: "\<guillemotleft>\<gamma>' : w \<Rightarrow> w'\<guillemotright> \<and> \<beta> = g \<star> \<gamma>' \<and> \<theta> = \<theta>' \<bullet> (f \<star> \<gamma>')"
                 interpret \<gamma>': arrow_of_spans C \<gamma>'
                   using 1 arr_char by auto
                 have hseq_g\<gamma>': \<open>hseq g \<gamma>'\<close>
                   using 1 \<beta> by auto
                 interpret g\<gamma>': two_composable_arrows_of_spans C prj0 prj1 g \<gamma>'
                   using hseq_g\<gamma>' hseq_char by unfold_locales auto
                 interpret g\<gamma>': arrow_of_spans C \<open>g \<star> \<gamma>'\<close>
                   using g\<gamma>'.composite_is_arrow arr_char by simp
                 show "\<gamma>' = ?\<gamma>"
                 proof (intro arr_eqI)
                   show par: "par \<gamma>' ?\<gamma>"
                     using 1 \<gamma> by fastforce
                   show "\<gamma>'.chine = \<gamma>.chine"
                   proof -
                     have "C.commutative_square ?R ?w1' (g.chine \<cdot> ?p1) (\<gamma>'.chine \<cdot> ?p0)"
                     proof
                       show "C.cospan ?R ?w1'" by fact
                       show 3: "C.span (g.chine \<cdot> ?p1) (\<gamma>'.chine \<cdot> ?p0)"
                       proof (intro conjI)
                         show "C.seq g.chine ?p1"
                           using cospan by auto
                         show "C.seq \<gamma>'.chine ?p0"
                           using cospan 2 par arrow_of_spans_data.simps(1)
                                 dom_char in_homE w.chine_eq_apex
                           by auto
                         thus "C.dom (g.chine \<cdot> ?p1) = C.dom (\<gamma>'.chine \<cdot> ?p0)"
                           using g.chine_eq_apex cospan by simp
                       qed
                       show "C.dom ra = C.cod (g.chine \<cdot> ?p1)"
                         using cospan by auto
                       show "?R \<cdot> g.chine \<cdot> ?p1 = ?w1' \<cdot> \<gamma>'.chine \<cdot> ?p0"
                       proof -
                         have "?w1' \<cdot> \<gamma>'.chine \<cdot> ?p0 = (?w1' \<cdot> \<gamma>'.chine) \<cdot> ?p0"
                           using C.comp_assoc by simp
                         moreover have "... = ?w1 \<cdot> ?p0"
                           using 1 \<gamma>'.leg1_commutes dom_char cod_char by auto
                         also have "... = ?R \<cdot> ?p1"
                           using cospan C.pullback_commutes [of ra ?w1] by auto
                         also have "... = ?R \<cdot> g.chine \<cdot> ?p1"
                           using 3 C.comp_cod_arr g.chine_is_identity g.chine_eq_apex g.dom.apex_def
                           by auto
                         finally show ?thesis by auto
                       qed
                     qed
                     have "C.commutative_square ?R ?w1' (g.chine \<cdot> ?p1) (\<gamma>.chine \<cdot> ?p0)"
                     proof
                       show "C.cospan ?R ?w1'" by fact
                       show 3: "C.span (g.chine \<cdot> ?p1) (\<gamma>.chine \<cdot> ?p0)"
                         using cospan \<gamma>.chine_in_hom by auto
                       show "C.dom ?R = C.cod (g.chine \<cdot> ?p1)"
                         using cospan by auto
                       show "?R \<cdot> g.chine \<cdot> ?p1 = ?w1' \<cdot> \<gamma>.chine \<cdot> ?p0"
                       proof -
                         have "?w1' \<cdot> \<gamma>.chine \<cdot> ?p0 = (?w1' \<cdot> \<gamma>.chine) \<cdot> ?p0"
                           using C.comp_assoc by simp
                         moreover have "... = ?w1 \<cdot> ?p0"
                           using 1 \<gamma>.leg1_commutes dom_char cod_char by auto
                         also have "... = ?R \<cdot> ?p1"
                           using cospan C.pullback_commutes [of ra ?w1] by auto
                         also have "... = ?R \<cdot> g.chine \<cdot> ?p1"
                           using 3 C.comp_cod_arr g.chine_is_identity g.chine_eq_apex g.dom.apex_def
                           by auto
                         finally show ?thesis by auto
                       qed
                     qed
                     have "\<gamma>'.chine \<cdot> ?p0 = \<gamma>.chine \<cdot> ?p0"
                     proof -
                       have "\<gamma>'.chine \<cdot> ?p0 = ?p0' \<cdot> g\<gamma>'.chine"
                         using 1 dom_char cod_char g\<gamma>'.chine_composite
                               \<open>C.commutative_square ?R ?w1' (g.chine \<cdot> ?p1) (\<gamma>'.chine \<cdot> ?p0)\<close>
                         by auto
                       also have "... = ?p0' \<cdot> \<beta>.chine"
                         using 1 by simp
                       also have "... = ?p0' \<cdot> g\<gamma>.chine"
                         using Chn_\<beta>_eq by simp
                       also have "... = \<gamma>.chine \<cdot> ?p0"
                         using g\<gamma>.chine_composite
                               \<open>C.commutative_square ?R ?w1' (g.chine \<cdot> ?p1) (\<gamma>.chine \<cdot> ?p0)\<close>
                         by simp
                       finally show ?thesis by simp
                     qed
                     thus ?thesis
                       using C.iso_pullback_ide C.iso_is_retraction C.retraction_is_epi
                             C.epiE [of "?p0" \<gamma>'.chine \<gamma>.chine] cospan \<gamma>.chine_in_hom
                             \<gamma>'.chine_in_hom
                       by auto
                   qed
                 qed
               qed
             qed
           qed
         qed
       qed
     qed
 
   end
 
   context span_bicategory
   begin
 
     interpretation chosen_right_adjoints vcomp hcomp assoc unit src trg ..
     notation some_right_adjoint  ("_\<^sup>*" [1000] 1000)  (* TODO: Why is this needed? *)
     notation isomorphic  (infix "\<cong>" 50)
 
     text \<open>
       \<open>Span(C)\<close> is a bicategory of spans.
     \<close>
 
     lemma is_bicategory_of_spans:
     shows "bicategory_of_spans vcomp hcomp assoc unit src trg"
     proof
       text \<open>
         Every 1-cell \<open>r\<close> is isomorphic to the composition of a map and the right adjoint
         of a map.  The proof is to obtain a tabulation of \<open>r\<close> as a span of maps \<open>(f, g)\<close>
         and then observe that \<open>r\<close> is isomorphic to \<open>g \<star> f\<^sup>*\<close>.
       \<close>
       show "\<And>r. ide r \<Longrightarrow> \<exists>f g. is_left_adjoint f \<and> is_left_adjoint g \<and> r \<cong> g \<star> f\<^sup>*"
       proof -
         fix r
         assume r: "ide r"
         interpret r: identity_arrow_of_spans C r
           using r ide_char' by auto
         interpret r: identity_arrow_in_span_bicategory C prj0 prj1 r ..
         have \<rho>: "tabulation (\<bullet>) (\<star>) assoc unit src trg r r.\<rho> r.f r.g \<and>
                  is_left_adjoint r.f \<and> is_left_adjoint r.g"
           using r r.has_tabulation by blast
         interpret \<rho>: tabulation vcomp hcomp assoc unit src trg r r.\<rho> r.f r.g
           using \<rho> by fast
         have 1: "r \<cong> r.g \<star> r.f\<^sup>*"
           using \<rho> \<rho>.yields_isomorphic_representation' \<rho>.T0.is_map
                 left_adjoint_extends_to_adjoint_pair
                 isomorphic_def [of "r.g \<star> r.f\<^sup>*" r] isomorphic_symmetric
           by auto
         thus "\<exists>f g. is_left_adjoint f \<and> is_left_adjoint g \<and> r \<cong> g \<star> f\<^sup>*"
           using \<rho> by blast
       qed
       text \<open>
         Every span of maps extends to a tabulation.
       \<close>
       show "\<And>f g. \<lbrakk> is_left_adjoint f; is_left_adjoint g; src f = src g \<rbrakk> \<Longrightarrow>
                    \<exists>r \<rho>. tabulation (\<bullet>) (\<star>) assoc unit src trg r \<rho> f g"
       proof -
         text \<open>
           The proof idea is as follows:  Let maps \<open>f = (f\<^sub>1, f\<^sub>0)\<close> and \<open>g = (g\<^sub>1, g\<^sub>0)\<close> be given.
           Let \<open>f' = (f\<^sub>1 \<cdot> C.inv f\<^sub>0, C.cod f\<^sub>0)\<close> and \<open>g' = (g\<^sub>1 \<cdot> C.inv g\<^sub>0, C.cod g\<^sub>0)\<close>;
           then \<open>f'\<close> and \<open>g'\<close> are maps isomorphic to \<open>f\<close> and \<open>g\<close>, respectively.
           By a previous result, \<open>f'\<close> and \<open>g'\<close> extend to a tabulation \<open>(f', \<tau>, g')\<close> of
           \<open>r = (f\<^sub>1 \<cdot> C.inv f\<^sub>0, g\<^sub>1 \<cdot> C.inv g\<^sub>0)\<close>.
           Compose with isomorphisms \<open>\<guillemotleft>\<phi> : f' \<Rightarrow> f\<guillemotright>\<close> and \<open>\<guillemotleft>\<psi> : g \<Rightarrow> g'\<guillemotright>\<close> to obtain
           \<open>(f, (r \<star> \<phi>) \<cdot> \<tau> \<cdot> \<psi>, g)\<close> and show it must also be a tabulation.
         \<close>
         fix f g
         assume f: "is_left_adjoint f"
         assume g: "is_left_adjoint g"
         assume fg: "src f = src g"
         show "\<exists>r \<rho>. tabulation (\<bullet>) (\<star>) assoc unit src trg r \<rho> f g"
         proof -
           text \<open>We have to unpack the hypotheses to get information about f and g.\<close>
           obtain f\<^sub>a \<eta>\<^sub>f \<epsilon>\<^sub>f
             where ff\<^sub>a: "adjunction_in_bicategory vcomp hcomp assoc unit src trg f f\<^sub>a \<eta>\<^sub>f \<epsilon>\<^sub>f"
             using f adjoint_pair_def by auto
           interpret ff\<^sub>a: adjunction_in_bicategory vcomp hcomp assoc unit src trg f f\<^sub>a \<eta>\<^sub>f \<epsilon>\<^sub>f
             using ff\<^sub>a by simp
           interpret f: arrow_of_spans C f
             using ide_char [of f] by simp
           interpret f: identity_arrow_of_spans C f
             using ide_char [of f] by unfold_locales auto
           obtain g\<^sub>a \<eta>\<^sub>g \<epsilon>\<^sub>g
             where G: "adjunction_in_bicategory vcomp hcomp assoc unit src trg g g\<^sub>a \<eta>\<^sub>g \<epsilon>\<^sub>g"
             using g adjoint_pair_def by auto
           interpret gg\<^sub>a: adjunction_in_bicategory vcomp hcomp assoc unit src trg g g\<^sub>a \<eta>\<^sub>g \<epsilon>\<^sub>g
             using G by simp
           interpret g: arrow_of_spans C g
             using ide_char [of g] by simp
           interpret g: identity_arrow_of_spans C g
             using ide_char [of g] by unfold_locales auto
 
           let ?f' = "mkIde (C.cod f.leg0) (f.dom.leg1 \<cdot> C.inv f.leg0)"
           have f': "ide ?f'"
           proof -
             have "C.span (C.cod f.leg0) (f.leg1 \<cdot> C.inv f.leg0)"
               using f is_left_adjoint_char by auto
             thus ?thesis
               using ide_mkIde by blast
           qed
           interpret f': arrow_of_spans C ?f'
             using f' ide_char by blast
           interpret f': identity_arrow_of_spans C ?f'
             using f' ide_char by unfold_locales auto
 
           let ?g' = "mkIde (C.cod g.leg0) (g.dom.leg1 \<cdot> C.inv g.leg0)"
           have g': "ide ?g'"
           proof -
             have "C.span (C.cod g.leg0) (g.leg1 \<cdot> C.inv g.leg0)"
               using g is_left_adjoint_char by auto
             thus ?thesis
               using ide_mkIde by blast
           qed
           interpret g': arrow_of_spans C ?g'
             using g' ide_char by blast
           interpret g': identity_arrow_of_spans C ?g'
             using g' ide_char by unfold_locales auto
         
           let ?r = "mkIde (f'.leg1) (g'.leg1)"
           have r: "ide ?r"
           proof -
             have "C.span (f'.leg1) (g'.leg1)"
               using f g fg src_def is_left_adjoint_char by simp
             thus ?thesis
               using ide_mkIde by blast
           qed
           interpret r: arrow_of_spans C ?r
             using r ide_char by blast
           interpret r: identity_arrow_of_spans C ?r
             using r ide_char by unfold_locales auto
           interpret r: identity_arrow_in_span_bicategory C prj0 prj1 ?r ..
 
           have "r.f = ?f'"
             using f r.chine_eq_apex is_left_adjoint_char by auto
           have "r.g = ?g'"
             using f r.chine_eq_apex fg src_def is_left_adjoint_char by simp
 
           interpret \<rho>: tabulation \<open>(\<bullet>)\<close> \<open>(\<star>)\<close> assoc unit src trg ?r r.\<rho> r.f r.g
             using r.has_tabulation by simp
           have \<rho>_eq: "r.\<rho> = \<lparr>Chn = \<langle>C.cod f.leg0 \<lbrakk>f'.leg1, f'.leg1\<rbrakk> C.cod f.leg0\<rangle>,
                              Dom = \<lparr>Leg0 = C.cod f.leg0, Leg1 = g'.leg1\<rparr>,
                              Cod = \<lparr>Leg0 = \<p>\<^sub>0[f'.leg1, f'.leg1],
                                     Leg1 = g'.leg1 \<cdot> \<p>\<^sub>1[f'.leg1, f'.leg1]\<rparr>\<rparr>"
             using \<open>r.f = ?f'\<close> by auto
 
           text \<open>Obtain the isomorphism from \<open>f'\<close> to \<open>f\<close>.\<close>
           let ?\<phi> = "\<lparr>Chn = C.inv f.leg0, Dom = Dom ?f', Cod = Dom f\<rparr>"
           interpret Dom_\<phi>: span_in_category C
                               \<open>Dom \<lparr>Chn = C.inv f.leg0,
                                     Dom = Dom (mkIde f.dsrc (f.leg1 \<cdot> C.inv f.leg0)),
                                     Cod = Dom f\<rparr>\<close>
             using f'.dom.span_in_category_axioms by simp
           interpret Cod_\<phi>: span_in_category C
                               \<open>Cod \<lparr>Chn = C.inv f.leg0,
                                     Dom = Dom (mkIde f.dsrc (f.leg1 \<cdot> C.inv f.leg0)),
                                     Cod = Dom f\<rparr>\<close>
             using f.dom.span_in_category_axioms by simp
           interpret \<phi>: arrow_of_spans C ?\<phi>
           proof
             show "\<guillemotleft>Chn \<lparr>Chn = C.inv f.leg0,
                         Dom = Dom (mkIde f.dsrc (f.leg1 \<cdot> C.inv f.leg0)),
                         Cod = Dom f\<rparr> : Dom_\<phi>.apex \<rightarrow>\<^sub>C Cod_\<phi>.apex\<guillemotright>"
               using f f.dom.apex_def f'.dom.apex_def is_left_adjoint_char by auto
             show "Cod_\<phi>.leg0 \<cdot> Chn \<lparr>Chn = C.inv f.leg0,
                                     Dom = Dom (mkIde f.dsrc (f.leg1 \<cdot> C.inv f.leg0)),
                                     Cod = Dom f\<rparr> =
                   Dom_\<phi>.leg0"
               using f f.dom.apex_def is_left_adjoint_char C.comp_arr_inv C.inv_is_inverse
               by simp
             show "Cod_\<phi>.leg1 \<cdot> Chn \<lparr>Chn = C.inv f.leg0,
                                     Dom = Dom (mkIde f.dsrc (f.leg1 \<cdot> C.inv f.leg0)),
                                     Cod = Dom f\<rparr> =
                   Dom_\<phi>.leg1"
               by simp
           qed
           have \<phi>: "\<guillemotleft>?\<phi> : ?f' \<Rightarrow> f\<guillemotright> \<and> iso ?\<phi>"
             using f is_left_adjoint_char iso_char arr_char dom_char cod_char
                   \<phi>.arrow_of_spans_axioms C.iso_inv_iso f'.dom.apex_def f.dom.apex_def
             by auto
 
           text \<open>
             Obtain the isomorphism from \<open>g\<close> to \<open>g'\<close>.
             Recall: \<open>g' = mkIde (C.cod g.leg0) (g.dom.leg1 \<cdot> C.inv g.leg0)\<close>.
             The isomorphism is given by \<open>g.leg0\<close>.
           \<close>
           let ?\<psi> = "\<lparr>Chn = g.leg0, Dom = Dom g, Cod = Dom ?g'\<rparr>"
           interpret Dom_\<psi>: span_in_category C
                               \<open>Dom \<lparr>Chn = g.leg0,
                                     Dom = Dom g,
                                     Cod = Dom (mkIde g.dsrc (g.leg1 \<cdot> C.inv g.leg0))\<rparr>\<close>
             using g.dom.span_in_category_axioms by simp
           interpret Cod_\<psi>: span_in_category C
                               \<open>Cod \<lparr>Chn = g.leg0,
                                     Dom = Dom g,
                                     Cod = Dom (mkIde g.dsrc (g.leg1 \<cdot> C.inv g.leg0))\<rparr>\<close>
             using g'.dom.span_in_category_axioms by simp
           interpret \<psi>: arrow_of_spans C ?\<psi>
           proof
             show "\<guillemotleft>Chn \<lparr>Chn = g.leg0,
                         Dom = Dom g,
                         Cod = Dom (mkIde g.dsrc (g.leg1 \<cdot> C.inv g.leg0))\<rparr> :
                           Dom_\<psi>.apex \<rightarrow>\<^sub>C Cod_\<psi>.apex\<guillemotright>"
               using g g.dom.apex_def g'.dom.apex_def is_left_adjoint_char by auto
             show "Cod_\<psi>.leg0 \<cdot> Chn \<lparr>Chn = g.leg0,
                                     Dom = Dom g,
                                     Cod = Dom (mkIde g.dsrc (g.leg1 \<cdot> C.inv g.leg0))\<rparr> =
                   Dom_\<psi>.leg0"
               using C.comp_cod_arr by simp
             show "Cod_\<psi>.leg1 \<cdot> Chn \<lparr>Chn = g.leg0,
                                     Dom = Dom g,
                                     Cod = Dom (mkIde g.dsrc (g.leg1 \<cdot> C.inv g.leg0))\<rparr> =
                   Dom_\<psi>.leg1"
               using g g.dom.apex_def is_left_adjoint_char C.comp_inv_arr C.inv_is_inverse
                     C.comp_assoc C.comp_arr_dom
               by simp
           qed
           have \<psi>: "\<guillemotleft>?\<psi> : g \<Rightarrow> ?g'\<guillemotright> \<and> iso ?\<psi>"
             using g is_left_adjoint_char iso_char arr_char dom_char cod_char
                   \<psi>.arrow_of_spans_axioms C.iso_inv_iso g.dom.apex_def g'.dom.apex_def
             by auto
           have \<rho>\<psi>: "tabulation (\<bullet>) (\<star>) assoc unit src trg ?r (r.\<rho> \<bullet> ?\<psi>) r.f g"
             using \<psi> `r.g = ?g'` iso_inv_iso r.has_tabulation \<rho>.preserved_by_output_iso by simp
           interpret \<tau>\<psi>: tabulation vcomp hcomp assoc unit src trg ?r \<open>r.\<rho> \<bullet> ?\<psi>\<close> r.f g
             using \<rho>\<psi> by auto
           have "tabulation (\<bullet>) (\<star>) assoc unit src trg ?r ((?r \<star> ?\<phi>) \<bullet> r.\<rho> \<bullet> ?\<psi>) f g"
             using \<phi> `r.f = ?f'` \<tau>\<psi>.preserved_by_input_iso [of ?\<phi> f] by argo
           thus ?thesis by auto
         qed
       qed
 
       text \<open>The sub-bicategory of maps is locally essentially discrete.\<close>
       show "\<And>f f' \<mu> \<mu>'. \<lbrakk> is_left_adjoint f; is_left_adjoint f'; \<guillemotleft>\<mu> : f \<Rightarrow> f'\<guillemotright>; \<guillemotleft>\<mu>' : f \<Rightarrow> f'\<guillemotright> \<rbrakk>
                             \<Longrightarrow> iso \<mu> \<and> iso \<mu>' \<and> \<mu> = \<mu>'"
       proof -
         fix f f' \<mu> \<mu>'
         assume f: "is_left_adjoint f" and f': "is_left_adjoint f'"
         assume \<mu>: "\<guillemotleft>\<mu> : f \<Rightarrow> f'\<guillemotright>" and \<mu>': "\<guillemotleft>\<mu>' : f \<Rightarrow> f'\<guillemotright>"
         obtain f\<^sub>a \<eta> \<epsilon>
           where f\<^sub>a: "adjunction_in_bicategory vcomp hcomp assoc unit src trg f f\<^sub>a \<eta> \<epsilon>"
           using f adjoint_pair_def by auto
         obtain f'\<^sub>a \<eta>' \<epsilon>'
           where f'\<^sub>a: "adjunction_in_bicategory vcomp hcomp assoc unit src trg f' f'\<^sub>a \<eta>' \<epsilon>'"
           using f' adjoint_pair_def adjunction_def by auto
         interpret f\<^sub>a: adjunction_in_bicategory vcomp hcomp assoc unit src trg f f\<^sub>a \<eta> \<epsilon>
           using f\<^sub>a by simp
         interpret f'\<^sub>a: adjunction_in_bicategory vcomp hcomp assoc unit src trg f' f'\<^sub>a \<eta>' \<epsilon>'
           using f'\<^sub>a by simp
         interpret f: identity_arrow_of_spans C f
           using ide_char' [of f] by simp
         interpret f': identity_arrow_of_spans C f'
           using ide_char' [of f'] by simp
         interpret \<mu>: arrow_of_spans C \<mu> using \<mu> arr_char by auto
         interpret \<mu>': arrow_of_spans C \<mu>' using \<mu>' arr_char by auto
         have 1: "C.iso f.leg0 \<and> C.iso f'.leg0"
           using f f' is_left_adjoint_char by simp
         have 2: "\<mu>.chine = C.inv f'.leg0 \<cdot> f.leg0"
           using \<mu> 1 dom_char cod_char \<mu>.leg0_commutes C.invert_side_of_triangle by auto
         moreover have "\<mu>'.chine = C.inv f'.leg0 \<cdot> f.leg0"
           using \<mu>' 1 dom_char cod_char \<mu>'.leg0_commutes C.invert_side_of_triangle by auto
         ultimately have 3: "\<mu>.chine = \<mu>'.chine" by simp
         have "iso \<mu>"
           using 1 2 C.isos_compose C.iso_inv_iso \<mu> dom_char cod_char
                 iso_char arr_char \<mu>.arrow_of_spans_axioms
           by auto
         hence "iso \<mu>'"
           using 3 iso_char arr_char \<mu>'.arrow_of_spans_axioms by simp
         moreover have "\<mu> = \<mu>'"
           using 3 \<mu> \<mu>' dom_char cod_char by fastforce
         ultimately show "iso \<mu> \<and> iso \<mu>' \<and> \<mu> = \<mu>'"
           by simp
       qed
     qed
 
     text \<open>
       We can now prove the easier half of the main result (CKS Theorem 4):
       If \<open>B\<close> is biequivalent to \<open>Span(C)\<close>, where \<open>C\<close> is a category with pullbacks,
       then \<open>B\<close> is a bicategory of spans.
       (Well, it is easier given that we have already done the work to show that the notion
       ``bicategory of spans'' is respected by equivalence of bicategories.)
     \<close>
 
     theorem equivalent_implies_bicategory_of_spans:
     assumes "equivalent_bicategories vcomp hcomp assoc unit src trg V\<^sub>1 H\<^sub>1 \<a>\<^sub>1 \<i>\<^sub>1 src\<^sub>1 trg\<^sub>1"
     shows "bicategory_of_spans V\<^sub>1 H\<^sub>1 \<a>\<^sub>1 \<i>\<^sub>1 src\<^sub>1 trg\<^sub>1"
       using assms is_bicategory_of_spans bicategory_of_spans_respects_equivalence by blast
 
   end
 
   subsection "Properties of Bicategories of Spans"
 
   text \<open>
     We now develop consequences of the axioms for a bicategory of spans, in preparation for
     proving the other half of the main result.
   \<close>
 
   context bicategory_of_spans
   begin
 
     notation isomorphic  (infix "\<cong>" 50)
 
     text \<open>
       The following is a convenience version of \<open>BS2\<close> that gives us what we generally want:
       given specified \<open>f, g\<close> obtain \<open>\<rho>\<close> that makes \<open>(f, \<rho>, g)\<close> a tabulation of \<open>g \<star> f\<^sup>*\<close>,
       not a tabulation of some \<open>r\<close> isomorphic to \<open>g \<star> f\<^sup>*\<close>.
     \<close>
 
     lemma BS2':
     assumes "is_left_adjoint f" and "is_left_adjoint g" and "src f = src g"
     and "isomorphic (g \<star> f\<^sup>*) r"
     shows "\<exists>\<rho>. tabulation V H \<a> \<i> src trg r \<rho> f g"
     proof -
       have 1: "is_left_adjoint f \<and> is_left_adjoint g \<and> g \<star> f\<^sup>* \<cong> r"
         using assms BS1 by simp
       obtain \<phi> where \<phi>: "\<guillemotleft>\<phi> : g \<star> f\<^sup>* \<Rightarrow> r\<guillemotright> \<and> iso \<phi>"
         using 1 isomorphic_def by blast
       obtain r' \<rho>' where \<rho>': "tabulation V H \<a> \<i> src trg r' \<rho>' f g"
         using assms 1 BS2 by blast
       interpret \<rho>': tabulation V H \<a> \<i> src trg r' \<rho>' f g
         using \<rho>' by simp
       let ?\<psi> = "\<rho>'.T0.trnr\<^sub>\<epsilon> r' \<rho>'"
       have \<psi>: "\<guillemotleft>?\<psi> : g \<star> f\<^sup>* \<Rightarrow> r'\<guillemotright> \<and> iso ?\<psi>"
         using \<rho>'.yields_isomorphic_representation by blast
       have "\<guillemotleft>\<phi> \<cdot> inv ?\<psi> : r' \<Rightarrow> r\<guillemotright> \<and> iso (\<phi> \<cdot> inv ?\<psi>)"
         using \<phi> \<psi> iso_inv_iso isos_compose inv_in_hom by blast
       hence 3: "tabulation V H \<a> \<i> src trg r ((\<phi> \<cdot> inv ?\<psi> \<star> f) \<cdot> \<rho>') f g"
         using \<rho>'.is_preserved_by_base_iso by blast
       hence "\<exists>\<rho>. tabulation V H \<a> \<i> src trg r \<rho> f g"
         by blast
       thus ?thesis
         using someI_ex [of "\<lambda>\<rho>. tabulation V H \<a> \<i> src trg r \<rho> f g"] by simp
     qed
 
     text \<open>
       The following observation is made by CKS near the beginning of the proof of Theorem 4:
       If \<open>w\<close> is an arbitrary 1-cell, and \<open>g\<close> and \<open>g \<star> w\<close> are maps, then \<open>w\<close> is in fact a map.
       It is applied frequently.
     \<close>
 
     lemma BS4:
     assumes "is_left_adjoint g" and "ide w" and "is_left_adjoint (g \<star> w)"
     shows "is_left_adjoint w"
     proof -
       text \<open>
         CKS say: ``by (i) there are maps \<open>m, n\<close> with \<open>w \<cong> nm\<^sup>*\<close>, so, by (ii), we have two
         tabulations \<open>(1, \<rho>, gw)\<close>, \<open>(m, \<sigma>, gn)\<close> of \<open>gw\<close>; since tabulations are unique
         up to equivalence, \<open>m\<close> is invertible and \<open>w \<cong> nm\<^sup>*\<close> is a map.''
       \<close>
       have ex_\<rho>: "\<exists>\<rho>. tabulation V H \<a> \<i> src trg (g \<star> w) \<rho> (src w) (g \<star> w)"
       proof -
         have "(g \<star> w) \<star> src w \<cong> g \<star> w"
           by (metis assms(3) iso_runit ideD(1) isomorphic_def left_adjoint_is_ide
               runit_in_hom(2) src_hcomp)
         moreover have "isomorphic ((g \<star> w) \<star> (src w)\<^sup>*) (g \<star> w)"
         proof -
           have "(g \<star> w) \<star> src (g \<star> w) \<cong> g \<star> w"
             using calculation isomorphic_implies_ide(2) by auto
           moreover have "isomorphic (src (g \<star> w)) (src w)\<^sup>*"
           proof -
             interpret src_w: map_in_bicategory V H \<a> \<i> src trg \<open>src w\<close>
               using assms obj_is_self_adjoint by unfold_locales auto
             interpret src_w: adjunction_in_bicategory V H \<a> \<i> src trg
                                \<open>src w\<close> \<open>(src w)\<^sup>*\<close> src_w.\<eta> src_w.\<epsilon>
               using src_w.is_map left_adjoint_extends_to_adjunction by simp
             have "adjoint_pair (src w) (src w)"
               using assms obj_is_self_adjoint by simp
             moreover have "adjoint_pair (src w) (src w)\<^sup>*"
               using adjoint_pair_def src_w.adjunction_in_bicategory_axioms by auto
             ultimately have "src w \<cong> (src w)\<^sup>*"
               using left_adjoint_determines_right_up_to_iso by simp
             moreover have "src w = src (g \<star> w)"
               using assms isomorphic_def hcomp_simps(1) left_adjoint_is_ide by simp
             ultimately show ?thesis by simp
           qed
           moreover have "src (g \<star> w) = trg (src (g \<star> w))"
             using assms left_adjoint_is_ide by simp
           ultimately show ?thesis
             using assms left_adjoint_is_ide isomorphic_transitive isomorphic_symmetric
                   hcomp_ide_isomorphic
             by blast
         qed
         ultimately show ?thesis
           using assms obj_is_self_adjoint
                 left_adjoint_is_ide BS2' [of "src w" "g \<star> w" "g \<star> w"]
           by auto
       qed
       obtain \<rho> where \<rho>: "tabulation V H \<a> \<i> src trg (g \<star> w) \<rho> (src w) (g \<star> w)"
         using ex_\<rho> by auto
       obtain m n where mn: "is_left_adjoint m \<and> is_left_adjoint n \<and> isomorphic w (n \<star> m\<^sup>*)"
         using assms BS1 [of w] by auto
       have m\<^sub>a: "adjoint_pair m m\<^sup>* \<and> isomorphic w (n \<star> m\<^sup>*)"
         using mn adjoint_pair_def left_adjoint_extends_to_adjoint_pair by blast
       have ex_\<sigma>: "\<exists>\<sigma>. tabulation V H \<a> \<i> src trg (g \<star> w) \<sigma> m (g \<star> n)"
       proof -
         have "hseq n m\<^sup>*"
           using mn isomorphic_implies_ide by auto
         have "trg (n \<star> m\<^sup>*) = trg w"
           using mn m\<^sub>a isomorphic_def
           by (metis (no_types, lifting) arr_inv dom_inv in_homE trg_dom trg_inv)
         hence "trg n = trg w"
           using mn by (metis assms(2) ideD(1) trg.preserves_reflects_arr trg_hcomp)
         hence "hseq g n"
           using assms mn left_adjoint_is_ide ideD(1) by blast
         have "hseq g w"
           using assms left_adjoint_is_ide by simp
         have "src m = src n"
           using mn m\<^sub>a `hseq n m\<^sup>*` adjoint_pair_antipar [of m "m\<^sup>*"] by fastforce
 
         have "is_left_adjoint (g \<star> n)"
           using assms mn left_adjoints_compose `hseq g n` by blast
         moreover have "src m = src (g \<star> n)"
           using assms mn `hseq g n` `src m = src n` by simp
         moreover have "(g \<star> n) \<star> m\<^sup>* \<cong> g \<star> w"
         proof -
           have 1: "src g = trg (n \<star> m\<^sup>*)"
             using assms `trg (n \<star> m\<^sup>*) = trg w` `hseq g w` by fastforce
           hence "(g \<star> n) \<star> m\<^sup>* \<cong> g \<star> n \<star> m\<^sup>*"
             using assms mn m\<^sub>a assoc_in_hom iso_assoc `hseq g n` `hseq n m\<^sup>*`
                   isomorphic_def left_adjoint_is_ide right_adjoint_is_ide
             by (metis hseqE ideD(2) ideD(3))
           also have "... \<cong> g \<star> w"
             using assms 1 mn m\<^sub>a isomorphic_symmetric hcomp_ide_isomorphic left_adjoint_is_ide
             by simp
           finally show ?thesis
             using isomorphic_transitive by blast
         qed
         ultimately show ?thesis
           using assms mn m\<^sub>a BS2' by blast
       qed
       obtain \<sigma> where \<sigma>: "tabulation V H \<a> \<i> src trg (g \<star> w) \<sigma> m (g \<star> n)"
         using ex_\<sigma> by auto
 
       interpret \<rho>: tabulation V H \<a> \<i> src trg \<open>g \<star> w\<close> \<rho> \<open>src w\<close> \<open>g \<star> w\<close>
         using \<rho> by auto
       interpret \<sigma>: tabulation V H \<a> \<i> src trg \<open>g \<star> w\<close> \<sigma> m \<open>g \<star> n\<close>
         using \<sigma> by auto
       text \<open>
         As usual, the sketch given by CKS seems more suggestive than it is a precise recipe.
         We can obtain an equivalence map \<open>\<guillemotleft>e : src w \<rightarrow> src m\<guillemotright>\<close> and \<open>\<theta>\<close> such that
         \<open>\<guillemotleft>\<theta> : m \<star> e \<Rightarrow> src w\<guillemotright>\<close>.
         We can also obtain an equivalence map \<open>\<guillemotleft>e' : src m \<rightarrow> src w\<guillemotright>\<close> and \<open>\<theta>'\<close> such that
         \<open>\<guillemotleft>\<theta>' : src w \<star> e' \<Rightarrow> m\<guillemotright>\<close>.  If \<open>\<theta>'\<close> can be taken to be an isomorphism; then we have
         \<open>e' \<cong> src w \<star> e' \<cong> m\<close>.  Since \<open>e'\<close> is an equivalence, this shows \<open>m\<close> is an equivalence,
         hence its right adjoint \<open>m\<^sup>*\<close> is also an equivalence and therefore a map.
         But \<open>w = n \<star> m\<^sub>a\<close>, so this shows that \<open>w\<close> is a map.
 
         Now, we may assume without loss of generality that \<open>e\<close> and \<open>e'\<close> are part of an
         adjoint equivalence.
         We have \<open>\<guillemotleft>\<theta> : m \<star> e \<Rightarrow> src w\<guillemotright>\<close> and \<open>\<guillemotleft>\<theta>' : src w \<star> e' \<Rightarrow> m\<guillemotright>\<close>.
         We may take the transpose of \<open>\<theta>\<close> to obtain \<open>\<guillemotleft>\<zeta> : m \<Rightarrow> src w \<star> e'\<guillemotright>\<close>;
         then \<open>\<guillemotleft>\<theta>' \<cdot> \<zeta> : m \<Rightarrow> m\<guillemotright>\<close> and \<open>\<guillemotleft>\<zeta> \<cdot> \<theta>' : src w \<star> e' \<Rightarrow> src w \<star> e'\<guillemotright>\<close>.
         Since \<open>m\<close> and \<open>src w \<star> e'\<close> are maps, by \<open>BS3\<close> it must be that \<open>\<zeta>\<close> and \<open>\<theta>'\<close> are inverses.
         \<close>
         text \<open>
           {\bf Note:} CKS don't cite \<open>BS3\<close> here.  I am not sure whether this result can be proved
           without \<open>BS3\<close>.  For example, I am interested in knowing whether it can still be
           proved under the the assumption that 2-cells between maps are unique, but not
           necessarily invertible, or maybe even in a more general situation.  It looks like
           the invertibility part of \<open>BS3\<close> is not used in the proof below.
         \<close>
       have 2: "\<exists>e e' \<phi> \<psi> \<theta> \<nu> \<theta>' \<nu>'.
                   equivalence_in_bicategory (\<cdot>) (\<star>) \<a> \<i> src trg e e' \<phi> \<psi> \<and>
                   \<guillemotleft>\<theta>' : src w \<star> e' \<Rightarrow> m\<guillemotright> \<and> \<guillemotleft>\<nu> : g \<star> n \<Rightarrow> (g \<star> w) \<star> e'\<guillemotright> \<and> iso \<nu> \<and>
                   \<sigma> = \<rho>.composite_cell e' \<theta>' \<cdot> \<nu> \<and>
                   \<guillemotleft>\<theta> : m \<star> e \<Rightarrow> src w\<guillemotright> \<and> \<guillemotleft>\<nu>' : g \<star> w \<Rightarrow> (g \<star> n) \<star> e\<guillemotright> \<and> iso \<nu>' \<and>
                   \<rho> = ((g \<star> w) \<star> \<theta>) \<cdot> \<a>[g \<star> w, m, e] \<cdot> (\<sigma> \<star> e) \<cdot> \<nu>'"
         using \<rho> \<sigma>.apex_unique_up_to_equivalence [of \<rho> "src w" "g \<star> w"] comp_assoc
         by metis
       obtain e e' \<phi> \<psi> \<theta> \<nu> \<theta>' \<nu>'
         where *: "equivalence_in_bicategory (\<cdot>) (\<star>) \<a> \<i> src trg e e' \<phi> \<psi> \<and>
                   \<guillemotleft>\<theta>' : src w \<star> e' \<Rightarrow> m\<guillemotright> \<and> \<guillemotleft>\<nu> : g \<star> n \<Rightarrow> (g \<star> w) \<star> e'\<guillemotright> \<and> iso \<nu> \<and>
                   \<sigma> = \<rho>.composite_cell e' \<theta>' \<cdot> \<nu> \<and>
                   \<guillemotleft>\<theta> : m \<star> e \<Rightarrow> src w\<guillemotright> \<and> \<guillemotleft>\<nu>' : g \<star> w \<Rightarrow> (g \<star> n) \<star> e\<guillemotright> \<and> iso \<nu>' \<and>
                   \<rho> = \<sigma>.composite_cell e \<theta> \<cdot> \<nu>'"
         using 2 comp_assoc by auto
       interpret ee': equivalence_in_bicategory \<open>(\<cdot>)\<close> \<open>(\<star>)\<close> \<a> \<i> src trg e e' \<phi> \<psi>
         using * by simp
 
       have equiv_e: "equivalence_map e"
         using ee'.equivalence_in_bicategory_axioms equivalence_map_def by auto
       obtain \<psi>' where \<psi>': "adjoint_equivalence_in_bicategory (\<cdot>) (\<star>) \<a> \<i> src trg e e' \<phi> \<psi>'"
         using equivalence_refines_to_adjoint_equivalence [of e e' \<phi>]
               ee'.unit_in_hom(2) ee'.unit_is_iso ee'.antipar equiv_e
         by auto
       interpret ee': adjoint_equivalence_in_bicategory \<open>(\<cdot>)\<close> \<open>(\<star>)\<close> \<a> \<i> src trg e e' \<phi> \<psi>'
         using \<psi>' by simp
       interpret e'e: adjoint_equivalence_in_bicategory \<open>(\<cdot>)\<close> \<open>(\<star>)\<close> \<a> \<i> src trg e' e \<open>inv \<psi>'\<close> \<open>inv \<phi>\<close>
         using * ee'.dual_adjoint_equivalence by simp
       have equiv_e': "equivalence_map e'"
         using e'e.equivalence_in_bicategory_axioms equivalence_map_def by auto
 
       have "hseq m e"
         using * ide_dom [of \<theta>]
         apply (elim conjE in_homE) by simp
       have "hseq (src w) e'"
         using * ide_dom [of \<theta>']
         apply (elim conjE in_homE) by simp
 
       have "e'e.trnr\<^sub>\<eta> m \<theta> \<in> hom m (src w \<star> e')"
       proof -
         have "src m = trg e"
           using `hseq m e` by auto
         moreover have "src (src w) = trg e'"
           using `hseq (src w) e'` by auto
         moreover have "ide m"
           using mn left_adjoint_is_ide by simp
         moreover have "ide (src w)"
           using assms by simp
         ultimately show ?thesis
           using * e'e.adjoint_transpose_right(1) by blast
       qed
       hence 3: "\<guillemotleft>e'e.trnr\<^sub>\<eta> m \<theta> : m \<Rightarrow> src w \<star> e'\<guillemotright>"
         by simp
       hence "\<guillemotleft>\<theta>' \<cdot> e'e.trnr\<^sub>\<eta> m \<theta> : m \<Rightarrow> m\<guillemotright> \<and> \<guillemotleft>e'e.trnr\<^sub>\<eta> m \<theta> \<cdot> \<theta>' : src w \<star> e' \<Rightarrow> src w \<star> e'\<guillemotright>"
         using * by auto
       moreover have "\<guillemotleft>m : m \<Rightarrow> m\<guillemotright> \<and> \<guillemotleft>src w \<star> e' : src w \<star> e' \<Rightarrow> src w \<star> e'\<guillemotright>"
         using mn 3 ide_cod [of "e'e.trnr\<^sub>\<eta> m \<theta>"] left_adjoint_is_ide by fastforce
       moreover have 4: "is_left_adjoint (src w \<star> e')"
       proof -
         have "is_left_adjoint (src w)"
           using assms obj_is_self_adjoint by simp
         moreover have "is_left_adjoint e'"
           using e'e.adjunction_in_bicategory_axioms adjoint_pair_def by auto
         ultimately show ?thesis
           using left_adjoints_compose `hseq (src w) e'` by auto
       qed
       ultimately have "\<theta>' \<cdot> e'e.trnr\<^sub>\<eta> m \<theta> = m \<and> e'e.trnr\<^sub>\<eta> m \<theta> \<cdot> \<theta>' = src w \<star> e'"
         using mn BS3 [of m m "\<theta>' \<cdot> e'e.trnr\<^sub>\<eta> m \<theta>" m]
               BS3 [of "src w \<star> e'" "src w \<star> e'" "e'e.trnr\<^sub>\<eta> m \<theta> \<cdot> \<theta>'" "src w \<star> e'"]
         by auto
       hence "inverse_arrows \<theta>' (e'e.trnr\<^sub>\<eta> m \<theta>)"
         using mn 4 left_adjoint_is_ide inverse_arrows_def by simp
       hence 5: "iso \<theta>'"
         by auto
       have "equivalence_map (src w \<star> e')"
         using assms obj_is_equivalence_map equiv_e' `hseq (src w) e'` equivalence_maps_compose
         by auto
       hence "equivalence_map m"
         using * 5 equivalence_map_preserved_by_iso isomorphic_def by auto
       hence "equivalence_map m\<^sup>*"
         using mn m\<^sub>a right_adjoint_to_equivalence_is_equivalence by simp
       hence "is_left_adjoint m\<^sup>*"
         using equivalence_is_left_adjoint by simp
       moreover have "hseq n m\<^sup>*"
         using mn isomorphic_implies_ide by auto
       ultimately have "is_left_adjoint (n \<star> m\<^sup>*)"
         using mn left_adjoints_compose by blast
       thus ?thesis
         using mn left_adjoint_preserved_by_iso isomorphic_def isomorphic_symmetric
         by metis
     qed
 
   end
 
   subsection "Choosing Tabulations"
 
   context bicategory_of_spans
   begin
 
     notation isomorphic  (infix "\<cong>" 50)
     notation iso_class ("\<lbrakk>_\<rbrakk>")
 
     text \<open>
       We will ultimately need to have chosen a specific tabulation for each 1-cell.
       This has to be done carefully, to avoid unnecessary choices.
       We start out by using \<open>BS1\<close> to choose a specific factorization of the form
       \<open>r \<cong> tab\<^sub>1 r \<star> (tab\<^sub>0 r)\<^sup>*\<close> for each 1-cell \<open>r\<close>.  This has to be done in such a way
       that all elements of an isomorphism class are assigned the same factorization.
     \<close>
 
     abbreviation isomorphic_rep
     where "isomorphic_rep r f g \<equiv> is_left_adjoint f \<and> is_left_adjoint g \<and> g \<star> f\<^sup>* \<cong> r"
 
     definition tab\<^sub>0
     where "tab\<^sub>0 r \<equiv> SOME f. \<exists>g. isomorphic_rep (iso_class_rep \<lbrakk>r\<rbrakk>) f g"
 
     definition tab\<^sub>1
     where "tab\<^sub>1 r \<equiv> SOME g. isomorphic_rep (iso_class_rep \<lbrakk>r\<rbrakk>) (tab\<^sub>0 r) g"
 
     definition rep
     where "rep r \<equiv> SOME \<phi>. \<guillemotleft>\<phi> : tab\<^sub>1 r \<star> (tab\<^sub>0 r)\<^sup>* \<Rightarrow> r\<guillemotright> \<and> iso \<phi>"
 
     lemma rep_props:
     assumes "ide r"
     shows "\<guillemotleft>rep r : tab\<^sub>1 r \<star> (tab\<^sub>0 r)\<^sup>* \<Rightarrow> r\<guillemotright>" and "iso (rep r)"
     and "r \<cong> iso_class_rep \<lbrakk>r\<rbrakk>"
     and "isomorphic_rep r (tab\<^sub>0 r) (tab\<^sub>1 r)"
     and "tab\<^sub>1 r \<star> (tab\<^sub>0 r)\<^sup>* \<cong> r"
     proof -
       have 1: "isomorphic_rep r (tab\<^sub>0 r) (tab\<^sub>1 r)"
       proof -
         have "\<exists>f g. isomorphic_rep (iso_class_rep \<lbrakk>r\<rbrakk>) f g"
           using assms BS1 isomorphic_symmetric rep_iso_class isomorphic_transitive
           by blast
         hence "isomorphic_rep (iso_class_rep \<lbrakk>r\<rbrakk>) (tab\<^sub>0 r) (tab\<^sub>1 r)"
           using assms tab\<^sub>0_def tab\<^sub>1_def 
                 someI_ex [of "\<lambda>f. \<exists>g. isomorphic_rep (iso_class_rep \<lbrakk>r\<rbrakk>) f g"]
                 someI_ex [of "\<lambda>g. isomorphic_rep (iso_class_rep \<lbrakk>r\<rbrakk>) (tab\<^sub>0 r) g"]
           by simp
         thus ?thesis
           using assms isomorphic_symmetric isomorphic_transitive rep_iso_class by blast
       qed
       hence "\<exists>\<phi>. \<guillemotleft>\<phi> : tab\<^sub>1 r \<star> (tab\<^sub>0 r)\<^sup>* \<Rightarrow> r\<guillemotright> \<and> iso \<phi>"
         using isomorphic_def by blast
       hence 2: "\<guillemotleft>rep r : tab\<^sub>1 r \<star> (tab\<^sub>0 r)\<^sup>* \<Rightarrow> r\<guillemotright> \<and> iso (rep r)"
         using someI_ex [of "\<lambda>\<phi>. \<guillemotleft>\<phi> : tab\<^sub>1 r \<star> (tab\<^sub>0 r)\<^sup>* \<Rightarrow> r\<guillemotright> \<and> iso \<phi>"] rep_def by auto
       show "\<guillemotleft>rep r : tab\<^sub>1 r \<star> (tab\<^sub>0 r)\<^sup>* \<Rightarrow> r\<guillemotright>"
         using 2 by simp
       show "iso (rep r)"
         using 2 by simp
       show "r \<cong> iso_class_rep \<lbrakk>r\<rbrakk>"
         using assms rep_iso_class isomorphic_symmetric by simp
       thus "isomorphic_rep r (tab\<^sub>0 r) (tab\<^sub>1 r)"
         using 1 isomorphic_transitive by blast
       thus "tab\<^sub>1 r \<star> (tab\<^sub>0 r)\<^sup>* \<cong> r"
         by simp
     qed
 
     lemma tab\<^sub>0_in_hom [intro]:
     assumes "ide r"
     shows "\<guillemotleft>tab\<^sub>0 r : src (tab\<^sub>0 r) \<rightarrow> src r\<guillemotright>"
     and "\<guillemotleft>tab\<^sub>0 r : tab\<^sub>0 r \<Rightarrow> tab\<^sub>0 r\<guillemotright>"
     proof -
       show "\<guillemotleft>tab\<^sub>0 r : tab\<^sub>0 r \<Rightarrow> tab\<^sub>0 r\<guillemotright>"
         using assms rep_props left_adjoint_is_ide by auto
       have "trg (tab\<^sub>0 r) = src r"
         using assms rep_props
         by (metis ideD(1) isomorphic_implies_hpar(1) isomorphic_implies_hpar(3)
             right_adjoint_simps(2) src_hcomp)
       thus "\<guillemotleft>tab\<^sub>0 r : src (tab\<^sub>0 r) \<rightarrow> src r\<guillemotright>"
         using assms rep_props left_adjoint_is_ide
         by (intro in_hhomI, auto)
     qed
 
     lemma tab\<^sub>0_simps [simp]:
     assumes "ide r"
     shows "ide (tab\<^sub>0 r)"
     and "is_left_adjoint (tab\<^sub>0 r)"
     and "trg (tab\<^sub>0 r) = src r"
     and "dom (tab\<^sub>0 r) = tab\<^sub>0 r" and "cod (tab\<^sub>0 r) = tab\<^sub>0 r"
       using assms tab\<^sub>0_in_hom rep_props ide_dom left_adjoint_is_ide by auto
 
     lemma tab\<^sub>1_in_hom [intro]:
     assumes "ide r"
     shows "\<guillemotleft>tab\<^sub>1 r : src (tab\<^sub>0 r) \<rightarrow> trg r\<guillemotright>"
     and "\<guillemotleft>tab\<^sub>1 r : tab\<^sub>1 r \<Rightarrow> tab\<^sub>1 r\<guillemotright>"
     proof -
       show "\<guillemotleft>tab\<^sub>1 r : tab\<^sub>1 r \<Rightarrow> tab\<^sub>1 r\<guillemotright>"
         using assms rep_props left_adjoint_is_ide by auto
       have "trg (tab\<^sub>1 r) = trg r"
         using assms rep_props
         by (metis ideD(1) isomorphic_implies_hpar(1) isomorphic_implies_hpar(4) trg_hcomp)
       moreover have "src (tab\<^sub>0 r) = src (tab\<^sub>1 r)"
         using assms rep_props by fastforce
       ultimately show "\<guillemotleft>tab\<^sub>1 r : src (tab\<^sub>0 r) \<rightarrow> trg r\<guillemotright>"
         using assms rep_props left_adjoint_is_ide
         by (intro in_hhomI, auto)
     qed
 
     lemma tab\<^sub>1_simps [simp]:
     assumes "ide r"
     shows "ide (tab\<^sub>1 r)"
     and "is_left_adjoint (tab\<^sub>1 r)"
     and "src (tab\<^sub>1 r) = src (tab\<^sub>0 r)" and "trg (tab\<^sub>1 r) = trg r"
     and "dom (tab\<^sub>1 r) = tab\<^sub>1 r" and "cod (tab\<^sub>1 r) = tab\<^sub>1 r"
       using assms tab\<^sub>1_in_hom rep_props ide_dom left_adjoint_is_ide by auto
 
     lemma rep_in_hom [intro]:
     assumes "ide r"
     shows "\<guillemotleft>rep r : src r \<rightarrow> trg r\<guillemotright>"
     and "\<guillemotleft>rep r : tab\<^sub>1 r \<star> (tab\<^sub>0 r)\<^sup>* \<Rightarrow> r\<guillemotright>"
     proof -
       show "\<guillemotleft>rep r : tab\<^sub>1 r \<star> (tab\<^sub>0 r)\<^sup>* \<Rightarrow> r\<guillemotright>"
         using assms rep_props by auto
       thus "\<guillemotleft>rep r : src r \<rightarrow> trg r\<guillemotright>"
         using src_cod trg_cod by fastforce
     qed
 
     lemma rep_simps [simp]:
     assumes "ide r"
     shows "arr (rep r)"
     and "src (rep r) = src r" and "trg (rep r) = trg r"
     and "dom (rep r) = tab\<^sub>1 r \<star> (tab\<^sub>0 r)\<^sup>*" and "cod (rep r) = r"
      using assms rep_in_hom by auto
 
     lemma iso_rep:
     assumes "ide r"
     shows "iso (rep r)"
       using assms rep_props by simp
 
   end
 
   text \<open>
     Next, we assign a specific tabulation to each 1-cell r.
     We can't just do this any old way if we ultimately expect to obtain a mapping that is
     functorial with respect to vertical composition.  What we have to do is to assign the
     representative \<open>tab\<^sub>1 r \<star> (tab\<^sub>0 r)\<^sup>*\<close> its canonical tabulation, obtained as the adjoint
     transpose of the identity, and then translate this to a tabulation of \<open>r\<close> via the chosen
     isomorphism \<open>\<guillemotleft>rep r : tab\<^sub>1 r \<star> (tab\<^sub>0 r)\<^sup>* \<Rightarrow> r\<guillemotright>\<close>.
   \<close>
 
   locale identity_in_bicategory_of_spans =
     bicategory_of_spans +
   fixes r :: 'a
   assumes is_ide: "ide r"
   begin
 
     interpretation tab\<^sub>0: map_in_bicategory V H \<a> \<i> src trg \<open>tab\<^sub>0 r\<close>
       using is_ide rep_props by unfold_locales auto
     interpretation tab\<^sub>1: map_in_bicategory V H \<a> \<i> src trg \<open>tab\<^sub>1 r\<close>
       using is_ide rep_props by unfold_locales auto
 
     text \<open>
       A tabulation \<open>(tab\<^sub>0 r, tab, tab\<^sub>1 r)\<close> of \<open>r\<close> can be obtained as the adjoint transpose
       of the isomorphism \<open>\<guillemotleft>rep r : (tab\<^sub>1 r) \<star> (tab\<^sub>0 r)\<^sup>* \<Rightarrow> r\<guillemotright>\<close>.  It is essential to define
       it this way if we expect the mapping from 2-cells of the underlying bicategory
       to arrows of spans to preserve vertical composition.
     \<close>
 
     definition tab
     where "tab \<equiv> tab\<^sub>0.trnr\<^sub>\<eta> (tab\<^sub>1 r) (rep r)"
 
     text \<open>
       In view of \<open>BS2'\<close>, the 1-cell \<open>(tab\<^sub>1 r) \<star> (tab\<^sub>0 r)\<^sup>*\<close> has the canonical tabulation
       obtained via adjoint transpose of an identity.  In fact, this tabulation generates the
       chosen tabulation of \<open>r\<close> in the same isomorphism class by translation along the
       isomorphism \<open>\<guillemotleft>rep r : (tab\<^sub>1 r) \<star> (tab\<^sub>0 r)\<^sup>* \<Rightarrow> r\<guillemotright>\<close>.  This fact is used to show that the
       mapping from 2-cells to arrows of spans preserves identities.
     \<close>
 
     lemma canonical_tabulation:
     shows "tabulation V H \<a> \<i> src trg
              ((tab\<^sub>1 r) \<star> (tab\<^sub>0 r)\<^sup>*) (tab\<^sub>0.trnr\<^sub>\<eta> (tab\<^sub>1 r) ((tab\<^sub>1 r) \<star> (tab\<^sub>0 r)\<^sup>*)) (tab\<^sub>0 r) (tab\<^sub>1 r)"
     proof -
       have "\<exists>\<rho>. tabulation V H \<a> \<i> src trg ((tab\<^sub>1 r) \<star> (tab\<^sub>0 r)\<^sup>*) \<rho> (tab\<^sub>0 r) (tab\<^sub>1 r)"
         by (simp add: bicategory_of_spans.BS2' bicategory_of_spans_axioms is_ide
             isomorphic_reflexive)
       thus ?thesis
         using is_ide tab\<^sub>0.canonical_tabulation by simp
     qed
 
     lemma tab_def_alt:
     shows "tab = (rep r \<star> tab\<^sub>0 r) \<cdot> tab\<^sub>0.trnr\<^sub>\<eta> (tab\<^sub>1 r) ((tab\<^sub>1 r) \<star> (tab\<^sub>0 r)\<^sup>*)"
     and "(inv (rep r) \<star> tab\<^sub>0 r) \<cdot> tab = tab\<^sub>0.trnr\<^sub>\<eta> (tab\<^sub>1 r) ((tab\<^sub>1 r) \<star> (tab\<^sub>0 r)\<^sup>*)"
     proof -
       have "tab = tab\<^sub>0.trnr\<^sub>\<eta> (tab\<^sub>1 r) (rep r \<cdot> ((tab\<^sub>1 r) \<star> (tab\<^sub>0 r)\<^sup>*))"
         using tab_def is_ide rep_in_hom [of r] comp_arr_dom by auto
       also have "... = (rep r \<star> tab\<^sub>0 r) \<cdot> tab\<^sub>0.trnr\<^sub>\<eta> (tab\<^sub>1 r) ((tab\<^sub>1 r) \<star> (tab\<^sub>0 r)\<^sup>*)"
         using is_ide tab\<^sub>0.trnr\<^sub>\<eta>_comp by auto
       finally show 1: "tab = (rep r \<star> tab\<^sub>0 r) \<cdot> tab\<^sub>0.trnr\<^sub>\<eta> (tab\<^sub>1 r) ((tab\<^sub>1 r) \<star> (tab\<^sub>0 r)\<^sup>*)" by simp
       have "(inv (rep r) \<star> tab\<^sub>0 r) \<cdot> tab =
             ((inv (rep r) \<star> tab\<^sub>0 r) \<cdot> (rep r \<star> tab\<^sub>0 r)) \<cdot> tab\<^sub>0.trnr\<^sub>\<eta> (tab\<^sub>1 r) ((tab\<^sub>1 r) \<star> (tab\<^sub>0 r)\<^sup>*)"
         unfolding 1 using comp_assoc by presburger
       also have "... = tab\<^sub>0.trnr\<^sub>\<eta> (tab\<^sub>1 r) ((tab\<^sub>1 r) \<star> (tab\<^sub>0 r)\<^sup>*)"
       proof - 
         have 1: "(inv (rep r) \<star> tab\<^sub>0 r) \<cdot> (rep r \<star> tab\<^sub>0 r) = ((tab\<^sub>1 r) \<star> (tab\<^sub>0 r)\<^sup>*) \<star> tab\<^sub>0 r"
           using whisker_right [of "tab\<^sub>0 r" "inv (rep r)" "rep r"] iso_rep rep_in_hom
                 inv_is_inverse comp_inv_arr
           by (simp add: comp_inv_arr' is_ide)
         show ?thesis
         proof -
           have "\<guillemotleft>tab\<^sub>0.trnr\<^sub>\<eta> (tab\<^sub>1 r) ((tab\<^sub>1 r) \<star> (tab\<^sub>0 r)\<^sup>*) :
                    tab\<^sub>1 r \<Rightarrow> (tab\<^sub>1 r \<star> (tab\<^sub>0 r)\<^sup>*) \<star> tab\<^sub>0 r\<guillemotright>"
             by (meson canonical_tabulation tabulation_data.tab_in_hom(2) tabulation_def)
           hence "((tab\<^sub>1 r \<star> (tab\<^sub>0 r)\<^sup>*) \<star> tab\<^sub>0 r) \<cdot> tab\<^sub>0.trnr\<^sub>\<eta> (tab\<^sub>1 r) ((tab\<^sub>1 r) \<star> (tab\<^sub>0 r)\<^sup>*) =
                  tab\<^sub>0.trnr\<^sub>\<eta> (tab\<^sub>1 r) ((tab\<^sub>1 r) \<star> (tab\<^sub>0 r)\<^sup>*)"
             using 1 comp_cod_arr by blast
           thus ?thesis
             using 1 by simp
         qed
       qed
       finally show "(inv (rep r) \<star> tab\<^sub>0 r) \<cdot> tab = tab\<^sub>0.trnr\<^sub>\<eta> (tab\<^sub>1 r) ((tab\<^sub>1 r) \<star> (tab\<^sub>0 r)\<^sup>*)"
         by blast
     qed
 
     lemma tab_is_tabulation:
     shows "tabulation V H \<a> \<i> src trg r tab (tab\<^sub>0 r) (tab\<^sub>1 r)"
       by (metis bicategory_of_spans.iso_rep bicategory_of_spans.rep_in_hom(2)
           bicategory_of_spans_axioms is_ide canonical_tabulation tab_def_alt(1)
           tabulation.is_preserved_by_base_iso)
 
     (*
      * TODO: If I pull the interpretation "tab" out of the following, Isabelle warns that
      * the lemma is a redundant introduction rule and is being "ignored" for that purpose.
      * However, the redundancy is only in the present context: if the enclosing locale is
      * interpreted elsewhere, then the rule is not redundant.  In order to make sure that
      * the rule is not "ignored", I have put the interpretation "tab" into the proof to
      * avoid the warning.
      *)
 
     lemma tab_in_hom [intro]:
     shows "\<guillemotleft>tab : src (tab\<^sub>0 r) \<rightarrow> trg r\<guillemotright>"
     and "\<guillemotleft>tab : tab\<^sub>1 r \<Rightarrow> r \<star> tab\<^sub>0 r\<guillemotright>"
     proof -
       interpret tab: tabulation V H \<a> \<i> src trg r tab \<open>tab\<^sub>0 r\<close> \<open>tab\<^sub>1 r\<close>
         using tab_is_tabulation by simp
       show "\<guillemotleft>tab : src (tab\<^sub>0 r) \<rightarrow> trg r\<guillemotright>"
         using tab.tab_in_hom by auto
       show "\<guillemotleft>tab : tab\<^sub>1 r \<Rightarrow> r \<star> tab\<^sub>0 r\<guillemotright>"
         using tab.tab_in_hom by auto
     qed
 
     lemma tab_simps [simp]:
     shows "arr tab"
     and "src tab = src (tab\<^sub>0 r)" and "trg tab = trg r"
     and "dom tab = tab\<^sub>1 r" and "cod tab = r \<star> tab\<^sub>0 r"
       using tab_in_hom by auto
 
   end
 
   text \<open>
     The following makes the chosen tabulation conveniently available whenever we are
     considering a particular 1-cell.
   \<close>
 
   sublocale identity_in_bicategory_of_spans \<subseteq> tabulation V H \<a> \<i> src trg r tab \<open>tab\<^sub>0 r\<close> \<open>tab\<^sub>1 r\<close>
     using is_ide tab_is_tabulation by simp
 
   context identity_in_bicategory_of_spans
   begin
 
     interpretation tab\<^sub>0: map_in_bicategory V H \<a> \<i> src trg \<open>tab\<^sub>0 r\<close>
       using is_ide rep_props by unfold_locales auto
     interpretation tab\<^sub>1: map_in_bicategory V H \<a> \<i> src trg \<open>tab\<^sub>1 r\<close>
       using is_ide rep_props by unfold_locales auto
 
     text \<open>
       The fact that adjoint transpose is a bijection allows us to invert the definition
       of \<open>tab\<close> in terms of \<open>rep\<close> to express rep in terms of tab.
     \<close>
 
     lemma rep_in_terms_of_tab:
     shows "rep r = T0.trnr\<^sub>\<epsilon> r tab"
       using is_ide T0.adjoint_transpose_right(3) [of r "tab\<^sub>1 r" "rep r"] tab_def
       by fastforce
 
     lemma isomorphic_implies_same_tab:
     assumes "isomorphic r r'"
     shows "tab\<^sub>0 r = tab\<^sub>0 r'" and "tab\<^sub>1 r = tab\<^sub>1 r'"
       using assms tab\<^sub>0_def tab\<^sub>1_def iso_class_eqI by auto
 
     text \<open>
       ``Every 1-cell has a tabulation as a span of maps.''
       Has a nice simple ring to it, but maybe not so useful for us, since we generally
       really need to know that the tabulation has a specific form.
     \<close>
 
     lemma has_tabulation:
     shows "\<exists>\<rho> f g. is_left_adjoint f \<and> is_left_adjoint g \<and> tabulation V H \<a> \<i> src trg r \<rho> f g"
       using is_ide tab_is_tabulation rep_props by blast
 
   end
 
   subsection "Tabulations in a Bicategory of Spans"
 
   context bicategory_of_spans
   begin
 
     abbreviation tab_of_ide
     where "tab_of_ide r \<equiv> identity_in_bicategory_of_spans.tab V H \<a> \<i> src trg r"
 
     abbreviation prj\<^sub>0
     where "prj\<^sub>0 h k \<equiv> tab\<^sub>0 (k\<^sup>* \<star> h)"
 
     abbreviation prj\<^sub>1
     where "prj\<^sub>1 h k \<equiv> tab\<^sub>1 (k\<^sup>* \<star> h)"
 
     lemma prj_in_hom [intro]:
     assumes "ide h" and "is_left_adjoint k" and "trg h = trg k"
     shows "\<guillemotleft>prj\<^sub>0 h k : src (prj\<^sub>0 h k) \<rightarrow> src h\<guillemotright>"
     and "\<guillemotleft>prj\<^sub>1 h k : src (prj\<^sub>0 h k) \<rightarrow> src k\<guillemotright>"
     and "\<guillemotleft>prj\<^sub>0 h k : prj\<^sub>0 h k \<Rightarrow> prj\<^sub>0 h k\<guillemotright>"
     and "\<guillemotleft>prj\<^sub>1 h k : prj\<^sub>1 h k \<Rightarrow> prj\<^sub>1 h k\<guillemotright>"
       by (intro in_hhomI, auto simp add: assms(1-3))
 
     lemma prj_simps [simp]:
     assumes "ide h" and "is_left_adjoint k" and "trg h = trg k"
     shows "trg (prj\<^sub>0 h k) = src h"
     and "src (prj\<^sub>1 h k) = src (prj\<^sub>0 h k)" and "trg (prj\<^sub>1 h k) = src k"
     and "dom (prj\<^sub>0 h k) = prj\<^sub>0 h k" and "cod (prj\<^sub>0 h k) = prj\<^sub>0 h k"
     and "dom (prj\<^sub>1 h k) = prj\<^sub>1 h k" and "cod (prj\<^sub>1 h k) = prj\<^sub>1 h k"
     and "is_left_adjoint (prj\<^sub>0 h k)" and "is_left_adjoint (prj\<^sub>1 h k)"
       using assms prj_in_hom by auto
 
   end
 
   text \<open>
     Many of the commutativity conditions that we would otherwise have to worry about
     when working with tabulations in a bicategory of spans reduce to trivialities.
     The following locales try to exploit this to make our life more manageable.
   \<close>
 
   locale span_of_maps =
     bicategory_of_spans +
   fixes leg\<^sub>0 :: 'a
   and leg\<^sub>1 :: 'a
   assumes leg0_is_map: "is_left_adjoint leg\<^sub>0"
   and leg1_is_map : "is_left_adjoint leg\<^sub>1"
 
   text \<open>
     The purpose of the somewhat strange-looking assumptions in this locale is
     to cater to the form of data that we obtain from \<open>T1\<close>.  Under the assumption
     that we are in a bicategory of spans and that the legs of \<open>r\<close> and \<open>s\<close> are maps,
     the hypothesized 2-cells will be uniquely determined isomorphisms, and an
     arrow of spans \<open>w\<close> from \<open>r\<close> to \<open>s\<close> will be a map.  We want to prove this once and
     for all under the weakest assumptions we can manage.
   \<close>
 
   locale arrow_of_spans_of_maps =
     bicategory_of_spans V H \<a> \<i> src trg +
     r: span_of_maps V H \<a> \<i> src trg r\<^sub>0 r\<^sub>1 +
     s: span_of_maps V H \<a> \<i> src trg s\<^sub>0 s\<^sub>1
   for V :: "'a comp"                 (infixr "\<cdot>" 55)
   and H :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"          (infixr "\<star>" 53)
   and \<a> :: "'a \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a"    ("\<a>[_, _, _]")
   and \<i> :: "'a \<Rightarrow> 'a"                ("\<i>[_]")
   and src :: "'a \<Rightarrow> 'a"
   and trg :: "'a \<Rightarrow> 'a"
   and r\<^sub>0 :: 'a
   and r\<^sub>1 :: 'a
   and s\<^sub>0 :: 'a
   and s\<^sub>1 :: 'a
   and w :: 'a +
   assumes is_ide: "ide w"
   and leg0_lax: "\<exists>\<theta>. \<guillemotleft>\<theta> : s\<^sub>0 \<star> w \<Rightarrow> r\<^sub>0\<guillemotright>"
   and leg1_iso: "\<exists>\<nu>. \<guillemotleft>\<nu> : r\<^sub>1 \<Rightarrow> s\<^sub>1 \<star> w\<guillemotright> \<and> iso \<nu>"
   begin
 
     notation isomorphic  (infix "\<cong>" 50)
 
     lemma composite_leg1_is_map:
     shows "is_left_adjoint (s\<^sub>1 \<star> w)"
       using r.leg1_is_map leg1_iso left_adjoint_preserved_by_iso' isomorphic_def
             isomorphic_symmetric
       by auto
 
     lemma is_map:
     shows "is_left_adjoint w"
       using is_ide composite_leg1_is_map s.leg1_is_map BS4 [of s\<^sub>1 w] by auto
 
     lemma hseq_leg\<^sub>0:
     shows "hseq s\<^sub>0 w"
       by (metis ideD(1) ide_dom in_homE leg0_lax)
 
     lemma composite_with_leg0_is_map:
     shows "is_left_adjoint (s\<^sub>0 \<star> w)"
       using left_adjoints_compose is_map s.leg0_is_map hseq_leg\<^sub>0 by blast
 
     lemma leg0_uniquely_isomorphic:
     shows "s\<^sub>0 \<star> w \<cong> r\<^sub>0"
     and "\<exists>!\<theta>. \<guillemotleft>\<theta> : s\<^sub>0 \<star> w \<Rightarrow> r\<^sub>0\<guillemotright>"
     proof -
       show 1: "s\<^sub>0 \<star> w \<cong> r\<^sub>0"
         using leg0_lax composite_with_leg0_is_map r.leg0_is_map BS3 [of "s\<^sub>0 \<star> w" r\<^sub>0]
               isomorphic_def
         by auto
       have "\<exists>\<theta>. \<guillemotleft>\<theta> : s\<^sub>0 \<star> w \<Rightarrow> r\<^sub>0\<guillemotright> \<and> iso \<theta>"
         using 1 isomorphic_def by simp
       moreover have "\<And>\<theta> \<theta>'. \<guillemotleft>\<theta> : s\<^sub>0 \<star> w \<Rightarrow> r\<^sub>0\<guillemotright> \<Longrightarrow> \<guillemotleft>\<theta>' : s\<^sub>0 \<star> w \<Rightarrow> r\<^sub>0\<guillemotright> \<Longrightarrow> \<theta> = \<theta>'"
         using BS3 r.leg0_is_map composite_with_leg0_is_map by blast
       ultimately show "\<exists>!\<theta>. \<guillemotleft>\<theta> : s\<^sub>0 \<star> w \<Rightarrow> r\<^sub>0\<guillemotright>" by blast
     qed
 
     lemma leg1_uniquely_isomorphic:
     shows "r\<^sub>1 \<cong> s\<^sub>1 \<star> w"
     and "\<exists>!\<nu>. \<guillemotleft>\<nu> : r\<^sub>1 \<Rightarrow> s\<^sub>1 \<star> w\<guillemotright>"
     proof -
       show 1: "r\<^sub>1 \<cong> s\<^sub>1 \<star> w"
         using leg1_iso isomorphic_def by auto
       have "\<exists>\<nu>. \<guillemotleft>\<nu> : r\<^sub>1 \<Rightarrow> s\<^sub>1 \<star> w\<guillemotright> \<and> iso \<nu>"
         using leg1_iso isomorphic_def isomorphic_symmetric by simp
       moreover have "\<And>\<nu> \<nu>'. \<guillemotleft>\<nu> : r\<^sub>1 \<Rightarrow> s\<^sub>1 \<star> w\<guillemotright> \<Longrightarrow> \<guillemotleft>\<nu>' : r\<^sub>1 \<Rightarrow> s\<^sub>1 \<star> w\<guillemotright> \<Longrightarrow> \<nu> = \<nu>'"
         using BS3 r.leg1_is_map composite_leg1_is_map by blast
       ultimately show "\<exists>!\<nu>. \<guillemotleft>\<nu> : r\<^sub>1 \<Rightarrow> s\<^sub>1 \<star> w\<guillemotright>" by blast
     qed
 
     definition the_\<theta>
     where "the_\<theta> \<equiv> THE \<theta>. \<guillemotleft>\<theta> : s\<^sub>0 \<star> w \<Rightarrow> r\<^sub>0\<guillemotright>"
 
     definition the_\<nu>
     where "the_\<nu> \<equiv> THE \<nu>. \<guillemotleft>\<nu> : r\<^sub>1 \<Rightarrow> s\<^sub>1 \<star> w\<guillemotright>"
 
     lemma the_\<theta>_props:
     shows "\<guillemotleft>the_\<theta> : s\<^sub>0 \<star> w \<Rightarrow> r\<^sub>0\<guillemotright>" and "iso the_\<theta>"
     proof -
       show "\<guillemotleft>the_\<theta> : s\<^sub>0 \<star> w \<Rightarrow> r\<^sub>0\<guillemotright>"
         unfolding the_\<theta>_def
         using the1I2 [of "\<lambda>\<theta>. \<guillemotleft>\<theta> : s\<^sub>0 \<star> w \<Rightarrow> r\<^sub>0\<guillemotright>" "\<lambda>\<theta>. \<guillemotleft>\<theta> : s\<^sub>0 \<star> w \<Rightarrow> r\<^sub>0\<guillemotright>"]
               leg0_uniquely_isomorphic
         by simp
       thus "iso the_\<theta>"
         using BS3 r.leg0_is_map composite_with_leg0_is_map by simp
     qed
 
     lemma the_\<theta>_in_hom [intro]:
     shows "\<guillemotleft>the_\<theta> : src r\<^sub>0 \<rightarrow> trg r\<^sub>0\<guillemotright>"
     and "\<guillemotleft>the_\<theta> : s\<^sub>0 \<star> w \<Rightarrow> r\<^sub>0\<guillemotright>"
       using the_\<theta>_props apply auto
       by (metis cod_trg in_hhom_def in_homE isomorphic_implies_hpar(3) leg0_uniquely_isomorphic(1)
           src_dom trg.preserves_cod)
 
     lemma the_\<theta>_simps [simp]:
     shows "arr the_\<theta>"
     and "src the_\<theta> = src r\<^sub>0" and "trg the_\<theta> = trg r\<^sub>0"
     and "dom the_\<theta> = s\<^sub>0 \<star> w" and "cod the_\<theta> = r\<^sub>0"
       using the_\<theta>_in_hom by auto
 
     lemma the_\<nu>_props:
     shows "\<guillemotleft>the_\<nu> : r\<^sub>1 \<Rightarrow> s\<^sub>1 \<star> w\<guillemotright>" and "iso the_\<nu>"
     proof -
       show "\<guillemotleft>the_\<nu> : r\<^sub>1 \<Rightarrow> s\<^sub>1 \<star> w\<guillemotright>"
         unfolding the_\<nu>_def
         using the1I2 [of "\<lambda>\<nu>. \<guillemotleft>\<nu> : r\<^sub>1 \<Rightarrow> s\<^sub>1 \<star> w\<guillemotright>" "\<lambda>\<nu>. \<guillemotleft>\<nu> : r\<^sub>1 \<Rightarrow> s\<^sub>1 \<star> w\<guillemotright>"]
               leg1_uniquely_isomorphic
         by simp
       thus "iso the_\<nu>"
         using BS3 r.leg1_is_map composite_leg1_is_map by simp
     qed
 
     lemma the_\<nu>_in_hom [intro]:
     shows "\<guillemotleft>the_\<nu> : src r\<^sub>1 \<rightarrow> trg r\<^sub>1\<guillemotright>"
     and "\<guillemotleft>the_\<nu> : r\<^sub>1 \<Rightarrow> s\<^sub>1 \<star> w\<guillemotright>"
       using the_\<nu>_props apply auto
       by (metis in_hhom_def in_homE isomorphic_implies_hpar(3) leg1_uniquely_isomorphic(1)
           src_cod trg_dom)
 
     lemma the_\<nu>_simps [simp]:
     shows "arr the_\<nu>"
     and "src the_\<nu> = src r\<^sub>1" and "trg the_\<nu> = trg r\<^sub>1"
     and "dom the_\<nu> = r\<^sub>1" and "cod the_\<nu> = s\<^sub>1 \<star> w"
       using the_\<nu>_in_hom by auto
 
   end
 
   (*
    * TODO: I could probably avoid repeating the declarations of the locale parameters
    * if I was willing to accept them being given in their order of appearance.
    *)
 
   locale arrow_of_spans_of_maps_to_tabulation_data =
     bicategory_of_spans V H \<a> \<i> src trg +
     arrow_of_spans_of_maps V H \<a> \<i> src trg r\<^sub>0 r\<^sub>1 s\<^sub>0 s\<^sub>1 w +
     \<sigma>: tabulation_data V H \<a> \<i> src trg s \<sigma> s\<^sub>0 s\<^sub>1
   for V :: "'a comp"                 (infixr "\<cdot>" 55)
   and H :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"          (infixr "\<star>" 53)
   and \<a> :: "'a \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a"     ("\<a>[_, _, _]")
   and \<i> :: "'a \<Rightarrow> 'a"                 ("\<i>[_]")
   and src :: "'a \<Rightarrow> 'a"
   and trg :: "'a \<Rightarrow> 'a"
   and r\<^sub>0 :: 'a
   and r\<^sub>1 :: 'a
   and s :: 'a
   and \<sigma> :: 'a
   and s\<^sub>0 :: 'a
   and s\<^sub>1 :: 'a
   and w :: 'a
 
   text \<open>
     The following declaration allows us to inherit the rules and other facts defined in
     locale @{locale uw\<theta>}.  It is tedious to prove very much without these in place.
   \<close>
 
   sublocale arrow_of_spans_of_maps_to_tabulation_data \<subseteq> uw\<theta> V H \<a> \<i> src trg s \<sigma> s\<^sub>0 s\<^sub>1 r\<^sub>0 w the_\<theta>
     using \<sigma>.tab_in_hom is_ide the_\<theta>_props by unfold_locales auto
 
   locale arrow_of_spans_of_maps_to_tabulation =
     arrow_of_spans_of_maps_to_tabulation_data +
     tabulation V H \<a> \<i> src trg s \<sigma> s\<^sub>0 s\<^sub>1
 
   locale tabulation_in_maps =
     span_of_maps V H \<a> \<i> src trg s\<^sub>0 s\<^sub>1 +
     tabulation V H \<a> \<i> src trg s \<sigma> s\<^sub>0 s\<^sub>1
   for V :: "'a comp"                 (infixr "\<cdot>" 55)
   and H :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"          (infixr "\<star>" 53)
   and \<a> :: "'a \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a"     ("\<a>[_, _, _]")
   and \<i> :: "'a \<Rightarrow> 'a"                 ("\<i>[_]")
   and src :: "'a \<Rightarrow> 'a"
   and trg :: "'a \<Rightarrow> 'a"
   and s :: 'a
   and \<sigma> :: 'a
   and s\<^sub>0 :: 'a
   and s\<^sub>1 :: 'a
 
   sublocale tabulation_in_maps \<subseteq> tabulation V H \<a> \<i> src trg s \<sigma> s\<^sub>0 s\<^sub>1 ..
 
   sublocale identity_in_bicategory_of_spans \<subseteq>
               tabulation_in_maps V H \<a> \<i> src trg r tab \<open>tab\<^sub>0 r\<close> \<open>tab\<^sub>1 r\<close>
     using is_ide rep_props by unfold_locales auto
 
   locale cospan_of_maps_in_bicategory_of_spans =
     bicategory_of_spans +
     fixes h :: 'a
     and k :: 'a
     assumes h_is_map: "is_left_adjoint h"
     and k_is_map: "is_left_adjoint k"
     and cospan: "trg h = trg k"
   begin
 
     text \<open>
       The following sublocale declaration is perhaps pushing the limits of sensibility,
       but the purpose is, given a cospan of maps \<open>(h, k)\<close>, to obtain ready access to the
       composite \<open>k\<^sup>* \<star> h\<close> and its chosen tabulation.
     \<close>
 
     sublocale identity_in_bicategory_of_spans V H \<a> \<i> src trg \<open>k\<^sup>* \<star> h\<close>
       using h_is_map k_is_map cospan left_adjoint_is_ide
       by unfold_locales auto
 
     notation isomorphic  (infix "\<cong>" 50)
 
     interpretation E: self_evaluation_map V H \<a> \<i> src trg ..
     notation E.eval ("\<lbrace>_\<rbrace>")
 
     interpretation h: map_in_bicategory V H \<a> \<i> src trg h
       using h_is_map by unfold_locales auto
     interpretation k: map_in_bicategory V H \<a> \<i> src trg k
       using k_is_map by unfold_locales auto
 
     text \<open>
       Our goal here is to reformulate the biuniversal properties of the chosen tabulation
       of \<open>k\<^sup>* \<star> h\<close> in terms of its transpose, which yields a 2-cell from \<open>k \<star> tab\<^sub>1 (k\<^sup>* \<star> h)\<close>
       to \<open>h \<star> tab\<^sub>0 (k\<^sup>* \<star> h)\<close>.  These results do not depend on \<open>BS3\<close>.
     \<close>
 
     abbreviation p\<^sub>0
     where "p\<^sub>0 \<equiv> prj\<^sub>0 h k"
 
     abbreviation p\<^sub>1
     where "p\<^sub>1 \<equiv> prj\<^sub>1 h k"
 
     lemma p\<^sub>0_in_hom [intro]:
     shows "\<guillemotleft>p\<^sub>0 : src p\<^sub>0 \<rightarrow> src h\<guillemotright>"
       by auto
 
     lemma p\<^sub>1_in_hom [intro]:
     shows "\<guillemotleft>p\<^sub>1 : src p\<^sub>0 \<rightarrow> src k\<guillemotright>"
       using prj_in_hom cospan h.ide_left k_is_map by blast
 
     lemma p\<^sub>0_simps [simp]:
     shows "trg p\<^sub>0 = src h"
       by simp
 
     lemma p\<^sub>1_simps [simp]:
     shows "trg p\<^sub>1 = src k"
       using k.antipar(1) by auto
 
     definition \<phi>
     where "\<phi> \<equiv> k.trnl\<^sub>\<epsilon> (h \<star> p\<^sub>0) (\<a>[k\<^sup>*, h, p\<^sub>0] \<cdot> tab)"
 
     lemma \<phi>_in_hom [intro]:
     shows "\<guillemotleft>\<phi> : src p\<^sub>0 \<rightarrow> trg h\<guillemotright>"
     and "\<guillemotleft>\<phi> : k \<star> p\<^sub>1 \<Rightarrow> h \<star> p\<^sub>0\<guillemotright>"
     proof -
       show 1: "\<guillemotleft>\<phi> : k \<star> p\<^sub>1 \<Rightarrow> h \<star> p\<^sub>0\<guillemotright>"
         unfolding \<phi>_def
         using k.antipar cospan k.adjoint_transpose_left(2) [of "h \<star> p\<^sub>0" "p\<^sub>1"]
         by fastforce
       show "\<guillemotleft>\<phi> : src p\<^sub>0 \<rightarrow> trg h\<guillemotright>"
         using 1 k.antipar src_dom trg_cod by fastforce
     qed
 
     lemma \<phi>_simps [simp]:
     shows "arr \<phi>"
     and "src \<phi> = src p\<^sub>0" and "trg \<phi> = trg h"
     and "dom \<phi> = k \<star> p\<^sub>1" and "cod \<phi> = h \<star> p\<^sub>0"
       using \<phi>_in_hom by auto
 
     lemma transpose_\<phi>:
     shows "tab = \<a>\<^sup>-\<^sup>1[k\<^sup>*, h, p\<^sub>0] \<cdot> k.trnl\<^sub>\<eta> p\<^sub>1 \<phi>"
     proof -
       have "\<a>\<^sup>-\<^sup>1[k\<^sup>*, h, p\<^sub>0] \<cdot> k.trnl\<^sub>\<eta> p\<^sub>1 \<phi> = \<a>\<^sup>-\<^sup>1[k\<^sup>*, h, p\<^sub>0] \<cdot> \<a>[k\<^sup>*, h, p\<^sub>0] \<cdot> tab"
         unfolding \<phi>_def
         using k.antipar cospan
               k.adjoint_transpose_left(4)
                 [of "h \<star> p\<^sub>0" "p\<^sub>1" "\<a>[k\<^sup>*, h, p\<^sub>0] \<cdot> tab"]
         by fastforce
       also have "... = (\<a>\<^sup>-\<^sup>1[k\<^sup>*, h, p\<^sub>0] \<cdot> \<a>[k\<^sup>*, h, p\<^sub>0]) \<cdot> tab"
         using comp_assoc by presburger
       also have "... = tab"
         using k.antipar cospan comp_cod_arr comp_assoc_assoc' by simp
       finally show ?thesis by simp
     qed
 
     lemma transpose_triangle:
     assumes "ide w"
     and "\<guillemotleft>\<theta> : p\<^sub>0 \<star> w \<Rightarrow> u\<guillemotright>" and "\<guillemotleft>\<nu> : v \<Rightarrow> p\<^sub>1 \<star> w\<guillemotright>"
     shows "k.trnl\<^sub>\<epsilon> (h \<star> u) (\<a>[k\<^sup>*, h, u] \<cdot> ((k\<^sup>* \<star> h) \<star> \<theta>) \<cdot> \<a>[k\<^sup>* \<star> h, p\<^sub>0, w] \<cdot> (tab \<star> w) \<cdot> \<nu>) =
           (h \<star> \<theta>) \<cdot> \<a>[h, p\<^sub>0, w] \<cdot> (\<phi> \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[k, p\<^sub>1, w] \<cdot> (k \<star> \<nu>)"
     proof -
       have u: "ide u"
         using assms(2) by auto
       have v: "ide v"
         using assms(3) by auto
       have 0: "src p\<^sub>0 = trg w"
         by (metis assms(2) hseqE ideD(1) src.preserves_reflects_arr u vconn_implies_hpar(3))
       have 1: "src h = trg u"
         using assms(1-2) 0 trg_dom trg_cod vconn_implies_hpar(4) by auto
       have 2: "src k = trg v"
         using assms(1,3) 0 trg_dom trg_cod hseqI'
         by (metis ideD(1) leg1_simps(2) leg1_simps(3) p\<^sub>1_simps trg_hcomp vconn_implies_hpar(4))
       have 3: "src u = src v \<and> src u = src w"
         using assms 0 k.antipar src_dom src_cod hseqI'
         by (metis ideD(1) leg0_simps(2) leg1_simps(2) leg1_simps(3) src_hcomp
             vconn_implies_hpar(3))
       have 4: "src h = trg \<theta>"
         using assms 1 k.antipar by auto
       define \<chi> where "\<chi> = \<a>[k\<^sup>*, h, p\<^sub>0 \<star> w] \<cdot> \<a>[k\<^sup>* \<star> h, p\<^sub>0, w] \<cdot> (tab \<star> w)"
       have \<chi>: "\<guillemotleft>\<chi> : p\<^sub>1 \<star> w \<Rightarrow> k\<^sup>* \<star> h \<star> p\<^sub>0 \<star> w\<guillemotright>"
         unfolding \<chi>_def
         using assms 0 k.antipar cospan by (intro comp_in_homI, auto)
       have "k.trnl\<^sub>\<epsilon> (h \<star> u) (\<a>[k\<^sup>*, h, u] \<cdot> ((k\<^sup>* \<star> h) \<star> \<theta>) \<cdot> \<a>[k\<^sup>* \<star> h, p\<^sub>0, w] \<cdot> (tab \<star> w) \<cdot> \<nu>) =
             k.trnl\<^sub>\<epsilon> (h \<star> u) ((k\<^sup>* \<star> h \<star> \<theta>) \<cdot> \<chi> \<cdot> \<nu>)"
         unfolding \<chi>_def
         using assms 1 k.antipar cospan assoc_naturality [of "k\<^sup>*" h \<theta>] comp_assoc
         by (metis "4" h.ide_left ide_char in_homE k.ide_right)
       also have "... = k.trnl\<^sub>\<epsilon> (h \<star> u) (k\<^sup>* \<star> h \<star> \<theta>) \<cdot> (k \<star> \<chi> \<cdot> \<nu>)"
       proof -
         have "ide (h \<star> u)"
           using "1" u assms h.ide_left by blast
         moreover have "seq (k\<^sup>* \<star> h \<star> \<theta>) (\<chi> \<cdot> \<nu>)"
           using assms 1 k.antipar cospan \<chi> seqI'
           apply (intro seqI)
                   apply auto
             apply blast
         proof -
           have "dom (k\<^sup>* \<star> h \<star> \<theta>) = k\<^sup>* \<star> h \<star> p\<^sub>0 \<star> w"
              using assms
              by (metis "4" cospan hcomp_simps(2-3) h.ide_left hseqI' ide_char in_homE
                  k.antipar(2) k.ide_right) 
           also have "... = cod \<chi>"
              using \<chi> by auto
           finally show "dom (k\<^sup>* \<star> h \<star> \<theta>) = cod \<chi>" by simp
         qed
         moreover have "src k = trg (k\<^sup>* \<star> h \<star> \<theta>)"
           using assms k.antipar cospan calculation(2) by auto
         ultimately show ?thesis
           using k.trnl\<^sub>\<epsilon>_comp by simp
       qed
       also have "... = k.trnl\<^sub>\<epsilon> (h \<star> u) (k\<^sup>* \<star> h \<star> \<theta>) \<cdot> (k \<star> \<chi>) \<cdot> (k \<star> \<nu>)"
         using assms u \<chi> whisker_left
         by (metis k.ide_left seqI')
       also have
         "... = (\<l>[h \<star> u] \<cdot> (k.\<epsilon> \<star> h \<star> u) \<cdot> \<a>\<^sup>-\<^sup>1[k, k\<^sup>*, h \<star> u] \<cdot> (k \<star> k\<^sup>* \<star> h \<star> \<theta>)) \<cdot> (k \<star> \<chi>) \<cdot> (k \<star> \<nu>)"
         unfolding k.trnl\<^sub>\<epsilon>_def by simp
       also have "... = (h \<star> \<theta>) \<cdot>
                          (\<l>[h \<star> p\<^sub>0 \<star> w] \<cdot> (k.\<epsilon> \<star> h \<star> p\<^sub>0 \<star> w) \<cdot>
                          \<a>\<^sup>-\<^sup>1[k, k\<^sup>*, h \<star> p\<^sub>0 \<star> w] \<cdot> (k \<star> \<chi>)) \<cdot>
                          (k \<star> \<nu>)"
       proof -
         have "\<l>[h \<star> u] \<cdot> (k.\<epsilon> \<star> h \<star> u) \<cdot> \<a>\<^sup>-\<^sup>1[k, k\<^sup>*, h \<star> u] \<cdot> (k \<star> k\<^sup>* \<star> h \<star> \<theta>) =
               \<l>[h \<star> u] \<cdot> (k.\<epsilon> \<star> h \<star> u) \<cdot> ((k \<star> k\<^sup>*) \<star> h \<star> \<theta>) \<cdot> \<a>\<^sup>-\<^sup>1[k, k\<^sup>*, h \<star> p\<^sub>0 \<star> w]"
           using assms 4 k.antipar cospan assoc'_naturality [of k "k\<^sup>*" "h \<star> \<theta>"]
           by fastforce
         also have "... = \<l>[h \<star> u] \<cdot> ((k.\<epsilon> \<star> h \<star> u) \<cdot> ((k \<star> k\<^sup>*) \<star> h \<star> \<theta>)) \<cdot> \<a>\<^sup>-\<^sup>1[k, k\<^sup>*, h \<star> p\<^sub>0 \<star> w]"
           using comp_assoc by presburger
         also have "... = (\<l>[h \<star> u] \<cdot> (trg k \<star> h \<star> \<theta>)) \<cdot> (k.\<epsilon> \<star> h \<star> p\<^sub>0 \<star> w) \<cdot>
                            \<a>\<^sup>-\<^sup>1[k, k\<^sup>*, h \<star> p\<^sub>0 \<star> w]"
         proof -
           have "(k.\<epsilon> \<star> h \<star> u) \<cdot> ((k \<star> k\<^sup>*) \<star> h \<star> \<theta>) = k.\<epsilon> \<cdot> (k \<star> k\<^sup>*) \<star> (h \<star> u) \<cdot> (h \<star> \<theta>)"
             using assms 1 k.antipar cospan interchange comp_arr_dom comp_cod_arr
             by fastforce
           also have "... = k.\<epsilon> \<star> h \<star> \<theta>"
             using assms k.antipar cospan comp_arr_dom comp_cod_arr k.counit_in_hom
                   whisker_left
             by (metis h.ide_left in_homE)
           also have "... = (trg k \<star> h \<star> \<theta>) \<cdot> (k.\<epsilon> \<star> h \<star> p\<^sub>0 \<star> w)"
             using assms 4 k.antipar cospan whisker_left comp_arr_dom comp_cod_arr
                   interchange [of "trg k" k.\<epsilon> "h \<star> \<theta>" "h \<star> p\<^sub>0 \<star> w"]
             by auto
           finally have "(k.\<epsilon> \<star> h \<star> u) \<cdot> ((k \<star> k\<^sup>*) \<star> h \<star> \<theta>) = (trg k \<star> h \<star> \<theta>) \<cdot> (k.\<epsilon> \<star> h \<star> p\<^sub>0 \<star> w)"
             by simp
           thus ?thesis
             using comp_assoc by presburger
         qed
         also have "... = (h \<star> \<theta>) \<cdot> \<l>[h \<star> p\<^sub>0 \<star> w] \<cdot> (k.\<epsilon> \<star> h \<star> p\<^sub>0 \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[k, k\<^sup>*, h \<star> p\<^sub>0 \<star> w]"
         proof -
           have "\<l>[h \<star> u] \<cdot> (trg k \<star> h \<star> \<theta>) = (h \<star> \<theta>) \<cdot> \<l>[h \<star> p\<^sub>0 \<star> w]"
             using assms 1 4 k.antipar cospan lunit_naturality [of "h \<star> \<theta>"]
             by (metis hcomp_simps(3-4) h.ide_left hseqI' ide_char in_homE trg_hcomp)
           thus ?thesis
             using comp_assoc by presburger
         qed
         finally have "\<l>[h \<star> u] \<cdot> (k.\<epsilon> \<star> h \<star> u) \<cdot> \<a>\<^sup>-\<^sup>1[k, k\<^sup>*, h \<star> u] \<cdot> (k \<star> k\<^sup>* \<star> h \<star> \<theta>) =
                       (h \<star> \<theta>) \<cdot> \<l>[h \<star> p\<^sub>0 \<star> w] \<cdot> (k.\<epsilon> \<star> h \<star> p\<^sub>0 \<star> w) \<cdot>
                         \<a>\<^sup>-\<^sup>1[k, k\<^sup>*, h \<star> p\<^sub>0 \<star> w]"
           by simp
         thus ?thesis
           using comp_assoc by presburger
       qed
       also have "... = (h \<star> \<theta>) \<cdot> \<a>[h, p\<^sub>0, w] \<cdot> (\<phi> \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[k, p\<^sub>1, w] \<cdot> (k \<star> \<nu>)"
       proof -
         have "\<l>[h \<star> p\<^sub>0 \<star> w] \<cdot> (k.\<epsilon> \<star> h \<star> p\<^sub>0 \<star> w) \<cdot>
                \<a>\<^sup>-\<^sup>1[k, k\<^sup>*, h \<star> p\<^sub>0 \<star> w] \<cdot>
                (k \<star> \<a>[k\<^sup>*, h, p\<^sub>0 \<star> w] \<cdot> \<a>[k\<^sup>* \<star> h, p\<^sub>0, w] \<cdot> (tab \<star> w)) =
               \<a>[h, p\<^sub>0, w] \<cdot> \<l>[(h \<star> p\<^sub>0) \<star> w] \<cdot>
                (trg h \<star> \<a>\<^sup>-\<^sup>1[h, p\<^sub>0, w]) \<cdot> (k.\<epsilon> \<star> h \<star> p\<^sub>0 \<star> w) \<cdot>
                \<a>\<^sup>-\<^sup>1[k, k\<^sup>*, h \<star> p\<^sub>0 \<star> w] \<cdot>
                (k \<star> \<a>[k\<^sup>*, h, p\<^sub>0 \<star> w] \<cdot> \<a>[k\<^sup>* \<star> h, p\<^sub>0, w] \<cdot> (tab \<star> w))"
         proof -
           have "\<l>[h \<star> p\<^sub>0 \<star> w] =
                 \<a>[h, p\<^sub>0, w] \<cdot> \<l>[(h \<star> p\<^sub>0) \<star> w] \<cdot> (trg h \<star> \<a>\<^sup>-\<^sup>1[h, p\<^sub>0, w])"
           proof -
             have "\<a>[h, p\<^sub>0, w] \<cdot> \<l>[(h \<star> p\<^sub>0) \<star> w] \<cdot> (trg h \<star> \<a>\<^sup>-\<^sup>1[h, p\<^sub>0, w]) =
                   \<a>[h, p\<^sub>0, w] \<cdot> \<ll> ((h \<star> p\<^sub>0) \<star> w) \<cdot> (trg h \<star> \<a>\<^sup>-\<^sup>1[h, p\<^sub>0, w])"
               using assms 0 k.antipar cospan comp_cod_arr \<ll>_ide_simp by simp
             also have "... = \<a>[h, p\<^sub>0, w] \<cdot> \<ll> (\<a>\<^sup>-\<^sup>1[h, p\<^sub>0, w])"
               using assms 0 k.antipar cospan \<ll>.is_natural_2 [of "\<a>\<^sup>-\<^sup>1[h, p\<^sub>0, w]"] by simp
             also have "... = \<a>[h, p\<^sub>0, w] \<cdot> \<a>\<^sup>-\<^sup>1[h, p\<^sub>0, w] \<cdot> \<ll> (h \<star> p\<^sub>0 \<star> w)"
               using assms 0 k.antipar cospan \<ll>.is_natural_1 [of "\<a>\<^sup>-\<^sup>1[h, p\<^sub>0, w]"] comp_assoc
               by simp
             also have "... = (\<a>[h, p\<^sub>0, w] \<cdot> \<a>\<^sup>-\<^sup>1[h, p\<^sub>0, w]) \<cdot> \<ll> (h \<star> p\<^sub>0 \<star> w)"
               using comp_assoc by presburger
             also have "... = \<ll> (h \<star> p\<^sub>0 \<star> w)"
               using assms 0 k.antipar cospan comp_cod_arr comp_assoc_assoc' by simp
             also have "... = \<l>[h \<star> p\<^sub>0 \<star> w]"
               using assms 0 k.antipar cospan \<ll>_ide_simp by simp
             finally show ?thesis by simp
           qed
           thus ?thesis
             using comp_assoc by presburger
         qed
         also have "... = \<a>[h, p\<^sub>0, w] \<cdot> (\<l>[h \<star> p\<^sub>0] \<star> w) \<cdot>
                \<a>\<^sup>-\<^sup>1[trg h, h \<star> p\<^sub>0, w] \<cdot>
                ((trg h \<star> \<a>\<^sup>-\<^sup>1[h, p\<^sub>0, w]) \<cdot> (k.\<epsilon> \<star> h \<star> p\<^sub>0 \<star> w)) \<cdot>
                \<a>\<^sup>-\<^sup>1[k, k\<^sup>*, h \<star> p\<^sub>0 \<star> w] \<cdot>
                (k \<star> \<a>[k\<^sup>*, h, p\<^sub>0 \<star> w] \<cdot> \<a>[k\<^sup>* \<star> h, p\<^sub>0, w] \<cdot> (tab \<star> w))"
           using assms 0 k.antipar cospan lunit_hcomp comp_assoc by simp
         also have "... = \<a>[h, p\<^sub>0, w] \<cdot> (\<l>[h \<star> p\<^sub>0] \<star> w) \<cdot>
                (\<a>\<^sup>-\<^sup>1[trg h, h \<star> p\<^sub>0, w] \<cdot> (k.\<epsilon> \<star> (h \<star> p\<^sub>0) \<star> w)) \<cdot>
                ((k \<star> k\<^sup>*) \<star> \<a>\<^sup>-\<^sup>1[h, p\<^sub>0, w]) \<cdot> \<a>\<^sup>-\<^sup>1[k, k\<^sup>*, h \<star> p\<^sub>0 \<star> w] \<cdot>
                (k \<star> \<a>[k\<^sup>*, h, p\<^sub>0 \<star> w] \<cdot> \<a>[k\<^sup>* \<star> h, p\<^sub>0, w] \<cdot> (tab \<star> w))"
         proof -
           have "(trg h \<star> \<a>\<^sup>-\<^sup>1[h, p\<^sub>0, w]) \<cdot> (k.\<epsilon> \<star> h \<star> p\<^sub>0 \<star> w) =
                 (k.\<epsilon> \<star> (h \<star> p\<^sub>0) \<star> w) \<cdot> ((k \<star> k\<^sup>*) \<star> \<a>\<^sup>-\<^sup>1[h, p\<^sub>0, w])"
             using assms 0 k.antipar cospan comp_arr_dom comp_cod_arr
                   interchange [of "trg h" k.\<epsilon> "\<a>\<^sup>-\<^sup>1[h, p\<^sub>0, w]" "h \<star> p\<^sub>0 \<star> w"]
                   interchange [of k.\<epsilon> "k \<star> k\<^sup>*" "(h \<star> p\<^sub>0) \<star> w" "\<a>\<^sup>-\<^sup>1[h, p\<^sub>0, w]"]
             by simp
           thus ?thesis
             using comp_assoc by presburger
         qed
         also have "... = \<a>[h, p\<^sub>0, w] \<cdot> (\<l>[h \<star> p\<^sub>0] \<star> w) \<cdot>
                ((k.\<epsilon> \<star> (h \<star> p\<^sub>0)) \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[k \<star> k\<^sup>*, h \<star> p\<^sub>0, w] \<cdot> 
                ((k \<star> k\<^sup>*) \<star> \<a>\<^sup>-\<^sup>1[h, p\<^sub>0, w]) \<cdot> \<a>\<^sup>-\<^sup>1[k, k\<^sup>*, h \<star> p\<^sub>0 \<star> w] \<cdot>
                (k \<star> \<a>[k\<^sup>*, h, p\<^sub>0 \<star> w] \<cdot> \<a>[k\<^sup>* \<star> h, p\<^sub>0, w] \<cdot> (tab \<star> w))"
           using assms 0 k.antipar cospan assoc'_naturality [of k.\<epsilon> "h \<star> p\<^sub>0" w] comp_assoc
           by simp
         also have "... = \<a>[h, p\<^sub>0, w] \<cdot> (\<l>[h \<star> p\<^sub>0] \<star> w) \<cdot>
                            ((k.\<epsilon> \<star> (h \<star> p\<^sub>0)) \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[k \<star> k\<^sup>*, h \<star> p\<^sub>0, w] \<cdot> 
                            ((k \<star> k\<^sup>*) \<star> \<a>\<^sup>-\<^sup>1[h, p\<^sub>0, w]) \<cdot> \<a>\<^sup>-\<^sup>1[k, k\<^sup>*, h \<star> p\<^sub>0 \<star> w] \<cdot>
                            (k \<star> \<a>[k\<^sup>*, h, p\<^sub>0 \<star> w]) \<cdot> (k \<star> \<a>[k\<^sup>* \<star> h, p\<^sub>0, w]) \<cdot>
                            (k \<star> tab \<star> w)"
         proof -
           have "k \<star> \<a>[k\<^sup>*, h, p\<^sub>0 \<star> w] \<cdot> \<a>[k\<^sup>* \<star> h, p\<^sub>0, w] \<cdot> (tab \<star> w) =
                 (k \<star> \<a>[k\<^sup>*, h, p\<^sub>0 \<star> w]) \<cdot> (k \<star> \<a>[k\<^sup>* \<star> h, p\<^sub>0, w]) \<cdot>
                 (k \<star> tab \<star> w)"
           proof -
             have "seq \<a>[k\<^sup>*, h, p\<^sub>0 \<star> w] (\<a>[k\<^sup>* \<star> h, p\<^sub>0, w] \<cdot> (tab \<star> w))"
               using \<chi>_def assms 0 k.antipar cospan \<chi> by blast
             thus ?thesis
               using assms 0 k.antipar cospan whisker_left by auto
           qed
           thus ?thesis
             using comp_assoc by presburger
         qed
         also have "... = \<a>[h, p\<^sub>0, w] \<cdot> (\<l>[h \<star> p\<^sub>0] \<star> w) \<cdot>
                            ((k.\<epsilon> \<star> (h \<star> p\<^sub>0)) \<star> w) \<cdot> (\<a>\<^sup>-\<^sup>1[k \<star> k\<^sup>*, h \<star> p\<^sub>0, w] \<cdot> 
                            ((k \<star> k\<^sup>*) \<star> \<a>\<^sup>-\<^sup>1[h, p\<^sub>0, w]) \<cdot> \<a>\<^sup>-\<^sup>1[k, k\<^sup>*, h \<star> p\<^sub>0 \<star> w] \<cdot>
                            (k \<star> \<a>[k\<^sup>*, h, p\<^sub>0 \<star> w]) \<cdot> (k \<star> \<a>[k\<^sup>* \<star> h, p\<^sub>0, w]) \<cdot>
                            \<a>[k, (k\<^sup>* \<star> h) \<star> p\<^sub>0, w]) \<cdot> ((k \<star> tab) \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[k, p\<^sub>1, w]"
         proof -
           have "k \<star> tab \<star> w = \<a>[k, (k\<^sup>* \<star> h) \<star> p\<^sub>0, w] \<cdot> \<a>\<^sup>-\<^sup>1[k, (k\<^sup>* \<star> h) \<star> p\<^sub>0, w] \<cdot> (k \<star> tab \<star> w)"
           proof -
             have "\<a>[k, (k\<^sup>* \<star> h) \<star> p\<^sub>0, w] \<cdot> \<a>\<^sup>-\<^sup>1[k, (k\<^sup>* \<star> h) \<star> p\<^sub>0, w] \<cdot> (k \<star> tab \<star> w) =
                   (\<a>[k, (k\<^sup>* \<star> h) \<star> p\<^sub>0, w] \<cdot> \<a>\<^sup>-\<^sup>1[k, (k\<^sup>* \<star> h) \<star> p\<^sub>0, w]) \<cdot> (k \<star> tab \<star> w)"
               using comp_assoc by presburger
             also have "... = (k \<star> ((k\<^sup>* \<star> h) \<star> p\<^sub>0) \<star> w) \<cdot> (k \<star> tab \<star> w)"
                using assms k.antipar 0 comp_assoc_assoc' by simp
             also have "... = k \<star> tab \<star> w"
                using assms k.antipar 0 comp_cod_arr by simp
             finally show ?thesis by simp
           qed
           also have "... = \<a>[k, (k\<^sup>* \<star> h) \<star> p\<^sub>0, w] \<cdot> ((k \<star> tab) \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[k, p\<^sub>1, w]"
             using assms 0 k.antipar cospan assoc'_naturality [of k tab w] by simp
           finally have "k \<star> tab \<star> w = \<a>[k, (k\<^sup>* \<star> h) \<star> p\<^sub>0, w] \<cdot> ((k \<star> tab) \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[k, p\<^sub>1, w]"
             by simp
           thus ?thesis
             using comp_assoc by presburger
         qed
         also have "... = \<a>[h, p\<^sub>0, w] \<cdot> (\<l>[h \<star> p\<^sub>0] \<star> w) \<cdot>
                            ((k.\<epsilon> \<star> h \<star> p\<^sub>0) \<star> w) \<cdot>
                            (\<a>\<^sup>-\<^sup>1[k, k\<^sup>*, h \<star> p\<^sub>0] \<cdot> (k \<star> \<a>[k\<^sup>*, h, p\<^sub>0]) \<star> w) \<cdot>
                            ((k \<star> tab) \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[k, p\<^sub>1, w]"
         proof -
           have "\<a>\<^sup>-\<^sup>1[k \<star> k\<^sup>*, h \<star> p\<^sub>0, w] \<cdot> ((k \<star> k\<^sup>*) \<star> \<a>\<^sup>-\<^sup>1[h, p\<^sub>0, w]) \<cdot>
                   \<a>\<^sup>-\<^sup>1[k, k\<^sup>*, h \<star> p\<^sub>0 \<star> w] \<cdot> (k \<star> \<a>[k\<^sup>*, h, p\<^sub>0 \<star> w]) \<cdot>
                   (k \<star> \<a>[k\<^sup>* \<star> h, p\<^sub>0, w]) \<cdot> \<a>[k, (k\<^sup>* \<star> h) \<star> p\<^sub>0, w] =
                 \<a>\<^sup>-\<^sup>1[k, k\<^sup>*, h \<star> p\<^sub>0] \<cdot> (k \<star> \<a>[k\<^sup>*, h, p\<^sub>0]) \<star> w"
           proof -
             have "\<a>\<^sup>-\<^sup>1[k \<star> k\<^sup>*, h \<star> p\<^sub>0, w] \<cdot> ((k \<star> k\<^sup>*) \<star> \<a>\<^sup>-\<^sup>1[h, p\<^sub>0, w]) \<cdot>
                     \<a>\<^sup>-\<^sup>1[k, k\<^sup>*, h \<star> p\<^sub>0 \<star> w] \<cdot> (k \<star> \<a>[k\<^sup>*, h, p\<^sub>0 \<star> w]) \<cdot>
                     (k \<star> \<a>[k\<^sup>* \<star> h, p\<^sub>0, w]) \<cdot> \<a>[k, (k\<^sup>* \<star> h) \<star> p\<^sub>0, w] =
                   \<lbrace>\<^bold>\<a>\<^sup>-\<^sup>1\<^bold>[\<^bold>\<langle>k\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>k\<^sup>*\<^bold>\<rangle>, \<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>p\<^sub>0\<^bold>\<rangle>, \<^bold>\<langle>w\<^bold>\<rangle>\<^bold>] \<^bold>\<cdot> ((\<^bold>\<langle>k\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>k\<^sup>*\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<a>\<^sup>-\<^sup>1\<^bold>[\<^bold>\<langle>h\<^bold>\<rangle>, \<^bold>\<langle>p\<^sub>0\<^bold>\<rangle>, \<^bold>\<langle>w\<^bold>\<rangle>\<^bold>]) \<^bold>\<cdot>
                     \<^bold>\<a>\<^sup>-\<^sup>1\<^bold>[\<^bold>\<langle>k\<^bold>\<rangle>, \<^bold>\<langle>k\<^sup>*\<^bold>\<rangle>, \<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>w\<^bold>\<rangle>\<^bold>] \<^bold>\<cdot> (\<^bold>\<langle>k\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<a>\<^bold>[\<^bold>\<langle>k\<^sup>*\<^bold>\<rangle>, \<^bold>\<langle>h\<^bold>\<rangle>, \<^bold>\<langle>p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>w\<^bold>\<rangle>\<^bold>]) \<^bold>\<cdot>
                     (\<^bold>\<langle>k\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<a>\<^bold>[\<^bold>\<langle>k\<^sup>*\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle>, \<^bold>\<langle>p\<^sub>0\<^bold>\<rangle>, \<^bold>\<langle>w\<^bold>\<rangle>\<^bold>]) \<^bold>\<cdot> \<^bold>\<a>\<^bold>[\<^bold>\<langle>k\<^bold>\<rangle>, (\<^bold>\<langle>k\<^sup>*\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>p\<^sub>0\<^bold>\<rangle>, \<^bold>\<langle>w\<^bold>\<rangle>\<^bold>]\<rbrace>"
               using assms 0 k.antipar cospan \<alpha>_def \<a>'_def by simp
             also have "... = \<lbrace>\<^bold>\<a>\<^sup>-\<^sup>1\<^bold>[\<^bold>\<langle>k\<^bold>\<rangle>, \<^bold>\<langle>k\<^sup>*\<^bold>\<rangle>, \<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>p\<^sub>0\<^bold>\<rangle>\<^bold>] \<^bold>\<cdot>
                                 (\<^bold>\<langle>k\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<a>\<^bold>[\<^bold>\<langle>k\<^sup>*\<^bold>\<rangle>, \<^bold>\<langle>h\<^bold>\<rangle>, \<^bold>\<langle>p\<^sub>0\<^bold>\<rangle>\<^bold>]) \<^bold>\<star> \<^bold>\<langle>w\<^bold>\<rangle>\<rbrace>"
               using assms 0 k.antipar cospan
               by (intro E.eval_eqI, simp_all)
             also have "... = \<a>\<^sup>-\<^sup>1[k, k\<^sup>*, h \<star> p\<^sub>0] \<cdot> (k \<star> \<a>[k\<^sup>*, h, p\<^sub>0]) \<star> w"
               using assms 0 k.antipar cospan \<alpha>_def \<a>'_def by simp
             finally show ?thesis by simp
           qed
           thus ?thesis
             using comp_assoc by presburger
         qed
         also have "... = \<a>[h, p\<^sub>0, w] \<cdot>
                            (\<l>[h \<star> p\<^sub>0] \<cdot> (k.\<epsilon> \<star> h \<star> p\<^sub>0) \<cdot>
                            \<a>\<^sup>-\<^sup>1[k, k\<^sup>*, h \<star> p\<^sub>0] \<cdot> (k \<star> \<a>[k\<^sup>*, h, p\<^sub>0]) \<cdot>
                            (k \<star> tab) \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[k, p\<^sub>1, w]"
           using assms 0 k.antipar cospan comp_assoc whisker_right by auto
         also have "... = \<a>[h, p\<^sub>0, w] \<cdot> (\<phi> \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[k, p\<^sub>1, w]"
           unfolding \<phi>_def k.trnl\<^sub>\<epsilon>_def
           using assms 0 k.antipar cospan comp_assoc whisker_left by simp
         finally have "\<l>[h \<star> p\<^sub>0 \<star> w] \<cdot> (k.\<epsilon> \<star> h \<star> p\<^sub>0 \<star> w) \<cdot>
                \<a>\<^sup>-\<^sup>1[k, k\<^sup>*, h \<star> p\<^sub>0 \<star> w] \<cdot>
                (k \<star> \<a>[k\<^sup>*, h, p\<^sub>0 \<star> w] \<cdot> \<a>[k\<^sup>* \<star> h, p\<^sub>0, w] \<cdot> (tab \<star> w)) =
                       \<a>[h, p\<^sub>0, w] \<cdot> (\<phi> \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[k, p\<^sub>1, w]"
           by blast
         thus ?thesis
           using \<chi>_def comp_assoc by simp
       qed
       finally show ?thesis by simp
     qed
 
     text \<open>
       \<open>BS3\<close> implies that \<open>\<phi>\<close> is the unique 2-cell from \<open>k \<star> p\<^sub>1\<close> to \<open>h \<star> p\<^sub>0\<close> and is an isomorphism.
     \<close>
 
     lemma \<phi>_uniqueness:
     shows "\<And>\<mu>. \<guillemotleft>\<mu> : k \<star> p\<^sub>1 \<Rightarrow> h \<star> p\<^sub>0\<guillemotright> \<Longrightarrow> \<mu> = \<phi>" and "iso \<phi>"
     proof -
       have 2: "is_left_adjoint (k \<star> p\<^sub>1)"
         using k.antipar cospan left_adjoints_compose by (simp add: k_is_map)
       have 3: "is_left_adjoint (h \<star> p\<^sub>0)"
         using k.antipar cospan left_adjoints_compose by (simp add: h_is_map)
       show "\<And>\<mu>. \<guillemotleft>\<mu> : k \<star> p\<^sub>1 \<Rightarrow> h \<star> p\<^sub>0\<guillemotright> \<Longrightarrow> \<mu> = \<phi>"
         using \<phi>_in_hom 2 3 BS3 by simp
       show "iso \<phi>"
         using \<phi>_in_hom 2 3 BS3 by simp
     qed
 
     text \<open>
       As a consequence, the chosen tabulation of \<open>k\<^sup>* \<star> h\<close> is the unique 2-cell from
       \<open>p\<^sub>1\<close> to \<open>(k\<^sup>* \<star> h) \<star> p\<^sub>0\<close>, and therefore if we are given any such 2-cell we may
       conclude it yields a tabulation of \<open>k\<^sup>* \<star> h\<close>.
     \<close>
 
     lemma tab_uniqueness:
     assumes "\<guillemotleft>\<tau> : p\<^sub>1 \<Rightarrow> (k\<^sup>* \<star> h) \<star> p\<^sub>0\<guillemotright>"
     shows "\<tau> = tab"
     proof -
       have "\<guillemotleft>k.trnl\<^sub>\<epsilon> (h \<star> p\<^sub>0) (\<a>[k\<^sup>*, h, p\<^sub>0] \<cdot> \<tau>) : k \<star> p\<^sub>1 \<Rightarrow> h \<star> p\<^sub>0\<guillemotright>"
         using assms k.antipar cospan k.adjoint_transpose_left(2) [of "h \<star> p\<^sub>0" "p\<^sub>1"]
               assoc_in_hom
         by force
       hence "tab = \<a>\<^sup>-\<^sup>1[k\<^sup>*, h, p\<^sub>0] \<cdot> k.trnl\<^sub>\<eta> p\<^sub>1 (k.trnl\<^sub>\<epsilon> (h \<star> p\<^sub>0) (\<a>[k\<^sup>*, h, p\<^sub>0] \<cdot> \<tau>))"
         using transpose_\<phi> \<phi>_uniqueness(1) by auto
       also have "... = \<a>\<^sup>-\<^sup>1[k\<^sup>*, h, p\<^sub>0] \<cdot> \<a>[k\<^sup>*, h, p\<^sub>0] \<cdot> \<tau>"
         using assms k.antipar cospan k.adjoint_transpose_left(4) assoc_in_hom by auto
       also have "... = (\<a>\<^sup>-\<^sup>1[k\<^sup>*, h, p\<^sub>0] \<cdot> \<a>[k\<^sup>*, h, p\<^sub>0]) \<cdot> \<tau>"
         using comp_assoc by presburger
       also have "... = \<tau>"
         using assms k.antipar cospan comp_cod_arr comp_assoc_assoc' by auto
       finally show ?thesis by simp
     qed
 
     text \<open>
       The following lemma reformulates the biuniversal property of the canonical tabulation
       of \<open>k\<^sup>* \<star> h\<close> as a biuniversal property of \<open>\<phi>\<close>, regarded as a square that commutes up to
       isomorphism.
     \<close>
 
     lemma \<phi>_biuniversal_prop:
     assumes "ide u" and "ide v"
     shows "\<And>\<mu>. \<guillemotleft>\<mu> : k \<star> v \<Rightarrow> h \<star> u\<guillemotright> \<Longrightarrow>
                 \<exists>w \<theta> \<nu>. ide w \<and> \<guillemotleft>\<theta> : p\<^sub>0 \<star> w \<Rightarrow> u\<guillemotright> \<and> \<guillemotleft>\<nu> : v \<Rightarrow> p\<^sub>1 \<star> w\<guillemotright> \<and> iso \<nu> \<and>
                         (h \<star> \<theta>) \<cdot> \<a>[h, p\<^sub>0, w] \<cdot> (\<phi> \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[k, p\<^sub>1, w] \<cdot> (k \<star> \<nu>) = \<mu>"
     and "\<And>w w' \<theta> \<theta>' \<beta>.
             \<lbrakk> ide w; ide w';
               \<guillemotleft>\<theta> : p\<^sub>0 \<star> w \<Rightarrow> u\<guillemotright>; \<guillemotleft>\<theta>' : p\<^sub>0 \<star> w' \<Rightarrow> u\<guillemotright>;
               \<guillemotleft>\<beta> : p\<^sub>1 \<star> w \<Rightarrow> p\<^sub>1 \<star> w'\<guillemotright>;
               (h \<star> \<theta>) \<cdot> \<a>[h, p\<^sub>0, w] \<cdot> (\<phi> \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[k, p\<^sub>1, w] =
               (h \<star> \<theta>') \<cdot> \<a>[h, p\<^sub>0, w'] \<cdot> (\<phi> \<star> w') \<cdot> \<a>\<^sup>-\<^sup>1[k, p\<^sub>1, w'] \<cdot> (k \<star> \<beta>) \<rbrakk>
                     \<Longrightarrow> \<exists>!\<gamma>. \<guillemotleft>\<gamma> : w \<Rightarrow> w'\<guillemotright> \<and> \<theta> = \<theta>' \<cdot> (p\<^sub>0 \<star> \<gamma>) \<and> p\<^sub>1 \<star> \<gamma> = \<beta>"
     proof -
       fix \<mu>
       assume \<mu>: "\<guillemotleft>\<mu> : k \<star> v \<Rightarrow> h \<star> u\<guillemotright>"
       have 1: "src h = trg u"
         using assms \<mu> ide_cod
         by (metis ide_def in_homE seq_if_composable)
       have 2: "src k = trg v"
         using assms \<mu> ide_dom
         by (metis ideD(1) in_homE not_arr_null seq_if_composable)
       let ?\<omega> = "\<a>\<^sup>-\<^sup>1[k\<^sup>*, h, u] \<cdot> k.trnl\<^sub>\<eta> v \<mu>"
       have \<omega>: "\<guillemotleft>?\<omega> : v \<Rightarrow> (k\<^sup>* \<star> h) \<star> u\<guillemotright>"
         using assms \<mu> 1 2 k.antipar cospan k.adjoint_transpose_left(1) [of "h \<star> u" v]
               assoc_in_hom
         by auto
       obtain w \<theta> \<nu>
       where w\<theta>\<nu>: "ide w \<and> \<guillemotleft>\<theta> : p\<^sub>0 \<star> w \<Rightarrow> u\<guillemotright> \<and> \<guillemotleft>\<nu> : v \<Rightarrow> p\<^sub>1 \<star> w\<guillemotright> \<and> iso \<nu> \<and>
                   ((k\<^sup>* \<star> h) \<star> \<theta>) \<cdot> \<a>[k\<^sup>* \<star> h, p\<^sub>0, w] \<cdot> (tab \<star> w) \<cdot> \<nu> = ?\<omega>"
         using assms \<omega> T1 [of u ?\<omega>] comp_assoc by (metis in_homE)
       have 0: "src p\<^sub>0 = trg w"
         using w\<theta>\<nu> ide_dom
         by (metis hseqE ideD(1) in_homE)
       have "\<mu> = k.trnl\<^sub>\<epsilon> (h \<star> u) (\<a>[k\<^sup>*, h, u] \<cdot> ((k\<^sup>* \<star> h) \<star> \<theta>) \<cdot> \<a>[k\<^sup>* \<star> h, p\<^sub>0, w] \<cdot> (tab \<star> w) \<cdot> \<nu>)"
       proof -
         have "\<mu> = k.trnl\<^sub>\<epsilon> (h \<star> u) (\<a>[k\<^sup>*, h, u] \<cdot> ?\<omega>)"
         proof -
           have "k.trnl\<^sub>\<epsilon> (h \<star> u) (\<a>[k\<^sup>*, h, u] \<cdot> ?\<omega>) =
                 k.trnl\<^sub>\<epsilon> (h \<star> u) ((\<a>[k\<^sup>*, h, u] \<cdot> \<a>\<^sup>-\<^sup>1[k\<^sup>*, h, u]) \<cdot> k.trnl\<^sub>\<eta> v \<mu>)"
             using comp_assoc by presburger
           also have "... = k.trnl\<^sub>\<epsilon> (h \<star> u) (k.trnl\<^sub>\<eta> v \<mu>)"
           proof -
             have "(\<a>[k\<^sup>*, h, u] \<cdot> \<a>\<^sup>-\<^sup>1[k\<^sup>*, h, u]) \<cdot> k.trnl\<^sub>\<eta> v \<mu> = (k\<^sup>* \<star> h \<star> u) \<cdot> k.trnl\<^sub>\<eta> v \<mu>"
               using comp_assoc_assoc'
               by (simp add: "1" assms(1) cospan k.antipar(2))
             also have "... = k.trnl\<^sub>\<eta> v \<mu>"
               using "1" \<omega> assms(1) comp_ide_arr cospan k.antipar(2) by fastforce
             finally show ?thesis
               by simp
           qed
           also have "... = \<mu>"
             using assms \<mu> k.antipar cospan 1 2 k.adjoint_transpose_left(3) by simp
           finally show ?thesis by simp
         qed
         thus ?thesis using w\<theta>\<nu> by simp
       qed
       also have "... = (h \<star> \<theta>) \<cdot> \<a>[h, p\<^sub>0, w] \<cdot> (\<phi> \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[k, p\<^sub>1, w] \<cdot> (k \<star> \<nu>)"
         using assms k.antipar cospan w\<theta>\<nu> transpose_triangle [of w \<theta> u \<nu>] by auto
       finally have "(h \<star> \<theta>) \<cdot> \<a>[h, p\<^sub>0, w] \<cdot> (\<phi> \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[k, p\<^sub>1, w] \<cdot> (k \<star> \<nu>) = \<mu>"
         by simp
       thus "\<exists>w \<theta> \<nu>. ide w \<and> \<guillemotleft>\<theta> : p\<^sub>0 \<star> w \<Rightarrow> u\<guillemotright> \<and>
                     \<guillemotleft>\<nu> : v \<Rightarrow> p\<^sub>1 \<star> w\<guillemotright> \<and> iso \<nu> \<and>
                     (h \<star> \<theta>) \<cdot> \<a>[h, p\<^sub>0, w] \<cdot> (\<phi> \<star> w) \<cdot>
                       \<a>\<^sup>-\<^sup>1[k, p\<^sub>1, w] \<cdot> (k \<star> \<nu>) = \<mu>"
         using w\<theta>\<nu> by blast
       next
       fix w w' \<theta> \<theta>' \<beta>
       assume w: "ide w"
       assume w': "ide w'"
       assume \<theta>: "\<guillemotleft>\<theta> : p\<^sub>0 \<star> w \<Rightarrow> u\<guillemotright>"
       assume \<theta>': "\<guillemotleft>\<theta>' : p\<^sub>0 \<star> w' \<Rightarrow> u\<guillemotright>"
       assume \<beta>: "\<guillemotleft>\<beta> : p\<^sub>1 \<star> w \<Rightarrow> p\<^sub>1 \<star> w'\<guillemotright>"
       assume eq: "(h \<star> \<theta>) \<cdot> \<a>[h, p\<^sub>0, w] \<cdot> (\<phi> \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[k, p\<^sub>1, w] =
                   (h \<star> \<theta>') \<cdot> \<a>[h, p\<^sub>0, w'] \<cdot> (\<phi> \<star> w') \<cdot> \<a>\<^sup>-\<^sup>1[k, p\<^sub>1, w'] \<cdot> (k \<star> \<beta>)"
       have 0: "src p\<^sub>0 = trg w"
         using \<theta> ide_dom
         by (metis ideD(1) in_homE not_arr_null seq_if_composable)
       interpret uw\<theta>w'\<theta>': uw\<theta>w'\<theta>' V H \<a> \<i> src trg \<open>k\<^sup>* \<star> h\<close> tab \<open>p\<^sub>0\<close> \<open>p\<^sub>1\<close>
                              u w \<theta> w' \<theta>'
         using w \<theta> w' \<theta>' apply (unfold_locales) by auto
       show "\<exists>!\<gamma>. \<guillemotleft>\<gamma> : w \<Rightarrow> w'\<guillemotright> \<and> \<theta> = \<theta>' \<cdot> (p\<^sub>0 \<star> \<gamma>) \<and> p\<^sub>1 \<star> \<gamma> = \<beta>"
       proof -
         let ?LHS = "\<a>[k\<^sup>*, h, u] \<cdot> ((k\<^sup>* \<star> h) \<star> \<theta>) \<cdot> \<a>[k\<^sup>* \<star> h, p\<^sub>0, w] \<cdot> (tab \<star> w)"
         let ?RHS = "\<a>[k\<^sup>*, h, u] \<cdot> ((k\<^sup>* \<star> h) \<star> \<theta>') \<cdot> \<a>[k\<^sup>* \<star> h, p\<^sub>0, w'] \<cdot> (tab \<star> w') \<cdot> \<beta>"
         have eq': "?LHS = ?RHS"
         proof -
           have "k.trnl\<^sub>\<epsilon> (h \<star> u) ?LHS =
                 k.trnl\<^sub>\<epsilon> (h \<star> u)
                         (\<a>[k\<^sup>*, h, u] \<cdot> ((k\<^sup>* \<star> h) \<star> \<theta>) \<cdot> \<a>[k\<^sup>* \<star> h, p\<^sub>0, w] \<cdot> (tab \<star> w) \<cdot> (p\<^sub>1 \<star> w))"
             using assms 0 w \<theta> \<beta> k.antipar cospan comp_arr_dom
             by (metis tab_simps(1) tab_simps(4) whisker_right)
           also have "... = (h \<star> \<theta>) \<cdot> \<a>[h, p\<^sub>0, w] \<cdot> (\<phi> \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[k, p\<^sub>1, w] \<cdot> (k \<star> p\<^sub>1 \<star> w)"
             using assms w \<theta> \<beta> transpose_triangle
             by (metis arr_dom ide_hcomp ide_in_hom(2) in_homE ide_leg1 not_arr_null
                 seq_if_composable)
           also have "... = (h \<star> \<theta>) \<cdot> \<a>[h, p\<^sub>0, w] \<cdot> (\<phi> \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[k, p\<^sub>1, w]"
             using assms 0 w k.antipar cospan comp_arr_dom by simp
           also have "... = (h \<star> \<theta>') \<cdot> \<a>[h, p\<^sub>0, w'] \<cdot> (\<phi> \<star> w') \<cdot> \<a>\<^sup>-\<^sup>1[k, p\<^sub>1, w'] \<cdot> (k \<star> \<beta>)"
             using eq by blast
           also have "... = k.trnl\<^sub>\<epsilon> (h \<star> u) ?RHS"
             using assms w' \<theta>' \<beta> transpose_triangle by simp
           finally have 4: "k.trnl\<^sub>\<epsilon> (h \<star> u) ?LHS = k.trnl\<^sub>\<epsilon> (h \<star> u) ?RHS"
             by simp
           have "src k = trg (p\<^sub>1 \<star> w)"
             using assms 0 w k.antipar cospan by simp
           moreover have "src k\<^sup>* = trg (h \<star> u)"
             using assms 0 w k.antipar cospan by simp
           moreover have "ide (h \<star> u)"
             using assms 0 w k.antipar cospan by simp
           moreover have "ide (p\<^sub>1 \<star> w)"
             using assms 0 w k.antipar cospan by simp
           ultimately have "inj_on (k.trnl\<^sub>\<epsilon> (h \<star> u)) (hom (p\<^sub>1 \<star> w) (k\<^sup>* \<star> h \<star> u))"
             using assms 0 w w' k.antipar cospan k.adjoint_transpose_left(6) bij_betw_imp_inj_on
             by blast
           moreover have "?LHS \<in> hom (p\<^sub>1 \<star> w) (k\<^sup>* \<star> h \<star> u)"
           proof -
             have "\<guillemotleft>\<a>[k\<^sup>*, h, u] \<cdot> ((k\<^sup>* \<star> h) \<star> \<theta>) \<cdot> \<a>[k\<^sup>* \<star> h, p\<^sub>0, w] \<cdot> (tab \<star> w) :
                      p\<^sub>1 \<star> w \<Rightarrow> k\<^sup>* \<star> h \<star> u\<guillemotright>"
               using k.antipar cospan
               apply (intro comp_in_homI) by auto
             thus ?thesis by simp
           qed
           moreover have "?RHS \<in> hom (p\<^sub>1 \<star> w) (k\<^sup>* \<star> h \<star> u)"
           proof -
             have "\<guillemotleft>\<a>[k\<^sup>*, h, u] \<cdot> ((k\<^sup>* \<star> h) \<star> \<theta>') \<cdot> \<a>[k\<^sup>* \<star> h, p\<^sub>0, w'] \<cdot>
                     (tab \<star> w') \<cdot> \<beta> : p\<^sub>1 \<star> w \<Rightarrow> k\<^sup>* \<star> h \<star> u\<guillemotright>"
               using \<beta> k.antipar cospan
               apply (intro comp_in_homI) by auto
             thus ?thesis by blast
           qed
           ultimately show "?LHS = ?RHS"
             using assms 4 k.antipar cospan bij_betw_imp_inj_on
                   inj_on_def [of "k.trnl\<^sub>\<epsilon> (h \<star> u)" "hom (p\<^sub>1 \<star> w) (k\<^sup>* \<star> h \<star> u)"]
             by simp
         qed
         moreover have "seq \<a>[k\<^sup>*, h, u] (composite_cell w \<theta>)"
           using assms k.antipar cospan tab_in_hom by fastforce
         moreover have "seq \<a>[k\<^sup>*, h, u] (composite_cell w' \<theta>' \<cdot> \<beta>)"
           using assms \<beta> k.antipar cospan tab_in_hom by fastforce
         ultimately have "composite_cell w \<theta> = composite_cell w' \<theta>' \<cdot> \<beta>"
           using assms 0 w w' \<beta> k.antipar cospan iso_assoc iso_is_section section_is_mono
                 monoE [of "\<a>[k\<^sup>*, h, u]" "composite_cell w \<theta>" "composite_cell w' \<theta>' \<cdot> \<beta>"]
                 comp_assoc
           by simp
         thus ?thesis
           using w w' \<theta> \<theta>' \<beta> eq' T2 [of w w' \<theta> u \<theta>' \<beta>] by metis
       qed
     qed
 
     text \<open>
       Using the uniqueness properties established for \<open>\<phi>\<close>, we obtain yet another reformulation
       of the biuniversal property associated with the chosen tabulation of \<open>k\<^sup>* \<star> h\<close>,
       this time as a kind of pseudo-pullback.  We will use this to show that the
       category of isomorphism classes of maps has pullbacks.
     \<close>
 
     lemma has_pseudo_pullback:
     assumes "is_left_adjoint u" and "is_left_adjoint v" and "isomorphic (k \<star> v) (h \<star> u)"
     shows "\<exists>w. is_left_adjoint w \<and> isomorphic (p\<^sub>0 \<star> w) u \<and> isomorphic v (p\<^sub>1 \<star> w)"
     and "\<And>w w'. \<lbrakk> is_left_adjoint w; is_left_adjoint w';
                   p\<^sub>0 \<star> w \<cong> u; v \<cong> p\<^sub>1 \<star> w; p\<^sub>0 \<star> w' \<cong> u; v \<cong> p\<^sub>1 \<star> w' \<rbrakk> \<Longrightarrow> w \<cong> w'"
     proof -
       interpret u: map_in_bicategory V H \<a> \<i> src trg u
         using assms(1) by unfold_locales auto
       interpret v: map_in_bicategory V H \<a> \<i> src trg v
         using assms(2) by unfold_locales auto
       obtain \<mu> where \<mu>: "\<guillemotleft>\<mu> : k \<star> v \<Rightarrow> h \<star> u\<guillemotright> \<and> iso \<mu>"
         using assms(3) by auto
       obtain w \<theta> \<nu> where w\<theta>\<nu>: "ide w \<and> \<guillemotleft>\<theta> : p\<^sub>0 \<star> w \<Rightarrow> u\<guillemotright> \<and>
                                \<guillemotleft>\<nu> : v \<Rightarrow> p\<^sub>1 \<star> w\<guillemotright> \<and> iso \<nu> \<and>
                                (h \<star> \<theta>) \<cdot> \<a>[h, p\<^sub>0, w] \<cdot> (\<phi> \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[k, p\<^sub>1, w] \<cdot> (k \<star> \<nu>) = \<mu>"
         using assms \<mu> \<phi>_biuniversal_prop(1) [of u v \<mu>] by auto
       have "is_left_adjoint w \<and> isomorphic (p\<^sub>0 \<star> w) u \<and> isomorphic v (p\<^sub>1 \<star> w)"
       proof (intro conjI)
         show 1: "is_left_adjoint w"
           using assms(2) w\<theta>\<nu> left_adjoint_preserved_by_iso' isomorphic_def BS4 leg1_is_map
           by blast
         show "v \<cong> p\<^sub>1 \<star> w"
           using w\<theta>\<nu> isomorphic_def by blast
         show "p\<^sub>0 \<star> w \<cong> u"
         proof -
           have "src p\<^sub>0 = trg w"
             using w\<theta>\<nu> ide_dom
             by (metis ideD(1) in_homE not_arr_null seq_if_composable)
           hence "is_left_adjoint (p\<^sub>0 \<star> w)"
             using 1 left_adjoints_compose by simp
           thus ?thesis
             using assms w\<theta>\<nu> 1 BS3 isomorphic_def by metis
         qed
       qed
       thus "\<exists>w. is_left_adjoint w \<and> p\<^sub>0 \<star> w \<cong> u \<and> v \<cong> p\<^sub>1 \<star> w"
         by blast
       show "\<And>w w'. \<lbrakk> is_left_adjoint w; is_left_adjoint w';
                      p\<^sub>0 \<star> w \<cong> u; v \<cong> p\<^sub>1 \<star> w; p\<^sub>0 \<star> w' \<cong> u; v \<cong> p\<^sub>1 \<star> w' \<rbrakk> \<Longrightarrow> w \<cong> w'"
       proof -
         fix w w'
         assume w: "is_left_adjoint w" and w': "is_left_adjoint w'"
         assume 1: "p\<^sub>0 \<star> w \<cong> u"
         assume 2: "v \<cong> p\<^sub>1 \<star> w"
         assume 3: "p\<^sub>0 \<star> w' \<cong> u"
         assume 4: "v \<cong> p\<^sub>1 \<star> w'"
         obtain \<theta> where \<theta>: "\<guillemotleft>\<theta> : p\<^sub>0 \<star> w \<Rightarrow> u\<guillemotright>"
           using 1 by auto
         obtain \<theta>' where \<theta>': "\<guillemotleft>\<theta>' : p\<^sub>0 \<star> w' \<Rightarrow> u\<guillemotright>"
           using 3 by auto
         obtain \<nu> where \<nu>: "\<guillemotleft>\<nu>: v \<Rightarrow> p\<^sub>1 \<star> w\<guillemotright> \<and> iso \<nu>"
           using 2 by blast
         obtain \<nu>' where \<nu>': "\<guillemotleft>\<nu>': v \<Rightarrow> p\<^sub>1 \<star> w'\<guillemotright> \<and> iso \<nu>'"
           using 4 by blast
         let ?\<beta> = "\<nu>' \<cdot> inv \<nu>"
         have \<beta>: "\<guillemotleft>?\<beta> : p\<^sub>1 \<star> w \<Rightarrow> p\<^sub>1 \<star> w'\<guillemotright>"
           using \<nu> \<nu>' by (elim conjE in_homE, auto)
         interpret uw\<theta>: uw\<theta> V H \<a> \<i> src trg \<open>k\<^sup>* \<star> h\<close> tab \<open>p\<^sub>0\<close> \<open>p\<^sub>1\<close> u w \<theta>
           using w \<theta> left_adjoint_is_ide
           by unfold_locales auto
         interpret uw'\<theta>': uw\<theta> V H \<a> \<i> src trg \<open>k\<^sup>* \<star> h\<close> tab \<open>p\<^sub>0\<close> \<open>p\<^sub>1\<close>
                              u w' \<theta>'
           using w' \<theta>' left_adjoint_is_ide
           by unfold_locales auto
         interpret uw\<theta>w'\<theta>': uw\<theta>w'\<theta>' V H \<a> \<i> src trg \<open>k\<^sup>* \<star> h\<close> tab \<open>p\<^sub>0\<close> \<open>p\<^sub>1\<close> u w \<theta> w' \<theta>'
           using w w' \<theta> \<theta>' left_adjoint_is_ide by unfold_locales
         have "(h \<star> \<theta>) \<cdot> \<a>[h, p\<^sub>0, w] \<cdot> (\<phi> \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[k, p\<^sub>1, w] =
               (h \<star> \<theta>') \<cdot> \<a>[h, p\<^sub>0, w'] \<cdot> (\<phi> \<star> w') \<cdot> \<a>\<^sup>-\<^sup>1[k, p\<^sub>1, w'] \<cdot>
                 (k \<star> ?\<beta>)"
         proof -
           let ?LHS = "(h \<star> \<theta>) \<cdot> \<a>[h, p\<^sub>0, w] \<cdot> (\<phi> \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[k, p\<^sub>1, w]"
           let ?RHS = "(h \<star> \<theta>') \<cdot> \<a>[h, p\<^sub>0, w'] \<cdot> (\<phi> \<star> w') \<cdot> \<a>\<^sup>-\<^sup>1[k, p\<^sub>1, w'] \<cdot> (k \<star> ?\<beta>)"
           have "\<guillemotleft>?LHS : k \<star> p\<^sub>1 \<star> w \<Rightarrow> h \<star> u\<guillemotright>"
             using w k.antipar by fastforce
           moreover have "\<guillemotleft>?RHS : k \<star> p\<^sub>1 \<star> w \<Rightarrow> h \<star> u\<guillemotright>"
             using w k.antipar \<beta> by fastforce
           moreover have "is_left_adjoint (k \<star> p\<^sub>1 \<star> w)"
             using w k.is_map left_adjoints_compose by simp
           moreover have "is_left_adjoint (h \<star> u)"
             using assms h.is_map left_adjoints_compose by auto
           ultimately show "?LHS = ?RHS"
             using BS3 by blast
         qed
         hence "\<exists>!\<gamma>. \<guillemotleft>\<gamma> : w \<Rightarrow> w'\<guillemotright> \<and> \<theta> = \<theta>' \<cdot> (p\<^sub>0 \<star> \<gamma>) \<and> p\<^sub>1 \<star> \<gamma> = ?\<beta>"
           using assms left_adjoint_is_ide w w' \<theta> \<theta>' \<nu> \<nu>' \<beta>
                 \<phi>_biuniversal_prop(2) [of u v w w' \<theta> \<theta>' ?\<beta>]
           by presburger
         thus "w \<cong> w'"
           using w w' BS3 isomorphic_def by metis
       qed
     qed
 
   end
 
   subsubsection "Tabulations in Maps"
 
   text \<open>
     Here we focus our attention on the properties of tabulations in a bicategory of spans,
     in the special case in which both legs are maps.
   \<close>
 
   context tabulation_in_maps
   begin
 
     text \<open>
       The following are the conditions under which \<open>w\<close> is a 1-cell induced via \<open>T1\<close> by
       a 2-cell \<open>\<guillemotleft>\<omega> : dom \<omega> \<Rightarrow> s \<star> r\<^sub>0\<guillemotright>\<close>:  \<open>w\<close> is an arrow of spans and \<open>\<omega>\<close> is obtained by
       composing the tabulation \<open>\<sigma>\<close> with \<open>w\<close> and the isomorphisms that witness \<open>w\<close> being
       an arrow of spans.
     \<close>
 
     abbreviation is_induced_by_cell
     where "is_induced_by_cell w r\<^sub>0 \<omega> \<equiv>
            arrow_of_spans_of_maps V H \<a> \<i> src trg r\<^sub>0 (dom \<omega>) s\<^sub>0 s\<^sub>1 w \<and>
            composite_cell w (arrow_of_spans_of_maps.the_\<theta> V H r\<^sub>0 s\<^sub>0 w) \<cdot>
              (arrow_of_spans_of_maps.the_\<nu> V H (dom \<omega>) s\<^sub>1 w) = \<omega>"
 
     lemma induced_map_unique:
     assumes "is_induced_by_cell w r\<^sub>0 \<omega>" and "is_induced_by_cell w' r\<^sub>0 \<omega>"
     shows "isomorphic w w'"
     proof -
       interpret w: arrow_of_spans_of_maps V H \<a> \<i> src trg r\<^sub>0 \<open>dom \<omega>\<close> s\<^sub>0 s\<^sub>1 w
         using assms(1) by auto
       interpret w: arrow_of_spans_of_maps_to_tabulation V H \<a> \<i> src trg r\<^sub>0 \<open>dom \<omega>\<close> s \<sigma> s\<^sub>0 s\<^sub>1 w
         ..
       interpret w': arrow_of_spans_of_maps V H \<a> \<i> src trg r\<^sub>0 \<open>dom \<omega>\<close> s\<^sub>0 s\<^sub>1 w'
         using assms(2) by auto
       interpret w': arrow_of_spans_of_maps_to_tabulation V H \<a> \<i> src trg r\<^sub>0 \<open>dom \<omega>\<close> s \<sigma> s\<^sub>0 s\<^sub>1 w'
         ..
       let ?\<beta> = "w'.the_\<nu> \<cdot> inv w.the_\<nu>"
       have \<beta>: "\<guillemotleft>?\<beta> : s\<^sub>1 \<star> w \<Rightarrow> s\<^sub>1 \<star> w'\<guillemotright>"
         using w.the_\<nu>_props w'.the_\<nu>_props arr_iff_in_hom by auto
       have 1: "composite_cell w w.the_\<theta> = composite_cell w' w'.the_\<theta> \<cdot> (w'.the_\<nu> \<cdot> inv w.the_\<nu>)"
       proof -
         have "composite_cell w' w'.the_\<theta> \<cdot> (w'.the_\<nu> \<cdot> inv w.the_\<nu>) =
               ((composite_cell w' w'.the_\<theta>) \<cdot> w'.the_\<nu>) \<cdot> inv w.the_\<nu>"
           using comp_assoc by presburger
         also have "... = \<omega> \<cdot> inv w.the_\<nu>"
           using assms(2) comp_assoc by simp
         also have "... = (composite_cell w w.the_\<theta> \<cdot> w.the_\<nu>) \<cdot> inv w.the_\<nu>"
           using assms(1) comp_assoc by simp
         also have "... = composite_cell w w.the_\<theta> \<cdot> w.the_\<nu> \<cdot> inv w.the_\<nu>"
           using comp_assoc by presburger
         also have "... = composite_cell w w.the_\<theta>"
         proof -
           have "w.the_\<nu> \<cdot> inv w.the_\<nu> = s\<^sub>1 \<star> w"
             using w.the_\<nu>_props comp_arr_inv inv_is_inverse by auto
           thus ?thesis
             using composite_cell_in_hom w.ide_w w.the_\<theta>_props comp_arr_dom
             by (metis composite_cell_in_hom in_homE w.w_in_hom(1))
         qed
         finally show ?thesis by auto
       qed
       have "\<exists>\<gamma>. \<guillemotleft>\<gamma> : w \<Rightarrow> w'\<guillemotright>"
         using 1 \<beta> w.is_ide w'.is_ide w.the_\<theta>_props w'.the_\<theta>_props
               T2 [of w w' w.the_\<theta> r\<^sub>0 w'.the_\<theta> ?\<beta>]
         by blast
       thus ?thesis
         using BS3 w.is_map w'.is_map by blast
     qed
 
     text \<open>
       The object src \<open>s\<^sub>0\<close> forming the apex of the tabulation satisfies the conditions for
       being a map induced via \<open>T1\<close> by the 2-cell \<open>\<sigma>\<close> itself.  This is ultimately required
       for the map from 2-cells to arrows of spans to be functorial with respect to vertical
       composition.
     \<close>
 
     lemma apex_is_induced_by_cell:
     shows "is_induced_by_cell (src s\<^sub>0) s\<^sub>0 \<sigma>"
     proof -
       have 1: "arrow_of_spans_of_maps V H \<a> \<i> src trg s\<^sub>0 s\<^sub>1 s\<^sub>0 s\<^sub>1 (src s\<^sub>0)"
         using iso_runit [of s\<^sub>0] iso_runit [of s\<^sub>1] tab_in_hom
         apply unfold_locales
           apply simp
         using ide_leg0 isomorphic_def
          apply blast
         using ide_leg1 isomorphic_def leg1_simps(3) runit'_in_vhom [of s\<^sub>1 "src s\<^sub>0"] iso_runit'
         by blast
       interpret w: arrow_of_spans_of_maps V H \<a> \<i> src trg s\<^sub>0 \<open>dom \<sigma>\<close> s\<^sub>0 s\<^sub>1 \<open>src s\<^sub>0\<close>
         using 1 tab_in_hom by simp
       interpret w: arrow_of_spans_of_maps_to_tabulation
                      V H \<a> \<i> src trg s\<^sub>0 \<open>dom \<sigma>\<close> s \<sigma> s\<^sub>0 s\<^sub>1 \<open>src s\<^sub>0\<close>
         ..
       show "is_induced_by_cell (src s\<^sub>0) s\<^sub>0 \<sigma>"
       proof (intro conjI)
         show "arrow_of_spans_of_maps V H \<a> \<i> src trg s\<^sub>0 (dom \<sigma>) s\<^sub>0 s\<^sub>1 (src s\<^sub>0)"
           using w.arrow_of_spans_of_maps_axioms by simp
         show "composite_cell (src s\<^sub>0) w.the_\<theta> \<cdot> w.the_\<nu> = \<sigma>"
         proof -
           have \<theta>: "w.the_\<theta> = \<r>[s\<^sub>0]"
             using iso_runit [of s\<^sub>0] w.leg0_uniquely_isomorphic w.the_\<theta>_props
                   the1_equality [of "\<lambda>\<theta>. \<guillemotleft>\<theta> : s\<^sub>0 \<star> src s\<^sub>0 \<Rightarrow> s\<^sub>0\<guillemotright> \<and> iso \<theta>"]
             by auto
           have \<nu>: "w.the_\<nu> = \<r>\<^sup>-\<^sup>1[s\<^sub>1]"
             using iso_runit' w.leg1_uniquely_isomorphic w.the_\<nu>_props leg1_simps(3)
                   the1_equality [of "\<lambda>\<nu>. \<guillemotleft>\<nu> : s\<^sub>1 \<Rightarrow> s\<^sub>1 \<star> src s\<^sub>0\<guillemotright> \<and> iso \<nu>"] tab_in_vhom'
             by auto
           have "composite_cell (src s\<^sub>0) \<r>[s\<^sub>0] \<cdot> \<r>\<^sup>-\<^sup>1[s\<^sub>1] = \<sigma>"
           proof -
             have "composite_cell (src s\<^sub>0) \<r>[s\<^sub>0] \<cdot> \<r>\<^sup>-\<^sup>1[s\<^sub>1] =
                   ((s \<star> \<r>[s\<^sub>0]) \<cdot> \<a>[s, s\<^sub>0, src s\<^sub>0]) \<cdot> (\<sigma> \<star> src s\<^sub>0) \<cdot> \<r>\<^sup>-\<^sup>1[s\<^sub>1]"
               using comp_assoc by presburger
             also have "... = (\<r>[s \<star> s\<^sub>0] \<cdot> (\<sigma> \<star> src s\<^sub>0)) \<cdot> \<r>\<^sup>-\<^sup>1[s\<^sub>1]"
               using runit_hcomp comp_assoc by simp
             also have "... = \<sigma> \<cdot> \<r>[s\<^sub>1] \<cdot> \<r>\<^sup>-\<^sup>1[s\<^sub>1]"
               using runit_naturality tab_in_hom
               by (metis tab_simps(1) tab_simps(2) tab_simps(4) tab_simps(5) comp_assoc)
             also have "... = \<sigma>"
               using iso_runit tab_in_hom comp_arr_dom comp_arr_inv inv_is_inverse by simp
             finally show ?thesis by simp
           qed
           thus ?thesis
             using \<theta> \<nu> comp_assoc by simp
         qed
       qed
     qed
 
   end
 
   subsubsection "Composing Tabulations"
 
   text \<open>
     Given tabulations \<open>(r\<^sub>0, \<rho>, r\<^sub>1)\<close> of \<open>r\<close> and \<open>(s\<^sub>0, \<sigma>, s\<^sub>1)\<close> of \<open>s\<close> in a bicategory of spans,
     where \<open>(r\<^sub>0, r\<^sub>1)\<close> and \<open>(s\<^sub>0, s\<^sub>1)\<close> are spans of maps and 1-cells \<open>r\<close> and \<open>s\<close> are composable,
     we can construct a 2-cell that yields a tabulation of \<open>r \<star> s\<close>.
     The proof uses the fact that the 2-cell \<open>\<phi>\<close> associated with the cospan \<open>(r\<^sub>0, s\<^sub>1)\<close>
     is an isomorphism, which we have proved above
     (\<open>cospan_of_maps_in_bicategory_of_spans.\<phi>_uniqueness\<close>) using \<open>BS3\<close>.
     However, this is the only use of \<open>BS3\<close> in the proof, and it seems plausible that it would be
     possible to establish that \<open>\<phi>\<close> is an isomorphism in more general situations in which the
     subbicategory of maps is not locally essentially discrete.  Alternatively, more general
     situations could be treated by adding the assertion that \<open>\<phi>\<close> is an isomorphism as part of
     a weakening of \<open>BS3\<close>.
   \<close>
 
   locale composite_tabulation_in_maps =
     bicategory_of_spans V H \<a> \<i> src trg +
     \<rho>: tabulation_in_maps V H \<a> \<i> src trg r \<rho> r\<^sub>0 r\<^sub>1 +
     \<sigma>: tabulation_in_maps V H \<a> \<i> src trg s \<sigma> s\<^sub>0 s\<^sub>1
   for V :: "'a comp"                 (infixr "\<cdot>" 55)
   and H :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"          (infixr "\<star>" 53)
   and \<a> :: "'a \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a"     ("\<a>[_, _, _]")
   and \<i> :: "'a \<Rightarrow> 'a"                 ("\<i>[_]")
   and src :: "'a \<Rightarrow> 'a"
   and trg :: "'a \<Rightarrow> 'a"
   and r :: 'a
   and \<rho> :: 'a
   and r\<^sub>0 :: 'a
   and r\<^sub>1 :: 'a
   and s :: 'a
   and \<sigma> :: 'a
   and s\<^sub>0 :: 'a
   and s\<^sub>1 :: 'a +
   assumes composable: "src r = trg s"
   begin
 
     text \<open>
       Interpret \<open>(r\<^sub>0, s\<^sub>1)\<close> as a @{locale cospan_of_maps_in_bicategory_of_spans},
       to obtain the isomorphism \<open>\<phi>\<close> in the central diamond, along with the assertion
       that it is unique.
     \<close>
     interpretation r\<^sub>0s\<^sub>1: cospan_of_maps_in_bicategory_of_spans V H \<a> \<i> src trg s\<^sub>1 r\<^sub>0
       using \<rho>.leg0_is_map \<sigma>.leg1_is_map composable by unfold_locales auto
 
     text \<open>
       We need access to simps, etc. in the preceding interpretation, yet trying to declare
       it as a sublocale introduces too many conflicts at the moment.
       As it confusing elsewhere to figure out exactly how, in other contexts, to express
       the particular interpretation that is needed, to make things easier we include the
       following lemma.  Then we can just recall the lemma to find out how to express
       the interpretation required in a given context.
     \<close>
 
     lemma r\<^sub>0s\<^sub>1_is_cospan:
     shows "cospan_of_maps_in_bicategory_of_spans V H \<a> \<i> src trg s\<^sub>1 r\<^sub>0"
       ..
 
     text \<open>
       The following define the projections associated with the natural tabulation of \<open>r\<^sub>0\<^sup>* \<star> s\<^sub>1\<close>.
     \<close>
 
     abbreviation p\<^sub>0
     where "p\<^sub>0 \<equiv> r\<^sub>0s\<^sub>1.p\<^sub>0"
 
     abbreviation p\<^sub>1
     where "p\<^sub>1 \<equiv> r\<^sub>0s\<^sub>1.p\<^sub>1"
 
     text \<open>
 $$
 \xymatrix{
   && {\rm src}~\phi \ar[dl]_{p_1} \ar[dr]^{p_0} \ddtwocell\omit{^\phi} \\  
   & {\rm src}~\rho \ar[dl]_{r_1} \ar[dr]^{r_0} \dtwocell\omit{^\rho}
   && {\rm src}~\sigma  \ar[dl]_{s_1} \ar[dr]^{s_0} \dtwocell\omit{^\sigma}\\
   {\rm trg}~r && {\rm src}~r = {\rm trg}~s \ar[ll]^{r} && {\rm src}~s \ar[ll]^{s}
 }
 $$
     \<close>
 
     text \<open>
       Next, we define the 2-cell that is the composite of the tabulation \<open>\<sigma>\<close>, the tabulation \<open>\<rho>\<close>,
       and the central diamond that commutes up to unique isomorphism \<open>\<phi>\<close>.
     \<close>
 
     definition tab
     where "tab \<equiv> \<a>\<^sup>-\<^sup>1[r, s, s\<^sub>0 \<star> p\<^sub>0] \<cdot> (r \<star> \<a>[s, s\<^sub>0, p\<^sub>0]) \<cdot> (r \<star> \<sigma> \<star> p\<^sub>0) \<cdot>
                    (r \<star> r\<^sub>0s\<^sub>1.\<phi>) \<cdot> \<a>[r, r\<^sub>0, p\<^sub>1] \<cdot> (\<rho> \<star> p\<^sub>1)"
 
     lemma tab_in_hom [intro]:
     shows "\<guillemotleft>tab : r\<^sub>1 \<star> p\<^sub>1 \<Rightarrow> (r \<star> s) \<star> s\<^sub>0 \<star> p\<^sub>0\<guillemotright>"
       using \<rho>.T0.antipar(1) r\<^sub>0s\<^sub>1.\<phi>_in_hom composable \<rho>.leg0_in_hom(1) \<sigma>.leg1_in_hom(1)
             composable tab_def
       by auto
 
     interpretation tabulation_data V H \<a> \<i> src trg \<open>r \<star> s\<close> tab \<open>s\<^sub>0 \<star> p\<^sub>0\<close> \<open>r\<^sub>1 \<star> p\<^sub>1\<close>
       using composable tab_in_hom
       by unfold_locales auto
 
     text \<open>
       In the subsequent proof we will use coherence to shortcut a few of the calculations.
     \<close>
     interpretation E: self_evaluation_map V H \<a> \<i> src trg ..
     notation E.eval ("\<lbrace>_\<rbrace>")
 
     text \<open>
       The following is applied twice in the proof of property \<open>T2\<close> for the composite
       tabulation.  It's too long to repeat.
     \<close>
 
     lemma technical:
     assumes "ide w"
     and "\<guillemotleft>\<theta> : (s\<^sub>0 \<star> p\<^sub>0) \<star> w \<Rightarrow> u\<guillemotright>"
     and "w\<^sub>r = p\<^sub>1 \<star> w"
     and "\<theta>\<^sub>r = (s \<star> \<theta>) \<cdot> (s \<star> \<a>\<^sup>-\<^sup>1[s\<^sub>0, p\<^sub>0, w]) \<cdot> \<a>[s, s\<^sub>0, p\<^sub>0 \<star> w] \<cdot>
                 (\<sigma> \<star> p\<^sub>0 \<star> w) \<cdot> \<a>[s\<^sub>1, p\<^sub>0, w] \<cdot> (r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w]"
     shows "\<rho>.composite_cell w\<^sub>r \<theta>\<^sub>r = \<a>[r, s, u] \<cdot> composite_cell w \<theta> \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>1, p\<^sub>1, w]"
     text \<open>
 $$
 \xymatrix{
   && X \ar[d]^{w} \ar@/ur20pt/[dddrr]^{u} \xtwocell[ddr]{}\omit{^{\theta}} \\
   && {\rm src}~\phi \ar[dl]_{p_1} \ar[dr]^{p_0} \ddtwocell\omit{^\phi} \\  
   & {\rm src}~\rho \ar[dl]_{r_1} \ar[dr]^{r_0} \dtwocell\omit{^\rho}
   && {\rm src}~\sigma  \ar[dl]_{s_1} \ar[dr]^{s_0} \dtwocell\omit{^\sigma}\\
   {\rm trg}~r && {\rm src}~r = {\rm trg}~s \ar[ll]^{r} && {\rm src}~s \ar[ll]^{s}
 }
 $$
     \<close>
     proof -
       interpret uw\<theta>: uw\<theta> V H \<a> \<i> src trg \<open>r \<star> s\<close> tab \<open>s\<^sub>0 \<star> p\<^sub>0\<close> \<open>r\<^sub>1 \<star> p\<^sub>1\<close> u w \<theta>
         using assms(1-2) composable
         by unfold_locales auto
       show ?thesis
       proof -
         have "\<a>[r, s, u] \<cdot> composite_cell w \<theta> \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>1, p\<^sub>1, w] =
               (\<a>[r, s, u] \<cdot> ((r \<star> s) \<star> \<theta>)) \<cdot> \<a>[r \<star> s, s\<^sub>0 \<star> p\<^sub>0, w] \<cdot> (tab \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>1, p\<^sub>1, w]"
           using comp_assoc by presburger
         also have "... = (r \<star> s \<star> \<theta>) \<cdot> \<a>[r, s, (s\<^sub>0 \<star> p\<^sub>0) \<star> w] \<cdot> \<a>[r \<star> s, s\<^sub>0 \<star> p\<^sub>0, w] \<cdot>
                            (tab \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>1, p\<^sub>1, w]"
           using assoc_naturality [of r s \<theta>] composable comp_assoc by simp
         also have "... = (r \<star> s \<star> \<theta>) \<cdot> \<a>[r, s, (s\<^sub>0 \<star> p\<^sub>0) \<star> w] \<cdot> \<a>[r \<star> s, s\<^sub>0 \<star> p\<^sub>0, w] \<cdot>
                            ((\<a>\<^sup>-\<^sup>1[r, s, s\<^sub>0 \<star> p\<^sub>0] \<cdot> (r \<star> \<a>[s, s\<^sub>0, p\<^sub>0])) \<cdot> (r \<star> \<sigma> \<star> p\<^sub>0) \<cdot>
                            \<rho>.composite_cell p\<^sub>1 r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>1, p\<^sub>1, w]"
           unfolding tab_def
           using comp_assoc by presburger
         also have "... = (r \<star> s \<star> \<theta>) \<cdot> ((\<a>[r, s, (s\<^sub>0 \<star> p\<^sub>0) \<star> w] \<cdot> \<a>[r \<star> s, s\<^sub>0 \<star> p\<^sub>0, w] \<cdot>
                            (\<a>\<^sup>-\<^sup>1[r, s, s\<^sub>0 \<star> p\<^sub>0] \<cdot> (r \<star> \<a>[s, s\<^sub>0, p\<^sub>0]) \<star> w))) \<cdot>
                            ((r \<star> \<sigma> \<star> p\<^sub>0) \<cdot> \<rho>.composite_cell p\<^sub>1 r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot>
                            \<a>\<^sup>-\<^sup>1[r\<^sub>1, p\<^sub>1, w]"
           using composable \<rho>.T0.antipar(1) comp_assoc whisker_right by auto
         also have "... = (r \<star> s \<star> \<theta>) \<cdot> ((\<a>[r, s, (s\<^sub>0 \<star> p\<^sub>0) \<star> w] \<cdot> \<a>[r \<star> s, s\<^sub>0 \<star> p\<^sub>0, w] \<cdot>
                            (\<a>\<^sup>-\<^sup>1[r, s, s\<^sub>0 \<star> p\<^sub>0] \<cdot> (r \<star> \<a>[s, s\<^sub>0, p\<^sub>0]) \<star> w))) \<cdot>
                            ((r \<star> \<sigma> \<star> p\<^sub>0) \<star> w) \<cdot> ((r \<star> r\<^sub>0s\<^sub>1.\<phi>) \<star> w) \<cdot>
                             (\<a>[r, r\<^sub>0, p\<^sub>1] \<star> w) \<cdot> ((\<rho> \<star> p\<^sub>1) \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>1, p\<^sub>1, w]"
           using composable \<rho>.T0.antipar(1) whisker_right tab_def tab_in_hom(2)
                 composable comp_assoc
           by force
         also have "... = (r \<star> s \<star> \<theta>) \<cdot> ((\<a>[r, s, (s\<^sub>0 \<star> p\<^sub>0) \<star> w] \<cdot> \<a>[r \<star> s, s\<^sub>0 \<star> p\<^sub>0, w] \<cdot>
                            (\<a>\<^sup>-\<^sup>1[r, s, s\<^sub>0 \<star> p\<^sub>0] \<cdot> (r \<star> \<a>[s, s\<^sub>0, p\<^sub>0]) \<star> w))) \<cdot>
                            ((r \<star> \<sigma> \<star> p\<^sub>0) \<star> w) \<cdot> ((r \<star> r\<^sub>0s\<^sub>1.\<phi>) \<star> w) \<cdot>
                            ((\<a>[r, r\<^sub>0, p\<^sub>1] \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[r \<star> r\<^sub>0, p\<^sub>1, w]) \<cdot> (\<rho> \<star> p\<^sub>1 \<star> w)"
           using assoc'_naturality [of \<rho> p\<^sub>1 w] \<rho>.T0.antipar(1) r\<^sub>0s\<^sub>1.base_simps(2) comp_assoc
           by auto
         also have "... = (r \<star> s \<star> \<theta>) \<cdot> ((\<a>[r, s, (s\<^sub>0 \<star> p\<^sub>0) \<star> w] \<cdot> \<a>[r \<star> s, s\<^sub>0 \<star> p\<^sub>0, w] \<cdot>
                            (\<a>\<^sup>-\<^sup>1[r, s, s\<^sub>0 \<star> p\<^sub>0] \<cdot> (r \<star> \<a>[s, s\<^sub>0, p\<^sub>0]) \<star> w))) \<cdot>
                            ((r \<star> \<sigma> \<star> p\<^sub>0) \<star> w) \<cdot> (((r \<star> r\<^sub>0s\<^sub>1.\<phi>) \<star> w) \<cdot>
                            \<a>\<^sup>-\<^sup>1[r, r\<^sub>0 \<star> p\<^sub>1, w]) \<cdot> \<rho>.composite_cell (p\<^sub>1 \<star> w) \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w]"
         proof -
           have "(\<a>[r, r\<^sub>0, p\<^sub>1] \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[r \<star> r\<^sub>0, p\<^sub>1, w] =
                  \<a>\<^sup>-\<^sup>1[r, r\<^sub>0 \<star> p\<^sub>1, w] \<cdot> (r \<star> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w]) \<cdot> \<a>[r, r\<^sub>0, p\<^sub>1 \<star> w]"
           proof -
             have "(\<a>\<^sup>-\<^sup>1[r, r\<^sub>0, p\<^sub>1] \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[r, r\<^sub>0 \<star> p\<^sub>1, w] \<cdot> (r \<star> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w]) =
                   \<a>\<^sup>-\<^sup>1[r \<star> r\<^sub>0, p\<^sub>1, w] \<cdot> \<a>\<^sup>-\<^sup>1[r, r\<^sub>0, p\<^sub>1 \<star> w]"
               using pentagon' \<rho>.T0.antipar(1) comp_assoc by simp
             moreover have 1: "seq (\<a>\<^sup>-\<^sup>1[r, r\<^sub>0, p\<^sub>1] \<star> w)(\<a>\<^sup>-\<^sup>1[r, r\<^sub>0 \<star> p\<^sub>1, w] \<cdot> (r \<star> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w]))"
               using \<rho>.T0.antipar(1)
               by (intro seqI hseqI, auto)
             ultimately
             have "\<a>\<^sup>-\<^sup>1[r \<star> r\<^sub>0, p\<^sub>1, w] =
                    ((\<a>\<^sup>-\<^sup>1[r, r\<^sub>0, p\<^sub>1] \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[r, r\<^sub>0 \<star> p\<^sub>1, w] \<cdot> (r \<star> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w])) \<cdot>
                      \<a>[r, r\<^sub>0, p\<^sub>1 \<star> w]"
               using \<rho>.T0.antipar(1) iso_inv_iso iso_assoc inv_inv
                     invert_side_of_triangle(2)
                       [of "(\<a>\<^sup>-\<^sup>1[r, r\<^sub>0, p\<^sub>1] \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[r, r\<^sub>0 \<star> p\<^sub>1, w] \<cdot> (r \<star> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w])"
                           "\<a>\<^sup>-\<^sup>1[r \<star> r\<^sub>0, p\<^sub>1, w]" "\<a>\<^sup>-\<^sup>1[r, r\<^sub>0, p\<^sub>1 \<star> w]"]
               by fastforce
             hence "\<a>\<^sup>-\<^sup>1[r \<star> r\<^sub>0, p\<^sub>1, w] =
                    (\<a>\<^sup>-\<^sup>1[r, r\<^sub>0, p\<^sub>1] \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[r, r\<^sub>0 \<star> p\<^sub>1, w] \<cdot> (r \<star> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w]) \<cdot>
                      \<a>[r, r\<^sub>0, p\<^sub>1 \<star> w]"
               using comp_assoc by presburger
             moreover have "seq (inv (\<a>\<^sup>-\<^sup>1[r, r\<^sub>0, p\<^sub>1] \<star> w)) \<a>\<^sup>-\<^sup>1[r \<star> r\<^sub>0, p\<^sub>1, w]"
               using \<rho>.T0.antipar(1) iso_inv_iso 1 by fastforce
             ultimately show ?thesis
               using \<rho>.T0.antipar(1) iso_inv_iso iso_assoc inv_inv inv_hcomp
                     invert_side_of_triangle(1)
                       [of "\<a>\<^sup>-\<^sup>1[r \<star> r\<^sub>0, p\<^sub>1, w]" "\<a>\<^sup>-\<^sup>1[r, r\<^sub>0, p\<^sub>1] \<star> w"
                           "\<a>\<^sup>-\<^sup>1[r, r\<^sub>0 \<star> p\<^sub>1, w] \<cdot> (r \<star> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w]) \<cdot> \<a>[r, r\<^sub>0, p\<^sub>1 \<star> w]"]
               by fastforce
           qed
           thus ?thesis
             using comp_assoc by presburger
         qed
         also have "... = (r \<star> s \<star> \<theta>) \<cdot> ((\<a>[r, s, (s\<^sub>0 \<star> p\<^sub>0) \<star> w] \<cdot> \<a>[r \<star> s, s\<^sub>0 \<star> p\<^sub>0, w] \<cdot>
                            (\<a>\<^sup>-\<^sup>1[r, s, s\<^sub>0 \<star> p\<^sub>0] \<cdot> (r \<star> \<a>[s, s\<^sub>0, p\<^sub>0]) \<star> w))) \<cdot>
                            (((r \<star> \<sigma> \<star> p\<^sub>0) \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[r, s\<^sub>1 \<star> p\<^sub>0, w]) \<cdot>
                            (r \<star> r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot> \<rho>.composite_cell (p\<^sub>1 \<star> w) \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w]"
         proof -
           have "((r \<star> r\<^sub>0s\<^sub>1.\<phi>) \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[r, r\<^sub>0 \<star> p\<^sub>1, w] = \<a>\<^sup>-\<^sup>1[r, s\<^sub>1 \<star> p\<^sub>0, w] \<cdot> (r \<star> r\<^sub>0s\<^sub>1.\<phi> \<star> w)"
             using assoc'_naturality [of r r\<^sub>0s\<^sub>1.\<phi> w] r\<^sub>0s\<^sub>1.cospan by auto
           thus ?thesis
             using comp_assoc by presburger
         qed
         also have "... = (r \<star> s \<star> \<theta>) \<cdot>
                            (\<a>[r, s, (s\<^sub>0 \<star> p\<^sub>0) \<star> w] \<cdot> \<a>[r \<star> s, s\<^sub>0 \<star> p\<^sub>0, w] \<cdot>
                              (\<a>\<^sup>-\<^sup>1[r, s, s\<^sub>0 \<star> p\<^sub>0] \<cdot> (r \<star> \<a>[s, s\<^sub>0, p\<^sub>0]) \<star> w) \<cdot>
                              \<a>\<^sup>-\<^sup>1[r, (s \<star> s\<^sub>0) \<star> p\<^sub>0, w]) \<cdot>
                            (r \<star> (\<sigma> \<star> p\<^sub>0) \<star> w) \<cdot> (r \<star> r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot>
                              \<rho>.composite_cell (p\<^sub>1 \<star> w) \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w]"
         proof -
           have "((r \<star> \<sigma> \<star> p\<^sub>0) \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[r, s\<^sub>1 \<star> p\<^sub>0, w] =
                 \<a>\<^sup>-\<^sup>1[r, (s \<star> s\<^sub>0) \<star> p\<^sub>0, w] \<cdot> (r \<star> (\<sigma> \<star> p\<^sub>0) \<star> w)"
             using assoc'_naturality [of r "\<sigma> \<star> p\<^sub>0" w]
             by (simp add: composable)
           thus ?thesis
             using comp_assoc by presburger
         qed
         also have "... = (r \<star> s \<star> \<theta>) \<cdot>
                            (r \<star> (s \<star> \<a>\<^sup>-\<^sup>1[s\<^sub>0, p\<^sub>0, w]) \<cdot> \<a>[s, s\<^sub>0, p\<^sub>0 \<star> w] \<cdot> \<a>[s \<star> s\<^sub>0, p\<^sub>0, w]) \<cdot>
                            ((r \<star> (\<sigma> \<star> p\<^sub>0) \<star> w) \<cdot> (r \<star> r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot> (r \<star> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w])) \<cdot>
                            \<a>[r, r\<^sub>0, p\<^sub>1 \<star> w] \<cdot> (\<rho> \<star> p\<^sub>1 \<star> w)"
         proof -
           have "\<a>[r, s, (s\<^sub>0 \<star> p\<^sub>0) \<star> w] \<cdot> \<a>[r \<star> s, s\<^sub>0 \<star> p\<^sub>0, w] \<cdot>
                   (\<a>\<^sup>-\<^sup>1[r, s, s\<^sub>0 \<star> p\<^sub>0] \<cdot> (r \<star> \<a>[s, s\<^sub>0, p\<^sub>0]) \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[r, (s \<star> s\<^sub>0) \<star> p\<^sub>0, w] =
                 r \<star> (s \<star> \<a>\<^sup>-\<^sup>1[s\<^sub>0, p\<^sub>0, w]) \<cdot> \<a>[s, s\<^sub>0, p\<^sub>0 \<star> w] \<cdot> \<a>[s \<star> s\<^sub>0, p\<^sub>0, w]"
           proof -
             have "\<a>[r, s, (s\<^sub>0 \<star> p\<^sub>0) \<star> w] \<cdot> \<a>[r \<star> s, s\<^sub>0 \<star> p\<^sub>0, w] \<cdot>
                     (\<a>\<^sup>-\<^sup>1[r, s, s\<^sub>0 \<star> p\<^sub>0] \<cdot> (r \<star> \<a>[s, s\<^sub>0, p\<^sub>0]) \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[r, (s \<star> s\<^sub>0) \<star> p\<^sub>0, w] =
                   \<lbrace>\<^bold>\<a>\<^bold>[\<^bold>\<langle>r\<^bold>\<rangle>, \<^bold>\<langle>s\<^bold>\<rangle>, (\<^bold>\<langle>s\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>w\<^bold>\<rangle>\<^bold>] \<^bold>\<cdot> \<^bold>\<a>\<^bold>[\<^bold>\<langle>r\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>s\<^bold>\<rangle>, \<^bold>\<langle>s\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>p\<^sub>0\<^bold>\<rangle>, \<^bold>\<langle>w\<^bold>\<rangle>\<^bold>] \<^bold>\<cdot>
                     (\<^bold>\<a>\<^sup>-\<^sup>1\<^bold>[\<^bold>\<langle>r\<^bold>\<rangle>, \<^bold>\<langle>s\<^bold>\<rangle>, \<^bold>\<langle>s\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>p\<^sub>0\<^bold>\<rangle>\<^bold>] \<^bold>\<cdot> (\<^bold>\<langle>r\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<a>\<^bold>[\<^bold>\<langle>s\<^bold>\<rangle>, \<^bold>\<langle>s\<^sub>0\<^bold>\<rangle>, \<^bold>\<langle>p\<^sub>0\<^bold>\<rangle>\<^bold>]) \<^bold>\<star> \<^bold>\<langle>w\<^bold>\<rangle>) \<^bold>\<cdot>
                     \<^bold>\<a>\<^sup>-\<^sup>1\<^bold>[\<^bold>\<langle>r\<^bold>\<rangle>, (\<^bold>\<langle>s\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>s\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>p\<^sub>0\<^bold>\<rangle>, \<^bold>\<langle>w\<^bold>\<rangle>\<^bold>]\<rbrace>"
               using \<alpha>_def \<a>'_def composable by simp
             also have "... = \<lbrace>\<^bold>\<langle>r\<^bold>\<rangle> \<^bold>\<star> (\<^bold>\<langle>s\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<a>\<^sup>-\<^sup>1\<^bold>[\<^bold>\<langle>s\<^sub>0\<^bold>\<rangle>, \<^bold>\<langle>p\<^sub>0\<^bold>\<rangle>, \<^bold>\<langle>w\<^bold>\<rangle>\<^bold>]) \<^bold>\<cdot> \<^bold>\<a>\<^bold>[\<^bold>\<langle>s\<^bold>\<rangle>, \<^bold>\<langle>s\<^sub>0\<^bold>\<rangle>, \<^bold>\<langle>p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>w\<^bold>\<rangle>\<^bold>] \<^bold>\<cdot>
                                 \<^bold>\<a>\<^bold>[\<^bold>\<langle>s\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>s\<^sub>0\<^bold>\<rangle>, \<^bold>\<langle>p\<^sub>0\<^bold>\<rangle>, \<^bold>\<langle>w\<^bold>\<rangle>\<^bold>]\<rbrace>"
               using composable
               by (intro E.eval_eqI, simp_all)
             also have "... = r \<star> (s \<star> \<a>\<^sup>-\<^sup>1[s\<^sub>0, p\<^sub>0, w]) \<cdot> \<a>[s, s\<^sub>0, p\<^sub>0 \<star> w] \<cdot> \<a>[s \<star> s\<^sub>0, p\<^sub>0, w]"
               using \<alpha>_def \<a>'_def composable by simp
             finally show ?thesis by simp
           qed
           thus ?thesis
             using comp_assoc by presburger
         qed
         also have "... = (r \<star> s \<star> \<theta>) \<cdot>
                            (r \<star> (s \<star> \<a>\<^sup>-\<^sup>1[s\<^sub>0, p\<^sub>0, w]) \<cdot> \<a>[s, s\<^sub>0, p\<^sub>0 \<star> w] \<cdot> \<a>[s \<star> s\<^sub>0, p\<^sub>0, w]) \<cdot>
                            \<rho>.composite_cell (p\<^sub>1 \<star> w)
                              (((\<sigma> \<star> p\<^sub>0) \<star> w) \<cdot> (r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w])"
           using assms(3) arrI \<rho>.T0.antipar(1) whisker_left by auto
         also have "... = (r \<star> (s \<star> \<theta>) \<cdot> (s \<star> \<a>\<^sup>-\<^sup>1[s\<^sub>0, p\<^sub>0, w]) \<cdot> \<a>[s, s\<^sub>0, p\<^sub>0 \<star> w] \<cdot>
                               (\<a>[s \<star> s\<^sub>0, p\<^sub>0, w] \<cdot> ((\<sigma> \<star> p\<^sub>0) \<star> w)) \<cdot>
                               (r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w]) \<cdot>
                            \<a>[r, r\<^sub>0, p\<^sub>1 \<star> w] \<cdot> (\<rho> \<star> p\<^sub>1 \<star> w)"
           using \<rho>.T0.antipar(1) comp_assoc whisker_left by auto
         also have "... = (r \<star> (s \<star> \<theta>) \<cdot> (s \<star> \<a>\<^sup>-\<^sup>1[s\<^sub>0, p\<^sub>0, w]) \<cdot> \<a>[s, s\<^sub>0, p\<^sub>0 \<star> w] \<cdot>
                               (\<sigma> \<star> p\<^sub>0 \<star> w) \<cdot> \<a>[s\<^sub>1, p\<^sub>0, w] \<cdot>
                               (r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w]) \<cdot>
                            \<a>[r, r\<^sub>0, p\<^sub>1 \<star> w] \<cdot> (\<rho> \<star> p\<^sub>1 \<star> w)"
           using assoc_naturality [of \<sigma> p\<^sub>0 w] comp_assoc by simp
         finally show ?thesis
           using assms(3-4) by simp
       qed
     qed
 
     lemma composite_is_tabulation:
     shows "tabulation V H \<a> \<i> src trg (r \<star> s) tab (s\<^sub>0 \<star> p\<^sub>0) (r\<^sub>1 \<star> p\<^sub>1)"
     proof
       show "\<And>u \<omega>. \<lbrakk> ide u; \<guillemotleft>\<omega> : dom \<omega> \<Rightarrow> (r \<star> s) \<star> u\<guillemotright> \<rbrakk> \<Longrightarrow>
                    \<exists>w \<theta> \<nu>. ide w \<and> \<guillemotleft>\<theta> : (s\<^sub>0 \<star> p\<^sub>0) \<star> w \<Rightarrow> u\<guillemotright> \<and>
                            \<guillemotleft>\<nu> : dom \<omega> \<Rightarrow> (r\<^sub>1 \<star> p\<^sub>1) \<star> w\<guillemotright> \<and> iso \<nu> \<and>
                            composite_cell w \<theta> \<cdot> \<nu> = \<omega>"
       proof -
         fix u \<omega>
         assume u: "ide u"
         assume \<omega>: "\<guillemotleft>\<omega> : dom \<omega> \<Rightarrow> (r \<star> s) \<star> u\<guillemotright>"
         let ?v = "dom \<omega>"
         have 1: "\<guillemotleft>\<a>[r, s, u] \<cdot> \<omega> : ?v \<Rightarrow> r \<star> s \<star> u\<guillemotright>"
         proof -
           (*
            * TODO: I think this highlights the current issue with assoc_in_hom:
            * it can't be applied automatically here because there isn't any way to
            * obtain the equations src r = trg s and src s = trg u from assumption \<omega>.
            * Maybe this can be improved with a little bit of thought, but not while
            * a lot of other stuff is being changed, too.
            *)
           have "src r = trg s \<and> src s = trg u"
             by (metis \<omega> arr_cod hseq_char in_homE hcomp_simps(1))
           thus ?thesis
             using u \<omega> by fastforce
         qed
 
         obtain w\<^sub>r \<theta>\<^sub>r \<nu>\<^sub>r
         where w\<^sub>r\<theta>\<^sub>r\<nu>\<^sub>r: "ide w\<^sub>r \<and> \<guillemotleft>\<theta>\<^sub>r : r\<^sub>0 \<star> w\<^sub>r \<Rightarrow> s \<star> u\<guillemotright> \<and>
                                \<guillemotleft>\<nu>\<^sub>r : ?v \<Rightarrow> r\<^sub>1 \<star> w\<^sub>r\<guillemotright> \<and> iso \<nu>\<^sub>r \<and>
                                \<rho>.composite_cell w\<^sub>r \<theta>\<^sub>r \<cdot> \<nu>\<^sub>r = \<a>[r, s, u] \<cdot> \<omega>"
           using u \<omega> \<rho>.T1 [of "s \<star> u" "\<a>[r, s, u] \<cdot> \<omega>"]
           by (metis 1 \<rho>.ide_base \<sigma>.ide_base arr_cod composable ide_hcomp in_homE
               match_1 not_arr_null seq_if_composable)
         text \<open>
 $$
 \xymatrix{
   && X \ar@ {.>}[ddl]^{w_r} \ar@/ul20pt/[dddll]_{v} \xtwocell[dddll]{}\omit{^{<1.5>\nu_r}}
   \ar@/ur20pt/[dddrr]^{u} \xtwocell[dddr]{}\omit{^{\theta_r}} \\
   && \\  
   & {\rm src}~\rho \ar[dl]_{r_1} \ar[dr]^{r_0} \dtwocell\omit{^\rho}
   && \\
   {\rm trg}~r && {\rm src}~r = {\rm trg}~s \ar[ll]^{r} && {\rm src}~s \ar[ll]^{s}
 }
 $$
         \<close>
         text \<open>We need some simps, etc., otherwise the subsequent diagram chase is very painful.\<close>
         have w\<^sub>r: "ide w\<^sub>r"
           using w\<^sub>r\<theta>\<^sub>r\<nu>\<^sub>r by simp
         have [simp]: "src w\<^sub>r = src u"
            using w\<^sub>r\<theta>\<^sub>r\<nu>\<^sub>r \<omega> 1 comp_arr_dom in_homE seqE hcomp_simps(1) vseq_implies_hpar(1)
            by (metis src_hcomp)
         have [simp]: "trg w\<^sub>r = src \<rho>"
           using w\<^sub>r\<theta>\<^sub>r\<nu>\<^sub>r
           by (metis 1 arrI not_arr_null seqE seq_if_composable)
         have \<theta>\<^sub>r_in_hom [intro]: "\<guillemotleft>\<theta>\<^sub>r : r\<^sub>0 \<star> w\<^sub>r \<Rightarrow> s \<star> u\<guillemotright>"
           using w\<^sub>r\<theta>\<^sub>r\<nu>\<^sub>r by simp
         have \<theta>\<^sub>r_in_hhom [intro]: "\<guillemotleft>\<theta>\<^sub>r : src u \<rightarrow> trg s\<guillemotright>"
           using \<theta>\<^sub>r_in_hom src_cod [of \<theta>\<^sub>r] trg_cod [of \<theta>\<^sub>r]
           by (metis \<open>src w\<^sub>r = src u\<close> \<sigma>.leg1_simps(4) arr_dom in_hhomI in_homE r\<^sub>0s\<^sub>1.cospan
               src_hcomp trg_hcomp vconn_implies_hpar(1) vconn_implies_hpar(2))
         have [simp]: "src \<theta>\<^sub>r = src u" using \<theta>\<^sub>r_in_hhom by auto
         have [simp]: "trg \<theta>\<^sub>r = trg s" using \<theta>\<^sub>r_in_hhom by auto
         have [simp]: "dom \<theta>\<^sub>r = r\<^sub>0 \<star> w\<^sub>r" using \<theta>\<^sub>r_in_hom by blast
         have [simp]: "cod \<theta>\<^sub>r = s \<star> u" using \<theta>\<^sub>r_in_hom by blast
         have \<nu>\<^sub>r_in_hom [intro]: "\<guillemotleft>\<nu>\<^sub>r : ?v \<Rightarrow> r\<^sub>1 \<star> w\<^sub>r\<guillemotright>" using w\<^sub>r\<theta>\<^sub>r\<nu>\<^sub>r by simp
         have \<nu>\<^sub>r_in_hhom [intro]: "\<guillemotleft>\<nu>\<^sub>r : src u \<rightarrow> trg r\<guillemotright>"
           using \<nu>\<^sub>r_in_hom src_dom [of \<nu>\<^sub>r] trg_dom [of \<nu>\<^sub>r]
           by (metis \<open>src w\<^sub>r = src u\<close> \<rho>.leg1_simps(4) arr_cod in_hhomI in_homE
               src_hcomp trg_hcomp vconn_implies_hpar(3) vconn_implies_hpar(4))
         have [simp]: "src \<nu>\<^sub>r = src u" using \<nu>\<^sub>r_in_hhom by auto
         have [simp]: "trg \<nu>\<^sub>r = trg r" using \<nu>\<^sub>r_in_hhom by auto
         have [simp]: "dom \<nu>\<^sub>r = ?v" using \<nu>\<^sub>r_in_hom by auto
         have [simp]: "cod \<nu>\<^sub>r = r\<^sub>1 \<star> w\<^sub>r" using \<nu>\<^sub>r_in_hom by auto
         have iso_\<nu>\<^sub>r: "iso \<nu>\<^sub>r" using w\<^sub>r\<theta>\<^sub>r\<nu>\<^sub>r by simp
 
         obtain w\<^sub>s \<theta>\<^sub>s \<nu>\<^sub>s
         where w\<^sub>s\<theta>\<^sub>s\<nu>\<^sub>s: "ide w\<^sub>s \<and> \<guillemotleft>\<theta>\<^sub>s : s\<^sub>0 \<star> w\<^sub>s \<Rightarrow> u\<guillemotright> \<and> \<guillemotleft>\<nu>\<^sub>s : r\<^sub>0 \<star> w\<^sub>r \<Rightarrow> s\<^sub>1 \<star> w\<^sub>s\<guillemotright> \<and> iso \<nu>\<^sub>s \<and>
                       \<sigma>.composite_cell w\<^sub>s \<theta>\<^sub>s \<cdot> \<nu>\<^sub>s = \<theta>\<^sub>r"
           using u w\<^sub>r\<theta>\<^sub>r\<nu>\<^sub>r \<sigma>.T1 [of u \<theta>\<^sub>r] by auto
         text \<open>
 $$
 \xymatrix{
   && X \ar[ddl]^{w_r} \ar@/ul20pt/[dddll]_{v} \xtwocell[dddll]{}\omit{^{<1.5>\nu_r}}
   \ar@/ur20pt/[dddrr]^{u} \ar@ {.>}[ddr]_{w_s} \xtwocell[dddrr]{}\omit{^{<-1.5>\theta_s}}
   \xtwocell[ddd]{}\omit{^{<1>\nu_s}} \\
   && \\  
   & {\rm src}~\rho \ar[dl]_{r_1} \ar[dr]^{r_0} \dtwocell\omit{^\rho}
   && {\rm src}~\sigma  \ar[dl]_{s_1} \ar[dr]^{s_0} \dtwocell\omit{^\sigma}\\
   {\rm trg}~r && {\rm src}~r = {\rm trg}~s \ar[ll]^{r} && {\rm src}~s \ar[ll]^{s}
 }
 $$
         \<close>
         have w\<^sub>s: "ide w\<^sub>s"
           using w\<^sub>s\<theta>\<^sub>s\<nu>\<^sub>s by simp
         have [simp]: "src w\<^sub>s = src u"
           using w\<^sub>s\<theta>\<^sub>s\<nu>\<^sub>s src_cod
           by (metis \<sigma>.leg0_simps(2) \<sigma>.tab_simps(2) \<theta>\<^sub>r_in_hom arrI hseqI' ideD(1) seqE
               seq_if_composable src_hcomp vconn_implies_hpar(3))
         have [simp]: "trg w\<^sub>s = src \<sigma>"
           using w\<^sub>s\<theta>\<^sub>s\<nu>\<^sub>s
           by (metis \<sigma>.tab_simps(2) arr_dom in_homE not_arr_null seq_if_composable)
         have \<theta>\<^sub>s_in_hom [intro]: "\<guillemotleft>\<theta>\<^sub>s : s\<^sub>0 \<star> w\<^sub>s \<Rightarrow> u\<guillemotright>"
           using w\<^sub>s\<theta>\<^sub>s\<nu>\<^sub>s by simp
         have \<theta>\<^sub>s_in_hhom [intro]: "\<guillemotleft>\<theta>\<^sub>s : src u \<rightarrow> src s\<guillemotright>"
           using \<theta>\<^sub>s_in_hom src_cod trg_cod
           by (metis \<theta>\<^sub>r_in_hom arrI hseqE in_hhom_def seqE vconn_implies_hpar(1)
               vconn_implies_hpar(3) w\<^sub>s\<theta>\<^sub>s\<nu>\<^sub>s)
         have [simp]: "src \<theta>\<^sub>s = src u" using \<theta>\<^sub>s_in_hhom by auto
         have [simp]: "trg \<theta>\<^sub>s = src s" using \<theta>\<^sub>s_in_hhom by auto
         have [simp]: "dom \<theta>\<^sub>s = s\<^sub>0 \<star> w\<^sub>s" using \<theta>\<^sub>s_in_hom by blast
         have [simp]: "cod \<theta>\<^sub>s = u" using \<theta>\<^sub>s_in_hom by blast
         have \<nu>\<^sub>s_in_hom [intro]: "\<guillemotleft>\<nu>\<^sub>s : r\<^sub>0 \<star> w\<^sub>r \<Rightarrow> s\<^sub>1 \<star> w\<^sub>s\<guillemotright>" using w\<^sub>s\<theta>\<^sub>s\<nu>\<^sub>s by simp
         have \<nu>\<^sub>s_in_hhom [intro]: "\<guillemotleft>\<nu>\<^sub>s : src u \<rightarrow> trg s\<guillemotright>"
           using \<nu>\<^sub>s_in_hom src_dom trg_cod
           by (metis \<open>src \<theta>\<^sub>r = src u\<close> \<open>trg \<theta>\<^sub>r = trg s\<close> \<theta>\<^sub>r_in_hom in_hhomI in_homE src_dom trg_dom)
         have [simp]: "src \<nu>\<^sub>s = src u" using \<nu>\<^sub>s_in_hhom by auto
         have [simp]: "trg \<nu>\<^sub>s = trg s" using \<nu>\<^sub>s_in_hhom by auto
         have [simp]: "dom \<nu>\<^sub>s = r\<^sub>0 \<star> w\<^sub>r" using \<nu>\<^sub>s_in_hom by auto
         have [simp]: "cod \<nu>\<^sub>s = s\<^sub>1 \<star> w\<^sub>s" using \<nu>\<^sub>s_in_hom by auto
         have iso_\<nu>\<^sub>s: "iso \<nu>\<^sub>s" using w\<^sub>s\<theta>\<^sub>s\<nu>\<^sub>s by simp
 
         obtain w \<theta>\<^sub>t \<nu>\<^sub>t
         where w\<theta>\<^sub>t\<nu>\<^sub>t: "ide w \<and> \<guillemotleft>\<theta>\<^sub>t : p\<^sub>0 \<star> w \<Rightarrow> w\<^sub>s\<guillemotright> \<and> \<guillemotleft>\<nu>\<^sub>t : w\<^sub>r \<Rightarrow> p\<^sub>1 \<star> w\<guillemotright> \<and> iso \<nu>\<^sub>t \<and>
                     (s\<^sub>1 \<star> \<theta>\<^sub>t) \<cdot> \<a>[s\<^sub>1, p\<^sub>0, w] \<cdot> (r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w] \<cdot> (r\<^sub>0 \<star> \<nu>\<^sub>t) = \<nu>\<^sub>s"
           using w\<^sub>r\<theta>\<^sub>r\<nu>\<^sub>r w\<^sub>s\<theta>\<^sub>s\<nu>\<^sub>s iso_\<nu>\<^sub>s r\<^sub>0s\<^sub>1.\<phi>_biuniversal_prop(1) [of w\<^sub>s w\<^sub>r \<nu>\<^sub>s] by blast
         text \<open>
 $$
 \xymatrix{
   && X \ar[ddl]_{w_r} \ar@/ul20pt/[dddll]_{v} \xtwocell[dddll]{}\omit{^{<1.5>\nu_r}}
   \ar@/ur20pt/[dddrr]^{u} \ar[ddr]^{w_s} \xtwocell[dddrr]{}\omit{^{<-1.5>\theta_s}}
   \ar@ {.>}[d]^{w} \xtwocell[ddl]{}\omit{^<-2>{\nu_t}} \xtwocell[ddr]{}\omit{^<2>{\theta_t}} \\
   && {\rm src}~\phi \ar[dl]_{p_1} \ar[dr]^{p_0} \ddtwocell\omit{^\phi} \\  
   & {\rm src}~\rho \ar[dl]_{r_1} \ar[dr]^{r_0} \dtwocell\omit{^\rho}
   && {\rm src}~\sigma  \ar[dl]_{s_1} \ar[dr]^{s_0} \dtwocell\omit{^\sigma}\\
   {\rm trg}~r && {\rm src}~r = {\rm trg}~s \ar[ll]^{r} && {\rm src}~s \ar[ll]^{s}
 }
 $$
         \<close>
         text \<open>{\bf Note:} \<open>w\<close> is not necessarily a map.\<close>
         have w: "ide w"
           using w\<theta>\<^sub>t\<nu>\<^sub>t by simp
         have [simp]: "src w = src u"
           using w\<theta>\<^sub>t\<nu>\<^sub>t src_cod
           by (metis \<nu>\<^sub>s_in_hom \<open>src \<nu>\<^sub>s = src u\<close> arrI seqE src_hcomp src_vcomp vseq_implies_hpar(1))
         have [simp]: "trg w = src p\<^sub>0"
           using w\<theta>\<^sub>t\<nu>\<^sub>t
           by (metis \<nu>\<^sub>s_in_hom arrI not_arr_null r\<^sub>0s\<^sub>1.\<phi>_simps(2) seqE seq_if_composable)
         have \<theta>\<^sub>t_in_hom [intro]: "\<guillemotleft>\<theta>\<^sub>t : p\<^sub>0 \<star> w \<Rightarrow> w\<^sub>s\<guillemotright>"
           using w\<theta>\<^sub>t\<nu>\<^sub>t by simp
         have \<theta>\<^sub>t_in_hhom [intro]: "\<guillemotleft>\<theta>\<^sub>t : src u \<rightarrow> src \<sigma>\<guillemotright>"
           using \<theta>\<^sub>t_in_hom src_cod trg_cod \<open>src w\<^sub>s = src u\<close> \<open>trg w\<^sub>s = src \<sigma>\<close> by fastforce
         have [simp]: "src \<theta>\<^sub>t = src u" using \<theta>\<^sub>t_in_hhom by auto
         have [simp]: "trg \<theta>\<^sub>t = src \<sigma>" using \<theta>\<^sub>t_in_hhom by auto
         have [simp]: "dom \<theta>\<^sub>t = p\<^sub>0 \<star> w" using \<theta>\<^sub>t_in_hom by blast
         have (* [simp]: *) "cod \<theta>\<^sub>t = w\<^sub>s" using \<theta>\<^sub>t_in_hom by blast
         have \<nu>\<^sub>t_in_hom [intro]: "\<guillemotleft>\<nu>\<^sub>t : w\<^sub>r \<Rightarrow> p\<^sub>1 \<star> w\<guillemotright>" using w\<theta>\<^sub>t\<nu>\<^sub>t by simp
         have \<nu>\<^sub>t_in_hhom [intro]: "\<guillemotleft>\<nu>\<^sub>t : src u \<rightarrow> src \<rho>\<guillemotright>"
           using \<nu>\<^sub>t_in_hom src_dom trg_dom \<open>src w\<^sub>r = src u\<close> \<open>trg w\<^sub>r = src \<rho>\<close> by fastforce
         have [simp]: "src \<nu>\<^sub>t = src u" using \<nu>\<^sub>t_in_hhom by auto
         have [simp]: "trg \<nu>\<^sub>t = src \<rho>" using \<nu>\<^sub>t_in_hhom by auto
         have (* [simp]: *) "dom \<nu>\<^sub>t = w\<^sub>r" using \<nu>\<^sub>t_in_hom by auto
         have [simp]: "cod \<nu>\<^sub>t = p\<^sub>1 \<star> w" using \<nu>\<^sub>t_in_hom by auto
         have iso_\<nu>\<^sub>t: "iso \<nu>\<^sub>t" using w\<theta>\<^sub>t\<nu>\<^sub>t by simp
 
         define \<theta> where "\<theta> = \<theta>\<^sub>s \<cdot> (s\<^sub>0 \<star> \<theta>\<^sub>t) \<cdot> \<a>[s\<^sub>0, p\<^sub>0, w]"
         have \<theta>: "\<guillemotleft>\<theta> : (s\<^sub>0 \<star> p\<^sub>0) \<star> w \<Rightarrow> u\<guillemotright>"
         proof (unfold \<theta>_def, intro comp_in_homI)
           show "\<guillemotleft>\<a>[s\<^sub>0, p\<^sub>0, w] : (s\<^sub>0 \<star> p\<^sub>0) \<star> w \<Rightarrow> s\<^sub>0 \<star> p\<^sub>0 \<star> w\<guillemotright>"
             using w\<theta>\<^sub>t\<nu>\<^sub>t by auto
           show "\<guillemotleft>s\<^sub>0 \<star> \<theta>\<^sub>t : s\<^sub>0 \<star> p\<^sub>0 \<star> w \<Rightarrow> s\<^sub>0 \<star> w\<^sub>s\<guillemotright>"
             using w\<theta>\<^sub>t\<nu>\<^sub>t by auto
           show "\<guillemotleft>\<theta>\<^sub>s : s\<^sub>0 \<star> w\<^sub>s \<Rightarrow> u\<guillemotright>"
             using w\<^sub>s\<theta>\<^sub>s\<nu>\<^sub>s by simp
         qed
         define \<nu> where "\<nu> = \<a>\<^sup>-\<^sup>1[r\<^sub>1, p\<^sub>1, w] \<cdot> (r\<^sub>1 \<star> \<nu>\<^sub>t) \<cdot> \<nu>\<^sub>r"
         have \<nu>: "\<guillemotleft>\<nu> : ?v \<Rightarrow> (r\<^sub>1 \<star> p\<^sub>1) \<star> w\<guillemotright>"
         proof (unfold \<nu>_def, intro comp_in_homI)
           show "\<guillemotleft>\<nu>\<^sub>r : ?v \<Rightarrow> r\<^sub>1 \<star> w\<^sub>r\<guillemotright>"
             using w\<^sub>r\<theta>\<^sub>r\<nu>\<^sub>r by blast
           show "\<guillemotleft>r\<^sub>1 \<star> \<nu>\<^sub>t : r\<^sub>1 \<star> w\<^sub>r \<Rightarrow> r\<^sub>1 \<star> p\<^sub>1 \<star> w\<guillemotright>"
             using w\<theta>\<^sub>t\<nu>\<^sub>t by (intro hcomp_in_vhom, auto)
           show "\<guillemotleft>\<a>\<^sup>-\<^sup>1[r\<^sub>1, p\<^sub>1, w] : r\<^sub>1 \<star> p\<^sub>1 \<star> w \<Rightarrow> (r\<^sub>1 \<star> p\<^sub>1) \<star> w\<guillemotright>"
             using w\<theta>\<^sub>t\<nu>\<^sub>t assoc_in_hom by (simp add: \<rho>.T0.antipar(1))
         qed
         have iso_\<nu>: "iso \<nu>"
           using \<nu> w\<theta>\<^sub>t\<nu>\<^sub>t w\<^sub>r\<theta>\<^sub>r\<nu>\<^sub>r \<rho>.T0.antipar(1) iso_inv_iso
           apply (unfold \<nu>_def, intro isos_compose) by auto
         have *: "arr ((s \<star> \<theta>\<^sub>s) \<cdot> \<a>[s, s\<^sub>0, w\<^sub>s] \<cdot> (\<sigma> \<star> w\<^sub>s) \<cdot> (s\<^sub>1 \<star> \<theta>\<^sub>t) \<cdot> \<a>[s\<^sub>1, p\<^sub>0, w] \<cdot>
                        (r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w] \<cdot> (r\<^sub>0 \<star> \<nu>\<^sub>t))"
           using w\<^sub>s\<theta>\<^sub>s\<nu>\<^sub>s w\<theta>\<^sub>t\<nu>\<^sub>t \<theta>\<^sub>r_in_hom comp_assoc by auto
 
         have "((r \<star> s) \<star> \<theta>) \<cdot> \<a>[r \<star> s, s\<^sub>0 \<star> p\<^sub>0, w] \<cdot> (tab \<star> w) \<cdot> \<nu> = \<omega>"
         proof -
           have "seq (r \<star> \<theta>\<^sub>r) (\<a>[r, r\<^sub>0, w\<^sub>r] \<cdot> (\<rho> \<star> w\<^sub>r) \<cdot> \<nu>\<^sub>r)"
             using w\<^sub>r\<theta>\<^sub>r\<nu>\<^sub>r \<rho>.base_simps(2) composable by fastforce
           hence "\<omega> = \<a>\<^sup>-\<^sup>1[r, s, u] \<cdot> \<rho>.composite_cell w\<^sub>r \<theta>\<^sub>r \<cdot> \<nu>\<^sub>r"
             using w\<^sub>r\<theta>\<^sub>r\<nu>\<^sub>r invert_side_of_triangle(1) iso_assoc
             by (metis 1 \<rho>.ide_base \<sigma>.ide_base arrI assoc'_eq_inv_assoc composable hseq_char'
                 seqE seq_if_composable u vconn_implies_hpar(2) vconn_implies_hpar(4) w\<^sub>s\<theta>\<^sub>s\<nu>\<^sub>s)
           also have "... = \<a>\<^sup>-\<^sup>1[r, s, u] \<cdot> \<rho>.composite_cell w\<^sub>r (\<sigma>.composite_cell w\<^sub>s \<theta>\<^sub>s \<cdot> \<nu>\<^sub>s) \<cdot> \<nu>\<^sub>r"
             using w\<^sub>s\<theta>\<^sub>s\<nu>\<^sub>s by simp
           also have "... = \<a>\<^sup>-\<^sup>1[r, s, u] \<cdot> (r \<star> (s \<star> \<theta>\<^sub>s) \<cdot> \<a>[s, s\<^sub>0, w\<^sub>s] \<cdot>
                              (\<sigma> \<star> w\<^sub>s) \<cdot> (s\<^sub>1 \<star> \<theta>\<^sub>t) \<cdot> \<a>[s\<^sub>1, p\<^sub>0, w] \<cdot> (r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot>
                              \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w] \<cdot> (r\<^sub>0 \<star> \<nu>\<^sub>t)) \<cdot> \<a>[r, r\<^sub>0, w\<^sub>r] \<cdot> (\<rho> \<star> w\<^sub>r) \<cdot> \<nu>\<^sub>r"
             using w\<theta>\<^sub>t\<nu>\<^sub>t comp_assoc by simp
           text \<open>Rearrange to create \<open>\<theta>\<close> and \<open>\<nu>\<close>, leaving \<open>tab\<close> in the middle.\<close>
           also have "... = \<a>\<^sup>-\<^sup>1[r, s, u] \<cdot> (r \<star> (s \<star> \<theta>\<^sub>s) \<cdot> \<a>[s, s\<^sub>0, w\<^sub>s] \<cdot>
                              ((\<sigma> \<star> w\<^sub>s) \<cdot> (s\<^sub>1 \<star> \<theta>\<^sub>t)) \<cdot> \<a>[s\<^sub>1, p\<^sub>0, w] \<cdot> (r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot>
                              \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w] \<cdot> (r\<^sub>0 \<star> \<nu>\<^sub>t)) \<cdot> \<a>[r, r\<^sub>0, w\<^sub>r] \<cdot> (\<rho> \<star> w\<^sub>r) \<cdot> \<nu>\<^sub>r"
             using comp_assoc by presburger
           also have "... = \<a>\<^sup>-\<^sup>1[r, s, u] \<cdot> (r \<star> (s \<star> \<theta>\<^sub>s) \<cdot> (\<a>[s, s\<^sub>0, w\<^sub>s] \<cdot>
                              ((s \<star> s\<^sub>0) \<star> \<theta>\<^sub>t)) \<cdot> (\<sigma> \<star> p\<^sub>0 \<star> w) \<cdot> \<a>[s\<^sub>1, p\<^sub>0, w] \<cdot> (r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot>
                              \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w] \<cdot> (r\<^sub>0 \<star> \<nu>\<^sub>t)) \<cdot> \<a>[r, r\<^sub>0, w\<^sub>r] \<cdot> (\<rho> \<star> w\<^sub>r) \<cdot> \<nu>\<^sub>r"
           proof -
             have "(\<sigma> \<star> w\<^sub>s) \<cdot> (s\<^sub>1 \<star> \<theta>\<^sub>t) = \<sigma> \<star> \<theta>\<^sub>t"
               using comp_arr_dom comp_cod_arr interchange
               by (metis \<open>cod \<theta>\<^sub>t = w\<^sub>s\<close> \<sigma>.tab_simps(1) \<sigma>.tab_simps(4) arrI w\<theta>\<^sub>t\<nu>\<^sub>t)
             also have "... = ((s \<star> s\<^sub>0) \<star> \<theta>\<^sub>t) \<cdot> (\<sigma> \<star> p\<^sub>0 \<star> w)"
               using comp_arr_dom comp_cod_arr interchange w\<^sub>s\<theta>\<^sub>s\<nu>\<^sub>s w\<theta>\<^sub>t\<nu>\<^sub>t \<sigma>.tab_in_hom
               by (metis \<open>dom \<theta>\<^sub>t = p\<^sub>0 \<star> w\<close> \<sigma>.tab_simps(5) arrI)
             finally have "(\<sigma> \<star> w\<^sub>s) \<cdot> (s\<^sub>1 \<star> \<theta>\<^sub>t) = ((s \<star> s\<^sub>0) \<star> \<theta>\<^sub>t) \<cdot> (\<sigma> \<star> p\<^sub>0 \<star> w)"
               by simp
             thus ?thesis
               using comp_assoc by presburger
           qed
           also have "... = \<a>\<^sup>-\<^sup>1[r, s, u] \<cdot> (r \<star> (s \<star> \<theta>\<^sub>s) \<cdot> (s \<star> s\<^sub>0 \<star> \<theta>\<^sub>t) \<cdot> \<a>[s, s\<^sub>0, p\<^sub>0 \<star> w] \<cdot>
                              (\<sigma> \<star> p\<^sub>0 \<star> w) \<cdot> \<a>[s\<^sub>1, p\<^sub>0, w] \<cdot> (r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot>
                              \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w] \<cdot> (r\<^sub>0 \<star> \<nu>\<^sub>t)) \<cdot> \<a>[r, r\<^sub>0, w\<^sub>r] \<cdot> (\<rho> \<star> w\<^sub>r) \<cdot> \<nu>\<^sub>r"
               using assoc_naturality [of s s\<^sub>0 \<theta>\<^sub>t] w\<theta>\<^sub>t\<nu>\<^sub>t comp_assoc \<open>cod \<theta>\<^sub>t = w\<^sub>s\<close> arrI by force
           also have "... = \<a>\<^sup>-\<^sup>1[r, s, u] \<cdot> (r \<star> (s \<star> \<theta>\<^sub>s) \<cdot> (s \<star> s\<^sub>0 \<star> \<theta>\<^sub>t)) \<cdot>
                              (r \<star> \<a>[s, s\<^sub>0, p\<^sub>0 \<star> w] \<cdot> (\<sigma> \<star> p\<^sub>0 \<star> w) \<cdot> \<a>[s\<^sub>1, p\<^sub>0, w] \<cdot>
                              (r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w] \<cdot> (r\<^sub>0 \<star> \<nu>\<^sub>t)) \<cdot> \<a>[r, r\<^sub>0, w\<^sub>r] \<cdot>
                              (\<rho> \<star> w\<^sub>r) \<cdot> \<nu>\<^sub>r"
           proof -
             have "r \<star> (s \<star> \<theta>\<^sub>s) \<cdot> (s \<star> s\<^sub>0 \<star> \<theta>\<^sub>t) \<cdot> \<a>[s, s\<^sub>0, p\<^sub>0 \<star> w] \<cdot>
                              (\<sigma> \<star> p\<^sub>0 \<star> w) \<cdot> \<a>[s\<^sub>1, p\<^sub>0, w] \<cdot> (r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot>
                              \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w] \<cdot> (r\<^sub>0 \<star> \<nu>\<^sub>t) =
                   (r \<star> (s \<star> \<theta>\<^sub>s) \<cdot> (s \<star> s\<^sub>0 \<star> \<theta>\<^sub>t)) \<cdot>
                     (r \<star> \<a>[s, s\<^sub>0, p\<^sub>0 \<star> w] \<cdot> (\<sigma> \<star> p\<^sub>0 \<star> w) \<cdot> \<a>[s\<^sub>1, p\<^sub>0, w] \<cdot> (r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot>
                              \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w] \<cdot> (r\<^sub>0 \<star> \<nu>\<^sub>t))"
             proof -
               have "seq ((s \<star> \<theta>\<^sub>s) \<cdot> (s \<star> s\<^sub>0 \<star> \<theta>\<^sub>t))
                         (\<a>[s, s\<^sub>0, p\<^sub>0 \<star> w] \<cdot> (\<sigma> \<star> p\<^sub>0 \<star> w) \<cdot> \<a>[s\<^sub>1, p\<^sub>0, w] \<cdot> (r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot>
                           \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w] \<cdot> (r\<^sub>0 \<star> \<nu>\<^sub>t))"
               proof -
                 have "seq (s \<star> \<theta>\<^sub>s)
                           ((s \<star> s\<^sub>0 \<star> \<theta>\<^sub>t) \<cdot> \<a>[s, s\<^sub>0, p\<^sub>0 \<star> w] \<cdot> (\<sigma> \<star> p\<^sub>0 \<star> w) \<cdot> \<a>[s\<^sub>1, p\<^sub>0, w] \<cdot>
                             (r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w] \<cdot> (r\<^sub>0 \<star> \<nu>\<^sub>t))"
                   using \<open>\<guillemotleft>\<a>[r, s, u] \<cdot> \<omega> : dom \<omega> \<Rightarrow> r \<star> s \<star> u\<guillemotright>\<close> calculation by blast
                 thus ?thesis
                   using comp_assoc by presburger
               qed
               thus ?thesis
                 using whisker_left [of r "(s \<star> \<theta>\<^sub>s) \<cdot> (s \<star> s\<^sub>0 \<star> \<theta>\<^sub>t)"
                                          "\<a>[s, s\<^sub>0, p\<^sub>0 \<star> w] \<cdot> (\<sigma> \<star> p\<^sub>0 \<star> w) \<cdot> \<a>[s\<^sub>1, p\<^sub>0, w] \<cdot>
                                             (r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w] \<cdot> (r\<^sub>0 \<star> \<nu>\<^sub>t)"]
                     w\<^sub>s\<theta>\<^sub>s\<nu>\<^sub>s w\<theta>\<^sub>t\<nu>\<^sub>t comp_assoc
                 by simp
             qed
             thus ?thesis
               using comp_assoc by presburger
           qed
           also have "... = \<a>\<^sup>-\<^sup>1[r, s, u] \<cdot> (r \<star> (s \<star> \<theta>\<^sub>s) \<cdot> (s \<star> s\<^sub>0 \<star> \<theta>\<^sub>t)) \<cdot>
                              (r \<star> \<a>[s, s\<^sub>0, p\<^sub>0 \<star> w] \<cdot> (\<sigma> \<star> p\<^sub>0 \<star> w) \<cdot> \<a>[s\<^sub>1, p\<^sub>0, w] \<cdot>
                              (r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w]) \<cdot> ((r \<star> r\<^sub>0 \<star> \<nu>\<^sub>t) \<cdot> \<a>[r, r\<^sub>0, w\<^sub>r]) \<cdot>
                              (\<rho> \<star> w\<^sub>r) \<cdot> \<nu>\<^sub>r"
           proof -
             have "seq (\<a>[s, s\<^sub>0, p\<^sub>0 \<star> w] \<cdot> (\<sigma> \<star> p\<^sub>0 \<star> w) \<cdot> \<a>[s\<^sub>1, p\<^sub>0, w] \<cdot> (r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot>
                       \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w]) (r\<^sub>0 \<star> \<nu>\<^sub>t)"
               using 1 r\<^sub>0s\<^sub>1.p\<^sub>1_simps w\<theta>\<^sub>t\<nu>\<^sub>t
               apply (intro seqI' comp_in_homI) by auto
             hence "r \<star> (\<a>[s, s\<^sub>0, p\<^sub>0 \<star> w] \<cdot> (\<sigma> \<star> p\<^sub>0 \<star> w) \<cdot> \<a>[s\<^sub>1, p\<^sub>0, w] \<cdot> (r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot>
                      \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w]) \<cdot> (r\<^sub>0 \<star> \<nu>\<^sub>t) =
                    (r \<star> \<a>[s, s\<^sub>0, p\<^sub>0 \<star> w] \<cdot> (\<sigma> \<star> p\<^sub>0 \<star> w) \<cdot> \<a>[s\<^sub>1, p\<^sub>0, w] \<cdot> (r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot>
                      \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w]) \<cdot> (r \<star> r\<^sub>0 \<star> \<nu>\<^sub>t)"
               using whisker_left by simp
             thus ?thesis
               using comp_assoc by simp
           qed
           also have "... = \<a>\<^sup>-\<^sup>1[r, s, u] \<cdot> (r \<star> (s \<star> \<theta>\<^sub>s) \<cdot> (s \<star> s\<^sub>0 \<star> \<theta>\<^sub>t)) \<cdot>
                              (r \<star> \<a>[s, s\<^sub>0, p\<^sub>0 \<star> w] \<cdot> (\<sigma> \<star> p\<^sub>0 \<star> w) \<cdot> \<a>[s\<^sub>1, p\<^sub>0, w] \<cdot>
                              (r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w]) \<cdot> \<a>[r, r\<^sub>0, p\<^sub>1 \<star> w] \<cdot>
                              (((r \<star> r\<^sub>0) \<star> \<nu>\<^sub>t) \<cdot> (\<rho> \<star> w\<^sub>r)) \<cdot> \<nu>\<^sub>r"
           proof -
             have "(r \<star> r\<^sub>0 \<star> \<nu>\<^sub>t) \<cdot> \<a>[r, r\<^sub>0, w\<^sub>r] = \<a>[r, r\<^sub>0, p\<^sub>1 \<star> w] \<cdot> ((r \<star> r\<^sub>0) \<star> \<nu>\<^sub>t)"
               using assoc_naturality [of r r\<^sub>0 \<nu>\<^sub>t] \<nu>\<^sub>t_in_hom by auto
             thus ?thesis
               using comp_assoc by presburger
           qed
           also have "... = (\<a>\<^sup>-\<^sup>1[r, s, u] \<cdot> (r \<star> (s \<star> \<theta>\<^sub>s) \<cdot> (s \<star> s\<^sub>0 \<star> \<theta>\<^sub>t))) \<cdot>
                              (r \<star> \<a>[s, s\<^sub>0, p\<^sub>0 \<star> w] \<cdot> (\<sigma> \<star> p\<^sub>0 \<star> w) \<cdot> \<a>[s\<^sub>1, p\<^sub>0, w] \<cdot>
                              (r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w]) \<cdot> \<a>[r, r\<^sub>0, p\<^sub>1 \<star> w] \<cdot>
                              (\<rho> \<star> p\<^sub>1 \<star> w) \<cdot> (r\<^sub>1 \<star> \<nu>\<^sub>t) \<cdot> \<nu>\<^sub>r"
           proof -
             have "((r \<star> r\<^sub>0) \<star> \<nu>\<^sub>t) \<cdot> (\<rho> \<star> w\<^sub>r) = \<rho> \<star> \<nu>\<^sub>t"
               using comp_arr_dom comp_cod_arr interchange
               by (metis \<open>dom \<nu>\<^sub>t = w\<^sub>r\<close> \<rho>.tab_simps(1) \<rho>.tab_simps(5) arrI w\<theta>\<^sub>t\<nu>\<^sub>t)
             also have "... = (\<rho> \<star> p\<^sub>1 \<star> w) \<cdot> (r\<^sub>1 \<star> \<nu>\<^sub>t)"
               using comp_arr_dom comp_cod_arr interchange
               by (metis \<open>cod \<nu>\<^sub>t = p\<^sub>1 \<star> w\<close> \<open>trg \<nu>\<^sub>t = src \<rho>\<close> \<rho>.T0.antipar(1) \<rho>.tab_simps(1)
                   \<rho>.tab_simps(2) \<rho>.tab_simps(4) r\<^sub>0s\<^sub>1.base_simps(2) trg.preserves_reflects_arr
                   trg_hcomp)
             finally have "((r \<star> r\<^sub>0) \<star> \<nu>\<^sub>t) \<cdot> (\<rho> \<star> w\<^sub>r) = (\<rho> \<star> p\<^sub>1 \<star> w) \<cdot> (r\<^sub>1 \<star> \<nu>\<^sub>t)" by simp
             thus ?thesis
               using comp_assoc by presburger
           qed
           also have "... = ((r \<star> s) \<star> \<theta>\<^sub>s \<cdot> (s\<^sub>0 \<star> \<theta>\<^sub>t)) \<cdot> \<a>\<^sup>-\<^sup>1[r, s, s\<^sub>0 \<star> p\<^sub>0 \<star> w] \<cdot> 
                              (r \<star> \<a>[s, s\<^sub>0, p\<^sub>0 \<star> w] \<cdot> ((\<sigma> \<star> p\<^sub>0 \<star> w) \<cdot> \<a>[s\<^sub>1, p\<^sub>0, w]) \<cdot>
                              (r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w]) \<cdot> \<a>[r, r\<^sub>0, p\<^sub>1 \<star> w] \<cdot>
                              (\<rho> \<star> p\<^sub>1 \<star> w) \<cdot> (r\<^sub>1 \<star> \<nu>\<^sub>t) \<cdot> \<nu>\<^sub>r"
           proof -
             have "\<a>\<^sup>-\<^sup>1[r, s, u] \<cdot> (r \<star> (s \<star> \<theta>\<^sub>s) \<cdot> (s \<star> s\<^sub>0 \<star> \<theta>\<^sub>t)) =
                   ((r \<star> s) \<star> \<theta>\<^sub>s \<cdot> (s\<^sub>0 \<star> \<theta>\<^sub>t)) \<cdot> \<a>\<^sup>-\<^sup>1[r, s, s\<^sub>0 \<star> p\<^sub>0 \<star> w]"
             proof -
               have "seq (s \<star> \<theta>\<^sub>s) (s \<star> s\<^sub>0 \<star> \<theta>\<^sub>t)"
                 using \<theta>\<^sub>s_in_hom \<theta>\<^sub>s_in_hhom \<theta>\<^sub>t_in_hom \<theta>\<^sub>t_in_hhom 1 calculation by blast
               moreover have "src r = trg (s \<star> \<theta>\<^sub>s)"
                 using composable hseqI by force
               ultimately
               have "\<a>\<^sup>-\<^sup>1[r, s, u] \<cdot> (r \<star> (s \<star> \<theta>\<^sub>s) \<cdot> (s \<star> s\<^sub>0 \<star> \<theta>\<^sub>t)) =
                     (\<a>\<^sup>-\<^sup>1[r, s, u] \<cdot> (r \<star> s \<star> \<theta>\<^sub>s)) \<cdot> (r \<star> s \<star> s\<^sub>0 \<star> \<theta>\<^sub>t)"
                 using whisker_left comp_assoc by simp
               also have "... = ((r \<star> s) \<star> \<theta>\<^sub>s) \<cdot> \<a>\<^sup>-\<^sup>1[r, s, s\<^sub>0 \<star> w\<^sub>s] \<cdot> (r \<star> s \<star> s\<^sub>0 \<star> \<theta>\<^sub>t)"
                 using assoc_naturality comp_assoc
                 by (metis \<open>cod \<theta>\<^sub>s = u\<close> \<open>dom \<theta>\<^sub>s = s\<^sub>0 \<star> w\<^sub>s\<close> \<open>trg \<theta>\<^sub>s = src s\<close>
                     \<rho>.base_simps(2-4) \<sigma>.base_simps(2-4) arrI assoc'_naturality composable w\<^sub>s\<theta>\<^sub>s\<nu>\<^sub>s)
               also have "... = (((r \<star> s) \<star> \<theta>\<^sub>s) \<cdot> ((r \<star> s) \<star> s\<^sub>0 \<star> \<theta>\<^sub>t)) \<cdot> \<a>\<^sup>-\<^sup>1[r, s, s\<^sub>0 \<star> p\<^sub>0 \<star> w]"
               proof -
                 have "\<a>\<^sup>-\<^sup>1[r, s, s\<^sub>0 \<star> w\<^sub>s] \<cdot> (r \<star> s \<star> s\<^sub>0 \<star> \<theta>\<^sub>t) =
                       ((r \<star> s) \<star> s\<^sub>0 \<star> \<theta>\<^sub>t) \<cdot> \<a>\<^sup>-\<^sup>1[r, s, s\<^sub>0 \<star> p\<^sub>0 \<star> w]"
                   using arrI hseq_char assoc'_naturality [of r s "s\<^sub>0 \<star> \<theta>\<^sub>t"] \<open>cod \<theta>\<^sub>t = w\<^sub>s\<close> composable
                   by auto
                 thus ?thesis
                   using comp_assoc by auto
               qed
               also have "... = ((r \<star> s) \<star> \<theta>\<^sub>s \<cdot> (s\<^sub>0 \<star> \<theta>\<^sub>t)) \<cdot> \<a>\<^sup>-\<^sup>1[r, s, s\<^sub>0 \<star> p\<^sub>0 \<star> w]"
                 using \<theta>_def \<theta> whisker_left
                 by (metis (full_types) arrI cod_comp ide_base seqE seqI)
               finally show ?thesis by simp
             qed
             thus ?thesis
               using comp_assoc by presburger
           qed
           also have "... = ((r \<star> s) \<star> \<theta>\<^sub>s \<cdot> (s\<^sub>0 \<star> \<theta>\<^sub>t)) \<cdot> \<a>\<^sup>-\<^sup>1[r, s, s\<^sub>0 \<star> p\<^sub>0 \<star> w] \<cdot> 
                              ((r \<star> \<a>[s, s\<^sub>0, p\<^sub>0 \<star> w] \<cdot> \<a>[s \<star> s\<^sub>0, p\<^sub>0, w] \<cdot>
                                ((\<sigma> \<star> p\<^sub>0) \<star> w) \<cdot> (r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w])) \<cdot>
                              \<a>[r, r\<^sub>0, p\<^sub>1 \<star> w] \<cdot> (\<rho> \<star> p\<^sub>1 \<star> w) \<cdot> (r\<^sub>1 \<star> \<nu>\<^sub>t) \<cdot> \<nu>\<^sub>r"
           proof -
             have "(\<sigma> \<star> p\<^sub>0 \<star> w) \<cdot> \<a>[s\<^sub>1, p\<^sub>0, w] = \<a>[s \<star> s\<^sub>0, p\<^sub>0, w] \<cdot> ((\<sigma> \<star> p\<^sub>0) \<star> w)"
               using assoc_naturality [of \<sigma> p\<^sub>0 w] by (simp add: w\<theta>\<^sub>t\<nu>\<^sub>t)
             thus ?thesis
               using comp_assoc by presburger
           qed
           also have "... = ((r \<star> s) \<star> \<theta>\<^sub>s \<cdot> (s\<^sub>0 \<star> \<theta>\<^sub>t)) \<cdot>
                              \<a>\<^sup>-\<^sup>1[r, s, s\<^sub>0 \<star> p\<^sub>0 \<star> w] \<cdot> (r \<star> \<a>[s, s\<^sub>0, p\<^sub>0 \<star> w]) \<cdot>
                              (r \<star> \<a>[s \<star> s\<^sub>0, p\<^sub>0, w]) \<cdot> (r \<star> (\<sigma> \<star> p\<^sub>0) \<star> w) \<cdot> (r \<star> r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot>
                              ((r \<star> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w]) \<cdot> \<a>[r, r\<^sub>0, p\<^sub>1 \<star> w]) \<cdot>
                              (\<rho> \<star> p\<^sub>1 \<star> w) \<cdot> (r\<^sub>1 \<star> \<nu>\<^sub>t) \<cdot> \<nu>\<^sub>r"
             using r\<^sub>0s\<^sub>1.p\<^sub>1_simps w\<theta>\<^sub>t\<nu>\<^sub>t whisker_left comp_assoc by force
           also have "... = ((r \<star> s) \<star> \<theta>\<^sub>s \<cdot> (s\<^sub>0 \<star> \<theta>\<^sub>t)) \<cdot>
                              \<a>\<^sup>-\<^sup>1[r, s, s\<^sub>0 \<star> p\<^sub>0 \<star> w] \<cdot> (r \<star> \<a>[s, s\<^sub>0, p\<^sub>0 \<star> w]) \<cdot>
                              (r \<star> \<a>[s \<star> s\<^sub>0, p\<^sub>0, w]) \<cdot> (r \<star> (\<sigma> \<star> p\<^sub>0) \<star> w) \<cdot> (r \<star> r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot>
                              (\<a>[r, r\<^sub>0 \<star> p\<^sub>1, w] \<cdot> (\<a>[r, r\<^sub>0, p\<^sub>1] \<star> w) \<cdot> (\<a>\<^sup>-\<^sup>1[r \<star> r\<^sub>0, p\<^sub>1, w]) \<cdot>
                              (\<rho> \<star> p\<^sub>1 \<star> w)) \<cdot> (r\<^sub>1 \<star> \<nu>\<^sub>t) \<cdot> \<nu>\<^sub>r"
           proof -
             have "(r \<star> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w]) \<cdot> \<a>[r, r\<^sub>0, p\<^sub>1 \<star> w] =
                   \<a>[r, r\<^sub>0 \<star> p\<^sub>1, w] \<cdot> (\<a>[r, r\<^sub>0, p\<^sub>1] \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[r \<star> r\<^sub>0, p\<^sub>1, w]"
             proof -
               have 1: "(r \<star> \<a>[r\<^sub>0, p\<^sub>1, w]) \<cdot> \<a>[r, r\<^sub>0 \<star> p\<^sub>1, w] \<cdot> (\<a>[r, r\<^sub>0, p\<^sub>1] \<star> w) =
                        \<a>[r, r\<^sub>0, p\<^sub>1 \<star> w] \<cdot> \<a>[r \<star> r\<^sub>0, p\<^sub>1, w]"
                 using pentagon
                 by (simp add: \<rho>.T0.antipar(1) w)
               moreover have 2: "seq \<a>[r, r\<^sub>0, p\<^sub>1 \<star> w] \<a>[r \<star> r\<^sub>0, p\<^sub>1, w]"
                 using \<rho>.T0.antipar(1) w by simp
               moreover have "inv (r \<star> \<a>[r\<^sub>0, p\<^sub>1, w]) = r \<star> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w]"
                 using \<rho>.T0.antipar(1) w by simp
               ultimately have "\<a>[r, r\<^sub>0 \<star> p\<^sub>1, w] \<cdot> (\<a>[r, r\<^sub>0, p\<^sub>1] \<star> w) =
                                  ((r \<star> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w]) \<cdot> \<a>[r, r\<^sub>0, p\<^sub>1 \<star> w]) \<cdot> \<a>[r \<star> r\<^sub>0, p\<^sub>1, w]"
                 using \<rho>.T0.antipar(1) w comp_assoc
                       invert_side_of_triangle(1)
                         [of "\<a>[r, r\<^sub>0, p\<^sub>1 \<star> w] \<cdot> \<a>[r \<star> r\<^sub>0, p\<^sub>1, w]" "r \<star> \<a>[r\<^sub>0, p\<^sub>1, w]"
                             "\<a>[r, r\<^sub>0 \<star> p\<^sub>1, w] \<cdot> (\<a>[r, r\<^sub>0, p\<^sub>1] \<star> w)"]
                 by simp
               hence "(r \<star> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w]) \<cdot> \<a>[r, r\<^sub>0, p\<^sub>1 \<star> w] =
                      (\<a>[r, r\<^sub>0 \<star> p\<^sub>1, w] \<cdot> (\<a>[r, r\<^sub>0, p\<^sub>1] \<star> w)) \<cdot> \<a>\<^sup>-\<^sup>1[r \<star> r\<^sub>0, p\<^sub>1, w]"
                 using \<rho>.T0.antipar(1) w
                       invert_side_of_triangle(2)
                         [of "\<a>[r, r\<^sub>0 \<star> p\<^sub>1, w] \<cdot> (\<a>[r, r\<^sub>0, p\<^sub>1] \<star> w)"
                             "(r \<star> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w]) \<cdot> \<a>[r, r\<^sub>0, p\<^sub>1 \<star> w]" "\<a>[r \<star> r\<^sub>0, p\<^sub>1, w]"]
                 using \<open>trg w = src p\<^sub>0\<close> by simp
               thus ?thesis
                 using comp_assoc by presburger
             qed
             thus ?thesis
               using comp_assoc by presburger
           qed
           also have "... = ((r \<star> s) \<star> \<theta>\<^sub>s \<cdot> (s\<^sub>0 \<star> \<theta>\<^sub>t)) \<cdot>
                              \<a>\<^sup>-\<^sup>1[r, s, s\<^sub>0 \<star> p\<^sub>0 \<star> w] \<cdot> (r \<star> \<a>[s, s\<^sub>0, p\<^sub>0 \<star> w]) \<cdot>
                              (r \<star> \<a>[s \<star> s\<^sub>0, p\<^sub>0, w]) \<cdot> (r \<star> (\<sigma> \<star> p\<^sub>0) \<star> w) \<cdot> ((r \<star> r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot>
                              \<a>[r, r\<^sub>0 \<star> p\<^sub>1, w]) \<cdot> (\<a>[r, r\<^sub>0, p\<^sub>1] \<star> w) \<cdot> ((\<rho> \<star> p\<^sub>1) \<star> w) \<cdot>
                              \<a>\<^sup>-\<^sup>1[r\<^sub>1, p\<^sub>1, w] \<cdot> (r\<^sub>1 \<star> \<nu>\<^sub>t) \<cdot> \<nu>\<^sub>r"
           proof -
             have "\<a>\<^sup>-\<^sup>1[r \<star> r\<^sub>0, p\<^sub>1, w] \<cdot> (\<rho> \<star> p\<^sub>1 \<star> w) = ((\<rho> \<star> p\<^sub>1) \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>1, p\<^sub>1, w]"
               using assoc'_naturality [of \<rho> p\<^sub>1 w] by (simp add: \<rho>.T0.antipar(1) w\<theta>\<^sub>t\<nu>\<^sub>t)
             thus ?thesis
               using comp_assoc by presburger
           qed
           also have "... = ((r \<star> s) \<star> \<theta>\<^sub>s \<cdot> (s\<^sub>0 \<star> \<theta>\<^sub>t)) \<cdot>
                              \<a>\<^sup>-\<^sup>1[r, s, s\<^sub>0 \<star> p\<^sub>0 \<star> w] \<cdot> (r \<star> \<a>[s, s\<^sub>0, p\<^sub>0 \<star> w]) \<cdot>
                              (r \<star> \<a>[s \<star> s\<^sub>0, p\<^sub>0, w]) \<cdot> ((r \<star> (\<sigma> \<star> p\<^sub>0) \<star> w) \<cdot> \<a>[r, s\<^sub>1 \<star> p\<^sub>0, w]) \<cdot>
                              ((r \<star> r\<^sub>0s\<^sub>1.\<phi>) \<star> w) \<cdot> (\<a>[r, r\<^sub>0, p\<^sub>1] \<star> w) \<cdot> ((\<rho> \<star> p\<^sub>1) \<star> w) \<cdot>
                              \<a>\<^sup>-\<^sup>1[r\<^sub>1, p\<^sub>1, w] \<cdot> (r\<^sub>1 \<star> \<nu>\<^sub>t) \<cdot> \<nu>\<^sub>r"
           proof -
             have "(r \<star> r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot> \<a>[r, r\<^sub>0 \<star> p\<^sub>1, w] = \<a>[r, s\<^sub>1 \<star> p\<^sub>0, w] \<cdot> ((r \<star> r\<^sub>0s\<^sub>1.\<phi>) \<star> w)"
               using assoc_naturality [of r r\<^sub>0s\<^sub>1.\<phi> w] r\<^sub>0s\<^sub>1.cospan w\<theta>\<^sub>t\<nu>\<^sub>t by auto
             thus ?thesis
               using comp_assoc by presburger
           qed
           also have "... = ((r \<star> s) \<star> \<theta>\<^sub>s \<cdot> (s\<^sub>0 \<star> \<theta>\<^sub>t)) \<cdot>
                              \<a>\<^sup>-\<^sup>1[r, s, s\<^sub>0 \<star> p\<^sub>0 \<star> w] \<cdot> (r \<star> \<a>[s, s\<^sub>0, p\<^sub>0 \<star> w]) \<cdot>
                              (r \<star> \<a>[s \<star> s\<^sub>0, p\<^sub>0, w]) \<cdot> \<a>[r, (s \<star> s\<^sub>0) \<star> p\<^sub>0, w] \<cdot>
                              (((r \<star> \<sigma> \<star> p\<^sub>0) \<star> w) \<cdot> ((r \<star> r\<^sub>0s\<^sub>1.\<phi>) \<star> w) \<cdot> (\<a>[r, r\<^sub>0, p\<^sub>1] \<star> w) \<cdot>
                                ((\<rho> \<star> p\<^sub>1) \<star> w)) \<cdot>
                              \<a>\<^sup>-\<^sup>1[r\<^sub>1, p\<^sub>1, w] \<cdot> (r\<^sub>1 \<star> \<nu>\<^sub>t) \<cdot> \<nu>\<^sub>r"
           proof -
             have "(r \<star> (\<sigma> \<star> p\<^sub>0) \<star> w) \<cdot> \<a>[r, s\<^sub>1 \<star> p\<^sub>0, w] =
                   \<a>[r, (s \<star> s\<^sub>0) \<star> p\<^sub>0, w] \<cdot> ((r \<star> \<sigma> \<star> p\<^sub>0) \<star> w)"
             proof -
               have "arr w \<and> dom w = w \<and> cod w = w"
                 using ide_char w by blast
               then show ?thesis
                 using assoc_naturality [of r "\<sigma> \<star> p\<^sub>0" w] composable by auto
             qed
             thus ?thesis
               using comp_assoc by presburger
           qed
           also have "... = ((r \<star> s) \<star> \<theta>\<^sub>s \<cdot> (s\<^sub>0 \<star> \<theta>\<^sub>t)) \<cdot>
                              (\<a>\<^sup>-\<^sup>1[r, s, s\<^sub>0 \<star> p\<^sub>0 \<star> w] \<cdot> (r \<star> \<a>[s, s\<^sub>0, p\<^sub>0 \<star> w]) \<cdot>
                              (r \<star> \<a>[s \<star> s\<^sub>0, p\<^sub>0, w]) \<cdot> \<a>[r, (s \<star> s\<^sub>0) \<star> p\<^sub>0, w] \<cdot>
                              ((r \<star> \<a>\<^sup>-\<^sup>1[s, s\<^sub>0, p\<^sub>0]) \<star> w) \<cdot> (\<a>[r, s, s\<^sub>0 \<star> p\<^sub>0] \<star> w)) \<cdot>
                              (tab \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>1, p\<^sub>1, w] \<cdot> (r\<^sub>1 \<star> \<nu>\<^sub>t) \<cdot> \<nu>\<^sub>r"
           proof -
             have "((r \<star> \<sigma> \<star> p\<^sub>0) \<star> w) \<cdot> ((r \<star> r\<^sub>0s\<^sub>1.\<phi>) \<star> w) \<cdot> (\<a>[r, r\<^sub>0, p\<^sub>1] \<star> w) \<cdot> ((\<rho> \<star> p\<^sub>1) \<star> w) =
                   (r \<star> \<sigma> \<star> p\<^sub>0) \<cdot> (r \<star> r\<^sub>0s\<^sub>1.\<phi>) \<cdot> \<a>[r, r\<^sub>0, p\<^sub>1] \<cdot> (\<rho> \<star> p\<^sub>1) \<star> w"
               using w \<rho>.T0.antipar(1) composable whisker_right by auto
             also have "... = (((r \<star> \<a>\<^sup>-\<^sup>1[s, s\<^sub>0, p\<^sub>0]) \<cdot> (\<a>[r, s, s\<^sub>0 \<star> p\<^sub>0] \<cdot>
                                \<a>\<^sup>-\<^sup>1[r, s, s\<^sub>0 \<star> p\<^sub>0]) \<cdot> (r \<star> \<a>[s, s\<^sub>0, p\<^sub>0])) \<cdot> (r \<star> \<sigma> \<star> p\<^sub>0)) \<cdot>
                                (r \<star> r\<^sub>0s\<^sub>1.\<phi>) \<cdot> \<a>[r, r\<^sub>0, p\<^sub>1] \<cdot> (\<rho> \<star> p\<^sub>1) \<star> w"
             proof -
               have "((r \<star> \<a>\<^sup>-\<^sup>1[s, s\<^sub>0, p\<^sub>0]) \<cdot> (\<a>[r, s, s\<^sub>0 \<star> p\<^sub>0] \<cdot> \<a>\<^sup>-\<^sup>1[r, s, s\<^sub>0 \<star> p\<^sub>0]) \<cdot> 
                       (r \<star> \<a>[s, s\<^sub>0, p\<^sub>0])) \<cdot> (r \<star> \<sigma> \<star> p\<^sub>0) =
                     r \<star> \<sigma> \<star> p\<^sub>0"
               proof -
                 have "((r \<star> \<a>\<^sup>-\<^sup>1[s, s\<^sub>0, p\<^sub>0]) \<cdot> (\<a>[r, s, s\<^sub>0 \<star> p\<^sub>0] \<cdot> \<a>\<^sup>-\<^sup>1[r, s, s\<^sub>0 \<star> p\<^sub>0]) \<cdot> 
                         (r \<star> \<a>[s, s\<^sub>0, p\<^sub>0])) \<cdot> (r \<star> \<sigma> \<star> p\<^sub>0) =
                       ((r \<star> \<a>\<^sup>-\<^sup>1[s, s\<^sub>0, p\<^sub>0]) \<cdot> ((r \<star> s \<star> s\<^sub>0 \<star> p\<^sub>0) \<cdot> (r \<star> \<a>[s, s\<^sub>0, p\<^sub>0]))) \<cdot> (r \<star> \<sigma> \<star> p\<^sub>0)"
                   using comp_assoc_assoc' by (simp add: composable)
                 also have "... = ((r \<star> \<a>\<^sup>-\<^sup>1[s, s\<^sub>0, p\<^sub>0]) \<cdot> (r \<star> \<a>[s, s\<^sub>0, p\<^sub>0])) \<cdot> (r \<star> \<sigma> \<star> p\<^sub>0)"
                   using comp_cod_arr by (simp add: composable)
                 also have "... = ((r \<star> (s \<star> s\<^sub>0) \<star> p\<^sub>0)) \<cdot> (r \<star> \<sigma> \<star> p\<^sub>0)"
                   using whisker_left comp_assoc_assoc' assoc_in_hom hseqI'
                   by (metis \<rho>.ide_base \<sigma>.base_simps(2) \<sigma>.ide_base \<sigma>.ide_leg0
                       \<sigma>.leg0_simps(2-3) \<sigma>.leg1_simps(3) r\<^sub>0s\<^sub>1.ide_leg0
                       r\<^sub>0s\<^sub>1.leg0_simps(2) r\<^sub>0s\<^sub>1.p\<^sub>0_simps hcomp_simps(1))
                 also have "... = r \<star> \<sigma> \<star> p\<^sub>0"
                   using comp_cod_arr
                   by (simp add: composable)
                 finally show ?thesis by blast
               qed
               thus ?thesis by simp
             qed
             also have "... = (r \<star> \<a>\<^sup>-\<^sup>1[s, s\<^sub>0, p\<^sub>0]) \<cdot> \<a>[r, s, s\<^sub>0 \<star> p\<^sub>0] \<cdot>
                                (\<a>\<^sup>-\<^sup>1[r, s, s\<^sub>0 \<star> p\<^sub>0]) \<cdot> (r \<star> \<a>[s, s\<^sub>0, p\<^sub>0]) \<cdot> (r \<star> \<sigma> \<star> p\<^sub>0) \<cdot>
                                (r \<star> r\<^sub>0s\<^sub>1.\<phi>) \<cdot> \<a>[r, r\<^sub>0, p\<^sub>1] \<cdot> (\<rho> \<star> p\<^sub>1) \<star> w"
               using comp_assoc by presburger
             also have "... = (r \<star> \<a>\<^sup>-\<^sup>1[s, s\<^sub>0, p\<^sub>0]) \<cdot> \<a>[r, s, s\<^sub>0 \<star> p\<^sub>0] \<cdot> tab \<star> w"
               using tab_def by simp
             also have "... = ((r \<star> \<a>\<^sup>-\<^sup>1[s, s\<^sub>0, p\<^sub>0]) \<star> w) \<cdot> (\<a>[r, s, s\<^sub>0 \<star> p\<^sub>0] \<star> w) \<cdot> (tab \<star> w)"
               using w \<rho>.T0.antipar(1) composable comp_assoc whisker_right by auto
             finally have "((r \<star> \<sigma> \<star> p\<^sub>0) \<star> w) \<cdot> ((r \<star> r\<^sub>0s\<^sub>1.\<phi>) \<star> w) \<cdot> (\<a>[r, r\<^sub>0, p\<^sub>1] \<star> w) \<cdot>
                             ((\<rho> \<star> p\<^sub>1) \<star> w) =
                           ((r \<star> \<a>\<^sup>-\<^sup>1[s, s\<^sub>0, p\<^sub>0]) \<star> w) \<cdot> (\<a>[r, s, s\<^sub>0 \<star> p\<^sub>0] \<star> w) \<cdot> (tab \<star> w)"
               by simp
             thus ?thesis
               using comp_assoc by presburger
           qed
           also have "... = (((r \<star> s) \<star> \<theta>\<^sub>s \<cdot> (s\<^sub>0 \<star> \<theta>\<^sub>t)) \<cdot> ((r \<star> s) \<star> \<a>[s\<^sub>0, p\<^sub>0, w])) \<cdot>
                              \<a>[r \<star> s, s\<^sub>0 \<star> p\<^sub>0, w] \<cdot> (tab \<star> w) \<cdot> \<nu>"
           proof -
             have "\<a>\<^sup>-\<^sup>1[r, s, s\<^sub>0 \<star> p\<^sub>0 \<star> w] \<cdot> (r \<star> \<a>[s, s\<^sub>0, p\<^sub>0 \<star> w]) \<cdot> (r \<star> \<a>[s \<star> s\<^sub>0, p\<^sub>0, w]) \<cdot>
                    \<a>[r, (s \<star> s\<^sub>0) \<star> p\<^sub>0, w] \<cdot> ((r \<star> \<a>\<^sup>-\<^sup>1[s, s\<^sub>0, p\<^sub>0]) \<star> w) \<cdot> (\<a>[r, s, s\<^sub>0 \<star> p\<^sub>0] \<star> w) =
                   ((r \<star> s) \<star> \<a>[s\<^sub>0, p\<^sub>0, w]) \<cdot> \<a>[r \<star> s, s\<^sub>0 \<star> p\<^sub>0, w]"
             proof -
               have "\<a>\<^sup>-\<^sup>1[r, s, s\<^sub>0 \<star> p\<^sub>0 \<star> w] \<cdot> (r \<star> \<a>[s, s\<^sub>0, p\<^sub>0 \<star> w]) \<cdot> (r \<star> \<a>[s \<star> s\<^sub>0, p\<^sub>0, w]) \<cdot>
                       \<a>[r, (s \<star> s\<^sub>0) \<star> p\<^sub>0, w] \<cdot> ((r \<star> \<a>\<^sup>-\<^sup>1[s, s\<^sub>0, p\<^sub>0]) \<star> w) \<cdot>
                       (\<a>[r, s, s\<^sub>0 \<star> p\<^sub>0] \<star> w) =
                     \<lbrace>\<^bold>\<a>\<^sup>-\<^sup>1\<^bold>[\<^bold>\<langle>r\<^bold>\<rangle>, \<^bold>\<langle>s\<^bold>\<rangle>, \<^bold>\<langle>s\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>w\<^bold>\<rangle>\<^bold>] \<^bold>\<cdot> (\<^bold>\<langle>r\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<a>\<^bold>[\<^bold>\<langle>s\<^bold>\<rangle>, \<^bold>\<langle>s\<^sub>0\<^bold>\<rangle>, \<^bold>\<langle>p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>w\<^bold>\<rangle>\<^bold>]) \<^bold>\<cdot>
                       (\<^bold>\<langle>r\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<a>\<^bold>[\<^bold>\<langle>s\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>s\<^sub>0\<^bold>\<rangle>, \<^bold>\<langle>p\<^sub>0\<^bold>\<rangle>, \<^bold>\<langle>w\<^bold>\<rangle>\<^bold>]) \<^bold>\<cdot> \<^bold>\<a>\<^bold>[\<^bold>\<langle>r\<^bold>\<rangle>, (\<^bold>\<langle>s\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>s\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>p\<^sub>0\<^bold>\<rangle>, \<^bold>\<langle>w\<^bold>\<rangle>\<^bold>] \<^bold>\<cdot>
                       ((\<^bold>\<langle>r\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<a>\<^sup>-\<^sup>1\<^bold>[\<^bold>\<langle>s\<^bold>\<rangle>, \<^bold>\<langle>s\<^sub>0\<^bold>\<rangle>, \<^bold>\<langle>p\<^sub>0\<^bold>\<rangle>\<^bold>]) \<^bold>\<star> \<^bold>\<langle>w\<^bold>\<rangle>) \<^bold>\<cdot> (\<^bold>\<a>\<^bold>[\<^bold>\<langle>r\<^bold>\<rangle>, \<^bold>\<langle>s\<^bold>\<rangle>, \<^bold>\<langle>s\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>p\<^sub>0\<^bold>\<rangle>\<^bold>] \<^bold>\<star> \<^bold>\<langle>w\<^bold>\<rangle>)\<rbrace>"
                 using w comp_assoc \<a>'_def \<alpha>_def composable by simp
               also have "... = \<lbrace>((\<^bold>\<langle>r\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>s\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<a>\<^bold>[\<^bold>\<langle>s\<^sub>0\<^bold>\<rangle>, \<^bold>\<langle>p\<^sub>0\<^bold>\<rangle>, \<^bold>\<langle>w\<^bold>\<rangle>\<^bold>]) \<^bold>\<cdot> \<^bold>\<a>\<^bold>[\<^bold>\<langle>r\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>s\<^bold>\<rangle>, \<^bold>\<langle>s\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>p\<^sub>0\<^bold>\<rangle>, \<^bold>\<langle>w\<^bold>\<rangle>\<^bold>]\<rbrace>"
                 using w composable
                 apply (intro E.eval_eqI) by simp_all
               also have "... = ((r \<star> s) \<star> \<a>[s\<^sub>0, p\<^sub>0, w]) \<cdot> \<a>[r \<star> s, s\<^sub>0 \<star> p\<^sub>0, w]"
                 using w comp_assoc \<a>'_def \<alpha>_def composable by simp
               finally show ?thesis by simp
             qed
             thus ?thesis
               using \<nu>_def comp_assoc by simp
           qed
           also have "... = ((r \<star> s) \<star> \<theta>) \<cdot> \<a>[r \<star> s, s\<^sub>0 \<star> p\<^sub>0, w] \<cdot> (tab \<star> w) \<cdot> \<nu>"
           proof -
             have "((r \<star> s) \<star> \<theta>\<^sub>s \<cdot> (s\<^sub>0 \<star> \<theta>\<^sub>t)) \<cdot> ((r \<star> s) \<star> \<a>[s\<^sub>0, p\<^sub>0, w]) = (r \<star> s) \<star> \<theta>"
               using \<theta>_def w whisker_left composable
               by (metis \<theta> arrI ide_base comp_assoc)
             thus ?thesis
               using comp_assoc by presburger
           qed
           finally show "((r \<star> s) \<star> \<theta>) \<cdot> \<a>[r \<star> s, s\<^sub>0 \<star> p\<^sub>0, w] \<cdot> (tab \<star> w) \<cdot> \<nu> = \<omega>"
             by simp
         qed
         thus "\<exists>w \<theta> \<nu>. ide w \<and> \<guillemotleft>\<theta> : (s\<^sub>0 \<star> p\<^sub>0) \<star> w \<Rightarrow> u\<guillemotright> \<and>
                       \<guillemotleft>\<nu> : dom \<omega> \<Rightarrow> (r\<^sub>1 \<star> p\<^sub>1) \<star> w\<guillemotright> \<and> iso \<nu> \<and>
                       composite_cell w \<theta> \<cdot> \<nu> = \<omega>"
           using w\<theta>\<^sub>t\<nu>\<^sub>t \<theta> \<nu> iso_\<nu> comp_assoc by metis
       qed
 
       show "\<And>u w w' \<theta> \<theta>' \<beta>.
               \<lbrakk> ide w; ide w'; \<guillemotleft>\<theta> : (s\<^sub>0 \<star> p\<^sub>0) \<star> w \<Rightarrow> u\<guillemotright>; \<guillemotleft>\<theta>' : (s\<^sub>0 \<star> p\<^sub>0) \<star> w' \<Rightarrow> u\<guillemotright>;
                 \<guillemotleft>\<beta> : (r\<^sub>1 \<star> p\<^sub>1) \<star> w \<Rightarrow> (r\<^sub>1 \<star> p\<^sub>1) \<star> w'\<guillemotright>;
                 composite_cell w \<theta> = composite_cell w' \<theta>' \<cdot> \<beta> \<rbrakk> \<Longrightarrow>
               \<exists>!\<gamma>. \<guillemotleft>\<gamma> : w \<Rightarrow> w'\<guillemotright> \<and> \<beta> = (r\<^sub>1 \<star> p\<^sub>1) \<star> \<gamma> \<and> \<theta> = \<theta>' \<cdot> ((s\<^sub>0 \<star> p\<^sub>0) \<star> \<gamma>)"
       proof -
         fix u w w' \<theta> \<theta>' \<beta>
         assume w: "ide w"
         assume w': "ide w'"
         assume \<theta>: "\<guillemotleft>\<theta> : (s\<^sub>0 \<star> p\<^sub>0) \<star> w \<Rightarrow> u\<guillemotright>"
         assume \<theta>': "\<guillemotleft>\<theta>' : (s\<^sub>0 \<star> p\<^sub>0) \<star> w' \<Rightarrow> u\<guillemotright>"
         assume \<beta>: "\<guillemotleft>\<beta> : (r\<^sub>1 \<star> p\<^sub>1) \<star> w \<Rightarrow> (r\<^sub>1 \<star> p\<^sub>1) \<star> w'\<guillemotright>"
         assume eq: "composite_cell w \<theta> = composite_cell w' \<theta>' \<cdot> \<beta>"
         interpret uw\<theta>w'\<theta>'\<beta>: uw\<theta>w'\<theta>'\<beta> V H \<a> \<i> src trg
                               \<open>r \<star> s\<close> tab \<open>s\<^sub>0 \<star> p\<^sub>0\<close> \<open>r\<^sub>1 \<star> p\<^sub>1\<close> u w \<theta> w' \<theta>' \<beta>
           using w w' \<theta> \<theta>' \<beta> eq composable tab_in_hom comp_assoc
           by unfold_locales auto
         text \<open>
 $$
 \begin{array}{ll}
 \xymatrix{
   && X \ar[d]_{w'} \xtwocell[ddl]{}\omit{^{\beta}}
   \ar@/ul20pt/[dddll]_<>(0.25){w}|<>(0.33)@ {>}_<>(0.5){p_1}|<>(0.67)@ {>}_<>(0.75){r_1}
   \ar@/ur20pt/[dddrr]^{u} \xtwocell[ddr]{}\omit{^{\theta'}}\\
   && {\rm src}~\phi \ar[dl]^{p_1} \ar[dr]_{p_0} \ddtwocell\omit{^\phi} \\  
   & {\rm src}~\rho \ar[dl]_{r_1} \ar[dr]^{r_0} \dtwocell\omit{^\rho}
   && {\rm src}~\sigma  \ar[dl]_{s_1} \ar[dr]^{s_0} \dtwocell\omit{^\sigma}\\
   {\rm trg}~r && {\rm src}~r = {\rm trg}~s \ar[ll]^{r} && {\rm src}~s \ar[ll]^{s}
 }
 \\
 \hspace{5cm}
 =
 \qquad
 \xy/50pt/
 \xymatrix{
   && X \ar[d]_{w} \ar@/ur20pt/[dddrr]^{u} \xtwocell[ddr]{}\omit{^{\theta}}\\
   && {\rm src}~\phi \ar[dl]^{p_1} \ar[dr]_{p_0} \ddtwocell\omit{^\phi} \\  
   & {\rm src}~\rho \ar[dl]_{r_1} \ar[dr]^{r_0} \dtwocell\omit{^\rho}
   && {\rm src}~\sigma  \ar[dl]_{s_1} \ar[dr]^{s_0} \dtwocell\omit{^\sigma}\\
   {\rm trg}~r && {\rm src}~r = {\rm trg}~s \ar[ll]^{r} && {\rm src}~s \ar[ll]^{s}
 }
 \endxy
 \end{array}
 $$
         \<close>
         text \<open>
           First apply property \<open>\<rho>.T2\<close> using \<open>\<guillemotleft>\<beta>\<^sub>r : r\<^sub>1 \<star> p\<^sub>1 \<star> w \<Rightarrow> r\<^sub>1 \<star> p\<^sub>1 \<star> w'\<guillemotright>\<close>
           (obtained by composing \<open>\<beta>\<close> with associativities) and ``everything to the right'' 
           as \<open>\<theta>\<^sub>r\<close> and \<open>\<theta>\<^sub>r'\<close>.  This yields \<open>\<guillemotleft>\<gamma>\<^sub>r : p\<^sub>1 \<star> w \<Rightarrow> p\<^sub>1 \<star> w'\<guillemotright>\<close>.
           Next, apply property \<open>\<rho>.T2\<close> to obtain \<open>\<guillemotleft>\<gamma>\<^sub>s : p\<^sub>0 \<star> w \<Rightarrow> p\<^sub>0 \<star> w'\<guillemotright>\<close>.
           For this use \<open>\<guillemotleft>\<theta>\<^sub>s : s\<^sub>0 \<star> p\<^sub>0 \<star> w \<Rightarrow> u\<guillemotright>\<close> and \<open>\<guillemotleft>\<theta>\<^sub>s' : s\<^sub>0 \<star> p\<^sub>0 \<star> w'\<guillemotright>\<close>
           obtained by composing \<open>\<theta>\<close> and \<open>\<theta>'\<close> with associativities.
           We also need \<open>\<guillemotleft>\<beta>\<^sub>s : s\<^sub>1 \<star> p\<^sub>0 \<star> w \<Rightarrow> s\<^sub>1 \<star> p\<^sub>0 \<star> w'\<guillemotright>\<close>.
           To get this, transport \<open>r\<^sub>0 \<star> \<gamma>\<^sub>r\<close> across \<open>\<phi>\<close>; we need \<open>\<phi>\<close> to be an isomorphism
           in order to do this.
           Finally, apply the biuniversal property of \<open>\<phi>\<close> to get \<open>\<guillemotleft>\<gamma> : w \<Rightarrow> w'\<guillemotright>\<close>
           and verify the required equation.
         \<close>
         let ?w\<^sub>r = "p\<^sub>1 \<star> w"
         have w\<^sub>r: "ide ?w\<^sub>r" by simp
         let ?w\<^sub>r' = "p\<^sub>1 \<star> w'"
         have w\<^sub>r': "ide ?w\<^sub>r'" by simp
         define \<theta>\<^sub>r where "\<theta>\<^sub>r = (s \<star> \<theta>) \<cdot> (s \<star> \<a>\<^sup>-\<^sup>1[s\<^sub>0, p\<^sub>0, w]) \<cdot> \<a>[s, s\<^sub>0, p\<^sub>0 \<star> w] \<cdot>
                                 (\<sigma> \<star> p\<^sub>0 \<star> w) \<cdot> \<a>[s\<^sub>1, p\<^sub>0, w] \<cdot> (r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w]"
         have \<theta>\<^sub>r: "\<guillemotleft>\<theta>\<^sub>r : r\<^sub>0 \<star> ?w\<^sub>r \<Rightarrow> s \<star> u\<guillemotright>"
           unfolding \<theta>\<^sub>r_def
           using \<rho>.T0.antipar(1) by fastforce
         define \<theta>\<^sub>r' where "\<theta>\<^sub>r' = (s \<star> \<theta>') \<cdot> (s \<star> \<a>\<^sup>-\<^sup>1[s\<^sub>0, p\<^sub>0, w']) \<cdot> \<a>[s, s\<^sub>0, p\<^sub>0 \<star> w'] \<cdot>
                                   (\<sigma> \<star> p\<^sub>0 \<star> w') \<cdot> \<a>[s\<^sub>1, p\<^sub>0, w'] \<cdot> (r\<^sub>0s\<^sub>1.\<phi> \<star> w') \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w']"
         have \<theta>\<^sub>r': "\<guillemotleft>\<theta>\<^sub>r' : r\<^sub>0 \<star> ?w\<^sub>r' \<Rightarrow> s \<star> u\<guillemotright>"
           unfolding \<theta>\<^sub>r'_def
           using \<rho>.T0.antipar(1) by fastforce
         define \<beta>\<^sub>r where "\<beta>\<^sub>r = \<a>[r\<^sub>1, p\<^sub>1, w'] \<cdot> \<beta> \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>1, p\<^sub>1, w]"
         have \<beta>\<^sub>r: "\<guillemotleft>\<beta>\<^sub>r : r\<^sub>1 \<star> ?w\<^sub>r \<Rightarrow> r\<^sub>1 \<star> ?w\<^sub>r'\<guillemotright>"
           unfolding \<beta>\<^sub>r_def
           using \<rho>.T0.antipar(1) by force
         have eq\<^sub>r: "\<rho>.composite_cell ?w\<^sub>r \<theta>\<^sub>r = \<rho>.composite_cell ?w\<^sub>r' \<theta>\<^sub>r' \<cdot> \<beta>\<^sub>r"
         text \<open>
 $$
 \begin{array}{ll}
 \xymatrix{
   && X \ar[ddl]^{w_r'} \xtwocell[dddll]{}\omit{^<2>{\beta_r}}
   \ar@/ul20pt/[dddll]_<>(0.33){w_r}|<>(0.67)@ {>}_<>(0.75){r_1}
   \ar@/ur20pt/[dddrr]^{u} \xtwocell[dddr]{}\omit{^{\theta_r'}}\\
   && \\  
   & {\rm src}~\rho \ar[dl]_{r_1} \ar[dr]^{r_0} \dtwocell\omit{^\rho}
   && \\
   {\rm trg}~r && {\rm src}~r = {\rm trg}~s \ar[ll]^{r} && {\rm src}~s \ar[ll]^{s}
 }
 \\
 \hspace{5cm}
 =\qquad
 \xy/50pt/
 \xymatrix{
   && X \ar[ddl]^{w_r} \ar@/ur20pt/[dddrr]^{u} \xtwocell[dddr]{}\omit{^{\theta_r}}\\
   && \\  
   & {\rm src}~\rho \ar[dl]_{r_1} \ar[dr]^{r_0} \dtwocell\omit{^\rho}
   && \\
   {\rm trg}~r && {\rm src}~r = {\rm trg}~s \ar[ll]^{r} && {\rm src}~s \ar[ll]^{s}
 }
 \endxy
 \end{array}
 $$
         \<close>
         proof -
           have "\<rho>.composite_cell ?w\<^sub>r \<theta>\<^sub>r = \<a>[r, s, u] \<cdot> composite_cell w \<theta> \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>1, p\<^sub>1, w]"
             using \<theta>\<^sub>r_def technical uw\<theta>w'\<theta>'\<beta>.uw\<theta>.uw\<theta> by blast
           also have "... = \<a>[r, s, u] \<cdot> (((r \<star> s) \<star> \<theta>') \<cdot> \<a>[r \<star> s, s\<^sub>0 \<star> p\<^sub>0, w'] \<cdot>
                              (tab \<star> w') \<cdot> \<beta>) \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>1, p\<^sub>1, w]"
             using eq comp_assoc by simp
           also have "... = (r \<star> \<theta>\<^sub>r') \<cdot> \<a>[r, r\<^sub>0, ?w\<^sub>r'] \<cdot> (\<rho> \<star> ?w\<^sub>r') \<cdot> \<beta>\<^sub>r"
           proof -
             have "\<a>[r, s, u] \<cdot> (composite_cell w' \<theta>' \<cdot> \<beta>) \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>1, p\<^sub>1, w] =
                   \<a>[r, s, u] \<cdot> composite_cell w' \<theta>' \<cdot> \<beta> \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>1, p\<^sub>1, w]"
               using comp_assoc by presburger
             also have "... = (r \<star> (s \<star> \<theta>') \<cdot> (s \<star> \<a>\<^sup>-\<^sup>1[s\<^sub>0, p\<^sub>0, w']) \<cdot> \<a>[s, s\<^sub>0, p\<^sub>0 \<star> w'] \<cdot>
                                     (\<sigma> \<star> p\<^sub>0 \<star> w') \<cdot> \<a>[s\<^sub>1, p\<^sub>0, w'] \<cdot> (r\<^sub>0s\<^sub>1.\<phi> \<star> w') \<cdot>
                                     \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w']) \<cdot>
                                 \<a>[r, r\<^sub>0, p\<^sub>1 \<star> w'] \<cdot> (\<rho> \<star> p\<^sub>1 \<star> w') \<cdot> \<a>[r\<^sub>1, p\<^sub>1, w'] \<cdot> \<beta> \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>1, p\<^sub>1, w]"
             proof -
               have "\<a>[r, s, u] \<cdot> composite_cell w' \<theta>' \<cdot> \<beta> \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>1, p\<^sub>1, w] =
                     \<a>[r, s, u] \<cdot> composite_cell w' \<theta>' \<cdot>
                       ((\<a>\<^sup>-\<^sup>1[r\<^sub>1, p\<^sub>1, w'] \<cdot> \<a>[r\<^sub>1, p\<^sub>1, w']) \<cdot> \<beta>) \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>1, p\<^sub>1, w]"
               proof -
                 have "(\<a>\<^sup>-\<^sup>1[r\<^sub>1, p\<^sub>1, w'] \<cdot> \<a>[r\<^sub>1, p\<^sub>1, w']) \<cdot> \<beta> = \<beta>"
                   using comp_cod_arr \<rho>.T0.antipar(1) \<beta> comp_assoc_assoc' by simp
                 thus ?thesis by argo
               qed
               also have "... = (\<a>[r, s, u] \<cdot> ((r \<star> s) \<star> \<theta>') \<cdot> \<a>[r \<star> s, s\<^sub>0 \<star> p\<^sub>0, w'] \<cdot> (tab \<star> w') \<cdot>
                                  \<a>\<^sup>-\<^sup>1[r\<^sub>1, p\<^sub>1, w']) \<cdot> \<a>[r\<^sub>1, p\<^sub>1, w'] \<cdot> \<beta> \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>1, p\<^sub>1, w]"
                 using comp_assoc by presburger
               also have "... = ((r \<star> (s \<star> \<theta>') \<cdot> (s \<star> \<a>\<^sup>-\<^sup>1[s\<^sub>0, p\<^sub>0, w']) \<cdot> \<a>[s, s\<^sub>0, p\<^sub>0 \<star> w'] \<cdot>
                                  (\<sigma> \<star> p\<^sub>0 \<star> w') \<cdot> \<a>[s\<^sub>1, p\<^sub>0, w'] \<cdot> (r\<^sub>0s\<^sub>1.\<phi> \<star> w') \<cdot>
                                  \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w']) \<cdot> \<a>[r, r\<^sub>0, p\<^sub>1 \<star> w'] \<cdot> (\<rho> \<star> p\<^sub>1 \<star> w')) \<cdot>
                                  \<a>[r\<^sub>1, p\<^sub>1, w'] \<cdot> \<beta> \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>1, p\<^sub>1, w]"
                 using \<theta>\<^sub>r'_def technical [of w' \<theta>' u ?w\<^sub>r' \<theta>\<^sub>r'] comp_assoc by fastforce
               finally show ?thesis
                 using comp_assoc by simp
             qed
             finally show ?thesis
               using \<theta>\<^sub>r'_def \<beta>\<^sub>r_def comp_assoc by auto
           qed
           finally show ?thesis
             using comp_assoc by presburger
         qed
         have 1: "\<exists>!\<gamma>. \<guillemotleft>\<gamma> : ?w\<^sub>r \<Rightarrow> ?w\<^sub>r'\<guillemotright> \<and> \<theta>\<^sub>r = \<theta>\<^sub>r' \<cdot> (r\<^sub>0 \<star> \<gamma>) \<and> \<beta>\<^sub>r = r\<^sub>1 \<star> \<gamma>"
           using eq\<^sub>r \<rho>.T2 [of ?w\<^sub>r ?w\<^sub>r' \<theta>\<^sub>r "s \<star> u" \<theta>\<^sub>r' \<beta>\<^sub>r] w\<^sub>r w\<^sub>r' \<theta>\<^sub>r \<theta>\<^sub>r' \<beta>\<^sub>r by blast
         obtain \<gamma>\<^sub>r where \<gamma>\<^sub>r: "\<guillemotleft>\<gamma>\<^sub>r : ?w\<^sub>r \<Rightarrow> ?w\<^sub>r'\<guillemotright> \<and> \<theta>\<^sub>r = \<theta>\<^sub>r' \<cdot> (r\<^sub>0 \<star> \<gamma>\<^sub>r) \<and> \<beta>\<^sub>r = r\<^sub>1 \<star> \<gamma>\<^sub>r"
           using 1 by blast
 
         let ?w\<^sub>s = "p\<^sub>0 \<star> w"
         have w\<^sub>s: "ide ?w\<^sub>s" by simp
         let ?w\<^sub>s' = "p\<^sub>0 \<star> w'"
         have w\<^sub>s': "ide ?w\<^sub>s'" by simp
         define \<theta>\<^sub>s where "\<theta>\<^sub>s = \<theta> \<cdot> \<a>\<^sup>-\<^sup>1[s\<^sub>0, p\<^sub>0, w]"
         have \<theta>\<^sub>s: "\<guillemotleft>\<theta>\<^sub>s : s\<^sub>0 \<star> p\<^sub>0 \<star> w \<Rightarrow> u\<guillemotright>"
           using \<theta>\<^sub>s_def by auto
         define \<theta>\<^sub>s' where "\<theta>\<^sub>s' = \<theta>' \<cdot> \<a>\<^sup>-\<^sup>1[s\<^sub>0, p\<^sub>0, w']"
         have \<theta>\<^sub>s': "\<guillemotleft>\<theta>\<^sub>s' : s\<^sub>0 \<star> p\<^sub>0 \<star> w' \<Rightarrow> u\<guillemotright>"
           using \<theta>\<^sub>s'_def by auto
         define \<beta>\<^sub>s where "\<beta>\<^sub>s = \<a>[s\<^sub>1, p\<^sub>0, w'] \<cdot> (r\<^sub>0s\<^sub>1.\<phi> \<star> w') \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w'] \<cdot> (r\<^sub>0 \<star> \<gamma>\<^sub>r) \<cdot>
                                 \<a>[r\<^sub>0, p\<^sub>1, w] \<cdot> (inv r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[s\<^sub>1, p\<^sub>0, w]"
         have \<beta>\<^sub>s: "\<guillemotleft>\<beta>\<^sub>s : s\<^sub>1 \<star> ?w\<^sub>s \<Rightarrow> s\<^sub>1 \<star> ?w\<^sub>s'\<guillemotright>"
           unfolding \<beta>\<^sub>s_def
           using \<gamma>\<^sub>r r\<^sub>0s\<^sub>1.\<phi>_in_hom(2) r\<^sub>0s\<^sub>1.\<phi>_uniqueness(2) \<rho>.T0.antipar(1)
           apply (intro comp_in_homI)
                 apply auto
           by auto
         have eq\<^sub>s: "\<sigma>.composite_cell (p\<^sub>0 \<star> w) (\<theta> \<cdot> \<a>\<^sup>-\<^sup>1[s\<^sub>0, p\<^sub>0, w]) =
                    \<sigma>.composite_cell (p\<^sub>0 \<star> w') (\<theta>' \<cdot> \<a>\<^sup>-\<^sup>1[s\<^sub>0, p\<^sub>0, w']) \<cdot> \<beta>\<^sub>s"
         text \<open>
 $$
 \begin{array}{ll}
 \xy/67pt/
 \xymatrix{
   && X \ar[d]^{w'} \ar@/l10pt/[dl]_{w} \ddltwocell\omit{^{\gamma_r}}
   \ar@/ur20pt/[dddrr]^{u} \xtwocell[ddr]{}\omit{^{\theta_s'}}\\
   & {\rm src}~\phi \ar[dr]_{p_1} \ar[d]_{p_0}
   & {\rm src}~\phi \ar[d]^{p_1} \ar[dr]_{p_0} \ddrtwocell\omit{^\phi} \xtwocell[ddl]{}\omit{^\;\;\;\;\phi^{-1}} \\  
   & {\rm src}~\sigma \ar[dr]_{s_1} & {\rm src}~\rho \ar[d]^{r_0}
   & {\rm src}~\sigma \ar[dl]_{s_1} \ar[dr]^{s_0} \dtwocell\omit{^\sigma}\\
   && {\rm src}~r = {\rm trg}~s && {\rm src}~s \ar[ll]^{s}
 }
 \endxy
 \\
 \hspace{5cm}=
 \xy/50pt/
 \xymatrix{
   & X \ar@/dl15pt/[ddr]_<>(0.5){w_s}
   \ar@/ur20pt/[dddrr]^{u} \xtwocell[ddr]{}\omit{^{\theta_s}}\\
   & \\  
   && {\rm src}~\sigma  \ar[dl]_{s_1} \ar[dr]^{s_0} \dtwocell\omit{^\sigma}\\
   & {\rm src}~r = {\rm trg}~s && {\rm src}~s \ar[ll]^{s}
 }
 \endxy
 \end{array}
 $$
         \<close>
         proof -
           have "\<sigma>.composite_cell (p\<^sub>0 \<star> w') (\<theta>' \<cdot> \<a>\<^sup>-\<^sup>1[s\<^sub>0, p\<^sub>0, w']) \<cdot> \<beta>\<^sub>s =
                 (\<theta>\<^sub>r' \<cdot> (r\<^sub>0 \<star> \<gamma>\<^sub>r)) \<cdot> \<a>[r\<^sub>0, p\<^sub>1, w] \<cdot> (inv r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[s\<^sub>1, p\<^sub>0, w]"
             using \<beta>\<^sub>s_def \<theta>\<^sub>r'_def whisker_left comp_assoc by simp
           also have "... = \<theta>\<^sub>r \<cdot> \<a>[r\<^sub>0, p\<^sub>1, w] \<cdot> (inv r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[s\<^sub>1, p\<^sub>0, w]"
             using \<gamma>\<^sub>r by simp
           also have "... = ((s \<star> \<theta>) \<cdot> (s \<star> \<a>\<^sup>-\<^sup>1[s\<^sub>0, p\<^sub>0, w])) \<cdot> \<a>[s, s\<^sub>0, ?w\<^sub>s] \<cdot> (\<sigma> \<star> ?w\<^sub>s) \<cdot>
                               \<a>[s\<^sub>1, p\<^sub>0, w] \<cdot> ((r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot> (\<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w] \<cdot>
                               \<a>[r\<^sub>0, p\<^sub>1, w]) \<cdot> (inv r\<^sub>0s\<^sub>1.\<phi> \<star> w)) \<cdot> \<a>\<^sup>-\<^sup>1[s\<^sub>1, p\<^sub>0, w]"
             using \<theta>\<^sub>r_def comp_assoc by simp
           also have "... = (s \<star> \<theta>) \<cdot> \<sigma>.composite_cell (p\<^sub>0 \<star> w) \<a>\<^sup>-\<^sup>1[s\<^sub>0, p\<^sub>0, w]"
           proof -
             have "(\<sigma> \<star> p\<^sub>0 \<star> w) \<cdot>
                     \<a>[s\<^sub>1, p\<^sub>0, w] \<cdot> ((r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot> (\<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w] \<cdot>
                     \<a>[r\<^sub>0, p\<^sub>1, w]) \<cdot> (inv r\<^sub>0s\<^sub>1.\<phi> \<star> w)) \<cdot> \<a>\<^sup>-\<^sup>1[s\<^sub>1, p\<^sub>0, w] =
                   \<sigma> \<star> p\<^sub>0 \<star> w"
             proof -
               have "\<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w] \<cdot> \<a>[r\<^sub>0, p\<^sub>1, w] = cod (inv r\<^sub>0s\<^sub>1.\<phi> \<star> w)"
                 using r\<^sub>0s\<^sub>1.\<phi>_uniqueness(2) \<rho>.T0.antipar(1) comp_assoc_assoc' by simp
               text \<open>Here the fact that \<open>\<phi>\<close> is a retraction is used.\<close>
               moreover have "(r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot> (inv r\<^sub>0s\<^sub>1.\<phi> \<star> w) = cod \<a>\<^sup>-\<^sup>1[s\<^sub>1, p\<^sub>0, w]"
                 using r\<^sub>0s\<^sub>1.\<phi>_uniqueness(2) comp_arr_inv' whisker_right [of w r\<^sub>0s\<^sub>1.\<phi> "inv r\<^sub>0s\<^sub>1.\<phi>"]
                 by simp
               moreover have "\<a>[s\<^sub>1, p\<^sub>0, w] \<cdot> \<a>\<^sup>-\<^sup>1[s\<^sub>1, p\<^sub>0, w] = dom (\<sigma> \<star> p\<^sub>0 \<star> w)"
                 using r\<^sub>0s\<^sub>1.base_simps(2) hseq_char comp_assoc_assoc' by auto
               moreover have "hseq (inv r\<^sub>0s\<^sub>1.\<phi>) w"
                 using r\<^sub>0s\<^sub>1.\<phi>_uniqueness(2)
                 by (intro hseqI, auto)
               moreover have "hseq \<sigma> (p\<^sub>0 \<star> w)"
                 by (intro hseqI, auto)
               ultimately show ?thesis
                 using comp_arr_dom comp_cod_arr by simp
             qed
             thus ?thesis
               using comp_assoc by simp
           qed
           also have "... = \<sigma>.composite_cell (p\<^sub>0 \<star> w) (\<theta> \<cdot> \<a>\<^sup>-\<^sup>1[s\<^sub>0, p\<^sub>0, w])"
             using \<theta>\<^sub>s_def whisker_left
             by (metis \<sigma>.ide_base \<theta>\<^sub>s arrI comp_assoc)
           finally show ?thesis by simp
         qed
         hence 2: "\<exists>!\<gamma>. \<guillemotleft>\<gamma> : ?w\<^sub>s \<Rightarrow> ?w\<^sub>s'\<guillemotright> \<and> \<theta>\<^sub>s = \<theta>\<^sub>s' \<cdot> (s\<^sub>0 \<star> \<gamma>) \<and> \<beta>\<^sub>s = s\<^sub>1 \<star> \<gamma>"
           using \<sigma>.T2 [of ?w\<^sub>s ?w\<^sub>s' \<theta>\<^sub>s u \<theta>\<^sub>s' \<beta>\<^sub>s] w\<^sub>s w\<^sub>s' \<theta>\<^sub>s \<theta>\<^sub>s' \<beta>\<^sub>s
           by (metis \<theta>\<^sub>s'_def \<theta>\<^sub>s_def)
         obtain \<gamma>\<^sub>s where \<gamma>\<^sub>s: "\<guillemotleft>\<gamma>\<^sub>s : ?w\<^sub>s \<Rightarrow> ?w\<^sub>s'\<guillemotright> \<and> \<theta>\<^sub>s = \<theta>\<^sub>s' \<cdot> (s\<^sub>0 \<star> \<gamma>\<^sub>s) \<and> \<beta>\<^sub>s = s\<^sub>1 \<star> \<gamma>\<^sub>s"
           using 2 by blast
 
         have eq\<^sub>t: "(s\<^sub>1 \<star> \<gamma>\<^sub>s) \<cdot> \<a>[s\<^sub>1, p\<^sub>0, w] \<cdot> (r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w] =
                    (s\<^sub>1 \<star> ?w\<^sub>s') \<cdot> \<a>[s\<^sub>1, p\<^sub>0, w'] \<cdot> (r\<^sub>0s\<^sub>1.\<phi> \<star> w') \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w'] \<cdot> (r\<^sub>0 \<star> \<gamma>\<^sub>r)"
         text \<open>
 $$
 \xy/78pt/
 \xymatrix{
   & X \ar[d]^{w'} \ar@/ul15pt/[ddl]_{w_r} \xtwocell[ddl]{}\omit{^{\gamma_r}} \\
   & {\rm src}~\phi \ar[dl]_{p_1} \ar[dr]^{p_0} \ddtwocell\omit{^\phi} \\  
   {\rm src}~\rho \ar[dr]^{r_0}
   && {\rm src}~\sigma \ar[dl]_{s_1} \\
   & {\rm src}~r = {\rm trg}~s &
 }
 \endxy
 \qquad = \qquad
 \xy/78pt/
 \xymatrix{
   & X \ar[d]^{w} \ar@/ur15pt/[ddr]^{w_s'} \xtwocell[ddr]{}\omit{^{\gamma_s}} \\
   & {\rm src}~\phi \ar[dl]_{p_1} \ar[dr]^{p_0} \ddtwocell\omit{^\phi}  \\  
   {\rm src}~\rho \ar[dr]^{r_0}
   && {\rm src}~\sigma \ar[dl]_{s_1} \\
   & {\rm src}~r = {\rm trg}~s &
 }
 \endxy
 $$
         \<close>
         proof -
           have "(s\<^sub>1 \<star> ?w\<^sub>s') \<cdot> \<a>[s\<^sub>1, p\<^sub>0, w'] \<cdot> (r\<^sub>0s\<^sub>1.\<phi> \<star> w') \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w'] \<cdot> (r\<^sub>0 \<star> \<gamma>\<^sub>r) =
                 \<beta>\<^sub>s \<cdot> \<a>[s\<^sub>1, p\<^sub>0, w] \<cdot> (r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w]"
           proof -
             have "\<beta>\<^sub>s \<cdot> \<a>[s\<^sub>1, p\<^sub>0, w] \<cdot> (r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w] =
                   (\<a>[s\<^sub>1, p\<^sub>0, w'] \<cdot> (r\<^sub>0s\<^sub>1.\<phi> \<star> w') \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w']) \<cdot> (r\<^sub>0 \<star> \<gamma>\<^sub>r) \<cdot>
                     \<a>[r\<^sub>0, p\<^sub>1, w] \<cdot> ((inv r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot> (\<a>\<^sup>-\<^sup>1[s\<^sub>1, p\<^sub>0, w] \<cdot>
                     \<a>[s\<^sub>1, p\<^sub>0, w]) \<cdot> (r\<^sub>0s\<^sub>1.\<phi> \<star> w)) \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w]"
               using \<beta>\<^sub>s_def comp_assoc by metis
             also have "... = (\<a>[s\<^sub>1, p\<^sub>0, w'] \<cdot> (r\<^sub>0s\<^sub>1.\<phi> \<star> w') \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w']) \<cdot> (r\<^sub>0 \<star> \<gamma>\<^sub>r)"
             proof -
               have "(r\<^sub>0 \<star> \<gamma>\<^sub>r) \<cdot> \<a>[r\<^sub>0, p\<^sub>1, w] \<cdot> ((inv r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot> (\<a>\<^sup>-\<^sup>1[s\<^sub>1, p\<^sub>0, w] \<cdot>
                       \<a>[s\<^sub>1, p\<^sub>0, w]) \<cdot> (r\<^sub>0s\<^sub>1.\<phi> \<star> w)) \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w] =
                     r\<^sub>0 \<star> \<gamma>\<^sub>r"
               proof -
                 have "(r\<^sub>0 \<star> \<gamma>\<^sub>r) \<cdot> \<a>[r\<^sub>0, p\<^sub>1, w] \<cdot> ((inv r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot> (\<a>\<^sup>-\<^sup>1[s\<^sub>1, p\<^sub>0, w] \<cdot>
                        \<a>[s\<^sub>1, p\<^sub>0, w]) \<cdot> (r\<^sub>0s\<^sub>1.\<phi> \<star> w)) \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w] =
                       (r\<^sub>0 \<star> \<gamma>\<^sub>r) \<cdot> \<a>[r\<^sub>0, p\<^sub>1, w] \<cdot> ((inv r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot> (r\<^sub>0s\<^sub>1.\<phi> \<star> w)) \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w]"
                   using r\<^sub>0s\<^sub>1.\<phi>_uniqueness(2) comp_assoc_assoc' comp_cod_arr by simp
                   (* Used here that \<phi> is a section. *)
                 also have "... = (r\<^sub>0 \<star> \<gamma>\<^sub>r) \<cdot> \<a>[r\<^sub>0, p\<^sub>1, w] \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w]"
                   using r\<^sub>0s\<^sub>1.\<phi>_uniqueness(2) comp_inv_arr' \<rho>.T0.antipar(1)
                         whisker_right [of w "inv r\<^sub>0s\<^sub>1.\<phi>" r\<^sub>0s\<^sub>1.\<phi>] comp_cod_arr
                   by simp
                 also have "... = r\<^sub>0 \<star> \<gamma>\<^sub>r"
                 proof -
                   have "hseq r\<^sub>0 \<gamma>\<^sub>r"
                     using \<beta>\<^sub>s \<beta>\<^sub>s_def by blast
                   thus ?thesis
                     using comp_assoc_assoc' comp_arr_dom
                       by (metis (no_types) \<gamma>\<^sub>r \<rho>.ide_leg0 comp_assoc_assoc'(1) hcomp_simps(3)
                           hseq_char ide_char in_homE r\<^sub>0s\<^sub>1.ide_leg1 r\<^sub>0s\<^sub>1.p\<^sub>1_simps w w\<^sub>r)
                 qed
                 finally show ?thesis by blast
               qed
               thus ?thesis by simp
             qed
             also have "... = \<a>[s\<^sub>1, p\<^sub>0, w'] \<cdot> (r\<^sub>0s\<^sub>1.\<phi> \<star> w') \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w'] \<cdot> (r\<^sub>0 \<star> \<gamma>\<^sub>r)"
               using comp_assoc by presburger
             also have "... = (s\<^sub>1 \<star> ?w\<^sub>s') \<cdot>
                                \<a>[s\<^sub>1, p\<^sub>0, w'] \<cdot> (r\<^sub>0s\<^sub>1.\<phi> \<star> w') \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w'] \<cdot> (r\<^sub>0 \<star> \<gamma>\<^sub>r)"
             proof -
               have "(s\<^sub>1 \<star> ?w\<^sub>s') \<cdot> \<a>[s\<^sub>1, p\<^sub>0, w'] = \<a>[s\<^sub>1, p\<^sub>0, w']"
                 using comp_cod_arr by simp
               thus ?thesis
                 using comp_assoc by metis
             qed
             finally show ?thesis by simp
           qed
           also have "... = (s\<^sub>1 \<star> \<gamma>\<^sub>s) \<cdot> \<a>[s\<^sub>1, p\<^sub>0, w] \<cdot> (r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w]"
             using \<gamma>\<^sub>s by simp
           finally show ?thesis by simp
         qed
         have 3: "\<exists>!\<gamma>. \<guillemotleft>\<gamma> : w \<Rightarrow> w'\<guillemotright> \<and> \<gamma>\<^sub>s = (p\<^sub>0 \<star> w') \<cdot> (p\<^sub>0 \<star> \<gamma>) \<and> p\<^sub>1 \<star> \<gamma> = \<gamma>\<^sub>r"
           using w w' w\<^sub>s' w\<^sub>r \<gamma>\<^sub>r \<gamma>\<^sub>s eq\<^sub>t
                 r\<^sub>0s\<^sub>1.\<phi>_biuniversal_prop(2) [of ?w\<^sub>s' ?w\<^sub>r w w' \<gamma>\<^sub>s "p\<^sub>0 \<star> w'" \<gamma>\<^sub>r]
           by blast
         obtain \<gamma> where \<gamma>: "\<guillemotleft>\<gamma> : w \<Rightarrow> w'\<guillemotright> \<and> \<gamma>\<^sub>s = (p\<^sub>0 \<star> w') \<cdot> (p\<^sub>0 \<star> \<gamma>) \<and> p\<^sub>1 \<star> \<gamma> = \<gamma>\<^sub>r"
           using 3 by blast
 
         show "\<exists>!\<gamma>. \<guillemotleft>\<gamma> : w \<Rightarrow> w'\<guillemotright> \<and> \<beta> = (r\<^sub>1 \<star> p\<^sub>1) \<star> \<gamma> \<and> \<theta> = \<theta>' \<cdot> ((s\<^sub>0 \<star> p\<^sub>0) \<star> \<gamma>)"
         proof -
           have "\<exists>\<gamma>. \<guillemotleft>\<gamma> : w \<Rightarrow> w'\<guillemotright> \<and> \<beta> = (r\<^sub>1 \<star> p\<^sub>1) \<star> \<gamma> \<and> \<theta> = \<theta>' \<cdot> ((s\<^sub>0 \<star> p\<^sub>0) \<star> \<gamma>)"
           proof -
             have "\<theta> = \<theta>' \<cdot> ((s\<^sub>0 \<star> p\<^sub>0) \<star> \<gamma>)"
             proof -
               have "\<theta>' \<cdot> ((s\<^sub>0 \<star> p\<^sub>0) \<star> \<gamma>) = (\<theta>\<^sub>s' \<cdot> \<a>[s\<^sub>0, p\<^sub>0, w']) \<cdot> ((s\<^sub>0 \<star> p\<^sub>0) \<star> \<gamma>)"
                 using \<theta>\<^sub>s'_def comp_arr_dom comp_assoc comp_assoc_assoc'(2) by auto
               also have "... = (\<theta>\<^sub>s' \<cdot> (s\<^sub>0 \<star> p\<^sub>0 \<star> \<gamma>)) \<cdot> \<a>[s\<^sub>0, p\<^sub>0, w]"
                 using assoc_naturality [of s\<^sub>0 p\<^sub>0 \<gamma>] comp_assoc
                 by (metis \<gamma> \<gamma>\<^sub>r \<sigma>.leg0_simps(4-5) r\<^sub>0s\<^sub>1.leg0_simps(4-5)
                     r\<^sub>0s\<^sub>1.leg1_simps(3) hseqE in_homE leg0_simps(2))
               also have "... = \<theta>\<^sub>s \<cdot> \<a>[s\<^sub>0, p\<^sub>0, w]"
                 by (metis \<gamma> \<gamma>\<^sub>s arrI comp_ide_arr w\<^sub>s')
               also have "... = \<theta>"
                 using \<theta>\<^sub>s_def comp_assoc comp_arr_dom comp_assoc_assoc' by simp
               finally show ?thesis by simp
             qed
             moreover have "\<beta> = (r\<^sub>1 \<star> p\<^sub>1) \<star> \<gamma>"
             proof -
               have "\<beta> = \<a>\<^sup>-\<^sup>1[r\<^sub>1, p\<^sub>1, w'] \<cdot> \<beta>\<^sub>r \<cdot> \<a>[r\<^sub>1, p\<^sub>1, w]"
               proof -
                 have "\<a>\<^sup>-\<^sup>1[r\<^sub>1, p\<^sub>1, w'] \<cdot> \<beta>\<^sub>r \<cdot> \<a>[r\<^sub>1, p\<^sub>1, w] =
                       (\<a>\<^sup>-\<^sup>1[r\<^sub>1, p\<^sub>1, w'] \<cdot> \<a>[r\<^sub>1, p\<^sub>1, w']) \<cdot> \<beta> \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>1, p\<^sub>1, w] \<cdot> \<a>[r\<^sub>1, p\<^sub>1, w]"
                   using \<beta>\<^sub>r_def comp_assoc by simp
                 also have "... = \<beta>"
                   using comp_arr_dom comp_cod_arr
                   by (metis \<rho>.ide_leg1 r\<^sub>0s\<^sub>1.ide_leg1 comp_assoc_assoc'(2) hseqE ideD(1)
                       uw\<theta>w'\<theta>'\<beta>.\<beta>_simps(1) uw\<theta>w'\<theta>'\<beta>.\<beta>_simps(4-5) leg1_simps(2) w w' w\<^sub>r w\<^sub>r')
                 finally show ?thesis by simp
               qed
               also have "... = \<a>\<^sup>-\<^sup>1[r\<^sub>1, p\<^sub>1, w'] \<cdot> (r\<^sub>1 \<star> \<gamma>\<^sub>r) \<cdot> \<a>[r\<^sub>1, p\<^sub>1, w]"
                 using \<gamma>\<^sub>r by simp
               also have "... = \<a>\<^sup>-\<^sup>1[r\<^sub>1, p\<^sub>1, w'] \<cdot> \<a>[r\<^sub>1, p\<^sub>1, w'] \<cdot> ((r\<^sub>1 \<star> p\<^sub>1) \<star> \<gamma>)"
                 using assoc_naturality [of r\<^sub>1 p\<^sub>1 \<gamma>]
                 by (metis \<gamma> \<gamma>\<^sub>r \<rho>.ide_leg1 r\<^sub>0s\<^sub>1.leg1_simps(5-6) hseqE
                     ide_char in_homE leg1_simps(2))
               also have "... = (\<a>\<^sup>-\<^sup>1[r\<^sub>1, p\<^sub>1, w'] \<cdot> \<a>[r\<^sub>1, p\<^sub>1, w']) \<cdot> ((r\<^sub>1 \<star> p\<^sub>1) \<star> \<gamma>)"
                 using comp_assoc by presburger
               also have "... = (r\<^sub>1 \<star> p\<^sub>1) \<star> \<gamma>"
                 using comp_cod_arr
                 by (metis \<rho>.ide_leg1 r\<^sub>0s\<^sub>1.ide_leg1 calculation comp_assoc_assoc'(2) comp_ide_arr
                     hseqE ideD(1) ide_cod local.uw\<theta>w'\<theta>'\<beta>.\<beta>_simps(1) local.uw\<theta>w'\<theta>'\<beta>.\<beta>_simps(5)
                     w' w\<^sub>r')
               finally show ?thesis by simp
             qed
             ultimately show "\<exists>\<gamma>. \<guillemotleft>\<gamma> : w \<Rightarrow> w'\<guillemotright> \<and> \<beta> = (r\<^sub>1 \<star> p\<^sub>1) \<star> \<gamma> \<and> \<theta> = \<theta>' \<cdot> ((s\<^sub>0 \<star> p\<^sub>0) \<star> \<gamma>)"
                using \<gamma> by blast
           qed
           moreover have "\<And>\<gamma>'. \<guillemotleft>\<gamma>' : w \<Rightarrow> w'\<guillemotright> \<and> \<beta> = (r\<^sub>1 \<star> p\<^sub>1) \<star> \<gamma>' \<and> \<theta> = \<theta>' \<cdot> ((s\<^sub>0 \<star> p\<^sub>0) \<star> \<gamma>')
                                    \<Longrightarrow> \<gamma>' = \<gamma>"
           proof -
             fix \<gamma>'
             assume \<gamma>': "\<guillemotleft>\<gamma>' : w \<Rightarrow> w'\<guillemotright> \<and> \<beta> = (r\<^sub>1 \<star> p\<^sub>1) \<star> \<gamma>' \<and> \<theta> = \<theta>' \<cdot> ((s\<^sub>0 \<star> p\<^sub>0) \<star> \<gamma>')"
             show "\<gamma>' = \<gamma>"
             proof -
               let ?P\<^sub>r = "\<lambda>\<gamma>. \<guillemotleft>\<gamma> : ?w\<^sub>r \<Rightarrow> ?w\<^sub>r'\<guillemotright> \<and> \<theta>\<^sub>r = \<theta>\<^sub>r' \<cdot> (r\<^sub>0 \<star> \<gamma>) \<and> \<beta>\<^sub>r = r\<^sub>1 \<star> \<gamma>"
               let ?P\<^sub>s = "\<lambda>\<gamma>. \<guillemotleft>\<gamma> : ?w\<^sub>s \<Rightarrow> ?w\<^sub>s'\<guillemotright> \<and> \<theta>\<^sub>s = \<theta>\<^sub>s' \<cdot> (s\<^sub>0 \<star> \<gamma>) \<and> \<beta>\<^sub>s = s\<^sub>1 \<star> \<gamma>"
               let ?\<gamma>\<^sub>r' = "p\<^sub>1 \<star> \<gamma>'"
               let ?\<gamma>\<^sub>s' = "p\<^sub>0 \<star> \<gamma>'"
               let ?P\<^sub>t = "\<lambda>\<gamma>. \<guillemotleft>\<gamma> : w \<Rightarrow> w'\<guillemotright> \<and> \<gamma>\<^sub>s = (p\<^sub>0 \<star> w') \<cdot> (p\<^sub>0 \<star> \<gamma>) \<and> p\<^sub>1 \<star> \<gamma> = \<gamma>\<^sub>r"
               have "hseq p\<^sub>0 \<gamma>'"
               proof (intro hseqI)
                 show "\<guillemotleft>\<gamma>' : src \<theta> \<rightarrow> src p\<^sub>0\<guillemotright>"
                   using \<gamma>'
                   by (metis hseqE hseqI' in_hhom_def uw\<theta>w'\<theta>'\<beta>.\<beta>_simps(1) src_hcomp
                       src_vcomp leg0_simps(2) leg1_simps(3)
                       uw\<theta>w'\<theta>'\<beta>.uw\<theta>.\<theta>_simps(1) vseq_implies_hpar(1))
                 show "\<guillemotleft>p\<^sub>0 : src p\<^sub>0 \<rightarrow> src s\<^sub>0\<guillemotright>" by simp
               qed
               hence "hseq p\<^sub>1 \<gamma>'"
                 using hseq_char by simp
               have "\<guillemotleft>?\<gamma>\<^sub>r' : ?w\<^sub>r \<Rightarrow> ?w\<^sub>r'\<guillemotright>"
                 using \<gamma>' by auto
               moreover have "\<theta>\<^sub>r = \<theta>\<^sub>r' \<cdot> (r\<^sub>0 \<star> ?\<gamma>\<^sub>r')"
               proof -
                 text \<open>
                   Note that @{term \<theta>\<^sub>r} is the composite of ``everything to the right''
                   of @{term "\<rho> \<star> ?w\<^sub>r"}, and similarly for @{term \<theta>\<^sub>r'}.
                   We can factor @{term \<theta>\<^sub>r} as @{term "(s \<star> \<theta>) \<cdot> X w"}, where @{term "X w"}
                   is a composite of @{term \<sigma>} and @{term \<phi>}.  We can similarly factor @{term \<theta>\<^sub>r'}
                   as @{term "(s \<star> \<theta>') \<cdot> X w'"}.
                   Then @{term "\<theta>\<^sub>r' \<cdot> (r\<^sub>0 \<star> ?\<gamma>\<^sub>r') = (s \<star> \<theta>') \<cdot> X w' \<cdot> (r\<^sub>0 \<star> ?\<gamma>\<^sub>r')"},
                   which equals @{term "(s \<star> \<theta>') \<cdot> (s \<star> (s\<^sub>0 \<star> p\<^sub>0) \<star> ?\<gamma>\<^sub>r') \<cdot> X w = \<theta>\<^sub>r"}.
                 \<close>
                 let ?X = "\<lambda>w. (s \<star> \<a>\<^sup>-\<^sup>1[s\<^sub>0, p\<^sub>0, w]) \<cdot> \<a>[s, s\<^sub>0, p\<^sub>0 \<star> w] \<cdot> (\<sigma> \<star> p\<^sub>0 \<star> w) \<cdot>
                                 \<a>[s\<^sub>1, p\<^sub>0, w] \<cdot> (r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w]"
                 have "\<theta>\<^sub>r' \<cdot> (r\<^sub>0 \<star> ?\<gamma>\<^sub>r') = (s \<star> \<theta>') \<cdot> ?X w' \<cdot> (r\<^sub>0 \<star> ?\<gamma>\<^sub>r')"
                   using \<theta>\<^sub>r'_def comp_assoc by simp
                 also have "... = (s \<star> \<theta>') \<cdot> (s \<star> (s\<^sub>0 \<star> p\<^sub>0) \<star> \<gamma>') \<cdot> ?X w"
                 proof -
                   have "(s \<star> \<theta>') \<cdot> ((s \<star> \<a>\<^sup>-\<^sup>1[s\<^sub>0, p\<^sub>0, w']) \<cdot> \<a>[s, s\<^sub>0, p\<^sub>0 \<star> w'] \<cdot> (\<sigma> \<star> p\<^sub>0 \<star> w') \<cdot>
                           \<a>[s\<^sub>1, p\<^sub>0, w'] \<cdot> (r\<^sub>0s\<^sub>1.\<phi> \<star> w') \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w']) \<cdot> (r\<^sub>0 \<star> p\<^sub>1 \<star> \<gamma>') =
                         (s \<star> \<theta>') \<cdot> (s \<star> \<a>\<^sup>-\<^sup>1[s\<^sub>0, p\<^sub>0, w']) \<cdot> \<a>[s, s\<^sub>0, p\<^sub>0 \<star> w'] \<cdot> (\<sigma> \<star> p\<^sub>0 \<star> w') \<cdot>
                           \<a>[s\<^sub>1, p\<^sub>0, w'] \<cdot> (r\<^sub>0s\<^sub>1.\<phi> \<star> w') \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w'] \<cdot> (r\<^sub>0 \<star> p\<^sub>1 \<star> \<gamma>')"
                     using comp_assoc by presburger
                   also have "... = (s \<star> \<theta>') \<cdot> (s \<star> \<a>\<^sup>-\<^sup>1[s\<^sub>0, p\<^sub>0, w']) \<cdot> \<a>[s, s\<^sub>0, p\<^sub>0 \<star> w'] \<cdot>
                                      (\<sigma> \<star> p\<^sub>0 \<star> w') \<cdot> \<a>[s\<^sub>1, p\<^sub>0, w'] \<cdot> ((r\<^sub>0s\<^sub>1.\<phi> \<star> w') \<cdot>
                                      ((r\<^sub>0 \<star> p\<^sub>1) \<star> \<gamma>')) \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w]"
                     using assoc'_naturality [of r\<^sub>0 p\<^sub>1 \<gamma>'] comp_assoc
                     by (metis \<gamma>' \<open>\<guillemotleft>p\<^sub>1 \<star> \<gamma>' : p\<^sub>1 \<star> w \<Rightarrow> p\<^sub>1 \<star> w'\<guillemotright>\<close> \<rho>.T0.antipar(1)
                         \<rho>.leg0_in_hom(2) r\<^sub>0s\<^sub>1.leg1_simps(4-6)
                         r\<^sub>0s\<^sub>1.base_simps(2) hcomp_in_vhomE in_homE trg_hcomp)
                   also have "... = (s \<star> \<theta>') \<cdot> (s \<star> \<a>\<^sup>-\<^sup>1[s\<^sub>0, p\<^sub>0, w']) \<cdot> \<a>[s, s\<^sub>0, p\<^sub>0 \<star> w'] \<cdot>
                                      (\<sigma> \<star> p\<^sub>0 \<star> w') \<cdot> (\<a>[s\<^sub>1, p\<^sub>0, w'] \<cdot> ((s\<^sub>1 \<star> p\<^sub>0) \<star> \<gamma>')) \<cdot>
                                      (r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w]"
                   proof -
                     have "(r\<^sub>0s\<^sub>1.\<phi> \<star> w') \<cdot> ((r\<^sub>0 \<star> p\<^sub>1) \<star> \<gamma>') = r\<^sub>0s\<^sub>1.\<phi> \<star> \<gamma>'"
                       using \<gamma>' interchange [of r\<^sub>0s\<^sub>1.\<phi> "r\<^sub>0 \<star> p\<^sub>1" w' \<gamma>'] comp_arr_dom comp_cod_arr
                       by auto
                     also have "... = ((s\<^sub>1 \<star> p\<^sub>0) \<star> \<gamma>') \<cdot> (r\<^sub>0s\<^sub>1.\<phi> \<star> w)"
                       using \<gamma>' interchange \<open>hseq p\<^sub>0 \<gamma>'\<close> comp_arr_dom comp_cod_arr
                       by (metis comp_arr_ide r\<^sub>0s\<^sub>1.\<phi>_simps(1,5) seqI'
                           uw\<theta>w'\<theta>'\<beta>.uw\<theta>.w_in_hom(2) w)
                     finally have "(r\<^sub>0s\<^sub>1.\<phi> \<star> w') \<cdot> ((r\<^sub>0 \<star> p\<^sub>1) \<star> \<gamma>') = 
                                   ((s\<^sub>1 \<star> p\<^sub>0) \<star> \<gamma>') \<cdot> (r\<^sub>0s\<^sub>1.\<phi> \<star> w)"
                       by simp
                     thus ?thesis
                       using comp_assoc by presburger
                   qed
                   also have "... = (s \<star> \<theta>') \<cdot> (s \<star> \<a>\<^sup>-\<^sup>1[s\<^sub>0, p\<^sub>0, w']) \<cdot> \<a>[s, s\<^sub>0, p\<^sub>0 \<star> w'] \<cdot>
                                      ((\<sigma> \<star> p\<^sub>0 \<star> w') \<cdot> (s\<^sub>1 \<star> p\<^sub>0 \<star> \<gamma>')) \<cdot> \<a>[s\<^sub>1, p\<^sub>0, w] \<cdot>
                                      (r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w]"
                     using \<gamma>' assoc_naturality [of s\<^sub>1 p\<^sub>0 \<gamma>'] comp_assoc
                     by (metis \<sigma>.leg1_simps(2) \<sigma>.leg1_simps(3,5-6) r\<^sub>0s\<^sub>1.leg0_simps(4-5)
                         hcomp_in_vhomE hseqE in_homE uw\<theta>w'\<theta>'\<beta>.\<beta>_simps(1)
                         leg0_in_hom(2) leg1_simps(3))
                   also have "... = (s \<star> \<theta>') \<cdot> (s \<star> \<a>\<^sup>-\<^sup>1[s\<^sub>0, p\<^sub>0, w']) \<cdot> (\<a>[s, s\<^sub>0, p\<^sub>0 \<star> w'] \<cdot>
                                    ((s \<star> s\<^sub>0) \<star> p\<^sub>0 \<star> \<gamma>')) \<cdot> (\<sigma> \<star> p\<^sub>0 \<star> w) \<cdot> \<a>[s\<^sub>1, p\<^sub>0, w] \<cdot>
                                    (r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w]"
                   proof -
                     have "(\<sigma> \<star> p\<^sub>0 \<star> w') \<cdot> (s\<^sub>1 \<star> p\<^sub>0 \<star> \<gamma>') = \<sigma> \<star> p\<^sub>0 \<star> \<gamma>'"
                       using \<gamma>' interchange [of \<sigma> s\<^sub>1 "p\<^sub>0 \<star> w'" "p\<^sub>0 \<star> \<gamma>'"]
                             whisker_left \<open>hseq p\<^sub>0 \<gamma>'\<close>comp_arr_dom comp_cod_arr
                       by (metis \<sigma>.tab_simps(1) \<sigma>.tab_simps(4) hcomp_simps(4) in_homE
                           r\<^sub>0s\<^sub>1.leg0_simps(5))
                     also have "... = ((s \<star> s\<^sub>0) \<star> p\<^sub>0 \<star> \<gamma>') \<cdot> (\<sigma> \<star> p\<^sub>0 \<star> w)"
                       using \<gamma>' interchange [of "s \<star> s\<^sub>0" \<sigma> "p\<^sub>0 \<star> \<gamma>'" "p\<^sub>0 \<star> w"]
                             whisker_left comp_arr_dom comp_cod_arr \<open>hseq p\<^sub>0 \<gamma>'\<close>
                       by (metis \<sigma>.tab_simps(1) \<sigma>.tab_simps(5) hcomp_simps(3) in_homE
                           r\<^sub>0s\<^sub>1.leg0_simps(4))
                     finally have "(\<sigma> \<star> p\<^sub>0 \<star> w') \<cdot> (s\<^sub>1 \<star> p\<^sub>0 \<star> \<gamma>') =
                                   ((s \<star> s\<^sub>0) \<star> p\<^sub>0 \<star> \<gamma>') \<cdot> (\<sigma> \<star> p\<^sub>0 \<star> w)"
                       by simp
                     thus ?thesis
                       using comp_assoc by presburger
                   qed
                   also have "... = (s \<star> \<theta>') \<cdot> (s \<star> \<a>\<^sup>-\<^sup>1[s\<^sub>0, p\<^sub>0, w']) \<cdot> ((s \<star> s\<^sub>0 \<star> p\<^sub>0 \<star> \<gamma>') \<cdot>
                                      \<a>[s, s\<^sub>0, p\<^sub>0 \<star> w]) \<cdot> (\<sigma> \<star> p\<^sub>0 \<star> w) \<cdot> \<a>[s\<^sub>1, p\<^sub>0, w] \<cdot>
                                      (r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w]"
                     using \<gamma>' assoc_naturality [of s s\<^sub>0 "p\<^sub>0 \<star> \<gamma>'"] \<open>hseq p\<^sub>0 \<gamma>'\<close> by force
                   also have "... = (s \<star> \<theta>') \<cdot> ((s \<star> \<a>\<^sup>-\<^sup>1[s\<^sub>0, p\<^sub>0, w']) \<cdot> (s \<star> s\<^sub>0 \<star> p\<^sub>0 \<star> \<gamma>')) \<cdot>
                                      \<a>[s, s\<^sub>0, p\<^sub>0 \<star> w] \<cdot> (\<sigma> \<star> p\<^sub>0 \<star> w) \<cdot> \<a>[s\<^sub>1, p\<^sub>0, w] \<cdot>
                                      (r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w]"
                     using comp_assoc by presburger
                   also have "... = (s \<star> \<theta>') \<cdot> ((s \<star> (s\<^sub>0 \<star> p\<^sub>0) \<star> \<gamma>') \<cdot> (s \<star> \<a>\<^sup>-\<^sup>1[s\<^sub>0, p\<^sub>0, w])) \<cdot>
                                      \<a>[s, s\<^sub>0, p\<^sub>0 \<star> w] \<cdot> (\<sigma> \<star> p\<^sub>0 \<star> w) \<cdot> \<a>[s\<^sub>1, p\<^sub>0, w] \<cdot>
                                      (r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w]"
                   proof -
                     have "(s \<star> \<a>\<^sup>-\<^sup>1[s\<^sub>0, p\<^sub>0, w']) \<cdot> (s \<star> s\<^sub>0 \<star> p\<^sub>0 \<star> \<gamma>') =
                           (s \<star> (s\<^sub>0 \<star> p\<^sub>0) \<star> \<gamma>') \<cdot> (s \<star> \<a>\<^sup>-\<^sup>1[s\<^sub>0, p\<^sub>0, w])"
                     proof -
                       have "(s \<star> \<a>\<^sup>-\<^sup>1[s\<^sub>0, p\<^sub>0, w']) \<cdot> (s \<star> s\<^sub>0 \<star> p\<^sub>0 \<star> \<gamma>') =
                             s \<star> \<a>\<^sup>-\<^sup>1[s\<^sub>0, p\<^sub>0, w'] \<cdot> (s\<^sub>0 \<star> p\<^sub>0 \<star> \<gamma>')"
                       proof -
                         have "seq \<a>\<^sup>-\<^sup>1[s\<^sub>0, p\<^sub>0, w'] (s\<^sub>0 \<star> p\<^sub>0 \<star> \<gamma>')"
                         proof
                           (* It seems to be too time-consuming for auto to solve these. *)
                           show "\<guillemotleft>s\<^sub>0 \<star> p\<^sub>0 \<star> \<gamma>' : s\<^sub>0 \<star> p\<^sub>0 \<star> w \<Rightarrow> s\<^sub>0 \<star> p\<^sub>0 \<star> w'\<guillemotright>"
                             using \<gamma>'
                             by (intro hcomp_in_vhom, auto)
                           show "\<guillemotleft>\<a>\<^sup>-\<^sup>1[s\<^sub>0, p\<^sub>0, w'] : s\<^sub>0 \<star> p\<^sub>0 \<star> w' \<Rightarrow> (s\<^sub>0 \<star> p\<^sub>0) \<star> w'\<guillemotright>"
                             by auto
                         qed
                         thus ?thesis
                           using w w' \<gamma>' whisker_left by simp
                       qed
                       also have "... = s \<star> ((s\<^sub>0 \<star> p\<^sub>0) \<star> \<gamma>') \<cdot> \<a>\<^sup>-\<^sup>1[s\<^sub>0, p\<^sub>0, w]"
                         using \<gamma>' \<open>hseq p\<^sub>0 \<gamma>'\<close> assoc'_naturality [of s\<^sub>0 p\<^sub>0 \<gamma>'] by fastforce
                       also have "... = (s \<star> (s\<^sub>0 \<star> p\<^sub>0) \<star> \<gamma>') \<cdot> (s \<star> \<a>\<^sup>-\<^sup>1[s\<^sub>0, p\<^sub>0, w])"
                       proof -
                         have "seq ((s\<^sub>0 \<star> p\<^sub>0) \<star> \<gamma>') \<a>\<^sup>-\<^sup>1[s\<^sub>0, p\<^sub>0, w]"
                         proof
                           (* Same here. *)
                           show "\<guillemotleft>\<a>\<^sup>-\<^sup>1[s\<^sub>0, p\<^sub>0, w] : s\<^sub>0 \<star> p\<^sub>0 \<star> w \<Rightarrow> (s\<^sub>0 \<star> p\<^sub>0) \<star> w\<guillemotright>"
                             by auto
                           show "\<guillemotleft>(s\<^sub>0 \<star> p\<^sub>0) \<star> \<gamma>' : (s\<^sub>0 \<star> p\<^sub>0) \<star> w \<Rightarrow> (s\<^sub>0 \<star> p\<^sub>0) \<star> w'\<guillemotright>"
                             using \<gamma>' by (intro hcomp_in_vhom, auto)
                         qed
                         thus ?thesis
                           using w w' \<gamma>' whisker_left by simp
                       qed
                       finally show ?thesis by blast
                     qed
                     thus ?thesis by simp
                   qed
                   also have "... = (s \<star> \<theta>') \<cdot> (s \<star> (s\<^sub>0 \<star> p\<^sub>0) \<star> \<gamma>') \<cdot> ?X w"
                     using comp_assoc by presburger
                   finally show ?thesis by simp
                 qed
                 also have "... = \<theta>\<^sub>r"
                   using \<theta>\<^sub>r_def \<gamma>' uw\<theta>w'\<theta>'\<beta>.uw\<theta>.\<theta>_simps(1) whisker_left \<sigma>.ide_base comp_assoc
                   by simp
                 finally show ?thesis by simp
               qed
               moreover have "\<beta>\<^sub>r = r\<^sub>1 \<star> ?\<gamma>\<^sub>r'"
               proof -
                 have "\<beta>\<^sub>r = \<a>[r\<^sub>1, p\<^sub>1, w'] \<cdot> ((r\<^sub>1 \<star> p\<^sub>1) \<star> \<gamma>') \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>1, p\<^sub>1, w]"
                   using \<beta>\<^sub>r_def \<gamma>' by simp
                 also have "... = \<a>[r\<^sub>1, p\<^sub>1, w'] \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>1, p\<^sub>1, w'] \<cdot> (r\<^sub>1 \<star> p\<^sub>1 \<star> \<gamma>')"
                   using \<gamma>' assoc'_naturality
                   by (metis \<rho>.leg1_simps(5-6) r\<^sub>0s\<^sub>1.leg1_simps(5-6)
                       hcomp_in_vhomE hseqE in_homE uw\<theta>w'\<theta>'\<beta>.\<beta>_simps(1) leg1_in_hom(2))
                 also have "... = (\<a>[r\<^sub>1, p\<^sub>1, w'] \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>1, p\<^sub>1, w']) \<cdot> (r\<^sub>1 \<star> p\<^sub>1 \<star> \<gamma>')"
                   using comp_assoc by presburger
                 also have "... = r\<^sub>1 \<star> p\<^sub>1 \<star> \<gamma>'"
                   using comp_cod_arr
                   by (metis (no_types, lifting) \<beta>\<^sub>r \<rho>.ide_leg1 r\<^sub>0s\<^sub>1.ide_leg1 arrI calculation
                       comp_assoc_assoc'(1) comp_ide_arr ide_hcomp hseq_char'
                       ideD(1) seq_if_composable hcomp_simps(2) leg1_simps(2) w' w\<^sub>r')
                 finally show ?thesis by simp
               qed
               ultimately have P\<^sub>r': "?P\<^sub>r ?\<gamma>\<^sub>r'"
                 by simp
               have eq\<^sub>r: "\<gamma>\<^sub>r = ?\<gamma>\<^sub>r'"
                 using 1 \<gamma>\<^sub>r P\<^sub>r' by blast
               have "\<guillemotleft>?\<gamma>\<^sub>s' : ?w\<^sub>s \<Rightarrow> ?w\<^sub>s'\<guillemotright>"
                 using \<gamma>' by auto
               moreover have "\<theta>\<^sub>s = \<theta>\<^sub>s' \<cdot> (s\<^sub>0 \<star> ?\<gamma>\<^sub>s')"
                 using \<gamma>' \<open>hseq p\<^sub>0 \<gamma>'\<close> \<sigma>.leg0_simps(2,4-5)  \<sigma>.leg1_simps(3) \<theta>\<^sub>s'_def \<theta>\<^sub>s_def
                       assoc'_naturality hseqE in_homE comp_assoc r\<^sub>0s\<^sub>1.leg0_simps(4-5)
                       r\<^sub>0s\<^sub>1.p\<^sub>0_simps
                 by metis
               moreover have "\<beta>\<^sub>s = s\<^sub>1 \<star> ?\<gamma>\<^sub>s'"
               proof -
                 have "\<a>[s\<^sub>1, p\<^sub>0, w'] \<cdot> (r\<^sub>0s\<^sub>1.\<phi> \<star> w') \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w'] \<cdot> (r\<^sub>0 \<star> \<gamma>\<^sub>r) \<cdot>
                         \<a>[r\<^sub>0, p\<^sub>1, w] \<cdot> (inv r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[s\<^sub>1, p\<^sub>0, w] =
                       \<a>[s\<^sub>1, p\<^sub>0, w'] \<cdot> (r\<^sub>0s\<^sub>1.\<phi> \<star> w') \<cdot> (\<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w'] \<cdot> (r\<^sub>0 \<star> p\<^sub>1 \<star> \<gamma>')) \<cdot>
                         \<a>[r\<^sub>0, p\<^sub>1, w] \<cdot> (inv r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[s\<^sub>1, p\<^sub>0, w]"
                   using eq\<^sub>r comp_assoc by simp
                 also have "... = \<a>[s\<^sub>1, p\<^sub>0, w'] \<cdot> ((r\<^sub>0s\<^sub>1.\<phi> \<star> w') \<cdot> ((r\<^sub>0 \<star> p\<^sub>1) \<star> \<gamma>')) \<cdot>
                                    \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w] \<cdot> \<a>[r\<^sub>0, p\<^sub>1, w] \<cdot> (inv r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot>
                                    \<a>\<^sup>-\<^sup>1[s\<^sub>1, p\<^sub>0, w]"
                 proof -
                   have "\<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w'] \<cdot> (r\<^sub>0 \<star> p\<^sub>1 \<star> \<gamma>') = ((r\<^sub>0 \<star> p\<^sub>1) \<star> \<gamma>') \<cdot> \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w]"
                     using \<gamma>' assoc'_naturality \<open>hseq p\<^sub>1 \<gamma>'\<close>
                     by (metis \<rho>.leg0_simps(2,4-5) \<rho>.leg1_simps(3)
                         r\<^sub>0s\<^sub>1.leg1_simps(5-6) hseqE in_homE leg1_simps(2))
                   thus ?thesis
                     using comp_assoc by presburger
                 qed
                 also have "... = (\<a>[s\<^sub>1, p\<^sub>0, w'] \<cdot> ((s\<^sub>1 \<star> p\<^sub>0) \<star> \<gamma>')) \<cdot> (r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot>
                                    \<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w] \<cdot> \<a>[r\<^sub>0, p\<^sub>1, w] \<cdot> (inv r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot>
                                    \<a>\<^sup>-\<^sup>1[s\<^sub>1, p\<^sub>0, w]"
                 proof -
                   have "(r\<^sub>0s\<^sub>1.\<phi> \<star> w') \<cdot> ((r\<^sub>0 \<star> p\<^sub>1) \<star> \<gamma>') = r\<^sub>0s\<^sub>1.\<phi> \<star> \<gamma>'"
                     using \<gamma>' interchange [of r\<^sub>0s\<^sub>1.\<phi> "r\<^sub>0 \<star> p\<^sub>1" w' \<gamma>']
                           comp_arr_dom comp_cod_arr
                     by auto
                   also have "... = ((s\<^sub>1 \<star> p\<^sub>0) \<star> \<gamma>') \<cdot> (r\<^sub>0s\<^sub>1.\<phi> \<star> w)"
                     using \<gamma>' interchange \<open>hseq p\<^sub>0 \<gamma>'\<close> comp_arr_dom comp_cod_arr
                     by (metis in_homE r\<^sub>0s\<^sub>1.\<phi>_simps(1,5))
                   finally have "(r\<^sub>0s\<^sub>1.\<phi> \<star> w') \<cdot> ((r\<^sub>0 \<star> p\<^sub>1) \<star> \<gamma>') =
                                 ((s\<^sub>1 \<star> p\<^sub>0) \<star> \<gamma>') \<cdot> (r\<^sub>0s\<^sub>1.\<phi> \<star> w)"
                     by simp
                   thus ?thesis
                     using comp_assoc by presburger
                 qed
                 also have "... = (s\<^sub>1 \<star> ?\<gamma>\<^sub>s') \<cdot> \<a>[s\<^sub>1, p\<^sub>0, w] \<cdot> ((r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot> (\<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w] \<cdot>
                                    \<a>[r\<^sub>0, p\<^sub>1, w]) \<cdot> (inv r\<^sub>0s\<^sub>1.\<phi> \<star> w)) \<cdot> \<a>\<^sup>-\<^sup>1[s\<^sub>1, p\<^sub>0, w]"
                 proof -
                   have "\<a>[s\<^sub>1, p\<^sub>0, w'] \<cdot> ((s\<^sub>1 \<star> p\<^sub>0) \<star> \<gamma>') = (s\<^sub>1 \<star> ?\<gamma>\<^sub>s') \<cdot> \<a>[s\<^sub>1, p\<^sub>0, w]"
                     using \<gamma>' assoc_naturality [of s\<^sub>1 p\<^sub>0 \<gamma>'] \<open>hseq p\<^sub>0 \<gamma>'\<close> by auto
                   thus ?thesis
                     using comp_assoc by presburger
                 qed
                 also have "... = s\<^sub>1 \<star> ?\<gamma>\<^sub>s'"
                 proof -
                   have "\<a>\<^sup>-\<^sup>1[r\<^sub>0, p\<^sub>1, w] \<cdot> \<a>[r\<^sub>0, p\<^sub>1, w] = cod (inv r\<^sub>0s\<^sub>1.\<phi> \<star> w)"
                     using r\<^sub>0s\<^sub>1.\<phi>_uniqueness(2) \<rho>.T0.antipar(1) comp_assoc_assoc'
                     by simp
                   text \<open>Here the fact that \<open>\<phi>\<close> is a retraction is used.\<close>
                   moreover have "(r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot> (inv r\<^sub>0s\<^sub>1.\<phi> \<star> w) = cod \<a>\<^sup>-\<^sup>1[s\<^sub>1, p\<^sub>0, w]"
                     using r\<^sub>0s\<^sub>1.\<phi>_uniqueness(2) comp_arr_inv'
                           whisker_right [of w r\<^sub>0s\<^sub>1.\<phi> "inv r\<^sub>0s\<^sub>1.\<phi>"]
                     by simp
                   moreover have "cod (inv r\<^sub>0s\<^sub>1.\<phi> \<star> w) \<cdot> (inv r\<^sub>0s\<^sub>1.\<phi> \<star> w) = inv r\<^sub>0s\<^sub>1.\<phi> \<star> w"
                     using \<beta>\<^sub>s_def \<beta>\<^sub>s
                     by (meson arrI comp_cod_arr seqE)
                   ultimately show ?thesis
                     using \<gamma>' \<open>hseq p\<^sub>0 \<gamma>'\<close> comp_arr_dom comp_cod_arr comp_assoc_assoc'
                           whisker_left [of s\<^sub>1 "p\<^sub>0 \<star> \<gamma>'" "p\<^sub>0 \<star> w"] whisker_left [of p\<^sub>0]
                     by (metis \<sigma>.ide_leg1 assoc'_simps(1) hseqE ideD(1) in_homE r\<^sub>0s\<^sub>1.ide_leg0
                         r\<^sub>0s\<^sub>1.p\<^sub>0_simps w w\<^sub>s)
                 qed
                 finally show ?thesis
                   using \<beta>\<^sub>s_def by simp
               qed
               ultimately have P\<^sub>s': "?P\<^sub>s ?\<gamma>\<^sub>s'"
                 by simp
               have eq\<^sub>s: "\<gamma>\<^sub>s = ?\<gamma>\<^sub>s'"
                 using 2 \<gamma>\<^sub>s P\<^sub>s' by blast
               have "?P\<^sub>t \<gamma>'"
                 using \<gamma>' comp_cod_arr \<open>\<guillemotleft>p\<^sub>0 \<star> \<gamma>' : p\<^sub>0 \<star> w \<Rightarrow> p\<^sub>0 \<star> w'\<guillemotright>\<close> eq\<^sub>r eq\<^sub>s by auto
               thus "\<gamma>' = \<gamma>"
                 using 3 \<gamma> by blast
             qed
           qed
           ultimately show ?thesis by blast
         qed
       qed
     qed
 
   end
 
   sublocale composite_tabulation_in_maps \<subseteq>
               tabulation V H \<a> \<i> src trg \<open>r \<star> s\<close> tab \<open>s\<^sub>0 \<star> p\<^sub>0\<close> \<open>r\<^sub>1 \<star> p\<^sub>1\<close>
     using composite_is_tabulation by simp
 
   sublocale composite_tabulation_in_maps \<subseteq>
               tabulation_in_maps V H \<a> \<i> src trg \<open>r \<star> s\<close> tab \<open>s\<^sub>0 \<star> p\<^sub>0\<close> \<open>r\<^sub>1 \<star> p\<^sub>1\<close>
     using T0.is_map \<rho>.leg1_is_map \<rho>.T0.antipar(2) composable \<rho>.leg1_is_map \<rho>.T0.antipar
     apply unfold_locales
      apply simp
     apply (intro left_adjoints_compose)
     by auto
 
   subsection "The Classifying Category of Maps"
 
   text \<open>
     \sloppypar
     We intend to show that if \<open>B\<close> is a bicategory of spans, then \<open>B\<close> is biequivalent to
     \<open>Span(Maps(B))\<close>, for a specific category \<open>Maps(B)\<close> derived from \<open>B\<close>.
     The category \<open>Maps(B)\<close> is constructed in this section as the ``classifying category'' of
     maps of \<open>B\<close>, which has the same objects as \<open>B\<close> and which has as 1-cells the isomorphism classes
     of maps of \<open>B\<close>.  We show that, if \<open>B\<close> is a bicategory of spans, then \<open>Maps(B)\<close> has pullbacks.
   \<close>
 
   locale maps_category =
     B: bicategory_of_spans
   begin
 
     no_notation B.in_hhom  ("\<guillemotleft>_ : _ \<rightarrow> _\<guillemotright>")
     no_notation B.in_hom  ("\<guillemotleft>_ : _ \<rightarrow>\<^sub>B _\<guillemotright>")
     notation B.in_hhom  ("\<guillemotleft>_ : _ \<rightarrow>\<^sub>B _\<guillemotright>")
     notation B.in_hom  ("\<guillemotleft>_ : _ \<Rightarrow>\<^sub>B _\<guillemotright>")
     notation B.isomorphic  (infix "\<cong>\<^sub>B" 50)
     notation B.iso_class  ("\<lbrakk>_\<rbrakk>\<^sub>B")
 
     text \<open>
       I attempted to modularize the construction here, by refactoring ``classifying category''
       out as a separate locale, but it ended up causing extra work because to apply it we
       first need to obtain the full sub-bicategory of 2-cells between maps, then construct its
       classifying category, and then we have to re-prove everything about it, to get rid of
       any mention of the sub-bicategory construction.  So the construction is being done
       here as a ``one-off'' special case construction, with the necessary properties proved
       just once.
      \<close>
 
      text \<open>
        The ``hom-categories'' of \<open>Maps(C)\<close> have as arrows the isomorphism classes of maps of \<open>B\<close>.
      \<close>
 
      abbreviation Hom
      where "Hom a b \<equiv> {F. \<exists>f. \<guillemotleft>f : a \<rightarrow>\<^sub>B b\<guillemotright> \<and> B.is_left_adjoint f \<and> F = \<lbrakk>f\<rbrakk>\<^sub>B}"
 
      lemma in_HomD:
      assumes "F \<in> Hom a b"
      shows "F \<noteq> {}"
      and "B.is_iso_class F"
      and "f \<in> F \<Longrightarrow> B.ide f"
      and "f \<in> F \<Longrightarrow> \<guillemotleft>f : a \<rightarrow>\<^sub>B b\<guillemotright>"
      and "f \<in> F \<Longrightarrow> B.is_left_adjoint f"
      and "f \<in> F \<Longrightarrow> F = \<lbrakk>f\<rbrakk>\<^sub>B"
      proof -
        show "F \<noteq> {}"
          using assms B.ide_in_iso_class B.left_adjoint_is_ide B.iso_class_is_nonempty by auto
        show 1: "B.is_iso_class F"
          using assms B.is_iso_classI B.left_adjoint_is_ide by fastforce
        show "f \<in> F \<Longrightarrow> B.ide f"
          using assms 1 B.iso_class_memb_is_ide by blast
        obtain f' where f': "\<guillemotleft>f' : a \<rightarrow>\<^sub>B b\<guillemotright> \<and> B.is_left_adjoint f' \<and> F = \<lbrakk>f'\<rbrakk>\<^sub>B"
          using assms by auto
        show "f \<in> F \<Longrightarrow> \<guillemotleft>f : a \<rightarrow>\<^sub>B b\<guillemotright>"
          using assms f' B.iso_class_def B.isomorphic_implies_hpar by auto
        show "f \<in> F \<Longrightarrow> B.is_left_adjoint f"
          using assms f' B.iso_class_def B.left_adjoint_preserved_by_iso [of f'] by auto
        show "f \<in> F \<Longrightarrow> F = \<lbrakk>f\<rbrakk>\<^sub>B"
          by (metis B.adjoint_pair_antipar(1) f' B.ide_in_iso_class B.is_iso_classI
              B.iso_class_elems_isomorphic B.iso_class_eqI)
      qed
 
      definition Comp
      where "Comp G F \<equiv> {h. B.is_iso_class F \<and> B.is_iso_class G \<and>
                             (\<exists>f g. f \<in> F \<and> g \<in> G \<and> g \<star> f \<cong>\<^sub>B h)}"
 
      lemma in_CompI [intro]:
      assumes "B.is_iso_class F" and "B.is_iso_class G"
      and "f \<in> F" and "g \<in> G" and "g \<star> f \<cong>\<^sub>B h"
      shows "h \<in> Comp G F"
        unfolding Comp_def
        using assms by auto
 
      lemma in_CompE [elim]:
      assumes "h \<in> Comp G F"
      and "\<And>f g. \<lbrakk> B.is_iso_class F; B.is_iso_class G; f \<in> F; g \<in> G; g \<star> f \<cong>\<^sub>B h \<rbrakk> \<Longrightarrow> T"
      shows T
        using assms Comp_def by auto
 
      lemma is_iso_class_Comp:
      assumes "Comp G F \<noteq> {}"
      shows "B.is_iso_class (Comp G F)"
      proof -
        obtain h where h: "h \<in> Comp G F"
          using assms by auto
        have ide_h: "B.ide h"
          using h Comp_def B.isomorphic_implies_hpar(2) by auto
        obtain f g where fg: "B.is_iso_class F \<and> B.is_iso_class G \<and> f \<in> F \<and> g \<in> G \<and> g \<star> f \<cong>\<^sub>B h"
          using h Comp_def by auto
        have "Comp G F = \<lbrakk>g \<star> f\<rbrakk>\<^sub>B \<and> B.ide (g \<star> f)"
        proof (intro conjI)
          show "B.ide (g \<star> f)"
            using fg B.iso_class_memb_is_ide B.isomorphic_implies_ide(1) by auto
          show "Comp G F = \<lbrakk>g \<star> f\<rbrakk>\<^sub>B"
          proof
            show "\<lbrakk>g \<star> f\<rbrakk>\<^sub>B \<subseteq> Comp G F"
              unfolding Comp_def B.iso_class_def
              using fg by auto
            show "Comp G F \<subseteq> \<lbrakk>g \<star> f\<rbrakk>\<^sub>B"
            proof
              fix h'
              assume h': "h' \<in> Comp G F"
              obtain f' g' where f'g': "f' \<in> F \<and> g' \<in> G \<and> g' \<star> f' \<cong>\<^sub>B h'"
                using h' Comp_def by auto
              have 1: "f' \<cong>\<^sub>B f \<and> g' \<cong>\<^sub>B g"
                using f'g' fg B.iso_class_elems_isomorphic by auto
              moreover have "B.ide f \<and> B.ide f' \<and> B.ide g \<and> B.ide g'"
                using 1 B.isomorphic_implies_hpar by auto
              ultimately have "g' \<star> f' \<cong>\<^sub>B g \<star> f"
                using f'g' fg B.hcomp_isomorphic_ide B.hcomp_ide_isomorphic
                      B.isomorphic_transitive B.isomorphic_implies_hpar
                by (meson B.hseqE B.ideD(1))
              hence "h' \<cong>\<^sub>B g \<star> f"
                using f'g' B.isomorphic_symmetric B.isomorphic_transitive by blast
              thus "h' \<in> B.iso_class (g \<star> f)"
                using B.iso_class_def B.isomorphic_symmetric by simp
            qed
          qed
        qed
        thus ?thesis
          using assms B.is_iso_class_def B.ide_in_iso_class by auto
      qed
 
      lemma Comp_is_extensional:
      assumes "Comp G F \<noteq> {}"
      shows "B.is_iso_class F" and "B.is_iso_class G"
      and "F \<noteq> {}" and "G \<noteq> {}"
        using assms Comp_def by auto
 
      lemma Comp_eqI [intro]:
      assumes "h \<in> Comp G F" and "h' \<in> Comp G' F'" and "h \<cong>\<^sub>B h'"
      shows "Comp G F = Comp G' F'"
      proof -
        obtain f g where fg: "f \<in> F \<and> g \<in> G \<and> g \<star> f \<cong>\<^sub>B h"
          using assms comp_def by auto
        obtain f' g' where f'g': "f' \<in> F' \<and>  g' \<in> G' \<and> g' \<star> f' \<cong>\<^sub>B h'"
          using assms by auto
        have "h \<in> Comp G F \<inter> Comp G' F'"
          by (meson IntI assms in_CompE in_CompI B.isomorphic_symmetric B.isomorphic_transitive)
        hence "Comp G F \<inter> Comp G' F' \<noteq> {}"
          by auto
        thus ?thesis
          using assms is_iso_class_Comp
          by (metis empty_iff B.iso_class_eq)
      qed
 
      lemma Comp_eq_iso_class_memb:
      assumes "h \<in> Comp G F"
      shows "Comp G F = \<lbrakk>h\<rbrakk>\<^sub>B"
      proof
        show "Comp G F \<subseteq> \<lbrakk>h\<rbrakk>\<^sub>B"
        proof
          fix h'
          assume h': "h' \<in> Comp G F"
          obtain f g where fg: "f \<in> F \<and> g \<in> G \<and> g \<star> f \<cong>\<^sub>B h"
            using assms by auto
          obtain f' g' where f'g': "f' \<in> F \<and> g' \<in> G \<and> g' \<star> f' \<cong>\<^sub>B h'"
            using h' by auto
          have "f \<cong>\<^sub>B f' \<and> g \<cong>\<^sub>B g'"
            using assms fg f'g' in_HomD(6) B.iso_class_elems_isomorphic by auto
          moreover have "B.ide f \<and> B.ide f' \<and> B.ide g \<and> B.ide g'"
            using assms fg f'g' in_HomD [of F] in_HomD [of G]
            by (meson calculation B.isomorphic_implies_ide(1) B.isomorphic_implies_ide(2))
          moreover have "src g = trg f \<and> src g = trg f' \<and> src g' = trg f \<and> src g' = trg f'"
            using fg f'g'
            by (metis B.seq_if_composable calculation(1) B.ideD(1)
                B.isomorphic_implies_hpar(1) B.isomorphic_implies_hpar(3) B.not_arr_null)
          ultimately have "g \<star> f \<cong>\<^sub>B g' \<star> f'"
            using fg f'g' B.hcomp_ide_isomorphic B.hcomp_isomorphic_ide B.isomorphic_transitive
            by metis
          thus "h' \<in> \<lbrakk>h\<rbrakk>\<^sub>B"
            using fg f'g' B.isomorphic_symmetric B.isomorphic_transitive B.iso_class_def [of h]
            by blast
        qed
        show "\<lbrakk>h\<rbrakk>\<^sub>B \<subseteq> Comp G F"
        proof (unfold B.iso_class_def Comp_def)
          obtain f g where 1: "f \<in> F \<and> g \<in> G \<and> g \<star> f \<cong>\<^sub>B h"
            using assms in_HomD Comp_def
            by (meson in_CompE)
          show "{h'. B.isomorphic h h'} \<subseteq>
                {h. B.is_iso_class F \<and> B.is_iso_class G \<and> (\<exists>f g. f \<in> F \<and> g \<in> G \<and> g \<star> f \<cong>\<^sub>B h)}"
            using assms 1 B.isomorphic_transitive by blast
        qed
      qed
 
      interpretation concrete_category \<open>Collect B.obj\<close> Hom B.iso_class \<open>\<lambda>_ _ _. Comp\<close>
      proof
        show "\<And>a. a \<in> Collect B.obj \<Longrightarrow> \<lbrakk>a\<rbrakk>\<^sub>B \<in> Hom a a"
          by (metis (mono_tags, lifting) B.ide_in_hom(1) mem_Collect_eq B.objE
              B.obj_is_self_adjoint(1))
        show "\<And>a b c F G. \<lbrakk> a \<in> Collect B.obj; b \<in> Collect B.obj; c \<in> Collect B.obj;
                            F \<in> Hom a b; G \<in> Hom b c \<rbrakk> \<Longrightarrow> Comp G F \<in> Hom a c"
        proof -
          fix a b c F G
          assume a: "a \<in> Collect B.obj" and b: "b \<in> Collect B.obj" and c: "c \<in> Collect B.obj"
          and F: "F \<in> Hom a b" and G: "G \<in> Hom b c"
          obtain f where f: "\<guillemotleft>f : a \<rightarrow>\<^sub>B b\<guillemotright> \<and> B.is_left_adjoint f \<and> F = \<lbrakk>f\<rbrakk>\<^sub>B"
            using F by blast
          obtain g where g: "\<guillemotleft>g : b \<rightarrow>\<^sub>B c\<guillemotright> \<and> B.is_left_adjoint g \<and> G = \<lbrakk>g\<rbrakk>\<^sub>B"
            using G by blast
          have "{h. B.is_iso_class F \<and> B.is_iso_class G \<and>
                    (\<exists>f g. f \<in> F \<and> \<guillemotleft>f : a \<rightarrow>\<^sub>B b\<guillemotright> \<and> g \<in> G \<and> \<guillemotleft>g : b \<rightarrow>\<^sub>B c\<guillemotright> \<and> g \<star> f \<cong>\<^sub>B h)} =
                \<lbrakk>g \<star> f\<rbrakk>\<^sub>B"
          proof
            show "{h. B.is_iso_class F \<and> B.is_iso_class G \<and>
                      (\<exists>f g. f \<in> F \<and> \<guillemotleft>f : a \<rightarrow>\<^sub>B b\<guillemotright> \<and> g \<in> G \<and> \<guillemotleft>g : b \<rightarrow>\<^sub>B c\<guillemotright> \<and> g \<star> f \<cong>\<^sub>B h)}
                    \<subseteq> \<lbrakk>g \<star> f\<rbrakk>\<^sub>B"
            proof
              fix h
              assume "h \<in> {h. B.is_iso_class F \<and> B.is_iso_class G \<and>
                              (\<exists>f g. f \<in> F \<and> \<guillemotleft>f : a \<rightarrow>\<^sub>B b\<guillemotright> \<and> g \<in> G \<and> \<guillemotleft>g : b \<rightarrow>\<^sub>B c\<guillemotright> \<and> g \<star> f \<cong>\<^sub>B h)}"
              hence h: "B.is_iso_class F \<and> B.is_iso_class G \<and>
                        (\<exists>f g. f \<in> F \<and> \<guillemotleft>f : a \<rightarrow>\<^sub>B b\<guillemotright> \<and> g \<in> G \<and> \<guillemotleft>g : b \<rightarrow>\<^sub>B c\<guillemotright> \<and> g \<star> f \<cong>\<^sub>B h)"
                by simp
              show "h \<in> \<lbrakk>g \<star> f\<rbrakk>\<^sub>B"
              proof -
                obtain f' g' where f'g': "g' \<in> G \<and> f' \<in> F \<and> g' \<star> f' \<cong>\<^sub>B h"
                  using h by auto
                obtain \<phi> where \<phi>: "\<guillemotleft>\<phi> : f \<Rightarrow>\<^sub>B f'\<guillemotright> \<and> B.iso \<phi>"
                  using f f'g' F B.iso_class_def by auto
                obtain \<psi> where \<psi>: "\<guillemotleft>\<psi> : g \<Rightarrow>\<^sub>B g'\<guillemotright> \<and> B.iso \<psi>"
                  using g f'g' G B.iso_class_def by auto
                have 1: "\<guillemotleft>\<psi> \<star> \<phi> : g \<star> f \<Rightarrow>\<^sub>B g' \<star> f'\<guillemotright>"
                  using f g \<phi> \<psi> by auto
                moreover have "B.iso (\<psi> \<star> \<phi>)"
                  using f g \<phi> \<psi> 1 B.iso_hcomp by auto
                ultimately show ?thesis
                   using f'g' B.iso_class_def B.isomorphic_def by auto
              qed
            qed
            show "\<lbrakk>g \<star> f\<rbrakk>\<^sub>B \<subseteq> {h. B.is_iso_class F \<and> B.is_iso_class G \<and>
                                (\<exists>f g. f \<in> F \<and> \<guillemotleft>f : a \<rightarrow>\<^sub>B b\<guillemotright> \<and> g \<in> G \<and> \<guillemotleft>g : b \<rightarrow>\<^sub>B c\<guillemotright> \<and> g \<star> f \<cong>\<^sub>B h)}"
              using f g B.iso_class_def B.isomorphic_reflexive B.left_adjoint_is_ide B.is_iso_classI
              by blast
          qed
          hence 1: "\<And>gf. gf \<in> B.iso_class (g \<star> f) \<Longrightarrow>
                          B.is_iso_class F \<and> B.is_iso_class G \<and>
                          (\<exists>f g. f \<in> F \<and> \<guillemotleft>f : a \<rightarrow>\<^sub>B b\<guillemotright> \<and> g \<in> G \<and> \<guillemotleft>g : b \<rightarrow>\<^sub>B c\<guillemotright> \<and> g \<star> f \<cong>\<^sub>B gf)"
            by blast
          show "Comp G F \<in> Hom a c"
          proof -
            have gf: "B.is_left_adjoint (g \<star> f)"
              by (meson f g B.hseqE B.hseqI B.left_adjoints_compose)
            obtain gf' where gf': "B.adjoint_pair (g \<star> f) gf'"
              using gf by blast
            hence "\<lbrakk>g \<star> f\<rbrakk>\<^sub>B = Comp G F"
              using 1 Comp_eq_iso_class_memb B.ide_in_iso_class B.left_adjoint_is_ide by blast
            thus ?thesis
              using f g gf' by blast
          qed
        qed
        show "\<And>a b F. \<lbrakk> a \<in> Collect B.obj; F \<in> Hom a b \<rbrakk> \<Longrightarrow> Comp F \<lbrakk>a\<rbrakk>\<^sub>B = F"
        proof -
          fix a b F
          assume a: "a \<in> Collect B.obj"
          assume F: "F \<in> Hom a b"
          obtain f where f: "\<guillemotleft>f : a \<rightarrow>\<^sub>B b\<guillemotright> \<and> B.is_left_adjoint f \<and> F = \<lbrakk>f\<rbrakk>\<^sub>B"
            using F by auto
          have *: "\<And>f'. f' \<in> F \<Longrightarrow> \<guillemotleft>f' : a \<rightarrow>\<^sub>B b\<guillemotright> \<and> B.ide f' \<and> f \<cong>\<^sub>B f'"
            using f B.iso_class_def by force
          show "Comp F \<lbrakk>a\<rbrakk>\<^sub>B = F"
          proof
            show "Comp F \<lbrakk>a\<rbrakk>\<^sub>B \<subseteq> F"
            proof
              fix h
              assume "h \<in> Comp F \<lbrakk>a\<rbrakk>\<^sub>B"
              hence h: "\<exists>f' a'. f' \<in> F \<and> a' \<in> \<lbrakk>a\<rbrakk>\<^sub>B \<and> f' \<star> a' \<cong>\<^sub>B h"
                unfolding Comp_def by auto
              obtain f' a' where f'a': "f' \<in> F \<and> a' \<in> \<lbrakk>a\<rbrakk>\<^sub>B \<and> f' \<star> a' \<cong>\<^sub>B h"
                using h by auto
              have "B.isomorphic f h"
              proof -
                have "B.isomorphic f (f \<star> a)"
                  using f B.iso_runit' [of f] B.isomorphic_def B.left_adjoint_is_ide
                  by blast
                also have "f \<star> a \<cong>\<^sub>B f' \<star> a"
                  using f f'a' B.iso_class_def B.hcomp_isomorphic_ide
                  apply (elim conjE B.in_hhomE) by auto
                also have "f' \<star> a \<cong>\<^sub>B f' \<star> a'"
                  using f'a' * [of f'] B.iso_class_def B.hcomp_ide_isomorphic by auto
                also have "f' \<star> a' \<cong>\<^sub>B h"
                  using f'a' by simp
                finally show ?thesis by blast
              qed
              thus "h \<in> F"
                using f B.iso_class_def by simp
            qed
            show "F \<subseteq> Comp F \<lbrakk>a\<rbrakk>\<^sub>B"
            proof
              fix h
              assume h: "h \<in> F"
              have "f \<in> F"
                using f B.iso_class_def B.right_adjoint_determines_left_up_to_iso by auto
              moreover have "a \<in> B.iso_class a"
                using a B.iso_class_def B.isomorphic_reflexive by auto
              moreover have "f \<star> a \<cong>\<^sub>B h"
              proof -
                have "f \<star> a \<cong>\<^sub>B f"
                  using f B.iso_runit [of f] B.isomorphic_def B.left_adjoint_is_ide by blast
                also have "f \<cong>\<^sub>B h"
                  using h * by simp
                finally show ?thesis by blast
              qed
              ultimately show "h \<in> Comp F \<lbrakk>a\<rbrakk>\<^sub>B"
                unfolding Comp_def
                using a f F B.is_iso_classI B.left_adjoint_is_ide by auto
            qed
          qed
        qed
        show "\<And>a b F. \<lbrakk> b \<in> Collect B.obj; F \<in> Hom a b \<rbrakk> \<Longrightarrow> Comp \<lbrakk>b\<rbrakk>\<^sub>B F = F"
        proof -
          fix a b F
          assume b: "b \<in> Collect B.obj"
          assume F: "F \<in> Hom a b"
          obtain f where f: "\<guillemotleft>f : a \<rightarrow>\<^sub>B b\<guillemotright> \<and> B.is_left_adjoint f \<and> F = \<lbrakk>f\<rbrakk>\<^sub>B"
            using F by auto
          have *: "\<And>f'. f' \<in> F \<Longrightarrow> \<guillemotleft>f' : a \<rightarrow>\<^sub>B b\<guillemotright> \<and> B.ide f' \<and> f \<cong>\<^sub>B f'"
            using f B.iso_class_def by force
          show "Comp \<lbrakk>b\<rbrakk>\<^sub>B F = F"
          proof
            show "Comp \<lbrakk>b\<rbrakk>\<^sub>B F \<subseteq> F"
            proof
              fix h
              assume "h \<in> Comp \<lbrakk>b\<rbrakk>\<^sub>B F"
              hence h: "\<exists>b' f'. b' \<in> \<lbrakk>b\<rbrakk>\<^sub>B \<and> f' \<in> F \<and> b' \<star> f' \<cong>\<^sub>B h"
                unfolding Comp_def by auto
              obtain b' f' where b'f': "b' \<in> \<lbrakk>b\<rbrakk>\<^sub>B \<and> f' \<in> F \<and> b' \<star> f' \<cong>\<^sub>B h"
                using h by auto
              have "f \<cong>\<^sub>B h"
              proof -
                have "f \<cong>\<^sub>B b \<star> f"
                  using f B.iso_lunit' [of f] B.isomorphic_def B.left_adjoint_is_ide
                  by blast
                also have "... \<cong>\<^sub>B b \<star> f'"
                  using f b'f' B.iso_class_def B.hcomp_ide_isomorphic
                  by (elim conjE B.in_hhomE, auto)
                also have "... \<cong>\<^sub>B b' \<star> f'"
                  using b'f' * [of f'] B.iso_class_def B.hcomp_isomorphic_ide by auto
                also have "... \<cong>\<^sub>B h"
                  using b'f' by simp
                finally show ?thesis by blast
              qed
              thus "h \<in> F"
                using f B.iso_class_def by simp
            qed
            show "F \<subseteq> Comp \<lbrakk>b\<rbrakk>\<^sub>B F"
            proof
              fix h
              assume h: "h \<in> F"
              have "f \<in> F"
                using f B.iso_class_def B.right_adjoint_determines_left_up_to_iso by auto
              moreover have "b \<in> B.iso_class b"
                using b B.iso_class_def B.isomorphic_reflexive by auto
              moreover have "b \<star> f \<cong>\<^sub>B h"
              proof -
                have "b \<star> f \<cong>\<^sub>B f"
                  using f B.iso_lunit [of f] B.isomorphic_def B.left_adjoint_is_ide
                  by blast
                also have "f \<cong>\<^sub>B h"
                  using h * by simp
                finally show ?thesis by blast
              qed
              ultimately show "h \<in> Comp \<lbrakk>b\<rbrakk>\<^sub>B F"
                unfolding Comp_def
                using b f F B.is_iso_classI B.left_adjoint_is_ide by auto
            qed
          qed
        qed
        show "\<And>a b c d F G H.
                \<lbrakk> a \<in> Collect B.obj; b \<in> Collect B.obj; c \<in> Collect B.obj; d \<in> Collect B.obj;
                  F \<in> Hom a b; G \<in> Hom b c; H \<in> Hom c d \<rbrakk> \<Longrightarrow>
                Comp H (Comp G F) = Comp (Comp H G) F"
        proof -
          fix a b c d F G H
          assume F: "F \<in> Hom a b" and G: "G \<in> Hom b c" and H: "H \<in> Hom c d"
          show "Comp H (Comp G F) = Comp (Comp H G) F"
          proof
            show "Comp H (Comp G F) \<subseteq> Comp (Comp H G) F"
            proof
              fix x
              assume x: "x \<in> Comp H (Comp G F)"
              obtain f g h gf
              where 1: "B.is_iso_class F \<and> B.is_iso_class G \<and> B.is_iso_class H \<and>
                        h \<in> H \<and> g \<in> G \<and> f \<in> F \<and> gf \<in> Comp G F \<and> g \<star> f \<cong>\<^sub>B gf \<and> h \<star> gf \<cong>\<^sub>B x"
                using x unfolding Comp_def by blast
              have hgf: "B.ide f \<and> B.ide g \<and> B.ide h"
                using 1 F G H B.isomorphic_implies_hpar in_HomD B.left_adjoint_is_ide
                by (metis (mono_tags, lifting))
              have "h \<star> g \<star> f \<cong>\<^sub>B x"
              proof -
                have "h \<star> g \<star> f \<cong>\<^sub>B h \<star> gf"
                  using 1 hgf B.hcomp_ide_isomorphic
                  by (metis (full_types) B.isomorphic_implies_hpar(1) B.isomorphic_reflexive
                      B.isomorphic_symmetric B.seq_if_composable)
                also have "h \<star> gf \<cong>\<^sub>B x"
                  using 1 by simp
                finally show ?thesis by blast
              qed
              moreover have "(h \<star> g) \<star> f \<cong>\<^sub>B h \<star> g \<star> f"
                using 1 hgf B.iso_assoc B.assoc_in_hom B.isomorphic_def
                by (metis B.hseq_char B.ideD(1-3) B.isomorphic_implies_hpar(1)
                    B.trg_hcomp calculation)
              moreover have hg: "\<guillemotleft>h \<star> g : b \<rightarrow>\<^sub>B d\<guillemotright>"
                using G H 1 in_HomD(4) by blast
              moreover have "h \<star> g \<in> Comp H G"
                unfolding Comp_def
                using 1 hgf F G H in_HomD [of F a b] in_HomD [of G b c] in_HomD [of H c d]
                      B.isomorphic_reflexive B.hcomp_ide_isomorphic B.hseqI'
                by (metis (no_types, lifting) B.hseqE B.hseqI mem_Collect_eq)
              ultimately show "x \<in> Comp (Comp H G) F"
                using 1 F G H hgf B.is_iso_class_def is_iso_class_Comp [of H G]
                      B.isomorphic_reflexive [of "h \<star> g"]
                apply (intro in_CompI)
                            apply auto[7]
                  apply blast
                 apply simp
                by (meson B.isomorphic_symmetric B.isomorphic_transitive)
            qed
            show "Comp (Comp H G) F \<subseteq> Comp H (Comp G F)"
            proof
              fix x
              assume x: "x \<in> Comp (Comp H G) F"
              obtain f g h hg
              where 1: "B.is_iso_class F \<and> B.is_iso_class G \<and> B.is_iso_class H \<and>
                        h \<in> H \<and> g \<in> G \<and> f \<in> F \<and> hg \<in> Comp H G \<and> h \<star> g \<cong>\<^sub>B hg \<and> hg \<star> f \<cong>\<^sub>B x"
                using x unfolding Comp_def by blast
              have hgf: "B.ide f \<and> B.ide g \<and> B.ide h \<and> src h = trg g \<and> src g = trg f"
                using 1 F G H in_HomD B.left_adjoint_is_ide
                by (metis (no_types, lifting) B.hseq_char' B.ideD(1) B.ide_dom
                    B.in_homE B.isomorphic_def B.isomorphic_symmetric B.seqI'
                    B.seq_if_composable B.src_dom B.src_hcomp B.vseq_implies_hpar(1))
              have 2: "(h \<star> g) \<star> f \<cong>\<^sub>B x"
              proof -
                have "(h \<star> g) \<star> f \<cong>\<^sub>B hg \<star> f"
                  using 1 F G H hgf
                  by (simp add: B.hcomp_isomorphic_ide)
                also have "hg \<star> f \<cong>\<^sub>B x"
                  using 1 by simp
                finally show ?thesis by blast
              qed
              moreover have "(h \<star> g) \<star> f \<cong>\<^sub>B h \<star> g \<star> f"
                using hgf B.iso_assoc B.assoc_in_hom B.isomorphic_def by auto
              moreover have "g \<star> f \<in> Comp G F"
                using 1 F G hgf B.isomorphic_reflexive by blast
              ultimately show "x \<in> Comp H (Comp G F)"
                using 1 hgf is_iso_class_Comp [of G F] B.isomorphic_reflexive [of "g \<star> f"]
                apply (intro in_CompI)
                        apply auto[6]
                  apply simp
                 apply auto[1]
                by (meson B.isomorphic_symmetric B.isomorphic_transitive)
            qed
          qed
        qed
      qed
 
      lemma is_concrete_category:
      shows "concrete_category (Collect B.obj) Hom B.iso_class (\<lambda>_ _ _. Comp)"
        ..
 
      sublocale concrete_category \<open>Collect B.obj\<close> Hom B.iso_class \<open>\<lambda>_ _ _. Comp\<close>
        using is_concrete_category by simp
 
      abbreviation comp  (infixr "\<odot>" 55)
      where "comp \<equiv> COMP"
      notation in_hom  ("\<guillemotleft>_ : _ \<rightarrow> _\<guillemotright>")
      no_notation B.in_hom  ("\<guillemotleft>_ : _ \<rightarrow>\<^sub>B _\<guillemotright>")
 
      lemma Map_memb_in_hhom:
      assumes "\<guillemotleft>F : A \<rightarrow> B\<guillemotright>" and "f \<in> Map F"
      shows "\<guillemotleft>f : Dom A \<rightarrow>\<^sub>B Dom B\<guillemotright>"
      proof -
        have "\<guillemotleft>f : Dom F \<rightarrow>\<^sub>B Cod F\<guillemotright>"
          using assms arr_char [of F] in_HomD [of "Map F" "Dom F" "Cod F"] by blast
        moreover have "Dom F = Dom A"
          using assms by auto
        moreover have "Cod F = Dom B"
          using assms by auto
        ultimately show ?thesis by simp
      qed
 
      lemma MkArr_in_hom':
      assumes "B.is_left_adjoint f" and "\<guillemotleft>f : a \<rightarrow>\<^sub>B b\<guillemotright>"
      shows "\<guillemotleft>MkArr a b \<lbrakk>f\<rbrakk>\<^sub>B : MkIde a \<rightarrow> MkIde b\<guillemotright>"
        using assms MkArr_in_hom by blast
 
      text \<open>
        The isomorphisms in \<open>Maps(B)\<close> are the isomorphism classes of equivalence maps in \<open>B\<close>.
      \<close>
 
      lemma iso_char:
      shows "iso F \<longleftrightarrow> arr F \<and> (\<forall>f. f \<in> Map F \<longrightarrow> B.equivalence_map f)"
      proof
        assume F: "iso F"
        have "\<And>f. f \<in> Map F \<Longrightarrow> B.equivalence_map f"
        proof -
          fix f
          assume f: "f \<in> Map F"
          obtain G where G: "inverse_arrows F G"
            using F by auto
          obtain g where g: "g \<in> Map G"
            using G arr_char [of G] in_HomD(1) by blast
          have f: "f \<in> Map F \<and> \<guillemotleft>f : Dom F \<rightarrow>\<^sub>B Cod F\<guillemotright> \<and> B.ide f \<and> B.is_left_adjoint f"
            by (metis (mono_tags, lifting) F iso_is_arr is_concrete_category
                concrete_category.arr_char f in_HomD(2,4-5) B.iso_class_memb_is_ide)
          have g: "g \<in> Map G \<and> \<guillemotleft>g : Cod F \<rightarrow>\<^sub>B Dom F\<guillemotright> \<and> B.ide g \<and> B.is_left_adjoint g"
            by (metis (no_types, lifting) F G Cod_cod Cod_dom arr_inv cod_inv dom_inv
                inverse_unique iso_is_arr is_concrete_category concrete_category.Map_in_Hom
                g in_HomD(2,4-5) B.iso_class_memb_is_ide)
          have "src (g \<star> f) \<cong>\<^sub>B g \<star> f"
          proof -
            have "g \<star> f \<in> Map (G \<odot> F)"
            proof -
              have 1: "f \<in> Map F \<and> g \<in> Map G \<and> g \<star> f \<cong>\<^sub>B g \<star> f"
                using F G f g B.isomorphic_reflexive by force
              have 2: "Dom G = Cod F \<and> Cod G = Dom F"
                using F G arr_char
                by (metis (no_types, lifting) Cod.simps(1) Cod_dom arr_inv
                    cod_char comp_inv_arr dom_inv inverse_unique
                    iso_is_arr is_concrete_category concrete_category.Cod_comp)
              have "g \<star> f \<in> Comp (Map G) (Map F)"
                using 1 F iso_is_arr Map_in_Hom [of F] in_HomD(2)
                apply (intro in_CompI, auto)
              proof -
                show "B.is_iso_class (Map G)"
                  using G iso_is_arr iso_inv_iso Map_in_Hom [of G] in_HomD(2) [of "Map G"] by blast
              qed
              thus ?thesis
                using F G f g comp_char [of G F] by auto
            qed
            moreover have "Dom F \<in> Map (G \<odot> F)"
              by (metis (no_types, lifting) F G Map_dom comp_inv_arr iso_is_arr
                  g B.ide_in_iso_class B.in_hhomE B.objE)
            moreover have "Map (G \<odot> F) = \<lbrakk>Dom F\<rbrakk>\<^sub>B"
              by (simp add: F G comp_inv_arr iso_is_arr)
            moreover have "Dom F = src (g \<star> f)"
              using f g by fastforce
            ultimately show ?thesis
              using f g B.iso_class_elems_isomorphic B.is_iso_classI
              by (metis B.hseqI B.ide_src)
          qed
          moreover have "f \<star> g \<cong>\<^sub>B trg f"
          proof -
            have "f \<star> g \<in> Map (F \<odot> G)"
            proof -
              have 1: "f \<in> Map F \<and> g \<in> Map G \<and> f \<star> g \<cong>\<^sub>B f \<star> g"
                using F G f g B.isomorphic_reflexive by force
              have 2: "Dom G = Cod F \<and> Cod G = Dom F"
                using F G arr_char
                by (metis (no_types, lifting) Cod.simps(1) Cod_dom arr_inv
                    cod_char comp_inv_arr dom_inv inverse_unique
                    iso_is_arr is_concrete_category concrete_category.Cod_comp)
              hence "f \<star> g \<in> Comp (Map F) (Map G)"
                using 1 F iso_is_arr Map_in_Hom [of F] in_HomD(2)
                apply (intro in_CompI, auto)
              proof -
                show "B.is_iso_class (Map G)"
                  using G iso_is_arr iso_inv_iso Map_in_Hom [of G] in_HomD(2) [of "Map G"] by blast
              qed
              thus ?thesis
                using F G f g comp_char [of F G] by auto
            qed
            moreover have "Cod F \<in> Map (F \<odot> G)"
              by (metis (no_types, lifting) F G Map_cod comp_arr_inv dom_inv
                  inverse_unique iso_is_arr g B.ide_in_iso_class B.in_hhomE B.src.preserves_ide)
            moreover have "Map (F \<odot> G) = \<lbrakk>Cod F\<rbrakk>\<^sub>B"
              by (metis (no_types, lifting) F G Map_cod comp_arr_inv dom_inv
                  inverse_unique iso_is_arr)
            moreover have "Cod F = trg (f \<star> g)"
              using f g by fastforce
            ultimately show ?thesis
              using B.iso_class_elems_isomorphic
              by (metis f g B.is_iso_classI B.in_hhomE B.src.preserves_ide)
          qed
          ultimately show "B.equivalence_map f"
            using f g B.equivalence_mapI by fastforce
        qed
        thus "arr F \<and> (\<forall>f. f \<in> Map F \<longrightarrow> B.equivalence_map f)"
          using F by blast
        next
        assume F: "arr F \<and> (\<forall>f. f \<in> Map F \<longrightarrow> B.equivalence_map f)"
        show "iso F"
        proof -
          obtain f where f: "f \<in> Map F"
            using F arr_char in_HomD(1) by blast
          have f_in_hhom: "\<guillemotleft>f : Dom F \<rightarrow>\<^sub>B Cod F\<guillemotright>"
            using f F arr_char in_HomD(4) [of "Map F" "Dom F" "Cod F" f] by simp
          have "Map F = B.iso_class f"
            using f F arr_char in_HomD(6) [of "Map F" "Dom F" "Cod F" f] by simp
          obtain g \<eta> \<epsilon>' where \<epsilon>': "equivalence_in_bicategory V H \<a> \<i> src trg f g \<eta> \<epsilon>'"
            using f F B.equivalence_map_def by auto
          interpret \<epsilon>': equivalence_in_bicategory V H \<a> \<i> src trg f g \<eta> \<epsilon>'
            using \<epsilon>' by auto
          obtain \<epsilon> where \<epsilon>: "adjoint_equivalence_in_bicategory V H \<a> \<i> src trg f g \<eta> \<epsilon>"
            using f F \<epsilon>'.ide_right \<epsilon>'.antipar \<epsilon>'.unit_in_hom \<epsilon>'.unit_is_iso B.equivalence_map_def
                  B.equivalence_refines_to_adjoint_equivalence [of f g \<eta>]
            by auto
          interpret \<epsilon>: adjoint_equivalence_in_bicategory V H \<a> \<i> src trg f g \<eta> \<epsilon>
            using \<epsilon> by simp
          have g_in_hhom: "\<guillemotleft>g : Cod F \<rightarrow>\<^sub>B Dom F\<guillemotright>"
            using \<epsilon>.ide_right \<epsilon>.antipar f_in_hhom by auto
          have fg: "B.equivalence_pair f g"
            using B.equivalence_pair_def \<epsilon>.equivalence_in_bicategory_axioms by auto
          have g: "\<guillemotleft>g : Cod F \<rightarrow>\<^sub>B Dom F\<guillemotright> \<and> B.is_left_adjoint g \<and> \<lbrakk>g\<rbrakk>\<^sub>B = \<lbrakk>g\<rbrakk>\<^sub>B"
            using \<epsilon>'.dual_equivalence B.equivalence_is_left_adjoint B.equivalence_map_def
                  g_in_hhom
            by blast
          have F_as_MkArr: "F = MkArr (Dom F) (Cod F) \<lbrakk>f\<rbrakk>\<^sub>B"
            using F MkArr_Map \<open>Map F = B.iso_class f\<close> by fastforce
          have F_in_hom: "in_hom F (MkIde (Dom F)) (MkIde (Cod F))"
            using F arr_char dom_char cod_char
            by (intro in_homI, auto)
          let ?G = "MkArr (Cod F) (Dom F) \<lbrakk>g\<rbrakk>\<^sub>B"
          have "arr ?G"
            using MkArr_in_hom' g by blast
          hence G_in_hom: "\<guillemotleft>?G : MkIde (Cod F) \<rightarrow> MkIde (Dom F)\<guillemotright>"
            using arr_char MkArr_in_hom by simp
          have "inverse_arrows F ?G"
          proof
            show "ide (?G \<odot> F)"
            proof -
              have "?G \<odot> F = dom F"
              proof (intro arr_eqI)
                show 1: "seq ?G F"
                  using F_in_hom G_in_hom by blast
                show "arr (dom F)"
                  using F_in_hom ide_dom by fastforce
                show "Dom (?G \<odot> F) = Dom (dom F)"
                  using F_in_hom G_in_hom 1 comp_char by auto
                show "Cod (?G \<odot> F) = Cod (dom F)"
                  using F_in_hom G_in_hom 1 comp_char by auto
                show "Map (?G \<odot> F) = Map (dom F)"
                proof -
                  have "Map (?G \<odot> F) = Comp \<lbrakk>g\<rbrakk>\<^sub>B \<lbrakk>f\<rbrakk>\<^sub>B"
                    using 1 comp_char [of ?G F] `Map F = B.iso_class f` by simp
                  also have "... = \<lbrakk>g \<star> f\<rbrakk>\<^sub>B"
                  proof -
                    have "g \<star> f \<in> Comp \<lbrakk>g\<rbrakk>\<^sub>B \<lbrakk>f\<rbrakk>\<^sub>B"
                      by (metis \<epsilon>.ide_left \<epsilon>.ide_right \<epsilon>.unit_in_vhom \<epsilon>.unit_simps(3) B.arrI
                          B.ide_cod B.ide_in_iso_class in_CompI B.is_iso_classI
                          B.isomorphic_reflexive)
                    thus ?thesis
                      using Comp_eq_iso_class_memb F_in_hom G_in_hom arr_char arr_char
                            `Map F = B.iso_class f`
                      by auto
                  qed
                  also have "... = \<lbrakk>src f\<rbrakk>\<^sub>B"
                    using \<epsilon>.unit_in_hom \<epsilon>.unit_is_iso B.isomorphic_def B.iso_class_def
                          B.isomorphic_symmetric
                    by (intro B.iso_class_eqI, blast)
                  also have "... = \<lbrakk>Dom F\<rbrakk>\<^sub>B"
                    using \<epsilon>.ide_left f_in_hhom B.ide_in_iso_class B.in_hhomE B.src.preserves_ide
                          B.isomorphic_reflexive
                    by (intro B.iso_class_eqI, fastforce)
                  also have "... = Map (dom F)"
                    using F_in_hom dom_char by auto
                  finally show ?thesis by blast
                qed
              qed
              thus ?thesis
                using F by simp
            qed
            show "ide (F \<odot> ?G)"
            proof -
              have "F \<odot> ?G = cod F"
              proof (intro arr_eqI)
                show 1: "seq F ?G"
                  using F_in_hom G_in_hom by blast
                show "arr (cod F)"
                  using F_in_hom ide_cod by fastforce
                show "Dom (F \<odot> ?G) = Dom (cod F)"
                  using F_in_hom G_in_hom 1 comp_char by auto
                show "Cod (F \<odot> ?G) = Cod (cod F)"
                  using F_in_hom G_in_hom 1 comp_char by auto
                show "Map (F \<odot> ?G) = Map (cod F)"
                proof -
                  have "Map (F \<odot> ?G) = Comp \<lbrakk>f\<rbrakk>\<^sub>B \<lbrakk>g\<rbrakk>\<^sub>B"
                    using 1 comp_char [of F ?G] `Map F = \<lbrakk>f\<rbrakk>\<^sub>B` by simp
                  also have "... = \<lbrakk>f \<star> g\<rbrakk>\<^sub>B"
                  proof -
                    have "f \<star> g \<in> Comp \<lbrakk>f\<rbrakk>\<^sub>B \<lbrakk>g\<rbrakk>\<^sub>B"
                      by (metis \<epsilon>.antipar(1) \<epsilon>.ide_left \<epsilon>.ide_right B.ide_hcomp
                          B.ide_in_iso_class in_CompI B.is_iso_classI B.isomorphic_reflexive)
                    thus ?thesis
                      using Comp_eq_iso_class_memb F_in_hom G_in_hom arr_char arr_char
                            `Map F = \<lbrakk>f\<rbrakk>\<^sub>B`
                      by auto
                  qed
                  also have "... = \<lbrakk>trg f\<rbrakk>\<^sub>B"
                  proof -
                    have "trg f \<in> \<lbrakk>f \<star> g\<rbrakk>\<^sub>B"
                      using \<epsilon>.counit_in_hom \<epsilon>.counit_is_iso B.isomorphic_def B.iso_class_def
                            B.isomorphic_symmetric
                      by blast
                    thus ?thesis
                      using B.iso_class_eqI
                      by (metis \<epsilon>.antipar(1) \<epsilon>.ide_left \<epsilon>.ide_right B.ide_hcomp
                          B.ide_in_iso_class B.is_iso_classI B.iso_class_elems_isomorphic)
                  qed
                  also have "... = \<lbrakk>Cod F\<rbrakk>\<^sub>B"
                    using f_in_hhom by auto
                  also have "... = Map (cod F)"
                    using F_in_hom dom_char by auto
                  finally show ?thesis by blast
                qed
              qed
              thus ?thesis
                using F by simp
            qed
          qed
          thus ?thesis by auto
        qed
      qed
 
      lemma iso_char':
      shows "iso F \<longleftrightarrow> arr F \<and> (\<exists>f. f \<in> Map F \<and> B.equivalence_map f)"
      proof -
        have "arr F \<Longrightarrow> (\<forall>f. f \<in> Map F \<longrightarrow> B.equivalence_map f) \<longleftrightarrow>
                        (\<exists>f. f \<in> Map F \<and> B.equivalence_map f)"
        proof
          assume F: "arr F"
          show "(\<forall>f. f \<in> Map F \<longrightarrow> B.equivalence_map f) \<Longrightarrow>
                (\<exists>f. f \<in> Map F \<and> B.equivalence_map f)"
            using F arr_char in_HomD(1) by blast
          show "(\<exists>f. f \<in> Map F \<and> B.equivalence_map f) \<Longrightarrow>
                (\<forall>f. f \<in> Map F \<longrightarrow> B.equivalence_map f)"
            by (metis (no_types, lifting) F is_concrete_category concrete_category.arr_char
                B.equivalence_map_preserved_by_iso in_HomD(2) B.iso_class_elems_isomorphic)
        qed
        thus ?thesis
          using iso_char by blast
      qed
 
      text \<open>
        The following mapping takes a map in \<open>B\<close> to the corresponding arrow of \<open>Maps(B)\<close>.
      \<close>
 
      abbreviation CLS  ("\<lbrakk>\<lbrakk>_\<rbrakk>\<rbrakk>")
      where "\<lbrakk>\<lbrakk>f\<rbrakk>\<rbrakk> \<equiv> MkArr (src f) (trg f) \<lbrakk>f\<rbrakk>\<^sub>B"
 
      lemma ide_CLS_obj:
      assumes "B.obj a"
      shows "ide \<lbrakk>\<lbrakk>a\<rbrakk>\<rbrakk>"
-       by (simp add: assms)
+       by (simp add: assms B.obj_simps)
 
      lemma CLS_in_hom:
      assumes "B.is_left_adjoint f"
      shows "\<guillemotleft>\<lbrakk>\<lbrakk>f\<rbrakk>\<rbrakk> : \<lbrakk>\<lbrakk>src f\<rbrakk>\<rbrakk> \<rightarrow> \<lbrakk>\<lbrakk>trg f\<rbrakk>\<rbrakk>\<guillemotright>"
        using assms B.left_adjoint_is_ide MkArr_in_hom MkArr_in_hom' by simp
 
      lemma CLS_eqI:
      assumes "B.ide f"
      shows "\<lbrakk>\<lbrakk>f\<rbrakk>\<rbrakk> = \<lbrakk>\<lbrakk>g\<rbrakk>\<rbrakk> \<longleftrightarrow> f \<cong>\<^sub>B g"
        by (metis arr.inject assms B.ide_in_iso_class B.iso_class_def B.iso_class_eqI
            B.isomorphic_implies_hpar(3) B.isomorphic_implies_hpar(4) B.isomorphic_symmetric
            mem_Collect_eq)
 
      lemma CLS_hcomp:
      assumes "B.ide f" and "B.ide g" and "src f = trg g"
      shows "\<lbrakk>\<lbrakk>f \<star> g\<rbrakk>\<rbrakk> = MkArr (src g) (trg f) (Comp \<lbrakk>f\<rbrakk>\<^sub>B \<lbrakk>g\<rbrakk>\<^sub>B)"
      proof -
        have "\<lbrakk>\<lbrakk>f \<star> g\<rbrakk>\<rbrakk> = MkArr (src g) (trg f) \<lbrakk>f \<star> g\<rbrakk>\<^sub>B"
          using assms B.left_adjoint_is_ide by simp
        moreover have "\<lbrakk>f \<star> g\<rbrakk>\<^sub>B = Comp \<lbrakk>f\<rbrakk>\<^sub>B \<lbrakk>g\<rbrakk>\<^sub>B"
        proof
          show "\<lbrakk>f \<star> g\<rbrakk>\<^sub>B \<subseteq> Comp \<lbrakk>f\<rbrakk>\<^sub>B \<lbrakk>g\<rbrakk>\<^sub>B"
            by (metis assms(1-2) B.ide_in_iso_class in_CompI B.is_iso_classI
                B.iso_class_def mem_Collect_eq subsetI)
          show "Comp \<lbrakk>f\<rbrakk>\<^sub>B \<lbrakk>g\<rbrakk>\<^sub>B \<subseteq> \<lbrakk>f \<star> g\<rbrakk>\<^sub>B"
            by (metis Comp_eq_iso_class_memb \<open>\<lbrakk>f \<star> g\<rbrakk>\<^sub>B \<subseteq> Comp \<lbrakk>f\<rbrakk>\<^sub>B \<lbrakk>g\<rbrakk>\<^sub>B\<close>
                assms(1-3) B.ide_hcomp B.ide_in_iso_class subset_iff)
        qed
        ultimately show ?thesis by simp
      qed
 
      lemma comp_CLS:
      assumes "B.is_left_adjoint f" and "B.is_left_adjoint g" and "f \<star> g \<cong>\<^sub>B h"
      shows "\<lbrakk>\<lbrakk>f\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>g\<rbrakk>\<rbrakk> = \<lbrakk>\<lbrakk>h\<rbrakk>\<rbrakk>"
      proof -
        have hseq_fg: "B.hseq f g"
          using assms B.isomorphic_implies_hpar(1) by simp
        have "seq \<lbrakk>\<lbrakk>f\<rbrakk>\<rbrakk> \<lbrakk>\<lbrakk>g\<rbrakk>\<rbrakk>"
          using assms hseq_fg CLS_in_hom [of f] CLS_in_hom [of g]  
          apply (elim B.hseqE) by auto
        hence "\<lbrakk>\<lbrakk>f\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>g\<rbrakk>\<rbrakk> = MkArr (src g) (trg f) (Comp \<lbrakk>f\<rbrakk>\<^sub>B \<lbrakk>g\<rbrakk>\<^sub>B)"
          using comp_char [of "CLS f" "CLS g"] by simp
        also have "... = \<lbrakk>\<lbrakk>f \<star> g\<rbrakk>\<rbrakk>"
          using assms hseq_fg CLS_hcomp
          apply (elim B.hseqE)
          using B.adjoint_pair_antipar(1) by auto
        also have "... = \<lbrakk>\<lbrakk>h\<rbrakk>\<rbrakk>"
          using assms B.isomorphic_symmetric
          by (simp add: assms(3) B.iso_class_eqI B.isomorphic_implies_hpar(3)
              B.isomorphic_implies_hpar(4))
        finally show ?thesis by simp
      qed
 
      text \<open>
        The following mapping that takes an arrow of \<open>Maps(B)\<close> and chooses some
        representative map in \<open>B\<close>.
      \<close>
 
      definition REP
      where "REP F \<equiv> if arr F then SOME f. f \<in> Map F else B.null"
 
      lemma REP_in_Map:
      assumes "arr A"
      shows "REP A \<in> Map A"
      proof -
        have "Map A \<noteq> {}"
          using assms arr_char in_HomD(1) by blast
        thus ?thesis
          using assms REP_def someI_ex [of "\<lambda>f. f \<in> Map A"] by auto
      qed
 
      lemma REP_in_hhom [intro]:
      assumes "in_hom F A B"
      shows "\<guillemotleft>REP F : src (REP A) \<rightarrow>\<^sub>B src (REP B)\<guillemotright>"
      and "B.is_left_adjoint (REP F)"
      proof -
        have "Map F \<noteq> {}"
          using assms in_hom_char arr_char null_char in_HomD(1) [of "Map F" "Dom F" "Cod F"]
          by blast
        hence 1: "REP F \<in> Map F"
          using assms REP_def someI_ex [of "\<lambda>f. f \<in> Map F"] by auto
        hence 2: "B.arr (REP F)"
          using assms 1 in_hom_char [of F A B] B.iso_class_def Map_memb_in_hhom B.in_hhom_def
          by blast
        hence "\<guillemotleft>REP F : Dom A \<rightarrow>\<^sub>B Dom B\<guillemotright>"
          using assms 1 in_hom_char [of F A B] Map_memb_in_hhom by auto
        thus "\<guillemotleft>REP F : src (REP A) \<rightarrow>\<^sub>B src (REP B)\<guillemotright>"
          using assms
          by (metis (no_types, lifting) Map_memb_in_hhom ideD(1)
              in_homI in_hom_char REP_in_Map B.in_hhom_def)
        have "REP F \<in> \<lbrakk>REP F\<rbrakk>\<^sub>B"
          using assms 1 2 arr_char [of F] in_HomD(6) B.ide_in_iso_class B.iso_class_memb_is_ide
                in_hom_char
          by blast
        thus "B.is_left_adjoint (REP F)"
          using assms 1 2 arr_char in_HomD(5) [of "Map F" "Dom F" "Cod F" "REP F"]
          by auto
      qed
 
      lemma ide_REP:
      assumes "arr A"
      shows "B.ide (REP A)"
        using assms REP_in_hhom(2) B.adjoint_pair_antipar(1) by blast
 
      lemma REP_simps [simp]:
      assumes "arr A"
      shows "B.ide (REP A)"
      and "src (REP A) = Dom A" and "trg (REP A) = Cod A"
      and "B.dom (REP A) = REP A" and "B.cod (REP A) = REP A"
      proof -
        show "B.ide (REP A)"
          using assms ide_REP by blast
        show "src (REP A) = Dom A"
          using assms REP_in_hhom
          by (metis (no_types, lifting) Map_memb_in_hhom Dom_dom in_homI
              REP_in_Map B.in_hhom_def)
        show "trg (REP A) = Cod A"
          using assms REP_in_hhom
          by (metis (no_types, lifting) Map_memb_in_hhom Dom_cod in_homI
              REP_in_Map B.in_hhom_def)
        show "B.dom (REP A) = REP A"
          using assms in_homI REP_in_hhom(2) B.adjoint_pair_antipar(1) B.ideD(2)
          by blast
        show "B.cod (REP A) = REP A"
          using assms in_homI REP_in_hhom(2) B.adjoint_pair_antipar(1) B.ideD(3)
          by blast
      qed
 
      lemma isomorphic_REP_src:
      assumes "ide A"
      shows "REP A \<cong>\<^sub>B src (REP A)"
        using assms
        by (metis (no_types, lifting) ideD(1) ide_char REP_in_Map ide_REP
            REP_simps(2) B.is_iso_classI B.ide_in_iso_class B.iso_class_elems_isomorphic
            B.src.preserves_ide)
 
      lemma isomorphic_REP_trg:
      assumes "ide A"
      shows "REP A \<cong>\<^sub>B trg (REP A)"
        using assms ide_char isomorphic_REP_src by auto
 
      lemma CLS_REP:
      assumes "arr F"
      shows "\<lbrakk>\<lbrakk>REP F\<rbrakk>\<rbrakk> = F"
        by (metis (mono_tags, lifting) MkArr_Map
            is_concrete_category REP_in_Map REP_simps(2) REP_simps(3) assms
            concrete_category.Map_in_Hom in_HomD(6))
 
      lemma REP_CLS:
      assumes "B.is_left_adjoint f"
      shows "REP \<lbrakk>\<lbrakk>f\<rbrakk>\<rbrakk> \<cong>\<^sub>B f"
        by (metis (mono_tags, lifting) CLS_in_hom Map.simps(1) in_homE REP_in_Map
            assms B.iso_class_def B.isomorphic_symmetric mem_Collect_eq)
 
      lemma isomorphic_hcomp_REP:
      assumes "seq F G"
      shows "REP F \<star> REP G \<cong>\<^sub>B REP (F \<odot> G)"
      proof -
        have 1: "Dom F = Cod G"
          using assms seq_char by simp
        have 2: "Map F = B.iso_class (REP F)"
          using assms seq_char arr_char REP_in_Map in_HomD(6) by meson
        have 3: "Map G = B.iso_class (REP G)"
          using assms seq_char arr_char REP_in_Map
                in_HomD(6) [of "Map G" "Dom G" "Cod G" "REP G"]
          by auto
        have "Map (F \<odot> G) = Comp \<lbrakk>REP F\<rbrakk>\<^sub>B \<lbrakk>REP G\<rbrakk>\<^sub>B"
          using assms seq_char null_char
          by (metis (no_types, lifting) CLS_REP Map.simps(1) Map_comp)
        have "Comp \<lbrakk>REP F\<rbrakk>\<^sub>B \<lbrakk>REP G\<rbrakk>\<^sub>B = \<lbrakk>REP F \<star> REP G\<rbrakk>\<^sub>B"
        proof -
          have "REP F \<star> REP G \<in> Comp \<lbrakk>REP F\<rbrakk>\<^sub>B \<lbrakk>REP G\<rbrakk>\<^sub>B"
          proof -
            have "REP F \<in> Map F \<and> REP G \<in> Map G"
              using assms seq_char REP_in_Map by auto
            moreover have "REP F \<star> REP G \<cong>\<^sub>B REP F \<star> REP G"
              using assms seq_char 2 B.isomorphic_reflexive by auto                   
            ultimately show ?thesis
              using assms 1 2 3 B.iso_class_def B.is_iso_class_def
              by (intro in_CompI, auto)
          qed
          moreover have "\<lbrakk>REP F\<rbrakk>\<^sub>B \<in> Hom (Cod G) (Cod F)"
            using assms 1 2 arr_char [of F] by auto
          moreover have "\<lbrakk>REP G\<rbrakk>\<^sub>B \<in> Hom (Dom G) (Cod G)"
            using assms 1 3 arr_char [of G] by auto
          ultimately show ?thesis
            using Comp_eq_iso_class_memb assms arr_char arr_char REP_in_Map
            by (simp add: Comp_def)
        qed
        moreover have "REP (F \<odot> G) \<in> Comp \<lbrakk>REP F\<rbrakk>\<^sub>B \<lbrakk>REP G\<rbrakk>\<^sub>B"
        proof -
          have "Map (F \<odot> G) = Comp (Map F) (Map G)"
            using assms 1 comp_char [of F G] by simp
          thus ?thesis
            using assms 1 2 3 REP_in_Map [of "F \<odot> G"] by simp
        qed
        ultimately show ?thesis
          using B.iso_class_def by simp
      qed
 
      text \<open>
        We now show that \<open>Maps(B)\<close> has pullbacks.  For this we need to exhibit
        functions \<open>PRJ\<^sub>0\<close> and \<open>PRJ\<^sub>1\<close> that produce the legs of the pullback of a cospan \<open>(H, K)\<close>
        and verify that they have the required universal property.  These are obtained by
        choosing representatives \<open>h\<close> and \<open>k\<close> of \<open>H\<close> and \<open>K\<close>, respectively, and then taking
        \<open>PRJ\<^sub>0 = CLS (tab\<^sub>0 (k\<^sup>* \<star> h))\<close> and \<open>PRJ\<^sub>1 = CLS (tab\<^sub>1 (k\<^sup>* \<star> h))\<close>.  That these constitute a
        pullback in \<open>Maps(B)\<close> follows from the fact that \<open>tab\<^sub>0 (k\<^sup>* \<star> h)\<close> and \<open>tab\<^sub>1 (k\<^sup>* \<star> h)\<close>
        form a pseudo-pullback of \<open>(h, k)\<close> in the underlying bicategory.
 
        For our purposes here, it is not sufficient simply to show that \<open>Maps(B)\<close> has pullbacks
        and then to treat it as an abstract ``category with pullbacks'' where the pullbacks
        are chosen arbitrarily.  Instead, we have to retain the connection between a pullback
        in Maps and the tabulation of \<open>k\<^sup>* \<star> h\<close> that is ultimately used to obtain it.  If we don't
        do this, then it becomes problematic to define the compositor of a pseudofunctor from
        the underlying bicategory \<open>B\<close> to \<open>Span(Maps(B))\<close>, because the components will go from the
        apex of a composite span (obtained by pullback) to the apex of a tabulation (chosen
        arbitrarily using \<open>BS2\<close>) and these need not be in agreement with each other.
      \<close>
 
      definition PRJ\<^sub>0
      where "PRJ\<^sub>0 \<equiv> \<lambda>K H. if cospan K H then \<lbrakk>\<lbrakk>B.tab\<^sub>0 ((REP K)\<^sup>* \<star> (REP H))\<rbrakk>\<rbrakk> else null"
      definition PRJ\<^sub>1
      where "PRJ\<^sub>1 \<equiv> \<lambda>K H. if cospan K H then \<lbrakk>\<lbrakk>B.tab\<^sub>1 ((REP K)\<^sup>* \<star> (REP H))\<rbrakk>\<rbrakk> else null"
 
      interpretation elementary_category_with_pullbacks comp PRJ\<^sub>0 PRJ\<^sub>1
      proof
        show "\<And>H K. \<not> cospan K H \<Longrightarrow> PRJ\<^sub>0 K H = null"
          unfolding PRJ\<^sub>0_def by auto
        show "\<And>H K. \<not> cospan K H \<Longrightarrow> PRJ\<^sub>1 K H = null"
          unfolding PRJ\<^sub>1_def by auto
        show "\<And>H K. cospan K H \<Longrightarrow> commutative_square K H (PRJ\<^sub>1 K H) (PRJ\<^sub>0 K H)"
        proof -
          fix H K
          assume HK: "cospan K H"
          define h where "h = REP H"
          define k where "k = REP K"
          have h: "h \<in> Map H"
            using h_def HK REP_in_Map by blast
          have k: "k \<in> Map K"
            using k_def HK REP_in_Map by blast
          have 1: "B.is_left_adjoint h \<and> B.is_left_adjoint k \<and> B.ide h \<and> B.ide k \<and> trg h = trg k"
            using h k h_def k_def HK arr_char cod_char B.in_hhom_def B.left_adjoint_is_ide
                  in_HomD(5) [of "Map H" "Dom H" "Cod H" h]
                  in_HomD(5) [of "Map K" "Dom K" "Cod K" k]
            apply auto
            by (metis (no_types, lifting) HK Dom_cod)
          interpret h: map_in_bicategory \<open>(\<cdot>)\<close> \<open>(\<star>)\<close> \<a> \<i> src trg h
            using 1 by unfold_locales auto
          interpret k: map_in_bicategory \<open>(\<cdot>)\<close> \<open>(\<star>)\<close> \<a> \<i> src trg k
            using 1 by unfold_locales auto
          interpret hk: cospan_of_maps_in_bicategory_of_spans \<open>(\<cdot>)\<close> \<open>(\<star>)\<close> \<a> \<i> src trg h k
            using 1 by unfold_locales auto
          let ?f = "B.tab\<^sub>0 (k\<^sup>* \<star> h)"
          let ?g = "B.tab\<^sub>1 (k\<^sup>* \<star> h)"
          have span: "span \<lbrakk>\<lbrakk>?f\<rbrakk>\<rbrakk> \<lbrakk>\<lbrakk>?g\<rbrakk>\<rbrakk>"
            using dom_char CLS_in_hom [of ?f] CLS_in_hom [of ?g] by auto
          have seq: "seq H \<lbrakk>\<lbrakk>?f\<rbrakk>\<rbrakk>"
            using HK seq_char hk.leg0_is_map CLS_in_hom h_def hk.p\<^sub>0_simps hk.satisfies_T0
            by fastforce
          have seq': "seq K \<lbrakk>\<lbrakk>?g\<rbrakk>\<rbrakk>"
            using HK k arr_char dom_char cod_char in_HomD(5) hk.leg1_is_map CLS_in_hom
            by (metis (no_types, lifting) Cod.simps(1) seq_char REP_simps(2)
                hk.p\<^sub>1_simps k_def span)
          show "commutative_square K H (PRJ\<^sub>1 K H) (PRJ\<^sub>0 K H)"
          proof
            show "cospan K H"
              using HK by simp
            show "dom K = cod (PRJ\<^sub>1 K H)"
              using seq' PRJ\<^sub>1_def HK h_def k_def by auto
            show "span (PRJ\<^sub>1 K H) (PRJ\<^sub>0 K H)"
              unfolding PRJ\<^sub>0_def PRJ\<^sub>1_def using HK span h_def k_def by simp
            show "K \<odot> PRJ\<^sub>1 K H = H \<odot> PRJ\<^sub>0 K H"
            proof -
              have iso: "h \<star> ?f \<cong>\<^sub>B k \<star> ?g"
                using hk.\<phi>_uniqueness B.isomorphic_symmetric B.isomorphic_def by blast
              have *: "Comp (Map H) \<lbrakk>?f\<rbrakk>\<^sub>B = Comp (Map K) \<lbrakk>?g\<rbrakk>\<^sub>B"
              proof (intro Comp_eqI)
                show "h \<star> ?f \<in> Comp (Map H) \<lbrakk>B.tab\<^sub>0 (k\<^sup>* \<star> h)\<rbrakk>\<^sub>B"
                proof (unfold Comp_def)
                  have "B.is_iso_class \<lbrakk>?f\<rbrakk>\<^sub>B"
                    by (simp add: B.is_iso_classI)
                  moreover have "B.is_iso_class (Map H)"
                    using CLS_REP HK Map.simps(1) B.is_iso_classI h.ide_left h_def
                    by (metis (no_types, lifting))
                  moreover have "?f \<in> \<lbrakk>B.tab\<^sub>0 (k\<^sup>* \<star> h)\<rbrakk>\<^sub>B"
                    by (simp add: B.ide_in_iso_class(1))
                  moreover have "\<guillemotleft>?f : src (B.tab\<^sub>0 (k\<^sup>* \<star> h)) \<rightarrow>\<^sub>B Dom H\<guillemotright>"
                    using seq seq_char by simp
                  moreover have "h \<in> Map H"
                    by fact
                  moreover have "\<guillemotleft>h : Dom H \<rightarrow>\<^sub>B Cod H\<guillemotright>"
                    by (simp add: HK h_def)
                  moreover have "h \<star> ?f \<cong>\<^sub>B h \<star> ?f"
                    using B.isomorphic_reflexive by auto
                  ultimately show "h \<star> B.tab\<^sub>0 (k\<^sup>* \<star> h)
                                     \<in> {h'. B.is_iso_class \<lbrakk>B.tab\<^sub>0 (k\<^sup>* \<star> h)\<rbrakk>\<^sub>B \<and>
                                            B.is_iso_class (Map H) \<and>
                                            (\<exists>f g. f \<in> \<lbrakk>B.tab\<^sub>0 (k\<^sup>* \<star> h)\<rbrakk>\<^sub>B \<and>
                                                   g \<in> Map H \<and> g \<star> f \<cong>\<^sub>B h')}"
                    by auto
                qed
                show "k \<star> ?g \<in> Comp (Map K) \<lbrakk>B.tab\<^sub>1 (k\<^sup>* \<star> h)\<rbrakk>\<^sub>B"
                proof (unfold Comp_def)
                  have "B.is_iso_class \<lbrakk>?g\<rbrakk>\<^sub>B"
                    by (simp add: B.is_iso_classI)
                  moreover have "B.is_iso_class (Map K)"
                    by (metis (no_types, lifting) CLS_REP HK Map.simps(1)
                        B.is_iso_classI k.ide_left k_def)
                  moreover have "?g \<in> \<lbrakk>B.tab\<^sub>1 (k\<^sup>* \<star> h)\<rbrakk>\<^sub>B"
                    by (simp add: B.ide_in_iso_class(1))
                  moreover have "\<guillemotleft>?g : src (B.tab\<^sub>1 (k\<^sup>* \<star> h)) \<rightarrow>\<^sub>B Dom K\<guillemotright>"
                    using seq seq_char B.in_hhom_def seq' by auto
                  moreover have "k \<in> Map K"
                    by fact
                  moreover have "\<guillemotleft>k : Dom K \<rightarrow>\<^sub>B Cod K\<guillemotright>"
                    by (simp add: HK k_def)
                  moreover have "k \<star> ?g \<cong>\<^sub>B k \<star> ?g"
                    using B.isomorphic_reflexive iso B.isomorphic_implies_hpar(2) by auto
                  ultimately show "k \<star> B.tab\<^sub>1 (k\<^sup>* \<star> h)
                                     \<in> {h'. B.is_iso_class \<lbrakk>B.tab\<^sub>1 (k\<^sup>* \<star> h)\<rbrakk>\<^sub>B \<and>
                                            B.is_iso_class (Map K) \<and>
                                            (\<exists>f g. f \<in> \<lbrakk>B.tab\<^sub>1 (k\<^sup>* \<star> h)\<rbrakk>\<^sub>B \<and>
                                                   g \<in> Map K \<and> g \<star> f \<cong>\<^sub>B h')}"
                    by auto
                qed
                show "h \<star> ?f \<cong>\<^sub>B k \<star> ?g"
                  using iso by simp
              qed
              have "K \<odot> PRJ\<^sub>1 K H = K \<odot> \<lbrakk>\<lbrakk>?g\<rbrakk>\<rbrakk>"
                unfolding PRJ\<^sub>1_def using HK h_def k_def by simp
              also have "... = MkArr (src ?g) (Cod K) (Comp (Map K) \<lbrakk>?g\<rbrakk>\<^sub>B)"
                using seq' comp_char [of K "\<lbrakk>\<lbrakk>?g\<rbrakk>\<rbrakk>"] by simp
              also have "... = MkArr (src ?f) (Cod H) (Comp (Map H) \<lbrakk>?f\<rbrakk>\<^sub>B)"
                using * HK cod_char by auto
              also have "... = comp H \<lbrakk>\<lbrakk>?f\<rbrakk>\<rbrakk>"
                using seq comp_char [of H "\<lbrakk>\<lbrakk>?f\<rbrakk>\<rbrakk>"] by simp
              also have "... = comp H (PRJ\<^sub>0 K H)"
                unfolding PRJ\<^sub>0_def using HK h_def k_def by simp
              finally show ?thesis by simp
            qed
          qed
        qed
        show "\<And>H K U V. commutative_square K H V U \<Longrightarrow>
                         \<exists>!E. comp (PRJ\<^sub>1 K H) E = V \<and> comp (PRJ\<^sub>0 K H) E = U"
        proof -
          fix H K U V
          assume cs: "commutative_square K H V U"
          have HK: "cospan K H"
            using cs by auto
          (* TODO: Is there any way to avoid this repetition? *)
          define h where "h = REP H"
          define k where "k = REP K"
          have h: "h \<in> Map H"
            using h_def HK REP_in_Map by blast
          have k: "k \<in> Map K"
            using k_def HK REP_in_Map by blast
          have 1: "B.is_left_adjoint h \<and> B.is_left_adjoint k \<and> B.ide h \<and> B.ide k \<and> trg h = trg k"
            using h k h_def k_def HK arr_char cod_char B.in_hhom_def B.left_adjoint_is_ide
                  in_HomD(5) [of "Map H" "Dom H" "Cod H" h]
                  in_HomD(5) [of "Map K" "Dom K" "Cod K" k]
            apply auto
            by (metis (no_types, lifting) HK Dom_cod)
          interpret h: map_in_bicategory \<open>(\<cdot>)\<close> \<open>(\<star>)\<close> \<a> \<i> src trg h
            using 1 by unfold_locales auto
          interpret k: map_in_bicategory \<open>(\<cdot>)\<close> \<open>(\<star>)\<close> \<a> \<i> src trg k
            using 1 by unfold_locales auto
          interpret hk: cospan_of_maps_in_bicategory_of_spans \<open>(\<cdot>)\<close> \<open>(\<star>)\<close> \<a> \<i> src trg h k
            using 1 by unfold_locales auto
          let ?f = "B.tab\<^sub>0 (k\<^sup>* \<star> h)"
          let ?g = "B.tab\<^sub>1 (k\<^sup>* \<star> h)"
          have seq_HU: "seq H U"
            using cs by auto 
          have seq_KV: "seq K V"
            using cs by auto 
          let ?u = "REP U"
          let ?v = "REP V"
          have u: "B.ide ?u"
            using ide_REP seq_HU by auto
          have v: "B.ide ?v"
            using ide_REP seq_KV by auto
          have u_is_map: "B.is_left_adjoint ?u"
            using u seq_HU REP_in_Map arr_char [of U]
                  in_HomD(5) [of "Map U" "Dom U" "Cod U" ?u]
            by auto
          have v_is_map: "B.is_left_adjoint ?v"
            using v seq_KV REP_in_Map arr_char [of V]
                  in_HomD(5) [of "Map V" "Dom V" "Cod V" ?v]
            by auto
          have *: "h \<star> ?u \<cong>\<^sub>B k \<star> ?v"
          proof -
            have "h \<star> ?u \<cong>\<^sub>B REP (H \<odot> U)"
            proof -
              have "h \<star> ?u \<cong>\<^sub>B REP H \<star> ?u"
              proof -
                have "h \<cong>\<^sub>B REP H"
                  using h h_def HK arr_char REP_in_Map B.iso_class_elems_isomorphic
                        in_HomD(5) [of "Map H" "Dom H" "Cod H" h] B.isomorphic_reflexive
                  by auto
                thus ?thesis
                  using h_def seq_HU B.isomorphic_implies_hpar(1) B.isomorphic_reflexive
                  by (simp add: seq_char)
              qed
              also have "...  \<cong>\<^sub>B REP (H \<odot> U)"
                using seq_HU isomorphic_hcomp_REP isomorphic_def by blast
              finally show ?thesis by blast
            qed
            also have "... \<cong>\<^sub>B REP (K \<odot> V)"
              using seq_HU cs B.isomorphic_reflexive by auto
            also have "... \<cong>\<^sub>B (k \<star> ?v)"
            proof -
              have "... \<cong>\<^sub>B REP K \<star> ?v"
                using seq_KV isomorphic_hcomp_REP B.isomorphic_def B.isomorphic_symmetric
                by blast
              also have "... \<cong>\<^sub>B k \<star> ?v"
              proof -
                have "k \<cong>\<^sub>B REP K"
                  using k k_def HK arr_char REP_in_Map B.iso_class_elems_isomorphic
                        in_HomD(5) [of "Map K" "Dom K" "Cod K" k] B.isomorphic_reflexive
                  by auto
                thus ?thesis
                  using k_def seq_KV B.isomorphic_implies_hpar(1) B.isomorphic_reflexive
                  by (simp add: seq_char)
              qed 
              finally show ?thesis by blast
            qed
            finally show ?thesis by blast
          qed
          have hseq_hu: "src h = trg ?u"
            using * B.isomorphic_implies_hpar
            by (meson B.hseqE B.ideD(1))
          have hseq_kv: "src k = trg ?v"
            using * B.isomorphic_implies_hpar
            by (meson B.hseqE B.ideD(1))
 
          obtain w where w: "B.is_left_adjoint w \<and> ?f \<star> w \<cong>\<^sub>B ?u \<and> ?v \<cong>\<^sub>B (?g \<star> w)"
            using * u_is_map v_is_map hk.has_pseudo_pullback [of ?u ?v] B.isomorphic_symmetric
            by blast
          have w_in_hom: "\<guillemotleft>w : src ?u \<rightarrow>\<^sub>B src ?f\<guillemotright> \<and> B.ide w"
            using w B.left_adjoint_is_ide B.src_cod B.trg_cod B.isomorphic_def
            by (metis B.hseqE B.ideD(1) B.in_hhom_def B.isomorphic_implies_hpar(3)
                B.isomorphic_implies_ide(1) B.src_hcomp)
          let ?W = "CLS w"
          have W: "\<guillemotleft>?W : dom U \<rightarrow> dom \<lbrakk>\<lbrakk>?f\<rbrakk>\<rbrakk>\<guillemotright>"
          proof
            show "arr ?W"
              using w CLS_in_hom by blast
            thus "dom ?W = dom U"
              using w_in_hom dom_char REP_in_hhom(1) CLS_in_hom
              by (metis (no_types, lifting) Dom.simps(1) commutative_squareE
                  dom_char REP_simps(2) cs B.in_hhomE)
            show "cod ?W = dom \<lbrakk>\<lbrakk>?f\<rbrakk>\<rbrakk>"
            proof -
              have "src ?f = trg w"
                by (metis (lifting) B.in_hhomE w_in_hom)
              thus ?thesis
                using CLS_in_hom [of ?f] CLS_in_hom [of w] hk.satisfies_T0 w by fastforce
            qed
          qed
          show "\<exists>!E. PRJ\<^sub>1 K H \<odot> E = V \<and> PRJ\<^sub>0 K H \<odot> E = U"
          proof -
            have "PRJ\<^sub>1 K H \<odot> ?W = V \<and> PRJ\<^sub>0 K H \<odot> ?W = U"
            proof -
              have "\<lbrakk>\<lbrakk>?f\<rbrakk>\<rbrakk> \<odot> ?W = U"
                using w w_in_hom u CLS_in_hom comp_CLS
                      B.isomorphic_symmetric CLS_REP hk.leg0_is_map
                by (metis (mono_tags, lifting) commutative_square_def cs)
              moreover have "\<lbrakk>\<lbrakk>?g\<rbrakk>\<rbrakk> \<odot> ?W = V"
                using w w_in_hom v CLS_in_hom comp_CLS
                      B.isomorphic_symmetric CLS_REP hk.leg1_is_map
                by (metis (mono_tags, lifting) commutative_square_def cs)
              ultimately show ?thesis
                using HK h_def k_def PRJ\<^sub>0_def PRJ\<^sub>1_def by auto
            qed
            moreover have
              "\<And>W'. PRJ\<^sub>1 K H \<odot> W' = V \<and> PRJ\<^sub>0 K H \<odot> W' = U \<Longrightarrow> W' = ?W"
            proof -
               fix W'
               assume "PRJ\<^sub>1 K H \<odot> W' = V \<and> PRJ\<^sub>0 K H \<odot> W' = U"
               hence W': "\<guillemotleft>W' : dom U \<rightarrow> dom \<lbrakk>\<lbrakk>?f\<rbrakk>\<rbrakk>\<guillemotright> \<and> \<lbrakk>\<lbrakk>?f\<rbrakk>\<rbrakk> \<odot> W' = U \<and> \<lbrakk>\<lbrakk>?g\<rbrakk>\<rbrakk> \<odot> W' = V"
                 using PRJ\<^sub>0_def PRJ\<^sub>1_def HK h_def k_def apply simp
                 using cs arr_iff_in_hom by blast
               let ?w' = "REP W'"
               have w': "B.ide ?w'"
                 using W' ide_REP by auto
 
               have fw'_iso_u: "?f \<star> ?w' \<cong>\<^sub>B ?u"
               proof -
                 have "?f \<star> ?w' \<cong>\<^sub>B REP \<lbrakk>\<lbrakk>?f\<rbrakk>\<rbrakk> \<star> ?w'"
                   by (metis (no_types, lifting) Cod.simps(1) in_hom_char
                       REP_CLS REP_simps(3) W W' B.hcomp_isomorphic_ide hk.satisfies_T0
                       B.in_hhomE B.isomorphic_symmetric w' w_in_hom)
                 also have "REP \<lbrakk>\<lbrakk>?f\<rbrakk>\<rbrakk> \<star> ?w' \<cong>\<^sub>B ?u"
                    using W' isomorphic_hcomp_REP cs by blast
                 finally show ?thesis by blast
               qed
 
               have gw'_iso_v: "?g \<star> ?w' \<cong>\<^sub>B ?v"
               proof -
                 have "?g \<star> ?w' \<cong>\<^sub>B REP \<lbrakk>\<lbrakk>?g\<rbrakk>\<rbrakk> \<star> ?w'"
                 proof -
                   have "?g \<cong>\<^sub>B REP \<lbrakk>\<lbrakk>?g\<rbrakk>\<rbrakk>"
                     using REP_CLS B.isomorphic_symmetric hk.leg1_is_map by blast
                   moreover have "B.ide (REP W')"
                     using W' by auto
                   moreover have "src ?f = trg ?w'"
                     using w_in_hom W W' in_hom_char arr_char B.in_hhom_def
                     by (meson fw'_iso_u B.hseqE B.ideD(1) B.isomorphic_implies_ide(1))
                   ultimately show ?thesis
                     using B.hcomp_isomorphic_ide by simp
                 qed
                 also have "... \<cong>\<^sub>B ?v"
                    using W' isomorphic_hcomp_REP cs by blast
                 finally show ?thesis by blast
               qed
 
               show "W' = ?W"
               proof -
                 have "W' = \<lbrakk>\<lbrakk>?w'\<rbrakk>\<rbrakk>"
                   using w' W' CLS_REP by auto
                 also have "... = ?W"
                 proof -
                   have "?w' \<cong>\<^sub>B w"
                     using * w W' hk.has_pseudo_pullback(2) u_is_map v_is_map
                           B.isomorphic_symmetric fw'_iso_u gw'_iso_v
                     by blast
                   thus ?thesis
                     using CLS_eqI B.iso_class_eqI w' by blast
                 qed
                 finally show ?thesis by blast
               qed
             qed
             ultimately show ?thesis by auto
           qed
         qed
       qed
 
     lemma is_elementary_category_with_pullbacks:
     shows "elementary_category_with_pullbacks comp PRJ\<^sub>0 PRJ\<^sub>1"
        ..
 
     lemma is_category_with_pullbacks:
     shows "category_with_pullbacks comp"
       ..
 
     sublocale elementary_category_with_pullbacks comp PRJ\<^sub>0 PRJ\<^sub>1
       using is_elementary_category_with_pullbacks by simp
 
   end
 
   text \<open>
     Here we relate the projections of the chosen pullbacks in \<open>Maps(B)\<close> to the
     projections associated with the chosen tabulations in \<open>B\<close>.
   \<close>
 
   context composite_tabulation_in_maps
   begin
 
     interpretation Maps: maps_category V H \<a> \<i> src trg
       ..
 
     interpretation r\<^sub>0s\<^sub>1: cospan_of_maps_in_bicategory_of_spans V H \<a> \<i> src trg s\<^sub>1 r\<^sub>0
       using \<rho>.leg0_is_map \<sigma>.leg1_is_map composable by unfold_locales auto
 
     lemma prj_char:
     shows "Maps.PRJ\<^sub>0 \<lbrakk>\<lbrakk>r\<^sub>0\<rbrakk>\<rbrakk> \<lbrakk>\<lbrakk>s\<^sub>1\<rbrakk>\<rbrakk> = \<lbrakk>\<lbrakk>prj\<^sub>0 s\<^sub>1 r\<^sub>0\<rbrakk>\<rbrakk>"
     and "Maps.PRJ\<^sub>1 \<lbrakk>\<lbrakk>r\<^sub>0\<rbrakk>\<rbrakk> \<lbrakk>\<lbrakk>s\<^sub>1\<rbrakk>\<rbrakk> = \<lbrakk>\<lbrakk>prj\<^sub>1 s\<^sub>1 r\<^sub>0\<rbrakk>\<rbrakk>"
     proof -
       have "Maps.arr (Maps.MkArr (src s\<^sub>0) (trg s) \<lbrakk>s\<^sub>1\<rbrakk>)"
         using \<sigma>.leg1_in_hom Maps.CLS_in_hom \<sigma>.leg1_is_map Maps.arr_char by auto
       moreover have "Maps.arr (Maps.MkArr (src r\<^sub>0) (trg s) \<lbrakk>r\<^sub>0\<rbrakk>)"
         using Maps.CLS_in_hom composable r\<^sub>0s\<^sub>1.k_is_map by fastforce
       moreover have "Maps.cod (Maps.MkArr (src r\<^sub>0) (trg s) \<lbrakk>r\<^sub>0\<rbrakk>) =
                      Maps.cod (Maps.MkArr (src s\<^sub>0) (trg s) \<lbrakk>s\<^sub>1\<rbrakk>)"
         unfolding Maps.arr_char
         using \<sigma>.leg1_in_hom \<rho>.leg0_in_hom
         by (simp add: Maps.cod_char calculation(1) calculation(2))
       ultimately have "Maps.PRJ\<^sub>0 \<lbrakk>\<lbrakk>r\<^sub>0\<rbrakk>\<rbrakk> \<lbrakk>\<lbrakk>s\<^sub>1\<rbrakk>\<rbrakk> =
                        \<lbrakk>\<lbrakk>tab\<^sub>0 ((Maps.REP (Maps.MkArr (src r\<^sub>0) (trg s) \<lbrakk>r\<^sub>0\<rbrakk>))\<^sup>* \<star>
                               Maps.REP (Maps.MkArr (src s\<^sub>0) (trg s) \<lbrakk>s\<^sub>1\<rbrakk>))\<rbrakk>\<rbrakk> \<and>
                        Maps.PRJ\<^sub>1 (Maps.CLS r\<^sub>0) (Maps.CLS s\<^sub>1) =
                        \<lbrakk>\<lbrakk>tab\<^sub>1 ((Maps.REP (Maps.MkArr (src r\<^sub>0) (trg s) \<lbrakk>r\<^sub>0\<rbrakk>))\<^sup>* \<star>
                               Maps.REP (Maps.MkArr (src s\<^sub>0) (trg s) \<lbrakk>s\<^sub>1\<rbrakk>))\<rbrakk>\<rbrakk>"
         unfolding Maps.PRJ\<^sub>0_def Maps.PRJ\<^sub>1_def
         using Maps.CLS_in_hom \<sigma>.leg1_is_map \<rho>.leg0_is_map composable by simp
       moreover have "r\<^sub>0\<^sup>* \<star> s\<^sub>1 \<cong> (Maps.REP (Maps.MkArr (src r\<^sub>0) (trg s) \<lbrakk>r\<^sub>0\<rbrakk>))\<^sup>* \<star>
                                 Maps.REP (Maps.MkArr (src s\<^sub>0) (trg s) \<lbrakk>s\<^sub>1\<rbrakk>)"
       proof -
         have "r\<^sub>0 \<cong> Maps.REP (Maps.MkArr (src r\<^sub>0) (trg s) \<lbrakk>r\<^sub>0\<rbrakk>)"
           using Maps.REP_CLS composable isomorphic_symmetric r\<^sub>0s\<^sub>1.k_is_map by fastforce
         hence 3: "isomorphic r\<^sub>0\<^sup>* (Maps.REP (Maps.MkArr (src r\<^sub>0) (trg s) \<lbrakk>r\<^sub>0\<rbrakk>))\<^sup>*"
           using \<rho>.leg0_is_map
           by (simp add: isomorphic_to_left_adjoint_implies_isomorphic_right_adjoint)
         moreover have 4: "s\<^sub>1 \<cong> Maps.REP (Maps.MkArr (src s\<^sub>0) (trg s) \<lbrakk>s\<^sub>1\<rbrakk>)"
           using Maps.REP_CLS isomorphic_symmetric r\<^sub>0s\<^sub>1.h_is_map by fastforce
         ultimately show ?thesis
         proof -
           have 1: "src r\<^sub>0\<^sup>* = trg s\<^sub>1"
             using \<rho>.T0.antipar(2) r\<^sub>0s\<^sub>1.cospan by argo
           have 2: "ide s\<^sub>1"
             by simp
           have "src (Maps.REP (Maps.MkArr (src r\<^sub>0) (trg s) \<lbrakk>r\<^sub>0\<rbrakk>))\<^sup>* = trg s\<^sub>1"
             by (metis 3 \<rho>.T0.antipar(2) isomorphic_implies_hpar(3) r\<^sub>0s\<^sub>1.cospan)
           thus ?thesis
             using 1 2
             by (meson 3 4 hcomp_ide_isomorphic hcomp_isomorphic_ide isomorphic_implies_ide(2)
                 isomorphic_transitive)
         qed
       qed
       ultimately have 1: "Maps.PRJ\<^sub>0 \<lbrakk>\<lbrakk>r\<^sub>0\<rbrakk>\<rbrakk> \<lbrakk>\<lbrakk>s\<^sub>1\<rbrakk>\<rbrakk> = \<lbrakk>\<lbrakk>prj\<^sub>0 s\<^sub>1 r\<^sub>0\<rbrakk>\<rbrakk> \<and>
                           Maps.PRJ\<^sub>1 \<lbrakk>\<lbrakk>r\<^sub>0\<rbrakk>\<rbrakk> \<lbrakk>\<lbrakk>s\<^sub>1\<rbrakk>\<rbrakk> = \<lbrakk>\<lbrakk>prj\<^sub>1 s\<^sub>1 r\<^sub>0\<rbrakk>\<rbrakk>"
         using r\<^sub>0s\<^sub>1.isomorphic_implies_same_tab by simp
       show "Maps.PRJ\<^sub>0 \<lbrakk>\<lbrakk>r\<^sub>0\<rbrakk>\<rbrakk> \<lbrakk>\<lbrakk>s\<^sub>1\<rbrakk>\<rbrakk> = \<lbrakk>\<lbrakk>prj\<^sub>0 s\<^sub>1 r\<^sub>0\<rbrakk>\<rbrakk>"
         using 1 by simp
       show "Maps.PRJ\<^sub>1 \<lbrakk>\<lbrakk>r\<^sub>0\<rbrakk>\<rbrakk> \<lbrakk>\<lbrakk>s\<^sub>1\<rbrakk>\<rbrakk> = \<lbrakk>\<lbrakk>prj\<^sub>1 s\<^sub>1 r\<^sub>0\<rbrakk>\<rbrakk>"
         using 1 by simp
     qed
 
   end
 
   context identity_in_bicategory_of_spans
   begin
 
     interpretation Maps: maps_category V H \<a> \<i> src trg ..
     interpretation Span: span_bicategory Maps.comp Maps.PRJ\<^sub>0 Maps.PRJ\<^sub>1 ..
 
     notation isomorphic (infix "\<cong>" 50)
 
     text \<open>
       A 1-cell \<open>r\<close> in a bicategory of spans is a map if and only if the ``input leg''
       \<open>tab\<^sub>0 r\<close> of the chosen tabulation of \<open>r\<close> is an equivalence map.
       Since a tabulation of \<open>r\<close> is unique up to equivalence, and equivalence maps compose,
       the result actually holds if ``chosen tabulation'' is replaced by ``any tabulation''.
     \<close>
 
     lemma is_map_iff_tab\<^sub>0_is_equivalence:
     shows "is_left_adjoint r \<longleftrightarrow> equivalence_map (tab\<^sub>0 r)"
     proof
       assume 1: "equivalence_map (tab\<^sub>0 r)"
       have 2: "equivalence_pair (tab\<^sub>0 r) (tab\<^sub>0 r)\<^sup>*"
       proof -
         obtain g' \<eta>' \<epsilon>' where \<eta>'\<epsilon>': "equivalence_in_bicategory V H \<a> \<i> src trg (tab\<^sub>0 r) g' \<eta>' \<epsilon>'"
           using 1 equivalence_map_def by auto
         have "adjoint_pair (tab\<^sub>0 r) g'"
           using \<eta>'\<epsilon>' equivalence_pair_def equivalence_pair_is_adjoint_pair by blast
         moreover have "adjoint_pair (tab\<^sub>0 r) (tab\<^sub>0 r)\<^sup>*"
           using T0.adjunction_in_bicategory_axioms adjoint_pair_def by auto
         ultimately have "g' \<cong> (tab\<^sub>0 r)\<^sup>*"
           using left_adjoint_determines_right_up_to_iso by simp
         thus ?thesis
           using \<eta>'\<epsilon>' equivalence_pair_def equivalence_pair_isomorphic_right by blast
       qed
       obtain \<eta>' \<epsilon>' where \<eta>'\<epsilon>': "equivalence_in_bicategory V H \<a> \<i> src trg (tab\<^sub>0 r) (tab\<^sub>0 r)\<^sup>* \<eta>' \<epsilon>'"
         using 2 equivalence_pair_def by auto
       interpret \<eta>'\<epsilon>': equivalence_in_bicategory V H \<a> \<i> src trg \<open>tab\<^sub>0 r\<close> \<open>(tab\<^sub>0 r)\<^sup>*\<close> \<eta>' \<epsilon>'
         using \<eta>'\<epsilon>' by auto
       have "is_left_adjoint (tab\<^sub>0 r)\<^sup>*"
         using 2 equivalence_pair_is_adjoint_pair equivalence_pair_symmetric by blast
       hence "is_left_adjoint (tab\<^sub>1 r \<star> (tab\<^sub>0 r)\<^sup>*)"
         using left_adjoints_compose by simp
       thus "is_left_adjoint r"
         using yields_isomorphic_representation isomorphic_def left_adjoint_preserved_by_iso'
         by meson
       next
       assume 1: "is_left_adjoint r"
       have 2: "is_left_adjoint (tab\<^sub>1 r \<star> (tab\<^sub>0 r)\<^sup>*)"
         using 1 yields_isomorphic_representation left_adjoint_preserved_by_iso'
               isomorphic_symmetric isomorphic_def
         by meson
       hence "is_left_adjoint (tab\<^sub>0 r)\<^sup>*"
         using is_ide BS4 [of "tab\<^sub>1 r" "(tab\<^sub>0 r)\<^sup>*"] by auto
       hence "is_left_adjoint ((tab\<^sub>0 r)\<^sup>* \<star> tab\<^sub>0 r) \<and> is_left_adjoint (tab\<^sub>0 r \<star> (tab\<^sub>0 r)\<^sup>*)"
         using left_adjoints_compose T0.antipar by simp
       hence 3: "iso \<eta> \<and> iso \<epsilon>"
         using BS3 [of "src (tab\<^sub>0 r)" "(tab\<^sub>0 r)\<^sup>* \<star> tab\<^sub>0 r" \<eta> \<eta>]
               BS3 [of "tab\<^sub>0 r \<star> (tab\<^sub>0 r)\<^sup>*" "trg (tab\<^sub>0 r)" \<epsilon> \<epsilon>]
               T0.unit_in_hom T0.counit_in_hom obj_is_self_adjoint
         by auto
       hence "equivalence_in_bicategory V H \<a> \<i> src trg (tab\<^sub>0 r) (tab\<^sub>0 r)\<^sup>* \<eta> \<epsilon>"
         apply unfold_locales by auto
       thus "equivalence_map (tab\<^sub>0 r)"
         using equivalence_map_def by blast
     qed
 
     text \<open>
       The chosen tabulation (and indeed, any other tabulation, which is equivalent)
       of an object is symmetric in the sense that its two legs are isomorphic.
     \<close>
 
     lemma obj_has_symmetric_tab:
     assumes "obj r"
     shows "tab\<^sub>0 r \<cong> tab\<^sub>1 r"
     proof -
       have "tab\<^sub>0 r \<cong> r \<star> tab\<^sub>0 r"
       proof -
         have "trg (tab\<^sub>0 r) = r"
           using assms by auto
         moreover have "\<guillemotleft>\<l>\<^sup>-\<^sup>1[tab\<^sub>0 r] : tab\<^sub>0 r \<Rightarrow> trg (tab\<^sub>0 r) \<star> tab\<^sub>0 r\<guillemotright> \<and> iso \<l>\<^sup>-\<^sup>1[tab\<^sub>0 r]"
           using assms by simp
         ultimately show ?thesis
           unfolding isomorphic_def by metis
       qed
       also have "... \<cong> tab\<^sub>1 r"
       proof -
         have "\<guillemotleft>tab : tab\<^sub>1 r \<Rightarrow> r \<star> tab\<^sub>0 r\<guillemotright>"
           using tab_in_hom by simp
         moreover have "is_left_adjoint (r \<star> tab\<^sub>0 r)"
           using assms left_adjoints_compose obj_is_self_adjoint by simp
         ultimately show ?thesis
           using BS3 [of "tab\<^sub>1 r" "r \<star> tab\<^sub>0 r" tab tab] isomorphic_symmetric isomorphic_def
           by auto
       qed
       finally show ?thesis by simp
     qed
 
     text \<open>
       The chosen tabulation of \<open>r\<close> determines a span in \<open>Maps(B)\<close>.
     \<close>
 
     lemma determines_span:
     assumes "ide r"
     shows "span_in_category Maps.comp \<lparr>Leg0 = \<lbrakk>\<lbrakk>tab\<^sub>0 r\<rbrakk>\<rbrakk>, Leg1 = \<lbrakk>\<lbrakk>tab\<^sub>1 r\<rbrakk>\<rbrakk>\<rparr>"
       using assms Maps.CLS_in_hom [of "tab\<^sub>0 r"] Maps.CLS_in_hom [of "tab\<^sub>1 r"]
             tab\<^sub>0_in_hom tab\<^sub>1_in_hom
       apply unfold_locales by fastforce
 
   end
 
   subsection "Arrows of Tabulations in Maps"
 
   text \<open>
     Here we consider the situation of two tabulations: a tabulation \<open>\<rho>\<close> of \<open>r\<close>
     and a tabulation \<open>\<sigma>\<close> of \<open>s\<close>, both ``legs'' of each tabulation being maps,
     together  with an arbitrary 2-cell \<open>\<guillemotleft>\<mu> : r \<Rightarrow> s\<guillemotright>\<close>.
     The 2-cell \<open>\<mu>\<close> at the base composes with the tabulation \<open>\<rho>\<close> to yield a 2-cell
     \<open>\<Delta> = (\<mu> \<star> r\<^sub>0) \<cdot> \<rho>\<close> ``over'' s.  By property \<open>T1\<close> of tabulation \<open>\<sigma>\<close>, this induces a map
     from the apex of \<open>\<rho>\<close> to the apex of \<open>\<sigma>\<close>, which together with the other data
     forms a triangular prism whose sides commute up to (unique) isomorphism.
   \<close>
   text \<open>
 $$
 \xymatrix{
   && {\rm src}~\sigma \ar[dl]_{s_1} \ar[dr]^{s_0} \dtwocell\omit{^<-1>\sigma} & \\
   &{\rm trg}~s && {\rm src}~s \ar[ll]^{s} \\
   & \rrtwocell\omit{^\mu} &&\\
   & {\rm src}~\rho \ar[dl]_{r_1} \ar[dr]^{r_0} \ar@ {.>}[uuur]^<>(0.3){{\rm chine}} \dtwocell\omit{^\rho}& \\
   {\rm trg}~r \ar@ {=}[uuur] && {\rm src}~r \ar[ll]^{r} \ar@ {=}[uuur]
 }
 $$
   \<close>
 
   locale arrow_of_tabulations_in_maps =
     bicategory_of_spans V H \<a> \<i> src trg +
     \<rho>: tabulation_in_maps V H \<a> \<i> src trg r \<rho> r\<^sub>0 r\<^sub>1 +
     \<sigma>: tabulation_in_maps V H \<a> \<i> src trg s \<sigma> s\<^sub>0 s\<^sub>1
   for V :: "'a comp"                 (infixr "\<cdot>" 55)
   and H :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"          (infixr "\<star>" 53)
   and \<a> :: "'a \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a"     ("\<a>[_, _, _]")
   and \<i> :: "'a \<Rightarrow> 'a"                 ("\<i>[_]")
   and src :: "'a \<Rightarrow> 'a"
   and trg :: "'a \<Rightarrow> 'a"
   and r :: 'a
   and \<rho> :: 'a
   and r\<^sub>0 :: 'a
   and r\<^sub>1 :: 'a
   and s :: 'a
   and \<sigma> :: 'a
   and s\<^sub>0 :: 'a
   and s\<^sub>1 :: 'a
   and \<mu> :: 'a +
   assumes in_hom: "\<guillemotleft>\<mu> : r \<Rightarrow> s\<guillemotright>"
   begin
 
     abbreviation (input) \<Delta>
     where "\<Delta> \<equiv> (\<mu> \<star> r\<^sub>0) \<cdot> \<rho>"
 
     lemma \<Delta>_in_hom [intro]:
     shows "\<guillemotleft>\<Delta> : src \<rho> \<rightarrow> trg \<sigma>\<guillemotright>"
     and "\<guillemotleft>\<Delta> : r\<^sub>1 \<Rightarrow> s \<star> r\<^sub>0\<guillemotright>"
     proof -
       show "\<guillemotleft>\<Delta> : r\<^sub>1 \<Rightarrow> s \<star> r\<^sub>0\<guillemotright>"
         using in_hom \<rho>.leg0_in_hom(2) \<rho>.tab_in_vhom' by auto
       thus "\<guillemotleft>\<Delta> : src \<rho> \<rightarrow> trg \<sigma>\<guillemotright>"
         by (metis \<rho>.tab_simps(3) \<rho>.base_in_hom(2) \<sigma>.tab_simps(3) \<sigma>.base_in_hom(2) arrI in_hom
             seqI' vcomp_in_hhom vseq_implies_hpar(1-2))
     qed
 
     lemma \<Delta>_simps [simp]:
     shows "arr \<Delta>"
     and "src \<Delta> = src \<rho>" and "trg \<Delta> = trg \<sigma>"
     and "dom \<Delta> = r\<^sub>1" and "cod \<Delta> = s \<star> r\<^sub>0"
       using \<Delta>_in_hom by auto
 
     abbreviation is_induced_map
     where "is_induced_map w \<equiv> \<sigma>.is_induced_by_cell w r\<^sub>0 \<Delta>"
 
     text \<open>
       The following is an equivalent restatement, in elementary terms, of the conditions
       for being an induced map.
     \<close>
 
     abbreviation (input) is_induced_map'
     where "is_induced_map' w \<equiv>
            ide w \<and>
            (\<exists>\<nu> \<theta>. \<guillemotleft>\<theta> : s\<^sub>0 \<star> w \<Rightarrow> r\<^sub>0\<guillemotright> \<and> \<guillemotleft>\<nu> : r\<^sub>1 \<Rightarrow> s\<^sub>1 \<star> w\<guillemotright> \<and> iso \<nu> \<and>
                   \<Delta> = (s \<star> \<theta>) \<cdot> \<a>[s, s\<^sub>0, w] \<cdot> (\<sigma> \<star> w) \<cdot> \<nu>)"
 
     lemma is_induced_map_iff:
     shows "is_induced_map w \<longleftrightarrow> is_induced_map' w"
     proof
       assume w: "is_induced_map' w"
       show "is_induced_map w"
       proof
         have 1: "dom \<Delta> = r\<^sub>1"
           by auto
         interpret w: arrow_of_spans_of_maps_to_tabulation V H \<a> \<i> src trg
                        r\<^sub>0 \<open>dom \<Delta>\<close> s \<sigma> s\<^sub>0 s\<^sub>1 w
         proof -
           have "arrow_of_spans_of_maps_to_tabulation V H \<a> \<i> src trg r\<^sub>0 r\<^sub>1 s \<sigma> s\<^sub>0 s\<^sub>1 w"
             using w apply unfold_locales by auto
           thus "arrow_of_spans_of_maps_to_tabulation V H \<a> \<i> src trg r\<^sub>0 (dom \<Delta>) s \<sigma> s\<^sub>0 s\<^sub>1 w"
             using 1 by simp
         qed
         show "arrow_of_spans_of_maps V H \<a> \<i> src trg r\<^sub>0 (dom \<Delta>) s\<^sub>0 s\<^sub>1 w"
           using w.arrow_of_spans_of_maps_axioms by auto
         show "\<sigma>.composite_cell w w.the_\<theta> \<cdot> w.the_\<nu> = \<Delta>"
         proof -
           obtain \<theta> \<nu>
           where \<theta>\<nu>: "\<guillemotleft>\<theta> : s\<^sub>0 \<star> w \<Rightarrow> r\<^sub>0\<guillemotright> \<and> \<guillemotleft>\<nu> : r\<^sub>1 \<Rightarrow> s\<^sub>1 \<star> w\<guillemotright> \<and> iso \<nu> \<and>
                      \<Delta> = (s \<star> \<theta>) \<cdot> \<a>[s, s\<^sub>0, w] \<cdot> (\<sigma> \<star> w) \<cdot> \<nu>"
             using w w.the_\<theta>_props(1) by auto
           have "(s \<star> \<theta>) \<cdot> \<a>[s, s\<^sub>0, w] \<cdot> (\<sigma> \<star> w) \<cdot> \<nu> = \<Delta>"
             using \<theta>\<nu> by argo
           moreover have "\<theta> = w.the_\<theta> \<and> \<nu> = w.the_\<nu>"
             using \<theta>\<nu> 1 w.the_\<nu>_props(1) w.leg0_uniquely_isomorphic w.leg1_uniquely_isomorphic
             by auto
           ultimately show ?thesis
             using comp_assoc by simp
         qed
       qed
       next
       assume w: "is_induced_map w"
       show "is_induced_map' w"
       proof -
         interpret w: arrow_of_spans_of_maps V H \<a> \<i> src trg r\<^sub>0 r\<^sub>1 s\<^sub>0 s\<^sub>1 w
           using w in_hom by auto
         interpret w: arrow_of_spans_of_maps_to_tabulation V H \<a> \<i> src trg r\<^sub>0 r\<^sub>1 s \<sigma> s\<^sub>0 s\<^sub>1 w
           ..
         have "dom \<Delta> = r\<^sub>1" by auto
         thus ?thesis
           using w comp_assoc w.the_\<nu>_props(1) w.the_\<nu>_props(2) w.uw\<theta> by metis
       qed
     qed
 
     lemma exists_induced_map:
     shows "\<exists>w. is_induced_map w"
     proof -
       obtain w \<theta> \<nu>
       where w\<theta>\<nu>: "ide w \<and> \<guillemotleft>\<theta> : s\<^sub>0 \<star> w \<Rightarrow> r\<^sub>0\<guillemotright> \<and> \<guillemotleft>\<nu> : r\<^sub>1 \<Rightarrow> s\<^sub>1 \<star> w\<guillemotright> \<and> iso \<nu> \<and>
                   \<Delta> = (s \<star> \<theta>) \<cdot> \<a>[s, s\<^sub>0, w] \<cdot> (\<sigma> \<star> w) \<cdot> \<nu>"
         using \<Delta>_in_hom \<rho>.ide_leg0 \<sigma>.T1 comp_assoc
         by (metis in_homE)
       thus ?thesis
         using is_induced_map_iff by blast
     qed
 
     lemma induced_map_unique:
     assumes "is_induced_map w" and "is_induced_map w'"
     shows "w \<cong> w'"
       using assms \<sigma>.induced_map_unique by blast
 
     definition chine
     where "chine \<equiv> SOME w. is_induced_map w"
 
     lemma chine_is_induced_map:
     shows "is_induced_map chine"
       unfolding chine_def
       using exists_induced_map someI_ex [of is_induced_map] by simp
 
     lemma chine_in_hom [intro]:
     shows "\<guillemotleft>chine : src r\<^sub>0 \<rightarrow> src s\<^sub>0\<guillemotright>"
     and "\<guillemotleft>chine: chine \<Rightarrow> chine\<guillemotright>"
     proof -
       show "\<guillemotleft>chine : src r\<^sub>0 \<rightarrow> src s\<^sub>0\<guillemotright>"
         using chine_is_induced_map
         by (metis \<Delta>_simps(1) \<Delta>_simps(4) \<rho>.leg1_simps(3) \<sigma>.ide_base \<sigma>.ide_leg0 \<sigma>.leg0_simps(3)
             \<sigma>.tab_simps(2) arrow_of_spans_of_maps.is_ide arrow_of_spans_of_maps.the_\<nu>_simps(2)
             assoc_simps(2) hseqE in_hhom_def seqE src_vcomp vseq_implies_hpar(1))
       show "\<guillemotleft>chine: chine \<Rightarrow> chine\<guillemotright>"
         using chine_is_induced_map
         by (meson arrow_of_spans_of_maps.is_ide ide_in_hom(2))
     qed
 
     lemma chine_simps [simp]:
     shows "arr chine" and "ide chine"
     and "src chine = src r\<^sub>0" and "trg chine = src s\<^sub>0"
     and "dom chine = chine" and "cod chine = chine"
       using chine_in_hom apply auto
       by (meson arrow_of_spans_of_maps.is_ide chine_is_induced_map)
 
   end
 
   sublocale arrow_of_tabulations_in_maps \<subseteq>
             arrow_of_spans_of_maps V H \<a> \<i> src trg r\<^sub>0 r\<^sub>1 s\<^sub>0 s\<^sub>1 chine
       using chine_is_induced_map is_induced_map_iff
       by unfold_locales auto
 
   sublocale arrow_of_tabulations_in_maps \<subseteq>
             arrow_of_spans_of_maps_to_tabulation V H \<a> \<i> src trg r\<^sub>0 r\<^sub>1 s \<sigma> s\<^sub>0 s\<^sub>1 chine
       ..
 
   context arrow_of_tabulations_in_maps
   begin
 
     text \<open>
       The two factorizations of the composite 2-cell \<open>\<Delta>\<close> amount to a naturality condition.
     \<close>
 
     lemma \<Delta>_naturality:
     shows "(\<mu> \<star> r\<^sub>0) \<cdot> \<rho> = (s \<star> the_\<theta>) \<cdot> \<a>[s, s\<^sub>0, chine] \<cdot> (\<sigma> \<star> chine) \<cdot> the_\<nu>"
       using chine_is_induced_map is_induced_map_iff
       by (metis leg0_uniquely_isomorphic(2) leg1_uniquely_isomorphic(2) the_\<nu>_props(1) uw\<theta>)
 
     lemma induced_map_preserved_by_iso:
     assumes "is_induced_map w" and "isomorphic w w'"
     shows "is_induced_map w'"
     proof -
       interpret w: arrow_of_spans_of_maps V H \<a> \<i> src trg r\<^sub>0 r\<^sub>1 s\<^sub>0 s\<^sub>1 w
         using assms in_hom by auto
       interpret w: arrow_of_spans_of_maps_to_tabulation V H \<a> \<i> src trg r\<^sub>0 r\<^sub>1 s \<sigma> s\<^sub>0 s\<^sub>1 w
         ..
       obtain \<phi> where \<phi>: "\<guillemotleft>\<phi> : w \<Rightarrow> w'\<guillemotright> \<and> iso \<phi>"
         using assms(2) isomorphic_def by auto
       show ?thesis
       proof
         interpret w': arrow_of_spans_of_maps V H \<a> \<i> src trg r\<^sub>0 \<open>dom \<Delta>\<close> s\<^sub>0 s\<^sub>1 w'
         proof
           show "is_left_adjoint r\<^sub>0"
             by (simp add: \<rho>.satisfies_T0)
           show "is_left_adjoint (dom \<Delta>)"
             by (simp add: \<rho>.leg1_is_map)
           show "ide w'" using assms by force
           show "\<exists>\<theta>. \<guillemotleft>\<theta> : s\<^sub>0 \<star> w' \<Rightarrow> r\<^sub>0\<guillemotright>"
             using \<phi> w.the_\<theta>_props \<sigma>.leg0_in_hom(2) assms(2) comp_in_homI hcomp_in_vhom
                   inv_in_hom isomorphic_implies_hpar(4) w.the_\<theta>_simps(4) w.w_simps(4)
             by metis
           have "\<guillemotleft>(s\<^sub>1 \<star> \<phi>) \<cdot> w.the_\<nu> : r\<^sub>1 \<Rightarrow> s\<^sub>1 \<star> w'\<guillemotright> \<and> iso ((s\<^sub>1 \<star> \<phi>) \<cdot> w.the_\<nu>)"
           proof (intro conjI)
             show "\<guillemotleft>(s\<^sub>1 \<star> \<phi>) \<cdot> w.the_\<nu> : r\<^sub>1 \<Rightarrow> s\<^sub>1 \<star> w'\<guillemotright>"
               using \<phi> w.the_\<nu>_props
               by (intro comp_in_homI, auto)
             thus "iso ((s\<^sub>1 \<star> \<phi>) \<cdot> w.the_\<nu>)"
               using \<phi> w.the_\<nu>_props
               by (meson \<sigma>.ide_leg1 arrI iso_hcomp hseqE ide_is_iso isos_compose seqE)
           qed
           hence "\<exists>\<nu>. \<guillemotleft>\<nu> : r\<^sub>1 \<Rightarrow> s\<^sub>1 \<star> w'\<guillemotright> \<and> iso \<nu>"
             by auto
           thus "\<exists>\<nu>. \<guillemotleft>\<nu> : dom \<Delta> \<Rightarrow> s\<^sub>1 \<star> w'\<guillemotright> \<and> iso \<nu>"
             by auto
         qed
         interpret w': arrow_of_spans_of_maps_to_tabulation V H \<a> \<i> src trg
                         r\<^sub>0 \<open>dom \<Delta>\<close> s \<sigma> s\<^sub>0 s\<^sub>1 w'
           ..
         show "arrow_of_spans_of_maps V H \<a> \<i> src trg r\<^sub>0 (dom \<Delta>) s\<^sub>0 s\<^sub>1 w'"
           using w'.arrow_of_spans_of_maps_axioms by auto
         show "\<sigma>.composite_cell w' w'.the_\<theta> \<cdot> w'.the_\<nu> = \<Delta>"
         proof -
           have 1: "w'.the_\<theta> = w.the_\<theta> \<cdot> (s\<^sub>0 \<star> inv \<phi>)" 
           proof -
             have "\<guillemotleft>w.the_\<theta> \<cdot> (s\<^sub>0 \<star> inv \<phi>) : s\<^sub>0 \<star> w' \<Rightarrow> r\<^sub>0\<guillemotright>"
               using w.the_\<theta>_props \<phi>
               by (intro comp_in_homI, auto)
             moreover have "\<guillemotleft>w'.the_\<theta> : s\<^sub>0 \<star> w' \<Rightarrow> r\<^sub>0\<guillemotright>"
               using w'.the_\<theta>_props by simp
             ultimately show ?thesis
               using w'.leg0_uniquely_isomorphic(2) by blast
           qed
           moreover have "w'.the_\<nu> = (s\<^sub>1 \<star> \<phi>) \<cdot> w.the_\<nu>"
           proof -
             have "\<guillemotleft>(s\<^sub>1 \<star> \<phi>) \<cdot> w.the_\<nu> : dom \<Delta> \<Rightarrow> s\<^sub>1 \<star> w'\<guillemotright>"
               using w.the_\<nu>_props \<phi>
               by (intro comp_in_homI, auto)
             moreover have "iso ((s\<^sub>1 \<star> \<phi>) \<cdot> w.the_\<nu>)"
               using w.the_\<nu>_props \<phi> iso_hcomp
               by (meson \<sigma>.ide_leg1 arrI calculation hseqE ide_is_iso isos_compose seqE)
             ultimately show ?thesis
               using w'.the_\<nu>_props w'.leg1_uniquely_isomorphic(2) by blast
           qed
           ultimately have "\<sigma>.composite_cell w' w'.the_\<theta> \<cdot> w'.the_\<nu> =
                            \<sigma>.composite_cell w' (w.the_\<theta> \<cdot> (s\<^sub>0 \<star> inv \<phi>)) \<cdot> (s\<^sub>1 \<star> \<phi>) \<cdot> w.the_\<nu>"
             by simp
           also have "... = (s \<star> w.the_\<theta> \<cdot> (s\<^sub>0 \<star> inv \<phi>)) \<cdot> \<a>[s, s\<^sub>0, w'] \<cdot>
                              (\<sigma> \<star> w') \<cdot> (s\<^sub>1 \<star> \<phi>) \<cdot> w.the_\<nu>"
             using comp_assoc by presburger
           also have "... = (s \<star> w.the_\<theta>) \<cdot> ((s \<star> s\<^sub>0 \<star> inv \<phi>) \<cdot> \<a>[s, s\<^sub>0, w'] \<cdot>
                              (\<sigma> \<star> w') \<cdot> (s\<^sub>1 \<star> \<phi>)) \<cdot> w.the_\<nu>"
             using 1 comp_assoc w'.the_\<theta>_simps(1) whisker_left
             by auto
           also have "... = (s \<star> w.the_\<theta>) \<cdot> (\<a>[s, s\<^sub>0, w] \<cdot> (\<sigma> \<star> w)) \<cdot> w.the_\<nu>"
           proof -
             have "(s \<star> s\<^sub>0 \<star> inv \<phi>) \<cdot> \<a>[s, s\<^sub>0, w'] \<cdot> (\<sigma> \<star> w') \<cdot> (s\<^sub>1 \<star> \<phi>) =
                   \<a>[s, s\<^sub>0, w] \<cdot> (\<sigma> \<star> w)"
             proof -
               have "(s \<star> s\<^sub>0 \<star> inv \<phi>) \<cdot> \<a>[s, s\<^sub>0, w'] \<cdot> (\<sigma> \<star> w') \<cdot> (s\<^sub>1 \<star> \<phi>) =
                     \<a>[s, s\<^sub>0, w] \<cdot> ((s \<star> s\<^sub>0) \<star> inv \<phi>) \<cdot> (\<sigma> \<star> w') \<cdot> (s\<^sub>1 \<star> \<phi>)"
               proof -
                 have "(s \<star> s\<^sub>0 \<star> inv \<phi>) \<cdot> \<a>[s, s\<^sub>0, w'] = \<a>[s, s\<^sub>0, w] \<cdot> ((s \<star> s\<^sub>0) \<star> inv \<phi>)"
                   using assms \<phi> assoc_naturality [of s s\<^sub>0 "inv \<phi>"] w.w_simps(4)
                   by (metis \<sigma>.leg0_simps(2-5) \<sigma>.base_simps(2-4) arr_inv cod_inv dom_inv
                       in_homE trg_cod)
                 thus ?thesis using comp_assoc by metis
               qed
               also have "... = \<a>[s, s\<^sub>0, w] \<cdot> (\<sigma> \<star> w) \<cdot> (s\<^sub>1 \<star> inv \<phi>) \<cdot> (s\<^sub>1 \<star> \<phi>)"
               proof -
                 have "((s \<star> s\<^sub>0) \<star> inv \<phi>) \<cdot> (\<sigma> \<star> w') = (\<sigma> \<star> w) \<cdot> (s\<^sub>1 \<star> inv \<phi>)"
                   using \<phi> comp_arr_dom comp_cod_arr in_hhom_def
                         interchange [of "s \<star> s\<^sub>0" \<sigma> "inv \<phi>" w']
                         interchange [of \<sigma> s\<^sub>1 w "inv \<phi>"]
                   by auto
                thus ?thesis
                   using comp_assoc by metis
               qed
               also have "... = \<a>[s, s\<^sub>0, w] \<cdot> (\<sigma> \<star> w)"
               proof -
                 have "(\<sigma> \<star> w) \<cdot> (s\<^sub>1 \<star> inv \<phi>) \<cdot> (s\<^sub>1 \<star> \<phi>) = \<sigma> \<star> w"
                 proof -
                   have "(\<sigma> \<star> w) \<cdot> (s\<^sub>1 \<star> inv \<phi>) \<cdot> (s\<^sub>1 \<star> \<phi>) = (\<sigma> \<star> w) \<cdot> (s\<^sub>1 \<star> inv \<phi> \<cdot> \<phi>)"
                     using \<phi> whisker_left in_hhom_def by auto
                   also have "... = (\<sigma> \<star> w) \<cdot> (s\<^sub>1 \<star> w)"
                     using \<phi> comp_inv_arr' by auto
                   also have "... = \<sigma> \<star> w"
                     using whisker_right [of w \<sigma> s\<^sub>1] comp_arr_dom in_hhom_def by auto
                   finally show ?thesis by blast
                 qed
                 thus ?thesis by simp
               qed
               finally show ?thesis by simp
             qed
             thus ?thesis by simp
           qed
           also have "... = \<Delta>"
             using assms(1) comp_assoc w.is_ide w.the_\<nu>_props(1) w.the_\<theta>_props(1) by simp
           finally show ?thesis
             using comp_assoc by auto
         qed
       qed
     qed
 
   end
 
   text \<open>
     In the special case that \<open>\<mu>\<close> is an identity 2-cell, the induced map from the apex of \<open>\<rho>\<close>
     to the apex of \<open>\<sigma>\<close> is an equivalence map.
   \<close>
 
   locale identity_arrow_of_tabulations_in_maps =
     arrow_of_tabulations_in_maps +
   assumes is_ide: "ide \<mu>"
   begin
 
     lemma r_eq_s:
     shows "r = s"
       using is_ide by (metis ide_char in_hom in_homE)
 
     lemma \<Delta>_eq_\<rho>:
     shows "\<Delta> = \<rho>"
       by (meson \<Delta>_simps(1) comp_ide_arr ide_hcomp hseq_char' ide_u is_ide seqE
           seq_if_composable)
 
     lemma chine_is_equivalence:
     shows "equivalence_map chine"
     proof -
       obtain w w' \<phi> \<psi> \<theta> \<nu> \<theta>' \<nu>'
         where e: "equivalence_in_bicategory (\<cdot>) (\<star>) \<a> \<i> src trg w' w \<psi> \<phi> \<and>
                   \<guillemotleft>w : src s\<^sub>0 \<rightarrow> src r\<^sub>0\<guillemotright> \<and> \<guillemotleft>w' : src r\<^sub>0 \<rightarrow> src s\<^sub>0\<guillemotright> \<and>
                   \<guillemotleft>\<theta> : r\<^sub>0 \<star> w \<Rightarrow> s\<^sub>0\<guillemotright> \<and> \<guillemotleft>\<nu> : s\<^sub>1 \<Rightarrow> r\<^sub>1 \<star> w\<guillemotright> \<and> iso \<nu> \<and>
                   \<sigma> = (s \<star> \<theta>) \<cdot> \<a>[s, r\<^sub>0, w] \<cdot> (\<rho> \<star> w) \<cdot> \<nu> \<and>
                   \<guillemotleft>\<theta>' : s\<^sub>0 \<star> w' \<Rightarrow> r\<^sub>0\<guillemotright> \<and> \<guillemotleft>\<nu>' : r\<^sub>1 \<Rightarrow> s\<^sub>1 \<star> w'\<guillemotright> \<and> iso \<nu>' \<and>
                   \<rho> = (s \<star> \<theta>') \<cdot> \<a>[s, s\<^sub>0, w'] \<cdot> (\<sigma> \<star> w') \<cdot> \<nu>'"
         using r_eq_s \<sigma>.apex_unique_up_to_equivalence [of \<rho> r\<^sub>0 r\<^sub>1] \<rho>.tabulation_axioms by blast
       have w': "equivalence_map w'"
         using e equivalence_map_def by auto
       hence "is_induced_map w'"
         using e r_eq_s \<Delta>_eq_\<rho> is_induced_map_iff comp_assoc equivalence_map_is_ide by metis
       hence "isomorphic chine w'"
         using induced_map_unique chine_is_induced_map by simp
       thus ?thesis
         using w' equivalence_map_preserved_by_iso isomorphic_symmetric by blast
     qed
 
   end
 
   text \<open>
     The following gives an interpretation of @{locale arrow_of_tabulations_in_maps}
     in the special case that the tabulations are those that we have chosen for the
     domain and codomain of the underlying 2-cell \<open>\<guillemotleft>\<mu> : r \<Rightarrow> s\<guillemotright>\<close>.
     In this case, we can recover \<open>\<mu>\<close> from \<open>\<Delta>\<close> via adjoint transpose.
   \<close>
 
   locale arrow_in_bicategory_of_spans =
     bicategory_of_spans V H \<a> \<i> src trg +
     r: identity_in_bicategory_of_spans V H \<a> \<i> src trg r +
     s: identity_in_bicategory_of_spans V H \<a> \<i> src trg s
   for V :: "'a comp"                 (infixr "\<cdot>" 55)
   and H :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"          (infixr "\<star>" 53)
   and \<a> :: "'a \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a"     ("\<a>[_, _, _]")
   and \<i> :: "'a \<Rightarrow> 'a"                 ("\<i>[_]")
   and src :: "'a \<Rightarrow> 'a"
   and trg :: "'a \<Rightarrow> 'a"
   and r :: 'a
   and s :: 'a
   and \<mu> :: 'a +
   assumes in_hom: "\<guillemotleft>\<mu> : r \<Rightarrow> s\<guillemotright>"
   begin
 
     abbreviation (input) r\<^sub>0 where "r\<^sub>0 \<equiv> tab\<^sub>0 r"
     abbreviation (input) r\<^sub>1 where "r\<^sub>1 \<equiv> tab\<^sub>1 r"
     abbreviation (input) s\<^sub>0 where "s\<^sub>0 \<equiv> tab\<^sub>0 s"
     abbreviation (input) s\<^sub>1 where "s\<^sub>1 \<equiv> tab\<^sub>1 s"
 
     lemma is_arrow_of_tabulations_in_maps:
     shows "arrow_of_tabulations_in_maps V H \<a> \<i> src trg r r.tab r\<^sub>0 r\<^sub>1 s s.tab s\<^sub>0 s\<^sub>1 \<mu>"
       using in_hom by unfold_locales auto
 
   end
 
   sublocale identity_in_bicategory_of_spans \<subseteq> arrow_in_bicategory_of_spans V H \<a> \<i> src trg r r r
     apply unfold_locales using is_ide by auto
 
   context arrow_in_bicategory_of_spans
   begin
 
     interpretation arrow_of_tabulations_in_maps V H \<a> \<i> src trg r r.tab r\<^sub>0 r\<^sub>1 s s.tab s\<^sub>0 s\<^sub>1 \<mu>
       using is_arrow_of_tabulations_in_maps by simp
     interpretation r: arrow_of_tabulations_in_maps V H \<a> \<i> src trg r r.tab r\<^sub>0 r\<^sub>1 r r.tab r\<^sub>0 r\<^sub>1 r
       using r.is_arrow_of_tabulations_in_maps by simp
 
     lemma \<mu>_in_terms_of_\<Delta>:
     shows "\<mu> = r.T0.trnr\<^sub>\<epsilon> (cod \<mu>) \<Delta> \<cdot> inv (r.T0.trnr\<^sub>\<epsilon> r r.tab)"
     proof -
       have \<mu>: "arr \<mu>"
         using in_hom by auto
       have "\<mu> \<cdot> r.T0.trnr\<^sub>\<epsilon> r r.tab = r.T0.trnr\<^sub>\<epsilon> s \<Delta>"
       proof -
         have "\<mu> \<cdot> r.T0.trnr\<^sub>\<epsilon> r r.tab =
               (\<mu> \<cdot> \<r>[r]) \<cdot> (r \<star> r.\<epsilon>) \<cdot> \<a>[r, tab\<^sub>0 r, (tab\<^sub>0 r)\<^sup>*] \<cdot> (r.tab \<star> (tab\<^sub>0 r)\<^sup>*)"
           unfolding r.T0.trnr\<^sub>\<epsilon>_def using comp_assoc by presburger
         also have "... = \<r>[s] \<cdot> ((\<mu> \<star> src \<mu>) \<cdot> (r \<star> r.\<epsilon>)) \<cdot>
                            \<a>[r, tab\<^sub>0 r, (tab\<^sub>0 r)\<^sup>*] \<cdot> (r.tab \<star> (tab\<^sub>0 r)\<^sup>*)"
           using \<mu> runit_naturality comp_assoc
           by (metis in_hom in_homE)
         also have "... = \<r>[s] \<cdot> (s \<star> r.\<epsilon>) \<cdot> ((\<mu> \<star> tab\<^sub>0 r \<star> (tab\<^sub>0 r)\<^sup>*) \<cdot>
                            \<a>[r, tab\<^sub>0 r, (tab\<^sub>0 r)\<^sup>*]) \<cdot> (r.tab \<star> (tab\<^sub>0 r)\<^sup>*)"
         proof -
           have "(\<mu> \<star> src \<mu>) \<cdot> (r \<star> r.\<epsilon>) = \<mu> \<star> r.\<epsilon>"
             using \<mu> interchange comp_arr_dom comp_cod_arr
             by (metis in_hom in_homE r.T0.counit_simps(1) r.T0.counit_simps(3) r.u_simps(3)
                 src_dom)
           also have "... = (s \<star> r.\<epsilon>) \<cdot> (\<mu> \<star> tab\<^sub>0 r \<star> (tab\<^sub>0 r)\<^sup>*)"
             using in_hom interchange [of s \<mu> r.\<epsilon> "tab\<^sub>0 r \<star> (tab\<^sub>0 r)\<^sup>*"]
                   comp_arr_dom comp_cod_arr r.T0.counit_simps(1) r.T0.counit_simps(2)
             by auto
           finally have "(\<mu> \<star> src \<mu>) \<cdot> (r \<star> r.\<epsilon>) = (s \<star> r.\<epsilon>) \<cdot> (\<mu> \<star> tab\<^sub>0 r \<star> (tab\<^sub>0 r)\<^sup>*)"
             by blast
           thus ?thesis
             using comp_assoc by presburger
         qed
         also have "... = \<r>[s] \<cdot> (s \<star> r.\<epsilon>) \<cdot> \<a>[s, tab\<^sub>0 r, (tab\<^sub>0 r)\<^sup>*] \<cdot>
                            ((\<mu> \<star> tab\<^sub>0 r) \<star> (tab\<^sub>0 r)\<^sup>*) \<cdot> (r.tab \<star> (tab\<^sub>0 r)\<^sup>*)"
         proof -
           have "(\<mu> \<star> tab\<^sub>0 r \<star> (tab\<^sub>0 r)\<^sup>*) \<cdot> \<a>[r, tab\<^sub>0 r, (tab\<^sub>0 r)\<^sup>*] =
                 \<a>[s, tab\<^sub>0 r, (tab\<^sub>0 r)\<^sup>*] \<cdot> ((\<mu> \<star> tab\<^sub>0 r) \<star> (tab\<^sub>0 r)\<^sup>*)"
             using \<mu> assoc_naturality [of \<mu> "tab\<^sub>0 r" "(tab\<^sub>0 r)\<^sup>*"]
             by (metis ide_char in_hom in_homE r.T0.antipar(1) r.T0.ide_right r.u_simps(3)
                 src_dom u_simps(2) u_simps(4-5))
           thus ?thesis
             using comp_assoc by presburger
         qed
         also have "... = \<r>[s] \<cdot> (s \<star> r.\<epsilon>) \<cdot> \<a>[s, tab\<^sub>0 r, (tab\<^sub>0 r)\<^sup>*] \<cdot>
                            ((\<mu> \<star> tab\<^sub>0 r) \<cdot> r.tab \<star> (tab\<^sub>0 r)\<^sup>*)"
           using \<mu> whisker_right \<Delta>_simps(1) by auto
         also have "... = r.T0.trnr\<^sub>\<epsilon> s \<Delta>"
           unfolding r.T0.trnr\<^sub>\<epsilon>_def by simp
         finally show ?thesis by blast
       qed
       thus ?thesis
         using \<mu> r.yields_isomorphic_representation invert_side_of_triangle(2)
         by (metis in_hom in_homE seqI')
     qed
 
   end
 
   subsubsection "Vertical Composite"
 
   locale vertical_composite_of_arrows_of_tabulations_in_maps =
     bicategory_of_spans V H \<a> \<i> src trg +
     \<rho>: tabulation_in_maps V H \<a> \<i> src trg r \<rho> r\<^sub>0 r\<^sub>1 +
     \<sigma>: tabulation_in_maps V H \<a> \<i> src trg s \<sigma> s\<^sub>0 s\<^sub>1 +
     \<tau>: tabulation_in_maps V H \<a> \<i> src trg t \<tau> t\<^sub>0 t\<^sub>1 +
     \<mu>: arrow_of_tabulations_in_maps V H \<a> \<i> src trg r \<rho> r\<^sub>0 r\<^sub>1 s \<sigma> s\<^sub>0 s\<^sub>1 \<mu> +
     \<pi>: arrow_of_tabulations_in_maps V H \<a> \<i> src trg s \<sigma> s\<^sub>0 s\<^sub>1 t \<tau> t\<^sub>0 t\<^sub>1 \<pi>
   for V :: "'a comp"                 (infixr "\<cdot>" 55)
   and H :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"          (infixr "\<star>" 53)
   and \<a> :: "'a \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a"     ("\<a>[_, _, _]")
   and \<i> :: "'a \<Rightarrow> 'a"                 ("\<i>[_]")
   and src :: "'a \<Rightarrow> 'a"
   and trg :: "'a \<Rightarrow> 'a"
   and r :: 'a
   and \<rho> :: 'a
   and r\<^sub>0 :: 'a
   and r\<^sub>1 :: 'a
   and s :: 'a
   and \<sigma> :: 'a
   and s\<^sub>0 :: 'a
   and s\<^sub>1 :: 'a
   and t :: 'a
   and \<tau> :: 'a
   and t\<^sub>0 :: 'a
   and t\<^sub>1 :: 'a
   and \<mu> :: 'a
   and \<pi> :: 'a
   begin
 
     text \<open>
 $$
 \xymatrix{
   &&& {\rm src}~\tau \ar[dl]_{t_1} \ar[dr]^{t_0} \dtwocell\omit{^<-1>\tau} & \\
   &&{\rm trg}~t && {\rm src}~t \ar[ll]^{s} \\
   && \rrtwocell\omit{^\pi} && \\
   && {\rm src}~\sigma \ar[dl]_{s_1} \ar[dr]^{s_0} \ar[uuur]^<>(0.3){\pi.{\rm chine}} \dtwocell\omit{^<-1>\sigma} & \\
   &{\rm trg}~s \ar@ {=}[uuur] && {\rm src}~s \ar[ll]^{s} \ar@ {=}[uuur] \\
   & \rrtwocell\omit{^\mu} &&\\
   & {\rm src}~\rho \ar[dl]_{r_1} \ar[dr]^{r_0} \ar[uuur]^<>(0.3){\mu.{\rm chine}} \dtwocell\omit{^\rho} & \\
   {\rm trg}~r \ar@ {=}[uuur] && {\rm src}~r \ar[ll]^{r} \ar@ {=}[uuur]
 }
 $$
     \<close>
 
     notation isomorphic (infix "\<cong>" 50)
 
     interpretation arrow_of_tabulations_in_maps V H \<a> \<i> src trg r \<rho> r\<^sub>0 r\<^sub>1 t \<tau> t\<^sub>0 t\<^sub>1 \<open>\<pi> \<cdot> \<mu>\<close>
       using \<mu>.in_hom \<pi>.in_hom by (unfold_locales, blast)
 
     lemma is_arrow_of_tabulations_in_maps:
     shows "arrow_of_tabulations_in_maps V H \<a> \<i> src trg r \<rho> r\<^sub>0 r\<^sub>1 t \<tau> t\<^sub>0 t\<^sub>1 (\<pi> \<cdot> \<mu>)"
       ..
 
     lemma chine_char:
     shows "chine \<cong> \<pi>.chine \<star> \<mu>.chine"
     proof -
       have "is_induced_map (\<pi>.chine \<star> \<mu>.chine)"
       proof -
         let ?f = "\<mu>.chine"
         have f: "\<guillemotleft>?f : src \<rho> \<rightarrow> src \<sigma>\<guillemotright> \<and> is_left_adjoint ?f \<and> ide ?f \<and> \<mu>.is_induced_map ?f"
           using \<mu>.chine_is_induced_map \<mu>.is_map by auto
         let ?g = "\<pi>.chine"
         have g: "\<guillemotleft>?g : src \<sigma> \<rightarrow> src \<tau>\<guillemotright> \<and> is_left_adjoint ?g \<and> ide ?g \<and> \<pi>.is_induced_map ?g"
           using \<pi>.chine_is_induced_map \<pi>.is_map by auto
         let ?\<theta> = "\<mu>.the_\<theta> \<cdot> (\<pi>.the_\<theta> \<star> ?f) \<cdot> \<a>\<^sup>-\<^sup>1[t\<^sub>0, ?g, ?f]"
         let ?\<nu> = "\<a>[t\<^sub>1, ?g, ?f] \<cdot> (\<pi>.the_\<nu> \<star> ?f) \<cdot> \<mu>.the_\<nu>"
         have \<theta>: "\<guillemotleft>?\<theta> : t\<^sub>0 \<star> ?g \<star> ?f \<Rightarrow> r\<^sub>0\<guillemotright>"
           using f g \<pi>.the_\<theta>_props \<mu>.the_\<theta>_props
           by (intro comp_in_homI hcomp_in_vhom, auto+)
         have \<nu>: "\<guillemotleft>?\<nu> : r\<^sub>1 \<Rightarrow> t\<^sub>1 \<star> ?g \<star> ?f\<guillemotright>"
           using f g \<pi>.the_\<theta>_props \<mu>.the_\<theta>_props
           by (intro comp_in_homI hcomp_in_vhom, auto)
         interpret gf: arrow_of_spans_of_maps V H \<a> \<i> src trg r\<^sub>0 r\<^sub>1 t\<^sub>0 t\<^sub>1 \<open>?g \<star> ?f\<close>
         proof
           show "ide (?g \<star> ?f)" by simp
           show "\<exists>\<theta>. \<guillemotleft>\<theta> : t\<^sub>0 \<star> ?g \<star> ?f \<Rightarrow> r\<^sub>0\<guillemotright>"
             using \<theta> by blast
           show "\<exists>\<nu>. \<guillemotleft>\<nu> : r\<^sub>1 \<Rightarrow> t\<^sub>1 \<star> ?g \<star> ?f\<guillemotright> \<and> iso \<nu>"
             using \<nu> \<mu>.the_\<nu>_props \<mu>.the_\<theta>_props \<pi>.the_\<nu>_props \<pi>.the_\<theta>_props
                   isos_compose [of "\<mu>.the_\<nu>" "\<pi>.the_\<nu>"] \<mu>.is_ide \<nu> \<open>ide (\<pi>.chine \<star> \<mu>.chine)\<close>
                   \<pi>.uw\<theta> \<pi>.w_simps(4) \<tau>.ide_leg1 \<tau>.leg1_simps(3) arrI hseq_char ideD(1)
                   ide_is_iso iso_assoc iso_hcomp isos_compose seqE
             by metis
         qed
         show ?thesis
         proof (intro conjI)
           have \<theta>_eq: "?\<theta> = gf.the_\<theta>"
             using \<theta> gf.the_\<theta>_props gf.leg0_uniquely_isomorphic by auto
           have \<nu>_eq: "?\<nu> = gf.the_\<nu>"
             using \<nu> gf.the_\<nu>_props gf.leg1_uniquely_isomorphic by auto
           have A: "src ?g = trg ?f"
             using f g by fastforce
           show "arrow_of_spans_of_maps V H \<a> \<i> src trg r\<^sub>0 (dom \<Delta>) t\<^sub>0 t\<^sub>1 (?g \<star> ?f)"
             using gf.arrow_of_spans_of_maps_axioms by simp
           have "((t \<star> gf.the_\<theta>) \<cdot> \<a>[t, t\<^sub>0, ?g \<star> ?f] \<cdot> (\<tau> \<star> ?g \<star> ?f)) \<cdot> gf.the_\<nu> = \<Delta>"
           proof -
             have "\<Delta> = (\<pi> \<star> r\<^sub>0) \<cdot> (\<mu> \<star> r\<^sub>0) \<cdot> \<rho>"
               using whisker_right comp_assoc
               by (metis \<Delta>_simps(1) hseqE ide_u seqE)
             also have "... = ((\<pi> \<star> r\<^sub>0) \<cdot> (s \<star> \<mu>.the_\<theta>)) \<cdot> \<a>[s, s\<^sub>0, ?f] \<cdot> (\<sigma> \<star> ?f) \<cdot> \<mu>.the_\<nu>"
               using \<mu>.\<Delta>_naturality comp_assoc by simp
             also have "... = (t \<star> \<mu>.the_\<theta>) \<cdot> ((\<pi> \<star> s\<^sub>0 \<star> ?f) \<cdot> \<a>[s, s\<^sub>0, ?f]) \<cdot> (\<sigma> \<star> ?f) \<cdot> \<mu>.the_\<nu>"
             proof -
               have "(\<pi> \<star> r\<^sub>0) \<cdot> (s \<star> \<mu>.the_\<theta>) = \<pi> \<star> \<mu>.the_\<theta>"
                 using f comp_arr_dom comp_cod_arr \<mu>.the_\<theta>_props \<pi>.in_hom
                       interchange [of \<pi> s r\<^sub>0 \<mu>.the_\<theta>]
                 by (metis in_homE)
               also have "... = (t \<star> \<mu>.the_\<theta>) \<cdot> (\<pi> \<star> s\<^sub>0 \<star> ?f)"
                 using f comp_arr_dom comp_cod_arr \<mu>.the_\<theta>_props \<pi>.in_hom
                       interchange [of t \<pi> \<mu>.the_\<theta> "s\<^sub>0 \<star> ?f"]
                 by (metis in_homE)
               finally have "(\<pi> \<star> r\<^sub>0) \<cdot> (s \<star> \<mu>.the_\<theta>) = (t \<star> \<mu>.the_\<theta>) \<cdot> (\<pi> \<star> s\<^sub>0 \<star> ?f)"
                 by simp
               thus ?thesis
                 using comp_assoc by presburger
             qed
             also have "... = (t \<star> \<mu>.the_\<theta>) \<cdot> \<a>[t, s\<^sub>0, ?f] \<cdot> (((\<pi> \<star> s\<^sub>0) \<star> ?f) \<cdot> (\<sigma> \<star> ?f)) \<cdot> \<mu>.the_\<nu>"
             proof -
               have "(\<pi> \<star> s\<^sub>0 \<star> ?f) \<cdot> \<a>[s, s\<^sub>0, ?f] = \<a>[t, s\<^sub>0, ?f] \<cdot> ((\<pi> \<star> s\<^sub>0) \<star> ?f)"
                 using f assoc_naturality [of \<pi> s\<^sub>0 ?f] \<pi>.in_hom by auto
               thus ?thesis
                 using comp_assoc by presburger
             qed
             also have "... = (t \<star> \<mu>.the_\<theta>) \<cdot> \<a>[t, s\<^sub>0, ?f] \<cdot> (\<pi>.\<Delta> \<star> ?f) \<cdot> \<mu>.the_\<nu>"
               using whisker_right comp_assoc by simp
             also have "... = (t \<star> \<mu>.the_\<theta>) \<cdot> \<a>[t, s\<^sub>0, ?f] \<cdot>
                                ((t \<star> \<pi>.the_\<theta>) \<cdot> \<a>[t, t\<^sub>0, ?g] \<cdot> (\<tau> \<star> ?g) \<cdot> \<pi>.the_\<nu> \<star> ?f) \<cdot> \<mu>.the_\<nu>"
               using \<pi>.\<Delta>_naturality by simp
             also have "... = (t \<star> \<mu>.the_\<theta>) \<cdot> \<a>[t, s\<^sub>0, ?f] \<cdot>
                                (((t \<star> \<pi>.the_\<theta>) \<star> ?f) \<cdot> (\<a>[t, t\<^sub>0, ?g] \<star> ?f) \<cdot> ((\<tau> \<star> ?g) \<star> ?f) \<cdot>
                                (\<pi>.the_\<nu> \<star> ?f)) \<cdot> \<mu>.the_\<nu>"
               using f g \<pi>.the_\<theta>_props \<pi>.the_\<nu>_props whisker_right
               by (metis \<pi>.\<Delta>_simps(1) \<pi>.\<Delta>_naturality seqE)
             also have "... = (t \<star> \<mu>.the_\<theta>) \<cdot> (\<a>[t, s\<^sub>0, ?f] \<cdot>
                                ((t \<star> \<pi>.the_\<theta>) \<star> ?f)) \<cdot> (\<a>[t, t\<^sub>0, ?g] \<star> ?f) \<cdot> ((\<tau> \<star> ?g) \<star> ?f) \<cdot>
                                (\<pi>.the_\<nu> \<star> ?f) \<cdot> \<mu>.the_\<nu>"
               using comp_assoc by presburger
             also have "... = (t \<star> \<mu>.the_\<theta>) \<cdot> (t \<star> \<pi>.the_\<theta> \<star> ?f) \<cdot>
                                (\<a>[t, t\<^sub>0 \<star> ?g, ?f] \<cdot> (\<a>[t, t\<^sub>0, ?g] \<star> ?f)) \<cdot>
                                ((\<tau> \<star> ?g) \<star> ?f) \<cdot> (\<pi>.the_\<nu> \<star> ?f) \<cdot> \<mu>.the_\<nu>"
               using f \<pi>.the_\<theta>_props assoc_naturality [of t "\<pi>.the_\<theta>" ?f] \<pi>.\<theta>_simps(3) comp_assoc
               by auto
             also have "... = (t \<star> \<mu>.the_\<theta>) \<cdot> (t \<star> \<pi>.the_\<theta> \<star> ?f) \<cdot>
                                (t \<star> \<a>\<^sup>-\<^sup>1[t\<^sub>0, ?g, ?f]) \<cdot> \<a>[t, t\<^sub>0, ?g \<star> ?f] \<cdot> (\<a>[t \<star> t\<^sub>0, ?g, ?f] \<cdot>
                                ((\<tau> \<star> ?g) \<star> ?f)) \<cdot> (\<pi>.the_\<nu> \<star> ?f) \<cdot> \<mu>.the_\<nu>"
             proof -
               have "seq \<a>[t, t\<^sub>0, ?g \<star> ?f] \<a>[t \<star> t\<^sub>0, ?g, ?f]"
                 using f g by fastforce
               moreover have "inv (t \<star> \<a>[t\<^sub>0, ?g, ?f]) = t \<star> \<a>\<^sup>-\<^sup>1[t\<^sub>0, ?g, ?f]"
                 using f g by simp
               moreover have "iso (t \<star> \<a>[t\<^sub>0, ?g, ?f])"
                 using f g by simp
               have "\<a>[t, t\<^sub>0 \<star> ?g, ?f] \<cdot> (\<a>[t, t\<^sub>0, ?g] \<star> ?f) =
                       (t \<star> \<a>\<^sup>-\<^sup>1[t\<^sub>0, ?g, ?f]) \<cdot> \<a>[t, t\<^sub>0, ?g \<star> ?f] \<cdot> \<a>[t \<star> t\<^sub>0, ?g, ?f]"
               proof -
                 have "seq \<a>[t, t\<^sub>0, ?g \<star> ?f] \<a>[t \<star> t\<^sub>0, ?g, ?f]"
                   using f g by fastforce
                 moreover have "inv (t \<star> \<a>[t\<^sub>0, ?g, ?f]) = t \<star> \<a>\<^sup>-\<^sup>1[t\<^sub>0, ?g, ?f]"
                   using f g by simp
                 moreover have "iso (t \<star> \<a>[t\<^sub>0, ?g, ?f])"
                   using f g by simp
                 ultimately show ?thesis
                   using A f g pentagon invert_side_of_triangle(1)
                   by (metis \<pi>.w_simps(4) \<tau>.ide_base \<tau>.ide_leg0 \<tau>.leg0_simps(3))
               qed
               thus ?thesis
                 using comp_assoc by presburger
             qed
             also have "... = ((t \<star> \<mu>.the_\<theta>) \<cdot> (t \<star> \<pi>.the_\<theta> \<star> ?f)) \<cdot>
                                (t \<star> \<a>\<^sup>-\<^sup>1[t\<^sub>0, ?g, ?f]) \<cdot> \<a>[t, t\<^sub>0, ?g \<star> ?f] \<cdot> (\<tau> \<star> ?g \<star> ?f) \<cdot> 
                                \<a>[t\<^sub>1, ?g, ?f] \<cdot> (\<pi>.the_\<nu> \<star> ?f) \<cdot> \<mu>.the_\<nu>"
               using f g assoc_naturality [of \<tau> ?g ?f] comp_assoc by simp
             also have "... = (t \<star> \<mu>.the_\<theta> \<cdot> (\<pi>.the_\<theta> \<star> ?f) \<cdot> \<a>\<^sup>-\<^sup>1[t\<^sub>0, ?g, ?f]) \<cdot>
                                \<a>[t, t\<^sub>0, ?g \<star> ?f] \<cdot>
                                (\<tau> \<star> ?g \<star> ?f) \<cdot> \<a>[t\<^sub>1, ?g, ?f] \<cdot> (\<pi>.the_\<nu> \<star> ?f) \<cdot> \<mu>.the_\<nu>"
             proof -
               have 1: "seq \<mu>.the_\<theta> ((\<pi>.the_\<theta> \<star> ?f) \<cdot> \<a>\<^sup>-\<^sup>1[t\<^sub>0, ?g, ?f])"
                 using \<theta>_eq by auto
               hence "t \<star> (\<pi>.the_\<theta> \<star> ?f) \<cdot> \<a>\<^sup>-\<^sup>1[t\<^sub>0, ?g, ?f] =
                      (t \<star> \<pi>.the_\<theta> \<star> ?f) \<cdot> (t \<star> \<a>\<^sup>-\<^sup>1[t\<^sub>0, ?g, ?f])"
                 using whisker_left \<tau>.ide_base by blast
               thus ?thesis
                 using 1 whisker_left \<tau>.ide_base comp_assoc by presburger
             qed
             also have "... = ((t \<star> gf.the_\<theta>) \<cdot> \<a>[t, t\<^sub>0, ?g \<star> ?f] \<cdot> (\<tau> \<star> ?g \<star> ?f)) \<cdot> gf.the_\<nu>"
               using \<theta>_eq \<nu>_eq by (simp add: comp_assoc)
             finally show ?thesis
               using comp_assoc by presburger
           qed
           thus "((t \<star> gf.the_\<theta>) \<cdot> \<a>[t, t\<^sub>0, ?g \<star> ?f] \<cdot> (\<tau> \<star> ?g \<star> ?f)) \<cdot>
                   arrow_of_spans_of_maps.the_\<nu> (\<cdot>) (\<star>) (dom ((\<pi> \<cdot> \<mu> \<star> r\<^sub>0) \<cdot> \<rho>)) t\<^sub>1 (?g \<star> ?f) =
                 \<Delta>"
             by simp
         qed
       qed
       thus ?thesis
         using chine_is_induced_map induced_map_unique by simp
     qed
 
   end
 
   sublocale vertical_composite_of_arrows_of_tabulations_in_maps \<subseteq>
             arrow_of_tabulations_in_maps V H \<a> \<i> src trg r \<rho> r\<^sub>0 r\<^sub>1 t \<tau> t\<^sub>0 t\<^sub>1 "\<pi> \<cdot> \<mu>"
     using is_arrow_of_tabulations_in_maps by simp
 
   subsubsection "Horizontal Composite"
 
   locale horizontal_composite_of_arrows_of_tabulations_in_maps =
     bicategory_of_spans V H \<a> \<i> src trg +
     \<rho>: tabulation_in_maps V H \<a> \<i> src trg r \<rho> r\<^sub>0 r\<^sub>1 +
     \<sigma>: tabulation_in_maps V H \<a> \<i> src trg s \<sigma> s\<^sub>0 s\<^sub>1 +
     \<tau>: tabulation_in_maps V H \<a> \<i> src trg t \<tau> t\<^sub>0 t\<^sub>1 +
     \<mu>: tabulation_in_maps V H \<a> \<i> src trg u \<mu> u\<^sub>0 u\<^sub>1 +
     \<rho>\<sigma>: composite_tabulation_in_maps V H \<a> \<i> src trg r \<rho> r\<^sub>0 r\<^sub>1 s \<sigma> s\<^sub>0 s\<^sub>1 +
     \<tau>\<mu>: composite_tabulation_in_maps V H \<a> \<i> src trg t \<tau> t\<^sub>0 t\<^sub>1 u \<mu> u\<^sub>0 u\<^sub>1 +
     \<omega>: arrow_of_tabulations_in_maps V H \<a> \<i> src trg r \<rho> r\<^sub>0 r\<^sub>1 t \<tau> t\<^sub>0 t\<^sub>1 \<omega> +
     \<chi>: arrow_of_tabulations_in_maps V H \<a> \<i> src trg s \<sigma> s\<^sub>0 s\<^sub>1 u \<mu> u\<^sub>0 u\<^sub>1 \<chi>
   for V :: "'a comp"                 (infixr "\<cdot>" 55)
   and H :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"          (infixr "\<star>" 53)
   and \<a> :: "'a \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a"     ("\<a>[_, _, _]")
   and \<i> :: "'a \<Rightarrow> 'a"                 ("\<i>[_]")
   and src :: "'a \<Rightarrow> 'a"
   and trg :: "'a \<Rightarrow> 'a"
   and r :: 'a
   and \<rho> :: 'a
   and r\<^sub>0 :: 'a
   and r\<^sub>1 :: 'a
   and s :: 'a
   and \<sigma> :: 'a
   and s\<^sub>0 :: 'a
   and s\<^sub>1 :: 'a
   and t :: 'a
   and \<tau> :: 'a
   and t\<^sub>0 :: 'a
   and t\<^sub>1 :: 'a
   and u :: 'a
   and \<mu> :: 'a
   and u\<^sub>0 :: 'a
   and u\<^sub>1 :: 'a
   and \<omega> :: 'a
   and \<chi> :: 'a
   begin
 
     text \<open>
 $$
 \xymatrix{
   &&& {\rm src}~t_0u_1.\phi \ar[dl]_{\tau\mu.p_1} \ar[dr]^{\tau\mu.p_0} \ddtwocell\omit{^{t_0u_1.\phi}} \\
   && {\rm src}~\tau \ar[dl]_{t_1} \ar[dr]^<>(0.4){t_0} \dtwocell\omit{^<-1>\tau}
   && {\rm src}~\mu \ar[dl]_{u_1} \ar[dr]^{u_0} \dtwocell\omit{^<-1>\mu} & \\
   & {\rm trg}~t && {\rm src}~t = {\rm trg}~u \ar[ll]^{t}
   && {\rm src}~u \ar[ll]^{u} \\
   & \xtwocell[r]{}\omit{^\omega}
   & {\rm src}~r_0s_1.\phi \ar[uuur]_<>(0.2){{\rm chine}}
     \ar[dl]^{\rho\sigma.p_1} \ar[dr]_{\rho\sigma.p_0\hspace{20pt}} \ddtwocell\omit{^{r_0s_1.\phi}}
   & \rrtwocell\omit{^\chi} && \\
   & {\rm src}~\rho \ar[dl]_{r_1} \ar[dr]^{r_0} \ar[uuur]^<>(0.4){\omega.{\rm chine}} \dtwocell\omit{^\rho}
   && {\rm src}~\sigma \ar[dl]_{s_1} \ar[dr]^{s_0} \ar[uuur]^<>(0.4){\chi.{\rm chine}} \dtwocell\omit{^<-1>\sigma} & \\
   {\rm trg}~r \ar@ {=}[uuur] && {\rm src}~r = {\rm trg}~s \ar[ll]^{r} \ar@ {=}[uuur]
   && {\rm src}~s \ar[ll]^{s} \ar@ {=}[uuur] \\
 }
 $$
     \<close>
 
     notation isomorphic (infix "\<cong>" 50)
 
     interpretation arrow_of_tabulations_in_maps V H \<a> \<i> src trg
                      \<open>r \<star> s\<close> \<rho>\<sigma>.tab \<open>s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0\<close> \<open>r\<^sub>1 \<star> \<rho>\<sigma>.p\<^sub>1\<close>
                      \<open>t \<star> u\<close> \<tau>\<mu>.tab \<open>u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0\<close> \<open>t\<^sub>1 \<star> \<tau>\<mu>.p\<^sub>1\<close> \<open>\<omega> \<star> \<chi>\<close>
       using \<rho>\<sigma>.composable \<omega>.in_hom \<chi>.in_hom
       by unfold_locales auto
 
     lemma is_arrow_of_tabulations_in_maps:
     shows "arrow_of_tabulations_in_maps V H \<a> \<i> src trg
              (r \<star> s) \<rho>\<sigma>.tab (s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0) (r\<^sub>1 \<star> \<rho>\<sigma>.p\<^sub>1)
              (t \<star> u) \<tau>\<mu>.tab (u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0) (t\<^sub>1 \<star> \<tau>\<mu>.p\<^sub>1) (\<omega> \<star> \<chi>)"
       ..
 
     sublocale arrow_of_tabulations_in_maps V H \<a> \<i> src trg
                 \<open>r \<star> s\<close> \<rho>\<sigma>.tab \<open>s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0\<close> \<open>r\<^sub>1 \<star> \<rho>\<sigma>.p\<^sub>1\<close>
                 \<open>t \<star> u\<close> \<tau>\<mu>.tab \<open>u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0\<close> \<open>t\<^sub>1 \<star> \<tau>\<mu>.p\<^sub>1\<close> \<open>\<omega> \<star> \<chi>\<close>
       using is_arrow_of_tabulations_in_maps by simp
 
     interpretation Maps: maps_category V H \<a> \<i> src trg ..
     notation Maps.comp  (infixr "\<odot>" 55)
 
     interpretation r\<^sub>0s\<^sub>1: cospan_of_maps_in_bicategory_of_spans \<open>(\<cdot>)\<close> \<open>(\<star>)\<close> \<a> \<i> src trg s\<^sub>1 r\<^sub>0
       using \<rho>.leg0_is_map \<sigma>.leg1_is_map \<rho>\<sigma>.composable apply unfold_locales by auto
     interpretation r\<^sub>0s\<^sub>1: arrow_of_tabulations_in_maps \<open>(\<cdot>)\<close> \<open>(\<star>)\<close> \<a> \<i> src trg
                            \<open>r\<^sub>0\<^sup>* \<star> s\<^sub>1\<close> r\<^sub>0s\<^sub>1.tab r\<^sub>0s\<^sub>1.p\<^sub>0 r\<^sub>0s\<^sub>1.p\<^sub>1
                            \<open>r\<^sub>0\<^sup>* \<star> s\<^sub>1\<close> r\<^sub>0s\<^sub>1.tab r\<^sub>0s\<^sub>1.p\<^sub>0 r\<^sub>0s\<^sub>1.p\<^sub>1
                            \<open>r\<^sub>0\<^sup>* \<star> s\<^sub>1\<close>
       using r\<^sub>0s\<^sub>1.is_arrow_of_tabulations_in_maps by simp
     interpretation t\<^sub>0u\<^sub>1: cospan_of_maps_in_bicategory_of_spans \<open>(\<cdot>)\<close> \<open>(\<star>)\<close> \<a> \<i> src trg u\<^sub>1 t\<^sub>0
       using \<tau>.leg0_is_map \<mu>.leg1_is_map \<tau>\<mu>.composable apply unfold_locales by auto
     interpretation t\<^sub>0u\<^sub>1: arrow_of_tabulations_in_maps \<open>(\<cdot>)\<close> \<open>(\<star>)\<close> \<a> \<i> src trg
                            \<open>t\<^sub>0\<^sup>* \<star> u\<^sub>1\<close> t\<^sub>0u\<^sub>1.tab t\<^sub>0u\<^sub>1.p\<^sub>0 t\<^sub>0u\<^sub>1.p\<^sub>1
                            \<open>t\<^sub>0\<^sup>* \<star> u\<^sub>1\<close> t\<^sub>0u\<^sub>1.tab t\<^sub>0u\<^sub>1.p\<^sub>0 t\<^sub>0u\<^sub>1.p\<^sub>1
                            \<open>t\<^sub>0\<^sup>* \<star> u\<^sub>1\<close>
       using t\<^sub>0u\<^sub>1.is_arrow_of_tabulations_in_maps by simp
 
     interpretation E: self_evaluation_map V H \<a> \<i> src trg ..
     notation E.eval ("\<lbrace>_\<rbrace>")
 
     no_notation in_hom ("\<guillemotleft>_ : _ \<rightarrow> _\<guillemotright>")
 
     text \<open>
       The following lemma states that the rectangular faces of the ``top prism'' commute
       up to isomorphism.  This was not already proved in @{locale composite_tabulation_in_maps},
       because there we did not consider any composite structure of the ``source'' 2-cell.
       There are common elements, though to the proof that the composite of tabulations is
       a tabulation and the present lemma.
       The proof idea is to use property \<open>T2\<close> of the ``base'' tabulations to establish the
       existence of the desired isomorphisms.  The proofs have to be carried out in
       sequence, starting from the ``output'' side, because the arrow \<open>\<beta>\<close> required in the
       hypotheses of \<open>T2\<close> depends, for the ``input'' tabulation, on the isomorphism constructed
       for the ``output'' tabulation.
     \<close>
 
     lemma prj_chine:
     shows "\<tau>\<mu>.p\<^sub>0 \<star> chine \<cong> \<chi>.chine \<star> \<rho>\<sigma>.p\<^sub>0"
     and "\<tau>\<mu>.p\<^sub>1 \<star> chine \<cong> \<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1"
     proof -
       have 1: "arrow_of_spans_of_maps V H \<a> \<i> src trg
                  (s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0) (r\<^sub>1 \<star> \<rho>\<sigma>.p\<^sub>1) (u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0) (t\<^sub>1 \<star> \<tau>\<mu>.p\<^sub>1) chine \<and>
                (((t \<star> u) \<star> the_\<theta>) \<cdot> \<a>[t \<star> u, u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0, chine] \<cdot> (\<tau>\<mu>.tab \<star> chine)) \<cdot> the_\<nu> =
                ((\<omega> \<star> \<chi>) \<star> s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> \<rho>\<sigma>.tab"
         using chine_is_induced_map by simp
       let ?u\<^sub>\<tau> = "u \<star> s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0"
       let ?w\<^sub>\<tau> = "\<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1"
       let ?w\<^sub>\<tau>' = "\<tau>\<mu>.p\<^sub>1 \<star> chine"
       have u\<^sub>\<tau>: "ide ?u\<^sub>\<tau>"
         using \<chi>.u_simps(3) by auto
       have w\<^sub>\<tau>: "ide ?w\<^sub>\<tau> \<and> is_left_adjoint ?w\<^sub>\<tau>"
         by (simp add: \<omega>.is_map \<rho>.T0.antipar(1) left_adjoints_compose)
       have w\<^sub>\<tau>': "ide ?w\<^sub>\<tau>' \<and> is_left_adjoint ?w\<^sub>\<tau>'"
         by (simp add: is_map left_adjoints_compose)
       let ?\<theta>\<^sub>\<tau> = "\<a>[u, s\<^sub>0, \<rho>\<sigma>.p\<^sub>0] \<cdot> ((\<chi> \<star> s\<^sub>0) \<cdot> \<sigma> \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> r\<^sub>0s\<^sub>1.\<phi> \<cdot> (\<omega>.the_\<theta> \<star> \<rho>\<sigma>.p\<^sub>1) \<cdot>
                    \<a>\<^sup>-\<^sup>1[t\<^sub>0, \<omega>.chine, \<rho>\<sigma>.p\<^sub>1]"
       let ?\<theta>\<^sub>\<tau>' = "(u \<star> the_\<theta>) \<cdot> \<a>[u, u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0, chine] \<cdot> (\<a>[u, u\<^sub>0, \<tau>\<mu>.p\<^sub>0] \<star> chine) \<cdot>
                    ((\<mu> \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine) \<cdot> (t\<^sub>0u\<^sub>1.\<phi> \<star> chine) \<cdot> \<a>\<^sup>-\<^sup>1[t\<^sub>0, \<tau>\<mu>.p\<^sub>1, chine]"
       let ?\<beta>\<^sub>\<tau> = "\<a>[t\<^sub>1, \<tau>\<mu>.p\<^sub>1, chine] \<cdot> the_\<nu> \<cdot> (inv \<omega>.the_\<nu> \<star> \<rho>\<sigma>.p\<^sub>1) \<cdot> \<a>\<^sup>-\<^sup>1[t\<^sub>1, \<omega>.chine, \<rho>\<sigma>.p\<^sub>1]"
       have \<theta>\<^sub>\<tau>: "\<guillemotleft>?\<theta>\<^sub>\<tau> : t\<^sub>0 \<star> ?w\<^sub>\<tau> \<Rightarrow> ?u\<^sub>\<tau>\<guillemotright>"
         using \<rho>.T0.antipar(1) \<omega>.the_\<theta>_in_hom \<chi>.u_simps(3)
         by (intro comp_in_homI, auto)
       have \<theta>\<^sub>\<tau>': "\<guillemotleft>?\<theta>\<^sub>\<tau>' : t\<^sub>0 \<star> ?w\<^sub>\<tau>' \<Rightarrow> ?u\<^sub>\<tau>\<guillemotright>"
       proof (intro comp_in_homI)
         show "\<guillemotleft>\<a>\<^sup>-\<^sup>1[t\<^sub>0, \<tau>\<mu>.p\<^sub>1, chine] : t\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>1 \<star> chine \<Rightarrow> (t\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>1) \<star> chine\<guillemotright>"
           using t\<^sub>0u\<^sub>1.p\<^sub>1_simps assoc'_in_hom by simp
         show "\<guillemotleft>t\<^sub>0u\<^sub>1.\<phi> \<star> chine : (t\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>1) \<star> chine \<Rightarrow> (u\<^sub>1 \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine\<guillemotright>"
           using \<tau>.T0.antipar(1)
           by (intro hcomp_in_vhom, auto)
         show "\<guillemotleft>(\<mu> \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine : (u\<^sub>1 \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine \<Rightarrow> ((u \<star> u\<^sub>0) \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine\<guillemotright>"
           by (intro hcomp_in_vhom, auto)
         show "\<guillemotleft>\<a>[u, u\<^sub>0, \<tau>\<mu>.p\<^sub>0] \<star> chine : ((u \<star> u\<^sub>0) \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine \<Rightarrow> (u \<star> u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine\<guillemotright>"
           using assoc_in_hom by auto
         show "\<guillemotleft>\<a>[u, u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0, chine] : (u \<star> u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine \<Rightarrow> u \<star> (u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine\<guillemotright>"
           by auto
         show "\<guillemotleft>u \<star> the_\<theta> : u \<star> (u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine \<Rightarrow> ?u\<^sub>\<tau>\<guillemotright>"
           by (intro hcomp_in_vhom, auto)
       qed
       have \<beta>\<^sub>\<tau>: "\<guillemotleft>?\<beta>\<^sub>\<tau> : t\<^sub>1 \<star> ?w\<^sub>\<tau> \<Rightarrow> t\<^sub>1 \<star> ?w\<^sub>\<tau>'\<guillemotright>"
       proof (intro comp_in_homI)
         show "\<guillemotleft>\<a>\<^sup>-\<^sup>1[t\<^sub>1, \<omega>.chine, \<rho>\<sigma>.p\<^sub>1] : t\<^sub>1 \<star> ?w\<^sub>\<tau> \<Rightarrow> (t\<^sub>1 \<star> \<omega>.chine) \<star> \<rho>\<sigma>.p\<^sub>1\<guillemotright>"
           using \<rho>.T0.antipar(1) by auto
         show "\<guillemotleft>inv \<omega>.the_\<nu> \<star> \<rho>\<sigma>.p\<^sub>1 : (t\<^sub>1 \<star> \<omega>.chine) \<star> \<rho>\<sigma>.p\<^sub>1 \<Rightarrow> r\<^sub>1 \<star> \<rho>\<sigma>.p\<^sub>1\<guillemotright>"
           using \<omega>.the_\<nu>_props \<rho>.T0.antipar(1)
           by (intro hcomp_in_vhom, auto)
         show "\<guillemotleft>the_\<nu> : r\<^sub>1 \<star> \<rho>\<sigma>.p\<^sub>1 \<Rightarrow> (t\<^sub>1 \<star> \<tau>\<mu>.p\<^sub>1) \<star> chine\<guillemotright>"
           using the_\<nu>_in_hom(2) by simp
         show "\<guillemotleft>\<a>[t\<^sub>1, \<tau>\<mu>.p\<^sub>1, chine] : (t\<^sub>1 \<star> \<tau>\<mu>.p\<^sub>1) \<star> chine \<Rightarrow> t\<^sub>1 \<star> ?w\<^sub>\<tau>'\<guillemotright>"
           using t\<^sub>0u\<^sub>1.p\<^sub>1_simps assoc_in_hom by simp
       qed
       define LHS where "LHS = (t \<star> ?\<theta>\<^sub>\<tau>) \<cdot> \<a>[t, t\<^sub>0, ?w\<^sub>\<tau>] \<cdot> (\<tau> \<star> ?w\<^sub>\<tau>)"
       have LHS: "\<guillemotleft>LHS : t\<^sub>1 \<star> ?w\<^sub>\<tau> \<Rightarrow> t \<star> ?u\<^sub>\<tau>\<guillemotright>"
       proof (unfold LHS_def, intro comp_in_homI)
         show "\<guillemotleft>\<tau> \<star> ?w\<^sub>\<tau> : t\<^sub>1 \<star> \<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1 \<Rightarrow> (t \<star> t\<^sub>0) \<star> ?w\<^sub>\<tau>\<guillemotright>"
           using \<rho>.T0.antipar(1)
           by (intro hcomp_in_vhom, auto)
         show "\<guillemotleft>\<a>[t, t\<^sub>0, ?w\<^sub>\<tau>] : (t \<star> t\<^sub>0) \<star> ?w\<^sub>\<tau> \<Rightarrow> t \<star> t\<^sub>0 \<star> ?w\<^sub>\<tau>\<guillemotright>"
           using \<rho>.T0.antipar(1) by auto
         show "\<guillemotleft>t \<star> ?\<theta>\<^sub>\<tau> : t \<star> t\<^sub>0 \<star> ?w\<^sub>\<tau> \<Rightarrow> t \<star> ?u\<^sub>\<tau>\<guillemotright>"
         proof -
           have "src t = trg (t\<^sub>0 \<star> \<omega>.chine \<star> r\<^sub>0s\<^sub>1.p\<^sub>1)"
             by (metis \<chi>.u_simps(3) \<mu>.ide_base \<sigma>.ide_leg0 \<sigma>.leg1_simps(3) \<tau>\<mu>.composable
                 \<theta>\<^sub>\<tau> arrI assoc_simps(3) r\<^sub>0s\<^sub>1.ide_u r\<^sub>0s\<^sub>1.p\<^sub>0_simps trg_vcomp vconn_implies_hpar(2))
           thus ?thesis
             using \<theta>\<^sub>\<tau> by blast
         qed
       qed
       define RHS where "RHS = ((t \<star> ?\<theta>\<^sub>\<tau>') \<cdot> \<a>[t, t\<^sub>0, ?w\<^sub>\<tau>'] \<cdot> (\<tau> \<star> ?w\<^sub>\<tau>')) \<cdot> ?\<beta>\<^sub>\<tau>"
       have RHS: "\<guillemotleft>RHS : t\<^sub>1 \<star> ?w\<^sub>\<tau> \<Rightarrow> t \<star> ?u\<^sub>\<tau>\<guillemotright>"
         unfolding RHS_def
       proof
         show "\<guillemotleft>?\<beta>\<^sub>\<tau> : t\<^sub>1 \<star> ?w\<^sub>\<tau> \<Rightarrow> t\<^sub>1 \<star> ?w\<^sub>\<tau>'\<guillemotright>"
           using \<beta>\<^sub>\<tau> by simp
         show "\<guillemotleft>(t \<star> ?\<theta>\<^sub>\<tau>') \<cdot> \<a>[t, t\<^sub>0, ?w\<^sub>\<tau>'] \<cdot> (\<tau> \<star> ?w\<^sub>\<tau>') : t\<^sub>1 \<star> ?w\<^sub>\<tau>' \<Rightarrow> t \<star> ?u\<^sub>\<tau>\<guillemotright>"
         proof
           show "\<guillemotleft>\<a>[t, t\<^sub>0, ?w\<^sub>\<tau>'] \<cdot> (\<tau> \<star> ?w\<^sub>\<tau>') : t\<^sub>1 \<star> ?w\<^sub>\<tau>' \<Rightarrow> t \<star> t\<^sub>0 \<star> ?w\<^sub>\<tau>'\<guillemotright>"
             using \<tau>.T0.antipar(1) by fastforce
           show "\<guillemotleft>t \<star> ?\<theta>\<^sub>\<tau>' : t \<star> t\<^sub>0 \<star> ?w\<^sub>\<tau>' \<Rightarrow> t \<star> ?u\<^sub>\<tau>\<guillemotright>"
             using w\<^sub>\<tau>' \<theta>\<^sub>\<tau>' \<tau>.leg0_simps(2) \<tau>.leg0_simps(3) hseqI' ideD(1) t\<^sub>0u\<^sub>1.p\<^sub>1_simps
                   trg_hcomp \<tau>.base_in_hom(2) hcomp_in_vhom
             by presburger
         qed
       qed
       have eq: "LHS = RHS"
       proof -
         have "\<a>\<^sup>-\<^sup>1[t, u, s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0] \<cdot> LHS \<cdot> \<a>[t\<^sub>1, \<omega>.chine, \<rho>\<sigma>.p\<^sub>1] \<cdot> (\<omega>.the_\<nu> \<star> \<rho>\<sigma>.p\<^sub>1) = \<Delta>"
         proof -
           text \<open>
             Here we use \<open>\<omega>.\<Delta>_naturality\<close> to replace @{term \<omega>.chine}
             in favor of @{term \<omega>}.
             We have to bring @{term \<omega>.the_\<nu>}, @{term \<tau>}, and @{term \<omega>.the_\<theta>} together, 
             with @{term \<rho>\<sigma>.p\<^sub>1} on the right.
           \<close>
           have "\<a>\<^sup>-\<^sup>1[t, u, s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0] \<cdot> LHS \<cdot> \<a>[t\<^sub>1, \<omega>.chine, \<rho>\<sigma>.p\<^sub>1] \<cdot> (\<omega>.the_\<nu> \<star> \<rho>\<sigma>.p\<^sub>1) =
                 \<a>\<^sup>-\<^sup>1[t, u, s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0] \<cdot>
                   (t \<star> \<a>[u, s\<^sub>0, \<rho>\<sigma>.p\<^sub>0] \<cdot> ((\<chi> \<star> s\<^sub>0) \<cdot> \<sigma> \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> r\<^sub>0s\<^sub>1.\<phi> \<cdot>
                        (\<omega>.the_\<theta> \<star> \<rho>\<sigma>.p\<^sub>1) \<cdot> \<a>\<^sup>-\<^sup>1[t\<^sub>0, \<omega>.chine, \<rho>\<sigma>.p\<^sub>1]) \<cdot>
                   \<a>[t, t\<^sub>0, \<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1] \<cdot> (\<tau> \<star> \<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1) \<cdot> \<a>[t\<^sub>1, \<omega>.chine, \<rho>\<sigma>.p\<^sub>1] \<cdot>
                   (\<omega>.the_\<nu> \<star> \<rho>\<sigma>.p\<^sub>1)"
             unfolding LHS_def
             using comp_assoc by presburger
           also have "... = \<a>\<^sup>-\<^sup>1[t, u, s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0] \<cdot> (t \<star> \<a>[u, s\<^sub>0, \<rho>\<sigma>.p\<^sub>0]) \<cdot>
                              (t \<star> (\<chi> \<star> s\<^sub>0) \<cdot> \<sigma> \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> (t \<star> r\<^sub>0s\<^sub>1.\<phi>) \<cdot>
                              (t \<star> \<omega>.the_\<theta> \<star> \<rho>\<sigma>.p\<^sub>1) \<cdot> (t \<star> \<a>\<^sup>-\<^sup>1[t\<^sub>0, \<omega>.chine, \<rho>\<sigma>.p\<^sub>1]) \<cdot>
                              \<a>[t, t\<^sub>0, \<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1] \<cdot> ((\<tau> \<star> \<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1) \<cdot>
                              \<a>[t\<^sub>1, \<omega>.chine, \<rho>\<sigma>.p\<^sub>1]) \<cdot> (\<omega>.the_\<nu> \<star> \<rho>\<sigma>.p\<^sub>1)"
           proof -
             have "t \<star> \<a>[u, s\<^sub>0, \<rho>\<sigma>.p\<^sub>0] \<cdot> ((\<chi> \<star> s\<^sub>0) \<cdot> \<sigma> \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> r\<^sub>0s\<^sub>1.\<phi> \<cdot>
                        (\<omega>.the_\<theta> \<star> \<rho>\<sigma>.p\<^sub>1) \<cdot> \<a>\<^sup>-\<^sup>1[t\<^sub>0, \<omega>.chine, \<rho>\<sigma>.p\<^sub>1] =
                   (t \<star> \<a>[u, s\<^sub>0, \<rho>\<sigma>.p\<^sub>0]) \<cdot> (t \<star> (\<chi> \<star> s\<^sub>0) \<cdot> \<sigma> \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> (t \<star> r\<^sub>0s\<^sub>1.\<phi>) \<cdot>
                        (t \<star> \<omega>.the_\<theta> \<star> \<rho>\<sigma>.p\<^sub>1) \<cdot> (t \<star> \<a>\<^sup>-\<^sup>1[t\<^sub>0, \<omega>.chine, \<rho>\<sigma>.p\<^sub>1])"
               using whisker_left \<tau>.ide_base \<theta>\<^sub>\<tau> arrI seqE
               by (metis (full_types))
             thus ?thesis
               using comp_assoc by presburger
           qed
           also have "... = \<a>\<^sup>-\<^sup>1[t, u, s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0] \<cdot> (t \<star> \<a>[u, s\<^sub>0, \<rho>\<sigma>.p\<^sub>0]) \<cdot>
                              (t \<star> (\<chi> \<star> s\<^sub>0) \<cdot> \<sigma> \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> (t \<star> r\<^sub>0s\<^sub>1.\<phi>) \<cdot>
                              (t \<star> \<omega>.the_\<theta> \<star> \<rho>\<sigma>.p\<^sub>1) \<cdot> ((t \<star> \<a>\<^sup>-\<^sup>1[t\<^sub>0, \<omega>.chine, \<rho>\<sigma>.p\<^sub>1]) \<cdot>
                              \<a>[t, t\<^sub>0, \<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1] \<cdot> \<a>[t \<star> t\<^sub>0, \<omega>.chine, \<rho>\<sigma>.p\<^sub>1]) \<cdot>
                              ((\<tau> \<star> \<omega>.chine) \<star> \<rho>\<sigma>.p\<^sub>1) \<cdot> (\<omega>.the_\<nu> \<star> \<rho>\<sigma>.p\<^sub>1)"
           proof -
             have "(\<tau> \<star> \<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1) \<cdot> \<a>[t\<^sub>1, \<omega>.chine, \<rho>\<sigma>.p\<^sub>1] =
                   \<a>[t \<star> t\<^sub>0, \<omega>.chine, \<rho>\<sigma>.p\<^sub>1] \<cdot> ((\<tau> \<star> \<omega>.chine) \<star> \<rho>\<sigma>.p\<^sub>1)"
               using assoc_naturality
               by (metis \<omega>.w_simps(2-6) \<rho>.leg1_simps(3) \<rho>\<sigma>.leg1_simps(2) \<tau>.tab_simps(1)
                   \<tau>.tab_simps(2,4-5) hseqE r\<^sub>0s\<^sub>1.leg1_simps(5) r\<^sub>0s\<^sub>1.leg1_simps(6))
             thus ?thesis
               using comp_assoc by presburger
           qed
           also have "... = \<a>\<^sup>-\<^sup>1[t, u, s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0] \<cdot> (t \<star> \<a>[u, s\<^sub>0, \<rho>\<sigma>.p\<^sub>0]) \<cdot>
                              (t \<star> (\<chi> \<star> s\<^sub>0) \<cdot> \<sigma> \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> (t \<star> r\<^sub>0s\<^sub>1.\<phi>) \<cdot>
                              ((t \<star> \<omega>.the_\<theta> \<star> \<rho>\<sigma>.p\<^sub>1) \<cdot> \<a>[t, t\<^sub>0 \<star> \<omega>.chine, \<rho>\<sigma>.p\<^sub>1]) \<cdot>
                              (\<a>[t, t\<^sub>0, \<omega>.chine] \<star> \<rho>\<sigma>.p\<^sub>1) \<cdot> ((\<tau> \<star> \<omega>.chine) \<star> \<rho>\<sigma>.p\<^sub>1) \<cdot>
                              (\<omega>.the_\<nu> \<star> \<rho>\<sigma>.p\<^sub>1)"
           proof -
             have "(t \<star> \<a>\<^sup>-\<^sup>1[t\<^sub>0, \<omega>.chine, \<rho>\<sigma>.p\<^sub>1]) \<cdot> \<a>[t, t\<^sub>0, \<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1] \<cdot>
                     \<a>[t \<star> t\<^sub>0, \<omega>.chine, \<rho>\<sigma>.p\<^sub>1] =
                   \<a>[t, t\<^sub>0 \<star> \<omega>.chine, \<rho>\<sigma>.p\<^sub>1] \<cdot> (\<a>[t, t\<^sub>0, \<omega>.chine] \<star> \<rho>\<sigma>.p\<^sub>1)"
             proof -
               have "seq \<a>[t, t\<^sub>0, \<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1] \<a>[t \<star> t\<^sub>0, \<omega>.chine, \<rho>\<sigma>.p\<^sub>1]"
                 by (simp add: \<rho>.T0.antipar(1))
               moreover have "inv (t \<star> \<a>[t\<^sub>0, \<omega>.chine, \<rho>\<sigma>.p\<^sub>1]) = t \<star> \<a>\<^sup>-\<^sup>1[t\<^sub>0, \<omega>.chine, \<rho>\<sigma>.p\<^sub>1]"
                 using \<rho>.T0.antipar(1) inv_hcomp [of t "\<a>[t\<^sub>0, \<omega>.chine, \<rho>\<sigma>.p\<^sub>1]"] by simp
               ultimately show ?thesis
                 using pentagon \<rho>.T0.antipar(1) iso_hcomp
                       invert_side_of_triangle(1)
                         [of "\<a>[t, t\<^sub>0, \<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1] \<cdot> \<a>[t \<star> t\<^sub>0, \<omega>.chine, \<rho>\<sigma>.p\<^sub>1]"
                             "t \<star> \<a>[t\<^sub>0, \<omega>.chine, \<rho>\<sigma>.p\<^sub>1]"
                             "\<a>[t, t\<^sub>0 \<star> \<omega>.chine, \<rho>\<sigma>.p\<^sub>1] \<cdot> (\<a>[t, t\<^sub>0, \<omega>.chine] \<star> \<rho>\<sigma>.p\<^sub>1)"]
                 by simp
             qed
             thus ?thesis
               using comp_assoc by presburger
           qed
           also have "... = \<a>\<^sup>-\<^sup>1[t, u, s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0] \<cdot> (t \<star> \<a>[u, s\<^sub>0, \<rho>\<sigma>.p\<^sub>0]) \<cdot>
                              (t \<star> (\<chi> \<star> s\<^sub>0) \<cdot> \<sigma> \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> (t \<star> r\<^sub>0s\<^sub>1.\<phi>) \<cdot>
                              \<a>[t, r\<^sub>0, \<rho>\<sigma>.p\<^sub>1] \<cdot> (((t \<star> \<omega>.the_\<theta>) \<star> \<rho>\<sigma>.p\<^sub>1) \<cdot>
                              (\<a>[t, t\<^sub>0, \<omega>.chine] \<star> \<rho>\<sigma>.p\<^sub>1) \<cdot> ((\<tau> \<star> \<omega>.chine) \<star> \<rho>\<sigma>.p\<^sub>1)) \<cdot>
                              (\<omega>.the_\<nu> \<star> \<rho>\<sigma>.p\<^sub>1)"
           proof -
             have "(t \<star> \<omega>.the_\<theta> \<star> \<rho>\<sigma>.p\<^sub>1) \<cdot> \<a>[t, t\<^sub>0 \<star> \<omega>.chine, \<rho>\<sigma>.p\<^sub>1] =
                   \<a>[t, r\<^sub>0, \<rho>\<sigma>.p\<^sub>1] \<cdot> ((t \<star> \<omega>.the_\<theta>) \<star> \<rho>\<sigma>.p\<^sub>1)"
               using assoc_naturality [of t \<omega>.the_\<theta> \<rho>\<sigma>.p\<^sub>1] \<omega>.\<theta>_simps(3) \<rho>\<sigma>.leg1_simps(2) hseq_char
               by auto
             thus ?thesis
               using comp_assoc by presburger
           qed
           also have "... = \<a>\<^sup>-\<^sup>1[t, u, s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0] \<cdot> (t \<star> \<a>[u, s\<^sub>0, \<rho>\<sigma>.p\<^sub>0]) \<cdot>
                              (t \<star> (\<chi> \<star> s\<^sub>0) \<cdot> \<sigma> \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> (t \<star> r\<^sub>0s\<^sub>1.\<phi>) \<cdot>
                              \<a>[t, r\<^sub>0, \<rho>\<sigma>.p\<^sub>1] \<cdot> ((\<omega> \<star> r\<^sub>0) \<cdot> \<rho> \<star> \<rho>\<sigma>.p\<^sub>1)"
             using whisker_right \<rho>.T0.antipar(1) \<omega>.\<Delta>_simps(1) \<omega>.\<Delta>_naturality comp_assoc
             by fastforce
           also have "... = \<a>\<^sup>-\<^sup>1[t, u, s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0] \<cdot> ((t \<star> \<a>[u, s\<^sub>0, \<rho>\<sigma>.p\<^sub>0]) \<cdot>
                              (t \<star> (\<chi> \<star> s\<^sub>0) \<star> \<rho>\<sigma>.p\<^sub>0)) \<cdot> (t \<star> \<sigma> \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> (t \<star> r\<^sub>0s\<^sub>1.\<phi>) \<cdot>
                              \<a>[t, r\<^sub>0, \<rho>\<sigma>.p\<^sub>1] \<cdot> ((\<omega> \<star> r\<^sub>0) \<cdot> \<rho> \<star> \<rho>\<sigma>.p\<^sub>1)"
           proof -
             have "t \<star> (\<chi> \<star> s\<^sub>0) \<cdot> \<sigma> \<star> \<rho>\<sigma>.p\<^sub>0 = (t \<star> (\<chi> \<star> s\<^sub>0) \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> (t \<star> \<sigma> \<star> \<rho>\<sigma>.p\<^sub>0)"
               using whisker_left whisker_right \<rho>.T0.antipar(1)
               by (metis (full_types) \<chi>.\<Delta>_simps(1) \<tau>.ide_base \<theta>\<^sub>\<tau> arrI r\<^sub>0s\<^sub>1.ide_u seqE)
             thus ?thesis
               using comp_assoc by presburger
           qed
           also have "... = \<a>\<^sup>-\<^sup>1[t, u, s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0] \<cdot> (t \<star> \<chi> \<star> s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot>
                              (t \<star> \<a>[s, s\<^sub>0, \<rho>\<sigma>.p\<^sub>0]) \<cdot> (t \<star> \<sigma> \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> (t \<star> r\<^sub>0s\<^sub>1.\<phi>) \<cdot>
                              \<a>[t, r\<^sub>0, \<rho>\<sigma>.p\<^sub>1] \<cdot> ((\<omega> \<star> r\<^sub>0) \<cdot> \<rho> \<star> \<rho>\<sigma>.p\<^sub>1)"
           proof -
             have "(t \<star> \<a>[u, s\<^sub>0, \<rho>\<sigma>.p\<^sub>0]) \<cdot> (t \<star> (\<chi> \<star> s\<^sub>0) \<star> \<rho>\<sigma>.p\<^sub>0) =
                   t \<star> \<a>[u, s\<^sub>0, \<rho>\<sigma>.p\<^sub>0] \<cdot> ((\<chi> \<star> s\<^sub>0) \<star> \<rho>\<sigma>.p\<^sub>0)"
               using \<chi>.in_hom whisker_left by auto
             also have "... = t \<star> (\<chi> \<star> s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> \<a>[s, s\<^sub>0, \<rho>\<sigma>.p\<^sub>0]"
               using assoc_naturality [of \<chi> s\<^sub>0 \<rho>\<sigma>.p\<^sub>0] \<chi>.in_hom by auto
             also have "... = (t \<star> \<chi> \<star> s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> (t \<star> \<a>[s, s\<^sub>0, \<rho>\<sigma>.p\<^sub>0])"
             proof -
               have "seq (\<chi> \<star> s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0) \<a>[s, s\<^sub>0, \<rho>\<sigma>.p\<^sub>0]"
                 using \<chi>.in_hom
                 apply (intro seqI hseqI)
                    apply auto
               proof -
                 show "\<guillemotleft>\<chi> : src u \<rightarrow> trg \<chi>\<guillemotright>"
                   by (metis \<chi>.\<Delta>_simps(1) \<chi>.u_simps(3) hseqE in_hhom_def seqE)
                 show "dom (\<chi> \<star> s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0) = s \<star> s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0"
                   by (metis \<Delta>_simps(1) \<chi>.in_hom hcomp_simps(1,3) hseq_char in_homE seqE
                       u_simps(4))
               qed
               thus ?thesis
                 using whisker_left by simp
             qed
             finally show ?thesis
               using comp_assoc by presburger
           qed
           also have "... = \<a>\<^sup>-\<^sup>1[t, u, s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0] \<cdot> (t \<star> \<chi> \<star> s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot>
                              (t \<star> \<a>[s, s\<^sub>0, \<rho>\<sigma>.p\<^sub>0]) \<cdot> (t \<star> \<sigma> \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> (t \<star> r\<^sub>0s\<^sub>1.\<phi>) \<cdot>
                              (\<a>[t, r\<^sub>0, \<rho>\<sigma>.p\<^sub>1] \<cdot> ((\<omega> \<star> r\<^sub>0) \<star> \<rho>\<sigma>.p\<^sub>1)) \<cdot> (\<rho> \<star> \<rho>\<sigma>.p\<^sub>1)"
             using whisker_right comp_assoc by simp
           also have "... = \<a>\<^sup>-\<^sup>1[t, u, s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0] \<cdot> (t \<star> \<chi> \<star> s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot>
                              (t \<star> \<a>[s, s\<^sub>0, \<rho>\<sigma>.p\<^sub>0]) \<cdot> (t \<star> \<sigma> \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> ((t \<star> r\<^sub>0s\<^sub>1.\<phi>) \<cdot>
                              (\<omega> \<star> r\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>1)) \<cdot> \<a>[r, r\<^sub>0, \<rho>\<sigma>.p\<^sub>1] \<cdot> (\<rho> \<star> \<rho>\<sigma>.p\<^sub>1)"
             using assoc_naturality [of \<omega> r\<^sub>0 \<rho>\<sigma>.p\<^sub>1] \<omega>.in_hom \<rho>.T0.antipar(1) comp_assoc
             by fastforce
           also have "... = \<a>\<^sup>-\<^sup>1[t, u, s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0] \<cdot> ((t \<star> \<chi> \<star> s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot>
                              (t \<star> \<a>[s, s\<^sub>0, \<rho>\<sigma>.p\<^sub>0]) \<cdot> (t \<star> \<sigma> \<star> \<rho>\<sigma>.p\<^sub>0)) \<cdot> (\<omega> \<star> s\<^sub>1 \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot>
                              (r \<star> r\<^sub>0s\<^sub>1.\<phi>) \<cdot> \<a>[r, r\<^sub>0, \<rho>\<sigma>.p\<^sub>1] \<cdot> (\<rho> \<star> \<rho>\<sigma>.p\<^sub>1)"
           proof -
             have "(t \<star> r\<^sub>0s\<^sub>1.\<phi>) \<cdot> (\<omega> \<star> r\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>1) = \<omega> \<star> r\<^sub>0s\<^sub>1.\<phi>"
               using comp_cod_arr comp_arr_dom \<omega>.in_hom interchange comp_ide_arr
               by (metis \<tau>.base_in_hom(2) \<tau>.ide_base r\<^sub>0s\<^sub>1.\<phi>_simps(1) r\<^sub>0s\<^sub>1.\<phi>_simps(4) seqI')
             also have "... = (\<omega> \<star> s\<^sub>1 \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> (r \<star> r\<^sub>0s\<^sub>1.\<phi>)"
               using r\<^sub>0s\<^sub>1.\<phi>_in_hom comp_cod_arr comp_arr_dom \<omega>.in_hom interchange
               by (metis in_homE)
             finally have "(t \<star> r\<^sub>0s\<^sub>1.\<phi>) \<cdot> (\<omega> \<star> r\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>1) = (\<omega> \<star> s\<^sub>1 \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> (r \<star> r\<^sub>0s\<^sub>1.\<phi>)"
               by simp
             thus ?thesis
               using comp_assoc by presburger
           qed
           also have "... = \<a>\<^sup>-\<^sup>1[t, u, s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0] \<cdot>
                              ((t \<star> (\<chi> \<star> s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> \<a>[s, s\<^sub>0, \<rho>\<sigma>.p\<^sub>0] \<cdot> (\<sigma> \<star> \<rho>\<sigma>.p\<^sub>0)) \<cdot>
                              (\<omega> \<star> s\<^sub>1 \<star> \<rho>\<sigma>.p\<^sub>0)) \<cdot>
                              (r \<star> r\<^sub>0s\<^sub>1.\<phi>) \<cdot> \<a>[r, r\<^sub>0, \<rho>\<sigma>.p\<^sub>1] \<cdot> (\<rho> \<star> \<rho>\<sigma>.p\<^sub>1)"
             using whisker_left \<rho>.T0.antipar(1) \<rho>\<sigma>.composable \<chi>.in_hom comp_assoc by auto
           also have "... = \<a>\<^sup>-\<^sup>1[t, u, s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0] \<cdot>
                              (\<omega> \<star> (\<chi> \<star> s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> \<a>[s, s\<^sub>0, \<rho>\<sigma>.p\<^sub>0] \<cdot> (\<sigma> \<star> \<rho>\<sigma>.p\<^sub>0)) \<cdot>
                              (r \<star> r\<^sub>0s\<^sub>1.\<phi>) \<cdot> \<a>[r, r\<^sub>0, \<rho>\<sigma>.p\<^sub>1] \<cdot> (\<rho> \<star> \<rho>\<sigma>.p\<^sub>1)"
           proof -
             have "(t \<star> (\<chi> \<star> s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> \<a>[s, s\<^sub>0, \<rho>\<sigma>.p\<^sub>0] \<cdot> (\<sigma> \<star> \<rho>\<sigma>.p\<^sub>0)) \<cdot> (\<omega> \<star> s\<^sub>1 \<star> \<rho>\<sigma>.p\<^sub>0) =
                    \<omega> \<star> (\<chi> \<star> s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> \<a>[s, s\<^sub>0, \<rho>\<sigma>.p\<^sub>0] \<cdot> (\<sigma> \<star> \<rho>\<sigma>.p\<^sub>0)"
             proof -
               have "\<guillemotleft>(\<chi> \<star> s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> \<a>[s, s\<^sub>0, \<rho>\<sigma>.p\<^sub>0] \<cdot> (\<sigma> \<star> \<rho>\<sigma>.p\<^sub>0) : s\<^sub>1 \<star> \<rho>\<sigma>.p\<^sub>0 \<Rightarrow> u \<star> s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0\<guillemotright>"
                 using \<omega>.in_hom \<chi>.in_hom by force
               thus ?thesis
                   by (metis (no_types) \<omega>.in_hom comp_arr_dom comp_cod_arr in_homE
                       interchange)
             qed
             thus ?thesis
               using comp_assoc by presburger
           qed
           also have "... = (\<a>\<^sup>-\<^sup>1[t, u, s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0] \<cdot>
                              (\<omega> \<star> \<chi> \<star> s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0)) \<cdot> (r \<star> \<a>[s, s\<^sub>0, \<rho>\<sigma>.p\<^sub>0] \<cdot> (\<sigma> \<star> \<rho>\<sigma>.p\<^sub>0)) \<cdot>
                              (r \<star> r\<^sub>0s\<^sub>1.\<phi>) \<cdot> \<a>[r, r\<^sub>0, \<rho>\<sigma>.p\<^sub>1] \<cdot> (\<rho> \<star> \<rho>\<sigma>.p\<^sub>1)"
           proof -
             have "\<omega> \<star> (\<chi> \<star> s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> \<a>[s, s\<^sub>0, \<rho>\<sigma>.p\<^sub>0] \<cdot> (\<sigma> \<star> \<rho>\<sigma>.p\<^sub>0) =
                   (\<omega> \<star> \<chi> \<star> s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> (r \<star> \<a>[s, s\<^sub>0, \<rho>\<sigma>.p\<^sub>0] \<cdot> (\<sigma> \<star> \<rho>\<sigma>.p\<^sub>0))"
             proof -
               have "seq (\<chi> \<star> s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0) (\<a>[s, s\<^sub>0, \<rho>\<sigma>.p\<^sub>0] \<cdot> (\<sigma> \<star> \<rho>\<sigma>.p\<^sub>0))"
                 using \<chi>.in_hom by force
               thus ?thesis
                using comp_arr_dom comp_cod_arr \<omega>.in_hom \<chi>.in_hom interchange
                by (metis in_homE)
             qed
             thus ?thesis
               using comp_assoc by presburger
           qed
           also have "... = ((\<omega> \<star> \<chi>) \<star> s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot>
                              \<a>\<^sup>-\<^sup>1[r, s, s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0] \<cdot> (r \<star> \<a>[s, s\<^sub>0, \<rho>\<sigma>.p\<^sub>0] \<cdot> (\<sigma> \<star> \<rho>\<sigma>.p\<^sub>0)) \<cdot>
                              (r \<star> r\<^sub>0s\<^sub>1.\<phi>) \<cdot> \<a>[r, r\<^sub>0, \<rho>\<sigma>.p\<^sub>1] \<cdot> (\<rho> \<star> \<rho>\<sigma>.p\<^sub>1)"
           proof -
             have "\<a>\<^sup>-\<^sup>1[t, u, s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0] \<cdot> (\<omega> \<star> \<chi> \<star> s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0) =
                   ((\<omega> \<star> \<chi>) \<star> s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> \<a>\<^sup>-\<^sup>1[r, s, s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0]"
               using assoc_naturality \<omega>.in_hom \<chi>.in_hom
               by (metis \<rho>\<sigma>.leg0_simps(3) assoc'_naturality hcomp_in_vhomE in_hom in_homE
                   u_simps(2) u_simps(4) u_simps(5))
             thus ?thesis
               using comp_assoc by presburger
           qed
           also have "... = \<Delta>"
             using whisker_left \<rho>\<sigma>.tab_def comp_assoc by simp
           finally show ?thesis by auto
         qed
         also have "... = \<a>\<^sup>-\<^sup>1[t, u, s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0] \<cdot> RHS \<cdot> \<a>[t\<^sub>1, \<omega>.chine, \<rho>\<sigma>.p\<^sub>1] \<cdot> (\<omega>.the_\<nu> \<star> \<rho>\<sigma>.p\<^sub>1)"
         proof -
           text \<open>Now cancel @{term \<omega>.the_\<nu>} and its inverse.\<close>
           have "\<a>\<^sup>-\<^sup>1[t, u, s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0] \<cdot> RHS \<cdot> \<a>[t\<^sub>1, \<omega>.chine, \<rho>\<sigma>.p\<^sub>1] \<cdot> (\<omega>.the_\<nu> \<star> \<rho>\<sigma>.p\<^sub>1) =
                 \<a>\<^sup>-\<^sup>1[t, u, s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0] \<cdot>
                   (t \<star> (u \<star> the_\<theta>) \<cdot> \<a>[u, u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0, chine] \<cdot>
                          (\<a>[u, u\<^sub>0, \<tau>\<mu>.p\<^sub>0] \<star> chine) \<cdot> ((\<mu> \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine) \<cdot>
                          (t\<^sub>0u\<^sub>1.\<phi> \<star> chine) \<cdot> \<a>\<^sup>-\<^sup>1[t\<^sub>0, \<tau>\<mu>.p\<^sub>1, chine]) \<cdot>
                     \<a>[t, t\<^sub>0, \<tau>\<mu>.p\<^sub>1 \<star> chine] \<cdot> (\<tau> \<star> \<tau>\<mu>.p\<^sub>1 \<star> chine) \<cdot>
                     \<a>[t\<^sub>1, \<tau>\<mu>.p\<^sub>1, chine] \<cdot> the_\<nu> \<cdot> (inv \<omega>.the_\<nu> \<star> \<rho>\<sigma>.p\<^sub>1) \<cdot>
                     ((\<a>\<^sup>-\<^sup>1[t\<^sub>1, \<omega>.chine, \<rho>\<sigma>.p\<^sub>1]) \<cdot> \<a>[t\<^sub>1, \<omega>.chine, \<rho>\<sigma>.p\<^sub>1]) \<cdot> (\<omega>.the_\<nu> \<star> \<rho>\<sigma>.p\<^sub>1)"
             unfolding RHS_def
             using comp_assoc by presburger
           also have "... = \<a>\<^sup>-\<^sup>1[t, u, s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0] \<cdot>
                              (t \<star> (u \<star> the_\<theta>) \<cdot> \<a>[u, u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0, chine] \<cdot>
                                      (\<a>[u, u\<^sub>0, \<tau>\<mu>.p\<^sub>0] \<star> chine) \<cdot> ((\<mu> \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine) \<cdot>
                                      (t\<^sub>0u\<^sub>1.\<phi> \<star> chine) \<cdot> \<a>\<^sup>-\<^sup>1[t\<^sub>0, \<tau>\<mu>.p\<^sub>1, chine]) \<cdot>
                                \<a>[t, t\<^sub>0, \<tau>\<mu>.p\<^sub>1 \<star> chine] \<cdot> (\<tau> \<star> \<tau>\<mu>.p\<^sub>1 \<star> chine) \<cdot>
                                \<a>[t\<^sub>1, \<tau>\<mu>.p\<^sub>1, chine] \<cdot> the_\<nu>"
           proof -
             have "the_\<nu> \<cdot> (inv \<omega>.the_\<nu> \<star> \<rho>\<sigma>.p\<^sub>1) \<cdot>
                     ((\<a>\<^sup>-\<^sup>1[t\<^sub>1, \<omega>.chine, \<rho>\<sigma>.p\<^sub>1]) \<cdot> \<a>[t\<^sub>1, \<omega>.chine, \<rho>\<sigma>.p\<^sub>1]) \<cdot> (\<omega>.the_\<nu> \<star> \<rho>\<sigma>.p\<^sub>1) =
                   the_\<nu> \<cdot> (inv \<omega>.the_\<nu> \<star> \<rho>\<sigma>.p\<^sub>1) \<cdot>
                     ((t\<^sub>1 \<star> \<omega>.chine) \<star> \<rho>\<sigma>.p\<^sub>1) \<cdot> (\<omega>.the_\<nu> \<star> \<rho>\<sigma>.p\<^sub>1)"
               using comp_inv_arr \<rho>.T0.antipar(1) comp_assoc_assoc' by simp
             also have "... = the_\<nu> \<cdot> (inv \<omega>.the_\<nu> \<star> \<rho>\<sigma>.p\<^sub>1) \<cdot> (\<omega>.the_\<nu> \<star> \<rho>\<sigma>.p\<^sub>1)"
               using comp_cod_arr \<rho>.T0.antipar(1) by simp
             also have "... = the_\<nu> \<cdot> (r\<^sub>1 \<star> \<rho>\<sigma>.p\<^sub>1)"
               using whisker_right [of \<rho>\<sigma>.p\<^sub>1] r\<^sub>0s\<^sub>1.ide_leg1 \<omega>.the_\<nu>_props(2) \<omega>.the_\<nu>_simps(4)
                     \<rho>.leg1_simps(2) comp_inv_arr'
               by metis
             also have "... = the_\<nu>"
               using comp_arr_dom by simp
             finally show ?thesis
               using comp_assoc by simp
           qed
           text \<open>
             Now reassociate to move @{term the_\<theta>} to the left and get other terms composed
             with @{term chine}, where they can be reduced to @{term \<tau>\<mu>.tab}.
           \<close>
           also have "... = (\<a>\<^sup>-\<^sup>1[t, u, s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0] \<cdot>
                              (t \<star> u \<star> the_\<theta>)) \<cdot> (t \<star> \<a>[u, u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0, chine]) \<cdot>
                              (t \<star> \<a>[u, u\<^sub>0, \<tau>\<mu>.p\<^sub>0] \<star> chine) \<cdot> (t \<star> (\<mu> \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine) \<cdot>
                              (t \<star> t\<^sub>0u\<^sub>1.\<phi> \<star> chine) \<cdot> (t \<star> \<a>\<^sup>-\<^sup>1[t\<^sub>0, \<tau>\<mu>.p\<^sub>1, chine]) \<cdot>
                              \<a>[t, t\<^sub>0, \<tau>\<mu>.p\<^sub>1 \<star> chine] \<cdot> (\<tau> \<star> \<tau>\<mu>.p\<^sub>1 \<star> chine) \<cdot>
                              \<a>[t\<^sub>1, \<tau>\<mu>.p\<^sub>1, chine] \<cdot> the_\<nu>"
           proof -
             have "arr ((u \<star> the_\<theta>) \<cdot> \<a>[u, u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0, chine] \<cdot> (\<a>[u, u\<^sub>0, \<tau>\<mu>.p\<^sub>0] \<star> chine) \<cdot>
                        ((\<mu> \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine) \<cdot> (t\<^sub>0u\<^sub>1.\<phi> \<star> chine) \<cdot> \<a>\<^sup>-\<^sup>1[t\<^sub>0, \<tau>\<mu>.p\<^sub>1, chine])"
               using \<theta>\<^sub>\<tau>' by blast
             moreover have "arr (\<a>[u, u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0, chine] \<cdot> (\<a>[u, u\<^sub>0, \<tau>\<mu>.p\<^sub>0] \<star> chine) \<cdot>
                                  ((\<mu> \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine) \<cdot> (t\<^sub>0u\<^sub>1.\<phi> \<star> chine) \<cdot> \<a>\<^sup>-\<^sup>1[t\<^sub>0, \<tau>\<mu>.p\<^sub>1, chine])"
               using calculation by blast
             moreover have "arr ((\<a>[u, u\<^sub>0, \<tau>\<mu>.p\<^sub>0] \<star> chine) \<cdot>
                                  ((\<mu> \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine) \<cdot> (t\<^sub>0u\<^sub>1.\<phi> \<star> chine) \<cdot> \<a>\<^sup>-\<^sup>1[t\<^sub>0, \<tau>\<mu>.p\<^sub>1, chine])"
               using calculation by blast
             moreover have "arr (((\<mu> \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine) \<cdot> (t\<^sub>0u\<^sub>1.\<phi> \<star> chine) \<cdot> \<a>\<^sup>-\<^sup>1[t\<^sub>0, \<tau>\<mu>.p\<^sub>1, chine])"
               using calculation by blast
             moreover have "arr ((t\<^sub>0u\<^sub>1.\<phi> \<star> chine) \<cdot> \<a>\<^sup>-\<^sup>1[t\<^sub>0, \<tau>\<mu>.p\<^sub>1, chine])"
               using calculation by blast
             ultimately
             have "t \<star> (u \<star> the_\<theta>) \<cdot> \<a>[u, u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0, chine] \<cdot> (\<a>[u, u\<^sub>0, \<tau>\<mu>.p\<^sub>0] \<star> chine) \<cdot>
                     ((\<mu> \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine) \<cdot> (t\<^sub>0u\<^sub>1.\<phi> \<star> chine) \<cdot> \<a>\<^sup>-\<^sup>1[t\<^sub>0, \<tau>\<mu>.p\<^sub>1, chine] =
                   (t \<star> u \<star> the_\<theta>) \<cdot> (t \<star> \<a>[u, u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0, chine]) \<cdot>
                     (t \<star> \<a>[u, u\<^sub>0, \<tau>\<mu>.p\<^sub>0] \<star> chine) \<cdot> (t \<star> (\<mu> \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine) \<cdot>
                     (t \<star> t\<^sub>0u\<^sub>1.\<phi> \<star> chine) \<cdot> (t \<star> \<a>\<^sup>-\<^sup>1[t\<^sub>0, \<tau>\<mu>.p\<^sub>1, chine])"
               using whisker_left \<rho>.T0.antipar(1) \<tau>.ide_base by presburger
             thus ?thesis
               using comp_assoc by presburger
           qed
           also have "... = ((t \<star> u) \<star> the_\<theta>) \<cdot> \<a>\<^sup>-\<^sup>1[t, u, (u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine] \<cdot>
                              (t \<star> \<a>[u, u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0, chine]) \<cdot> (t \<star> \<a>[u, u\<^sub>0, \<tau>\<mu>.p\<^sub>0] \<star> chine) \<cdot>
                              (t \<star> (\<mu> \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine) \<cdot>
                              (t \<star> t\<^sub>0u\<^sub>1.\<phi> \<star> chine) \<cdot>
                              (t \<star> \<a>\<^sup>-\<^sup>1[t\<^sub>0, \<tau>\<mu>.p\<^sub>1, chine]) \<cdot> \<a>[t, t\<^sub>0, \<tau>\<mu>.p\<^sub>1 \<star> chine] \<cdot>
                              ((\<tau> \<star> \<tau>\<mu>.p\<^sub>1 \<star> chine) \<cdot> \<a>[t\<^sub>1, \<tau>\<mu>.p\<^sub>1, chine]) \<cdot> the_\<nu>"
             using assoc'_naturality [of t u the_\<theta>] \<tau>\<mu>.composable \<theta>_simps(3) comp_assoc by auto
           also have "... = ((t \<star> u) \<star> the_\<theta>) \<cdot> \<a>\<^sup>-\<^sup>1[t, u, (u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine] \<cdot>
                              (t \<star> \<a>[u, u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0, chine]) \<cdot> (t \<star> \<a>[u, u\<^sub>0, \<tau>\<mu>.p\<^sub>0] \<star> chine) \<cdot>
                              (t \<star> (\<mu> \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine) \<cdot>
                              (t \<star> t\<^sub>0u\<^sub>1.\<phi> \<star> chine) \<cdot>
                              ((t \<star> \<a>\<^sup>-\<^sup>1[t\<^sub>0, \<tau>\<mu>.p\<^sub>1, chine]) \<cdot> \<a>[t, t\<^sub>0, \<tau>\<mu>.p\<^sub>1 \<star> chine] \<cdot>
                              \<a>[t \<star> t\<^sub>0, \<tau>\<mu>.p\<^sub>1, chine]) \<cdot> ((\<tau> \<star> \<tau>\<mu>.p\<^sub>1) \<star> chine) \<cdot> the_\<nu>"
           proof -
             have "(\<tau> \<star> \<tau>\<mu>.p\<^sub>1 \<star> chine) \<cdot> \<a>[t\<^sub>1, \<tau>\<mu>.p\<^sub>1, chine] =
                   \<a>[t \<star> t\<^sub>0, \<tau>\<mu>.p\<^sub>1, chine] \<cdot> ((\<tau> \<star> \<tau>\<mu>.p\<^sub>1) \<star> chine)"
               using assoc_naturality
               by (metis \<tau>.leg1_simps(3) \<tau>.tab_simps(1,2,4) \<tau>.tab_simps(5) \<tau>\<mu>.leg0_simps(2)
                   \<tau>\<mu>.leg1_simps(2) hseqE src_hcomp t\<^sub>0u\<^sub>1.leg1_simps(3,5-6) w_simps(2)
                   w_simps(4-6))
             thus ?thesis
               using comp_assoc by presburger
           qed
           also have "... = ((t \<star> u) \<star> the_\<theta>) \<cdot> \<a>\<^sup>-\<^sup>1[t, u, (u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine] \<cdot>
                              (t \<star> \<a>[u, u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0, chine]) \<cdot> (t \<star> \<a>[u, u\<^sub>0, \<tau>\<mu>.p\<^sub>0] \<star> chine) \<cdot>
                              (t \<star> (\<mu> \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine) \<cdot>
                              ((t \<star> t\<^sub>0u\<^sub>1.\<phi> \<star> chine) \<cdot> \<a>[t, t\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>1, chine]) \<cdot>
                              (\<a>[t, t\<^sub>0, \<tau>\<mu>.p\<^sub>1] \<star> chine) \<cdot> ((\<tau> \<star> \<tau>\<mu>.p\<^sub>1) \<star> chine) \<cdot> the_\<nu>"
           proof -
             have "(t \<star> \<a>\<^sup>-\<^sup>1[t\<^sub>0, \<tau>\<mu>.p\<^sub>1, chine]) \<cdot> \<a>[t, t\<^sub>0, \<tau>\<mu>.p\<^sub>1 \<star> chine] \<cdot>
                     \<a>[t \<star> t\<^sub>0, \<tau>\<mu>.p\<^sub>1, chine] =
                   \<a>[t, t\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>1, chine] \<cdot> (\<a>[t, t\<^sub>0, \<tau>\<mu>.p\<^sub>1] \<star> chine)"
               using pentagon t\<^sub>0u\<^sub>1.p\<^sub>1_simps uw\<theta> \<tau>.T0.antipar(1) iso_hcomp
                     comp_assoc_assoc'
                     invert_side_of_triangle(1)
                       [of "\<a>[t, t\<^sub>0, \<tau>\<mu>.p\<^sub>1 \<star> chine] \<cdot> \<a>[t \<star> t\<^sub>0, \<tau>\<mu>.p\<^sub>1, chine]"
                           "t \<star> \<a>[t\<^sub>0, \<tau>\<mu>.p\<^sub>1, chine]"
                           "\<a>[t, t\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>1, chine] \<cdot> (\<a>[t, t\<^sub>0, \<tau>\<mu>.p\<^sub>1] \<star> chine)"]
               by auto
             thus ?thesis
               using comp_assoc by presburger
           qed
           also have "... = ((t \<star> u) \<star> the_\<theta>) \<cdot> \<a>\<^sup>-\<^sup>1[t, u, (u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine] \<cdot>
                              (t \<star> \<a>[u, u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0, chine]) \<cdot> (t \<star> \<a>[u, u\<^sub>0, \<tau>\<mu>.p\<^sub>0] \<star> chine) \<cdot>
                              ((t \<star> (\<mu> \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine) \<cdot> \<a>[t, u\<^sub>1 \<star> \<tau>\<mu>.p\<^sub>0, chine]) \<cdot>
                              ((t \<star> t\<^sub>0u\<^sub>1.\<phi>) \<star> chine) \<cdot> 
                              (\<a>[t, t\<^sub>0, \<tau>\<mu>.p\<^sub>1] \<star> chine) \<cdot> ((\<tau> \<star> \<tau>\<mu>.p\<^sub>1) \<star> chine) \<cdot> the_\<nu>"
           proof -
             have "(t \<star> t\<^sub>0u\<^sub>1.\<phi> \<star> chine) \<cdot> \<a>[t, t\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>1, chine] =
                   \<a>[t, u\<^sub>1 \<star> \<tau>\<mu>.p\<^sub>0, chine] \<cdot> ((t \<star> t\<^sub>0u\<^sub>1.\<phi>) \<star> chine)"
               using assoc_naturality [of t t\<^sub>0u\<^sub>1.\<phi> chine] t\<^sub>0u\<^sub>1.cospan by auto
             thus ?thesis
               using comp_assoc by presburger
           qed
           also have "... = ((t \<star> u) \<star> the_\<theta>) \<cdot> \<a>\<^sup>-\<^sup>1[t, u, (u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine] \<cdot>
                              (t \<star> \<a>[u, u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0, chine]) \<cdot> (t \<star> \<a>[u, u\<^sub>0, \<tau>\<mu>.p\<^sub>0] \<star> chine) \<cdot>
                              \<a>[t, (u \<star> u\<^sub>0) \<star> \<tau>\<mu>.p\<^sub>0, chine] \<cdot>
                              ((t \<star> \<mu> \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine) \<cdot> ((t \<star> t\<^sub>0u\<^sub>1.\<phi>) \<star> chine) \<cdot> 
                              (\<a>[t, t\<^sub>0, \<tau>\<mu>.p\<^sub>1] \<star> chine) \<cdot> ((\<tau> \<star> \<tau>\<mu>.p\<^sub>1) \<star> chine) \<cdot> the_\<nu>"
           proof -
             have "(t \<star> (\<mu> \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine) \<cdot> \<a>[t, u\<^sub>1 \<star> \<tau>\<mu>.p\<^sub>0, chine] =
                   \<a>[t, (u \<star> u\<^sub>0) \<star> \<tau>\<mu>.p\<^sub>0, chine] \<cdot> ((t \<star> (\<mu> \<star> \<tau>\<mu>.p\<^sub>0)) \<star> chine)"
               using assoc_naturality [of t "\<mu> \<star> \<tau>\<mu>.p\<^sub>0" chine]
               by (simp add: \<tau>\<mu>.composable)
             thus ?thesis
               using comp_assoc by presburger
           qed
           also have "... = ((t \<star> u) \<star> the_\<theta>) \<cdot> \<a>\<^sup>-\<^sup>1[t, u, (u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine] \<cdot>
                              (t \<star> \<a>[u, u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0, chine]) \<cdot> (t \<star> \<a>[u, u\<^sub>0, \<tau>\<mu>.p\<^sub>0] \<star> chine) \<cdot>
                              \<a>[t, (u \<star> u\<^sub>0) \<star> \<tau>\<mu>.p\<^sub>0, chine] \<cdot>
                              ((t \<star> \<a>\<^sup>-\<^sup>1[u, u\<^sub>0, \<tau>\<mu>.p\<^sub>0]) \<star> chine) \<cdot> ((t \<star> \<a>[u, u\<^sub>0, \<tau>\<mu>.p\<^sub>0]) \<star> chine) \<cdot>
                              ((t \<star> \<mu> \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine) \<cdot> ((t \<star> t\<^sub>0u\<^sub>1.\<phi>) \<star> chine) \<cdot> 
                              (\<a>[t, t\<^sub>0, \<tau>\<mu>.p\<^sub>1] \<star> chine) \<cdot> ((\<tau> \<star> \<tau>\<mu>.p\<^sub>1) \<star> chine) \<cdot> the_\<nu>"
           proof -
             have "(((t \<star> \<a>\<^sup>-\<^sup>1[u, u\<^sub>0, \<tau>\<mu>.p\<^sub>0]) \<star> chine) \<cdot> ((t \<star> \<a>[u, u\<^sub>0, \<tau>\<mu>.p\<^sub>0]) \<star> chine)) \<cdot>
                     ((t \<star> \<mu> \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine) =
                   ((t \<star> ((u \<star> u\<^sub>0) \<star> \<tau>\<mu>.p\<^sub>0)) \<star> chine) \<cdot> ((t \<star> \<mu> \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine)"
               using whisker_right whisker_left [of t "\<a>\<^sup>-\<^sup>1[u, u\<^sub>0, \<tau>\<mu>.p\<^sub>0]" "\<a>[u, u\<^sub>0, \<tau>\<mu>.p\<^sub>0]"]
                     \<tau>\<mu>.composable comp_assoc_assoc'
               by simp
             also have "... = (t \<star> \<mu> \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine"
               using comp_cod_arr \<tau>\<mu>.composable by simp
             finally have "(((t \<star> \<a>\<^sup>-\<^sup>1[u, u\<^sub>0, \<tau>\<mu>.p\<^sub>0]) \<star> chine) \<cdot> ((t \<star> \<a>[u, u\<^sub>0, \<tau>\<mu>.p\<^sub>0]) \<star> chine)) \<cdot>
                             ((t \<star> \<mu> \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine) =
                           (t \<star> \<mu> \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine"
               by simp
             thus ?thesis
               using comp_assoc by metis
           qed
           also have "... = ((t \<star> u) \<star> the_\<theta>) \<cdot> \<a>\<^sup>-\<^sup>1[t, u, (u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine] \<cdot>
                              (t \<star> \<a>[u, u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0, chine]) \<cdot> (t \<star> \<a>[u, u\<^sub>0, \<tau>\<mu>.p\<^sub>0] \<star> chine) \<cdot>
                              \<a>[t, (u \<star> u\<^sub>0) \<star> \<tau>\<mu>.p\<^sub>0, chine] \<cdot>
                              ((t \<star> \<a>\<^sup>-\<^sup>1[u, u\<^sub>0, \<tau>\<mu>.p\<^sub>0]) \<star> chine) \<cdot> (((\<a>[t, u, u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0] \<star> chine) \<cdot>
                              (\<a>\<^sup>-\<^sup>1[t, u, u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0] \<star> chine)) \<cdot> ((t \<star> \<a>[u, u\<^sub>0, \<tau>\<mu>.p\<^sub>0]) \<star> chine)) \<cdot> 
                              ((t \<star> \<mu> \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine) \<cdot> ((t \<star> t\<^sub>0u\<^sub>1.\<phi>) \<star> chine) \<cdot> 
                              (\<a>[t, t\<^sub>0, \<tau>\<mu>.p\<^sub>1] \<star> chine) \<cdot> ((\<tau> \<star> \<tau>\<mu>.p\<^sub>1) \<star> chine) \<cdot> the_\<nu>"
           proof -
             have "((\<a>[t, u, u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0] \<star> chine) \<cdot> (\<a>\<^sup>-\<^sup>1[t, u, u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0] \<star> chine)) \<cdot>
                     ((t \<star> \<a>[u, u\<^sub>0, \<tau>\<mu>.p\<^sub>0]) \<star> chine) =
                   ((t \<star> \<a>[u, u\<^sub>0, \<tau>\<mu>.p\<^sub>0]) \<star> chine)"
               using comp_inv_arr' comp_cod_arr \<tau>\<mu>.composable comp_assoc_assoc'
                     whisker_right [of chine "\<a>[t, u, u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0]" "\<a>\<^sup>-\<^sup>1[t, u, u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0]"]
               by simp
             thus ?thesis
               using comp_assoc by simp
           qed
           also have "... = ((t \<star> u) \<star> the_\<theta>) \<cdot> \<a>\<^sup>-\<^sup>1[t, u, (u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine] \<cdot>
                              (t \<star> \<a>[u, u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0, chine]) \<cdot> (t \<star> \<a>[u, u\<^sub>0, \<tau>\<mu>.p\<^sub>0] \<star> chine) \<cdot>
                              \<a>[t, (u \<star> u\<^sub>0) \<star> \<tau>\<mu>.p\<^sub>0, chine] \<cdot>
                              ((t \<star> \<a>\<^sup>-\<^sup>1[u, u\<^sub>0, \<tau>\<mu>.p\<^sub>0]) \<star> chine) \<cdot> (\<a>[t, u, u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0] \<star> chine) \<cdot>
                              ((\<a>\<^sup>-\<^sup>1[t, u, u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0] \<star> chine) \<cdot> ((t \<star> \<a>[u, u\<^sub>0, \<tau>\<mu>.p\<^sub>0]) \<star> chine) \<cdot> 
                              ((t \<star> \<mu> \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine) \<cdot> ((t \<star> t\<^sub>0u\<^sub>1.\<phi>) \<star> chine) \<cdot> 
                              (\<a>[t, t\<^sub>0, \<tau>\<mu>.p\<^sub>1] \<star> chine) \<cdot> ((\<tau> \<star> \<tau>\<mu>.p\<^sub>1) \<star> chine)) \<cdot> the_\<nu>"
             using comp_assoc by presburger
           also have "... = ((t \<star> u) \<star> the_\<theta>) \<cdot>
                              (\<a>\<^sup>-\<^sup>1[t, u, (u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine] \<cdot>
                              (t \<star> \<a>[u, u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0, chine]) \<cdot> (t \<star> \<a>[u, u\<^sub>0, \<tau>\<mu>.p\<^sub>0] \<star> chine) \<cdot>
                              \<a>[t, (u \<star> u\<^sub>0) \<star> \<tau>\<mu>.p\<^sub>0, chine] \<cdot>
                              ((t \<star> \<a>\<^sup>-\<^sup>1[u, u\<^sub>0, \<tau>\<mu>.p\<^sub>0]) \<star> chine) \<cdot> (\<a>[t, u, u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0] \<star> chine)) \<cdot>
                              (\<tau>\<mu>.tab \<star> chine) \<cdot> the_\<nu>"
           proof -
             have "(\<a>\<^sup>-\<^sup>1[t, u, u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0] \<star> chine) \<cdot> ((t \<star> \<a>[u, u\<^sub>0, \<tau>\<mu>.p\<^sub>0]) \<star> chine) \<cdot> 
                              ((t \<star> \<mu> \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine) \<cdot> ((t \<star> t\<^sub>0u\<^sub>1.\<phi>) \<star> chine) \<cdot> 
                              (\<a>[t, t\<^sub>0, \<tau>\<mu>.p\<^sub>1] \<star> chine) \<cdot> ((\<tau> \<star> \<tau>\<mu>.p\<^sub>1) \<star> chine) =
                   \<tau>\<mu>.tab \<star> chine"
               using uw\<theta> whisker_right [of chine]
               by (metis \<tau>\<mu>.tab_def \<tau>\<mu>.tab_in_vhom' arrI seqE)
             thus ?thesis
               using comp_assoc by presburger
           qed
           also have "... = ((t \<star> u) \<star> the_\<theta>) \<cdot> \<a>[t \<star> u, u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0, chine] \<cdot> (\<tau>\<mu>.tab \<star> chine) \<cdot> the_\<nu>"
           proof -
             have "\<a>\<^sup>-\<^sup>1[t, u, (u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine] \<cdot> (t \<star> \<a>[u, u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0, chine]) \<cdot>
                     (t \<star> \<a>[u, u\<^sub>0, \<tau>\<mu>.p\<^sub>0] \<star> chine) \<cdot> \<a>[t, (u \<star> u\<^sub>0) \<star> \<tau>\<mu>.p\<^sub>0, chine] \<cdot>
                     ((t \<star> \<a>\<^sup>-\<^sup>1[u, u\<^sub>0, \<tau>\<mu>.p\<^sub>0]) \<star> chine) \<cdot> (\<a>[t, u, u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0] \<star> chine) =
                   \<lbrace>\<^bold>\<a>\<^sup>-\<^sup>1\<^bold>[\<^bold>\<langle>t\<^bold>\<rangle>, \<^bold>\<langle>u\<^bold>\<rangle>, (\<^bold>\<langle>u\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>\<tau>\<mu>.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>chine\<^bold>\<rangle>\<^bold>] \<^bold>\<cdot> (\<^bold>\<langle>t\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<a>\<^bold>[\<^bold>\<langle>u\<^bold>\<rangle>, \<^bold>\<langle>u\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>\<tau>\<mu>.p\<^sub>0\<^bold>\<rangle>, \<^bold>\<langle>chine\<^bold>\<rangle>\<^bold>]) \<^bold>\<cdot>
                    (\<^bold>\<langle>t\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<a>\<^bold>[\<^bold>\<langle>u\<^bold>\<rangle>, \<^bold>\<langle>u\<^sub>0\<^bold>\<rangle>, \<^bold>\<langle>\<tau>\<mu>.p\<^sub>0\<^bold>\<rangle>\<^bold>] \<^bold>\<star> \<^bold>\<langle>chine\<^bold>\<rangle>) \<^bold>\<cdot> \<^bold>\<a>\<^bold>[\<^bold>\<langle>t\<^bold>\<rangle>, (\<^bold>\<langle>u\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>u\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>\<tau>\<mu>.p\<^sub>0\<^bold>\<rangle>, \<^bold>\<langle>chine\<^bold>\<rangle>\<^bold>] \<^bold>\<cdot>
                    ((\<^bold>\<langle>t\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<a>\<^sup>-\<^sup>1\<^bold>[\<^bold>\<langle>u\<^bold>\<rangle>, \<^bold>\<langle>u\<^sub>0\<^bold>\<rangle>, \<^bold>\<langle>\<tau>\<mu>.p\<^sub>0\<^bold>\<rangle>\<^bold>]) \<^bold>\<star> \<^bold>\<langle>chine\<^bold>\<rangle>) \<^bold>\<cdot>
                    (\<^bold>\<a>\<^bold>[\<^bold>\<langle>t\<^bold>\<rangle>, \<^bold>\<langle>u\<^bold>\<rangle>, \<^bold>\<langle>u\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>\<tau>\<mu>.p\<^sub>0\<^bold>\<rangle>\<^bold>] \<^bold>\<star> \<^bold>\<langle>chine\<^bold>\<rangle>)\<rbrace>"
               using \<a>'_def \<alpha>_def \<tau>\<mu>.composable by simp
             also have "... = \<lbrace>\<^bold>\<a>\<^bold>[\<^bold>\<langle>t\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>u\<^bold>\<rangle>, \<^bold>\<langle>u\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>\<tau>\<mu>.p\<^sub>0\<^bold>\<rangle>, \<^bold>\<langle>chine\<^bold>\<rangle>\<^bold>]\<rbrace>"
               using \<tau>\<mu>.composable
               apply (intro E.eval_eqI) by simp_all
             also have "... = \<a>[t \<star> u, u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0, chine]"
               using \<a>'_def \<alpha>_def \<tau>\<mu>.composable by simp
             finally show ?thesis by simp
           qed
           also have "... = \<Delta>"
             using \<Delta>_naturality by simp
           finally show ?thesis by simp
         qed
         finally have "\<a>\<^sup>-\<^sup>1[t, u, s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0] \<cdot> LHS \<cdot> \<a>[t\<^sub>1, \<omega>.chine, \<rho>\<sigma>.p\<^sub>1] \<cdot> (\<omega>.the_\<nu> \<star> \<rho>\<sigma>.p\<^sub>1) =
                       \<a>\<^sup>-\<^sup>1[t, u, s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0] \<cdot> RHS \<cdot> \<a>[t\<^sub>1, \<omega>.chine, \<rho>\<sigma>.p\<^sub>1] \<cdot> (\<omega>.the_\<nu> \<star> \<rho>\<sigma>.p\<^sub>1)"
           by blast
         (*
          * TODO: This is common enough that there should be "cancel_iso_left" and
          * "cancel_iso_right" rules for doing it.
          *)
         hence "(LHS \<cdot> \<a>[t\<^sub>1, \<omega>.chine, \<rho>\<sigma>.p\<^sub>1]) \<cdot> (\<omega>.the_\<nu> \<star> \<rho>\<sigma>.p\<^sub>1) =
                (RHS \<cdot> \<a>[t\<^sub>1, \<omega>.chine, \<rho>\<sigma>.p\<^sub>1]) \<cdot> (\<omega>.the_\<nu> \<star> \<rho>\<sigma>.p\<^sub>1)"
           using u\<^sub>\<tau> r\<^sub>0s\<^sub>1.ide_u LHS RHS iso_is_section [of "\<a>\<^sup>-\<^sup>1[t, u, s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0]"] section_is_mono
                 monoE \<tau>\<mu>.composable comp_assoc
           by (metis (no_types, lifting) \<Delta>_simps(1) \<mu>.ide_base
               \<open>\<a>\<^sup>-\<^sup>1[t, u, s\<^sub>0 \<star> r\<^sub>0s\<^sub>1.p\<^sub>0] \<cdot> LHS \<cdot> \<a>[t\<^sub>1, \<omega>.chine, r\<^sub>0s\<^sub>1.p\<^sub>1] \<cdot> (\<omega>.the_\<nu> \<star> r\<^sub>0s\<^sub>1.p\<^sub>1) =
                ((\<omega> \<star> \<chi>) \<star> s\<^sub>0 \<star> r\<^sub>0s\<^sub>1.p\<^sub>0) \<cdot> \<rho>\<sigma>.tab\<close>
               \<tau>.ide_base hseq_char ideD(1) ide_u iso_assoc')
         hence 1: "LHS \<cdot> \<a>[t\<^sub>1, \<omega>.chine, \<rho>\<sigma>.p\<^sub>1] = RHS \<cdot> \<a>[t\<^sub>1, \<omega>.chine, \<rho>\<sigma>.p\<^sub>1]"
           using epiE LHS RHS iso_is_retraction retraction_is_epi \<tau>\<mu>.composable
                 \<omega>.the_\<nu>_props iso_hcomp
           by (metis \<Delta>_simps(1) \<omega>.the_\<nu>_simps(2)
               \<open>((\<omega> \<star> \<chi>) \<star> s\<^sub>0 \<star> r\<^sub>0s\<^sub>1.p\<^sub>0) \<cdot> \<rho>\<sigma>.tab =
                \<a>\<^sup>-\<^sup>1[t, u, s\<^sub>0 \<star> r\<^sub>0s\<^sub>1.p\<^sub>0] \<cdot> RHS \<cdot> \<a>[t\<^sub>1, \<omega>.chine, r\<^sub>0s\<^sub>1.p\<^sub>1] \<cdot> (\<omega>.the_\<nu> \<star> r\<^sub>0s\<^sub>1.p\<^sub>1)\<close>
               \<rho>.leg1_simps(3) ide_is_iso local.comp_assoc r\<^sub>0s\<^sub>1.ide_leg1 r\<^sub>0s\<^sub>1.p\<^sub>1_simps seqE)
         show "LHS = RHS"
         proof -
           have "epi \<a>[t\<^sub>1, \<omega>.chine, \<rho>\<sigma>.p\<^sub>1]"
             using iso_is_retraction retraction_is_epi \<rho>.T0.antipar(1) by simp
           moreover have "seq LHS \<a>[t\<^sub>1, \<omega>.chine, \<rho>\<sigma>.p\<^sub>1]"
             using LHS \<rho>.T0.antipar(1) by auto
           moreover have "seq RHS \<a>[t\<^sub>1, \<omega>.chine, \<rho>\<sigma>.p\<^sub>1]"
             using RHS \<rho>.T0.antipar(1) by auto
           ultimately show ?thesis
             using epiE 1 by blast
         qed
       qed
       have 1: "\<exists>!\<gamma>. \<guillemotleft>\<gamma> : ?w\<^sub>\<tau> \<Rightarrow> ?w\<^sub>\<tau>'\<guillemotright> \<and> ?\<beta>\<^sub>\<tau> = t\<^sub>1 \<star> \<gamma> \<and> ?\<theta>\<^sub>\<tau> = ?\<theta>\<^sub>\<tau>' \<cdot> (t\<^sub>0 \<star> \<gamma>)"
         using LHS_def RHS_def u\<^sub>\<tau> w\<^sub>\<tau> w\<^sub>\<tau>' \<beta>\<^sub>\<tau> \<theta>\<^sub>\<tau> \<theta>\<^sub>\<tau>' eq \<tau>.T2 [of ?w\<^sub>\<tau> ?w\<^sub>\<tau>' ?\<theta>\<^sub>\<tau> ?u\<^sub>\<tau> ?\<theta>\<^sub>\<tau>' ?\<beta>\<^sub>\<tau>]
         by fastforce
       obtain \<gamma>\<^sub>\<tau> where \<gamma>\<^sub>\<tau>: "\<guillemotleft>\<gamma>\<^sub>\<tau> : ?w\<^sub>\<tau> \<Rightarrow> ?w\<^sub>\<tau>'\<guillemotright> \<and> ?\<beta>\<^sub>\<tau> = t\<^sub>1 \<star> \<gamma>\<^sub>\<tau> \<and> ?\<theta>\<^sub>\<tau> = ?\<theta>\<^sub>\<tau>' \<cdot> (t\<^sub>0 \<star> \<gamma>\<^sub>\<tau>)"
         using 1 by auto
       text \<open>
         At this point we could show that @{term \<gamma>\<^sub>\<tau>} is invertible using \<open>BS3\<close>,
         but we want to avoid using \<open>BS3\<close> if possible and we also want to
         establish a characterization of @{term "inv \<gamma>\<^sub>\<tau>"}.  So we show the invertibility of
         @{term \<gamma>\<^sub>\<tau>} directly, using a few more applications of \<open>T2\<close>.
       \<close>
       have iso_\<beta>\<^sub>\<tau>: "iso ?\<beta>\<^sub>\<tau>"
         using uw\<theta> \<beta>\<^sub>\<tau> the_\<nu>_props \<omega>.the_\<nu>_props iso_inv_iso hseqI'
               iso_assoc' \<omega>.hseq_leg\<^sub>0 iso_inv_iso iso_hcomp
         apply (intro isos_compose)
               apply (metis \<omega>.is_ide \<rho>\<sigma>.leg1_simps(2) \<tau>.ide_leg1 \<tau>.leg1_simps(2)
                            \<tau>.leg1_simps(3) hseqE r\<^sub>0s\<^sub>1.ide_leg1 hcomp_simps(1) vconn_implies_hpar(3))
              apply (metis \<rho>\<sigma>.leg1_simps(2) hseqE ide_is_iso r\<^sub>0s\<^sub>1.ide_leg1 src_inv
                           vconn_implies_hpar(1))
             apply blast
            apply blast
           apply blast
          apply (metis \<tau>.ide_leg1 \<tau>.leg1_simps(3) hseqE ide_char iso_assoc t\<^sub>0u\<^sub>1.ide_leg1
                       t\<^sub>0u\<^sub>1.p\<^sub>1_simps w\<^sub>\<tau>')
         by blast
       hence eq': "((t \<star> ?\<theta>\<^sub>\<tau>') \<cdot> \<a>[t, t\<^sub>0, ?w\<^sub>\<tau>'] \<cdot> (\<tau> \<star> ?w\<^sub>\<tau>')) =
                   ((t \<star> ?\<theta>\<^sub>\<tau>) \<cdot> \<a>[t, t\<^sub>0, ?w\<^sub>\<tau>] \<cdot> (\<tau> \<star> ?w\<^sub>\<tau>)) \<cdot> inv ?\<beta>\<^sub>\<tau>"
       proof -
         have "seq ((t \<star> ?\<theta>\<^sub>\<tau>') \<cdot> \<a>[t, t\<^sub>0, ?w\<^sub>\<tau>'] \<cdot> (\<tau> \<star> ?w\<^sub>\<tau>')) ?\<beta>\<^sub>\<tau>"
           using LHS RHS_def eq by blast
         hence "(t \<star> ?\<theta>\<^sub>\<tau>') \<cdot> \<a>[t, t\<^sub>0, ?w\<^sub>\<tau>'] \<cdot> (\<tau> \<star> ?w\<^sub>\<tau>') =
                (((t \<star> ?\<theta>\<^sub>\<tau>') \<cdot> \<a>[t, t\<^sub>0, ?w\<^sub>\<tau>'] \<cdot> (\<tau> \<star> ?w\<^sub>\<tau>')) \<cdot> ?\<beta>\<^sub>\<tau>) \<cdot> inv ?\<beta>\<^sub>\<tau>"
           by (meson invert_side_of_triangle(2) iso_\<beta>\<^sub>\<tau>)
         thus ?thesis
           using LHS_def RHS_def eq by argo
       qed
       have 2: "\<exists>!\<gamma>. \<guillemotleft>\<gamma> : ?w\<^sub>\<tau>' \<Rightarrow> ?w\<^sub>\<tau>\<guillemotright> \<and> inv ?\<beta>\<^sub>\<tau> = t\<^sub>1 \<star> \<gamma> \<and> ?\<theta>\<^sub>\<tau>' = ?\<theta>\<^sub>\<tau> \<cdot> (t\<^sub>0 \<star> \<gamma>)"
         using u\<^sub>\<tau> w\<^sub>\<tau> w\<^sub>\<tau>' \<beta>\<^sub>\<tau> \<theta>\<^sub>\<tau> \<theta>\<^sub>\<tau>' eq' \<tau>.T2 [of ?w\<^sub>\<tau>' ?w\<^sub>\<tau> ?\<theta>\<^sub>\<tau>'?u\<^sub>\<tau> ?\<theta>\<^sub>\<tau> "inv ?\<beta>\<^sub>\<tau>"] iso_\<beta>\<^sub>\<tau> comp_assoc
         by blast
       obtain \<gamma>\<^sub>\<tau>' where
         \<gamma>\<^sub>\<tau>': "\<guillemotleft>\<gamma>\<^sub>\<tau>' : ?w\<^sub>\<tau>' \<Rightarrow> ?w\<^sub>\<tau>\<guillemotright> \<and> inv ?\<beta>\<^sub>\<tau> = t\<^sub>1 \<star> \<gamma>\<^sub>\<tau>' \<and> ?\<theta>\<^sub>\<tau>' = ?\<theta>\<^sub>\<tau> \<cdot> (t\<^sub>0 \<star> \<gamma>\<^sub>\<tau>')"
         using 2 by auto
       have "inverse_arrows \<gamma>\<^sub>\<tau> \<gamma>\<^sub>\<tau>'"
       proof
         have "\<guillemotleft>\<gamma>\<^sub>\<tau>' \<cdot> \<gamma>\<^sub>\<tau> : ?w\<^sub>\<tau> \<Rightarrow> ?w\<^sub>\<tau>\<guillemotright>"
           using \<gamma>\<^sub>\<tau> \<gamma>\<^sub>\<tau>' by auto
         moreover have "t\<^sub>1 \<star> \<gamma>\<^sub>\<tau>' \<cdot> \<gamma>\<^sub>\<tau> = t\<^sub>1 \<star> ?w\<^sub>\<tau>"
           using \<gamma>\<^sub>\<tau> \<gamma>\<^sub>\<tau>' whisker_left \<beta>\<^sub>\<tau> iso_\<beta>\<^sub>\<tau> comp_inv_arr'
           by (metis (no_types, lifting) \<tau>.ide_leg1 calculation in_homE)
         moreover have "?\<theta>\<^sub>\<tau> = ?\<theta>\<^sub>\<tau> \<cdot> (t\<^sub>0 \<star> \<gamma>\<^sub>\<tau>' \<cdot> \<gamma>\<^sub>\<tau>)"
         proof -
           have "?\<theta>\<^sub>\<tau> = ?\<theta>\<^sub>\<tau>' \<cdot> (t\<^sub>0 \<star> \<gamma>\<^sub>\<tau>)"
             using \<gamma>\<^sub>\<tau> by simp
           also have "... = ?\<theta>\<^sub>\<tau> \<cdot> (t\<^sub>0 \<star> \<gamma>\<^sub>\<tau>') \<cdot> (t\<^sub>0 \<star> \<gamma>\<^sub>\<tau>)"
             using \<gamma>\<^sub>\<tau>' comp_assoc by simp
           also have "... = ?\<theta>\<^sub>\<tau> \<cdot> (t\<^sub>0 \<star> \<gamma>\<^sub>\<tau>' \<cdot> \<gamma>\<^sub>\<tau>)"
             using \<gamma>\<^sub>\<tau> \<gamma>\<^sub>\<tau>' whisker_left
             by (metis (full_types) \<tau>.ide_leg0 seqI')
           finally show ?thesis by simp
         qed
         moreover have
           "\<And>\<gamma>. \<guillemotleft>\<gamma> : ?w\<^sub>\<tau> \<Rightarrow> ?w\<^sub>\<tau>\<guillemotright> \<and> t\<^sub>1 \<star> \<gamma> = t\<^sub>1 \<star> ?w\<^sub>\<tau> \<and> ?\<theta>\<^sub>\<tau> = ?\<theta>\<^sub>\<tau> \<cdot> (t\<^sub>0 \<star> \<gamma>) \<Longrightarrow> \<gamma> = ?w\<^sub>\<tau>"
         proof -
           have "\<exists>!\<gamma>. \<guillemotleft>\<gamma> : ?w\<^sub>\<tau> \<Rightarrow> ?w\<^sub>\<tau>\<guillemotright> \<and> t\<^sub>1 \<star> ?w\<^sub>\<tau> = t\<^sub>1 \<star> \<gamma> \<and> ?\<theta>\<^sub>\<tau> = ?\<theta>\<^sub>\<tau> \<cdot> (t\<^sub>0 \<star> \<gamma>)"
           proof -
             have "(t \<star> ?\<theta>\<^sub>\<tau>) \<cdot> \<a>[t, t\<^sub>0, ?w\<^sub>\<tau>] \<cdot> (\<tau> \<star> ?w\<^sub>\<tau>) =
                   ((t \<star> ?\<theta>\<^sub>\<tau>) \<cdot> \<a>[t, t\<^sub>0, ?w\<^sub>\<tau>] \<cdot> (\<tau> \<star> ?w\<^sub>\<tau>)) \<cdot> (t\<^sub>1 \<star> ?w\<^sub>\<tau>)"
               by (metis LHS LHS_def comp_arr_dom in_homE)
             thus ?thesis
               using w\<^sub>\<tau> \<theta>\<^sub>\<tau> \<omega>.w_simps(4) \<tau>.leg1_in_hom(2) \<tau>.leg1_simps(3) hcomp_in_vhom ideD(1)
                     trg_hcomp ide_in_hom(2) \<tau>.T2
               by presburger
           qed
           thus "\<And>\<gamma>. \<guillemotleft>\<gamma> : ?w\<^sub>\<tau> \<Rightarrow> ?w\<^sub>\<tau>\<guillemotright> \<and> t\<^sub>1 \<star> \<gamma> = t\<^sub>1 \<star> ?w\<^sub>\<tau> \<and> ?\<theta>\<^sub>\<tau> = ?\<theta>\<^sub>\<tau> \<cdot> (t\<^sub>0 \<star> \<gamma>) \<Longrightarrow> \<gamma> = ?w\<^sub>\<tau>"
             by (metis \<theta>\<^sub>\<tau> comp_arr_dom ide_in_hom(2) in_homE w\<^sub>\<tau>)
         qed
         ultimately have "\<gamma>\<^sub>\<tau>' \<cdot> \<gamma>\<^sub>\<tau> = ?w\<^sub>\<tau>"
           by simp
         thus "ide (\<gamma>\<^sub>\<tau>' \<cdot> \<gamma>\<^sub>\<tau>)"
           using w\<^sub>\<tau> by simp
         have "\<guillemotleft>\<gamma>\<^sub>\<tau> \<cdot> \<gamma>\<^sub>\<tau>' : ?w\<^sub>\<tau>' \<Rightarrow> ?w\<^sub>\<tau>'\<guillemotright>"
           using \<gamma>\<^sub>\<tau> \<gamma>\<^sub>\<tau>' by auto
         moreover have "t\<^sub>1 \<star> \<gamma>\<^sub>\<tau> \<cdot> \<gamma>\<^sub>\<tau>' = t\<^sub>1 \<star> ?w\<^sub>\<tau>'"
           by (metis \<beta>\<^sub>\<tau> \<gamma>\<^sub>\<tau> \<gamma>\<^sub>\<tau>' \<tau>.ide_leg1 calculation comp_arr_inv' in_homE iso_\<beta>\<^sub>\<tau> whisker_left)
         moreover have "?\<theta>\<^sub>\<tau>' = ?\<theta>\<^sub>\<tau>' \<cdot> (t\<^sub>0 \<star> \<gamma>\<^sub>\<tau> \<cdot> \<gamma>\<^sub>\<tau>')"
         proof -
           have "?\<theta>\<^sub>\<tau>' = ?\<theta>\<^sub>\<tau> \<cdot> (t\<^sub>0 \<star> \<gamma>\<^sub>\<tau>')"
             using \<gamma>\<^sub>\<tau>' by simp
           also have "... = ?\<theta>\<^sub>\<tau>' \<cdot> (t\<^sub>0 \<star> \<gamma>\<^sub>\<tau>) \<cdot> (t\<^sub>0 \<star> \<gamma>\<^sub>\<tau>')"
             using \<gamma>\<^sub>\<tau> comp_assoc by simp
           also have "... = ?\<theta>\<^sub>\<tau>' \<cdot> (t\<^sub>0 \<star> \<gamma>\<^sub>\<tau> \<cdot> \<gamma>\<^sub>\<tau>')"
             using \<gamma>\<^sub>\<tau> \<gamma>\<^sub>\<tau>' whisker_left
             by (metis (full_types) \<tau>.ide_leg0 seqI')
           finally show ?thesis by simp
         qed
         moreover have "\<And>\<gamma>. \<guillemotleft>\<gamma> : ?w\<^sub>\<tau>' \<Rightarrow> ?w\<^sub>\<tau>'\<guillemotright> \<and> t\<^sub>1 \<star> \<gamma> = t\<^sub>1 \<star> ?w\<^sub>\<tau>' \<and> ?\<theta>\<^sub>\<tau>' = ?\<theta>\<^sub>\<tau>' \<cdot> (t\<^sub>0 \<star> \<gamma>)
                               \<Longrightarrow> \<gamma> = ?w\<^sub>\<tau>'"
         proof -
           have "\<exists>!\<gamma>. \<guillemotleft>\<gamma> : ?w\<^sub>\<tau>' \<Rightarrow> ?w\<^sub>\<tau>'\<guillemotright> \<and> t\<^sub>1 \<star> ?w\<^sub>\<tau>' = t\<^sub>1 \<star> \<gamma> \<and> ?\<theta>\<^sub>\<tau>' = ?\<theta>\<^sub>\<tau>' \<cdot> (t\<^sub>0 \<star> \<gamma>)"
           proof -
             have "(t \<star> ?\<theta>\<^sub>\<tau>') \<cdot> \<a>[t, t\<^sub>0, ?w\<^sub>\<tau>'] \<cdot> (\<tau> \<star> ?w\<^sub>\<tau>') =
                   ((t \<star> ?\<theta>\<^sub>\<tau>') \<cdot> \<a>[t, t\<^sub>0, ?w\<^sub>\<tau>'] \<cdot> (\<tau> \<star> ?w\<^sub>\<tau>')) \<cdot> (t\<^sub>1 \<star> ?w\<^sub>\<tau>')"
             proof -
               have 1: "t\<^sub>1 \<star> \<gamma>\<^sub>\<tau> \<cdot> \<gamma>\<^sub>\<tau>' = (t\<^sub>1 \<star> \<gamma>\<^sub>\<tau>) \<cdot> (t\<^sub>1 \<star> \<gamma>\<^sub>\<tau>')"
                 by (meson \<gamma>\<^sub>\<tau> \<gamma>\<^sub>\<tau>' \<tau>.ide_leg1 seqI' whisker_left)
               have "((LHS \<cdot> inv ?\<beta>\<^sub>\<tau>) \<cdot> (t\<^sub>1 \<star> \<gamma>\<^sub>\<tau>)) \<cdot> (t\<^sub>1 \<star> \<gamma>\<^sub>\<tau>') = LHS \<cdot> inv ?\<beta>\<^sub>\<tau>"
                 using LHS_def RHS_def \<gamma>\<^sub>\<tau> \<gamma>\<^sub>\<tau>' eq eq' by argo
               thus ?thesis
                 unfolding LHS_def
                 using 1 by (simp add: calculation(2) eq' comp_assoc)
             qed
             thus ?thesis
               using w\<^sub>\<tau>' \<theta>\<^sub>\<tau>' \<omega>.w_simps(4) \<tau>.leg1_in_hom(2) \<tau>.leg1_simps(3) hcomp_in_vhom ideD(1)
                     trg_hcomp ide_in_hom(2) \<tau>.T2 \<tau>.T0.antipar(1) t\<^sub>0u\<^sub>1.base_simps(2)
                     t\<^sub>0u\<^sub>1.leg1_simps(4)
               by presburger
           qed
           thus "\<And>\<gamma>. \<guillemotleft>\<gamma> : ?w\<^sub>\<tau>' \<Rightarrow> ?w\<^sub>\<tau>'\<guillemotright> \<and> t\<^sub>1 \<star> \<gamma> = t\<^sub>1 \<star> ?w\<^sub>\<tau>' \<and> ?\<theta>\<^sub>\<tau>' = ?\<theta>\<^sub>\<tau>' \<cdot> (t\<^sub>0 \<star> \<gamma>)
                          \<Longrightarrow> \<gamma> = ?w\<^sub>\<tau>'"
             by (metis \<theta>\<^sub>\<tau>' comp_arr_dom ide_in_hom(2) in_homE w\<^sub>\<tau>')
         qed
         ultimately have "\<gamma>\<^sub>\<tau> \<cdot> \<gamma>\<^sub>\<tau>' = ?w\<^sub>\<tau>'"
           by simp
         thus "ide (\<gamma>\<^sub>\<tau> \<cdot> \<gamma>\<^sub>\<tau>')"
           using w\<^sub>\<tau>' by simp
       qed
       thus "\<tau>\<mu>.p\<^sub>1 \<star> chine \<cong> \<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1"
         using w\<^sub>\<tau> w\<^sub>\<tau>' \<gamma>\<^sub>\<tau> isomorphic_symmetric isomorphic_def by blast
       have iso_\<gamma>\<^sub>\<tau>: "iso \<gamma>\<^sub>\<tau>"
         using \<open>inverse_arrows \<gamma>\<^sub>\<tau> \<gamma>\<^sub>\<tau>'\<close> by auto
       have \<gamma>\<^sub>\<tau>'_eq: "\<gamma>\<^sub>\<tau>' = inv \<gamma>\<^sub>\<tau>"
         using \<open>inverse_arrows \<gamma>\<^sub>\<tau> \<gamma>\<^sub>\<tau>'\<close> inverse_unique by blast
 
       let ?w\<^sub>\<mu> = "\<tau>\<mu>.p\<^sub>0 \<star> chine"
       let ?w\<^sub>\<mu>' = "\<chi>.chine \<star> \<rho>\<sigma>.p\<^sub>0"
       let ?u\<^sub>\<mu> = "s\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>0"
       let ?\<theta>\<^sub>\<mu> = "the_\<theta> \<cdot> \<a>\<^sup>-\<^sup>1[u\<^sub>0, \<tau>\<mu>.p\<^sub>0, chine]"
       let ?\<theta>\<^sub>\<mu>' = "(\<chi>.the_\<theta> \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> \<a>\<^sup>-\<^sup>1[u\<^sub>0, \<chi>.chine, \<rho>\<sigma>.p\<^sub>0]"
       let ?\<beta>\<^sub>\<mu> = "\<a>[u\<^sub>1, \<chi>.chine, \<rho>\<sigma>.p\<^sub>0] \<cdot> (\<chi>.the_\<nu> \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> r\<^sub>0s\<^sub>1.\<phi> \<cdot> (\<omega>.the_\<theta> \<star> \<rho>\<sigma>.p\<^sub>1) \<cdot>
                   \<a>\<^sup>-\<^sup>1[t\<^sub>0, \<omega>.chine, \<rho>\<sigma>.p\<^sub>1] \<cdot> (t\<^sub>0 \<star> inv \<gamma>\<^sub>\<tau>) \<cdot> \<a>[t\<^sub>0, \<tau>\<mu>.p\<^sub>1, chine] \<cdot>
                   (inv t\<^sub>0u\<^sub>1.\<phi> \<star> chine) \<cdot> \<a>\<^sup>-\<^sup>1[u\<^sub>1, \<tau>\<mu>.p\<^sub>0, chine]"
       have w\<^sub>\<mu>: "ide ?w\<^sub>\<mu> \<and> is_left_adjoint ?w\<^sub>\<mu>"
         using is_map left_adjoints_compose by simp
       have w\<^sub>\<mu>': "ide ?w\<^sub>\<mu>' \<and> is_left_adjoint ?w\<^sub>\<mu>'"
         using \<chi>.is_map left_adjoints_compose
         by (simp add: is_map left_adjoints_compose)
       have 1: "\<exists>!\<gamma>. \<guillemotleft>\<gamma> : ?w\<^sub>\<mu> \<Rightarrow> ?w\<^sub>\<mu>'\<guillemotright> \<and> ?\<beta>\<^sub>\<mu> = u\<^sub>1 \<star> \<gamma> \<and> ?\<theta>\<^sub>\<mu> = ?\<theta>\<^sub>\<mu>' \<cdot> (u\<^sub>0 \<star> \<gamma>)"
       proof -
         have \<theta>\<^sub>\<mu>: "\<guillemotleft>?\<theta>\<^sub>\<mu> : u\<^sub>0 \<star> ?w\<^sub>\<mu> \<Rightarrow> ?u\<^sub>\<mu>\<guillemotright>"
           by auto
         have \<theta>\<^sub>\<mu>': "\<guillemotleft>?\<theta>\<^sub>\<mu>' : u\<^sub>0 \<star> ?w\<^sub>\<mu>' \<Rightarrow> ?u\<^sub>\<mu>\<guillemotright>"
           by fastforce
         have \<beta>\<^sub>\<mu>: "\<guillemotleft>?\<beta>\<^sub>\<mu> : u\<^sub>1 \<star> ?w\<^sub>\<mu> \<Rightarrow> u\<^sub>1 \<star> ?w\<^sub>\<mu>'\<guillemotright>"
         proof (intro comp_in_homI)
           show "\<guillemotleft>\<a>\<^sup>-\<^sup>1[u\<^sub>1, \<tau>\<mu>.p\<^sub>0, chine] : u\<^sub>1 \<star> \<tau>\<mu>.p\<^sub>0 \<star> chine \<Rightarrow> (u\<^sub>1 \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine\<guillemotright>"
             by auto
           show "\<guillemotleft>inv t\<^sub>0u\<^sub>1.\<phi> \<star> chine : (u\<^sub>1 \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine \<Rightarrow> (t\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>1) \<star> chine\<guillemotright>"
             using t\<^sub>0u\<^sub>1.\<phi>_in_hom(2) t\<^sub>0u\<^sub>1.\<phi>_uniqueness(2) by auto
           show "\<guillemotleft>\<a>[t\<^sub>0, \<tau>\<mu>.p\<^sub>1, chine] : (t\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>1) \<star> chine \<Rightarrow> t\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>1 \<star> chine\<guillemotright>"
             using \<tau>.T0.antipar(1) by auto
           show "\<guillemotleft>t\<^sub>0 \<star> inv \<gamma>\<^sub>\<tau> : t\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>1 \<star> chine \<Rightarrow> t\<^sub>0 \<star> \<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1\<guillemotright>"
             using \<gamma>\<^sub>\<tau> iso_\<gamma>\<^sub>\<tau> using \<tau>.T0.antipar(1) by auto
           show "\<guillemotleft>\<a>\<^sup>-\<^sup>1[t\<^sub>0, \<omega>.chine, \<rho>\<sigma>.p\<^sub>1] : t\<^sub>0 \<star> \<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1 \<Rightarrow> (t\<^sub>0 \<star> \<omega>.chine) \<star> \<rho>\<sigma>.p\<^sub>1\<guillemotright>"
             using \<rho>.T0.antipar(1) by auto
           show "\<guillemotleft>\<omega>.the_\<theta> \<star> \<rho>\<sigma>.p\<^sub>1 : (t\<^sub>0 \<star> \<omega>.chine) \<star> \<rho>\<sigma>.p\<^sub>1 \<Rightarrow> r\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>1\<guillemotright>"
             using \<rho>.T0.antipar(1) by auto
           show "\<guillemotleft>r\<^sub>0s\<^sub>1.\<phi> : r\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>1 \<Rightarrow> s\<^sub>1 \<star> \<rho>\<sigma>.p\<^sub>0\<guillemotright>"
             by auto
           show "\<guillemotleft>\<chi>.the_\<nu> \<star> \<rho>\<sigma>.p\<^sub>0 : s\<^sub>1 \<star> \<rho>\<sigma>.p\<^sub>0 \<Rightarrow> (u\<^sub>1 \<star> \<chi>.chine) \<star> \<rho>\<sigma>.p\<^sub>0\<guillemotright>"
             by auto
           show "\<guillemotleft>\<a>[u\<^sub>1, \<chi>.chine, \<rho>\<sigma>.p\<^sub>0] : (u\<^sub>1 \<star> \<chi>.chine) \<star> \<rho>\<sigma>.p\<^sub>0 \<Rightarrow> u\<^sub>1 \<star> \<chi>.chine \<star> \<rho>\<sigma>.p\<^sub>0\<guillemotright>"
             by auto
         qed
         text \<open>
           The proof of the equation below needs to make use of the equation
           \<open>\<theta>\<^sub>\<tau>' = \<theta>\<^sub>\<tau> \<cdot> (t\<^sub>0 \<star> \<gamma>\<^sub>\<tau>')\<close> from the previous section.  So the overall strategy is to
           work toward an expression of the form \<open>\<theta>\<^sub>\<tau> \<cdot> (t\<^sub>0 \<star> \<gamma>\<^sub>\<tau>')\<close> and perform the replacement
           to eliminate \<open>\<gamma>\<^sub>\<tau>'\<close>.
         \<close>
         have eq\<^sub>\<mu>: "(u \<star> ?\<theta>\<^sub>\<mu>) \<cdot> \<a>[u, u\<^sub>0, ?w\<^sub>\<mu>] \<cdot> (\<mu> \<star> ?w\<^sub>\<mu>) =
                    ((u \<star> ?\<theta>\<^sub>\<mu>') \<cdot> \<a>[u, u\<^sub>0, ?w\<^sub>\<mu>'] \<cdot> (\<mu> \<star> ?w\<^sub>\<mu>')) \<cdot> ?\<beta>\<^sub>\<mu>"
         proof -
           let ?LHS = "(u \<star> ?\<theta>\<^sub>\<mu>) \<cdot> \<a>[u, u\<^sub>0, ?w\<^sub>\<mu>] \<cdot> (\<mu> \<star> ?w\<^sub>\<mu>)"
           let ?RHS = "((u \<star> ?\<theta>\<^sub>\<mu>') \<cdot> \<a>[u, u\<^sub>0, ?w\<^sub>\<mu>'] \<cdot> (\<mu> \<star> ?w\<^sub>\<mu>')) \<cdot> ?\<beta>\<^sub>\<mu>"
           have "?RHS = (u \<star> (\<chi>.the_\<theta> \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> \<a>\<^sup>-\<^sup>1[u\<^sub>0, \<chi>.chine, \<rho>\<sigma>.p\<^sub>0]) \<cdot>
                          \<a>[u, u\<^sub>0, \<chi>.chine \<star> \<rho>\<sigma>.p\<^sub>0] \<cdot> (\<mu> \<star> \<chi>.chine \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot>
                          \<a>[u\<^sub>1, \<chi>.chine, \<rho>\<sigma>.p\<^sub>0] \<cdot> (\<chi>.the_\<nu> \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> r\<^sub>0s\<^sub>1.\<phi> \<cdot>
                          (\<omega>.the_\<theta> \<star> \<rho>\<sigma>.p\<^sub>1) \<cdot> \<a>\<^sup>-\<^sup>1[t\<^sub>0, \<omega>.chine, \<rho>\<sigma>.p\<^sub>1] \<cdot> (t\<^sub>0 \<star> inv \<gamma>\<^sub>\<tau>) \<cdot>
                          \<a>[t\<^sub>0, \<tau>\<mu>.p\<^sub>1, chine] \<cdot> (inv t\<^sub>0u\<^sub>1.\<phi> \<star> chine) \<cdot> \<a>\<^sup>-\<^sup>1[u\<^sub>1, \<tau>\<mu>.p\<^sub>0, chine]"
             using comp_assoc by presburger
           also have "... = (u \<star> \<chi>.the_\<theta> \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> ((u \<star> \<a>\<^sup>-\<^sup>1[u\<^sub>0, \<chi>.chine, \<rho>\<sigma>.p\<^sub>0]) \<cdot>
                              \<a>[u, u\<^sub>0, \<chi>.chine \<star> \<rho>\<sigma>.p\<^sub>0]) \<cdot> (\<mu> \<star> \<chi>.chine \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot>
                              \<a>[u\<^sub>1, \<chi>.chine, \<rho>\<sigma>.p\<^sub>0] \<cdot> (\<chi>.the_\<nu> \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> r\<^sub>0s\<^sub>1.\<phi> \<cdot>
                              (\<omega>.the_\<theta> \<star> \<rho>\<sigma>.p\<^sub>1) \<cdot> \<a>\<^sup>-\<^sup>1[t\<^sub>0, \<omega>.chine, \<rho>\<sigma>.p\<^sub>1] \<cdot> (t\<^sub>0 \<star> inv \<gamma>\<^sub>\<tau>) \<cdot>
                              \<a>[t\<^sub>0, \<tau>\<mu>.p\<^sub>1, chine] \<cdot> (inv t\<^sub>0u\<^sub>1.\<phi> \<star> chine) \<cdot>
                              \<a>\<^sup>-\<^sup>1[u\<^sub>1, \<tau>\<mu>.p\<^sub>0, chine]"
           proof -
             have "u \<star> (\<chi>.the_\<theta> \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> \<a>\<^sup>-\<^sup>1[u\<^sub>0, \<chi>.chine, \<rho>\<sigma>.p\<^sub>0] =
                   (u \<star> \<chi>.the_\<theta> \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> (u \<star> \<a>\<^sup>-\<^sup>1[u\<^sub>0, \<chi>.chine, \<rho>\<sigma>.p\<^sub>0])"
               using whisker_left \<mu>.ide_base \<theta>\<^sub>\<mu>' by blast
             thus ?thesis
               using comp_assoc by presburger
           qed
           also have "... = ((u \<star> \<chi>.the_\<theta> \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> \<a>[u, u\<^sub>0 \<star> \<chi>.chine, \<rho>\<sigma>.p\<^sub>0]) \<cdot>
                              (\<a>[u, u\<^sub>0, \<chi>.chine] \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> \<a>\<^sup>-\<^sup>1[u \<star> u\<^sub>0, \<chi>.chine, \<rho>\<sigma>.p\<^sub>0] \<cdot>
                              (\<mu> \<star> \<chi>.chine \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot>
                              \<a>[u\<^sub>1, \<chi>.chine, \<rho>\<sigma>.p\<^sub>0] \<cdot> (\<chi>.the_\<nu> \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> r\<^sub>0s\<^sub>1.\<phi> \<cdot>
                              (\<omega>.the_\<theta> \<star> \<rho>\<sigma>.p\<^sub>1) \<cdot> \<a>\<^sup>-\<^sup>1[t\<^sub>0, \<omega>.chine, \<rho>\<sigma>.p\<^sub>1] \<cdot> (t\<^sub>0 \<star> inv \<gamma>\<^sub>\<tau>) \<cdot>
                              \<a>[t\<^sub>0, \<tau>\<mu>.p\<^sub>1, chine] \<cdot> (inv t\<^sub>0u\<^sub>1.\<phi> \<star> chine) \<cdot>
                              \<a>\<^sup>-\<^sup>1[u\<^sub>1, \<tau>\<mu>.p\<^sub>0, chine]"
           proof -
             have "seq (u \<star> \<a>[u\<^sub>0, \<chi>.chine, \<rho>\<sigma>.p\<^sub>0])
                       (\<a>[u, u\<^sub>0 \<star> \<chi>.chine, \<rho>\<sigma>.p\<^sub>0] \<cdot> (\<a>[u, u\<^sub>0, \<chi>.chine] \<star> \<rho>\<sigma>.p\<^sub>0))"
               by auto
             moreover have "src u = trg \<a>[u\<^sub>0, \<chi>.chine, \<rho>\<sigma>.p\<^sub>0]"
               by simp
             moreover have "inv (u \<star> \<a>[u\<^sub>0, \<chi>.chine, \<rho>\<sigma>.p\<^sub>0]) = u \<star> \<a>\<^sup>-\<^sup>1[u\<^sub>0, \<chi>.chine, \<rho>\<sigma>.p\<^sub>0]"
               by simp
             moreover have "iso (u \<star> \<a>[u\<^sub>0, \<chi>.chine, \<rho>\<sigma>.p\<^sub>0])"
               by simp
             moreover have "iso \<a>[u \<star> u\<^sub>0, \<chi>.chine, \<rho>\<sigma>.p\<^sub>0]"
               by simp
             ultimately have "(u \<star> \<a>\<^sup>-\<^sup>1[u\<^sub>0, \<chi>.chine, \<rho>\<sigma>.p\<^sub>0]) \<cdot> \<a>[u, u\<^sub>0, \<chi>.chine \<star> \<rho>\<sigma>.p\<^sub>0] =
                              \<a>[u, u\<^sub>0 \<star> \<chi>.chine, \<rho>\<sigma>.p\<^sub>0] \<cdot> (\<a>[u, u\<^sub>0, \<chi>.chine] \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot>
                                \<a>\<^sup>-\<^sup>1[u \<star> u\<^sub>0, \<chi>.chine, \<rho>\<sigma>.p\<^sub>0]"
               using pentagon hseqI' comp_assoc
                     invert_opposite_sides_of_square
                       [of "u \<star> \<a>[u\<^sub>0, \<chi>.chine, \<rho>\<sigma>.p\<^sub>0]"
                           "\<a>[u, u\<^sub>0 \<star> \<chi>.chine, \<rho>\<sigma>.p\<^sub>0] \<cdot> (\<a>[u, u\<^sub>0, \<chi>.chine] \<star> \<rho>\<sigma>.p\<^sub>0)"
                           "\<a>[u, u\<^sub>0, \<chi>.chine \<star> \<rho>\<sigma>.p\<^sub>0]" "\<a>[u \<star> u\<^sub>0, \<chi>.chine, \<rho>\<sigma>.p\<^sub>0]"]
                     inv_hcomp \<chi>.is_ide \<chi>.w_simps(3) \<chi>.w_simps(4) \<mu>.base_simps(2) \<mu>.ide_base
                     \<mu>.ide_leg0 \<mu>.leg0_simps(2) \<mu>.leg0_simps(3) \<sigma>.leg1_simps(3)
                     assoc'_eq_inv_assoc ide_hcomp r\<^sub>0s\<^sub>1.ide_u r\<^sub>0s\<^sub>1.p\<^sub>0_simps hcomp_simps(1)
               by presburger
             thus ?thesis
               using comp_assoc by presburger
           qed
           also have "... = \<a>[u, s\<^sub>0, \<rho>\<sigma>.p\<^sub>0] \<cdot> ((u \<star> \<chi>.the_\<theta>) \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot>
                              (\<a>[u, u\<^sub>0, \<chi>.chine] \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> (\<a>\<^sup>-\<^sup>1[u \<star> u\<^sub>0, \<chi>.chine, \<rho>\<sigma>.p\<^sub>0] \<cdot>
                              (\<mu> \<star> \<chi>.chine \<star> \<rho>\<sigma>.p\<^sub>0)) \<cdot>
                              \<a>[u\<^sub>1, \<chi>.chine, \<rho>\<sigma>.p\<^sub>0] \<cdot> (\<chi>.the_\<nu> \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> r\<^sub>0s\<^sub>1.\<phi> \<cdot>
                              (\<omega>.the_\<theta> \<star> \<rho>\<sigma>.p\<^sub>1) \<cdot> \<a>\<^sup>-\<^sup>1[t\<^sub>0, \<omega>.chine, \<rho>\<sigma>.p\<^sub>1] \<cdot> (t\<^sub>0 \<star> inv \<gamma>\<^sub>\<tau>) \<cdot>
                              \<a>[t\<^sub>0, \<tau>\<mu>.p\<^sub>1, chine] \<cdot> (inv t\<^sub>0u\<^sub>1.\<phi> \<star> chine) \<cdot>
                              \<a>\<^sup>-\<^sup>1[u\<^sub>1, \<tau>\<mu>.p\<^sub>0, chine]"
           proof -
             have "(u \<star> \<chi>.the_\<theta> \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> \<a>[u, u\<^sub>0 \<star> \<chi>.chine, \<rho>\<sigma>.p\<^sub>0] =
                   \<a>[u, s\<^sub>0, \<rho>\<sigma>.p\<^sub>0] \<cdot> ((u \<star> \<chi>.the_\<theta>) \<star> \<rho>\<sigma>.p\<^sub>0)"
               using assoc_naturality [of u \<chi>.the_\<theta> \<rho>\<sigma>.p\<^sub>0] \<chi>.\<theta>_simps(3) by auto
             thus ?thesis
               using comp_assoc by presburger
           qed
           also have "... = \<a>[u, s\<^sub>0, \<rho>\<sigma>.p\<^sub>0] \<cdot> ((u \<star> \<chi>.the_\<theta>) \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot>
                              (\<a>[u, u\<^sub>0, \<chi>.chine] \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> ((\<mu> \<star> \<chi>.chine) \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot>
                              \<a>\<^sup>-\<^sup>1[u\<^sub>1, \<chi>.chine, \<rho>\<sigma>.p\<^sub>0] \<cdot> \<a>[u\<^sub>1, \<chi>.chine, \<rho>\<sigma>.p\<^sub>0] \<cdot>
                              (\<chi>.the_\<nu> \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> r\<^sub>0s\<^sub>1.\<phi> \<cdot>
                              (\<omega>.the_\<theta> \<star> \<rho>\<sigma>.p\<^sub>1) \<cdot> \<a>\<^sup>-\<^sup>1[t\<^sub>0, \<omega>.chine, \<rho>\<sigma>.p\<^sub>1] \<cdot> (t\<^sub>0 \<star> inv \<gamma>\<^sub>\<tau>) \<cdot>
                              \<a>[t\<^sub>0, \<tau>\<mu>.p\<^sub>1, chine] \<cdot> (inv t\<^sub>0u\<^sub>1.\<phi> \<star> chine) \<cdot>
                              \<a>\<^sup>-\<^sup>1[u\<^sub>1, \<tau>\<mu>.p\<^sub>0, chine]"
           proof -
             have "\<a>\<^sup>-\<^sup>1[u \<star> u\<^sub>0, \<chi>.chine, \<rho>\<sigma>.p\<^sub>0] \<cdot> (\<mu> \<star> \<chi>.chine \<star> \<rho>\<sigma>.p\<^sub>0) =
                   ((\<mu> \<star> \<chi>.chine) \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> \<a>\<^sup>-\<^sup>1[u\<^sub>1, \<chi>.chine, \<rho>\<sigma>.p\<^sub>0]"
               using assoc'_naturality [of \<mu> \<chi>.chine \<rho>\<sigma>.p\<^sub>0] by simp
             thus ?thesis
               using comp_assoc by presburger
           qed
           also have "... = \<a>[u, s\<^sub>0, \<rho>\<sigma>.p\<^sub>0] \<cdot> ((u \<star> \<chi>.the_\<theta>) \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot>
                              (\<a>[u, u\<^sub>0, \<chi>.chine] \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> ((\<mu> \<star> \<chi>.chine) \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot>
                              ((\<a>\<^sup>-\<^sup>1[u\<^sub>1, \<chi>.chine, \<rho>\<sigma>.p\<^sub>0] \<cdot> \<a>[u\<^sub>1, \<chi>.chine, \<rho>\<sigma>.p\<^sub>0]) \<cdot>
                              (\<chi>.the_\<nu> \<star> \<rho>\<sigma>.p\<^sub>0)) \<cdot> r\<^sub>0s\<^sub>1.\<phi> \<cdot>
                              (\<omega>.the_\<theta> \<star> \<rho>\<sigma>.p\<^sub>1) \<cdot> \<a>\<^sup>-\<^sup>1[t\<^sub>0, \<omega>.chine, \<rho>\<sigma>.p\<^sub>1] \<cdot> (t\<^sub>0 \<star> inv \<gamma>\<^sub>\<tau>) \<cdot>
                              \<a>[t\<^sub>0, \<tau>\<mu>.p\<^sub>1, chine] \<cdot> (inv t\<^sub>0u\<^sub>1.\<phi> \<star> chine) \<cdot>
                              \<a>\<^sup>-\<^sup>1[u\<^sub>1, \<tau>\<mu>.p\<^sub>0, chine]"
             using comp_assoc by metis
           also have "... = \<a>[u, s\<^sub>0, \<rho>\<sigma>.p\<^sub>0] \<cdot> (((u \<star> \<chi>.the_\<theta>) \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot>
                              (\<a>[u, u\<^sub>0, \<chi>.chine] \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> ((\<mu> \<star> \<chi>.chine) \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot>
                              (\<chi>.the_\<nu> \<star> \<rho>\<sigma>.p\<^sub>0)) \<cdot> r\<^sub>0s\<^sub>1.\<phi> \<cdot>
                              (\<omega>.the_\<theta> \<star> \<rho>\<sigma>.p\<^sub>1) \<cdot> \<a>\<^sup>-\<^sup>1[t\<^sub>0, \<omega>.chine, \<rho>\<sigma>.p\<^sub>1] \<cdot> (t\<^sub>0 \<star> inv \<gamma>\<^sub>\<tau>) \<cdot>
                              \<a>[t\<^sub>0, \<tau>\<mu>.p\<^sub>1, chine] \<cdot> (inv t\<^sub>0u\<^sub>1.\<phi> \<star> chine) \<cdot>
                              \<a>\<^sup>-\<^sup>1[u\<^sub>1, \<tau>\<mu>.p\<^sub>0, chine]"
           proof -
             have "(\<a>\<^sup>-\<^sup>1[u\<^sub>1, \<chi>.chine, \<rho>\<sigma>.p\<^sub>0] \<cdot> \<a>[u\<^sub>1, \<chi>.chine, \<rho>\<sigma>.p\<^sub>0]) \<cdot> (\<chi>.the_\<nu> \<star> \<rho>\<sigma>.p\<^sub>0) =
                   \<chi>.the_\<nu> \<star> \<rho>\<sigma>.p\<^sub>0"
               using comp_inv_arr' comp_cod_arr by auto
             thus ?thesis
               using comp_assoc by simp
           qed
           also have "... = (\<a>[u, s\<^sub>0, \<rho>\<sigma>.p\<^sub>0] \<cdot> ((\<chi> \<star> s\<^sub>0) \<cdot> \<sigma> \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> r\<^sub>0s\<^sub>1.\<phi> \<cdot>
                              (\<omega>.the_\<theta> \<star> \<rho>\<sigma>.p\<^sub>1) \<cdot> \<a>\<^sup>-\<^sup>1[t\<^sub>0, \<omega>.chine, \<rho>\<sigma>.p\<^sub>1]) \<cdot> (t\<^sub>0 \<star> inv \<gamma>\<^sub>\<tau>) \<cdot>
                              \<a>[t\<^sub>0, \<tau>\<mu>.p\<^sub>1, chine] \<cdot> (inv t\<^sub>0u\<^sub>1.\<phi> \<star> chine) \<cdot>
                              \<a>\<^sup>-\<^sup>1[u\<^sub>1, \<tau>\<mu>.p\<^sub>0, chine]"
           proof -
             have "arr ((u \<star> \<chi>.the_\<theta>) \<cdot> \<a>[u, u\<^sub>0, \<chi>.chine] \<cdot> (\<mu> \<star> \<chi>.chine) \<cdot> \<chi>.the_\<nu>)"
               using \<chi>.\<theta>_simps(3) by simp
             hence "((u \<star> \<chi>.the_\<theta>) \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> (\<a>[u, u\<^sub>0, \<chi>.chine] \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot>
                      ((\<mu> \<star> \<chi>.chine) \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> (\<chi>.the_\<nu> \<star> \<rho>\<sigma>.p\<^sub>0) =
                    (u \<star> \<chi>.the_\<theta>) \<cdot> \<a>[u, u\<^sub>0, \<chi>.chine] \<cdot> (\<mu> \<star> \<chi>.chine) \<cdot> \<chi>.the_\<nu> \<star> \<rho>\<sigma>.p\<^sub>0"
               using whisker_right by simp
             also have "... = (\<chi> \<star> s\<^sub>0) \<cdot> \<sigma> \<star> \<rho>\<sigma>.p\<^sub>0"
               using \<chi>.\<Delta>_naturality by simp
             finally have "((u \<star> \<chi>.the_\<theta>) \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> (\<a>[u, u\<^sub>0, \<chi>.chine] \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot>
                             ((\<mu> \<star> \<chi>.chine) \<star> \<rho>\<sigma>.p\<^sub>0) \<cdot> (\<chi>.the_\<nu> \<star> \<rho>\<sigma>.p\<^sub>0) =
                           (\<chi> \<star> s\<^sub>0) \<cdot> \<sigma> \<star> \<rho>\<sigma>.p\<^sub>0"
               by simp
             thus ?thesis
               using comp_assoc by presburger
           qed
           also have "... = (?\<theta>\<^sub>\<tau> \<cdot> (t\<^sub>0 \<star> inv \<gamma>\<^sub>\<tau>)) \<cdot>
                              \<a>[t\<^sub>0, \<tau>\<mu>.p\<^sub>1, chine] \<cdot> (inv t\<^sub>0u\<^sub>1.\<phi> \<star> chine) \<cdot>
                              \<a>\<^sup>-\<^sup>1[u\<^sub>1, \<tau>\<mu>.p\<^sub>0, chine]"
             using comp_assoc by presburger
           also have "... = ?\<theta>\<^sub>\<tau>' \<cdot> \<a>[t\<^sub>0, \<tau>\<mu>.p\<^sub>1, chine] \<cdot> (inv t\<^sub>0u\<^sub>1.\<phi> \<star> chine) \<cdot>
                              \<a>\<^sup>-\<^sup>1[u\<^sub>1, \<tau>\<mu>.p\<^sub>0, chine]"
             using \<gamma>\<^sub>\<tau>' \<gamma>\<^sub>\<tau>'_eq by simp
           also have "... = (u \<star> the_\<theta>) \<cdot> \<a>[u, u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0, chine] \<cdot> (\<a>[u, u\<^sub>0, \<tau>\<mu>.p\<^sub>0] \<star> chine) \<cdot>
                              ((\<mu> \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine) \<cdot> ((t\<^sub>0u\<^sub>1.\<phi> \<star> chine) \<cdot>
                              ((\<a>\<^sup>-\<^sup>1[t\<^sub>0, \<tau>\<mu>.p\<^sub>1, chine]) \<cdot> \<a>[t\<^sub>0, \<tau>\<mu>.p\<^sub>1, chine]) \<cdot>
                              (inv t\<^sub>0u\<^sub>1.\<phi> \<star> chine)) \<cdot> \<a>\<^sup>-\<^sup>1[u\<^sub>1, \<tau>\<mu>.p\<^sub>0, chine]"
             using comp_assoc by presburger
           also have "... = (u \<star> the_\<theta>) \<cdot> \<a>[u, u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0, chine] \<cdot> (\<a>[u, u\<^sub>0, \<tau>\<mu>.p\<^sub>0] \<star> chine) \<cdot>
                              ((\<mu> \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine) \<cdot> \<a>\<^sup>-\<^sup>1[u\<^sub>1, \<tau>\<mu>.p\<^sub>0, chine]"
           proof -
             have "((t\<^sub>0u\<^sub>1.\<phi> \<star> chine) \<cdot> ((\<a>\<^sup>-\<^sup>1[t\<^sub>0, \<tau>\<mu>.p\<^sub>1, chine]) \<cdot> \<a>[t\<^sub>0, \<tau>\<mu>.p\<^sub>1, chine]) \<cdot>
                     (inv t\<^sub>0u\<^sub>1.\<phi> \<star> chine)) \<cdot> \<a>\<^sup>-\<^sup>1[u\<^sub>1, \<tau>\<mu>.p\<^sub>0, chine] =
                   \<a>\<^sup>-\<^sup>1[u\<^sub>1, \<tau>\<mu>.p\<^sub>0, chine]"
             proof -
               have "((t\<^sub>0u\<^sub>1.\<phi> \<star> chine) \<cdot> ((\<a>\<^sup>-\<^sup>1[t\<^sub>0, \<tau>\<mu>.p\<^sub>1, chine]) \<cdot> \<a>[t\<^sub>0, \<tau>\<mu>.p\<^sub>1, chine]) \<cdot>
                       (inv t\<^sub>0u\<^sub>1.\<phi> \<star> chine)) \<cdot> \<a>\<^sup>-\<^sup>1[u\<^sub>1, \<tau>\<mu>.p\<^sub>0, chine] =
                     ((t\<^sub>0u\<^sub>1.\<phi> \<star> chine) \<cdot> ((t\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>1) \<star> chine) \<cdot>
                       (inv t\<^sub>0u\<^sub>1.\<phi> \<star> chine)) \<cdot> \<a>\<^sup>-\<^sup>1[u\<^sub>1, \<tau>\<mu>.p\<^sub>0, chine]"
                 using comp_inv_arr' \<tau>.T0.antipar(1) by auto
               also have "... = ((t\<^sub>0u\<^sub>1.\<phi> \<star> chine) \<cdot> (inv t\<^sub>0u\<^sub>1.\<phi> \<star> chine)) \<cdot> \<a>\<^sup>-\<^sup>1[u\<^sub>1, \<tau>\<mu>.p\<^sub>0, chine]"
                 using comp_cod_arr t\<^sub>0u\<^sub>1.\<phi>_uniqueness by simp
               also have "... = (t\<^sub>0u\<^sub>1.\<phi> \<cdot> inv t\<^sub>0u\<^sub>1.\<phi> \<star> chine) \<cdot> \<a>\<^sup>-\<^sup>1[u\<^sub>1, \<tau>\<mu>.p\<^sub>0, chine]"
                 using whisker_right t\<^sub>0u\<^sub>1.\<phi>_uniqueness by simp
               also have "... = ((u\<^sub>1 \<star> \<tau>\<mu>.p\<^sub>0) \<star> chine) \<cdot> \<a>\<^sup>-\<^sup>1[u\<^sub>1, \<tau>\<mu>.p\<^sub>0, chine]"
                 using comp_arr_inv' \<tau>.T0.antipar(1) t\<^sub>0u\<^sub>1.\<phi>_uniqueness by simp
               also have "... = \<a>\<^sup>-\<^sup>1[u\<^sub>1, \<tau>\<mu>.p\<^sub>0, chine]"
                 using comp_cod_arr \<tau>.T0.antipar(1) by simp
               finally show ?thesis by simp
             qed
             thus ?thesis
               using comp_assoc by simp
           qed
           also have "... = (u \<star> the_\<theta>) \<cdot> (\<a>[u, u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0, chine] \<cdot> (\<a>[u, u\<^sub>0, \<tau>\<mu>.p\<^sub>0] \<star> chine) \<cdot>
                              \<a>\<^sup>-\<^sup>1[u \<star> u\<^sub>0, \<tau>\<mu>.p\<^sub>0, chine]) \<cdot> (\<mu> \<star> ?w\<^sub>\<mu>)"
             using assoc'_naturality [of \<mu> \<tau>\<mu>.p\<^sub>0 chine] comp_assoc by auto
           also have "... = ((u \<star> the_\<theta>) \<cdot> (u \<star> \<a>\<^sup>-\<^sup>1[u\<^sub>0, \<tau>\<mu>.p\<^sub>0, chine])) \<cdot> \<a>[u, u\<^sub>0, ?w\<^sub>\<mu>] \<cdot> (\<mu> \<star> ?w\<^sub>\<mu>)"
             using uw\<theta> pentagon comp_assoc inv_hcomp
                   invert_opposite_sides_of_square
                     [of "u \<star> \<a>[u\<^sub>0, \<tau>\<mu>.p\<^sub>0, chine]"
                         "\<a>[u, u\<^sub>0 \<star> \<tau>\<mu>.p\<^sub>0, chine] \<cdot> (\<a>[u, u\<^sub>0, \<tau>\<mu>.p\<^sub>0] \<star> chine)" "\<a>[u, u\<^sub>0, ?w\<^sub>\<mu>]"
                         "\<a>[u \<star> u\<^sub>0, \<tau>\<mu>.p\<^sub>0, chine]"]
                   \<mu>.base_simps(2) \<mu>.ide_base \<mu>.ide_leg0 \<mu>.leg0_simps(2) assoc'_eq_inv_assoc
                   ide_hcomp hcomp_simps(1) t\<^sub>0u\<^sub>1.ide_u
             by force
           also have "... = (u \<star> the_\<theta> \<cdot> \<a>\<^sup>-\<^sup>1[u\<^sub>0, \<tau>\<mu>.p\<^sub>0, chine]) \<cdot> \<a>[u, u\<^sub>0, ?w\<^sub>\<mu>] \<cdot> (\<mu> \<star> ?w\<^sub>\<mu>)"
             using whisker_left comp_assoc by simp
           finally show ?thesis by simp
         qed
         show "\<exists>!\<gamma>. \<guillemotleft>\<gamma> : ?w\<^sub>\<mu> \<Rightarrow> ?w\<^sub>\<mu>'\<guillemotright> \<and> ?\<beta>\<^sub>\<mu> = u\<^sub>1 \<star> \<gamma> \<and> ?\<theta>\<^sub>\<mu> = ?\<theta>\<^sub>\<mu>' \<cdot> (u\<^sub>0 \<star> \<gamma>)"
           using w\<^sub>\<mu> w\<^sub>\<mu>' \<theta>\<^sub>\<mu> \<theta>\<^sub>\<mu>' \<beta>\<^sub>\<mu> eq\<^sub>\<mu> \<mu>.T2 [of ?w\<^sub>\<mu> ?w\<^sub>\<mu>' ?\<theta>\<^sub>\<mu> ?u\<^sub>\<mu> ?\<theta>\<^sub>\<mu>' ?\<beta>\<^sub>\<mu>] by fast
       qed
       obtain \<gamma>\<^sub>\<mu> where \<gamma>\<^sub>\<mu>: "\<guillemotleft>\<gamma>\<^sub>\<mu> : ?w\<^sub>\<mu> \<Rightarrow> ?w\<^sub>\<mu>'\<guillemotright> \<and> ?\<beta>\<^sub>\<mu> = u\<^sub>1 \<star> \<gamma>\<^sub>\<mu> \<and> ?\<theta>\<^sub>\<mu> = ?\<theta>\<^sub>\<mu>' \<cdot> (u\<^sub>0 \<star> \<gamma>\<^sub>\<mu>)"
         using 1 by auto
       show "?w\<^sub>\<mu> \<cong> ?w\<^sub>\<mu>'"
         using w\<^sub>\<mu> w\<^sub>\<mu>' \<gamma>\<^sub>\<mu> BS3 [of ?w\<^sub>\<mu> ?w\<^sub>\<mu>' \<gamma>\<^sub>\<mu> \<gamma>\<^sub>\<mu>] isomorphic_def by auto
     qed
 
     lemma comp_L:
     shows "Maps.seq \<lbrakk>\<lbrakk>t\<^sub>0\<rbrakk>\<rbrakk> \<lbrakk>\<lbrakk>\<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1\<rbrakk>\<rbrakk>"
     and "\<lbrakk>\<lbrakk>t\<^sub>0\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>\<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1\<rbrakk>\<rbrakk> =
          Maps.MkArr (src (\<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1)) (src t) (Maps.Comp \<lbrakk>t\<^sub>0\<rbrakk> \<lbrakk>\<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1\<rbrakk>)"
     proof -
       show "Maps.seq \<lbrakk>\<lbrakk>t\<^sub>0\<rbrakk>\<rbrakk> \<lbrakk>\<lbrakk>\<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1\<rbrakk>\<rbrakk>"
       proof -
         have "is_left_adjoint (\<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1)"
           using \<omega>.is_map r\<^sub>0s\<^sub>1.leg1_is_map left_adjoints_compose r\<^sub>0s\<^sub>1.p\<^sub>1_simps by auto
         thus ?thesis
           using Maps.CLS_in_hom r\<^sub>0s\<^sub>1.leg1_is_map
           apply (intro Maps.seqI')
            apply blast
           using Maps.CLS_in_hom [of t\<^sub>0] \<tau>.leg0_is_map \<rho>\<sigma>.leg1_in_hom by auto
       qed
       thus "\<lbrakk>\<lbrakk>t\<^sub>0\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>\<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1\<rbrakk>\<rbrakk> =
             Maps.MkArr (src (\<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1)) (src t) (Maps.Comp \<lbrakk>t\<^sub>0\<rbrakk> \<lbrakk>\<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1\<rbrakk>)"
         using Maps.comp_char by auto
     qed
 
     lemma comp_R:
     shows "Maps.seq \<lbrakk>\<lbrakk>u\<^sub>1\<rbrakk>\<rbrakk> \<lbrakk>\<lbrakk>\<chi>.chine \<star> \<rho>\<sigma>.p\<^sub>0\<rbrakk>\<rbrakk>"
     and "\<lbrakk>\<lbrakk>u\<^sub>1\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>\<chi>.chine \<star> \<rho>\<sigma>.p\<^sub>0\<rbrakk>\<rbrakk> =
          Maps.MkArr (src r\<^sub>0s\<^sub>1.p\<^sub>0) (trg u) (Maps.Comp \<lbrakk>u\<^sub>1\<rbrakk> \<lbrakk>\<chi>.chine \<star> r\<^sub>0s\<^sub>1.p\<^sub>0\<rbrakk>)"
     proof -
       show "Maps.seq \<lbrakk>\<lbrakk>u\<^sub>1\<rbrakk>\<rbrakk> \<lbrakk>\<lbrakk>\<chi>.chine \<star> \<rho>\<sigma>.p\<^sub>0\<rbrakk>\<rbrakk>"
       proof -
         have "is_left_adjoint (\<chi>.chine \<star> \<rho>\<sigma>.p\<^sub>0)"
           using \<chi>.is_map r\<^sub>0s\<^sub>1.leg0_is_map left_adjoints_compose [of \<chi>.chine \<rho>\<sigma>.p\<^sub>0] by simp
         thus ?thesis
           using Maps.CLS_in_hom \<mu>.leg1_is_map
           apply (intro Maps.seqI')
            apply blast
           using Maps.CLS_in_hom [of u\<^sub>1] \<mu>.leg1_is_map by simp
       qed
       thus "\<lbrakk>\<lbrakk>u\<^sub>1\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>\<chi>.chine \<star> \<rho>\<sigma>.p\<^sub>0\<rbrakk>\<rbrakk> =
             Maps.MkArr (src r\<^sub>0s\<^sub>1.p\<^sub>0) (trg u) (Maps.Comp \<lbrakk>u\<^sub>1\<rbrakk> \<lbrakk>\<chi>.chine \<star> r\<^sub>0s\<^sub>1.p\<^sub>0\<rbrakk>)"
         using Maps.comp_char by auto
     qed
 
     lemma comp_L_eq_comp_R:
     shows "\<lbrakk>\<lbrakk>t\<^sub>0\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>\<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1\<rbrakk>\<rbrakk> = \<lbrakk>\<lbrakk>u\<^sub>1\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>\<chi>.chine \<star> \<rho>\<sigma>.p\<^sub>0\<rbrakk>\<rbrakk>"
     proof (intro Maps.arr_eqI)
       show "Maps.seq \<lbrakk>\<lbrakk>t\<^sub>0\<rbrakk>\<rbrakk> \<lbrakk>\<lbrakk>\<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1\<rbrakk>\<rbrakk>"
         using comp_L(1) by simp
       show "Maps.seq \<lbrakk>\<lbrakk>u\<^sub>1\<rbrakk>\<rbrakk> \<lbrakk>\<lbrakk>\<chi>.chine \<star> \<rho>\<sigma>.p\<^sub>0\<rbrakk>\<rbrakk>"
         using comp_R(1) by simp
       show "Maps.Dom (\<lbrakk>\<lbrakk>t\<^sub>0\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>\<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1\<rbrakk>\<rbrakk>) = Maps.Dom (\<lbrakk>\<lbrakk>u\<^sub>1\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>\<chi>.chine \<star> \<rho>\<sigma>.p\<^sub>0\<rbrakk>\<rbrakk>)"
         by (metis (no_types, lifting) Maps.Dom.simps(1) \<omega>.w_simps(2) \<omega>.w_simps(3)
             \<rho>.leg1_simps(3) \<rho>\<sigma>.leg1_in_hom(2) comp_L(2) comp_R(2) hcomp_in_vhomE hseqI'
             r\<^sub>0s\<^sub>1.leg1_simps(3) hcomp_simps(1))
       show "Maps.Cod (\<lbrakk>\<lbrakk>t\<^sub>0\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>\<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1\<rbrakk>\<rbrakk>) = Maps.Cod (\<lbrakk>\<lbrakk>u\<^sub>1\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>\<chi>.chine \<star> \<rho>\<sigma>.p\<^sub>0\<rbrakk>\<rbrakk>)"
         by (metis Maps.Cod.simps(1) \<tau>\<mu>.composable comp_L(2) comp_R(2))
       have A: "Maps.Map (\<lbrakk>\<lbrakk>t\<^sub>0\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>\<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1\<rbrakk>\<rbrakk>) = Maps.Comp \<lbrakk>t\<^sub>0\<rbrakk> \<lbrakk>\<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1\<rbrakk>"
         using comp_L(1) Maps.comp_char by auto
       have B: "Maps.Map (\<lbrakk>\<lbrakk>u\<^sub>1\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>\<chi>.chine \<star> \<rho>\<sigma>.p\<^sub>0\<rbrakk>\<rbrakk>) = Maps.Comp \<lbrakk>u\<^sub>1\<rbrakk> \<lbrakk>\<chi>.chine \<star> \<rho>\<sigma>.p\<^sub>0\<rbrakk>"
         using comp_R(1) Maps.comp_char by auto
       have C: "Maps.Comp \<lbrakk>t\<^sub>0\<rbrakk> \<lbrakk>\<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1\<rbrakk> = Maps.Comp \<lbrakk>u\<^sub>1\<rbrakk> \<lbrakk>\<chi>.chine \<star> \<rho>\<sigma>.p\<^sub>0\<rbrakk>"
       proof (intro Maps.Comp_eqI)
         show "t\<^sub>0 \<star> \<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1 \<in> Maps.Comp \<lbrakk>t\<^sub>0\<rbrakk> \<lbrakk>\<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1\<rbrakk>"
         proof (intro Maps.in_CompI)
           show "is_iso_class \<lbrakk>\<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1\<rbrakk>"
             using prj_chine(2) is_iso_classI isomorphic_implies_hpar(2) by blast
           show "is_iso_class \<lbrakk>t\<^sub>0\<rbrakk>"
             using is_iso_classI by auto
           show "\<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1 \<in> \<lbrakk>\<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1\<rbrakk>"
             using ide_in_iso_class prj_chine(2) isomorphic_implies_hpar(2) by blast
           show "t\<^sub>0 \<in> \<lbrakk>t\<^sub>0\<rbrakk>"
             using ide_in_iso_class by simp
           show "t\<^sub>0 \<star> \<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1 \<cong> t\<^sub>0 \<star> \<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1"
             using isomorphic_reflexive prj_chine(2) isomorphic_implies_hpar(2) by auto
         qed
         show "u\<^sub>1 \<star> \<chi>.chine \<star> \<rho>\<sigma>.p\<^sub>0 \<in> Maps.Comp \<lbrakk>u\<^sub>1\<rbrakk> \<lbrakk>\<chi>.chine \<star> \<rho>\<sigma>.p\<^sub>0\<rbrakk>"
         proof (intro Maps.in_CompI)
           show "is_iso_class \<lbrakk>\<chi>.chine \<star> \<rho>\<sigma>.p\<^sub>0\<rbrakk>"
             using is_iso_classI by simp
           show "is_iso_class \<lbrakk>u\<^sub>1\<rbrakk>"
             using is_iso_classI by simp
           show "\<chi>.chine \<star> \<rho>\<sigma>.p\<^sub>0 \<in> \<lbrakk>\<chi>.chine \<star> \<rho>\<sigma>.p\<^sub>0\<rbrakk>"
             using ide_in_iso_class by simp
           show "u\<^sub>1 \<in> iso_class u\<^sub>1"
             using ide_in_iso_class by simp
           show "u\<^sub>1 \<star> \<chi>.chine \<star> \<rho>\<sigma>.p\<^sub>0 \<cong> u\<^sub>1 \<star> \<chi>.chine \<star> \<rho>\<sigma>.p\<^sub>0"
             using isomorphic_reflexive isomorphic_implies_hpar(2) by auto
         qed
         show "t\<^sub>0 \<star> \<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1 \<cong> u\<^sub>1 \<star> \<chi>.chine \<star> \<rho>\<sigma>.p\<^sub>0"
         proof -
           have "t\<^sub>0 \<star> \<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1 \<cong> (t\<^sub>0 \<star> \<omega>.chine) \<star> \<rho>\<sigma>.p\<^sub>1"
             using assoc'_in_hom [of t\<^sub>0 \<omega>.chine \<rho>\<sigma>.p\<^sub>1] iso_assoc' isomorphic_def r\<^sub>0s\<^sub>1.p\<^sub>1_simps
             by auto
           also have "... \<cong> r\<^sub>0 \<star> \<rho>\<sigma>.p\<^sub>1"
             using \<omega>.leg0_uniquely_isomorphic hcomp_isomorphic_ide
             by (simp add: \<rho>.T0.antipar(1))
           also have "... \<cong> s\<^sub>1 \<star> \<rho>\<sigma>.p\<^sub>0"
             using isomorphic_def r\<^sub>0s\<^sub>1.\<phi>_uniqueness(2) by blast
           also have "... \<cong> (u\<^sub>1 \<star> \<chi>.chine) \<star> \<rho>\<sigma>.p\<^sub>0"
             using \<chi>.leg1_uniquely_isomorphic hcomp_isomorphic_ide by auto
           also have "... \<cong> u\<^sub>1 \<star> \<chi>.chine \<star> \<rho>\<sigma>.p\<^sub>0"
             using assoc_in_hom [of u\<^sub>1 \<chi>.chine \<rho>\<sigma>.p\<^sub>0] iso_assoc isomorphic_def by auto
           finally show ?thesis by simp
         qed
       qed
       show "Maps.Map (\<lbrakk>\<lbrakk>t\<^sub>0\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>\<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1\<rbrakk>\<rbrakk>) = Maps.Map (\<lbrakk>\<lbrakk>u\<^sub>1\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>\<chi>.chine \<star> \<rho>\<sigma>.p\<^sub>0\<rbrakk>\<rbrakk>)"
         using A B C by simp
     qed
 
     lemma csq:
     shows "Maps.commutative_square \<lbrakk>\<lbrakk>t\<^sub>0\<rbrakk>\<rbrakk> \<lbrakk>\<lbrakk>u\<^sub>1\<rbrakk>\<rbrakk> \<lbrakk>\<lbrakk>\<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1\<rbrakk>\<rbrakk> \<lbrakk>\<lbrakk>\<chi>.chine \<star> \<rho>\<sigma>.p\<^sub>0\<rbrakk>\<rbrakk>"
     proof
       show "Maps.cospan \<lbrakk>\<lbrakk>t\<^sub>0\<rbrakk>\<rbrakk> \<lbrakk>\<lbrakk>u\<^sub>1\<rbrakk>\<rbrakk>"
         using comp_L(1) comp_R(1) comp_L_eq_comp_R
         by (metis (no_types, lifting) Maps.cod_comp Maps.seq_char)
       show "Maps.span \<lbrakk>\<lbrakk>\<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1\<rbrakk>\<rbrakk> \<lbrakk>\<lbrakk>\<chi>.chine \<star> \<rho>\<sigma>.p\<^sub>0\<rbrakk>\<rbrakk>"
         using comp_L(1) comp_R(1) comp_L_eq_comp_R
         by (metis (no_types, lifting) Maps.dom_comp Maps.seq_char)
       show "Maps.dom \<lbrakk>\<lbrakk>t\<^sub>0\<rbrakk>\<rbrakk> = Maps.cod \<lbrakk>\<lbrakk>\<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1\<rbrakk>\<rbrakk>"
         using comp_L(1) by auto
       show "\<lbrakk>\<lbrakk>t\<^sub>0\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>\<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1\<rbrakk>\<rbrakk> = \<lbrakk>\<lbrakk>u\<^sub>1\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>\<chi>.chine \<star> \<rho>\<sigma>.p\<^sub>0\<rbrakk>\<rbrakk>"
         using comp_L_eq_comp_R by simp
     qed
 
     lemma CLS_chine:
     shows "\<lbrakk>\<lbrakk>chine\<rbrakk>\<rbrakk> = Maps.tuple \<lbrakk>\<lbrakk>\<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1\<rbrakk>\<rbrakk> \<lbrakk>\<lbrakk>t\<^sub>0\<rbrakk>\<rbrakk> \<lbrakk>\<lbrakk>u\<^sub>1\<rbrakk>\<rbrakk> \<lbrakk>\<lbrakk>\<chi>.chine \<star> \<rho>\<sigma>.p\<^sub>0\<rbrakk>\<rbrakk>"
     proof -
       let ?T = "Maps.tuple \<lbrakk>\<lbrakk>\<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1\<rbrakk>\<rbrakk> \<lbrakk>\<lbrakk>t\<^sub>0\<rbrakk>\<rbrakk> \<lbrakk>\<lbrakk>u\<^sub>1\<rbrakk>\<rbrakk> \<lbrakk>\<lbrakk>\<chi>.chine \<star> \<rho>\<sigma>.p\<^sub>0\<rbrakk>\<rbrakk>"
       have "\<exists>!l. \<lbrakk>\<lbrakk>t\<^sub>0u\<^sub>1.p\<^sub>1\<rbrakk>\<rbrakk> \<odot> l = \<lbrakk>\<lbrakk>\<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1\<rbrakk>\<rbrakk> \<and> \<lbrakk>\<lbrakk>t\<^sub>0u\<^sub>1.p\<^sub>0\<rbrakk>\<rbrakk> \<odot> l = \<lbrakk>\<lbrakk>\<chi>.chine \<star> \<rho>\<sigma>.p\<^sub>0\<rbrakk>\<rbrakk>"
         using csq \<tau>\<mu>.prj_char
               Maps.universal [of "\<lbrakk>\<lbrakk>t\<^sub>0\<rbrakk>\<rbrakk>" "\<lbrakk>\<lbrakk>u\<^sub>1\<rbrakk>\<rbrakk>" "\<lbrakk>\<lbrakk>\<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1\<rbrakk>\<rbrakk>" "\<lbrakk>\<lbrakk>\<chi>.chine \<star> \<rho>\<sigma>.p\<^sub>0\<rbrakk>\<rbrakk>"]
         by simp
       moreover have "\<lbrakk>\<lbrakk>\<tau>\<mu>.p\<^sub>1\<rbrakk>\<rbrakk> \<odot> ?T = \<lbrakk>\<lbrakk>\<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1\<rbrakk>\<rbrakk> \<and>
                      \<lbrakk>\<lbrakk>\<tau>\<mu>.p\<^sub>0\<rbrakk>\<rbrakk> \<odot> ?T = \<lbrakk>\<lbrakk>\<chi>.chine \<star> \<rho>\<sigma>.p\<^sub>0\<rbrakk>\<rbrakk>"
         using csq \<tau>\<mu>.prj_char
               Maps.prj_tuple [of "\<lbrakk>\<lbrakk>t\<^sub>0\<rbrakk>\<rbrakk>" "\<lbrakk>\<lbrakk>u\<^sub>1\<rbrakk>\<rbrakk>" "\<lbrakk>\<lbrakk>\<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1\<rbrakk>\<rbrakk>" "\<lbrakk>\<lbrakk>\<chi>.chine \<star> \<rho>\<sigma>.p\<^sub>0\<rbrakk>\<rbrakk>"]
         by simp
       moreover have "\<lbrakk>\<lbrakk>t\<^sub>0u\<^sub>1.p\<^sub>1\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>chine\<rbrakk>\<rbrakk> = \<lbrakk>\<lbrakk>\<omega>.chine \<star> \<rho>\<sigma>.p\<^sub>1\<rbrakk>\<rbrakk> \<and>
                      \<lbrakk>\<lbrakk>t\<^sub>0u\<^sub>1.p\<^sub>0\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>chine\<rbrakk>\<rbrakk> = \<lbrakk>\<lbrakk>\<chi>.chine \<star> \<rho>\<sigma>.p\<^sub>0\<rbrakk>\<rbrakk>"
         using prj_chine \<tau>\<mu>.leg0_is_map \<tau>\<mu>.leg1_is_map is_map t\<^sub>0u\<^sub>1.leg1_is_map
               t\<^sub>0u\<^sub>1.satisfies_T0 Maps.comp_CLS
         by blast
       ultimately show "\<lbrakk>\<lbrakk>chine\<rbrakk>\<rbrakk> = ?T" by auto
     qed
 
   end
 
   subsection "Equivalence of B and Span(Maps(B))"
 
   subsubsection "The Functor SPN"
  
   text \<open>
     We now define a function \<open>SPN\<close> on arrows and will ultimately show that it extends to a
     biequivalence from the underlying bicategory \<open>B\<close> to \<open>Span(Maps(B))\<close>.
     The idea is that \<open>SPN\<close> takes \<open>\<guillemotleft>\<mu> : r \<Rightarrow> s\<guillemotright>\<close> to the isomorphism class of an induced arrow
     of spans from the chosen tabulation of \<open>r\<close> to the chosen tabulation of \<open>s\<close>.
     To obtain this, we first use isomorphisms \<open>r.tab\<^sub>1 \<star> r.tab\<^sub>0\<^sup>* \<cong> r\<close> and \<open>s.tab\<^sub>1 \<star> s.tab\<^sub>0\<^sup>* \<cong> s\<close>
     to transform \<open>\<mu>\<close> to \<open>\<guillemotleft>\<mu>' : r.tab\<^sub>1 \<star> r.tab\<^sub>0\<^sup>* \<Rightarrow> s.tab\<^sub>1 \<star> s.tab\<^sub>0\<^sup>*\<guillemotright>\<close>.
     We then take the adjoint transpose of \<open>\<mu>'\<close> to obtain
     \<open>\<guillemotleft>\<omega> : r.tab\<^sub>1 \<Rightarrow> (s.tab\<^sub>1 \<star> s.tab\<^sub>0\<^sup>*) \<star> r.tab\<^sub>0\<guillemotright>\<close>.  The 2-cell \<open>\<omega>\<close> induces a map \<open>w\<close>
     which is an arrow of spans from \<open>(r.tab\<^sub>0, r.tab\<^sub>1)\<close> to \<open>(s.tab\<^sub>0, s.tab\<^sub>1)\<close>.
     We take the arrow of \<open>Span(Maps(B))\<close> defined by \<open>w\<close> as the value of \<open>SPN \<mu>\<close>.
 
     Ensuring that \<open>SPN\<close> is functorial is a somewhat delicate point, which requires that all
     the underlying definitions that have been set up are ``just so'', with no extra choices
     other than those that are forced, and with the tabulation assigned to each 1-cell \<open>r\<close> in
     the proper relationship with the canonical tabulation assigned to its chosen factorization
     \<open>r = g \<star> f\<^sup>*\<close>.
   \<close>
 
   context bicategory_of_spans
   begin
 
     interpretation Maps: maps_category V H \<a> \<i> src trg ..
     interpretation Span: span_bicategory Maps.comp Maps.PRJ\<^sub>0 Maps.PRJ\<^sub>1 ..
 
     no_notation Fun.comp (infixl "\<circ>" 55)
     notation Span.vcomp (infixr "\<bullet>" 55)
     notation Span.hcomp (infixr "\<circ>" 53)
     notation Maps.comp  (infixr "\<odot>" 55)
     notation isomorphic (infix "\<cong>" 50)
 
     definition spn
     where "spn \<mu> \<equiv>
            arrow_of_tabulations_in_maps.chine V H \<a> \<i> src trg
              (tab_of_ide (dom \<mu>)) (tab\<^sub>0 (dom \<mu>)) (cod \<mu>)
              (tab_of_ide (cod \<mu>)) (tab\<^sub>0 (cod \<mu>)) (tab\<^sub>1 (cod \<mu>)) \<mu>"
 
     lemma is_induced_map_spn:
     assumes "arr \<mu>"
     shows "arrow_of_tabulations_in_maps.is_induced_map V H \<a> \<i> src trg
              (tab_of_ide (dom \<mu>)) (tab\<^sub>0 (dom \<mu>)) (cod \<mu>)
              (tab_of_ide (cod \<mu>)) (tab\<^sub>0 (cod \<mu>)) (tab\<^sub>1 (cod \<mu>))
              \<mu> (spn \<mu>)"
     proof -
       interpret \<mu>: arrow_in_bicategory_of_spans V H \<a> \<i> src trg \<open>dom \<mu>\<close> \<open>cod \<mu>\<close> \<mu>
         using assms by unfold_locales auto
       interpret \<mu>: arrow_of_tabulations_in_maps V H \<a> \<i> src trg
                      \<open>dom \<mu>\<close> \<mu>.r.tab \<open>tab\<^sub>0 (dom \<mu>)\<close> \<open>tab\<^sub>1 (dom \<mu>)\<close>
                      \<open>cod \<mu>\<close> \<mu>.s.tab \<open>tab\<^sub>0 (cod \<mu>)\<close> \<open>tab\<^sub>1 (cod \<mu>)\<close>
                      \<mu>
         using \<mu>.is_arrow_of_tabulations_in_maps by simp
       show ?thesis
         unfolding spn_def
         using \<mu>.chine_is_induced_map by blast
     qed
 
     lemma spn_props:
     assumes "arr \<mu>"
     shows "\<guillemotleft>spn \<mu> : src (tab\<^sub>0 (dom \<mu>)) \<rightarrow> src (tab\<^sub>0 (cod \<mu>))\<guillemotright>"
     and "is_left_adjoint (spn \<mu>)"
     and "tab\<^sub>0 (cod \<mu>) \<star> spn \<mu> \<cong> tab\<^sub>0 (dom \<mu>)"
     and "tab\<^sub>1 (cod \<mu>) \<star> spn \<mu> \<cong> tab\<^sub>1 (dom \<mu>)"
     proof -
       interpret \<mu>: arrow_in_bicategory_of_spans V H \<a> \<i> src trg \<open>dom \<mu>\<close> \<open>cod \<mu>\<close> \<mu>
         using assms by unfold_locales auto
       interpret \<mu>: arrow_of_tabulations_in_maps V H \<a> \<i> src trg
                      \<open>dom \<mu>\<close> \<mu>.r.tab \<open>tab\<^sub>0 (dom \<mu>)\<close> \<open>tab\<^sub>1 (dom \<mu>)\<close>
                      \<open>cod \<mu>\<close> \<mu>.s.tab \<open>tab\<^sub>0 (cod \<mu>)\<close> \<open>tab\<^sub>1 (cod \<mu>)\<close>
                      \<mu>
         using \<mu>.is_arrow_of_tabulations_in_maps by simp
       show "\<guillemotleft>spn \<mu> : src (tab\<^sub>0 (dom \<mu>)) \<rightarrow> src (tab\<^sub>0 (cod \<mu>))\<guillemotright>"
         using spn_def by simp
       show "is_left_adjoint (spn \<mu>)"
         using spn_def by (simp add: \<mu>.is_map)
       show "tab\<^sub>0 (cod \<mu>) \<star> spn \<mu> \<cong> tab\<^sub>0 (dom \<mu>)"
         using spn_def isomorphic_def \<mu>.leg0_uniquely_isomorphic(1) by auto
       show "tab\<^sub>1 (cod \<mu>) \<star> spn \<mu> \<cong> tab\<^sub>1 (dom \<mu>)"
         using spn_def isomorphic_def isomorphic_symmetric
               \<mu>.leg1_uniquely_isomorphic(1)
         by auto
     qed
 
     lemma spn_in_hom [intro]:
     assumes "arr \<mu>"
     shows "\<guillemotleft>spn \<mu> : src (tab\<^sub>0 (dom \<mu>)) \<rightarrow> src (tab\<^sub>0 (cod \<mu>))\<guillemotright>"
     and "\<guillemotleft>spn \<mu> : spn \<mu> \<Rightarrow> spn \<mu>\<guillemotright>"
       using assms spn_props left_adjoint_is_ide by auto
 
     lemma spn_simps [simp]:
     assumes "arr \<mu>"
     shows "is_left_adjoint (spn \<mu>)"
     and "ide (spn \<mu>)"
     and "src (spn \<mu>) = src (tab\<^sub>0 (dom \<mu>))"
     and "trg (spn \<mu>) = src (tab\<^sub>0 (cod \<mu>))"
       using assms spn_props left_adjoint_is_ide by auto
 
     text \<open>
       We need the next result to show that \<open>SPN\<close> is functorial; in particular,
       that it takes \<open>\<guillemotleft>r : r \<Rightarrow> r\<guillemotright>\<close> in the underlying bicategory to a 1-cell
       in \<open>Span(Maps(B))\<close>.  The 1-cells in \<open>Span(Maps(B))\<close> have objects of \<open>Maps(B)\<close>
       as their chines, and objects of \<open>Maps(B)\<close> are isomorphism classes of objects in the
       underlying bicategory \<open>B\<close>. So we need the induced map associated with \<open>r\<close> to be isomorphic
       to an object.
     \<close>
 
     lemma spn_ide:
     assumes "ide r"
     shows "spn r \<cong> src (tab\<^sub>0 r)"
     proof -
       interpret r: identity_in_bicategory_of_spans V H \<a> \<i> src trg r
         using assms by unfold_locales auto
       interpret r: arrow_of_tabulations_in_maps V H \<a> \<i> src trg
                      r r.tab \<open>tab\<^sub>0 r\<close> \<open>tab\<^sub>1 r\<close> r r.tab \<open>tab\<^sub>0 r\<close> \<open>tab\<^sub>1 r\<close> r
         using r.is_arrow_of_tabulations_in_maps by simp
       interpret tab: tabulation V H \<a> \<i> src trg r \<open>r.tab\<close> \<open>tab\<^sub>0 r\<close> \<open>dom r.tab\<close>
         using assms r.tab_is_tabulation by simp
       interpret tab: tabulation_in_maps V H \<a> \<i> src trg r \<open>r.tab\<close> \<open>tab\<^sub>0 r\<close> \<open>dom r.tab\<close>
         by (unfold_locales, simp_all)
       have "tab.is_induced_by_cell (spn r) (tab\<^sub>0 r) r.tab"
         using spn_def comp_ide_arr r.chine_is_induced_map by auto
       thus ?thesis
         using tab.induced_map_unique [of "tab\<^sub>0 r" "r.tab" "spn r" "src r.s\<^sub>0"]
               tab.apex_is_induced_by_cell
         by (simp add: comp_assoc)
     qed
 
     text \<open>
       The other key result we need to show that \<open>SPN\<close> is functorial is to show
       that the induced map of a composite is isomorphic to the composite of
       induced maps.
     \<close>
 
     lemma spn_hcomp:
     assumes "seq \<tau> \<mu>" and "g \<cong> spn \<tau>" and "f \<cong> spn \<mu>"
     shows "spn (\<tau> \<cdot> \<mu>) \<cong> g \<star> f"
     proof -
       interpret \<tau>: arrow_in_bicategory_of_spans V H \<a> \<i> src trg \<open>dom \<tau>\<close> \<open>cod \<tau>\<close> \<tau>
         using assms by unfold_locales auto
       interpret \<tau>: arrow_of_tabulations_in_maps V H \<a> \<i> src trg
                      \<open>dom \<tau>\<close> \<tau>.r.tab \<open>tab\<^sub>0 (dom \<tau>)\<close> \<open>tab\<^sub>1 (dom \<tau>)\<close>
                      \<open>cod \<tau>\<close> \<tau>.s.tab \<open>tab\<^sub>0 (cod \<tau>)\<close> \<open>tab\<^sub>1 (cod \<tau>)\<close>
                      \<tau>
         using \<tau>.is_arrow_of_tabulations_in_maps by simp
       interpret \<mu>: arrow_in_bicategory_of_spans V H \<a> \<i> src trg \<open>dom \<mu>\<close> \<open>dom \<tau>\<close> \<mu>
         using assms apply unfold_locales
          apply auto[1]
         by (elim seqE, auto)
       interpret \<mu>: arrow_of_tabulations_in_maps V H \<a> \<i> src trg
                      \<open>dom \<mu>\<close> \<mu>.r.tab \<open>tab\<^sub>0 (dom \<mu>)\<close> \<open>tab\<^sub>1 (dom \<mu>)\<close>
                      \<open>dom \<tau>\<close> \<tau>.r.tab \<open>tab\<^sub>0 (dom \<tau>)\<close> \<open>tab\<^sub>1 (dom \<tau>)\<close>
                      \<mu>
         using \<mu>.is_arrow_of_tabulations_in_maps by simp
       interpret \<tau>\<mu>: vertical_composite_of_arrows_of_tabulations_in_maps V H \<a> \<i> src trg
                       \<open>dom \<mu>\<close> \<mu>.r.tab \<open>tab\<^sub>0 (dom \<mu>)\<close> \<open>tab\<^sub>1 (dom \<mu>)\<close>
                       \<open>dom \<tau>\<close> \<tau>.r.tab \<open>tab\<^sub>0 (dom \<tau>)\<close> \<open>tab\<^sub>1 (dom \<tau>)\<close>
                       \<open>cod \<tau>\<close> \<tau>.s.tab \<open>tab\<^sub>0 (cod \<tau>)\<close> \<open>tab\<^sub>1 (cod \<tau>)\<close>
                       \<mu> \<tau>
         ..
       have "g \<cong> \<tau>.chine"
         using assms(2) spn_def by auto
       moreover have "f \<cong> \<mu>.chine"
         using assms(1) assms(3) spn_def by auto
       moreover have "src g = trg f"
         using calculation(1-2) isomorphic_implies_hpar(3-4) by auto
       moreover have "src g = trg \<mu>.chine"
         using calculation(1) isomorphic_implies_hpar(3) by auto
       ultimately have "g \<star> f \<cong> \<tau>.chine \<star> \<mu>.chine"
         using hcomp_ide_isomorphic hcomp_isomorphic_ide isomorphic_transitive
         by (meson \<mu>.is_ide isomorphic_implies_ide(1))
       also have "... \<cong> spn (\<tau> \<cdot> \<mu>)"
         using spn_def \<tau>\<mu>.chine_char isomorphic_symmetric
         by (metis \<tau>\<mu>.in_hom in_homE)
       finally show ?thesis
         using isomorphic_symmetric by simp
     qed
 
     abbreviation (input) SPN\<^sub>0
     where "SPN\<^sub>0 r \<equiv> Span.mkIde \<lbrakk>\<lbrakk>tab\<^sub>0 r\<rbrakk>\<rbrakk> \<lbrakk>\<lbrakk>tab\<^sub>1 r\<rbrakk>\<rbrakk>"
 
     definition SPN
     where "SPN \<mu> \<equiv> if arr \<mu> then
                       \<lparr>Chn = \<lbrakk>\<lbrakk>spn \<mu>\<rbrakk>\<rbrakk>,
                        Dom = \<lparr>Leg0 = \<lbrakk>\<lbrakk>tab\<^sub>0 (dom \<mu>)\<rbrakk>\<rbrakk>, Leg1 = \<lbrakk>\<lbrakk>tab\<^sub>1 (dom \<mu>)\<rbrakk>\<rbrakk>\<rparr>,
                        Cod = \<lparr>Leg0 = \<lbrakk>\<lbrakk>tab\<^sub>0 (cod \<mu>)\<rbrakk>\<rbrakk>, Leg1 = \<lbrakk>\<lbrakk>tab\<^sub>1 (cod \<mu>)\<rbrakk>\<rbrakk>\<rparr>\<rparr>
                     else Span.null"
 
     lemma Dom_SPN [simp]:
     assumes "arr \<mu>"
     shows "Dom (SPN \<mu>) = \<lparr>Leg0 = \<lbrakk>\<lbrakk>tab\<^sub>0 (dom \<mu>)\<rbrakk>\<rbrakk>, Leg1 = \<lbrakk>\<lbrakk>tab\<^sub>1 (dom \<mu>)\<rbrakk>\<rbrakk>\<rparr>"
       using assms SPN_def by simp
 
     lemma Cod_SPN [simp]:
     assumes "arr \<mu>"
     shows "Cod (SPN \<mu>) = \<lparr>Leg0 = \<lbrakk>\<lbrakk>tab\<^sub>0 (cod \<mu>)\<rbrakk>\<rbrakk>, Leg1 = \<lbrakk>\<lbrakk>tab\<^sub>1 (cod \<mu>)\<rbrakk>\<rbrakk>\<rparr>"
       using assms SPN_def by simp
 
     text \<open>Now we have to show this does the right thing for us.\<close>
 
     lemma SPN_in_hom:
     assumes "arr \<mu>"
     shows "Span.in_hom (SPN \<mu>) (SPN\<^sub>0 (dom \<mu>)) (SPN\<^sub>0 (cod \<mu>))"
     proof
       interpret Dom: span_in_category Maps.comp \<open>Dom (SPN \<mu>)\<close>
       proof
         interpret r: identity_in_bicategory_of_spans V H \<a> \<i> src trg \<open>dom \<mu>\<close>
           using assms by unfold_locales auto
         show "Maps.span (Leg0 (Dom (SPN \<mu>))) (Leg1 (Dom (SPN \<mu>)))"
           using assms Maps.CLS_in_hom SPN_def
           by (metis (no_types, lifting) Maps.in_homE bicategory_of_spans.Dom_SPN
               bicategory_of_spans_axioms r.leg1_is_map r.leg1_simps(3) r.satisfies_T0
               span_data.simps(1) span_data.simps(2))
       qed
       interpret Dom': span_in_category Maps.comp 
                         \<open>\<lparr>Leg0 = \<lbrakk>\<lbrakk>tab\<^sub>0 (dom \<mu>)\<rbrakk>\<rbrakk>, Leg1 = \<lbrakk>\<lbrakk>tab\<^sub>1 (dom \<mu>)\<rbrakk>\<rbrakk>\<rparr>\<close>
         using assms Dom.span_in_category_axioms SPN_def by simp
       interpret Cod: span_in_category Maps.comp \<open>Cod (SPN \<mu>)\<close>
       proof
         interpret s: identity_in_bicategory_of_spans V H \<a> \<i> src trg \<open>cod \<mu>\<close>
           using assms by unfold_locales auto
         show "Maps.span (Leg0 (Cod (SPN \<mu>))) (Leg1 (Cod (SPN \<mu>)))"
           using assms Maps.CLS_in_hom SPN_def
           by (metis (no_types, lifting) bicategory_of_spans.Cod_SPN bicategory_of_spans_axioms
               ide_dom s.base_simps(2) s.base_simps(3) s.determines_span span_in_category.is_span)
       qed
       interpret Cod': span_in_category Maps.comp 
                         \<open>\<lparr>Leg0 = \<lbrakk>\<lbrakk>tab\<^sub>0 (cod \<mu>)\<rbrakk>\<rbrakk>, Leg1 = \<lbrakk>\<lbrakk>tab\<^sub>1 (cod \<mu>)\<rbrakk>\<rbrakk>\<rparr>\<close>
         using assms Cod.span_in_category_axioms SPN_def by simp
       show 1: "Span.arr (SPN \<mu>)"
       proof (unfold Span.arr_char)
         show "arrow_of_spans Maps.comp (SPN \<mu>)"
         proof (unfold_locales)
           show "Maps.in_hom (Chn (SPN \<mu>)) Dom.apex Cod.apex"
             unfolding SPN_def Maps.in_hom_char
             using assms Dom'.apex_def Cod'.apex_def Dom'.is_span Cod'.is_span Maps.arr_char
             by auto
           show "Cod.leg0 \<odot> Chn (SPN \<mu>) = Dom.leg0"
             unfolding SPN_def
             using assms spn_props [of \<mu>] Maps.comp_CLS [of "tab\<^sub>0 (cod \<mu>)" "spn \<mu>"] by simp
           show "Cod.leg1 \<odot> Chn (SPN \<mu>) = Dom.leg1"
             unfolding SPN_def
             using assms spn_props [of \<mu>] Maps.comp_CLS [of "tab\<^sub>1 (cod \<mu>)" "spn \<mu>"] by simp
         qed
       qed
       show "Span.dom (SPN \<mu>) = SPN\<^sub>0 (dom \<mu>)"
         using assms 1 Span.dom_char Dom'.apex_def SPN_def by simp
       show "Span.cod (SPN \<mu>) = SPN\<^sub>0 (cod \<mu>)"
         using assms 1 Span.cod_char Cod'.apex_def SPN_def by simp
     qed
 
     interpretation SPN: "functor" V Span.vcomp SPN
     proof
       show "\<And>\<mu>. \<not> arr \<mu> \<Longrightarrow> SPN \<mu> = Span.null"
         unfolding SPN_def by simp
       show 1: "\<And>\<mu>. arr \<mu> \<Longrightarrow> Span.arr (SPN \<mu>)"
         using SPN_in_hom by auto
       show "\<And>\<mu>. arr \<mu> \<Longrightarrow> Span.dom (SPN \<mu>) = SPN (dom \<mu>)"
       proof -
         fix \<mu>
         assume \<mu>: "arr \<mu>"
         have 1: "Maps.arr (Maps.MkArr (src (tab\<^sub>0 (dom \<mu>))) (src \<mu>) \<lbrakk>tab\<^sub>0 (dom \<mu>)\<rbrakk>)"
         proof -
           have "src (tab\<^sub>0 (dom \<mu>)) \<in> Collect obj"
             using \<mu> by simp
           moreover have "src \<mu> \<in> Collect obj"
             using \<mu> by simp
           moreover have "\<lbrakk>tab\<^sub>0 (dom \<mu>)\<rbrakk> \<in> Maps.Hom (src (tab\<^sub>0 (local.dom \<mu>))) (src \<mu>)"
           proof -
             have "\<guillemotleft>tab\<^sub>0 (dom \<mu>) : src (tab\<^sub>0 (dom \<mu>)) \<rightarrow> src \<mu>\<guillemotright>"
               using \<mu> by simp
             moreover have "is_left_adjoint (tab\<^sub>0 (dom \<mu>))"
               using \<mu> tab\<^sub>0_simps [of "dom \<mu>"] by auto
             ultimately show ?thesis by auto
           qed
           ultimately show ?thesis by simp
         qed
         have "\<lbrakk>spn (dom \<mu>)\<rbrakk> = \<lbrakk>src (tab\<^sub>0 (dom \<mu>))\<rbrakk>"
           using \<mu> spn_ide iso_class_eqI by auto
         hence "SPN (dom \<mu>) = SPN\<^sub>0 (dom \<mu>)"
           unfolding SPN_def
           using \<mu> 1 Maps.dom_char by simp
         thus "Span.dom (SPN \<mu>) = SPN (dom \<mu>)"
           using \<mu> SPN_in_hom by auto
       qed
       show "\<And>\<mu>. arr \<mu> \<Longrightarrow> Span.cod (SPN \<mu>) = SPN (cod \<mu>)"
       proof -
         fix \<mu>
         assume \<mu>: "arr \<mu>"
         have 1: "Maps.arr (Maps.MkArr (src (tab\<^sub>0 (cod \<mu>))) (src \<mu>) \<lbrakk>tab\<^sub>0 (cod \<mu>)\<rbrakk>)"
         proof -
           have "src (tab\<^sub>0 (cod \<mu>)) \<in> Collect obj"
             using \<mu> by simp
           moreover have "src \<mu> \<in> Collect obj"
             using \<mu> by simp
           moreover have "\<lbrakk>tab\<^sub>0 (cod \<mu>)\<rbrakk> \<in> Maps.Hom (src (tab\<^sub>0 (cod \<mu>))) (src \<mu>)"
           proof -
             have "\<guillemotleft>tab\<^sub>0 (cod \<mu>) : src (tab\<^sub>0 (cod \<mu>)) \<rightarrow> src \<mu>\<guillemotright>"
               using \<mu> by simp
             moreover have "is_left_adjoint (tab\<^sub>0 (cod \<mu>))"
               using \<mu> by simp
             ultimately show ?thesis by auto
           qed
           ultimately show ?thesis by simp
         qed
         have "\<lbrakk>spn (cod \<mu>)\<rbrakk> = \<lbrakk>src (tab\<^sub>0 (cod \<mu>))\<rbrakk>"
           using \<mu> spn_ide iso_class_eqI by auto
         hence "SPN (cod \<mu>) = SPN\<^sub>0 (cod \<mu>)"
           unfolding SPN_def
           using \<mu> 1 Maps.dom_char by simp
         thus "Span.cod (SPN \<mu>) = SPN (cod \<mu>)"
           using \<mu> SPN_in_hom by auto
       qed
       show "\<And>\<nu> \<mu>. seq \<nu> \<mu> \<Longrightarrow> SPN (\<nu> \<cdot> \<mu>) = SPN \<nu> \<bullet> SPN \<mu>"
       proof -
         fix \<mu> \<nu>
         assume seq: "seq \<nu> \<mu>"
         have "Dom (SPN (\<nu> \<cdot> \<mu>)) = Dom (SPN \<nu> \<bullet> SPN \<mu>)"
           using seq 1 Span.vcomp_def Span.arr_char
           by (elim seqE, simp)
         moreover have "Cod (SPN (\<nu> \<cdot> \<mu>)) = Cod (SPN \<nu> \<bullet> SPN \<mu>)"
           using seq 1 Span.vcomp_def Span.arr_char
           by (elim seqE, simp)
         moreover have "Chn (SPN (\<nu> \<cdot> \<mu>)) = Chn (SPN \<nu> \<bullet> SPN \<mu>)"
         proof -
           have *: "\<lbrakk>spn (\<nu> \<cdot> \<mu>)\<rbrakk> = Maps.Comp \<lbrakk>spn \<nu>\<rbrakk> \<lbrakk>spn \<mu>\<rbrakk>"
           proof
             show "\<lbrakk>spn (\<nu> \<cdot> \<mu>)\<rbrakk> \<subseteq> Maps.Comp \<lbrakk>spn \<nu>\<rbrakk> \<lbrakk>spn \<mu>\<rbrakk>"
             proof
               fix h
               assume h: "h \<in> \<lbrakk>spn (\<nu> \<cdot> \<mu>)\<rbrakk>"
               show "h \<in> Maps.Comp \<lbrakk>spn \<nu>\<rbrakk> \<lbrakk>spn \<mu>\<rbrakk>"
               proof -
                 have 1: "spn \<nu> \<in> \<lbrakk>spn \<nu>\<rbrakk>"
                   using seq ide_in_iso_class by auto
                 moreover have 2: "spn \<mu> \<in> \<lbrakk>spn \<mu>\<rbrakk>"
                   using seq ide_in_iso_class by auto
                 moreover have "spn \<nu> \<star> spn \<mu> \<cong> h"
                  proof -
                   have "spn \<nu> \<star> spn \<mu> \<cong> spn (\<nu> \<cdot> \<mu>)"
                     using seq spn_hcomp 1 2 iso_class_def isomorphic_reflexive
                           isomorphic_symmetric
                     by simp
                   thus ?thesis
                     using h isomorphic_transitive iso_class_def by simp
                 qed
                 ultimately show ?thesis
                   unfolding Maps.Comp_def
                   by (metis (mono_tags, lifting) is_iso_classI spn_simps(2)
                       mem_Collect_eq seq seqE)
               qed
             qed
             show "Maps.Comp \<lbrakk>spn \<nu>\<rbrakk> \<lbrakk>spn \<mu>\<rbrakk> \<subseteq> \<lbrakk>spn (\<nu> \<cdot> \<mu>)\<rbrakk>"
             proof
               fix h
               assume h: "h \<in> Maps.Comp \<lbrakk>spn \<nu>\<rbrakk> \<lbrakk>spn \<mu>\<rbrakk>"
               show "h \<in> \<lbrakk>spn (\<nu> \<cdot> \<mu>)\<rbrakk>"
               proof -
                 obtain f g where 1: "g \<in> \<lbrakk>spn \<nu>\<rbrakk> \<and> f \<in> \<lbrakk>spn \<mu>\<rbrakk> \<and> g \<star> f \<cong> h"
                   using h Maps.Comp_def [of "iso_class (spn \<nu>)" "iso_class (spn \<mu>)"]
                         iso_class_def iso_class_elems_isomorphic
                   by blast
                 have fg: "g \<cong> spn \<nu> \<and> f \<cong> spn \<mu> \<and> g \<star> f \<cong> h"
                 proof -
                   have "spn \<nu> \<in> \<lbrakk>spn \<nu>\<rbrakk> \<and> spn \<mu> \<in> \<lbrakk>spn \<mu>\<rbrakk>"
                     using seq ide_in_iso_class by auto
                   thus ?thesis
                     using 1 iso_class_elems_isomorphic isomorphic_symmetric is_iso_classI
                     by (meson spn_simps(2) seq seqE)
                 qed
                 have "g \<star> f \<in> \<lbrakk>spn (\<nu> \<cdot> \<mu>)\<rbrakk>"
                   using seq fg 1 spn_hcomp iso_class_def isomorphic_symmetric by simp
                 thus ?thesis
                   using fg isomorphic_transitive iso_class_def by blast
               qed
             qed
           qed
           have "Chn (SPN \<nu> \<bullet> SPN \<mu>) =
                 Maps.MkArr (src (tab\<^sub>0 (cod \<mu>))) (src (tab\<^sub>0 (cod \<nu>))) \<lbrakk>spn \<nu>\<rbrakk> \<odot>
                   Maps.MkArr (src (tab\<^sub>0 (dom \<mu>))) (src (tab\<^sub>0 (cod \<mu>))) \<lbrakk>spn \<mu>\<rbrakk>"
             using 1 seq SPN_def Span.vcomp_def Span.arr_char
             apply (elim seqE)
             apply simp
             by (metis (no_types, lifting) seq vseq_implies_hpar(1) vseq_implies_hpar(2))
           also have "... = Maps.MkArr (src (tab\<^sub>0 (dom \<mu>))) (src (tab\<^sub>0 (cod \<nu>)))
                                       (Maps.Comp \<lbrakk>spn \<nu>\<rbrakk> \<lbrakk>spn \<mu>\<rbrakk>)"
           proof -
             have "Maps.seq (Maps.MkArr (src (tab\<^sub>0 (cod \<mu>))) (src (tab\<^sub>0 (cod \<nu>))) \<lbrakk>spn \<nu>\<rbrakk>)
                            (Maps.MkArr (src (tab\<^sub>0 (dom \<mu>))) (src (tab\<^sub>0 (cod \<mu>))) \<lbrakk>spn \<mu>\<rbrakk>)"
             proof
               show "Maps.in_hom (Maps.MkArr (src (tab\<^sub>0 (local.dom \<mu>))) (src (tab\<^sub>0 (cod \<mu>))) \<lbrakk>spn \<mu>\<rbrakk>)
                                 (Maps.MkIde (src (tab\<^sub>0 (dom \<mu>))))
                                 (Maps.MkIde (src (tab\<^sub>0 (cod \<mu>))))"
               proof -
                 have "src (tab\<^sub>0 (dom \<mu>)) \<in> Collect obj"
                   using in_hhom_def seq by auto
                 moreover have "src (tab\<^sub>0 (cod \<mu>)) \<in> Collect obj"
                   using seq by auto
                 moreover have "\<lbrakk>spn \<mu>\<rbrakk> \<in> Maps.Hom (src (tab\<^sub>0 (dom \<mu>))) (src (tab\<^sub>0 (cod \<mu>)))"
                   using spn_props
                   by (metis (mono_tags, lifting) mem_Collect_eq seq seqE)
                 ultimately show ?thesis
                   using Maps.MkArr_in_hom by simp
               qed
               show "Maps.in_hom (Maps.MkArr (src (tab\<^sub>0 (cod \<mu>))) (src (tab\<^sub>0 (cod \<nu>))) \<lbrakk>spn \<nu>\<rbrakk>)
                                 (Maps.MkIde (src (tab\<^sub>0 (cod \<mu>))))
                                 (Maps.MkIde (src (tab\<^sub>0 (cod \<nu>))))"
               proof -
                 have "src (tab\<^sub>0 (cod \<mu>)) \<in> Collect obj"
                   using in_hhom_def seq by auto
                 moreover have "src (tab\<^sub>0 (cod \<nu>)) \<in> Collect obj"
                   using seq by auto
                 moreover have "\<lbrakk>spn \<nu>\<rbrakk> \<in> Maps.Hom (src (tab\<^sub>0 (cod \<mu>))) (src (tab\<^sub>0 (cod \<nu>)))"
                   using spn_props
                   by (metis (mono_tags, lifting) mem_Collect_eq seq seqE)
                 ultimately show ?thesis
                   using Maps.MkArr_in_hom by simp
               qed
             qed
             thus ?thesis
               using Maps.comp_char
                      [of "Maps.MkArr (src (tab\<^sub>0 (cod \<mu>))) (src (tab\<^sub>0 (cod \<nu>))) \<lbrakk>spn \<nu>\<rbrakk>"
                          "Maps.MkArr (src (tab\<^sub>0 (dom \<mu>))) (src (tab\<^sub>0 (cod \<mu>))) \<lbrakk>spn \<mu>\<rbrakk>"]
               by simp
           qed
           also have "... = Maps.MkArr (src (tab\<^sub>0 (dom \<mu>))) (src (tab\<^sub>0 (cod \<nu>))) \<lbrakk>spn (\<nu> \<cdot> \<mu>)\<rbrakk>"
             using * by simp
           also have "... = Chn (SPN (\<nu> \<cdot> \<mu>))"
             using seq SPN_def Span.vcomp_def
             by (elim seqE, simp)
           finally show ?thesis by simp
         qed
         ultimately show "SPN (\<nu> \<cdot> \<mu>) = SPN \<nu> \<bullet> SPN \<mu>" by simp
       qed
     qed
 
     lemma SPN_is_functor:
     shows "functor V Span.vcomp SPN"
       ..
 
     interpretation SPN: weak_arrow_of_homs V src trg Span.vcomp Span.src Span.trg SPN
     proof
       show "\<And>\<mu>. arr \<mu> \<Longrightarrow> Span.isomorphic (SPN (src \<mu>)) (Span.src (SPN \<mu>))"
       proof -
         fix \<mu>
         assume \<mu>: "arr \<mu>"
         let ?src = "Maps.MkIde (src \<mu>)"
         have src: "Maps.ide ?src"
           using \<mu> by simp
         interpret src: identity_in_bicategory_of_spans V H \<a> \<i> src trg \<open>src \<mu>\<close>
           using \<mu> by unfold_locales auto
         interpret src: arrow_of_tabulations_in_maps V H \<a> \<i> src trg
                          \<open>src \<mu>\<close> src.tab \<open>tab\<^sub>0 (src \<mu>)\<close> \<open>tab\<^sub>1 (src \<mu>)\<close>
                          \<open>src \<mu>\<close> src.tab \<open>tab\<^sub>0 (src \<mu>)\<close> \<open>tab\<^sub>1 (src \<mu>)\<close>
                          \<open>src \<mu>\<close>
           using src.is_arrow_of_tabulations_in_maps by simp
         interpret src: span_in_category Maps.comp \<open>\<lparr>Leg0 = ?src, Leg1 = ?src\<rparr>\<close>
           using src by (unfold_locales, simp)
 
         let ?tab\<^sub>0 = "Maps.MkArr (src (tab\<^sub>0 (src \<mu>))) (src \<mu>) \<lbrakk>tab\<^sub>0 (src \<mu>)\<rbrakk>"
         have tab\<^sub>0_src: "\<guillemotleft>tab\<^sub>0 (src \<mu>) : src (tab\<^sub>0 (src \<mu>)) \<rightarrow> src \<mu>\<guillemotright> \<and>
                         is_left_adjoint (tab\<^sub>0 (src \<mu>)) \<and> \<lbrakk>tab\<^sub>0 (src \<mu>)\<rbrakk> = \<lbrakk>tab\<^sub>0 (src \<mu>)\<rbrakk>"
           using \<mu> by simp
         have tab\<^sub>0: "Maps.arr ?tab\<^sub>0"
           using \<mu> Maps.arr_MkArr tab\<^sub>0_src by blast
         let ?tab\<^sub>1 = "Maps.MkArr (src (tab\<^sub>0 (src \<mu>))) (src \<mu>) \<lbrakk>tab\<^sub>1 (src \<mu>)\<rbrakk>"
         have tab\<^sub>1_src: "\<guillemotleft>tab\<^sub>1 (src \<mu>) : src (tab\<^sub>0 (src \<mu>)) \<rightarrow> src \<mu>\<guillemotright> \<and>
                         is_left_adjoint (tab\<^sub>1 (src \<mu>)) \<and> \<lbrakk>tab\<^sub>1 (src \<mu>)\<rbrakk> = \<lbrakk>tab\<^sub>1 (src \<mu>)\<rbrakk>"
           using \<mu> by simp
         have tab\<^sub>1: "Maps.arr ?tab\<^sub>1"
           using \<mu> Maps.arr_MkArr tab\<^sub>1_src by blast
         interpret tab: span_in_category Maps.comp \<open>\<lparr>Leg0 = ?tab\<^sub>0, Leg1 = ?tab\<^sub>1\<rparr>\<close>
           using tab\<^sub>0 tab\<^sub>1 Maps.dom_char Maps.cod_char by (unfold_locales, simp)
 
         have "src \<mu> \<star> tab\<^sub>0 (src \<mu>) \<cong> tab\<^sub>0 (src \<mu>)"
           using \<mu> iso_lunit isomorphic_def
           by (metis lunit_in_hom(2) src.ide_u src.u_simps(3) src_src)
         hence "src \<mu> \<star> tab\<^sub>0 (src \<mu>) \<cong> tab\<^sub>1 (src \<mu>)"
           using \<mu> src.obj_has_symmetric_tab isomorphic_transitive by blast
 
         have "\<lbrakk>tab\<^sub>0 (src \<mu>)\<rbrakk> \<in> Maps.Hom (src (tab\<^sub>0 (src \<mu>))) (src \<mu>)"
           using \<mu> tab\<^sub>0_src by blast
         have "\<lbrakk>src \<mu>\<rbrakk> \<in> Maps.Hom (src \<mu>) (src \<mu>)"
         proof -
           have "\<guillemotleft>src \<mu> : src \<mu> \<rightarrow> src \<mu>\<guillemotright> \<and> is_left_adjoint (src \<mu>) \<and> \<lbrakk>src \<mu>\<rbrakk> = \<lbrakk>src \<mu>\<rbrakk>"
             using \<mu> obj_is_self_adjoint by simp
           thus ?thesis by auto
         qed
 
         interpret SPN_src: arrow_of_spans Maps.comp \<open>SPN (src \<mu>)\<close>
           using \<mu> SPN.preserves_reflects_arr Span.arr_char by blast
         have SPN_src: "SPN (src \<mu>) =
                        \<lparr>Chn = Maps.MkArr (src (tab\<^sub>0 (src \<mu>))) (src (tab\<^sub>0 (src \<mu>))) \<lbrakk>spn (src \<mu>)\<rbrakk>,
                         Dom = \<lparr>Leg0 = ?tab\<^sub>0, Leg1 = ?tab\<^sub>1\<rparr>,
                         Cod = \<lparr>Leg0 = ?tab\<^sub>0, Leg1 = ?tab\<^sub>1\<rparr>\<rparr>"
           unfolding SPN_def using \<mu> by simp
 
         interpret src_SPN: arrow_of_spans Maps.comp \<open>Span.src (SPN \<mu>)\<close>
           using \<mu> SPN.preserves_reflects_arr Span.arr_char by blast
         have src_SPN: "Span.src (SPN \<mu>) =
                        \<lparr>Chn = ?src,
                         Dom = \<lparr>Leg0 = ?src, Leg1 = ?src\<rparr>,
                         Cod = \<lparr>Leg0 = ?src, Leg1 = ?src\<rparr>\<rparr>"
         proof -
           let ?tab\<^sub>0_dom = "Maps.MkArr (src (tab\<^sub>0 (dom \<mu>))) (src \<mu>) \<lbrakk>tab\<^sub>0 (dom \<mu>)\<rbrakk>"
           have "Maps.arr ?tab\<^sub>0_dom"
           proof -
             have "\<guillemotleft>tab\<^sub>0 (dom \<mu>) : src (tab\<^sub>0 (dom \<mu>)) \<rightarrow> src \<mu>\<guillemotright> \<and>
                   is_left_adjoint (tab\<^sub>0 (dom \<mu>)) \<and> \<lbrakk>tab\<^sub>0 (dom \<mu>)\<rbrakk> = \<lbrakk>tab\<^sub>0 (dom \<mu>)\<rbrakk>"
               using \<mu> by simp
             thus ?thesis
               using \<mu> Maps.arr_MkArr by blast
           qed
           thus ?thesis
             using \<mu> Maps.cod_char Span.src_def by simp
         qed
 
         text \<open>
           The idea of the proof is that @{term "iso_class (tab\<^sub>0 (src \<mu>))"} is invertible
           in \<open>Maps(B)\<close> and determines an invertible arrow of spans from @{term "SPN (src \<mu>)"}
           to @{term "Span.src (SPN \<mu>)"}.
         \<close>
 
         let ?\<phi> = "\<lparr>Chn = ?tab\<^sub>0, Dom = Dom (SPN (src \<mu>)), Cod = Cod (Span.src (SPN \<mu>))\<rparr>"
         interpret \<phi>: arrow_of_spans Maps.comp ?\<phi>
           apply (unfold_locales, simp_all)
         proof -
           show "Maps.in_hom ?tab\<^sub>0 SPN_src.dom.apex src_SPN.cod.apex"
             using \<mu> tab\<^sub>0 Maps.dom_char Maps.cod_char SPN_src src_SPN
                   tab.apex_def src_SPN.cod.apex_def
             apply (intro Maps.in_homI) by simp_all
           show "src_SPN.cod.leg0 \<odot> ?tab\<^sub>0 = SPN_src.dom.leg0"
           proof -
             have "Maps.seq src_SPN.cod.leg0 ?tab\<^sub>0"
               using \<mu> src_SPN tab\<^sub>0 Maps.dom_char Maps.cod_char
               by (intro Maps.seqI, auto)
             moreover have "Maps.Comp \<lbrakk>src \<mu>\<rbrakk> \<lbrakk>tab\<^sub>0 (src \<mu>)\<rbrakk> = \<lbrakk>tab\<^sub>0 (src \<mu>)\<rbrakk>"
             proof -
               have "tab\<^sub>0 (src \<mu>) \<in> Maps.Comp \<lbrakk>src \<mu>\<rbrakk> \<lbrakk>tab\<^sub>0 (src \<mu>)\<rbrakk>"
                 using \<mu> is_iso_classI ide_in_iso_class [of "src \<mu>"]
                       ide_in_iso_class [of "tab\<^sub>0 (src \<mu>)"] \<open>src \<mu> \<star> tab\<^sub>0 (src \<mu>) \<cong> tab\<^sub>0 (src \<mu>)\<close>
                 by auto
               thus ?thesis
                 using Maps.Comp_eq_iso_class_memb
                       \<open>\<lbrakk>tab\<^sub>0 (src \<mu>)\<rbrakk> \<in> Maps.Hom (src (tab\<^sub>0 (src \<mu>))) (src \<mu>)\<close>
                       \<open>\<lbrakk>src \<mu>\<rbrakk> \<in> Maps.Hom (src \<mu>) (src \<mu>)\<close>
                 by meson
             qed
             ultimately show ?thesis
               using \<mu> Maps.comp_char [of src_SPN.cod.leg0 ?tab\<^sub>0] src_SPN by simp
           qed
           show "src_SPN.cod.leg1 \<odot> ?tab\<^sub>0 = SPN_src.dom.leg1"
           proof -
             have "Maps.seq src_SPN.cod.leg1 ?tab\<^sub>0"
               using \<mu> src_SPN tab\<^sub>0 Maps.dom_char Maps.cod_char
               by (intro Maps.seqI, auto)
             moreover have "Maps.Comp \<lbrakk>src \<mu>\<rbrakk> \<lbrakk>tab\<^sub>0 (src \<mu>)\<rbrakk> = \<lbrakk>tab\<^sub>1 (src \<mu>)\<rbrakk>"
             proof -
               have "tab\<^sub>1 (src \<mu>) \<in> Maps.Comp \<lbrakk>src \<mu>\<rbrakk> \<lbrakk>tab\<^sub>0 (src \<mu>)\<rbrakk>"
                 using \<mu> is_iso_classI ide_in_iso_class [of "src \<mu>"]
                       ide_in_iso_class [of "tab\<^sub>0 (src \<mu>)"]
                       \<open>isomorphic (src \<mu> \<star> tab\<^sub>0 (src \<mu>)) (tab\<^sub>1 (src \<mu>))\<close>
                 by auto
               thus ?thesis
                 using Maps.Comp_eq_iso_class_memb
                       \<open>\<lbrakk>tab\<^sub>0 (src \<mu>)\<rbrakk> \<in> Maps.Hom (src (tab\<^sub>0 (src \<mu>))) (src \<mu>)\<close>
                       \<open>\<lbrakk>src \<mu>\<rbrakk> \<in> Maps.Hom (src \<mu>) (src \<mu>)\<close>
                 by meson
             qed
             ultimately show ?thesis
               using \<mu> Maps.comp_char [of src_SPN.cod.leg1 ?tab\<^sub>0] src_SPN by simp
           qed
         qed
         have "Span.in_hom ?\<phi> (SPN (src \<mu>)) (Span.src (SPN \<mu>))"
           using \<mu> tab\<^sub>0 spn_ide [of "src \<mu>"] iso_class_eqI
                 Span.arr_char Span.dom_char Span.cod_char \<phi>.arrow_of_spans_axioms
                 SPN_src src_SPN src.apex_def tab.apex_def Maps.dom_char
           apply (intro Span.in_homI) by auto
           (* The preceding cannot be written "by (intro Span.in_homI, auto)", why? *)
         moreover have "Maps.iso ?tab\<^sub>0"
           using \<mu> tab\<^sub>0 ide_in_iso_class src.is_map_iff_tab\<^sub>0_is_equivalence obj_is_self_adjoint
                 Maps.iso_char' [of ?tab\<^sub>0]
           by auto
         ultimately show "Span.isomorphic (SPN (src \<mu>)) (Span.src (SPN \<mu>))"
           using Span.isomorphic_def Span.iso_char by auto
       qed
       show "\<And>\<mu>. arr \<mu> \<Longrightarrow> Span.isomorphic (SPN (trg \<mu>)) (Span.trg (SPN \<mu>))"
       proof -
         fix \<mu>
         assume \<mu>: "arr \<mu>"
         let ?trg = "Maps.MkIde (trg \<mu>)"
         have trg: "Maps.ide ?trg"
           using \<mu> by simp
         interpret trg: identity_in_bicategory_of_spans V H \<a> \<i> src trg \<open>trg \<mu>\<close>
           using \<mu> by unfold_locales auto
         interpret trg: span_in_category Maps.comp \<open>\<lparr>Leg0 = ?trg, Leg1 = ?trg\<rparr>\<close>
           using trg by (unfold_locales, simp)
 
         let ?tab\<^sub>0 = "Maps.MkArr (src (tab\<^sub>0 (trg \<mu>))) (trg \<mu>) \<lbrakk>tab\<^sub>0 (trg \<mu>)\<rbrakk>"
         have tab\<^sub>0_trg: "\<guillemotleft>tab\<^sub>0 (trg \<mu>) : src (tab\<^sub>0 (trg \<mu>)) \<rightarrow> trg \<mu>\<guillemotright> \<and>
                         is_left_adjoint (tab\<^sub>0 (trg \<mu>)) \<and> \<lbrakk>tab\<^sub>0 (trg \<mu>)\<rbrakk> = \<lbrakk>tab\<^sub>0 (trg \<mu>)\<rbrakk>"
           using \<mu> by simp
         have tab\<^sub>0: "Maps.arr ?tab\<^sub>0"
           using \<mu> Maps.arr_MkArr tab\<^sub>0_trg by blast
         let ?tab\<^sub>1 = "Maps.MkArr (src (tab\<^sub>0 (trg \<mu>))) (trg \<mu>) \<lbrakk>tab\<^sub>1 (trg \<mu>)\<rbrakk>"
         have tab\<^sub>1_trg: "\<guillemotleft>tab\<^sub>1 (trg \<mu>) : src (tab\<^sub>0 (trg \<mu>)) \<rightarrow> trg \<mu>\<guillemotright> \<and>
                         is_left_adjoint (tab\<^sub>1 (trg \<mu>)) \<and> \<lbrakk>tab\<^sub>1 (trg \<mu>)\<rbrakk> = \<lbrakk>tab\<^sub>1 (trg \<mu>)\<rbrakk>"
           using \<mu> by simp
         have tab\<^sub>1: "Maps.arr ?tab\<^sub>1"
           using \<mu> Maps.arr_MkArr tab\<^sub>1_trg by blast
         interpret tab: span_in_category Maps.comp \<open>\<lparr>Leg0 = ?tab\<^sub>0, Leg1 = ?tab\<^sub>1\<rparr>\<close>
           using tab\<^sub>0 tab\<^sub>1 Maps.dom_char Maps.cod_char by (unfold_locales, simp)
 
         have "trg \<mu> \<star> tab\<^sub>1 (trg \<mu>) \<cong> tab\<^sub>0 (trg \<mu>)"
         proof -
           have "\<guillemotleft>\<l>[tab\<^sub>1 (trg \<mu>)] : trg \<mu> \<star> tab\<^sub>1 (trg \<mu>) \<Rightarrow> tab\<^sub>1 (trg \<mu>)\<guillemotright>"
             using \<mu> by simp
           moreover have "iso \<l>[tab\<^sub>1 (trg \<mu>)]"
             using \<mu> iso_lunit by simp
           ultimately have "trg \<mu> \<star> tab\<^sub>1 (trg \<mu>) \<cong> tab\<^sub>1 (trg \<mu>)"
             using isomorphic_def by auto
           also have "tab\<^sub>1 (trg \<mu>) \<cong> tab\<^sub>0 (trg \<mu>)"
             using \<mu> trg.obj_has_symmetric_tab isomorphic_symmetric by auto
           finally show ?thesis by blast
         qed
         hence "trg \<mu> \<star> tab\<^sub>1 (trg \<mu>) \<cong> tab\<^sub>1 (trg \<mu>)"
           using \<mu> trg.obj_has_symmetric_tab isomorphic_transitive by blast
 
         have "\<lbrakk>tab\<^sub>1 (trg \<mu>)\<rbrakk> \<in> Maps.Hom (src (tab\<^sub>0 (trg \<mu>))) (trg \<mu>)"
         proof -
           have "\<guillemotleft>tab\<^sub>1 (trg \<mu>) : src (tab\<^sub>0 (trg \<mu>)) \<rightarrow> trg \<mu>\<guillemotright> \<and> is_left_adjoint (tab\<^sub>0 (trg \<mu>)) \<and>
                 \<lbrakk>tab\<^sub>0 (trg \<mu>)\<rbrakk> = \<lbrakk>tab\<^sub>0 (trg \<mu>)\<rbrakk>"
             using \<mu> by simp
           thus ?thesis by auto
         qed
         have "\<lbrakk>trg \<mu>\<rbrakk> \<in> Maps.Hom (trg \<mu>) (trg \<mu>)"
         proof -
           have "\<guillemotleft>trg \<mu> : trg \<mu> \<rightarrow> trg \<mu>\<guillemotright> \<and> is_left_adjoint (trg \<mu>) \<and> \<lbrakk>trg \<mu>\<rbrakk> = \<lbrakk>trg \<mu>\<rbrakk>"
             using \<mu> obj_is_self_adjoint by simp
           thus ?thesis by auto
         qed
 
         interpret SPN_trg: arrow_of_spans Maps.comp \<open>SPN (trg \<mu>)\<close>
           using \<mu> SPN.preserves_reflects_arr Span.arr_char by blast
         have SPN_trg: "SPN (trg \<mu>) =
                        \<lparr>Chn = Maps.MkArr (src (tab\<^sub>1 (trg \<mu>))) (src (tab\<^sub>1 (trg \<mu>))) \<lbrakk>spn (trg \<mu>)\<rbrakk>,
                         Dom = \<lparr>Leg0 = ?tab\<^sub>0, Leg1 = ?tab\<^sub>1\<rparr>,
                         Cod = \<lparr>Leg0 = ?tab\<^sub>0, Leg1 = ?tab\<^sub>1\<rparr>\<rparr>"
           unfolding SPN_def using \<mu> by simp
 
         interpret trg_SPN: arrow_of_spans Maps.comp \<open>Span.trg (SPN \<mu>)\<close>
           using \<mu> SPN.preserves_reflects_arr Span.arr_char by blast
         have trg_SPN: "Span.trg (SPN \<mu>) = \<lparr>Chn = ?trg,
                                            Dom = \<lparr>Leg0 = ?trg, Leg1 = ?trg\<rparr>,
                                            Cod = \<lparr>Leg0 = ?trg, Leg1 = ?trg\<rparr>\<rparr>"
         proof -
           let ?tab\<^sub>1_dom = "Maps.MkArr (src (tab\<^sub>1 (dom \<mu>))) (trg \<mu>) \<lbrakk>tab\<^sub>1 (dom \<mu>)\<rbrakk>"
           have "Maps.arr ?tab\<^sub>1_dom"
           proof -
             have "\<guillemotleft>tab\<^sub>1 (dom \<mu>) : src (tab\<^sub>1 (dom \<mu>)) \<rightarrow> trg \<mu>\<guillemotright> \<and>
                   is_left_adjoint (tab\<^sub>1 (dom \<mu>)) \<and> \<lbrakk>tab\<^sub>1 (dom \<mu>)\<rbrakk> = \<lbrakk>tab\<^sub>1 (dom \<mu>)\<rbrakk>"
               using \<mu> by simp
             thus ?thesis
               using \<mu> Maps.arr_MkArr by blast
           qed
           thus ?thesis
             using \<mu> Maps.cod_char Span.trg_def by simp
         qed
 
         let ?\<phi> = "\<lparr>Chn = ?tab\<^sub>1, Dom = Dom (SPN (trg \<mu>)), Cod = Cod (Span.trg (SPN \<mu>))\<rparr>"
         interpret \<phi>: arrow_of_spans Maps.comp ?\<phi>
           apply (unfold_locales, simp_all)
         proof -
           show "Maps.in_hom ?tab\<^sub>1 SPN_trg.dom.apex trg_SPN.cod.apex"
             using \<mu> tab\<^sub>0 tab\<^sub>1 Maps.dom_char Maps.cod_char SPN_trg trg_SPN
                   tab.apex_def trg_SPN.cod.apex_def
             apply (intro Maps.in_homI) by simp_all
             (* The preceding cannot be written "by (intro Maps.in_homI, simp_all)", why? *)
           show "Maps.comp trg_SPN.cod.leg0 ?tab\<^sub>1 = SPN_trg.dom.leg0"
           proof -
             have "Maps.seq trg_SPN.cod.leg0 ?tab\<^sub>1"
               using \<mu> trg_SPN tab\<^sub>1 Maps.dom_char Maps.cod_char
               by (intro Maps.seqI, auto)
             moreover have "Maps.Comp \<lbrakk>trg \<mu>\<rbrakk> \<lbrakk>tab\<^sub>1 (trg \<mu>)\<rbrakk> = \<lbrakk>tab\<^sub>1 (trg \<mu>)\<rbrakk>"
             proof -
               have "tab\<^sub>1 (trg \<mu>) \<in> Maps.Comp \<lbrakk>trg \<mu>\<rbrakk> \<lbrakk>tab\<^sub>1 (trg \<mu>)\<rbrakk>"
                 using \<mu> is_iso_classI ide_in_iso_class [of "trg \<mu>"]
                       ide_in_iso_class [of "tab\<^sub>1 (trg \<mu>)"] \<open>trg \<mu> \<star> tab\<^sub>1 (trg \<mu>) \<cong> tab\<^sub>1 (trg \<mu>)\<close>
                 by auto
               thus ?thesis
                 using Maps.Comp_eq_iso_class_memb
                       \<open>iso_class (tab\<^sub>1 (trg \<mu>)) \<in> Maps.Hom (src (tab\<^sub>0 (trg \<mu>))) (trg \<mu>)\<close>
                       \<open>iso_class (trg \<mu>) \<in> Maps.Hom (trg \<mu>) (trg \<mu>)\<close>
                 by meson
             qed
             moreover have "\<lbrakk>tab\<^sub>1 (trg \<mu>)\<rbrakk> = \<lbrakk>tab\<^sub>0 (trg \<mu>)\<rbrakk>"
               using \<mu> iso_class_eqI trg.obj_has_symmetric_tab by auto
             ultimately show ?thesis
               using \<mu> Maps.comp_char [of trg_SPN.cod.leg0 ?tab\<^sub>1] trg_SPN
               by simp
           qed
           show "trg_SPN.cod.leg1 \<odot> ?tab\<^sub>1 = SPN_trg.dom.leg1"
           proof -
             have "Maps.seq trg_SPN.cod.leg1 ?tab\<^sub>1"
               using \<mu> trg_SPN tab\<^sub>1 Maps.dom_char Maps.cod_char
               by (intro Maps.seqI, auto)
             moreover have "Maps.Comp \<lbrakk>trg \<mu>\<rbrakk> \<lbrakk>tab\<^sub>1 (trg \<mu>)\<rbrakk> = \<lbrakk>tab\<^sub>1 (trg \<mu>)\<rbrakk>"
             proof -
               have "tab\<^sub>1 (trg \<mu>) \<in> Maps.Comp \<lbrakk>trg \<mu>\<rbrakk> \<lbrakk>tab\<^sub>1 (trg \<mu>)\<rbrakk>"
                 using \<mu> is_iso_classI ide_in_iso_class [of "trg \<mu>"]
                       ide_in_iso_class [of "tab\<^sub>1 (trg \<mu>)"] \<open>trg \<mu> \<star> tab\<^sub>1 (trg \<mu>) \<cong> tab\<^sub>1 (trg \<mu>)\<close>
                 by auto
               thus ?thesis
                 using Maps.Comp_eq_iso_class_memb
                       \<open>\<lbrakk>tab\<^sub>1 (trg \<mu>)\<rbrakk> \<in> Maps.Hom (src (tab\<^sub>0 (trg \<mu>))) (trg \<mu>)\<close>
                       \<open>\<lbrakk>trg \<mu>\<rbrakk> \<in> Maps.Hom (trg \<mu>) (trg \<mu>)\<close>
                 by meson
             qed
             ultimately show ?thesis
               using \<mu> Maps.comp_char [of trg_SPN.cod.leg1 ?tab\<^sub>1] trg_SPN by simp
           qed
         qed
         have \<phi>: "Span.in_hom ?\<phi> (SPN (trg \<mu>)) (Span.trg (SPN \<mu>))"
           using \<mu> tab\<^sub>0 spn_ide [of "trg \<mu>"] iso_class_eqI
                 Span.arr_char Span.dom_char Span.cod_char \<phi>.arrow_of_spans_axioms
                 SPN_trg trg_SPN trg.apex_def tab.apex_def Maps.dom_char
           apply (intro Span.in_homI) by auto
         have "Maps.iso ?tab\<^sub>1"
         proof -
           have "Maps.iso ?tab\<^sub>0"
             using \<mu> tab\<^sub>0 ide_in_iso_class trg.is_map_iff_tab\<^sub>0_is_equivalence obj_is_self_adjoint
                   Maps.iso_char' [of ?tab\<^sub>0]
             by auto
           moreover have "?tab\<^sub>0 = ?tab\<^sub>1"
           proof -
             have "\<lbrakk>tab\<^sub>0 (trg \<mu>)\<rbrakk> = \<lbrakk>tab\<^sub>1 (trg \<mu>)\<rbrakk>"
               using \<mu> iso_class_eqI trg.obj_has_symmetric_tab by auto
             thus ?thesis by simp
           qed
           ultimately show ?thesis by simp
         qed
         thus "Span.isomorphic (SPN (trg \<mu>)) (Span.trg (SPN \<mu>))"
           using \<phi> Span.isomorphic_def Span.iso_char by auto
       qed
     qed
 
     lemma SPN_is_weak_arrow_of_homs:
     shows "weak_arrow_of_homs V src trg Span.vcomp Span.src Span.trg SPN"
       ..
 
   end
 
   subsubsection "Compositors"
 
   text \<open>
     To complete the proof that \<open>SPN\<close> is a pseudofunctor, we need to obtain a natural
     isomorphism \<open>\<Phi>\<close>, whose component at \<open>(r, s)\<close> is an isomorphism \<open>\<Phi> (r, s)\<close>
     from the horizontal composite \<open>SPN r \<circ> SPN s\<close> to \<open>SPN (r \<star> s)\<close> in \<open>Span(Maps(B))\<close>,
     and we need to prove that the coherence conditions are satisfied.
 
     We have shown that the tabulations of \<open>r\<close> and \<open>s\<close> compose to yield a tabulation of \<open>r \<star> s\<close>.
     Since tabulations of the same arrow are equivalent, this tabulation must be equivalent
     to the chosen tabulation of \<open>r \<star> s\<close>.  We therefore obtain an equivalence map from the
     apex of \<open>SPN r \<circ> SPN s\<close> to the apex of \<open>SPN (r \<star> s)\<close> which commutes with the
     legs of these spans up to isomorphism.  This equivalence map determines an invertible
     arrow in \<open>Span(Maps(B))\<close>.  Moreover, by property \<open>T2\<close>, any two such equivalence maps are
     connected by a unique 2-cell, which is consequently an isomorphism.  This shows that
     the arrow in \<open>Span(Maps(B))\<close> is uniquely determined, which fact we can exploit to establish
     the required coherence conditions.
   \<close>
 
   locale two_composable_identities_in_bicategory_of_spans =
     bicategory_of_spans V H \<a> \<i> src trg +
     r: identity_in_bicategory_of_spans V H \<a> \<i> src trg r +
     s: identity_in_bicategory_of_spans V H \<a> \<i> src trg s
   for V :: "'a comp"                 (infixr "\<cdot>" 55)
   and H :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"          (infixr "\<star>" 53)
   and \<a> :: "'a \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a"     ("\<a>[_, _, _]")
   and \<i> :: "'a \<Rightarrow> 'a"                 ("\<i>[_]")
   and src :: "'a \<Rightarrow> 'a"
   and trg :: "'a \<Rightarrow> 'a"
   and r :: 'a
   and s :: 'a +
   assumes composable: "src r = trg s"
   begin
 
     notation isomorphic (infix "\<cong>" 50)
 
     interpretation r: arrow_in_bicategory_of_spans V H \<a> \<i> src trg r r r
       by unfold_locales auto
     interpretation r: arrow_of_tabulations_in_maps V H \<a> \<i> src trg
                         r r.tab \<open>tab\<^sub>0 r\<close> \<open>tab\<^sub>1 r\<close>
                         r r.tab \<open>tab\<^sub>0 r\<close> \<open>tab\<^sub>1 r\<close>
                         r
       using r.is_arrow_of_tabulations_in_maps by simp
     interpretation s: arrow_in_bicategory_of_spans V H \<a> \<i> src trg s s s
       by unfold_locales auto
     interpretation s: arrow_of_tabulations_in_maps V H \<a> \<i> src trg
                         s s.tab \<open>tab\<^sub>0 s\<close> \<open>tab\<^sub>1 s\<close>
                         s s.tab \<open>tab\<^sub>0 s\<close> \<open>tab\<^sub>1 s\<close>
                         s
       using s.is_arrow_of_tabulations_in_maps by simp
 
     sublocale identity_in_bicategory_of_spans V H \<a> \<i> src trg \<open>r \<star> s\<close>
       apply unfold_locales by (simp add: composable)
     sublocale horizontal_composite_of_arrows_of_tabulations_in_maps V H \<a> \<i> src trg
                 r r.tab \<open>tab\<^sub>0 r\<close> \<open>tab\<^sub>1 r\<close> s s.tab \<open>tab\<^sub>0 s\<close> \<open>tab\<^sub>1 s\<close>
                 r r.tab \<open>tab\<^sub>0 r\<close> \<open>tab\<^sub>1 r\<close> s s.tab \<open>tab\<^sub>0 s\<close> \<open>tab\<^sub>1 s\<close>
                 r s
       using composable by unfold_locales auto
 
     abbreviation p\<^sub>0 where "p\<^sub>0 \<equiv> \<rho>\<sigma>.p\<^sub>0"
     abbreviation p\<^sub>1 where "p\<^sub>1 \<equiv> \<rho>\<sigma>.p\<^sub>1"
 
     text \<open>
       We will take as the composition isomorphism from \<open>SPN r \<circ> SPN s\<close> to \<open>SPN (r \<star> s)\<close>
       the arrow of tabulations, induced by the identity \<open>r \<star> s\<close>, from the composite of
       the chosen tabulations of \<open>r\<close> and \<open>s\<close> to the chosen tabulation of \<open>r \<star> s\<close>.
       As this arrow of tabulations is induced by an identity, it is an equivalence map.
     \<close>
 
     interpretation cmp: identity_arrow_of_tabulations_in_maps V H \<a> \<i> src trg
                           \<open>r \<star> s\<close> \<rho>\<sigma>.tab \<open>tab\<^sub>0 s \<star> \<rho>\<sigma>.p\<^sub>0\<close> \<open>tab\<^sub>1 r \<star> \<rho>\<sigma>.p\<^sub>1\<close>
                           \<open>r \<star> s\<close> tab \<open>tab\<^sub>0 (r \<star> s)\<close> \<open>tab\<^sub>1 (r \<star> s)\<close>
                           \<open>r \<star> s\<close>
       using composable
       by unfold_locales auto
 
     lemma cmp_interpretation:
     shows "identity_arrow_of_tabulations_in_maps V H \<a> \<i> src trg
                           (r \<star> s) \<rho>\<sigma>.tab (tab\<^sub>0 s \<star> \<rho>\<sigma>.p\<^sub>0) (tab\<^sub>1 r \<star> \<rho>\<sigma>.p\<^sub>1)
                           (r \<star> s) tab (tab\<^sub>0 (r \<star> s)) (tab\<^sub>1 (r \<star> s))
                           (r \<star> s)"
       ..
 
     definition cmp
     where "cmp = cmp.chine"
 
     lemma cmp_props:
     shows "\<guillemotleft>cmp : src \<rho>\<sigma>.tab \<rightarrow> src tab\<guillemotright>"
     and "\<guillemotleft>cmp : cmp \<Rightarrow> cmp\<guillemotright>"
     and "equivalence_map cmp"
     and "tab\<^sub>0 (r \<star> s) \<star> cmp \<cong> tab\<^sub>0 s \<star> \<rho>\<sigma>.p\<^sub>0"
     and "tab\<^sub>1 (r \<star> s) \<star> cmp \<cong> tab\<^sub>1 r \<star> \<rho>\<sigma>.p\<^sub>1"
       using cmp_def cmp.leg0_uniquely_isomorphic(1) cmp.leg1_uniquely_isomorphic(1)
             isomorphic_symmetric cmp.chine_is_equivalence
       by auto
 
     lemma cmp_in_hom [intro]:
     shows "\<guillemotleft>cmp : src \<rho>\<sigma>.tab \<rightarrow> src tab\<guillemotright>"
     and "\<guillemotleft>cmp : cmp \<Rightarrow> cmp\<guillemotright>"
       using cmp_props by auto
 
     lemma cmp_simps [simp]:
     shows "arr cmp" and "ide cmp"
     and "src cmp = src \<rho>\<sigma>.tab" and "trg cmp = src tab"
     and "dom cmp = cmp" and "cod cmp = cmp"
       using cmp_props equivalence_map_is_ide by auto
 
     text \<open>
       Now we have to use the above properties of the underlying bicategory to
       exhibit the composition isomoprhisms as actual arrows in \<open>Span(Maps(B))\<close>
       and to prove the required naturality and coherence conditions.
     \<close>
 
     interpretation Maps: maps_category V H \<a> \<i> src trg ..
     interpretation Span: span_bicategory Maps.comp Maps.PRJ\<^sub>0 Maps.PRJ\<^sub>1 ..
 
     no_notation Fun.comp (infixl "\<circ>" 55)
     notation Span.vcomp (infixr "\<bullet>" 55)
     notation Span.hcomp (infixr "\<circ>" 53)
     notation Maps.comp (infixr "\<odot>" 55)
 
     interpretation SPN: "functor" V Span.vcomp SPN
       using SPN_is_functor by simp
     interpretation SPN: weak_arrow_of_homs V src trg Span.vcomp Span.src Span.trg SPN
       using SPN_is_weak_arrow_of_homs by simp
 
     interpretation SPN_r_SPN_s: arrow_of_spans Maps.comp \<open>SPN r \<circ> SPN s\<close>
       using composable Span.ide_char [of "SPN r \<circ> SPN s"] by simp
     interpretation SPN_r_SPN_s: identity_arrow_of_spans Maps.comp \<open>SPN r \<circ> SPN s\<close>
       using composable Span.ide_char [of "SPN r \<circ> SPN s"]
       by (unfold_locales, simp)
     interpretation SPN_rs: arrow_of_spans Maps.comp \<open>SPN (r \<star> s)\<close>
       using composable Span.arr_char r.base_simps(2) s.base_simps(2) by blast
     interpretation SPN_rs: identity_arrow_of_spans Maps.comp \<open>SPN (r \<star> s)\<close>
       using composable Span.ide_char SPN.preserves_ide r.is_ide s.is_ide
       by (unfold_locales, simp)
 
     text \<open>
       The following are the legs (as arrows of \<open>Maps\<close>) of the spans \<open>SPN r\<close> and \<open>SPN s\<close>.
     \<close>
 
     definition R\<^sub>0 where "R\<^sub>0 = \<lbrakk>\<lbrakk>tab\<^sub>0 r\<rbrakk>\<rbrakk>"
     definition R\<^sub>1 where "R\<^sub>1 = \<lbrakk>\<lbrakk>tab\<^sub>1 r\<rbrakk>\<rbrakk>"
     definition S\<^sub>0 where "S\<^sub>0 = \<lbrakk>\<lbrakk>tab\<^sub>0 s\<rbrakk>\<rbrakk>"
     definition S\<^sub>1 where "S\<^sub>1 = \<lbrakk>\<lbrakk>tab\<^sub>1 s\<rbrakk>\<rbrakk>"
 
     lemma span_legs_eq:
     shows "Leg0 (Dom (SPN r)) = R\<^sub>0" and "Leg1 (Dom (SPN r)) = R\<^sub>1"
     and "Leg0 (Dom (SPN s)) = S\<^sub>0" and "Leg1 (Dom (SPN s)) = S\<^sub>1"
       using SPN_def R\<^sub>0_def R\<^sub>1_def S\<^sub>0_def S\<^sub>1_def composable by auto
 
     lemma R\<^sub>0_in_hom [intro]:
     shows "Maps.in_hom R\<^sub>0 (Maps.MkIde (src r.s\<^sub>0)) (Maps.MkIde (src r))"
       by (simp add: Maps.MkArr_in_hom' R\<^sub>0_def)
 
     lemma R\<^sub>1_in_hom [intro]:
     shows "Maps.in_hom R\<^sub>1 (Maps.MkIde (src r.s\<^sub>0)) (Maps.MkIde (trg r))"
       by (simp add: Maps.MkArr_in_hom' R\<^sub>1_def)
 
     lemma S\<^sub>0_in_hom [intro]:
     shows "Maps.in_hom S\<^sub>0 (Maps.MkIde (src s.s\<^sub>0)) (Maps.MkIde (src s))"
       by (simp add: Maps.MkArr_in_hom' S\<^sub>0_def)
 
     lemma S\<^sub>1_in_hom [intro]:
     shows "Maps.in_hom S\<^sub>1 (Maps.MkIde (src s.s\<^sub>0)) (Maps.MkIde (trg s))"
       by (simp add: Maps.MkArr_in_hom' S\<^sub>1_def)
 
     lemma RS_simps [simp]:
     shows "Maps.arr R\<^sub>0" and "Maps.dom R\<^sub>0 = Maps.MkIde (src r.s\<^sub>0)"
     and "Maps.cod R\<^sub>0 = Maps.MkIde (src r)"
     and "Maps.Dom R\<^sub>0 = src r.s\<^sub>0" and "Maps.Cod R\<^sub>0 = src r"
     and "Maps.arr R\<^sub>1" and "Maps.dom R\<^sub>1 = Maps.MkIde (src r.s\<^sub>0)"
     and "Maps.cod R\<^sub>1 = Maps.MkIde (trg r)"
     and "Maps.Dom R\<^sub>1 = src r.s\<^sub>0" and "Maps.Cod R\<^sub>1 = trg r"
     and "Maps.arr S\<^sub>0" and "Maps.dom S\<^sub>0 = Maps.MkIde (src s.s\<^sub>0)"
     and "Maps.cod S\<^sub>0 = Maps.MkIde (src s)"
     and "Maps.Dom S\<^sub>0 = src s.s\<^sub>0" and "Maps.Cod S\<^sub>0 = src s"
     and "Maps.arr S\<^sub>1" and "Maps.dom S\<^sub>1 = Maps.MkIde (src s.s\<^sub>0)"
     and "Maps.cod S\<^sub>1 = Maps.MkIde (trg s)"
     and "Maps.Dom S\<^sub>1 = src s.s\<^sub>0" and "Maps.Cod S\<^sub>1 = trg s"
       using R\<^sub>0_in_hom R\<^sub>1_in_hom S\<^sub>0_in_hom S\<^sub>1_in_hom composable
       by (auto simp add: R\<^sub>0_def R\<^sub>1_def S\<^sub>0_def S\<^sub>1_def)
 
     text \<open>
       The apex of the composite span @{term "SPN r \<circ> SPN s"} (defined in terms of pullback)
       coincides with the apex of the composite tabulation \<open>\<rho>\<sigma>\<close> (defined using
       the chosen tabulation of \<open>(tab\<^sub>0 r)\<^sup>* \<star> tab\<^sub>1 s)\<close>).  We need this to be true in order
       to define the compositor of a pseudofunctor from the underlying bicategory \<open>B\<close>
       to \<open>Span(Maps(B))\<close>.  It is only true if we have carefully chosen pullbacks in \<open>Maps(B)\<close>
       in order to ensure the relationship with the chosen tabulations.
     \<close>
 
     lemma SPN_r_SPN_s_apex_eq:
     shows "SPN_r_SPN_s.apex = Maps.MkIde (src \<rho>\<sigma>.tab)"
     proof -
       have "obj (Maps.Cod SPN_r_SPN_s.leg0)"
         using Maps.arr_char [of "SPN_r_SPN_s.leg0"] by simp
       moreover have "obj (Maps.Dom SPN_r_SPN_s.leg0)"
         using Maps.arr_char [of "SPN_r_SPN_s.leg0"] by simp
       moreover have "SPN_r_SPN_s.leg0 \<noteq> Maps.Null"
         using Maps.arr_char [of "SPN_r_SPN_s.leg0"] by simp
       moreover have "Maps.Dom SPN_r_SPN_s.leg0 = src \<rho>\<sigma>.tab"
       proof -
         interpret REP_S\<^sub>1: map_in_bicategory V H \<a> \<i> src trg \<open>Maps.REP S\<^sub>1\<close>
           using Maps.REP_in_Map Maps.arr_char Maps.in_HomD S\<^sub>1_def
           apply unfold_locales
           by (meson Maps.REP_in_hhom(2) S\<^sub>1_in_hom)
         interpret REP_R\<^sub>0: map_in_bicategory V H \<a> \<i> src trg \<open>Maps.REP R\<^sub>0\<close>
           using Maps.REP_in_Map Maps.arr_char Maps.in_HomD R\<^sub>0_def
           apply unfold_locales
           by (meson Maps.REP_in_hhom(2) R\<^sub>0_in_hom)
         have "Maps.Dom SPN_r_SPN_s.leg0 = Maps.Dom (S\<^sub>0 \<odot> Maps.PRJ\<^sub>0 R\<^sub>0 S\<^sub>1)"
           using composable Span.hcomp_def S\<^sub>0_def R\<^sub>0_def S\<^sub>1_def by simp
         also have "... = Maps.Dom \<lbrakk>\<lbrakk>tab\<^sub>0 ((Maps.REP R\<^sub>0)\<^sup>* \<star> Maps.REP S\<^sub>1)\<rbrakk>\<rbrakk>"
         proof -
           have "is_left_adjoint (tab\<^sub>0 ((Maps.REP R\<^sub>0)\<^sup>* \<star> Maps.REP S\<^sub>1))"
           proof -
             have "ide ((Maps.REP R\<^sub>0)\<^sup>* \<star> Maps.REP S\<^sub>1)"
             proof -
               have "src (Maps.REP R\<^sub>0)\<^sup>* = trg (Maps.REP S\<^sub>1)"
                 using REP_R\<^sub>0.is_map REP_S\<^sub>1.is_map left_adjoint_is_ide R\<^sub>0_def S\<^sub>1_def
                 by (metis (no_types, lifting) Maps.REP_CLS REP_R\<^sub>0.antipar(2)
                     isomorphic_implies_hpar(4) composable r.leg0_simps(3)
                     r.satisfies_T0 s.leg1_is_map s.leg1_simps(3) s.leg1_simps(4))
               thus ?thesis by simp
             qed
             thus ?thesis by simp
           qed
           moreover have "Maps.Dom (S\<^sub>0 \<odot> \<lbrakk>\<lbrakk>tab\<^sub>0 ((Maps.REP R\<^sub>0)\<^sup>* \<star> Maps.REP S\<^sub>1)\<rbrakk>\<rbrakk>) =
                          src (tab\<^sub>0 ((Maps.REP R\<^sub>0)\<^sup>* \<star> Maps.REP S\<^sub>1))"
           proof -
             have "Maps.arr (\<lbrakk>\<lbrakk>prj\<^sub>0 (Maps.REP S\<^sub>1) (Maps.REP R\<^sub>0)\<rbrakk>\<rbrakk>)"
               using Maps.CLS_in_hom Maps.prj0_simps(1) Maps.PRJ\<^sub>0_def composable by fastforce
             moreover have "Maps.Dom S\<^sub>0 = Maps.Cod \<lbrakk>\<lbrakk>prj\<^sub>0 (Maps.REP S\<^sub>1) (Maps.REP R\<^sub>0)\<rbrakk>\<rbrakk>"
             proof -
               have "Maps.Cod \<lbrakk>\<lbrakk>prj\<^sub>0 (Maps.REP S\<^sub>1) (Maps.REP R\<^sub>0)\<rbrakk>\<rbrakk> =
                     trg (prj\<^sub>0 (Maps.REP S\<^sub>1) (Maps.REP R\<^sub>0))"
                 by simp
               also have "... = src (Maps.REP S\<^sub>1)"
               proof -
                 have "ide (Maps.REP S\<^sub>1)"
                   by simp
                 moreover have "is_left_adjoint (Maps.REP R\<^sub>0)"
                   by auto
                 moreover have "trg (Maps.REP S\<^sub>1) = trg (Maps.REP R\<^sub>0)"
                   by (simp add: composable)
                 ultimately show ?thesis
                   using S\<^sub>1_def Maps.REP_CLS r.leg0_is_map s.leg1_is_map by simp
               qed
               also have "... = src (tab\<^sub>0 s)"
                 using tab\<^sub>0_in_hom(1) by simp
               also have "... = Maps.Dom S\<^sub>0"
                 using S\<^sub>0_def by simp
               finally show ?thesis by simp
             qed
             ultimately have
               "Maps.Dom (S\<^sub>0 \<odot> \<lbrakk>\<lbrakk>tab\<^sub>0 ((Maps.REP R\<^sub>0)\<^sup>* \<star> Maps.REP S\<^sub>1)\<rbrakk>\<rbrakk>) =
                Maps.Dom \<lbrakk>\<lbrakk>tab\<^sub>0 ((Maps.REP R\<^sub>0)\<^sup>* \<star> Maps.REP S\<^sub>1)\<rbrakk>\<rbrakk>"
               using Maps.CLS_in_hom by simp
             thus ?thesis by simp
           qed
           ultimately show ?thesis
             using Maps.PRJ\<^sub>0_def composable Maps.Dom.simps(1) RS_simps(1) RS_simps(16)
                   RS_simps(18) RS_simps(3)
             by presburger
         qed
         also have "... = src (tab\<^sub>0 ((Maps.REP R\<^sub>0)\<^sup>* \<star> Maps.REP S\<^sub>1))"
           by simp
         finally have
           "Maps.Dom SPN_r_SPN_s.leg0 = src (tab\<^sub>0 ((Maps.REP R\<^sub>0)\<^sup>* \<star> Maps.REP S\<^sub>1))"
           by simp
         also have "... = src (tab\<^sub>0 (r.s\<^sub>0\<^sup>* \<star> s.s\<^sub>1))"
         proof -
           interpret r\<^sub>0's\<^sub>1: identity_in_bicategory_of_spans V H \<a> \<i> src trg \<open>r.s\<^sub>0\<^sup>* \<star> s.s\<^sub>1\<close>
             using composable by (unfold_locales, simp)
           have "(Maps.REP R\<^sub>0)\<^sup>* \<star> Maps.REP S\<^sub>1 \<cong> r.s\<^sub>0\<^sup>* \<star> s.s\<^sub>1"
           proof -
             have "(Maps.REP R\<^sub>0)\<^sup>* \<cong> r.s\<^sub>0\<^sup>*"
             proof -
               have 1: "adjoint_pair (Maps.REP R\<^sub>0) (Maps.REP R\<^sub>0)\<^sup>*"
                 using REP_R\<^sub>0.is_map left_adjoint_extends_to_adjoint_pair by blast
               moreover have "adjoint_pair r.s\<^sub>0 (Maps.REP R\<^sub>0)\<^sup>*"
               proof -
                 have "Maps.REP R\<^sub>0 \<cong> r.s\<^sub>0"
                   unfolding R\<^sub>0_def
                   using Maps.REP_CLS r.leg0_is_map composable by force
                 thus ?thesis
                   using 1 adjoint_pair_preserved_by_iso isomorphic_def
                         REP_R\<^sub>0.triangle_in_hom(4) REP_R\<^sub>0.triangle_right'
                   by auto
               qed
               ultimately show ?thesis
                 using r.leg0_is_map left_adjoint_determines_right_up_to_iso
                       left_adjoint_extends_to_adjoint_pair
                 by auto
             qed
             moreover have "Maps.REP S\<^sub>1 \<cong> s.s\<^sub>1"
               unfolding S\<^sub>1_def
               using Maps.REP_CLS s.leg1_is_map composable by force
             moreover have "\<exists>a. a \<cong> (tab\<^sub>0 r)\<^sup>* \<star> tab\<^sub>1 s \<and> (Maps.REP R\<^sub>0)\<^sup>* \<star> Maps.REP S\<^sub>1 \<cong> a"
               using calculation composable isomorphic_implies_hpar(3)
                     hcomp_ide_isomorphic hcomp_isomorphic_ide [of "(Maps.REP R\<^sub>0)\<^sup>*" "r.s\<^sub>0\<^sup>*" s.s\<^sub>1]
               by auto
             ultimately show ?thesis
               using isomorphic_transitive by blast
           qed
           thus ?thesis
             using r\<^sub>0's\<^sub>1.isomorphic_implies_same_tab isomorphic_symmetric by metis
         qed
         also have "... = src \<rho>\<sigma>.tab"
           using VV.ide_char VV.arr_char composable Span.hcomp_def \<rho>\<sigma>.tab_simps(2) by auto
         finally show ?thesis by simp
       qed
       ultimately show ?thesis
         using composable Maps.arr_char Maps.dom_char SPN_r_SPN_s.dom.apex_def
         apply auto
         by (metis (no_types, lifting) Maps.not_arr_null SPN_r_SPN_s.chine_eq_apex
             SPN_r_SPN_s.chine_simps(1))
     qed
 
     text \<open>
       We will be taking the arrow @{term "CLS cmp"} of \<open>Maps\<close> as the composition isomorphism from
       @{term "SPN r \<circ> SPN s"} to @{term "SPN (r \<star> s)"}.  The following result shows that it
       has the right domain and codomain for that purpose.
     \<close>
 
     lemma iso_class_cmp_in_hom:
     shows "Maps.in_hom (Maps.MkArr (src \<rho>\<sigma>.tab) (src tab) \<lbrakk>cmp\<rbrakk>)
                        SPN_r_SPN_s.apex SPN_rs.apex"
     and "Maps.in_hom \<lbrakk>\<lbrakk>cmp\<rbrakk>\<rbrakk> SPN_r_SPN_s.apex SPN_rs.apex"
     proof -
       show "Maps.in_hom (Maps.MkArr (src \<rho>\<sigma>.tab) (src tab) \<lbrakk>cmp\<rbrakk>)
                         SPN_r_SPN_s.apex SPN_rs.apex"
       proof -
         have "obj (src \<rho>\<sigma>.tab)"
           using obj_src \<rho>\<sigma>.tab_in_hom by blast
         moreover have "obj (src tab)"
           using obj_src by simp
         moreover have "\<lbrakk>cmp\<rbrakk> \<in> Maps.Hom (src \<rho>\<sigma>.tab) (src tab)"
           by (metis (mono_tags, lifting) cmp.is_map cmp_def cmp_props(1) mem_Collect_eq)
         moreover have "SPN_r_SPN_s.apex = Maps.MkIde (src \<rho>\<sigma>.tab)"
           using SPN_r_SPN_s_apex_eq by simp
         moreover have "SPN_rs.apex = Maps.MkIde (src tab)"
           using SPN_def composable SPN_rs.cod.apex_def Maps.arr_char Maps.dom_char
                 SPN_rs.dom.leg_simps(1)
           by fastforce
         ultimately show ?thesis
           using Maps.MkArr_in_hom by simp
       qed
       thus "Maps.in_hom \<lbrakk>\<lbrakk>cmp\<rbrakk>\<rbrakk> SPN_r_SPN_s.apex SPN_rs.apex" by simp
     qed
 
     interpretation r\<^sub>0's\<^sub>1: two_composable_identities_in_bicategory_of_spans
                             V H \<a> \<i> src trg \<open>(Maps.REP R\<^sub>0)\<^sup>*\<close> \<open>Maps.REP S\<^sub>1\<close>
     proof
       show "ide (Maps.REP S\<^sub>1)"
         using Maps.REP_in_Map Maps.arr_char left_adjoint_is_ide
         by (meson Maps.REP_in_hhom(2) S\<^sub>1_in_hom)
       show "ide (Maps.REP R\<^sub>0)\<^sup>*"
         using Maps.REP_in_Map Maps.arr_char left_adjoint_is_ide
               Maps.REP_in_hhom(2) R\<^sub>0_in_hom by auto
       show "src (Maps.REP R\<^sub>0)\<^sup>* = trg (Maps.REP S\<^sub>1)"
         using Maps.REP_in_hhom(2) R\<^sub>0_in_hom composable by auto
     qed
 
     interpretation R\<^sub>0'S\<^sub>1: identity_in_bicategory_of_spans V H \<a> \<i> src trg \<open>(tab\<^sub>0 r)\<^sup>* \<star> tab\<^sub>1 s\<close>
       by (unfold_locales, simp add: composable)
 
     lemma prj_tab_agreement:
     shows "(tab\<^sub>0 r)\<^sup>* \<star> tab\<^sub>1 s \<cong> (Maps.REP R\<^sub>0)\<^sup>* \<star> Maps.REP S\<^sub>1"
     and "\<rho>\<sigma>.p\<^sub>0 \<cong> prj\<^sub>0 (Maps.REP S\<^sub>1) (Maps.REP R\<^sub>0)"
     and "\<rho>\<sigma>.p\<^sub>1 \<cong> prj\<^sub>1 (Maps.REP S\<^sub>1) (Maps.REP R\<^sub>0)"
     proof -
       show 1: "(tab\<^sub>0 r)\<^sup>* \<star> tab\<^sub>1 s \<cong> (Maps.REP R\<^sub>0)\<^sup>* \<star> Maps.REP S\<^sub>1"
       proof -
         have "(tab\<^sub>0 r)\<^sup>* \<cong> (Maps.REP R\<^sub>0)\<^sup>*"
           using Maps.REP_CLS isomorphic_symmetric R\<^sub>0_def composable r.satisfies_T0
                 isomorphic_to_left_adjoint_implies_isomorphic_right_adjoint
           by fastforce
         moreover have "tab\<^sub>1 s \<cong> Maps.REP S\<^sub>1"
           by (metis Maps.REP_CLS isomorphic_symmetric S\<^sub>1_def s.leg1_is_map s.leg1_simps(3-4))
         moreover have "src (Maps.REP R\<^sub>0)\<^sup>* = trg (tab\<^sub>1 s)"
           using composable r.T0.antipar right_adjoint_simps(2) by fastforce
         ultimately show ?thesis
           using hcomp_isomorphic_ide [of "(tab\<^sub>0 r)\<^sup>*" "(Maps.REP R\<^sub>0)\<^sup>*" "tab\<^sub>1 s"]
                 hcomp_ide_isomorphic isomorphic_transitive composable
           by auto
       qed
       show "\<rho>\<sigma>.p\<^sub>0 \<cong> tab\<^sub>0 ((Maps.REP R\<^sub>0)\<^sup>* \<star> Maps.REP S\<^sub>1)"
         using 1 R\<^sub>0'S\<^sub>1.isomorphic_implies_same_tab isomorphic_reflexive by auto
       show "\<rho>\<sigma>.p\<^sub>1 \<cong> tab\<^sub>1 ((Maps.REP R\<^sub>0)\<^sup>* \<star> Maps.REP S\<^sub>1)"
         using 1 R\<^sub>0'S\<^sub>1.isomorphic_implies_same_tab isomorphic_reflexive by auto
     qed
 
     lemma chine_hcomp_SPN_SPN:
     shows "Span.chine_hcomp (SPN r) (SPN s) = Maps.MkIde (src \<rho>\<sigma>.p\<^sub>0)"
     proof -
       have "Span.chine_hcomp (SPN r) (SPN s) =
             Maps.MkIde (src (tab\<^sub>0 ((Maps.REP R\<^sub>0)\<^sup>* \<star> Maps.REP S\<^sub>1)))"
         using Span.chine_hcomp_ide_ide [of "SPN r" "SPN s"] composable
               Maps.pbdom_def Maps.PRJ\<^sub>0_def Maps.CLS_in_hom Maps.dom_char R\<^sub>0_def S\<^sub>1_def
         apply simp
         using Maps.prj0_simps(1) RS_simps(1) RS_simps(16) RS_simps(18) RS_simps(3)
         by presburger
       also have "... = Maps.MkIde (src \<rho>\<sigma>.p\<^sub>0)"
         using prj_tab_agreement isomorphic_implies_hpar(3) by force
       finally show ?thesis by simp
     qed
 
   end
 
   text \<open>
     The development above focused on two specific composable 1-cells in bicategory \<open>B\<close>.
     Here we reformulate those results as statements about the entire bicategory.
   \<close>
 
   context bicategory_of_spans
   begin
 
     interpretation Maps: maps_category V H \<a> \<i> src trg ..
     interpretation Span: span_bicategory Maps.comp Maps.PRJ\<^sub>0 Maps.PRJ\<^sub>1 ..
 
     no_notation Fun.comp (infixl "\<circ>" 55)
     notation Span.vcomp (infixr "\<bullet>" 55)
     notation Span.hcomp (infixr "\<circ>" 53)
     notation Maps.comp (infixr "\<odot>" 55)
     notation isomorphic (infix "\<cong>" 50)
 
     interpretation SPN: "functor" V Span.vcomp SPN
       using SPN_is_functor by simp
     interpretation SPN: weak_arrow_of_homs V src trg Span.vcomp Span.src Span.trg SPN
       using SPN_is_weak_arrow_of_homs by simp
 
     interpretation SPN_SPN: "functor" VV.comp Span.VV.comp SPN.FF
       using SPN.functor_FF by auto
     interpretation HoSPN_SPN: composite_functor VV.comp Span.VV.comp Span.vcomp
                                 SPN.FF \<open>\<lambda>\<mu>\<nu>. fst \<mu>\<nu> \<circ> snd \<mu>\<nu>\<close>
       ..
     interpretation SPNoH: composite_functor VV.comp V
                             Span.vcomp \<open>\<lambda>\<mu>\<nu>. fst \<mu>\<nu> \<star> snd \<mu>\<nu>\<close> SPN
       ..
 
     text \<open>
       Given arbitrary composable 1-cells \<open>r\<close> and \<open>s\<close>, obtain an arrow of spans in \<open>Maps\<close>
       having the isomorphism class of \<open>rs.cmp\<close> as its chine.
     \<close>
 
     definition CMP
     where "CMP r s \<equiv>
            \<lparr>Chn = \<lbrakk>\<lbrakk>two_composable_identities_in_bicategory_of_spans.cmp V H \<a> \<i> src trg r s\<rbrakk>\<rbrakk>,
             Dom = Dom (SPN r \<circ> SPN s), Cod = Dom (SPN (r \<star> s))\<rparr>"
 
     lemma compositor_in_hom [intro]:
     assumes "ide r" and "ide s" and "src r = trg s"
     shows "Span.in_hhom (CMP r s) (SPN.map\<^sub>0 (src s)) (SPN.map\<^sub>0 (trg r))"
     and "Span.in_hom (CMP r s) (HoSPN_SPN.map (r, s)) (SPNoH.map (r, s))"
     proof -
       have rs: "VV.ide (r, s)"
         using assms VV.ide_char VV.arr_char by simp
       interpret rs: two_composable_identities_in_bicategory_of_spans V H \<a> \<i> src trg r s
         using rs VV.ide_char VV.arr_char apply unfold_locales by auto
       interpret cmp: arrow_of_tabulations_in_maps V H \<a> \<i> src trg
                      \<open>r \<star> s\<close> rs.\<rho>\<sigma>.tab \<open>tab\<^sub>0 s \<star> rs.\<rho>\<sigma>.p\<^sub>0\<close> \<open>tab\<^sub>1 r \<star> rs.\<rho>\<sigma>.p\<^sub>1\<close>
                      \<open>r \<star> s\<close> rs.tab \<open>tab\<^sub>0 (r \<star> s)\<close> \<open>tab\<^sub>1 (r \<star> s)\<close>
                      \<open>r \<star> s\<close>
         by unfold_locales auto
       have "rs.cmp = cmp.chine"
         using rs.cmp_def by simp
 
       interpret SPN_r_SPN_s: arrow_of_spans Maps.comp \<open>SPN r \<circ> SPN s\<close>
         using rs.composable Span.ide_char [of "SPN r \<circ> SPN s"] by simp
       interpret SPN_r_SPN_s: identity_arrow_of_spans Maps.comp \<open>SPN r \<circ> SPN s\<close>
         using rs.composable Span.ide_char [of "SPN r \<circ> SPN s"]
         by (unfold_locales, simp)
       interpret SPN_rs: arrow_of_spans Maps.comp \<open>SPN (r \<star> s)\<close>
         using Span.arr_char rs.is_ide SPN.preserves_arr by blast
       interpret SPN_rs: identity_arrow_of_spans Maps.comp \<open>SPN (r \<star> s)\<close>
         using Span.ide_char rs.is_ide SPN.preserves_ide
         by (unfold_locales, simp)
 
       interpret Dom: span_in_category Maps.comp \<open>Dom (CMP r s)\<close>
         by (unfold_locales, simp add: CMP_def)
       interpret Cod: span_in_category Maps.comp \<open>Cod (CMP r s)\<close>
       proof -
         (* TODO: I don't understand what makes this so difficult. *)
         have "\<guillemotleft>tab\<^sub>0 (r \<star> s) : src (tab\<^sub>0 (r \<star> s)) \<rightarrow> src s\<guillemotright> \<and> is_left_adjoint (tab\<^sub>0 (r \<star> s)) \<and>
               \<lbrakk>tab\<^sub>0 (r \<star> s)\<rbrakk> = \<lbrakk>tab\<^sub>0 (r \<star> s)\<rbrakk>"
           by simp
         hence "\<exists>f. \<guillemotleft>f : src (tab\<^sub>0 (r \<star> s)) \<rightarrow> src s\<guillemotright> \<and> is_left_adjoint f \<and> \<lbrakk>tab\<^sub>0 (r \<star> s)\<rbrakk> = \<lbrakk>f\<rbrakk>"
           by blast
         moreover have "\<exists>f. \<guillemotleft>f : src (tab\<^sub>0 (r \<star> s)) \<rightarrow> trg r\<guillemotright> \<and> is_left_adjoint f \<and>
                            \<lbrakk>tab\<^sub>1 (r \<star> s)\<rbrakk> = \<lbrakk>f\<rbrakk>"
           by (metis rs.base_simps(2) rs.leg1_in_hom(1) rs.leg1_is_map trg_hcomp)
         ultimately show "span_in_category Maps.comp (Cod (CMP r s))"
           using assms Maps.arr_char Maps.dom_char CMP_def
           by unfold_locales auto
       qed
 
       interpret r\<^sub>0's\<^sub>1: two_composable_identities_in_bicategory_of_spans
                          V H \<a> \<i> src trg \<open>(Maps.REP rs.R\<^sub>0)\<^sup>*\<close> \<open>Maps.REP rs.S\<^sub>1\<close>
       proof
         show "ide (Maps.REP rs.S\<^sub>1)"
           using Maps.REP_in_Map Maps.arr_char left_adjoint_is_ide
           by (meson Maps.REP_in_hhom(2) rs.S\<^sub>1_in_hom)
         show "ide (Maps.REP rs.R\<^sub>0)\<^sup>*"
           using Maps.REP_in_Map Maps.arr_char left_adjoint_is_ide
                 Maps.REP_in_hhom(2) rs.R\<^sub>0_in_hom by auto
         show "src (Maps.REP rs.R\<^sub>0)\<^sup>* = trg (Maps.REP rs.S\<^sub>1)"
           using Maps.REP_in_hhom(2) rs.R\<^sub>0_in_hom rs.composable by auto
       qed
 
       interpret R\<^sub>0'S\<^sub>1: identity_in_bicategory_of_spans V H \<a> \<i> src trg \<open>(tab\<^sub>0 r)\<^sup>* \<star> tab\<^sub>1 s\<close>
         by (unfold_locales, simp add: rs.composable)
 
       text \<open>
         Here we obtain explicit formulas for the legs and apex of \<open>SPN_r_SPN_s\<close> and \<open>SPN_rs\<close>.
       \<close>
 
       have SPN_r_SPN_s_leg0_eq:
              "SPN_r_SPN_s.leg0 = Maps.comp rs.S\<^sub>0 (Maps.PRJ\<^sub>0 rs.R\<^sub>0 rs.S\<^sub>1)"
         using rs.composable Span.hcomp_def rs.S\<^sub>0_def rs.R\<^sub>0_def rs.S\<^sub>1_def by simp
       have SPN_r_SPN_s_leg1_eq:
              "SPN_r_SPN_s.leg1 = Maps.comp rs.R\<^sub>1 (Maps.PRJ\<^sub>1 rs.R\<^sub>0 rs.S\<^sub>1)"
         using rs.composable Span.hcomp_def rs.R\<^sub>1_def rs.R\<^sub>0_def rs.S\<^sub>1_def by simp
       have "SPN_r_SPN_s.apex = Maps.MkIde (src rs.\<rho>\<sigma>.tab)"
         using rs.SPN_r_SPN_s_apex_eq by auto
 
       have SPN_rs_leg0_eq: "SPN_rs.leg0 = \<lbrakk>\<lbrakk>tab\<^sub>0 (r \<star> s)\<rbrakk>\<rbrakk>"
         unfolding SPN_def using rs by simp
       have SPN_rs_leg1_eq: "SPN_rs.leg1 = \<lbrakk>\<lbrakk>tab\<^sub>1 (r \<star> s)\<rbrakk>\<rbrakk>"
         unfolding SPN_def using rs by simp
       have "SPN_rs.apex = Maps.MkIde (src (tab_of_ide (r \<star> s)))"
         using SPN_rs.dom.apex_def Maps.dom_char SPN_rs_leg0_eq SPN_rs.dom.leg_simps(1)
         by simp
 
       text \<open>
         The composition isomorphism @{term "CMP r s"} is an arrow of spans in \<open>Maps(B)\<close>.
       \<close>
 
       interpret arrow_of_spans Maps.comp \<open>CMP r s\<close>
       proof
         show 1: "Maps.in_hom (Chn (CMP r s)) Dom.apex Cod.apex"
           using rs.iso_class_cmp_in_hom rs.composable CMP_def by simp
         show "Cod.leg0 \<odot> Chn (CMP r s) = Dom.leg0"
         proof (intro Maps.arr_eqI)
           show 2: "Maps.seq Cod.leg0 (Chn (CMP r s))"
             using 1 Maps.dom_char Maps.cod_char by blast
           show 3: "Maps.arr Dom.leg0" by simp
           show "Maps.Dom (Cod.leg0 \<odot> Chn (CMP r s)) = Maps.Dom Dom.leg0"
             using 1 2 Maps.dom_char Maps.cod_char Maps.comp_char
                   Dom.leg_in_hom Maps.in_hom_char Maps.seq_char
             by auto
           show "Maps.Cod (Cod.leg0 \<odot> Chn (CMP r s)) = Maps.Cod Dom.leg0"
             using 2 3 Maps.comp_char [of Cod.leg0 "Chn (CMP r s)"]
                   Dom.leg_simps Dom.apex_def Maps.dom_char SPN_r_SPN_s_leg0_eq
                   Maps.comp_char [of rs.S\<^sub>0 "Maps.PRJ\<^sub>0 rs.R\<^sub>0 rs.S\<^sub>1"] CMP_def
             by simp
           show "Maps.Map (Cod.leg0 \<odot> Chn (CMP r s)) = Maps.Map Dom.leg0"
           proof -
             have "Maps.Map (Cod.leg0 \<odot> Chn (CMP r s)) = Maps.Comp \<lbrakk>tab\<^sub>0 (r \<star> s)\<rbrakk> \<lbrakk>rs.cmp\<rbrakk>"
               using 1 2 Maps.dom_char Maps.cod_char
                     Maps.comp_char [of Cod.leg0 "Chn (CMP r s)"] CMP_def
               by simp
             also have "... = Maps.Comp \<lbrakk>tab\<^sub>0 s\<rbrakk> \<lbrakk>rs.\<rho>\<sigma>.p\<^sub>0\<rbrakk>"
             proof -
               have "Maps.Comp \<lbrakk>tab\<^sub>0 (r \<star> s)\<rbrakk> \<lbrakk>rs.cmp\<rbrakk> = \<lbrakk>tab\<^sub>0 (r \<star> s) \<star> rs.cmp\<rbrakk>"
                 using Maps.Comp_eq_iso_class_memb Maps.CLS_hcomp cmp.is_map rs.cmp_def
                 by auto
               also have "... = Maps.Comp \<lbrakk>tab\<^sub>0 s\<rbrakk> \<lbrakk>rs.\<rho>\<sigma>.p\<^sub>0\<rbrakk>"
                 using Maps.Comp_eq_iso_class_memb Maps.CLS_hcomp iso_class_eqI rs.cmp_props(4)
                 by auto
               finally show ?thesis by simp
             qed
             also have "... = Maps.Map Dom.leg0"
             proof -
               have "Maps.seq rs.S\<^sub>0 (Maps.PRJ\<^sub>0 rs.R\<^sub>0 rs.S\<^sub>1)"
                 by (intro Maps.seqI, simp_all add: rs.composable)
               moreover have "\<lbrakk>prj\<^sub>0 (Maps.REP rs.S\<^sub>1) (Maps.REP rs.R\<^sub>0)\<rbrakk> = \<lbrakk>rs.\<rho>\<sigma>.p\<^sub>0\<rbrakk>"
                 using "rs.prj_tab_agreement" iso_class_eqI by auto
               moreover have "Maps.Dom (Maps.PRJ\<^sub>0 rs.R\<^sub>0 rs.S\<^sub>1) = src rs.\<rho>\<sigma>.p\<^sub>0"
                 using rs.prj_tab_agreement Maps.PRJ\<^sub>0_def rs.composable
                       isomorphic_implies_hpar(3)
                 by auto
               ultimately show ?thesis
                 using SPN_r_SPN_s_leg0_eq Maps.comp_char [of rs.S\<^sub>0 "Maps.PRJ\<^sub>0 rs.R\<^sub>0 rs.S\<^sub>1"]
                       rs.S\<^sub>0_def Maps.PRJ\<^sub>0_def rs.composable CMP_def
                 by simp
             qed
             finally show ?thesis by simp
           qed
         qed
         show "Cod.leg1 \<odot> Chn (CMP r s) = Dom.leg1"
         proof (intro Maps.arr_eqI)
           show 2: "Maps.seq Cod.leg1 (Chn (CMP r s))"
             using 1 Maps.dom_char Maps.cod_char by blast
           show 3: "Maps.arr Dom.leg1" by simp
           show "Maps.Dom (Cod.leg1 \<odot> Chn (CMP r s)) = Maps.Dom Dom.leg1"
             using 1 2 Maps.dom_char Maps.cod_char Maps.comp_char
                   Dom.leg_in_hom Maps.in_hom_char Maps.seq_char
             by auto
           show "Maps.Cod (Cod.leg1 \<odot> Chn (CMP r s)) = Maps.Cod Dom.leg1"
             using 2 3 Maps.comp_char [of Cod.leg1 "Chn (CMP r s)"]
                   Dom.apex_def Maps.dom_char SPN_r_SPN_s_leg1_eq
                   Maps.comp_char [of rs.R\<^sub>1 "Maps.PRJ\<^sub>1 rs.R\<^sub>0 rs.S\<^sub>1"] CMP_def
             by simp
           show "Maps.Map (Cod.leg1 \<odot> Chn (CMP r s)) = Maps.Map Dom.leg1"
           proof -
             have "Maps.Map (Cod.leg1 \<odot> Chn (CMP r s)) = Maps.Comp \<lbrakk>tab\<^sub>1 (r \<star> s)\<rbrakk> \<lbrakk>rs.cmp\<rbrakk>"
               using 1 2 Maps.dom_char Maps.cod_char
                     Maps.comp_char [of Cod.leg1 "Chn (CMP r s)"] CMP_def
               by simp
             also have "... = Maps.Comp \<lbrakk>tab\<^sub>1 r\<rbrakk> \<lbrakk>rs.\<rho>\<sigma>.p\<^sub>1\<rbrakk>"
             proof -
               have "Maps.Comp \<lbrakk>tab\<^sub>1 (r \<star> s)\<rbrakk> \<lbrakk>rs.cmp\<rbrakk> = \<lbrakk>tab\<^sub>1 (r \<star> s) \<star> rs.cmp\<rbrakk>"
                 using Maps.Comp_eq_iso_class_memb Maps.CLS_hcomp cmp.is_map rs.cmp_def
                 by auto
               also have "... = Maps.Comp \<lbrakk>tab\<^sub>1 r\<rbrakk> \<lbrakk>rs.\<rho>\<sigma>.p\<^sub>1\<rbrakk>"
                 using Maps.Comp_eq_iso_class_memb
                       Maps.CLS_hcomp [of "tab\<^sub>1 r" rs.\<rho>\<sigma>.p\<^sub>1] iso_class_eqI rs.cmp_props(5)
                 by auto
               finally show ?thesis by simp
             qed
             also have "... = Maps.Map Dom.leg1"
             proof -
               have "Maps.seq rs.R\<^sub>1 (Maps.PRJ\<^sub>1 rs.R\<^sub>0 rs.S\<^sub>1)"
                 by (intro Maps.seqI, simp_all add: rs.composable)
               moreover have "\<lbrakk>prj\<^sub>1 (Maps.REP rs.S\<^sub>1) (Maps.REP rs.R\<^sub>0)\<rbrakk> = \<lbrakk>rs.\<rho>\<sigma>.p\<^sub>1\<rbrakk>"
                 using rs.prj_tab_agreement iso_class_eqI by auto
               moreover have "Maps.Dom (Maps.PRJ\<^sub>1 rs.R\<^sub>0 rs.S\<^sub>1) = src rs.\<rho>\<sigma>.p\<^sub>1"
                 using rs.prj_tab_agreement Maps.PRJ\<^sub>1_def rs.composable
                       isomorphic_implies_hpar(3)
                 by auto
               ultimately show ?thesis
                 using SPN_r_SPN_s_leg1_eq Maps.comp_char [of rs.R\<^sub>1 "Maps.PRJ\<^sub>1 rs.R\<^sub>0 rs.S\<^sub>1"]
                       rs.R\<^sub>1_def Maps.PRJ\<^sub>1_def rs.composable CMP_def
                 by simp
             qed
             finally show ?thesis by simp
             (*
              * Very simple, right?  Yeah, once you sort through the notational morass and
              * figure out what equals what.
              *)
           qed
         qed
       qed
       show "Span.in_hom (CMP r s) (HoSPN_SPN.map (r, s)) (SPNoH.map (r, s))"
           using Span.arr_char arrow_of_spans_axioms Span.dom_char Span.cod_char
                 CMP_def SPN.FF_def VV.arr_char rs.composable
           by auto
       thus "Span.in_hhom (CMP r s) (SPN.map\<^sub>0 (src s)) (SPN.map\<^sub>0 (trg r))"
         using assms VV.ide_char VV.arr_char VV.in_hom_char SPN.FF_def
               Span.src_dom [of "CMP r s"] Span.trg_dom [of "CMP r s"]
         by fastforce
     qed
 
     lemma compositor_simps [simp]:
     assumes "ide r" and "ide s" and "src r = trg s"
     shows "Span.arr (CMP r s)"
     and "Span.src (CMP r s) = SPN.map\<^sub>0 (src s)" and "Span.trg (CMP r s) = SPN.map\<^sub>0 (trg r)"
     and "Span.dom (CMP r s) = HoSPN_SPN.map (r, s)"
     and "Span.cod (CMP r s) = SPNoH.map (r, s)"
       using assms compositor_in_hom [of r s] by auto
 
     lemma compositor_is_iso:
     assumes "ide r" and "ide s" and "src r = trg s"
     shows "Span.iso (CMP r s)"
     proof -
       interpret rs: two_composable_identities_in_bicategory_of_spans V H \<a> \<i> src trg r s
         using assms by unfold_locales auto
       have "Span.arr (CMP r s)"
         using assms compositor_in_hom by blast
       moreover have "Maps.iso \<lbrakk>\<lbrakk>rs.cmp\<rbrakk>\<rbrakk>"
         using assms Maps.iso_char'
         by (metis (mono_tags, lifting) Maps.CLS_in_hom Maps.Map.simps(1) Maps.in_homE
             equivalence_is_left_adjoint ide_in_iso_class rs.cmp_props(3) rs.cmp_simps(2))
       ultimately show ?thesis
         unfolding CMP_def
         using assms Span.iso_char by simp
     qed
 
     interpretation \<Xi>: transformation_by_components VV.comp Span.vcomp
                         HoSPN_SPN.map SPNoH.map \<open>\<lambda>rs. CMP (fst rs) (snd rs)\<close>
     proof
       fix rs
       assume rs: "VV.ide rs"
       let ?r = "fst rs"
       let ?s = "snd rs"
       show "Span.in_hom (CMP ?r ?s) (HoSPN_SPN.map rs) (SPNoH.map rs)"
         using rs compositor_in_hom [of ?r ?s] VV.ide_char VV.arr_char by simp
       next
       fix \<mu>\<nu>
       assume \<mu>\<nu>: "VV.arr \<mu>\<nu>"
       let ?\<mu> = "fst \<mu>\<nu>"
       let ?\<nu> = "snd \<mu>\<nu>"
       show "CMP (fst (VV.cod \<mu>\<nu>)) (snd (VV.cod \<mu>\<nu>)) \<bullet> HoSPN_SPN.map \<mu>\<nu> =
             SPNoH.map \<mu>\<nu> \<bullet> CMP (fst (VV.dom \<mu>\<nu>)) (snd (VV.dom \<mu>\<nu>))"
       proof -
         let ?LHS = "CMP (fst (VV.cod \<mu>\<nu>)) (snd (VV.cod \<mu>\<nu>)) \<bullet> HoSPN_SPN.map \<mu>\<nu>"
         let ?RHS = "SPNoH.map \<mu>\<nu> \<bullet> CMP (fst (VV.dom \<mu>\<nu>)) (snd (VV.dom \<mu>\<nu>))"
         have LHS:
           "Span.in_hom ?LHS (HoSPN_SPN.map (VV.dom \<mu>\<nu>)) (SPNoH.map (VV.cod \<mu>\<nu>))"
         proof
           show "Span.in_hom (HoSPN_SPN.map \<mu>\<nu>) (HoSPN_SPN.map (VV.dom \<mu>\<nu>))
                             (HoSPN_SPN.map (VV.cod \<mu>\<nu>))"
             using \<mu>\<nu> by blast
           show "Span.in_hom (CMP (fst (VV.cod \<mu>\<nu>)) (snd (VV.cod \<mu>\<nu>)))
                             (HoSPN_SPN.map (VV.cod \<mu>\<nu>)) (SPNoH.map (VV.cod \<mu>\<nu>))"
             using \<mu>\<nu> by (auto simp add: VV.arr_char)
         qed
         have RHS:
           "Span.in_hom ?RHS (HoSPN_SPN.map (VV.dom \<mu>\<nu>)) (SPNoH.map (VV.cod \<mu>\<nu>))"
           using \<mu>\<nu> by (auto simp add: VV.arr_char)
         show "?LHS = ?RHS"
         proof (intro Span.arr_eqI)
           show "Span.par ?LHS ?RHS"
             apply (intro conjI)
             using LHS RHS apply auto[2]
           proof -
             show "Span.dom ?LHS = Span.dom ?RHS"
             proof -
               have "Span.dom ?LHS = HoSPN_SPN.map (VV.dom \<mu>\<nu>)"
                 using LHS by auto
               also have "... = Span.dom ?RHS"
                 using RHS by auto
               finally show ?thesis by simp
             qed
             show "Span.cod ?LHS = Span.cod ?RHS"
             proof -
               have "Span.cod ?LHS = SPNoH.map (VV.cod \<mu>\<nu>)"
                 using LHS by auto
               also have "... = Span.cod ?RHS"
                 using RHS by auto
               finally show ?thesis by simp
             qed
           qed
           show "Chn ?LHS = Chn ?RHS"
           proof -
             interpret dom_\<mu>_\<nu>: two_composable_identities_in_bicategory_of_spans V H \<a> \<i> src trg
                                  \<open>dom ?\<mu>\<close> \<open>dom ?\<nu>\<close>
               using \<mu>\<nu> VV.ide_char VV.arr_char by unfold_locales auto
             interpret cod_\<mu>_\<nu>: two_composable_identities_in_bicategory_of_spans V H \<a> \<i> src trg
                                  \<open>cod ?\<mu>\<close> \<open>cod ?\<nu>\<close>
               using \<mu>\<nu> VV.ide_char VV.arr_char by unfold_locales auto
             interpret \<mu>_\<nu>: horizontal_composite_of_arrows_of_tabulations_in_maps
                              V H \<a> \<i> src trg
                              \<open>dom ?\<mu>\<close> \<open>tab_of_ide (dom ?\<mu>)\<close> \<open>tab\<^sub>0 (dom ?\<mu>)\<close> \<open>tab\<^sub>1 (dom ?\<mu>)\<close>
                              \<open>dom ?\<nu>\<close> \<open>tab_of_ide (dom ?\<nu>)\<close> \<open>tab\<^sub>0 (dom ?\<nu>)\<close> \<open>tab\<^sub>1 (dom ?\<nu>)\<close>
                              \<open>cod ?\<mu>\<close> \<open>tab_of_ide (cod ?\<mu>)\<close> \<open>tab\<^sub>0 (cod ?\<mu>)\<close> \<open>tab\<^sub>1 (cod ?\<mu>)\<close>
                              \<open>cod ?\<nu>\<close> \<open>tab_of_ide (cod ?\<nu>)\<close> \<open>tab\<^sub>0 (cod ?\<nu>)\<close> \<open>tab\<^sub>1 (cod ?\<nu>)\<close>
                              ?\<mu> ?\<nu>
               using \<mu>\<nu> VV.arr_char by unfold_locales auto
 
             let ?\<mu>\<nu> = "?\<mu> \<star> ?\<nu>"
             interpret dom_\<mu>\<nu>: identity_in_bicategory_of_spans V H \<a> \<i> src trg \<open>dom ?\<mu>\<nu>\<close>
               using \<mu>\<nu> by (unfold_locales, simp)
             interpret cod_\<mu>\<nu>: identity_in_bicategory_of_spans V H \<a> \<i> src trg \<open>cod ?\<mu>\<nu>\<close>
               using \<mu>\<nu> by (unfold_locales, simp)
             interpret \<mu>\<nu>: arrow_of_tabulations_in_maps V H \<a> \<i> src trg
                             \<open>dom ?\<mu>\<nu>\<close> \<open>tab_of_ide (dom ?\<mu>\<nu>)\<close> \<open>tab\<^sub>0 (dom ?\<mu>\<nu>)\<close> \<open>tab\<^sub>1 (dom ?\<mu>\<nu>)\<close>
                             \<open>cod ?\<mu>\<nu>\<close> \<open>tab_of_ide (cod ?\<mu>\<nu>)\<close> \<open>tab\<^sub>0 (cod ?\<mu>\<nu>)\<close> \<open>tab\<^sub>1 (cod ?\<mu>\<nu>)\<close>
                             ?\<mu>\<nu>
               using \<mu>\<nu> by unfold_locales auto
 
             have Chn_LHS_eq:
               "Chn ?LHS = \<lbrakk>\<lbrakk>cod_\<mu>_\<nu>.cmp\<rbrakk>\<rbrakk> \<odot> Span.chine_hcomp (SPN (fst \<mu>\<nu>)) (SPN (snd \<mu>\<nu>))"
             proof -
               have "Chn ?LHS = Chn (CMP (fst (VV.cod \<mu>\<nu>)) (snd (VV.cod \<mu>\<nu>))) \<odot>
                                  Chn (HoSPN_SPN.map \<mu>\<nu>)"
                 using \<mu>\<nu> LHS Span.Chn_vcomp by blast
               also have "... = \<lbrakk>\<lbrakk>cod_\<mu>_\<nu>.cmp\<rbrakk>\<rbrakk> \<odot> Chn (HoSPN_SPN.map \<mu>\<nu>)"
                 using \<mu>\<nu> VV.arr_char VV.cod_char CMP_def by simp
               also have "... = \<lbrakk>\<lbrakk>cod_\<mu>_\<nu>.cmp\<rbrakk>\<rbrakk> \<odot>
                                  Span.chine_hcomp (SPN (fst \<mu>\<nu>)) (SPN (snd \<mu>\<nu>))"
                 using \<mu>\<nu> VV.arr_char SPN.FF_def Span.hcomp_def by simp
               finally show ?thesis by blast
             qed
             have Chn_RHS_eq:
                "Chn ?RHS = Maps.MkArr (src (tab\<^sub>0 (dom ?\<mu> \<star> dom ?\<nu>))) (src (tab\<^sub>0 (cod ?\<mu> \<star> cod ?\<nu>)))
                                       \<lbrakk>\<mu>\<nu>.chine\<rbrakk> \<odot>
                            Maps.MkArr (src dom_\<mu>_\<nu>.\<rho>\<sigma>.p\<^sub>0) (src (tab_of_ide (dom ?\<mu> \<star> dom ?\<nu>)))
                                       \<lbrakk>dom_\<mu>_\<nu>.cmp\<rbrakk>"
             proof -
               have "Chn ?RHS = Chn (SPN (?\<mu> \<star> ?\<nu>)) \<odot>
                                Maps.MkArr (src dom_\<mu>_\<nu>.\<rho>\<sigma>.p\<^sub>0) (src (tab_of_ide (dom ?\<mu> \<star> dom ?\<nu>)))
                                           \<lbrakk>dom_\<mu>_\<nu>.cmp\<rbrakk>"
                 using \<mu>\<nu> RHS Span.vcomp_def VV.arr_char CMP_def Span.arr_char Span.not_arr_Null
                 by auto
               moreover have "Chn (SPN (?\<mu> \<star> ?\<nu>)) =
                              Maps.MkArr (src (tab\<^sub>0 (dom ?\<mu> \<star> dom ?\<nu>)))
                                         (src (tab\<^sub>0 (cod ?\<mu> \<star> cod ?\<nu>)))
                                         \<lbrakk>\<mu>\<nu>.chine\<rbrakk>"
               proof -
                 have "Chn (SPN (?\<mu> \<star> ?\<nu>)) =
                       Maps.MkArr (src (tab\<^sub>0 (dom ?\<mu> \<star> dom ?\<nu>)))
                                  (src (tab\<^sub>0 (cod ?\<mu> \<star> cod ?\<nu>)))
                                  \<lbrakk>spn ?\<mu>\<nu>\<rbrakk>"
                   using \<mu>\<nu> SPN_def by simp
                 also have "... = Maps.MkArr (src (tab\<^sub>0 (dom ?\<mu> \<star> dom ?\<nu>)))
                                             (src (tab\<^sub>0 (cod ?\<mu> \<star> cod ?\<nu>)))
                                             \<lbrakk>\<mu>\<nu>.chine\<rbrakk>"
                   using spn_def by simp
                 finally show ?thesis by simp
               qed
               ultimately show ?thesis by simp
             qed
 
             let ?Chn_LHS =
                 "Maps.MkArr (src cod_\<mu>_\<nu>.\<rho>\<sigma>.p\<^sub>0) (src (tab_of_ide (cod ?\<mu> \<star> cod ?\<nu>)))
                    \<lbrakk>cod_\<mu>_\<nu>.cmp\<rbrakk> \<odot>
                  Span.chine_hcomp (SPN ?\<mu>) (SPN ?\<nu>)"
             let ?Chn_RHS =
                 "Maps.MkArr (src (tab\<^sub>0 (dom ?\<mu> \<star> dom ?\<nu>))) (src (tab\<^sub>0 (cod ?\<mu> \<star> cod ?\<nu>)))
                    \<lbrakk>\<mu>\<nu>.chine\<rbrakk> \<odot>
                  Maps.MkArr (src dom_\<mu>_\<nu>.\<rho>\<sigma>.p\<^sub>0) (src (tab_of_ide (dom ?\<mu> \<star> dom ?\<nu>)))
                    \<lbrakk>dom_\<mu>_\<nu>.cmp\<rbrakk>"
 
             have "?Chn_LHS = ?Chn_RHS"
             proof (intro Maps.arr_eqI)
               interpret LHS: arrow_of_spans Maps.comp ?LHS
                 using LHS Span.arr_char by auto
               interpret RHS: arrow_of_spans Maps.comp ?RHS
                 using RHS Span.arr_char by auto
               show 1: "Maps.arr ?Chn_LHS"
                 using LHS.chine_in_hom Chn_LHS_eq by auto
               show 2: "Maps.arr ?Chn_RHS"
                 using RHS.chine_in_hom Chn_RHS_eq by auto
               text \<open>
                 Here is where we use \<open>dom_\<mu>_\<nu>.chine_hcomp_SPN_SPN\<close>,
                 which depends on our having chosen the ``right'' pullbacks for \<open>Maps(B)\<close>.
                 The map \<open>Chn_LHS\<close> has as its domain the apex of the
                 horizontal composite of the components of @{term "VV.dom \<mu>\<nu>"},
                 whereas \<open>Chn_RHS\<close> has as its
                 domain the apex of the chosen tabulation of \<open>r\<^sub>0\<^sup>* \<star> s\<^sub>1\<close>.
                 We need these to be equal in order for \<open>Chn_LHS\<close> and \<open>Chn_RHS\<close> to be equal.
               \<close>
               show "Maps.Dom ?Chn_LHS = Maps.Dom ?Chn_RHS"
               proof -
                 have "Maps.Dom ?Chn_LHS = Maps.Dom (Maps.dom ?Chn_LHS)"
                    using \<mu>\<nu> 1 Maps.Dom_dom by presburger
                 also have
                   "... = Maps.Dom (Span.chine_hcomp (SPN (dom ?\<mu>)) (SPN (dom ?\<nu>)))"
                 proof -
                   have "... = Maps.Dom (Maps.dom (Span.chine_hcomp (SPN ?\<mu>) (SPN ?\<nu>)))"
                     using 1 Maps.seq_char Maps.Dom_comp by auto
                   also have "... = Maps.Dom (Maps.pbdom (Leg0 (Dom (SPN ?\<mu>)))
                                                         (Leg1 (Dom (SPN ?\<nu>))))"
                     using \<mu>\<nu> VV.arr_char Span.chine_hcomp_in_hom [of "SPN ?\<nu>" "SPN ?\<mu>"]
                     by auto
                   also have "... = Maps.Dom (Maps.dom (Maps.pbdom (Leg0 (Dom (SPN ?\<mu>)))
                                                                   (Leg1 (Dom (SPN ?\<nu>)))))"
                   proof -
                     have "Maps.cospan (Leg0 (Dom (SPN (fst \<mu>\<nu>)))) (Leg1 (Dom (SPN (snd \<mu>\<nu>))))"
                       using \<mu>\<nu> VV.arr_char SPN_in_hom Span.arr_char Span.dom_char SPN_def
                             Maps.CLS_in_hom Maps.arr_char Maps.cod_char dom_\<mu>_\<nu>.composable
                             dom_\<mu>_\<nu>.RS_simps(16) dom_\<mu>_\<nu>.S\<^sub>1_def dom_\<mu>_\<nu>.RS_simps(1)
                             dom_\<mu>_\<nu>.R\<^sub>0_def Maps.pbdom_in_hom
                       by simp
                     thus ?thesis
                       using \<mu>\<nu> VV.arr_char Maps.pbdom_in_hom by simp
                   qed
                   also have "... = Maps.Dom
                                      (Maps.dom (Maps.pbdom (Leg0 (Dom (SPN (dom ?\<mu>))))
                                                            (Leg1 (Dom (SPN (dom ?\<nu>))))))"
                     using \<mu>\<nu> SPN_def VV.arr_char by simp
                   also have "... = Maps.Dom
                                      (Maps.dom (Span.chine_hcomp (SPN (dom ?\<mu>)) (SPN (dom ?\<nu>))))"
                     using \<mu>\<nu> VV.arr_char ide_dom
                     by (simp add: Span.chine_hcomp_ide_ide)
                   also have "... = Maps.Dom (Span.chine_hcomp (SPN (dom ?\<mu>)) (SPN (dom ?\<nu>)))"
                     using Maps.Dom_dom Maps.in_homE SPN.preserves_reflects_arr SPN.preserves_src
                           SPN.preserves_trg Span.chine_hcomp_in_hom dom_\<mu>_\<nu>.composable
                           dom_\<mu>_\<nu>.r.base_simps(2) dom_\<mu>_\<nu>.s.base_simps(2)
                     by (metis (no_types, lifting))
                   finally show ?thesis by simp
                 qed
                 also have "... = src dom_\<mu>_\<nu>.\<rho>\<sigma>.p\<^sub>0"
                   using "dom_\<mu>_\<nu>.chine_hcomp_SPN_SPN" by simp
                 also have "... = Maps.Dom ?Chn_RHS"
                   using 2 Maps.seq_char Maps.Dom_comp by auto
                 finally show ?thesis by simp
               qed
               show "Maps.Cod ?Chn_LHS = Maps.Cod ?Chn_RHS"
               proof -
                 have "Maps.Cod ?Chn_LHS = src (tab_of_ide (cod ?\<mu> \<star> cod ?\<nu>))"
                   using \<mu>\<nu> 1 VV.arr_char Maps.seq_char by auto
                 also have "... = src (tab\<^sub>0 (cod ?\<mu> \<star> cod ?\<nu>))"
                   using \<mu>\<nu> VV.arr_char cod_\<mu>\<nu>.tab_simps(2) by auto
                 also have "... = Maps.Cod ?Chn_RHS"
                   by (metis (no_types, lifting) "2" Maps.Cod.simps(1) Maps.Cod_comp Maps.seq_char)
                 finally show ?thesis by simp
               qed
               show "Maps.Map ?Chn_LHS = Maps.Map ?Chn_RHS"
               proof -
                 have RHS: "Maps.Map ?Chn_RHS = iso_class (\<mu>\<nu>.chine \<star> dom_\<mu>_\<nu>.cmp)"
                 proof -
                   have "Maps.Map ?Chn_RHS = Maps.Comp \<lbrakk>\<mu>\<nu>.chine\<rbrakk> \<lbrakk>dom_\<mu>_\<nu>.cmp\<rbrakk>"
                     using \<mu>\<nu> 2 VV.arr_char Maps.Map_comp
                           Maps.comp_char
                             [of "Maps.MkArr (src (tab\<^sub>0 (dom ?\<mu> \<star> dom ?\<nu>)))
                                             (src (tab\<^sub>0 (cod ?\<mu> \<star> cod ?\<nu>)))
                                             \<lbrakk>\<mu>\<nu>.chine\<rbrakk>"
                                 "Maps.MkArr (src dom_\<mu>_\<nu>.\<rho>\<sigma>.p\<^sub>0)
                                             (src (tab_of_ide (dom ?\<mu> \<star> dom ?\<nu>)))
                                             \<lbrakk>dom_\<mu>_\<nu>.cmp\<rbrakk>"]
                     by simp
                   also have "... = \<lbrakk>\<mu>\<nu>.chine \<star> dom_\<mu>_\<nu>.cmp\<rbrakk>"
                   proof -
                     have "\<lbrakk>dom_\<mu>_\<nu>.cmp\<rbrakk> \<in>
                           Maps.Hom (src dom_\<mu>_\<nu>.\<rho>\<sigma>.p\<^sub>0) (src (tab\<^sub>0 (dom ?\<mu> \<star> dom ?\<nu>)))"
                     proof -
                       have "\<lbrakk>dom_\<mu>_\<nu>.cmp\<rbrakk> \<in>
                             Maps.Hom (src dom_\<mu>_\<nu>.\<rho>\<sigma>.tab) (src (tab_of_ide (dom ?\<mu> \<star> dom ?\<nu>)))"
                         using \<mu>\<nu> VV.arr_char dom_\<mu>_\<nu>.cmp_props(1-3)
                         by (metis (mono_tags, lifting) equivalence_is_left_adjoint mem_Collect_eq)
                       thus ?thesis
                         using \<mu>\<nu> VV.arr_char dom_\<mu>\<nu>.tab_simps(2) by simp
                     qed
                     moreover have "\<lbrakk>\<mu>\<nu>.chine\<rbrakk> \<in>
                                    Maps.Hom (src (tab\<^sub>0 (dom ?\<mu> \<star> dom ?\<nu>)))
                                             (src (tab\<^sub>0 (cod ?\<mu> \<star> cod ?\<nu>)))"
                       using \<mu>\<nu> VV.arr_char \<mu>\<nu>.chine_in_hom \<mu>\<nu>.is_map by auto
                     moreover have
                       "\<mu>\<nu>.chine \<star> dom_\<mu>_\<nu>.cmp \<in> Maps.Comp \<lbrakk>\<mu>\<nu>.chine\<rbrakk> \<lbrakk>dom_\<mu>_\<nu>.cmp\<rbrakk>"
                     proof
                       show "is_iso_class \<lbrakk>dom_\<mu>_\<nu>.cmp\<rbrakk>"
                         using is_iso_classI by simp
                       show "is_iso_class \<lbrakk>\<mu>\<nu>.chine\<rbrakk>"
                         using is_iso_classI by simp
                       show "dom_\<mu>_\<nu>.cmp \<in> \<lbrakk>dom_\<mu>_\<nu>.cmp\<rbrakk>"
                         using ide_in_iso_class [of dom_\<mu>_\<nu>.cmp] by simp
                       show "\<mu>\<nu>.chine \<in> \<lbrakk>\<mu>\<nu>.chine\<rbrakk>" 
                         using ide_in_iso_class by simp
                       show "\<mu>\<nu>.chine \<star> dom_\<mu>_\<nu>.cmp \<cong> \<mu>\<nu>.chine \<star> dom_\<mu>_\<nu>.cmp"
                         using \<mu>\<nu> VV.arr_char \<mu>\<nu>.chine_simps dom_\<mu>_\<nu>.cmp_simps dom_\<mu>\<nu>.tab_simps(2)
                               isomorphic_reflexive
                         by auto
                     qed
                     ultimately show ?thesis
                       using \<mu>\<nu> dom_\<mu>_\<nu>.cmp_props \<mu>\<nu>.chine_in_hom \<mu>\<nu>.chine_is_induced_map
                             Maps.Comp_eq_iso_class_memb
                       by blast
                   qed
                   finally show ?thesis by simp
                 qed
 
                 have LHS: "Maps.Map ?Chn_LHS = \<lbrakk>cod_\<mu>_\<nu>.cmp \<star> \<mu>_\<nu>.chine\<rbrakk>"
                 proof -
                   have "Maps.Map ?Chn_LHS =
                            Maps.Comp \<lbrakk>cod_\<mu>_\<nu>.cmp\<rbrakk>
                                      (Maps.Map
                                        (Maps.tuple (Maps.CLS (spn ?\<mu> \<star> dom_\<mu>_\<nu>.\<rho>\<sigma>.p\<^sub>1))
                                                    (Maps.CLS (tab\<^sub>0 (cod ?\<mu>)))
                                                    (Maps.CLS (tab\<^sub>1 (cod ?\<nu>)))
                                                    (Maps.CLS (spn ?\<nu> \<star> dom_\<mu>_\<nu>.\<rho>\<sigma>.p\<^sub>0))))"
                   proof -
                     have "Maps.Map ?Chn_LHS =
                           Maps.Comp \<lbrakk>cod_\<mu>_\<nu>.cmp\<rbrakk>
                                     (Maps.Map (Span.chine_hcomp (SPN ?\<mu>) (SPN ?\<nu>)))"
                       using \<mu>\<nu> 1 VV.arr_char Maps.Map_comp cod_\<mu>\<nu>.tab_simps(2)
                             Maps.comp_char
                               [of "Maps.MkArr (src cod_\<mu>_\<nu>.\<rho>\<sigma>.p\<^sub>0)
                                               (src (tab_of_ide (cod ?\<mu> \<star> cod ?\<nu>)))
                                               \<lbrakk>cod_\<mu>_\<nu>.cmp\<rbrakk>"
                                   "Span.chine_hcomp (SPN ?\<mu>) (SPN ?\<nu>)"]
                       by simp
                     moreover have "Span.chine_hcomp (SPN ?\<mu>) (SPN ?\<nu>) =
                                    Maps.tuple
                                      (Maps.CLS (spn ?\<mu> \<star> dom_\<mu>_\<nu>.\<rho>\<sigma>.p\<^sub>1))
                                       (Maps.CLS (tab\<^sub>0 (cod ?\<mu>)))
                                       (Maps.CLS (tab\<^sub>1 (cod ?\<nu>)))
                                      (Maps.CLS (spn ?\<nu> \<star> dom_\<mu>_\<nu>.\<rho>\<sigma>.p\<^sub>0))"
                     proof -
                       have "Maps.PRJ\<^sub>0
                               (Maps.MkArr (src (tab\<^sub>0 (dom ?\<mu>))) (trg ?\<nu>) \<lbrakk>tab\<^sub>0 (dom ?\<mu>)\<rbrakk>)
                               (Maps.MkArr (src (tab\<^sub>0 (dom ?\<nu>))) (trg ?\<nu>) \<lbrakk>tab\<^sub>1 (dom ?\<nu>)\<rbrakk>) =
                             \<lbrakk>\<lbrakk>dom_\<mu>_\<nu>.\<rho>\<sigma>.p\<^sub>0\<rbrakk>\<rbrakk> \<and>
                             Maps.PRJ\<^sub>1
                               (Maps.MkArr (src (tab\<^sub>0 (dom ?\<mu>))) (trg ?\<nu>) \<lbrakk>tab\<^sub>0 (dom ?\<mu>)\<rbrakk>)
                               (Maps.MkArr (src (tab\<^sub>0 (dom ?\<nu>))) (trg ?\<nu>) \<lbrakk>tab\<^sub>1 (dom ?\<nu>)\<rbrakk>) =
                             \<lbrakk>\<lbrakk>dom_\<mu>_\<nu>.\<rho>\<sigma>.p\<^sub>1\<rbrakk>\<rbrakk>"
                       proof -
                         interpret X: identity_in_bicategory_of_spans V H \<a> \<i> src trg
                                        \<open>(tab\<^sub>0 (dom ?\<mu>))\<^sup>* \<star> tab\<^sub>1 (dom ?\<nu>)\<close>
                           using \<mu>\<nu> VV.arr_char
                           by (unfold_locales, simp)
                         have "Maps.PRJ\<^sub>0
                                 (Maps.MkArr (src (tab\<^sub>0 (dom ?\<mu>))) (trg ?\<nu>) \<lbrakk>tab\<^sub>0 (dom ?\<mu>)\<rbrakk>)
                                 (Maps.MkArr (src (tab\<^sub>0 (dom ?\<nu>))) (trg ?\<nu>) \<lbrakk>tab\<^sub>1 (dom ?\<nu>)\<rbrakk>) =
                               \<lbrakk>\<lbrakk>tab\<^sub>0 ((Maps.REP (Maps.MkArr (src (tab\<^sub>0 (dom ?\<mu>))) (trg (snd \<mu>\<nu>))
                                                            \<lbrakk>tab\<^sub>0 (dom ?\<mu>)\<rbrakk>))\<^sup>* \<star>
                                       Maps.REP (Maps.MkArr (src (tab\<^sub>0 (dom ?\<nu>))) (trg ?\<nu>)
                                                            \<lbrakk>tab\<^sub>1 (dom ?\<nu>)\<rbrakk>))\<rbrakk>\<rbrakk>"
                           unfolding Maps.PRJ\<^sub>0_def
                           using \<mu>\<nu> VV.arr_char dom_\<mu>_\<nu>.RS_simps(1) dom_\<mu>_\<nu>.RS_simps(16)
                                 dom_\<mu>_\<nu>.RS_simps(18) dom_\<mu>_\<nu>.RS_simps(3) dom_\<mu>_\<nu>.R\<^sub>0_def
                                 dom_\<mu>_\<nu>.S\<^sub>1_def
                           by auto
                         moreover
                         have "Maps.PRJ\<^sub>1
                                 (Maps.MkArr (src (tab\<^sub>0 (dom ?\<mu>))) (trg ?\<nu>) \<lbrakk>tab\<^sub>0 (dom ?\<mu>)\<rbrakk>)
                                 (Maps.MkArr (src (tab\<^sub>0 (dom ?\<nu>))) (trg ?\<nu>) \<lbrakk>tab\<^sub>1 (dom ?\<nu>)\<rbrakk>) =
                               \<lbrakk>\<lbrakk>tab\<^sub>1 ((Maps.REP (Maps.MkArr (src (tab\<^sub>0 (dom ?\<mu>))) (trg (snd \<mu>\<nu>))
                                                            \<lbrakk>tab\<^sub>0 (dom ?\<mu>)\<rbrakk>))\<^sup>* \<star>
                                      Maps.REP (Maps.MkArr (src (tab\<^sub>0 (dom ?\<nu>))) (trg ?\<nu>)
                                                           \<lbrakk>tab\<^sub>1 (dom ?\<nu>)\<rbrakk>))\<rbrakk>\<rbrakk>"
                           unfolding Maps.PRJ\<^sub>1_def
                           using \<mu>\<nu> VV.arr_char dom_\<mu>_\<nu>.RS_simps(1) dom_\<mu>_\<nu>.RS_simps(16)
                                 dom_\<mu>_\<nu>.RS_simps(18) dom_\<mu>_\<nu>.RS_simps(3) dom_\<mu>_\<nu>.R\<^sub>0_def
                                 dom_\<mu>_\<nu>.S\<^sub>1_def
                           by auto
                         moreover
                         have "(Maps.REP (Maps.MkArr (src (tab\<^sub>0 (dom ?\<mu>))) (trg (snd \<mu>\<nu>))
                                                     \<lbrakk>tab\<^sub>0 (dom ?\<mu>)\<rbrakk>))\<^sup>* \<star>
                               Maps.REP (Maps.MkArr (src (tab\<^sub>0 (dom ?\<nu>))) (trg ?\<nu>)
                                                    \<lbrakk>tab\<^sub>1 (dom ?\<nu>)\<rbrakk>) \<cong>
                               (tab\<^sub>0 (dom ?\<mu>))\<^sup>* \<star> tab\<^sub>1 (dom ?\<nu>)"
                           using VV.arr_char \<mu>\<nu> dom_\<mu>_\<nu>.S\<^sub>1_def dom_\<mu>_\<nu>.s.leg1_simps(3)
                                 dom_\<mu>_\<nu>.s.leg1_simps(4) trg_dom dom_\<mu>_\<nu>.R\<^sub>0_def
                                 dom_\<mu>_\<nu>.prj_tab_agreement(1) isomorphic_symmetric
                           by simp
                         ultimately show ?thesis
                            using X.isomorphic_implies_same_tab isomorphic_symmetric by metis
                       qed
                       thus ?thesis
                         unfolding Span.chine_hcomp_def
                         using \<mu>\<nu> VV.arr_char SPN_def isomorphic_reflexive
                               Maps.comp_CLS [of "spn ?\<mu>" dom_\<mu>_\<nu>.\<rho>\<sigma>.p\<^sub>1 "spn ?\<mu> \<star> dom_\<mu>_\<nu>.\<rho>\<sigma>.p\<^sub>1"]
                               Maps.comp_CLS [of "spn ?\<nu>" dom_\<mu>_\<nu>.\<rho>\<sigma>.p\<^sub>0 "spn ?\<nu> \<star> dom_\<mu>_\<nu>.\<rho>\<sigma>.p\<^sub>0"]
                         by simp
                     qed
                     moreover have "Maps.Dom (Span.chine_hcomp (SPN ?\<mu>) (SPN ?\<nu>)) =
                                    src dom_\<mu>_\<nu>.\<rho>\<sigma>.p\<^sub>0"
                       by (metis (no_types, lifting) "1" "2" Maps.Dom.simps(1) Maps.comp_char
                           \<open>Maps.Dom ?Chn_LHS = Maps.Dom ?Chn_RHS\<close>)
                     ultimately show ?thesis by simp
                   qed
                   also have "... = Maps.Comp \<lbrakk>cod_\<mu>_\<nu>.cmp\<rbrakk> \<lbrakk>\<mu>_\<nu>.chine\<rbrakk>"
                   proof -
                     let ?tuple = "Maps.tuple \<lbrakk>\<lbrakk>spn (fst \<mu>\<nu>) \<star> dom_\<mu>_\<nu>.\<rho>\<sigma>.p\<^sub>1\<rbrakk>\<rbrakk>
                                                \<lbrakk>\<lbrakk>tab\<^sub>0 (cod ?\<mu>)\<rbrakk>\<rbrakk> \<lbrakk>\<lbrakk>tab\<^sub>1 (cod ?\<nu>)\<rbrakk>\<rbrakk>
                                              \<lbrakk>\<lbrakk>spn (snd \<mu>\<nu>) \<star> dom_\<mu>_\<nu>.\<rho>\<sigma>.p\<^sub>0\<rbrakk>\<rbrakk>"
                     have "iso_class \<mu>_\<nu>.chine = Maps.Map ?tuple"
                       using \<mu>_\<nu>.CLS_chine spn_def Maps.Map.simps(1)
                       by (metis (no_types, lifting))
                     thus ?thesis by simp
                   qed
                   also have "... = \<lbrakk>cod_\<mu>_\<nu>.cmp \<star> \<mu>_\<nu>.chine\<rbrakk>"
                   proof -
                     have "\<lbrakk>\<mu>_\<nu>.chine\<rbrakk> \<in> Maps.Hom (src dom_\<mu>_\<nu>.\<rho>\<sigma>.p\<^sub>0) (src cod_\<mu>_\<nu>.\<rho>\<sigma>.p\<^sub>0)"
                     proof -
                       have "\<guillemotleft>\<mu>_\<nu>.chine : src dom_\<mu>_\<nu>.\<rho>\<sigma>.p\<^sub>0 \<rightarrow> src cod_\<mu>_\<nu>.\<rho>\<sigma>.p\<^sub>0\<guillemotright>"
                         using \<mu>\<nu> VV.arr_char by simp
                       thus ?thesis
                         using \<mu>_\<nu>.is_map ide_in_iso_class left_adjoint_is_ide by blast
                     qed
                     moreover have "\<lbrakk>cod_\<mu>_\<nu>.cmp\<rbrakk> \<in>
                                    Maps.Hom (src cod_\<mu>_\<nu>.\<rho>\<sigma>.p\<^sub>0) (src (tab\<^sub>0 (cod ?\<mu> \<star> cod ?\<nu>)))"
                     proof -
                       have "\<guillemotleft>cod_\<mu>_\<nu>.cmp : src cod_\<mu>_\<nu>.\<rho>\<sigma>.p\<^sub>0 \<rightarrow> src (tab\<^sub>0 (cod ?\<mu> \<star> cod ?\<nu>))\<guillemotright>"
                         using \<mu>\<nu> VV.arr_char cod_\<mu>_\<nu>.cmp_in_hom cod_\<mu>\<nu>.tab_simps(2)
                         by simp
                       thus ?thesis
                         using cod_\<mu>_\<nu>.cmp_props equivalence_is_left_adjoint left_adjoint_is_ide
                               ide_in_iso_class [of cod_\<mu>_\<nu>.cmp]
                         by blast
                     qed
                     moreover have
                       "cod_\<mu>_\<nu>.cmp \<star> \<mu>_\<nu>.chine \<in> Maps.Comp \<lbrakk>cod_\<mu>_\<nu>.cmp\<rbrakk> \<lbrakk>\<mu>_\<nu>.chine\<rbrakk>"
                     proof
                       show "is_iso_class \<lbrakk>\<mu>_\<nu>.chine\<rbrakk>"
                         using \<mu>_\<nu>.w_simps(1) is_iso_classI by blast
                       show "is_iso_class \<lbrakk>cod_\<mu>_\<nu>.cmp\<rbrakk>"
                         using cod_\<mu>_\<nu>.cmp_simps(2) is_iso_classI by blast
                       show "\<mu>_\<nu>.chine \<in> \<lbrakk>\<mu>_\<nu>.chine\<rbrakk>"
                         using ide_in_iso_class by simp
                       show "cod_\<mu>_\<nu>.cmp \<in> \<lbrakk>cod_\<mu>_\<nu>.cmp\<rbrakk>"
                         using ide_in_iso_class by simp
                       show "cod_\<mu>_\<nu>.cmp \<star> \<mu>_\<nu>.chine \<cong> cod_\<mu>_\<nu>.cmp \<star> \<mu>_\<nu>.chine"
                         by (simp add: isomorphic_reflexive)
                     qed
                     ultimately show ?thesis
                       using \<mu>\<nu> cod_\<mu>_\<nu>.cmp_props \<mu>_\<nu>.chine_in_hom \<mu>_\<nu>.chine_is_induced_map
                             Maps.Comp_eq_iso_class_memb
                       by simp
                   qed
                   finally show ?thesis by simp
                 qed
 
                 have EQ: "\<lbrakk>\<mu>\<nu>.chine \<star> dom_\<mu>_\<nu>.cmp\<rbrakk> = \<lbrakk>cod_\<mu>_\<nu>.cmp \<star> \<mu>_\<nu>.chine\<rbrakk>"
                 proof (intro iso_class_eqI)
                   show "\<mu>\<nu>.chine \<star> dom_\<mu>_\<nu>.cmp \<cong> cod_\<mu>_\<nu>.cmp \<star> \<mu>_\<nu>.chine"
                   proof -
                     interpret dom_cmp: identity_arrow_of_tabulations_in_maps V H \<a> \<i> src trg
                                          \<open>dom ?\<mu>\<nu>\<close>
                                          dom_\<mu>_\<nu>.\<rho>\<sigma>.tab
                                          \<open>tab\<^sub>0 (dom ?\<nu>) \<star> dom_\<mu>_\<nu>.\<rho>\<sigma>.p\<^sub>0\<close>
                                          \<open>tab\<^sub>1 (dom ?\<mu>) \<star> dom_\<mu>_\<nu>.\<rho>\<sigma>.p\<^sub>1\<close>
                                          \<open>dom ?\<mu>\<nu>\<close>
                                          \<open>tab_of_ide (dom ?\<mu> \<star> dom ?\<nu>)\<close>
                                          \<open>tab\<^sub>0 (dom ?\<mu> \<star> dom ?\<nu>)\<close>
                                          \<open>tab\<^sub>1 (dom ?\<mu> \<star> dom ?\<nu>)\<close>
                                          \<open>dom ?\<mu>\<nu>\<close>
                       using \<mu>\<nu> VV.arr_char dom_\<mu>_\<nu>.cmp_interpretation by simp
                     interpret cod_cmp: identity_arrow_of_tabulations_in_maps V H \<a> \<i> src trg
                                         \<open>cod ?\<mu>\<nu>\<close>
                                         cod_\<mu>_\<nu>.\<rho>\<sigma>.tab
                                         \<open>tab\<^sub>0 (cod ?\<nu>) \<star> cod_\<mu>_\<nu>.\<rho>\<sigma>.p\<^sub>0\<close>
                                         \<open>tab\<^sub>1 (cod ?\<mu>) \<star> cod_\<mu>_\<nu>.\<rho>\<sigma>.p\<^sub>1\<close>
                                         \<open>cod ?\<mu>\<nu>\<close>
                                         \<open>tab_of_ide (cod ?\<mu> \<star> cod ?\<nu>)\<close>
                                         \<open>tab\<^sub>0 (cod ?\<mu> \<star> cod ?\<nu>)\<close>
                                         \<open>tab\<^sub>1 (cod ?\<mu> \<star> cod ?\<nu>)\<close>
                                         \<open>cod ?\<mu>\<nu>\<close>
                       using \<mu>\<nu> VV.arr_char cod_\<mu>_\<nu>.cmp_interpretation by simp
                     interpret L: vertical_composite_of_arrows_of_tabulations_in_maps
                                    V H \<a> \<i> src trg
                                    \<open>dom ?\<mu>\<nu>\<close>
                                    \<open>dom_\<mu>_\<nu>.\<rho>\<sigma>.tab\<close>
                                    \<open>tab\<^sub>0 (dom ?\<nu>) \<star> dom_\<mu>_\<nu>.\<rho>\<sigma>.p\<^sub>0\<close>
                                    \<open>tab\<^sub>1 (dom ?\<mu>) \<star> dom_\<mu>_\<nu>.\<rho>\<sigma>.p\<^sub>1\<close>
                                    \<open>dom ?\<mu>\<nu>\<close>
                                    \<open>tab_of_ide (dom ?\<mu>\<nu>)\<close>
                                    \<open>tab\<^sub>0 (dom ?\<mu>\<nu>)\<close>
                                    \<open>tab\<^sub>1 (dom ?\<mu>\<nu>)\<close>
                                    \<open>cod ?\<mu>\<nu>\<close>
                                    cod_\<mu>\<nu>.tab
                                    \<open>tab\<^sub>0 (cod ?\<mu>\<nu>)\<close>
                                    \<open>tab\<^sub>1 (cod ?\<mu>\<nu>)\<close>
                                    \<open>dom ?\<mu>\<nu>\<close>
                                    \<open>?\<mu> \<star> ?\<nu>\<close>
                       using \<mu>\<nu> VV.arr_char dom_\<mu>_\<nu>.cmp_in_hom
                       by unfold_locales auto
                     interpret R: vertical_composite_of_arrows_of_tabulations_in_maps
                                    V H \<a> \<i> src trg
                                    \<open>dom ?\<mu>\<nu>\<close>
                                    \<open>dom_\<mu>_\<nu>.\<rho>\<sigma>.tab\<close>
                                    \<open>tab\<^sub>0 (dom ?\<nu>) \<star> dom_\<mu>_\<nu>.\<rho>\<sigma>.p\<^sub>0\<close>
                                    \<open>tab\<^sub>1 (dom ?\<mu>) \<star> dom_\<mu>_\<nu>.\<rho>\<sigma>.p\<^sub>1\<close>
                                    \<open>cod ?\<mu>\<nu>\<close>
                                    \<open>cod_\<mu>_\<nu>.\<rho>\<sigma>.tab\<close>
                                    \<open>tab\<^sub>0 (cod ?\<nu>) \<star> cod_\<mu>_\<nu>.\<rho>\<sigma>.p\<^sub>0\<close>
                                    \<open>tab\<^sub>1 (cod ?\<mu>) \<star> cod_\<mu>_\<nu>.\<rho>\<sigma>.p\<^sub>1\<close>
                                    \<open>cod ?\<mu>\<nu>\<close>
                                    cod_\<mu>\<nu>.tab
                                    \<open>tab\<^sub>0 (cod ?\<mu>\<nu>)\<close>
                                    \<open>tab\<^sub>1 (cod ?\<mu>\<nu>)\<close>
                                    \<open>?\<mu> \<star> ?\<nu>\<close>
                                    \<open>cod ?\<mu>\<nu>\<close>
                        using \<mu>\<nu> VV.arr_char cod_\<mu>_\<nu>.cmp_in_hom
                        by unfold_locales auto
                     have "\<mu>\<nu>.chine \<star> dom_\<mu>_\<nu>.cmp \<cong> L.chine"
                       using \<mu>\<nu> VV.arr_char L.chine_char dom_\<mu>_\<nu>.cmp_def isomorphic_symmetric
                       by simp
                     also have "... = R.chine"
                       using L.is_ide \<mu>\<nu> comp_arr_dom comp_cod_arr isomorphic_reflexive by force
                     also have "... \<cong> cod_\<mu>_\<nu>.cmp \<star> \<mu>_\<nu>.chine"
                       using \<mu>\<nu> VV.arr_char R.chine_char cod_\<mu>_\<nu>.cmp_def by simp
                     finally show ?thesis by simp
                   qed
                 qed
                 show ?thesis
                   using LHS RHS EQ by simp
               qed
             qed
             thus ?thesis
               using Chn_LHS_eq Chn_RHS_eq by simp
           qed
         qed
       qed
     qed
 
     interpretation \<Xi>: natural_isomorphism VV.comp Span.vcomp
                         HoSPN_SPN.map SPNoH.map \<Xi>.map
       using VV.ide_char VV.arr_char \<Xi>.map_simp_ide compositor_is_iso
       by (unfold_locales, simp)
 
     lemma compositor_is_natural_transformation:
     shows "transformation_by_components VV.comp Span.vcomp HoSPN_SPN.map SPNoH.map
              (\<lambda>rs. CMP (fst rs) (snd rs))"
       ..
 
     lemma compositor_is_natural_isomorphism:
     shows "natural_isomorphism VV.comp Span.vcomp HoSPN_SPN.map SPNoH.map \<Xi>.map"
       ..
 
   end
   
   subsubsection "Associativity Coherence"
 
   locale three_composable_identities_in_bicategory_of_spans =
     bicategory_of_spans V H \<a> \<i> src trg +
     f: identity_in_bicategory_of_spans V H \<a> \<i> src trg f +
     g: identity_in_bicategory_of_spans V H \<a> \<i> src trg g +
     h: identity_in_bicategory_of_spans V H \<a> \<i> src trg h
   for V :: "'a comp"                 (infixr "\<cdot>" 55)
   and H :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"          (infixr "\<star>" 53)
   and \<a> :: "'a \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a"     ("\<a>[_, _, _]")
   and \<i> :: "'a \<Rightarrow> 'a"                 ("\<i>[_]")
   and src :: "'a \<Rightarrow> 'a"
   and trg :: "'a \<Rightarrow> 'a"
   and f :: 'a
   and g :: 'a
   and h :: 'a +
   assumes fg: "src f = trg g"
   and gh: "src g = trg h"
   begin
 
     interpretation f: arrow_of_tabulations_in_maps V H \<a> \<i> src trg
                         f f.tab \<open>tab\<^sub>0 f\<close> \<open>tab\<^sub>1 f\<close> f f.tab \<open>tab\<^sub>0 f\<close> \<open>tab\<^sub>1 f\<close> f
       using f.is_arrow_of_tabulations_in_maps by simp
     interpretation h: arrow_of_tabulations_in_maps V H \<a> \<i> src trg
                         h h.tab \<open>tab\<^sub>0 h\<close> \<open>tab\<^sub>1 h\<close> h h.tab \<open>tab\<^sub>0 h\<close> \<open>tab\<^sub>1 h\<close> h
       using h.is_arrow_of_tabulations_in_maps by simp
 
     interpretation E: self_evaluation_map V H \<a> \<i> src trg ..
     notation E.eval ("\<lbrace>_\<rbrace>")
 
     interpretation Maps: maps_category V H \<a> \<i> src trg ..
     interpretation Span: span_bicategory Maps.comp Maps.PRJ\<^sub>0 Maps.PRJ\<^sub>1 ..
 
     no_notation Fun.comp (infixl "\<circ>" 55)
     notation Span.vcomp (infixr "\<bullet>" 55)
     notation Span.hcomp (infixr "\<circ>" 53)
     notation Maps.comp (infixr "\<odot>" 55)
     notation isomorphic (infix "\<cong>" 50)
 
     interpretation SPN: "functor" V Span.vcomp SPN
       using SPN_is_functor by simp
     interpretation SPN: weak_arrow_of_homs V src trg Span.vcomp Span.src Span.trg SPN
       using SPN_is_weak_arrow_of_homs by simp
     interpretation SPN_SPN: "functor" VV.comp Span.VV.comp SPN.FF
       using SPN.functor_FF by auto
     interpretation HoSPN_SPN: composite_functor VV.comp Span.VV.comp Span.vcomp
                                 SPN.FF \<open>\<lambda>\<mu>\<nu>. fst \<mu>\<nu> \<circ> snd \<mu>\<nu>\<close>
       ..
     interpretation SPNoH: composite_functor VV.comp V Span.vcomp \<open>\<lambda>\<mu>\<nu>. fst \<mu>\<nu> \<star> snd \<mu>\<nu>\<close> SPN
       ..
 
     text \<open>
       Here come a lot of interpretations for ``composite things''.
       We need these in order to have relatively short, systematic names for entities that will
       appear in the lemmas to follow.
       The names of the interpretations use a prefix notation, where \<open>H\<close> refers to horizontal
       composition of 1-cells and \<open>T\<close> refers to composite of tabulations.
       So, for example, \<open>THfgh\<close> refers to the composite of the tabulation associated with the
       horizontal composition \<open>f \<star> g\<close> with the tabulation associated with \<open>h\<close>.
     \<close>
     interpretation HHfgh: identity_in_bicategory_of_spans V H \<a> \<i> src trg \<open>(f \<star> g) \<star> h\<close>
       using fg gh by unfold_locales auto
     interpretation HfHgh: identity_in_bicategory_of_spans V H \<a> \<i> src trg \<open>f \<star> g \<star> h\<close>
       using fg gh by unfold_locales auto
     interpretation Tfg: two_composable_identities_in_bicategory_of_spans V H \<a> \<i> src trg f g
       using fg gh by unfold_locales auto
     interpretation Tgh: two_composable_identities_in_bicategory_of_spans V H \<a> \<i> src trg g h
       using fg gh by unfold_locales auto
     interpretation THfgh: two_composable_identities_in_bicategory_of_spans V H \<a> \<i> src trg
                             \<open>f \<star> g\<close> h
       using fg gh by unfold_locales auto
     interpretation THfgh: tabulation V H \<a> \<i> src trg \<open>(f \<star> g) \<star> h\<close> THfgh.\<rho>\<sigma>.tab
                             \<open>tab\<^sub>0 h \<star> THfgh.\<rho>\<sigma>.p\<^sub>0\<close> \<open>tab\<^sub>1 (f \<star> g) \<star> THfgh.\<rho>\<sigma>.p\<^sub>1\<close>
       using THfgh.\<rho>\<sigma>.composite_is_tabulation by simp
     interpretation TfHgh: two_composable_identities_in_bicategory_of_spans V H \<a> \<i> src trg
                             f \<open>g \<star> h\<close>
       using fg gh by unfold_locales auto
     interpretation TfHgh: tabulation V H \<a> \<i> src trg \<open>f \<star> g \<star> h\<close> TfHgh.\<rho>\<sigma>.tab
                             \<open>tab\<^sub>0 (g \<star> h) \<star> TfHgh.\<rho>\<sigma>.p\<^sub>0\<close> \<open>tab\<^sub>1 f \<star> TfHgh.\<rho>\<sigma>.p\<^sub>1\<close>
       using TfHgh.\<rho>\<sigma>.composite_is_tabulation by simp
 
     interpretation Tfg_Hfg: arrow_of_tabulations_in_maps V H \<a> \<i> src trg
                               \<open>f \<star> g\<close> Tfg.\<rho>\<sigma>.tab \<open>tab\<^sub>0 g \<star> Tfg.\<rho>\<sigma>.p\<^sub>0\<close> \<open>tab\<^sub>1 f \<star> Tfg.\<rho>\<sigma>.p\<^sub>1\<close>
                               \<open>f \<star> g\<close> \<open>tab_of_ide (f \<star> g)\<close> \<open>tab\<^sub>0 (f \<star> g)\<close> \<open>tab\<^sub>1 (f \<star> g)\<close>
                               \<open>f \<star> g\<close>
       by unfold_locales auto
     interpretation Tgh_Hgh: arrow_of_tabulations_in_maps V H \<a> \<i> src trg
                               \<open>g \<star> h\<close> Tgh.\<rho>\<sigma>.tab \<open>tab\<^sub>0 h \<star> Tgh.\<rho>\<sigma>.p\<^sub>0\<close> \<open>tab\<^sub>1 g \<star> Tgh.\<rho>\<sigma>.p\<^sub>1\<close>
                               \<open>g \<star> h\<close> \<open>tab_of_ide (g \<star> h)\<close> \<open>tab\<^sub>0 (g \<star> h)\<close> \<open>tab\<^sub>1 (g \<star> h)\<close>
                               \<open>g \<star> h\<close>
       by unfold_locales auto
     interpretation THfgh_HHfgh:
         arrow_of_tabulations_in_maps V H \<a> \<i> src trg
           \<open>(f \<star> g) \<star> h\<close> THfgh.\<rho>\<sigma>.tab \<open>tab\<^sub>0 h \<star> THfgh.\<rho>\<sigma>.p\<^sub>0\<close> \<open>tab\<^sub>1 (f \<star> g) \<star> THfgh.\<rho>\<sigma>.p\<^sub>1\<close>
           \<open>(f \<star> g) \<star> h\<close> \<open>tab_of_ide ((f \<star> g) \<star> h)\<close> \<open>tab\<^sub>0 ((f \<star> g) \<star> h)\<close> \<open>tab\<^sub>1 ((f \<star> g) \<star> h)\<close>
           \<open>(f \<star> g) \<star> h\<close>
       using fg gh by unfold_locales auto
     interpretation TfHgh_HfHgh:
         arrow_of_tabulations_in_maps V H \<a> \<i> src trg
           \<open>f \<star> g \<star> h\<close> TfHgh.\<rho>\<sigma>.tab \<open>tab\<^sub>0 (g \<star> h) \<star> TfHgh.\<rho>\<sigma>.p\<^sub>0\<close> \<open>tab\<^sub>1 f \<star> TfHgh.\<rho>\<sigma>.p\<^sub>1\<close>
           \<open>f \<star> g \<star> h\<close> \<open>tab_of_ide (f \<star> g \<star> h)\<close> \<open>tab\<^sub>0 (f \<star> g \<star> h)\<close> \<open>tab\<^sub>1 (f \<star> g \<star> h)\<close>
           \<open>f \<star> g \<star> h\<close>
       using fg gh by unfold_locales auto
     interpretation TTfgh: composite_tabulation_in_maps V H \<a> \<i> src trg
                             \<open>f \<star> g\<close> Tfg.\<rho>\<sigma>.tab \<open>tab\<^sub>0 g \<star> Tfg.\<rho>\<sigma>.p\<^sub>0\<close> \<open>tab\<^sub>1 f \<star> Tfg.\<rho>\<sigma>.p\<^sub>1\<close>
                             h \<open>tab_of_ide h\<close> \<open>tab\<^sub>0 h\<close> \<open>tab\<^sub>1 h\<close>
       using fg gh by unfold_locales auto
     interpretation TTfgh_THfgh:
         horizontal_composite_of_arrows_of_tabulations_in_maps V H \<a> \<i> src trg
           \<open>f \<star> g\<close> Tfg.\<rho>\<sigma>.tab \<open>tab\<^sub>0 g \<star> Tfg.\<rho>\<sigma>.p\<^sub>0\<close> \<open>tab\<^sub>1 f \<star> Tfg.\<rho>\<sigma>.p\<^sub>1\<close>
           h \<open>tab_of_ide h\<close> \<open>tab\<^sub>0 h\<close> \<open>tab\<^sub>1 h\<close>
           \<open>f \<star> g\<close> \<open>tab_of_ide (f \<star> g)\<close> \<open>tab\<^sub>0 (f \<star> g)\<close> \<open>tab\<^sub>1 (f \<star> g)\<close>
           h \<open>tab_of_ide h\<close> \<open>tab\<^sub>0 h\<close> \<open>tab\<^sub>1 h\<close>
           \<open>f \<star> g\<close> h
       ..
     interpretation TfTgh: composite_tabulation_in_maps V H \<a> \<i> src trg
                             f \<open>tab_of_ide f\<close> \<open>tab\<^sub>0 f\<close> \<open>tab\<^sub>1 f\<close>
                             \<open>g \<star> h\<close> Tgh.\<rho>\<sigma>.tab \<open>tab\<^sub>0 h \<star> Tgh.\<rho>\<sigma>.p\<^sub>0\<close> \<open>tab\<^sub>1 g \<star> Tgh.\<rho>\<sigma>.p\<^sub>1\<close>
       using fg gh by unfold_locales auto
     interpretation TfTgh_TfHgh:
         horizontal_composite_of_arrows_of_tabulations_in_maps V H \<a> \<i> src trg
           f \<open>tab_of_ide f\<close> \<open>tab\<^sub>0 f\<close> \<open>tab\<^sub>1 f\<close>
           \<open>g \<star> h\<close> Tgh.\<rho>\<sigma>.tab \<open>tab\<^sub>0 h \<star> Tgh.\<rho>\<sigma>.p\<^sub>0\<close> \<open>tab\<^sub>1 g \<star> Tgh.\<rho>\<sigma>.p\<^sub>1\<close>
           f \<open>tab_of_ide f\<close> \<open>tab\<^sub>0 f\<close> \<open>tab\<^sub>1 f\<close>
           \<open>g \<star> h\<close> \<open>tab_of_ide (g \<star> h)\<close> \<open>tab\<^sub>0 (g \<star> h)\<close> \<open>tab\<^sub>1 (g \<star> h)\<close>
           f \<open>g \<star> h\<close>
       ..
     interpretation TfTgh_TfTgh:
         horizontal_composite_of_arrows_of_tabulations_in_maps V H \<a> \<i> src trg
           f \<open>tab_of_ide f\<close> \<open>tab\<^sub>0 f\<close> \<open>tab\<^sub>1 f\<close>
           \<open>g \<star> h\<close> Tgh.\<rho>\<sigma>.tab \<open>tab\<^sub>0 h \<star> Tgh.\<rho>\<sigma>.p\<^sub>0\<close> \<open>tab\<^sub>1 g \<star> Tgh.\<rho>\<sigma>.p\<^sub>1\<close>
           f \<open>tab_of_ide f\<close> \<open>tab\<^sub>0 f\<close> \<open>tab\<^sub>1 f\<close>
           \<open>g \<star> h\<close> Tgh.\<rho>\<sigma>.tab \<open>tab\<^sub>0 h \<star> Tgh.\<rho>\<sigma>.p\<^sub>0\<close> \<open>tab\<^sub>1 g \<star> Tgh.\<rho>\<sigma>.p\<^sub>1\<close>
           f \<open>g \<star> h\<close>
       ..
     text \<open>
       The following interpretation defines the associativity between the peaks
       of the two composite tabulations \<open>TTfgh\<close> (associated to the left) and \<open>TfTgh\<close>
       (associated to the right).
     \<close>
     (* TODO: Try to get rid of the .\<rho>\<sigma> in, e.g., Tfg.\<rho>\<sigma>.p\<^sub>1. *)
     interpretation TTfgh_TfTgh:
         arrow_of_tabulations_in_maps V H \<a> \<i> src trg
           \<open>(f \<star> g) \<star> h\<close> TTfgh.tab \<open>tab\<^sub>0 h \<star> TTfgh.p\<^sub>0\<close> \<open>(tab\<^sub>1 f \<star> Tfg.\<rho>\<sigma>.p\<^sub>1) \<star> TTfgh.p\<^sub>1\<close>
           \<open>f \<star> g \<star> h\<close> TfTgh.tab \<open>(tab\<^sub>0 h \<star> Tgh.\<rho>\<sigma>.p\<^sub>0) \<star> TfTgh.p\<^sub>0\<close> \<open>tab\<^sub>1 f \<star> TfTgh.p\<^sub>1\<close>
           \<open>\<a>[f, g, h]\<close>
       using fg gh by unfold_locales auto
 
     text \<open>
       This interpretation defines the map, from the apex of the tabulation associated
       with the horizontal composite \<open>(f \<star> g) \<star> h\<close> to the apex of the tabulation associated
       with the horizontal composite \<open>f \<star> g \<star> h\<close>, induced by the associativity isomorphism
       \<open>\<a>[f, g, h]\<close> from \<open>(f \<star> g) \<star> h\<close> to \<open>f \<star> g \<star> h\<close>.
     \<close>
 
     interpretation HHfgh_HfHgh: arrow_of_tabulations_in_maps V H \<a> \<i> src trg
                                   \<open>dom (\<alpha> (f, g, h))\<close> \<open>tab_of_ide (dom (\<alpha> (f, g, h)))\<close>
                                   \<open>tab\<^sub>0 (dom (\<alpha> (f, g, h)))\<close> \<open>tab\<^sub>1 (dom (\<alpha> (f, g, h)))\<close>
                                   \<open>cod (\<alpha> (f, g, h))\<close> \<open>tab_of_ide (cod (\<alpha> (f, g, h)))\<close>
                                   \<open>tab\<^sub>0 (cod (\<alpha> (f, g, h)))\<close> \<open>tab\<^sub>1 (cod (\<alpha> (f, g, h)))\<close>
                                   \<open>\<alpha> (f, g, h)\<close>
     proof -
       have "arrow_of_tabulations_in_maps V H \<a> \<i> src trg
               ((f \<star> g) \<star> h) (tab_of_ide ((f \<star> g) \<star> h)) (tab\<^sub>0 ((f \<star> g) \<star> h)) (tab\<^sub>1 ((f \<star> g) \<star> h))
               (f \<star> g \<star> h) (tab_of_ide (f \<star> g \<star> h)) (tab\<^sub>0 (f \<star> g \<star> h)) (tab\<^sub>1 (f \<star> g \<star> h))
               \<a>[f, g, h]"
         using fg gh by unfold_locales auto
       thus "arrow_of_tabulations_in_maps V H \<a> \<i> src trg
               (dom (\<alpha> (f, g, h))) (tab_of_ide (dom (\<alpha> (f, g, h))))
               (tab\<^sub>0 (dom (\<alpha> (f, g, h)))) (tab\<^sub>1 (dom (\<alpha> (f, g, h))))
               (cod (\<alpha> (f, g, h))) (tab_of_ide (cod (\<alpha> (f, g, h))))
               (tab\<^sub>0 (cod (\<alpha> (f, g, h)))) (tab\<^sub>1 (cod (\<alpha> (f, g, h))))
               (\<alpha> (f, g, h))"
         using fg gh \<alpha>_def by auto
     qed
 
     interpretation SPN_f: arrow_of_spans Maps.comp \<open>SPN f\<close>
       using SPN_in_hom Span.arr_char [of "SPN f"] by simp
     interpretation SPN_g: arrow_of_spans Maps.comp \<open>SPN g\<close>
       using SPN_in_hom Span.arr_char [of "SPN g"] by simp
     interpretation SPN_h: arrow_of_spans Maps.comp \<open>SPN h\<close>
       using SPN_in_hom Span.arr_char [of "SPN h"] by simp
     interpretation SPN_fgh: three_composable_identity_arrows_of_spans Maps.comp
                               Maps.PRJ\<^sub>0 Maps.PRJ\<^sub>1 \<open>SPN f\<close> \<open>SPN g\<close> \<open>SPN h\<close>
       using fg gh Span.arr_char SPN_in_hom SPN.preserves_ide Span.ide_char
       apply unfold_locales by auto
 
     text \<open>
       The following relates the projections associated with the composite span \<open>SPN_fgh\<close>
       with tabulations in the underlying bicategory.
     \<close>
 
     lemma prj_char:
     shows "SPN_fgh.Prj\<^sub>1\<^sub>1 = \<lbrakk>\<lbrakk>Tfg.\<rho>\<sigma>.p\<^sub>1 \<star> TTfgh.p\<^sub>1\<rbrakk>\<rbrakk>"
     and "SPN_fgh.Prj\<^sub>0\<^sub>1 = \<lbrakk>\<lbrakk>Tfg.\<rho>\<sigma>.p\<^sub>0 \<star> TTfgh.p\<^sub>1\<rbrakk>\<rbrakk>"
     and "SPN_fgh.Prj\<^sub>0 = \<lbrakk>\<lbrakk>TTfgh.p\<^sub>0\<rbrakk>\<rbrakk>"
     and "SPN_fgh.Prj\<^sub>1 = \<lbrakk>\<lbrakk>TfTgh.p\<^sub>1\<rbrakk>\<rbrakk>"
     and "SPN_fgh.Prj\<^sub>1\<^sub>0 = \<lbrakk>\<lbrakk>Tgh.\<rho>\<sigma>.p\<^sub>1 \<star> TfTgh.p\<^sub>0\<rbrakk>\<rbrakk>"
     and "SPN_fgh.Prj\<^sub>0\<^sub>0 = \<lbrakk>\<lbrakk>Tgh.\<rho>\<sigma>.p\<^sub>0 \<star> TfTgh.p\<^sub>0\<rbrakk>\<rbrakk>"
     proof -
       show "SPN_fgh.Prj\<^sub>1\<^sub>1 = \<lbrakk>\<lbrakk>Tfg.\<rho>\<sigma>.p\<^sub>1 \<star> TTfgh.p\<^sub>1\<rbrakk>\<rbrakk>"
       proof -
         have "ide (Tfg.\<rho>\<sigma>.p\<^sub>1 \<star> TTfgh.p\<^sub>1)"
           by (metis TTfgh.composable TTfgh.leg1_simps(2) Tfg.\<rho>\<sigma>.T0.antipar(2)
               Tfg.\<rho>\<sigma>.T0.ide_right Tfg_Hfg.u_simps(3) f.T0.antipar(2) f.T0.ide_right
               f.u_simps(3) fg g.ide_leg1 g.leg1_simps(4) h.ide_leg1 h.leg1_simps(4)
               ide_hcomp hseqE hcomp_simps(1) tab\<^sub>1_simps(1))
         thus ?thesis
           using fg gh Tfg.\<rho>\<sigma>.prj_char TTfgh.prj_char isomorphic_reflexive
                 Maps.comp_CLS [of "tab\<^sub>0 g" Tfg.\<rho>\<sigma>.p\<^sub>0 "tab\<^sub>0 g \<star> Tfg.\<rho>\<sigma>.p\<^sub>0"]
                 Maps.comp_CLS [of Tfg.\<rho>\<sigma>.p\<^sub>1 TTfgh.p\<^sub>1 "Tfg.\<rho>\<sigma>.p\<^sub>1 \<star> TTfgh.p\<^sub>1"]
           by (simp add: TTfgh.composable Tfg.\<rho>\<sigma>.T0.antipar(2))
       qed
       show "SPN_fgh.Prj\<^sub>0\<^sub>1 = \<lbrakk>\<lbrakk>Tfg.\<rho>\<sigma>.p\<^sub>0 \<star> TTfgh.p\<^sub>1\<rbrakk>\<rbrakk>"
       proof -
         have "ide (Tfg.\<rho>\<sigma>.p\<^sub>0 \<star> TTfgh.p\<^sub>1)"
           by (metis TTfgh.leg1_simps(2) bicategory_of_spans.tab\<^sub>0_simps(1)
               bicategory_of_spans.tab\<^sub>1_simps(1) bicategory_of_spans_axioms
               Tfg.\<rho>\<sigma>.T0.antipar(2) Tfg.\<rho>\<sigma>.T0.ide_right Tfg.composable f.T0.antipar(2)
               f.T0.ide_right f.u_simps(3) g.ide_leg1 g.leg1_simps(4)
               Tfg.u_simps(3) THfgh.composable h.ide_leg1 h.leg1_simps(4)
               ide_hcomp hseqE hcomp_simps(1) tab\<^sub>1_simps(3))
         thus ?thesis
           using fg gh Tfg.\<rho>\<sigma>.prj_char TTfgh.prj_char isomorphic_reflexive
                 Maps.comp_CLS [of "tab\<^sub>0 g" Tfg.\<rho>\<sigma>.p\<^sub>0 "tab\<^sub>0 g \<star> Tfg.\<rho>\<sigma>.p\<^sub>0"]
                 Maps.comp_CLS [of Tfg.\<rho>\<sigma>.p\<^sub>0 TTfgh.p\<^sub>1 "Tfg.\<rho>\<sigma>.p\<^sub>0 \<star> TTfgh.p\<^sub>1"]
           by (simp add: Tfg.\<rho>\<sigma>.T0.antipar(2) THfgh.composable)
       qed
       show "SPN_fgh.Prj\<^sub>0 = \<lbrakk>\<lbrakk>TTfgh.p\<^sub>0\<rbrakk>\<rbrakk>"
         using isomorphic_reflexive TTfgh.prj_char Tfg.\<rho>\<sigma>.prj_char
               Maps.comp_CLS [of "tab\<^sub>0 g" Tfg.\<rho>\<sigma>.p\<^sub>0 "tab\<^sub>0 g \<star> Tfg.\<rho>\<sigma>.p\<^sub>0"]
         by (simp add: Tfg.composable)
       show "SPN_fgh.Prj\<^sub>1 = \<lbrakk>\<lbrakk>TfTgh.p\<^sub>1\<rbrakk>\<rbrakk>"
         using Tgh.\<rho>\<sigma>.prj_char isomorphic_reflexive Tgh.composable
               Maps.comp_CLS [of "tab\<^sub>1 g" Tgh.\<rho>\<sigma>.p\<^sub>1 "tab\<^sub>1 g \<star> Tgh.\<rho>\<sigma>.p\<^sub>1"]
               TfTgh.prj_char
         by simp
       show "SPN_fgh.Prj\<^sub>1\<^sub>0 = \<lbrakk>\<lbrakk>Tgh.\<rho>\<sigma>.p\<^sub>1 \<star> TfTgh.p\<^sub>0\<rbrakk>\<rbrakk>"
        using fg gh Tgh.\<rho>\<sigma>.prj_char TfTgh.prj_char isomorphic_reflexive
               Maps.comp_CLS [of "tab\<^sub>1 g" "prj\<^sub>1 (tab\<^sub>1 h) (tab\<^sub>0 g)" "tab\<^sub>1 g \<star> Tgh.\<rho>\<sigma>.p\<^sub>1"]
               Maps.comp_CLS [of Tgh.\<rho>\<sigma>.p\<^sub>1 TfTgh.p\<^sub>0 "Tgh.\<rho>\<sigma>.p\<^sub>1 \<star> TfTgh.p\<^sub>0"]
         by simp
       show "SPN_fgh.Prj\<^sub>0\<^sub>0 = \<lbrakk>\<lbrakk>Tgh.\<rho>\<sigma>.p\<^sub>0 \<star> TfTgh.p\<^sub>0\<rbrakk>\<rbrakk>"
         using fg gh Tgh.\<rho>\<sigma>.prj_char TfTgh.prj_char isomorphic_reflexive
               Maps.comp_CLS [of "tab\<^sub>1 g" "Tgh.\<rho>\<sigma>.p\<^sub>1" "tab\<^sub>1 g \<star> Tgh.\<rho>\<sigma>.p\<^sub>1"]
               Maps.comp_CLS [of Tgh.\<rho>\<sigma>.p\<^sub>0 TfTgh.p\<^sub>0 "Tgh.\<rho>\<sigma>.p\<^sub>0 \<star> TfTgh.p\<^sub>0"]
         by simp
     qed
 
     interpretation \<Phi>: transformation_by_components VV.comp Span.vcomp
                         HoSPN_SPN.map SPNoH.map \<open>\<lambda>rs. CMP (fst rs) (snd rs)\<close>
       using compositor_is_natural_transformation by simp
     interpretation \<Phi>: natural_isomorphism VV.comp Span.vcomp
                         HoSPN_SPN.map SPNoH.map \<Phi>.map
       using compositor_is_natural_isomorphism by simp
 
     (*
      * TODO: Figure out how this subcategory gets introduced.
      * The simps in the locale are used in the subsequent proofs.
      *)
     interpretation VVV': subcategory VxVxV.comp
                            \<open>\<lambda>\<tau>\<mu>\<nu>. arr (fst \<tau>\<mu>\<nu>) \<and> arr (fst (snd \<tau>\<mu>\<nu>)) \<and> arr (snd (snd \<tau>\<mu>\<nu>)) \<and>
                                   src (fst (snd \<tau>\<mu>\<nu>)) = trg (snd (snd \<tau>\<mu>\<nu>)) \<and>
                                   src (fst \<tau>\<mu>\<nu>) = trg (fst (snd \<tau>\<mu>\<nu>))\<close>
       using fg gh VVV.arr_char VV.arr_char VVV.subcategory_axioms by simp
 
     text \<open>
       We define abbreviations for the left and right-hand sides of the equation for
       associativity coherence.
     \<close>
     (*
      * TODO: \<Phi> doesn't really belong in this locale.  Replace it with CMP and rearrange
      * material so that this locale comes first and the definition of \<Phi> comes later
      * in bicategory_of_spans.
      *)
     abbreviation LHS
     where "LHS \<equiv> SPN \<a>[f, g, h] \<bullet> \<Phi>.map (f \<star> g, h) \<bullet> (\<Phi>.map (f, g) \<circ> SPN h)"
 
     abbreviation RHS
     where "RHS \<equiv> \<Phi>.map (f, g \<star> h) \<bullet> (SPN f \<circ> \<Phi>.map (g, h)) \<bullet>
                     Span.assoc (SPN f) (SPN g) (SPN h)"
 
     lemma arr_LHS:
     shows "Span.arr LHS"
       using fg gh VVV.arr_char VVV.ide_char VV.arr_char VV.ide_char Span.hseqI'
             HoHV_def compositor_in_hom \<alpha>_def
       apply (intro Span.seqI)
           apply simp_all
       using SPN.FF_def
        apply simp
     proof -
       have "SPN ((f \<star> g) \<star> h) = Span.cod (CMP (f \<star> g) h)"
         using fg gh compositor_in_hom by simp
       also have "... = Span.cod (CMP (f \<star> g) h \<bullet> (CMP f g \<circ> SPN h))"
       proof -
         have "Span.seq (CMP (f \<star> g) h) (CMP f g \<circ> SPN h)"
         proof (intro Span.seqI Span.hseqI)
           show 1: "Span.in_hhom (SPN h) (SPN.map\<^sub>0 (src h)) (SPN.map\<^sub>0 (trg h))"
             using SPN.preserves_src SPN.preserves_trg by simp
           show 2: "Span.in_hhom (CMP f g) (SPN.map\<^sub>0 (trg h)) (SPN.map\<^sub>0 (trg f))"
             using compositor_in_hom SPN_fgh.\<nu>\<pi>.composable fg by auto
           show 3: "Span.arr (CMP (f \<star> g) h)"
             using TTfgh.composable Tfg.\<rho>\<sigma>.ide_base compositor_simps(1) h.is_ide by auto
           show "Span.dom (CMP (f \<star> g) h) = Span.cod (CMP f g \<circ> SPN h)"
             using 1 2 3 fg gh compositor_in_hom SPN_fgh.\<nu>\<pi>.composable SPN_in_hom SPN.FF_def
             by auto
         qed
         thus ?thesis by simp
       qed
       finally show "SPN ((f \<star> g) \<star> h) = Span.cod (CMP (f \<star> g) h \<bullet> (CMP f g \<circ> SPN h))"
         by blast
     qed
 
     lemma arr_RHS:
     shows "Span.arr RHS"
       using fg gh VV.ide_char VV.arr_char \<Phi>.map_simp_ide SPN.FF_def Span.hseqI'
       by (intro Span.seqI, simp_all)
 
     lemma par_LHS_RHS:
     shows "Span.par LHS RHS"
     proof (intro conjI)
       show "Span.arr LHS"
         using arr_LHS by simp
       show "Span.arr RHS"
         using arr_RHS by simp
       show "Span.dom LHS = Span.dom RHS"
       proof -
         have "Span.dom LHS = Span.dom (\<Phi>.map (f, g) \<circ> SPN h)"
           using arr_LHS by auto
         also have "... = Span.dom (\<Phi>.map (f, g)) \<circ> Span.dom (SPN h)"
           using arr_LHS Span.dom_hcomp [of "SPN h" "\<Phi>.map (f, g)"] by blast
         also have "... = (SPN f \<circ> SPN g) \<circ> SPN h"
           using fg \<Phi>.map_simp_ide VV.ide_char VV.arr_char SPN.FF_def by simp
         also have "... = Span.dom (Span.assoc (SPN f) (SPN g) (SPN h))"
           using fg gh VVV.arr_char VVV.ide_char VV.arr_char VV.ide_char by simp
         also have "... = Span.dom RHS"
           using \<open>Span.arr RHS\<close> by auto
         finally show ?thesis by blast
       qed
       show "Span.cod LHS = Span.cod RHS"
       proof -
         have "Span.cod LHS = Span.cod (SPN \<a>[f, g, h])"
           using arr_LHS by simp
         also have "... = SPN (f \<star> g \<star> h)"
           unfolding \<alpha>_def
           using fg gh VVV.ide_char VVV.arr_char VV.ide_char VV.arr_char HoVH_def
           by simp
         also have "... = Span.cod RHS"
           using arr_RHS fg gh \<Phi>.map_simp_ide VV.ide_char VV.arr_char SPN.FF_def
                 compositor_in_hom
           by simp
         finally show ?thesis by blast
       qed
     qed
 
     lemma Chn_LHS_eq:
     shows "Chn LHS =
            \<lbrakk>\<lbrakk>HHfgh_HfHgh.chine\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>THfgh_HHfgh.chine\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>TTfgh_THfgh.chine\<rbrakk>\<rbrakk>"
     proof -
       have "Chn LHS = \<lbrakk>\<lbrakk>HHfgh_HfHgh.chine\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>THfgh_HHfgh.chine\<rbrakk>\<rbrakk> \<odot>
                         Span.chine_hcomp (CMP f g) (SPN h)"
       proof -
         have "Chn LHS = Chn (SPN \<a>[f, g, h]) \<odot> Chn (CMP (f \<star> g) h) \<odot>
                           Chn (CMP f g \<circ> SPN h)"
           using fg gh arr_LHS \<Phi>.map_simp_ide VV.ide_char VV.arr_char Span.Chn_vcomp
           by auto
         moreover have "Chn (SPN \<a>[f, g, h]) = Maps.CLS HHfgh_HfHgh.chine"
           using fg gh SPN_def VVV.arr_char VV.arr_char spn_def \<alpha>_def by simp
         moreover have "Chn (CMP (f \<star> g) h) = Maps.CLS THfgh_HHfgh.chine"
           using fg gh CMP_def THfgh.cmp_def by simp
         moreover have "Chn (CMP f g \<circ> SPN h) = Span.chine_hcomp (CMP f g) (SPN h)"
           using fg gh Span.hcomp_def by simp
         ultimately show ?thesis by simp
       qed
       moreover have "Span.chine_hcomp (CMP f g) (SPN h) = \<lbrakk>\<lbrakk>TTfgh_THfgh.chine\<rbrakk>\<rbrakk>"
       proof -
         have "Span.chine_hcomp (CMP f g) (SPN h) =
               Maps.tuple
                 (\<lbrakk>\<lbrakk>Tfg.cmp\<rbrakk>\<rbrakk> \<odot> Maps.PRJ\<^sub>1 \<lbrakk>\<lbrakk>tab\<^sub>0 g \<star> Tfg.\<rho>\<sigma>.p\<^sub>0\<rbrakk>\<rbrakk> \<lbrakk>\<lbrakk>tab\<^sub>1 h\<rbrakk>\<rbrakk>)
                    \<lbrakk>\<lbrakk>tab\<^sub>0 (f \<star> g)\<rbrakk>\<rbrakk> \<lbrakk>\<lbrakk>tab\<^sub>1 h\<rbrakk>\<rbrakk>
                 (\<lbrakk>\<lbrakk>spn h\<rbrakk>\<rbrakk> \<odot> Maps.PRJ\<^sub>0 \<lbrakk>\<lbrakk>tab\<^sub>0 g \<star> Tfg.\<rho>\<sigma>.p\<^sub>0\<rbrakk>\<rbrakk> \<lbrakk>\<lbrakk>tab\<^sub>1 h\<rbrakk>\<rbrakk>)"
         proof -
           have "\<lbrakk>\<lbrakk>tab\<^sub>0 g\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>Tfg.\<rho>\<sigma>.p\<^sub>0\<rbrakk>\<rbrakk> = \<lbrakk>\<lbrakk>tab\<^sub>0 g \<star> Tfg.\<rho>\<sigma>.p\<^sub>0\<rbrakk>\<rbrakk>"
             using fg isomorphic_reflexive
                   Maps.comp_CLS [of "tab\<^sub>0 g" "Tfg.\<rho>\<sigma>.p\<^sub>0" "tab\<^sub>0 g \<star> Tfg.\<rho>\<sigma>.p\<^sub>0"]
             by simp
           moreover have "span_in_category.apex Maps.comp \<lparr>Leg0 = \<lbrakk>\<lbrakk>tab\<^sub>0 h\<rbrakk>\<rbrakk>, Leg1 = \<lbrakk>\<lbrakk>tab\<^sub>1 h\<rbrakk>\<rbrakk>\<rparr> =
                          \<lbrakk>\<lbrakk>spn h\<rbrakk>\<rbrakk>"
           proof -
             interpret h: span_in_category Maps.comp \<open>\<lparr>Leg0 = \<lbrakk>\<lbrakk>tab\<^sub>0 h\<rbrakk>\<rbrakk>, Leg1 = \<lbrakk>\<lbrakk>tab\<^sub>1 h\<rbrakk>\<rbrakk>\<rparr>\<close>
               using h.determines_span by simp
             interpret dom_h: identity_arrow_of_tabulations_in_maps V H \<a> \<i> src trg
                                \<open>dom h\<close> \<open>tab_of_ide (dom h)\<close> \<open>tab\<^sub>0 (dom h)\<close> \<open>tab\<^sub>1 (dom h)\<close>
                                \<open>cod h\<close> \<open>tab_of_ide (cod h)\<close> \<open>tab\<^sub>0 (cod h)\<close> \<open>tab\<^sub>1 (cod h)\<close>
                                h
               by (simp add: h.is_arrow_of_tabulations_in_maps
                   identity_arrow_of_tabulations_in_maps.intro
                   identity_arrow_of_tabulations_in_maps_axioms.intro)
             have "Maps.arr h.leg0"
               using h.leg_simps(1) by simp
             hence "Maps.dom h.leg0 = \<lbrakk>\<lbrakk>dom_h.chine\<rbrakk>\<rbrakk>"
               using Maps.dom_char Maps.CLS_in_hom
               apply simp
             proof -
               have "h.is_induced_map (src (tab\<^sub>0 h))"
                 using h.is_induced_map_iff dom_h.\<Delta>_eq_\<rho> h.apex_is_induced_by_cell by force
               hence "src (tab\<^sub>0 h) \<cong> h.chine"
                 using h.chine_is_induced_map h.induced_map_unique by simp
               thus "\<lbrakk>src (tab\<^sub>0 h)\<rbrakk> = \<lbrakk>h.chine\<rbrakk>"
                 using iso_class_eqI by simp
             qed
             thus ?thesis
               using h.apex_def spn_def by simp
           qed
           ultimately show ?thesis
             unfolding Span.chine_hcomp_def
             using fg gh CMP_def Tfg.\<rho>\<sigma>.prj_char Span.hcomp_def by simp
         qed
         also have "... = \<lbrakk>\<lbrakk>TTfgh_THfgh.chine\<rbrakk>\<rbrakk>"
         proof -
           have "\<lbrakk>\<lbrakk>TTfgh_THfgh.chine\<rbrakk>\<rbrakk> =
                 Maps.tuple \<lbrakk>\<lbrakk>Tfg_Hfg.chine \<star> TTfgh.p\<^sub>1\<rbrakk>\<rbrakk>
                              \<lbrakk>\<lbrakk>tab\<^sub>0 (f \<star> g)\<rbrakk>\<rbrakk> \<lbrakk>\<lbrakk>tab\<^sub>1 h\<rbrakk>\<rbrakk>
                            \<lbrakk>\<lbrakk>h.chine \<star> TTfgh.p\<^sub>0\<rbrakk>\<rbrakk>"
             using TTfgh_THfgh.CLS_chine by simp
           also have "... =
                      Maps.tuple (\<lbrakk>\<lbrakk>Tfg_Hfg.chine\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>TTfgh.p\<^sub>1\<rbrakk>\<rbrakk>)
                                   \<lbrakk>\<lbrakk>tab\<^sub>0 (f \<star> g)\<rbrakk>\<rbrakk> \<lbrakk>\<lbrakk>tab\<^sub>1 h\<rbrakk>\<rbrakk>
                                 (\<lbrakk>\<lbrakk>h.chine\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>TTfgh.p\<^sub>0\<rbrakk>\<rbrakk>)"
           proof -
             have "\<lbrakk>\<lbrakk>Tfg_Hfg.chine \<star> TTfgh.p\<^sub>1\<rbrakk>\<rbrakk> = \<lbrakk>\<lbrakk>Tfg_Hfg.chine\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>TTfgh.p\<^sub>1\<rbrakk>\<rbrakk>"
             proof -
               have "is_left_adjoint TTfgh.p\<^sub>1"
                 using Tfg.\<rho>\<sigma>.T0.antipar(2) THfgh.composable by simp
               moreover have "Tfg_Hfg.chine \<star> TTfgh.p\<^sub>1 \<cong> Tfg_Hfg.chine \<star> TTfgh.p\<^sub>1"
                 using TTfgh_THfgh.prj_chine(2) isomorphic_reflexive isomorphic_implies_hpar(2)
                 by blast
               ultimately show ?thesis
                 using Tfg_Hfg.is_map
                       Maps.comp_CLS [of Tfg_Hfg.chine TTfgh.p\<^sub>1 "Tfg_Hfg.chine \<star> TTfgh.p\<^sub>1"]
                 by simp
             qed
             moreover have "\<lbrakk>\<lbrakk>h.chine \<star> TTfgh.p\<^sub>0\<rbrakk>\<rbrakk> = \<lbrakk>\<lbrakk>h.chine\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>TTfgh.p\<^sub>0\<rbrakk>\<rbrakk>"
             proof -
               have "is_left_adjoint TTfgh.p\<^sub>0"
                 by (simp add: Tfg.\<rho>\<sigma>.T0.antipar(2) THfgh.composable)
               moreover have "h.chine \<star> TTfgh.p\<^sub>0 \<cong> h.chine \<star> TTfgh.p\<^sub>0"
                 using TTfgh_THfgh.prj_chine(1) isomorphic_reflexive isomorphic_implies_hpar(2)
                 by blast
               ultimately show ?thesis
                 using h.is_map Maps.comp_CLS [of h.chine TTfgh.p\<^sub>0 "h.chine \<star> TTfgh.p\<^sub>0"]
                 by simp
             qed
             ultimately show ?thesis by argo
           qed
           also have "... =
                      Maps.tuple (\<lbrakk>\<lbrakk>Tfg.cmp\<rbrakk>\<rbrakk> \<odot> Maps.PRJ\<^sub>1 \<lbrakk>\<lbrakk>tab\<^sub>0 g \<star> Tfg.\<rho>\<sigma>.p\<^sub>0\<rbrakk>\<rbrakk> \<lbrakk>\<lbrakk>tab\<^sub>1 h\<rbrakk>\<rbrakk>)
                                   \<lbrakk>\<lbrakk>tab\<^sub>0 (f \<star> g)\<rbrakk>\<rbrakk> \<lbrakk>\<lbrakk>tab\<^sub>1 h\<rbrakk>\<rbrakk>
                                 (\<lbrakk>\<lbrakk>spn h\<rbrakk>\<rbrakk> \<odot> Maps.PRJ\<^sub>0 \<lbrakk>\<lbrakk>tab\<^sub>0 g \<star> Tfg.\<rho>\<sigma>.p\<^sub>0\<rbrakk>\<rbrakk> \<lbrakk>\<lbrakk>tab\<^sub>1 h\<rbrakk>\<rbrakk>)"
             using Tfg.cmp_def spn_def TTfgh.prj_char by simp
           finally show ?thesis by simp
         qed
         finally show ?thesis by blast
       qed
       ultimately show ?thesis by simp
     qed
 
     abbreviation tuple_BC
     where "tuple_BC \<equiv> Maps.tuple SPN_fgh.Prj\<^sub>0\<^sub>1 SPN_fgh.\<nu>.leg0 SPN_fgh.\<pi>.leg1 SPN_fgh.Prj\<^sub>0"
 
     abbreviation tuple_ABC
     where "tuple_ABC \<equiv> Maps.tuple SPN_fgh.Prj\<^sub>1\<^sub>1
                                     SPN_fgh.\<mu>.leg0
                                     (SPN_fgh.\<nu>.leg1 \<odot> SPN_fgh.\<nu>\<pi>.prj\<^sub>1)
                                   tuple_BC"
 
     abbreviation tuple_BC'
     where "tuple_BC' \<equiv> Maps.tuple \<lbrakk>\<lbrakk>Tfg.\<rho>\<sigma>.p\<^sub>0 \<star> TTfgh.p\<^sub>1\<rbrakk>\<rbrakk> \<lbrakk>\<lbrakk>tab\<^sub>0 g\<rbrakk>\<rbrakk> \<lbrakk>\<lbrakk>tab\<^sub>1 h\<rbrakk>\<rbrakk> \<lbrakk>\<lbrakk>TTfgh.p\<^sub>0\<rbrakk>\<rbrakk>"
 
     abbreviation tuple_ABC'
     where "tuple_ABC' \<equiv> Maps.tuple \<lbrakk>\<lbrakk>Tfg.\<rho>\<sigma>.p\<^sub>1 \<star> TTfgh.p\<^sub>1\<rbrakk>\<rbrakk>
                                       \<lbrakk>\<lbrakk>tab\<^sub>0 f\<rbrakk>\<rbrakk> \<lbrakk>\<lbrakk>tab\<^sub>1 g \<star> Tgh.\<rho>\<sigma>.p\<^sub>1\<rbrakk>\<rbrakk>
                                    tuple_BC'"
 
     lemma csq:
     shows "Maps.commutative_square SPN_fgh.\<nu>.leg0 SPN_fgh.\<pi>.leg1
                                     SPN_fgh.Prj\<^sub>0\<^sub>1 SPN_fgh.Prj\<^sub>0"
     and "Maps.commutative_square SPN_fgh.\<mu>.leg0 (SPN_fgh.\<nu>.leg1 \<odot> SPN_fgh.\<nu>\<pi>.prj\<^sub>1)
                                  SPN_fgh.Prj\<^sub>1\<^sub>1 tuple_BC"
     proof -
       show 1: "Maps.commutative_square SPN_fgh.\<nu>.leg0 SPN_fgh.\<pi>.leg1
                                        SPN_fgh.Prj\<^sub>0\<^sub>1 SPN_fgh.Prj\<^sub>0"
       proof
         show "Maps.cospan SPN_fgh.\<nu>.leg0 SPN_fgh.\<pi>.leg1"
           using SPN_fgh.\<nu>\<pi>.legs_form_cospan(1) by simp
         show "Maps.span SPN_fgh.Prj\<^sub>0\<^sub>1 SPN_fgh.Prj\<^sub>0"
           using SPN_fgh.prj_simps(2-3,5-6) by presburger
         show "Maps.dom SPN_fgh.\<nu>.leg0 = Maps.cod SPN_fgh.Prj\<^sub>0\<^sub>1"
           using SPN_fgh.prj_simps(8) SPN_g.dom.is_span SPN_g.dom.leg_simps(2)
           by auto
         show "SPN_fgh.\<nu>.leg0 \<odot> SPN_fgh.Prj\<^sub>0\<^sub>1 = SPN_fgh.\<pi>.leg1 \<odot> SPN_fgh.Prj\<^sub>0"
           by (metis (no_types, lifting) Maps.cod_comp Maps.comp_assoc
               Maps.pullback_commutes' SPN_fgh.\<mu>\<nu>.dom.leg_simps(1)
               SPN_fgh.\<mu>\<nu>.leg0_composite SPN_fgh.cospan_\<nu>\<pi>)
       qed
       show "Maps.commutative_square
               SPN_fgh.\<mu>.leg0 (Maps.comp SPN_fgh.\<nu>.leg1 SPN_fgh.\<nu>\<pi>.prj\<^sub>1)
               SPN_fgh.Prj\<^sub>1\<^sub>1 tuple_BC"
       proof
         show "Maps.cospan SPN_fgh.\<mu>.leg0 (SPN_fgh.\<nu>.leg1 \<odot> SPN_fgh.\<nu>\<pi>.prj\<^sub>1)"
           using fg gh SPN_fgh.prj_simps(10) by blast
         show "Maps.span SPN_fgh.Prj\<^sub>1\<^sub>1 tuple_BC"
           using fg gh 1 Maps.tuple_simps(1) Maps.tuple_simps(2) SPN_fgh.prj_simps(1)
                 SPN_fgh.prj_simps(4) SPN_fgh.prj_simps(5)
           by presburger
         show "Maps.dom SPN_fgh.\<mu>.leg0 = Maps.cod SPN_fgh.Prj\<^sub>1\<^sub>1"
           using fg gh SPN_f.dom.leg_simps(2) SPN_fgh.prj_simps(7) by auto
         show "SPN_fgh.\<mu>.leg0 \<odot> SPN_fgh.Prj\<^sub>1\<^sub>1 = (SPN_fgh.\<nu>.leg1 \<odot> SPN_fgh.\<nu>\<pi>.prj\<^sub>1) \<odot> tuple_BC"
           using 1 fg gh Maps.comp_assoc Maps.prj_tuple
           by (metis (no_types, lifting) Maps.pullback_commutes' SPN_fgh.cospan_\<mu>\<nu>)
       qed
     qed
 
     lemma tuple_ABC_eq_ABC':
     shows "tuple_BC = tuple_BC'"
     and "tuple_ABC = tuple_ABC'"
     proof -
       have "SPN_fgh.Prj\<^sub>1\<^sub>1 = \<lbrakk>\<lbrakk>Tfg.\<rho>\<sigma>.p\<^sub>1 \<star> TTfgh.p\<^sub>1\<rbrakk>\<rbrakk>"
         using prj_char by simp
       moreover have "SPN_fgh.\<mu>.leg0 = \<lbrakk>\<lbrakk>tab\<^sub>0 f\<rbrakk>\<rbrakk>"
         by simp
       moreover have "SPN_fgh.\<nu>.leg1 \<odot> SPN_fgh.\<nu>\<pi>.prj\<^sub>1 = \<lbrakk>\<lbrakk>tab\<^sub>1 g \<star> Tgh.\<rho>\<sigma>.p\<^sub>1\<rbrakk>\<rbrakk>"
         using Tgh.\<rho>\<sigma>.prj_char isomorphic_reflexive Tgh.composable
               Maps.comp_CLS [of "tab\<^sub>1 g" Tgh.\<rho>\<sigma>.p\<^sub>1 "tab\<^sub>1 g \<star> Tgh.\<rho>\<sigma>.p\<^sub>1"]
         by (simp add: g.T0.antipar(2))
       moreover show "tuple_BC = tuple_BC'"
         using prj_char Tfg.\<rho>\<sigma>.prj_char by simp
       ultimately show "tuple_ABC = tuple_ABC'"
         by argo
     qed
 
     lemma tuple_BC_in_hom:
     shows "Maps.in_hom tuple_BC (Maps.MkIde (src TTfgh.p\<^sub>0)) (Maps.MkIde (src Tgh.\<rho>\<sigma>.p\<^sub>0))"
     proof
       show 1: "Maps.arr tuple_BC"
         using csq(1) by simp
       have 2: "Maps.commutative_square
                  \<lbrakk>\<lbrakk>tab\<^sub>0 g\<rbrakk>\<rbrakk> \<lbrakk>\<lbrakk>tab\<^sub>1 h\<rbrakk>\<rbrakk> \<lbrakk>\<lbrakk>Tfg.\<rho>\<sigma>.p\<^sub>0 \<star> TTfgh.p\<^sub>1\<rbrakk>\<rbrakk> \<lbrakk>\<lbrakk>TTfgh.p\<^sub>0\<rbrakk>\<rbrakk>"
         by (metis Tfg.S\<^sub>0_def Tfg.span_legs_eq(3) Tgh.S\<^sub>1_def Tgh.span_legs_eq(4) csq(1)
                   prj_char(2) prj_char(3))
       show "Maps.dom tuple_BC = Maps.MkIde (src TTfgh.p\<^sub>0)"
       proof -
         have "Maps.dom tuple_BC' = Maps.dom \<lbrakk>\<lbrakk>Tfg.\<rho>\<sigma>.p\<^sub>0 \<star> TTfgh.p\<^sub>1\<rbrakk>\<rbrakk>"
           using 2 Maps.tuple_simps by simp
         also have "... = Chn (Span.hcomp (Span.hcomp (SPN f) (SPN g)) (SPN h))"
           using Maps.dom_char
           by (metis SPN_fgh.prj_simps(5) prj_char(2))
         also have "... = Maps.MkIde (src TTfgh.p\<^sub>0)"
           using 1 fg gh Maps.dom_char csq(1) prj_char(3) tuple_ABC_eq_ABC'(1)
                 Maps.Dom.simps(1) Maps.tuple_simps(2) SPN_fgh.prj_simps(3,5-6)
           by presburger
         finally have "Maps.dom tuple_BC' = Maps.MkIde (src TTfgh.p\<^sub>0)"
           by blast
         thus ?thesis
           using tuple_ABC_eq_ABC' by simp
       qed
       show "Maps.cod tuple_BC = Maps.MkIde (src Tgh.\<rho>\<sigma>.p\<^sub>0)"
       proof -
         have "Maps.cod tuple_BC' = Maps.pbdom \<lbrakk>\<lbrakk>tab\<^sub>0 g\<rbrakk>\<rbrakk> \<lbrakk>\<lbrakk>tab\<^sub>1 h\<rbrakk>\<rbrakk>"
           using 1 2 fg gh Maps.tuple_in_hom by blast
         also have "... = Maps.MkIde (src Tgh.\<rho>\<sigma>.p\<^sub>0)"
           using 1 2 fg gh Maps.pbdom_def
           by (metis (no_types, lifting) SPN.preserves_ide SPN_fgh.\<nu>\<pi>.are_identities(2)
               SPN_fgh.\<nu>\<pi>.composable Span.chine_hcomp_ide_ide Tfg.S\<^sub>0_def Tfg.span_legs_eq(3)
               Tgh.S\<^sub>1_def Tgh.chine_hcomp_SPN_SPN Tgh.span_legs_eq(4) g.is_ide)
         finally show ?thesis
           using tuple_ABC_eq_ABC' by simp
       qed
     qed
 
     lemma tuple_ABC_in_hom:
     shows "Maps.in_hom tuple_ABC (Maps.MkIde (src TTfgh.p\<^sub>0)) (Maps.MkIde (src TfTgh.p\<^sub>0))"
     proof
       show 1: "Maps.arr tuple_ABC"
         using SPN_fgh.chine_assoc_def SPN_fgh.chine_assoc_in_hom by auto
       show "Maps.dom tuple_ABC = Maps.MkIde (src TTfgh.p\<^sub>0)"
       proof -
         have "Maps.dom tuple_ABC = Maps.dom SPN_fgh.chine_assoc"
           by (simp add: SPN_fgh.chine_assoc_def)
         also have "... = Chn ((SPN f \<circ> SPN g) \<circ> SPN h)"
           using SPN_fgh.chine_assoc_in_hom by blast
         also have "... = Maps.MkIde (src TTfgh.p\<^sub>0)"
           by (metis (lifting) Maps.Dom.simps(1) Maps.dom_char SPN_fgh.prj_simps(3)
               SPN_fgh.prj_simps(6) prj_char(3))
         finally show ?thesis by blast
       qed
       show "Maps.cod tuple_ABC = Maps.MkIde (src TfTgh.p\<^sub>0)"
       proof -
         have "Maps.cod tuple_ABC = Maps.cod SPN_fgh.chine_assoc"
           by (simp add: SPN_fgh.chine_assoc_def)
         also have 1: "... = Chn (SPN f \<circ> SPN g \<circ> SPN h)"
           using SPN_fgh.chine_assoc_in_hom by blast
         also have "... = Maps.MkIde (src TfTgh.p\<^sub>0)"
           by (metis (lifting) Maps.Dom.simps(1) Maps.cod_char Maps.seq_char
               SPN_fgh.prj_chine_assoc(1) SPN_fgh.prj_simps(1) TfTgh.leg1_in_hom(1)
               TfTgh_TfTgh.u_in_hom 1 in_hhomE prj_char(4) src_hcomp)
         finally show ?thesis by argo
       qed
     qed
 
     lemma Chn_RHS_eq:
     shows "Chn RHS = \<lbrakk>\<lbrakk>TfHgh_HfHgh.chine\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>TfTgh_TfHgh.chine\<rbrakk>\<rbrakk> \<odot> tuple_ABC'"
     proof -
       have "Chn RHS =
             Chn (\<Phi>.map (f, g \<star> h)) \<odot> Chn (SPN f \<circ> \<Phi>.map (g, h)) \<odot>
               Chn (Span.assoc (SPN f) (SPN g) (SPN h))"
       proof -
         have "Chn RHS = Chn (\<Phi>.map (f, g \<star> h)) \<odot>
                           Chn ((SPN f \<circ> \<Phi>.map (g, h)) \<bullet> Span.assoc (SPN f) (SPN g) (SPN h))"
           using arr_RHS Span.vcomp_eq Span.Chn_vcomp by blast
         also have "... = Chn (\<Phi>.map (f, g \<star> h)) \<odot> Chn (SPN f \<circ> \<Phi>.map (g, h)) \<odot>
                            Chn (Span.assoc (SPN f) (SPN g) (SPN h))"
         proof -
           have "Span.seq (SPN f \<circ> \<Phi>.map (g, h)) (Span.assoc (SPN f) (SPN g) (SPN h))"
             using arr_RHS by auto
           thus ?thesis
             using fg gh Span.vcomp_eq [of "SPN f \<circ> \<Phi>.map (g, h)"
                                           "Span.assoc (SPN f) (SPN g) (SPN h)"]
             by simp
         qed
         finally show ?thesis by blast
       qed
       moreover have "Chn (\<Phi>.map (f, g \<star> h)) = \<lbrakk>\<lbrakk>TfHgh_HfHgh.chine\<rbrakk>\<rbrakk>"
         using arr_RHS fg gh \<Phi>.map_simp_ide VV.ide_char VV.arr_char CMP_def TfHgh.cmp_def
         by simp
       moreover have "Chn (SPN f \<circ> \<Phi>.map (g, h)) = Span.chine_hcomp (SPN f) (CMP g h)"
         using fg gh Span.hcomp_def \<Phi>.map_simp_ide VV.ide_char VV.arr_char SPN.FF_def
         by simp
       moreover have "Chn (Span.assoc (SPN f) (SPN g) (SPN h)) = tuple_ABC"
         using fg gh Span.\<alpha>_ide VVV.ide_char VVV.arr_char VV.ide_char VV.arr_char
               SPN_fgh.chine_assoc_def Span.\<alpha>_def
         by simp
       moreover have "Span.chine_hcomp (SPN f) (CMP g h) = \<lbrakk>\<lbrakk>TfTgh_TfHgh.chine\<rbrakk>\<rbrakk>"
       proof -
         have "Span.chine_hcomp (SPN f) (CMP g h) =
               Maps.tuple
                 (\<lbrakk>\<lbrakk>f.chine\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>TfTgh.p\<^sub>1\<rbrakk>\<rbrakk>)
                    \<lbrakk>\<lbrakk>tab\<^sub>0 f\<rbrakk>\<rbrakk> \<lbrakk>\<lbrakk>tab\<^sub>1 (g \<star> h)\<rbrakk>\<rbrakk>
                 (\<lbrakk>\<lbrakk>Tgh_Hgh.chine\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>TfTgh.p\<^sub>0\<rbrakk>\<rbrakk>)"
         proof -
           interpret f: span_in_category Maps.comp
                          \<open>\<lparr>Leg0 = Maps.MkArr (src (tab\<^sub>0 f)) (trg g) \<lbrakk>tab\<^sub>0 f\<rbrakk>,
                            Leg1 = Maps.MkArr (src (tab\<^sub>0 f)) (trg f) \<lbrakk>tab\<^sub>1 f\<rbrakk>\<rparr>\<close>
             using f.determines_span
             by (simp add: Tfg.composable)
           interpret f: arrow_of_tabulations_in_maps V H \<a> \<i> src trg
                         f f.tab \<open>tab\<^sub>0 f\<close> \<open>tab\<^sub>1 f\<close> f f.tab \<open>tab\<^sub>0 f\<close> \<open>tab\<^sub>1 f\<close> f
             using f.is_arrow_of_tabulations_in_maps by simp
           have "f.apex = Maps.CLS f.chine"
           proof (intro Maps.arr_eqI)
             show "Maps.arr f.apex" by simp
             show "Maps.arr \<lbrakk>\<lbrakk>f.chine\<rbrakk>\<rbrakk>"
               using Maps.CLS_in_hom f.is_map by blast
             show "Maps.Dom f.apex = Maps.Dom \<lbrakk>\<lbrakk>f.chine\<rbrakk>\<rbrakk>"
               using f.apex_def Tfg.RS_simps(2) Tfg.R\<^sub>0_def Tfg.composable by auto
             show "Maps.Cod f.apex = Maps.Cod \<lbrakk>\<lbrakk>f.chine\<rbrakk>\<rbrakk>"
               using f.apex_def Tfg.RS_simps(2) Tfg.R\<^sub>0_def Tfg.composable by auto
             show "Maps.Map f.apex = Maps.Map \<lbrakk>\<lbrakk>f.chine\<rbrakk>\<rbrakk>"
             proof -
               have "Maps.Map f.apex = \<lbrakk>src (tab\<^sub>0 f)\<rbrakk>"
                 using f.apex_def Maps.dom_char Tfg.RS_simps(2) Tfg.R\<^sub>0_def Tfg.composable
                 by auto
               also have "... = \<lbrakk>f.chine\<rbrakk>"
               proof (intro iso_class_eqI)
                 have "f.is_induced_map (src (tab\<^sub>0 f))"
                   using f.apex_is_induced_by_cell comp_cod_arr by auto
                 thus "src (tab\<^sub>0 f) \<cong> f.chine"
                   using f.induced_map_unique f.chine_is_induced_map by simp
               qed
               also have "... = Maps.Map \<lbrakk>\<lbrakk>f.chine\<rbrakk>\<rbrakk>"
                 by simp
               finally show ?thesis by simp
             qed
           qed
           thus ?thesis
             unfolding Span.chine_hcomp_def
             using fg gh CMP_def Tgh.\<rho>\<sigma>.prj_char Span.hcomp_def isomorphic_reflexive
                   Maps.comp_CLS [of "tab\<^sub>1 g" Tgh.\<rho>\<sigma>.p\<^sub>1 "tab\<^sub>1 g \<star> Tgh.\<rho>\<sigma>.p\<^sub>1"]
                   Tgh.cmp_def TfTgh.prj_char
             by simp
         qed
         also have "... = Maps.tuple \<lbrakk>\<lbrakk>f.chine \<star> TfTgh.p\<^sub>1\<rbrakk>\<rbrakk>
                                       \<lbrakk>\<lbrakk>tab\<^sub>0 f\<rbrakk>\<rbrakk> \<lbrakk>\<lbrakk>tab\<^sub>1 (g \<star> h)\<rbrakk>\<rbrakk>
                                     \<lbrakk>\<lbrakk>Tgh_Hgh.chine \<star> TfTgh.p\<^sub>0\<rbrakk>\<rbrakk>"
           using isomorphic_reflexive TfHgh.composable f.is_map TfHgh.composable Tgh_Hgh.is_map
                 Maps.comp_CLS [of f.chine TfTgh.p\<^sub>1 "f.chine \<star> TfTgh.p\<^sub>1"]
                 Maps.comp_CLS [of Tgh_Hgh.chine TfTgh.p\<^sub>0 "Tgh_Hgh.chine \<star> TfTgh.p\<^sub>0"]
           by auto
         also have "... = \<lbrakk>\<lbrakk>TfTgh_TfHgh.chine\<rbrakk>\<rbrakk>"
           using TfTgh_TfHgh.CLS_chine by simp
         finally show ?thesis by blast
       qed
       ultimately have "Chn RHS =\<lbrakk>\<lbrakk>TfHgh_HfHgh.chine\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>TfTgh_TfHgh.chine\<rbrakk>\<rbrakk> \<odot> tuple_ABC"
         by simp
       also have "... = \<lbrakk>\<lbrakk>TfHgh_HfHgh.chine\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>TfTgh_TfHgh.chine\<rbrakk>\<rbrakk> \<odot> tuple_ABC'"
         using tuple_ABC_eq_ABC' by simp
       finally show ?thesis by simp
     qed
 
     interpretation g\<^sub>0h\<^sub>1: cospan_of_maps_in_bicategory_of_spans V H \<a> \<i> src trg \<open>tab\<^sub>1 h\<close> \<open>tab\<^sub>0 g\<close>
       using gh by unfold_locales auto
     interpretation f\<^sub>0g\<^sub>1: cospan_of_maps_in_bicategory_of_spans V H \<a> \<i> src trg \<open>tab\<^sub>1 g\<close> \<open>tab\<^sub>0 f\<close>
       using fg by unfold_locales auto
     interpretation f\<^sub>0gh\<^sub>1: cospan_of_maps_in_bicategory_of_spans V H \<a> \<i> src trg
                             \<open>tab\<^sub>1 g \<star> Tgh.\<rho>\<sigma>.p\<^sub>1\<close> \<open>tab\<^sub>0 f\<close>
       using fg gh Tgh.\<rho>\<sigma>.leg1_is_map
       by unfold_locales auto
     interpretation fg\<^sub>0h\<^sub>1: cospan_of_maps_in_bicategory_of_spans V H \<a> \<i> src trg
                             \<open>tab\<^sub>1 h\<close> \<open>tab\<^sub>0 g \<star> Tfg.p\<^sub>0\<close>
       using TTfgh.r\<^sub>0s\<^sub>1_is_cospan by simp
 
     lemma src_tab_eq:
     shows "(\<a>\<^sup>-\<^sup>1[f, g, h] \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0) \<cdot>
               TfTgh.composite_cell TTfgh_TfTgh.chine TTfgh_TfTgh.the_\<theta> \<cdot> TTfgh_TfTgh.the_\<nu> =
            TTfgh.tab"
     proof -
       have "TfTgh.composite_cell TTfgh_TfTgh.chine TTfgh_TfTgh.the_\<theta> \<cdot> TTfgh_TfTgh.the_\<nu> =
             (\<a>[f, g, h] \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0) \<cdot> TTfgh.tab"
         unfolding TTfgh.tab_def
         using TTfgh_TfTgh.chine_is_induced_map TTfgh.tab_def TTfgh_TfTgh.\<Delta>_simps(4)
         by auto
       moreover have "iso (\<a>[f, g, h] \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0)"
         by (simp add: fg gh)
       moreover have "inv (\<a>[f, g, h] \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0) = \<a>\<^sup>-\<^sup>1[f, g, h] \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0"
         using fg gh by simp
       ultimately show ?thesis
         using TTfgh_TfTgh.\<Delta>_simps(1)
               invert_side_of_triangle(1)
                 [of "TfTgh.composite_cell TTfgh_TfTgh.chine TTfgh_TfTgh.the_\<theta> \<cdot> TTfgh_TfTgh.the_\<nu>"
                     "\<a>[f, g, h] \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0" TTfgh.tab]
         by argo
     qed
 
     text \<open>
       We need to show that the associativity isomorphism (defined in terms of tupling) coincides
       with \<open>TTfgh_TfTgh.chine\<close> (defined in terms of tabulations).  In order to do this,
       we need to know how the latter commutes with projections.  That is the purpose of
       the following lemma.  Unfortunately, it requires some lengthy calculations,
       which I haven't seen any way to avoid.
     \<close>
 
     lemma prj_chine:
     shows "\<lbrakk>\<lbrakk>TfTgh.p\<^sub>1 \<star> TTfgh_TfTgh.chine\<rbrakk>\<rbrakk> = \<lbrakk>\<lbrakk>Tfg.p\<^sub>1 \<star> TTfgh.p\<^sub>1\<rbrakk>\<rbrakk>"
     and "\<lbrakk>\<lbrakk>Tgh.p\<^sub>1 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine\<rbrakk>\<rbrakk> = \<lbrakk>\<lbrakk>Tfg.p\<^sub>0 \<star> TTfgh.p\<^sub>1\<rbrakk>\<rbrakk>"
     and "\<lbrakk>\<lbrakk>Tgh.p\<^sub>0 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine\<rbrakk>\<rbrakk> = \<lbrakk>\<lbrakk>TTfgh.p\<^sub>0\<rbrakk>\<rbrakk>"
     proof -
       have 1: "ide TfTgh.p\<^sub>1"
         by (simp add: TfTgh.composable)
       have 2: "ide TTfgh_TfTgh.chine"
         by simp
       have 3: "src TfTgh.p\<^sub>1 = trg TTfgh_TfTgh.chine"
         using TTfgh_TfTgh.chine_in_hom(1) by simp
       have 4: "src (tab\<^sub>1 f) = trg TfTgh.p\<^sub>1"
         using TfTgh.leg1_simps(2) by blast
       text \<open>
         The required isomorphisms will each be established via \<open>T2\<close>, using the equation
         \<open>src_tab_eq\<close> (associativities omitted from diagram):
 $$
 \begin{array}{l}
 \xymatrix{
   && \xtwocell[dddd]{}\omit{^{\rm the\_}\nu}
   & \scriptstyle{{\rm TTfgh}.{\rm apex}} \ar[dd]^{{\rm chine}} \ar[dddlll]_{{\rm TfTgh}.p_1} \ar[dddrrr]^{{\rm TfTgh}.p_0}
   & \xtwocell[dddd]{}\omit{^{\rm the\_}\theta} \\
   &&&&& \\
   &&& \scriptstyle{{\rm TfTgh.apex}} \ar[ddll]_{{\rm TfTgh}.p_1} \ar[dr]^{{\rm TfTgh}.p_0} && \\
   \scriptstyle{f.{\rm apex}} \ar[dd]_{f.{\rm tab}_1}
   && \dtwocell\omit{^<-7>{f_0gh_1.\phi}}
   && \scriptstyle{{\rm Tgh.apex}} \ar[dl]_{{\rm Tgh}.p_1} \ar[dr]^{{\rm Tgh}.p_0} \ddtwocell\omit{^{g_0h_1.\phi}}
   && \scriptstyle{h.{\rm apex}} \ar[dd]^{h.{\rm tab}_0} \\
   & \scriptstyle{f.{\rm apex}} \ar[dl]_{f.{\rm tab}_1} \ar[dr]^{f.{\rm tab}_0} \dtwocell\omit{^f.{\rm tab}}
   && \scriptstyle{g.{\rm apex}} \ar[dl]_{g.{\rm tab}_1} \ar[dr]^{g.{\rm tab}_0} \dtwocell\omit{^g.{\rm tab}}
   && \scriptstyle{h.{\rm apex}} \ar[dl]_{h.{\rm tab}_1} \ar[dr]^{h.{\rm tab}_0}  \dtwocell\omit{^h.{\rm tab}} \\  
   \scriptstyle{{\rm trg}~f} && \scriptstyle{{\rm src}~f = {\rm trg}~g} \ar[ll]^{f}
   && \scriptstyle{{\rm src}~g = {\rm trg}~h} \ar[ll]^{g} && \scriptstyle{{\rm src}~h} \ar[ll]^{h}
 }
 \\
 \\
 \hspace{7cm}=
 \\
 \\
 \xymatrix{
   &&& \scriptstyle{{\rm TTfgh.apex}} \ar[dl]_{{\rm TTfgh}.p_1} \ar[ddrr]^{{\rm TTfgh}.p_0} && \\
   && \scriptstyle{{\rm Tfg.apex}} \ar[dl]_{{\rm Tfg}.p_1} \ar[dr]^{{\rm Tfg}.p_0} \ddtwocell\omit{^{f_0g_1.\phi}}
   & \dtwocell\omit{^<-7>{fg_0h_1.\phi}} &&& \\
   & \scriptstyle{f.{\rm apex}} \ar[dl]_{f.{\rm tab}_1} \ar[dr]^{f.{\rm tab}_0} \dtwocell\omit{^f.{\rm tab}}
   && \scriptstyle{g.{\rm apex}} \ar[dl]_{g.{\rm tab}_1} \ar[dr]^{g.{\rm tab}_0} \dtwocell\omit{^g.{\rm tab}}
   && \scriptstyle{h.{\rm apex}} \ar[dl]_{h.{\rm tab}_1} \ar[dr]^{h.{\rm tab}_0}  \dtwocell\omit{^h.{\rm tab}} \\  
   \scriptstyle{{\rm trg}~f} && \scriptstyle{{\rm src}~f = {\rm trg}~g} \ar[ll]^{f}
   && \scriptstyle{{\rm src}~g = {\rm trg}~h} \ar[ll]^{g} && \scriptstyle{{\rm src}~h} \ar[ll]^{h}
 }
 \end{array}
 $$
         There is a sequential dependence between the proofs, such as we have already
         seen for \<open>horizontal_composite_of_arrows_of_tabulations_in_maps.prj_chine\<close>.
       \<close>
       define u\<^sub>f where "u\<^sub>f = g \<star> h \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0"
       define w\<^sub>f where "w\<^sub>f = Tfg.p\<^sub>1 \<star> TTfgh.p\<^sub>1"
       define w\<^sub>f' where "w\<^sub>f' = TfTgh.p\<^sub>1 \<star> TTfgh_TfTgh.chine"
       define \<theta>\<^sub>f
       where "\<theta>\<^sub>f = (g \<star> \<a>[h, tab\<^sub>0 h, TTfgh.p\<^sub>0]) \<cdot> (g \<star> h.tab \<star> TTfgh.p\<^sub>0) \<cdot> (g \<star> fg\<^sub>0h\<^sub>1.\<phi>) \<cdot>
                    \<a>[g, tab\<^sub>0 g \<star> Tfg.p\<^sub>0, TTfgh.p\<^sub>1] \<cdot> (\<a>[g, tab\<^sub>0 g, Tfg.p\<^sub>0] \<star> TTfgh.p\<^sub>1) \<cdot>
                    ((g.tab \<star> Tfg.p\<^sub>0) \<star> TTfgh.p\<^sub>1) \<cdot> (f\<^sub>0g\<^sub>1.\<phi> \<star> TTfgh.p\<^sub>1) \<cdot>
                    \<a>\<^sup>-\<^sup>1[tab\<^sub>0 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1]"
       define \<theta>\<^sub>f'
       where "\<theta>\<^sub>f' = (g \<star> h \<star> TTfgh_TfTgh.the_\<theta>) \<cdot>
                    can (\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> ((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                        (((\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>) \<cdot>
                    (((g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                    (((g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                    ((\<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                    (((g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                    (f\<^sub>0gh\<^sub>1.\<phi> \<star> TTfgh_TfTgh.chine) \<cdot>
                    \<a>\<^sup>-\<^sup>1[tab\<^sub>0 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine]"
       define \<beta>\<^sub>f
       where "\<beta>\<^sub>f = \<a>[tab\<^sub>1 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine] \<cdot>
                   TTfgh_TfTgh.the_\<nu> \<cdot>
                   \<a>\<^sup>-\<^sup>1[tab\<^sub>1 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1]"
       have w\<^sub>f: "ide w\<^sub>f"
         using w\<^sub>f_def fg\<^sub>0h\<^sub>1.p\<^sub>1_simps by auto
       have w\<^sub>f_is_map: "is_left_adjoint w\<^sub>f"
         using w\<^sub>f_def fg\<^sub>0h\<^sub>1.p\<^sub>1_simps
           by (simp add: left_adjoints_compose)
       have w\<^sub>f': "ide w\<^sub>f'"
         unfolding w\<^sub>f'_def by simp
       have w\<^sub>f'_is_map: "is_left_adjoint w\<^sub>f'"
         unfolding w\<^sub>f'_def
         using 3 TTfgh_TfTgh.is_map f\<^sub>0gh\<^sub>1.leg1_is_map
         by (simp add: left_adjoints_compose)
       have \<theta>\<^sub>f: "\<guillemotleft>\<theta>\<^sub>f : tab\<^sub>0 f \<star> w\<^sub>f \<Rightarrow> u\<^sub>f\<guillemotright>"
       proof (unfold \<theta>\<^sub>f_def w\<^sub>f_def u\<^sub>f_def, intro comp_in_homI)
         show "\<guillemotleft>\<a>\<^sup>-\<^sup>1[tab\<^sub>0 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1] :
                  tab\<^sub>0 f \<star> Tfg.p\<^sub>1 \<star> TTfgh.p\<^sub>1 \<Rightarrow> (tab\<^sub>0 f \<star> Tfg.p\<^sub>1) \<star> TTfgh.p\<^sub>1\<guillemotright>"
           using f\<^sub>0g\<^sub>1.leg1_simps fg\<^sub>0h\<^sub>1.p\<^sub>1_simps f\<^sub>0g\<^sub>1.cospan g\<^sub>0h\<^sub>1.cospan by auto
         show "\<guillemotleft>f\<^sub>0g\<^sub>1.\<phi> \<star> TTfgh.p\<^sub>1 :
                  (tab\<^sub>0 f \<star> Tfg.p\<^sub>1) \<star> TTfgh.p\<^sub>1 \<Rightarrow> (tab\<^sub>1 g \<star> Tfg.p\<^sub>0) \<star> TTfgh.p\<^sub>1\<guillemotright>"
           using f\<^sub>0g\<^sub>1.\<phi>_in_hom(2) Tfg.\<rho>\<sigma>.T0.antipar(1)
           by (intro hcomp_in_vhom, auto)
         show "\<guillemotleft>(g.tab \<star> Tfg.p\<^sub>0) \<star> TTfgh.p\<^sub>1 :
                  (tab\<^sub>1 g \<star> Tfg.p\<^sub>0) \<star> TTfgh.p\<^sub>1 \<Rightarrow> ((g \<star> tab\<^sub>0 g) \<star> Tfg.p\<^sub>0) \<star> TTfgh.p\<^sub>1\<guillemotright>"
           using Tfg.\<rho>\<sigma>.T0.antipar(1)
           by (intro hcomp_in_vhom, auto)
         show "\<guillemotleft>\<a>[g, tab\<^sub>0 g, Tfg.p\<^sub>0] \<star> TTfgh.p\<^sub>1 :
                  ((g \<star> tab\<^sub>0 g) \<star> Tfg.p\<^sub>0) \<star> TTfgh.p\<^sub>1 \<Rightarrow> (g \<star> tab\<^sub>0 g \<star> Tfg.p\<^sub>0) \<star> TTfgh.p\<^sub>1\<guillemotright>"
           using fg\<^sub>0h\<^sub>1.p\<^sub>1_simps
           by (intro hcomp_in_vhom, auto)
         show "\<guillemotleft>\<a>[g, tab\<^sub>0 g \<star> Tfg.p\<^sub>0, TTfgh.p\<^sub>1] :
                 (g \<star> tab\<^sub>0 g \<star> Tfg.p\<^sub>0) \<star> TTfgh.p\<^sub>1 \<Rightarrow> g \<star> (tab\<^sub>0 g \<star> Tfg.p\<^sub>0) \<star> TTfgh.p\<^sub>1\<guillemotright>"
           using fg\<^sub>0h\<^sub>1.p\<^sub>1_simps by auto
         show "\<guillemotleft>g \<star> fg\<^sub>0h\<^sub>1.\<phi> : g \<star> (tab\<^sub>0 g \<star> Tfg.p\<^sub>0) \<star> TTfgh.p\<^sub>1 \<Rightarrow> g \<star> tab\<^sub>1 h \<star> TTfgh.p\<^sub>0\<guillemotright>"
           using fg\<^sub>0h\<^sub>1.\<phi>_in_hom fg\<^sub>0h\<^sub>1.p\<^sub>1_simps
           by (intro hcomp_in_vhom, auto)
         show "\<guillemotleft>g \<star> h.tab \<star> TTfgh.p\<^sub>0 : g \<star> tab\<^sub>1 h \<star> TTfgh.p\<^sub>0 \<Rightarrow> g \<star> (h \<star> tab\<^sub>0 h) \<star> TTfgh.p\<^sub>0\<guillemotright>"
           using gh fg\<^sub>0h\<^sub>1.\<phi>_in_hom fg\<^sub>0h\<^sub>1.p\<^sub>1_simps
           by (intro hcomp_in_vhom, auto)
         show "\<guillemotleft>g \<star> \<a>[h, tab\<^sub>0 h, TTfgh.p\<^sub>0] :
                 g \<star> (h \<star> tab\<^sub>0 h) \<star> TTfgh.p\<^sub>0 \<Rightarrow> g \<star> h \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0\<guillemotright>"
           using gh fg\<^sub>0h\<^sub>1.\<phi>_in_hom fg\<^sub>0h\<^sub>1.p\<^sub>1_simps
           by (intro hcomp_in_vhom, auto)
       qed
       have \<theta>\<^sub>f': "\<guillemotleft>\<theta>\<^sub>f' : tab\<^sub>0 f \<star> w\<^sub>f' \<Rightarrow> u\<^sub>f\<guillemotright>"
       proof (unfold \<theta>\<^sub>f'_def w\<^sub>f'_def u\<^sub>f_def, intro comp_in_homI)
         show "\<guillemotleft>\<a>\<^sup>-\<^sup>1[tab\<^sub>0 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine] :
                  tab\<^sub>0 f \<star> TfTgh.p\<^sub>1 \<star> TTfgh_TfTgh.chine \<Rightarrow> (tab\<^sub>0 f \<star> TfTgh.p\<^sub>1) \<star> TTfgh_TfTgh.chine\<guillemotright>"
           using "1" "2" "3" "4" assoc'_in_hom(2) f.ide_u f.leg1_simps(3) by auto
         show "\<guillemotleft>f\<^sub>0gh\<^sub>1.\<phi> \<star> TTfgh_TfTgh.chine :
                  (tab\<^sub>0 f \<star> TfTgh.p\<^sub>1) \<star> TTfgh_TfTgh.chine \<Rightarrow>
                      ((tab\<^sub>1 g \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine\<guillemotright>"
           using f\<^sub>0gh\<^sub>1.\<phi>_in_hom(2)
           by (intro hcomp_in_vhom, auto)
         show "\<guillemotleft>((g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine :
                  ((tab\<^sub>1 g \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine
                          \<Rightarrow> (((g \<star> tab\<^sub>0 g) \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine\<guillemotright>"
           using f\<^sub>0gh\<^sub>1.cospan g\<^sub>0h\<^sub>1.cospan
           by (intro hcomp_in_vhom, auto)
         show "\<guillemotleft>(\<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine :
                  (((g \<star> tab\<^sub>0 g) \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine
                     \<Rightarrow> ((g \<star> tab\<^sub>0 g \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine\<guillemotright>"
           using f\<^sub>0gh\<^sub>1.cospan g\<^sub>0h\<^sub>1.cospan
           by (intro hcomp_in_vhom, auto)
         show "\<guillemotleft>((g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine :
                 ((g \<star> tab\<^sub>0 g \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine
                    \<Rightarrow> ((g \<star> tab\<^sub>1 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine\<guillemotright>"
           using f\<^sub>0gh\<^sub>1.cospan g\<^sub>0h\<^sub>1.cospan g\<^sub>0h\<^sub>1.\<phi>_in_hom(2)
           by (intro hcomp_in_vhom, auto)
         show "\<guillemotleft>((g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine :
                 ((g \<star> tab\<^sub>1 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine
                    \<Rightarrow> ((g \<star> (h \<star> tab\<^sub>0 h) \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine\<guillemotright>"
           using f\<^sub>0gh\<^sub>1.cospan g\<^sub>0h\<^sub>1.cospan
           by (intro hcomp_in_vhom, auto)
         show "\<guillemotleft>can (\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> ((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                    (((\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>) :
                    ((g \<star> (h \<star> tab\<^sub>0 h) \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine
                      \<Rightarrow> g \<star> h \<star> ((tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine\<guillemotright>"
           using f\<^sub>0gh\<^sub>1.cospan g\<^sub>0h\<^sub>1.cospan by auto
         show "\<guillemotleft>g \<star> h \<star> TTfgh_TfTgh.the_\<theta> :
                  g \<star> h \<star> ((tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine
                     \<Rightarrow> g \<star> h \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0\<guillemotright>"
           using f\<^sub>0gh\<^sub>1.cospan g\<^sub>0h\<^sub>1.cospan TTfgh_TfTgh.the_\<theta>_in_hom
           by (intro hcomp_in_vhom, auto)
       qed
       have \<beta>\<^sub>f: "\<guillemotleft>\<beta>\<^sub>f : tab\<^sub>1 f \<star> w\<^sub>f \<Rightarrow> tab\<^sub>1 f \<star> w\<^sub>f'\<guillemotright>"
       proof (unfold \<beta>\<^sub>f_def w\<^sub>f_def w\<^sub>f'_def, intro comp_in_homI)
         show "\<guillemotleft>\<a>\<^sup>-\<^sup>1[tab\<^sub>1 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1] :
                  tab\<^sub>1 f \<star> Tfg.p\<^sub>1 \<star> TTfgh.p\<^sub>1 \<Rightarrow> (tab\<^sub>1 f \<star> Tfg.p\<^sub>1) \<star> TTfgh.p\<^sub>1\<guillemotright>"
           using TTfgh.leg1_in_hom(2) assoc'_in_hom by auto
         show "\<guillemotleft>TTfgh_TfTgh.the_\<nu> :
                  (tab\<^sub>1 f \<star> Tfg.p\<^sub>1) \<star> TTfgh.p\<^sub>1 \<Rightarrow> (tab\<^sub>1 f \<star> TfTgh.p\<^sub>1) \<star> TTfgh_TfTgh.chine\<guillemotright>"
           using TTfgh_TfTgh.the_\<nu>_in_hom TTfgh_TfTgh.the_\<nu>_props by simp
         show "\<guillemotleft>\<a>[tab\<^sub>1 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine] :
                 (tab\<^sub>1 f \<star> TfTgh.p\<^sub>1) \<star> TTfgh_TfTgh.chine \<Rightarrow> tab\<^sub>1 f \<star> TfTgh.p\<^sub>1 \<star> TTfgh_TfTgh.chine\<guillemotright>"
           using 1 2 3 4 by auto
       qed
       have iso_\<beta>\<^sub>f: "iso \<beta>\<^sub>f"
         unfolding \<beta>\<^sub>f_def
         using 1 2 3 4 \<beta>\<^sub>f \<beta>\<^sub>f_def isos_compose
         apply (intro isos_compose)
             apply (metis TTfgh.composable TTfgh.leg1_in_hom(2) Tfg.\<rho>\<sigma>.T0.antipar(2)
                          Tfg.\<rho>\<sigma>.T0.ide_right Tfg.\<rho>\<sigma>.leg1_in_hom(2) Tfg_Hfg.u_simps(3)
                          f.T0.antipar(2) f.T0.ide_right f.ide_leg1 f\<^sub>0g\<^sub>1.cospan g.ide_leg1
                          h.ide_leg1 h.leg1_simps(4) hcomp_in_vhomE ide_hcomp
                          iso_assoc' tab\<^sub>1_simps(1))
         using TTfgh_TfTgh.the_\<nu>_props(2) f.ide_leg1 iso_assoc by blast+
       have u\<^sub>f: "ide u\<^sub>f"
         using \<theta>\<^sub>f ide_cod by blast
       have w\<^sub>f_in_hhom: "in_hhom w\<^sub>f (src u\<^sub>f) (src (tab\<^sub>0 f))"
         using u\<^sub>f w\<^sub>f u\<^sub>f_def w\<^sub>f_def by simp
       have w\<^sub>f'_in_hhom: "in_hhom w\<^sub>f' (src u\<^sub>f) (src (tab\<^sub>0 f))"
         using u\<^sub>f w\<^sub>f' w\<^sub>f'_def u\<^sub>f_def by simp
       have 5: "\<exists>!\<gamma>. \<guillemotleft>\<gamma> : w\<^sub>f \<Rightarrow> w\<^sub>f'\<guillemotright> \<and> \<beta>\<^sub>f = tab\<^sub>1 f \<star> \<gamma> \<and> \<theta>\<^sub>f = \<theta>\<^sub>f' \<cdot> (tab\<^sub>0 f \<star> \<gamma>)"
       proof -
         have eq\<^sub>f: "f.composite_cell w\<^sub>f \<theta>\<^sub>f = f.composite_cell w\<^sub>f' \<theta>\<^sub>f' \<cdot> \<beta>\<^sub>f"
         proof -
           text \<open>
             I don't see any alternative here to just grinding out the calculation.
             The idea is to bring \<open>f.composite_cell w\<^sub>f \<theta>\<^sub>f\<close> into a form in which
             \<open>src_tab_eq\<close> can be applied to eliminate \<open>\<theta>\<^sub>f\<close> in favor of \<open>\<theta>\<^sub>f'\<close>.
           \<close>
           have "f.composite_cell w\<^sub>f \<theta>\<^sub>f =
                   (f \<star> g \<star> \<a>[h, tab\<^sub>0 h, TTfgh.p\<^sub>0]) \<cdot>
                     (f \<star> g \<star> h.tab \<star> TTfgh.p\<^sub>0) \<cdot>
                     (f \<star> g \<star> fg\<^sub>0h\<^sub>1.\<phi>) \<cdot>
                     (f \<star> \<a>[g, tab\<^sub>0 g \<star> Tfg.p\<^sub>0, TTfgh.p\<^sub>1]) \<cdot>
                     (f \<star> \<a>[g, tab\<^sub>0 g, Tfg.p\<^sub>0] \<star> TTfgh.p\<^sub>1) \<cdot>
                     (f \<star> (g.tab \<star> Tfg.p\<^sub>0) \<star> TTfgh.p\<^sub>1) \<cdot>
                     (f \<star> f\<^sub>0g\<^sub>1.\<phi> \<star> TTfgh.p\<^sub>1) \<cdot>
                     (f \<star> \<a>\<^sup>-\<^sup>1[tab\<^sub>0 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1]) \<cdot>
                     \<a>[f, tab\<^sub>0 f, Tfg.p\<^sub>1 \<star> TTfgh.p\<^sub>1] \<cdot>
                     (f.tab \<star> Tfg.p\<^sub>1 \<star> TTfgh.p\<^sub>1)"
             unfolding w\<^sub>f_def \<theta>\<^sub>f_def
             using fg\<^sub>0h\<^sub>1.p\<^sub>1_simps Tgh.composable whisker_left comp_assoc
             by simp (* 20 sec *)
           also have "... =
                        (\<a>[f, g, h \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                          \<a>\<^sup>-\<^sup>1[f, g, h \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                          (f \<star> g \<star> \<a>[h, tab\<^sub>0 h, TTfgh.p\<^sub>0])) \<cdot>
                        (f \<star> g \<star> h.tab \<star> TTfgh.p\<^sub>0) \<cdot>
                        (f \<star> g \<star> fg\<^sub>0h\<^sub>1.\<phi>) \<cdot>
                        (f \<star> \<a>[g, tab\<^sub>0 g \<star> Tfg.p\<^sub>0, TTfgh.p\<^sub>1]) \<cdot>
                        (f \<star> \<a>[g, tab\<^sub>0 g, Tfg.p\<^sub>0] \<star> TTfgh.p\<^sub>1) \<cdot>
                        (f \<star> (g.tab \<star> Tfg.p\<^sub>0) \<star> TTfgh.p\<^sub>1) \<cdot>
                        (f \<star> f\<^sub>0g\<^sub>1.\<phi> \<star> TTfgh.p\<^sub>1) \<cdot>
                        (f \<star> \<a>\<^sup>-\<^sup>1[tab\<^sub>0 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1]) \<cdot>
                        \<a>[f, tab\<^sub>0 f, Tfg.p\<^sub>1 \<star> TTfgh.p\<^sub>1] \<cdot>
                        (f.tab \<star> Tfg.p\<^sub>1 \<star> TTfgh.p\<^sub>1)"
           proof -
             have "(\<a>[f, g, h \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                     \<a>\<^sup>-\<^sup>1[f, g, h \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0]) \<cdot>
                     (f \<star> g \<star> \<a>[h, tab\<^sub>0 h, TTfgh.p\<^sub>0]) =
                   f \<star> g \<star> \<a>[h, tab\<^sub>0 h, TTfgh.p\<^sub>0]"
               using fg gh fg\<^sub>0h\<^sub>1.p\<^sub>1_simps comp_cod_arr comp_assoc_assoc' by simp
             thus ?thesis
               using comp_assoc by simp
           qed
           also have "... =
                        \<a>[f, g, h \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                        (\<a>\<^sup>-\<^sup>1[f, g, h \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                          (f \<star> g \<star> \<a>[h, tab\<^sub>0 h, TTfgh.p\<^sub>0])) \<cdot>
                        (f \<star> g \<star> h.tab \<star> TTfgh.p\<^sub>0) \<cdot>
                        (f \<star> g \<star> fg\<^sub>0h\<^sub>1.\<phi>) \<cdot>
                        (f \<star> \<a>[g, tab\<^sub>0 g \<star> Tfg.p\<^sub>0, TTfgh.p\<^sub>1]) \<cdot>
                        (f \<star> \<a>[g, tab\<^sub>0 g, Tfg.p\<^sub>0] \<star> TTfgh.p\<^sub>1) \<cdot>
                        (f \<star> (g.tab \<star> Tfg.p\<^sub>0) \<star> TTfgh.p\<^sub>1) \<cdot>
                        (f \<star> f\<^sub>0g\<^sub>1.\<phi> \<star> TTfgh.p\<^sub>1) \<cdot>
                        (f \<star> \<a>\<^sup>-\<^sup>1[tab\<^sub>0 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1]) \<cdot>
                        \<a>[f, tab\<^sub>0 f, Tfg.p\<^sub>1 \<star> TTfgh.p\<^sub>1] \<cdot>
                        (f.tab \<star> Tfg.p\<^sub>1 \<star> TTfgh.p\<^sub>1)"
             using comp_assoc by presburger
           also have "... =
                        \<a>[f, g, h \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                        ((f \<star> g) \<star> \<a>[h, tab\<^sub>0 h, TTfgh.p\<^sub>0]) \<cdot>
                        (\<a>\<^sup>-\<^sup>1[f, g, (h \<star> tab\<^sub>0 h) \<star> TTfgh.p\<^sub>0] \<cdot>
                        (f \<star> g \<star> h.tab \<star> TTfgh.p\<^sub>0)) \<cdot>
                        (f \<star> g \<star> fg\<^sub>0h\<^sub>1.\<phi>) \<cdot>
                        (f \<star> \<a>[g, tab\<^sub>0 g \<star> Tfg.p\<^sub>0, TTfgh.p\<^sub>1]) \<cdot>
                        (f \<star> \<a>[g, tab\<^sub>0 g, Tfg.p\<^sub>0] \<star> TTfgh.p\<^sub>1) \<cdot>
                        (f \<star> (g.tab \<star> Tfg.p\<^sub>0) \<star> TTfgh.p\<^sub>1) \<cdot>
                        (f \<star> f\<^sub>0g\<^sub>1.\<phi> \<star> TTfgh.p\<^sub>1) \<cdot>
                        (f \<star> \<a>\<^sup>-\<^sup>1[tab\<^sub>0 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1]) \<cdot>
                        \<a>[f, tab\<^sub>0 f, Tfg.p\<^sub>1 \<star> TTfgh.p\<^sub>1] \<cdot>
                        (f.tab \<star> Tfg.p\<^sub>1 \<star> TTfgh.p\<^sub>1)"
             using fg gh fg\<^sub>0h\<^sub>1.p\<^sub>0_simps fg\<^sub>0h\<^sub>1.p\<^sub>1_simps comp_assoc
                   assoc'_naturality [of f g "\<a>[h, tab\<^sub>0 h, TTfgh.p\<^sub>0]"]
             by simp
           also have "... =
                        \<a>[f, g, h \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                        ((f \<star> g) \<star> \<a>[h, tab\<^sub>0 h, TTfgh.p\<^sub>0]) \<cdot>
                        ((f \<star> g) \<star> h.tab \<star> TTfgh.p\<^sub>0) \<cdot>
                        (\<a>\<^sup>-\<^sup>1[f, g, tab\<^sub>1 h \<star> TTfgh.p\<^sub>0] \<cdot>
                        (f \<star> g \<star> fg\<^sub>0h\<^sub>1.\<phi>)) \<cdot>
                        (f \<star> \<a>[g, tab\<^sub>0 g \<star> Tfg.p\<^sub>0, TTfgh.p\<^sub>1]) \<cdot>
                        (f \<star> \<a>[g, tab\<^sub>0 g, Tfg.p\<^sub>0] \<star> TTfgh.p\<^sub>1) \<cdot>
                        (f \<star> (g.tab \<star> Tfg.p\<^sub>0) \<star> TTfgh.p\<^sub>1) \<cdot>
                        (f \<star> f\<^sub>0g\<^sub>1.\<phi> \<star> TTfgh.p\<^sub>1) \<cdot>
                        (f \<star> \<a>\<^sup>-\<^sup>1[tab\<^sub>0 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1]) \<cdot>
                        \<a>[f, tab\<^sub>0 f, Tfg.p\<^sub>1 \<star> TTfgh.p\<^sub>1] \<cdot>
                        (f.tab \<star> Tfg.p\<^sub>1 \<star> TTfgh.p\<^sub>1)"
             using fg gh fg\<^sub>0h\<^sub>1.p\<^sub>0_simps fg\<^sub>0h\<^sub>1.p\<^sub>1_simps comp_assoc
                   assoc'_naturality [of f g "h.tab \<star> TTfgh.p\<^sub>0"]
             by simp
           also have "... =
                        \<a>[f, g, h \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                        ((f \<star> g) \<star> \<a>[h, tab\<^sub>0 h, TTfgh.p\<^sub>0]) \<cdot>
                        ((f \<star> g) \<star> h.tab \<star> TTfgh.p\<^sub>0) \<cdot>
                        ((f \<star> g) \<star> fg\<^sub>0h\<^sub>1.\<phi>) \<cdot>
                        \<a>\<^sup>-\<^sup>1[f, g, (tab\<^sub>0 g \<star> Tfg.p\<^sub>0) \<star> TTfgh.p\<^sub>1] \<cdot>
                        (f \<star> \<a>[g, tab\<^sub>0 g \<star> Tfg.p\<^sub>0, TTfgh.p\<^sub>1]) \<cdot>
                        (f \<star> \<a>[g, tab\<^sub>0 g, Tfg.p\<^sub>0] \<star> TTfgh.p\<^sub>1) \<cdot>
                        (f \<star> (g.tab \<star> Tfg.p\<^sub>0) \<star> TTfgh.p\<^sub>1) \<cdot>
                        (f \<star> f\<^sub>0g\<^sub>1.\<phi> \<star> TTfgh.p\<^sub>1) \<cdot>
                        ((f \<star> \<a>\<^sup>-\<^sup>1[tab\<^sub>0 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1]) \<cdot>
                        \<a>[f, tab\<^sub>0 f, Tfg.p\<^sub>1 \<star> TTfgh.p\<^sub>1]) \<cdot>
                        (f.tab \<star> Tfg.p\<^sub>1 \<star> TTfgh.p\<^sub>1)"
             using fg gh fg\<^sub>0h\<^sub>1.p\<^sub>0_simps fg\<^sub>0h\<^sub>1.p\<^sub>1_simps comp_assoc
                   assoc'_naturality [of f g fg\<^sub>0h\<^sub>1.\<phi>]
             by simp
           also have "... =
                        \<a>[f, g, h \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                        ((f \<star> g) \<star> \<a>[h, tab\<^sub>0 h, TTfgh.p\<^sub>0]) \<cdot>
                        ((f \<star> g) \<star> h.tab \<star> TTfgh.p\<^sub>0) \<cdot>
                        ((f \<star> g) \<star> fg\<^sub>0h\<^sub>1.\<phi>) \<cdot>
                        \<a>\<^sup>-\<^sup>1[f, g, (tab\<^sub>0 g \<star> Tfg.p\<^sub>0) \<star> TTfgh.p\<^sub>1] \<cdot>
                        (f \<star> \<a>[g, tab\<^sub>0 g \<star> Tfg.p\<^sub>0, TTfgh.p\<^sub>1]) \<cdot>
                        (f \<star> \<a>[g, tab\<^sub>0 g, Tfg.p\<^sub>0] \<star> TTfgh.p\<^sub>1) \<cdot>
                        (f \<star> (g.tab \<star> Tfg.p\<^sub>0) \<star> TTfgh.p\<^sub>1) \<cdot>
                        ((f \<star> f\<^sub>0g\<^sub>1.\<phi> \<star> TTfgh.p\<^sub>1) \<cdot>
                        \<a>[f, tab\<^sub>0 f \<star> Tfg.p\<^sub>1, TTfgh.p\<^sub>1]) \<cdot>
                        (\<a>[f, tab\<^sub>0 f, Tfg.p\<^sub>1] \<star> TTfgh.p\<^sub>1) \<cdot>
                        \<a>\<^sup>-\<^sup>1[f \<star> tab\<^sub>0 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1] \<cdot>
                        (f.tab \<star> Tfg.p\<^sub>1 \<star> TTfgh.p\<^sub>1)"
           proof -
             have "(f \<star> \<a>\<^sup>-\<^sup>1[tab\<^sub>0 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1]) \<cdot> \<a>[f, tab\<^sub>0 f, Tfg.p\<^sub>1 \<star> TTfgh.p\<^sub>1] =
                   \<a>[f, tab\<^sub>0 f \<star> Tfg.p\<^sub>1, TTfgh.p\<^sub>1] \<cdot> (\<a>[f, tab\<^sub>0 f, Tfg.p\<^sub>1] \<star> TTfgh.p\<^sub>1) \<cdot>
                     \<a>\<^sup>-\<^sup>1[f \<star> tab\<^sub>0 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1]"
             proof -
               have "(f \<star> \<a>\<^sup>-\<^sup>1[tab\<^sub>0 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1]) \<cdot> \<a>[f, tab\<^sub>0 f, Tfg.p\<^sub>1 \<star> TTfgh.p\<^sub>1] =
                     \<lbrace>(\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<a>\<^sup>-\<^sup>1\<^bold>[\<^bold>\<langle>tab\<^sub>0 f\<^bold>\<rangle>, \<^bold>\<langle>Tfg.p\<^sub>1\<^bold>\<rangle>, \<^bold>\<langle>TTfgh.p\<^sub>1\<^bold>\<rangle>\<^bold>]) \<^bold>\<cdot>
                               \<^bold>\<a>\<^bold>[\<^bold>\<langle>f\<^bold>\<rangle>, \<^bold>\<langle>tab\<^sub>0 f\<^bold>\<rangle>, \<^bold>\<langle>Tfg.p\<^sub>1\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TTfgh.p\<^sub>1\<^bold>\<rangle>\<^bold>]\<rbrace>"
                 using fg gh fg\<^sub>0h\<^sub>1.p\<^sub>0_simps fg\<^sub>0h\<^sub>1.p\<^sub>1_simps f\<^sub>0g\<^sub>1.p\<^sub>0_simps f\<^sub>0g\<^sub>1.p\<^sub>1_simps
                       \<a>'_def \<alpha>_def
                 by simp
               also have "... =
                          \<lbrace>\<^bold>\<a>\<^bold>[\<^bold>\<langle>f\<^bold>\<rangle>, \<^bold>\<langle>tab\<^sub>0 f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tfg.p\<^sub>1\<^bold>\<rangle>, \<^bold>\<langle>TTfgh.p\<^sub>1\<^bold>\<rangle>\<^bold>] \<^bold>\<cdot>
                           (\<^bold>\<a>\<^bold>[\<^bold>\<langle>f\<^bold>\<rangle>, \<^bold>\<langle>tab\<^sub>0 f\<^bold>\<rangle>, \<^bold>\<langle>Tfg.p\<^sub>1\<^bold>\<rangle>\<^bold>] \<^bold>\<star> \<^bold>\<langle>TTfgh.p\<^sub>1\<^bold>\<rangle>) \<^bold>\<cdot>
                           \<^bold>\<a>\<^sup>-\<^sup>1\<^bold>[\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 f\<^bold>\<rangle>, \<^bold>\<langle>Tfg.p\<^sub>1\<^bold>\<rangle>, \<^bold>\<langle>TTfgh.p\<^sub>1\<^bold>\<rangle>\<^bold>]\<rbrace>"
                 using fg gh fg\<^sub>0h\<^sub>1.p\<^sub>0_simps fg\<^sub>0h\<^sub>1.p\<^sub>1_simps f\<^sub>0g\<^sub>1.p\<^sub>0_simps f\<^sub>0g\<^sub>1.p\<^sub>1_simps
                 by (intro E.eval_eqI, simp_all)
               also have "... = \<a>[f, tab\<^sub>0 f \<star> Tfg.p\<^sub>1, TTfgh.p\<^sub>1] \<cdot> (\<a>[f, tab\<^sub>0 f, Tfg.p\<^sub>1] \<star> TTfgh.p\<^sub>1) \<cdot>
                                  \<a>\<^sup>-\<^sup>1[f \<star> tab\<^sub>0 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1]"
                 using fg gh fg\<^sub>0h\<^sub>1.p\<^sub>0_simps fg\<^sub>0h\<^sub>1.p\<^sub>1_simps f\<^sub>0g\<^sub>1.p\<^sub>0_simps f\<^sub>0g\<^sub>1.p\<^sub>1_simps
                       \<a>'_def \<alpha>_def
                 by simp
               finally show ?thesis by blast
             qed
             thus ?thesis
               using comp_assoc by presburger
           qed
           also have "... =
                        \<a>[f, g, h \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                        ((f \<star> g) \<star> \<a>[h, tab\<^sub>0 h, TTfgh.p\<^sub>0]) \<cdot>
                        ((f \<star> g) \<star> h.tab \<star> TTfgh.p\<^sub>0) \<cdot>
                        ((f \<star> g) \<star> fg\<^sub>0h\<^sub>1.\<phi>) \<cdot>
                        \<a>\<^sup>-\<^sup>1[f, g, (tab\<^sub>0 g \<star> Tfg.p\<^sub>0) \<star> TTfgh.p\<^sub>1] \<cdot>
                        (f \<star> \<a>[g, tab\<^sub>0 g \<star> Tfg.p\<^sub>0, TTfgh.p\<^sub>1]) \<cdot>
                        (f \<star> \<a>[g, tab\<^sub>0 g, Tfg.p\<^sub>0] \<star> TTfgh.p\<^sub>1) \<cdot>
                        ((f \<star> (g.tab \<star> Tfg.p\<^sub>0) \<star> TTfgh.p\<^sub>1) \<cdot>
                        \<a>[f, tab\<^sub>1 g \<star> Tfg.p\<^sub>0, TTfgh.p\<^sub>1]) \<cdot>
                        ((f \<star> f\<^sub>0g\<^sub>1.\<phi>) \<star> TTfgh.p\<^sub>1) \<cdot>
                        (\<a>[f, tab\<^sub>0 f, Tfg.p\<^sub>1] \<star> TTfgh.p\<^sub>1) \<cdot>
                        \<a>\<^sup>-\<^sup>1[f \<star> tab\<^sub>0 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1] \<cdot>
                        (f.tab \<star> Tfg.p\<^sub>1 \<star> TTfgh.p\<^sub>1)"
           proof -
             have "(f \<star> f\<^sub>0g\<^sub>1.\<phi> \<star> TTfgh.p\<^sub>1) \<cdot> \<a>[f, tab\<^sub>0 f \<star> Tfg.p\<^sub>1, TTfgh.p\<^sub>1] =
                   \<a>[f, tab\<^sub>1 g \<star> Tfg.p\<^sub>0, TTfgh.p\<^sub>1] \<cdot> ((f \<star> f\<^sub>0g\<^sub>1.\<phi>) \<star> TTfgh.p\<^sub>1)"
               using fg gh fg\<^sub>0h\<^sub>1.p\<^sub>0_simps fg\<^sub>0h\<^sub>1.p\<^sub>1_simps f\<^sub>0g\<^sub>1.\<phi>_in_hom
                     assoc_naturality [of f f\<^sub>0g\<^sub>1.\<phi> TTfgh.p\<^sub>1]
               by simp
             thus ?thesis
               using comp_assoc by presburger
           qed
           also have "... =
                        \<a>[f, g, h \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                        ((f \<star> g) \<star> \<a>[h, tab\<^sub>0 h, TTfgh.p\<^sub>0]) \<cdot>
                        ((f \<star> g) \<star> h.tab \<star> TTfgh.p\<^sub>0) \<cdot>
                        ((f \<star> g) \<star> fg\<^sub>0h\<^sub>1.\<phi>) \<cdot>
                        \<a>\<^sup>-\<^sup>1[f, g, (tab\<^sub>0 g \<star> Tfg.p\<^sub>0) \<star> TTfgh.p\<^sub>1] \<cdot>
                        (f \<star> \<a>[g, tab\<^sub>0 g \<star> Tfg.p\<^sub>0, TTfgh.p\<^sub>1]) \<cdot>
                        (f \<star> \<a>[g, tab\<^sub>0 g, Tfg.p\<^sub>0] \<star> TTfgh.p\<^sub>1) \<cdot>
                        \<a>[f, (g \<star> tab\<^sub>0 g) \<star> Tfg.p\<^sub>0, TTfgh.p\<^sub>1] \<cdot>
                        ((f \<star> (g.tab \<star> Tfg.p\<^sub>0)) \<star> TTfgh.p\<^sub>1) \<cdot>
                        ((f \<star> f\<^sub>0g\<^sub>1.\<phi>) \<star> TTfgh.p\<^sub>1) \<cdot>
                        (\<a>[f, tab\<^sub>0 f, Tfg.p\<^sub>1] \<star> TTfgh.p\<^sub>1) \<cdot>
                        \<a>\<^sup>-\<^sup>1[f \<star> tab\<^sub>0 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1] \<cdot>
                        (f.tab \<star> Tfg.p\<^sub>1 \<star> TTfgh.p\<^sub>1)"
           proof -
             have "(f \<star> (g.tab \<star> Tfg.p\<^sub>0) \<star> TTfgh.p\<^sub>1) \<cdot> \<a>[f, tab\<^sub>1 g \<star> Tfg.p\<^sub>0, TTfgh.p\<^sub>1] =
                   \<a>[f, (g \<star> tab\<^sub>0 g) \<star> Tfg.p\<^sub>0, TTfgh.p\<^sub>1] \<cdot> ((f \<star> (g.tab \<star> Tfg.p\<^sub>0)) \<star> TTfgh.p\<^sub>1)"
               using fg gh fg\<^sub>0h\<^sub>1.p\<^sub>0_simps fg\<^sub>0h\<^sub>1.p\<^sub>1_simps f\<^sub>0g\<^sub>1.\<phi>_in_hom
                     assoc_naturality [of f "g.tab \<star> Tfg.p\<^sub>0" TTfgh.p\<^sub>1]
               by simp
             thus ?thesis
               using comp_assoc by presburger
           qed
           also have "... =
                        \<a>[f, g, h \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                        ((f \<star> g) \<star> \<a>[h, tab\<^sub>0 h, TTfgh.p\<^sub>0]) \<cdot>
                        ((f \<star> g) \<star> h.tab \<star> TTfgh.p\<^sub>0) \<cdot>
                        ((f \<star> g) \<star> fg\<^sub>0h\<^sub>1.\<phi>) \<cdot>
                        \<a>\<^sup>-\<^sup>1[f, g, (tab\<^sub>0 g \<star> Tfg.p\<^sub>0) \<star> TTfgh.p\<^sub>1] \<cdot>
                        (f \<star> \<a>[g, tab\<^sub>0 g \<star> Tfg.p\<^sub>0, TTfgh.p\<^sub>1]) \<cdot>
                        ((f \<star> \<a>[g, tab\<^sub>0 g, Tfg.p\<^sub>0] \<star> TTfgh.p\<^sub>1) \<cdot>
                        \<a>[f, (g \<star> tab\<^sub>0 g) \<star> Tfg.p\<^sub>0, TTfgh.p\<^sub>1]) \<cdot>
                        ((f \<star> (g.tab \<star> Tfg.p\<^sub>0)) \<star> TTfgh.p\<^sub>1) \<cdot>
                        ((f \<star> f\<^sub>0g\<^sub>1.\<phi>) \<star> TTfgh.p\<^sub>1) \<cdot>
                        (\<a>[f, tab\<^sub>0 f, Tfg.p\<^sub>1] \<star> TTfgh.p\<^sub>1) \<cdot>
                        ((f.tab \<star> Tfg.p\<^sub>1) \<star> TTfgh.p\<^sub>1) \<cdot>
                        \<a>\<^sup>-\<^sup>1[tab\<^sub>1 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1]"
             using fg\<^sub>0h\<^sub>1.p\<^sub>1_simps assoc'_naturality [of f.tab Tfg.p\<^sub>1 TTfgh.p\<^sub>1] comp_assoc
             by simp
           also have "... =
                        \<a>[f, g, h \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                        ((f \<star> g) \<star> \<a>[h, tab\<^sub>0 h, TTfgh.p\<^sub>0]) \<cdot>
                        ((f \<star> g) \<star> h.tab \<star> TTfgh.p\<^sub>0) \<cdot>
                        ((f \<star> g) \<star> fg\<^sub>0h\<^sub>1.\<phi>) \<cdot>
                        \<a>\<^sup>-\<^sup>1[f, g, (tab\<^sub>0 g \<star> Tfg.p\<^sub>0) \<star> TTfgh.p\<^sub>1] \<cdot>
                        (f \<star> \<a>[g, tab\<^sub>0 g \<star> Tfg.p\<^sub>0, TTfgh.p\<^sub>1]) \<cdot>
                        (f \<star> \<a>[g, tab\<^sub>0 g, Tfg.p\<^sub>0] \<star> TTfgh.p\<^sub>1) \<cdot>
                        \<a>[f, (g \<star> tab\<^sub>0 g) \<star> Tfg.p\<^sub>0, TTfgh.p\<^sub>1] \<cdot>
                        ((((f \<star> \<a>\<^sup>-\<^sup>1[g, tab\<^sub>0 g, Tfg.p\<^sub>0]) \<star> TTfgh.p\<^sub>1) \<cdot>
                        ((f \<star> \<a>[g, tab\<^sub>0 g, Tfg.p\<^sub>0]) \<star> TTfgh.p\<^sub>1)) \<cdot>
                        ((f \<star> (g.tab \<star> Tfg.p\<^sub>0)) \<star> TTfgh.p\<^sub>1)) \<cdot>
                        ((f \<star> f\<^sub>0g\<^sub>1.\<phi>) \<star> TTfgh.p\<^sub>1) \<cdot>
                        (\<a>[f, tab\<^sub>0 f, Tfg.p\<^sub>1] \<star> TTfgh.p\<^sub>1) \<cdot>
                        ((f.tab \<star> Tfg.p\<^sub>1) \<star> TTfgh.p\<^sub>1) \<cdot>
                        \<a>\<^sup>-\<^sup>1[tab\<^sub>1 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1]"
           proof -
             have "(((f \<star> \<a>\<^sup>-\<^sup>1[g, tab\<^sub>0 g, Tfg.p\<^sub>0]) \<star> TTfgh.p\<^sub>1) \<cdot>
                      ((f \<star> \<a>[g, tab\<^sub>0 g, Tfg.p\<^sub>0]) \<star> TTfgh.p\<^sub>1)) \<cdot>
                      ((f \<star> (g.tab \<star> Tfg.p\<^sub>0)) \<star> TTfgh.p\<^sub>1) =
                   (f \<star> (g.tab \<star> Tfg.p\<^sub>0)) \<star> TTfgh.p\<^sub>1"
               using fg gh fg\<^sub>0h\<^sub>1.p\<^sub>1_simps comp_cod_arr whisker_right comp_assoc_assoc'
                     whisker_left [of f "\<a>\<^sup>-\<^sup>1[g, tab\<^sub>0 g, Tfg.p\<^sub>0]" "\<a>[g, tab\<^sub>0 g, Tfg.p\<^sub>0]"]
               by simp
             thus ?thesis
               using comp_assoc by simp
           qed
           also have "... =
                        \<a>[f, g, h \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                        ((f \<star> g) \<star> \<a>[h, tab\<^sub>0 h, TTfgh.p\<^sub>0]) \<cdot>
                        ((f \<star> g) \<star> h.tab \<star> TTfgh.p\<^sub>0) \<cdot>
                        ((f \<star> g) \<star> fg\<^sub>0h\<^sub>1.\<phi>) \<cdot>
                        \<a>\<^sup>-\<^sup>1[f, g, (tab\<^sub>0 g \<star> Tfg.p\<^sub>0) \<star> TTfgh.p\<^sub>1] \<cdot>
                        (f \<star> \<a>[g, tab\<^sub>0 g \<star> Tfg.p\<^sub>0, TTfgh.p\<^sub>1]) \<cdot>
                        (f \<star> \<a>[g, tab\<^sub>0 g, Tfg.p\<^sub>0] \<star> TTfgh.p\<^sub>1) \<cdot>
                        \<a>[f, (g \<star> tab\<^sub>0 g) \<star> Tfg.p\<^sub>0, TTfgh.p\<^sub>1] \<cdot>
                        ((f \<star> \<a>\<^sup>-\<^sup>1[g, tab\<^sub>0 g, Tfg.p\<^sub>0]) \<star> TTfgh.p\<^sub>1) \<cdot>
                        ((f \<star> \<a>[g, tab\<^sub>0 g, Tfg.p\<^sub>0]) \<star> TTfgh.p\<^sub>1) \<cdot>
                        ((f \<star> (g.tab \<star> Tfg.p\<^sub>0)) \<star> TTfgh.p\<^sub>1) \<cdot>
                        ((f \<star> f\<^sub>0g\<^sub>1.\<phi>) \<star> TTfgh.p\<^sub>1) \<cdot>
                        (\<a>[f, tab\<^sub>0 f, Tfg.p\<^sub>1] \<star> TTfgh.p\<^sub>1) \<cdot>
                        ((f.tab \<star> Tfg.p\<^sub>1) \<star> TTfgh.p\<^sub>1) \<cdot>
                        \<a>\<^sup>-\<^sup>1[tab\<^sub>1 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1]"
             using comp_assoc by presburger
           also have "... =
                        \<a>[f, g, h \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                        ((f \<star> g) \<star> \<a>[h, tab\<^sub>0 h, TTfgh.p\<^sub>0]) \<cdot>
                        ((f \<star> g) \<star> h.tab \<star> TTfgh.p\<^sub>0) \<cdot>
                        ((f \<star> g) \<star> fg\<^sub>0h\<^sub>1.\<phi>) \<cdot>
                        \<a>\<^sup>-\<^sup>1[f, g, (tab\<^sub>0 g \<star> Tfg.p\<^sub>0) \<star> TTfgh.p\<^sub>1] \<cdot>
                        (f \<star> \<a>[g, tab\<^sub>0 g \<star> Tfg.p\<^sub>0, TTfgh.p\<^sub>1]) \<cdot>
                        (f \<star> \<a>[g, tab\<^sub>0 g, Tfg.p\<^sub>0] \<star> TTfgh.p\<^sub>1) \<cdot>
                        \<a>[f, (g \<star> tab\<^sub>0 g) \<star> Tfg.p\<^sub>0, TTfgh.p\<^sub>1] \<cdot>
                        ((f \<star> \<a>\<^sup>-\<^sup>1[g, tab\<^sub>0 g, Tfg.p\<^sub>0]) \<star> TTfgh.p\<^sub>1) \<cdot>
                        (((\<a>[f, g, tab\<^sub>0 g \<star> Tfg.p\<^sub>0] \<star> TTfgh.p\<^sub>1) \<cdot>
                        (\<a>\<^sup>-\<^sup>1[f, g, tab\<^sub>0 g \<star> Tfg.p\<^sub>0] \<star> TTfgh.p\<^sub>1)) \<cdot>
                        ((f \<star> \<a>[g, tab\<^sub>0 g, Tfg.p\<^sub>0]) \<star> TTfgh.p\<^sub>1)) \<cdot>
                        ((f \<star> (g.tab \<star> Tfg.p\<^sub>0)) \<star> TTfgh.p\<^sub>1) \<cdot>
                        ((f \<star> f\<^sub>0g\<^sub>1.\<phi>) \<star> TTfgh.p\<^sub>1) \<cdot>
                        (\<a>[f, tab\<^sub>0 f, Tfg.p\<^sub>1] \<star> TTfgh.p\<^sub>1) \<cdot>
                        ((f.tab \<star> Tfg.p\<^sub>1) \<star> TTfgh.p\<^sub>1) \<cdot>
                        \<a>\<^sup>-\<^sup>1[tab\<^sub>1 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1]"
           proof -
             have "((\<a>[f, g, tab\<^sub>0 g \<star> Tfg.p\<^sub>0] \<star> TTfgh.p\<^sub>1) \<cdot>
                      (\<a>\<^sup>-\<^sup>1[f, g, tab\<^sub>0 g \<star> Tfg.p\<^sub>0] \<star> TTfgh.p\<^sub>1)) \<cdot>
                      ((f \<star> \<a>[g, tab\<^sub>0 g, Tfg.p\<^sub>0]) \<star> TTfgh.p\<^sub>1) =
                   (f \<star> \<a>[g, tab\<^sub>0 g, Tfg.p\<^sub>0]) \<star> TTfgh.p\<^sub>1"
               using fg fg\<^sub>0h\<^sub>1.p\<^sub>1_simps comp_cod_arr comp_assoc_assoc'
                     whisker_right
                       [of TTfgh.p\<^sub>1 "\<a>[f, g, tab\<^sub>0 g \<star> Tfg.p\<^sub>0]" "\<a>\<^sup>-\<^sup>1[f, g, tab\<^sub>0 g \<star> Tfg.p\<^sub>0]"]
               by simp
             thus ?thesis
               using comp_assoc by simp
           qed
           also have "... =
                        \<a>[f, g, h \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                        ((f \<star> g) \<star> \<a>[h, tab\<^sub>0 h, TTfgh.p\<^sub>0]) \<cdot>
                        ((f \<star> g) \<star> h.tab \<star> TTfgh.p\<^sub>0) \<cdot>
                        ((f \<star> g) \<star> fg\<^sub>0h\<^sub>1.\<phi>) \<cdot>
                        \<a>\<^sup>-\<^sup>1[f, g, (tab\<^sub>0 g \<star> Tfg.p\<^sub>0) \<star> TTfgh.p\<^sub>1] \<cdot>
                        (f \<star> \<a>[g, tab\<^sub>0 g \<star> Tfg.p\<^sub>0, TTfgh.p\<^sub>1]) \<cdot>
                        (f \<star> \<a>[g, tab\<^sub>0 g, Tfg.p\<^sub>0] \<star> TTfgh.p\<^sub>1) \<cdot>
                        \<a>[f, (g \<star> tab\<^sub>0 g) \<star> Tfg.p\<^sub>0, TTfgh.p\<^sub>1] \<cdot>
                        ((f \<star> \<a>\<^sup>-\<^sup>1[g, tab\<^sub>0 g, Tfg.p\<^sub>0]) \<star> TTfgh.p\<^sub>1) \<cdot>
                        (\<a>[f, g, tab\<^sub>0 g \<star> Tfg.p\<^sub>0] \<star> TTfgh.p\<^sub>1) \<cdot>
                        ((\<a>\<^sup>-\<^sup>1[f, g, tab\<^sub>0 g \<star> Tfg.p\<^sub>0] \<star> TTfgh.p\<^sub>1) \<cdot>
                        ((f \<star> \<a>[g, tab\<^sub>0 g, Tfg.p\<^sub>0]) \<star> TTfgh.p\<^sub>1) \<cdot>
                        ((f \<star> (g.tab \<star> Tfg.p\<^sub>0)) \<star> TTfgh.p\<^sub>1) \<cdot>
                        ((f \<star> f\<^sub>0g\<^sub>1.\<phi>) \<star> TTfgh.p\<^sub>1) \<cdot>
                        (\<a>[f, tab\<^sub>0 f, Tfg.p\<^sub>1] \<star> TTfgh.p\<^sub>1) \<cdot>
                        ((f.tab \<star> Tfg.p\<^sub>1) \<star> TTfgh.p\<^sub>1)) \<cdot>
                        \<a>\<^sup>-\<^sup>1[tab\<^sub>1 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1]"
             using comp_assoc by presburger
           also have "... =
                        \<a>[f, g, h \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                        ((f \<star> g) \<star> \<a>[h, tab\<^sub>0 h, TTfgh.p\<^sub>0]) \<cdot>
                        ((f \<star> g) \<star> h.tab \<star> TTfgh.p\<^sub>0) \<cdot>
                        ((f \<star> g) \<star> fg\<^sub>0h\<^sub>1.\<phi>) \<cdot>
                        (\<a>\<^sup>-\<^sup>1[f, g, (tab\<^sub>0 g \<star> Tfg.p\<^sub>0) \<star> TTfgh.p\<^sub>1] \<cdot>
                        (f \<star> \<a>[g, tab\<^sub>0 g \<star> Tfg.p\<^sub>0, TTfgh.p\<^sub>1]) \<cdot>
                        (f \<star> \<a>[g, tab\<^sub>0 g, Tfg.p\<^sub>0] \<star> TTfgh.p\<^sub>1) \<cdot>
                        \<a>[f, (g \<star> tab\<^sub>0 g) \<star> Tfg.p\<^sub>0, TTfgh.p\<^sub>1] \<cdot>
                        ((f \<star> \<a>\<^sup>-\<^sup>1[g, tab\<^sub>0 g, Tfg.p\<^sub>0]) \<star> TTfgh.p\<^sub>1) \<cdot>
                        (\<a>[f, g, tab\<^sub>0 g \<star> Tfg.p\<^sub>0] \<star> TTfgh.p\<^sub>1)) \<cdot>
                        (\<a>\<^sup>-\<^sup>1[f, g, tab\<^sub>0 g \<star> Tfg.p\<^sub>0] \<cdot>
                          (f \<star> \<a>[g, tab\<^sub>0 g, Tfg.p\<^sub>0]) \<cdot>
                          (f \<star> (g.tab \<star> Tfg.p\<^sub>0)) \<cdot>
                          (f \<star> f\<^sub>0g\<^sub>1.\<phi>) \<cdot>
                          \<a>[f, tab\<^sub>0 f, Tfg.p\<^sub>1] \<cdot>
                          (f.tab \<star> Tfg.p\<^sub>1)
                         \<star> TTfgh.p\<^sub>1) \<cdot>
                        \<a>\<^sup>-\<^sup>1[tab\<^sub>1 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1]"
             using fg gh fg\<^sub>0h\<^sub>1.p\<^sub>0_simps fg\<^sub>0h\<^sub>1.p\<^sub>1_simps f\<^sub>0g\<^sub>1.p\<^sub>0_simps f\<^sub>0g\<^sub>1.p\<^sub>1_simps
                   whisker_right comp_assoc
             by simp
           also have "... =
                        \<a>[f, g, h \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                        ((f \<star> g) \<star> \<a>[h, tab\<^sub>0 h, TTfgh.p\<^sub>0]) \<cdot>
                        ((f \<star> g) \<star> h.tab \<star> TTfgh.p\<^sub>0) \<cdot>
                        ((f \<star> g) \<star> fg\<^sub>0h\<^sub>1.\<phi>) \<cdot>
                        \<a>[f \<star> g, tab\<^sub>0 g \<star> Tfg.p\<^sub>0, TTfgh.p\<^sub>1] \<cdot>
                        (\<a>\<^sup>-\<^sup>1[f, g, tab\<^sub>0 g \<star> Tfg.p\<^sub>0] \<cdot>
                          (f \<star> \<a>[g, tab\<^sub>0 g, Tfg.p\<^sub>0]) \<cdot>
                          (f \<star> (g.tab \<star> Tfg.p\<^sub>0)) \<cdot>
                          (f \<star> f\<^sub>0g\<^sub>1.\<phi>) \<cdot>
                          \<a>[f, tab\<^sub>0 f, Tfg.p\<^sub>1] \<cdot>
                          (f.tab \<star> Tfg.p\<^sub>1)
                         \<star> TTfgh.p\<^sub>1) \<cdot>
                        \<a>\<^sup>-\<^sup>1[tab\<^sub>1 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1]"
           proof -
             have "\<a>\<^sup>-\<^sup>1[f, g, (tab\<^sub>0 g \<star> Tfg.p\<^sub>0) \<star> TTfgh.p\<^sub>1] \<cdot>
                        (f \<star> \<a>[g, tab\<^sub>0 g \<star> Tfg.p\<^sub>0, TTfgh.p\<^sub>1]) \<cdot>
                        (f \<star> \<a>[g, tab\<^sub>0 g, Tfg.p\<^sub>0] \<star> TTfgh.p\<^sub>1) \<cdot>
                        \<a>[f, (g \<star> tab\<^sub>0 g) \<star> Tfg.p\<^sub>0, TTfgh.p\<^sub>1] \<cdot>
                        ((f \<star> \<a>\<^sup>-\<^sup>1[g, tab\<^sub>0 g, Tfg.p\<^sub>0]) \<star> TTfgh.p\<^sub>1) \<cdot>
                        (\<a>[f, g, tab\<^sub>0 g \<star> Tfg.p\<^sub>0] \<star> TTfgh.p\<^sub>1) =
                       \<lbrace>\<^bold>\<a>\<^sup>-\<^sup>1\<^bold>[\<^bold>\<langle>f\<^bold>\<rangle>, \<^bold>\<langle>g\<^bold>\<rangle>, (\<^bold>\<langle>tab\<^sub>0 g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tfg.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TTfgh.p\<^sub>1\<^bold>\<rangle>\<^bold>] \<^bold>\<cdot>
                        (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<a>\<^bold>[\<^bold>\<langle>g\<^bold>\<rangle>, \<^bold>\<langle>tab\<^sub>0 g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tfg.p\<^sub>0\<^bold>\<rangle>, \<^bold>\<langle>TTfgh.p\<^sub>1\<^bold>\<rangle>\<^bold>]) \<^bold>\<cdot>
                        (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<a>\<^bold>[\<^bold>\<langle>g\<^bold>\<rangle>, \<^bold>\<langle>tab\<^sub>0 g\<^bold>\<rangle>, \<^bold>\<langle>Tfg.p\<^sub>0\<^bold>\<rangle>\<^bold>] \<^bold>\<star> \<^bold>\<langle>TTfgh.p\<^sub>1\<^bold>\<rangle>) \<^bold>\<cdot>
                         \<^bold>\<a>\<^bold>[\<^bold>\<langle>f\<^bold>\<rangle>, (\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 g\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tfg.p\<^sub>0\<^bold>\<rangle>, \<^bold>\<langle>TTfgh.p\<^sub>1\<^bold>\<rangle>\<^bold>] \<^bold>\<cdot>
                        ((\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<a>\<^sup>-\<^sup>1\<^bold>[\<^bold>\<langle>g\<^bold>\<rangle>, \<^bold>\<langle>tab\<^sub>0 g\<^bold>\<rangle>, \<^bold>\<langle>Tfg.p\<^sub>0\<^bold>\<rangle>\<^bold>]) \<^bold>\<star> \<^bold>\<langle>TTfgh.p\<^sub>1\<^bold>\<rangle>) \<^bold>\<cdot>
                        (\<^bold>\<a>\<^bold>[\<^bold>\<langle>f\<^bold>\<rangle>, \<^bold>\<langle>g\<^bold>\<rangle>, \<^bold>\<langle>tab\<^sub>0 g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tfg.p\<^sub>0\<^bold>\<rangle>\<^bold>] \<^bold>\<star> \<^bold>\<langle>TTfgh.p\<^sub>1\<^bold>\<rangle>)\<rbrace>"
               using fg gh fg\<^sub>0h\<^sub>1.p\<^sub>0_simps fg\<^sub>0h\<^sub>1.p\<^sub>1_simps f\<^sub>0g\<^sub>1.p\<^sub>0_simps f\<^sub>0g\<^sub>1.p\<^sub>1_simps
                     \<a>'_def \<alpha>_def
               by simp
             also have "... = \<lbrace>\<^bold>\<a>\<^bold>[\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle>, \<^bold>\<langle>tab\<^sub>0 g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tfg.p\<^sub>0\<^bold>\<rangle>, \<^bold>\<langle>TTfgh.p\<^sub>1\<^bold>\<rangle>\<^bold>]\<rbrace>"
               using fg gh fg\<^sub>0h\<^sub>1.p\<^sub>0_simps fg\<^sub>0h\<^sub>1.p\<^sub>1_simps f\<^sub>0g\<^sub>1.p\<^sub>0_simps f\<^sub>0g\<^sub>1.p\<^sub>1_simps
               by (intro E.eval_eqI, auto)
             also have "... = \<a>[f \<star> g, tab\<^sub>0 g \<star> Tfg.p\<^sub>0, TTfgh.p\<^sub>1]"
               using fg gh fg\<^sub>0h\<^sub>1.p\<^sub>0_simps fg\<^sub>0h\<^sub>1.p\<^sub>1_simps f\<^sub>0g\<^sub>1.p\<^sub>0_simps f\<^sub>0g\<^sub>1.p\<^sub>1_simps
                     \<a>'_def \<alpha>_def
               by simp
             finally show ?thesis
               using comp_assoc by presburger
           qed
           also have "... =
                        \<a>[f, g, h \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                        ((\<a>[f \<star> g, h, tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                        \<a>\<^sup>-\<^sup>1[f \<star> g, h, tab\<^sub>0 h \<star> TTfgh.p\<^sub>0]) \<cdot>
                        ((f \<star> g) \<star> \<a>[h, tab\<^sub>0 h, TTfgh.p\<^sub>0])) \<cdot>
                        ((f \<star> g) \<star> h.tab \<star> TTfgh.p\<^sub>0) \<cdot>
                        ((f \<star> g) \<star> fg\<^sub>0h\<^sub>1.\<phi>) \<cdot>
                        \<a>[f \<star> g, tab\<^sub>0 g \<star> Tfg.p\<^sub>0, TTfgh.p\<^sub>1] \<cdot>
                        (\<a>\<^sup>-\<^sup>1[f, g, tab\<^sub>0 g \<star> Tfg.p\<^sub>0] \<cdot>
                          (f \<star> \<a>[g, tab\<^sub>0 g, Tfg.p\<^sub>0]) \<cdot>
                          (f \<star> (g.tab \<star> Tfg.p\<^sub>0)) \<cdot>
                          (f \<star> f\<^sub>0g\<^sub>1.\<phi>) \<cdot>
                          \<a>[f, tab\<^sub>0 f, Tfg.p\<^sub>1] \<cdot>
                          (f.tab \<star> Tfg.p\<^sub>1)
                         \<star> TTfgh.p\<^sub>1) \<cdot>
                        \<a>\<^sup>-\<^sup>1[tab\<^sub>1 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1]"
           proof -
             have "(\<a>[f \<star> g, h, tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                        \<a>\<^sup>-\<^sup>1[f \<star> g, h, tab\<^sub>0 h \<star> TTfgh.p\<^sub>0]) \<cdot>
                        ((f \<star> g) \<star> \<a>[h, tab\<^sub>0 h, TTfgh.p\<^sub>0]) =
                     ((f \<star> g) \<star> \<a>[h, tab\<^sub>0 h, TTfgh.p\<^sub>0])"
               using fg gh fg\<^sub>0h\<^sub>1.p\<^sub>0_simps fg\<^sub>0h\<^sub>1.p\<^sub>1_simps f\<^sub>0g\<^sub>1.p\<^sub>0_simps f\<^sub>0g\<^sub>1.p\<^sub>1_simps
                     comp_cod_arr comp_assoc_assoc'
               by simp
             thus ?thesis by simp
           qed
           also have "... =
                        \<a>[f, g, h \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                        \<a>[f \<star> g, h, tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                        (\<a>\<^sup>-\<^sup>1[f \<star> g, h, tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                        ((f \<star> g) \<star> \<a>[h, tab\<^sub>0 h, TTfgh.p\<^sub>0]) \<cdot>
                        ((f \<star> g) \<star> h.tab \<star> TTfgh.p\<^sub>0) \<cdot>
                        ((f \<star> g) \<star> fg\<^sub>0h\<^sub>1.\<phi>) \<cdot>
                        \<a>[f \<star> g, tab\<^sub>0 g \<star> Tfg.p\<^sub>0, TTfgh.p\<^sub>1] \<cdot>
                        (\<a>\<^sup>-\<^sup>1[f, g, tab\<^sub>0 g \<star> Tfg.p\<^sub>0] \<cdot>
                          (f \<star> \<a>[g, tab\<^sub>0 g, Tfg.p\<^sub>0]) \<cdot>
                          (f \<star> (g.tab \<star> Tfg.p\<^sub>0)) \<cdot>
                          (f \<star> f\<^sub>0g\<^sub>1.\<phi>) \<cdot>
                          \<a>[f, tab\<^sub>0 f, Tfg.p\<^sub>1] \<cdot>
                          (f.tab \<star> Tfg.p\<^sub>1)
                         \<star> TTfgh.p\<^sub>1)) \<cdot>
                        \<a>\<^sup>-\<^sup>1[tab\<^sub>1 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1]"
             using comp_assoc by presburger
           also have "... =
                        \<a>[f, g, h \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                        \<a>[f \<star> g, h, tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                        TTfgh.tab \<cdot>
                        \<a>\<^sup>-\<^sup>1[tab\<^sub>1 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1]"
             using TTfgh.tab_def Tfg.\<rho>\<sigma>.tab_def by simp
           also have "... =
                        \<a>[f, g, h \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                          \<a>[f \<star> g, h, tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                          ((\<a>\<^sup>-\<^sup>1[f, g, h] \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0) \<cdot>
                          ((f \<star> g \<star> h) \<star> TTfgh_TfTgh.the_\<theta>) \<cdot>
                          \<a>[f \<star> g \<star> h, (tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                          (\<a>\<^sup>-\<^sup>1[f, g \<star> h, (tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0] \<cdot>
                            (f \<star> \<a>[g \<star> h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0]) \<cdot>
                            (f \<star> \<a>\<^sup>-\<^sup>1[g, h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0] \<cdot>
                                  (g \<star> \<a>[h, tab\<^sub>0 h, Tgh.p\<^sub>0]) \<cdot>
                                  (g \<star> h.tab \<star> Tgh.p\<^sub>0) \<cdot>
                                  (g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<cdot>
                                  \<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<cdot>
                                  (g.tab \<star> Tgh.p\<^sub>1)
                               \<star> TfTgh.p\<^sub>0) \<cdot>
                            (f \<star> f\<^sub>0gh\<^sub>1.\<phi>) \<cdot>
                            \<a>[f, tab\<^sub>0 f, TfTgh.p\<^sub>1] \<cdot>
                            (f.tab \<star> TfTgh.p\<^sub>1)
                           \<star> TTfgh_TfTgh.chine) \<cdot>
                          TTfgh_TfTgh.the_\<nu>) \<cdot>
                          \<a>\<^sup>-\<^sup>1[tab\<^sub>1 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1]"
             using src_tab_eq TfTgh.tab_def Tgh.\<rho>\<sigma>.tab_def comp_assoc by simp
           text \<open>Now we have to make this look like \<open>f.composite_cell w\<^sub>f' \<theta>\<^sub>f' \<cdot> \<beta>\<^sub>f\<close>.\<close>
           also have "... =
                        \<a>[f, g, h \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                          \<a>[f \<star> g, h, tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                          ((\<a>\<^sup>-\<^sup>1[f, g, h] \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0) \<cdot>
                          ((f \<star> g \<star> h) \<star> TTfgh_TfTgh.the_\<theta>) \<cdot>
                          \<a>[f \<star> g \<star> h, (tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                          (\<a>\<^sup>-\<^sup>1[f, g \<star> h, (tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0] \<cdot>
                            (f \<star> \<a>[g \<star> h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0]) \<cdot>
                            ((f \<star> \<a>\<^sup>-\<^sup>1[g, h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0] \<star> TfTgh.p\<^sub>0) \<cdot>
                              (f \<star> (g \<star> \<a>[h, tab\<^sub>0 h, Tgh.p\<^sub>0]) \<star> TfTgh.p\<^sub>0) \<cdot>
                              (f \<star> (g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<cdot>
                              (f \<star> (g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<cdot>
                              (f \<star> \<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<cdot>
                              (f \<star> (g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<cdot>
                              (f \<star> f\<^sub>0gh\<^sub>1.\<phi>)) \<cdot>
                              \<a>[f, tab\<^sub>0 f, TfTgh.p\<^sub>1] \<cdot>
                              (f.tab \<star> TfTgh.p\<^sub>1)
                             \<star> TTfgh_TfTgh.chine) \<cdot>
                          TTfgh_TfTgh.the_\<nu>) \<cdot>
                          \<a>\<^sup>-\<^sup>1[tab\<^sub>1 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1]"
           proof -
             have "f \<star> \<a>\<^sup>-\<^sup>1[g, h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0] \<cdot>
                           (g \<star> \<a>[h, tab\<^sub>0 h, Tgh.p\<^sub>0]) \<cdot>
                           (g \<star> h.tab \<star> Tgh.p\<^sub>0) \<cdot>
                           (g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<cdot>
                           \<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<cdot>
                           (g.tab \<star> Tgh.p\<^sub>1)
                       \<star> TfTgh.p\<^sub>0 =
                     (f \<star> \<a>\<^sup>-\<^sup>1[g, h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0] \<star> TfTgh.p\<^sub>0) \<cdot>
                       (f \<star> (g \<star> \<a>[h, tab\<^sub>0 h, Tgh.p\<^sub>0]) \<star> TfTgh.p\<^sub>0) \<cdot>
                       (f \<star> (g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<cdot>
                       (f \<star> (g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<cdot>
                       (f \<star> \<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<cdot>
                       (f \<star> (g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0)"
               using fg gh whisker_right whisker_left by simp
             thus ?thesis
               using comp_assoc by presburger
           qed
           also have "... =
                        \<a>[f, g, h \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                        \<a>[f \<star> g, h, tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                        (\<a>\<^sup>-\<^sup>1[f, g, h] \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0) \<cdot>
                        ((f \<star> g \<star> h) \<star> TTfgh_TfTgh.the_\<theta>) \<cdot>
                        \<a>[f \<star> g \<star> h, (tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                        (\<a>\<^sup>-\<^sup>1[f, g \<star> h, (tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0] \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> \<a>[g \<star> h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0]) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> \<a>\<^sup>-\<^sup>1[g, h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> (g \<star> \<a>[h, tab\<^sub>0 h, Tgh.p\<^sub>0]) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> (g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> (g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> \<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> (g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> f\<^sub>0gh\<^sub>1.\<phi>) \<star> TTfgh_TfTgh.chine) \<cdot>
                        (\<a>[f, tab\<^sub>0 f, TfTgh.p\<^sub>1] \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f.tab \<star> TfTgh.p\<^sub>1) \<star> TTfgh_TfTgh.chine) \<cdot>
                        TTfgh_TfTgh.the_\<nu> \<cdot>
                        \<a>\<^sup>-\<^sup>1[tab\<^sub>1 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1]"
           proof -
             have "\<a>\<^sup>-\<^sup>1[f, g \<star> h, (tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0] \<cdot>
                       (f \<star> \<a>[g \<star> h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0]) \<cdot>
                       (f \<star> \<a>\<^sup>-\<^sup>1[g, h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0] \<star> TfTgh.p\<^sub>0) \<cdot>
                       (f \<star> (g \<star> \<a>[h, tab\<^sub>0 h, Tgh.p\<^sub>0]) \<star> TfTgh.p\<^sub>0) \<cdot>
                       (f \<star> (g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<cdot>
                       (f \<star> (g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<cdot>
                       (f \<star> \<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<cdot>
                       (f \<star> (g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<cdot>
                       (f \<star> f\<^sub>0gh\<^sub>1.\<phi>) \<cdot>
                       \<a>[f, tab\<^sub>0 f, TfTgh.p\<^sub>1] \<cdot>
                       (f.tab \<star> TfTgh.p\<^sub>1)
                      \<star> TTfgh_TfTgh.chine =
                     (\<a>\<^sup>-\<^sup>1[f, g \<star> h, (tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0] \<star> TTfgh_TfTgh.chine) \<cdot>
                     ((f \<star> \<a>[g \<star> h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0]) \<star> TTfgh_TfTgh.chine) \<cdot>
                     ((f \<star> \<a>\<^sup>-\<^sup>1[g, h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                     ((f \<star> (g \<star> \<a>[h, tab\<^sub>0 h, Tgh.p\<^sub>0]) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                     ((f \<star> (g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                     ((f \<star> (g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                     ((f \<star> \<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                     ((f \<star> (g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                     ((f \<star> f\<^sub>0gh\<^sub>1.\<phi>) \<star> TTfgh_TfTgh.chine) \<cdot>
                     (\<a>[f, tab\<^sub>0 f, TfTgh.p\<^sub>1] \<star> TTfgh_TfTgh.chine) \<cdot>
                     ((f.tab \<star> TfTgh.p\<^sub>1) \<star> TTfgh_TfTgh.chine)"
             proof -
               have "arr (\<a>\<^sup>-\<^sup>1[f, g \<star> h, (tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0] \<cdot>
                       (f \<star> \<a>[g \<star> h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0]) \<cdot>
                       (f \<star> \<a>\<^sup>-\<^sup>1[g, h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0] \<star> TfTgh.p\<^sub>0) \<cdot>
                       (f \<star> (g \<star> \<a>[h, tab\<^sub>0 h, Tgh.p\<^sub>0]) \<star> TfTgh.p\<^sub>0) \<cdot>
                       (f \<star> (g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<cdot>
                       (f \<star> (g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<cdot>
                       (f \<star> \<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<cdot>
                       (f \<star> (g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<cdot>
                       (f \<star> f\<^sub>0gh\<^sub>1.\<phi>) \<cdot>
                       \<a>[f, tab\<^sub>0 f, TfTgh.p\<^sub>1] \<cdot>
                       (f.tab \<star> TfTgh.p\<^sub>1))"
                 using fg gh
                 by (intro seqI' comp_in_homI) auto
               (*
                * TODO: Find a way to generate the following consequences automatically
                * without having to list them.
                *)
               moreover
               have "arr ((f \<star> \<a>[g \<star> h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0]) \<cdot>
                       (f \<star> \<a>\<^sup>-\<^sup>1[g, h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0] \<star> TfTgh.p\<^sub>0) \<cdot>
                       (f \<star> (g \<star> \<a>[h, tab\<^sub>0 h, Tgh.p\<^sub>0]) \<star> TfTgh.p\<^sub>0) \<cdot>
                       (f \<star> (g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<cdot>
                       (f \<star> (g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<cdot>
                       (f \<star> \<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<cdot>
                       (f \<star> (g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<cdot>
                       (f \<star> f\<^sub>0gh\<^sub>1.\<phi>) \<cdot>
                       \<a>[f, tab\<^sub>0 f, TfTgh.p\<^sub>1] \<cdot>
                       (f.tab \<star> TfTgh.p\<^sub>1))"
                 using calculation by blast
               moreover
               have "arr ((f \<star> \<a>\<^sup>-\<^sup>1[g, h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0] \<star> TfTgh.p\<^sub>0) \<cdot>
                       (f \<star> (g \<star> \<a>[h, tab\<^sub>0 h, Tgh.p\<^sub>0]) \<star> TfTgh.p\<^sub>0) \<cdot>
                       (f \<star> (g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<cdot>
                       (f \<star> (g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<cdot>
                       (f \<star> \<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<cdot>
                       (f \<star> (g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<cdot>
                       (f \<star> f\<^sub>0gh\<^sub>1.\<phi>) \<cdot>
                       \<a>[f, tab\<^sub>0 f, TfTgh.p\<^sub>1] \<cdot>
                       (f.tab \<star> TfTgh.p\<^sub>1))"
                 using calculation by blast
               moreover
               have "arr ((f \<star> (g \<star> \<a>[h, tab\<^sub>0 h, Tgh.p\<^sub>0]) \<star> TfTgh.p\<^sub>0) \<cdot>
                       (f \<star> (g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<cdot>
                       (f \<star> (g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<cdot>
                       (f \<star> \<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<cdot>
                       (f \<star> (g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<cdot>
                       (f \<star> f\<^sub>0gh\<^sub>1.\<phi>) \<cdot>
                       \<a>[f, tab\<^sub>0 f, TfTgh.p\<^sub>1] \<cdot>
                       (f.tab \<star> TfTgh.p\<^sub>1))"
                 using calculation by blast
               moreover
               have "arr ((f \<star> (g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<cdot>
                       (f \<star> (g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<cdot>
                       (f \<star> \<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<cdot>
                       (f \<star> (g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<cdot>
                       (f \<star> f\<^sub>0gh\<^sub>1.\<phi>) \<cdot>
                       \<a>[f, tab\<^sub>0 f, TfTgh.p\<^sub>1] \<cdot>
                       (f.tab \<star> TfTgh.p\<^sub>1))"
                 using calculation by blast
               moreover
               have "arr ((f \<star> (g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<cdot>
                       (f \<star> \<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<cdot>
                       (f \<star> (g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<cdot>
                       (f \<star> f\<^sub>0gh\<^sub>1.\<phi>) \<cdot>
                       \<a>[f, tab\<^sub>0 f, TfTgh.p\<^sub>1] \<cdot>
                       (f.tab \<star> TfTgh.p\<^sub>1))"
                 using calculation by blast
               moreover
               have "arr ((f \<star> \<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<cdot>
                       (f \<star> (g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<cdot>
                       (f \<star> f\<^sub>0gh\<^sub>1.\<phi>) \<cdot>
                       \<a>[f, tab\<^sub>0 f, TfTgh.p\<^sub>1] \<cdot>
                       (f.tab \<star> TfTgh.p\<^sub>1))"
                 using calculation by blast
               moreover
               have "arr ((f \<star> (g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<cdot>
                       (f \<star> f\<^sub>0gh\<^sub>1.\<phi>) \<cdot>
                       \<a>[f, tab\<^sub>0 f, TfTgh.p\<^sub>1] \<cdot>
                       (f.tab \<star> TfTgh.p\<^sub>1))"
                 using calculation by blast
               moreover
               have "arr ((f \<star> f\<^sub>0gh\<^sub>1.\<phi>) \<cdot>
                       \<a>[f, tab\<^sub>0 f, TfTgh.p\<^sub>1] \<cdot>
                       (f.tab \<star> TfTgh.p\<^sub>1))"
                 using calculation by blast
               moreover
               have "arr (\<a>[f, tab\<^sub>0 f, TfTgh.p\<^sub>1] \<cdot>
                       (f.tab \<star> TfTgh.p\<^sub>1))"
                 using calculation by blast
               ultimately show ?thesis
                 using whisker_right by auto
             qed
             thus ?thesis
               using comp_assoc by presburger
           qed
           also have "... =
                        \<a>[f, g, h \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                        \<a>[f \<star> g, h, tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                        (\<a>\<^sup>-\<^sup>1[f, g, h] \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0) \<cdot>
                        ((f \<star> g \<star> h) \<star> TTfgh_TfTgh.the_\<theta>) \<cdot>
                        \<a>[f \<star> g \<star> h, (tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                        (\<a>\<^sup>-\<^sup>1[f, g \<star> h, (tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0] \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> \<a>[g \<star> h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0]) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> \<a>\<^sup>-\<^sup>1[g, h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> (g \<star> \<a>[h, tab\<^sub>0 h, Tgh.p\<^sub>0]) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> (g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> (g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> \<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> (g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> f\<^sub>0gh\<^sub>1.\<phi>) \<star> TTfgh_TfTgh.chine) \<cdot>
                        (\<a>[f, tab\<^sub>0 f, TfTgh.p\<^sub>1] \<star> TTfgh_TfTgh.chine) \<cdot>
                        (((f.tab \<star> TfTgh.p\<^sub>1) \<star> TTfgh_TfTgh.chine) \<cdot>
                        \<a>\<^sup>-\<^sup>1[tab\<^sub>1 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine] \<cdot>
                        \<a>[tab\<^sub>1 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine]) \<cdot>
                        TTfgh_TfTgh.the_\<nu> \<cdot>
                        \<a>\<^sup>-\<^sup>1[tab\<^sub>1 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1]"
          proof -
            have "((f.tab \<star> TfTgh.p\<^sub>1) \<star> TTfgh_TfTgh.chine) \<cdot>
                        \<a>\<^sup>-\<^sup>1[tab\<^sub>1 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine] \<cdot>
                        \<a>[tab\<^sub>1 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine] =
                     (f.tab \<star> TfTgh.p\<^sub>1) \<star> TTfgh_TfTgh.chine"
              using fg gh fg\<^sub>0h\<^sub>1.p\<^sub>0_simps fg\<^sub>0h\<^sub>1.p\<^sub>1_simps f\<^sub>0g\<^sub>1.p\<^sub>0_simps f\<^sub>0g\<^sub>1.p\<^sub>1_simps
                    comp_arr_dom comp_assoc_assoc'
              by simp
            thus ?thesis by simp
          qed
          also have "... =
                        \<a>[f, g, h \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                        \<a>[f \<star> g, h, tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                        (\<a>\<^sup>-\<^sup>1[f, g, h] \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0) \<cdot>
                        ((f \<star> g \<star> h) \<star> TTfgh_TfTgh.the_\<theta>) \<cdot>
                        \<a>[f \<star> g \<star> h, (tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                        (\<a>\<^sup>-\<^sup>1[f, g \<star> h, (tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0] \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> \<a>[g \<star> h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0]) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> \<a>\<^sup>-\<^sup>1[g, h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> (g \<star> \<a>[h, tab\<^sub>0 h, Tgh.p\<^sub>0]) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> (g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> (g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> \<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> (g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> f\<^sub>0gh\<^sub>1.\<phi>) \<star> TTfgh_TfTgh.chine) \<cdot>
                        (\<a>[f, tab\<^sub>0 f, TfTgh.p\<^sub>1] \<star> TTfgh_TfTgh.chine) \<cdot>
                        (((f.tab \<star> TfTgh.p\<^sub>1) \<star> TTfgh_TfTgh.chine) \<cdot>
                        \<a>\<^sup>-\<^sup>1[tab\<^sub>1 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine]) \<cdot>
                        \<a>[tab\<^sub>1 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine] \<cdot>
                        TTfgh_TfTgh.the_\<nu> \<cdot>
                        \<a>\<^sup>-\<^sup>1[tab\<^sub>1 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1]"
             using comp_assoc by presburger
           also have "... =
                        \<a>[f, g, h \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                        \<a>[f \<star> g, h, tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                        (\<a>\<^sup>-\<^sup>1[f, g, h] \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0) \<cdot>
                        ((f \<star> g \<star> h) \<star> TTfgh_TfTgh.the_\<theta>) \<cdot>
                        \<a>[f \<star> g \<star> h, (tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                        (\<a>\<^sup>-\<^sup>1[f, g \<star> h, (tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0] \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> \<a>[g \<star> h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0]) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> \<a>\<^sup>-\<^sup>1[g, h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> (g \<star> \<a>[h, tab\<^sub>0 h, Tgh.p\<^sub>0]) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> (g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> (g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> \<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> (g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> f\<^sub>0gh\<^sub>1.\<phi>) \<star> TTfgh_TfTgh.chine) \<cdot>
                        (\<a>[f, tab\<^sub>0 f, TfTgh.p\<^sub>1] \<star> TTfgh_TfTgh.chine) \<cdot>
                        \<a>\<^sup>-\<^sup>1[f \<star> tab\<^sub>0 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine] \<cdot>
                        (f.tab \<star> TfTgh.p\<^sub>1 \<star> TTfgh_TfTgh.chine) \<cdot>
                        \<a>[tab\<^sub>1 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine] \<cdot>
                        TTfgh_TfTgh.the_\<nu> \<cdot>
                        \<a>\<^sup>-\<^sup>1[tab\<^sub>1 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1]"
           proof -
             have "((f.tab \<star> TfTgh.p\<^sub>1) \<star> TTfgh_TfTgh.chine) \<cdot>
                       \<a>\<^sup>-\<^sup>1[tab\<^sub>1 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine] =
                     \<a>\<^sup>-\<^sup>1[f \<star> tab\<^sub>0 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine] \<cdot>
                       (f.tab \<star> TfTgh.p\<^sub>1 \<star> TTfgh_TfTgh.chine)"
               using fg gh fg\<^sub>0h\<^sub>1.p\<^sub>0_simps fg\<^sub>0h\<^sub>1.p\<^sub>1_simps f\<^sub>0g\<^sub>1.p\<^sub>0_simps f\<^sub>0g\<^sub>1.p\<^sub>1_simps
                     assoc'_naturality [of f.tab TfTgh.p\<^sub>1 TTfgh_TfTgh.chine]
               by simp
             thus ?thesis
               using comp_assoc by presburger
           qed
           also have "... =
                        \<a>[f, g, h \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                        \<a>[f \<star> g, h, tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                        (\<a>\<^sup>-\<^sup>1[f, g, h] \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0) \<cdot>
                        ((f \<star> g \<star> h) \<star> TTfgh_TfTgh.the_\<theta>) \<cdot>
                        \<a>[f \<star> g \<star> h, (tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                        (\<a>\<^sup>-\<^sup>1[f, g \<star> h, (tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0] \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> \<a>[g \<star> h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0]) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> \<a>\<^sup>-\<^sup>1[g, h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> (g \<star> \<a>[h, tab\<^sub>0 h, Tgh.p\<^sub>0]) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> (g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> (g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> \<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> (g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> f\<^sub>0gh\<^sub>1.\<phi>) \<star> TTfgh_TfTgh.chine) \<cdot>
                        (\<a>[f, tab\<^sub>0 f, TfTgh.p\<^sub>1] \<star> TTfgh_TfTgh.chine) \<cdot>
                        \<a>\<^sup>-\<^sup>1[f \<star> tab\<^sub>0 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine] \<cdot>
                        ((\<a>\<^sup>-\<^sup>1[f, tab\<^sub>0 f, TfTgh.p\<^sub>1 \<star> TTfgh_TfTgh.chine] \<cdot>
                        \<a>[f, tab\<^sub>0 f, TfTgh.p\<^sub>1 \<star> TTfgh_TfTgh.chine]) \<cdot>
                        (f.tab \<star> TfTgh.p\<^sub>1 \<star> TTfgh_TfTgh.chine)) \<cdot>
                        \<a>[tab\<^sub>1 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine] \<cdot>
                        TTfgh_TfTgh.the_\<nu> \<cdot>
                        \<a>\<^sup>-\<^sup>1[tab\<^sub>1 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1]"
           proof -
             have "(\<a>\<^sup>-\<^sup>1[f, tab\<^sub>0 f, TfTgh.p\<^sub>1 \<star> TTfgh_TfTgh.chine] \<cdot>
                       \<a>[f, tab\<^sub>0 f, TfTgh.p\<^sub>1 \<star> TTfgh_TfTgh.chine]) \<cdot>
                       (f.tab \<star> TfTgh.p\<^sub>1 \<star> TTfgh_TfTgh.chine) =
                     f.tab \<star> TfTgh.p\<^sub>1 \<star> TTfgh_TfTgh.chine"
               using fg gh fg\<^sub>0h\<^sub>1.p\<^sub>0_simps fg\<^sub>0h\<^sub>1.p\<^sub>1_simps f\<^sub>0g\<^sub>1.p\<^sub>0_simps f\<^sub>0g\<^sub>1.p\<^sub>1_simps
                     comp_cod_arr comp_assoc_assoc'
               by simp
             thus ?thesis
               using comp_assoc by simp
           qed
           also have "... =
                        \<a>[f, g, h \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                        \<a>[f \<star> g, h, tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                        (\<a>\<^sup>-\<^sup>1[f, g, h] \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0) \<cdot>
                        ((f \<star> g \<star> h) \<star> TTfgh_TfTgh.the_\<theta>) \<cdot>
                        \<a>[f \<star> g \<star> h, (tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                        (\<a>\<^sup>-\<^sup>1[f, g \<star> h, (tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0] \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> \<a>[g \<star> h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0]) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> \<a>\<^sup>-\<^sup>1[g, h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> (g \<star> \<a>[h, tab\<^sub>0 h, Tgh.p\<^sub>0]) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> (g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> (g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> \<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> (g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> f\<^sub>0gh\<^sub>1.\<phi>) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((\<a>[f, tab\<^sub>0 f, TfTgh.p\<^sub>1] \<star> TTfgh_TfTgh.chine) \<cdot>
                        \<a>\<^sup>-\<^sup>1[f \<star> tab\<^sub>0 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine] \<cdot>
                        \<a>\<^sup>-\<^sup>1[f, tab\<^sub>0 f, TfTgh.p\<^sub>1 \<star> TTfgh_TfTgh.chine]) \<cdot>
                        \<a>[f, tab\<^sub>0 f, TfTgh.p\<^sub>1 \<star> TTfgh_TfTgh.chine] \<cdot>
                        (f.tab \<star> TfTgh.p\<^sub>1 \<star> TTfgh_TfTgh.chine) \<cdot>
                        \<a>[tab\<^sub>1 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine] \<cdot>
                        TTfgh_TfTgh.the_\<nu> \<cdot>
                        \<a>\<^sup>-\<^sup>1[tab\<^sub>1 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1]"
             using comp_assoc by presburger
           also have "... =
                        \<a>[f, g, h \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                        \<a>[f \<star> g, h, tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                        (\<a>\<^sup>-\<^sup>1[f, g, h] \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0) \<cdot>
                        ((f \<star> g \<star> h) \<star> TTfgh_TfTgh.the_\<theta>) \<cdot>
                        \<a>[f \<star> g \<star> h, (tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                        (\<a>\<^sup>-\<^sup>1[f, g \<star> h, (tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0] \<star> TTfgh_TfTgh.chine) \<cdot>
                        (((f \<star> \<a>[g \<star> h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0]) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> \<a>\<^sup>-\<^sup>1[g, h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> (g \<star> \<a>[h, tab\<^sub>0 h, Tgh.p\<^sub>0]) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> (g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> (g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> \<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> (g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> f\<^sub>0gh\<^sub>1.\<phi>) \<star> TTfgh_TfTgh.chine) \<cdot>
                        \<a>\<^sup>-\<^sup>1[f, tab\<^sub>0 f \<star> TfTgh.p\<^sub>1, TTfgh_TfTgh.chine]) \<cdot>
                        (f \<star> \<a>\<^sup>-\<^sup>1[tab\<^sub>0 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine]) \<cdot>
                        \<a>[f, tab\<^sub>0 f, TfTgh.p\<^sub>1 \<star> TTfgh_TfTgh.chine] \<cdot>
                        (f.tab \<star> TfTgh.p\<^sub>1 \<star> TTfgh_TfTgh.chine) \<cdot>
                        \<a>[tab\<^sub>1 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine] \<cdot>
                        TTfgh_TfTgh.the_\<nu> \<cdot>
                        \<a>\<^sup>-\<^sup>1[tab\<^sub>1 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1]"
           proof -
             have "(\<a>[f, tab\<^sub>0 f, TfTgh.p\<^sub>1] \<star> TTfgh_TfTgh.chine) \<cdot>
                        \<a>\<^sup>-\<^sup>1[f \<star> tab\<^sub>0 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine] \<cdot>
                        \<a>\<^sup>-\<^sup>1[f, tab\<^sub>0 f, TfTgh.p\<^sub>1 \<star> TTfgh_TfTgh.chine] =
                     \<a>\<^sup>-\<^sup>1[f, tab\<^sub>0 f \<star> TfTgh.p\<^sub>1, TTfgh_TfTgh.chine] \<cdot>
                       (f \<star> \<a>\<^sup>-\<^sup>1[tab\<^sub>0 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine])"
             proof -
               have "(\<a>[f, tab\<^sub>0 f, TfTgh.p\<^sub>1] \<star> TTfgh_TfTgh.chine) \<cdot>
                         \<a>\<^sup>-\<^sup>1[f \<star> tab\<^sub>0 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine] \<cdot>
                         \<a>\<^sup>-\<^sup>1[f, tab\<^sub>0 f, TfTgh.p\<^sub>1 \<star> TTfgh_TfTgh.chine] =
                       \<lbrace>(\<^bold>\<a>\<^bold>[\<^bold>\<langle>f\<^bold>\<rangle>, \<^bold>\<langle>tab\<^sub>0 f\<^bold>\<rangle>, \<^bold>\<langle>TfTgh.p\<^sub>1\<^bold>\<rangle>\<^bold>] \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>) \<^bold>\<cdot>
                          \<^bold>\<a>\<^sup>-\<^sup>1\<^bold>[\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 f\<^bold>\<rangle>, \<^bold>\<langle>TfTgh.p\<^sub>1\<^bold>\<rangle>, \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>\<^bold>] \<^bold>\<cdot>
                          \<^bold>\<a>\<^sup>-\<^sup>1\<^bold>[\<^bold>\<langle>f\<^bold>\<rangle>, \<^bold>\<langle>tab\<^sub>0 f\<^bold>\<rangle>, \<^bold>\<langle>TfTgh.p\<^sub>1\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>\<^bold>]\<rbrace>"
                 using \<a>'_def \<alpha>_def by simp
               also have "... = \<lbrace>\<^bold>\<a>\<^sup>-\<^sup>1\<^bold>[\<^bold>\<langle>f\<^bold>\<rangle>, \<^bold>\<langle>tab\<^sub>0 f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>1\<^bold>\<rangle>, \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>\<^bold>] \<^bold>\<cdot>
                                   (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<a>\<^sup>-\<^sup>1\<^bold>[\<^bold>\<langle>tab\<^sub>0 f\<^bold>\<rangle>, \<^bold>\<langle>TfTgh.p\<^sub>1\<^bold>\<rangle>, \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>\<^bold>])\<rbrace>"
                 using fg gh fg\<^sub>0h\<^sub>1.p\<^sub>0_simps fg\<^sub>0h\<^sub>1.p\<^sub>1_simps f\<^sub>0g\<^sub>1.p\<^sub>0_simps f\<^sub>0g\<^sub>1.p\<^sub>1_simps
                 by (intro E.eval_eqI, auto)
               also have "... = \<a>\<^sup>-\<^sup>1[f, tab\<^sub>0 f \<star> TfTgh.p\<^sub>1, TTfgh_TfTgh.chine] \<cdot>
                                    (f \<star> \<a>\<^sup>-\<^sup>1[tab\<^sub>0 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine])"
                 using \<a>'_def \<alpha>_def by simp
               finally show ?thesis by simp
             qed
             thus ?thesis
               using comp_assoc by presburger
           qed
           also have "... =
                        \<a>[f, g, h \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                        \<a>[f \<star> g, h, tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                        (\<a>\<^sup>-\<^sup>1[f, g, h] \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0) \<cdot>
                        ((f \<star> g \<star> h) \<star> TTfgh_TfTgh.the_\<theta>) \<cdot>
                        \<a>[f \<star> g \<star> h, (tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                        (\<a>\<^sup>-\<^sup>1[f, g \<star> h, (tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0] \<star> TTfgh_TfTgh.chine) \<cdot>
                        \<a>\<^sup>-\<^sup>1[f, (g \<star> h) \<star> (tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                        (f \<star> \<a>[g \<star> h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0] \<star> TTfgh_TfTgh.chine) \<cdot>
                        (f \<star> (\<a>\<^sup>-\<^sup>1[g, h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        (f \<star> ((g \<star> \<a>[h, tab\<^sub>0 h, Tgh.p\<^sub>0]) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> ((g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        (f \<star> ((g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        (f \<star> (\<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        (f \<star> ((g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        (f \<star> f\<^sub>0gh\<^sub>1.\<phi> \<star> TTfgh_TfTgh.chine) \<cdot>
                        (f \<star> \<a>\<^sup>-\<^sup>1[tab\<^sub>0 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine])) \<cdot>
                        \<a>[f, tab\<^sub>0 f, TfTgh.p\<^sub>1 \<star> TTfgh_TfTgh.chine] \<cdot>
                        (f.tab \<star> TfTgh.p\<^sub>1 \<star> TTfgh_TfTgh.chine) \<cdot>
                        \<a>[tab\<^sub>1 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine] \<cdot>
                        TTfgh_TfTgh.the_\<nu> \<cdot>
                        \<a>\<^sup>-\<^sup>1[tab\<^sub>1 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1]"
           proof -
             have "((f \<star> \<a>[g \<star> h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0]) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> \<a>\<^sup>-\<^sup>1[g, h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> (g \<star> \<a>[h, tab\<^sub>0 h, Tgh.p\<^sub>0]) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> (g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> (g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> \<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> (g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        ((f \<star> f\<^sub>0gh\<^sub>1.\<phi>) \<star> TTfgh_TfTgh.chine) \<cdot>
                        \<a>\<^sup>-\<^sup>1[f, tab\<^sub>0 f \<star> TfTgh.p\<^sub>1, TTfgh_TfTgh.chine] =
                     \<a>\<^sup>-\<^sup>1[f, (g \<star> h) \<star> (tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                        (f \<star> \<a>[g \<star> h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0] \<star> TTfgh_TfTgh.chine) \<cdot>
                        (f \<star> (\<a>\<^sup>-\<^sup>1[g, h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        (f \<star> ((g \<star> \<a>[h, tab\<^sub>0 h, Tgh.p\<^sub>0]) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        (f \<star> ((g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        (f \<star> ((g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        (f \<star> (\<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        (f \<star> ((g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        (f \<star> f\<^sub>0gh\<^sub>1.\<phi> \<star> TTfgh_TfTgh.chine)"
             proof -
               (*
                * This one can't be shortcut with a straight coherence-based proof,
                * due to the presence of f\<^sub>0gh\<^sub>1.\<phi>, g\<^sub>0h\<^sub>1.\<phi>, h.tab, with associativities that
                * do not respect their domain and codomain.
                *
                * I also tried to avoid distributing the "f \<star>" in advance, in order to
                * reduce the number of associativity proof steps, but it then becomes
                * less automatic to prove the necessary "arr" facts to do the proof.
                * So unfortunately the mindless grind seems to be the path of least
                * resistance.
                *)
               have "((f \<star> \<a>[g \<star> h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0]) \<star> TTfgh_TfTgh.chine) \<cdot>
                         ((f \<star> \<a>\<^sup>-\<^sup>1[g, h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                         ((f \<star> (g \<star> \<a>[h, tab\<^sub>0 h, Tgh.p\<^sub>0]) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                         ((f \<star> (g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                         ((f \<star> (g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                         ((f \<star> \<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                         ((f \<star> (g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                         ((f \<star> f\<^sub>0gh\<^sub>1.\<phi>) \<star> TTfgh_TfTgh.chine) \<cdot>
                         \<a>\<^sup>-\<^sup>1[f, tab\<^sub>0 f \<star> TfTgh.p\<^sub>1, TTfgh_TfTgh.chine] =
                       ((f \<star> \<a>[g \<star> h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0]) \<star> TTfgh_TfTgh.chine) \<cdot>
                         ((f \<star> \<a>\<^sup>-\<^sup>1[g, h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                         ((f \<star> (g \<star> \<a>[h, tab\<^sub>0 h, Tgh.p\<^sub>0]) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                         ((f \<star> (g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                         ((f \<star> (g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                         ((f \<star> \<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                         (((f \<star> (g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                         \<a>\<^sup>-\<^sup>1[f, (tab\<^sub>1 g \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0, TTfgh_TfTgh.chine]) \<cdot>
                         (f \<star> f\<^sub>0gh\<^sub>1.\<phi> \<star> TTfgh_TfTgh.chine)"
                 using fg gh fg\<^sub>0h\<^sub>1.p\<^sub>0_simps fg\<^sub>0h\<^sub>1.p\<^sub>1_simps f\<^sub>0g\<^sub>1.p\<^sub>0_simps f\<^sub>0g\<^sub>1.p\<^sub>1_simps
                       assoc'_naturality [of f f\<^sub>0gh\<^sub>1.\<phi> TTfgh_TfTgh.chine] comp_assoc
                 by simp
               also have "... =
                            ((f \<star> \<a>[g \<star> h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0]) \<star> TTfgh_TfTgh.chine) \<cdot>
                              ((f \<star> \<a>\<^sup>-\<^sup>1[g, h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                              ((f \<star> (g \<star> \<a>[h, tab\<^sub>0 h, Tgh.p\<^sub>0]) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                              ((f \<star> (g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                              ((f \<star> (g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                              (((f \<star> \<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                              \<a>\<^sup>-\<^sup>1[f, ((g \<star> tab\<^sub>0 g) \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0, TTfgh_TfTgh.chine]) \<cdot>
                              (f \<star> ((g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                              (f \<star> f\<^sub>0gh\<^sub>1.\<phi> \<star> TTfgh_TfTgh.chine)"
               proof -
                 have "((f \<star> (g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                           \<a>\<^sup>-\<^sup>1[f, (tab\<^sub>1 g \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] =
                         \<a>\<^sup>-\<^sup>1[f, ((g \<star> tab\<^sub>0 g) \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                           (f \<star> ((g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine)"
                   using fg gh fg\<^sub>0h\<^sub>1.p\<^sub>0_simps fg\<^sub>0h\<^sub>1.p\<^sub>1_simps f\<^sub>0g\<^sub>1.p\<^sub>0_simps f\<^sub>0g\<^sub>1.p\<^sub>1_simps
                         assoc'_naturality [of f "(g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0" TTfgh_TfTgh.chine]
                   by simp
                 thus ?thesis
                   using comp_assoc by presburger
               qed
               also have "... =
                            ((f \<star> \<a>[g \<star> h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0]) \<star> TTfgh_TfTgh.chine) \<cdot>
                              ((f \<star> \<a>\<^sup>-\<^sup>1[g, h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                              ((f \<star> (g \<star> \<a>[h, tab\<^sub>0 h, Tgh.p\<^sub>0]) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                              ((f \<star> (g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                              (((f \<star> (g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                              \<a>\<^sup>-\<^sup>1[f, (g \<star> tab\<^sub>0 g \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0, TTfgh_TfTgh.chine]) \<cdot>
                              (f \<star> (\<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                              (f \<star> ((g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                              (f \<star> f\<^sub>0gh\<^sub>1.\<phi> \<star> TTfgh_TfTgh.chine)"
               proof -
                 have "((f \<star> \<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                           \<a>\<^sup>-\<^sup>1[f, ((g \<star> tab\<^sub>0 g) \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] =
                         \<a>\<^sup>-\<^sup>1[f, (g \<star> tab\<^sub>0 g \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                           (f \<star> (\<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine)"
                   using fg gh fg\<^sub>0h\<^sub>1.p\<^sub>0_simps fg\<^sub>0h\<^sub>1.p\<^sub>1_simps f\<^sub>0g\<^sub>1.p\<^sub>0_simps f\<^sub>0g\<^sub>1.p\<^sub>1_simps
                           assoc'_naturality
                             [of f "\<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0" TTfgh_TfTgh.chine]
                   by simp
                 thus ?thesis
                   using comp_assoc by presburger
               qed
               also have "... =
                            ((f \<star> \<a>[g \<star> h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0]) \<star> TTfgh_TfTgh.chine) \<cdot>
                              ((f \<star> \<a>\<^sup>-\<^sup>1[g, h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                              ((f \<star> (g \<star> \<a>[h, tab\<^sub>0 h, Tgh.p\<^sub>0]) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                              (((f \<star> (g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                              \<a>\<^sup>-\<^sup>1[f, (g \<star> tab\<^sub>1 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0, TTfgh_TfTgh.chine]) \<cdot>
                              (f \<star> ((g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                              (f \<star> (\<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                              (f \<star> ((g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                              (f \<star> f\<^sub>0gh\<^sub>1.\<phi> \<star> TTfgh_TfTgh.chine)"
               proof -
                 have "((f \<star> (g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                           \<a>\<^sup>-\<^sup>1[f, (g \<star> tab\<^sub>0 g \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] =
                         \<a>\<^sup>-\<^sup>1[f, (g \<star> tab\<^sub>1 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                           (f \<star> ((g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine)"
                   using fg gh fg\<^sub>0h\<^sub>1.p\<^sub>0_simps fg\<^sub>0h\<^sub>1.p\<^sub>1_simps f\<^sub>0g\<^sub>1.p\<^sub>0_simps f\<^sub>0g\<^sub>1.p\<^sub>1_simps
                         assoc'_naturality [of f "(g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0" TTfgh_TfTgh.chine]
                   by simp
                 thus ?thesis
                   using comp_assoc by presburger
               qed
               also have "... =
                            (((f \<star> \<a>[g \<star> h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0]) \<star> TTfgh_TfTgh.chine) \<cdot>
                              ((f \<star> \<a>\<^sup>-\<^sup>1[g, h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                              ((f \<star> (g \<star> \<a>[h, tab\<^sub>0 h, Tgh.p\<^sub>0]) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                              \<a>\<^sup>-\<^sup>1[f, (g \<star> (h \<star> tab\<^sub>0 h) \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0, TTfgh_TfTgh.chine]) \<cdot>
                              (f \<star> ((g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                              (f \<star> ((g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                              (f \<star> (\<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                              (f \<star> ((g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                              (f \<star> f\<^sub>0gh\<^sub>1.\<phi> \<star> TTfgh_TfTgh.chine)"
               proof -
                 have "((f \<star> (g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                           \<a>\<^sup>-\<^sup>1[f, (g \<star> tab\<^sub>1 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] =
                         \<a>\<^sup>-\<^sup>1[f, (g \<star> (h \<star> tab\<^sub>0 h) \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                           (f \<star> ((g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine)"
                   using fg gh fg\<^sub>0h\<^sub>1.p\<^sub>0_simps fg\<^sub>0h\<^sub>1.p\<^sub>1_simps f\<^sub>0g\<^sub>1.p\<^sub>0_simps f\<^sub>0g\<^sub>1.p\<^sub>1_simps
                         assoc'_naturality
                           [of f "(g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0" TTfgh_TfTgh.chine]
                   by simp
                 thus ?thesis
                   using comp_assoc by presburger
               qed
               also have "... =
                            \<a>\<^sup>-\<^sup>1[f, (g \<star> h) \<star> (tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                              (f \<star> \<a>[g \<star> h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0] \<star> TTfgh_TfTgh.chine) \<cdot>
                              (f \<star> (\<a>\<^sup>-\<^sup>1[g, h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                              (f \<star> ((g \<star> \<a>[h, tab\<^sub>0 h, Tgh.p\<^sub>0]) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                              (f \<star> ((g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                              (f \<star> ((g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                              (f \<star> (\<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                              (f \<star> ((g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                              (f \<star> f\<^sub>0gh\<^sub>1.\<phi> \<star> TTfgh_TfTgh.chine)"
               proof -
                 (* OK, we can perhaps shortcut the last few steps... *)
                 have "((f \<star> \<a>[g \<star> h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0]) \<star> TTfgh_TfTgh.chine) \<cdot>
                           ((f \<star> \<a>\<^sup>-\<^sup>1[g, h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                           ((f \<star> (g \<star> \<a>[h, tab\<^sub>0 h, Tgh.p\<^sub>0]) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                           \<a>\<^sup>-\<^sup>1[f, (g \<star> (h \<star> tab\<^sub>0 h) \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] =
                         \<lbrace>((\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<a>\<^bold>[\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle>, \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>, \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>\<^bold>])
                               \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>) \<^bold>\<cdot>
                            ((\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<a>\<^sup>-\<^sup>1\<^bold>[\<^bold>\<langle>g\<^bold>\<rangle>, \<^bold>\<langle>h\<^bold>\<rangle>, \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>\<^bold>] \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>)
                                 \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>) \<^bold>\<cdot>
                            ((\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> (\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<a>\<^bold>[\<^bold>\<langle>h\<^bold>\<rangle>, \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>, \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>\<^bold>]) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>)
                                 \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>) \<^bold>\<cdot>
                            \<^bold>\<a>\<^sup>-\<^sup>1\<^bold>[\<^bold>\<langle>f\<^bold>\<rangle>, (\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>,
                                \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>\<^bold>]\<rbrace>"
                   using fg gh fg\<^sub>0h\<^sub>1.p\<^sub>0_simps fg\<^sub>0h\<^sub>1.p\<^sub>1_simps f\<^sub>0g\<^sub>1.p\<^sub>0_simps f\<^sub>0g\<^sub>1.p\<^sub>1_simps
                         \<a>'_def \<alpha>_def
                   by simp
                 also have "... =
                              \<lbrace>\<^bold>\<a>\<^sup>-\<^sup>1\<^bold>[\<^bold>\<langle>f\<^bold>\<rangle>, (\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle>) \<^bold>\<star> (\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>,
                                   \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>\<^bold>] \<^bold>\<cdot>
                                 (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> (\<^bold>\<a>\<^bold>[\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle>, \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>, \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>\<^bold>])
                                     \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>) \<^bold>\<cdot>
                                 (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> (\<^bold>\<a>\<^sup>-\<^sup>1\<^bold>[\<^bold>\<langle>g\<^bold>\<rangle>, \<^bold>\<langle>h\<^bold>\<rangle>, \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>\<^bold>] \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>)
                                      \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>) \<^bold>\<cdot>
                                 (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> ((\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<a>\<^bold>[\<^bold>\<langle>h\<^bold>\<rangle>, \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>, \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>\<^bold>]) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>)
                                      \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)\<rbrace>"
                     using fg gh fg\<^sub>0h\<^sub>1.p\<^sub>0_simps fg\<^sub>0h\<^sub>1.p\<^sub>1_simps f\<^sub>0g\<^sub>1.p\<^sub>0_simps f\<^sub>0g\<^sub>1.p\<^sub>1_simps
                     apply (intro E.eval_eqI) by simp_all
                   also have "... =
                              \<a>\<^sup>-\<^sup>1[f, (g \<star> h) \<star> (tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                                (f \<star> \<a>[g \<star> h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0] \<star> TTfgh_TfTgh.chine) \<cdot>
                                (f \<star> (\<a>\<^sup>-\<^sup>1[g, h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                                (f \<star> ((g \<star> \<a>[h, tab\<^sub>0 h, Tgh.p\<^sub>0]) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine)"
                   using fg gh fg\<^sub>0h\<^sub>1.p\<^sub>0_simps fg\<^sub>0h\<^sub>1.p\<^sub>1_simps f\<^sub>0g\<^sub>1.p\<^sub>0_simps f\<^sub>0g\<^sub>1.p\<^sub>1_simps
                         \<a>'_def \<alpha>_def
                   by simp
                 finally show ?thesis
                   using comp_assoc by presburger
               qed
               finally show ?thesis
                 using comp_assoc by presburger
             qed
             thus ?thesis
               using comp_assoc by presburger
           qed
           also have "... =
                        (\<a>[f, g, h \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                        \<a>[f \<star> g, h, tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                        (\<a>\<^sup>-\<^sup>1[f, g, h] \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0) \<cdot>
                        ((f \<star> g \<star> h) \<star> TTfgh_TfTgh.the_\<theta>)) \<cdot>
                        \<a>[f \<star> g \<star> h, (tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                        (\<a>\<^sup>-\<^sup>1[f, g \<star> h, (tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0] \<star> TTfgh_TfTgh.chine) \<cdot>
                        \<a>\<^sup>-\<^sup>1[f, (g \<star> h) \<star> (tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                        (f \<star> \<a>[g \<star> h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0] \<star> TTfgh_TfTgh.chine) \<cdot>
                        (f \<star> (\<a>\<^sup>-\<^sup>1[g, h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        (f \<star> ((g \<star> \<a>[h, tab\<^sub>0 h, Tgh.p\<^sub>0]) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        (f \<star> (((g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                             (((g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                             ((\<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                             (((g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                             (f\<^sub>0gh\<^sub>1.\<phi> \<star> TTfgh_TfTgh.chine) \<cdot>
                             \<a>\<^sup>-\<^sup>1[tab\<^sub>0 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine]) \<cdot>
                        \<a>[f, tab\<^sub>0 f, TfTgh.p\<^sub>1 \<star> TTfgh_TfTgh.chine] \<cdot>
                        (f.tab \<star> TfTgh.p\<^sub>1 \<star> TTfgh_TfTgh.chine) \<cdot>
                        \<a>[tab\<^sub>1 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine] \<cdot>
                        TTfgh_TfTgh.the_\<nu> \<cdot>
                        \<a>\<^sup>-\<^sup>1[tab\<^sub>1 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1]"
           proof -
             have "(f \<star> ((g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                       (f \<star> ((g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                       (f \<star> (\<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                       (f \<star> ((g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                       (f \<star> f\<^sub>0gh\<^sub>1.\<phi> \<star> TTfgh_TfTgh.chine) \<cdot>
                       (f \<star> \<a>\<^sup>-\<^sup>1[tab\<^sub>0 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine]) =
                     (f \<star> (((g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                            (((g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                            ((\<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                            (((g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                            (f\<^sub>0gh\<^sub>1.\<phi> \<star> TTfgh_TfTgh.chine) \<cdot>
                            \<a>\<^sup>-\<^sup>1[tab\<^sub>0 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine])"
             proof -
               have "arr ((((g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                             (((g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                             ((\<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                             (((g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                             (f\<^sub>0gh\<^sub>1.\<phi> \<star> TTfgh_TfTgh.chine) \<cdot>
                             \<a>\<^sup>-\<^sup>1[tab\<^sub>0 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine])"
                 using fg gh
                 apply (intro seqI) by auto
               moreover
               have "arr ((((g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                             ((\<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                             (((g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                             (f\<^sub>0gh\<^sub>1.\<phi> \<star> TTfgh_TfTgh.chine) \<cdot>
                             \<a>\<^sup>-\<^sup>1[tab\<^sub>0 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine])"
                 using calculation by blast
               moreover
               have "arr (((\<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                             (((g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                             (f\<^sub>0gh\<^sub>1.\<phi> \<star> TTfgh_TfTgh.chine) \<cdot>
                             \<a>\<^sup>-\<^sup>1[tab\<^sub>0 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine])"
                 using calculation by blast
               moreover
               have "arr ((((g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                             (f\<^sub>0gh\<^sub>1.\<phi> \<star> TTfgh_TfTgh.chine) \<cdot>
                             \<a>\<^sup>-\<^sup>1[tab\<^sub>0 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine])"
                 using calculation by blast
               moreover
               have "arr ((f\<^sub>0gh\<^sub>1.\<phi> \<star> TTfgh_TfTgh.chine) \<cdot>
                             \<a>\<^sup>-\<^sup>1[tab\<^sub>0 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine])"
                 using calculation by blast
               ultimately show ?thesis
                 using whisker_left f.ide_base by presburger
             qed
             thus ?thesis
               using comp_assoc by presburger
           qed
           also have "... =
                        (f \<star> g \<star> h \<star> TTfgh_TfTgh.the_\<theta>) \<cdot>
                        (\<a>[f, g, h \<star> ((tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine] \<cdot>
                        \<a>[f \<star> g, h, ((tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine] \<cdot>
                        (\<a>\<^sup>-\<^sup>1[f, g, h] \<star> ((tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        \<a>[f \<star> g \<star> h, (tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                        (\<a>\<^sup>-\<^sup>1[f, g \<star> h, (tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0] \<star> TTfgh_TfTgh.chine) \<cdot>
                        \<a>\<^sup>-\<^sup>1[f, (g \<star> h) \<star> (tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                        (f \<star> \<a>[g \<star> h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0] \<star> TTfgh_TfTgh.chine) \<cdot>
                        (f \<star> (\<a>\<^sup>-\<^sup>1[g, h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        (f \<star> ((g \<star> \<a>[h, tab\<^sub>0 h, Tgh.p\<^sub>0]) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine)) \<cdot>
                        (f \<star> (((g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                             (((g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                             ((\<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                             (((g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                             (f\<^sub>0gh\<^sub>1.\<phi> \<star> TTfgh_TfTgh.chine) \<cdot>
                             \<a>\<^sup>-\<^sup>1[tab\<^sub>0 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine]) \<cdot>
                        \<a>[f, tab\<^sub>0 f, TfTgh.p\<^sub>1 \<star> TTfgh_TfTgh.chine] \<cdot>
                        (f.tab \<star> TfTgh.p\<^sub>1 \<star> TTfgh_TfTgh.chine) \<cdot>
                        \<a>[tab\<^sub>1 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine] \<cdot>
                        TTfgh_TfTgh.the_\<nu> \<cdot>
                        \<a>\<^sup>-\<^sup>1[tab\<^sub>1 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1]"
           proof -
             have "\<a>[f, g, h \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                        \<a>[f \<star> g, h, tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                        (\<a>\<^sup>-\<^sup>1[f, g, h] \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0) \<cdot>
                        ((f \<star> g \<star> h) \<star> TTfgh_TfTgh.the_\<theta>) =
                     \<a>[f, g, h \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                        (\<a>[f \<star> g, h, tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                        (((f \<star> g) \<star> h) \<star> TTfgh_TfTgh.the_\<theta>)) \<cdot>
                        (\<a>\<^sup>-\<^sup>1[f, g, h] \<star> ((tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine)"
             proof -
               have "(\<a>\<^sup>-\<^sup>1[f, g, h] \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0) \<cdot> ((f \<star> g \<star> h) \<star> TTfgh_TfTgh.the_\<theta>) =
                       \<a>\<^sup>-\<^sup>1[f, g, h] \<star> TTfgh_TfTgh.the_\<theta>"
                 using fg gh comp_arr_dom comp_cod_arr
                       interchange [of "\<a>\<^sup>-\<^sup>1[f, g, h]" "f \<star> g \<star> h"
                                       "tab\<^sub>0 h \<star> TTfgh.p\<^sub>0" TTfgh_TfTgh.the_\<theta>]
                 by simp
               also have "... = (((f \<star> g) \<star> h) \<star> TTfgh_TfTgh.the_\<theta>) \<cdot>
                                (\<a>\<^sup>-\<^sup>1[f, g, h] \<star> ((tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine)"
                 using fg gh comp_arr_dom comp_cod_arr
                       interchange [of "(f \<star> g) \<star> h" "\<a>\<^sup>-\<^sup>1[f, g, h]" TTfgh_TfTgh.the_\<theta>
                                       "((tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine"]
                 by simp
               finally show ?thesis
                 using comp_assoc by presburger
             qed
             also have "... =
                          (\<a>[f, g, h \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0] \<cdot>
                            ((f \<star> g) \<star> h \<star> TTfgh_TfTgh.the_\<theta>)) \<cdot>
                            \<a>[f \<star> g, h, ((tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine] \<cdot>
                            (\<a>\<^sup>-\<^sup>1[f, g, h] \<star> ((tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine)"
               using fg gh assoc_naturality [of "f \<star> g" h TTfgh_TfTgh.the_\<theta>] comp_assoc
               by simp
             also have "... =
                          (f \<star> g \<star> h \<star> TTfgh_TfTgh.the_\<theta>) \<cdot>
                            \<a>[f, g, h \<star> ((tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine] \<cdot>
                            \<a>[f \<star> g, h, ((tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine] \<cdot>
                            (\<a>\<^sup>-\<^sup>1[f, g, h] \<star> ((tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine)"
               using fg gh assoc_naturality [of f g "h \<star> TTfgh_TfTgh.the_\<theta>"] comp_assoc
               by simp
             finally show ?thesis
               using comp_assoc by presburger
           qed
           also have "... =
                        ((f \<star> g \<star> h \<star> TTfgh_TfTgh.the_\<theta>) \<cdot>
                        (f \<star> can (\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> ((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                                 (((\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)) \<cdot>
                        (f \<star> (((g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                             (((g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                             ((\<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                             (((g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                             (f\<^sub>0gh\<^sub>1.\<phi> \<star> TTfgh_TfTgh.chine) \<cdot>
                             \<a>\<^sup>-\<^sup>1[tab\<^sub>0 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine])) \<cdot>
                        \<a>[f, tab\<^sub>0 f, TfTgh.p\<^sub>1 \<star> TTfgh_TfTgh.chine] \<cdot>
                        (f.tab \<star> TfTgh.p\<^sub>1 \<star> TTfgh_TfTgh.chine) \<cdot>
                        \<a>[tab\<^sub>1 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine] \<cdot>
                        TTfgh_TfTgh.the_\<nu> \<cdot>
                        \<a>\<^sup>-\<^sup>1[tab\<^sub>1 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1]"
           proof -
             have "\<a>[f, g, h \<star> ((tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine] \<cdot>
                        \<a>[f \<star> g, h, ((tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine] \<cdot>
                        (\<a>\<^sup>-\<^sup>1[f, g, h] \<star> ((tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        \<a>[f \<star> g \<star> h, (tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                        (\<a>\<^sup>-\<^sup>1[f, g \<star> h, (tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0] \<star> TTfgh_TfTgh.chine) \<cdot>
                        \<a>\<^sup>-\<^sup>1[f, (g \<star> h) \<star> (tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                        (f \<star> \<a>[g \<star> h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0] \<star> TTfgh_TfTgh.chine) \<cdot>
                        (f \<star> (\<a>\<^sup>-\<^sup>1[g, h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                        (f \<star> ((g \<star> \<a>[h, tab\<^sub>0 h, Tgh.p\<^sub>0]) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) =
                     f \<star> can
                           (\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> ((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                           (((\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)"
             proof -
               have "\<a>[f, g, h \<star> ((tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine] \<cdot>
                         \<a>[f \<star> g, h, ((tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine] \<cdot>
                         (\<a>\<^sup>-\<^sup>1[f, g, h] \<star> ((tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                         \<a>[f \<star> g \<star> h, (tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                         (\<a>\<^sup>-\<^sup>1[f, g \<star> h, (tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0] \<star> TTfgh_TfTgh.chine) \<cdot>
                         \<a>\<^sup>-\<^sup>1[f, (g \<star> h) \<star> (tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                         (f \<star> \<a>[g \<star> h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0] \<star> TTfgh_TfTgh.chine) \<cdot>
                         (f \<star> (\<a>\<^sup>-\<^sup>1[g, h, tab\<^sub>0 h \<star> Tgh.p\<^sub>0] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                         (f \<star> ((g \<star> \<a>[h, tab\<^sub>0 h, Tgh.p\<^sub>0]) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) =
                       \<lbrace>\<^bold>\<a>\<^bold>[\<^bold>\<langle>f\<^bold>\<rangle>, \<^bold>\<langle>g\<^bold>\<rangle>,
                          \<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> ((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>\<^bold>] \<^bold>\<cdot>
                         \<^bold>\<a>\<^bold>[\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle>, \<^bold>\<langle>h\<^bold>\<rangle>,
                          ((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>\<^bold>] \<^bold>\<cdot>
                         (\<^bold>\<a>\<^sup>-\<^sup>1\<^bold>[\<^bold>\<langle>f\<^bold>\<rangle>, \<^bold>\<langle>g\<^bold>\<rangle>, \<^bold>\<langle>h\<^bold>\<rangle>\<^bold>]
                            \<^bold>\<star> ((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>) \<^bold>\<cdot>
                         \<^bold>\<a>\<^bold>[\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle>, (\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>,
                           \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>\<^bold>] \<^bold>\<cdot>
                         (\<^bold>\<a>\<^sup>-\<^sup>1\<^bold>[\<^bold>\<langle>f\<^bold>\<rangle>, \<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle>,
                              (\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>\<^bold>] \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>) \<^bold>\<cdot>
                         \<^bold>\<a>\<^sup>-\<^sup>1\<^bold>[\<^bold>\<langle>f\<^bold>\<rangle>, (\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle>) \<^bold>\<star> (\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>,
                             \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>\<^bold>] \<^bold>\<cdot>
                         (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<a>\<^bold>[\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle>, \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>, \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>\<^bold>] \<^bold>\<star>
                           \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>) \<^bold>\<cdot>
                         (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> (\<^bold>\<a>\<^sup>-\<^sup>1\<^bold>[\<^bold>\<langle>g\<^bold>\<rangle>, \<^bold>\<langle>h\<^bold>\<rangle>, \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>\<^bold>] \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>)
                            \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>) \<^bold>\<cdot>
                         (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> ((\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<a>\<^bold>[\<^bold>\<langle>h\<^bold>\<rangle>, \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>, \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>\<^bold>]) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>)
                            \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)\<rbrace>"
                 using \<a>'_def \<alpha>_def by simp
               also have "... =
                          can (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> (\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> ((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>)
                                 \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>))
                            (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> (((\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>)
                                 \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>))"
                 using fg gh
                 apply (unfold can_def)
                 apply (intro E.eval_eqI)
                 by simp_all
               also have "... =
                          f \<star> can (\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> ((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>)
                                     \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                                  (((\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>)
                                     \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)"
                 using fg gh whisker_can_left_0 by simp
               finally show ?thesis by blast
             qed
             thus ?thesis
               using comp_assoc by presburger
           qed
           also have "... =
                        (f \<star> (g \<star> h \<star> TTfgh_TfTgh.the_\<theta>) \<cdot>
                           can (\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> ((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>)
                                  \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                               (((\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>)
                                  \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>) \<cdot>
                           (((g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                           (((g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                           ((\<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                           (((g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                           (f\<^sub>0gh\<^sub>1.\<phi> \<star> TTfgh_TfTgh.chine) \<cdot>
                           \<a>\<^sup>-\<^sup>1[tab\<^sub>0 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine]) \<cdot>
                        \<a>[f, tab\<^sub>0 f, TfTgh.p\<^sub>1 \<star> TTfgh_TfTgh.chine] \<cdot>
                        (f.tab \<star> TfTgh.p\<^sub>1 \<star> TTfgh_TfTgh.chine) \<cdot>
                        \<a>[tab\<^sub>1 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine] \<cdot>
                        TTfgh_TfTgh.the_\<nu> \<cdot>
                        \<a>\<^sup>-\<^sup>1[tab\<^sub>1 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1]"
           proof -
             have "((f \<star> g \<star> h \<star> TTfgh_TfTgh.the_\<theta>) \<cdot>
                        (f \<star> can (\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> ((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>)
                                    \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                                 (((\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>)
                                    \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)) \<cdot>
                        (f \<star> (((g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                             (((g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                             ((\<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                             (((g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                             (f\<^sub>0gh\<^sub>1.\<phi> \<star> TTfgh_TfTgh.chine) \<cdot>
                             \<a>\<^sup>-\<^sup>1[tab\<^sub>0 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine])) =
                     f \<star> (g \<star> h \<star> TTfgh_TfTgh.the_\<theta>) \<cdot>
                           can (\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> ((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>)
                                  \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                               (((\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>)
                                  \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>) \<cdot>
                           (((g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                           (((g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                           ((\<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                           (((g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                           (f\<^sub>0gh\<^sub>1.\<phi> \<star> TTfgh_TfTgh.chine) \<cdot>
                           \<a>\<^sup>-\<^sup>1[tab\<^sub>0 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine]"
             proof -
               have 1: "arr ((g \<star> h \<star> TTfgh_TfTgh.the_\<theta>) \<cdot>
                            can (\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> ((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>)
                                   \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                                (((\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>)
                                   \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>) \<cdot>
                            (((g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                            (((g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                            ((\<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                            (((g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                            (f\<^sub>0gh\<^sub>1.\<phi> \<star> TTfgh_TfTgh.chine) \<cdot>
                            \<a>\<^sup>-\<^sup>1[tab\<^sub>0 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine])"
                 using fg gh
                 apply (intro seqI' comp_in_homI) by auto
               moreover
               have 2: "arr (can (\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> ((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>)
                                    \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                                (((\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>)
                                    \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>) \<cdot>
                            (((g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                            (((g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                            ((\<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                            (((g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                            (f\<^sub>0gh\<^sub>1.\<phi> \<star> TTfgh_TfTgh.chine) \<cdot>
                            \<a>\<^sup>-\<^sup>1[tab\<^sub>0 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine])"
                 using calculation by blast
               ultimately show ?thesis
                 using whisker_left f.ide_base by presburger
             qed
             thus ?thesis
               using comp_assoc by presburger
           qed
           also have "... = f.composite_cell w\<^sub>f' \<theta>\<^sub>f' \<cdot> \<beta>\<^sub>f"
             unfolding w\<^sub>f'_def \<theta>\<^sub>f'_def \<beta>\<^sub>f_def
             using comp_assoc by presburger
           finally show ?thesis by blast
         qed
         show ?thesis
           using w\<^sub>f w\<^sub>f' \<theta>\<^sub>f \<theta>\<^sub>f' \<beta>\<^sub>f f.T2 [of w\<^sub>f w\<^sub>f' \<theta>\<^sub>f u\<^sub>f \<theta>\<^sub>f' \<beta>\<^sub>f] eq\<^sub>f by fast
       qed
       obtain \<gamma>\<^sub>f where \<gamma>\<^sub>f: "\<guillemotleft>\<gamma>\<^sub>f : w\<^sub>f \<Rightarrow> w\<^sub>f'\<guillemotright> \<and> \<beta>\<^sub>f = tab\<^sub>1 f \<star> \<gamma>\<^sub>f \<and> \<theta>\<^sub>f = \<theta>\<^sub>f' \<cdot> (tab\<^sub>0 f \<star> \<gamma>\<^sub>f)"
         using 5 by auto
       show "\<lbrakk>\<lbrakk>TfTgh.p\<^sub>1 \<star> TTfgh_TfTgh.chine\<rbrakk>\<rbrakk> = \<lbrakk>\<lbrakk>Tfg.p\<^sub>1 \<star> TTfgh.p\<^sub>1\<rbrakk>\<rbrakk>"
       proof -
         have "iso \<gamma>\<^sub>f"
           using \<gamma>\<^sub>f BS3 w\<^sub>f_is_map w\<^sub>f'_is_map by blast
         hence "isomorphic w\<^sub>f w\<^sub>f'"
           using \<gamma>\<^sub>f isomorphic_def isomorphic_symmetric by auto
         thus ?thesis
           using w\<^sub>f w\<^sub>f_def w\<^sub>f'_def Maps.CLS_eqI isomorphic_symmetric by auto
       qed
       text \<open>
         On to the next equation:
         \[
            \<open>\<lbrakk>\<lbrakk>Tgh.p\<^sub>1 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine\<rbrakk>\<rbrakk> = \<lbrakk>\<lbrakk>Tfg.p\<^sub>0 \<star> TTfgh.p\<^sub>1\<rbrakk>\<rbrakk>\<close>.
         \]
         We have to make use of the equation \<open>\<theta>\<^sub>f = \<theta>\<^sub>f' \<cdot> (tab\<^sub>0 f \<star> \<gamma>\<^sub>f)\<close> in this part,
         similarly to how the equation \<open>src_tab_eq\<close> was used to replace
         \<open>TTfgh.tab\<close> in the first part.
       \<close>
       define u\<^sub>g where "u\<^sub>g = h \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0"
       define w\<^sub>g where "w\<^sub>g = Tfg.p\<^sub>0 \<star> TTfgh.p\<^sub>1"
       define w\<^sub>g' where "w\<^sub>g' = Tgh.p\<^sub>1 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine"
       define \<theta>\<^sub>g
       where "\<theta>\<^sub>g = \<a>[h, tab\<^sub>0 h, TTfgh.p\<^sub>0] \<cdot> (h.tab \<star> TTfgh.p\<^sub>0) \<cdot> fg\<^sub>0h\<^sub>1.\<phi> \<cdot>
                     \<a>\<^sup>-\<^sup>1[tab\<^sub>0 g, Tfg.p\<^sub>0, TTfgh.p\<^sub>1]"
       define \<theta>\<^sub>g'
       where "\<theta>\<^sub>g' = (h \<star> TTfgh_TfTgh.the_\<theta>) \<cdot>
                    can (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> ((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                        (((\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>) \<cdot>
                    ((h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                    (g\<^sub>0h\<^sub>1.\<phi> \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                    \<a>\<^sup>-\<^sup>1[tab\<^sub>0 g, Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine]"
       define \<beta>\<^sub>g
       where "\<beta>\<^sub>g = \<a>[tab\<^sub>1 g, Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                   \<a>[tab\<^sub>1 g \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                   (f\<^sub>0gh\<^sub>1.\<phi> \<star> TTfgh_TfTgh.chine) \<cdot> \<a>\<^sup>-\<^sup>1[tab\<^sub>0 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine] \<cdot>
                   (tab\<^sub>0 f \<star> \<gamma>\<^sub>f) \<cdot> \<a>[tab\<^sub>0 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1] \<cdot> (inv f\<^sub>0g\<^sub>1.\<phi> \<star> TTfgh.p\<^sub>1) \<cdot>
                   \<a>\<^sup>-\<^sup>1[tab\<^sub>1 g, Tfg.p\<^sub>0, TTfgh.p\<^sub>1]"
       have u\<^sub>g: "ide u\<^sub>g"
         unfolding u\<^sub>g_def by simp
       have w\<^sub>g: "ide w\<^sub>g"
         unfolding w\<^sub>g_def using fg\<^sub>0h\<^sub>1.p\<^sub>1_simps by auto
       have w\<^sub>g_is_map: "is_left_adjoint w\<^sub>g"
         unfolding w\<^sub>g_def
         using fg\<^sub>0h\<^sub>1.p\<^sub>1_simps left_adjoints_compose by simp
       have w\<^sub>g': "ide w\<^sub>g'"
         unfolding w\<^sub>g'_def by simp
       have w\<^sub>g'_is_map: "is_left_adjoint w\<^sub>g'"
         unfolding w\<^sub>g'_def
         using TTfgh_TfTgh.is_map left_adjoints_compose by simp
       have \<theta>\<^sub>g: "\<guillemotleft>\<theta>\<^sub>g : tab\<^sub>0 g \<star> w\<^sub>g \<Rightarrow> u\<^sub>g\<guillemotright>"
         unfolding w\<^sub>g_def u\<^sub>g_def \<theta>\<^sub>g_def
         using fg\<^sub>0h\<^sub>1.p\<^sub>1_simps fg\<^sub>0h\<^sub>1.\<phi>_in_hom
         apply (intro comp_in_homI) by auto
       have \<theta>\<^sub>g': "\<guillemotleft>\<theta>\<^sub>g' : tab\<^sub>0 g \<star> w\<^sub>g' \<Rightarrow> u\<^sub>g\<guillemotright>"
           unfolding w\<^sub>g'_def u\<^sub>g_def \<theta>\<^sub>g'_def
           using fg\<^sub>0h\<^sub>1.p\<^sub>0_simps
           apply (intro comp_in_homI) by auto
       have w\<^sub>g_in_hhom: "in_hhom w\<^sub>g (src u\<^sub>g) (src (tab\<^sub>0 g))"
         unfolding w\<^sub>g_def u\<^sub>g_def by auto
       have w\<^sub>g'_in_hhom: "in_hhom w\<^sub>g' (src u\<^sub>g) (src (tab\<^sub>0 g))"
         unfolding w\<^sub>g'_def u\<^sub>g_def by auto
       have \<beta>\<^sub>g: "\<guillemotleft>\<beta>\<^sub>g : tab\<^sub>1 g \<star> w\<^sub>g \<Rightarrow> tab\<^sub>1 g \<star> w\<^sub>g'\<guillemotright>"
       proof (unfold \<beta>\<^sub>g_def w\<^sub>g_def, intro comp_in_homI)
         (* auto can solve this, but it's too slow *)
         show "\<guillemotleft>\<a>\<^sup>-\<^sup>1[tab\<^sub>1 g, Tfg.p\<^sub>0, TTfgh.p\<^sub>1] :
                  tab\<^sub>1 g \<star> Tfg.p\<^sub>0 \<star> TTfgh.p\<^sub>1 \<Rightarrow> (tab\<^sub>1 g \<star> Tfg.p\<^sub>0) \<star> TTfgh.p\<^sub>1\<guillemotright>"
           using fg\<^sub>0h\<^sub>1.p\<^sub>1_simps by auto
         show "\<guillemotleft>inv f\<^sub>0g\<^sub>1.\<phi> \<star> TTfgh.p\<^sub>1 :
                  (tab\<^sub>1 g \<star> Tfg.p\<^sub>0) \<star> TTfgh.p\<^sub>1 \<Rightarrow> (tab\<^sub>0 f \<star> Tfg.p\<^sub>1) \<star> TTfgh.p\<^sub>1\<guillemotright>"
           using fg\<^sub>0h\<^sub>1.p\<^sub>1_simps f\<^sub>0g\<^sub>1.\<phi>_in_hom f\<^sub>0g\<^sub>1.\<phi>_uniqueness(2)
           by (intro hcomp_in_vhom) auto
         show "\<guillemotleft>\<a>[tab\<^sub>0 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1] :
                  (tab\<^sub>0 f \<star> Tfg.p\<^sub>1) \<star> TTfgh.p\<^sub>1 \<Rightarrow> tab\<^sub>0 f \<star> Tfg.p\<^sub>1 \<star> TTfgh.p\<^sub>1\<guillemotright>"
           using fg\<^sub>0h\<^sub>1.p\<^sub>1_simps \<gamma>\<^sub>f w\<^sub>f_def w\<^sub>f'_def by auto
         show "\<guillemotleft>tab\<^sub>0 f \<star> \<gamma>\<^sub>f : tab\<^sub>0 f \<star> Tfg.p\<^sub>1 \<star> TTfgh.p\<^sub>1 \<Rightarrow> tab\<^sub>0 f \<star> TfTgh.p\<^sub>1 \<star> TTfgh_TfTgh.chine\<guillemotright>"
           using fg\<^sub>0h\<^sub>1.p\<^sub>1_simps \<gamma>\<^sub>f w\<^sub>f_def w\<^sub>f'_def by auto
         show "\<guillemotleft>\<a>\<^sup>-\<^sup>1[tab\<^sub>0 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine] :
                  tab\<^sub>0 f \<star> TfTgh.p\<^sub>1 \<star> TTfgh_TfTgh.chine \<Rightarrow> (tab\<^sub>0 f \<star> TfTgh.p\<^sub>1) \<star> TTfgh_TfTgh.chine\<guillemotright>"
           by auto
         show "\<guillemotleft>f\<^sub>0gh\<^sub>1.\<phi> \<star> TTfgh_TfTgh.chine :
                  (tab\<^sub>0 f \<star> TfTgh.p\<^sub>1) \<star> TTfgh_TfTgh.chine
                     \<Rightarrow> ((tab\<^sub>1 g \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine\<guillemotright>"
           using f\<^sub>0gh\<^sub>1.\<phi>_in_hom
           by (intro hcomp_in_vhom) auto
         show "\<guillemotleft>\<a>[tab\<^sub>1 g \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] :
                  ((tab\<^sub>1 g \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine
                     \<Rightarrow> (tab\<^sub>1 g \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine\<guillemotright>"
           by auto
         show "\<guillemotleft>\<a>[tab\<^sub>1 g, Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] :
                  (tab\<^sub>1 g \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine \<Rightarrow> tab\<^sub>1 g \<star> w\<^sub>g'\<guillemotright>"
           using w\<^sub>g'_def by auto
       qed
       have eq\<^sub>g: "g.composite_cell w\<^sub>g \<theta>\<^sub>g = g.composite_cell w\<^sub>g' \<theta>\<^sub>g' \<cdot> \<beta>\<^sub>g"
       proof -
         have "g.composite_cell w\<^sub>g \<theta>\<^sub>g =
               (g \<star> \<a>[h, tab\<^sub>0 h, TTfgh.p\<^sub>0] \<cdot>
                      (h.tab \<star> TTfgh.p\<^sub>0) \<cdot>
                      fg\<^sub>0h\<^sub>1.\<phi> \<cdot>
                      \<a>\<^sup>-\<^sup>1[tab\<^sub>0 g, Tfg.p\<^sub>0, TTfgh.p\<^sub>1]) \<cdot>
                 \<a>[g, tab\<^sub>0 g, Tfg.p\<^sub>0 \<star> TTfgh.p\<^sub>1] \<cdot>
                 (g.tab \<star> Tfg.p\<^sub>0 \<star> TTfgh.p\<^sub>1)"
           unfolding w\<^sub>g_def \<theta>\<^sub>g_def by simp
         also have "... =
                    (g \<star> \<a>[h, tab\<^sub>0 h, TTfgh.p\<^sub>0]) \<cdot>
                      (g \<star> h.tab \<star> TTfgh.p\<^sub>0) \<cdot>
                      (g \<star> fg\<^sub>0h\<^sub>1.\<phi>) \<cdot>
                      ((g \<star> \<a>\<^sup>-\<^sup>1[tab\<^sub>0 g, Tfg.p\<^sub>0, TTfgh.p\<^sub>1]) \<cdot>
                      \<a>[g, tab\<^sub>0 g, Tfg.p\<^sub>0 \<star> TTfgh.p\<^sub>1]) \<cdot>
                      (g.tab \<star> Tfg.p\<^sub>0 \<star> TTfgh.p\<^sub>1)"
           using fg gh f\<^sub>0g\<^sub>1.p\<^sub>0_simps fg\<^sub>0h\<^sub>1.p\<^sub>0_simps fg\<^sub>0h\<^sub>1.p\<^sub>1_simps whisker_left
                 comp_assoc
           by simp
         also have "... =
                    (g \<star> \<a>[h, tab\<^sub>0 h, TTfgh.p\<^sub>0]) \<cdot>
                      (g \<star> h.tab \<star> TTfgh.p\<^sub>0) \<cdot>
                      (g \<star> fg\<^sub>0h\<^sub>1.\<phi>) \<cdot>
                      (\<a>[g, tab\<^sub>0 g \<star> Tfg.p\<^sub>0, TTfgh.p\<^sub>1] \<cdot>
                      (\<a>\<^sup>-\<^sup>1[g, tab\<^sub>0 g \<star> Tfg.p\<^sub>0, TTfgh.p\<^sub>1] \<cdot>
                      (g \<star> \<a>\<^sup>-\<^sup>1[tab\<^sub>0 g, Tfg.p\<^sub>0, TTfgh.p\<^sub>1]))) \<cdot>
                      \<a>[g, tab\<^sub>0 g, Tfg.p\<^sub>0 \<star> TTfgh.p\<^sub>1] \<cdot>
                      (g.tab \<star> Tfg.p\<^sub>0 \<star> TTfgh.p\<^sub>1)"
         proof -
           have "(\<a>[g, tab\<^sub>0 g \<star> Tfg.p\<^sub>0, TTfgh.p\<^sub>1] \<cdot>
                    \<a>\<^sup>-\<^sup>1[g, tab\<^sub>0 g \<star> Tfg.p\<^sub>0, TTfgh.p\<^sub>1]) \<cdot>
                    (g \<star> \<a>\<^sup>-\<^sup>1[tab\<^sub>0 g, Tfg.p\<^sub>0, TTfgh.p\<^sub>1]) =
                 g \<star> \<a>\<^sup>-\<^sup>1[tab\<^sub>0 g, Tfg.p\<^sub>0, TTfgh.p\<^sub>1]"
             using fg\<^sub>0h\<^sub>1.p\<^sub>1_simps comp_cod_arr comp_assoc_assoc' by simp
           thus ?thesis
             by (simp add: comp_assoc)
         qed
         also have "... =
                    (g \<star> \<a>[h, tab\<^sub>0 h, TTfgh.p\<^sub>0]) \<cdot>
                      (g \<star> h.tab \<star> TTfgh.p\<^sub>0) \<cdot>
                      (g \<star> fg\<^sub>0h\<^sub>1.\<phi>) \<cdot>
                      \<a>[g, tab\<^sub>0 g \<star> Tfg.p\<^sub>0, TTfgh.p\<^sub>1] \<cdot>
                      (\<a>\<^sup>-\<^sup>1[g, tab\<^sub>0 g \<star> Tfg.p\<^sub>0, TTfgh.p\<^sub>1] \<cdot>
                      (g \<star> \<a>\<^sup>-\<^sup>1[tab\<^sub>0 g, Tfg.p\<^sub>0, TTfgh.p\<^sub>1]) \<cdot>
                      \<a>[g, tab\<^sub>0 g, Tfg.p\<^sub>0 \<star> TTfgh.p\<^sub>1]) \<cdot>
                      (g.tab \<star> Tfg.p\<^sub>0 \<star> TTfgh.p\<^sub>1)"
           using comp_assoc by presburger
         also have "... =
                    (g \<star> \<a>[h, tab\<^sub>0 h, TTfgh.p\<^sub>0]) \<cdot>
                      (g \<star> h.tab \<star> TTfgh.p\<^sub>0) \<cdot>
                      (g \<star> fg\<^sub>0h\<^sub>1.\<phi>) \<cdot>
                      \<a>[g, tab\<^sub>0 g \<star> Tfg.p\<^sub>0, TTfgh.p\<^sub>1] \<cdot>
                      (\<a>[g, tab\<^sub>0 g, Tfg.p\<^sub>0] \<star> TTfgh.p\<^sub>1) \<cdot>
                      (\<a>\<^sup>-\<^sup>1[g \<star> tab\<^sub>0 g, Tfg.p\<^sub>0, TTfgh.p\<^sub>1] \<cdot>
                      (g.tab \<star> Tfg.p\<^sub>0 \<star> TTfgh.p\<^sub>1))"
           using fg gh f\<^sub>0g\<^sub>1.p\<^sub>0_simps fg\<^sub>0h\<^sub>1.p\<^sub>0_simps fg\<^sub>0h\<^sub>1.p\<^sub>1_simps comp_assoc
                 fg\<^sub>0h\<^sub>1.p\<^sub>1_simps pentagon' iso_inv_iso
                 invert_opposite_sides_of_square
                   [of "\<a>\<^sup>-\<^sup>1[g, tab\<^sub>0 g, Tfg.p\<^sub>0] \<star> TTfgh.p\<^sub>1"
                       "(\<a>\<^sup>-\<^sup>1[g, tab\<^sub>0 g \<star> Tfg.p\<^sub>0, TTfgh.p\<^sub>1]) \<cdot> (g \<star> \<a>\<^sup>-\<^sup>1[tab\<^sub>0 g, Tfg.p\<^sub>0, TTfgh.p\<^sub>1])"
                       "\<a>\<^sup>-\<^sup>1[g \<star> tab\<^sub>0 g, Tfg.p\<^sub>0, TTfgh.p\<^sub>1]" "\<a>\<^sup>-\<^sup>1[g, tab\<^sub>0 g, Tfg.p\<^sub>0 \<star> TTfgh.p\<^sub>1]"]
           by simp
         also have "... =
                    (g \<star> \<a>[h, tab\<^sub>0 h, TTfgh.p\<^sub>0]) \<cdot>
                      (g \<star> h.tab \<star> TTfgh.p\<^sub>0) \<cdot>
                      (g \<star> fg\<^sub>0h\<^sub>1.\<phi>) \<cdot>
                      \<a>[g, tab\<^sub>0 g \<star> Tfg.p\<^sub>0, TTfgh.p\<^sub>1] \<cdot>
                      (\<a>[g, tab\<^sub>0 g, Tfg.p\<^sub>0] \<star> TTfgh.p\<^sub>1) \<cdot>
                      ((g.tab \<star> Tfg.p\<^sub>0) \<star> TTfgh.p\<^sub>1) \<cdot>
                      \<a>\<^sup>-\<^sup>1[tab\<^sub>1 g, Tfg.p\<^sub>0, TTfgh.p\<^sub>1]"
           using fg\<^sub>0h\<^sub>1.p\<^sub>1_simps assoc'_naturality [of g.tab Tfg.p\<^sub>0 TTfgh.p\<^sub>1] by simp
         also have "... =
                    (g \<star> \<a>[h, tab\<^sub>0 h, TTfgh.p\<^sub>0]) \<cdot>
                      (g \<star> h.tab \<star> TTfgh.p\<^sub>0) \<cdot>
                      (g \<star> fg\<^sub>0h\<^sub>1.\<phi>) \<cdot>
                      \<a>[g, tab\<^sub>0 g \<star> Tfg.p\<^sub>0, TTfgh.p\<^sub>1] \<cdot>
                      (\<a>[g, tab\<^sub>0 g, Tfg.p\<^sub>0] \<star> TTfgh.p\<^sub>1) \<cdot>
                      ((g.tab \<star> Tfg.p\<^sub>0) \<star> TTfgh.p\<^sub>1) \<cdot>
                      (f\<^sub>0g\<^sub>1.\<phi> \<star> TTfgh.p\<^sub>1) \<cdot>
                      \<a>\<^sup>-\<^sup>1[tab\<^sub>0 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1] \<cdot>
                      \<a>[tab\<^sub>0 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1] \<cdot>
                      (inv f\<^sub>0g\<^sub>1.\<phi> \<star> TTfgh.p\<^sub>1) \<cdot>
                      \<a>\<^sup>-\<^sup>1[tab\<^sub>1 g, Tfg.p\<^sub>0, TTfgh.p\<^sub>1]"
         proof -
           have "(f\<^sub>0g\<^sub>1.\<phi> \<star> TTfgh.p\<^sub>1) \<cdot>
                      \<a>\<^sup>-\<^sup>1[tab\<^sub>0 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1] \<cdot>
                      \<a>[tab\<^sub>0 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1] \<cdot>
                      (inv f\<^sub>0g\<^sub>1.\<phi> \<star> TTfgh.p\<^sub>1) \<cdot>
                      \<a>\<^sup>-\<^sup>1[tab\<^sub>1 g, Tfg.p\<^sub>0, TTfgh.p\<^sub>1] =
                 ((f\<^sub>0g\<^sub>1.\<phi> \<star> TTfgh.p\<^sub>1) \<cdot>
                      (\<a>\<^sup>-\<^sup>1[tab\<^sub>0 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1] \<cdot>
                      \<a>[tab\<^sub>0 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1]) \<cdot>
                      (inv f\<^sub>0g\<^sub>1.\<phi> \<star> TTfgh.p\<^sub>1)) \<cdot>
                      \<a>\<^sup>-\<^sup>1[tab\<^sub>1 g, Tfg.p\<^sub>0, TTfgh.p\<^sub>1]"
             using comp_assoc by presburger
           also have "... = ((f\<^sub>0g\<^sub>1.\<phi> \<star> TTfgh.p\<^sub>1) \<cdot>
                              ((tab\<^sub>0 f \<star> Tfg.p\<^sub>1) \<star> TTfgh.p\<^sub>1) \<cdot>
                              (inv f\<^sub>0g\<^sub>1.\<phi> \<star> TTfgh.p\<^sub>1)) \<cdot>
                              \<a>\<^sup>-\<^sup>1[tab\<^sub>1 g, Tfg.p\<^sub>0, TTfgh.p\<^sub>1]"
             using fg\<^sub>0h\<^sub>1.p\<^sub>1_simps whisker_right comp_assoc_assoc' by simp
           also have "... = ((f\<^sub>0g\<^sub>1.\<phi> \<star> TTfgh.p\<^sub>1) \<cdot>
                              (inv f\<^sub>0g\<^sub>1.\<phi> \<star> TTfgh.p\<^sub>1)) \<cdot>
                              \<a>\<^sup>-\<^sup>1[tab\<^sub>1 g, Tfg.p\<^sub>0, TTfgh.p\<^sub>1]"
             using fg\<^sub>0h\<^sub>1.p\<^sub>1_simps f\<^sub>0g\<^sub>1.\<phi>_uniqueness comp_cod_arr by simp
           also have "... = ((tab\<^sub>1 g \<star> Tfg.p\<^sub>0) \<star> TTfgh.p\<^sub>1) \<cdot> \<a>\<^sup>-\<^sup>1[tab\<^sub>1 g, Tfg.p\<^sub>0, TTfgh.p\<^sub>1]"
           proof -
             have "(f\<^sub>0g\<^sub>1.\<phi> \<star> TTfgh.p\<^sub>1) \<cdot> (inv f\<^sub>0g\<^sub>1.\<phi> \<star> TTfgh.p\<^sub>1) =
                   f\<^sub>0g\<^sub>1.\<phi> \<cdot> inv f\<^sub>0g\<^sub>1.\<phi> \<star> TTfgh.p\<^sub>1"
               using f\<^sub>0g\<^sub>1.\<phi>_uniqueness whisker_right by simp
             also have "... = (tab\<^sub>1 g \<star> Tfg.p\<^sub>0) \<star> TTfgh.p\<^sub>1"
               using f\<^sub>0g\<^sub>1.\<phi>_uniqueness comp_arr_inv' by simp
             finally show ?thesis by simp
           qed
           also have "... = \<a>\<^sup>-\<^sup>1[tab\<^sub>1 g, Tfg.p\<^sub>0, TTfgh.p\<^sub>1]"
             using fg\<^sub>0h\<^sub>1.p\<^sub>1_simps comp_cod_arr by simp
           finally have "(f\<^sub>0g\<^sub>1.\<phi> \<star> TTfgh.p\<^sub>1) \<cdot> \<a>\<^sup>-\<^sup>1[tab\<^sub>0 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1] \<cdot>
                           \<a>[tab\<^sub>0 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1] \<cdot> (inv f\<^sub>0g\<^sub>1.\<phi> \<star> TTfgh.p\<^sub>1) \<cdot>
                      \<a>\<^sup>-\<^sup>1[tab\<^sub>1 g, Tfg.p\<^sub>0, TTfgh.p\<^sub>1] = \<a>\<^sup>-\<^sup>1[tab\<^sub>1 g, Tfg.p\<^sub>0, TTfgh.p\<^sub>1]"
             by simp
           thus ?thesis
             using comp_assoc by presburger
         qed
         also have "... = \<theta>\<^sub>f \<cdot>
                            \<a>[tab\<^sub>0 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1] \<cdot>
                            (inv f\<^sub>0g\<^sub>1.\<phi> \<star> TTfgh.p\<^sub>1) \<cdot>
                            \<a>\<^sup>-\<^sup>1[tab\<^sub>1 g, Tfg.p\<^sub>0, TTfgh.p\<^sub>1]"
           unfolding \<theta>\<^sub>f_def using comp_assoc by presburger
         also have "... = \<theta>\<^sub>f' \<cdot> (tab\<^sub>0 f \<star> \<gamma>\<^sub>f) \<cdot>
                            \<a>[tab\<^sub>0 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1] \<cdot>
                            (inv f\<^sub>0g\<^sub>1.\<phi> \<star> TTfgh.p\<^sub>1) \<cdot>
                            \<a>\<^sup>-\<^sup>1[tab\<^sub>1 g, Tfg.p\<^sub>0, TTfgh.p\<^sub>1]"
           using \<gamma>\<^sub>f comp_assoc by simp
         also have "... = (g \<star> h \<star> TTfgh_TfTgh.the_\<theta>) \<cdot>
                            can (\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> ((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>)
                                   \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                                (((\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>)
                                   \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>) \<cdot>
                            (((g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                            (((g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                            ((\<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                            (((g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                            (f\<^sub>0gh\<^sub>1.\<phi> \<star> TTfgh_TfTgh.chine) \<cdot>
                            \<a>\<^sup>-\<^sup>1[tab\<^sub>0 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine] \<cdot>
                            (tab\<^sub>0 f \<star> \<gamma>\<^sub>f) \<cdot>
                            \<a>[tab\<^sub>0 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1] \<cdot>
                            (inv f\<^sub>0g\<^sub>1.\<phi> \<star> TTfgh.p\<^sub>1) \<cdot>
                            \<a>\<^sup>-\<^sup>1[tab\<^sub>1 g, Tfg.p\<^sub>0, TTfgh.p\<^sub>1]"
           unfolding \<theta>\<^sub>f'_def using comp_assoc by presburger
         also have "... = (g \<star> h \<star> TTfgh_TfTgh.the_\<theta>) \<cdot>
                            can (\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> ((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>)
                                   \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                                (((\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>)
                                   \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>) \<cdot>
                            (((g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                            (((g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                            ((\<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                            (((g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                            (\<a>\<^sup>-\<^sup>1[tab\<^sub>1 g \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                            (\<a>\<^sup>-\<^sup>1[tab\<^sub>1 g, Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            \<a>[tab\<^sub>1 g, Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine]) \<cdot>
                            \<a>[tab\<^sub>1 g \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                            (f\<^sub>0gh\<^sub>1.\<phi> \<star> TTfgh_TfTgh.chine)) \<cdot>
                            \<a>\<^sup>-\<^sup>1[tab\<^sub>0 f, TfTgh.p\<^sub>1, TTfgh_TfTgh.chine] \<cdot>
                            (tab\<^sub>0 f \<star> \<gamma>\<^sub>f) \<cdot>
                            \<a>[tab\<^sub>0 f, Tfg.p\<^sub>1, TTfgh.p\<^sub>1] \<cdot>
                            (inv f\<^sub>0g\<^sub>1.\<phi> \<star> TTfgh.p\<^sub>1) \<cdot>
                            \<a>\<^sup>-\<^sup>1[tab\<^sub>1 g, Tfg.p\<^sub>0, TTfgh.p\<^sub>1]"
         proof -
           have "(\<a>\<^sup>-\<^sup>1[tab\<^sub>1 g \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                            (\<a>\<^sup>-\<^sup>1[tab\<^sub>1 g, Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            \<a>[tab\<^sub>1 g, Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine]) \<cdot>
                            \<a>[tab\<^sub>1 g \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine]) \<cdot>
                            (f\<^sub>0gh\<^sub>1.\<phi> \<star> TTfgh_TfTgh.chine) =
                 f\<^sub>0gh\<^sub>1.\<phi> \<star> TTfgh_TfTgh.chine"
             using f\<^sub>0gh\<^sub>1.p\<^sub>0_simps comp_cod_arr comp_arr_dom comp_assoc_assoc' by simp
           thus ?thesis
             using comp_assoc by simp
         qed
         also have "... = (g \<star> h \<star> TTfgh_TfTgh.the_\<theta>) \<cdot>
                            can (\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> ((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>)
                                   \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                                (((\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>)
                                   \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>) \<cdot>
                            (((g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                            (((g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                            ((\<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                            ((((g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                            \<a>\<^sup>-\<^sup>1[tab\<^sub>1 g \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine]) \<cdot>
                            \<a>\<^sup>-\<^sup>1[tab\<^sub>1 g, Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            \<beta>\<^sub>g"
           unfolding \<beta>\<^sub>g_def using comp_assoc by presburger
         also have "... = (g \<star> h \<star> TTfgh_TfTgh.the_\<theta>) \<cdot>
                            can (\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> ((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>)
                                   \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                                (((\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>)
                                   \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>) \<cdot>
                            (((g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                            (((g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                            ((\<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                            \<a>\<^sup>-\<^sup>1[(g \<star> tab\<^sub>0 g) \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                            (((g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                            \<a>\<^sup>-\<^sup>1[tab\<^sub>1 g, Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine]) \<cdot>
                            \<beta>\<^sub>g"
         proof -
           have "(((g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                   \<a>\<^sup>-\<^sup>1[tab\<^sub>1 g \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] =
                 \<a>\<^sup>-\<^sup>1[(g \<star> tab\<^sub>0 g) \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                   ((g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine)"
             using f\<^sub>0gh\<^sub>1.p\<^sub>0_simps
                   assoc'_naturality [of "(g.tab \<star> Tgh.p\<^sub>1)" TfTgh.p\<^sub>0 TTfgh_TfTgh.chine]
             by simp
           thus ?thesis
             using comp_assoc by presburger
         qed
         also have "... = (g \<star> h \<star> TTfgh_TfTgh.the_\<theta>) \<cdot>
                            can (\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> ((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>)
                                   \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                                (((\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>)
                                   \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>) \<cdot>
                            (((g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                            (((g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                            ((\<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                            \<a>\<^sup>-\<^sup>1[(g \<star> tab\<^sub>0 g) \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                            \<a>\<^sup>-\<^sup>1[g \<star> tab\<^sub>0 g, Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            (g.tab \<star> Tgh.p\<^sub>1 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                            \<beta>\<^sub>g"
         proof -
           have "((g.tab \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                   \<a>\<^sup>-\<^sup>1[tab\<^sub>1 g, Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] =
                 \<a>\<^sup>-\<^sup>1[g \<star> tab\<^sub>0 g, Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                   (g.tab \<star> Tgh.p\<^sub>1 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine)"
             using g\<^sub>0h\<^sub>1.p\<^sub>1_simps f\<^sub>0gh\<^sub>1.p\<^sub>0_simps
                   assoc'_naturality [of g.tab Tgh.p\<^sub>1 "TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine"]
             by simp
           thus ?thesis
             using comp_assoc by presburger
         qed
         also have "... = (g \<star> h \<star> TTfgh_TfTgh.the_\<theta>) \<cdot>
                            can (\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> ((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>)
                                   \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                                (((\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>)
                                   \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>) \<cdot>
                            (((g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                            (((g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                            ((\<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                            \<a>\<^sup>-\<^sup>1[(g \<star> tab\<^sub>0 g) \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                            \<a>\<^sup>-\<^sup>1[g \<star> tab\<^sub>0 g, Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            ((\<a>\<^sup>-\<^sup>1[g, tab\<^sub>0 g, Tgh.p\<^sub>1 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            \<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine]) \<cdot>
                            (g.tab \<star> Tgh.p\<^sub>1 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine)) \<cdot>
                            \<beta>\<^sub>g"
         proof -
           have "(\<a>\<^sup>-\<^sup>1[g, tab\<^sub>0 g, Tgh.p\<^sub>1 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                   \<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine]) \<cdot>
                   (g.tab \<star> Tgh.p\<^sub>1 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) =
                 g.tab \<star> Tgh.p\<^sub>1 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine"
             using comp_cod_arr comp_assoc_assoc' by simp
           thus ?thesis
             using comp_assoc g\<^sub>0h\<^sub>1.\<phi>_in_hom by simp
         qed
         also have "... = (g \<star> h \<star> TTfgh_TfTgh.the_\<theta>) \<cdot>
                            can (\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> ((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>)
                                   \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                                (((\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>)
                                   \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>) \<cdot>
                            (((g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                            (((g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                            ((\<a>\<^sup>-\<^sup>1[g \<star> tab\<^sub>0 g \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                            (\<a>\<^sup>-\<^sup>1[g, tab\<^sub>0 g \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            \<a>[g, tab\<^sub>0 g \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine]) \<cdot>
                            \<a>[g \<star> tab\<^sub>0 g \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine]) \<cdot>
                            ((\<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine)) \<cdot>
                            \<a>\<^sup>-\<^sup>1[(g \<star> tab\<^sub>0 g) \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                            \<a>\<^sup>-\<^sup>1[g \<star> tab\<^sub>0 g, Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            ((\<a>\<^sup>-\<^sup>1[g, tab\<^sub>0 g, Tgh.p\<^sub>1 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            \<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine]) \<cdot>
                            (g.tab \<star> Tgh.p\<^sub>1 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine)) \<cdot>
                            \<beta>\<^sub>g"
         proof -
           have "(\<a>\<^sup>-\<^sup>1[g \<star> tab\<^sub>0 g \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                            (\<a>\<^sup>-\<^sup>1[g, tab\<^sub>0 g \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            \<a>[g, tab\<^sub>0 g \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine]) \<cdot>
                            \<a>[g \<star> tab\<^sub>0 g \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine]) \<cdot>
                            ((\<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) =
                 (\<a>\<^sup>-\<^sup>1[g \<star> tab\<^sub>0 g \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                            ((g \<star> (tab\<^sub>0 g \<star> Tgh.p\<^sub>1)) \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                            \<a>[g \<star> tab\<^sub>0 g \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine]) \<cdot>
                            ((\<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine)"
             using g\<^sub>0h\<^sub>1.p\<^sub>1_simps f\<^sub>0gh\<^sub>1.p\<^sub>0_simps comp_assoc comp_assoc_assoc' by simp
           also have "... = (\<a>\<^sup>-\<^sup>1[g \<star> tab\<^sub>0 g \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                            \<a>[g \<star> tab\<^sub>0 g \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine]) \<cdot>
                            ((\<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine)"
             using g\<^sub>0h\<^sub>1.p\<^sub>1_simps f\<^sub>0gh\<^sub>1.p\<^sub>0_simps comp_cod_arr comp_assoc_assoc' by simp
           also have "... = (((g \<star> (tab\<^sub>0 g \<star> Tgh.p\<^sub>1)) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                              ((\<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine)"
             using g\<^sub>0h\<^sub>1.p\<^sub>1_simps f\<^sub>0gh\<^sub>1.p\<^sub>0_simps whisker_right comp_assoc_assoc' by simp
           also have "... = (\<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine"
             using g\<^sub>0h\<^sub>1.p\<^sub>1_simps f\<^sub>0gh\<^sub>1.p\<^sub>0_simps comp_cod_arr by simp
           finally show ?thesis by presburger
         qed
         also have "... = (g \<star> h \<star> TTfgh_TfTgh.the_\<theta>) \<cdot>
                            can (\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> ((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>)
                                   \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                                (((\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>)
                                   \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>) \<cdot>
                            ((((g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                            (((g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                            \<a>\<^sup>-\<^sup>1[g \<star> tab\<^sub>0 g \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                            \<a>\<^sup>-\<^sup>1[g, tab\<^sub>0 g \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine]) \<cdot>
                            \<a>[g, tab\<^sub>0 g \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            \<a>[g \<star> tab\<^sub>0 g \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                            ((\<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                            \<a>\<^sup>-\<^sup>1[(g \<star> tab\<^sub>0 g) \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                            \<a>\<^sup>-\<^sup>1[g \<star> tab\<^sub>0 g, Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            (\<a>\<^sup>-\<^sup>1[g, tab\<^sub>0 g, Tgh.p\<^sub>1 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            \<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            (g.tab \<star> Tgh.p\<^sub>1 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine)) \<cdot>
                            \<beta>\<^sub>g"
           using comp_assoc by presburger
         also have "... = (g \<star> h \<star> TTfgh_TfTgh.the_\<theta>) \<cdot>
                            (can (\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> ((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>)
                                    \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                                (((\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>)
                                    \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>) \<cdot>
                 \<a>\<^sup>-\<^sup>1[g \<star> (h \<star> tab\<^sub>0 h) \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                     \<a>\<^sup>-\<^sup>1[g, (h \<star> tab\<^sub>0 h) \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine]) \<cdot>
                       (g \<star> (h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                       (g \<star> g\<^sub>0h\<^sub>1.\<phi> \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                            (\<a>[g, tab\<^sub>0 g \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            \<a>[g \<star> tab\<^sub>0 g \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                            ((\<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                            \<a>\<^sup>-\<^sup>1[(g \<star> tab\<^sub>0 g) \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                            \<a>\<^sup>-\<^sup>1[g \<star> tab\<^sub>0 g, Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            \<a>\<^sup>-\<^sup>1[g, tab\<^sub>0 g, Tgh.p\<^sub>1 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine]) \<cdot>
                            \<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            (g.tab \<star> Tgh.p\<^sub>1 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                            \<beta>\<^sub>g"
         proof -
           have "(((g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                            (((g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                            \<a>\<^sup>-\<^sup>1[g \<star> tab\<^sub>0 g \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                            \<a>\<^sup>-\<^sup>1[g, tab\<^sub>0 g \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] =
                 \<a>\<^sup>-\<^sup>1[g \<star> (h \<star> tab\<^sub>0 h) \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                     \<a>\<^sup>-\<^sup>1[g, (h \<star> tab\<^sub>0 h) \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                       (g \<star> (h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                       (g \<star> g\<^sub>0h\<^sub>1.\<phi> \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine)"
           proof -
             have "(((g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                            (((g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                            \<a>\<^sup>-\<^sup>1[g \<star> tab\<^sub>0 g \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                            \<a>\<^sup>-\<^sup>1[g, tab\<^sub>0 g \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] =
                   (((g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                            ((((g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                            \<a>\<^sup>-\<^sup>1[g \<star> tab\<^sub>0 g \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine]) \<cdot>
                            \<a>\<^sup>-\<^sup>1[g, tab\<^sub>0 g \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine]"
               using comp_assoc by presburger
             also have "... = ((((g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                                \<a>\<^sup>-\<^sup>1[g \<star> tab\<^sub>1 h \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine]) \<cdot>
                                ((g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                                \<a>\<^sup>-\<^sup>1[g, tab\<^sub>0 g \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine]"
             proof -
               have "(((g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                            \<a>\<^sup>-\<^sup>1[g \<star> tab\<^sub>0 g \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] =
                     \<a>\<^sup>-\<^sup>1[g \<star> tab\<^sub>1 h \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                       ((g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine)"
                 using gh f\<^sub>0gh\<^sub>1.p\<^sub>0_simps
                       assoc'_naturality [of "g \<star> g\<^sub>0h\<^sub>1.\<phi>" TfTgh.p\<^sub>0 TTfgh_TfTgh.chine]
                 by simp
               thus ?thesis
                 using comp_assoc by presburger
             qed
             also have "... = \<a>\<^sup>-\<^sup>1[g \<star> (h \<star> tab\<^sub>0 h) \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                       ((g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                                ((g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                                \<a>\<^sup>-\<^sup>1[g, tab\<^sub>0 g \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine]"
             proof -
               have "(((g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                                \<a>\<^sup>-\<^sup>1[g \<star> tab\<^sub>1 h \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] =
                     \<a>\<^sup>-\<^sup>1[g \<star> (h \<star> tab\<^sub>0 h) \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                       ((g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine)"
                 using gh f\<^sub>0gh\<^sub>1.p\<^sub>0_simps
                       assoc'_naturality [of "g \<star> h.tab \<star> Tgh.p\<^sub>0" TfTgh.p\<^sub>0 TTfgh_TfTgh.chine]
                 by simp
               thus ?thesis
                 using comp_assoc by presburger
             qed
             also have "... = \<a>\<^sup>-\<^sup>1[g \<star> (h \<star> tab\<^sub>0 h) \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                       (((g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                     \<a>\<^sup>-\<^sup>1[g, tab\<^sub>1 h \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine]) \<cdot>
                       (g \<star> g\<^sub>0h\<^sub>1.\<phi> \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine)"
             proof -
               have "((g \<star> g\<^sub>0h\<^sub>1.\<phi>) \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                       \<a>\<^sup>-\<^sup>1[g, tab\<^sub>0 g \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] =
                     \<a>\<^sup>-\<^sup>1[g, tab\<^sub>1 h \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                       (g \<star> g\<^sub>0h\<^sub>1.\<phi> \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine)"
                 using gh f\<^sub>0gh\<^sub>1.p\<^sub>0_simps
                       assoc'_naturality [of g g\<^sub>0h\<^sub>1.\<phi> "TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine"]
                 by simp
               thus ?thesis
                 using comp_assoc by presburger
             qed
             also have "... = \<a>\<^sup>-\<^sup>1[g \<star> (h \<star> tab\<^sub>0 h) \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                     \<a>\<^sup>-\<^sup>1[g, (h \<star> tab\<^sub>0 h) \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                       (g \<star> (h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                       (g \<star> g\<^sub>0h\<^sub>1.\<phi> \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine)"
             proof -
               have "((g \<star> h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                     \<a>\<^sup>-\<^sup>1[g, tab\<^sub>1 h \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] =
                     \<a>\<^sup>-\<^sup>1[g, (h \<star> tab\<^sub>0 h) \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                       (g \<star> (h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine)"
                 using gh f\<^sub>0gh\<^sub>1.p\<^sub>0_simps
                       assoc'_naturality [of g "h.tab \<star> Tgh.p\<^sub>0" "TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine"]
                 by simp
               thus ?thesis
                 using comp_assoc by presburger
             qed
             finally show ?thesis by simp
           qed
           thus ?thesis
             using comp_assoc by presburger
         qed
         also have "... = ((g \<star> h \<star> TTfgh_TfTgh.the_\<theta>) \<cdot>
                            (g \<star> can (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> ((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>)
                                        \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                                     (((\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>
                                        \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)) \<cdot>
                            (g \<star> (h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                            (g \<star> g\<^sub>0h\<^sub>1.\<phi> \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                            (g \<star> \<a>\<^sup>-\<^sup>1[tab\<^sub>0 g, Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine])) \<cdot>
                            \<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            (g.tab \<star> Tgh.p\<^sub>1 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                            \<beta>\<^sub>g"
         proof -
           have "can (\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> ((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                     (((\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>) \<cdot>
                 \<a>\<^sup>-\<^sup>1[g \<star> (h \<star> tab\<^sub>0 h) \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                     \<a>\<^sup>-\<^sup>1[g, (h \<star> tab\<^sub>0 h) \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] =
                 g \<star> can (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> ((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                         (((\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)"
           proof -
             have "\<a>\<^sup>-\<^sup>1[g \<star> (h \<star> tab\<^sub>0 h) \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] =
                   can (((\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                       ((\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)"
             proof -
               have "\<a>\<^sup>-\<^sup>1[g \<star> (h \<star> tab\<^sub>0 h) \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] =
                     \<lbrace>\<^bold>\<a>\<^sup>-\<^sup>1\<^bold>[\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>, \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>, \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>\<^bold>]\<rbrace>"
                 using gh f\<^sub>0gh\<^sub>1.p\<^sub>0_simps canI_associator_0 \<a>'_def \<alpha>_def by simp
               also have "... = can (((\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>)
                                         \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                                    ((\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>
                                         \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)"
                 unfolding can_def
                 using gh
                 apply (intro E.eval_eqI) by simp_all
               finally show ?thesis by blast
             qed
             moreover
             have "\<a>\<^sup>-\<^sup>1[g, (h \<star> tab\<^sub>0 h) \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] =
                   can ((\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                       (\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> ((\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)"
             proof -
               have "\<a>\<^sup>-\<^sup>1[g, (h \<star> tab\<^sub>0 h) \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] =
                       \<lbrace>\<^bold>\<a>\<^sup>-\<^sup>1\<^bold>[\<^bold>\<langle>g\<^bold>\<rangle>, (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>, \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>\<^bold>]\<rbrace>"
                 using gh f\<^sub>0gh\<^sub>1.p\<^sub>0_simps canI_associator_0 \<a>'_def \<alpha>_def by simp
               also have "... = can ((\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>
                                        \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                                    (\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> ((\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>
                                        \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)"
                 unfolding can_def
                 using gh
                 apply (intro E.eval_eqI) by simp_all
               finally show ?thesis by blast
             qed
             ultimately show ?thesis
               using gh whisker_can_left_0 by simp
           qed
           moreover have "\<a>[g, tab\<^sub>0 g \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            \<a>[g \<star> tab\<^sub>0 g \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                            ((\<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                            \<a>\<^sup>-\<^sup>1[(g \<star> tab\<^sub>0 g) \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                            \<a>\<^sup>-\<^sup>1[g \<star> tab\<^sub>0 g, Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            \<a>\<^sup>-\<^sup>1[g, tab\<^sub>0 g, Tgh.p\<^sub>1 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] =
                          g \<star> \<a>\<^sup>-\<^sup>1[tab\<^sub>0 g, Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine]"
           proof -
             have "\<a>[g, tab\<^sub>0 g \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            \<a>[g \<star> tab\<^sub>0 g \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                            ((\<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1] \<star> TfTgh.p\<^sub>0) \<star> TTfgh_TfTgh.chine) \<cdot>
                            \<a>\<^sup>-\<^sup>1[(g \<star> tab\<^sub>0 g) \<star> Tgh.p\<^sub>1, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                            \<a>\<^sup>-\<^sup>1[g \<star> tab\<^sub>0 g, Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            \<a>\<^sup>-\<^sup>1[g, tab\<^sub>0 g, Tgh.p\<^sub>1 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] =
                   \<lbrace>\<^bold>\<a>\<^bold>[\<^bold>\<langle>g\<^bold>\<rangle>, \<^bold>\<langle>tab\<^sub>0 g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>1\<^bold>\<rangle>, \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>\<^bold>] \<^bold>\<cdot>
                     \<^bold>\<a>\<^bold>[\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>1\<^bold>\<rangle>, \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>, \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>\<^bold>] \<^bold>\<cdot>
                     ((\<^bold>\<a>\<^bold>[\<^bold>\<langle>g\<^bold>\<rangle>, \<^bold>\<langle>tab\<^sub>0 g\<^bold>\<rangle>, \<^bold>\<langle>Tgh.p\<^sub>1\<^bold>\<rangle>\<^bold>] \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>) \<^bold>\<cdot>
                     \<^bold>\<a>\<^sup>-\<^sup>1\<^bold>[(\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 g\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>1\<^bold>\<rangle>, \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>, \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>\<^bold>] \<^bold>\<cdot>
                     \<^bold>\<a>\<^sup>-\<^sup>1\<^bold>[\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 g\<^bold>\<rangle>, \<^bold>\<langle>Tgh.p\<^sub>1\<^bold>\<rangle>, \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>\<^bold>] \<^bold>\<cdot>
                     \<^bold>\<a>\<^sup>-\<^sup>1\<^bold>[\<^bold>\<langle>g\<^bold>\<rangle>, \<^bold>\<langle>tab\<^sub>0 g\<^bold>\<rangle>, \<^bold>\<langle>Tgh.p\<^sub>1\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>\<^bold>]\<rbrace>"
               using gh g\<^sub>0h\<^sub>1.p\<^sub>1_simps f\<^sub>0gh\<^sub>1.p\<^sub>0_simps \<a>'_def \<alpha>_def by simp
             also have "... = \<lbrace>\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<a>\<^sup>-\<^sup>1\<^bold>[\<^bold>\<langle>tab\<^sub>0 g\<^bold>\<rangle>, \<^bold>\<langle>Tgh.p\<^sub>1\<^bold>\<rangle>, \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>\<^bold>]\<rbrace>"
               apply (intro E.eval_eqI) by simp_all
             also have "... = g \<star> \<a>\<^sup>-\<^sup>1[tab\<^sub>0 g, Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine]"
               using gh g\<^sub>0h\<^sub>1.p\<^sub>1_simps f\<^sub>0gh\<^sub>1.p\<^sub>0_simps \<a>'_def \<alpha>_def by simp
             finally show ?thesis by simp
           qed
           ultimately show ?thesis
             using comp_assoc by presburger
         qed
         also have "... = (g \<star>
                            (h \<star> TTfgh_TfTgh.the_\<theta>) \<cdot>
                              (can (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> ((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>)
                                      \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                                   (((\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>
                                      \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)) \<cdot>
                              ((h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                              (g\<^sub>0h\<^sub>1.\<phi> \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                              \<a>\<^sup>-\<^sup>1[tab\<^sub>0 g, Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine]) \<cdot>
                            \<a>[g, tab\<^sub>0 g, Tgh.p\<^sub>1 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            (g.tab \<star> Tgh.p\<^sub>1 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                            \<beta>\<^sub>g"
         proof -
           have "arr ((h \<star> TTfgh_TfTgh.the_\<theta>) \<cdot>
                        (can (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> ((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                             (((\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)) \<cdot>
                        ((h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                        (g\<^sub>0h\<^sub>1.\<phi> \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                        \<a>\<^sup>-\<^sup>1[tab\<^sub>0 g, Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine])"
             using gh f\<^sub>0gh\<^sub>1.p\<^sub>0_simps
             apply (intro seqI) by auto
           moreover
           have "arr ((can (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> ((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                           (((\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)) \<cdot>
                        ((h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                        (g\<^sub>0h\<^sub>1.\<phi> \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                        \<a>\<^sup>-\<^sup>1[tab\<^sub>0 g, Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine])"
             using calculation by blast
           moreover
           have "arr (((h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                        (g\<^sub>0h\<^sub>1.\<phi> \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                        \<a>\<^sup>-\<^sup>1[tab\<^sub>0 g, Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine])"
             using calculation by blast
           moreover
           have "arr ((g\<^sub>0h\<^sub>1.\<phi> \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                        \<a>\<^sup>-\<^sup>1[tab\<^sub>0 g, Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine])"
             using calculation by blast
           ultimately
           have "(g \<star> h \<star> TTfgh_TfTgh.the_\<theta>) \<cdot>
                    (g \<star> can (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> ((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                             (((\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)) \<cdot>
                    (g \<star> (h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                    (g \<star> g\<^sub>0h\<^sub>1.\<phi> \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                    (g \<star> \<a>\<^sup>-\<^sup>1[tab\<^sub>0 g, Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine]) =
                  g \<star>
                    (h \<star> TTfgh_TfTgh.the_\<theta>) \<cdot>
                      (can (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> ((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                           (((\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)) \<cdot>
                      ((h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                      (g\<^sub>0h\<^sub>1.\<phi> \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                      \<a>\<^sup>-\<^sup>1[tab\<^sub>0 g, Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine]"
             using whisker_left by simp (* 20 sec *)
           thus ?thesis by simp
         qed
         also have "... = g.composite_cell w\<^sub>g' \<theta>\<^sub>g' \<cdot> \<beta>\<^sub>g"
           unfolding w\<^sub>g'_def \<theta>\<^sub>g'_def
           using comp_assoc by presburger
         finally show ?thesis by simp
       qed
       have 6: "\<exists>!\<gamma>. \<guillemotleft>\<gamma> : w\<^sub>g \<Rightarrow> w\<^sub>g'\<guillemotright> \<and> \<beta>\<^sub>g = tab\<^sub>1 g \<star> \<gamma> \<and> \<theta>\<^sub>g = \<theta>\<^sub>g' \<cdot> (tab\<^sub>0 g \<star> \<gamma>)"
         using w\<^sub>g w\<^sub>g' \<theta>\<^sub>g \<theta>\<^sub>g' \<beta>\<^sub>g eq\<^sub>g g.T2 [of w\<^sub>g w\<^sub>g' \<theta>\<^sub>g u\<^sub>g \<theta>\<^sub>g' \<beta>\<^sub>g] by blast
       obtain \<gamma>\<^sub>g where \<gamma>\<^sub>g: "\<guillemotleft>\<gamma>\<^sub>g : w\<^sub>g \<Rightarrow> w\<^sub>g'\<guillemotright> \<and> \<beta>\<^sub>g = tab\<^sub>1 g \<star> \<gamma>\<^sub>g \<and> \<theta>\<^sub>g = \<theta>\<^sub>g' \<cdot> (tab\<^sub>0 g \<star> \<gamma>\<^sub>g)"
         using 6 by auto
       show "\<lbrakk>\<lbrakk>Tgh.p\<^sub>1 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine\<rbrakk>\<rbrakk> = \<lbrakk>\<lbrakk>Tfg.p\<^sub>0 \<star> TTfgh.p\<^sub>1\<rbrakk>\<rbrakk>"
       proof -
         have "iso \<gamma>\<^sub>g"
           using \<gamma>\<^sub>g BS3 w\<^sub>g_is_map w\<^sub>g'_is_map by blast
         hence "isomorphic w\<^sub>g w\<^sub>g'"
           using \<gamma>\<^sub>g isomorphic_def isomorphic_symmetric by auto
         thus ?thesis
           using w\<^sub>g w\<^sub>g' w\<^sub>g_def w\<^sub>g'_def Maps.CLS_eqI by auto
       qed
 
       text \<open>Now the last equation: similar, but somewhat simpler.\<close>
       define u\<^sub>h where "u\<^sub>h = tab\<^sub>0 h \<star> TTfgh.p\<^sub>0"
       define w\<^sub>h where "w\<^sub>h = TTfgh.p\<^sub>0"
       define w\<^sub>h' where "w\<^sub>h' = Tgh.p\<^sub>0 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine"
       define \<theta>\<^sub>h
       where "\<theta>\<^sub>h = tab\<^sub>0 h \<star> TTfgh.p\<^sub>0"
       define \<theta>\<^sub>h'
       where "\<theta>\<^sub>h' = TTfgh_TfTgh.the_\<theta> \<cdot> \<a>\<^sup>-\<^sup>1[tab\<^sub>0 h \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                  \<a>\<^sup>-\<^sup>1[tab\<^sub>0 h, Tgh.p\<^sub>0, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine]"
       define \<beta>\<^sub>h
       where "\<beta>\<^sub>h = \<a>[tab\<^sub>1 h, Tgh.p\<^sub>0, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                    (g\<^sub>0h\<^sub>1.\<phi> \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                    \<a>\<^sup>-\<^sup>1[tab\<^sub>0 g, Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot> (tab\<^sub>0 g \<star> \<gamma>\<^sub>g) \<cdot>
                    \<a>[tab\<^sub>0 g, Tfg.p\<^sub>0, TTfgh.p\<^sub>1] \<cdot> inv fg\<^sub>0h\<^sub>1.\<phi>"
       have u\<^sub>h: "ide u\<^sub>h"
         unfolding u\<^sub>h_def by simp
       have w\<^sub>h: "ide w\<^sub>h"
         unfolding w\<^sub>h_def by simp
       have w\<^sub>h_is_map: "is_left_adjoint w\<^sub>h"
         unfolding w\<^sub>h_def by simp
       have w\<^sub>h': "ide w\<^sub>h'"
         unfolding w\<^sub>h'_def by simp
       have w\<^sub>h'_is_map: "is_left_adjoint w\<^sub>h'"
         unfolding w\<^sub>h'_def
         using g\<^sub>0h\<^sub>1.p\<^sub>0_simps f\<^sub>0gh\<^sub>1.p\<^sub>0_simps TTfgh_TfTgh.is_map left_adjoints_compose by simp
       have \<theta>\<^sub>h: "\<guillemotleft>\<theta>\<^sub>h : tab\<^sub>0 h \<star> w\<^sub>h \<Rightarrow> u\<^sub>h\<guillemotright>"
         unfolding \<theta>\<^sub>h_def w\<^sub>h_def u\<^sub>h_def by auto
       have \<theta>\<^sub>h': "\<guillemotleft>\<theta>\<^sub>h' : tab\<^sub>0 h \<star> w\<^sub>h' \<Rightarrow> u\<^sub>h\<guillemotright>"
         unfolding \<theta>\<^sub>h'_def w\<^sub>h'_def u\<^sub>h_def
         using g\<^sub>0h\<^sub>1.p\<^sub>0_simps f\<^sub>0gh\<^sub>1.p\<^sub>0_simps
         by (intro comp_in_homI) auto
       have \<beta>\<^sub>h: "\<guillemotleft>\<beta>\<^sub>h : tab\<^sub>1 h \<star> w\<^sub>h \<Rightarrow> tab\<^sub>1 h \<star> w\<^sub>h'\<guillemotright>"
       proof (unfold \<beta>\<^sub>h_def w\<^sub>h_def w\<^sub>h'_def, intro comp_in_homI)
         (* auto can solve this, but it's too slow *)
         show "\<guillemotleft>inv fg\<^sub>0h\<^sub>1.\<phi> : tab\<^sub>1 h \<star> TTfgh.p\<^sub>0 \<Rightarrow> (tab\<^sub>0 g \<star> Tfg.p\<^sub>0) \<star> TTfgh.p\<^sub>1\<guillemotright>"
           using fg\<^sub>0h\<^sub>1.\<phi>_uniqueness by blast
         show "\<guillemotleft>\<a>[tab\<^sub>0 g, Tfg.p\<^sub>0, TTfgh.p\<^sub>1] :
                  (tab\<^sub>0 g \<star> Tfg.p\<^sub>0) \<star> TTfgh.p\<^sub>1 \<Rightarrow> tab\<^sub>0 g \<star> Tfg.p\<^sub>0 \<star> TTfgh.p\<^sub>1\<guillemotright>"
           using fg\<^sub>0h\<^sub>1.p\<^sub>1_simps by auto
         show "\<guillemotleft>tab\<^sub>0 g \<star> \<gamma>\<^sub>g :
                  tab\<^sub>0 g \<star> Tfg.p\<^sub>0 \<star> TTfgh.p\<^sub>1 \<Rightarrow> tab\<^sub>0 g \<star> Tgh.p\<^sub>1 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine\<guillemotright>"
           using \<gamma>\<^sub>g w\<^sub>g_def w\<^sub>g'_def fg\<^sub>0h\<^sub>1.p\<^sub>1_simps by auto
         show "\<guillemotleft>\<a>\<^sup>-\<^sup>1[tab\<^sub>0 g, Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] :
                  tab\<^sub>0 g \<star> Tgh.p\<^sub>1 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine
                     \<Rightarrow> (tab\<^sub>0 g \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine\<guillemotright>"
           using fg\<^sub>0h\<^sub>1.p\<^sub>1_simps by auto
         show "\<guillemotleft>g\<^sub>0h\<^sub>1.\<phi> \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine :
                 (tab\<^sub>0 g \<star> Tgh.p\<^sub>1) \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine
                    \<Rightarrow> (tab\<^sub>1 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine\<guillemotright>"
           using fg\<^sub>0h\<^sub>1.p\<^sub>1_simps by force
         show "\<guillemotleft>\<a>[tab\<^sub>1 h, Tgh.p\<^sub>0, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] :
                 (tab\<^sub>1 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine
                    \<Rightarrow> tab\<^sub>1 h \<star> Tgh.p\<^sub>0 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine\<guillemotright>"
           using fg\<^sub>0h\<^sub>1.p\<^sub>1_simps by auto
       qed
       have eq\<^sub>h: "h.composite_cell w\<^sub>h \<theta>\<^sub>h = h.composite_cell w\<^sub>h' \<theta>\<^sub>h' \<cdot> \<beta>\<^sub>h"
       proof -
         text \<open>
           Once again, the strategy is to form the subexpression
           \[
              \<open>\<a>[h, tab\<^sub>0 h, TTfgh.p\<^sub>0] \<cdot> (h.tab \<star> TTfgh.p\<^sub>0) \<cdot> fg\<^sub>0h\<^sub>1.\<phi> \<cdot> \<a>\<^sup>-\<^sup>1[tab\<^sub>0 g, Tfg.p\<^sub>0, TTfgh.p\<^sub>1]\<close>
           \]
           which is equal to \<open>\<theta>\<^sub>g\<close>, so that we can make use of the equation \<open>\<theta>\<^sub>g = \<theta>\<^sub>g' \<cdot> (tab\<^sub>0 g \<star> \<gamma>\<^sub>g)\<close>.
         \<close>
         have "h.composite_cell w\<^sub>h \<theta>\<^sub>h =
               (h \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0) \<cdot> \<a>[h, tab\<^sub>0 h, TTfgh.p\<^sub>0] \<cdot> (h.tab \<star> TTfgh.p\<^sub>0)"
           unfolding w\<^sub>h_def \<theta>\<^sub>h_def by simp
         also have "... = \<a>[h, tab\<^sub>0 h, TTfgh.p\<^sub>0] \<cdot> (h.tab \<star> TTfgh.p\<^sub>0)"
         proof -
           have "(h \<star> tab\<^sub>0 h \<star> TTfgh.p\<^sub>0) \<cdot> \<a>[h, tab\<^sub>0 h, TTfgh.p\<^sub>0] = \<a>[h, tab\<^sub>0 h, TTfgh.p\<^sub>0]"
             using comp_cod_arr by simp
           thus ?thesis
             using comp_assoc by metis
         qed
         also have "... = (\<a>[h, tab\<^sub>0 h, TTfgh.p\<^sub>0] \<cdot> (h.tab \<star> TTfgh.p\<^sub>0) \<cdot>
                            fg\<^sub>0h\<^sub>1.\<phi> \<cdot> \<a>\<^sup>-\<^sup>1[tab\<^sub>0 g, Tfg.p\<^sub>0, TTfgh.p\<^sub>1]) \<cdot>
                            \<a>[tab\<^sub>0 g, Tfg.p\<^sub>0, TTfgh.p\<^sub>1] \<cdot> inv fg\<^sub>0h\<^sub>1.\<phi>"
         proof -
           have "(h.tab \<star> TTfgh.p\<^sub>0) \<cdot> fg\<^sub>0h\<^sub>1.\<phi> \<cdot> (\<a>\<^sup>-\<^sup>1[tab\<^sub>0 g, Tfg.p\<^sub>0, TTfgh.p\<^sub>1] \<cdot>
                            \<a>[tab\<^sub>0 g, Tfg.p\<^sub>0, TTfgh.p\<^sub>1]) \<cdot> inv fg\<^sub>0h\<^sub>1.\<phi> =
                 (h.tab \<star> TTfgh.p\<^sub>0) \<cdot> fg\<^sub>0h\<^sub>1.\<phi> \<cdot> ((tab\<^sub>0 g \<star> Tfg.p\<^sub>0) \<star> TTfgh.p\<^sub>1) \<cdot> inv fg\<^sub>0h\<^sub>1.\<phi>"
            using fg\<^sub>0h\<^sub>1.p\<^sub>1_simps comp_assoc_assoc' by simp
           also have "... = (h.tab \<star> TTfgh.p\<^sub>0) \<cdot> fg\<^sub>0h\<^sub>1.\<phi> \<cdot> inv fg\<^sub>0h\<^sub>1.\<phi>"
            using fg\<^sub>0h\<^sub>1.p\<^sub>1_simps fg\<^sub>0h\<^sub>1.\<phi>_uniqueness comp_cod_arr by simp
           also have "... = (h.tab \<star> TTfgh.p\<^sub>0) \<cdot> (tab\<^sub>1 h \<star> TTfgh.p\<^sub>0)"
            using comp_arr_inv' fg\<^sub>0h\<^sub>1.\<phi>_uniqueness by simp
           also have "... = h.tab \<star> TTfgh.p\<^sub>0"
            using comp_arr_dom fg\<^sub>0h\<^sub>1.p\<^sub>0_simps by simp
           finally have "(h.tab \<star> TTfgh.p\<^sub>0) \<cdot> fg\<^sub>0h\<^sub>1.\<phi> \<cdot> (\<a>\<^sup>-\<^sup>1[tab\<^sub>0 g, Tfg.p\<^sub>0, TTfgh.p\<^sub>1] \<cdot>
                            \<a>[tab\<^sub>0 g, Tfg.p\<^sub>0, TTfgh.p\<^sub>1]) \<cdot> inv fg\<^sub>0h\<^sub>1.\<phi> =
                         h.tab \<star> TTfgh.p\<^sub>0"
             by simp
           thus ?thesis
             using comp_assoc by simp
         qed
         also have "... = \<theta>\<^sub>g \<cdot> \<a>[tab\<^sub>0 g, Tfg.p\<^sub>0, TTfgh.p\<^sub>1] \<cdot> inv fg\<^sub>0h\<^sub>1.\<phi>"
           unfolding \<theta>\<^sub>g_def by simp
         also have "... = (\<theta>\<^sub>g' \<cdot> (tab\<^sub>0 g \<star> \<gamma>\<^sub>g)) \<cdot> \<a>[tab\<^sub>0 g, Tfg.p\<^sub>0, TTfgh.p\<^sub>1] \<cdot> inv fg\<^sub>0h\<^sub>1.\<phi>"
           using \<gamma>\<^sub>g by simp
         also have "... = (h \<star> TTfgh_TfTgh.the_\<theta>) \<cdot>
                            can (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> ((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                                (((\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>) \<cdot>
                            ((h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                            (g\<^sub>0h\<^sub>1.\<phi> \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                            \<a>\<^sup>-\<^sup>1[tab\<^sub>0 g, Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            (tab\<^sub>0 g \<star> \<gamma>\<^sub>g) \<cdot>
                            \<a>[tab\<^sub>0 g, Tfg.p\<^sub>0, TTfgh.p\<^sub>1] \<cdot>
                            inv fg\<^sub>0h\<^sub>1.\<phi>"
           unfolding \<theta>\<^sub>g'_def
           using comp_assoc by presburger
         also have "... = (h \<star> TTfgh_TfTgh.the_\<theta>) \<cdot>
                            can (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> ((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                                (((\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>) \<cdot>
                            ((\<a>\<^sup>-\<^sup>1[h \<star> tab\<^sub>0 h, Tgh.p\<^sub>0, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            \<a>[h \<star> tab\<^sub>0 h, Tgh.p\<^sub>0, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine]) \<cdot>
                            ((h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine)) \<cdot>
                            (g\<^sub>0h\<^sub>1.\<phi> \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                            \<a>\<^sup>-\<^sup>1[tab\<^sub>0 g, Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            (tab\<^sub>0 g \<star> \<gamma>\<^sub>g) \<cdot>
                            \<a>[tab\<^sub>0 g, Tfg.p\<^sub>0, TTfgh.p\<^sub>1] \<cdot>
                            inv fg\<^sub>0h\<^sub>1.\<phi>"
         proof -
           have "(\<a>\<^sup>-\<^sup>1[h \<star> tab\<^sub>0 h, Tgh.p\<^sub>0, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            \<a>[h \<star> tab\<^sub>0 h, Tgh.p\<^sub>0, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine]) \<cdot>
                            ((h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) =
                  (h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine"
             using comp_cod_arr comp_assoc_assoc' by simp
           thus ?thesis
             using comp_assoc by simp
         qed
         also have "... = (h \<star> TTfgh_TfTgh.the_\<theta>) \<cdot>
                            can (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> ((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                                (((\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>) \<cdot>
                            \<a>\<^sup>-\<^sup>1[h \<star> tab\<^sub>0 h, Tgh.p\<^sub>0, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            (\<a>[h \<star> tab\<^sub>0 h, Tgh.p\<^sub>0, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            ((h.tab \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine)) \<cdot>
                            (g\<^sub>0h\<^sub>1.\<phi> \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                            \<a>\<^sup>-\<^sup>1[tab\<^sub>0 g, Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            (tab\<^sub>0 g \<star> \<gamma>\<^sub>g) \<cdot>
                            \<a>[tab\<^sub>0 g, Tfg.p\<^sub>0, TTfgh.p\<^sub>1] \<cdot>
                            inv fg\<^sub>0h\<^sub>1.\<phi>"
           using comp_assoc by presburger
         also have "... = (h \<star> TTfgh_TfTgh.the_\<theta>) \<cdot>
                            can (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> ((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                                  (((\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>) \<cdot>
                            \<a>\<^sup>-\<^sup>1[h \<star> tab\<^sub>0 h, Tgh.p\<^sub>0, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            (h.tab \<star> Tgh.p\<^sub>0 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                            \<a>[tab\<^sub>1 h, Tgh.p\<^sub>0, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            (g\<^sub>0h\<^sub>1.\<phi> \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                            \<a>\<^sup>-\<^sup>1[tab\<^sub>0 g, Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            (tab\<^sub>0 g \<star> \<gamma>\<^sub>g) \<cdot>
                            \<a>[tab\<^sub>0 g, Tfg.p\<^sub>0, TTfgh.p\<^sub>1] \<cdot>
                            inv fg\<^sub>0h\<^sub>1.\<phi>"
           using assoc_naturality [of h.tab Tgh.p\<^sub>0 "TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine"] comp_assoc
           by simp
         also have "... = (h \<star> TTfgh_TfTgh.the_\<theta>) \<cdot>
                            can (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> ((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                                  (((\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>) \<cdot>
                            \<a>\<^sup>-\<^sup>1[h \<star> tab\<^sub>0 h, Tgh.p\<^sub>0, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            ((\<a>\<^sup>-\<^sup>1[h, tab\<^sub>0 h, Tgh.p\<^sub>0 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            \<a>[h, tab\<^sub>0 h, Tgh.p\<^sub>0 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine]) \<cdot>
                            (h.tab \<star> Tgh.p\<^sub>0 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine)) \<cdot>
                            \<a>[tab\<^sub>1 h, Tgh.p\<^sub>0, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            (g\<^sub>0h\<^sub>1.\<phi> \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                            \<a>\<^sup>-\<^sup>1[tab\<^sub>0 g, Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            (tab\<^sub>0 g \<star> \<gamma>\<^sub>g) \<cdot>
                            \<a>[tab\<^sub>0 g, Tfg.p\<^sub>0, TTfgh.p\<^sub>1] \<cdot>
                            inv fg\<^sub>0h\<^sub>1.\<phi>"
         proof -
           have "(\<a>\<^sup>-\<^sup>1[h, tab\<^sub>0 h, Tgh.p\<^sub>0 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            \<a>[h, tab\<^sub>0 h, Tgh.p\<^sub>0 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine]) \<cdot>
                            (h.tab \<star> Tgh.p\<^sub>0 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) =
                 h.tab \<star> Tgh.p\<^sub>0 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine"
             using comp_cod_arr comp_assoc_assoc' by simp
           thus ?thesis
             using comp_assoc by simp
         qed
         also have "... = (h \<star> TTfgh_TfTgh.the_\<theta>) \<cdot>
                            (can (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> ((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                                  (((\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>) \<cdot>
                            (\<a>\<^sup>-\<^sup>1[h \<star> tab\<^sub>0 h, Tgh.p\<^sub>0, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            \<a>\<^sup>-\<^sup>1[h, tab\<^sub>0 h, Tgh.p\<^sub>0 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine])) \<cdot>
                            \<a>[h, tab\<^sub>0 h, Tgh.p\<^sub>0 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            (h.tab \<star> Tgh.p\<^sub>0 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                            \<a>[tab\<^sub>1 h, Tgh.p\<^sub>0, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            (g\<^sub>0h\<^sub>1.\<phi> \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                            \<a>\<^sup>-\<^sup>1[tab\<^sub>0 g, Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            (tab\<^sub>0 g \<star> \<gamma>\<^sub>g) \<cdot>
                            \<a>[tab\<^sub>0 g, Tfg.p\<^sub>0, TTfgh.p\<^sub>1] \<cdot>
                            inv fg\<^sub>0h\<^sub>1.\<phi>"
           using comp_assoc by presburger
         also have "... = ((h \<star> TTfgh_TfTgh.the_\<theta>) \<cdot>
                            (h \<star> can (((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                                     (\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>))) \<cdot>
                            \<a>[h, tab\<^sub>0 h, Tgh.p\<^sub>0 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            (h.tab \<star> Tgh.p\<^sub>0 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                            \<a>[tab\<^sub>1 h, Tgh.p\<^sub>0, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            (g\<^sub>0h\<^sub>1.\<phi> \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                            \<a>\<^sup>-\<^sup>1[tab\<^sub>0 g, Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            (tab\<^sub>0 g \<star> \<gamma>\<^sub>g) \<cdot>
                            \<a>[tab\<^sub>0 g, Tfg.p\<^sub>0, TTfgh.p\<^sub>1] \<cdot>
                            inv fg\<^sub>0h\<^sub>1.\<phi>"
         proof -
           have "can (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> ((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                     (((\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>) \<cdot>
                   (\<a>\<^sup>-\<^sup>1[h \<star> tab\<^sub>0 h, Tgh.p\<^sub>0, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                   \<a>\<^sup>-\<^sup>1[h, tab\<^sub>0 h, Tgh.p\<^sub>0 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine]) =
                 can (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> ((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                     (((\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>) \<cdot>
                   \<lbrace>\<^bold>\<a>\<^sup>-\<^sup>1\<^bold>[\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>, \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>, \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>\<^bold>] \<^bold>\<cdot>
                    \<^bold>\<a>\<^sup>-\<^sup>1\<^bold>[\<^bold>\<langle>h\<^bold>\<rangle>, \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>, \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>\<^bold>]\<rbrace>"
             using \<a>'_def \<alpha>_def by simp
           also have "... = can (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> ((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                                (((\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>) \<cdot>
                            can (((\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                                (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)"
           proof -
             have "\<lbrace>\<^bold>\<a>\<^sup>-\<^sup>1\<^bold>[\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>, \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>, \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>\<^bold>] \<^bold>\<cdot>
                    \<^bold>\<a>\<^sup>-\<^sup>1\<^bold>[\<^bold>\<langle>h\<^bold>\<rangle>, \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>, \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>\<^bold>]\<rbrace> =
                   can (((\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                                (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)"
               unfolding can_def
               apply (intro E.eval_eqI) by simp_all
             thus ?thesis by simp
           qed
           also have "... = can (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> ((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                                (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)"
             by simp
           also have "... = h \<star> can (((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                                    (\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)"
             using whisker_can_left_0 by simp
           finally have "can (\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> ((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                             (((\<^bold>\<langle>h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>) \<cdot>
                           (\<a>\<^sup>-\<^sup>1[h \<star> tab\<^sub>0 h, Tgh.p\<^sub>0, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                           \<a>\<^sup>-\<^sup>1[h, tab\<^sub>0 h, Tgh.p\<^sub>0 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine]) =
                         h \<star> can (((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                                 (\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)"
             by simp
           thus ?thesis
             using comp_assoc by presburger
         qed
         also have "... = (h \<star> TTfgh_TfTgh.the_\<theta> \<cdot>
                               can (((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                                   (\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)) \<cdot>
                            \<a>[h, tab\<^sub>0 h, Tgh.p\<^sub>0 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            (h.tab \<star> Tgh.p\<^sub>0 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                            \<a>[tab\<^sub>1 h, Tgh.p\<^sub>0, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            (g\<^sub>0h\<^sub>1.\<phi> \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                            \<a>\<^sup>-\<^sup>1[tab\<^sub>0 g, Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            (tab\<^sub>0 g \<star> \<gamma>\<^sub>g) \<cdot>
                            \<a>[tab\<^sub>0 g, Tfg.p\<^sub>0, TTfgh.p\<^sub>1] \<cdot>
                            inv fg\<^sub>0h\<^sub>1.\<phi>"
           using whisker_left [of h] comp_assoc by simp
         also have "... = (h \<star> TTfgh_TfTgh.the_\<theta> \<cdot>
                               \<a>\<^sup>-\<^sup>1[tab\<^sub>0 h \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                               \<a>\<^sup>-\<^sup>1[tab\<^sub>0 h, Tgh.p\<^sub>0, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine]) \<cdot>
                            \<a>[h, tab\<^sub>0 h, Tgh.p\<^sub>0 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            (h.tab \<star> Tgh.p\<^sub>0 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                            \<a>[tab\<^sub>1 h, Tgh.p\<^sub>0, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            (g\<^sub>0h\<^sub>1.\<phi> \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine) \<cdot>
                            \<a>\<^sup>-\<^sup>1[tab\<^sub>0 g, Tgh.p\<^sub>1, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine] \<cdot>
                            (tab\<^sub>0 g \<star> \<gamma>\<^sub>g) \<cdot>
                            \<a>[tab\<^sub>0 g, Tfg.p\<^sub>0, TTfgh.p\<^sub>1] \<cdot>
                            inv fg\<^sub>0h\<^sub>1.\<phi>"
         proof -
           have "can (((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                     (\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>) =
                 \<lbrace>\<^bold>\<a>\<^sup>-\<^sup>1\<^bold>[\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>, \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>, \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>\<^bold>] \<^bold>\<cdot>
                  \<^bold>\<a>\<^sup>-\<^sup>1\<^bold>[\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle>, \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>, \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>\<^bold>]\<rbrace>"
             unfolding can_def
             apply (intro E.eval_eqI) by auto
           also have "... = \<a>\<^sup>-\<^sup>1[tab\<^sub>0 h \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                              \<a>\<^sup>-\<^sup>1[tab\<^sub>0 h, Tgh.p\<^sub>0, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine]"
             using \<a>'_def \<alpha>_def by simp
           finally have "can (((\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>)
                             (\<^bold>\<langle>tab\<^sub>0 h\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>Tgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TfTgh.p\<^sub>0\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>TTfgh_TfTgh.chine\<^bold>\<rangle>) =
                         \<a>\<^sup>-\<^sup>1[tab\<^sub>0 h \<star> Tgh.p\<^sub>0, TfTgh.p\<^sub>0, TTfgh_TfTgh.chine] \<cdot>
                           \<a>\<^sup>-\<^sup>1[tab\<^sub>0 h, Tgh.p\<^sub>0, TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine]"
             by simp
           thus ?thesis by simp
         qed
         also have "... = h.composite_cell w\<^sub>h' \<theta>\<^sub>h' \<cdot> \<beta>\<^sub>h"
           unfolding w\<^sub>h'_def \<theta>\<^sub>h'_def \<beta>\<^sub>h_def
           using comp_assoc by presburger
         finally show ?thesis by simp
       qed
       have 7: "\<exists>!\<gamma>. \<guillemotleft>\<gamma> : w\<^sub>h \<Rightarrow> w\<^sub>h'\<guillemotright> \<and> \<beta>\<^sub>h = tab\<^sub>1 h \<star> \<gamma> \<and> \<theta>\<^sub>h = \<theta>\<^sub>h' \<cdot> (tab\<^sub>0 h \<star> \<gamma>)"
         using w\<^sub>h w\<^sub>h' \<theta>\<^sub>h \<theta>\<^sub>h' \<beta>\<^sub>h eq\<^sub>h h.T2 [of w\<^sub>h w\<^sub>h' \<theta>\<^sub>h u\<^sub>h \<theta>\<^sub>h' \<beta>\<^sub>h] by blast
       obtain \<gamma>\<^sub>h where \<gamma>\<^sub>h: "\<guillemotleft>\<gamma>\<^sub>h : w\<^sub>h \<Rightarrow> w\<^sub>h'\<guillemotright> \<and> \<beta>\<^sub>h = tab\<^sub>1 h \<star> \<gamma>\<^sub>h \<and> \<theta>\<^sub>h = \<theta>\<^sub>h' \<cdot> (tab\<^sub>0 h \<star> \<gamma>\<^sub>h)"
         using 7 by auto
       show "\<lbrakk>\<lbrakk>Tgh.p\<^sub>0 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine\<rbrakk>\<rbrakk> = \<lbrakk>\<lbrakk>TTfgh.p\<^sub>0\<rbrakk>\<rbrakk>"
       proof -
         have "iso \<gamma>\<^sub>h"
           using \<gamma>\<^sub>h BS3 w\<^sub>h_is_map w\<^sub>h'_is_map by blast
         hence "isomorphic w\<^sub>h w\<^sub>h'"
           using \<gamma>\<^sub>h isomorphic_def isomorphic_symmetric by auto
         thus ?thesis
           using w\<^sub>h w\<^sub>h' w\<^sub>h_def w\<^sub>h'_def Maps.CLS_eqI [of w\<^sub>h w\<^sub>h'] by simp
       qed
     qed
 
     text \<open>
       Finally, we can show that @{term TTfgh_TfTgh.chine} is given by tupling.
     \<close>
 
     lemma CLS_chine:
     shows "\<lbrakk>\<lbrakk>TTfgh_TfTgh.chine\<rbrakk>\<rbrakk> = tuple_ABC"
     proof -
       have "tuple_ABC = SPN_fgh.chine_assoc"
         using SPN_fgh.chine_assoc_def by simp
       also have "... = \<lbrakk>\<lbrakk>TTfgh_TfTgh.chine\<rbrakk>\<rbrakk>"
       proof (intro Maps.arr_eqI)
         show "Maps.arr SPN_fgh.chine_assoc"
           using SPN_fgh.chine_assoc_in_hom by auto
         show "Maps.arr \<lbrakk>\<lbrakk>TTfgh_TfTgh.chine\<rbrakk>\<rbrakk>"
           using Maps.CLS_in_hom TTfgh_TfTgh.is_map by blast
         show "Maps.Dom SPN_fgh.chine_assoc = Maps.Dom \<lbrakk>\<lbrakk>TTfgh_TfTgh.chine\<rbrakk>\<rbrakk>"
           using SPN_fgh.chine_assoc_def Maps.dom_char tuple_ABC_in_hom TTfgh_TfTgh.chine_in_hom
           by fastforce
         show "Maps.Cod SPN_fgh.chine_assoc = Maps.Cod \<lbrakk>\<lbrakk>TTfgh_TfTgh.chine\<rbrakk>\<rbrakk>"
         proof - 
           have "Maps.Cod SPN_fgh.chine_assoc = Maps.Cod tuple_ABC"
             using SPN_fgh.chine_assoc_def by simp
           also have "... = src (prj\<^sub>0 (tab\<^sub>1 g \<star> prj\<^sub>1 (tab\<^sub>1 h) (tab\<^sub>0 g)) (tab\<^sub>0 f))"
             by (metis (lifting) Maps.Dom.simps(1) Maps.seq_char SPN_fgh.prj_chine_assoc(1)
                 SPN_fgh.prj_simps(1) calculation f\<^sub>0gh\<^sub>1.leg1_simps(3) prj_char(4))
           also have "... = Maps.Cod \<lbrakk>\<lbrakk>TTfgh_TfTgh.chine\<rbrakk>\<rbrakk>"
             using Maps.cod_char TTfgh_TfTgh.chine_in_hom by simp
           finally show ?thesis by blast
         qed
         show "Maps.Map SPN_fgh.chine_assoc = Maps.Map \<lbrakk>\<lbrakk>TTfgh_TfTgh.chine\<rbrakk>\<rbrakk>"
         proof -
           have 0: "Chn (Span.hcomp (SPN f) (Span.hcomp (SPN g) (SPN h))) =
                    Maps.MkIde (src TfTgh.p\<^sub>0)"
             using fg gh
             by (metis (mono_tags, lifting) Maps.in_homE Maps.seqE SPN_fgh.prj_chine_assoc(1)
                 SPN_fgh.prj_simps(1) SPN_fgh.prj_simps(13) calculation tuple_ABC_in_hom)
           have "tuple_ABC = \<lbrakk>\<lbrakk>TTfgh_TfTgh.chine\<rbrakk>\<rbrakk>"
           proof (intro Maps.prj_joint_monic
                          [of SPN_fgh.\<mu>.leg0 "SPN_fgh.\<nu>.leg1 \<odot> SPN_fgh.\<nu>\<pi>.prj\<^sub>1"
                              tuple_ABC "\<lbrakk>\<lbrakk>TTfgh_TfTgh.chine\<rbrakk>\<rbrakk>"])
             show "Maps.cospan SPN_fgh.\<mu>.leg0 (SPN_fgh.\<nu>.leg1 \<odot> SPN_fgh.\<nu>\<pi>.prj\<^sub>1)"
               using SPN_fgh.\<nu>\<pi>.dom.is_span SPN_fgh.\<nu>\<pi>.leg1_composite SPN_fgh.cospan_\<mu>\<nu>
               by auto
             show "Maps.seq SPN_fgh.Prj\<^sub>1 tuple_ABC"
               using 0 tuple_ABC_in_hom SPN_fgh.prj_in_hom(4) by auto
             show "Maps.seq SPN_fgh.Prj\<^sub>1 \<lbrakk>\<lbrakk>TTfgh_TfTgh.chine\<rbrakk>\<rbrakk>"
             proof
               show "Maps.in_hom \<lbrakk>\<lbrakk>TTfgh_TfTgh.chine\<rbrakk>\<rbrakk> \<lbrakk>\<lbrakk>src TTfgh_TfTgh.chine\<rbrakk>\<rbrakk>
                                 \<lbrakk>\<lbrakk>trg TTfgh_TfTgh.chine\<rbrakk>\<rbrakk>"
                 using fg gh TTfgh_TfTgh.chine_in_hom Maps.CLS_in_hom TTfgh_TfTgh.is_map
                 by blast
               show "Maps.in_hom SPN_fgh.Prj\<^sub>1 \<lbrakk>\<lbrakk>trg TTfgh_TfTgh.chine\<rbrakk>\<rbrakk> SPN_fgh.\<mu>.apex"
               proof
                 show "Maps.cospan SPN_fgh.\<mu>.leg0 (SPN_fgh.\<nu>.leg1 \<odot> SPN_fgh.\<nu>\<pi>.prj\<^sub>1)"
                   using SPN_fgh.prj_in_hom(4) by blast
                 show "\<lbrakk>\<lbrakk>trg TTfgh_TfTgh.chine\<rbrakk>\<rbrakk> =
                       Maps.pbdom SPN_fgh.\<mu>.leg0 (SPN_fgh.\<nu>.leg1 \<odot> SPN_fgh.\<nu>\<pi>.prj\<^sub>1)"
                 proof -
                   have "\<lbrakk>\<lbrakk>trg TTfgh_TfTgh.chine\<rbrakk>\<rbrakk> = Maps.MkIde (src TfTgh.p\<^sub>0)"
                     by simp
                   also have "... = Maps.pbdom SPN_fgh.\<mu>.leg0 (SPN_fgh.\<nu>.leg1 \<odot> SPN_fgh.\<nu>\<pi>.prj\<^sub>1)"
                     using 0 Maps.pbdom_def SPN_fgh.chine_composite(2) by presburger
                   finally show ?thesis by blast
                 qed
                 show "SPN_fgh.\<mu>.apex = Maps.dom SPN_fgh.\<mu>.leg0"
                   using SPN_f.dom.apex_def by blast
               qed
             qed
             have 2: "Maps.commutative_square SPN_fgh.\<nu>.leg0 SPN_fgh.\<pi>.leg1
                                              SPN_fgh.Prj\<^sub>0\<^sub>1 SPN_fgh.Prj\<^sub>0"
             proof
               show "Maps.cospan SPN_fgh.\<nu>.leg0 SPN_fgh.\<pi>.leg1"
                 using SPN_fgh.\<nu>\<pi>.legs_form_cospan(1) by simp
               show "Maps.span SPN_fgh.Prj\<^sub>0\<^sub>1 SPN_fgh.Prj\<^sub>0"
                 using SPN_fgh.prj_simps(2-3,5-6) by presburger
               show "Maps.dom SPN_fgh.\<nu>.leg0 = Maps.cod SPN_fgh.Prj\<^sub>0\<^sub>1"
                 using SPN_fgh.prj_simps(8) SPN_g.dom.is_span SPN_g.dom.leg_simps(2)
                 by auto
               show "SPN_fgh.\<nu>.leg0 \<odot> SPN_fgh.Prj\<^sub>0\<^sub>1 = SPN_fgh.\<pi>.leg1 \<odot> SPN_fgh.Prj\<^sub>0"
                 by (metis (no_types, lifting) Maps.cod_comp Maps.comp_assoc
                     Maps.pullback_commutes' SPN_fgh.\<mu>\<nu>.dom.leg_simps(1)
                     SPN_fgh.\<mu>\<nu>.leg0_composite SPN_fgh.cospan_\<nu>\<pi>)
             qed
             have 1: "Maps.commutative_square
                        SPN_fgh.\<mu>.leg0 (Maps.comp SPN_fgh.\<nu>.leg1 SPN_fgh.\<nu>\<pi>.prj\<^sub>1)
                        SPN_fgh.Prj\<^sub>1\<^sub>1 tuple_BC"
             proof
               show "Maps.cospan SPN_fgh.\<mu>.leg0 (Maps.comp SPN_fgh.\<nu>.leg1 SPN_fgh.\<nu>\<pi>.prj\<^sub>1)"
                 using fg gh SPN_fgh.prj_simps(10) by blast
               show "Maps.span SPN_fgh.Prj\<^sub>1\<^sub>1 tuple_BC"
                 using fg gh csq(2) by blast
               show "Maps.dom SPN_fgh.\<mu>.leg0 = Maps.cod SPN_fgh.Prj\<^sub>1\<^sub>1"
                 using fg gh SPN_f.dom.leg_simps(2) SPN_fgh.prj_simps(7) by auto
               show "SPN_fgh.\<mu>.leg0 \<odot> SPN_fgh.Prj\<^sub>1\<^sub>1 =
                     (SPN_fgh.\<nu>.leg1 \<odot> SPN_fgh.\<nu>\<pi>.prj\<^sub>1) \<odot> tuple_BC"
                 using 2 fg gh Maps.comp_assoc csq(2)
                       Maps.prj_tuple [of SPN_fgh.\<nu>.leg0 SPN_fgh.\<pi>.leg1 SPN_fgh.Prj\<^sub>0\<^sub>1 SPN_fgh.Prj\<^sub>0]
                 by blast
             qed
             show "SPN_fgh.Prj\<^sub>1 \<odot> tuple_ABC = SPN_fgh.Prj\<^sub>1 \<odot> Maps.CLS TTfgh_TfTgh.chine"
             proof -
               have "SPN_fgh.Prj\<^sub>1 \<odot> tuple_ABC = SPN_fgh.Prj\<^sub>1\<^sub>1"
                 using csq(2) by simp
               also have "... = \<lbrakk>\<lbrakk>Tfg.p\<^sub>1 \<star> TTfgh.p\<^sub>1\<rbrakk>\<rbrakk>"
                 using prj_char by simp
               also have "... = \<lbrakk>\<lbrakk>TfTgh.p\<^sub>1 \<star> TTfgh_TfTgh.chine\<rbrakk>\<rbrakk>"
                 using prj_chine(1) by simp
               also have "... = \<lbrakk>\<lbrakk>TfTgh.p\<^sub>1\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>TTfgh_TfTgh.chine\<rbrakk>\<rbrakk>"
               proof -
                 have "is_left_adjoint TfTgh.p\<^sub>1"
                   by (simp add: fg)
                 moreover have "is_left_adjoint TTfgh_TfTgh.chine"
                   using TTfgh_TfTgh.is_map by simp
                 moreover have "TfTgh.p\<^sub>1 \<star> TTfgh_TfTgh.chine \<cong> TfTgh.p\<^sub>1 \<star> TTfgh_TfTgh.chine"
                   using fg gh isomorphic_reflexive by simp
                 ultimately show ?thesis
                   using Maps.comp_CLS
                           [of TfTgh.p\<^sub>1 TTfgh_TfTgh.chine "TfTgh.p\<^sub>1 \<star> TTfgh_TfTgh.chine"]
                   by simp
               qed
               finally show ?thesis
                 using prj_char by simp
             qed
             show
               "Maps.PRJ\<^sub>0 SPN_fgh.\<mu>.leg0 (SPN_fgh.\<nu>.leg1 \<odot> SPN_fgh.\<nu>\<pi>.prj\<^sub>1) \<odot> tuple_ABC =
                Maps.PRJ\<^sub>0 SPN_fgh.\<mu>.leg0 (SPN_fgh.\<nu>.leg1 \<odot> SPN_fgh.\<nu>\<pi>.prj\<^sub>1) \<odot>
                  \<lbrakk>\<lbrakk>TTfgh_TfTgh.chine\<rbrakk>\<rbrakk>"
             proof -
               have
                 "Maps.PRJ\<^sub>0 SPN_fgh.\<mu>.leg0 (SPN_fgh.\<nu>.leg1 \<odot> SPN_fgh.\<nu>\<pi>.prj\<^sub>1) \<odot> tuple_ABC =
                  tuple_BC"
                 using csq(2)
                       Maps.prj_tuple [of SPN_fgh.\<mu>.leg0 "SPN_fgh.\<nu>.leg1 \<odot> SPN_fgh.\<nu>\<pi>.prj\<^sub>1"
                                          SPN_fgh.Prj\<^sub>1\<^sub>1 tuple_BC]
                 by simp
               also have "... =
                          Maps.comp
                            (Maps.PRJ\<^sub>0 SPN_fgh.\<mu>.leg0 (Maps.comp SPN_fgh.\<nu>.leg1 SPN_fgh.\<nu>\<pi>.prj\<^sub>1))
                            \<lbrakk>\<lbrakk>TTfgh_TfTgh.chine\<rbrakk>\<rbrakk>"
               proof (intro Maps.prj_joint_monic
                              [of SPN_fgh.\<nu>.leg0 SPN_fgh.\<pi>.leg1 tuple_BC
                                  "Maps.PRJ\<^sub>0 SPN_fgh.\<mu>.leg0 (SPN_fgh.\<nu>.leg1 \<odot> SPN_fgh.\<nu>\<pi>.prj\<^sub>1) \<odot>
                                     \<lbrakk>\<lbrakk>TTfgh_TfTgh.chine\<rbrakk>\<rbrakk>"])
                 show "Maps.cospan SPN_fgh.\<nu>.leg0 SPN_fgh.\<pi>.leg1"
                   using SPN_fgh.\<nu>\<pi>.legs_form_cospan(1) by simp
                 show "Maps.seq SPN_fgh.\<nu>\<pi>.prj\<^sub>1 tuple_BC"
                 proof
                   show "Maps.in_hom tuple_BC
                                     (Maps.MkIde (src TTfgh.p\<^sub>0)) (Maps.MkIde (src Tgh.p\<^sub>0))"
                     using tuple_BC_in_hom by simp
                   show "Maps.in_hom SPN_fgh.\<nu>\<pi>.prj\<^sub>1 (Maps.MkIde (src Tgh.p\<^sub>0)) SPN_fgh.\<nu>.apex"
                   proof -
                     have "Maps.pbdom SPN_fgh.\<nu>.leg0 SPN_fgh.\<pi>.leg1 = Maps.MkIde (src Tgh.p\<^sub>0)"
                       using fg gh Maps.pbdom_def
                       by (metis (no_types, lifting) SPN.preserves_ide SPN_fgh.\<nu>\<pi>.are_identities(2)
                           SPN_fgh.\<nu>\<pi>.composable Span.chine_hcomp_ide_ide Tgh.chine_hcomp_SPN_SPN
                           g.is_ide)
                     thus ?thesis
                       using SPN_fgh.\<nu>\<pi>.prj_in_hom(1) by simp
                   qed
                 qed
                 show "Maps.seq SPN_fgh.\<nu>\<pi>.prj\<^sub>1
                                (Maps.PRJ\<^sub>0 SPN_fgh.\<mu>.leg0 (SPN_fgh.\<nu>.leg1 \<odot> SPN_fgh.\<nu>\<pi>.prj\<^sub>1) \<odot>
                                   \<lbrakk>\<lbrakk>TTfgh_TfTgh.chine\<rbrakk>\<rbrakk>)"
                 proof
                   show "Maps.in_hom SPN_fgh.\<nu>\<pi>.prj\<^sub>1
                                     (Maps.pbdom SPN_fgh.\<nu>.leg0 SPN_fgh.\<pi>.leg1) SPN_fgh.\<nu>.apex"
                     using SPN_fgh.\<nu>\<pi>.prj_in_hom(1) by simp
                   show "Maps.in_hom
                          (Maps.PRJ\<^sub>0 SPN_fgh.\<mu>.leg0 (SPN_fgh.\<nu>.leg1 \<odot> SPN_fgh.\<nu>\<pi>.prj\<^sub>1) \<odot>
                              \<lbrakk>\<lbrakk>TTfgh_TfTgh.chine\<rbrakk>\<rbrakk>)
                          \<lbrakk>\<lbrakk>src TTfgh_TfTgh.chine\<rbrakk>\<rbrakk>
                          (Maps.pbdom SPN_fgh.\<nu>.leg0 SPN_fgh.\<pi>.leg1)"
                   proof
                     show "Maps.in_hom \<lbrakk>\<lbrakk>TTfgh_TfTgh.chine\<rbrakk>\<rbrakk> \<lbrakk>\<lbrakk>src TTfgh_TfTgh.chine\<rbrakk>\<rbrakk>
                                       \<lbrakk>\<lbrakk>trg TTfgh_TfTgh.chine\<rbrakk>\<rbrakk>"
                       using fg gh TTfgh_TfTgh.chine_in_hom Maps.CLS_in_hom TTfgh_TfTgh.is_map
                       by blast
                     show "Maps.in_hom
                            (Maps.PRJ\<^sub>0 SPN_fgh.\<mu>.leg0 (SPN_fgh.\<nu>.leg1 \<odot> SPN_fgh.\<nu>\<pi>.prj\<^sub>1))
                            \<lbrakk>\<lbrakk>trg TTfgh_TfTgh.chine\<rbrakk>\<rbrakk>
                            (Maps.pbdom SPN_fgh.\<nu>.leg0 SPN_fgh.\<pi>.leg1)"
                     proof
                       show "Maps.cospan SPN_fgh.\<mu>.leg0 (SPN_fgh.\<nu>.leg1 \<odot> SPN_fgh.\<nu>\<pi>.prj\<^sub>1)"
                         using SPN_fgh.prj_in_hom(4) by blast
                       show "\<lbrakk>\<lbrakk>trg TTfgh_TfTgh.chine\<rbrakk>\<rbrakk> =
                             Maps.pbdom SPN_fgh.\<mu>.leg0 (SPN_fgh.\<nu>.leg1 \<odot> SPN_fgh.\<nu>\<pi>.prj\<^sub>1)"
                       proof -
                         have "\<lbrakk>\<lbrakk>trg TTfgh_TfTgh.chine\<rbrakk>\<rbrakk> = Maps.MkIde (src TfTgh.p\<^sub>0)"
                           by simp
                         also have "... = Maps.pbdom SPN_fgh.\<mu>.leg0
                                                     (SPN_fgh.\<nu>.leg1 \<odot> SPN_fgh.\<nu>\<pi>.prj\<^sub>1)"
                           using 0 Maps.pbdom_def SPN_fgh.chine_composite(2) by presburger
                         finally show ?thesis by blast
                       qed
                       show "Maps.pbdom SPN_fgh.\<nu>.leg0 SPN_fgh.\<pi>.leg1 =
                             Maps.dom (SPN_fgh.\<nu>.leg1 \<odot> SPN_fgh.\<nu>\<pi>.prj\<^sub>1)"
                         using fg gh Maps.pbdom_def SPN_fgh.\<nu>\<pi>.apex_composite
                               SPN_fgh.\<nu>\<pi>.dom.apex_def SPN_fgh.\<nu>\<pi>.dom.is_span
                               SPN_fgh.\<nu>\<pi>.leg1_composite
                         by presburger
                     qed
                   qed
                 qed
                 show "SPN_fgh.\<nu>\<pi>.prj\<^sub>0 \<odot> tuple_BC =
                       SPN_fgh.\<nu>\<pi>.prj\<^sub>0 \<odot>
                         Maps.PRJ\<^sub>0 SPN_fgh.\<mu>.leg0 (SPN_fgh.\<nu>.leg1 \<odot> SPN_fgh.\<nu>\<pi>.prj\<^sub>1) \<odot>
                         \<lbrakk>\<lbrakk>TTfgh_TfTgh.chine\<rbrakk>\<rbrakk>"
                 proof - 
                   have "SPN_fgh.\<nu>\<pi>.prj\<^sub>0 \<odot> tuple_BC = SPN_fgh.Prj\<^sub>0"
                     using csq(1) by simp
                   also have "... = SPN_fgh.\<nu>\<pi>.prj\<^sub>0 \<odot>
                                      Maps.PRJ\<^sub>0 SPN_fgh.\<mu>.leg0 (SPN_fgh.\<nu>.leg1 \<odot> SPN_fgh.\<nu>\<pi>.prj\<^sub>1) \<odot>
                                      \<lbrakk>\<lbrakk>TTfgh_TfTgh.chine\<rbrakk>\<rbrakk>"
                   proof -
                     have "SPN_fgh.\<nu>\<pi>.prj\<^sub>0 \<odot>
                             Maps.PRJ\<^sub>0 SPN_fgh.\<mu>.leg0 (SPN_fgh.\<nu>.leg1 \<odot> SPN_fgh.\<nu>\<pi>.prj\<^sub>1) \<odot>
                             \<lbrakk>\<lbrakk>TTfgh_TfTgh.chine\<rbrakk>\<rbrakk> =
                           \<lbrakk>\<lbrakk>Tgh.p\<^sub>0\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>TfTgh.p\<^sub>0\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>TTfgh_TfTgh.chine\<rbrakk>\<rbrakk>"
                       using fg gh Tgh.\<rho>\<sigma>.prj_char TfTgh.prj_char(1) isomorphic_reflexive
                             Maps.comp_CLS [of "tab\<^sub>1 g" "prj\<^sub>1 (tab\<^sub>1 h) (tab\<^sub>0 g)" "tab\<^sub>1 g \<star> Tgh.p\<^sub>1"]
                       by simp
                     also have "... = \<lbrakk>\<lbrakk>Tgh.p\<^sub>0\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine\<rbrakk>\<rbrakk>"
                       using fg gh TTfgh_TfTgh.is_map isomorphic_reflexive
                             Maps.comp_CLS
                               [of TfTgh.p\<^sub>0 TTfgh_TfTgh.chine "TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine"]
                       by simp
                     also have "... = \<lbrakk>\<lbrakk>Tgh.p\<^sub>0 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine\<rbrakk>\<rbrakk>"
                       using fg gh TTfgh_TfTgh.is_map left_adjoints_compose isomorphic_reflexive
                             Maps.comp_CLS [of Tgh.p\<^sub>0 "TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine"
                                            "Tgh.p\<^sub>0 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine"]
                       by simp
                     also have "... = \<lbrakk>\<lbrakk>TTfgh.p\<^sub>0\<rbrakk>\<rbrakk>"
                       using prj_chine(3) by simp
                     also have "... = SPN_fgh.Prj\<^sub>0"
                       using prj_char by simp
                     finally show ?thesis by argo
                   qed
                   finally show ?thesis by blast
                 qed
                 show "SPN_fgh.\<nu>\<pi>.prj\<^sub>1 \<odot> tuple_BC =
                       SPN_fgh.\<nu>\<pi>.prj\<^sub>1 \<odot>
                         Maps.PRJ\<^sub>0 SPN_fgh.\<mu>.leg0 (SPN_fgh.\<nu>.leg1 \<odot> SPN_fgh.\<nu>\<pi>.prj\<^sub>1) \<odot>
                         \<lbrakk>\<lbrakk>TTfgh_TfTgh.chine\<rbrakk>\<rbrakk>"
                 proof -
                   have "SPN_fgh.\<nu>\<pi>.prj\<^sub>1 \<odot> tuple_BC = SPN_fgh.Prj\<^sub>0\<^sub>1"
                     using csq(1) by simp
                   also have "... = SPN_fgh.\<nu>\<pi>.prj\<^sub>1 \<odot>
                                      Maps.PRJ\<^sub>0 SPN_fgh.\<mu>.leg0 (SPN_fgh.\<nu>.leg1 \<odot> SPN_fgh.\<nu>\<pi>.prj\<^sub>1) \<odot>
                                       \<lbrakk>\<lbrakk>TTfgh_TfTgh.chine\<rbrakk>\<rbrakk>"
                   proof -
                     have "SPN_fgh.\<nu>\<pi>.prj\<^sub>1 \<odot>
                             Maps.PRJ\<^sub>0 SPN_fgh.\<mu>.leg0 (SPN_fgh.\<nu>.leg1 \<odot> SPN_fgh.\<nu>\<pi>.prj\<^sub>1) \<odot>
                              \<lbrakk>\<lbrakk>TTfgh_TfTgh.chine\<rbrakk>\<rbrakk> =
                           \<lbrakk>\<lbrakk>Tgh.p\<^sub>1\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>TfTgh.p\<^sub>0\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>TTfgh_TfTgh.chine\<rbrakk>\<rbrakk>"
                       using fg gh Tgh.\<rho>\<sigma>.prj_char TfTgh.prj_char(1) isomorphic_reflexive
                             Maps.comp_CLS [of "tab\<^sub>1 g" "prj\<^sub>1 (tab\<^sub>1 h) (tab\<^sub>0 g)" "tab\<^sub>1 g \<star> Tgh.p\<^sub>1"]
                       by simp
                     also have "... = \<lbrakk>\<lbrakk>Tgh.p\<^sub>1\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine\<rbrakk>\<rbrakk>"
                       using fg gh TTfgh_TfTgh.is_map isomorphic_reflexive
                             Maps.comp_CLS
                               [of TfTgh.p\<^sub>0 TTfgh_TfTgh.chine "TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine"]
                       by simp
                     also have "... = \<lbrakk>\<lbrakk>Tgh.p\<^sub>1 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine\<rbrakk>\<rbrakk>"
                       using fg gh TTfgh_TfTgh.is_map left_adjoints_compose isomorphic_reflexive
                             Maps.comp_CLS [of Tgh.p\<^sub>1 "TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine"
                                          "Tgh.p\<^sub>1 \<star> TfTgh.p\<^sub>0 \<star> TTfgh_TfTgh.chine"]
                       by simp
                     also have "... = \<lbrakk>\<lbrakk>Tfg.p\<^sub>0 \<star> TTfgh.p\<^sub>1\<rbrakk>\<rbrakk>"
                       using prj_chine(2) by simp
                     also have "... = SPN_fgh.Prj\<^sub>0\<^sub>1"
                       using prj_char by simp
                     finally show ?thesis by argo
                   qed
                   finally show ?thesis by blast
                 qed
               qed
               finally show ?thesis by simp
             qed
           qed
           thus ?thesis
             using SPN_fgh.chine_assoc_def by simp
         qed
       qed
       finally show ?thesis by simp
     qed
 
     text \<open>
       At long last, we can show associativity coherence for \<open>SPN\<close>.
     \<close>
 
     lemma assoc_coherence:
     shows "LHS = RHS"
     proof (intro Span.arr_eqI)
       show "Span.par LHS RHS"
         using par_LHS_RHS by blast
       show "Chn LHS = Chn RHS"
       proof -
         have "Chn LHS = \<lbrakk>\<lbrakk>HHfgh_HfHgh.chine\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>THfgh_HHfgh.chine\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>TTfgh_THfgh.chine\<rbrakk>\<rbrakk>"
           using Chn_LHS_eq by simp
         also have "... = \<lbrakk>\<lbrakk>HHfgh_HfHgh.chine \<star> THfgh_HHfgh.chine \<star> TTfgh_THfgh.chine\<rbrakk>\<rbrakk>"
         proof -
           have "\<lbrakk>\<lbrakk>THfgh_HHfgh.chine\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>TTfgh_THfgh.chine\<rbrakk>\<rbrakk> =
                 \<lbrakk>\<lbrakk>THfgh_HHfgh.chine \<star> TTfgh_THfgh.chine\<rbrakk>\<rbrakk>"
             using fg gh isomorphic_reflexive HHfgh_HfHgh.is_map THfgh_HHfgh.is_map
                   TTfgh_THfgh.is_map left_adjoints_compose
                   Maps.comp_CLS
                     [of THfgh_HHfgh.chine TTfgh_THfgh.chine "THfgh_HHfgh.chine \<star> TTfgh_THfgh.chine"]
             by simp
           moreover
           have "\<lbrakk>\<lbrakk>HHfgh_HfHgh.chine\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>THfgh_HHfgh.chine \<star> TTfgh_THfgh.chine\<rbrakk>\<rbrakk> =
                 \<lbrakk>\<lbrakk>HHfgh_HfHgh.chine \<star> THfgh_HHfgh.chine \<star> TTfgh_THfgh.chine\<rbrakk>\<rbrakk>"
           proof -
             have "ide (HHfgh_HfHgh.chine \<star> THfgh_HHfgh.chine \<star> TTfgh_THfgh.chine)"
             proof -
               have "ide (THfgh_HHfgh.chine \<star> TTfgh_THfgh.chine)"  
                 using fg gh HHfgh_HfHgh.is_map THfgh_HHfgh.is_map TTfgh_THfgh.is_map
                       left_adjoint_is_ide left_adjoints_compose
                 by auto
               moreover have "src HHfgh_HfHgh.chine = trg (THfgh_HHfgh.chine \<star> TTfgh_THfgh.chine)"
                 using fg gh HHfgh_HfHgh.chine_in_hom \<alpha>_def by auto
               ultimately show ?thesis by simp
             qed
             thus ?thesis
               using fg gh isomorphic_reflexive HHfgh_HfHgh.is_map THfgh_HHfgh.is_map
                     TTfgh_THfgh.is_map left_adjoints_compose
                     Maps.comp_CLS
                       [of HHfgh_HfHgh.chine "THfgh_HHfgh.chine \<star> TTfgh_THfgh.chine"
                           "HHfgh_HfHgh.chine \<star> THfgh_HHfgh.chine \<star> TTfgh_THfgh.chine"]
               by auto
           qed
           ultimately show ?thesis by argo
         qed
         also have "... = \<lbrakk>\<lbrakk>TfHgh_HfHgh.chine \<star> TfTgh_TfHgh.chine \<star> TTfgh_TfTgh.chine\<rbrakk>\<rbrakk>"
         proof -
           interpret A: vertical_composite_of_arrows_of_tabulations_in_maps V H \<a> \<i> src trg
                          \<open>(f \<star> g) \<star> h\<close> TTfgh.tab \<open>tab\<^sub>0 h \<star> TTfgh.p\<^sub>0\<close> \<open>(tab\<^sub>1 f \<star> Tfg.p\<^sub>1) \<star> TTfgh.p\<^sub>1\<close>
                          \<open>f \<star> g \<star> h\<close> TfTgh.tab \<open>(tab\<^sub>0 h \<star> Tgh.p\<^sub>0) \<star> TfTgh.p\<^sub>0\<close> \<open>tab\<^sub>1 f \<star> TfTgh.p\<^sub>1\<close>
                          \<open>f \<star> g \<star> h\<close> TfHgh.\<rho>\<sigma>.tab \<open>tab\<^sub>0 (g \<star> h) \<star> TfHgh.\<rho>\<sigma>.p\<^sub>0\<close> \<open>tab\<^sub>1 f \<star> TfHgh.\<rho>\<sigma>.p\<^sub>1\<close>
                          \<open>\<a>[f, g, h]\<close> \<open>f \<star> g \<star> h\<close>
             ..
           interpret B: vertical_composite_of_arrows_of_tabulations_in_maps V H \<a> \<i> src trg
                          \<open>(f \<star> g) \<star> h\<close> TTfgh.tab \<open>tab\<^sub>0 h \<star> TTfgh.p\<^sub>0\<close> \<open>(tab\<^sub>1 f \<star> Tfg.p\<^sub>1) \<star> TTfgh.p\<^sub>1\<close>
                          \<open>f \<star> g \<star> h\<close> TfHgh.\<rho>\<sigma>.tab \<open>tab\<^sub>0 (g \<star> h) \<star> TfHgh.\<rho>\<sigma>.p\<^sub>0\<close> \<open>tab\<^sub>1 f \<star> TfHgh.\<rho>\<sigma>.p\<^sub>1\<close>
                          \<open>f \<star> g \<star> h\<close> HfHgh.tab \<open>tab\<^sub>0 (f \<star> g \<star> h)\<close> \<open>tab\<^sub>1 (f \<star> g \<star> h)\<close>
                          \<open>\<a>[f, g, h]\<close> \<open>f \<star> g \<star> h\<close>
             using fg gh by unfold_locales auto
           interpret C: vertical_composite_of_arrows_of_tabulations_in_maps V H \<a> \<i> src trg
                          \<open>(f \<star> g) \<star> h\<close> THfgh.\<rho>\<sigma>.tab \<open>tab\<^sub>0 h \<star> THfgh.\<rho>\<sigma>.p\<^sub>0\<close> \<open>tab\<^sub>1 (f \<star> g) \<star> THfgh.\<rho>\<sigma>.p\<^sub>1\<close>
                          \<open>(f \<star> g) \<star> h\<close> HHfgh.tab \<open>tab\<^sub>0 ((f \<star> g) \<star> h)\<close> \<open>tab\<^sub>1 ((f \<star> g) \<star> h)\<close>
                          \<open>f \<star> g \<star> h\<close> HfHgh.tab \<open>tab\<^sub>0 (f \<star> g \<star> h)\<close> \<open>tab\<^sub>1 (f \<star> g \<star> h)\<close>
                          \<open>(f \<star> g) \<star> h\<close> \<open>\<a>[f, g, h]\<close>
             using fg gh by unfold_locales auto
           interpret D: vertical_composite_of_arrows_of_tabulations_in_maps V H \<a> \<i> src trg
                          \<open>(f \<star> g) \<star> h\<close> TTfgh.tab \<open>tab\<^sub>0 h \<star> TTfgh.p\<^sub>0\<close> \<open>(tab\<^sub>1 f \<star> Tfg.p\<^sub>1) \<star> TTfgh.p\<^sub>1\<close>
                          \<open>(f \<star> g) \<star> h\<close> THfgh.\<rho>\<sigma>.tab \<open>tab\<^sub>0 h \<star> THfgh.\<rho>\<sigma>.p\<^sub>0\<close> \<open>tab\<^sub>1 (f \<star> g) \<star> THfgh.\<rho>\<sigma>.p\<^sub>1\<close>
                          \<open>f \<star> g \<star> h\<close> HfHgh.tab \<open>tab\<^sub>0 (f \<star> g \<star> h)\<close> \<open>tab\<^sub>1 (f \<star> g \<star> h)\<close>
                          \<open>(f \<star> g) \<star> h\<close> \<open>\<a>[f, g, h]\<close>
             using fg gh by unfold_locales auto
           have "HHfgh_HfHgh.chine \<star> THfgh_HHfgh.chine \<star> TTfgh_THfgh.chine \<cong> D.chine"
           proof -
             have "D.chine \<cong> D.\<pi>.chine \<star> TTfgh_THfgh.chine"
               using D.chine_char by simp
             also have "... \<cong> C.chine \<star> TTfgh_THfgh.chine"
               using fg gh comp_arr_dom isomorphic_reflexive by simp
             also have "... \<cong> (C.\<pi>.chine \<star> THfgh_HHfgh.chine) \<star> TTfgh_THfgh.chine"
               using C.chine_char hcomp_isomorphic_ide by simp
             also have "... \<cong> (HHfgh_HfHgh.chine \<star> THfgh_HHfgh.chine) \<star> TTfgh_THfgh.chine"
             proof -
               have "C.\<pi>.chine = HHfgh_HfHgh.chine"
                 using fg gh comp_arr_dom comp_cod_arr \<alpha>_def by simp
               hence "isomorphic C.\<pi>.chine HHfgh_HfHgh.chine"
                 using isomorphic_reflexive by simp
               thus ?thesis
                 using hcomp_isomorphic_ide by simp
             qed
             also have "... \<cong> HHfgh_HfHgh.chine \<star> THfgh_HHfgh.chine \<star> TTfgh_THfgh.chine"
             proof -
               have "ide HHfgh_HfHgh.chine \<and> ide THfgh_HHfgh.chine \<and> ide TTfgh_THfgh.chine"
                 by simp
               moreover have "src HHfgh_HfHgh.chine = trg THfgh_HHfgh.chine \<and>
                              src THfgh_HHfgh.chine = trg TTfgh_THfgh.chine"
                 using fg gh HHfgh_HfHgh.chine_in_hom THfgh_HHfgh.chine_in_hom 
                       TTfgh_THfgh.chine_in_hom \<alpha>_def
                  by auto
               ultimately show ?thesis
                 using fg gh iso_assoc isomorphic_def
                        assoc_in_hom [of HHfgh_HfHgh.chine THfgh_HHfgh.chine TTfgh_THfgh.chine]
                 by auto
             qed
             finally show ?thesis
               using isomorphic_symmetric by blast
           qed
           also have "... \<cong> B.chine"
           proof -
             have "D.chine = B.chine"
               using fg gh comp_arr_dom comp_cod_arr by simp
             thus ?thesis
               using isomorphic_reflexive by simp
           qed
           also have "... \<cong> TfHgh_HfHgh.chine \<star> TfTgh_TfHgh.chine \<star> TTfgh_TfTgh.chine"
           proof -
             have "B.chine \<cong> TfHgh_HfHgh.chine \<star> B.\<mu>.chine"
               using B.chine_char by simp
             also have "... \<cong> TfHgh_HfHgh.chine \<star> A.chine"
                 using fg gh comp_cod_arr isomorphic_reflexive by simp
             also have "... \<cong> TfHgh_HfHgh.chine \<star> TfTgh_TfHgh.chine \<star> TTfgh_TfTgh.chine"
               using A.chine_char hcomp_ide_isomorphic by simp
             finally show ?thesis by blast
           qed
           finally have "HHfgh_HfHgh.chine \<star> THfgh_HHfgh.chine \<star> TTfgh_THfgh.chine \<cong>
                         TfHgh_HfHgh.chine \<star> TfTgh_TfHgh.chine \<star> TTfgh_TfTgh.chine"
             by blast
           thus ?thesis
             using fg gh Maps.CLS_eqI isomorphic_implies_hpar(1) by blast
         qed
         also have "... = \<lbrakk>\<lbrakk>TfHgh_HfHgh.chine\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>TfTgh_TfHgh.chine\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>TTfgh_TfTgh.chine\<rbrakk>\<rbrakk>"
           using fg gh isomorphic_reflexive TfTgh_TfHgh.is_map TfHgh_HfHgh.is_map TTfgh_TfTgh.is_map
                 left_adjoints_compose
                 Maps.comp_CLS
                   [of TfTgh_TfHgh.chine TTfgh_TfTgh.chine "TfTgh_TfHgh.chine \<star> TTfgh_TfTgh.chine"]
                 Maps.comp_CLS
                   [of TfHgh_HfHgh.chine "TfTgh_TfHgh.chine \<star> TTfgh_TfTgh.chine"
                       "TfHgh_HfHgh.chine \<star> TfTgh_TfHgh.chine \<star> TTfgh_TfTgh.chine"]
           by simp
         also have "... = Chn RHS"
           using Chn_RHS_eq CLS_chine tuple_ABC_eq_ABC'(2) by simp
         finally show ?thesis
           by blast
       qed
     qed
 
   end
 
   subsubsection "SPN is an Equivalence Pseudofunctor"
 
   context bicategory_of_spans
   begin
 
     interpretation Maps: maps_category V H \<a> \<i> src trg ..
     interpretation Span: span_bicategory Maps.comp Maps.PRJ\<^sub>0 Maps.PRJ\<^sub>1 ..
 
     no_notation Fun.comp (infixl "\<circ>" 55)
     notation Span.vcomp (infixr "\<bullet>" 55)
     notation Span.hcomp (infixr "\<circ>" 53)
     notation Maps.comp (infixr "\<odot>" 55)
     notation isomorphic (infix "\<cong>" 50)
 
     interpretation SPN: "functor" V Span.vcomp SPN
       using SPN_is_functor by simp
     interpretation SPN: weak_arrow_of_homs V src trg Span.vcomp Span.src Span.trg SPN
       using SPN_is_weak_arrow_of_homs by simp
     interpretation SPN_SPN: "functor" VV.comp Span.VV.comp SPN.FF
       using SPN.functor_FF by auto
     interpretation HoSPN_SPN: composite_functor VV.comp Span.VV.comp Span.vcomp
                                 SPN.FF \<open>\<lambda>\<mu>\<nu>. Span.hcomp (fst \<mu>\<nu>) (snd \<mu>\<nu>)\<close>
       ..
     interpretation SPNoH: composite_functor VV.comp V Span.vcomp
                             \<open>\<lambda>\<mu>\<nu>. fst \<mu>\<nu> \<star> snd \<mu>\<nu>\<close> SPN
       ..
 
     interpretation \<Phi>: transformation_by_components VV.comp Span.vcomp
                         HoSPN_SPN.map SPNoH.map \<open>\<lambda>rs. CMP (fst rs) (snd rs)\<close>
       using compositor_is_natural_transformation by simp
     interpretation \<Phi>: natural_isomorphism VV.comp Span.vcomp
                         HoSPN_SPN.map SPNoH.map \<Phi>.map
       using compositor_is_natural_isomorphism by simp
 
     abbreviation \<Phi>
     where "\<Phi> \<equiv> \<Phi>.map"
 
     interpretation SPN: pseudofunctor V H \<a> \<i> src trg
                         Span.vcomp Span.hcomp Span.assoc Span.unit Span.src Span.trg SPN \<Phi>
     proof
       show "\<And>f g h. \<lbrakk> ide f; ide g; ide h; src f = trg g; src g = trg h \<rbrakk> \<Longrightarrow>
                     SPN \<a>[f, g, h] \<bullet> \<Phi> (f \<star> g, h) \<bullet> (\<Phi> (f, g) \<circ> SPN h) =
                     \<Phi> (f, g \<star> h) \<bullet> (SPN f \<circ> \<Phi> (g, h)) \<bullet> Span.assoc (SPN f) (SPN g) (SPN h)"
       proof -
         fix f g h
         assume f: "ide f" and g: "ide g" and h: "ide h"
         assume fg: "src f = trg g" and gh: "src g = trg h"
         interpret fgh: three_composable_identities_in_bicategory_of_spans V H \<a> \<i> src trg f g h
           using f g h fg gh
           by (unfold_locales, simp)
         show "fgh.LHS = fgh.RHS"
           using fgh.assoc_coherence by simp
       qed
     qed
 
     lemma SPN_is_pseudofunctor:
     shows "pseudofunctor V H \<a> \<i> src trg
              Span.vcomp Span.hcomp Span.assoc Span.unit Span.src Span.trg SPN \<Phi>"
       ..
 
     interpretation SPN: equivalence_pseudofunctor V H \<a> \<i> src trg
                         Span.vcomp Span.hcomp Span.assoc Span.unit Span.src Span.trg SPN \<Phi>
     proof
       show "\<And>\<mu> \<mu>'. \<lbrakk>par \<mu> \<mu>'; SPN \<mu> = SPN \<mu>'\<rbrakk> \<Longrightarrow> \<mu> = \<mu>'"
       proof -
         fix \<mu> \<mu>'
         assume par: "par \<mu> \<mu>'"
         assume eq: "SPN \<mu> = SPN \<mu>'"
         interpret dom_\<mu>: identity_in_bicategory_of_spans V H \<a> \<i> src trg \<open>dom \<mu>\<close>
           using par apply unfold_locales by auto
         interpret cod_\<mu>: identity_in_bicategory_of_spans V H \<a> \<i> src trg \<open>cod \<mu>\<close>
           using par apply unfold_locales by auto
         interpret \<mu>: arrow_of_tabulations_in_maps V H \<a> \<i> src trg
                        \<open>dom \<mu>\<close> \<open>tab_of_ide (dom \<mu>)\<close> \<open>tab\<^sub>0 (dom \<mu>)\<close> \<open>tab\<^sub>1 (dom \<mu>)\<close>
                        \<open>cod \<mu>\<close> \<open>tab_of_ide (cod \<mu>)\<close> \<open>tab\<^sub>0 (cod \<mu>)\<close> \<open>tab\<^sub>1 (cod \<mu>)\<close>
                        \<mu>
           using par apply unfold_locales by auto
         interpret \<mu>: arrow_in_bicategory_of_spans V H \<a> \<i> src trg \<open>dom \<mu>\<close> \<open>cod \<mu>\<close> \<mu>
           using par apply unfold_locales by auto
         interpret \<mu>': arrow_of_tabulations_in_maps V H \<a> \<i> src trg
                         \<open>dom \<mu>\<close> \<open>tab_of_ide (dom \<mu>)\<close> \<open>tab\<^sub>0 (dom \<mu>)\<close> \<open>tab\<^sub>1 (dom \<mu>)\<close>
                         \<open>cod \<mu>\<close> \<open>tab_of_ide (cod \<mu>)\<close> \<open>tab\<^sub>0 (cod \<mu>)\<close> \<open>tab\<^sub>1 (cod \<mu>)\<close>
                         \<mu>'
           using par apply unfold_locales by auto
         interpret \<mu>': arrow_in_bicategory_of_spans V H \<a> \<i> src trg \<open>dom \<mu>\<close> \<open>cod \<mu>\<close> \<mu>'
           using par apply unfold_locales by auto
         have "\<mu>.chine \<cong> \<mu>'.chine"
           using par eq SPN_def spn_def Maps.CLS_eqI \<mu>.is_ide by auto
         hence "\<mu>.\<Delta> = \<mu>'.\<Delta>"
           using \<mu>.\<Delta>_naturality \<mu>'.\<Delta>_naturality
           by (metis \<mu>.\<Delta>_simps(4) \<mu>'.\<Delta>_simps(4) \<mu>.chine_is_induced_map \<mu>'.chine_is_induced_map
               \<mu>.induced_map_preserved_by_iso)
         thus "\<mu> = \<mu>'"
           using par \<mu>.\<mu>_in_terms_of_\<Delta> \<mu>'.\<mu>_in_terms_of_\<Delta> by metis
       qed
       show "\<And>a'. Span.obj a' \<Longrightarrow> \<exists>a. obj a \<and> Span.equivalent_objects (SPN.map\<^sub>0 a) a'"
       proof -
         fix a'
         assume a': "Span.obj a'"
         let ?a = "Maps.Dom (Chn a')"
         have a: "obj ?a"
           using a' Span.obj_char Span.ide_char Maps.ide_char by blast
         moreover have "Span.equivalent_objects (SPN.map\<^sub>0 ?a) a'"
         proof -
           have "SPN.map\<^sub>0 ?a = a'"
           proof (intro Span.arr_eqI)
             have "Chn (SPN.map\<^sub>0 ?a) = Chn (Span.src (SPN ?a))"
               using a a' by auto
             also have "... = Maps.MkIde (Maps.Dom (Chn a'))"
             proof -
               have "Maps.arr \<lbrakk>\<lbrakk>tab\<^sub>0 (dom (Maps.Dom (Chn a')))\<rbrakk>\<rbrakk>"
               proof -
                 have "is_left_adjoint (tab\<^sub>0 (dom (Maps.Dom (Chn a'))))"
                   using a by auto
                 thus ?thesis
                   using Maps.CLS_in_hom by auto
               qed
               moreover have "arr (Maps.Dom (Chn a'))"
                 using a by auto
               moreover have "Span.arr (SPN (Maps.Dom (Chn a')))"
                 using a a' SPN_in_hom by auto
               ultimately show ?thesis
-                using a a' SPN_def Span.src_def Maps.cod_char by simp
+                using a a' SPN_def Span.src_def Maps.cod_char obj_simps by simp
             qed
             also have "... = Chn a'"
               using a' Maps.MkIde_Dom Span.obj_char Span.ide_char by simp
             finally show "Chn (SPN.map\<^sub>0 ?a) = Chn a'" by simp
             show "Span.par (SPN.map\<^sub>0 (Maps.Dom (Chn a'))) a'"
               using a a' Span.obj_char
               apply (intro conjI)
               using SPN.map\<^sub>0_simps(1) Span.obj_def
                  apply blast
                 apply simp
                apply (metis (no_types, lifting) SPN.map\<^sub>0_def SPN.preserves_arr Span.obj_src
                   \<open>Chn (SPN.map\<^sub>0 (Maps.Dom (Chn a'))) = Chn a'\<close> obj_def)
               by (metis (no_types, lifting) SPN.map\<^sub>0_def SPN.preserves_arr Span.obj_src
                   \<open>Chn (SPN.map\<^sub>0 (Maps.Dom (Chn a'))) = Chn a'\<close> obj_def)
           qed
           thus ?thesis
             using Span.equivalent_objects_reflexive
             by (simp add: a')
         qed
         ultimately show "\<exists>a. obj a \<and> Span.equivalent_objects (SPN.map\<^sub>0 a) a'"
           by auto
       qed
       show "\<And>a b g. \<lbrakk>obj a; obj b; Span.in_hhom g (SPN.map\<^sub>0 a) (SPN.map\<^sub>0 b); Span.ide g\<rbrakk>
                        \<Longrightarrow> \<exists>f. \<guillemotleft>f : a \<rightarrow> b\<guillemotright> \<and> ide f \<and> Span.isomorphic (SPN f) g"
       proof -
         fix a b g
         assume a: "obj a" and b: "obj b"
         and g_in_hhom: "Span.in_hhom g (SPN.map\<^sub>0 a) (SPN.map\<^sub>0 b)"
         and ide_g: "Span.ide g"
         have arr_a: "arr a"
           using a by auto
         have arr_b: "arr b"
          using b by auto
         show "\<exists>f. \<guillemotleft>f : a \<rightarrow> b\<guillemotright> \<and> ide f \<and> Span.isomorphic (SPN f) g"
         proof -
           interpret g: arrow_of_spans Maps.comp g
             using ide_g Span.ide_char by blast
           interpret g: identity_arrow_of_spans Maps.comp g
             using ide_g Span.ide_char
             by unfold_locales auto
           interpret REP_leg0: map_in_bicategory V H \<a> \<i> src trg \<open>Maps.REP g.leg0\<close>
             using Maps.REP_in_Map [of g.leg0]
             by unfold_locales auto
           have 0: "\<guillemotleft>Maps.REP g.leg0 : src (Maps.REP g.apex) \<rightarrow> Maps.Cod g.leg0\<guillemotright>"
             using g.dom.leg_in_hom Maps.REP_in_hhom by force
           have 1: "\<guillemotleft>Maps.REP g.leg1 : src (Maps.REP g.apex) \<rightarrow> Maps.Cod g.leg1\<guillemotright>"
             using g.dom.leg_in_hom Maps.REP_in_hhom by force
           let ?f = "Maps.REP g.leg1 \<star> (Maps.REP g.leg0)\<^sup>*"
           have f_in_hhom: "\<guillemotleft>?f : a \<rightarrow> b\<guillemotright>"
           proof
             show "\<guillemotleft>Maps.REP g.leg1 : src (Maps.REP g.apex) \<rightarrow> b\<guillemotright>"
             proof -
               have "\<guillemotleft>Maps.REP g.leg1 : src (Maps.REP g.apex) \<rightarrow> Maps.Cod g.leg1\<guillemotright>"
                 using 1 by simp
               moreover have "Maps.Cod g.leg1 = b"
               proof -
                 have "src (Maps.REP g.dtrg) = src (Maps.REP (Leg0 (Dom (SPN.map\<^sub>0 b))))"
                   using g_in_hhom Span.trg_def [of g] by auto
                 also have "... = src (Maps.REP (Maps.cod \<lbrakk>\<lbrakk>tab\<^sub>0 b\<rbrakk>\<rbrakk>))"
                   using b arr_b SPN.map\<^sub>0_def Span.src_def SPN_in_hom by auto
                 also have "... = src (Maps.REP \<lbrakk>\<lbrakk>trg (tab\<^sub>0 b)\<rbrakk>\<rbrakk>)"
                   using b Maps.CLS_in_hom [of "tab\<^sub>0 b"] by force
                 also have "... = src (Maps.REP \<lbrakk>\<lbrakk>b\<rbrakk>\<rbrakk>)"
                   using b by fastforce
                 also have "... = b"
-                  using b by auto
+                  using b obj_simps by auto
                 finally show ?thesis by simp
               qed
               ultimately show ?thesis by argo
             qed
             show "\<guillemotleft>(Maps.REP g.leg0)\<^sup>* : a \<rightarrow> src (Maps.REP g.apex)\<guillemotright>"
             proof -
               have "\<guillemotleft>Maps.REP g.leg0 : src (Maps.REP g.apex) \<rightarrow> a\<guillemotright>"
               proof -
                 have "src (Maps.REP g.dsrc) = src (Maps.REP (Leg0 (Dom (SPN.map\<^sub>0 a))))"
                   using g_in_hhom Span.src_def [of g] by auto
                 also have "... = src (Maps.REP (Maps.cod \<lbrakk>\<lbrakk>tab\<^sub>0 a\<rbrakk>\<rbrakk>))"
                   using a arr_a SPN.map\<^sub>0_def Span.src_def SPN_in_hom by auto
                 also have "... = src (Maps.REP \<lbrakk>\<lbrakk>trg (tab\<^sub>0 a)\<rbrakk>\<rbrakk>)"
                   using a Maps.CLS_in_hom [of "tab\<^sub>0 a"] by force
                 also have "... = src (Maps.REP \<lbrakk>\<lbrakk>a\<rbrakk>\<rbrakk>)"
                   using a by fastforce
                 also have "... = a"
-                  using a by auto
+                  using a obj_simps by auto
                 finally show ?thesis by fast
               qed
               thus ?thesis
                 using REP_leg0.antipar REP_leg0.ide_right
                 apply (intro in_hhomI) by auto
             qed
           qed
           moreover have ide_f: "ide ?f"
             using REP_leg0.antipar f_in_hhom by fastforce
           moreover have "Span.isomorphic (SPN ?f) g"
           proof -
             have SPN_f_eq: "SPN ?f = \<lparr>Chn = \<lbrakk>\<lbrakk>spn ?f\<rbrakk>\<rbrakk>,
                                       Dom = \<lparr>Leg0 = \<lbrakk>\<lbrakk>tab\<^sub>0 ?f\<rbrakk>\<rbrakk>, Leg1 = \<lbrakk>\<lbrakk>tab\<^sub>1 ?f\<rbrakk>\<rbrakk>\<rparr>,
                                       Cod = \<lparr>Leg0 = \<lbrakk>\<lbrakk>tab\<^sub>0 ?f\<rbrakk>\<rbrakk>, Leg1 = \<lbrakk>\<lbrakk>tab\<^sub>1 ?f\<rbrakk>\<rbrakk>\<rparr>\<rparr>"
               using calculation(1) SPN_def [of ?f] REP_leg0.antipar by auto
             text \<open>
               We need an invertible arrow of spans from \<open>SPN f\<close> to \<open>g\<close>.
               There exists a tabulation \<open>(REP g.leg0, \<rho>, REP g.leg1)\<close> of \<open>f\<close>.
               There is also a tabulation \<open>(tab\<^sub>0 f, \<rho>', tab\<^sub>1 f) of f\<close>.
               As these are tabulations of the same arrow, they are equivalent.
               This yields an equivalence map which is an arrow of spans from
               \<open>(tab\<^sub>0 f, tab\<^sub>1 f)\<close> to \<open>(REP g.leg0, \<rho>, REP g.leg1)\<close>.
               Its isomorphism class is an invertible arrow of spans in maps
               from \<open>(CLS (tab\<^sub>0 f), CLS (tab\<^sub>1 f))\<close> to \<open>(g.leg0, g.leg1)\<close>.
             \<close>
             interpret f: identity_in_bicategory_of_spans V H \<a> \<i> src trg ?f
               using ide_f apply unfold_locales by auto
             interpret f: arrow_of_tabulations_in_maps V H \<a> \<i> src trg
                            ?f f.tab \<open>tab\<^sub>0 ?f\<close> \<open>tab\<^sub>1 ?f\<close> ?f f.tab \<open>tab\<^sub>0 ?f\<close> \<open>tab\<^sub>1 ?f\<close> ?f
               using f.is_arrow_of_tabulations_in_maps by simp
             interpret g: span_of_maps V H \<a> \<i> src trg \<open>Maps.REP g.leg0\<close> \<open>Maps.REP g.leg1\<close>
               using Span.arr_char
               by (unfold_locales, blast+)
 
             have 2: "src (Maps.REP g.leg0) = src (Maps.REP g.leg1)"
               using 0 1 by fastforce
             hence "\<exists>\<rho>. tabulation (\<cdot>) (\<star>) \<a> \<i> src trg ?f \<rho> (Maps.REP g.leg0) (Maps.REP g.leg1)"
               using BS2' [of "Maps.REP g.leg0" "Maps.REP g.leg1" ?f] isomorphic_reflexive
                     Span.arr_char
               by auto
             hence "tabulation V H \<a> \<i> src trg ?f
                      (REP_leg0.trnr\<^sub>\<eta> (Maps.REP g.leg1) ?f) (Maps.REP g.leg0) (Maps.REP g.leg1)"
               using 2 REP_leg0.canonical_tabulation [of "Maps.REP g.leg1"] by auto
             hence 3: "\<exists>w w' \<phi> \<psi> \<theta> \<nu> \<theta>' \<nu>'.
                         equivalence_in_bicategory (\<cdot>) (\<star>) \<a> \<i> src trg w' w \<psi> \<phi> \<and>
                         \<guillemotleft>w : src (tab\<^sub>0 ?f) \<rightarrow> src (Maps.REP g.leg0)\<guillemotright> \<and>
                         \<guillemotleft>w' : src (Maps.REP g.leg0) \<rightarrow> src (tab\<^sub>0 ?f)\<guillemotright> \<and>
                         \<guillemotleft>\<theta> : Maps.REP g.leg0 \<star> w \<Rightarrow> tab\<^sub>0 ?f\<guillemotright> \<and>
                         \<guillemotleft>\<nu> : tab\<^sub>1 ?f \<Rightarrow> Maps.REP g.leg1 \<star> w\<guillemotright> \<and> iso \<nu> \<and>
                         f.tab = (?f \<star> \<theta>) \<cdot> \<a>[?f, Maps.REP g.leg0, w] \<cdot>
                                   (REP_leg0.trnr\<^sub>\<eta> (Maps.REP g.leg1) ?f \<star> w) \<cdot> \<nu> \<and>
                         \<guillemotleft>\<theta>' : tab\<^sub>0 ?f \<star> w' \<Rightarrow> Maps.REP g.leg0\<guillemotright> \<and>
                         \<guillemotleft>\<nu>' : Maps.REP g.leg1 \<Rightarrow> tab\<^sub>1 ?f \<star> w'\<guillemotright> \<and> iso \<nu>' \<and>
                         REP_leg0.trnr\<^sub>\<eta> (Maps.REP g.leg1) ?f =
                         (?f \<star> \<theta>') \<cdot> \<a>[?f, tab\<^sub>0 ?f, w'] \<cdot> (f.tab \<star> w') \<cdot> \<nu>'"
                           using f.apex_unique_up_to_equivalence
                                   [of "REP_leg0.trnr\<^sub>\<eta> (Maps.REP g.leg1) ?f"
                                       "Maps.REP g.leg0" "Maps.REP g.leg1"]
               by simp
             obtain w w' \<phi> \<psi> \<theta> \<nu> \<theta>' \<nu>'
               where 4: "equivalence_in_bicategory (\<cdot>) (\<star>) \<a> \<i> src trg w' w \<psi> \<phi> \<and>
                         \<guillemotleft>w : src (tab\<^sub>0 ?f) \<rightarrow> src (Maps.REP g.leg0)\<guillemotright> \<and>
                         \<guillemotleft>w' : src (Maps.REP g.leg0) \<rightarrow> src (tab\<^sub>0 ?f)\<guillemotright> \<and>
                         \<guillemotleft>\<theta> : Maps.REP g.leg0 \<star> w \<Rightarrow> tab\<^sub>0 ?f\<guillemotright> \<and>
                         \<guillemotleft>\<nu> : tab\<^sub>1 ?f \<Rightarrow> Maps.REP g.leg1 \<star> w\<guillemotright> \<and> iso \<nu> \<and>
                         f.tab = (?f \<star> \<theta>) \<cdot> \<a>[?f, Maps.REP g.leg0, w] \<cdot>
                                   (REP_leg0.trnr\<^sub>\<eta> (Maps.REP g.leg1) ?f \<star> w) \<cdot> \<nu> \<and>
                         \<guillemotleft>\<theta>' : tab\<^sub>0 ?f \<star> w' \<Rightarrow> Maps.REP g.leg0\<guillemotright> \<and>
                         \<guillemotleft>\<nu>' : Maps.REP g.leg1 \<Rightarrow> tab\<^sub>1 ?f \<star> w'\<guillemotright> \<and> iso \<nu>' \<and>
                         REP_leg0.trnr\<^sub>\<eta> (Maps.REP g.leg1) ?f =
                         (?f \<star> \<theta>') \<cdot> \<a>[?f, tab\<^sub>0 ?f, w'] \<cdot> (f.tab \<star> w') \<cdot> \<nu>'"
               using 3 by meson
             hence w\<theta>\<nu>: "equivalence_map w \<and> \<guillemotleft>w : src (tab\<^sub>0 ?f) \<rightarrow> src (Maps.REP g.leg0)\<guillemotright> \<and>
                         \<guillemotleft>\<theta> : Maps.REP g.leg0 \<star> w \<Rightarrow> tab\<^sub>0 ?f\<guillemotright> \<and>
                         \<guillemotleft>\<nu> : tab\<^sub>1 ?f \<Rightarrow> Maps.REP g.leg1 \<star> w\<guillemotright> \<and> iso \<nu>"
               using equivalence_map_def equivalence_pair_def equivalence_pair_symmetric
               by meson
             let ?W = "\<lparr>Chn = \<lbrakk>\<lbrakk>w\<rbrakk>\<rbrakk>, Dom = Dom (SPN ?f), Cod = Dom g\<rparr>"
             have W_in_hom: "Span.in_hom ?W (SPN ?f) g"
             proof
               have "arrow_of_spans Maps.comp ?W"
               proof
                 interpret Dom_W: span_in_category Maps.comp \<open>Dom ?W\<close>
                 proof (unfold_locales, intro conjI)
                   show "Maps.arr (Leg0 (Dom ?W))"
                     apply (intro Maps.arrI)
                        apply auto
                     by (metis f.base_simps(2) f.satisfies_T0 f.u_in_hom src_hcomp)
                   show "Maps.arr (Leg1 (Dom ?W))"
                     using 1
                     apply (intro Maps.arrI)
                        apply auto
                   proof -
                     let ?f = "tab\<^sub>1 (Maps.REP g.leg1 \<star> (Maps.REP g.leg0)\<^sup>*)"
                     assume 1: "\<guillemotleft>Maps.REP g.leg1 : Maps.Dom g.apex \<rightarrow> Maps.Cod g.leg1\<guillemotright>"
                     have "\<guillemotleft>?f : src (tab\<^sub>0 (Maps.REP g.leg1 \<star> (Maps.REP g.leg0)\<^sup>*))
                                    \<rightarrow> Maps.Cod g.leg1\<guillemotright> \<and>
                           is_left_adjoint ?f \<and> \<lbrakk>tab\<^sub>1 (Maps.REP g.leg1 \<star> (Maps.REP g.leg0)\<^sup>*)\<rbrakk> = \<lbrakk>?f\<rbrakk>"
                       using 1 by simp
                     thus "\<exists>f. \<guillemotleft>f : src (tab\<^sub>0 (Maps.REP g.leg1 \<star> (Maps.REP g.leg0)\<^sup>*))
                                    \<rightarrow> Maps.Cod g.leg1\<guillemotright> \<and>
                               is_left_adjoint f \<and>
                               \<lbrakk>tab\<^sub>1 (Maps.REP g.leg1 \<star> (Maps.REP g.leg0)\<^sup>*)\<rbrakk> = \<lbrakk>f\<rbrakk>"
                       by blast
                   qed
                   show "Maps.dom (Leg0 (Dom ?W)) = Maps.dom (Leg1 (Dom ?W))"
                   proof -
                     have "Maps.dom (Leg0 (Dom ?W)) =
                           Maps.MkIde (src (tab\<^sub>0 (Maps.REP g.leg1 \<star> (Maps.REP g.leg0)\<^sup>*)))"
                       using Maps.dom_char
                       apply simp
                       by (metis (no_types, lifting) Maps.CLS_in_hom Maps.in_homE f.base_simps(2)
                           f.satisfies_T0 f.u_simps(3) hcomp_simps(1))
                     also have "... = Maps.dom (Leg1 (Dom ?W))"
                       using Maps.dom_char Maps.CLS_in_hom f.leg1_is_map f_in_hhom
                       apply simp
                       by (metis (no_types, lifting) Maps.in_homE Maps.REP_simps(3) f.base_simps(2)
                           f.leg1_is_map f.leg1_simps(3) f.leg1_simps(4) g.dom.leg_simps(3)
                           trg_hcomp)
                     finally show ?thesis by blast
                   qed
                 qed
                 show "Maps.span (Leg0 (Dom ?W)) (Leg1 (Dom ?W))"
                   using Dom_W.span_in_category_axioms Dom_W.is_span by blast
                 interpret Cod_W: span_in_category Maps.comp \<open>Cod ?W\<close>
                   apply unfold_locales by fastforce
                 show "Maps.span (Leg0 (Cod ?W)) (Leg1 (Cod ?W))"
                   by fastforce
                 show "Maps.in_hom (Chn ?W) Dom_W.apex Cod_W.apex"
                 proof
                   show 1: "Maps.arr (Chn ?W)"
                     using w\<theta>\<nu> Maps.CLS_in_hom [of w] equivalence_is_adjoint by auto
                   show "Maps.dom (Chn ?W) = Dom_W.apex"
                   proof -
                     have "Maps.dom (Chn ?W) = Maps.MkIde (src w)"
                       using 1 w\<theta>\<nu> Maps.dom_char by simp
                     also have "... = Dom_W.apex"
                     proof -
                       have "src w = src (tab\<^sub>0 ?f)"
                         using w\<theta>\<nu> by blast
                       thus ?thesis
                         using Dom_W.apex_def Maps.arr_char Maps.dom_char
                         apply simp
                         by (metis (no_types, lifting) f.base_simps(2) f.satisfies_T0
                             f.u_in_hom hcomp_simps(1))
                     qed
                     finally show ?thesis by fastforce
                   qed
                   show "Maps.cod (Chn ?W) = Cod_W.apex"
                   proof -
                     have "Maps.cod (Chn ?W) = Maps.MkIde (trg w)"
                       using 1 w\<theta>\<nu> Maps.cod_char by simp
                     also have "... = Cod_W.apex"
                     proof -
                       have "trg w = src (Maps.REP g.leg0)"
                         using w\<theta>\<nu> by blast
                       thus ?thesis
                         using Cod_W.apex_def Maps.arr_char Maps.cod_char
                         apply simp
                         using g.dom.apex_def Maps.dom_char Maps.REP_simps(2) g.dom.is_span
                         by presburger
                     qed
                     finally show ?thesis by fastforce
                   qed
                 qed
                 show "Cod_W.leg0 \<odot> Chn ?W = Dom_W.leg0"
                 proof -
                   have "Cod_W.leg0 \<odot> Chn ?W = g.leg0 \<odot> \<lbrakk>\<lbrakk>w\<rbrakk>\<rbrakk>"
                     by simp
                   also have "... = \<lbrakk>\<lbrakk>Maps.REP g.leg0\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>w\<rbrakk>\<rbrakk>"
                     using g.dom.leg_simps(1) Maps.CLS_REP [of g.leg0]
                     by simp
                   also have "... = \<lbrakk>\<lbrakk>Maps.REP g.leg0 \<star> w\<rbrakk>\<rbrakk>"
                   proof -
                     have "is_left_adjoint (Maps.REP g.leg0)"
                       by fast
                     moreover have "is_left_adjoint w"
                       using w\<theta>\<nu> equivalence_is_adjoint by simp
                     moreover have "Maps.REP g.leg0 \<star> w \<cong> Maps.REP g.leg0 \<star> w"
                       using w\<theta>\<nu> isomorphic_reflexive Maps.REP_in_hhom
                       by (metis (no_types, lifting) REP_leg0.ide_left adjoint_pair_antipar(1)
                           calculation(2) ide_hcomp in_hhomE)
                     ultimately show ?thesis
                       using w\<theta>\<nu> Maps.comp_CLS isomorphic_reflexive equivalence_is_adjoint
                       by blast
                   qed
                   also have "... = \<lbrakk>\<lbrakk>tab\<^sub>0 ?f\<rbrakk>\<rbrakk>"
                   proof -
                     have "iso \<theta>"
                     proof -
                       have "is_left_adjoint (Maps.REP g.leg0 \<star> w)"
                         using w\<theta>\<nu> equivalence_is_adjoint Maps.REP_in_hhom
                         by (simp add: g.leg0_is_map in_hhom_def left_adjoints_compose)
                       moreover have "is_left_adjoint (tab\<^sub>0 ?f)"
                         by simp
                       ultimately show ?thesis
                         using w\<theta>\<nu> BS3 by blast
                     qed
                     thus ?thesis
                       using w\<theta>\<nu> Maps.CLS_eqI equivalence_is_adjoint
                       by (meson isomorphic_def isomorphic_implies_hpar(1))
                   qed
                   finally show ?thesis by fastforce
                 qed
                 show "Cod_W.leg1 \<odot> Chn ?W = Dom_W.leg1"
                 proof -
                   have "Cod_W.leg1 \<odot> Chn ?W = g.leg1 \<odot> \<lbrakk>\<lbrakk>w\<rbrakk>\<rbrakk>"
                     by simp
                   also have "... = \<lbrakk>\<lbrakk>Maps.REP g.leg1\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>w\<rbrakk>\<rbrakk>"
                     using g.dom.leg_simps(3) Maps.CLS_REP by presburger
                   also have "... = \<lbrakk>\<lbrakk>Maps.REP g.leg1 \<star> w\<rbrakk>\<rbrakk>"
                   proof -
                     have "is_left_adjoint (Maps.REP g.leg1)"
                       by fast
                     moreover have "is_left_adjoint w"
                       using w\<theta>\<nu> equivalence_is_adjoint by simp
                     moreover have "Maps.REP g.leg1 \<star> w \<cong> Maps.REP g.leg1 \<star> w"
                       using w\<theta>\<nu> isomorphic_reflexive Maps.REP_in_hhom
                       by (metis (no_types, lifting) "2" calculation(2) g.dom.is_span
                           hcomp_ide_isomorphic Maps.ide_REP in_hhomE
                           right_adjoint_determines_left_up_to_iso)
                     ultimately show ?thesis
                       using w\<theta>\<nu> Maps.comp_CLS isomorphic_reflexive equivalence_is_adjoint
                       by blast
                   qed
                   also have "... = \<lbrakk>\<lbrakk>tab\<^sub>1 ?f\<rbrakk>\<rbrakk>"
                   proof -
                     have "ide (Maps.REP g.leg1 \<star> w)"
                       using 2 w\<theta>\<nu> equivalence_map_is_ide by auto
                     moreover have "Maps.REP g.leg1 \<star> w \<cong>
                                    tab\<^sub>1 (Maps.REP g.leg1 \<star> (Maps.REP g.leg0)\<^sup>*)"
                       using w\<theta>\<nu> equivalence_is_adjoint f.leg1_is_map
                             right_adjoint_determines_left_up_to_iso adjoint_pair_preserved_by_iso
                       by (meson adjoint_pair_antipar(2) ide_in_hom(2) ide_is_iso)
                     ultimately show ?thesis
                       using Maps.CLS_eqI by blast
                   qed
                   finally show ?thesis by fastforce
                 qed
               qed
               thus W: "Span.arr ?W"
                 using Span.arr_char by blast
               interpret Dom_W:
                 span_in_category Maps.comp
                   \<open>\<lparr>Leg0 = Maps.MkArr (src (tab\<^sub>0 (Maps.REP g.leg1 \<star> (Maps.REP g.leg0)\<^sup>*)))
                                       (src (Maps.REP g.leg0)\<^sup>*)
                                       (iso_class (tab\<^sub>0 (Maps.REP g.leg1 \<star> (Maps.REP g.leg0)\<^sup>*))),
                     Leg1 = Maps.MkArr (src (tab\<^sub>0 (Maps.REP g.leg1 \<star> (Maps.REP g.leg0)\<^sup>*)))
                                       (Maps.Cod g.leg1)
                                       (iso_class (tab\<^sub>1 (Maps.REP g.leg1 \<star> (Maps.REP g.leg0)\<^sup>*)))\<rparr>\<close>
                 using W Span.arr_char
                 by (simp add: arrow_of_spans_def)
               interpret Cod_W: span_in_category Maps.comp \<open>Cod ?W\<close>
                 using W Span.arr_char
                 by (simp add: arrow_of_spans_def)
               show "Span.dom ?W = SPN ?f"
               proof -
                 have "Span.dom ?W =
                       \<lparr>Chn = Dom_W.apex,
                        Dom = \<lparr>Leg0 = \<lbrakk>\<lbrakk>tab\<^sub>0 (Maps.REP g.leg1 \<star> (Maps.REP g.leg0)\<^sup>*)\<rbrakk>\<rbrakk>,
                               Leg1 = \<lbrakk>\<lbrakk>tab\<^sub>1 (Maps.REP g.leg1 \<star> (Maps.REP g.leg0)\<^sup>*)\<rbrakk>\<rbrakk>\<rparr>,
                        Cod = \<lparr>Leg0 = \<lbrakk>\<lbrakk>tab\<^sub>0 (Maps.REP g.leg1 \<star> (Maps.REP g.leg0)\<^sup>*)\<rbrakk>\<rbrakk>,
                               Leg1 = \<lbrakk>\<lbrakk>tab\<^sub>1 (Maps.REP g.leg1 \<star> (Maps.REP g.leg0)\<^sup>*)\<rbrakk>\<rbrakk>\<rparr>\<rparr>"
                   using 0 W Span.dom_char by simp
                 also have "... = SPN ?f"
                   using SPN_def Dom_W.apex_def Maps.dom_char Dom_W.is_span iso_class_eqI
                         spn_ide
                   apply simp
                   using ide_f by blast
                 finally show ?thesis by blast
               qed
               show "Span.cod ?W = g"
                 using 0 W Span.cod_char Cod_W.apex_def by simp
             qed
             moreover have "Span.iso ?W"
             proof -
               have "Maps.iso \<lbrakk>\<lbrakk>w\<rbrakk>\<rbrakk>"
               proof -
                 have "Maps.arr \<lbrakk>\<lbrakk>w\<rbrakk>\<rbrakk> \<and> w \<in> Maps.Map \<lbrakk>\<lbrakk>w\<rbrakk>\<rbrakk> \<and> equivalence_map w"
                 proof (intro conjI)
                   show 1: "Maps.arr \<lbrakk>\<lbrakk>w\<rbrakk>\<rbrakk>"
                     using w\<theta>\<nu> Maps.CLS_in_hom equivalence_is_adjoint by blast
                   show "equivalence_map w"
                     using w\<theta>\<nu> by blast
                   show "w \<in> Maps.Map \<lbrakk>\<lbrakk>w\<rbrakk>\<rbrakk>"
                     using 1 w\<theta>\<nu> equivalence_is_adjoint Maps.arr_char
                     by (simp add: equivalence_map_is_ide ide_in_iso_class)
                 qed
                 thus ?thesis
                   using Maps.iso_char' by blast
               qed
               thus ?thesis
                 using w\<theta>\<nu> W_in_hom Span.iso_char by auto
             qed
             ultimately show ?thesis
               using Span.isomorphic_def by blast
           qed
           ultimately show ?thesis by blast
         qed
       qed
       show "\<And>r s \<tau>. \<lbrakk>ide r; ide s; src r = src s; trg r = trg s; Span.in_hom \<tau> (SPN r) (SPN s)\<rbrakk>
                        \<Longrightarrow> \<exists>\<mu>. \<guillemotleft>\<mu> : r \<Rightarrow> s\<guillemotright> \<and> SPN \<mu> = \<tau>"
       proof -
         fix r s \<tau>
         assume r: "ide r" and s: "ide s"
         assume src_eq: "src r = src s" and trg_eq: "trg r = trg s"
         assume \<tau>: "Span.in_hom \<tau> (SPN r) (SPN s)"
         interpret \<tau>: arrow_of_spans Maps.comp \<tau>
           using \<tau> Span.arr_char by auto
         interpret r: identity_in_bicategory_of_spans V H \<a> \<i> src trg r
           using r by unfold_locales auto
         interpret s: identity_in_bicategory_of_spans V H \<a> \<i> src trg s
           using s by unfold_locales auto
         interpret s: arrow_of_tabulations_in_maps V H \<a> \<i> src trg
                        s s.tab \<open>tab\<^sub>0 s\<close> \<open>tab\<^sub>1 s\<close> s s.tab \<open>tab\<^sub>0 s\<close> \<open>tab\<^sub>1 s\<close> s
           using s.is_arrow_of_tabulations_in_maps by simp
         have \<tau>_dom_leg0_eq: "\<tau>.dom.leg0 = \<lbrakk>\<lbrakk>tab\<^sub>0 r\<rbrakk>\<rbrakk>"
           using \<tau> Span.dom_char SPN_def [of r] by auto
         have \<tau>_dom_leg1_eq: "\<tau>.dom.leg1 = \<lbrakk>\<lbrakk>tab\<^sub>1 r\<rbrakk>\<rbrakk>"
           using \<tau> Span.dom_char SPN_def [of r] by auto
         have \<tau>_cod_leg0_eq: "\<tau>.cod.leg0 = \<lbrakk>\<lbrakk>tab\<^sub>0 s\<rbrakk>\<rbrakk>"
           using \<tau> Span.cod_char SPN_def [of s] by auto
         have \<tau>_cod_leg1_eq: "\<tau>.cod.leg1 = \<lbrakk>\<lbrakk>tab\<^sub>1 s\<rbrakk>\<rbrakk>"
           using \<tau> Span.cod_char SPN_def [of s] by auto
 
         have 1: "tab\<^sub>0 s \<star> Maps.REP \<tau>.chine \<cong> tab\<^sub>0 r"
         proof -
           have "tab\<^sub>0 s \<star> Maps.REP \<tau>.chine \<cong> Maps.REP \<tau>.cod.leg0 \<star> Maps.REP \<tau>.chine"
           proof -
             have "Maps.REP \<tau>.cod.leg0 \<cong> tab\<^sub>0 s"
               using \<tau>_cod_leg0_eq Maps.CLS_REP Maps.CLS_eqI Maps.REP_CLS s.satisfies_T0
               by presburger
             thus ?thesis
               using hcomp_isomorphic_ide [of "Maps.REP \<tau>.cod.leg0" "tab\<^sub>0 s" "Maps.REP \<tau>.chine"]
                     isomorphic_symmetric Maps.seq_char
               by fastforce
           qed
           also have "... \<cong> Maps.REP \<tau>.dom.leg0"
           proof -
             have "\<lbrakk>\<lbrakk>Maps.REP \<tau>.cod.leg0\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>Maps.REP \<tau>.chine\<rbrakk>\<rbrakk> = \<lbrakk>\<lbrakk>Maps.REP \<tau>.dom.leg0\<rbrakk>\<rbrakk>"
               using \<tau>.leg0_commutes Maps.CLS_REP \<tau>.chine_simps(1)
                     \<tau>.cod.leg_simps(1) \<tau>.dom.leg_simps(1)
               by presburger
             hence "\<lbrakk>\<lbrakk>Maps.REP \<tau>.cod.leg0 \<star> Maps.REP \<tau>.chine\<rbrakk>\<rbrakk> = \<lbrakk>\<lbrakk>Maps.REP \<tau>.dom.leg0\<rbrakk>\<rbrakk>"
               using Maps.comp_CLS [of "Maps.REP \<tau>.cod.leg0" "Maps.REP \<tau>.chine"
                                       "Maps.REP \<tau>.cod.leg0 \<star> Maps.REP \<tau>.chine"]
                     isomorphic_reflexive
               by (metis (no_types, lifting) Maps.seq_char Maps.REP_in_hhom(2) Maps.REP_simps(2-3)
                   \<tau>.chine_in_hom \<tau>.cod.leg_in_hom(1) \<tau>.dom.leg_simps(1) \<tau>.leg0_commutes
                   ide_hcomp Maps.ide_REP)
             thus ?thesis
               using Maps.CLS_eqI Maps.seq_char Maps.ide_REP
               by (meson calculation isomorphic_implies_ide(2))
           qed
           also have "... \<cong> tab\<^sub>0 r"
             using \<tau>_dom_leg0_eq Maps.CLS_REP Maps.CLS_eqI Maps.REP_CLS r.satisfies_T0
             by presburger
           finally show ?thesis by blast
         qed
         obtain \<theta> where \<theta>: "\<guillemotleft>\<theta> : tab\<^sub>0 s \<star> Maps.REP \<tau>.chine \<Rightarrow> tab\<^sub>0 r\<guillemotright> \<and> iso \<theta>"
           using 1 by blast
         have 2: "tab\<^sub>1 s \<star> Maps.REP \<tau>.chine \<cong> tab\<^sub>1 r"
         proof -
           have "tab\<^sub>1 s \<star> Maps.REP \<tau>.chine \<cong> Maps.REP \<tau>.cod.leg1 \<star> Maps.REP \<tau>.chine"
           proof -
             have "Maps.REP \<tau>.cod.leg1 \<cong> tab\<^sub>1 s"
               using \<tau>_cod_leg1_eq Maps.CLS_REP Maps.CLS_eqI Maps.REP_CLS s.leg1_is_map
               by presburger
             thus ?thesis
               using hcomp_isomorphic_ide [of "Maps.REP \<tau>.cod.leg1" "tab\<^sub>1 s" "Maps.REP \<tau>.chine"]
                     isomorphic_symmetric Maps.seq_char
               by fastforce
           qed
           also have "... \<cong> Maps.REP \<tau>.dom.leg1"
           proof -
             have "\<lbrakk>\<lbrakk>Maps.REP \<tau>.cod.leg1\<rbrakk>\<rbrakk> \<odot> \<lbrakk>\<lbrakk>Maps.REP \<tau>.chine\<rbrakk>\<rbrakk> = \<lbrakk>\<lbrakk>Maps.REP \<tau>.dom.leg1\<rbrakk>\<rbrakk>"
               using \<tau>.leg1_commutes Maps.CLS_REP \<tau>.chine_simps(1)
                     \<tau>.cod.leg_simps(3) \<tau>.dom.leg_simps(3)
               by presburger
             hence "\<lbrakk>\<lbrakk>Maps.REP \<tau>.cod.leg1 \<star> Maps.REP \<tau>.chine\<rbrakk>\<rbrakk> = \<lbrakk>\<lbrakk>Maps.REP \<tau>.dom.leg1\<rbrakk>\<rbrakk>"
               using Maps.comp_CLS [of "Maps.REP \<tau>.cod.leg1" "Maps.REP \<tau>.chine"
                                       "Maps.REP \<tau>.cod.leg1 \<star> Maps.REP \<tau>.chine"]
                     isomorphic_reflexive
               by (metis (no_types, lifting) Maps.seq_char Maps.REP_in_hhom(2)
                   Maps.REP_simps(2) Maps.REP_simps(3) \<tau>.chine_in_hom \<tau>.cod.leg_in_hom(2)
                   \<tau>.dom.leg_simps(3) \<tau>.leg1_commutes ide_hcomp Maps.ide_REP)
             thus ?thesis
               using Maps.CLS_eqI Maps.seq_char Maps.ide_REP
               by (meson calculation isomorphic_implies_ide(2))
           qed
           also have "... \<cong> tab\<^sub>1 r"
             using \<tau>_dom_leg1_eq Maps.CLS_REP Maps.CLS_eqI Maps.REP_CLS r.leg1_is_map
             by presburger
           finally show ?thesis by blast
         qed
         obtain \<nu> where \<nu>: "\<guillemotleft>\<nu> : tab\<^sub>1 r \<Rightarrow> tab\<^sub>1 s \<star> Maps.REP \<tau>.chine\<guillemotright> \<and> iso \<nu>"
           using 2 isomorphic_symmetric by blast
 
         define \<Delta>
           where "\<Delta> \<equiv> (s \<star> \<theta>) \<cdot> \<a>[s, tab\<^sub>0 s, Maps.REP \<tau>.chine] \<cdot> (s.tab \<star> Maps.REP \<tau>.chine) \<cdot> \<nu>"
         have \<Delta>: "\<guillemotleft>\<Delta> : tab\<^sub>1 r \<Rightarrow> s \<star> tab\<^sub>0 r\<guillemotright>"
         proof (unfold \<Delta>_def, intro comp_in_homI)
           show "\<guillemotleft>\<nu> : tab\<^sub>1 r \<Rightarrow> tab\<^sub>1 s \<star> Maps.REP \<tau>.chine\<guillemotright>"
             using \<nu> by simp
           show 3: "\<guillemotleft>s.tab \<star> Maps.REP \<tau>.chine :
                       tab\<^sub>1 s \<star> Maps.REP \<tau>.chine \<Rightarrow> (s \<star> tab\<^sub>0 s) \<star> Maps.REP \<tau>.chine\<guillemotright>"
             apply (intro hcomp_in_vhom)
               apply auto
             using "1" by fastforce
           show "\<guillemotleft>\<a>[s, tab\<^sub>0 s, Maps.REP \<tau>.chine] :
                    (s \<star> tab\<^sub>0 s) \<star> Maps.REP \<tau>.chine \<Rightarrow> s \<star> tab\<^sub>0 s \<star> Maps.REP \<tau>.chine\<guillemotright>"
             using s assoc_in_hom [of s "tab\<^sub>0 s" "Maps.REP \<tau>.chine"]
             by (metis (no_types, lifting) Maps.ide_REP 3 \<tau>.chine_simps(1) hcomp_in_vhomE
                 ideD(2) ideD(3) s.ide_u s.tab_simps(2) s.u_simps(3))
           show "\<guillemotleft>s \<star> \<theta> : s \<star> tab\<^sub>0 s \<star> Maps.REP \<tau>.chine \<Rightarrow> s \<star> tab\<^sub>0 r\<guillemotright>"
             using 1 s \<theta> isomorphic_implies_hpar(4) src_eq by auto
         qed
         define \<mu> where "\<mu> \<equiv> r.T0.trnr\<^sub>\<epsilon> s \<Delta> \<cdot> inv (r.T0.trnr\<^sub>\<epsilon> r r.tab)"
         have \<mu>: "\<guillemotleft>\<mu> : r \<Rightarrow> s\<guillemotright>"
         proof (unfold \<mu>_def, intro comp_in_homI)
           show "\<guillemotleft>inv (r.T0.trnr\<^sub>\<epsilon> r r.tab) : r \<Rightarrow> tab\<^sub>1 r \<star> (tab\<^sub>0 r)\<^sup>*\<guillemotright>"
             using r.yields_isomorphic_representation by fastforce
           show "\<guillemotleft>r.T0.trnr\<^sub>\<epsilon> s \<Delta> : tab\<^sub>1 r \<star> (tab\<^sub>0 r)\<^sup>* \<Rightarrow> s\<guillemotright>"
             using s \<Delta> src_eq r.T0.adjoint_transpose_right(2) [of s "tab\<^sub>1 r"] by auto
         qed
         interpret \<mu>: arrow_in_bicategory_of_spans V H \<a> \<i> src trg r s \<mu>
           using \<mu> by unfold_locales auto
         interpret \<mu>: arrow_of_tabulations_in_maps V H \<a> \<i> src trg
                        r r.tab \<open>tab\<^sub>0 r\<close> \<open>tab\<^sub>1 r\<close> s s.tab \<open>tab\<^sub>0 s\<close> \<open>tab\<^sub>1 s\<close> \<mu>
           using \<mu>.is_arrow_of_tabulations_in_maps by simp
         have \<Delta>_eq: "\<Delta> = \<mu>.\<Delta>"
         proof -
           have "r.T0.trnr\<^sub>\<epsilon> s \<Delta> \<cdot> inv (r.T0.trnr\<^sub>\<epsilon> r r.tab) =
                 r.T0.trnr\<^sub>\<epsilon> s \<mu>.\<Delta> \<cdot> inv (r.T0.trnr\<^sub>\<epsilon> r r.tab)"
             using \<mu> \<mu>_def \<mu>.\<mu>_in_terms_of_\<Delta> by auto
           hence "r.T0.trnr\<^sub>\<epsilon> s \<Delta> = r.T0.trnr\<^sub>\<epsilon> s \<mu>.\<Delta>"
             using r s \<Delta> r.T0.adjoint_transpose_right(2) r.yields_isomorphic_representation
                   iso_inv_iso iso_is_retraction retraction_is_epi epiE
             by (metis \<mu>.in_hom \<mu>_def arrI)
           thus ?thesis
             using \<Delta> \<mu>.\<Delta>_in_hom(2) src_eq r.T0.adjoint_transpose_right(6)
                   bij_betw_imp_inj_on
                     [of "r.T0.trnr\<^sub>\<epsilon> s" "hom (tab\<^sub>1 r) (s \<star> tab\<^sub>0 r)" "hom (tab\<^sub>1 r \<star> (tab\<^sub>0 r)\<^sup>*) s"]
                   inj_on_def [of "r.T0.trnr\<^sub>\<epsilon> s" "hom (tab\<^sub>1 r) (s \<star> tab\<^sub>0 r)"]
             by simp
         qed
         have "\<mu>.is_induced_map (Maps.REP \<tau>.chine)"
           using \<theta> \<nu> \<Delta>_eq \<Delta>_def \<mu>.is_induced_map_iff \<tau>.chine_simps(1) Maps.ide_REP by blast
         hence 3: "Maps.REP \<tau>.chine \<cong> \<mu>.chine"
           using \<mu>.chine_is_induced_map \<mu>.induced_map_unique by simp
         have "SPN \<mu> = \<tau>"
         proof (intro Span.arr_eqI)
           show "Span.par (SPN \<mu>) \<tau>"
             using \<mu> \<tau> SPN_in_hom
             by (metis (no_types, lifting) SPN.preserves_cod SPN.preserves_dom Span.in_homE
                 in_homE)
           show "Chn (SPN \<mu>) = \<tau>.chine"
           proof -
             have "Chn (SPN \<mu>) = \<lbrakk>\<lbrakk>spn \<mu>\<rbrakk>\<rbrakk>"
               using \<mu> SPN_def spn_def by auto
             also have "... = \<lbrakk>\<lbrakk>\<mu>.chine\<rbrakk>\<rbrakk>"
               using \<mu> spn_def by fastforce
             also have "... = \<lbrakk>\<lbrakk>Maps.REP \<tau>.chine\<rbrakk>\<rbrakk>"
               using 3 isomorphic_symmetric Maps.CLS_eqI iso_class_eqI isomorphic_implies_hpar(3)
                     isomorphic_implies_hpar(4)
               by auto
             also have "... = \<tau>.chine"
               using Maps.CLS_REP \<tau>.chine_simps(1) by blast
             finally show ?thesis by blast
           qed
         qed
         thus "\<exists>\<mu>. \<guillemotleft>\<mu> : r \<Rightarrow> s\<guillemotright> \<and> SPN \<mu> = \<tau>"
           using \<mu> by auto
       qed
     qed
 
     theorem SPN_is_equivalence_pseudofunctor:
     shows "equivalence_pseudofunctor V H \<a> \<i> src trg
              Span.vcomp Span.hcomp Span.assoc Span.unit Span.src Span.trg SPN \<Phi>"
       ..
 
     text \<open>
       We have completed the proof of the second half of the main result (CKS Theorem 4):
       \<open>B\<close> is biequivalent (via \<open>SPN\<close>) to \<open>Span(Maps(B))\<close>.
     \<close>
 
     corollary
     shows "equivalent_bicategories V H \<a> \<i> src trg
              Span.vcomp Span.hcomp Span.assoc Span.unit Span.src Span.trg"
       using SPN_is_equivalence_pseudofunctor equivalent_bicategories_def by blast
 
   end
 
 end
diff --git a/thys/Bicategory/InternalAdjunction.thy b/thys/Bicategory/InternalAdjunction.thy
--- a/thys/Bicategory/InternalAdjunction.thy
+++ b/thys/Bicategory/InternalAdjunction.thy
@@ -1,3435 +1,3435 @@
 (*  Title:       InternalAdjunction
     Author:      Eugene W. Stark <stark@cs.stonybrook.edu>, 2019
     Maintainer:  Eugene W. Stark <stark@cs.stonybrook.edu>
 *)
 
 section "Adjunctions in a Bicategory"
 
 theory InternalAdjunction
 imports CanonicalIsos Strictness
 begin
 
   text \<open>
     An \emph{internal adjunction} in a bicategory is a four-tuple \<open>(f, g, \<eta>, \<epsilon>)\<close>,
     where \<open>f\<close> and \<open>g\<close> are antiparallel 1-cells and \<open>\<guillemotleft>\<eta> : src f \<Rightarrow> g \<star> f\<guillemotright>\<close> and
     \<open>\<guillemotleft>\<epsilon> : f \<star> g \<Rightarrow> src g\<guillemotright>\<close> are 2-cells, such that the familiar ``triangle''
     (or ``zig-zag'') identities are satisfied.  We state the triangle identities
     in two equivalent forms, each of which is convenient in certain situations.
   \<close>
 
   locale adjunction_in_bicategory =
     adjunction_data_in_bicategory +
   assumes triangle_left: "(\<epsilon> \<star> f) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f] \<cdot> (f \<star> \<eta>) = \<l>\<^sup>-\<^sup>1[f] \<cdot> \<r>[f]"
   and triangle_right: "(g \<star> \<epsilon>) \<cdot> \<a>[g, f, g] \<cdot> (\<eta> \<star> g) = \<r>\<^sup>-\<^sup>1[g] \<cdot> \<l>[g]"
   begin
 
     lemma triangle_left':
     shows "\<l>[f] \<cdot> (\<epsilon> \<star> f) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f] \<cdot> (f \<star> \<eta>) \<cdot> \<r>\<^sup>-\<^sup>1[f] = f"
       using triangle_left triangle_equiv_form by simp
 
     lemma triangle_right':
     shows "\<r>[g] \<cdot> (g \<star> \<epsilon>) \<cdot> \<a>[g, f, g] \<cdot> (\<eta> \<star> g) \<cdot> \<l>\<^sup>-\<^sup>1[g] = g"
       using triangle_right triangle_equiv_form by simp
 
   end
 
   text \<open>
     Internal adjunctions have a number of properties, which we now develop,
     that generalize those of ordinary adjunctions involving functors and
     natural transformations.
   \<close>
 
   context bicategory
   begin
 
     lemma adjunction_unit_determines_counit:
     assumes "adjunction_in_bicategory (\<cdot>) (\<star>) \<a> \<i> src trg f g \<eta> \<epsilon>"
     and "adjunction_in_bicategory (\<cdot>) (\<star>) \<a> \<i> src trg f g \<eta> \<epsilon>'"
     shows "\<epsilon> = \<epsilon>'"
     proof -
       interpret E: adjunction_in_bicategory V H \<a> \<i> src trg f g \<eta> \<epsilon>
         using assms(1) by auto
       interpret E': adjunction_in_bicategory V H \<a> \<i> src trg f g \<eta> \<epsilon>'
         using assms(2) by auto
       text \<open>
         Note that since we want to prove the the result for an arbitrary bicategory,
         not just in for a strict bicategory, the calculation is a little more involved
         than one might expect from a treatment that suppresses canonical isomorphisms.
       \<close>
       have "\<epsilon> \<cdot> \<r>[f \<star> g] = \<r>[trg f] \<cdot> (\<epsilon> \<star> trg f)"
         using runit_naturality [of \<epsilon>] by simp
       have 1: "\<r>[f \<star> g] = (f \<star> \<r>[g]) \<cdot> \<a>[f, g, src g]"
         using E.antipar runit_hcomp by simp
 
       have "\<epsilon> = \<epsilon> \<cdot> (f \<star> \<r>[g] \<cdot> (g \<star> \<epsilon>') \<cdot> \<a>[g, f, g] \<cdot> (\<eta> \<star> g) \<cdot> \<l>\<^sup>-\<^sup>1[g])"
         using E'.triangle_right' comp_arr_dom by simp
       also have "... = \<epsilon> \<cdot> (f \<star> \<r>[g]) \<cdot> (f \<star> g \<star> \<epsilon>') \<cdot> (f \<star> \<a>[g, f, g]) \<cdot> (f \<star> \<eta> \<star> g) \<cdot> (f \<star> \<l>\<^sup>-\<^sup>1[g])"
         using E.antipar whisker_left by simp
       also have "... = \<epsilon> \<cdot> ((f \<star> \<r>[g]) \<cdot> (f \<star> g \<star> \<epsilon>')) \<cdot> (f \<star> \<a>[g, f, g]) \<cdot> (f \<star> \<eta> \<star> g) \<cdot> (f \<star> \<l>\<^sup>-\<^sup>1[g])"
         using comp_assoc by simp
       also have "... = \<epsilon> \<cdot> \<r>[f \<star> g] \<cdot> (\<a>\<^sup>-\<^sup>1[f, g, src g] \<cdot> (f \<star> g \<star> \<epsilon>')) \<cdot>
                          (f \<star> \<a>[g, f, g]) \<cdot> (f \<star> \<eta> \<star> g) \<cdot> (f \<star> \<l>\<^sup>-\<^sup>1[g])"
       proof -
         have "f \<star> \<r>[g] = \<r>[f \<star> g] \<cdot> \<a>\<^sup>-\<^sup>1[f, g, src g]"
           using E.antipar(1) runit_hcomp(3) by auto
         thus ?thesis
           using comp_assoc by simp
       qed
       also have "... = (\<epsilon> \<cdot> \<r>[f \<star> g]) \<cdot> ((f \<star> g) \<star> \<epsilon>') \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f \<star> g] \<cdot>
                          (f \<star> \<a>[g, f, g]) \<cdot> (f \<star> \<eta> \<star> g) \<cdot> (f \<star> \<l>\<^sup>-\<^sup>1[g])"
           using E.antipar E'.counit_in_hom assoc'_naturality [of f g \<epsilon>'] comp_assoc by simp
       also have "... = \<r>[trg f] \<cdot> ((\<epsilon> \<star> trg f) \<cdot> ((f \<star> g) \<star> \<epsilon>')) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f \<star> g] \<cdot>
                          (f \<star> \<a>[g, f, g]) \<cdot> (f \<star> \<eta> \<star> g) \<cdot> (f \<star> \<l>\<^sup>-\<^sup>1[g])"
         using E.antipar E.counit_in_hom runit_naturality [of \<epsilon>] comp_assoc by simp
       also have "... = (\<l>[src g] \<cdot> (src g \<star> \<epsilon>')) \<cdot> (\<epsilon> \<star> f \<star> g) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f \<star> g] \<cdot>
                          (f \<star> \<a>[g, f, g]) \<cdot> (f \<star> \<eta> \<star> g) \<cdot> (f \<star> \<l>\<^sup>-\<^sup>1[g])"
       proof -
         have "(\<epsilon> \<star> trg f) \<cdot> ((f \<star> g) \<star> \<epsilon>') = (src g \<star> \<epsilon>') \<cdot> (\<epsilon> \<star> f \<star> g)"
           using E.antipar interchange E.counit_in_hom comp_arr_dom comp_cod_arr
           by (metis E'.counit_simps(1-3) E.counit_simps(1-3))
         thus ?thesis
           using E.antipar comp_assoc unitor_coincidence by simp
       qed
       also have "... = \<epsilon>' \<cdot> \<l>[f \<star> g] \<cdot> (\<epsilon> \<star> f \<star> g) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f \<star> g] \<cdot>
                          (f \<star> \<a>[g, f, g]) \<cdot> (f \<star> \<eta> \<star> g) \<cdot> (f \<star> \<l>\<^sup>-\<^sup>1[g])"
       proof -
         have "\<l>[src g] \<cdot> (src g \<star> \<epsilon>') = \<epsilon>' \<cdot> \<l>[f \<star> g]"
           using E.antipar lunit_naturality [of \<epsilon>'] by simp
         thus ?thesis
           using comp_assoc by simp
       qed
       also have "... = \<epsilon>' \<cdot> (\<l>[f] \<star> g) \<cdot> (\<a>\<^sup>-\<^sup>1[trg f, f, g] \<cdot> (\<epsilon> \<star> f \<star> g)) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f \<star> g] \<cdot>
                          (f \<star> \<a>[g, f, g]) \<cdot> (f \<star> \<eta> \<star> g) \<cdot> (f \<star> \<l>\<^sup>-\<^sup>1[g])"
         using E.antipar lunit_hcomp comp_assoc by simp
       also have "... = \<epsilon>' \<cdot> (\<l>[f] \<star> g) \<cdot> ((\<epsilon> \<star> f) \<star> g) \<cdot> (\<a>\<^sup>-\<^sup>1[f \<star> g, f, g] \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f \<star> g] \<cdot>
                          (f \<star> \<a>[g, f, g])) \<cdot> (f \<star> \<eta> \<star> g) \<cdot> (f \<star> \<l>\<^sup>-\<^sup>1[g])"
         using E.antipar assoc'_naturality [of \<epsilon> f g] comp_assoc by simp
       also have "... = \<epsilon>' \<cdot> (\<l>[f] \<star> g) \<cdot> ((\<epsilon> \<star> f) \<star> g) \<cdot> (\<a>\<^sup>-\<^sup>1[f, g, f] \<star> g) \<cdot>
                          (\<a>\<^sup>-\<^sup>1[f, g \<star> f, g] \<cdot> (f \<star> \<eta> \<star> g)) \<cdot> (f \<star> \<l>\<^sup>-\<^sup>1[g])"
       proof -
         have "\<a>\<^sup>-\<^sup>1[f \<star> g, f, g] \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f \<star> g] \<cdot> (f \<star> \<a>[g, f, g]) =
               (\<a>\<^sup>-\<^sup>1[f, g, f] \<star> g) \<cdot> \<a>\<^sup>-\<^sup>1[f, g \<star> f, g]"
           using 1 E.antipar iso_assoc' iso_inv_iso pentagon' comp_assoc
                 invert_side_of_triangle(2)
                   [of "\<a>\<^sup>-\<^sup>1[f \<star> g, f, g] \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f \<star> g]"
                       "(\<a>\<^sup>-\<^sup>1[f, g, f] \<star> g) \<cdot> \<a>\<^sup>-\<^sup>1[f, g \<star> f, g]" "f \<star> \<a>\<^sup>-\<^sup>1[g, f, g]"]
           by simp
         thus ?thesis
           using comp_assoc by simp
       qed
       also have "... = \<epsilon>' \<cdot> (\<l>[f] \<star> g) \<cdot> ((\<epsilon> \<star> f) \<star> g) \<cdot> (\<a>\<^sup>-\<^sup>1[f, g, f] \<star> g) \<cdot>
                          ((f \<star> \<eta>) \<star> g) \<cdot> \<a>\<^sup>-\<^sup>1[f, trg g, g] \<cdot> (f \<star> \<l>\<^sup>-\<^sup>1[g])"
         using E.antipar assoc'_naturality [of f \<eta> g] comp_assoc by simp
       also have "... = \<epsilon>' \<cdot> (\<l>[f] \<star> g) \<cdot> ((\<epsilon> \<star> f) \<star> g) \<cdot> (\<a>\<^sup>-\<^sup>1[f, g, f] \<star> g) \<cdot>
                          ((f \<star> \<eta>) \<star> g) \<cdot> (\<r>\<^sup>-\<^sup>1[f] \<star> g)"
       proof -
         have "\<a>\<^sup>-\<^sup>1[f, trg g, g] \<cdot> (f \<star> \<l>\<^sup>-\<^sup>1[g]) = \<r>\<^sup>-\<^sup>1[f] \<star> g"
         proof -
           have "\<r>\<^sup>-\<^sup>1[f] \<star> g = inv (\<r>[f] \<star> g)"
             using E.antipar by simp
           also have "... = inv ((f \<star> \<l>[g]) \<cdot> \<a>[f, trg g, g])"
             using E.antipar by (simp add: triangle)
           also have "... = \<a>\<^sup>-\<^sup>1[f, trg g, g] \<cdot> (f \<star> \<l>\<^sup>-\<^sup>1[g])"
             using E.antipar inv_comp by simp
           finally show ?thesis by simp
         qed
         thus ?thesis by simp
       qed
       also have "... = \<epsilon>' \<cdot> (\<l>[f] \<cdot> (\<epsilon> \<star> f) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f] \<cdot> (f \<star> \<eta>) \<cdot> \<r>\<^sup>-\<^sup>1[f] \<star> g)"
         using E.antipar whisker_right by simp
       also have "... = \<epsilon>'"
         using E.triangle_left' comp_arr_dom by simp
       finally show ?thesis by simp
     qed
 
   end
 
   subsection "Adjoint Transpose"
 
   context adjunction_in_bicategory
   begin
 
     interpretation E: self_evaluation_map V H \<a> \<i> src trg ..
     notation E.eval ("\<lbrace>_\<rbrace>")
 
     text \<open>
       Just as for an ordinary adjunction between categories, an adjunction in a bicategory
       determines bijections between hom-sets.  There are two versions of this relationship:
       depending on whether the transposition is occurring on the left (\emph{i.e.}~``output'')
       side or the right (\emph{i.e.}~``input'') side.
     \<close>
 
     definition trnl\<^sub>\<eta>
     where "trnl\<^sub>\<eta> v \<mu> \<equiv> (g \<star> \<mu>) \<cdot> \<a>[g, f, v] \<cdot> (\<eta> \<star> v) \<cdot> \<l>\<^sup>-\<^sup>1[v]"
 
     definition trnl\<^sub>\<epsilon>
     where "trnl\<^sub>\<epsilon> u \<nu> \<equiv> \<l>[u] \<cdot> (\<epsilon> \<star> u) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, u] \<cdot> (f \<star> \<nu>)"
 
     lemma adjoint_transpose_left:
     assumes "ide u" and "ide v" and "src f = trg v" and "src g = trg u"
     shows "trnl\<^sub>\<eta> v \<in> hom (f \<star> v) u \<rightarrow> hom v (g \<star> u)"
     and "trnl\<^sub>\<epsilon> u \<in> hom v (g \<star> u) \<rightarrow> hom (f \<star> v) u"
     and "\<guillemotleft>\<mu> : f \<star> v \<Rightarrow> u\<guillemotright> \<Longrightarrow> trnl\<^sub>\<epsilon> u (trnl\<^sub>\<eta> v \<mu>) = \<mu>"
     and "\<guillemotleft>\<nu> : v \<Rightarrow> g \<star> u\<guillemotright> \<Longrightarrow> trnl\<^sub>\<eta> v (trnl\<^sub>\<epsilon> u \<nu>) = \<nu>"
     and "bij_betw (trnl\<^sub>\<eta> v) (hom (f \<star> v) u) (hom v (g \<star> u))"
     and "bij_betw (trnl\<^sub>\<epsilon> u) (hom v (g \<star> u)) (hom (f \<star> v) u)"
     proof -
       show A: "trnl\<^sub>\<eta> v \<in> hom (f \<star> v) u \<rightarrow> hom v (g \<star> u)"
         using assms antipar trnl\<^sub>\<eta>_def by fastforce
       show B: "trnl\<^sub>\<epsilon> u \<in> hom v (g \<star> u) \<rightarrow> hom (f \<star> v) u"
         using assms antipar trnl\<^sub>\<epsilon>_def by fastforce
       show C: "\<And>\<mu>. \<guillemotleft>\<mu> : f \<star> v \<Rightarrow> u\<guillemotright> \<Longrightarrow> trnl\<^sub>\<epsilon> u (trnl\<^sub>\<eta> v \<mu>) = \<mu>"
       proof -
         fix \<mu>
         assume \<mu>: "\<guillemotleft>\<mu> : f \<star> v \<Rightarrow> u\<guillemotright>"
         have "trnl\<^sub>\<epsilon> u (trnl\<^sub>\<eta> v \<mu>) =
               \<l>[u] \<cdot> (\<epsilon> \<star> u) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, u] \<cdot> (f \<star> (g \<star> \<mu>) \<cdot> \<a>[g, f, v] \<cdot> (\<eta> \<star> v) \<cdot> \<l>\<^sup>-\<^sup>1[v])"
           using trnl\<^sub>\<eta>_def trnl\<^sub>\<epsilon>_def by simp
         also have "... = \<l>[u] \<cdot> (\<epsilon> \<star> u) \<cdot> (\<a>\<^sup>-\<^sup>1[f, g, u] \<cdot> (f \<star> g \<star> \<mu>)) \<cdot> (f \<star> \<a>[g, f, v]) \<cdot>
                            (f \<star> \<eta> \<star> v) \<cdot> (f \<star> \<l>\<^sup>-\<^sup>1[v])"
           using assms \<mu> antipar whisker_left comp_assoc by auto
         also have "... = \<l>[u] \<cdot> ((\<epsilon> \<star> u) \<cdot> ((f \<star> g) \<star> \<mu>)) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f \<star> v] \<cdot> (f \<star> \<a>[g, f, v]) \<cdot>
                            (f \<star> \<eta> \<star> v) \<cdot> (f \<star> \<l>\<^sup>-\<^sup>1[v])"
           using assms \<mu> antipar assoc'_naturality [of f g \<mu>] comp_assoc by fastforce
         also have "... = \<l>[u] \<cdot> (trg u \<star> \<mu>) \<cdot>
                            (\<epsilon> \<star> f \<star> v) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f \<star> v] \<cdot> (f \<star> \<a>[g, f, v]) \<cdot>
                              (f \<star> \<eta> \<star> v) \<cdot> (f \<star> \<l>\<^sup>-\<^sup>1[v])"
         proof -
           have "(\<epsilon> \<star> u) \<cdot> ((f \<star> g) \<star> \<mu>) = (trg u \<star> \<mu>) \<cdot> (\<epsilon> \<star> f \<star> v)"
             using assms \<mu> antipar comp_cod_arr comp_arr_dom
                   interchange [of "trg u" \<epsilon> \<mu> "f \<star> v"] interchange [of \<epsilon> "f \<star> g" u \<mu>]
             by auto
           thus ?thesis
             using comp_assoc by simp
         qed
         also have "... = \<l>[u] \<cdot> (trg u \<star> \<mu>) \<cdot> \<a>[trg f, f, v] \<cdot> 
                            ((\<epsilon> \<star> f) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f] \<cdot> (f \<star> \<eta>) \<star> v) \<cdot>
                              \<a>\<^sup>-\<^sup>1[f, trg v, v] \<cdot> (f \<star> \<l>\<^sup>-\<^sup>1[v])"
         proof -
           have 1: "(\<epsilon> \<star> f \<star> v) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f \<star> v] \<cdot> (f \<star> \<a>[g, f, v]) \<cdot> (f \<star> \<eta> \<star> v) =
                    \<a>[trg f, f, v] \<cdot> ((\<epsilon> \<star> f) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f] \<cdot> (f \<star> \<eta>) \<star> v) \<cdot> \<a>\<^sup>-\<^sup>1[f, trg v, v]"
           proof -
             have "(\<epsilon> \<star> f \<star> v) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f \<star> v] \<cdot> (f \<star> \<a>[g, f, v]) \<cdot> (f \<star> \<eta> \<star> v) =
                    (\<epsilon> \<star> f \<star> v) \<cdot>
                      \<a>[f \<star> g, f, v] \<cdot> (\<a>\<^sup>-\<^sup>1[f, g, f] \<star> v) \<cdot> \<a>\<^sup>-\<^sup>1[f, g \<star> f, v] \<cdot>
                        (f \<star> \<eta> \<star> v)"
             proof -
               have "(\<epsilon> \<star> f \<star> v) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f \<star> v] \<cdot> (f \<star> \<a>[g, f, v]) \<cdot> (f \<star> \<eta> \<star> v) =
                     (\<epsilon> \<star> f \<star> v) \<cdot> (\<a>\<^sup>-\<^sup>1[f, g, f \<star> v] \<cdot> (f \<star> \<a>[g, f, v])) \<cdot> (f \<star> \<eta> \<star> v)"
                 using comp_assoc by simp
               also have "... = (\<epsilon> \<star> f \<star> v) \<cdot>
                                  \<a>[f \<star> g, f, v] \<cdot> (\<a>\<^sup>-\<^sup>1[f, g, f] \<star> v) \<cdot> \<a>\<^sup>-\<^sup>1[f, g \<star> f, v] \<cdot>
                                    (f \<star> \<eta> \<star> v)"
               proof -
                 have "\<a>\<^sup>-\<^sup>1[f, g, f \<star> v] \<cdot> (f \<star> \<a>[g, f, v]) =
                        \<a>[f \<star> g, f, v] \<cdot> (\<a>\<^sup>-\<^sup>1[f, g, f] \<star> v) \<cdot> \<a>\<^sup>-\<^sup>1[f, g \<star> f, v]"
                   using assms antipar canI_associator_0 whisker_can_left_0 whisker_can_right_0
                         canI_associator_hcomp(1-3)
                   by simp
                 thus ?thesis
                   using comp_assoc by simp
               qed
               finally show ?thesis by blast
             qed
             also have "... = ((\<epsilon> \<star> f \<star> v) \<cdot> \<a>[f \<star> g, f, v]) \<cdot>
                                (\<a>\<^sup>-\<^sup>1[f, g, f] \<star> v) \<cdot> ((f \<star> \<eta>) \<star> v) \<cdot>
                                  \<a>\<^sup>-\<^sup>1[f, trg v, v]"
               using assms \<mu> antipar assoc'_naturality [of f \<eta> v] comp_assoc by simp
             also have "... = (\<a>[trg f, f, v] \<cdot> ((\<epsilon> \<star> f) \<star> v)) \<cdot> (\<a>\<^sup>-\<^sup>1[f, g, f] \<star> v) \<cdot> ((f \<star> \<eta>) \<star> v) \<cdot>
                                  \<a>\<^sup>-\<^sup>1[f, trg v, v]"
               using assms \<mu> antipar assoc_naturality [of \<epsilon> f v] by simp
             also have "... = \<a>[trg f, f, v] \<cdot>
                                (((\<epsilon> \<star> f) \<star> v) \<cdot> (\<a>\<^sup>-\<^sup>1[f, g, f] \<star> v) \<cdot> ((f \<star> \<eta>) \<star> v)) \<cdot>
                                  \<a>\<^sup>-\<^sup>1[f, trg v, v]"
               using comp_assoc by simp
             also have "... = \<a>[trg f, f, v] \<cdot> ((\<epsilon> \<star> f) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f] \<cdot> (f \<star> \<eta>) \<star> v) \<cdot> \<a>\<^sup>-\<^sup>1[f, trg v, v]"
               using assms \<mu> antipar whisker_right by simp
             finally show ?thesis by simp
           qed
           show ?thesis
             using 1 comp_assoc by metis
         qed
         also have "... = \<l>[u] \<cdot> (trg u \<star> \<mu>) \<cdot>
                            \<a>[trg f, f, v] \<cdot> (\<l>\<^sup>-\<^sup>1[f] \<cdot> \<r>[f] \<star> v) \<cdot> \<a>\<^sup>-\<^sup>1[f, trg v, v] \<cdot> (f \<star> \<l>\<^sup>-\<^sup>1[v])"
           using assms \<mu> antipar triangle_left by simp
         also have "... = \<l>[u] \<cdot> (trg u \<star> \<mu>) \<cdot> can (\<^bold>\<langle>trg u\<^bold>\<rangle>\<^sub>0 \<^bold>\<star> \<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>v\<^bold>\<rangle>) (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>v\<^bold>\<rangle>)"
           using assms \<mu> antipar canI_unitor_0 canI_associator_1
                 canI_associator_1(1-2) [of f v] whisker_can_right_0 whisker_can_left_0
           by simp
         also have "... = \<l>[u] \<cdot> (trg u \<star> \<mu>) \<cdot> \<l>\<^sup>-\<^sup>1[f \<star> v]"
           unfolding can_def using assms antipar comp_arr_dom comp_cod_arr \<ll>_ide_simp
           by simp
         also have "... = (\<l>[u] \<cdot> \<l>\<^sup>-\<^sup>1[u]) \<cdot> \<mu>"
           using assms \<mu> lunit'_naturality [of \<mu>] comp_assoc by auto
         also have "... = \<mu>"
           using assms \<mu> comp_cod_arr iso_lunit comp_arr_inv inv_is_inverse by auto
         finally show "trnl\<^sub>\<epsilon> u (trnl\<^sub>\<eta> v \<mu>) = \<mu>" by simp
       qed
       show D: "\<And>\<nu>. \<guillemotleft>\<nu> : v \<Rightarrow> g \<star> u\<guillemotright> \<Longrightarrow> trnl\<^sub>\<eta> v (trnl\<^sub>\<epsilon> u \<nu>) = \<nu>"
       proof -
         fix \<nu>
         assume \<nu>: "\<guillemotleft>\<nu> : v \<Rightarrow> g \<star> u\<guillemotright>"
         have "trnl\<^sub>\<eta> v (trnl\<^sub>\<epsilon> u \<nu>) =
               (g \<star> \<l>[u] \<cdot> (\<epsilon> \<star> u) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, u] \<cdot> (f \<star> \<nu>)) \<cdot> \<a>[g, f, v] \<cdot> (\<eta> \<star> v) \<cdot> \<l>\<^sup>-\<^sup>1[v]"
           using trnl\<^sub>\<eta>_def trnl\<^sub>\<epsilon>_def by simp
         also have "... = (g \<star> \<l>[u]) \<cdot> (g \<star> \<epsilon> \<star> u) \<cdot> (g \<star> \<a>\<^sup>-\<^sup>1[f, g, u]) \<cdot> (g \<star> f \<star> \<nu>) \<cdot>
                            \<a>[g, f, v] \<cdot> (\<eta> \<star> v) \<cdot> \<l>\<^sup>-\<^sup>1[v]"
           using assms \<nu> antipar interchange [of g "g \<cdot> g \<cdot> g"] comp_assoc by auto
         also have "... = ((g \<star> \<l>[u]) \<cdot> (g \<star> \<epsilon> \<star> u) \<cdot> (g \<star> \<a>\<^sup>-\<^sup>1[f, g, u]) \<cdot>
                            \<a>[g, f, g \<star> u] \<cdot> (\<eta> \<star> g \<star> u)) \<cdot> (trg v \<star> \<nu>) \<cdot> \<l>\<^sup>-\<^sup>1[v]"
         proof -
           have "(g \<star> f \<star> \<nu>) \<cdot> \<a>[g, f, v] \<cdot> (\<eta> \<star> v) \<cdot> \<l>\<^sup>-\<^sup>1[v] =
                 \<a>[g, f, g \<star> u] \<cdot> (\<eta> \<star> g \<star> u) \<cdot> (trg v \<star> \<nu>) \<cdot> \<l>\<^sup>-\<^sup>1[v]"
           proof -
             have "(g \<star> f \<star> \<nu>) \<cdot> \<a>[g, f, v] \<cdot> (\<eta> \<star> v) \<cdot> \<l>\<^sup>-\<^sup>1[v] =
                   \<a>[g, f, g \<star> u] \<cdot> ((g \<star> f) \<star> \<nu>) \<cdot> (\<eta> \<star> v) \<cdot> \<l>\<^sup>-\<^sup>1[v]"
             proof -
               have "(g \<star> f \<star> \<nu>) \<cdot> \<a>[g, f, v] = \<a>[g, f, g \<star> u] \<cdot> ((g \<star> f) \<star> \<nu>)"
                 using assms \<nu> antipar assoc_naturality [of g f \<nu>] by auto
               thus ?thesis
                 using assms comp_assoc by metis
             qed
             also have "... = \<a>[g, f, g \<star> u] \<cdot> (\<eta> \<star> g \<star> u) \<cdot> (trg v \<star> \<nu>) \<cdot> \<l>\<^sup>-\<^sup>1[v]"
             proof -
               have "((g \<star> f) \<star> \<nu>) \<cdot> (\<eta> \<star> v) = (\<eta> \<star> g \<star> u) \<cdot> (trg v \<star> \<nu>)"
                 using assms \<nu> antipar comp_arr_dom comp_cod_arr
                       interchange [of "g \<star> f" \<eta> \<nu> v] interchange [of \<eta> "trg v" "g \<star> u" \<nu>]
                 by auto
               thus ?thesis
                 using comp_assoc by metis
             qed
             finally show ?thesis by blast
           qed
           thus ?thesis using comp_assoc by simp
         qed
         also have "... = \<l>[g \<star> u] \<cdot> (trg v \<star> \<nu>) \<cdot> \<l>\<^sup>-\<^sup>1[v]"
         proof -
           have "(g \<star> \<l>[u]) \<cdot> (g \<star> \<epsilon> \<star> u) \<cdot> (g \<star> \<a>\<^sup>-\<^sup>1[f, g, u]) \<cdot> \<a>[g, f, g \<star> u] \<cdot> (\<eta> \<star> g \<star> u) =
                 \<l>[g \<star> u]"
           proof -
             have "(g \<star> \<l>[u]) \<cdot> (g \<star> \<epsilon> \<star> u) \<cdot> (g \<star> \<a>\<^sup>-\<^sup>1[f, g, u]) \<cdot> \<a>[g, f, g \<star> u] \<cdot> (\<eta> \<star> g \<star> u) =
                   (g \<star> \<l>[u]) \<cdot> \<a>[g, trg u, u] \<cdot>
                      ((g \<star> \<epsilon>) \<cdot> \<a>[g, f, g] \<cdot> (\<eta> \<star> g) \<star> u) \<cdot>
                         \<a>\<^sup>-\<^sup>1[trg v, g, u]"
             proof -
               have "(g \<star> \<l>[u]) \<cdot> (g \<star> \<epsilon> \<star> u) \<cdot> (g \<star> \<a>\<^sup>-\<^sup>1[f, g, u]) \<cdot> \<a>[g, f, g \<star> u] \<cdot> (\<eta> \<star> g \<star> u) =
                     (g \<star> \<l>[u]) \<cdot> (g \<star> \<epsilon> \<star> u) \<cdot> (g \<star> \<a>\<^sup>-\<^sup>1[f, g, u]) \<cdot> \<a>[g, f, g \<star> u] \<cdot>
                        ((\<eta> \<star> g \<star> u) \<cdot> \<a>[trg v, g, u]) \<cdot> \<a>\<^sup>-\<^sup>1[trg v, g, u]"
                 using assms antipar comp_arr_dom comp_assoc comp_assoc_assoc'(1) by simp
               also have "... = (g \<star> \<l>[u]) \<cdot> (g \<star> \<epsilon> \<star> u) \<cdot> (g \<star> \<a>\<^sup>-\<^sup>1[f, g, u]) \<cdot> \<a>[g, f, g \<star> u] \<cdot>
                                  (\<a>[g \<star> f, g, u] \<cdot> ((\<eta> \<star> g) \<star> u)) \<cdot> \<a>\<^sup>-\<^sup>1[trg v, g, u]"
                 using assms antipar assoc_naturality [of \<eta> g u] by simp
               also have "... = (g \<star> \<l>[u]) \<cdot> (g \<star> \<epsilon> \<star> u) \<cdot>
                                  ((g \<star> \<a>\<^sup>-\<^sup>1[f, g, u]) \<cdot> \<a>[g, f, g \<star> u] \<cdot> \<a>[g \<star> f, g, u]) \<cdot>
                                    ((\<eta> \<star> g) \<star> u) \<cdot> \<a>\<^sup>-\<^sup>1[trg v, g, u]"
                 using comp_assoc by simp
               also have "... = (g \<star> \<l>[u]) \<cdot> ((\<a>[g, trg u, u] \<cdot> \<a>\<^sup>-\<^sup>1[g, trg u, u]) \<cdot> (g \<star> \<epsilon> \<star> u)) \<cdot>
                                  ((g \<star> \<a>\<^sup>-\<^sup>1[f, g, u]) \<cdot> \<a>[g, f, g \<star> u] \<cdot> \<a>[g \<star> f, g, u]) \<cdot>
                                    ((\<eta> \<star> g) \<star> u) \<cdot> \<a>\<^sup>-\<^sup>1[trg v, g, u]"
               proof -
                 have "(\<a>[g, trg u, u] \<cdot> \<a>\<^sup>-\<^sup>1[g, trg u, u]) \<cdot> (g \<star> \<epsilon> \<star> u) = g \<star> \<epsilon> \<star> u"
                   using assms antipar comp_cod_arr comp_assoc_assoc'(1) by simp
                 thus ?thesis
                   using comp_assoc by simp
               qed
               also have "... = (g \<star> \<l>[u]) \<cdot> \<a>[g, trg u, u] \<cdot> (\<a>\<^sup>-\<^sup>1[g, trg u, u] \<cdot> (g \<star> \<epsilon> \<star> u)) \<cdot>
                                  (g \<star> \<a>\<^sup>-\<^sup>1[f, g, u]) \<cdot> \<a>[g, f, g \<star> u] \<cdot> \<a>[g \<star> f, g, u] \<cdot>
                                    ((\<eta> \<star> g) \<star> u) \<cdot> \<a>\<^sup>-\<^sup>1[trg v, g, u]"
                 using comp_assoc by simp
               also have "... = (g \<star> \<l>[u]) \<cdot> \<a>[g, trg u, u] \<cdot> (((g \<star> \<epsilon>) \<star> u) \<cdot> (\<a>\<^sup>-\<^sup>1[g, f \<star> g, u] \<cdot>
                                  (g \<star> \<a>\<^sup>-\<^sup>1[f, g, u]) \<cdot> \<a>[g, f, g \<star> u] \<cdot> \<a>[g \<star> f, g, u]) \<cdot>
                                    ((\<eta> \<star> g) \<star> u)) \<cdot> \<a>\<^sup>-\<^sup>1[trg v, g, u]"
                 using assms antipar assoc'_naturality [of g \<epsilon> u] comp_assoc by simp
               also have "... = (g \<star> \<l>[u]) \<cdot> \<a>[g, trg u, u] \<cdot>
                                  ((g \<star> \<epsilon>) \<cdot> \<a>[g, f, g] \<cdot> (\<eta> \<star> g) \<star> u) \<cdot>
                                    \<a>\<^sup>-\<^sup>1[trg v, g, u]"
               proof -
                 have "\<a>\<^sup>-\<^sup>1[g, f \<star> g, u] \<cdot> (g \<star> \<a>\<^sup>-\<^sup>1[f, g, u]) \<cdot> \<a>[g, f, g \<star> u] \<cdot> \<a>[g \<star> f, g, u] =
                       \<a>[g, f, g] \<star> u"
                   using assms antipar canI_associator_0 whisker_can_left_0 whisker_can_right_0
                         canI_associator_hcomp
                   by simp
                 hence "((g \<star> \<epsilon>) \<star> u) \<cdot>
                           (\<a>\<^sup>-\<^sup>1[g, f \<star> g, u] \<cdot> (g \<star> \<a>\<^sup>-\<^sup>1[f, g, u]) \<cdot> \<a>[g, f, g \<star> u] \<cdot> \<a>[g \<star> f, g, u]) \<cdot>
                              ((\<eta> \<star> g) \<star> u) =
                        (g \<star> \<epsilon>) \<cdot> \<a>[g, f, g] \<cdot> (\<eta> \<star> g) \<star> u"
                   using assms antipar whisker_right by simp
                 thus ?thesis by simp
               qed
               finally show ?thesis by blast
             qed
             also have "... = (g \<star> \<l>[u]) \<cdot> \<a>[g, trg u, u] \<cdot> (\<r>\<^sup>-\<^sup>1[g] \<cdot> \<l>[g] \<star> u) \<cdot> \<a>\<^sup>-\<^sup>1[trg g, g, u]"
               using assms antipar triangle_right by simp
             also have "... = can (\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>u\<^bold>\<rangle>) (\<^bold>\<langle>trg g\<^bold>\<rangle>\<^sub>0 \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>u\<^bold>\<rangle>)"
             proof -
               have "(g \<star> \<l>[u]) \<cdot> \<a>[g, trg u, u] \<cdot> (\<r>\<^sup>-\<^sup>1[g] \<cdot> \<l>[g] \<star> u) \<cdot> \<a>\<^sup>-\<^sup>1[trg g, g, u] =
                     ((g \<star> \<l>[u]) \<cdot> \<a>[g, trg u, u] \<cdot> (\<r>\<^sup>-\<^sup>1[g] \<cdot> \<l>[g] \<star> u) \<cdot> \<a>\<^sup>-\<^sup>1[trg g, g, u])"
                 using comp_assoc by simp
               moreover have "... = can (\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>u\<^bold>\<rangle>) (\<^bold>\<langle>trg g\<^bold>\<rangle>\<^sub>0 \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>u\<^bold>\<rangle>)"
                 using assms antipar canI_unitor_0 canI_associator_1 [of g u] inv_can
                   whisker_can_left_0 whisker_can_right_0
                 by simp
               ultimately show ?thesis by simp
             qed
             also have "... = \<l>[g \<star> u]"
               unfolding can_def using assms comp_arr_dom comp_cod_arr \<ll>_ide_simp by simp
             finally show ?thesis by simp
           qed
           thus ?thesis by simp
         qed
         also have "... = (\<l>[g \<star> u] \<cdot> \<l>\<^sup>-\<^sup>1[g \<star> u]) \<cdot> \<nu>"
           using assms \<nu> lunit'_naturality comp_assoc by auto
         also have "... = \<nu>"
           using assms \<nu> comp_cod_arr iso_lunit comp_arr_inv inv_is_inverse by auto
         finally show "trnl\<^sub>\<eta> v (trnl\<^sub>\<epsilon> u \<nu>) = \<nu>" by simp
       qed
       show "bij_betw (trnl\<^sub>\<eta> v) (hom (f \<star> v) u) (hom v (g \<star> u))"
         using A B C D by (intro bij_betwI, auto)
       show "bij_betw (trnl\<^sub>\<epsilon> u) (hom v (g \<star> u)) (hom (f \<star> v) u)"
         using A B C D by (intro bij_betwI, auto)
     qed
 
     lemma trnl\<^sub>\<epsilon>_comp:
     assumes "ide u" and "seq \<mu> \<nu>" and "src f = trg \<mu>"
     shows "trnl\<^sub>\<epsilon> u (\<mu> \<cdot> \<nu>) = trnl\<^sub>\<epsilon> u \<mu> \<cdot> (f \<star> \<nu>)"
       using assms trnl\<^sub>\<epsilon>_def whisker_left [of f \<mu> \<nu>] comp_assoc by auto
 
     definition trnr\<^sub>\<eta>
     where "trnr\<^sub>\<eta> v \<mu> \<equiv> (\<mu> \<star> f) \<cdot> \<a>\<^sup>-\<^sup>1[v, g, f] \<cdot> (v \<star> \<eta>) \<cdot> \<r>\<^sup>-\<^sup>1[v]"
 
     definition trnr\<^sub>\<epsilon>
     where "trnr\<^sub>\<epsilon> u \<nu> \<equiv> \<r>[u] \<cdot> (u \<star> \<epsilon>) \<cdot> \<a>[u, f, g] \<cdot> (\<nu> \<star> g)"
 
     lemma adjoint_transpose_right:
     assumes "ide u" and "ide v" and "src v = trg g" and "src u = trg f"
     shows "trnr\<^sub>\<eta> v \<in> hom (v \<star> g) u \<rightarrow> hom v (u \<star> f)"
     and "trnr\<^sub>\<epsilon> u \<in> hom v (u \<star> f) \<rightarrow> hom (v \<star> g) u"
     and "\<guillemotleft>\<mu> : v \<star> g \<Rightarrow> u\<guillemotright> \<Longrightarrow> trnr\<^sub>\<epsilon> u (trnr\<^sub>\<eta> v \<mu>) = \<mu>"
     and "\<guillemotleft>\<nu> : v \<Rightarrow> u \<star> f\<guillemotright> \<Longrightarrow> trnr\<^sub>\<eta> v (trnr\<^sub>\<epsilon> u \<nu>) = \<nu>"
     and "bij_betw (trnr\<^sub>\<eta> v) (hom (v \<star> g) u) (hom v (u \<star> f))"
     and "bij_betw (trnr\<^sub>\<epsilon> u) (hom v (u \<star> f)) (hom (v \<star> g) u)"
     proof -
       show A: "trnr\<^sub>\<eta> v \<in> hom (v \<star> g) u \<rightarrow> hom v (u \<star> f)"
         using assms antipar trnr\<^sub>\<eta>_def by fastforce
       show B: "trnr\<^sub>\<epsilon> u \<in> hom v (u \<star> f) \<rightarrow> hom (v \<star> g) u"
         using assms antipar trnr\<^sub>\<epsilon>_def by fastforce
       show C: "\<And>\<mu>. \<guillemotleft>\<mu> : v \<star> g \<Rightarrow> u\<guillemotright> \<Longrightarrow> trnr\<^sub>\<epsilon> u (trnr\<^sub>\<eta> v \<mu>) = \<mu>"
       proof -
         fix \<mu>
         assume \<mu>: "\<guillemotleft>\<mu> : v \<star> g \<Rightarrow> u\<guillemotright>"
         have "trnr\<^sub>\<epsilon> u (trnr\<^sub>\<eta> v \<mu>) =
               \<r>[u] \<cdot> (u \<star> \<epsilon>) \<cdot> \<a>[u, f, g] \<cdot> ((\<mu> \<star> f) \<cdot> \<a>\<^sup>-\<^sup>1[v, g, f] \<cdot> (v \<star> \<eta>) \<cdot> \<r>\<^sup>-\<^sup>1[v] \<star> g)"
           unfolding trnr\<^sub>\<epsilon>_def trnr\<^sub>\<eta>_def by simp
         also have "... = \<r>[u] \<cdot> (u \<star> \<epsilon>) \<cdot> (\<a>[u, f, g] \<cdot> ((\<mu> \<star> f) \<star> g)) \<cdot>
                            (\<a>\<^sup>-\<^sup>1[v, g, f] \<star> g) \<cdot> ((v \<star> \<eta>) \<star> g) \<cdot> (\<r>\<^sup>-\<^sup>1[v] \<star> g)"
           using assms \<mu> antipar whisker_right comp_assoc by auto
         also have "... = \<r>[u] \<cdot> (u \<star> \<epsilon>) \<cdot> ((\<mu> \<star> f \<star> g) \<cdot> \<a>[v \<star> g, f, g]) \<cdot>
                            (\<a>\<^sup>-\<^sup>1[v, g, f] \<star> g) \<cdot> ((v \<star> \<eta>) \<star> g) \<cdot> (\<r>\<^sup>-\<^sup>1[v] \<star> g)"
           using assms \<mu> antipar assoc_naturality [of \<mu> f g] by auto
         also have "... = \<r>[u] \<cdot> ((u \<star> \<epsilon>) \<cdot> (\<mu> \<star> f \<star> g)) \<cdot> \<a>[v \<star> g, f, g] \<cdot>
                            (\<a>\<^sup>-\<^sup>1[v, g, f] \<star> g) \<cdot> ((v \<star> \<eta>) \<star> g) \<cdot> (\<r>\<^sup>-\<^sup>1[v] \<star> g)"
           using comp_assoc by auto
         also have "... = \<r>[u] \<cdot> (\<mu> \<star> src u) \<cdot> ((v \<star> g) \<star> \<epsilon>) \<cdot> \<a>[v \<star> g, f, g] \<cdot>
                            (\<a>\<^sup>-\<^sup>1[v, g, f] \<star> g) \<cdot> ((v \<star> \<eta>) \<star> g) \<cdot> (\<r>\<^sup>-\<^sup>1[v] \<star> g)"
         proof -
           have "(u \<star> \<epsilon>) \<cdot> (\<mu> \<star> f \<star> g) = (\<mu> \<star> src u) \<cdot> ((v \<star> g) \<star> \<epsilon>)"
             using assms \<mu> antipar comp_arr_dom comp_cod_arr
                   interchange [of \<mu> "v \<star> g" "src u" \<epsilon>] interchange [of u \<mu> \<epsilon> "f \<star> g"]
             by auto
           thus ?thesis
             using comp_assoc by simp
         qed
         also have "... = \<r>[u] \<cdot> (\<mu> \<star> src u) \<cdot>
                            (((v \<star> g) \<star> \<epsilon>) \<cdot> \<a>[v \<star> g, f, g] \<cdot> (\<a>\<^sup>-\<^sup>1[v, g, f] \<star> g) \<cdot> ((v \<star> \<eta>) \<star> g)) \<cdot>
                              (\<r>\<^sup>-\<^sup>1[v] \<star> g)"
           using comp_assoc by simp
         also have "... = \<r>[u] \<cdot> (\<mu> \<star> src u) \<cdot>
                            (\<a>\<^sup>-\<^sup>1[v, g, src u] \<cdot> (v \<star> (g \<star> \<epsilon>) \<cdot> \<a>[g, f, g] \<cdot> (\<eta> \<star> g)) \<cdot>
                              \<a>[v, src v, g]) \<cdot> (\<r>\<^sup>-\<^sup>1[v] \<star> g)"
         proof -
           have "((v \<star> g) \<star> \<epsilon>) \<cdot> \<a>[v \<star> g, f, g] \<cdot> (\<a>\<^sup>-\<^sup>1[v, g, f] \<star> g) \<cdot> ((v \<star> \<eta>) \<star> g) =
                   \<a>\<^sup>-\<^sup>1[v, g, src u] \<cdot> (v \<star> (g \<star> \<epsilon>) \<cdot> \<a>[g, f, g] \<cdot> (\<eta> \<star> g)) \<cdot> \<a>[v, src v, g]"
           proof -
             have "((v \<star> g) \<star> \<epsilon>) \<cdot> \<a>[v \<star> g, f, g] \<cdot> (\<a>\<^sup>-\<^sup>1[v, g, f] \<star> g) \<cdot> ((v \<star> \<eta>) \<star> g) =
                     ((\<a>\<^sup>-\<^sup>1[v, g, src u] \<cdot> \<a>[v, g, src u]) \<cdot> ((v \<star> g) \<star> \<epsilon>)) \<cdot>
                       \<a>[v \<star> g, f, g] \<cdot> (\<a>\<^sup>-\<^sup>1[v, g, f] \<star> g) \<cdot> ((v \<star> \<eta>) \<star> g)"
             proof -
               have "arr v \<and> dom v = v \<and> cod v = v"
                 using assms(2) ide_char by blast
               moreover have "arr g \<and> dom g = g \<and> cod g = g"
                 using ide_right ide_char by blast
               ultimately show ?thesis
                 by (metis (no_types) antipar(2) assms(3-4) assoc_naturality
                     counit_simps(1,3,5) hcomp_reassoc(1) comp_assoc)
             qed
             also have "... = \<a>\<^sup>-\<^sup>1[v, g, src u] \<cdot> (\<a>[v, g, src u] \<cdot> ((v \<star> g) \<star> \<epsilon>)) \<cdot>
                                \<a>[v \<star> g, f, g] \<cdot> (\<a>\<^sup>-\<^sup>1[v, g, f] \<star> g) \<cdot> ((v \<star> \<eta>) \<star> g)"
               using comp_assoc by simp
             also have "... = \<a>\<^sup>-\<^sup>1[v, g, src u] \<cdot> ((v \<star> g \<star> \<epsilon>) \<cdot> \<a>[v, g, f \<star> g]) \<cdot>
                                \<a>[v \<star> g, f, g] \<cdot> (\<a>\<^sup>-\<^sup>1[v, g, f] \<star> g) \<cdot>
                                  (\<a>\<^sup>-\<^sup>1[v, g \<star> f, g] \<cdot> \<a>[v, g \<star> f, g]) \<cdot> ((v \<star> \<eta>) \<star> g)"
             proof -
               have "\<a>[v, g, src u] \<cdot> ((v \<star> g) \<star> \<epsilon>) = (v \<star> g \<star> \<epsilon>) \<cdot> \<a>[v, g, f \<star> g]"
                 using assms antipar assoc_naturality [of v g \<epsilon>] by simp
               moreover have "(\<a>\<^sup>-\<^sup>1[v, g \<star> f, g] \<cdot> \<a>[v, g \<star> f, g]) \<cdot> ((v \<star> \<eta>) \<star> g) = (v \<star> \<eta>) \<star> g"
                 using assms antipar comp_cod_arr comp_assoc_assoc'(2) by simp
               ultimately show ?thesis by simp
             qed
             also have "... = \<a>\<^sup>-\<^sup>1[v, g, src u] \<cdot> (v \<star> g \<star> \<epsilon>) \<cdot>
                                \<a>[v, g, f \<star> g] \<cdot> \<a>[v \<star> g, f, g] \<cdot> (\<a>\<^sup>-\<^sup>1[v, g, f] \<star> g) \<cdot>
                                  \<a>\<^sup>-\<^sup>1[v, g \<star> f, g] \<cdot> \<a>[v, g \<star> f, g] \<cdot> ((v \<star> \<eta>) \<star> g)"
               using comp_assoc by simp
             also have "... = \<a>\<^sup>-\<^sup>1[v, g, src u] \<cdot> ((v \<star> g \<star> \<epsilon>) \<cdot>
                                (\<a>[v, g, f \<star> g] \<cdot> \<a>[v \<star> g, f, g] \<cdot> (\<a>\<^sup>-\<^sup>1[v, g, f] \<star> g) \<cdot>
                                  \<a>\<^sup>-\<^sup>1[v, g \<star> f, g]) \<cdot> (v \<star> \<eta> \<star> g)) \<cdot> \<a>[v, src v, g]"
               using assms antipar assoc_naturality [of v \<eta> g] comp_assoc by simp
             also have "... = \<a>\<^sup>-\<^sup>1[v, g, src u] \<cdot>
                                ((v \<star> g \<star> \<epsilon>) \<cdot> (v \<star> \<a>[g, f, g]) \<cdot> (v \<star> \<eta> \<star> g)) \<cdot>
                                  \<a>[v, src v, g]"
             proof -
               have "\<a>[v, g, f \<star> g] \<cdot> \<a>[v \<star> g, f, g] \<cdot> (\<a>\<^sup>-\<^sup>1[v, g, f] \<star> g) \<cdot> \<a>\<^sup>-\<^sup>1[v, g \<star> f, g] =
                     v \<star> \<a>[g, f, g]"
                 using assms antipar canI_associator_0 canI_associator_hcomp
                       whisker_can_left_0 whisker_can_right_0
                 by simp
               thus ?thesis
                 using assms antipar whisker_left by simp
             qed
             also have "... = \<a>\<^sup>-\<^sup>1[v, g, src u] \<cdot>
                                (v \<star> (g \<star> \<epsilon>) \<cdot> \<a>[g, f, g] \<cdot> (\<eta> \<star> g)) \<cdot>
                                  \<a>[v, src v, g]"
               using assms antipar whisker_left by simp
             finally show ?thesis by simp
           qed
           thus ?thesis by auto
         qed
         also have "... = \<r>[u] \<cdot> (\<mu> \<star> src u) \<cdot>
                           \<a>\<^sup>-\<^sup>1[v, g, src u] \<cdot> (v \<star> \<r>\<^sup>-\<^sup>1[g] \<cdot> \<l>[g]) \<cdot>
                             \<a>[v, src v, g] \<cdot> (\<r>\<^sup>-\<^sup>1[v] \<star> g)"
               using triangle_right comp_assoc by simp
         also have "... = \<r>[u] \<cdot> (\<mu> \<star> src u) \<cdot> \<r>\<^sup>-\<^sup>1[v \<star> g]"
         proof -
           have "\<a>\<^sup>-\<^sup>1[v, g, src u] \<cdot> (v \<star> \<r>\<^sup>-\<^sup>1[g] \<cdot> \<l>[g]) \<cdot> \<a>[v, src v, g] \<cdot> (\<r>\<^sup>-\<^sup>1[v] \<star> g) = \<r>\<^sup>-\<^sup>1[v \<star> g]"
           proof -
             have "\<a>\<^sup>-\<^sup>1[v, g, src u] \<cdot> (v \<star> \<r>\<^sup>-\<^sup>1[g] \<cdot> \<l>[g]) \<cdot> \<a>[v, src v, g] \<cdot> (\<r>\<^sup>-\<^sup>1[v] \<star> g) =
                   \<a>\<^sup>-\<^sup>1[v, g, trg f] \<cdot> can (\<^bold>\<langle>v\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>src g\<^bold>\<rangle>\<^sub>0) (\<^bold>\<langle>v\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle>)"
               using assms canI_unitor_0 canI_associator_1(2-3) whisker_can_left_0(1)
                 whisker_can_right_0
               by simp
             also have "... = \<a>\<^sup>-\<^sup>1[v, g, src g] \<cdot> can (\<^bold>\<langle>v\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>src g\<^bold>\<rangle>\<^sub>0) (\<^bold>\<langle>v\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle>)"
               using antipar by simp
             (* TODO: There should be an alternate version of whisker_can_left for this. *)
             also have "... = \<a>\<^sup>-\<^sup>1[v, g, src g] \<cdot> (v \<star> can (\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>src g\<^bold>\<rangle>\<^sub>0) \<^bold>\<langle>g\<^bold>\<rangle>)"
               using assms canI_unitor_0(2) whisker_can_left_0 by simp
             also have "... = \<a>\<^sup>-\<^sup>1[v, g, src g] \<cdot> (v \<star> \<r>\<^sup>-\<^sup>1[g])"
               using assms canI_unitor_0(2) by simp
             also have "... = \<r>\<^sup>-\<^sup>1[v \<star> g]"
               using assms runit_hcomp(2) by simp
             finally have "\<a>\<^sup>-\<^sup>1[v, g, src u] \<cdot> (v \<star> \<r>\<^sup>-\<^sup>1[g] \<cdot> \<l>[g]) \<cdot> \<a>[v, src v, g] \<cdot> (\<r>\<^sup>-\<^sup>1[v] \<star> g) =
                           \<r>\<^sup>-\<^sup>1[v \<star> g]"
               by simp
             thus ?thesis by simp
           qed
           thus ?thesis by simp
         qed
         also have "... = (\<r>[u] \<cdot> \<r>\<^sup>-\<^sup>1[u]) \<cdot> \<mu>"
           using assms \<mu> runit'_naturality [of \<mu>] comp_assoc by auto
         also have "... = \<mu>"
           using \<mu> comp_cod_arr iso_runit inv_is_inverse comp_arr_inv by auto
         finally show "trnr\<^sub>\<epsilon> u (trnr\<^sub>\<eta> v \<mu>) = \<mu>" by simp
       qed
       show D: "\<And>\<nu>. \<guillemotleft>\<nu> : v \<Rightarrow> u \<star> f\<guillemotright> \<Longrightarrow> trnr\<^sub>\<eta> v (trnr\<^sub>\<epsilon> u \<nu>) = \<nu>"
       proof -
         fix \<nu>
         assume \<nu>: "\<guillemotleft>\<nu> : v \<Rightarrow> u \<star> f\<guillemotright>"
         have "trnr\<^sub>\<eta> v (trnr\<^sub>\<epsilon> u \<nu>) =
               (\<r>[u] \<cdot> (u \<star> \<epsilon>) \<cdot> \<a>[u, f, g] \<cdot> (\<nu> \<star> g) \<star> f) \<cdot> \<a>\<^sup>-\<^sup>1[v, g, f] \<cdot> (v \<star> \<eta>) \<cdot> \<r>\<^sup>-\<^sup>1[v]"
           unfolding trnr\<^sub>\<eta>_def trnr\<^sub>\<epsilon>_def by simp
         also have "... = (\<r>[u] \<star> f) \<cdot> ((u \<star> \<epsilon>) \<star> f) \<cdot> (\<a>[u, f, g] \<star> f) \<cdot>
                           (((\<nu> \<star> g) \<star> f) \<cdot> \<a>\<^sup>-\<^sup>1[v, g, f]) \<cdot> (v \<star> \<eta>) \<cdot> \<r>\<^sup>-\<^sup>1[v]"
           using assms \<nu> antipar whisker_right comp_assoc by auto
         also have "... = (\<r>[u] \<star> f) \<cdot> ((u \<star> \<epsilon>) \<star> f) \<cdot> (\<a>[u, f, g] \<star> f) \<cdot>
                           (\<a>\<^sup>-\<^sup>1[u \<star> f, g, f] \<cdot> (\<nu> \<star> g \<star> f)) \<cdot> (v \<star> \<eta>) \<cdot> \<r>\<^sup>-\<^sup>1[v]"
           using assms \<nu> antipar assoc'_naturality [of \<nu> g f] by auto
         also have "... = (\<r>[u] \<star> f) \<cdot> ((u \<star> \<epsilon>) \<star> f) \<cdot> (\<a>[u, f, g] \<star> f) \<cdot>
                           \<a>\<^sup>-\<^sup>1[u \<star> f, g, f] \<cdot> ((\<nu> \<star> g \<star> f) \<cdot> (v \<star> \<eta>)) \<cdot> \<r>\<^sup>-\<^sup>1[v]"
           using comp_assoc by simp
         also have "... = (\<r>[u] \<star> f) \<cdot> ((u \<star> \<epsilon>) \<star> f) \<cdot> (\<a>[u, f, g] \<star> f) \<cdot>
                           \<a>\<^sup>-\<^sup>1[u \<star> f, g, f] \<cdot> (((u \<star> f) \<star> \<eta>) \<cdot> (\<nu> \<star> src v)) \<cdot> \<r>\<^sup>-\<^sup>1[v]"
         proof -
           have "(\<nu> \<star> g \<star> f) \<cdot> (v \<star> \<eta>) = ((u \<star> f) \<star> \<eta>) \<cdot> (\<nu> \<star> src v)"
             using assms \<nu> antipar interchange [of "u \<star> f" \<nu> \<eta> "src v"]
                   interchange [of \<nu> v "g \<star> f" \<eta>] comp_arr_dom comp_cod_arr
             by auto
           thus ?thesis by simp
         qed
         also have "... = ((\<r>[u] \<star> f) \<cdot> ((u \<star> \<epsilon>) \<star> f) \<cdot>
                            ((\<a>[u, f, g] \<star> f) \<cdot> \<a>\<^sup>-\<^sup>1[u \<star> f, g, f]) \<cdot>
                              ((u \<star> f) \<star> \<eta>)) \<cdot> (\<nu> \<star> src v) \<cdot> \<r>\<^sup>-\<^sup>1[v]"
           using comp_assoc by simp
         also have "... = ((\<r>[u] \<star> f) \<cdot> ((u \<star> \<epsilon>) \<star> f) \<cdot>
                            (\<a>\<^sup>-\<^sup>1[u, f \<star> g, f] \<cdot> (u \<star> \<a>\<^sup>-\<^sup>1[f, g, f]) \<cdot> \<a>[u, f, g \<star> f]) \<cdot>
                              ((u \<star> f) \<star> \<eta>)) \<cdot> (\<nu> \<star> src v) \<cdot> \<r>\<^sup>-\<^sup>1[v]"
           using assms antipar canI_associator_hcomp canI_associator_0 whisker_can_left_0
                 whisker_can_right_0
           by simp
         also have "... = ((\<r>[u] \<star> f) \<cdot> (((u \<star> \<epsilon>) \<star> f) \<cdot>
                            \<a>\<^sup>-\<^sup>1[u, f \<star> g, f]) \<cdot> (u \<star> \<a>\<^sup>-\<^sup>1[f, g, f]) \<cdot> (\<a>[u, f, g \<star> f]) \<cdot>
                              ((u \<star> f) \<star> \<eta>)) \<cdot> (\<nu> \<star> src v) \<cdot> \<r>\<^sup>-\<^sup>1[v]"
           using comp_assoc by simp
         also have "... = ((\<r>[u] \<star> f) \<cdot> (\<a>\<^sup>-\<^sup>1[u, src u, f] \<cdot> (u \<star> \<epsilon> \<star> f)) \<cdot>
                            (u \<star> \<a>\<^sup>-\<^sup>1[f, g, f]) \<cdot> ((u \<star> f \<star> \<eta>) \<cdot> \<a>[u, f, src f])) \<cdot>
                              (\<nu> \<star> src v) \<cdot> \<r>\<^sup>-\<^sup>1[v]"
           using assms antipar assoc'_naturality [of u \<epsilon> f] assoc_naturality [of u f \<eta>]
           by auto
         also have "... = (\<r>[u] \<star> f) \<cdot> \<a>\<^sup>-\<^sup>1[u, src u, f] \<cdot>
                            ((u \<star> \<epsilon> \<star> f) \<cdot> (u \<star> \<a>\<^sup>-\<^sup>1[f, g, f]) \<cdot> (u \<star> f \<star> \<eta>)) \<cdot> \<a>[u, f, src f] \<cdot>
                              (\<nu> \<star> src v) \<cdot> \<r>\<^sup>-\<^sup>1[v]"
           using comp_assoc by simp
         also have "... = (\<r>[u] \<star> f) \<cdot> \<a>\<^sup>-\<^sup>1[u, src u, f] \<cdot>
                            (u \<star> (\<epsilon> \<star> f) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f] \<cdot> (f \<star> \<eta>)) \<cdot> \<a>[u, f, src f] \<cdot>
                              (\<nu> \<star> src v) \<cdot> \<r>\<^sup>-\<^sup>1[v]"
           using assms antipar whisker_left by auto
         also have "... = ((\<r>[u] \<star> f) \<cdot> (\<a>\<^sup>-\<^sup>1[u, src u, f] \<cdot> (u \<star> \<l>\<^sup>-\<^sup>1[f] \<cdot> \<r>[f]) \<cdot> \<a>[u, f, src f])) \<cdot>
                            (\<nu> \<star> src v) \<cdot> \<r>\<^sup>-\<^sup>1[v]"
           using assms antipar triangle_left comp_assoc by simp
         also have "... = \<r>[u \<star> f] \<cdot> (\<nu> \<star> src v) \<cdot> \<r>\<^sup>-\<^sup>1[v]"
         proof -
           have "(\<r>[u] \<star> f) \<cdot> \<a>\<^sup>-\<^sup>1[u, src u, f] \<cdot> (u \<star> \<l>\<^sup>-\<^sup>1[f] \<cdot> \<r>[f]) \<cdot> \<a>[u, f, src f] =
                 ((u \<star> \<l>[f]) \<cdot> (\<a>[u, src u, f] \<cdot> \<a>\<^sup>-\<^sup>1[u, src u, f])) \<cdot>
                   (u \<star> \<l>\<^sup>-\<^sup>1[f] \<cdot> \<r>[f]) \<cdot> \<a>[u, f, src f]"
             using assms ide_left ide_right antipar triangle comp_assoc by metis
           also have "... = (u \<star> \<r>[f]) \<cdot> \<a>[u, f, src f]"
             using assms antipar canI_associator_1 canI_unitor_0 whisker_can_left_0
                   whisker_can_right_0 canI_associator_1
             by simp
           also have "... = \<r>[u \<star> f]"
             using assms antipar runit_hcomp by simp
           finally show ?thesis by simp
         qed
         also have "... = (\<r>[u \<star> f] \<cdot> \<r>\<^sup>-\<^sup>1[u \<star> f]) \<cdot> \<nu>"
           using assms \<nu> runit'_naturality [of \<nu>] comp_assoc by auto
         also have "... = \<nu>"
           using assms \<nu> comp_cod_arr comp_arr_inv inv_is_inverse iso_runit by auto
         finally show "trnr\<^sub>\<eta> v (trnr\<^sub>\<epsilon> u \<nu>) = \<nu>" by auto
       qed
       show "bij_betw (trnr\<^sub>\<eta> v) (hom (v \<star> g) u) (hom v (u \<star> f))"
         using A B C D by (intro bij_betwI, auto)
       show "bij_betw (trnr\<^sub>\<epsilon> u) (hom v (u \<star> f)) (hom (v \<star> g) u)"
         using A B C D by (intro bij_betwI, auto)
     qed
 
     lemma trnr\<^sub>\<eta>_comp:
     assumes "ide v" and "seq \<mu> \<nu>" and "src \<mu> = trg f"
     shows "trnr\<^sub>\<eta> v (\<mu> \<cdot> \<nu>) = (\<mu> \<star> f) \<cdot> trnr\<^sub>\<eta> v \<nu>"
       using assms trnr\<^sub>\<eta>_def whisker_right comp_assoc by auto
 
   end
 
   text \<open>
     It is useful to have at hand the simpler versions of the preceding results that
     hold in a normal bicategory and in a strict bicategory.
   \<close>
 
   locale adjunction_in_normal_bicategory =
     normal_bicategory +
     adjunction_in_bicategory
   begin
 
     lemma triangle_left:
     shows "(\<epsilon> \<star> f) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f] \<cdot> (f \<star> \<eta>) = f"
       using triangle_left strict_lunit strict_runit by simp
 
     lemma triangle_right:
     shows "(g \<star> \<epsilon>) \<cdot> \<a>[g, f, g] \<cdot> (\<eta> \<star> g) = g"
       using triangle_right strict_lunit strict_runit by simp
 
     lemma trnr\<^sub>\<eta>_eq:
     assumes "ide u" and "ide v"
     and "src v = trg g" and "src u = trg f"
     and "\<mu> \<in> hom (v \<star> g) u"
     shows "trnr\<^sub>\<eta> v \<mu> = (\<mu> \<star> f) \<cdot> \<a>\<^sup>-\<^sup>1[v, g, f] \<cdot> (v \<star> \<eta>)"
       unfolding trnr\<^sub>\<eta>_def
       using assms antipar strict_runit' comp_arr_ide [of "\<r>\<^sup>-\<^sup>1[v]" "v \<star> \<eta>"] hcomp_arr_obj
       by auto
 
     lemma trnr\<^sub>\<epsilon>_eq:
     assumes "ide u" and "ide v"
     and "src v = trg g" and "src u = trg f"
     and "\<nu> \<in> hom v (u \<star> f)"
     shows "trnr\<^sub>\<epsilon> u \<nu> = (u \<star> \<epsilon>) \<cdot> \<a>[u, f, g] \<cdot> (\<nu> \<star> g)"
       unfolding trnr\<^sub>\<epsilon>_def
       using assms antipar strict_runit comp_ide_arr hcomp_arr_obj by auto
 
     lemma trnl\<^sub>\<eta>_eq:
     assumes "ide u" and "ide v"
     and "src f = trg v" and "src g = trg u"
     and "\<mu> \<in> hom (f \<star> v) u"
     shows "trnl\<^sub>\<eta> v \<mu> = (g \<star> \<mu>) \<cdot> \<a>[g, f, v] \<cdot> (\<eta> \<star> v)"
       using assms trnl\<^sub>\<eta>_def antipar strict_lunit comp_arr_dom hcomp_obj_arr by auto
 
     lemma trnl\<^sub>\<epsilon>_eq:
     assumes "ide u" and "ide v"
     and "src f = trg v" and "src g = trg u"
     and "\<nu> \<in> hom v (g \<star> u)"
     shows "trnl\<^sub>\<epsilon> u \<nu> = (\<epsilon> \<star> u) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, u] \<cdot> (f \<star> \<nu>)"
       using assms trnl\<^sub>\<epsilon>_def antipar strict_lunit comp_cod_arr hcomp_obj_arr by auto
 
   end
 
   locale adjunction_in_strict_bicategory =
     strict_bicategory +
     adjunction_in_normal_bicategory
   begin
 
     lemma triangle_left:
     shows "(\<epsilon> \<star> f) \<cdot> (f \<star> \<eta>) = f"
       using ide_left ide_right antipar triangle_left strict_assoc' comp_cod_arr
       by (metis dom_eqI ideD(1) seqE)
 
     lemma triangle_right:
     shows "(g \<star> \<epsilon>) \<cdot> (\<eta> \<star> g) = g"
       using ide_left ide_right antipar triangle_right strict_assoc comp_cod_arr
       by (metis ideD(1) ideD(2) seqE)
 
     lemma trnr\<^sub>\<eta>_eq:
     assumes "ide u" and "ide v"
     and "src v = trg g" and "src u = trg f"
     and "\<mu> \<in> hom (v \<star> g) u"
     shows "trnr\<^sub>\<eta> v \<mu> = (\<mu> \<star> f) \<cdot> (v \<star> \<eta>)"
     proof -
       have "trnr\<^sub>\<eta> v \<mu> = (\<mu> \<star> f) \<cdot> \<a>\<^sup>-\<^sup>1[v, g, f] \<cdot> (v \<star> \<eta>)"
         using assms trnr\<^sub>\<eta>_eq [of u v \<mu>] by simp
       also have "... = (\<mu> \<star> f) \<cdot> (v \<star> \<eta>)"
       proof -
         have "\<a>\<^sup>-\<^sup>1[v, g, f] \<cdot> (v \<star> \<eta>) = (v \<star> \<eta>)"
         proof -
           have "ide \<a>\<^sup>-\<^sup>1[v, g, f]"
             using assms antipar strict_assoc' by simp
           moreover have "seq \<a>\<^sup>-\<^sup>1[v, g, f] (v \<star> \<eta>)"
             using assms antipar by simp
           ultimately show ?thesis
             using comp_ide_arr by simp
         qed
         thus ?thesis by simp
       qed
       finally show ?thesis by simp
     qed
 
     lemma trnr\<^sub>\<epsilon>_eq:
     assumes "ide u" and "ide v"
     and "src v = trg g" and "src u = trg f"
     and "\<nu> \<in> hom v (u \<star> f)"
     shows "trnr\<^sub>\<epsilon> u \<nu> = (u \<star> \<epsilon>) \<cdot> (\<nu> \<star> g)"
     proof -
       have "trnr\<^sub>\<epsilon> u \<nu> = (u \<star> \<epsilon>) \<cdot> \<a>[u, f, g] \<cdot> (\<nu> \<star> g)"
         using assms trnr\<^sub>\<epsilon>_eq [of u v \<nu>] by simp
       also have "... = (u \<star> \<epsilon>) \<cdot> (\<nu> \<star> g)"
       proof -
         have "\<a>[u, f, g] \<cdot> (\<nu> \<star> g) = (\<nu> \<star> g)"
         proof -
           have "ide \<a>[u, f, g]"
             using assms antipar strict_assoc by simp
           moreover have "seq \<a>[u, f, g] (\<nu> \<star> g)"
             using assms antipar by force
           ultimately show ?thesis
             using comp_ide_arr by simp
         qed
         thus ?thesis by simp
       qed
       finally show ?thesis by simp
     qed
 
     lemma trnl\<^sub>\<eta>_eq:
     assumes "ide u" and "ide v"
     and "src f = trg v" and "src g = trg u"
     and "\<mu> \<in> hom (f \<star> v) u"
     shows "trnl\<^sub>\<eta> v \<mu> = (g \<star> \<mu>) \<cdot> (\<eta> \<star> v)"
     proof -
       have "trnl\<^sub>\<eta> v \<mu> = (g \<star> \<mu>) \<cdot> \<a>[g, f, v] \<cdot> (\<eta> \<star> v)"
         using assms trnl\<^sub>\<eta>_eq [of u v \<mu>] by simp
       also have "... = (g \<star> \<mu>) \<cdot> (\<eta> \<star> v)"
       proof -
         have "seq \<a>[g, f, v] (\<eta> \<star> v)"
           using assms antipar unit_in_hom by simp
         thus ?thesis
           using assms antipar trnl\<^sub>\<eta>_eq strict_assoc comp_ide_arr [of "\<a>[g, f, v]" "\<eta> \<star> v"]
           by simp
       qed
       finally show ?thesis by blast
     qed
 
     lemma trnl\<^sub>\<epsilon>_eq:
     assumes "ide u" and "ide v"
     and "src f = trg v" and "src g = trg u"
     and "\<nu> \<in> hom v (g \<star> u)"
     shows "trnl\<^sub>\<epsilon> u \<nu> = (\<epsilon> \<star> u) \<cdot> (f \<star> \<nu>)"
     proof -
       have "trnl\<^sub>\<epsilon> u \<nu> = (\<epsilon> \<star> u) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, u] \<cdot> (f \<star> \<nu>)"
         using assms trnl\<^sub>\<epsilon>_eq [of u v \<nu>] by simp
       also have "... = ((\<epsilon> \<star> u) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, u]) \<cdot> (f \<star> \<nu>)"
         using comp_assoc by simp
       also have "... = (\<epsilon> \<star> u) \<cdot> (f \<star> \<nu>)"
       proof -
         have "seq (\<epsilon> \<star> u) \<a>\<^sup>-\<^sup>1[f, g, u]"
           using assms antipar unit_in_hom by simp
         thus ?thesis
           using assms antipar trnl\<^sub>\<epsilon>_eq strict_assoc' comp_arr_ide ide_left ide_right
           by metis
       qed
       finally show ?thesis by simp
     qed
 
   end
 
   subsection "Preservation Properties for Adjunctions"
 
   text \<open>
     Here we show that adjunctions are preserved under isomorphisms of the
     left and right adjoints.
   \<close>
 
   context bicategory
   begin
 
     interpretation E: self_evaluation_map V H \<a> \<i> src trg ..
     notation E.eval ("\<lbrace>_\<rbrace>")
 
     definition adjoint_pair
     where "adjoint_pair f g \<equiv> \<exists>\<eta> \<epsilon>. adjunction_in_bicategory V H \<a> \<i> src trg f g \<eta> \<epsilon>"
 
     (* These would normally be called "maps", but that name is too heavily used already. *)
     abbreviation is_left_adjoint
     where "is_left_adjoint f \<equiv> \<exists>g. adjoint_pair f g"
 
     abbreviation is_right_adjoint
     where "is_right_adjoint g \<equiv> \<exists>f. adjoint_pair f g"
 
     lemma adjoint_pair_antipar:
     assumes "adjoint_pair f g"
     shows "ide f" and "ide g" and "src f = trg g" and "src g = trg f"
     proof -
       obtain \<eta> \<epsilon> where A: "adjunction_in_bicategory V H \<a> \<i> src trg f g \<eta> \<epsilon>"
         using assms adjoint_pair_def by auto
       interpret A: adjunction_in_bicategory V H \<a> \<i> src trg f g \<eta> \<epsilon>
         using A by auto
       show "ide f" by simp
       show "ide g" by simp
       show "src f = trg g" using A.antipar by simp
       show "src g = trg f" using A.antipar by simp
     qed
 
     lemma left_adjoint_is_ide:
     assumes "is_left_adjoint f"
     shows "ide f"
       using assms adjoint_pair_antipar by auto
 
     lemma right_adjoint_is_ide:
     assumes "is_right_adjoint f"
     shows "ide f"
       using assms adjoint_pair_antipar by auto
 
     lemma adjunction_preserved_by_iso_right:
     assumes "adjunction_in_bicategory V H \<a> \<i> src trg f g \<eta> \<epsilon>"
     and "\<guillemotleft>\<phi> : g \<Rightarrow> g'\<guillemotright>" and "iso \<phi>"
     shows "adjunction_in_bicategory V H \<a> \<i> src trg f g' ((\<phi> \<star> f) \<cdot> \<eta>) (\<epsilon> \<cdot> (f \<star> inv \<phi>))"
     proof
       interpret A: adjunction_in_bicategory V H \<a> \<i> src trg f g \<eta> \<epsilon>
         using assms by auto
       show "ide f" by simp
       show "ide g'"
         using assms(2) isomorphic_def by auto
       show "\<guillemotleft>(\<phi> \<star> f) \<cdot> \<eta> : src f \<Rightarrow> g' \<star> f\<guillemotright>"
         using assms A.antipar by fastforce
       show "\<guillemotleft>\<epsilon> \<cdot> (f \<star> inv \<phi>) : f \<star> g' \<Rightarrow> src g'\<guillemotright>"
       proof
         show "\<guillemotleft>f \<star> inv \<phi> : f \<star> g' \<Rightarrow> f \<star> g\<guillemotright>"
           using assms A.antipar by (intro hcomp_in_vhom, auto)
         show "\<guillemotleft>\<epsilon> : f \<star> g \<Rightarrow> src g'\<guillemotright>"
           using assms A.counit_in_hom A.antipar by auto
       qed
       show "(\<epsilon> \<cdot> (f \<star> inv \<phi>) \<star> f) \<cdot> \<a>\<^sup>-\<^sup>1[f, g', f] \<cdot> (f \<star> (\<phi> \<star> f) \<cdot> \<eta>) = \<l>\<^sup>-\<^sup>1[f] \<cdot> \<r>[f]"
       proof -
         have "(\<epsilon> \<cdot> (f \<star> inv \<phi>) \<star> f) \<cdot> \<a>\<^sup>-\<^sup>1[f, g', f] \<cdot> (f \<star> (\<phi> \<star> f) \<cdot> \<eta>) =
               (\<epsilon> \<star> f) \<cdot> (((f \<star> inv \<phi>) \<star> f) \<cdot> \<a>\<^sup>-\<^sup>1[f, g', f]) \<cdot> (f \<star> \<phi> \<star> f) \<cdot> (f \<star> \<eta>)"
           using assms A.antipar whisker_right whisker_left comp_assoc by auto
         also have "... = (\<epsilon> \<star> f) \<cdot> (\<a>\<^sup>-\<^sup>1[f, g, f] \<cdot> (f \<star> inv \<phi> \<star> f)) \<cdot> (f \<star> \<phi> \<star> f) \<cdot> (f \<star> \<eta>)"
           using assms A.antipar assoc'_naturality [of f "inv \<phi>" f] by auto
         also have "... = (\<epsilon> \<star> f) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f] \<cdot> ((f \<star> inv \<phi> \<star> f) \<cdot> (f \<star> \<phi> \<star> f)) \<cdot> (f \<star> \<eta>)"
           using comp_assoc by simp
         also have "... = (\<epsilon> \<star> f) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f] \<cdot> (f \<star> g \<star> f) \<cdot> (f \<star> \<eta>)"
           using assms A.antipar comp_inv_arr inv_is_inverse whisker_left
                 whisker_right [of f "inv \<phi>" \<phi>]
           by auto
         also have "... = (\<epsilon> \<star> f) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f] \<cdot> (f \<star> \<eta>)"
           using assms A.antipar comp_cod_arr by simp
         also have "... = \<l>\<^sup>-\<^sup>1[f] \<cdot> \<r>[f]"
           using A.triangle_left by simp
         finally show ?thesis by simp
       qed
       show "(g' \<star> \<epsilon> \<cdot> (f \<star> inv \<phi>)) \<cdot> \<a>[g', f, g'] \<cdot> ((\<phi> \<star> f) \<cdot> \<eta> \<star> g') = \<r>\<^sup>-\<^sup>1[g'] \<cdot> \<l>[g']"
       proof -
         have "(g' \<star> \<epsilon> \<cdot> (f \<star> inv \<phi>)) \<cdot> \<a>[g', f, g'] \<cdot> ((\<phi> \<star> f) \<cdot> \<eta> \<star> g') =
               (g' \<star> \<epsilon>) \<cdot> ((g' \<star> f \<star> inv \<phi>) \<cdot> \<a>[g', f, g']) \<cdot> ((\<phi> \<star> f) \<star> g') \<cdot> (\<eta> \<star> g')"
             using assms A.antipar whisker_left whisker_right comp_assoc by auto
         also have "... = (g' \<star> \<epsilon>) \<cdot> (\<a>[g', f, g] \<cdot> ((g' \<star> f) \<star> inv \<phi>)) \<cdot> ((\<phi> \<star> f) \<star> g') \<cdot> (\<eta> \<star> g')"
           using assms A.antipar assoc_naturality [of g' f "inv \<phi>"] by auto
         also have "... = (g' \<star> \<epsilon>) \<cdot> \<a>[g', f, g] \<cdot> (((g' \<star> f) \<star> inv \<phi>) \<cdot> ((\<phi> \<star> f) \<star> g')) \<cdot> (\<eta> \<star> g')"
           using comp_assoc by simp
         also have "... = (g' \<star> \<epsilon>) \<cdot> (\<a>[g', f, g] \<cdot> ((\<phi> \<star> f) \<star> g)) \<cdot> ((g \<star> f) \<star> inv \<phi>) \<cdot> (\<eta> \<star> g')"
         proof -
           have "((g' \<star> f) \<star> inv \<phi>) \<cdot> ((\<phi> \<star> f) \<star> g') = (\<phi> \<star> f) \<star> inv \<phi>"
             using assms A.antipar comp_arr_dom comp_cod_arr
                   interchange [of "g' \<star> f" "\<phi> \<star> f" "inv \<phi>" g']
             by auto
           also have "... = ((\<phi> \<star> f) \<star> g) \<cdot> ((g \<star> f) \<star> inv \<phi>)"
             using assms A.antipar comp_arr_dom comp_cod_arr
                   interchange [of "\<phi> \<star> f" "g \<star> f" g "inv \<phi>"]
             by auto
           finally show ?thesis
             using comp_assoc by simp
         qed
         also have "... = ((g' \<star> \<epsilon>) \<cdot> (\<phi> \<star> f \<star> g)) \<cdot> \<a>[g, f, g] \<cdot> (\<eta> \<star> g) \<cdot> (trg g \<star> inv \<phi>)"
         proof -
           have "\<a>[g', f, g] \<cdot> ((\<phi> \<star> f) \<star> g) = (\<phi> \<star> f \<star> g) \<cdot> \<a>[g, f, g]"
             using assms A.antipar assoc_naturality [of \<phi> f g] by auto
           moreover have "((g \<star> f) \<star> inv \<phi>) \<cdot> (\<eta> \<star> g') = (\<eta> \<star> g) \<cdot> (trg g \<star> inv \<phi>)"
             using assms A.antipar comp_arr_dom comp_cod_arr
                   interchange [of "g \<star> f" \<eta> "inv \<phi>" g'] interchange [of \<eta> "trg g" g "inv \<phi>"]
             by auto
           ultimately show ?thesis
             using comp_assoc by simp
         qed
         also have "... = ((\<phi> \<star> src g) \<cdot> (g \<star> \<epsilon>)) \<cdot> \<a>[g, f, g] \<cdot> (\<eta> \<star> g) \<cdot> (trg g \<star> inv \<phi>)"
           using assms A.antipar comp_arr_dom comp_cod_arr
                 interchange [of g' \<phi> \<epsilon> "f \<star> g"] interchange [of \<phi> g "src g" \<epsilon>]
             by auto
         also have "... = (\<phi> \<star> src g) \<cdot> ((g \<star> \<epsilon>) \<cdot> \<a>[g, f, g] \<cdot> (\<eta> \<star> g)) \<cdot> (trg g \<star> inv \<phi>)"
           using comp_assoc by simp
         also have "... = ((\<phi> \<star> src g) \<cdot> \<r>\<^sup>-\<^sup>1[g]) \<cdot> \<l>[g] \<cdot> (trg g \<star> inv \<phi>)"
           using assms A.antipar A.triangle_right comp_cod_arr comp_assoc
           by simp
         also have "... = (\<r>\<^sup>-\<^sup>1[g'] \<cdot> \<phi>) \<cdot> inv \<phi> \<cdot> \<l>[g']"
           using assms A.antipar runit'_naturality [of \<phi>] lunit_naturality [of "inv \<phi>"]
           by auto
         also have "... = \<r>\<^sup>-\<^sup>1[g'] \<cdot> (\<phi> \<cdot> inv \<phi>) \<cdot> \<l>[g']"
           using comp_assoc by simp
         also have "... = \<r>\<^sup>-\<^sup>1[g'] \<cdot> \<l>[g']"
           using assms comp_cod_arr comp_arr_inv' by auto
         finally show ?thesis by simp
       qed
     qed
 
     lemma adjunction_preserved_by_iso_left:
     assumes "adjunction_in_bicategory V H \<a> \<i> src trg f g \<eta> \<epsilon>"
     and "\<guillemotleft>\<phi> : f \<Rightarrow> f'\<guillemotright>" and "iso \<phi>"
     shows "adjunction_in_bicategory V H \<a> \<i> src trg f' g ((g \<star> \<phi>) \<cdot> \<eta>) (\<epsilon> \<cdot> (inv \<phi> \<star> g))"
     proof
       interpret A: adjunction_in_bicategory V H \<a> \<i> src trg f g \<eta> \<epsilon>
         using assms by auto
       show "ide g" by simp
       show "ide f'"
         using assms(2) isomorphic_def by auto
       show "\<guillemotleft>(g \<star> \<phi>) \<cdot> \<eta> : src f' \<Rightarrow> g \<star> f'\<guillemotright>"
       proof
         show "\<guillemotleft>\<eta> : src f' \<Rightarrow> g \<star> f\<guillemotright>"
           using assms A.unit_in_hom by auto
         show "\<guillemotleft>g \<star> \<phi> : g \<star> f \<Rightarrow> g \<star> f'\<guillemotright>"
           using assms A.antipar by fastforce
       qed
       show "\<guillemotleft>\<epsilon> \<cdot> (inv \<phi> \<star> g) : f' \<star> g \<Rightarrow> src g\<guillemotright>"
       proof
         show "\<guillemotleft>inv \<phi> \<star> g : f' \<star> g \<Rightarrow> f \<star> g\<guillemotright>"
           using assms A.antipar by (intro hcomp_in_vhom, auto)
         show "\<guillemotleft>\<epsilon> : f \<star> g \<Rightarrow> src g\<guillemotright>"
           using assms A.antipar by auto
       qed
       show "(g \<star> \<epsilon> \<cdot> (inv \<phi> \<star> g)) \<cdot> \<a>[g, f', g] \<cdot> ((g \<star> \<phi>) \<cdot> \<eta> \<star> g) = \<r>\<^sup>-\<^sup>1[g] \<cdot> \<l>[g]"
       proof -
         have "(g \<star> \<epsilon> \<cdot> (inv \<phi> \<star> g)) \<cdot> \<a>[g, f', g] \<cdot> ((g \<star> \<phi>) \<cdot> \<eta> \<star> g) =
               (g \<star> \<epsilon>) \<cdot> ((g \<star> inv \<phi> \<star> g) \<cdot> \<a>[g, f', g]) \<cdot> ((g \<star> \<phi>) \<star> g) \<cdot> (\<eta> \<star> g)"
           using assms A.antipar whisker_left whisker_right comp_assoc by auto
         also have "... = (g \<star> \<epsilon>) \<cdot> (\<a>[g, f, g] \<cdot> ((g \<star> inv \<phi>) \<star> g)) \<cdot> ((g \<star> \<phi>) \<star> g) \<cdot> (\<eta> \<star> g)"
           using assms A.antipar assoc_naturality [of g "inv \<phi>" g] by auto
         also have "... = (g \<star> \<epsilon>) \<cdot> \<a>[g, f, g] \<cdot> (((g \<star> inv \<phi>) \<star> g) \<cdot> ((g \<star> \<phi>) \<star> g)) \<cdot> (\<eta> \<star> g)"
           using comp_assoc by simp
         also have "... = (g \<star> \<epsilon>) \<cdot> \<a>[g, f, g] \<cdot> ((g \<star> f) \<star> g) \<cdot> (\<eta> \<star> g)"
           using assms A.antipar comp_inv_arr inv_is_inverse whisker_right
                 whisker_left [of g "inv \<phi>" \<phi>]
           by auto
         also have "... = (g \<star> \<epsilon>) \<cdot> \<a>[g, f, g] \<cdot> (\<eta> \<star> g)"
           using assms A.antipar comp_cod_arr by simp
         also have "... = \<r>\<^sup>-\<^sup>1[g] \<cdot> \<l>[g]"
           using A.triangle_right by simp
         finally show ?thesis by simp
       qed
       show "(\<epsilon> \<cdot> (inv \<phi> \<star> g) \<star> f') \<cdot> \<a>\<^sup>-\<^sup>1[f', g, f'] \<cdot> (f' \<star> (g \<star> \<phi>) \<cdot> \<eta>) = \<l>\<^sup>-\<^sup>1[f'] \<cdot> \<r>[f']"
       proof -
         have "(\<epsilon> \<cdot> (inv \<phi> \<star> g) \<star> f') \<cdot> \<a>\<^sup>-\<^sup>1[f', g, f'] \<cdot> (f' \<star> (g \<star> \<phi>) \<cdot> \<eta>) =
               (\<epsilon> \<star> f') \<cdot> (((inv \<phi> \<star> g) \<star> f') \<cdot> \<a>\<^sup>-\<^sup>1[f', g, f']) \<cdot> (f' \<star> g \<star> \<phi>) \<cdot> (f' \<star> \<eta>)"
           using assms A.antipar whisker_right whisker_left comp_assoc
           by auto
         also have "... = (\<epsilon> \<star> f') \<cdot> (\<a>\<^sup>-\<^sup>1[f, g, f'] \<cdot> (inv \<phi> \<star> g \<star> f')) \<cdot> (f' \<star> g \<star> \<phi>) \<cdot> (f' \<star> \<eta>)"
           using assms A.antipar assoc'_naturality [of "inv \<phi>" g f'] by auto
         also have "... = (\<epsilon> \<star> f') \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f'] \<cdot> ((inv \<phi> \<star> g \<star> f') \<cdot> (f' \<star> g \<star> \<phi>)) \<cdot> (f' \<star> \<eta>)"
           using comp_assoc by simp
         also have "... = (\<epsilon> \<star> f') \<cdot> (\<a>\<^sup>-\<^sup>1[f, g, f'] \<cdot> (f \<star> g \<star> \<phi>)) \<cdot> (inv \<phi> \<star> g \<star> f) \<cdot> (f' \<star> \<eta>)"
         proof -
           have "(inv \<phi> \<star> g \<star> f') \<cdot> (f' \<star> g \<star> \<phi>) = (f \<star> g \<star> \<phi>) \<cdot> (inv \<phi> \<star> g \<star> f)"
             using assms(2-3) A.antipar comp_arr_dom comp_cod_arr
                   interchange [of "inv \<phi>" f' "g \<star> f'" "g \<star> \<phi>"]
                   interchange [of f "inv \<phi>" "g \<star> \<phi>" "g \<star> f"]
             by auto
           thus ?thesis
             using comp_assoc by simp
         qed
         also have "... = ((\<epsilon> \<star> f') \<cdot> ((f \<star> g) \<star> \<phi>)) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f] \<cdot> (f \<star> \<eta>) \<cdot> (inv \<phi> \<star> src f)"
         proof -
           have "\<a>\<^sup>-\<^sup>1[f, g, f'] \<cdot> (f \<star> g \<star> \<phi>) = ((f \<star> g) \<star> \<phi>) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f]"
             using assms A.antipar assoc'_naturality [of f g \<phi>] by auto
           moreover have "(inv \<phi> \<star> g \<star> f) \<cdot> (f' \<star> \<eta>) = (f \<star> \<eta>) \<cdot> (inv \<phi> \<star> src f)"
             using assms A.antipar comp_arr_dom comp_cod_arr
                   interchange [of "inv \<phi>" f' "g \<star> f" \<eta>] interchange [of f "inv \<phi>" \<eta> "src f"]
             by auto
           ultimately show ?thesis
             using comp_assoc by simp
         qed
         also have "... = ((trg f \<star> \<phi>) \<cdot> (\<epsilon> \<star> f)) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f] \<cdot> (f \<star> \<eta>) \<cdot> (inv \<phi> \<star> src f)"
           using assms A.antipar comp_arr_dom comp_cod_arr
                 interchange [of \<epsilon> "f \<star> g" f' \<phi>] interchange [of "trg f" \<epsilon> \<phi> f]
           by (metis A.counit_simps(1) A.counit_simps(2) A.counit_simps(3) in_homE)
         also have "... = (trg f \<star> \<phi>) \<cdot> ((\<epsilon> \<star> f) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f] \<cdot> (f \<star> \<eta>)) \<cdot> (inv \<phi> \<star> src f)"
           using comp_assoc by simp
         also have "... = ((trg f \<star> \<phi>) \<cdot> \<l>\<^sup>-\<^sup>1[f]) \<cdot> \<r>[f] \<cdot> (inv \<phi> \<star> src f)"
           using assms A.antipar A.triangle_left comp_cod_arr comp_assoc
           by simp
         also have "... = (\<l>\<^sup>-\<^sup>1[f'] \<cdot> \<phi>) \<cdot> inv \<phi> \<cdot> \<r>[f']"
           using assms A.antipar lunit'_naturality runit_naturality [of "inv \<phi>"] by auto
         also have "... = \<l>\<^sup>-\<^sup>1[f'] \<cdot> (\<phi> \<cdot> inv \<phi>) \<cdot> \<r>[f']"
           using comp_assoc by simp
         also have "... =  \<l>\<^sup>-\<^sup>1[f'] \<cdot> \<r>[f']"
           using assms comp_cod_arr comp_arr_inv inv_is_inverse by auto
         finally show ?thesis by simp
       qed
     qed
 
     lemma adjoint_pair_preserved_by_iso:
     assumes "adjoint_pair f g"
     and "\<guillemotleft>\<phi> : f \<Rightarrow> f'\<guillemotright>" and "iso \<phi>"
     and "\<guillemotleft>\<psi> : g \<Rightarrow> g'\<guillemotright>" and "iso \<psi>"
     shows "adjoint_pair f' g'"
     proof -
       obtain \<eta> \<epsilon> where A: "adjunction_in_bicategory V H \<a> \<i> src trg f g \<eta> \<epsilon>"
         using assms adjoint_pair_def by auto
       have "adjunction_in_bicategory V H \<a> \<i> src trg f g' ((\<psi> \<star> f) \<cdot> \<eta>) (\<epsilon> \<cdot> (f \<star> inv \<psi>))"
         using assms A adjunction_preserved_by_iso_right by blast
       hence "adjunction_in_bicategory V H \<a> \<i> src trg f' g'
                ((g' \<star> \<phi>) \<cdot> (\<psi> \<star> f) \<cdot> \<eta>) ((\<epsilon> \<cdot> (f \<star> inv \<psi>)) \<cdot> (inv \<phi> \<star> g'))"
         using assms adjunction_preserved_by_iso_left by blast
       thus ?thesis using adjoint_pair_def by auto
     qed
 
     lemma left_adjoint_preserved_by_iso:
     assumes "is_left_adjoint f"
     and "\<guillemotleft>\<phi> : f \<Rightarrow> f'\<guillemotright>" and "iso \<phi>"
     shows "is_left_adjoint f'"
     proof -
       obtain g where g: "adjoint_pair f g"
         using assms by auto
       have "adjoint_pair f' g"
         using assms g adjoint_pair_preserved_by_iso [of f g \<phi> f' g g]
               adjoint_pair_antipar [of f g]
         by auto
       thus ?thesis by auto
     qed
 
     lemma right_adjoint_preserved_by_iso:
     assumes "is_right_adjoint g"
     and "\<guillemotleft>\<phi> : g \<Rightarrow> g'\<guillemotright>" and "iso \<phi>"
     shows "is_right_adjoint g'"
     proof -
       obtain f where f: "adjoint_pair f g"
         using assms by auto
       have "adjoint_pair f g'"
         using assms f adjoint_pair_preserved_by_iso [of f g f f \<phi> g']
               adjoint_pair_antipar [of f g]
         by auto
       thus ?thesis by auto
     qed
 
     lemma left_adjoint_preserved_by_iso':
     assumes "is_left_adjoint f" and "f \<cong> f'"
     shows "is_left_adjoint f'"
       using assms isomorphic_def left_adjoint_preserved_by_iso by blast
 
     lemma right_adjoint_preserved_by_iso':
     assumes "is_right_adjoint g" and "g \<cong> g'"
     shows "is_right_adjoint g'"
       using assms isomorphic_def right_adjoint_preserved_by_iso by blast
 
     lemma obj_self_adjunction:
     assumes "obj a"
     shows "adjunction_in_bicategory V H \<a> \<i> src trg a a \<l>\<^sup>-\<^sup>1[a] \<r>[a]"
     proof
       show 1: "ide a"
         using assms by auto
       show "\<guillemotleft>\<l>\<^sup>-\<^sup>1[a] : src a \<Rightarrow> a \<star> a\<guillemotright>"
         using assms 1 by auto
       show "\<guillemotleft>\<r>[a] : a \<star> a \<Rightarrow> src a\<guillemotright>"
         using assms 1 by fastforce
       show "(\<r>[a] \<star> a) \<cdot> \<a>\<^sup>-\<^sup>1[a, a, a] \<cdot> (a \<star> \<l>\<^sup>-\<^sup>1[a]) = \<l>\<^sup>-\<^sup>1[a] \<cdot> \<r>[a]"
         using assms 1 canI_unitor_1 canI_associator_1(2) canI_associator_3
-              whisker_can_right_1 whisker_can_left_1 can_Ide_self
+              whisker_can_right_1 whisker_can_left_1 can_Ide_self obj_simps
         by simp
       show "(a \<star> \<r>[a]) \<cdot> \<a>[a, a, a] \<cdot> (\<l>\<^sup>-\<^sup>1[a] \<star> a) = \<r>\<^sup>-\<^sup>1[a] \<cdot> \<l>[a]"
         using assms 1 canI_unitor_1 canI_associator_1(2) canI_associator_3
               whisker_can_right_1 whisker_can_left_1 can_Ide_self
         by simp
     qed
 
     lemma obj_is_self_adjoint:
     assumes "obj a"
     shows "adjoint_pair a a" and "is_left_adjoint a" and "is_right_adjoint a"
       using assms obj_self_adjunction adjoint_pair_def by auto
 
   end
 
   subsection "Pseudofunctors and Adjunctions"
 
   context pseudofunctor
   begin
 
     lemma preserves_adjunction:
     assumes "adjunction_in_bicategory V\<^sub>C H\<^sub>C \<a>\<^sub>C \<i>\<^sub>C src\<^sub>C trg\<^sub>C f g \<eta> \<epsilon>"
     shows "adjunction_in_bicategory V\<^sub>D H\<^sub>D \<a>\<^sub>D \<i>\<^sub>D src\<^sub>D trg\<^sub>D (F f) (F g)
              (D.inv (\<Phi> (g, f)) \<cdot>\<^sub>D F \<eta> \<cdot>\<^sub>D \<Psi> (src\<^sub>C f))
              (D.inv (\<Psi> (trg\<^sub>C f)) \<cdot>\<^sub>D F \<epsilon> \<cdot>\<^sub>D \<Phi> (f, g))"
     proof -
       interpret adjunction_in_bicategory V\<^sub>C H\<^sub>C \<a>\<^sub>C \<i>\<^sub>C src\<^sub>C trg\<^sub>C f g \<eta> \<epsilon>
         using assms by auto
       interpret A: adjunction_data_in_bicategory V\<^sub>D H\<^sub>D \<a>\<^sub>D \<i>\<^sub>D src\<^sub>D trg\<^sub>D
                      \<open>F f\<close> \<open>F g\<close> \<open>D.inv (\<Phi> (g, f)) \<cdot>\<^sub>D F \<eta> \<cdot>\<^sub>D \<Psi> (src\<^sub>C f)\<close>
                      \<open>D.inv (\<Psi> (trg\<^sub>C f)) \<cdot>\<^sub>D F \<epsilon> \<cdot>\<^sub>D \<Phi> (f, g)\<close>
         using adjunction_data_in_bicategory_axioms preserves_adjunction_data by auto
       show "adjunction_in_bicategory V\<^sub>D H\<^sub>D \<a>\<^sub>D \<i>\<^sub>D src\<^sub>D trg\<^sub>D (F f) (F g)
               (D.inv (\<Phi> (g, f)) \<cdot>\<^sub>D F \<eta> \<cdot>\<^sub>D \<Psi> (src\<^sub>C f))
               (D.inv (\<Psi> (trg\<^sub>C f)) \<cdot>\<^sub>D F \<epsilon> \<cdot>\<^sub>D \<Phi> (f, g))"
       proof
         show "(D.inv (\<Psi> (trg\<^sub>C f)) \<cdot>\<^sub>D F \<epsilon> \<cdot>\<^sub>D \<Phi> (f, g) \<star>\<^sub>D F f) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, F g, F f] \<cdot>\<^sub>D
                 (F f \<star>\<^sub>D D.inv (\<Phi> (g, f)) \<cdot>\<^sub>D F \<eta> \<cdot>\<^sub>D \<Psi> (src\<^sub>C f)) =
               D.lunit' (F f) \<cdot>\<^sub>D \<r>\<^sub>D[F f]"
         proof -
           have 1: "D.iso (\<Phi> (f, g \<star>\<^sub>C f) \<cdot>\<^sub>D (F f \<star>\<^sub>D \<Phi> (g, f)))"
             using antipar C.VV.ide_char C.VV.arr_char D.iso_is_arr FF_def
             by (intro D.isos_compose D.seqI, simp_all)
           have "(D.inv (\<Psi> (trg\<^sub>C f)) \<cdot>\<^sub>D F \<epsilon> \<cdot>\<^sub>D \<Phi> (f, g) \<star>\<^sub>D F f) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, F g, F f] \<cdot>\<^sub>D
                     (F f \<star>\<^sub>D D.inv (\<Phi> (g, f)) \<cdot>\<^sub>D F \<eta> \<cdot>\<^sub>D \<Psi> (src\<^sub>C f)) =
                  (D.inv (\<Psi> (trg\<^sub>C f)) \<cdot>\<^sub>D F \<epsilon> \<cdot>\<^sub>D \<Phi> (f, g) \<star>\<^sub>D F f) \<cdot>\<^sub>D
                    (D.inv (\<Phi> (f, g)) \<star>\<^sub>D F f) \<cdot>\<^sub>D D.inv (\<Phi> (f \<star>\<^sub>C g, f)) \<cdot>\<^sub>D
                    F \<a>\<^sub>C\<^sup>-\<^sup>1[f, g, f] \<cdot>\<^sub>D
                    \<Phi> (f, g \<star>\<^sub>C f) \<cdot>\<^sub>D (F f \<star>\<^sub>D \<Phi> (g, f)) \<cdot>\<^sub>D
                    (F f \<star>\<^sub>D D.inv (\<Phi> (g, f)) \<cdot>\<^sub>D F \<eta> \<cdot>\<^sub>D \<Psi> (src\<^sub>C f))"
           proof -
             have "\<a>\<^sub>D\<^sup>-\<^sup>1[F f, F g, F f] =
                   (D.inv (\<Phi> (f, g)) \<star>\<^sub>D F f) \<cdot>\<^sub>D D.inv (\<Phi> (f \<star>\<^sub>C g, f)) \<cdot>\<^sub>D F \<a>\<^sub>C\<^sup>-\<^sup>1[f, g, f] \<cdot>\<^sub>D
                     \<Phi> (f, g \<star>\<^sub>C f) \<cdot>\<^sub>D (F f \<star>\<^sub>D \<Phi> (g, f))"
             proof -
               have "\<a>\<^sub>D\<^sup>-\<^sup>1[F f, F g, F f] \<cdot>\<^sub>D D.inv (\<Phi> (f, g \<star>\<^sub>C f) \<cdot>\<^sub>D (F f \<star>\<^sub>D \<Phi> (g, f))) =
                     D.inv (F \<a>\<^sub>C[f, g, f] \<cdot>\<^sub>D \<Phi> (f \<star>\<^sub>C g, f) \<cdot>\<^sub>D (\<Phi> (f, g) \<star>\<^sub>D F f))"
               proof -
                 have "D.inv (\<Phi> (f, g \<star>\<^sub>C f) \<cdot>\<^sub>D (F f \<star>\<^sub>D \<Phi> (g, f)) \<cdot>\<^sub>D \<a>\<^sub>D[F f, F g, F f]) =
                       D.inv (F \<a>\<^sub>C[f, g, f] \<cdot>\<^sub>D \<Phi> (f \<star>\<^sub>C g, f) \<cdot>\<^sub>D (\<Phi> (f, g) \<star>\<^sub>D F f))"
                   using antipar assoc_coherence by simp
                 moreover
                 have "D.inv (\<Phi> (f, g \<star>\<^sub>C f) \<cdot>\<^sub>D (F f \<star>\<^sub>D \<Phi> (g, f)) \<cdot>\<^sub>D \<a>\<^sub>D[F f, F g, F f]) =
                       \<a>\<^sub>D\<^sup>-\<^sup>1[F f, F g, F f] \<cdot>\<^sub>D D.inv (\<Phi> (f, g \<star>\<^sub>C f) \<cdot>\<^sub>D (F f \<star>\<^sub>D \<Phi> (g, f)))"
                 proof -
                   have "D.seq (\<Phi> (f, g \<star>\<^sub>C f) \<cdot>\<^sub>D (F f \<star>\<^sub>D \<Phi> (g, f))) \<a>\<^sub>D[F f, F g, F f]"
                     using antipar by fastforce
                   thus ?thesis
                     using 1 antipar D.comp_assoc
                           D.inv_comp [of "\<a>\<^sub>D[F f, F g, F f]" "\<Phi> (f, g \<star>\<^sub>C f) \<cdot>\<^sub>D (F f \<star>\<^sub>D \<Phi> (g, f))"]
                     by auto
                 qed
                 ultimately show ?thesis by simp
               qed
               moreover have 2: "D.iso (F \<a>\<^sub>C[f, g, f] \<cdot>\<^sub>D \<Phi> (f \<star>\<^sub>C g, f) \<cdot>\<^sub>D (\<Phi> (f, g) \<star>\<^sub>D F f))"
                 using antipar D.isos_compose C.VV.ide_char C.VV.arr_char \<Phi>_simps(4)
                 by simp
               ultimately have "\<a>\<^sub>D\<^sup>-\<^sup>1[F f, F g, F f] =
                                D.inv (F \<a>\<^sub>C[f, g, f] \<cdot>\<^sub>D \<Phi> (f \<star>\<^sub>C g, f) \<cdot>\<^sub>D (\<Phi> (f, g) \<star>\<^sub>D F f)) \<cdot>\<^sub>D
                                  (\<Phi> (f, g \<star>\<^sub>C f) \<cdot>\<^sub>D (F f \<star>\<^sub>D \<Phi> (g, f)))"
                 using 1 2 antipar D.invert_side_of_triangle(2) D.inv_inv D.iso_inv_iso D.arr_inv
                 by metis
               moreover have "D.inv (F \<a>\<^sub>C[f, g, f] \<cdot>\<^sub>D \<Phi> (f \<star>\<^sub>C g, f) \<cdot>\<^sub>D (\<Phi> (f, g) \<star>\<^sub>D F f)) =
                              (D.inv (\<Phi> (f, g)) \<star>\<^sub>D F f) \<cdot>\<^sub>D D.inv (\<Phi> (f \<star>\<^sub>C g, f)) \<cdot>\<^sub>D F \<a>\<^sub>C\<^sup>-\<^sup>1[f, g, f]"
               proof -
                 have "D.inv (F \<a>\<^sub>C[f, g, f] \<cdot>\<^sub>D \<Phi> (f \<star>\<^sub>C g, f) \<cdot>\<^sub>D (\<Phi> (f, g) \<star>\<^sub>D F f)) =
                        D.inv (\<Phi> (f \<star>\<^sub>C g, f) \<cdot>\<^sub>D (\<Phi> (f, g) \<star>\<^sub>D F f)) \<cdot>\<^sub>D F \<a>\<^sub>C\<^sup>-\<^sup>1[f, g, f]"
                   using antipar D.isos_compose C.VV.arr_char \<Phi>_simps(4)
                         preserves_inv D.inv_comp
                   by simp
                 also have "... = (D.inv (\<Phi> (f, g) \<star>\<^sub>D F f) \<cdot>\<^sub>D D.inv (\<Phi> (f \<star>\<^sub>C g, f))) \<cdot>\<^sub>D
                                  F \<a>\<^sub>C\<^sup>-\<^sup>1[f, g, f]"
                   using antipar D.inv_comp C.VV.ide_char C.VV.arr_char \<Phi>_simps(4)
                   by simp
                 also have "... = ((D.inv (\<Phi> (f, g)) \<star>\<^sub>D F f) \<cdot>\<^sub>D D.inv (\<Phi> (f \<star>\<^sub>C g, f))) \<cdot>\<^sub>D
                                  F \<a>\<^sub>C\<^sup>-\<^sup>1[f, g, f]"
                   using antipar C.VV.ide_char C.VV.arr_char by simp
                 also have "... = (D.inv (\<Phi> (f, g)) \<star>\<^sub>D F f) \<cdot>\<^sub>D D.inv (\<Phi> (f \<star>\<^sub>C g, f)) \<cdot>\<^sub>D
                                  F \<a>\<^sub>C\<^sup>-\<^sup>1[f, g, f]"
                   using D.comp_assoc by simp
                 finally show ?thesis by simp
               qed
               ultimately show ?thesis
                 using D.comp_assoc by simp
             qed
             thus ?thesis
               using D.comp_assoc by simp
           qed
           also have "... = (D.inv (\<Psi> (trg\<^sub>C f)) \<cdot>\<^sub>D F \<epsilon> \<star>\<^sub>D F f) \<cdot>\<^sub>D
                              D.inv (\<Phi> (f \<star>\<^sub>C g, f)) \<cdot>\<^sub>D
                              F \<a>\<^sub>C\<^sup>-\<^sup>1[f, g, f] \<cdot>\<^sub>D
                              \<Phi> (f, g \<star>\<^sub>C f) \<cdot>\<^sub>D
                              (F f \<star>\<^sub>D F \<eta> \<cdot>\<^sub>D \<Psi> (src\<^sub>C f))"
           proof -
             have "... = ((D.inv (\<Psi> (trg\<^sub>C f)) \<cdot>\<^sub>D F \<epsilon> \<star>\<^sub>D F f) \<cdot>\<^sub>D (\<Phi> (f, g) \<star>\<^sub>D F f)) \<cdot>\<^sub>D
                           (D.inv (\<Phi> (f, g)) \<star>\<^sub>D F f) \<cdot>\<^sub>D D.inv (\<Phi> (f \<star>\<^sub>C g, f)) \<cdot>\<^sub>D
                           F \<a>\<^sub>C\<^sup>-\<^sup>1[f, g, f] \<cdot>\<^sub>D
                           \<Phi> (f, g \<star>\<^sub>C f) \<cdot>\<^sub>D (F f \<star>\<^sub>D \<Phi> (g, f)) \<cdot>\<^sub>D
                           ((F f \<star>\<^sub>D D.inv (\<Phi> (g, f))) \<cdot>\<^sub>D (F f \<star>\<^sub>D F \<eta> \<cdot>\<^sub>D \<Psi> (src\<^sub>C f)))"
             proof -
               have "D.inv (\<Psi> (trg\<^sub>C f)) \<cdot>\<^sub>D F \<epsilon> \<cdot>\<^sub>D \<Phi> (f, g) \<star>\<^sub>D F f =
                     (D.inv (\<Psi> (trg\<^sub>C f)) \<cdot>\<^sub>D F \<epsilon> \<star>\<^sub>D F f) \<cdot>\<^sub>D (\<Phi> (f, g) \<star>\<^sub>D F f)"
                 using ide_left ide_right antipar D.whisker_right \<Psi>_char(2)
                 by (metis A.counit_simps(1) A.ide_left D.comp_assoc)
               moreover have "F f \<star>\<^sub>D D.inv (\<Phi> (g, f)) \<cdot>\<^sub>D F \<eta> \<cdot>\<^sub>D \<Psi> (src\<^sub>C f) =
                              (F f \<star>\<^sub>D D.inv (\<Phi> (g, f))) \<cdot>\<^sub>D (F f \<star>\<^sub>D F \<eta> \<cdot>\<^sub>D \<Psi> (src\<^sub>C f))"
                 using antipar \<Psi>_char(2) D.whisker_left by simp
               ultimately show ?thesis by simp
             qed
             also have "... = (D.inv (\<Psi> (trg\<^sub>C f)) \<cdot>\<^sub>D F \<epsilon> \<star>\<^sub>D F f) \<cdot>\<^sub>D
                                (((\<Phi> (f, g) \<star>\<^sub>D F f) \<cdot>\<^sub>D (D.inv (\<Phi> (f, g)) \<star>\<^sub>D F f)) \<cdot>\<^sub>D
                                D.inv (\<Phi> (f \<star>\<^sub>C g, f))) \<cdot>\<^sub>D F \<a>\<^sub>C\<^sup>-\<^sup>1[f, g, f] \<cdot>\<^sub>D \<Phi> (f, g \<star>\<^sub>C f) \<cdot>\<^sub>D
                                (((F f \<star>\<^sub>D \<Phi> (g, f)) \<cdot>\<^sub>D (F f \<star>\<^sub>D D.inv (\<Phi> (g, f)))) \<cdot>\<^sub>D
                                (F f \<star>\<^sub>D F \<eta> \<cdot>\<^sub>D \<Psi> (src\<^sub>C f)))"
               using D.comp_assoc by simp
             also have "... = (D.inv (\<Psi> (trg\<^sub>C f)) \<cdot>\<^sub>D F \<epsilon> \<star>\<^sub>D F f) \<cdot>\<^sub>D
                              D.inv (\<Phi> (f \<star>\<^sub>C g, f)) \<cdot>\<^sub>D
                              F \<a>\<^sub>C\<^sup>-\<^sup>1[f, g, f] \<cdot>\<^sub>D
                              \<Phi> (f, g \<star>\<^sub>C f) \<cdot>\<^sub>D
                              (F f \<star>\<^sub>D F \<eta> \<cdot>\<^sub>D \<Psi> (src\<^sub>C f))"
             proof -
               have "((F f \<star>\<^sub>D \<Phi> (g, f)) \<cdot>\<^sub>D (F f \<star>\<^sub>D D.inv (\<Phi> (g, f)))) \<cdot>\<^sub>D
                       (F f \<star>\<^sub>D F \<eta> \<cdot>\<^sub>D \<Psi> (src\<^sub>C f)) =
                     F f \<star>\<^sub>D F \<eta> \<cdot>\<^sub>D \<Psi> (src\<^sub>C f)"
               proof -
                 have "(F f \<star>\<^sub>D \<Phi> (g, f)) \<cdot>\<^sub>D (F f \<star>\<^sub>D D.inv (\<Phi> (g, f))) = F f \<star>\<^sub>D F (g \<star>\<^sub>C f)"
                   using antipar \<Psi>_char(2) D.comp_arr_inv D.inv_is_inverse
                         D.whisker_left [of "F f" "\<Phi> (g, f)" "D.inv (\<Phi> (g, f))"]
                   by simp
                 moreover have "D.seq (F f \<star>\<^sub>D F (g \<star>\<^sub>C f)) (F f \<star>\<^sub>D F \<eta> \<cdot>\<^sub>D \<Psi> (src\<^sub>C f))"
                   using antipar by fastforce
                 ultimately show ?thesis
                   using D.comp_cod_arr by auto
               qed
               moreover have "((\<Phi> (f, g) \<star>\<^sub>D F f) \<cdot>\<^sub>D (D.inv (\<Phi> (f, g)) \<star>\<^sub>D F f)) \<cdot>\<^sub>D
                                D.inv (\<Phi> (f \<star>\<^sub>C g, f)) =
                              D.inv (\<Phi> (f \<star>\<^sub>C g, f))"
                 using antipar D.comp_arr_inv D.inv_is_inverse D.comp_cod_arr
                       D.whisker_right [of "F f" "\<Phi> (f, g)" "D.inv (\<Phi> (f, g))"]
                 by simp
               ultimately show ?thesis by simp
             qed
             finally show ?thesis by simp
           qed
           also have "... = (D.inv (\<Psi> (trg\<^sub>C f)) \<star>\<^sub>D F f) \<cdot>\<^sub>D
                              D.inv (\<Phi> (trg\<^sub>C f, f)) \<cdot>\<^sub>D F (\<epsilon> \<star>\<^sub>C f) \<cdot>\<^sub>D
                              ((\<Phi> (f \<star>\<^sub>C g, f) \<cdot>\<^sub>D D.inv (\<Phi> (f \<star>\<^sub>C g, f))) \<cdot>\<^sub>D
                                 F \<a>\<^sub>C\<^sup>-\<^sup>1[f, g, f]) \<cdot>\<^sub>D
                              ((\<Phi> (f, g \<star>\<^sub>C f) \<cdot>\<^sub>D D.inv (\<Phi> (f, g \<star>\<^sub>C f))) \<cdot>\<^sub>D F (f \<star>\<^sub>C \<eta>)) \<cdot>\<^sub>D
                              \<Phi> (f, src\<^sub>C f) \<cdot>\<^sub>D (F f \<star>\<^sub>D \<Psi> (src\<^sub>C f))"
           proof -
             have "(D.inv (\<Psi> (trg\<^sub>C f)) \<cdot>\<^sub>D F \<epsilon> \<star>\<^sub>D F f) \<cdot>\<^sub>D
                     D.inv (\<Phi> (f \<star>\<^sub>C g, f)) \<cdot>\<^sub>D
                     F \<a>\<^sub>C\<^sup>-\<^sup>1[f, g, f] \<cdot>\<^sub>D
                     \<Phi> (f, g \<star>\<^sub>C f) \<cdot>\<^sub>D
                     (F f \<star>\<^sub>D F \<eta> \<cdot>\<^sub>D \<Psi> (src\<^sub>C f)) =
                   ((D.inv (\<Psi> (trg\<^sub>C f)) \<star>\<^sub>D F f) \<cdot>\<^sub>D (F \<epsilon> \<star>\<^sub>D F f)) \<cdot>\<^sub>D
                     D.inv (\<Phi> (f \<star>\<^sub>C g, f)) \<cdot>\<^sub>D
                     F \<a>\<^sub>C\<^sup>-\<^sup>1[f, g, f] \<cdot>\<^sub>D
                     \<Phi> (f, g \<star>\<^sub>C f) \<cdot>\<^sub>D
                     ((F f \<star>\<^sub>D F \<eta>) \<cdot>\<^sub>D (F f \<star>\<^sub>D \<Psi> (src\<^sub>C f)))"
                 using antipar D.comp_assoc D.whisker_left D.whisker_right \<Psi>_char(2)
                 by simp
             moreover have "F \<epsilon> \<star>\<^sub>D F f = D.inv (\<Phi> (trg\<^sub>C f, f)) \<cdot>\<^sub>D F (\<epsilon> \<star>\<^sub>C f) \<cdot>\<^sub>D \<Phi> (f \<star>\<^sub>C g, f)"
               using antipar \<Phi>.naturality [of "(\<epsilon>, f)"] C.VV.arr_char FF_def
                     D.invert_side_of_triangle(1)
               by simp
             moreover have "F f \<star>\<^sub>D F \<eta> = D.inv (\<Phi> (f, g \<star>\<^sub>C f)) \<cdot>\<^sub>D F (f \<star>\<^sub>C \<eta>) \<cdot>\<^sub>D \<Phi> (f, src\<^sub>C f)"
               using antipar \<Phi>.naturality [of "(f, \<eta>)"] C.VV.arr_char FF_def
                     D.invert_side_of_triangle(1)
               by simp
             ultimately show ?thesis
               using D.comp_assoc by simp
           qed
           also have "... = ((D.inv (\<Psi> (trg\<^sub>C f)) \<star>\<^sub>D F f) \<cdot>\<^sub>D D.inv (\<Phi> (trg\<^sub>C f, f))) \<cdot>\<^sub>D
                              (F (\<epsilon> \<star>\<^sub>C f) \<cdot>\<^sub>D F \<a>\<^sub>C\<^sup>-\<^sup>1[f, g, f] \<cdot>\<^sub>D F (f \<star>\<^sub>C \<eta>)) \<cdot>\<^sub>D
                              \<Phi> (f, src\<^sub>C f) \<cdot>\<^sub>D (F f \<star>\<^sub>D \<Psi> (src\<^sub>C f))"
             using antipar D.comp_arr_inv' D.comp_cod_arr D.comp_assoc by simp
           also have "... = D.inv (\<Phi> (trg\<^sub>C f, f) \<cdot>\<^sub>D (\<Psi> (trg\<^sub>C f) \<star>\<^sub>D F f)) \<cdot>\<^sub>D
                              F ((\<epsilon> \<star>\<^sub>C f) \<cdot>\<^sub>C \<a>\<^sub>C\<^sup>-\<^sup>1[f, g, f] \<cdot>\<^sub>C (f \<star>\<^sub>C \<eta>)) \<cdot>\<^sub>D
                              \<Phi> (f, src\<^sub>C f) \<cdot>\<^sub>D (F f \<star>\<^sub>D \<Psi> (src\<^sub>C f))"
           proof -
             have "(D.inv (\<Psi> (trg\<^sub>C f)) \<star>\<^sub>D F f) \<cdot>\<^sub>D D.inv (\<Phi> (trg\<^sub>C f, f)) =
                   D.inv (\<Phi> (trg\<^sub>C f, f) \<cdot>\<^sub>D (\<Psi> (trg\<^sub>C f) \<star>\<^sub>D F f))"
             proof -
               have "D.iso (\<Phi> (trg\<^sub>C f, f))"
                 using antipar by simp
               moreover have "D.iso (\<Psi> (trg\<^sub>C f) \<star>\<^sub>D F f)"
                 using antipar \<Psi>_char(2) by simp
               moreover have "D.seq (\<Phi> (trg\<^sub>C f, f)) (\<Psi> (trg\<^sub>C f) \<star>\<^sub>D F f)"
                 using antipar D.iso_is_arr calculation(2)
                 apply (intro D.seqI D.hseqI) by auto
               ultimately show ?thesis
                 using antipar D.inv_comp \<Psi>_char(2) by simp
             qed
             moreover have "F (\<epsilon> \<star>\<^sub>C f) \<cdot>\<^sub>D F \<a>\<^sub>C\<^sup>-\<^sup>1[f, g, f] \<cdot>\<^sub>D F (f \<star>\<^sub>C \<eta>) =
                            F ((\<epsilon> \<star>\<^sub>C f) \<cdot>\<^sub>C \<a>\<^sub>C\<^sup>-\<^sup>1[f, g, f] \<cdot>\<^sub>C (f \<star>\<^sub>C \<eta>))"
               using antipar by simp
             ultimately show ?thesis by simp
           qed
           also have "... = (D.lunit' (F f) \<cdot>\<^sub>D F \<l>\<^sub>C[f]) \<cdot>\<^sub>D
                              F (C.lunit' f \<cdot>\<^sub>C \<r>\<^sub>C[f]) \<cdot>\<^sub>D
                              (D.inv (F \<r>\<^sub>C[f]) \<cdot>\<^sub>D \<r>\<^sub>D[F f])"
           proof -
             have "F ((\<epsilon> \<star>\<^sub>C f) \<cdot>\<^sub>C \<a>\<^sub>C\<^sup>-\<^sup>1[f, g, f] \<cdot>\<^sub>C (f \<star>\<^sub>C \<eta>)) = F (C.lunit' f \<cdot>\<^sub>C \<r>\<^sub>C[f])"
               using triangle_left by simp
             moreover have "D.inv (\<Phi> (trg\<^sub>C f, f) \<cdot>\<^sub>D (\<Psi> (trg\<^sub>C f) \<star>\<^sub>D F f)) =
                            D.lunit' (F f) \<cdot>\<^sub>D F \<l>\<^sub>C[f]"
             proof -
               have 0: "D.iso (\<Phi> (trg\<^sub>C f, f) \<cdot>\<^sub>D (\<Psi> (trg\<^sub>C f) \<star>\<^sub>D F f))"
                 using \<Psi>_char(2)
                 apply (intro D.isos_compose D.seqI) by auto
               show ?thesis
               proof -
                 have 1: "D.iso (F \<l>\<^sub>C[f])"
                   using C.iso_lunit preserves_iso by auto
                 moreover have "D.iso (F \<l>\<^sub>C[f] \<cdot>\<^sub>D \<Phi> (trg\<^sub>C f, f) \<cdot>\<^sub>D (\<Psi> (trg\<^sub>C f) \<star>\<^sub>D F f))"
                   by (metis (no_types) A.ide_left D.iso_lunit ide_left lunit_coherence)
                 moreover have "D.inv (D.inv (F \<l>\<^sub>C[f])) = F \<l>\<^sub>C[f]"
                   using 1 D.inv_inv by blast
                 ultimately show ?thesis
                   by (metis 0 D.inv_comp D.invert_side_of_triangle(2) D.iso_inv_iso
                       D.iso_is_arr ide_left lunit_coherence)
               qed
             qed
             moreover have "\<Phi> (f, src\<^sub>C f) \<cdot>\<^sub>D (F f \<star>\<^sub>D \<Psi> (src\<^sub>C f)) = D.inv (F \<r>\<^sub>C[f]) \<cdot>\<^sub>D \<r>\<^sub>D[F f]"
               using ide_left runit_coherence preserves_iso C.iso_runit D.invert_side_of_triangle(1)
               by (metis A.ide_left D.runit_simps(1))
             ultimately show ?thesis by simp
           qed
           also have "... = D.lunit' (F f) \<cdot>\<^sub>D
                              ((F \<l>\<^sub>C[f] \<cdot>\<^sub>D F (C.lunit' f)) \<cdot>\<^sub>D (F \<r>\<^sub>C[f] \<cdot>\<^sub>D D.inv (F \<r>\<^sub>C[f]))) \<cdot>\<^sub>D
                              \<r>\<^sub>D[F f]"
             using D.comp_assoc by simp
           also have "... = D.lunit' (F f) \<cdot>\<^sub>D \<r>\<^sub>D[F f]"
             using D.comp_cod_arr C.iso_runit C.iso_lunit preserves_iso D.comp_arr_inv'
                   preserves_inv
             by force
           finally show ?thesis by blast
         qed
         show "(F g \<star>\<^sub>D D.inv (\<Psi> (trg\<^sub>C f)) \<cdot>\<^sub>D F \<epsilon> \<cdot>\<^sub>D \<Phi> (f, g)) \<cdot>\<^sub>D
                 \<a>\<^sub>D[F g, F f, F g] \<cdot>\<^sub>D (D.inv (\<Phi> (g, f)) \<cdot>\<^sub>D F \<eta> \<cdot>\<^sub>D \<Psi> (src\<^sub>C f) \<star>\<^sub>D F g) =
               D.runit' (F g) \<cdot>\<^sub>D \<l>\<^sub>D[F g]"
         proof -
           have "\<a>\<^sub>D[F g, F f, F g] =
                 D.inv (\<Phi> (g, f \<star>\<^sub>C g) \<cdot>\<^sub>D (F g \<star>\<^sub>D \<Phi> (f, g))) \<cdot>\<^sub>D
                   F \<a>\<^sub>C[g, f, g] \<cdot>\<^sub>D \<Phi> (g \<star>\<^sub>C f, g) \<cdot>\<^sub>D (\<Phi> (g, f) \<star>\<^sub>D F g)"
           proof -
             have "D.iso (\<Phi> (g, f \<star>\<^sub>C g) \<cdot>\<^sub>D (F g \<star>\<^sub>D \<Phi> (f, g)))"
               using antipar D.iso_is_arr
               apply (intro D.isos_compose, auto)
               by (metis C.iso_assoc D.comp_assoc D.seqE ide_left ide_right
                   preserves_assoc(1) preserves_iso)
             have "F \<a>\<^sub>C[g, f, g] \<cdot>\<^sub>D \<Phi> (g \<star>\<^sub>C f, g) \<cdot>\<^sub>D (\<Phi> (g, f) \<star>\<^sub>D F g) =
                    \<Phi> (g, f \<star>\<^sub>C g) \<cdot>\<^sub>D (F g \<star>\<^sub>D \<Phi> (f, g)) \<cdot>\<^sub>D \<a>\<^sub>D[F g, F f, F g]"
               using antipar assoc_coherence by simp
             moreover have "D.seq (F \<a>\<^sub>C[g, f, g]) (\<Phi> (g \<star>\<^sub>C f, g) \<cdot>\<^sub>D (\<Phi> (g, f) \<star>\<^sub>D F g))"
             proof (intro D.seqI)
               show 1: "D.hseq (\<Phi> (g, f)) (F g)"
                 using antipar C.VV.arr_char by simp
               show "D.arr (\<Phi> (g \<star>\<^sub>C f, g))"
                 using antipar C.VV.arr_char by simp
               show "D.dom (\<Phi> (g \<star>\<^sub>C f, g)) = D.cod (\<Phi> (g, f) \<star>\<^sub>D F g)"
               proof -
                 have "D.iso (\<Phi> (g, f) \<star>\<^sub>D F g)"
                   using antipar by simp
                 moreover have "D.iso (\<Phi> (g \<star>\<^sub>C f, g))"
                   using antipar by simp
                 ultimately show ?thesis
                   by (metis C.iso_assoc D.comp_assoc D.iso_is_arr D.seqE
                       \<open>F \<a>\<^sub>C[g, f, g] \<cdot>\<^sub>D \<Phi> (g \<star>\<^sub>C f, g) \<cdot>\<^sub>D (\<Phi> (g, f) \<star>\<^sub>D F g) =
                        \<Phi> (g, f \<star>\<^sub>C g) \<cdot>\<^sub>D (F g \<star>\<^sub>D \<Phi> (f, g)) \<cdot>\<^sub>D \<a>\<^sub>D[F g, F f, F g]\<close>
                       antipar(1) antipar(2) ide_left ide_right preserves_assoc(1) preserves_iso)
               qed
               show "D.arr (F \<a>\<^sub>C[g, f, g])"
                 using antipar by simp
               show "D.dom (F \<a>\<^sub>C[g, f, g]) = D.cod (\<Phi> (g \<star>\<^sub>C f, g) \<cdot>\<^sub>D (\<Phi> (g, f) \<star>\<^sub>D F g))"
               proof -
                 have "D.iso (\<Phi> (g, f) \<star>\<^sub>D F g)"
                   using antipar by simp
                 moreover have "D.seq (\<Phi> (g \<star>\<^sub>C f, g)) (\<Phi> (g, f) \<star>\<^sub>D F g)"
                   using antipar D.iso_is_arr
                   apply (intro D.seqI) by auto
                 ultimately show ?thesis
                   using antipar by simp
               qed
             qed
             ultimately show ?thesis
               using \<open>D.iso (\<Phi> (g, f \<star>\<^sub>C g) \<cdot>\<^sub>D (F g \<star>\<^sub>D \<Phi> (f, g)))\<close> D.invert_side_of_triangle(1)
                     D.comp_assoc
               by auto
             qed
             hence "(F g \<star>\<^sub>D D.inv (\<Psi> (trg\<^sub>C f)) \<cdot>\<^sub>D F \<epsilon> \<cdot>\<^sub>D \<Phi> (f, g)) \<cdot>\<^sub>D
                      \<a>\<^sub>D[F g, F f, F g] \<cdot>\<^sub>D
                      (D.inv (\<Phi> (g, f)) \<cdot>\<^sub>D F \<eta> \<cdot>\<^sub>D \<Psi> (src\<^sub>C f) \<star>\<^sub>D F g) =
                    (F g \<star>\<^sub>D (D.inv (\<Psi> (trg\<^sub>C f)) \<cdot>\<^sub>D F \<epsilon>) \<cdot>\<^sub>D \<Phi> (f, g)) \<cdot>\<^sub>D
                      D.inv (\<Phi> (g, f \<star>\<^sub>C g) \<cdot>\<^sub>D (F g \<star>\<^sub>D \<Phi> (f, g))) \<cdot>\<^sub>D
                      F \<a>\<^sub>C[g, f, g] \<cdot>\<^sub>D
                      \<Phi> (g \<star>\<^sub>C f, g) \<cdot>\<^sub>D (\<Phi> (g, f) \<star>\<^sub>D F g) \<cdot>\<^sub>D
                      (D.inv (\<Phi> (g, f)) \<cdot>\<^sub>D F \<eta> \<cdot>\<^sub>D \<Psi> (src\<^sub>C f) \<star>\<^sub>D F g)"
               using D.comp_assoc by simp
             also have "... = ((F g \<star>\<^sub>D D.inv (\<Psi> (trg\<^sub>C f)) \<cdot>\<^sub>D F \<epsilon>) \<cdot>\<^sub>D (F g \<star>\<^sub>D \<Phi> (f, g))) \<cdot>\<^sub>D
                                D.inv (\<Phi> (g, f \<star>\<^sub>C g) \<cdot>\<^sub>D (F g \<star>\<^sub>D \<Phi> (f, g))) \<cdot>\<^sub>D
                                F \<a>\<^sub>C[g, f, g] \<cdot>\<^sub>D \<Phi> (g \<star>\<^sub>C f, g) \<cdot>\<^sub>D
                                (\<Phi> (g, f) \<star>\<^sub>D F g) \<cdot>\<^sub>D ((D.inv (\<Phi> (g, f)) \<star>\<^sub>D F g) \<cdot>\<^sub>D
                                (F \<eta> \<cdot>\<^sub>D \<Psi> (src\<^sub>C f) \<star>\<^sub>D F g))"
             proof -
               have "F g \<star>\<^sub>D (D.inv (\<Psi> (trg\<^sub>C f)) \<cdot>\<^sub>D F \<epsilon>) \<cdot>\<^sub>D \<Phi> (f, g) =
                     (F g \<star>\<^sub>D D.inv (\<Psi> (trg\<^sub>C f)) \<cdot>\<^sub>D F \<epsilon>) \<cdot>\<^sub>D (F g \<star>\<^sub>D \<Phi> (f, g))"
               proof -
                 have "D.seq (D.inv (\<Psi> (trg\<^sub>C f)) \<cdot>\<^sub>D F \<epsilon>) (\<Phi> (f, g))"
                   using antipar D.comp_assoc by simp
                 thus ?thesis
                   using antipar D.whisker_left by simp
               qed
               moreover have "D.inv (\<Phi> (g, f)) \<cdot>\<^sub>D F \<eta> \<cdot>\<^sub>D \<Psi> (src\<^sub>C f) \<star>\<^sub>D F g =
                              (D.inv (\<Phi> (g, f)) \<star>\<^sub>D F g) \<cdot>\<^sub>D (F \<eta> \<cdot>\<^sub>D \<Psi> (src\<^sub>C f) \<star>\<^sub>D F g)"
                 using antipar D.whisker_right by simp
               ultimately show ?thesis
                 using D.comp_assoc by simp
            qed
            also have "... = (F g \<star>\<^sub>D D.inv (\<Psi> (trg\<^sub>C f)) \<cdot>\<^sub>D F \<epsilon>) \<cdot>\<^sub>D
                               (((F g \<star>\<^sub>D \<Phi> (f, g)) \<cdot>\<^sub>D D.inv (F g \<star>\<^sub>D \<Phi> (f, g))) \<cdot>\<^sub>D
                               D.inv (\<Phi> (g, f \<star>\<^sub>C g))) \<cdot>\<^sub>D F \<a>\<^sub>C[g, f, g] \<cdot>\<^sub>D \<Phi> (g \<star>\<^sub>C f, g) \<cdot>\<^sub>D
                               ((\<Phi> (g, f) \<star>\<^sub>D F g) \<cdot>\<^sub>D (D.inv (\<Phi> (g, f)) \<star>\<^sub>D F g)) \<cdot>\<^sub>D
                               (F \<eta> \<cdot>\<^sub>D \<Psi> (src\<^sub>C f) \<star>\<^sub>D F g)"
            proof -
              have "D.inv (\<Phi> (g, f \<star>\<^sub>C g) \<cdot>\<^sub>D (F g \<star>\<^sub>D \<Phi> (f, g))) =
                    D.inv (F g \<star>\<^sub>D \<Phi> (f, g)) \<cdot>\<^sub>D D.inv (\<Phi> (g, f \<star>\<^sub>C g))"
              proof -
               have "D.iso (\<Phi> (g, f \<star>\<^sub>C g))"
                 using antipar by simp
               moreover have "D.iso (F g \<star>\<^sub>D \<Phi> (f, g))"
                 using antipar by simp
               moreover have "D.seq (\<Phi> (g, f \<star>\<^sub>C g)) (F g \<star>\<^sub>D \<Phi> (f, g))"
                 using antipar \<Phi>_in_hom A.ide_right D.iso_is_arr
                 apply (intro D.seqI D.hseqI) by auto
               ultimately show ?thesis
                 using antipar D.inv_comp by simp
             qed
             thus ?thesis
               using D.comp_assoc by simp
           qed
           also have "... = (F g \<star>\<^sub>D D.inv (\<Psi> (trg\<^sub>C f)) \<cdot>\<^sub>D F \<epsilon>) \<cdot>\<^sub>D
                              D.inv (\<Phi> (g, f \<star>\<^sub>C g)) \<cdot>\<^sub>D F \<a>\<^sub>C[g, f, g] \<cdot>\<^sub>D \<Phi> (g \<star>\<^sub>C f, g) \<cdot>\<^sub>D
                              (F \<eta> \<cdot>\<^sub>D \<Psi> (src\<^sub>C f) \<star>\<^sub>D F g)"
           proof -
             have "((\<Phi> (g, f) \<star>\<^sub>D F g) \<cdot>\<^sub>D (D.inv (\<Phi> (g, f)) \<star>\<^sub>D F g)) \<cdot>\<^sub>D
                     (F \<eta> \<cdot>\<^sub>D \<Psi> (src\<^sub>C f) \<star>\<^sub>D F g) =
                   (F \<eta> \<cdot>\<^sub>D \<Psi> (src\<^sub>C f) \<star>\<^sub>D F g)"
             proof -
               have "(\<Phi> (g, f) \<star>\<^sub>D F g) \<cdot>\<^sub>D (D.inv (\<Phi> (g, f)) \<star>\<^sub>D F g) = F (g \<star>\<^sub>C f) \<star>\<^sub>D F g"
                 using antipar D.comp_arr_inv'
                       D.whisker_right [of "F g" "\<Phi> (g, f)" "D.inv (\<Phi> (g, f))"]
                 by simp
               thus ?thesis
                 using antipar D.comp_cod_arr D.whisker_right by simp
             qed
             moreover have "((F g \<star>\<^sub>D \<Phi> (f, g)) \<cdot>\<^sub>D D.inv (F g \<star>\<^sub>D \<Phi> (f, g))) \<cdot>\<^sub>D
                              D.inv (\<Phi> (g, f \<star>\<^sub>C g)) =
                            D.inv (\<Phi> (g, f \<star>\<^sub>C g))"
               using antipar D.comp_arr_inv' D.comp_cod_arr
                     D.whisker_left [of "F g" "\<Phi> (f, g)" "D.inv (\<Phi> (f, g))"]
               by simp
             ultimately show ?thesis by simp
           qed
           also have "... = (F g \<star>\<^sub>D D.inv (\<Psi> (trg\<^sub>C f))) \<cdot>\<^sub>D
                              ((F g \<star>\<^sub>D F \<epsilon>) \<cdot>\<^sub>D D.inv (\<Phi> (g, f \<star>\<^sub>C g))) \<cdot>\<^sub>D
                              F \<a>\<^sub>C[g, f, g] \<cdot>\<^sub>D
                              (\<Phi> (g \<star>\<^sub>C f, g) \<cdot>\<^sub>D (F \<eta> \<star>\<^sub>D F g)) \<cdot>\<^sub>D
                              (\<Psi> (src\<^sub>C f) \<star>\<^sub>D F g)"
             using antipar D.whisker_left D.whisker_right \<Psi>_char(2) D.comp_assoc by simp
           also have "... = (F g \<star>\<^sub>D D.inv (\<Psi> (trg\<^sub>C f))) \<cdot>\<^sub>D D.inv (\<Phi> (g, src\<^sub>C g)) \<cdot>\<^sub>D
                              (F (g \<star>\<^sub>C \<epsilon>) \<cdot>\<^sub>D F \<a>\<^sub>C[g, f, g] \<cdot>\<^sub>D F (\<eta> \<star>\<^sub>C g)) \<cdot>\<^sub>D
                              \<Phi> (trg\<^sub>C g, g) \<cdot>\<^sub>D (\<Psi> (src\<^sub>C f) \<star>\<^sub>D F g)"
           proof -
             have "(F g \<star>\<^sub>D F \<epsilon>) \<cdot>\<^sub>D D.inv (\<Phi> (g, f \<star>\<^sub>C g)) = D.inv (\<Phi> (g, src\<^sub>C g)) \<cdot>\<^sub>D F (g \<star>\<^sub>C \<epsilon>)"
               using antipar C.VV.arr_char \<Phi>.naturality [of "(g, \<epsilon>)"] FF_def 
                     D.invert_opposite_sides_of_square
               by simp
             moreover have "\<Phi> (g \<star>\<^sub>C f, g) \<cdot>\<^sub>D (F \<eta> \<star>\<^sub>D F g) = F (\<eta> \<star>\<^sub>C g) \<cdot>\<^sub>D \<Phi> (trg\<^sub>C g, g)"
               using antipar C.VV.arr_char \<Phi>.naturality [of "(\<eta>, g)"] FF_def by simp
             ultimately show ?thesis
               using D.comp_assoc by simp
           qed
           also have "... = ((F g \<star>\<^sub>D D.inv (\<Psi> (trg\<^sub>C f))) \<cdot>\<^sub>D D.inv (\<Phi> (g, src\<^sub>C g)) \<cdot>\<^sub>D
                              F (C.runit' g)) \<cdot>\<^sub>D (F \<l>\<^sub>C[g] \<cdot>\<^sub>D \<Phi> (trg\<^sub>C g, g) \<cdot>\<^sub>D (\<Psi> (src\<^sub>C f) \<star>\<^sub>D F g))"
           proof -
             have "F (g \<star>\<^sub>C \<epsilon>) \<cdot>\<^sub>D F \<a>\<^sub>C[g, f, g] \<cdot>\<^sub>D F (\<eta> \<star>\<^sub>C g) = F (C.runit' g) \<cdot>\<^sub>D F \<l>\<^sub>C[g]"
               using ide_left ide_right antipar triangle_right
               by (metis C.comp_in_homE C.seqI' preserves_comp triangle_in_hom(2))
             thus ?thesis
               using D.comp_assoc by simp
           qed
           also have "... = D.runit' (F g) \<cdot>\<^sub>D \<l>\<^sub>D[F g]"
           proof -
             have "D.inv \<r>\<^sub>D[F g] =
                   (F g \<star>\<^sub>D D.inv (\<Psi> (trg\<^sub>C f))) \<cdot>\<^sub>D D.inv (\<Phi> (g, src\<^sub>C g)) \<cdot>\<^sub>D F (C.runit' g)"
             proof -
               have "D.runit' (F g) = D.inv (F \<r>\<^sub>C[g] \<cdot>\<^sub>D \<Phi> (g, src\<^sub>C g) \<cdot>\<^sub>D (F g \<star>\<^sub>D \<Psi> (src\<^sub>C g)))"
                 using runit_coherence by simp
               also have
                 "... = (F g \<star>\<^sub>D D.inv (\<Psi> (trg\<^sub>C f))) \<cdot>\<^sub>D D.inv (\<Phi> (g, src\<^sub>C g)) \<cdot>\<^sub>D F (C.runit' g)"
               proof -
                 have "D.inv (F \<r>\<^sub>C[g] \<cdot>\<^sub>D \<Phi> (g, src\<^sub>C g) \<cdot>\<^sub>D (F g \<star>\<^sub>D \<Psi> (src\<^sub>C g))) =
                        D.inv (F g \<star>\<^sub>D \<Psi> (src\<^sub>C g)) \<cdot>\<^sub>D D.inv (\<Phi> (g, src\<^sub>C g)) \<cdot>\<^sub>D F (C.runit' g)"
                 proof -
                   have "D.iso (F \<r>\<^sub>C[g])"
                     using preserves_iso by simp
                   moreover have 1: "D.iso (\<Phi> (g, src\<^sub>C g) \<cdot>\<^sub>D (F g \<star>\<^sub>D \<Psi> (src\<^sub>C g)))"
                     using preserves_iso \<Psi>_char(2) D.arrI D.seqE ide_right runit_coherence
                     by (intro D.isos_compose D.seqI, auto)
                   moreover have "D.seq (F \<r>\<^sub>C[g]) (\<Phi> (g, src\<^sub>C g) \<cdot>\<^sub>D (F g \<star>\<^sub>D \<Psi> (src\<^sub>C g)))"
                     using ide_right A.ide_right D.runit_simps(1) runit_coherence by metis
                   ultimately have "D.inv (F \<r>\<^sub>C[g] \<cdot>\<^sub>D \<Phi> (g, src\<^sub>C g) \<cdot>\<^sub>D (F g \<star>\<^sub>D \<Psi> (src\<^sub>C g))) =
                                    D.inv (\<Phi> (g, src\<^sub>C g) \<cdot>\<^sub>D (F g \<star>\<^sub>D \<Psi> (src\<^sub>C g))) \<cdot>\<^sub>D F (C.runit' g)"
                     using C.iso_runit preserves_inv D.inv_comp by simp
                   moreover have "D.inv (\<Phi> (g, src\<^sub>C g) \<cdot>\<^sub>D (F g \<star>\<^sub>D \<Psi> (src\<^sub>C g))) =
                                  D.inv (F g \<star>\<^sub>D \<Psi> (src\<^sub>C g)) \<cdot>\<^sub>D D.inv (\<Phi> (g, src\<^sub>C g))"
                   proof -
                     have "D.seq (\<Phi> (g, src\<^sub>C g)) (F g \<star>\<^sub>D \<Psi> (src\<^sub>C g))"
                       using 1 antipar preserves_iso \<Psi>_char(2) by fast
                       (*
                        * TODO: The fact that auto cannot do this step is probably what is blocking
                        * the whole thing from being done by auto.
                        *)
                     thus ?thesis
                       using 1 antipar preserves_iso \<Psi>_char(2) D.inv_comp by auto
                   qed
                   ultimately show ?thesis
                     using D.comp_assoc by simp
                 qed
                 thus ?thesis
                   using antipar \<Psi>_char(2) preserves_iso by simp
               qed
               finally show ?thesis by simp
             qed
             thus ?thesis
               using antipar lunit_coherence by simp
           qed
           finally show ?thesis by simp
         qed
       qed
     qed
 
     lemma preserves_adjoint_pair:
     assumes "C.adjoint_pair f g"
     shows "D.adjoint_pair (F f) (F g)"
       using assms C.adjoint_pair_def D.adjoint_pair_def preserves_adjunction by blast
 
     lemma preserves_left_adjoint:
     assumes "C.is_left_adjoint f"
     shows "D.is_left_adjoint (F f)"
       using assms preserves_adjoint_pair by auto
 
     lemma preserves_right_adjoint:
     assumes "C.is_right_adjoint g"
     shows "D.is_right_adjoint (F g)"
       using assms preserves_adjoint_pair by auto
 
   end
 
   context equivalence_pseudofunctor
   begin
 
     lemma reflects_adjunction:
     assumes "C.ide f" and "C.ide g"
     and "\<guillemotleft>\<eta> : src\<^sub>C f \<Rightarrow>\<^sub>C g \<star>\<^sub>C f\<guillemotright>" and "\<guillemotleft>\<epsilon> : f \<star>\<^sub>C g \<Rightarrow>\<^sub>C src\<^sub>C g\<guillemotright>"
     and "adjunction_in_bicategory V\<^sub>D H\<^sub>D \<a>\<^sub>D \<i>\<^sub>D src\<^sub>D trg\<^sub>D (F f) (F g)
            (D.inv (\<Phi> (g, f)) \<cdot>\<^sub>D F \<eta> \<cdot>\<^sub>D \<Psi> (src\<^sub>C f))
            (D.inv (\<Psi> (trg\<^sub>C f)) \<cdot>\<^sub>D F \<epsilon> \<cdot>\<^sub>D \<Phi> (f, g))"
     shows "adjunction_in_bicategory V\<^sub>C H\<^sub>C \<a>\<^sub>C \<i>\<^sub>C src\<^sub>C trg\<^sub>C f g \<eta> \<epsilon>"
     proof -
       let ?\<eta>' = "D.inv (\<Phi> (g, f)) \<cdot>\<^sub>D F \<eta> \<cdot>\<^sub>D \<Psi> (src\<^sub>C f)"
       let ?\<epsilon>' = "D.inv (\<Psi> (trg\<^sub>C f)) \<cdot>\<^sub>D F \<epsilon> \<cdot>\<^sub>D \<Phi> (f, g)"
       interpret A': adjunction_in_bicategory V\<^sub>D H\<^sub>D \<a>\<^sub>D \<i>\<^sub>D src\<^sub>D trg\<^sub>D \<open>F f\<close> \<open>F g\<close> ?\<eta>' ?\<epsilon>'
         using assms(5) by auto
       interpret A: adjunction_data_in_bicategory V\<^sub>C H\<^sub>C \<a>\<^sub>C \<i>\<^sub>C src\<^sub>C trg\<^sub>C f g \<eta> \<epsilon>
         using assms(1-4) by (unfold_locales, auto)
       show ?thesis
       proof
         show "(\<epsilon> \<star>\<^sub>C f) \<cdot>\<^sub>C \<a>\<^sub>C\<^sup>-\<^sup>1[f, g, f] \<cdot>\<^sub>C (f \<star>\<^sub>C \<eta>) = \<l>\<^sub>C\<^sup>-\<^sup>1[f] \<cdot>\<^sub>C \<r>\<^sub>C[f]"
         proof -
           have 1: "C.par ((\<epsilon> \<star>\<^sub>C f) \<cdot>\<^sub>C \<a>\<^sub>C\<^sup>-\<^sup>1[f, g, f] \<cdot>\<^sub>C (f \<star>\<^sub>C \<eta>)) (\<l>\<^sub>C\<^sup>-\<^sup>1[f] \<cdot>\<^sub>C \<r>\<^sub>C[f])"
             using assms A.antipar by simp
           moreover have "F ((\<epsilon> \<star>\<^sub>C f) \<cdot>\<^sub>C \<a>\<^sub>C\<^sup>-\<^sup>1[f, g, f] \<cdot>\<^sub>C (f \<star>\<^sub>C \<eta>)) = F (\<l>\<^sub>C\<^sup>-\<^sup>1[f] \<cdot>\<^sub>C \<r>\<^sub>C[f])"
           proof -
             have "F ((\<epsilon> \<star>\<^sub>C f) \<cdot>\<^sub>C \<a>\<^sub>C\<^sup>-\<^sup>1[f, g, f] \<cdot>\<^sub>C (f \<star>\<^sub>C \<eta>)) =
                   F (\<epsilon> \<star>\<^sub>C f) \<cdot>\<^sub>D F \<a>\<^sub>C\<^sup>-\<^sup>1[f, g, f] \<cdot>\<^sub>D F (f \<star>\<^sub>C \<eta>)"
               using 1 by auto
             also have "... =
                        (F (\<epsilon> \<star>\<^sub>C f) \<cdot>\<^sub>D \<Phi> (f \<star>\<^sub>C g, f)) \<cdot>\<^sub>D
                          (\<Phi> (f, g) \<star>\<^sub>D F f) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, F g, F f] \<cdot>\<^sub>D (F f \<star>\<^sub>D D.inv (\<Phi> (g, f))) \<cdot>\<^sub>D
                          (D.inv (\<Phi> (f, g \<star>\<^sub>C f)) \<cdot>\<^sub>D F (f \<star>\<^sub>C \<eta>))"
               using assms A.antipar preserves_assoc(2) D.comp_assoc by auto
             also have "... = \<Phi> (trg\<^sub>C f, f) \<cdot>\<^sub>D ((F \<epsilon> \<star>\<^sub>D F f) \<cdot>\<^sub>D (\<Phi> (f, g) \<star>\<^sub>D F f)) \<cdot>\<^sub>D
                                \<a>\<^sub>D\<^sup>-\<^sup>1[F f, F g, F f] \<cdot>\<^sub>D
                                ((F f \<star>\<^sub>D D.inv (\<Phi> (g, f))) \<cdot>\<^sub>D (F f \<star>\<^sub>D F \<eta>)) \<cdot>\<^sub>D
                                D.inv (\<Phi> (f, src\<^sub>C f))"
             proof -
               have "F (\<epsilon> \<star>\<^sub>C f) \<cdot>\<^sub>D \<Phi> (f \<star>\<^sub>C g, f) = \<Phi> (trg\<^sub>C f, f) \<cdot>\<^sub>D (F \<epsilon> \<star>\<^sub>D F f)"
                 using assms \<Phi>.naturality [of "(\<epsilon>, f)"] FF_def C.VV.arr_char by simp
               moreover have "D.inv (\<Phi> (f, g \<star>\<^sub>C f)) \<cdot>\<^sub>D F (f \<star>\<^sub>C \<eta>) =
                              (F f \<star>\<^sub>D F \<eta>) \<cdot>\<^sub>D D.inv (\<Phi> (f, src\<^sub>C f))"
               proof -
                 have "F (f \<star>\<^sub>C \<eta>) \<cdot>\<^sub>D \<Phi> (f, src\<^sub>C f) = \<Phi> (f, g \<star>\<^sub>C f) \<cdot>\<^sub>D (F f \<star>\<^sub>D F \<eta>)"
                   using assms \<Phi>.naturality [of "(f, \<eta>)"] FF_def C.VV.arr_char A.antipar
                   by simp
                 thus ?thesis
                   using assms A.antipar \<Phi>_components_are_iso C.VV.arr_char \<Phi>_in_hom
                         FF_def
                         D.invert_opposite_sides_of_square
                           [of "\<Phi> (f, g \<star>\<^sub>C f)" "F f \<star>\<^sub>D F \<eta>" "F (f \<star>\<^sub>C \<eta>)" "\<Phi> (f, src\<^sub>C f)"]
                   by fastforce
               qed
               ultimately show ?thesis
                 using D.comp_assoc by simp
             qed
             also have "... = \<Phi> (trg\<^sub>C f, f) \<cdot>\<^sub>D (F \<epsilon> \<cdot>\<^sub>D \<Phi> (f, g) \<star>\<^sub>D F f) \<cdot>\<^sub>D
                                \<a>\<^sub>D\<^sup>-\<^sup>1[F f, F g, F f] \<cdot>\<^sub>D
                                (F f \<star>\<^sub>D D.inv (\<Phi> (g, f)) \<cdot>\<^sub>D F \<eta>) \<cdot>\<^sub>D D.inv (\<Phi> (f, src\<^sub>C f))"
               using assms A.antipar \<Phi>_in_hom A.ide_left A.ide_right A'.ide_left A'.ide_right
                     D.whisker_left [of "F f" "D.inv (\<Phi> (g, f))" "F \<eta>"]
                     D.whisker_right [of "F f" "F \<epsilon>" "\<Phi> (f, g)"]
               by (metis A'.counit_in_vhom A'.unit_simps(1)D.arrI D.comp_assoc
                   D.src.preserves_reflects_arr D.src_vcomp D.vseq_implies_hpar(1) \<Phi>_simps(2))
             also have "... = \<Phi> (trg\<^sub>C f, f) \<cdot>\<^sub>D (\<Psi> (trg\<^sub>C f) \<cdot>\<^sub>D ?\<epsilon>' \<star>\<^sub>D F f) \<cdot>\<^sub>D
                                \<a>\<^sub>D\<^sup>-\<^sup>1[F f, F g, F f] \<cdot>\<^sub>D
                                (F f \<star>\<^sub>D ?\<eta>' \<cdot>\<^sub>D D.inv (\<Psi> (src\<^sub>C f))) \<cdot>\<^sub>D D.inv (\<Phi> (f, src\<^sub>C f))"
             proof -
               have "F \<epsilon> \<cdot>\<^sub>D \<Phi> (f, g) = \<Psi> (trg\<^sub>C f) \<cdot>\<^sub>D ?\<epsilon>'"
               proof -
                 have "D.iso (\<Psi> (trg\<^sub>C f))"
                   using A.ide_left C.ideD(1) \<Psi>_char(2) by blast
                 thus ?thesis
                   by (metis A'.counit_simps(1) D.comp_assoc D.comp_cod_arr D.inv_is_inverse
                       D.seqE D.comp_arr_inv)
               qed
               moreover have "D.inv (\<Phi> (g, f)) \<cdot>\<^sub>D F \<eta> = ?\<eta>' \<cdot>\<^sub>D D.inv (\<Psi> (src\<^sub>C f))"
                 using assms(2) \<Psi>_char D.comp_arr_inv D.inv_is_inverse D.comp_assoc D.comp_cod_arr
                 by (metis A'.unit_simps(1) A.antipar(1) C.ideD(1) C.obj_trg
                     D.invert_side_of_triangle(2))
               ultimately show ?thesis by simp
             qed
             also have "... = \<Phi> (trg\<^sub>C f, f) \<cdot>\<^sub>D ((\<Psi> (trg\<^sub>C f) \<star>\<^sub>D F f) \<cdot>\<^sub>D
                                (?\<epsilon>' \<star>\<^sub>D F f)) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, F g, F f] \<cdot>\<^sub>D ((F f \<star>\<^sub>D ?\<eta>') \<cdot>\<^sub>D
                                (F f \<star>\<^sub>D D.inv (\<Psi> (src\<^sub>C f)))) \<cdot>\<^sub>D D.inv (\<Phi> (f, src\<^sub>C f))"
               using assms A.antipar A'.antipar \<Psi>_char D.whisker_left D.whisker_right
               by simp
             also have "... = \<Phi> (trg\<^sub>C f, f) \<cdot>\<^sub>D (\<Psi> (trg\<^sub>C f) \<star>\<^sub>D F f) \<cdot>\<^sub>D
                                ((?\<epsilon>' \<star>\<^sub>D F f) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, F g, F f] \<cdot>\<^sub>D (F f \<star>\<^sub>D ?\<eta>')) \<cdot>\<^sub>D
                                (F f \<star>\<^sub>D D.inv (\<Psi> (src\<^sub>C f))) \<cdot>\<^sub>D D.inv (\<Phi> (f, src\<^sub>C f))"
               using D.comp_assoc by simp
             also have "... = (\<Phi> (trg\<^sub>C f, f) \<cdot>\<^sub>D (\<Psi> (trg\<^sub>C f) \<star>\<^sub>D F f) \<cdot>\<^sub>D \<l>\<^sub>D\<^sup>-\<^sup>1[F f]) \<cdot>\<^sub>D
                                \<r>\<^sub>D[F f] \<cdot>\<^sub>D (F f \<star>\<^sub>D D.inv (\<Psi> (src\<^sub>C f))) \<cdot>\<^sub>D D.inv (\<Phi> (f, src\<^sub>C f))"
               using A'.triangle_left D.comp_assoc by simp
             also have "... = F \<l>\<^sub>C\<^sup>-\<^sup>1[f] \<cdot>\<^sub>D F \<r>\<^sub>C[f]"
               using assms A.antipar preserves_lunit(2) preserves_runit(1) by simp
             also have "... = F (\<l>\<^sub>C\<^sup>-\<^sup>1[f] \<cdot>\<^sub>C \<r>\<^sub>C[f])"
               using assms by simp
             finally show ?thesis by simp
           qed
           ultimately show ?thesis
             using is_faithful by blast
         qed
         show "(g \<star>\<^sub>C \<epsilon>) \<cdot>\<^sub>C \<a>\<^sub>C[g, f, g] \<cdot>\<^sub>C (\<eta> \<star>\<^sub>C g) = \<r>\<^sub>C\<^sup>-\<^sup>1[g] \<cdot>\<^sub>C \<l>\<^sub>C[g]"
         proof -
           have 1: "C.par ((g \<star>\<^sub>C \<epsilon>) \<cdot>\<^sub>C \<a>\<^sub>C g f g \<cdot>\<^sub>C (\<eta> \<star>\<^sub>C g)) (\<r>\<^sub>C\<^sup>-\<^sup>1[g] \<cdot>\<^sub>C \<l>\<^sub>C[g])"
             using assms A.antipar by auto
           moreover have "F ((g \<star>\<^sub>C \<epsilon>) \<cdot>\<^sub>C \<a>\<^sub>C[g, f, g] \<cdot>\<^sub>C (\<eta> \<star>\<^sub>C g)) = F (\<r>\<^sub>C\<^sup>-\<^sup>1[g] \<cdot>\<^sub>C \<l>\<^sub>C[g])"
           proof -
             have "F ((g \<star>\<^sub>C \<epsilon>) \<cdot>\<^sub>C \<a>\<^sub>C g f g \<cdot>\<^sub>C (\<eta> \<star>\<^sub>C g)) =
                   F (g \<star>\<^sub>C \<epsilon>) \<cdot>\<^sub>D F \<a>\<^sub>C[g, f, g] \<cdot>\<^sub>D F (\<eta> \<star>\<^sub>C g)"
               using 1 by auto
             also have "... = (F (g \<star>\<^sub>C \<epsilon>) \<cdot>\<^sub>D \<Phi> (g, f \<star>\<^sub>C g)) \<cdot>\<^sub>D (F g \<star>\<^sub>D \<Phi> (f, g)) \<cdot>\<^sub>D
                              \<a>\<^sub>D[F g, F f, F g] \<cdot>\<^sub>D
                              (D.inv (\<Phi> (g, f)) \<star>\<^sub>D F g) \<cdot>\<^sub>D (D.inv (\<Phi> (g \<star>\<^sub>C f, g)) \<cdot>\<^sub>D F (\<eta> \<star>\<^sub>C g))"
               using assms A.antipar preserves_assoc(1) [of g f g] D.comp_assoc by auto
             also have "... = \<Phi> (g, src\<^sub>C g) \<cdot>\<^sub>D ((F g \<star>\<^sub>D F \<epsilon>) \<cdot>\<^sub>D (F g \<star>\<^sub>D \<Phi> (f, g))) \<cdot>\<^sub>D
                              \<a>\<^sub>D[F g, F f, F g] \<cdot>\<^sub>D
                              ((D.inv (\<Phi> (g, f)) \<star>\<^sub>D F g) \<cdot>\<^sub>D (F \<eta> \<star>\<^sub>D F g)) \<cdot>\<^sub>D D.inv (\<Phi> (trg\<^sub>C g, g))"
             proof -
               have "F (g \<star>\<^sub>C \<epsilon>) \<cdot>\<^sub>D \<Phi> (g, f \<star>\<^sub>C g) = \<Phi> (g, src\<^sub>C g) \<cdot>\<^sub>D (F g \<star>\<^sub>D F \<epsilon>)"
                 using assms \<Phi>.naturality [of "(g, \<epsilon>)"] FF_def C.VV.arr_char by auto
               moreover have "D.inv (\<Phi> (g \<star>\<^sub>C f, g)) \<cdot>\<^sub>D F (\<eta> \<star>\<^sub>C g) =
                              (F \<eta> \<star>\<^sub>D F g) \<cdot>\<^sub>D D.inv (\<Phi> (trg\<^sub>C g, g))"
               proof -
                 have "F (\<eta> \<star>\<^sub>C g) \<cdot>\<^sub>D \<Phi> (trg\<^sub>C g, g) = \<Phi> (g \<star>\<^sub>C f, g) \<cdot>\<^sub>D (F \<eta> \<star>\<^sub>D F g)"
                   using assms \<Phi>.naturality [of "(\<eta>, g)"] FF_def C.VV.arr_char A.antipar
                   by auto
                 thus ?thesis
                   using assms A.antipar \<Phi>_components_are_iso C.VV.arr_char FF_def
                         D.invert_opposite_sides_of_square
                           [of "\<Phi> (g \<star>\<^sub>C f, g)" "F \<eta> \<star>\<^sub>D F g" "F (\<eta> \<star>\<^sub>C g)" "\<Phi> (trg\<^sub>C g, g)"]
                   by fastforce
               qed
               ultimately show ?thesis
                 using D.comp_assoc by simp
             qed
             also have " ... = \<Phi> (g, src\<^sub>C g) \<cdot>\<^sub>D (F g \<star>\<^sub>D F \<epsilon> \<cdot>\<^sub>D \<Phi> (f, g)) \<cdot>\<^sub>D
                               \<a>\<^sub>D[F g, F f, F g] \<cdot>\<^sub>D
                               (D.inv (\<Phi> (g, f)) \<cdot>\<^sub>D F \<eta> \<star>\<^sub>D F g) \<cdot>\<^sub>D D.inv (\<Phi> (trg\<^sub>C g, g))"
             proof -
               have "(F g \<star>\<^sub>D F \<epsilon>) \<cdot>\<^sub>D (F g \<star>\<^sub>D \<Phi> (f, g)) = F g \<star>\<^sub>D F \<epsilon> \<cdot>\<^sub>D \<Phi> (f, g)"
                 using assms A.antipar D.whisker_left
                 by (metis A'.counit_simps(1) A'.ide_right D.seqE)
               moreover have "(D.inv (\<Phi> (g, f)) \<star>\<^sub>D F g) \<cdot>\<^sub>D (F \<eta> \<star>\<^sub>D F g) =
                              D.inv (\<Phi> (g, f)) \<cdot>\<^sub>D F \<eta> \<star>\<^sub>D F g"
                 using assms A.antipar D.whisker_right by simp
               ultimately show ?thesis by simp
             qed
             also have "... = \<Phi> (g, src\<^sub>C g) \<cdot>\<^sub>D (F g \<star>\<^sub>D \<Psi> (trg\<^sub>C f) \<cdot>\<^sub>D ?\<epsilon>') \<cdot>\<^sub>D
                              \<a>\<^sub>D[F g, F f, F g] \<cdot>\<^sub>D
                              (?\<eta>' \<cdot>\<^sub>D D.inv (\<Psi> (src\<^sub>C f)) \<star>\<^sub>D F g) \<cdot>\<^sub>D D.inv (\<Phi> (trg\<^sub>C g, g))"
             proof -
               have "F \<epsilon> \<cdot>\<^sub>D \<Phi> (f, g) = \<Psi> (trg\<^sub>C f) \<cdot>\<^sub>D ?\<epsilon>'"
                 using \<Psi>_char D.comp_arr_inv D.inv_is_inverse D.comp_assoc D.comp_cod_arr
                 by (metis A'.counit_simps(1) C.ideD(1) C.obj_trg D.seqE assms(1))
               moreover have "D.inv (\<Phi> (g, f)) \<cdot>\<^sub>D F \<eta> = ?\<eta>' \<cdot>\<^sub>D D.inv (\<Psi> (src\<^sub>C f))"
                 using \<Psi>_char D.comp_arr_inv D.inv_is_inverse D.comp_assoc D.comp_cod_arr
                 by (metis A'.unit_simps(1) A.unit_simps(1) A.unit_simps(5)
                     C.obj_trg D.invert_side_of_triangle(2))
               ultimately show ?thesis by simp
             qed
             also have "... = \<Phi> (g, src\<^sub>C g) \<cdot>\<^sub>D (F g \<star>\<^sub>D \<Psi> (trg\<^sub>C f)) \<cdot>\<^sub>D
                              ((F g \<star>\<^sub>D ?\<epsilon>') \<cdot>\<^sub>D \<a>\<^sub>D[F g, F f, F g] \<cdot>\<^sub>D (?\<eta>' \<star>\<^sub>D F g)) \<cdot>\<^sub>D
                              (D.inv (\<Psi> (src\<^sub>C f)) \<star>\<^sub>D F g) \<cdot>\<^sub>D D.inv (\<Phi> (trg\<^sub>C g, g))"
               using assms A.antipar \<Psi>_char D.whisker_left D.whisker_right D.comp_assoc
               by simp
             also have "... = \<Phi> (g, src\<^sub>C g) \<cdot>\<^sub>D (F g \<star>\<^sub>D \<Psi> (trg\<^sub>C f)) \<cdot>\<^sub>D \<r>\<^sub>D\<^sup>-\<^sup>1[F g] \<cdot>\<^sub>D
                              \<l>\<^sub>D[F g] \<cdot>\<^sub>D (D.inv (\<Psi> (src\<^sub>C f)) \<star>\<^sub>D F g) \<cdot>\<^sub>D D.inv (\<Phi> (trg\<^sub>C g, g))"
               using A'.triangle_right D.comp_assoc by simp
             also have "... = F \<r>\<^sub>C\<^sup>-\<^sup>1[g] \<cdot>\<^sub>D F \<l>\<^sub>C[g]"
                 using assms A.antipar preserves_lunit(1) preserves_runit(2) D.comp_assoc
                 by simp
             also have "... = F (\<r>\<^sub>C\<^sup>-\<^sup>1[g] \<cdot>\<^sub>C \<l>\<^sub>C[g])"
               using assms by simp
             finally show ?thesis by simp
           qed
           ultimately show ?thesis
             using is_faithful by blast
         qed
       qed
     qed
 
     lemma reflects_adjoint_pair:
     assumes "C.ide f" and "C.ide g"
     and "src\<^sub>C f = trg\<^sub>C g" and "src\<^sub>C g = trg\<^sub>C f"
     and "D.adjoint_pair (F f) (F g)"
     shows "C.adjoint_pair f g"
     proof -
       obtain \<eta>' \<epsilon>' where A': "adjunction_in_bicategory V\<^sub>D H\<^sub>D \<a>\<^sub>D \<i>\<^sub>D src\<^sub>D trg\<^sub>D (F f) (F g) \<eta>' \<epsilon>'"
         using assms D.adjoint_pair_def by auto
       interpret A': adjunction_in_bicategory V\<^sub>D H\<^sub>D \<a>\<^sub>D \<i>\<^sub>D src\<^sub>D trg\<^sub>D \<open>F f\<close> \<open>F g\<close> \<eta>' \<epsilon>'
         using A' by auto
       have 1: "\<guillemotleft>\<Phi> (g, f) \<cdot>\<^sub>D \<eta>' \<cdot>\<^sub>D D.inv (\<Psi> (src\<^sub>C f)) : F (src\<^sub>C f) \<Rightarrow>\<^sub>D F (g \<star>\<^sub>C f)\<guillemotright>"
         using assms \<Psi>_char [of "src\<^sub>C f"] A'.unit_in_hom
         by (intro D.comp_in_homI, auto)
       have 2: "\<guillemotleft>\<Psi> (trg\<^sub>C f) \<cdot>\<^sub>D \<epsilon>' \<cdot>\<^sub>D D.inv (\<Phi> (f, g)): F (f \<star>\<^sub>C g) \<Rightarrow>\<^sub>D F (trg\<^sub>C f)\<guillemotright>"
         using assms \<Phi>_in_hom [of f g] \<Psi>_char [of "trg\<^sub>C f"] A'.counit_in_hom
         by (intro D.comp_in_homI, auto)
       obtain \<eta> where \<eta>: "\<guillemotleft>\<eta> : src\<^sub>C f \<Rightarrow>\<^sub>C g \<star>\<^sub>C f\<guillemotright> \<and>
                          F \<eta> = \<Phi> (g, f) \<cdot>\<^sub>D \<eta>' \<cdot>\<^sub>D D.inv (\<Psi> (src\<^sub>C f))"
         using assms 1 A'.unit_in_hom \<Phi>_in_hom locally_full by fastforce
       have \<eta>': "\<eta>' = D.inv (\<Phi> (g, f)) \<cdot>\<^sub>D F \<eta> \<cdot>\<^sub>D \<Psi> (src\<^sub>C f)"
         using assms 1 \<eta> \<Phi>_in_hom \<Phi>.components_are_iso C.VV.ide_char C.VV.arr_char D.iso_inv_iso
               \<Phi>_components_are_iso \<Psi>_char(2)
               D.invert_side_of_triangle(1) [of "F \<eta>" "\<Phi> (g, f)" "\<eta>' \<cdot>\<^sub>D D.inv (\<Psi> (src\<^sub>C f))"]
               D.invert_side_of_triangle(2) [of "D.inv (\<Phi> (g, f)) \<cdot>\<^sub>D F \<eta>" \<eta>' "D.inv (\<Psi> (src\<^sub>C f))"]
         by (metis (no_types, lifting) C.ideD(1) C.obj_trg D.arrI D.comp_assoc D.inv_inv)
       obtain \<epsilon> where \<epsilon>: "\<guillemotleft>\<epsilon> : f \<star>\<^sub>C g \<Rightarrow>\<^sub>C trg\<^sub>C f\<guillemotright> \<and>
                          F \<epsilon> = \<Psi> (trg\<^sub>C f) \<cdot>\<^sub>D \<epsilon>' \<cdot>\<^sub>D D.inv (\<Phi> (f, g))"
         using assms 2 A'.counit_in_hom \<Phi>_in_hom locally_full by fastforce
       have \<epsilon>': "\<epsilon>' = D.inv (\<Psi> (trg\<^sub>C f)) \<cdot>\<^sub>D F \<epsilon> \<cdot>\<^sub>D \<Phi> (f, g)"
         using assms 2 \<epsilon> \<Phi>_in_hom \<Phi>.components_are_iso C.VV.ide_char C.VV.arr_char D.iso_inv_iso
               \<Psi>_char(2) D.comp_assoc
               D.invert_side_of_triangle(1) [of "F \<epsilon>" "\<Psi> (trg\<^sub>C f)" "\<epsilon>' \<cdot>\<^sub>D D.inv (\<Phi> (f, g))"]
               D.invert_side_of_triangle(2) [of "D.inv (\<Psi> (trg\<^sub>C f)) \<cdot>\<^sub>D F \<epsilon>" \<epsilon>' "D.inv (\<Phi> (f, g))"]
         by (metis (no_types, lifting) C.arrI C.ideD(1) C.obj_trg D.inv_inv \<Phi>_components_are_iso
             preserves_arr)
       have "adjunction_in_bicategory V\<^sub>D H\<^sub>D \<a>\<^sub>D \<i>\<^sub>D src\<^sub>D trg\<^sub>D (F f) (F g)
               (D.inv (\<Phi> (g, f)) \<cdot>\<^sub>D F \<eta> \<cdot>\<^sub>D \<Psi> (src\<^sub>C f))                          
               (D.inv (\<Psi> (trg\<^sub>C f)) \<cdot>\<^sub>D F \<epsilon> \<cdot>\<^sub>D \<Phi> (f, g))"
         using A'.adjunction_in_bicategory_axioms \<eta>' \<epsilon>' by simp
       hence "adjunction_in_bicategory V\<^sub>C H\<^sub>C \<a>\<^sub>C \<i>\<^sub>C src\<^sub>C trg\<^sub>C f g \<eta> \<epsilon>"
         using assms \<eta> \<epsilon> reflects_adjunction by simp
       thus ?thesis
         using C.adjoint_pair_def by auto
     qed
 
     lemma reflects_left_adjoint:
     assumes "C.ide f" and "D.is_left_adjoint (F f)"
     shows "C.is_left_adjoint f"
     proof -
       obtain g' where g': "D.adjoint_pair (F f) g'"
         using assms D.adjoint_pair_def by auto
       obtain g where g: "\<guillemotleft>g : trg\<^sub>C f \<rightarrow>\<^sub>C src\<^sub>C f\<guillemotright> \<and> C.ide g \<and> D.isomorphic (F g) g'"
         using assms g' locally_essentially_surjective [of "trg\<^sub>C f" "src\<^sub>C f" g']
               D.adjoint_pair_antipar [of "F f" g']
         by auto
       obtain \<phi> where \<phi>: "\<guillemotleft>\<phi> : g' \<Rightarrow>\<^sub>D F g\<guillemotright> \<and> D.iso \<phi>"
         using g D.isomorphic_def D.isomorphic_symmetric by metis
       have "D.adjoint_pair (F f) (F g)"
         using assms g g' \<phi> D.adjoint_pair_preserved_by_iso [of "F f" g' "F f" "F f" \<phi> "F g"]
         by auto
       thus ?thesis
         using assms g reflects_adjoint_pair [of f g] D.adjoint_pair_antipar C.in_hhom_def
         by auto
     qed      
 
     lemma reflects_right_adjoint:
     assumes "C.ide g" and "D.is_right_adjoint (F g)"
     shows "C.is_right_adjoint g"
     proof -
       obtain f' where f': "D.adjoint_pair f' (F g)"
         using assms D.adjoint_pair_def by auto
       obtain f where f: "\<guillemotleft>f : trg\<^sub>C g \<rightarrow>\<^sub>C src\<^sub>C g\<guillemotright> \<and> C.ide f \<and> D.isomorphic (F f) f'"
         using assms f' locally_essentially_surjective [of "trg\<^sub>C g" "src\<^sub>C g" f']
               D.adjoint_pair_antipar [of f' "F g"]
         by auto
       obtain \<phi> where \<phi>: "\<guillemotleft>\<phi> : f' \<Rightarrow>\<^sub>D F f\<guillemotright> \<and> D.iso \<phi>"
         using f D.isomorphic_def D.isomorphic_symmetric by metis
       have "D.adjoint_pair (F f) (F g)"
         using assms f f' \<phi> D.adjoint_pair_preserved_by_iso [of f' "F g" \<phi> "F f" "F g" "F g"]
         by auto
       thus ?thesis
         using assms f reflects_adjoint_pair [of f g] D.adjoint_pair_antipar C.in_hhom_def
         by auto
     qed      
 
   end
 
   subsection "Composition of Adjunctions"
 
   text \<open>
     We first consider the strict case, then extend to all bicategories using strictification.
   \<close>
 
   locale composite_adjunction_in_strict_bicategory =
     strict_bicategory V H \<a> \<i> src trg +
     fg: adjunction_in_strict_bicategory V H \<a> \<i> src trg f g \<zeta> \<xi> +
     hk: adjunction_in_strict_bicategory V H \<a> \<i> src trg h k \<sigma> \<tau>
   for V :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"        (infixr "\<cdot>" 55)
   and H :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"        (infixr "\<star>" 53)
   and \<a> :: "'a \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a"  ("\<a>[_, _, _]")
   and \<i> :: "'a \<Rightarrow> 'a"              ("\<i>[_]")
   and src :: "'a \<Rightarrow> 'a"
   and trg :: "'a \<Rightarrow> 'a"
   and f :: "'a"
   and g :: "'a"
   and \<zeta> :: "'a"
   and \<xi> :: "'a"
   and h :: "'a"
   and k :: "'a"
   and \<sigma> :: "'a"
   and \<tau> :: "'a" +
   assumes composable: "src h = trg f"
   begin
 
     abbreviation \<eta>
     where "\<eta> \<equiv> (g \<star> \<sigma> \<star> f) \<cdot> \<zeta>"
 
     abbreviation \<epsilon>
     where "\<epsilon> \<equiv> \<tau> \<cdot> (h \<star> \<xi> \<star> k)"
 
     interpretation adjunction_data_in_bicategory V H \<a> \<i> src trg \<open>h \<star> f\<close> \<open>g \<star> k\<close> \<eta> \<epsilon>
     proof
       show "ide (h \<star> f)"
         using composable by simp
       show "ide (g \<star> k)"
         using fg.antipar hk.antipar composable by simp
       show "\<guillemotleft>\<eta> : src (h \<star> f) \<Rightarrow> (g \<star> k) \<star> h \<star> f\<guillemotright>"
       proof
         show "\<guillemotleft>\<zeta> : src (h \<star> f) \<Rightarrow> g \<star> f\<guillemotright>"
           using fg.antipar hk.antipar composable \<open>ide (h \<star> f)\<close> by auto
         show "\<guillemotleft>g \<star> \<sigma> \<star> f : g \<star> f \<Rightarrow> (g \<star> k) \<star> h \<star> f\<guillemotright>"
         proof -
           have "\<guillemotleft>g \<star> \<sigma> \<star> f : g \<star> trg f \<star> f \<Rightarrow> g \<star> (k \<star> h) \<star> f\<guillemotright>"
             using fg.antipar hk.antipar composable hk.unit_in_hom
             apply (intro hcomp_in_vhom) by auto
           thus ?thesis
             using hcomp_obj_arr hcomp_assoc by fastforce
         qed
       qed
       show "\<guillemotleft>\<epsilon> : (h \<star> f) \<star> g \<star> k \<Rightarrow> src (g \<star> k)\<guillemotright>"
       proof
         show "\<guillemotleft>h \<star> \<xi> \<star> k : (h \<star> f) \<star> g \<star> k \<Rightarrow> h \<star> k\<guillemotright>"
         proof -
           have "\<guillemotleft>h \<star> \<xi> \<star> k : h \<star> (f \<star> g) \<star> k \<Rightarrow> h \<star> trg f \<star> k\<guillemotright>"
             using composable fg.antipar(1-2) hk.antipar(1) by fastforce
           thus ?thesis
             using fg.antipar hk.antipar composable hk.unit_in_hom hcomp_obj_arr hcomp_assoc
             by simp
         qed
         show "\<guillemotleft>\<tau> : h \<star> k \<Rightarrow> src (g \<star> k)\<guillemotright>"
           using fg.antipar hk.antipar composable hk.unit_in_hom by auto
       qed
     qed
 
     sublocale adjunction_in_strict_bicategory V H \<a> \<i> src trg \<open>h \<star> f\<close> \<open>g \<star> k\<close> \<eta> \<epsilon>
     proof
       show "(\<epsilon> \<star> h \<star> f) \<cdot> \<a>\<^sup>-\<^sup>1[h \<star> f, g \<star> k, h \<star> f] \<cdot> ((h \<star> f) \<star> \<eta>) = \<l>\<^sup>-\<^sup>1[h \<star> f] \<cdot> \<r>[h \<star> f]"
       proof -
         have "(\<epsilon> \<star> h \<star> f) \<cdot> \<a>\<^sup>-\<^sup>1[h \<star> f, g \<star> k, h \<star> f] \<cdot> ((h \<star> f) \<star> \<eta>) =
               (\<tau> \<cdot> (h \<star> \<xi> \<star> k) \<star> h \<star> f) \<cdot> ((h \<star> f) \<star> (g \<star> \<sigma> \<star> f) \<cdot> \<zeta>)"
           using fg.antipar hk.antipar composable strict_assoc comp_ide_arr
                 ide_left ide_right antipar(1) antipar(2)
           by (metis arrI seqE strict_assoc' triangle_in_hom(1))
         also have "... = (\<tau> \<star> h \<star> f) \<cdot> ((h \<star> \<xi> \<star> (k \<star> h) \<star> f) \<cdot> (h \<star> (f \<star> g) \<star> \<sigma> \<star> f)) \<cdot> (h \<star> f \<star> \<zeta>)"
           using fg.antipar hk.antipar composable whisker_left [of "h \<star> f"] whisker_right
             comp_assoc hcomp_assoc
           by simp
         also have "... = (\<tau> \<star> h \<star> f) \<cdot> (h \<star> (\<xi> \<star> (k \<star> h)) \<cdot> ((f \<star> g) \<star> \<sigma>) \<star> f) \<cdot> (h \<star> f \<star> \<zeta>)"
           using fg.antipar hk.antipar composable whisker_left whisker_right hcomp_assoc
           by simp
         also have "... = (\<tau> \<star> h \<star> f) \<cdot> (h \<star> (trg f \<star> \<sigma>) \<cdot> (\<xi> \<star> trg f) \<star> f) \<cdot> (h \<star> f \<star> \<zeta>)"
           using fg.antipar hk.antipar composable comp_arr_dom comp_cod_arr
                 interchange [of \<xi> "f \<star> g" "k \<star> h" \<sigma>] interchange [of "trg f" \<xi> \<sigma> "trg f"]
           by (metis fg.counit_simps(1) fg.counit_simps(2) fg.counit_simps(3)
               hk.unit_simps(1) hk.unit_simps(2) hk.unit_simps(3))
         also have "... = (\<tau> \<star> h \<star> f) \<cdot> (h \<star> \<sigma> \<cdot> \<xi> \<star> f) \<cdot> (h \<star> f \<star> \<zeta>)"
           using fg.antipar hk.antipar composable hcomp_obj_arr hcomp_arr_obj
           by (metis fg.counit_simps(1) fg.counit_simps(4) hk.unit_simps(1) hk.unit_simps(5)
               obj_src)
         also have "... = ((\<tau> \<star> h \<star> f) \<cdot> (h \<star> \<sigma> \<star> f)) \<cdot> ((h \<star> \<xi> \<star> f) \<cdot> (h \<star> f \<star> \<zeta>))"
           using fg.antipar hk.antipar composable whisker_left whisker_right comp_assoc
           by simp
         also have "... = ((\<tau> \<star> h) \<cdot> (h \<star> \<sigma>) \<star> f) \<cdot> (h \<star> (\<xi> \<star> f) \<cdot> (f \<star> \<zeta>))"
           using fg.antipar hk.antipar composable whisker_left whisker_right hcomp_assoc
           by simp
         also have "... = h \<star> f"
           using fg.antipar hk.antipar composable fg.triangle_left hk.triangle_left
           by simp
         also have "... = \<l>\<^sup>-\<^sup>1[h \<star> f] \<cdot> \<r>[h \<star> f]"
           using fg.antipar hk.antipar composable strict_lunit' strict_runit by simp
         finally show ?thesis by simp
       qed
       show "((g \<star> k) \<star> \<epsilon>) \<cdot> \<a>[g \<star> k, h \<star> f, g \<star> k] \<cdot> (\<eta> \<star> g \<star> k) = \<r>\<^sup>-\<^sup>1[g \<star> k] \<cdot> \<l>[g \<star> k]"
       proof -
         have "((g \<star> k) \<star> \<epsilon>) \<cdot> \<a>[g \<star> k, h \<star> f, g \<star> k] \<cdot> (\<eta> \<star> g \<star> k) =
               ((g \<star> k) \<star> \<tau> \<cdot> (h \<star> \<xi> \<star> k)) \<cdot> ((g \<star> \<sigma> \<star> f) \<cdot> \<zeta> \<star> g \<star> k)"
           using fg.antipar hk.antipar composable strict_assoc comp_ide_arr
                 ide_left ide_right
           by (metis antipar(1) antipar(2) arrI seqE triangle_in_hom(2))
         also have "... = (g \<star> k \<star> \<tau>) \<cdot> ((g \<star> (k \<star> h) \<star> \<xi> \<star> k) \<cdot> (g \<star> \<sigma> \<star> (f \<star> g) \<star> k)) \<cdot> (\<zeta> \<star> g \<star> k)"
           using fg.antipar hk.antipar composable whisker_left [of "g \<star> k"] whisker_right
             comp_assoc hcomp_assoc
           by simp
         also have "... = (g \<star> k \<star> \<tau>) \<cdot> (g \<star> ((k \<star> h) \<star> \<xi>) \<cdot> (\<sigma> \<star> f \<star> g) \<star> k) \<cdot> (\<zeta> \<star> g \<star> k)"
             using fg.antipar hk.antipar composable whisker_left whisker_right hcomp_assoc
             by simp
         also have "... = (g \<star> k \<star> \<tau>) \<cdot> (g \<star> (\<sigma> \<star> src g) \<cdot> (src g \<star> \<xi>) \<star> k) \<cdot> (\<zeta> \<star> g \<star> k)"
           using fg.antipar hk.antipar composable interchange [of "k \<star> h" \<sigma> \<xi> "f \<star> g"]
                 interchange [of \<sigma> "src g" "src g" \<xi>] comp_arr_dom comp_cod_arr
           by (metis fg.counit_simps(1) fg.counit_simps(2) fg.counit_simps(3)
               hk.unit_simps(1) hk.unit_simps(2) hk.unit_simps(3))
         also have "... = (g \<star> k \<star> \<tau>) \<cdot> (g \<star> \<sigma> \<cdot> \<xi> \<star> k) \<cdot> (\<zeta> \<star> g \<star> k)"
           using fg.antipar hk.antipar composable hcomp_obj_arr [of "src g" \<xi>]
                 hcomp_arr_obj [of \<sigma> "src g"]
           by simp
         also have "... = ((g \<star> k \<star> \<tau>) \<cdot> (g \<star> \<sigma> \<star> k)) \<cdot> (g \<star> \<xi> \<star> k) \<cdot> (\<zeta> \<star> g \<star> k)"
           using fg.antipar hk.antipar composable whisker_left whisker_right comp_assoc
           by simp
         also have "... = (g \<star> (k \<star> \<tau>) \<cdot> (\<sigma> \<star> k)) \<cdot> ((g \<star> \<xi>) \<cdot> (\<zeta> \<star> g) \<star> k)"
           using fg.antipar hk.antipar composable whisker_left whisker_right hcomp_assoc
           by simp
         also have "... = g \<star> k"
           using fg.antipar hk.antipar composable fg.triangle_right hk.triangle_right
           by simp
         also have "... = \<r>\<^sup>-\<^sup>1[g \<star> k] \<cdot> \<l>[g \<star> k]"
           using fg.antipar hk.antipar composable strict_lunit strict_runit' by simp
         finally show ?thesis by simp
       qed
     qed
 
     lemma is_adjunction_in_strict_bicategory:
     shows "adjunction_in_strict_bicategory V H \<a> \<i> src trg (h \<star> f) (g \<star> k) \<eta> \<epsilon>"
       ..
 
   end
 
   context strict_bicategory
   begin
 
     lemma left_adjoints_compose:
     assumes "is_left_adjoint f" and "is_left_adjoint f'" and "src f' = trg f"
     shows "is_left_adjoint (f' \<star> f)"
     proof -
       obtain g \<eta> \<epsilon> where fg: "adjunction_in_bicategory V H \<a> \<i> src trg f g \<eta> \<epsilon>"
         using assms adjoint_pair_def by auto
       interpret fg: adjunction_in_bicategory V H \<a> \<i> src trg f g \<eta> \<epsilon>
         using fg by auto
       obtain g' \<eta>' \<epsilon>' where f'g': "adjunction_in_bicategory V H \<a> \<i> src trg f' g' \<eta>' \<epsilon>'"
         using assms adjoint_pair_def by auto
       interpret f'g': adjunction_in_bicategory V H \<a> \<i> src trg f' g' \<eta>' \<epsilon>'
         using f'g' by auto
       interpret f'fgg': composite_adjunction_in_strict_bicategory V H \<a> \<i> src trg
                           f g \<eta> \<epsilon> f' g' \<eta>' \<epsilon>'
         using assms apply unfold_locales by simp
       have "adjoint_pair (f' \<star> f) (g \<star> g')"
         using adjoint_pair_def f'fgg'.adjunction_in_bicategory_axioms by auto
       thus ?thesis by auto
     qed
 
     lemma right_adjoints_compose:
     assumes "is_right_adjoint g" and "is_right_adjoint g'" and "src g = trg g'"
     shows "is_right_adjoint (g \<star> g')"
     proof -
       obtain f \<eta> \<epsilon> where fg: "adjunction_in_bicategory V H \<a> \<i> src trg f g \<eta> \<epsilon>"
         using assms adjoint_pair_def by auto
       interpret fg: adjunction_in_bicategory V H \<a> \<i> src trg f g \<eta> \<epsilon>
         using fg by auto
       obtain f' \<eta>' \<epsilon>' where f'g': "adjunction_in_bicategory V H \<a> \<i> src trg f' g' \<eta>' \<epsilon>'"
         using assms adjoint_pair_def by auto
       interpret f'g': adjunction_in_bicategory V H \<a> \<i> src trg f' g' \<eta>' \<epsilon>'
         using f'g' by auto
       interpret f'fgg': composite_adjunction_in_strict_bicategory V H \<a> \<i> src trg
                           f g \<eta> \<epsilon> f' g' \<eta>' \<epsilon>'
         using assms fg.antipar f'g'.antipar apply unfold_locales by simp
       have "adjoint_pair (f' \<star> f) (g \<star> g')"
         using adjoint_pair_def f'fgg'.adjunction_in_bicategory_axioms by auto
       thus ?thesis by auto
     qed
 
   end
 
   text \<open>
     We now use strictification to extend the preceding results to an arbitrary bicategory.
     We only prove that ``left adjoints compose'' and ``right adjoints compose'';
     I did not work out formulas for the unit and counit of the composite adjunction in the
     non-strict case.
   \<close>
 
   context bicategory
   begin
 
     interpretation S: strictified_bicategory V H \<a> \<i> src trg ..
 
     notation S.vcomp  (infixr "\<cdot>\<^sub>S" 55)
     notation S.hcomp  (infixr "\<star>\<^sub>S" 53)
     notation S.in_hom  ("\<guillemotleft>_ : _ \<Rightarrow>\<^sub>S _\<guillemotright>")
     notation S.in_hhom  ("\<guillemotleft>_ : _ \<rightarrow>\<^sub>S _\<guillemotright>")
 
     interpretation UP: fully_faithful_functor V S.vcomp S.UP
       using S.UP_is_fully_faithful_functor by auto
     interpretation UP: equivalence_pseudofunctor V H \<a> \<i> src trg
                           S.vcomp S.hcomp S.\<a> S.\<i> S.src S.trg S.UP S.\<Phi>
       using S.UP_is_equivalence_pseudofunctor by auto
 
     lemma left_adjoints_compose:
     assumes "is_left_adjoint f" and "is_left_adjoint f'" and "src f = trg f'"
     shows "is_left_adjoint (f \<star> f')"
     proof -
       have "S.is_left_adjoint (S.UP f) \<and> S.is_left_adjoint (S.UP f')"
         using assms UP.preserves_left_adjoint by simp
       moreover have "S.src (S.UP f) = S.trg (S.UP f')"
         using assms left_adjoint_is_ide by simp
       ultimately have "S.is_left_adjoint (S.hcomp (S.UP f) (S.UP f'))"
         using S.left_adjoints_compose by simp
       moreover have "S.isomorphic (S.hcomp (S.UP f) (S.UP f')) (S.UP (f \<star> f'))"
       proof -
         have "\<guillemotleft>S.\<Phi> (f, f') : S.hcomp (S.UP f) (S.UP f') \<Rightarrow>\<^sub>S S.UP (f \<star> f')\<guillemotright>"
           using assms left_adjoint_is_ide UP.\<Phi>_in_hom by simp
         moreover have "S.iso (S.\<Phi> (f, f'))"
           using assms left_adjoint_is_ide by simp
         ultimately show ?thesis
           using S.isomorphic_def by blast
       qed
       ultimately have "S.is_left_adjoint (S.UP (f \<star> f'))"
         using S.left_adjoint_preserved_by_iso S.isomorphic_def by blast
       thus "is_left_adjoint (f \<star> f')"
         using assms left_adjoint_is_ide UP.reflects_left_adjoint by simp
     qed
 
     lemma right_adjoints_compose:
     assumes "is_right_adjoint g" and "is_right_adjoint g'" and "src g' = trg g"
     shows "is_right_adjoint (g' \<star> g)"
     proof -
       have "S.is_right_adjoint (S.UP g) \<and> S.is_right_adjoint (S.UP g')"
         using assms UP.preserves_right_adjoint by simp
       moreover have "S.src (S.UP g') = S.trg (S.UP g)"
         using assms right_adjoint_is_ide by simp
       ultimately have "S.is_right_adjoint (S.hcomp (S.UP g') (S.UP g))"
         using S.right_adjoints_compose by simp
       moreover have "S.isomorphic (S.hcomp (S.UP g') (S.UP g)) (S.UP (g' \<star> g))"
       proof -
         have "\<guillemotleft>S.\<Phi> (g', g) : S.hcomp (S.UP g') (S.UP g) \<Rightarrow>\<^sub>S S.UP (g' \<star> g)\<guillemotright>"
           using assms right_adjoint_is_ide UP.\<Phi>_in_hom by simp
         moreover have "S.iso (S.\<Phi> (g', g))"
           using assms right_adjoint_is_ide by simp
         ultimately show ?thesis
           using S.isomorphic_def by blast
       qed
       ultimately have "S.is_right_adjoint (S.UP (g' \<star> g))"
         using S.right_adjoint_preserved_by_iso S.isomorphic_def by blast
       thus "is_right_adjoint (g' \<star> g)"
         using assms right_adjoint_is_ide UP.reflects_right_adjoint by simp
     qed
 
   end
 
   subsection "Choosing Right Adjoints"
 
   text \<open>
     It will be useful in various situations to suppose that we have made a choice of
     right adjoint for each left adjoint ({\it i.e.} each ``map'') in a bicategory.
   \<close>
 
   locale chosen_right_adjoints =
     bicategory
   begin
 
     (* Global notation is evil! *)
     no_notation Transitive_Closure.rtrancl  ("(_\<^sup>*)" [1000] 999)
 
     definition some_right_adjoint  ("_\<^sup>*" [1000] 1000)
     where "f\<^sup>* \<equiv> SOME g. adjoint_pair f g"
 
     definition some_unit
     where "some_unit f \<equiv> SOME \<eta>. \<exists>\<epsilon>. adjunction_in_bicategory V H \<a> \<i> src trg f f\<^sup>* \<eta> \<epsilon>"
 
     definition some_counit
     where "some_counit f \<equiv>
            SOME \<epsilon>. adjunction_in_bicategory V H \<a> \<i> src trg f f\<^sup>* (some_unit f) \<epsilon>"
 
     lemma left_adjoint_extends_to_adjunction:
     assumes "is_left_adjoint f"
     shows "adjunction_in_bicategory V H \<a> \<i> src trg f f\<^sup>* (some_unit f) (some_counit f)"
       using assms some_right_adjoint_def adjoint_pair_def some_unit_def some_counit_def
             someI_ex [of "\<lambda>g. adjoint_pair f g"]
             someI_ex [of "\<lambda>\<eta>. \<exists>\<epsilon>. adjunction_in_bicategory V H \<a> \<i> src trg f f\<^sup>* \<eta> \<epsilon>"]
             someI_ex [of "\<lambda>\<epsilon>. adjunction_in_bicategory V H \<a> \<i> src trg f f\<^sup>* (some_unit f) \<epsilon>"]
       by auto
 
     lemma left_adjoint_extends_to_adjoint_pair:
     assumes "is_left_adjoint f"
     shows "adjoint_pair f f\<^sup>*"
       using assms adjoint_pair_def left_adjoint_extends_to_adjunction by blast
 
     lemma right_adjoint_in_hom [intro]:
     assumes "is_left_adjoint f"
     shows "\<guillemotleft>f\<^sup>* : trg f \<rightarrow> src f\<guillemotright>"
     and "\<guillemotleft>f\<^sup>* : f\<^sup>* \<Rightarrow> f\<^sup>*\<guillemotright>"
       using assms left_adjoint_extends_to_adjoint_pair adjoint_pair_antipar [of f "f\<^sup>*"]
       by auto
 
     lemma right_adjoint_simps [simp]:
     assumes "is_left_adjoint f"
     shows "ide f\<^sup>*"
     and "src f\<^sup>* = trg f" and "trg f\<^sup>* = src f"
     and "dom f\<^sup>* = f\<^sup>*" and "cod f\<^sup>* = f\<^sup>*"
       using assms right_adjoint_in_hom left_adjoint_extends_to_adjoint_pair apply auto
       using assms right_adjoint_is_ide [of "f\<^sup>*"] by blast
 
   end
 
   locale map_in_bicategory =
     bicategory + chosen_right_adjoints +
   fixes f :: 'a
   assumes is_map: "is_left_adjoint f"
   begin
 
     abbreviation \<eta>
       where "\<eta> \<equiv> some_unit f"
 
     abbreviation \<epsilon>
       where "\<epsilon> \<equiv> some_counit f"
 
     sublocale adjunction_in_bicategory V H \<a> \<i> src trg f \<open>f\<^sup>*\<close> \<eta> \<epsilon>
       using is_map left_adjoint_extends_to_adjunction by simp
 
   end
 
   subsection "Equivalences Refine to Adjoint Equivalences"
 
   text \<open>
     In this section, we show that, just as an equivalence between categories can always
     be refined to an adjoint equivalence, an internal equivalence in a bicategory can also
     always be so refined.
     The proof, which follows that of Theorem 3.3 from \cite{nlab-adjoint-equivalence},
     makes use of the fact that if an internal equivalence satisfies one of the triangle
     identities, then it also satisfies the other.
   \<close>
 
   locale adjoint_equivalence_in_bicategory =
     equivalence_in_bicategory +
     adjunction_in_bicategory
   begin
 
     lemma dual_adjoint_equivalence:
     shows "adjoint_equivalence_in_bicategory V H \<a> \<i> src trg g f (inv \<epsilon>) (inv \<eta>)"
     proof -
       interpret gf: equivalence_in_bicategory V H \<a> \<i> src trg g f \<open>inv \<epsilon>\<close> \<open>inv \<eta>\<close>
         using dual_equivalence by simp
       show ?thesis
       proof
         show "(inv \<eta> \<star> g) \<cdot> \<a>\<^sup>-\<^sup>1[g, f, g] \<cdot> (g \<star> inv \<epsilon>) = \<l>\<^sup>-\<^sup>1[g] \<cdot> \<r>[g]"
         proof -
           have "(inv \<eta> \<star> g) \<cdot> \<a>\<^sup>-\<^sup>1[g, f, g] \<cdot> (g \<star> inv \<epsilon>) =
                 inv ((g \<star> \<epsilon>) \<cdot> \<a>[g, f, g] \<cdot> (\<eta> \<star> g))"
             using antipar inv_comp iso_inv_iso isos_compose comp_assoc by simp
           also have "... = inv (\<r>\<^sup>-\<^sup>1[g] \<cdot> \<l>[g])"
             using triangle_right by simp
           also have "... = \<l>\<^sup>-\<^sup>1[g] \<cdot> \<r>[g]"
             using iso_inv_iso inv_comp by simp
           finally show ?thesis
             by blast
         qed
         show "(f \<star> inv \<eta>) \<cdot> \<a>[f, g, f] \<cdot> (inv \<epsilon> \<star> f) = \<r>\<^sup>-\<^sup>1[f] \<cdot> \<l>[f]"
         proof -
           have "(f \<star> inv \<eta>) \<cdot> \<a>[f, g, f] \<cdot> (inv \<epsilon> \<star> f) =
                 inv ((\<epsilon> \<star> f) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f] \<cdot> (f \<star> \<eta>))"
             using antipar inv_comp iso_inv_iso isos_compose comp_assoc by simp
           also have "... = inv (\<l>\<^sup>-\<^sup>1[f] \<cdot> \<r>[f])"
             using triangle_left by simp
           also have "... = \<r>\<^sup>-\<^sup>1[f] \<cdot> \<l>[f]"
             using iso_inv_iso inv_comp by simp
           finally show ?thesis by blast
         qed
       qed
     qed
 
   end
 
   context strict_bicategory
   begin
 
     lemma equivalence_refines_to_adjoint_equivalence:
     assumes "equivalence_map f" and "\<guillemotleft>g : trg f \<rightarrow> src f\<guillemotright>" and "ide g"
     and "\<guillemotleft>\<eta> : src f \<Rightarrow> g \<star> f\<guillemotright>" and "iso \<eta>"
     shows "\<exists>!\<epsilon>. adjoint_equivalence_in_bicategory V H \<a> \<i> src trg f g \<eta> \<epsilon>"
     proof -
       obtain g' \<eta>' \<epsilon>' where E': "equivalence_in_bicategory V H \<a> \<i> src trg f g' \<eta>' \<epsilon>'"
         using assms equivalence_map_def by auto
       interpret E': equivalence_in_bicategory V H \<a> \<i> src trg f g' \<eta>' \<epsilon>'
         using E' by auto
       let ?a = "src f" and ?b = "trg f"
       (* TODO: in_homE cannot be applied automatically to a conjunction.  Must break down! *)
       have f_in_hhom: "\<guillemotleft>f : ?a \<rightarrow> ?b\<guillemotright>" and ide_f: "ide f"
         using assms equivalence_map_def by auto
       have g_in_hhom: "\<guillemotleft>g : ?b \<rightarrow> ?a\<guillemotright>" and ide_g: "ide g"
         using assms by auto
       have g'_in_hhom: "\<guillemotleft>g' : ?b \<rightarrow> ?a\<guillemotright>" and ide_g': "ide g'"
         using assms f_in_hhom E'.antipar by auto
       have \<eta>_in_hom: "\<guillemotleft>\<eta> : ?a \<Rightarrow> g \<star> f\<guillemotright>" and iso_\<eta>: "iso \<eta>"
         using assms by auto
       have a: "obj ?a" and b: "obj ?b"
         using f_in_hhom by auto
       have \<eta>_in_hhom: "\<guillemotleft>\<eta> : ?a \<rightarrow> ?a\<guillemotright>"
         using a src_dom trg_dom \<eta>_in_hom by fastforce
       text \<open>
         The following is quoted from \cite{nlab-adjoint-equivalence}:
         \begin{quotation}
           ``Since \<open>g \<cong> gfg' \<cong> g'\<close>, the isomorphism \<open>fg' \<cong> 1\<close> also induces an isomorphism \<open>fg \<cong> 1\<close>,
           which we denote \<open>\<xi>\<close>.  Now \<open>\<eta>\<close> and \<open>\<xi>\<close> may not satisfy the zigzag identities, but if we
           define \<open>\<epsilon>\<close> by \<open>\<xi> \<cdot> (f \<star> \<eta>\<^sup>-\<^sup>1) \<cdot> (f \<star> g \<star> \<xi>\<^sup>-\<^sup>1) : f \<star> g \<Rightarrow> 1\<close>, then we can verify,
           using string diagram notation as above,
           that \<open>\<epsilon>\<close> satisfies one zigzag identity, and hence (by the previous lemma) also the other.
 
           Finally, if \<open>\<epsilon>': fg \<Rightarrow> 1\<close> is any other isomorphism satisfying the zigzag identities
           with \<open>\<eta>\<close>, then we have:
           \[
               \<open>\<epsilon>' = \<epsilon>' \<cdot> (\<epsilon> f g) \<cdot> (f \<eta> g) = \<epsilon> \<cdot> (f g \<epsilon>') \<cdot> (f \<eta> g) = \<epsilon>\<close>
           \]
           using the interchange law and two zigzag identities.  This shows uniqueness.''
         \end{quotation}
       \<close>
       have 1: "isomorphic g g'"
       proof -
         have "isomorphic g (g \<star> ?b)"
           using assms hcomp_arr_obj isomorphic_reflexive by auto
         also have "isomorphic ... (g \<star> f \<star> g')"
           using assms f_in_hhom g_in_hhom g'_in_hhom E'.counit_in_vhom E'.counit_is_iso
                 isomorphic_def hcomp_ide_isomorphic isomorphic_symmetric
           by (metis E'.counit_simps(5) in_hhomE trg_trg)
         also have "isomorphic ... (?a \<star> g')"
           using assms f_in_hhom g_in_hhom g'_in_hhom ide_g' E'.unit_in_vhom E'.unit_is_iso
                 isomorphic_def hcomp_isomorphic_ide isomorphic_symmetric
           by (metis hcomp_assoc hcomp_isomorphic_ide in_hhomE src_src)
         also have "isomorphic ... g'"
           using assms
           by (simp add: E'.antipar(1) hcomp_obj_arr isomorphic_reflexive)
         finally show ?thesis by blast
       qed
       moreover have "isomorphic (f \<star> g') ?b"
         using E'.counit_is_iso isomorphicI [of \<epsilon>'] by auto
       hence 2: "isomorphic (f \<star> g) ?b"
         using assms 1 ide_f hcomp_ide_isomorphic [of f g g'] isomorphic_transitive
               isomorphic_symmetric
         by (metis in_hhomE)
       obtain \<xi> where \<xi>: "\<guillemotleft>\<xi> : f \<star> g \<Rightarrow> ?b\<guillemotright> \<and> iso \<xi>"
         using 2 by auto
       have \<xi>_in_hom: "\<guillemotleft>\<xi> : f \<star> g \<Rightarrow> ?b\<guillemotright>" and iso_\<xi>: "iso \<xi>"
         using \<xi> by auto
       have \<xi>_in_hhom: "\<guillemotleft>\<xi> : ?b \<rightarrow> ?b\<guillemotright>"
         using b src_cod trg_cod \<xi>_in_hom by fastforce
       text \<open>
         At the time of this writing, the definition of \<open>\<epsilon>\<close> given on nLab
         \cite{nlab-adjoint-equivalence} had an apparent typo:
         the expression \<open>f \<star> g \<star> \<xi>\<^sup>-\<^sup>1\<close> should read \<open>\<xi>\<^sup>-\<^sup>1 \<star> f \<star> g\<close>, as we have used here.
       \<close>
       let ?\<epsilon> = "\<xi> \<cdot> (f \<star> inv \<eta> \<star> g) \<cdot> (inv \<xi> \<star> f \<star> g)"
       have \<epsilon>_in_hom: "\<guillemotleft>?\<epsilon> : f \<star> g \<Rightarrow> ?b\<guillemotright>"
       proof -
         have "\<guillemotleft>f \<star> inv \<eta> \<star> g : f \<star> g \<star> f \<star> g \<Rightarrow> f \<star> g\<guillemotright>"
         proof -
           have "\<guillemotleft>inv \<eta> : g \<star> f \<Rightarrow> ?a\<guillemotright>"
             using \<eta>_in_hom iso_\<eta> by auto
           hence "\<guillemotleft>f \<star> inv \<eta> \<star> g : f \<star> (g \<star> f) \<star> g \<Rightarrow> f \<star> ?a \<star> g\<guillemotright>"
             using assms by (intro hcomp_in_vhom, auto)
           hence "\<guillemotleft>f \<star> inv \<eta> \<star> g : f \<star> (g \<star> f) \<star> g \<Rightarrow> f \<star> g\<guillemotright>"
             using assms f_in_hhom hcomp_obj_arr by (metis in_hhomE)
           moreover have "f \<star> (g \<star> f) \<star> g = f \<star> g \<star> f \<star> g"
             using hcomp_assoc by simp
           ultimately show ?thesis by simp
         qed
         moreover have "\<guillemotleft>inv \<xi> \<star> f \<star> g : f \<star> g \<Rightarrow> f \<star> g \<star> f \<star> g\<guillemotright>"
         proof -
           have "\<guillemotleft>inv \<xi> \<star> f \<star> g : ?b \<star> f \<star> g \<Rightarrow> (f \<star> g) \<star> f \<star> g\<guillemotright>"
             using assms \<xi>_in_hom iso_\<xi> by (intro hcomp_in_vhom, auto)
           moreover have "(f \<star> g) \<star> f \<star> g = f \<star> g \<star> f \<star> g"
             using hcomp_assoc by simp
           moreover have "?b \<star> f \<star> g = f \<star> g"
             using f_in_hhom g_in_hhom b hcomp_obj_arr [of ?b "f \<star> g"] by fastforce
           ultimately show ?thesis by simp
         qed
         ultimately show "\<guillemotleft>?\<epsilon> : f \<star> g \<Rightarrow> ?b\<guillemotright>"
           using \<xi>_in_hom by blast
       qed
       have "iso ?\<epsilon>"
         using f_in_hhom g_in_hhom \<eta>_in_hhom ide_f ide_g \<eta>_in_hom iso_\<eta> \<xi>_in_hhom \<xi>_in_hom iso_\<xi>
               iso_inv_iso isos_compose
         by (metis \<epsilon>_in_hom arrI hseqE ide_is_iso iso_hcomp seqE)
       have 4: "\<guillemotleft>inv \<xi> \<star> f : ?b \<star> f \<Rightarrow> f \<star> g \<star> f\<guillemotright>"
       proof -
         have "\<guillemotleft>inv \<xi> \<star> f : ?b \<star> f \<Rightarrow> (f \<star> g) \<star> f\<guillemotright>"
           using \<xi>_in_hom iso_\<xi> f_in_hhom
           by (intro hcomp_in_vhom, auto)
         thus ?thesis
           using hcomp_assoc by simp
       qed
       text \<open>
         First show \<open>?\<epsilon>\<close> and \<open>\<eta>\<close> satisfy the ``left'' triangle identity.
       \<close>
       have triangle_left: "(?\<epsilon> \<star> f) \<cdot> (f \<star> \<eta>) = f"
       proof -
         have "(?\<epsilon> \<star> f) \<cdot> (f \<star> \<eta>) = (\<xi> \<star> f) \<cdot> (f \<star> inv \<eta> \<star> g \<star> f) \<cdot> (inv \<xi> \<star> f \<star> g \<star> f) \<cdot> (?b \<star> f \<star> \<eta>)"
         proof -
           have "f \<star> \<eta> = ?b \<star> f \<star> \<eta>"
             using b \<eta>_in_hhom hcomp_obj_arr [of ?b "f \<star> \<eta>"] by fastforce
           moreover have "\<xi> \<cdot> (f \<star> inv \<eta> \<star> g) \<cdot> (inv \<xi> \<star> f \<star> g) \<star> f =
                          (\<xi> \<star> f) \<cdot> ((f \<star> inv \<eta> \<star> g) \<star> f) \<cdot> ((inv \<xi> \<star> f \<star> g) \<star> f)"
             using ide_f ide_g \<xi>_in_hhom \<xi>_in_hom iso_\<xi> \<eta>_in_hhom \<eta>_in_hom iso_\<eta> whisker_right
             by (metis \<epsilon>_in_hom arrI in_hhomE seqE)
           moreover have "... = (\<xi> \<star> f) \<cdot> (f \<star> inv \<eta> \<star> g \<star> f) \<cdot> (inv \<xi> \<star> f \<star> g \<star> f)"
             using hcomp_assoc by simp
           ultimately show ?thesis
             using comp_assoc by simp
         qed
         also have "... = (\<xi> \<star> f) \<cdot> ((f \<star> inv \<eta> \<star> g \<star> f) \<cdot> (f \<star> g \<star> f \<star> \<eta>)) \<cdot> (inv \<xi> \<star> f)"
         proof -
           have "((inv \<xi> \<star> f) \<star> (g \<star> f)) \<cdot> ((?b \<star> f) \<star> \<eta>) = (inv \<xi> \<star> f) \<cdot> (?b \<star> f) \<star> (g \<star> f) \<cdot> \<eta>"
           proof -
             have "seq (inv \<xi> \<star> f) (?b \<star> f)"
               using a b 4 ide_f ide_g \<xi>_in_hhom \<xi>_in_hom iso_\<xi> \<eta>_in_hhom \<eta>_in_hom iso_\<eta>
               by blast
             moreover have "seq (g \<star> f) \<eta>"
               using f_in_hhom g_in_hhom ide_g ide_f \<eta>_in_hom by fast
             ultimately show ?thesis
               using interchange [of "inv \<xi> \<star> f" "?b \<star> f" "g \<star> f" \<eta>] by simp
           qed
           also have "... = inv \<xi> \<star> f \<star> \<eta>"
           proof -
             have "(inv \<xi> \<star> f) \<cdot> (?b \<star> f) = inv \<xi> \<star> f"
               using 4 comp_arr_dom by auto
             moreover have "(g \<star> f) \<cdot> \<eta> = \<eta>"
               using \<eta>_in_hom comp_cod_arr by auto
             ultimately show ?thesis
               using hcomp_assoc by simp
           qed
           also have "... = (f \<star> g) \<cdot> inv \<xi> \<star> (f \<star> \<eta>) \<cdot> (f \<star> ?a)"
           proof -
             have "(f \<star> g) \<cdot> inv \<xi> = inv \<xi>"
               using \<xi>_in_hom iso_\<xi> comp_cod_arr by auto
             moreover have "(f \<star> \<eta>) \<cdot> (f \<star> ?a) = f \<star> \<eta>"
             proof -
               have "\<guillemotleft>f \<star> \<eta> : f \<star> ?a \<Rightarrow> f \<star> g \<star> f\<guillemotright>"
                 using \<eta>_in_hom by fastforce
               thus ?thesis
                 using comp_arr_dom by blast
             qed
             ultimately show ?thesis by argo
           qed
           also have "... = ((f \<star> g) \<star> (f \<star> \<eta>)) \<cdot> (inv \<xi> \<star> (f \<star> ?a))"
           proof -
             have "seq (f \<star> g) (inv \<xi>)"
               using \<xi>_in_hom iso_\<xi> comp_cod_arr by auto
             moreover have "seq (f \<star> \<eta>) (f \<star> ?a)"
               using f_in_hhom \<eta>_in_hom by force
             ultimately show ?thesis
               using interchange by simp
           qed
           also have "... = (f \<star> g \<star> f \<star> \<eta>) \<cdot> (inv \<xi> \<star> f)"
             using hcomp_arr_obj hcomp_assoc by auto
           finally have "((inv \<xi> \<star> f) \<star> (g \<star> f)) \<cdot> ((?b \<star> f) \<star> \<eta>) = (f \<star> g \<star> f \<star> \<eta>) \<cdot> (inv \<xi> \<star> f)"
             by simp
           thus ?thesis
             using comp_assoc hcomp_assoc by simp
         qed
         also have "... = (\<xi> \<star> f) \<cdot> ((f \<star> ?a \<star> \<eta>) \<cdot> (f \<star> inv \<eta> \<star> ?a)) \<cdot> (inv \<xi> \<star> f)"
         proof -
           have "(f \<star> inv \<eta> \<star> g \<star> f) \<cdot> (f \<star> (g \<star> f) \<star> \<eta>) = f \<star> (inv \<eta> \<star> g \<star> f) \<cdot> ((g \<star> f) \<star> \<eta>)"
           proof -
             have "seq ((inv \<eta> \<star> g) \<star> f) ((g \<star> f) \<star> \<eta>)"
             proof -
               have "seq (inv \<eta> \<star> g \<star> f) ((g \<star> f) \<star> \<eta>)"
                 using f_in_hhom ide_f g_in_hhom ide_g \<eta>_in_hhom \<eta>_in_hom iso_\<eta>
                 apply (intro seqI)
                   apply blast
                  apply blast
                 by fastforce
               thus ?thesis
                 using hcomp_assoc by simp
             qed
             hence "(f \<star> (inv \<eta> \<star> g) \<star> f) \<cdot> (f \<star> (g \<star> f) \<star> \<eta>) =
                              f \<star> ((inv \<eta> \<star> g) \<star> f) \<cdot> ((g \<star> f) \<star> \<eta>)"
               using whisker_left by simp
             thus ?thesis
               using hcomp_assoc by simp
           qed
           also have "... = f \<star> (?a \<star> \<eta>) \<cdot> (inv \<eta> \<star> ?a)"
           proof -
             have "(inv \<eta> \<star> g \<star> f) \<cdot> ((g \<star> f) \<star> \<eta>) = (?a \<star> \<eta>) \<cdot> (inv \<eta> \<star> ?a)"
             proof -
               have "(inv \<eta> \<star> g \<star> f) \<cdot> ((g \<star> f) \<star> \<eta>) = inv \<eta> \<cdot> (g \<star> f) \<star> (g \<star> f) \<cdot> \<eta>"
               proof -
                 have "seq (inv \<eta>) (g \<star> f)"
                   using g_in_hhom ide_g \<eta>_in_hom iso_\<eta> by force                  
                 moreover have "seq (g \<star> f) \<eta>"
                   using g_in_hhom ide_g \<eta>_in_hom by fastforce
                 ultimately show ?thesis
                   using interchange by fastforce
               qed
               also have "... = inv \<eta> \<star> \<eta>"
                 using \<eta>_in_hom iso_\<eta> comp_arr_dom comp_cod_arr by auto
               also have "... = ?a \<cdot> inv \<eta> \<star> \<eta> \<cdot> ?a"
                 using \<eta>_in_hom iso_\<eta> comp_arr_dom comp_cod_arr by auto
               also have "... = (?a \<star> \<eta>) \<cdot> (inv \<eta> \<star> ?a)"
               proof -
                 have "seq ?a (inv \<eta>)"
                   using a \<eta>_in_hom iso_\<eta> ideD [of ?a] by (elim objE, auto)
                 moreover have "seq \<eta> ?a"
                   using a \<eta>_in_hom by fastforce
                 ultimately show ?thesis
                   using interchange by blast
               qed
               finally show ?thesis by simp
             qed
             thus ?thesis by argo
           qed
           also have "... = (f \<star> ?a \<star> \<eta>) \<cdot> (f \<star> inv \<eta> \<star> ?a)"
           proof -
             have "seq (?a \<star> \<eta>) (inv \<eta> \<star> ?a)"
             proof (intro seqI')
               show "\<guillemotleft>inv \<eta> \<star> ?a : (g \<star> f) \<star> ?a \<Rightarrow> ?a \<star> ?a\<guillemotright>"
                 using a g_in_hhom \<eta>_in_hom iso_\<eta> hseqI ide_f ide_g
                 apply (elim in_homE in_hhomE, intro hcomp_in_vhom)
                 by auto
               show "\<guillemotleft>?a \<star> \<eta> : ?a \<star> ?a \<Rightarrow> ?a \<star> g \<star> f\<guillemotright>"
                 using a \<eta>_in_hom hseqI by (intro hcomp_in_vhom, auto)
             qed
             thus ?thesis
               using whisker_left by simp
           qed
           finally show ?thesis
             using hcomp_assoc by simp
         qed
         also have "... = (\<xi> \<star> f) \<cdot> ((f \<star> \<eta>) \<cdot> (f \<star> inv \<eta>)) \<cdot> (inv \<xi> \<star> f)"
           using a \<eta>_in_hhom iso_\<eta> hcomp_obj_arr [of ?a \<eta>] hcomp_arr_obj [of "inv \<eta>" ?a] by auto
         also have "... = (\<xi> \<star> f) \<cdot> (inv \<xi> \<star> f)"
         proof -
           have "(f \<star> \<eta>) \<cdot> (f \<star> inv \<eta>) = f \<star> \<eta> \<cdot> inv \<eta>"
             using \<eta>_in_hhom iso_\<eta> whisker_left inv_in_hom by auto
           moreover have "f \<star> \<eta> \<cdot> inv \<eta> = f \<star> g \<star> f"
             using \<eta>_in_hom iso_\<eta> comp_arr_inv inv_is_inverse by auto
           moreover have "(f \<star> g \<star> f) \<cdot> (inv \<xi> \<star> f) = inv \<xi> \<star> f"
           proof -
             have "\<guillemotleft>inv \<xi> \<star> f : ?b \<star> f \<Rightarrow> f \<star> g \<star> f\<guillemotright>"
             proof -
               have "\<guillemotleft>inv \<xi> \<star> f : ?b \<star> f \<Rightarrow> (f \<star> g) \<star> f\<guillemotright>"
                 using \<xi>_in_hom iso_\<xi> by (intro hcomp_in_vhom, auto)
               thus ?thesis
                 using hcomp_assoc by simp
             qed
             moreover have "f \<star> g \<star> f = cod (inv \<xi> \<star> f)"
               using \<xi>_in_hhom iso_\<xi> hcomp_assoc calculation by auto
             ultimately show ?thesis
               using comp_cod_arr by auto
           qed
           ultimately show ?thesis by simp
         qed
         also have "... = ?b \<star> f"
         proof -
           have "(\<xi> \<star> f) \<cdot> (inv \<xi> \<star> f) = \<xi> \<cdot> inv \<xi> \<star> f"
             using \<xi>_in_hhom iso_\<xi> whisker_right by auto
           moreover have "\<xi> \<cdot> inv \<xi> = ?b"
             using \<xi>_in_hom iso_\<xi> comp_arr_inv inv_is_inverse by auto
           ultimately show ?thesis by simp
         qed
         also have "... = f"
           using hcomp_obj_arr by auto
         finally show ?thesis by blast
       qed
 
       (* TODO: Putting this earlier breaks some steps in the proof. *)
       interpret E: equivalence_in_strict_bicategory V H \<a> \<i> src trg f g \<eta> ?\<epsilon>
         using ide_g \<eta>_in_hom \<epsilon>_in_hom g_in_hhom `iso \<eta>` `iso ?\<epsilon>`
         by (unfold_locales, auto)
 
       text \<open>
         Apply ``triangle left if and only iff right'' to show the ``right'' triangle identity.
       \<close>
       have triangle_right: "((g \<star> \<xi> \<cdot> (f \<star> inv \<eta> \<star> g) \<cdot> (inv \<xi> \<star> f \<star> g)) \<cdot> (\<eta> \<star> g) = g)"
         using triangle_left E.triangle_left_iff_right by simp
 
       text \<open>
         Use the two triangle identities to establish an adjoint equivalence and show that
         there is only one choice for the counit.
       \<close>
       show "\<exists>!\<epsilon>. adjoint_equivalence_in_bicategory V H \<a> \<i> src trg f g \<eta> \<epsilon>"
       proof -
         have "adjoint_equivalence_in_bicategory V H \<a> \<i> src trg f g \<eta> ?\<epsilon>"
         proof
           show "(?\<epsilon> \<star> f) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f] \<cdot> (f \<star> \<eta>) = \<l>\<^sup>-\<^sup>1[f] \<cdot> \<r>[f]"
           proof -
             have "(?\<epsilon> \<star> f) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f] \<cdot> (f \<star> \<eta>) = (?\<epsilon> \<star> f) \<cdot> (f \<star> \<eta>)"
             proof -
               have "seq \<a>\<^sup>-\<^sup>1[f, g, f] (f \<star> \<eta>)"
                 using E.antipar
                 by (intro seqI, auto)
               hence "\<a>\<^sup>-\<^sup>1[f, g, f] \<cdot> (f \<star> \<eta>) = f \<star> \<eta>"
                 using ide_f ide_g E.antipar triangle_right strict_assoc' comp_ide_arr
                 by presburger
               thus ?thesis by simp
             qed
             also have "... = f"
               using triangle_left by simp
             also have "... = \<l>\<^sup>-\<^sup>1[f] \<cdot> \<r>[f]"
               using strict_lunit strict_runit by simp
             finally show ?thesis by simp
           qed
           show "(g \<star> ?\<epsilon>) \<cdot> \<a>[g, f, g] \<cdot> (\<eta> \<star> g) = \<r>\<^sup>-\<^sup>1[g] \<cdot> \<l>[g]"
           proof -
             have "(g \<star> ?\<epsilon>) \<cdot> \<a>[g, f, g] \<cdot> (\<eta> \<star> g) = (g \<star> ?\<epsilon>) \<cdot> (\<eta> \<star> g)"
             proof -
               have "seq \<a>[g, f, g] (\<eta> \<star> g)"
                 using E.antipar
                 by (intro seqI, auto)
               hence "\<a>[g, f, g] \<cdot> (\<eta> \<star> g) = \<eta> \<star> g"
                 using ide_f ide_g E.antipar triangle_right strict_assoc comp_ide_arr
                 by presburger
               thus ?thesis by simp
             qed
             also have "... = g"
               using triangle_right by simp
             also have "... = \<r>\<^sup>-\<^sup>1[g] \<cdot> \<l>[g]"
               using strict_lunit strict_runit by simp
             finally show ?thesis by blast
           qed
         qed
         moreover have "\<And>\<epsilon> \<epsilon>'. \<lbrakk> adjoint_equivalence_in_bicategory (\<cdot>) (\<star>) \<a> \<i> src trg f g \<eta> \<epsilon>;
                                 adjoint_equivalence_in_bicategory (\<cdot>) (\<star>) \<a> \<i> src trg f g \<eta> \<epsilon>' \<rbrakk>
                                    \<Longrightarrow> \<epsilon> = \<epsilon>'"
           using adjunction_unit_determines_counit
           by (meson adjoint_equivalence_in_bicategory.axioms(2))
         ultimately show ?thesis by auto
       qed
     qed
 
   end
 
   text \<open>
     We now apply strictification to generalize the preceding result to an arbitrary bicategory.
   \<close>
 
   context bicategory
   begin
 
     interpretation S: strictified_bicategory V H \<a> \<i> src trg ..
 
     notation S.vcomp  (infixr "\<cdot>\<^sub>S" 55)
     notation S.hcomp  (infixr "\<star>\<^sub>S" 53)
     notation S.in_hom  ("\<guillemotleft>_ : _ \<Rightarrow>\<^sub>S _\<guillemotright>")
     notation S.in_hhom  ("\<guillemotleft>_ : _ \<rightarrow>\<^sub>S _\<guillemotright>")
 
     interpretation UP: fully_faithful_functor V S.vcomp S.UP
       using S.UP_is_fully_faithful_functor by auto
     interpretation UP: equivalence_pseudofunctor V H \<a> \<i> src trg
                           S.vcomp S.hcomp S.\<a> S.\<i> S.src S.trg S.UP S.\<Phi>
       using S.UP_is_equivalence_pseudofunctor by auto
     interpretation UP: pseudofunctor_into_strict_bicategory V H \<a> \<i> src trg
                           S.vcomp S.hcomp S.\<a> S.\<i> S.src S.trg S.UP S.\<Phi>
       ..
 
     lemma equivalence_refines_to_adjoint_equivalence:
     assumes "equivalence_map f" and "\<guillemotleft>g : trg f \<rightarrow> src f\<guillemotright>" and "ide g"
     and "\<guillemotleft>\<eta> : src f \<Rightarrow> g \<star> f\<guillemotright>" and "iso \<eta>"
     shows "\<exists>!\<epsilon>. adjoint_equivalence_in_bicategory V H \<a> \<i> src trg f g \<eta> \<epsilon>"
     proof -
       text \<open>
         To unpack the consequences of the assumptions, we need to obtain an
         interpretation of @{locale equivalence_in_bicategory}, even though we don't
         need the associated data other than \<open>f\<close>, \<open>a\<close>, and \<open>b\<close>.
       \<close>
       obtain g' \<phi> \<psi> where E: "equivalence_in_bicategory V H \<a> \<i> src trg f g' \<phi> \<psi>"
         using assms equivalence_map_def by auto
       interpret E: equivalence_in_bicategory V H \<a> \<i> src trg f g' \<phi> \<psi>
         using E by auto
       let ?a = "src f" and ?b = "trg f"
       have ide_f: "ide f" by simp
       have f_in_hhom: "\<guillemotleft>f : ?a \<rightarrow> ?b\<guillemotright>" by simp
       have a: "obj ?a" and b: "obj ?b" by auto
       have 1: "S.equivalence_map (S.UP f)"
         using assms UP.preserves_equivalence_maps by simp
       let ?\<eta>' = "S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta> \<cdot>\<^sub>S UP.\<Psi> ?a"
       have 2: "\<guillemotleft>S.UP \<eta> : S.UP ?a \<Rightarrow>\<^sub>S S.UP (g \<star> f)\<guillemotright>"
         using assms UP.preserves_hom [of \<eta> "src f" "g \<star> f"] by auto
       have 4: "\<guillemotleft>?\<eta>' : UP.map\<^sub>0 ?a \<Rightarrow>\<^sub>S S.UP g \<star>\<^sub>S S.UP f\<guillemotright> \<and> S.iso ?\<eta>'"
       proof (intro S.comp_in_homI conjI)
         have 3: "S.iso (S.\<Phi> (g, f))"
           using assms UP.\<Phi>_components_are_iso by auto
         show "\<guillemotleft>S.inv (S.\<Phi> (g, f)) : S.UP (g \<star> f) \<Rightarrow>\<^sub>S S.UP g \<star>\<^sub>S S.UP f\<guillemotright>"
           using assms 3 UP.\<Phi>_in_hom(2) [of g f] UP.FF_def by auto
         moreover show "\<guillemotleft>UP.\<Psi> ?a : UP.map\<^sub>0 ?a \<Rightarrow>\<^sub>S S.UP ?a\<guillemotright>" by auto
         moreover show "\<guillemotleft>S.UP \<eta> : S.UP ?a \<Rightarrow>\<^sub>S S.UP (g \<star> f)\<guillemotright>"
           using 2 by simp
         ultimately show "S.iso (S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta> \<cdot>\<^sub>S UP.\<Psi> ?a)"
           using assms 3 a UP.\<Psi>_char(2) S.iso_inv_iso
           apply (intro S.isos_compose) by auto
       qed
       have ex_un_\<xi>': "\<exists>!\<xi>'. adjoint_equivalence_in_bicategory S.vcomp S.hcomp S.\<a> S.\<i> S.src S.trg
                                (S.UP f) (S.UP g) ?\<eta>' \<xi>'"
       proof -
         have "\<guillemotleft>S.UP g : S.trg (S.UP f) \<rightarrow>\<^sub>S S.src (S.UP f)\<guillemotright>"
           using assms(2) by auto
         moreover have "S.ide (S.UP g)"
           by (simp add: assms(3))
         ultimately show ?thesis
           using 1 4 S.equivalence_refines_to_adjoint_equivalence S.UP_map\<^sub>0_obj by simp
       qed
       obtain \<xi>' where \<xi>': "adjoint_equivalence_in_bicategory S.vcomp S.hcomp S.\<a> S.\<i> S.src S.trg
                              (S.UP f) (S.UP g) ?\<eta>' \<xi>'"
         using ex_un_\<xi>' by auto
       interpret E': adjoint_equivalence_in_bicategory S.vcomp S.hcomp S.\<a> S.\<i> S.src S.trg
                       \<open>S.UP f\<close> \<open>S.UP g\<close> ?\<eta>' \<xi>'
         using \<xi>' by auto
       let ?\<epsilon>' = "UP.\<Psi> ?b \<cdot>\<^sub>S \<xi>' \<cdot>\<^sub>S S.inv (S.\<Phi> (f, g))"
       have \<epsilon>': "\<guillemotleft>?\<epsilon>' : S.UP (f \<star> g) \<Rightarrow>\<^sub>S S.UP ?b\<guillemotright>"
         using assms(2-3) S.UP_map\<^sub>0_obj apply (intro S.in_homI) by auto
       have ex_un_\<epsilon>: "\<exists>!\<epsilon>. \<guillemotleft>\<epsilon> : f \<star> g \<Rightarrow> ?b\<guillemotright> \<and> S.UP \<epsilon> = ?\<epsilon>'"
       proof -
         have "\<exists>\<epsilon>. \<guillemotleft>\<epsilon> : f \<star> g \<Rightarrow> ?b\<guillemotright> \<and> S.UP \<epsilon> = ?\<epsilon>'"
         proof -
           have "src (f \<star> g) = src ?b \<and> trg (f \<star> g) = trg ?b"
           proof -
             have "arr (f \<star> g)"
               using assms(2) f_in_hhom by blast
             thus ?thesis
               using assms(2) f_in_hhom by (elim hseqE, auto)
           qed
           moreover have "ide (f \<star> g)"
             using assms(2-3) by auto
           ultimately show ?thesis
             using \<epsilon>' UP.locally_full by auto
         qed
         moreover have
           "\<And>\<mu> \<nu>. \<lbrakk> \<guillemotleft>\<mu> : f \<star> g \<Rightarrow> ?b\<guillemotright>; S.UP \<mu> = ?\<epsilon>'; \<guillemotleft>\<nu> : f \<star> g \<Rightarrow> ?b\<guillemotright>; S.UP \<nu> = ?\<epsilon>' \<rbrakk>
                      \<Longrightarrow> \<mu> = \<nu>"
         proof -
           fix \<mu> \<nu>
           assume \<mu>: "\<guillemotleft>\<mu> : f \<star> g \<Rightarrow> ?b\<guillemotright>" and \<nu>: "\<guillemotleft>\<nu> : f \<star> g \<Rightarrow> ?b\<guillemotright>"
           and 1: "S.UP \<mu> = ?\<epsilon>'" and 2: "S.UP \<nu> = ?\<epsilon>'"
           have "par \<mu> \<nu>"
             using \<mu> \<nu> by fastforce
           thus "\<mu> = \<nu>"
             using 1 2 UP.is_faithful [of \<mu> \<nu>] by simp
         qed
         ultimately show ?thesis by auto
       qed
       have iso_\<epsilon>': "S.iso ?\<epsilon>'"
       proof (intro S.isos_compose)
         show "S.iso (S.inv (S.\<Phi> (f, g)))"
           using assms UP.\<Phi>_components_are_iso S.iso_inv_iso by auto
         show "S.iso \<xi>'"
           using E'.counit_is_iso by blast
         show "S.iso (UP.\<Psi> ?b)"
           using b UP.\<Psi>_char(2) by simp
         show "S.seq (UP.\<Psi> ?b) (\<xi>' \<cdot>\<^sub>S S.inv (S.\<Phi> (f, g)))"
         proof (intro S.seqI')
           show "\<guillemotleft>UP.\<Psi> ?b : UP.map\<^sub>0 ?b \<Rightarrow>\<^sub>S S.UP ?b\<guillemotright>"
             using b UP.\<Psi>_char by simp
           show "\<guillemotleft>\<xi>' \<cdot>\<^sub>S S.inv (S.\<Phi> (f, g)) : S.UP (f \<star> g) \<Rightarrow>\<^sub>S UP.map\<^sub>0 ?b\<guillemotright>"
             using assms UP.\<Phi>_components_are_iso VV.arr_char S.\<Phi>_in_hom [of "(f, g)"]
                   E'.counit_in_hom S.UP_map\<^sub>0_obj
             apply (intro S.comp_in_homI) by auto
         qed
         thus "S.seq \<xi>' (S.inv (S.\<Phi> (f, g)))" by auto
       qed
       obtain \<epsilon> where \<epsilon>: "\<guillemotleft>\<epsilon> : f \<star> g \<Rightarrow> ?b\<guillemotright> \<and> S.UP \<epsilon> = ?\<epsilon>'"
         using ex_un_\<epsilon> by auto
       interpret E'': equivalence_in_bicategory V H \<a> \<i> src trg f g \<eta> \<epsilon>
         using assms(1,3-5)
         apply unfold_locales
              apply simp_all
         using assms(2) \<epsilon>
          apply auto[1]
         using \<epsilon> iso_\<epsilon>' UP.reflects_iso [of \<epsilon>]
         by auto
       interpret E'': adjoint_equivalence_in_bicategory V H \<a> \<i> src trg f g \<eta> \<epsilon>
       proof
         show "(\<epsilon> \<star> f) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f] \<cdot> (f \<star> \<eta>) = \<l>\<^sup>-\<^sup>1[f] \<cdot> \<r>[f]"
         proof -
           have "S.UP ((\<epsilon> \<star> f) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f] \<cdot> (f \<star> \<eta>)) =
                 S.\<Phi> (trg f, f) \<cdot>\<^sub>S (S.UP \<epsilon> \<cdot>\<^sub>S S.\<Phi> (f, g) \<star>\<^sub>S S.UP f) \<cdot>\<^sub>S
                   (S.UP f \<star>\<^sub>S S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta>) \<cdot>\<^sub>S S.inv (S.\<Phi> (f, src f))"
             using E''.UP_triangle(3) by simp
           also have
             "... = S.\<Phi> (trg f, f) \<cdot>\<^sub>S (UP.\<Psi> ?b \<cdot>\<^sub>S \<xi>' \<cdot>\<^sub>S S.inv (S.\<Phi> (f, g)) \<cdot>\<^sub>S S.\<Phi> (f, g) \<star>\<^sub>S S.UP f) \<cdot>\<^sub>S
                      (S.UP f \<star>\<^sub>S S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta>) \<cdot>\<^sub>S S.inv (S.\<Phi> (f, src f))"
             using \<epsilon> S.comp_assoc by simp
           also have "... = S.\<Phi> (trg f, f) \<cdot>\<^sub>S (UP.\<Psi> ?b \<cdot>\<^sub>S \<xi>' \<star>\<^sub>S S.UP f) \<cdot>\<^sub>S
                              (S.UP f \<star>\<^sub>S S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta>) \<cdot>\<^sub>S S.inv (S.\<Phi> (f, src f))"
           proof -
             have "\<xi>' \<cdot>\<^sub>S S.inv (S.\<Phi> (f, g)) \<cdot>\<^sub>S S.\<Phi> (f, g) = \<xi>'"
             proof -
               have "S.iso (S.\<Phi> (f, g))"
                 using assms by auto
               moreover have "S.dom (S.\<Phi> (f, g)) = S.UP f \<star>\<^sub>S S.UP g"
                 using assms by auto
               ultimately have "S.inv (S.\<Phi> (f, g)) \<cdot>\<^sub>S S.\<Phi> (f, g) = S.UP f \<star>\<^sub>S S.UP g"
                 using S.comp_inv_arr' by simp
               thus ?thesis
                 using S.comp_arr_dom E'.counit_in_hom(2) by simp
             qed
             thus ?thesis by argo
           qed
           also have
             "... = S.\<Phi> (trg f, f) \<cdot>\<^sub>S (UP.\<Psi> ?b \<star>\<^sub>S S.UP f) \<cdot>\<^sub>S
                      ((\<xi>' \<star>\<^sub>S S.UP f) \<cdot>\<^sub>S (S.UP f \<star>\<^sub>S S.inv (S.\<Phi> (g, f))) \<cdot>\<^sub>S (S.UP f \<star>\<^sub>S S.UP \<eta>)) \<cdot>\<^sub>S
                      S.inv (S.\<Phi> (f, src f))"
           proof -
             have "UP.\<Psi> ?b \<cdot>\<^sub>S \<xi>' \<star>\<^sub>S S.UP f = (UP.\<Psi> ?b \<star>\<^sub>S S.UP f) \<cdot>\<^sub>S (\<xi>' \<star>\<^sub>S S.UP f)"
               using assms b UP.\<Psi>_char S.whisker_right S.UP_map\<^sub>0_obj by auto
             moreover have "S.UP f \<star>\<^sub>S S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta> =
                            (S.UP f \<star>\<^sub>S S.inv (S.\<Phi> (g, f))) \<cdot>\<^sub>S (S.UP f \<star>\<^sub>S S.UP \<eta>)"
               using assms S.whisker_left S.comp_assoc by auto
             ultimately show ?thesis
               using S.comp_assoc by simp
           qed
           also have "... = (S.\<Phi> (trg f, f) \<cdot>\<^sub>S (UP.\<Psi> ?b \<star>\<^sub>S S.UP f)) \<cdot>\<^sub>S
                              (S.UP f \<star>\<^sub>S S.inv (UP.\<Psi> (src f))) \<cdot>\<^sub>S S.inv (S.\<Phi> (f, src f))"
           proof -
             have "(\<xi>' \<star>\<^sub>S S.UP f) \<cdot>\<^sub>S (S.UP f \<star>\<^sub>S S.inv (S.\<Phi> (g, f))) \<cdot>\<^sub>S (S.UP f \<star>\<^sub>S S.UP \<eta>) =
                   (S.UP f \<star>\<^sub>S S.inv (UP.\<Psi> (src f)))"
             proof -
               have "(S.UP f \<star>\<^sub>S S.inv (S.\<Phi> (g, f))) \<cdot>\<^sub>S (S.UP f \<star>\<^sub>S S.UP \<eta>) =
                       S.UP f \<star>\<^sub>S S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta>"
                 using assms S.whisker_left by auto
               hence "((\<xi>' \<star>\<^sub>S S.UP f) \<cdot>\<^sub>S (S.UP f \<star>\<^sub>S S.inv (S.\<Phi> (g, f))) \<cdot>\<^sub>S (S.UP f \<star>\<^sub>S S.UP \<eta>)) =
                      ((\<xi>' \<star>\<^sub>S S.UP f) \<cdot>\<^sub>S (S.UP f \<star>\<^sub>S S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta>))"
                 by simp
               also have "... = ((\<xi>' \<star>\<^sub>S S.UP f) \<cdot>\<^sub>S S.\<a>' (S.UP f) (S.UP g) (S.UP f)) \<cdot>\<^sub>S
                                  (S.UP f \<star>\<^sub>S S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta>)"
               proof -
                 have "(\<xi>' \<star>\<^sub>S S.UP f) \<cdot>\<^sub>S S.\<a>' (S.UP f) (S.UP g) (S.UP f) = \<xi>' \<star>\<^sub>S S.UP f"
                 proof -
                   have "\<guillemotleft>\<xi>' \<star>\<^sub>S S.UP f :
                           (S.UP f \<star>\<^sub>S S.UP g) \<star>\<^sub>S S.UP f \<Rightarrow>\<^sub>S S.trg (S.UP f) \<star>\<^sub>S S.UP f\<guillemotright>"
                     using assms by (intro S.hcomp_in_vhom, auto)
                   moreover have "\<guillemotleft>S.\<a>' (S.UP f) (S.UP g) (S.UP f) :
                                     S.UP f \<star>\<^sub>S S.UP g \<star>\<^sub>S S.UP f \<Rightarrow>\<^sub>S (S.UP f \<star>\<^sub>S S.UP g) \<star>\<^sub>S S.UP f\<guillemotright>"
                     using assms S.assoc'_in_hom by auto
                   ultimately show ?thesis
                     using assms S.strict_assoc' S.iso_assoc S.hcomp_assoc E'.antipar
                           S.comp_arr_ide S.seqI'
                     by (metis (no_types, lifting) E'.ide_left E'.ide_right)
                 qed
                 thus ?thesis
                   using S.comp_assoc by simp
               qed
               also have "... = ((\<xi>' \<star>\<^sub>S S.UP f) \<cdot>\<^sub>S S.\<a>' (S.UP f) (S.UP g) (S.UP f) \<cdot>\<^sub>S
                                  (S.UP f \<star>\<^sub>S S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta>))"
                 using S.comp_assoc by simp
               also have "... = (S.UP f \<star>\<^sub>S S.inv (UP.\<Psi> (src f)))"
               proof -
                 have "(\<xi>' \<star>\<^sub>S S.UP f) \<cdot>\<^sub>S S.\<a>' (S.UP f) (S.UP g) (S.UP f) \<cdot>\<^sub>S
                         (S.UP f \<star>\<^sub>S S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta>) =
                       (S.UP f \<star>\<^sub>S S.inv (UP.\<Psi> (src f)))"
                 proof -
                   have "(\<xi>' \<star>\<^sub>S S.UP f) \<cdot>\<^sub>S S.\<a>' (S.UP f) (S.UP g) (S.UP f) \<cdot>\<^sub>S
                           (S.UP f \<star>\<^sub>S S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta>) \<cdot>\<^sub>S
                           (S.UP f \<star>\<^sub>S UP.\<Psi> ?a) =
                         S.lunit' (S.UP f) \<cdot>\<^sub>S S.runit (S.UP f)"
                   proof -
                     have "(\<xi>' \<star>\<^sub>S S.UP f) \<cdot>\<^sub>S S.\<a>' (S.UP f) (S.UP g) (S.UP f) \<cdot>\<^sub>S
                             (S.UP f \<star>\<^sub>S S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta>) \<cdot>\<^sub>S
                             (S.UP f \<star>\<^sub>S UP.\<Psi> ?a) =
                           (\<xi>' \<star>\<^sub>S S.UP f) \<cdot>\<^sub>S S.\<a>' (S.UP f) (S.UP g) (S.UP f) \<cdot>\<^sub>S
                             (S.UP f \<star>\<^sub>S S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta> \<cdot>\<^sub>S UP.\<Psi> ?a)"
                     proof -
                       have "S.seq (S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta>) (UP.\<Psi> ?a)"
                         using assms UP.\<Psi>_char UP.\<Phi>_components_are_iso
                               E'.unit_simps(1) S.comp_assoc
                         by presburger 
                       hence "(S.UP f \<star>\<^sub>S S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta>) \<cdot>\<^sub>S (S.UP f \<star>\<^sub>S UP.\<Psi> ?a) =
                              S.UP f \<star>\<^sub>S S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta> \<cdot>\<^sub>S UP.\<Psi> ?a"
                         using assms UP.\<Psi>_char UP.\<Phi>_components_are_iso S.comp_assoc
                               S.whisker_left [of "S.UP f" "S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta>" "UP.\<Psi> ?a"]
                         by simp
                       thus ?thesis by simp
                     qed
                     thus ?thesis
                       using assms E'.triangle_left UP.\<Phi>_components_are_iso UP.\<Psi>_char
                       by argo
                   qed
                   also have "... = S.UP f"
                     using S.strict_lunit' S.strict_runit by simp
                   finally have 1: "((\<xi>' \<star>\<^sub>S S.UP f) \<cdot>\<^sub>S S.\<a>' (S.UP f) (S.UP g) (S.UP f) \<cdot>\<^sub>S
                                      (S.UP f \<star>\<^sub>S S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta>)) \<cdot>\<^sub>S
                                      (S.UP f \<star>\<^sub>S UP.\<Psi> ?a) = S.UP f"
                     using S.comp_assoc by simp
                   have "(\<xi>' \<star>\<^sub>S S.UP f) \<cdot>\<^sub>S S.\<a>' (S.UP f) (S.UP g) (S.UP f) \<cdot>\<^sub>S
                            (S.UP f \<star>\<^sub>S S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta>) =
                          S.UP f \<cdot>\<^sub>S (S.UP f \<star>\<^sub>S S.inv (UP.\<Psi> ?a))"
                   proof -
                     have "S.arr (S.UP f)"
                       using assms by simp
                     moreover have "S.iso (S.UP f \<star>\<^sub>S UP.\<Psi> ?a)"
                       using assms UP.\<Psi>_char S.UP_map\<^sub>0_obj by auto
                     moreover have "S.inv (S.UP f \<star>\<^sub>S UP.\<Psi> ?a) = S.UP f \<star>\<^sub>S S.inv (UP.\<Psi> ?a)"
                       using assms a UP.\<Psi>_char S.UP_map\<^sub>0_obj by auto
                     ultimately show ?thesis
                       using assms 1 UP.\<Psi>_char UP.\<Phi>_components_are_iso
                             S.invert_side_of_triangle(2)
                               [of "S.UP f" "(\<xi>' \<star>\<^sub>S S.UP f) \<cdot>\<^sub>S S.\<a>' (S.UP f) (S.UP g) (S.UP f) \<cdot>\<^sub>S
                                               (S.UP f \<star>\<^sub>S S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta>)"
                                   "S.UP f \<star>\<^sub>S UP.\<Psi> ?a"]
                       by presburger
                   qed
                   also have "... = S.UP f \<star>\<^sub>S S.inv (UP.\<Psi> ?a)"
                   proof -
                     have "\<guillemotleft>S.UP f \<star>\<^sub>S S.inv (UP.\<Psi> ?a) :
                              S.UP f \<star>\<^sub>S S.UP ?a \<Rightarrow>\<^sub>S S.UP f \<star>\<^sub>S UP.map\<^sub>0 ?a\<guillemotright>"
                       using assms ide_f f_in_hhom UP.\<Psi>_char [of ?a] S.inv_in_hom
                       apply (intro S.hcomp_in_vhom)
                         apply auto[1]
                        apply blast
                       by auto
                     moreover have "S.UP f \<star>\<^sub>S UP.map\<^sub>0 ?a = S.UP f"
                       using a S.hcomp_arr_obj S.UP_map\<^sub>0_obj by auto
                     finally show ?thesis
                       using S.comp_cod_arr by blast
                   qed
                   finally show ?thesis by auto
                 qed
                 thus ?thesis
                   using S.comp_assoc by simp
               qed
               finally show ?thesis by simp
             qed
             thus ?thesis
               using S.comp_assoc by simp
           qed
           also have "... = S.UP \<l>\<^sup>-\<^sup>1[f] \<cdot>\<^sub>S S.UP \<r>[f]"
           proof -
              have "S.\<Phi> (trg f, f) \<cdot>\<^sub>S (UP.\<Psi> ?b \<star>\<^sub>S S.UP f) = S.UP \<l>\<^sup>-\<^sup>1[f]"
              proof -
                have "S.UP f = S.UP \<l>[f] \<cdot>\<^sub>S S.\<Phi> (trg f, f) \<cdot>\<^sub>S (UP.\<Psi> (trg f) \<star>\<^sub>S S.UP f)"
                  using UP.lunit_coherence iso_lunit S.strict_lunit by simp
                thus ?thesis
                  using UP.image_of_unitor(3) ide_f by presburger
              qed
              moreover have "(S.UP f \<star>\<^sub>S S.inv (UP.\<Psi> (src f))) \<cdot>\<^sub>S S.inv (S.\<Phi> (f, src f)) =
                             S.UP \<r>[f]"
              proof -
                have "S.UP \<r>[f] \<cdot>\<^sub>S S.\<Phi> (f, src f) \<cdot>\<^sub>S (S.UP f \<star>\<^sub>S UP.\<Psi> (src f)) = S.UP f"
                  using UP.runit_coherence [of f] S.strict_runit by simp
                moreover have "S.iso (S.\<Phi> (f, src f) \<cdot>\<^sub>S (S.UP f \<star>\<^sub>S UP.\<Psi> (src f)))"
                  using UP.\<Psi>_char UP.\<Phi>_components_are_iso VV.arr_char S.UP_map\<^sub>0_obj
                  apply (intro S.isos_compose S.seqI)
                  by simp_all
                ultimately have
                  "S.UP \<r>[f] = S.UP f \<cdot>\<^sub>S S.inv (S.\<Phi> (f, src f) \<cdot>\<^sub>S (S.UP f \<star>\<^sub>S UP.\<Psi> (src f)))"
                  using S.invert_side_of_triangle(2)
                          [of "S.UP f" "S.UP \<r>[f]" "S.\<Phi> (f, src f) \<cdot>\<^sub>S (S.UP f \<star>\<^sub>S UP.\<Psi> (src f))"]
                        ideD(1) ide_f by blast
                thus ?thesis
                  using ide_f UP.image_of_unitor(2) [of f] by argo
              qed
              ultimately show ?thesis
                using S.comp_assoc by simp
           qed
           also have "... = S.UP (\<l>\<^sup>-\<^sup>1[f] \<cdot> \<r>[f])"
             by simp
           finally have "S.UP ((\<epsilon> \<star> f) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f] \<cdot> (f \<star> \<eta>)) = S.UP (\<l>\<^sup>-\<^sup>1[f] \<cdot> \<r>[f])"
             by simp
           moreover have "par ((\<epsilon> \<star> f) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f] \<cdot> (f \<star> \<eta>)) (\<l>\<^sup>-\<^sup>1[f] \<cdot> \<r>[f])"
           proof -
             have "\<guillemotleft>(\<epsilon> \<star> f) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f] \<cdot> (f \<star> \<eta>) : f \<star> src f \<Rightarrow> trg f \<star> f\<guillemotright>"
               using E''.triangle_in_hom(1) by simp
             moreover have "\<guillemotleft>\<l>\<^sup>-\<^sup>1[f] \<cdot> \<r>[f] : f \<star> src f \<Rightarrow> trg f \<star> f\<guillemotright>" by auto
             ultimately show ?thesis
               by (metis in_homE)
           qed
           ultimately show ?thesis
             using UP.is_faithful by blast
         qed
         thus "(g \<star> \<epsilon>) \<cdot> \<a>[g, f, g] \<cdot> (\<eta> \<star> g) = \<r>\<^sup>-\<^sup>1[g] \<cdot> \<l>[g]"
           using E''.triangle_left_implies_right by simp
       qed
       show ?thesis
         using E''.adjoint_equivalence_in_bicategory_axioms E''.adjunction_in_bicategory_axioms
              adjunction_unit_determines_counit adjoint_equivalence_in_bicategory_def
         by metis
     qed
 
     lemma equivalence_map_extends_to_adjoint_equivalence:
     assumes "equivalence_map f"
     shows "\<exists>g \<eta> \<epsilon>. adjoint_equivalence_in_bicategory V H \<a> \<i> src trg f g \<eta> \<epsilon>"
     proof -
       obtain g \<eta> \<epsilon>' where E: "equivalence_in_bicategory V H \<a> \<i> src trg f g \<eta> \<epsilon>'"
         using assms equivalence_map_def by auto
       interpret E: equivalence_in_bicategory V H \<a> \<i> src trg f g \<eta> \<epsilon>'
         using E by auto
       obtain \<epsilon> where A: "adjoint_equivalence_in_bicategory V H \<a> \<i> src trg f g \<eta> \<epsilon>"
         using assms equivalence_refines_to_adjoint_equivalence [of f g \<eta>]
               E.antipar E.unit_is_iso E.unit_in_hom by auto
       show ?thesis
         using E A by blast
     qed
 
   end
 
   subsection "Uniqueness of Adjoints"
 
   text \<open>
     Left and right adjoints determine each other up to isomorphism.
   \<close>
 
   context strict_bicategory
   begin
 
     lemma left_adjoint_determines_right_up_to_iso:
     assumes "adjoint_pair f g" and "adjoint_pair f g'"
     shows "g \<cong> g'"
     proof -
       obtain \<eta> \<epsilon> where A: "adjunction_in_bicategory V H \<a> \<i> src trg f g \<eta> \<epsilon>"
         using assms adjoint_pair_def by auto
       interpret A: adjunction_in_bicategory V H \<a> \<i> src trg f g \<eta> \<epsilon>
         using A by auto
       interpret A: adjunction_in_strict_bicategory V H \<a> \<i> src trg f g \<eta> \<epsilon> ..
       obtain \<eta>' \<epsilon>' where A': "adjunction_in_bicategory V H \<a> \<i> src trg f g' \<eta>' \<epsilon>'"
         using assms adjoint_pair_def by auto
       interpret A': adjunction_in_bicategory V H \<a> \<i> src trg f g' \<eta>' \<epsilon>'
         using A' by auto
       interpret A': adjunction_in_strict_bicategory V H \<a> \<i> src trg f g' \<eta>' \<epsilon>' ..
       let ?\<phi> = "A'.trnl\<^sub>\<eta> g \<epsilon>"
       have "\<guillemotleft>?\<phi>: g \<Rightarrow> g'\<guillemotright>"
         using A'.trnl\<^sub>\<eta>_eq A'.adjoint_transpose_left(1) [of "trg f" g] A.antipar A'.antipar
               hcomp_arr_obj
         by auto
       moreover have "iso ?\<phi>"
       proof (intro isoI)
         let ?\<psi> = "A.trnl\<^sub>\<eta> g' \<epsilon>'"
         show "inverse_arrows ?\<phi> ?\<psi>"
         proof
           show "ide (?\<phi> \<cdot> ?\<psi>)"
           proof -
             have 1: "ide (trg f) \<and> trg (trg f) = trg f"
               by simp
             have "?\<phi> \<cdot> ?\<psi> = (g' \<star> \<epsilon>) \<cdot> ((\<eta>' \<star> g) \<cdot> (g \<star> \<epsilon>')) \<cdot> (\<eta> \<star> g')"
               using 1 A.antipar A'.antipar A.trnl\<^sub>\<eta>_eq [of "trg f" g' \<epsilon>']
                     A'.trnl\<^sub>\<eta>_eq [of "trg f" g \<epsilon>] comp_assoc A.counit_in_hom A'.counit_in_hom
               by simp
             also have "... = ((g' \<star> \<epsilon>) \<cdot> (g' \<star> f \<star> g \<star> \<epsilon>')) \<cdot> ((\<eta>' \<star> g \<star> f \<star> g') \<cdot> (\<eta> \<star> g'))"
             proof -
               have "(\<eta>' \<star> g) \<cdot> (g \<star> \<epsilon>') = (\<eta>' \<star> g \<star> trg f) \<cdot> (src f \<star> g \<star> \<epsilon>')"
                 using A.antipar A'.antipar hcomp_arr_obj hcomp_obj_arr [of "src f" "g \<star> \<epsilon>'"]
                       hseqI'
                 by (metis A'.counit_simps(1) A'.counit_simps(5) A.ide_right ideD(1)
                     obj_trg trg_hcomp)
               also have "... = \<eta>' \<star> g \<star> \<epsilon>'"
                 using A.antipar A'.antipar interchange [of \<eta>' "src f" "g \<star> trg f" "g \<star> \<epsilon>'"]
                       whisker_left comp_arr_dom comp_cod_arr
                 by simp
               also have "... = ((g' \<star> f) \<star> g \<star> \<epsilon>') \<cdot> (\<eta>' \<star> g \<star> (f \<star> g'))"
                 using A.ide_left A.ide_right A'.ide_right A.antipar A'.antipar
                       A'.unit_in_hom A'.counit_in_hom interchange whisker_left
                       comp_arr_dom comp_cod_arr
                 by (metis A'.counit_simps(1-2,5) A'.unit_simps(1,3) hseqI' ide_char)
               also have "... = (g' \<star> f \<star> g \<star> \<epsilon>') \<cdot> (\<eta>' \<star> g \<star> f \<star> g')"
                 using hcomp_assoc by simp
               finally show ?thesis
                 using comp_assoc by simp
             qed
             also have "... = (g' \<star> \<epsilon>') \<cdot> ((g' \<star> (\<epsilon> \<star> f) \<star> g') \<cdot> (g' \<star> (f \<star> \<eta>) \<star> g')) \<cdot> (\<eta>' \<star> g')"
             proof -
               have "(g' \<star> \<epsilon>) \<cdot> (g' \<star> f \<star> g \<star> \<epsilon>') = (g' \<star> \<epsilon>') \<cdot> (g' \<star> \<epsilon> \<star> f \<star> g')"
               proof -
                 have "(g' \<star> \<epsilon>) \<cdot> (g' \<star> f \<star> g \<star> \<epsilon>') = g' \<star> \<epsilon> \<star> \<epsilon>'"
                 proof -
                   have "\<epsilon> \<cdot> (f \<star> g \<star> \<epsilon>') = \<epsilon> \<star> \<epsilon>'"
                     using A.ide_left A.ide_right A.antipar A'.antipar hcomp_arr_obj comp_arr_dom
                       comp_cod_arr interchange obj_src trg_src
                     by (metis A'.counit_simps(1,3) A.counit_simps(1-2,4) hcomp_assoc)
                   thus ?thesis
                     using A.antipar A'.antipar whisker_left [of g' \<epsilon> "f \<star> g \<star> \<epsilon>'"]
                     by (simp add: hcomp_assoc)
                 qed
                 also have "... = (g' \<star> \<epsilon>') \<cdot> (g' \<star> \<epsilon> \<star> f \<star> g')"
                 proof -
                   have "\<epsilon> \<star> \<epsilon>' = \<epsilon>' \<cdot> (\<epsilon> \<star> f \<star> g')"
                     using A.ide_left A.ide_right A'.ide_right A.antipar A'.antipar
                           hcomp_obj_arr hcomp_arr_obj comp_arr_dom comp_cod_arr interchange
                           obj_src trg_src
                     by (metis A'.counit_simps(1-2,5) A.counit_simps(1,3-4) arr_cod
                         not_arr_null seq_if_composable)
                   thus ?thesis
                     using A.ide_left A.ide_right A'.ide_right A.antipar A'.antipar
                           whisker_left
                     by (metis A'.counit_simps(1,5) A.counit_simps(1,4) hseqI')
                 qed
                 finally show ?thesis by simp
               qed
               moreover have "(\<eta>' \<star> g \<star> f \<star> g') \<cdot> (\<eta> \<star> g') = (g' \<star> f \<star> \<eta> \<star> g') \<cdot> (\<eta>' \<star> g')"
               proof -
                 have "(\<eta>' \<star> g \<star> f \<star> g') \<cdot> (\<eta> \<star> g') = \<eta>' \<star> \<eta> \<star> g'"
                 proof -
                   have "(\<eta>' \<star> g \<star> f) \<cdot> \<eta> = \<eta>' \<star> \<eta>"
                     using A.ide_left A.ide_right A.antipar A'.antipar A'.unit_in_hom hcomp_arr_obj
                           interchange comp_arr_dom comp_cod_arr
                     by (metis A'.unit_simps(1-2,4) A.unit_simps(1,3,5) hcomp_obj_arr obj_trg)
                   thus ?thesis
                     using A.antipar A'.antipar whisker_right [of g' "\<eta>' \<star> g \<star> f" \<eta>]
                     by (simp add: hcomp_assoc)
                 qed
                 also have "... = (g' \<star> f \<star> \<eta> \<star> g') \<cdot> (\<eta>' \<star> g')"
                 proof -
                   have "\<eta>' \<star> \<eta> = (g' \<star> f \<star> \<eta>) \<cdot> \<eta>'"
                     using A.ide_left A.ide_right A.antipar A'.antipar A'.unit_in_hom hcomp_arr_obj
                           comp_arr_dom comp_cod_arr hcomp_assoc interchange
                     by (metis A'.unit_simps(1,3-4) A.unit_simps(1-2) obj_src)
                   thus ?thesis
                     using A.ide_left A.ide_right A.antipar A'.antipar A'.unit_in_hom hcomp_arr_obj
                           whisker_right [of g' "g' \<star> f \<star> \<eta>" \<eta>']
                     by (metis A'.ide_right A'.unit_simps(1,4) A.unit_simps(1,5)
                         hseqI' hcomp_assoc)
                 qed
                 finally show ?thesis by simp
               qed
               ultimately show ?thesis
                 using comp_assoc hcomp_assoc by simp
             qed
             also have "... = (g' \<star> \<epsilon>') \<cdot> ((g' \<star> f) \<star> g') \<cdot> (\<eta>' \<star> g')"
             proof -
               have "(g' \<star> (\<epsilon> \<star> f) \<star> g') \<cdot> (g' \<star> (f \<star> \<eta>) \<star> g') = g' \<star> f \<star> g'"
               proof -
                 have "(g' \<star> (\<epsilon> \<star> f) \<star> g') \<cdot> (g' \<star> (f \<star> \<eta>) \<star> g') =
                       g' \<star> ((\<epsilon> \<star> f) \<star> g') \<cdot> ((f \<star> \<eta>) \<star> g')"
                   using A.ide_left A.ide_right A.antipar A'.antipar A'.unit_in_hom
                         A'.counit_in_hom whisker_left [of g' "(\<epsilon> \<star> f) \<star> g'" "(f \<star> \<eta>) \<star> g'"]
                   by (metis A'.ide_right A.triangle_left hseqI' ideD(1) whisker_right)
                 also have "... = g' \<star> (\<epsilon> \<star> f) \<cdot> (f \<star> \<eta>) \<star> g'"
                   using A.antipar A'.antipar whisker_right [of g' "\<epsilon> \<star> f" "f \<star> \<eta>"]
                   by (simp add: A.triangle_left)
                 also have "... = g' \<star> f \<star> g'"
                   using A.triangle_left by simp
                 finally show ?thesis by simp
               qed
               thus ?thesis
                 using hcomp_assoc by simp
             qed
             also have "... = (g' \<star> \<epsilon>') \<cdot> (\<eta>' \<star> g')"
               using A.antipar A'.antipar A'.unit_in_hom A'.counit_in_hom comp_cod_arr
               by (metis A'.ide_right A'.triangle_in_hom(2) A.ide_left arrI assoc_is_natural_2
                   ide_char seqE strict_assoc)
             also have "... = g'"
               using A'.triangle_right by simp
             finally have "?\<phi> \<cdot> ?\<psi> = g'" by simp
             thus ?thesis by simp
           qed
           show "ide (?\<psi> \<cdot> ?\<phi>)"
           proof -
             have 1: "ide (trg f) \<and> trg (trg f) = trg f"
               by simp
             have "?\<psi> \<cdot> ?\<phi> = (g \<star> \<epsilon>') \<cdot> ((\<eta> \<star> g') \<cdot> (g' \<star> \<epsilon>)) \<cdot> (\<eta>' \<star> g)"
               using A.antipar A'.antipar A'.trnl\<^sub>\<eta>_eq [of "trg f" g \<epsilon>]
                     A.trnl\<^sub>\<eta>_eq [of "trg f" g' \<epsilon>'] comp_assoc A.counit_in_hom A'.counit_in_hom
               by simp
             also have "... = ((g \<star> \<epsilon>') \<cdot> (g \<star> f \<star> g' \<star> \<epsilon>)) \<cdot> ((\<eta> \<star> g' \<star> f \<star> g) \<cdot> (\<eta>' \<star> g))"
             proof -
               have "(\<eta> \<star> g') \<cdot> (g' \<star> \<epsilon>) = (\<eta> \<star> g' \<star> trg f) \<cdot> (src f \<star> g' \<star> \<epsilon>)"
                 using A.antipar A'.antipar hcomp_arr_obj hcomp_obj_arr hseqI'
                 by (metis A'.ide_right A.unit_simps(1,4) hcomp_assoc hcomp_obj_arr
                     ideD(1) obj_src)
               also have "... = \<eta> \<star> g' \<star> \<epsilon>"
                 using A.ide_left A.ide_right A'.ide_right A.antipar A'.antipar A.unit_in_hom
                       A.counit_in_hom interchange
                 by (metis "1" A.counit_simps(5) A.unit_simps(4) hseqI' ide_def ide_in_hom(2)
                     not_arr_null seqI' src.preserves_ide)
               also have "... = ((g \<star> f) \<star> g' \<star> \<epsilon>) \<cdot> (\<eta> \<star> g' \<star> (f \<star> g))"
                 using A'.ide_right A'.antipar interchange ide_char comp_arr_dom comp_cod_arr hseqI'
                 by (metis A.counit_simps(1-2,5) A.unit_simps(1,3))
               also have "... = (g \<star> f \<star> g' \<star> \<epsilon>) \<cdot> (\<eta> \<star> g' \<star> f \<star> g)"
                 using hcomp_assoc by simp
               finally show ?thesis
                 using comp_assoc by simp
             qed
             also have "... = (g \<star> \<epsilon>) \<cdot> ((g \<star> (\<epsilon>' \<star> f) \<star> g) \<cdot> (g \<star> (f \<star> \<eta>') \<star> g)) \<cdot> (\<eta> \<star> g)"
             proof -
               have "(g \<star> \<epsilon>') \<cdot> (g \<star> f \<star> g' \<star> \<epsilon>) = (g \<star> \<epsilon>) \<cdot> (g \<star> \<epsilon>' \<star> f \<star> g)"
               proof -
                 have "(g \<star> \<epsilon>') \<cdot> (g \<star> f \<star> g' \<star> \<epsilon>) = g \<star> \<epsilon>' \<star> \<epsilon>"
                 proof -
                   have "\<epsilon>' \<cdot> (f \<star> g' \<star> \<epsilon>) = \<epsilon>' \<star> \<epsilon>"
                     using A.ide_left A.ide_right A'.ide_right A.antipar A'.antipar hcomp_arr_obj
                           comp_arr_dom comp_cod_arr interchange obj_src trg_src hcomp_assoc
                     by (metis A.counit_simps(1,3) A'.counit_simps(1-2,4))
                   thus ?thesis
                     using A.antipar A'.antipar whisker_left [of g \<epsilon>' "f \<star> g' \<star> \<epsilon>"]
                     by (simp add: hcomp_assoc)
                 qed
                 also have "... = (g \<star> \<epsilon>) \<cdot> (g \<star> \<epsilon>' \<star> f \<star> g)"
                 proof -
                   have "\<epsilon>' \<star> \<epsilon> = \<epsilon> \<cdot> (\<epsilon>' \<star> f \<star> g)"
                     using A.ide_left A.ide_right A'.ide_right A.antipar A'.antipar hcomp_obj_arr
                           hcomp_arr_obj comp_arr_dom comp_cod_arr interchange obj_src trg_src
                     by (metis A.counit_simps(1-2,5) A'.counit_simps(1,3-4)
                         arr_cod not_arr_null seq_if_composable)
                   thus ?thesis
                     using A.ide_left A.ide_right A'.ide_right A.antipar A'.antipar
                           whisker_left
                     by (metis A.counit_simps(1,5) A'.counit_simps(1,4) hseqI')
                 qed
                 finally show ?thesis by simp
               qed
               moreover have "(\<eta> \<star> g' \<star> f \<star> g) \<cdot> (\<eta>' \<star> g) = (g \<star> f \<star> \<eta>' \<star> g) \<cdot> (\<eta> \<star> g)"
               proof -
                 have "(\<eta> \<star> g' \<star> f \<star> g) \<cdot> (\<eta>' \<star> g) = \<eta> \<star> \<eta>' \<star> g"
                 proof -
                   have "(\<eta> \<star> g' \<star> f) \<cdot> \<eta>' = \<eta> \<star> \<eta>'"
                     using A.antipar A'.antipar A.unit_in_hom hcomp_arr_obj
                           comp_arr_dom comp_cod_arr hcomp_obj_arr interchange
                     by (metis A'.unit_simps(1,3,5) A.unit_simps(1-2,4) obj_trg)
                   thus ?thesis
                     using A.antipar A'.antipar whisker_right [of g "\<eta> \<star> g' \<star> f" \<eta>']
                     by (simp add: hcomp_assoc)
                 qed
                 also have "... = ((g \<star> f) \<star> \<eta>' \<star> g) \<cdot> (\<eta> \<star> src f \<star> g)"
                   using A.ide_left A.ide_right A'.ide_right A.antipar A'.antipar A.unit_in_hom
                         A'.unit_in_hom comp_arr_dom comp_cod_arr interchange
                   by (metis A'.unit_simps(1-2,4) A.unit_simps(1,3) hseqI' ide_char)
                 also have "... = (g \<star> f \<star> \<eta>' \<star> g) \<cdot> (\<eta> \<star> g)"
                   using A.antipar A'.antipar hcomp_assoc
                   by (simp add: hcomp_obj_arr)
                 finally show ?thesis by simp
               qed
               ultimately show ?thesis
                 using comp_assoc hcomp_assoc by simp
             qed
             also have "... = (g \<star> \<epsilon>) \<cdot> ((g \<star> f) \<star> g) \<cdot> (\<eta> \<star> g)"
             proof -
               have "(g \<star> (\<epsilon>' \<star> f) \<star> g) \<cdot> (g \<star> (f \<star> \<eta>') \<star> g) = g \<star> f \<star> g"
               proof -
                 have "(g \<star> (\<epsilon>' \<star> f) \<star> g) \<cdot> (g \<star> (f \<star> \<eta>') \<star> g) =
                       g \<star> ((\<epsilon>' \<star> f) \<star> g) \<cdot> ((f \<star> \<eta>') \<star> g)"
                   using A.ide_left A.ide_right A'.ide_right A.antipar A'.antipar A.unit_in_hom
                         A.counit_in_hom whisker_left
                   by (metis A'.triangle_left hseqI' ideD(1) whisker_right)
                 also have "... = g \<star> (\<epsilon>' \<star> f) \<cdot> (f \<star> \<eta>') \<star> g"
                   using A.antipar A'.antipar whisker_right [of g "\<epsilon>' \<star> f" "f \<star> \<eta>'"]
                   by (simp add: A'.triangle_left)
                 also have "... = g \<star> f \<star> g"
                   using A'.triangle_left by simp
                 finally show ?thesis by simp
               qed
               thus ?thesis
                 using hcomp_assoc by simp
             qed
             also have "... = (g \<star> \<epsilon>) \<cdot> (\<eta> \<star> g)"
               using A.antipar A'.antipar A.unit_in_hom A.counit_in_hom comp_cod_arr
               by (metis A.ide_left A.ide_right A.triangle_in_hom(2) arrI assoc_is_natural_2
                   ide_char seqE strict_assoc)
             also have "... = g"
               using A.triangle_right by simp
             finally have "?\<psi> \<cdot> ?\<phi> = g" by simp
             moreover have "ide g"
               by simp
             ultimately show ?thesis by simp
           qed
         qed
       qed
       ultimately show ?thesis
         using isomorphic_def by auto
     qed
 
   end
 
   text \<open>
     We now use strictification to extend to arbitrary bicategories.
   \<close>
 
   context bicategory
   begin
 
     interpretation S: strictified_bicategory V H \<a> \<i> src trg ..
 
     notation S.vcomp  (infixr "\<cdot>\<^sub>S" 55)
     notation S.hcomp  (infixr "\<star>\<^sub>S" 53)
     notation S.in_hom  ("\<guillemotleft>_ : _ \<Rightarrow>\<^sub>S _\<guillemotright>")
     notation S.in_hhom  ("\<guillemotleft>_ : _ \<rightarrow>\<^sub>S _\<guillemotright>")
 
     interpretation UP: equivalence_pseudofunctor V H \<a> \<i> src trg
                           S.vcomp S.hcomp S.\<a> S.\<i> S.src S.trg S.UP S.\<Phi>
       using S.UP_is_equivalence_pseudofunctor by auto
     interpretation UP: pseudofunctor_into_strict_bicategory V H \<a> \<i> src trg
                           S.vcomp S.hcomp S.\<a> S.\<i> S.src S.trg S.UP S.\<Phi>
       ..
     interpretation UP: fully_faithful_functor V S.vcomp S.UP
       using S.UP_is_fully_faithful_functor by auto
 
     lemma left_adjoint_determines_right_up_to_iso:
     assumes "adjoint_pair f g" and "adjoint_pair f g'"
     shows "g \<cong> g'"
     proof -
       have 0: "ide g \<and> ide g'"
         using assms adjoint_pair_def adjunction_in_bicategory_def
               adjunction_data_in_bicategory_def adjunction_data_in_bicategory_axioms_def
         by metis
       have 1: "S.adjoint_pair (S.UP f) (S.UP g) \<and> S.adjoint_pair (S.UP f) (S.UP g')"
         using assms UP.preserves_adjoint_pair by simp
       obtain \<nu> where \<nu>: "\<guillemotleft>\<nu> : S.UP g \<Rightarrow>\<^sub>S S.UP g'\<guillemotright> \<and> S.iso \<nu>"
         using 1 S.left_adjoint_determines_right_up_to_iso S.isomorphic_def by blast
       obtain \<mu> where \<mu>: "\<guillemotleft>\<mu> : g \<Rightarrow> g'\<guillemotright> \<and> S.UP \<mu> = \<nu>"
         using 0 \<nu> UP.is_full [of g' g \<nu>] by auto
       have "\<guillemotleft>\<mu> : g \<Rightarrow> g'\<guillemotright> \<and> iso \<mu>"
         using \<mu> \<nu> UP.reflects_iso by auto
       thus ?thesis
         using isomorphic_def by auto
     qed
 
     lemma right_adjoint_determines_left_up_to_iso:
     assumes "adjoint_pair f g" and "adjoint_pair f' g"
     shows "f \<cong> f'"
     proof -
       obtain \<eta> \<epsilon> where A: "adjunction_in_bicategory V H \<a> \<i> src trg f g \<eta> \<epsilon>"
         using assms adjoint_pair_def by auto
       interpret A: adjunction_in_bicategory V H \<a> \<i> src trg f g \<eta> \<epsilon>
         using A by auto
       obtain \<eta>' \<epsilon>' where A': "adjunction_in_bicategory V H \<a> \<i> src trg f' g \<eta>' \<epsilon>'"
         using assms adjoint_pair_def by auto
       interpret A': adjunction_in_bicategory V H \<a> \<i> src trg f' g \<eta>' \<epsilon>'
         using A' by auto
       interpret Cop: op_bicategory V H \<a> \<i> src trg ..
       interpret Aop: adjunction_in_bicategory V Cop.H Cop.\<a> \<i> Cop.src Cop.trg g f \<eta> \<epsilon>
         using A.antipar A.triangle_left A.triangle_right Cop.assoc_ide_simp
               Cop.lunit_ide_simp Cop.runit_ide_simp
         by (unfold_locales, auto)
       interpret Aop': adjunction_in_bicategory V Cop.H Cop.\<a> \<i> Cop.src Cop.trg g f' \<eta>' \<epsilon>'
         using A'.antipar A'.triangle_left A'.triangle_right Cop.assoc_ide_simp
               Cop.lunit_ide_simp Cop.runit_ide_simp
         by (unfold_locales, auto)
       show ?thesis
         using Aop.adjunction_in_bicategory_axioms Aop'.adjunction_in_bicategory_axioms
               Cop.left_adjoint_determines_right_up_to_iso Cop.adjoint_pair_def
         by blast
     qed
 
   end
 
   context chosen_right_adjoints
   begin
 
     lemma isomorphic_to_left_adjoint_implies_isomorphic_right_adjoint:
     assumes "is_left_adjoint f" and "f \<cong> h"
     shows "f\<^sup>* \<cong> h\<^sup>*"
     proof -
       have 1: "adjoint_pair f f\<^sup>*"
         using assms left_adjoint_extends_to_adjoint_pair by blast
       moreover have "adjoint_pair h f\<^sup>*"
         using assms 1 adjoint_pair_preserved_by_iso isomorphic_symmetric isomorphic_reflexive
         by (meson isomorphic_def right_adjoint_simps(1))
       thus ?thesis
         using left_adjoint_determines_right_up_to_iso left_adjoint_extends_to_adjoint_pair
         by blast
     qed
 
   end
 
   context bicategory
   begin
 
     lemma equivalence_is_adjoint:
     assumes "equivalence_map f"
     shows equivalence_is_left_adjoint: "is_left_adjoint f"
     and equivalence_is_right_adjoint: "is_right_adjoint f"
     proof -
       obtain g \<eta> \<epsilon> where fg: "adjoint_equivalence_in_bicategory V H \<a> \<i> src trg f g \<eta> \<epsilon>"
         using assms equivalence_map_extends_to_adjoint_equivalence by blast
       interpret fg: adjoint_equivalence_in_bicategory V H \<a> \<i> src trg f g \<eta> \<epsilon>
         using fg by simp
       interpret gf: adjoint_equivalence_in_bicategory V H \<a> \<i> src trg g f \<open>inv \<epsilon>\<close> \<open>inv \<eta>\<close>
         using fg.dual_adjoint_equivalence by simp
       show "is_left_adjoint f"
         using fg.adjunction_in_bicategory_axioms adjoint_pair_def by auto
       show "is_right_adjoint f"
         using gf.adjunction_in_bicategory_axioms adjoint_pair_def by auto
     qed
 
     lemma right_adjoint_to_equivalence_is_equivalence:
     assumes "equivalence_map f" and "adjoint_pair f g"
     shows "equivalence_map g"
     proof -
       obtain \<eta> \<epsilon> where fg: "adjunction_in_bicategory (\<cdot>) (\<star>) \<a> \<i> src trg f g \<eta> \<epsilon>"
         using assms adjoint_pair_def by auto
       interpret fg: adjunction_in_bicategory \<open>(\<cdot>)\<close> \<open>(\<star>)\<close> \<a> \<i> src trg f g \<eta> \<epsilon>
         using fg by simp
       obtain g' \<phi> \<psi> where fg': "equivalence_in_bicategory (\<cdot>) (\<star>) \<a> \<i> src trg f g' \<phi> \<psi>"
         using assms equivalence_map_def by auto
       interpret fg': equivalence_in_bicategory \<open>(\<cdot>)\<close> \<open>(\<star>)\<close> \<a> \<i> src trg f g' \<phi> \<psi>
         using fg' by auto
       obtain \<psi>' where \<psi>': "adjoint_equivalence_in_bicategory (\<cdot>) (\<star>) \<a> \<i> src trg f g' \<phi> \<psi>'"
         using assms equivalence_refines_to_adjoint_equivalence [of f g' \<phi>]
               fg'.antipar fg'.unit_in_hom fg'.unit_is_iso
         by auto
       interpret \<psi>': adjoint_equivalence_in_bicategory \<open>(\<cdot>)\<close> \<open>(\<star>)\<close> \<a> \<i> src trg f g' \<phi> \<psi>'
         using \<psi>' by simp
       have 1: "g \<cong> g'"
         using fg.adjunction_in_bicategory_axioms \<psi>'.adjunction_in_bicategory_axioms
               left_adjoint_determines_right_up_to_iso adjoint_pair_def
         by blast
       obtain \<gamma> where \<gamma>: "\<guillemotleft>\<gamma> : g' \<Rightarrow> g\<guillemotright> \<and> iso \<gamma>"
         using 1 isomorphic_def isomorphic_symmetric by metis
       have "equivalence_in_bicategory (\<cdot>) (\<star>) \<a> \<i> src trg f g ((\<gamma> \<star> f) \<cdot> \<phi>) (\<psi>' \<cdot> (f \<star> inv \<gamma>))"
         using \<gamma> equivalence_preserved_by_iso_right \<psi>'.equivalence_in_bicategory_axioms by simp
       hence "equivalence_pair f g"
         using equivalence_pair_def by auto
       thus ?thesis
         using equivalence_pair_symmetric equivalence_pair_def equivalence_map_def by blast
     qed
 
     lemma left_adjoint_to_equivalence_is_equivalence:
     assumes "equivalence_map f" and "adjoint_pair g f"
     shows "equivalence_map g"
     proof -
       obtain \<eta> \<epsilon> where gf: "adjunction_in_bicategory (\<cdot>) (\<star>) \<a> \<i> src trg g f \<eta> \<epsilon>"
         using assms adjoint_pair_def by auto
       interpret gf: adjunction_in_bicategory \<open>(\<cdot>)\<close> \<open>(\<star>)\<close> \<a> \<i> src trg g f \<eta> \<epsilon>
         using gf by simp
       obtain g' where 1: "equivalence_pair g' f"
         using assms equivalence_map_def equivalence_pair_def equivalence_pair_symmetric
         by blast
       obtain \<phi> \<psi> where g'f: "equivalence_in_bicategory (\<cdot>) (\<star>) \<a> \<i> src trg g' f \<phi> \<psi>"
         using assms 1 equivalence_pair_def by auto
       interpret g'f: equivalence_in_bicategory \<open>(\<cdot>)\<close> \<open>(\<star>)\<close> \<a> \<i> src trg g' f \<phi> \<psi>
         using g'f by auto
       obtain \<psi>' where \<psi>': "adjoint_equivalence_in_bicategory (\<cdot>) (\<star>) \<a> \<i> src trg g' f \<phi> \<psi>'"
         using assms 1 equivalence_refines_to_adjoint_equivalence [of g' f \<phi>]
               g'f.antipar g'f.unit_in_hom g'f.unit_is_iso equivalence_pair_def
               equivalence_map_def
         by auto
       interpret \<psi>': adjoint_equivalence_in_bicategory \<open>(\<cdot>)\<close> \<open>(\<star>)\<close> \<a> \<i> src trg g' f \<phi> \<psi>'
         using \<psi>' by simp
       have 1: "g \<cong> g'"
         using gf.adjunction_in_bicategory_axioms \<psi>'.adjunction_in_bicategory_axioms
               right_adjoint_determines_left_up_to_iso adjoint_pair_def
         by blast
       obtain \<gamma> where \<gamma>: "\<guillemotleft>\<gamma> : g' \<Rightarrow> g\<guillemotright> \<and> iso \<gamma>"
         using 1 isomorphic_def isomorphic_symmetric by metis
       have "equivalence_in_bicategory (\<cdot>) (\<star>) \<a> \<i> src trg g f ((f \<star> \<gamma>) \<cdot> \<phi>) (\<psi>' \<cdot> (inv \<gamma> \<star> f))"
         using \<gamma> equivalence_preserved_by_iso_left \<psi>'.equivalence_in_bicategory_axioms by simp
       hence "equivalence_pair g f"
         using equivalence_pair_def by auto
       thus ?thesis
         using equivalence_pair_symmetric equivalence_pair_def equivalence_map_def by blast
     qed
 
     lemma equivalence_pair_is_adjoint_pair:
     assumes "equivalence_pair f g"
     shows "adjoint_pair f g"
     proof -
       obtain \<eta> \<epsilon> where \<eta>\<epsilon>: "equivalence_in_bicategory V H \<a> \<i> src trg f g \<eta> \<epsilon>"
         using assms equivalence_pair_def by auto
       interpret \<eta>\<epsilon>: equivalence_in_bicategory V H \<a> \<i> src trg f g \<eta> \<epsilon>
         using \<eta>\<epsilon> by auto
       obtain \<epsilon>' where \<eta>\<epsilon>': "adjoint_equivalence_in_bicategory V H \<a> \<i> src trg f g \<eta> \<epsilon>'"
         using \<eta>\<epsilon> equivalence_map_def \<eta>\<epsilon>.antipar \<eta>\<epsilon>.unit_in_hom \<eta>\<epsilon>.unit_is_iso
               \<eta>\<epsilon>.ide_right equivalence_refines_to_adjoint_equivalence [of f g \<eta>]
         by force
       interpret \<eta>\<epsilon>': adjoint_equivalence_in_bicategory V H \<a> \<i> src trg f g \<eta> \<epsilon>'
         using \<eta>\<epsilon>' by auto
       show ?thesis
         using \<eta>\<epsilon>' adjoint_pair_def \<eta>\<epsilon>'.adjunction_in_bicategory_axioms by auto
     qed
 
     lemma equivalence_pair_isomorphic_right:
     assumes "equivalence_pair f g"
     shows "equivalence_pair f g' \<longleftrightarrow> g \<cong> g'"
     proof
       show "g \<cong> g' \<Longrightarrow> equivalence_pair f g'"
         using assms equivalence_pair_def isomorphic_def equivalence_preserved_by_iso_right
         by metis
       assume g': "equivalence_pair f g'"
       show "g \<cong> g'"
         using assms g' equivalence_pair_is_adjoint_pair left_adjoint_determines_right_up_to_iso
         by blast
     qed
 
     lemma equivalence_pair_isomorphic_left:
     assumes "equivalence_pair f g"
     shows "equivalence_pair f' g \<longleftrightarrow> f \<cong> f'"
     proof
       show "f \<cong> f' \<Longrightarrow> equivalence_pair f' g"
         using assms equivalence_pair_def isomorphic_def equivalence_preserved_by_iso_left
         by metis
       assume f': "equivalence_pair f' g"
       show "f \<cong> f'"
         using assms f' equivalence_pair_is_adjoint_pair right_adjoint_determines_left_up_to_iso
         by blast
     qed      
 
   end
 
 end
diff --git a/thys/Bicategory/Prebicategory.thy b/thys/Bicategory/Prebicategory.thy
--- a/thys/Bicategory/Prebicategory.thy
+++ b/thys/Bicategory/Prebicategory.thy
@@ -1,3330 +1,3335 @@
 (*  Title:       PreBicategory
     Author:      Eugene W. Stark <stark@cs.stonybrook.edu>, 2019
     Maintainer:  Eugene W. Stark <stark@cs.stonybrook.edu>
 *)
 
   text \<open>
     The objective of this section is to construct a formalization of bicategories that is
     compatible with our previous formulation of categories \cite{Category3-AFP}
     and that permits us to carry over unchanged as much of the work done on categories as possible.
     For these reasons, we conceive of a bicategory in what might be regarded as a somewhat
     unusual fashion.  Rather than a traditional development, which would typically define
     a bicategory to be essentially ``a `category' whose homs themselves have the structure
     of categories,'' here we regard a bicategory as ``a (vertical) category that has been
     equipped with a suitable (horizontal) weak composition.''  Stated another way, we think
     of a bicategory as a generalization of a monoidal category in which the tensor product is
     a partial operation, rather than a total one.  Our definition of bicategory can thus
     be summarized as follows: a bicategory is a (vertical) category that has been equipped
     with idempotent endofunctors \<open>src\<close> and \<open>trg\<close> that assign to each arrow its ``source''
     and ``target'' subject to certain commutativity constraints,
     a partial binary operation \<open>\<star>\<close> of horizontal composition that is suitably functorial on
     the ``hom-categories'' determined by the assignment of sources and targets,
     ``associativity'' isomorphisms \<open>\<guillemotleft>\<a>[f, g, h] : (f \<star> g) \<star> h \<Rightarrow> f \<star> (g \<star> h)\<guillemotright>\<close> for each horizontally
     composable triple of vertical identities \<open>f\<close>, \<open>g\<close>, \<open>h\<close>, subject to the usual naturality
     and coherence conditions, and for each ``object'' \<open>a\<close> (defined to be an arrow that is
     its own source and target) a ``unit isomorphism'' \<open>\<guillemotleft>\<i>[a] : a \<star> a \<Rightarrow> a\<guillemotright>\<close>.
     As is the case for monoidal categories, the unit isomorphisms and associator isomorphisms
     together enable a canonical definition of left and right ``unit'' isomorphisms
     \<open>\<guillemotleft>\<l>[f] : a \<star> f \<Rightarrow> f\<guillemotright>\<close> and \<open>\<guillemotleft>\<r>[f] : f \<star> a \<Rightarrow> f\<guillemotright>\<close> when \<open>f\<close> is a vertical identity
     horizontally composable on the left or right by \<open>a\<close>, and it can be shown that these are
     the components of natural transformations.
 
     The definition of bicategory just sketched shares with a more traditional version the
     requirement that assignments of source and target are given as basic data, and these
     assignments determine horizontal composability in the sense that arrows \<open>\<mu>\<close> and \<open>\<nu>\<close>
     are composable if the chosen source of \<open>\<mu>\<close> coincides with the chosen target of \<open>\<nu>\<close>.
     Thus it appears, at least on its face, that composability of arrows depends on an assignment
     of sources and targets.  We are interested in establishing whether this is essential or
     whether bicategories can be formalized in a completely ``object-free'' fashion.
 
     It turns out that we can obtain such an object-free formalization through a rather direct
     generalization of the approach we used in the formalization of categories.
     Specifically, we define a \emph{weak composition} to be a partial binary operation \<open>\<star>\<close>
     on the arrow type of a ``vertical'' category \<open>V\<close>, such that the domain of definition of this
     operation is itself a category (of ``horizontally composable pairs of arrows''),
     the operation is functorial, and it is subject to certain matching conditions which include
     those satisfied by a category.
     From the axioms for a weak composition we can prove the existence of ``hom-categories'',
     which are subcategories of \<open>V\<close> consisting of arrows horizontally composable on the
     left or right by a specified vertical identity.
     A \emph{weak unit} is defined to be a vertical identity \<open>a\<close> such that \<open>a \<star> a \<cong> a\<close>
     and is such that the mappings \<open>a \<star> \<hyphen>\<close> and \<open>\<hyphen> \<star> a\<close> are fully faithful endofunctors
     of the subcategories of \<open>V\<close> consisting of the arrows for which they are defined.
     We define the \emph{sources} of an arrow \<open>\<mu>\<close> to be the weak units that are horizontally
     composable with \<open>\<mu>\<close> on the right, and the \emph{targets} of \<open>\<mu>\<close> to be the weak units
     that are horizontally composable with \<open>\<mu>\<close> on the left.
     An \emph{associative weak composition} is defined to be a weak composition that is equipped
     with ``associator'' isomorphisms \<open>\<guillemotleft>\<a>[f, g, h] : (f \<star> g) \<star> h \<Rightarrow> f \<star> (g \<star> h)\<guillemotright>\<close> for horizontally
     composable vertical identities \<open>f\<close>, \<open>g\<close>, \<open>h\<close>, subject to the usual naturality and coherence
     conditions.
     A \emph{prebicategory} is defined to be an associative weak composition for which every
     arrow has a source and a target.  We show that the sets of sources and targets of each
     arrow in a prebicategory is an isomorphism class of weak units, and that horizontal
     composability of arrows \<open>\<mu>\<close> and \<open>\<nu>\<close> is characterized by the set of sources of \<open>\<mu>\<close> being
     equal to the set of targets of \<open>\<nu>\<close>.
 
     We show that prebicategories are essentially ``bicategories without objects''.
     Given a prebicategory, we may choose an arbitrary representative of each
     isomorphism class of weak units and declare these to be ``objects''
     (this is analogous to choosing a particular unit object in a monoidal category).
     For each object we may choose a particular \emph{unit isomorphism} \<open>\<guillemotleft>\<i>[a] : a \<star> a \<Rightarrow> a\<guillemotright>\<close>.
     This choice, together with the associator isomorphisms, enables a canonical definition
     of left and right unit isomorphisms \<open>\<guillemotleft>\<l>[f] : a \<star> f \<Rightarrow> f\<guillemotright>\<close> and \<open>\<guillemotleft>\<r>[f] : f \<star> a \<Rightarrow> f\<guillemotright>\<close>
     when \<open>f\<close> is a vertical identity horizontally composable on the left or right by \<open>a\<close>,
     and it can be shown that these are the components of natural isomorphisms.
     We may then define ``the source'' of an arrow to be the chosen representative of the
     set of its sources and ``the target'' to be the chosen representative of the set of its
     targets.  We show that the resulting structure is a bicategory, in which horizontal
     composability as given by the weak composition coincides with the ``syntactic'' version
     determined by the chosen sources and targets.
     Conversely, a bicategory determines a prebicategory, essentially by forgetting
     the sources, targets and unit isomorphisms.
     These results make it clear that the assignment of sources and targets to arrows in
     a bicategory is basically a convenience and that horizontal composability of arrows
     is not dependent on a particular choice.
 \<close>
 
 theory Prebicategory
 imports Category3.EquivalenceOfCategories Category3.Subcategory IsomorphismClass
 begin
 
   section "Weak Composition"
 
   text \<open>
     In this section we define a locale \<open>weak_composition\<close>, which formalizes a functorial
     operation of ``horizontal'' composition defined on an underlying ``vertical'' category.
     The definition is expressed without the presumption of the existence of any sort
     of ``objects'' that determine horizontal composability.  Rather, just as we did
     in showing that the @{locale partial_magma} locale supported the definition of ``identity
     arrow'' as a kind of unit for vertical composition which ultimately served as a basis
     for the definition of ``domain'' and ``codomain'' of an arrow, here we show that the
     \<open>weak_composition\<close> locale supports a definition of \emph{weak unit} for horizontal
     composition which can ultimately be used to define the \emph{sources} and \emph{targets}
     of an arrow with respect to horizontal composition.
     In particular, the definition of weak composition involves axioms that relate horizontal
     and vertical composability.  As a consequence of these axioms, for any fixed arrow \<open>\<mu>\<close>,
     the sets of arrows horizontally composable on the left and on the right with \<open>\<mu>\<close>
     form subcategories with respect to vertical composition.  We define the
     sources of \<open>\<mu>\<close> to be the weak units that are composable with \<open>\<mu>\<close> on the right,
     and the targets of \<open>\<mu>\<close> to be the weak units that are composable with \<open>\<mu>\<close>
     on the left.  Weak units are then characterized as arrows that are members
     of the set of their own sources (or, equivalently, of their own targets).
   \<close>
 
   subsection "Definition"
 
   locale weak_composition =
     category V +
     VxV: product_category V V +
     VoV: subcategory VxV.comp \<open>\<lambda>\<mu>\<nu>. fst \<mu>\<nu> \<star> snd \<mu>\<nu> \<noteq> null\<close> +
     "functor" VoV.comp V \<open>\<lambda>\<mu>\<nu>. fst \<mu>\<nu> \<star> snd \<mu>\<nu>\<close>
   for V :: "'a comp"         (infixr "\<cdot>" 55)
   and H :: "'a comp"         (infixr "\<star>" 53) +
   assumes left_connected: "seq \<nu> \<nu>' \<Longrightarrow> \<nu> \<star> \<mu> \<noteq> null \<longleftrightarrow> \<nu>' \<star> \<mu> \<noteq> null"
   and right_connected: "seq \<mu> \<mu>' \<Longrightarrow> \<nu> \<star> \<mu> \<noteq> null \<longleftrightarrow> \<nu> \<star> \<mu>' \<noteq> null"
   and match_1: "\<lbrakk> \<nu> \<star> \<mu> \<noteq> null; (\<nu> \<star> \<mu>) \<star> \<tau> \<noteq> null \<rbrakk> \<Longrightarrow> \<mu> \<star> \<tau> \<noteq> null"
   and match_2: "\<lbrakk> \<nu> \<star> (\<mu> \<star> \<tau>) \<noteq> null; \<mu> \<star> \<tau> \<noteq> null \<rbrakk> \<Longrightarrow> \<nu> \<star> \<mu> \<noteq> null"
   and match_3: "\<lbrakk> \<mu> \<star> \<tau> \<noteq> null; \<nu> \<star> \<mu> \<noteq> null \<rbrakk> \<Longrightarrow> (\<nu> \<star> \<mu>) \<star> \<tau> \<noteq> null"
   and match_4: "\<lbrakk> \<mu> \<star> \<tau> \<noteq> null; \<nu> \<star> \<mu> \<noteq> null \<rbrakk> \<Longrightarrow> \<nu> \<star> (\<mu> \<star> \<tau>) \<noteq> null"
   begin
 
     text \<open>
       We think of the arrows of the vertical category as ``2-cells'' and the vertical identities
       as ``1-cells''.  In the formal development, the predicate @{term arr} (``arrow'')
       will have its normal meaning with respect to the vertical composition, hence @{term "arr \<mu>"}
       will mean, essentially, ``\<open>\<mu>\<close> is a 2-cell''.  This is somewhat unfortunate, as it is
       traditional when discussing bicategories to use the term ``arrow'' to refer to the 1-cells.
       However, we are trying to carry over all the formalism that we have already developed for
       categories and apply it to bicategories with as little change and redundancy as possible.
       It becomes too confusing to try to repurpose the name @{term arr} to mean @{term ide} and
       to introduce a replacement for the name @{term arr}, so we will simply tolerate the
       situation.  In informal text, we will prefer the terms ``2-cell'' and ``1-cell'' over
       (vertical) ``arrow'' and ``identity'' when there is a chance for confusion.
 
       We do, however, make the following adjustments in notation for @{term in_hom} so that
       it is distinguished from the notion @{term in_hhom} (``in horizontal hom'') to be
       introduced subsequently.
     \<close>
 
     no_notation in_hom      ("\<guillemotleft>_ : _ \<rightarrow> _\<guillemotright>")
     notation in_hom         ("\<guillemotleft>_ : _ \<Rightarrow> _\<guillemotright>")
 
     lemma is_partial_magma:
     shows "partial_magma H"
     proof
       show "\<exists>!n. \<forall>f. n \<star> f = n \<and> f \<star> n = n"
       proof
         show 1: "\<forall>f. null \<star> f = null \<and> f \<star> null = null"
           using is_extensional VoV.inclusion VoV.arr_char by force
         show "\<And>n. \<forall>f. n \<star> f = n \<and> f \<star> n = n \<Longrightarrow> n = null"
           using 1 VoV.arr_char is_extensional not_arr_null by metis
       qed
     qed
 
     interpretation H: partial_magma H
       using is_partial_magma by auto
 
     text \<open>
       Either \<open>match_1\<close> or \<open>match_2\<close> seems essential for the next result, which states
       that the nulls for the horizontal and vertical compositions coincide.
     \<close>
 
     lemma null_agreement [simp]:
     shows "H.null = null"
       by (metis VoV.inclusion VxV.not_arr_null match_1 H.comp_null(1))
 
     lemma composable_implies_arr:
     assumes "\<nu> \<star> \<mu> \<noteq> null"
     shows "arr \<mu>" and "arr \<nu>"
       using assms is_extensional VoV.arr_char VoV.inclusion by auto
 
     lemma hcomp_null [simp]:
     shows "null \<star> \<mu> = null" and "\<mu> \<star> null = null"
       using H.comp_null by auto
 
     lemma hcomp_simps\<^sub>W\<^sub>C [simp]:
     assumes "\<nu> \<star> \<mu> \<noteq> null"
     shows "arr (\<nu> \<star> \<mu>)" and "dom (\<nu> \<star> \<mu>) = dom \<nu> \<star> dom \<mu>" and "cod (\<nu> \<star> \<mu>) = cod \<nu> \<star> cod \<mu>"
       using assms preserves_arr preserves_dom preserves_cod VoV.arr_char VoV.inclusion
       by force+
 
     lemma ide_hcomp\<^sub>W\<^sub>C [simp]:
     assumes "ide f" and "ide g" and "g \<star> f \<noteq> null"
     shows "ide (g \<star> f)"
       using assms preserves_ide VoV.ide_char by force
 
     lemma hcomp_in_hom\<^sub>W\<^sub>C [intro]:
     assumes "\<nu> \<star> \<mu> \<noteq> null"
     shows "\<guillemotleft>\<nu> \<star> \<mu> : dom \<nu> \<star> dom \<mu> \<Rightarrow> cod \<nu> \<star> cod \<mu>\<guillemotright>"
       using assms by auto
 
     text \<open>
       Horizontal composability of arrows is determined by horizontal composability of
       their domains and codomains (defined with respect to vertical composition).
     \<close>
 
     lemma hom_connected:
     shows "\<nu> \<star> \<mu> \<noteq> null \<longleftrightarrow> dom \<nu> \<star> \<mu> \<noteq> null"
     and "\<nu> \<star> \<mu> \<noteq> null \<longleftrightarrow> \<nu> \<star> dom \<mu> \<noteq> null"
     and "\<nu> \<star> \<mu> \<noteq> null \<longleftrightarrow> cod \<nu> \<star> \<mu> \<noteq> null"
     and "\<nu> \<star> \<mu> \<noteq> null \<longleftrightarrow> \<nu> \<star> cod \<mu> \<noteq> null"
     proof -
       show "\<nu> \<star> \<mu> \<noteq> null \<longleftrightarrow> dom \<nu> \<star> \<mu> \<noteq> null"
         using left_connected [of \<nu> "dom \<nu>" \<mu>] composable_implies_arr arr_dom_iff_arr by force
       show "\<nu> \<star> \<mu> \<noteq> null \<longleftrightarrow> cod \<nu> \<star> \<mu> \<noteq> null"
         using left_connected [of  "cod \<nu>" \<nu> \<mu>] composable_implies_arr arr_cod_iff_arr by force
       show "\<nu> \<star> \<mu> \<noteq> null \<longleftrightarrow> \<nu> \<star> dom \<mu> \<noteq> null"
         using right_connected [of \<mu> "dom \<mu>" \<nu>] composable_implies_arr arr_dom_iff_arr by force
       show "\<nu> \<star> \<mu> \<noteq> null \<longleftrightarrow> \<nu> \<star> cod \<mu> \<noteq> null"
         using right_connected [of "cod \<mu>" \<mu> \<nu>] composable_implies_arr arr_cod_iff_arr by force
     qed
 
     lemma isomorphic_implies_equicomposable:
     assumes "f \<cong> g"
     shows "\<tau> \<star> f \<noteq> null \<longleftrightarrow> \<tau> \<star> g \<noteq> null"
     and "f \<star> \<sigma> \<noteq> null \<longleftrightarrow> g \<star> \<sigma> \<noteq> null"
       using assms isomorphic_def hom_connected by auto
 
     lemma interchange:
     assumes "seq \<nu> \<mu>" and "seq \<tau> \<sigma>"
     shows "(\<nu> \<cdot> \<mu>) \<star> (\<tau> \<cdot> \<sigma>) = (\<nu> \<star> \<tau>) \<cdot> (\<mu> \<star> \<sigma>)"
     proof -
       have "\<mu> \<star> \<sigma> = null \<Longrightarrow> ?thesis"
         by (metis assms comp_null(2) dom_comp hom_connected(1-2))
       moreover have "\<mu> \<star> \<sigma> \<noteq> null \<Longrightarrow> ?thesis"
       proof -
         assume \<mu>\<sigma>: "\<mu> \<star> \<sigma> \<noteq> null"
         have 1: "VoV.arr (\<mu>, \<sigma>)"
           using \<mu>\<sigma> VoV.arr_char by auto
         have \<nu>\<tau>: "(\<nu>, \<tau>) \<in> VoV.hom (VoV.cod (\<mu>, \<sigma>)) (VoV.cod (\<nu>, \<tau>))"
         proof -
           have "VoV.arr (\<nu>, \<tau>)"
             using assms 1 hom_connected VoV.arr_char
             by (elim seqE, auto, metis)
           thus ?thesis
             using assms \<mu>\<sigma> VoV.dom_char VoV.cod_char by fastforce
         qed
         show ?thesis
         proof -
           have "VoV.seq (\<nu>, \<tau>) (\<mu>, \<sigma>)"
             using assms 1 \<mu>\<sigma> \<nu>\<tau> VoV.seqI by blast
           thus ?thesis
             using assms 1 \<mu>\<sigma> \<nu>\<tau> VoV.comp_char preserves_comp [of "(\<nu>, \<tau>)" "(\<mu>, \<sigma>)"] VoV.seqI
             by fastforce
         qed
       qed
       ultimately show ?thesis by blast
     qed
 
     lemma paste_1:
     shows "\<nu> \<star> \<mu> = (cod \<nu> \<star> \<mu>) \<cdot> (\<nu> \<star> dom \<mu>)"
       using interchange composable_implies_arr comp_arr_dom comp_cod_arr
             hom_connected(2-3)
       by (metis comp_null(2))
 
     lemma paste_2:
     shows "\<nu> \<star> \<mu> = (\<nu> \<star> cod \<mu>) \<cdot> (dom \<nu> \<star> \<mu>)"
       using interchange composable_implies_arr comp_arr_dom comp_cod_arr
             hom_connected(1,4)
       by (metis comp_null(2))
 
     lemma whisker_left:
     assumes "seq \<nu> \<mu>" and "ide f"
     shows "f \<star> (\<nu> \<cdot> \<mu>) = (f \<star> \<nu>) \<cdot> (f \<star> \<mu>)"
       using assms interchange [of f f \<nu> \<mu>] hom_connected by auto
 
     lemma whisker_right:
     assumes "seq \<nu> \<mu>" and "ide f"
     shows "(\<nu> \<cdot> \<mu>) \<star> f = (\<nu> \<star> f) \<cdot> (\<mu> \<star> f)"
       using assms interchange [of \<nu> \<mu> f f] hom_connected by auto
 
     subsection "Hom-Subcategories"
 
     definition left
     where "left \<tau> \<equiv> \<lambda>\<mu>. \<tau> \<star> \<mu> \<noteq> null"
 
     definition right
     where "right \<sigma> \<equiv> \<lambda>\<mu>. \<mu> \<star> \<sigma> \<noteq> null"
 
     lemma right_iff_left:
     shows "right \<sigma> \<tau> \<longleftrightarrow> left \<tau> \<sigma>"
       using right_def left_def by simp
 
     lemma left_respects_isomorphic:
     assumes "f \<cong> g"
     shows "left f = left g"
       using assms isomorphic_implies_equicomposable left_def by auto
 
     lemma right_respects_isomorphic:
     assumes "f \<cong> g"
     shows "right f = right g"
       using assms isomorphic_implies_equicomposable right_def by auto
 
     lemma left_iff_left_inv:
     assumes "iso \<mu>"
     shows "left \<tau> \<mu> \<longleftrightarrow> left \<tau> (inv \<mu>)"
       using assms left_def inv_in_hom hom_connected(2) hom_connected(4) [of \<tau> "inv \<mu>"]
       by auto
         
     lemma right_iff_right_inv:
     assumes "iso \<mu>"
     shows "right \<sigma> \<mu> \<longleftrightarrow> right \<sigma> (inv \<mu>)"
       using assms right_def inv_in_hom hom_connected(1) hom_connected(3) [of "inv \<mu>" \<sigma>]
       by auto
 
     lemma left_hom_is_subcategory:
     assumes "arr \<mu>"
     shows "subcategory V (left \<mu>)"
     proof (unfold left_def, unfold_locales)
       show "\<And>f. \<mu> \<star> f \<noteq> null \<Longrightarrow> arr f" using composable_implies_arr by simp
       show "\<And>f. \<mu> \<star> f \<noteq> null \<Longrightarrow> \<mu> \<star> dom f \<noteq> null" using hom_connected(2) by simp
       show "\<And>f. \<mu> \<star> f \<noteq> null \<Longrightarrow> \<mu> \<star> cod f \<noteq> null" using hom_connected(4) by auto
       show "\<And>f g. \<lbrakk> \<mu> \<star> f \<noteq> null; \<mu> \<star> g \<noteq> null; cod f = dom g \<rbrakk> \<Longrightarrow> \<mu> \<star> (g \<cdot> f) \<noteq> null"
       proof -
         fix f g
         assume f: "\<mu> \<star> f \<noteq> null" and g: "\<mu> \<star> g \<noteq> null" and fg: "cod f = dom g"
         show "\<mu> \<star> (g \<cdot> f) \<noteq> null"
           using f g fg composable_implies_arr hom_connected(2) [of \<mu> "g \<cdot> f"] hom_connected(2)
           by simp
       qed
     qed
 
     lemma right_hom_is_subcategory:
     assumes "arr \<mu>"
     shows "subcategory V (right \<mu>)"
     proof (unfold right_def, unfold_locales)
       show "\<And>f. f \<star> \<mu> \<noteq> null \<Longrightarrow> arr f" using composable_implies_arr by simp
       show "\<And>f. f \<star> \<mu> \<noteq> null \<Longrightarrow> dom f \<star> \<mu> \<noteq> null" using hom_connected(1) by auto
       show "\<And>f. f \<star> \<mu> \<noteq> null \<Longrightarrow> cod f \<star> \<mu> \<noteq> null" using hom_connected(3) by auto
       show "\<And>f g. \<lbrakk> f \<star> \<mu> \<noteq> null; g \<star> \<mu> \<noteq> null; cod f = dom g \<rbrakk> \<Longrightarrow> (g \<cdot> f) \<star> \<mu> \<noteq> null"
       proof -
         fix f g
         assume f: "f \<star> \<mu> \<noteq> null" and g: "g \<star> \<mu> \<noteq> null" and fg: "cod f = dom g"
         show "(g \<cdot> f) \<star> \<mu> \<noteq> null"
           using f g fg composable_implies_arr hom_connected(1) [of "g \<cdot> f" \<mu>] hom_connected(1)
           by simp
       qed
     qed
 
     abbreviation Left
     where "Left a \<equiv> subcategory.comp V (left a)"
 
     abbreviation Right
     where "Right a \<equiv> subcategory.comp V (right a)"
 
     text \<open>
       We define operations of composition on the left or right with a fixed 1-cell,
       and show that such operations are functorial in case that 1-cell is
       horizontally self-composable.
     \<close>
 
     definition H\<^sub>L
     where "H\<^sub>L g \<equiv> \<lambda>\<mu>. g \<star> \<mu>"
 
     definition H\<^sub>R
     where "H\<^sub>R f \<equiv> \<lambda>\<mu>. \<mu> \<star> f"
 
     (* TODO: Why do the following fail when I use @{thm ...} *)
     text \<open>
       Note that \<open>match_3\<close> and \<open>match_4\<close> are required for the next results.
     \<close>
 
     lemma endofunctor_H\<^sub>L:
     assumes "ide g" and "g \<star> g \<noteq> null"
     shows "endofunctor (Left g) (H\<^sub>L g)"
     proof -
       interpret L: subcategory V \<open>left g\<close> using assms left_hom_is_subcategory by simp
       have *: "\<And>\<mu>. L.arr \<mu> \<Longrightarrow> H\<^sub>L g \<mu> = g \<star> \<mu>"
         using assms H\<^sub>L_def by simp
       have preserves_arr: "\<And>\<mu>. L.arr \<mu> \<Longrightarrow> L.arr (H\<^sub>L g \<mu>)"
         using assms * L.arr_char left_def match_4 by force
       show "endofunctor L.comp (H\<^sub>L g)"
       proof
         show "\<And>\<mu>. \<not> L.arr \<mu> \<Longrightarrow> H\<^sub>L g \<mu> = L.null"
           using assms L.arr_char L.null_char left_def H\<^sub>L_def by fastforce
         show "\<And>\<mu>. L.arr \<mu> \<Longrightarrow> L.arr (H\<^sub>L g \<mu>)" by fact
         fix \<mu>
         assume "L.arr \<mu>"
         hence \<mu>: "L.arr \<mu> \<and> arr \<mu> \<and> g \<star> \<mu> \<noteq> null"
           using assms L.arr_char composable_implies_arr left_def by metis
         show "L.dom (H\<^sub>L g \<mu>) = H\<^sub>L g (L.dom \<mu>)"
           using assms \<mu> * L.arr_char L.dom_char preserves_arr hom_connected(2) left_def
           by simp
         show "L.cod (H\<^sub>L g \<mu>) = H\<^sub>L g (L.cod \<mu>)"
           using assms \<mu> * L.arr_char L.cod_char preserves_arr hom_connected(4) left_def
           by simp
         next
         fix \<mu> \<nu>
         assume \<mu>\<nu>: "L.seq \<nu> \<mu>"
         have \<mu>: "L.arr \<mu>"
           using \<mu>\<nu> by (elim L.seqE, auto)
         have \<nu>: "L.arr \<nu> \<and> arr \<nu> \<and> in_hom \<nu> (L.cod \<mu>) (L.cod \<nu>) \<and> left g \<nu> \<and> g \<star> \<nu> \<noteq> null"
         proof -
           have 1: "L.in_hom \<nu> (L.cod \<mu>) (L.cod \<nu>)"
             using \<mu>\<nu> by (elim L.seqE, auto)
           hence "arr \<nu> \<and> left g \<nu>"
             using L.hom_char by blast
           thus ?thesis
             using assms 1 left_def by fastforce
         qed
         show "H\<^sub>L g (L.comp \<nu> \<mu>) = L.comp (H\<^sub>L g \<nu>) (H\<^sub>L g \<mu>)"
         proof -
           have "H\<^sub>L g (L.comp \<nu> \<mu>) = g \<star> (\<nu> \<cdot> \<mu>)"
             using \<mu> \<nu> H\<^sub>L_def L.comp_def L.arr_char by fastforce
           also have "... = (g \<star> \<nu>) \<cdot> (g \<star> \<mu>)"
             using assms \<mu> \<nu> L.inclusion whisker_left L.arr_char by fastforce
           also have "... = L.comp (H\<^sub>L g \<nu>) (H\<^sub>L g \<mu>)"
             using assms \<mu>\<nu> \<mu> \<nu> * preserves_arr L.arr_char L.dom_char L.cod_char L.comp_char
                   L.inclusion H\<^sub>L_def left_def
             by auto
           finally show ?thesis by blast
         qed
       qed
     qed
 
     lemma endofunctor_H\<^sub>R:
     assumes "ide f" and "f \<star> f \<noteq> null"
     shows "endofunctor (Right f) (H\<^sub>R f)"
     proof -
       interpret R: subcategory V \<open>right f\<close> using assms right_hom_is_subcategory by simp
       have *: "\<And>\<mu>. R.arr \<mu> \<Longrightarrow> H\<^sub>R f \<mu> = \<mu> \<star> f"
         using assms H\<^sub>R_def by simp
       have preserves_arr: "\<And>\<mu>. R.arr \<mu> \<Longrightarrow> R.arr (H\<^sub>R f \<mu>)"
         using assms * R.arr_char right_def match_3 by force
       show "endofunctor R.comp (H\<^sub>R f)"
       proof
         show "\<And>\<mu>. \<not> R.arr \<mu> \<Longrightarrow> H\<^sub>R f \<mu> = R.null"
           using assms R.arr_char R.null_char right_def H\<^sub>R_def by fastforce
         show "\<And>\<mu>. R.arr \<mu> \<Longrightarrow> R.arr (H\<^sub>R f \<mu>)" by fact
         fix \<mu>
         assume "R.arr \<mu>"
         hence \<mu>: "R.arr \<mu> \<and> arr \<mu> \<and> \<mu> \<star> f \<noteq> null"
           using assms R.arr_char composable_implies_arr right_def by simp
         show "R.dom (H\<^sub>R f \<mu>) = H\<^sub>R f (R.dom \<mu>)"
           using assms \<mu> * R.arr_char R.dom_char preserves_arr hom_connected(1) right_def
           by simp
         show "R.cod (H\<^sub>R f \<mu>) = H\<^sub>R f (R.cod \<mu>)"
           using assms \<mu> * R.arr_char R.cod_char preserves_arr hom_connected(3) right_def
           by simp
         next
         fix \<mu> \<nu>
         assume \<mu>\<nu>: "R.seq \<nu> \<mu>"
         have \<mu>: "R.arr \<mu>"
           using \<mu>\<nu> by (elim R.seqE, auto)
         have \<nu>: "R.arr \<nu> \<and> arr \<nu> \<and> in_hom \<nu> (R.cod \<mu>) (R.cod \<nu>) \<and> right f \<nu> \<and> \<nu> \<star> f \<noteq> null"
         proof -
           have 1: "R.in_hom \<nu> (R.cod \<mu>) (R.cod \<nu>)"
             using \<mu>\<nu> by (elim R.seqE, auto)
           hence "arr \<nu> \<and> right f \<nu>"
             using R.hom_char by blast
           thus ?thesis
             using assms 1 right_def by fastforce
         qed
         show "H\<^sub>R f (R.comp \<nu> \<mu>) = R.comp (H\<^sub>R f \<nu>) (H\<^sub>R f \<mu>)"
         proof -
           have "H\<^sub>R f (R.comp \<nu> \<mu>) = (\<nu> \<cdot> \<mu>) \<star> f"
             using \<mu> \<nu> H\<^sub>R_def R.comp_def R.arr_char by fastforce
           also have "... = (\<nu> \<star> f) \<cdot> (\<mu> \<star> f)"
             using assms \<mu> \<nu> R.inclusion whisker_right R.arr_char by fastforce
           also have "... = R.comp (H\<^sub>R f \<nu>) (H\<^sub>R f \<mu>)"
             using assms \<mu>\<nu> \<mu> \<nu> * preserves_arr R.arr_char R.dom_char R.cod_char R.comp_char
                   R.inclusion H\<^sub>R_def right_def
             by auto
           finally show ?thesis by blast
         qed
       qed
     qed
 
   end
 
   locale left_hom =
     weak_composition V H +
     S: subcategory V \<open>left \<omega>\<close>
   for V :: "'a comp"                  (infixr "\<cdot>" 55)
   and H :: "'a comp"                  (infixr "\<star>" 53)
   and \<omega> :: 'a +
   assumes arr_\<omega>: "arr \<omega>"
   begin
 
     no_notation in_hom      ("\<guillemotleft>_ : _ \<rightarrow> _\<guillemotright>")
     notation in_hom         ("\<guillemotleft>_ : _ \<Rightarrow> _\<guillemotright>")
     notation S.comp         (infixr "\<cdot>\<^sub>S" 55)
     notation S.in_hom       ("\<guillemotleft>_ : _ \<Rightarrow>\<^sub>S _\<guillemotright>")
 
     lemma right_hcomp_closed [simp]:
     assumes "\<guillemotleft>\<mu> : x \<Rightarrow>\<^sub>S y\<guillemotright>" and "\<guillemotleft>\<nu> : c \<Rightarrow> d\<guillemotright>" and "\<mu> \<star> \<nu> \<noteq> null"
     shows "\<guillemotleft>\<mu> \<star> \<nu> : x \<star> c \<Rightarrow>\<^sub>S y \<star> d\<guillemotright>"
     proof
       show 1: "S.arr (\<mu> \<star> \<nu>)"
         using assms arr_\<omega> S.arr_char left_def match_4
         by (elim S.in_homE, meson)
       show "S.dom (\<mu> \<star> \<nu>) = x \<star> c"
         using assms 1 by force
       show "S.cod (\<mu> \<star> \<nu>) = y \<star> d"
         using assms 1 by force
     qed
 
     lemma interchange:
     assumes "S.seq \<nu> \<mu>" and "S.seq \<tau> \<sigma>" and "\<mu> \<star> \<sigma> \<noteq> null"
     shows "(\<nu> \<cdot>\<^sub>S \<mu>) \<star> (\<tau> \<cdot>\<^sub>S \<sigma>) = (\<nu> \<star> \<tau>) \<cdot>\<^sub>S (\<mu> \<star> \<sigma>)"
     proof -
       have 1: "\<nu> \<star> \<tau> \<noteq> null"
         using assms hom_connected(1) [of \<nu> \<sigma>] hom_connected(2) [of \<nu> \<tau>] hom_connected(3-4)
         by force
       have "(\<nu> \<cdot>\<^sub>S \<mu>) \<star> (\<tau> \<cdot>\<^sub>S \<sigma>) = (\<nu> \<cdot> \<mu>) \<star> (\<tau> \<cdot> \<sigma>)"
         using assms S.comp_char S.seq_char by metis
       also have "... = (\<nu> \<star> \<tau>) \<cdot> (\<mu> \<star> \<sigma>)"
         using assms interchange S.seq_char S.arr_char by simp
       also have "... = (\<nu> \<star> \<tau>) \<cdot>\<^sub>S (\<mu> \<star> \<sigma>)"
       proof -
         have "S.arr (\<nu> \<star> \<tau>)"
         proof -
           have "\<guillemotleft>\<tau> : dom \<tau> \<Rightarrow> cod \<tau>\<guillemotright>"
             using assms S.in_hom_char by blast
           thus ?thesis
             using assms 1 right_hcomp_closed by blast
         qed
         moreover have "S.arr (\<mu> \<star> \<sigma>)"
         proof -
           have "\<guillemotleft>\<sigma> : dom \<sigma> \<Rightarrow> cod \<sigma>\<guillemotright>"
             using assms S.in_hom_char by blast
           thus ?thesis
             using assms right_hcomp_closed [of \<mu> "dom \<mu>" "cod \<mu>" \<sigma> "dom \<sigma>" "cod \<sigma>"] by fastforce
         qed
         moreover have "seq (\<nu> \<star> \<tau>) (\<mu> \<star> \<sigma>)"
           using assms 1 S.in_hom_char
           by (metis (full_types) S.seq_char hcomp_simps\<^sub>W\<^sub>C(1-3) seqE seqI)
         ultimately show ?thesis
           using S.comp_char by auto
       qed
       finally show ?thesis by blast
     qed
 
     lemma inv_char:
     assumes "S.arr \<phi>" and "iso \<phi>"
     shows "S.inverse_arrows \<phi> (inv \<phi>)"
     and "S.inv \<phi> = inv \<phi>"
     proof -
       have 1: "S.arr (inv \<phi>)"
       proof -
         have "S.arr \<phi>" using assms by auto
         hence "\<omega> \<star> \<phi> \<noteq> null"
           using S.arr_char left_def by simp
         hence "\<omega> \<star> cod \<phi> \<noteq> null"
           using hom_connected(4) by blast
         hence "\<omega> \<star> dom (inv \<phi>) \<noteq> null"
           using assms S.iso_char by simp
         hence "\<omega> \<star> inv \<phi> \<noteq> null"
           using hom_connected by blast
         thus "S.arr (inv \<phi>)"
           using S.arr_char left_def by force
       qed
       show "S.inv \<phi> = inv \<phi>"
         using assms 1 S.inv_char S.iso_char by blast
       thus "S.inverse_arrows \<phi> (inv \<phi>)"
         using assms 1 S.iso_char S.inv_is_inverse by metis
     qed
 
     lemma iso_char:
     assumes "S.arr \<phi>"
     shows "S.iso \<phi> \<longleftrightarrow> iso \<phi>"
       using assms S.iso_char inv_char by auto
 
   end
 
   locale right_hom =
     weak_composition V H +
     S: subcategory V \<open>right \<omega>\<close>
   for V :: "'a comp"        (infixr "\<cdot>" 55)
   and H :: "'a comp"        (infixr "\<star>" 53)
   and \<omega> :: 'a +
   assumes arr_\<omega>: "arr \<omega>"
   begin
 
     no_notation in_hom      ("\<guillemotleft>_ : _ \<rightarrow> _\<guillemotright>")
     notation in_hom         ("\<guillemotleft>_ : _ \<Rightarrow> _\<guillemotright>")
     notation S.comp         (infixr "\<cdot>\<^sub>S" 55)
     notation S.in_hom       ("\<guillemotleft>_ : _ \<Rightarrow>\<^sub>S _\<guillemotright>")
 
     lemma left_hcomp_closed [simp]:
     assumes "\<guillemotleft>\<mu> : x \<Rightarrow>\<^sub>S y\<guillemotright>" and "\<guillemotleft>\<nu> : c \<Rightarrow> d\<guillemotright>" and "\<nu> \<star> \<mu> \<noteq> null"
     shows "\<guillemotleft>\<nu> \<star> \<mu> : c \<star> x \<Rightarrow>\<^sub>S d \<star> y\<guillemotright>"
     proof
       show 1: "S.arr (\<nu> \<star> \<mu>)"
         using assms arr_\<omega> S.arr_char right_def match_3
         by (elim S.in_homE, meson)
       show "S.dom (\<nu> \<star> \<mu>) = c \<star> x"
         using assms 1 by force
       show "S.cod (\<nu> \<star> \<mu>) = d \<star> y"
         using assms 1 by force
     qed
 
     lemma interchange:
     assumes "S.seq \<nu> \<mu>" and "S.seq \<tau> \<sigma>" and "\<mu> \<star> \<sigma> \<noteq> null"
     shows "(\<nu> \<cdot>\<^sub>S \<mu>) \<star> (\<tau> \<cdot>\<^sub>S \<sigma>) = (\<nu> \<star> \<tau>) \<cdot>\<^sub>S (\<mu> \<star> \<sigma>)"
     proof -
       have 1: "\<nu> \<star> \<tau> \<noteq> null"
         using assms hom_connected(1) [of \<nu> \<sigma>] hom_connected(2) [of \<nu> \<tau>] hom_connected(3-4)
         by fastforce
       have "(\<nu> \<cdot>\<^sub>S \<mu>) \<star> (\<tau> \<cdot>\<^sub>S \<sigma>) = (\<nu> \<cdot> \<mu>) \<star> (\<tau> \<cdot> \<sigma>)"
         using assms S.comp_char S.seq_char by metis
       also have "... = (\<nu> \<star> \<tau>) \<cdot> (\<mu> \<star> \<sigma>)"
         using assms interchange S.seq_char S.arr_char by simp
       also have "... = (\<nu> \<star> \<tau>) \<cdot>\<^sub>S (\<mu> \<star> \<sigma>)"
       proof -
         have "S.arr (\<nu> \<star> \<tau>)"
         proof -
           have "\<guillemotleft>\<nu> : dom \<nu> \<Rightarrow> cod \<nu>\<guillemotright>"
             using assms S.in_hom_char by blast
           thus ?thesis
             using assms 1 left_hcomp_closed by blast
         qed
         moreover have "S.arr (\<mu> \<star> \<sigma>)"
         proof -
           have "\<guillemotleft>\<mu> : dom \<mu> \<Rightarrow> cod \<mu>\<guillemotright>"
             using assms S.in_hom_char by blast
           thus ?thesis
             using assms left_hcomp_closed [of \<sigma> "dom \<sigma>" "cod \<sigma>" \<mu> "dom \<mu>" "cod \<mu>"]
             by fastforce
         qed
         moreover have "seq (\<nu> \<star> \<tau>) (\<mu> \<star> \<sigma>)"
           using assms 1 S.in_hom_char
           by (metis (full_types) S.seq_char hcomp_simps\<^sub>W\<^sub>C(1-3) seqE seqI)
         ultimately show ?thesis
           using S.comp_char by auto
       qed
       finally show ?thesis by blast
     qed
 
     lemma inv_char:
     assumes "S.arr \<phi>" and "iso \<phi>"
     shows "S.inverse_arrows \<phi> (inv \<phi>)"
     and "S.inv \<phi> = inv \<phi>"
     proof -
       have 1: "S.arr (inv \<phi>)"
       proof -
         have "S.arr \<phi>" using assms by auto
         hence "\<phi> \<star> \<omega> \<noteq> null"
           using S.arr_char right_def by simp
         hence "cod \<phi> \<star> \<omega> \<noteq> null"
           using hom_connected(3) by blast
         hence "dom (inv \<phi>) \<star> \<omega> \<noteq> null"
           using assms S.iso_char by simp
         hence "inv \<phi> \<star> \<omega> \<noteq> null"
           using hom_connected(1) by blast
         thus ?thesis
           using S.arr_char right_def by force
       qed
       show "S.inv \<phi> = inv \<phi>"
         using assms 1 S.inv_char S.iso_char by blast
       thus "S.inverse_arrows \<phi> (inv \<phi>)"
         using assms 1 S.iso_char S.inv_is_inverse by metis
     qed
 
     lemma iso_char:
     assumes "S.arr \<phi>"
     shows "S.iso \<phi> \<longleftrightarrow> iso \<phi>"
       using assms S.iso_char inv_char by auto
 
   end
 
   subsection "Weak Units"
 
   text \<open>
     We now define a \emph{weak unit} to be an arrow \<open>a\<close> such that:
     \begin{enumerate}
     \item  \<open>a \<star> a\<close> is isomorphic to \<open>a\<close>
            (and hence \<open>a\<close> is a horizontally self-composable 1-cell).
     \item  Horizontal composition on the left with \<open>a\<close> is a fully faithful endofunctor of the
            subcategory of arrows that are composable on the left with \<open>a\<close>.
     \item  Horizontal composition on the right with \<open>a\<close> is fully faithful endofunctor of the
            subcategory of arrows that are composable on the right with \<open>a\<close>.
     \end{enumerate}
   \<close>
 
   context weak_composition
   begin
 
     definition weak_unit :: "'a \<Rightarrow> bool"
     where "weak_unit a \<equiv> a \<star> a \<cong> a \<and>
                          fully_faithful_functor (Left a) (Left a) (H\<^sub>L a) \<and>
                          fully_faithful_functor (Right a) (Right a) (H\<^sub>R a)"
 
     lemma weak_unit_self_composable [simp]:
     assumes "weak_unit a"
     shows "ide a" and "ide (a \<star> a)" and "a \<star> a \<noteq> null"
     proof -
       obtain \<phi> where \<phi>: "\<guillemotleft>\<phi> : a \<star> a \<Rightarrow> a\<guillemotright> \<and> iso \<phi>"
         using assms weak_unit_def isomorphic_def by blast
       have 1: "arr \<phi>" using \<phi> by blast
       show "ide a" using \<phi> ide_cod by blast
       thus "ide (a \<star> a)" using \<phi> ide_dom by force
       thus "a \<star> a \<noteq> null" using not_arr_null ideD(1) by metis
     qed
 
     lemma weak_unit_self_right:
     assumes "weak_unit a"
     shows "right a a"
       using assms weak_unit_self_composable right_def by simp
 
     lemma weak_unit_self_left:
     assumes "weak_unit a"
     shows "left a a"
       using assms weak_unit_self_composable left_def by simp
 
     lemma weak_unit_in_vhom:
     assumes "weak_unit a"
     shows "\<guillemotleft>a : a \<Rightarrow> a\<guillemotright>"
       using assms weak_unit_self_composable left_def by auto
 
     text \<open>
       If \<open>a\<close> is a weak unit, then there exists a ``unit isomorphism'' \<open>\<guillemotleft>\<iota> : a \<star> a \<Rightarrow> a\<guillemotright>\<close>.
       It need not be unique, but we may choose one arbitrarily.
     \<close>
 
     definition some_unit
     where "some_unit a \<equiv> SOME \<iota>. iso \<iota> \<and> \<guillemotleft>\<iota> : a \<star> a \<Rightarrow> a\<guillemotright>"
 
     lemma iso_some_unit:
     assumes "weak_unit a"
     shows "iso (some_unit a)"
     and "\<guillemotleft>some_unit a : a \<star> a \<Rightarrow> a\<guillemotright>"
     proof -
       let ?P = "\<lambda>\<iota>. iso \<iota> \<and> \<guillemotleft>\<iota> : a \<star> a \<Rightarrow> a\<guillemotright>"
       have "\<exists>\<iota>. ?P \<iota>"
         using assms weak_unit_def by auto
       hence 1: "?P (some_unit a)"
         using someI_ex [of ?P] some_unit_def by simp
       show "iso (some_unit a)" using 1 by blast
       show "\<guillemotleft>some_unit a : a \<star> a \<Rightarrow> a\<guillemotright>" using 1 by blast
     qed
 
     text \<open>
       The \emph{sources} of an arbitrary arrow \<open>\<mu>\<close> are the weak units that are composable with \<open>\<mu>\<close>
       on the right.  Similarly, the \emph{targets} of \<open>\<mu>\<close> are the weak units that are composable
       with \<open>\<mu>\<close> on the left.
     \<close>
 
     definition sources
     where "sources \<mu> \<equiv> {a. weak_unit a \<and> \<mu> \<star> a \<noteq> null}"
 
     lemma sourcesI [intro]:
     assumes "weak_unit a" and "\<mu> \<star> a \<noteq> null"
     shows "a \<in> sources \<mu>"
       using assms sources_def by blast
 
     lemma sourcesD [dest]:
     assumes "a \<in> sources \<mu>"
     shows "ide a" and "weak_unit a" and "\<mu> \<star> a \<noteq> null"
       using assms sources_def by auto
 
     definition targets
     where "targets \<mu> \<equiv> {b. weak_unit b \<and> b \<star> \<mu> \<noteq> null}"
 
     lemma targetsI [intro]:
     assumes "weak_unit b" and "b \<star> \<mu> \<noteq> null"
     shows "b \<in> targets \<mu>"
       using assms targets_def by blast
 
     lemma targetsD [dest]:
     assumes "b \<in> targets \<mu>"
     shows "ide b" and "weak_unit b" and "b \<star> \<mu> \<noteq> null"
       using assms targets_def by auto
 
     lemma sources_dom [simp]:
     assumes "arr \<mu>"
     shows "sources (dom \<mu>) = sources \<mu>"
       using assms hom_connected(1) by blast
 
     lemma sources_cod [simp]:
     assumes "arr \<mu>"
     shows "sources (cod \<mu>) = sources \<mu>"
       using assms hom_connected(3) by blast
 
     lemma targets_dom [simp]:
     assumes "arr \<mu>"
     shows "targets (dom \<mu>) = targets \<mu>"
       using assms hom_connected(2) by blast
 
     lemma targets_cod [simp]:
     assumes "arr \<mu>"
     shows "targets (cod \<mu>) = targets \<mu>"
       using assms hom_connected(4) by blast
 
     lemma weak_unit_iff_self_source:
     shows "weak_unit a \<longleftrightarrow> a \<in> sources a"
       using weak_unit_self_composable by auto
 
     lemma weak_unit_iff_self_target:
     shows "weak_unit b \<longleftrightarrow> b \<in> targets b"
       using weak_unit_self_composable by auto
 
     abbreviation (input) in_hhom\<^sub>W\<^sub>C  ("\<guillemotleft>_ : _ \<rightarrow>\<^sub>W\<^sub>C _\<guillemotright>")
     where "in_hhom\<^sub>W\<^sub>C \<mu> f g \<equiv> arr \<mu> \<and> f \<in> sources \<mu> \<and> g \<in> targets \<mu>"
 
     lemma sources_hcomp:
     assumes "\<nu> \<star> \<mu> \<noteq> null"
     shows "sources (\<nu> \<star> \<mu>) = sources \<mu>"
       using assms match_1 match_3 null_agreement by blast
 
     lemma targets_hcomp:
     assumes "\<nu> \<star> \<mu> \<noteq> null"
     shows "targets (\<nu> \<star> \<mu>) = targets \<nu>"
       using assms match_2 match_4 null_agreement by blast
 
     lemma H\<^sub>R_preserved_along_iso:
     assumes "weak_unit a" and "a \<cong> a'"
     shows "endofunctor (Right a) (H\<^sub>R a')"
     proof -
       have a: "ide a \<and> weak_unit a" using assms isomorphic_def by auto
       have a': "ide a'" using assms isomorphic_def by auto
       (* TODO: The following interpretation re-introduces unwanted notation for "in_hom" *)
       interpret R: subcategory V \<open>right a\<close> using a right_hom_is_subcategory by simp
       have *: "\<And>\<mu>. R.arr \<mu> \<Longrightarrow> H\<^sub>R a' \<mu> = \<mu> \<star> a'"
         using assms H\<^sub>R_def by simp
       have preserves_arr: "\<And>\<mu>. R.arr \<mu> \<Longrightarrow> R.arr (H\<^sub>R a' \<mu>)"
         using assms a' * R.arr_char right_def weak_unit_def weak_unit_self_composable
               isomorphic_implies_equicomposable R.ide_char match_3 hcomp_simps\<^sub>W\<^sub>C(1)
               null_agreement
         by metis
       show "endofunctor R.comp (H\<^sub>R a')"
       proof
         show "\<And>\<mu>. \<not> R.arr \<mu> \<Longrightarrow> H\<^sub>R a' \<mu> = R.null"
           using assms R.arr_char R.null_char right_def H\<^sub>R_def null_agreement
                 right_respects_isomorphic
           by metis
         fix \<mu>
         assume "R.arr \<mu>"
         hence \<mu>: "R.arr \<mu> \<and> arr \<mu> \<and> right a \<mu> \<and> right a' \<mu> \<and> \<mu> \<star> a \<noteq> null \<and> \<mu> \<star> a' \<noteq> null"
           using assms R.arr_char right_respects_isomorphic composable_implies_arr null_agreement
                 right_def
           by metis
         show "R.arr (H\<^sub>R a' \<mu>)" using \<mu> preserves_arr by blast
         show "R.dom (H\<^sub>R a' \<mu>) = H\<^sub>R a' (R.dom \<mu>)"
           using a' \<mu> * R.arr_char R.dom_char preserves_arr hom_connected(1) right_def
           by simp
         show "R.cod (H\<^sub>R a' \<mu>) = H\<^sub>R a' (R.cod \<mu>)"
           using a' \<mu> * R.arr_char R.cod_char preserves_arr hom_connected(3) right_def
           by simp
         next
         fix \<mu> \<nu>
         assume \<mu>\<nu>: "R.seq \<nu> \<mu>"
         have "R.arr \<mu>"
           using \<mu>\<nu> by (elim R.seqE, auto)
         hence \<mu>: "R.arr \<mu> \<and> arr \<mu> \<and> right a \<mu> \<and> right a' \<mu> \<and> \<mu> \<star> a \<noteq> null \<and> \<mu> \<star> a' \<noteq> null"
           using assms R.arr_char right_respects_isomorphic composable_implies_arr null_agreement
                 right_def
           by metis
         have "\<nu> \<in> R.hom (R.cod \<mu>) (R.cod \<nu>)"
           using \<mu>\<nu> by (elim R.seqE, auto)
         hence "\<guillemotleft>\<nu> : R.cod \<mu> \<Rightarrow> R.cod \<nu>\<guillemotright> \<and> arr \<nu> \<and> \<nu> \<in> Collect (right a)"
           using R.hom_char by blast
         hence \<nu>: "\<guillemotleft>\<nu> : R.cod \<mu> \<rightarrow> R.cod \<nu>\<guillemotright> \<and> arr \<nu> \<and>
                   right a \<nu> \<and> H \<nu> a \<noteq> null \<and> right a' \<nu> \<and> H \<nu> a' \<noteq> null"
           using assms right_def right_respects_isomorphic isomorphic_implies_equicomposable
           by simp
         show "H\<^sub>R a' (R.comp \<nu> \<mu>) = R.comp (H\<^sub>R a' \<nu>) (H\<^sub>R a' \<mu>)"
         proof -
           have 1: "R.arr (H\<^sub>R a' \<nu>)"
             using \<nu> preserves_arr by blast
           have 2: "seq (\<nu> \<star> a') (\<mu> \<star> a')"
             using a' \<mu> \<nu> R.arr_char R.inclusion R.dom_char R.cod_char
                    isomorphic_implies_equicomposable
             by auto
           show ?thesis
           proof -
             have "H\<^sub>R a' (R.comp \<nu> \<mu>) = (\<nu> \<cdot> \<mu>) \<star> a'"
               using \<mu> \<nu> H\<^sub>R_def R.comp_def by fastforce
             also have "... = (\<nu> \<star> a') \<cdot> (\<mu> \<star> a')"
             proof -
               have "seq \<nu> \<mu>"
                 using \<mu> \<nu> \<mu>\<nu> by (elim R.seqE, auto)
               thus ?thesis
                 using a' \<nu> whisker_right right_def by blast
             qed
             also have "... = R.comp (H\<^sub>R a' \<nu>) (H\<^sub>R a' \<mu>)"
               using assms \<mu> 1 2 preserves_arr R.comp_char R.inclusion H\<^sub>R_def by auto
             finally show ?thesis by blast
           qed
         qed
       qed
     qed
 
     lemma H\<^sub>L_preserved_along_iso:
     assumes "weak_unit a" and "a \<cong> a'"
     shows "endofunctor (Left a) (H\<^sub>L a')"
     proof -
       have a: "ide a \<and> weak_unit a" using assms isomorphic_def by auto
       have a': "ide a'" using assms isomorphic_def by auto
       (* TODO: The following interpretation re-introduces unwanted notation for "in_hom" *)
       interpret L: subcategory V \<open>left a\<close> using a left_hom_is_subcategory by simp
       have *: "\<And>\<mu>. L.arr \<mu> \<Longrightarrow> H\<^sub>L a' \<mu> = a' \<star> \<mu>"
         using assms H\<^sub>L_def by simp
       have preserves_arr: "\<And>\<mu>. L.arr \<mu> \<Longrightarrow> L.arr (H\<^sub>L a' \<mu>)"
         using assms a' * L.arr_char left_def weak_unit_def weak_unit_self_composable
               isomorphic_implies_equicomposable L.ide_char match_4 hcomp_simps\<^sub>W\<^sub>C(1)
               null_agreement
         by metis
       show "endofunctor L.comp (H\<^sub>L a')"
       proof
         show "\<And>\<mu>. \<not> L.arr \<mu> \<Longrightarrow> H\<^sub>L a' \<mu> = L.null"
           using assms L.arr_char L.null_char left_def H\<^sub>L_def null_agreement
                 left_respects_isomorphic
           by metis
         fix \<mu>
         assume "L.arr \<mu>"
         hence \<mu>: "L.arr \<mu> \<and> arr \<mu> \<and> left a \<mu> \<and> left a' \<mu> \<and> a \<star> \<mu> \<noteq> null \<and> a' \<star> \<mu> \<noteq> null"
           using assms L.arr_char left_respects_isomorphic composable_implies_arr null_agreement
                 left_def
           by metis
         show "L.arr (H\<^sub>L a' \<mu>)" using \<mu> preserves_arr by blast
         show "L.dom (H\<^sub>L a' \<mu>) = H\<^sub>L a' (L.dom \<mu>)"
           using a' \<mu> * L.arr_char L.dom_char preserves_arr hom_connected(2) left_def
           by simp
         show "L.cod (H\<^sub>L a' \<mu>) = H\<^sub>L a' (L.cod \<mu>)"
           using a' \<mu> * L.arr_char L.cod_char preserves_arr hom_connected(4) left_def
           by simp
         next
         fix \<mu> \<nu>
         assume \<mu>\<nu>: "L.seq \<nu> \<mu>"
         have "L.arr \<mu>"
           using \<mu>\<nu> by (elim L.seqE, auto)
         hence \<mu>: "L.arr \<mu> \<and> arr \<mu> \<and> left a \<mu> \<and> left a' \<mu> \<and> a \<star> \<mu> \<noteq> null \<and> a' \<star> \<mu> \<noteq> null"
           using assms L.arr_char left_respects_isomorphic composable_implies_arr null_agreement
                 left_def
           by metis
         have "L.in_hom \<nu> (L.cod \<mu>) (L.cod \<nu>)"
           using \<mu>\<nu> by (elim L.seqE, auto)
         hence "\<guillemotleft>\<nu> : L.cod \<mu> \<Rightarrow> L.cod \<nu>\<guillemotright> \<and> arr \<nu> \<and> \<nu> \<in> Collect (left a)"
           using L.hom_char by blast
         hence \<nu>: "\<guillemotleft>\<nu> : L.cod \<mu> \<Rightarrow> L.cod \<nu>\<guillemotright> \<and> arr \<nu> \<and>
                   left a \<nu> \<and> a \<star> \<nu> \<noteq> null \<and> left a' \<nu> \<and> a' \<star> \<nu> \<noteq> null"
           using assms left_def left_respects_isomorphic isomorphic_implies_equicomposable
           by simp
         show "H\<^sub>L a' (L.comp \<nu> \<mu>) = L.comp (H\<^sub>L a' \<nu>) (H\<^sub>L a' \<mu>)"
         proof -
           have 1: "L.arr (H\<^sub>L a' \<nu>)"
             using \<nu> preserves_arr by blast
           have 2: "seq (a' \<star> \<nu>) (a' \<star> \<mu>)"
             using a' \<mu> \<nu> L.arr_char L.inclusion L.dom_char L.cod_char
                   isomorphic_implies_equicomposable
             by auto
           have "H\<^sub>L a' (L.comp \<nu> \<mu>) = a' \<star> (\<nu> \<cdot> \<mu>)"
             using \<mu> \<nu> H\<^sub>L_def L.comp_def by fastforce
           also have "... = (a' \<star> \<nu>) \<cdot> (a' \<star> \<mu>)"
           proof -
             have "seq \<nu> \<mu>"
               using \<mu> \<nu> \<mu>\<nu> by (elim L.seqE, auto)
             thus ?thesis
               using a' \<nu> whisker_left right_def by blast
           qed
           also have "... = L.comp (H\<^sub>L a' \<nu>) (H\<^sub>L a' \<mu>)"
             using assms \<mu> 1 2 preserves_arr L.comp_char L.inclusion H\<^sub>L_def by auto
           finally show ?thesis by blast
         qed
       qed
     qed
 
   end
 
   subsection "Regularity"
 
   text \<open>
     We call a weak composition \emph{regular} if \<open>f \<star> a \<cong> f\<close> whenever \<open>a\<close> is a source of
     1-cell \<open>f\<close>, and \<open>b \<star> f \<cong> f\<close> whenever \<open>b\<close> is a target of \<open>f\<close>.  A consequence of regularity
     is that horizontal composability of 2-cells is fully determined by their sets of
     sources and targets.
   \<close>
 
   locale regular_weak_composition =
     weak_composition +
   assumes comp_ide_source: "\<lbrakk> a \<in> sources f; ide f \<rbrakk> \<Longrightarrow> f \<star> a \<cong> f"
   and comp_target_ide: "\<lbrakk> b \<in> targets f; ide f \<rbrakk> \<Longrightarrow> b \<star> f \<cong> f"
   begin
 
     lemma sources_determine_composability:
     assumes "a \<in> sources \<tau>"
     shows "\<tau> \<star> \<mu> \<noteq> null \<longleftrightarrow> a \<star> \<mu> \<noteq> null"
     proof -
       have *: "\<And>\<tau>. ide \<tau> \<and> a \<in> sources \<tau> \<Longrightarrow> \<tau> \<star> \<mu> \<noteq> null \<longleftrightarrow> a \<star> \<mu> \<noteq> null"
       proof -
         fix \<tau>
         assume \<tau>: "ide \<tau> \<and> a \<in> sources \<tau>"
         show "\<tau> \<star> \<mu> \<noteq> null \<longleftrightarrow> a \<star> \<mu> \<noteq> null"
         proof
           assume \<mu>: "\<tau> \<star> \<mu> \<noteq> null"
           show "a \<star> \<mu> \<noteq> null"
             using assms \<mu> \<tau> comp_ide_source isomorphic_implies_equicomposable match_1
             by blast
           next
           assume \<mu>: "a \<star> \<mu> \<noteq> null"
           show "\<tau> \<star> \<mu> \<noteq> null"
             using assms \<mu> \<tau> comp_ide_source isomorphic_implies_equicomposable match_3
             by blast
         qed
       qed
       show ?thesis
       proof -
         have "arr \<tau>" using assms composable_implies_arr by auto
         thus ?thesis
           using assms * [of "dom \<tau>"] hom_connected(1) by auto
       qed
     qed
 
     lemma targets_determine_composability:
     assumes "b \<in> targets \<mu>"
     shows "\<tau> \<star> \<mu> \<noteq> null \<longleftrightarrow> \<tau> \<star> b \<noteq> null"
     proof -
       have *: "\<And>\<mu>. ide \<mu> \<and> b \<in> targets \<mu> \<Longrightarrow> \<tau> \<star> \<mu> \<noteq> null \<longleftrightarrow> \<tau> \<star> b \<noteq> null"
       proof -
         fix \<mu>
         assume \<mu>: "ide \<mu> \<and> b \<in> targets \<mu>"
         show "\<tau> \<star> \<mu> \<noteq> null \<longleftrightarrow> \<tau> \<star> b \<noteq> null"
         proof
           assume \<tau>: "\<tau> \<star> \<mu> \<noteq> null"
           show "\<tau> \<star> b \<noteq> null"
             using assms \<mu> \<tau> comp_target_ide isomorphic_implies_equicomposable match_2
             by blast
           next
           assume \<tau>: "\<tau> \<star> b \<noteq> null"
           show "\<tau> \<star> \<mu> \<noteq> null"
             using assms \<mu> \<tau>  comp_target_ide isomorphic_implies_equicomposable match_4
             by blast
         qed
       qed
       show ?thesis
       proof -
         have "arr \<mu>" using assms composable_implies_arr by auto
         thus ?thesis
           using assms * [of "dom \<mu>"] hom_connected(2) by auto
       qed
     qed
 
     lemma composable_if_connected:
     assumes "sources \<nu> \<inter> targets \<mu> \<noteq> {}"
     shows "\<nu> \<star> \<mu> \<noteq> null"
       using assms targets_determine_composability by blast
 
     lemma connected_if_composable:
     assumes "\<nu> \<star> \<mu> \<noteq> null"
     shows "sources \<nu> = targets \<mu>"
       using assms sources_determine_composability targets_determine_composability by blast
 
     lemma iso_hcomp\<^sub>R\<^sub>W\<^sub>C:
     assumes "iso \<mu>" and "iso \<nu>" and "sources \<nu> \<inter> targets \<mu> \<noteq> {}"
     shows "iso (\<nu> \<star> \<mu>)"
     and "inverse_arrows (\<nu> \<star> \<mu>) (inv \<nu> \<star> inv \<mu>)"
     proof -
       have \<mu>: "arr \<mu> \<and> \<guillemotleft>\<mu> : dom \<mu> \<Rightarrow> cod \<mu>\<guillemotright> \<and>
                iso \<mu> \<and> \<guillemotleft>inv \<mu> : cod \<mu> \<Rightarrow> dom \<mu>\<guillemotright>"
         using assms inv_in_hom arr_iff_in_hom iso_is_arr by auto
       have \<nu>: "arr \<nu> \<and> \<guillemotleft>\<nu> : dom \<nu> \<Rightarrow> cod \<nu>\<guillemotright> \<and>
                iso \<nu> \<and> \<guillemotleft>inv \<nu> : cod \<nu> \<Rightarrow> dom \<nu>\<guillemotright>"
         using assms inv_in_hom by blast
       have 1: "sources (inv \<nu>) \<inter> targets (inv \<mu>) \<noteq> {}"
       proof -
         have "sources (inv \<nu>) \<inter> targets (inv \<mu>) = sources \<nu> \<inter> targets \<mu>"
         proof -
           have "sources (inv \<nu>) \<inter> targets (inv \<mu>)
                   = sources (cod (inv \<nu>)) \<inter> targets (cod (inv \<mu>))"
             using assms \<mu> \<nu> sources_cod targets_cod arr_inv by presburger
           also have "... = sources (dom \<nu>) \<inter> targets (dom \<mu>)"
             using \<mu> \<nu> by simp
           also have "... = sources \<nu> \<inter> targets \<mu>"
             using \<mu> \<nu> sources_dom targets_dom by simp
           finally show ?thesis by blast
         qed
         thus ?thesis using assms by simp
       qed
       show "inverse_arrows (\<nu> \<star> \<mu>) (inv \<nu> \<star> inv \<mu>)"
       proof
         have "(inv \<nu> \<star> inv \<mu>) \<cdot> (\<nu> \<star> \<mu>) = dom \<nu> \<star> dom \<mu>"
           using assms \<mu> \<nu> inv_in_hom inv_is_inverse comp_inv_arr
                 interchange [of "inv \<nu>" \<nu> "inv \<mu>" \<mu>] composable_if_connected
           by simp
         moreover have "ide (dom \<nu> \<star> dom \<mu>)"
           using assms \<mu> \<nu> ide_hcomp\<^sub>W\<^sub>C composable_if_connected sources_dom targets_dom
           by auto
         ultimately show "ide ((inv \<nu> \<star> inv \<mu>) \<cdot> (\<nu> \<star> \<mu>))"
           by presburger
         have "(\<nu> \<star> \<mu>) \<cdot> (inv \<nu> \<star> inv \<mu>) = cod \<nu> \<star> cod \<mu>"
           using assms 1 \<mu> \<nu> inv_in_hom inv_is_inverse comp_arr_inv
                 interchange [of \<nu> "inv \<nu>" \<mu> "inv \<mu>"] composable_if_connected
           by simp
         moreover have "ide (cod \<nu> \<star> cod \<mu>)"
           using assms \<mu> \<nu> ide_hcomp\<^sub>W\<^sub>C composable_if_connected sources_cod targets_cod
           by auto
         ultimately show "ide ((\<nu> \<star> \<mu>) \<cdot> (inv \<nu> \<star> inv \<mu>))"
           by presburger
       qed
       thus "iso (\<nu> \<star> \<mu>)" by auto
     qed
 
     lemma inv_hcomp\<^sub>R\<^sub>W\<^sub>C:
     assumes "iso \<mu>" and "iso \<nu>" and "sources \<nu> \<inter> targets \<mu> \<noteq> {}"
     shows "inv (\<nu> \<star> \<mu>) = inv \<nu> \<star> inv \<mu>"
       using assms iso_hcomp\<^sub>R\<^sub>W\<^sub>C(2) [of \<mu> \<nu>] inverse_arrow_unique [of "H \<nu> \<mu>"] inv_is_inverse
       by auto
 
   end
 
   subsection "Associativity"
 
   text \<open>
     An \emph{associative weak composition} consists of a weak composition that has been
     equipped with an \emph{associator} isomorphism: \<open>\<guillemotleft>\<a>[f, g, h] : (f \<star> g) \<star> h \<Rightarrow> f \<star> g \<star> h\<guillemotright>\<close>
     for each composable triple \<open>(f, g, h)\<close> of 1-cells, subject to naturality and
     coherence conditions.
   \<close>
 
   locale associative_weak_composition =
     weak_composition +
   fixes \<a> :: "'a \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a"    ("\<a>[_, _, _]")
   assumes assoc_in_vhom\<^sub>A\<^sub>W\<^sub>C:
            "\<lbrakk> ide f; ide g; ide h; f \<star> g \<noteq> null; g \<star> h \<noteq> null \<rbrakk> \<Longrightarrow>
               \<guillemotleft>\<a>[f, g, h] : (f \<star> g) \<star> h \<Rightarrow> f \<star> g \<star> h\<guillemotright>"
   and assoc_naturality\<^sub>A\<^sub>W\<^sub>C:
            "\<lbrakk> \<tau> \<star> \<mu> \<noteq> null; \<mu> \<star> \<nu> \<noteq> null \<rbrakk> \<Longrightarrow>
               \<a>[cod \<tau>, cod \<mu>, cod \<nu>] \<cdot> ((\<tau> \<star> \<mu>) \<star> \<nu>) = (\<tau> \<star> \<mu> \<star> \<nu>) \<cdot> \<a>[dom \<tau>, dom \<mu>, dom \<nu>]"
   and iso_assoc\<^sub>A\<^sub>W\<^sub>C: "\<lbrakk> ide f; ide g; ide h; f \<star> g \<noteq> null; g \<star> h \<noteq> null \<rbrakk> \<Longrightarrow> iso \<a>[f, g, h]"
   and pentagon\<^sub>A\<^sub>W\<^sub>C:
            "\<lbrakk> ide f; ide g; ide h; ide k; sources f \<inter> targets g \<noteq> {};
               sources g \<inter> targets h \<noteq> {}; sources h \<inter> targets k \<noteq> {} \<rbrakk> \<Longrightarrow>
               (f \<star> \<a>[g, h, k]) \<cdot> \<a>[f, g \<star> h, k] \<cdot> (\<a>[f, g, h] \<star> k) = \<a>[f, g, h \<star> k] \<cdot> \<a>[f \<star> g, h, k]"
   begin
 
     lemma assoc_in_hom\<^sub>A\<^sub>W\<^sub>C:
     assumes "ide f" and "ide g" and "ide h"
     and "f \<star> g \<noteq> null" and "g \<star> h \<noteq> null"
     shows "sources \<a>[f, g, h] = sources h" and "targets \<a>[f, g, h] = targets f"
     and "\<guillemotleft>\<a>[f, g, h] : (f \<star> g) \<star> h \<Rightarrow> f \<star> g \<star> h\<guillemotright>"
     proof -
       show 1: "\<guillemotleft>\<a>[f, g, h] : (f \<star> g) \<star> h \<Rightarrow> f \<star> g \<star> h\<guillemotright>"
         using assms assoc_in_vhom\<^sub>A\<^sub>W\<^sub>C by simp
       show "sources \<a>[f, g, h] = sources h"
         using assms 1 sources_dom [of "\<a>[f, g, h]"] sources_hcomp match_3
         by (elim in_homE, auto)
       show "targets \<a>[f, g, h] = targets f"
         using assms 1 targets_cod [of "\<a>[f, g, h]"] targets_hcomp match_4
         by (elim in_homE, auto)
     qed
 
     lemma assoc_simps\<^sub>A\<^sub>W\<^sub>C [simp]:
     assumes "ide f" and "ide g" and "ide h"
     and "f \<star> g \<noteq> null" and "g \<star> h \<noteq> null"
     shows "arr \<a>[f, g, h]"
     and "dom \<a>[f, g, h] = (f \<star> g) \<star> h"
     and "cod \<a>[f, g, h] = f \<star> g \<star> h"
     proof -
       have 1: "\<guillemotleft>\<a>[f, g, h] : (f \<star> g) \<star> h \<Rightarrow> f \<star> g \<star> h\<guillemotright>"
         using assms assoc_in_hom\<^sub>A\<^sub>W\<^sub>C by auto
       show "arr \<a>[f, g, h]" using 1 by auto
       show "dom \<a>[f, g, h] = (f \<star> g) \<star> h" using 1 by auto
       show "cod \<a>[f, g, h] = f \<star> g \<star> h" using 1 by auto
     qed
 
     lemma assoc'_in_hom\<^sub>A\<^sub>W\<^sub>C:
     assumes "ide f" and "ide g" and "ide h"
     and "f \<star> g \<noteq> null" and "g \<star> h \<noteq> null"
     shows "sources (inv \<a>[f, g, h]) = sources h" and "targets (inv \<a>[f, g, h]) = targets f"
     and "\<guillemotleft>inv \<a>[f, g, h] :  f \<star> g \<star> h \<Rightarrow> (f \<star> g) \<star> h\<guillemotright>"
     proof -
       show 1: "\<guillemotleft>inv \<a>[f, g, h] :  f \<star> g \<star> h \<Rightarrow> (f \<star> g) \<star> h\<guillemotright>"
         using assms assoc_in_hom\<^sub>A\<^sub>W\<^sub>C iso_assoc\<^sub>A\<^sub>W\<^sub>C inv_in_hom by auto
       show "sources (inv \<a>[f, g, h]) = sources h"
         using assms 1 sources_hcomp [of "f \<star> g" h] sources_cod match_3 null_agreement
         by (elim in_homE, metis)
       show "targets (inv \<a>[f, g, h]) = targets f"
         using assms 1 targets_hcomp [of f "g \<star> h"] targets_dom match_4 null_agreement
         by (elim in_homE, metis)
     qed
 
     lemma assoc'_simps\<^sub>A\<^sub>W\<^sub>C [simp]:
     assumes "ide f" and "ide g" and "ide h"
     and "f \<star> g \<noteq> null" and "g \<star> h \<noteq> null"
     shows "arr (inv \<a>[f, g, h])"
     and "dom (inv \<a>[f, g, h]) = f \<star> g \<star> h"
     and "cod (inv \<a>[f, g, h]) = (f \<star> g) \<star> h"
     proof -
       have 1: "\<guillemotleft>inv \<a>[f, g, h] : f \<star> g \<star> h \<Rightarrow> (f \<star> g) \<star> h\<guillemotright>"
         using assms assoc'_in_hom\<^sub>A\<^sub>W\<^sub>C by auto
       show "arr (inv \<a>[f, g, h])" using 1 by auto
       show "dom (inv \<a>[f, g, h]) = f \<star> g \<star> h" using 1 by auto
       show "cod (inv \<a>[f, g, h]) = (f \<star> g) \<star> h" using 1 by auto
     qed
 
     lemma assoc'_naturality\<^sub>A\<^sub>W\<^sub>C:
     assumes "\<tau> \<star> \<mu> \<noteq> null" and "\<mu> \<star> \<nu> \<noteq> null"
     shows "inv \<a>[cod \<tau>, cod \<mu>, cod \<nu>] \<cdot> (\<tau> \<star> \<mu> \<star> \<nu>) = ((\<tau> \<star> \<mu>) \<star> \<nu>) \<cdot> inv \<a>[dom \<tau>, dom \<mu>, dom \<nu>]"
     proof -
       have \<tau>\<mu>\<nu>: "arr \<tau> \<and> arr \<mu> \<and> arr \<nu>"
         using assms composable_implies_arr by simp
       have 0: "dom \<tau> \<star> dom \<mu> \<noteq> null \<and> dom \<mu> \<star> dom \<nu> \<noteq> null \<and>
                cod \<tau> \<star> cod \<mu> \<noteq> null \<and> cod \<mu> \<star> cod \<nu> \<noteq> null"
         using assms \<tau>\<mu>\<nu> hom_connected by simp
       have 1: "\<guillemotleft>\<tau> \<star> \<mu> \<star> \<nu> : dom \<tau> \<star> dom \<mu> \<star> dom \<nu> \<Rightarrow> cod \<tau> \<star> cod \<mu> \<star> cod \<nu>\<guillemotright>"
         using assms match_4 by auto
       have 2: "\<guillemotleft>(\<tau> \<star> \<mu>) \<star> \<nu> : (dom \<tau> \<star> dom \<mu>) \<star> dom \<nu> \<Rightarrow> (cod \<tau> \<star> cod \<mu>) \<star> cod \<nu>\<guillemotright>"
         using assms match_3 by auto
       have "(inv \<a>[cod \<tau>, cod \<mu>, cod \<nu>] \<cdot> (\<tau> \<star> \<mu> \<star> \<nu>)) \<cdot> \<a>[dom \<tau>, dom \<mu>, dom \<nu>] = (\<tau> \<star> \<mu>) \<star> \<nu>"
       proof -
         have "(\<tau> \<star> \<mu>) \<star> \<nu> = (inv \<a>[cod \<tau>, cod \<mu>, cod \<nu>] \<cdot> \<a>[cod \<tau>, cod \<mu>, cod \<nu>]) \<cdot> ((\<tau> \<star> \<mu>) \<star> \<nu>)"
           using 0 2 \<tau>\<mu>\<nu> assoc_in_hom\<^sub>A\<^sub>W\<^sub>C iso_assoc\<^sub>A\<^sub>W\<^sub>C comp_inv_arr inv_is_inverse comp_cod_arr
           by auto
         also have "... = inv \<a>[cod \<tau>, cod \<mu>, cod \<nu>] \<cdot> \<a>[cod \<tau>, cod \<mu>, cod \<nu>] \<cdot> ((\<tau> \<star> \<mu>) \<star> \<nu>)"
           using comp_assoc by auto
         also have "... = inv \<a>[cod \<tau>, cod \<mu>, cod \<nu>] \<cdot> (\<tau> \<star> \<mu> \<star> \<nu>) \<cdot> \<a>[dom \<tau>, dom \<mu>, dom \<nu>]"
           using assms \<tau>\<mu>\<nu> 0 2 assoc_naturality\<^sub>A\<^sub>W\<^sub>C by presburger
         also have "... = (inv \<a>[cod \<tau>, cod \<mu>, cod \<nu>] \<cdot> (\<tau> \<star> \<mu> \<star> \<nu>)) \<cdot> \<a>[dom \<tau>, dom \<mu>, dom \<nu>]"
           using comp_assoc by auto
         finally show ?thesis by argo
       qed
       thus ?thesis
         using 0 1 2 \<tau>\<mu>\<nu> iso_assoc\<^sub>A\<^sub>W\<^sub>C assoc'_in_hom\<^sub>A\<^sub>W\<^sub>C inv_in_hom invert_side_of_triangle(2)
         by auto
       qed
 
   end
 
   subsection "Unitors"
 
   text \<open>
     For an associative weak composition with a chosen unit isomorphism \<open>\<iota> : a \<star> a \<Rightarrow> a\<close>,
     where \<open>a\<close> is a weak unit, horizontal composition on the right by \<open>a\<close> is a fully faithful
     endofunctor \<open>R\<close> of the subcategory of arrows composable on the right with \<open>a\<close>, and is
     consequently an endo-equivalence of that subcategory.  This equivalence, together with the
     associator isomorphisms and unit isomorphism \<open>\<iota>\<close>, canonically associate, with each
     identity arrow \<open>f\<close> composable on the right with \<open>a\<close>, a \emph{right unit} isomorphism
     \<open>\<guillemotleft>\<r>[f] : f \<star> a \<Rightarrow> f\<guillemotright>\<close>.  These isomorphisms are the components of a natural isomorphism
     from \<open>R\<close> to the identity functor.
   \<close>
 
   locale right_hom_with_unit =
     associative_weak_composition V H \<a> +
     right_hom V H a
   for V :: "'a comp"                  (infixr "\<cdot>" 55)
   and H :: "'a comp"                  (infixr "\<star>" 53)
   and \<a> :: "'a \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a"      ("\<a>[_, _, _]")
   and \<iota> :: 'a
   and a :: 'a +
   assumes weak_unit_a: "weak_unit a"
   and \<iota>_in_hom: "\<guillemotleft>\<iota> : a \<star> a \<Rightarrow> a\<guillemotright>"
   and iso_\<iota>: "iso \<iota>"
   begin
 
     abbreviation R
     where "R \<equiv> H\<^sub>R a"
 
     interpretation R: endofunctor S.comp R
       using weak_unit_a weak_unit_self_composable endofunctor_H\<^sub>R by simp
     interpretation R: fully_faithful_functor S.comp S.comp R
       using weak_unit_a weak_unit_def by simp
 
     lemma fully_faithful_functor_R:
     shows "fully_faithful_functor S.comp S.comp R"
       ..
 
     definition runit  ("\<r>[_]")
     where "runit f \<equiv> THE \<mu>. \<guillemotleft>\<mu> : R f \<Rightarrow>\<^sub>S f\<guillemotright> \<and> R \<mu> = (f \<star> \<iota>) \<cdot>\<^sub>S \<a>[f, a, a]"
 
     lemma iso_unit:
     shows "S.iso \<iota>" and "\<guillemotleft>\<iota> : a \<star> a \<Rightarrow>\<^sub>S a\<guillemotright>"
     proof -
       show "\<guillemotleft>\<iota> : a \<star> a \<Rightarrow>\<^sub>S a\<guillemotright>"
       proof -
         have a: "weak_unit a \<and> S.ide a"
           using weak_unit_a S.ide_char S.arr_char right_def weak_unit_self_composable
           by metis
         moreover have "S.arr (a \<star> a)"
           using a S.ideD(1) R.preserves_arr H\<^sub>R_def by auto
         ultimately show ?thesis
           using a S.in_hom_char S.arr_char right_def \<iota>_in_hom
           by (metis S.ideD(1) hom_connected(3) in_homE)
       qed
       thus "S.iso \<iota>"
         using iso_\<iota> iso_char by blast
     qed
 
     lemma characteristic_iso:
     assumes "S.ide f"
     shows "\<guillemotleft>\<a>[f, a, a] : (f \<star> a) \<star> a \<Rightarrow>\<^sub>S f \<star> a \<star> a\<guillemotright>"
     and "\<guillemotleft>f \<star> \<iota> : f \<star> a \<star> a \<Rightarrow>\<^sub>S f \<star> a\<guillemotright>"
     and "\<guillemotleft>(f \<star> \<iota>) \<cdot>\<^sub>S \<a>[f, a, a] : R (R f) \<Rightarrow>\<^sub>S R f\<guillemotright>"
     and "S.iso ((f \<star> \<iota>) \<cdot>\<^sub>S \<a>[f, a, a])"
     proof -
       have f: "S.ide f \<and> ide f"
         using assms S.ide_char by simp
       have a: "weak_unit a \<and> ide a \<and> S.ide a"
         using weak_unit_a S.ide_char weak_unit_def S.arr_char right_def
               weak_unit_self_composable
         by metis
       have fa: "f \<star> a \<noteq> null \<and> (f \<star> a) \<star> a \<noteq> null \<and> ((f \<star> a) \<star> a) \<star> a \<noteq> null"
       proof -
         have "S.arr (f \<star> a) \<and> S.arr ((f \<star> a) \<star> a) \<and> S.arr (((f \<star> a) \<star> a) \<star> a)"
           using assms S.ideD(1) R.preserves_arr H\<^sub>R_def by auto
         thus ?thesis
           using S.not_arr_null by fastforce
       qed
       have aa: "a \<star> a \<noteq> null"
         using a S.ideD(1) R.preserves_arr H\<^sub>R_def S.not_arr_null by auto
       have ia_a: "\<iota> \<star> a \<noteq> null"
         using weak_unit_a hom_connected(3) weak_unit_self_composable \<iota>_in_hom by blast
       have f_ia: "f \<star> \<iota> \<noteq> null"
         using assms S.ide_char right_def S.arr_char hom_connected(4) \<iota>_in_hom by auto
       show assoc_in_hom: "\<guillemotleft>\<a>[f, a, a] : (f \<star> a) \<star> a \<Rightarrow>\<^sub>S f \<star> a \<star> a\<guillemotright>"
         using a f fa hom_connected(1) [of "\<a>[f, a, a]" a] S.arr_char right_def
               match_3 match_4 S.in_hom_char
         by auto
       show 1: "\<guillemotleft>f \<star> \<iota> : f \<star> a \<star> a \<Rightarrow>\<^sub>S f \<star> a\<guillemotright>"
         using a f fa iso_unit
         by (simp add: f_ia ide_in_hom)
       moreover have "S.iso (f \<star> \<iota>)"
         using a f fa f_ia 1 VoV.arr_char VxV.inv_simp
               inv_in_hom hom_connected(2) [of f "inv \<iota>"] VoV.arr_char VoV.iso_char
               preserves_iso iso_char iso_\<iota>
         by auto
       ultimately have unit_part: "\<guillemotleft>f \<star> \<iota> : f \<star> a \<star> a \<Rightarrow>\<^sub>S f \<star> a\<guillemotright> \<and> S.iso (f \<star> \<iota>)"
         by blast
       show "S.iso ((f \<star> \<iota>) \<cdot>\<^sub>S \<a>[f, a, a])"
         using assms a f fa aa hom_connected(1) [of "\<a>[f, a, a]" a] right_def
               iso_assoc\<^sub>A\<^sub>W\<^sub>C iso_char S.arr_char unit_part assoc_in_hom isos_compose
         using S.isos_compose S.seqI' by auto
       show "\<guillemotleft>(f \<star> \<iota>) \<cdot>\<^sub>S \<a>[f, a, a] : R (R f) \<Rightarrow>\<^sub>S R f\<guillemotright>"
         unfolding H\<^sub>R_def using unit_part assoc_in_hom by blast
     qed
 
     lemma runit_char:
     assumes "S.ide f"
     shows "\<guillemotleft>\<r>[f] : R f \<Rightarrow>\<^sub>S f\<guillemotright>" and "R \<r>[f] = (f \<star> \<iota>) \<cdot>\<^sub>S \<a>[f, a, a]"
     and "\<exists>!\<mu>. \<guillemotleft>\<mu> : R f \<Rightarrow>\<^sub>S f\<guillemotright> \<and> R \<mu> = (f \<star> \<iota>) \<cdot>\<^sub>S \<a>[f, a, a]"
     proof -
       let ?P = "\<lambda>\<mu>. \<guillemotleft>\<mu> : R f \<Rightarrow>\<^sub>S f\<guillemotright> \<and> R \<mu> = (f \<star> \<iota>) \<cdot>\<^sub>S \<a>[f, a, a]"
       show "\<exists>!\<mu>. ?P \<mu>"
       proof -
         have "\<exists>\<mu>. ?P \<mu>"
         proof -
           have 1: "S.ide f"
             using assms S.ide_char S.arr_char by simp
           moreover have "S.ide (R f)"
             using 1 R.preserves_ide by simp
           ultimately show ?thesis
             using assms characteristic_iso(3) R.is_full by blast
         qed
         moreover have "\<forall>\<mu> \<mu>'. ?P \<mu> \<and> ?P \<mu>' \<longrightarrow> \<mu> = \<mu>'"
         proof
           fix \<mu>
           show "\<forall>\<mu>'. ?P \<mu> \<and> ?P \<mu>' \<longrightarrow> \<mu> = \<mu>'"
             using R.is_faithful [of \<mu>] by fastforce
         qed
         ultimately show ?thesis by blast
       qed
       hence "?P (THE \<mu>. ?P \<mu>)"
         using theI' [of ?P] by fastforce
       hence 1: "?P \<r>[f]"
         unfolding runit_def by blast
       show "\<guillemotleft>\<r>[f] : R f \<Rightarrow>\<^sub>S f\<guillemotright>" using 1 by fast
       show "R \<r>[f] = (f \<star> \<iota>) \<cdot>\<^sub>S \<a>[f, a, a]" using 1 by fast
     qed
 
     lemma iso_runit:
     assumes "S.ide f"
     shows "S.iso \<r>[f]"
       using assms characteristic_iso(4) runit_char R.reflects_iso by metis
 
     lemma runit_eqI:
     assumes "\<guillemotleft>f : a \<Rightarrow>\<^sub>S b\<guillemotright>" and "\<guillemotleft>\<mu> : R f \<Rightarrow>\<^sub>S f\<guillemotright>"
     and "R \<mu> = ((f \<star> \<iota>) \<cdot>\<^sub>S \<a>[f, a, a])"
     shows "\<mu> = \<r>[f]"
     proof -
       have "S.ide f" using assms(2) S.ide_cod by auto
       thus ?thesis using assms runit_char [of f] by auto
     qed
 
     lemma runit_naturality:
     assumes "S.arr \<mu>"
     shows "\<r>[S.cod \<mu>] \<cdot>\<^sub>S R \<mu> = \<mu> \<cdot>\<^sub>S \<r>[S.dom \<mu>]"
     proof -
       have 1: "\<guillemotleft>\<r>[S.cod \<mu>] \<cdot>\<^sub>S R \<mu> : R (S.dom \<mu>) \<Rightarrow>\<^sub>S S.cod \<mu>\<guillemotright>"
         using assms runit_char(1) S.ide_cod by blast
       have 2: "S.par (\<r>[S.cod \<mu>] \<cdot>\<^sub>S R \<mu>) (\<mu> \<cdot>\<^sub>S \<r>[S.dom \<mu>])"
       proof -
         have "\<guillemotleft>\<mu> \<cdot>\<^sub>S \<r>[S.dom \<mu>] : R (S.dom \<mu>) \<Rightarrow>\<^sub>S S.cod \<mu>\<guillemotright>"
           using assms S.ide_dom runit_char(1) by blast
         thus ?thesis using 1 by (elim S.in_homE, auto)
       qed
       moreover have "R (\<r>[S.cod \<mu>] \<cdot>\<^sub>S R \<mu>) = R (\<mu> \<cdot>\<^sub>S \<r>[S.dom \<mu>])"
       proof -
         have 3: "\<guillemotleft>\<mu> \<star> a \<star> a : S.dom \<mu> \<star> a \<star> a \<Rightarrow>\<^sub>S S.cod \<mu> \<star> a \<star> a\<guillemotright>"
           using assms weak_unit_a R.preserves_hom H\<^sub>R_def S.arr_iff_in_hom S.arr_char
           by (metis match_4 weak_unit_in_vhom weak_unit_self_right S.in_hom_char
               left_hcomp_closed S.not_arr_null S.null_char)
         have 4: "R (\<r>[S.cod \<mu>] \<cdot>\<^sub>S R \<mu>) = R \<r>[S.cod \<mu>] \<cdot>\<^sub>S R (R \<mu>)"
           using assms 1 R.preserves_comp_2 by blast
         also have 5: "... = ((S.cod \<mu> \<star> \<iota>) \<cdot>\<^sub>S \<a>[S.cod \<mu>, a, a]) \<cdot>\<^sub>S ((\<mu> \<star> a) \<star> a)"
           using assms R.preserves_arr runit_char S.ide_cod H\<^sub>R_def by auto
         also have 6: "... = (S.cod \<mu> \<star> \<iota>) \<cdot>\<^sub>S \<a>[S.cod \<mu>, a, a] \<cdot>\<^sub>S ((\<mu> \<star> a) \<star> a)"
           using assms S.comp_assoc by simp
         also have "... = (S.cod \<mu> \<star> \<iota>) \<cdot>\<^sub>S (\<mu> \<star> a \<star> a) \<cdot>\<^sub>S \<a>[S.dom \<mu>, a, a]"
         proof -
           have "(\<mu> \<star> a \<star> a) \<cdot>\<^sub>S \<a>[S.dom \<mu>, a, a] = \<a>[S.cod \<mu>, a, a] \<cdot>\<^sub>S ((\<mu> \<star> a) \<star> a)"
           proof -
             have "(\<mu> \<star> a \<star> a) \<cdot>\<^sub>S \<a>[S.dom \<mu>, a, a] = (\<mu> \<star> a \<star> a) \<cdot> \<a>[S.dom \<mu>, a, a]"
               using assms 3 S.ide_dom characteristic_iso(1) S.in_hom_char
                     S.comp_char [of "\<mu> \<star> a \<star> a" "\<a>[S.dom \<mu>, a, a]"]
               by fastforce
             also have "... = \<a>[S.cod \<mu>, a, a] \<cdot> ((\<mu> \<star> a) \<star> a)"
             proof -
               have "\<mu> \<star> a \<noteq> null"
                 using assms S.arr_char right_def by simp
               thus ?thesis
                 using assms weak_unit_a assoc_naturality\<^sub>A\<^sub>W\<^sub>C [of \<mu> a a] by fastforce
             qed
             also have "... = \<a>[S.cod \<mu>, a, a] \<cdot>\<^sub>S ((\<mu> \<star> a) \<star> a)"
               using S.in_hom_char S.comp_char
               by (metis 2 4 5 6 R.preserves_arr S.seq_char)
             finally show ?thesis by blast
           qed
          thus ?thesis by argo
         qed
         also have "... = ((S.cod \<mu> \<star> \<iota>) \<cdot>\<^sub>S (\<mu> \<star> a \<star> a)) \<cdot>\<^sub>S \<a>[S.dom \<mu>, a, a]"
           using S.comp_assoc by auto
         also have "... = ((\<mu> \<star> a) \<cdot>\<^sub>S (S.dom \<mu> \<star> \<iota>)) \<cdot>\<^sub>S \<a>[S.dom \<mu>, a, a]"
         proof -
           have "\<mu> \<star> a \<star> a \<noteq> null"
             using 3 S.not_arr_null by (elim S.in_homE, auto)
           moreover have "S.dom \<mu> \<star> \<iota> \<noteq> null"
             using assms S.not_arr_null
             by (metis S.dom_char \<iota>_in_hom calculation hom_connected(1-2) in_homE)
           ultimately have "(S.cod \<mu> \<star> \<iota>) \<cdot>\<^sub>S (\<mu> \<star> a \<star> a) = (\<mu> \<star> a) \<cdot>\<^sub>S (S.dom \<mu> \<star> \<iota>)"
             using assms weak_unit_a iso_unit S.comp_arr_dom S.comp_cod_arr
                   interchange [of "S.cod \<mu>" \<mu> \<iota> "a \<star> a"] interchange [of \<mu> "S.dom \<mu>" a \<iota>]
             by auto
           thus ?thesis by argo
         qed
         also have "... = (\<mu> \<star> a) \<cdot>\<^sub>S (S.dom \<mu> \<star> \<iota>) \<cdot>\<^sub>S \<a>[S.dom \<mu>, a, a]"
           using S.comp_assoc by auto
         also have "... = R \<mu> \<cdot>\<^sub>S R \<r>[S.dom \<mu>]"
           using assms runit_char(2) S.ide_dom H\<^sub>R_def by auto
         also have "... = R (\<mu> \<cdot>\<^sub>S \<r>[S.dom \<mu>])"
           using assms S.arr_iff_in_hom [of \<mu>] runit_char(1) S.ide_dom by fastforce
         finally show ?thesis by blast
       qed
       ultimately show "\<r>[S.cod \<mu>] \<cdot>\<^sub>S (R \<mu>) = \<mu> \<cdot>\<^sub>S \<r>[S.dom \<mu>]"
         using R.is_faithful by blast
     qed
 
     abbreviation \<rr>
     where "\<rr> \<mu> \<equiv> if S.arr \<mu> then \<mu> \<cdot>\<^sub>S \<r>[S.dom \<mu>] else null"
 
     interpretation \<rr>: natural_transformation S.comp S.comp R S.map \<rr>
     proof -
       interpret \<rr>: transformation_by_components S.comp S.comp R S.map runit
         using runit_char(1) runit_naturality by (unfold_locales, simp_all)
       have "\<rr>.map = \<rr>"
         using \<rr>.is_extensional \<rr>.map_def \<rr>.naturality \<rr>.map_simp_ide S.ide_dom S.ide_cod
               S.map_def
         by auto
       thus "natural_transformation S.comp S.comp R S.map \<rr>"
         using \<rr>.natural_transformation_axioms by auto
     qed
 
     lemma natural_transformation_\<rr>:
     shows "natural_transformation S.comp S.comp R S.map \<rr>" ..
 
     interpretation \<rr>: natural_isomorphism S.comp S.comp R S.map \<rr>
       using S.ide_is_iso iso_runit runit_char(1) S.isos_compose
       by (unfold_locales, force)
 
     lemma natural_isomorphism_\<rr>:
     shows "natural_isomorphism S.comp S.comp R S.map \<rr>" ..
 
     interpretation R: equivalence_functor S.comp S.comp R
       using natural_isomorphism_\<rr> R.isomorphic_to_identity_is_equivalence by blast
 
     lemma equivalence_functor_R:
     shows "equivalence_functor S.comp S.comp R"
       ..
 
     lemma runit_commutes_with_R:
     assumes "S.ide f"
     shows "\<r>[R f] = R \<r>[f]"
     proof -
       have "S.seq \<r>[f] (R \<r>[f])"
         using assms runit_char(1) R.preserves_hom [of "\<r>[f]" "R f" f] by fastforce
       moreover have "S.seq \<r>[f] \<r>[R f]"
         using assms runit_char(1) [of f] runit_char(1) [of "R f"] by auto
       ultimately show ?thesis
         using assms runit_char(1) runit_naturality [of "\<r>[f]"] iso_runit S.iso_is_section
               S.section_is_mono S.monoE [of "\<r>[f]" "R \<r>[f]" "\<r>[R f]"]
         by force
     qed
 
   end
 
   text \<open>
     Symmetric results hold for the subcategory of all arrows composable on the left with
     a specified weak unit \<open>b\<close>.  This yields the \emph{left unitors}.
   \<close>
 
   locale left_hom_with_unit =
     associative_weak_composition V H \<a> +
     left_hom V H b
   for V :: "'a comp"                  (infixr "\<cdot>" 55)
   and H :: "'a comp"                  (infixr "\<star>" 53)
   and \<a> :: "'a \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a"      ("\<a>[_, _, _]")
   and \<iota> :: 'a
   and b :: 'a +
   assumes weak_unit_b: "weak_unit b"
   and \<iota>_in_hom: "\<guillemotleft>\<iota> : b \<star> b \<Rightarrow> b\<guillemotright>"
   and iso_\<iota>: "iso \<iota>"
   begin
 
     abbreviation L
     where "L \<equiv> H\<^sub>L b"
 
     interpretation L: endofunctor S.comp L
       using weak_unit_b weak_unit_self_composable endofunctor_H\<^sub>L by simp
     interpretation L: fully_faithful_functor S.comp S.comp L
       using weak_unit_b weak_unit_def by simp
 
     lemma fully_faithful_functor_L:
     shows "fully_faithful_functor S.comp S.comp L"
       ..
 
     definition lunit  ("\<l>[_]")
     where "lunit f \<equiv> THE \<mu>. \<guillemotleft>\<mu> : L f \<Rightarrow>\<^sub>S f\<guillemotright> \<and> L \<mu> = (\<iota> \<star> f) \<cdot>\<^sub>S (inv \<a>[b, b, f])"
 
     lemma iso_unit:
     shows "S.iso \<iota>" and "\<guillemotleft>\<iota> : b \<star> b \<Rightarrow>\<^sub>S b\<guillemotright>"
     proof -
       show "\<guillemotleft>\<iota> : b \<star> b \<Rightarrow>\<^sub>S b\<guillemotright>"
       proof -
         have b: "weak_unit b \<and> S.ide b"
           using weak_unit_b S.ide_char S.arr_char left_def weak_unit_self_composable
           by metis
         moreover have "S.arr (b \<star> b)"
           using b S.ideD(1) L.preserves_arr H\<^sub>L_def by auto
         ultimately show ?thesis
           using b S.in_hom_char S.arr_char left_def \<iota>_in_hom
           by (metis S.ideD(1) hom_connected(4) in_homE)
       qed
       thus "S.iso \<iota>"
         using iso_\<iota> iso_char by blast
     qed
 
     lemma characteristic_iso:
     assumes "S.ide f"
     shows "\<guillemotleft>inv \<a>[b, b, f] :  b \<star> b \<star> f \<Rightarrow>\<^sub>S (b \<star> b) \<star> f\<guillemotright>"
     and "\<guillemotleft>\<iota> \<star> f : (b \<star> b) \<star> f \<Rightarrow>\<^sub>S b \<star> f\<guillemotright>"
     and "\<guillemotleft>(\<iota> \<star> f) \<cdot>\<^sub>S inv \<a>[b, b, f] : L (L f) \<Rightarrow>\<^sub>S L f\<guillemotright>"
     and "S.iso ((\<iota> \<star> f) \<cdot>\<^sub>S inv \<a>[b, b, f])"
     proof -
       have f: "S.ide f \<and> ide f"
         using assms S.ide_char by simp
       have b: "weak_unit b \<and> ide b \<and> S.ide b"
         using weak_unit_b S.ide_char weak_unit_def S.arr_char left_def
               weak_unit_self_composable
         by metis
       have bf: "b \<star> f \<noteq> null \<and> b \<star> b \<star> b \<star> f \<noteq> null"
       proof -
         have "S.arr (b \<star> f) \<and> S.arr (b \<star> b \<star> f) \<and> S.arr (b \<star> b \<star> b \<star> f)"
           using assms S.ideD(1) L.preserves_arr H\<^sub>L_def by auto
         thus ?thesis
           using S.not_arr_null by fastforce
       qed
       have bb: "b \<star> b \<noteq> null"
       proof -
         have "S.arr (b \<star> b)"
           using b S.ideD(1) L.preserves_arr H\<^sub>L_def by auto
         thus ?thesis
           using S.not_arr_null by fastforce
       qed
       have b_ib: "b \<star> \<iota> \<noteq> null"
         using weak_unit_b hom_connected(4) weak_unit_self_composable \<iota>_in_hom by blast
       have ib_f: "\<iota> \<star> f \<noteq> null"
         using assms S.ide_char left_def S.arr_char hom_connected(3) \<iota>_in_hom
         by auto
       show assoc_in_hom: "\<guillemotleft>inv \<a>[b, b, f] : b \<star> b \<star> f \<Rightarrow>\<^sub>S (b \<star> b) \<star> f\<guillemotright>"
         using b f bf bb hom_connected(2) [of b "inv \<a>[b, b, f]"] left_def
         by (metis S.arrI S.cod_closed S.in_hom_char assoc'_in_hom\<^sub>A\<^sub>W\<^sub>C(3) assoc'_simps\<^sub>A\<^sub>W\<^sub>C(2-3))
       show 1: "\<guillemotleft>\<iota> \<star> f : (b \<star> b) \<star> f \<Rightarrow>\<^sub>S b \<star> f\<guillemotright>"
         using b f bf by (simp add: ib_f ide_in_hom iso_unit(2))
       moreover have "S.iso (\<iota> \<star> f)"
         using b f bf ib_f 1 VoV.arr_char VxV.inv_simp
               inv_in_hom hom_connected(1) [of "inv \<iota>" f] VoV.arr_char VoV.iso_char
               preserves_iso iso_char iso_\<iota>
         by auto
       ultimately have unit_part: "\<guillemotleft>\<iota> \<star> f : (b \<star> b) \<star> f \<Rightarrow>\<^sub>S b \<star> f\<guillemotright> \<and> S.iso (\<iota> \<star> f)"
         by blast
       show "S.iso ((\<iota> \<star> f) \<cdot>\<^sub>S inv \<a>[b, b, f])"
       proof -
         have "S.iso (inv \<a>[b, b, f])"
           using assms b f bf bb hom_connected(2) [of b "inv \<a>[b, b, f]"] left_def
                iso_assoc\<^sub>A\<^sub>W\<^sub>C iso_inv_iso iso_char S.arr_char left_def
           by simp 
         thus ?thesis       
           using unit_part assoc_in_hom isos_compose by blast
       qed
       show "\<guillemotleft>(\<iota> \<star> f) \<cdot>\<^sub>S inv \<a>[b, b, f] : L (L f) \<Rightarrow>\<^sub>S L f\<guillemotright>"
         unfolding H\<^sub>L_def using unit_part assoc_in_hom by blast
     qed
 
     lemma lunit_char:
     assumes "S.ide f"
     shows "\<guillemotleft>\<l>[f] : L f \<Rightarrow>\<^sub>S f\<guillemotright>" and "L \<l>[f] = (\<iota> \<star> f) \<cdot>\<^sub>S inv \<a>[b, b, f]"
     and "\<exists>!\<mu>. \<guillemotleft>\<mu> : L f \<Rightarrow>\<^sub>S f\<guillemotright> \<and> L \<mu> = (\<iota> \<star> f) \<cdot>\<^sub>S inv \<a>[b, b, f]"
     proof -
       let ?P = "\<lambda>\<mu>. \<guillemotleft>\<mu> : L f \<Rightarrow>\<^sub>S f\<guillemotright> \<and> L \<mu> = (\<iota> \<star> f) \<cdot>\<^sub>S inv \<a>[b, b, f]"
       show "\<exists>!\<mu>. ?P \<mu>"
       proof -
         have "\<exists>\<mu>. ?P \<mu>"
         proof -
           have 1: "S.ide f"
             using assms S.ide_char S.arr_char by simp
           moreover have "S.ide (L f)"
             using 1 L.preserves_ide by simp
           ultimately show ?thesis
             using assms characteristic_iso(3) L.is_full by blast
         qed
         moreover have "\<forall>\<mu> \<mu>'. ?P \<mu> \<and> ?P \<mu>' \<longrightarrow> \<mu> = \<mu>'"
         proof
           fix \<mu>
           show "\<forall>\<mu>'. ?P \<mu> \<and> ?P \<mu>' \<longrightarrow> \<mu> = \<mu>'"
               using L.is_faithful [of \<mu>] by fastforce
         qed
         ultimately show ?thesis by blast
       qed
       hence "?P (THE \<mu>. ?P \<mu>)"
         using theI' [of ?P] by fastforce
       hence 1: "?P \<l>[f]"
         unfolding lunit_def by blast
       show "\<guillemotleft>\<l>[f] : L f \<Rightarrow>\<^sub>S f\<guillemotright>" using 1 by fast
       show "L \<l>[f] = (\<iota> \<star> f) \<cdot>\<^sub>S inv \<a>[b, b, f]" using 1 by fast
     qed
 
     lemma iso_lunit:
     assumes "S.ide f"
     shows "S.iso \<l>[f]"
       using assms characteristic_iso(4) lunit_char L.reflects_iso by metis
 
     lemma lunit_eqI:
     assumes "\<guillemotleft>f : a \<Rightarrow>\<^sub>S b\<guillemotright>" and "\<guillemotleft>\<mu> : L f \<Rightarrow>\<^sub>S f\<guillemotright>"
     and "L \<mu> = ((\<iota> \<star> f) \<cdot>\<^sub>S inv \<a>[b, b, f])"
     shows "\<mu> = \<l>[f]"
     proof -
       have "S.ide f" using assms(2) S.ide_cod by auto
       thus ?thesis using assms lunit_char [of f] by auto
     qed
 
     lemma lunit_naturality:
     assumes "S.arr \<mu>"
     shows "\<l>[S.cod \<mu>] \<cdot>\<^sub>S L \<mu> = \<mu> \<cdot>\<^sub>S \<l>[S.dom \<mu>]"
     proof -
       have 1: "\<guillemotleft>\<l>[S.cod \<mu>] \<cdot>\<^sub>S L \<mu> : L (S.dom \<mu>) \<Rightarrow>\<^sub>S S.cod \<mu>\<guillemotright>"
         using assms lunit_char(1) [of "S.cod \<mu>"] S.ide_cod by blast
       have "S.par (\<l>[S.cod \<mu>] \<cdot>\<^sub>S L \<mu>) (\<mu> \<cdot>\<^sub>S \<l>[S.dom \<mu>])"
       proof -
         have "\<guillemotleft>\<mu> \<cdot>\<^sub>S \<l>[S.dom \<mu>] : L (S.dom \<mu>) \<Rightarrow>\<^sub>S S.cod \<mu>\<guillemotright>"
           using assms S.ide_dom lunit_char(1) by blast
         thus ?thesis using 1 by (elim S.in_homE, auto)
       qed
       moreover have "L (\<l>[S.cod \<mu>] \<cdot>\<^sub>S L \<mu>) = L (\<mu> \<cdot>\<^sub>S \<l>[S.dom \<mu>])"
       proof -
         have 2: "\<guillemotleft>b \<star> b \<star> \<mu> : b \<star> b \<star> S.dom \<mu> \<Rightarrow>\<^sub>S b \<star> b \<star> S.cod \<mu>\<guillemotright>"
           using assms weak_unit_b L.preserves_hom H\<^sub>L_def S.arr_iff_in_hom [of \<mu>] S.arr_char
           by simp
         have 3: "\<guillemotleft>(b \<star> b) \<star> \<mu> : (b \<star> b) \<star> S.dom \<mu> \<Rightarrow>\<^sub>S (b \<star> b) \<star> S.cod \<mu>\<guillemotright>"
           using assms weak_unit_b L.preserves_hom H\<^sub>L_def S.arr_iff_in_hom S.arr_char
           by (metis match_3 weak_unit_in_vhom weak_unit_self_left S.in_hom_char
               S.not_arr_null S.null_char right_hcomp_closed)
 
         have "L (\<l>[S.cod \<mu>] \<cdot>\<^sub>S L \<mu>) = L \<l>[S.cod \<mu>] \<cdot>\<^sub>S L (L \<mu>)"
           using assms 1 L.preserves_comp_2 by blast
         also have "... = ((\<iota> \<star> S.cod \<mu>) \<cdot>\<^sub>S inv \<a>[b, b, S.cod \<mu>]) \<cdot>\<^sub>S (b \<star> b \<star> \<mu>)"
           using assms L.preserves_arr lunit_char S.ide_cod H\<^sub>L_def by auto
         also have "... = (\<iota> \<star> S.cod \<mu>) \<cdot>\<^sub>S inv \<a>[b, b, S.cod \<mu>] \<cdot>\<^sub>S (b \<star> b \<star> \<mu>)"
           using S.comp_assoc by auto
         also have "... = (\<iota> \<star> S.cod \<mu>) \<cdot>\<^sub>S ((b \<star> b) \<star> \<mu>) \<cdot>\<^sub>S inv \<a>[b, b, S.dom \<mu>]"
         proof -
           have "inv \<a>[b, b, S.cod \<mu>] \<cdot>\<^sub>S (b \<star> b \<star> \<mu>) = ((b \<star> b) \<star> \<mu>) \<cdot>\<^sub>S inv \<a>[b, b, S.dom \<mu>]"
           proof -
             have "((b \<star> b) \<star> \<mu>) \<cdot>\<^sub>S inv \<a>[b, b, S.dom \<mu>] = ((b \<star> b) \<star> \<mu>) \<cdot> inv \<a>[b, b, S.dom \<mu>]"
               using assms 3 S.in_hom_char S.comp_char [of "(b \<star> b) \<star> \<mu>" "inv \<a>[b, b, S.dom \<mu>]"]
               by (metis S.ide_dom characteristic_iso(1) ext)
             also have "... = inv \<a>[b, b, S.cod \<mu>] \<cdot> (b \<star> b \<star> \<mu>)"
             proof -
               have "b \<star> \<mu> \<noteq> null"
                 using assms S.arr_char left_def by simp
               thus ?thesis
                 using assms weak_unit_b assoc'_naturality\<^sub>A\<^sub>W\<^sub>C [of b b \<mu>] by fastforce
             qed
             also have "... = inv \<a>[b, b, S.cod \<mu>] \<cdot>\<^sub>S (b \<star> b \<star> \<mu>)"
               using assms 2 S.in_hom_char S.comp_char
               by (metis S.comp_simp S.ide_cod S.seqI' characteristic_iso(1))
             finally show ?thesis by argo
           qed
          thus ?thesis by argo
         qed
         also have "... = ((\<iota> \<star> S.cod \<mu>) \<cdot>\<^sub>S ((b \<star> b) \<star> \<mu>)) \<cdot>\<^sub>S inv \<a>[b, b, S.dom \<mu>]"
           using S.comp_assoc by auto
         also have "... = ((b \<star> \<mu>) \<cdot>\<^sub>S (\<iota> \<star> S.dom \<mu>)) \<cdot>\<^sub>S inv \<a>[b, b, S.dom \<mu>]"
         proof -
           have "(b \<star> b) \<star> \<mu> \<noteq> null"
             using 3 S.not_arr_null by (elim S.in_homE, auto)
           moreover have "\<iota> \<star> S.dom \<mu> \<noteq> null"
             using assms S.not_arr_null
             by (metis S.dom_char \<iota>_in_hom calculation hom_connected(1-2) in_homE)
           ultimately have "(\<iota> \<star> S.cod \<mu>) \<cdot>\<^sub>S ((b \<star> b) \<star> \<mu>) = (b \<star> \<mu>) \<cdot>\<^sub>S (\<iota> \<star> S.dom \<mu>)"
             using assms weak_unit_b iso_unit S.comp_arr_dom S.comp_cod_arr
                   interchange [of \<iota> "b \<star> b" "S.cod \<mu>" \<mu> ] interchange [of b \<iota> \<mu> "S.dom \<mu>"]
             by auto
           thus ?thesis by argo
         qed
         also have "... = (b \<star> \<mu>) \<cdot>\<^sub>S (\<iota> \<star> S.dom \<mu>) \<cdot>\<^sub>S inv \<a>[b, b, S.dom \<mu>]"
           using S.comp_assoc by auto
         also have "... = L \<mu> \<cdot>\<^sub>S L \<l>[S.dom \<mu>]"
           using assms lunit_char(2) S.ide_dom H\<^sub>L_def by auto
         also have "... = L (\<mu> \<cdot>\<^sub>S \<l>[S.dom \<mu>])"
           using assms S.arr_iff_in_hom [of \<mu>] lunit_char(1) S.ide_dom S.seqI
           by fastforce
         finally show ?thesis by blast
       qed
       ultimately show "\<l>[S.cod \<mu>] \<cdot>\<^sub>S L \<mu> = \<mu> \<cdot>\<^sub>S \<l>[S.dom \<mu>]"
         using L.is_faithful by blast
     qed
 
     abbreviation \<ll>
     where "\<ll> \<mu> \<equiv> if S.arr \<mu> then \<mu> \<cdot>\<^sub>S \<l>[S.dom \<mu>] else null"
 
     interpretation \<ll>: natural_transformation S.comp S.comp L S.map \<ll>
     proof -
       interpret \<ll>: transformation_by_components S.comp S.comp L S.map lunit
         using lunit_char(1) lunit_naturality by (unfold_locales, simp_all)
       have "\<ll>.map = \<ll>"
         using \<ll>.is_extensional \<ll>.map_def \<ll>.naturality \<ll>.map_simp_ide S.ide_dom S.ide_cod
               S.map_def
         by auto
       thus "natural_transformation S.comp S.comp L S.map \<ll>"
         using \<ll>.natural_transformation_axioms by auto
     qed
 
     lemma natural_transformation_\<ll>:
     shows "natural_transformation S.comp S.comp L S.map \<ll>" ..
 
     interpretation \<ll>: natural_isomorphism S.comp S.comp L S.map \<ll>
       using S.ide_is_iso iso_lunit lunit_char(1) S.isos_compose
       by (unfold_locales, force)
 
     lemma natural_isomorphism_\<ll>:
     shows "natural_isomorphism S.comp S.comp L S.map \<ll>" ..
 
     interpretation L: equivalence_functor S.comp S.comp L
       using natural_isomorphism_\<ll> L.isomorphic_to_identity_is_equivalence by blast
 
     lemma equivalence_functor_L:
     shows "equivalence_functor S.comp S.comp L"
       ..
 
     lemma lunit_commutes_with_L:
     assumes "S.ide f"
     shows "\<l>[L f] = L \<l>[f]"
     proof -
       have "S.seq \<l>[f] (L \<l>[f])"
         using assms lunit_char(1) L.preserves_hom [of "\<l>[f]" "L f" f] by fastforce
       moreover have "S.seq \<l>[f] \<l>[L f]"
         using assms lunit_char(1) [of f] lunit_char(1) [of "L f"] by auto
       ultimately show ?thesis
         using assms lunit_char(1) lunit_naturality [of "\<l>[f]"] iso_lunit S.iso_is_section
               S.section_is_mono S.monoE [of "\<l>[f]" "L \<l>[f]" "\<l>[L f]"]
         by force
     qed
 
   end
 
   subsection "Prebicategories"
 
   text \<open>
     A \emph{prebicategory} is an associative weak composition satisfying the additional assumption
     that every arrow has a source and a target.
   \<close>
 
   locale prebicategory =
     associative_weak_composition +
   assumes arr_has_source: "arr \<mu> \<Longrightarrow> sources \<mu> \<noteq> {}"
   and arr_has_target: "arr \<mu> \<Longrightarrow> targets \<mu> \<noteq> {}"
   begin
 
     lemma arr_iff_has_src:
     shows "arr \<mu> \<longleftrightarrow> sources \<mu> \<noteq> {}"
       using arr_has_source composable_implies_arr by auto
 
     lemma arr_iff_has_trg:
     shows "arr \<mu> \<longleftrightarrow> targets \<mu> \<noteq> {}"
       using arr_has_target composable_implies_arr by auto
 
   end
 
   text \<open>
     The horizontal composition of a prebicategory is regular.
   \<close>
 
   sublocale prebicategory \<subseteq> regular_weak_composition V H
   proof
     show "\<And>a f. a \<in> sources f \<Longrightarrow> ide f \<Longrightarrow> f \<star> a \<cong> f"
     proof -
       fix a f
       assume a: "a \<in> sources f" and f: "ide f"
       interpret Right_a: subcategory V \<open>right a\<close>
         using a right_hom_is_subcategory weak_unit_self_composable by force
       interpret Right_a: right_hom_with_unit V H \<a> \<open>some_unit a\<close> a
         using a iso_some_unit by (unfold_locales, auto)
       show "f \<star> a \<cong> f"
       proof -
         have "Right_a.ide f"
           using a f Right_a.ide_char Right_a.arr_char right_def by auto
         hence "Right_a.iso (Right_a.runit f) \<and> (Right_a.runit f) \<in> Right_a.hom (f \<star> a) f"
           using Right_a.iso_runit Right_a.runit_char(1) H\<^sub>R_def by simp
         hence "iso (Right_a.runit f) \<and> (Right_a.runit f) \<in> hom (f \<star> a) f"
           using Right_a.iso_char Right_a.hom_char by auto
         thus ?thesis using f isomorphic_def by auto
       qed
     qed
     show "\<And>b f. b \<in> targets f \<Longrightarrow> ide f \<Longrightarrow> b \<star> f \<cong> f"
     proof -
       fix b f
       assume b: "b \<in> targets f" and f: "ide f"
       interpret Left_b: subcategory V \<open>left b\<close>
         using b left_hom_is_subcategory weak_unit_self_composable by force
       interpret Left_b: left_hom_with_unit V H \<a> \<open>some_unit b\<close> b
         using b iso_some_unit by (unfold_locales, auto)
       show "b \<star> f \<cong> f"
       proof -
         have "Left_b.ide f"
           using b f Left_b.ide_char Left_b.arr_char left_def by auto
         hence "Left_b.iso (Left_b.lunit f) \<and> (Left_b.lunit f) \<in> Left_b.hom (b \<star> f) f"
           using b f Left_b.iso_lunit Left_b.lunit_char(1) H\<^sub>L_def by simp
         hence "iso (Left_b.lunit f) \<and> (Left_b.lunit f) \<in> hom (b \<star> f) f"
           using Left_b.iso_char Left_b.hom_char by auto
         thus ?thesis using isomorphic_def by auto
       qed
     qed
   qed
 
   text \<open>
     The regularity allows us to show that, in a prebicategory, all sources of
     a given arrow are isomorphic, and similarly for targets.
   \<close>
 
   context prebicategory
   begin
 
     lemma sources_are_isomorphic:
     assumes "a \<in> sources \<mu>" and "a' \<in> sources \<mu>"
     shows "a \<cong> a'"
     proof -
       have \<mu>: "arr \<mu>" using assms composable_implies_arr by auto
       have 0: "\<And>f. \<lbrakk> ide f; a \<in> sources f; a' \<in> sources f \<rbrakk> \<Longrightarrow> a \<cong> a'"
       proof -
         fix f
         assume f: "ide f" and a: "a \<in> sources f" and a': "a' \<in> sources f"
         have 1: "a \<star> a' \<noteq> null"
           using a a' f \<mu> assms(1) sources_determine_composability sourcesD(2-3) by meson
         have 2: "a \<in> targets a' \<and> a' \<in> sources a"
           using assms 1 by blast
         show "a \<cong> a'"
           using a a' 1 2 comp_ide_source comp_target_ide [of a a']
                 weak_unit_self_composable(1) [of a] weak_unit_self_composable(1) [of a']
                 isomorphic_transitive isomorphic_symmetric
           by blast
       qed
       have "ide (dom \<mu>) \<and> a \<in> sources (dom \<mu>) \<and> a' \<in> sources (dom \<mu>)"
         using assms \<mu> sources_dom by auto
       thus ?thesis using 0 by auto
     qed
       
     lemma targets_are_isomorphic:
     assumes "b \<in> targets \<mu>" and "b' \<in> targets \<mu>"
     shows "b \<cong> b'"
     proof -
       have \<mu>: "arr \<mu>" using assms composable_implies_arr by auto
       have 0: "\<And>f. \<lbrakk> ide f; b \<in> targets f; b' \<in> targets f \<rbrakk> \<Longrightarrow> b \<cong> b'"
       proof -
         fix f
         assume f: "ide f" and b: "b \<in> targets f" and b': "b' \<in> targets f"
         have 1: "b \<star> b' \<noteq> null"
           using b b' f \<mu> assms(1) targets_determine_composability targetsD(2-3) by meson
         have 2: "b \<in> targets b' \<and> b' \<in> sources b"
           using assms 1 by blast
         show "b \<cong> b'"
           using b b' 1 2 comp_ide_source comp_target_ide [of b b']
                 weak_unit_self_composable(1) [of b] weak_unit_self_composable(1) [of b']
                 isomorphic_transitive isomorphic_symmetric
           by blast
       qed
       have "ide (dom \<mu>) \<and> b \<in> targets (dom \<mu>) \<and> b' \<in> targets (dom \<mu>)"
         using assms \<mu> targets_dom [of \<mu>] by auto
       thus ?thesis using 0 by auto
     qed
 
     text \<open>
       In fact, we now show that the sets of sources and targets of a 2-cell are
       isomorphism-closed, and hence are isomorphism classes.
       We first show that the notion ``weak unit'' is preserved under isomorphism.
     \<close>
 
     interpretation H: partial_magma H
       using is_partial_magma by auto
 
     lemma isomorphism_respects_weak_units:
     assumes "weak_unit a" and "a \<cong> a'"
     shows "weak_unit a'"
     proof -
       obtain \<phi> where \<phi>: "iso \<phi> \<and> \<guillemotleft>\<phi> : a \<Rightarrow> a'\<guillemotright>"
         using assms by auto
       interpret Left_a: subcategory V \<open>left a\<close>
         using assms left_hom_is_subcategory by fastforce
       interpret Left_a: left_hom_with_unit V H \<a> \<open>some_unit a\<close> a
         using assms iso_some_unit
         apply unfold_locales by auto
       interpret Right_a: subcategory V "right a"
         using assms right_hom_is_subcategory by fastforce
       interpret Right_a: right_hom_with_unit V H \<a> \<open>some_unit a\<close> a
         using assms iso_some_unit
         apply unfold_locales by auto
       have a': "ide a' \<and> a \<star> a' \<noteq> null \<and> a' \<star> a \<noteq> null \<and> a' \<star> a' \<noteq> null \<and>
                 \<phi> \<star> a' \<noteq> null \<and> Left_a.ide a'"
         using assms \<phi> weak_unit_self_composable hom_connected
               Left_a.ide_char Left_a.arr_char left_def
         apply auto
             apply (meson weak_unit_self_composable(3) isomorphic_implies_equicomposable)
            apply (meson weak_unit_self_composable(3) isomorphic_implies_equicomposable)
           apply (meson weak_unit_self_composable(3) isomorphic_implies_equicomposable)
          apply (metis weak_unit_self_composable(3) in_homE)
         by (meson weak_unit_self_composable(3) isomorphic_implies_equicomposable)
       have iso: "a' \<star> a' \<cong> a'"
       proof -
         have 1: "Right a' = Right a"
           using assms right_respects_isomorphic by simp
         interpret Right_a': subcategory V \<open>right a'\<close>
           using assms right_hom_is_subcategory by fastforce
         (* TODO: The previous interpretation brings in unwanted notation for in_hom. *)
         interpret Ra': endofunctor \<open>Right a'\<close> \<open>H\<^sub>R a'\<close>
           using assms a' endofunctor_H\<^sub>R by auto
         let ?\<psi> = "Left_a.lunit a' \<cdot> inv (\<phi> \<star> a')"
         have "iso ?\<psi> \<and> \<guillemotleft>?\<psi> : a' \<star> a' \<Rightarrow> a'\<guillemotright>"
         proof -
           have "iso (Left_a.lunit a') \<and> \<guillemotleft>Left_a.lunit a' : a \<star> a' \<Rightarrow> a'\<guillemotright>"
             using a' Left_a.lunit_char(1) Left_a.iso_lunit Left_a.iso_char
                   Left_a.in_hom_char H\<^sub>L_def
             by auto
           moreover have "iso (\<phi> \<star> a') \<and> \<guillemotleft>\<phi> \<star> a' : a \<star> a' \<Rightarrow> a' \<star> a'\<guillemotright>"
           proof -
             have 1: "Right_a'.iso \<phi> \<and> \<phi> \<in> Right_a'.hom (Right_a'.dom \<phi>) (Right_a'.cod \<phi>)"
               using a' \<phi> Right_a'.iso_char Right_a'.arr_char right_def right_iff_right_inv
                     Right_a'.arr_iff_in_hom [of \<phi>]
               by simp
             have "Right_a'.iso (H\<^sub>R a' \<phi>) \<and>
                   Right_a'.in_hom (H\<^sub>R a' \<phi>) (H\<^sub>R a' (Right_a'.dom \<phi>)) (H\<^sub>R a' (Right_a'.cod \<phi>))"
               using \<phi> 1 Ra'.preserves_iso Ra'.preserves_hom Right_a'.iso_char
                     Ra'.preserves_dom Ra'.preserves_cod Right_a'.arr_iff_in_hom [of "H\<^sub>R a' \<phi>"]
               by simp
             thus ?thesis
               using \<phi> 1 Right_a'.in_hom_char Right_a'.iso_char H\<^sub>R_def by auto
           qed
           ultimately show ?thesis
             using isos_compose iso_inv_iso inv_in_hom by blast
         qed
         thus ?thesis using isomorphic_def by auto
       qed
       text \<open>
         We show that horizontal composition on the left and right by @{term a'}
         is naturally isomorphic to the identity functor.  This follows from the fact
         that if @{term a} is isomorphic to @{term a'}, then horizontal composition with @{term a}
         is naturally isomorphic to horizontal composition with @{term a'}, hence the latter is
         naturally isomorphic to the identity if the former is.
         This is conceptually simple, but there are tedious composability details to handle.
       \<close>  
       have 1: "Left a' = Left a \<and> Right a' = Right a"
         using assms left_respects_isomorphic right_respects_isomorphic by simp
       interpret L: fully_faithful_functor \<open>Left a\<close> \<open>Left a\<close> \<open>H\<^sub>L a\<close>
         using assms weak_unit_def by simp
       interpret L': endofunctor \<open>Left a\<close> \<open>H\<^sub>L a'\<close>
         using a' 1 endofunctor_H\<^sub>L [of a'] by auto
       interpret \<Phi>: natural_isomorphism \<open>Left a\<close> \<open>Left a\<close> \<open>H\<^sub>L a\<close> \<open>H\<^sub>L a'\<close> \<open>H\<^sub>L \<phi>\<close>
       proof
         fix \<mu>
         show "\<not> Left_a.arr \<mu> \<Longrightarrow> H\<^sub>L \<phi> \<mu> = Left_a.null"
           using left_def \<phi> H\<^sub>L_def hom_connected(1) Left_a.null_char null_agreement
                 Left_a.arr_char
           by auto
         assume "Left_a.arr \<mu>"
         hence \<mu>: "Left_a.arr \<mu> \<and> arr \<mu> \<and> a \<star> \<mu> \<noteq> null"
           using Left_a.arr_char left_def composable_implies_arr by simp
         have 2: "\<phi> \<star> \<mu> \<noteq> null"
           using assms \<phi> \<mu> Left_a.arr_char left_def hom_connected by auto
         show "Left_a.dom (H\<^sub>L \<phi> \<mu>) = H\<^sub>L a (Left_a.dom \<mu>)"
           using assms 2 \<phi> \<mu> Left_a.arr_char left_def hom_connected(2) [of a \<phi>]
                 weak_unit_self_composable match_4 Left_a.dom_char H\<^sub>L_def by auto
         show "Left_a.cod (H\<^sub>L \<phi> \<mu>) = H\<^sub>L a' (Left_a.cod \<mu>)"
           using assms 2 \<phi> \<mu> Left_a.arr_char left_def hom_connected(2) [of a \<phi>]
                 weak_unit_self_composable match_4 Left_a.cod_char H\<^sub>L_def
           by auto
         show "Left_a.comp (H\<^sub>L a' \<mu>) (H\<^sub>L \<phi> (Left_a.dom \<mu>)) = H\<^sub>L \<phi> \<mu>"
         proof -
           have "Left_a.comp (H\<^sub>L a' \<mu>) (H\<^sub>L \<phi> (Left_a.dom \<mu>)) =
                 Left_a.comp (a' \<star> \<mu>) (\<phi> \<star> dom \<mu>)"
             using assms 1 2 \<phi> \<mu> Left_a.dom_char left_def H\<^sub>L_def by simp
           also have "... = (a' \<star> \<mu>) \<cdot> (\<phi> \<star> dom \<mu>)"
           proof -
             have "Left_a.seq (a' \<star> \<mu>) (\<phi> \<star> dom \<mu>)"
             proof (intro Left_a.seqI)
               show 3: "Left_a.arr (\<phi> \<star> dom \<mu>)"
                 using assms 2 \<phi> \<mu> Left_a.arr_char left_def
                 by (metis H\<^sub>L_def L'.preserves_arr hcomp_simps\<^sub>W\<^sub>C(1) in_homE right_connected
                     paste_1)
               show 4: "Left_a.arr (a' \<star> \<mu>)"
                 using \<mu> H\<^sub>L_def L'.preserves_arr by auto
               show "Left_a.dom (a' \<star> \<mu>) = Left_a.cod (\<phi> \<star> dom \<mu>)"
                 using a' \<phi> \<mu> 2 3 4 Left_a.dom_char Left_a.cod_char
                 by (metis Left_a.seqE Left_a.seq_char hcomp_simps\<^sub>W\<^sub>C(1) in_homE paste_1)
             qed
             thus ?thesis using Left_a.comp_char Left_a.arr_char left_def by auto
           qed
           also have "... = a' \<cdot> \<phi> \<star> \<mu> \<cdot> dom \<mu>"
             using a' \<phi> \<mu> interchange hom_connected by auto
           also have "... = \<phi> \<star> \<mu>"
             using \<phi> \<mu> comp_arr_dom comp_cod_arr by auto
           finally show ?thesis using H\<^sub>L_def by simp
         qed
         show "Left_a.comp (H\<^sub>L \<phi> (Left_a.cod \<mu>)) (Left_a.L \<mu>) = H\<^sub>L \<phi> \<mu>"
         proof -
           have "Left_a.comp (H\<^sub>L \<phi> (Left_a.cod \<mu>)) (Left_a.L \<mu>) = Left_a.comp (\<phi> \<star> cod \<mu>) (a \<star> \<mu>)"
             using assms 1 2 \<phi> \<mu> Left_a.cod_char left_def H\<^sub>L_def by simp
           also have "... = (\<phi> \<star> cod \<mu>) \<cdot> (a \<star> \<mu>)"
           proof -
             have "Left_a.seq (\<phi> \<star> cod \<mu>) (a \<star> \<mu>)"
             proof (intro Left_a.seqI)
               show 3: "Left_a.arr (\<phi> \<star> cod \<mu>)"
                 using \<phi> \<mu> 2 Left_a.arr_char left_def
                 by (metis (no_types, lifting) H\<^sub>L_def L.preserves_arr hcomp_simps\<^sub>W\<^sub>C(1)
                     in_homE right_connected paste_2)
               show 4: "Left_a.arr (a \<star> \<mu>)"
                 using assms \<mu> Left_a.arr_char left_def
                 using H\<^sub>L_def L.preserves_arr by auto
               show "Left_a.dom (\<phi> \<star> cod \<mu>) = Left_a.cod (a \<star> \<mu>)"
                 using assms \<phi> \<mu> 2 3 4 Left_a.dom_char Left_a.cod_char
                 by (metis Left_a.seqE Left_a.seq_char hcomp_simps\<^sub>W\<^sub>C(1) in_homE paste_2)
             qed
             thus ?thesis using Left_a.comp_char Left_a.arr_char left_def by auto
           qed
           also have "... = \<phi> \<cdot> a \<star> cod \<mu> \<cdot> \<mu>"
             using \<phi> \<mu> interchange hom_connected by auto
           also have "... = \<phi> \<star> \<mu>"
             using \<phi> \<mu> comp_arr_dom comp_cod_arr by auto
           finally show ?thesis using H\<^sub>L_def by simp
         qed
         next
         fix \<mu>
         assume \<mu>: "Left_a.ide \<mu>"
         have 1: "\<phi> \<star> \<mu> \<noteq> null"
           using assms \<phi> \<mu> Left_a.ide_char Left_a.arr_char left_def hom_connected by auto
         show "Left_a.iso (H\<^sub>L \<phi> \<mu>)"
         proof -
           have "iso (\<phi> \<star> \<mu>)"
           proof -
             have "a \<in> sources \<phi> \<inter> targets \<mu>"
               using assms \<phi> \<mu> 1 hom_connected weak_unit_self_composable
                     Left_a.ide_char Left_a.arr_char left_def connected_if_composable
               by auto
             thus ?thesis
               using \<phi> \<mu> Left_a.ide_char ide_is_iso iso_hcomp\<^sub>R\<^sub>W\<^sub>C(1) by blast
           qed
           moreover have "left a (\<phi> \<star> \<mu>)"
             using assms 1 \<phi> weak_unit_self_composable hom_connected(2) [of a \<phi>]
                   left_def match_4 null_agreement
             by auto
           ultimately show ?thesis
             using Left_a.iso_char Left_a.arr_char left_iff_left_inv Left_a.inv_char H\<^sub>L_def
             by simp
         qed
       qed
       interpret L': equivalence_functor \<open>Left a'\<close> \<open>Left a'\<close> \<open>H\<^sub>L a'\<close>
       proof -
         have "naturally_isomorphic (Left a) (Left a) (H\<^sub>L a) Left_a.map"
           using assms Left_a.natural_isomorphism_\<ll> naturally_isomorphic_def by blast
         moreover have "naturally_isomorphic (Left a) (Left a) (H\<^sub>L a) (H\<^sub>L a')"
           using naturally_isomorphic_def \<Phi>.natural_isomorphism_axioms by blast
         ultimately have "naturally_isomorphic (Left a) (Left a) (H\<^sub>L a')
                                               (identity_functor.map (Left a))"
           using naturally_isomorphic_symmetric naturally_isomorphic_transitive by fast
         hence "naturally_isomorphic (Left a') (Left a') (H\<^sub>L a') (identity_functor.map (Left a'))"
           using 1 by auto
         thus "equivalence_functor (Left a') (Left a') (H\<^sub>L a')"
           using 1 L'.isomorphic_to_identity_is_equivalence naturally_isomorphic_def by fastforce
       qed
 
       text \<open>
         Now we do the same for \<open>R'\<close>.
       \<close>
       interpret R: fully_faithful_functor \<open>Right a\<close> \<open>Right a\<close> \<open>H\<^sub>R a\<close>
         using assms weak_unit_def by simp
       interpret R': endofunctor \<open>Right a\<close> \<open>H\<^sub>R a'\<close>
         using a' 1 endofunctor_H\<^sub>R [of a'] by auto
       interpret \<Psi>: natural_isomorphism \<open>Right a\<close> \<open>Right a\<close> \<open>H\<^sub>R a\<close> \<open>H\<^sub>R a'\<close> \<open>H\<^sub>R \<phi>\<close>
       proof
         fix \<mu>
         show "\<not> Right_a.arr \<mu> \<Longrightarrow> H\<^sub>R \<phi> \<mu> = Right_a.null"
           using right_def \<phi> H\<^sub>R_def hom_connected Right_a.null_char Right_a.arr_char
           by auto
         assume "Right_a.arr \<mu>"
         hence \<mu>: "Right_a.arr \<mu> \<and> arr \<mu> \<and> \<mu> \<star> a \<noteq> null"
           using Right_a.arr_char right_def composable_implies_arr by simp
         have 2: "\<mu> \<star> \<phi> \<noteq> null"
           using assms \<phi> \<mu> Right_a.arr_char right_def hom_connected by auto
         show "Right_a.dom (H\<^sub>R \<phi> \<mu>) = H\<^sub>R a (Right_a.dom \<mu>)"
           using assms 2 \<phi> \<mu> Right_a.arr_char right_def hom_connected(1) [of \<phi> a]
                 weak_unit_self_composable match_3 Right_a.dom_char H\<^sub>R_def
           by auto
         show "Right_a.cod (H\<^sub>R \<phi> \<mu>) = H\<^sub>R a' (Right_a.cod \<mu>)"
           using assms 2 a' \<phi> \<mu> Right_a.arr_char right_def hom_connected(3) [of \<phi> a]
                 weak_unit_self_composable match_3 Right_a.cod_char H\<^sub>R_def
           by auto
         show "Right_a.comp (H\<^sub>R a' \<mu>) (H\<^sub>R \<phi> (Right_a.dom \<mu>)) = H\<^sub>R \<phi> \<mu>"
         proof -
           have "Right_a.comp (H\<^sub>R a' \<mu>) (H\<^sub>R \<phi> (Right_a.dom \<mu>)) =
                 Right_a.comp (\<mu> \<star> a') (dom \<mu> \<star> \<phi>)"
             using assms 1 2 \<phi> \<mu> Right_a.dom_char right_def H\<^sub>R_def by simp
           also have "... = (\<mu> \<star> a') \<cdot> (dom \<mu> \<star> \<phi>)"
           proof -
             have "Right_a.seq (\<mu> \<star> a') (dom \<mu> \<star> \<phi>)"
             proof (intro Right_a.seqI)
               show 3: "Right_a.arr (dom \<mu> \<star> \<phi>)"
                 using assms 2 \<phi> \<mu> Right_a.arr_char right_def
                 by (metis H\<^sub>R_def R'.preserves_arr hcomp_simps\<^sub>W\<^sub>C(1) in_homE left_connected
                           paste_2)
               show 4: "Right_a.arr (\<mu> \<star> a')"
                 using \<mu> H\<^sub>R_def R'.preserves_arr by auto
               show "Right_a.dom (\<mu> \<star> a') = Right_a.cod (dom \<mu> \<star> \<phi>)"
                 using a' \<phi> \<mu> 2 3 4 Right_a.dom_char Right_a.cod_char
                 by (metis Right_a.seqE Right_a.seq_char hcomp_simps\<^sub>W\<^sub>C(1) in_homE paste_2)
             qed
             thus ?thesis using Right_a.comp_char Right_a.arr_char right_def by auto
           qed
           also have "... = \<mu> \<cdot> dom \<mu> \<star> a' \<cdot> \<phi>"
             using a' \<phi> \<mu> interchange hom_connected by auto
           also have "... = \<mu> \<star> \<phi>"
             using \<phi> \<mu> comp_arr_dom comp_cod_arr by auto
           finally show ?thesis using H\<^sub>R_def by simp
         qed
         show "Right_a.comp (H\<^sub>R \<phi> (Right_a.cod \<mu>)) (Right_a.R \<mu>) = H\<^sub>R \<phi> \<mu>"
         proof -
           have "Right_a.comp (H\<^sub>R \<phi> (Right_a.cod \<mu>)) (Right_a.R \<mu>)
                   = Right_a.comp (cod \<mu> \<star> \<phi>) (\<mu> \<star> a)"
             using assms 1 2 \<phi> \<mu> Right_a.cod_char right_def H\<^sub>R_def by simp
           also have "... = (cod \<mu> \<star> \<phi>) \<cdot> (\<mu> \<star> a)"
           proof -
             have "Right_a.seq (cod \<mu> \<star> \<phi>) (\<mu> \<star> a)"
             proof (intro Right_a.seqI)
               show 3: "Right_a.arr (cod \<mu> \<star> \<phi>)"
                 using \<phi> \<mu> 2 Right_a.arr_char right_def
                 by (metis (no_types, lifting) H\<^sub>R_def R.preserves_arr hcomp_simps\<^sub>W\<^sub>C(1)
                     in_homE left_connected paste_1)
               show 4: "Right_a.arr (\<mu> \<star> a)"
                 using assms \<mu> Right_a.arr_char right_def
                 using H\<^sub>R_def R.preserves_arr by auto
               show "Right_a.dom (cod \<mu> \<star> \<phi>) = Right_a.cod (\<mu> \<star> a)"
                 using assms \<phi> \<mu> 2 3 4 Right_a.dom_char Right_a.cod_char
                 by (metis Right_a.seqE Right_a.seq_char hcomp_simps\<^sub>W\<^sub>C(1) in_homE paste_1)
             qed
             thus ?thesis using Right_a.comp_char Right_a.arr_char right_def by auto
           qed
           also have "... = cod \<mu> \<cdot> \<mu> \<star> \<phi> \<cdot> a"
             using \<phi> \<mu> interchange hom_connected by auto
           also have "... = \<mu> \<star> \<phi>"
             using \<phi> \<mu> comp_arr_dom comp_cod_arr by auto
           finally show ?thesis using H\<^sub>R_def by simp
         qed
         next
         fix \<mu>
         assume \<mu>: "Right_a.ide \<mu>"
         have 1: "\<mu> \<star> \<phi> \<noteq> null"
           using assms \<phi> \<mu> Right_a.ide_char Right_a.arr_char right_def hom_connected by auto
         show "Right_a.iso (H\<^sub>R \<phi> \<mu>)"
         proof -
           have "iso (\<mu> \<star> \<phi>)"
           proof -
             have "a \<in> targets \<phi> \<inter> sources \<mu>"
               using assms \<phi> \<mu> 1 hom_connected weak_unit_self_composable
                     Right_a.ide_char Right_a.arr_char right_def connected_if_composable
               by (metis (full_types) IntI targetsI)
             thus ?thesis
               using \<phi> \<mu> Right_a.ide_char ide_is_iso iso_hcomp\<^sub>R\<^sub>W\<^sub>C(1) by blast
           qed
           moreover have "right a (\<mu> \<star> \<phi>)"
             using assms 1 \<phi> weak_unit_self_composable hom_connected(1) [of \<phi> a]
                   right_def match_3 null_agreement
             by auto
           ultimately show ?thesis
             using Right_a.iso_char Right_a.arr_char right_iff_right_inv
                   Right_a.inv_char H\<^sub>R_def
             by simp
         qed
       qed
       interpret R': equivalence_functor \<open>Right a'\<close> \<open>Right a'\<close> \<open>H\<^sub>R a'\<close>
       proof -
         have "naturally_isomorphic (Right a) (Right a) (H\<^sub>R a) Right_a.map"
           using assms Right_a.natural_isomorphism_\<rr> naturally_isomorphic_def by blast
         moreover have "naturally_isomorphic (Right a) (Right a) (H\<^sub>R a) (H\<^sub>R a')"
           using naturally_isomorphic_def \<Psi>.natural_isomorphism_axioms by blast
         ultimately have "naturally_isomorphic (Right a) (Right a) (H\<^sub>R a') Right_a.map"
           using naturally_isomorphic_symmetric naturally_isomorphic_transitive by fast
         hence "naturally_isomorphic (Right a') (Right a') (H\<^sub>R a') 
                  (identity_functor.map (Right a'))"
           using 1 by auto
         thus "equivalence_functor (Right a') (Right a') (H\<^sub>R a')"
           using 1 R'.isomorphic_to_identity_is_equivalence naturally_isomorphic_def
           by fastforce
       qed
 
       show "weak_unit a'"
         using weak_unit_def iso L'.fully_faithful_functor_axioms R'.fully_faithful_functor_axioms
         by blast
     qed
 
     lemma sources_iso_closed:
     assumes "a \<in> sources \<mu>" and "a \<cong> a'"
     shows "a' \<in> sources \<mu>"
       using assms isomorphism_respects_weak_units isomorphic_implies_equicomposable
       by blast
 
     lemma targets_iso_closed:
     assumes "a \<in> targets \<mu>" and "a \<cong> a'"
     shows "a' \<in> targets \<mu>"
       using assms isomorphism_respects_weak_units isomorphic_implies_equicomposable
       by blast
 
     lemma sources_eqI:
     assumes "sources \<mu> \<inter> sources \<nu> \<noteq> {}"
     shows "sources \<mu> = sources \<nu>"
       using assms sources_iso_closed sources_are_isomorphic by blast
 
     lemma targets_eqI:
     assumes "targets \<mu> \<inter> targets \<nu> \<noteq> {}"
     shows "targets \<mu> = targets \<nu>"
       using assms targets_iso_closed targets_are_isomorphic by blast
 
     text \<open>
       The sets of sources and targets of a weak unit are isomorphism classes.
     \<close>
 
     lemma sources_char:
     assumes "weak_unit a"
     shows "sources a = {x. x \<cong> a}"
       using assms sources_iso_closed weak_unit_iff_self_source sources_are_isomorphic
             isomorphic_symmetric
       by blast
 
     lemma targets_char:
     assumes "weak_unit a"
     shows "targets a = {x. x \<cong> a}"
       using assms targets_iso_closed weak_unit_iff_self_target targets_are_isomorphic
             isomorphic_symmetric
       by blast
 
   end
 
   section "Horizontal Homs"
 
   text \<open>
     Here we define a locale that axiomatizes a (vertical) category \<open>V\<close> that has been
     punctuated into ``horizontal homs'' by the choice of idempotent endofunctors \<open>src\<close> and \<open>trg\<close>
     that assign a specific ``source'' and ``target'' 1-cell to each of its arrows.
     The functors \<open>src\<close> and \<open>trg\<close> are also subject to further conditions that constrain how
     they commute with each other.
   \<close>
 
   locale horizontal_homs =
     category V +
     src: endofunctor V src +
     trg: endofunctor V trg
   for V :: "'a comp"      (infixr "\<cdot>" 55)
   and src :: "'a \<Rightarrow> 'a"
   and trg :: "'a \<Rightarrow> 'a" +
   assumes ide_src [simp]: "arr \<mu> \<Longrightarrow> ide (src \<mu>)"
   and ide_trg [simp]: "arr \<mu> \<Longrightarrow> ide (trg \<mu>)"
   and src_src [simp]: "arr \<mu> \<Longrightarrow> src (src \<mu>) = src \<mu>"
   and trg_trg [simp]: "arr \<mu> \<Longrightarrow> trg (trg \<mu>) = trg \<mu>"
   and trg_src [simp]: "arr \<mu> \<Longrightarrow> trg (src \<mu>) = src \<mu>"
   and src_trg [simp]: "arr \<mu> \<Longrightarrow> src (trg \<mu>) = trg \<mu>"
   begin
 
     no_notation in_hom        ("\<guillemotleft>_ : _ \<rightarrow> _\<guillemotright>")
     notation in_hom           ("\<guillemotleft>_ : _ \<Rightarrow> _\<guillemotright>")
 
     text \<open>
       We define an \emph{object} to be an arrow that is its own source
       (or equivalently, its own target).
     \<close>
 
     definition obj
     where "obj a \<equiv> arr a \<and> src a = a"
 
     lemma obj_def':
     shows "obj a \<longleftrightarrow> arr a \<and> trg a = a"
       using trg_src src_trg obj_def by metis
 
     lemma objE [elim]:
     assumes "obj a" and "\<lbrakk> ide a; src a = a; trg a = a \<rbrakk> \<Longrightarrow> T"
     shows T
     proof -
       have "ide a" using assms obj_def ide_src by metis
       moreover have "src a = a" using assms obj_def by simp
       moreover have "trg a = a" using assms obj_def' by simp
       ultimately show ?thesis using assms by simp
     qed
 
     (* TODO: Can't add "arr a" or "ide a" due to looping. *)
-    lemma obj_simps [simp]:
+    lemma obj_simps (* [simp] *):
     assumes "obj a"
     shows "src a = a" and "trg a = a"
       using assms by auto
 
     lemma obj_src [intro, simp]:
     assumes "arr \<mu>"
     shows "obj (src \<mu>)"
       using assms obj_def by auto
 
     lemma obj_trg [intro, simp]:
     assumes "arr \<mu>"
     shows "obj (trg \<mu>)"
       using assms obj_def by auto
 
     definition in_hhom  ("\<guillemotleft>_ : _ \<rightarrow> _\<guillemotright>")
     where "in_hhom \<mu> a b \<equiv> arr \<mu> \<and> src \<mu> = a \<and> trg \<mu> = b"
 
     abbreviation hhom
     where "hhom a b \<equiv> {\<mu>. \<guillemotleft>\<mu> : a \<rightarrow> b\<guillemotright>}"
 
     abbreviation (input) hseq\<^sub>H\<^sub>H
     where "hseq\<^sub>H\<^sub>H \<equiv> \<lambda>\<mu> \<nu>. arr \<mu> \<and> arr \<nu> \<and> src \<mu> = trg \<nu>"
 
     lemma in_hhomI [intro, simp]:
     assumes "arr \<mu>" and "src \<mu> = a" and "trg \<mu> = b"
     shows "\<guillemotleft>\<mu> : a \<rightarrow> b\<guillemotright>"
       using assms in_hhom_def by auto
 
     lemma in_hhomE [elim]:
     assumes "\<guillemotleft>\<mu> : a \<rightarrow> b\<guillemotright>"
     and "\<lbrakk> arr \<mu>; obj a; obj b; src \<mu> = a; trg \<mu> = b \<rbrakk> \<Longrightarrow> T"
     shows "T"
       using assms in_hhom_def by auto
 
     (*
      * TODO: I tried removing the second assertion here, thinking that it should already
      * be covered by the category locale, but in fact it breaks some proofs in
      * SpanBicategory that ought to be trivial.  So it seems that the presence of
      * this introduction rule adds something, and I should consider whether this rule
      * should be added to the category locale.
      *)
     lemma ide_in_hom [intro]:
     assumes "ide f"
     shows "\<guillemotleft>f : src f \<rightarrow> trg f\<guillemotright>" and "\<guillemotleft>f : f \<Rightarrow> f\<guillemotright>"
       using assms by auto
 
     lemma src_dom [simp]:
     assumes "arr \<mu>"
     shows "src (dom \<mu>) = src \<mu>"
       using assms src.preserves_dom [of \<mu>] by simp
 
     lemma src_cod [simp]:
     assumes "arr \<mu>"
     shows "src (cod \<mu>) = src \<mu>"
       using assms src.preserves_cod [of \<mu>] by simp
 
     lemma trg_dom [simp]:
     assumes "arr \<mu>"
     shows "trg (dom \<mu>) = trg \<mu>"
       using assms trg.preserves_dom [of \<mu>] by simp
 
     lemma trg_cod [simp]:
     assumes "arr \<mu>"
     shows "trg (cod \<mu>) = trg \<mu>"
       using assms trg.preserves_cod [of \<mu>] by simp
 
     (*
      * TODO: In theory, the following simps should already be available from the fact
      * that src and trg are endofunctors.  But they seem not to get used.
      *)
     lemma dom_src [simp]:
     assumes "arr \<mu>"
     shows "dom (src \<mu>) = src \<mu>"
       using assms by simp
 
     lemma cod_src [simp]:
     assumes "arr \<mu>"
     shows "cod (src \<mu>) = src \<mu>"
       using assms by simp
 
     lemma dom_trg [simp]:
     assumes "arr \<mu>"
     shows "dom (trg \<mu>) = trg \<mu>"
       using assms by simp
 
     lemma cod_trg [simp]:
     assumes "arr \<mu>"
     shows "cod (trg \<mu>) = trg \<mu>"
       using assms by simp
 
     lemma vcomp_in_hhom [intro, simp]:
     assumes "seq \<nu> \<mu>" and "src \<nu> = a" and "trg \<nu> = b"
     shows "\<guillemotleft>\<nu> \<cdot> \<mu> : a \<rightarrow> b\<guillemotright>"
       using assms src_cod [of "\<nu> \<cdot> \<mu>"] trg_cod [of "\<nu> \<cdot> \<mu>"] by auto
 
     lemma src_vcomp [simp]:
     assumes "seq \<nu> \<mu>"
     shows "src (\<nu> \<cdot> \<mu>) = src \<nu>"
       using assms src_cod [of "\<nu> \<cdot> \<mu>"] by auto
 
     lemma trg_vcomp [simp]:
     assumes "seq \<nu> \<mu>"
     shows "trg (\<nu> \<cdot> \<mu>) = trg \<nu>"
       using assms trg_cod [of "\<nu> \<cdot> \<mu>"] by auto
 
     lemma vseq_implies_hpar:
     assumes "seq \<nu> \<mu>"
     shows "src \<nu> = src \<mu>" and "trg \<nu> = trg \<mu>"
       using assms src_dom [of "\<nu> \<cdot> \<mu>"] trg_dom [of "\<nu> \<cdot> \<mu>"] src_cod [of "\<nu> \<cdot> \<mu>"]
             trg_cod [of "\<nu> \<cdot> \<mu>"]
       by auto
 
     lemma vconn_implies_hpar:
     assumes "\<guillemotleft>\<mu> : f \<Rightarrow> g\<guillemotright>"
     shows "src \<mu> = src f" and "trg \<mu> = trg f" and "src g = src f" and "trg g = trg f"
       using assms by auto
 
     lemma src_inv [simp]:
     assumes "iso \<mu>"
     shows "src (inv \<mu>) = src \<mu>"
       using assms inv_in_hom iso_is_arr src_dom src_cod iso_inv_iso dom_inv by metis
 
     lemma trg_inv [simp]:
     assumes "iso \<mu>"
     shows "trg (inv \<mu>) = trg \<mu>"
       using assms inv_in_hom iso_is_arr trg_dom trg_cod iso_inv_iso cod_inv by metis
 
     lemma inv_in_hhom [intro, simp]:
     assumes "iso \<mu>" and "src \<mu> = a" and "trg \<mu> = b"
     shows "\<guillemotleft>inv \<mu> : a \<rightarrow> b\<guillemotright>"
       using assms iso_is_arr by simp
 
     lemma hhom_is_subcategory:
     shows "subcategory V (\<lambda>\<mu>. \<guillemotleft>\<mu> : a \<rightarrow> b\<guillemotright>)"
       using src_dom trg_dom src_cod trg_cod by (unfold_locales, auto)
 
     lemma isomorphic_objects_are_equal:
     assumes "obj a" and "obj b" and "a \<cong> b"
     shows "a = b"
       using assms isomorphic_def
       by (metis arr_inv dom_inv in_homE objE src_dom src_inv)
 
 
     text \<open>
       Having the functors \<open>src\<close> and \<open>trg\<close> allows us to form categories VV and VVV
       of formally horizontally composable pairs and triples of arrows.
     \<close>
 
     interpretation VxV: product_category V V ..
     interpretation VV: subcategory VxV.comp \<open>\<lambda>\<mu>\<nu>. hseq\<^sub>H\<^sub>H (fst \<mu>\<nu>) (snd \<mu>\<nu>)\<close>
       by (unfold_locales, auto)
 
     lemma subcategory_VV:
     shows "subcategory VxV.comp (\<lambda>\<mu>\<nu>. hseq\<^sub>H\<^sub>H (fst \<mu>\<nu>) (snd \<mu>\<nu>))"
       ..
 
     interpretation VxVxV: product_category V VxV.comp ..
     interpretation VVV: subcategory VxVxV.comp
                             \<open>\<lambda>\<tau>\<mu>\<nu>. arr (fst \<tau>\<mu>\<nu>) \<and> VV.arr (snd \<tau>\<mu>\<nu>) \<and>
                                    src (fst \<tau>\<mu>\<nu>) = trg (fst (snd \<tau>\<mu>\<nu>))\<close>
       using VV.arr_char
       by (unfold_locales, auto)
 
     lemma subcategory_VVV:
     shows "subcategory VxVxV.comp
              (\<lambda>\<tau>\<mu>\<nu>. arr (fst \<tau>\<mu>\<nu>) \<and> VV.arr (snd \<tau>\<mu>\<nu>) \<and>
                     src (fst \<tau>\<mu>\<nu>) = trg (fst (snd \<tau>\<mu>\<nu>)))"
       ..
 
   end
 
   subsection "Prebicategories with Homs"
 
   text \<open>
     A \emph{weak composition with homs} consists of a weak composition that is
     equipped with horizontal homs in such a way that the chosen source and
     target of each 2-cell \<open>\<mu>\<close> in fact lie in the set of sources and targets,
     respectively, of \<open>\<mu>\<close>, such that horizontal composition respects the
     chosen sources and targets, and such that if 2-cells \<open>\<mu>\<close> and \<open>\<nu>\<close> are
     horizontally composable, then the chosen target of \<open>\<mu>\<close> coincides with
     the chosen source of \<open>\<nu>\<close>.
   \<close>
 
   locale weak_composition_with_homs =
     weak_composition +
     horizontal_homs +
   assumes src_in_sources: "arr \<mu> \<Longrightarrow> src \<mu> \<in> sources \<mu>"
   and trg_in_targets: "arr \<mu> \<Longrightarrow> trg \<mu> \<in> targets \<mu>"
   and src_hcomp': "\<nu> \<star> \<mu> \<noteq> null \<Longrightarrow> src (\<nu> \<star> \<mu>) = src \<mu>"
   and trg_hcomp': "\<nu> \<star> \<mu> \<noteq> null \<Longrightarrow> trg (\<nu> \<star> \<mu>) = trg \<nu>"
   and seq_if_composable: "\<nu> \<star> \<mu> \<noteq> null \<Longrightarrow> src \<nu> = trg \<mu>"
 
   locale prebicategory_with_homs =
     prebicategory +
     weak_composition_with_homs
   begin
 
     lemma composable_char\<^sub>P\<^sub>B\<^sub>H:
     shows "\<nu> \<star> \<mu> \<noteq> null \<longleftrightarrow> arr \<mu> \<and> arr \<nu> \<and> src \<nu> = trg \<mu>"
     proof
       show "arr \<mu> \<and> arr \<nu> \<and> src \<nu> = trg \<mu> \<Longrightarrow> \<nu> \<star> \<mu> \<noteq> null"
         using trg_in_targets src_in_sources composable_if_connected
         by (metis sourcesD(3) targets_determine_composability)
       show "\<nu> \<star> \<mu> \<noteq> null \<Longrightarrow> arr \<mu> \<and> arr \<nu> \<and> src \<nu> = trg \<mu>"
         using seq_if_composable composable_implies_arr by auto
     qed
 
     lemma hcomp_in_hom\<^sub>P\<^sub>B\<^sub>H:
     assumes "\<guillemotleft>\<mu> : a \<rightarrow>\<^sub>W\<^sub>C b\<guillemotright>" and "\<guillemotleft>\<nu> : b \<rightarrow>\<^sub>W\<^sub>C c\<guillemotright>"
     shows "\<guillemotleft>\<nu> \<star> \<mu> : a \<rightarrow>\<^sub>W\<^sub>C c\<guillemotright>"
     and "\<guillemotleft>\<nu> \<star> \<mu> : dom \<nu> \<star> dom \<mu> \<Rightarrow> cod \<nu> \<star> cod \<mu>\<guillemotright>"
     proof -
       show "\<guillemotleft>\<nu> \<star> \<mu> : a \<rightarrow>\<^sub>W\<^sub>C c\<guillemotright>"
         using assms sources_determine_composability sources_hcomp targets_hcomp by auto
       thus "\<guillemotleft>\<nu> \<star> \<mu> : dom \<nu> \<star> dom \<mu> \<Rightarrow> cod \<nu> \<star> cod \<mu>\<guillemotright>"
         using assms by auto
     qed
 
     text \<open>
       In a prebicategory with homs, if \<open>a\<close> is an object (i.e. \<open>src a = a\<close> and \<open>trg a = a\<close>),
       then \<open>a\<close> is a weak unit.  The converse need not hold: there can be weak units that the
       \<open>src\<close> and \<open>trg\<close> mappings send to other 1-cells in the same isomorphism class.
     \<close>
 
     lemma obj_is_weak_unit:
     assumes "obj a"
     shows "weak_unit a"
     proof -
       have "a \<in> sources a"
         using assms objE src_in_sources ideD(1) by metis
       thus ?thesis by auto
     qed
 
   end
 
   subsection "Choosing Homs"
 
   text \<open>
     Every prebicategory extends to a prebicategory with homs, by choosing an arbitrary
     representative of each isomorphism class of weak units to serve as an object.
     ``The source'' of a 2-cell is defined to be the chosen representative of the set of
      all its sources (which is an isomorphism class), and similarly for ``the target''.
   \<close>
 
   context prebicategory
   begin
 
     definition rep
     where "rep f \<equiv> SOME f'. f' \<in> { f'. f \<cong> f' }"
 
     definition some_src
     where "some_src \<mu> \<equiv> if arr \<mu> then rep (SOME a. a \<in> sources \<mu>) else null"
 
     definition some_trg
     where "some_trg \<mu> \<equiv> if arr \<mu> then rep (SOME b. b \<in> targets \<mu>) else null"
 
     lemma isomorphic_ide_rep:
     assumes "ide f"
     shows "f \<cong> rep f"
     proof -
       have "\<exists>f'. f' \<in> { f'. f \<cong> f' }"
         using assms isomorphic_reflexive by blast
       thus ?thesis using rep_def someI_ex by simp
     qed
 
     lemma rep_rep:
     assumes "ide f"
     shows "rep (rep f) = rep f"
     proof -
       have "rep f \<in> { f'. f \<cong> f' }"
         using assms isomorphic_ide_rep by simp
       have "{ f'. f \<cong> f' } = { f'. rep f \<cong> f' }"
       proof -
         have "\<And>f'. f \<cong> f' \<longleftrightarrow> rep f \<cong> f'"
         proof
           fix f'
           assume f': "f \<cong> f'"
           show "rep f \<cong> f'"
           proof -
             obtain \<phi> where \<phi>: "\<phi> \<in> hom f f' \<and> iso \<phi>"
               using f' by auto
             obtain \<psi> where \<psi>: "\<psi> \<in> hom f (rep f) \<and> iso \<psi>"
               using assms isomorphic_ide_rep by blast
             have "inv \<psi> \<in> hom (rep f) f \<and> iso (inv \<psi>)"
               using \<psi> iso_inv_iso inv_in_hom by simp
             hence "iso (V \<phi> (inv \<psi>)) \<and> V \<phi> (inv \<psi>) \<in> hom (rep f) f'"
               using \<phi> isos_compose by auto
             thus ?thesis using isomorphic_def by auto
           qed
           next
           fix f'
           assume f': "rep f \<cong> f'"
           show "f \<cong> f'"
             using assms f' isomorphic_ide_rep isos_compose isomorphic_def by blast
         qed
         thus ?thesis by auto
       qed
       hence "rep (rep f) = (SOME f'. f' \<in> { f'. f \<cong> f' })"
         using assms rep_def by fastforce
       also have "... = rep f"
         using assms rep_def by simp
       finally show ?thesis by simp
     qed
 
     lemma some_src_in_sources:
     assumes "arr \<mu>"
     shows "some_src \<mu> \<in> sources \<mu>"
     proof -
       have 1: "(SOME a. a \<in> sources \<mu>) \<in> sources \<mu>"
         using assms arr_iff_has_src someI_ex [of "\<lambda>a. a \<in> sources \<mu>"] by blast
       moreover have "ide (SOME a. a \<in> sources \<mu>)"
         using 1 weak_unit_self_composable by auto
       ultimately show ?thesis
         using assms 1 some_src_def
               sources_iso_closed [of "SOME a. a \<in> sources \<mu>" \<mu>]
               isomorphic_ide_rep [of "SOME a. a \<in> sources \<mu>"]
         by metis
     qed
 
     lemma some_trg_in_targets:
     assumes "arr \<mu>"
     shows "some_trg \<mu> \<in> targets \<mu>"
     proof -
       have 1: "(SOME a. a \<in> targets \<mu>) \<in> targets \<mu>"
         using assms arr_iff_has_trg someI_ex [of "\<lambda>a. a \<in> targets \<mu>"] by blast
       moreover have "ide (SOME a. a \<in> targets \<mu>)"
         using 1 weak_unit_self_composable by auto
       ultimately show ?thesis
         using assms 1 some_trg_def
               targets_iso_closed [of "SOME a. a \<in> targets \<mu>" \<mu>]
               isomorphic_ide_rep [of "SOME a. a \<in> targets \<mu>"]
         by presburger
     qed
 
     lemma some_src_dom:
     assumes "arr \<mu>"
     shows "some_src (dom \<mu>) = some_src \<mu>"
       using assms some_src_def sources_dom by simp
 
     lemma some_src_cod:
     assumes "arr \<mu>"
     shows "some_src (cod \<mu>) = some_src \<mu>"
       using assms some_src_def sources_cod by simp
 
     lemma some_trg_dom:
     assumes "arr \<mu>"
     shows "some_trg (dom \<mu>) = some_trg \<mu>"
       using assms some_trg_def targets_dom by simp
 
     lemma some_trg_cod:
     assumes "arr \<mu>"
     shows "some_trg (cod \<mu>) = some_trg \<mu>"
       using assms some_trg_def targets_cod by simp
 
     lemma ide_some_src:
     assumes "arr \<mu>"
     shows "ide (some_src \<mu>)"
       using assms some_src_in_sources weak_unit_self_composable by blast
 
     lemma ide_some_trg:
     assumes "arr \<mu>"
     shows "ide (some_trg \<mu>)"
       using assms some_trg_in_targets weak_unit_self_composable by blast
 
     lemma some_src_composable:
     assumes "arr \<tau>"
     shows "\<tau> \<star> \<mu> \<noteq> null \<longleftrightarrow> some_src \<tau> \<star> \<mu> \<noteq> null"
       using assms some_src_in_sources sources_determine_composability by blast
 
     lemma some_trg_composable:
     assumes "arr \<sigma>"
     shows "\<mu> \<star> \<sigma> \<noteq> null \<longleftrightarrow> \<mu> \<star> some_trg \<sigma> \<noteq> null"
       using assms some_trg_in_targets targets_determine_composability by blast
 
     lemma sources_some_src:
     assumes "arr \<mu>"
     shows "sources (some_src \<mu>) = sources \<mu>"
       using assms sources_determine_composability some_src_in_sources by blast
 
     lemma targets_some_trg:
     assumes "arr \<mu>"
     shows "targets (some_trg \<mu>) = targets \<mu>"
       using assms targets_determine_composability some_trg_in_targets by blast
 
     lemma src_some_src:
     assumes "arr \<mu>"
     shows "some_src (some_src \<mu>) = some_src \<mu>"
       using assms some_src_def ide_some_src sources_some_src by force
 
     lemma trg_some_trg:
     assumes "arr \<mu>"
     shows "some_trg (some_trg \<mu>) = some_trg \<mu>"
       using assms some_trg_def ide_some_trg targets_some_trg by force
 
     lemma sources_char':
     assumes "arr \<mu>"
     shows "a \<in> sources \<mu> \<longleftrightarrow> some_src \<mu> \<cong> a"
       using assms some_src_in_sources sources_iso_closed sources_are_isomorphic by meson
 
     lemma targets_char':
     assumes "arr \<mu>"
     shows "a \<in> targets \<mu> \<longleftrightarrow> some_trg \<mu> \<cong> a"
       using assms some_trg_in_targets targets_iso_closed targets_are_isomorphic by blast
 
     text \<open>
       An arbitrary choice of sources and targets in a prebicategory results in a notion of
       formal composability that coincides with the actual horizontal composability
       of the prebicategory.
     \<close>
 
     lemma composable_char\<^sub>P\<^sub>B:
     shows "\<tau> \<star> \<sigma> \<noteq> null \<longleftrightarrow> arr \<sigma> \<and> arr \<tau> \<and> some_src \<tau> = some_trg \<sigma>"
     proof
         assume \<sigma>\<tau>: "\<tau> \<star> \<sigma> \<noteq> null"
         show "arr \<sigma> \<and> arr \<tau> \<and> some_src \<tau> = some_trg \<sigma>"
           using \<sigma>\<tau> composable_implies_arr connected_if_composable some_src_def some_trg_def
           by force
         next
         assume \<sigma>\<tau>: "arr \<sigma> \<and> arr \<tau> \<and> some_src \<tau> = some_trg \<sigma>"
         show "\<tau> \<star> \<sigma> \<noteq> null"
           using \<sigma>\<tau> some_src_in_sources some_trg_composable by force
     qed
 
     text \<open>
       A 1-cell is its own source if and only if it is its own target.
     \<close>
 
     lemma self_src_iff_self_trg:
     assumes "ide a"
     shows "a = some_src a \<longleftrightarrow> a = some_trg a"
     proof
       assume a: "a = some_src a"
       have "weak_unit a \<and> a \<star> a \<noteq> null"
         using assms a some_src_in_sources [of a] by force
       thus "a = some_trg a" using a composable_char\<^sub>P\<^sub>B by simp
       next
       assume a: "a = some_trg a"
       have "weak_unit a \<and> a \<star> a \<noteq> null"
         using assms a some_trg_in_targets [of a] by force
       thus "a = some_src a" using a composable_char\<^sub>P\<^sub>B by simp
     qed
 
     lemma some_trg_some_src:
     assumes "arr \<mu>"
     shows "some_trg (some_src \<mu>) = some_src \<mu>"
       using assms ide_some_src some_src_def some_trg_def some_src_in_sources sources_char
             targets_char sources_some_src
       by force
 
     lemma src_some_trg:
     assumes "arr \<mu>"
     shows "some_src (some_trg \<mu>) = some_trg \<mu>"
       using assms ide_some_trg some_src_def some_trg_def some_trg_in_targets sources_char
             targets_char targets_some_trg
       by force
 
     lemma some_src_eqI:
     assumes "a \<in> sources \<mu>" and "some_src a = a"
     shows "some_src \<mu> = a"
     proof -
       have 1: "arr \<mu> \<and> arr a" using assms composable_implies_arr by auto
       have "some_src \<mu> = rep (SOME x. x \<in> sources \<mu>)"
         using assms 1 some_src_def by simp
       also have "... = rep (SOME x. some_src \<mu> \<cong> x)"
         using assms 1 sources_char' by simp
       also have "... = rep (SOME x. some_src a \<cong> x)"
         using assms 1 some_src_in_sources sources_are_isomorphic
               isomorphic_symmetric isomorphic_transitive
         by metis
       also have "... = rep (SOME x. x \<in> sources a)"
         using assms 1 sources_char' by auto
       also have "... = some_src a"
         using assms 1 some_src_def by simp
       also have "... = a"
         using assms by auto
       finally show ?thesis by simp
     qed
 
     lemma some_trg_eqI:
     assumes "b \<in> targets \<mu>" and "some_trg b = b"
     shows "some_trg \<mu> = b"
     proof -
       have 1: "arr \<mu> \<and> arr b" using assms composable_implies_arr by auto
       have "some_trg \<mu> = rep (SOME x. x \<in> targets \<mu>)"
         using assms 1 some_trg_def by simp
       also have "... = rep (SOME x. some_trg \<mu> \<cong> x)"
         using assms 1 targets_char' by simp
       also have "... = rep (SOME x. some_trg b \<cong> x)"
         using assms 1 some_trg_in_targets targets_are_isomorphic
               isomorphic_symmetric isomorphic_transitive
         by metis
       also have "... = rep (SOME x. x \<in> targets b)"
         using assms 1 targets_char' by auto
       also have "... = some_trg b"
         using assms 1 some_trg_def by simp
       also have "... = b"
         using assms by auto
       finally show ?thesis by simp
     qed
 
     lemma some_src_comp:
     assumes "\<tau> \<star> \<sigma> \<noteq> null"
     shows "some_src (\<tau> \<star> \<sigma>) = some_src \<sigma>"
     proof (intro some_src_eqI [of "some_src \<sigma>" "\<tau> \<star> \<sigma>"])
       show "some_src (some_src \<sigma>) = some_src \<sigma>"
         using assms src_some_src composable_implies_arr by simp
       show "some_src \<sigma> \<in> sources (H \<tau> \<sigma>)"
         using assms some_src_in_sources composable_char\<^sub>P\<^sub>B match_3 [of \<sigma> "some_src \<sigma>"]
         by (simp add: sources_hcomp)
     qed
 
     lemma some_trg_comp:
     assumes "\<tau> \<star> \<sigma> \<noteq> null"
     shows "some_trg (\<tau> \<star> \<sigma>) = some_trg \<tau>"
     proof (intro some_trg_eqI [of "some_trg \<tau>" "\<tau> \<star> \<sigma>"])
       show "some_trg (some_trg \<tau>) = some_trg \<tau>"
         using assms trg_some_trg composable_implies_arr by simp
       show "some_trg \<tau> \<in> targets (H \<tau> \<sigma>)"
         using assms some_trg_in_targets composable_char\<^sub>P\<^sub>B match_4 [of \<tau> \<sigma> "some_trg \<tau>"]
         by (simp add: targets_hcomp)
     qed
 
     text \<open>
       The mappings that take an arrow to its chosen source or target are endofunctors
       of the vertical category, which commute with each other in the manner required
       for horizontal homs.
     \<close>
 
     interpretation S: endofunctor V some_src
       apply unfold_locales
            using some_src_def apply simp
           using ide_some_src apply simp
         using some_src_dom ide_some_src apply simp
        using some_src_cod ide_some_src apply simp
     proof -
       fix \<nu> \<mu>
       assume \<mu>\<nu>: "seq \<nu> \<mu>"
       show "some_src (\<nu> \<cdot> \<mu>) = some_src \<nu> \<cdot> some_src \<mu>"
         using \<mu>\<nu> some_src_dom [of "\<nu> \<cdot> \<mu>"] some_src_dom some_src_cod [of "\<nu> \<cdot> \<mu>"]
               some_src_cod ide_some_src
         by auto
     qed
 
     interpretation T: endofunctor V some_trg
       apply unfold_locales
           using some_trg_def apply simp
          using ide_some_trg apply simp
         using some_trg_dom ide_some_trg apply simp
        using some_trg_cod ide_some_trg apply simp
     proof -
       fix \<nu> \<mu>
       assume \<mu>\<nu>: "seq \<nu> \<mu>"
       show "some_trg (\<nu> \<cdot> \<mu>) = some_trg \<nu> \<cdot> some_trg \<mu>"
         using \<mu>\<nu> some_trg_dom [of "\<nu> \<cdot> \<mu>"] some_trg_dom some_trg_cod [of "\<nu> \<cdot> \<mu>"]
               some_trg_cod ide_some_trg
         by auto
     qed
 
     interpretation weak_composition_with_homs V H some_src some_trg
       apply unfold_locales
       using some_src_in_sources some_trg_in_targets
             src_some_src trg_some_trg src_some_trg some_trg_some_src
             some_src_comp some_trg_comp composable_char\<^sub>P\<^sub>B ide_some_src ide_some_trg
       by simp_all
 
     proposition extends_to_weak_composition_with_homs:
     shows "weak_composition_with_homs V H some_src some_trg"
       ..
 
     proposition extends_to_prebicategory_with_homs:
     shows "prebicategory_with_homs V H \<a> some_src some_trg"
       ..
 
   end
 
   subsection "Choosing Units"
 
   text \<open>
     A \emph{prebicategory with units} is a prebicategory equipped with a choice,
     for each weak unit \<open>a\<close>, of a ``unit isomorphism'' \<open>\<guillemotleft>\<i>[a] : a \<star> a \<Rightarrow> a\<guillemotright>\<close>.
   \<close>
 
   locale prebicategory_with_units =
     prebicategory V H \<a> +
     weak_composition V H
   for V :: "'a comp"                  (infixr "\<cdot>" 55)
   and H :: "'a comp"                  (infixr "\<star>" 53)
   and \<a> :: "'a \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a"      ("\<a>[_, _, _]")
   and \<i> :: "'a \<Rightarrow> 'a"                  ("\<i>[_]") +
   assumes unit_in_vhom\<^sub>P\<^sub>B\<^sub>U: "weak_unit a \<Longrightarrow> \<guillemotleft>\<i>[a] : a \<star> a \<Rightarrow> a\<guillemotright>"
   and iso_unit\<^sub>P\<^sub>B\<^sub>U: "weak_unit a \<Longrightarrow> iso \<i>[a]"
   begin
 
     lemma unit_in_hom\<^sub>P\<^sub>B\<^sub>U:
     assumes "weak_unit a"
     shows "\<guillemotleft>\<i>[a] : a \<rightarrow>\<^sub>W\<^sub>C a\<guillemotright>" and "\<guillemotleft>\<i>[a] : a \<star> a \<Rightarrow> a\<guillemotright>"
     proof -
       show 1: "\<guillemotleft>\<i>[a] : a \<star> a \<Rightarrow> a\<guillemotright>"
         using assms unit_in_vhom\<^sub>P\<^sub>B\<^sub>U by auto
       show "\<guillemotleft>\<i>[a] : a \<rightarrow>\<^sub>W\<^sub>C a\<guillemotright>"
         using assms 1 weak_unit_iff_self_source weak_unit_iff_self_target
               sources_cod [of "\<i>[a]"] targets_cod [of "\<i>[a]"]
         by (elim in_homE, auto)
     qed
 
     lemma unit_simps [simp]:
     assumes "weak_unit a"
     shows "arr \<i>[a]" and "dom \<i>[a] = a \<star> a" and "cod \<i>[a] = a"
       using assms unit_in_vhom\<^sub>P\<^sub>B\<^sub>U by auto
 
   end
 
   text \<open>
     Every prebicategory extends to a prebicategory with units, simply by choosing the
     unit isomorphisms arbitrarily.
   \<close>
 
   context prebicategory
   begin
 
     proposition extends_to_prebicategory_with_units:
     shows "prebicategory_with_units V H \<a> some_unit"
       using iso_some_unit by (unfold_locales, auto)
 
   end
 
   subsection "Horizontal Composition"
 
   text \<open>
     The following locale axiomatizes a (vertical) category \<open>V\<close> with horizontal homs,
     which in addition has been equipped with a functorial operation \<open>H\<close> of
     horizontal composition from \<open>VV\<close> to \<open>V\<close>, assumed to preserve source and target.
   \<close>
 
   locale horizontal_composition =
     horizontal_homs V src trg +
     VxV: product_category V V +
     VV: subcategory VxV.comp \<open>\<lambda>\<mu>\<nu>. hseq\<^sub>H\<^sub>H (fst \<mu>\<nu>) (snd \<mu>\<nu>)\<close> +
     H: "functor" VV.comp V \<open>\<lambda>\<mu>\<nu>. H (fst \<mu>\<nu>) (snd \<mu>\<nu>)\<close>
   for V :: "'a comp"          (infixr "\<cdot>" 55)
   and H :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"   (infixr "\<star>" 53)
   and src :: "'a \<Rightarrow> 'a"
   and trg :: "'a \<Rightarrow> 'a" +
   assumes src_hcomp: "arr (\<mu> \<star> \<nu>) \<Longrightarrow> src (\<mu> \<star> \<nu>) = src \<nu>"
   and trg_hcomp: "arr (\<mu> \<star> \<nu>) \<Longrightarrow> trg (\<mu> \<star> \<nu>) = trg \<mu>"
   begin
     (* TODO: Why does this get re-introduced? *)
     no_notation in_hom        ("\<guillemotleft>_ : _ \<rightarrow> _\<guillemotright>")
 
     text \<open>
       \<open>H\<close> is a partial magma, which shares its null with \<open>V\<close>.
     \<close>
 
     lemma is_partial_magma:
     shows "partial_magma H" and "partial_magma.null H = null"
     proof -
       have 1: "\<forall>f. null \<star> f = null \<and> f \<star> null = null"
         using H.is_extensional VV.arr_char not_arr_null by auto
       interpret H: partial_magma H
       proof
         show "\<exists>!n. \<forall>f. n \<star> f = n \<and> f \<star> n = n"
         proof
           show "\<forall>f. null \<star> f = null \<and> f \<star> null = null" by fact
           show "\<And>n. \<forall>f. n \<star> f = n \<and> f \<star> n = n \<Longrightarrow> n = null"
             using 1 VV.arr_char H.is_extensional not_arr_null by metis
         qed
       qed
       show "partial_magma H" ..
       show "H.null = null"
         using 1 H.null_def the1_equality [of "\<lambda>n. \<forall>f. n \<star> f = n \<and> f \<star> n = n"]
         by metis
     qed
 
     text \<open>
       \textbf{Note:} The following is ``almost'' \<open>H.seq\<close>, but for that we would need
       \<open>H.arr = V.arr\<close>.
       This would be unreasonable to expect, in general, as the definition of \<open>H.arr\<close> is based
       on ``strict'' units rather than weak units.
       Later we will show that we do have \<open>H.arr = V.arr\<close> if the vertical category is discrete.
     \<close>
 
     abbreviation hseq
     where "hseq \<nu> \<mu> \<equiv> arr (\<nu> \<star> \<mu>)"
 
     lemma hseq_char:
     shows "hseq \<nu> \<mu> \<longleftrightarrow> arr \<mu> \<and> arr \<nu> \<and> src \<nu> = trg \<mu>"
     proof -
       have "hseq \<nu> \<mu> \<longleftrightarrow> VV.arr (\<nu>, \<mu>)"
         using H.is_extensional H.preserves_arr by force
       also have "... \<longleftrightarrow> arr \<mu> \<and> arr \<nu> \<and> src \<nu> = trg \<mu>"
         using VV.arr_char by force
       finally show ?thesis by blast
     qed
 
     lemma hseq_char':
     shows "hseq \<nu> \<mu> \<longleftrightarrow> \<nu> \<star> \<mu> \<noteq> null"
       using VV.arr_char H.preserves_arr H.is_extensional hseq_char [of \<nu> \<mu>] by auto
 
     lemma hseqI' [simp]:
     assumes "arr \<mu>" and "arr \<nu>" and "src \<nu> = trg \<mu>"
     shows "hseq \<nu> \<mu>"
       using assms hseq_char by simp
 
     lemma hseqI [intro]:
     assumes "\<guillemotleft>\<mu> : a \<rightarrow> b\<guillemotright>" and "\<guillemotleft>\<nu> : b \<rightarrow> c\<guillemotright>"
     shows "hseq \<nu> \<mu>"
       using assms hseq_char by auto
 
     lemma hseqE [elim]:
     assumes "hseq \<nu> \<mu>"
     and "arr \<mu> \<Longrightarrow> arr \<nu> \<Longrightarrow> src \<nu> = trg \<mu> \<Longrightarrow> T"
     shows "T"
       using assms hseq_char by simp
 
     lemma hcomp_simps [simp]:
     assumes "hseq \<nu> \<mu>"
     shows "src (\<nu> \<star> \<mu>) = src \<mu>" and "trg (\<nu> \<star> \<mu>) = trg \<nu>"
     and "dom (\<nu> \<star> \<mu>) = dom \<nu> \<star> dom \<mu>" and "cod (\<nu> \<star> \<mu>) = cod \<nu> \<star> cod \<mu>"
       using assms VV.arr_char src_hcomp apply blast
       using assms VV.arr_char trg_hcomp apply blast
       using assms VV.arr_char H.preserves_dom apply force
       using assms VV.arr_char H.preserves_cod by force
 
     lemma ide_hcomp [intro, simp]:
     assumes "ide \<nu>" and "ide \<mu>" and "src \<nu> = trg \<mu>"
     shows "ide (\<nu> \<star> \<mu>)"
       using assms VV.ide_char VV.arr_char H.preserves_ide [of "(\<nu>, \<mu>)"] by auto
 
-    lemma hcomp_in_hhom [intro, simp]:
+    lemma hcomp_in_hhom [intro]:
     assumes "\<guillemotleft>\<mu> : a \<rightarrow> b\<guillemotright>" and "\<guillemotleft>\<nu> : b \<rightarrow> c\<guillemotright>"
     shows "\<guillemotleft>\<nu> \<star> \<mu> : a \<rightarrow> c\<guillemotright>"
       using assms hseq_char by fastforce
 
+    lemma hcomp_in_hhom' (* [simp] *):
+    assumes "arr \<mu>" and "arr \<nu>" and "src \<mu> = a" and "trg \<nu> = c" and "src \<nu> = trg \<mu>"
+    shows "\<guillemotleft>\<nu> \<star> \<mu> : a \<rightarrow> c\<guillemotright>"
+      using assms hseq_char by fastforce
+
     lemma hcomp_in_hhomE [elim]:
     assumes "\<guillemotleft>\<nu> \<star> \<mu> : a \<rightarrow> c\<guillemotright>"
     and "\<lbrakk> arr \<mu>; arr \<nu>; src \<nu> = trg \<mu>; src \<mu> = a; trg \<nu> = c \<rbrakk> \<Longrightarrow> T"
     shows T
       using assms in_hhom_def by fastforce
 
     lemma hcomp_in_vhom [intro]:
     assumes "\<guillemotleft>\<mu> : f \<Rightarrow> g\<guillemotright>" and "\<guillemotleft>\<nu> : h \<Rightarrow> k\<guillemotright>" and "src h = trg f"
     shows "\<guillemotleft>\<nu> \<star> \<mu> : h \<star> f \<Rightarrow> k \<star> g\<guillemotright>"
       using assms by fastforce
 
     lemma hcomp_in_vhom' [simp]:
     assumes "hseq \<nu> \<mu>"
     and "dom \<mu> = f" and "dom \<nu> = h" and "cod \<mu> = g" and "cod \<nu> = k"
     assumes "\<guillemotleft>\<mu> : f \<Rightarrow> g\<guillemotright>" and "\<guillemotleft>\<nu> : h \<Rightarrow> k\<guillemotright>" and "src h = trg f"
     shows "\<guillemotleft>\<nu> \<star> \<mu> : h \<star> f \<Rightarrow> k \<star> g\<guillemotright>"
       using assms by fastforce
 
     lemma hcomp_in_vhomE [elim]:
     assumes "\<guillemotleft>\<nu> \<star> \<mu> : f \<Rightarrow> g\<guillemotright>"
     and "\<lbrakk> arr \<mu>; arr \<nu>; src \<nu> = trg \<mu>; src \<mu> = src f; src \<mu> = src g;
            trg \<nu> = trg f; trg \<nu> = trg g \<rbrakk> \<Longrightarrow> T"
     shows T
       using assms in_hom_def
       by (metis in_homE hseqE src_cod src_dom src_hcomp trg_cod trg_dom trg_hcomp)
 
     text \<open>
       A horizontal composition yields a weak composition by simply forgetting
       the \<open>src\<close> and \<open>trg\<close> functors.
     \<close>
 
     lemma match_1:
     assumes "\<nu> \<star> \<mu> \<noteq> null" and "(\<nu> \<star> \<mu>) \<star> \<tau> \<noteq> null"
     shows "\<mu> \<star> \<tau> \<noteq> null"
       using assms H.is_extensional not_arr_null VV.arr_char hseq_char hseq_char' by auto
 
     lemma match_2:
     assumes "\<nu> \<star> (\<mu> \<star> \<tau>) \<noteq> null" and "\<mu> \<star> \<tau> \<noteq> null"
     shows "\<nu> \<star> \<mu> \<noteq> null"
       using assms H.is_extensional not_arr_null VV.arr_char hseq_char hseq_char' by auto
 
     lemma match_3:
     assumes "\<mu> \<star> \<tau> \<noteq> null" and "\<nu> \<star> \<mu> \<noteq> null"
     shows "(\<nu> \<star> \<mu>) \<star> \<tau> \<noteq> null"
       using assms H.is_extensional not_arr_null VV.arr_char hseq_char hseq_char' by auto
 
     lemma match_4:
     assumes "\<mu> \<star> \<tau> \<noteq> null" and "\<nu> \<star> \<mu> \<noteq> null"
     shows "\<nu> \<star> (\<mu> \<star> \<tau>) \<noteq> null"
       using assms H.is_extensional not_arr_null VV.arr_char hseq_char hseq_char' by auto
 
     lemma left_connected:
     assumes "seq \<nu> \<nu>'"
     shows "\<nu> \<star> \<mu> \<noteq> null \<longleftrightarrow> \<nu>' \<star> \<mu> \<noteq> null"
       using assms H.is_extensional not_arr_null VV.arr_char hseq_char'
       by (metis hseq_char seqE vseq_implies_hpar(1))
 
     lemma right_connected:
     assumes "seq \<mu> \<mu>'"
     shows "H \<nu> \<mu> \<noteq> null \<longleftrightarrow> H \<nu> \<mu>' \<noteq> null"
       using assms H.is_extensional not_arr_null VV.arr_char hseq_char'
       by (metis hseq_char seqE vseq_implies_hpar(2))
 
     proposition is_weak_composition:
     shows "weak_composition V H"
     proof -
       have 1: "(\<lambda>\<mu>\<nu>. fst \<mu>\<nu> \<star> snd \<mu>\<nu> \<noteq> null)
                  = (\<lambda>\<mu>\<nu>. arr (fst \<mu>\<nu>) \<and> arr (snd \<mu>\<nu>) \<and> src (fst \<mu>\<nu>) = trg (snd \<mu>\<nu>))"
         using hseq_char' by auto
       interpret VoV: subcategory VxV.comp \<open>\<lambda>\<mu>\<nu>. fst \<mu>\<nu> \<star> snd \<mu>\<nu> \<noteq> null\<close>
         using 1 VV.subcategory_axioms by simp
       interpret H: "functor" VoV.comp V \<open>\<lambda>\<mu>\<nu>. fst \<mu>\<nu> \<star> snd \<mu>\<nu>\<close>
         using H.functor_axioms 1 by simp
       show ?thesis
         using match_1 match_2 match_3 match_4 left_connected right_connected
         by (unfold_locales, metis)
     qed
 
     interpretation weak_composition V H
       using is_weak_composition by auto
 
      text \<open>
       It can be shown that \<open>arr ((\<nu> \<cdot> \<mu>) \<star> (\<tau> \<cdot> \<sigma>)) \<Longrightarrow> (\<nu> \<cdot> \<mu>) \<star> (\<tau> \<cdot> \<sigma>) = (\<nu> \<star> \<tau>) \<cdot> (\<mu> \<star> \<sigma>)\<close>.
       However, we do not have \<open>arr ((\<nu> \<star> \<tau>) \<cdot> (\<mu> \<star> \<sigma>)) \<Longrightarrow> (\<nu> \<cdot> \<mu>) \<star> (\<tau> \<cdot> \<sigma>) = (\<nu> \<star> \<tau>) \<cdot> (\<mu> \<star> \<sigma>)\<close>,
       because it does not follow from \<open>arr ((\<nu> \<star> \<tau>) \<cdot> (\<mu> \<star> \<sigma>))\<close> that \<open>dom \<nu> = cod \<mu>\<close>
       and \<open>dom \<tau> = cod \<sigma>\<close>, only that \<open>dom \<nu> \<star> dom \<tau> = cod \<mu> \<star> cod \<sigma>\<close>.
       So we don't get interchange unconditionally.
     \<close>
 
     lemma interchange:
     assumes "seq \<nu> \<mu>" and "seq \<tau> \<sigma>"
     shows "(\<nu> \<cdot> \<mu>) \<star> (\<tau> \<cdot> \<sigma>) = (\<nu> \<star> \<tau>) \<cdot> (\<mu> \<star> \<sigma>)"
       using assms interchange by simp
 
     lemma whisker_right:
     assumes "ide f" and "seq \<nu> \<mu>"
     shows "(\<nu> \<cdot> \<mu>) \<star> f = (\<nu> \<star> f) \<cdot> (\<mu> \<star> f)"
       using assms whisker_right by simp
 
     lemma whisker_left:
     assumes "ide f" and "seq \<nu> \<mu>"
     shows "f \<star> (\<nu> \<cdot> \<mu>) = (f \<star> \<nu>) \<cdot> (f \<star> \<mu>)"
       using assms whisker_left by simp
 
     lemma inverse_arrows_hcomp:
     assumes "iso \<mu>" and "iso \<nu>" and "src \<nu> = trg \<mu>"
     shows "inverse_arrows (\<nu> \<star> \<mu>) (inv \<nu> \<star> inv \<mu>)"
     proof -
       show "inverse_arrows (\<nu> \<star> \<mu>) (inv \<nu> \<star> inv \<mu>)"
       proof
         show "ide ((inv \<nu> \<star> inv \<mu>) \<cdot> (\<nu> \<star> \<mu>))"
         proof -
           have "(inv \<nu> \<star> inv \<mu>) \<cdot> (\<nu> \<star> \<mu>) = dom \<nu> \<star> dom \<mu>"
             using assms interchange iso_is_arr comp_inv_arr'
             by (metis arr_dom)
           thus ?thesis
             using assms iso_is_arr by simp
         qed
         show "ide ((\<nu> \<star> \<mu>) \<cdot> (inv \<nu> \<star> inv \<mu>))"
         proof -
           have "(\<nu> \<star> \<mu>) \<cdot> (inv \<nu> \<star> inv \<mu>) = cod \<nu> \<star> cod \<mu>"
             using assms interchange iso_is_arr comp_arr_inv'
             by (metis arr_cod)
           thus ?thesis
             using assms iso_is_arr by simp
         qed
       qed
     qed
 
     lemma iso_hcomp [intro, simp]:
     assumes "iso \<mu>" and "iso \<nu>" and "src \<nu> = trg \<mu>"
     shows "iso (\<nu> \<star> \<mu>)"
       using assms inverse_arrows_hcomp by auto
 
     lemma isomorphic_implies_ide:
     assumes "f \<cong> g"
     shows "ide f" and "ide g"
       using assms isomorphic_def by auto
 
     lemma hcomp_ide_isomorphic:
     assumes "ide f" and "g \<cong> h" and "src f = trg g"
     shows "f \<star> g \<cong> f \<star> h"
     proof -
       obtain \<mu> where \<mu>: "iso \<mu> \<and> \<guillemotleft>\<mu> : g \<Rightarrow> h\<guillemotright>"
         using assms isomorphic_def by auto
       have "iso (f \<star> \<mu>) \<and> \<guillemotleft>f \<star> \<mu> : f \<star> g \<Rightarrow> f \<star> h\<guillemotright>"
         using assms \<mu> iso_hcomp by auto
       thus ?thesis
         using isomorphic_def by auto
     qed
 
     lemma hcomp_isomorphic_ide:
     assumes "f \<cong> g" and "ide h" and "src f = trg h"
     shows "f \<star> h \<cong> g \<star> h"
     proof -
       obtain \<mu> where \<mu>: "iso \<mu> \<and> \<guillemotleft>\<mu> : f \<Rightarrow> g\<guillemotright>"
         using assms isomorphic_def by auto
       have "iso (\<mu> \<star> h) \<and> \<guillemotleft>\<mu> \<star> h : f \<star> h \<Rightarrow> g \<star> h\<guillemotright>"
         using assms \<mu> iso_hcomp by auto
       thus ?thesis
         using isomorphic_def by auto
     qed
 
     lemma isomorphic_implies_hpar:
     assumes "f \<cong> f'"
     shows "ide f" and "ide f'" and "src f = src f'" and "trg f = trg f'"
       using assms isomorphic_def by auto
 
     lemma inv_hcomp [simp]:
     assumes "iso \<nu>" and "iso \<mu>" and "src \<nu> = trg \<mu>"
     shows "inv (\<nu> \<star> \<mu>) = inv \<nu> \<star> inv \<mu>"
       using assms inverse_arrow_unique [of "\<nu> \<star> \<mu>"] inv_is_inverse inverse_arrows_hcomp
       by auto
 
     interpretation VxVxV: product_category V VxV.comp ..
     interpretation VVV: subcategory VxVxV.comp
                           \<open>\<lambda>\<tau>\<mu>\<nu>. arr (fst \<tau>\<mu>\<nu>) \<and> VV.arr (snd \<tau>\<mu>\<nu>) \<and>
                                  src (fst \<tau>\<mu>\<nu>) = trg (fst (snd \<tau>\<mu>\<nu>))\<close>
       using subcategory_VVV by auto
 
     text \<open>
       The following define the two ways of using horizontal composition to compose three arrows.
     \<close>
 
     definition HoHV
     where "HoHV \<mu> \<equiv> if VVV.arr \<mu> then (fst \<mu> \<star> fst (snd \<mu>)) \<star> snd (snd \<mu>) else null"
 
     definition HoVH
     where "HoVH \<mu> \<equiv> if VVV.arr \<mu> then fst \<mu> \<star> fst (snd \<mu>) \<star> snd (snd \<mu>) else null"
 
     lemma functor_HoHV:
     shows "functor VVV.comp V HoHV"
       apply unfold_locales
       using VVV.arr_char VV.arr_char VVV.dom_char VVV.cod_char VVV.comp_char HoHV_def
           apply auto[4]
     proof -
       fix f g
       assume fg: "VVV.seq g f"
       show "HoHV (VVV.comp g f) = HoHV g \<cdot> HoHV f"
       proof -
         have "VxVxV.comp g f =
               (fst g \<cdot> fst f, fst (snd g) \<cdot> fst (snd f), snd (snd g) \<cdot> snd (snd f))"
           using fg VVV.seq_char VVV.arr_char VV.arr_char VxVxV.comp_char VxV.comp_char
           by (metis (no_types, lifting) VxV.seqE VxVxV.seqE)
         hence "HoHV (VVV.comp g f) =
               (fst g \<cdot> fst f \<star> fst (snd g) \<cdot> fst (snd f)) \<star> snd (snd g) \<cdot> snd (snd f)"
           using HoHV_def VVV.comp_simp fg by auto
         also have "... = ((fst g \<star> fst (snd g)) \<star> snd (snd g)) \<cdot>
                            ((fst f \<star> fst (snd f)) \<star> snd (snd f))"
           using fg VVV.seq_char VVV.arr_char VV.arr_char interchange
           by (metis (no_types, lifting) VxV.seqE VxVxV.seqE hseqI' src_vcomp trg_vcomp)
         also have "... = HoHV g \<cdot> HoHV f"
           using HoHV_def fg by auto
         finally show ?thesis by simp
       qed
     qed
 
     lemma functor_HoVH:
     shows "functor VVV.comp V HoVH"
       apply unfold_locales
       using VVV.arr_char VV.arr_char VVV.dom_char VVV.cod_char VVV.comp_char
             HoHV_def HoVH_def
           apply auto[4]
     proof -
       fix f g
       assume fg: "VVV.seq g f"
       show "HoVH (VVV.comp g f) = HoVH g \<cdot> HoVH f"
       proof -
         have "VxVxV.comp g f =
               (fst g \<cdot> fst f, fst (snd g) \<cdot> fst (snd f), snd (snd g) \<cdot> snd (snd f))"
           using fg VVV.seq_char VVV.arr_char VV.arr_char VxVxV.comp_char VxV.comp_char
           by (metis (no_types, lifting) VxV.seqE VxVxV.seqE)
         hence "HoVH (VVV.comp g f) =
               fst g \<cdot> fst f \<star> fst (snd g) \<cdot> fst (snd f) \<star> snd (snd g) \<cdot> snd (snd f)"
           using HoVH_def VVV.comp_simp fg by auto
         also have "... = (fst g \<star> fst (snd g) \<star> snd (snd g)) \<cdot>
                            (fst f \<star> fst (snd f) \<star> snd (snd f))"
           using fg VVV.seq_char VVV.arr_char VV.arr_char interchange
           by (metis (no_types, lifting) VxV.seqE VxVxV.seqE hseqI' src_vcomp trg_vcomp)
         also have "... = HoVH g \<cdot> HoVH f"
           using fg VVV.seq_char VVV.arr_char HoVH_def VVV.comp_char VV.arr_char
           by (metis (no_types, lifting))
         finally show ?thesis by simp
       qed
     qed
 
     text \<open>
       The following define horizontal composition of an arrow on the left by its target
       and on the right by its source.
     \<close>
 
     abbreviation L
     where "L \<equiv> \<lambda>\<mu>. if arr \<mu> then trg \<mu> \<star> \<mu> else null"
 
     abbreviation R
     where "R \<equiv> \<lambda>\<mu>. if arr \<mu> then \<mu> \<star> src \<mu> else null"
 
     lemma endofunctor_L:
     shows "endofunctor V L"
       using vseq_implies_hpar(2) whisker_left
       by (unfold_locales, auto)
 
     lemma endofunctor_R:
     shows "endofunctor V R"
       using vseq_implies_hpar(1) whisker_right
       by (unfold_locales, auto)
 
   end
 
 end
diff --git a/thys/Bicategory/Strictness.thy b/thys/Bicategory/Strictness.thy
--- a/thys/Bicategory/Strictness.thy
+++ b/thys/Bicategory/Strictness.thy
@@ -1,4491 +1,4491 @@
 (*  Title:       Strictness
     Author:      Eugene W. Stark <stark@cs.stonybrook.edu>, 2019
     Maintainer:  Eugene W. Stark <stark@cs.stonybrook.edu>
 *)
 
 section "Strictness"
 
 theory Strictness
 imports Category3.ConcreteCategory Pseudofunctor CanonicalIsos
 begin
 
   text \<open>
     In this section we consider bicategories in which some or all of the canonical isomorphisms
     are assumed to be identities.  A \emph{normal} bicategory is one in which the unit
     isomorphisms are identities, so that unit laws for horizontal composition are satisfied
     ``on the nose''.
     A \emph{strict} bicategory (also known as a \emph{2-category}) is a bicategory in which both
     the unit and associativity isomoprhisms are identities, so that horizontal composition is
     strictly associative as well as strictly unital.
 
     From any given bicategory \<open>B\<close> we may construct a related strict bicategory \<open>S\<close>,
     its \emph{strictification}, together with a pseudofunctor that embeds \<open>B\<close> in \<open>S\<close>.
     The Strictness Theorem states that this pseudofunctor is an equivalence pseudofunctor,
     so that bicategory \<open>B\<close> is biequivalent to its strictification.
     The Strictness Theorem is often used informally to justify suppressing canonical
     isomorphisms; which amounts to proving a theorem about 2-categories and asserting that
     it holds for all bicategories.  Here we are working formally, so we can't just wave
     our hands and mutter something about the Strictness Theorem when we want to avoid
     dealing with units and associativities.  However, in cases where we can establish that the
     property we would like to prove is reflected by the embedding of a bicategory in its
     strictification, then we can formally apply the Strictness Theorem to generalize to all
     bicategories a result proved for 2-categories.  We will apply this approach here to
     simplify the proof of some facts about internal equivalences in a bicategory.
   \<close>
 
   subsection "Normal and Strict Bicategories"
 
   text \<open>
     A \emph{normal} bicategory is one in which the unit isomorphisms are identities,
     so that unit laws for horizontal composition are satisfied ``on the nose''.
   \<close>
 
   locale normal_bicategory =
     bicategory +
   assumes strict_lunit: "\<And>f. ide f \<Longrightarrow> \<l>[f] = f"
   and strict_runit: "\<And>f. ide f \<Longrightarrow> \<r>[f] = f"
   begin
 
     lemma strict_unit:
     assumes "obj a"
     shows "ide \<i>[a]"
       using assms strict_runit unitor_coincidence(2) [of a] by auto
 
     lemma strict_lunit':
     assumes "ide f"
     shows "\<l>\<^sup>-\<^sup>1[f] = f"
       using assms strict_lunit by simp
 
     lemma strict_runit':
     assumes "ide f"
     shows "\<r>\<^sup>-\<^sup>1[f] = f"
       using assms strict_runit by simp
 
     lemma hcomp_obj_arr:
     assumes "obj b" and "arr f" and "b = trg f"
     shows "b \<star> f = f"
       using assms strict_lunit
       by (metis comp_arr_dom comp_ide_arr ide_cod ide_dom lunit_naturality)
 
     lemma hcomp_arr_obj:
     assumes "arr f" and "obj a" and "src f = a"
     shows "f \<star> a = f"
       using assms strict_runit
       by (metis comp_arr_dom comp_ide_arr ide_cod ide_dom runit_naturality)
 
   end
 
   text \<open>
     A \emph{strict} bicategory is a normal bicategory in which the associativities are also
     identities, so that associativity of horizontal composition holds ``on the nose''.
   \<close>
 
   locale strict_bicategory =
     normal_bicategory +
   assumes strict_assoc: "\<And>f g h. \<lbrakk>ide f; ide g; ide h; src f = trg g; src g = trg h\<rbrakk> \<Longrightarrow>
                                   ide \<a>[f, g, h]"
   begin
 
     lemma strict_assoc':
     assumes "ide f" and "ide g" and "ide h" and "src f = trg g" and "src g = trg h"
     shows "ide \<a>\<^sup>-\<^sup>1[f, g, h]"
       using assms strict_assoc by simp
 
     lemma hcomp_assoc:
     shows "(\<mu> \<star> \<nu>) \<star> \<tau> = \<mu> \<star> \<nu> \<star> \<tau>"
     proof (cases "hseq \<mu> \<nu> \<and> hseq \<nu> \<tau>")
       show "\<not> (hseq \<mu> \<nu> \<and> hseq \<nu> \<tau>) \<Longrightarrow> ?thesis"
         by (metis hseqE hseq_char' match_1 match_2)
       show "hseq \<mu> \<nu> \<and> hseq \<nu> \<tau> \<Longrightarrow> ?thesis"
       proof -
         assume 1: "hseq \<mu> \<nu> \<and> hseq \<nu> \<tau>"
         have 2: "arr \<mu> \<and> arr \<nu> \<and> arr \<tau> \<and> src \<mu> = trg \<nu> \<and> src \<nu> = trg \<tau>"
           using 1 by blast
         have "(\<mu> \<star> \<nu>) \<star> \<tau> = \<a>[cod \<mu>, cod \<nu>, cod \<tau>] \<cdot> ((\<mu> \<star> \<nu>) \<star> \<tau>)"
           using 1 assoc_in_hom strict_assoc comp_cod_arr assoc_simps(4) hseq_char
           by simp
         also have "... = (\<mu> \<star> \<nu> \<star> \<tau>) \<cdot> \<a>[dom \<mu>, dom \<nu>, dom \<tau>]"
           using 1 assoc_naturality by auto
         also have "... = \<mu> \<star> \<nu> \<star> \<tau>"
           using 2 assoc_in_hom [of "dom \<mu>" "dom \<nu>" "dom \<tau>"] strict_assoc comp_arr_dom
           by auto
         finally show ?thesis by simp
       qed
     qed
 
     text \<open>
       In a strict bicategory, every canonical isomorphism is an identity.
     \<close>
 
     interpretation bicategorical_language ..
     interpretation E: self_evaluation_map V H \<a> \<i> src trg ..
     notation E.eval ("\<lbrace>_\<rbrace>")
 
     lemma ide_eval_Can:
     assumes "Can t"
     shows "ide \<lbrace>t\<rbrace>"
     proof -
       have 1: "\<And>u1 u2. \<lbrakk> ide \<lbrace>u1\<rbrace>; ide \<lbrace>u2\<rbrace>; Arr u1; Arr u2; Dom u1 = Cod u2 \<rbrakk>
                            \<Longrightarrow> ide (\<lbrace>u1\<rbrace> \<cdot> \<lbrace>u2\<rbrace>)"
         by (metis (no_types, lifting) E.eval_simps'(4-5) comp_ide_self ide_char)
       have "\<And>u. Can u \<Longrightarrow> ide \<lbrace>u\<rbrace>"
       proof -
         fix u
         show "Can u \<Longrightarrow> ide \<lbrace>u\<rbrace>"
           (* TODO: Rename \<ll>_ide_simp \<rr>_ide_simp to \<ll>_ide_eq \<rr>_ide_eq *)
           using 1 \<alpha>_def \<a>'_def strict_lunit strict_runit strict_assoc strict_assoc'
                 \<ll>_ide_simp \<rr>_ide_simp Can_implies_Arr comp_ide_arr E.eval_simps'(2-3)
           apply (induct u) by auto
       qed
       thus ?thesis
         using assms by simp
     qed
 
     lemma ide_can:
     assumes "Ide f" and "Ide g" and "\<^bold>\<lfloor>f\<^bold>\<rfloor> = \<^bold>\<lfloor>g\<^bold>\<rfloor>"
     shows "ide (can g f)"
     proof -
       have "Can (Inv (g\<^bold>\<down>) \<^bold>\<cdot> f\<^bold>\<down>)"
         using assms Can_red Can_Inv red_in_Hom Inv_in_Hom by simp
       thus ?thesis
         using assms can_def ide_eval_Can by presburger
     qed
 
   end
 
   subsection "Strictification"
 
   (*
    * TODO: Perhaps change the typeface used for a symbol that stands for a bicategory;
    * for example, to avoid the clashes here between B used as the name of a bicategory
    * and B used to denote a syntactic identity term.
    *)
 
   text \<open>
     The Strictness Theorem asserts that every bicategory is biequivalent to a
     strict bicategory.  More specifically, it shows how to construct, given an arbitrary
     bicategory, a strict bicategory (its \emph{strictification}) that is biequivalent to it.
     Consequently, given a property \<open>P\<close> of bicategories that is ``bicategorical''
     (\emph{i.e.}~respects biequivalence), if we want to show that \<open>P\<close> holds for a bicategory \<open>B\<close>
     then it suffices to show that \<open>P\<close> holds for the strictification of \<open>B\<close>, and if we want to show
     that \<open>P\<close> holds for all bicategories, it is sufficient to show that it holds for all
     strict bicategories.  This is very useful, because it becomes quite tedious, even
     with the aid of a proof assistant, to do ``diagram chases'' with all the units and
     associativities fully spelled out.
 
     Given a bicategory \<open>B\<close>, the strictification \<open>S\<close> of \<open>B\<close> may be constructed as the bicategory
     whose arrows are triples \<open>(A, B, \<mu>)\<close>, where \<open>X\<close> and \<open>Y\<close> are ``normal identity terms''
     (essentially, nonempty horizontally composable lists of 1-cells of \<open>B\<close>) having the same
     syntactic source and target, and \<open>\<guillemotleft>\<mu> : \<lbrace>X\<rbrace> \<Rightarrow> \<lbrace>Y\<rbrace>\<guillemotright>\<close> in \<open>B\<close>.
     Vertical composition in \<open>S\<close> is given by composition of the underlying arrows in \<open>B\<close>.
     Horizontal composition in \<open>S\<close> is given by \<open>(A, B, \<mu>) \<star> (A', B', \<mu>') = (AA', BB', \<nu>)\<close>,
     where \<open>AA'\<close> and \<open>BB'\<close> denote concatenations of lists and where \<open>\<nu>\<close> is defined as the
     composition \<open>can BB' (B \<^bold>\<star> B') \<cdot> (\<mu> \<star> \<mu>') \<cdot> can (A \<^bold>\<star> A') AA'\<close>, where \<open>can (A \<^bold>\<star> A') AA'\<close> and
     \<open>can BB' (B \<^bold>\<star> B')\<close> are canonical isomorphisms in \<open>B\<close>.  The canonical isomorphism
     \<open>can (A \<^bold>\<star> A') AA'\<close> corresponds to taking a pair of lists \<open>A \<^bold>\<star> A'\<close> and
     ``shifting the parentheses to the right'' to obtain a single list \<open>AA'\<close>.
     The canonical isomorphism can \<open>BB' (B \<^bold>\<star> B')\<close> corresponds to the inverse rearrangement.
 
     The bicategory \<open>B\<close> embeds into its strictification \<open>S\<close> via the functor \<open>UP\<close> that takes
     each arrow \<open>\<mu>\<close> of \<open>B\<close> to \<open>(\<^bold>\<langle>dom \<mu>\<^bold>\<rangle>, \<^bold>\<langle>cod \<mu>\<^bold>\<rangle>, \<mu>)\<close>, where \<open>\<^bold>\<langle>dom \<mu>\<^bold>\<rangle>\<close> and \<open>\<^bold>\<langle>cod \<mu>\<^bold>\<rangle>\<close> denote
     one-element lists.  This mapping extends to a pseudofunctor.
     There is also a pseudofunctor \<open>DN\<close>, which maps \<open>(A, B, \<mu>)\<close> in \<open>S\<close> to \<open>\<mu>\<close> in \<open>B\<close>;
     this is such that \<open>DN o UP\<close> is the identity on \<open>B\<close> and \<open>UP o DN\<close> is equivalent to the
     identity on \<open>S\<close>, so we obtain a biequivalence between \<open>B\<close> and \<open>S\<close>.
 
     It seems difficult to find references that explicitly describe a strictification
     construction in elementary terms like this (in retrospect, it ought to have been relatively
     easy to rediscover such a construction, but my thinking got off on the wrong track).
     One reference that I did find useful was \cite{unapologetic-strictification},
     which discusses strictification for monoidal categories.
   \<close>
 
   locale strictified_bicategory =
     B: bicategory V\<^sub>B H\<^sub>B \<a>\<^sub>B \<i>\<^sub>B src\<^sub>B trg\<^sub>B
   for V\<^sub>B :: "'a comp"                  (infixr "\<cdot>\<^sub>B" 55)
   and H\<^sub>B :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"           (infixr "\<star>\<^sub>B" 53)
   and \<a>\<^sub>B :: "'a \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a"      ("\<a>\<^sub>B[_, _, _]")
   and \<i>\<^sub>B :: "'a \<Rightarrow> 'a"                  ("\<i>\<^sub>B[_]")
   and src\<^sub>B :: "'a \<Rightarrow> 'a"
   and trg\<^sub>B :: "'a \<Rightarrow> 'a"
   begin
 
     sublocale E: self_evaluation_map V\<^sub>B H\<^sub>B \<a>\<^sub>B \<i>\<^sub>B src\<^sub>B trg\<^sub>B ..
 
     notation B.in_hhom  ("\<guillemotleft>_ : _ \<rightarrow>\<^sub>B _\<guillemotright>")
     notation B.in_hom  ("\<guillemotleft>_ : _ \<Rightarrow>\<^sub>B _\<guillemotright>")
 
     notation E.eval ("\<lbrace>_\<rbrace>")
     notation E.Nmlize ("\<^bold>\<lfloor>_\<^bold>\<rfloor>")
 
     text \<open>
       The following gives the construction of a bicategory whose arrows are triples \<open>(A, B, \<mu>)\<close>,
       where \<open>Nml A \<and> Ide A\<close>, \<open>Nml B \<and> Ide B\<close>, \<open>Src A = Src B\<close>, \<open>Trg A = Trg B\<close>, and \<open>\<mu> : \<lbrace>A\<rbrace> \<Rightarrow> \<lbrace>B\<rbrace>\<close>.
       We use @{locale concrete_category} to construct the vertical composition, so formally the
       arrows of the bicategory will be of the form \<open>MkArr A B \<mu>\<close>.
     \<close>
 
     text \<open>
       The 1-cells of the bicategory correspond to normal, identity terms \<open>A\<close>
       in the bicategorical language associated with \<open>B\<close>.
     \<close>
 
     abbreviation IDE
     where "IDE \<equiv> {A. E.Nml A \<and> E.Ide A}"
 
     text \<open>
       If terms \<open>A\<close> and \<open>B\<close> determine 1-cells of the strictification and have a
       common source and target, then the 2-cells between these 1-cells correspond
       to arrows \<open>\<mu>\<close> of the underlying bicategory such that \<open>\<guillemotleft>\<mu> : \<lbrace>A\<rbrace> \<Rightarrow>\<^sub>B \<lbrace>B\<rbrace>\<guillemotright>\<close>.
     \<close>
 
     abbreviation HOM
     where "HOM A B \<equiv> {\<mu>. E.Src A = E.Src B \<and> E.Trg A = E.Trg B \<and> \<guillemotleft>\<mu> : \<lbrace>A\<rbrace> \<Rightarrow>\<^sub>B \<lbrace>B\<rbrace>\<guillemotright>}"
 
     text \<open>
       The map taking term \<open>A \<in> OBJ\<close> to its evaluation \<open>\<lbrace>A\<rbrace> \<in> HOM A A\<close> defines the
       embedding of 1-cells as identity 2-cells.
     \<close>
 
     abbreviation EVAL
     where "EVAL \<equiv> E.eval"
 
     sublocale concrete_category IDE HOM EVAL \<open>\<lambda>_ _ _ \<mu> \<nu>. \<mu> \<cdot>\<^sub>B \<nu>\<close>
       using E.ide_eval_Ide B.comp_arr_dom B.comp_cod_arr B.comp_assoc
       by (unfold_locales, auto)
 
     lemma is_concrete_category:
     shows "concrete_category IDE HOM EVAL (\<lambda>_ _ _ \<mu> \<nu>. \<mu> \<cdot>\<^sub>B \<nu>)"
       ..
 
     abbreviation vcomp     (infixr "\<cdot>" 55)
     where "vcomp \<equiv> COMP"
 
     lemma arr_char:
     shows "arr F \<longleftrightarrow>
            E.Nml (Dom F) \<and> E.Ide (Dom F) \<and> E.Nml (Cod F) \<and> E.Ide (Cod F) \<and>
            E.Src (Dom F) = E.Src (Cod F) \<and> E.Trg (Dom F) = E.Trg (Cod F) \<and>
            \<guillemotleft>Map F : \<lbrace>Dom F\<rbrace> \<Rightarrow>\<^sub>B \<lbrace>Cod F\<rbrace>\<guillemotright> \<and> F \<noteq> Null"
       using arr_char by auto
 
     lemma arrI (* [intro] *):
     assumes "E.Nml (Dom F)" and "E.Ide (Dom F)" and "E.Nml (Cod F)" and "E.Ide (Cod F)"
     and "E.Src (Dom F) = E.Src (Cod F)" and "E.Trg (Dom F) = E.Trg (Cod F)"
     and "\<guillemotleft>Map F : \<lbrace>Dom F\<rbrace> \<Rightarrow>\<^sub>B \<lbrace>Cod F\<rbrace>\<guillemotright>" and "F \<noteq> Null"
     shows "arr F"
       using assms arr_char by blast
 
     lemma arrE [elim]:
     assumes "arr F"
     shows "(\<lbrakk> E.Nml (Dom F); E.Ide (Dom F); E.Nml (Cod F); E.Ide (Cod F);
               E.Src (Dom F) = E.Src (Cod F); E.Trg (Dom F) = E.Trg (Cod F);
               \<guillemotleft>Map F : \<lbrace>Dom F\<rbrace> \<Rightarrow>\<^sub>B \<lbrace>Cod F\<rbrace>\<guillemotright>; F \<noteq> Null \<rbrakk> \<Longrightarrow> T) \<Longrightarrow> T"
       using assms arr_char by simp
 
     lemma ide_char:
     shows "ide F \<longleftrightarrow> endo F \<and> B.ide (Map F)"
     proof
       show "ide F \<Longrightarrow> endo F \<and> B.ide (Map F)"
         using ide_char by (simp add: E.ide_eval_Ide)
       show "endo F \<and> B.ide (Map F) \<Longrightarrow> ide F"
         by (metis (no_types, lifting) B.ide_char B.in_homE arr_char ide_char
             mem_Collect_eq seq_char)
     qed
 
     lemma ideI [intro]:
     assumes "arr F" and "Dom F = Cod F" and "B.ide (Map F)"
     shows "ide F"
       using assms ide_char dom_char cod_char seq_char by presburger
 
     lemma ideE [elim]:
     assumes "ide F"
     shows "(\<lbrakk> arr F; Dom F = Cod F; B.ide (Map F); Map F = \<lbrace>Dom F\<rbrace>;
               Map F = \<lbrace>Cod F\<rbrace> \<rbrakk> \<Longrightarrow> T) \<Longrightarrow> T"
     proof -
       assume 1: "\<lbrakk> arr F; Dom F = Cod F; B.ide (Map F); Map F = \<lbrace>Dom F\<rbrace>;
                    Map F = \<lbrace>Cod F\<rbrace> \<rbrakk> \<Longrightarrow> T"
       show T
       proof -
         have "arr F"
           using assms by auto
         moreover have "Dom F = Cod F"
           using assms ide_char dom_char cod_char
           by (metis (no_types, lifting) Dom_cod calculation ideD(3))
         moreover have "B.ide (Map F)"
           using assms ide_char by blast
         moreover have "Map F = \<lbrace>Dom F\<rbrace>"
           using assms ide_char dom_char Map_ide(1) by blast
         ultimately show T
           using 1 by simp
       qed
     qed
 
     text \<open>
       Source and target are defined by the corresponding syntactic operations on terms.
     \<close>
 
     definition src
     where "src F \<equiv> if arr F then MkIde (E.Src (Dom F)) else null"
 
     definition trg
     where "trg F \<equiv> if arr F then MkIde (E.Trg (Dom F)) else null"
 
     lemma src_simps [simp]:
     assumes "arr F"
     shows "Dom (src F) = E.Src (Dom F)" and "Cod (src F) = E.Src (Dom F)"
     and "Map (src F) = \<lbrace>E.Src (Dom F)\<rbrace>"
       using assms src_def arr_char by auto
 
     lemma trg_simps [simp]:
     assumes "arr F"
     shows "Dom (trg F) = E.Trg (Dom F)" and "Cod (trg F) = E.Trg (Dom F)"
     and "Map (trg F) = \<lbrace>E.Trg (Dom F)\<rbrace>"
       using assms trg_def arr_char by auto
 
     interpretation src: endofunctor vcomp src
       using src_def comp_char
       apply (unfold_locales)
           apply auto[4]
     proof -
       show "\<And>g f. seq g f \<Longrightarrow> src (g \<cdot> f) = src g \<cdot> src f"
       proof -
         fix g f
         assume gf: "seq g f"
         have "src (g \<cdot> f) = MkIde (E.Src (Dom (g \<cdot> f)))"
           using gf src_def comp_char by simp
         also have "... = MkIde (E.Src (Dom f))"
           using gf by (simp add: seq_char)
         also have "... = MkIde (E.Src (Dom g)) \<cdot> MkIde (E.Src (Dom f))"
           using gf seq_char by auto
         also have "... = src g \<cdot> src f"
           using gf src_def comp_char by auto
         finally show "src (g \<cdot> f) = src g \<cdot> src f" by blast
       qed
     qed
 
     interpretation trg: endofunctor vcomp trg
       using trg_def comp_char
       apply (unfold_locales)
           apply auto[4]
     proof -
       show "\<And>g f. seq g f \<Longrightarrow> trg (g \<cdot> f) = trg g \<cdot> trg f"
       proof -
         fix g f
         assume gf: "seq g f"
         have "trg (g \<cdot> f) = MkIde (E.Trg (Dom (g \<cdot> f)))"
           using gf trg_def comp_char by simp
         also have "... = MkIde (E.Trg (Dom f))"
           using gf by (simp add: seq_char)
         also have "... = MkIde (E.Trg (Dom g)) \<cdot> MkIde (E.Trg (Dom f))"
           using gf seq_char by auto
         also have "... = trg g \<cdot> trg f"
           using gf trg_def comp_char by auto
         finally show "trg (g \<cdot> f) = trg g \<cdot> trg f" by blast
       qed
     qed
 
     interpretation horizontal_homs vcomp src trg
       using src_def trg_def Cod_in_Obj Map_in_Hom
       by (unfold_locales, auto)
 
     notation in_hhom  ("\<guillemotleft>_ : _ \<rightarrow> _\<guillemotright>")
 
     definition hcomp    (infixr "\<star>" 53)
     where "\<mu> \<star> \<nu> \<equiv> if arr \<mu> \<and> arr \<nu> \<and> src \<mu> = trg \<nu>
                    then MkArr (Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu>) (Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu>)
                               (B.can (Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu>) (Cod \<mu> \<^bold>\<star> Cod \<nu>) \<cdot>\<^sub>B
                                 (Map \<mu> \<star>\<^sub>B Map \<nu>) \<cdot>\<^sub>B
                                 B.can (Dom \<mu> \<^bold>\<star> Dom \<nu>) (Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu>))
                    else null"
 
     lemma arr_hcomp:
     assumes "arr \<mu>" and "arr \<nu>" and "src \<mu> = trg \<nu>"
     shows "arr (\<mu> \<star> \<nu>)"
     proof -
       have 1: "E.Ide (Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu>) \<and> E.Nml (Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu>) \<and>
                E.Ide (Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu>) \<and> E.Nml (Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu>)"
         using assms arr_char src_def trg_def E.Ide_HcompNml E.Nml_HcompNml(1) by auto
       moreover
       have "\<guillemotleft>B.can (Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu>) (Cod \<mu> \<^bold>\<star> Cod \<nu>) \<cdot>\<^sub>B (Map \<mu> \<star>\<^sub>B Map \<nu>) \<cdot>\<^sub>B
                B.can (Dom \<mu> \<^bold>\<star> Dom \<nu>) (Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu>) :
                   \<lbrace>Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu>\<rbrace> \<Rightarrow>\<^sub>B \<lbrace>Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu>\<rbrace>\<guillemotright>"
       proof -
         have "\<guillemotleft>Map \<mu> \<star>\<^sub>B Map \<nu> : \<lbrace>Dom \<mu> \<^bold>\<star> Dom \<nu>\<rbrace> \<Rightarrow>\<^sub>B \<lbrace>Cod \<mu> \<^bold>\<star> Cod \<nu>\<rbrace>\<guillemotright>"
           using assms arr_char dom_char cod_char src_def trg_def E.eval_simps'(2-3)
           by auto
         moreover
         have "\<guillemotleft>B.can (Dom \<mu> \<^bold>\<star> Dom \<nu>) (Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu>) :
                   \<lbrace>Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu>\<rbrace> \<Rightarrow>\<^sub>B \<lbrace>Dom \<mu> \<^bold>\<star> Dom \<nu>\<rbrace>\<guillemotright> \<and>
                \<guillemotleft>B.can (Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu>) (Cod \<mu> \<^bold>\<star> Cod \<nu>) :
                   \<lbrace>Cod \<mu> \<^bold>\<star> Cod \<nu>\<rbrace> \<Rightarrow>\<^sub>B \<lbrace>Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu>\<rbrace>\<guillemotright>"
           using assms 1 arr_char src_def trg_def
           apply (intro conjI B.in_homI) by auto
         ultimately show ?thesis by auto
       qed
       moreover have "E.Src (Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu>) = E.Src (Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu>) \<and>
                      E.Trg (Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu>) = E.Trg (Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu>)"
         using assms arr_char src_def trg_def
         by (simp add: E.Src_HcompNml E.Trg_HcompNml)
       ultimately show ?thesis
         unfolding hcomp_def
         using assms by (intro arrI, auto)
     qed
 
     lemma src_hcomp [simp]:
     assumes "arr \<mu>" and "arr \<nu>" and "src \<mu> = trg \<nu>"
     shows "src (\<mu> \<star> \<nu>) = src \<nu>"
       using assms arr_char hcomp_def src_def trg_def arr_hcomp E.Src_HcompNml by simp
 
     lemma trg_hcomp [simp]:
     assumes "arr \<mu>" and "arr \<nu>" and "src \<mu> = trg \<nu>"
     shows "trg (hcomp \<mu> \<nu>) = trg \<mu>"
       using assms arr_char hcomp_def src_def trg_def arr_hcomp E.Trg_HcompNml by simp
 
     lemma hseq_char:
     shows "arr (\<mu> \<star> \<nu>) \<longleftrightarrow> arr \<mu> \<and> arr \<nu> \<and> src \<mu> = trg \<nu>"
       using arr_hcomp hcomp_def by simp
 
     lemma Dom_hcomp [simp]:
     assumes "arr \<mu>" and "arr \<nu>" and "src \<mu> = trg \<nu>"
     shows "Dom (\<mu> \<star> \<nu>) = Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu>"
       using assms hcomp_def [of \<mu> \<nu>] by simp
 
     lemma Cod_hcomp [simp]:
     assumes "arr \<mu>" and "arr \<nu>" and "src \<mu> = trg \<nu>"
     shows "Cod (\<mu> \<star> \<nu>) = Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu>"
       using assms hcomp_def [of \<mu> \<nu>] by simp
 
     lemma Map_hcomp [simp]:
     assumes "arr \<mu>" and "arr \<nu>" and "src \<mu> = trg \<nu>"
     shows "Map (\<mu> \<star> \<nu>) = B.can (Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu>) (Cod \<mu> \<^bold>\<star> Cod \<nu>) \<cdot>\<^sub>B
                            (Map \<mu> \<star>\<^sub>B Map \<nu>) \<cdot>\<^sub>B
                            B.can (Dom \<mu> \<^bold>\<star> Dom \<nu>) (Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu>)"
       using assms hcomp_def [of \<mu> \<nu>] by simp
 
     interpretation VxV: product_category vcomp vcomp ..
     interpretation VV: subcategory VxV.comp
                           \<open>\<lambda>\<mu>\<nu>. arr (fst \<mu>\<nu>) \<and> arr (snd \<mu>\<nu>) \<and> src (fst \<mu>\<nu>) = trg (snd \<mu>\<nu>)\<close>
       using subcategory_VV by simp
 
     interpretation H: "functor" VV.comp vcomp \<open>\<lambda>\<mu>\<nu>. hcomp (fst \<mu>\<nu>) (snd \<mu>\<nu>)\<close>
     proof
       show "\<And>f. \<not> VV.arr f \<Longrightarrow> fst f \<star> snd f = null"
         using hcomp_def by auto
       show A: "\<And>f. VV.arr f \<Longrightarrow> arr (fst f \<star> snd f)"
         using VV.arrE hseq_char by blast
       show "\<And>f. VV.arr f \<Longrightarrow> dom (fst f \<star> snd f) = fst (VV.dom f) \<star> snd (VV.dom f)"
       proof -
         fix f
         assume f: "VV.arr f"
         have "dom (fst f \<star> snd f) = MkIde (Dom (fst f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd f))"
           using f VV.arrE [of f] dom_char arr_hcomp hcomp_def by simp
         also have "... = fst (VV.dom f) \<star> snd (VV.dom f)"
         proof -
           have "hcomp (fst (VV.dom f)) (snd (VV.dom f)) =
                 MkArr (Dom (fst f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd f)) (Dom (fst f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd f))
                       (B.can (Dom (fst f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd f)) (Dom (fst f) \<^bold>\<star> Dom (snd f)) \<cdot>\<^sub>B
                         (\<lbrace>Dom (fst f)\<rbrace> \<star>\<^sub>B \<lbrace>Dom (snd f)\<rbrace>) \<cdot>\<^sub>B
                         B.can (Dom (fst f) \<^bold>\<star> Dom (snd f)) (Dom (fst f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd f)))"
             using f VV.arrE [of f] arr_hcomp hcomp_def by simp
           moreover have "B.can (Dom (fst f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd f)) (Dom (fst f) \<^bold>\<star> Dom (snd f)) \<cdot>\<^sub>B
                            (\<lbrace>Dom (fst f)\<rbrace> \<star>\<^sub>B \<lbrace>Dom (snd f)\<rbrace>) \<cdot>\<^sub>B
                               B.can (Dom (fst f) \<^bold>\<star> Dom (snd f)) (Dom (fst f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd f)) =
                          \<lbrace>Dom (fst f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd f)\<rbrace>"
           proof -
             have 1: "E.Ide (Dom (fst f) \<^bold>\<star> Dom (snd f))"
               using f VV.arr_char arr_char dom_char
               apply simp
               by (metis (no_types, lifting) src_simps(1) trg_simps(1))
             have 2: "E.Ide (Dom (fst f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd f))"
               using f VV.arr_char arr_char dom_char
               apply simp
               by (metis (no_types, lifting) E.Ide_HcompNml src_simps(1) trg_simps(1))
             have 3: "\<^bold>\<lfloor>Dom (fst f) \<^bold>\<star> Dom (snd f)\<^bold>\<rfloor> = \<^bold>\<lfloor>Dom (fst f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd f)\<^bold>\<rfloor>"
               using f VV.arr_char arr_char dom_char
               apply simp
               by (metis (no_types, lifting) E.Nml_HcompNml(1) E.Nmlize_Nml
                   src_simps(1) trg_simps(1))
             have "(\<lbrace>Dom (fst f)\<rbrace> \<star>\<^sub>B \<lbrace>Dom (snd f)\<rbrace>) \<cdot>\<^sub>B
                     B.can (Dom (fst f) \<^bold>\<star> Dom (snd f)) (Dom (fst f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd f)) =
                   B.can (Dom (fst f) \<^bold>\<star> Dom (snd f)) (Dom (fst f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd f))"
             proof -
               have "B.in_hom (B.can (Dom (fst f) \<^bold>\<star> Dom (snd f))
                              (Dom (fst f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd f)))
                              \<lbrace>Dom (fst f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd f)\<rbrace> (\<lbrace>Dom (fst f)\<rbrace> \<star>\<^sub>B \<lbrace>Dom (snd f)\<rbrace>)"
                 using 1 2 3 f VV.arr_char arr_char
                       B.can_in_hom [of "Dom (fst f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd f)" "Dom (fst f) \<^bold>\<star> Dom (snd f)"]
                 by simp
               thus ?thesis
                 using B.comp_cod_arr by auto
             qed
             thus ?thesis
               using 1 2 3 f VV.arr_char B.can_Ide_self B.vcomp_can by simp
           qed
           ultimately show ?thesis by simp
         qed
         finally show "dom (fst f \<star> snd f) = fst (VV.dom f) \<star> snd (VV.dom f)"
           by simp
       qed
       show "\<And>f. VV.arr f \<Longrightarrow> cod (fst f \<star> snd f) = fst (VV.cod f) \<star> snd (VV.cod f)"
       proof -
         fix f
         assume f: "VV.arr f"
         have "cod (fst f \<star> snd f) = MkIde (Cod (fst f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod (snd f))"
           using f VV.arrE [of f] cod_char arr_hcomp hcomp_def by simp
         also have "... = fst (VV.cod f) \<star> snd (VV.cod f)"
         proof -
           have "hcomp (fst (VV.cod f)) (snd (VV.cod f)) =
                 MkArr (Cod (fst f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod (snd f)) (Cod (fst f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod (snd f))
                       (B.can (Cod (fst f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod (snd f)) (Cod (fst f) \<^bold>\<star> Cod (snd f)) \<cdot>\<^sub>B
                         (\<lbrace>Cod (fst f)\<rbrace> \<star>\<^sub>B \<lbrace>Cod (snd f)\<rbrace>) \<cdot>\<^sub>B
                         B.can (Cod (fst f) \<^bold>\<star> Cod (snd f)) (Cod (fst f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod (snd f)))"
             using f VV.arrE [of f] arr_hcomp hcomp_def by simp
           moreover have "B.can (Cod (fst f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod (snd f)) (Cod (fst f) \<^bold>\<star> Cod (snd f)) \<cdot>\<^sub>B
                            (\<lbrace>Cod (fst f)\<rbrace> \<star>\<^sub>B \<lbrace>Cod (snd f)\<rbrace>) \<cdot>\<^sub>B
                              B.can (Cod (fst f) \<^bold>\<star> Cod (snd f)) (Cod (fst f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod (snd f)) =
                          \<lbrace>Cod (fst f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod (snd f)\<rbrace>"
           proof -
             have 1: "E.Ide (Cod (fst f) \<^bold>\<star> Cod (snd f))"
               using f VV.arr_char arr_char dom_char
               apply simp
               by (metis (no_types, lifting) src_simps(1) trg_simps(1))
             have 2: "E.Ide (Cod (fst f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod (snd f))"
               using f VV.arr_char arr_char dom_char
               apply simp
               by (metis (no_types, lifting) E.Ide_HcompNml src_simps(1) trg_simps(1))
             have 3: "\<^bold>\<lfloor>Cod (fst f) \<^bold>\<star> Cod (snd f)\<^bold>\<rfloor> = \<^bold>\<lfloor>Cod (fst f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod (snd f)\<^bold>\<rfloor>"
               using f VV.arr_char arr_char dom_char
               apply simp
               by (metis (no_types, lifting) E.Nml_HcompNml(1) E.Nmlize_Nml
                   src_simps(1) trg_simps(1))
             have "(\<lbrace>Cod (fst f)\<rbrace> \<star>\<^sub>B \<lbrace>Cod (snd f)\<rbrace>) \<cdot>\<^sub>B
                     B.can (Cod (fst f) \<^bold>\<star> Cod (snd f)) (Cod (fst f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod (snd f)) =
                   B.can (Cod (fst f) \<^bold>\<star> Cod (snd f)) (Cod (fst f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod (snd f))"
             proof -
               have "B.in_hom (B.can (Cod (fst f) \<^bold>\<star> Cod (snd f))
                              (Cod (fst f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod (snd f)))
                              \<lbrace>Cod (fst f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod (snd f)\<rbrace> (\<lbrace>Cod (fst f)\<rbrace> \<star>\<^sub>B \<lbrace>Cod (snd f)\<rbrace>)"
                 using 1 2 3 f VV.arr_char arr_char
                       B.can_in_hom [of "Cod (fst f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod (snd f)"
                                        "Cod (fst f) \<^bold>\<star> Cod (snd f)"]
                 by simp
               thus ?thesis
                 using B.comp_cod_arr by auto
             qed
             thus ?thesis
               using 1 2 3 f VV.arr_char B.can_Ide_self B.vcomp_can by simp
           qed
           ultimately show ?thesis by simp
         qed
         finally show "cod (fst f \<star> snd f) = fst (VV.cod f) \<star> snd (VV.cod f)"
           by simp
       qed
       show "\<And>g f. VV.seq g f \<Longrightarrow>
                    fst (VV.comp g f) \<star> snd (VV.comp g f) = (fst g \<star> snd g) \<cdot> (fst f \<star> snd f)"
       proof -
         fix f g
         assume fg: "VV.seq g f"
         have f: "arr (fst f) \<and> arr (snd f) \<and> src (fst f) = trg (snd f)"
           using fg VV.seq_char VV.arr_char by simp
         have g: "arr (fst g) \<and> arr (snd g) \<and> src (fst g) = trg (snd g)"
           using fg VV.seq_char VV.arr_char by simp
         have 1: "arr (fst (VV.comp g f)) \<and> arr (snd (VV.comp g f)) \<and>
                  src (fst (VV.comp g f)) = trg (snd (VV.comp g f))"
           using fg VV.arrE by blast
         have 0: "VV.comp g f = (fst g \<cdot> fst f, snd g \<cdot> snd f)"
           using fg 1 VV.comp_char VxV.comp_char
           by (metis (no_types, lifting) VV.seq_char VxV.seqE)
         let ?X = "MkArr (Dom (fst (VV.comp g f)) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd (VV.comp g f)))
                         (Cod (fst (VV.comp g f)) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod (snd (VV.comp g f)))
                         (B.can (Cod (fst (VV.comp g f)) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod (snd (VV.comp g f)))
                                (Cod (fst (VV.comp g f)) \<^bold>\<star> Cod (snd (VV.comp g f))) \<cdot>\<^sub>B
                            (Map (fst (VV.comp g f)) \<star>\<^sub>B Map (snd (VV.comp g f))) \<cdot>\<^sub>B
                            B.can (Dom (fst (VV.comp g f)) \<^bold>\<star> Dom (snd (VV.comp g f)))
                                  (Dom (fst (VV.comp g f)) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd (VV.comp g f))))"
         have 2: "fst (VV.comp g f) \<star> snd (VV.comp g f) = ?X"
           unfolding hcomp_def using 1 by simp
         also have "... = (fst g \<star> snd g) \<cdot> (fst f \<star> snd f)"
         proof -
           let ?GG = "MkArr (Dom (fst g) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd g)) (Cod (fst g) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod (snd g))
                            (B.can (Cod (fst g) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod (snd g)) (Cod (fst g) \<^bold>\<star> Cod (snd g)) \<cdot>\<^sub>B
                              (Map (fst g) \<star>\<^sub>B Map (snd g)) \<cdot>\<^sub>B
                              B.can (Dom (fst g) \<^bold>\<star> Dom (snd g)) (Dom (fst g) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd g)))"
           let ?FF = "MkArr (Dom (fst f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd f)) (Cod (fst f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod (snd f))
                            (B.can (Cod (fst f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod (snd f)) (Cod (fst f) \<^bold>\<star> Cod (snd f)) \<cdot>\<^sub>B
                              (Map (fst f) \<star>\<^sub>B Map (snd f)) \<cdot>\<^sub>B
                              B.can (Dom (fst f) \<^bold>\<star> Dom (snd f)) (Dom (fst f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd f)))"
           have 4: "arr ?FF \<and> arr ?GG \<and> Dom ?GG = Cod ?FF"
           proof -
             have "arr ?FF \<and> arr ?GG"
               using f g fg VV.arr_char VV.seqE hcomp_def A by presburger
             thus ?thesis
               using 0 1 by (simp add: fg seq_char)
           qed
           have "(fst g \<star> snd g) \<cdot> (fst f \<star> snd f) = ?GG \<cdot> ?FF"
             unfolding hcomp_def
             using 1 f g fg VV.arr_char VV.seqE by simp
           also have "... = ?X"
           proof (intro arr_eqI)
             show "seq ?GG ?FF"
               using fg 4 seq_char by blast
             show "arr ?X"
               using fg 1 arr_hcomp hcomp_def by simp
             show "Dom (?GG \<cdot> ?FF) = Dom ?X"
               using fg 0 1 4 seq_char by simp
             show "Cod (?GG \<cdot> ?FF) = Cod ?X"
               using fg 0 1 4 seq_char by simp
             show "Map (?GG \<cdot> ?FF) = Map ?X"
             proof -
               have "Map (?GG \<cdot> ?FF) = Map ?GG \<cdot>\<^sub>B Map ?FF"
                 using 4 by auto
               also have
                 "... = (B.can (Cod (fst g) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod (snd g)) (Cod (fst g) \<^bold>\<star> Cod (snd g)) \<cdot>\<^sub>B
                          (Map (fst g) \<star>\<^sub>B Map (snd g)) \<cdot>\<^sub>B
                          B.can (Dom (fst g) \<^bold>\<star> Dom (snd g)) (Dom (fst g) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd g))) \<cdot>\<^sub>B
                        (B.can (Cod (fst f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod (snd f)) (Cod (fst f) \<^bold>\<star> Cod (snd f)) \<cdot>\<^sub>B
                          (Map (fst f) \<star>\<^sub>B Map (snd f)) \<cdot>\<^sub>B
                          B.can (Dom (fst f) \<^bold>\<star> Dom (snd f)) (Dom (fst f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd f)))"
                 using fg by simp
               also have
                 "... = B.can (Cod (fst g) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod (snd g)) (Cod (fst g) \<^bold>\<star> Cod (snd g)) \<cdot>\<^sub>B
                          ((Map (fst g) \<star>\<^sub>B Map (snd g)) \<cdot>\<^sub>B (Map (fst f) \<star>\<^sub>B Map (snd f))) \<cdot>\<^sub>B
                          B.can (Dom (fst f) \<^bold>\<star> Dom (snd f)) (Dom (fst f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd f))"
               proof -
                 have "(B.can (Cod (fst g) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod (snd g)) (Cod (fst g) \<^bold>\<star> Cod (snd g)) \<cdot>\<^sub>B
                         (Map (fst g) \<star>\<^sub>B Map (snd g)) \<cdot>\<^sub>B
                         B.can (Dom (fst g) \<^bold>\<star> Dom (snd g)) (Dom (fst g) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd g))) \<cdot>\<^sub>B
                         (B.can (Cod (fst f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod (snd f)) (Cod (fst f) \<^bold>\<star> Cod (snd f)) \<cdot>\<^sub>B
                         (Map (fst f) \<star>\<^sub>B Map (snd f)) \<cdot>\<^sub>B
                         B.can (Dom (fst f) \<^bold>\<star> Dom (snd f)) (Dom (fst f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd f))) =
                       B.can (Cod (fst g) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod (snd g)) (Cod (fst g) \<^bold>\<star> Cod (snd g)) \<cdot>\<^sub>B
                         ((Map (fst g) \<star>\<^sub>B Map (snd g)) \<cdot>\<^sub>B
                         (B.can (Dom (fst g) \<^bold>\<star> Dom (snd g)) (Dom (fst g) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd g)) \<cdot>\<^sub>B
                         B.can (Cod (fst f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod (snd f)) (Cod (fst f) \<^bold>\<star> Cod (snd f))) \<cdot>\<^sub>B
                         (Map (fst f) \<star>\<^sub>B Map (snd f))) \<cdot>\<^sub>B
                         B.can (Dom (fst f) \<^bold>\<star> Dom (snd f)) (Dom (fst f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd f))"
                   using B.comp_assoc by simp
                 also have "... = B.can (Cod (fst g) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod (snd g)) (Cod (fst g) \<^bold>\<star> Cod (snd g)) \<cdot>\<^sub>B
                                   ((Map (fst g) \<star>\<^sub>B Map (snd g)) \<cdot>\<^sub>B (Map (fst f) \<star>\<^sub>B Map (snd f))) \<cdot>\<^sub>B
                                    B.can (Dom (fst f) \<^bold>\<star> Dom (snd f)) (Dom (fst f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd f))"
                 proof -
                   have "(B.can (Dom (fst g) \<^bold>\<star> Dom (snd g)) (Dom (fst g) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd g))) \<cdot>\<^sub>B
                           (B.can (Cod (fst f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod (snd f)) (Cod (fst f) \<^bold>\<star> Cod (snd f))) =
                         \<lbrace>Cod (fst f) \<^bold>\<star> Cod (snd f)\<rbrace>"
                   proof -
                     have "(B.can (Dom (fst g) \<^bold>\<star> Dom (snd g)) (Dom (fst g) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd g))) \<cdot>\<^sub>B
                           (B.can (Cod (fst f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod (snd f)) (Cod (fst f) \<^bold>\<star> Cod (snd f))) =
                           B.can (Dom (fst g) \<^bold>\<star> Dom (snd g)) (Cod (fst f) \<^bold>\<star> Cod (snd f))"
                     proof -
                       have "E.Ide (Dom (fst g) \<^bold>\<star> Dom (snd g))"
                         using g arr_char
                         apply simp
                         by (metis (no_types, lifting) src_simps(1) trg_simps(1))
                       moreover have "E.Ide (Dom (fst g) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd g))"
                         using g arr_char
                         apply simp
                         by (metis (no_types, lifting) E.Ide_HcompNml src_simps(1) trg_simps(1))
                       moreover have "E.Ide (Cod (fst f) \<^bold>\<star> Cod (snd f))"
                         using f arr_char
                         apply simp
                         by (metis (no_types, lifting) src_simps(1) trg_simps(1))
                       moreover have
                         "\<^bold>\<lfloor>Dom (fst g) \<^bold>\<star> Dom (snd g)\<^bold>\<rfloor> = \<^bold>\<lfloor>Dom (fst g) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd g)\<^bold>\<rfloor>"
                         using g
                         apply simp
                         by (metis (no_types, lifting) E.Nml_HcompNml(1) E.Nmlize_Nml
                             arrE src_simps(1) trg_simps(1))
                       moreover have
                         "\<^bold>\<lfloor>Dom (fst g) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd g)\<^bold>\<rfloor> = \<^bold>\<lfloor>Cod (fst f) \<^bold>\<star> Cod (snd f)\<^bold>\<rfloor>"
                         using g
                         apply simp
                         by (metis (no_types, lifting) "0" "1" E.Nmlize.simps(3)
                             calculation(4) fst_conv seq_char snd_conv)
                       moreover have
                         "Dom (fst g) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd g) = Cod (fst f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod (snd f)"
                         using 0 1 by (simp add: seq_char)
                       ultimately show ?thesis
                         using B.vcomp_can by simp
                     qed
                     also have "... = \<lbrace>Cod (fst f) \<^bold>\<star> Cod (snd f)\<rbrace>"
                     proof -
                       have "Dom (fst g) \<^bold>\<star> Dom (snd g) = Cod (fst f) \<^bold>\<star> Cod (snd f)"
                         using 0 f g fg seq_char VV.seq_char VV.arr_char
                         by simp
                       thus ?thesis
                         using f B.can_Ide_self [of "Dom (fst f) \<^bold>\<star> Dom (snd f)"]
                         apply simp
                         by (metis (no_types, lifting) B.can_Ide_self E.eval.simps(3)
                             E.Ide.simps(3) arr_char src_simps(2) trg_simps(2))
                     qed
                     finally show ?thesis by simp
                   qed
                   hence "(B.can (Dom (fst g) \<^bold>\<star> Dom (snd g)) (Dom (fst g) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd g)) \<cdot>\<^sub>B
                            B.can (Cod (fst f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod (snd f)) (Cod (fst f) \<^bold>\<star> Cod (snd f))) \<cdot>\<^sub>B
                            (Map (fst f) \<star>\<^sub>B Map (snd f)) =
                          \<lbrace>Cod (fst f) \<^bold>\<star> Cod (snd f)\<rbrace> \<cdot>\<^sub>B (Map (fst f) \<star>\<^sub>B Map (snd f))"
                     by simp
                   also have "... = Map (fst f) \<star>\<^sub>B Map (snd f)"
                   proof -
                     have 1: "\<forall>p. arr p \<longrightarrow> map (cod p) \<cdot> map p = map p"
                       by blast
                     have 3: "\<lbrace>Cod (fst f)\<rbrace> \<cdot>\<^sub>B Map (fst f) = Map (map (cod (fst f)) \<cdot> map (fst f))"
                       by (simp add: f)
                     have 4: "map (cod (fst f)) \<cdot> map (fst f) = fst f"
                       using 1 f map_simp by simp
                     show ?thesis
                     proof -
                       have 2: "\<lbrace>Cod (snd f)\<rbrace> \<cdot>\<^sub>B Map (snd f) = Map (snd f)"
                       proof -
                         have "\<lbrace>Cod (snd f)\<rbrace> \<cdot>\<^sub>B Map (snd f) =
                               Map (map (cod (snd f)) \<cdot> map (snd f))"
                           by (simp add: f)
                         moreover have "map (cod (snd f)) \<cdot> map (snd f) = snd f"
                           using 1 f map_simp by simp
                         ultimately show ?thesis by presburger
                       qed
                       have "B.seq \<lbrace>Cod (snd f)\<rbrace> (Map (snd f))"
                         using f 2 by auto
                       moreover have "B.seq \<lbrace>Cod (fst f)\<rbrace> (Map (fst f))"
                         using 4 f 3 by auto
                       moreover have
                         "\<lbrace>Cod (fst f)\<rbrace> \<cdot>\<^sub>B Map (fst f) \<star>\<^sub>B \<lbrace>Cod (snd f)\<rbrace> \<cdot>\<^sub>B Map (snd f) =
                          Map (fst f) \<star>\<^sub>B Map (snd f)"
                         using 2 3 4 by presburger
                       ultimately show ?thesis
                         by (simp add: B.interchange)
                     qed
                   qed
                   finally have
                     "(B.can (Dom (fst g) \<^bold>\<star> Dom (snd g)) (Dom (fst g) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd g)) \<cdot>\<^sub>B
                        B.can (Cod (fst f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod (snd f)) (Cod (fst f) \<^bold>\<star> Cod (snd f))) \<cdot>\<^sub>B
                        (Map (fst f) \<star>\<^sub>B Map (snd f)) =
                      Map (fst f) \<star>\<^sub>B Map (snd f)"
                     by simp
                   thus ?thesis
                     using fg B.comp_cod_arr by simp
                 qed
                 finally show ?thesis by simp
               qed
               also have "... = B.can (Cod (fst g) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod (snd g)) (Cod (fst g) \<^bold>\<star> Cod (snd g)) \<cdot>\<^sub>B
                                  (Map (fst g \<cdot> fst f) \<star>\<^sub>B Map (snd g \<cdot> snd f)) \<cdot>\<^sub>B
                                  B.can (Dom (fst f) \<^bold>\<star> Dom (snd f)) (Dom (fst f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd f))"
               proof -
                 have 2: "Dom (fst g) = Cod (fst f)"
                   using 0 f g fg VV.seq_char [of g f] VV.arr_char arr_char seq_char
                   by (metis (no_types, lifting) fst_conv)
                 hence "Map (fst g \<cdot> fst f) = Map (fst g) \<cdot>\<^sub>B Map (fst f)"
                   using f g Map_comp [of "fst f" "fst g"] by simp
                 moreover have "B.seq (Map (fst g)) (Map (fst f)) \<and>
                                B.seq (Map (snd g)) (Map (snd f))"
                   using f g 0 1 2 arr_char
                   by (metis (no_types, lifting) B.seqI' prod.sel(2) seq_char)
                 ultimately show ?thesis
                   using 0 1 seq_char Map_comp B.interchange by auto
               qed
               also have "... = Map ?X"
                 using fg 0 1 by (simp add: seq_char)
               finally show ?thesis by simp
             qed
           qed
           finally show ?thesis by simp
         qed
         finally show "fst (VV.comp g f) \<star> snd (VV.comp g f) = (fst g \<star> snd g) \<cdot> (fst f \<star> snd f)"
           by simp
       qed
     qed
 
     interpretation H: horizontal_composition vcomp hcomp src trg
       using hseq_char by (unfold_locales, auto)
 
     lemma hcomp_assoc:
     assumes "arr \<mu>" and "arr \<nu>" and "arr \<tau>"
     and "src \<mu> = trg \<nu>" and "src \<nu> = trg \<tau>"
     shows "(\<mu> \<star> \<nu>) \<star> \<tau> = \<mu> \<star> \<nu> \<star> \<tau>"
     proof (intro arr_eqI)
       have \<mu>\<nu>: "\<guillemotleft>Map \<mu> \<star>\<^sub>B Map \<nu> : \<lbrace>Dom \<mu> \<^bold>\<star> Dom \<nu>\<rbrace> \<Rightarrow>\<^sub>B \<lbrace>Cod \<mu> \<^bold>\<star> Cod \<nu>\<rbrace>\<guillemotright>"
         using assms src_def trg_def arr_char
         by (auto simp add: E.eval_simps'(2-3) Pair_inject)
       have \<nu>\<tau>: "\<guillemotleft>Map \<nu> \<star>\<^sub>B Map \<tau> : \<lbrace>Dom \<nu> \<^bold>\<star> Dom \<tau>\<rbrace> \<Rightarrow>\<^sub>B \<lbrace>Cod \<nu> \<^bold>\<star> Cod \<tau>\<rbrace>\<guillemotright>"
         using assms src_def trg_def arr_char
         by (auto simp add: E.eval_simps'(2-3) Pair_inject)
       show "H.hseq (\<mu> \<star> \<nu>) \<tau>"
         using assms \<mu>\<nu> \<nu>\<tau> by auto
       show "H.hseq \<mu> (\<nu> \<star> \<tau>)"
         using assms \<mu>\<nu> \<nu>\<tau> by auto
       show "Dom ((\<mu> \<star> \<nu>) \<star> \<tau>) = Dom (\<mu> \<star> \<nu> \<star> \<tau>)"
       proof -
         have "E.Nml (Dom \<mu>) \<and> E.Nml (Dom \<nu>) \<and> E.Nml (Dom \<tau>)"
           using assms by blast
         moreover have "E.Src (Dom \<mu>) = E.Trg (Dom \<nu>) \<and> E.Src (Dom \<nu>) = E.Trg (Dom \<tau>)"
           using assms \<mu>\<nu> \<nu>\<tau>
           by (metis (no_types, lifting) src_simps(2) trg_simps(2))
         ultimately show ?thesis
           using assms \<mu>\<nu> \<nu>\<tau> E.HcompNml_assoc by simp
       qed
       show "Cod ((\<mu> \<star> \<nu>) \<star> \<tau>) = Cod (\<mu> \<star> \<nu> \<star> \<tau>)"
       proof -
         have "E.Nml (Cod \<mu>) \<and> E.Nml (Cod \<nu>) \<and> E.Nml (Cod \<tau>)"
           using assms by blast
         moreover have "E.Src (Cod \<mu>) = E.Trg (Cod \<nu>) \<and> E.Src (Cod \<nu>) = E.Trg (Cod \<tau>)"
           using assms \<mu>\<nu> \<nu>\<tau>
           by (metis (no_types, lifting) arrE src_simps(2) trg_simps(2))
         ultimately show ?thesis
           using assms \<mu>\<nu> \<nu>\<tau> E.HcompNml_assoc by simp
       qed
      show "Map ((\<mu> \<star> \<nu>) \<star> \<tau>) = Map (\<mu> \<star> \<nu> \<star> \<tau>)"
       proof -
         have "Map ((\<mu> \<star> \<nu>) \<star> \<tau>) =
               B.can (Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<tau>) (Cod \<mu> \<^bold>\<star> Cod \<nu> \<^bold>\<star> Cod \<tau>) \<cdot>\<^sub>B
                 (Map \<mu> \<star>\<^sub>B Map \<nu> \<star>\<^sub>B Map \<tau>) \<cdot>\<^sub>B
                    B.can (Dom \<mu> \<^bold>\<star> Dom \<nu> \<^bold>\<star> Dom \<tau>) (Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<tau>)"
         proof -
           have 1: "Map ((\<mu> \<star> \<nu>) \<star> \<tau>) =
                    B.can (Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<tau>) ((Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu>) \<^bold>\<star> Cod \<tau>) \<cdot>\<^sub>B
                      (B.can (Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu>) (Cod \<mu> \<^bold>\<star> Cod \<nu>) \<cdot>\<^sub>B
                        (Map \<mu> \<star>\<^sub>B Map \<nu>) \<cdot>\<^sub>B
                          B.can (Dom \<mu> \<^bold>\<star> Dom \<nu>) (Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu>) \<star>\<^sub>B Map \<tau>) \<cdot>\<^sub>B
                        B.can ((Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu>) \<^bold>\<star> Dom \<tau>) (Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<tau>)"
             using assms \<mu>\<nu> \<nu>\<tau> hcomp_def E.HcompNml_assoc src_def trg_def arr_char
                   E.Nml_HcompNml E.Ide_HcompNml
             by auto (* 5 sec *)
           also have
             "... = B.can (Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<tau>) ((Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu>) \<^bold>\<star> Cod \<tau>) \<cdot>\<^sub>B
                      (B.can ((Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu>) \<^bold>\<star> Cod \<tau>) (Cod \<mu> \<^bold>\<star> Cod \<nu> \<^bold>\<star> Cod \<tau>) \<cdot>\<^sub>B
                        (Map \<mu> \<star>\<^sub>B Map \<nu> \<star>\<^sub>B Map \<tau>) \<cdot>\<^sub>B
                          B.can (Dom \<mu> \<^bold>\<star> Dom \<nu> \<^bold>\<star> Dom \<tau>) ((Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu>) \<^bold>\<star> Dom \<tau>)) \<cdot>\<^sub>B
                        B.can ((Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu>) \<^bold>\<star> Dom \<tau>) (Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<tau>)"
           proof -
             have
               "B.can (Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu>) (Cod \<mu> \<^bold>\<star> Cod \<nu>) \<cdot>\<^sub>B
                  (Map \<mu> \<star>\<^sub>B Map \<nu>) \<cdot>\<^sub>B B.can (Dom \<mu> \<^bold>\<star> Dom \<nu>) (Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu>) \<star>\<^sub>B Map \<tau> =
                B.can ((Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu>) \<^bold>\<star> Cod \<tau>) (Cod \<mu> \<^bold>\<star> Cod \<nu> \<^bold>\<star> Cod \<tau>) \<cdot>\<^sub>B
                  (Map \<mu> \<star>\<^sub>B Map \<nu> \<star>\<^sub>B Map \<tau>) \<cdot>\<^sub>B
                  B.can (Dom \<mu> \<^bold>\<star> Dom \<nu> \<^bold>\<star> Dom \<tau>) ((Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu>) \<^bold>\<star> Dom \<tau>)"
             proof -
               have "B.can (Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu>) (Cod \<mu> \<^bold>\<star> Cod \<nu>) \<cdot>\<^sub>B
                       (Map \<mu> \<star>\<^sub>B Map \<nu>) \<cdot>\<^sub>B B.can (Dom \<mu> \<^bold>\<star> Dom \<nu>) (Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu>)
                          \<star>\<^sub>B Map \<tau> =
                     (B.can (Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu>) (Cod \<mu> \<^bold>\<star> Cod \<nu>) \<star>\<^sub>B B.can (Cod \<tau>) (Cod \<tau>)) \<cdot>\<^sub>B
                       ((Map \<mu> \<star>\<^sub>B Map \<nu>) \<cdot>\<^sub>B
                          B.can (Dom \<mu> \<^bold>\<star> Dom \<nu>) (Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu>) \<star>\<^sub>B Map \<tau>)"
               proof -
                 have "B.seq (B.can (Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu>) (Cod \<mu> \<^bold>\<star> Cod \<nu>))
                                ((Map \<mu> \<star>\<^sub>B Map \<nu>) \<cdot>\<^sub>B B.can (Dom \<mu> \<^bold>\<star> Dom \<nu>) (Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu>))"
                   by (metis (no_types, lifting) B.arrI Map_hcomp arrE arr_hcomp
                       assms(1) assms(2) assms(4))
                 moreover have "B.seq (B.can (Cod \<tau>) (Cod \<tau>)) (Map \<tau>)"
                   using B.can_in_hom assms(3) by blast
                 moreover have "B.ide (B.can (Cod \<tau>) (Cod \<tau>))"
                   using B.can_Ide_self E.ide_eval_Ide arr_char assms(3) by presburger
                 ultimately show ?thesis
                   by (metis (no_types) B.comp_ide_arr B.interchange)
               qed
               also have
                 "... = (B.can (Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu>) (Cod \<mu> \<^bold>\<star> Cod \<nu>) \<star>\<^sub>B B.can (Cod \<tau>) (Cod \<tau>)) \<cdot>\<^sub>B
                          ((Map \<mu> \<star>\<^sub>B Map \<nu>) \<star>\<^sub>B Map \<tau>) \<cdot>\<^sub>B
                            (B.can (Dom \<mu> \<^bold>\<star> Dom \<nu>) (Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu>) \<star>\<^sub>B
                               B.can (Dom \<tau>) (Dom \<tau>))"
               proof -
                 have "B.seq (Map \<mu> \<star>\<^sub>B Map \<nu>) (B.can (Dom \<mu> \<^bold>\<star> Dom \<nu>) (Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu>))"
                   by (metis (no_types, lifting) B.arrI B.comp_null(2) B.ext Map_hcomp
                       arrE arr_hcomp assms(1) assms(2) assms(4))
                 moreover have "B.seq (Map \<tau>) (B.can (Dom \<tau>) (Dom \<tau>))"
                   using assms(3) by fastforce
                 ultimately show ?thesis
                   using B.interchange
                   by (metis (no_types, lifting) B.can_Ide_self B.comp_arr_ide E.ide_eval_Ide
                       arrE assms(3))
               qed
               also have
                 "... = (B.can (Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu>) (Cod \<mu> \<^bold>\<star> Cod \<nu>) \<star>\<^sub>B B.can (Cod \<tau>) (Cod \<tau>)) \<cdot>\<^sub>B
                          (B.can ((Cod \<mu> \<^bold>\<star> Cod \<nu>) \<^bold>\<star> Cod \<tau>) (Cod \<mu> \<^bold>\<star> Cod \<nu> \<^bold>\<star> Cod \<tau>) \<cdot>\<^sub>B
                            (Map \<mu> \<star>\<^sub>B Map \<nu> \<star>\<^sub>B Map \<tau>) \<cdot>\<^sub>B
                              B.can (Dom \<mu> \<^bold>\<star> Dom \<nu> \<^bold>\<star> Dom \<tau>) ((Dom \<mu> \<^bold>\<star> Dom \<nu>) \<^bold>\<star> Dom \<tau>)) \<cdot>\<^sub>B
                            (B.can (Dom \<mu> \<^bold>\<star> Dom \<nu>) (Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu>) \<star>\<^sub>B
                               B.can (Dom \<tau>) (Dom \<tau>))"
               proof -
                 have "(Map \<mu> \<star>\<^sub>B Map \<nu>) \<star>\<^sub>B Map \<tau> =
                         B.\<a>' \<lbrace>Cod \<mu>\<rbrace> \<lbrace>Cod \<nu>\<rbrace> \<lbrace>Cod \<tau>\<rbrace> \<cdot>\<^sub>B
                           (Map \<mu> \<star>\<^sub>B Map \<nu> \<star>\<^sub>B Map \<tau>) \<cdot>\<^sub>B
                              \<a>\<^sub>B \<lbrace>Dom \<mu>\<rbrace> \<lbrace>Dom \<nu>\<rbrace> \<lbrace>Dom \<tau>\<rbrace>"
                   using B.hcomp_reassoc(1)
                   by (metis (no_types, lifting) B.hcomp_in_vhomE B.in_homE \<mu>\<nu> \<nu>\<tau> arrE
                       assms(1) assms(2) assms(3))
                 also have "... = B.can ((Cod \<mu> \<^bold>\<star> Cod \<nu>) \<^bold>\<star> Cod \<tau>) (Cod \<mu> \<^bold>\<star> Cod \<nu> \<^bold>\<star> Cod \<tau>) \<cdot>\<^sub>B
                                    (Map \<mu> \<star>\<^sub>B Map \<nu> \<star>\<^sub>B Map \<tau>) \<cdot>\<^sub>B
                                       B.can (Dom \<mu> \<^bold>\<star> Dom \<nu> \<^bold>\<star> Dom \<tau>) ((Dom \<mu> \<^bold>\<star> Dom \<nu>) \<^bold>\<star> Dom \<tau>)"
                   using assms arr_char src_def trg_def arr_char B.canE_associator by simp
                finally show ?thesis by simp
               qed
               also have
                 "... = ((B.can (Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu>) (Cod \<mu> \<^bold>\<star> Cod \<nu>) \<star>\<^sub>B B.can (Cod \<tau>) (Cod \<tau>)) \<cdot>\<^sub>B
                          (B.can ((Cod \<mu> \<^bold>\<star> Cod \<nu>) \<^bold>\<star> Cod \<tau>) (Cod \<mu> \<^bold>\<star> Cod \<nu> \<^bold>\<star> Cod \<tau>))) \<cdot>\<^sub>B
                        (Map \<mu> \<star>\<^sub>B Map \<nu> \<star>\<^sub>B Map \<tau>) \<cdot>\<^sub>B
                        (B.can (Dom \<mu> \<^bold>\<star> Dom \<nu> \<^bold>\<star> Dom \<tau>) ((Dom \<mu> \<^bold>\<star> Dom \<nu>) \<^bold>\<star> Dom \<tau>) \<cdot>\<^sub>B
                           (B.can (Dom \<mu> \<^bold>\<star> Dom \<nu>) (Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu>) \<star>\<^sub>B
                              B.can (Dom \<tau>) (Dom \<tau>)))"
                 using B.comp_assoc by simp
               also have
                 "... = B.can ((Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu>) \<^bold>\<star> Cod \<tau>) (Cod \<mu> \<^bold>\<star> Cod \<nu> \<^bold>\<star> Cod \<tau>) \<cdot>\<^sub>B
                          (Map \<mu> \<star>\<^sub>B Map \<nu> \<star>\<^sub>B Map \<tau>) \<cdot>\<^sub>B
                          B.can (Dom \<mu> \<^bold>\<star> Dom \<nu> \<^bold>\<star> Dom \<tau>) ((Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu>) \<^bold>\<star> Dom \<tau>)"
               proof -
                 have "(B.can (Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu>) (Cod \<mu> \<^bold>\<star> Cod \<nu>) \<star>\<^sub>B B.can (Cod \<tau>) (Cod \<tau>)) \<cdot>\<^sub>B
                         (B.can ((Cod \<mu> \<^bold>\<star> Cod \<nu>) \<^bold>\<star> Cod \<tau>) (Cod \<mu> \<^bold>\<star> Cod \<nu> \<^bold>\<star> Cod \<tau>)) =
                       B.can ((Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu>) \<^bold>\<star> Cod \<tau>) (Cod \<mu> \<^bold>\<star> Cod \<nu> \<^bold>\<star> Cod \<tau>)"
                 proof -
                   have "E.Ide (Cod \<mu> \<^bold>\<star> Cod \<nu>)"
                     by (metis (no_types, lifting) E.Ide.simps(3) arrE assms(1-2,4)
                         src_simps(1) trg_simps(1))
                   moreover have "E.Ide (Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu>)"
                     using E.Ide_HcompNml assms(1) assms(2) calculation by auto
                   moreover have "\<^bold>\<lfloor>Cod \<mu> \<^bold>\<star> Cod \<nu>\<^bold>\<rfloor> = \<^bold>\<lfloor>Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu>\<^bold>\<rfloor>"
                     using E.Nml_HcompNml(1) assms(1) assms(2) calculation(1) by fastforce
                   moreover have "E.Src (Cod \<mu> \<^bold>\<star> Cod \<nu>) = E.Trg (Cod \<tau>)"
                     by (metis (no_types, lifting) E.Src.simps(3) arrE assms(2-3,5)
                         src_simps(2) trg_simps(2))
                   moreover have "E.Src (Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu>) = E.Trg (Cod \<tau>)"
                     using E.Src_HcompNml assms(1) assms(2) calculation(1) calculation(4)
                     by fastforce
                   moreover have "\<^bold>\<lfloor>Cod \<mu> \<^bold>\<star> Cod \<nu> \<^bold>\<star> Cod \<tau>\<^bold>\<rfloor> = \<^bold>\<lfloor>(Cod \<mu> \<^bold>\<star> Cod \<nu>) \<^bold>\<star> Cod \<tau>\<^bold>\<rfloor>"
                     by (metis (no_types, lifting) E.Arr.simps(3) E.Nmlize_Hcomp_Hcomp
                         E.Nmlize_Hcomp_Hcomp' E.Ide_implies_Arr E.Src.simps(3) arrE assms(3)
                         calculation(1) calculation(4))
                   ultimately show ?thesis
                     using assms(3) B.hcomp_can B.vcomp_can by auto
                 qed
                 moreover have
                   "B.can (Dom \<mu> \<^bold>\<star> Dom \<nu> \<^bold>\<star> Dom \<tau>) ((Dom \<mu> \<^bold>\<star> Dom \<nu>) \<^bold>\<star> Dom \<tau>) \<cdot>\<^sub>B
                      (B.can (Dom \<mu> \<^bold>\<star> Dom \<nu>) (Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu>) \<star>\<^sub>B B.can (Dom \<tau>) (Dom \<tau>)) =
                    B.can (Dom \<mu> \<^bold>\<star> Dom \<nu> \<^bold>\<star> Dom \<tau>) ((Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu>) \<^bold>\<star> Dom \<tau>)"
                 proof -
                   have "E.Ide (Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu>)"
                     by (metis (no_types, lifting) E.Ide_HcompNml arrE assms(1-2,4)
                         src_simps(2) trg_simps(2))
                   moreover have "E.Ide (Dom \<mu> \<^bold>\<star> Dom \<nu>)"
                     by (metis (no_types, lifting) E.Ide.simps(3) arrE assms(1-2,4)
                         src_simps(1) trg_simps(1))
                   moreover have "\<^bold>\<lfloor>Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu>\<^bold>\<rfloor> = \<^bold>\<lfloor>Dom \<mu> \<^bold>\<star> Dom \<nu>\<^bold>\<rfloor>"
                     using E.Nml_HcompNml(1) assms(1-2) calculation(2) by fastforce
                   moreover have "E.Src (Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu>) = E.Trg (Dom \<tau>)"
                     by (metis (no_types, lifting) E.Ide.simps(3) E.Src_HcompNml arrE
                         assms(1-3,5) calculation(2) src_simps(2) trg_simps(2))
                   moreover have "E.Src (Dom \<mu> \<^bold>\<star> Dom \<nu>) = E.Trg (Dom \<tau>)"
                     using E.Src_HcompNml assms(1-2) calculation(2) calculation(4)
                     by fastforce
                   moreover have "E.Ide ((Dom \<mu> \<^bold>\<star> Dom \<nu>) \<^bold>\<star> Dom \<tau>)"
                     using E.Ide.simps(3) assms(3) calculation(2) calculation(5) by blast
                   moreover have "\<^bold>\<lfloor>(Dom \<mu> \<^bold>\<star> Dom \<nu>) \<^bold>\<star> Dom \<tau>\<^bold>\<rfloor> = \<^bold>\<lfloor>Dom \<mu> \<^bold>\<star> Dom \<nu> \<^bold>\<star> Dom \<tau>\<^bold>\<rfloor>"
                     using E.Nmlize_Hcomp_Hcomp calculation(6) by auto
                   ultimately show ?thesis
                     using assms(3) B.hcomp_can B.vcomp_can by auto
                 qed
                 ultimately show ?thesis by simp
               qed
               finally show ?thesis by simp
             qed
             thus ?thesis by simp
           qed
           also have
             "... = (B.can (Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<tau>) ((Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu>) \<^bold>\<star> Cod \<tau>) \<cdot>\<^sub>B
                      B.can ((Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu>) \<^bold>\<star> Cod \<tau>) (Cod \<mu> \<^bold>\<star> Cod \<nu> \<^bold>\<star> Cod \<tau>)) \<cdot>\<^sub>B
                        (Map \<mu> \<star>\<^sub>B Map \<nu> \<star>\<^sub>B Map \<tau>) \<cdot>\<^sub>B
                          B.can (Dom \<mu> \<^bold>\<star> Dom \<nu> \<^bold>\<star> Dom \<tau>) ((Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu>) \<^bold>\<star> Dom \<tau>) \<cdot>\<^sub>B
                            B.can ((Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu>) \<^bold>\<star> Dom \<tau>) (Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<tau>)"
             using B.comp_assoc by simp
           also have "... = B.can (Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<tau>) (Cod \<mu> \<^bold>\<star> Cod \<nu> \<^bold>\<star> Cod \<tau>) \<cdot>\<^sub>B
                              (Map \<mu> \<star>\<^sub>B Map \<nu> \<star>\<^sub>B Map \<tau>) \<cdot>\<^sub>B
                                B.can (Dom \<mu> \<^bold>\<star> Dom \<nu> \<^bold>\<star> Dom \<tau>) (Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<tau>)"
           proof -
             have "B.can (Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<tau>) ((Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu>) \<^bold>\<star> Cod \<tau>) \<cdot>\<^sub>B
                     B.can ((Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu>) \<^bold>\<star> Cod \<tau>) (Cod \<mu> \<^bold>\<star> Cod \<nu> \<^bold>\<star> Cod \<tau>) =
                   B.can (Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<tau>) (Cod \<mu> \<^bold>\<star> Cod \<nu> \<^bold>\<star> Cod \<tau>)"
             proof -
               have "E.Ide (Cod \<mu> \<^bold>\<star> Cod \<nu> \<^bold>\<star> Cod \<tau>)"
                 using assms src_def trg_def by fastforce
               moreover have "E.Ide ((Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu>) \<^bold>\<star> Cod \<tau>)"
                 using assms arr_char src_def trg_def E.Ide_HcompNml E.Src_HcompNml
                 by auto
               moreover have "E.Ide (Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<tau>)"
                 using assms arr_char src_def trg_def
                 by (simp add: E.Nml_HcompNml(1) E.Ide_HcompNml E.Trg_HcompNml)
               moreover have "\<^bold>\<lfloor>Cod \<mu> \<^bold>\<star> Cod \<nu> \<^bold>\<star> Cod \<tau>\<^bold>\<rfloor> = \<^bold>\<lfloor>(Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu>) \<^bold>\<star> Cod \<tau>\<^bold>\<rfloor>"
                 using assms arr_char src_def trg_def E.Nml_HcompNml E.HcompNml_assoc by simp
               moreover have "\<^bold>\<lfloor>(Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu>) \<^bold>\<star> Cod \<tau>\<^bold>\<rfloor> = \<^bold>\<lfloor>Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<tau>\<^bold>\<rfloor>"
                 using assms arr_char src_def trg_def E.Nml_HcompNml E.HcompNml_assoc
                 by simp
               ultimately show ?thesis by simp
             qed
             moreover have
               "B.can (Dom \<mu> \<^bold>\<star> Dom \<nu> \<^bold>\<star> Dom \<tau>) ((Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu>) \<^bold>\<star> Dom \<tau>) \<cdot>\<^sub>B
                  B.can ((Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu>) \<^bold>\<star> Dom \<tau>) (Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<tau>) =
                B.can (Dom \<mu> \<^bold>\<star> Dom \<nu> \<^bold>\<star> Dom \<tau>) (Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<tau>)"
             proof -
               have "E.Ide (Dom \<mu> \<^bold>\<star> Dom \<nu> \<^bold>\<star> Dom \<tau>)"
                 using assms src_def trg_def by fastforce
               moreover have "E.Ide ((Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu>) \<^bold>\<star> Dom \<tau>)"
                 using assms arr_char src_def trg_def E.Ide_HcompNml E.Src_HcompNml
                 by auto
               moreover have "E.Ide (Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<tau>)"
                 using assms arr_char src_def trg_def
                 by (simp add: E.Nml_HcompNml(1) E.Ide_HcompNml E.Trg_HcompNml)
               moreover have "\<^bold>\<lfloor>Dom \<mu> \<^bold>\<star> Dom \<nu> \<^bold>\<star> Dom \<tau>\<^bold>\<rfloor> = \<^bold>\<lfloor>(Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu>) \<^bold>\<star> Dom \<tau>\<^bold>\<rfloor>"
                 using assms arr_char src_def trg_def E.Nml_HcompNml E.HcompNml_assoc by simp
               moreover have
                 "\<^bold>\<lfloor>(Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu>) \<^bold>\<star> Dom \<tau>\<^bold>\<rfloor> = \<^bold>\<lfloor>Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<tau>\<^bold>\<rfloor>"
                 using assms arr_char src_def trg_def E.Nml_HcompNml E.HcompNml_assoc
                 by simp
               ultimately show ?thesis by simp
             qed
             ultimately show ?thesis by simp
           qed
           finally show ?thesis by simp
         qed
         also have "... = Map (\<mu> \<star> \<nu> \<star> \<tau>)"
         proof -
           have 1: "Map (\<mu> \<star> \<nu> \<star> \<tau>) =
                    B.can (Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<tau>) (Cod \<mu> \<^bold>\<star> Cod \<nu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<tau>) \<cdot>\<^sub>B
                      (Map \<mu> \<star>\<^sub>B B.can (Cod \<nu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<tau>) (Cod \<nu> \<^bold>\<star> Cod \<tau>) \<cdot>\<^sub>B
                                 (Map \<nu> \<star>\<^sub>B Map \<tau>) \<cdot>\<^sub>B
                                   B.can (Dom \<nu> \<^bold>\<star> Dom \<tau>) (Dom \<nu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<tau>)) \<cdot>\<^sub>B
                         B.can (Dom \<mu> \<^bold>\<star> Dom \<nu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<tau>) (Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<tau>)"
             using assms Map_hcomp [of \<mu> "\<nu> \<star> \<tau>"] Map_hcomp [of \<nu> \<tau>] by simp
           also have
             "... = B.can (Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<tau>) (Cod \<mu> \<^bold>\<star> Cod \<nu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<tau>) \<cdot>\<^sub>B
                      ((B.can (Cod \<mu>) (Cod \<mu>) \<star>\<^sub>B B.can (Cod \<nu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<tau>) (Cod \<nu> \<^bold>\<star> Cod \<tau>)) \<cdot>\<^sub>B
                        (Map \<mu> \<star>\<^sub>B Map \<nu> \<star>\<^sub>B Map \<tau>) \<cdot>\<^sub>B
                          (B.can (Dom \<mu>) (Dom \<mu>) \<star>\<^sub>B
                             B.can (Dom \<nu> \<^bold>\<star> Dom \<tau>) (Dom \<nu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<tau>))) \<cdot>\<^sub>B
                      B.can (Dom \<mu> \<^bold>\<star> Dom \<nu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<tau>) (Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<tau>)"
           proof -
             have "Map \<mu> \<star>\<^sub>B B.can (Cod \<nu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<tau>) (Cod \<nu> \<^bold>\<star> Cod \<tau>) \<cdot>\<^sub>B
                             (Map \<nu> \<star>\<^sub>B Map \<tau>) \<cdot>\<^sub>B
                               B.can (Dom \<nu> \<^bold>\<star> Dom \<tau>) (Dom \<nu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<tau>) =
                     (B.can (Cod \<mu>) (Cod \<mu>) \<star>\<^sub>B B.can (Cod \<nu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<tau>) (Cod \<nu> \<^bold>\<star> Cod \<tau>)) \<cdot>\<^sub>B
                        (Map \<mu> \<star>\<^sub>B (Map \<nu> \<star>\<^sub>B Map \<tau>) \<cdot>\<^sub>B
                           B.can (Dom \<nu> \<^bold>\<star> Dom \<tau>) (Dom \<nu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<tau>))"
               using assms B.interchange B.comp_cod_arr
               by (metis (no_types, lifting) B.can_Ide_self B.in_homE Map_hcomp arrE hseq_char)
             also have "... = (B.can (Cod \<mu>) (Cod \<mu>) \<star>\<^sub>B
                                  B.can (Cod \<nu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<tau>) (Cod \<nu> \<^bold>\<star> Cod \<tau>)) \<cdot>\<^sub>B
                                (Map \<mu> \<star>\<^sub>B Map \<nu> \<star>\<^sub>B Map \<tau>) \<cdot>\<^sub>B
                                  (B.can (Dom \<mu>) (Dom \<mu>) \<star>\<^sub>B
                                     B.can (Dom \<nu> \<^bold>\<star> Dom \<tau>) (Dom \<nu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<tau>))"
               using assms B.interchange B.comp_arr_dom [of "Map \<mu>" "B.can (Dom \<mu>) (Dom \<mu>)"]
               by (metis (no_types, lifting) B.can_Ide_self B.comp_null(2) B.ext B.in_homE
                   Map_hcomp arrE hseq_char)
             finally have
               "Map \<mu> \<star>\<^sub>B B.can (Cod \<nu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<tau>) (Cod \<nu> \<^bold>\<star> Cod \<tau>) \<cdot>\<^sub>B
                  (Map \<nu> \<star>\<^sub>B Map \<tau>) \<cdot>\<^sub>B
                    B.can (Dom \<nu> \<^bold>\<star> Dom \<tau>) (Dom \<nu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<tau>) =
               (B.can (Cod \<mu>) (Cod \<mu>) \<star>\<^sub>B B.can (Cod \<nu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<tau>) (Cod \<nu> \<^bold>\<star> Cod \<tau>)) \<cdot>\<^sub>B
                 (Map \<mu> \<star>\<^sub>B Map \<nu> \<star>\<^sub>B Map \<tau>) \<cdot>\<^sub>B
                   (B.can (Dom \<mu>) (Dom \<mu>) \<star>\<^sub>B B.can (Dom \<nu> \<^bold>\<star> Dom \<tau>) (Dom \<nu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<tau>))"
               by simp
             thus ?thesis by simp
           qed
           also have
             "... = (B.can (Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<tau>) (Cod \<mu> \<^bold>\<star> Cod \<nu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<tau>) \<cdot>\<^sub>B
                      (B.can (Cod \<mu>) (Cod \<mu>) \<star>\<^sub>B B.can (Cod \<nu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<tau>) (Cod \<nu> \<^bold>\<star> Cod \<tau>))) \<cdot>\<^sub>B
                        (Map \<mu> \<star>\<^sub>B Map \<nu> \<star>\<^sub>B Map \<tau>) \<cdot>\<^sub>B
                          ((B.can (Dom \<mu>) (Dom \<mu>) \<star>\<^sub>B
                              B.can (Dom \<nu> \<^bold>\<star> Dom \<tau>) (Dom \<nu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<tau>)) \<cdot>\<^sub>B
                            B.can (Dom \<mu> \<^bold>\<star> Dom \<nu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<tau>) (Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<tau>))"
             using B.comp_assoc by simp
           also have "... = B.can (Cod \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<nu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod \<tau>) (Cod \<mu> \<^bold>\<star> Cod \<nu> \<^bold>\<star> Cod \<tau>) \<cdot>\<^sub>B
                              (Map \<mu> \<star>\<^sub>B Map \<nu> \<star>\<^sub>B Map \<tau>) \<cdot>\<^sub>B
                                 B.can (Dom \<mu> \<^bold>\<star> Dom \<nu> \<^bold>\<star> Dom \<tau>) (Dom \<mu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<nu> \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom \<tau>)"
             using assms \<mu>\<nu> \<nu>\<tau> E.HcompNml_assoc src_def trg_def arr_char
                   E.Src_HcompNml E.Trg_HcompNml E.Nml_HcompNml E.Ide_HcompNml
             by simp
           finally show ?thesis by simp
         qed
         ultimately show ?thesis by metis
       qed
     qed
 
     lemma obj_char:
     shows "obj a \<longleftrightarrow> endo a \<and> E.Obj (Dom a) \<and> Map a = \<lbrace>Dom a\<rbrace>"
     proof
       assume a: "obj a"
       show "endo a \<and> E.Obj (Dom a) \<and> Map a = \<lbrace>Dom a\<rbrace>"
       proof (intro conjI)
         show "endo a"
           using a ide_char by blast
         show "E.Obj (Dom a)"
           using a ide_char src_def
           by (metis (no_types, lifting) E.Ide_implies_Arr E.Obj_Trg arrE obj_def
               trg_simps(1) trg_src) 
         show "Map a = \<lbrace>Dom a\<rbrace>"
           using a ide_char src_def by blast
       qed
       next
       assume a: "endo a \<and> E.Obj (Dom a) \<and> Map a = \<lbrace>Dom a\<rbrace>"
       show "obj a"
       proof -
         have "arr a" using a by auto
         moreover have "src a = a"
           using a E.Obj_in_Hom(1) seq_char by (intro arr_eqI, auto)
         ultimately show ?thesis
           using obj_def by simp
       qed
     qed
 
     lemma hcomp_obj_self:
     assumes "obj a"
     shows "a \<star> a = a"
     proof (intro arr_eqI)
       show "H.hseq a a"
         using assms by auto
       show "arr a"
         using assms by auto
       show 1: "Dom (a \<star> a) = Dom a"
         unfolding hcomp_def
         using assms arr_char E.HcompNml_Trg_Nml
         apply simp
         by (metis (no_types, lifting) objE obj_def trg_simps(1))
       show 2: "Cod (a \<star> a) = Cod a"
         unfolding hcomp_def
         using assms 1 arr_char E.HcompNml_Trg_Nml
         apply simp
         by (metis (no_types, lifting) Dom_hcomp ideE objE)
       show "Map (a \<star> a) = Map a"
       proof -
         have "Map (a \<star> a) = B.can (Cod a \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod a) (Cod a \<^bold>\<star> Cod a) \<cdot>\<^sub>B
                               (Map a \<star>\<^sub>B Map a) \<cdot>\<^sub>B
                                 B.can (Dom a \<^bold>\<star> Dom a) (Dom a \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom a)"
           using assms Map_hcomp by auto
         also have "... = B.can (Dom a) (Dom a \<^bold>\<star> Dom a) \<cdot>\<^sub>B
                            (\<lbrace>Dom a\<rbrace> \<star>\<^sub>B \<lbrace>Dom a\<rbrace>) \<cdot>\<^sub>B
                               B.can (Dom a \<^bold>\<star> Dom a) (Dom a)"
         proof -
           have "Dom a \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom a = Dom a"
             using assms obj_char arr_char E.HcompNml_Trg_Nml
             by (metis (no_types, lifting) ideE objE obj_def' trg_simps(2))
           moreover have "Cod a = Dom a"
             using assms obj_char arr_char dom_char cod_char objE ide_char'
             by (metis (no_types, lifting) src_simps(1) src_simps(2))
           moreover have "Map a = \<lbrace>Dom a\<rbrace>"
             using assms obj_char by simp
           ultimately show ?thesis by simp
         qed
         also have "... = B.can (Dom a) (Dom a \<^bold>\<star> Dom a) \<cdot>\<^sub>B B.can (Dom a \<^bold>\<star> Dom a) (Dom a)"
           using assms obj_char arr_char B.comp_cod_arr E.ide_eval_Ide B.can_in_hom
           by (metis (no_types, lifting) H.ide_hcomp obj_def obj_def'
               calculation B.comp_ide_arr B.ide_hcomp B.hseqE B.ideD(1) ide_char B.seqE)
         also have "... = \<lbrace>Dom a\<rbrace>"
           using assms 1 2 obj_char arr_char B.vcomp_can calculation H.ide_hcomp ideE objE
           by (metis (no_types, lifting))
         also have "... = Map a"
           using assms obj_char by simp
         finally show ?thesis by simp
       qed
     qed
 
     lemma hcomp_ide_src:
     assumes "ide f"
     shows "f \<star> src f = f"
     proof (intro arr_eqI)
       show "H.hseq f (src f)"
         using assms by simp
       show "arr f"
         using assms by simp
       show 1: "Dom (f \<star> src f) = Dom f"
         unfolding hcomp_def
         using assms apply simp
         using assms ide_char arr_char E.HcompNml_Nml_Src
         by (metis (no_types, lifting) ideD(1))
       show "Cod (f \<star> src f) = Cod f"
         unfolding hcomp_def
         using assms apply simp
         using assms ide_char arr_char E.HcompNml_Nml_Src
         by (metis (no_types, lifting) ideD(1))
       show "Map (f \<star> src f) = Map f"
       proof -
         have "Map (f \<star> src f) = B.can (Cod f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod (src f)) (Cod f \<^bold>\<star> Cod (src f)) \<cdot>\<^sub>B
                                   (Map f \<star>\<^sub>B Map (src f)) \<cdot>\<^sub>B
                                     B.can (Dom f \<^bold>\<star> Dom (src f)) (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (src f))"
           unfolding hcomp_def
           using assms by simp
         also have "... = B.can (Dom f) (Dom f \<^bold>\<star> E.Src (Dom f)) \<cdot>\<^sub>B
                            (\<lbrace>Dom f\<rbrace> \<star>\<^sub>B \<lbrace>E.Src (Dom f)\<rbrace>) \<cdot>\<^sub>B
                              B.can (Dom f \<^bold>\<star> E.Src (Dom f)) (Dom f)"
           using assms arr_char E.HcompNml_Nml_Src by fastforce
         also have "... = B.can (Dom f) (Dom f \<^bold>\<star> E.Src (Dom f)) \<cdot>\<^sub>B
                            B.can (Dom f \<^bold>\<star> E.Src (Dom f)) (Dom f)"
         proof -
           have "\<guillemotleft>B.can (Dom f \<^bold>\<star> E.Src (Dom f)) (Dom f) :
                   \<lbrace>Dom f\<rbrace> \<Rightarrow>\<^sub>B \<lbrace>Dom f\<rbrace> \<star>\<^sub>B \<lbrace>E.Src (Dom f)\<rbrace>\<guillemotright>"
             using assms ide_char arr_char B.can_in_hom
             by (metis (no_types, lifting) B.canE_unitor(3) B.runit'_in_vhom E.eval_simps(2)
                 E.Ide_implies_Arr ideE)
           thus ?thesis
             using B.comp_cod_arr by auto
         qed
         also have "... = \<lbrace>Dom f\<rbrace>"
           using assms 1 ide_char arr_char
           by (metis (no_types, lifting) H.ide_hcomp calculation ideE ide_src obj_def' obj_src)
         also have "... = Map f"
           using assms by auto
         finally show ?thesis by simp
       qed
     qed
 
     lemma hcomp_trg_ide:
     assumes "ide f"
     shows "trg f \<star> f = f"
     proof (intro arr_eqI)
       show "H.hseq (trg f) f"
         using assms by auto
       show "arr f"
         using assms by auto
       show 1: "Dom (trg f \<star> f) = Dom f"
         unfolding hcomp_def
         using assms apply simp
         using assms ide_char arr_char E.HcompNml_Trg_Nml
         by (metis (no_types, lifting) ideD(1))
       show "Cod (trg f \<star> f) = Cod f"
         unfolding hcomp_def
         using assms apply simp
         using assms ide_char arr_char E.HcompNml_Trg_Nml
         by (metis (no_types, lifting)  ideD(1))
       show "Map (trg f \<star> f) = Map f"
       proof -
         have "Map (trg f \<star> f) = B.can (Cod (trg f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod f) (Cod (trg f) \<^bold>\<star> Cod f) \<cdot>\<^sub>B
                                   (Map (trg f) \<star>\<^sub>B Map f) \<cdot>\<^sub>B
                                     B.can (Dom (trg f) \<^bold>\<star> Dom f) (Dom (trg f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom f)"
           unfolding hcomp_def
           using assms by simp
         also have "... = B.can (Dom f) (E.Trg (Dom f) \<^bold>\<star> Dom f) \<cdot>\<^sub>B
                            (\<lbrace>E.Trg (Dom f)\<rbrace> \<star>\<^sub>B \<lbrace>Dom f\<rbrace>) \<cdot>\<^sub>B
                              B.can (E.Trg (Dom f) \<^bold>\<star> Dom f) (Dom f)"
           using assms arr_char E.HcompNml_Trg_Nml by fastforce
         also have "... = B.can (Dom f) (E.Trg (Dom f) \<^bold>\<star> Dom f) \<cdot>\<^sub>B
                            B.can (E.Trg (Dom f) \<^bold>\<star> Dom f) (Dom f)"
         proof -
           have "\<guillemotleft>B.can (E.Trg (Dom f) \<^bold>\<star> Dom f) (Dom f) :
                   \<lbrace>Dom f\<rbrace> \<Rightarrow>\<^sub>B \<lbrace>E.Trg (Dom f)\<rbrace> \<star>\<^sub>B \<lbrace>Dom f\<rbrace>\<guillemotright>"
             using assms ide_char arr_char B.can_in_hom
             by (metis (no_types, lifting) B.canE_unitor(4) B.lunit'_in_vhom E.Nml_implies_Arr
                 E.eval_simps'(3) ideE)
           thus ?thesis
             using B.comp_cod_arr by auto
         qed
         also have "... = \<lbrace>Dom f\<rbrace>"
           using assms 1 ide_char arr_char
           by (metis (no_types, lifting) H.ide_hcomp Map_ide(1) calculation ideD(1)
               src_trg trg.preserves_ide)
         also have "... = Map f"
           using assms by auto
         finally show ?thesis by simp
       qed
     qed
 
     interpretation L: endofunctor vcomp H.L
       using H.endofunctor_L by auto
     interpretation R: endofunctor vcomp H.R
       using H.endofunctor_R by auto
 
     interpretation L: full_functor vcomp vcomp H.L
     proof
       fix a a' g
       assume a: "ide a" and a': "ide a'"
       assume g: "in_hom g (H.L a') (H.L a)"
       have a_eq: "a = MkIde (Dom a)"
         using a dom_char [of a] by simp
       have a'_eq: "a' = MkIde (Dom a')"
         using a' dom_char [of a'] by simp
       have 1: "Cod g = Dom a"
       proof -
         have "Dom (H.L a) = Dom a"
         proof -
           have "Dom (H.L a) = E.Trg (Dom a) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom a"
             using a trg_def hcomp_def
             apply simp
             by (metis (no_types, lifting) ideE src_trg trg.preserves_reflects_arr)
           also have "... = Dom a"
             using a arr_char E.Trg_HcompNml
             by (metis (no_types, lifting) E.HcompNml_Trg_Nml ideD(1))
           finally show ?thesis by simp
         qed
         thus ?thesis
           using g cod_char [of g]
           by (metis (no_types, lifting) Dom_cod in_homE)
       qed
       have 2: "Dom g = Dom a'"
       proof -
         have "Dom (H.L a') = Dom a'"
         proof -
           have "Dom (H.L a') = E.Trg (Dom a') \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom a'"
             using a' trg_def hcomp_def
             apply simp
             by (metis (no_types, lifting) ideE src_trg trg.preserves_reflects_arr)
           also have "... = Dom a'"
             using a' arr_char E.Trg_HcompNml
             by (metis (no_types, lifting) E.HcompNml_Trg_Nml ideD(1))
           finally show ?thesis by simp
         qed
         thus ?thesis
           using g dom_char [of g]
           by (metis (no_types, lifting) Dom_dom in_homE)
       qed
       let ?f = "MkArr (Dom a') (Cod a) (Map g)"
       have f: "in_hom ?f a' a"
       proof (intro in_homI)
         show 3: "arr (MkArr (Dom a') (Cod a) (Map g))"
         proof (intro arr_MkArr [of "Dom a'" "Cod a" "Map g"])
           show "Dom a' \<in> IDE"
             using a' ide_char arr_char by blast
           show "Cod a \<in> IDE"
             using a ide_char arr_char by blast
           show "Map g \<in> HOM (Dom a') (Cod a)"
           proof
             show "E.Src (Dom a') = E.Src (Cod a) \<and> E.Trg (Dom a') = E.Trg (Cod a) \<and>
                   \<guillemotleft>Map g : \<lbrace>Dom a'\<rbrace> \<Rightarrow>\<^sub>B \<lbrace>Cod a\<rbrace>\<guillemotright>"
               using a a' a_eq g 1 2 ide_char arr_char src_def trg_def trg_hcomp
               by (metis (no_types, lifting) Cod.simps(1) in_homE)
           qed
         qed
         show "dom (MkArr (Dom a') (Cod a) (Map g)) = a'"
           using a a' 3 dom_char by auto
         show "cod (MkArr (Dom a') (Cod a) (Map g)) = a"
           using a a' 3 cod_char by auto
       qed
       moreover have "H.L ?f = g"
       proof -
         have "H.L ?f =
               trg (MkArr (Dom a') (Cod a) (Map g)) \<star> MkArr (Dom a') (Cod a) (Map g)"
           using f by auto
         also have "... = MkIde (E.Trg (Cod a)) \<star> MkArr (Dom a') (Cod a) (Map g)"
           using a a' f trg_def [of a] vconn_implies_hpar by auto
         also have "... = MkArr (E.Trg (Cod a) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom a') (E.Trg (Cod a) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod a)
                                (B.can (E.Trg (Cod a) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod a) (E.Trg (Cod a) \<^bold>\<star> Cod a) \<cdot>\<^sub>B
                                  (\<lbrace>E.Trg (Cod a)\<rbrace> \<star>\<^sub>B Map g) \<cdot>\<^sub>B
                                  B.can (E.Trg (Cod a) \<^bold>\<star> Dom a') (E.Trg (Cod a) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom a'))"
           using hcomp_def
           apply simp
           by (metis (no_types, lifting) Cod.simps(1) arrE f in_homE src_trg trg.preserves_arr
               trg_def)
         also have "... = MkArr (Dom a') (Cod a)
                                (B.can (Cod a) (E.Trg (Cod a) \<^bold>\<star> Cod a) \<cdot>\<^sub>B
                                  (trg\<^sub>B \<lbrace>Cod a\<rbrace> \<star>\<^sub>B Map g) \<cdot>\<^sub>B
                                  B.can (E.Trg (Cod a) \<^bold>\<star> Dom a') (Dom a'))"
         proof -
           have "E.Trg (Cod a) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom a' = Dom a'"
             using a a' arr_char E.HcompNml_Trg_Nml
             by (metis (no_types, lifting) f ideE trg_simps(1) vconn_implies_hpar(4))
           moreover have "E.Trg (Cod a) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod a = Cod a"
             using a a' arr_char E.HcompNml_Trg_Nml by blast
           moreover have "\<lbrace>E.Trg (Cod a)\<rbrace> = trg\<^sub>B \<lbrace>Cod a\<rbrace>"
             using a a' arr_char E.eval_simps'(3) by fastforce
           ultimately show ?thesis by simp
         qed
         also have "... = MkArr (Dom a') (Cod a)
                            (B.lunit \<lbrace>Cod a\<rbrace> \<cdot>\<^sub>B (trg\<^sub>B \<lbrace>Cod a\<rbrace> \<star>\<^sub>B Map g) \<cdot>\<^sub>B B.lunit' \<lbrace>Dom a'\<rbrace>)"
         proof -
           have "E.Trg (Cod a) = E.Trg (Dom a')"
             using a a' a_eq g ide_char arr_char src_def trg_def trg_hcomp
                   \<open>Cod g = Dom a\<close> \<open>Dom g = Dom a'\<close>
             by (metis (no_types, lifting) Cod.simps(1) in_homE)
           moreover have "B.can (Cod a) (E.Trg (Cod a) \<^bold>\<star> Cod a) = B.lunit \<lbrace>Cod a\<rbrace>"
             using a ide_char arr_char B.canE_unitor(2) by blast
           moreover have "B.can (E.Trg (Dom a') \<^bold>\<star> Dom a') (Dom a') = B.lunit' \<lbrace>Dom a'\<rbrace>"
             using a' ide_char arr_char B.canE_unitor(4) by blast
           ultimately show ?thesis by simp
         qed
         also have "... = MkArr (Dom g) (Cod g) (Map g)"
         proof -
           have "src\<^sub>B \<lbrace>Cod a\<rbrace> = src\<^sub>B (Map g)"
             using a f g ide_char arr_char src_def B.comp_cod_arr
             by (metis (no_types, lifting) B.vconn_implies_hpar(1) B.vconn_implies_hpar(3)
                 Cod.simps(1) Map.simps(1) in_homE)
           moreover have
             "B.lunit \<lbrace>Cod g\<rbrace> \<cdot>\<^sub>B (trg\<^sub>B (Map g) \<star>\<^sub>B Map g) \<cdot>\<^sub>B B.lunit' \<lbrace>Dom g\<rbrace> = Map g"
           proof -
             have "B.lunit \<lbrace>Cod g\<rbrace> \<cdot>\<^sub>B (trg\<^sub>B (Map g) \<star>\<^sub>B Map g) \<cdot>\<^sub>B B.lunit' \<lbrace>Dom g\<rbrace> =
                   B.lunit \<lbrace>Cod g\<rbrace> \<cdot>\<^sub>B B.lunit' \<lbrace>Cod g\<rbrace> \<cdot>\<^sub>B Map g"
               using g ide_char arr_char B.lunit'_naturality
               by (metis (no_types, lifting) partial_magma_axioms B.in_homE partial_magma.arrI)
             also have "... = (B.lunit \<lbrace>Cod g\<rbrace> \<cdot>\<^sub>B B.lunit' \<lbrace>Cod g\<rbrace>) \<cdot>\<^sub>B Map g"
               using B.comp_assoc by simp
             also have "... = Map g"
               using g arr_char E.ide_eval_Ide B.comp_arr_inv' B.comp_cod_arr by fastforce
             finally show ?thesis by simp
           qed
           ultimately have
             "B.lunit \<lbrace>Cod a\<rbrace> \<cdot>\<^sub>B (trg\<^sub>B \<lbrace>Cod a\<rbrace> \<star>\<^sub>B Map g) \<cdot>\<^sub>B B.lunit' \<lbrace>Dom a'\<rbrace> = Map g"
             using a a' 1 2 f g hcomp_def dom_char cod_char
             by (metis (no_types, lifting) B.comp_null(2) B.ext B.lunit_simps(2) B.lunit_simps(3)
                 B.src.preserves_reflects_arr B.trg_vcomp B.vseq_implies_hpar(1) ideE)
           thus ?thesis
             using a 1 2 by auto
         qed
         also have "... = g"
           using g MkArr_Map by blast
         finally show ?thesis by simp
       qed
       ultimately show "\<exists>f. in_hom f a' a \<and> H.L f = g"
         by blast
     qed
 
     interpretation R: full_functor vcomp vcomp H.R
     proof
       fix a a' g
       assume a: "ide a" and a': "ide a'"
       assume g: "in_hom g (H.R a') (H.R a)"
       have a_eq: "a = MkIde (Dom a)"
         using a dom_char [of a] by simp
       have a'_eq: "a' = MkIde (Dom a')"
         using a' dom_char [of a'] by simp
       have 1: "Cod g = Dom a"
       proof -
         have "Dom (H.R a) = Dom a"
         proof -
           have "Dom (H.R a) = Dom a \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> E.Src (Dom a)"
             using a src_def hcomp_def
             apply simp
             by (metis (no_types, lifting) ideE trg_src src.preserves_reflects_arr)
           also have "... = Dom a"
             using a arr_char E.Src_HcompNml
             by (metis (no_types, lifting) E.HcompNml_Nml_Src ideD(1))
           finally show ?thesis by simp
         qed
         thus ?thesis
           using g cod_char [of g]
           by (metis (no_types, lifting) Dom_cod in_homE)
       qed
       have 2: "Dom g = Dom a'"
       proof -
         have "Dom (H.R a') = Dom a'"
         proof -
           have "Dom (H.R a') = Dom a' \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> E.Src (Dom a')"
             using a' src_def hcomp_def
             apply simp
             by (metis (no_types, lifting) ideE trg_src src.preserves_reflects_arr)
           also have "... = Dom a'"
             using a' arr_char E.Src_HcompNml
             by (metis (no_types, lifting) E.HcompNml_Nml_Src ideD(1))
           finally show ?thesis by simp
         qed
         thus ?thesis
           using g dom_char [of g]
           by (metis (no_types, lifting) Dom_dom in_homE)
       qed
       let ?f = "MkArr (Dom a') (Cod a) (Map g)"
       have f: "in_hom ?f a' a"
       proof (intro in_homI)
         show 3: "arr (MkArr (Dom a') (Cod a) (Map g))"
         proof (intro arr_MkArr [of "Dom a'" "Cod a" "Map g"])
           show "Dom a' \<in> IDE"
             using a' ide_char arr_char by blast
           show "Cod a \<in> IDE"
             using a ide_char arr_char by blast
           show "Map g \<in> HOM (Dom a') (Cod a)"
           proof
             show "E.Src (Dom a') = E.Src (Cod a) \<and> E.Trg (Dom a') = E.Trg (Cod a) \<and>
                   \<guillemotleft>Map g : \<lbrace>Dom a'\<rbrace> \<Rightarrow>\<^sub>B \<lbrace>Cod a\<rbrace>\<guillemotright>"
               using a a' a_eq g 1 2 ide_char arr_char src_def trg_def trg_hcomp
               by (metis (no_types, lifting) Cod.simps(1) in_homE)
           qed
         qed
         show "dom (MkArr (Dom a') (Cod a) (Map g)) = a'"
           using a a' 3 dom_char by auto
         show "cod (MkArr (Dom a') (Cod a) (Map g)) = a"
           using a a' 3 cod_char by auto
       qed
       moreover have "H.R ?f = g"
       proof -
         have "H.R ?f =
                MkArr (Dom a') (Cod a) (Map g) \<star> src (MkArr (Dom a') (Cod a) (Map g))"
           using f by auto
         also have "... = MkArr (Dom a') (Cod a) (Map g) \<star> MkIde (E.Src (Cod a))"
           using a a' f src_def [of a] vconn_implies_hpar by auto
         also have "... = MkArr (Dom a' \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> E.Src (Cod a)) (Cod a \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> E.Src (Cod a))
                                (B.can (Cod a \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> E.Src (Cod a)) (Cod a \<^bold>\<star> E.Src (Cod a)) \<cdot>\<^sub>B
                                  (Map g \<star>\<^sub>B \<lbrace>E.Src (Cod a)\<rbrace>) \<cdot>\<^sub>B
                                  B.can (Dom a' \<^bold>\<star> E.Src (Cod a)) (Dom a' \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> E.Src (Cod a)))"
           using hcomp_def
           apply simp
           by (metis (no_types, lifting) Cod_cod arrE f in_homE trg_src src.preserves_arr src_def)
         also have "... = MkArr (Dom a') (Cod a)
                                (B.can (Cod a) (Cod a \<^bold>\<star> E.Src (Cod a)) \<cdot>\<^sub>B
                                  (Map g \<star>\<^sub>B src\<^sub>B \<lbrace>Cod a\<rbrace>) \<cdot>\<^sub>B
                                  B.can (Dom a' \<^bold>\<star> E.Src (Cod a)) (Dom a'))"
         proof -
           have "Dom a' \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> E.Src (Cod a) = Dom a'"
             using a a' arr_char E.HcompNml_Nml_Src
             by (metis (no_types, lifting) f ideE src_simps(1) vconn_implies_hpar(3))
           moreover have "Cod a \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> E.Src (Cod a) = Cod a"
             using a a' arr_char E.HcompNml_Nml_Src by blast
           moreover have "\<lbrace>E.Src (Cod a)\<rbrace> = src\<^sub>B \<lbrace>Cod a\<rbrace>"
             using a a' arr_char E.eval_simps'(2) by fastforce
           ultimately show ?thesis by simp
         qed
         also have "... = MkArr (Dom a') (Cod a)
                                (B.runit \<lbrace>Cod a\<rbrace> \<cdot>\<^sub>B (Map g \<star>\<^sub>B src\<^sub>B \<lbrace>Cod a\<rbrace>) \<cdot>\<^sub>B B.runit' \<lbrace>Dom a'\<rbrace>)"
         proof -
           have "E.Src (Cod a) = E.Src (Dom a')"
             using a a' g ide_char arr_char src_def trg_def src_hcomp
             by (metis (no_types, lifting) Cod_dom f ideE in_homE src_cod src_simps(1))
           moreover have "B.can (Cod a) (Cod a \<^bold>\<star> E.Src (Cod a)) = B.runit \<lbrace>Cod a\<rbrace>"
             using a ide_char arr_char B.canE_unitor(1) by blast
           moreover have "B.can (Dom a' \<^bold>\<star> E.Src (Dom a')) (Dom a') = B.runit' \<lbrace>Dom a'\<rbrace>"
             using a' ide_char arr_char B.canE_unitor(3) by blast
           ultimately show ?thesis by simp
         qed
         also have "... = MkArr (Dom g) (Cod g) (Map g)"
         proof -
           have "src\<^sub>B \<lbrace>Cod a\<rbrace> = src\<^sub>B (Map g)"
             using a f g ide_char arr_char src_def B.comp_cod_arr
             by (metis (no_types, lifting) B.vconn_implies_hpar(1) B.vconn_implies_hpar(3)
                 Cod.simps(1) Map.simps(1) in_homE)
           moreover have
             "B.runit \<lbrace>Cod g\<rbrace> \<cdot>\<^sub>B (Map g \<star>\<^sub>B src\<^sub>B (Map g)) \<cdot>\<^sub>B B.runit' \<lbrace>Dom g\<rbrace> = Map g"
           proof -
             have "B.runit \<lbrace>Cod g\<rbrace> \<cdot>\<^sub>B (Map g \<star>\<^sub>B src\<^sub>B (Map g)) \<cdot>\<^sub>B B.runit' \<lbrace>Dom g\<rbrace> =
                   B.runit \<lbrace>Cod g\<rbrace> \<cdot>\<^sub>B B.runit'\<lbrace>Cod g\<rbrace> \<cdot>\<^sub>B Map g"
               using g ide_char arr_char B.runit'_naturality [of "Map g"]
               by (metis (no_types, lifting) partial_magma_axioms B.in_homE partial_magma.arrI)
             also have "... = (B.runit \<lbrace>Cod g\<rbrace> \<cdot>\<^sub>B B.runit' \<lbrace>Cod g\<rbrace>) \<cdot>\<^sub>B Map g"
               using B.comp_assoc by simp
             also have "... = Map g"
               using g arr_char E.ide_eval_Ide B.comp_arr_inv' B.comp_cod_arr by fastforce
             finally show ?thesis by simp
           qed
           ultimately have
             "B.runit \<lbrace>Cod a\<rbrace> \<cdot>\<^sub>B (Map g \<star>\<^sub>B src\<^sub>B \<lbrace>Cod a\<rbrace>) \<cdot>\<^sub>B B.runit' \<lbrace>Dom a'\<rbrace> = Map g"
             using a a' 1 2 f g hcomp_def dom_char cod_char
             by (metis (no_types, lifting) ideE)
           thus ?thesis
             using a 1 2 by auto
         qed
         also have "... = g"
            using g MkArr_Map by blast
         finally show ?thesis by simp
       qed
       ultimately show "\<exists>f. in_hom f a' a \<and> H.R f = g"
         by blast
     qed
 
     interpretation L: faithful_functor vcomp vcomp H.L
     proof
       fix f f'
       assume par: "par f f'" and eq: "H.L f = H.L f'"
       show "f = f'"
       proof (intro arr_eqI)
         have 1: "Dom f = Dom f' \<and> Cod f = Cod f'"
           using par dom_char cod_char by auto
         show "arr f"
           using par by simp
         show "arr f'"
           using par by simp
         show 2: "Dom f = Dom f'" and 3: "Cod f = Cod f'"
           using 1 by auto
         show "Map f = Map f'"
         proof -
           have "B.L (Map f) = trg\<^sub>B (Map f) \<star>\<^sub>B Map f"
             using par by auto
           also have "... = trg\<^sub>B (Map f') \<star>\<^sub>B Map f'"
           proof -
             have "\<lbrace>E.Trg (Dom f)\<rbrace> \<star>\<^sub>B Map f = \<lbrace>E.Trg (Dom f')\<rbrace> \<star>\<^sub>B Map f'"
             proof -
               have A: "\<guillemotleft>B.can (E.Trg (Dom f) \<^bold>\<star> Dom f) (E.Trg (Dom f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom f) :
                           \<lbrace>E.Trg (Dom f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom f\<rbrace> \<Rightarrow>\<^sub>B \<lbrace>E.Trg (Dom f)\<rbrace> \<star>\<^sub>B \<lbrace>Dom f\<rbrace>\<guillemotright>"
                 using par arr_char B.can_in_hom E.Ide_HcompNml
                       E.Ide_Nmlize_Ide E.Nml_Trg E.Nmlize_Nml E.HcompNml_Trg_Nml
                       src_def trg_def
                 by (metis (no_types, lifting) E.eval_simps(3) E.ide_eval_Ide E.Ide_implies_Arr
                     B.canE_unitor(4) B.lunit'_in_vhom)
               have B: "\<guillemotleft>B.can (E.Trg (Dom f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod f) (E.Trg (Dom f) \<^bold>\<star> Cod f) :
                           \<lbrace>E.Trg (Dom f)\<rbrace> \<star>\<^sub>B \<lbrace>Cod f\<rbrace> \<Rightarrow>\<^sub>B \<lbrace>E.Trg (Dom f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod f\<rbrace>\<guillemotright>"
                 using par arr_char B.can_in_hom E.Ide_HcompNml
                       E.Ide_Nmlize_Ide E.Nml_Trg E.Nmlize_Nml E.HcompNml_Trg_Nml
                       src_def trg_def
                 by (metis (no_types, lifting) E.Nmlize.simps(3) E.eval.simps(3) E.Ide.simps(3)
                     E.Ide_implies_Arr E.Src_Trg trg.preserves_arr trg_simps(2))
               have C: "\<guillemotleft>\<lbrace>E.Trg (Dom f)\<rbrace> \<star>\<^sub>B Map f :
                           \<lbrace>E.Trg (Dom f)\<rbrace> \<star>\<^sub>B \<lbrace>Dom f\<rbrace> \<Rightarrow>\<^sub>B \<lbrace>E.Trg (Dom f)\<rbrace> \<star>\<^sub>B \<lbrace>Cod f\<rbrace>\<guillemotright>"
                 using par arr_char
                 by (metis (no_types, lifting) E.eval_simps'(1) E.eval_simps(3) E.ide_eval_Ide
                     E.Ide_implies_Arr E.Obj_Trg E.Obj_implies_Ide B.hcomp_in_vhom
                     B.ide_in_hom(2) B.src_trg)
               have 3: "(\<lbrace>E.Trg (Dom f)\<rbrace> \<star>\<^sub>B Map f) \<cdot>\<^sub>B
                           B.can (E.Trg (Dom f) \<^bold>\<star> Dom f) (E.Trg (Dom f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom f) =
                         (\<lbrace>E.Trg (Dom f')\<rbrace> \<star>\<^sub>B Map f') \<cdot>\<^sub>B
                             B.can (E.Trg (Dom f') \<^bold>\<star> Dom f') (E.Trg (Dom f') \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom f')"
               proof -
                 have 2: "B.can (E.Trg (Dom f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod f) (E.Trg (Dom f) \<^bold>\<star> Cod f) \<cdot>\<^sub>B
                           (\<lbrace>E.Trg (Dom f)\<rbrace> \<star>\<^sub>B Map f) \<cdot>\<^sub>B
                             B.can (E.Trg (Dom f) \<^bold>\<star> Dom f) (E.Trg (Dom f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom f) =
                          B.can (E.Trg (Dom f') \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod f') (E.Trg (Dom f') \<^bold>\<star> Cod f') \<cdot>\<^sub>B
                            (\<lbrace>E.Trg (Dom f')\<rbrace> \<star>\<^sub>B Map f') \<cdot>\<^sub>B
                              B.can (E.Trg (Dom f') \<^bold>\<star> Dom f') (E.Trg (Dom f') \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom f')"
                   using par eq hcomp_def trg_def src_trg trg.preserves_arr Map_hcomp
                         trg_simps(1) trg_simps(2) trg_simps(3)
                   by auto
                 have "B.mono (B.can (E.Trg (Dom f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod f) (E.Trg (Dom f) \<^bold>\<star> Cod f))"
                   using par arr_char B.inverse_arrows_can B.iso_is_section B.section_is_mono
                         src_def trg_def E.Nmlize_Nml E.HcompNml_Trg_Nml E.Ide_implies_Arr
                         trg.preserves_arr trg_simps(1)
                   by auto
                 moreover have
                   "B.seq (B.can (E.Trg (Dom f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod f) (E.Trg (Dom f) \<^bold>\<star> Cod f))
                      ((\<lbrace>E.Trg (Dom f)\<rbrace> \<star>\<^sub>B Map f) \<cdot>\<^sub>B
                        B.can (E.Trg (Dom f) \<^bold>\<star> Dom f) (E.Trg (Dom f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom f))"
                   using A B C by auto
                 moreover have
                   "B.seq (B.can (E.Trg (Dom f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod f) (E.Trg (Dom f) \<^bold>\<star> Cod f))
                      ((\<lbrace>E.Trg (Dom f')\<rbrace> \<star>\<^sub>B Map f') \<cdot>\<^sub>B
                        B.can (E.Trg (Dom f') \<^bold>\<star> Dom f') (E.Trg (Dom f') \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom f'))"
                   using par 1 2 arr_char calculation(2) by auto
                 moreover have "B.can (E.Trg (Dom f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod f) (E.Trg (Dom f) \<^bold>\<star> Cod f) =
                                B.can (E.Trg (Dom f') \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod f') (E.Trg (Dom f') \<^bold>\<star> Cod f')"
                   using par 1 arr_char by simp
                 ultimately show ?thesis
                   using 2 B.monoE cod_char by auto
               qed
               show ?thesis
               proof -
                 have "B.epi (B.can (E.Trg (Dom f) \<^bold>\<star> Dom f) (E.Trg (Dom f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom f))"
                   using par arr_char B.inverse_arrows_can B.iso_is_retraction
                         B.retraction_is_epi E.Nmlize_Nml E.HcompNml_Trg_Nml src_def trg_def
                         E.Ide_implies_Arr
                   by (metis (no_types, lifting) E.Nmlize.simps(3) E.Ide.simps(3) E.Src_Trg
                       trg.preserves_arr trg_simps(1))
                 moreover have "B.seq (\<lbrace>E.Trg (Dom f)\<rbrace> \<star>\<^sub>B Map f)
                                      (B.can (E.Trg (Dom f) \<^bold>\<star> Dom f) (E.Trg (Dom f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom f))"
                   using A C by auto
                 moreover have "B.seq (\<lbrace>E.Trg (Dom f')\<rbrace> \<star>\<^sub>B Map f')
                                      (B.can (E.Trg (Dom f) \<^bold>\<star> Dom f) (E.Trg (Dom f) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom f))"
                   using 1 3 calculation(2) by auto
                 ultimately show ?thesis
                   using par 1 3 arr_char B.epiE by simp
               qed
             qed
             moreover have "trg\<^sub>B (Map f) = \<lbrace>E.Trg (Dom f)\<rbrace> \<and>
                            trg\<^sub>B (Map f') = \<lbrace>E.Trg (Dom f')\<rbrace>"
               using par arr_char trg_def E.Ide_implies_Arr B.comp_arr_dom
                     B.vseq_implies_hpar(2) E.eval_simps(3)
               by (metis (no_types, lifting) B.vconn_implies_hpar(2))
             ultimately show ?thesis by simp
           qed
           also have "... = B.L (Map f')"
             using par B.hseqE B.hseq_char' by auto
           finally have "B.L (Map f) = B.L (Map f')"
             by simp
           thus ?thesis
             using 2 3 par arr_char B.L.is_faithful
             by (metis (no_types, lifting) B.in_homE)
         qed
       qed
     qed
 
     interpretation R: faithful_functor vcomp vcomp H.R
     proof
       fix f f'
       assume par: "par f f'" and eq: "H.R f = H.R f'"
       show "f = f'"
       proof (intro arr_eqI)
         have 1: "Dom f = Dom f' \<and> Cod f = Cod f'"
           using par dom_char cod_char by auto
         show "arr f"
           using par by simp
         show "arr f'"
           using par by simp
         show 2: "Dom f = Dom f'" and 3: "Cod f = Cod f'"
           using 1 by auto
         show "Map f = Map f'"
         proof -
           have "B.R (Map f) = Map f \<star>\<^sub>B src\<^sub>B (Map f)"
             using par apply simp by (metis B.hseqE B.hseq_char')
           also have "... = Map f' \<star>\<^sub>B src\<^sub>B (Map f')"
           proof -
             have "Map f \<star>\<^sub>B \<lbrace>E.Src (Dom f)\<rbrace> = Map f' \<star>\<^sub>B \<lbrace>E.Src (Dom f')\<rbrace>"
             proof -
               have 2: "E.Ide (Cod f \<^bold>\<star> E.Src (Dom f))"
                 using par arr_char src.preserves_arr by auto
               hence 3: "E.Ide (Cod f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> E.Src (Dom f))"
                 using par arr_char E.Nml_Src E.Ide_HcompNml calculation by auto
               have 4: "\<^bold>\<lfloor>Cod f \<^bold>\<star> E.Src (Dom f)\<^bold>\<rfloor> = \<^bold>\<lfloor>Cod f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> E.Src (Dom f)\<^bold>\<rfloor>"
                 using par arr_char by (simp add: E.Nml_HcompNml(1))
               have A: "\<guillemotleft>B.can (Dom f \<^bold>\<star> E.Src (Dom f)) (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> E.Src (Dom f)) :
                           \<lbrace>Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> E.Src (Dom f)\<rbrace> \<Rightarrow>\<^sub>B \<lbrace>Dom f\<rbrace> \<star>\<^sub>B \<lbrace>E.Src (Dom f)\<rbrace>\<guillemotright>"
                 using par arr_char B.can_in_hom E.Ide_HcompNml
                       E.Ide_Nmlize_Ide E.Nml_Src E.Nmlize_Nml E.HcompNml_Nml_Src
                       src_def trg_def
                 by (metis (no_types, lifting) E.eval_simps(2) E.ide_eval_Ide E.Ide_implies_Arr
                     B.canE_unitor(3) B.runit'_in_vhom)
               have B: "\<guillemotleft>B.can (Cod f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> E.Src (Dom f)) (Cod f \<^bold>\<star> E.Src (Dom f)) :
                           \<lbrace>Cod f\<rbrace> \<star>\<^sub>B \<lbrace>E.Src (Dom f)\<rbrace> \<Rightarrow>\<^sub>B \<lbrace>Cod f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> E.Src (Dom f)\<rbrace>\<guillemotright>"
                 using 2 3 4 B.can_in_hom [of "Cod f \<^bold>\<star> E.Src (Dom f)" "Cod f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> E.Src (Dom f)"]
                 by simp
               have C: "\<guillemotleft>Map f \<star>\<^sub>B \<lbrace>E.Src (Dom f)\<rbrace> :
                          \<lbrace>Dom f\<rbrace> \<star>\<^sub>B \<lbrace>E.Src (Dom f)\<rbrace> \<Rightarrow>\<^sub>B \<lbrace>Cod f\<rbrace> \<star>\<^sub>B \<lbrace>E.Src (Dom f)\<rbrace>\<guillemotright>"
                 using par arr_char E.Ide_Nmlize_Ide E.Nml_Trg E.Nmlize_Nml E.HcompNml_Trg_Nml
                       src_def trg_def E.ide_eval_Ide E.Ide_implies_Arr E.Obj_implies_Ide
                 apply (intro B.hcomp_in_vhom)
                   apply (simp add: B.ide_in_hom(2))
                  apply simp
                 by (metis (no_types, lifting) A B.ideD(1) B.not_arr_null B.seq_if_composable
                     B.src.preserves_reflects_arr B.vconn_implies_hpar(3) E.HcompNml_Nml_Src)
               have 5: "(Map f \<star>\<^sub>B \<lbrace>E.Src (Dom f)\<rbrace>) \<cdot>\<^sub>B
                           B.can (Dom f \<^bold>\<star> E.Src (Dom f)) (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> E.Src (Dom f)) =
                         (Map f' \<star>\<^sub>B \<lbrace>E.Src (Dom f')\<rbrace>) \<cdot>\<^sub>B
                             B.can (Dom f' \<^bold>\<star> E.Src (Dom f')) (Dom f' \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> E.Src (Dom f'))"
               proof -
                 have 6: "B.can (Cod f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> E.Src (Dom f)) (Cod f \<^bold>\<star> E.Src (Dom f)) \<cdot>\<^sub>B
                            (Map f \<star>\<^sub>B \<lbrace>E.Src (Dom f)\<rbrace>) \<cdot>\<^sub>B
                              B.can (Dom f \<^bold>\<star> E.Src (Dom f)) (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> E.Src (Dom f)) =
                          B.can (Cod f' \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> E.Src (Dom f')) (Cod f' \<^bold>\<star> E.Src (Dom f')) \<cdot>\<^sub>B
                            (Map f' \<star>\<^sub>B \<lbrace>E.Src (Dom f')\<rbrace>) \<cdot>\<^sub>B
                              B.can (Dom f' \<^bold>\<star> E.Src (Dom f')) (Dom f' \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> E.Src (Dom f'))"
                   using par eq hcomp_def src_def trg_src src.preserves_arr Map_hcomp
                         src_simps(1) src_simps(2) src_simps(3)
                   by auto
                 have "B.mono (B.can (Cod f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> E.Src (Dom f)) (Cod f \<^bold>\<star> E.Src (Dom f)))"
                   using 2 3 4 B.inverse_arrows_can(1) B.iso_is_section B.section_is_mono
                   by simp
                 moreover have
                   "B.seq (B.can (Cod f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> E.Src (Dom f)) (Cod f \<^bold>\<star> E.Src (Dom f)))
                      ((Map f \<star>\<^sub>B \<lbrace>E.Src (Dom f)\<rbrace>) \<cdot>\<^sub>B
                        B.can (Dom f \<^bold>\<star> E.Src (Dom f)) (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> E.Src (Dom f)))"
                   using A B C by auto
                 moreover have
                   "B.seq (B.can (Cod f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> E.Src (Dom f)) (Cod f \<^bold>\<star> E.Src (Dom f)))
                      ((Map f' \<star>\<^sub>B \<lbrace>E.Src (Dom f')\<rbrace>) \<cdot>\<^sub>B
                        B.can (Dom f' \<^bold>\<star> E.Src (Dom f')) (Dom f' \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> E.Src (Dom f')))"
                   using par 1 6 arr_char calculation(2) by auto
                 moreover have "B.can (Cod f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> E.Src (Dom f)) (Cod f \<^bold>\<star> E.Src (Dom f)) =
                                B.can (Cod f' \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> E.Src (Dom f')) (Cod f' \<^bold>\<star> E.Src (Dom f'))"
                   using par 1 arr_char by simp
                 ultimately show ?thesis
                   using 6 B.monoE cod_char by auto
               qed
               show ?thesis
               proof -
                 have "B.epi (B.can (Dom f \<^bold>\<star> E.Src (Dom f)) (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> E.Src (Dom f)))"
                   using 2 3 4 B.inverse_arrows_can(1) B.iso_is_retraction B.retraction_is_epi
                   by (metis (no_types, lifting) E.Nml_Src E.Nmlize.simps(3) E.Nmlize_Nml
                       E.HcompNml_Nml_Src E.Ide.simps(3) par arrE)
                 moreover have "B.seq (Map f \<star>\<^sub>B \<lbrace>E.Src (Dom f)\<rbrace>)
                                    (B.can (Dom f \<^bold>\<star> E.Src (Dom f)) (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> E.Src (Dom f)))"
                   using A C by auto
                 moreover have "B.seq (Map f' \<star>\<^sub>B \<lbrace>E.Src (Dom f')\<rbrace>)
                                    (B.can (Dom f \<^bold>\<star> E.Src (Dom f)) (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> E.Src (Dom f)))"
                   using 1 5 calculation(2) by auto
                 ultimately show ?thesis
                   using par 1 5 arr_char B.epiE by simp
               qed
             qed
             moreover have "src\<^sub>B (Map f) = \<lbrace>E.Src (Dom f)\<rbrace> \<and>
                            src\<^sub>B (Map f') = \<lbrace>E.Src (Dom f')\<rbrace>"
               using par arr_char src_def
               by (metis (no_types, lifting) B.vconn_implies_hpar(1) E.Nml_implies_Arr
                   E.eval_simps(2))
             ultimately show ?thesis by simp
           qed
           also have "... = B.R (Map f')"
             using par B.hseqE B.hseq_char' by auto
           finally have "B.R (Map f) = B.R (Map f')"
             by simp
           thus ?thesis
             using 2 3 par arr_char B.R.is_faithful
             by (metis (no_types, lifting) B.in_homE)
         qed
       qed
     qed
 
     interpretation VxVxV: product_category vcomp VxV.comp ..
     interpretation VVV: subcategory VxVxV.comp
                  \<open>\<lambda>\<tau>\<mu>\<nu>. arr (fst \<tau>\<mu>\<nu>) \<and> VV.arr (snd \<tau>\<mu>\<nu>) \<and> src (fst \<tau>\<mu>\<nu>) = trg (fst (snd \<tau>\<mu>\<nu>))\<close>
       using subcategory_VVV by auto
 
     interpretation HoHV: "functor" VVV.comp vcomp H.HoHV
       using H.functor_HoHV by auto
     interpretation HoVH: "functor" VVV.comp vcomp H.HoVH
       using H.functor_HoVH by auto
 
     definition \<a>
     where "\<a> \<tau> \<mu> \<nu> \<equiv> if VVV.arr (\<tau>, \<mu>, \<nu>) then hcomp \<tau> (hcomp \<mu> \<nu>) else null"
 
     interpretation natural_isomorphism VVV.comp vcomp H.HoHV H.HoVH
                      \<open>\<lambda>\<tau>\<mu>\<nu>. \<a> (fst \<tau>\<mu>\<nu>) (fst (snd \<tau>\<mu>\<nu>)) (snd (snd \<tau>\<mu>\<nu>))\<close>
     proof
       show "\<And>\<tau>\<mu>\<nu>. \<not> VVV.arr \<tau>\<mu>\<nu> \<Longrightarrow> \<a> (fst \<tau>\<mu>\<nu>) (fst (snd \<tau>\<mu>\<nu>)) (snd (snd \<tau>\<mu>\<nu>)) = null"
         using \<a>_def by simp
       show "\<And>\<tau>\<mu>\<nu>. VVV.arr \<tau>\<mu>\<nu> \<Longrightarrow>
                   dom (\<a> (fst \<tau>\<mu>\<nu>) (fst (snd \<tau>\<mu>\<nu>)) (snd (snd \<tau>\<mu>\<nu>))) = H.HoHV (VVV.dom \<tau>\<mu>\<nu>)"
         using VVV.arr_char VV.arr_char \<a>_def hcomp_assoc H.HoHV_def by force
       show 1: "\<And>\<tau>\<mu>\<nu>. VVV.arr \<tau>\<mu>\<nu> \<Longrightarrow>
                      cod (\<a> (fst \<tau>\<mu>\<nu>) (fst (snd \<tau>\<mu>\<nu>)) (snd (snd \<tau>\<mu>\<nu>))) = H.HoVH (VVV.cod \<tau>\<mu>\<nu>)"
         using VVV.arr_char VV.arr_char \<a>_def H.HoVH_def by force
       show "\<And>\<tau>\<mu>\<nu>. VVV.arr \<tau>\<mu>\<nu> \<Longrightarrow>
                   H.HoVH \<tau>\<mu>\<nu> \<cdot>
                     \<a> (fst (VVV.dom \<tau>\<mu>\<nu>)) (fst (snd (VVV.dom \<tau>\<mu>\<nu>)))
                       (snd (snd (VVV.dom \<tau>\<mu>\<nu>))) =
                   \<a> (fst \<tau>\<mu>\<nu>) (fst (snd \<tau>\<mu>\<nu>)) (snd (snd \<tau>\<mu>\<nu>))"
         using \<a>_def HoVH.is_natural_1 H.HoVH_def by auto
       show "\<And>\<tau>\<mu>\<nu>. VVV.arr \<tau>\<mu>\<nu> \<Longrightarrow>
                    \<a> (fst (VVV.cod \<tau>\<mu>\<nu>)) (fst (snd (VVV.cod \<tau>\<mu>\<nu>)))
                      (snd (snd (VVV.cod \<tau>\<mu>\<nu>))) \<cdot> H.HoHV \<tau>\<mu>\<nu> =
                    \<a> (fst \<tau>\<mu>\<nu>) (fst (snd \<tau>\<mu>\<nu>)) (snd (snd \<tau>\<mu>\<nu>))"
       proof -
         fix \<tau>\<mu>\<nu>
         assume \<tau>\<mu>\<nu>: "VVV.arr \<tau>\<mu>\<nu>"
         have "H.HoHV \<tau>\<mu>\<nu> = \<a> (fst \<tau>\<mu>\<nu>) (fst (snd \<tau>\<mu>\<nu>)) (snd (snd \<tau>\<mu>\<nu>))"
           unfolding \<a>_def H.HoHV_def
           using \<tau>\<mu>\<nu> HoHV.preserves_cod hcomp_assoc VVV.arr_char VV.arr_char
           by simp
         thus "\<a> (fst (VVV.cod \<tau>\<mu>\<nu>)) (fst (snd (VVV.cod \<tau>\<mu>\<nu>))) (snd (snd (VVV.cod \<tau>\<mu>\<nu>))) \<cdot>
                 H.HoHV \<tau>\<mu>\<nu> =
               \<a> (fst \<tau>\<mu>\<nu>) (fst (snd \<tau>\<mu>\<nu>)) (snd (snd \<tau>\<mu>\<nu>))"
           using 1 \<tau>\<mu>\<nu> comp_cod_arr \<a>_def
           by (metis (no_types, lifting) H.HoVH_def HoHV.preserves_arr prod.collapse)
       qed
       show "\<And>fgh. VVV.ide fgh \<Longrightarrow> iso (\<a> (fst fgh) (fst (snd fgh)) (snd (snd fgh)))"
         using \<a>_def HoVH.preserves_ide H.HoVH_def by auto
     qed
 
     definition \<i>
     where "\<i> \<equiv> \<lambda>a. a"
 
     sublocale bicategory vcomp hcomp \<a> \<i> src trg
       using hcomp_obj_self \<a>_def hcomp_assoc VVV.arr_char VV.arr_char
       apply unfold_locales
       by (auto simp add: \<i>_def ide_in_hom(2))
 
     lemma is_bicategory:
     shows "bicategory vcomp hcomp \<a> \<i> src trg"
       ..
 
     sublocale strict_bicategory vcomp hcomp \<a> \<i> src trg
     proof
       show "\<And>fgh. ide fgh \<Longrightarrow> lunit fgh = fgh"
       proof -
         fix fgh
         assume fgh: "ide fgh"
         have "fgh = lunit fgh"
         proof (intro lunit_eqI)
           show "ide fgh" using fgh by simp
           show "\<guillemotleft>fgh : trg fgh \<star> fgh \<Rightarrow> fgh\<guillemotright>"
             using fgh hcomp_def hcomp_trg_ide by auto
           show "trg fgh \<star> fgh = (\<i> (trg fgh) \<star> fgh) \<cdot> \<a>' (trg fgh) (trg fgh) fgh"
           proof -
             have "(\<i> (trg fgh) \<star> fgh) \<cdot> \<a>' (trg fgh) (trg fgh) fgh =
                   (trg fgh \<star> fgh) \<cdot> \<a>' (trg fgh) (trg fgh) fgh"
               using fgh \<i>_def by metis
             also have "... = (trg fgh \<star> fgh) \<cdot> (trg fgh \<star> trg fgh \<star> fgh)"
               using fgh \<a>_def by fastforce
             also have "... = trg fgh \<star> fgh"
               using fgh hcomp_obj_self hcomp_assoc
               by (simp add: hcomp_trg_ide)
             finally show ?thesis by simp
           qed
         qed
         thus "lunit fgh = fgh" by simp
       qed
       show "\<And>fgh. ide fgh \<Longrightarrow> runit fgh = fgh"
       proof -
         fix fgh
         assume fgh: "ide fgh"
         have "fgh = runit fgh"
         proof (intro runit_eqI)
           show "ide fgh" using fgh by simp
           show "\<guillemotleft>fgh : fgh \<star> src fgh \<Rightarrow> fgh\<guillemotright>"
             using fgh hcomp_def hcomp_ide_src by auto
           show "fgh \<star> src fgh = (fgh \<star> \<i> (src fgh)) \<cdot> \<a> fgh (src fgh) (src fgh)"
           proof -
             have "(fgh \<star> \<i> (src fgh)) \<cdot> \<a> fgh (src fgh) (src fgh) =
                   (fgh \<star> src fgh) \<cdot> \<a> fgh (src fgh) (src fgh)"
               using fgh \<i>_def by metis
             also have "... = (fgh \<star> src fgh) \<cdot> (fgh \<star> src fgh \<star> src fgh)"
               using fgh \<a>_def by fastforce
             also have "... = fgh \<star> src fgh"
               using fgh comp_arr_dom hcomp_obj_self by simp
             finally show ?thesis by simp
           qed
         qed
         thus "runit fgh = fgh" by simp
       qed
       show "\<And>f g h. \<lbrakk> ide f; ide g; ide h; src f = trg g; src g = trg h \<rbrakk> \<Longrightarrow> ide (\<a> f g h)"
         using \<a>_def VV.arr_char VVV.arr_char by auto
     qed
 
     theorem is_strict_bicategory:
     shows "strict_bicategory vcomp hcomp \<a> \<i> src trg"
       ..
 
     subsection "The Strictness Theorem"
 
     text \<open>
       The Strictness Theorem asserts: ``Every bicategory is biequivalent to a strict bicategory.''
       This amounts to an equivalent (and perhaps more desirable) formulation of the
       Coherence Theorem.
       In this section we prove the Strictness Theorem by constructing an equivalence pseudofunctor
       from a bicategory to its strictification.
     \<close>
 
     lemma iso_char:
     shows "iso \<mu> \<longleftrightarrow> arr \<mu> \<and> B.iso (Map \<mu>)"
     and "iso \<mu> \<Longrightarrow> inv \<mu> = MkArr (Cod \<mu>) (Dom \<mu>) (B.inv (Map \<mu>))"
     proof -
       have 1: "iso \<mu> \<Longrightarrow> arr \<mu> \<and> B.iso (Map \<mu>)"
       proof -
         assume \<mu>: "iso \<mu>"
         obtain \<nu> where \<nu>: "inverse_arrows \<mu> \<nu>"
           using \<mu> by auto
         have "B.inverse_arrows (Map \<mu>) (Map \<nu>)"
         proof
           show "B.ide (Map \<mu> \<cdot>\<^sub>B Map \<nu>)"
           proof -
             have "Map \<mu> \<cdot>\<^sub>B Map \<nu> = Map (\<mu> \<cdot> \<nu>)"
               using \<mu> \<nu> inverse_arrows_def Map_comp arr_char seq_char
               by (metis (no_types, lifting) ide_compE)
             moreover have "B.ide ..."
               using \<nu> ide_char by blast
             ultimately show ?thesis by simp
           qed
           show "B.ide (Map \<nu> \<cdot>\<^sub>B Map \<mu>)"
           proof -
             have "Map \<nu> \<cdot>\<^sub>B Map \<mu> = Map (\<nu> \<cdot> \<mu>)"
               using \<mu> \<nu> inverse_arrows_def comp_char [of \<nu> \<mu>] by simp
             moreover have "B.ide ..."
               using \<nu> ide_char by blast
             ultimately show ?thesis by simp
           qed
         qed
         thus "arr \<mu> \<and> B.iso (Map \<mu>)"
           using \<mu> by auto
       qed
       let ?\<nu> = "MkArr (Cod \<mu>) (Dom \<mu>) (B.inv (Map \<mu>))"
       have 2: "arr \<mu> \<and> B.iso (Map \<mu>) \<Longrightarrow> iso \<mu> \<and> inv \<mu> = ?\<nu>"
       proof
         assume \<mu>: "arr \<mu> \<and> B.iso (Map \<mu>)"
         have \<nu>: "\<guillemotleft>?\<nu> : cod \<mu> \<Rightarrow> dom \<mu>\<guillemotright>"
           using \<mu> arr_char dom_char cod_char by auto
         have 4: "inverse_arrows \<mu> ?\<nu>"
         proof
           show "ide (?\<nu> \<cdot> \<mu>)"
           proof -
             have "?\<nu> \<cdot> \<mu> = dom \<mu>"
               using \<mu> \<nu> MkArr_Map comp_char seq_char B.comp_inv_arr' dom_char by auto
             thus ?thesis
               using \<mu> by simp
           qed
           show "ide (\<mu> \<cdot> ?\<nu>)"
           proof -
             have "\<mu> \<cdot> ?\<nu> = cod \<mu>"
               using \<mu> \<nu> MkArr_Map comp_char seq_char B.comp_arr_inv' cod_char by auto
             thus ?thesis
               using \<mu> by simp
           qed
         qed
         thus "iso \<mu>" by auto
         show "inv \<mu> = ?\<nu>"
           using 4 inverse_unique by simp
       qed
       have 3: "arr \<mu> \<and> B.iso (Map \<mu>) \<Longrightarrow> iso \<mu>"
         using 2 by simp
       show "iso \<mu> \<longleftrightarrow> arr \<mu> \<and> B.iso (Map \<mu>)"
         using 1 3 by blast
       show "iso \<mu> \<Longrightarrow> inv \<mu> = ?\<nu>"
         using 1 2 by blast
     qed
 
     text \<open>
       We next define a map \<open>UP\<close> from the given bicategory \<open>B\<close> to its strictification,
       and show that it is an equivalence pseudofunctor.
       The following auxiliary definition is not logically necessary, but it provides some
       terms that can be the targets of simplification rules and thereby enables some proofs
       to be done by simplification that otherwise could not be.  Trying to eliminate it
       breaks some short proofs below, so I have kept it.
     \<close>
 
     definition UP\<^sub>0
     where "UP\<^sub>0 a \<equiv> if B.obj a then MkIde \<^bold>\<langle>a\<^bold>\<rangle>\<^sub>0 else null"
 
     lemma obj_UP\<^sub>0 [simp]:
     assumes "B.obj a"
     shows "obj (UP\<^sub>0 a)"
       using assms UP\<^sub>0_def ide_MkIde [of "\<^bold>\<langle>a\<^bold>\<rangle>\<^sub>0"] src_def obj_def by simp
 
     lemma UP\<^sub>0_in_hom [intro]:
     assumes "B.obj a"
     shows "\<guillemotleft>UP\<^sub>0 a : UP\<^sub>0 a \<rightarrow> UP\<^sub>0 a\<guillemotright>"
     and "\<guillemotleft>UP\<^sub>0 a : UP\<^sub>0 a \<Rightarrow> UP\<^sub>0 a\<guillemotright>"
       using assms obj_UP\<^sub>0 by blast+
 
     lemma UP\<^sub>0_simps [simp]:
     assumes "B.obj a"
     shows "ide (UP\<^sub>0 a)" "arr (UP\<^sub>0 a)"
     and "src (UP\<^sub>0 a) = UP\<^sub>0 a" and "trg (UP\<^sub>0 a) = UP\<^sub>0 a"
     and "dom (UP\<^sub>0 a) = UP\<^sub>0 a" and "cod (UP\<^sub>0 a) = UP\<^sub>0 a"
       using assms obj_UP\<^sub>0
            apply blast
       using assms obj_UP\<^sub>0
           apply blast
-      using assms obj_UP\<^sub>0
+      using assms obj_UP\<^sub>0 obj_simps
          apply simp_all
       using ideD(2) obj_UP\<^sub>0
        apply blast
       using ideD(3) obj_UP\<^sub>0
       by blast
 
     definition UP
     where "UP \<mu> \<equiv> if B.arr \<mu> then MkArr \<^bold>\<langle>B.dom \<mu>\<^bold>\<rangle> \<^bold>\<langle>B.cod \<mu>\<^bold>\<rangle> \<mu> else null"
 
     lemma Dom_UP [simp]:
     assumes "B.arr \<mu>"
     shows "Dom (UP \<mu>) = \<^bold>\<langle>B.dom \<mu>\<^bold>\<rangle>"
       using assms UP_def by fastforce
 
     lemma Cod_UP [simp]:
     assumes "B.arr \<mu>"
     shows "Cod (UP \<mu>) = \<^bold>\<langle>B.cod \<mu>\<^bold>\<rangle>"
       using assms UP_def by fastforce
 
     lemma Map_UP [simp]:
     assumes "B.arr \<mu>"
     shows "Map (UP \<mu>) = \<mu>"
       using assms UP_def by fastforce
 
     lemma arr_UP:
     assumes "B.arr \<mu>"
     shows "arr (UP \<mu>)"
       using assms UP_def
       by (intro arrI, fastforce+)
 
     lemma UP_in_hom [intro]:
     assumes "B.arr \<mu>"
     shows "\<guillemotleft>UP \<mu> : UP\<^sub>0 (src\<^sub>B \<mu>) \<rightarrow> UP\<^sub>0 (trg\<^sub>B \<mu>)\<guillemotright>"
     and "\<guillemotleft>UP \<mu> : UP (B.dom \<mu>) \<Rightarrow> UP (B.cod \<mu>)\<guillemotright>"
       using assms arr_UP UP_def UP\<^sub>0_def dom_char cod_char src_def trg_def by auto
 
     lemma UP_simps [simp]:
     assumes "B.arr \<mu>"
     shows "arr (UP \<mu>)"
     and "src (UP \<mu>) = UP\<^sub>0 (src\<^sub>B \<mu>)" and "trg (UP \<mu>) = UP\<^sub>0 (trg\<^sub>B \<mu>)"
     and "dom (UP \<mu>) = UP (B.dom \<mu>)" and "cod (UP \<mu>) = UP (B.cod \<mu>)"
       using assms arr_UP UP_in_hom by auto
 
     interpretation UP: "functor" V\<^sub>B vcomp UP
       using UP_def arr_UP UP_simps(4-5)
       apply unfold_locales
           apply auto[4]
       using arr_UP UP_def comp_char seq_char
       by auto
 
     interpretation UP: weak_arrow_of_homs V\<^sub>B src\<^sub>B trg\<^sub>B vcomp src trg UP
     proof
       fix \<mu>
       assume \<mu>: "B.arr \<mu>"
       show "isomorphic (UP (src\<^sub>B \<mu>)) (src (UP \<mu>))"
       proof -
         let ?\<phi> = "MkArr \<^bold>\<langle>src\<^sub>B \<mu>\<^bold>\<rangle> \<^bold>\<langle>src\<^sub>B \<mu>\<^bold>\<rangle>\<^sub>0 (src\<^sub>B \<mu>)"
         have \<phi>: "\<guillemotleft>?\<phi> : UP (src\<^sub>B \<mu>) \<Rightarrow> src (UP \<mu>)\<guillemotright>"
         proof
           show 1: "arr ?\<phi>"
             using \<mu> by (intro arrI, auto)
           show "dom ?\<phi> = UP (src\<^sub>B \<mu>)"
             using \<mu> 1 dom_char UP_def by simp
           show "cod ?\<phi> = src (UP \<mu>)"
             using \<mu> 1 cod_char src_def by auto
         qed
         have "iso ?\<phi>"
           using \<mu> \<phi> iso_char src_def by auto
         thus ?thesis
           using \<phi> isomorphic_def by auto
       qed
       show "isomorphic (UP (trg\<^sub>B \<mu>)) (trg (UP \<mu>))"
       proof -
         let ?\<phi> = "MkArr \<^bold>\<langle>trg\<^sub>B \<mu>\<^bold>\<rangle> \<^bold>\<langle>trg\<^sub>B \<mu>\<^bold>\<rangle>\<^sub>0 (trg\<^sub>B \<mu>)"
         have \<phi>: "\<guillemotleft>?\<phi> : UP (trg\<^sub>B \<mu>) \<Rightarrow> trg (UP \<mu>)\<guillemotright>"
         proof
           show 1: "arr ?\<phi>"
             using \<mu> by (intro arrI, auto)
           show "dom ?\<phi> = UP (trg\<^sub>B \<mu>)"
             using \<mu> 1 dom_char UP_def by simp
           show "cod ?\<phi> = trg (UP \<mu>)"
             using \<mu> 1 cod_char trg_def by auto
         qed
         have "iso ?\<phi>"
           using \<mu> \<phi> iso_char trg_def by auto
         thus ?thesis
           using \<phi> isomorphic_def by auto
       qed
     qed
 
     interpretation "functor" B.VV.comp VV.comp UP.FF
       using UP.functor_FF by auto
     interpretation HoUP_UP: composite_functor B.VV.comp VV.comp vcomp
                               UP.FF \<open>\<lambda>\<mu>\<nu>. hcomp (fst \<mu>\<nu>) (snd \<mu>\<nu>)\<close> ..
     interpretation UPoH: composite_functor B.VV.comp V\<^sub>B vcomp
                            \<open>\<lambda>\<mu>\<nu>. fst \<mu>\<nu> \<star>\<^sub>B snd \<mu>\<nu>\<close> UP ..
 
     abbreviation \<Phi>\<^sub>o
     where "\<Phi>\<^sub>o fg \<equiv> MkArr (\<^bold>\<langle>fst fg\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>snd fg\<^bold>\<rangle>) \<^bold>\<langle>fst fg \<star>\<^sub>B snd fg\<^bold>\<rangle> (fst fg \<star>\<^sub>B snd fg)"
 
     interpretation \<Phi>: transformation_by_components
                         B.VV.comp vcomp HoUP_UP.map UPoH.map \<Phi>\<^sub>o
     proof
       fix fg
       assume fg: "B.VV.ide fg"
       show "\<guillemotleft>\<Phi>\<^sub>o fg : HoUP_UP.map fg \<Rightarrow> UPoH.map fg\<guillemotright>"
         using fg arr_char dom_char cod_char B.VV.ide_char B.VV.arr_char
               UP.FF_def UP_def hcomp_def B.can_Ide_self src_def trg_def
         apply (intro in_homI) by auto
       next
       fix \<mu>\<nu>
       assume \<mu>\<nu>: "B.VV.arr \<mu>\<nu>"
       show "\<Phi>\<^sub>o (B.VV.cod \<mu>\<nu>) \<cdot> HoUP_UP.map \<mu>\<nu> = UPoH.map \<mu>\<nu> \<cdot> \<Phi>\<^sub>o (B.VV.dom \<mu>\<nu>)"
       proof -
         have "\<Phi>\<^sub>o (B.VV.cod \<mu>\<nu>) \<cdot> HoUP_UP.map \<mu>\<nu> =
               MkArr (\<^bold>\<langle>B.dom (fst \<mu>\<nu>)\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>B.dom (snd \<mu>\<nu>)\<^bold>\<rangle>)
                     (\<^bold>\<langle>B.cod (fst \<mu>\<nu>) \<star>\<^sub>B B.cod (snd \<mu>\<nu>)\<^bold>\<rangle>)
                     (fst \<mu>\<nu> \<star>\<^sub>B snd \<mu>\<nu>)"
         proof -
           have "\<Phi>\<^sub>o (B.VV.cod \<mu>\<nu>) \<cdot> HoUP_UP.map \<mu>\<nu> =
                 MkArr (\<^bold>\<langle>B.cod (fst \<mu>\<nu>)\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>B.cod (snd \<mu>\<nu>)\<^bold>\<rangle>) (\<^bold>\<langle>B.cod (fst \<mu>\<nu>) \<star>\<^sub>B B.cod (snd \<mu>\<nu>)\<^bold>\<rangle>)
                       (B.cod (fst \<mu>\<nu>) \<star>\<^sub>B B.cod (snd \<mu>\<nu>)) \<cdot>
                 MkArr (\<^bold>\<langle>B.dom (fst \<mu>\<nu>)\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>B.dom (snd \<mu>\<nu>)\<^bold>\<rangle>)
                       (\<^bold>\<langle>B.cod (fst \<mu>\<nu>)\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>B.cod (snd \<mu>\<nu>)\<^bold>\<rangle>)
                       (fst \<mu>\<nu> \<star>\<^sub>B snd \<mu>\<nu>)"
             using \<mu>\<nu> B.VV.arr_char arr_char UP.FF_def hcomp_def UP_def
                   src_def trg_def B.can_in_hom B.can_Ide_self B.comp_arr_dom B.comp_cod_arr
             by auto
           also have "... = MkArr (\<^bold>\<langle>B.dom (fst \<mu>\<nu>)\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>B.dom (snd \<mu>\<nu>)\<^bold>\<rangle>)
                                  (\<^bold>\<langle>B.cod (fst \<mu>\<nu>) \<star>\<^sub>B B.cod (snd \<mu>\<nu>)\<^bold>\<rangle>)
                                  ((B.cod (fst \<mu>\<nu>) \<star>\<^sub>B B.cod (snd \<mu>\<nu>)) \<cdot>\<^sub>B (fst \<mu>\<nu> \<star>\<^sub>B snd \<mu>\<nu>))"
             using \<mu>\<nu> B.VV.arr_char
             by (intro comp_MkArr arr_MkArr, auto)
           also have "... = MkArr (\<^bold>\<langle>B.dom (fst \<mu>\<nu>)\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>B.dom (snd \<mu>\<nu>)\<^bold>\<rangle>)
                                  (\<^bold>\<langle>B.cod (fst \<mu>\<nu>) \<star>\<^sub>B B.cod (snd \<mu>\<nu>)\<^bold>\<rangle>)
                                  (fst \<mu>\<nu> \<star>\<^sub>B snd \<mu>\<nu>)"
             using \<mu>\<nu> B.VV.arr_char B.comp_cod_arr by auto
           finally show ?thesis by simp
         qed
         also have "... = UPoH.map \<mu>\<nu> \<cdot> \<Phi>\<^sub>o (B.VV.dom \<mu>\<nu>)"
         proof -
           have "UPoH.map \<mu>\<nu> \<cdot> \<Phi>\<^sub>o (B.VV.dom \<mu>\<nu>) =
                 MkArr (\<^bold>\<langle>B.dom (fst \<mu>\<nu>) \<star>\<^sub>B B.dom (snd \<mu>\<nu>)\<^bold>\<rangle>)
                       (\<^bold>\<langle>B.cod (fst \<mu>\<nu>) \<star>\<^sub>B B.cod (snd \<mu>\<nu>)\<^bold>\<rangle>)
                       (fst \<mu>\<nu> \<star>\<^sub>B snd \<mu>\<nu>) \<cdot>
                 MkArr (\<^bold>\<langle>B.dom (fst \<mu>\<nu>)\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>B.dom (snd \<mu>\<nu>)\<^bold>\<rangle>)
                       (\<^bold>\<langle>B.dom (fst \<mu>\<nu>) \<star>\<^sub>B B.dom (snd \<mu>\<nu>)\<^bold>\<rangle>)
                       (B.dom (fst \<mu>\<nu>) \<star>\<^sub>B B.dom (snd \<mu>\<nu>))"
             using \<mu>\<nu> B.VV.arr_char arr_char UP.FF_def hcomp_def UP_def
                   src_def trg_def B.can_in_hom B.can_Ide_self B.comp_arr_dom B.comp_cod_arr
             by auto
           also have "... = MkArr (\<^bold>\<langle>B.dom (fst \<mu>\<nu>)\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>B.dom (snd \<mu>\<nu>)\<^bold>\<rangle>)
                                  (\<^bold>\<langle>B.cod (fst \<mu>\<nu>) \<star>\<^sub>B B.cod (snd \<mu>\<nu>)\<^bold>\<rangle>)
                                  ((fst \<mu>\<nu> \<star>\<^sub>B snd \<mu>\<nu>) \<cdot>\<^sub>B (B.dom (fst \<mu>\<nu>) \<star>\<^sub>B B.dom (snd \<mu>\<nu>)))"
             using \<mu>\<nu> B.VV.arr_char arr_MkArr
             apply (intro comp_MkArr arr_MkArr) by auto
           also have "... = MkArr (\<^bold>\<langle>B.dom (fst \<mu>\<nu>)\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>B.dom (snd \<mu>\<nu>)\<^bold>\<rangle>)
                                  (\<^bold>\<langle>B.cod (fst \<mu>\<nu>) \<star>\<^sub>B B.cod (snd \<mu>\<nu>)\<^bold>\<rangle>)
                                  (fst \<mu>\<nu> \<star>\<^sub>B snd \<mu>\<nu>)"
             using \<mu>\<nu> B.VV.arr_char B.comp_arr_dom by auto
          finally show ?thesis by simp
         qed
         finally show ?thesis by simp
       qed
     qed
 
     abbreviation \<Phi>
     where "\<Phi> \<equiv> \<Phi>.map"
 
     lemma \<Phi>_in_hom [intro]:
     assumes "B.arr (fst \<mu>\<nu>)" and "B.arr (snd \<mu>\<nu>)" and "src\<^sub>B (fst \<mu>\<nu>) = trg\<^sub>B (snd \<mu>\<nu>)"
     shows "\<guillemotleft>\<Phi> \<mu>\<nu> : UP\<^sub>0 (src\<^sub>B (snd \<mu>\<nu>)) \<rightarrow> UP\<^sub>0 (trg\<^sub>B (fst \<mu>\<nu>))\<guillemotright>"
     and "\<guillemotleft>\<Phi> \<mu>\<nu> : UP (B.dom (fst \<mu>\<nu>)) \<star> UP (B.dom (snd \<mu>\<nu>))
                     \<Rightarrow> UP (B.cod (fst \<mu>\<nu>) \<star>\<^sub>B B.cod (snd \<mu>\<nu>))\<guillemotright>"
     proof -
       let ?\<mu> = "fst \<mu>\<nu>" and ?\<nu> = "snd \<mu>\<nu>"
       show 1: "\<guillemotleft>\<Phi> \<mu>\<nu> : UP (B.dom ?\<mu>) \<star> UP (B.dom ?\<nu>) \<Rightarrow> UP (B.cod ?\<mu> \<star>\<^sub>B B.cod ?\<nu>)\<guillemotright>"
       proof
         show "arr (\<Phi> \<mu>\<nu>)"
           using assms by auto
         show "dom (\<Phi> \<mu>\<nu>) = UP (B.dom ?\<mu>) \<star> UP (B.dom ?\<nu>)"
         proof -
           have "B.VV.in_hom (?\<mu>, ?\<nu>) (B.dom ?\<mu>, B.dom ?\<nu>) (B.cod ?\<mu>, B.cod ?\<nu>)"
             using assms B.VV.in_hom_char B.VV.arr_char by auto
           hence "dom (\<Phi> \<mu>\<nu>) = HoUP_UP.map (B.dom ?\<mu>, B.dom ?\<nu>)"
             by auto
           also have "... = UP (B.dom ?\<mu>) \<star> UP (B.dom ?\<nu>)"
             using assms UP.FF_def by fastforce
           finally show ?thesis by simp
         qed
         show "cod (\<Phi> \<mu>\<nu>) = UP (B.cod ?\<mu> \<star>\<^sub>B B.cod ?\<nu>)"
           using assms B.VV.in_hom_char B.VV.arr_char by auto
       qed
       show "\<guillemotleft>\<Phi> \<mu>\<nu> : UP\<^sub>0 (src\<^sub>B ?\<nu>) \<rightarrow> UP\<^sub>0 (trg\<^sub>B ?\<mu>)\<guillemotright>"
         using assms 1 src_dom [of "\<Phi> \<mu>\<nu>"] trg_dom [of "\<Phi> \<mu>\<nu>"] by auto
     qed
 
     lemma \<Phi>_simps [simp]:
     assumes "B.arr (fst \<mu>\<nu>)" and "B.arr (snd \<mu>\<nu>)" and "src\<^sub>B (fst \<mu>\<nu>) = trg\<^sub>B (snd \<mu>\<nu>)"
     shows "arr (\<Phi> \<mu>\<nu>)"
     and "src (\<Phi> \<mu>\<nu>) = UP\<^sub>0 (src\<^sub>B (snd \<mu>\<nu>))" and "trg (\<Phi> \<mu>\<nu>) = UP\<^sub>0 (trg\<^sub>B (fst \<mu>\<nu>))"
     and "dom (\<Phi> \<mu>\<nu>) = UP (B.dom (fst \<mu>\<nu>)) \<star> UP (B.dom (snd \<mu>\<nu>))"
     and "cod (\<Phi> \<mu>\<nu>) = UP (B.cod (fst \<mu>\<nu>) \<star>\<^sub>B B.cod (snd \<mu>\<nu>))"
       using assms \<Phi>_in_hom [of \<mu>\<nu>] by auto
 
     lemma \<Phi>_ide_simps [simp]:
     assumes "B.ide (fst fg)" and "B.ide (snd fg)" and "src\<^sub>B (fst fg) = trg\<^sub>B (snd fg)"
     shows "Dom (\<Phi> fg) = \<^bold>\<langle>fst fg\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>snd fg\<^bold>\<rangle>"
     and "Cod (\<Phi> fg) = \<^bold>\<langle>fst fg \<star>\<^sub>B snd fg\<^bold>\<rangle>"
     and "Map (\<Phi> fg) = fst fg \<star>\<^sub>B snd fg"
       using assms B.VV.ide_char B.VV.arr_char by auto
 
     interpretation \<Phi>: natural_isomorphism B.VV.comp vcomp HoUP_UP.map UPoH.map \<Phi>
     proof
       fix fg
       assume fg: "B.VV.ide fg"
       have "arr (\<Phi> fg)"
         using fg \<Phi>.preserves_reflects_arr [of fg] by simp
       thus "iso (\<Phi> fg)"
         using fg iso_char by simp
     qed
 
     lemma \<Phi>_ide_simp:
     assumes "B.ide f" and "B.ide g" and "src\<^sub>B f = trg\<^sub>B g"
     shows "\<Phi> (f, g) = MkArr (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle>) \<^bold>\<langle>f \<star>\<^sub>B g\<^bold>\<rangle> (f \<star>\<^sub>B g)"
       using assms B.VV.ide_char B.VV.arr_char by simp
 
     lemma \<Phi>'_ide_simp:
     assumes "B.ide f" and "B.ide g" and "src\<^sub>B f = trg\<^sub>B g"
     shows "inv (\<Phi> (f, g)) = MkArr \<^bold>\<langle>f \<star>\<^sub>B g\<^bold>\<rangle> (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle>) (f \<star>\<^sub>B g)"
       using assms \<Phi>_ide_simp iso_char \<Phi>.components_are_iso [of "(f, g)"]
             B.VV.ide_char B.VV.arr_char
       by simp
 
     interpretation UP: pseudofunctor V\<^sub>B H\<^sub>B \<a>\<^sub>B \<i>\<^sub>B src\<^sub>B trg\<^sub>B vcomp hcomp \<a> \<i> src trg UP \<Phi>
     proof
       fix f g h
       assume f: "B.ide f" and g: "B.ide g" and h: "B.ide h"
       and fg: "src\<^sub>B f = trg\<^sub>B g" and gh: "src\<^sub>B g = trg\<^sub>B h"
       show "UP \<a>\<^sub>B[f, g, h] \<cdot> \<Phi> (f \<star>\<^sub>B g, h) \<cdot> (\<Phi> (f, g) \<star> UP h) =
             \<Phi> (f, g \<star>\<^sub>B h) \<cdot> (UP f \<star> \<Phi> (g, h)) \<cdot> \<a> (UP f) (UP g) (UP h)"
       proof -
         have "UP \<a>\<^sub>B[f, g, h] \<cdot> \<Phi> (f \<star>\<^sub>B g, h) \<cdot> (\<Phi> (f, g) \<star> UP h) =
               MkArr (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle>) \<^bold>\<langle>f \<star>\<^sub>B g \<star>\<^sub>B h\<^bold>\<rangle> (f \<star>\<^sub>B g \<star>\<^sub>B h)"
         proof -
           have 1: "UP.hseq\<^sub>D (MkIde \<^bold>\<langle>f\<^bold>\<rangle>) (MkIde \<^bold>\<langle>g\<^bold>\<rangle>)"
             using f g fg hseq_char src_def trg_def arr_char by auto
           have 2: "UP.hseq\<^sub>D (MkArr (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle>) \<^bold>\<langle>f \<star>\<^sub>B g\<^bold>\<rangle> (f \<star>\<^sub>B g) \<cdot> MkIde (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle>))
                             (MkIde \<^bold>\<langle>h\<^bold>\<rangle>)"
           proof -
             have "MkArr (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle>) \<^bold>\<langle>f \<star>\<^sub>B g\<^bold>\<rangle> (f \<star>\<^sub>B g) \<cdot> MkIde (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle>) =
                   MkArr (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle>) \<^bold>\<langle>f \<star>\<^sub>B g\<^bold>\<rangle> (f \<star>\<^sub>B g)"
             proof -
               have "MkArr (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle>) \<^bold>\<langle>f \<star>\<^sub>B g\<^bold>\<rangle> (f \<star>\<^sub>B g) \<cdot> MkIde (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle>) =
                     MkArr (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle>) \<^bold>\<langle>f \<star>\<^sub>B g\<^bold>\<rangle> (f \<star>\<^sub>B g) \<cdot> MkArr (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle>) (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle>) (f \<star>\<^sub>B g)"
                 using f g fg by simp
               also have "... = MkArr (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle>) \<^bold>\<langle>f \<star>\<^sub>B g\<^bold>\<rangle> ((f \<star>\<^sub>B g) \<cdot>\<^sub>B (f \<star>\<^sub>B g))"
                 using f g fg by (intro comp_MkArr arr_MkArr, auto)
               also have "... = MkArr (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle>) \<^bold>\<langle>f \<star>\<^sub>B g\<^bold>\<rangle> (f \<star>\<^sub>B g)"
                 using f g fg by simp
               finally show ?thesis by blast
             qed
             thus ?thesis
               using f g h fg gh arr_char src_def trg_def by auto
           qed
           have "UP \<a>\<^sub>B[f, g, h] = MkArr \<^bold>\<langle>(f \<star>\<^sub>B g) \<star>\<^sub>B h\<^bold>\<rangle> \<^bold>\<langle>f \<star>\<^sub>B g \<star>\<^sub>B h\<^bold>\<rangle> \<a>\<^sub>B[f, g, h]"
             using f g h fg gh UP_def B.HoHV_def B.HoVH_def B.VVV.arr_char B.VV.arr_char
                   B.VVV.dom_char B.VVV.cod_char
             by simp
           moreover have
             "\<Phi> (f \<star>\<^sub>B g, h) = MkArr (\<^bold>\<langle>f \<star>\<^sub>B g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle>) \<^bold>\<langle>(f \<star>\<^sub>B g) \<star>\<^sub>B h\<^bold>\<rangle> ((f \<star>\<^sub>B g) \<star>\<^sub>B h) \<cdot>
                              MkArr (\<^bold>\<langle>f \<star>\<^sub>B g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle>) (\<^bold>\<langle>f \<star>\<^sub>B g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle>) ((f \<star>\<^sub>B g) \<star>\<^sub>B h)"
             using f g h fg gh \<Phi>.map_simp_ide \<Phi>.map_def UP.FF_def UP_def hcomp_def
                   B.VV.arr_char B.can_Ide_self B.comp_arr_dom B.comp_cod_arr src_def trg_def
             apply simp
             by (metis (no_types, lifting) B.ide_hcomp B.ide_char arr_UP)
           moreover have "\<Phi> (f, g) \<star> UP h =
                          MkArr (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle>) (\<^bold>\<langle>f \<star>\<^sub>B g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle>) (B.inv \<a>\<^sub>B[f, g, h])"
           proof -
             have "MkArr (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle>) (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle>)
                         (B.can (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle>) (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle>) \<cdot>\<^sub>B (f \<star>\<^sub>B g) \<cdot>\<^sub>B B.can (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle>) (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle>)) =
                   MkArr (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle>) (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle>) (f \<star>\<^sub>B g)"
               using f g fg B.can_Ide_self B.comp_arr_dom B.comp_cod_arr by simp
             moreover have "MkArr (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle>) \<^bold>\<langle>f \<star>\<^sub>B g\<^bold>\<rangle> (f \<star>\<^sub>B g) \<cdot>
                              MkArr (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle>) (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle>) (f \<star>\<^sub>B g) =
                            MkArr (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle>) \<^bold>\<langle>f \<star>\<^sub>B g\<^bold>\<rangle> (f \<star>\<^sub>B g)"
             proof -
               have "MkArr (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle>) \<^bold>\<langle>f \<star>\<^sub>B g\<^bold>\<rangle> (f \<star>\<^sub>B g) \<cdot>
                       MkArr (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle>) (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle>) (f \<star>\<^sub>B g) =
                     MkArr (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle>) \<^bold>\<langle>f \<star>\<^sub>B g\<^bold>\<rangle> ((f \<star>\<^sub>B g) \<cdot>\<^sub>B (f \<star>\<^sub>B g))"
                 using f g fg arr_MkArr by (intro comp_MkArr arr_MkArr) auto
               also have "... = MkArr (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle>) \<^bold>\<langle>f \<star>\<^sub>B g\<^bold>\<rangle> (f \<star>\<^sub>B g)"
                 using f g fg by simp
               finally show ?thesis by blast
             qed
             moreover have "B.can ((\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle>) \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle>) (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle>) = B.inv \<a>\<^sub>B[f, g, h]"
               using f g h fg gh B.canI_associator_0 B.inverse_arrows_can by simp
             ultimately show ?thesis
               using 1 2 f g h fg gh \<Phi>.map_def UP_def hcomp_def UP.FF_def
                     B.VV.arr_char trg_def B.can_Ide_self B.comp_cod_arr
               by simp
           qed
           ultimately have "UP \<a>\<^sub>B[f, g, h] \<cdot> \<Phi> (f \<star>\<^sub>B g, h) \<cdot> (\<Phi> (f, g) \<star> UP h) =
                            MkArr \<^bold>\<langle>(f \<star>\<^sub>B g) \<star>\<^sub>B h\<^bold>\<rangle> \<^bold>\<langle>f \<star>\<^sub>B g \<star>\<^sub>B h\<^bold>\<rangle> \<a>\<^sub>B[f, g, h] \<cdot>
                              MkArr (\<^bold>\<langle>f \<star>\<^sub>B g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle>) \<^bold>\<langle>(f \<star>\<^sub>B g) \<star>\<^sub>B h\<^bold>\<rangle> ((f \<star>\<^sub>B g) \<star>\<^sub>B h) \<cdot>
                                MkArr (\<^bold>\<langle>f \<star>\<^sub>B g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle>) (\<^bold>\<langle>f \<star>\<^sub>B g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle>) ((f \<star>\<^sub>B g) \<star>\<^sub>B h) \<cdot>
                                  MkArr (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle>) (\<^bold>\<langle>f \<star>\<^sub>B g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle>) (B.inv \<a>\<^sub>B[f, g, h])"
             using comp_assoc by presburger
           also have "... = MkArr (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle>) \<^bold>\<langle>f \<star>\<^sub>B g \<star>\<^sub>B h\<^bold>\<rangle>
                                  (\<a>\<^sub>B[f, g, h] \<cdot>\<^sub>B ((f \<star>\<^sub>B g) \<star>\<^sub>B h) \<cdot>\<^sub>B ((f \<star>\<^sub>B g) \<star>\<^sub>B h) \<cdot>\<^sub>B
                                    B.inv \<a>\<^sub>B[f, g, h])"
           proof -
             have "Arr (MkArr (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle>) (\<^bold>\<langle>f \<star>\<^sub>B g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle>) (B.inv \<a>\<^sub>B[f, g, h])) \<and>
                      Arr (MkArr (\<^bold>\<langle>f \<star>\<^sub>B g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle>) (\<^bold>\<langle>f \<star>\<^sub>B g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle>) ((f \<star>\<^sub>B g) \<star>\<^sub>B h)) \<and>
                      Arr (MkArr (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle>) (\<^bold>\<langle>f \<star>\<^sub>B g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle>)
                                 (((f \<star>\<^sub>B g) \<star>\<^sub>B h) \<cdot>\<^sub>B B.inv \<a>\<^sub>B[f, g, h])) \<and>
                      Arr (MkArr (\<^bold>\<langle>f \<star>\<^sub>B g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle>) \<^bold>\<langle>(f \<star>\<^sub>B g) \<star>\<^sub>B h\<^bold>\<rangle> ((f \<star>\<^sub>B g) \<star>\<^sub>B h)) \<and>
                      Arr (MkArr (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle>) \<^bold>\<langle>(f \<star>\<^sub>B g) \<star>\<^sub>B h\<^bold>\<rangle>
                           (((f \<star>\<^sub>B g) \<star>\<^sub>B h) \<cdot>\<^sub>B ((f \<star>\<^sub>B g) \<star>\<^sub>B h) \<cdot>\<^sub>B B.inv \<a>\<^sub>B[f, g, h])) \<and>
                      Arr (MkArr \<^bold>\<langle>(f \<star>\<^sub>B g) \<star>\<^sub>B h\<^bold>\<rangle> \<^bold>\<langle>f \<star>\<^sub>B g \<star>\<^sub>B h\<^bold>\<rangle> \<a>\<^sub>B[f, g, h])"
               using f g h fg gh B.\<alpha>.preserves_hom B.HoHV_def B.HoVH_def by auto
             thus ?thesis
               using f g h fg gh comp_def B.comp_arr_dom B.comp_cod_arr by simp
           qed
           also have "... = MkArr (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle>) \<^bold>\<langle>f \<star>\<^sub>B g \<star>\<^sub>B h\<^bold>\<rangle> (f \<star>\<^sub>B g \<star>\<^sub>B h)"
             using B.comp_cod_arr B.comp_arr_inv'
             by (auto simp add: f fg g gh h)
           finally show ?thesis by simp
         qed
         also have "... = \<Phi> (f, g \<star>\<^sub>B h) \<cdot> (UP f \<star> \<Phi> (g, h)) \<cdot> \<a> (UP f) (UP g) (UP h)"
         proof -
           have "\<Phi> (f, g \<star>\<^sub>B h) \<cdot> (UP f \<star> \<Phi> (g, h)) \<cdot> \<a> (UP f) (UP g) (UP h) =
                 \<Phi> (f, g \<star>\<^sub>B h) \<cdot> (MkIde \<^bold>\<langle>f\<^bold>\<rangle> \<star> \<Phi> (g, h)) \<cdot> (MkIde \<^bold>\<langle>f\<^bold>\<rangle> \<star> MkIde \<^bold>\<langle>g\<^bold>\<rangle> \<star> MkIde \<^bold>\<langle>h\<^bold>\<rangle>)"
             using f g h fg gh VVV.arr_char VV.arr_char arr_char src_def trg_def UP_def \<a>_def
             by auto
           also have "... = MkArr (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g \<star>\<^sub>B h\<^bold>\<rangle>) \<^bold>\<langle>f \<star>\<^sub>B g \<star>\<^sub>B h\<^bold>\<rangle> (f \<star>\<^sub>B g \<star>\<^sub>B h) \<cdot>
                             MkArr (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g \<star>\<^sub>B h\<^bold>\<rangle>) (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g \<star>\<^sub>B h\<^bold>\<rangle>) (f \<star>\<^sub>B g \<star>\<^sub>B h) \<cdot>
                              MkArr (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle>) (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g \<star>\<^sub>B h\<^bold>\<rangle>) (f \<star>\<^sub>B g \<star>\<^sub>B h) \<cdot>
                               MkArr (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle>) (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle>) (f \<star>\<^sub>B g \<star>\<^sub>B h)"
           proof -
             have "\<Phi> (f, g \<star>\<^sub>B h) = MkArr (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g \<star>\<^sub>B h\<^bold>\<rangle>) \<^bold>\<langle>f \<star>\<^sub>B g \<star>\<^sub>B h\<^bold>\<rangle> (f \<star>\<^sub>B g \<star>\<^sub>B h) \<cdot>
                                   MkArr (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g \<star>\<^sub>B h\<^bold>\<rangle>) (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g \<star>\<^sub>B h\<^bold>\<rangle>) (f \<star>\<^sub>B g \<star>\<^sub>B h)"
               using f g h fg gh \<Phi>.map_simp_ide \<Phi>.map_def UP.FF_def UP_def hcomp_def
                     B.VV.arr_char B.can_Ide_self B.comp_arr_dom B.comp_cod_arr src_def trg_def
                     arr_char
               apply simp_all
               by blast
             moreover
             have "\<Phi> (g, h) = MkArr (\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle>) \<^bold>\<langle>g \<star>\<^sub>B h\<^bold>\<rangle> (g \<star>\<^sub>B h)"
               using f g h fg gh \<Phi>.map_def UP.FF_def UP_def hcomp_def B.VV.arr_char
                     B.can_Ide_self src_def trg_def arr_char
               by auto
             moreover have "MkIde \<^bold>\<langle>f\<^bold>\<rangle> \<star> MkArr (\<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle>) \<^bold>\<langle>g \<star>\<^sub>B h\<^bold>\<rangle> (g \<star>\<^sub>B h) =
                            MkArr (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle>) (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g \<star>\<^sub>B h\<^bold>\<rangle>) (f \<star>\<^sub>B g \<star>\<^sub>B h)"
               using f g h fg gh hcomp_def arr_char src_def trg_def B.can_Ide_self
                     B.comp_arr_dom B.comp_cod_arr
               by auto
             moreover
             have "MkIde \<^bold>\<langle>f\<^bold>\<rangle> \<star> MkIde \<^bold>\<langle>g\<^bold>\<rangle> \<star> MkIde \<^bold>\<langle>h\<^bold>\<rangle> =
                   MkArr (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle>) (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle>) (f \<star>\<^sub>B g \<star>\<^sub>B h)"
             proof -
               have "\<guillemotleft>f : f \<Rightarrow>\<^sub>B f\<guillemotright> \<and> \<guillemotleft>g : g \<Rightarrow>\<^sub>B g\<guillemotright> \<and> \<guillemotleft>h : h \<Rightarrow>\<^sub>B h\<guillemotright>"
                 using f g h by auto
               thus ?thesis
                 using f g h fg gh hcomp_def arr_char src_def trg_def B.can_Ide_self
                       B.comp_arr_dom B.comp_cod_arr
                 by simp
             qed
             ultimately show ?thesis
               using comp_assoc by auto
           qed
           also have "... = MkArr (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle>) \<^bold>\<langle>f \<star>\<^sub>B g \<star>\<^sub>B h\<^bold>\<rangle> (f \<star>\<^sub>B g \<star>\<^sub>B h)"
           proof -
             have "Arr (MkArr (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle>) (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle>) (f \<star>\<^sub>B g \<star>\<^sub>B h)) \<and>
                   Arr (MkArr (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>h\<^bold>\<rangle>) (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g \<star>\<^sub>B h\<^bold>\<rangle>) (f \<star>\<^sub>B g \<star>\<^sub>B h)) \<and>
                   Arr (MkArr (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g \<star>\<^sub>B h\<^bold>\<rangle>) (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g \<star>\<^sub>B h\<^bold>\<rangle>) (f \<star>\<^sub>B g \<star>\<^sub>B h)) \<and>
                   Arr (MkArr (\<^bold>\<langle>f\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>g \<star>\<^sub>B h\<^bold>\<rangle>) \<^bold>\<langle>f \<star>\<^sub>B g \<star>\<^sub>B h\<^bold>\<rangle> (f \<star>\<^sub>B g \<star>\<^sub>B h))"
               using f g h fg gh by auto
             thus ?thesis
               using f g h fg gh comp_def by auto
           qed
           finally show ?thesis by simp
         qed
         finally show ?thesis by blast
       qed
     qed
 
     lemma UP_is_pseudofunctor:
     shows "pseudofunctor V\<^sub>B H\<^sub>B \<a>\<^sub>B \<i>\<^sub>B src\<^sub>B trg\<^sub>B vcomp hcomp \<a> \<i> src trg UP \<Phi>" ..
 
     lemma UP_map\<^sub>0_obj [simp]:
     assumes "B.obj a"
     shows "UP.map\<^sub>0 a = UP\<^sub>0 a"
       using assms UP.map\<^sub>0_def by auto
 
     interpretation UP: full_functor V\<^sub>B vcomp UP
     proof
       fix \<mu> f g
       assume f: "B.ide f" and g: "B.ide g"
       assume \<mu>: "\<guillemotleft>\<mu> : UP f \<Rightarrow> UP g\<guillemotright>"
       show "\<exists>\<nu>. \<guillemotleft>\<nu> : f \<Rightarrow>\<^sub>B g\<guillemotright> \<and> UP \<nu> = \<mu>"
       proof -
         have 1: "\<guillemotleft>Map \<mu> : f \<Rightarrow>\<^sub>B g\<guillemotright>"
           using f g \<mu> UP_def arr_char in_hom_char by auto
         moreover have "UP (Map \<mu>) = \<mu>"
         proof -
           have "\<mu> = MkArr (Dom \<mu>) (Cod \<mu>) (Map \<mu>)"
             using \<mu> MkArr_Map by auto
           also have "... = UP (Map \<mu>)"
             using f g \<mu> 1 UP_def arr_char dom_char cod_char
             apply simp
             by (metis (no_types, lifting) B.in_homE Dom.simps(1) in_homE)
           finally show ?thesis by auto
         qed
         ultimately show ?thesis by blast
       qed
     qed
 
     interpretation UP: faithful_functor V\<^sub>B vcomp UP
       using arr_char UP_def
       by (unfold_locales, simp_all)
 
     interpretation UP: fully_faithful_functor V\<^sub>B vcomp UP ..
 
     lemma UP_is_fully_faithful_functor:
     shows "fully_faithful_functor V\<^sub>B vcomp UP"
       ..
 
     no_notation B.in_hom  ("\<guillemotleft>_ : _ \<rightarrow>\<^sub>B _\<guillemotright>")   (* Inherited from functor, I think. *)
 
     lemma Map_reflects_hhom:
     assumes "B.obj a" and "B.obj b" and "ide g"
     and "\<guillemotleft>g : UP.map\<^sub>0 a \<rightarrow> UP.map\<^sub>0 b\<guillemotright>"
     shows "\<guillemotleft>Map g : a \<rightarrow>\<^sub>B b\<guillemotright>"
     proof
       have 1: "B.ide (Map g)"
         using assms ide_char by blast
       show "B.arr (Map g)"
         using 1 by simp
       show "src\<^sub>B (Map g) = a"
       proof -
         have "src\<^sub>B (Map g) = Map (src g)"
           using assms src_def apply simp
           by (metis (no_types, lifting) E.eval_simps(2) E.Ide_implies_Arr arr_char ideE)
         also have "... = Map (UP.map\<^sub>0 a)"
           using assms by (metis (no_types, lifting) in_hhomE)
         also have "... = a"
           using assms UP.map\<^sub>0_def UP_def [of a] src_def by auto
         finally show ?thesis by simp
       qed
       show "trg\<^sub>B (Map g) = b"
       proof -
         have "trg\<^sub>B (Map g) = Map (trg g)"
           using assms trg_def apply simp
           by (metis (no_types, lifting) E.eval_simps(3) E.Ide_implies_Arr arr_char ideE)
         also have "... = Map (UP.map\<^sub>0 b)"
           using assms by (metis (no_types, lifting) in_hhomE)
         also have "... = b"
           using assms UP.map\<^sub>0_def UP_def [of b] src_def by auto
         finally show ?thesis by simp
       qed
     qed
 
     lemma eval_Dom_ide [simp]:
     assumes "ide g"
     shows "\<lbrace>Dom g\<rbrace> = Map g"
       using assms dom_char ideD by auto
 
     lemma Cod_ide:
     assumes "ide f"
     shows "Cod f = Dom f"
       using assms dom_char by auto
 
     lemma Map_preserves_objects:
     assumes "obj a"
     shows "B.obj (Map a)"
     proof -
       have "src\<^sub>B (Map a) = Map (src a)"
         using assms src_def apply simp
         using E.eval_simps(2) E.Ide_implies_Arr arr_char ideE
         by (metis (no_types, lifting) objE)
       also have 1: "... = \<lbrace>E.Src (Dom a)\<rbrace>"
         using assms src_def by auto
       also have "... = \<lbrace>\<^bold>\<langle>Map a\<^bold>\<rangle>\<^sub>0\<rbrace>"
         using assms B.src.is_extensional 1 by force
       also have "... = Map a"
         using assms by auto
       finally have "src\<^sub>B (Map a) = Map a" by simp
       moreover have "B.arr (Map a)"
         using assms B.ideD arr_char by auto
       ultimately show ?thesis
         using B.obj_def by simp
     qed
 
     interpretation UP: equivalence_pseudofunctor
                          V\<^sub>B H\<^sub>B \<a>\<^sub>B \<i>\<^sub>B src\<^sub>B trg\<^sub>B vcomp hcomp \<a> \<i> src trg UP \<Phi>
     proof
       (* UP is full, hence locally full. *)
       show "\<And>f f' \<nu>. \<lbrakk> B.ide f; B.ide f'; src\<^sub>B f = src\<^sub>B f'; trg\<^sub>B f = trg\<^sub>B f';
                        \<guillemotleft>\<nu> : UP f \<Rightarrow> UP f'\<guillemotright> \<rbrakk> \<Longrightarrow> \<exists>\<mu>. \<guillemotleft>\<mu> : f \<Rightarrow>\<^sub>B f'\<guillemotright> \<and> UP \<mu> = \<nu>"
         using UP.is_full by simp
       (* UP is essentially surjective up to equivalence on objects. *)
       show "\<And>b. obj b \<Longrightarrow> \<exists>a. B.obj a \<and> equivalent_objects (UP.map\<^sub>0 a) b"
       proof -
         fix b
         assume b: "obj b"
         have 1: "B.obj (Map b)"
           using b Map_preserves_objects by simp
         have 3: "UP.map\<^sub>0 (Map b) = MkArr \<^bold>\<langle>Map b\<^bold>\<rangle>\<^sub>0 \<^bold>\<langle>Map b\<^bold>\<rangle>\<^sub>0 (Map b)"
           using b 1 UP.map\<^sub>0_def [of "Map b"] UP_def src_def arr_char by auto
         have 4: "b = MkArr (Dom b) (Dom b) (Map b)"
           using b objE eval_Dom_ide
           by (metis (no_types, lifting) dom_char ideD(2) obj_def)
         let ?\<phi> = "MkArr \<^bold>\<langle>Map b\<^bold>\<rangle>\<^sub>0 (Dom b) (Map b)"
         have \<phi>: "arr ?\<phi>"
         proof -
           have 2: "E.Obj (Dom b)"
           proof -
             have "Dom b = Dom (src b)"
               using b obj_def by simp
             moreover have "Dom (src b) = E.Src (Dom b)"
               using b obj_def src_def arr_char by simp
             moreover have "E.Obj (E.Src (Dom b))"
               using b obj_def src_def arr_char arr_def E.Obj_Src by simp
             ultimately show ?thesis by simp
           qed
           have "E.Nml \<^bold>\<langle>Map b\<^bold>\<rangle>\<^sub>0 \<and> E.Ide \<^bold>\<langle>Map b\<^bold>\<rangle>\<^sub>0"
             using 1 by auto
           moreover have "E.Nml (Dom b) \<and> E.Ide (Dom b)"
             using b arr_char [of b] by auto
           moreover have "E.Src \<^bold>\<langle>Map b\<^bold>\<rangle>\<^sub>0 = E.Src (Dom b)"
             using b 1 2 B.obj_def obj_char
             by (cases "Dom b", simp_all)
           moreover have "E.Trg \<^bold>\<langle>Map b\<^bold>\<rangle>\<^sub>0 = E.Trg (Dom b)"
             using b 1 2 B.obj_def obj_char
             by (cases "Dom b", simp_all)
           moreover have "\<guillemotleft>Map b : \<lbrace>\<^bold>\<langle>Map b\<^bold>\<rangle>\<^sub>0\<rbrace> \<Rightarrow>\<^sub>B \<lbrace>Dom b\<rbrace>\<guillemotright>"
             using b 1 by (elim objE, auto)
           ultimately show ?thesis
             using arr_char \<open>E.Nml \<^bold>\<langle>Map b\<^bold>\<rangle>\<^sub>0 \<and> E.Ide \<^bold>\<langle>Map b\<^bold>\<rangle>\<^sub>0\<close> by auto
         qed
         hence "iso ?\<phi>"
           using 1 iso_char by auto
         moreover have "dom ?\<phi> = UP.map\<^sub>0 (Map b)"
           using \<phi> dom_char b 1 3 B.objE UP.map\<^sub>0_def UP_def src_def by auto
         moreover have "cod ?\<phi> = b"
           using \<phi> cod_char b 4 1 by auto
         ultimately have "isomorphic (UP.map\<^sub>0 (Map b)) b"
           using \<phi> 3 4 isomorphic_def by blast
         moreover have 5: "obj (UP.map\<^sub>0 (Map b))"
           using 1 UP.map\<^sub>0_simps(2) by simp
         ultimately have 6: "UP.map\<^sub>0 (Map b) = b"
           using b isomorphic_objects_are_equal by simp
         have "equivalent_objects (UP.map\<^sub>0 (Map b)) b"
           using b 6 equivalent_objects_reflexive [of b] by simp
         thus "\<exists>a. B.obj a \<and> equivalent_objects (UP.map\<^sub>0 a) b"
           using 1 6 by auto
       qed
       (* UP is locally essentially surjective. *)
       show "\<And>a b g. \<lbrakk> B.obj a; B.obj b; \<guillemotleft>g : UP.map\<^sub>0 a \<rightarrow> UP.map\<^sub>0 b\<guillemotright>; ide g \<rbrakk> \<Longrightarrow>
                         \<exists>f. \<guillemotleft>f : a \<rightarrow>\<^sub>B b\<guillemotright> \<and> B.ide f \<and> isomorphic (UP f) g"
       proof -
         fix a b g
         assume a: "B.obj a" and b: "B.obj b"
         assume g_in_hhom: "\<guillemotleft>g : UP.map\<^sub>0 a \<rightarrow> UP.map\<^sub>0 b\<guillemotright>"
         assume ide_g: "ide g"
         have 1: "B.ide (Map g)"
           using ide_g ide_char by blast
         have "arr (UP a)"
           using a by auto
         have "arr (UP b)"
           using b by auto
         have Map_g_eq: "Map g = \<lbrace>Dom g\<rbrace>"
           using ide_g by simp
         have Map_g_in_hhom: "\<guillemotleft>Map g : a \<rightarrow>\<^sub>B b\<guillemotright>"
           using a b ide_g g_in_hhom Map_reflects_hhom by simp
 
         let ?\<phi> = "MkArr \<^bold>\<langle>Map g\<^bold>\<rangle> (Dom g) (Map g)"
         have \<phi>: "arr ?\<phi>"
         proof -
           have "\<guillemotleft>Map ?\<phi> : \<lbrace>Dom ?\<phi>\<rbrace> \<Rightarrow>\<^sub>B \<lbrace>Cod ?\<phi>\<rbrace>\<guillemotright>"
             using 1 Map_g_eq by auto
           moreover have "E.Ide \<^bold>\<langle>Map g\<^bold>\<rangle> \<and> E.Nml \<^bold>\<langle>Map g\<^bold>\<rangle>"
             using 1 by simp
           moreover have "E.Ide (Dom g) \<and> E.Nml (Dom g)"
             using ide_g arr_char ide_char by blast
           moreover have "E.Src \<^bold>\<langle>Map g\<^bold>\<rangle> = E.Src (Dom g)"
             using ide_g g_in_hhom src_def Map_g_in_hhom
             by (metis (no_types, lifting) B.ideD(2) B.in_hhom_def B.objE B.obj_def'
                 Dom.simps(1) E.Src.simps(2) UP.map\<^sub>0_def \<open>arr (UP a)\<close> a in_hhomE UP_def)
           moreover have "E.Trg \<^bold>\<langle>Map g\<^bold>\<rangle> = E.Trg (Dom g)"
           proof -
             have "E.Trg \<^bold>\<langle>Map g\<^bold>\<rangle> = \<^bold>\<langle>b\<^bold>\<rangle>\<^sub>0"
               using Map_g_in_hhom by auto
             also have "... = E.Trg (Dom g)"
             proof -
               have "E.Trg (Dom g) = Dom (trg g)"
                 using ide_g trg_def by simp
               also have "... = Dom (UP.map\<^sub>0 b)"
                 using g_in_hhom by auto
               also have "... = \<^bold>\<langle>b\<^bold>\<rangle>\<^sub>0"
                 using b \<open>arr (UP b)\<close> UP.map\<^sub>0_def src_def UP_def B.objE by auto
               finally show ?thesis by simp
             qed
             finally show ?thesis by simp
           qed
           ultimately show ?thesis
             using arr_char by simp
         qed
         have "\<guillemotleft>?\<phi> : UP (Map g) \<Rightarrow> g\<guillemotright>"
         proof
           show "arr ?\<phi>"
             using \<phi> by simp
           show "dom ?\<phi> = UP (Map g)"
             using \<phi> 1 dom_char UP_def by simp
           show "cod ?\<phi> = g"
           proof -
             have "cod ?\<phi> = MkArr (Dom g) (Dom g) (Map g)"
               using ide_g cod_char Map_g_eq \<phi> by auto
             moreover have "Dom g = Cod g"
               using ide_g Cod_ide by simp
             ultimately have "cod ?\<phi> = MkArr (Dom g) (Cod g) (Map g)"
               by simp
             thus ?thesis
               by (metis (no_types, lifting) "1" B.comp_ide_self
                   \<open>Dom g = Cod g\<close> comp_cod_arr ideD(1) ideD(3) ide_g comp_char)
           qed
         qed
         moreover have "iso ?\<phi>"
           using \<phi> 1 iso_char by simp
         ultimately have "isomorphic (UP (Map g)) g"
           using isomorphic_def by auto
         thus "\<exists>f. \<guillemotleft>f : a \<rightarrow>\<^sub>B b\<guillemotright> \<and> B.ide f \<and> isomorphic (UP f) g"
           using 1 Map_g_in_hhom by auto
       qed
     qed
 
     theorem UP_is_equivalence_pseudofunctor:
     shows "equivalence_pseudofunctor V\<^sub>B H\<^sub>B \<a>\<^sub>B \<i>\<^sub>B src\<^sub>B trg\<^sub>B vcomp hcomp \<a> \<i> src trg UP \<Phi>" ..
 
     text \<open>
       Next, we work out the details of the equivalence pseudofunctor \<open>DN\<close> in the
       converse direction.
     \<close>
 
     definition DN
     where "DN \<mu> \<equiv> if arr \<mu> then Map \<mu> else B.null"
 
     lemma DN_in_hom [intro]:
     assumes "arr \<mu>"
     shows "\<guillemotleft>DN \<mu> : DN (src \<mu>) \<rightarrow>\<^sub>B DN (trg \<mu>)\<guillemotright>"
     and "\<guillemotleft>DN \<mu> : DN (dom \<mu>) \<Rightarrow>\<^sub>B DN (cod \<mu>)\<guillemotright>"
       using assms DN_def arr_char [of \<mu>] B.vconn_implies_hpar(1-2) E.eval_in_hom(1)
             B.in_hhom_def
       by auto
 
     lemma DN_simps [simp]:
     assumes "arr \<mu>"
     shows "B.arr (DN \<mu>)"
     and "src\<^sub>B (DN \<mu>) = DN (src \<mu>)" and "trg\<^sub>B (DN \<mu>) = DN (trg \<mu>)"
     and "B.dom (DN \<mu>) = DN (dom \<mu>)" and "B.cod (DN \<mu>) = DN (cod \<mu>)"
       using assms DN_in_hom by auto
 
     interpretation "functor" vcomp V\<^sub>B DN
       using DN_def seqE Map_comp seq_char
       by (unfold_locales, auto)
 
     interpretation DN: weak_arrow_of_homs vcomp src trg V\<^sub>B src\<^sub>B trg\<^sub>B DN
     proof
       fix \<mu>
       assume \<mu>: "arr \<mu>"
       show "B.isomorphic (DN (src \<mu>)) (src\<^sub>B (DN \<mu>))"
       proof -
         have "DN (src \<mu>) = src\<^sub>B (DN \<mu>)"
           using \<mu> DN_def arr_char E.eval_simps(2) E.Ide_implies_Arr
           apply simp
           by (metis (no_types, lifting) B.vconn_implies_hpar(1) E.Nml_implies_Arr ideE
               ide_src src_simps(3))
         moreover have "B.ide (DN (src \<mu>))"
           using \<mu> by simp
         ultimately show ?thesis
           using \<mu> B.isomorphic_reflexive by auto
       qed
       show "B.isomorphic (DN (trg \<mu>)) (trg\<^sub>B (DN \<mu>))"
       proof -
         have "DN (trg \<mu>) = trg\<^sub>B (DN \<mu>)"
           using \<mu> DN_def arr_char E.eval_simps(3) E.Ide_implies_Arr
           apply simp
           by (metis (no_types, lifting) B.vconn_implies_hpar(2) E.Nml_implies_Arr ideE
               ide_trg trg_simps(3))
         moreover have "B.ide (DN (trg \<mu>))"
           using \<mu> by simp
         ultimately show ?thesis
           using B.isomorphic_reflexive by auto
       qed
     qed
 
     interpretation "functor" VV.comp B.VV.comp DN.FF
       using DN.functor_FF by auto
     interpretation HoDN_DN: composite_functor VV.comp B.VV.comp V\<^sub>B
                       DN.FF \<open>\<lambda>\<mu>\<nu>. H\<^sub>B (fst \<mu>\<nu>) (snd \<mu>\<nu>)\<close> ..
     interpretation DNoH: composite_functor VV.comp vcomp V\<^sub>B
                       \<open>\<lambda>\<mu>\<nu>. fst \<mu>\<nu> \<star> snd \<mu>\<nu>\<close> DN ..
 
     abbreviation \<Psi>\<^sub>o
     where "\<Psi>\<^sub>o fg \<equiv> B.can (Dom (fst fg) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd fg)) (Dom (fst fg) \<^bold>\<star> Dom (snd fg))"
 
     abbreviation \<Psi>\<^sub>o'
     where "\<Psi>\<^sub>o' fg \<equiv> B.can (Dom (fst fg) \<^bold>\<star> Dom (snd fg)) (Dom (fst fg) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd fg))"
 
     lemma \<Psi>\<^sub>o_in_hom:
     assumes "VV.ide fg"
     shows "\<guillemotleft>\<Psi>\<^sub>o fg : Map (fst fg) \<star>\<^sub>B Map (snd fg) \<Rightarrow>\<^sub>B \<lbrace>Dom (fst fg) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd fg)\<rbrace>\<guillemotright>"
     and "\<guillemotleft>\<Psi>\<^sub>o' fg : \<lbrace>Dom (fst fg) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd fg)\<rbrace> \<Rightarrow>\<^sub>B Map (fst fg) \<star>\<^sub>B Map (snd fg)\<guillemotright>"
     and "B.inverse_arrows (\<Psi>\<^sub>o fg) (\<Psi>\<^sub>o' fg)"
     proof -
       have 1: "E.Ide (Dom (fst fg) \<^bold>\<star> Dom (snd fg))"
         unfolding E.Ide.simps(3)
         apply (intro conjI)
         using assms VV.ide_char VV.arr_char arr_char
           apply simp
         using VV.arr_char VV.ideD(1) assms
          apply blast
         by (metis (no_types, lifting) VV.arrE VV.ideD(1) assms src_simps(1) trg_simps(1))
       have 2: "E.Ide (Dom (fst fg) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd fg))"
         using 1
         by (meson E.Ide.simps(3) E.Ide_HcompNml VV.arr_char VV.ideD(1) arr_char assms)
       have 3: "\<^bold>\<lfloor>Dom (fst fg) \<^bold>\<star> Dom (snd fg)\<^bold>\<rfloor> = \<^bold>\<lfloor>Dom (fst fg) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd fg)\<^bold>\<rfloor>"
         by (metis (no_types, lifting) E.Ide.simps(3) E.Nml_HcompNml(1) E.Nmlize.simps(3)
             E.Nmlize_Nml VV.arr_char VV.ideD(1) arr_char assms 1)
       have 4: "\<lbrace>Dom (fst fg) \<^bold>\<star> Dom (snd fg)\<rbrace> = Map (fst fg) \<star>\<^sub>B Map (snd fg)"
         using assms VV.ide_char VV.arr_char arr_char by simp
       show "\<guillemotleft>\<Psi>\<^sub>o fg : Map (fst fg) \<star>\<^sub>B Map (snd fg) \<Rightarrow>\<^sub>B \<lbrace>Dom (fst fg) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd fg)\<rbrace>\<guillemotright>"
         using 1 2 3 4 by auto
       show "\<guillemotleft>\<Psi>\<^sub>o' fg : \<lbrace>Dom (fst fg) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd fg)\<rbrace> \<Rightarrow>\<^sub>B Map (fst fg) \<star>\<^sub>B Map (snd fg)\<guillemotright>"
         using 1 2 3 4 by auto
       show "B.inverse_arrows (\<Psi>\<^sub>o fg) (\<Psi>\<^sub>o' fg)"
         using 1 2 3 B.inverse_arrows_can by blast
     qed
 
     interpretation \<Psi>: transformation_by_components
                          VV.comp V\<^sub>B HoDN_DN.map DNoH.map \<Psi>\<^sub>o
     proof
       fix fg
       assume fg: "VV.ide fg"
       have 1: "\<lbrace>Dom (fst fg) \<^bold>\<star> Dom (snd fg)\<rbrace> = Map (fst fg) \<star>\<^sub>B Map (snd fg)"
         using fg VV.ide_char VV.arr_char arr_char by simp
       show "\<guillemotleft>\<Psi>\<^sub>o fg : HoDN_DN.map fg \<Rightarrow>\<^sub>B DNoH.map fg\<guillemotright>"
       proof
         show "B.arr (\<Psi>\<^sub>o fg)"
           using fg \<Psi>\<^sub>o_in_hom by blast
         show "B.dom (\<Psi>\<^sub>o fg) = HoDN_DN.map fg"
         proof -
           have "B.dom (\<Psi>\<^sub>o fg) = Map (fst fg) \<star>\<^sub>B Map (snd fg)"
             using fg \<Psi>\<^sub>o_in_hom by blast
           also have "... = HoDN_DN.map fg"
             using fg DN.FF_def DN_def VV.arr_char src_def trg_def VV.ide_char by auto
           finally show ?thesis by simp
         qed
         show "B.cod (\<Psi>\<^sub>o fg) = DNoH.map fg"
         proof -
           have "B.cod (\<Psi>\<^sub>o fg) = \<lbrace>Dom (fst fg) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd fg)\<rbrace>"
             using fg \<Psi>\<^sub>o_in_hom by blast
           also have "... = DNoH.map fg"
           proof -
             have "DNoH.map fg = 
                   B.can (Cod (fst fg) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod (snd fg)) (Cod (fst fg) \<^bold>\<star> Cod (snd fg)) \<cdot>\<^sub>B
                     (Map (fst fg) \<star>\<^sub>B Map (snd fg)) \<cdot>\<^sub>B
                       B.can (Dom (fst fg) \<^bold>\<star> Dom (snd fg)) (Dom (fst fg) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd fg))"
               using fg DN_def Map_hcomp VV.arr_char
               apply simp
               using VV.ideD(1) by blast
             also have "... =
                        B.can (Cod (fst fg) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod (snd fg)) (Cod (fst fg) \<^bold>\<star> Cod (snd fg)) \<cdot>\<^sub>B
                          B.can (Dom (fst fg) \<^bold>\<star> Dom (snd fg)) (Dom (fst fg) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd fg))"
             proof -
               have "(Map (fst fg) \<star>\<^sub>B Map (snd fg)) \<cdot>\<^sub>B
                       B.can (Dom (fst fg) \<^bold>\<star> Dom (snd fg)) (Dom (fst fg) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd fg)) =
                     B.can (Dom (fst fg) \<^bold>\<star> Dom (snd fg)) (Dom (fst fg) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd fg))"
                 using fg 1 \<Psi>\<^sub>o_in_hom B.comp_cod_arr by blast
               thus ?thesis by simp
             qed
             also have "... = \<lbrace>Dom (fst fg) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd fg)\<rbrace>"
             proof -
               have "B.can (Cod (fst fg) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod (snd fg)) (Cod (fst fg) \<^bold>\<star> Cod (snd fg)) = \<Psi>\<^sub>o fg"
                 using fg VV.ide_char Cod_ide by simp
               thus ?thesis
                 using fg 1 \<Psi>\<^sub>o_in_hom [of fg] B.comp_arr_inv' by fastforce
             qed
             finally show ?thesis by simp
           qed
           finally show ?thesis by blast
         qed
       qed
       next
       show "\<And>f. VV.arr f \<Longrightarrow>
                    \<Psi>\<^sub>o (VV.cod f) \<cdot>\<^sub>B HoDN_DN.map f = DNoH.map f \<cdot>\<^sub>B \<Psi>\<^sub>o (VV.dom f)"
       proof -
         fix \<mu>\<nu>
         assume \<mu>\<nu>: "VV.arr \<mu>\<nu>"
         show "\<Psi>\<^sub>o (VV.cod \<mu>\<nu>) \<cdot>\<^sub>B HoDN_DN.map \<mu>\<nu> = DNoH.map \<mu>\<nu> \<cdot>\<^sub>B \<Psi>\<^sub>o (VV.dom \<mu>\<nu>)"
         proof -
           have 1: "E.Ide (Dom (fst \<mu>\<nu>) \<^bold>\<star> Dom (snd \<mu>\<nu>))"
             unfolding E.Ide.simps(3)
             apply (intro conjI)
             using \<mu>\<nu> VV.ide_char VV.arr_char arr_char
               apply simp
             using VV.arr_char VV.ideD(1) \<mu>\<nu>
              apply blast
             by (metis (no_types, lifting) VV.arrE \<mu>\<nu> src_simps(1) trg_simps(1))
           have 2: "E.Ide (Dom (fst \<mu>\<nu>) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd \<mu>\<nu>))"
             using 1
             by (meson E.Ide.simps(3) E.Ide_HcompNml VV.arr_char VV.ideD(1) arr_char \<mu>\<nu>)
           have 3: "\<^bold>\<lfloor>Dom (fst \<mu>\<nu>) \<^bold>\<star> Dom (snd \<mu>\<nu>)\<^bold>\<rfloor> = \<^bold>\<lfloor>Dom (fst \<mu>\<nu>) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd \<mu>\<nu>)\<^bold>\<rfloor>"
             by (metis (no_types, lifting) E.Ide.simps(3) E.Nml_HcompNml(1) E.Nmlize.simps(3)
                E.Nmlize_Nml VV.arr_char arr_char \<mu>\<nu> 1)
           have 4: "E.Ide (Cod (fst \<mu>\<nu>) \<^bold>\<star> Cod (snd \<mu>\<nu>))"
             unfolding E.Ide.simps(3)
             apply (intro conjI)
             using \<mu>\<nu> VV.ide_char VV.arr_char arr_char
               apply simp
             using VV.arr_char VV.ideD(1) \<mu>\<nu>
              apply blast
             by (metis (no_types, lifting) "1" E.Ide.simps(3) VV.arrE \<mu>\<nu> arrE)
           have 5: "E.Ide (Cod (fst \<mu>\<nu>) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod (snd \<mu>\<nu>))"
             using 4
             by (meson E.Ide.simps(3) E.Ide_HcompNml VV.arr_char VV.ideD(1) arr_char \<mu>\<nu>)
           have 6: "\<^bold>\<lfloor>Cod (fst \<mu>\<nu>) \<^bold>\<star> Cod (snd \<mu>\<nu>)\<^bold>\<rfloor> = \<^bold>\<lfloor>Cod (fst \<mu>\<nu>) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod (snd \<mu>\<nu>)\<^bold>\<rfloor>"
             by (metis (no_types, lifting) E.Ide.simps(3) E.Nml_HcompNml(1) E.Nmlize.simps(3)
                E.Nmlize_Nml VV.arr_char arr_char \<mu>\<nu> 1)
           have A: "\<guillemotleft>\<Psi>\<^sub>o' \<mu>\<nu> : \<lbrace>Dom (fst \<mu>\<nu>) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom (snd \<mu>\<nu>)\<rbrace>
                                  \<Rightarrow>\<^sub>B \<lbrace>Dom (fst \<mu>\<nu>) \<^bold>\<star> Dom (snd \<mu>\<nu>)\<rbrace>\<guillemotright>"
             using 1 2 3 by auto
           have B: "\<guillemotleft>Map (fst \<mu>\<nu>) \<star>\<^sub>B Map (snd \<mu>\<nu>) :
                      \<lbrace>Dom (fst \<mu>\<nu>) \<^bold>\<star> Dom (snd \<mu>\<nu>)\<rbrace> \<Rightarrow>\<^sub>B \<lbrace>Cod (fst \<mu>\<nu>) \<^bold>\<star> Cod (snd \<mu>\<nu>)\<rbrace>\<guillemotright>"
             using \<mu>\<nu> VV.arr_char arr_char src_def trg_def E.Nml_implies_Arr E.eval_simps'(2-3)
             by auto
           have C: "\<guillemotleft>B.can (Cod (fst \<mu>\<nu>) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod (snd \<mu>\<nu>)) (Cod (fst \<mu>\<nu>) \<^bold>\<star> Cod (snd \<mu>\<nu>)) :
                      \<lbrace>Cod (fst \<mu>\<nu>) \<^bold>\<star> Cod (snd \<mu>\<nu>)\<rbrace> \<Rightarrow>\<^sub>B \<lbrace>Cod (fst \<mu>\<nu>) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod (snd \<mu>\<nu>)\<rbrace>\<guillemotright>"
             using 4 5 6 by auto
           have "\<Psi>\<^sub>o (VV.cod \<mu>\<nu>) \<cdot>\<^sub>B HoDN_DN.map \<mu>\<nu> =
                 B.can (Cod (fst \<mu>\<nu>) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod (snd \<mu>\<nu>)) (Cod (fst \<mu>\<nu>) \<^bold>\<star> Cod (snd \<mu>\<nu>)) \<cdot>\<^sub>B
                   (Map (fst \<mu>\<nu>) \<star>\<^sub>B Map (snd \<mu>\<nu>))"
             using \<mu>\<nu> VV.arr_char VV.cod_char arr_char src_def trg_def cod_char DN.FF_def DN_def
             by auto
           also have "... = B.can (Cod (fst \<mu>\<nu>) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod (snd \<mu>\<nu>))
                                  (Cod (fst \<mu>\<nu>) \<^bold>\<star> Cod (snd \<mu>\<nu>)) \<cdot>\<^sub>B
                              (Map (fst \<mu>\<nu>) \<star>\<^sub>B Map (snd \<mu>\<nu>)) \<cdot>\<^sub>B \<Psi>\<^sub>o' \<mu>\<nu> \<cdot>\<^sub>B \<Psi>\<^sub>o \<mu>\<nu>"
             using B B.comp_assoc \<mu>\<nu> VV.arr_char arr_char src_def trg_def B.inverse_arrows_can
                   E.Ide_HcompNml E.Nmlize_Nml E.Nml_HcompNml(1) B.can_Ide_self B.comp_arr_dom
             by auto
           also have "... = DNoH.map \<mu>\<nu> \<cdot>\<^sub>B \<Psi>\<^sub>o (VV.dom \<mu>\<nu>)"
           proof -
             have "DNoH.map \<mu>\<nu> \<cdot>\<^sub>B \<Psi>\<^sub>o (VV.dom \<mu>\<nu>) =
                   B.can (Cod (fst \<mu>\<nu>) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod (snd \<mu>\<nu>)) (Cod (fst \<mu>\<nu>) \<^bold>\<star> Cod (snd \<mu>\<nu>)) \<cdot>\<^sub>B
                     (Map (fst \<mu>\<nu>) \<star>\<^sub>B Map (snd \<mu>\<nu>)) \<cdot>\<^sub>B \<Psi>\<^sub>o' \<mu>\<nu> \<cdot>\<^sub>B \<Psi>\<^sub>o (VV.dom \<mu>\<nu>)"
               using \<mu>\<nu> DN_def VV.arr_char B.comp_assoc by simp
             moreover have "\<Psi>\<^sub>o (VV.dom \<mu>\<nu>) = \<Psi>\<^sub>o \<mu>\<nu>"
               using \<mu>\<nu> VV.dom_char VV.arr_char by auto
             ultimately show ?thesis
               using B.comp_assoc by simp
           qed
           finally show ?thesis by blast
         qed
       qed
     qed
 
     abbreviation \<Psi>
     where "\<Psi> \<equiv> \<Psi>.map"
 
     interpretation \<Psi>: natural_isomorphism VV.comp V\<^sub>B HoDN_DN.map DNoH.map \<Psi>
     proof
       show "\<And>fg. VV.ide fg \<Longrightarrow> B.iso (\<Psi> fg)"
       proof -
         fix fg
         assume fg: "VV.ide fg"
         have "B.inverse_arrows (\<Psi>\<^sub>o fg) (\<Psi>\<^sub>o' fg)"
           using fg \<Psi>\<^sub>o_in_hom by simp
         thus "B.iso (\<Psi> fg)"
           using fg B.iso_def \<Psi>.map_simp_ide by auto
       qed
     qed
 
     no_notation B.in_hom  ("\<guillemotleft>_ : _ \<rightarrow>\<^sub>B _\<guillemotright>")
 
     lemma \<Psi>_in_hom [intro]:
     assumes "arr (fst \<mu>\<nu>)" and "arr (snd \<mu>\<nu>)" and "src (fst \<mu>\<nu>) = trg (snd \<mu>\<nu>)"
     shows "\<guillemotleft>\<Psi> \<mu>\<nu> : DN (src (snd \<mu>\<nu>)) \<rightarrow>\<^sub>B DN (trg (fst \<mu>\<nu>))\<guillemotright>"
     and "\<guillemotleft>\<Psi> \<mu>\<nu> : DN (dom (fst \<mu>\<nu>)) \<star>\<^sub>B DN (dom (snd \<mu>\<nu>))
                     \<Rightarrow>\<^sub>B DN (cod (fst \<mu>\<nu>) \<star> cod (snd \<mu>\<nu>))\<guillemotright>"
     proof -
       have 1: "VV.arr \<mu>\<nu>"
         using assms VV.arr_char by simp
       show 2: "\<guillemotleft>\<Psi> \<mu>\<nu> : DN (dom (fst \<mu>\<nu>)) \<star>\<^sub>B DN (dom (snd \<mu>\<nu>))
                           \<Rightarrow>\<^sub>B DN (cod (fst \<mu>\<nu>) \<star> cod (snd \<mu>\<nu>))\<guillemotright>"
       proof -
         have "HoDN_DN.map (VV.dom \<mu>\<nu>) = DN (dom (fst \<mu>\<nu>)) \<star>\<^sub>B DN (dom (snd \<mu>\<nu>))"
           using assms 1 DN.FF_def by auto
         moreover have "DNoH.map (VV.cod \<mu>\<nu>) = DN (cod (fst \<mu>\<nu>) \<star> cod (snd \<mu>\<nu>))"
           using assms 1 by simp
         ultimately show ?thesis
           using assms 1 \<Psi>.preserves_hom by auto
       qed
       show "\<guillemotleft>\<Psi> \<mu>\<nu> : DN (src (snd \<mu>\<nu>)) \<rightarrow>\<^sub>B DN (trg (fst \<mu>\<nu>))\<guillemotright>"
         using assms 1 2 B.src_dom [of "\<Psi> \<mu>\<nu>"] B.trg_dom [of "\<Psi> \<mu>\<nu>"] by auto
     qed
 
     lemma \<Psi>_simps [simp]:
     assumes "arr (fst \<mu>\<nu>)" and "arr (snd \<mu>\<nu>)" and "src (fst \<mu>\<nu>) = trg (snd \<mu>\<nu>)"
     shows "B.arr (\<Psi> \<mu>\<nu>)"
     and "src\<^sub>B (\<Psi> \<mu>\<nu>) = DN (src (snd \<mu>\<nu>))" and "trg\<^sub>B (\<Psi> \<mu>\<nu>) = DN (trg (fst \<mu>\<nu>))"
     and "B.dom (\<Psi> \<mu>\<nu>) = DN (dom (fst \<mu>\<nu>)) \<star>\<^sub>B DN (dom (snd \<mu>\<nu>))"
     and "B.cod (\<Psi> \<mu>\<nu>) = DN (cod (fst \<mu>\<nu>) \<star> cod (snd \<mu>\<nu>))"
     proof
       show "VV.arr \<mu>\<nu>"
         using assms by blast
       have 1: "\<guillemotleft>\<Psi> \<mu>\<nu> : DN (src (snd \<mu>\<nu>)) \<rightarrow>\<^sub>B DN (trg (fst \<mu>\<nu>))\<guillemotright>"
         using assms by blast
       show "src\<^sub>B (\<Psi> \<mu>\<nu>) = DN (src (snd \<mu>\<nu>))"
         using 1 by fast
       show "trg\<^sub>B (\<Psi> \<mu>\<nu>) = DN (trg (fst \<mu>\<nu>))"
         using 1 by fast
       have 2: "\<guillemotleft>\<Psi> \<mu>\<nu> : DN (dom (fst \<mu>\<nu>)) \<star>\<^sub>B DN (dom (snd \<mu>\<nu>))
                           \<Rightarrow>\<^sub>B DN (cod (fst \<mu>\<nu>) \<star> cod (snd \<mu>\<nu>))\<guillemotright>"
         using assms by blast
       show "B.dom (\<Psi> \<mu>\<nu>) = DN (dom (fst \<mu>\<nu>)) \<star>\<^sub>B DN (dom (snd \<mu>\<nu>))"
         using 2 by fast
       show "B.cod (\<Psi> \<mu>\<nu>) = DN (cod (fst \<mu>\<nu>) \<star> cod (snd \<mu>\<nu>))"
         using 2 by fast
     qed
 
     interpretation DN: pseudofunctor vcomp hcomp \<a> \<i> src trg V\<^sub>B H\<^sub>B \<a>\<^sub>B \<i>\<^sub>B src\<^sub>B trg\<^sub>B DN \<Psi>
     proof
       show "\<And>f g h. \<lbrakk> ide f; ide g; ide h; src f = trg g; src g = trg h \<rbrakk> \<Longrightarrow>
                        DN (\<a> f g h) \<cdot>\<^sub>B \<Psi> (f \<star> g, h) \<cdot>\<^sub>B (\<Psi> (f, g) \<star>\<^sub>B DN h) =
                        \<Psi> (f, g \<star> h) \<cdot>\<^sub>B (DN f \<star>\<^sub>B \<Psi> (g, h)) \<cdot>\<^sub>B \<a>\<^sub>B[DN f, DN g, DN h]"
       proof -
         fix f g h
         assume f: "ide f" and g: "ide g" and h: "ide h"
         and fg: "src f = trg g" and gh: "src g = trg h"
         show "DN (\<a> f g h) \<cdot>\<^sub>B \<Psi> (f \<star> g, h) \<cdot>\<^sub>B (\<Psi> (f, g) \<star>\<^sub>B DN h) =
               \<Psi> (f, g \<star> h) \<cdot>\<^sub>B (DN f \<star>\<^sub>B \<Psi> (g, h)) \<cdot>\<^sub>B \<a>\<^sub>B[DN f, DN g, DN h]"
         proof -
           have 1: "E.Trg (Dom g) = E.Trg (Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) \<and>
                    \<lbrace>E.Trg (Dom g)\<rbrace> = \<lbrace>E.Trg (Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h)\<rbrace>"
             using f g h fg gh arr_char src_def trg_def E.Trg_HcompNml
             by (metis (no_types, lifting) ideD(1) src_simps(2) trg_simps(2))
           have 2: "arr (MkArr (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) (Cod f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod h)
                        (B.can (Cod f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod h) (Cod f \<^bold>\<star> Cod g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod h) \<cdot>\<^sub>B
                           (Map f \<star>\<^sub>B B.can (Cod g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod h) (Cod g \<^bold>\<star> Cod h) \<cdot>\<^sub>B
                           (Map g \<star>\<^sub>B Map h) \<cdot>\<^sub>B B.can (Dom g \<^bold>\<star> Dom h) (Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h)) \<cdot>\<^sub>B
                           B.can (Dom f \<^bold>\<star> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h)))"
           proof -
             have "\<guillemotleft>B.can (Cod f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod h) (Cod f \<^bold>\<star> Cod g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod h) \<cdot>\<^sub>B
                      (Map f \<star>\<^sub>B
                         B.can (Cod g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod h) (Cod g \<^bold>\<star> Cod h) \<cdot>\<^sub>B
                           (Map g \<star>\<^sub>B Map h) \<cdot>\<^sub>B B.can (Dom g \<^bold>\<star> Dom h) (Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h)) \<cdot>\<^sub>B
                           B.can (Dom f \<^bold>\<star> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) :
                      EVAL (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) \<Rightarrow>\<^sub>B EVAL (Cod f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod h)\<guillemotright>"
             proof (intro B.comp_in_homI)
               show 2: "\<guillemotleft>B.can (Dom f \<^bold>\<star> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) :
                           EVAL (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) \<Rightarrow>\<^sub>B
                             EVAL (Dom f \<^bold>\<star> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h)\<guillemotright>"
                 using f g h fg gh 1
                 apply (intro B.can_in_hom)
                   apply (metis (no_types, lifting) E.Ide_HcompNml E.Nml_HcompNml(1)
                     arr_char ideD(1) src_simps(1) trg_simps(1))
                  apply (metis (no_types, lifting) E.Ide.simps(3) E.Ide_HcompNml ideD(1)
                     arr_char src_simps(1) trg_simps(1))
                 by (metis (no_types, lifting) E.Nml_HcompNml(1) E.Nmlize.simps(3)
                     E.Nmlize_Nml ideD(1) arr_char src_simps(1) trg_simps(1))
               show "\<guillemotleft>B.can (Cod f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod h) (Cod f \<^bold>\<star> Cod g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod h) :
                        EVAL (Cod f \<^bold>\<star> Cod g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod h) \<Rightarrow>\<^sub>B
                          EVAL (Cod f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod h)\<guillemotright>"
               proof -
                 have "E.Ide (Cod f \<^bold>\<star> Cod g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod h)"
                   using f g h fg gh 1 Cod_ide E.Ide_HcompNml arr_char
                   apply simp
                   by (metis (no_types, lifting) ideD(1) src_simps(1) trg_simps(1))
                 moreover have "E.Ide (Cod f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod h)"
                   using f g h fg gh
                   by (metis (no_types, lifting) E.Ide.simps(3) E.Ide_HcompNml E.Nml_HcompNml(1)
                       arr_char calculation ideD(1) src_simps(1) trg_simps(1))
                 moreover have "E.Nmlize (Cod f \<^bold>\<star> Cod g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod h) =
                                E.Nmlize (Cod f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod h)"
                   using f g h fg gh
                   by (metis (no_types, lifting) E.Ide.simps(3) E.Nml_HcompNml(1) E.Nmlize.simps(3)
                       E.Nmlize_Nml arr_char calculation(1) ideD(1) src_simps(1) trg_simps(1))
                 ultimately show ?thesis
                   using B.can_in_hom [of "Cod f \<^bold>\<star> Cod g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod h" "Cod f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod h"]
                   by blast
               qed
               show
                 "\<guillemotleft>Map f \<star>\<^sub>B B.can (Cod g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod h) (Cod g \<^bold>\<star> Cod h) \<cdot>\<^sub>B (Map g \<star>\<^sub>B Map h) \<cdot>\<^sub>B
                   B.can (Dom g \<^bold>\<star> Dom h) (Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) :
                     EVAL (Dom f \<^bold>\<star> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) \<Rightarrow>\<^sub>B EVAL (Cod f \<^bold>\<star> Cod g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod h)\<guillemotright>"
                 using f g h fg gh B.can_in_hom
                 apply simp
               proof (intro B.hcomp_in_vhom B.comp_in_homI)
                 show 1: "\<guillemotleft>B.can (Dom g \<^bold>\<star> Dom h) (Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) :
                             EVAL (Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) \<Rightarrow>\<^sub>B EVAL (Dom g \<^bold>\<star> Dom h)\<guillemotright>"
                   using g h gh B.can_in_hom
                   by (metis (no_types, lifting) E.Ide.simps(3) E.Ide_HcompNml E.Nml_HcompNml(1)
                       E.Nmlize.simps(3) E.Nmlize_Nml arr_char ideD(1) src_simps(1) trg_simps(1))
                 show "\<guillemotleft>B.can (Cod g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod h) (Cod g \<^bold>\<star> Cod h) :
                          EVAL (Cod g \<^bold>\<star> Cod h) \<Rightarrow>\<^sub>B EVAL (Cod g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod h)\<guillemotright>"
                   using g h gh B.can_in_hom
                   by (metis (no_types, lifting) Cod_ide E.Ide.simps(3) E.Ide_HcompNml
                       E.Nml_HcompNml(1) E.Nmlize.simps(3) E.Nmlize_Nml arr_char ideD(1)
                       src_simps(2) trg_simps(2))
                 show "\<guillemotleft>Map g \<star>\<^sub>B Map h : EVAL (Dom g \<^bold>\<star> Dom h) \<Rightarrow>\<^sub>B EVAL (Cod g \<^bold>\<star> Cod h)\<guillemotright>"
                   using g h gh 1 Map_in_Hom B.hcomp_in_vhom B.not_arr_null B.seq_if_composable
                         B.trg.is_extensional B.trg.preserves_hom B.vconn_implies_hpar(2)
                         B.vconn_implies_hpar(4) Cod_ide E.eval.simps(3) Map_ide(1)
                         arr_char ideD(1)
                   by (metis (no_types, lifting))
                 show "\<guillemotleft>Map f : Map f \<Rightarrow>\<^sub>B EVAL (Cod f)\<guillemotright>"
                   using f arr_char Cod_ide by auto
                 show "src\<^sub>B (Map f) = trg\<^sub>B \<lbrace>Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h\<rbrace>"
                   using f g h fg gh 1 2 src_def trg_def B.arrI B.hseqE B.not_arr_null
                         B.trg.is_extensional B.trg.preserves_hom B.vconn_implies_hpar(2)
                         B.vconn_implies_hpar(4) E.eval.simps(3)
                   by (metis (no_types, lifting) Map_ide(1))
               qed
             qed
             thus ?thesis
               using f g h fg gh arr_char src_def trg_def E.Nml_HcompNml E.Ide_HcompNml
                     ideD(1)
               apply (intro arr_MkArr) by auto
           qed
           have 3: "E.Ide (Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h)"
             using g h gh ide_char arr_char src_def trg_def E.Ide_HcompNml Cod_ide
             by (metis (no_types, lifting) ideD(1) src_simps(2) trg_simps(2))
           have 4: "E.Ide (Dom g \<^bold>\<star> Dom h)"
             using g h gh ide_char arr_char src_def trg_def Cod_ide
             by (metis (no_types, lifting) E.Ide.simps(3) arrE ideD(1) src_simps(2) trg_simps(2))
           have 5: "E.Nmlize (Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) = E.Nmlize (Dom g \<^bold>\<star> Dom h)"
             using g h gh ide_char arr_char src_def trg_def E.Nml_HcompNml
             by (metis (no_types, lifting) 4 E.Ide.simps(3) E.Nmlize.simps(3) E.Nmlize_Nml
                 ideD(1))
           have 6: "E.Ide (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h)"
             using f g h fg gh arr_char src_def trg_def
             by (metis (no_types, lifting) 1 E.Nml_HcompNml(1) E.Ide_HcompNml ideD(1)
                 src_simps(2) trg_simps(2))
           have 7: "E.Ide (Dom f \<^bold>\<star> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h)"
             using f g h fg gh arr_char src_def trg_def
             by (metis (no_types, lifting) 1 3 E.Ide.simps(3) ideD(1) src_simps(2) trg_simps(2))
           have 8: "E.Nmlize (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) =
                    E.Nmlize (Dom f \<^bold>\<star> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h)"
             using f g h fg gh arr_char src_def trg_def
                   7 E.Nml_HcompNml(1) ideD(1)
             by auto
           have "DN (\<a> f g h) \<cdot>\<^sub>B \<Psi> (f \<star> g, h) \<cdot>\<^sub>B (\<Psi> (f, g) \<star>\<^sub>B DN h) =
                 B.can (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) ((Dom f \<^bold>\<star> Dom g) \<^bold>\<star> Dom h)"
           proof -
             have 9: "VVV.arr (f, g, h)"
               using f g h fg gh VVV.arr_char VV.arr_char arr_char ideD by simp
             have 10: "VV.ide (f, g)"
               using f g fg VV.ide_char by auto
             have 11: "VV.ide (hcomp f g, h)"
               using f g h fg gh VV.ide_char VV.arr_char by simp
             have 12: "arr (MkArr (Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) (Cod g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod h)
                                 (B.can (Cod g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod h) (Cod g \<^bold>\<star> Cod h) \<cdot>\<^sub>B
                                   (Map g \<star>\<^sub>B Map h) \<cdot>\<^sub>B
                                   B.can (Dom g \<^bold>\<star> Dom h) (Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h)))"
             proof (intro arr_MkArr)
               show "Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h \<in> IDE"
                 using g h gh
                 by (metis (no_types, lifting) 3 E.Nml_HcompNml(1) arr_char ideD(1)
                     mem_Collect_eq src_simps(2) trg_simps(2))
               show "Cod g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod h \<in> IDE"
                 using g h gh Cod_ide \<open>Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h \<in> IDE\<close> by auto
               show "B.can (Cod g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod h) (Cod g \<^bold>\<star> Cod h) \<cdot>\<^sub>B
                       (Map g \<star>\<^sub>B Map h) \<cdot>\<^sub>B
                       B.can (Dom g \<^bold>\<star> Dom h) (Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h)
                     \<in> HOM (Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) (Cod g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod h)"
               proof
                 show "E.Src (Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) = E.Src (Cod g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod h) \<and>
                       E.Trg (Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) = E.Trg (Cod g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod h) \<and>
                       \<guillemotleft>B.can (Cod g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod h) (Cod g \<^bold>\<star> Cod h) \<cdot>\<^sub>B
                          (Map g \<star>\<^sub>B Map h) \<cdot>\<^sub>B B.can (Dom g \<^bold>\<star> Dom h) (Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) :
                          \<lbrace>Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h\<rbrace> \<Rightarrow>\<^sub>B \<lbrace>Cod g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod h\<rbrace>\<guillemotright>"
                 proof (intro conjI)
                   show "E.Src (Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) = E.Src (Cod g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod h)"
                     using g h gh Cod_ide by simp
                   show "E.Trg (Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) = E.Trg (Cod g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod h)"
                     using g h gh Cod_ide by simp
                   show "\<guillemotleft>B.can (Cod g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod h) (Cod g \<^bold>\<star> Cod h) \<cdot>\<^sub>B
                            (Map g \<star>\<^sub>B Map h) \<cdot>\<^sub>B B.can (Dom g \<^bold>\<star> Dom h) (Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) :
                            \<lbrace>Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h\<rbrace> \<Rightarrow>\<^sub>B \<lbrace>Cod g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod h\<rbrace>\<guillemotright>"
                   proof (intro B.comp_in_homI)
                     show "\<guillemotleft>B.can (Dom g \<^bold>\<star> Dom h) (Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) :
                              \<lbrace>Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h\<rbrace> \<Rightarrow>\<^sub>B \<lbrace>Dom g \<^bold>\<star> Dom h\<rbrace>\<guillemotright>"
                       using 3 4 5 by blast
                     show "\<guillemotleft>Map g \<star>\<^sub>B Map h : \<lbrace>Dom g \<^bold>\<star> Dom h\<rbrace> \<Rightarrow>\<^sub>B \<lbrace>Cod g \<^bold>\<star> Cod h\<rbrace>\<guillemotright>"
                       using g h gh
                       by (metis (no_types, lifting) 4 B.ide_in_hom(2) Cod_ide E.eval.simps(3)
                           E.ide_eval_Ide Map_ide(2))
                     show "\<guillemotleft>B.can (Cod g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod h) (Cod g \<^bold>\<star> Cod h) :
                             \<lbrace>Cod g \<^bold>\<star> Cod h\<rbrace> \<Rightarrow>\<^sub>B \<lbrace>Cod g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Cod h\<rbrace>\<guillemotright>"
                       using 3 4 5 Cod_ide g h by auto
                   qed
                 qed
               qed
             qed
             have "DN (\<a> f g h) = \<lbrace>Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h\<rbrace>"
             proof -
               have "DN (\<a> f g h) =
                     (B.can (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) (Dom f \<^bold>\<star> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) \<cdot>\<^sub>B
                       ((Map f \<star>\<^sub>B B.can (Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) (Dom g \<^bold>\<star> Dom h) \<cdot>\<^sub>B
                          (Map g \<star>\<^sub>B Map h) \<cdot>\<^sub>B B.can (Dom g \<^bold>\<star> Dom h) (Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h))) \<cdot>\<^sub>B
                       B.can (Dom f \<^bold>\<star> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h))"
                 using f g h fg gh 1 2 9 10 11 12 DN_def \<a>_def hcomp_def src_def trg_def
                       B.comp_assoc Cod_ide
                 by simp
               also have
                 "... = B.can (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) (Dom f \<^bold>\<star> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) \<cdot>\<^sub>B
                          (Map f \<star>\<^sub>B \<lbrace>Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h\<rbrace>) \<cdot>\<^sub>B
                            B.can (Dom f \<^bold>\<star> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h)"
               proof -
                 have "\<guillemotleft>B.can (Dom g \<^bold>\<star> Dom h) (Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) :
                                     \<lbrace>Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h\<rbrace> \<Rightarrow>\<^sub>B Map g \<star>\<^sub>B Map h\<guillemotright>"
                   using g h 3 4 5 B.can_in_hom [of "Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h" "Dom g \<^bold>\<star> Dom h"]
                   by simp
                 hence "Map f \<star>\<^sub>B B.can (Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) (Dom g \<^bold>\<star> Dom h) \<cdot>\<^sub>B
                                  (Map g \<star>\<^sub>B Map h) \<cdot>\<^sub>B B.can (Dom g \<^bold>\<star> Dom h) (Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) =
                        Map f \<star>\<^sub>B B.can (Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) (Dom g \<^bold>\<star> Dom h) \<cdot>\<^sub>B
                                  B.can (Dom g \<^bold>\<star> Dom h) (Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h)"
                   using B.comp_cod_arr by auto
                 also have "... = Map f \<star>\<^sub>B \<lbrace>Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h\<rbrace>"
                   using f g h fg gh arr_char src_def trg_def B.vcomp_can
                         B.can_Ide_self
                   using 3 4 5 by auto
                 finally have "Map f \<star>\<^sub>B B.can (Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) (Dom g \<^bold>\<star> Dom h) \<cdot>\<^sub>B
                                  (Map g \<star>\<^sub>B Map h) \<cdot>\<^sub>B B.can (Dom g \<^bold>\<star> Dom h) (Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) =
                               Map f \<star>\<^sub>B \<lbrace>Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h\<rbrace>"
                   by simp
                 thus ?thesis by simp
               qed
               also have
                 "... = B.can (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) (Dom f \<^bold>\<star> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) \<cdot>\<^sub>B
                          B.can (Dom f \<^bold>\<star> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h)"
               proof -
                 have "\<guillemotleft>B.can (Dom f \<^bold>\<star> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) :
                                \<lbrace>Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h\<rbrace> \<Rightarrow>\<^sub>B Map f \<star>\<^sub>B \<lbrace>Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h\<rbrace>\<guillemotright>"
                   using f g h 6 7 8
                         B.can_in_hom [of "Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h" "Dom f \<^bold>\<star> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h"]
                   by simp
                 hence "(Map f \<star>\<^sub>B \<lbrace>Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h\<rbrace>) \<cdot>\<^sub>B
                          B.can (Dom f \<^bold>\<star> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) =
                        B.can (Dom f \<^bold>\<star> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h)"
                   using B.comp_cod_arr by auto
                 thus ?thesis by simp
               qed
               also have
                 "... = B.can (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h)"
                 using f g h fg gh src_def trg_def B.vcomp_can
                 using 6 7 8 by auto
               also have "... = \<lbrace>Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h\<rbrace>"
                 using f g h fg gh src_def trg_def B.can_Ide_self
                 using 6 by blast
               finally show ?thesis by simp
             qed
             have "DN (\<a> f g h) \<cdot>\<^sub>B \<Psi> (f \<star> g, h) \<cdot>\<^sub>B (\<Psi> (f, g) \<star>\<^sub>B DN h) =
                   B.can (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) ((Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) \<cdot>\<^sub>B
                   B.can ((Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) ((Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g) \<^bold>\<star> Dom h) \<cdot>\<^sub>B
                     (B.can (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g) (Dom f \<^bold>\<star> Dom g) \<star>\<^sub>B Map h)"
             proof -
               have "DN (\<a> f g h) =
                     B.can (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) ((Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h)"
                 using f g h fg gh DN_def 1 4 6 7 B.can_Ide_self E.HcompNml_assoc
                       E.Ide.simps(3) \<open>DN (\<a> f g h) = \<lbrace>Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h\<rbrace>\<close> ide_char
                 by (metis (no_types, lifting) arr_char ideD(1))
               thus ?thesis
                 using f g h fg gh 1 2 4 5 6 7 8 9 10 11 12 DN_def \<alpha>_def
                       \<Psi>.map_simp_ide hcomp_def src_def trg_def Cod_ide
                 by simp
             qed
             also have
               "... = (B.can (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) ((Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) \<cdot>\<^sub>B
                        B.can ((Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) ((Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g) \<^bold>\<star> Dom h)) \<cdot>\<^sub>B
                         (B.can (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g) (Dom f \<^bold>\<star> Dom g) \<star>\<^sub>B Map h)"
               using B.comp_assoc by simp
             also have
               "... = B.can (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) ((Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g) \<^bold>\<star> Dom h) \<cdot>\<^sub>B
                        B.can ((Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g) \<^bold>\<star> Dom h) ((Dom f \<^bold>\<star> Dom g) \<^bold>\<star> Dom h)"
             proof -
               have "B.can (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g) (Dom f \<^bold>\<star> Dom g) \<star>\<^sub>B Map h =
                     B.can ((Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g) \<^bold>\<star> Dom h) ((Dom f \<^bold>\<star> Dom g) \<^bold>\<star> Dom h)"
               proof -
                 have "B.can (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g) (Dom f \<^bold>\<star> Dom g) \<star>\<^sub>B Map h =
                       B.can (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g) (Dom f \<^bold>\<star> Dom g) \<star>\<^sub>B B.can (Dom h) (Dom h)"
                   using h B.can_Ide_self by fastforce
                 also have "... = B.can ((Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g) \<^bold>\<star> Dom h) ((Dom f \<^bold>\<star> Dom g) \<^bold>\<star> Dom h)"
                   using f g h 1 4 7 arr_char E.Nml_HcompNml(1) E.Src_HcompNml
                         B.hcomp_can [of "Dom f \<^bold>\<star> Dom g" "Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g" "Dom h" "Dom h"]
                   by (metis (no_types, lifting) E.Nmlize.simps(3) E.Nmlize_Nml
                       E.Ide.simps(3) E.Ide_HcompNml E.Src.simps(3) arrE ideD(1))
                 finally show ?thesis by simp
               qed
               moreover have
                 "B.can (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) ((Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) \<cdot>\<^sub>B
                    B.can ((Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) ((Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g) \<^bold>\<star> Dom h) =
                      B.can (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) ((Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g) \<^bold>\<star> Dom h)"
               proof -
                 have "E.Ide ((Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g) \<^bold>\<star> Dom h)"
                   using f g h 1 4 7
                   by (metis (no_types, lifting) E.Ide.simps(3) E.Ide_HcompNml E.Src_HcompNml
                       arrE ideD(1))
                 moreover have "E.Ide ((Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h)"
                   using f g h 1 4 7 E.Ide_HcompNml E.Nml_HcompNml(1) arr_char calculation
                         ideD(1)
                   by auto
                 moreover have "E.Ide (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h)"
                   using f g h 1 4 6 by blast
                 moreover have "E.Nmlize ((Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g) \<^bold>\<star> Dom h) =
                                E.Nmlize ((Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h)"
                   using f g h 1 4 7
                   by (metis (no_types, lifting) E.Nml_HcompNml(1) E.Nmlize.simps(3)
                       E.Nmlize_Nml E.Ide.simps(3) arrE calculation(1) ideD(1))
                 moreover have "E.Nmlize ((Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g) \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) =
                                E.Nmlize (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h)"
                   using f g h 1 4 7 E.HcompNml_assoc by fastforce
                 ultimately show ?thesis
                   using B.vcomp_can by simp
               qed
               ultimately show ?thesis by simp
             qed
             also have "... = B.can (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) ((Dom f \<^bold>\<star> Dom g) \<^bold>\<star> Dom h)"
             proof -
               have "E.Ide ((Dom f \<^bold>\<star> Dom g) \<^bold>\<star> Dom h)"
                 using 1 4 7 by simp
               moreover have "E.Ide ((Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g) \<^bold>\<star> Dom h)"
                 using f g 1 4 7
                 by (metis (no_types, lifting) E.Ide.simps(3) E.Ide_HcompNml E.Src_HcompNml
                     arrE ideD(1))
               moreover have "E.Ide (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h)"
                 using f g h 1 8 6 7 by blast
               moreover have "E.Nmlize ((Dom f \<^bold>\<star> Dom g) \<^bold>\<star> Dom h) =
                              E.Nmlize ((Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g) \<^bold>\<star> Dom h)"
                 using f g h 1 4 7 E.Nml_HcompNml(1) by fastforce
               moreover have "E.Nmlize ((Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g) \<^bold>\<star> Dom h) =
                              E.Nmlize (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h)"
                 using f g h 1 4 7
                 by (metis (no_types, lifting) E.Nml_HcompNml(1) E.Nmlize.simps(3)
                     E.Nmlize_Nml E.HcompNml_assoc E.Ide.simps(3) arrE ideD(1))
               ultimately show ?thesis
                 using B.vcomp_can by simp
             qed
             finally show ?thesis by simp
           qed
           also have "... = \<Psi> (f, g \<star> h) \<cdot>\<^sub>B (DN f \<star>\<^sub>B \<Psi> (g, h)) \<cdot>\<^sub>B \<a>\<^sub>B[DN f, DN g, DN h]"
           proof -
             have "\<Psi> (f, g \<star> h) \<cdot>\<^sub>B (DN f \<star>\<^sub>B \<Psi> (g, h)) \<cdot>\<^sub>B \<a>\<^sub>B[DN f, DN g, DN h] =
                   (\<Psi> (f, g \<star> h) \<cdot>\<^sub>B (DN f \<star>\<^sub>B \<Psi> (g, h))) \<cdot>\<^sub>B \<a>\<^sub>B[DN f, DN g, DN h]"
               using B.comp_assoc by simp
             also have
               "... = B.can (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) (Dom f \<^bold>\<star> Dom g \<^bold>\<star> Dom h) \<cdot>\<^sub>B
                        B.can (Dom f \<^bold>\<star> Dom g \<^bold>\<star> Dom h) ((Dom f \<^bold>\<star> Dom g) \<^bold>\<star> Dom h)"
             proof -
               have "\<Psi> (f, g \<star> h) \<cdot>\<^sub>B (DN f \<star>\<^sub>B \<Psi> (g, h)) =
                     B.can (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) (Dom f \<^bold>\<star> Dom g \<^bold>\<star> Dom h)"
               proof -
                 have "\<Psi> (f, g \<star> h) \<cdot>\<^sub>B (DN f \<star>\<^sub>B \<Psi> (g, h)) =
                       B.can (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) (Dom f \<^bold>\<star> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) \<cdot>\<^sub>B
                             (Map f \<star>\<^sub>B B.can (Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) (Dom g \<^bold>\<star> Dom h))"
                proof -
                   have "VV.ide (g, h)"
                     using g h gh VV.ide_char VV.arr_char by simp
                   moreover have "VV.ide (f, hcomp g h)"
                     using f g h fg gh VV.ide_char VV.arr_char by simp
                   ultimately show ?thesis
                     using f g h fg gh \<Psi>.map_simp_ide DN_def hcomp_def src_def trg_def
                     by simp
                 qed
                 also have
                   "... = B.can (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) (Dom f \<^bold>\<star> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) \<cdot>\<^sub>B
                            (B.can (Dom f) (Dom f) \<star>\<^sub>B B.can (Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) (Dom g \<^bold>\<star> Dom h))"
                 proof -
                   have "Map f = B.can (Dom f) (Dom f)"
                     using f arr_char B.can_Ide_self [of "Dom f"] Map_ide
                     by (metis (no_types, lifting) ide_char')
                   thus ?thesis by simp
                 qed
                 also have
                   "... = B.can (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) (Dom f \<^bold>\<star> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) \<cdot>\<^sub>B
                          B.can (Dom f \<^bold>\<star> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) (Dom f \<^bold>\<star> Dom g \<^bold>\<star> Dom h)"
                   using 1 4 5 7 B.hcomp_can by auto
                 also have "... = B.can (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) (Dom f \<^bold>\<star> Dom g \<^bold>\<star> Dom h)"
                   using 1 4 5 6 7 8 B.vcomp_can by auto
                 finally show ?thesis by simp
               qed
               moreover have "\<a>\<^sub>B[DN f, DN g, DN h] =
                              B.can (Dom f \<^bold>\<star> Dom g \<^bold>\<star> Dom h) ((Dom f \<^bold>\<star> Dom g) \<^bold>\<star> Dom h)"
                 using f g h 1 4 7 DN_def B.canE_associator(1) Map_ide
                 by auto
               ultimately show ?thesis by simp
             qed
             also have  "... = B.can (Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h) ((Dom f \<^bold>\<star> Dom g) \<^bold>\<star> Dom h)"
               using 1 4 5 6 7 8 E.Nmlize_Hcomp_Hcomp
                     B.vcomp_can [of "(Dom f \<^bold>\<star> Dom g) \<^bold>\<star> Dom h" "Dom f \<^bold>\<star> Dom g \<^bold>\<star> Dom h"
                                     "Dom f \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom g \<^bold>\<lfloor>\<^bold>\<star>\<^bold>\<rfloor> Dom h"]
               by simp
             finally show ?thesis by simp
           qed
           finally show ?thesis by blast
         qed
       qed
     qed
 
     lemma DN_is_pseudofunctor:
     shows "pseudofunctor vcomp hcomp \<a> \<i> src trg V\<^sub>B H\<^sub>B \<a>\<^sub>B \<i>\<^sub>B src\<^sub>B trg\<^sub>B DN \<Psi>"
       ..
 
     interpretation faithful_functor vcomp V\<^sub>B DN
     proof
       fix \<mu> \<mu>'
       assume par: "par \<mu> \<mu>'" and eq: "DN \<mu> = DN \<mu>'"
       show "\<mu> = \<mu>'"
       proof (intro arr_eqI)
         show "arr \<mu>"
           using par by simp
         show "arr \<mu>'"
           using par by simp
         show "Dom \<mu> = Dom \<mu>'"
           using par arr_char dom_char by force
         show "Cod \<mu> = Cod \<mu>'"
           using par arr_char cod_char by force
         show "Map \<mu> = Map \<mu>'"
           using par eq DN_def by simp
       qed
     qed
 
     no_notation B.in_hom  ("\<guillemotleft>_ : _ \<rightarrow>\<^sub>B _\<guillemotright>")
 
     lemma DN_UP:
     assumes "B.arr \<mu>"
     shows "DN (UP \<mu>) = \<mu>"
       using assms UP_def DN_def arr_UP by auto
 
     interpretation DN: equivalence_pseudofunctor
                          vcomp hcomp \<a> \<i> src trg V\<^sub>B H\<^sub>B \<a>\<^sub>B \<i>\<^sub>B src\<^sub>B trg\<^sub>B DN \<Psi>
     proof
       (* DN is locally (but not globally) full. *)
       show "\<And>f f' \<nu>. \<lbrakk> ide f; ide f'; src f = src f'; trg f = trg f'; \<guillemotleft>\<nu> : DN f \<Rightarrow>\<^sub>B DN f'\<guillemotright> \<rbrakk>
                          \<Longrightarrow> \<exists>\<mu>. \<guillemotleft>\<mu> : f \<Rightarrow> f'\<guillemotright> \<and> DN \<mu> = \<nu>"
       proof -
         fix f f' \<nu>
         assume f: "ide f" and f': "ide f'"
         and eq_src: "src f = src f'" and eq_trg: "trg f = trg f'"
         and \<nu>: "\<guillemotleft>\<nu> : DN f \<Rightarrow>\<^sub>B DN f'\<guillemotright>"
         show "\<exists>\<mu>. \<guillemotleft>\<mu> : f \<Rightarrow> f'\<guillemotright> \<and> DN \<mu> = \<nu>"
         proof -
           let ?\<mu> = "MkArr (Dom f) (Dom f') \<nu>"
           have \<mu>: "\<guillemotleft>?\<mu> : f \<Rightarrow> f'\<guillemotright>"
           proof
             have "Map f = \<lbrace>Dom f\<rbrace>"
               using f by simp
             have "Map f' = \<lbrace>Dom f'\<rbrace>"
               using f' by simp
             have "Dom f' = Cod f'"
               using f' Cod_ide by simp
             show \<mu>: "arr ?\<mu>"
             proof -
               have "E.Nml (Dom ?\<mu>) \<and> E.Ide (Dom ?\<mu>)"
               proof -
                 have "E.Nml (Dom f) \<and> E.Ide (Dom f)"
                   using f ide_char arr_char by blast
                 thus ?thesis
                   using f by simp
               qed
               moreover have "E.Nml (Cod ?\<mu>) \<and> E.Ide (Cod ?\<mu>)"
               proof -
                 have "E.Nml (Dom f') \<and> E.Ide (Dom f')"
                   using f' ide_char arr_char by blast
                 thus ?thesis
                   using f' by simp
               qed
               moreover have "E.Src (Dom ?\<mu>) = E.Src (Cod ?\<mu>)"
                 using f f' \<nu> arr_char src_def eq_src ideD(1) by auto
               moreover have "E.Trg (Dom ?\<mu>) = E.Trg (Cod ?\<mu>)"
                 using f f' \<nu> arr_char trg_def eq_trg ideD(1) by auto
               moreover have "\<guillemotleft>Map ?\<mu> : \<lbrace>Dom ?\<mu>\<rbrace> \<Rightarrow>\<^sub>B \<lbrace>Cod ?\<mu>\<rbrace>\<guillemotright>"
               proof -
                 have "\<guillemotleft>\<nu> : \<lbrace>Dom f\<rbrace> \<Rightarrow>\<^sub>B \<lbrace>Dom f'\<rbrace>\<guillemotright>"
                   using f f' \<nu> ide_char arr_char DN_def Cod_ide Map_ide
                   by (metis (no_types, lifting) ideD(1))
                 thus ?thesis by simp
               qed
               ultimately show ?thesis
                 using f f' \<nu> ide_char arr_char by blast
             qed
             show "dom ?\<mu> = f"
               using f \<mu> dom_char MkArr_Map MkIde_Dom' by simp
             show "cod ?\<mu> = f'"
             proof -
               have "cod ?\<mu> = MkIde (Dom f')"
                 using \<mu> cod_char by simp
               also have "... = MkArr (Dom f') (Cod f') (Map f')"
                 using f' by auto
               also have "... = f'"
                 using f' MkArr_Map by simp
               finally show ?thesis by simp
             qed
           qed
           moreover have "DN ?\<mu> = \<nu>"
             using \<mu> DN_def by auto
           ultimately show ?thesis by blast
         qed
       qed
       (* DN is essentially surjective up to equivalence on objects. *)
       show "\<And>a'. B.obj a' \<Longrightarrow> \<exists>a. obj a \<and> B.equivalent_objects (DN.map\<^sub>0 a) a'"
       proof -
         fix a'
         assume a': "B.obj a'"
         have "obj (UP.map\<^sub>0 a')"
           using a' UP.map\<^sub>0_simps(1) by simp
         moreover have "B.equivalent_objects (DN.map\<^sub>0 (UP.map\<^sub>0 a')) a'"
         proof -
           have "arr (MkArr \<^bold>\<langle>a'\<^bold>\<rangle> \<^bold>\<langle>a'\<^bold>\<rangle> a')"
             using a' UP_def [of a'] UP.preserves_reflects_arr [of a'] by auto
           moreover have "arr (MkArr \<^bold>\<langle>a'\<^bold>\<rangle>\<^sub>0 \<^bold>\<langle>a'\<^bold>\<rangle>\<^sub>0 a')"
             using a' arr_char B.obj_def by auto
           ultimately have "DN.map\<^sub>0 (UP.map\<^sub>0 a') = a'"
             using a' UP.map\<^sub>0_def UP_def DN.map\<^sub>0_def DN_def src_def UP.map\<^sub>0_simps(1)
             by auto
           thus ?thesis
             using a' B.equivalent_objects_reflexive by simp
         qed
         ultimately show "\<exists>a. obj a \<and> B.equivalent_objects (DN.map\<^sub>0 a) a'"
           by blast
       qed
       (* DN is locally essentially surjective. *)
       show "\<And>a b g. \<lbrakk> obj a; obj b; \<guillemotleft>g : DN.map\<^sub>0 a \<rightarrow>\<^sub>B DN.map\<^sub>0 b\<guillemotright>; B.ide g \<rbrakk> \<Longrightarrow>
                        \<exists>f. \<guillemotleft>f : a \<rightarrow> b\<guillemotright> \<and> ide f \<and> B.isomorphic (DN f) g"
       proof -
         fix a b g
         assume a: "obj a" and b: "obj b"
         and g: "\<guillemotleft>g : DN.map\<^sub>0 a \<rightarrow>\<^sub>B DN.map\<^sub>0 b\<guillemotright>" and ide_g: "B.ide g"
         have "ide (UP g)"
           using ide_g UP.preserves_ide by simp
         moreover have "B.isomorphic (DN (UP g)) g"
           using ide_g DN_UP B.isomorphic_reflexive by simp
         moreover have "\<guillemotleft>UP g : a \<rightarrow> b\<guillemotright>"
         proof
           show "arr (UP g)"
             using g UP.preserves_reflects_arr by auto
           show "src (UP g) = a"
           proof -
             have "src (UP g) = MkArr \<^bold>\<langle>src\<^sub>B g\<^bold>\<rangle>\<^sub>0 \<^bold>\<langle>src\<^sub>B g\<^bold>\<rangle>\<^sub>0 (src\<^sub>B g)"
               using ide_g src_def UP_def UP.preserves_reflects_arr [of g] B.ideD(1) by simp
             also have "... = a"
             proof -
               have "src\<^sub>B g = src\<^sub>B (DN.map\<^sub>0 a)"
                 using a g B.in_hhom_def by simp
               also have "... = Map a"
-                using a Map_preserves_objects DN.map\<^sub>0_def DN_def B.src_src by auto
+                using a Map_preserves_objects DN.map\<^sub>0_def DN_def B.src_src B.obj_simps
+                by auto
               finally have "src\<^sub>B g = Map a" by simp
               hence "MkArr \<^bold>\<langle>src\<^sub>B g\<^bold>\<rangle>\<^sub>0 \<^bold>\<langle>src\<^sub>B g\<^bold>\<rangle>\<^sub>0 (src\<^sub>B g) = MkArr \<^bold>\<langle>Map a\<^bold>\<rangle>\<^sub>0 \<^bold>\<langle>Map a\<^bold>\<rangle>\<^sub>0 (Map a)"
                 by simp
               also have "... = a"
                 using a obj_char apply (cases "Dom a", simp_all)
                 by (metis (no_types, lifting) B.obj_def' a comp_ide_arr dom_char dom_eqI objE)
               finally show ?thesis by simp
             qed
             finally show ?thesis by simp
           qed
           show "trg (UP g) = b"
           proof -
             have "trg (UP g) = MkArr \<^bold>\<langle>trg\<^sub>B g\<^bold>\<rangle>\<^sub>0 \<^bold>\<langle>trg\<^sub>B g\<^bold>\<rangle>\<^sub>0 (trg\<^sub>B g)"
               using ide_g trg_def UP_def UP.preserves_reflects_arr [of g] B.ideD(1) by simp
             also have "... = b"
             proof -
               have "trg\<^sub>B g = trg\<^sub>B (DN.map\<^sub>0 b)"
                 using b g B.in_hhom_def by simp
               also have "... = Map b"
-                using b Map_preserves_objects DN.map\<^sub>0_def DN_def B.src_src by auto
+                using b Map_preserves_objects DN.map\<^sub>0_def DN_def B.src_src B.obj_simps
+                by auto
               finally have "trg\<^sub>B g = Map b" by simp
               hence "MkArr \<^bold>\<langle>trg\<^sub>B g\<^bold>\<rangle>\<^sub>0 \<^bold>\<langle>trg\<^sub>B g\<^bold>\<rangle>\<^sub>0 (trg\<^sub>B g) = MkArr \<^bold>\<langle>Map b\<^bold>\<rangle>\<^sub>0 \<^bold>\<langle>Map b\<^bold>\<rangle>\<^sub>0 (Map b)"
                 by simp
               also have "... = b"
                 using b obj_char apply (cases "Dom b", simp_all)
                 by (metis (no_types, lifting) B.obj_def' b comp_ide_arr dom_char dom_eqI objE)
               finally show ?thesis by simp
             qed
             finally show ?thesis by simp
           qed
         qed
         ultimately show "\<exists>f. \<guillemotleft>f : a \<rightarrow> b\<guillemotright> \<and> ide f \<and> B.isomorphic (DN f) g"
           by blast
       qed
     qed
 
     theorem DN_is_equivalence_pseudofunctor:
     shows "equivalence_pseudofunctor vcomp hcomp \<a> \<i> src trg V\<^sub>B H\<^sub>B \<a>\<^sub>B \<i>\<^sub>B src\<^sub>B trg\<^sub>B DN \<Psi>"
       ..
 
     text \<open>
       The following gives an explicit formula for a component of the unit isomorphism of
       the pseudofunctor \<open>UP\<close> from a bicategory to its strictification.
       It is not currently being used -- I originally proved it in order to establish something
       that I later proved in a more abstract setting -- but it might be useful at some point.
     \<close>
 
     interpretation L: bicategorical_language V\<^sub>B src\<^sub>B trg\<^sub>B ..
     interpretation E: evaluation_map V\<^sub>B src\<^sub>B trg\<^sub>B V\<^sub>B H\<^sub>B \<a>\<^sub>B \<i>\<^sub>B src\<^sub>B trg\<^sub>B
                         \<open>\<lambda>\<mu>. if B.arr \<mu> then \<mu> else B.null\<close>
       using B.src.is_extensional B.trg.is_extensional
       by (unfold_locales, auto)
     notation E.eval ("\<lbrace>_\<rbrace>")
 
     interpretation UP: equivalence_pseudofunctor
                          V\<^sub>B H\<^sub>B \<a>\<^sub>B \<i>\<^sub>B src\<^sub>B trg\<^sub>B vcomp hcomp \<a> \<i> src trg UP \<Phi>
       using UP_is_equivalence_pseudofunctor by auto
 
     lemma UP_\<Psi>_char:
     assumes "B.obj a"
     shows "UP.\<Psi> a = MkArr \<^bold>\<langle>a\<^bold>\<rangle>\<^sub>0 \<^bold>\<langle>a\<^bold>\<rangle> a"
     proof -
       have " MkArr \<^bold>\<langle>a\<^bold>\<rangle>\<^sub>0 \<^bold>\<langle>a\<^bold>\<rangle> a = UP.\<Psi> a"
       proof (intro UP.\<Psi>_eqI)
         show "B.obj a"
           using assms by simp
         have 0: "\<guillemotleft>a : a \<Rightarrow>\<^sub>B a\<guillemotright>"
           using assms by auto
         have 1: "arr (MkArr \<^bold>\<langle>a\<^bold>\<rangle>\<^sub>0 \<^bold>\<langle>a\<^bold>\<rangle> a)"
           apply (unfold arr_char, intro conjI)
           using assms by auto
         have 2: "arr (MkArr \<^bold>\<langle>a\<^bold>\<rangle> \<^bold>\<langle>a\<^bold>\<rangle> a)"
           apply (unfold arr_char, intro conjI)
           using assms by auto
         have 3: "arr (MkArr \<^bold>\<langle>a\<^bold>\<rangle>\<^sub>0 \<^bold>\<langle>a\<^bold>\<rangle>\<^sub>0 a)"
           apply (unfold arr_char, intro conjI)
           using assms by auto
         show "\<guillemotleft>MkArr \<^bold>\<langle>a\<^bold>\<rangle>\<^sub>0 \<^bold>\<langle>a\<^bold>\<rangle> a : UP.map\<^sub>0 a \<Rightarrow> UP a\<guillemotright>"
         proof
           show "arr (MkArr \<^bold>\<langle>a\<^bold>\<rangle>\<^sub>0 \<^bold>\<langle>a\<^bold>\<rangle> a)" by fact
           show "dom (MkArr \<^bold>\<langle>a\<^bold>\<rangle>\<^sub>0 \<^bold>\<langle>a\<^bold>\<rangle> a) = UP.map\<^sub>0 a"
             using assms 1 2 dom_char UP.map\<^sub>0_def UP_def src_def by auto
           show "cod (MkArr \<^bold>\<langle>a\<^bold>\<rangle>\<^sub>0 \<^bold>\<langle>a\<^bold>\<rangle> a) = UP a"
             using assms 1 2 cod_char UP.map\<^sub>0_def UP_def src_def by auto
         qed
         show "iso (MkArr \<^bold>\<langle>a\<^bold>\<rangle>\<^sub>0 \<^bold>\<langle>a\<^bold>\<rangle> a)"
           using assms 1 iso_char by auto
         show "MkArr \<^bold>\<langle>a\<^bold>\<rangle>\<^sub>0 \<^bold>\<langle>a\<^bold>\<rangle> a \<cdot> \<i> (UP.map\<^sub>0 a) =
               (UP \<i>\<^sub>B[a] \<cdot> \<Phi> (a, a)) \<cdot> (MkArr \<^bold>\<langle>a\<^bold>\<rangle>\<^sub>0 \<^bold>\<langle>a\<^bold>\<rangle> a \<star> MkArr \<^bold>\<langle>a\<^bold>\<rangle>\<^sub>0 \<^bold>\<langle>a\<^bold>\<rangle> a)"
         proof -
           have "MkArr \<^bold>\<langle>a\<^bold>\<rangle>\<^sub>0 \<^bold>\<langle>a\<^bold>\<rangle> a \<cdot> \<i> (UP.map\<^sub>0 a) = MkArr \<^bold>\<langle>a\<^bold>\<rangle>\<^sub>0 \<^bold>\<langle>a\<^bold>\<rangle> a"
             unfolding \<i>_def UP.map\<^sub>0_def UP_def
             using assms 0 1 2 src_def by auto
           also have "... = (UP \<i>\<^sub>B[a] \<cdot> \<Phi> (a, a)) \<cdot> (MkArr \<^bold>\<langle>a\<^bold>\<rangle>\<^sub>0 \<^bold>\<langle>a\<^bold>\<rangle> a \<star> MkArr \<^bold>\<langle>a\<^bold>\<rangle>\<^sub>0 \<^bold>\<langle>a\<^bold>\<rangle> a)"
           proof -
             have "(UP \<i>\<^sub>B[a] \<cdot> \<Phi> (a, a)) \<cdot> (MkArr \<^bold>\<langle>a\<^bold>\<rangle>\<^sub>0 \<^bold>\<langle>a\<^bold>\<rangle> a \<star> MkArr \<^bold>\<langle>a\<^bold>\<rangle>\<^sub>0 \<^bold>\<langle>a\<^bold>\<rangle> a) =
                   (MkArr \<^bold>\<langle>a \<star>\<^sub>B a\<^bold>\<rangle> \<^bold>\<langle>a\<^bold>\<rangle> \<i>\<^sub>B[a] \<cdot> MkArr (\<^bold>\<langle>a\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>a\<^bold>\<rangle>) \<^bold>\<langle>a \<star>\<^sub>B a\<^bold>\<rangle> (a \<star>\<^sub>B a))
                      \<cdot> (MkArr \<^bold>\<langle>a\<^bold>\<rangle>\<^sub>0 \<^bold>\<langle>a\<^bold>\<rangle> a \<star> MkArr \<^bold>\<langle>a\<^bold>\<rangle>\<^sub>0 \<^bold>\<langle>a\<^bold>\<rangle> a)"
               using assms UP_def \<Phi>_ide_simp by auto
             also have "... = (MkArr \<^bold>\<langle>a \<star>\<^sub>B a\<^bold>\<rangle> \<^bold>\<langle>a\<^bold>\<rangle> \<i>\<^sub>B[a] \<cdot> MkArr (\<^bold>\<langle>a\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>a\<^bold>\<rangle>) \<^bold>\<langle>a \<star>\<^sub>B a\<^bold>\<rangle> (a \<star>\<^sub>B a))
                                \<cdot> MkArr \<^bold>\<langle>a\<^bold>\<rangle>\<^sub>0 (\<^bold>\<langle>a\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>a\<^bold>\<rangle>) (B.runit' a)"
               using assms 0 1 2 3 hcomp_def B.comp_cod_arr src_def trg_def
                     B.can_Ide_self B.canE_unitor [of "\<^bold>\<langle>a\<^bold>\<rangle>\<^sub>0"] B.comp_cod_arr
               by auto
             also have "... = MkArr \<^bold>\<langle>a\<^bold>\<rangle>\<^sub>0 \<^bold>\<langle>a\<^bold>\<rangle> ((\<i>\<^sub>B[a] \<cdot>\<^sub>B (a \<star>\<^sub>B a)) \<cdot>\<^sub>B B.runit' a)"
             proof -
               have "MkArr \<^bold>\<langle>a \<star>\<^sub>B a\<^bold>\<rangle> \<^bold>\<langle>a\<^bold>\<rangle> \<i>\<^sub>B[a] \<cdot> MkArr (\<^bold>\<langle>a\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>a\<^bold>\<rangle>) \<^bold>\<langle>a \<star>\<^sub>B a\<^bold>\<rangle> (a \<star>\<^sub>B a) =
                     MkArr (\<^bold>\<langle>a\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>a\<^bold>\<rangle>) \<^bold>\<langle>a\<^bold>\<rangle> (\<i>\<^sub>B[a] \<cdot>\<^sub>B (a \<star>\<^sub>B a))"
                 using assms
-                apply (intro comp_MkArr arr_MkArr)
-                     apply auto
-                by fastforce
+                by (intro comp_MkArr arr_MkArr) auto
               moreover have "MkArr (\<^bold>\<langle>a\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>a\<^bold>\<rangle>) \<^bold>\<langle>a\<^bold>\<rangle> (\<i>\<^sub>B[a] \<cdot>\<^sub>B (a \<star>\<^sub>B a))
                                \<cdot> MkArr \<^bold>\<langle>a\<^bold>\<rangle>\<^sub>0 (\<^bold>\<langle>a\<^bold>\<rangle> \<^bold>\<star> \<^bold>\<langle>a\<^bold>\<rangle>) (B.runit' a) =
                              MkArr \<^bold>\<langle>a\<^bold>\<rangle>\<^sub>0 \<^bold>\<langle>a\<^bold>\<rangle> ((\<i>\<^sub>B[a] \<cdot>\<^sub>B (a \<star>\<^sub>B a)) \<cdot>\<^sub>B B.runit' a)"
                 using assms 0 B.comp_arr_dom
                 by (intro comp_MkArr arr_MkArr, auto)
               ultimately show ?thesis by argo
             qed
             also have "... = MkArr \<^bold>\<langle>a\<^bold>\<rangle>\<^sub>0 \<^bold>\<langle>a\<^bold>\<rangle> a"
               using assms B.comp_arr_dom B.comp_arr_inv' B.iso_unit B.unitor_coincidence(2)
               by simp
             finally show ?thesis by argo
           qed
           finally show ?thesis by simp
         qed
       qed
       thus ?thesis by simp
     qed
 
   end
 
   subsection "Pseudofunctors into a Strict Bicategory"
 
   text \<open>
     In the special case of a pseudofunctor into a strict bicategory, we can obtain
     explicit formulas for the images of the units and associativities under the pseudofunctor,
     which only involve the structure maps of the pseudofunctor, since the units and associativities
     in the target bicategory are all identities.  This is useful in applying strictification.
   \<close>
 
   locale pseudofunctor_into_strict_bicategory =
     pseudofunctor +
     D: strict_bicategory V\<^sub>D H\<^sub>D \<a>\<^sub>D \<i>\<^sub>D src\<^sub>D trg\<^sub>D
   begin
 
     lemma image_of_unitor:
     assumes "C.ide g"
     shows "F \<l>\<^sub>C[g] = (D.inv (\<Psi> (trg\<^sub>C g)) \<star>\<^sub>D F g) \<cdot>\<^sub>D D.inv (\<Phi> (trg\<^sub>C g, g))"
     and "F \<r>\<^sub>C[g] = (F g \<star>\<^sub>D D.inv (\<Psi> (src\<^sub>C g))) \<cdot>\<^sub>D D.inv (\<Phi> (g, src\<^sub>C g))"
     and "F (C.lunit' g) = \<Phi> (trg\<^sub>C g, g) \<cdot>\<^sub>D (\<Psi> (trg\<^sub>C g) \<star>\<^sub>D F g)"
     and "F (C.runit' g) = \<Phi> (g, src\<^sub>C g) \<cdot>\<^sub>D (F g \<star>\<^sub>D \<Psi> (src\<^sub>C g))"
     proof -
       show A: "F \<l>\<^sub>C[g] = (D.inv (\<Psi> (trg\<^sub>C g)) \<star>\<^sub>D F g) \<cdot>\<^sub>D D.inv (\<Phi> (trg\<^sub>C g, g))"
       proof -
         have 1: "\<guillemotleft>(D.inv (\<Psi> (trg\<^sub>C g)) \<star>\<^sub>D F g) \<cdot>\<^sub>D D.inv (\<Phi> (trg\<^sub>C g, g)) :
                      F (trg\<^sub>C g \<star>\<^sub>C g) \<Rightarrow>\<^sub>D F g\<guillemotright>"
         proof
           show "\<guillemotleft>D.inv (\<Psi> (trg\<^sub>C g)) \<star>\<^sub>D F g : F (trg\<^sub>C g) \<star>\<^sub>D F g \<Rightarrow>\<^sub>D F g\<guillemotright>"
             using assms \<Psi>_char by (auto simp add: D.hcomp_obj_arr)
           show "\<guillemotleft>D.inv (\<Phi> (trg\<^sub>C g, g)) : F (trg\<^sub>C g \<star>\<^sub>C g) \<Rightarrow>\<^sub>D F (trg\<^sub>C g) \<star>\<^sub>D F g\<guillemotright>"
             using assms \<Phi>_in_hom(2) D.inv_is_inverse by simp
         qed
         have "(D.inv (\<Psi> (trg\<^sub>C g)) \<star>\<^sub>D F g) \<cdot>\<^sub>D D.inv (\<Phi> (trg\<^sub>C g, g)) =
               F g \<cdot>\<^sub>D (D.inv (\<Psi> (trg\<^sub>C g)) \<star>\<^sub>D F g) \<cdot>\<^sub>D D.inv (\<Phi> (trg\<^sub>C g, g))"
           using 1 D.comp_cod_arr by auto
         also have "... = (F \<l>\<^sub>C[g] \<cdot>\<^sub>D \<Phi> (trg\<^sub>C g, g) \<cdot>\<^sub>D (\<Psi> (trg\<^sub>C g) \<star>\<^sub>D F g)) \<cdot>\<^sub>D
                            (D.inv (\<Psi> (trg\<^sub>C g)) \<star>\<^sub>D F g) \<cdot>\<^sub>D D.inv (\<Phi> (trg\<^sub>C g, g))"
           using assms lunit_coherence [of g] D.strict_lunit by simp
         also have "... = F \<l>\<^sub>C[g] \<cdot>\<^sub>D \<Phi> (trg\<^sub>C g, g) \<cdot>\<^sub>D
                                     ((\<Psi> (trg\<^sub>C g) \<star>\<^sub>D F g) \<cdot>\<^sub>D (D.inv (\<Psi> (trg\<^sub>C g)) \<star>\<^sub>D F g)) \<cdot>\<^sub>D
                                    D.inv (\<Phi> (trg\<^sub>C g, g))"
           using D.comp_assoc by simp
         also have "... = F \<l>\<^sub>C[g]"
         proof -
           have "(\<Psi> (trg\<^sub>C g) \<star>\<^sub>D F g) \<cdot>\<^sub>D (D.inv (\<Psi> (trg\<^sub>C g)) \<star>\<^sub>D F g) = F (trg\<^sub>C g) \<star>\<^sub>D F g"
             using assms \<Psi>_char D.whisker_right
             by (metis C.ideD(1) C.obj_trg C.trg.preserves_reflects_arr D.comp_arr_inv'
                 \<Psi>_simps(5) preserves_arr preserves_ide)
           moreover have "\<Phi> (trg\<^sub>C g, g) \<cdot>\<^sub>D D.inv (\<Phi> (trg\<^sub>C g, g)) = F (trg\<^sub>C g \<star>\<^sub>C g)"
             using assms D.comp_arr_inv D.inv_is_inverse by simp
           ultimately show ?thesis
             using assms D.comp_arr_dom D.comp_cod_arr \<Psi>_char by auto
         qed
         finally show ?thesis by simp
       qed
       show B: "F \<r>\<^sub>C[g] = (F g \<star>\<^sub>D D.inv (\<Psi> (src\<^sub>C g))) \<cdot>\<^sub>D D.inv (\<Phi> (g, src\<^sub>C g))"
       proof -
         have 1: "\<guillemotleft>(F g \<star>\<^sub>D D.inv (\<Psi> (src\<^sub>C g))) \<cdot>\<^sub>D D.inv (\<Phi> (g, src\<^sub>C g)) :
                     F (g \<star>\<^sub>C src\<^sub>C g) \<Rightarrow>\<^sub>D F g\<guillemotright>"
         proof
           show "\<guillemotleft>F g \<star>\<^sub>D D.inv (\<Psi> (src\<^sub>C g)) : F g \<star>\<^sub>D F (src\<^sub>C g) \<Rightarrow>\<^sub>D F g\<guillemotright>"
             using assms \<Psi>_char by (auto simp add: D.hcomp_arr_obj)
           show "\<guillemotleft>D.inv (\<Phi> (g, src\<^sub>C g)) : F (g \<star>\<^sub>C src\<^sub>C g) \<Rightarrow>\<^sub>D F g \<star>\<^sub>D F (src\<^sub>C g)\<guillemotright>"
             using assms \<Phi>_in_hom(2) by simp
         qed
         have "(F g \<star>\<^sub>D D.inv (\<Psi> (src\<^sub>C g))) \<cdot>\<^sub>D D.inv (\<Phi> (g, src\<^sub>C g)) =
               F g \<cdot>\<^sub>D (F g \<star>\<^sub>D D.inv (\<Psi> (src\<^sub>C g))) \<cdot>\<^sub>D D.inv (\<Phi> (g, src\<^sub>C g))"
           using 1 D.comp_cod_arr by auto
         also have "... = (F \<r>\<^sub>C[g] \<cdot>\<^sub>D \<Phi> (g, src\<^sub>C g) \<cdot>\<^sub>D (F g \<star>\<^sub>D \<Psi> (src\<^sub>C g))) \<cdot>\<^sub>D
                            (F g \<star>\<^sub>D D.inv (\<Psi> (src\<^sub>C g))) \<cdot>\<^sub>D D.inv (\<Phi> (g, src\<^sub>C g))"
            using assms runit_coherence [of g] D.strict_runit by simp
         also have "... = F \<r>\<^sub>C[g] \<cdot>\<^sub>D (\<Phi> (g, src\<^sub>C g) \<cdot>\<^sub>D ((F g \<star>\<^sub>D \<Psi> (src\<^sub>C g)) \<cdot>\<^sub>D
                            (F g \<star>\<^sub>D D.inv (\<Psi> (src\<^sub>C g))))) \<cdot>\<^sub>D D.inv (\<Phi> (g, src\<^sub>C g))"
            using D.comp_assoc by simp
         also have "... = F \<r>\<^sub>C[g]"
         proof -
           have "(F g \<star>\<^sub>D \<Psi> (src\<^sub>C g)) \<cdot>\<^sub>D (F g \<star>\<^sub>D D.inv (\<Psi> (src\<^sub>C g))) = F g \<star>\<^sub>D F (src\<^sub>C g)"
             using assms D.whisker_left \<Psi>_char
             by (metis C.ideD(1) C.obj_src C.src.preserves_ide D.comp_arr_inv' D.ideD(1)
                 \<Psi>_simps(5) preserves_ide)
           moreover have "\<Phi> (g, src\<^sub>C g) \<cdot>\<^sub>D D.inv (\<Phi> (g, src\<^sub>C g)) = F (g \<star>\<^sub>C src\<^sub>C g)"
             using assms D.comp_arr_inv D.inv_is_inverse by simp
           ultimately show ?thesis
             using assms D.comp_arr_dom D.comp_cod_arr \<Psi>_char \<Phi>_in_hom(2) [of g "src\<^sub>C g"]
             by auto
         qed
         finally show ?thesis by simp
       qed
       show "F (C.lunit' g) = \<Phi> (trg\<^sub>C g, g) \<cdot>\<^sub>D (\<Psi> (trg\<^sub>C g) \<star>\<^sub>D F g)"
       proof -
         have "F (C.lunit' g) = D.inv (F \<l>\<^sub>C[g])"
           using assms C.iso_lunit preserves_inv by simp
         also have "... = D.inv ((D.inv (\<Psi> (trg\<^sub>C g)) \<star>\<^sub>D F g) \<cdot>\<^sub>D D.inv (\<Phi> (trg\<^sub>C g, g)))"
           using A by simp
         also have "... = \<Phi> (trg\<^sub>C g, g) \<cdot>\<^sub>D (\<Psi> (trg\<^sub>C g) \<star>\<^sub>D F g)"
         proof -
           have "D.iso (D.inv (\<Phi> (trg\<^sub>C g, g))) \<and> D.inv (D.inv (\<Phi> (trg\<^sub>C g, g))) = \<Phi> (trg\<^sub>C g, g)"
             using assms D.iso_inv_iso by simp
           moreover have "D.iso (D.inv (\<Psi> (trg\<^sub>C g)) \<star>\<^sub>D F g) \<and>
                          D.inv (D.inv (\<Psi> (trg\<^sub>C g)) \<star>\<^sub>D F g) = \<Psi> (trg\<^sub>C g) \<star>\<^sub>D F g"
             using assms \<Psi>_char D.iso_inv_iso by simp
           moreover have "D.seq (D.inv (\<Psi> (trg\<^sub>C g)) \<star>\<^sub>D F g) (D.inv (\<Phi> (trg\<^sub>C g, g)))"
             using assms \<Psi>_char by (metis A C.lunit_simps(1) preserves_arr)
           ultimately show ?thesis
             using D.inv_comp by simp
         qed
         finally show ?thesis by simp
       qed
       show "F (C.runit' g) = \<Phi> (g, src\<^sub>C g) \<cdot>\<^sub>D (F g \<star>\<^sub>D \<Psi> (src\<^sub>C g))"
       proof -
         have "F (C.runit' g) = D.inv (F \<r>\<^sub>C[g])"
           using assms C.iso_runit preserves_inv by simp
         also have "... = D.inv ((F g \<star>\<^sub>D D.inv (\<Psi> (src\<^sub>C g))) \<cdot>\<^sub>D D.inv (\<Phi> (g, src\<^sub>C g)))"
           using B by simp
         also have "... = \<Phi> (g, src\<^sub>C g) \<cdot>\<^sub>D (F g \<star>\<^sub>D \<Psi> (src\<^sub>C g))"
         proof -
           have "D.iso (D.inv (\<Phi> (g, src\<^sub>C g))) \<and> D.inv (D.inv (\<Phi> (g, src\<^sub>C g))) = \<Phi> (g, src\<^sub>C g)"
             using assms D.iso_inv_iso by simp
           moreover have "D.iso (F g \<star>\<^sub>D D.inv (\<Psi> (src\<^sub>C g))) \<and>
                          D.inv (F g \<star>\<^sub>D D.inv (\<Psi> (src\<^sub>C g))) = F g \<star>\<^sub>D \<Psi> (src\<^sub>C g)"
             using assms \<Psi>_char D.iso_inv_iso by simp
           moreover have "D.seq (F g \<star>\<^sub>D D.inv (\<Psi> (src\<^sub>C g))) (D.inv (\<Phi> (g, src\<^sub>C g)))"
             using assms \<Psi>_char by (metis B C.runit_simps(1) preserves_arr)
           ultimately show ?thesis
             using D.inv_comp by simp
         qed
         finally show ?thesis by simp
       qed
     qed
 
     lemma image_of_associator:
     assumes "C.ide f" and "C.ide g" and "C.ide h" and "src\<^sub>C f = trg\<^sub>C g" and "src\<^sub>C g = trg\<^sub>C h"
     shows "F \<a>\<^sub>C[f, g, h] = \<Phi> (f, g \<star>\<^sub>C h) \<cdot>\<^sub>D (F f \<star>\<^sub>D \<Phi> (g, h)) \<cdot>\<^sub>D
                              (D.inv (\<Phi> (f, g)) \<star>\<^sub>D F h) \<cdot>\<^sub>D D.inv (\<Phi> (f \<star>\<^sub>C g, h))"
     and "F (C.\<a>' f g h) = \<Phi> (f \<star>\<^sub>C g, h) \<cdot>\<^sub>D (\<Phi> (f, g) \<star>\<^sub>D F h) \<cdot>\<^sub>D
                                 (F f \<star>\<^sub>D D.inv (\<Phi> (g, h))) \<cdot>\<^sub>D D.inv (\<Phi> (f, g \<star>\<^sub>C h))"
     proof -
       show 1: "F \<a>\<^sub>C[f, g, h] = \<Phi> (f, g \<star>\<^sub>C h) \<cdot>\<^sub>D (F f \<star>\<^sub>D \<Phi> (g, h)) \<cdot>\<^sub>D
                                  (D.inv (\<Phi> (f, g)) \<star>\<^sub>D F h) \<cdot>\<^sub>D D.inv (\<Phi> (f \<star>\<^sub>C g, h))"
       proof -
         have 2: "D.seq (\<Phi> (f, g \<star>\<^sub>C h)) ((F f \<star>\<^sub>D \<Phi> (g, h)) \<cdot>\<^sub>D \<a>\<^sub>D[F f, F g, F h])"
         proof (intro D.seqI)
           show "D.arr \<a>\<^sub>D[F f, F g, F h]"
             using assms D.assoc_in_hom(2) [of "F f" "F g" "F h"] by auto
           show "D.hseq (F f) (\<Phi> (g, h))"
             using assms by fastforce
           show "D.dom (F f \<star>\<^sub>D \<Phi> (g, h)) = D.cod \<a>\<^sub>D[F f, F g, F h]"
             using assms \<open>D.hseq (F f) (\<Phi> (g, h))\<close> \<Phi>_simps(1) \<Phi>_simps(4) by auto
           show "D.arr (\<Phi> (f, g \<star>\<^sub>C h))"
             using assms by auto
           show "D.dom (\<Phi> (f, g \<star>\<^sub>C h)) = D.cod ((F f \<star>\<^sub>D \<Phi> (g, h)) \<cdot>\<^sub>D \<a>\<^sub>D[F f, F g, F h])"
             using assms \<open>D.hseq (F f) (\<Phi> (g, h))\<close> \<Phi>_simps(1) \<Phi>_simps(4) by auto
         qed
         moreover have 3: "F \<a>\<^sub>C[f, g, h] \<cdot>\<^sub>D \<Phi> (f \<star>\<^sub>C g, h) \<cdot>\<^sub>D (\<Phi> (f, g) \<star>\<^sub>D F h) =
                           \<Phi> (f, g \<star>\<^sub>C h) \<cdot>\<^sub>D (F f \<star>\<^sub>D \<Phi> (g, h)) \<cdot>\<^sub>D \<a>\<^sub>D[F f, F g, F h]"
           using assms assoc_coherence [of f g h] by blast
         moreover have "D.iso (\<Phi> (f \<star>\<^sub>C g, h) \<cdot>\<^sub>D (\<Phi> (f, g) \<star>\<^sub>D F h))"
         proof -
           have "D.iso (\<Phi> (f \<star>\<^sub>C g, h)) \<and> D.iso (\<Phi> (f, g)) \<and> D.iso (F h)"
             using assms by simp
           moreover have "D.seq (\<Phi> (f \<star>\<^sub>C g, h)) (\<Phi> (f, g) \<star>\<^sub>D F h)"
           proof (intro D.seqI)
             show "D.hseq (\<Phi> (f, g)) (F h)"
               using assms C.VV.arr_char by simp
             show "D.arr (\<Phi> (f \<star>\<^sub>C g, h))"
               using assms C.VV.arr_char by simp
             show "D.dom (\<Phi> (f \<star>\<^sub>C g, h)) = D.cod (\<Phi> (f, g) \<star>\<^sub>D F h)"
               using assms 2 3 by (metis D.seqE)
           qed
           ultimately show ?thesis
             using assms D.isos_compose by simp
         qed
         ultimately have "F \<a>\<^sub>C[f, g, h] =
                          (\<Phi> (f, g \<star>\<^sub>C h) \<cdot>\<^sub>D ((F f \<star>\<^sub>D \<Phi> (g, h)) \<cdot>\<^sub>D \<a>\<^sub>D[F f, F g, F h])) \<cdot>\<^sub>D
                            D.inv (\<Phi> (f \<star>\<^sub>C g, h) \<cdot>\<^sub>D (\<Phi> (f, g) \<star>\<^sub>D F h))"
           using D.invert_side_of_triangle(2)
                   [of "\<Phi> (f, g \<star>\<^sub>C h) \<cdot>\<^sub>D (F f \<star>\<^sub>D \<Phi> (g, h)) \<cdot>\<^sub>D \<a>\<^sub>D[F f, F g, F h]"
                       "F \<a>\<^sub>C[f, g, h]" "\<Phi> (f \<star>\<^sub>C g, h) \<cdot>\<^sub>D (\<Phi> (f, g) \<star>\<^sub>D F h)"]
           by presburger
         also have "... = \<Phi> (f, g \<star>\<^sub>C h) \<cdot>\<^sub>D (F f \<star>\<^sub>D \<Phi> (g, h)) \<cdot>\<^sub>D
                             (D.inv (\<Phi> (f, g)) \<star>\<^sub>D F h) \<cdot>\<^sub>D D.inv (\<Phi> (f \<star>\<^sub>C g, h))"
         proof -
           have "D.inv (\<Phi> (f \<star>\<^sub>C g, h) \<cdot>\<^sub>D (\<Phi> (f, g) \<star>\<^sub>D F h)) =
                 (D.inv (\<Phi> (f, g)) \<star>\<^sub>D F h) \<cdot>\<^sub>D D.inv (\<Phi> (f \<star>\<^sub>C g, h))"
           proof -
             have "D.iso (\<Phi> (f \<star>\<^sub>C g, h))"
               using assms D.iso_inv_iso by simp
             moreover have "D.iso (\<Phi> (f, g) \<star>\<^sub>D F h) \<and>
                            D.inv (\<Phi> (f, g) \<star>\<^sub>D F h) = D.inv (\<Phi> (f, g)) \<star>\<^sub>D F h"
               using assms D.iso_inv_iso by simp
             moreover have "D.seq (\<Phi> (f \<star>\<^sub>C g, h)) (\<Phi> (f, g) \<star>\<^sub>D F h)"
               using assms by fastforce
             ultimately show ?thesis
               using D.inv_comp by simp
           qed
           moreover have "(F f \<star>\<^sub>D \<Phi> (g, h)) \<cdot>\<^sub>D \<a>\<^sub>D[F f, F g, F h] = (F f \<star>\<^sub>D \<Phi> (g, h))"
             using assms D.comp_arr_dom D.assoc_in_hom [of "F f" "F g" "F h"] \<Phi>_in_hom
             by (metis "2" "3" D.comp_arr_ide D.hseq_char D.seqE D.strict_assoc
                 \<Phi>_simps(2) \<Phi>_simps(3) preserves_ide)
           ultimately show ?thesis
             using D.comp_assoc by simp
         qed
         finally show ?thesis
           by simp
       qed
       show "F (C.\<a>' f g h) = \<Phi> (f \<star>\<^sub>C g, h) \<cdot>\<^sub>D (\<Phi> (f, g) \<star>\<^sub>D F h) \<cdot>\<^sub>D
                                (F f \<star>\<^sub>D D.inv (\<Phi> (g, h))) \<cdot>\<^sub>D D.inv (\<Phi> (f, g \<star>\<^sub>C h))"
       proof -
         have "F (C.\<a>' f g h) = D.inv (F \<a>\<^sub>C[f, g, h])"
           using assms preserves_inv by simp
         also have "... = D.inv (\<Phi> (f, g \<star>\<^sub>C h) \<cdot>\<^sub>D (F f \<star>\<^sub>D \<Phi> (g, h)) \<cdot>\<^sub>D
                                   (D.inv (\<Phi> (f, g)) \<star>\<^sub>D F h) \<cdot>\<^sub>D D.inv (\<Phi> (f \<star>\<^sub>C g, h)))"
           using 1 by simp
         also have "... = \<Phi> (f \<star>\<^sub>C g, h) \<cdot>\<^sub>D (\<Phi> (f, g) \<star>\<^sub>D F h) \<cdot>\<^sub>D
                                    (F f \<star>\<^sub>D D.inv (\<Phi> (g, h))) \<cdot>\<^sub>D D.inv (\<Phi> (f, g \<star>\<^sub>C h))"
           using assms C.VV.arr_char D.iso_inv_iso FF_def D.hcomp_assoc D.comp_assoc
           (* OK, this is pretty cool, but not as cool as if I didn't have to direct it. *)
           by (simp add: D.inv_comp D.isos_compose)
         finally show ?thesis by simp
       qed
     qed
 
   end
 
   subsection "Internal Equivalences in a Strict Bicategory"
 
   text \<open>
     In this section we prove a useful fact about internal equivalences in a strict bicategory:
     namely, that if the ``right'' triangle identity holds for such an equivalence then the
     ``left'' does, as well.  Later we will dualize this property, and use strictification to
     extend it to arbitrary bicategories.
   \<close>
 
   locale equivalence_in_strict_bicategory =
     strict_bicategory +
     equivalence_in_bicategory
   begin
 
     lemma triangle_right_implies_left:
     shows "(g \<star> \<epsilon>) \<cdot> (\<eta> \<star> g) = g \<Longrightarrow> (\<epsilon> \<star> f) \<cdot> (f \<star> \<eta>) = f"
     proof -
       text \<open>
         The formal proof here was constructed following the string diagram sketch below,
         which appears in \cite{nlab-zigzag-diagram}
         (see it also in context in \cite{nlab-adjoint-equivalence}).
         The diagram is reproduced here by permission of its author, Mike Shulman,
         who says (private communication):
         ``Just don't give the impression that the proof itself is due to me, because it's not.
         I don't know who first gave that proof; it's probably folklore.''
         \begin{figure}[h]
           \includegraphics[width=6.5in]{triangle_right_implies_left.png}
         \end{figure}
       \<close>
       assume 1: "(g \<star> \<epsilon>) \<cdot> (\<eta> \<star> g) = g"
       have 2: "(inv \<eta> \<star> g) \<cdot> (g \<star> inv \<epsilon>) = g"
       proof -
         have "(inv \<eta> \<star> g) \<cdot> (g \<star> inv \<epsilon>) = inv ((g \<star> \<epsilon>) \<cdot> (\<eta> \<star> g))"
           using antipar inv_comp hcomp_assoc by simp
         also have "... = g"
           using 1 by simp
         finally show ?thesis by blast
       qed
       have "(\<epsilon> \<star> f) \<cdot> (f \<star> \<eta>) = (\<epsilon> \<star> f) \<cdot> (f \<star> (inv \<eta> \<star> g) \<cdot> (g \<star> inv \<epsilon>) \<star> f) \<cdot> (f \<star> \<eta>)"
       proof -
         have "(f \<star> (inv \<eta> \<star> g) \<cdot> (g \<star> inv \<epsilon>) \<star> f) \<cdot> (f \<star> \<eta>) = f \<star> \<eta>"
           using 2 ide_left ide_right antipar whisker_left
           by (metis comp_cod_arr unit_simps(1) unit_simps(3))
         thus ?thesis by simp
       qed
       also have "... = (\<epsilon> \<star> f) \<cdot> (f \<star> (inv \<eta> \<star> g) \<cdot> (g \<star> inv \<epsilon>) \<star> f) \<cdot> (f \<star> \<eta>) \<star> (inv \<eta> \<cdot> \<eta>)"
       proof -
         have "inv \<eta> \<cdot> \<eta> = src f"
           by (simp add: comp_inv_arr')
         thus ?thesis
           by (metis antipar(1) antipar(2) arrI calculation
               comp_ide_arr hcomp_arr_obj ideD(1) ide_left ide_right obj_src seqE
               strict_assoc' triangle_in_hom(1) vconn_implies_hpar(1))
       qed
       also have "... = (\<epsilon> \<cdot> (f \<star> (inv \<eta> \<star> g) \<cdot> (g \<star> inv \<epsilon>)) \<star> ((f \<star> inv \<eta>) \<cdot> (f \<star> \<eta>))) \<cdot> (f \<star> \<eta>)"
         using ide_left ide_right antipar unit_is_iso
         by (metis "2" arr_inv calculation comp_arr_dom comp_inv_arr' counit_simps(1)
             counit_simps(2) dom_inv hcomp_arr_obj ideD(1) unit_simps(1) unit_simps(2)
             unit_simps(5) obj_trg seqI whisker_left)
       also have "... = (\<epsilon> \<cdot> (f \<star> (inv \<eta> \<star> g) \<cdot> (g \<star> inv \<epsilon>)) \<star>
                          ((f \<star> inv \<eta>) \<cdot> ((inv \<epsilon> \<star> f) \<cdot> (\<epsilon> \<star> f)) \<cdot> (f \<star> \<eta>))) \<cdot> (f \<star> \<eta>)"
       proof -
         have "(inv \<epsilon> \<star> f) \<cdot> (\<epsilon> \<star> f) = (f \<star> g) \<star> f"
           using whisker_right [of f "inv \<epsilon>" \<epsilon>] counit_in_hom
           by (simp add: antipar(1) comp_inv_arr')
         thus ?thesis
           using hcomp_assoc comp_arr_dom
           by (metis comp_cod_arr ide_left local.unit_simps(1) local.unit_simps(3)
               whisker_left)
       qed
       also have "... = (((\<epsilon> \<cdot> (f \<star> (inv \<eta> \<star> g) \<cdot> (g \<star> inv \<epsilon>))) \<cdot> (f \<star> g)) \<star>
                          (((f \<star> inv \<eta>) \<cdot> (inv \<epsilon> \<star> f)) \<cdot> (\<epsilon> \<star> f) \<cdot> (f \<star> \<eta>))) \<cdot>
                            (f \<star> \<eta>)"
         using ide_left ide_right antipar comp_assoc whisker_right comp_cod_arr
         by (metis "2" comp_arr_dom counit_simps(1-2))
       also have "... = (((\<epsilon> \<cdot> (f \<star> (inv \<eta> \<star> g) \<cdot> (g \<star> inv \<epsilon>))) \<star> ((f \<star> inv \<eta>) \<cdot> (inv \<epsilon> \<star> f))) \<cdot>
                          ((f \<star> g) \<star> (\<epsilon> \<star> f) \<cdot> (f \<star> \<eta>))) \<cdot>
                            (f \<star> \<eta>)"
       proof -
         have 3: "seq (\<epsilon> \<cdot> (f \<star> (inv \<eta> \<star> g) \<cdot> (g \<star> inv \<epsilon>))) (f \<star> g)"
           using 2 antipar by auto
         moreover have 4: "seq ((f \<star> inv \<eta>) \<cdot> (inv \<epsilon> \<star> f)) ((\<epsilon> \<star> f) \<cdot> (f \<star> \<eta>))"
           using antipar hcomp_assoc by auto
         ultimately show ?thesis
           using interchange by simp
       qed
       also have "... = ((\<epsilon> \<cdot> (f \<star> (inv \<eta> \<star> g) \<cdot> (g \<star> inv \<epsilon>))) \<star> ((f \<star> inv \<eta>) \<cdot> (inv \<epsilon> \<star> f))) \<cdot>
                         ((f \<star> g) \<star> (\<epsilon> \<star> f) \<cdot> (f \<star> \<eta>)) \<cdot> (f \<star> \<eta>)"
         using comp_assoc by presburger
       also have "... = ((\<epsilon> \<star> (f \<star> inv \<eta>) \<cdot> (inv \<epsilon> \<star> f)) \<cdot>
                          ((f \<star> (inv \<eta> \<star> g) \<cdot> (g \<star> inv \<epsilon>)) \<star> f)) \<cdot>
                            (f \<star> (g \<star> \<epsilon>) \<cdot> (\<eta> \<star> g) \<star> f) \<cdot> (f \<star> \<eta>)"
       proof -
         have "(\<epsilon> \<cdot> (f \<star> (inv \<eta> \<star> g) \<cdot> (g \<star> inv \<epsilon>))) \<star> ((f \<star> inv \<eta>) \<cdot> (inv \<epsilon> \<star> f)) =
               (\<epsilon> \<star> (f \<star> inv \<eta>) \<cdot> (inv \<epsilon> \<star> f)) \<cdot> ((f \<star> (inv \<eta> \<star> g) \<cdot> (g \<star> inv \<epsilon>)) \<star> f)"
         proof -
           have "seq \<epsilon> (f \<star> (inv \<eta> \<star> g) \<cdot> (g \<star> inv \<epsilon>))"
             using 2 antipar by simp
           moreover have "seq ((f \<star> inv \<eta>) \<cdot> (inv \<epsilon> \<star> f)) f"
             using antipar hcomp_assoc hcomp_obj_arr by auto
           ultimately show ?thesis
             using comp_assoc comp_arr_dom hcomp_obj_arr
                   interchange [of \<epsilon> "f \<star> (inv \<eta> \<star> g) \<cdot> (g \<star> inv \<epsilon>)" "(f \<star> inv \<eta>) \<cdot> (inv \<epsilon> \<star> f)" f]
             by simp
         qed
         moreover have "((f \<star> g) \<star> (\<epsilon> \<star> f) \<cdot> (f \<star> \<eta>)) \<cdot> (f \<star> \<eta>) =
                        (f \<star> (g \<star> \<epsilon>) \<cdot> (\<eta> \<star> g) \<star> f) \<cdot> (f \<star> \<eta>)"
         proof -
           have "((f \<star> g) \<star> (\<epsilon> \<star> f) \<cdot> (f \<star> \<eta>)) \<cdot> (f \<star> \<eta>) =
                 (f \<star> g \<star> \<epsilon> \<star> f) \<cdot> (f \<star> (g \<star> f) \<star> \<eta>) \<cdot> (f \<star> \<eta> \<star> src f)"
             using antipar comp_assoc hcomp_assoc whisker_left hcomp_arr_obj by simp
           also have "... = (f \<star> g \<star> \<epsilon> \<star> f) \<cdot> (f \<star> ((g \<star> f) \<star> \<eta>) \<cdot> (\<eta> \<cdot> src f))"
             using antipar comp_arr_dom whisker_left hcomp_arr_obj by simp
           also have "... = (f \<star> g \<star> \<epsilon> \<star> f) \<cdot> (f \<star> \<eta> \<star> \<eta>)"
             using antipar comp_arr_dom comp_cod_arr hcomp_arr_obj
                   interchange [of "g \<star> f" \<eta> \<eta> "src f"]
             by simp
           also have "... = (f \<star> g \<star> \<epsilon> \<star> f) \<cdot> (f \<star> \<eta> \<star> g \<star> f) \<cdot> (f \<star> src f \<star> \<eta>)"
             using antipar comp_arr_dom comp_cod_arr whisker_left
                   interchange [of \<eta> "src f" "g \<star> f" \<eta>]
             by simp
           also have "... = ((f \<star> g \<star> \<epsilon> \<star> f) \<cdot> (f \<star> \<eta> \<star> g \<star> f)) \<cdot> (f \<star> \<eta>)"
             using antipar comp_assoc by (simp add: hcomp_obj_arr)
           also have "... = (f \<star> (g \<star> \<epsilon>) \<cdot> (\<eta> \<star> g) \<star> f) \<cdot> (f \<star> \<eta>)"
             using antipar comp_assoc whisker_left whisker_right hcomp_assoc by simp
           finally show ?thesis by blast
         qed
         ultimately show ?thesis by simp
       qed
       also have "... = (\<epsilon> \<star> (f \<star> inv \<eta>) \<cdot> (inv \<epsilon> \<star> f)) \<cdot>
                          ((f \<star> (inv \<eta> \<star> g) \<cdot> (g \<star> inv \<epsilon>) \<star> f) \<cdot>
                            (f \<star> (g \<star> \<epsilon>) \<cdot> (\<eta> \<star> g) \<star> f)) \<cdot> (f \<star> \<eta>)"
         using comp_assoc hcomp_assoc antipar(1) antipar(2) by auto
       also have "... = (\<epsilon> \<star> (f \<star> inv \<eta>) \<cdot> (inv \<epsilon> \<star> f)) \<cdot>
                          ((f \<star> (inv \<eta> \<star> g) \<cdot> (g \<star> inv \<epsilon>) \<cdot> (g \<star> \<epsilon>) \<cdot> (\<eta> \<star> g) \<star> f)) \<cdot>
                            (f \<star> \<eta>)"
         using ide_left ide_right antipar comp_cod_arr comp_assoc whisker_left
         by (metis "1" "2" comp_ide_self unit_simps(1) unit_simps(3))
       also have "... = (\<epsilon> \<star> (f \<star> inv \<eta>) \<cdot> (inv \<epsilon> \<star> f)) \<cdot> (f \<star> \<eta>)"
       proof -
         have "(inv \<eta> \<star> g) \<cdot> (g \<star> inv \<epsilon>) \<cdot> (g \<star> \<epsilon>) \<cdot> (\<eta> \<star> g) = g"
           using ide_left ide_right antipar comp_arr_dom comp_assoc
           by (metis "1" "2" comp_ide_self)
         thus ?thesis
           using antipar comp_cod_arr by simp
       qed
       also have "... = (f \<star> inv \<eta>) \<cdot> ((inv \<epsilon> \<star> f) \<cdot> (\<epsilon> \<star> f)) \<cdot> (f \<star> \<eta>)"
       proof -
         have "(\<epsilon> \<star> (f \<star> inv \<eta>) \<cdot> (inv \<epsilon> \<star> f)) \<cdot> (f \<star> \<eta>) =
               (trg f \<cdot> \<epsilon> \<star> (f \<star> inv \<eta>) \<cdot> (inv \<epsilon> \<star> f)) \<cdot> (f \<star> \<eta>)"
           using hcomp_obj_arr comp_cod_arr by simp
         also have "... = ((trg f \<star> f \<star> inv \<eta>) \<cdot> (\<epsilon> \<star> inv \<epsilon> \<star> f)) \<cdot> (f \<star> \<eta>)"
           using antipar hcomp_arr_obj hcomp_assoc interchange by auto
         also have "... = (f \<star> inv \<eta>) \<cdot> ((inv \<epsilon> \<star> f) \<cdot> (\<epsilon> \<star> f)) \<cdot> (f \<star> \<eta>)"
         proof -
           have "(inv \<epsilon> \<star> f) \<cdot> (\<epsilon> \<star> f) = (trg f \<star> inv \<epsilon> \<star> f) \<cdot> (\<epsilon> \<star> trg f \<star> f)"
             using hseqI' by (simp add: hcomp_obj_arr)
           also have "... = \<epsilon> \<star> inv \<epsilon> \<star> f"
             using antipar comp_arr_dom comp_cod_arr
                   interchange [of "trg f" \<epsilon> "inv \<epsilon> \<star> f" "trg f \<star> f"]
             by force
           finally have "(inv \<epsilon> \<star> f) \<cdot> (\<epsilon> \<star> f) = \<epsilon> \<star> inv \<epsilon> \<star> f" by simp
           moreover have "trg f \<star> f \<star> inv \<eta> = f \<star> inv \<eta>"
             using hcomp_obj_arr [of "trg f" "f \<star> inv \<eta>"] by fastforce
           ultimately have "((trg f \<star> f \<star> inv \<eta>) \<cdot> (\<epsilon> \<star> inv \<epsilon> \<star> f)) \<cdot> (f \<star> \<eta>) =
                            ((f \<star> inv \<eta>) \<cdot> ((inv \<epsilon> \<star> f) \<cdot> (\<epsilon> \<star> f))) \<cdot> (f \<star> \<eta>)"
             by simp
           thus ?thesis
             using comp_assoc by simp
         qed
         finally show ?thesis by simp
       qed
       also have "... = f \<star> inv \<eta> \<cdot> \<eta>"
       proof -
         have "(inv \<epsilon> \<star> f) \<cdot> (\<epsilon> \<star> f) = f \<star> g \<star> f"
           using ide_left ide_right antipar counit_is_iso whisker_right hcomp_assoc
           by (metis comp_arr_dom comp_inv_arr' counit_simps(1) counit_simps(2) seqE)
         thus ?thesis
           using ide_left ide_right antipar unit_is_iso comp_cod_arr
           by (metis arr_inv dom_inv unit_simps(1) unit_simps(3) seqI whisker_left)
       qed
       also have "... = f \<star> src f"
         using antipar by (simp add: comp_inv_arr')
       also have "... = f"
         using hcomp_arr_obj by simp
       finally show ?thesis by simp
     qed
 
   end
 
   text \<open>
     Now we use strictification to generalize the preceding result to arbitrary bicategories.
     I originally attempted to generalize this proof directly from the strict case, by filling
     in the necessary canonical isomorphisms, but it turned out to be too daunting.
     The proof using strictification is still fairly tedious, but it is manageable.
   \<close>
 
   context equivalence_in_bicategory
   begin
 
     interpretation S: strictified_bicategory V H \<a> \<i> src trg ..
 
     notation S.vcomp  (infixr "\<cdot>\<^sub>S" 55)
     notation S.hcomp  (infixr "\<star>\<^sub>S" 53)
     notation S.in_hom  ("\<guillemotleft>_ : _ \<Rightarrow>\<^sub>S _\<guillemotright>")
     notation S.in_hhom  ("\<guillemotleft>_ : _ \<rightarrow>\<^sub>S _\<guillemotright>")
 
     interpretation UP: equivalence_pseudofunctor V H \<a> \<i> src trg
                           S.vcomp S.hcomp S.\<a> S.\<i> S.src S.trg S.UP S.\<Phi>
       using S.UP_is_equivalence_pseudofunctor by auto
     interpretation UP: pseudofunctor_into_strict_bicategory V H \<a> \<i> src trg
                           S.vcomp S.hcomp S.\<a> S.\<i> S.src S.trg S.UP S.\<Phi>
       ..
     interpretation E: equivalence_in_bicategory S.vcomp S.hcomp S.\<a> S.\<i> S.src S.trg
                         \<open>S.UP f\<close> \<open>S.UP g\<close>
                         \<open>S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta> \<cdot>\<^sub>S UP.\<Psi> (src f)\<close>
                         \<open>S.inv (UP.\<Psi> (trg f)) \<cdot>\<^sub>S S.UP \<epsilon> \<cdot>\<^sub>S S.\<Phi> (f, g)\<close>
       using equivalence_in_bicategory_axioms UP.preserves_equivalence [of f g \<eta> \<epsilon>] by auto
     interpretation E: equivalence_in_strict_bicategory S.vcomp S.hcomp S.\<a> S.\<i> S.src S.trg
                         \<open>S.UP f\<close> \<open>S.UP g\<close>
                         \<open>S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta> \<cdot>\<^sub>S UP.\<Psi> (src f)\<close>
                         \<open>S.inv (UP.\<Psi> (trg f)) \<cdot>\<^sub>S S.UP \<epsilon> \<cdot>\<^sub>S S.\<Phi> (f, g)\<close>
       ..
 
     lemma UP_triangle:
     shows "S.UP ((g \<star> \<epsilon>) \<cdot> \<a>[g, f, g] \<cdot> (\<eta> \<star> g)) =
             S.\<Phi> (g, src g) \<cdot>\<^sub>S (S.UP g \<star>\<^sub>S S.UP \<epsilon> \<cdot>\<^sub>S S.\<Phi> (f, g)) \<cdot>\<^sub>S
               (S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta> \<star>\<^sub>S S.UP g) \<cdot>\<^sub>S S.inv (S.\<Phi> (trg g, g))"
     and "S.UP (\<r>\<^sup>-\<^sup>1[g] \<cdot> \<l>[g]) =
             (S.\<Phi> (g, src g) \<cdot>\<^sub>S (S.UP g \<star>\<^sub>S UP.\<Psi> (src g))) \<cdot>\<^sub>S
                (S.inv (UP.\<Psi> (trg g)) \<star>\<^sub>S S.UP g) \<cdot>\<^sub>S S.inv (S.\<Phi> (trg g, g))"
     and "S.UP ((\<epsilon> \<star> f) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f] \<cdot> (f \<star> \<eta>)) =
             S.\<Phi> (trg f, f) \<cdot>\<^sub>S (S.UP \<epsilon> \<cdot>\<^sub>S S.\<Phi> (f, g) \<star>\<^sub>S S.UP f) \<cdot>\<^sub>S
               (S.UP f \<star>\<^sub>S S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta>) \<cdot>\<^sub>S S.inv (S.\<Phi> (f, src f))"
     and "S.UP (\<l>\<^sup>-\<^sup>1[f] \<cdot> \<r>[f]) =
             (S.\<Phi> (trg f, f) \<cdot>\<^sub>S (UP.\<Psi> (trg f) \<star>\<^sub>S S.UP f)) \<cdot>\<^sub>S
               (S.UP f \<star>\<^sub>S S.inv (UP.\<Psi> (src f))) \<cdot>\<^sub>S S.inv (S.\<Phi> (f, src f))"
     and "(g \<star> \<epsilon>) \<cdot> \<a>[g, f, g] \<cdot> (\<eta> \<star> g) = \<r>\<^sup>-\<^sup>1[g] \<cdot> \<l>[g] \<Longrightarrow>
             S.\<Phi> (trg f, f) \<cdot>\<^sub>S (S.UP \<epsilon> \<cdot>\<^sub>S S.\<Phi> (f, g) \<star>\<^sub>S S.UP f) \<cdot>\<^sub>S
                  (S.UP f \<star>\<^sub>S S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta>) \<cdot>\<^sub>S S.inv (S.\<Phi> (f, src f)) =
                (S.\<Phi> (trg f, f) \<cdot>\<^sub>S (UP.\<Psi> (trg f) \<star>\<^sub>S S.UP f)) \<cdot>\<^sub>S
                  (S.UP f \<star>\<^sub>S S.inv (UP.\<Psi> (src f))) \<cdot>\<^sub>S S.inv (S.\<Phi> (f, src f))"
     proof -
       show T1: "S.UP ((g \<star> \<epsilon>) \<cdot> \<a>[g, f, g] \<cdot> (\<eta> \<star> g)) =
                 S.\<Phi> (g, src g) \<cdot>\<^sub>S (S.UP g \<star>\<^sub>S S.UP \<epsilon> \<cdot>\<^sub>S S.\<Phi> (f, g)) \<cdot>\<^sub>S
                   (S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta> \<star>\<^sub>S S.UP g) \<cdot>\<^sub>S S.inv (S.\<Phi> (trg g, g))"
       proof -
         have "S.UP ((g \<star> \<epsilon>) \<cdot> \<a>[g, f, g] \<cdot> (\<eta> \<star> g)) =
                 S.UP (g \<star> \<epsilon>) \<cdot>\<^sub>S S.UP \<a>[g, f, g] \<cdot>\<^sub>S S.UP (\<eta> \<star> g)"
           using antipar by simp
         also have "... = (S.\<Phi> (g, src g) \<cdot>\<^sub>S (S.UP g \<star>\<^sub>S S.UP \<epsilon>) \<cdot>\<^sub>S ((S.inv (S.\<Phi> (g, f \<star> g)) \<cdot>\<^sub>S
                            S.\<Phi> (g, f \<star> g)) \<cdot>\<^sub>S (S.UP g \<star>\<^sub>S S.\<Phi> (f, g))) \<cdot>\<^sub>S
                              (((S.inv (S.\<Phi> (g, f)) \<star>\<^sub>S S.UP g) \<cdot>\<^sub>S (S.inv (S.\<Phi> (g \<star> f, g)))) \<cdot>\<^sub>S
                            S.\<Phi> (g \<star> f, g)) \<cdot>\<^sub>S (S.UP \<eta> \<star>\<^sub>S S.UP g)) \<cdot>\<^sub>S S.inv (S.\<Phi> (trg g, g))"
         proof -
           have "S.UP \<a>[g, f, g] =
                 S.\<Phi> (g, f \<star> g) \<cdot>\<^sub>S (S.UP g \<star>\<^sub>S S.\<Phi> (f, g)) \<cdot>\<^sub>S (S.inv (S.\<Phi> (g, f)) \<star>\<^sub>S S.UP g) \<cdot>\<^sub>S
                   S.inv (S.\<Phi> (g \<star> f, g))"
             using ide_left ide_right antipar UP.image_of_associator [of g f g] by simp
           moreover have
             "S.UP (g \<star> \<epsilon>) = S.\<Phi> (g, src g) \<cdot>\<^sub>S (S.UP g \<star>\<^sub>S S.UP \<epsilon>) \<cdot>\<^sub>S S.inv (S.\<Phi> (g, f \<star> g))"
           proof -
             have "S.seq (S.\<Phi> (g, src g)) (S.UP g \<star>\<^sub>S S.UP \<epsilon>)"
               using antipar UP.FF_def UP.\<Phi>_in_hom [of g "src g"]
               apply (intro S.seqI) by auto
             moreover have
               "S.UP (g \<star> \<epsilon>) \<cdot>\<^sub>S S.\<Phi> (g, f \<star> g) = S.\<Phi> (g, src g) \<cdot>\<^sub>S (S.UP g \<star>\<^sub>S S.UP \<epsilon>)"
               using antipar UP.\<Phi>.naturality [of "(g, \<epsilon>)"] UP.FF_def VV.arr_char by simp
             moreover have "S.iso (S.\<Phi> (g, f \<star> g))"
               using antipar by simp
             ultimately show ?thesis
               using antipar S.comp_assoc
                     S.invert_side_of_triangle(2)
                       [of "S.\<Phi> (g, src g) \<cdot>\<^sub>S (S.UP g \<star>\<^sub>S S.UP \<epsilon>)" "S.UP (g \<star> \<epsilon>)" "S.\<Phi> (g, f \<star> g)"]
               by simp
           qed
           moreover have "S.UP (\<eta> \<star> g) =
                          (S.\<Phi> (g \<star> f, g) \<cdot>\<^sub>S (S.UP \<eta> \<star>\<^sub>S S.UP g)) \<cdot>\<^sub>S S.inv (S.\<Phi> (trg g, g))"
           proof -
             have "S.UP (\<eta> \<star> g) \<cdot>\<^sub>S S.\<Phi> (trg g, g) = S.\<Phi> (g \<star> f, g) \<cdot>\<^sub>S (S.UP \<eta> \<star>\<^sub>S S.UP g)"
               using antipar UP.\<Phi>.naturality [of "(\<eta>, g)"] UP.FF_def VV.arr_char by simp
             moreover have "S.seq (S.\<Phi> (g \<star> f, g)) (S.UP \<eta> \<star>\<^sub>S S.UP g)"
               using antipar UP.\<Phi>_in_hom(2) by (intro S.seqI, auto)
             ultimately show ?thesis
               using antipar S.invert_side_of_triangle(2) by simp
           qed
           ultimately show ?thesis
             using S.comp_assoc by simp
         qed
         also have "... = S.\<Phi> (g, src g) \<cdot>\<^sub>S
                            ((S.UP g \<star>\<^sub>S S.UP \<epsilon>) \<cdot>\<^sub>S (S.UP g \<star>\<^sub>S S.\<Phi> (f, g))) \<cdot>\<^sub>S
                            ((S.inv (S.\<Phi> (g, f)) \<star>\<^sub>S S.UP g) \<cdot>\<^sub>S (S.UP \<eta> \<star>\<^sub>S S.UP g)) \<cdot>\<^sub>S
                            S.inv (S.\<Phi> (trg g, g))"
         proof -
           have "(S.inv (S.\<Phi> (g \<star> f, g)) \<cdot>\<^sub>S S.\<Phi> (g \<star> f, g)) \<cdot>\<^sub>S (S.UP \<eta> \<star>\<^sub>S S.UP g) =
                 (S.UP \<eta> \<star>\<^sub>S S.UP g)"
             using antipar S.comp_inv_arr' S.comp_cod_arr by auto
           moreover have "(S.inv (S.\<Phi> (g, f \<star> g)) \<cdot>\<^sub>S S.\<Phi> (g, f \<star> g)) \<cdot>\<^sub>S (S.UP g \<star>\<^sub>S S.\<Phi> (f, g)) =
                          (S.UP g \<star>\<^sub>S S.\<Phi> (f, g))"
           proof -
             have "S.inv (S.\<Phi> (g, f \<star> g)) \<cdot>\<^sub>S S.\<Phi> (g, f \<star> g) = S.UP g \<star>\<^sub>S S.UP (f \<star> g)"
               using antipar S.comp_inv_arr' UP.\<Phi>_in_hom by auto
             thus ?thesis
               using antipar VV.arr_char S.comp_cod_arr by simp
           qed
           ultimately show ?thesis
             using S.comp_assoc by simp
         qed
         also have "... = S.\<Phi> (g, src g) \<cdot>\<^sub>S (S.UP g \<star>\<^sub>S S.UP \<epsilon> \<cdot>\<^sub>S S.\<Phi> (f, g)) \<cdot>\<^sub>S
                            (S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta> \<star>\<^sub>S S.UP g) \<cdot>\<^sub>S S.inv (S.\<Phi> (trg g, g))"
             using antipar VV.arr_char S.whisker_left S.whisker_right by auto
         finally show ?thesis by simp
       qed
       show T2: "S.UP (\<r>\<^sup>-\<^sup>1[g] \<cdot> \<l>[g]) =
                 (S.\<Phi> (g, src g) \<cdot>\<^sub>S (S.UP g \<star>\<^sub>S UP.\<Psi> (src g))) \<cdot>\<^sub>S
                    (S.inv (UP.\<Psi> (trg g)) \<star>\<^sub>S S.UP g) \<cdot>\<^sub>S S.inv (S.\<Phi> (trg g, g))"
         using UP.image_of_unitor by simp
       show "S.UP ((\<epsilon> \<star> f) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f] \<cdot> (f \<star> \<eta>)) =
             S.\<Phi> (trg f, f) \<cdot>\<^sub>S (S.UP \<epsilon> \<cdot>\<^sub>S S.\<Phi> (f, g) \<star>\<^sub>S S.UP f) \<cdot>\<^sub>S
               (S.UP f \<star>\<^sub>S S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta>) \<cdot>\<^sub>S S.inv (S.\<Phi> (f, src f))"
       proof -
         have "S.UP ((\<epsilon> \<star> f) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f] \<cdot> (f \<star> \<eta>)) =
                  S.UP (\<epsilon> \<star> f) \<cdot>\<^sub>S S.UP \<a>\<^sup>-\<^sup>1[f, g, f] \<cdot>\<^sub>S S.UP (f \<star> \<eta>)"
           using antipar by simp
         also have "... = S.\<Phi> (trg f, f) \<cdot>\<^sub>S (S.UP \<epsilon> \<star>\<^sub>S S.UP f) \<cdot>\<^sub>S (S.inv (S.\<Phi> (f \<star> g, f)) \<cdot>\<^sub>S
                            S.\<Phi> (f \<star> g, f) \<cdot>\<^sub>S (S.\<Phi> (f, g) \<star>\<^sub>S S.UP f)) \<cdot>\<^sub>S
                              (S.UP f \<star>\<^sub>S S.inv (S.\<Phi> (g, f))) \<cdot>\<^sub>S (S.inv (S.\<Phi> (f, g \<star> f)) \<cdot>\<^sub>S
                            S.\<Phi> (f, g \<star> f) \<cdot>\<^sub>S (S.UP f \<star>\<^sub>S S.UP \<eta>)) \<cdot>\<^sub>S S.inv (S.\<Phi> (f, src f))"
         proof -
           have "S.UP \<a>\<^sup>-\<^sup>1[f, g, f] =
                 S.\<Phi> (f \<star> g, f) \<cdot>\<^sub>S (S.\<Phi> (f, g) \<star>\<^sub>S S.UP f) \<cdot>\<^sub>S (S.UP f \<star>\<^sub>S S.inv (S.\<Phi> (g, f))) \<cdot>\<^sub>S
                    S.inv (S.\<Phi> (f, g \<star> f))"
             using ide_left ide_right antipar UP.image_of_associator by simp
           moreover have "S.UP (\<epsilon> \<star> f) =
                          S.\<Phi> (trg f, f) \<cdot>\<^sub>S (S.UP \<epsilon> \<star>\<^sub>S S.UP f) \<cdot>\<^sub>S S.inv (S.\<Phi> (f \<star> g, f))"
           proof -
             have "S.seq (S.\<Phi> (trg f, f)) (S.UP \<epsilon> \<star>\<^sub>S S.UP f)"
               using antipar UP.FF_def VV.ide_char VV.arr_char UP.\<Phi>_in_hom [of "trg f" f]
               apply (intro S.seqI) by auto
             moreover have
               "S.\<Phi> (trg f, f) \<cdot>\<^sub>S (S.UP \<epsilon> \<star>\<^sub>S S.UP f) = S.UP (\<epsilon> \<star> f) \<cdot>\<^sub>S S.\<Phi> (f \<star> g, f)"
               using antipar UP.\<Phi>.naturality [of "(\<epsilon>, f)"] UP.FF_def VV.arr_char by simp
             moreover have "S.iso (S.\<Phi> (f \<star> g, f))"
               using antipar by simp
             ultimately show ?thesis
               using antipar S.comp_assoc
                     S.invert_side_of_triangle(2)
                       [of "S.\<Phi> (trg f, f) \<cdot>\<^sub>S (S.UP \<epsilon> \<star>\<^sub>S S.UP f)" "S.UP (\<epsilon> \<star> f)" "S.\<Phi> (f \<star> g, f)"]
               by metis
           qed
           moreover have "S.UP (f \<star> \<eta>) =
                         (S.\<Phi> (f, g \<star> f) \<cdot>\<^sub>S (S.UP f \<star>\<^sub>S S.UP \<eta>)) \<cdot>\<^sub>S S.inv (S.\<Phi> (f, src f))"
           proof -
             have "S.\<Phi> (f, g \<star> f) \<cdot>\<^sub>S (S.UP f \<star>\<^sub>S S.UP \<eta>) = S.UP (f \<star> \<eta>) \<cdot>\<^sub>S S.\<Phi> (f, src f)"
               using antipar UP.\<Phi>.naturality [of "(f, \<eta>)"] UP.FF_def VV.arr_char by simp
             moreover have "S.seq (S.\<Phi> (f, g \<star> f)) (S.UP f \<star>\<^sub>S S.UP \<eta>)"
               using antipar by (intro S.seqI, auto)
             ultimately show ?thesis
               using antipar S.invert_side_of_triangle(2) by auto
           qed
           ultimately show ?thesis
             using S.comp_assoc by simp
         qed
         also have "... = S.\<Phi> (trg f, f) \<cdot>\<^sub>S
                            ((S.UP \<epsilon> \<star>\<^sub>S S.UP f) \<cdot>\<^sub>S (S.\<Phi> (f, g) \<star>\<^sub>S S.UP f)) \<cdot>\<^sub>S
                            ((S.UP f \<star>\<^sub>S S.inv (S.\<Phi> (g, f))) \<cdot>\<^sub>S (S.UP f \<star>\<^sub>S S.UP \<eta>)) \<cdot>\<^sub>S
                            S.inv (S.\<Phi> (f, src f))"
         proof -
           have "(S.inv (S.\<Phi> (f \<star> g, f)) \<cdot>\<^sub>S S.\<Phi> (f \<star> g, f)) \<cdot>\<^sub>S (S.\<Phi> (f, g) \<star>\<^sub>S S.UP f) =
                 (S.\<Phi> (f, g) \<star>\<^sub>S S.UP f)"
             using antipar S.comp_cod_arr VV.arr_char S.comp_inv_arr' by auto
           moreover have "(S.inv (S.\<Phi> (f, g \<star> f)) \<cdot>\<^sub>S S.\<Phi> (f, g \<star> f)) \<cdot>\<^sub>S (S.UP f \<star>\<^sub>S S.UP \<eta>) =
                          (S.UP f \<star>\<^sub>S S.UP \<eta>)"
             using antipar S.comp_inv_arr' S.comp_cod_arr by auto
           ultimately show ?thesis
             using S.comp_assoc by simp
         qed
         also have "... = S.\<Phi> (trg f, f) \<cdot>\<^sub>S (S.UP \<epsilon> \<cdot>\<^sub>S S.\<Phi> (f, g) \<star>\<^sub>S S.UP f) \<cdot>\<^sub>S
                            (S.UP f \<star>\<^sub>S S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta>) \<cdot>\<^sub>S S.inv (S.\<Phi> (f, src f))"
             using antipar VV.arr_char S.whisker_left S.whisker_right by auto
         finally show ?thesis by simp
       qed
       show "S.UP (\<l>\<^sup>-\<^sup>1[f] \<cdot> \<r>[f]) =
             (S.\<Phi> (trg f, f) \<cdot>\<^sub>S (UP.\<Psi> (trg f) \<star>\<^sub>S S.UP f)) \<cdot>\<^sub>S
               (S.UP f \<star>\<^sub>S S.inv (UP.\<Psi> (src f))) \<cdot>\<^sub>S S.inv (S.\<Phi> (f, src f))"
         using UP.image_of_unitor by simp
       show "(g \<star> \<epsilon>) \<cdot> \<a>[g, f, g] \<cdot> (\<eta> \<star> g) = \<r>\<^sup>-\<^sup>1[g] \<cdot> \<l>[g] \<Longrightarrow>
               S.\<Phi> (trg f, f) \<cdot>\<^sub>S (S.UP \<epsilon> \<cdot>\<^sub>S S.\<Phi> (f, g) \<star>\<^sub>S S.UP f) \<cdot>\<^sub>S
                   (S.UP f \<star>\<^sub>S S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta>) \<cdot>\<^sub>S S.inv (S.\<Phi> (f, src f)) =
               (S.\<Phi> (trg f, f) \<cdot>\<^sub>S (UP.\<Psi> (trg f) \<star>\<^sub>S S.UP f)) \<cdot>\<^sub>S
                   (S.UP f \<star>\<^sub>S S.inv (UP.\<Psi> (src f))) \<cdot>\<^sub>S S.inv (S.\<Phi> (f, src f))"
       proof -
         assume A: "(g \<star> \<epsilon>) \<cdot> \<a>[g, f, g] \<cdot> (\<eta> \<star> g) = \<r>\<^sup>-\<^sup>1[g] \<cdot> \<l>[g]"
         have B: "(S.UP g \<star>\<^sub>S S.inv (UP.\<Psi> (src g)) \<cdot>\<^sub>S S.UP \<epsilon> \<cdot>\<^sub>S S.\<Phi> (f, g)) \<cdot>\<^sub>S
                    (S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta> \<cdot>\<^sub>S UP.\<Psi> (trg g) \<star>\<^sub>S S.UP g) = S.UP g"
         proof -
           show "(S.UP g \<star>\<^sub>S S.inv (UP.\<Psi> (src g)) \<cdot>\<^sub>S S.UP \<epsilon> \<cdot>\<^sub>S S.\<Phi> (f, g)) \<cdot>\<^sub>S
                 (S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta> \<cdot>\<^sub>S UP.\<Psi> (trg g) \<star>\<^sub>S S.UP g) = S.UP g"
           proof -
             have 2: "S.\<Phi> (g, src g) \<cdot>\<^sub>S (S.UP g \<star>\<^sub>S S.UP \<epsilon> \<cdot>\<^sub>S S.\<Phi> (f, g)) \<cdot>\<^sub>S
                        (S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta> \<star>\<^sub>S S.UP g) \<cdot>\<^sub>S S.inv (S.\<Phi> (trg g, g)) =
                      (S.\<Phi> (g, src g) \<cdot>\<^sub>S (S.UP g \<star>\<^sub>S UP.\<Psi> (src g))) \<cdot>\<^sub>S
                        (S.inv (UP.\<Psi> (trg g)) \<star>\<^sub>S S.UP g) \<cdot>\<^sub>S S.inv (S.\<Phi> (trg g, g))"
               using A T1 T2 by simp
             show ?thesis
             proof -
               have 8: "S.seq (S.\<Phi> (g, src g))
                              ((S.UP g \<star>\<^sub>S S.UP \<epsilon> \<cdot>\<^sub>S S.\<Phi> (f, g)) \<cdot>\<^sub>S
                                (S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta> \<star>\<^sub>S S.UP g) \<cdot>\<^sub>S
                                S.inv (S.\<Phi> (trg g, g)))"
                 using antipar VV.arr_char S.hcomp_assoc
                 apply (intro S.seqI) by auto
               have 7: "S.seq (S.\<Phi> (g, src g))
                              ((S.UP g \<star>\<^sub>S UP.\<Psi> (src g)) \<cdot>\<^sub>S (S.inv (UP.\<Psi> (trg g)) \<star>\<^sub>S S.UP g) \<cdot>\<^sub>S
                                S.inv (S.\<Phi> (trg g, g)))"
                 using antipar 2 8 S.comp_assoc by auto
               have 5: "(S.UP g \<star>\<^sub>S S.UP \<epsilon> \<cdot>\<^sub>S S.\<Phi> (f, g)) \<cdot>\<^sub>S
                          (S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta> \<star>\<^sub>S S.UP g) =
                        (S.UP g \<star>\<^sub>S UP.\<Psi> (src g)) \<cdot>\<^sub>S (S.inv (UP.\<Psi> (trg g)) \<star>\<^sub>S S.UP g)"
               proof -
                 have "((S.UP g \<star>\<^sub>S S.UP \<epsilon> \<cdot>\<^sub>S S.\<Phi> (f, g)) \<cdot>\<^sub>S (S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S
                         S.UP \<eta> \<star>\<^sub>S S.UP g)) \<cdot>\<^sub>S S.inv (S.\<Phi> (trg g, g)) =
                       ((S.UP g \<star>\<^sub>S UP.\<Psi> (src g)) \<cdot>\<^sub>S (S.inv (UP.\<Psi> (trg g)) \<star>\<^sub>S S.UP g)) \<cdot>\<^sub>S
                         S.inv (S.\<Phi> (trg g, g))"
                 proof -
                   have "S.mono (S.\<Phi> (g, src g))"
                     using antipar S.iso_is_section S.section_is_mono by simp
                   thus ?thesis
                     using 2 8 7 S.monoE S.comp_assoc by presburger
                 qed
                 moreover have "S.epi (S.inv (S.\<Phi> (trg g, g)))"
                   using antipar S.iso_is_retraction S.retraction_is_epi S.iso_inv_iso
                   by simp
                 moreover have "S.seq ((S.UP g \<star>\<^sub>S S.UP \<epsilon> \<cdot>\<^sub>S S.\<Phi> (f, g)) \<cdot>\<^sub>S (S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S
                                       S.UP \<eta> \<star>\<^sub>S S.UP g))
                                      (S.inv (S.\<Phi> (trg g, g)))"
                   using S.comp_assoc S.seq_char 8 by presburger
                 moreover have
                   "S.seq ((S.UP g \<star>\<^sub>S UP.\<Psi> (src g)) \<cdot>\<^sub>S (S.inv (UP.\<Psi> (trg g)) \<star>\<^sub>S S.UP g))
                          (S.inv (S.\<Phi> (trg g, g)))"
                   using antipar calculation(1) calculation(3) by presburger
                 ultimately show ?thesis
                   using 2 S.epiE by blast
               qed
               have 6: "S.seq (S.UP g \<star>\<^sub>S S.UP \<epsilon> \<cdot>\<^sub>S S.\<Phi> (f, g))
                              (S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta> \<star>\<^sub>S S.UP g)"
                 using antipar VV.arr_char S.hcomp_assoc by auto
               have 3: "(S.UP g \<star>\<^sub>S S.inv (UP.\<Psi> (src g))) \<cdot>\<^sub>S (S.UP g \<star>\<^sub>S S.UP \<epsilon> \<cdot>\<^sub>S S.\<Phi> (f, g)) \<cdot>\<^sub>S
                        (S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta> \<star>\<^sub>S S.UP g) =
                        (S.inv (UP.\<Psi> (trg g)) \<star>\<^sub>S S.UP g)"
               proof -
                 have "S.seq (S.UP g \<star>\<^sub>S S.UP \<epsilon> \<cdot>\<^sub>S S.\<Phi> (f, g))
                             (S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta> \<star>\<^sub>S S.UP g)"
                   using 6 by simp
                 moreover have "(S.UP g \<star>\<^sub>S UP.\<Psi> (src g)) \<cdot>\<^sub>S (S.inv (UP.\<Psi> (trg g)) \<star>\<^sub>S S.UP g) =
                                (S.UP g \<star>\<^sub>S S.UP \<epsilon> \<cdot>\<^sub>S S.\<Phi> (f, g)) \<cdot>\<^sub>S
                                  (S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta> \<star>\<^sub>S S.UP g)"
                   using 5 by argo
                 moreover have "S.iso (S.UP g \<star>\<^sub>S UP.\<Psi> (src g))"
                   using antipar UP.\<Psi>_char S.UP_map\<^sub>0_obj by simp
                 moreover have "S.inv (S.UP g \<star>\<^sub>S UP.\<Psi> (src g)) =
                                S.UP g \<star>\<^sub>S S.inv (UP.\<Psi> (src g))"
                   using antipar UP.\<Psi>_char S.UP_map\<^sub>0_obj by simp
                 ultimately show ?thesis
                   using S.invert_side_of_triangle(1)
                           [of "(S.UP g \<star>\<^sub>S S.UP \<epsilon> \<cdot>\<^sub>S S.\<Phi> (f, g)) \<cdot>\<^sub>S
                                  (S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta> \<star>\<^sub>S S.UP g)"
                               "S.UP g \<star>\<^sub>S UP.\<Psi> (src g)" "S.inv (UP.\<Psi> (trg g)) \<star>\<^sub>S S.UP g"]
                   by presburger
               qed
               have 4: "(((S.UP g \<star>\<^sub>S S.inv (UP.\<Psi> (src g))) \<cdot>\<^sub>S
                          (S.UP g \<star>\<^sub>S S.UP \<epsilon> \<cdot>\<^sub>S S.\<Phi> (f, g))) \<cdot>\<^sub>S
                          ((S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta> \<star>\<^sub>S S.UP g)) \<cdot>\<^sub>S (UP.\<Psi> (trg g) \<star>\<^sub>S S.UP g))
                        = S.UP g"
               proof -
                 have "(((S.UP g \<star>\<^sub>S S.inv (UP.\<Psi> (src g))) \<cdot>\<^sub>S (S.UP g \<star>\<^sub>S S.UP \<epsilon> \<cdot>\<^sub>S S.\<Phi> (f, g))) \<cdot>\<^sub>S
                          ((S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta> \<star>\<^sub>S S.UP g)) \<cdot>\<^sub>S (UP.\<Psi> (trg g) \<star>\<^sub>S S.UP g)) =
                       (((S.UP g \<star>\<^sub>S S.inv (UP.\<Psi> (src g))) \<cdot>\<^sub>S (S.UP g \<star>\<^sub>S S.UP \<epsilon> \<cdot>\<^sub>S S.\<Phi> (f, g))) \<cdot>\<^sub>S
                          ((S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta> \<star>\<^sub>S S.UP g))) \<cdot>\<^sub>S (UP.\<Psi> (trg g) \<star>\<^sub>S S.UP g)"
                   using S.comp_assoc by simp
                 also have "... = (S.inv (UP.\<Psi> (trg g)) \<star>\<^sub>S S.UP g) \<cdot>\<^sub>S (UP.\<Psi> (trg g) \<star>\<^sub>S S.UP g)"
                   using 3 S.comp_assoc by auto
                 also have "... = S.inv (UP.\<Psi> (trg g)) \<cdot>\<^sub>S UP.\<Psi> (trg g) \<star>\<^sub>S S.UP g"
                   using UP.\<Psi>_char(2) S.whisker_right by auto
                 also have "... = UP.map\<^sub>0 (trg g) \<star>\<^sub>S S.UP g"
                   using UP.\<Psi>_char [of "trg g"] S.comp_inv_arr S.inv_is_inverse by simp
                 also have "... = S.UP g"
                   using S.UP_map\<^sub>0_obj by (simp add: S.hcomp_obj_arr)
                 finally show ?thesis by blast
               qed
               thus ?thesis
                 using antipar S.whisker_left S.whisker_right UP.\<Psi>_char S.comp_assoc by simp
             qed
           qed
         qed
         show "S.\<Phi> (trg f, f) \<cdot>\<^sub>S (S.UP \<epsilon> \<cdot>\<^sub>S S.\<Phi> (f, g) \<star>\<^sub>S S.UP f) \<cdot>\<^sub>S
                 (S.UP f \<star>\<^sub>S S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta>) \<cdot>\<^sub>S S.inv (S.\<Phi> (f, src f)) =
               (S.\<Phi> (trg f, f) \<cdot>\<^sub>S (UP.\<Psi> (trg f) \<star>\<^sub>S S.UP f)) \<cdot>\<^sub>S
                 (S.UP f \<star>\<^sub>S S.inv (UP.\<Psi> (src f))) \<cdot>\<^sub>S S.inv (S.\<Phi> (f, src f))"
         proof -
           have "(S.UP \<epsilon> \<cdot>\<^sub>S S.\<Phi> (f, g) \<star>\<^sub>S S.UP f) \<cdot>\<^sub>S (S.UP f \<star>\<^sub>S S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta>) =
                    (UP.\<Psi> (trg f) \<star>\<^sub>S S.UP f) \<cdot>\<^sub>S (S.UP f \<star>\<^sub>S S.inv (UP.\<Psi> (src f)))"
           proof -
             have 2: "(S.inv (UP.\<Psi> (trg f)) \<star>\<^sub>S S.UP f) \<cdot>\<^sub>S
                         ((S.UP \<epsilon> \<cdot>\<^sub>S S.\<Phi> (f, g) \<star>\<^sub>S S.UP f) \<cdot>\<^sub>S
                           (S.UP f \<star>\<^sub>S S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta>)) \<cdot>\<^sub>S
                         (S.UP f \<star>\<^sub>S UP.\<Psi> (src f)) =
                      S.UP f"
             proof -
               have "S.UP f = (S.inv (UP.\<Psi> (trg f)) \<cdot>\<^sub>S S.UP \<epsilon> \<cdot>\<^sub>S S.\<Phi> (f, g) \<star>\<^sub>S S.UP f) \<cdot>\<^sub>S
                                (S.UP f \<star>\<^sub>S S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta> \<cdot>\<^sub>S UP.\<Psi> (src f))"
                 using B antipar E.triangle_right_implies_left by argo
               also have "... = (S.inv (UP.\<Psi> (trg f)) \<star>\<^sub>S S.UP f) \<cdot>\<^sub>S
                                  ((S.UP \<epsilon> \<cdot>\<^sub>S S.\<Phi> (f, g) \<star>\<^sub>S S.UP f) \<cdot>\<^sub>S
                                     (S.UP f \<star>\<^sub>S S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta>)) \<cdot>\<^sub>S
                                  (S.UP f \<star>\<^sub>S UP.\<Psi> (src f))"
               proof -
                 have "S.inv (UP.\<Psi> (trg f)) \<cdot>\<^sub>S S.UP \<epsilon> \<cdot>\<^sub>S S.\<Phi> (f, g) \<star>\<^sub>S S.UP f =
                         (S.inv (UP.\<Psi> (trg f)) \<star>\<^sub>S S.UP f) \<cdot>\<^sub>S (S.UP \<epsilon> \<cdot>\<^sub>S S.\<Phi> (f, g) \<star>\<^sub>S S.UP f)"
                   using UP.\<Psi>_char S.whisker_right by simp
                 moreover have "S.UP f \<star>\<^sub>S S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta> \<cdot>\<^sub>S UP.\<Psi> (src f) =
                                  (S.UP f \<star>\<^sub>S S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta>) \<cdot>\<^sub>S
                                    (S.UP f \<star>\<^sub>S UP.\<Psi> (src f))"
                   using antipar UP.\<Psi>_char S.whisker_left S.comp_assoc by simp
                 ultimately show ?thesis
                   using S.comp_assoc by presburger
               qed
               finally show ?thesis by argo
             qed
             show ?thesis
             proof -
               have "((S.UP \<epsilon> \<cdot>\<^sub>S S.\<Phi> (f, g) \<star>\<^sub>S S.UP f) \<cdot>\<^sub>S
                         (S.UP f \<star>\<^sub>S S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta>)) \<cdot>\<^sub>S (S.UP f \<star>\<^sub>S UP.\<Psi> (src f)) =
                      (UP.\<Psi> (trg f) \<star>\<^sub>S S.UP f)"
               proof -
                 have "S.inv (S.inv (UP.\<Psi> (trg f)) \<star>\<^sub>S S.UP f) \<cdot>\<^sub>S S.UP f = UP.\<Psi> (trg f) \<star>\<^sub>S S.UP f"
                   using UP.\<Psi>_char S.iso_inv_iso S.comp_arr_dom S.UP_map\<^sub>0_obj
                   by (simp add: S.hcomp_obj_arr)
                 moreover have "S.arr (S.UP f)"
                   by simp
                 moreover have "S.iso (S.inv (UP.\<Psi> (trg f)) \<star>\<^sub>S S.UP f)"
                   using S.iso_inv_iso S.UP_map\<^sub>0_obj
                   by (simp add: UP.\<Psi>_char(2))
                 ultimately show ?thesis
                   using 2 S.invert_side_of_triangle(1)
                             [of "S.UP f" "S.inv (UP.\<Psi> (trg f)) \<star>\<^sub>S S.UP f"
                                 "((S.UP \<epsilon> \<cdot>\<^sub>S S.\<Phi> (f, g) \<star>\<^sub>S S.UP f) \<cdot>\<^sub>S
                                    (S.UP f \<star>\<^sub>S S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta>)) \<cdot>\<^sub>S
                                  (S.UP f \<star>\<^sub>S UP.\<Psi> (src f))"]
                   by presburger
               qed
               moreover have "S.hseq (UP.\<Psi> (trg f)) (S.UP f) \<and>
                              S.iso (S.UP f \<star>\<^sub>S UP.\<Psi> (src f)) \<and>
                              S.inv (S.UP f \<star>\<^sub>S UP.\<Psi> (src f)) = S.UP f \<star>\<^sub>S S.inv (UP.\<Psi> (src f))"
                 using UP.\<Psi>_char S.UP_map\<^sub>0_obj by simp
               ultimately show ?thesis
                 using S.invert_side_of_triangle(2)
                         [of "UP.\<Psi> (trg f) \<star>\<^sub>S S.UP f"
                             "(S.UP \<epsilon> \<cdot>\<^sub>S S.\<Phi> (f, g) \<star>\<^sub>S S.UP f) \<cdot>\<^sub>S
                                (S.UP f \<star>\<^sub>S S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta>)"
                             "S.UP f \<star>\<^sub>S UP.\<Psi> (src f)"]
                 by presburger
             qed
           qed
           hence "S.\<Phi> (trg f, f) \<cdot>\<^sub>S ((S.UP \<epsilon> \<cdot>\<^sub>S S.\<Phi> (f, g) \<star>\<^sub>S S.UP f) \<cdot>\<^sub>S
                    (S.UP f \<star>\<^sub>S S.inv (S.\<Phi> (g, f)) \<cdot>\<^sub>S S.UP \<eta>)) \<cdot>\<^sub>S S.inv (S.\<Phi> (f, src f)) =
                  S.\<Phi> (trg f, f) \<cdot>\<^sub>S ((UP.\<Psi> (trg f) \<star>\<^sub>S S.UP f) \<cdot>\<^sub>S
                    (S.UP f \<star>\<^sub>S S.inv (UP.\<Psi> (src f)))) \<cdot>\<^sub>S S.inv (S.\<Phi> (f, src f))"
             by simp
           thus ?thesis
             using S.comp_assoc by simp
         qed
       qed
     qed
 
     lemma triangle_right_implies_left:
     assumes "(g \<star> \<epsilon>) \<cdot> \<a>[g, f, g] \<cdot> (\<eta> \<star> g) = \<r>\<^sup>-\<^sup>1[g] \<cdot> \<l>[g]"
     shows "(\<epsilon> \<star> f) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f] \<cdot> (f \<star> \<eta>) = \<l>\<^sup>-\<^sup>1[f] \<cdot> \<r>[f]"
     proof -
       have "par ((\<epsilon> \<star> f) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f] \<cdot> (f \<star> \<eta>)) (\<l>\<^sup>-\<^sup>1[f] \<cdot> \<r>[f])"
         using antipar by simp
       moreover have "S.UP ((\<epsilon> \<star> f) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f] \<cdot> (f \<star> \<eta>)) = S.UP (\<l>\<^sup>-\<^sup>1[f] \<cdot> \<r>[f])"
         using assms UP_triangle(3-5) by simp
       ultimately show "(\<epsilon> \<star> f) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f] \<cdot> (f \<star> \<eta>) = \<l>\<^sup>-\<^sup>1[f] \<cdot> \<r>[f]"
         using UP.is_faithful by blast
     qed
 
     text \<open>
       We \emph{really} don't want to go through the ordeal of proving a dual version of
       \<open>UP_triangle(5)\<close>, do we?  So let's be smart and dualize via the opposite bicategory.
     \<close>
 
     lemma triangle_left_implies_right:
     assumes "(\<epsilon> \<star> f) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f] \<cdot> (f \<star> \<eta>) = \<l>\<^sup>-\<^sup>1[f] \<cdot> \<r>[f]"
     shows "(g \<star> \<epsilon>) \<cdot> \<a>[g, f, g] \<cdot> (\<eta> \<star> g) = \<r>\<^sup>-\<^sup>1[g] \<cdot> \<l>[g]"
     proof -
       interpret Cop: op_bicategory V H \<a> \<i> src trg ..
       interpret Eop: equivalence_in_bicategory V Cop.H Cop.\<a> \<i> Cop.src Cop.trg g f \<eta> \<epsilon>
       using antipar unit_in_hom counit_in_hom iso_inv_iso
         by (unfold_locales, simp_all)
       have "(\<epsilon> \<star> f) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f] \<cdot> (f \<star> \<eta>) = \<l>\<^sup>-\<^sup>1[f] \<cdot> \<r>[f] \<Longrightarrow>
             (g \<star> \<epsilon>) \<cdot> \<a>[g, f, g] \<cdot> (\<eta> \<star> g) = \<r>\<^sup>-\<^sup>1[g] \<cdot> \<l>[g]"
         using antipar Cop.lunit_ide_simp Cop.runit_ide_simp Cop.assoc_ide_simp
               VVV.ide_char VVV.arr_char VV.arr_char Eop.triangle_right_implies_left
         by simp
       thus ?thesis
         using assms by simp
     qed
 
     lemma triangle_left_iff_right:
     shows "(\<epsilon> \<star> f) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f] \<cdot> (f \<star> \<eta>) = \<l>\<^sup>-\<^sup>1[f] \<cdot> \<r>[f] \<longleftrightarrow>
            (g \<star> \<epsilon>) \<cdot> \<a>[g, f, g] \<cdot> (\<eta> \<star> g) = \<r>\<^sup>-\<^sup>1[g] \<cdot> \<l>[g]"
       using triangle_left_implies_right triangle_right_implies_left by auto
 
   end
 
   text \<open>
     We might as well specialize the dual result back to the strict case while we are at it.
   \<close>
 
   context equivalence_in_strict_bicategory
   begin
 
     lemma triangle_left_iff_right:
     shows "(\<epsilon> \<star> f) \<cdot> (f \<star> \<eta>) = f \<longleftrightarrow> (g \<star> \<epsilon>) \<cdot> (\<eta> \<star> g) = g"
     proof -
       have "(\<epsilon> \<star> f) \<cdot> (f \<star> \<eta>) = f \<longleftrightarrow> (\<epsilon> \<star> f) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f] \<cdot> (f \<star> \<eta>) = \<l>\<^sup>-\<^sup>1[f] \<cdot> \<r>[f]"
       proof -
         have "\<l>\<^sup>-\<^sup>1[f] \<cdot> \<r>[f] = f"
           using strict_lunit strict_runit by simp
         moreover have "(\<epsilon> \<star> f) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, f] \<cdot> (f \<star> \<eta>) = (\<epsilon> \<star> f) \<cdot> (f \<star> \<eta>)"
           using antipar strict_assoc assoc'_in_hom(2) [of f g f] comp_cod_arr
           by auto
         ultimately show ?thesis by simp
       qed
       also have "... \<longleftrightarrow> (g \<star> \<epsilon>) \<cdot> \<a>[g, f, g] \<cdot> (\<eta> \<star> g) = \<r>\<^sup>-\<^sup>1[g] \<cdot> \<l>[g]"
         using triangle_left_iff_right by blast
       also have "... \<longleftrightarrow> (g \<star> \<epsilon>) \<cdot> (\<eta> \<star> g) = g"
       proof -
         have "\<r>\<^sup>-\<^sup>1[g] \<cdot> \<l>[g] = g"
           using strict_lunit strict_runit by simp
         moreover have "(g \<star> \<epsilon>) \<cdot> \<a>[g, f, g] \<cdot> (\<eta> \<star> g) = (g \<star> \<epsilon>) \<cdot> (\<eta> \<star> g)"
           using antipar strict_assoc assoc_in_hom(2) [of g f g] comp_cod_arr
           by auto
         ultimately show ?thesis by simp
       qed
       finally show ?thesis by simp
     qed
 
   end
 
 end