Library UniMath.CategoryTheory.Bicategories.Transformations.Examples.Composition

Composition of lax transformations gives another transformation. In addition, if both are pseudo transformations, then the composition is a pseudotransformation as well.
Require Import UniMath.Foundations.All.
Require Import UniMath.MoreFoundations.All.
Require Import UniMath.CategoryTheory.Categories.
Require Import UniMath.CategoryTheory.functor_categories.
Require Import UniMath.CategoryTheory.PrecategoryBinProduct.
Require Import UniMath.CategoryTheory.Bicategories.Bicategories.Bicat.
Import Bicat.Notations.
Require Import UniMath.CategoryTheory.Bicategories.Bicategories.BicategoryLaws.
Require Import UniMath.CategoryTheory.Bicategories.Bicategories.Invertible_2cells.
Require Import UniMath.CategoryTheory.Bicategories.PseudoFunctors.PseudoFunctor.
Import PseudoFunctor.Notations.
Require Import UniMath.CategoryTheory.Bicategories.Transformations.LaxTransformation.
Require Import UniMath.CategoryTheory.Bicategories.Bicategories.Unitors.

Local Open Scope cat.

Section Composition.
  Context {C D : bicat}
          {F₁ F₂ F₃ : psfunctor C D}.
  Variable (σ : laxtrans F₁ F₂) (σ : laxtrans F₂ F₃).

  Definition comp_data : laxtrans_data F₁ F₃.
  Proof.
    use mk_laxtrans_data.
    - exact (λ X, σ X · σ X).
    - exact (λ X Y f,
             (rassociator (σ X) (σ X) (#F₃ f))
                (σ X laxnaturality_of σ f)
                lassociator (σ X) (#F₂ f) (σ Y)
                (laxnaturality_of σ f σ Y)
                rassociator (#F₁ f) (σ Y) (σ Y)).
  Defined.

  Definition comp_laws
    : is_laxtrans comp_data.
  Proof.
    repeat split.
    - intros X Y f g α ; cbn in ×.
      rewrite !vassocr.
      rewrite <- lwhisker_lwhisker_rassociator.
      rewrite !vassocl.
      apply maponpaths.
      rewrite <- rwhisker_rwhisker_alt.
      rewrite !vassocr.
      apply maponpaths_2.
      rewrite !vassocl.
      pose (laxnaturality_natural σ).
      rewrite !vassocr.
      rewrite !lwhisker_vcomp.
      rewrite <- laxnaturality_natural.
      rewrite <- lwhisker_vcomp.
      rewrite !vassocl.
      apply maponpaths.
      rewrite !vassocr.
      rewrite rwhisker_lwhisker.
      rewrite !vassocl.
      apply maponpaths.
      rewrite !rwhisker_vcomp.
      rewrite laxnaturality_natural.
      reflexivity.
    - intros X ; cbn.
      rewrite !vassocr.
      rewrite <- lwhisker_lwhisker_rassociator.
      rewrite !vassocl.
      rewrite !(maponpaths (λ z, _ z) (vassocr _ _ _)).
      rewrite lwhisker_vcomp.
      rewrite laxtrans_id.
      rewrite <- !lwhisker_vcomp.
      rewrite !vassocr.
      rewrite runitor_triangle.
      rewrite !vassocl.
      apply maponpaths.
      pose (laxtrans_id σ).
      rewrite !(maponpaths (λ z, _ z) (vassocr _ _ _)).
      rewrite rwhisker_lwhisker.
      rewrite !vassocl.
      rewrite !(maponpaths (λ z, _ (_ z)) (vassocr _ _ _)).
      rewrite rwhisker_vcomp.
      rewrite laxtrans_id.
      rewrite <- !rwhisker_vcomp.
      rewrite !vassocr.
      rewrite lwhisker_hcomp.
      rewrite triangle_l_inv.
      rewrite <- rwhisker_hcomp.
      rewrite rwhisker_vcomp.
      rewrite rinvunitor_runitor, id2_rwhisker, id2_left.
      rewrite !vassocl.
      rewrite rwhisker_rwhisker_alt.
      rewrite !vassocr.
      rewrite linvunitor_assoc.
      reflexivity.
    - intros X Y Z f g ; cbn.
      rewrite <- !lwhisker_vcomp, <- !rwhisker_vcomp.
      rewrite !vassocr.
      assert ((lassociator (σ X · σ X) (# F₃ f) (# F₃ g))
                 (rassociator (σ X) (σ X) (# F₃ f) # F₃ g)
              =
              (rassociator (σ X) (σ X) (#F₃ f · #F₃ g))
                 (σ X lassociator (σ X) (# F₃ f) (# F₃ g))
                 lassociator (σ X) (σ X · # F₃ f) (# F₃ g)) as →.
      {
        rewrite !vassocl.
        use vcomp_move_L_pM.
        { is_iso. }
        cbn.
        rewrite !vassocr.
        rewrite !lwhisker_hcomp, !rwhisker_hcomp.
        rewrite pentagon_2.
        rewrite !vassocl.
        reflexivity.
      }
      rewrite <- lwhisker_lwhisker_rassociator.
      rewrite !vassocl.
      apply maponpaths.
      rewrite !(maponpaths
                  (λ z, _ (_ (_ (_ (_ (_ (_ (_ (_ (_ (_ z)))))))))))
                  (vassocr _ _ _)).
      pose (inverse_pentagon_5 (σ Z) (σ Z) (#F₁ g) (#F₁ f)) as pent.
      rewrite <- !lwhisker_hcomp, <- !rwhisker_hcomp in pent.
      rewrite pent ; clear pent.
      rewrite !vassocl.
      rewrite <- rwhisker_rwhisker_alt.
      rewrite !vassocr.
      rewrite lwhisker_vcomp.
      rewrite laxtrans_comp.
      rewrite <- !lwhisker_vcomp.
      rewrite !vassocl.
      apply maponpaths.
      refine (!(_ @ _)).
      {
        rewrite !vassocr.
        rewrite <- rwhisker_lwhisker.
        rewrite !vassocl.
        reflexivity.
      }
      apply maponpaths.
      use vcomp_move_L_pM.
      { is_iso. }
      cbn.
      etrans.
      {
        rewrite !vassocr.
        do 11 apply maponpaths_2.
        rewrite lwhisker_hcomp, rwhisker_hcomp.
        rewrite !vassocl.
        exact (!(pentagon (#F₃ g) (σ Y) (#F₂ f) (σ X))).
      }
      rewrite !vassocl.
      refine (!(_ @ _)).
      {
        do 2 apply maponpaths.
        rewrite !vassocr.
        rewrite rwhisker_lwhisker.
        rewrite !vassocl.
        rewrite !(maponpaths (λ z, _ z) (vassocr _ _ _)).
        rewrite rwhisker_vcomp.
        rewrite laxtrans_comp.
        rewrite <- !rwhisker_vcomp.
        rewrite !vassocl.
        reflexivity.
      }
      rewrite !vassocr.
      repeat (apply maponpaths_2).
      rewrite !vassocl.
      rewrite rwhisker_lwhisker.
      rewrite !vassocr.
      apply maponpaths_2.
      use vcomp_move_L_Mp.
      { is_iso. }
      use vcomp_move_L_Mp.
      { is_iso. }
      cbn.
      rewrite !vassocl.
      etrans.
      {
        do 5 apply maponpaths.
        rewrite lwhisker_hcomp, rwhisker_hcomp.
        rewrite <- inverse_pentagon.
        reflexivity.
      }
      etrans.
      {
        do 4 apply maponpaths.
        rewrite !vassocr.
        rewrite rwhisker_rwhisker_alt.
        rewrite !vassocl.
        reflexivity.
      }
      etrans.
      {
        apply maponpaths.
        rewrite !vassocr.
        do 2 apply maponpaths_2.
        rewrite !(maponpaths (λ z, z _) (vassocl _ _ _)).
        rewrite lwhisker_hcomp, rwhisker_hcomp.
        rewrite <- pentagon.
        rewrite !vassocl.
        rewrite lassociator_rassociator, id2_right.
        reflexivity.
      }
      etrans.
      {
        rewrite !vassocr.
        rewrite lwhisker_lwhisker.
        rewrite !vassocl.
        reflexivity.
      }
      apply maponpaths.
      rewrite !vassocr.
      rewrite rwhisker_rwhisker.
      rewrite <- vcomp_whisker.
      rewrite !vassocl.
      apply maponpaths.
      refine (!(_ @ _)).
      {
        rewrite !vassocr.
        apply maponpaths_2.
        rewrite !vassocl.
        rewrite lwhisker_hcomp, rwhisker_hcomp.
        rewrite <- inverse_pentagon.
        rewrite !vassocr.
        rewrite lassociator_rassociator.
        apply id2_left.
      }
      rewrite lwhisker_lwhisker_rassociator.
      reflexivity.
  Qed.

  Definition comp_laxtrans : laxtrans F₁ F₃
    := mk_laxtrans comp_data comp_laws.
End Composition.

Definition comp_trans
           {C D : bicat}
           {F₁ F₂ F₃ : psfunctor C D}
           (σ : pstrans F₁ F₂) (σ : pstrans F₂ F₃)
  : pstrans F₁ F₃.
Proof.
  use mk_pstrans.
  - exact (comp_laxtrans σ σ).
  - intros X Y f ; cbn.
    is_iso.
    + apply σ.
    + apply σ.
Defined.