Timings for TwoSphere.v

(* -*- mode: coq; mode: visual-line -*- *)

Require Import Basics.Overture Basics.Tactics Basics.PathGroupoids.

Local Open Scope path_scope.

(** * Theorems about the 2-sphere [S^2]. *)

(* ** Definition of the 2-sphere. *)

Module Export TwoSphere.

  Private Inductive TwoSphere : Type0 :=
    | base : TwoSphere.

  Axiom surf : idpath base = idpath base.

  Definition TwoSphere_ind (P : TwoSphere -> Type)
    (b : P base) (s : idpath b = transport2 P surf b)
    : forall (x : TwoSphere), P x
    := fun x => match x with base => fun _ => b end s.

  Axiom TwoSphere_ind_beta_surf : forall (P : TwoSphere -> Type)
    (b : P base) (s : idpath b = transport2 P surf b),
    apD02 (TwoSphere_ind P b s) surf = s @ (concat_p1 _)^.

End TwoSphere.

(* ** The non-dependent eliminator *)

Definition TwoSphere_rec (P : Type) (b : P) (s : idpath b = idpath b)
  : TwoSphere -> P
  := TwoSphere_ind (fun _ => P) b (s @ (transport2_const surf b) @ (concat_p1 _)).

Definition TwoSphere_rec_beta_surf (P : Type) (b : P) (s : idpath b = idpath b)
  : ap02 (TwoSphere_rec P b s) surf = s.

Proof.

  apply (cancel2L (transport2_const surf b)).

  apply (cancelL (apD_const (TwoSphere_rec P b s) (idpath base))).

  apply (cancelR _ _ (concat_p_pp _ (transport_const _ b) _)^).

  apply (cancelR _ _ (whiskerL (transport2 _ surf b) (apD_const _ _)^)).

  refine ((apD02_const (TwoSphere_rec P b s) surf)^ @ _).

  refine ((TwoSphere_ind_beta_surf _ _ _) @ _).

  refine (_ @ (ap (fun w => _ @ w) 
                  (triangulator 
                     (transport2 (fun _ : TwoSphere => P) surf b) _))).

 
  cbn.

 refine (_ @ (ap (fun w => (w @ _) @ _) (concat_1p _)^)).

  
  refine (_ @ (concat_p_pp _ _ _)).

  refine (_ @ (ap (fun w => _ @ w) (concat_pp_p _ _ _))).

  refine (_ @ (ap (fun w => _ @ (w @ _)) (concat_Vp _)^)).

  refine (_ @ (ap (fun w => _ @ (w @ _)) 
                  (concat_pV (concat_p1 
                                (transport2 (fun _ : TwoSphere => P) surf b @ 1))))).

  refine (_ @ (ap (fun w => _ @ w) (concat_p_pp _ _ _))).

  refine (_ @ (concat_pp_p _ _ _)).

 apply moveR_pV.

  refine (_ @ (concat_p_pp _ _ _)).

  refine (_ @ (ap (fun w => _ @ w) (whiskerR_p1 _)^)).

 f_ap.

  refine ((ap (fun w => w @ _) (whiskerL_1p_1 _)^) @ _).

  refine ((ap (fun w => _ @ w) (whiskerR_p1 _)^) @ _).

 cbn.

  refine ((concat_p_pp _ _ _) @ _).

 f_ap.

  refine ((ap (fun w => _ @ w) (concat_1p _)) @ _).

  refine ((concat_whisker 1 _ _ 1 (transport2_const surf b) s)^ @ _).

  
  symmetry.

  refine ((ap (fun w => w @@ _) (concat_p1 _)^) @ _).

  refine ((ap (fun w => _ @@ w) (concat_1p _)^) @ _).

  refine ((concat_concat2 _ _ _ _)^ @ _).

 f_ap.

Defined.