diff --git a/homotopy/spectrum.hlean b/homotopy/spectrum.hlean index 88c36ad..af6b485 100644 --- a/homotopy/spectrum.hlean +++ b/homotopy/spectrum.hlean @@ -283,7 +283,7 @@ namespace spectrum refine _ ∘g π→g[k+2] (glue E _), refine (ghomotopy_group_succ_in _ (k+1))⁻¹ᵍ ∘g _, refine homotopy_group_isomorphism_of_pequiv (k+1) - (loop_pequiv_loop (pequiv_of_eq (ap E !add.assoc))) + (loop_pequiv_loop (pequiv_of_eq (ap E (add.assoc (-n - 2) k 1)))) end definition pshomotopy_group (n : ℤ) (E : prespectrum) : AbGroup := @@ -295,7 +295,13 @@ namespace spectrum πₚₛ[n] E →g πₚₛ[n] F := group.seq_colim_functor (λk, π→g[k+2] (f (-n - 2 +[ℤ] k))) begin - exact sorry + intro k, + note sq1 := homotopy_group_homomorphism_psquare (k+2) (ptranspose (smap.glue_square f (-n - 2 +[ℤ] k))), + note sq2 := homotopy_group_functor_hsquare (k+2) (ap1_psquare (ptransport_natural E F f (add.assoc (-n - 2) k 1))), + note sq3 := (homotopy_group_succ_in_natural (k+2) (f (-n - 2 +[ℤ] (k+1))))⁻¹ʰᵗʸʰ, + note sq4 := hsquare_of_psquare sq2, + note rect := sq1 ⬝htyh sq4 ⬝htyh sq3, + exact sorry --sq1 ⬝htyh sq4 ⬝htyh sq3, end notation `πₚₛ→[`:95 n:0 `]`:0 := pshomotopy_group_fun n @@ -622,7 +628,7 @@ open fwedge fconstructor, { intro n, exact fwedge (λ i, X i n) }, { intro n, fapply fwedge_pmap, - intro i, exact Ω→ !pinl ∘* !glue + intro i, exact Ω→ !pinl ∘* !glue } end diff --git a/move_to_lib.hlean b/move_to_lib.hlean index 7004cfb..2192a53 100644 --- a/move_to_lib.hlean +++ b/move_to_lib.hlean @@ -93,6 +93,24 @@ namespace eq -- (p : f ~ g) (q : a = a') : natural_square p q = square_of_pathover (apd p q) := -- idp + section hsquare + variables {A₀₀ A₂₀ A₄₀ A₀₂ A₂₂ A₄₂ A₀₄ A₂₄ A₄₄ : Type} + {f₁₀ : A₀₀ → A₂₀} {f₃₀ : A₂₀ → A₄₀} + {f₀₁ : A₀₀ → A₀₂} {f₂₁ : A₂₀ → A₂₂} {f₄₁ : A₄₀ → A₄₂} + {f₁₂ : A₀₂ → A₂₂} {f₃₂ : A₂₂ → A₄₂} + {f₀₃ : A₀₂ → A₀₄} {f₂₃ : A₂₂ → A₂₄} {f₄₃ : A₄₂ → A₄₄} + {f₁₄ : A₀₄ → A₂₄} {f₃₄ : A₂₄ → A₄₄} + + definition trunc_functor_hsquare (n : ℕ₋₂) (h : hsquare f₁₀ f₁₂ f₀₁ f₂₁) : + hsquare (trunc_functor n f₁₀) (trunc_functor n f₁₂) + (trunc_functor n f₀₁) (trunc_functor n f₂₁) := + λa, !trunc_functor_compose⁻¹ ⬝ trunc_functor_homotopy n h a ⬝ !trunc_functor_compose + + end hsquare + definition homotopy_group_succ_in_natural (n : ℕ) {A B : Type*} (f : A →* B) : + hsquare (homotopy_group_succ_in A n) (homotopy_group_succ_in B n) (π→[n+1] f) (π→[n] (Ω→ f)) := + trunc_functor_hsquare _ (loopn_succ_in_natural n f)⁻¹* + end eq open eq namespace pmap diff --git a/pointed.hlean b/pointed.hlean index 453a3cd..c71e2fc 100644 --- a/pointed.hlean +++ b/pointed.hlean @@ -151,4 +151,35 @@ namespace pointed esimp, exact !idp_con end + -- this should replace pnatural_square + definition pnatural_square2 {A B : Type} (X : B → Type*) (Y : B → Type*) {f g : A → B} + (h : Πa, X (f a) →* Y (g a)) {a a' : A} (p : a = a') : + h a' ∘* ptransport X (ap f p) ~* ptransport Y (ap g p) ∘* h a := + by induction p; exact !pcompose_pid ⬝* !pid_pcompose⁻¹* + + definition ptransport_natural {A : Type} (X : A → Type*) (Y : A → Type*) + (h : Πa, X a →* Y a) {a a' : A} (p : a = a') : + h a' ∘* ptransport X p ~* ptransport Y p ∘* h a := + by induction p; exact !pcompose_pid ⬝* !pid_pcompose⁻¹* + + section psquare + variables {A A' A₀₀ A₂₀ A₄₀ A₀₂ A₂₂ A₄₂ A₀₄ A₂₄ A₄₄ : Type*} + {f₁₀ f₁₀' : A₀₀ →* A₂₀} {f₃₀ : A₂₀ →* A₄₀} + {f₀₁ f₀₁' : A₀₀ →* A₀₂} {f₂₁ f₂₁' : A₂₀ →* A₂₂} {f₄₁ : A₄₀ →* A₄₂} + {f₁₂ f₁₂' : A₀₂ →* A₂₂} {f₃₂ : A₂₂ →* A₄₂} + {f₀₃ : A₀₂ →* A₀₄} {f₂₃ : A₂₂ →* A₂₄} {f₄₃ : A₄₂ →* A₄₄} + {f₁₄ : A₀₄ →* A₂₄} {f₃₄ : A₂₄ →* A₄₄} + + definition ptranspose (p : psquare f₁₀ f₁₂ f₀₁ f₂₁) : psquare f₀₁ f₂₁ f₁₀ f₁₂ := + p⁻¹* + + definition hsquare_of_psquare (p : psquare f₁₀ f₁₂ f₀₁ f₂₁) : hsquare f₁₀ f₁₂ f₀₁ f₂₁ := + p + + definition homotopy_group_functor_hsquare (n : ℕ) (h : psquare f₁₀ f₁₂ f₀₁ f₂₁) : + psquare (π→[n] f₁₀) (π→[n] f₁₂) + (π→[n] f₀₁) (π→[n] f₂₁) := + sorry + + end psquare end pointed