More lemmas about fwedge.

homotopy/fwedge.hlean

@@ -7,7 +7,7 @@ The Wedge Sum of a family of Pointed Types
 -/
 import homotopy.wedge ..move_to_lib ..choice
 
-open eq pushout pointed unit trunc_index sigma bool equiv trunc choice unit is_trunc
+open eq pushout pointed unit trunc_index sigma bool equiv trunc choice unit is_trunc sigma.ops lift
 
 definition fwedge' {I : Type} (F : I → Type*) : Type := pushout (λi, ⟨i, Point (F i)⟩) (λi, ⋆)
 definition pt' [constructor] {I : Type} {F : I → Type*} : fwedge' F := inr ⋆
@@ -133,8 +133,78 @@ namespace fwedge
     { intro g, apply eq_of_phomotopy, exact fwedge_pmap_eta g }
   end
 
+  definition fwedge_pmap_phomotopy {I : Type} {F : I → Type*} {X : Type*} {f g : Π i, F i →* X}
+    (h : Π i, f i ~* g i) : fwedge_pmap f ~* fwedge_pmap g :=
+  begin
+    fconstructor,
+    { fapply fwedge.rec,
+      { exact h },
+      { reflexivity },
+      { intro i, apply eq_pathover,
+        refine _ ⬝ph _ ⬝hp _,
+        { exact (respect_pt (g i)) },
+        { exact (respect_pt (f i)) },
+        { exact !elim_glue },
+        { apply square_of_eq,
+          exact ((phomotopy.sigma_char (f i) (g i)) (h i)).2
+        },
+        { refine !elim_glue⁻¹ }
+      }
+    },
+    { reflexivity }
+  end
+
   definition trunc_fwedge_pmap_equiv.{u} {n : ℕ₋₂} {I : Type.{u}} (H : has_choice n I)
     (F : I → pType.{u}) (X : pType.{u}) : trunc n (⋁F →* X) ≃ Πi, trunc n (F i →* X) :=
   trunc_equiv_trunc n (fwedge_pmap_equiv F X) ⬝e choice_equiv (λi, F i →* X)
 
+  definition fwedge_functor [constructor] {I : Type} {F F' : I → Type*} (f : Π i, F i →* F' i)
+    : ⋁ F →* ⋁ F' := fwedge_pmap (λ i, pinl i ∘* f i)
+
+  definition fwedge_functor_pid {I : Type} {F : I → Type*}
+    : @fwedge_functor I F F (λ i, !pid) ~* !pid :=
+  calc fwedge_pmap (λ i, pinl i ∘* !pid) ~* fwedge_pmap pinl : by exact fwedge_pmap_phomotopy (λ i, pcompose_pid (pinl i))
+                                     ... ~* fwedge_pmap (λ i, !pid ∘* pinl i) : by exact fwedge_pmap_phomotopy (λ i, phomotopy.symm (pid_pcompose (pinl i)))
+                                     ... ~* !pid : by exact fwedge_pmap_eta !pid
+
+  definition fwedge_functor_compose {I : Type} {F F' F'' : I → Type*} (g : Π i, F' i →* F'' i)
+    (f : Π i, F i →* F' i) : fwedge_functor (λ i, g i ∘* f i) ~* fwedge_functor g ∘* fwedge_functor f :=
+  calc        fwedge_functor (λ i, g i ∘* f i)
+           ~* fwedge_pmap (λ i, (pinl i ∘* g i) ∘* f i)
+              : by exact fwedge_pmap_phomotopy (λ i, phomotopy.symm (passoc (pinl i) (g i) (f i)))
+       ... ~* fwedge_pmap (λ i, (fwedge_functor g ∘* pinl i) ∘* f i)
+              : by exact fwedge_pmap_phomotopy (λ i, pwhisker_right (f i) (phomotopy.symm (fwedge_pmap_beta (λ i, pinl i ∘* g i) i)))
+       ... ~* fwedge_pmap (λ i, fwedge_functor g ∘* (pinl i ∘* f i))
+              : by exact fwedge_pmap_phomotopy (λ i, passoc (fwedge_functor g) (pinl i) (f i))
+       ... ~* fwedge_pmap (λ i, fwedge_functor g ∘* (fwedge_functor f ∘* pinl i))
+              : by exact fwedge_pmap_phomotopy (λ i, pwhisker_left (fwedge_functor g) (phomotopy.symm (fwedge_pmap_beta (λ i, pinl i ∘* f i) i)))
+       ... ~* fwedge_pmap (λ i, (fwedge_functor g ∘* fwedge_functor f) ∘* pinl i)
+              : by exact fwedge_pmap_phomotopy (λ i, (phomotopy.symm (passoc (fwedge_functor g) (fwedge_functor f) (pinl i))))
+       ... ~* fwedge_functor g ∘* fwedge_functor f
+              : by exact fwedge_pmap_eta (fwedge_functor g ∘* fwedge_functor f)
+
+  definition fwedge_functor_homotopy {I : Type} {F F' : I → Type*} {f g : Π i, F i →* F' i}
+    (h : Π i, f i ~* g i) : fwedge_functor f ~* fwedge_functor g :=
+    fwedge_pmap_phomotopy (λ i, pwhisker_left (pinl i) (h i))
+
+  definition fwedge_pequiv [constructor] {I : Type} {F F' : I → Type*} (f : Π i, F i ≃* F' i) : ⋁ F ≃* ⋁ F' :=
+  let pto := fwedge_functor (λ i, f i) in
+  let pfrom := fwedge_functor (λ i, (f i)⁻¹ᵉ*) in
+  begin
+    fapply pequiv_of_pmap, exact pto,
+    fapply is_equiv.adjointify, exact pfrom,
+    { intro y, refine (fwedge_functor_compose (λ i, f i) (λ i, (f i)⁻¹ᵉ*) y)⁻¹ ⬝ _,
+      refine fwedge_functor_homotopy (λ i, pright_inv (f i)) y ⬝ _,
+      exact fwedge_functor_pid y
+    },
+    { intro y, refine (fwedge_functor_compose (λ i, (f i)⁻¹ᵉ*) (λ i, f i) y)⁻¹ ⬝ _,
+      refine fwedge_functor_homotopy (λ i, pleft_inv (f i)) y ⬝ _,
+      exact fwedge_functor_pid y
+    }
+  end
+
+  definition plift_fwedge.{u v} {I : Type} {F : I → pType.{u}} : plift.{u v} (⋁ F) ≃* ⋁ (λ i, plift.{u v} (F i)) :=
+  calc plift.{u v} (⋁ F) ≃* ⋁ F : by exact !pequiv_plift ⁻¹ᵉ*
+                      ... ≃* ⋁ (λ i, plift.{u v} (F i)) : by exact fwedge_pequiv (λ i, !pequiv_plift)
+
 end fwedge