michael/Spectral
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add fwedge_down_left.

Browse source
This commit is contained in:
favonia 2017-06-09 11:55:34 -06:00
parent 2e55a4a4ef
commit 0acc5c786d
1 changed files with 38 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

41
homotopy/fwedge.hlean
View file

@ -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 sigma.ops lift
open eq is_equiv pushout pointed unit trunc_index sigma bool equiv trunc choice unit is_trunc sigma.ops lift function
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 ⋆
@ -123,6 +123,15 @@ namespace fwedge
{ exact con.left_inv (respect_pt g) }
end
definition fwedge_pmap_pinl [constructor] {I : Type} {F : I → Type*} : fwedge_pmap (λi, pinl i) ~* pid (⋁ F) :=
begin
fconstructor,
{ intro x, induction x,
reflexivity, reflexivity,
apply eq_pathover, apply hdeg_square, refine !elim_glue ⬝ !ap_id⁻¹ },
{ reflexivity }
end
definition fwedge_pmap_equiv [constructor] {I : Type} (F : I → Type*) (X : Type*) :
⋁F →* X ≃ Πi, F i →* X :=
begin
@ -203,8 +212,34 @@ namespace fwedge
}
end
definition plift_fwedge.{u v} {I : Type} {F : I → pType.{u}} : plift.{u v} (⋁ F) ≃* ⋁ (λ i, plift.{u v} (F i)) :=
definition plift_fwedge.{u v} {I : Type} (F : I → pType.{u}) : plift.{u v} (⋁ F) ≃* ⋁ (plift.{u v} ∘ F) :=
calc plift.{u v} (⋁ F) ≃* ⋁ F : by exact !pequiv_plift ⁻¹ᵉ*
... ≃* ⋁ (λ i, plift.{u v} (F i)) : by exact fwedge_pequiv (λ i, !pequiv_plift)
... ≃* ⋁ (λ i, plift.{u v} (F i)) : by exact fwedge_pequiv (λ i, !pequiv_plift)
definition fwedge_down_left.{u v} {I : Type} (F : I → pType) : ⋁ (F ∘ down.{u v}) ≃* ⋁ F :=
let pto := @fwedge_pmap (lift.{u v} I) (F ∘ down) (⋁ F) (λ i, pinl (down i)) in
let pfrom := @fwedge_pmap I F (⋁ (F ∘ down.{u v})) (λ i, pinl (up.{u v} i)) in
begin
fapply pequiv_of_pmap,
{ exact pto },
fapply adjointify,
{ exact pfrom },
{ intro x, exact calc pto (pfrom x) = fwedge_pmap (λ i, (pto ∘* pfrom) ∘* pinl i) x : by exact (fwedge_pmap_eta (pto ∘* pfrom) x)⁻¹
... = fwedge_pmap (λ i, pto ∘* (pfrom ∘* pinl i)) x : by exact fwedge_pmap_phomotopy (λ i, passoc pto pfrom (pinl i)) x
... = fwedge_pmap (λ i, pto ∘* pinl (up.{u v} i)) x : by exact fwedge_pmap_phomotopy (λ i, pwhisker_left pto (fwedge_pmap_beta (λ i, pinl (up.{u v} i)) i)) x
... = fwedge_pmap pinl x : by exact fwedge_pmap_phomotopy (λ i, fwedge_pmap_beta (λ i, (pinl (down.{u v} i))) (up.{u v} i)) x
... = x : by exact fwedge_pmap_pinl x
},
{ intro x, exact calc pfrom (pto x) = fwedge_pmap (λ i, (pfrom ∘* pto) ∘* pinl i) x : by exact (fwedge_pmap_eta (pfrom ∘* pto) x)⁻¹
... = fwedge_pmap (λ i, pfrom ∘* (pto ∘* pinl i)) x : by exact fwedge_pmap_phomotopy (λ i, passoc pfrom pto (pinl i)) x
... = fwedge_pmap (λ i, pfrom ∘* pinl (down.{u v} i)) x : by exact fwedge_pmap_phomotopy (λ i, pwhisker_left pfrom (fwedge_pmap_beta (λ i, pinl (down.{u v} i)) i)) x
... = fwedge_pmap pinl x : by exact fwedge_pmap_phomotopy (λ i,
begin induction i with i,
exact fwedge_pmap_beta (λ i, (pinl (up.{u v} i))) i
end
) x
... = x : by exact fwedge_pmap_pinl x
}
end
end fwedge