(*  Title:       Tabulation
    Author:      Eugene W. Stark <stark@cs.stonybrook.edu>, 2019
    Maintainer:  Eugene W. Stark <stark@cs.stonybrook.edu>
*)

section "Tabulations"

theory Tabulation
imports CanonicalIsos InternalAdjunction
begin

  text ‹
 A ``tabulation'' is a kind of bicategorical limit that associates with a 1-cell ‹r›
 a triple ‹(f, ρ, g)›, where ‹f› and ‹g› are 1-cells having a common source,
 and ‹ρ› is a $2$-cell from ‹g› to ‹r ⋅ f›, such that a certain biuniversal property
 is satisfied.
 The notion was introduced in a study of bicategories of spans and relations by
 Carboni, Kasangian, and Street cite‹"carboni-et-al"› (hereinafter, ``CKS''),
 who named it after a related,
 but different notion previously used by Freyd in his study of the algebra of relations.
 One can find motivation for the concept of tabulation by considering the problem of
 trying to find some kind of universal way of factoring a 1-cell ‹r›, up to isomorphism,
 as the composition ‹g ⋅ f^*› of a map ‹g› and the right adjoint ‹f^*› of a map ‹f›.
 In order to be able to express this as a bicategorical limit, CKS consider,
 instead of an isomorphism ‹«φ : g ⋆ f^* → r¬›, its transpose
 ‹ρ : g → r ⋆ f› under the adjunction ‹f ⊣ f^*›.
 ›

  subsection "Definition of Tabulation"

  text ‹
 The following locale sets forth the ``signature'' of the data involved in a tabulation,
 and establishes some basic facts.
 $\xymatrix{
 & \scriptstyle{{\rm src}~g \;=\;{\rm src}~f} \xtwocell[ddd]{}\omit{^\rho}
 \ar[ddl] _{g}
 \ar[ddr] ^{f}
 \\
 \\
 \scriptstyle{{\rm trg}~r} & & \scriptstyle{{\rm src}~r} \ar[ll] ^{r}
 \\
 &
 $$
 ›

  locale tabulation_data =
    bicategory +
  fixes r :: 'a
    and ρ :: 'a
    and f :: 'a
    and g :: 'a
  assumes ide_base: "ide r"
  and ide_leg0: "ide f"
  and tab_in_vhom': "«ρ : g → r ⋆ f¬"
  begin

    lemma base_in_hom [intro]:
    shows "«r : src r → trg r¬" and "«r : r → r¬"
      using ide_base by auto

    lemma base_simps [simp]:
    shows "ide r" and "arr r"
    and "dom r = r" and "cod r = r"
      using ide_base by auto

    lemma tab_in_hom [intro]:
    shows "«ρ : src f → trg r¬" and "«ρ : g → r ⋆ f¬"
      using tab_in_vhom' src_dom [of ρ] trg_dom [of ρ] base_in_hom apply auto
      by (metis arrI hcomp_simps(1) hcomp_simps(2) in_hhomI not_arr_null
          src.extensionality src.preserves_hom vconn_implies_hpar(1)
          vconn_implies_hpar(2) vconn_implies_hpar(3) vconn_implies_hpar(4))

    lemma ide_leg1:
    shows "ide g"
      using tab_in_hom by auto

    lemma leg1_in_hom [intro]:
    shows "«g : src f → trg r¬" and "«g : g → g¬"
      using ide_leg1 apply auto
      using tab_in_hom ide_dom [of ρ]
      apply (elim conjE in_homE) by auto

    lemma leg1_simps [simp]:
    shows "ide g" and "arr g"
    and "src g = src f" and "trg g = trg r"
    and "dom g = g"and "cod g = g"
      using ide_leg1 leg1_in_hom by auto

    lemma tab_simps [simp]:
    shows "arr ρ" and "src ρ = src f" and "trg ρ = trg r"
    and "dom ρ = g" and "cod ρ = r ⋆ f"
      using tab_in_hom by auto

    lemma leg0_in_hom [intro]:
    shows "«f : src f → src r¬" and "«f : f → f¬"
      using ide_leg0 apply auto
      using tab_in_hom ide_cod [of ρ] hseq_char [of r f]
      apply (elim conjE in_homE) by auto

    lemma leg0_simps [simp]:
    shows "ide f" and "arr f"
    and "trg f = src r"
    and "dom f = f" and "cod f = f"
      using ide_leg0 leg0_in_hom by auto

    text ‹
 The following function, which composes ‹ρ› with a 2-cell ‹«θ : f ⋆ w → u¬› to obtain
 a 2-cell ‹«(r ⋆ θ) ⋅ a[r, f, w] ⋅ (ρ ⋆ w) : g ⋆ w → r ⋆ u¬"›,
 occurs frequently in the sequel.
 ›

    abbreviation (input) composite_cell
    where "composite_cell w θ ≡ (r ⋆ θ) ⋅ a[r, f, w] ⋅ (ρ ⋆ w)"

    lemma composite_cell_in_hom:
    assumes "ide w" and "«w : src u → src f¬" and "«θ : f ⋆ w → u¬"
    shows "«composite_cell w θ : g ⋆ w → r ⋆ u¬"
    proof (intro comp_in_homI)
      show "«ρ ⋆ w : g ⋆ w → (r ⋆ f) ⋆ w¬"
        using assms tab_in_hom
        apply (elim conjE in_hhomE in_homE)
        by (intro hcomp_in_vhom, auto)
      show "«a[r, f, w] : (r ⋆ f) ⋆ w → r ⋆ f ⋆ w¬"
        using assms ide_base ide_leg0 tab_in_hom by fastforce
      show "«r ⋆ θ : r ⋆ f ⋆ w → r ⋆ u¬"
        using assms ide_base ide_leg0 tab_in_hom by fastforce
    qed

    text ‹
 We define some abbreviations for various combinations of conditions that occur in the
 hypotheses and conclusions of the tabulation axioms.
 ›

    abbreviation (input) uwθψ
    where "uwθψ u w θ ψ ≡ ide w ∧ «θ : f ⋆ w → u¬ ∧ «ψ : dom ψ → r ⋆ u¬"

    abbreviation (input) uwθψν
    where "uwθψν u w θ ψ ν ≡
           ide w ∧ «θ : f ⋆ w → u¬ ∧ «ν : dom ψ → g ⋆ w¬ ∧ iso ν ∧
             (r ⋆ θ) ⋅ a[r, f, w] ⋅ (ρ ⋆ w) ⋅ ν = ψ"

    abbreviation (input) uwθw'θ'β
    where "uwθw'θ'β u w θ w' θ' β ≡
               ide u ∧ ide w ∧ ide w' ∧
               «θ : f ⋆ w → u¬ ∧ «θ' : f ⋆ w' → u¬ ∧ «β : g ⋆ w → g ⋆ w'¬ ∧
               (r ⋆ θ) ⋅ a[r, f, w] ⋅ (ρ ⋆ w) = (r ⋆ θ') ⋅ a[r, f, w'] ⋅ (ρ ⋆ w') ⋅ β"

  end

  text ‹
 CKS define two notions of tabulation.
 The first, which they call simply ``tabulation'', is restricted to triples ‹(f, ρ, g)›
 where the ``input leg'' ‹f› is a map, and assumes only a weak form of the biuniversal
 property that only applies to ‹(u, ψ, v)› for which u is a map.
 The second notion, which they call ``wide tabulation'', concerns arbitrary ‹(f, ρ, g)›,
 and assumes a strong form of the biuniversal property that applies to all ‹(u, ψ, v)›.
 On its face, neither notion implies the other: ``tabulation'' has the stronger assumption
 that ‹f› is a map, but requires a weaker biuniversal property, and ``wide tabulation''
 omits the assumption on ‹f›, but requires a stronger biuniversal property.
 CKS Proposition 1(c) states that if ‹(f, ρ, g)› is a wide tabulation,
 then ‹f› is automatically a map. This is in fact true, but it took me a long time to
 reconstruct the details of the proof.
 
 CKS' definition of ``bicategory of spans'' uses their notion ``tabulation'',
 presumably because it is only applied in situations where maps are involved and it is more
 desirable to have axioms that involve a weaker biuniversal property rather than a stronger one.
 However I am more interested in ``wide tabulation'', as it is in some sense the nicer notion,
 and since I have had to establish various kinds of preservation results that I don't want
 to repeat for both tabulation and wide tabulation, I am using wide tabulation everywhere,
 calling it simply ``tabulation''. The fact that the ``input leg'' of a tabulation must
 be a map is an essential ingredient throughout.
 
 I have attempted to follow CKS variable naming conventions as much as possible in this
 development to avoid confusion when comparing with their paper, even though these are
 sometimes at odds with what I have been using elsewhere in this document.
 ›

  locale tabulation =
    tabulation_data +
  assumes T1: "∧u ψ.
                 [ ide u; «ψ : dom ψ → r ⋆ u¬ ] ==>
                 ∃w θ ν. ide w ∧ «θ : f ⋆ w → u¬ ∧ «ν : dom ψ → g ⋆ w¬ ∧ iso ν ∧
                         composite_cell w θ ⋅ ν = ψ"
      and T2: "∧u w w' θ θ' β.
                 [ ide w; ide w'; «θ : f ⋆ w → u¬; «θ' : f ⋆ w' → u¬; «β : g ⋆ w → g ⋆ w'¬;
                   composite_cell w θ = composite_cell w' θ' ⋅ β ] ==>
                 ∃!γ. «γ : w → w'¬ ∧ β = g ⋆ γ ∧ θ = θ' ⋅ (f ⋆ γ)"

  text ‹
 $
 textbf{T1:}\qquad\qquad
 xy/u67pt/
 xymatrix{
 & {\scriptstyle{{\rm src}~\omega}}
 \xlowertwocell[ddddl]{}_{{\rm dom}~\omega\hspace{20pt}}{^\nu}
 \xuppertwocell[ddddr]{}^{u}{^\theta}
 \ar@ {.>}[dd]^{w}
 \\
 \\
 & \scriptstyle{{\rm src}~g \;=\;{\rm src}~f} \xtwocell[ddd]{}\omit{^\rho}
 \ar[ddl] _{g}
 \ar[ddr] ^{f}
 \\
 \\
 \scriptstyle{{\rm trg}~r} & & \scriptstyle{{\rm src}~r} \ar[ll] ^{r}
 \\
 &
 
 endxy
 ;\;=\;\;
 xy/u33pt/
 xymatrix{
 & \scriptstyle{{\rm src}~\omega} \xtwocell[ddd]{}\omit{^\omega}
 \ar[ddl] _{{\rm dom}~\omega}
 \ar[ddr] ^{u}
 \\
 \\
 \scriptstyle{{\rm trg}~r} & & \scriptstyle{{\rm src}~r} \ar[ll] ^{r}
 \\
 &
 
 endxy
 $
 ›

  text ‹
 The following definition includes the additional axiom ‹T0›, which states that
 the ``input leg'' ‹f› is a map.
 ›

  locale tabulation_data_with_T0 =
    tabulation_data +
    T0: map_in_bicategory V H a i src trg f
  begin

    abbreviation η where "η ≡ T0.η"
    abbreviation ε where "ε ≡ T0.ε"

    text ‹
 If ‹«ρ : g → r ⋆ f¬› is a 2-cell and ‹f› is a map, then ‹«T0.trnr_\ε r ρ : g ⋆ f^* → r¬›,
 where ‹T0.trnr_\ε r ρ› is the adjoint transpose of ‹ρ›.
 We will show (CKS Proposition 1(d)) that if ‹ρ› is a tabulation,
 then ‹ψ = T0.trnr_\ε r ρ› is an isomorphism. However, regardless of whether ‹ρ› is a
 tabulation, the mapping ‹ρ ↦ ψ› is injective, and we can recover ‹ρ› by the formula:
      \<open>\<rho> = (\<psi> \<star> f) \<cdot> T0.trnr\<^sub>\<eta> g (g \<star> f\<^sup>*)›.  The proof requires only ‹T0› and the ``syntactic''
      properties of the tabulation data, and in particular does not require the tabulation
      conditions \<open>T1\<close> and \<open>T2\<close>.  In case \<open>\<rho>\<close> is in fact a tabulation, then this formula can
      be interpreted as expressing that \<open>\<rho>\<close> is obtained by transposing the identity
      \<open>\<guillemotleft>g \<star> f\<^sup>* : g \<star> f\<^sup>* \<Rightarrow> g \<star> f\<^sup>*\<guillemotright>\<close> to obtain a 2-cell \<open>\<guillemotleft>T0.trnr\<^sub>\<eta> g (g \<star> f\<^sup>*) : g → (g ⋆ f^*) ⋆ f¬›
      (which may be regarded as the canonical tabulation of ‹g ⋆ f^*›), and then composing
      with the isomorphism \<open>\<guillemotleft>\<psi> \<star> f : (g \<star> f\<^sup>*) ⋆ f → r ⋆ f¬› to obtain a tabulation of ‹r›.
      This fact will end up being very important in establishing the characterization of
      bicategories of spans.  Strangely, CKS doesn't make any explicit mention of it.
    \<close>

    lemma rep_in_hom [intro]:
    shows "\<guillemotleft>T0.trnr\<^sub>\<epsilon> r \<rho> : g \<star> f\<^sup>* \<Rightarrow> r\<guillemotright>"
    proof (unfold T0.trnr\<^sub>\<epsilon>_def, intro comp_in_homI)
      show "\<guillemotleft>\<rho> \<star> f\<^sup>* : g \<star> f\<^sup>* \<Rightarrow> (r \<star> f) \<star> f\<^sup>*\<guillemotright>"
        using tab_in_hom T0.antipar(1) by auto
      show "\<guillemotleft>\<a>[r, f, f\<^sup>*] : (r \<star> f) \<star> f\<^sup>* \<Rightarrow> r \<star> f \<star> f\<^sup>*\<guillemotright>"
        using T0.antipar(1-2) by auto
      show "\<guillemotleft>r \<star> \<epsilon> : r \<star> f \<star> f\<^sup>* \<Rightarrow> r \<star> src r\<guillemotright>"
        using T0.antipar by auto
      show "\<guillemotleft>\<r>[r] : r \<star> src r \<Rightarrow> r\<guillemotright>"
        by auto
    qed

    lemma \<rho>_in_terms_of_rep:
    shows "\<rho> = (T0.trnr\<^sub>\<epsilon> r \<rho> \<star> f) \<cdot> T0.trnr\<^sub>\<eta> g (g \<star> f\<^sup>*)"
    proof -
      have "(T0.trnr_\ε r ρ ⋆ f) ⋅ T0.trnr_\η g (g ⋆ f^*) =
            (r[r] ⋅ composite_cell f^* ε ⋆ f) ⋅ ((g ⋆ f^*) ⋆ f) ⋅ a^-1[g, f^*, f] ⋅ (g ⋆ η) ⋅ r^-1[g]"
        unfolding T0.trnr_\<epsilon>_def T0.trnr_\<eta>_def by simp
      text ‹
$$
\xy/u67pt/
\xymatrix{
  & \scriptstyle{{\rm src}~g \;=\;{\rm src}~f}
  \ar[ddl]_{g} \ar[ddr]^{f} \xtwocell[ddd]{}\omit{^\rho}
  &
  \\
  \\
  \scriptstyle{{\rm trg}~r} & & \scriptstyle{{\rm src}~r} \ar[ll]^{r}
  \\
  & &
}
\endxy
\;\;=\;\;
\xy/u133pt/
\xymatrix{
  & & \scriptstyle{{\rm src}~g \;=\;{\rm src}~f} \ar[dd]
  \xtwocell[dddddddl]{}\omit{^\rho}
  \xlowertwocell[ddddll]{}_{g}{^{\hspace{20pt}{\rm r}^{-1}[g]}}
  \xuppertwocell[ddddrr]{}^{f}{\omit} & &
  \xtwocell[dddddddlll]{}\omit{^\epsilon}
  \xtwocell[ddddll]{}\omit{^\eta}
  \\
  & \\
  & & \scriptstyle{{\rm src}~g \;=\;{\rm src}~f} \ar[dd]^{f} \ar[ddll]_{g}
  & \\
  & & & \\
  \scriptstyle{{\rm trg}~r} & & \scriptstyle{{\rm src}~r} \ar[ll]^{r}
  & &
  \scriptstyle{{\rm src}~r} \ar[ll] \ar[uull]_{f^\ast}
  \xuppertwocell[llll]{}^{r}<20>{^{\hspace{20pt}{\rm r}[r]}}
  \\
  & & \\
  & & \\
  & & & & \\
}
\endxy
$$
      ›
      also have "... = (r[r] ⋅ composite_cell f^* ε ⋆ f) ⋅ a^-1[g, f^*, f] ⋅ (g ⋆ η) ⋅ r^-1[g]"
      proof -
        have "((g ⋆ f^*) ⋆ f) ⋅ a^-1[g, f^*, f] = a^-1[g, f^*, f]"
          using comp_cod_arr T0.antipar by simp
        thus ?thesis
          using comp_assoc by metis
      qed
      also have "... = (r[r] ⋆ f) ⋅ (composite_cell f^* ε ⋆ f) ⋅ a^-1[g, f^*, f] ⋅ (g ⋆ η) ⋅ r^-1[g]"
        using comp_assoc T0.antipar whisker_right [of "f" "r[r]" "composite_cell f^* ε"]
        by fastforce
      also have "... = (r[r] ⋆ f) ⋅ ((r ⋆ ε) ⋅ a[r, f, f^*] ⋆ f) ⋅ ((ρ ⋆ f^*) ⋆ f) ⋅ a^-1[g, f^*, f] ⋅
                         (g ⋆ η) ⋅ r^-1[g]"
        using T0.antipar whisker_right [of "f" "(r ⋆ ε) ⋅ a[r, f, f^*]" "ρ ⋆ f^*"] comp_assoc
        by fastforce
      also have "... = (r[r] ⋆ f) ⋅ ((r ⋆ ε) ⋆ f) ⋅ (a[r, f, f^*] ⋆ f) ⋅
                         ((ρ ⋆ f^*) ⋆ f) ⋅ a^-1[g, f^*, f] ⋅ (g ⋆ η) ⋅ r^-1[g]"
        using T0.antipar whisker_right [of "f" "r ⋆ ε" "a[r, f, f^*]"] comp_assoc by fastforce
      also have "... = (r[r] ⋆ f) ⋅ ((r ⋆ ε) ⋆ f) ⋅ (a[r, f, f^*] ⋆ f) ⋅
                         a^-1[r ⋆ f, f^*, f] ⋅ (ρ ⋆ f^* ⋆ f) ⋅ (g ⋆ η) ⋅ r^-1[g]"
      proof -
        have "((ρ ⋆ f^*) ⋆ f) ⋅ a^-1[g, f^*, f] = a^-1[r ⋆ f, f^*, f] ⋅ (ρ ⋆ f^* ⋆ f)"
          using assoc'_naturality [of ρ "f^*" "f"] T0.antipar by simp
        thus ?thesis
          using comp_assoc by metis
      qed
      also have "... = (r[r] ⋆ f) ⋅ ((r ⋆ ε) ⋆ f) ⋅
                         (a[r, f, f^*] ⋆ f) ⋅ a^-1[r ⋆ f, f^*, f] ⋅
                         ((r ⋆ f) ⋆ η) ⋅ (ρ ⋆ src (f)) ⋅ r^-1[g]"
      proof -
        have "(ρ ⋆ f^* ⋆ f) ⋅ (g ⋆ η) = ((r ⋆ f) ⋆ η) ⋅ (ρ ⋆ src (f))"
          using comp_arr_dom comp_cod_arr T0.antipar interchange [of ρ "g" "f^* ⋆ f" η]
                interchange [of "r ⋆ f" ρ η "src (f)"]
          by auto
        thus ?thesis
          using comp_assoc by metis
      qed
      also have "... = (r[r] ⋆ f) ⋅ ((r ⋆ ε) ⋆ f) ⋅ (a[r, f, f^*] ⋆ f) ⋅ a^-1[r ⋆ f, f^*, f] ⋅
                         ((r ⋆ f) ⋆ η) ⋅ r^-1[r ⋆ f] ⋅ ρ"
        using runit'_naturality [of ρ] by simp
      also have "... = (r[r] ⋆ f) ⋅ ((r ⋆ ε) ⋆ f) ⋅
                         a^-1[r, f ⋆ f^*, f] ⋅ (r ⋆ a^-1[f, f^*, f]) ⋅ a[r, f, f^* ⋆ f] ⋅
                         ((r ⋆ f) ⋆ η) ⋅ r^-1[r ⋆ f] ⋅ ρ"
      proof -
        have "(a[r, f, f^*] ⋆ f) ⋅ a^-1[r ⋆ f, f^*, f] =
              a^-1[r, f ⋆ f^*, f] ⋅ (r ⋆ a^-1[f, f^*, f]) ⋅ a[r, f, f^* ⋆ f]"
        proof -
          have "a^-1[r ⋆ f, f^*, f] =
                (a^-1[r, f, f^*] ⋆ f) ⋅ a^-1[r, f ⋆ f^*, f] ⋅ (r ⋆ a^-1[f, f^*, f]) ⋅ a[r, f, f^* ⋆ f]"
            using pentagon' [of r "f" "f^*" "f"] T0.antipar iso_assoc comp_assoc
              invert_side_of_triangle(2)
                [of "((a^-1[r, f, f^*] ⋆ f) ⋅ a^-1[r, f ⋆ f^*, f]) ⋅ (r ⋆ a^-1[f, f^*, f])"
                    "a^-1[r ⋆ f, f^*, f]" "a^-1[r, f, f^* ⋆ f]"]
            by fastforce
          hence "(a[r, f, f^*] ⋆ f) ⋅ a^-1[r ⋆ f, f^*, f] =
                 ((a[r, f, f^*] ⋆ f) ⋅ (a^-1[r, f, f^*] ⋆ f)) ⋅
                   a^-1[r, f ⋆ f^*, f] ⋅ (r ⋆ a^-1[f, f^*, f]) ⋅ a[r, f, f^* ⋆ f]"
            using comp_assoc by simp
          also have "... = a^-1[r, f ⋆ f^*, f] ⋅ (r ⋆ a^-1[f, f^*, f]) ⋅ a[r, f, f^* ⋆ f]"
          proof -
            have "(a[r, f, f^*] ⋆ f) ⋅ (a^-1[r, f, f^*] ⋆ f) ⋅ a^-1[r, f ⋆ f^*, f] =
                  ((r ⋆ f ⋆ f^*) ⋆ f) ⋅ a^-1[r, f ⋆ f^*, f]"
              using comp_cod_arr comp_assoc iso_assoc comp_arr_inv T0.antipar
                    whisker_right [of "f" "a[r, f, f^*]" "a^-1[r, f, f^*]"] comp_assoc_assoc'
              by simp
            also have "... = a^-1[r, f ⋆ f^*, f]"
              using comp_cod_arr T0.antipar by auto
            finally show ?thesis
              using comp_assoc by metis
          qed
          finally show ?thesis by blast
        qed
        thus ?thesis
          using comp_assoc by metis
      qed
      also have "... = (r[r] ⋆ f) ⋅ a^-1[r, src r, f] ⋅ (r ⋆ ε ⋆ f) ⋅
                         (r ⋆ a^-1[f, f^*, f]) ⋅ (r ⋆ f ⋆ η) ⋅ a[r, f, src (f)] ⋅ r^-1[r ⋆ f] ⋅ ρ"
      proof -
        have "((r ⋆ ε) ⋆ f) ⋅ a^-1[r, f ⋆ f^*, f] = a^-1[r, src r, f] ⋅ (r ⋆ ε ⋆ f)"
          using assoc'_naturality [of r ε "f"] by auto
        moreover have "a[r, f, f^* ⋆ f] ⋅ ((r ⋆ f) ⋆ η) = (r ⋆ f ⋆ η) ⋅ a[r, f, src (f)]"
          using assoc_naturality [of r "f" η] T0.antipar by auto
        ultimately show ?thesis
          using comp_assoc by metis
      qed
      also have "... = (r[r] ⋆ f) ⋅ a^-1[r, src r, f] ⋅ (r ⋆ (ε ⋆ f) ⋅
                         a^-1[f, f^*, f] ⋅ (f ⋆ η)) ⋅ a[r, f, src (f)] ⋅ r^-1[r ⋆ f] ⋅ ρ"
      proof -
        have "seq a^-1[f, f^*, f] (f ⋆ η)"
          using T0.antipar by force
        moreover have "seq (ε ⋆ f) (a^-1[f, f^*, f] ⋅ (f ⋆ η))"
          using T0.antipar by fastforce
        ultimately have "(r ⋆ ε ⋆ f) ⋅ (r ⋆ a^-1[f, f^*, f]) ⋅ (r ⋆ f ⋆ η) =
                         r ⋆ (ε ⋆ f) ⋅ a^-1[f, f^*, f] ⋅ (f ⋆ η)"
          using T0.antipar whisker_left [of r "a^-1[f, f^*, f]" "f ⋆ η"]
                whisker_left [of r "ε ⋆ f" "a^-1[f, f^*, f] ⋅ (f ⋆ η)"]
          by auto
        thus ?thesis
          using comp_assoc by metis
      qed
      also have "... = (r[r] ⋆ f) ⋅ a^-1[r, src r, f] ⋅ (r ⋆ l^-1[f] ⋅ r[f]) ⋅
                         a[r, f, src (f)] ⋅ r^-1[r ⋆ f] ⋅ ρ"
        using T0.triangle_left by simp
      also have "... = ((r[r] ⋆ f) ⋅ a^-1[r, src r, f] ⋅ (r ⋆ l^-1[f])) ⋅
                         ((r ⋆ r[f]) ⋅ a[r, f, src (f)] ⋅ r^-1[r ⋆ f]) ⋅ ρ"
        using whisker_left [of r "l^-1[f]" "r[f]"] comp_assoc by simp
      also have "... = ((r ⋆ l[f]) ⋅ (r ⋆ l^-1[f])) ⋅ (r[r ⋆ f] ⋅ r^-1[r ⋆ f]) ⋅ ρ"
        using triangle' [of r "f"] runit_hcomp [of r "f"] comp_assoc by simp
      also have "... = ρ"
      proof -
        have "(r ⋆ l[f]) ⋅ (r ⋆ l^-1[f]) = r ⋆ f"
          using iso_lunit comp_arr_inv' whisker_left [of r "l[f]" "l^-1[f]"] by simp
        moreover have "(r[r ⋆ f] ⋅ r^-1[r ⋆ f]) = r ⋆ f"
          using iso_runit inv_is_inverse comp_arr_inv' by auto
        ultimately show ?thesis
          using comp_cod_arr by simp
      qed
      finally show ?thesis by simp
    qed

  end

  text ‹
    The following corresponds to what CKS call ``tabulation''; it supposes axiom ‹T0›,
    but involves weaker versions of ‹T1› and ‹T2›. I am calling it ``narrow tabulation''.
  ›

  locale narrow_tabulation =
    tabulation_data_with_T0 +
  assumes T1: "∧u ψ.
                  [ is_left_adjoint u; «ψ : dom ψ → r ⋆ u¬ ] ==>
                  ∃w θ ν. ide w ∧ «θ : f ⋆ w → u¬ ∧ «ν : dom ψ → g ⋆ w¬ ∧ iso ν ∧
                          composite_cell w θ ⋅ ν = ψ"
      and T2: "∧u w w' θ θ' β.
                  [ is_left_adjoint u; ide w; ide w';
                    «θ : f ⋆ w → u¬; «θ' : f ⋆ w' → u¬; «β : g ⋆ w → g ⋆ w'¬;
                    composite_cell w θ = composite_cell w' θ' ⋅ β ] ==>
                  ∃!γ. «γ : w → w'¬ ∧ β = g ⋆ γ ∧ θ = θ' ⋅ (f ⋆ γ)"

  text ‹
    The next few locales are used to bundle up some routine consequences of
    the situations described by the hypotheses and conclusions of the tabulation axioms,
    so we don't have to keep deriving them over and over again in each context,
    and also so as to keep the simplification rules oriented consistently with each other.
  ›

  locale uwθ =
    tabulation_data +
  fixes u :: 'a
  and w :: 'a
  and θ :: 'a
  assumes uwθ: "ide w ∧ «θ : f ⋆ w → u¬"
  begin

    lemma ide_u:
    shows "ide u"
      using uwθ by force

    lemma u_in_hom [intro]:
    shows "«u : src u → src r¬"
      using uwθ ide_u ide_cod [of θ] hseq_char [of f w]
      apply (intro in_hhomI, simp_all)
      by (metis arr_dom in_homE leg0_simps(3) trg_hcomp vconn_implies_hpar(4))

    lemma u_simps [simp]:
    shows "ide u" and "arr u"
    and "trg u = src r"
    and "dom u = u" and "cod u = u"
      using ide_u u_in_hom by auto

    lemma ide_w:
    shows "ide w"
      using uwθ by auto

    lemma w_in_hom [intro]:
    shows "«w : src u → src f¬" and "«w : w → w¬"
    proof -
      show "«w : w → w¬"
        using ide_w by auto
      show "«w : src u → src f¬"
      proof
        show "arr w" using ide_w by simp
        show "src w = src u"
          using uwθ ide_dom [of θ] hseq_char [of f w]
          by (metis arr_dom in_homE src_cod src_dom hcomp_simps(1))
        show "trg w = src f"
          using uwθ ide_dom [of θ] hseq_char [of f w]
          by (metis arr_dom in_homE)
      qed
    qed

    lemma w_simps [simp]:
    shows "ide w" and "arr w"
    and "src w = src u" and "trg w = src f"
    and "dom w = w" and "cod w = w"
      using ide_w w_in_hom by auto

    lemma θ_in_hom [intro]:
    shows "«θ : src u → src r¬" and "«θ : f ⋆ w → u¬"
    proof -
      show "«θ : f ⋆ w → u¬"
        using uwθ by simp
      show "«θ : src u → src r¬"
        using uwθ hcomp_simps(1-2)
        by (metis arrI in_hhomI u_simps(3) vconn_implies_hpar(1-4))
    qed

    lemma θ_simps [simp]:
    shows "arr θ" and "src θ = src u" and "trg θ = src r"
    and "dom θ = f ⋆ w" and "cod θ = u"
      using θ_in_hom by auto

  end

  locale uwθψ =
    uwθ +
  fixes ψ :: 'a
  assumes uwθψ: "uwθψ u w θ ψ"
  begin

    lemma ψ_in_hom [intro]:
    shows "«ψ : src w → trg r¬" and "«ψ : dom ψ → r ⋆ u¬"
    proof -
      show "«ψ : src w → trg r¬"
        using uwθψ src_cod [of ψ] trg_cod [of ψ]
        apply (elim conjE in_homE)
        by simp
      show "«ψ : dom ψ → r ⋆ u¬"
        using uwθψ by auto
    qed

    lemma ψ_simps [simp]:
    shows "arr ψ" and "src ψ = src w" and "trg ψ = trg r"
    and "cod ψ = r ⋆ u"
      using ψ_in_hom by auto

  end

  locale uwθψν =
    uwθ +
  fixes ψ :: 'a
  and ν :: 'a
  assumes uwθψν: "uwθψν u w θ ψ ν"
  begin

    lemma ν_in_hom [intro]:
    shows "«ν : src u → trg r¬" and "«ν : dom ψ → g ⋆ w¬"
    proof -
      show "«ν : dom ψ → g ⋆ w¬"
        using uwθψν by auto
      show "«ν : src u → trg r¬"
      proof
        show 1: "arr ν"
          using uwθψν by auto
        show "src ν = src u"
        proof -
          have "src (cod ν) = src u"
            using uwθψν
            by (metis arr_cod hcomp_simps(1) in_homE w_simps(3))
          thus ?thesis by simp
        qed
        show "trg ν = trg r"
        proof -
          have "trg (cod ν) = trg r"
            using uwθψν
            by (metis arr_cod hcomp_simps(2) in_homE leg1_simps(4))
          thus ?thesis by simp
        qed
      qed
    qed

    lemma ν_simps [simp]:
    shows "iso ν" and "arr ν" and "src ν = src u" and "trg ν = trg r"
    and "cod ν = g ⋆ w"
      using uwθψν ν_in_hom by auto

    sublocale uwθψ
    proof (unfold_locales, intro conjI)
      show "ide w"
        using uwθψν by simp
      show "«θ : f ⋆ w → u¬"
        using uwθψν by simp
      have "«(r ⋆ θ) ⋅ a[r, f, w] ⋅ (ρ ⋆ w) ⋅ ν : dom ν → r ⋆ u¬"
        using ide_base ide_leg0 ide_w by fastforce
      thus "«ψ : dom ψ → r ⋆ u¬"
        using uwθψν by auto
    qed

  end


  locale uwθw'θ' =
    tabulation_data V H a ι src trg r ρ f g +
    uwθ: uwθ V H a ι src trg r ρ f g u w θ +
    uw'θ': uwθ V H a ι src trg r ρ f g u w' θ'
  for V :: "'a comp" (infixr ‹⋅› 55)
  and H :: "'a → 'a → 'a" (infixr ‹⋆› 53)
  and a :: "'a → 'a → 'a → 'a" (‹a[_, _, _]›)
  and ι :: "'a → 'a" (‹i[_]›)
  and src :: "'a → 'a"
  and trg :: "'a → 'a"
  and r :: 'a
  and ρ :: 'a
  and f :: 'a
  and g :: 'a
  and u :: 'a
  and w :: 'a
  and θ :: 'a
  and w' :: 'a
  and θ' :: 'a
   
  locale uwθw'θ'γ =
    uwθw'θ' +
  fixes γ :: 'a
  assumes γ_in_vhom: "«γ : w → w'¬"
  and "θ = θ' ⋅ (f ⋆ γ)"
  begin

    lemma γ_in_hom [intro]:
    shows "«γ : src u → src f¬" and "«γ : w → w'¬"
    proof -
      show "«γ : w → w'¬"
        using γ_in_vhom by simp
      show "«γ : src u → src f¬"
      proof
        show "arr γ"
          using γ_in_vhom by auto
        show "src γ = src u"
          using γ_in_vhom src_dom [of γ]
          apply (elim in_homE) by simp
        show "trg γ = src f"
          using γ_in_vhom trg_dom [of γ]
          apply (elim in_homE) by simp
      qed
    qed

    lemma γ_simps [simp]:
    shows "arr γ"
    and "src γ = src u" and "trg γ = src f"
    and "dom γ = w" and "cod γ = w'"
      using γ_in_hom by auto

  end

  locale uwθw'θ'β =
    uwθw'θ' +
  fixes β :: 'a
  assumes uwθw'θ'β: "uwθw'θ'β u w θ w' θ' β"
  begin

    lemma β_in_hom [intro]:
    shows "«β : src u → trg r¬" and "«β : g ⋆ w → g ⋆ w'¬"
    proof -
      show "«β : g ⋆ w → g ⋆ w'¬"
        using uwθw'θ'β by auto
      show "«β : src u → trg r¬"
        using uwθw'θ'β src_dom [of β] trg_dom [of β] hseq_char [of g w]
        apply (elim conjE in_homE) by auto
    qed

    lemma β_simps [simp]:
    shows "arr β" and "src β = src u" and "trg β = trg r"
    and "dom β = g ⋆ w" and "cod β = g ⋆ w'"
      using β_in_hom by auto

  end

  subsection "Tabulations yield Factorizations"

  text ‹
    If ‹(f, ρ, g)› is a (wide) tabulation, then ‹f› is automatically a map;
    this is CKS Proposition 1(c).
    The proof sketch provided by CKS is only three lines long, and for a long time I
    was only able to prove one of the two triangle identities.
    Finally, after gaining a lot of experience with the definitions I saw how to prove
    the other.
    CKS say nothing about the extra step that seems to be required.
  ›

  context tabulation
  begin

    text ‹
      The following is used in order to allow us to apply the coherence theorem
      to shortcut proofs of equations between canonical arrows.
    ›

    interpretation E: self_evaluation_map V H a i src trg ..
    notation E.eval (‹{_}›)

    lemma satisfies_T0:
    shows "is_left_adjoint f"
    proof -
      text ‹
        The difficulty is filling in details left out by CKS, and accounting for the
        fact that they have suppressed unitors and associators everywhere.
        In addition, their typography generally uses only parentheses, with no explicit
        operation symbols to distinguish between horizontal and vertical composition.
        In some cases, for example the statement of T2 in the definition of tabulation,
        this makes it difficult for someone not very experienced with the definitions to
        reconstruct the correct formulas.
      ›
      text ‹
        CKS say to first apply ‹T1› with ‹u = src r›, ‹v = r›, and ‹ρ' = r›.
        However, ‹«r : r → r¬›, not ‹«r : r → r ⋆ src r¬›, so we have to take ‹ρ' = r^-1[r]›.
      ›
      obtain f_a ε ν
      where f_a: "ide f_a ∧ «ε : f ⋆ f_a → src r¬ ∧ «ν : r → g ⋆ f_a¬ ∧ iso ν ∧
                 composite_cell f_a ε ⋅ ν = r^-1[r]"
        using T1 [of "src r" "r^-1[r]"] runit'_in_hom [of r] ide_base comp_assoc by auto
      have f_a': "composite_cell f_a ε ⋅ ν = r^-1[r]"
        using f_a by simp
      have f_a: "ide f_a ∧ «ε : f ⋆ f_a → src r¬ ∧ «ν : r → g ⋆ f_a¬ ∧ iso ν"
        using f_a by simp
      have 1: "src f_a = trg f"
        using f_a f_a' comp_assoc
        by (metis ide_base leg0_simps(3) runit'_simps(1) seqE src_hcomp vconn_implies_hpar(1)
            vseq_implies_hpar(1))
      have 2: "trg f_a = src g"
        using f_a by force
      have ε: "«ε : f ⋆ f_a → trg f¬ ∧ «ε : trg f → trg f¬ ∧
               arr ε ∧ src ε = trg f ∧ trg ε = trg f ∧ dom ε = f ⋆ f_a ∧ cod ε = trg f"
        using f_a 1 2
        by (metis in_hhomI in_homE leg0_simps(3) src_src trg_src vconn_implies_hpar(1-4))
      have ν: "«ν : r → g ⋆ f_a¬ ∧ «ν : trg f → trg g¬ ∧
               arr ν ∧ src ν = trg f ∧ trg ν = trg g ∧ dom ν = r ∧ cod ν = g ⋆ f_a"
        using f_a by force
      text ‹
        Next, CKS say to apply ‹T2› with ‹w = trg f_a = src f›, ‹w' = f_a ⋆ f›, ‹u = f›,
        to obtain the unit and the adjunction conditions, but they don't say explicitly
        what to use for ‹θ›, ‹θ'›, and ‹β›.
        We need ‹«θ : f ⋆ w → u¬› and ‹«θ' : f ⋆ w' → u¬›;
        \emph{i.e.}~‹«θ : f ⋆ trg f_a → f¬› and ‹«θ' : f ⋆ f_a ⋆ f → f¬›.
        Evidently, we may take ‹θ = ρ[f]› and ‹θ' = l[f] ⋅ (ε ⋆ f) ⋅ a^-1[f, f_a, f]›.

        What should be taken for ‹β›? Reconstructing this is a little bit more difficult.
        ‹T2› requires ‹«β : g ⋆ w → g ⋆ w'¬›, hence ‹«β : g ⋆ trg f_a → g ⋆ f_a ⋆ f¬›.
        We have the isomorphism ‹«ν : r → g ⋆ f_a¬› from ‹T1›. Also ‹«ρ : g → r ⋆ f¬›.
        So ‹«a[g, f_a, f] ⋅ (ν ⋆ f) ⋅ ρ ⋅ r[g] : g ⋆ trg f_a → g ⋆ f_a ⋆ f¬›,
        suggesting that we take ‹β = a[g, f_a, f] ⋅ (ν ⋆ f) ⋅ ρ ⋅ r[g]›.
        Now, to apply ‹T2› we need to satisfy the equation:
        \[
           ‹(r ⋆ θ) ⋅ a[r, f, trg f_a] ⋅ (ρ ⋆ trg f_a ) =
           (r ⋆ θ') ⋅ a[r, f, f_a ⋆ f] ⋅ (ρ ⋆ f_a ⋆ f) ⋅ β›;
        \]
        that is, with our choice of ‹θ›, ‹θ'›, and ‹β›:

        ‹(r ⋆ r[f]) ⋅ a[r, f, trg f_a] ⋅ (ρ ⋆ trg f_a ) =
         (r ⋆ l[f] ⋅ (ε ⋆ f) ⋅ a^-1[f, f_a, f]) ⋅ a[r, f, f_a ⋆ f] ⋅ (ρ ⋅ (f_a ⋆ f)) ⋅
               a[g, f_a, f] ⋅ (ν ⋆ f) ⋅ ρ ⋅ r[g]›.

        It is not too difficult to get the idea of showing that the left-hand side
        is equal to ‹ρ ⋅ r[g]› (note that ‹trg f_a = src f = src g]› and ‹trg f = src r›),
        so we should also try to prove that the right-hand side is equal to this as well.
        What we have to work with is the equation:
        \[
           ‹r^-1[r] = (r ⋆ ε) ⋅ a[r, f, f_a] ⋅ (ρ ⋆ f_a ) ⋅ ν›.
        \]
        After some pondering, I realized that to apply this to the right-hand side of the
        equation to be shown requires that we re-associate everything to the left,
        so that f stands alone on the right.
      ›
      let ?β = "a[g, f_a, f] ⋅ (ν ⋆ f) ⋅ ρ ⋅ r[g]"
      let ?θ = "r[f]"
      let ?θ' = "l[f] ⋅ (ε ⋆ f) ⋅ a^-1[f, f_a, f]"
      have β: "«?β : g ⋆ src g → g ⋆ f_a ⋆ f¬ ∧ «?β : src f → trg g¬ ∧
               src ?β = src g ∧ trg ?β = trg g ∧ dom ?β = g ⋆ src g ∧ cod ?β = g ⋆ f_a ⋆ f"
      proof -
        have 3: "«?β : g ⋆ src g → g ⋆ f_a ⋆ f¬"
          using f_a 1 2 by fastforce
        moreover have "«?β : src f → trg g¬"
          using 1 2 3 f_a by auto
        ultimately show ?thesis
          by (auto simp add: in_hhom_def)
      qed
      have θ': "«?θ' : f ⋆ f_a ⋆ f → f¬"
        using f_a 1 2 ε by fastforce
      have A: "composite_cell (trg f_a) r[f] = composite_cell (f_a ⋆ f) ?θ' ⋅ ?β"
      proof -
        have "composite_cell (trg f_a) r[f] = ρ ⋅ r[g]"
          using 2 runit_hcomp runit_naturality [of ρ] comp_assoc by simp
        also have "... = composite_cell (f_a ⋆ f) ?θ' ⋅ ?β"
        proof -
          have "composite_cell (f_a ⋆ f) ?θ' ⋅ ?β =
                (composite_cell (f_a ⋆ f) ?θ' ⋅ a[g, f_a, f]) ⋅ (ν ⋆ f) ⋅ ρ ⋅ r[g]"
            using comp_assoc by simp
          also have "... = ρ ⋅ r[g]"
          proof -
            have "(composite_cell (f_a ⋆ f) ?θ' ⋅ a[g, f_a, f]) ⋅ (ν ⋆ f) = r ⋆ f"
            proof -
              have "(composite_cell (f_a ⋆ f) ?θ' ⋅ a[g, f_a, f]) ⋅ (ν ⋆ f) =
                    r[r] ⋅ (r ⋆ ε) ⋅ a[r, f, f_a] ⋅ (ρ ⋆ f_a) ⋅ ν ⋆ f"
              proof -
                have "(composite_cell (f_a ⋆ f) ?θ' ⋅ a[g, f_a, f]) ⋅ (ν ⋆ f) =
                      (r ⋆ l[f]) ⋅ (r ⋆ ε ⋆ f) ⋅
                        composite_cell (f_a ⋆ f) a^-1[f, f_a, f] ⋅ (a[g, f_a, f] ⋅ (ν ⋆ f))"
                  using f_a 1 2 ε whisker_left comp_assoc by auto
                also have "... = (r[r] ⋆ f) ⋅ a^-1[r, src r, f] ⋅ (r ⋆ ε ⋆ f) ⋅
                                   composite_cell (f_a ⋆ f) a^-1[f, f_a, f] ⋅ (a[g, f_a, f] ⋅ (ν ⋆ f))"
                  using f_a 1 2 comp_assoc by (simp add: triangle')
                also have "... = (r[r] ⋆ f) ⋅ ((r ⋆ ε) ⋆ f) ⋅ a^-1[r, f ⋆ f_a, f] ⋅
                                   composite_cell (f_a ⋆ f) a^-1[f, f_a, f] ⋅ (a[g, f_a, f] ⋅ (ν ⋆ f))"
                proof -
                  have "a^-1[r, src r, f] ⋅ (r ⋆ ε ⋆ f) = ((r ⋆ ε) ⋆ f) ⋅ a^-1[r, f ⋆ f_a, f]"
                    using f_a ε assoc'_naturality [of r ε f] by auto
                  thus ?thesis
                    using comp_assoc by metis
                qed
                also have "... = (r[r] ⋆ f) ⋅ ((r ⋆ ε) ⋆ f) ⋅
                                   (a[r, f, f_a] ⋆ f) ⋅ a^-1[r ⋆ f, f_a, f] ⋅ (ρ ⋆ f_a ⋆ f) ⋅
                                     a[g, f_a, f] ⋅ (ν ⋆ f)"
                proof -
                  have "(r[r] ⋆ f) ⋅ ((r ⋆ ε) ⋆ f) ⋅ a^-1[r, f ⋆ f_a, f] ⋅
                          composite_cell (f_a ⋆ f) a^-1[f, f_a, f] ⋅ (a[g, f_a, f] ⋅ (ν ⋆ f)) =
                        (r[r] ⋆ f) ⋅ ((r ⋆ ε) ⋆ f) ⋅
                          (a^-1[r, f ⋆ f_a, f] ⋅ (r ⋆ a^-1[f, f_a, f]) ⋅ a[r, f, f_a ⋆ f]) ⋅
                            (ρ ⋆ f_a ⋆ f) ⋅ a[g, f_a, f] ⋅ (ν ⋆ f)"
                    by (simp add: comp_assoc)
                  also have "... = (r[r] ⋆ f) ⋅ ((r ⋆ ε) ⋆ f) ⋅
                                     ((a[r, f, f_a] ⋆ f) ⋅ a^-1[r ⋆ f, f_a, f]) ⋅
                                       (ρ ⋆ f_a ⋆ f) ⋅ a[g, f_a, f] ⋅ (ν ⋆ f)"
                  proof -
                    have "a^-1[r, f ⋆ f_a, f] ⋅ (r ⋆ a^-1[f, f_a, f]) ⋅ a[r, f, f_a ⋆ f] =
                            (a[r, f, f_a] ⋆ f) ⋅ a^-1[r ⋆ f, f_a, f]"
                    proof -
                      (* No need to calculate manually, apply the coherence theorem. *)
                      have "a^-1[r, f ⋆ f_a, f] ⋅ (r ⋆ a^-1[f, f_a, f]) ⋅ a[r, f, f_a ⋆ f] =
                            {\a^-1[\⟨r\⟩, \⟨f\⟩ \⋆ \⟨f_a\⟩, \⟨f\⟩] \⋅ (\⟨r\⟩ \⋆ \a^-1[\⟨f\⟩, \⟨f_a\⟩, \⟨f\⟩]) \⋅
                              \a[\⟨r\⟩, \⟨f\⟩, \⟨f_a\⟩ \⋆ \⟨f\⟩]}"
                        using f_a 1 2 a'_def α_def assoc'_eq_inv_assoc by auto
                      also have "... = {(\a[\⟨r\⟩, \⟨f\⟩, \⟨f_a\⟩] \⋆ \⟨f\⟩) \⋅ \a^-1[\⟨r\⟩ \⋆ \⟨f\⟩, \⟨f_a\⟩, \⟨f\⟩]}"
                        using f_a 1 2 by (intro E.eval_eqI, auto)
                      also have "... = (a[r, f, f_a] ⋆ f) ⋅ a^-1[r ⋆ f, f_a, f]"
                        using f_a 1 2 a'_def α_def assoc'_eq_inv_assoc by auto
                      finally show ?thesis by blast
                    qed
                    thus ?thesis by simp
                  qed
                  also have "... = (r[r] ⋆ f) ⋅ ((r ⋆ ε) ⋆ f) ⋅ (a[r, f, f_a] ⋆ f) ⋅
                                     a^-1[r ⋆ f, f_a, f] ⋅ (ρ ⋆ f_a ⋆ f) ⋅ a[g, f_a, f] ⋅ (ν ⋆ f)"
                    by (simp add: comp_assoc)
                  finally show ?thesis by blast
                qed
                also have "... = (r[r] ⋆ f) ⋅ ((r ⋆ ε) ⋆ f) ⋅
                                   (a[r, f, f_a] ⋆ f) ⋅ ((ρ ⋆ f_a) ⋆ f) ⋅ a^-1[g, f_a, f] ⋅
                                     a[g, f_a, f] ⋅ (ν ⋆ f)"
                proof -
                  have "a^-1[r ⋆ f, f_a, f] ⋅ (ρ ⋆ f_a ⋆ f) = ((ρ ⋆ f_a) ⋆ f) ⋅ a^-1[g, f_a, f]"
                    using f_a 1 2 assoc'_naturality [of ρ f_a f] by auto
                  thus ?thesis
                    by (metis comp_assoc)
                qed
                also have "... = (r[r] ⋆ f) ⋅ ((r ⋆ ε) ⋆ f) ⋅ (a[r, f, f_a] ⋆ f) ⋅
                                 ((ρ ⋆ f_a) ⋆ f) ⋅ (ν ⋆ f)"
                proof -
                  have "a^-1[g, f_a, f] ⋅ a[g, f_a, f] = (g ⋆ f_a) ⋆ f"
                    using f_a 1 2 comp_assoc_assoc' by auto
                  moreover have "((g ⋆ f_a) ⋆ f) ⋅ (ν ⋆ f) = ν ⋆ f"
                    by (simp add: ν comp_cod_arr)
                  ultimately show ?thesis
                    using comp_assoc by metis
                qed
                also have "... = (r[r] ⋅ (r ⋆ ε) ⋅ a[r, f, f_a] ⋅ (ρ ⋆ f_a) ⋅ ν) ⋆ f"
                proof -
                  have "arr (r[r] ⋅ (r ⋆ ε) ⋅ a[r, f, f_a] ⋅ (ρ ⋆ f_a) ⋅ ν)"
                    using f_a' comp_assoc by auto
                  thus ?thesis
                    using whisker_right by fastforce
                qed
                finally show ?thesis by blast
              qed
              also have "... = (r[r] ⋅ r^-1[r]) ⋆ f"
                using f_a' comp_assoc by simp
              also have "... = r ⋆ f"
                using ide_base by (simp add: comp_arr_inv')
              finally show ?thesis by blast
            qed
            thus ?thesis
              using ide_leg0 ide_leg1 tab_in_hom comp_cod_arr comp_assoc tab_simps(5) arrI
              by metis
          qed
          finally show ?thesis by argo
        qed
        finally show ?thesis by argo
      qed
      obtain η where η: "«η : trg f_a → f_a ⋆ f¬ ∧ ?β = g ⋆ η ∧
                         (l[f] ⋅ (ε ⋆ f) ⋅ a^-1[f, f_a, f]) ⋅ (f ⋆ η) = r[f]"
        using β θ' A 1 2 f_a runit_in_hom ide_leg0 ide_hcomp src.preserves_ide
              T2 [of "trg f_a" "f_a ⋆ f" "r[f]" f "l[f] ⋅ (ε ⋆ f) ⋅ a^-1[f, f_a, f]" ?β] comp_assoc
              leg1_simps(3)
        by metis
      have η': "?β = g ⋆ η ∧ (l[f] ⋅ (ε ⋆ f) ⋅ a^-1[f, f_a, f]) ⋅ (f ⋆ η) = r[f]"
        using η by simp
      have η: "«η : trg f_a → f_a ⋆ f¬ ∧ «η : src f → src f¬ ∧
               arr η ∧ src η = src f ∧ trg η = src f ∧ dom η = trg f_a ∧ cod η = f_a ⋆ f"
        using η β 2 by force

      have "adjunction_in_bicategory V H a i src trg f f_a η ε"
      proof
        show "ide f" using ide_leg0 by simp
        show "ide f_a" using f_a by blast
        show η_in_hom: "«η : src f → f_a ⋆ f¬"
          using η 2 by simp
        show ε_in_hom: "«ε : f ⋆ f_a → src f_a¬"
          using f_a 1 by simp
        show *: "(ε ⋆ f) ⋅ a^-1[f, f_a, f] ⋅ (f ⋆ η) = l^-1[f] ⋅ r[f]"
          using ide_leg0 iso_lunit invert_side_of_triangle(1) η' comp_assoc by auto

        text ‹
           We have proved one of the triangle identities; now we have to show the other.
           This part, not mentioned by CKS, took me a while to discover.
           Apply ‹T2› again, this time with the following:
           \[\begin{array}{l}
              ‹w = src f ⋆ f_a›,\\
              ‹θ = (ε ⋆ ε) ⋅ a^-1[f, f_a, f ⋆ f_a] ⋅ (f ⋆ a[f_a, f, f_a]) ⋅ (f ⋆ η ⋆ f_a)›,\\
              ‹w' = f_a ⋆ trg›,\\
              ‹θ' = ε ⋆ trg f›,\\
              ‹β = g ⋆ r^-1[f_a] ⋅ l[f_a]›
           \end{array}\]
           Then the conditions for ‹γ› are satisfied by both
           ‹r^-1[f_a] ⋅ l[f_a]› and ‹(f_a ⋆ ε) ⋅ a[f_a, f, f_a] ⋅ (η ⋆ f_a)› so they are equal,
           as required.
        ›
        show "(f_a ⋆ ε) ⋅ a[f_a, f, f_a] ⋅ (η ⋆ f_a) = r^-1[f_a] ⋅ l[f_a]"
        proof -
          let ?u = "trg f ⋆ trg f"
          let ?w = "src f ⋆ f_a"
          let ?w' = "f_a ⋆ trg f"
          let ?θ = "(ε ⋆ ε) ⋅ a^-1[f, f_a, f ⋆ f_a] ⋅ (f ⋆ a[f_a, f, f_a]) ⋅ (f ⋆ η ⋆ f_a)"
          let ?θ' = "(ε ⋆ trg f) ⋅ a^-1[f, f_a, trg f]"
          let ?β = "g ⋆ r^-1[f_a] ⋅ l[f_a]"
          let ?γ = "r^-1[f_a] ⋅ l[f_a]"
          let ?γ' = "(f_a ⋆ ε) ⋅ a[f_a, f, f_a] ⋅ (η ⋆ f_a)"
          have θ_eq': "?θ = (trg f ⋆ ε) ⋅ a[trg f, f, f_a] ⋅ (l^-1[f] ⋅ r[f] ⋆ f_a) ⋅ a^-1[f, src f, f_a]"
          proof -
            have "?θ = (trg f ⋆ ε) ⋅ (ε ⋆ f ⋆ f_a) ⋅
                         (a^-1[f, f_a, f ⋆ f_a] ⋅ (f ⋆ a[f_a, f, f_a])) ⋅ (f ⋆ η ⋆ f_a)"
              using interchange [of "trg f" ε ε "f ⋆ f_a"] comp_arr_dom comp_cod_arr comp_assoc
              by (simp add: ε)
            also have "... = (trg f ⋆ ε) ⋅ (ε ⋆ f ⋆ f_a) ⋅
                               (a[f ⋆ f_a, f, f_a] ⋅ (a^-1[f, f_a, f] ⋆ f_a) ⋅ a^-1[f, f_a ⋆ f, f_a]) ⋅
                               (f ⋆ η ⋆ f_a)"
            proof -
              have "a^-1[f, f_a, f ⋆ f_a] ⋅ (f ⋆ a[f_a, f, f_a]) =
                    a[f ⋆ f_a, f, f_a] ⋅ (a^-1[f, f_a, f] ⋆ f_a) ⋅ a^-1[f, f_a ⋆ f, f_a]"
              proof -
                have "(a[f ⋆ f_a, f, f_a] ⋅ ((a^-1[f, f_a, f] ⋆ f_a) ⋅ a^-1[f, f_a ⋆ f, f_a])) ⋅
                        (f ⋆ a^-1[f_a, f, f_a]) =
                      a^-1[f, f_a, f ⋆ f_a]"
                  using 1 2 ‹ide f_a› ide_leg0 iso_assoc
                        invert_side_of_triangle(1)
                          [of "((a^-1[f, f_a, f] ⋆ f_a) ⋅ a^-1[f, f_a ⋆ f, f_a]) ⋅ (f ⋆ a^-1[f_a, f, f_a])"
                              "a^-1[f ⋆ f_a, f, f_a]" "a^-1[f, f_a, f ⋆ f_a]"]
                       pentagon' comp_assoc by auto
                hence "(a[f ⋆ f_a, f, f_a] ⋅ ((a^-1[f, f_a, f] ⋆ f_a) ⋅ a^-1[f, f_a ⋆ f, f_a])) =
                       a^-1[f, f_a, f ⋆ f_a] ⋅ (f ⋆ a[f_a, f, f_a])"
                  using 1 2 ‹ide f_a›
                        invert_side_of_triangle(2)
                          [of "a^-1[f, f_a, f ⋆ f_a]" "a[f ⋆ f_a, f, f_a] ⋅ ((a^-1[f, f_a, f] ⋆ f_a) ⋅
                                 a^-1[f, f_a ⋆ f, f_a])"
                              "f ⋆ a^-1[f_a, f, f_a]"]
                  by auto
                thus ?thesis
                  using comp_assoc by simp
              qed
              thus ?thesis by simp
            qed
            also have "... = (trg f ⋆ ε) ⋅ ((ε ⋆ f ⋆ f_a) ⋅ a[f ⋆ f_a, f, f_a]) ⋅ (a^-1[f, f_a, f] ⋆ f_a) ⋅
                               a^-1[f, f_a ⋆ f, f_a] ⋅ (f ⋆ η ⋆ f_a)"
              using comp_assoc by simp
            also have "... = (trg f ⋆ ε) ⋅ a[trg f, f, f_a] ⋅
                               ((ε ⋆ f) ⋅ a^-1[f, f_a, f] ⋅ (f ⋆ η) ⋆ f_a) ⋅
                               a^-1[f, src f, f_a]"
            proof -
              have "((ε ⋆ f ⋆ f_a) ⋅ a[f ⋆ f_a, f, f_a] ⋅ (a^-1[f, f_a, f] ⋆ f_a) ⋅
                      a^-1[f, f_a ⋆ f, f_a]) ⋅ (f ⋆ η ⋆ f_a) =
                    (a[trg f, f, f_a] ⋅ ((ε ⋆ f) ⋆ f_a)) ⋅ (a^-1[f, f_a, f] ⋆ f_a) ⋅
                      ((f ⋆ η) ⋆ f_a) ⋅ a^-1[f, src f, f_a]"
                using assoc_naturality [of ε f f_a] assoc'_naturality [of f η f_a]
                by (simp add: 2 ε η ‹ide f_a› comp_assoc)
              also have "... = a[trg f, f, f_a] ⋅
                                 (((ε ⋆ f) ⋆ f_a) ⋅ (a^-1[f, f_a, f] ⋆ f_a) ⋅ ((f ⋆ η) ⋆ f_a)) ⋅
                                 a^-1[f, src f, f_a]"
                using comp_assoc by simp
              also have "... = a[trg f, f, f_a] ⋅
                                 ((ε ⋆ f) ⋅ a^-1[f, f_a, f] ⋅ (f ⋆ η) ⋆ f_a) ⋅
                                 a^-1[f, src f, f_a]"
                using η' comp_assoc whisker_right ‹ide f_a› null_is_zero(2) ide_leg0 ext
                      runit_simps(1)
                by metis
              finally show ?thesis
                using comp_assoc by simp
            qed
            also have "... = (trg f ⋆ ε) ⋅ a[trg f, f, f_a] ⋅ (l^-1[f] ⋅ r[f] ⋆ f_a) ⋅ a^-1[f, src f, f_a]"
              using * by simp
            finally show ?thesis by simp
          qed
          have θ_eq: "?θ = (ε ⋆ trg f) ⋅ a^-1[f, f_a, src f_a] ⋅ (f ⋆ ?γ)"
          proof -
            have "?θ = (trg f ⋆ ε) ⋅ a[trg f, f, f_a] ⋅ (l^-1[f] ⋅ r[f] ⋆ f_a) ⋅ a^-1[f, src f, f_a]"
              using θ_eq' by simp
            also have "... =
                       (trg f ⋆ ε) ⋅ a[trg f, f, f_a] ⋅ (l^-1[f] ⋆ f_a) ⋅ (r[f] ⋆ f_a) ⋅ a^-1[f, src f, f_a]"
              using ‹ide f_a› whisker_right comp_assoc by auto
            also have "... = (trg f ⋆ ε) ⋅ ((a[trg f, f, f_a] ⋅ (a^-1[trg f, f, f_a]) ⋅ l^-1[f ⋆ f_a])) ⋅
                               (f ⋆ l[f_a])"
               using 2 ‹ide f_a› lunit_hcomp [of f f_a] invert_side_of_triangle(2) triangle'
                     comp_assoc
               by auto
            also have "... = (trg f ⋆ ε) ⋅ l^-1[f ⋆ f_a] ⋅ (f ⋆ l[f_a])"
              using f_a 2 comp_cod_arr iso_assoc comp_arr_inv lunit_hcomp(2) lunit_hcomp(4)
                    ide_leg0 leg1_simps(3)
              by metis
            also have "... = l^-1[trg f] ⋅ ε ⋅ (f ⋆ l[f_a])"
              using ε lunit'_naturality comp_assoc by metis
            also have "... = r^-1[trg f] ⋅ ε ⋅ (f ⋆ l[f_a])"
              using unitor_coincidence by simp
            also have "... = (ε ⋆ trg f) ⋅ r^-1[f ⋆ f_a] ⋅ (f ⋆ l[f_a])"
              using ε runit'_naturality comp_assoc by metis
            also have "... = (ε ⋆ trg f) ⋅ a^-1[f, f_a, src f_a] ⋅ (f ⋆ r^-1[f_a]) ⋅ (f ⋆ l[f_a])"
              using 2 ‹ide f_a› runit_hcomp(2) comp_assoc by auto
            also have "... = (ε ⋆ trg f) ⋅ a^-1[f, f_a, src f_a] ⋅ (f ⋆ ?γ)"
              using 2 ‹ide f_a› whisker_left by simp
            finally show ?thesis by simp
          qed
          have θ: "«?θ : f ⋆ ?w → ?u¬"
            using 1 2 ‹ide f_a› η_in_hom ε by fastforce
          have θ': "«?θ' : f ⋆ ?w' → ?u¬"
            using f_a 1 2 ε by auto
          have ww': "ide ?w ∧ ide ?w'"
            by (simp add: 1 2 ‹ide f_a›)
          have "∃!γ. «γ : ?w → ?w'¬ ∧ ?β = g ⋆ γ ∧ ?θ = ?θ' ⋅ (f ⋆ γ)"
          proof -
            have "«?β : g ⋆ ?w → g ⋆ ?w'¬"
              using ‹ide f_a› 1 2 by auto
            moreover have "composite_cell ?w ?θ = composite_cell ?w' ?θ' ⋅ ?β"
            proof -
              have "composite_cell ?w' ?θ' ⋅ ?β =
                    composite_cell ?w ((ε ⋆ trg f) ⋅ a^-1[f, f_a, src f_a] ⋅ (f ⋆ r^-1[f_a] ⋅ l[f_a]))"
              proof -
                have "a[r, f, f_a ⋆ trg f] ⋅ (ρ ⋆ f_a ⋆ trg f) ⋅ (g ⋆ r^-1[f_a] ⋅ l[f_a]) =
                      composite_cell ?w (f ⋆ r^-1[f_a] ⋅ l[f_a])"
                proof -
                  have "a[r, f, f_a ⋆ trg f] ⋅ (ρ ⋆ f_a ⋆ trg f) ⋅ (g ⋆ r^-1[f_a] ⋅ l[f_a]) =
                        (a[r, f, f_a ⋆ trg f] ⋅ ((r ⋆ f) ⋆ r^-1[f_a] ⋅ l[f_a])) ⋅ (ρ ⋆ src f ⋆ f_a)"
                  proof -
                    have "(ρ ⋆ f_a ⋆ trg f) ⋅ (g ⋆ r^-1[f_a] ⋅ l[f_a]) = ρ ⋆ r^-1[f_a] ⋅ l[f_a]"
                      using interchange [of ρ g "f_a ⋆ trg f" "r^-1[f_a] ⋅ l[f_a]"]
                            comp_arr_dom comp_cod_arr 1 2 ‹ide f_a›
                      by simp
                    also have "... = ((r ⋆ f) ⋆ r^-1[f_a] ⋅ l[f_a]) ⋅ (ρ ⋆ src f ⋆ f_a)"
                    proof -
                      have "seq (f_a ⋆ trg f) (r^-1[f_a] ⋅ l[f_a])"
                        using f_a 1 2 ww' by auto
                      thus ?thesis
                        using interchange comp_arr_dom comp_cod_arr 1 2 ‹ide f_a›
                        by (metis ww' comp_ide_arr dom_comp leg1_simps(3)
                                  lunit_simps(4) tab_simps(1) tab_simps(5))
                    qed
                    finally show ?thesis
                      using comp_assoc by simp
                  qed
                  also have "... = composite_cell ?w (f ⋆ r^-1[f_a] ⋅ l[f_a])"
                    using assoc_naturality [of r f "r^-1[f_a] ⋅ l[f_a]"] 1 2 ‹ide f_a› comp_assoc by simp
                  finally show ?thesis by simp
                qed
                hence "composite_cell ?w' ?θ' ⋅ ?β =
                       ((r ⋆ (ε ⋆ trg f) ⋅ a^-1[f, f_a, trg f]) ⋅ (r ⋆ f ⋆ r^-1[f_a] ⋅ l[f_a])) ⋅
                         a[r, f, src f ⋆ f_a] ⋅ (ρ ⋆ src f ⋆ f_a)"
                  using comp_assoc by simp
                also have
                  "... = composite_cell ?w (((ε ⋆ trg f) ⋅ a^-1[f, f_a, trg f]) ⋅ (f ⋆ r^-1[f_a] ⋅ l[f_a]))"
                  using whisker_left 1 2 ‹ide f_a› ide_base
                  by (metis ‹«(ε ⋆ ε) ⋅ a^-1[f, f_a, f ⋆ f_a] ⋅ (f ⋆ a[f_a, f, f_a]) ⋅ (f ⋆ η ⋆ f_a) :
                               f ⋆ src f ⋆ f_a → trg f ⋆ trg f¬›
                      θ_eq arrI comp_assoc)
                finally show ?thesis
                  using comp_assoc by (simp add: "1")
              qed
              also have "... = composite_cell ?w ?θ"
                using θ_eq by simp
              finally show ?thesis by simp
            qed
            ultimately show ?thesis
              using ww' θ θ' T2 [of ?w ?w' ?θ ?u ?θ' ?β] comp_assoc by metis
          qed
          moreover have "«?γ : ?w → ?w'¬ ∧ ?β = g ⋆ ?γ ∧ ?θ = ?θ' ⋅ (f ⋆ ?γ)"
            using 1 2 ‹ide f_a› θ_eq comp_assoc by auto
          moreover have "«?γ' : ?w → ?w'¬ ∧ ?β = g ⋆ ?γ' ∧ ?θ = ?θ' ⋅ (f ⋆ ?γ')"
          proof (intro conjI)
            show "«?γ' : ?w → ?w'¬"
              using 1 2 f_a η_in_hom ε_in_hom by fastforce
            show "?β = g ⋆ ?γ'"
         text ‹
           This equation is not immediate.
           To show it, we have to recall the properties from the construction of ‹ε› and ‹η›.
           Use the property of ‹η› to replace ‹g ⋆ η ⋆ f_a› by a 2-cell involving
           ‹ε›, ‹ρ›, and ‹ν›.
           Use the property ‹(r ⋆ ε) ⋅ (ρ ⋆ f_a) ⋅ ν = r[r]› from the construction of ‹ε› to
           eliminate ‹ε› and ‹ρ› in favor of inv ‹ν› and canonical isomorphisms.
           Cancelling ‹ν› and inv ‹ν› leaves the canonical 2-cell ‹g ⋆ r^-1[f_a] ⋅ l[f_a]›.
            ›
            proof -
              have "g ⋆ ?γ' = (g ⋆ f_a ⋆ ε) ⋅ (g ⋆ a[f_a, f, f_a]) ⋅ (g ⋆ η ⋆ f_a)"
                using 1 2 ‹ide f_a› ε η whisker_left
                by (metis ‹«?γ' : ?w → ?w'¬› arrI ide_leg1 seqE)
              also have "... = (g ⋆ f_a ⋆ ε) ⋅ (g ⋆ a[f_a, f, f_a]) ⋅ (g ⋆ η ⋆ f_a) ⋅
                                 a[g, src f, f_a] ⋅ a^-1[g, src f, f_a]"
                using 1 2 ‹ide f_a› η comp_arr_dom hseq_char comp_assoc_assoc'
                by simp
              also have "... = (g ⋆ f_a ⋆ ε) ⋅ (g ⋆ a[f_a, f, f_a]) ⋅ ((g ⋆ η ⋆ f_a) ⋅
                                 a[g, src f, f_a]) ⋅ a^-1[g, src f, f_a]"
                using comp_assoc by simp
              also have "... = (g ⋆ f_a ⋆ ε) ⋅ (g ⋆ a[f_a, f, f_a]) ⋅
                                 (a[g, f_a ⋆ f, f_a] ⋅ ((g ⋆ η) ⋆ f_a)) ⋅ a^-1[g, src f, f_a]"
                using 1 2 ‹ide f_a› ε η assoc_naturality [of g η f_a] by simp
              also have "... = (g ⋆ f_a ⋆ ε) ⋅ (g ⋆ a[f_a, f, f_a]) ⋅ a[g, f_a ⋆ f, f_a] ⋅
                                 (a[g, f_a, f] ⋅ (ν ⋆ f) ⋅ ρ ⋅ r[g] ⋆ f_a) ⋅ a^-1[g, src f, f_a]"
                using η' comp_assoc by simp
              also have "... = (g ⋆ f_a ⋆ ε) ⋅
                                 ((g ⋆ a[f_a, f, f_a]) ⋅ a[g, f_a ⋆ f, f_a] ⋅ (a[g, f_a, f] ⋆ f_a)) ⋅
                                 ((ν ⋆ f) ⋆ f_a) ⋅ (ρ ⋆ f_a) ⋅ (r[g] ⋆ f_a) ⋅ a^-1[g, src f, f_a]"
              proof -
                have "a[g, f_a, f] ⋅ (ν ⋆ f) ⋅ ρ ⋅ r[g] ⋆ f_a =
                      (a[g, f_a, f] ⋆ f_a) ⋅ ((ν ⋆ f) ⋆ f_a) ⋅ (ρ ⋆ f_a) ⋅ (r[g] ⋆ f_a)"
                  using 1 2 ‹ide f_a› β ε η whisker_right by (metis arrI seqE)
                thus ?thesis
                  using comp_assoc by simp
              qed
              also have "... = ((g ⋆ f_a ⋆ ε) ⋅
                                 a[g, f_a, f ⋆ f_a]) ⋅ (a[g ⋆ f_a, f, f_a] ⋅
                                 ((ν ⋆ f) ⋆ f_a)) ⋅ (ρ ⋆ f_a) ⋅ (r[g] ⋆ f_a) ⋅ a^-1[g, src f, f_a]"
                using 1 2 ‹ide f_a› pentagon comp_assoc by simp
              also have "... = (a[g, f_a, trg f] ⋅ ((g ⋆ f_a) ⋆ ε)) ⋅
                               ((ν ⋆ f ⋆ f_a) ⋅ a[r, f, f_a]) ⋅
                               (ρ ⋆ f_a) ⋅ (r[g] ⋆ f_a) ⋅ a^-1[g, src f, f_a]"
                using 1 2 ‹ide f_a› assoc_naturality [of g f_a ε] assoc_naturality [of ν f f_a]
                by (simp add: ε ν)
              also have "... = a[g, f_a, trg f] ⋅ (((g ⋆ f_a) ⋆ ε) ⋅ (ν ⋆ f ⋆ f_a)) ⋅ a[r, f, f_a] ⋅
                               (ρ ⋆ f_a) ⋅ (r[g] ⋆ f_a) ⋅ a^-1[g, src f, f_a]"
                using 1 2 ‹ide f_a› assoc_naturality [of g f_a ε] assoc_naturality [of ν f f_a]
                      comp_assoc
                by simp
              also have "... = a[g, f_a, trg f] ⋅ (ν ⋆ trg f) ⋅
                                 composite_cell f_a ε ⋅
                                 (r[g] ⋆ f_a) ⋅ a^-1[g, src f, f_a]"
              proof -
                have "((g ⋆ f_a) ⋆ ε) ⋅ (ν ⋆ f ⋆ f_a) = ν ⋆ ε"
                  using 1 2 ‹ide f_a› ν ε interchange [of "g ⋆ f_a" ν ε "f ⋆ f_a"]
                        comp_arr_dom comp_cod_arr
                  by simp
                also have "... = (ν ⋆ trg f) ⋅ (r ⋆ ε)"
                  using ‹ide f_a› ν ε interchange [of ν r "trg f" ε] comp_arr_dom comp_cod_arr
                  by simp
                finally show ?thesis
                  using comp_assoc by simp
              qed
              also have "... = a[g, f_a, trg f] ⋅ ((((ν ⋆ trg f) ⋅ r^-1[r]) ⋅ inv ν) ⋅ (r[g] ⋆ f_a)) ⋅
                                 a^-1[g, src f, f_a]"
                using ide_base f_a' comp_assoc f_a runit'_simps(1) invert_side_of_triangle(2)
                      comp_assoc
                by presburger
              also have "... = a[g, f_a, trg f] ⋅ r^-1[g ⋆ f_a] ⋅ (r[g] ⋆ f_a) ⋅ a^-1[g, src f, f_a]"
              proof -
                have "((ν ⋆ trg f) ⋅ r^-1[r]) ⋅ inv ν = r^-1[g ⋆ f_a]"
                  using 1 2 ‹ide f_a› ν ide_base runit'_naturality [of ν] comp_arr_dom
                  by (metis f_a ide_compE inv_is_inverse inverse_arrowsE comp_assoc
                      runit'_simps(1) runit'_simps(4))
                thus ?thesis
                  using comp_assoc by simp
              qed
              also have "... = ((a[g, f_a, trg f] ⋅ a^-1[g, f_a, src f_a]) ⋅
                                 (g ⋆ r^-1[f_a])) ⋅ (r[g] ⋆ f_a) ⋅ a^-1[g, src f, f_a]"
                using f_a "2" runit_hcomp ‹ide f_a› comp_assoc by simp
              also have "... = (g ⋆ r^-1[f_a]) ⋅ (g ⋆ l[f_a])"
                using 1 2 comp_cod_arr ‹ide f_a› comp_assoc_assoc' triangle' by simp
              also have "... = ?β"
                using 2 ‹ide f_a› whisker_left by simp
              finally show ?thesis by simp
            qed
            show "?θ = ?θ' ⋅ (f ⋆ ?γ')"
            proof -
              have "((ε ⋆ trg f) ⋅ a^-1[f, f_a, trg f]) ⋅ (f ⋆ (f_a ⋆ ε) ⋅ a[f_a, f, f_a] ⋅ (η ⋆ f_a)) =
                    ((ε ⋆ trg f) ⋅ a^-1[f, f_a, trg f]) ⋅ (f ⋆ f_a ⋆ ε) ⋅ (f ⋆ a[f_a, f, f_a]) ⋅ (f ⋆ η ⋆ f_a)"
                using 1 2 ‹ide f_a› ε η whisker_left
                by (metis ‹«(f_a ⋆ ε) ⋅ a[f_a, f, f_a] ⋅ (η ⋆ f_a) : src f ⋆ f_a → f_a ⋆ trg f¬›
                    arrI ide_leg0 seqE)
              also have
                "... = (ε ⋆ trg f) ⋅ (a^-1[f, f_a, trg f] ⋅ (f ⋆ f_a ⋆ ε)) ⋅ (f ⋆ a[f_a, f, f_a]) ⋅ (f ⋆ η ⋆ f_a)"
                using comp_assoc by simp
              also have "... = ((ε ⋆ trg f) ⋅ ((f ⋆ f_a) ⋆ ε)) ⋅
                                 a^-1[f, f_a, f ⋆ f_a] ⋅ (f ⋆ a[f_a, f, f_a]) ⋅
                                 (f ⋆ η ⋆ f_a)"
                using 1 2 ‹ide f_a› ε assoc'_naturality [of f f_a ε] comp_assoc by simp
              also have "... = (trg f ⋆ ε) ⋅ (ε ⋆ f ⋆ f_a) ⋅
                                 (a^-1[f, f_a, f ⋆ f_a] ⋅ (f ⋆ a[f_a, f, f_a])) ⋅
                                 (f ⋆ η ⋆ f_a)"
                using 1 2 ‹ide f_a› ε interchange [of ε "f ⋆ f_a" "trg f" ε]
                       interchange [of "trg f" ε ε "f ⋆ f_a"] comp_arr_dom comp_cod_arr comp_assoc
                by simp
              also have "... = (trg f ⋆ ε) ⋅ ((ε ⋆ f ⋆ f_a) ⋅
                                 (a[f ⋆ f_a, f, f_a]) ⋅ (a^-1[f, f_a, f] ⋆ f_a) ⋅ (a^-1[f, f_a ⋆ f, f_a]) ⋅
                                 (f ⋆ η ⋆ f_a))"
              proof -
                have "a^-1[f, f_a, f ⋆ f_a] ⋅ (f ⋆ a[f_a, f, f_a]) =
                      a[f ⋆ f_a, f, f_a] ⋅ (a^-1[f, f_a, f] ⋆ f_a) ⋅ a^-1[f, f_a ⋆ f, f_a]"
                proof -
                  have A: "(a^-1[f, f_a, f] ⋆ f_a) ⋅ a^-1[f, f_a ⋆ f, f_a] ⋅ (f ⋆ a^-1[f_a, f, f_a]) =
                           a^-1[f ⋆ f_a, f, f_a] ⋅ a^-1[f, f_a, f ⋆ f_a]"
                    using 1 2 ‹ide f_a› pentagon' comp_assoc by fastforce
                  hence B: "a[f ⋆ f_a, f, f_a] ⋅ (a^-1[f, f_a, f] ⋆ f_a) ⋅ a^-1[f, f_a ⋆ f, f_a] ⋅
                              (f ⋆ a^-1[f_a, f, f_a]) =
                            a^-1[f, f_a, f ⋆ f_a]"
                    using A 1 2 ‹ide f_a›
                          invert_side_of_triangle(1)
                            [of "(a^-1[f, f_a, f] ⋆ f_a) ⋅ a^-1[f, f_a ⋆ f, f_a] ⋅ (f ⋆ a^-1[f_a, f, f_a])"
                                "a^-1[f ⋆ f_a, f, f_a]" "a^-1[f, f_a, f ⋆ f_a]"]
                    by auto
                  show ?thesis
                  proof -
                    have C: "iso (f ⋆ a^-1[f_a, f, f_a])"
                      using 1 2 ‹ide f_a› by simp
                    moreover have "inv (f ⋆ a^-1[f_a, f, f_a]) = f ⋆ a[f_a, f, f_a]"
                       using C 1 2 ‹ide f_a› by fastforce
                    ultimately show ?thesis
                      using B 1 2 ‹ide f_a› comp_assoc
                            invert_side_of_triangle(2)
                              [of "a^-1[f, f_a, f ⋆ f_a]"
                                  "a[f ⋆ f_a, f, f_a] ⋅ (a^-1[f, f_a, f] ⋆ f_a) ⋅ a^-1[f, f_a ⋆ f, f_a]"
                                  "f ⋆ a^-1[f_a, f, f_a]"]
                      by simp
                  qed
                qed
                thus ?thesis
                  using comp_assoc by simp
              qed
              also have "... = (trg f ⋆ ε) ⋅ (a[trg f, f, f_a] ⋅
                                 ((ε ⋆ f) ⋆ f_a)) ⋅ (a^-1[f, f_a, f] ⋆ f_a) ⋅ ((f ⋆ η) ⋆ f_a) ⋅
                                 a^-1[f, src f, f_a]"
                using 1 2 ‹ide f_a› ‹ide f› η ε assoc_naturality [of ε f f_a]
                      assoc'_naturality [of f η f_a] comp_assoc
                by simp
              also have "... = (trg f ⋆ ε) ⋅ a[trg f, f, f_a] ⋅
                                 (((ε ⋆ f) ⋆ f_a) ⋅ (a^-1[f, f_a, f] ⋆ f_a) ⋅ ((f ⋆ η) ⋆ f_a)) ⋅
                                 a^-1[f, src f, f_a]"
                using comp_assoc by simp
              also have "... = (trg f ⋆ ε) ⋅ a[trg f, f, f_a] ⋅
                                 ((ε ⋆ f) ⋅ a^-1[f, f_a, f] ⋅ (f ⋆ η) ⋆ f_a) ⋅
                                 a^-1[f, src f, f_a]"
                using 1 2 ‹ide f_a› ‹ide f› η ε whisker_right
                by (metis (full_types) * θ θ_eq' arrI hseqE seqE)
              also have "... = (trg f ⋆ ε) ⋅ a[trg f, f, f_a] ⋅ (l^-1[f] ⋅ r[f] ⋆ f_a) ⋅ a^-1[f, src f, f_a]"
                using * by simp
              also have "... = ?θ"
                using θ_eq' by simp
              finally show ?thesis by simp
            qed
          qed
          ultimately show "?γ' = ?γ" by blast
        qed
      qed
      thus ?thesis
        using adjoint_pair_def by auto
    qed

    sublocale tabulation_data_with_T0
      using satisfies_T0 by (unfold_locales, simp)
    sublocale narrow_tabulation
      using adjoint_pair_antipar(1) T1 T2
      by (unfold_locales, auto)

  end

  text ‹
    A tabulation ‹(f, ρ, g)› of ‹r› yields an isomorphism ‹«ψ : g ⋆ f^* → r¬›
    via adjoint transpose.
    The proof requires ‹T0›, in order to obtain ‹ψ› as the transpose of ‹«ρ : g → r ⋆ f¬›.
    However, it uses only the weaker versions of ‹T1› and ‹T2›.
  ›

  context narrow_tabulation
  begin

    interpretation E: self_evaluation_map V H a i src trg ..
    notation E.eval (‹{_}›)

    text ‹
      The following is CKS Proposition 1(d), with the statement refined to incorporate
      the canonical isomorphisms that they omit.
      Note that we can easily show using ‹T1› that there is some 1-cell ‹f_a› and isomorphism ‹ψ›
      such that ‹«ψ : f ⋆ f_a → r¬› (this was already part of the proof that a tabulation
      satisfies ‹T0›). The more difficult content in the present result is that we may
      actually take ‹f_a› to be the left adjoint ‹f^*› of ‹f›.
    ›

    lemma yields_isomorphic_representation:
    shows "«T0.trnr_\ε r ρ : g ⋆ f^* → r¬" and "iso (T0.trnr_\ε r ρ)"
    proof -
      text ‹
        As stated in CKS, the first step of the proof is:
        \begin{quotation}
          ``Apply ‹T1› with ‹X = A›, ‹u = 1_A›, ‹v = r›, ‹ψ = 1_R›, to obtain ‹f'›, ‹θ': ff' → 1_A›,
          ‹ν : r ≃ g f'› with ‹1_R = (rθ')(ρf')ν›.''
        \end{quotation}
        In our nomenclature: ‹X = trg f›, ‹u = trg f›, ‹v = r›, but ‹ψ = src f›
        does not make any sense, since we need ‹«ψ : v → r ⋆ u¬›. We have to take ‹ψ = r^-1[r]›.
        It is not clear whether this is a typo, or whether it is a consequence of CKS having
        suppressed all canonical isomorphisms (unitors, in this case). The resulting equation
        obtained via T1 is:
        \[
          ‹r^-1[r] = (r ⋆ θ') ⋅ a[r, f, w] ⋅ (ρ ⋆ w) ⋅ ν›,
        \]
        which has ‹r^-1[r]› on the left-hand side, rather than ‹1_R›, as in CKS.
        Also, we have inserted the omitted associativity.
      ›

      obtain w θ' ν where wθ'ν: "ide w ∧ «θ' : f ⋆ w → src r¬ ∧ «ν : r → g ⋆ w¬ ∧ iso ν ∧
                                 composite_cell w θ' ⋅ ν = r^-1[r]"
        using ide_base obj_is_self_adjoint T1 [of "src r" "r^-1[r]"] comp_assoc by auto

      interpret uwθψν V H a i src trg r ρ f g ‹src r› w θ' ‹r^-1[r]› ν
        using ide_base tab_in_hom wθ'ν comp_assoc by (unfold_locales, auto)

      text ‹
        CKS now say:
        \begin{quotation}
          ``Apply ‹T2› with ‹u = 1<sub>A</sub>›, ‹w = f<sup>*</sup>›, ‹w' = f'›, ‹θ = ε: ff<sup>*</sup> → 1›, ‹θ': ff' → 1›,
          ‹β = ν(rε)(ρf<sup>*</sup>)› to obtain ‹γ : f<sup>*</sup> → f'› with ‹gγ = ν(rε)(ρf<sup>*</sup>)ε = θ'(fγ).›''
        \end{quotation}
        The last equation is mysterious, but upon consideration one eventually realizes
        that it is definitely a typo, and what is meant is ``‹gγ = ν(rε)(ρf^*)›, ‹ε = θ'(fγ)›''.

        So, we take ‹u = trg f›, ‹w = f^*›, ‹w' = w›, ‹θ'› as obtained from ‹T1›, ‹θ = ε›,
        and ‹β = ν ⋅ r[r] ⋅ (r ⋆ ε) ⋅ a[r, f, f^*] ⋅ (ρ ⋆ f^*)›.
        (CKS mention neither the unitor term ‹r[r]› nor the associativity ‹a[r, f, f^*]›
        which are required for the expression for ‹β› to make sense.)
      ›

      let ?ψ = "r[r] ⋅ composite_cell f^* ε"
      show ψ_in_hom: "«T0.trnr_\ε r ρ : g ⋆ f^* → r¬"
        using ide_base T0.trnr_\<epsilon>_def rep_in_hom by simp
      have A: "«ν ⋅ ?ψ : g ⋆ f^* → g ⋆ w¬"
        using ide_base T0.antipar hseq_char T0.trnr_\<epsilon>_def rep_in_hom wθ'ν
        apply (intro comp_in_homI') by auto
      have B: "composite_cell f^* ε = composite_cell w θ' ⋅ ν ⋅ ?ψ"
          using ide_base T0.antipar wθ'ν comp_assoc
          by (metis A arrI invert_side_of_triangle(1) iso_runit)

      obtain γ where γ: "«γ : f^* → w¬ ∧ ν ⋅ ?ψ = g ⋆ γ ∧ ε = θ' ⋅ (f ⋆ γ)"
        using A B T0.counit_in_hom obj_is_self_adjoint T0.antipar comp_assoc
              T2 [of "trg f" "f^*" w ε θ' "ν ⋅ r[r] ⋅ composite_cell f^* ε"]
        by auto
      have trg_γ_eq: "trg γ = trg w"
        using γ by fastforce

      text ‹
        CKS say:
        \begin{quotation}
          ``The last equation implies ‹γ: f^* → f'› is a split monic (coretraction), while
          the calculation:
          \begin{eqnarray*}
             ‹(gγ)(gf^*θ')(gηf')› &‹=›& ‹ν(rε)(ρf^*)(gf^*θ')(gηf')›\\
                                 &‹=›& ‹ν(rε)(rff^*θ')(ρf^*ff')(gηf')›\\
                                 &‹=›& ‹ν(rθ')(rεff')(rfηf')(ρf')›\\
                                 &‹=›& ‹ν(rθ')(ρf') = 1_gf'›,
          \end{eqnarray*}
          shows that ‹gγ› is a split epic. So ‹gγ = ν(rε)(ρf^*): gf^* → gf'› is invertible.
          So ‹(rε)(ρf^*) = ν^-1(gγ)› is invertible.''
        \end{quotation}
        We carry out the indicated calculations, inserting where required the canonical
        isomorphisms omitted by CKS. It is perhaps amusing to compare the four-line sketch
        given by CKS with the formalization below, but note that we have carried out the
        proof in full, with no hand waving about units or associativities.
      ›

      have "section (g ⋆ γ)"
      proof
        have "(g ⋆ r[f^*] ⋅ (f^* ⋆ θ') ⋅ a[f^*, f, w] ⋅ (η ⋆ w) ⋅ l^-1[w]) ⋅ (g ⋆ γ) = g ⋆ f^*"
        proof -
          have "(r[f^*] ⋅ (f^* ⋆ θ') ⋅ a[f^*, f, w] ⋅ (η ⋆ w) ⋅ l^-1[w]) ⋅ γ = f^*"
          proof -
            have "(r[f^*] ⋅ (f^* ⋆ θ') ⋅ a[f^*, f, w] ⋅ (η ⋆ w) ⋅ l^-1[w]) ⋅ γ =
                  (r[f^*] ⋅ (f^* ⋆ θ') ⋅ a[f^*, f, w] ⋅ (η ⋆ w)) ⋅ l^-1[w] ⋅ γ"
              using comp_assoc by auto
            also have "... = (r[f^*] ⋅ (f^* ⋆ θ') ⋅ a[f^*, f, w]) ⋅ ((η ⋆ w) ⋅ (trg w ⋆ γ)) ⋅ l^-1[f^*]"
              using γ trg_γ_eq lunit'_naturality [of γ] comp_assoc by auto
            also have "... = r[f^*] ⋅ (f^* ⋆ θ') ⋅ (a[f^*, f, w] ⋅ ((f^* ⋆ f) ⋆ γ)) ⋅ (η ⋆ f^*) ⋅ l^-1[f^*]"
            proof -
              have "(η ⋆ w) ⋅ (trg w ⋆ γ) = η ⋆ γ"
                using A γ interchange comp_arr_dom comp_cod_arr
                by (metis T0.unit_simps(1-2) comp_ide_arr seqI' uwθ w_in_hom(2) w_simps(4))
              also have "... = ((f^* ⋆ f) ⋆ γ) ⋅ (η ⋆ f^*)"
                using γ interchange comp_arr_dom comp_cod_arr T0.antipar T0.unit_simps(1,3)
                      in_homE
                by metis
              finally show ?thesis
                using comp_assoc by simp
            qed
            also have "... = r[f^*] ⋅ (f^* ⋆ θ') ⋅ ((f^* ⋆ f ⋆ γ) ⋅ a[f^*, f, f^*]) ⋅ (η ⋆ f^*) ⋅ l^-1[f^*]"
              using γ assoc_naturality [of "f^*" f γ] trg_γ_eq T0.antipar by auto
            also have "... = r[f^*] ⋅ ((f^* ⋆ ε) ⋅ a[f^*, f, f^*] ⋅ (η ⋆ f^*)) ⋅ l^-1[f^*]"
              using γ whisker_left trg_γ_eq T0.antipar comp_assoc by auto
            also have "... =  r[f^*] ⋅ (r^-1[f^*] ⋅ l[f^*]) ⋅ l^-1[f^*]"
              using T0.triangle_right by simp
            also have "... = f^*"
              using comp_assoc by (simp add: comp_arr_dom comp_arr_inv')
            finally show ?thesis by blast
          qed
          thus ?thesis
            using γ whisker_left [of g "r[f^*] ⋅ (f^* ⋆ θ') ⋅ a[f^*, f, w] ⋅ (η ⋆ w) ⋅ l^-1[w]" γ]
                  T0.antipar
            by simp
        qed
        thus "ide ((g ⋆ r[f^*] ⋅ (f^* ⋆ θ') ⋅ a[f^*, f, w] ⋅ (η ⋆ w) ⋅ l^-1[w]) ⋅ (g ⋆ γ))"
          using T0.antipar by simp
      qed
      moreover have "retraction (g ⋆ γ)"
      proof
        have "«(g ⋆ γ) ⋅ (g ⋆ r[f^*]) ⋅ (g ⋆ f^* ⋆ θ') ⋅ (g ⋆ a[f^*, f, w]) ⋅ (g ⋆ η ⋆ w) ⋅ (g ⋆ l^-1[w]) :
                 g ⋆ w → g ⋆ w¬"
          using γ T0.antipar hseq_char by force
        hence **: "arr ((g ⋆ γ) ⋅ (g ⋆ r[f^*]) ⋅ (g ⋆ f^* ⋆ θ') ⋅ (g ⋆ a[f^*, f, w]) ⋅
                        (g ⋆ η ⋆ w) ⋅ (g ⋆ l^-1[w]))"
          by auto
        show "ide ((g ⋆ γ) ⋅ (g ⋆ r[f^*]) ⋅ (g ⋆ f^* ⋆ θ') ⋅ (g ⋆ a[f^*, f, w]) ⋅
                    (g ⋆ η ⋆ w) ⋅ (g ⋆ l^-1[w]))"
        proof -
          have "((g ⋆ γ) ⋅ (g ⋆ r[f^*]) ⋅ (g ⋆ f^* ⋆ θ') ⋅ (g ⋆ a[f^*, f, w]) ⋅
                  (g ⋆ η ⋆ w) ⋅ (g ⋆ l^-1[w])) =
                g ⋆ w"
          proof -
            have "((g ⋆ γ) ⋅ (g ⋆ r[f^*]) ⋅ (g ⋆ f^* ⋆ θ') ⋅ (g ⋆ a[f^*, f, w]) ⋅
                    (g ⋆ η ⋆ w) ⋅ (g ⋆ l^-1[w])) =
                  ν ⋅ r[r] ⋅ ((r ⋆ r[src f^*]) ⋅ (r ⋆ src f^* ⋆ θ') ⋅ (r ⋆ a[src f^*, f, w]) ⋅
                    (r ⋆ l^-1[f] ⋅ r[f] ⋆ w) ⋅ (r ⋆ a^-1[f, trg w, w]) ⋅ a[r, f, trg w ⋆ w] ⋅
                       (ρ ⋆ trg w ⋆ w)) ⋅ (g ⋆ l^-1[w])"
            proof -
              have "(g ⋆ γ) ⋅ (g ⋆ r[f^*]) ⋅ (g ⋆ f^* ⋆ θ') ⋅ (g ⋆ a[f^*, f, w]) ⋅
                      (g ⋆ η ⋆ w) ⋅ (g ⋆ l^-1[w]) =
                    (ν ⋅ r[r] ⋅ (r ⋆ ε) ⋅ a[r, f, f^*] ⋅ (ρ ⋆ f^*)) ⋅
                      (g ⋆ r[f^*]) ⋅ (g ⋆ f^* ⋆ θ') ⋅ (g ⋆ a[f^*, f, w]) ⋅
                      (g ⋆ η ⋆ w) ⋅ (g ⋆ l^-1[w])"
                using γ by auto
              also have "... =
                         ν ⋅ r[r] ⋅ (r ⋆ ε) ⋅ a[r, f, f^*] ⋅
                           ((ρ ⋆ f^*) ⋅ (g ⋆ r[f^*]) ⋅ (g ⋆ f^* ⋆ θ')) ⋅
                             (g ⋆ a[f^*, f, w]) ⋅ (g ⋆ η ⋆ w) ⋅ (g ⋆ l^-1[w])"
                using comp_assoc by simp
              also have "... = ν ⋅ r[r] ⋅ (r ⋆ ε) ⋅ a[r, f, f^*] ⋅
                                 (((r ⋆ f) ⋆ r[f^*]) ⋅ ((r ⋆ f) ⋆ f^* ⋆ θ') ⋅ (ρ ⋆ f^* ⋆ f ⋆ w)) ⋅
                                   (g ⋆ a[f^*, f, w]) ⋅ (g ⋆ η ⋆ w) ⋅ (g ⋆ l^-1[w])"
              proof -
                have "(ρ ⋆ f^*) ⋅ (g ⋆ r[f^*]) ⋅ (g ⋆ f^* ⋆ θ') =
                      ((r ⋆ f) ⋆ r[f^*]) ⋅ (ρ ⋆ f^* ⋆ src f^*) ⋅ (g ⋆ f^* ⋆ θ')"
                proof -
                  have "(ρ ⋆ f^*) ⋅ (g ⋆ r[f^*]) = ((r ⋆ f) ⋆ r[f^*]) ⋅ (ρ ⋆ f^* ⋆ src f^*)"
                    using tab_in_hom comp_arr_dom comp_cod_arr T0.antipar(1) interchange
                  by (metis T0.ide_right in_homE runit_simps(1,4-5))
                    thus ?thesis
                    by (metis comp_assoc)
                qed
                also have "... = ((r ⋆ f) ⋆ r[f^*]) ⋅ (ρ ⋆ f^* ⋆ θ')"
                  using comp_arr_dom comp_cod_arr T0.antipar
                        interchange [of ρ g "f^* ⋆ src f^*" "f^* ⋆ θ'"]
                  by simp
                also have "... = ((r ⋆ f) ⋆ r[f^*]) ⋅ ((r ⋆ f) ⋆ f^* ⋆ θ') ⋅ (ρ ⋆ f^* ⋆ f ⋆ w)"
                  using comp_arr_dom comp_cod_arr T0.antipar
                        interchange [of "r ⋆ f" ρ "f^* ⋆ θ'" "f^* ⋆ f ⋆ w"]
                  by simp
                finally show ?thesis by simp
              qed
              also have "... = 
                         ν ⋅ r[r] ⋅
                           ((r ⋆ ε) ⋅ a[r, f, f^*] ⋅ ((r ⋆ f) ⋆ r[f^*]) ⋅ ((r ⋆ f) ⋆ f^* ⋆ θ')) ⋅
                           ((ρ ⋆ f^* ⋆ f ⋆ w) ⋅ (g ⋆ a[f^*, f, w]) ⋅ (g ⋆ η ⋆ w)) ⋅
                            (g ⋆ l^-1[w])"
                using comp_assoc by simp
              also have "... = ν ⋅ r[r] ⋅
                                 ((r ⋆ r[src f^*]) ⋅ (r ⋆ src f^* ⋆ θ') ⋅ (r ⋆ ε ⋆ f ⋆ w) ⋅
                                 (r ⋆ a^-1[f, f^*, f ⋆ w]) ⋅ a[r, f, f^* ⋆ f ⋆ w]) ⋅
                                 (((r ⋆ f) ⋆ a[f^*, f, w]) ⋅ ((r ⋆ f) ⋆ η ⋆ w) ⋅ (ρ ⋆ trg w ⋆ w)) ⋅
                                 (g ⋆ l^-1[w])"
              proof -
                have 1: "(r ⋆ ε) ⋅ a[r, f, f^*] ⋅ ((r ⋆ f) ⋆ r[f^*]) ⋅ ((r ⋆ f) ⋆ f^* ⋆ θ') =
                           (r ⋆ r[src f^*]) ⋅ (r ⋆ src f^* ⋆ θ') ⋅ (r ⋆ ε ⋆ f ⋆ w) ⋅
                           (r ⋆ a^-1[f, f^*, f ⋆ w]) ⋅ a[r, f, f^* ⋆ f ⋆ w]"
                proof -
                  have "(r ⋆ ε) ⋅ a[r, f, f^*] ⋅ ((r ⋆ f) ⋆ r[f^*]) ⋅ ((r ⋆ f) ⋆ f^* ⋆ θ') =
                        (r ⋆ ε) ⋅ (r ⋆ f ⋆ r[f^*]) ⋅ a[r, f, f^* ⋆ src f^*] ⋅ ((r ⋆ f) ⋆ f^* ⋆ θ')"
                  proof -
                    have "a[r, f, f^*] ⋅ ((r ⋆ f) ⋆ r[f^*]) = (r ⋆ f ⋆ r[f^*]) ⋅ a[r, f, f^* ⋆ src f^*]"
                      using assoc_naturality [of r f "r[f^*]"] T0.antipar by auto
                    thus ?thesis
                      using comp_assoc by metis
                  qed
                  also have "... = (r ⋆ ε) ⋅ (r ⋆ f ⋆ r[f^*]) ⋅ (r ⋆ f ⋆ f^* ⋆ θ') ⋅
                                     a[r, f, f^* ⋆ f ⋆ w]"
                    using assoc_naturality [of r f "f^* ⋆ θ'"] T0.antipar by fastforce
                  also have "... = (r ⋆ r[src f^*]) ⋅ (r ⋆ ε ⋆ src f^*) ⋅ (r ⋆ a^-1[f, f^*, src f^*]) ⋅
                                   (r ⋆ f ⋆ f^* ⋆ θ') ⋅ a[r, f, f^* ⋆ f ⋆ w]"
                  proof -
                    have "(r ⋆ ε) ⋅ (r ⋆ f ⋆ r[f^*]) =
                          (r ⋆ r[src f^*]) ⋅ (r ⋆ ε ⋆ src f^*) ⋅ (r ⋆ a^-1[f, f^*, src f^*])"
                    proof -
                      have "(r ⋆ ε) ⋅ (r ⋆ f ⋆ r[f^*]) = r ⋆ (ε ⋅ (f ⋆ r[f^*]))"
                        using whisker_left T0.antipar by simp
                      also have "... =
                                 (r ⋆ r[src f^*]) ⋅ (r ⋆ ε ⋆ src f^*) ⋅ (r ⋆ a^-1[f, f^*, src f^*])"
                      proof -
                        have "ε ⋅ (f ⋆ r[f^*]) = r[src f^*] ⋅ (ε ⋆ src f^*) ⋅ a^-1[f, f^*, src f^*]"
                          using ide_leg0 T0.antipar runit_hcomp invert_side_of_triangle(2)
                                runit_naturality comp_assoc
                          by (metis (no_types, lifting) T0.counit_simps(1-4) T0.ide_right)
                        thus ?thesis
                          using whisker_left T0.antipar by simp
                      qed
                      finally show ?thesis by simp
                    qed
                    thus ?thesis using comp_assoc by metis
                  qed
                  also have "... =
                             (r ⋆ r[src f^*]) ⋅ (r ⋆ ε ⋆ src f^*) ⋅
                               ((r ⋆ a^-1[f, f^*, src f^*]) ⋅ (r ⋆ f ⋆ f^* ⋆ θ')) ⋅
                                 a[r, f, f^* ⋆ f ⋆ w]"
                         using comp_assoc by simp
                  also have "... = (r ⋆ r[src f^*]) ⋅ (r ⋆ ε ⋆ src f^*) ⋅
                                     ((r ⋆ (f ⋆ f^*) ⋆ θ') ⋅ (r ⋆ a^-1[f, f^*, f ⋆ w])) ⋅
                                       a[r, f, f^* ⋆ f ⋆ w]"
                  proof -
                    have "(r ⋆ a^-1[f, f^*, src f^*]) ⋅ (r ⋆ f ⋆ f^* ⋆ θ') =
                          (r ⋆ (f ⋆ f^*) ⋆ θ') ⋅ (r ⋆ a^-1[f, f^*, f ⋆ w])"
                    proof -
                      have "(r ⋆ a^-1[f, f^*, src f^*]) ⋅ (r ⋆ f ⋆ f^* ⋆ θ') =
                            r ⋆ a^-1[f, f^*, src f^*] ⋅ (f ⋆ f^* ⋆ θ')"
                        using whisker_left T0.antipar by simp
                      also have "... = r ⋆ ((f ⋆ f^*) ⋆ θ') ⋅ a^-1[f, f^*, f ⋆ w]"
                        using assoc'_naturality [of f "f^*" θ'] T0.antipar by auto
                      also have "... = (r ⋆ (f ⋆ f^*) ⋆ θ') ⋅ (r ⋆ a^-1[f, f^*, f ⋆ w])"
                        using whisker_left T0.antipar by auto
                      finally show ?thesis by simp
                    qed
                    thus ?thesis by simp
                  qed
                  also have "... = (r ⋆ r[src f^*]) ⋅ (r ⋆ ε ⋆ src f^*) ⋅ (r ⋆ (f ⋆ f^*) ⋆ θ') ⋅
                                     (r ⋆ a^-1[f, f^*, f ⋆ w]) ⋅ a[r, f, f^* ⋆ f ⋆ w]"
                    using comp_assoc by simp
                  also have "... = 
                             (r ⋆ r[src f^*]) ⋅ ((r ⋆ ε ⋆ src f^*) ⋅ (r ⋆ (f ⋆ f^*) ⋆ θ')) ⋅
                               (r ⋆ a^-1[f, f^*, f ⋆ w]) ⋅ a[r, f, f^* ⋆ f ⋆ w]"
                    using comp_assoc by simp
                  also have "... = (r ⋆ r[src f^*]) ⋅ ((r ⋆ src f^* ⋆ θ') ⋅ (r ⋆ ε ⋆ f ⋆ w)) ⋅
                                     (r ⋆ a^-1[f, f^*, f ⋆ w]) ⋅ a[r, f, f^* ⋆ f ⋆ w]"
                  proof -
                    have "(r ⋆ ε ⋆ src f^*) ⋅ (r ⋆ (f ⋆ f^*) ⋆ θ') =
                          (r ⋆ src f^* ⋆ θ') ⋅ (r ⋆ ε ⋆ f ⋆ w)"
                    proof -
                      have "(r ⋆ ε ⋆ src f^*) ⋅ (r ⋆ (f ⋆ f^*) ⋆ θ') =
                            r ⋆ (ε ⋆ src f^*) ⋅ ((f ⋆ f^*) ⋆ θ')"
                        using whisker_left T0.antipar by simp
                      also have "... = r ⋆ ε ⋆ θ'"
                        using interchange [of ε "f ⋆ f^*" "src f^*" θ']
                              T0.antipar comp_arr_dom comp_cod_arr
                        by auto
                      also have "... = r ⋆ (src f^* ⋆ θ') ⋅ (ε ⋆ f ⋆ w)"
                        using interchange [of "src f^*" ε θ' "f ⋆ w"]
                              T0.antipar comp_arr_dom comp_cod_arr
                        by auto
                      also have "... = (r ⋆ src f^* ⋆ θ') ⋅ (r ⋆ ε ⋆ f ⋆ w)"
                        using whisker_left T0.antipar by simp
                      finally show ?thesis by blast
                    qed
                    thus ?thesis by simp
                  qed
                  also have "... = (r ⋆ r[src f^*]) ⋅ (r ⋆ src f^* ⋆ θ') ⋅ (r ⋆ ε ⋆ f ⋆ w) ⋅
                                     (r ⋆ a^-1[f, f^*, f ⋆ w]) ⋅ a[r, f, f^* ⋆ f ⋆ w]"
                    using comp_assoc by simp
                  finally show ?thesis by simp
                qed
                have 2: "(ρ ⋆ f^* ⋆ f ⋆ w) ⋅ (g ⋆ a[f^*, f, w]) ⋅ (g ⋆ η ⋆ w) =
                           ((r ⋆ f) ⋆ a[f^*, f, w]) ⋅ ((r ⋆ f) ⋆ η ⋆ w) ⋅ (ρ ⋆ trg w ⋆ w)"
                proof -
                  have "(ρ ⋆ f^* ⋆ f ⋆ w) ⋅ (g ⋆ a[f^*, f, w]) ⋅ (g ⋆ η ⋆ w) =
                        ((ρ ⋆ f^* ⋆ f ⋆ w) ⋅ (g ⋆ a[f^*, f, w])) ⋅ (g ⋆ η ⋆ w)"
                    using comp_assoc by simp
                  also have "... = (((r ⋆ f) ⋆ a[f^*, f, w]) ⋅ (ρ ⋆ (f^* ⋆ f) ⋆ w)) ⋅ (g ⋆ η ⋆ w)"
                  proof -
                    have "(ρ ⋆ f^* ⋆ f ⋆ w) ⋅ (g ⋆ a[f^*, f, w]) =
                          ((r ⋆ f) ⋆ a[f^*, f, w]) ⋅ (ρ ⋆ (f^* ⋆ f) ⋆ w)"
                    proof -
                      have "(ρ ⋆ f^* ⋆ f ⋆ w) ⋅ (g ⋆ a[f^*, f, w]) =
                            ρ ⋅ g ⋆ (f^* ⋆ f ⋆ w) ⋅ a[f^*, f, w]"
                        using interchange T0.antipar by auto
                      also have "... = ρ ⋆ a[f^*, f, w]"
                        using comp_arr_dom comp_cod_arr T0.antipar by auto
                      also have "... = (r ⋆ f) ⋅ ρ ⋆ a[f^*, f, w] ⋅ ((f^* ⋆ f) ⋆ w)"
                        using comp_arr_dom comp_cod_arr T0.antipar by auto
                      also have "... = ((r ⋆ f) ⋆ a[f^*, f, w]) ⋅ (ρ ⋆ (f^* ⋆ f) ⋆ w)"
                        using interchange T0.antipar by auto
                      finally show ?thesis by blast
                    qed
                    thus ?thesis by simp
                  qed
                  also have "... = ((r ⋆ f) ⋆ a[f^*, f, w]) ⋅ (ρ ⋆ (f^* ⋆ f) ⋆ w) ⋅ (g ⋆ η ⋆ w)"
                    using comp_assoc by simp
                  also have "... = ((r ⋆ f) ⋆ a[f^*, f, w]) ⋅ ((r ⋆ f) ⋆ η ⋆ w) ⋅ (ρ ⋆ trg w ⋆ w)"
                  proof -
                    have "(ρ ⋆ (f^* ⋆ f) ⋆ w) ⋅ (g ⋆ η ⋆ w) = ((r ⋆ f) ⋆ η ⋆ w) ⋅ (ρ ⋆ trg w ⋆ w)"
                    proof -
                      have "(ρ ⋆ (f^* ⋆ f) ⋆ w) ⋅ (g ⋆ η ⋆ w) = ρ ⋅ g ⋆ (f^* ⋆ f) ⋅ η ⋆ w ⋅ w"
                      proof -
                        have "«g ⋆ η ⋆ w : g ⋆ trg w ⋆ w → g ⋆ (f^* ⋆ f) ⋆ w¬"
                          by (intro hcomp_in_vhom, auto)
                        thus ?thesis
                          using interchange whisker_right T0.antipar by auto
                      qed
                      also have "... = (r ⋆ f) ⋅ ρ ⋆ η ⋅ trg w ⋆ w ⋅ w"
                        using comp_arr_dom comp_cod_arr by auto
                      also have "... = ((r ⋆ f) ⋆ η ⋆ w) ⋅ (ρ ⋆ trg w ⋆ w)"
                        using interchange [of "r ⋆ f" ρ "η ⋆ w" "trg w ⋆ w"]
                              interchange [of η "trg w" w w]
                              comp_arr_dom comp_cod_arr T0.unit_in_hom
                        by auto
                      finally show ?thesis by simp
                    qed
                    thus ?thesis by simp
                  qed
                  finally show ?thesis by simp
                qed
                show ?thesis
                  using 1 2 by simp
              qed
              also have "... =
                         ν ⋅ r[r] ⋅
                           ((r ⋆ r[src r]) ⋅ (r ⋆ src r ⋆ θ') ⋅
                              ((r ⋆ a[src r, f, w]) ⋅ (r ⋆ (ε ⋆ f) ⋆ w) ⋅ (r ⋆ a^-1[f ⋆ f^*, f, w])) ⋅
                            (r ⋆ a^-1[f, f^*, f ⋆ w]) ⋅ a[r, f, f^* ⋆ f ⋆ w]) ⋅
                          (((r ⋆ f) ⋆ a[f^*, f, w]) ⋅
                              (a^-1[r, f, (f^* ⋆ f) ⋆ w] ⋅ (r ⋆ a[f, f^* ⋆ f, w]) ⋅
                                (r ⋆ (f ⋆ η) ⋆ w) ⋅
                               (r ⋆ a^-1[f, trg w, w]) ⋅ a[r, f, trg w ⋆ w]) ⋅
                            (ρ ⋆ trg w ⋆ w)) ⋅ (g ⋆ l^-1[w])"
              proof -
                have 3: "r ⋆ ε ⋆ f ⋆ w =
                         (r ⋆ a[src r, f, w]) ⋅ (r ⋆ (ε ⋆ f) ⋆ w) ⋅ (r ⋆ a^-1[f ⋆ f^*, f, w])"
                proof -
                  have "r ⋆ ε ⋆ f ⋆ w =
                        ((r ⋆ a[src r, f, w]) ⋅ (r ⋆ a^-1[src r, f, w])) ⋅ (r ⋆ ε ⋆ f ⋆ w)"
                    using T0.antipar whisker_left [of r "a[src r, f, w]" "a^-1[src r, f, w]"]
                          comp_cod_arr comp_assoc_assoc'
                    by simp
                 also have "... = (r ⋆ a[src r, f, w]) ⋅ (r ⋆ (ε ⋆ f) ⋆ w) ⋅
                                     (r ⋆ a^-1[f ⋆ f^*, f, w])"
                    using assoc'_naturality [of ε f w]
                          whisker_left [of r "a^-1[src r, f, w]" "ε ⋆ f ⋆ w"]
                          whisker_left comp_assoc T0.antipar
                    by simp
                  finally show ?thesis
                    using T0.antipar by simp
                qed
                have 4: "(r ⋆ f) ⋆ η ⋆ w =
                         a^-1[r, f, (f^* ⋆ f) ⋆ w] ⋅ (r ⋆ a[f, f^* ⋆ f, w]) ⋅
                           (r ⋆ (f ⋆ η) ⋆ w) ⋅
                             (r ⋆ a^-1[f, trg w, w]) ⋅ a[r, f, trg w ⋆ w]"
                proof -
                  have "(r ⋆ f) ⋆ η ⋆ w =
                        (a^-1[r, f, (f^* ⋆ f) ⋆ w] ⋅
                          ((r ⋆ a[f, f^* ⋆ f, w]) ⋅ (r ⋆ a^-1[f, f^* ⋆ f, w])) ⋅
                            a[r, f, (f^* ⋆ f) ⋆ w]) ⋅
                              ((r ⋆ f) ⋆ η ⋆ w)"
                  proof -
                    have "ide r" by simp
                    moreover have "seq a[f, f^* ⋆ f, w] a^-1[f, f^* ⋆ f, w]"
                      using T0.antipar comp_cod_arr ide_base by simp
                    ultimately have "(r ⋆ a[f, f^* ⋆ f, w]) ⋅ (r ⋆ a^-1[f, f^* ⋆ f, w]) =
                                     r ⋆ a[f, f^* ⋆ f, w] ⋅ a^-1[f, f^* ⋆ f, w]"
                      using whisker_left by metis
                    thus ?thesis
                      using T0.antipar comp_cod_arr comp_assoc_assoc' by simp
                  qed
                  also have "... =
                             a^-1[r, f, (f^* ⋆ f) ⋆ w] ⋅
                               (r ⋆ a[f, f^* ⋆ f, w]) ⋅ ((r ⋆ a^-1[f, f^* ⋆ f, w]) ⋅
                                 (r ⋆ f ⋆ η ⋆ w)) ⋅
                                   a[r, f, trg w ⋆ w]"
                    using assoc_naturality [of r f "η ⋆ w"] comp_assoc by fastforce
                  also have "... =
                             a^-1[r, f, (f^* ⋆ f) ⋆ w] ⋅
                               (r ⋆ a[f, f^* ⋆ f, w]) ⋅ (r ⋆ (f ⋆ η) ⋆ w) ⋅
                                 (r ⋆ a^-1[f, trg w, w]) ⋅
                                   a[r, f, trg w ⋆ w]"
                    using assoc'_naturality [of f η w] T0.antipar comp_assoc
                          whisker_left [of r "a^-1[f, f^* ⋆ f, w]" "f ⋆ η ⋆ w"]
                          whisker_left [of r "(f ⋆ η) ⋆ w" "a^-1[f, trg w, w]"]
                    by simp
                  finally show ?thesis by blast
                qed
                show ?thesis
                  using 3 4 T0.antipar by simp
              qed
              also have "... = ν ⋅ r[r] ⋅ ((r ⋆ r[src r]) ⋅ (r ⋆ src r ⋆ θ') ⋅
                                (r ⋆ a[src r, f, w]) ⋅
                                  ((r ⋆ (ε ⋆ f) ⋆ w) ⋅
                                    ((r ⋆ a^-1[f ⋆ f^*, f, w]) ⋅ (r ⋆ a^-1[f, f^*, f ⋆ w]) ⋅
                                     a[r, f, f^* ⋆ f ⋆ w] ⋅ ((r ⋆ f) ⋆ a[f^*, f, w]) ⋅
                                     a^-1[r, f, (f^* ⋆ f) ⋆ w] ⋅ (r ⋆ a[f, f^* ⋆ f, w])) ⋅
                                  (r ⋆ (f ⋆ η) ⋆ w)) ⋅
                                    (r ⋆ a^-1[f, trg w, w]) ⋅ a[r, f, trg w ⋆ w] ⋅
                                      (ρ ⋆ trg w ⋆ w)) ⋅ (g ⋆ l^-1[w])"
                using comp_assoc T0.antipar by auto
              also have "... = ν ⋅ r[r] ⋅ ((r ⋆ r[src r]) ⋅ (r ⋆ src r ⋆ θ') ⋅
                                (r ⋆ a[src r, f, w]) ⋅
                                  ((r ⋆ (ε ⋆ f) ⋆ w) ⋅ (r ⋆ a^-1[f, f^*, f] ⋆ w) ⋅
                                    (r ⋆ (f ⋆ η) ⋆ w)) ⋅
                                  (r ⋆ a^-1[f, trg w, w]) ⋅ a[r, f, trg w ⋆ w] ⋅
                                    (ρ ⋆ trg w ⋆ w)) ⋅ (g ⋆ l^-1[w])"
              proof -
                have "(r ⋆ a^-1[f ⋆ f^*, f, w]) ⋅ (r ⋆ a^-1[f, f^*, f ⋆ w]) ⋅
                        a[r, f, f^* ⋆ f ⋆ w] ⋅ ((r ⋆ f) ⋆ a[f^*, f, w]) ⋅
                          a^-1[r, f, (f^* ⋆ f) ⋆ w] ⋅ (r ⋆ a[f, f^* ⋆ f, w]) =
                      r ⋆ a^-1[f, f^*, f] ⋆ w"
                proof -
                  text ‹We can compress the reasoning about the associativities using coherence.›
                  have "(r ⋆ a^-1[f ⋆ f^*, f, w]) ⋅ (r ⋆ a^-1[f, f^*, f ⋆ w]) ⋅
                          a[r, f, f^* ⋆ f ⋆ w] ⋅ ((r ⋆ f) ⋆ a[f^*, f, w]) ⋅
                            a^-1[r, f, (f^* ⋆ f) ⋆ w] ⋅ (r ⋆ a[f, f^* ⋆ f, w]) =
                          {(\⟨r\⟩ \⋆ \a^-1[\⟨f\⟩ \⋆ \⟨f^*\⟩, \⟨f\⟩, \⟨w\⟩]) \⋅ (\⟨r\⟩ \⋆ \a^-1[\⟨f\⟩, \⟨f^*\⟩, \⟨f\⟩ \⋆ \⟨w\⟩]) \⋅
                            \a[\⟨r\⟩, \⟨f\⟩, \⟨f^*\⟩ \⋆ \⟨f\⟩ \⋆ \⟨w\⟩] \⋅ ((\⟨r\⟩ \⋆ \⟨f\⟩) \⋆ \a[\⟨f^*\⟩, \⟨f\⟩, \⟨w\⟩]) \⋅
                              \a^-1[\⟨r\⟩, \⟨f\⟩, (\⟨f^*\⟩ \⋆ \⟨f\⟩) \⋆ \⟨w\⟩] \⋅ (\⟨r\⟩ \⋆ \a[\⟨f\⟩, \⟨f^*\⟩ \⋆ \⟨f\⟩, \⟨w\⟩])}"
                    using T0.antipar a'_def α_def assoc'_eq_inv_assoc by auto
                  also have "... = {\⟨r\⟩ \⋆ \a^-1[\⟨f\⟩, \⟨f^*\⟩, \⟨f\⟩] \⋆ \⟨w\⟩}"
                    using T0.antipar by (intro E.eval_eqI, auto)
                  also have "... = r ⋆ a^-1[f, f^*, f] ⋆ w"
                    using T0.antipar a'_def α_def assoc'_eq_inv_assoc by simp
                  finally show ?thesis
                    by simp
                qed
                thus ?thesis by simp
              qed
              also have "... = ν ⋅ r[r] ⋅ ((r ⋆ r[src r]) ⋅ (r ⋆ src r ⋆ θ') ⋅
                                  (r ⋆ a[src r, f, w]) ⋅
                                (r ⋆ l^-1[f] ⋅ r[f] ⋆ w) ⋅
                                  (r ⋆ a^-1[f, trg w, w]) ⋅ a[r, f, trg w ⋆ w] ⋅
                                    (ρ ⋆ trg w ⋆ w)) ⋅ (g ⋆ l^-1[w])"
              proof -
                have "(r ⋆ (ε ⋆ f) ⋆ w) ⋅ (r ⋆ a^-1[f, f^*, f] ⋆ w) ⋅ (r ⋆ (f ⋆ η) ⋆ w) =
                      r ⋆ l^-1[f] ⋅ r[f] ⋆ w"
                proof -
                  have "(r ⋆ (ε ⋆ f) ⋆ w) ⋅ (r ⋆ a^-1[f, f^*, f] ⋆ w) ⋅ (r ⋆ (f ⋆ η) ⋆ w) =
                        r ⋆ (ε ⋆ f) ⋅ a^-1[f, f^*, f] ⋅ (f ⋆ η) ⋆ w"
                    using whisker_left whisker_right T0.antipar by simp
                  also have "... = r ⋆ l^-1[f] ⋅ r[f] ⋆ w"
                    using T0.triangle_left by simp
                  finally show ?thesis by blast
                qed
                thus ?thesis by simp
              qed
              also have "... = ν ⋅ r[r] ⋅ ((r ⋆ r[src f^*]) ⋅ (r ⋆ src f^* ⋆ θ') ⋅ (r ⋆ a[src f^*, f, w]) ⋅
                                (r ⋆ l^-1[f] ⋅ r[f] ⋆ w) ⋅
                                  (r ⋆ a^-1[f, trg w, w]) ⋅ a[r, f, trg w ⋆ w] ⋅
                                    (ρ ⋆ trg w ⋆ w)) ⋅ (g ⋆ l^-1[w])"
                using T0.antipar by simp
              finally show ?thesis by simp
            qed
            also have "... = ν ⋅ r[r] ⋅
                               ((r ⋆ r[src r]) ⋅ (r ⋆ src r ⋆ θ')) ⋅
                                 (r ⋆ a[src r, f, w]) ⋅ (r ⋆ l^-1[f] ⋅ r[f] ⋆ w) ⋅
                                   (r ⋆ a^-1[f, trg w, w]) ⋅ a[r, f, trg w ⋆ w] ⋅
                                    ((ρ ⋆ trg w ⋆ w) ⋅ (g ⋆ l^-1[w]))"
              using comp_assoc T0.antipar by simp
            also have "... = ν ⋅ r[r] ⋅
                               ((r ⋆ θ') ⋅ (r ⋆ l[f ⋆ w])) ⋅
                                 (r ⋆ a[src r, f, w]) ⋅ (r ⋆ l^-1[f] ⋅ r[f] ⋆ w) ⋅
                                   (r ⋆ a^-1[f, trg w, w]) ⋅ a[r, f, trg w ⋆ w] ⋅
                                    (((r ⋆ f) ⋆ l^-1[w]) ⋅ (ρ ⋆ w))"
            proof -
              have "(r ⋆ r[src r]) ⋅ (r ⋆ src r ⋆ θ') = (r ⋆ θ') ⋅ (r ⋆ l[f ⋆ w])"
              proof -
                have "(r ⋆ r[src r]) ⋅ (r ⋆ src r ⋆ θ') = r ⋆ r[src r] ⋅ (src r ⋆ θ')"
                  using whisker_left by simp
                also have "... = r ⋆ θ' ⋅ l[f ⋆ w]"
                  using lunit_naturality [of θ'] unitor_coincidence by simp
                also have "... = (r ⋆ θ') ⋅ (r ⋆ l[f ⋆ w])"
                  using whisker_left by simp
                finally show ?thesis by simp
              qed
              moreover have "(ρ ⋆ trg w ⋆ w) ⋅ (g ⋆ l^-1[w]) = ((r ⋆ f) ⋆ l^-1[w]) ⋅ (ρ ⋆ w)"
              proof -
                have "(ρ ⋆ trg w ⋆ w) ⋅ (g ⋆ l^-1[w]) = ρ ⋅ g ⋆ (trg w ⋆ w) ⋅ l^-1[w]"
                  using interchange by simp
                also have "... = ρ ⋆ l^-1[w]"
                  using comp_arr_dom comp_cod_arr by simp
                also have "... = (r ⋆ f) ⋅ ρ ⋆ l^-1[w] ⋅ w"
                  using comp_arr_dom comp_cod_arr by simp
                also have "... = ((r ⋆ f) ⋆ l^-1[w]) ⋅ (ρ ⋆ w)"
                  using interchange by simp
                finally show ?thesis by simp
              qed
              ultimately show ?thesis by simp
            qed
            also have "... = ν ⋅ r[r] ⋅ (r ⋆ θ') ⋅
                              ((r ⋆ l[f ⋆ w]) ⋅ (r ⋆ a[src r, f, w]) ⋅
                                 (r ⋆ l^-1[f] ⋅ r[f] ⋆ w) ⋅ (r ⋆ a^-1[f, trg w, w]) ⋅
                                    a[r, f, trg w ⋆ w] ⋅ ((r ⋆ f) ⋆ l^-1[w])) ⋅
                                (ρ ⋆ w)"
              using comp_assoc by simp
            also have "... = ν ⋅ r[r] ⋅ (r ⋆ θ') ⋅ a[r, f, w] ⋅ (ρ ⋆ w)"
            proof -
              have "((r ⋆ l[f ⋆ w]) ⋅ (r ⋆ a[src r, f, w]) ⋅
                      (r ⋆ l^-1[f] ⋅ r[f] ⋆ w) ⋅ (r ⋆ a^-1[f, trg w, w]) ⋅
                        a[r, f, trg w ⋆ w] ⋅ ((r ⋆ f) ⋆ l^-1[w])) =
                    a[r, f, w]"
              proof -
                have "((r ⋆ l[f ⋆ w]) ⋅ (r ⋆ a[src r, f, w]) ⋅
                        (r ⋆ l^-1[f] ⋅ r[f] ⋆ w) ⋅ (r ⋆ a^-1[f, trg w, w]) ⋅
                          a[r, f, trg w ⋆ w] ⋅ ((r ⋆ f) ⋆ l^-1[w])) =
                      ((r ⋆ (l[f] ⋆ w) ⋅ a^-1[trg f, f, w]) ⋅ (r ⋆ a[src r, f, w]) ⋅
                         (r ⋆ l^-1[f] ⋅ r[f] ⋆ w) ⋅ (r ⋆ a^-1[f, trg w, w]) ⋅
                           (r ⋆ f ⋆ l^-1[w])) ⋅ a[r, f, w]"
                  using comp_assoc assoc_naturality [of r f "l^-1[w]"] lunit_hcomp by simp
                also have "... = a[r, f, w]"
                proof -
                  have "(r ⋆ (l[f] ⋆ w) ⋅ a^-1[trg f, f, w]) ⋅ (r ⋆ a[src r, f, w]) ⋅
                          (r ⋆ l^-1[f] ⋅ r[f] ⋆ w) ⋅ (r ⋆ a^-1[f, trg w, w]) ⋅
                            (r ⋆ f ⋆ l^-1[w]) =
                        r ⋆ f ⋆ w"
                  proof -
                    text ‹Again, get a little more mileage out of coherence.›
                    have "(r ⋆ (l[f] ⋆ w) ⋅ a^-1[trg f, f, w]) ⋅ (r ⋆ a[src r, f, w]) ⋅
                            (r ⋆ l^-1[f] ⋅ r[f] ⋆ w) ⋅ (r ⋆ a^-1[f, trg w, w]) ⋅
                              (r ⋆ f ⋆ l^-1[w]) =
                          {(\⟨r\⟩ \⋆ (\l[\⟨f\⟩] \⋆ \⟨w\⟩) \⋅ \a^-1[E.Trg \⟨f\⟩, \⟨f\⟩, \⟨w\⟩]) \⋅
                               (\⟨r\⟩ \⋆ \a[E.Src \⟨r\⟩, \⟨f\⟩, \⟨w\⟩]) \⋅
                             (\⟨r\⟩ \⋆ \l^-1[\⟨f\⟩] \⋅ \r[\⟨f\⟩] \⋆ \⟨w\⟩) \⋅ (\⟨r\⟩ \⋆ \a^-1[\⟨f\⟩, E.Trg \⟨w\⟩, \⟨w\⟩]) \⋅
                               (\⟨r\⟩ \⋆ \⟨f\⟩ \⋆ \l^-1[\⟨w\⟩])}"
                        using l_ide_simp r_ide_simp a'_def α_def assoc'_eq_inv_assoc by simp
                    also have "... = {\⟨r\⟩ \⋆ \⟨f\⟩ \⋆ \⟨w\⟩}"
                      by (intro E.eval_eqI, auto)
                    also have "... = r ⋆ f ⋆ w"
                      by simp
                    finally show ?thesis by blast
                  qed
                  thus ?thesis
                    using comp_cod_arr
                    by (metis assoc_naturality1 base_simps(2-3) leg0_simps(2-4)
                        w_simps(2) w_simps(4) w_simps(5))
                qed
                finally show ?thesis by blast
              qed
              thus ?thesis by simp
            qed
            also have "... = ν ⋅ r[r] ⋅ r^-1[r] ⋅ inv ν"
            proof -
              have "r^-1[r] ⋅ inv ν = (r ⋆ θ') ⋅ a[r, f, w] ⋅ (ρ ⋆ w)"
                using ** wθ'ν ide_base ide_leg0 tab_in_hom invert_side_of_triangle(2) comp_arr_dom
                      T0.antipar comp_assoc runit'_simps(1)
                by metis
              thus ?thesis by simp
            qed
            also have "... = g ⋆ w"
              using ** wθ'ν ide_base comp_arr_inv'
              by (metis calculation in_homE invert_side_of_triangle(1) iso_runit iso_runit')
            finally show ?thesis by simp
          qed
          thus ?thesis by simp
        qed
      qed
      ultimately have 1: "iso (g ⋆ γ)"
        using iso_iff_section_and_retraction by simp
      have "iso (inv (ν ⋅ r[r]) ⋅ (g ⋆ γ))"
      proof -
        have "iso (inv (ν ⋅ r[r]))"
          using wθ'ν γ iso_runit
          by (elim conjE in_homE, intro iso_inv_iso isos_compose, auto)
        thus ?thesis
          using 1 wθ'ν γ trg_γ_eq isos_compose
          by (elim conjE in_homE, auto)
      qed
      moreover have "inv (ν ⋅ r[r]) ⋅ (g ⋆ γ) = composite_cell f^* ε"
      proof -
        have "inv (ν ⋅ r[r]) ⋅ (g ⋆ γ) = inv (ν ⋅ r[r]) ⋅ ν ⋅ r[r] ⋅ composite_cell f^* ε"
          using γ by auto
        also have "... = ((inv (ν ⋅ r[r]) ⋅ (ν ⋅ r[r])) ⋅ (r ⋆ ε)) ⋅ a[r, f, f^*] ⋅ (ρ ⋆ f^*)"
            using wθ'ν comp_assoc by auto
        also have "... = composite_cell f^* ε"
        proof -
          have "dom ν = r"
            using wθ'ν by auto
          thus ?thesis
            using iso_runit wθ'ν isos_compose comp_cod_arr whisker_left comp_inv_arr'
            by auto
        qed
        finally show ?thesis by blast
      qed
      ultimately have "iso (composite_cell f^* ε)" by simp
      thus "iso (T0.trnr_\ε r ρ)"
        using T0.trnr_\<epsilon>_def ide_base runit_in_hom iso_runit isos_compose
        by (metis A arrI seqE)
    qed

    text ‹
      It is convenient to have a simpler version of the previous result for when we do
      not care about the details of the isomorphism.
    ›

    lemma yields_isomorphic_representation':
    obtains ψ where "«ψ : g ⋆ f^* → r¬" and "iso ψ"
      using yields_isomorphic_representation adjoint_pair_def by simp

  end

  text ‹
    It is natural to ask whether if ‹«ψ : g ⋆ f^* → r¬› is an isomorphism
    then ‹ρ = (ψ ⋆ f) ⋅ T0.trnr_\<eta> g (g ⋆ f^*)› is a tabulation of ‹r›.
    This is not true without additional conditions on ‹f› and ‹g›
    (\emph{cf.}~the comments following CKS Proposition 6).
    So only rather special isomorphisms ‹«ψ : g ⋆ f^* → r¬› result from tabulations of ‹r›.
  ›

  subsection "Tabulation of a Right Adjoint"

  text ‹
    Here we obtain a tabulation of the right adjoint of a map. This is CKS Proposition 1(e).
    It was somewhat difficult to find the correct way to insert the unitors
    that CKS omit.  At first I thought I could only prove this under the assumption
    that the bicategory is normal, but later I saw how to do it in the general case.
  \<close>

  context adjunction_in_bicategory
  begin

    lemma tabulation_of_right_adjoint:
    shows "tabulation V H \<a> \<i> src trg g \<eta> f (src f)"
    proof -
      interpret T: tabulation_data V H \<a> \<i> src trg g \<eta> f \<open>src f\<close>
        using unit_in_hom antipar by (unfold_locales, simp_all)
      show ?thesis
      proof
        show T1: "\<And>u \<omega>. \<lbrakk> ide u; \<guillemotleft>\<omega> : dom \<omega> \<Rightarrow> g \<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> src f \<star> w\<guillemotright> \<and> iso \<nu> \<and>
                                 T.composite_cell w \<theta> \<cdot> \<nu> = \<omega>"
        proof -
          fix u v \<omega>
          assume u: "ide u"
          assume \<omega>: "\<guillemotleft>\<omega> : v \<Rightarrow> g \<star> u\<guillemotright>"
          have v: "ide v"
            using \<omega> by auto
          have 1: "src g = trg u"
            using \<omega> by (metis arr_cod in_homE not_arr_null seq_if_composable)
          have 2: "src f = trg v"
            using \<omega> 1 u ide_right antipar(1) vconn_implies_hpar(4) by force
          text \<open>It seems clear that we need to take \<open>w = v\<close> and \<open>\<nu> = \<l>\<^sup>-\<^sup>1[v]\<close>. \<close>
          let ?w = v
          let ?\<nu> = "\<l>\<^sup>-\<^sup>1[v]"
          have \<nu>: "\<guillemotleft>?\<nu> : v \<Rightarrow> src f \<star> ?w\<guillemotright> \<and> iso ?\<nu>"
            using v 2 iso_lunit' by auto
          text \<open>
            We need \<open>\<theta>\<close>, defined to satisfy \<open>\<guillemotleft>\<theta> : f \<star> v \<Rightarrow> u\<guillemotright>\<close> and
            \<open>\<omega> = (v \<star> \<theta>) \<cdot> \<a>[v, f, v] \<cdot> (\<eta> \<star> w) \<cdot> \<l>\<^sup>-\<^sup>1[v]\<close>.
            We have \<open>\<guillemotleft>\<omega> : v \<Rightarrow> g \<star> u\<guillemotright>\<close>, so we can get arrow \<open>\<guillemotleft>\<theta> : f \<star> v \<Rightarrow> u\<guillemotright>\<close> by adjoint transpose.
            Note that this uses adjoint transpose on the \emph{left}, rather than on the right.
          \<close>
          let ?\<theta> = "trnl\<^sub>\<epsilon> u \<omega>"
          have \<theta>: "\<guillemotleft>?\<theta> : f \<star> ?w \<Rightarrow> u\<guillemotright>"
            using u v antipar 1 2 \<omega> adjoint_transpose_left(2) [of u v] by auto
          text \<open>
            Now, \<open>trnl\<^sub>\<eta> v \<theta> \<equiv> (g \<star> \<theta>) \<cdot> \<a>[g, f, v] \<cdot> (\<eta> \<star> v) \<cdot> \<l>\<^sup>-\<^sup>1[v]\<close>, which suggests that
            we ought to have \<open>\<omega> = trnl\<^sub>\<eta> v \<theta>\<close> and \<open>\<nu> = \<l>\<^sup>-\<^sup>1[v]\<close>;
          \<close>
          have "T.composite_cell ?w ?\<theta> \<cdot> ?\<nu> = \<omega>"
            using u v \<omega> 1 2 adjoint_transpose_left(4) [of u v \<omega>] trnl\<^sub>\<eta>_def comp_assoc by simp
          thus "\<exists>w  java.lang.StringIndexOutOfBoundsException: Index 2 out of bounds for length 2
                        .w < <>< = <"
using  \theta>\<u antipar  by 
        
       T2:"<>u  w <><> \beta>.
                     *  >sbjava.lang.StringIndexOutOfBoundsException: Index 37 out of bounds for length 37
                        ctx->pos = ( + 1)< 
                     T. w \<heta>=T. ' <'\cdot <>\rbrakk>\Longrightarrow>
                    \<exists>!\<gamma>. \<guillemotleft*/
        folio_release_(olio,lf;
          fix  w < \theta> \>
            (i ;i <limit; i+, de+){
           (olio, de-i)
          assume \<theta>: "\<guillemotleft>\<theta> : f \<star> w \<Rightarrow> u\<guillemotright>"
          assume \<theta>': "\<guillemotleft>\<theta>' : f \<star> w' \<Rightarrow> u\<guillemotright>"
          assume \<beta>: "\<guillemotleft>\<beta> : src f \<star> w \<Rightarrow> src f \<star> w'\<guillemotright>"
          assume E: "T.composite_cell w \<theta> = T.composite_cell w' \<theta>' \<cdot> \<beta>"
          interpret T: uw\<theta>w'\<theta>'\<beta> V H \<a> \<i> src trg g \<eta> f \<open>src f\<close> u w \<theta> w' \<theta>' \<beta>
            using w w' \<theta> \<theta>' \<beta> E comp_assoc by (unfold_locales, auto)
          have 2: "src f = trg \<beta>"
            using antipar by simp
          show "\<exists>!\<gamma>. \<guillemotleft>\<gamma> : w \<Rightarrow> w'\<guillemotright> \<and> \<beta> = src f \<star> \<gamma> \<and> \<theta> = \<theta>' \<cdot> (f \<star> \<gamma>)"
          proof -
            text \<open>
              The requirement \<open>\<beta> = src f \<star> \<gamma>\<close> means we have to essentially invert \<open>\<lambda>\<gamma>. src f \<star> \<gamma>\<close>
              to obtain \<open>\<gamma>\<close>.  CKS say only: ``the strong form of \<open>T2\<close> is clear since \<open>g = 1\<close>"
              (here by ``\<open>g\<close>'' they are referring to \<open>dom \<eta>\<close>, the ``output leg'' of the span in
              the tabulation).  This would mean that we would have to take \<open>\<gamma> = \<beta>\<close>, which doesn't
              work for a general bicategory (we don't necessarily have \<open>src f \<star> \<gamma> = \<gamma>\<close>).
              For a general bicategory, we have to take \<open>\<gamma> = \<l>[w'] \<cdot> \<beta> \<cdot> \<l>\<^sup>-\<^sup>1[w]\<close>.
            \<close>
            let ?\<gamma> = "\<l>[w'] \<cdot> \<beta> \<cdot> \<l>\<^sup>-\<^sup>1[w]"
            have \<gamma>: "\<guillemotleft>?\<gamma> : w \<Rightarrow> w'\<guillemotright>"
              using \<beta> by simp
            have 3: "\<beta> = src f \<star> ?\<gamma>"
            proof -
              have "\<beta> = \<l>\<^sup>-\<^sup>1[w'] \<cdot> ?\<gamma> \<cdot> \<l>[w]"
                using \<beta> iso_lunit
                by (simp add: comp_arr_dom invert_side_of_triangle(1) comp_assoc)
              also have "... = \<l>\<^sup>-\<^sup>1[w'] \<cdot> \<l>[w'] \<cdot> (src f \<star> ?\<gamma>)"
                using \<gamma> lunit_naturality
                by (metis T.uw\<theta>.w_simps(4) in_homE trg_dom)
              also have "... = (\<l>\<^sup>-\<^sup>1[w'] \<cdot> \<l>[w']) \<cdot> (src f \<star> ?\<gamma>)"
                using comp_assoc by simp
              also have "... = src f \<star> ?\<gamma>"
                using \<gamma> iso_lunit comp_inv_arr comp_cod_arr
                by (metis T.\<beta>_simps(1) calculation comp_ide_arr inv_is_inverse inverse_arrowsE w')
              finally show ?thesis by simp
            qed
            have "\<theta> = \<theta>' \<cdot> (f \<star> ?\<gamma>)"
            proof -
              have "\<theta> = trnl\<^sub>\<epsilon> u (trnl\<^sub>\<eta> w \<theta>)"
                using \<theta> adjoint_transpose_left(3) [of u w \<theta>] by simp
              also have "... = trnl\<^sub>\<epsilon> u (trnl\<^sub>\<eta> w' \<theta>' \<cdot> \<l>[w'] \<cdot> \<beta> \<cdot> \<l>\<^sup>-\<^sup>1[w])"
              proof -
                have "trnl\<^sub>\<eta> w \<theta> = trnl\<^sub>\<eta> w' \<theta>' \<cdot> \<l>[w'] \<cdot> \<beta> \<cdot> \<l>\<^sup>-\<^sup>1[w]"
                proof -
                  have "trnl\<^sub>\<eta> w \<theta> \<cdot> \<l>[w] = (T.composite_cell w \<theta> \<cdot> \<l>\<^sup>-\<^sup>1[w]) \<cdot> \<l>[w]"
                    unfolding trnl\<^sub>\<eta>_def using comp_assoc by simp
                  also have "... = T.composite_cell w \<theta> \<cdot> (\<l>\<^sup>-\<^sup>1[w] \<cdot> \<l>[w])"
                    using comp_assoc by simp
                  also have 4: "... = T.composite_cell w \<theta>"
                    using comp_arr_dom by (simp add: comp_inv_arr')
                  also have "... = T.composite_cell w' \<theta>' \<cdot> \<beta>"
                    using E by simp
                  also have "... = (T.composite_cell w' \<theta>' \<cdot> \<l>\<^sup>-\<^sup>1[w']) \<cdot> \<l>[w'] \<cdot> \<beta>"
                  proof -
                    have "(\<l>\<^sup>-\<^sup>1[w'] \<cdot> \<l>[w']) \<cdot> \<beta> = \<beta>"
                      using iso_lunit \<beta> comp_cod_arr comp_assoc comp_inv_arr' by simp
                    thus ?thesis
                      using comp_assoc by simp
                  qed
                  also have "... = trnl\<^sub>\<eta> w' \<theta>' \<cdot> \<l>[w'] \<cdot> \<beta>"
                    unfolding trnl\<^sub>\<eta>_def using comp_assoc by simp
                  finally have "trnl\<^sub>\<eta> w \<theta> \<cdot> \<l>[w] = trnl\<^sub>\<eta> w' \<theta>' \<cdot> \<l>[w'] \<cdot> \<beta>"
                    by simp
                  thus ?thesis
                    using \<beta> 4 invert_side_of_triangle(2) adjoint_transpose_left iso_lunit
                          trnl\<^sub>\<eta>_def comp_assoc
                    by metis
                qed
                thus ?thesis by simp
              qed
              also have "... = \<l>[u] \<cdot> (\<epsilon> \<star> u) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, u] \<cdot> (f \<star> trnl\<^sub>\<eta> w' \<theta>' \<cdot> \<l>[w'] \<cdot> \<beta> \<cdot> \<l>\<^sup>-\<^sup>1[w])"
                using 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> trnl\<^sub>\<eta> w' \<theta>') \<cdot> (f \<star> \<l>[w'] \<cdot> \<beta> \<cdot> \<l>\<^sup>-\<^sup>1[w])"
                using ide_left ide_right w w' 2 \<beta> \<theta> antipar trnl\<^sub>\<epsilon>_def adjoint_transpose_left
                      whisker_left
                by (metis T.uw\<theta>.\<theta>_simps(1) calculation hseqE seqE)
              also have
                "... = (\<l>[u] \<cdot> (\<epsilon> \<star> u) \<cdot> \<a>\<^sup>-\<^sup>1[f, g, u] \<cdot> (f \<star> trnl\<^sub>\<eta> w' \<theta>')) \<cdot> (f \<star> \<l>[w'] \<cdot> \<beta> \<cdot> \<l>\<^sup>-\<^sup>1[w])"
                using comp_assoc by simp
              also have "... = trnl\<^sub>\<epsilon> u (trnl\<^sub>\<eta> w' \<theta>') \<cdot> (f \<star> \<l>[w'] \<cdot> \<beta> \<cdot> \<l>\<^sup>-\<^sup>1[w])"
                unfolding trnl\<^sub>\<epsilon>_def by simp
              also have "... = \<theta>' \<cdot> (f \<star> ?\<gamma>)"
                using \<theta>' adjoint_transpose_left(3) by auto
              finally show ?thesis by simp
            qed
            hence "\<exists>\<gamma>. \<guillemotleft>\<gamma> : w \<Rightarrow> w'\<guillemotright> \<and> \<beta> = src f \<star> \<gamma> \<and> \<theta> = \<theta>' \<cdot> (f \<star> \<gamma>)"
              using \<gamma> 3 hcomp_obj_arr by blast
            moreover have "\<And>\<gamma> \<gamma>'. \<guillemotleft>\<gamma> : w \<Rightarrow> w'\<guillemotright> \<and> \<beta> = src f \<star> \<gamma> \<and> \<theta> = \<theta>' \<cdot> (f \<star> \<gamma>) \<and>
                                   \<guillemotleft>\<gamma>' : w \<Rightarrow> w'\<guillemotright> \<and> \<beta> = src f \<star> \<gamma>' \<and> \<theta> = \<theta>' \<cdot> (f \<star> \<gamma>') \<Longrightarrow> \<gamma> = \<gamma>'"
            proof -
              fix \<gamma> \<gamma>'
              assume \<gamma>\<gamma>': "\<guillemotleft>\<gamma> : w \<Rightarrow> w'\<guillemotright> \<and> \<beta> = src f \<star> \<gamma> \<and> \<theta> = \<theta>' \<cdot> (f \<star> \<gamma>) \<and>
                           \<guillemotleft>\<gamma>' : w \<Rightarrow> w'\<guillemotright> \<and> \<beta> = src f \<star> \<gamma>' \<and> \<theta> = \<theta>' \<cdot> (f \<star> \<gamma>')"
              show "\<gamma> = \<gamma>'"
                using \<gamma>\<gamma>' vconn_implies_hpar(2) L.is_faithful [of \<gamma> \<gamma>'] by force
            qed
            ultimately show ?thesis by blast
          qed
        qed
      qed
    qed

  end

  subsection "Preservation by Isomorphisms"

  text \<open>
    Next, we show that tabulations are preserved under composition on all three sides by
    isomorphisms.  This is something that we would expect to hold if ``tabulation'' is a
    properly bicategorical notion.
  \<close>

  context tabulation
  begin

    text \<open>
      Tabulations are preserved under composition of an isomorphism with the ``input leg''.
    \<close>

    lemma preserved_by_input_iso:
    assumes "\<guillemotleft>\<phi> : f \<Rightarrow> f'\<guillemotright>" and "iso \<phi>"
    shows "tabulation V H \<a> \<i> src trg r ((r \<star> \<phi>) \<cdot> \<rho>) f' g"
    proof -
      interpret T': tabulation_data V H \<a> \<i> src trg r \<open>(r \<star> \<phi>) \<cdot> \<rho>\<close> f'
        using assms(1) tab_in_hom
        apply unfold_locales
          apply auto
        by force
      show ?thesis
      proof
        show "\<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> \<cdot> \<nu> = \<omega>"
        proof -
          fix u \<omega>
          assume u: "ide u" and \<omega>: "\<guillemotleft>\<omega> : dom \<omega> \<Rightarrow> r \<star> u\<guillemotright>"
          obtain w \<theta> \<nu> where 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> composite_cell w \<theta> \<cdot> \<nu> = \<omega>"
            using u \<omega> T1 by blast
          interpret T1: uw\<theta>\<omega>\<nu> V H \<a> \<i> src trg r \<rho> f g u w \<theta> \<omega> \<nu>
            using w\<theta>\<nu> comp_assoc by (unfold_locales, auto)
          have 1: "\<guillemotleft>inv \<phi> \<star> w : f' \<star> w \<Rightarrow> f \<star> w\<guillemotright>"
            using assms by (intro hcomp_in_vhom, auto)
          have "ide w \<and> \<guillemotleft>\<theta> \<cdot> (inv \<phi> \<star> w) : 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> \<cdot> (inv \<phi> \<star> w)) \<cdot> \<nu> = \<omega>"
            using w\<theta>\<nu> 1
            apply (intro conjI)
                apply auto[4]
          proof -
            show "T'.composite_cell w (\<theta> \<cdot> (inv \<phi> \<star> w)) \<cdot> \<nu> = \<omega>"
            proof -
              have "T'.composite_cell w (\<theta> \<cdot> (inv \<phi> \<star> w)) \<cdot> \<nu> =
                    (r \<star> \<theta>) \<cdot> ((r \<star> inv \<phi> \<star> w) \<cdot> \<a>[r, f', w]) \<cdot> ((r \<star> \<phi>) \<cdot> \<rho> \<star> w) \<cdot> \<nu>"
                using assms(1) 1 whisker_left [of r \<theta> "inv \<phi> \<star> w"] comp_assoc by auto
              also have "... = (r \<star> \<theta>) \<cdot> (\<a>[r, f, w] \<cdot> ((r \<star> inv \<phi>) \<star> w)) \<cdot> ((r \<star> \<phi>) \<cdot> \<rho> \<star> w) \<cdot> \<nu>"
                using assms assoc_naturality [of r "inv \<phi>" w]
                by (metis 1 T'.tab_simps(1) base_simps(3) base_simps(4) T1.w_simps(5-6)
                    cod_inv dom_inv hseqE in_homE seqE trg_inv)
              also have "... = (r \<star> \<theta>) \<cdot> \<a>[r, f, w] \<cdot> ((((r \<star> inv \<phi>) \<star> w) \<cdot> ((r \<star> \<phi>) \<star> w)) \<cdot> (\<rho> \<star> w)) \<cdot> \<nu>"
                using whisker_right [of w "r \<star> \<phi>" \<rho>] comp_assoc T1.ide_w vseq_implies_hpar(1)
                by auto
              also have "... = composite_cell w \<theta> \<cdot> \<nu>"
              proof -
                have "(((r \<star> inv \<phi>) \<star> w) \<cdot> ((r \<star> \<phi>) \<star> w)) \<cdot> (\<rho> \<star> w) = \<rho> \<star> w"
                proof -
                  have "\<guillemotleft>r \<star> \<phi> : r \<star> f \<Rightarrow> r \<star> f'\<guillemotright>"
                    using assms(1) by (intro hcomp_in_vhom, auto)
                  moreover have "\<guillemotleft>r \<star> inv \<phi> : r \<star> f' \<Rightarrow> r \<star> f\<guillemotright>"
                    using assms by (intro hcomp_in_vhom, auto)
                  ultimately show ?thesis
                    using comp_cod_arr
                    by (metis T1.w_in_hom(2) tab_simps(1) tab_simps(5) assms(1-2) comp_inv_arr'
                              in_homE leg0_simps(2) interchange base_in_hom(2) seqI')
                qed
                thus ?thesis
                  using comp_assoc by simp
              qed
              also have "... = \<omega>"
                using w\<theta>\<nu> by simp
              finally show ?thesis by simp
            qed
          qed
          thus "\<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> \<cdot> \<nu> = \<omega>"
            by blast
        qed
        show "\<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>' \<cdot> \<beta> \<rbrakk> \<Longrightarrow>
                  \<exists>!\<gamma>. \<guillemotleft>\<gamma> : w \<Rightarrow> w'\<guillemotright> \<and> \<beta> = g \<star> \<gamma> \<and> \<theta> = \<theta>' \<cdot> (f' \<star> \<gamma>)"
        proof -
          fix u w w' \<theta> \<theta>' \<beta>
          assume w: "ide w" and w': "ide w'"
          and \<theta>: "\<guillemotleft>\<theta> : f' \<star> w \<Rightarrow> u\<guillemotright>" and \<theta>': "\<guillemotleft>\<theta>' : f' \<star> w' \<Rightarrow> u\<guillemotright>"
          and \<beta>: "\<guillemotleft>\<beta> : g \<star> w \<Rightarrow> g \<star> w'\<guillemotright>"
          and eq: "T'.composite_cell w \<theta> = T'.composite_cell w' \<theta>' \<cdot> \<beta>"
          interpret uw\<theta>w'\<theta>'\<beta> V H \<a> \<i> src trg r \<open>(r \<star> \<phi>) \<cdot> \<rho>\<close> f' g u w \<theta> w' \<theta>' \<beta>
            using w w' \<theta> \<theta>' \<beta> eq comp_assoc by (unfold_locales, auto)
          show "\<exists>!\<gamma>. \<guillemotleft>\<gamma> : w \<Rightarrow> w'\<guillemotright> \<and> \<beta> = g \<star> \<gamma> \<and> \<theta> = \<theta>' \<cdot> (f' \<star> \<gamma>)"
          proof -
            have \<phi>_w: "\<guillemotleft>\<phi> \<star> w : f \<star> w \<Rightarrow> f' \<star> w\<guillemotright>"
              using assms(1) by (intro hcomp_in_vhom, auto)
            have \<phi>_w': "\<guillemotleft>\<phi> \<star> w' : f \<star> w' \<Rightarrow> f' \<star> w'\<guillemotright>"
              using assms(1) by (intro hcomp_in_vhom, auto)
            have "\<guillemotleft>\<theta> \<cdot> (\<phi> \<star> w) : f \<star> w \<Rightarrow> u\<guillemotright>"
              using \<theta> assms(1) by fastforce
            moreover have "\<guillemotleft>\<theta>' \<cdot> (\<phi> \<star> w') : f \<star> w' \<Rightarrow> u\<guillemotright>"
              using \<theta>' assms(1) by fastforce
            moreover have "composite_cell w (\<theta> \<cdot> (\<phi> \<star> w)) = composite_cell w' (\<theta>' \<cdot> (\<phi> \<star> w')) \<cdot> \<beta>"
            proof -
              have "composite_cell w (\<theta> \<cdot> (\<phi> \<star> w)) =
                    (r \<star> \<theta>) \<cdot> ((r \<star> \<phi> \<star> w) \<cdot> \<a>[r, f, w]) \<cdot> (\<rho> \<star> w)"
                using assms(2) \<phi>_w \<theta> whisker_left comp_assoc by auto
              also have "... = (r \<star> \<theta>) \<cdot> \<a>[r, f', w] \<cdot> ((r \<star> \<phi>) \<star> w) \<cdot> (\<rho> \<star> w)"
                using assms(1) assoc_naturality [of r \<phi> w] comp_assoc
                by (metis \<phi>_w T'.tab_simps(1) base_simps(3) base_simps(4) hseq_char
                    in_homE seqE uw\<theta>.w_simps(5) uw\<theta>.w_simps(6))
              also have "... = T'.composite_cell w \<theta>"
                using assms(2) w whisker_right [of w] by simp
              also have "... = T'.composite_cell w' \<theta>' \<cdot> \<beta>"
                using eq by simp
              also have "... = (r \<star> \<theta>') \<cdot> (\<a>[r, f', w'] \<cdot> ((r \<star> \<phi>) \<star> w')) \<cdot> (\<rho> \<star> w') \<cdot> \<beta>"
                using assms(2) w' whisker_right [of w'] comp_assoc by simp
              also have "... = ((r \<star> \<theta>') \<cdot> (r \<star> \<phi> \<star> w')) \<cdot> \<a>[r, f, w'] \<cdot> (\<rho> \<star> w') \<cdot> \<beta>"
                using assms(1) assoc_naturality [of r \<phi> w'] comp_assoc
                by (metis \<phi>_w' T'.tab_simps(1) base_simps(3) base_simps(4) hseqE in_homE seqE
                    uw'\<theta>'.w_simps(5) uw'\<theta>'.w_simps(6))
              also have "... = composite_cell w' (\<theta>' \<cdot> (\<phi> \<star> w')) \<cdot> \<beta>"
                using assms(2) whisker_left [of r] \<open>\<guillemotleft>\<theta>' \<cdot> (\<phi> \<star> w') : f \<star> w' \<Rightarrow> u\<guillemotright>\<close> comp_assoc
                by auto
              finally show ?thesis by simp
            qed
            ultimately have *: "\<exists>!\<gamma>. \<guillemotleft>\<gamma> : w \<Rightarrow> w'\<guillemotright> \<and> \<beta> = g \<star> \<gamma> \<and>
                                     \<theta> \<cdot> (\<phi> \<star> w) = (\<theta>' \<cdot> (\<phi> \<star> w')) \<cdot> (f \<star> \<gamma>)"
              using w w' \<beta> T2 by auto
            show ?thesis
            proof -
              have **: "\<And>\<gamma>. \<guillemotleft>\<gamma> : w \<Rightarrow> w'\<guillemotright> \<Longrightarrow> \<theta>' \<cdot> (\<phi> \<star> w') \<cdot> (f \<star> \<gamma>) \<cdot> (inv \<phi> \<star> w) = \<theta>' \<cdot> (f' \<star> \<gamma>)"
              proof -
                fix \<gamma>
                assume \<gamma>: "\<guillemotleft>\<gamma> : w \<Rightarrow> w'\<guillemotright>"
                have "\<theta>' \<cdot> (\<phi> \<star> w') \<cdot> (f \<star> \<gamma>) \<cdot> (inv \<phi> \<star> w) = \<theta>' \<cdot> (\<phi> \<star> w') \<cdot> (f \<cdot> inv \<phi> \<star> \<gamma> \<cdot> w)"
                  using \<gamma> assms(1-2) interchange
                  by (metis arr_inv cod_inv in_homE leg0_simps(2) leg0_simps(4) uw\<theta>.w_in_hom(2)
                      seqI)
                also have "... = \<theta>' \<cdot> (\<phi> \<cdot> f \<cdot> inv \<phi> \<star> w' \<cdot> \<gamma> \<cdot> w)"
                  using assms(1-2) interchange
                  by (metis \<gamma> arr_inv cod_inv comp_arr_dom comp_cod_arr in_homE seqI)
                also have "... = \<theta>' \<cdot> (f' \<star> \<gamma>)"
                proof -
                  have "\<phi> \<cdot> f \<cdot> inv \<phi> = f'"
                    using assms(1-2) comp_cod_arr comp_arr_inv' by auto
                  moreover have "w' \<cdot> \<gamma> \<cdot> w = \<gamma>"
                    using \<gamma> comp_arr_dom comp_cod_arr by auto
                  ultimately show ?thesis by simp
                qed
                finally show "\<theta>' \<cdot> (\<phi> \<star> w') \<cdot> (f \<star> \<gamma>) \<cdot> (inv \<phi> \<star> w) = \<theta>' \<cdot> (f' \<star> \<gamma>)" by simp
              qed
              obtain \<gamma> where \<gamma>: "\<guillemotleft>\<gamma> : w \<Rightarrow> w'\<guillemotright> \<and> \<beta> = g \<star> \<gamma> \<and>
                                 \<theta> \<cdot> (\<phi> \<star> w) = (\<theta>' \<cdot> (\<phi> \<star> w')) \<cdot> (f \<star> \<gamma>)"
                using * by blast
              have "\<theta> = \<theta>' \<cdot> (\<phi> \<star> w') \<cdot> (f \<star> \<gamma>) \<cdot> (inv \<phi> \<star> w)"
              proof -
                have "seq (\<theta>' \<cdot> (\<phi> \<star> w')) (f \<star> \<gamma>)"
                  using assms(2) \<phi>_w \<phi>_w' \<gamma> \<beta> \<theta>
                  apply (intro seqI)
                          apply auto
                  by (metis seqE seqI')
                thus ?thesis
                  using assms \<phi>_w \<gamma> comp_assoc invert_side_of_triangle(2) iso_hcomp
                  by (metis hcomp_in_vhomE ide_is_iso inv_hcomp inv_ide w)
              qed
              hence "\<theta> = \<theta>' \<cdot> (f' \<star> \<gamma>)"
                using \<gamma> ** by simp
              hence "\<exists>\<gamma>. \<guillemotleft>\<gamma> : w \<Rightarrow> w'\<guillemotright> \<and> \<beta> = g \<star> \<gamma> \<and> \<theta> = \<theta>' \<cdot> (f' \<star> \<gamma>)"
                using \<gamma> by auto
              moreover have "\<And>\<gamma> \<gamma>'. \<guillemotleft>\<gamma> : w \<Rightarrow> w'\<guillemotright> \<and> \<beta> = g \<star> \<gamma> \<and> \<theta> = \<theta>' \<cdot> (f' \<star> \<gamma>) \<and>
 «γ' : w → w'¬ ∧ β = g ⋆ γ' ∧ θ = θ' ⋅ (f' ⋆ γ')
 ==> γ = γ'"
 proof -
 fix γ γ'
 assume A: "«γ : w → w'¬ ∧ β = g ⋆ γ ∧ θ = θ' ⋅ (f' ⋆ γ) ∧
 «γ' : w → w'¬ ∧ β = g ⋆ γ' ∧ θ = θ' ⋅ (f' ⋆ γ')"
 have "θ ⋅ (φ ⋆ w) = (θ' ⋅ (φ ⋆ w')) ⋅ (f ⋆ γ)"
 proof -
 have "θ = ((θ' ⋅ (φ ⋆ w')) ⋅ (f ⋆ γ)) ⋅ (inv φ ⋆ w)"
 using A ** comp_assoc by simp
 thus ?thesis
 using assms(1-2) A iso_inv_iso
 by (metis comp_arr_dom comp_cod_arr in_homE comp_assoc interchange)
 qed
 moreover have "θ ⋅ (φ ⋆ w) = (θ' ⋅ (φ ⋆ w')) ⋅ (f ⋆ γ')"
 proof -
 have "θ = ((θ' ⋅ (φ ⋆ w')) ⋅ (f ⋆ γ')) ⋅ (inv φ ⋆ w)"
 using A ** comp_assoc by auto
 thus ?thesis
 using assms(1-2) A iso_inv_iso
 by (metis comp_arr_dom comp_cod_arr in_homE comp_assoc interchange)
 qed
 ultimately show "γ = γ'"
 using A * by blast
 qed
 ultimately show "∃!γ. «γ : w → w'¬ ∧ β = g ⋆ γ ∧ θ = θ' ⋅ (f' ⋆ γ)"
 by metis
 qed
 qed
 qed
 qed
 qed

 text ‹
 Similarly, tabulations are preserved under composition of an isomorphism with
 the ``output leg''.
 ›

 lemma preserved_by_output_iso:
 assumes "«φ : g' → g¬" and "iso φ"
 shows "tabulation V H a i src trg r (ρ ⋅ φ) f g'"
 proof -
 have τφ: "«ρ ⋅ φ : g' → r ⋆ f¬"
 using assms by auto
 interpret T': tabulation_data V H a i src trg r ‹ρ ⋅ φ› f g'
 using assms(2) τφ by (unfold_locales, auto)
 have φ_in_hhom: "«φ : src f → trg r¬"
 using assms src_cod [of φ] trg_cod [of φ]
 by (elim in_homE, simp)
 show ?thesis
 proof
 fix u ψ
 assume u: "ide u" and ψ: "«ψ : dom ψ → r ⋆ u¬"
 show "∃w θ ν'. ide w ∧ «θ : f ⋆ w → u¬ ∧ «ν' : dom ψ → g' ⋆ w¬ ∧ iso ν' ∧
 T'.composite_cell w θ ⋅ ν' = ψ"
 proof -
 obtain w θ ν where wθν: "ide w ∧ «θ : f ⋆ w → u¬ ∧ «ν : dom ψ → g ⋆ w¬ ∧
 iso ν ∧ composite_cell w θ ⋅ ν = ψ"
 using u ψ T1 [of u ψ] by auto
 interpret uwθψν: uwθψν V H a i src trg r ρ f g u w θ ψ ν
 using wθν comp_assoc by (unfold_locales, auto)
 let ?ν' = "(inv φ ⋆ w) ⋅ ν"
 have ν': "«?ν' : dom ψ → g' ⋆ w¬"
 using assms φ_in_hhom uwθψν.ν_in_hom
 by (intro comp_in_homI, auto)
 moreover have "iso ?ν'"
 using assms ν' wθν φ_in_hhom
 by (intro iso_hcomp isos_compose) auto
 moreover have "T'.composite_cell w θ ⋅ ?ν' = ψ"
 proof -
 have "composite_cell w θ ⋅ ((φ ⋆ w) ⋅ ?ν') = ψ"
 proof -
 have "(φ
java.lang.StringIndexOutOfBoundsException: Index 19 out of bounds for length 0
  (metis comp_arr_inv' in_homE leg1_simps(2) uwθψν.uwθψν)
 thus ?thesis
 using wθν by simp
 qed
 moreover have "(ρ ⋅ φ ⋆ w) ⋅ ?ν' = (ρ ⋆ w) ⋅ ((φ ⋆ w) ⋅ ?ν')"
 using assms φ_in_hhom whisker_right comp_assoc by simp
 ultimately show ?thesis
 using comp_assoc by simp
 qed
 ultimately show ?thesis
 using wθν by blast
 qed
 next
 fix u w w' θ θ' β'
 assume w: "ide w" and w': "ide w'"
 and θ: "«θ : f ⋆ w → u¬" and θ': "«θ' : f ⋆ w' → u¬"
 and β': "«β' : g' ⋆ w → g' ⋆ w'¬"
 and eq': "T'.composite_cell w θ = T'.composite_cell w' θ' ⋅ β'"
 interpret uwθw'θ'β: uwθw'θ'β V H a i src trg r ‹ρ ⋅ φ› f g' u w θ w' θ' β'
 using assms w w' θ θ' β' eq' comp_assoc by (unfold_locales, auto)
 let ?β = "(φ ⋆ w') ⋅ β' ⋅ (inv φ ⋆ w)"
 have β: "«?β : g ⋆ w → g ⋆ w'¬"
 using assms φ_in_hhom β'
 by (intro comp_in_homI hcomp_in_vhom, auto)
 have eq: "composite_cell w θ = composite_cell w' θ' ⋅ ((φ ⋆ w') ⋅ β' ⋅ (inv φ ⋆ w))"
 proof -
 have "composite_cell w θ = (r ⋆ θ) ⋅ a[r, f, w] ⋅ ((ρ ⋆ w) ⋅ (φ ⋆ w)) ⋅ (inv φ ⋆ w)"
 proof -
 have "ρ ⋆ w = (ρ ⋆ w) ⋅ (φ ⋆ w) ⋅ (inv φ ⋆ w)"
 using assms w φ_in_hhom whisker_right comp_arr_dom comp_arr_inv'
 by (metis tab_simps(1) tab_simps(4) in_homE leg1_simps(2))
 thus ?thesis
 using comp_assoc by simp
 qed
 also have "... = T'.composite_cell w θ ⋅ (inv φ ⋆ w)"
 using assms φ_in_hhom whisker_right comp_assoc by simp
 also have "... = T'.composite_c w''\theta' ⋅ (inv φ ⋆
 using eq' comp_assoc by simp
 ". opost_elw θ ((φ ⋆ β' ⋅ \star w))"
  p:
  finaly ho ?hes y m
 
 show \exists!\gamma. « w'¬ β γ ∧ = θ (f ⋆ga>)"
 proof -
 obtain γ where γ: "«γ : w → w'¬ ∧ ?β = g ⋆ γ ∧ θ = θ' ⋅ (f ⋆ γ)"
 using assms w w' θ θ' β eq φ_in_hhom T2 [of w w' θ u θ' ?β] by auto
 have "β' = g' ⋆ γ"
 proof -
 have "g ⋆ γ = (φ ⋆ w') ⋅ β' ⋅ (inv φ ⋆ w)"
 using γ by simp
 hence "(inv φ ⋆ w') ⋅ (g ⋆ γ) = β' ⋅ (inv φ ⋆ w)"
 using assms w' β φ_in_hhom invert_side_of_triangle arrI iso_hcomp
 hseqE ide_is_iso inv_hcomp inv_ide seqE
 by metis
 hence "β' = (inv φ ⋆ w') ⋅ (g ⋆ γ) ⋅ (φ ⋆ w)"
 using assms w β φ_in_hhom invert_side_of_triangle comp_assoc seqE
 by (metis comp_arr_dom in_homE local.uwθw'θ'β.β_simps(4) whisker_right)
 also have "... = (inv φ ⋆ w') ⋅ (φ ⋆ γ)"
 using assms φ_in_hhom γ interchange comp_arr_dom comp_cod_arr
 by (metis in_homE)
 also have "... = g' ⋆ γ"
 using assms φ_in_hhom γ interchange comp_inv_arr inv_is_inverse comp_cod_arr
 by (metis arr_dom calculation in_homE)
 finally show ?thesis by simp
 qed
 hence "∃γ. «γ : w → w'¬ ∧ β' = g' ⋆ γ ∧ θ = θ' ⋅ (f ⋆ γ)"
 using β γ by auto
 moreover have "∧ :\open>'::lewr\close
 «
 proof -
 have *: "∧ips
  -
 fix γ
 assume γ: "«γ : w → w'¬"
 have "(φ ⋆ w') ⋅ (g' ⋆ γ) ⋅ (inv φ ⋆ w) = (φ ⋆ w') ⋅ (inv φ ⋆ γ)"
 using assms φ_in_hhom γ interchange comp_arr_dom comp_cod_arr
 by (metis arr_dom comp_inv_arr' in_homE invert_side_of_triangle(2))
 also have "... = g ⋆ γ"
 using assms φ_in_hhom interchange comp_arr_inv inv_is_inverse comp_cod_arr
 by (metis γ comp_arr_inv' in_homE leg1_simps(2))
 finally show "(φ ⋆ w') ⋅ (g' ⋆ γ) ⋅ (inv φ ⋆ w) = g ⋆ γ" by blast
 qed
 fix γ γ'
 assume γ: "«γ : w → w'¬ ∧ β' = g' ⋆ γ ∧ θ = θ' ⋅ (f ⋆ γ)"
 and γ': "«γ' : w → w'¬ ∧ β' = g' ⋆ γ' ∧ θ = θ' ⋅ (f ⋆ γ')"
 show "γ = γ'"
 using w w' θ θ' β γ γ' eq * T2 by metis
 qed
 ultimately show "∃oreds:u_cs_n)
java.lang.StringIndexOutOfBoundsException: Range [11, 12) out of bounds for length 11
 qed  " * 2 y 2^ (m + n)" using ux uy nv mnv xv' *
 

java.lang.StringIndexOutOfBoundsException: Range [10, 8) out of bounds for length 16
 Finally, tabulations
 from usszv obtain q where qv: "sz = us + q"

  unat_lt2pn_lp[f]
 assumes "«: r\Rightarr> r'¬" and "iso φ"
 shows "tabulation V H a i src trg r' ((φ ⋆ f) ⋅ ρ) f g"
 proof -
 have φf: "«φ ⋆ f : r ⋆ f → r' ⋆ f¬"
 using assms ide_leg0 by auto
 interpret T: tabulation_data V H a i src trg r' ‹(φ ⋆ f) ⋅ ρ› f
 proof
 show ide_r': "ide r'" using assms by auto
 show "ide f" using ide_leg0 by auto
 show "«(φ ⋆ f) ⋅ ρ : g → r' ⋆ f¬"
 using tab_in_hom φf by force
 qed
 show ?thesis
 proof
 have *: "∧u v w θ ν. [ ide u; ide v; ide w; «θ : f ⋆ w → u¬; «ν : v → g ⋆ w¬ ] ==>
 ((φ ⋆ u) ⋅ (r ⋆ θ)) ⋅ a[r, f, w] ⋅ (ρ ⋆ w) ⋅ ν =
 T.composite_cell w θ ⋅ ν"
 proof -
 fix u v w θ ν
 assume u: "ide u" and v: "ide v" and w: "ide w"
 and θ: "«θ : f ⋆ w → u¬" and ν: "«ν : v → g ⋆ w¬"
 have fw: "hseq f w"
 using θ ide_dom [of θ] by fastforce
 have rθ: "hseq r θ"
 using θ ide_base ide_dom [of θ] trg_dom [of θ]
 using arrI fw vconn_implies_hpar(2) by auto
 have "((φ ⋆ u) ⋅ (r ⋆ θ)) ⋅ a[r, f, w] ⋅ (ρ ⋆ w) ⋅ ν =
 ((r' ⋆ θ) ⋅ (φ ⋆ f ⋆ w)) ⋅ a[r, f, w] ⋅ (ρ ⋆ w) ⋅ ν"
 using assms u w ide_base ide_leg0 θ interchange comp_arr_dom comp_cod_arr
 by (metis rθ hseq_char in_homE)
 also have "... = (r' \star θ ((φ ⋆ w) ⋅[r, f, w]) ⋅sta> w) ⋅
 using comp_assoc by si
java.lang.StringIndexOutOfBoundsException: Range [20, 19) out of bounds for length 154
 proof -
java.lang.StringIndexOutOfBoundsException: Range [26, 24) out of bounds for length 125
 using assms ide_leg0 w assoc_naturality [of φfoc
 thus tsiss
 gcm_so ysip
 qed
 also have". .opst_cl <  ν"
 using assms ide_leg0 whisker_right fw T.tab_in_hom arrI w cmpasscb uo
 finally show "((φ> u) ⋅ (r < <heta)u} = {m + 1..u}› if ‹m ≠ - 1› for m :: ‹'a::len word›
            by simp
        qed
        show "∧u ψ'. [ ide u; «ψ' : dom ψ' → r' ⋆ u¬ ] ==>
                 ∃w θ ν. ide w ∧ «θ : f ⋆ w → u¬ ∧ «ν : dom ψ' → g ⋆ w¬ ∧ iso ν ∧
                         T.composite_cell w θ ⋅ ν = ψ'"
        proof -
          fix u v ψ'
          assume u: "ide u" and ψ': "«ψ' : v → r' ⋆ u¬"
          have ψ: "«(inv φ ⋆ u) ⋅ ψ' : v → r ⋆ u¬"
          proof
            show "«ψ' : v → r' ⋆ u¬" by fact
            show "«inv φ ⋆ u : r' ⋆ u → r ⋆ u¬"
            proof -
              have "ide (r' ⋆ u)"
                using ψ' ide_cod by fastforce
              hence "hseq r' u" by simp
              thus ?hesis
                using assms u by
            qed
          qed
          phiu: "hp> u"
            java.lang.StringIndexOutOfBoundsException: Range [50, 19) out of bounds for length 50
            by1_iff_lt_ der_not_lesser_zero_iff
                src_invjava.lang.StringIndexOutOfBoundsException: Index 26 out of bounds for length 26
          obtain w θ: "ide w ∧ : f ⋆ ∧ν g ⋆ ∧
                                   composite_cell w θlem int_e:
            using u ψ sint (of_nat a :: 'a :: len word) ≤

          interpret uwθψ V H a src trg r ρ ‹ u) ⋅'›
            using wθ 🚫^ n div 2 ^ m. w = word_of_nat k"

          have "ide w ∧ «θ : f ⋆ w → u¬ ∧ «ν : v → g ⋆ w¬ ∧ iso ν ∧
                T.composite_cell w θ ⋅ ν = ψ'"
          proof -
            have "ψ' = ((φ ⋆ u) ⋅ (r ⋆ θ)) ⋅ a[r, f, w] ⋅ (ρ ⋆ w) ⋅ ν"
            proof -
              have "seq (r ⋆ θ) (a[r, f, w] ⋅ (ρ ⋆ w) ⋅ ν)" by fastforce
              moreover have "iso (inv φ ⋆ u)"
                using assms u φu by auto
              moreover have "inv (inv φ ⋆ u) = φ ⋆ u"
                using assms u φu by auto
              ultimately show ?thesis
                using invert_side_of_triangle(1) wθν comp_assoc by metis
            qed
            also have "... = T.composite_cell w θ ⋅ ν"
              using u wθν * [of u v w θ ν] by force
            finally have "ψ' = T.composite_cell w θ ⋅ ν" by simp
            thus ?thesis
              usingifk<2 
       
          java.lang.StringIndexOutOfBoundsException: Range [5, 3) out of bounds for length 39
                        T.composite_cell w θ
            byast
        qed
        showu w w' θ ide w; ide w'; «   s>w → u¬; «θ' : f ⋆ w' → u¬;
                                 «β : g ⋆ w → g ⋆ w'¬; 
                                 T.composite_cell w θ = T.composite_cell w' θ' ⋅ β ] ==>
                 ∃!γ. «γ : w → w'¬ ∧ β = g ⋆ γ ∧ θ = θ' ⋅ (f ⋆ γ)"
        proof -
          fix u w w' θ θ' β
          assume w: "ide w" and w': "ide w'"
          and θ: "«θ : f ⋆ w → u¬" and θ': "«θ' : f ⋆ w' → u¬"
          and β: "«β : g ⋆ w → g ⋆ w'¬"
          and eq': "T.composite_cell w θ = T.composite_cell w' θ' ⋅ β"
          interpret T: uwθw'θ'β V H a i src trg r' ‹(φ ⋆ f) ⋅ ρ› f g u w θ w' θ' β
            using w w' θ θ' β eq' comp_assoc
            by (em word_range'
          have eq: "composite_cell w θ = composite_cell w' θ' ⋅ β"
          proof -
            have "(φ ⋆ u) ⋅ composite_cell w θ = (φ ⋆ u) ⋅ composite_cell w' θ' ⋅ β"
            proof -
              have "(φ ⋆ u) ⋅ composite_cell w θ =
                    ((φ ⋆ u) ⋅ (r ⋆ θ)) ⋅ a[r, f, w] ⋅ (ρ ⋆ w) ⋅ (g ⋆ w)"
              proof -
                have "«ρ ⋆ w : g ⋆ w → (r ⋆ f) ⋆ w¬"
                  using w by auto
                thus ?thesis
                  using comp_arr_dom comp_assoc by auto
              qed
              also have "... = T.composite_cell w θ ⋅ (g ⋆ w)"
                using * [of u "g ⋆ w" w θ "g ⋆ w"] by fastforce
              also have "... = T.composite_cell w θ"
              proof -
                have "«(φ ⋆ f) ⋅ ρ ⋆ w : g ⋆ w → (r' ⋆ f) ⋆ w¬"

                thus ?thesis
                  using com_ardmcm_sscb uo
              qed
              also have "... = java.lang.StringIndexOutOfBoundsException: Range [9, 7) out of bounds for length 27
                using java.lang.StringIndexOutOfBoundsException: Range [34, 33) out of bounds for length 34
              also have "... = ((φ u) ⋅ <>')) \cdot \a[r, f, w'] ⋅ (ρ ⋆ w') ⋅ β"
                using * [of u "g ⋆ w" w' θ' β] by fastforce
              finally show ?thesis
                using comp_assoc by simp
            qed
            moreover have "iso (φ ⋆ u)"
              using assms by auto
            moreover have "seq (φ ⋆ u) ((r ⋆ θ) ⋅ a[r, f, w] ⋅ (ρ ⋆ w))"
            proof -
              have "«φ ⋆ u : r ⋆ u → r' ⋆ u¬"
                using assms by (intro hcomp_in_vhom, auto)
              thus ?thesis
                using composite_cell_in_hom [of w u θ] by auto
            qed
            moreover have "seq (φ ⋆ u) (composite_cell w' θ' ⋅ β)"
              using assmsby(addt_of_nat_lenlnat_alt 
            ultimately show ?thesis
              using mono_cancel section_is_mono iso_is_sectionusing1_eq_on_maskaskk ast
          qed
          show "∃
            w w' θ θ' β eq T2 by simp
        qed
      qed
    qed

  end

  subsection "Canonical Tabulations"

  text ‹
    If the 1-cell ‹g ⋆ f^*› has any tabulation ‹(f, ρ, g)›, then it has the canonical
    tabulation obtained as the adjoint transpose of (the identity on) ‹g ⋆ f^*›.
  ›

  context map_in_bicategory
  begin

    lemma canonical_tabulation:
    assumes "ide g" and "src f = src g"
    and "∃ρ. tabulation V H a i src trg (g ⋆ f^*) ρ f g"
    shows "tabulation V H a i src trg (g ⋆ f^*) (trnr_\η g (g ⋆ f^*)) f g"
    proof -
      have 1: "ide (g ⋆ f^*)"
        using assms(1-2) ide_right antipar by simp
      obtain ρ where ρ: "tabulation V H a i src trg (g ⋆ f^*) ρ f g"
        using assms(3) by auto
      interpret \<shows 
       🚫
      let ?ψ take_bit_wo [of n p] by auto
      have 3: <guillemotleft>??\psi>: g ⋆ f^* → g ⋆ f^*¬ ∧ iso ?ψ"
        using ρ.yields_isomorphic_representation by blast
      hence "tabulation (⋅) (⋆) a i src trg (g ⋆ f^*) ((inv ?ψ ⋆ f) ⋅ ρ) f g"
        using ρ.is_preserved_by_base_iso [of "inv ?ψ" "g ⋆ f^*"] by simp
      moreover have "(inv ?ψ ⋆ f) ⋅ ρ = trnr_\<eta> g (g ⋆ f^*)"
      proof -
        have "(inv ?ψ ⋆ f) ⋅ ρ = ((inv ?ψ ⋆ f) ⋅ (?ψ ⋆ f)) ⋅ trnr_\<eta> g (g ⋆ f^*)"
          using ρ.ρ_in_terms_of_rep comp_assoc by simp
        also have "... = ((g ⋆ f^*) ⋆ f) ⋅ trnr_\<eta> g (g ⋆ f^*)"
        proof -
          have "src (inv ?ψf""
            using 3 antipar
            by (metis ρ.lle test_:
          hence "(inv ?ψby n "(a si: test word_ops_nth_size word_size)
            using 3 whisker_right [of f "inv ?ψ" ?ψ
          thus ?thesis
            using comp_cod_arr by simp
        qed
        also have "... = trnr java.lang.StringIndexOutOfBoundsException: Range [51, 50) out of bounds for length 51
        proof -
          have "
          moreover have"java.lang.StringIndexOutOfBoundsException: Range [29, 28) out of bounds for length 39
          ultimately have "\div_les:
            using 1 adjoint_transpose_right(1) ide_in_hom antipar by blast
          thus ?thesis
            using comp_cod_arr by blast
        qed
        finally show ?thesis by simp
java.lang.StringIndexOutOfBoundsException: Range [9, 10) out of bounds for length 9
      ultimately show ?thesis by simp
    qed

java.lang.StringIndexOutOfBoundsException: Range [5, 6) out of bounds for length 5

  subsection "Uniqueness of Tabulations"mpad oresz_e agtsz_e i_odeIbtsms

  text ‹)an
    We now intend to shwta auaino <o>r<clo> i``uiu pt qiaec',
    which is a property that any proper bicategorical limit should have.
    What do w
java.lang.StringIndexOutOfBoundsException: Range [43, 37) out of bounds for length 137
    induces ‹>(x AND NOT (mask n)) AND NOT (mask m) = x AND NOT (mask m)"
    ‹'a::len word›
    from ‹(qed
    ‹«
    This means that we obtain isomorphisms ‹(ν' \<star  ν g' ⋆ w¬ and
    ‹
    These isomorphisms then induce, via ‹
    and from ‹
    equivalence maps.
  \c

  context tabulation
  begin

    text ‹
      We will need the following technical lemma.
    ›

    lemma apex_equivalence_lemma:
    assumes " «ρ' : g' → r ⋆ f'¬"
 and "ide w ∧ «θ : f' ⋆ w → f¬ ∧ «ν : g → g' ⋆ w¬ ∧ iso ν ∧
 (r ⋆ θ) ⋅ a[r, f', w] ⋅ (ρ' ⋆ w) ⋅ ν = ρ"
 and "ide w' ∧ «θ' : f ⋆ w' → f'¬ ∧ «ν' : g' → g ⋆ w'¬ ∧ iso ν' ∧
 (r ⋆ θ') ⋅ a[r, f, w'] ⋅ (ρ ⋆ w') ⋅ ν' = ρ'"
 shows "∃φ. «φ : src f → w' ⋆ w¬ ∧ iso φ"
 proof -
  θρ'
 using assms(1,3) apply unfold_locales by auto
 interpret T:
 using assms(1,2) apply unfold_locales by auto
  upper_bits_unset_is_l2p [wwhe p=p]
 using assms(1,2) apply unfold_locales by auto

      (* These next simps are very important. *)
      have_le
        using assms(2) by auto
      have dom_ν' [simp]: "dom ν
        using assms(3) by auto

      let ?\<nu>'\<nu> = "\<a>[dom \<rho>, w', w] \<cdot> (\<nu>' \<star> w) \<cdot> \<nu>"
      have\<>\n> \guillemotleft?<u'<u  \rho \R  <ho <tar> w' <tarw<uillemotright>
        by fastforce
      have "\<guillemotleft>\<nu> : src \<rho> \<rightarrow> trg r\<guillemotright>" by simp
       \theta><  "<heta>\<dot>(<heta' <tar>w) <dot> \<><s>\^up[, w,w]java.lang.StringIndexOutOfBoundsException: Index 110 out of bounds for length 110
      have \<lemma[] " <unat(  : a:en)java.lang.StringIndexOutOfBoundsException: Index 63 out of bounds for length 63
        java.lang.StringIndexOutOfBoundsException: Range [11, 10) out of bounds for length 20
      have iso_\<nu>'\<nu>_r: "iso (?\<nu>'\<nu> \<cdot> \<r>[g])"
        using iso_runit \<nu>'\<nu>
        apply (intro isos_compose) by auto

      have eq: "composite_cell (src f) \<r>[f] =   if"ENGTH')+ LENGTH LENGTH('"
      proof -
        have "composite_cell (w' \<star> w) ?\<theta>\<theta>' \<cdot> (?\<nu>'\<nu> \<cdot> \<r>[g]) =
              ((r \<star> \<theta>) \<cdot> (r \<star> \<theta>' \<star> w) \<cdot> (r \<star> \<a>\<^sup>-\<^sup>1[java.lang.StringIndexOutOfBoundsException: Range [2, 117) out of bounds for length 47
                \<a>[r, f, w' \<star> w] \<cdot> ((\<rho> \<by (not_less p2_gt_0power_0power_0
          using whisker_left comp_assoc by simp
        > \t) \< (r<tar\theta>'\ w)\c>( <tar <>^up-<s>f w' ]) <dot
                           \<a>[r, f, w' \<star> w] \<cdot> (\<word_of_int (<ambda  l concat_bitn k)w(ize  uint )"
                           ((\<rho> \<star> w') \<star> w)) \<cdot> (\<nu>' \<star> w) \<cdot> \<nu> \<cdot> \<r>[g]"
          using assoc_naturality [of \<rho> w' w] by simp
        ".  (\star> \ \>r \s <> \<tar>w \cdot>
                           ((<tar> \a\^sup>\<sup1 ' w) \cdot> \a>r,f, '< w]r \ f w',w]) \<cdot>
                           ((\<>\star> ' <tar>w) \cdot> (\n> \s>w \c>\nu\cdot><>g"
          using comp_assoc by simp
        also have "... = (r \<star> \<theta>) \<cdot>proof -
(<>r  w]\star  <dot
                           ((\<rho> \<star> w') \<star> w) \<cdot> (\<nu>' \<star> w) \<cdot>show ? Q?
         -
          have "seq \<a>[r, f, w' \<star> w] \<a>[r \<star> f, w', w]" by simp
eover"(r\<>\<> w, ] =\<java.lang.StringIndexOutOfBoundsException: Range [68, 66) out of bounds for length 99
            by simp
          moreover have "(r \<star> \<a>[f, w', w]) \<cdot> \<a>[r, f \<star> w', w] \<cdot> (\<a>[r, f, w'] \<  includes bit_operations_syntax
                \<a>[r, f, w' \<star> w] \<cdot> \<a>[r \<star> f, w', w]"
            using pentagon by simp
          ultimately have "(r \<star> \<a>\<^sup>-\<^sup>1
                           \<a>[r, f \<star> w', w] \<cdot> (\<a>[r, f, w'] \<star> w)"
            using iso_assoc [of f w' w] iso_hcomp
                  invert_side_of_triangle(1)
                    [of "\<a>[r, f, w' \<star> w] \<cdot> \<a>[r \<star> f, w', w]" "r \<star> \<a>[f, w', w]"
                        "\<a>[r, f \<star> w', w] \<cdot> (\<a>[r, f, w'] \<star> w)"]
            by simp
          thus ?thesis
            using comp_assoc by simp
        qed
        also have "... = (r \<star> \<theta>) \<cdot> \<a>[r, f', w] \<cdot>
                           (((r \<star> \<theta>') \<star> w) \<cdot> (\<a>[r, f, w'] \<star> w) \<cdot> ((\<rho> \<star> w') \<star> w)) \<cdot>
                           (\<nu>' \<star> w) \<cdot> \<nu> \<cdot> \<r>[g]"
        proof -
          have "(r \<star> \<theta>' \<star> w) \<cdot> \<a>[r, f \<star> w', w] = \<a>[r, f', w] \<cdot> ((r \<star> \<theta>') \<star> w)"
            using assoc_naturality [of r \<theta>' w] by simp
          thus ?thesis
            using comp_assoc by simp
        qed
        also have "... = (r \<star> \<theta>) \<cdot> \<a>[r, f', w] \<cdot> (composite_cell w' \<theta>' \<star> w) \<cdot> (\<nu>' \<star> w) \<cdot> \<nu> \<cdot> \<r>[g]"
          using whisker_right
          by (metis T'.uw\<theta>\<omega> T'.w_in_hom(1) composite_cell_in_hom T'.\<theta>_simps(2) T'.ide_w
              T.ide_w arrI seqE)
        also have "... = (r \<star> \<theta>) \<cdot> \<a>[r, f', w] \<cdot> ((\<rho>' \<cdot> inv \<nu>' \<star> w) \<cdot> (\<nu>' \<star> w)) \<cdot> \<nu> \<cdot> \<r>[g]"
        proof -
          have "composite_cell w' \<theta>' = \<rho>' \<cdot> inv \<nu>'"
            using assms invert_side_of_triangle(2) T.tab_simps(1) comp_assoc by presburger
          thus ?thesis
            using comp_assoc by simp
        qed
        also have "... = (T.composite_cell w \<theta> \<cdot> \<nu>) \<cdot> \<r>[g]"
          using whisker_right [of w "\<rho>' \<cdot> inv \<nu>'" \<nu>'] dom_\<nu>' comp_assoc comp_inv_arr'
                comp_arr_dom
          by simp
        also have "... = \<rho> \<cdot> \<r>[g]"
          using assms(2) comp_assoc by simp
        also have "... = composite_cell (src f) \<r>[f]"
          using comp_assoc runit_hcomp runit_naturality [of \<rho>] by simp
        finally show ?thesis by simp
      qed
      have eq': "(r \<star> \<r>[f]) \<cdot> \<a>[r, f, src f] \<cdot> (\<rho> \<star> src f) \<cdot> (inv (?\<nu>'\<nu> \<cdot> \<r>[g])) =
                 composite_cell (w' \<star> w) ?\<theta>\<theta>'"
      proof -
        have 1: "composite_cell (src f) \<r>[f] = (composite_cell (w' \<star> w) ?\<theta>\<theta>') \<cdot> ?\<nu>'\<nu> \<cdot> \<r>[g]"
          using eq comp_assoc by simp
        have "composite_cell (src f) \<r>[f] \<cdot> (inv (?\<nu>'\<nu> \<cdot> \<r>[g])) = composite_cell (w' \<star> w) ?\<theta>\<theta>'"
        proof -
          have "seq (r \<star> \<r>[f]) (\<a>[r, f, src f] \<cdot> (\<rho> \<star> src f))"
            by fastforce
          thus ?thesis
            using iso_\<nu>'\<nu>_r 1 invert_side_of_triangle(2) by simp
        qed
        thus ?thesis
          using comp_assoc by simp
      qed

      have \<nu>'\<nu>_r: "\<guillemotleft>?\<nu>'\<nu> \<cdot> \<r>[g] : g \<star> src f \<Rightarrow> g \<star> w' \<star> w\<guillemotright>"
          by force
      have inv_\<nu>'\<nu>_r: "\<guillemotleft>inv (?\<nu>'\<nu> \<cdot> \<r>[g]) : g \<star> w' \<star> w \<Rightarrow> g \<star> src f\<guillemotright>"
        using \<nu>'\<nu> iso_\<nu>'\<nu>_r by auto

      let ?P = "\<lambda>\<gamma>. \<guillemotleft>\<gamma> : src f \<Rightarrow> w' \<star> w\<guillemotright> \<and> ?\<nu>'\<nu> \<cdot> \<r>[g] = dom \<rho> \<star> \<gamma> \<and> \<r>[f] = ?\<theta>\<theta>' \<cdot> (f \<star> \<gamma>)"
      let ?\<gamma> = "THE \<gamma>. ?P \<gamma>"
      have "?P ?\<gamma>"
      proof -
        have "\<exists>!\<gamma>. ?P \<gamma>"
          using \<nu>'\<nu>_r \<theta>\<theta>' eq T2 [of "src f" "w' \<star> w" "\<r>[f]" f ?\<theta>\<theta>' "?\<nu>'\<nu> \<cdot> \<r>[g]"] by simp
        thus ?thesis
          using the1_equality [of ?P] by blast
      qed
      hence \<gamma>: "\<guillemotleft>?\<gamma> : src f \<rightarrow> src f\<guillemotright> \<and> ?P ?\<gamma>"
        using vconn_implies_hpar(1-2) by auto

      let ?P' = "\<lambda>\<gamma>. \<guillemotleft>\<gamma> : w' \<star> w \<Rightarrow> src f\<guillemotright> \<and> inv (?\<nu>'\<nu> \<cdot> \<r>[g]) = g \<star> \<gamma> \<and> ?\<theta>\<theta>' = \<r>[f] \<cdot> (f \<star> \<gamma>)"
      let ?\<gamma>' = "THE \<gamma>. ?P' \<gamma>"
      have "?P' ?\<gamma>'"
      proof -
        have "\<exists>!\<gamma>. ?P' \<gamma>"
          using inv_\<nu>'\<nu>_r \<theta>\<theta>' eq'
                T2 [of "w' \<star> w" "src f" "\<theta> \<cdot> (\<theta>' \<star> w) \<cdot> \<a>\<^sup>-\<^sup>1[f, w', w]" f] comp_assoc
          by simp
        thus ?thesis
          using the1_equality [of ?P'] by blast
      qed
      hence \<gamma>': "\<guillemotleft>?\<gamma>' : src f \<rightarrow> src f\<guillemotright> \<and> ?P' ?\<gamma>'"
        using vconn_implies_hpar(1-2) by auto

      have "inverse_arrows ?\<gamma> ?\<gamma>'"
      proof
        let ?Q = "\<lambda>\<gamma>. \<guillemotleft>\<gamma> : src f \<Rightarrow> src f\<guillemotright> \<and> dom \<rho> \<star> src f = g \<star> \<gamma> \<and> \<r>[f] = \<r>[f] \<cdot> (f \<star> \<gamma>)"
        have "\<exists>!\<gamma>. ?Q \<gamma>"
        proof -
          have "ide (src f)" by simp
          moreover have "\<guillemotleft>\<r>[f] : f \<star> src f \<Rightarrow> f\<guillemotright>" by simp
          moreover have "\<guillemotleft>dom \<rho> \<star> src f : g \<star> src f \<Rightarrow> g \<star> src f\<guillemotright>" by auto
          moreover have "(\<rho> \<star> src f) \<cdot> (dom \<rho> \<star> src f) = \<rho> \<star> src f"
          proof -
            have "(\<rho> \<star> src \<rho>) \<cdot> (dom \<rho> \<star> src (dom \<rho>)) = \<rho> \<star> src \<rho>"
              using R.as_nat_trans.naturality1 arr_dom tab_simps(1) by presburger
            thus ?thesis
              by simp
          qed
          ultimately show ?thesis
            using comp_arr_dom T2 [of "src f" "src f" "\<r>[f]" f "\<r>[f]" "dom \<rho> \<star> src f"]
                  comp_assoc
            by metis
        qed
        moreover have "?Q (src f)"
          using comp_arr_dom by auto
        moreover have "?Q (?\<gamma>' \<cdot> ?\<gamma>)"
        proof (intro conjI)
          show "\<guillemotleft>?\<gamma>' \<cdot> ?\<gamma> : src f \<Rightarrow> src f\<guillemotright>"
            using \<gamma> \<gamma>' by auto
          show "dom \<rho> \<star> src f = g \<star> ?\<gamma>' \<cdot> ?\<gamma>"
          proof -
            have "g \<star> ?\<gamma>' \<cdot> ?\<gamma> = (g \<star> ?\<gamma>') \<cdot> (g \<star> ?\<gamma>)"
              using \<gamma> \<gamma>' whisker_left by fastforce
            also have "... = inv (?\<nu>'\<nu> \<cdot> \<r>[g]) \<cdot> (?\<nu>'\<nu> \<cdot> \<r>[g])"
              using \<gamma> \<gamma>' by simp
            also have "... = dom \<rho> \<star> src f"
              using \<nu>'\<nu> iso_\<nu>'\<nu>_r comp_inv_arr inv_is_inverse by auto
            finally show ?thesis by simp
          qed
          show "\<r>[f] = \<r>[f] \<cdot> (f \<star> ?\<gamma>' \<cdot> ?\<gamma>)"
          proof -
            have "\<r>[f] \<cdot> (f \<star> ?\<gamma>' \<cdot> ?\<gamma>) = \<r>[f] \<cdot> (f \<star> ?\<gamma>') \<cdot> (f \<star> ?\<gamma>)"
              using \<gamma> \<gamma>' whisker_left by fastforce
            also have "... = (\<r>[f] \<cdot> (f \<star> ?\<gamma>')) \<cdot> (f \<star> ?\<gamma>)"
              using comp_assoc by simp
            also have "... = \<r>[f]"
              using \<gamma> \<gamma>' by simp
            finally show ?thesis by simp
          qed
        qed
        ultimately have "?\<gamma>' \<cdot> ?\<gamma> = src f" by blast
        thus "ide (?\<gamma>' \<cdot> ?\<gamma>)" by simp

        let ?Q' = "\<lambda>\<gamma>. \<guillemotleft>\<gamma> : w' \<star> w \<Rightarrow> w' \<star> w\<guillemotright> \<and> g \<star> w' \<star> w = g \<star> \<gamma> \<and> ?\<theta>\<theta>' = ?\<theta>\<theta>' \<cdot> (f \<star> \<gamma>)"
        have "\<exists>!\<gamma>. ?Q' \<gamma>"
        proof -
          have "ide (w' \<star> w)" by simp
          moreover have "\<guillemotleft>?\<theta>\<theta>' : f \<star> w' \<star> w \<Rightarrow> f\<guillemotright>"
            using \<theta>\<theta>' by simp
          moreover have "\<guillemotleft>g \<star> w' \<star> w : g \<star> w' \<star> w \<Rightarrow> g \<star> w' \<star> w\<guillemotright>"
            by auto
          moreover have
            "composite_cell (w' \<star> w) ?\<theta>\<theta>' = composite_cell (w' \<star> w) ?\<theta>\<theta>' \<cdot> (g \<star> w' \<star> w)"
          proof -
            have "\<guillemotleft>\<rho> \<star> w' \<star> w : g \<star> w' \<star> w \<Rightarrow> (r \<star> f) \<star> w' \<star> w\<guillemotright>"
              by (intro hcomp_in_vhom, auto)
            hence "(\<rho> \<star> w' \<star> w) \<cdot> (g \<star> w' \<star> w) = \<rho> \<star> w' \<star> w"
              using comp_arr_dom by auto
            thus ?thesis
              using comp_assoc by simp
          qed
          ultimately show ?thesis
            using T2 by presburger
        qed
        moreover have "?Q' (w' \<star> w)"
          using \<theta>\<theta>' comp_arr_dom by auto
        moreover have "?Q' (?\<gamma> \<cdot> ?\<gamma>')"
        proof (intro conjI)
          show "\<guillemotleft>?\<gamma> \<cdot> ?\<gamma>' : w' \<star> w \<Rightarrow> w' \<star> w\<guillemotright>"
            using \<gamma> \<gamma>' by auto
          show "g \<star> w' \<star> w = g \<star> ?\<gamma> \<cdot> ?\<gamma>'"
          proof -
            have "g \<star> ?\<gamma> \<cdot> ?\<gamma>' = (g \<star> ?\<gamma>) \<cdot> (g \<star> ?\<gamma>')"
              using \<gamma> \<gamma>' whisker_left by fastforce
            also have "... = (?\<nu>'\<nu> \<cdot> \<r>[g]) \<cdot> inv (?\<nu>'\<nu> \<cdot> \<r>[g])"
              using \<gamma> \<gamma>' by simp
            also have "... = g \<star> w' \<star> w"
              using \<nu>'\<nu> iso_\<nu>'\<nu>_r comp_arr_inv inv_is_inverse by auto
            finally show ?thesis by simp
          qed
          show "?\<theta>\<theta>' = ?\<theta>\<theta>' \<cdot> (f \<star> ?\<gamma> \<cdot> ?\<gamma>')"
          proof -
            have "?\<theta>\<theta>' \<cdot> (f \<star> ?\<gamma> \<cdot> ?\<gamma>') = ?\<theta>\<theta>' \<cdot> (f \<star> ?\<gamma>) \<cdot> (f \<star> ?\<gamma>')"
              using \<gamma> \<gamma>' whisker_left by fastforce
            also have "... = (?\<theta>\<theta>' \<cdot> (f \<star> ?\<gamma>)) \<cdot> (f \<star> ?\<gamma>')"
              using comp_assoc by simp
            also have "... = ?\<theta>\<theta>'"
              using \<gamma> \<gamma>' by simp
            finally show ?thesis by simp
          qed
        qed
        ultimately have "?\<gamma> \<cdot> ?\<gamma>' = w' \<star> w" by blast
        thus "ide (?\<gamma> \<cdot> ?\<gamma>')" by simp
      qed
      hence "\<guillemotleft>?\<gamma> : src f \<Rightarrow> w' \<star> w\<guillemotright> \<and> iso ?\<gamma>"
        using \<gamma> by auto
      thus ?thesis by auto
    qed

    text \<open>
      Now we can show that, given two tabulations of the same 1-cell,
      there is an equivalence map between the apexes that extends to a transformation
      of one tabulation into the other.
    \<close>

    lemma apex_unique_up_to_equivalence:
    assumes "tabulation V H \<a> \<i> src trg r \<rho>' f' g'"
    shows "\<exists>w w' \<phi> \<psi> \<theta> \<nu> \<theta>' \<nu>'.
             equivalence_in_bicategory V H \<a> \<i> src trg w' w \<psi> \<phi> \<and>
             \<guillemotleft>w : src f \<rightarrow> src f'\<guillemotright> \<and> \<guillemotleft>w' : src f' \<rightarrow> src f\<guillemotright> \<and>
             \<guillemotleft>\<theta> : f' \<star> w \<Rightarrow> f\<guillemotright> \<and> \<guillemotleft>\<nu> : g \<Rightarrow> g' \<star> w\<guillemotright> \<and> iso \<nu> \<and>
             \<rho> = (r \<star> \<theta>) \<cdot> \<a>[r, f', w] \<cdot> (\<rho>' \<star> w) \<cdot> \<nu> \<and>
             \<guillemotleft>\<theta>' : f \<star> w' \<Rightarrow> f'\<guillemotright> \<and> \<guillemotleft>\<nu>' : g' \<Rightarrow> g \<star> w'\<guillemotright> \<and> iso \<nu>' \<and>
             \<rho>' = (r \<star> \<theta>') \<cdot> \<a>[r, f, w'] \<cdot> (\<rho> \<star> w') \<cdot> \<nu>'"
    proof -
      interpret T': tabulation V H \<a> \<i> src trg r \<rho>' f' g'
        using assms by auto
      obtain w \<theta> \<nu>
      where w\<theta>\<nu>: "ide w \<and> \<guillemotleft>\<theta> : f' \<star> w \<Rightarrow> f\<guillemotright> \<and> \<guillemotleft>\<nu> : g \<Rightarrow> g' \<star> w\<guillemotright> \<and> iso \<nu> \<and>
                  \<rho> = T'.composite_cell w \<theta> \<cdot> \<nu>"
        using T'.T1 [of f \<rho>] ide_leg0 tab_in_hom by auto
      obtain w' \<theta>' \<nu>'
      where w'\<theta>'\<nu>': "ide w' \<and> \<guillemotleft>\<theta>' : f \<star> w' \<Rightarrow> f'\<guillemotright> \<and> \<guillemotleft>\<nu>' : g' \<Rightarrow> g \<star> w'\<guillemotright> \<and> iso \<nu>' \<and>
                     \<rho>' = composite_cell w' \<theta>' \<cdot> \<nu>'"
        using T1 [of f' \<rho>'] T'.ide_leg0 T'.tab_in_hom by auto
      obtain \<phi> where \<phi>: "\<guillemotleft>\<phi> : src f \<Rightarrow> w' \<star> w\<guillemotright> \<and> iso \<phi>"
        using w\<theta>\<nu> w'\<theta>'\<nu>' apex_equivalence_lemma T'.tab_in_hom comp_assoc by metis
      obtain \<psi> where \<psi>: "\<guillemotleft>\<psi> : src f' \<Rightarrow> w \<star> w'\<guillemotright> \<and> iso \<psi>"
        using w\<theta>\<nu> w'\<theta>'\<nu>' T'.apex_equivalence_lemma tab_in_hom comp_assoc by metis
      have 1: "src f = src w"
        using \<phi> src_dom [of \<phi>] hcomp_simps(1) [of w' w]
        by (metis arr_cod in_homE leg0_simps(2) src_hcomp src_src vconn_implies_hpar(3))
      have 2: "src f' = src w'"
        using \<psi> src_dom [of \<psi>] hcomp_simps(1) [of w w']
        by (metis T'.leg0_simps(2) arr_cod in_homE src_hcomp src_src vconn_implies_hpar(3))
      interpret E: equivalence_in_bicategory V H \<a> \<i> src trg w' w \<psi> \<open>inv \<phi>\<close>
        using \<phi> \<psi> 1 2 w\<theta>\<nu> w'\<theta>'\<nu>' by unfold_locales auto
      have "\<guillemotleft>w : src f \<rightarrow> src f'\<guillemotright>"
        using \<psi> w\<theta>\<nu> 1 2 trg_cod hcomp_simps(2) E.antipar(1) by simp
      moreover have "\<guillemotleft>w' : src f' \<rightarrow> src f\<guillemotright>"
        using \<phi> w'\<theta>'\<nu>' 1 2 E.antipar(2) by simp
      ultimately show ?thesis
        using E.equivalence_in_bicategory_axioms w\<theta>\<nu> w'\<theta>'\<nu>' comp_assoc by metis
    qed

  end

  subsection "`Tabulation' is Bicategorical"

  text \<open>
    In this section we show that ``tabulation'' is a truly bicategorical notion,
    in the sense that tabulations are preserved and reflected by equivalence pseudofunctors.
    The proofs given here is are elementary proofs from first principles.
    It should also be possible to give a proof based on birepresentations,
    but for this to actually save work it would first be necessary to carry out a general
    development of birepresentations and bicategorical limits, and I have chosen not to
    attempt this here.
  \<close>

  context equivalence_pseudofunctor
  begin

    lemma preserves_tabulation:
    assumes "tabulation (\<cdot>\<^sub>C) (\<star>\<^sub>C) \<a>\<^sub>C \<i>\<^sub>C src\<^sub>C trg\<^sub>C r \<rho> f g"
    shows "tabulation (\<cdot>\<^sub>D) (\<star>\<^sub>D) \<a>\<^sub>D \<i>\<^sub>D src\<^sub>D trg\<^sub>D (F r) (D.inv (\<Phi> (r, f)) \<cdot>\<^sub>D F \<rho>) (F f) (F g)"
    proof -
      let ?\<rho>' = "D.inv (\<Phi> (r, f)) \<cdot>\<^sub>D F \<rho>"
      interpret T: tabulation V\<^sub>C H\<^sub>C \<a>\<^sub>C \<i>\<^sub>C src\<^sub>C trg\<^sub>C r \<rho> f
        using assms by auto
      interpret T': tabulation_data V\<^sub>D H\<^sub>D \<a>\<^sub>D \<i>\<^sub>D src\<^sub>D trg\<^sub>D \<open>F r\<close> ?\<rho>' \<open>F f\<close> \<open>F g\<close>
        using cmp_in_hom \<Phi>.components_are_iso C.VV.ide_char\<^sub>S\<^sub>b\<^sub>C C.VV.arr_char\<^sub>S\<^sub>b\<^sub>C
        apply unfold_locales
          apply auto
        by (intro D.comp_in_homI, auto)
      interpret T': tabulation V\<^sub>D H\<^sub>D \<a>\<^sub>D \<i>\<^sub>D src\<^sub>D trg\<^sub>D \<open>F r\<close> ?\<rho>' \<open>F f\<close> \<open>F g\<close>
      text \<open>
        How bad can it be to just show this directly from first principles?
        It is worse than it at first seems, once you start filling in the details!
      \<close>
      proof
        fix u' \<omega>'
        assume u': "D.ide u'"
        assume \<omega>': "\<guillemotleft>\<omega>' : D.dom \<omega>' \<Rightarrow>\<^sub>D F r \<star>\<^sub>D u'\<guillemotright>"
        show "\<exists>w' \<theta>' \<nu>'. D.ide w' \<and> \<guillemotleft>\<theta>' : F f \<star>\<^sub>D w' \<Rightarrow>\<^sub>D u'\<guillemotright> \<and>
                         \<guillemotleft>\<nu>' : D.dom \<omega>' \<Rightarrow>\<^sub>D F g \<star>\<^sub>D w'\<guillemotright> \<and> D.iso \<nu>' \<and>
                         T'.composite_cell w' \<theta>' \<cdot>\<^sub>D \<nu>' = \<omega>'"
        proof -
          text \<open>
            First, obtain \<open>\<omega>\<close> in \<open>C\<close> such that \<open>F \<omega>\<close> is related to \<open>\<omega>'\<close> by an equivalence in \<open>D\<close>.
          \<close>
          define v' where "v' = D.dom \<omega>'"
          have v': "D.ide v'"
            using assms v'_def D.ide_dom \<omega>' by blast
          have \<omega>': "\<guillemotleft>\<omega>' : v' \<Rightarrow>\<^sub>D F r \<star>\<^sub>D u'\<guillemotright>"
            using v'_def \<omega>' by simp
          define a' where "a' = src\<^sub>D \<omega>'"

          have [simp]: "src\<^sub>D u' = a'"
            using a'_def \<omega>'
            by (metis D.arr_cod D.ide_char D.in_homE D.src.preserves_cod D.src_dom
                D.src_hcomp v')
          have [simp]: "trg\<^sub>D u' = src\<^sub>D (F r)"
            using \<omega>'
            by (metis D.cod_trg D.in_homE D.not_arr_null D.seq_if_composable D.trg.extensionality
                D.trg.preserves_arr D.trg.preserves_cod)
          have [simp]: "src\<^sub>D v' = a'"
            using v'_def \<omega>' a'_def by auto
          have [simp]: "trg\<^sub>D v' = trg\<^sub>D (F r)"
            using v'_def D.vconn_implies_hpar(4) \<omega>' u' by force

          have [simp]: "src\<^sub>D \<omega>' = a'"
            using \<omega>' a'_def by blast
          have [simp]: "trg\<^sub>D \<omega>' = trg\<^sub>D (F r)"
            using \<omega>' v'_def \<open>trg\<^sub>D v' = trg\<^sub>D (F r)\<close> by auto

          obtain a where a: "C.obj a \<and> D.equivalent_objects (map\<^sub>0 a) a'"
            using u' \<omega>' a'_def biessentially_surjective_on_objects D.obj_src by blast
          obtain e' where e': "\<guillemotleft>e' : map\<^sub>0 a \<rightarrow>\<^sub>D a'\<guillemotright> \<and> D.equivalence_map e'"
            using a D.equivalent_objects_def by auto

          have u'_in_hhom: "\<guillemotleft>u' : a' \<rightarrow>\<^sub>D map\<^sub>0 (src\<^sub>C r)\<guillemotright>"
            by (simp add: u')
          hence 1: "\<guillemotleft>u' \<star>\<^sub>D e' : map\<^sub>0 a \<rightarrow>\<^sub>D map\<^sub>0 (src\<^sub>C r)\<guillemotright>"
            using e' by blast
          have v'_in_hhom: "\<guillemotleft>v' : a' \<rightarrow>\<^sub>D map\<^sub>0 (trg\<^sub>C r)\<guillemotright>"
            by (simp add: v')
          hence 2: "\<guillemotleft>v' \<star>\<^sub>D e' : map\<^sub>0 a \<rightarrow>\<^sub>D map\<^sub>0 (trg\<^sub>C r)\<guillemotright>"
            using e' by blast

          obtain d' \<eta>' \<epsilon>'
          where d'\<eta>'\<epsilon>': "adjoint_equivalence_in_bicategory (\<cdot>\<^sub>D) (\<star>\<^sub>D) \<a>\<^sub>D \<i>\<^sub>D src\<^sub>D trg\<^sub>D e' d' \<eta>' \<epsilon>'"
            using e' D.equivalence_map_extends_to_adjoint_equivalence by blast
          interpret e': adjoint_equivalence_in_bicategory \<open>(\<cdot>\<^sub>D)\<close> \<open>(\<star>\<^sub>D)\<close> \<a>\<^sub>D \<i>\<^sub>D src\<^sub>D trg\<^sub>D e' d' \<eta>' \<epsilon>'
            using d'\<eta>'\<epsilon>' by auto
          interpret d': adjoint_equivalence_in_bicategory \<open>(\<cdot>\<^sub>D)\<close> \<open>(\<star>\<^sub>D)\<close> \<a>\<^sub>D \<i>\<^sub>D src\<^sub>D trg\<^sub>D
                          d' e' "D.inv \<epsilon>'" "D.inv \<eta>'"
            using e'.dual_adjoint_equivalence by simp
          have [simp]: "src\<^sub>D e' = map\<^sub>0 a"
            using e' by auto
          have [simp]: "trg\<^sub>D e' = a'"
             using e' by auto
          have [simp]: "src\<^sub>D d' = a'"
            by (simp add: e'.antipar(2))
          have [simp]: "trg\<^sub>D d' = map\<^sub>0 a"
            using e'.antipar by simp

          obtain u where u: "\<guillemotleft>u : a \<rightarrow>\<^sub>C src\<^sub>C r\<guillemotright> \<and> C.ide u \<and> D.isomorphic (F u) (u' \<star>\<^sub>D e')"
            using a e' u' 1 u'_in_hhom locally_essentially_surjective [of a "src\<^sub>C r" "u' \<star>\<^sub>D e'"]
                  C.obj_src D.equivalence_map_is_ide T.base_simps(2)
            by blast
          obtain \<phi> where \<phi>: "\<guillemotleft>\<phi> : u' \<star>\<^sub>D e' \<Rightarrow>\<^sub>D F u\<guillemotright> \<and> D.iso \<phi>"
            using u D.isomorphic_symmetric by blast
          obtain v where v: "\<guillemotleft>v : a \<rightarrow>\<^sub>C trg\<^sub>C r\<guillemotright> \<and> C.ide v \<and> D.isomorphic (F v) (v' \<star>\<^sub>D e')"
            using a e' v' v'_in_hhom locally_essentially_surjective [of a "trg\<^sub>C r" "v' \<star>\<^sub>D e'"]
                  C.obj_trg D.equivalence_map_is_ide T.base_simps(2)
            by blast
          obtain \<psi> where \<psi>: "\<guillemotleft>\<psi> : F v \<Rightarrow>\<^sub>D v' \<star>\<^sub>D e'\<guillemotright> \<and> D.iso \<psi>"
            using v by blast

          have [simp]: "src\<^sub>C u = a" using u by auto
          have [simp]: "trg\<^sub>C u = src\<^sub>C r" using u by auto
          have [simp]: "src\<^sub>C v = a" using v by auto
          have [simp]: "trg\<^sub>C v = trg\<^sub>C r" using v by auto
          have [simp]: "src\<^sub>D \<phi> = map\<^sub>0 a"
            using \<phi> by (metis "1" D.dom_src D.in_hhomE D.in_homE D.src.preserves_dom)
          have [simp]: "trg\<^sub>D \<phi> = trg\<^sub>D u'"
            using \<phi>
            by (metis D.cod_trg D.hseqI D.in_homE D.isomorphic_implies_hpar(4)
                D.trg.preserves_cod D.trg_hcomp e' u u'_in_hhom)
          have [simp]: "src\<^sub>D \<psi> = map\<^sub>0 a"
            using \<psi>
            by (metis C.in_hhomE D.in_homE D.src_dom \<open>src\<^sub>D e' = map\<^sub>0 a\<close> preserves_src v)
          have [simp]: "trg\<^sub>D \<psi> = trg\<^sub>D v'"
            using \<psi>
            by (metis "2" D.cod_trg D.in_hhomE D.in_homE D.trg.preserves_cod T.base_simps(2)
                \<open>trg\<^sub>D v' = trg\<^sub>D (F r)\<close> preserves_trg)

          define F\<omega> where "F\<omega> = \<Phi> (r, u) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<phi>) \<cdot>\<^sub>D \<a>\<^sub>D[F r, u', e'] \<cdot>\<^sub>D (\<omega>' \<star>\<^sub>D e') \<cdot>\<^sub>D \<psi>"
          have F\<omega>: "\<guillemotleft>F\<omega> : F v \<Rightarrow>\<^sub>D F (r \<star>\<^sub>C u)\<guillemotright>"
          proof (unfold F\<omega>_def, intro D.comp_in_homI)
            show "\<guillemotleft>\<psi> : F v \<Rightarrow>\<^sub>D v' \<star>\<^sub>D e'\<guillemotright>"
              using \<psi> by simp
            show "\<guillemotleft>\<omega>' \<star>\<^sub>D e' : v' \<star>\<^sub>D e' \<Rightarrow>\<^sub>D (F r \<star>\<^sub>D u') \<star>\<^sub>D e'\<guillemotright>"
              using e' \<omega>' D.equivalence_map_is_ide v'_in_hhom by blast
            show "\<guillemotleft>\<a>\<^sub>D[F r, u', e'] : (F r \<star>\<^sub>D u') \<star>\<^sub>D e' \<Rightarrow>\<^sub>D F r \<star>\<^sub>D u' \<star>\<^sub>D e'\<guillemotright>"
              using e' u' D.equivalence_map_is_ide D.in_hhom_def u'_in_hhom by auto
            show "\<guillemotleft>F r \<star>\<^sub>D \<phi> : F r \<star>\<^sub>D u' \<star>\<^sub>D e' \<Rightarrow>\<^sub>D F r \<star>\<^sub>D F u\<guillemotright>"
              using e' u' u \<phi>
              by (metis C.in_hhomE D.hcomp_in_vhom D.isomorphic_implies_hpar(4)
                  T'.base_in_hom(2) T.base_simps(2) preserves_src preserves_trg)
            show "\<guillemotleft>\<Phi> (r, u) : F r \<star>\<^sub>D F u \<Rightarrow>\<^sub>D F (r \<star>\<^sub>C u)\<guillemotright>"
              using u cmp_in_hom(2) [of r u] by auto
          qed

          obtain \<omega> where \<omega>: "\<guillemotleft>\<omega> : v \<Rightarrow>\<^sub>C r \<star>\<^sub>C u\<guillemotright> \<and> F \<omega> = F\<omega>"
            using u v \<omega>' \<phi> \<psi> F\<omega> locally_full [of v "r \<star>\<^sub>C u" F\<omega>]
            by (metis C.ide_hcomp C.hseqI C.in_hhomE C.src_hcomp C.trg_hcomp
                T.ide_base T.base_in_hom(1))
          have [simp]: "src\<^sub>C \<omega> = src\<^sub>C u"
            using \<omega>
            by (metis C.hseqI C.in_homE C.src_cod C.src_hcomp T.base_in_hom(1) u)
          have [simp]: "trg\<^sub>C \<omega> = trg\<^sub>C r"
            using \<omega>
            by (metis C.ide_char C.ide_trg C.in_homE C.trg.preserves_hom \<open>trg\<^sub>C v = trg\<^sub>C r\<close>)
  
          text \<open>Apply \<open>T.T1\<close> to \<open>u\<close> and \<open>\<omega>\<close> to obtain \<open>w\<close>, \<open>\<theta>\<close>, \<open>\<nu>\<close>.\<close>

          obtain w \<theta> \<nu>
          where w\<theta>\<nu>: "C.ide w \<and> \<guillemotleft>\<theta> : f \<star>\<^sub>C w \<Rightarrow>\<^sub>C u\<guillemotright> \<and> \<guillemotleft>\<nu> : C.dom \<omega> \<Rightarrow>\<^sub>C g \<star>\<^sub>C w\<guillemotright> \<and>
                      C.iso \<nu> \<and> T.composite_cell w \<theta> \<cdot>\<^sub>C \<nu> = \<omega>"
            using u \<omega> T.T1 [of u \<omega>] by auto
          text \<open>
          Combining \<open>\<omega>\<close> and \<open>w\<theta>\<nu>\<close> yields the situation depicted in the diagram below.
          In this as well as subsequent diagrams, canonical isomorphisms have been suppressed
          in the interests of clarity.
$$
F (
\xy/67pt/
\xymatrix{
  & {\scriptstyle{a}}
  \xlowertwocell[ddddl]{}_{v}{^\nu}
  \xuppertwocell[ddddr]{}^{u}{^\theta}
  \ar@ {.>}[dd]^{w}
  \\
  \\
  & \scriptstyle{{\rm src}~g \;=\;{\rm src}~f} \xtwocell[ddd]{}\omit{^\rho}
  \ar[ddl] _{g}
  \ar[ddr] ^{f}
  \\
  \\
  \scriptstyle{{\rm trg}~r} & & \scriptstyle{{\rm src}~r} \ar[ll] ^{r}
  \\
  &
}
\endxy
)
\qquad = \qquad
\xy/67pt/
\xymatrix{
  & {\scriptstyle{{\rm src}(F a)}}
  \xlowertwocell[ddddl]{}^{<2>F v}{^{\psi}}
  \xuppertwocell[ddddr]{}^{<2>F u}{^{\phi}}
  \ar[dd] ^{e'}
  \\
  \\
  & \scriptstyle{a'} \xtwocell[ddd]{}\omit{^{\omega'}}
  \ar[ddl] _{v'}
  \ar[ddr] ^{u'}
  \\
  \\
  \scriptstyle{{\rm trg}~(F r)} & & \scriptstyle{{\rm src}~(F r)} \ar[ll] ^{F r}
  \\
  &
}
\endxy
$$
          \<close>
          have [simp]: "src\<^sub>C w = src\<^sub>C u"
            by (metis C.arrI C.seqE C.src_hcomp C.src_vcomp C.vseq_implies_hpar(1)
                \<omega> \<open>src\<^sub>C \<omega> = src\<^sub>C u\<close> w\<theta>\<nu>)
          have [simp]: "trg\<^sub>C w = src\<^sub>C f"
            by (metis C.arrI C.hseq_char C.seqE T.tab_simps(2) \<omega> w\<theta>\<nu>)
          have [simp]: "src\<^sub>D (F u) = map\<^sub>0 a"
            using e'.antipar(1) u by auto
          have [simp]: "src\<^sub>D (F v) = map\<^sub>0 a"
              using v e' e'.antipar by force
          have [simp]: "src\<^sub>D (F w) = map\<^sub>0 a"
            by (simp add: w\<theta>\<nu>)

          have *: "F (T.composite_cell w \<theta> \<cdot>\<^sub>C \<nu>) =
                     \<Phi> (r, u) \<cdot>\<^sub>D (F r \<star>\<^sub>D F \<theta> \<cdot>\<^sub>D \<Phi> (f, w)) \<cdot>\<^sub>D \<a>\<^sub>D[F r, F f, F w] \<cdot>\<^sub>D
                       (D.inv (\<Phi> (r, f)) \<cdot>\<^sub>D F \<rho> \<star>\<^sub>D F w) \<cdot>\<^sub>D D.inv (\<Phi> (g, w)) \<cdot>\<^sub>D F \<nu>"
          text \<open>
$$
F (
\xy/67pt/
\xymatrix{
  & {\scriptstyle{a}}
  \xlowertwocell[ddddl]{}_{v}{^\nu}
  \xuppertwocell[ddddr]{}^{u}{^\theta}
  \ar[dd] ^{w}
  \\
  \\
  & \scriptstyle{{\rm src}~g \;=\;{\rm src}~f} \xtwocell[ddd]{}\omit{^\rho}
  \ar[ddl] _{g}
  \ar[ddr] ^{f}
  \\
  \\
  \scriptstyle{{\rm trg}~r} & & \scriptstyle{{\rm src}~r} \ar[ll] ^{r}
  \\
  &
}
\endxy
)
\qquad = \qquad
\xy/67pt/
\xymatrix{
  & {\scriptstyle{{\rm src}(F a)}}
  \xlowertwocell[ddddl]{}^{<2>F v}{^{F \nu}}
  \xuppertwocell[ddddr]{}^{<2>F u}{^{F \theta}}
  \ar[dd] ^{Fw}
  \\
  \\
  & \scriptstyle{{\rm src}(F g) \;=\;{\rm src}(F f)} \xtwocell[ddd]{}\omit{^{F \rho}}
  \ar[ddl] _{F g}
  \ar[ddr] ^{F f}
  \\
  \\
  \scriptstyle{{\rm trg}~(F r)} & & \scriptstyle{{\rm src}~(F r)} \ar[ll] ^{F r}
  \\
  &
}
\endxy
$$
          \<close>
          proof -
            have "F (T.composite_cell w \<theta> \<cdot>\<^sub>C \<nu>) = F ((r \<star>\<^sub>C \<theta>) \<cdot>\<^sub>C \<a>\<^sub>C[r, f, w] \<cdot>\<^sub>C (\<rho> \<star>\<^sub>C w) \<cdot>\<^sub>C \<nu>)"
              using C.comp_assoc by simp
            also have "... = F (r \<star>\<^sub>C \<theta>) \<cdot>\<^sub>D F \<a>\<^sub>C[r, f, w] \<cdot>\<^sub>D F (\<rho> \<star>\<^sub>C w) \<cdot>\<^sub>D F \<nu>"
              by (metis C.arr_dom_iff_arr C.comp_assoc C.in_homE C.seqE
                        as_nat_trans.preserves_comp_2 w\<theta>\<nu>)
            also have "... =
                       F (r \<star>\<^sub>C \<theta>) \<cdot>\<^sub>D (\<Phi> (r, f \<star>\<^sub>C w) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<Phi> (f, w)) \<cdot>\<^sub>D \<a>\<^sub>D[F r, F f, F w] \<cdot>\<^sub>D
                         (D.inv (\<Phi> (r, f)) \<star>\<^sub>D F w) \<cdot>\<^sub>D D.inv (\<Phi> (r \<star>\<^sub>C f, w))) \<cdot>\<^sub>D F (\<rho> \<star>\<^sub>C w) \<cdot>\<^sub>D F \<nu>"
              using \<omega> w\<theta>\<nu> preserves_assoc [of r f w]
              by (metis C.hseqE C.in_homE C.seqE T.tab_simps(2) T.ide_leg0 T.ide_base
                  T.leg0_simps(3))
            also have "... =
                       ((F (r \<star>\<^sub>C \<theta>) \<cdot>\<^sub>D \<Phi> (r, f \<star>\<^sub>C w)) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<Phi> (f, w))) \<cdot>\<^sub>D \<a>\<^sub>D[F r, F f, F w] \<cdot>\<^sub>D
                         ((D.inv (\<Phi> (r, f)) \<star>\<^sub>D F w) \<cdot>\<^sub>D D.inv (\<Phi> (r \<star>\<^sub>C f, w))) \<cdot>\<^sub>D F (\<rho> \<star>\<^sub>C w) \<cdot>\<^sub>D F \<nu>"
              using D.comp_assoc by simp
            also have "... =
                       \<Phi> (r, u) \<cdot>\<^sub>D (F r \<star>\<^sub>D F \<theta> \<cdot>\<^sub>D \<Phi> (f, w)) \<cdot>\<^sub>D \<a>\<^sub>D[F r, F f, F w] \<cdot>\<^sub>D
                         ((D.inv (\<Phi> (r, f)) \<star>\<^sub>D F w) \<cdot>\<^sub>D D.inv (\<Phi> (r \<star>\<^sub>C f, w)) \<cdot>\<^sub>D F (\<rho> \<star>\<^sub>C w)) \<cdot>\<^sub>D F \<nu>"
            proof -
              have "(F (r \<star>\<^sub>C \<theta>) \<cdot>\<^sub>D \<Phi> (r, f \<star>\<^sub>C w)) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<Phi> (f, w)) =
                    (\<Phi> (r, u) \<cdot>\<^sub>D (F r \<star>\<^sub>D F \<theta>) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<Phi> (f, w)))"
              proof -
                have "F (r \<star>\<^sub>C \<theta>) \<cdot>\<^sub>D \<Phi> (r, f \<star>\<^sub>C w) = \<Phi> (r, u) \<cdot>\<^sub>D (F r \<star>\<^sub>D F \<theta>)"
                  using \<omega> \<Phi>.naturality [of "(r, \<theta>)"] FF_def w\<theta>\<nu> C.VV.arr_char\<^sub>S\<^sub>b\<^sub>C
                        C.VV.dom_simp C.VV.cod_simp
                  apply simp
                  by (metis (no_types, lifting) C.hseqE C.in_homE C.seqE)
                thus ?thesis
                  using D.comp_assoc by simp
              qed
              also have "... = \<Phi> (r, u) \<cdot>\<^sub>D (F r \<star>\<^sub>D F \<theta> \<cdot>\<^sub>D \<Phi> (f, w))"
              proof -
                have "(F r \<star>\<^sub>D F \<theta>) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<Phi> (f, w)) = F r \<star>\<^sub>D F \<theta> \<cdot>\<^sub>D \<Phi> (f, w)"
                  using \<omega> w\<theta>\<nu> D.whisker_right [of "F r" "F \<theta>" "\<Phi> (f, w)"]
                  by (metis C.hseqE C.in_homE C.seqE D.comp_ide_self D.interchange D.seqI'
                      T'.ide_base T'.base_in_hom(2) T.tab_simps(2) T.ide_leg0 cmp_in_hom(2)
                      preserves_hom)
                thus ?thesis by simp
              qed
              finally have "(F (r \<star>\<^sub>C \<theta>) \<cdot>\<^sub>D \<Phi> (r, f \<star>\<^sub>C w)) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<Phi> (f, w)) =
                            \<Phi> (r, u) \<cdot>\<^sub>D (F r \<star>\<^sub>D F \<theta> \<cdot>\<^sub>D \<Phi> (f, w))"
                by simp
              thus ?thesis
                using D.comp_assoc by simp
            qed
            also have "... = \<Phi> (r, u) \<cdot>\<^sub>D (F r \<star>\<^sub>D F \<theta> \<cdot>\<^sub>D \<Phi> (f, w)) \<cdot>\<^sub>D \<a>\<^sub>D[F r, F f, F w] \<cdot>\<^sub>D
                               ((D.inv (\<Phi> (r, f)) \<cdot>\<^sub>D F \<rho> \<star>\<^sub>D F w) \<cdot>\<^sub>D D.inv (\<Phi> (g, w))) \<cdot>\<^sub>D F \<nu>"
            proof -
              have "(D.inv (\<Phi> (r, f)) \<star>\<^sub>D F w) \<cdot>\<^sub>D D.inv (\<Phi> (r \<star>\<^sub>C f, w)) \<cdot>\<^sub>D F (\<rho> \<star>\<^sub>C w) =
                    ((D.inv (\<Phi> (r, f)) \<star>\<^sub>D F w) \<cdot>\<^sub>D (F \<rho> \<star>\<^sub>D F w)) \<cdot>\<^sub>D D.inv (\<Phi> (g, w))"
              proof -
                have "D.inv (\<Phi> (r \<star>\<^sub>C f, w)) \<cdot>\<^sub>D F (\<rho> \<star>\<^sub>C w) = (F \<rho> \<star>\<^sub>D F w) \<cdot>\<^sub>D D.inv (\<Phi> (g, w))"
                proof -
                  have "src\<^sub>C (r \<star>\<^sub>C f) = trg\<^sub>C w"
                    using \<omega> w\<theta>\<nu>
                    by (metis C.arrI C.hseq_char C.seqE C.hcomp_simps(1) T.tab_simps(2)
                        T.leg0_simps(2) T.leg0_simps(3))
                  hence "D.seq (\<Phi> (r \<star>\<^sub>C f, w)) (F \<rho> \<star>\<^sub>D F w)"
                    using \<omega> w\<theta>\<nu> cmp_in_hom(2) [of "r \<star>\<^sub>C f" w] C.VV.arr_char\<^sub>S\<^sub>b\<^sub>C FF_def by auto
                  moreover have "\<Phi> (r \<star>\<^sub>C f, w) \<cdot>\<^sub>D (F \<rho> \<star>\<^sub>D F w) = F (\<rho> \<star>\<^sub>C w) \<cdot>\<^sub>D \<Phi> (g, w)"
                    using \<omega> w\<theta>\<nu> \<Phi>.naturality [of "(\<rho>, w)"] cmp_components_are_iso FF_def
                          C.VV.arr_char\<^sub>S\<^sub>b\<^sub>C C.VV.dom_simp C.VV.cod_simp
                    by simp
                  moreover have "D.iso (\<Phi> (r \<star>\<^sub>C f, w))"
                    using w\<theta>\<nu> cmp_components_are_iso
                    by (metis C.arrI C.ide_hcomp C.hseqE C.hseqI' C.seqE C.src_hcomp
                        T.tab_simps(2) T.ide_leg0 T.ide_base T.leg0_simps(2-3) \<omega>)
                  moreover have "D.iso (\<Phi> (g, w))"
                    using w\<theta>\<nu> cmp_components_are_iso
                    by (metis C.arrI C.hseqE C.seqE T.tab_simps(2) T.ide_leg1 T.leg1_simps(3) \<omega>)
                  ultimately show ?thesis
                    using \<omega> w\<theta>\<nu> \<Phi>.naturality cmp_components_are_iso FF_def C.VV.arr_char\<^sub>S\<^sub>b\<^sub>C
                          D.invert_opposite_sides_of_square
                    by presburger
                qed
                thus ?thesis
                  using D.comp_assoc by simp
              qed
              also have "... = (D.inv (\<Phi> (r, f)) \<cdot>\<^sub>D F \<rho> \<star>\<^sub>D F w) \<cdot>\<^sub>D D.inv (\<Phi> (g, w))"
                using \<omega> w\<theta>\<nu> D.whisker_right cmp_components_are_iso cmp_in_hom D.comp_assoc
                by auto
              finally show ?thesis
                using D.comp_assoc by simp
            qed
            finally show ?thesis
              using D.comp_assoc by simp
          qed

          text \<open>We can now define the \<open>w'\<close>, \<open>\<theta>'\<close>, and \<open>\<nu>'\<close> that we are required to exhibit.\<close>

          define \<phi>' where "\<phi>' = e'.trnr\<^sub>\<epsilon> u' (D.inv \<phi>)"
          have "\<phi>' = \<r>\<^sub>D[u'] \<cdot>\<^sub>D (u' \<star>\<^sub>D \<epsilon>') \<cdot>\<^sub>D \<a>\<^sub>D[u', e', d'] \<cdot>\<^sub>D (D.inv \<phi> \<star>\<^sub>D d')"
            unfolding \<phi>'_def e'.trnr\<^sub>\<epsilon>_def by simp
          have \<phi>': "\<guillemotleft>\<phi>' : F u \<star>\<^sub>D d' \<Rightarrow>\<^sub>D u'\<guillemotright>"
            using \<phi> \<phi>'_def u u' e'.adjoint_transpose_right(2) [of u' "F u"] by auto

          have [simp]: "src\<^sub>D \<phi>' = src\<^sub>D u'"
            using \<phi>' by fastforce
          have [simp]: "trg\<^sub>D \<phi>' = trg\<^sub>D u'"
            using \<phi>' by fastforce

          define \<psi>' where "\<psi>' = d'.trnr\<^sub>\<eta> v' (D.inv \<psi>)"
          have \<psi>'_eq: "\<psi>' = (D.inv \<psi> \<star>\<^sub>D d') \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[v', e', d'] \<cdot>\<^sub>D (v' \<star>\<^sub>D D.inv \<epsilon>') \<cdot>\<^sub>D \<r>\<^sub>D\<^sup>-\<^sup>1[v']"
            unfolding \<psi>'_def d'.trnr\<^sub>\<eta>_def by simp
          have \<psi>': "\<guillemotleft>\<psi>' : v' \<Rightarrow>\<^sub>D F v \<star>\<^sub>D d'\<guillemotright>"
            using \<psi> \<psi>'_def v v' d'.adjoint_transpose_right(1) [of "F v" v'] by auto
          have iso_\<psi>': "D.iso \<psi>'"
            unfolding \<psi>'_def d'.trnr\<^sub>\<eta>_def
            using \<psi> e'.counit_is_iso
            by (metis D.arrI D.iso_hcomp D.hseq_char D.ide_is_iso D.iso_assoc'
                D.iso_inv_iso D.iso_runit' D.isos_compose D.seqE \<psi>'_eq
                \<psi>' d'.unit_simps(5) e'.antipar(1) e'.antipar(2) e'.ide_left e'.ide_right v')

          have [simp]: "src\<^sub>D \<psi>' = src\<^sub>D v'"
            using \<psi>' by fastforce
          have [simp]: "trg\<^sub>D \<psi>' = trg\<^sub>D v'"
            using \<psi>' by fastforce

          define w' where "w' = F w \<star>\<^sub>D d'"
          define \<theta>' where "\<theta>' = \<phi>' \<cdot>\<^sub>D (F \<theta> \<cdot>\<^sub>D \<Phi> (f, w) \<star>\<^sub>D d') \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, F w, d']"
          define \<nu>' where "\<nu>' = \<a>\<^sub>D[F g, F w, d'] \<cdot>\<^sub>D (D.inv (\<Phi> (g, w)) \<cdot>\<^sub>D F \<nu> \<star>\<^sub>D d') \<cdot>\<^sub>D \<psi>'"
          have w': "D.ide w' \<and> \<guillemotleft>w' : src\<^sub>D u' \<rightarrow>\<^sub>D src\<^sub>D (F f)\<guillemotright>"
            using w'_def \<omega> w\<theta>\<nu> by simp
          have \<theta>': "\<guillemotleft>\<theta>' : F f \<star>\<^sub>D w' \<Rightarrow>\<^sub>D u'\<guillemotright>"
            unfolding \<theta>'_def w'_def
            using \<phi>' \<omega> w\<theta>\<nu> cmp_in_hom
            apply (intro D.comp_in_homI D.hcomp_in_vhom)
              apply auto
            by (intro D.comp_in_homI D.hcomp_in_vhom, auto)
          have \<nu>': "\<guillemotleft>\<nu>' : v' \<Rightarrow>\<^sub>D F g \<star>\<^sub>D w'\<guillemotright>"
            unfolding \<nu>'_def w'_def
            using \<psi>' \<omega> w\<theta>\<nu> cmp_in_hom cmp_components_are_iso
            apply (intro D.comp_in_homI)
              apply auto
            by (intro D.hcomp_in_vhom D.comp_in_homI, auto)
          have iso_\<nu>': "D.iso \<nu>'"
            using \<nu>'_def iso_\<psi>' cmp_in_hom D.isos_compose preserves_iso
            by (metis (no_types, lifting) C.ideD(1) D.arrI D.iso_hcomp D.hseqE D.ide_is_iso
                D.iso_assoc D.iso_inv_iso D.seqE T.ide_leg1 T.leg1_simps(3) cmp_components_are_iso
                \<nu>' \<open>src\<^sub>D (F w) = map\<^sub>0 a\<close> \<open>src\<^sub>D e' = map\<^sub>0 a\<close> \<open>trg\<^sub>C w = src\<^sub>C f\<close> e'.antipar(1)
                e'.ide_right preserves_ide preserves_src preserves_trg w\<theta>\<nu>)

          have "T'.composite_cell w' \<theta>' \<cdot>\<^sub>D \<nu>' = \<omega>'"
          text \<open>
$$
\xy/67pt/
\xymatrix{
  &
  \xlowertwocell[ddddddl]{\scriptstyle{a'}}<-13>^{<2>v'}{^{\psi'}}
  \xuppertwocell[ddddddr]{}<13>^{<2>u'}{^{\phi'}}
  \ar [dd] ^{d'}
  \\
  \\
  & {\scriptstyle{{\rm src}(F g) \;=\;{\rm src}(F f)}}
  \xlowertwocell[ddddl]{}^{<2>F v}{^{F \nu}}
  \xuppertwocell[ddddr]{}^{<2>F u}{^{F \theta}}
  \ar[dd] ^{Fw}
  \\
  \\
  & \scriptstyle{a'} \xtwocell[ddd]{}\omit{^{F \rho}}
  \ar[ddl] _{F g}
  \ar[ddr] ^{F f}
  \\
  \\
  \scriptstyle{{\rm trg}~(F r)} & & \scriptstyle{{\rm src}~(F r)} \ar[ll] ^{F r}
  \\
  &
}
\endxy
\qquad = \qquad
\xy/33pt/
\xymatrix{
  & \scriptstyle{\scriptstyle{a'}} \xtwocell[ddd]{}\omit{^{\omega'}}
  \ar[ddl] _{v'}
  \ar[ddr] ^{u'}
  \\
  \\
  \scriptstyle{{\rm trg}~(Fr)} & & \scriptstyle{{\rm src}~(Fr)} \ar[ll] ^{Fr}
  \\
  &
}
\endxy
$$
          \<close>
          proof -
            have 1: "\<guillemotleft>T'.composite_cell w' \<theta>' \<cdot>\<^sub>D \<nu>' : v' \<Rightarrow>\<^sub>D F r \<star>\<^sub>D u'\<guillemotright>"
              using w' \<theta>' \<nu>' w\<theta>\<nu> T'.composite_cell_in_hom by blast
            have "T'.composite_cell w' \<theta>' \<cdot>\<^sub>D \<nu>' =
                  (F r \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D \<a>\<^sub>D[F r, F u, d'] \<cdot>\<^sub>D (D.inv (\<Phi> (r, u)) \<star>\<^sub>D d') \<cdot>\<^sub>D
                    (F (T.composite_cell w \<theta> \<cdot>\<^sub>C \<nu>) \<star>\<^sub>D d') \<cdot>\<^sub>D \<psi>'"
            proof -
              have "T'.composite_cell w' \<theta>' \<cdot>\<^sub>D \<nu>' =
                    (F r \<star>\<^sub>D \<phi>' \<cdot>\<^sub>D (F \<theta> \<cdot>\<^sub>D \<Phi> (f, w) \<star>\<^sub>D d') \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, F w, d']) \<cdot>\<^sub>D
                      \<a>\<^sub>D[F r, F f, w'] \<cdot>\<^sub>D (D.inv (\<Phi> (r, f)) \<cdot>\<^sub>D F \<rho> \<star>\<^sub>D w') \<cdot>\<^sub>D \<a>\<^sub>D[F g, F w, d'] \<cdot>\<^sub>D
                      (D.inv (\<Phi> (g, w)) \<cdot>\<^sub>D F \<nu> \<star>\<^sub>D d') \<cdot>\<^sub>D \<psi>'"
                using \<theta>'_def \<nu>'_def D.comp_assoc by simp
              also have
                "... = (F r \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D (F r \<star>\<^sub>D (F \<theta> \<cdot>\<^sub>D \<Phi> (f, w) \<star>\<^sub>D d') \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, F w, d']) \<cdot>\<^sub>D
                         \<a>\<^sub>D[F r, F f, F w \<star>\<^sub>D d'] \<cdot>\<^sub>D (D.inv (\<Phi> (r, f)) \<cdot>\<^sub>D F \<rho> \<star>\<^sub>D F w \<star>\<^sub>D d') \<cdot>\<^sub>D
                         \<a>\<^sub>D[F g, F w, d'] \<cdot>\<^sub>D (D.inv (\<Phi> (g, w)) \<cdot>\<^sub>D F \<nu> \<star>\<^sub>D d') \<cdot>\<^sub>D \<psi>'"
                using \<theta>' \<theta>'_def w'_def D.comp_assoc D.whisker_left by auto
              also have
                "... = (F r \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D (F r \<star>\<^sub>D (F \<theta> \<star>\<^sub>D d') \<cdot>\<^sub>D (\<Phi> (f, w) \<star>\<^sub>D d') \<cdot>\<^sub>D
                         \<a>\<^sub>D\<^sup>-\<^sup>1[F f, F w, d']) \<cdot>\<^sub>D \<a>\<^sub>D[F r, F f, F w \<star>\<^sub>D d'] \<cdot>\<^sub>D
                         ((D.inv (\<Phi> (r, f)) \<cdot>\<^sub>D F \<rho> \<star>\<^sub>D F w \<star>\<^sub>D d') \<cdot>\<^sub>D
                         \<a>\<^sub>D[F g, F w, d']) \<cdot>\<^sub>D (D.inv (\<Phi> (g, w)) \<cdot>\<^sub>D F \<nu> \<star>\<^sub>D d') \<cdot>\<^sub>D \<psi>'"
                using \<theta>' \<theta>'_def D.whisker_right cmp_in_hom D.comp_assoc by fastforce
              also have
                "... = (F r \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D (F r \<star>\<^sub>D (F \<theta> \<star>\<^sub>D d') \<cdot>\<^sub>D (\<Phi> (f, w) \<star>\<^sub>D d') \<cdot>\<^sub>D
                         \<a>\<^sub>D\<^sup>-\<^sup>1[F f, F w, d']) \<cdot>\<^sub>D \<a>\<^sub>D[F r, F f, F w \<star>\<^sub>D d'] \<cdot>\<^sub>D
                         \<a>\<^sub>D[F r \<star>\<^sub>D F f, F w, d'] \<cdot>\<^sub>D ((D.inv (\<Phi> (r, f)) \<cdot>\<^sub>D F \<rho> \<star>\<^sub>D F w) \<star>\<^sub>D d') \<cdot>\<^sub>D
                         (D.inv (\<Phi> (g, w)) \<cdot>\<^sub>D F \<nu> \<star>\<^sub>D d') \<cdot>\<^sub>D \<psi>'"
              proof -
                have "(D.inv (\<Phi> (r, f)) \<cdot>\<^sub>D F \<rho> \<star>\<^sub>D F w \<star>\<^sub>D d') \<cdot>\<^sub>D \<a>\<^sub>D[F g, F w, d'] =
                      \<a>\<^sub>D[F r \<star>\<^sub>D F f, F w, d'] \<cdot>\<^sub>D ((D.inv (\<Phi> (r, f)) \<cdot>\<^sub>D F \<rho> \<star>\<^sub>D F w) \<star>\<^sub>D d')"
                  using D.assoc_naturality [of "D.inv (\<Phi> (r, f)) \<cdot>\<^sub>D F \<rho>" "F w" d']
                        cmp_in_hom cmp_components_are_iso
                  by (simp add: w\<theta>\<nu>)
                thus ?thesis
                  using D.comp_assoc by simp
              qed
              also have "... = (F r \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D (F r \<star>\<^sub>D F \<theta> \<star>\<^sub>D d') \<cdot>\<^sub>D (F r \<star>\<^sub>D \<Phi> (f, w) \<star>\<^sub>D d') \<cdot>\<^sub>D
                                 ((F r \<star>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, F w, d']) \<cdot>\<^sub>D
                                 \<a>\<^sub>D[F r, F f, F w \<star>\<^sub>D d'] \<cdot>\<^sub>D \<a>\<^sub>D[F r \<star>\<^sub>D F f, F w, d']) \<cdot>\<^sub>D 
                                 ((D.inv (\<Phi> (r, f)) \<cdot>\<^sub>D F \<rho> \<star>\<^sub>D F w) \<star>\<^sub>D d') \<cdot>\<^sub>D
                                 (D.inv (\<Phi> (g, w)) \<cdot>\<^sub>D F \<nu> \<star>\<^sub>D d') \<cdot>\<^sub>D \<psi>'"
                using 1 D.whisker_left D.comp_assoc
                by (metis D.arrI D.hseq_char D.seqE T'.ide_base calculation)
              also have "... = (F r \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D (F r \<star>\<^sub>D F \<theta> \<star>\<^sub>D d') \<cdot>\<^sub>D ((F r \<star>\<^sub>D \<Phi> (f, w) \<star>\<^sub>D d') \<cdot>\<^sub>D
                                 \<a>\<^sub>D[F r, F f \<star>\<^sub>D F w, d']) \<cdot>\<^sub>D (\<a>\<^sub>D[F r, F f, F w] \<star>\<^sub>D d') \<cdot>\<^sub>D 
                                 ((D.inv (\<Phi> (r, f)) \<cdot>\<^sub>D F \<rho> \<star>\<^sub>D F w) \<star>\<^sub>D d') \<cdot>\<^sub>D
                                 (D.inv (\<Phi> (g, w)) \<cdot>\<^sub>D F \<nu> \<star>\<^sub>D d') \<cdot>\<^sub>D \<psi>'"
              proof -
                have "D.seq \<a>\<^sub>D[F r, F f, F w \<star>\<^sub>D d'] \<a>\<^sub>D[F r \<star>\<^sub>D F f, F w, d']"
                  by (metis 1 D.arrI D.seqE calculation)
                hence "(F r \<star>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, F w, d']) \<cdot>\<^sub>D \<a>\<^sub>D[F r, F f, F w \<star>\<^sub>D d'] \<cdot>\<^sub>D
                         \<a>\<^sub>D[F r \<star>\<^sub>D F f, F w, d'] =
                       \<a>\<^sub>D[F r, F f \<star>\<^sub>D F w, d'] \<cdot>\<^sub>D (\<a>\<^sub>D[F r, F f, F w] \<star>\<^sub>D d')"
                  using w\<theta>\<nu> D.pentagon
                        D.invert_side_of_triangle(1)
                           [of "\<a>\<^sub>D[F r, F f, F w \<star>\<^sub>D d'] \<cdot>\<^sub>D \<a>\<^sub>D[F r \<star>\<^sub>D F f, F w, d']"
                               "F r \<star>\<^sub>D \<a>\<^sub>D[F f, F w, d']"
                               "\<a>\<^sub>D[F r, F f \<star>\<^sub>D F w, d'] \<cdot>\<^sub>D (\<a>\<^sub>D[F r, F f, F w] \<star>\<^sub>D d')"]
                  by (simp add: w\<theta>\<nu>)
                thus ?thesis
                  using D.comp_assoc by simp
              qed
              also have "... = (F r \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D ((F r \<star>\<^sub>D F \<theta> \<star>\<^sub>D d') \<cdot>\<^sub>D \<a>\<^sub>D[F r, F (f \<star>\<^sub>C w), d']) \<cdot>\<^sub>D 
                                 ((F r \<star>\<^sub>D \<Phi> (f, w)) \<star>\<^sub>D d') \<cdot>\<^sub>D (\<a>\<^sub>D[F r, F f, F w] \<star>\<^sub>D d') \<cdot>\<^sub>D 
                                 ((D.inv (\<Phi> (r, f)) \<cdot>\<^sub>D F \<rho> \<star>\<^sub>D F w) \<star>\<^sub>D d') \<cdot>\<^sub>D
                                 (D.inv (\<Phi> (g, w)) \<cdot>\<^sub>D F \<nu> \<star>\<^sub>D d') \<cdot>\<^sub>D \<psi>'"
              proof -
                have "(F r \<star>\<^sub>D \<Phi> (f, w) \<star>\<^sub>D d') \<cdot>\<^sub>D \<a>\<^sub>D[F r, F f \<star>\<^sub>D F w, d'] =
                      \<a>\<^sub>D[F r, F (f \<star>\<^sub>C w), d'] \<cdot>\<^sub>D ((F r \<star>\<^sub>D \<Phi> (f, w)) \<star>\<^sub>D d')"
                  using 1 w\<theta>\<nu> D.assoc_naturality [of "F r" "\<Phi> (f, w)" d']
                        \<open>trg\<^sub>C w = src\<^sub>C f\<close> e'.ide_right
                  by (metis D.arrI D.hseq_char D.ide_char D.seqE T'.base_simps(3)
                      T'.base_simps(4) T'.leg0_simps(3) T.ide_leg0 cmp_simps(1-5) w'_def)
                thus ?thesis
                  using D.comp_assoc by simp
              qed
              also have "... = (F r \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D \<a>\<^sub>D[F r, F u, d'] \<cdot>\<^sub>D (((F r \<star>\<^sub>D F \<theta>) \<star>\<^sub>D d') \<cdot>\<^sub>D
                                 ((F r \<star>\<^sub>D \<Phi> (f, w)) \<star>\<^sub>D d') \<cdot>\<^sub>D (\<a>\<^sub>D[F r, F f, F w] \<star>\<^sub>D d') \<cdot>\<^sub>D 
                                 ((D.inv (\<Phi> (r, f)) \<cdot>\<^sub>D F \<rho> \<star>\<^sub>D F w) \<star>\<^sub>D d') \<cdot>\<^sub>D
                                 (D.inv (\<Phi> (g, w)) \<cdot>\<^sub>D F \<nu> \<star>\<^sub>D d')) \<cdot>\<^sub>D \<psi>'"
              proof -
                have "src\<^sub>D (F r) = trg\<^sub>D (F \<theta>)"
                  using w\<theta>\<nu> by (metis C.arrI C.hseqE C.seqE \<omega> preserves_hseq)
                moreover have "src\<^sub>D (F \<theta>) = trg\<^sub>D d'"
                  using w\<theta>\<nu> C.arrI C.vconn_implies_hpar(1) by auto
                ultimately
                have "(F r \<star>\<^sub>D F \<theta> \<star>\<^sub>D d') \<cdot>\<^sub>D \<a>\<^sub>D[F r, F (f \<star>\<^sub>C w), d'] =
                      \<a>\<^sub>D[F r, F u, d'] \<cdot>\<^sub>D ((F r \<star>\<^sub>D F \<theta>) \<star>\<^sub>D d')"
                  using w\<theta>\<nu> D.assoc_naturality [of "F r" "F \<theta>" d'] by auto
                thus ?thesis
                  using D.comp_assoc by simp
              qed
              also have "... = (F r \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D \<a>\<^sub>D[F r, F u, d'] \<cdot>\<^sub>D
                                 (((F r \<star>\<^sub>D F \<theta>) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<Phi> (f, w))) \<cdot>\<^sub>D \<a>\<^sub>D[F r, F f, F w] \<cdot>\<^sub>D 
                                 (D.inv (\<Phi> (r, f)) \<cdot>\<^sub>D F \<rho> \<star>\<^sub>D F w) \<cdot>\<^sub>D
                                 D.inv (\<Phi> (g, w)) \<cdot>\<^sub>D F \<nu> \<star>\<^sub>D d') \<cdot>\<^sub>D \<psi>'"
              proof -
                have "((F r \<star>\<^sub>D F \<theta>) \<star>\<^sub>D d') \<cdot>\<^sub>D
                        ((F r \<star>\<^sub>D \<Phi> (f, w)) \<star>\<^sub>D d') \<cdot>\<^sub>D (\<a>\<^sub>D[F r, F f, F w] \<star>\<^sub>D d') \<cdot>\<^sub>D 
                        ((D.inv (\<Phi> (r, f)) \<cdot>\<^sub>D F \<rho> \<star>\<^sub>D F w) \<star>\<^sub>D d') \<cdot>\<^sub>D
                        (D.inv (\<Phi> (g, w)) \<cdot>\<^sub>D F \<nu> \<star>\<^sub>D d') =
                      (F r \<star>\<^sub>D F \<theta>) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<Phi> (f, w)) \<cdot>\<^sub>D \<a>\<^sub>D[F r, F f, F w] \<cdot>\<^sub>D 
                        (D.inv (\<Phi> (r, f)) \<cdot>\<^sub>D F \<rho> \<star>\<^sub>D F w) \<cdot>\<^sub>D D.inv (\<Phi> (g, w)) \<cdot>\<^sub>D F \<nu>
                        \<star>\<^sub>D d'"
                proof -
                  have "\<guillemotleft>(F r \<star>\<^sub>D F \<theta>) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<Phi> (f, w)) \<cdot>\<^sub>D \<a>\<^sub>D[F r, F f, F w] \<cdot>\<^sub>D 
                           (D.inv (\<Phi> (r, f)) \<cdot>\<^sub>D F \<rho> \<star>\<^sub>D F w) \<cdot>\<^sub>D D.inv (\<Phi> (g, w)) \<cdot>\<^sub>D F \<nu> :
                             F v \<Rightarrow>\<^sub>D F r \<star>\<^sub>D F u\<guillemotright>"
                    using w\<theta>\<nu> \<omega> cmp_in_hom
                    apply (intro D.comp_in_homI)
                         apply auto
                    by (intro D.hcomp_in_vhom, auto)
                  hence "D.arr ((F r \<star>\<^sub>D F \<theta>) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<Phi> (f, w)) \<cdot>\<^sub>D \<a>\<^sub>D[F r, F f, F w] \<cdot>\<^sub>D 
                                 (D.inv (\<Phi> (r, f)) \<cdot>\<^sub>D F \<rho> \<star>\<^sub>D F w) \<cdot>\<^sub>D D.inv (\<Phi> (g, w)) \<cdot>\<^sub>D F \<nu>)"
                    by auto
                  thus ?thesis
                    using D.whisker_right by fastforce
                qed
                thus ?thesis
                  using D.comp_assoc by simp
              qed
              also have "... = (F r \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D \<a>\<^sub>D[F r, F u, d'] \<cdot>\<^sub>D
                                 ((F r \<star>\<^sub>D F \<theta> \<cdot>\<^sub>D \<Phi> (f, w)) \<cdot>\<^sub>D \<a>\<^sub>D[F r, F f, F w] \<cdot>\<^sub>D 
                                 (D.inv (\<Phi> (r, f)) \<cdot>\<^sub>D F \<rho> \<star>\<^sub>D F w) \<cdot>\<^sub>D
                                 D.inv (\<Phi> (g, w)) \<cdot>\<^sub>D F \<nu> \<star>\<^sub>D d') \<cdot>\<^sub>D \<psi>'"
                using w\<theta>\<nu> D.whisker_left cmp_in_hom
                by (metis D.seqI' T'.ide_base T.ide_leg0 \<open>trg\<^sub>C w = src\<^sub>C f\<close> preserves_hom)
              also have "... = (F r \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D \<a>\<^sub>D[F r, F u, d'] \<cdot>\<^sub>D
                                 ((D.inv (\<Phi> (r, u)) \<cdot>\<^sub>D \<Phi> (r, u) \<cdot>\<^sub>D
                                 (F r \<star>\<^sub>D F \<theta> \<cdot>\<^sub>D \<Phi> (f, w))) \<cdot>\<^sub>D \<a>\<^sub>D[F r, F f, F w] \<cdot>\<^sub>D 
                                 (D.inv (\<Phi> (r, f)) \<cdot>\<^sub>D F \<rho> \<star>\<^sub>D F w) \<cdot>\<^sub>D
                                 D.inv (\<Phi> (g, w)) \<cdot>\<^sub>D F \<nu> \<star>\<^sub>D d') \<cdot>\<^sub>D \<psi>'"
              proof -
                have "(D.inv (\<Phi> (r, u)) \<cdot>\<^sub>D \<Phi> (r, u)) \<cdot>\<^sub>D (F r \<star>\<^sub>D F \<theta> \<cdot>\<^sub>D \<Phi> (f, w)) =
                      F r \<star>\<^sub>D F \<theta> \<cdot>\<^sub>D \<Phi> (f, w)"
                proof -  
                  have "(D.inv (\<Phi> (r, u)) \<cdot>\<^sub>D \<Phi> (r, u)) \<cdot>\<^sub>D (F r \<star>\<^sub>D F \<theta> \<cdot>\<^sub>D \<Phi> (f, w)) =
                        (F r \<star>\<^sub>D F u) \<cdot>\<^sub>D (F r \<star>\<^sub>D F \<theta> \<cdot>\<^sub>D \<Phi> (f, w))"
                    using u cmp_components_are_iso
                    by (simp add: D.comp_inv_arr')
                  also have "... = F r \<star>\<^sub>D F \<theta> \<cdot>\<^sub>D \<Phi> (f, w)"
                    using u \<omega> w\<theta>\<nu> cmp_in_hom \<open>trg\<^sub>C u = src\<^sub>C r\<close>
                          D.comp_cod_arr [of "F r \<star>\<^sub>D F \<theta> \<cdot>\<^sub>D \<Phi> (f, w)" "F r \<star>\<^sub>D F u"]
                    by (metis (full_types) "*" D.arrI D.cod_comp D.seqE F\<omega> T.ide_base
                        cmp_simps(4))
                  finally show ?thesis by blast
                qed
                thus ?thesis
                  using D.comp_assoc by simp
               qed
              also have "... = (F r \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D \<a>\<^sub>D[F r, F u, d'] \<cdot>\<^sub>D
                               (D.inv (\<Phi> (r, u)) \<cdot>\<^sub>D \<Phi> (r, u) \<cdot>\<^sub>D (F r \<star>\<^sub>D F \<theta> \<cdot>\<^sub>D \<Phi> (f, w)) \<cdot>\<^sub>D
                                 \<a>\<^sub>D[F r, F f, F w] \<cdot>\<^sub>D (D.inv (\<Phi> (r, f)) \<cdot>\<^sub>D F \<rho> \<star>\<^sub>D F w) \<cdot>\<^sub>D
                                 D.inv (\<Phi> (g, w)) \<cdot>\<^sub>D F \<nu> \<star>\<^sub>D d') \<cdot>\<^sub>D \<psi>'"
                using D.comp_assoc by simp
              also have "... = (F r \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D \<a>\<^sub>D[F r, F u, d'] \<cdot>\<^sub>D (D.inv (\<Phi> (r, u)) \<star>\<^sub>D d') \<cdot>\<^sub>D
                                 (\<Phi> (r, u) \<cdot>\<^sub>D (F r \<star>\<^sub>D F \<theta> \<cdot>\<^sub>D \<Phi> (f, w)) \<cdot>\<^sub>D \<a>\<^sub>D[F r, F f, F w] \<cdot>\<^sub>D 
                                 (D.inv (\<Phi> (r, f)) \<cdot>\<^sub>D F \<rho> \<star>\<^sub>D F w) \<cdot>\<^sub>D
                                 D.inv (\<Phi> (g, w)) \<cdot>\<^sub>D F \<nu> \<star>\<^sub>D d') \<cdot>\<^sub>D \<psi>'"
              proof -
                have "D.inv (\<Phi> (r, u)) \<cdot>\<^sub>D \<Phi> (r, u) \<cdot>\<^sub>D (F r \<star>\<^sub>D F \<theta> \<cdot>\<^sub>D \<Phi> (f, w)) \<cdot>\<^sub>D
                                 \<a>\<^sub>D[F r, F f, F w] \<cdot>\<^sub>D (D.inv (\<Phi> (r, f)) \<cdot>\<^sub>D F \<rho> \<star>\<^sub>D F w) \<cdot>\<^sub>D
                                 D.inv (\<Phi> (g, w)) \<cdot>\<^sub>D F \<nu> \<star>\<^sub>D d' =
                      (D.inv (\<Phi> (r, u)) \<star>\<^sub>D d') \<cdot>\<^sub>D (\<Phi> (r, u) \<cdot>\<^sub>D (F r \<star>\<^sub>D F \<theta> \<cdot>\<^sub>D \<Phi> (f, w)) \<cdot>\<^sub>D
                                 \<a>\<^sub>D[F r, F f, F w] \<cdot>\<^sub>D (D.inv (\<Phi> (r, f)) \<cdot>\<^sub>D F \<rho> \<star>\<^sub>D F w) \<cdot>\<^sub>D
                                 D.inv (\<Phi> (g, w)) \<cdot>\<^sub>D F \<nu> \<star>\<^sub>D d')"
                  using D.whisker_right cmp_in_hom cmp_components_are_iso
                  by (metis * D.arrI D.invert_side_of_triangle(1) F\<omega> T.ide_base \<omega>
                       \<open>trg\<^sub>C u = src\<^sub>C r\<close> e'.ide_right u w\<theta>\<nu>)
                thus ?thesis
                   using D.comp_assoc by simp
              qed
              also have "... = (F r \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D \<a>\<^sub>D[F r, F u, d'] \<cdot>\<^sub>D (D.inv (\<Phi> (r, u)) \<star>\<^sub>D d') \<cdot>\<^sub>D
                                 (F (T.composite_cell w \<theta> \<cdot>\<^sub>C \<nu>) \<star>\<^sub>D d') \<cdot>\<^sub>D \<psi>'"
                using D.comp_assoc * by simp
             finally show ?thesis by simp
           qed
           also have "... = (F r \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D \<a>\<^sub>D[F r, F u, d'] \<cdot>\<^sub>D (D.inv (\<Phi> (r, u)) \<star>\<^sub>D d') \<cdot>\<^sub>D
                               (F \<omega> \<star>\<^sub>D d') \<cdot>\<^sub>D \<psi>'"
              using w\<theta>\<nu> by simp
            also have "... = (F r \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D \<a>\<^sub>D[F r, F u, d'] \<cdot>\<^sub>D (D.inv (\<Phi> (r, u)) \<star>\<^sub>D d') \<cdot>\<^sub>D
                               (\<Phi> (r, u) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<phi>) \<cdot>\<^sub>D \<a>\<^sub>D[F r, u', e'] \<cdot>\<^sub>D (\<omega>' \<star>\<^sub>D e') \<cdot>\<^sub>D \<psi> \<star>\<^sub>D d') \<cdot>\<^sub>D
                               \<psi>'"
               using \<omega> F\<omega>_def by simp
            text \<open>
$$
\xy/67pt/
\xymatrix{
  & {\scriptstyle{a'}}
  \xlowertwocell[ddddl]{}^{<2>F v}{^{\psi'}}
  \xuppertwocell[ddddr]{}^{<2>F u}{^{\phi'}}
  \ar@ {.}[dd] ^{d'}
  \\
  \\
  & \scriptstyle{{\rm src}(F a)} \xtwocell[ddd]{}\omit{^{F \omega}}
  \ar[ddl] _{F v}
  \ar[ddr] ^{F u}
  \\
  \\
  \scriptstyle{{\rm trg}~(F r)} & & \scriptstyle{{\rm src}~(F r)} \ar[ll] ^{F r}
  \\
  &
}
\endxy
\qquad = \qquad
\xy/67pt/
\xymatrix{
  &
  \xlowertwocell[ddddddl]{\scriptstyle{a'}}<-13>^{<2>v'}{^{\psi'}}
  \xuppertwocell[ddddddr]{}<13>^{<2>u'}{^{\phi'}}
  \ar@ {.}[dd] ^{d'}
  \\
  \\
  & {\scriptstyle{{\rm src}(F a)}}
  \xlowertwocell[ddddl]{}^{<2>F v}{^{\psi}}
  \xuppertwocell[ddddr]{}^{<2>F u}{^{\phi}}
  \ar@ {.}[dd] ^{e'}
  \\
  \\
  & \scriptstyle{a'} \xtwocell[ddd]{}\omit{^{\omega'}}
  \ar[ddl] _{v'}
  \ar[ddr] ^{u'}
  \\
  \\
  \scriptstyle{{\rm trg}~(F r)} & & \scriptstyle{{\rm src}~(F r)} \ar[ll] ^{F r}
  \\
  &
}
\endxy
$$
            \<close>
            also have "... = \<omega>'"
            text \<open>
$$
\xy/67pt/
\xymatrix{
  &
  \xlowertwocell[ddddddl]{\scriptstyle{a'}}<-13>^{<2>v'}{^{\psi'}}
  \xuppertwocell[ddddddr]{}<13>^{<2>u'}{^{\phi'}}
  \ar[dd] ^{d'}
  \\
  \\
  & {\scriptstyle{{\rm src}(F a)}}
  \xlowertwocell[ddddl]{}^{<2>F v}{^{\psi}}
  \xuppertwocell[ddddr]{}^{<2>F u}{^{\phi}}
  \ar[dd] ^{e'}
  \\
  \\
  & \scriptstyle{a'} \xtwocell[ddd]{}\omit{^{\omega'}}
  \ar[ddl] _{v'}
  \ar[ddr] ^{u'}
  \\
  \\
  \scriptstyle{{\rm trg}~(F r)} & & \scriptstyle{{\rm src}~(F r)} \ar[ll] ^{F r}
  \\
  &
}
\endxy
\qquad = \qquad
\xy/33pt/
\xymatrix{
  & \scriptstyle{a'} \xtwocell[ddd]{}\omit{^{\omega'}}
  \ar[ddl] _{v'}
  \ar[ddr] ^{u'}
  \\
  \\
  \scriptstyle{{\rm trg}~(F r)} & & \scriptstyle{{\rm src}~)(F r)} \ar[ll] ^{F r}
  \\
  &
}
\endxy
$$
            \<close>
            proof -
              have "(F r \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D \<a>\<^sub>D[F r, F u, d'] \<cdot>\<^sub>D (D.inv (\<Phi> (r, u)) \<star>\<^sub>D d') \<cdot>\<^sub>D
                      (\<Phi> (r, u) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<phi>) \<cdot>\<^sub>D \<a>\<^sub>D[F r, u', e'] \<cdot>\<^sub>D (\<omega>' \<star>\<^sub>D e') \<cdot>\<^sub>D \<psi> \<star>\<^sub>D d') \<cdot>\<^sub>D \<psi>' =
                    (F r \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D \<a>\<^sub>D[F r, F u, d'] \<cdot>\<^sub>D
                      ((D.inv (\<Phi> (r, u)) \<star>\<^sub>D d') \<cdot>\<^sub>D (\<Phi> (r, u) \<star>\<^sub>D d')) \<cdot>\<^sub>D
                      ((F r \<star>\<^sub>D \<phi>) \<cdot>\<^sub>D \<a>\<^sub>D[F r, u', e'] \<cdot>\<^sub>D (\<omega>' \<star>\<^sub>D e') \<cdot>\<^sub>D \<psi> \<star>\<^sub>D d') \<cdot>\<^sub>D \<psi>'"
                using D.whisker_right cmp_in_hom D.comp_assoc
                by (metis D.arrI F\<omega> F\<omega>_def e'.ide_right)
              also have "... = (F r \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D \<a>\<^sub>D[F r, F u, d'] \<cdot>\<^sub>D
                                 ((F r \<star>\<^sub>D \<phi>) \<cdot>\<^sub>D \<a>\<^sub>D[F r, u', e'] \<cdot>\<^sub>D (\<omega>' \<star>\<^sub>D e') \<cdot>\<^sub>D \<psi> \<star>\<^sub>D d') \<cdot>\<^sub>D \<psi>'"
               proof -
                 have "(D.inv (\<Phi> (r, u)) \<star>\<^sub>D d') \<cdot>\<^sub>D (\<Phi> (r, u) \<star>\<^sub>D d') =
                       D.inv (\<Phi> (r, u)) \<cdot>\<^sub>D \<Phi> (r, u) \<star>\<^sub>D d'"
                   using cmp_in_hom cmp_components_are_iso D.whisker_right
                   by (metis C.hseqI D.comp_arr_inv' D.in_homE D.invert_opposite_sides_of_square
                       D.iso_inv_iso T.ide_base T.base_in_hom(1) \<open>trg\<^sub>C u = src\<^sub>C r\<close> e'.ide_right
                       preserves_arr u)
                 also have "... = (F r \<star>\<^sub>D F u) \<star>\<^sub>D d'"
                   using u cmp_components_are_iso D.comp_inv_arr' by simp
                 finally have "(F r \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D \<a>\<^sub>D[F r, F u, d'] \<cdot>\<^sub>D
                                 ((D.inv (\<Phi> (r, u)) \<star>\<^sub>D d') \<cdot>\<^sub>D (\<Phi> (r, u) \<star>\<^sub>D d')) \<cdot>\<^sub>D
                                 ((F r \<star>\<^sub>D \<phi>) \<cdot>\<^sub>D \<a>\<^sub>D[F r, u', e'] \<cdot>\<^sub>D (\<omega>' \<star>\<^sub>D e') \<cdot>\<^sub>D \<psi> \<star>\<^sub>D d') \<cdot>\<^sub>D \<psi>' =
                               (F r \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D \<a>\<^sub>D[F r, F u, d'] \<cdot>\<^sub>D ((F r \<star>\<^sub>D F u) \<star>\<^sub>D d') \<cdot>\<^sub>D
                                 ((F r \<star>\<^sub>D \<phi>) \<cdot>\<^sub>D \<a>\<^sub>D[F r, u', e'] \<cdot>\<^sub>D (\<omega>' \<star>\<^sub>D e') \<cdot>\<^sub>D \<psi> \<star>\<^sub>D d') \<cdot>\<^sub>D \<psi>'"
                   by simp
                 also have "... = (F r \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D (\<a>\<^sub>D[F r, F u, d'] \<cdot>\<^sub>D ((F r \<star>\<^sub>D F u) \<star>\<^sub>D d')) \<cdot>\<^sub>D
                                    ((F r \<star>\<^sub>D \<phi>) \<cdot>\<^sub>D \<a>\<^sub>D[F r, u', e'] \<cdot>\<^sub>D (\<omega>' \<star>\<^sub>D e') \<cdot>\<^sub>D \<psi> \<star>\<^sub>D d') \<cdot>\<^sub>D \<psi>'"
                   using D.comp_assoc by auto
                 also have "... = (F r \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D \<a>\<^sub>D[F r, F u, d'] \<cdot>\<^sub>D
                                  ((F r \<star>\<^sub>D \<phi>) \<cdot>\<^sub>D \<a>\<^sub>D[F r, u', e'] \<cdot>\<^sub>D (\<omega>' \<star>\<^sub>D e') \<cdot>\<^sub>D \<psi> \<star>\<^sub>D d') \<cdot>\<^sub>D \<psi>'"
                   using u D.comp_arr_dom by simp
                 finally show ?thesis by blast
               qed
              also have "... = (F r \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D (\<a>\<^sub>D[F r, F u, d'] \<cdot>\<^sub>D
                                  ((F r \<star>\<^sub>D \<phi>) \<star>\<^sub>D d')) \<cdot>\<^sub>D (\<a>\<^sub>D[F r, u', e'] \<star>\<^sub>D d') \<cdot>\<^sub>D
                                  ((\<omega>' \<star>\<^sub>D e') \<star>\<^sub>D d') \<cdot>\<^sub>D (\<psi> \<star>\<^sub>D d') \<cdot>\<^sub>D \<psi>'"
               proof -
                 have
                   "(F r \<star>\<^sub>D \<phi>) \<cdot>\<^sub>D \<a>\<^sub>D[F r, u', e'] \<cdot>\<^sub>D (\<omega>' \<star>\<^sub>D e') \<cdot>\<^sub>D \<psi> \<star>\<^sub>D d' =
                    ((F r \<star>\<^sub>D \<phi>) \<star>\<^sub>D d') \<cdot>\<^sub>D (\<a>\<^sub>D[F r, u', e'] \<star>\<^sub>D d') \<cdot>\<^sub>D ((\<omega>' \<star>\<^sub>D e') \<star>\<^sub>D d') \<cdot>\<^sub>D (\<psi> \<star>\<^sub>D d')"
                   using D.whisker_right \<phi> \<phi>' e' e'.antipar(1) u' u'_in_hhom
                   by (metis D.arrI D.seqE F\<omega> F\<omega>_def e'.ide_right)
                 thus ?thesis
                   using D.comp_assoc by simp
               qed
              also have "... = (F r \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D (F r \<star>\<^sub>D \<phi> \<star>\<^sub>D d') \<cdot>\<^sub>D \<a>\<^sub>D[F r, u' \<star>\<^sub>D e', d'] \<cdot>\<^sub>D
                                  ((\<a>\<^sub>D[F r, u', e'] \<star>\<^sub>D d') \<cdot>\<^sub>D ((\<omega>' \<star>\<^sub>D e') \<star>\<^sub>D d')) \<cdot>\<^sub>D (\<psi> \<star>\<^sub>D d') \<cdot>\<^sub>D \<psi>'"
               proof -
                 have "\<a>\<^sub>D[F r, F u, d'] \<cdot>\<^sub>D ((F r \<star>\<^sub>D \<phi>) \<star>\<^sub>D d') =
                       (F r \<star>\<^sub>D \<phi> \<star>\<^sub>D d') \<cdot>\<^sub>D \<a>\<^sub>D[F r, u' \<star>\<^sub>D e', d']"
                   using D.assoc_naturality [of "F r" \<phi> d'] \<phi> by auto
                 thus ?thesis
                   using D.comp_assoc by simp
               qed
              also have "... = (F r \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D (F r \<star>\<^sub>D \<phi> \<star>\<^sub>D d') \<cdot>\<^sub>D \<a>\<^sub>D[F r, u' \<star>\<^sub>D e', d'] \<cdot>\<^sub>D
                                 ((\<a>\<^sub>D[F r, u', e'] \<star>\<^sub>D d') \<cdot>\<^sub>D (\<a>\<^sub>D\<^sup>-\<^sup>1[F r \<star>\<^sub>D u', e', d'] \<cdot>\<^sub>D
                                 (\<omega>' \<star>\<^sub>D e' \<star>\<^sub>D d') \<cdot>\<^sub>D \<a>\<^sub>D[v', e', d'])) \<cdot>\<^sub>D (\<psi> \<star>\<^sub>D d') \<cdot>\<^sub>D \<psi>'"
                using F\<omega> F\<omega>_def \<omega>' D.comp_assoc D.hcomp_reassoc(1) [of \<omega>' e' d']
                by (elim D.in_homE, simp)
              also have "... = (F r \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D (F r \<star>\<^sub>D \<phi> \<star>\<^sub>D d') \<cdot>\<^sub>D (F r \<star>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[u', e', d']) \<cdot>\<^sub>D
                                  \<a>\<^sub>D[F r, u', e' \<star>\<^sub>D d'] \<cdot>\<^sub>D (\<omega>' \<star>\<^sub>D e' \<star>\<^sub>D d') \<cdot>\<^sub>D \<a>\<^sub>D[v', e', d'] \<cdot>\<^sub>D
                                  (\<psi> \<star>\<^sub>D d') \<cdot>\<^sub>D \<psi>'"
               proof -
                 have "D.seq (F r \<star>\<^sub>D \<a>\<^sub>D[u', e', d'])
                             (\<a>\<^sub>D[F r, u' \<star>\<^sub>D e', d'] \<cdot>\<^sub>D (\<a>\<^sub>D[F r, u', e'] \<star>\<^sub>D d'))"
                   using u' by simp
                 moreover have "(F r \<star>\<^sub>D \<a>\<^sub>D[u', e', d']) \<cdot>\<^sub>D \<a>\<^sub>D[F r, u' \<star>\<^sub>D e', d'] \<cdot>\<^sub>D
                                  (\<a>\<^sub>D[F r, u', e'] \<star>\<^sub>D d') =
                                \<a>\<^sub>D[F r, u', e' \<star>\<^sub>D d'] \<cdot>\<^sub>D \<a>\<^sub>D[F r \<star>\<^sub>D u', e', d']"
                   using u' D.pentagon by simp
                 moreover have "D.iso (F r \<star>\<^sub>D \<a>\<^sub>D[u', e', d'])"
                   using u' by simp
                 moreover have "D.inv (F r \<star>\<^sub>D \<a>\<^sub>D[u', e', d']) = F r \<star>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[u', e', d']"
                   using u' by simp
                 ultimately
                 have "\<a>\<^sub>D[F r, u' \<star>\<^sub>D e', d'] \<cdot>\<^sub>D (\<a>\<^sub>D[F r, u', e'] \<star>\<^sub>D d') \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F r \<star>\<^sub>D u', e', d'] =
                         (F r \<star>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[u', e', d']) \<cdot>\<^sub>D \<a>\<^sub>D[F r, u', e' \<star>\<^sub>D d']"
                   using u' D.comp_assoc
                         D.invert_opposite_sides_of_square
                           [of "F r \<star>\<^sub>D \<a>\<^sub>D[u', e', d']"
                               "\<a>\<^sub>D[F r, u' \<star>\<^sub>D e', d'] \<cdot>\<^sub>D (\<a>\<^sub>D[F r, u', e'] \<star>\<^sub>D d')"
                               "\<a>\<^sub>D[F r, u', e' \<star>\<^sub>D d']" "\<a>\<^sub>D[F r \<star>\<^sub>D u', e', d']"]
                   by simp
                 thus ?thesis
                   using D.comp_assoc by metis
               qed
              also have
                "... = (F r \<star>\<^sub>D \<r>\<^sub>D[u'] \<cdot>\<^sub>D (u' \<star>\<^sub>D \<epsilon>') \<cdot>\<^sub>D \<a>\<^sub>D[u', e', d'] \<cdot>\<^sub>D (D.inv \<phi> \<star>\<^sub>D d')) \<cdot>\<^sub>D
                         (F r \<star>\<^sub>D \<phi> \<star>\<^sub>D d') \<cdot>\<^sub>D (F r \<star>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[u', e', d']) \<cdot>\<^sub>D \<a>\<^sub>D[F r, u', e' \<star>\<^sub>D d'] \<cdot>\<^sub>D
                         (\<omega>' \<star>\<^sub>D e' \<star>\<^sub>D d') \<cdot>\<^sub>D \<a>\<^sub>D[v', e', d'] \<cdot>\<^sub>D (\<psi> \<star>\<^sub>D d') \<cdot>\<^sub>D (D.inv \<psi> \<star>\<^sub>D d') \<cdot>\<^sub>D
                         \<a>\<^sub>D\<^sup>-\<^sup>1[v', e', d'] \<cdot>\<^sub>D (v' \<star>\<^sub>D D.inv \<epsilon>') \<cdot>\<^sub>D \<r>\<^sub>D\<^sup>-\<^sup>1[v']"
                unfolding \<phi>'_def \<psi>'_def e'.trnr\<^sub>\<epsilon>_def d'.trnr\<^sub>\<eta>_def by simp
              also have
                "... = (F r \<star>\<^sub>D \<r>\<^sub>D[u']) \<cdot>\<^sub>D (F r \<star>\<^sub>D u' \<star>\<^sub>D \<epsilon>') \<cdot>\<^sub>D (F r \<star>\<^sub>D \<a>\<^sub>D[u', e', d']) \<cdot>\<^sub>D
                         (F r \<star>\<^sub>D D.inv \<phi> \<star>\<^sub>D d') \<cdot>\<^sub>D (F r \<star>\<^sub>D \<phi> \<star>\<^sub>D d') \<cdot>\<^sub>D
                         (F r \<star>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[u', e', d']) \<cdot>\<^sub>D \<a>\<^sub>D[F r, u', e' \<star>\<^sub>D d'] \<cdot>\<^sub>D (\<omega>' \<star>\<^sub>D e' \<star>\<^sub>D d') \<cdot>\<^sub>D
                         \<a>\<^sub>D[v', e', d'] \<cdot>\<^sub>D (\<psi> \<star>\<^sub>D d') \<cdot>\<^sub>D (D.inv \<psi> \<star>\<^sub>D d') \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[v', e', d'] \<cdot>\<^sub>D
                         (v' \<star>\<^sub>D D.inv \<epsilon>') \<cdot>\<^sub>D \<r>\<^sub>D\<^sup>-\<^sup>1[v']"
              proof -
                have "F r \<star>\<^sub>D \<r>\<^sub>D[u'] \<cdot>\<^sub>D (u' \<star>\<^sub>D \<epsilon>') \<cdot>\<^sub>D \<a>\<^sub>D[u', e', d'] \<cdot>\<^sub>D (D.inv \<phi> \<star>\<^sub>D d') =
                      (F r \<star>\<^sub>D \<r>\<^sub>D[u']) \<cdot>\<^sub>D (F r \<star>\<^sub>D u' \<star>\<^sub>D \<epsilon>') \<cdot>\<^sub>D (F r \<star>\<^sub>D \<a>\<^sub>D[u', e', d']) \<cdot>\<^sub>D
                        (F r \<star>\<^sub>D D.inv \<phi> \<star>\<^sub>D d')"
                proof -
                  have "D.ide (F r)" by simp
                  moreover have "D.seq \<r>\<^sub>D[u'] ((u' \<star>\<^sub>D \<epsilon>') \<cdot>\<^sub>D \<a>\<^sub>D[u', e', d'] \<cdot>\<^sub>D (D.inv \<phi> \<star>\<^sub>D d')) \<and>
                                 D.seq (u' \<star>\<^sub>D \<epsilon>') (\<a>\<^sub>D[u', e', d'] \<cdot>\<^sub>D (D.inv \<phi> \<star>\<^sub>D d')) \<and>
                                 D.seq \<a>\<^sub>D[u', e', d'] (D.inv \<phi> \<star>\<^sub>D d')"
                    using \<phi>' \<phi>'_def unfolding e'.trnr\<^sub>\<epsilon>_def by blast
                  ultimately show ?thesis
                    using D.whisker_left by metis
                qed
                thus ?thesis
                  using D.comp_assoc by simp
              qed
              also have
                "... = (F r \<star>\<^sub>D \<r>\<^sub>D[u']) \<cdot>\<^sub>D (F r \<star>\<^sub>D u' \<star>\<^sub>D \<epsilon>') \<cdot>\<^sub>D (F r \<star>\<^sub>D \<a>\<^sub>D[u', e', d']) \<cdot>\<^sub>D
                         (((F r \<star>\<^sub>D D.inv \<phi> \<star>\<^sub>D d') \<cdot>\<^sub>D (F r \<star>\<^sub>D \<phi> \<star>\<^sub>D d')) \<cdot>\<^sub>D
                         (F r \<star>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[u', e', d'])) \<cdot>\<^sub>D \<a>\<^sub>D[F r, u', e' \<star>\<^sub>D d'] \<cdot>\<^sub>D (\<omega>' \<star>\<^sub>D e' \<star>\<^sub>D d') \<cdot>\<^sub>D
                         \<a>\<^sub>D[v', e', d'] \<cdot>\<^sub>D (((\<psi> \<star>\<^sub>D d') \<cdot>\<^sub>D (D.inv \<psi> \<star>\<^sub>D d')) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[v', e', d']) \<cdot>\<^sub>D
                         (v' \<star>\<^sub>D D.inv \<epsilon>') \<cdot>\<^sub>D \<r>\<^sub>D\<^sup>-\<^sup>1[v']"
                using D.comp_assoc by simp
              also have
                "... = (F r \<star>\<^sub>D \<r>\<^sub>D[u']) \<cdot>\<^sub>D (F r \<star>\<^sub>D u' \<star>\<^sub>D \<epsilon>') \<cdot>\<^sub>D (F r \<star>\<^sub>D \<a>\<^sub>D[u', e', d']) \<cdot>\<^sub>D
                         (F r \<star>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[u', e', d']) \<cdot>\<^sub>D \<a>\<^sub>D[F r, u', e' \<star>\<^sub>D d'] \<cdot>\<^sub>D (\<omega>' \<star>\<^sub>D e' \<star>\<^sub>D d') \<cdot>\<^sub>D
                         ((\<a>\<^sub>D[v', e', d'] \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[v', e', d']) \<cdot>\<^sub>D (v' \<star>\<^sub>D D.inv \<epsilon>')) \<cdot>\<^sub>D \<r>\<^sub>D\<^sup>-\<^sup>1[v']"
              proof -
                have "((F r \<star>\<^sub>D D.inv \<phi> \<star>\<^sub>D d') \<cdot>\<^sub>D (F r \<star>\<^sub>D \<phi> \<star>\<^sub>D d')) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[u', e', d']) =
                      F r \<star>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[u', e', d']"
                proof -
                have "(F r \<star>\<^sub>D D.inv \<phi> \<star>\<^sub>D d') \<cdot>\<^sub>D (F r \<star>\<^sub>D \<phi> \<star>\<^sub>D d') = F r \<star>\<^sub>D D.inv \<phi> \<cdot>\<^sub>D \<phi> \<star>\<^sub>D d'"
                  using u u' \<phi> 1 2 D.src_dom e'.antipar D.whisker_left D.whisker_right
                  by auto
                also have "... = F r \<star>\<^sub>D (u' \<star>\<^sub>D e') \<star>\<^sub>D d'"
                  using \<phi> D.comp_inv_arr' by auto
                finally have
                  "(F r \<star>\<^sub>D D.inv \<phi> \<star>\<^sub>D d') \<cdot>\<^sub>D (F r \<star>\<^sub>D \<phi> \<star>\<^sub>D d') = F r \<star>\<^sub>D (u' \<star>\<^sub>D e') \<star>\<^sub>D d'"
                  by simp
                hence
                  "((F r \<star>\<^sub>D D.inv \<phi> \<star>\<^sub>D d') \<cdot>\<^sub>D (F r \<star>\<^sub>D \<phi> \<star>\<^sub>D d')) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[u', e', d']) =
                   (F r \<star>\<^sub>D (u' \<star>\<^sub>D e') \<star>\<^sub>D d') \<cdot>\<^sub>D (F r \<star>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[u', e', d'])"
                  using D.comp_assoc by simp
                also have "... = F r \<star>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[u', e', d']"
                proof -
                  have "\<guillemotleft>F r \<star>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[u', e', d'] :
                            F r \<star>\<^sub>D u' \<star>\<^sub>D e' \<star>\<^sub>D d' \<Rightarrow>\<^sub>D F r \<star>\<^sub>D (u' \<star>\<^sub>D e') \<star>\<^sub>D d'\<guillemotright>"
                    using u' e'.antipar \<phi>' D.assoc'_in_hom
                    unfolding e'.trnr\<^sub>\<epsilon>_def
                    by (intro D.hcomp_in_vhom, auto)
                  thus ?thesis
                    using D.comp_cod_arr by blast
                qed
                finally show ?thesis by simp
              qed
              moreover have
                "((\<psi> \<star>\<^sub>D d') \<cdot>\<^sub>D (D.inv \<psi> \<star>\<^sub>D d')) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[v', e', d'] = \<a>\<^sub>D\<^sup>-\<^sup>1[v', e', d']"
              proof -
                have "(\<psi> \<star>\<^sub>D d') \<cdot>\<^sub>D (D.inv \<psi> \<star>\<^sub>D d') = (v' \<star>\<^sub>D e') \<star>\<^sub>D d'"
                  using \<psi> e'.antipar D.src_cod v' e'.antipar \<psi>' d'.trnr\<^sub>\<eta>_def
                        D.whisker_right [of d' \<psi> "D.inv \<psi>"] D.comp_arr_inv'
                  by auto
                moreover have "\<guillemotleft>\<a>\<^sub>D\<^sup>-\<^sup>1[v', e', d'] : v' \<star>\<^sub>D e' \<star>\<^sub>D d' \<Rightarrow>\<^sub>D (v' \<star>\<^sub>D e') \<star>\<^sub>D d'\<guillemotright>"
                  using v' e'.antipar \<psi>' D.assoc'_in_hom
                  unfolding d'.trnr\<^sub>\<eta>_def
                  by fastforce
                ultimately show ?thesis
                  using D.comp_cod_arr by auto
              qed
              ultimately show ?thesis
                using D.comp_assoc by simp
            qed
              also have "... = (F r \<star>\<^sub>D \<r>\<^sub>D[u']) \<cdot>\<^sub>D (F r \<star>\<^sub>D u' \<star>\<^sub>D \<epsilon>') \<cdot>\<^sub>D (((F r \<star>\<^sub>D \<a>\<^sub>D[u', e', d']) \<cdot>\<^sub>D
                               (F r \<star>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[u', e', d'])) \<cdot>\<^sub>D \<a>\<^sub>D[F r, u', e' \<star>\<^sub>D d']) \<cdot>\<^sub>D
                               (\<omega>' \<star>\<^sub>D e' \<star>\<^sub>D d') \<cdot>\<^sub>D (v' \<star>\<^sub>D D.inv \<epsilon>') \<cdot>\<^sub>D \<r>\<^sub>D\<^sup>-\<^sup>1[v']"
              proof -
                have "(\<a>\<^sub>D[v', e', d'] \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[v', e', d']) \<cdot>\<^sub>D (v' \<star>\<^sub>D D.inv \<epsilon>') = v' \<star>\<^sub>D D.inv \<epsilon>'"
                proof -
                  have 1: "D.hseq v' e'"
                    using v' e'.antipar \<psi>' unfolding d'.trnr\<^sub>\<eta>_def by fastforce
                  have "\<a>\<^sub>D[v', e', d'] \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[v', e', d'] = v' \<star>\<^sub>D e' \<star>\<^sub>D d'"
                    using v' e'.antipar 1 D.comp_assoc_assoc' by auto
                  moreover have "\<guillemotleft>v' \<star>\<^sub>D D.inv \<epsilon>' : v' \<star>\<^sub>D trg\<^sub>D e' \<Rightarrow>\<^sub>D v' \<star>\<^sub>D e' \<star>\<^sub>D d'\<guillemotright>"
                    using v' e'.antipar 1
                    apply (intro D.hcomp_in_vhom)
                      apply auto
                    by (metis D.ideD(1) D.trg_src \<open>trg\<^sub>D e' = a'\<close> e'.antipar(2) e'.ide_right)
                  ultimately show ?thesis
                    using D.comp_cod_arr by auto
                qed
                thus ?thesis
                  using D.comp_assoc by simp
              qed
              also have "... = (F r \<star>\<^sub>D \<r>\<^sub>D[u']) \<cdot>\<^sub>D ((F r \<star>\<^sub>D u' \<star>\<^sub>D \<epsilon>') \<cdot>\<^sub>D \<a>\<^sub>D[F r, u', e' \<star>\<^sub>D d']) \<cdot>\<^sub>D
                               (\<omega>' \<star>\<^sub>D e' \<star>\<^sub>D d') \<cdot>\<^sub>D (v' \<star>\<^sub>D D.inv \<epsilon>') \<cdot>\<^sub>D \<r>\<^sub>D\<^sup>-\<^sup>1[v']"
              proof -
                have "((F r \<star>\<^sub>D \<a>\<^sub>D[u', e', d']) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[u', e', d'])) \<cdot>\<^sub>D
                        \<a>\<^sub>D[F r, u', e' \<star>\<^sub>D d'] =
                      \<a>\<^sub>D[F r, u', e' \<star>\<^sub>D d']"
                  using \<phi> u' e'.antipar 1 D.comp_cod_arr D.comp_assoc_assoc'
                        D.whisker_left [of "F r" "\<a>\<^sub>D[u', e', d']" "\<a>\<^sub>D\<^sup>-\<^sup>1[u', e', d']"]
                  by auto
                thus ?thesis
                using D.comp_assoc by simp
              qed
              also have "... = (F r \<star>\<^sub>D \<r>\<^sub>D[u']) \<cdot>\<^sub>D \<a>\<^sub>D[F r, u', trg\<^sub>D e'] \<cdot>\<^sub>D (((F r \<star>\<^sub>D u') \<star>\<^sub>D \<epsilon>') \<cdot>\<^sub>D
                               (\<omega>' \<star>\<^sub>D e' \<star>\<^sub>D d')) \<cdot>\<^sub>D (v' \<star>\<^sub>D D.inv \<epsilon>') \<cdot>\<^sub>D \<r>\<^sub>D\<^sup>-\<^sup>1[v']"
              proof -
                have "(F r \<star>\<^sub>D u' \<star>\<^sub>D \<epsilon>') \<cdot>\<^sub>D \<a>\<^sub>D[F r, u', e' \<star>\<^sub>D d'] =
                      \<a>\<^sub>D[F r, u', trg\<^sub>D e'] \<cdot>\<^sub>D ((F r \<star>\<^sub>D u') \<star>\<^sub>D \<epsilon>')"
                  using D.assoc_naturality [of "F r" u' \<epsilon>'] e' u' u'_in_hhom by force
                thus ?thesis
                  using D.comp_assoc by simp
              qed
              also have "... = (F r \<star>\<^sub>D \<r>\<^sub>D[u']) \<cdot>\<^sub>D \<a>\<^sub>D[F r, u', trg\<^sub>D e'] \<cdot>\<^sub>D (\<omega>' \<star>\<^sub>D trg\<^sub>D e') \<cdot>\<^sub>D
                               ((v' \<star>\<^sub>D \<epsilon>') \<cdot>\<^sub>D (v' \<star>\<^sub>D D.inv \<epsilon>')) \<cdot>\<^sub>D \<r>\<^sub>D\<^sup>-\<^sup>1[v']"
              proof -
                have "((F r \<star>\<^sub>D u') \<star>\<^sub>D \<epsilon>') \<cdot>\<^sub>D (\<omega>' \<star>\<^sub>D e' \<star>\<^sub>D d') = (\<omega>' \<star>\<^sub>D trg\<^sub>D e') \<cdot>\<^sub>D (v' \<star>\<^sub>D \<epsilon>')"
                proof -
                  have "((F r \<star>\<^sub>D u') \<star>\<^sub>D \<epsilon>') \<cdot>\<^sub>D (\<omega>' \<star>\<^sub>D e' \<star>\<^sub>D d') =
                        ((F r \<star>\<^sub>D u') \<cdot>\<^sub>D \<omega>' \<star>\<^sub>D \<epsilon>' \<cdot>\<^sub>D (e' \<star>\<^sub>D d'))"
                    using D.interchange
                    by (metis D.comp_arr_dom D.hcomp_simps(3) D.hseqI D.ide_char D.in_hhomE
                        D.in_homE D.seqI T'.base_in_hom(1) T'.base_simps(3) T.base_simps(2)
                        \<omega>' e'.counit_simps(1) e'.counit_simps(2) preserves_src u' u'_in_hhom)
                  also have "... = \<omega>' \<cdot>\<^sub>D v' \<star>\<^sub>D trg\<^sub>D e' \<cdot>\<^sub>D \<epsilon>'"
                    using \<omega>' D.comp_arr_dom D.comp_cod_arr by auto
                  also have "... = (\<omega>' \<star>\<^sub>D trg\<^sub>D e') \<cdot>\<^sub>D (v' \<star>\<^sub>D \<epsilon>')"
                    using D.interchange
                    by (metis D.arrI D.comp_cod_arr D.ide_char D.seqI \<omega>' \<open>trg\<^sub>D e' = a'\<close>
                        e'.counit_simps(1) e'.counit_simps(3) e'.counit_simps(5) v' v'_def)
                  finally show ?thesis by simp
                qed
                thus ?thesis
                  using D.comp_assoc by simp
              qed
              also have "... = (F r \<star>\<^sub>D \<r>\<^sub>D[u']) \<cdot>\<^sub>D \<a>\<^sub>D[F r, u', trg\<^sub>D e'] \<cdot>\<^sub>D (\<omega>' \<star>\<^sub>D trg\<^sub>D e') \<cdot>\<^sub>D \<r>\<^sub>D\<^sup>-\<^sup>1[v']"
              proof -
                have "(v' \<star>\<^sub>D \<epsilon>') \<cdot>\<^sub>D (v' \<star>\<^sub>D D.inv \<epsilon>') = v' \<star>\<^sub>D trg\<^sub>D e'"
                  using v' D.whisker_left D.comp_arr_inv D.inv_is_inverse
                  by (metis D.comp_arr_inv' D.seqI' d'.unit_in_vhom e'.counit_in_hom(2)
                      e'.counit_is_iso e'.counit_simps(3))
                moreover have "\<guillemotleft>\<r>\<^sub>D\<^sup>-\<^sup>1[v'] : v' \<Rightarrow>\<^sub>D v' \<star>\<^sub>D trg\<^sub>D e'\<guillemotright>"
                  using v' 1 by simp
                ultimately show ?thesis
                using v' D.comp_cod_arr by auto
              qed
              also have "... = (F r \<star>\<^sub>D \<r>\<^sub>D[u']) \<cdot>\<^sub>D (\<a>\<^sub>D[F r, u', trg\<^sub>D e'] \<cdot>\<^sub>D \<r>\<^sub>D\<^sup>-\<^sup>1[F r \<star>\<^sub>D u']) \<cdot>\<^sub>D \<omega>'"
                using u' v' \<omega>' D.runit'_naturality D.comp_assoc
                by (metis D.in_hhomE D.in_homE a'_def e')
              also have "... = (F r \<star>\<^sub>D \<r>\<^sub>D[u']) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<r>\<^sub>D\<^sup>-\<^sup>1[u']) \<cdot>\<^sub>D \<omega>'"
                using 1 T'.ide_base u' D.runit_hcomp [of "F r" u'] by fastforce
              also have "... = ((F r \<star>\<^sub>D \<r>\<^sub>D[u']) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<r>\<^sub>D\<^sup>-\<^sup>1[u'])) \<cdot>\<^sub>D \<omega>'"
                using D.comp_assoc by simp
              also have "... = (F r \<star>\<^sub>D \<r>\<^sub>D[u'] \<cdot>\<^sub>D \<r>\<^sub>D\<^sup>-\<^sup>1[u']) \<cdot>\<^sub>D \<omega>'"
                using 1 T'.ide_base u' D.whisker_left by simp
              also have "... = (F r \<star>\<^sub>D u') \<cdot>\<^sub>D \<omega>'"
                using u'
                by (metis D.comp_ide_self D.ide_in_hom(2) D.ide_is_iso
                  D.invert_opposite_sides_of_square D.invert_side_of_triangle(1)
                  D.iso_runit D.runit_in_vhom D.seqI')
              also have "... = \<omega>'"
                using \<omega>' D.comp_cod_arr by auto
              finally show ?thesis by simp
            qed
            finally show ?thesis by simp
          qed
          thus "\<exists>w' \<theta>' \<nu>'. D.ide w' \<and>  \<guillemotleft>\<theta>' : F f \<star>\<^sub>D w' \<Rightarrow>\<^sub>D u'\<guillemotright> \<and>
                    \<guillemotleft>\<nu>' : D.dom \<omega>' \<Rightarrow>\<^sub>D F g \<star>\<^sub>D w'\<guillemotright> \<and> D.iso \<nu>' \<and> T'.composite_cell w' \<theta>' \<cdot>\<^sub>D \<nu>' = \<omega>'"
            using w' \<theta>' \<nu>' iso_\<nu>' v'_def by blast
        qed

        text \<open>Now we establish \<open>T'.T2\<close>.\<close>
        next
        fix u w w' \<theta> \<theta>' \<beta>
        assume w: "D.ide w"
        assume w': "D.ide w'"
        assume \<theta>: "\<guillemotleft>\<theta> : F f \<star>\<^sub>D w \<Rightarrow>\<^sub>D u\<guillemotright>"
        assume \<theta>': "\<guillemotleft>\<theta>' : F f \<star>\<^sub>D w' \<Rightarrow>\<^sub>D u\<guillemotright>"
        assume \<beta>: "\<guillemotleft>\<beta> : F g \<star>\<^sub>D w \<Rightarrow>\<^sub>D F g \<star>\<^sub>D w'\<guillemotright>"
        assume eq: "T'.composite_cell w \<theta> = T'.composite_cell w' \<theta>' \<cdot>\<^sub>D \<beta>"
        show "\<exists>!\<gamma>. \<guillemotleft>\<gamma> : w \<Rightarrow>\<^sub>D w'\<guillemotright> \<and> \<beta> = F g \<star>\<^sub>D \<gamma> \<and> \<theta> = \<theta>' \<cdot>\<^sub>D (F f \<star>\<^sub>D \<gamma>)"
        proof -
          define a where "a = src\<^sub>D w"
          have a: "D.obj a"
            unfolding a_def by (simp add: w)

          have [simp]: "src\<^sub>D \<theta> = a"
            using \<theta> a_def
            by (metis D.dom_src D.in_homE D.src.preserves_dom D.src.preserves_reflects_arr
              D.src_hcomp)
          have [simp]: "trg\<^sub>D \<theta> = trg\<^sub>D (F f)"
            using \<theta>
            by (metis D.arr_dom D.in_homE D.trg_hcomp D.vconn_implies_hpar(2))
          have [simp]: "src\<^sub>D \<theta>' = a"
            using \<theta>' a_def
            by (metis D.horizontal_homs_axioms D.in_homE \<open>src\<^sub>D \<theta> = a\<close> \<theta> horizontal_homs.src_cod)
          have [simp]: "trg\<^sub>D \<theta>' = trg\<^sub>D (F f)"
            using \<theta>'
            by (metis D.vconn_implies_hpar(2) D.vconn_implies_hpar(4) \<open>trg\<^sub>D \<theta> = trg\<^sub>D (F f)\<close> \<theta>)
          have [simp]: "src\<^sub>D w = a"
            using a_def by simp
          have [simp]: "trg\<^sub>D w = map\<^sub>0 (src\<^sub>C \<rho>)"
            by (metis D.horizontal_homs_axioms D.hseq_char D.in_homE T.tab_simps(2) T.leg0_simps(2)
              \<theta> category.ideD(1) category.ide_dom horizontal_homs_def preserves_src)
          have [simp]: "src\<^sub>D w' = a"
            using a_def
            by (metis D.ideD(1) D.in_homE D.src_hcomp D.vconn_implies_hpar(1) \<open>src\<^sub>D \<theta>' = a\<close>
                \<theta>' category.ide_dom horizontal_homs_def weak_arrow_of_homs_axioms
                weak_arrow_of_homs_def)
          have [simp]: "trg\<^sub>D w' = map\<^sub>0 (src\<^sub>C \<rho>)"
            by (metis D.horizontal_homs_axioms D.hseq_char D.in_homE T.tab_simps(2) T.leg0_simps(2)
                \<theta>' category.ideD(1) category.ide_dom horizontal_homs_def preserves_src)

          text \<open>First, reflect the picture back to \<open>C\<close>, so that we will be able to apply \<open>T.T2\<close>.
          We need to choose arrows in \<open>C\<close> carefully, so that their \<open>F\<close> images will enable the
          cancellation of the various isomorphisms that appear.\<close>

          obtain a\<^sub>C where a\<^sub>C: "C.obj a\<^sub>C \<and> D.equivalent_objects (map\<^sub>0 a\<^sub>C) a"
            using w a_def biessentially_surjective_on_objects D.obj_src D.ideD(1)
            by presburger
          obtain e where e: "\<guillemotleft>e : map\<^sub>0 a\<^sub>C \<rightarrow>\<^sub>D a\<guillemotright> \<and> D.equivalence_map e"
            using a\<^sub>C D.equivalent_objects_def by auto
          obtain d \<eta> \<epsilon>
            where d\<eta>\<epsilon>: "adjoint_equivalence_in_bicategory (\<cdot>\<^sub>D) (\<star>\<^sub>D) \<a>\<^sub>D \<i>\<^sub>D src\<^sub>D trg\<^sub>D e d \<eta> \<epsilon>"
              using e D.equivalence_map_extends_to_adjoint_equivalence by blast
          interpret e: adjoint_equivalence_in_bicategory \<open>(\<cdot>\<^sub>D)\<close> \<open>(\<star>\<^sub>D)\<close> \<a>\<^sub>D \<i>\<^sub>D src\<^sub>D trg\<^sub>D e d \<eta> \<epsilon>
            using d\<eta>\<epsilon> by auto
          interpret d: adjoint_equivalence_in_bicategory \<open>(\<cdot>\<^sub>D)\<close> \<open>(\<star>\<^sub>D)\<close> \<a>\<^sub>D \<i>\<^sub>D src\<^sub>D trg\<^sub>D
                          d e "D.inv \<epsilon>" "D.inv \<eta>"
            using e.dual_adjoint_equivalence by simp

          have [simp]: "src\<^sub>D e = map\<^sub>0 a\<^sub>C"
            using e by auto
          have [simp]: "trg\<^sub>D e = a"
            using e by auto
          have [simp]: "src\<^sub>D d = a"
            using e.antipar by simp
          have [simp]: "trg\<^sub>D d = map\<^sub>0 a\<^sub>C"
            using e.antipar by simp

          have we: "\<guillemotleft>w \<star>\<^sub>D e : map\<^sub>0 a\<^sub>C \<rightarrow>\<^sub>D map\<^sub>0 (src\<^sub>C \<rho>)\<guillemotright>"
            using a\<^sub>C e D.ideD(1) \<open>trg\<^sub>D w = map\<^sub>0 (src\<^sub>C \<rho>)\<close> a_def by blast
          obtain w\<^sub>C where
            w\<^sub>C: "C.ide w\<^sub>C \<and> \<guillemotleft>w\<^sub>C : a\<^sub>C \<rightarrow>\<^sub>C src\<^sub>C \<rho>\<guillemotright> \<and> D.isomorphic (F w\<^sub>C) (w \<star>\<^sub>D e)"
            using a\<^sub>C e we locally_essentially_surjective [of a\<^sub>C "src\<^sub>C \<rho>" "w \<star>\<^sub>D e"]
                  C.obj_src T.tab_simps(1) e.ide_left w by blast
          have w'e: "\<guillemotleft>w' \<star>\<^sub>D e : map\<^sub>0 a\<^sub>C \<rightarrow>\<^sub>D map\<^sub>0 (src\<^sub>C \<rho>)\<guillemotright>"
            using a\<^sub>C e D.ideD(1) \<open>trg\<^sub>D w' = map\<^sub>0 (src\<^sub>C \<rho>)\<close> a_def \<open>src\<^sub>D w' = a\<close> w' by blast
          obtain w\<^sub>C' where
            w\<^sub>C': "C.ide w\<^sub>C' \<and> \<guillemotleft>w\<^sub>C' : a\<^sub>C \<rightarrow>\<^sub>C src\<^sub>C \<rho>\<guillemotright> \<and> D.isomorphic (F w\<^sub>C') (w' \<star>\<^sub>D e)"
            using a\<^sub>C e a_def locally_essentially_surjective
            by (metis C.obj_src D.ide_hcomp D.hseq_char D.in_hhomE T.tab_simps(2)
                T.leg0_simps(2) e.ide_left w' w'e)

          have [simp]: "src\<^sub>C w\<^sub>C = a\<^sub>C"
            using w\<^sub>C by auto
          have [simp]: "trg\<^sub>C w\<^sub>C = src\<^sub>C \<rho>"
            using w\<^sub>C by auto
          have [simp]: "src\<^sub>C w\<^sub>C' = a\<^sub>C"
            using w\<^sub>C' by auto
          have [simp]: "trg\<^sub>C w\<^sub>C' = src\<^sub>C \<rho>"
            using w\<^sub>C' by auto

          obtain \<phi> where \<phi>: "\<guillemotleft>\<phi> : F w\<^sub>C \<Rightarrow>\<^sub>D w \<star>\<^sub>D e\<guillemotright> \<and> D.iso \<phi>"
            using w\<^sub>C D.isomorphicE by blast
          obtain \<phi>' where \<phi>': "\<guillemotleft>\<phi>' : F w\<^sub>C' \<Rightarrow>\<^sub>D w' \<star>\<^sub>D e\<guillemotright> \<and> D.iso \<phi>'"
            using w\<^sub>C' D.isomorphicE by blast

          have ue: "\<guillemotleft>u \<star>\<^sub>D e : map\<^sub>0 a\<^sub>C \<rightarrow>\<^sub>D map\<^sub>0 (trg\<^sub>C f)\<guillemotright> \<and> D.ide (u \<star>\<^sub>D e)"
            using a\<^sub>C e \<theta> e.ide_left
            by (intro conjI, auto)
          obtain u\<^sub>C where
            u\<^sub>C: "C.ide u\<^sub>C \<and> \<guillemotleft>u\<^sub>C : a\<^sub>C \<rightarrow>\<^sub>C trg\<^sub>C f\<guillemotright> \<and> D.isomorphic (F u\<^sub>C) (u \<star>\<^sub>D e)"
            using a\<^sub>C e ue locally_essentially_surjective [of a\<^sub>C "trg\<^sub>C f" "u \<star>\<^sub>D e"] by auto

          have [simp]: "src\<^sub>C u\<^sub>C = a\<^sub>C"
            using u\<^sub>C by auto
          have [simp]: "trg\<^sub>C u\<^sub>C = trg\<^sub>C f"
            using u\<^sub>C by auto

          obtain \<psi> where \<psi>: "\<guillemotleft>\<psi> : u \<star>\<^sub>D e \<Rightarrow>\<^sub>D F u\<^sub>C\<guillemotright> \<and> D.iso \<psi>"
            using u\<^sub>C D.isomorphic_symmetric D.isomorphicE by blast

          define F\<theta>\<^sub>C where
            "F\<theta>\<^sub>C = \<psi> \<cdot>\<^sub>D (\<theta> \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, w, e] \<cdot>\<^sub>D (F f \<star>\<^sub>D \<phi>) \<cdot>\<^sub>D D.inv (\<Phi> (f, w\<^sub>C))"
          have 1: "\<guillemotleft>F\<theta>\<^sub>C : F (f \<star>\<^sub>C w\<^sub>C) \<Rightarrow>\<^sub>D F u\<^sub>C\<guillemotright>"
          proof (unfold F\<theta>\<^sub>C_def, intro D.comp_in_homI)
            show "\<guillemotleft>D.inv (\<Phi> (f, w\<^sub>C)) : F (f \<star>\<^sub>C w\<^sub>C) \<Rightarrow>\<^sub>D F f \<star>\<^sub>D F w\<^sub>C\<guillemotright>"
              by (simp add: cmp_in_hom(2) w\<^sub>C)
            show "\<guillemotleft>F f \<star>\<^sub>D \<phi> : F f \<star>\<^sub>D F w\<^sub>C \<Rightarrow>\<^sub>D F f \<star>\<^sub>D w \<star>\<^sub>D e\<guillemotright>"
              using w w\<^sub>C \<phi> by (intro D.hcomp_in_vhom, auto)
            show "\<guillemotleft>\<a>\<^sub>D\<^sup>-\<^sup>1[F f, w, e] : F f \<star>\<^sub>D w \<star>\<^sub>D e \<Rightarrow>\<^sub>D (F f \<star>\<^sub>D w) \<star>\<^sub>D e\<guillemotright>"
              using w D.assoc'_in_hom by simp
            show "\<guillemotleft>\<theta> \<star>\<^sub>D e : (F f \<star>\<^sub>D w) \<star>\<^sub>D e \<Rightarrow>\<^sub>D u \<star>\<^sub>D e\<guillemotright>"
              using w \<theta> by (intro D.hcomp_in_vhom, auto)
            show "\<guillemotleft>\<psi> : u \<star>\<^sub>D e \<Rightarrow>\<^sub>D F u\<^sub>C\<guillemotright>"
              using \<psi> by simp
          qed
          have 2: "\<exists>\<theta>\<^sub>C. \<guillemotleft>\<theta>\<^sub>C : f \<star>\<^sub>C w\<^sub>C \<Rightarrow>\<^sub>C u\<^sub>C\<guillemotright> \<and> F \<theta>\<^sub>C = F\<theta>\<^sub>C"
            using u\<^sub>C w\<^sub>C 1 e \<theta> \<phi> locally_full by simp
          obtain \<theta>\<^sub>C where \<theta>\<^sub>C: "\<guillemotleft>\<theta>\<^sub>C : f \<star>\<^sub>C w\<^sub>C \<Rightarrow>\<^sub>C u\<^sub>C\<guillemotright> \<and> F \<theta>\<^sub>C = F\<theta>\<^sub>C"
            using 2 by auto

          define F\<theta>\<^sub>C' where
            "F\<theta>\<^sub>C' = \<psi> \<cdot>\<^sub>D (\<theta>' \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, w', e] \<cdot>\<^sub>D (F f \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D D.inv (\<Phi> (f, w\<^sub>C'))"
          have 1: "\<guillemotleft>F\<theta>\<^sub>C' : F (f \<star>\<^sub>C w\<^sub>C') \<Rightarrow>\<^sub>D F u\<^sub>C\<guillemotright>"
          proof (unfold F\<theta>\<^sub>C'_def, intro D.comp_in_homI)
            show "\<guillemotleft>D.inv (\<Phi> (f, w\<^sub>C')) : F (f \<star>\<^sub>C w\<^sub>C') \<Rightarrow>\<^sub>D F f \<star>\<^sub>D F w\<^sub>C'\<guillemotright>"
              by (simp add: cmp_in_hom(2) w\<^sub>C')
            show "\<guillemotleft>F f \<star>\<^sub>D \<phi>' : F f \<star>\<^sub>D F w\<^sub>C' \<Rightarrow>\<^sub>D F f \<star>\<^sub>D w' \<star>\<^sub>D e\<guillemotright>"
              using w' w\<^sub>C' \<phi>' by (intro D.hcomp_in_vhom, auto)
            show "\<guillemotleft>\<a>\<^sub>D\<^sup>-\<^sup>1[F f, w', e] : F f \<star>\<^sub>D w' \<star>\<^sub>D e \<Rightarrow>\<^sub>D (F f \<star>\<^sub>D w') \<star>\<^sub>D e\<guillemotright>"
              using w' D.assoc'_in_hom by simp
            show "\<guillemotleft>\<theta>' \<star>\<^sub>D e : (F f \<star>\<^sub>D w') \<star>\<^sub>D e \<Rightarrow>\<^sub>D u \<star>\<^sub>D e\<guillemotright>"
              using w' \<theta>' by (intro D.hcomp_in_vhom, auto)
            show "\<guillemotleft>\<psi> : u \<star>\<^sub>D e \<Rightarrow>\<^sub>D F u\<^sub>C\<guillemotright>"
              using \<psi> by simp
          qed
          have 2: "\<exists>\<theta>\<^sub>C'. \<guillemotleft>\<theta>\<^sub>C' : f \<star>\<^sub>C w\<^sub>C' \<Rightarrow>\<^sub>C u\<^sub>C\<guillemotright> \<and> F \<theta>\<^sub>C' = F\<theta>\<^sub>C'"
            using u\<^sub>C w\<^sub>C' 1 e \<theta> \<phi> locally_full by simp
          obtain \<theta>\<^sub>C' where \<theta>\<^sub>C': "\<guillemotleft>\<theta>\<^sub>C' : f \<star>\<^sub>C w\<^sub>C' \<Rightarrow>\<^sub>C u\<^sub>C\<guillemotright> \<and> F \<theta>\<^sub>C' = F\<theta>\<^sub>C'"
            using 2 by auto

          define F\<beta>\<^sub>C where
            "F\<beta>\<^sub>C = \<Phi> (g, w\<^sub>C') \<cdot>\<^sub>D (F g \<star>\<^sub>D D.inv \<phi>') \<cdot>\<^sub>D \<a>\<^sub>D[F g, w', e] \<cdot>\<^sub>D (\<beta> \<star>\<^sub>D e) \<cdot>\<^sub>D
                     \<a>\<^sub>D\<^sup>-\<^sup>1[F g, w, e] \<cdot>\<^sub>D (F g \<star>\<^sub>D \<phi>) \<cdot>\<^sub>D D.inv (\<Phi> (g, w\<^sub>C))"
          have F\<beta>\<^sub>C: "\<guillemotleft>F\<beta>\<^sub>C: F (g \<star>\<^sub>C w\<^sub>C) \<Rightarrow>\<^sub>D F (g \<star>\<^sub>C w\<^sub>C')\<guillemotright>"
          proof (unfold F\<beta>\<^sub>C_def, intro D.comp_in_homI)
            show "\<guillemotleft>D.inv (\<Phi> (g, w\<^sub>C)) : F (g \<star>\<^sub>C w\<^sub>C) \<Rightarrow>\<^sub>D F g \<star>\<^sub>D F w\<^sub>C\<guillemotright>"
              by (simp add: cmp_in_hom(2) w\<^sub>C)
            show "\<guillemotleft>F g \<star>\<^sub>D \<phi> : F g \<star>\<^sub>D F w\<^sub>C \<Rightarrow>\<^sub>D F g \<star>\<^sub>D w \<star>\<^sub>D e\<guillemotright>"
              using w\<^sub>C \<phi> apply (intro D.hcomp_in_vhom) by auto
            show "\<guillemotleft>\<a>\<^sub>D\<^sup>-\<^sup>1[F g, w, e] : F g \<star>\<^sub>D w \<star>\<^sub>D e \<Rightarrow>\<^sub>D (F g \<star>\<^sub>D w) \<star>\<^sub>D e\<guillemotright>"
              using w D.assoc'_in_hom by simp
            show "\<guillemotleft>\<beta> \<star>\<^sub>D e : (F g \<star>\<^sub>D w) \<star>\<^sub>D e \<Rightarrow>\<^sub>D (F g \<star>\<^sub>D w') \<star>\<^sub>D e\<guillemotright>"
              using w \<beta> apply (intro D.hcomp_in_vhom) by auto
            show "\<guillemotleft>\<a>\<^sub>D[F g, w', e] : (F g \<star>\<^sub>D w') \<star>\<^sub>D e \<Rightarrow>\<^sub>D F g \<star>\<^sub>D w' \<star>\<^sub>D e\<guillemotright>"
              using w' e.antipar D.assoc_in_hom by simp
            show "\<guillemotleft>F g \<star>\<^sub>D D.inv \<phi>' : F g \<star>\<^sub>D w' \<star>\<^sub>D e \<Rightarrow>\<^sub>D F g \<star>\<^sub>D F w\<^sub>C'\<guillemotright>"
              using w' w\<^sub>C' \<phi>' by (intro D.hcomp_in_vhom, auto)
            show "\<guillemotleft>\<Phi> (g, w\<^sub>C') : F g \<star>\<^sub>D F w\<^sub>C' \<Rightarrow>\<^sub>D F (g \<star>\<^sub>C w\<^sub>C')\<guillemotright>"
              using w\<^sub>C' cmp_in_hom by simp
          qed

          have 1: "\<exists>\<beta>\<^sub>C. \<guillemotleft>\<beta>\<^sub>C : g \<star>\<^sub>C w\<^sub>C \<Rightarrow>\<^sub>C g \<star>\<^sub>C w\<^sub>C'\<guillemotright> \<and> F \<beta>\<^sub>C = F\<beta>\<^sub>C"
            using w\<^sub>C w\<^sub>C' F\<beta>\<^sub>C locally_full by simp
          obtain \<beta>\<^sub>C where \<beta>\<^sub>C: "\<guillemotleft>\<beta>\<^sub>C : g \<star>\<^sub>C w\<^sub>C \<Rightarrow>\<^sub>C g \<star>\<^sub>C w\<^sub>C'\<guillemotright> \<and> F \<beta>\<^sub>C = F\<beta>\<^sub>C"
            using 1 by auto

          text \<open>
            The following is the main calculation that needs to be done, to permit us
            to apply \<open>T.T2\<close>.
            Once again, it started out looking simple, but once all the necessary
            isomorphisms are thrown in it looks much more complicated.
          \<close>

          have *: "T.composite_cell w\<^sub>C \<theta>\<^sub>C = T.composite_cell w\<^sub>C' \<theta>\<^sub>C' \<cdot>\<^sub>C \<beta>\<^sub>C"
          proof -
            have par: "C.par (T.composite_cell w\<^sub>C \<theta>\<^sub>C) (T.composite_cell w\<^sub>C' \<theta>\<^sub>C' \<cdot>\<^sub>C \<beta>\<^sub>C)"
            proof -
              have "\<guillemotleft>T.composite_cell w\<^sub>C \<theta>\<^sub>C : g \<star>\<^sub>C w\<^sub>C \<Rightarrow>\<^sub>C r \<star>\<^sub>C u\<^sub>C\<guillemotright>"
                using w\<^sub>C \<theta>\<^sub>C T.composite_cell_in_hom by simp
              moreover have "\<guillemotleft>T.composite_cell w\<^sub>C' \<theta>\<^sub>C' \<cdot>\<^sub>C \<beta>\<^sub>C : g \<star>\<^sub>C w\<^sub>C \<Rightarrow>\<^sub>C r \<star>\<^sub>C u\<^sub>C\<guillemotright>"
              proof (intro C.comp_in_homI)
                show "\<guillemotleft>\<beta>\<^sub>C : g \<star>\<^sub>C w\<^sub>C \<Rightarrow>\<^sub>C g \<star>\<^sub>C w\<^sub>C'\<guillemotright>"
                  using \<beta>\<^sub>C by simp
                show "\<guillemotleft>\<rho> \<star>\<^sub>C w\<^sub>C' : g \<star>\<^sub>C w\<^sub>C' \<Rightarrow>\<^sub>C (r \<star>\<^sub>C f) \<star>\<^sub>C w\<^sub>C'\<guillemotright>"
                  using w\<^sub>C' by (intro C.hcomp_in_vhom, auto)
                show "\<guillemotleft>\<a>\<^sub>C[r, f, w\<^sub>C'] : (r \<star>\<^sub>C f) \<star>\<^sub>C w\<^sub>C' \<Rightarrow>\<^sub>C r \<star>\<^sub>C f \<star>\<^sub>C w\<^sub>C'\<guillemotright>"
                  using w\<^sub>C' C.assoc_in_hom by simp
                show "\<guillemotleft>r \<star>\<^sub>C \<theta>\<^sub>C' : r \<star>\<^sub>C f \<star>\<^sub>C w\<^sub>C' \<Rightarrow>\<^sub>C r \<star>\<^sub>C u\<^sub>C\<guillemotright>"
                  using w\<^sub>C' \<theta>\<^sub>C' by (intro C.hcomp_in_vhom, auto)
              qed
              ultimately show ?thesis
                by (metis C.in_homE)
            qed
            moreover have "F (T.composite_cell w\<^sub>C \<theta>\<^sub>C) = F (T.composite_cell w\<^sub>C' \<theta>\<^sub>C' \<cdot>\<^sub>C \<beta>\<^sub>C)"
            proof -
              have "F (T.composite_cell w\<^sub>C \<theta>\<^sub>C) = F (r \<star>\<^sub>C \<theta>\<^sub>C) \<cdot>\<^sub>D F \<a>\<^sub>C[r, f, w\<^sub>C] \<cdot>\<^sub>D F (\<rho> \<star>\<^sub>C w\<^sub>C)"
                using par by auto
              also have "... = (\<Phi> (r, u\<^sub>C) \<cdot>\<^sub>D (F r \<star>\<^sub>D F \<theta>\<^sub>C) \<cdot>\<^sub>D D.inv (\<Phi> (r, f \<star>\<^sub>C w\<^sub>C))) \<cdot>\<^sub>D
                                 (\<Phi> (r, f \<star>\<^sub>C w\<^sub>C) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<Phi> (f, w\<^sub>C)) \<cdot>\<^sub>D \<a>\<^sub>D[F r, F f, F w\<^sub>C] \<cdot>\<^sub>D
                                 (D.inv (\<Phi> (r, f)) \<star>\<^sub>D F w\<^sub>C) \<cdot>\<^sub>D D.inv (\<Phi> (r \<star>\<^sub>C f, w\<^sub>C))) \<cdot>\<^sub>D
                                 (\<Phi> (r \<star>\<^sub>C f, w\<^sub>C) \<cdot>\<^sub>D (F \<rho> \<star>\<^sub>D F w\<^sub>C) \<cdot>\<^sub>D D.inv (\<Phi> (g, w\<^sub>C)))"
              proof -
                have "src\<^sub>C f = trg\<^sub>C w\<^sub>C \<and> C.hseq r \<theta>\<^sub>C \<and> C.hseq \<rho> w\<^sub>C"
                using par by auto
                thus ?thesis
                  using w\<^sub>C \<theta>\<^sub>C preserves_assoc preserves_hcomp
                  by (metis C.ideD(2) C.ideD(3) C.in_homE T.ide_base T.ide_leg0 T.leg0_simps(3)
                    T.tab_simps(4) T.tab_simps(5))
              qed
              also have
                "... = \<Phi> (r, u\<^sub>C) \<cdot>\<^sub>D (F r \<star>\<^sub>D F \<theta>\<^sub>C) \<cdot>\<^sub>D (((D.inv (\<Phi> (r, f \<star>\<^sub>C w\<^sub>C))) \<cdot>\<^sub>D
                         (\<Phi> (r, f \<star>\<^sub>C w\<^sub>C))) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<Phi> (f, w\<^sub>C))) \<cdot>\<^sub>D \<a>\<^sub>D[F r, F f, F w\<^sub>C] \<cdot>\<^sub>D
                         (D.inv (\<Phi> (r, f)) \<star>\<^sub>D F w\<^sub>C) \<cdot>\<^sub>D ((D.inv (\<Phi> (r \<star>\<^sub>C f, w\<^sub>C))) \<cdot>\<^sub>D
                         (\<Phi> (r \<star>\<^sub>C f, w\<^sub>C)) \<cdot>\<^sub>D (F \<rho> \<star>\<^sub>D F w\<^sub>C)) \<cdot>\<^sub>D D.inv (\<Phi> (g, w\<^sub>C))"
                using D.comp_assoc by simp
              also have
                "... = \<Phi> (r, u\<^sub>C) \<cdot>\<^sub>D ((F r \<star>\<^sub>D F \<theta>\<^sub>C) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<Phi> (f, w\<^sub>C))) \<cdot>\<^sub>D
                         \<a>\<^sub>D[F r, F f, F w\<^sub>C] \<cdot>\<^sub>D ((D.inv (\<Phi> (r, f)) \<star>\<^sub>D F w\<^sub>C) \<cdot>\<^sub>D (F \<rho> \<star>\<^sub>D F w\<^sub>C)) \<cdot>\<^sub>D
                         D.inv (\<Phi> (g, w\<^sub>C))"
              proof -
                have
                  "(D.inv (\<Phi> (r \<star>\<^sub>C f, w\<^sub>C)) \<cdot>\<^sub>D \<Phi> (r \<star>\<^sub>C f, w\<^sub>C)) \<cdot>\<^sub>D (F \<rho> \<star>\<^sub>D F w\<^sub>C) = F \<rho> \<star>\<^sub>D F w\<^sub>C"
                  using w\<^sub>C \<open>trg\<^sub>C w\<^sub>C = src\<^sub>C \<rho>\<close> D.comp_inv_arr' cmp_in_hom cmp_components_are_iso
                        D.comp_cod_arr
                  by simp
                moreover have
                  "((D.inv (\<Phi> (r, f \<star>\<^sub>C w\<^sub>C))) \<cdot>\<^sub>D (\<Phi> (r, f \<star>\<^sub>C w\<^sub>C))) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<Phi> (f, w\<^sub>C)) =
                   F r \<star>\<^sub>D \<Phi> (f, w\<^sub>C)"
                  using w\<^sub>C D.comp_cod_arr D.comp_inv_arr' cmp_simps(1,4) C.VV.cod_simp
                  by auto
                ultimately show ?thesis
                  using D.comp_assoc by simp
              qed
              also have
                "... = \<Phi> (r, u\<^sub>C) \<cdot>\<^sub>D (F r \<star>\<^sub>D F \<theta>\<^sub>C \<cdot>\<^sub>D \<Phi> (f, w\<^sub>C)) \<cdot>\<^sub>D \<a>\<^sub>D[F r, F f, F w\<^sub>C] \<cdot>\<^sub>D
                         (?\<rho>' \<star>\<^sub>D F w\<^sub>C) \<cdot>\<^sub>D D.inv (\<Phi> (g, w\<^sub>C))"
              proof -
                have "(F r \<star>\<^sub>D F \<theta>\<^sub>C) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<Phi> (f, w\<^sub>C)) = F r \<star>\<^sub>D F \<theta>\<^sub>C \<cdot>\<^sub>D \<Phi> (f, w\<^sub>C)"
                  using \<theta>\<^sub>C w\<^sub>C D.whisker_left cmp_in_hom
                  by (metis C.hseqE C.seqE D.seqI' T'.ide_base T.tab_simps(2) T.ide_leg0
                      par preserves_hom)
                moreover have "(D.inv (\<Phi> (r, f)) \<star>\<^sub>D F w\<^sub>C) \<cdot>\<^sub>D (F \<rho> \<star>\<^sub>D F w\<^sub>C) = ?\<rho>' \<star>\<^sub>D F w\<^sub>C"
                  using D.whisker_right by (simp add: w\<^sub>C)
                ultimately show ?thesis
                  using D.comp_assoc by simp
              qed
              also have
                "... = \<Phi> (r, u\<^sub>C) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<psi> \<cdot>\<^sub>D (\<theta> \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, w, e] \<cdot>\<^sub>D (F f \<star>\<^sub>D \<phi>) \<cdot>\<^sub>D
                         D.inv (\<Phi> (f, w\<^sub>C)) \<cdot>\<^sub>D \<Phi> (f, w\<^sub>C)) \<cdot>\<^sub>D \<a>\<^sub>D[F r, F f, F w\<^sub>C] \<cdot>\<^sub>D
                         (?\<rho>' \<star>\<^sub>D F w\<^sub>C) \<cdot>\<^sub>D D.inv (\<Phi> (g, w\<^sub>C))"
                using \<theta>\<^sub>C F\<theta>\<^sub>C_def D.comp_assoc by simp
              also have
                "... = \<Phi> (r, u\<^sub>C) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<psi>) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<theta> \<star>\<^sub>D e) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, w, e]) \<cdot>\<^sub>D
                         ((F r \<star>\<^sub>D F f \<star>\<^sub>D \<phi>) \<cdot>\<^sub>D \<a>\<^sub>D[F r, F f, F w\<^sub>C]) \<cdot>\<^sub>D (?\<rho>' \<star>\<^sub>D F w\<^sub>C) \<cdot>\<^sub>D
                         D.inv (\<Phi> (g, w\<^sub>C))"
              proof -
                have "F r \<star>\<^sub>D \<psi> \<cdot>\<^sub>D (\<theta> \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, w, e] \<cdot>\<^sub>D (F f \<star>\<^sub>D \<phi>) \<cdot>\<^sub>D
                        D.inv (\<Phi> (f, w\<^sub>C)) \<cdot>\<^sub>D \<Phi> (f, w\<^sub>C) =
                      F r \<star>\<^sub>D \<psi> \<cdot>\<^sub>D (\<theta> \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, w, e] \<cdot>\<^sub>D (F f \<star>\<^sub>D \<phi>)"
                  using cmp_in_hom cmp_components_are_iso D.comp_arr_dom
                  by (metis C.arrI D.cod_inv D.comp_inv_arr' D.seqE F\<theta>\<^sub>C_def T.tab_simps(2)
                      T.ide_leg0 \<open>trg\<^sub>C w\<^sub>C = src\<^sub>C \<rho>\<close> \<theta>\<^sub>C preserves_arr w\<^sub>C)
                also have "... = (F r \<star>\<^sub>D \<psi>) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<theta> \<star>\<^sub>D e) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, w, e]) \<cdot>\<^sub>D
                                   (F r \<star>\<^sub>D F f \<star>\<^sub>D \<phi>)"
                  using D.whisker_left
                  by (metis (no_types, lifting) C.in_homE D.comp_assoc D.seqE F\<theta>\<^sub>C_def T'.ide_base
                      \<theta>\<^sub>C preserves_arr)
                finally have "F r \<star>\<^sub>D \<psi> \<cdot>\<^sub>D (\<theta> \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, w, e] \<cdot>\<^sub>D (F f \<star>\<^sub>D \<phi>) \<cdot>\<^sub>D
                                D.inv (\<Phi> (f, w\<^sub>C)) \<cdot>\<^sub>D \<Phi> (f, w\<^sub>C) =
                              (F r \<star>\<^sub>D \<psi>) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<theta> \<star>\<^sub>D e) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, w, e]) \<cdot>\<^sub>D
                                (F r \<star>\<^sub>D F f \<star>\<^sub>D \<phi>)"
                  by simp
                thus ?thesis
                  using D.comp_assoc by simp
              qed
              also have
                "... = \<Phi> (r, u\<^sub>C) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<psi>) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<theta> \<star>\<^sub>D e) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, w, e]) \<cdot>\<^sub>D
                         \<a>\<^sub>D[F r, F f, w \<star>\<^sub>D e] \<cdot>\<^sub>D (((F r \<star>\<^sub>D F f) \<star>\<^sub>D \<phi>) \<cdot>\<^sub>D (?\<rho>' \<star>\<^sub>D F w\<^sub>C)) \<cdot>\<^sub>D
                         D.inv (\<Phi> (g, w\<^sub>C))"
              proof -
                have "(F r \<star>\<^sub>D F f \<star>\<^sub>D \<phi>) \<cdot>\<^sub>D \<a>\<^sub>D[F r, F f, F w\<^sub>C] =
                      \<a>\<^sub>D[F r, F f, w \<star>\<^sub>D e] \<cdot>\<^sub>D ((F r \<star>\<^sub>D F f) \<star>\<^sub>D \<phi>)"
                  using w\<^sub>C \<phi> \<open>trg\<^sub>C w\<^sub>C = src\<^sub>C \<rho>\<close> D.assoc_naturality [of "F r" "F f" \<phi>]
                  by (metis (mono_tags, lifting) C.ideD(1) D.in_homE D.vconn_implies_hpar(2)
                      T'.base_simps(2-4) T'.leg0_simps(2-5) T.leg0_simps(2)
                      T.tab_simps(2) preserves_src preserves_trg)
                thus ?thesis
                  using D.comp_assoc by simp
              qed
              also have
                "... = \<Phi> (r, u\<^sub>C) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<psi>) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<theta> \<star>\<^sub>D e) \<cdot>\<^sub>D ((F r \<star>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, w, e]) \<cdot>\<^sub>D
                         \<a>\<^sub>D[F r, F f, w \<star>\<^sub>D e]) \<cdot>\<^sub>D (?\<rho>' \<star>\<^sub>D w \<star>\<^sub>D e) \<cdot>\<^sub>D (F g \<star>\<^sub>D \<phi>) \<cdot>\<^sub>D
                         D.inv (\<Phi> (g, w\<^sub>C))"
              proof -
                have "((F r \<star>\<^sub>D F f) \<star>\<^sub>D \<phi>) \<cdot>\<^sub>D (?\<rho>' \<star>\<^sub>D F w\<^sub>C) = ?\<rho>' \<star>\<^sub>D \<phi> \<cdot>\<^sub>D F w\<^sub>C"
                  using \<phi> D.interchange
                  by (metis D.comp_arr_dom D.comp_cod_arr D.in_homE T'.tab_simps(1,5))
                also have "... = ?\<rho>' \<star>\<^sub>D (w \<star>\<^sub>D e) \<cdot>\<^sub>D \<phi>"
                  using \<phi> w\<^sub>C D.comp_arr_dom D.comp_cod_arr by auto
                also have "... = (?\<rho>' \<star>\<^sub>D w \<star>\<^sub>D e) \<cdot>\<^sub>D (F g \<star>\<^sub>D \<phi>)"
                  using \<phi> D.interchange
                  by (metis D.comp_arr_ide D.comp_cod_arr D.in_homE D.seqI' T'.ide_leg1
                      T'.leg1_in_hom(2) T'.tab_in_vhom')
                finally have
                  "((F r \<star>\<^sub>D F f) \<star>\<^sub>D \<phi>) \<cdot>\<^sub>D (?\<rho>' \<star>\<^sub>D F w\<^sub>C) = (?\<rho>' \<star>\<^sub>D w \<star>\<^sub>D e) \<cdot>\<^sub>D (F g \<star>\<^sub>D \<phi>)"
                  by simp
                thus ?thesis
                  using D.comp_assoc by simp
              qed
              also have
                "... = \<Phi> (r, u\<^sub>C) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<psi>) \<cdot>\<^sub>D ((F r \<star>\<^sub>D \<theta> \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D[F r, F f \<star>\<^sub>D w, e]) \<cdot>\<^sub>D
                         (\<a>\<^sub>D[F r, F f, w] \<star>\<^sub>D e) \<cdot>\<^sub>D (\<a>\<^sub>D\<^sup>-\<^sup>1[F r \<star>\<^sub>D F f, w, e] \<cdot>\<^sub>D
                         (?\<rho>' \<star>\<^sub>D w \<star>\<^sub>D e)) \<cdot>\<^sub>D (F g \<star>\<^sub>D \<phi>) \<cdot>\<^sub>D D.inv (\<Phi> (g, w\<^sub>C))"
              proof -
                have "D.inv (F r \<star>\<^sub>D \<a>\<^sub>D[F f, w, e]) = F r \<star>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, w, e]"
                  using w by simp
                moreover have "D.seq (F r \<star>\<^sub>D \<a>\<^sub>D[F f, w, e])
                                     (\<a>\<^sub>D[F r, F f \<star>\<^sub>D w, e] \<cdot>\<^sub>D (\<a>\<^sub>D[F r, F f, w] \<star>\<^sub>D e))"
                  using w by simp
                moreover have
                  "(F r \<star>\<^sub>D \<a>\<^sub>D[F f, w, e]) \<cdot>\<^sub>D \<a>\<^sub>D[F r, F f \<star>\<^sub>D w, e] \<cdot>\<^sub>D (\<a>\<^sub>D[F r, F f, w] \<star>\<^sub>D e) =
                   \<a>\<^sub>D[F r, F f, w \<star>\<^sub>D e] \<cdot>\<^sub>D \<a>\<^sub>D[F r \<star>\<^sub>D F f, w, e]"
                  using w D.pentagon by simp
                ultimately
                have "(F r \<star>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, w, e]) \<cdot>\<^sub>D \<a>\<^sub>D[F r, F f, w \<star>\<^sub>D e] =
                      \<a>\<^sub>D[F r, F f \<star>\<^sub>D w, e] \<cdot>\<^sub>D (\<a>\<^sub>D[F r, F f, w] \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F r \<star>\<^sub>D F f, w, e]"
                  using w D.comp_assoc
                        D.invert_opposite_sides_of_square
                          [of "F r \<star>\<^sub>D \<a>\<^sub>D[F f, w, e]" "\<a>\<^sub>D[F r, F f \<star>\<^sub>D w, e] \<cdot>\<^sub>D (\<a>\<^sub>D[F r, F f, w] \<star>\<^sub>D e)"
                              "\<a>\<^sub>D[F r, F f, w \<star>\<^sub>D e]"  "\<a>\<^sub>D[F r \<star>\<^sub>D F f, w, e]"]
                  by auto
                thus ?thesis
                  using D.comp_assoc by simp
              qed
              also have "... = \<Phi> (r, u\<^sub>C) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<psi>) \<cdot>\<^sub>D \<a>\<^sub>D[F r, u, e] \<cdot>\<^sub>D (((F r \<star>\<^sub>D \<theta>) \<star>\<^sub>D e) \<cdot>\<^sub>D
                                 (\<a>\<^sub>D[F r, F f, w] \<star>\<^sub>D e) \<cdot>\<^sub>D ((?\<rho>' \<star>\<^sub>D w) \<star>\<^sub>D e)) \<cdot>\<^sub>D
                                  \<a>\<^sub>D\<^sup>-\<^sup>1[F g, w, e] \<cdot>\<^sub>D (F g \<star>\<^sub>D \<phi>) \<cdot>\<^sub>D D.inv (\<Phi> (g, w\<^sub>C))"
              proof -
                have
                  "(F r \<star>\<^sub>D \<theta> \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D[F r, F f \<star>\<^sub>D w, e] = \<a>\<^sub>D[F r, u, e] \<cdot>\<^sub>D ((F r \<star>\<^sub>D \<theta>) \<star>\<^sub>D e)"
                  using D.assoc_naturality [of "F r" \<theta> e] \<theta> by auto
                moreover have "\<a>\<^sub>D\<^sup>-\<^sup>1[F r \<star>\<^sub>D F f, w, e] \<cdot>\<^sub>D (?\<rho>' \<star>\<^sub>D w \<star>\<^sub>D e) =
                               ((?\<rho>' \<star>\<^sub>D w) \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F g, w, e]"
                  using w we e.ide_left D.assoc'_naturality [of ?\<rho>' w e] by simp
                ultimately show ?thesis
                  using D.comp_assoc by simp
              qed
              also have "... = \<Phi> (r, u\<^sub>C) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<psi>) \<cdot>\<^sub>D \<a>\<^sub>D[F r, u, e] \<cdot>\<^sub>D
                                 (T'.composite_cell w \<theta> \<star>\<^sub>D e) \<cdot>\<^sub>D
                                 \<a>\<^sub>D\<^sup>-\<^sup>1[F g, w, e] \<cdot>\<^sub>D (F g \<star>\<^sub>D \<phi>) \<cdot>\<^sub>D D.inv (\<Phi> (g, w\<^sub>C))"
              proof -
                have "((F r \<star>\<^sub>D \<theta>) \<star>\<^sub>D e) \<cdot>\<^sub>D (\<a>\<^sub>D[F r, F f, w] \<star>\<^sub>D e) \<cdot>\<^sub>D ((?\<rho>' \<star>\<^sub>D w) \<star>\<^sub>D e) =
                       T'.composite_cell w \<theta> \<star>\<^sub>D e"
                proof -
                  have "\<guillemotleft>T'.composite_cell w \<theta> : F g \<star>\<^sub>D w \<Rightarrow>\<^sub>D F r \<star>\<^sub>D u\<guillemotright>"
                    using w we \<theta> \<open>src\<^sub>D \<theta> = a\<close> \<open>trg\<^sub>D e = a\<close> T'.composite_cell_in_hom
                    by (metis D.ideD(1) D.ide_in_hom(1) D.not_arr_null D.seq_if_composable
                        T'.leg1_simps(3) T.leg1_simps(2-3) T.tab_simps(2)
                        \<open>trg\<^sub>D w = map\<^sub>0 (src\<^sub>C \<rho>)\<close> a_def preserves_src ue)
                  thus ?thesis
                    using D.whisker_right D.arrI by auto
                qed
                thus ?thesis
                  using D.comp_assoc by simp
              qed
              finally have L: "F (T.composite_cell w\<^sub>C \<theta>\<^sub>C) =
                               \<Phi> (r, u\<^sub>C) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<psi>) \<cdot>\<^sub>D \<a>\<^sub>D[F r, u, e] \<cdot>\<^sub>D
                                 (T'.composite_cell w \<theta> \<star>\<^sub>D e) \<cdot>\<^sub>D
                                 \<a>\<^sub>D\<^sup>-\<^sup>1[F g, w, e] \<cdot>\<^sub>D (F g \<star>\<^sub>D \<phi>) \<cdot>\<^sub>D D.inv (\<Phi> (g, w\<^sub>C))"
                by simp

              have "F (T.composite_cell w\<^sub>C' \<theta>\<^sub>C' \<cdot>\<^sub>C \<beta>\<^sub>C) =
                    F ((r \<star>\<^sub>C \<theta>\<^sub>C') \<cdot>\<^sub>C \<a>\<^sub>C[r, f, w\<^sub>C'] \<cdot>\<^sub>C (\<rho> \<star>\<^sub>C w\<^sub>C') \<cdot>\<^sub>C \<beta>\<^sub>C)"
                using C.comp_assoc by simp
              also have "... = F(r \<star>\<^sub>C \<theta>\<^sub>C') \<cdot>\<^sub>D F \<a>\<^sub>C[r, f, w\<^sub>C'] \<cdot>\<^sub>D F (\<rho> \<star>\<^sub>C w\<^sub>C') \<cdot>\<^sub>D F \<beta>\<^sub>C"
                using C.comp_assoc par by fastforce
              also have "... = (\<Phi> (r, u\<^sub>C) \<cdot>\<^sub>D (F r \<star>\<^sub>D F \<theta>\<^sub>C') \<cdot>\<^sub>D D.inv (\<Phi> (r, f \<star>\<^sub>C w\<^sub>C'))) \<cdot>\<^sub>D
                                 (\<Phi> (r, f \<star>\<^sub>C w\<^sub>C') \<cdot>\<^sub>D (F r \<star>\<^sub>D \<Phi> (f, w\<^sub>C')) \<cdot>\<^sub>D \<a>\<^sub>D[F r, F f, F w\<^sub>C'] \<cdot>\<^sub>D
                                 (D.inv (\<Phi> (r, f)) \<star>\<^sub>D F w\<^sub>C') \<cdot>\<^sub>D D.inv (\<Phi> (r \<star>\<^sub>C f, w\<^sub>C'))) \<cdot>\<^sub>D
                                 (\<Phi> (r \<star>\<^sub>C f, w\<^sub>C') \<cdot>\<^sub>D (F \<rho> \<star>\<^sub>D F w\<^sub>C') \<cdot>\<^sub>D D.inv (\<Phi> (g, w\<^sub>C'))) \<cdot>\<^sub>D
                                 \<Phi> (g, w\<^sub>C') \<cdot>\<^sub>D (F g \<star>\<^sub>D D.inv \<phi>') \<cdot>\<^sub>D \<a>\<^sub>D[F g, w', e] \<cdot>\<^sub>D (\<beta> \<star>\<^sub>D e) \<cdot>\<^sub>D
                                 \<a>\<^sub>D\<^sup>-\<^sup>1[F g, w, e] \<cdot>\<^sub>D (F g \<star>\<^sub>D \<phi>) \<cdot>\<^sub>D D.inv (\<Phi> (g, w\<^sub>C))"
              proof -
                have "C.hseq r \<theta>\<^sub>C' \<and> C.hseq \<rho> w\<^sub>C'"
                  using par by blast
                thus ?thesis
                  using w\<^sub>C' \<theta>\<^sub>C' \<beta>\<^sub>C F\<beta>\<^sub>C_def preserves_assoc [of r f w\<^sub>C'] preserves_hcomp
                  by force
              qed
              also have "... = \<Phi> (r, u\<^sub>C) \<cdot>\<^sub>D (F r \<star>\<^sub>D F \<theta>\<^sub>C') \<cdot>\<^sub>D ((D.inv (\<Phi> (r, f \<star>\<^sub>C w\<^sub>C'))) \<cdot>\<^sub>D
                                 (\<Phi> (r, f \<star>\<^sub>C w\<^sub>C')) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<Phi> (f, w\<^sub>C'))) \<cdot>\<^sub>D \<a>\<^sub>D[F r, F f, F w\<^sub>C'] \<cdot>\<^sub>D
                                 (D.inv (\<Phi> (r, f)) \<star>\<^sub>D F w\<^sub>C') \<cdot>\<^sub>D ((D.inv (\<Phi> (r \<star>\<^sub>C f, w\<^sub>C')) \<cdot>\<^sub>D
                                 \<Phi> (r \<star>\<^sub>C f, w\<^sub>C')) \<cdot>\<^sub>D (F \<rho> \<star>\<^sub>D F w\<^sub>C')) \<cdot>\<^sub>D ((D.inv (\<Phi> (g, w\<^sub>C')) \<cdot>\<^sub>D
                                 \<Phi> (g, w\<^sub>C')) \<cdot>\<^sub>D (F g \<star>\<^sub>D D.inv \<phi>')) \<cdot>\<^sub>D \<a>\<^sub>D[F g, w', e] \<cdot>\<^sub>D (\<beta> \<star>\<^sub>D e) \<cdot>\<^sub>D
                                 \<a>\<^sub>D\<^sup>-\<^sup>1[F g, w, e] \<cdot>\<^sub>D (F g \<star>\<^sub>D \<phi>) \<cdot>\<^sub>D D.inv (\<Phi> (g, w\<^sub>C))"
                using D.comp_assoc by simp
              also have
                "... = \<Phi> (r, u\<^sub>C) \<cdot>\<^sub>D (F r \<star>\<^sub>D F \<theta>\<^sub>C') \<cdot>\<^sub>D (F r \<star>\<^sub>D \<Phi> (f, w\<^sub>C')) \<cdot>\<^sub>D
                         \<a>\<^sub>D[F r, F f, F w\<^sub>C'] \<cdot>\<^sub>D
                         ((D.inv (\<Phi> (r, f)) \<star>\<^sub>D F w\<^sub>C') \<cdot>\<^sub>D (F \<rho> \<star>\<^sub>D F w\<^sub>C')) \<cdot>\<^sub>D (F g \<star>\<^sub>D D.inv \<phi>') \<cdot>\<^sub>D
                         \<a>\<^sub>D[F g, w', e] \<cdot>\<^sub>D (\<beta> \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F g, w, e] \<cdot>\<^sub>D
                         (F g \<star>\<^sub>D \<phi>) \<cdot>\<^sub>D D.inv (\<Phi> (g, w\<^sub>C))"
              proof -
                have "(D.inv (\<Phi> (r, f \<star>\<^sub>C w\<^sub>C'))) \<cdot>\<^sub>D (\<Phi> (r, f \<star>\<^sub>C w\<^sub>C')) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<Phi> (f, w\<^sub>C')) =
                      F r \<star>\<^sub>D \<Phi> (f, w\<^sub>C')"
                proof -
                  have "D.seq (\<Phi> (r, f \<star>\<^sub>C w\<^sub>C')) (F r \<star>\<^sub>D \<Phi> (f, w\<^sub>C')) \<and>
                        D.arr (D.inv (\<Phi> (r, f \<star>\<^sub>C w\<^sub>C'))) \<and>
                        D.dom (D.inv (\<Phi> (r, f \<star>\<^sub>C w\<^sub>C'))) =
                        D.cod (\<Phi> (r, f \<star>\<^sub>C w\<^sub>C') \<cdot>\<^sub>D (F r \<star>\<^sub>D \<Phi> (f, w\<^sub>C')))"
                    by (metis D.seqE calculation par preserves_arr)
                  thus ?thesis
                    using C.ide_hcomp C.ideD(1) C.trg_hcomp D.invert_side_of_triangle(1)
                          T.ide_base T.ide_leg0 T.leg0_simps(3) T.tab_simps(2) cmp_components_are_iso
                          \<open>trg\<^sub>C w\<^sub>C' = src\<^sub>C \<rho>\<close> w\<^sub>C'
                    by presburger
                qed
                moreover have
                  "(D.inv (\<Phi> (r \<star>\<^sub>C f, w\<^sub>C')) \<cdot>\<^sub>D \<Phi> (r \<star>\<^sub>C f, w\<^sub>C')) \<cdot>\<^sub>D (F \<rho> \<star>\<^sub>D F w\<^sub>C') =
                   F \<rho> \<star>\<^sub>D F w\<^sub>C'"
                proof -
                  have "D.seq (F \<rho> \<star>\<^sub>D F w\<^sub>C') (D.inv (\<Phi> (C.dom \<rho>, C.dom w\<^sub>C'))) \<and>
                        D.arr (\<Phi> (r \<star>\<^sub>C f, w\<^sub>C')) \<and>
                        D.dom (\<Phi> (r \<star>\<^sub>C f, w\<^sub>C')) =
                        D.cod ((F \<rho> \<star>\<^sub>D F w\<^sub>C') \<cdot>\<^sub>D D.inv (\<Phi> (C.dom \<rho>, C.dom w\<^sub>C')))"
                    by (metis C.hseqI' C.ide_char D.seqE T.tab_simps(1) T.tab_simps(5)
                        \<open>trg\<^sub>C w\<^sub>C' = src\<^sub>C \<rho>\<close> preserves_arr preserves_hcomp w\<^sub>C')
                  thus ?thesis
                    by (metis (no_types) C.ide_hcomp C.ide_char C.hcomp_simps(1)
                        D.cod_comp D.comp_inv_arr' D.seqE T.ide_base T.ide_leg0 T.leg0_simps(3)
                        T.tab_simps(2) cmp_components_are_iso D.comp_cod_arr
                        \<open>trg\<^sub>C w\<^sub>C' = src\<^sub>C \<rho>\<close> w\<^sub>C')
                qed
                moreover have "(D.inv (\<Phi> (g, w\<^sub>C')) \<cdot>\<^sub>D \<Phi> (g, w\<^sub>C')) \<cdot>\<^sub>D (F g \<star>\<^sub>D D.inv \<phi>') =
                               F g \<star>\<^sub>D D.inv \<phi>'"
                proof -
                  have "(D.inv (\<Phi> (g, w\<^sub>C')) \<cdot>\<^sub>D \<Phi> (g, w\<^sub>C')) \<cdot>\<^sub>D (F g \<star>\<^sub>D D.inv \<phi>') =
                        (F g \<star>\<^sub>D F w\<^sub>C') \<cdot>\<^sub>D (F g \<star>\<^sub>D D.inv \<phi>')"
                    using w\<^sub>C' \<beta>\<^sub>C F\<beta>\<^sub>C_def cmp_components_are_iso D.comp_inv_arr' by simp
                  also have "... = F g \<star>\<^sub>D D.inv \<phi>'"
                    using D.comp_cod_arr [of "F g \<star>\<^sub>D D.inv \<phi>'" "F g \<star>\<^sub>D F w\<^sub>C'"]
                    by (metis D.cod_inv D.null_is_zero(2) D.hseq_char' D.in_homE
                        D.is_weak_composition T'.leg1_simps(6) \<phi>'
                        weak_composition.hcomp_simps\<^sub>W\<^sub>C(3))
                  finally show ?thesis by blast
                qed
                ultimately show ?thesis
                  using D.comp_assoc by simp
              qed
              also have "... = \<Phi> (r, u\<^sub>C) \<cdot>\<^sub>D (F r \<star>\<^sub>D F \<theta>\<^sub>C') \<cdot>\<^sub>D (F r \<star>\<^sub>D \<Phi> (f, w\<^sub>C')) \<cdot>\<^sub>D
                                 \<a>\<^sub>D[F r, F f, F w\<^sub>C'] \<cdot>\<^sub>D (?\<rho>' \<star>\<^sub>D F w\<^sub>C') \<cdot>\<^sub>D (F g \<star>\<^sub>D D.inv \<phi>') \<cdot>\<^sub>D
                                 \<a>\<^sub>D[F g, w', e] \<cdot>\<^sub>D (\<beta> \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F g, w, e] \<cdot>\<^sub>D
                                 (F g \<star>\<^sub>D \<phi>) \<cdot>\<^sub>D D.inv (\<Phi> (g, w\<^sub>C))"
                using w\<^sub>C' D.whisker_right cmp_in_hom cmp_components_are_iso by simp
              also have "... = \<Phi> (r, u\<^sub>C) \<cdot>\<^sub>D
                                 (F r \<star>\<^sub>D \<psi> \<cdot>\<^sub>D (\<theta>' \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, w', e] \<cdot>\<^sub>D (F f \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D
                                   D.inv (\<Phi> (f, w\<^sub>C'))) \<cdot>\<^sub>D
                                 (F r \<star>\<^sub>D \<Phi> (f, w\<^sub>C')) \<cdot>\<^sub>D
                                 \<a>\<^sub>D[F r, F f, F w\<^sub>C'] \<cdot>\<^sub>D (?\<rho>' \<star>\<^sub>D F w\<^sub>C') \<cdot>\<^sub>D (F g \<star>\<^sub>D D.inv \<phi>') \<cdot>\<^sub>D
                                 \<a>\<^sub>D[F g, w', e] \<cdot>\<^sub>D (\<beta> \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F g, w, e] \<cdot>\<^sub>D
                                 (F g \<star>\<^sub>D \<phi>) \<cdot>\<^sub>D D.inv (\<Phi> (g, w\<^sub>C))"
                using \<theta>\<^sub>C' F\<theta>\<^sub>C'_def by simp
              also have "... = \<Phi> (r, u\<^sub>C) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<psi>) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<theta>' \<star>\<^sub>D e) \<cdot>\<^sub>D
                                 (F r \<star>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, w', e]) \<cdot>\<^sub>D (F r \<star>\<^sub>D F f \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D
                                 (((F r \<star>\<^sub>D D.inv (\<Phi> (f, w\<^sub>C'))) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<Phi> (f, w\<^sub>C'))) \<cdot>\<^sub>D
                                 \<a>\<^sub>D[F r, F f, F w\<^sub>C']) \<cdot>\<^sub>D (?\<rho>' \<star>\<^sub>D F w\<^sub>C') \<cdot>\<^sub>D (F g \<star>\<^sub>D D.inv \<phi>') \<cdot>\<^sub>D
                                 \<a>\<^sub>D[F g, w', e] \<cdot>\<^sub>D (\<beta> \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F g, w, e] \<cdot>\<^sub>D
                                 (F g \<star>\<^sub>D \<phi>) \<cdot>\<^sub>D D.inv (\<Phi> (g, w\<^sub>C))"
              proof -
                have "F r \<star>\<^sub>D \<psi> \<cdot>\<^sub>D (\<theta>' \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, w', e] \<cdot>\<^sub>D (F f \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D
                        D.inv (\<Phi> (f, w\<^sub>C')) =
                      (F r \<star>\<^sub>D \<psi>) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<theta>' \<star>\<^sub>D e) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, w', e]) \<cdot>\<^sub>D
                        (F r \<star>\<^sub>D F f \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D (F r \<star>\<^sub>D D.inv (\<Phi> (f, w\<^sub>C')))"
                  using D.whisker_left cmp_in_hom cmp_components_are_iso
                  by (metis C.arrI D.src.preserves_reflects_arr D.src_vcomp D.vseq_implies_hpar(1)
                      F\<theta>\<^sub>C'_def T'.ide_base \<theta>\<^sub>C' preserves_arr)
                thus ?thesis
                  using D.comp_assoc by simp
              qed
              also have "... = \<Phi> (r, u\<^sub>C) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<psi>) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<theta>' \<star>\<^sub>D e) \<cdot>\<^sub>D
                                 (F r \<star>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, w', e]) \<cdot>\<^sub>D ((F r \<star>\<^sub>D F f \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D
                                 \<a>\<^sub>D[F r, F f, F w\<^sub>C']) \<cdot>\<^sub>D (?\<rho>' \<star>\<^sub>D F w\<^sub>C') \<cdot>\<^sub>D (F g \<star>\<^sub>D D.inv \<phi>') \<cdot>\<^sub>D
                                 \<a>\<^sub>D[F g, w', e] \<cdot>\<^sub>D (\<beta> \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F g, w, e] \<cdot>\<^sub>D
                                 (F g \<star>\<^sub>D \<phi>) \<cdot>\<^sub>D D.inv (\<Phi> (g, w\<^sub>C))"
              proof -
                have "((F r \<star>\<^sub>D D.inv (\<Phi> (f, w\<^sub>C'))) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<Phi> (f, w\<^sub>C'))) \<cdot>\<^sub>D
                        \<a>\<^sub>D[F r, F f, F w\<^sub>C'] =
                      \<a>\<^sub>D[F r, F f, F w\<^sub>C']"
                  using cmp_in_hom cmp_components_are_iso D.comp_cod_arr
                        D.whisker_left [of "F r" "D.inv (\<Phi> (f, w\<^sub>C'))" "\<Phi> (f, w\<^sub>C')"]
                  by (simp add: D.comp_inv_arr' w\<^sub>C')
                thus ?thesis
                  using D.comp_assoc by simp
              qed
              also have "... = \<Phi> (r, u\<^sub>C) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<psi>) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<theta>' \<star>\<^sub>D e) \<cdot>\<^sub>D
                                 (F r \<star>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, w', e]) \<cdot>\<^sub>D \<a>\<^sub>D[F r, F f, w' \<star>\<^sub>D e] \<cdot>\<^sub>D
                                  (((F r \<star>\<^sub>D F f) \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D (?\<rho>' \<star>\<^sub>D F w\<^sub>C')) \<cdot>\<^sub>D (F g \<star>\<^sub>D D.inv \<phi>') \<cdot>\<^sub>D
                                 \<a>\<^sub>D[F g, w', e] \<cdot>\<^sub>D (\<beta> \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F g, w, e] \<cdot>\<^sub>D
                                 (F g \<star>\<^sub>D \<phi>) \<cdot>\<^sub>D D.inv (\<Phi> (g, w\<^sub>C))"
              proof -
                have "(F r \<star>\<^sub>D F f \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D \<a>\<^sub>D[F r, F f, F w\<^sub>C'] =
                      \<a>\<^sub>D[F r, F f, w' \<star>\<^sub>D e] \<cdot>\<^sub>D ((F r \<star>\<^sub>D F f) \<star>\<^sub>D \<phi>')"
                  using w\<^sub>C' \<phi>' D.assoc_naturality [of "F r" "F f" \<phi>']
                  by (metis C.ideD(1) D.dom_trg D.in_homE D.trg.preserves_dom
                      T'.leg0_simps(2-5) T'.base_simps(2-4) T.tab_simps(2) T.leg0_simps(2)
                      \<open>trg\<^sub>C w\<^sub>C' = src\<^sub>C \<rho>\<close> preserves_src preserves_trg)
                thus ?thesis
                  using D.comp_assoc by simp
              qed
              also have "... = \<Phi> (r, u\<^sub>C) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<psi>) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<theta>' \<star>\<^sub>D e) \<cdot>\<^sub>D
                                 (F r \<star>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, w', e]) \<cdot>\<^sub>D \<a>\<^sub>D[F r, F f, w' \<star>\<^sub>D e] \<cdot>\<^sub>D
                                 (?\<rho>' \<star>\<^sub>D w' \<star>\<^sub>D e) \<cdot>\<^sub>D (((F g \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D (F g \<star>\<^sub>D D.inv \<phi>')) \<cdot>\<^sub>D
                                 \<a>\<^sub>D[F g, w', e]) \<cdot>\<^sub>D (\<beta> \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F g, w, e] \<cdot>\<^sub>D
                                 (F g \<star>\<^sub>D \<phi>) \<cdot>\<^sub>D D.inv (\<Phi> (g, w\<^sub>C))"
              proof -
                have "((F r \<star>\<^sub>D F f) \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D (?\<rho>' \<star>\<^sub>D F w\<^sub>C') = (?\<rho>' \<star>\<^sub>D w' \<star>\<^sub>D e) \<cdot>\<^sub>D (F g \<star>\<^sub>D \<phi>')"
                  using \<phi>' D.interchange D.comp_arr_dom D.comp_cod_arr
                  by (metis D.in_homE T'.tab_in_hom(2))
                thus ?thesis
                  using D.comp_assoc by simp
              qed
              also have "... = \<Phi> (r, u\<^sub>C) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<psi>) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<theta>' \<star>\<^sub>D e) \<cdot>\<^sub>D
                                 ((F r \<star>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, w', e]) \<cdot>\<^sub>D \<a>\<^sub>D[F r, F f, w' \< *All RightsReserved
(\'\star\subD'\><>e\cdot>^> <\s>Dg,w',]\cdot<sub (< <star\^De <><subD\a>\^subD<sup>\^>1Fg ,e \>\^ubD
  ( xfs_mountmp;
  -
* java.lang.StringIndexOutOfBoundsException: Range [13, 12) out of bounds for length 67
proof
                  have "((F g \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D (F g \<star>\<^sub>D D.inv \<phi>')) \<cdot>\<^sub>D \<a>\<^sub>D[F g, w', e] =
                        (F g \<star>\<^sub>D w' \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D[F g, w', e]"
                    by (metis D.arr_inv D.cod_inv D.comp_arr_inv' D.in_homE D.seqI
                        D.whisker_left T'.ide_leg1 \<phi>')
                  also have "... = \<a>\<^sub>D[F g, w', e]"
                    using w' D.comp_cod_arr by simp
                  finally show ?thesis by blast
                qed
                thus ?thesis
                  using D.comp_assoc by simp
              qed
              also have "... = \<Phi> (r, u\<^sub>C) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<psi>) \<cdot>\<^sub>D ((F r \<star>\<^sub>D \<theta>' \<star>\<^sub>D e) \<cdot>\<^sub>D
                                 \<a>\<^sub>D[F r, F f \<star>\<^sub>D w', e]) \<cdot>\<^sub>D (\<a>\<^sub>D[F r, F f, w'] \<star>\<^sub>D e) \<cdot>\<^sub>D
                                 (\<a>\<^sub>D\<^sup>-\<^sup>1[F r \<star>\<^sub>D F f, w', e] \<cdot>\<^sub>D (?\<rho>' \<star>\<^sub>D w' \<star>\<^sub>D e)) \<cdot>\<^sub>D \<a>\<^sub>D[F g, w', e] \<cdot>\<^sub>D
                                 (\<beta> \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F g, w, e] \<cdot>\<^sub>D (F g \<star>\<^sub>D \<phi>) \<cdot>\<^sub>D D.inv (\<Phi> (g, w\<^sub>C))"
              proof -
                have "D.inv (F r \<star>\<^sub>D \<a>\<^sub>D[F f, w', e]) = F r \<star>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, w', e]"
                  using w' by simp
                moreover have "D.seq (F r \<star>\<^sub>D \<a>\<^sub>D[F f, w', e])
                                     (\<a>\<^sub>D[F r, F f \<star>\<^sub>D w', e] \<cdot>\<^sub>D (\<a>\<^sub>D[F r, F f, w'] \<star>\<^sub>D e))"
                  using w' by simp
                moreover have "D.iso (F r \<star>\<^sub>D \<a>\<^sub>D[F f, w', e])"
                  using w' by simp
                moreover have "D.iso \<a>\<^sub>D[F r \<star>\<^sub>D F f, w', e]"
                  using w' by simp
                moreover have "(F r \<star>\<^sub>D \<a>\<^sub>D[F f, w', e]) \<cdot>\<^sub>D \<a>\<^sub>D[F r, F f \<star>\<^sub>D w', e] \<cdot>\<^sub>D
                                 (\<a>\<^sub>D[F r, F f, w'] \<star>\<^sub>D e) =
                               \<a>\<^sub>D[F r, F f, w' \<star>\<^sub>D e] \<cdot>\<^sub>D \<a>\<^sub>D[F r \<star>\<^sub>D F f, w', e]"
                  using w' D.pentagon by simp
                ultimately
                have "(F r \<star>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, w', e]) \<cdot>\<^sub>D \<a>\<^sub>D[F r, F f, w' \<star>\<^sub>D e] =
                      \<a>\<^sub>D[F r, F f \<star>\<^sub>D w', e] \<cdot>\<^sub>D (\<a>\<^sub>D[F r, F f, w'] \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F r \<star>\<^sub>D F f, w', e]"
                  using w' D.comp_assoc
                        D.invert_opposite_sides_of_square
                          [of "F r \<star>\<^sub>D \<a>\<^sub>D[F f, w', e]" "\<a>\<^sub>D[F r, F f \<star>\<^sub>D w', e] \<cdot>\<^sub>D (\<a>\<^sub>D[F r, F f, w'] \<star>\<^sub>D e)"
                              "\<a>\<^sub>D[F r, F f, w' \<star>\<^sub>D e]"  "\<a>\<^sub>D[F r \<star>\<^sub>D F f, w', e]"]
                  by auto
                thus ?thesis
                  using D.comp_assoc by simp
              qed
              also have
                "... = \<Phi> (r, u\<^sub>C) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<psi>) \<cdot>\<^sub>D \<a>\<^sub>D[F r, u, e] \<cdot>\<^sub>D (((F r \<star>\<^sub>D \<theta>') \<star>\<^sub>D e) \<cdot>\<^sub>D
                         (\<a>\<^sub>D[F r, F f, w'] \<star>\<^sub>D e) \<cdot>\<^sub>D ((?\<rho>' \<star>\<^sub>D w') \<star>\<^sub>D e)) \<cdot>\<^sub>D
                         ((\<a>\<^sub>D\<^sup>-\<^sup>1[F g, w', e] \<cdot>\<^sub>D \<a>\<^sub>D[F g, w', e]) \<cdot>\<^sub>D (\<beta> \<star>\<^sub>D e)) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F g, w, e] \<cdot>\<^sub>D
                         (F g \<star>\<^sub>D \<phi>) \<cdot>\<^sub>D D.inv (\<Phi> (g, w\<^sub>C))"
              proof -
                have "(F r \<star>\<^sub>D \<theta>' \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D[F r, F f \<star>\<^sub>D w', e] =
                      \<a>\<^sub>D[F r, u, e] \<cdot>\<^sub>D ((F r \<star>\<^sub>D \<theta>') \<star>\<^sub>D e)"
                  using D.assoc_naturality [of "F r" \<theta>' e] \<theta>' by auto
                moreover have "\<a>\<^sub>D\<^sup>-\<^sup>1[F r \<star>\<^sub>D F f, w', e] \<cdot>\<^sub>D (?\<rho>' \<star>\<^sub>D w' \<star>\<^sub>D e) =
                               ((?\<rho>' \<star>\<^sub>D w') \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F g, w', e]"
                  using w' w'e D.assoc'_naturality [of ?\<rho>' w' e] by simp
                ultimately show ?thesis
                  using D.comp_assoc by simp
              qed
              also have "... = \<Phi> (r, u\<^sub>C) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<psi>) \<cdot>\<^sub>D \<a>\<^sub>D[F r, u, e] \<cdot>\<^sub>D
                                (T'.composite_cell w' \<theta>' \<star>\<^sub>D e) \<cdot>\<^sub>D (\<beta> \<star>\<^sub>D e) \<cdot>\<^sub>D
                                \<a>\<^sub>D\<^sup>-\<^sup>1[F g, w, e] \<cdot>\<^sub>D (F g \<star>\<^sub>D \<phi>) \<cdot>\<^sub>D D.inv (\<Phi> (g, w\<^sub>C))"
              proof -
                have "((F r \<star>\<^sub>D \<theta>') \<star>\<^sub>D e) \<cdot>\<^sub>D (\<a>\<^sub>D[F r, F f, w'] \<star>\<^sub>D e) \<cdot>\<^sub>D ((?\<rho>' \<star>\<^sub>D w') \<star>\<^sub>D e) =
                       T'.composite_cell w' \<theta>' \<star>\<^sub>D e"
                proof -
                  have "\<guillemotleft>T'.composite_cell w' \<theta>' : F g \<star>\<^sub>D w' \<Rightarrow>\<^sub>D F r \<star>\<^sub>D u\<guillemotright>"
                    using \<theta>' w' T'.composite_cell_in_hom D.vconn_implies_hpar(3) by simp
                  thus ?thesis
                    using D.whisker_right D.arrI by auto
                qed
                moreover have "(\<a>\<^sub>D\<^sup>-\<^sup>1[F g, w', e] \<cdot>\<^sub>D \<a>\<^sub>D[F g, w', e]) \<cdot>\<^sub>D (\<beta> \<star>\<^sub>D e) = \<beta> \<star>\<^sub>D e"
                  using w' \<beta> e.ide_left \<open>src\<^sub>D w' = a\<close> \<open>trg\<^sub>D e = a\<close> F\<beta>\<^sub>C F\<beta>\<^sub>C_def D.comp_cod_arr
                        D.comp_arr_inv'
                  by (metis (no_types, lifting) D.comp_assoc_assoc'(2) D.hcomp_simps(1)
                      D.hcomp_simps(4) D.hseqI' D.ide_char D.in_homE D.vconn_implies_hpar(1)
                      D.vconn_implies_hpar(3) T'.ide_leg1 T.leg1_simps(2) T.leg1_simps(3)
                      T.tab_simps(2) \<open>trg\<^sub>D w' = map\<^sub>0 (src\<^sub>C \<rho>)\<close> preserves_src)
                ultimately show ?thesis
                  using D.comp_assoc by simp
              qed
              also have "... = \<Phi> (r, u\<^sub>C) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<psi>) \<cdot>\<^sub>D \<a>\<^sub>D[F r, u, e] \<cdot>\<^sub>D
                                 (T'.composite_cell w' \<theta>' \<cdot>\<^sub>D \<beta> \<star>\<^sub>D e) \<cdot>\<^sub>D
                                 \<a>\<^sub>D\<^sup>-\<^sup>1[F g, w, e] \<cdot>\<^sub>D (F g \<star>\<^sub>D \<phi>) \<cdot>\<^sub>D D.inv (\<Phi> (g, w\<^sub>C))"
              proof -
                have "D.arr (T'.composite_cell w' \<theta>' \<cdot>\<^sub>D \<beta>)"
                  by (metis (full_types) D.hseq_char D.seqE L eq par preserves_arr)
                thus ?thesis
                  using D.whisker_right by (metis D.comp_assoc e.ide_left)
              qed
              finally have R: "F (T.composite_cell w\<^sub>C' \<theta>\<^sub>C' \<cdot>\<^sub>C \<beta>\<^sub>C) =
                               \<Phi> (r, u\<^sub>C) \<cdot>\<^sub>D (F r \<star>\<^sub>D \<psi>) \<cdot>\<^sub>D \<a>\<^sub>D[F r, u, e] \<cdot>\<^sub>D
                                 (T'.composite_cell w' \<theta>' \<cdot>\<^sub>D \<beta> \<star>\<^sub>D e) \<cdot>\<^sub>D
                                 \<a>\<^sub>D\<^sup>-\<^sup>1[F g, w, e] \<cdot>\<^sub>D (F g \<star>\<^sub>D \<phi>) \<cdot>\<^sub>D D.inv (\<Phi> (g, w\<^sub>C))"
                by simp

              show "F (T.composite_cell w\<^sub>C \<theta>\<^sub>C) = F (T.composite_cell w\<^sub>C' \<theta>\<^sub>C' \<cdot>\<^sub>C \<beta>\<^sub>C)"
                using eq L R by simp
            qed
            ultimately show ?thesis
              using is_faithful [of "T.composite_cell w\<^sub>C \<theta>\<^sub>C" "T.composite_cell w\<^sub>C' \<theta>\<^sub>C' \<cdot>\<^sub>C \<beta>\<^sub>C"]
              by simp
          qed
          have **: "\<exists>!\<gamma>. \<guillemotleft>\<gamma> : w\<^sub>C \<Rightarrow>\<^sub>C w\<^sub>C'\<guillemotright> \<and> \<beta>\<^sub>C = g \<star>\<^sub>C \<gamma> \<and> \<theta>\<^sub>C = \<theta>\<^sub>C' \<cdot>\<^sub>C (f \<star>\<^sub>C \<gamma>)"
            using * w\<^sub>C w\<^sub>C' \<theta>\<^sub>C \<theta>\<^sub>C' \<beta>\<^sub>C T.T2 [of w\<^sub>C w\<^sub>C' \<theta>\<^sub>C u\<^sub>C \<theta>\<^sub>C' \<beta>\<^sub>C] by simp
          obtain \<gamma>\<^sub>C where
            \<gamma>\<^sub>C: "\<guillemotleft>\<gamma>\<^sub>C : w\<^sub>C \<Rightarrow>\<^sub>C w\<^sub>C'\<guillemotright> \<and> \<beta>\<^sub>C = g \<star>\<^sub>C \<gamma>\<^sub>C \<and> \<theta>\<^sub>C = \<theta>\<^sub>C' \<cdot>\<^sub>C (f \<star>\<^sub>C \<gamma>\<^sub>C)"
            using ** by auto
          have \<gamma>\<^sub>C_unique: "\<And>\<gamma>\<^sub>C'. \<guillemotleft>\<gamma>\<^sub>C' : w\<^sub>C \<Rightarrow>\<^sub>C w\<^sub>C'\<guillemotright> \<and> \<beta>\<^sub>C = g \<star>\<^sub>C \<gamma>\<^sub>C' \<and>
                                 \<theta>\<^sub>C = \<theta>\<^sub>C' \<cdot>\<^sub>C (f \<star>\<^sub>C \<gamma>\<^sub>C') \<Longrightarrow> \<gamma>\<^sub>C' = \<gamma>\<^sub>C"
            using \<gamma>\<^sub>C ** by blast

          text \<open>
            Now use \<open>F\<close> to map everything back to \<open>D\<close>, transport the result along the
            equivalence map \<open>e\<close>, and cancel all of the isomorphisms that got introduced.
          \<close>

          let ?P = "\<lambda>\<gamma>. \<guillemotleft>\<gamma> : w \<star>\<^sub>D e \<Rightarrow>\<^sub>D w' \<star>\<^sub>D e\<guillemotright> \<and>
                        \<a>\<^sub>D[F g, w', e] \<cdot>\<^sub>D (\<beta> \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F g, w, e] = F g \<star>\<^sub>D \<gamma> \<and>
                        \<psi> \<cdot>\<^sub>D (\<theta> \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, w, e] =
                        \<psi> \<cdot>\<^sub>D (\<theta>' \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, w', e] \<cdot>\<^sub>D (F f \<star>\<^sub>D \<gamma>)"
          define \<gamma>e where "\<gamma>e = \<phi>' \<cdot>\<^sub>D F \<gamma>\<^sub>C \<cdot>\<^sub>D D.inv \<phi>"
          have P\<gamma>e: "?P \<gamma>e"
          proof -
            have 1: "\<guillemotleft>F \<gamma>\<^sub>C : F w\<^sub>C \<Rightarrow>\<^sub>D F w\<^sub>C'\<guillemotright> \<and>
                     F \<beta>\<^sub>C = \<Phi> (g, w\<^sub>C') \<cdot>\<^sub>D (F g \<star>\<^sub>D F \<gamma>\<^sub>C) \<cdot>\<^sub>D D.inv (\<Phi> (g, w\<^sub>C)) \<and>
                     F \<theta>\<^sub>C = F \<theta>\<^sub>C' \<cdot>\<^sub>D \<Phi> (f, C.cod \<gamma>\<^sub>C) \<cdot>\<^sub>D (F f \<star>\<^sub>D F \<gamma>\<^sub>C) \<cdot>\<^sub>D D.inv (\<Phi> (f, w\<^sub>C))"
              using \<beta>\<^sub>C \<theta>\<^sub>C \<gamma>\<^sub>C preserves_hcomp [of f \<gamma>\<^sub>C] preserves_hcomp [of g \<gamma>\<^sub>C] by force
            have A: "\<a>\<^sub>D[F g, w', e] \<cdot>\<^sub>D (\<beta> \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F g, w, e] =
                     F g \<star>\<^sub>D \<phi>' \<cdot>\<^sub>D F \<gamma>\<^sub>C \<cdot>\<^sub>D D.inv \<phi>"
            proof -
              have "F g \<star>\<^sub>D F \<gamma>\<^sub>C = D.inv (\<Phi> (g, w\<^sub>C')) \<cdot>\<^sub>D F \<beta>\<^sub>C \<cdot>\<^sub>D \<Phi> (g, w\<^sub>C)"
              proof -
                have "F \<beta>\<^sub>C = \<Phi> (g, w\<^sub>C') \<cdot>\<^sub>D (F g \<star>\<^sub>D F \<gamma>\<^sub>C) \<cdot>\<^sub>D D.inv (\<Phi> (g, w\<^sub>C))"
                  using 1 by simp
                hence "D.inv (\<Phi> (g, w\<^sub>C')) \<cdot>\<^sub>D F \<beta>\<^sub>C = (F g \<star>\<^sub>D F \<gamma>\<^sub>C) \<cdot>\<^sub>D D.inv (\<Phi> (g, w\<^sub>C))"
                  using w\<^sub>C w\<^sub>C' \<open>trg\<^sub>C w\<^sub>C = src\<^sub>C \<rho>\<close> \<open>trg\<^sub>C w\<^sub>C' = src\<^sub>C \<rho>\<close> cmp_components_are_iso
                        D.invert_side_of_triangle(1)
                  by (metis D.arrI F\<beta>\<^sub>C T.ide_leg1 T.leg1_simps(3) T.tab_simps(2) \<beta>\<^sub>C)
                hence "(D.inv (\<Phi> (g, w\<^sub>C')) \<cdot>\<^sub>D F \<beta>\<^sub>C) \<cdot>\<^sub>D \<Phi> (g, w\<^sub>C) = F g \<star>\<^sub>D F \<gamma>\<^sub>C"
                  using cmp_components_are_iso D.invert_side_of_triangle(2)
                  by (metis "1" D.arrI D.inv_inv D.iso_inv_iso D.seqE F\<beta>\<^sub>C T.ide_leg1
                      T.leg1_simps(3) T.tab_simps(2) \<beta>\<^sub>C \<open>trg\<^sub>C w\<^sub>C = src\<^sub>C \<rho>\<close> w\<^sub>C)
                thus ?thesis
                  using D.comp_assoc by simp
              qed
              also have "... = ((D.inv (\<Phi> (g, w\<^sub>C')) \<cdot>\<^sub>D \<Phi> (g, w\<^sub>C')) \<cdot>\<^sub>D (F g \<star>\<^sub>D D.inv \<phi>')) \<cdot>\<^sub>D
                                 \<a>\<^sub>D[F g, w', e] \<cdot>\<^sub>D (\<beta> \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F g, w, e] \<cdot>\<^sub>D (F g \<star>\<^sub>D \<phi>) \<cdot>\<^sub>D
                                 D.inv (\<Phi> (g, w\<^sub>C)) \<cdot>\<^sub>D \<Phi> (g, w\<^sub>C)"
                    using \<beta>\<^sub>C F\<beta>\<^sub>C_def D.comp_assoc by simp
              also have "... = (F g \<star>\<^sub>D D.inv \<phi>') \<cdot>\<^sub>D \<a>\<^sub>D[F g, w', e] \<cdot>\<^sub>D (\<beta> \<star>\<^sub>D e) \<cdot>\<^sub>D
                                 \<a>\<^sub>D\<^sup>-\<^sup>1[F g, w, e] \<cdot>\<^sub>D (F g \<star>\<^sub>D \<phi>)"
              proof -
                have "(D.inv (\<Phi> (g, w\<^sub>C')) \<cdot>\<^sub>D \<Phi> (g, w\<^sub>C')) \<cdot>\<^sub>D (F g \<star>\<^sub>D D.inv \<phi>') = F g \<star>\<^sub>D D.inv \<phi>'"
                proof -
                  have "(D.inv (\<Phi> (g, w\<^sub>C')) \<cdot>\<^sub>D \<Phi> (g, w\<^sub>C')) \<cdot>\<^sub>D (F g \<star>\<^sub>D D.inv \<phi>') =
                        (F g \<star>\<^sub>D F w\<^sub>C') \<cdot>\<^sub>D (F g \<star>\<^sub>D D.inv \<phi>')"
                    using w\<^sub>C' \<phi>' cmp_components_are_iso D.comp_inv_arr' by simp
                  also have "... = F g \<star>\<^sub>D D.inv \<phi>'"
                    using w\<^sub>C' \<phi>' D.comp_cod_arr
                    by (metis D.arr_inv D.cod_inv D.in_homE D.whisker_left T'.ide_leg1)
                  finally show ?thesis by blast
                qed
                moreover have "(F g \<star>\<^sub>D \<phi>) \<cdot>\<^sub>D D.inv (\<Phi> (g, w\<^sub>C)) \<cdot>\<^sub>D \<Phi> (g, w\<^sub>C) = F g \<star>\<^sub>D \<phi>"
                proof -
                  have "(F g \<star>\<^sub>D \<phi>) \<cdot>\<^sub>D D.inv (\<Phi> (g, w\<^sub>C)) \<cdot>\<^sub>D \<Phi> (g, w\<^sub>C) =
                        (F g \<star>\<^sub>D \<phi>) \<cdot>\<^sub>D (F g \<star>\<^sub>D F w\<^sub>C)"
                    using w\<^sub>C \<phi> \<open>trg\<^sub>C w\<^sub>C = src\<^sub>C \<rho>\<close> cmp_components_are_iso cmp_in_hom
                          D.comp_inv_arr'
                    by simp
                  also have "... = F g \<star>\<^sub>D \<phi>"
                    using w\<^sub>C \<phi> D.comp_arr_dom
                    by (metis D.hcomp_simps(3) D.hseqI' D.in_hhom_def D.in_homE
                        D.vconn_implies_hpar(2) D.vconn_implies_hpar(4) T'.leg1_simps(2,5)
                        T.leg1_simps(2-3) T.tab_simps(2) preserves_src we)
                  finally show ?thesis by blast
                qed
                ultimately show ?thesis by simp
              qed
              finally have 2: "(F g \<star>\<^sub>D D.inv \<phi>') \<cdot>\<^sub>D (\<a>\<^sub>D[F g, w', e] \<cdot>\<^sub>D (\<beta> \<star>\<^sub>D e) \<cdot>\<^sub>D
                                 \<a>\<^sub>D\<^sup>-\<^sup>1[F g, w, e]) \<cdot>\<^sub>D (F g \<star>\<^sub>D \<phi>) =
                               F g \<star>\<^sub>D F \<gamma>\<^sub>C"
                using D.comp_assoc by simp
              have 3: "(\<a>\<^sub>D[F g, w', e] \<cdot>\<^sub>D (\<beta> \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F g, w, e]) \<cdot>\<^sub>D (F g \<star>\<^sub>D \<phi>) =
                       (F g \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D (F g \<star>\<^sub>D F \<gamma>\<^sub>C)"
              proof -
                have "D.hseq (F g) (F \<gamma>\<^sub>C)"
                  using "1" F\<beta>\<^sub>C \<beta>\<^sub>C by auto
                moreover have "D.iso (F g \<star>\<^sub>D D.inv \<phi>')"
                  by (metis "2" D.iso_hcomp D.hseqE D.ide_is_iso D.iso_inv_iso D.seqE
                      T'.ide_leg1 \<phi>' calculation)
                moreover have "D.inv (F g \<star>\<^sub>D D.inv \<phi>') = F g \<star>\<^sub>D \<phi>'"
                  by (metis D.hseqE D.ide_is_iso D.inv_hcomp D.inv_ide D.inv_inv D.iso_inv_iso
                      D.iso_is_arr T'.ide_leg1 \<phi>' calculation(2))
                ultimately show ?thesis
                  using 2 \<phi> \<phi>'
                        D.invert_side_of_triangle(1)
                          [of "F g \<star>\<^sub>D F \<gamma>\<^sub>C" "F g \<star>\<^sub>D D.inv \<phi>'"
                              "(\<a>\<^sub>D[F g, w', e] \<cdot>\<^sub>D (\<beta> \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F g, w, e]) \<cdot>\<^sub>D (F g \<star>\<^sub>D \<phi>)"]
                  by auto
              qed
              hence "\<a>\<^sub>D[F g, w', e] \<cdot>\<^sub>D (\<beta> \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F g, w, e] =
                     ((F g \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D (F g \<star>\<^sub>D F \<gamma>\<^sub>C)) \<cdot>\<^sub>D (F g \<star>\<^sub>D D.inv \<phi>)"
              proof -
                have "D.seq (F g \<star>\<^sub>D \<phi>') (F g \<star>\<^sub>D F \<gamma>\<^sub>C)"
                  by (metis "1" "2" "3" D.arrI D.null_is_zero(1) D.null_is_zero(2) D.ext F\<beta>\<^sub>C \<beta>\<^sub>C)
                moreover have "D.iso (F g \<star>\<^sub>D \<phi>)"
                  using D.vconn_implies_hpar(2) D.vconn_implies_hpar(4) \<phi> we by auto
                moreover have "D.inv (F g \<star>\<^sub>D \<phi>) = F g \<star>\<^sub>D D.inv \<phi>"
                  by (metis D.hseqE D.ide_is_iso D.inv_hcomp D.inv_ide D.iso_is_arr
                      T'.ide_leg1 \<phi> calculation(2))
                ultimately show ?thesis
                  using 3 \<phi> \<phi>'
                        D.invert_side_of_triangle(2)
                          [of "(F g \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D (F g \<star>\<^sub>D F \<gamma>\<^sub>C)"
                              "\<a>\<^sub>D[F g, w', e] \<cdot>\<^sub>D (\<beta> \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F g, w, e]" "F g \<star>\<^sub>D \<phi>"]
                  by auto
              qed
              also have "... = F g \<star>\<^sub>D \<phi>' \<cdot>\<^sub>D F \<gamma>\<^sub>C \<cdot>\<^sub>D D.inv \<phi>"
                using \<phi>' D.whisker_left
                by (metis "1" D.arr_inv D.cod_comp D.cod_inv D.comp_assoc D.in_homE D.seqI
                    T'.ide_leg1 \<phi>)
              finally show ?thesis by simp
            qed
            have B: "\<psi> \<cdot>\<^sub>D (\<theta> \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, w, e] =
                     \<psi> \<cdot>\<^sub>D (\<theta>' \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, w', e] \<cdot>\<^sub>D (F f \<star>\<^sub>D \<phi>' \<cdot>\<^sub>D F \<gamma>\<^sub>C \<cdot>\<^sub>D D.inv \<phi>)"
            proof -
              have "F \<theta>\<^sub>C' \<cdot>\<^sub>D \<Phi> (f, w\<^sub>C') \<cdot>\<^sub>D (F f \<star>\<^sub>D F \<gamma>\<^sub>C) \<cdot>\<^sub>D D.inv (\<Phi> (f, w\<^sub>C)) =
                    (\<psi> \<cdot>\<^sub>D (\<theta>' \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, w', e] \<cdot>\<^sub>D (F f \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D (D.inv (\<Phi> (f, w\<^sub>C')) \<cdot>\<^sub>D
                      \<Phi> (f, w\<^sub>C')) \<cdot>\<^sub>D (F f \<star>\<^sub>D F \<gamma>\<^sub>C)) \<cdot>\<^sub>D D.inv (\<Phi> (f, w\<^sub>C))"
                using \<gamma>\<^sub>C \<theta>\<^sub>C' F\<theta>\<^sub>C'_def D.comp_assoc by auto
              also have "... = \<psi> \<cdot>\<^sub>D (\<theta>' \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, w', e] \<cdot>\<^sub>D (F f \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D
                                 (F f \<star>\<^sub>D F \<gamma>\<^sub>C) \<cdot>\<^sub>D D.inv (\<Phi> (f, w\<^sub>C))"
              proof -
                have "(D.inv (\<Phi> (f, w\<^sub>C')) \<cdot>\<^sub>D \<Phi> (f, w\<^sub>C')) \<cdot>\<^sub>D (F f \<star>\<^sub>D F \<gamma>\<^sub>C) = F f \<star>\<^sub>D F \<gamma>\<^sub>C"
                  using D.comp_cod_arr
                  by (metis (mono_tags, lifting) C.in_homE D.cod_comp D.comp_inv_arr' D.seqE
                      T.tab_simps(2) T.ide_leg0 cmp_components_are_iso \<gamma>\<^sub>C 1 \<open>trg\<^sub>C w\<^sub>C' = src\<^sub>C \<rho>\<close>
                      \<theta>\<^sub>C preserves_arr w\<^sub>C')
                thus ?thesis
                  using D.comp_assoc by simp
              qed
              finally have "F \<theta>\<^sub>C' \<cdot>\<^sub>D \<Phi> (f, w\<^sub>C') \<cdot>\<^sub>D (F f \<star>\<^sub>D F \<gamma>\<^sub>C) \<cdot>\<^sub>D D.inv (\<Phi> (f, w\<^sub>C)) =
                            \<psi> \<cdot>\<^sub>D (\<theta>' \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, w', e] \<cdot>\<^sub>D (F f \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D
                              (F f \<star>\<^sub>D F \<gamma>\<^sub>C) \<cdot>\<^sub>D D.inv (\<Phi> (f, w\<^sub>C))"
                by simp
              hence 3: "F \<theta>\<^sub>C' \<cdot>\<^sub>D \<Phi> (f, w\<^sub>C') \<cdot>\<^sub>D (F f \<star>\<^sub>D F \<gamma>\<^sub>C) =
                        \<psi> \<cdot>\<^sub>D (\<theta>' \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, w', e] \<cdot>\<^sub>D (F f \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D (F f \<star>\<^sub>D F \<gamma>\<^sub>C)"
                using cmp_components_are_iso D.iso_inv_iso D.iso_is_retraction D.retraction_is_epi
                      D.epi_cancel
                by (metis C.in_homE D.comp_assoc T.tab_simps(2) T.ide_leg0 \<gamma>\<^sub>C 1
                    \<open>trg\<^sub>C w\<^sub>C = src\<^sub>C \<rho>\<close> \<theta>\<^sub>C preserves_arr w\<^sub>C)
              hence "(\<psi> \<cdot>\<^sub>D (\<theta> \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, w, e] \<cdot>\<^sub>D (F f \<star>\<^sub>D \<phi>)) \<cdot>\<^sub>D D.inv (\<Phi> (f, w\<^sub>C)) =
                     (\<psi> \<cdot>\<^sub>D (\<theta>' \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, w', e] \<cdot>\<^sub>D (F f \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D
                       (F f \<star>\<^sub>D F \<gamma>\<^sub>C)) \<cdot>\<^sub>D D.inv (\<Phi> (f, w\<^sub>C))"
                using 1 \<theta>\<^sub>C F\<theta>\<^sub>C_def D.comp_assoc by (metis C.in_homE \<gamma>\<^sub>C)
              hence 2: "(\<psi> \<cdot>\<^sub>D (\<theta> \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, w, e]) \<cdot>\<^sub>D (F f \<star>\<^sub>D \<phi>) =
                         \<psi> \<cdot>\<^sub>D (\<theta>' \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, w', e] \<cdot>\<^sub>D (F f \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D (F f \<star>\<^sub>D F \<gamma>\<^sub>C)"
                using \<gamma>\<^sub>C cmp_components_are_iso D.iso_inv_iso D.iso_is_retraction
                      D.retraction_is_epi D.epi_cancel
                by (metis (mono_tags, lifting) 1 3 C.in_homE D.comp_assoc T.tab_simps(2)
                      T.ide_leg0 \<open>trg\<^sub>C w\<^sub>C = src\<^sub>C \<rho>\<close> \<theta>\<^sub>C preserves_arr w\<^sub>C)
              hence "\<psi> \<cdot>\<^sub>D (\<theta> \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, w, e] =
                     (\<psi> \<cdot>\<^sub>D (\<theta>' \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, w', e]) \<cdot>\<^sub>D
                       (F f \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D (F f \<star>\<^sub>D F \<gamma>\<^sub>C) \<cdot>\<^sub>D (F f \<star>\<^sub>D D.inv \<phi>)"
              proof -
                have "D.inv (F f \<star>\<^sub>D \<phi>) = F f \<star>\<^sub>D D.inv \<phi>"
                  using \<phi>
                  by (metis C.arrI D.hseq_char D.ide_is_iso D.inv_hcomp D.inv_ide D.seqE F\<theta>\<^sub>C_def
                      T'.ide_leg0 preserves_arr \<theta>\<^sub>C)
                thus ?thesis
                  using \<phi> \<phi>' \<theta> \<theta>' \<gamma>\<^sub>C D.invert_side_of_triangle(2)
                  by (metis 2 C.arrI D.comp_assoc D.iso_hcomp D.hseqE D.ide_is_iso D.seqE
                      F\<theta>\<^sub>C_def T'.ide_leg0 \<theta>\<^sub>C preserves_arr)
              qed
              also have "... = \<psi> \<cdot>\<^sub>D (\<theta>' \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, w', e] \<cdot>\<^sub>D
                                (F f \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D (F f \<star>\<^sub>D F \<gamma>\<^sub>C) \<cdot>\<^sub>D (F f \<star>\<^sub>D D.inv \<phi>)"
                using D.comp_assoc by simp
              also have
                "... = \<psi> \<cdot>\<^sub>D (\<theta>' \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, w', e] \<cdot>\<^sub>D (F f \<star>\<^sub>D \<phi>' \<cdot>\<^sub>D F \<gamma>\<^sub>C \<cdot>\<^sub>D D.inv \<phi>)"
              proof -
                have "D.arr (\<phi>' \<cdot>\<^sub>D F \<gamma>\<^sub>C \<cdot>\<^sub>D D.inv \<phi>)"
                  using "1" \<phi> \<phi>' by blast
                thus ?thesis
                  using D.whisker_left by auto
              qed
              finally show ?thesis by simp
            qed
            have C: "\<guillemotleft>\<phi>' \<cdot>\<^sub>D F \<gamma>\<^sub>C \<cdot>\<^sub>D D.inv \<phi> : w \<star>\<^sub>D e \<Rightarrow>\<^sub>D w' \<star>\<^sub>D e\<guillemotright>"
              using \<phi> \<phi>' \<gamma>\<^sub>C 1 by (meson D.comp_in_homI D.inv_in_hom)
            show ?thesis
              unfolding \<gamma>e_def
              using A B C by simp
          qed
          have UN: "\<And>\<gamma>. ?P \<gamma> \<Longrightarrow> \<gamma> = \<gamma>e"
          proof -
            fix \<gamma>
            assume \<gamma>: "?P \<gamma>"
            show "\<gamma> = \<gamma>e"
            proof -
              let ?\<gamma>' = "D.inv \<phi>' \<cdot>\<^sub>D \<gamma> \<cdot>\<^sub>D \<phi>"
              have \<gamma>': "\<guillemotleft>?\<gamma>' : F w\<^sub>C \<Rightarrow>\<^sub>D F w\<^sub>C'\<guillemotright>"
                using \<gamma> \<phi> \<phi>' by auto
              obtain <gamma><sub' where \gamma>\<sub>C' "<guillemotleft><gamma>\^sub>C'  w<^ubC \Rightarrow>\^subC \<^ub'\guillemotright> \<and> F \<gamma>\<^sub>C' = ?\<gamma>'"
                using w\<^sub>C w\<^sub>C'  *failurejava.lang.StringIndexOutOfBoundsException: Index 11 out of bounds for length 11
have \beta>\^ub> =g \<tar\<^ubC\g\^>'
java.lang.StringIndexOutOfBoundsException: Index 21 out of bounds for length 21
                have "F \<beta>\<^sub>C = F  *
                proof -
                  have "F \<beta>\<^sub>C =
>C)\cdot\^D(g\star<s>D D. \phi>' \cdot><^sub> \<a\^D[F ,w,e \<>\<subD(<beta>\star>\<subDe) \cdot\<^>java.lang.StringIndexOutOfBoundsException: Index 199 out of bounds for length 199
                          \<a>\<^sub>D\<^sup>-\<^sup>1[F g, w, e] \<cdot>\<^sub>D (F g \<star>\<^sub>D \<phi>) \<cdot>\<^sub>D D.inv (\<Phi> (g, w\<^sub>C))"
                    using \<beta>\<^sub>C F\<beta>\<^sub>C_def by simp
                   *@b:super block instance used to recover past segment
                        <> g, w<^ub>' <><^>D ( g \star\<sub> D.inv \<phi>'\<cdot>\<subD <gamma>\<dot\<subD\<hi> \cdot>\<^sub>D D.inv (\<Phi> (g w\^sub>C))"
                    using \<gamma>\<^sub>C' preserves_hcomp
                    by (metis Cint valid_fs= nilfs_valid_fsnilfs;
        Tleg1_simps(,-)\open>\^> \^>  \<sub>C \><>java.lang.StringIndexOutOfBoundsException: Index 102 out of bounds for length 102
                   have .. =\Phi (,w\<^sub>C')\<dot\<^ubD(F  \star\^sub> D. \phi' \<dot\<sub> F g\star\^>D \gamma)\cdot>\^sub>
                       Fg \star><^ubD\phi> \<dot\<subD .inv\Phi (,w<^sub>C))
using<> <'D.hisker_left comp_assoc
                    by metis D. D. F\beta><sub>_ T'ide_leg1 \gamma>\gamma>)
                  also have "...  goto failed;
                                     (\<a returnres;
                                     (g\star\^> <)\cdot>\^> .inv(<>(,w<sub>C)"
                    using \{
also .. = F\beta\<^ubC
                     =le32_to_cpu(bp->_locks_per_segment)
                  finally
                qed
                return0;
                proof (=c,sumoff+ ,
show".rr \beta\<sub>java.lang.StringIndexOutOfBoundsException: Index 46 out of bounds for length 46
 *
>C"
                    nilfs_swap_super_block  *)
               Cdom \beta\^C=.domg<\^ubC\\^ub>'
                    using 2 \<beta>\<^sub     blocksize;
                  show "C.cod \<beta>\<^sub>C = C.cod (g \<star  */java.lang.StringIndexOutOfBoundsException: Index 0 out of bounds for length 0
using2 \<beta><^sub> \gamma>\^sub>'by 
                qed
                ultimately show ?thesis using is_faithful by blast
              qed
              have 2: "older =valid[1] ^ swp;
              proof -
*
                proof 
                  have "F (nilfs_err(bjava.lang.StringIndexOutOfBoundsException: Index 15 out of bounds for length 15
                    using \<theta>\<^sub
                  also have
                    "... = F  nilfs_discard_segmentsstruct  *ilfs,_u64 segnumpjava.lang.StringIndexOutOfBoundsException: Index 67 out of bounds for length 67
                    using w\<  elsejava.lang.StringIndexOutOfBoundsException: Index 10 out of bounds for length 10
                    by (metis C.'C.n_homE C.trg_dom Ttab_simps(2) T.leg0_simps(2)
                        T.leg0_simps(4-5) \ ncleansegs = nilfs_sufile_get_ncleansegsnilfs-ns_sufile)java.lang.StringIndexOutOfBoundsException: Index 60 out of bounds for length 60
                  also have "... = F  }else if (no > -cno {
)
                                     D.inv (\<Phi   ()
                    ()
                                        
                  also have "... = \<psi> \<cdot>\<^sub>D (\<theta>' \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, w', e] \<cdot>\<^sub>D (((F f \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D
                                     (D.inv (\<Phi> (f, w\<^sub>C')) \<cdot>\<^sub>D \<Phi> (f, w\<^sub>C')) \<cdot>\<^sub>D (F f \<star>\<^sub>D D.inv \<phi>')) \<cdot>\<^sub>D
                                     (F f \<star>\<^sub>D \<gamma>)) \<cdot>\<^sub>D (F f \<star>\<^sub>D \<phi>) \<cdot>\<^sub>D D.inv (\<Phi> (f, w\<^sub>C))"
                    using \<theta>\<^sub>C' F\<theta>\<^sub>C'_def D.comp_assoc by simp
                  also have "... = (\<psi> \<cdot>\<^sub>D (\<theta>' \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, w', e] \<cdot>\<^sub>D (F f \<star>\<^sub>D \<gamma>)) \<cdot>\<^sub>D
                                     (F f \<star>\<^sub>D \<phi>) \<cdot>\<^sub>D D.inv (\<Phi> (f, w\<^sub>C))"
                  proof -
                    have "D.inv (\<Phi> (f, w\<^sub>C')) \<cdot>\<^sub>D \<Phi> (f, w\<^sub>C') = F f \<star>\<^sub>D F w\<^sub>C'"
                      using w\<^sub>C' cmp_in_hom cmp_components_are_iso
                      by (simp add: D.comp_inv_arr')
                    moreover have "D.hseq (F f) (D.inv \<phi>')"
                      using \<phi>' D.hseqI'
                      by (metis D.ide_is_iso D.in_hhom_def D.iso_inv_iso D.iso_is_arr
                          D.trg_inv D.vconn_implies_hpar(2) D.vconn_implies_hpar(4)
                          T'.ide_leg0 T'.leg1_simps(3) T.leg1_simps(2-3)
                          T.tab_simps(2) \<gamma> preserves_src we)
                    ultimately have "(D.inv (\<Phi> (f, w\<^sub>C')) \<cdot>\<^sub>D \<Phi> (f, w\<^sub>C')) \<cdot>\<^sub>D (F f \<star>\<^sub>D D.inv \<phi>') =
                                     F f \<star>\<^sub>D D.inv \<phi>'"
                      using w\<^sub>C' \<phi>' D.comp_cod_arr [of "F f \<star>\<^sub>D D.inv \<phi>'" "F f \<star>\<^sub>D F w\<^sub>C'"]
                      by fastforce
                    hence "((F f \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D (D.inv (\<Phi> (f, w\<^sub>C')) \<cdot>\<^sub>D \<Phi> (f, w\<^sub>C')) \<cdot>\<^sub>D
                             (F f \<star>\<^sub>D D.inv \<phi>')) \<cdot>\<^sub>D (F f \<star>\<^sub>D \<gamma>) =
                           ((F f \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D (F f \<star>\<^sub>D D.inv \<phi>')) \<cdot>\<^sub>D (F f \<star>\<^sub>D \<gamma>)"
                      by simp
                    also have "... = F f \<star>\<^sub>D \<gamma>"
                      using \<gamma> \<phi>' \<theta>\<^sub>C' F\<theta>\<^sub>C'_def D.comp_cod_arr D.whisker_left D.hseqI'
                      by (metis D.comp_arr_inv' D.in_hhom_def D.in_homE T'.ide_leg0 w'e)
                    finally have "((F f \<star>\<^sub>D \<phi>') \<cdot>\<^sub>D (D.inv (\<Phi> (f, w\<^sub>C')) \<cdot>\<^sub>D \<Phi> (f, w\<^sub>C')) \<cdot>\<^sub>D
                                    (F f \<star>\<^sub>D D.inv \<phi>')) \<cdot>\<^sub>D (F f \<star>\<^sub>D \<gamma>) =
                                  F f \<star>\<^sub>D \<gamma>"
                      by simp
                    thus ?thesis
                      using D.comp_assoc by simp
                  qed
                  also have "... = \<psi> \<cdot>\<^sub>D (\<theta> \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F f, w, e] \<cdot>\<^sub>D
                                     (F f \<star>\<^sub>D \<phi>) \<cdot>\<^sub>D D.inv (\<Phi> (f, w\<^sub>C))"
                    using \<gamma> D.comp_assoc by metis
                  also have "... = F \<theta>\<^sub>C"
                    using \<theta>\<^sub>C F\<theta>\<^sub>C_def by simp
                  finally show ?thesis by simp
                qed
                moreover have "C.par \<theta>\<^sub>C (\<theta>\<^sub>C' \<cdot>\<^sub>C (f \<star>\<^sub>C \<gamma>\<^sub>C'))"
                proof (intro conjI)
                  show "C.arr \<theta>\<^sub>C"
                    using \<theta>\<^sub>C by auto
                  show 1: "C.seq \<theta>\<^sub>C' (f \<star>\<^sub>C \<gamma>\<^sub>C')"
                    using \<theta>\<^sub>C' \<gamma>\<^sub>C'
                    by (metis C.arrI \<theta>\<^sub>C calculation preserves_reflects_arr)
                  show "C.dom \<theta>\<^sub>C = C.dom (\<theta>\<^sub>C' \<cdot>\<^sub>C (f \<star>\<^sub>C \<gamma>\<^sub>C'))"
                    using 1 \<theta>\<^sub>C \<gamma>\<^sub>C' by fastforce
                  show "C.cod \<theta>\<^sub>C = C.cod (\<theta>\<^sub>C' \<cdot>\<^sub>C (f \<star>\<^sub>C \<gamma>\<^sub>C'))"
                    using 1 \<theta>\<^sub>C \<gamma>\<^sub>C' \<gamma>\<^sub>C by auto
                qed
                ultimately show ?thesis
                  using is_faithful by blast
              qed
              have "F \<gamma>\<^sub>C' = F \<gamma>\<^sub>C"
                using ** \<gamma>\<^sub>C \<gamma>\<^sub>C' 1 2 by blast
              hence "?\<gamma>' = F \<gamma>\<^sub>C"
                using \<gamma>\<^sub>C' by simp
              thus "\<gamma> = \<gamma>e"
                unfolding \<gamma>e_def
                by (metis D.arrI D.comp_assoc D.inv_inv D.invert_side_of_triangle(1)
                    D.invert_side_of_triangle(2) D.iso_inv_iso \<gamma>' \<phi> \<phi>')
            qed
          qed

          text \<open>We are now in a position to exhibit the 2-cell \<open>\<gamma>\<close> and show that it
          is unique with the required properties.\<close>

          show ?thesis
          proof
            let ?\<gamma> = "\<r>\<^sub>D[w'] \<cdot>\<^sub>D (w' \<star>\<^sub>D \<epsilon>) \<cdot>\<^sub>D \<a>\<^sub>D[w', e, d] \<cdot>\<^sub>D (\<gamma>e \<star>\<^sub>D d) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[w, e, d] \<cdot>\<^sub>D
                        (w \<star>\<^sub>D D.inv \<epsilon>) \<cdot>\<^sub>D \<r>\<^sub>D\<^sup>-\<^sup>1[w]"
            have \<gamma>: "\<guillemotleft>?\<gamma> : w \<Rightarrow>\<^sub>D w'\<guillemotright>"
              using P\<gamma>e w w' e.counit_in_hom(2) e.counit_is_iso
              apply (intro D.comp_in_homI)
                    apply auto[2]
                   apply fastforce
                  apply auto[3]
                apply fastforce
              by auto
            moreover have "\<beta> = F g \<star>\<^sub>D ?\<gamma>"
            proof -
              have "F g \<star>\<^sub>D ?\<gamma> =
                    (F g \<star>\<^sub>D \<r>\<^sub>D[w']) \<cdot>\<^sub>D (F g \<star>\<^sub>D w' \<star>\<^sub>D \<epsilon>) \<cdot>\<^sub>D (F g \<star>\<^sub>D \<a>\<^sub>D[w', e, d]) \<cdot>\<^sub>D
                      (F g \<star>\<^sub>D \<gamma>e \<star>\<^sub>D d) \<cdot>\<^sub>D
                      (F g \<star>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[w, e, d]) \<cdot>\<^sub>D (F g \<star>\<^sub>D w \<star>\<^sub>D D.inv \<epsilon>) \<cdot>\<^sub>D (F g \<star>\<^sub>D \<r>\<^sub>D\<^sup>-\<^sup>1[w])"
                using w w' \<gamma> P\<gamma>e D.whisker_left e.antipar
                by (metis D.arrI D.seqE T'.ide_leg1)
              also have "... =
                         (F g \<star>\<^sub>D \<r>\<^sub>D[w']) \<cdot>\<^sub>D (F g \<star>\<^sub>D w' \<star>\<^sub>D \<epsilon>) \<cdot>\<^sub>D (F g \<star>\<^sub>D \<a>\<^sub>D[w', e, d]) \<cdot>\<^sub>D
                           (\<a>\<^sub>D[F g, w' \<star>\<^sub>D e, d] \<cdot>\<^sub>D ((F g \<star>\<^sub>D \<gamma>e) \<star>\<^sub>D d) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F g, w \<star>\<^sub>D e, d]) \<cdot>\<^sub>D
                           (F g \<star>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[w, e, d]) \<cdot>\<^sub>D (F g \<star>\<^sub>D w \<star>\<^sub>D D.inv \<epsilon>) \<cdot>\<^sub>D (F g \<star>\<^sub>D \<r>\<^sub>D\<^sup>-\<^sup>1[w])"
              proof -
                have "\<a>\<^sub>D[F g, w' \<star>\<^sub>D e, d] \<cdot>\<^sub>D ((F g \<star>\<^sub>D \<gamma>e) \<star>\<^sub>D d) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F g, w \<star>\<^sub>D e, d] =
                      \<a>\<^sub>D[F g, w' \<star>\<^sub>D e, d] \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F g, w' \<star>\<^sub>D e, d] \<cdot>\<^sub>D (F g \<star>\<^sub>D \<gamma>e \<star>\<^sub>D d)"
                  using w w' e.antipar P\<gamma>e D.assoc'_naturality [of "F g" \<gamma>e d]
                  by (metis D.dom_trg D.ideD(1-3) D.in_hhomE D.in_homE
                      D.src_dom D.trg.preserves_dom T'.leg1_simps(2) T'.leg1_simps(3,5-6)
                      T.tab_simps(2) T.leg0_simps(2) e e.ide_right preserves_src we)
                also have
                  "... = (\<a>\<^sub>D[F g, w' \<star>\<^sub>D e, d] \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F g, w' \<star>\<^sub>D e, d]) \<cdot>\<^sub>D (F g \<star>\<^sub>D \<gamma>e \<star>\<^sub>D d)"
                  using D.comp_assoc by simp
                also have "... = F g \<star>\<^sub>D \<gamma>e \<star>\<^sub>D d"
                proof -
                  have "(\<a>\<^sub>D[F g, w' \<star>\<^sub>D e, d] \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F g, w' \<star>\<^sub>D e, d]) \<cdot>\<^sub>D (F g \<star>\<^sub>D \<gamma>e \<star>\<^sub>D d) =
                        (F g \<star>\<^sub>D (w' \<star>\<^sub>D e) \<star>\<^sub>D d) \<cdot>\<^sub>D (F g \<star>\<^sub>D \<gamma>e \<star>\<^sub>D d)"
                    using w'e D.isomorphic_implies_ide(2) w\<^sub>C' D.comp_assoc_assoc'(1) by auto
                  also have "... = F g \<star>\<^sub>D \<gamma>e \<star>\<^sub>D d"
                  proof -
                    have "\<guillemotleft>F g \<star>\<^sub>D \<gamma>e \<star>\<^sub>D d : F g \<star>\<^sub>D (w \<star>\<^sub>D e) \<star>\<^sub>D d \<Rightarrow>\<^sub>D F g \<star>\<^sub>D (w' \<star>\<^sub>D e) \<star>\<^sub>D d\<guillemotright>"
                      using we e.ide_right e.antipar P\<gamma>e by fastforce
                    thus ?thesis
                      using D.comp_cod_arr by auto
                  qed
                  finally show ?thesis by blast
                qed
                finally have
                  "\<a>\<^sub>D[F g, w' \<star>\<^sub>D e, d] \<cdot>\<^sub>D ((F g \<star>\<^sub>D \<gamma>e) \<star>\<^sub>D d) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F g, w \<star>\<^sub>D e, d] =
                   F g \<star>\<^sub>D \<gamma>e \<star>\<^sub>D d"
                  by simp
                thus ?thesis by simp
              qed
              also have "... =
                         (F g \<star>\<^sub>D \<r>\<^sub>D[w']) \<cdot>\<^sub>D (F g \<star>\<^sub>D w' \<star>\<^sub>D \<epsilon>) \<cdot>\<^sub>D (F g \<star>\<^sub>D \<a>\<^sub>D[w', e, d]) \<cdot>\<^sub>D
                           (\<a>\<^sub>D[F g, w' \<star>\<^sub>D e, d] \<cdot>\<^sub>D
                           (\<a>\<^sub>D[F g, w', e] \<cdot>\<^sub>D (\<beta> \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F g, w, e] \<star>\<^sub>D d) \<cdot>\<^sub>D
                           \<a>\<^sub>D\<^sup>-\<^sup>1[F g, w \<star>\<^sub>D e, d]) \<cdot>\<^sub>D
                           (F g \<star>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[w, e, d]) \<cdot>\<^sub>D (F g \<star>\<^sub>D w \<star>\<^sub>D D.inv \<epsilon>) \<cdot>\<^sub>D (F g \<star>\<^sub>D \<r>\<^sub>D\<^sup>-\<^sup>1[w])"
                using P\<gamma>e by simp
              also have
                "... =
                 (F g \<star>\<^sub>D \<r>\<^sub>D[w']) \<cdot>\<^sub>D (F g \<star>\<^sub>D w' \<star>\<^sub>D \<epsilon>) \<cdot>\<^sub>D
                   (F g \<star>\<^sub>D \<a>\<^sub>D[w', e, d]) \<cdot>\<^sub>D \<a>\<^sub>D[F g, w' \<star>\<^sub>D e, d] \<cdot>\<^sub>D (\<a>\<^sub>D[F g, w', e] \<star>\<^sub>D d) \<cdot>\<^sub>D
                   ((\<beta> \<star>\<^sub>D e) \<star>\<^sub>D d) \<cdot>\<^sub>D
                   (\<a>\<^sub>D\<^sup>-\<^sup>1[F g, w, e] \<star>\<^sub>D d) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F g, w \<star>\<^sub>D e, d] \<cdot>\<^sub>D (F g \<star>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[w, e, d]) \<cdot>\<^sub>D
                   (F g \<star>\<^sub>D w \<star>\<^sub>D D.inv \<epsilon>) \<cdot>\<^sub>D (F g \<star>\<^sub>D \<r>\<^sub>D\<^sup>-\<^sup>1[w])"
              proof -
                have "\<a>\<^sub>D[F g, w', e] \<cdot>\<^sub>D (\<beta> \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F g, w, e] \<star>\<^sub>D d =
                      (\<a>\<^sub>D[F g, w', e] \<star>\<^sub>D d) \<cdot>\<^sub>D ((\<beta> \<star>\<^sub>D e) \<star>\<^sub>D d) \<cdot>\<^sub>D (\<a>\<^sub>D\<^sup>-\<^sup>1[F g, w, e] \<star>\<^sub>D d)"
                proof -
                  have "D.arr (\<a>\<^sub>D[F g, w', e] \<cdot>\<^sub>D (\<beta> \<star>\<^sub>D e) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F g, w, e])"
                    using D.arrI D.in_hhom_def D.vconn_implies_hpar(2) P\<gamma>e we by auto
                  thus ?thesis
                    using D.whisker_right by auto
                qed
                thus ?thesis
                  using D.comp_assoc by simp
              qed
              also have
                "... =
                 (F g \<star>\<^sub>D \<r>\<^sub>D[w']) \<cdot>\<^sub>D (F g \<star>\<^sub>D w' \<star>\<^sub>D \<epsilon>) \<cdot>\<^sub>D
                   ((F g \<star>\<^sub>D \<a>\<^sub>D[w', e, d]) \<cdot>\<^sub>D \<a>\<^sub>D[F g, w' \<star>\<^sub>D e, d] \<cdot>\<^sub>D (\<a>\<^sub>D[F g, w', e] \<star>\<^sub>D d) \<cdot>\<^sub>D
                   (\<a>\<^sub>D\<^sup>-\<^sup>1[F g \<star>\<^sub>D w', e, d]) \<cdot>\<^sub>D (\<beta> \<star>\<^sub>D e \<star>\<^sub>D d) \<cdot>\<^sub>D (\<a>\<^sub>D[F g \<star>\<^sub>D w, e, d]) \<cdot>\<^sub>D 
                   (\<a>\<^sub>D\<^sup>-\<^sup>1[F g, w, e] \<star>\<^sub>D d) \<cdot>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[F g, w \<star>\<^sub>D e, d] \<cdot>\<^sub>D (F g \<star>\<^sub>D \<a>\<^sub>D\<^sup>-\<^sup>1[w, e, d])) \<cdot>\<^sub>D
                   (F g \<star>\<^sub>D w \<star>\<^sub>D D.inv \<epsilon>) \<cdot>\<^sub>D (F g \<star>\<^sub>D \<r>\<^sub>D\<^sup>-\<^sup>1[w])"
              proof -
                have "(\<beta> \<star>\<^sub>D e) \<star>\<^sub>D d =
                      \<a>\<^sub>D\<^sup>-\<^sup>1[F g \<star>\<^sub>D w', e, d] \<cdot>\<^sub>D (\<beta> \<star>\<^sub>D e \<star>\<^sub>D d) \<cdot>\<^sub>D \<a>\<^sub>D[F g \<star>\<^sub>D w, e, d]"
                proof -
                  have "src\<^sub>D \<beta> = trg\<^sub>D e"
                    using \<beta>
                    by (metis D.dom_trg D.hseq_char' D.in_homE D.src_dom D.src_hcomp
                        D.trg.extensionality D.trg.preserves_arr D.trg.preserves_dom
                        \<open>trg\<^sub>D e = a\<close> a_def)
                  moreover have "src\<^sub>D (F g) = trg\<^sub>D w"
                    by simp
                  moreover have "src\<^sub>D (F g) = trg\<^sub>D w'"
                    by simp
                  moreover have
                    "\<guillemotleft>(\<beta> \<star>\<^sub>D e) \<star>\<^sub>D d : ((F g \<star>\<^sub>D w) \<star>\<^sub>D e) \<star>\<^sub>D d \<Rightarrow>\<^sub>D ((F g \<star>\<^sub>D w') \<star>\<^sub>D e) \<star>\<^sub>D d\<guillemotright>"
                    using \<beta> w w' e e.antipar
                    by (intro D.hcomp_in_vhom, auto)
                  ultimately have
                    "\<a>\<^sub>D\<^sup>-\<^sup>1[F g \<star>\<^sub>D w', e, d] \<cdot>\<^sub>D (\<beta> \<star>\<^sub>D e \<star>\<^sub>D d) \<cdot>\<^sub>D \<a>\<^sub>D[F g \<star>\<^sub>D w, e, d] =
                     \<a>\<^sub>D\<^sup>-\<^sup>1[F g \<star>\<^sub>D w', e, d] \<cdot>\<^sub>D \<a>\<^sub>D[F g \<star>\<^sub>D w', e, d] \<cdot>\<^sub>D ((\<beta> \<star>\<^sub>D e) \<star>\<^sub>D d)"
                    using w' e e.ide_left e.ide_right e.antipar \<beta> D.assoc'_naturality
                    by (metis D.assoc_naturality D.in_homE e.triangle_equiv_form(1)
                              e.triangle_in_hom(3) e.triangle_in_hom(4) e.triangle_right
                              e.triangle_right' e.triangle_right_implies_left)
                  also have
                    "... = (\<a>\<^sub>D\<^sup>-\<^sup>1[F g \<star>\<^sub>D w', e, d] \<cdot>\<^sub>D \<a>\<^sub>D[F g \<star>\<^sub>D w', e, d]) \<cdot>\<^sub>D ((\<beta> \<star>\<^sub>D e) \<star>\<^sub>D d)"
                    using D.comp_assoc by simp
                  also have "... = (((F g \<star>\<^sub>D w') \<star>\<^sub>D e) \<star>\<^sub>D d) \<cdot>\<^sub>D ((\<beta> \<star>\<^sub>D e) \<star>\<^sub>D d)"
                    using w' e e.antipar \<beta> D.comp_assoc_assoc' by simp
                  also have "... = (\<beta> \<star>\<^sub>D e) \<star>\<^sub>D d"
                  proof -
                    have "\<guillemotleft>(\<beta> \<star>\<^sub>D e) \<star>\<^sub>D d : ((F g \<star>\<^sub>D w) \<star>\<^sub>D e) \<star>\<^sub>D d \<Rightarrow>\<^sub>D ((F g \<star>\<^sub>D w') \<star>\<^sub>D e) \<star>\<^sub>D d\<guillemotright>"
                      using w e e.antipar \<beta>
                      by (intro D.hcomp_in_vhom, auto)
                    thus ?thesis
                      using D.comp_cod_arr by auto
                  qed
                  finally show ?thesis by simp
                qed
                thus ?thesis
                  using D.comp_assoc by simp
              qed
              also have
                "... = (F g \<star>\<^sub>D \<r>\<^sub>D[w']) \<cdot>\<^sub>D ((F g \<star>\<^sub>D w' \<star>\<^sub>D \<epsilon>) \<cdot>\<^sub>D \<a>\<^sub>D[F g, w', e \<star>\<^sub>D d]) \<cdot>\<^sub>D
                         (\<beta> \<star>\<^sub>D e \<star>\<^sub>D d) \<cdot>\<^sub>D
                         (\<a>\<^sub>D\<^sup>-\<^sup>1[F g, w, e \<star>\<^sub>D d] \<cdot>\<^sub>D (F g \<star>\<^sub>D w \<star>\<^sub>D D.inv \<epsilon>)) \<cdot>\<^sub>D (F g \<star>\<^sub>D \<r>\<^sub>D\<^sup>-\<^sup>1[w])"
              proof -
                have "(F g \<star>\<^sub>D \<a>\<^sub>D[w', e, d]) \<cdot>\<^sub>D \<a>\<^sub>D[F g, w' \<star>\<^sub>D e, d] \<cdot>\<^sub>D (\<a>\<^sub>D[F g, w', e] \<star>\<^sub>D d) \<cdot>\<^sub>D
                        \<a>\<^sub>D\<^sup>-\<^sup>1[F g \<star>\<^sub>D w', e, d] =
                      \<a>\<^sub>D[F g, w', e \<star>\<^sub>D d]"
                proof -
                  have "D.seq (F g \<star>\<^sub>D \<a>\<^sub>D[w', e, d])
                              (a_D[F g, w' ⋆_D e, d] ⋅_D (a_D[F g, w', e] ⋆_D d))"
                    using w w' e e.antipar by simp
                  thus ?thesis
                    using w w' e e.antipar D.pentagon [of "F g" w' e d] D.invert_side_of_triangle(2)
                          D.assoc'_eq_inv_assoc D.comp_assoc D.ide_hcomp D.ideD(1)
                          D.iso_assoc D.hcomp_simps(1) T'.ide_leg1 T.leg1_simps(2-3)
                          T.tab_simps(2) ‹src_D w' = a› ‹trg_D e = a› ‹trg_D w' = map₀ (src_C ρ)›
                          e.ide_left e.ide_right preserves_src
                    by metis
                qed
                moreover have
                  "a_D[F g ⋆_D w, e, d] ⋅_D (a_D^-1[F g, w, e] ⋆_D d) ⋅_D a_D^-1[F g, w ⋆_D e, d] ⋅_D
                     (F g ⋆_D a_D^-1[w, e, d]) =
                   a_D^-1[F g, w, e ⋆_D d]"
                proof -
                  have "D.seq (a_D^-1[F g, w, e] ⋆_D d)
                              (a_D^-1[F g, w ⋆_D e, d] ⋅_D (F g ⋆_D a_D^-1[w, e, d]))"
                    using w w' e e.antipar by simp
                  moreover have "D.inv a_D^-1[F g ⋆_D w, e, d] = a_D[F g ⋆_D w, e, d]"
                    using w w' e e.antipar by simp
                  ultimately show ?thesis
                    using w w' e e.antipar D.pentagon' [of "F g" w e d]
                          D.iso_inv_iso D.inv_inv D.comp_assoc D.invert_side_of_triangle(1)
                    by (metis D.assoc'_simps(3) D.null_is_zero(2) D.ide_hcomp D.ideD(1)
                        D.iso_assoc' D.not_arr_null D.seq_if_composable D.src_hcomp T'.ide_leg1
                        ‹trg_D e = a› a_def e.ide_left e.ide_right)
                qed
                ultimately show ?thesis
                  using w w' e e.antipar β D.comp_assoc by metis
              qed
              also have "... = (F g ⋆_D r_D[w']) ⋅_D a_D[F g, w', trg_D e] ⋅_D
                                 (((F g ⋆_D w') ⋆_D ε) ⋅_D (β ⋆_D e ⋆_D d) ⋅_D ((F g ⋆_D w) ⋆_D D.inv ε)) ⋅_D
                                 a_D^-1[F g, w, trg_D e] ⋅_D (F g ⋆_D r_D^-1[w])"
              proof -
                have "(F g ⋆_D w' ⋆_D ε) ⋅_D a_D[F g, w', e ⋆_D d] =
                      a_D[F g, w', trg_D e] ⋅_D ((F g ⋆_D w') ⋆_D ε)"
                  using w' e e.antipar D.assoc_naturality [of "F g" w' ε] by simp
                moreover have "a_D^-1[F g, w, e ⋆_D d] ⋅_D (F g ⋆_D w ⋆_D D.inv ε) =
                               ((F g ⋆_D w) ⋆_D D.inv ε) ⋅_D a_D^-1[F g, w, trg_D e]"
                 using w e e.antipar D.assoc'_naturality [of "F g" w "D.inv ε"]
                        e.counit_is_iso e.counit_in_hom
                  by simp
                ultimately show ?thesis
                  using D.comp_assoc by simp
              qed
              also have "... = ((F g ⋆_D r_D[w']) ⋅_D a_D[F g, w', trg_D e]) ⋅_D
                                (β ⋆_D trg_D e) ⋅_D
                                 (a_D^-1[F g, w, trg_D e] ⋅_D (F g ⋆_D r_D^-1[w]))"
              proof -
                have "((F g ⋆_D w') ⋆_D ε) ⋅_D (β ⋆_D e ⋆_D d) ⋅_D ((F g ⋆_D w) ⋆_D D.inv ε) =
                      β ⋆_D trg_D e"
               proof -
                  have "((F g ⋆_D w') ⋆_D ε) ⋅_D (β ⋆_D e ⋆_D d) ⋅_D ((F g ⋆_D w) ⋆_D D.inv ε) =
                        ((F g ⋆_D w') ⋆_D ε) ⋅_D (β ⋆_D D.inv ε)"
                    using w w' e e.antipar D.interchange [of β "F g ⋆_D w" "e ⋆_D d" "D.inv ε"]
                          D.comp_arr_dom D.comp_cod_arr e.counit_is_iso
                    by (metis D.in_homE β d.unit_simps(1) d.unit_simps(3))
                  also have "... = ((F g ⋆_D w') ⋆_D ε) ⋅_D ((F g ⋆_D w') ⋆_D D.inv ε) ⋅_D (β ⋆_D trg_D e)"
                    using w w' e e.antipar β D.interchange [of "F g ⋆_D w'" β "D.inv ε" "trg_D e"]
                          D.comp_arr_dom D.comp_cod_arr e.counit_is_iso
                    by auto
                  also have
                    "... = (F \^ 🚫) ⋅_D ((F g ⋆_D w') ⋆_D D.inv ε)) ⋅_D (β ⋆_D trg_D e)"
                    using D.comp_assoc by simp
                  also have "... = ((F g ⋆_D w') ⋆_D ε ⋅₎ ⋅D (β<tar<.local   presburger
                    java.lang.StringIndexOutOfBoundsException: Index 25 out of bounds for length 25
                  also have "... = ((F g ⋆D w') ⋆D trg_\<sb> (<bta <star>\<ub
                    by (simp add: D.comp_arr_inv')
                  also have "... = β ⋆_D trg_D e"
                    using β D.comp_cod_arr D.hseqI'
                    by (metis D.cod_cod D.hcomp_simps(1) D.hcomp_simps(4)
                        D.in_homE D.trg.preserves_reflects_arr D.vconn_implies_hpar(1)
                        D.vconn_implies_hpar(2) D.vconn_implies_hpar(3) D.vconn_implies_hpar(4)
                        ‹src_D w' = a› ‹trg_D e = a› e.counit_in_hom(2) e.counit_simps(5))
                  finally show ?thesis by blast
                qed
                thus ?thesis
                  using D.comp_assoc by simp
              qed
              also have "... = r_D[F g ⋆_D w'] ⋅_D (β ⋆_D trg_D e) ⋅_D r_D^-1[F g ⋆_D w]"
                using w w' D.runit_hcomp D.runit_hcomp [of "F g" w] by simp
              also have "... = r_D[F g ⋆_D w'] ⋅_D r_D^-1[F g ⋆_D w'] ⋅_D β"
                using β D.runit'_naturality
                by (metis D.arr_cod D.arr_dom D.cod_dom D.in_homE D.src.preserves_cod
                  D.src_dom D.src_hcomp ‹src_D w' = a› ‹trg_D e = a›)
              also have "... = (r_D[F g ⋆_D w'] ⋅_D r_D^-1[F g ⋆_D w']) ⋅_D β"
                using D.comp_assoc by simp
              also have "... = β"
                using w' β D.comp_cod_arr D.comp_arr_inv' D.iso_runit by auto
              finally show ?thesis by simp
            qed
            moreover have "θ = θ' ⋅_D (F f ⋆_D ?γ)"
            proof -
              have "θ' ⋅_D (F f ⋆_D ?γ) =
                    θ' ⋅_D (F f ⋆_D r_D[w']) ⋅_D (F f ⋆_D w' ⋆_D ε) ⋅_D (F f ⋆_D a_D[w', e, d]) ⋅_D
                      (F f ⋆_D γe ⋆_D d) ⋅_D
                      (F f ⋆_D a_D^-1[w, e, d]) ⋅_D (F f ⋆_D w ⋆_D D.inv ε) ⋅_D (F f ⋆_D r_D^-1[w])"
                 using w θ γ D.whisker_left
                 by (metis D.arrI D.seqE T'.ide_leg0)
              also have
                "... = (θ' ⋅_D (F f ⋆_D r_D[w'])) ⋅_D (F f ⋆_D w' ⋆_D ε) ⋅_D (F f ⋆_D a_D[w', e, d]) ⋅_D
                         (a_D[F f, w' ⋆_D e, d] ⋅_D ((F f ⋆_D γe) ⋆_D d) ⋅_D a_D^-1[F f, w ⋆_D e, d]) ⋅_D
                         (F f ⋆_D a_D^-1[w, e, d]) ⋅_D (F f ⋆_D w ⋆_D D.inv ε) ⋅_D (F f ⋆_D r_D^-1[w])"
              proof -
                have 1: "a_D[F f, w' ⋆_D e, d] ⋅_D ((F f ⋆_D γe) ⋆_D d) ⋅_D a_D^-1[F f, w ⋆_D e, d] =
                         a_D[F f, w' ⋆_D e, d] ⋅_D a_D^-1[F f, w' ⋆_D e, d] ⋅_D (F f ⋆_D γe ⋆_D d)"
                  using w w' e we w'e e.antipar Pγe D.assoc'_naturality [of "F f" γe d]
                  by (metis D.cod_trg D.in_hhomE D.in_homE D.src_cod D.trg.preserves_cod
                      T'.leg0_simps(2,4-5) T.tab_simps(2) T.leg0_simps(2)
                      e.triangle_in_hom(4) e.triangle_right' preserves_src)
                also have
                  2: "... = (a_D[F f, w' ⋆_D e, d] ⋅_D a_D^-1[F f, w' ⋆_D e, d]) ⋅_D (F f ⋆_D γe ⋆_D d)"
                  using D.comp_assoc by simp
                also have "... = F f ⋆_D γe ⋆_D d"
                proof -
                  have "(a_D[F f, w' ⋆_D e, d] ⋅_D a_D^-1[F f, w' ⋆_D e, d]) ⋅_D (F f ⋆_D γe ⋆_D d) =
                        (F f ⋆_D (w' ⋆_D e) ⋆_D d) ⋅_D (F f ⋆_D γe ⋆_D d)"
                    using 1 2 e.antipar D.isomorphic_implies_ide(2) w_C' w'e D.comp_assoc_assoc'
                    by auto
                  also have "... = F f ⋆_D γe ⋆_D d"
                  proof -
                    have "«F f ⋆_D γe ⋆_D d : F f ⋆_D (w ⋆_D e) ⋆_D d →_D F f ⋆_D (w' ⋆_D e) ⋆_D d¬"
                      using we 1 2 e.antipar Pγe by fastforce
                    thus ?thesis
                      using D.comp_cod_arr by blast
                  qed
                  finally show ?thesis by blast
                qed
                finally have
                  "a_D[F f, w' ⋆_D e, d] ⋅_D ((F f ⋆_D γe) ⋆_D d) ⋅_D (a_D^-1[F f, w ⋆_D e, d]) =
                   F f ⋆_D γe ⋆_D d"
                  by simp
                thus ?thesis
                  using D.comp_assoc by simp
              qed
              also have
                "... = ((θ' ⋅_D r_D[F f ⋆_D w']) ⋅_D a_D^-1[F f, w', src_D w']) ⋅_D (F f ⋆_D w' ⋆_D ε) ⋅_D
                         (F f ⋆_D a_D[w', e, d]) ⋅_D (a_D[F f, w' ⋆_D e, d] ⋅_D ((F f ⋆_D γe) ⋆_D d) ⋅_D
                         a_D^-1[F f, w ⋆_D e, d]) ⋅_D (F f ⋆_D a_D^-1[w, e, d]) ⋅_D
                         (F f ⋆_D w ⋆_D D.inv ε) ⋅_D (F f ⋆_D r_D^-1[w])"
                using w' D.runit_hcomp(3) [of "F f" w'] D.comp_assoc by simp
              also have "... = r_D[u] ⋅_D (θ' ⋆_D src_D w') ⋅_D (a_D^-1[F f, w', src_D w'] ⋅_D
                                 (F f ⋆_D w' ⋆_D ε)) ⋅_D (F f ⋆_D a_D[w', e, d]) ⋅_D
                                 (a_D[F f, w' ⋆_D e, d] ⋅_D ((F f ⋆_D γe) ⋆_D d) ⋅_D
                                 a_D^-1[F f, w ⋆_D e, d]) ⋅_D (F f ⋆_D a_D^-1[w, e, d]) ⋅_D
                                 (F f ⋆_D w ⋆_D D.inv ε) ⋅_D (F f ⋆_D r_D^-1[w])"
                using θ' D.runit_naturality [of θ'] D.comp_assoc by fastforce
              also have "... = r_D[u] ⋅_D ((θ' ⋆_D src_D w') ⋅_D ((F f ⋆_D w') ⋆_D ε)) ⋅_D
                                 a_D^-1[F f, w', e ⋆_D d] ⋅_D (F f ⋆_D a_D[w', e, d]) ⋅_D
                                 a_D[F f, w' ⋆_D e, d] ⋅_D ((F f ⋆_D γe) ⋆_D d) ⋅_D
                                 a_D^-1[F f, w ⋆_D e, d] ⋅_D (F f ⋆_D a_D^-1[w, e, d]) ⋅_D
                                 (F f ⋆_D w ⋆_D D.inv ε) ⋅_D (F f ⋆_D r_D^-1[w])"
                using w' D.assoc'_naturality [of "F f" w' ε] D.comp_assoc by simp
              also have "... = r_D[u] ⋅_D (u ⋆_D ε) ⋅_D (θ' ⋆_D e ⋆_D d) ⋅_D
                                 a_D^-1[F f, w', e ⋆_D d] ⋅_D (F f ⋆_D a_D[w', e, d]) ⋅_D
                                 (a_D[F f, w' ⋆_D e, d] ⋅_D ((F f ⋆_D γe) ⋆_D d)) ⋅_D
                                 a_D^-1[F f, w ⋆_D e, d] ⋅_D (F f ⋆_D a_D^-1[w, e, d]) ⋅_D
                                 (F f ⋆_D w ⋆_D D.inv ε) ⋅_D (F f ⋆_D r_D^-1[w])"
              proof -
                have "(θ' ⋆_D src_D w') ⋅_D ((F f ⋆_D w') ⋆_D ε) = θ' ⋆_D ε"
                  using D.interchange D.comp_arr_dom D.comp_cod_arr
                  by (metis D.in_homE ‹src_D w' = a› ‹trg_D e = a› θ' e.counit_simps(1)
                      e.counit_simps(3))
                also have "... = (u ⋆_D ε) ⋅_D (θ' ⋆_D e ⋆_D d)"
                  using θ' D.interchange [of u θ' ε "e ⋆_D d"] D.comp_arr_dom D.comp_cod_arr
                  by auto
                finally have "(θ' ⋆_D src_D w') ⋅_D ((F f ⋆_D w') ⋆_D ε) = (u ⋆_D ε) ⋅_D (θ' ⋆_D e ⋆_D d)"
                  by simp
                thus ?thesis
                  using D.comp_assoc by simp
              qed
              also have "... = r_D[u] ⋅_D (u ⋆_D ε) ⋅_D (θ' ⋆_D e ⋆_D d) ⋅_D
                                 a_D^-1[F f, w', e ⋆_D d] ⋅_D (F f ⋆_D a_D[w', e, d]) ⋅_D
                                 (F f ⋆_D γe ⋆_D d) ⋅_D ((a_D[F f, w ⋆_D e, d] ⋅_D
                                 a_D^-1[F f, w ⋆_D e, d]) ⋅_D (F f ⋆_D a_D^-1[w, e, d])) ⋅_D
                                 (F f ⋆_D w ⋆_D D.inv ε) ⋅_D (F f ⋆_D r_D^-1[w])"
              proof -
                have "a_D[F f, w' ⋆_D e, d] ⋅_D ((F f ⋆_D γe) ⋆_D d) =
                      (F f ⋆_D γe ⋆_D d) ⋅_D a_D[F f, w ⋆_D e, d]"
                  using D.assoc_naturality [of "F f" γe d]
                  by (metis D.cod_trg D.in_hhomE D.in_homE D.src_cod D.trg.preserves_cod Pγe
                      T'.leg0_simps(2,4-5) T.tab_simps(2) T.leg0_simps(2) e e.antipar(1)
                      e.triangle_in_hom(4) e.triangle_right' preserves_src w'e)
                thus ?thesis
                  using D.comp_assoc by simp
              qed
              also have "... = r_D[u] ⋅_D (u ⋆_D ε) ⋅_D (θ' ⋆_D e ⋆_D d) ⋅_D
                                 (a_D^-1[F f, w', e ⋆_D d]) ⋅_D (F f ⋆_D a_D[w', e, d]) ⋅_D
                                 (F f ⋆_D γe ⋆_D d) ⋅_D (F f ⋆_D a_D^-1[w, e, d]) ⋅_D
                                 (F f ⋆_D w ⋆_D D.inv ε) ⋅_D (F f ⋆_D r_D^-1[w])"
              proof -
                have "(a_D[F f, w ⋆_D e, d] ⋅_D a_D^-1[F f, w ⋆_D e, d]) ⋅_D (F f ⋆_D a_D^-1[w, e, d]) =
                      F f ⋆_D a_D^-1[w, e, d]"
                  using w D.comp_cod_arr D.comp_assoc_assoc' by simp
                thus ?thesis
                  using D.comp_assoc by simp
              qed
              also have
                "... = r_D[u] ⋅_D (u ⋆_D ε) ⋅_D (θ' ⋆_D e ⋆_D d) ⋅_D
                         ((a_D^-1[F f, w', e ⋆_D d]) ⋅_D (F f ⋆_D a_D[w', e, d]) ⋅_D a_D[F f, w' ⋆_D e, d]) ⋅_D
                         ((F f ⋆_D γe) ⋆_D d) ⋅_D
                         a_D^-1[F f, w ⋆_D e, d] ⋅_D (F f ⋆_D a_D^-1[w, e, d]) ⋅_D
                         (F f ⋆_D w ⋆_D D.inv ε) ⋅_D (F f ⋆_D r_D^-1[w])"
              proof -
                have "F f ⋆_D γe ⋆_D d =
                      a_D[F f, w' ⋆_D e, d] ⋅_D ((F f ⋆_D γe) ⋆_D d) ⋅_D a_D^-1[F f, w ⋆_D e, d]"
                proof -
                  have "a_D[F f, w' ⋆_D e, d] ⋅_D ((F f ⋆_D γe) ⋆_D d) ⋅_D a_D^-1[F f, w ⋆_D e, d] =
                        a_D[F f, w' ⋆_D e, d] ⋅_D a_D^-1[F f, w' ⋆_D e, d] ⋅_D (F f ⋆_D γe ⋆_D d)"
                    using Pγe e.antipar D.assoc'_naturality
                    by (metis D.in_hhom_def D.in_homE D.vconn_implies_hpar(1)
                        D.vconn_implies_hpar(2) T'.leg0_simps(2,4-5)
                        T.leg0_simps(2) T.tab_simps(2) ‹src_D e = map₀ a_C›
                        d.triangle_equiv_form(1) d.triangle_in_hom(3) d.triangle_left
                        preserves_src we)
                  also have
                    "... = (a_D[F f, w' ⋆_D e, d] ⋅_D a_D^-1[F f, w' ⋆_D e, d]) ⋅_D (F f ⋆_D γe ⋆_D d)"
                    using D.comp_assoc by simp
                  also have "... = (F f ⋆_D (w' ⋆_D e) ⋆_D d) ⋅_D (F f ⋆_D γe ⋆_D d)"
                    using w'e D.isomorphic_implies_ide(2) w_C' D.comp_assoc_assoc' by auto
                  also have "... = F f ⋆_D γe ⋆_D d"
                    using D.comp_cod_arr
                    by (metis D.comp_cod_arr D.null_is_zero(2) D.hseq_char D.hseq_char'
                        D.in_homE D.whisker_left D.whisker_right Pγe T'.ide_leg0 e.ide_right)
                  finally show ?thesis by simp
                qed
                thus ?thesis
                  using D.comp_assoc by simp
              qed
              also have "... = r_D[u] ⋅_D (u ⋆_D ε) ⋅_D ((θ' ⋆_D e ⋆_D d) ⋅_D
                                 a_D[F f ⋆_D w', e, d]) ⋅_D (a_D^-1[F f, w', e] ⋆_D d) ⋅_D
                                 ((F f ⋆_D γe) ⋆_D d) ⋅_D
                                 a_D^-1[F f, w ⋆_D e, d] ⋅_D (F f ⋆_D a_D^-1[w, e, d]) ⋅_D
                                 (F f ⋆_D w ⋆_D D.inv ε) ⋅_D (F f ⋆_D r_D^-1[w])"
              proof -
                have "(a_D^-1[F f, w', e ⋆_D d]) ⋅_D (F f ⋆_D a_D[w', e, d]) ⋅_D a_D[F f, w' ⋆_D e, d] =
                      a_D[F f ⋆_D w', e, d] ⋅_D (a_D^-1[F f, w', e] ⋆_D d)"
                proof -
                  have "a_D[F f, w', e ⋆_D d] ⋅_D a_D[F f ⋆_D w', e, d] =
                        ((F f ⋆_D a_D[w', e, d]) ⋅_D a_D[F f, w' ⋆_D e, d]) ⋅_D (a_D[F f, w', e] ⋆_D d)"
                    using w' D.pentagon D.comp_assoc by simp
                  moreover have "D.seq a_D[F f, w', e ⋆_D d] a_D[F f ⋆_D w', e, d]"
                    using w' by simp
                  moreover have "D.inv (a_D[F f, w', e] ⋆_D d) = a_D^-1[F f, w', e] ⋆_D d"
                    using w' by simp
                  ultimately show ?thesis
                    using w' D.comp_assoc
                          D.invert_opposite_sides_of_square
                            [of "a_D[F f, w', e ⋆_D d]" "a_D[F f ⋆_D w', e, d]"
                                "(F f ⋆_D a_D[w', e, d]) ⋅_D a_D[F f, w' ⋆_D e, d]"
                                "a_D[F f, w', e] ⋆_D d"]
                    by simp
                qed
                thus ?thesis
                  using D.comp_assoc by simp
              qed
              also have
                "... = r_D[u] ⋅_D (u ⋆_D ε) ⋅_D a_D[u, e, d] ⋅_D
                         (((θ' ⋆_D e) ⋆_D d) ⋅_D (a_D^-1[F f, w', e] ⋆_D d) ⋅_D ((F f ⋆_D γe) ⋆_D d)) ⋅_D
                         a_D^-1[F f, w ⋆_D e, d] ⋅_D (F f ⋆_D a_D^-1[w, e, d]) ⋅_D
                         (F f ⋆_D w ⋆_D D.inv ε) ⋅_D (F f ⋆_D r_D^-1[w])"
              proof -
                have "(θ' ⋆_D e ⋆_D d) ⋅_D a_D[F f ⋆_D w', e, d] = a_D[u, e, d] ⋅_D ((θ' ⋆_D e) ⋆_D d)"
                  using w' θ' e.ide_left e.ide_right e.antipar D.assoc_naturality [of θ' e d]
                  by auto
                thus ?thesis
                  using D.comp_assoc by simp
              qed
              also have "... = r_D[u] ⋅_D (u ⋆_D ε) ⋅_D a_D[u, e, d] ⋅_D
                                 ((θ' ⋆_D e) ⋅_D a_D^-1[F f, w', e] ⋅_D (F f ⋆_D γe) ⋆_D d) ⋅_D
                                 a_D^-1[F f, w ⋆_D e, d] ⋅_D (F f ⋆_D a_D^-1[w, e, d]) ⋅_D
                                 (F f ⋆_D w ⋆_D D.inv ε) ⋅_D (F f ⋆_D r_D^-1[w])"
              proof -
                have "((θ' ⋆_D e) ⋆_D d) ⋅_D (a_D^-1[F f, w', e] ⋆_D d) ⋅_D ((F f ⋆_D γe) ⋆_D d) =
                       (θ' ⋆_D e) ⋅_D a_D^-1[F f, w', e] ⋅_D (F f ⋆_D γe) ⋆_D d"
                  using w' w'e θ' θ_C e.ide_left e.ide_right e.antipar D.whisker_right
                  by (metis (full_types) C.arrI D.cod_comp D.seqE D.seqI Fθ_{C_def} Pγe
                      preserves_arr)
                thus ?thesis
                  using D.comp_assoc by simp
              qed
              also have "... = r_D[u] ⋅_D (u ⋆_D ε) ⋅_D a_D[u, e, d] ⋅_D
                                 ((θ ⋆_D e) ⋅_D a_D^-1[F f, w, e] ⋆_D d) ⋅_D
                                 a_D^-1[F f, w ⋆_D e, d] ⋅_D (F f ⋆_D a_D^-1[w, e, d]) ⋅_D
                                 (F f ⋆_D w ⋆_D D.inv ε) ⋅_D (F f ⋆_D r_D^-1[w])"
              proof -
                have "ψ ⋅_D (θ' ⋆_D e) ⋅_D a_D^-1[F f, w', e] ⋅_D (F f ⋆_D γe) =
                      ψ ⋅_D (θ ⋆_D e) ⋅_D a_D^-1[F f, w, e]"
                  using Pγe by simp
                moreover have "D.arr (ψ ⋅_D (θ' ⋆_D e) ⋅_D a_D^-1[F f, w', e] ⋅_D (F f ⋆_D γe))"
                  by (metis C.in_homE D.comp_assoc D.null_is_zero(1) D.ext Fθ_{C_def} Pγe θ_C
                      preserves_arr)
                moreover have "D.arr (ψ ⋅_D (θ ⋆_D e) ⋅_D a_D^-1[F f, w, e])"
                  using Pγe calculation(2) by auto
                ultimately have "(θ' ⋆_D e) ⋅_D a_D^-1[F f, w', e] ⋅_D (F f ⋆_D γe) =
                                 (θ ⋆_D e) ⋅_D a_D^-1[F f, w, e]"
                  using ψ θ_C Fθ_{C_def} D.iso_is_section D.section_is_mono
                  by (metis D.mono_cancel)
                thus ?thesis
                  using D.comp_assoc by simp
              qed
              also have "... = r_D[u] ⋅_D (u ⋆_D ε) ⋅_D a_D[u, e, d] ⋅_D
                                 ((θ ⋆_D e) ⋆_D d) ⋅_D ((a_D^-1[F f, w, e] ⋆_D d) ⋅_D
                                 a_D^-1[F f, w ⋆_D e, d] ⋅_D (F f ⋆_D a_D^-1[w, e, d])) ⋅_D
                                 (F f ⋆_D w ⋆_D D.inv ε) ⋅_D (F f ⋆_D r_D^-1[w])"
              proof -
                have "(θ ⋆_D e) ⋅_D a_D^-1[F f, w, e] ⋆_D d =
                      ((θ ⋆_D e) ⋆_D d) ⋅_D (a_D^-1[F f, w, e] ⋆_D d)"
                proof -
                  have "D.arr ((θ ⋆_D e) ⋅_D a_D^-1[F f, w, e])"
                    by (metis C.arrI D.cod_comp D.seqE D.seqI Fθ_{C_def} θ_C preserves_arr)
                  thus ?thesis
                    using D.whisker_right e.ide_right by blast
                qed
                thus ?thesis
                  using D.comp_assoc by simp
              qed
              also have "... = r_D[u] ⋅_D (u ⋆_D ε) ⋅_D a_D[u, e, d] ⋅_D
                                 (((θ ⋆_D e) ⋆_D d) ⋅_D a_D^-1[F f ⋆_D w, e, d]) ⋅_D a_D^-1[F f, w, e ⋆_D d] ⋅_D
                                 (F f ⋆_D w ⋆_D D.inv ε) ⋅_D (F f ⋆_D r_D^-1[w])"
                using w D.pentagon' D.comp_assoc by simp
              also have "... = r_D[u] ⋅_D (u ⋆_D ε) ⋅_D ((a_D[u, e, d] ⋅_D
                                 a_D^-1[u, e, d]) ⋅_D (θ ⋆_D e ⋆_D d)) ⋅_D a_D^-1[F f, w, e ⋆_D d] ⋅_D
                                 (F f ⋆_D w ⋆_D D.inv ε) ⋅_D (F f ⋆_D r_D^-1[w])"
                using θ e.antipar D.assoc'_naturality [of θ e d] D.comp_assoc by fastforce
              also have "... = r_D[u] ⋅_D (u ⋆_D ε) ⋅_D (θ ⋆_D e ⋆_D d) ⋅_D (a_D^-1[F f, w, e ⋆_D d] ⋅_D
                                 (F f ⋆_D w ⋆_D D.inv ε)) ⋅_D (F f ⋆_D r_D^-1[w])"
              proof -
                have "(a_D[u, e, d] ⋅_D a_D^-1[u, e, d]) ⋅_D (θ ⋆_D e ⋆_D d) = θ ⋆_D e ⋆_D d"
                proof -
                  have "(a_D[u, e, d] ⋅_D a_D^-1[u, e, d]) ⋅_D (θ ⋆_D e ⋆_D d) =
                        (u ⋆_D e ⋆_D d) ⋅_D (θ ⋆_D e ⋆_D d)"
                    using θ ue e.ide_left e.ide_right e.antipar D.comp_arr_inv' D.comp_cod_arr
                    by auto
                  also have "... = θ ⋆_D e ⋆_D d"
                    using ue e.ide_left e.ide_right e.antipar D.hcomp_simps(4) D.hseq_char' θ
                          D.comp_cod_arr [of "θ ⋆_D e ⋆_D d" "u ⋆_D e ⋆_D d"]
                    by force
                  finally show ?thesis by blast
                qed
                thus ?thesis
                  using D.comp_assoc by simp
              qed
              also have "... = r_D[u] ⋅_D ((u ⋆_D ε) ⋅_D (θ ⋆_D e ⋆_D d)) ⋅_D ((F f ⋆_D w) ⋆_D D.inv ε) ⋅_D
                                 a_D^-1[F f, w, trg_D e] ⋅_D (F f ⋆_D r_D^-1[w])"
                using w e.antipar D.assoc'_naturality [of "F f" w "D.inv ε"] D.comp_assoc by simp
              also have
                "... = r_D[u] ⋅_D (θ ⋆_D trg_D e) ⋅_D (((F f ⋆_D w) ⋆_D ε) ⋅_D ((F f ⋆_D w) ⋆_D D.inv ε) ⋅_D
                         a_D^-1[F f, w, trg_D e]) ⋅_D (F f ⋆_D r_D^-1[w])"
              proof -
                have "(u ⋆_D ε) ⋅_D (θ ⋆_D e ⋆_D d) = (θ ⋆_D trg_D e) ⋅_D ((F f ⋆_D w) ⋆_D ε)"
                  using θ e.antipar D.interchange D.comp_arr_dom D.comp_cod_arr
                  by (metis D.in_homE ‹trg_D e = a› e.counit_simps(1-3,5))
                thus ?thesis
                  using D.comp_assoc by simp
              qed
              also have "... = r_D[u] ⋅_D (θ ⋆_D trg_D e) ⋅_D a_D^-1[F f, w, trg_D e] ⋅_D (F f ⋆_D r_D^-1[w])"
              proof -
                have "(((F f ⋆_D w) ⋆_D ε) ⋅_D ((F f ⋆_D w) ⋆_D D.inv ε)) ⋅_D a_D^-1[F f, w, trg_D e] =
                      a_D^-1[F f, w, trg_D e]"
                proof -
                  have "(((F f ⋆_D w) ⋆_D ε) ⋅_D ((F f ⋆_D w) ⋆_D D.inv ε)) ⋅_D a_D^-1[F f, w, trg_D e] =
                        ((F f ⋆_D w) ⋆_D trg_D e) ⋅_D a_D^-1[F f, w, trg_D e]"
                    using w e.ide_left e.ide_right e.antipar e.counit_is_iso D.comp_arr_inv'
                          D.comp_assoc D.whisker_left
                    by (metis D.ide_hcomp D.seqI' T'.ide_leg0 T'.leg1_simps(3)
                        T.leg1_simps(2-3) T.tab_simps(2) ‹trg_D w = map₀ (src_C ρ)›
                        d.unit_in_vhom e.counit_in_hom(2) e.counit_simps(3) preserves_src)
                  also have "... = a_D^-1[F f, w, trg_D e]"
                    using w D.comp_cod_arr D.assoc'_in_hom(2) [of "F f" w "trg_D e"]
                          ‹trg_D e = a› ‹trg_D w = map₀ (src_C ρ)›
                    by (metis D.assoc'_naturality1 D.ideD(1) D.ideD(2) D.trg.preserves_ide
                        D.trg_trg T'.leg0_simps(2,4) T'.leg1_simps(3)
                        T.leg1_simps(2-3) T.tab_simps(2) a_def e.ide_left
                        preserves_src)
                  finally show ?thesis by blast
                qed
                thus ?thesis
                  using D.comp_assoc by simp
              qed
              also have "... = (r_D[u] ⋅_D (θ ⋆_D trg_D e)) ⋅_D r_D^-1[F f ⋆_D w]"
                using w D.runit_hcomp(2) [of "F f" w] D.comp_assoc by simp
              also have 1: "... = (θ ⋅_D r_D[F f ⋆_D w]) ⋅_D r_D^-1[F f ⋆_D w]"
                using θ D.runit_naturality [of θ] by auto
              also have "... = θ"
                using w θ D.comp_arr_dom D.comp_assoc
                by (metis D.hcomp_arr_obj(2) D.in_homE D.obj_src 1 ‹src_D θ = a› ‹trg_D e = a›)
              finally show ?thesis by simp
            qed
            ultimately show "«?γ : w →_D w'¬ ∧ β = F g ⋆_D ?γ ∧ θ = θ' ⋅_D (F f ⋆_D ?γ)"
              by simp

            show "∧γ'. «γ' : w →_D w'¬ ∧ β = F g ⋆_D γ' ∧ θ = θ' ⋅_D (F f ⋆_D γ') ==> γ' = ?γ"
            proof -
              fix γ'
              assume γ': "«γ' : w →_D w'¬ ∧ β = F g ⋆_D γ' ∧ θ = θ' ⋅_D (F f ⋆_D γ')"
              show "γ' = ?γ"
              proof -
                have "?γ = r_D[w'] ⋅_D (w' ⋆_D ε) ⋅_D (a_D[w', e, d] ⋅_D ((γ' ⋆_D e) ⋆_D d)) ⋅_D
                             a_D^-1[w, e, d] ⋅_D (w ⋆_D D.inv ε) ⋅_D r_D^-1[w]"
                proof -
                  have "γe = γ' ⋆_D e"
                  proof -
                    have "«γ' ⋆_D e : w ⋆_D e →_D w' ⋆_D e¬"
                      using γ' by (intro D.hcomp_in_vhom, auto)
                    moreover have
                      "a_D[F g, w', e] ⋅_D (β ⋆_D e) ⋅_D a_D^-1[F g, w, e] = F g ⋆_D γ' ⋆_D e"
                    proof -
                      have "a_D[F g, w', e] ⋅_D (β ⋆_D e) ⋅_D a_D^-1[F g, w, e] =
                            a_D[F g, w', e] ⋅_D ((F g ⋆_D γ') ⋆_D e) ⋅_D a_D^-1[F g, w, e]"
                        using γ' by simp
                      also have "... = a_D[F g, w', e] ⋅_D a_D^-1[F g, w', e] ⋅_D (F g ⋆_D γ' ⋆_D e)"
                        using γ' D.assoc_naturality
                        by (metis D.assoc'_naturality D.hcomp_in_vhomE D.ideD(2) D.ideD(3)
                            D.in_homE T'.leg1_simps(5-6) β
                            ‹«γ' ⋆_D e : w ⋆_D e →_D w' ⋆_D e¬› e.ide_left)
                      also have "... = (a_D[F g, w', e] ⋅_D a_D^-1[F g, w', e]) ⋅_D (F g ⋆_D γ' ⋆_D e)"
                        using D.comp_assoc by simp
                      also have "... = F g ⋆_D γ' ⋆_D e"
                        by (metis D.hcomp_reassoc(2) D.in_homE D.not_arr_null D.seq_if_composable
                            T'.leg1_simps(2,5-6) β γ' calculation
                            ‹«γ' ⋆_D e : w ⋆_D e →_D w' ⋆_D e¬› e.triangle_equiv_form(1)
                            e.triangle_in_hom(3) e.triangle_right e.triangle_right_implies_left)
                      finally show ?thesis by simp
                    qed
                    moreover have "ψ ⋅_D (θ ⋆_D e) ⋅_D a_D^-1[F f, w, e] =
                                   ψ ⋅_D (θ' ⋆_D e) ⋅_D a_D^-1[F f, w', e] ⋅_D (F f ⋆_D γ' ⋆_D e)"
                    proof -
                      have "ψ ⋅_D (θ' ⋆_D e) ⋅_D a_D^-1[F f, w', e] ⋅_D (F f ⋆_D γ' ⋆_D e) =
                            ψ ⋅_D (θ' ⋆_D e) ⋅_D ((F f ⋆_D γ') ⋆_D e) ⋅_D a_D^-1[F f, w, e]"
                        using γ' θ e.ide_left D.assoc'_naturality
                        by (metis D.hcomp_in_vhomE D.ideD(2) D.ideD(3) D.in_homE
                            T'.leg0_simps(2,4-5) T'.leg1_simps(3) β calculation(1))
                      also have "... = ψ ⋅_D ((θ' ⋆_D e) ⋅_D ((F f ⋆_D γ') ⋆_D e)) ⋅_D a_D^-1[F f, w, e]"
                        using D.comp_assoc by simp
                      also have "... = ψ ⋅_D (θ' ⋅_D (F f ⋆_D γ') ⋆_D e) ⋅_D a_D^-1[F f, w, e]"
                        using D.whisker_right γ' θ by auto
                      also have "... = ψ ⋅_D (θ ⋆_D e) ⋅_D a_D^-1[F f, w, e]"
                        using γ' by simp
                      finally show ?thesis by simp
                    qed
                    ultimately show ?thesis
                      using UN by simp
                  qed
                  thus ?thesis
                    using D.comp_assoc by simp
                qed
                also have "... = r_D[w'] ⋅_D ((w' ⋆_D ε) ⋅_D (γ' ⋆_D e ⋆_D d)) ⋅_D a_D[w, e, d] ⋅_D
                                   a_D^-1[w, e, d] ⋅_D (w ⋆_D D.inv ε) ⋅_D r_D^-1[w]"
                  using w' γ' D.comp_assoc D.assoc_naturality
                  by (metis D.in_homE D.src_dom ‹trg_D e = a› a_def e.antipar(1)
                      e.triangle_equiv_form(1) e.triangle_in_hom(3-4)
                      e.triangle_right e.triangle_right' e.triangle_right_implies_left)
                also have "... = (r_D[w'] ⋅_D (γ' ⋆_D trg_D e)) ⋅_D (w ⋆_D ε) ⋅_D a_D[w, e, d] ⋅_D
                                   a_D^-1[w, e, d] ⋅_D (w ⋆_D D.inv ε) ⋅_D r_D^-1[w]"
                proof -
                  have "(w' ⋆_D ε) ⋅_D (γ' ⋆_D e ⋆_D d) = γ' ⋆_D ε"
                    using w' γ' e.antipar D.comp_arr_dom D.comp_cod_arr
                          D.interchange [of w' γ' ε "e ⋆_D d"]
                    by auto
                  also have "... = (γ' ⋆_D trg_D e) ⋅_D (w ⋆_D ε)"
                    using w γ' e.antipar D.comp_arr_dom D.comp_cod_arr D.interchange
                    by (metis D.in_homE ‹trg_D e = a› e.counit_simps(1) e.counit_simps(3,5))
                  finally have "(w' ⋆_D ε) ⋅_D (γ' ⋆_D e ⋆_D d) = (γ' ⋆_D trg_D e) ⋅_D (w ⋆_D ε)"
                    by simp
                  thus ?thesis
                    using D.comp_assoc by simp
                qed
                also have "... = γ' ⋅_D r_D[w] ⋅_D (w ⋆_D ε) ⋅_D a_D[w, e, d] ⋅_D a_D^-1[w, e, d] ⋅_D
                                   (w ⋆_D D.inv ε) ⋅_D r_D^-1[w]"
                  using γ' D.runit_naturality D.comp_assoc
                  by (metis D.in_homE D.src_dom ‹trg_D e = a› a_def)
                also have "... = γ'"
                proof -
                  have "r_D[w] ⋅_D (w ⋆_D ε) ⋅_D a_D[w, e, d] ⋅_D a_D^-1[w, e, d] ⋅_D (w ⋆_D D.inv ε) ⋅_D
                          r_D^-1[w] =
                        r_D[w] ⋅_D ((w ⋆_D ε) ⋅_D (a_D[w, e, d] ⋅_D a_D^-1[w, e, d]) ⋅_D (w ⋆_D D.inv ε)) ⋅_D
                          r_D^-1[w]"
                    using D.comp_assoc by simp
                  also have "... = r_D[w] ⋅_D ((w ⋆_D ε) ⋅_D (w ⋆_D e ⋆_D d) ⋅_D (w ⋆_D D.inv ε)) ⋅_D
                                     r_D^-1[w]"
                    using w γ e.ide_left e.ide_right we e.antipar D.comp_assoc_assoc'(1)
                          ‹trg_D e = a› a_def
                    by presburger
                  also have "... = r_D[w] ⋅_D ((w ⋆_D ε) ⋅_D (w ⋆_D D.inv ε)) ⋅_D r_D^-1[w]"
                    using w γ e.ide_left e.ide_right we e.antipar D.comp_cod_arr
                    by (metis D.whisker_left d.unit_simps(1,3))
                  also have "... = r_D[w] ⋅_D (w ⋆_D src_D w) ⋅_D r_D^-1[w]"
                    using w e.counit_is_iso C.comp_arr_inv'
                    by (metis D.comp_arr_inv' D.seqI' D.whisker_left ‹trg_D e = a› a_def
                        d.unit_in_vhom e.counit_in_hom(2) e.counit_simps(3))
                  also have "... = r_D[w] ⋅_D r_D^-1[w]"
                    using w e.antipar D.comp_cod_arr by simp
                  also have "... = w"
                    using w
                    by (simp add: D.comp_arr_inv')
                  finally have "r_D[w] ⋅_D (w ⋆_D ε) ⋅_D a_D[w, e, d] ⋅_D a_D^-1[w, e, d] ⋅_D
                                 (w ⋆_D D.inv ε) ⋅_D r_D^-1[w] = w"
                    by simp
                  thus ?thesis
                    using γ' D.comp_arr_dom by auto
                qed
                finally show ?thesis by simp
              qed
           qed
          qed
        qed
      qed
      show ?thesis ..
    qed

    lemma reflects_tabulation:
    assumes "C.ide r" and "C.ide f" and "«ρ : g →_C r ⋆_C f¬"
    assumes "tabulation V_D H_D a_D i_D src_D trg_D (F r) (D.inv (Φ (r, f)) ⋅_D F ρ) (F f) (F g)"
    shows "tabulation V_C H_C a_C i_C src_C trg_C r ρ f g"
    proof -
      interpret ρ': tabulation V_D H_D a_D i_D src_D trg_D
                      ‹F r› ‹D.inv (Φ (r, f)) ⋅_D F ρ› ‹F f› ‹F g›
        using assms by auto
      interpret ρ: tabulation_data V_C H_C a_C i_C src_C trg_C r ρ f g
        using assms by (unfold_locales, simp_all)
      interpret ρ: tabulation V_C H_C a_C i_C src_C trg_C r ρ f g
      proof
        show "∧u ψ. [ C.ide u; «ψ : C.dom ψ →_C r ⋆_C u¬ ] ==>
                     ∃w θ ν. C.ide w ∧ «θ : f ⋆_C w →_C u¬ ∧ «ν : C.dom ψ →_C g ⋆_C w¬ ∧
                             C.iso ν ∧ ρ.composite_cell w θ ⋅_C ν = ψ"
        proof -
          fix u ψ
          assume u: "C.ide u"
          assume ψ: "«ψ : C.dom ψ →_C r ⋆_C u¬"
          have hseq_ru: "src_C r = trg_C u"
            using ψ C.ide_cod C.ideD(1) by fastforce
          hence 1: "«D.inv (Φ (r, u)) ⋅_D F ψ : F (C.dom ψ) →_D F r ⋆_D F u¬"
            using assms u ψ cmp_in_hom cmp_components_are_iso
            by (intro D.comp_in_homI, auto)
          hence 2: "D.dom (D.inv (Φ (r, u)) ⋅_D F ψ) = F (C.dom ψ)"
            by auto
          obtain w θ ν
            where wθν: "D.ide w ∧ «θ : F f ⋆_D w →_D F u¬ ∧
                        «ν : F (C.dom ψ) →_D F g ⋆_D w¬ ∧ D.iso ν ∧
                        ρ'.composite_cell w θ ⋅_D ν = D.inv (Φ (r, u)) ⋅_D F ψ"
            using 1 2 u ρ'.T1 [of "F u" "D.inv (Φ (r, u)) ⋅_D F ψ"] by auto
          have hseq_Ff_w: "src_D (F f) = trg_D w"
            using u ψ wθν
            by (metis "1" D.arrI D.not_arr_null D.seqE D.seq_if_composable ρ'.tab_simps(2))
          have hseq_Fg_w: "src_D (F g) = trg_D w"
            using u ψ wθν by (simp add: hseq_Ff_w)
          have w: "«w : map₀ (src_C ψ) →_D map₀ (src_C f)¬"
              using u ψ wθν hseq_Fg_w
              by (metis "1" C.arrI D.arrI D.hseqI' D.ideD(1) D.in_hhom_def D.src_hcomp
                  D.src_vcomp D.vconn_implies_hpar(1) D.vconn_implies_hpar(3)
                  D.vseq_implies_hpar(1) ρ'.leg1_simps(2) ρ.leg0_simps(2) hseq_Ff_w
                  preserves_src)
          obtain w' where w': "«w' : src_C ψ →_C src_C f¬ ∧ C.ide w' ∧ D.isomorphic (F w') w"
            using assms w ψ wθν locally_essentially_surjective by force
          obtain φ where φ: "«φ : F w' →_D w¬ ∧ D.iso φ"
            using w' D.isomorphic_def by blast
          have src_fw': "src_C (f ⋆_C w') = src_C u"
            using u w' ψ
            by (metis C.hseqI' C.ideD(1) C.in_hhomE C.src_hcomp C.vconn_implies_hpar(1)
                C.vconn_implies_hpar(3) ρ.base_simps(2) ρ.leg0_in_hom(1) hseq_ru)
          have 3: "«θ ⋅_D (F f ⋆_D φ) ⋅_D D.inv (Φ (f, w')) : F (f ⋆_C w') →_D F u¬"
          proof (intro D.c am :: "'a1 → 'a2"
            show "«D.F<b>a am F"
              as w' cmp_in_ho cmp_components_are_ by aut
            show "<motleft 
              using φ ρ'.leg0_in_hom(2) w' by fastforce
            show "«θ : F f ⋆_D w →_D F u¬"
              using wθν by simp
          qed
          have 4: "∃θ'. «θ' : f ⋆_C w' →_C u¬ ∧ F θ' = θ ⋅_D (F f ⋆_D φ) ⋅_D D.inv (Φ (f, w'))"
            using w' u hseq_ru src_fw' 3 locally_full by auto
          obtain θ' where
            θ': "«θ' : f ⋆_C w' →_C u¬ ∧ F θ' = θ ⋅_D (F f ⋆_D φ) ⋅_D D.inv (Φ (f, w'))"
            using 4 by auto
          have 5: "«Φ (g, w') ⋅_D (F g ⋆_D D.inv φ) ⋅_D ν : F (C.dom ψ) →_D F (g ⋆_C w')¬"
          proof (intro D.comp_in_homI)
            show "«ν : F (C.dom ψ) →_D F g ⋆_D w¬"
              using wθν by simp
            show "«F g ⋆_D D.inv φ : F g ⋆_D w →_D F g ⋆_D F w'¬"
              using assms φ
              by (meson D.hcomp_in_vhom D.inv_in_hom ρ'.leg1_in_hom(2) hseq_Fg_w)
            show "«Φ (g, w') : F g ⋆_D F w' →_D F (g ⋆_C w')¬"
              using assms w' cmp_in_hom by auto
          qed
          have 6: "∃ν'. «ν' : C.dom ψ →_C g ⋆_C w'¬ ∧
                        F ν' = Φ(g, w') ⋅_D (F g ⋆_D D.inv φ) ⋅_D ν"
            using u w' ψ C.in_hhom_def hseq_ru C.hseqI' C.hcomp_simps(1-2)
            by (metis "5" C.arrI C.ide_hcomp C.ideD(1) C.ide_dom C.vconn_implies_hpar(1,4)
                ρ.base_simps(2) ρ.ide_leg1 ρ.leg1_in_hom(1) locally_full)
          obtain ν' where
            ν': "«ν' : C.dom ψ →_C g ⋆_C w'¬ ∧ F ν' = Φ(g, w') ⋅_D (F g ⋆_D D.inv φ) ⋅_D ν"
            using 6 by auto
          have "C.ide w' ∧ «θ' : f ⋆_C w' →_C u¬ ∧ «ν' : C.dom ψ →_C g ⋆_C w'¬ ∧ C.iso ν' ∧
                ρ.composite_cell w' θ' ⋅_C ν' = ψ"
            using w' θ' ν'
            apply (intro conjI)
                apply auto
          proof -
            show "C.iso ν'"
            proof -
              have "D.iso (F ν')"
              proof -
                have "D.iso (Φ(g, w'))"
                  using w' cmp_components_are_iso by auto
                moreover have "D.iso (F g ⋆_D D.inv φ)"
                  using φ
                  by (meson "5" D.arrI D.iso_hcomp D.hseq_char' D.ide_is_iso D.iso_inv_iso
                      D.seqE D.seq_if_composable ρ'.ide_leg1)
                moreover have "D.iso ν"
                  using wθν by simp
                ultimately show ?thesis
                  using ν' D.isos_compose
                  by (metis "5" D.arrI D.seqE)
              qed
              thus ?thesis using reflects_iso by blast
            qed
            have 7: "«ρ.composite_cell w' θ' : g ⋆_C w' →_C r ⋆_C u¬"
              using u w' θ' ρ.composite_cell_in_hom hseq_ru src_fw' C.hseqI'
              by (metis C.in_hhomE C.hcomp_simps(1) ρ.leg0_simps(2))
            hence 8: "«ρ.composite_cell w' θ' ⋅_C ν' : C.dom ψ →_C r ⋆_C u¬"
              using ν' by blast
            show "ρ.composite_cell w' θ' ⋅_C ν' = ψ"
            proof -
              have 1: "C.par (ρ.composite_cell w' θ' ⋅_C ν') ψ"
                using ψ 8 hseq_ru C.hseqI' C.in_homE by metis
              moreover have "F (ρ.composite_cell w' θ' ⋅_C ν') = F ψ"
              proof -
                have "F (ρ.composite_cell w' θ' ⋅_C ν') =
                      F (r ⋆_C θ') ⋅_D F a_C[r, f, w'] ⋅_D F (ρ ⋆_C w') ⋅_D F ν'"
                  using w' θ' ν' 1 C.comp_assoc
                  by (metis C.seqE preserves_comp)
                also have "... = Φ (r, u) ⋅_D (F r ⋆_D F θ') ⋅_D ((D.inv (Φ (r, f ⋆_C w')) ⋅_D
                                   Φ (r, f ⋆_C w')) ⋅_D (F r ⋆_D Φ (f, w'))) ⋅_D
                                   a_D[F r, F f, F w'] ⋅_D (D.inv (Φ (r, f)) ⋆_D F w') ⋅_D
                                   ((D.inv (Φ (r ⋆_C f, w')) ⋅_D
                                   Φ (r ⋆_C f, w')) ⋅_D (F ρ ⋆_D F w')) ⋅_D D.inv (Φ (g, w')) ⋅_D F ν'"
                proof -
                  have "F a_C[r, f, w'] =
                        Φ (r, f ⋆_C w') ⋅_D (F r ⋆_D Φ (f, w')) ⋅_D a_D[F r, F f, F w'] ⋅_D
                         (D.inv (Φ (r, f)) ⋆_D F w') ⋅_D D.inv (Φ (r ⋆_C f, w'))"
                    using assms w'
                    by (simp add: C.in_hhom_def preserves_assoc(1))
                  moreover have
                    "F (r ⋆_C θ') = Φ (r, u) ⋅_D (F r ⋆_D F θ') ⋅_D D.inv (Φ (r, f ⋆_C w'))"
                    using assms θ' preserves_hcomp [of r θ']
                    by (metis "1" C.in_homE C.seqE ρ.base_simps(3) ρ.base_simps(4))
                  moreover have
                    "F (ρ ⋆_C w') = Φ (r ⋆_C f, w') ⋅_D (F ρ ⋆_D F w') ⋅_D D.inv (Φ (g, w'))"
                    using w' preserves_hcomp [of ρ w'] by auto
                  ultimately show ?thesis
                    by (simp add: D.comp_assoc)
                qed
                also have "... = Φ (r, u) ⋅_D (F r ⋆_D F θ') ⋅_D (F r ⋆_D Φ (f, w')) ⋅_D
                                   a_D[F r, F f, F w'] ⋅_D (D.inv (Φ (r, f)) ⋆_D F w') ⋅_D
                                   (F ρ ⋆_D F w') ⋅_D D.inv (Φ (g, w')) ⋅_D F ν'"
                proof -
                  have "(D.inv (Φ (r, f ⋆_C w')) ⋅_D Φ (r, f ⋆_C w')) ⋅_D (F r ⋆_D Φ (f, w')) =
                        F r ⋆_D Φ (f, w')"
                    using w' cmp_components_are_iso D.comp_cod_arr C.hseqI' D.hseqI'
                          C.in_hhom_def C.trg_hcomp D.comp_inv_arr' C.ide_hcomp
                    by (metis C.ideD(1) D.hcomp_simps(4) cmp_simps(1,3-5)
                        ρ'.leg0_simps(3) ρ'.base_simps(2,4) ρ.ide_leg0 ρ.ide_base
                        ρ.leg0_simps(3))
                  moreover have "(D.inv (Φ (r ⋆_C f, w')) ⋅_D Φ (r ⋆_C f, w')) ⋅_D (F ρ ⋆_D F w') =
                                 F ρ ⋆_D F w'"
                    using w' D.comp_inv_arr' hseq_Fg_w D.comp_cod_arr by auto
                  ultimately show ?thesis by simp
                qed
                also have "... = Φ (r, u) ⋅_D ((F r ⋆_D θ ⋅_D (F f ⋆_D φ) ⋅_D D.inv (Φ (f, w'))) ⋅_D
                                   (F r ⋆_D Φ (f, w'))) ⋅_D a_D[F r, F f, F w'] ⋅_D
                                   ((D.inv (Φ (r, f)) ⋆_D F w') ⋅_D (F ρ ⋆_D F w')) ⋅_D
                                   D.inv (Φ (g, w')) ⋅_D Φ (g, w') ⋅_D (F g ⋆_D D.inv φ) ⋅_D ν"
                  using w' θ' ν' D.comp_assoc by simp
                also have "... = Φ (r, u) ⋅_D (F r ⋆_D θ ⋅_D (F f ⋆_D φ) ⋅_D D.inv (Φ (f, w')) ⋅_D
                                   Φ (f, w')) ⋅_D a_D[F r, F f, F w'] ⋅_D (D.inv (Φ (r, f)) ⋅_D
                                   F ρ ⋆_D F w') ⋅_D ((D.inv (Φ (g, w')) ⋅_D Φ (g, w')) ⋅_D
                                   (F g ⋆_D D.inv φ)) ⋅_D ν"
                proof -
                  have "(F r ⋆_D θ ⋅_D (F f ⋆_D φ) ⋅_D D.inv (Φ (f, w'))) ⋅_D (F r ⋆_D Φ (f, w')) =
                        F r ⋆_D (θ ⋅_D (F f ⋆_D φ) ⋅_D D.inv (Φ (f, w'))) ⋅_D Φ (f, w')"
                  proof - 
                    have "D.seq (θ ⋅_D (F f ⋆_D φ) ⋅_D D.inv (Φ (f, w'))) (Φ (f, w'))"
                      using assms 3 ρ.ide_base w' wθν cmp_in_hom [of f w'] cmp_components_are_iso
                            C.in_hhom_def
                      apply (intro D.seqI)
                      using C.in_hhom_def
                            apply auto[3]
                         apply blast
                      by auto
                    thus ?thesis
                      using assms w' wθν cmp_in_hom cmp_components_are_iso D.whisker_left
                      by simp
                  qed
                  moreover have "(D.inv (Φ (r, f)) ⋆_D F w') ⋅_D (F ρ ⋆_D F w') =
                                 D.inv (Φ (r, f)) ⋅_D F ρ ⋆_D F w'"
                    using w' D.whisker_right by simp
                  ultimately show ?thesis
                    using D.comp_assoc by simp
                qed
                also have "... = Φ (r, u) ⋅_D (F r ⋆_D θ ⋅_D (F f ⋆_D φ)) ⋅_D
                                   a_D[F r, F f, F w'] ⋅_D ((D.inv (Φ (r, f)) ⋅_D F ρ ⋆_D F w') ⋅_D
                                   (F g ⋆_D D.inv φ)) ⋅_D ν"
                proof -
                  have "(F f ⋆_D φ) ⋅_D D.inv (Φ (f, w')) ⋅_D Φ (f, w') = F f ⋆_D φ"
                    using assms(2) w' φ 3 cmp_components_are_iso cmp_in_hom D.hseqI' D.comp_inv_arr'
                          D.comp_arr_dom
                    by (metis C.in_hhom_def D.arrI D.cod_inv D.seqE)
                  moreover have "(D.inv (Φ (g, w')) ⋅_D Φ (g, w')) ⋅_D (F g ⋆_D D.inv φ) =
                                 F g ⋆_D D.inv φ"
                    using assms w' φ 3 cmp_components_are_iso cmp_in_hom D.hseqI'
                          D.comp_inv_arr' D.comp_cod_arr
                    by (metis "5" C.in_hhom_def D.arrI D.comp_assoc D.seqE ρ.ide_leg1
                        ρ.leg1_simps(3))
                  ultimately show ?thesis
                    using D.comp_assoc by simp
                qed
                also have "... = Φ (r, u) ⋅_D (F r ⋆_D θ ⋅_D (F f ⋆_D φ)) ⋅_D
                                   (a_D[F r, F f, F w'] ⋅_D ((F r ⋆_D F f) ⋆_D D.inv φ)) ⋅_D
                                   (D.inv (Φ (r, f)) ⋅_D F ρ ⋆_D w) ⋅_D ν"
                proof -
                  have "(D.inv (Φ (r, f)) ⋅_D F ρ ⋆_D F w') ⋅_D (F g ⋆_D D.inv φ) =
                        D.inv (Φ (r, f)) ⋅_D F ρ ⋆_D D.inv φ"
                    using assms w' φ cmp_in_hom cmp_components_are_iso D.comp_arr_dom
                          D.comp_cod_arr
                          D.interchange [of "D.inv (Φ (r, f)) ⋅_D F ρ" "F g" "F w'" "D.inv φ"]
                    by auto
                  also have "... = ((F r ⋆_D F f) ⋆_D D.inv φ) ⋅_D (D.inv (Φ (r, f)) ⋅_D F ρ ⋆_D w)"
                    using assms w' φ cmp_components_are_iso D.comp_arr_dom D.comp_cod_arr
                          D.interchange [of "F r ⋆_D F f" "D.inv (Φ (r, f)) ⋅_D F ρ" "D.inv φ" w]
                    by auto
                  finally have "(D.inv (Φ (r, f)) ⋅_D F ρ ⋆_D F w') ⋅_D (F g ⋆_D D.inv φ) =
                                ((F r ⋆_D F f) ⋆_D D.inv φ) ⋅_D (D.inv (Φ (r, f)) ⋅_D F ρ ⋆_D w)"
                    by simp
                  thus ?thesis
                    using D.comp_assoc by simp
                qed
                also have "... = Φ (r, u) ⋅_D ((F r ⋆_D θ ⋅_D (F f ⋆_D φ)) ⋅_D
                                    (F r ⋆_D F f ⋆_D D.inv φ)) ⋅_D a_D[F r, F f, w] ⋅_D
                                   (D.inv (Φ (r, f)) ⋅_D F ρ ⋆_D w) ⋅_D ν"
                proof -
                  have "a_D[F r, F f, F w'] ⋅_D ((F r ⋆_D F f) ⋆_D D.inv φ) =
                        (F r ⋆_D F f ⋆_D D.inv φ) ⋅_D a_D[F r, F f, w]"
                  proof -
                    have "src_D (F r) = trg_D (F f)"
                      by simp
                    moreover have "src_D (F f) = trg_D (D.inv φ)"
                      using φ
                      by (metis "5" D.arrI D.hseqE D.seqE ρ'.leg1_simps(3))
                    ultimately show ?thesis
                      using assms w' φ D.assoc_naturality [of "F r" "F f" "D.inv φ"] by auto
                  qed
                  thus ?thesis
                    using D.comp_assoc by simp
                qed
                also have "... = Φ (r, u) ⋅_D (F r ⋆_D θ) ⋅_D a_D[F r, F f, w] ⋅_D
                                   (D.inv (Φ (r, f)) ⋅_D F ρ ⋆_D w) ⋅_D ν"
                  using assms φ wθν D.comp_arr_inv' D.comp_arr_dom D.comp_cod_arr
                        D.whisker_left D.whisker_left D.comp_assoc
                  by (metis D.ideD(1) D.in_homE ρ'.ide_base tabulation_data.leg0_simps(1)
                            tabulation_def)
                also have "... = (Φ (r, u) ⋅_D D.inv (Φ (r, u))) ⋅_D F ψ"
                  using wθν D.comp_assoc by simp
                also have "... = F ψ"
                  using u ψ cmp_in_hom D.comp_arr_inv'
                  by (metis C.in_homE cmp_components_are_iso cmp_simps(5) ρ.ide_base
                      as_nat_trans.naturality1 as_nat_trans.naturality hseq_ru)
                finally show ?thesis by blast
              qed
              ultimately show ?thesis
                using is_faithful [of "ρ.composite_cell w' θ' ⋅_C ν'" ψ] by simp
            qed
          qed
          thus "∃w θ ν. C.ide w ∧ «θ : f ⋆_C w →_C u¬ ∧ «ν : C.dom ψ →_C g ⋆_C w¬ ∧
                        C.iso ν ∧ ρ.composite_cell w θ ⋅_C ν = ψ"
            by auto
        qed

        show "∧u w w' θ θ' β. [ C.ide w; C.ide w'; «θ : f ⋆_C w →_C u¬; «θ' : f ⋆_C w' →_C u¬;
                                «β : g ⋆_C w →_C g ⋆_C w'¬;
                                ρ.composite_cell w θ = ρ.composite_cell w' θ' ⋅_C β ]
                                   ==> ∃!γ. «γ : w →_C w'¬ ∧ β = g ⋆_C γ ∧ θ = θ' ⋅_C (f ⋆_C γ)"
        proof -
          fix u w w' θ θ' β
          assume w: "C.ide w"
          assume w': "C.ide w'"
          assume θ: "«θ : f ⋆_C w →_C u¬"
          assume θ': "«θ' : f ⋆_C w' →_C u¬"
          assume β: "«β : g ⋆_C w →_C g ⋆_C w'¬"
          assume eq: "ρ.composite_cell w θ = ρ.composite_cell w' θ' ⋅_C β"
          show "∃!γ. «γ : w →_C w'¬ ∧ β = g ⋆_C γ ∧ θ = θ' ⋅_C (f ⋆_C γ)"
          proof -
            have hseq_ru: "src_C r = trg_C u"
            using w θ
            by (metis C.hseq_char' C.in_homE C.trg.extensionality C.trg.preserves_hom
                C.trg_hcomp C.vconn_implies_hpar(2) C.vconn_implies_hpar(4) ρ.leg0_simps(3))
            have hseq_fw: "src_C f = trg_C w ∧ src_C f = trg_C w'"
              using w w' ρ.ide_leg0 θ θ'
              by (metis C.horizontal_homs_axioms C.ideD(1) C.in_homE C.not_arr_null
                  C.seq_if_composable category.ide_dom horizontal_homs_def)
            have hseq_gw: "src_C g = trg_C w ∧ src_C g = trg_C w'"
              using w w' ρ.ide_leg0 θ θ' ‹src_C f = trg_C w ∧ src_C f = trg_C w'› by auto
            have *: "∃!γ. «γ : F w →_D F w'¬ ∧
                          D.inv (Φ (g, w')) ⋅_D F β ⋅_D Φ (g, w) = F g ⋆_D γ ∧
                          F θ ⋅_D Φ (f, w) = (F θ' ⋅_D Φ (f, w')) ⋅_D (F f ⋆_D γ)"
            proof -
              have "D.ide (F w) ∧ D.ide (F w')"
                using w w' by simp
              moreover have 1: "«F θ ⋅_D Φ (f, w) : F f ⋆_D F w →_D F u¬"
                using w θ cmp_in_hom ρ.ide_leg0 hseq_fw by blast
              moreover have 2: "«F θ' ⋅_D Φ (f, w') : F f ⋆_D F w' →_D F u¬"
                using w' θ' cmp_in_hom ρ.ide_leg0 hseq_fw by blast
              moreover have
                "«D.inv (Φ (g, w')) ⋅_D F β ⋅_D Φ (g, w) : F g ⋆_D F w →_D F g ⋆_D F w'¬"
                using w w' β ρ.ide_leg1 cmp_in_hom cmp_components_are_iso hseq_gw preserves_hom
                by fastforce
              moreover have "ρ'.composite_cell (F w) (F θ ⋅_D Φ (f, w)) =
                             ρ'.composite_cell (F w') (F θ' ⋅_D Φ (f, w')) ⋅_D
                               D.inv (Φ (g, w')) ⋅_D F β ⋅_D Φ (g, w)"
              proof -
                have "ρ'.composite_cell (F w') (F θ' ⋅_D Φ (f, w')) ⋅_D
                        D.inv (Φ (g, w')) ⋅_D F β ⋅_D Φ (g, w) =
                      (F r ⋆_D F θ' ⋅_D Φ (f, w')) ⋅_D a_D[F r, F f, F w'] ⋅_D
                        (D.inv (Φ (r, f)) ⋅_D F ρ ⋆_D F w') ⋅_D
                        D.inv (Φ (g, w')) ⋅_D F β ⋅_D Φ (g, w)"
                  using D.comp_assoc by simp
                also have "... =
                           (F r ⋆_D F θ') ⋅_D (F r ⋆_D Φ (f, w')) ⋅_D a_D[F r, F f, F w'] ⋅_D
                             (D.inv (Φ (r, f)) ⋆_D F w') ⋅_D (F ρ ⋆_D F w') ⋅_D
                             D.inv (Φ (g, w')) ⋅_D F β ⋅_D Φ (g, w)"
                  using w' θ' 2 D.whisker_left D.whisker_right D.comp_assoc by auto
                also have "... = (F r ⋆_D F θ') ⋅_D ((D.inv (Φ (r, f ⋆_C w')) ⋅_D
                                   Φ (r, f ⋆_C w')) ⋅_D (F r ⋆_D Φ (f, w'))) ⋅_D
                                   a_D[F r, F f, F w'] ⋅_D (D.inv (Φ (r, f)) ⋆_D F w') ⋅_D
                                   D.inv (\P (r ⋆_C f, w')) ⋅_D
                                   Φ (r ⋆_C f, w')) ⋅_D (F ρ ⋆_D F w')) ⋅_D
                                   D.inv (Φ (g, w')) ⋅_D F β ⋅_D Φ (g, w)"
                proof -
                  have "(D.inv (Φ (r, f ⋆_C w')) ⋅_D Φ (r, f ⋆_C w')) ⋅_D (F r ⋆_D Φ (f, w')) =
                        F r ⋆_D Φ (f, w')"
                    using w' cmp_components_are_iso D.comp_cod_arr C.hseqI' D.hseqI'
                          C.in_hhom_def C.trg_hcomp D.comp_inv_arr' C.ide_hcomp
.(1)D.(4)cmp_simps1)(3-)
                        ρ'.leg0_simps(3) ρ'.base_simps(2,4) ρ.ide_leg0 ρ.ide_base
                        ρ.leg0_simps(3) hseq_fw)
                  moreover have "(D.inv (Φ (r ⋆_C f, w')) ⋅_D Φ (r ⋆_C f, w')) ⋅_D (F ρ ⋆_D F w') =
                                 F ρ ⋆_D F w'"
                    using w' D.comp_inv_arr' D.comp_cod_arr hseq_fw by auto
                  ultimately show ?thesis
                    using D.comp_assoc by simp
                qed
                also have "... = D.inv (Φ (r, u)) ⋅_D
                                   (Φ (r, u) ⋅_D (F r ⋆_D F θ') ⋅_D (D.inv (Φ (r, f ⋆_C w'))) ⋅_D
                                   (Φ (r, f ⋆_C w')) ⋅_D (F r ⋆_D Φ (f, w')) ⋅_D
                                   a_D[F r, F f, F w'] ⋅_D (D.inv (Φ (r, f)) ⋆_D F w') ⋅_D
                                   (D.inv (Φ (r ⋆_C f, w')) ⋅_D
                                   (Φ (r ⋆_C f, w')) ⋅_D (F ρ ⋆_D F w')) ⋅_D
                                   D.inv (Φ (g, w'))) ⋅_D F β ⋅_D Φ (g, w)"
                proof -
                  have "(D.inv (Φ (r, u)) ⋅_D Φ (r, u)) ⋅_D (F r ⋆_D F θ') = F r ⋆_D F θ'"
                    using assms(1) θ' D.comp_cod_arr hseq_ru D.comp_inv_arr' by auto
                  thus ?thesis
                    using D.comp_assoc by metis
                qed
                also have "... = D.inv (Φ (r, u)) ⋅_D
                                  (F (r ⋆_C θ') ⋅_D F a_C[r, f, w'] ⋅_D F (ρ ⋆_C w')) ⋅_D
                                  F β ⋅_D Φ (g, w)"
                proof -
                  have "F (r ⋆_C θ') = Φ (r, u) ⋅_D (F r ⋆_D F θ') ⋅_D D.inv (Φ (r, f ⋆_C w'))"
                    using w' θ' preserves_hcomp hseq_ru by auto
                  moreover have "F a_C[r, f, w'] =
                                 Φ (r, f ⋆_C w') ⋅_D (F r ⋆_D Φ (f, w')) ⋅_D a_D[F r, F f, F w'] ⋅_D
                                   (D.inv (Φ (r, f)) ⋆_D F w') ⋅_D D.inv (Φ (r ⋆_C f, w'))"
                    using w' preserves_assoc(1) hseq_fw by force
                  moreover have
                    "F (ρ ⋆_C w') = Φ (r ⋆_C f, w') ⋅_D (F ρ ⋆_D F w') ⋅_D D.inv (Φ (g, w'))"
                    using w' preserves_hcomp hseq_fw by fastforce
                  ultimately show ?thesis
                    using D.comp_assoc by auto
                qed
                also have "... = D.inv (Φ (r, u)) ⋅_D F (ρ.composite_cell w' θ') ⋅_D F β ⋅_D Φ (g, w)"
                  using w' θ' C.comp_assoc hseq_ru hseq_fw by auto
                also have "... = D.inv (Φ (r, u)) ⋅_D (F (ρ.composite_cell w' θ') ⋅_D F β) ⋅_D Φ (g, w)"
                  using D.comp_assoc by simp
                also have "... = D.inv (Φ (r, u)) ⋅_D F (ρ.composite_cell w' θ' ⋅_C β) ⋅_D Φ (g, w)"
                proof -
                  have "F (ρ.composite_cell w' θ') ⋅_D F β = F (ρ.composite_cell w' θ' ⋅_C β)"
                    using w w' θ' β ρ.composite_cell_in_hom
                          preserves_comp [of "ρ.composite_cell w' θ'" β]
                    by (metis C.dom_comp C.hcomp_simps(3) C.ide_char C.in_homE C.seqE C.seqI
                        D.ext D.seqE ρ.tab_simps(4) extensionality preserves_reflects_arr)
                  thus ?thesis by simp
                qed
                also have "... = D.inv (Φ (r, u)) ⋅_D F (ρ.composite_cell w θ) ⋅_D Φ (g, w)"
                  using eq by simp
                also have "... = D.inv (Φ (r, u)) ⋅_D
                                   F (r ⋆_C θ) ⋅_D F a_C[r, f, w] ⋅_D F (ρ ⋆_C w) ⋅_D Φ (g, w)"
                  using w θ C.comp_assoc hseq_ru hseq_fw D.comp_assoc by auto
                also have "... = ((D.inv (Φ (r, u)) ⋅_D
                                   Φ (r, u)) ⋅_D (F r ⋆_D F θ)) ⋅_D ((D.inv (Φ (r, f ⋆_C w)) ⋅_D
                                   Φ (r, f ⋆_C w)) ⋅_D (F r ⋆_D Φ (f, w))) ⋅_D
                                   a_D[F r, F f, F w] ⋅_D (D.inv (Φ (r, f)) ⋆_D F w) ⋅_D
                                   ((D.inv (Φ (r ⋆_C f, w)) ⋅_D
                                   Φ (r ⋆_C f, w)) ⋅_D (F ρ ⋆_D F w)) ⋅_D D.inv (Φ (g, w)) ⋅_D Φ (g, w)"
                proof -
                  have "F (r ⋆_C θ) = Φ (r, u) ⋅_D (F r ⋆_D F θ) ⋅_D D.inv (Φ (r, f ⋆_C w))"
                    using w θ preserves_hcomp hseq_ru by auto
                  moreover have "F a_C[r, f, w] =
                        Φ (r, f ⋆_C w) ⋅_D (F r ⋆_D Φ (f, w)) ⋅_D a_D[F r, F f, F w] ⋅_D
                         (D.inv (Φ (r, f)) ⋆_D F w) ⋅_D D.inv (Φ (r ⋆_C f, w))"
                    using w preserves_assoc(1) hseq_fw by force
                  moreover have
                    "F (ρ ⋆_C w) = Φ (r ⋆_C f, w) ⋅_D (F ρ ⋆_D F w) ⋅_D D.inv (Φ (g, w))"
                    using w preserves_hcomp hseq_fw by fastforce
                  ultimately show ?thesis
                    using D.comp_assoc by simp
                qed
                also have "... = (F r ⋆_D F θ) ⋅_D (F r ⋆_D Φ (f, w)) ⋅_D a_D[F r, F f, F w] ⋅_D
                                   (D.inv (Φ (r, f)) ⋆_D F w) ⋅_D (F ρ ⋆_D F w)"
                proof -
                  have "(D.inv (Φ (r, u)) ⋅_D Φ (r, u)) ⋅_D (F r ⋆_D F θ) = F r ⋆_D F θ"
                    using θ D.comp_cod_arr hseq_ru D.comp_inv_arr' by auto
                  moreover have
                    "(D.inv (Φ (r, f ⋆_C w)) ⋅_D Φ (r, f ⋆_C w)) ⋅_D (F r ⋆_D Φ (f, w)) =
                     F r ⋆_D Φ (f, w)"
                    using w cmp_components_are_iso D.comp_cod_arr C.hseqI' D.hseqI'
                          C.in_hhom_def C.trg_hcomp D.comp_inv_arr' C.ide_hcomp
                    by (metis C.ideD(1) D.hcomp_simps(4) cmp_simps(1) cmp_simps(3-5)
                        ρ'.leg0_simps(3) ρ'.base_simps(2,4) ρ.ide_leg0 ρ.ide_base
                        ρ.leg0_simps(3) hseq_fw)
                  moreover have "(D.inv (Φ (r ⋆_C f, w)) ⋅_D Φ (r ⋆_C f, w)) ⋅_D (F ρ ⋆_D F w) =
                                 F ρ ⋆_D F w"
                    using w D.comp_inv_arr' D.comp_cod_arr hseq_fw by simp
                  moreover have "(F ρ ⋆_D F w) ⋅_D D.inv (Φ (g, w)) ⋅_D Φ (g, w) = F ρ ⋆_D F w"
                    using w θ D.comp_arr_dom D.comp_inv_arr' hseq_gw by simp
                  ultimately show ?thesis
                    using D.comp_assoc by simp
                qed
                also have "... = ρ'.composite_cell (F w) (F θ ⋅_D Φ (f, w))"
                  using w θ 1 D.whisker_left D.whisker_right D.comp_assoc by auto
                finally show ?thesis by simp
              qed
              ultimately show ?thesis
                using w w' θ θ' β eq
                      ρ'.T2 [of "F w" "F w'" "F θ ⋅_D Φ (f, w)" "F u" "F θ' ⋅_D Φ (f, w')"
                                "D.inv (Φ (g, w')) ⋅_D F β ⋅_D Φ (g, w)"]
                by blast
            qed

            obtain γ' where γ': "«γ' : F w →_D F w'¬ ∧
                                 D.inv (Φ (g, w')) ⋅_D F β ⋅_D Φ (g, w) = F g ⋆_D γ' ∧
                                 F θ ⋅_D Φ (f, w) = (F θ' ⋅_D Φ (f, w')) ⋅_D (F f ⋆_D γ')"
              using * by auto
            obtain γ where γ: "«γ : w →_C w'¬ ∧ F γ = γ'"
              using θ θ w w' γ' locally_full [of w w' γ']
              by (metis C.hseqI' C.ideD(1) C.src_hcomp C.vconn_implies_hpar(3)
                  ρ.leg0_simps(2) θ' hseq_fw)
            have "θ = θ' ⋅_C (f ⋆_C γ)"
            proof -
              have "F θ = F (θ' ⋅_C (f ⋆_C γ))"
              proof -
                have "F θ = F θ' ⋅_D Φ (f, w') ⋅_D (F f ⋆_D γ') ⋅_D D.inv (Φ (f, w))"
                  using w' θ' γ' preserves_hcomp hseq_fw D.comp_assoc D.invert_side_of_triangle
                  by (metis C.in_homE D.comp_arr_inv' cmp_components_are_iso cmp_simps(5)
                      ρ.ide_leg0 θ as_nat_trans.naturality1 w)
                also have "... = F θ' ⋅_D F (f ⋆_C γ)"
                  using w' D.comp_assoc hseq_fw preserves_hcomp cmp_components_are_iso
                        D.comp_arr_inv'
                  by (metis C.hseqI' C.in_homE C.trg_cod γ ρ.leg0_in_hom(2))
                also have "... = F (θ' ⋅_C (f ⋆_C γ))"
                  using γ θ θ' hseq_fw C.hseqI' preserves_comp by force
                finally show ?thesis by simp
              qed
              moreover have "C.par θ (θ' ⋅_C (f ⋆_C γ))"
                using γ θ θ' hseq_fw by fastforce
              ultimately show ?thesis
                using is_faithful by blast
            qed
            moreover have "β = g ⋆_C γ"
            proof -
              have "F β = F (g ⋆_C γ)"
              proof -
                have "F β = Φ (g, w') ⋅_D (F g ⋆_D γ') ⋅_D D.inv (Φ (g, w))"
                  by (metis (no_types) C.in_homE D.comp_arr_inv' D.comp_assoc
                      cmp_components_are_iso cmp_simps(5) β γ' ρ.ide_leg1 hseq_gw
                      as_nat_trans.naturality1 as_nat_trans.naturality w w')
                also have "... = F (g ⋆_C γ)"
                  using w γ γ' preserves_hcomp hseq_gw
                  by (metis C.hseqE C.hseqI' C.in_homE C.seqE ‹θ = θ' ⋅_C (f ⋆_C γ)›
                      ρ.leg1_simps(2) ρ.leg1_simps(5) ρ.leg1_simps(6) θ hseq_fw)
                finally show ?thesis by simp
              qed
              moreover have "C.par β (g ⋆_C γ)"
              proof (intro conjI)
                show "C.arr β"
                  using β by blast
                show 1: "C.hseq g γ"
                  using γ hseq_gw by fastforce
                show "C.dom β = C.dom (g ⋆_C γ)"
                  using γ β 1 by fastforce
                show "C.cod β = C.cod (g ⋆_C γ)"
                  using γ β 1 by fastforce
              qed
              ultimately show ?thesis
                using is_faithful by blast
            qed
            ultimately have "∃γ. «γ : w →_C w'¬ ∧ β = g ⋆_C γ ∧ θ = θ' ⋅_C (f ⋆_C γ)"
              using γ by blast
            moreover have "∧γ₁ γ₂. «γ₁ : w →_C w'¬ ∧ β = g ⋆_C γ₁ ∧ θ = θ' ⋅_C (f ⋆_C γ₁) ==>
                                   «γ₂ : w →_C w'¬ ∧ β = g ⋆_C γ₂ ∧ θ = θ' ⋅_C (f ⋆_C γ₂) ==> γ₁ = γ₂"
            proof -
              fix γ₁ γ₂
              assume γ₁: "«γ₁ : w →_C w'¬ ∧ β = g ⋆_C γ₁ ∧ θ = θ' ⋅_C (f ⋆_C γ₁)"
              assume γ₂: "«γ₂ : w →_C w'¬ ∧ β = g ⋆_C γ₂ ∧ θ = θ' ⋅_C (f ⋆_C γ₂)"
              have Fβ₁: "F β = Φ (g, w') ⋅_D (F g ⋆_D F γ₁) ⋅_D D.inv (Φ (g, w))"
                using w w' β hseq_gw γ₁ preserves_hcomp [of g γ₁] cmp_components_are_iso
                by auto
              have Fβ₂: "F β = Φ (g, w') ⋅_D (F g ⋆_D F γ₂) ⋅_D D.inv (Φ (g, w))"
                using w w' β hseq_gw γ₂ preserves_hcomp [of g γ₂] cmp_components_are_iso
                by auto
              have "D.inv (Φ (g, w')) ⋅_D F β ⋅_D Φ (g, w) = F g ⋆_D F γ₁"
              proof -
                have "F β ⋅_D Φ (g, w) = Φ (g, w') ⋅_D (F g ⋆_D F γ₁)"
                  using w w' β hseq_gw γ₁ Fβ₁ preserves_hcomp cmp_components_are_iso
                        D.invert_side_of_triangle D.iso_inv_iso
                  by (metis C.arrI D.comp_assoc D.inv_inv ρ.ide_leg1 preserves_reflects_arr)
                thus ?thesis
                  using w w' β hseq_gw γ₁ preserves_hcomp cmp_components_are_iso
                        D.invert_side_of_triangle
                  by (metis C.arrI D.cod_comp D.seqE D.seqI Fβ₁ ρ.ide_leg1 preserves_arr)
              qed
              moreover have "D.inv (Φ (g, w')) ⋅_D F β ⋅_D Φ (g, w) = F g ⋆_D F γ₂"
              proof -
                have "F β ⋅_D Φ (g, w) = Φ (g, w') ⋅_D (F g ⋆_D F γ₂)"
                  using w w' β hseq_gw γ₂ Fβ₂ preserves_hcomp cmp_components_are_iso
                        D.invert_side_of_triangle D.iso_inv_iso
                  by (metis C.arrI D.comp_assoc D.inv_inv ρ.ide_leg1 preserves_reflects_arr)
                thus ?thesis
                  using w w' β hseq_gw γ₂ preserves_hcomp cmp_components_are_iso
                        D.invert_side_of_triangle
                  by (metis C.arrI D.cod_comp D.seqE D.seqI Fβ₂ ρ.ide_leg1 preserves_arr)
              qed
              moreover have "F θ ⋅_D Φ (f, w) = (F θ' ⋅_D Φ (f, w')) ⋅_D (F f ⋆_D F γ₁)"
              proof -
                have "F θ ⋅_D Φ (f, w) = F (θ' ⋅_C (f ⋆_C γ₁)) ⋅_D Φ (f, w)"
                  using γ₁ by blast
                also have "... = (F θ' ⋅_D F (f ⋆_C γ₁)) ⋅_D Φ (f, w)"
                  using γ₁ θ by auto
                also have
                  "... = (F θ' ⋅_D Φ (f, w') ⋅_D (F f ⋆_D F γ₁) ⋅_D D.inv (Φ (f, w))) ⋅_D Φ (f, w)"
                  using γ₁ hseq_fw preserves_hcomp by auto
                also have
                  "... = F θ' ⋅_D Φ (f, w') ⋅_D (F f ⋆_D F γ₁) ⋅_D D.inv (Φ (f, w)) ⋅_D Φ (f, w)"
                  using D.comp_assoc by simp
                also have "... = F θ' ⋅_D Φ (f, w') ⋅_D (F f ⋆_D F γ₁) ⋅_D (F f ⋆_D F w)"
                  by (simp add: D.comp_inv_arr' hseq_fw w)
                also have "... = F θ' ⋅_D Φ (f, w') ⋅_D (F f ⋆_D F γ₁)"
                  using w γ₁ D.whisker_left [of "F f" "F γ₁" "F w"] D.comp_arr_dom by auto
                finally show ?thesis
                  using D.comp_assoc by simp
              qed
              moreover have "F θ ⋅_D Φ (f, w) = (F θ' ⋅_D Φ (f, w')) ⋅_D (F f ⋆_D F γ₂)"
              proof -
                have "F θ ⋅_D Φ (f, w) = F (θ' ⋅_C (f ⋆_C γ₂)) ⋅_D Φ (f, w)"
                  using γ₂ by blast
                also have "... = (F θ' ⋅_D F (f ⋆_C γ₂)) ⋅_D Φ (f, w)"
                  using γ₂ θ by auto
                also have
                  "... = (F θ' ⋅_D Φ (f, w') ⋅_D (F f ⋆_D F γ₂) ⋅_D D.inv (Φ (f, w))) ⋅_D Φ (f, w)"
                  using γ₂ hseq_fw preserves_hcomp by auto
                also have
                  "... = F θ' ⋅_D Φ (f, w') ⋅_D (F f ⋆_D F γ₂) ⋅_D D.inv (Φ (f, w)) ⋅_D Φ (f, w)"
                  using D.comp_assoc by simp
                also have "... = F θ' ⋅_D Φ (f, w') ⋅_D (F f ⋆_D F γ₂) ⋅_D (F f ⋆_D F w)"
                  by (simp add: D.comp_inv_arr' hseq_fw w)
                also have "... = F θ' ⋅_D Φ (f, w') ⋅_D (F f ⋆_D F γ₂)"
                  using w γ₂ D.whisker_left [of "F f" "F γ₂" "F w"] D.comp_arr_dom by auto
                finally show ?thesis
                  using D.comp_assoc by simp
              qed
              ultimately have "F γ₁ = F γ₂"
                using γ₁ γ₂ * by blast
              thus "γ₁ = γ₂"
                using γ₁ γ₂ is_faithful [of γ₁ γ₂] by auto
            qed
            ultimately show "∃!γ. «γ : w →_C w'¬ ∧ β = g ⋆_C γ ∧ θ = θ' ⋅_C (f ⋆_C γ)"
              by blast
          qed
        qed
      qed
      show ?thesis ..
    qed

  end

end