| Quellcodebibliothek Statistik Leitseite products/Sources/formale Sprachen/Isabelle/Archive-of-Formal-Proofs/thys/Bicategory/ (Sammlung formaler Beweise Version 2026-5©) Datei vom 29.4.2026 mit Größe 486 kB |
|
Quellcode-Bibliothek Tabulation.thySprache: Isabelle |
|||||||||||||||
|
(* 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 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 proper 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 rel One can find motivation for the concept of tabulation by considering the problem trying to find some kind of universal way of factoring a 1-cell ‹r›, up to isomo 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 tabu and establishes some basic facts. $\xymatrix{ & \scriptstyle{{\rm src}~g \;=\;{\rm src}~f} \xtwocel \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 obta 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 i 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, ρ where the ``input leg'' ‹f› is a map, and assumes only a weak form of the biuniv property that only applies to ‹(u, ψ, v)› for which u is a map. The second notion, which they call ``wide tabulation'', concerns arbitrary ‹(f, ρ and assumes a strong form of the biuniversal property that applies to all ‹(u, ψ, On its face, neither notion implies the other: ``tabulation'' has the stronger a that ‹f› is a map, but requires a weaker biuniversal property, and ``wide tabula 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 ti 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 desirable to have axioms that involve a weaker biuniversal property rather than However I am more interested in ``wide tabulation'', as it is in some sense the and since I have had to establish various kinds of preservation results that I d to repeat for both tabulation and wide tabulation, I am using wide tabulation ev calling it simply ``tabulation''. The fact that the ``input leg'' of a tabulati be a map is an essential ingredient throughout. I have attempted to follow CKS variable naming conventions as much as possible i development to avoid confusion when comparing with their paper, even though thes 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} \xtwocel \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]{}\omi \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* ==> 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>*) 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 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>*\<guillemot (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 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\<guillemo 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> 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 using T0.antipar(1-2) by auto show "\<guillemotleft>r \<star> \<epsilon> : r \<star> f \<star> f\<^sup>* \<Rightarrow> r \<star> src r\<guill 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\<epsilon> r ρ ⋆ f) ⋅ T0.trnr\<eta> 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 tabulat › 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 axi 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 › 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 pro 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 fa ε ν where fa: "ide fa ∧ «ε : f ⋆ fa ==> src r¬ ∧ «ν : r ==> g ⋆ fa¬ ∧ iso ν ∧ composite_cell fa ε ⋅ ν = r-1[r]" using T1 [of "src r" "r-1[r]"] runit'_in_hom [of r] ide_base comp_assoc by auto have fa': "composite_cell fa ε ⋅ ν = r-1[r]" using fa by simp have fa: "ide fa ∧ «ε : f ⋆ fa ==> src r¬ ∧ «ν : r ==> g ⋆ fa¬ ∧ iso ν" using fa by simp have 1: "src fa = trg f" using fa fa' comp_assoc by (metis ide_base leg0_simps(3) runit'_simps(1) seqE src_hcomp vconn_implies_hp vseq_implies_hpar(1)) have 2: "trg fa = src g" using fa by force have ε: "«ε : f ⋆ fa ==> trg f¬ ∧ «ε : trg f → trg f¬ ∧ arr ε ∧ src ε = trg f ∧ trg ε = trg f ∧ dom ε = f ⋆ fa ∧ cod ε = trg f" using fa 1 2 by (metis in_hhomI in_homE leg0_simps(3) src_src trg_src vconn_implies_hpar(1-4) have ν: "«ν : r ==> g ⋆ fa¬ ∧ «ν : trg f → trg g¬ ∧ arr ν ∧ src ν = trg f ∧ trg ν = trg g ∧ dom ν = r ∧ cod ν = g ⋆ fa" using fa by force text ‹ Next, CKS say to apply ‹T2› with ‹w = trg fa = src f›, ‹w' = fa ⋆ 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 fa ==> f¬› and ‹«θ' : f ⋆ fa ⋆ f ==> f¬›. Evidently, we may take ‹θ = ρ[f]› and ‹θ' = l[f] ⋅ (ε ⋆ f) ⋅ a-1[f, fa, f]›. What should be taken for ‹β›? Reconstructing this is a little bit more difficult ‹T2› requires ‹«β : g ⋆ w ==> g ⋆ w'¬›, hence ‹«β : g ⋆ trg fa ==> g ⋆ fa ⋆ f¬›. We have the isomorphism ‹«ν : r ==> g ⋆ fa¬› from ‹T1›. Also ‹«ρ : g ==> r ⋆ f¬›. So ‹«a[g, fa, f] ⋅ (ν ⋆ f) ⋅ ρ ⋅ r[g] : g ⋆ trg fa ==> g ⋆ fa ⋆ f¬›, suggesting that we take ‹β = a[g, fa, f] ⋅ (ν ⋆ f) ⋅ ρ ⋅ r[g]›. Now, to apply ‹T2› we need to satisfy the equation: \[ ‹(r ⋆ θ) ⋅ a[r, f, trg fa] ⋅ (ρ ⋆ trg fa ) = (r ⋆ θ') ⋅ a[r, f, fa ⋆ f] ⋅ (ρ ⋆ fa ⋆ f) ⋅ β›; \] that is, with our choice of ‹θ›, ‹θ'›, and ‹β›: ‹(r ⋆ r[f]) ⋅ a[r, f, trg fa] ⋅ (ρ ⋆ trg fa ) = (r ⋆ l[f] ⋅ (ε ⋆ f) ⋅ a-1[f, fa, f]) ⋅ a[r, f, fa ⋆ f] ⋅ (ρ ⋅ (fa ⋆ f)) ⋅ a[g, fa, 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 fa = 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, fa] ⋅ (ρ ⋆ fa ) ⋅ ν›. \] After some pondering, I realized that to apply this to the right-hand side of th equation to be shown requires that we re-associate everything to the left, so that f stands alone on the right. › let ?β = "a[g, fa, f] ⋅ (ν ⋆ f) ⋅ ρ ⋅ r[g]" let ?θ = "r[f]" let ?θ' = "l[f] ⋅ (ε ⋆ f) ⋅ a-1[f, fa, f]" have β: "«?β : g ⋆ src g ==> g ⋆ fa ⋆ f¬ ∧ «?β : src f → trg g¬ ∧ src ?β = src g ∧ trg ?β = trg g ∧ dom ?β = g ⋆ src g ∧ cod ?β = g ⋆ fa ⋆ f" proof - have 3: "«?β : g ⋆ src g ==> g ⋆ fa ⋆ f¬" using fa 1 2 by fastforce moreover have "«?β : src f → trg g¬" using 1 2 3 fa by auto ultimately show ?thesis by (auto simp add: in_hhom_def) qed have θ': "«?θ' : f ⋆ fa ⋆ f ==> f¬" using fa 1 2 ε by fastforce have A: "composite_cell (trg fa) r[f] = composite_cell (fa ⋆ f) ?θ' ⋅ ?β" proof - have "composite_cell (trg fa) r[f] = ρ ⋅ r[g]" using 2 runit_hcomp runit_naturality [of ρ] comp_assoc by simp also have "... = composite_cell (fa ⋆ f) ?θ' ⋅ ?β" proof - have "composite_cell (fa ⋆ f) ?θ' ⋅ ?β = (composite_cell (fa ⋆ f) ?θ' ⋅ a[g, fa, f]) ⋅ (ν ⋆ f) ⋅ ρ ⋅ r[g]" using comp_assoc by simp also have "... = ρ ⋅ r[g]" proof - have "(composite_cell (fa ⋆ f) ?θ' ⋅ a[g, fa, f]) ⋅ (ν ⋆ f) = r ⋆ f" proof - have "(composite_cell (fa ⋆ f) ?θ' ⋅ a[g, fa, f]) ⋅ (ν ⋆ f) = r[r] ⋅ (r ⋆ ε) ⋅ a[r, f, fa] ⋅ (ρ ⋆ fa) ⋅ ν ⋆ f" proof - have "(composite_cell (fa ⋆ f) ?θ' ⋅ a[g, fa, f]) ⋅ (ν ⋆ f) = (r ⋆ l[f]) ⋅ (r ⋆ ε ⋆ f) ⋅ composite_cell (fa ⋆ f) a-1[f, fa, f] ⋅ (a[g, fa, f] ⋅ (ν ⋆ f))" using fa 1 2 ε whisker_left comp_assoc by auto also have "... = (r[r] ⋆ f) ⋅ a-1[r, src r, f] ⋅ (r ⋆ ε ⋆ f) ⋅ composite_cell (fa ⋆ f) a-1[f, fa, f] ⋅ (a[g, fa, f] ⋅ (ν ⋆ f))" using fa 1 2 comp_assoc by (simp add: triangle') also have "... = (r[r] ⋆ f) ⋅ ((r ⋆ ε) ⋆ f) ⋅ a-1[r, f ⋆ fa, f] ⋅ composite_cell (fa ⋆ f) a-1[f, fa, f] ⋅ (a[g, fa, f] ⋅ (ν ⋆ f))" proof - have "a-1[r, src r, f] ⋅ (r ⋆ ε ⋆ f) = ((r ⋆ ε) ⋆ f) ⋅ a-1[r, f ⋆ fa, f]" using fa ε 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, fa] ⋆ f) ⋅ a-1[r ⋆ f, fa, f] ⋅ (ρ ⋆ fa ⋆ f) ⋅ a[g, fa, f] ⋅ (ν ⋆ f)" proof - have "(r[r] ⋆ f) ⋅ ((r ⋆ ε) ⋆ f) ⋅ a-1[r, f ⋆ fa, f] ⋅ composite_cell (fa ⋆ f) a-1[f, fa, f] ⋅ (a[g, fa, f] ⋅ (ν ⋆ f)) = (r[r] ⋆ f) ⋅ ((r ⋆ ε) ⋆ f) ⋅ (a-1[r, f ⋆ fa, f] ⋅ (r ⋆ a-1[f, fa, f]) ⋅ a[r, f, fa ⋆ f]) ⋅ (ρ ⋆ fa ⋆ f) ⋅ a[g, fa, f] ⋅ (ν ⋆ f)" by (simp add: comp_assoc) also have "... = (r[r] ⋆ f) ⋅ ((r ⋆ ε) ⋆ f) ⋅ ((a[r, f, fa] ⋆ f) ⋅ a-1[r ⋆ f, fa, f]) ⋅ (ρ ⋆ fa ⋆ f) ⋅ a[g, fa, f] ⋅ (ν ⋆ f)" proof - have "a-1[r, f ⋆ fa, f] ⋅ (r ⋆ a-1[f, fa, f]) ⋅ a[r, f, fa ⋆ f] = (a[r, f, fa] ⋆ f) ⋅ a-1[r ⋆ f, fa, f]" proof - (* No need to calculate manually, apply the coherence theorem. *) have "a-1[r, f ⋆ fa, f] ⋅ (r ⋆ a-1[f, fa, f]) ⋅ a[r, f, fa ⋆ f] = {\<a>-1[\<langle>r\<rangle>, \<langle>f\<rangle> \<star> \<langle>fa\<rangle>, \<langle>f\<rangle>] \<cdot> \<a>[\<langle>r\<rangle>, \<langle>f\<rangle>, \<langle>fa\<rangle> \<star> \<langle>f\<rangle>]}" using fa 1 2 a'_def α_def assoc'_eq_inv_assoc by auto also have "... = {(\<a>[\<langle>r\<rangle>, \<langle>f\<rangle>, \<langle>fa\<rangle>] \<star> \<langl using fa 1 2 by (intro E.eval_eqI, auto) also have "... = (a[r, f, fa] ⋆ f) ⋅ a-1[r ⋆ f, fa, f]" using fa 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, fa] ⋆ f) ⋅ a-1[r ⋆ f, fa, f] ⋅ (ρ ⋆ fa ⋆ f) ⋅ a[g, fa, f] ⋅ (ν ⋆ f)" by (simp add: comp_assoc) finally show ?thesis by blast qed also have "... = (r[r] ⋆ f) ⋅ ((r ⋆ ε) ⋆ f) ⋅ (a[r, f, fa] ⋆ f) ⋅ ((ρ ⋆ fa) ⋆ f) ⋅ a-1[g, fa, f] ⋅ a[g, fa, f] ⋅ (ν ⋆ f)" proof - have "a-1[r ⋆ f, fa, f] ⋅ (ρ ⋆ fa ⋆ f) = ((ρ ⋆ fa) ⋆ f) ⋅ a-1[g, fa, f]" using fa 1 2 assoc'_naturality [of ρ fa f] by auto thus ?thesis by (metis comp_assoc) qed also have "... = (r[r] ⋆ f) ⋅ ((r ⋆ ε) ⋆ f) ⋅ (a[r, f, fa] ⋆ f) ⋅ ((ρ ⋆ fa) ⋆ f) ⋅ (ν ⋆ f)" proof - have "a-1[g, fa, f] ⋅ a[g, fa, f] = (g ⋆ fa) ⋆ f" using fa 1 2 comp_assoc_assoc' by auto moreover have "((g ⋆ fa) ⋆ 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, fa] ⋅ (ρ ⋆ fa) ⋅ ν) ⋆ f" proof - have "arr (r[r] ⋅ (r ⋆ ε) ⋅ a[r, f, fa] ⋅ (ρ ⋆ fa) ⋅ ν)" using fa' 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 fa' 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 fa ==> fa ⋆ f¬ ∧ ?β = g ⋆ η ∧ (l[f] ⋅ (ε ⋆ f) ⋅ a-1[f, fa, f]) ⋅ (f ⋆ η) = r[f]" using β θ' A 1 2 fa runit_in_hom ide_leg0 ide_hcomp src.preserves_ide T2 [of "trg fa" "fa ⋆ f" "r[f]" f "l[f] ⋅ (ε ⋆ f) ⋅ a-1[f, fa, f]" ?β] comp_assoc leg1_simps(3) by metis have η': "?β = g ⋆ η ∧ (l[f] ⋅ (ε ⋆ f) ⋅ a-1[f, fa, f]) ⋅ (f ⋆ η) = r[f]" using η by simp have η: "«η : trg fa ==> fa ⋆ f¬ ∧ «η : src f → src f¬ ∧ arr η ∧ src η = src f ∧ trg η = src f ∧ dom η = trg fa ∧ cod η = fa ⋆ f" using η β 2 by force have "adjunction_in_bicategory V H a i src trg f fa η ε" proof show "ide f" using ide_leg0 by simp show "ide fa" using fa by blast show η_in_hom: "«η : src f ==> fa ⋆ f¬" using η 2 by simp show ε_in_hom: "«ε : f ⋆ fa ==> src fa¬" using fa 1 by simp show *: "(ε ⋆ f) ⋅ a-1[f, fa, 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 ⋆ fa›,\\ ‹θ = (ε ⋆ ε) ⋅ a-1[f, fa, f ⋆ fa] ⋅ (f ⋆ a[fa, f, fa]) ⋅ (f ⋆ η ⋆ fa)›,\\ ‹w' = fa ⋆ trg›,\\ ‹θ' = ε ⋆ trg f›,\\ ‹β = g ⋆ r-1[fa] ⋅ l[fa]› \end{array}\] Then the conditions for ‹γ› are satisfied by both ‹r-1[fa] ⋅ l[fa]› and ‹(fa ⋆ ε) ⋅ a[fa, f, fa] ⋅ (η ⋆ fa)› so they are equal, as required. › show "(fa ⋆ ε) ⋅ a[fa, f, fa] ⋅ (η ⋆ fa) = r-1[fa] ⋅ l[fa]" proof - let ?u = "trg f ⋆ trg f" let ?w = "src f ⋆ fa" let ?w' = "fa ⋆ trg f" let ?θ = "(ε ⋆ ε) ⋅ a-1[f, fa, f ⋆ fa] ⋅ (f ⋆ a[fa, f, fa]) ⋅ (f ⋆ η ⋆ fa)" let ?θ' = "(ε ⋆ trg f) ⋅ a-1[f, fa, trg f]" let ?β = "g ⋆ r-1[fa] ⋅ l[fa]" let ?γ = "r-1[fa] ⋅ l[fa]" let ?γ' = "(fa ⋆ ε) ⋅ a[fa, f, fa] ⋅ (η ⋆ fa)" have θ_eq': "?θ = (trg f ⋆ ε) ⋅ a[trg f, f, fa] ⋅ (l-1[f] ⋅ r[f] ⋆ fa) ⋅ a-1[f, src f, fa]" proof - have "?θ = (trg f ⋆ ε) ⋅ (ε ⋆ f ⋆ fa) ⋅ (a-1[f, fa, f ⋆ fa] ⋅ (f ⋆ a[fa, f, fa])) ⋅ (f ⋆ η ⋆ fa)" using interchange [of "trg f" ε ε "f ⋆ fa"] comp_arr_dom comp_cod_arr comp_assoc by (simp add: ε) also have "... = (trg f ⋆ ε) ⋅ (ε ⋆ f ⋆ fa) ⋅ (a[f ⋆ fa, f, fa] ⋅ (a-1[f, fa, f] ⋆ fa) ⋅ a-1[f, fa ⋆ f, fa]) ⋅ (f ⋆ η ⋆ fa)" proof - have "a-1[f, fa, f ⋆ fa] ⋅ (f ⋆ a[fa, f, fa]) = a[f ⋆ fa, f, fa] ⋅ (a-1[f, fa, f] ⋆ fa) ⋅ a-1[f, fa ⋆ f, fa]" proof - have "(a[f ⋆ fa, f, fa] ⋅ ((a-1[f, fa, f] ⋆ fa) ⋅ a-1[f, fa ⋆ f, fa])) ⋅ (f ⋆ a-1[fa, f, fa]) = a-1[f, fa, f ⋆ fa]" using 1 2 ‹ide fa› ide_leg0 iso_assoc invert_side_of_triangle(1) [of "((a-1[f, fa, f] ⋆ fa) ⋅ a-1[f, fa ⋆ f, fa]) ⋅ (f ⋆ a-1[fa, f, fa])" "a-1[f ⋆ fa, f, fa]" "a-1[f, fa, f ⋆ fa]"] pentagon' comp_assoc by auto hence "(a[f ⋆ fa, f, fa] ⋅ ((a-1[f, fa, f] ⋆ fa) ⋅ a-1[f, fa ⋆ f, fa])) = a-1[f, fa, f ⋆ fa] ⋅ (f ⋆ a[fa, f, fa])" using 1 2 ‹ide fa› invert_side_of_triangle(2) [of "a-1[f, fa, f ⋆ fa]" "a[f ⋆ fa, f, fa] ⋅ ((a-1[f, fa, f] ⋆ fa) ⋅ a-1[f, fa ⋆ f, fa])" "f ⋆ a-1[fa, f, fa]"] by auto thus ?thesis using comp_assoc by simp qed thus ?thesis by simp qed also have "... = (trg f ⋆ ε) ⋅ ((ε ⋆ f ⋆ fa) ⋅ a[f ⋆ fa, f, fa]) ⋅ (a-1[f, fa, f] ⋆ fa) ⋅ a-1[f, fa ⋆ f, fa] ⋅ (f ⋆ η ⋆ fa)" using comp_assoc by simp also have "... = (trg f ⋆ ε) ⋅ a[trg f, f, fa] ⋅ ((ε ⋆ f) ⋅ a-1[f, fa, f] ⋅ (f ⋆ η) ⋆ fa) ⋅ a-1[f, src f, fa]" proof - have "((ε ⋆ f ⋆ fa) ⋅ a[f ⋆ fa, f, fa] ⋅ (a-1[f, fa, f] ⋆ fa) ⋅ a-1[f, fa ⋆ f, fa]) ⋅ (f ⋆ η ⋆ fa) = (a[trg f, f, fa] ⋅ ((ε ⋆ f) ⋆ fa)) ⋅ (a-1[f, fa, f] ⋆ fa) ⋅ ((f ⋆ η) ⋆ fa) ⋅ a-1[f, src f, fa]" using assoc_naturality [of ε f fa] assoc'_naturality [of f η fa] by (simp add: 2 ε η ‹ide fa› comp_assoc) also have "... = a[trg f, f, fa] ⋅ (((ε ⋆ f) ⋆ fa) ⋅ (a-1[f, fa, f] ⋆ fa) ⋅ ((f ⋆ η) ⋆ fa)) ⋅ a-1[f, src f, fa]" using comp_assoc by simp also have "... = a[trg f, f, fa] ⋅ ((ε ⋆ f) ⋅ a-1[f, fa, f] ⋅ (f ⋆ η) ⋆ fa) ⋅ a-1[f, src f, fa]" using η' comp_assoc whisker_right ‹ide fa› 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, fa] ⋅ (l-1[f] ⋅ r[f] ⋆ fa) ⋅ a-1[f, src f, fa]" using * by simp finally show ?thesis by simp qed have θ_eq: "?θ = (ε ⋆ trg f) ⋅ a-1[f, fa, src fa] ⋅ (f ⋆ ?γ)" proof - have "?θ = (trg f ⋆ ε) ⋅ a[trg f, f, fa] ⋅ (l-1[f] ⋅ r[f] ⋆ fa) ⋅ a-1[f, src f, fa]" using θ_eq' by simp also have "... = (trg f ⋆ ε) ⋅ a[trg f, f, fa] ⋅ (l-1[f] ⋆ fa) ⋅ (r[f] ⋆ fa) ⋅ a-1[f, src f, fa]" using ‹ide fa› whisker_right comp_assoc by auto also have "... = (trg f ⋆ ε) ⋅ ((a[trg f, f, fa] ⋅ (a-1[trg f, f, fa]) ⋅ l-1[f ⋆ fa])) ⋅ (f ⋆ l[fa])" using 2 ‹ide fa› lunit_hcomp [of f fa] invert_side_of_triangle(2) triangle' comp_assoc by auto also have "... = (trg f ⋆ ε) ⋅ l-1[f ⋆ fa] ⋅ (f ⋆ l[fa])" using fa 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[fa])" using ε lunit'_naturality comp_assoc by metis also have "... = r-1[trg f] ⋅ ε ⋅ (f ⋆ l[fa])" using unitor_coincidence by simp also have "... = (ε ⋆ trg f) ⋅ r-1[f ⋆ fa] ⋅ (f ⋆ l[fa])" using ε runit'_naturality comp_assoc by metis also have "... = (ε ⋆ trg f) ⋅ a-1[f, fa, src fa] ⋅ (f ⋆ r-1[fa]) ⋅ (f ⋆ l[fa])" using 2 ‹ide fa› runit_hcomp(2) comp_assoc by auto also have "... = (ε ⋆ trg f) ⋅ a-1[f, fa, src fa] ⋅ (f ⋆ ?γ)" using 2 ‹ide fa› whisker_left by simp finally show ?thesis by simp qed have θ: "«?θ : f ⋆ ?w ==> ?u¬" using 1 2 ‹ide fa› η_in_hom ε by fastforce have θ': "«?θ' : f ⋆ ?w' ==> ?u¬" using fa 1 2 ε by auto have ww': "ide ?w ∧ ide ?w'" by (simp add: 1 2 ‹ide fa›) have "∃!γ. «γ : ?w ==> ?w'¬ ∧ ?β = g ⋆ γ ∧ ?θ = ?θ' ⋅ (f ⋆ γ)" proof - have "«?β : g ⋆ ?w ==> g ⋆ ?w'¬" using ‹ide fa› 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, fa, src fa] ⋅ (f ⋆ r-1[fa] ⋅ l[fa]))" proof - have "a[r, f, fa ⋆ trg f] ⋅ (ρ ⋆ fa ⋆ trg f) ⋅ (g ⋆ r-1[fa] ⋅ l[fa]) = composite_cell ?w (f ⋆ r-1[fa] ⋅ l[fa])" proof - have "a[r, f, fa ⋆ trg f] ⋅ (ρ ⋆ fa ⋆ trg f) ⋅ (g ⋆ r-1[fa] ⋅ l[fa]) = (a[r, f, fa ⋆ trg f] ⋅ ((r ⋆ f) ⋆ r-1[fa] ⋅ l[fa])) ⋅ (ρ ⋆ src f ⋆ fa)" proof - have "(ρ ⋆ fa ⋆ trg f) ⋅ (g ⋆ r-1[fa] ⋅ l[fa]) = ρ ⋆ r-1[fa] ⋅ l[fa]" using interchange [of ρ g "fa ⋆ trg f" "r-1[fa] ⋅ l[fa]"] comp_arr_dom comp_cod_arr 1 2 ‹ide fa› by simp also have "... = ((r ⋆ f) ⋆ r-1[fa] ⋅ l[fa]) ⋅ (ρ ⋆ src f ⋆ fa)" proof - have "seq (fa ⋆ trg f) (r-1[fa] ⋅ l[fa])" using fa 1 2 ww' by auto thus ?thesis using interchange comp_arr_dom comp_cod_arr 1 2 ‹ide fa› 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[fa] ⋅ l[fa])" using assoc_naturality [of r f "r-1[fa] ⋅ l[fa]"] 1 2 ‹ide fa› comp_assoc by simp finally show ?thesis by simp qed hence "composite_cell ?w' ?θ' ⋅ ?β = ((r ⋆ (ε ⋆ trg f) ⋅ a-1[f, fa, trg f]) ⋅ (r ⋆ f ⋆ r-1[fa] ⋅ l[fa])) ⋅ a[r, f, src f ⋆ fa] ⋅ (ρ ⋆ src f ⋆ fa)" using comp_assoc by simp also have "... = composite_cell ?w (((ε ⋆ trg f) ⋅ a-1[f, fa, trg f]) ⋅ (f ⋆ r-1[fa] ⋅ l[fa]))" using whisker_left 1 2 ‹ide fa› ide_base by (metis ‹«(ε ⋆ ε) ⋅ a-1[f, fa, f ⋆ fa] ⋅ (f ⋆ a[fa, f, fa]) ⋅ (f ⋆ η ⋆ fa) : f ⋆ src f ⋆ fa ==> 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 fa› θ_eq comp_assoc by auto moreover have "«?γ' : ?w ==> ?w'¬ ∧ ?β = g ⋆ ?γ' ∧ ?θ = ?θ' ⋅ (f ⋆ ?γ')" proof (intro conjI) show "«?γ' : ?w ==> ?w'¬" using 1 2 fa η_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 ⋆ η ⋆ fa› by a 2-cell involving ‹ε›, ‹ρ›, and ‹ν›. Use the property ‹(r ⋆ ε) ⋅ (ρ ⋆ fa) ⋅ ν = 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[fa] ⋅ l[fa]›. › proof - have "g ⋆ ?γ' = (g ⋆ fa ⋆ ε) ⋅ (g ⋆ a[fa, f, fa]) ⋅ (g ⋆ η ⋆ fa)" using 1 2 ‹ide fa› ε η whisker_left by (metis ‹«?γ' : ?w ==> ?w'¬› arrI ide_leg1 seqE) also have "... = (g ⋆ fa ⋆ ε) ⋅ (g ⋆ a[fa, f, fa]) ⋅ (g ⋆ η ⋆ fa) ⋅ a[g, src f, fa] ⋅ a-1[g, src f, fa]" using 1 2 ‹ide fa› η comp_arr_dom hseq_char comp_assoc_assoc' by simp also have "... = (g ⋆ fa ⋆ ε) ⋅ (g ⋆ a[fa, f, fa]) ⋅ ((g ⋆ η ⋆ fa) ⋅ a[g, src f, fa]) ⋅ a-1[g, src f, fa]" using comp_assoc by simp also have "... = (g ⋆ fa ⋆ ε) ⋅ (g ⋆ a[fa, f, fa]) ⋅ (a[g, fa ⋆ f, fa] ⋅ ((g ⋆ η) ⋆ fa)) ⋅ a-1[g, src f, fa]" using 1 2 ‹ide fa› ε η assoc_naturality [of g η fa] by simp also have "... = (g ⋆ fa ⋆ ε) ⋅ (g ⋆ a[fa, f, fa]) ⋅ a[g, fa ⋆ f, fa] ⋅ (a[g, fa, f] ⋅ (ν ⋆ f) ⋅ ρ ⋅ r[g] ⋆ fa) ⋅ a-1[g, src f, fa]" using η' comp_assoc by simp also have "... = (g ⋆ fa ⋆ ε) ⋅ ((g ⋆ a[fa, f, fa]) ⋅ a[g, fa ⋆ f, fa] ⋅ (a[g, fa, f] ⋆ fa)) ⋅ ((ν ⋆ f) ⋆ fa) ⋅ (ρ ⋆ fa) ⋅ (r[g] ⋆ fa) ⋅ a-1[g, src f, fa]" proof - have "a[g, fa, f] ⋅ (ν ⋆ f) ⋅ ρ ⋅ r[g] ⋆ fa = (a[g, fa, f] ⋆ fa) ⋅ ((ν ⋆ f) ⋆ fa) ⋅ (ρ ⋆ fa) ⋅ (r[g] ⋆ fa)" using 1 2 ‹ide fa› β ε η whisker_right by (metis arrI seqE) thus ?thesis using comp_assoc by simp qed also have "... = ((g ⋆ fa ⋆ ε) ⋅ a[g, fa, f ⋆ fa]) ⋅ (a[g ⋆ fa, f, fa] ⋅ ((ν ⋆ f) ⋆ fa)) ⋅ (ρ ⋆ fa) ⋅ (r[g] ⋆ fa) ⋅ a-1[g, src f, fa]" using 1 2 ‹ide fa› pentagon comp_assoc by simp also have "... = (a[g, fa, trg f] ⋅ ((g ⋆ fa) ⋆ ε)) ⋅ ((ν ⋆ f ⋆ fa) ⋅ a[r, f, fa]) ⋅ (ρ ⋆ fa) ⋅ (r[g] ⋆ fa) ⋅ a-1[g, src f, fa]" using 1 2 ‹ide fa› assoc_naturality [of g fa ε] assoc_naturality [of ν f fa] by (simp add: ε ν) also have "... = a[g, fa, trg f] ⋅ (((g ⋆ fa) ⋆ ε) ⋅ (ν ⋆ f ⋆ fa)) ⋅ a[r, f, fa] ⋅ (ρ ⋆ fa) ⋅ (r[g] ⋆ fa) ⋅ a-1[g, src f, fa]" using 1 2 ‹ide fa› assoc_naturality [of g fa ε] assoc_naturality [of ν f fa] comp_assoc by simp also have "... = a[g, fa, trg f] ⋅ (ν ⋆ trg f) ⋅ composite_cell fa ε ⋅ (r[g] ⋆ fa) ⋅ a-1[g, src f, fa]" proof - have "((g ⋆ fa) ⋆ ε) ⋅ (ν ⋆ f ⋆ fa) = ν ⋆ ε" using 1 2 ‹ide fa› ν ε interchange [of "g ⋆ fa" ν ε "f ⋆ fa"] comp_arr_dom comp_cod_arr by simp also have "... = (ν ⋆ trg f) ⋅ (r ⋆ ε)" using ‹ide fa› ν ε 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, fa, trg f] ⋅ ((((ν ⋆ trg f) ⋅ r-1[r]) ⋅ inv ν) ⋅ (r[g] ⋆ fa)) ⋅ a-1[g, src f, fa]" using ide_base fa' comp_assoc fa runit'_simps(1) invert_side_of_triangle(2) comp_assoc by presburger also have "... = a[g, fa, trg f] ⋅ r-1[g ⋆ fa] ⋅ (r[g] ⋆ fa) ⋅ a-1[g, src f, fa]" proof - have "((ν ⋆ trg f) ⋅ r-1[r]) ⋅ inv ν = r-1[g ⋆ fa]" using 1 2 ‹ide fa› ν ide_base runit'_naturality [of ν] comp_arr_dom by (metis fa 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, fa, trg f] ⋅ a-1[g, fa, src fa]) ⋅ (g ⋆ r-1[fa])) ⋅ (r[g] ⋆ fa) ⋅ a-1[g, src f, fa]" using fa "2" runit_hcomp ‹ide fa› comp_assoc by simp also have "... = (g ⋆ r-1[fa]) ⋅ (g ⋆ l[fa])" using 1 2 comp_cod_arr ‹ide fa› comp_assoc_assoc' triangle' by simp also have "... = ?β" using 2 ‹ide fa› whisker_left by simp finally show ?thesis by simp qed show "?θ = ?θ' ⋅ (f ⋆ ?γ')" proof - have "((ε ⋆ trg f) ⋅ a-1[f, fa, trg f]) ⋅ (f ⋆ (fa ⋆ ε) ⋅ a[fa, f, fa] ⋅ (η ⋆ fa)) = ((ε ⋆ trg f) ⋅ a-1[f, fa, trg f]) ⋅ (f ⋆ fa ⋆ ε) ⋅ (f ⋆ a[fa, f, fa]) ⋅ (f ⋆ η ⋆ fa)" using 1 2 ‹ide fa› ε η whisker_left by (metis ‹«(fa ⋆ ε) ⋅ a[fa, f, fa] ⋅ (η ⋆ fa) : src f ⋆ fa ==> fa ⋆ trg f¬› arrI ide_leg0 seqE) also have "... = (ε ⋆ trg f) ⋅ (a-1[f, fa, trg f] ⋅ (f ⋆ fa ⋆ ε)) ⋅ (f ⋆ a[fa, f, fa]) ⋅ (f ⋆ η ⋆ fa)" using comp_assoc by simp also have "... = ((ε ⋆ trg f) ⋅ ((f ⋆ fa) ⋆ ε)) ⋅ a-1[f, fa, f ⋆ fa] ⋅ (f ⋆ a[fa, f, fa]) ⋅ (f ⋆ η ⋆ fa)" using 1 2 ‹ide fa› ε assoc'_naturality [of f fa ε] comp_assoc by simp also have "... = (trg f ⋆ ε) ⋅ (ε ⋆ f ⋆ fa) ⋅ (a-1[f, fa, f ⋆ fa] ⋅ (f ⋆ a[fa, f, fa])) ⋅ (f ⋆ η ⋆ fa)" using 1 2 ‹ide fa› ε interchange [of ε "f ⋆ fa" "trg f" ε] interchange [of "trg f" ε ε "f ⋆ fa"] comp_arr_dom comp_cod_arr comp_assoc by simp also have "... = (trg f ⋆ ε) ⋅ ((ε ⋆ f ⋆ fa) ⋅ (a[f ⋆ fa, f, fa]) ⋅ (a-1[f, fa, f] ⋆ fa) ⋅ (a-1[f, fa ⋆ f, fa]) ⋅ (f ⋆ η ⋆ fa))" proof - have "a-1[f, fa, f ⋆ fa] ⋅ (f ⋆ a[fa, f, fa]) = a[f ⋆ fa, f, fa] ⋅ (a-1[f, fa, f] ⋆ fa) ⋅ a-1[f, fa ⋆ f, fa]" proof - have A: "(a-1[f, fa, f] ⋆ fa) ⋅ a-1[f, fa ⋆ f, fa] ⋅ (f ⋆ a-1[fa, f, fa]) = a-1[f ⋆ fa, f, fa] ⋅ a-1[f, fa, f ⋆ fa]" using 1 2 ‹ide fa› pentagon' comp_assoc by fastforce hence B: "a[f ⋆ fa, f, fa] ⋅ (a-1[f, fa, f] ⋆ fa) ⋅ a-1[f, fa ⋆ f, fa] ⋅ (f ⋆ a-1[fa, f, fa]) = a-1[f, fa, f ⋆ fa]" using A 1 2 ‹ide fa› invert_side_of_triangle(1) [of "(a-1[f, fa, f] ⋆ fa) ⋅ a-1[f, fa ⋆ f, fa] ⋅ (f ⋆ a-1[fa, f, fa])" "a-1[f ⋆ fa, f, fa]" "a-1[f, fa, f ⋆ fa]"] by auto show ?thesis proof - have C: "iso (f ⋆ a-1[fa, f, fa])" using 1 2 ‹ide fa› by simp moreover have "inv (f ⋆ a-1[fa, f, fa]) = f ⋆ a[fa, f, fa]" using C 1 2 ‹ide fa› by fastforce ultimately show ?thesis using B 1 2 ‹ide fa› comp_assoc invert_side_of_triangle(2) [of "a-1[f, fa, f ⋆ fa]" "a[f ⋆ fa, f, fa] ⋅ (a-1[f, fa, f] ⋆ fa) ⋅ a-1[f, fa ⋆ f, fa]" "f ⋆ a-1[fa, f, fa]"] by simp qed qed thus ?thesis using comp_assoc by simp qed also have "... = (trg f ⋆ ε) ⋅ (a[trg f, f, fa] ⋅ ((ε ⋆ f) ⋆ fa)) ⋅ (a-1[f, fa, f] ⋆ fa) ⋅ ((f ⋆ η) ⋆ fa) ⋅ a-1[f, src f, fa]" using 1 2 ‹ide fa› ‹ide f› η ε assoc_naturality [of ε f fa] assoc'_naturality [of f η fa] comp_assoc by simp also have "... = (trg f ⋆ ε) ⋅ a[trg f, f, fa] ⋅ (((ε ⋆ f) ⋆ fa) ⋅ (a-1[f, fa, f] ⋆ fa) ⋅ ((f ⋆ η) ⋆ fa)) ⋅ a-1[f, src f, fa]" using comp_assoc by simp also have "... = (trg f ⋆ ε) ⋅ a[trg f, f, fa] ⋅ ((ε ⋆ f) ⋅ a-1[f, fa, f] ⋅ (f ⋆ η) ⋆ fa) ⋅ a-1[f, src f, fa]" using 1 2 ‹ide fa› ‹ide f› η ε whisker_right by (metis (full_types) * θ θ_eq' arrI hseqE seqE) also have "... = (trg f ⋆ ε) ⋅ a[trg f, f, fa] ⋅ (l-1[f] ⋅ r[f] ⋆ fa) ⋅ a-1[f, src f, fa]" 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 ⋆ 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 ‹fa› and isomo such that ‹«ψ : f ⋆ fa ==> r¬› (this was already part of the proof that a tabulatio satisfies ‹T0›). The more difficult content in the present result is that we ma actually take ‹fa› to be the left adjoint ‹f*› of ‹f›. › lemma yields_isomorphic_representation: shows "«T0.trnr\<epsilon> r ρ : g ⋆ f* ==> r¬" and "iso (T0.trnr\<epsilon> r ρ)" proof - text ‹ As stated in CKS, the first step of the proof is: \begin{quotation} ``Apply ‹T1› with ‹X = A›, ‹u = 1A›, ‹v = r›, ‹ψ = 1R›, to obtain ‹f'›, ‹θ': ff' = ‹ν : r ≃ g f'› with ‹1R = (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- It is not clear whether this is a typo, or whether it is a consequence of CKS ha suppressed all canonical isomorphisms (unitors, in this case). The resulting eq 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 ‹1R›, 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 = 1A›, ‹w = f*›, ‹w' = f'›, ‹θ = ε: ff* ==> 1›, ‹θ': ff' ==> 1 ‹β = ν(rε)(ρf*)› to obtain ‹γ : f* ==> f'› with ‹gγ = ν(rε)(ρf*)ε = θ'(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\<epsilon> 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*)(g &‹=›& ‹ν(rε)(rff*θ')(ρf*ff')(gηf')›\\ &‹=›& ‹ν(rθ')(rεff')(rfηf')(ρf')›\\ &‹=›& ‹ν(rθ')(ρf') = 1gf'›, \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 ske 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[ using γ trg_γ_eq lunit'_naturality [of γ] comp_assoc by auto also have "... = r[f*] ⋅ (f* ⋆ θ') ⋅ (a[f*, f, w] ⋅ ((f* ⋆ f) ⋆ γ)) ⋅ (η ⋆ f*) ⋅ l- 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 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 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 - java.lang.NullPointerException (r ⋆ r>*]) ⋅ (r ⋆ \<starrc*) ⋅ a1[f, f*])" proof - java.lang.NullPointerException _left T0.anar by simp hve "... = (r ⋆ r[src f (r ⋆ ⋆*) ⋅ a1[f, f*])" proof - have "ε ⋅ r[f*] ⋅ (ε src f a1[f, f*]" using ie_leg0 T T0.ntippar ruunit_hcomvrt_sie_of_triangle(2) runit_naturality it_nat_naturality cmp__assoc by ( thus ?thesisdefinehe Free Group over a set set of generators,d showhat it using whiskeleftft Tantipar by sip qedjava.lang.StringIndexOutOfBoundsException: Index 25 out of bounds for length hessimp qed t thus ?thesis using comp_asoc byetis qed (r ⋆*]) ⋅<> sc f<sp>*) ⋅ \star a1[f, f, src f<sup>*]) \cdot> (r ⋆🚫 carrier Fgens a[rf \^sup>* ⋆ f \star " using comp_assoy simp also have "... = (r ⋆ {y∈gens). canceled y}" java.lang.NullPointerException a[r, f, proof - have "(r ⋆-*, src f (r ⋆ f θ java.lang.NullPointerException proof - have "(r ⋆ι›) r ⋆-[, f\<^up, src f*] ⋅ f θ using whisker_left alsoa "... = r ⋆(f<star>> f θ') ⋅-*, f ⋆w]" using assoc'_naturality [of f <su>*"θbyuto also have "... = (r ⋆ f θ (r ⋆-*, f ⋆ using whisker_left.anprby auto finally show ?thesis by simp ancels_to x cels x y" thus ?thesis by simp qed (r ⋆-*, f ⋆ a[r, f, f f ⋆ using ommp_assoc by sy siimp also have "... = simp (r ⋆-[ f f ⋆ w]) \<ot< gens → using comp_asunfolree_group_def by simp also have "... = (r ⋆*]) ⋅ src f* ⋆') ⋅ ε f ⋆ r \\> <a>1[f, f w]) ⋅[r, f, f<sp>* \<star ⋆ proof - have "(r ⋆ ⋆*) ⋅ (f ⋆*) ⋆') = (r ⋆* ⋆') ⋅ ε ⋆ w)" proof - r ⋆ src f (r ⋆ f θ r ⋆ (ε src fcdot> ((f ⋆ f θ using whisker_left T0.antiparsim also have ".. = r ⋆ θ'" using interchange [of ε f*" θ'] T0.antipar comp_arr_dom comp_cod_arr byb aututo also have "... = r ⋆* ⋆ θ (ε ⋆ w)" using in [of "src f <theta>' 🚫a # x ∈\^gens<ls> T0.antipar comp_arr_dom comp_cod_arr by auto also have "... = (r ⋆* ⋆') ⋅ ε f ⋆ w" using rom ‹ finally show ?thesis by blast qed thus ?thesis by simp qed also have "... = (r ⋆r f\^>*]) \<<cdot') ⋅ ε f ⋆ (r ⋆-*, f ⋆ a* ⋆ ⋆ using comp_assoc by simp finally show ?thesis by simp qed have 2: "(ρ f f ⋆ (g ⋆*, f, w]) ⋅ η ⋆ ((r ⋆ a[f\^up>*, f, w]) ⋅ f) ⋆ \>w) ⋅ ⋆ w)" proof - haveshow "∀java.lang.StringIndexOutOfBoundsException: Index 3 out of bounds for ((ρ ⋆ 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]) = {(\<langle>r\<rangle> \<star> \<a>-1[\<langle>f\<rangle> \<star> \<langle>f*\<rangle>, \<l \<a>[\<langle>r\<rangle>, \<langle>f\<rangle>, \<langle>f*\<rangle> \<star> \<langle>f\<ra \<a>-1[\<langle>r\<rangle>, \<langle>f\<rangle>, (\<langle>f*\<rangle> \<star> \<langle>f using T0.antipar a'_def α_def assoc'_eq_inv_assoc by auto also have "... = {\<langle>r\<rangle> \<star> \<a>-1[\<langle>f\<rangle>, \<langle>f*\<r 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*, (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]) = {(\<langle>r\<rangle> \<star> (\<l>[\<langle>f\<rangle>] \<star> \<langle>w\<rangle>) \<cd (\<langle>r\<rangle> \<star> \<a>[E.Src \<langle>r\<rangle>, \<langle>f\<rangle>, \<langl (\<langle>r\<rangle> \<star> \<l>-1[\<langle>f\<rangle>] \<cdot> \<r>[\<langle>f\<rangle>] (\<langle>r\<rangle> \<star> \<langle>f\<rangle> \<star> \<l>-1[\<langle>w\<rangle>])}" using l_ide_simp r_ide_simp a'_def α_def assoc'_eq_inv_assoc by simp also have "... = {\<langle>r\<rangle> \<star> \<langle>f\<rangle> \<star> \<langle>w\<ra 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\<epsilon> 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 › subsection "Tabulation of a Right Adjoint" text ‹ Here we obtain a tabulation of the right adjoint of a map. This is CKS Proposit 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. › context adjunction_in_bicategory begin lemma tabulation_of_right_adjoint: shows "tabulation V H a i src trg g η f (src f)" proof - interpret T: tabulation_data V H a i src trg g η f ‹src f› using unit_in_hom antipar by (unfold_locales, simp_all) show ?thesis proof show T1: "∧u ψ. [ ide u; «ψ : dom ψ ==> g ⋆ u¬ ] ==> ∃w θ ν. ide w ∧ «θ : f ⋆ w ==> u¬ ∧ «ν : dom ψ ==> src f ⋆ w¬ ∧ iso ν ∧ T.composite_cell w θ ⋅ ν = ψ" proof - fix u v ψ assume u: "ide u" assume ψ: "«ψ : v ==> g ⋆ u¬" have v: "ide v" using ψ by auto have 1: "src g = trg u" using ψ by (metis arr_cod in_homE not_arr_null seq_if_composable) have 2: "src f = trg v" using ψ 1 u ide_right antipar(1) vconn_implies_hpar(4) by force text ‹It seems clear that we need to take ‹w = v› and ‹ν = l-1[v]›. › let ?w = v let ?ν = "l-1[v]" have ν: "«?ν : v ==> src f ⋆ ?w¬ ∧ iso ?ν" using v 2 iso_lunit' by auto text ‹ We need ‹θ›, defined to satisfy ‹«θ : f ⋆ v ==> u¬› and ‹ψ = (v ⋆ θ) ⋅ a[v, f, v] ⋅ (η ⋆ w) ⋅ l-1[v]›. We have ‹«ψ : v ==> g ⋆ u¬›, so we can get arrow ‹«θ : f ⋆ v ==> u¬› by adjoint transp Note that this uses adjoint transpose on the \emph{left}, rather than on the rig › let ?θ = "trnl\<epsilon> u ψ" have θ: "«?θ : f ⋆ ?w ==> u¬" using u v antipar 1 2 ψ adjoint_transpose_left(2) [of u v] by auto text ‹ Now, ‹trnl\<eta> v θ ≡ (g ⋆ θ) ⋅ a[g, f, v] ⋅ (η ⋆ v) ⋅ l-1[v]›, which suggests that we ought to have ‹ψ = trnl\<eta> v θ› and ‹ν = l-1[v]›; › have "T.composite_cell ?w ?θ ⋅ ?ν = ψ" using u v ψ 1 2 adjoint_transpose_left(4) [of u v ψ] trnl\<eta>_def comp_assoc by s thus "∃w θ ν. ide w ∧ «θ : f ⋆ w ==> u¬ ∧ «ν : v ==> src f ⋆ w¬ ∧ iso ν ∧ T.composite_cell w θ ⋅ ν = ψ" using v θ ν antipar comp_assoc by blast qed show T2: "∧u w w' θ θ' β. [ ide w; ide w'; «θ : f ⋆ w ==> u¬; «θ' : f ⋆ w' ==> u¬; «β : src f ⋆ w ==> src f ⋆ w'¬; T.composite_cell w θ = T.composite_cell w' θ' ⋅ β ] ==> ∃!γ. «γ : w ==> w'¬ ∧ β = src f ⋆ γ ∧ θ = θ' ⋅ (f ⋆ γ)" proof - fix u w w' θ θ' β assume w: "ide w" assume w': "ide w'" assume θ: "«θ : f ⋆ w ==> u¬" assume θ': "«θ' : f ⋆ w' ==> u¬" assume β: "«β : src f ⋆ w ==> src f ⋆ w'¬" assume E: "T.composite_cell w θ = T.composite_cell w' θ' ⋅ β" interpret T: uwθw'θ'β V H a i src trg g η f ‹src f› u w θ w' θ' β using w w' θ θ' β E comp_assoc by (unfold_locales, auto) have 2: "src f = trg β" using antipar by simp show "∃!γ. «γ : w ==> w'¬ ∧ β = src f ⋆ γ ∧ θ = θ' ⋅ (f ⋆ γ)" proof - text ‹ The requirement ‹β = src f ⋆ γ› means we have to essentially invert ‹λγ. src f ⋆ γ› to obtain ‹γ›. CKS say only: ``the strong form of ‹T2› is clear since ‹g = 1›" (here by ``‹g›'' they are referring to ‹dom η›, the ``output leg'' of the span in the tabulation). This would mean that we would have to take ‹γ = β›, which doesn' work for a general bicategory (we don't necessarily have ‹src f ⋆ γ = γ›). For a general bicategory, we have to take ‹γ = l[w'] ⋅ β ⋅ l-1[w]›. › let ?γ = "l[w'] ⋅ β ⋅ l-1[w]" have γ: "«?γ : w ==> w'¬" using β by simp have 3: "β = src f ⋆ ?γ" proof - have "β = l-1[w'] ⋅ ?γ ⋅ l[w]" using β iso_lunit by (simp add: comp_arr_dom invert_side_of_triangle(1) comp_assoc) also have "... = l-1[w'] ⋅ l[w'] ⋅ (src f ⋆ ?γ)" using γ lunit_naturality by (metis T.uwθ.w_simps(4) in_homE trg_dom) also have "... = (l-1[w'] ⋅ l[w']) ⋅ (src f ⋆ ?γ)" using comp_assoc by simp also have "... = src f ⋆ ?γ" using γ iso_lunit comp_inv_arr comp_cod_arr by (metis T.β_simps(1) calculation comp_ide_arr inv_is_inverse inverse_arrowsE w' finally show ?thesis by simp qed have "θ = θ' ⋅ (f ⋆ ?γ)" proof - have "θ = trnl\<epsilon> u (trnl\<eta> w θ)" using θ adjoint_transpose_left(3) [of u w θ] by simp also have "... = trnl\<epsilon> u (trnl\<eta> w' θ' ⋅ l[w'] ⋅ β ⋅ l-1[w])" proof - have "trnl\<eta> w θ = trnl\<eta> w' θ' ⋅ l[w'] ⋅ β ⋅ l-1[w]" proof - have "trnl\<eta> w θ ⋅ l[w] = (T.composite_cell w θ ⋅ l-1[w]) ⋅ l[w]" unfolding trnl\<eta>_def using comp_assoc by simp also have "... = T.composite_cell w θ ⋅ (l-1[w] ⋅ l[w])" using comp_assoc by simp also have 4: "... = T.composite_cell w θ" using comp_arr_dom by (simp add: comp_inv_arr') also have "... = T.composite_cell w' θ' ⋅ β" using E by simp also have "... = (T.composite_cell w' θ' ⋅ l-1[w']) ⋅ l[w'] ⋅ β" proof - have "(l-1[w'] ⋅ l[w']) ⋅ β = β" using iso_lunit β comp_cod_arr comp_assoc comp_inv_arr' by simp thus ?thesis using comp_assoc by simp qed also have "... = trnl\<eta> w' θ' ⋅ l[w'] ⋅ β" unfolding trnl\<eta>_def using comp_assoc by simp finally have "trnl\<eta> w θ ⋅ l[w] = trnl\<eta> w' θ' ⋅ l[w'] ⋅ β" by simp thus ?thesis using β 4 invert_side_of_triangle(2) adjoint_transpose_left iso_lunit trnl\<eta>_def comp_assoc by metis qed thus ?thesis by simp qed also have "... = l[u] ⋅ (ε ⋆ u) ⋅ a-1[f, g, u] ⋅ (f ⋆ trnl\<eta> w' θ' ⋅ l[w'] ⋅ β ⋅ using trnl\<epsilon>_def by simp also have "... = l[u] ⋅ (ε ⋆ u) ⋅ a-1[f, g, u] ⋅ (f ⋆ trnl\<eta> w' θ') ⋅ (f ⋆ l[w'] ⋅ β ⋅ l-1 using ide_left ide_right w w' 2 β θ antipar trnl\<epsilon>_def adjoint_transpose_le whisker_left by (metis T.uwθ.θ_simps(1) calculation hseqE seqE) also have "... = (l[u] ⋅ (ε ⋆ u) ⋅ a-1[f, g, u] ⋅ (f ⋆ trnl\<eta> w' θ')) ⋅ (f ⋆ l[w'] ⋅ β ⋅ l using comp_assoc by simp also have "... = trnl\<epsilon> u (trnl\<eta> w' θ') ⋅ (f ⋆ l[w'] ⋅ β ⋅ l-1[w])" unfolding trnl\<epsilon>_def by simp also have "... = θ' ⋅ (f ⋆ ?γ)" using θ' adjoint_transpose_left(3) by auto finally show ?thesis by simp qed hence "∃γ. «γ : w ==> w'¬ ∧ β = src f ⋆ γ ∧ θ = θ' ⋅ (f ⋆ γ)" using γ 3 hcomp_obj_arr by blast moreover have "∧γ γ'. «γ : w ==> w'¬ ∧ β = src f ⋆ γ ∧ θ = θ' ⋅ (f ⋆ γ) ∧ «γ' : w ==> w'¬ ∧ β = src f ⋆ γ' ∧ θ = θ' ⋅ (f ⋆ γ') ==> γ = γ'" proof - fix γ γ' assume γγ': "«γ : w ==> w'¬ ∧ β = src f ⋆ γ ∧ θ = θ' ⋅ (f ⋆ γ) ∧ «γ' : w ==> w'¬ ∧ β = src f ⋆ γ' ∧ θ = θ' ⋅ (f ⋆ γ')" show "γ = γ'" using γγ' vconn_implies_hpar(2) L.is_faithful [of γ γ'] by force qed ultimately show ?thesis by blast qed qed qed qed end subsection "Preservation by Isomorphisms" text ‹ Next, we show that tabulations are preserved under composition on all three side isomorphisms. This is something that we would expect to hold if ``tabulation'' properly bicategorical notion. › context tabulation begin text ‹ Tabulations are preserved under composition of an isomorphism with the ``input l › lemma preserved_by_input_iso: assumes "«φ : f ==> f'¬" and "iso φ" shows "tabulation V H a i src trg r ((r ⋆ φ) ⋅ ρ) f' g" proof - interpret T': tabulation_data V H a i src trg r ‹(r ⋆ φ) ⋅ ρ› f' using assms(1) tab_in_hom apply unfold_locales apply auto by force show ?thesis proof show "∧u ψ. [ ide u; «ψ : dom ψ ==> r ⋆ u¬ ] ==> ∃w θ ν. ide w ∧ «θ : f' ⋆ w ==> u¬ ∧ «ν : dom ψ ==> g ⋆ w¬ ∧ iso ν ∧ T'.composite_cell w θ ⋅ ν = ψ" proof - fix u ψ assume u: "ide u" and ψ: "«ψ : dom ψ ==> r ⋆ u¬" obtain w θ ν where wθν: "ide w ∧ «θ : f ⋆ w ==> u¬ ∧ «ν : dom ψ ==> g ⋆ w¬ ∧ iso ν ∧ composite_cell w θ ⋅ ν = ψ" using u ψ T1 by blast interpret T1: uwθψν V H a i src trg r ρ f g u w θ ψ ν using wθν comp_assoc by (unfold_locales, auto) have 1: "«inv φ ⋆ w : f' ⋆ w ==> f ⋆ w¬" using assms by (intro hcomp_in_vhom, auto) have "ide w ∧ «θ ⋅ (inv φ ⋆ w) : f' ⋆ w ==> u¬ ∧ «ν : dom ψ ==> g ⋆ w¬ ∧ iso ν ∧ T'.composite_cell w (θ ⋅ (inv φ ⋆ w)) ⋅ ν = ψ" using wθν 1 apply (intro conjI) apply auto[4] proof - show "T'.composite_cell w (θ ⋅ (inv φ ⋆ w)) ⋅ ν = ψ" proof - have "T'.composite_cell w (θ ⋅ (inv φ ⋆ w)) ⋅ ν = (r ⋆ θ) ⋅ ((r ⋆ inv φ ⋆ w) ⋅ a[r, f', w]) ⋅ ((r ⋆ φ) ⋅ ρ ⋆ w) ⋅ ν" using assms(1) 1 whisker_left [of r θ "inv φ ⋆ w"] comp_assoc by auto also have "... = (r ⋆ θ) ⋅ (a[r, f, w] ⋅ ((r ⋆ inv φ) ⋆ w)) ⋅ ((r ⋆ φ) ⋅ ρ ⋆ w) ⋅ ν" using assms assoc_naturality [of r "inv φ" 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 ⋆ θ) ⋅ a[r, f, w] ⋅ ((((r ⋆ inv φ) ⋆ w) ⋅ ((r ⋆ φ) ⋆ w)) ⋅ (ρ ⋆ using whisker_right [of w "r ⋆ φ" ρ] comp_assoc T1.ide_w vseq_implies_hpar(1) by auto also have "... = composite_cell w θ ⋅ ν" proof - have "(((r ⋆ inv φ) ⋆ w) ⋅ ((r ⋆ φ) ⋆ w)) ⋅ (ρ ⋆ w) = ρ ⋆ w" proof - have "«r ⋆ φ : r ⋆ f ==> r ⋆ f'¬" using assms(1) by (intro hcomp_in_vhom, auto) moreover have "«r ⋆ inv φ : r ⋆ f' ==> r ⋆ f¬" 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 "... = ψ" using wθν by simp finally show ?thesis by simp qed qed thus "∃w θ ν. ide w ∧ «θ : f' ⋆ w ==> u¬ ∧ «ν : dom ψ ==> g ⋆ w¬ ∧ iso ν ∧ T'.composite_cell w θ ⋅ ν = ψ" by blast qed show "∧u w w' θ θ' β. [ ide w; ide w'; «θ : f' ⋆ 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 uwθw'θ'β V H a i src trg r ‹(r ⋆ φ) ⋅ ρ› f' g u w θ w' θ' β using w w' θ θ' β eq comp_assoc by (unfold_locales, auto) show "∃!γ. «γ : w ==> w'¬ ∧ β = g ⋆ γ ∧ θ = θ' ⋅ (f' ⋆ γ)" proof - have φ_w: "«φ ⋆ w : f ⋆ w ==> f' ⋆ w¬" using assms(1) by (intro hcomp_in_vhom, auto) have φ_w': "«φ ⋆ w' : f ⋆ w' ==> f' ⋆ w'¬" using assms(1) by (intro hcomp_in_vhom, auto) have "«θ ⋅ (φ ⋆ w) : f ⋆ w ==> u¬" using θ assms(1) by fastforce moreover have "«θ' ⋅ (φ ⋆ w') : f ⋆ w' ==> u¬" using θ' assms(1) by fastforce moreover have "composite_cell w (θ ⋅ (φ ⋆ w)) = composite_cell w' (θ' ⋅ (φ ⋆ w')) ⋅ β proof - have "composite_cell w (θ ⋅ (φ ⋆ w)) = (r ⋆ θ) ⋅ ((r ⋆ φ ⋆ w) ⋅ a[r, f, w]) ⋅ (ρ ⋆ w)" using assms(2) φ_w θ whisker_left comp_assoc by auto also have "... = (r ⋆ θ) ⋅ a[r, f', w] ⋅ ((r ⋆ φ) ⋆ w) ⋅ (ρ ⋆ w)" using assms(1) assoc_naturality [of r φ w] comp_assoc by (metis φ_w T'.tab_simps(1) base_simps(3) base_simps(4) hseq_char in_homE seqE uwθ.w_simps(5) uwθ.w_simps(6)) also have "... = T'.composite_cell w θ" using assms(2) w whisker_right [of w] by simp also have "... = T'.composite_cell w' θ' ⋅ β" using eq by simp also have "... = (r ⋆ θ') ⋅ (a[r, f', w'] ⋅ ((r ⋆ φ) ⋆ w')) ⋅ (ρ ⋆ w') ⋅ β" using assms(2) w' whisker_right [of w'] comp_assoc by simp also have "... = ((r ⋆ θ') ⋅ (r ⋆ φ ⋆ w')) ⋅ a[r, f, w'] ⋅ (ρ ⋆ w') ⋅ β" using assms(1) assoc_naturality [of r φ w'] comp_assoc by (metis φ_w' T'.tab_simps(1) base_simps(3) base_simps(4) hseqE in_homE seqE uw'θ'.w_simps(5) uw'θ'.w_simps(6)) also have "... = composite_cell w' (θ' ⋅ (φ ⋆ w')) ⋅ β" using assms(2) whisker_left [of r] ‹«θ' ⋅ (φ ⋆ w') : f ⋆ w' ==> u¬› comp_assoc by auto finally show ?thesis by simp qed ultimately have *: "∃!γ. «γ : w ==> w'¬ ∧ β = g ⋆ γ ∧ θ ⋅ (φ ⋆ w) = (θ' ⋅ (φ ⋆ w')) ⋅ (f ⋆ γ)" using w w' β T2 by auto show ?thesis proof - have **: "∧γ. «γ : w ==> w'¬ ==> θ' ⋅ (φ ⋆ w') ⋅ (f ⋆ γ) ⋅ (inv φ ⋆ w) = θ' ⋅ (f' ⋆ γ)" proof - fix γ assume γ: "«γ : w ==> w'¬" have "θ' ⋅ (φ ⋆ w') ⋅ (f ⋆ γ) ⋅ (inv φ ⋆ w) = θ' ⋅ (φ ⋆ w') ⋅ (f ⋅ inv φ ⋆ γ ⋅ w)" using γ assms(1-2) interchange by (metis arr_inv cod_inv in_homE leg0_simps(2) leg0_simps(4) uwθ.w_in_hom(2) seqI) also have "... = θ' ⋅ (φ ⋅ f ⋅ inv φ ⋆ w' ⋅ γ ⋅ w)" using assms(1-2) interchange by (metis γ arr_inv cod_inv comp_arr_dom comp_cod_arr in_homE seqI) also have "... = θ' ⋅ (f' ⋆ γ)" proof - have "φ ⋅ f ⋅ inv φ = f'" using assms(1-2) comp_cod_arr comp_arr_inv' by auto moreover have "w' ⋅ γ ⋅ w = γ" using γ comp_arr_dom comp_cod_arr by auto ultimately show ?thesis by simp qed finally show "θ' ⋅ (φ ⋆ w') ⋅ (f ⋆ γ) ⋅ (inv φ ⋆ w) = θ' ⋅ (f' ⋆ γ)" by simp qed obtain γ where γ: "«γ : w ==> w'¬ ∧ β = g ⋆ γ ∧ θ ⋅ (φ ⋆ w) = (θ' ⋅ (φ ⋆ w')) ⋅ (f ⋆ γ)" using * by blast have "θ = θ' ⋅ (φ ⋆ w') ⋅ (f ⋆ γ) ⋅ (inv φ ⋆ w)" proof - have "seq (θ' ⋅ (φ ⋆ w')) (f ⋆ γ)" using assms(2) φ_w φ_w' γ β θ apply (intro seqI) apply auto by (metis seqE seqI') thus ?thesis using assms φ_w γ comp_assoc invert_side_of_triangle(2) iso_hcomp by (metis hcomp_in_vhomE ide_is_iso inv_hcomp inv_ide w) qed hence "θ = θ' ⋅ (f' ⋆ γ)" using γ ** by simp hence "∃γ. «γ : w ==> w'¬ ∧ β = g ⋆ γ ∧ θ = θ' ⋅ (f' ⋆ γ)" using γ by auto moreover have "∧γ γ'. «γ : w ==> w'¬ ∧ β = g ⋆ γ ∧ θ = θ' ⋅ (f' ⋆ γ) ∧ «γ' : 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 "(φ ⋆ w) ⋅ ?ν' = ν" using assms ν' φ_in_hhom whisker_right comp_cod_arr comp_assoc by (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_cell w' θ' ⋅ (β' ⋅ (inv φ ⋆ w))" using eq' comp_assoc by simp also have "... = composite_cell w' θ' ⋅ ((φ ⋆ w') ⋅ β' ⋅ (inv φ ⋆ w))" using assms φ_in_hhom whisker_right comp_assoc by simp finally show ?thesis by simp qed show "∃!γ. «γ : w ==> w'¬ ∧ β' = g' ⋆ γ ∧ θ = θ' ⋅ (f ⋆ γ)" 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 "∧γ γ'. [ «γ : w ==> w'¬ ∧ β' = g' ⋆ γ ∧ θ = θ' ⋅ (f ⋆ γ); «γ' : w ==> w'¬ ∧ β' = g' ⋆ γ' ∧ θ = θ' ⋅ (f ⋆ γ') ] ==> γ = γ'" proof - have *: "∧γ. «γ : w ==> w'¬ ==> (φ ⋆ w') ⋅ (g' ⋆ γ) ⋅ (inv φ ⋆ w) = g ⋆ γ" proof - 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 "∃!γ. «γ : w ==> w'¬ ∧ β' = g' ⋆ γ ∧ θ = θ' ⋅ (f ⋆ γ)" by blast qed qed qed text ‹ Finally, tabulations are preserved by composition with an isomorphism on the ``b › lemma is_preserved_by_base_iso: assumes "«φ : r ==> 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' ⋆ θ) ⋅ ((φ ⋆ f ⋆ w) ⋅ a[r, f, w]) ⋅ (ρ ⋆ w) ⋅ ν" using comp_assoc by simp also have "... = (r' ⋆ θ) ⋅ a[r', f, w] ⋅ (((φ ⋆ f) ⋆ w) ⋅ (ρ ⋆ w)) ⋅ ν" proof - have "(φ ⋆ f ⋆ w) ⋅ a[r, f, w] = a[r', f, w] ⋅ ((φ ⋆ f) ⋆ w)" using assms ide_leg0 w assoc_naturality [of φ f w] fw by fastforce thus ?thesis using comp_assoc by simp qed also have "... = T.composite_cell w θ ⋅ ν" using assms ide_leg0 whisker_right fw T.tab_in_hom arrI w comp_assoc by auto finally show "((φ ⋆ u) ⋅ (r ⋆ θ)) ⋅ a[r, f, w] ⋅ (ρ ⋆ w) ⋅ ν = T.composite_cell w θ ⋅ ν" 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 ?thesis using assms u by auto qed qed have φu: "hseq φ u" using assms ψ hseqI by (metis arrI ide_is_iso iso_hcomp iso_is_arr seqE seq_if_composable src_inv u) obtain w θ ν where wθν: "ide w ∧ «θ : f ⋆ w ==> u¬ ∧ «ν : v ==> g ⋆ w¬ ∧ iso ν ∧ composite_cell w θ ⋅ ν = (inv φ ⋆ u) ⋅ ψ'" using u ψ T1 [of u "(inv φ ⋆ u) ⋅ ψ'"] φf in_homE seqI' by auto interpret uwθψν V H a i src trg r ρ f g u w θ ‹(inv φ ⋆ u) ⋅ ψ'› ν using wθν ψ comp_assoc by (unfold_locales, auto) 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 using wθν by simp qed thus "∃w θ ν. ide w ∧ «θ : f ⋆ w ==> u¬ ∧ «ν : v ==> g ⋆ w¬ ∧ iso ν ∧ T.composite_cell w θ ⋅ ν = ψ'" by blast qed show "∧u w w' θ θ' β. [ ide w; ide w'; «θ : f ⋆ 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 (unfold_locales, auto) 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¬" using assms by fastforce thus ?thesis using comp_arr_dom comp_assoc by auto qed also have "... = T.composite_cell w' θ' ⋅ β" using eq' by simp also have "... = ((φ ⋆ u) ⋅ (r ⋆ θ')) ⋅ 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 assms ide_leg0 w w' θ θ' β calculation(1) calculation(3) by auto ultimately show ?thesis using mono_cancel section_is_mono iso_is_section by metis qed show "∃!γ. «γ : w ==> w'¬ ∧ β = g ⋆ γ ∧ θ = θ' ⋅ (f ⋆ γ)" using 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\<eta> 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 ρ: tabulation V H a i src trg ‹g ⋆ f*› ρ f g using ρ by auto let ?ψ = "trnr\<epsilon> (g ⋆ f*) ρ" have 3: "«?ψ : 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 ?ψ) = trg f" using 3 antipar by (metis ρ.leg0_simps(3) ρ.base_in_hom(2) seqI' src_inv vseq_implies_hpar(1)) hence "(inv ?ψ ⋆ f) ⋅ (?ψ ⋆ f) = (g ⋆ f*) ⋆ f" using 3 whisker_right [of f "inv ?ψ" ?ψ] inv_is_inverse comp_inv_arr by auto thus ?thesis using comp_cod_arr by simp qed also have "... = trnr\<eta> g (g ⋆ f*)" proof - have "src (g ⋆ f*) = trg f" by simp moreover have "ide g" by simp ultimately have "«trnr\<eta> g (g ⋆ f*) : g ==> (g ⋆ f*) ⋆ f¬" 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 qed ultimately show ?thesis by simp qed end subsection "Uniqueness of Tabulations" text ‹ We now intend to show that a tabulation of ‹r› is ``unique up to equivalence'', which is a property that any proper bicategorical limit should have. What do we mean by this, exactly? If we have two tabulations ‹(f, ρ)› and ‹(f', ρ')› of the same 1-cell ‹r›, then th induces ‹«w : src f' → src f¬›, ‹«w' : src f → src f'¬›, ‹«θ : f ⋆ w ==> f'¬›, and ‹«θ : f ⋆ w ==> f'¬›, such that ‹ρ'› is recovered up to isomorphism ‹«ν : g' ==> g ⋆ w¬ from ‹(w, θ)› by composition with ‹ρ› and ‹ρ› is recovered up to isomorphism ‹«ν' : g ==> g' ⋆ w'¬› from ‹(w', θ')› by composition with ‹ρ'›. This means that we obtain isomorphisms ‹«(ν' ⋆ w') ⋅ ν : g' ==> g' ⋆ w' ⋆ w¬› and ‹«(ν ⋆ w') ⋅ ν' : g ==> g ⋆ w ⋆ w'¬›. These isomorphisms then induce, via ‹T2›, unique 2-cells from ‹src f'› to ‹w' ⋆ and from ‹src f› to ‹w ⋆ w'›, which must be isomorphisms, thus showing ‹w› and ‹ equivalence maps. › 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 - interpret T': uwθψν V H a i src trg r ρ f g f' w' θ' ρ' ν' using assms(1,3) apply unfold_locales by auto interpret T: tabulation_data V H a i src trg r ρ' f' g' using assms(1,2) apply unfold_locales by auto interpret T: uwθψν V H a i src trg r ρ' f' g' f w θ ρ ν using assms(1,2) apply unfold_locales by auto (* These next simps are very important. *) have dom_ν [simp]: "dom ν = dom ρ" using assms(2) by auto have dom_ν' [simp]: "dom ν' = dom ρ'" using assms(3) by auto let ?ν'ν = "a[dom ρ, w', w] ⋅ (ν' ⋆ w) ⋅ ν" have ν'ν: "«?ν'ν : dom ρ ==> dom ρ ⋆ w' ⋆ w¬" by fastforce have "«ν : src ρ → trg r¬" by simp let ?θθ' = "θ ⋅ (θ' ⋆ w) ⋅ a-1[f, w', w]" have θθ': "«?θθ' : f ⋆ w' ⋆ w ==> f¬" by fastforce have iso_ν'ν_r: "iso (?ν'ν ⋅ r[g])" using iso_runit ν'ν apply (intro isos_compose) by auto have eq: "composite_cell (src f) r[f] = composite_cell (w' ⋆ w) ?θθ' ⋅ (?ν'ν ⋅ r[g])" proof - have "composite_cell (w' ⋆ w) ?θθ' ⋅ (?ν'ν ⋅ r[g]) = ((r ⋆ θ) ⋅ (r ⋆ θ' ⋆ w) ⋅ (r ⋆ a-1[f, w', w])) ⋅ a[r, f, w' ⋆ w] ⋅ ((ρ ⋆ w' ⋆ w) ⋅ a[g, w', w]) ⋅ (ν' ⋆ w) ⋅ ν ⋅ r[g]" using whisker_left comp_assoc by simp also have "... = ((r ⋆ θ) ⋅ (r ⋆ θ' ⋆ w) ⋅ (r ⋆ a-1[f, w', w])) ⋅ a[r, f, w' ⋆ w] ⋅ (a[r ⋆ f, w', w] ⋅ ((ρ ⋆ w') ⋆ w)) ⋅ (ν' ⋆ w) ⋅ ν ⋅ r[g]" using assoc_naturality [of ρ w' w] by simp also have "... = (r ⋆ θ) ⋅ (r ⋆ θ' ⋆ w) ⋅ ((r ⋆ a-1[f, w', w]) ⋅ a[r, f, w' ⋆ w] ⋅ a[r ⋆ f, w', w]) ⋅ ((ρ ⋆ w') ⋆ w) ⋅ (ν' ⋆ w) ⋅ ν ⋅ r[g]" using comp_assoc by simp also have "... = (r ⋆ θ) ⋅ ((r ⋆ θ' ⋆ w) ⋅ a[r, f ⋆ w', w]) ⋅ (a[r, f, w'] ⋆ w) ⋅ ((ρ ⋆ w') ⋆ w) ⋅ (ν' ⋆ w) ⋅ ν ⋅ r[g]" proof - have "seq a[r, f, w' ⋆ w] a[r ⋆ f, w', w]" by simp moreover have "inv (r ⋆ a[f, w', w]) = r ⋆ a-1[f, w', w]" by simp moreover have "(r ⋆ a[f, w', w]) ⋅ a[r, f ⋆ w', w] ⋅ (a[r, f, w'] ⋆ w) = a[r, f, w' ⋆ w] ⋅ a[r ⋆ f, w', w]" using pentagon by simp ultimately have "(r ⋆ a-1[f, w', w]) ⋅ a[r, f, w' ⋆ w] ⋅ a[r ⋆ f, w', w] = a[r, f ⋆ w', w] ⋅ (a[r, f, w'] ⋆ w)" using iso_assoc [of f w' w] iso_hcomp invert_side_of_triangle(1) [of "a[r, f, w' ⋆ w] ⋅ a[r ⋆ f, w', w]" "r ⋆ a[f, w', w]" "a[r, f ⋆ w', w] ⋅ (a[r, f, w'] ⋆ w)"] by simp thus ?thesis using comp_assoc by simp qed also have "... = (r ⋆ θ) ⋅ a[r, f', w] ⋅ (((r ⋆ θ') ⋆ w) ⋅ (a[r, f, w'] ⋆ w) ⋅ ((ρ ⋆ w') ⋆ w)) ⋅ (ν' ⋆ w) ⋅ ν ⋅ r[g]" proof - have "(r ⋆ θ' ⋆ w) ⋅ a[r, f ⋆ w', w] = a[r, f', w] ⋅ ((r ⋆ θ') ⋆ w)" using assoc_naturality [of r θ' w] by simp thus ?thesis using comp_assoc by simp qed also have "... = (r ⋆ θ) ⋅ a[r, f', w] ⋅ (composite_cell w' θ' ⋆ w) ⋅ (ν' ⋆ w) ⋅ ν ⋅ r[g]" using whisker_right by (metis T'.uwθψ T'.w_in_hom(1) composite_cell_in_hom T'.θ_simps(2) T'.ide_w T.ide_w arrI seqE) also have "... = (r ⋆ θ) ⋅ a[r, f', w] ⋅ ((ρ' ⋅ inv ν' ⋆ w) ⋅ (ν' ⋆ w)) ⋅ ν ⋅ r[g]" proof - have "composite_cell w' θ' = ρ' ⋅ inv ν'" 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 θ ⋅ ν) ⋅ r[g]" using whisker_right [of w "ρ' ⋅ inv ν'" ν'] dom_ν' comp_assoc comp_inv_arr' comp_arr_dom by simp also have "... = ρ ⋅ 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 ρ] by simp finally show ?thesis by simp qed have eq': "(r ⋆ r[f]) ⋅ a[r, f, src f] ⋅ (ρ ⋆ src f) ⋅ (inv (?ν'ν ⋅ r[g])) = composite_cell (w' ⋆ w) ?θθ'" proof - have 1: "composite_cell (src f) r[f] = (composite_cell (w' ⋆ w) ?θθ') ⋅ ?ν'ν ⋅ r[g]" using eq comp_assoc by simp have "composite_cell (src f) r[f] ⋅ (inv (?ν'ν ⋅ r[g])) = composite_cell (w' ⋆ w) ?θθ'" proof - have "seq (r ⋆ r[f]) (a[r, f, src f] ⋅ (ρ ⋆ src f))" by fastforce thus ?thesis using iso_ν'ν_r 1 invert_side_of_triangle(2) by simp qed thus ?thesis using comp_assoc by simp qed have ν'ν_r: "«?ν'ν ⋅ r[g] : g ⋆ src f ==> g ⋆ w' ⋆ w¬" by force have inv_ν'ν_r: "«inv (?ν'ν ⋅ r[g]) : g ⋆ w' ⋆ w ==> g ⋆ src f¬" using ν'ν iso_ν'ν_r by auto let ?P = "λγ. «γ : src f ==> w' ⋆ w¬ ∧ ?ν'ν ⋅ r[g] = dom ρ ⋆ γ ∧ r[f] = ?θθ' ⋅ (f ⋆ γ)" let ?γ = "THE γ. ?P γ" have "?P ?γ" proof - have "∃!γ. ?P γ" using ν'ν_r θθ' eq T2 [of "src f" "w' ⋆ w" "r[f]" f ?θθ' "?ν'ν ⋅ r[g]"] by simp thus ?thesis using the1_equality [of ?P] by blast qed hence γ: "«?γ : src f → src f¬ ∧ ?P ?γ" using vconn_implies_hpar(1-2) by auto let ?P' = "λγ. «γ : w' ⋆ w ==> src f¬ ∧ inv (?ν'ν ⋅ r[g]) = g ⋆ γ ∧ ?θθ' = r[f] ⋅ (f ⋆ γ)" let ?γ' = "THE γ. ?P' γ" have "?P' ?γ'" proof - have "∃!γ. ?P' γ" using inv_ν'ν_r θθ' eq' T2 [of "w' ⋆ w" "src f" "θ ⋅ (θ' ⋆ w) ⋅ a-1[f, w', w]" f] comp_assoc by simp thus ?thesis using the1_equality [of ?P'] by blast qed hence γ': "«?γ' : src f → src f¬ ∧ ?P' ?γ'" using vconn_implies_hpar(1-2) by auto have "inverse_arrows ?γ ?γ'" proof let ?Q = "λγ. «γ : src f ==> src f¬ ∧ dom ρ ⋆ src f = g ⋆ γ ∧ r[f] = r[f] ⋅ (f ⋆ γ)" have "∃!γ. ?Q γ" proof - have "ide (src f)" by simp moreover have "«r[f] : f ⋆ src f ==> f¬" by simp moreover have "«dom ρ ⋆ src f : g ⋆ src f ==> g ⋆ src f¬" by auto moreover have "(ρ ⋆ src f) ⋅ (dom ρ ⋆ src f) = ρ ⋆ src f" proof - have "(ρ ⋆ src ρ) ⋅ (dom ρ ⋆ src (dom ρ)) = ρ ⋆ src ρ" 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 ρ ⋆ src f"] comp_assoc by metis qed moreover have "?Q (src f)" using comp_arr_dom by auto moreover have "?Q (?γ' ⋅ ?γ)" proof (intro conjI) show "«?γ' ⋅ ?γ : src f ==> src f¬" using γ γ' by auto show "dom ρ ⋆ src f = g ⋆ ?γ' ⋅ ?γ" proof - have "g ⋆ ?γ' ⋅ ?γ = (g ⋆ ?γ') ⋅ (g ⋆ ?γ)" using γ γ' whisker_left by fastforce also have "... = inv (?ν'ν ⋅ r[g]) ⋅ (?ν'ν ⋅ r[g])" using γ γ' by simp also have "... = dom ρ ⋆ src f" using ν'ν iso_ν'ν_r comp_inv_arr inv_is_inverse by auto finally show ?thesis by simp qed show "r[f] = r[f] ⋅ (f ⋆ ?γ' ⋅ ?γ)" proof - have "r[f] ⋅ (f ⋆ ?γ' ⋅ ?γ) = r[f] ⋅ (f ⋆ ?γ') ⋅ (f ⋆ ?γ)" using γ γ' whisker_left by fastforce also have "... = (r[f] ⋅ (f ⋆ ?γ')) ⋅ (f ⋆ ?γ)" using comp_assoc by simp also have "... = r[f]" using γ γ' by simp finally show ?thesis by simp qed qed ultimately have "?γ' ⋅ ?γ = src f" by blast thus "ide (?γ' ⋅ ?γ)" by simp let ?Q' = "λγ. «γ : w' ⋆ w ==> w' ⋆ w¬ ∧ g ⋆ w' ⋆ w = g ⋆ γ ∧ ?θθ' = ?θθ' ⋅ (f ⋆ γ)" have "∃!γ. ?Q' γ" proof - have "ide (w' ⋆ w)" by simp moreover have "«?θθ' : f ⋆ w' ⋆ w ==> f¬" using θθ' by simp moreover have "«g ⋆ w' ⋆ w : g ⋆ w' ⋆ w ==> g ⋆ w' ⋆ w¬" by auto moreover have "composite_cell (w' ⋆ w) ?θθ' = composite_cell (w' ⋆ w) ?θθ' ⋅ (g ⋆ w' ⋆ w)" proof - have "«ρ ⋆ w' ⋆ w : g ⋆ w' ⋆ w ==> (r ⋆ f) ⋆ w' ⋆ w¬" by (intro hcomp_in_vhom, auto) hence "(ρ ⋆ w' ⋆ w) ⋅ (g ⋆ w' ⋆ w) = ρ ⋆ w' ⋆ 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' ⋆ w)" using θθ' comp_arr_dom by auto moreover have "?Q' (?γ ⋅ ?γ')" proof (intro conjI) show "«?γ ⋅ ?γ' : w' ⋆ w ==> w' ⋆ w¬" using γ γ' by auto show "g ⋆ w' ⋆ w = g ⋆ ?γ ⋅ ?γ'" proof - have "g ⋆ ?γ ⋅ ?γ' = (g ⋆ ?γ) ⋅ (g ⋆ ?γ')" using γ γ' whisker_left by fastforce also have "... = (?ν'ν ⋅ r[g]) ⋅ inv (?ν'ν ⋅ r[g])" using γ γ' by simp also have "... = g ⋆ w' ⋆ w" using ν'ν iso_ν'ν_r comp_arr_inv inv_is_inverse by auto finally show ?thesis by simp qed show "?θθ' = ?θθ' ⋅ (f ⋆ ?γ ⋅ ?γ')" proof - have "?θθ' ⋅ (f ⋆ ?γ ⋅ ?γ') = ?θθ' ⋅ (f ⋆ ?γ) ⋅ (f ⋆ ?γ')" using γ γ' whisker_left by fastforce also have "... = (?θθ' ⋅ (f ⋆ ?γ)) ⋅ (f ⋆ ?γ')" using comp_assoc by simp also have "... = ?θθ'" using γ γ' by simp finally show ?thesis by simp qed qed ultimately have "?γ ⋅ ?γ' = w' ⋆ w" by blast thus "ide (?γ ⋅ ?γ')" by simp qed hence "«?γ : src f ==> w' ⋆ w¬ ∧ iso ?γ" using γ by auto thus ?thesis by auto qed text ‹ 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. › lemma apex_unique_up_to_equivalence: assumes "tabulation V H a i src trg r ρ' f' g'" shows "∃w w' φ ψ θ ν θ' ν'. equivalence_in_bicategory V H a i src trg w' w ψ φ ∧ «w : src f → src f'¬ ∧ «w' : src f' → src f¬ ∧ «θ : f' ⋆ w ==> f¬ ∧ «ν : g ==> g' ⋆ w¬ ∧ iso ν ∧ ρ = (r ⋆ θ) ⋅ a[r, f', w] ⋅ (ρ' ⋆ w) ⋅ ν ∧ «θ' : f ⋆ w' ==> f'¬ ∧ «ν' : g' ==> g ⋆ w'¬ ∧ iso ν' ∧ ρ' = (r ⋆ θ') ⋅ a[r, f, w'] ⋅ (ρ ⋆ w') ⋅ ν'" proof - interpret T': tabulation V H a i src trg r ρ' f' g' using assms by auto obtain w θ ν where wθν: "ide w ∧ «θ : f' ⋆ w ==> f¬ ∧ «ν : g ==> g' ⋆ w¬ ∧ iso ν ∧ ρ = T'.composite_cell w θ ⋅ ν" using T'.T1 [of f ρ] ide_leg0 tab_in_hom by auto obtain w' θ' ν' where w'θ'ν': "ide w' ∧ «θ' : f ⋆ w' ==> f'¬ ∧ «ν' : g' ==> g ⋆ w'¬ ∧ iso ν' ∧ ρ' = composite_cell w' θ' ⋅ ν'" using T1 [of f' ρ'] T'.ide_leg0 T'.tab_in_hom by auto obtain φ where φ: "«φ : src f ==> w' ⋆ w¬ ∧ iso φ" using wθν w'θ'ν' apex_equivalence_lemma T'.tab_in_hom comp_assoc by metis obtain ψ where ψ: "«ψ : src f' ==> w ⋆ w'¬ ∧ iso ψ" using wθν w'θ'ν' T'.apex_equivalence_lemma tab_in_hom comp_assoc by metis have 1: "src f = src w" using φ src_dom [of φ] 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 ψ src_dom [of ψ] hcomp_simps(1) [of w w'] by (metis T'.leg0_simps(2) arr_cod in_homE src_hcomp src_src vconn_implies_hpar( interpret E: equivalence_in_bicategory V H a i src trg w' w ψ ‹inv φ› using φ ψ 1 2 wθν w'θ'ν' by unfold_locales auto have "«w : src f → src f'¬" using ψ wθν 1 2 trg_cod hcomp_simps(2) E.antipar(1) by simp moreover have "«w' : src f' → src f¬" using φ w'θ'ν' 1 2 E.antipar(2) by simp ultimately show ?thesis using E.equivalence_in_bicategory_axioms wθν w'θ'ν' comp_assoc by metis qed end subsection "`Tabulation' is Bicategorical" text ‹ In this section we show that ``tabulation'' is a truly bicategorical notion, in the sense that tabulations are preserved and reflected by equivalence pseudof 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 ge development of birepresentations and bicategorical limits, and I have chosen not attempt this here. › context equivalence_pseudofunctor begin lemma preserves_tabulation: assumes "tabulation (⋅C) (⋆C) aC iC srcC trgC r ρ f g" shows "tabulation (⋅D) (⋆D) aD iD srcD trgD (F r) (D.inv (Φ (r, f)) ⋅D F ρ) (F f) (F g)" proof - let ?ρ' = "D.inv (Φ (r, f)) ⋅D F ρ" interpret T: tabulation VC HC aC iC srcC trgC r ρ f using assms by auto interpret T': tabulation_data VD HD aD iD srcD trgD ‹F r› ?ρ' ‹F f› ‹F g› using cmp_in_hom Φ.components_are_iso C.VV.ide_charSbC C.VV.arr_charSbC apply unfold_locales apply auto by (intro D.comp_in_homI, auto) interpret T': tabulation VD HD aD iD srcD trgD ‹F r› ?ρ' ‹F f› ‹F g› text ‹ 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! › proof fix u' ψ' assume u': "D.ide u'" assume ψ': "«ψ' : D.dom ψ' ==>D F r ⋆D u'¬" show "∃w' θ' ν'. D.ide w' ∧ «θ' : F f ⋆D w' ==>D u'¬ ∧ «ν' : D.dom ψ' ==>D F g ⋆D w'¬ ∧ D.iso ν' ∧ T'.composite_cell w' θ' ⋅D ν' = ψ'" proof - text ‹ First, obtain ‹ψ› in ‹C› such that ‹F ψ› is related to ‹ψ'› by an equivalence in ‹D › define v' where "v' = D.dom ψ'" have v': "D.ide v'" using assms v'_def D.ide_dom ψ' by blast have ψ': "«ψ' : v' ==>D F r ⋆D u'¬" using v'_def ψ' by simp define a' where "a' = srcD ψ'" have [simp]: "srcD u' = a'" using a'_def ψ' by (metis D.arr_cod D.ide_char D.in_homE D.src.preserves_cod D.src_dom D.src_hcomp v') have [simp]: "trgD u' = srcD (F r)" using ψ' by (metis D.cod_trg D.in_homE D.not_arr_null D.seq_if_composable D.trg.extension D.trg.preserves_arr D.trg.preserves_cod) have [simp]: "srcD v' = a'" using v'_def ψ' a'_def by auto have [simp]: "trgD v' = trgD (F r)" using v'_def D.vconn_implies_hpar(4) ψ' u' by force have [simp]: "srcD ψ' = a'" using ψ' a'_def by blast have [simp]: "trgD ψ' = trgD (F r)" using ψ' v'_def ‹trgD v' = trgD (F r)› by auto obtain a where a: "C.obj a ∧ D.equivalent_objects (map0 a) a'" using u' ψ' a'_def biessentially_surjective_on_objects D.obj_src by blast obtain e' where e': "«e' : map0 a →D a'¬ ∧ D.equivalence_map e'" using a D.equivalent_objects_def by auto have u'_in_hhom: "«u' : a' →D map0 (srcC r)¬" by (simp add: u') hence 1: "«u' ⋆D e' : map0 a →D map0 (srcC r)¬" using e' by blast have v'_in_hhom: "«v' : a' →D map0 (trgC r)¬" by (simp add: v') hence 2: "«v' ⋆D e' : map0 a →D map0 (trgC r)¬" using e' by blast obtain d' η' ε' where d'η'ε': "adjoint_equivalence_in_bicategory (⋅D) (⋆D) aD iD srcD trgD e' d' η' ε'" using e' D.equivalence_map_extends_to_adjoint_equivalence by blast interpret e': adjoint_equivalence_in_bicategory ‹(⋅D)› ‹(⋆D)› aD iD srcD trgD e' using d'η'ε' by auto interpret d': adjoint_equivalence_in_bicategory ‹(⋅D)› ‹(⋆D)› aD iD srcD trgD d' e' "D.inv ε'" "D.inv η'" using e'.dual_adjoint_equivalence by simp have [simp]: "srcD e' = map0 a" using e' by auto have [simp]: "trgD e' = a'" using e' by auto have [simp]: "srcD d' = a'" by (simp add: e'.antipar(2)) have [simp]: "trgD d' = map0 a" using e'.antipar by simp obtain u where u: "«u : a →C srcC r¬ ∧ C.ide u ∧ D.isomorphic (F u) (u' ⋆D e')" using a e' u' 1 u'_in_hhom locally_essentially_surjective [of a "srcC r" "u' ⋆D e'" C.obj_src D.equivalence_map_is_ide T.base_simps(2) by blast obtain φ where φ: "«φ : u' ⋆D e' ==>D F u¬ ∧ D.iso φ" using u D.isomorphic_symmetric by blast obtain v where v: "«v : a →C trgC r¬ ∧ C.ide v ∧ D.isomorphic (F v) (v' ⋆D e')" using a e' v' v'_in_hhom locally_essentially_surjective [of a "trgC r" "v' ⋆D e'"] C.obj_trg D.equivalence_map_is_ide T.base_simps(2) by blast obtain ψ where ψ: "«ψ : F v ==>D v' ⋆D e'¬ ∧ D.iso ψ" using v by blast have [simp]: "srcC u = a" using u by auto have [simp]: "trgC u = srcC r" using u by auto have [simp]: "srcC v = a" using v by auto have [simp]: "trgC v = trgC r" using v by auto have [simp]: "srcD φ = map0 a" using φ by (metis "1" D.dom_src D.in_hhomE D.in_homE D.src.preserves_dom) have [simp]: "trgD φ = trgD u'" using φ 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]: "srcD ψ = map0 a" using ψ by (metis C.in_hhomE D.in_homE D.src_dom ‹srcD e' = map0 a› preserves_src v) have [simp]: "trgD ψ = trgD v'" using ψ by (metis "2" D.cod_trg D.in_hhomE D.in_homE D.trg.preserves_cod T.base_simps(2) ‹trgD v' = trgD (F r)› preserves_trg) define Fψ where "Fψ = Φ (r, u) ⋅D (F r ⋆D φ) ⋅D aD[F r, u', e'] ⋅D (ψ' ⋆D e') ⋅D ψ" have Fψ: "«Fψ : F v ==>D F (r ⋆C u)¬" proof (unfold Fψ_def, intro D.comp_in_homI) show "«ψ : F v ==>D v' ⋆D e'¬" using ψ by simp show "«ψ' ⋆D e' : v' ⋆D e' ==>D (F r ⋆D u') ⋆D e'¬" using e' ψ' D.equivalence_map_is_ide v'_in_hhom by blast show "«aD[F r, u', e'] : (F r ⋆D u') ⋆D e' ==>D F r ⋆D u' ⋆D e'¬" using e' u' D.equivalence_map_is_ide D.in_hhom_def u'_in_hhom by auto show "«F r ⋆D φ : F r ⋆D u' ⋆D e' ==>D F r ⋆D F u¬" using e' u' u φ 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 "«Φ (r, u) : F r ⋆D F u ==>D F (r ⋆C u)¬" using u cmp_in_hom(2) [of r u] by auto qed obtain ψ where ψ: "«ψ : v ==>C r ⋆C u¬ ∧ F ψ = Fψ" using u v ψ' φ ψ Fψ locally_full [of v "r ⋆C u" Fψ] 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]: "srcC ψ = srcC u" using ψ by (metis C.hseqI C.in_homE C.src_cod C.src_hcomp T.base_in_hom(1) u) have [simp]: "trgC ψ = trgC r" using ψ by (metis C.ide_char C.ide_trg C.in_homE C.trg.preserves_hom ‹trgC v = trgC r›) text ‹Apply ‹T.T1› to ‹u› and ‹ψ› to obtain ‹w›, ‹θ›, ‹ν›.› obtain w θ ν where wθν: "C.ide w ∧ «θ : f ⋆C w ==>C u¬ ∧ «ν : C.dom ψ ==>C g ⋆C w¬ ∧ C.iso ν ∧ T.composite_cell w θ ⋅C ν = ψ" using u ψ T.T1 [of u ψ] by auto text ‹ Combining ‹ψ› and ‹wθν› yields the situation depicted in the diagram below. In this as well as subsequent diagrams, canonical isomorphisms have been suppres 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} \xtwocel \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 $$ › have [simp]: "srcC w = srcC u" by (metis C.arrI C.seqE C.src_hcomp C.src_vcomp C.vseq_implies_hpar(1) ψ ‹srcC ψ = srcC u› wθν) have [simp]: "trgC w = srcC f" by (metis C.arrI C.hseq_char C.seqE T.tab_simps(2) ψ wθν) have [simp]: "srcD (F u) = map0 a" using e'.antipar(1) u by auto have [simp]: "srcD (F v) = map0 a" using v e' e'.antipar by force have [simp]: "srcD (F w) = map0 a" by (simp add: wθν) have *: "F (T.composite_cell w θ ⋅C ν) = Φ (r, u) ⋅D (F r ⋆D F θ ⋅D Φ (f, w)) ⋅D aD[F r, F f, F w] ⋅D (D.inv (Φ (r, f)) ⋅D F ρ ⋆D F w) ⋅D D.inv (Φ (g, w)) ⋅D F ν" text ‹ $$ F ( \xy/67pt/ \xymatrix{ & {\scriptstyle{a}} \xlowertwocell[ddddl]{}_{v}{^\nu} \xuppertwocell[ddddr]{}^{u}{^\theta} \ar[dd] ^{w} \\ \\ & \scriptstyle{{\rm src}~g \;=\;{\rm src}~f} \xtwocel \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)} \x \ar[ddl] _{F g} \ar[ddr] ^{F f} \\ \\ \scriptstyle{{\rm trg}~(F r)} & & \scriptstyle{{\rm src}~(F r)} \ar[ll] ^{F r} \\ & } \endxy $$ › proof - have "F (T.composite_cell w θ ⋅C ν) = F ((r ⋆C θ) ⋅C aC[r, f, w] ⋅C (ρ ⋆C w) ⋅C ν)" using C.comp_assoc by simp also have "... = F (r ⋆C θ) ⋅D F aC[r, f, w] ⋅D F (ρ ⋆C w) ⋅D F ν" by (metis C.arr_dom_iff_arr C.comp_assoc C.in_homE C.seqE as_nat_trans.preserves_comp_2 wθν) also have "... = F (r ⋆C θ) ⋅D (Φ (r, f ⋆C w) ⋅D (F r ⋆D Φ (f, w)) ⋅D aD[F r, F f, F w] ⋅D (D.inv (Φ (r, f)) ⋆D F w) ⋅D D.inv (Φ (r ⋆C f, w))) ⋅D F (ρ ⋆C w) ⋅D F ν" using ψ wθν 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 ⋆C θ) ⋅D Φ (r, f ⋆C w)) ⋅D (F r ⋆D Φ (f, w))) ⋅D aD[F r, F f, F w] ⋅D ((D.inv (Φ (r, f)) ⋆D F w) ⋅D D.inv (Φ (r ⋆C f, w))) ⋅D F (ρ ⋆C w) ⋅D F ν" using D.comp_assoc by simp also have "... = Φ (r, u) ⋅D (F r ⋆D F θ ⋅D Φ (f, w)) ⋅D aD[F r, F f, F w] ⋅D ((D.inv (Φ (r, f)) ⋆D F w) ⋅D D.inv (Φ (r ⋆C f, w)) ⋅D F (ρ ⋆C w)) ⋅D F ν" proof - have "(F (r ⋆C θ) ⋅D Φ (r, f ⋆C w)) ⋅D (F r ⋆D Φ (f, w)) = (Φ (r, u) ⋅D (F r ⋆D F θ) ⋅D (F r ⋆D Φ (f, w)))" proof - have "F (r ⋆C θ) ⋅D Φ (r, f ⋆C w) = Φ (r, u) ⋅D (F r ⋆D F θ)" using ψ Φ.naturality [of "(r, θ)"] FF_def wθν C.VV.arr_charSbC 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 "... = Φ (r, u) ⋅D (F r ⋆D F θ ⋅D Φ (f, w))" proof - have "(F r ⋆D F θ) ⋅D (F r ⋆D Φ (f, w)) = F r ⋆D F θ ⋅D Φ (f, w)" using ψ wθν D.whisker_right [of "F r" "F θ" "Φ (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 ⋆C θ) ⋅D Φ (r, f ⋆C w)) ⋅D (F r ⋆D Φ (f, w)) = Φ (r, u) ⋅D (F r ⋆D F θ ⋅D Φ (f, w))" by simp thus ?thesis using D.comp_assoc by simp qed also have "... = Φ (r, u) ⋅D (F r ⋆D F θ ⋅D Φ (f, w)) ⋅D aD[F r, F f, F w] ⋅D ((D.inv (Φ (r, f)) ⋅D F ρ ⋆D F w) ⋅D D.inv (Φ (g, w))) ⋅D F ν" proof - have "(D.inv (Φ (r, f)) ⋆D F w) ⋅D D.inv (Φ (r ⋆C f, w)) ⋅D F (ρ ⋆C w) = ((D.inv (Φ (r, f)) ⋆D F w) ⋅D (F ρ ⋆D F w)) ⋅D D.inv (Φ (g, w))" proof - have "D.inv (Φ (r ⋆C f, w)) ⋅D F (ρ ⋆C w) = (F ρ ⋆D F w) ⋅D D.inv (Φ (g, w))" proof - have "srcC (r ⋆C f) = trgC w" using ψ wθν 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 (Φ (r ⋆C f, w)) (F ρ ⋆D F w)" using ψ wθν cmp_in_hom(2) [of "r ⋆C f" w] C.VV.arr_charSbC FF_def by auto moreover have "Φ (r ⋆C f, w) ⋅D (F ρ ⋆D F w) = F (ρ ⋆C w) ⋅D Φ (g, w)" using ψ wθν Φ.naturality [of "(ρ, w)"] cmp_components_are_iso FF_def C.VV.arr_charSbC C.VV.dom_simp C.VV.cod_simp by simp moreover have "D.iso (Φ (r ⋆C f, w))" using wθν 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) ψ) moreover have "D.iso (Φ (g, w))" using wθν cmp_components_are_iso by (metis C.arrI C.hseqE C.seqE T.tab_simps(2) T.ide_leg1 T.leg1_simps(3) ψ) ultimately show ?thesis using ψ wθν Φ.naturality cmp_components_are_iso FF_def C.VV.arr_charSbC D.invert_opposite_sides_of_square by presburger qed thus ?thesis using D.comp_assoc by simp qed also have "... = (D.inv (Φ (r, f)) ⋅D F ρ ⋆D F w) ⋅D D.inv (Φ (g, w))" using ψ wθν 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 ‹We can now define the ‹w'›, ‹θ'›, and ‹ν'› that we are required to exhibit.› define φ' where "φ' = e'.trnr\<epsilon> u' (D.inv φ)" have "φ' = rD[u'] ⋅D (u' ⋆D ε') ⋅D aD[u', e', d'] ⋅D (D.inv φ ⋆D d')" unfolding φ'_def e'.trnr\<epsilon>_def by simp have φ': "«φ' : F u ⋆D d' ==>D u'¬" using φ φ'_def u u' e'.adjoint_transpose_right(2) [of u' "F u"] by auto have [simp]: "srcD φ' = srcD u'" using φ' by fastforce have [simp]: "trgD φ' = trgD u'" using φ' by fastforce define ψ' where "ψ' = d'.trnr\<eta> v' (D.inv ψ)" have ψ'_eq: "ψ' = (D.inv ψ ⋆D d') ⋅D aD-1[v', e', d'] ⋅D (v' ⋆D D.inv ε') ⋅D rD-1[v' unfolding ψ'_def d'.trnr\<eta>_def by simp have ψ': "«ψ' : v' ==>D F v ⋆D d'¬" using ψ ψ'_def v v' d'.adjoint_transpose_right(1) [of "F v" v'] by auto have iso_ψ': "D.iso ψ'" unfolding ψ'_def d'.trnr\<eta>_def using ψ 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 ψ'_eq ψ' d'.unit_simps(5) e'.antipar(1) e'.antipar(2) e'.ide_left e'.ide_right v') have [simp]: "srcD ψ' = srcD v'" using ψ' by fastforce have [simp]: "trgD ψ' = trgD v'" using ψ' by fastforce define w' where "w' = F w ⋆D d'" define θ' where "θ' = φ' ⋅D (F θ ⋅D Φ (f, w) ⋆D d') ⋅D aD-1[F f, F w, d']" define ν' where "ν' = aD[F g, F w, d'] ⋅D (D.inv (Φ (g, w)) ⋅D F ν ⋆D d') ⋅D ψ'" have w': "D.ide w' ∧ «w' : srcD u' →D srcD (F f)¬" using w'_def ψ wθν by simp have θ': "«θ' : F f ⋆D w' ==>D u'¬" unfolding θ'_def w'_def using φ' ψ wθν 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 ν': "«ν' : v' ==>D F g ⋆D w'¬" unfolding ν'_def w'_def using ψ' ψ wθν 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_ν': "D.iso ν'" using ν'_def iso_ψ' 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_i ν' ‹srcD (F w) = map0 a› ‹srcD e' = map0 a› ‹trgC w = srcC f› e'.antipar(1) e'.ide_right preserves_ide preserves_src preserves_trg wθν) have "T'.composite_cell w' θ' ⋅D ν' = ψ'" text ‹ $$ \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]{}\omi \ar[ddl] _{v'} \ar[ddr] ^{u'} \\ \\ \scriptstyle{{\rm trg}~(Fr)} & & \scriptstyle{{\rm src}~(Fr)} \ar[ll] ^{Fr} \\ & } \endxy $$ › proof - have 1: "«T'.composite_cell w' θ' ⋅D ν' : v' ==>D F r ⋆D u'¬" using w' θ' ν' wθν T'.composite_cell_in_hom by blast have "T'.composite_cell w' θ' ⋅D ν' = (F r ⋆D φ') ⋅D aD[F r, F u, d'] ⋅D (D.inv (Φ (r, u)) ⋆D d') ⋅D (F (T.composite_cell w θ ⋅C ν) ⋆D d') ⋅D ψ'" proof - have "T'.composite_cell w' θ' ⋅D ν' = (F r ⋆D φ' ⋅D (F θ ⋅D Φ (f, w) ⋆D d') ⋅D aD-1[F f, F w, d']) ⋅D aD[F r, F f, w'] ⋅D (D.inv (Φ (r, f)) ⋅D F ρ ⋆D w') ⋅D aD[F g, F w, d'] ⋅D (D.inv (Φ (g, w)) ⋅D F ν ⋆D d') ⋅D ψ'" using θ'_def ν'_def D.comp_assoc by simp also have "... = (F r ⋆D φ') ⋅D (F r ⋆D (F θ ⋅D Φ (f, w) ⋆D d') ⋅D aD-1[F f, F w, d']) ⋅D aD[F r, F f, F w ⋆D d'] ⋅D (D.inv (Φ (r, f)) ⋅D F ρ ⋆D F w ⋆D d') ⋅D aD[F g, F w, d'] ⋅D (D.inv (Φ (g, w)) ⋅D F ν ⋆D d') ⋅D ψ'" using θ' θ'_def w'_def D.comp_assoc D.whisker_left by auto also have "... = (F r ⋆D φ') ⋅D (F r ⋆D (F θ ⋆D d') ⋅D (Φ (f, w) ⋆D d') ⋅D aD-1[F f, F w, d']) ⋅D aD[F r, F f, F w ⋆D d'] ⋅D ((D.inv (Φ (r, f)) ⋅D F ρ ⋆D F w ⋆D d') ⋅D aD[F g, F w, d']) ⋅D (D.inv (Φ (g, w)) ⋅D F ν ⋆D d') ⋅D ψ'" using θ' θ'_def D.whisker_right cmp_in_hom D.comp_assoc by fastforce also have "... = (F r ⋆D φ') ⋅D (F r ⋆D (F θ ⋆D d') ⋅D (Φ (f, w) ⋆D d') ⋅D aD-1[F f, F w, d']) ⋅D aD[F r, F f, F w ⋆D d'] ⋅D aD[F r ⋆D F f, F w, d'] ⋅D ((D.inv (Φ (r, f)) ⋅D F ρ ⋆D F w) ⋆D d') ⋅D (D.inv (Φ (g, w)) ⋅D F ν ⋆D d') ⋅D ψ'" proof - have "(D.inv (Φ (r, f)) ⋅D F ρ ⋆D F w ⋆D d') ⋅D aD[F g, F w, d'] = aD[F r ⋆D F f, F w, d'] ⋅D ((D.inv (Φ (r, f)) ⋅D F ρ ⋆D F w) ⋆D d')" using D.assoc_naturality [of "D.inv (Φ (r, f)) ⋅D F ρ" "F w" d'] cmp_in_hom cmp_components_are_iso by (simp add: wθν) thus ?thesis using D.comp_assoc by simp qed also have "... = (F r ⋆D φ') ⋅D (F r ⋆D F θ ⋆D d') ⋅D (F r ⋆D Φ (f, w) ⋆D d') ⋅D ((F r ⋆D aD-1[F f, F w, d']) ⋅D aD[F r, F f, F w ⋆D d'] ⋅D aD[F r ⋆D F f, F w, d']) ⋅D ((D.inv (Φ (r, f)) ⋅D F ρ ⋆D F w) ⋆D d') ⋅D (D.inv (Φ (g, w)) ⋅D F ν ⋆D d') ⋅D ψ'" 1 D.wh D.comp_assoc by (metis D.arrI D.hseq_char D.seqE T'.ide_base calculation) also have "... = (F r ⋆D φ') ⋅D (F r ⋆D F θ ⋆D d') ⋅D ((F r ⋆D Φ (f, w) ⋆D d') ⋅D aD[F r, F f ⋆D F w, d']) ⋅D (aD[F r, F f, F w] ⋆D d') ⋅D ((D.inv (Φ (r, f)) ⋅D F ρ ⋆D F w) ⋆D d') ⋅D (D.inv (Φ (g, w)) ⋅D F ν ⋆D d') ⋅D ψ'" proof - have "D.seq aD[F r, F f, F w ⋆D d'] aD[F r ⋆D F f, F w, d']" by (metis 1 D.arrI D.seqE calculation) hence "(F r ⋆D aD-1[F f, F w, d']) ⋅D aD[F r, F f, F w ⋆D d'] ⋅D aD[F r ⋆D F f, F w, d'] = aD[F r, F f ⋆D F w, d'] ⋅D (aD[F r, F f, F w] ⋆D d')" using wθν D.pentagon D.invert_side_of_triangle(1) [of "aD[F r, F f, F w ⋆D d'] ⋅D aD[F r ⋆D F f, F w, d']" "F r ⋆D aD[F f, F w, d']" "aD[F r, F f ⋆D F w, d'] ⋅D (aD[F r, F f, F w] ⋆D d')"] by (simp add: wθν) thus ?thesis using D.comp_assoc by simp qed also have "... = (F r ⋆D φ') ⋅D ((F r ⋆D F θ ⋆D d') ⋅D aD[F r, F (f ⋆C w), d']) ⋅D ((F r ⋆D Φ (f, w)) ⋆D d') ⋅D (aD[F r, F f, F w] ⋆D d') ⋅D ((D.inv (Φ (r, f)) ⋅D F ρ ⋆D F w) ⋆D d') ⋅D (D.inv (Φ (g, w)) ⋅D F ν ⋆D d') ⋅D ψ'" proof - have "(F r ⋆D Φ (f, w) ⋆D d') ⋅D aD[F r, F f ⋆D F w, d'] = aD[F r, F (f ⋆C w), d'] ⋅D ((F r ⋆D Φ (f, w)) ⋆D d')" using 1 wθν D.assoc_naturality [of "F r" "Φ (f, w)" d'] ‹trgC w = srcC f› 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 ⋆D φ') ⋅D aD[F r, F u, d'] ⋅D (((F r ⋆D F θ) ⋆D d') ⋅D ((F r ⋆D Φ (f, w)) ⋆D d') ⋅D (aD[F r, F f, F w] ⋆D d') ⋅D ((D.inv (Φ (r, f)) ⋅D F ρ ⋆D F w) ⋆D d') ⋅D (D.inv (Φ (g, w)) ⋅D F ν ⋆D d')) ⋅D ψ'" proof - have "srcD (F r) = trgD (F θ)" using wθν by (metis C.arrI C.hseqE C.seqE ψ preserves_hseq) moreover have "srcD (F θ) = trgD d'" using wθν C.arrI C.vconn_implies_hpar(1) by auto ultimately have "(F r ⋆D F θ ⋆D d') ⋅D aD[F r, F (f ⋆C w), d'] = aD[F r, F u, d'] ⋅D ((F r ⋆D F θ) ⋆D d')" using wθν D.assoc_naturality [of "F r" "F θ" d'] by auto thus ?thesis using D.comp_assoc by simp qed also have "... = (F r ⋆D φ') ⋅D aD[F r, F u, d'] ⋅D (((F r ⋆D F θ) ⋅D (F r ⋆D Φ (f, w))) ⋅D aD[F r, F f, F w] ⋅D (D.inv (Φ (r, f)) ⋅D F ρ ⋆D F w) ⋅D D.inv (Φ (g, w)) ⋅D F ν ⋆D d') ⋅D ψ'" proof - have "((F r ⋆D F θ) ⋆D d') ⋅D ((F r ⋆D Φ (f, w)) ⋆D d') ⋅D (aD[F r, F f, F w] ⋆D d') ⋅D ((D.inv (Φ (r, f)) ⋅D F ρ ⋆D F w) ⋆D d') ⋅D (D.inv (Φ (g, w)) ⋅D F ν ⋆D d') = (F r ⋆D F θ) ⋅D (F r ⋆D Φ (f, w)) ⋅D aD[F r, F f, F w] ⋅D (D.inv (Φ (r, f)) ⋅D F ρ ⋆D F w) ⋅D D.inv (Φ (g, w)) ⋅D F ν ⋆D d'" proof - have "«(F r ⋆D F θ) ⋅D (F r ⋆D Φ (f, w)) ⋅D aD[F r, F f, F w] ⋅D (D.inv (Φ (r, f)) ⋅D F ρ ⋆D F w) ⋅D D.inv (Φ (g, w)) ⋅D F ν : F v ==>D F r ⋆D F u¬" using wθν ψ cmp_in_hom apply (intro D.comp_in_homI) apply auto by (intro D.hcomp_in_vhom, auto) hence "D.arr ((F r ⋆D F θ) ⋅D (F r ⋆D Φ (f, w)) ⋅D aD[F r, F f, F w] ⋅D (D.inv (Φ (r, f)) ⋅D F ρ ⋆D F w) ⋅D D.inv (Φ (g, w)) ⋅D F ν)" by auto thus ?thesis using D.whisker_right by fastforce qed thus ?thesis using D.comp_assoc by simp qed also have "... = (F r ⋆D φ') ⋅D aD[F r, F u, d'] ⋅D ((F r ⋆D F θ ⋅D Φ (f, w)) ⋅D aD[F r, F f, F w] ⋅D (D.inv (Φ (r, f)) ⋅D F ρ ⋆D F w) ⋅D D.inv (Φ (g, w)) ⋅D F ν ⋆D d') ⋅D ψ'" using wθν D.whisker_left cmp_in_hom by (metis D.seqI' T'.ide_base T.ide_leg0 ‹trgC w = srcC f› preserves_hom) also have "... = (F r ⋆D φ') ⋅D aD[F r, F u, d'] ⋅D ((D.inv (Φ (r, u)) ⋅D Φ (r, u) ⋅D (F r ⋆D F θ ⋅D Φ (f, w))) ⋅D aD[F r, F f, F w] ⋅D (D.inv (Φ (r, f)) ⋅D F ρ ⋆D F w) ⋅D D.inv (Φ (g, w)) ⋅D F ν ⋆D d') ⋅D ψ'" proof - have "(D.inv (Φ (r, u)) ⋅D Φ (r, u)) ⋅D (F r ⋆D F θ ⋅D Φ (f, w)) = F r ⋆D F θ ⋅D Φ (f, w)" proof - have "(D.inv (Φ (r, u)) ⋅D Φ (r, u)) ⋅D (F r ⋆D F θ ⋅D Φ (f, w)) = (F r ⋆D F u) ⋅D (F r ⋆D F θ ⋅D Φ (f, w))" using u cmp_components_are_iso by (simp add: D.comp_inv_arr') also have "... = F r ⋆D F θ ⋅D Φ (f, w)" using u ψ wθν cmp_in_hom ‹trgC u = srcC r› D.comp_cod_arr [of "F r ⋆D F θ ⋅D Φ (f, w)" "F r ⋆D F u"] by (metis (full_types) "*" D.arrI D.cod_comp D.seqE Fψ 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 ⋆D φ') ⋅D aD[F r, F u, d'] ⋅D (D.inv (Φ (r, u)) ⋅D Φ (r, u) ⋅D (F r ⋆D F θ ⋅D Φ (f, w)) ⋅D aD[F r, F f, F w] ⋅D (D.inv (Φ (r, f)) ⋅D F ρ ⋆D F w) ⋅D D.inv (Φ (g, w)) ⋅D F ν ⋆D d') ⋅D ψ'" using D.comp_assoc by simp also have "... = (F r ⋆D φ') ⋅D aD[F r, F u, d'] ⋅D (D.inv (Φ (r, u)) ⋆D d') ⋅D (Φ (r, u) ⋅D (F r ⋆D F θ ⋅D Φ (f, w)) ⋅D aD[F r, F f, F w] ⋅D (D.inv (Φ (r, f)) ⋅D F ρ ⋆D F w) ⋅D D.inv (Φ (g, w)) ⋅D F ν ⋆D d') ⋅D ψ'" proof - have "D.inv (Φ (r, u)) ⋅D Φ (r, u) ⋅D (F r ⋆D F θ ⋅D Φ (f, w)) ⋅D aD[F r, F f, F w] ⋅D (D.inv (Φ (r, f)) ⋅D F ρ ⋆D F w) ⋅D D.inv (Φ (g, w)) ⋅D F ν ⋆D d' = (D.inv (Φ (r, u)) ⋆D d') ⋅D (Φ (r, u) ⋅D (F r ⋆D F θ ⋅D Φ (f, w)) ⋅D aD[F r, F f, F w] ⋅D (D.inv (Φ (r, f)) ⋅D F ρ ⋆D F w) ⋅D D.inv (Φ (g, w)) ⋅D F ν ⋆D d')" using D.whisker_right cmp_in_hom cmp_components_are_iso by (metis * D.arrI D.invert_side_of_triangle(1) Fψ T.ide_base ψ ‹trgC u = srcC r› e'.ide_right u wθν) thus ?thesis using D.comp_assoc by simp qed also have "... = (F r ⋆D φ') ⋅D aD[F r, F u, d'] ⋅D (D.inv (Φ (r, u)) ⋆D d') ⋅D (F (T.composite_cell w θ ⋅C ν) ⋆D d') ⋅D ψ'" using D.comp_assoc * by simp finally show ?thesis by simp qed also have "... = (F r ⋆D φ') ⋅D aD[F r, F u, d'] ⋅D (D.inv (Φ (r, u)) ⋆D d') ⋅D (F ψ ⋆D d') ⋅D ψ'" using wθν by simp also have "... = (F r ⋆D φ') ⋅D aD[F r, F u, d'] ⋅D (D.inv (Φ (r, u)) ⋆D d') ⋅D (Φ (r, u) ⋅D (F r ⋆D φ) ⋅D aD[F r, u', e'] ⋅D (ψ' ⋆D e') ⋅D ψ ⋆D d') ⋅D ψ'" using ψ Fψ_def by simp text ‹ $$ \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{ \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 $$ › also have "... = ψ'" text ‹ $$ \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 $$ › proof - have "(F r ⋆D φ') ⋅D aD[F r, F u, d'] ⋅D (D.inv (Φ (r, u)) ⋆D d') ⋅D (Φ (r, u) ⋅D (F r ⋆D φ) ⋅D aD[F r, u', e'] ⋅D (ψ' ⋆D e') ⋅D ψ ⋆D d') ⋅D ψ' = (F r ⋆D φ') ⋅D aD[F r, F u, d'] ⋅D ((D.inv (Φ (r, u)) ⋆D d') ⋅D (Φ (r, u) ⋆D d')) ⋅D ((F r ⋆D φ) ⋅D aD[F r, u', e'] ⋅D (ψ' ⋆D e') ⋅D ψ ⋆D d') ⋅D ψ'" using D.whisker_right cmp_in_hom D.comp_assoc by (metis D.arrI Fψ Fψ_def e'.ide_right) also have "... = (F r ⋆D φ') ⋅D aD[F r, F u, d'] ⋅D ((F r ⋆D φ) ⋅D aD[F r, u', e'] ⋅D (ψ' ⋆D e') ⋅D ψ ⋆D d') ⋅D ψ'" proof - have "(D.inv (Φ (r, u)) ⋆D d') ⋅D (Φ (r, u) ⋆D d') = D.inv (Φ (r, u)) ⋅D Φ (r, u) ⋆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) ‹trgC u = srcC r› e'.ide_right preserves_arr u) also have "... = (F r ⋆D F u) ⋆D d'" using u cmp_components_are_iso D.comp_inv_arr' by simp finally have "(F r ⋆D φ') ⋅D aD[F r, F u, d'] ⋅D ((D.inv (Φ (r, u)) ⋆D d') ⋅D (Φ (r, u) ⋆D d')) ⋅D ((F r ⋆D φ) ⋅D aD[F r, u', e'] ⋅D (ψ' ⋆D e') ⋅D ψ ⋆D d') ⋅D ψ' = (F r ⋆D φ') ⋅D aD[F r, F u, d'] ⋅D ((F r ⋆D F u) ⋆D d') ⋅D ((F r ⋆D φ) ⋅D aD[F r, u', e'] ⋅D (ψ' ⋆D e') ⋅D ψ ⋆D d') ⋅D ψ'" by simp also have "... = (F r ⋆D φ') ⋅D (aD[F r, F u, d'] ⋅D ((F r ⋆D F u) ⋆D d')) ⋅D ((F r ⋆D φ) ⋅D aD[F r, u', e'] ⋅D (ψ' ⋆D e') ⋅D ψ ⋆D d') ⋅D ψ'" using D.comp_assoc by auto also have "... = (F r ⋆D φ') ⋅D aD[F r, F u, d'] ⋅D ((F r ⋆D φ) ⋅D aD[F r, u', e'] ⋅D (ψ' ⋆D e') ⋅D ψ ⋆D d') ⋅D ψ'" using u D.comp_arr_dom by simp finally show ?thesis by blast qed also have "... = (F r ⋆D φ') ⋅D (aD[F r, F u, d'] ⋅D ((F r ⋆D φ) ⋆D d')) ⋅D (aD[F r, u', e'] ⋆D d') ⋅D ((ψ' ⋆D e') ⋆D d') ⋅D (ψ ⋆D d') ⋅D ψ'" proof - have "(F r ⋆D φ) ⋅D aD[F r, u', e'] ⋅D (ψ' ⋆D e') ⋅D ψ ⋆D d' = ((F r ⋆D φ) ⋆D d') ⋅D (aD[F r, u', e'] ⋆D d') ⋅D ((ψ' ⋆D e') ⋆D d') ⋅D (ψ ⋆D d')" using D.whisker_right φ φ' e' e'.antipar(1) u' u'_in_hhom by (metis D.arrI D.seqE Fψ Fψ_def e'.ide_right) thus ?thesis using D.comp_assoc by simp qed also have "... = (F r ⋆D φ') ⋅D (F r ⋆D φ ⋆D d') ⋅D aD[F r, u' ⋆D e', d'] ⋅D ((aD[F r, u', e'] ⋆D d') ⋅D ((ψ' ⋆D e') ⋆D d')) ⋅D (ψ ⋆D d') ⋅D ψ'" proof - have "aD[F r, F u, d'] ⋅D ((F r ⋆D φ) ⋆D d') = (F r ⋆D φ ⋆D d') ⋅D aD[F r, u' ⋆D e', d']" using D.assoc_naturality [of "F r" φ d'] φ by auto thus ?thesis using D.comp_assoc by simp qed also have "... = (F r ⋆D φ') ⋅D (F r ⋆D φ ⋆D d') ⋅D aD[F r, u' ⋆D e', d'] ⋅D ((aD[F r, u', e'] ⋆D d') ⋅D (aD-1[F r ⋆D u', e', d'] ⋅D (ψ' ⋆D e' ⋆D d') ⋅D aD[v', e', d'])) ⋅D (ψ ⋆D d') ⋅D ψ'" using Fψ Fψ_def ψ' D.comp_assoc D.hcomp_reassoc(1) [of ψ' e' d'] by (elim D.in_homE, simp) also have "... = (F r ⋆D φ') ⋅D (F r ⋆D φ ⋆D d') ⋅D (F r ⋆D aD-1[u', e', d']) ⋅D aD[F r, u', e' ⋆D d'] ⋅D (ψ' ⋆D e' ⋆D d') ⋅D aD[v', e', d'] ⋅D (ψ ⋆D d') ⋅D ψ'" proof - have "D.seq (F r ⋆D aD[u', e', d']) (aD[F r, u' ⋆D e', d'] ⋅D (aD[F r, u', e'] ⋆D d'))" using u' by simp moreover have "(F r ⋆D aD[u', e', d']) ⋅D aD[F r, u' ⋆D e', d'] ⋅D (aD[F r, u', e'] ⋆D d') = aD[F r, u', e' ⋆D d'] ⋅D aD[F r ⋆D u', e', d']" using u' D.pentagon by simp moreover have "D.iso (F r ⋆D aD[u', e', d'])" using u' by simp moreover have "D.inv (F r ⋆D aD[u', e', d']) = F r ⋆D aD-1[u', e', d']" using u' by simp ultimately have "aD[F r, u' ⋆D e', d'] ⋅D (aD[F r, u', e'] ⋆D d') ⋅D aD-1[F r ⋆D u', e', d'] = (F r ⋆D aD-1[u', e', d']) ⋅D aD[F r, u', e' ⋆D d']" using u' D.comp_assoc D.invert_opposite_sides_of_square [of "F r ⋆D aD[u', e', d']" "aD[F r, u' ⋆D e', d'] ⋅D (aD[F r, u', e'] ⋆D d')" "aD[F r, u', e' ⋆D d']" "aD[F r ⋆D u', e', d']"] by simp thus ?thesis using D.comp_assoc by metis qed also have "... = (F r ⋆D rD[u'] ⋅D (u' ⋆D ε') ⋅D aD[u', e', d'] ⋅D (D.inv φ ⋆D d')) ⋅D (F r ⋆D φ ⋆D d') ⋅D (F r ⋆D aD-1[u', e', d']) ⋅D aD[F r, u', e' ⋆D d'] ⋅D (ψ' ⋆D e' ⋆D d') ⋅D aD[v', e', d'] ⋅D (ψ ⋆D d') ⋅D (D.inv ψ ⋆D d') ⋅D aD-1[v', e', d'] ⋅D (v' ⋆D D.inv ε') ⋅D rD-1[v']" unfolding φ'_def ψ'_def e'.trnr\<epsilon>_def d'.trnr\<eta>_def by simp also have "... = (F r ⋆D rD[u']) ⋅D (F r ⋆D u' ⋆D ε') ⋅D (F r ⋆D aD[u', e', d']) ⋅D (F r ⋆D D.inv φ ⋆D d') ⋅D (F r ⋆D φ ⋆D d') ⋅D (F r ⋆D aD-1[u', e', d']) ⋅D aD[F r, u', e' ⋆D d'] ⋅D (ψ' ⋆D e' ⋆D d') ⋅D aD[v', e', d'] ⋅D (ψ ⋆D d') ⋅D (D.inv ψ ⋆D d') ⋅D aD-1[v', e', d'] ⋅D (v' ⋆D D.inv ε') ⋅D rD-1[v']" proof - have "F r ⋆D rD[u'] ⋅D (u' ⋆D ε') ⋅D aD[u', e', d'] ⋅D (D.inv φ ⋆D d') = (F r ⋆D rD[u']) ⋅D (F r ⋆D u' ⋆D ε') ⋅D (F r ⋆D aD[u', e', d']) ⋅D (F r ⋆D D.inv φ ⋆D d')" proof - have "D.ide (F r)" by simp moreover have "D.seq rD[u'] ((u' ⋆D ε') ⋅D aD[u', e', d'] ⋅D (D.inv φ ⋆D d')) ∧ D.seq (u' ⋆D ε') (aD[u', e', d'] ⋅D (D.inv φ ⋆D d')) ∧ D.seq aD[u', e', d'] (D.inv φ ⋆D d')" using φ' φ'_def unfolding e'.trnr\<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 ⋆D rD[u']) ⋅D (F r ⋆D u' ⋆D ε') ⋅D (F r ⋆D aD[u', e', d']) ⋅D (((F r ⋆D D.inv φ ⋆D d') ⋅D (F r ⋆D φ ⋆D d')) ⋅D (F r ⋆D aD-1[u', e', d'])) ⋅D aD[F r, u', e' ⋆D d'] ⋅D (ψ' ⋆D e' ⋆D d') ⋅D aD[v', e', d'] ⋅D (((ψ ⋆D d') ⋅D (D.inv ψ ⋆D d')) ⋅D aD-1[v', e', d']) ⋅D (v' ⋆D D.inv ε') ⋅D rD-1[v']" using D.comp_assoc by simp also have "... = (F r ⋆D rD[u']) ⋅D (F r ⋆D u' ⋆D ε') ⋅D (F r ⋆D aD[u', e', d']) ⋅D (F r ⋆D aD-1[u', e', d']) ⋅D aD[F r, u', e' ⋆D d'] ⋅D (ψ' ⋆D e' ⋆D d') ⋅D ((aD[v', e', d'] ⋅D aD-1[v', e', d']) ⋅D (v' ⋆D D.inv ε')) ⋅D rD-1[v']" proof - have "((F r ⋆D D.inv φ ⋆D d') ⋅D (F r ⋆D φ ⋆D d')) ⋅D (F r ⋆D aD-1[u', e', d']) = F r ⋆D aD-1[u', e', d']" proof - have "(F r ⋆D D.inv φ ⋆D d') ⋅D (F r ⋆D φ ⋆D d') = F r ⋆D D.inv φ ⋅D φ ⋆D d'" using u u' φ 1 2 D.src_dom e'.antipar D.whisker_left D.whisker_right by auto also have "... = F r ⋆D (u' ⋆D e') ⋆D d'" using φ D.comp_inv_arr' by auto finally have "(F r ⋆D D.inv φ ⋆D d') ⋅D (F r ⋆D φ ⋆D d') = F r ⋆D (u' ⋆D e') ⋆D d'" by simp hence "((F r ⋆D D.inv φ ⋆D d') ⋅D (F r ⋆D φ ⋆D d')) ⋅D (F r ⋆D aD-1[u', e', d']) = (F r ⋆D (u' ⋆D e') ⋆D d') ⋅D (F r ⋆D aD-1[u', e', d'])" using D.comp_assoc by simp also have "... = F r ⋆D aD-1[u', e', d']" proof - have "«F r ⋆D aD-1[u', e', d'] : F r ⋆D u' ⋆D e' ⋆D d' ==>D F r ⋆D (u' ⋆D e') ⋆D d'¬" using u' e'.antipar φ' D.assoc'_in_hom unfolding e'.trnr\<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 "((ψ ⋆D d') ⋅D (D.inv ψ ⋆D d')) ⋅D aD-1[v', e', d'] = aD-1[v', e', d']" proof - have "(ψ ⋆D d') ⋅D (D.inv ψ ⋆D d') = (v' ⋆D e') ⋆D d'" using ψ e'.antipar D.src_cod v' e'.antipar ψ' d'.trnr\<eta>_def D.whisker_right [of d' ψ "D.inv ψ"] D.comp_arr_inv' by auto moreover have "«aD-1[v', e', d'] : v' ⋆D e' ⋆D d' ==>D (v' ⋆D e') ⋆D d'¬" using v' e'.antipar ψ' D.assoc'_in_hom unfolding d'.trnr\<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 ⋆D rD[u']) ⋅D (F r ⋆D u' ⋆D ε') ⋅D (((F r ⋆D aD[u', e', d']) ⋅D (F r ⋆D aD-1[u', e', d'])) ⋅D aD[F r, u', e' ⋆D d']) ⋅D (ψ' ⋆D e' ⋆D d') ⋅D (v' ⋆D D.inv ε') ⋅D rD-1[v']" proof - have "(aD[v', e', d'] ⋅D aD-1[v', e', d']) ⋅D (v' ⋆D D.inv ε') = v' ⋆D D.inv ε'" proof - have 1: "D.hseq v' e'" using v' e'.antipar ψ' unfolding d'.trnr\<eta>_def by fastforce have "aD[v', e', d'] ⋅D aD-1[v', e', d'] = v' ⋆D e' ⋆D d'" using v' e'.antipar 1 D.comp_assoc_assoc' by auto moreover have "«v' ⋆D D.inv ε' : v' ⋆D trgD e' ==>D v' ⋆D e' ⋆D d'¬" using v' e'.antipar 1 apply (intro D.hcomp_in_vhom) apply auto by (metis D.ideD(1) D.trg_src ‹trgD e' = a'› 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 ⋆D rD[u']) ⋅D ((F r ⋆D u' ⋆D ε') ⋅D aD[F r, u', e' ⋆D d']) ⋅D (ψ' ⋆D e' ⋆D d') ⋅D (v' ⋆D D.inv ε') ⋅D rD-1[v']" proof - have "((F r ⋆D aD[u', e', d']) ⋅D (F r ⋆D aD-1[u', e', d'])) ⋅D aD[F r, u', e' ⋆D d'] = aD[F r, u', e' ⋆D d']" using φ u' e'.antipar 1 D.comp_cod_arr D.comp_assoc_assoc' D.whisker_left [of "F r" "aD[u', e', d']" "aD-1[u', e', d']"] by auto thus ?thesis using D.comp_assoc by simp qed also have "... = (F r ⋆D rD[u']) ⋅D aD[F r, u', trgD e'] ⋅D (((F r ⋆D u') ⋆D ε') ⋅D (ψ' ⋆D e' ⋆D d')) ⋅D (v' ⋆D D.inv ε') ⋅D rD-1[v']" proof - have "(F r ⋆D u' ⋆D ε') ⋅D aD[F r, u', e' ⋆D d'] = aD[F r, u', trgD e'] ⋅D ((F r ⋆D u') ⋆D ε')" using D.assoc_naturality [of "F r" u' ε'] e' u' u'_in_hhom by force thus ?thesis using D.comp_assoc by simp qed also have "... = (F r ⋆D rD[u']) ⋅D aD[F r, u', trgD e'] ⋅D (ψ' ⋆D trgD e') ⋅D ((v' ⋆D ε') ⋅D (v' ⋆D D.inv ε')) ⋅D rD-1[v']" proof - have "((F r ⋆D u') ⋆D ε') ⋅D (ψ' ⋆D e' ⋆D d') = (ψ' ⋆D trgD e') ⋅D (v' ⋆D ε')" proof - have "((F r ⋆D u') ⋆D ε') ⋅D (ψ' ⋆D e' ⋆D d') = ((F r ⋆D u') ⋅D ψ' ⋆D ε' ⋅D (e' ⋆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) ψ' e'.counit_simps(1) e'.counit_simps(2) preserves_src u' u'_in_hhom) also have "... = ψ' ⋅D v' ⋆D trgD e' ⋅D ε'" using ψ' D.comp_arr_dom D.comp_cod_arr by auto also have "... = (ψ' ⋆D trgD e') ⋅D (v' ⋆D ε')" using D.interchange by (metis D.arrI D.comp_cod_arr D.ide_char D.seqI ψ' ‹trgD e' = a'› 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 ⋆D rD[u']) ⋅D aD[F r, u', trgD e'] ⋅D (ψ' ⋆D trgD e') ⋅D rD-1[v']" proof - have "(v' ⋆D ε') ⋅D (v' ⋆D D.inv ε') = v' ⋆D trgD 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 "«rD-1[v'] : v' ==>D v' ⋆D trgD e'¬" using v' 1 by simp ultimately show ?thesis using v' D.comp_cod_arr by auto qed also have "... = (F r ⋆D rD[u']) ⋅D (aD[F r, u', trgD e'] ⋅D rD-1[F r ⋆D u']) ⋅D ψ'" using u' v' ψ' D.runit'_naturality D.comp_assoc by (metis D.in_hhomE D.in_homE a'_def e') also have "... = (F r ⋆D rD[u']) ⋅D (F r ⋆D rD-1[u']) ⋅D ψ'" using 1 T'.ide_base u' D.runit_hcomp [of "F r" u'] by fastforce also have "... = ((F r ⋆D rD[u']) ⋅D (F r ⋆D rD-1[u'])) ⋅D ψ'" using D.comp_assoc by simp also have "... = (F r ⋆D rD[u'] ⋅D rD-1[u']) ⋅D ψ'" using 1 T'.ide_base u' D.whisker_left by simp also have "... = (F r ⋆D u') ⋅D ψ'" 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 "... = ψ'" using ψ' D.comp_cod_arr by auto finally show ?thesis by simp qed finally show ?thesis by simp qed thus "∃w' θ' ν'. D.ide w' ∧ «θ' : F f ⋆D w' ==>D u'¬ ∧ «ν' : D.dom ψ' ==>D F g ⋆D w'¬ ∧ D.iso ν' ∧ T'.composite_cell w' θ' ⋅D ν' = ψ'" using w' θ' ν' iso_ν' v'_def by blast qed text ‹Now we establish ‹T'.T2›.› next fix u w w' θ θ' β assume w: "D.ide w" assume w': "D.ide w'" assume θ: "«θ : F f ⋆D w ==>D u¬" assume θ': "«θ' : F f ⋆D w' ==>D u¬" assume β: "«β : F g ⋆D w ==>D F g ⋆D w'¬" assume eq: "T'.composite_cell w θ = T'.composite_cell w' θ' ⋅D β" show "∃!γ. «γ : w ==>D w'¬ ∧ β = F g ⋆D γ ∧ θ = θ' ⋅D (F f ⋆D γ)" proof - define a where "a = srcD w" have a: "D.obj a" unfolding a_def by (simp add: w) have [simp]: "srcD θ = a" using θ a_def by (metis D.dom_src D.in_homE D.src.preserves_dom D.src.preserves_reflects_arr D.src_hcomp) have [simp]: "trgD θ = trgD (F f)" using θ by (metis D.arr_dom D.in_homE D.trg_hcomp D.vconn_implies_hpar(2)) have [simp]: "srcD θ' = a" using θ' a_def by (metis D.horizontal_homs_axioms D.in_homE ‹srcD θ = a› θ horizontal_homs.src_co have [simp]: "trgD θ' = trgD (F f)" using θ' by (metis D.vconn_implies_hpar(2) D.vconn_implies_hpar(4) ‹trgD θ = trgD (F f)› θ) have [simp]: "srcD w = a" using a_def by simp have [simp]: "trgD w = map0 (srcC ρ)" by (metis D.horizontal_homs_axioms D.hseq_char D.in_homE T.tab_simps(2) T.leg0_s θ category.ideD(1) category.ide_dom horizontal_homs_def preserves_src) have [simp]: "srcD w' = a" using a_def by (metis D.ideD(1) D.in_homE D.src_hcomp D.vconn_implies_hpar(1) ‹srcD θ' = a› θ' category.ide_dom horizontal_homs_def weak_arrow_of_homs_axioms weak_arrow_of_homs_def) have [simp]: "trgD w' = map0 (srcC ρ)" by (metis D.horizontal_homs_axioms D.hseq_char D.in_homE T.tab_simps(2) T.leg0_s θ' category.ideD(1) category.ide_dom horizontal_homs_def preserves_src) text ‹First, reflect the picture back to ‹C›, so that we will be able to apply ‹ We need to choose arrows in ‹C› carefully, so that their ‹F› images will enable cancellation of the various isomorphisms that appear.› obtain aC where aC: "C.obj aC ∧ D.equivalent_objects (map0 aC) a" using w a_def biessentially_surjective_on_objects D.obj_src D.ideD(1) by presburger obtain e where e: "«e : map0 aC →D a¬ ∧ D.equivalence_map e" using aC D.equivalent_objects_def by auto obtain d η ε where dηε: "adjoint_equivalence_in_bicategory (⋅D) (⋆D) aD iD srcD trgD e d η ε" using e D.equivalence_map_extends_to_adjoint_equivalence by blast interpret e: adjoint_equivalence_in_bicategory ‹(⋅D)› ‹(⋆D)› aD iD srcD trgD e d using dηε by auto interpret d: adjoint_equivalence_in_bicategory ‹(⋅D)› ‹(⋆D)› aD iD srcD trgD d e "D.inv ε" "D.inv η" using e.dual_adjoint_equivalence by simp have [simp]: "srcD e = map0 aC" using e by auto have [simp]: "trgD e = a" using e by auto have [simp]: "srcD d = a" using e.antipar by simp have [simp]: "trgD d = map0 aC" using e.antipar by simp have we: "«w ⋆D e : map0 aC →D map0 (srcC ρ)¬" using aC e D.ideD(1) ‹trgD w = map0 (srcC ρ)› a_def by blast obtain wC where wC: "C.ide wC ∧ «wC : aC →C srcC ρ¬ ∧ D.isomorphic (F wC) (w ⋆D e)" using aC e we locally_essentially_surjective [of aC "srcC ρ" "w ⋆D e"] C.obj_src T.tab_simps(1) e.ide_left w by blast have w'e: "«w' ⋆D e : map0 aC →D map0 (srcC ρ)¬" using aC e D.ideD(1) ‹trgD w' = map0 (srcC ρ)› a_def ‹srcD w' = a› w' by blast obtain wC' where wC': "C.ide wC' ∧ «wC' : aC →C srcC ρ¬ ∧ D.isomorphic (F wC') (w' ⋆D e)" using aC 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]: "srcC wC = aC" using wC by auto have [simp]: "trgC wC = srcC ρ" using wC by auto have [simp]: "srcC wC' = aC" using wC' by auto have [simp]: "trgC wC' = srcC ρ" using wC' by auto obtain φ where φ: "«φ : F wC ==>D w ⋆D e¬ ∧ D.iso φ" using wC D.isomorphicE by blast obtain φ' where φ': "«φ' : F wC' ==>D w' ⋆D e¬ ∧ D.iso φ'" using wC' D.isomorphicE by blast have ue: "«u ⋆D e : map0 aC →D map0 (trgC f)¬ ∧ D.ide (u ⋆D e)" using aC e θ e.ide_left by (intro conjI, auto) obtain uC where uC: "C.ide uC ∧ «uC : aC →C trgC f¬ ∧ D.isomorphic (F uC) (u ⋆D e)" using aC e ue locally_essentially_surjective [of aC "trgC f" "u ⋆D e"] by auto have [simp]: "srcC uC = aC" using uC by auto have [simp]: "trgC uC = trgC f" using uC by auto obtain ψ where ψ: "«ψ : u ⋆D e ==>D F uC¬ ∧ D.iso ψ" using uC D.isomorphic_symmetric D.isomorphicE by blast define FθC where "FθC = ψ ⋅D (θ ⋆D e) ⋅D aD-1[F f, w, e] ⋅D (F f ⋆D φ) ⋅D D.inv (Φ (f, wC))" have 1: "«FθC : F (f ⋆C wC) ==>D F uC¬" proof (unfold FθC_def, intro D.comp_in_homI) show "«D.inv (Φ (f, wC)) : F (f ⋆C wC) ==>D F f ⋆D F wC¬" by (simp add: cmp_in_hom(2) wC) show "«F f ⋆D φ : F f ⋆D F wC ==>D F f ⋆D w ⋆D e¬" using w wC φ by (intro D.hcomp_in_vhom, auto) show "«aD-1[F f, w, e] : F f ⋆D w ⋆D e ==>D (F f ⋆D w) ⋆D e¬" using w D.assoc'_in_hom by simp show "«θ ⋆D e : (F f ⋆D w) ⋆D e ==>D u ⋆D e¬" using w θ by (intro D.hcomp_in_vhom, auto) show "«ψ : u ⋆D e ==>D F uC¬" using ψ by simp qed have 2: "∃θC. «θC : f ⋆C wC ==>C uC¬ ∧ F θC = FθC" using uC wC 1 e θ φ locally_full by simp obtain θC where θC: "«θC : f ⋆C wC ==>C uC¬ ∧ F θC = FθC" using 2 by auto define FθC' where "FθC' = ψ ⋅D (θ' ⋆D e) ⋅D aD-1[F f, w', e] ⋅D (F f ⋆D φ') ⋅D D.inv (Φ (f, wC'))" have 1: "«FθC' : F (f ⋆C wC') ==>D F uC¬" proof (unfold FθC'_def, intro D.comp_in_homI) show "«D.inv (Φ (f, wC')) : F (f ⋆C wC') ==>D F f ⋆D F wC'¬" by (simp add: cmp_in_hom(2) wC') show "«F f ⋆D φ' : F f ⋆D F wC' ==>D F f ⋆D w' ⋆D e¬" using w' wC' φ' by (intro D.hcomp_in_vhom, auto) show "«aD-1[F f, w', e] : F f ⋆D w' ⋆D e ==>D (F f ⋆D w') ⋆D e¬" using w' D.assoc'_in_hom by simp show "«θ' ⋆D e : (F f ⋆D w') ⋆D e ==>D u ⋆D e¬" using w' θ' by (intro D.hcomp_in_vhom, auto) show "«ψ : u ⋆D e ==>D F uC¬" using ψ by simp qed have 2: "∃θC'. «θC' : f ⋆C wC' ==>C uC¬ ∧ F θC' = FθC'" using uC wC' 1 e θ φ locally_full by simp obtain θC' where θC': "«θC' : f ⋆C wC' ==>C uC¬ ∧ F θC' = FθC'" using 2 by auto define FβC where "FβC = Φ (g, wC') ⋅D (F g ⋆D D.inv φ') ⋅D aD[F g, w', e] ⋅D (β ⋆D e) ⋅D aD-1[F g, w, e] ⋅D (F g ⋆D φ) ⋅D D.inv (Φ (g, wC))" have FβC: "«FβC: F (g ⋆C wC) ==>D F (g ⋆C wC')¬" proof (unfold FβC_def, intro D.comp_in_homI) show "«D.inv (Φ (g, wC)) : F (g ⋆C wC) ==>D F g ⋆D F wC¬" by (simp add: cmp_in_hom(2) wC) show "«F g ⋆D φ : F g ⋆D F wC ==>D F g ⋆D w ⋆D e¬" using wC φ apply (intro D.hcomp_in_vhom) by auto show "«aD-1[F g, w, e] : F g ⋆D w ⋆D e ==>D (F g ⋆D w) ⋆D e¬" using w D.assoc'_in_hom by simp show "«β ⋆D e : (F g ⋆D w) ⋆D e ==>D (F g ⋆D w') ⋆D e¬" using w β apply (intro D.hcomp_in_vhom) by auto show "«aD[F g, w', e] : (F g ⋆D w') ⋆D e ==>D F g ⋆D w' ⋆D e¬" using w' e.antipar D.assoc_in_hom by simp show "«F g ⋆D D.inv φ' : F g ⋆D w' ⋆D e ==>D F g ⋆D F wC'¬" using w' wC' φ' by (intro D.hcomp_in_vhom, auto) show "«Φ (g, wC') : F g ⋆D F wC' ==>D F (g ⋆C wC')¬" using wC' cmp_in_hom by simp qed have 1: "∃βC. «βC : g ⋆C wC ==>C g ⋆C wC'¬ ∧ F βC = FβC" using wC wC' FβC locally_full by simp obtain βC where βC: "«βC : g ⋆C wC ==>C g ⋆C wC'¬ ∧ F βC = FβC" using 1 by auto text ‹ The following is the main calculation that needs to be done, to permit us to apply ‹T.T2›. Once again, it started out looking simple, but once all the necessary isomorphisms are thrown in it looks much more complicated. › have *: "T.composite_cell wC θC = T.composite_cell wC' θC' ⋅C βC" proof - have par: "C.par (T.composite_cell wC θC) (T.composite_cell wC' θC' ⋅C βC)" proof - have "«T.composite_cell wC θC : g ⋆C wC ==>C r ⋆C uC¬" using wC θC T.composite_cell_in_hom by simp moreover have "«T.composite_cell wC' θC' ⋅C βC : g ⋆C wC ==>C r ⋆C uC¬" proof (intro C.comp_in_homI) show "«βC : g ⋆C wC ==>C g ⋆C wC'¬" using βC by simp show "«ρ ⋆C wC' : g ⋆C wC' ==>C (r ⋆C f) ⋆C wC'¬" using wC' by (intro C.hcomp_in_vhom, auto) show "«aC[r, f, wC'] : (r ⋆C f) ⋆C wC' ==>C r ⋆C f ⋆C wC'¬" using wC' C.assoc_in_hom by simp show "«r ⋆C θC' : r ⋆C f ⋆C wC' ==>C r ⋆C uC¬" using wC' θC' by (intro C.hcomp_in_vhom, auto) qed ultimately show ?thesis by (metis C.in_homE) qed moreover have "F (T.composite_cell wC θC) = F (T.composite_cell wC' θC' ⋅C βC)" proof - have "F (T.composite_cell wC θC) = F (r ⋆C θC) ⋅D F aC[r, f, wC] ⋅D F (ρ ⋆C wC)" using par by auto also have "... = (Φ (r, uC) ⋅D (F r ⋆D F θC) ⋅D D.inv (Φ (r, f ⋆C wC))) ⋅D (Φ (r, f ⋆C wC) ⋅D (F r ⋆D Φ (f, wC)) ⋅D aD[F r, F f, F wC] ⋅D (D.inv (Φ (r, f)) ⋆D F wC) ⋅D D.inv (Φ (r ⋆C f, wC))) ⋅D (Φ (r ⋆C f, wC) ⋅D (F ρ ⋆D F wC) ⋅D D.inv (Φ (g, wC)))" proof - have "srcC f = trgC wC ∧ C.hseq r θC ∧ C.hseq ρ wC" using par by auto thus ?thesis using wC θ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 "... = Φ (r, uC) ⋅D (F r ⋆D F θC) ⋅D (((D.inv (Φ (r, f ⋆C wC))) ⋅D (Φ (r, f ⋆C wC))) ⋅D (F r ⋆D Φ (f, wC))) ⋅D aD[F r, F f, F wC] ⋅D (D.inv (Φ (r, f)) ⋆D F wC) ⋅D ((D.inv (Φ (r ⋆C f, wC))) ⋅D (Φ (r ⋆C f, wC)) ⋅D (F ρ ⋆D F wC)) ⋅D D.inv (Φ (g, wC))" using D.comp_assoc by simp also have "... = Φ (r, uC) ⋅D ((F r ⋆D F θC) ⋅D (F r ⋆D Φ (f, wC))) ⋅D aD[F r, F f, F wC] ⋅D ((D.inv (Φ (r, f)) ⋆D F wC) ⋅D (F ρ ⋆D F wC)) ⋅D D.inv (Φ (g, wC))" proof - have "(D.inv (Φ (r ⋆C f, wC)) ⋅D Φ (r ⋆C f, wC)) ⋅D (F ρ ⋆D F wC) = F ρ ⋆D F wC" using wC ‹trgC wC = srcC ρ› D.comp_inv_arr' cmp_in_hom cmp_components_are_iso D.comp_cod_arr by simp moreover have "((D.inv (Φ (r, f ⋆C wC))) ⋅D (Φ (r, f ⋆C wC))) ⋅D (F r ⋆D Φ (f, wC)) = F r ⋆D Φ (f, wC)" using wC 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 "... = Φ (r, uC) ⋅D (F r ⋆D F θC ⋅D Φ (f, wC)) ⋅D aD[F r, F f, F wC] ⋅D (?ρ' ⋆D F wC) ⋅D D.inv (Φ (g, wC))" proof - have "(F r ⋆D F θC) ⋅D (F r ⋆D Φ (f, wC)) = F r ⋆D F θC ⋅D Φ (f, wC)" using θC wC 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 (Φ (r, f)) ⋆D F wC) ⋅D (F ρ ⋆D F wC) = ?ρ' ⋆D F wC" using D.whisker_right by (simp add: wC) ultimately show ?thesis using D.comp_assoc by simp qed also have "... = Φ (r, uC) ⋅D (F r ⋆D ψ ⋅D (θ ⋆D e) ⋅D aD-1[F f, w, e] ⋅D (F f ⋆D φ) ⋅D D.inv (Φ (f, wC)) ⋅D Φ (f, wC)) ⋅D aD[F r, F f, F wC] ⋅D (?ρ' ⋆D F wC) ⋅D D.inv (Φ (g, wC))" using θC FθC_def D.comp_assoc by simp also have "... = Φ (r, uC) ⋅D (F r ⋆D ψ) ⋅D (F r ⋆D θ ⋆D e) ⋅D (F r ⋆D aD-1[F f, w, e]) ⋅D ((F r ⋆D F f ⋆D φ) ⋅D aD[F r, F f, F wC]) ⋅D (?ρ' ⋆D F wC) ⋅D D.inv (Φ (g, wC))" proof - have "F r ⋆D ψ ⋅D (θ ⋆D e) ⋅D aD-1[F f, w, e] ⋅D (F f ⋆D φ) ⋅D D.inv (Φ (f, wC)) ⋅D Φ (f, wC) = F r ⋆D ψ ⋅D (θ ⋆D e) ⋅D aD-1[F f, w, e] ⋅D (F f ⋆D φ)" 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θC_def T.tab_simps(2) T.ide_leg0 ‹trgC wC = srcC ρ› θC preserves_arr wC) also have "... = (F r ⋆D ψ) ⋅D (F r ⋆D θ ⋆D e) ⋅D (F r ⋆D aD-1[F f, w, e]) ⋅D (F r ⋆D F f ⋆D φ)" using D.whisker_left by (metis (no_types, lifting) C.in_homE D.comp_assoc D.seqE FθC_def T'.ide_base θC preserves_arr) finally have "F r ⋆D ψ ⋅D (θ ⋆D e) ⋅D aD-1[F f, w, e] ⋅D (F f ⋆D φ) ⋅D D.inv (Φ (f, wC)) ⋅D Φ (f, wC) = (F r ⋆D ψ) ⋅D (F r ⋆D θ ⋆D e) ⋅D (F r ⋆D aD-1[F f, w, e]) ⋅D (F r ⋆D F f ⋆D φ)" by simp thus ?thesis using D.comp_assoc by simp qed also have "... = Φ (r, uC) ⋅D (F r ⋆D ψ) ⋅D (F r ⋆D θ ⋆D e) ⋅D (F r ⋆D aD-1[F f, w, e]) ⋅D aD[F r, F f, w ⋆D e] ⋅D (((F r ⋆D F f) ⋆D φ) ⋅D (?ρ' ⋆D F wC)) ⋅D D.inv (Φ (g, wC))" proof - have "(F r ⋆D F f ⋆D φ) ⋅D aD[F r, F f, F wC] = aD[F r, F f, w ⋆D e] ⋅D ((F r ⋆D F f) ⋆D φ)" using wC φ ‹trgC wC = srcC ρ› D.assoc_naturality [of "F r" "F f" φ] 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 "... = Φ (r, uC) ⋅D (F r ⋆D ψ) ⋅D (F r ⋆D θ ⋆D e) ⋅D ((F r ⋆D aD-1[F f, w, e]) ⋅D aD[F r, F f, w ⋆D e]) ⋅D (?ρ' ⋆D w ⋆D e) ⋅D (F g ⋆D φ) ⋅D D.inv (Φ (g, wC))" proof - have "((F r ⋆D F f) ⋆D φ) ⋅D (?ρ' ⋆D F wC) = ?ρ' ⋆D φ ⋅D F wC" using φ D.interchange by (metis D.comp_arr_dom D.comp_cod_arr D.in_homE T'.tab_simps(1,5)) also have "... = ?ρ' ⋆D (w ⋆D e) ⋅D φ" using φ wC D.comp_arr_dom D.comp_cod_arr by auto also have "... = (?ρ' ⋆D w ⋆D e) ⋅D (F g ⋆D φ)" using φ 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 ⋆D F f) ⋆D φ) ⋅D (?ρ' ⋆D F wC) = (?ρ' ⋆D w ⋆D e) ⋅D (F g ⋆D φ)" by simp thus ?thesis using D.comp_assoc by simp qed also have "... = Φ (r, uC) ⋅D (F r ⋆D ψ) ⋅D ((F r ⋆D θ ⋆D e) ⋅D aD[F r, F f ⋆D w, e]) ⋅D (aD[F r, F f, w] ⋆D e) ⋅D (aD-1[F r ⋆D F f, w, e] ⋅D (?ρ' ⋆D w ⋆D e)) ⋅D (F g ⋆D φ) ⋅D D.inv (Φ (g, wC))" proof - have "D.inv (F r ⋆D aD[F f, w, e]) = F r ⋆D aD-1[F f, w, e]" using w by simp moreover have "D.seq (F r ⋆D aD[F f, w, e]) (aD[F r, F f ⋆D w, e] ⋅D (aD[F r, F f, w] ⋆D e))" using w by simp moreover have "(F r ⋆D aD[F f, w, e]) ⋅D aD[F r, F f ⋆D w, e] ⋅D (aD[F r, F f, w] ⋆D e) = aD[F r, F f, w ⋆D e] ⋅D aD[F r ⋆D F f, w, e]" using w D.pentagon by simp ultimately have "(F r ⋆D aD-1[F f, w, e]) ⋅D aD[F r, F f, w ⋆D e] = aD[F r, F f ⋆D w, e] ⋅D (aD[F r, F f, w] ⋆D e) ⋅D aD-1[F r ⋆D F f, w, e]" using w D.comp_assoc D.invert_opposite_sides_of_square [of "F r ⋆D aD[F f, w, e]" "aD[F r, F f ⋆D w, e] ⋅D (aD[F r, F f, w] ⋆D e)" "aD[F r, F f, w ⋆D e]" "aD[F r ⋆D F f, w, e]"] by auto thus ?thesis using D.comp_assoc by simp qed also have "... = Φ (r, uC) ⋅D (F r ⋆D ψ) ⋅D aD[F r, u, e] ⋅D (((F r ⋆D θ) ⋆D e) ⋅D (aD[F r, F f, w] ⋆D e) ⋅D ((?ρ' ⋆D w) ⋆D e)) ⋅D aD-1[F g, w, e] ⋅D (F g ⋆D φ) ⋅D D.inv (Φ (g, wC))" proof - have "(F r ⋆D θ ⋆D e) ⋅D aD[F r, F f ⋆D w, e] = aD[F r, u, e] ⋅D ((F r ⋆D θ) ⋆D e)" using D.assoc_naturality [of "F r" θ e] θ by auto moreover have "aD-1[F r ⋆D F f, w, e] ⋅D (?ρ' ⋆D w ⋆D e) = ((?ρ' ⋆D w) ⋆D e) ⋅D aD-1[F g, w, e]" using w we e.ide_left D.assoc'_naturality [of ?ρ' w e] by simp ultimately show ?thesis using D.comp_assoc by simp qed also have "... = Φ (r, uC) ⋅D (F r ⋆D ψ) ⋅D aD[F r, u, e] ⋅D (T'.composite_cell w θ ⋆D e) ⋅D aD-1[F g, w, e] ⋅D (F g ⋆D φ) ⋅D D.inv (Φ (g, wC))" proof - have "((F r ⋆D θ) ⋆D e) ⋅D (aD[F r, F f, w] ⋆D e) ⋅D ((?ρ' ⋆D w) ⋆D e) = T'.composite_cell w θ ⋆D e" proof - have "«T'.composite_cell w θ : F g ⋆D w ==>D F r ⋆D u¬" using w we θ ‹srcD θ = a› ‹trgD e = a› 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) ‹trgD w = map0 (srcC ρ)› 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 wC θC) = Φ (r, uC) ⋅D (F r ⋆D ψ) ⋅D aD[F r, u, e] ⋅D (T'.composite_cell w θ ⋆D e) ⋅D aD-1[F g, w, e] ⋅D (F g ⋆D φ) ⋅D D.inv (Φ (g, wC))" by simp have "F (T.composite_cell wC' θC' ⋅C βC) = F ((r ⋆C θC') ⋅C aC[r, f, wC'] ⋅C (ρ ⋆C wC') ⋅C βC)" using C.comp_assoc by simp also have "... = F(r ⋆C θC') ⋅D F aC[r, f, wC'] ⋅D F (ρ ⋆C wC') ⋅D F βC" using C.comp_assoc par by fastforce also have "... = (Φ (r, uC) ⋅D (F r ⋆D F θC') ⋅D D.inv (Φ (r, f ⋆C wC'))) ⋅D (Φ (r, f ⋆C wC') ⋅D (F r ⋆D Φ (f, wC')) ⋅D aD[F r, F f, F wC'] ⋅D (D.inv (Φ (r, f)) ⋆D F wC') ⋅D D.inv (Φ (r ⋆C f, wC'))) ⋅D (Φ (r ⋆C f, wC') ⋅D (F ρ ⋆D F wC') ⋅D D.inv (Φ (g, wC'))) ⋅D Φ (g, wC') ⋅D (F g ⋆D D.inv φ') ⋅D aD[F g, w', e] ⋅D (β ⋆D e) ⋅D aD-1[F g, w, e] ⋅D (F g ⋆D φ) ⋅D D.inv (Φ (g, wC))" proof - have "C.hseq r θC' ∧ C.hseq ρ wC'" using par by blast thus ?thesis using wC' θC' βC FβC_def preserves_assoc [of r f wC'] preserves_hcomp by force qed also have "... = Φ (r, uC) ⋅D (F r ⋆D F θC') ⋅D ((D.inv (Φ (r, f ⋆C wC'))) ⋅D (Φ (r, f ⋆C wC')) ⋅D (F r ⋆D Φ (f, wC'))) ⋅D aD[F r, F f, F wC'] ⋅D (D.inv (Φ (r, f)) ⋆D F wC') ⋅D ((D.inv (Φ (r ⋆C f, wC')) ⋅D Φ (r ⋆C f, wC')) ⋅D (F ρ ⋆D F wC')) ⋅D ((D.inv (Φ (g, wC')) ⋅D Φ (g, wC')) ⋅D (F g ⋆D D.inv φ')) ⋅D aD[F g, w', e] ⋅D (β ⋆D e) ⋅D aD-1[F g, w, e] ⋅D (F g ⋆D φ) ⋅D D.inv (Φ (g, wC))" using D.comp_assoc by simp also have "... = Φ (r, uC) ⋅D (F r ⋆D F θC') ⋅D (F r ⋆D Φ (f, wC')) ⋅D aD[F r, F f, F wC'] ⋅D ((D.inv (Φ (r, f)) ⋆D F wC') ⋅D (F ρ ⋆D F wC')) ⋅D (F g ⋆D D.inv φ') ⋅D aD[F g, w', e] ⋅D (β ⋆D e) ⋅D aD-1[F g, w, e] ⋅D (F g ⋆D φ) ⋅D D.inv (Φ (g, wC))" proof - have "(D.inv (Φ (r, f ⋆C wC'))) ⋅D (Φ (r, f ⋆C wC')) ⋅D (F r ⋆D Φ (f, wC')) = F r ⋆D Φ (f, wC')" proof - have "D.seq (Φ (r, f ⋆C wC')) (F r ⋆D Φ (f, wC')) ∧ D.arr (D.inv (Φ (r, f ⋆C wC'))) ∧ D.dom (D.inv (Φ (r, f ⋆C wC'))) = D.cod (Φ (r, f ⋆C wC') ⋅D (F r ⋆D Φ (f, wC')))" 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 ‹trgC wC' = srcC ρ› wC' by presburger qed moreover have "(D.inv (Φ (r ⋆C f, wC')) ⋅D Φ (r ⋆C f, wC')) ⋅D (F ρ ⋆D F wC') = F ρ ⋆D F wC'" proof - have "D.seq (F ρ ⋆D F wC') (D.inv (Φ (C.dom ρ, C.dom wC'))) ∧ D.arr (Φ (r ⋆C f, wC')) ∧ D.dom (Φ (r ⋆C f, wC')) = D.cod ((F ρ ⋆D F wC') ⋅D D.inv (Φ (C.dom ρ, C.dom wC')))" by (metis C.hseqI' C.ide_char D.seqE T.tab_simps(1) T.tab_simps(5) ‹trgC wC' = srcC ρ› preserves_arr preserves_hcomp wC') 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 ‹trgC wC' = srcC ρ› wC') qed moreover have "(D.inv (Φ (g, wC')) ⋅D Φ (g, wC')) ⋅D (F g ⋆D D.inv φ') = F g ⋆D D.inv φ'" proof - have "(D.inv (Φ (g, wC')) ⋅D Φ (g, wC')) ⋅D (F g ⋆D D.inv φ') = (F g ⋆D F wC') ⋅D (F g ⋆D D.inv φ')" using wC' βC FβC_def cmp_components_are_iso D.comp_inv_arr' by simp also have "... = F g ⋆D D.inv φ'" using D.comp_cod_arr [of "F g ⋆D D.inv φ'" "F g ⋆D F wC'"] by (metis D.cod_inv D.null_is_zero(2) D.hseq_char' D.in_homE D.is_weak_composition T'.leg1_simps(6) φ' weak_composition.hcomp_simpsWC(3)) finally show ?thesis by blast qed ultimately show ?thesis using D.comp_assoc by simp qed also have "... = Φ (r, uC) ⋅D (F r ⋆D F θC') ⋅D (F r ⋆D Φ (f, wC')) ⋅D aD[F r, F f, F wC'] ⋅D (?ρ' ⋆D F wC') ⋅D (F g ⋆D D.inv φ') ⋅D aD[F g, w', e] ⋅D (β ⋆D e) ⋅D aD-1[F g, w, e] ⋅D (F g ⋆D φ) ⋅D D.inv (Φ (g, wC))" using wC' D.whisker_right cmp_in_hom cmp_components_are_iso by simp also have "... = Φ (r, uC) ⋅D (F r ⋆D ψ ⋅D (θ' ⋆D e) ⋅D aD-1[F f, w', e] ⋅D (F f ⋆D φ') ⋅D D.inv (Φ (f, wC'))) ⋅D (F r ⋆D Φ (f, wC')) ⋅D aD[F r, F f, F wC'] ⋅D (?ρ' ⋆D F wC') ⋅D (F g ⋆D D.inv φ') ⋅D aD[F g, w', e] ⋅D (β ⋆D e) ⋅D aD-1[F g, w, e] ⋅D (F g ⋆D φ) ⋅D D.inv (Φ (g, wC))" using θC' FθC'_def by simp also have "... = Φ (r, uC) ⋅D (F r ⋆D ψ) ⋅D (F r ⋆D θ' ⋆D e) ⋅D (F r ⋆D aD-1[F f, w', e]) ⋅D (F r ⋆D F f ⋆D φ') ⋅D (((F r ⋆D D.inv (Φ (f, wC'))) ⋅D (F r ⋆D Φ (f, wC'))) ⋅D aD[F r, F f, F wC']) ⋅D (?ρ' ⋆D F wC') ⋅D (F g ⋆D D.inv φ') ⋅D aD[F g, w', e] ⋅D (β ⋆D e) ⋅D aD-1[F g, w, e] ⋅D (F g ⋆D φ) ⋅D D.inv (Φ (g, wC))" proof - have "F r ⋆D ψ ⋅D (θ' ⋆D e) ⋅D aD-1[F f, w', e] ⋅D (F f ⋆D φ') ⋅D D.inv (Φ (f, wC')) = (F r ⋆D ψ) ⋅D (F r ⋆D θ' ⋆D e) ⋅D (F r ⋆D aD-1[F f, w', e]) ⋅D (F r ⋆D F f ⋆D φ') ⋅D (F r ⋆D D.inv (Φ (f, wC')))" 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θC'_def T'.ide_base θC' preserves_arr) thus ?thesis using D.comp_assoc by simp qed also have "... = Φ (r, uC) ⋅D (F r ⋆D ψ) ⋅D (F r ⋆D θ' ⋆D e) ⋅D (F r ⋆D aD-1[F f, w', e]) ⋅D ((F r ⋆D F f ⋆D φ') ⋅D aD[F r, F f, F wC']) ⋅D (?ρ' ⋆D F wC') ⋅D (F g ⋆D D.inv φ') ⋅D aD[F g, w', e] ⋅D (β ⋆D e) ⋅D aD-1[F g, w, e] ⋅D (F g ⋆D φ) ⋅D D.inv (Φ (g, wC))" proof - have "((F r ⋆D D.inv (Φ (f, wC'))) ⋅D (F r ⋆D Φ (f, wC'))) ⋅D aD[F r, F f, F wC'] = aD[F r, F f, F wC']" using cmp_in_hom cmp_components_are_iso D.comp_cod_arr D.whisker_left [of "F r" "D.inv (Φ (f, wC'))" "Φ (f, wC')"] by (simp add: D.comp_inv_arr' wC') thus ?thesis using D.comp_assoc by simp qed also have "... = Φ (r, uC) ⋅D (F r ⋆D ψ) ⋅D (F r ⋆D θ' ⋆D e) ⋅D (F r ⋆D aD-1[F f, w', e]) ⋅D aD[F r, F f, w' ⋆D e] ⋅D (((F r ⋆D F f) ⋆D φ') ⋅D (?ρ' ⋆D F wC')) ⋅D (F g ⋆D D.inv φ') ⋅D aD[F g, w', e] ⋅D (β ⋆D e) ⋅D aD-1[F g, w, e] ⋅D (F g ⋆D φ) ⋅D D.inv (Φ (g, wC))" proof - have "(F r ⋆D F f ⋆D φ') ⋅D aD[F r, F f, F wC'] = aD[F r, F f, w' ⋆D e] ⋅D ((F r ⋆D F f) ⋆D φ')" using wC' φ' D.assoc_naturality [of "F r" "F f" φ'] 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) ‹trgC wC' = srcC ρ› preserves_src preserves_trg) thus ?thesis using D.comp_assoc by simp qed also have "... = Φ (r, uC) ⋅D (F r ⋆D ψ) ⋅D (F r ⋆D θ' ⋆D e) ⋅D (F r ⋆D aD-1[F f, w', e]) ⋅D aD[F r, F f, w' ⋆D e] ⋅D (?ρ' ⋆D w' ⋆D e) ⋅D (((F g ⋆D φ') ⋅D (F g ⋆D D.inv φ')) ⋅D aD[F g, w', e]) ⋅D (β ⋆D e) ⋅D aD-1[F g, w, e] ⋅D (F g ⋆D φ) ⋅D D.inv (Φ (g, wC))" proof - have "((F r ⋆D F f) ⋆D φ') ⋅D (?ρ' ⋆D F wC') = (?ρ' ⋆D w' ⋆D e) ⋅D (F g ⋆D φ')" using φ' 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 "... = Φ (r, uC) ⋅D (F r ⋆D ψ) ⋅D (F r ⋆D θ' ⋆D e) ⋅D ((F r ⋆D aD-1[F f, w', e]) ⋅D aD[F r, F f, w' ⋆D e]) ⋅D (?ρ' ⋆D w' ⋆D e) ⋅D aD[F g, w', e] ⋅D (β ⋆D e) ⋅D aD-1[F g, w, e] ⋅D (F g ⋆D φ) ⋅D D.inv (Φ (g, wC))" proof - have "((F g ⋆D φ') ⋅D (F g ⋆D D.inv φ')) ⋅D aD[F g, w', e] = aD[F g, w', e]" proof - have "((F g ⋆D φ') ⋅D (F g ⋆D D.inv φ')) ⋅D aD[F g, w', e] = (F g ⋆D w' ⋆D e) ⋅D aD[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 φ') also have "... = aD[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 "... = Φ (r, uC) ⋅D (F r ⋆D ψ) ⋅D ((F r ⋆D θ' ⋆D e) ⋅D aD[F r, F f ⋆D w', e]) ⋅D (aD[F r, F f, w'] ⋆D e) ⋅D (aD-1[F r ⋆D F f, w', e] ⋅D (?ρ' ⋆D w' ⋆D e)) ⋅D aD[F g, w', e] ⋅D (β ⋆D e) ⋅D aD-1[F g, w, e] ⋅D (F g ⋆D φ) ⋅D D.inv (Φ (g, wC))" proof - have "D.inv (F r ⋆D aD[F f, w', e]) = F r ⋆D aD-1[F f, w', e]" using w' by simp moreover have "D.seq (F r ⋆D aD[F f, w', e]) (aD[F r, F f ⋆D w', e] ⋅D (aD[F r, F f, w'] ⋆D e))" using w' by simp moreover have "D.iso (F r ⋆D aD[F f, w', e])" using w' by simp moreover have "D.iso aD[F r ⋆D F f, w', e]" using w' by simp moreover have "(F r ⋆D aD[F f, w', e]) ⋅D aD[F r, F f ⋆D w', e] ⋅D (aD[F r, F f, w'] ⋆D e) = aD[F r, F f, w' ⋆D e] ⋅D aD[F r ⋆D F f, w', e]" using w' D.pentagon by simp ultimately have "(F r ⋆D aD-1[F f, w', e]) ⋅D aD[F r, F f, w' ⋆D e] = aD[F r, F f ⋆D w', e] ⋅D (aD[F r, F f, w'] ⋆D e) ⋅D aD-1[F r ⋆D F f, w', e]" using w' D.comp_assoc D.invert_opposite_sides_of_square [of "F r ⋆D aD[F f, w', e]" "aD[F r, F f ⋆D w', e] ⋅D (aD[F r, F f, w'] ⋆D e)" "aD[F r, F f, w' ⋆D e]" "aD[F r ⋆D F f, w', e]"] by auto thus ?thesis using D.comp_assoc by simp qed also have "... = Φ (r, uC) ⋅D (F r ⋆D ψ) ⋅D aD[F r, u, e] ⋅D (((F r ⋆D θ') ⋆D e) ⋅D (aD[F r, F f, w'] ⋆D e) ⋅D ((?ρ' ⋆D w') ⋆D e)) ⋅D ((aD-1[F g, w', e] ⋅D aD[F g, w', e]) ⋅D (β ⋆D e)) ⋅D aD-1[F g, w, e] ⋅D (F g ⋆D φ) ⋅D D.inv (Φ (g, wC))" proof - have "(F r ⋆D θ' ⋆D e) ⋅D aD[F r, F f ⋆D w', e] = aD[F r, u, e] ⋅D ((F r ⋆D θ') ⋆D e)" using D.assoc_naturality [of "F r" θ' e] θ' by auto moreover have "aD-1[F r ⋆D F f, w', e] ⋅D (?ρ' ⋆D w' ⋆D e) = ((?ρ' ⋆D w') ⋆D e) ⋅D aD-1[F g, w', e]" using w' w'e D.assoc'_naturality [of ?ρ' w' e] by simp ultimately show ?thesis using D.comp_assoc by simp qed also have "... = Φ (r, uC) ⋅D (F r ⋆D ψ) ⋅D aD[F r, u, e] ⋅D (T'.composite_cell w' θ' ⋆D e) ⋅D (β ⋆D e) ⋅D aD-1[F g, w, e] ⋅D (F g ⋆D φ) ⋅D D.inv (Φ (g, wC))" proof - have "((F r ⋆D θ') ⋆D e) ⋅D (aD[F r, F f, w'] ⋆D e) ⋅D ((?ρ' ⋆D w') ⋆D e) = T'.composite_cell w' θ' ⋆D e" proof - have "«T'.composite_cell w' θ' : F g ⋆D w' ==>D F r ⋆D u¬" using θ' 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 "(aD-1[F g, w', e] ⋅D aD[F g, w', e]) ⋅D (β ⋆D e) = β ⋆D e" using w' β e.ide_left ‹srcD w' = a› ‹trgD e = a› FβC Fβ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) ‹trgD w' = map0 (srcC ρ)› preserves_src) ultimately show ?thesis using D.comp_assoc by simp qed also have "... = Φ (r, uC) ⋅D (F r ⋆D ψ) ⋅D aD[F r, u, e] ⋅D (T'.composite_cell w' θ' ⋅D β ⋆D e) ⋅D aD-1[F g, w, e] ⋅D (F g ⋆D φ) ⋅D D.inv (Φ (g, wC))" proof - have "D.arr (T'.composite_cell w' θ' ⋅D β)" 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 wC' θC' ⋅C βC) = Φ (r, uC) ⋅D (F r ⋆D ψ) ⋅D aD[F r, u, e] ⋅D (T'.composite_cell w' θ' ⋅D β ⋆D e) ⋅D aD-1[F g, w, e] ⋅D (F g ⋆D φ) ⋅D D.inv (Φ (g, wC))" by simp show "F (T.composite_cell wC θC) = F (T.composite_cell wC' θC' ⋅C βC)" using eq L R by simp qed ultimately show ?thesis using is_faithful [of "T.composite_cell wC θC" "T.composite_cell wC' θC' ⋅C βC"] by simp qed have **: "∃!γ. «γ : wC ==>C wC'¬ ∧ βC = g ⋆C γ ∧ θC = θC' ⋅C (f ⋆C γ)" using * wC wC' θC θC' βC T.T2 [of wC wC' θC uC θC' βC] by simp obtain γC where γC: "«γC : wC ==>C wC'¬ ∧ βC = g ⋆C γC ∧ θC = θC' ⋅C (f ⋆C γC)" using ** by auto have γC_unique: "∧γC'. «γC' : wC ==>C wC'¬ ∧ βC = g ⋆C γC' ∧ θC = θC' ⋅C (f ⋆C γC') ==> γC' = γC" using γC ** by blast text ‹ Now use ‹F› to map everything back to ‹D›, transport the result along the equivalence map ‹e›, and cancel all of the isomorphisms that got introduced. › let ?P = "λγ. «γ : w ⋆D e ==>D w' ⋆D e¬ ∧ aD[F g, w', e] ⋅D (β ⋆D e) ⋅D aD-1[F g, w, e] = F g ⋆D γ ∧ ψ ⋅D (θ ⋆D e) ⋅D aD-1[F f, w, e] = ψ ⋅D (θ' ⋆D e) ⋅D aD-1[F f, w', e] ⋅D (F f ⋆D γ)" define γe where "γe = φ' ⋅D F γC ⋅D D.inv φ" have Pγe: "?P γe" proof - have 1: "«F γC : F wC ==>D F wC'¬ ∧ F βC = Φ (g, wC') ⋅D (F g ⋆D F γC) ⋅D D.inv (Φ (g, wC)) ∧ F θC = F θC' ⋅D Φ (f, C.cod γC) ⋅D (F f ⋆D F γC) ⋅D D.inv (Φ (f, wC))" using βC θC γC preserves_hcomp [of f γC] preserves_hcomp [of g γC] by force have A: "aD[F g, w', e] ⋅D (β ⋆D e) ⋅D aD-1[F g, w, e] = F g ⋆D φ' ⋅D F γC ⋅D D.inv φ" proof - have "F g ⋆D F γC = D.inv (Φ (g, wC')) ⋅D F βC ⋅D Φ (g, wC)" proof - have "F βC = Φ (g, wC') ⋅D (F g ⋆D F γC) ⋅D D.inv (Φ (g, wC))" using 1 by simp hence "D.inv (Φ (g, wC')) ⋅D F βC = (F g ⋆D F γC) ⋅D D.inv (Φ (g, wC))" using wC wC' ‹trgC wC = srcC ρ› ‹trgC wC' = srcC ρ› cmp_components_are_iso D.invert_side_of_triangle(1) by (metis D.arrI FβC T.ide_leg1 T.leg1_simps(3) T.tab_simps(2) βC) hence "(D.inv (Φ (g, wC')) ⋅D F βC) ⋅D Φ (g, wC) = F g ⋆D F γ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βC T.ide_leg1 T.leg1_simps(3) T.tab_simps(2) βC ‹trgC wC = srcC ρ› wC) thus ?thesis using D.comp_assoc by simp qed also have "... = ((D.inv (Φ (g, wC')) ⋅D Φ (g, wC')) ⋅D (F g ⋆D D.inv φ')) ⋅D aD[F g, w', e] ⋅D (β ⋆D e) ⋅D aD-1[F g, w, e] ⋅D (F g ⋆D φ) ⋅D D.inv (Φ (g, wC)) ⋅D Φ (g, wC)" using βC FβC_def D.comp_assoc by simp also have "... = (F g ⋆D D.inv φ') ⋅D aD[F g, w', e] ⋅D (β ⋆D e) ⋅D aD-1[F g, w, e] ⋅D (F g ⋆D φ)" proof - have "(D.inv (Φ (g, wC')) ⋅D Φ (g, wC')) ⋅D (F g ⋆D D.inv φ') = F g ⋆D D.inv φ'" proof - have "(D.inv (Φ (g, wC')) ⋅D Φ (g, wC')) ⋅D (F g ⋆D D.inv φ') = (F g ⋆D F wC') ⋅D (F g ⋆D D.inv φ')" using wC' φ' cmp_components_are_iso D.comp_inv_arr' by simp also have "... = F g ⋆D D.inv φ'" using wC' φ' 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 ⋆D φ) ⋅D D.inv (Φ (g, wC)) ⋅D Φ (g, wC) = F g ⋆D φ" proof - have "(F g ⋆D φ) ⋅D D.inv (Φ (g, wC)) ⋅D Φ (g, wC) = (F g ⋆D φ) ⋅D (F g ⋆D F wC)" using wC φ ‹trgC wC = srcC ρ› cmp_components_are_iso cmp_in_hom D.comp_inv_arr' by simp also have "... = F g ⋆D φ" using wC φ 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 ⋆D D.inv φ') ⋅D (aD[F g, w', e] ⋅D (β ⋆D e) ⋅D aD-1[F g, w, e]) ⋅D (F g ⋆D φ) = F g ⋆D F γC" using D.comp_assoc by simp have 3: "(aD[F g, w', e] ⋅D (β ⋆D e) ⋅D aD-1[F g, w, e]) ⋅D (F g ⋆D φ) = (F g ⋆D φ') ⋅D (F g ⋆D F γC)" proof - have "D.hseq (F g) (F γC)" using "1" FβC βC by auto moreover have "D.iso (F g ⋆D D.inv φ')" by (metis "2" D.iso_hcomp D.hseqE D.ide_is_iso D.iso_inv_iso D.seqE T'.ide_leg1 φ' calculation) moreover have "D.inv (F g ⋆D D.inv φ') = F g ⋆D φ'" 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 φ' calculation(2)) ultimately show ?thesis using 2 φ φ' D.invert_side_of_triangle(1) [of "F g ⋆D F γC" "F g ⋆D D.inv φ'" "(aD[F g, w', e] ⋅D (β ⋆D e) ⋅D aD-1[F g, w, e]) ⋅D (F g ⋆D φ)"] by auto qed hence "aD[F g, w', e] ⋅D (β ⋆D e) ⋅D aD-1[F g, w, e] = ((F g ⋆D φ') ⋅D (F g ⋆D F γC)) ⋅D (F g ⋆D D.inv φ)" proof - have "D.seq (F g ⋆D φ') (F g ⋆D F γC)" by (metis "1" "2" "3" D.arrI D.null_is_zero(1) D.null_is_zero(2) D.ext FβC βC) moreover have "D.iso (F g ⋆D φ)" using D.vconn_implies_hpar(2) D.vconn_implies_hpar(4) φ we by auto moreover have "D.inv (F g ⋆D φ) = F g ⋆D D.inv φ" by (metis D.hseqE D.ide_is_iso D.inv_hcomp D.inv_ide D.iso_is_arr T'.ide_leg1 φ calculation(2)) ultimately show ?thesis using 3 φ φ' D.invert_side_of_triangle(2) [of "(F g ⋆D φ') ⋅D (F g ⋆D F γC)" "aD[F g, w', e] ⋅D (β ⋆D e) ⋅D aD-1[F g, w, e]" "F g ⋆D φ"] by auto qed also have "... = F g ⋆D φ' ⋅D F γC ⋅D D.inv φ" using φ' 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 φ) finally show ?thesis by simp qed have B: "ψ ⋅D (θ ⋆D e) ⋅D aD-1[F f, w, e] = ψ ⋅D (θ' ⋆D e) ⋅D aD-1[F f, w', e] ⋅D (F f ⋆D φ' ⋅D F γC ⋅D D.inv φ)" proof - have "F θC' ⋅D Φ (f, wC') ⋅D (F f ⋆D F γC) ⋅D D.inv (Φ (f, wC)) = (ψ ⋅D (θ' ⋆D e) ⋅D aD-1[F f, w', e] ⋅D (F f ⋆D φ') ⋅D (D.inv (Φ (f, wC')) ⋅D Φ (f, wC')) ⋅D (F f ⋆D F γC)) ⋅D D.inv (Φ (f, wC))" using γC θC' FθC'_def D.comp_assoc by auto also have "... = ψ ⋅D (θ' ⋆D e) ⋅D aD-1[F f, w', e] ⋅D (F f ⋆D φ') ⋅D (F f ⋆D F γC) ⋅D D.inv (Φ (f, wC))" proof - have "(D.inv (Φ (f, wC')) ⋅D Φ (f, wC')) ⋅D (F f ⋆D F γC) = F f ⋆D F γ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 γC 1 ‹trgC wC' = srcC ρ› θC preserves_arr wC') thus ?thesis using D.comp_assoc by simp qed finally have "F θC' ⋅D Φ (f, wC') ⋅D (F f ⋆D F γC) ⋅D D.inv (Φ (f, wC)) = ψ ⋅D (θ' ⋆D e) ⋅D aD-1[F f, w', e] ⋅D (F f ⋆D φ') ⋅D (F f ⋆D F γC) ⋅D D.inv (Φ (f, wC))" by simp hence 3: "F θC' ⋅D Φ (f, wC') ⋅D (F f ⋆D F γC) = ψ ⋅D (θ' ⋆D e) ⋅D aD-1[F f, w', e] ⋅D (F f ⋆D φ') ⋅D (F f ⋆D F γC)" using cmp_components_are_iso D.iso_inv_iso D.iso_is_retraction D.retraction_is_e D.epi_cancel by (metis C.in_homE D.comp_assoc T.tab_simps(2) T.ide_leg0 γC 1 ‹trgC wC = srcC ρ› θC preserves_arr wC) hence "(ψ ⋅D (θ ⋆D e) ⋅D aD-1[F f, w, e] ⋅D (F f ⋆D φ)) ⋅D D.inv (Φ (f, wC)) = (ψ ⋅D (θ' ⋆D e) ⋅D aD-1[F f, w', e] ⋅D (F f ⋆D φ') ⋅D (F f ⋆D F γC)) ⋅D D.inv (Φ (f, wC))" using 1 θC FθC_def D.comp_assoc by (metis C.in_homE γC) hence 2: "(ψ ⋅D (θ ⋆D e) ⋅D aD-1[F f, w, e]) ⋅D (F f ⋆D φ) = ψ ⋅D (θ' ⋆D e) ⋅D aD-1[F f, w', e] ⋅D (F f ⋆D φ') ⋅D (F f ⋆D F γC)" using γ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 ‹trgC wC = srcC ρ› θC preserves_arr wC) hence "ψ ⋅D (θ ⋆D e) ⋅D aD-1[F f, w, e] = (ψ ⋅D (θ' ⋆D e) ⋅D aD-1[F f, w', e]) ⋅D (F f ⋆D φ') ⋅D (F f ⋆D F γC) ⋅D (F f ⋆D D.inv φ)" proof - have "D.inv (F f ⋆D φ) = F f ⋆D D.inv φ" using φ by (metis C.arrI D.hseq_char D.ide_is_iso D.inv_hcomp D.inv_ide D.seqE FθC_def T'.ide_leg0 preserves_arr θC) thus ?thesis using φ φ' θ θ' γ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θC_def T'.ide_leg0 θC preserves_arr) qed also have "... = ψ ⋅D (θ' ⋆D e) ⋅D aD-1[F f, w', e] ⋅D (F f ⋆D φ') ⋅D (F f ⋆D F γC) ⋅D (F f ⋆D D.inv φ)" using D.comp_assoc by simp also have "... = ψ ⋅D (θ' ⋆D e) ⋅D aD-1[F f, w', e] ⋅D (F f ⋆D φ' ⋅D F γC ⋅D D.inv φ)" proof - have "D.arr (φ' ⋅D F γC ⋅D D.inv φ)" using "1" φ φ' by blast thus ?thesis using D.whisker_left by auto qed finally show ?thesis by simp qed have C: "«φ' ⋅D F γC ⋅D D.inv φ : w ⋆D e ==>D w' ⋆D e¬" using φ φ' γC 1 by (meson D.comp_in_homI D.inv_in_hom) show ?thesis unfolding γe_def using A B C by simp qed have UN: "∧γ. ?P γ ==> γ = γe" proof - fix γ assume γ: "?P γ" show "γ = γe" proof - let ?γ' = "D.inv φ' ⋅D γ ⋅D φ" have γ': "«?γ' : F wC ==>D F wC'¬" using γ φ φ' by auto obtain γC' where γC': "«γC' : wC ==>C wC'¬ ∧ F γC' = ?γ'" using wC wC' γ γ' locally_full by fastforce have 1: "βC = g ⋆C γC'" proof - have "F βC = F (g ⋆C γC')" proof - have "F βC = Φ (g, wC') ⋅D (F g ⋆D D.inv φ') ⋅D aD[F g, w', e] ⋅D (β ⋆D e) ⋅D aD-1[F g, w, e] ⋅D (F g ⋆D φ) ⋅D D.inv (Φ (g, wC))" using βC FβC_def by simp have "F (g ⋆C γC') = Φ (g, wC') ⋅D (F g ⋆D D.inv φ' ⋅D γ ⋅D φ) ⋅D D.inv (Φ (g, wC))" using γC' preserves_hcomp by (metis C.hseqI' C.in_homE C.trg_dom T.tab_simps(2) T.leg1_simps(2) T.leg1_simps(3,5-6) ‹trgC wC = srcC ρ›) also have "... = Φ (g, wC') ⋅D (F g ⋆D D.inv φ') ⋅D (F g ⋆D γ) ⋅D (F g ⋆D φ) ⋅D D.inv (Φ (g, wC))" using φ φ' D.whisker_left D.comp_assoc by (metis D.arrI D.seqE FβC_def T'.ide_leg1 γ γ') also have "... = Φ (g, wC') ⋅D (F g ⋆D D.inv φ') ⋅D (aD[F g, w', e] ⋅D (β ⋆D e) ⋅D aD-1[F g, w, e]) ⋅D (F g ⋆D φ) ⋅D D.inv (Φ (g, wC))" using γ D.comp_assoc by simp also have "... = F βC" using βC FβC_def D.comp_assoc by simp finally show ?thesis by simp qed moreover have "C.par βC (g ⋆C γC')" proof (intro conjI) show "C.arr βC" using βC by blast show 2: "C.hseq g γC'" using FβC βC calculation by fastforce show "C.dom βC = C.dom (g ⋆C γC')" using 2 βC γC' by fastforce show "C.cod βC = C.cod (g ⋆C γC')" using 2 βC γC' by fastforce qed ultimately show ?thesis using is_faithful by blast qed have 2: "θC = θC' ⋅C (f ⋆C γC')" proof - have "F θC = F (θC' ⋅C (f ⋆C γC'))" proof - have "F (θC' ⋅C (f ⋆C γC')) = F θC' ⋅D F (f ⋆C γC')" using θC' γC' by force also have "... = F θC' ⋅D Φ (f, wC') ⋅D (F f ⋆D D.inv φ' ⋅D γ ⋅D φ) ⋅D D.inv (Φ (f, wC))" using wC wC' θC' γC' preserves_hcomp by (metis C.hseqI' C.in_homE C.trg_dom T.tab_simps(2) T.leg0_simps(2) T.leg0_simps(4-5) ‹trgC wC = srcC ρ›) also have "... = F θC' ⋅D Φ (f, wC') ⋅D ((F f ⋆D D.inv φ') ⋅D (F f ⋆D γ) ⋅D (F f ⋆D φ)) ⋅D D.inv (Φ (f, wC))" using D.whisker_left by (metis D.arrI D.seqE T'.ide_leg0 γ') also have "... = ψ ⋅D (θ' ⋆D e) ⋅D aD-1[F f, w', e] ⋅D (((F f ⋆D φ') ⋅D (D.inv (Φ (f, wC')) ⋅D Φ (f, wC')) ⋅D (F f ⋆D D.inv φ')) ⋅D (F f ⋆D γ)) ⋅D (F f ⋆D φ) ⋅D D.inv (Φ (f, wC))" using θC' FθC'_def D.comp_assoc by simp also have "... = (ψ ⋅D (θ' ⋆D e) ⋅D aD-1[F f, w', e] ⋅D (F f ⋆D γ)) ⋅D (F f ⋆D φ) ⋅D D.inv (Φ (f, wC))" proof - have "D.inv (Φ (f, wC')) ⋅D Φ (f, wC') = F f ⋆D F wC'" using wC' cmp_in_hom cmp_components_are_iso by (simp add: D.comp_inv_arr') moreover have "D.hseq (F f) (D.inv φ')" using φ' 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) γ preserves_src we) ultimately have "(D.inv (Φ (f, wC')) ⋅D Φ (f, wC')) ⋅D (F f ⋆D D.inv φ') = F f ⋆D D.inv φ'" using wC' φ' D.comp_cod_arr [of "F f ⋆D D.inv φ'" "F f ⋆D F wC'"] by fastforce hence "((F f ⋆D φ') ⋅D (D.inv (Φ (f, wC')) ⋅D Φ (f, wC')) ⋅D (F f ⋆D D.inv φ')) ⋅D (F f ⋆D γ) = ((F f ⋆D φ') ⋅D (F f ⋆D D.inv φ')) ⋅D (F f ⋆D γ)" by simp also have "... = F f ⋆D γ" using γ φ' θC' Fθ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 ⋆D φ') ⋅D (D.inv (Φ (f, wC')) ⋅D Φ (f, wC')) ⋅D (F f ⋆D D.inv φ')) ⋅D (F f ⋆D γ) = F f ⋆D γ" by simp thus ?thesis using D.comp_assoc by simp qed also have "... = ψ ⋅D (θ ⋆D e) ⋅D aD-1[F f, w, e] ⋅D (F f ⋆D φ) ⋅D D.inv (Φ (f, wC))" using γ D.comp_assoc by metis also have "... = F θC" using θC FθC_def by simp finally show ?thesis by simp qed moreover have "C.par θC (θC' ⋅C (f ⋆C γC'))" proof (intro conjI) show "C.arr θC" using θC by auto show 1: "C.seq θC' (f ⋆C γC')" using θC' γC' by (metis C.arrI θC calculation preserves_reflects_arr) show "C.dom θC = C.dom (θC' ⋅C (f ⋆C γC'))" using 1 θC γC' by fastforce show "C.cod θC = C.cod (θC' ⋅C (f ⋆C γC'))" using 1 θC γC' γC by auto qed ultimately show ?thesis using is_faithful by blast qed have "F γC' = F γC" using ** γC γC' 1 2 by blast hence "?γ' = F γC" using γC' by simp thus "γ = γe" unfolding γ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 γ' φ φ') qed qed text ‹We are now in a position to exhibit the 2-cell ‹γ› and show that it is unique with the required properties.› show ?thesis proof let ?γ = "rD[w'] ⋅D (w' ⋆D ε) ⋅D aD[w', e, d] ⋅D (γe ⋆D d) ⋅D aD-1[w, e, d] ⋅D (w ⋆D D.inv ε) ⋅D rD-1[w]" have γ: "«?γ : w ==>D w'¬" using Pγ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 "β = F g ⋆D ?γ" proof - have "F g ⋆D ?γ = (F g ⋆D rD[w']) ⋅D (F g ⋆D w' ⋆D ε) ⋅D (F g ⋆D aD[w', e, d]) ⋅D (F g ⋆D γe ⋆D d) ⋅D (F g ⋆D aD-1[w, e, d]) ⋅D (F g ⋆D w ⋆D D.inv ε) ⋅D (F g ⋆D rD-1[w])" using w w' γ Pγe D.whisker_left e.antipar by (metis D.arrI D.seqE T'.ide_leg1) also have "... = (F g ⋆D rD[w']) ⋅D (F g ⋆D w' ⋆D ε) ⋅D (F g ⋆D aD[w', e, d]) ⋅D (aD[F g, w' ⋆D e, d] ⋅D ((F g ⋆D γe) ⋆D d) ⋅D aD-1[F g, w ⋆D e, d]) ⋅D (F g ⋆D aD-1[w, e, d]) ⋅D (F g ⋆D w ⋆D D.inv ε) ⋅D (F g ⋆D rD-1[w])" proof - have "aD[F g, w' ⋆D e, d] ⋅D ((F g ⋆D γe) ⋆D d) ⋅D aD-1[F g, w ⋆D e, d] = aD[F g, w' ⋆D e, d] ⋅D aD-1[F g, w' ⋆D e, d] ⋅D (F g ⋆D γe ⋆D d)" using w w' e.antipar Pγe D.assoc'_naturality [of "F g" γ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 "... = (aD[F g, w' ⋆D e, d] ⋅D aD-1[F g, w' ⋆D e, d]) ⋅D (F g ⋆D γe ⋆D d)" using D.comp_assoc by simp also have "... = F g ⋆D γe ⋆D d" proof - have "(aD[F g, w' ⋆D e, d] ⋅D aD-1[F g, w' ⋆D e, d]) ⋅D (F g ⋆D γe ⋆D d) = (F g ⋆D (w' ⋆D e) ⋆D d) ⋅D (F g ⋆D γe ⋆D d)" using w'e D.isomorphic_implies_ide(2) wC' D.comp_assoc_assoc'(1) by auto also have "... = F g ⋆D γe ⋆D d" proof - have "«F g ⋆D γe ⋆D d : F g ⋆D (w ⋆D e) ⋆D d ==>D F g ⋆D (w' ⋆D e) ⋆D d¬" using we e.ide_right e.antipar Pγe by fastforce thus ?thesis using D.comp_cod_arr by auto qed finally show ?thesis by blast qed finally have "aD[F g, w' ⋆D e, d] ⋅D ((F g ⋆D γe) ⋆D d) ⋅D aD-1[F g, w ⋆D e, d] = F g ⋆D γe ⋆D d" by simp thus ?thesis by simp qed also have "... = (F g ⋆D rD[w']) ⋅D (F g ⋆D w' ⋆D ε) ⋅D (F g ⋆D aD[w', e, d]) ⋅D (aD[F g, w' ⋆D e, d] ⋅D (aD[F g, w', e] ⋅D (β ⋆D e) ⋅D aD-1[F g, w, e] ⋆D d) ⋅D aD-1[F g, w ⋆D e, d]) ⋅D (F g ⋆D aD-1[w, e, d]) ⋅D (F g ⋆D w ⋆D D.inv ε) ⋅D (F g ⋆D rD-1[w])" using Pγe by simp also have "... = (F g ⋆D rD[w']) ⋅D (F g ⋆D w' ⋆D ε) ⋅D (F g ⋆D aD[w', e, d]) ⋅D aD[F g, w' ⋆D e, d] ⋅D (aD[F g, w', e] ⋆D d) ⋅D ((β ⋆D e) ⋆D d) ⋅D (aD-1[F g, w, e] ⋆D d) ⋅D aD-1[F g, w ⋆D e, d] ⋅D (F g ⋆D aD-1[w, e, d]) ⋅D (F g ⋆D w ⋆D D.inv ε) ⋅D (F g ⋆D rD-1[w])" proof - have "aD[F g, w', e] ⋅D (β ⋆D e) ⋅D aD-1[F g, w, e] ⋆D d = (aD[F g, w', e] ⋆D d) ⋅D ((β ⋆D e) ⋆D d) ⋅D (aD-1[F g, w, e] ⋆D d)" proof - have "D.arr (aD[F g, w', e] ⋅D (β ⋆D e) ⋅D aD-1[F g, w, e])" using D.arrI D.in_hhom_def D.vconn_implies_hpar(2) Pγ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 ⋆D rD[w']) ⋅D (F g ⋆D w' ⋆D ε) ⋅D ((F g ⋆D aD[w', e, d]) ⋅D aD[F g, w' ⋆D e, d] ⋅D (aD[F g, w', e] ⋆D d) ⋅D (aD-1[F g ⋆D w', e, d]) ⋅D (β ⋆D e ⋆D d) ⋅D (aD[F g ⋆D w, e, d]) ⋅D (aD-1[F g, w, e] ⋆D d) ⋅D aD-1[F g, w ⋆D e, d] ⋅D (F g ⋆D aD-1[w, e, d])) ⋅D (F g ⋆D w ⋆D D.inv ε) ⋅D (F g ⋆D rD-1[w])" proof - have "(β ⋆D e) ⋆D d = aD-1[F g ⋆D w', e, d] ⋅D (β ⋆D e ⋆D d) ⋅D aD[F g ⋆D w, e, d]" proof - have "srcD β = trgD e" using β 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 ‹trgD e = a› a_def) moreover have "srcD (F g) = trgD w" by simp moreover have "srcD (F g) = trgD w'" by simp moreover have "«(β ⋆D e) ⋆D d : ((F g ⋆D w) ⋆D e) ⋆D d ==>D ((F g ⋆D w') ⋆D e) ⋆D d¬" using β w w' e e.antipar by (intro D.hcomp_in_vhom, auto) ultimately have "aD-1[F g ⋆D w', e, d] ⋅D (β ⋆D e ⋆D d) ⋅D aD[F g ⋆D w, e, d] = aD-1[F g ⋆D w', e, d] ⋅D aD[F g ⋆D w', e, d] ⋅D ((β ⋆D e) ⋆D d)" using w' e e.ide_left e.ide_right e.antipar β 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 "... = (aD-1[F g ⋆D w', e, d] ⋅D aD[F g ⋆D w', e, d]) ⋅D ((β ⋆D e) ⋆D d)" using D.comp_assoc by simp also have "... = (((F g ⋆D w') ⋆D e) ⋆D d) ⋅D ((β ⋆D e) ⋆D d)" using w' e e.antipar β D.comp_assoc_assoc' by simp also have "... = (β ⋆D e) ⋆D d" proof - have "«(β ⋆D e) ⋆D d : ((F g ⋆D w) ⋆D e) ⋆D d ==>D ((F g ⋆D w') ⋆D e) ⋆D d¬" using w e e.antipar β 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 ⋆D rD[w']) ⋅D ((F g ⋆D w' ⋆D ε) ⋅D aD[F g, w', e ⋆D d]) ⋅D (β ⋆D e ⋆D d) ⋅D (aD-1[F g, w, e ⋆D d] ⋅D (F g ⋆D w ⋆D D.inv ε)) ⋅D (F g ⋆D rD-1[w])" proof - have "(F g ⋆D aD[w', e, d]) ⋅D aD[F g, w' ⋆D e, d] ⋅D (aD[F g, w', e] ⋆D d) ⋅D aD-1[F g ⋆D w', e, d] = aD[F g, w', e ⋆D d]" proof - have "D.seq (F g ⋆D aD[w', e, d]) (aD[F g, w' ⋆D e, d] ⋅D (aD[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) ‹srcD w' = a› ‹trgD e = a› ‹trgD w' = map0 (srcC ρ)› e.ide_left e.ide_right preserves_src by metis qed moreover have "aD[F g ⋆D w, e, d] ⋅D (aD-1[F g, w, e] ⋆D d) ⋅D aD-1[F g, w ⋆D e, d] ⋅D (F g ⋆D aD-1[w, e, d]) = aD-1[F g, w, e ⋆D d]" proof - have "D.seq (aD-1[F g, w, e] ⋆D d) (aD-1[F g, w ⋆D e, d] ⋅D (F g ⋆D aD-1[w, e, d]))" using w w' e e.antipar by simp moreover have "D.inv aD-1[F g ⋆D w, e, d] = aD[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 ‹trgD 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 rD[w']) ⋅D aD[F g, w', trgD e] ⋅D (((F g ⋆D w') ⋆D ε) ⋅D (β ⋆D e ⋆D d) ⋅D ((F g ⋆D w) ⋆D D.inv ε)) ⋅D aD-1[F g, w, trgD e] ⋅D (F g ⋆D rD-1[w])" proof - have "(F g ⋆D w' ⋆D ε) ⋅D aD[F g, w', e ⋆D d] = aD[F g, w', trgD e] ⋅D ((F g ⋆D w') ⋆D ε)" using w' e e.antipar D.assoc_naturality [of "F g" w' ε] by simp moreover have "aD-1[F g, w, e ⋆D d] ⋅D (F g ⋆D w ⋆D D.inv ε) = ((F g ⋆D w) ⋆D D.inv ε) ⋅D aD-1[F g, w, trgD 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 rD[w']) ⋅D aD[F g, w', trgD e]) ⋅D (β ⋆D trgD e) ⋅D (aD-1[F g, w, trgD e] ⋅D (F g ⋆D rD-1[w]))" proof - have "((F g ⋆D w') ⋆D ε) ⋅D (β ⋆D e ⋆D d) ⋅D ((F g ⋆D w) ⋆D D.inv ε) = β ⋆D trgD 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 trgD e)" using w w' e e.antipar β D.interchange [of "F g ⋆D w'" β "D.inv ε" "trgD e"] D.comp_arr_dom D.comp_cod_arr e.counit_is_iso by auto also have "... = (((F g ⋆D w') ⋆D ε) ⋅D ((F g ⋆D w') ⋆D D.inv ε)) ⋅D (β ⋆D trgD e)" using D.comp_assoc by simp also have "... = ((F g ⋆D w') ⋆D ε ⋅D D.inv ε) ⋅D (β ⋆D trgD e)" using w' D.whisker_left [of "F g ⋆D w'"] by simp also have "... = ((F g ⋆D w') ⋆D trgD e) ⋅D (β ⋆D trgD e)" by (simp add: D.comp_arr_inv') also have "... = β ⋆D trgD 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) ‹srcD w' = a› ‹trgD 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 "... = rD[F g ⋆D w'] ⋅D (β ⋆D trgD e) ⋅D rD-1[F g ⋆D w]" using w w' D.runit_hcomp D.runit_hcomp [of "F g" w] by simp also have "... = rD[F g ⋆D w'] ⋅D rD-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 ‹srcD w' = a› ‹trgD e = a›) also have "... = (rD[F g ⋆D w'] ⋅D rD-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 rD[w']) ⋅D (F f ⋆D w' ⋆D ε) ⋅D (F f ⋆D aD[w', e, d]) ⋅D (F f ⋆D γe ⋆D d) ⋅D (F f ⋆D aD-1[w, e, d]) ⋅D (F f ⋆D w ⋆D D.inv ε) ⋅D (F f ⋆D rD-1[w])" using w θ γ D.whisker_left by (metis D.arrI D.seqE T'.ide_leg0) also have "... = (θ' ⋅D (F f ⋆D rD[w'])) ⋅D (F f ⋆D w' ⋆D ε) ⋅D (F f ⋆D aD[w', e, d]) ⋅D (aD[F f, w' ⋆D e, d] ⋅D ((F f ⋆D γe) ⋆D d) ⋅D aD-1[F f, w ⋆D e, d]) ⋅D (F f ⋆D aD-1[w, e, d]) ⋅D (F f ⋆D w ⋆D D.inv ε) ⋅D (F f ⋆D rD-1[w])" proof - have 1: "aD[F f, w' ⋆D e, d] ⋅D ((F f ⋆D γe) ⋆D d) ⋅D aD-1[F f, w ⋆D e, d] = aD[F f, w' ⋆D e, d] ⋅D aD-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: "... = (aD[F f, w' ⋆D e, d] ⋅D aD-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 "(aD[F f, w' ⋆D e, d] ⋅D aD-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) wC' 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 "aD[F f, w' ⋆D e, d] ⋅D ((F f ⋆D γe) ⋆D d) ⋅D (aD-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 rD[F f ⋆D w']) ⋅D aD-1[F f, w', srcD w']) ⋅D (F f ⋆D w' ⋆D ε) ⋅D (F f ⋆D aD[w', e, d]) ⋅D (aD[F f, w' ⋆D e, d] ⋅D ((F f ⋆D γe) ⋆D d) ⋅D aD-1[F f, w ⋆D e, d]) ⋅D (F f ⋆D aD-1[w, e, d]) ⋅D (F f ⋆D w ⋆D D.inv ε) ⋅D (F f ⋆D rD-1[w])" using w' D.runit_hcomp(3) [of "F f" w'] D.comp_assoc by simp also have "... = rD[u] ⋅D (θ' ⋆D srcD w') ⋅D (aD-1[F f, w', srcD w'] ⋅D (F f ⋆D w' ⋆D ε)) ⋅D (F f ⋆D aD[w', e, d]) ⋅D (aD[F f, w' ⋆D e, d] ⋅D ((F f ⋆D γe) ⋆D d) ⋅D aD-1[F f, w ⋆D e, d]) ⋅D (F f ⋆D aD-1[w, e, d]) ⋅D (F f ⋆D w ⋆D D.inv ε) ⋅D (F f ⋆D rD-1[w])" using θ' D.runit_naturality [of θ'] D.comp_assoc by fastforce also have "... = rD[u] ⋅D ((θ' ⋆D srcD w') ⋅D ((F f ⋆D w') ⋆D ε)) ⋅D aD-1[F f, w', e ⋆D d] ⋅D (F f ⋆D aD[w', e, d]) ⋅D aD[F f, w' ⋆D e, d] ⋅D ((F f ⋆D γe) ⋆D d) ⋅D aD-1[F f, w ⋆D e, d] ⋅D (F f ⋆D aD-1[w, e, d]) ⋅D (F f ⋆D w ⋆D D.inv ε) ⋅D (F f ⋆D rD-1[w])" using w' D.assoc'_naturality [of "F f" w' ε] D.comp_assoc by simp also have "... = rD[u] ⋅D (u ⋆D ε) ⋅D (θ' ⋆D e ⋆D d) ⋅D aD-1[F f, w', e ⋆D d] ⋅D (F f ⋆D aD[w', e, d]) ⋅D (aD[F f, w' ⋆D e, d] ⋅D ((F f ⋆D γe) ⋆D d)) ⋅D aD-1[F f, w ⋆D e, d] ⋅D (F f ⋆D aD-1[w, e, d]) ⋅D (F f ⋆D w ⋆D D.inv ε) ⋅D (F f ⋆D rD-1[w])" proof - have "(θ' ⋆D srcD w') ⋅D ((F f ⋆D w') ⋆D ε) = θ' ⋆D ε" using D.interchange D.comp_arr_dom D.comp_cod_arr by (metis D.in_homE ‹srcD w' = a› ‹trgD 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 srcD 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 "... = rD[u] ⋅D (u ⋆D ε) ⋅D (θ' ⋆D e ⋆D d) ⋅D aD-1[F f, w', e ⋆D d] ⋅D (F f ⋆D aD[w', e, d]) ⋅D (F f ⋆D γe ⋆D d) ⋅D ((aD[F f, w ⋆D e, d] ⋅D aD-1[F f, w ⋆D e, d]) ⋅D (F f ⋆D aD-1[w, e, d])) ⋅D (F f ⋆D w ⋆D D.inv ε) ⋅D (F f ⋆D rD-1[w])" proof - have "aD[F f, w' ⋆D e, d] ⋅D ((F f ⋆D γe) ⋆D d) = (F f ⋆D γe ⋆D d) ⋅D aD[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 "... = rD[u] ⋅D (u ⋆D ε) ⋅D (θ' ⋆D e ⋆D d) ⋅D (aD-1[F f, w', e ⋆D d]) ⋅D (F f ⋆D aD[w', e, d]) ⋅D (F f ⋆D γe ⋆D d) ⋅D (F f ⋆D aD-1[w, e, d]) ⋅D (F f ⋆D w ⋆D D.inv ε) ⋅D (F f ⋆D rD-1[w])" proof - have "(aD[F f, w ⋆D e, d] ⋅D aD-1[F f, w ⋆D e, d]) ⋅D (F f ⋆D aD-1[w, e, d]) = F f ⋆D aD-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 "... = rD[u] ⋅D (u ⋆D ε) ⋅D (θ' ⋆D e ⋆D d) ⋅D ((aD-1[F f, w', e ⋆D d]) ⋅D (F f ⋆D aD[w', e, d]) ⋅D aD[F f, w' ⋆D e, d]) ⋅D ((F f ⋆D γe) ⋆D d) ⋅D aD-1[F f, w ⋆D e, d] ⋅D (F f ⋆D aD-1[w, e, d]) ⋅D (F f ⋆D w ⋆D D.inv ε) ⋅D (F f ⋆D rD-1[w])" proof - have "F f ⋆D γe ⋆D d = aD[F f, w' ⋆D e, d] ⋅D ((F f ⋆D γe) ⋆D d) ⋅D aD-1[F f, w ⋆D e, d]" proof - have "aD[F f, w' ⋆D e, d] ⋅D ((F f ⋆D γe) ⋆D d) ⋅D aD-1[F f, w ⋆D e, d] = aD[F f, w' ⋆D e, d] ⋅D aD-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) ‹srcD e = map0 aC› d.triangle_equiv_form(1) d.triangle_in_hom(3) d.triangle_left preserves_src we) also have "... = (aD[F f, w' ⋆D e, d] ⋅D aD-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) wC' 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 "... = rD[u] ⋅D (u ⋆D ε) ⋅D ((θ' ⋆D e ⋆D d) ⋅D aD[F f ⋆D w', e, d]) ⋅D (aD-1[F f, w', e] ⋆D d) ⋅D ((F f ⋆D γe) ⋆D d) ⋅D aD-1[F f, w ⋆D e, d] ⋅D (F f ⋆D aD-1[w, e, d]) ⋅D (F f ⋆D w ⋆D D.inv ε) ⋅D (F f ⋆D rD-1[w])" proof - have "(aD-1[F f, w', e ⋆D d]) ⋅D (F f ⋆D aD[w', e, d]) ⋅D aD[F f, w' ⋆D e, d] = aD[F f ⋆D w', e, d] ⋅D (aD-1[F f, w', e] ⋆D d)" proof - have "aD[F f, w', e ⋆D d] ⋅D aD[F f ⋆D w', e, d] = ((F f ⋆D aD[w', e, d]) ⋅D aD[F f, w' ⋆D e, d]) ⋅D (aD[F f, w', e] ⋆D d)" using w' D.pentagon D.comp_assoc by simp moreover have "D.seq aD[F f, w', e ⋆D d] aD[F f ⋆D w', e, d]" using w' by simp moreover have "D.inv (aD[F f, w', e] ⋆D d) = aD-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 "aD[F f, w', e ⋆D d]" "aD[F f ⋆D w', e, d]" "(F f ⋆D aD[w', e, d]) ⋅D aD[F f, w' ⋆D e, d]" "aD[F f, w', e] ⋆D d"] by simp qed thus ?thesis using D.comp_assoc by simp qed also have "... = rD[u] ⋅D (u ⋆D ε) ⋅D aD[u, e, d] ⋅D (((θ' ⋆D e) ⋆D d) ⋅D (aD-1[F f, w', e] ⋆D d) ⋅D ((F f ⋆D γe) ⋆D d)) ⋅D aD-1[F f, w ⋆D e, d] ⋅D (F f ⋆D aD-1[w, e, d]) ⋅D (F f ⋆D w ⋆D D.inv ε) ⋅D (F f ⋆D rD-1[w])" proof - have "(θ' ⋆D e ⋆D d) ⋅D aD[F f ⋆D w', e, d] = aD[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 "... = rD[u] ⋅D (u ⋆D ε) ⋅D aD[u, e, d] ⋅D ((θ' ⋆D e) ⋅D aD-1[F f, w', e] ⋅D (F f ⋆D γe) ⋆D d) ⋅D aD-1[F f, w ⋆D e, d] ⋅D (F f ⋆D aD-1[w, e, d]) ⋅D (F f ⋆D w ⋆D D.inv ε) ⋅D (F f ⋆D rD-1[w])" proof - have "((θ' ⋆D e) ⋆D d) ⋅D (aD-1[F f, w', e] ⋆D d) ⋅D ((F f ⋆D γe) ⋆D d) = (θ' ⋆D e) ⋅D aD-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 "... = rD[u] ⋅D (u ⋆D ε) ⋅D aD[u, e, d] ⋅D ((θ ⋆D e) ⋅D aD-1[F f, w, e] ⋆D d) ⋅D aD-1[F f, w ⋆D e, d] ⋅D (F f ⋆D aD-1[w, e, d]) ⋅D (F f ⋆D w ⋆D D.inv ε) ⋅D (F f ⋆D rD-1[w])" proof - have "ψ ⋅D (θ' ⋆D e) ⋅D aD-1[F f, w', e] ⋅D (F f ⋆D γe) = ψ ⋅D (θ ⋆D e) ⋅D aD-1[F f, w, e]" using Pγe by simp moreover have "D.arr (ψ ⋅D (θ' ⋆D e) ⋅D aD-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 aD-1[F f, w, e])" using Pγe calculation(2) by auto ultimately have "(θ' ⋆D e) ⋅D aD-1[F f, w', e] ⋅D (F f ⋆D γe) = (θ ⋆D e) ⋅D aD-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 "... = rD[u] ⋅D (u ⋆D ε) ⋅D aD[u, e, d] ⋅D ((θ ⋆D e) ⋆D d) ⋅D ((aD-1[F f, w, e] ⋆D d) ⋅D aD-1[F f, w ⋆D e, d] ⋅D (F f ⋆D aD-1[w, e, d])) ⋅D (F f ⋆D w ⋆D D.inv ε) ⋅D (F f ⋆D rD-1[w])" proof - have "(θ ⋆D e) ⋅D aD-1[F f, w, e] ⋆D d = ((θ ⋆D e) ⋆D d) ⋅D (aD-1[F f, w, e] ⋆D d)" proof - have "D.arr ((θ ⋆D e) ⋅D aD-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 "... = rD[u] ⋅D (u ⋆D ε) ⋅D aD[u, e, d] ⋅D (((θ ⋆D e) ⋆D d) ⋅D aD-1[F f ⋆D w, e, d]) ⋅D aD-1[F f, w, e ⋆D d] ⋅D (F f ⋆D w ⋆D D.inv ε) ⋅D (F f ⋆D rD-1[w])" using w D.pentagon' D.comp_assoc by simp also have "... = rD[u] ⋅D (u ⋆D ε) ⋅D ((aD[u, e, d] ⋅D aD-1[u, e, d]) ⋅D (θ ⋆D e ⋆D d)) ⋅D aD-1[F f, w, e ⋆D d] ⋅D (F f ⋆D w ⋆D D.inv ε) ⋅D (F f ⋆D rD-1[w])" using θ e.antipar D.assoc'_naturality [of θ e d] D.comp_assoc by fastforce also have "... = rD[u] ⋅D (u ⋆D ε) ⋅D (θ ⋆D e ⋆D d) ⋅D (aD-1[F f, w, e ⋆D d] ⋅D (F f ⋆D w ⋆D D.inv ε)) ⋅D (F f ⋆D rD-1[w])" proof - have "(aD[u, e, d] ⋅D aD-1[u, e, d]) ⋅D (θ ⋆D e ⋆D d) = θ ⋆D e ⋆D d" proof - have "(aD[u, e, d] ⋅D aD-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 "... = rD[u] ⋅D ((u ⋆D ε) ⋅D (θ ⋆D e ⋆D d)) ⋅D ((F f ⋆D w) ⋆D D.inv ε) ⋅D aD-1[F f, w, trgD e] ⋅D (F f ⋆D rD-1[w])" using w e.antipar D.assoc'_naturality [of "F f" w "D.inv ε"] D.comp_assoc by simp also have "... = rD[u] ⋅D (θ ⋆D trgD e) ⋅D (((F f ⋆D w) ⋆D ε) ⋅D ((F f ⋆D w) ⋆D D.inv ε) ⋅D aD-1[F f, w, trgD e]) ⋅D (F f ⋆D rD-1[w])" proof - have "(u ⋆D ε) ⋅D (θ ⋆D e ⋆D d) = (θ ⋆D trgD 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 ‹trgD e = a› e.counit_simps(1-3,5)) thus ?thesis using D.comp_assoc by simp qed also have "... = rD[u] ⋅D (θ ⋆D trgD e) ⋅D aD-1[F f, w, trgD e] ⋅D (F f ⋆D rD-1[w])" proof - have "(((F f ⋆D w) ⋆D ε) ⋅D ((F f ⋆D w) ⋆D D.inv ε)) ⋅D aD-1[F f, w, trgD e] = aD-1[F f, w, trgD e]" proof - have "(((F f ⋆D w) ⋆D ε) ⋅D ((F f ⋆D w) ⋆D D.inv ε)) ⋅D aD-1[F f, w, trgD e] = ((F f ⋆D w) ⋆D trgD e) ⋅D aD-1[F f, w, trgD 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) ‹trgD w = map0 (srcC ρ)› d.unit_in_vhom e.counit_in_hom(2) e.counit_simps(3) preserves_src) also have "... = aD-1[F f, w, trgD e]" using w D.comp_cod_arr D.assoc'_in_hom(2) [of "F f" w "trgD e"] ‹trgD e = a› ‹trgD w = map0 (srcC ρ)› 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 "... = (rD[u] ⋅D (θ ⋆D trgD e)) ⋅D rD-1[F f ⋆D w]" using w D.runit_hcomp(2) [of "F f" w] D.comp_assoc by simp also have 1: "... = (θ ⋅D rD[F f ⋆D w]) ⋅D rD-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 ‹srcD θ = a› ‹trgD 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 "?γ = rD[w'] ⋅D (w' ⋆D ε) ⋅D (aD[w', e, d] ⋅D ((γ' ⋆D e) ⋆D d)) ⋅D aD-1[w, e, d] ⋅D (w ⋆D D.inv ε) ⋅D rD-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 "aD[F g, w', e] ⋅D (β ⋆D e) ⋅D aD-1[F g, w, e] = F g ⋆D γ' ⋆D e" proof - have "aD[F g, w', e] ⋅D (β ⋆D e) ⋅D aD-1[F g, w, e] = aD[F g, w', e] ⋅D ((F g ⋆D γ') ⋆D e) ⋅D aD-1[F g, w, e]" using γ' by simp also have "... = aD[F g, w', e] ⋅D aD-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 "... = (aD[F g, w', e] ⋅D aD-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 aD-1[F f, w, e] = ψ ⋅D (θ' ⋆D e) ⋅D aD-1[F f, w', e] ⋅D (F f ⋆D γ' ⋆D e)" proof - have "ψ ⋅D (θ' ⋆D e) ⋅D aD-1[F f, w', e] ⋅D (F f ⋆D γ' ⋆D e) = ψ ⋅D (θ' ⋆D e) ⋅D ((F f ⋆D γ') ⋆D e) ⋅D aD-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 aD-1[F f, w, e]" using D.comp_assoc by simp also have "... = ψ ⋅D (θ' ⋅D (F f ⋆D γ') ⋆D e) ⋅D aD-1[F f, w, e]" using D.whisker_right γ' θ by auto also have "... = ψ ⋅D (θ ⋆D e) ⋅D aD-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 "... = rD[w'] ⋅D ((w' ⋆D ε) ⋅D (γ' ⋆D e ⋆D d)) ⋅D aD[w, e, d] ⋅D aD-1[w, e, d] ⋅D (w ⋆D D.inv ε) ⋅D rD-1[w]" using w' γ' D.comp_assoc D.assoc_naturality by (metis D.in_homE D.src_dom ‹trgD 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 "... = (rD[w'] ⋅D (γ' ⋆D trgD e)) ⋅D (w ⋆D ε) ⋅D aD[w, e, d] ⋅D aD-1[w, e, d] ⋅D (w ⋆D D.inv ε) ⋅D rD-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 trgD e) ⋅D (w ⋆D ε)" using w γ' e.antipar D.comp_arr_dom D.comp_cod_arr D.interchange by (metis D.in_homE ‹trgD e = a› e.counit_simps(1) e.counit_simps(3,5)) finally have "(w' ⋆D ε) ⋅D (γ' ⋆D e ⋆D d) = (γ' ⋆D trgD e) ⋅D (w ⋆D ε)" by simp thus ?thesis using D.comp_assoc by simp qed also have "... = γ' ⋅D rD[w] ⋅D (w ⋆D ε) ⋅D aD[w, e, d] ⋅D aD-1[w, e, d] ⋅D (w ⋆D D.inv ε) ⋅D rD-1[w]" using γ' D.runit_naturality D.comp_assoc by (metis D.in_homE D.src_dom ‹trgD e = a› a_def) also have "... = γ'" proof - have "rD[w] ⋅D (w ⋆D ε) ⋅D aD[w, e, d] ⋅D aD-1[w, e, d] ⋅D (w ⋆D D.inv ε) ⋅D rD-1[w] = rD[w] ⋅D ((w ⋆D ε) ⋅D (aD[w, e, d] ⋅D aD-1[w, e, d]) ⋅D (w ⋆D D.inv ε)) ⋅D rD-1[w]" using D.comp_assoc by simp also have "... = rD[w] ⋅D ((w ⋆D ε) ⋅D (w ⋆D e ⋆D d) ⋅D (w ⋆D D.inv ε)) ⋅D rD-1[w]" using w γ e.ide_left e.ide_right we e.antipar D.comp_assoc_assoc'(1) ‹trgD e = a› a_def by presburger also have "... = rD[w] ⋅D ((w ⋆D ε) ⋅D (w ⋆D D.inv ε)) ⋅D rD-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 "... = rD[w] ⋅D (w ⋆D srcD w) ⋅D rD-1[w]" using w e.counit_is_iso C.comp_arr_inv' by (metis D.comp_arr_inv' D.seqI' D.whisker_left ‹trgD e = a› a_def d.unit_in_vhom e.counit_in_hom(2) e.counit_simps(3)) also have "... = rD[w] ⋅D rD-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 "rD[w] ⋅D (w ⋆D ε) ⋅D aD[w, e, d] ⋅D aD-1[w, e, d] ⋅D (w ⋆D D.inv ε) ⋅D rD-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 VD HD aD iD srcD trgD (F r) (D.inv (Φ (r, f)) ⋅D F ρ) (F f) (F g)" shows "tabulation VC HC aC iC srcC trgC r ρ f g" proof - interpret ρ': tabulation VD HD aD iD srcD trgD ‹F r› ‹D.inv (Φ (r, f)) ⋅D F ρ› ‹F f› ‹F g› using assms by auto interpret ρ: tabulation_data VC HC aC iC srcC trgC r ρ f g using assms by (unfold_locales, simp_all) interpret ρ: tabulation VC HC aC iC srcC trgC 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: "srcC r = trgC 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: "srcD (F f) = trgD 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: "srcD (F g) = trgD w" using u ψ wθν by (simp add: hseq_Ff_w) have w: "«w : map0 (srcC ψ) →D map0 (srcC 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' : srcC ψ →C srcC 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': "srcC (f ⋆C w') = srcC 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.comp_in_homI) show "«D.inv (Φ (f, w')) : F (f ⋆C w') ==>D F f ⋆D F w'¬" using assms w' cmp_in_hom cmp_components_are_iso by auto show "«F f ⋆D φ : F f ⋆D F w' ==>D F f ⋆D w¬" 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 aC[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 aD[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 aC[r, f, w'] = Φ (r, f ⋆C w') ⋅D (F r ⋆D Φ (f, w')) ⋅D aD[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 aD[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 aD[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 aD[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 aD[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 (aD[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 aD[F r, F f, w] ⋅D (D.inv (Φ (r, f)) ⋅D F ρ ⋆D w) ⋅D ν" proof - have "aD[F r, F f, F w'] ⋅D ((F r ⋆D F f) ⋆D D.inv φ) = (F r ⋆D F f ⋆D D.inv φ) ⋅D aD[F r, F f, w]" proof - have "srcD (F r) = trgD (F f)" by simp moreover have "srcD (F f) = trgD (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 aD[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: "srcC r = trgC 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: "srcC f = trgC w ∧ srcC f = trgC 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: "srcC g = trgC w ∧ srcC g = trgC w'" using w w' ρ.ide_leg0 θ θ' ‹srcC f = trgC w ∧ srcC f = trgC 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 aD[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 aD[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 aD[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, 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 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 aD[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 aC[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 aC[r, f, w'] = Φ (r, f ⋆C w') ⋅D (F r ⋆D Φ (f, w')) ⋅D aD[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 aC[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 aD[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 aC[r, f, w] = Φ (r, f ⋆C w) ⋅D (F r ⋆D Φ (f, w)) ⋅D aD[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 aD[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 "∧γ1 γ2. «γ1 : w ==>C w'¬ ∧ β = g ⋆C γ1 ∧ θ = θ' ⋅C (f ⋆C γ1) ==> «γ2 : w ==>C w'¬ ∧ β = g ⋆C γ2 ∧ θ = θ' ⋅C (f ⋆C γ2) ==> γ1 = γ2" proof - fix γ1 γ2 assume γ1: "«γ1 : w ==>C w'¬ ∧ β = g ⋆C γ1 ∧ θ = θ' ⋅C (f ⋆C γ1)" assume γ2: "«γ2 : w ==>C w'¬ ∧ β = g ⋆C γ2 ∧ θ = θ' ⋅C (f ⋆C γ2)" have Fβ1: "F β = Φ (g, w') ⋅D (F g ⋆D F γ1) ⋅D D.inv (Φ (g, w))" using w w' β hseq_gw γ1 preserves_hcomp [of g γ1] cmp_components_are_iso by auto have Fβ2: "F β = Φ (g, w') ⋅D (F g ⋆D F γ2) ⋅D D.inv (Φ (g, w))" using w w' β hseq_gw γ2 preserves_hcomp [of g γ2] cmp_components_are_iso by auto have "D.inv (Φ (g, w')) ⋅D F β ⋅D Φ (g, w) = F g ⋆D F γ1" proof - have "F β ⋅D Φ (g, w) = Φ (g, w') ⋅D (F g ⋆D F γ1)" using w w' β hseq_gw γ1 Fβ1 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 γ1 preserves_hcomp cmp_components_are_iso D.invert_side_of_triangle by (metis C.arrI D.cod_comp D.seqE D.seqI Fβ1 ρ.ide_leg1 preserves_arr) qed moreover have "D.inv (Φ (g, w')) ⋅D F β ⋅D Φ (g, w) = F g ⋆D F γ2" proof - have "F β ⋅D Φ (g, w) = Φ (g, w') ⋅D (F g ⋆D F γ2)" using w w' β hseq_gw γ2 Fβ2 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 γ2 preserves_hcomp cmp_components_are_iso D.invert_side_of_triangle by (metis C.arrI D.cod_comp D.seqE D.seqI Fβ2 ρ.ide_leg1 preserves_arr) qed moreover have "F θ ⋅D Φ (f, w) = (F θ' ⋅D Φ (f, w')) ⋅D (F f ⋆D F γ1)" proof - have "F θ ⋅D Φ (f, w) = F (θ' ⋅C (f ⋆C γ1)) ⋅D Φ (f, w)" using γ1 by blast also have "... = (F θ' ⋅D F (f ⋆C γ1)) ⋅D Φ (f, w)" using γ1 θ by auto also have "... = (F θ' ⋅D Φ (f, w') ⋅D (F f ⋆D F γ1) ⋅D D.inv (Φ (f, w))) ⋅D Φ (f, w)" using γ1 hseq_fw preserves_hcomp by auto also have "... = F θ' ⋅D Φ (f, w') ⋅D (F f ⋆D F γ1) ⋅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 γ1) ⋅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 γ1)" using w γ1 D.whisker_left [of "F f" "F γ1" "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 γ2)" proof - have "F θ ⋅D Φ (f, w) = F (θ' ⋅C (f ⋆C γ2)) ⋅D Φ (f, w)" using γ2 by blast also have "... = (F θ' ⋅D F (f ⋆C γ2)) ⋅D Φ (f, w)" using γ2 θ by auto also have "... = (F θ' ⋅D Φ (f, w') ⋅D (F f ⋆D F γ2) ⋅D D.inv (Φ (f, w))) ⋅D Φ (f, w)" using γ2 hseq_fw preserves_hcomp by auto also have "... = F θ' ⋅D Φ (f, w') ⋅D (F f ⋆D F γ2) ⋅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 γ2) ⋅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 γ2)" using w γ2 D.whisker_left [of "F f" "F γ2" "F w"] D.comp_arr_dom by auto finally show ?thesis using D.comp_assoc by simp qed ultimately have "F γ1 = F γ2" using γ1 γ2 * by blast thus "γ1 = γ2" using γ1 γ2 is_faithful [of γ1 γ2] by auto qed ultimately show "∃!γ. «γ : w ==>C w'¬ ∧ β = g ⋆C γ ∧ θ = θ' ⋅C (f ⋆C γ)" by blast qed qed qed show ?thesis .. qed end end
¤ Die Informationen auf dieser Webseite wurden nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit, noch Qualität der bereit gestellten Informationen zugesichert.0.893Bemerkung: (vorverarbeitet am 2026-06-10) ¤*Bot Zugriff |
|
||||||||||||||
2026-06-09