diff --git a/homotopy/fwedge.hlean b/homotopy/fwedge.hlean index a6ecdb4..9b3c985 100644 --- a/homotopy/fwedge.hlean +++ b/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