proposition: Lemma inner_swap_composite_second_arg (x y1 y2 z w : V) : mon_lassociator _ _ _ #⊗ (identity _) · inner_swap x (y1 ⊗ y2) z w · (identity _) #⊗ mon_lassociator _ _ _ = inner_swap (x ⊗ y1) y2 z w · mon_lassociator _ _ _ · inner_swap x y1 z (y2 ⊗ w).
proof: Proof. unfold inner_swap. rewrite sym_mon_tensor_rassociator. rewrite !tensor_mor_left. rewrite !tensor_comp_id_l. rewrite !tensor_mor_right. rewrite !tensor_comp_id_r. rewrite !tensor_comp_id_l. rewrite !assoc. etrans. 2: { do 2 apply maponpaths_2. rewrite !assoc'. do 9 apply maponpaths. rewrite <- tensor_id_id. assert (aux := tensor_lassociator (sym_mon_braiding V y1 z) (identity y2) (identity w)). apply (z_iso_inv_on_right _ _ _ (z_iso_from_associator_iso V _ _ _)) in aux. cbn in aux. exact aux. } rewrite !tensor_comp_id_l. rewrite !assoc. assert (cohe1 : identity x #⊗ (mon_lassociator z y1 y2 #⊗ identity w) · identity x #⊗ mon_lassociator z (y1 ⊗ y2) w · mon_rassociator x z (y1 ⊗ y2 ⊗ w) · identity (x ⊗ z) #⊗ mon_lassociator y1 y2 w = identity x #⊗ mon_lassociator (z ⊗ y1) y2 w · identity x #⊗ mon_lassociator z y1 (y2 ⊗ w) · mon_rassociator x z (y1 ⊗ (y2 ⊗ w))). { refine (!_). etrans. { rewrite <- tensor_comp_id_l. rewrite mon_lassociator_lassociator. rewrite !tensor_comp_id_l. apply idpath. } rewrite !assoc'. do 2 apply maponpaths. rewrite tensor_rassociator. rewrite tensor_id_id. apply idpath. } etrans. { rewrite !assoc'. do 7 apply maponpaths. rewrite !assoc. exact cohe1. } rewrite !assoc. do 3 apply maponpaths_2. etrans. 2: { do 7 apply maponpaths_2. rewrite assoc'. do 2 apply maponpaths. rewrite <- tensor_id_id. etrans. 2: { assert (aux := tensor_lassociator (identity x) (identity y1) (sym_mon_braiding V y2 z #⊗ identity w)). apply pathsinv0, (z_iso_inv_on_left _ _ _ _ (z_iso_from_associator_iso V _ _ _)), pathsinv0 in aux. cbn in aux. exact aux. } apply maponpaths_2. do 2 apply maponpaths. assert (aux := tensor_lassociator (identity y1) (sym_mon_braiding V y2 z) (identity w)). apply (z_iso_inv_on_right _ _ _ (z_iso_from_associator_iso V _ _ _)) in aux. cbn in aux. exact aux. } rewrite !tensor_comp_id_l. rewrite !assoc. change ((pr12 V) y2 z) with (sym_mon_braiding V y2 z). assert (cohe2 : mon_lassociator x y1 y2 #⊗ identity (z ⊗ w) · mon_lassociator x (y1 ⊗ y2) (z ⊗ w) · identity x #⊗ mon_rassociator (y1 ⊗ y2) z w · identity x #⊗ (mon_lassociator y1 y2 z #⊗ identity w) = mon_lassociator (x ⊗ y1) y2 (z ⊗ w) · identity (x ⊗ y1) #⊗ mon_rassociator y2 z w · mon_lassociator x y1 (y2 ⊗ z ⊗ w) · identity x #⊗ αinv^{ V }_{ y1, y2 ⊗ z, w}). { refine (!_). etrans. { apply maponpaths_2. rewrite !assoc'. rewrite <- tensor_id_id. rewrite tensor_lassociator. rewrite !assoc. rewrite mon_lassociator_lassociator. apply idpath. } rewrite !assoc'. do 2 apply maponpaths. rewrite <- !tensor_comp_id_l. apply maponpaths. refine ((!id_left _) @ _). rewrite <- mon_rassociator_lassociator. rewrite !assoc'. apply maponpaths. rewrite !assoc. rewrite mon_lassociator_lassociator. rewrite !assoc'. refine (_ @ id_right _). apply maponpaths. etrans. { apply maponpaths. rewrite !assoc. rewrite <- tensor_comp_id_l. rewrite mon_lassociator_rassociator. rewrite tensor_id_id. apply id_left. } apply mon_lassociator_rassociator. } etrans. { do 3 apply maponpaths_2. exact cohe2. } rewrite !assoc'. do 5 apply maponpaths. rewrite !assoc. apply maponpaths_2. refine (!_). etrans. { rewrite !assoc'. do 3 apply maponpaths. rewrite !assoc. rewrite mon_rassociator_lassociator. rewrite id_left. apply idpath. } etrans. { do 2 apply maponpaths. rewrite !assoc. rewrite <- tensor_id_id. rewrite tensor_lassociator. apply idpath. } etrans. { apply maponpaths. rewrite !assoc. do 3 apply maponpaths_2. apply mon_rassociator_lassociator. } rewrite id_left. rewrite !assoc'. etrans. { apply maponpaths. etrans. { apply maponpaths. refine (!_). apply tensor_comp_id_l. } refine (!_). apply tensor_comp_id_l. } refine (!(tensor_comp_id_l _ _) @ _). apply maponpaths. etrans. { do 2 apply maponpaths. apply mon_rassociator_rassociator. } etrans. { apply maponpaths. rewrite !assoc. do 2 apply maponpaths_2. refine (!_). apply tensor_comp_id_l. } rewrite mon_lassociator_rassociator. rewrite tensor_id_id. rewrite id_left. rewrite !assoc. etrans. { apply maponpaths_2. apply mon_lassociator_rassociator. } apply id_left. Qed.
imports: UniMath.Foundations.All UniMath.MoreFoundations.All UniMath.CategoryTheory.Core.Categories UniMath.CategoryTheory.Core.Functors UniMath.CategoryTheory.Core.Isos UniMath.CategoryTheory.Limits.BinProducts UniMath.CategoryTheory.PrecategoryBinProduct UniMath.CategoryTheory.Monoidal.WhiskeredBifunctors UniMath.CategoryTheory.Monoidal.Categories UniMath.CategoryTheory.Monoidal.Structure.Symmetric