work on functorial action of prespectrum homotopy groups

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
 

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

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