Lemma Y_inhab_proof (b b' : D) (f : b --> b') (a0 : C) (h0 : unitary _ (H a0) b) (a0' : C) (h0' : unitary _ (H a0') b') : ∏ (a : C) (h : unitary _ (H a) b) (a' : C) (h' : unitary _ (H a') b') (l : a --> a'), #H l· h' = h· f -> #F l· k b' a' h' = k b a h· ((unitary_inv (k b a0 h0)· #F (fH^-1 ((h0· f)· unitary_inv h0')))· k b' a0' h0'). Proof. intros a h a' h' l alpha. set (m := fH^-i _ _ (unitary_comp h0 (unitary_inv h))). set (m' := fH^-i _ _ (unitary_comp h0' (unitary_inv h'))). assert (sss : unitary_comp (dagger_functor_on_unitary dagF _ _ m) (k b a h) = k b a0 h0). { apply unitary_eq. apply (q b (tpair _ a0 h0) (tpair _ a h) m). simpl. inv_functor fH a0 a. rewrite <- assoc. refine (_ @ id_right _). apply maponpaths, (pr2 h). } assert (ssss : unitary_comp (dagger_functor_on_unitary dagF _ _ m') (k b' a' h') = k b' a0' h0'). { apply unitary_eq. apply (q b' (tpair _ a0' h0') (tpair _ a' h') m'). simpl; inv_functor fH a0' a'. rewrite <- assoc. refine (_ @ id_right _). apply maponpaths, (pr22 h'). } set (hfh := h0 · f · unitary_inv h0'). set (l0 := fH^-1 hfh). set (g0 := unitary_inv (k b a0 h0) · #F l0 · k b' a0' h0'). assert (sssss : #H (l0 · m') = #H (m · l)). { rewrite functor_comp . unfold m'. simpl. inv_functor fH a0' a'. unfold l0. inv_functor fH a0 a0'. unfold hfh. intermediate_path (h0 · f · (unitary_inv h0' · h0') · unitary_inv h'). { repeat rewrite assoc; apply idpath. } etrans. { apply maponpaths_2, maponpaths. apply (pr22 h0'). } rewrite id_right, functor_comp. inv_functor fH a0 a. repeat rewrite <- assoc. apply maponpaths, pathsinv0. apply unitary_inv_on_right. { apply h. } rewrite assoc. apply unitary_inv_on_left. { apply h'. } apply pathsinv0, alpha. } assert (star5 : unitary_inv m · l0 = l · unitary_inv m'). { apply unitary_inv_on_right. { apply m. } rewrite assoc. apply unitary_inv_on_left. { apply m'. } apply (invmaponpathsweq (weq_from_fully_faithful fH a0 a')), pathsinv0, sssss. } clear sssss. unfold g0. assert (sss'' : k b a h · unitary_inv (k b a0 h0) = unitary_inv (dagger_functor_on_unitary dagF _ _ m)). { apply pathsinv0. apply unitary_inv_on_left. { apply k. } apply pathsinv0. apply unitary_inv_on_right. { apply dagger_functor_on_unitary. } apply pathsinv0, (base_paths _ _ sss). } repeat rewrite assoc. rewrite sss''. clear sss'' sss. rewrite dagger_functor_on_unitary_inv. etrans. 2: { apply maponpaths_2, functor_comp. } cbn. unfold m, m' in star5. cbn in star5. rewrite star5; clear star5. rewrite functor_comp. rewrite <- assoc. apply maponpaths. assert (star4 : unitary_inv (dagger_functor_on_unitary dagF _ _ m') · k b' a0' h0' = k b' a' h'). { apply unitary_inv_on_right. { apply dagger_functor_on_unitary. } apply pathsinv0, (base_paths _ _ ssss). } refine (! star4 @ _). apply maponpaths_2. apply pathsinv0, dagF. Qed.
Require Import UniMath.Foundations.All. Require Import UniMath.MoreFoundations.All. Require Import UniMath.CategoryTheory.Core.Categories. Require Import UniMath.CategoryTheory.Core.Functors. Require Import UniMath.CategoryTheory.Core.NaturalTransformations. Require Import UniMath.CategoryTheory.whiskering. Require Import UniMath.CategoryTheory.DisplayedCats.Core. Require Import UniMath.CategoryTheory.DisplayedCats.Functors. Require Import UniMath.CategoryTheory.DisplayedCats.Total. Require Import UniMath.CategoryTheory.DisplayedCats.TotalCategoryFacts. Require Import UniMath.CategoryTheory.precomp_fully_faithful. Require Import UniMath.CategoryTheory.DaggerCategories.Categories. Require Import UniMath.CategoryTheory.DaggerCategories.Functors. Require Import UniMath.CategoryTheory.DaggerCategories.Transformations. Require Import UniMath.CategoryTheory.DaggerCategories.Unitary. Require Import UniMath.CategoryTheory.DaggerCategories.Univalence. Require Import UniMath.CategoryTheory.DaggerCategories.FunctorCategory. Require Import UniMath.CategoryTheory.DaggerCategories.Functors.FullyFaithful. Require Import UniMath.CategoryTheory.DaggerCategories.Functors.WeakEquivalences.