diff --git a/colim.hlean b/colim.hlean index bdb571e..7619b49 100644 --- a/colim.hlean +++ b/colim.hlean @@ -399,7 +399,7 @@ namespace seq_colim equiv.mk _ !is_equiv_seq_colim_rec end functor - definition pseq_colim.elim [constructor] {A : ℕ → Type*} {B : Type*} {f : Π{n}, A n →* A (n+1)} + definition pseq_colim.elim' [constructor] {A : ℕ → Type*} {B : Type*} {f : Π{n}, A n →* A (n+1)} (g : Πn, A n →* B) (p : Πn, g (n+1) ∘* f ~ g n) : pseq_colim @f →* B := begin fapply pmap.mk, @@ -409,6 +409,10 @@ namespace seq_colim { esimp, apply respect_pt } end + definition pseq_colim.elim [constructor] {A : ℕ → Type*} {B : Type*} {f : Π{n}, A n →* A (n+1)} + (g : Πn, A n →* B) (p : Πn, g (n+1) ∘* f ~* g n) : pseq_colim @f →* B := + pseq_colim.elim' g p + definition prep0 [constructor] {A : ℕ → Type*} (f : pseq_diagram A) (k : ℕ) : A 0 →* A k := pmap.mk (rep0 (λn x, f x) k) begin induction k with k p, reflexivity, exact ap (@f k) p ⬝ !respect_pt end diff --git a/homotopy/spectrum.hlean b/homotopy/spectrum.hlean index 597fa76..5f39b59 100644 --- a/homotopy/spectrum.hlean +++ b/homotopy/spectrum.hlean @@ -431,8 +431,15 @@ namespace spectrum -- note: the forward map is (currently) not definitionally equal to gluen. Is that a problem? definition equiv_gluen {N : succ_str} (X : gen_spectrum N) (n : N) (k : ℕ) : X n ≃* Ω[k] (X (n +' k)) := - by induction k with k f; reflexivity; exact f ⬝e* loopn_pequiv_loopn k (equiv_glue X (n +' k)) - ⬝e* !loopn_succ_in⁻¹ᵉ* + by induction k with k f; reflexivity; exact f ⬝e* (loopn_pequiv_loopn k (equiv_glue X (n +' k)) + ⬝e* !loopn_succ_in⁻¹ᵉ*) + + definition equiv_gluen_inv_succ {N : succ_str} (X : gen_spectrum N) (n : N) (k : ℕ) : + (equiv_gluen X n (k+1))⁻¹ᵉ* ~* + (equiv_gluen X n k)⁻¹ᵉ* ∘* Ω→[k] (equiv_glue X (n +' k))⁻¹ᵉ* ∘* !loopn_succ_in := + begin + refine !trans_pinv ⬝* pwhisker_left _ _, refine !trans_pinv ⬝* _, refine !to_pinv_pequiv_MK2 ◾* !pinv_pinv + end definition spectrify_map {N : succ_str} {X : gen_prespectrum N} : X →ₛ spectrify X := begin @@ -457,7 +464,9 @@ namespace spectrum fapply smap.mk, { intro n, fapply pseq_colim.elim, { intro k, refine !equiv_gluen⁻¹ᵉ* ∘* apn k (f (n +' k)) }, - { intro k, apply to_homotopy, exact sorry }}, + { intro k, refine !passoc ⬝* pwhisker_right _ !equiv_gluen_inv_succ ⬝* _, + refine !passoc ⬝* _, apply pwhisker_left, + refine !passoc ⬝* _, exact sorry }}, { intro n, exact sorry } end