Spectral/homotopy/spectrum.hlean

453 lines
20 KiB
Text
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

/-
Copyright (c) 2016 Michael Shulman. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Michael Shulman, Floris van Doorn
-/
import homotopy.LES_of_homotopy_groups .splice ..colim types.pointed2 .EM ..pointed_pi
open eq nat int susp pointed pmap sigma is_equiv equiv fiber algebra trunc trunc_index pi group
seq_colim succ_str EM EM.ops
/---------------------
Basic definitions
---------------------/
/- The basic definitions of spectra and prespectra make sense for any successor-structure. -/
structure gen_prespectrum (N : succ_str) :=
(deloop : N → Type*)
(glue : Π(n:N), (deloop n) →* (Ω (deloop (S n))))
attribute gen_prespectrum.deloop [coercion]
structure is_spectrum [class] {N : succ_str} (E : gen_prespectrum N) :=
(is_equiv_glue : Πn, is_equiv (gen_prespectrum.glue E n))
attribute is_spectrum.is_equiv_glue [instance]
structure gen_spectrum (N : succ_str) :=
(to_prespectrum : gen_prespectrum N)
(to_is_spectrum : is_spectrum to_prespectrum)
attribute gen_spectrum.to_prespectrum [coercion]
attribute gen_spectrum.to_is_spectrum [instance]
-- Classically, spectra and prespectra use the successor structure +.
-- But we will use + instead, to reduce case analysis later on.
abbreviation prespectrum := gen_prespectrum +
abbreviation prespectrum.mk := @gen_prespectrum.mk +
abbreviation spectrum := gen_spectrum +
abbreviation spectrum.mk := @gen_spectrum.mk +
namespace spectrum
definition glue {{N : succ_str}} := @gen_prespectrum.glue N
--definition glue := (@gen_prespectrum.glue +)
definition equiv_glue {N : succ_str} (E : gen_prespectrum N) [H : is_spectrum E] (n:N) : (E n) ≃* (Ω (E (S n))) :=
pequiv_of_pmap (glue E n) (is_spectrum.is_equiv_glue E n)
definition equiv_glue2 (Y : spectrum) (n : ) : Ω (Ω (Y (n+2))) ≃* Y n :=
begin
refine (!equiv_glue ⬝e* loop_pequiv_loop (!equiv_glue ⬝e* loop_pequiv_loop _))⁻¹ᵉ*,
refine pequiv_of_eq (ap Y _),
exact add.assoc n 1 1
end
-- a square when we compose glue with transporting over a path in N
definition glue_ptransport {N : succ_str} (X : gen_prespectrum N) {n n' : N} (p : n = n') :
glue X n' ∘* ptransport X p ~* Ω→ (ptransport X (ap S p)) ∘* glue X n :=
by induction p; exact !pcompose_pid ⬝* !pid_pcompose⁻¹* ⬝* pwhisker_right _ !ap1_pid⁻¹*
-- Sometimes an -indexed version does arise naturally, however, so
-- we give a standard way to extend an -indexed (pre)spectrum to a
-- -indexed one.
definition psp_of_nat_indexed [constructor] (E : gen_prespectrum +) : gen_prespectrum + :=
gen_prespectrum.mk
(λ(n:), match n with
| of_nat k := E k
| neg_succ_of_nat k := Ω[succ k] (E 0)
end)
begin
intros n, cases n with n n: esimp,
{ exact (gen_prespectrum.glue E n) },
cases n with n,
{ exact (pid _) },
{ exact (pid _) }
end
definition is_spectrum_of_nat_indexed [instance] (E : gen_prespectrum +) [H : is_spectrum E] : is_spectrum (psp_of_nat_indexed E) :=
begin
apply is_spectrum.mk, intros n, cases n with n n: esimp,
{ apply is_spectrum.is_equiv_glue },
cases n with n: apply is_equiv_id
end
protected definition of_nat_indexed (E : gen_prespectrum +) [H : is_spectrum E] : spectrum
:= spectrum.mk (psp_of_nat_indexed E) (is_spectrum_of_nat_indexed E)
-- In fact, a (pre)spectrum indexed on any pointed successor structure
-- gives rise to one indexed on +, so in this sense + is a
-- "universal" successor structure for indexing spectra.
definition succ_str.of_nat {N : succ_str} (z : N) : → N
| succ_str.of_nat zero := z
| succ_str.of_nat (succ k) := S (succ_str.of_nat k)
definition psp_of_gen_indexed [constructor] {N : succ_str} (z : N) (E : gen_prespectrum N) : gen_prespectrum + :=
psp_of_nat_indexed (gen_prespectrum.mk (λn, E (succ_str.of_nat z n)) (λn, gen_prespectrum.glue E (succ_str.of_nat z n)))
definition is_spectrum_of_gen_indexed [instance] {N : succ_str} (z : N) (E : gen_prespectrum N) [H : is_spectrum E]
: is_spectrum (psp_of_gen_indexed z E) :=
begin
apply is_spectrum_of_nat_indexed, apply is_spectrum.mk, intros n, esimp, apply is_spectrum.is_equiv_glue
end
protected definition of_gen_indexed [constructor] {N : succ_str} (z : N) (E : gen_spectrum N) : spectrum :=
spectrum.mk (psp_of_gen_indexed z E) (is_spectrum_of_gen_indexed z E)
-- Generally it's easiest to define a spectrum by giving 'equiv's
-- directly. This works for any indexing succ_str.
protected definition MK [constructor] {N : succ_str} (deloop : N → Type*)
(glue : Π(n:N), (deloop n) ≃* (Ω (deloop (S n)))) : gen_spectrum N :=
gen_spectrum.mk (gen_prespectrum.mk deloop (λ(n:N), glue n))
(begin
apply is_spectrum.mk, intros n, esimp,
apply pequiv.to_is_equiv -- Why doesn't typeclass inference find this?
end)
-- Finally, we combine them and give a way to produce a (-)spectrum from a -indexed family of 'equiv's.
protected definition Mk [constructor] (deloop : → Type*)
(glue : Π(n:), (deloop n) ≃* (Ω (deloop (nat.succ n)))) : spectrum :=
spectrum.of_nat_indexed (spectrum.MK deloop glue)
------------------------------
-- Maps and homotopies of (pre)spectra
------------------------------
-- These make sense for any succ_str.
structure smap {N : succ_str} (E F : gen_prespectrum N) :=
(to_fun : Π(n:N), E n →* F n)
(glue_square : Π(n:N), glue F n ∘* to_fun n ~* Ω→ (to_fun (S n)) ∘* glue E n)
open smap
infix ` →ₛ `:30 := smap
attribute smap.to_fun [coercion]
-- A version of 'glue_square' in the spectrum case that uses 'equiv_glue'
definition sglue_square {N : succ_str} {E F : gen_spectrum N} (f : E →ₛ F) (n : N)
: equiv_glue F n ∘* f n ~* Ω→ (f (S n)) ∘* equiv_glue E n
-- I guess this manual eta-expansion is necessary because structures lack definitional eta?
:= phomotopy.mk (glue_square f n) (to_homotopy_pt (glue_square f n))
definition sid {N : succ_str} (E : gen_spectrum N) : E →ₛ E :=
smap.mk (λn, pid (E n))
(λn, calc glue E n ∘* pid (E n) ~* glue E n : pcompose_pid
... ~* pid (Ω(E (S n))) ∘* glue E n : pid_pcompose
... ~* Ω→(pid (E (S n))) ∘* glue E n : pwhisker_right (glue E n) ap1_pid⁻¹*)
definition scompose {N : succ_str} {X Y Z : gen_prespectrum N} (g : Y →ₛ Z) (f : X →ₛ Y) : X →ₛ Z :=
smap.mk (λn, g n ∘* f n)
(λn, calc glue Z n ∘* to_fun g n ∘* to_fun f n
~* (glue Z n ∘* to_fun g n) ∘* to_fun f n : passoc
... ~* (Ω→(to_fun g (S n)) ∘* glue Y n) ∘* to_fun f n : pwhisker_right (to_fun f n) (glue_square g n)
... ~* Ω→(to_fun g (S n)) ∘* (glue Y n ∘* to_fun f n) : passoc
... ~* Ω→(to_fun g (S n)) ∘* (Ω→ (f (S n)) ∘* glue X n) : pwhisker_left (Ω→(to_fun g (S n))) (glue_square f n)
... ~* (Ω→(to_fun g (S n)) ∘* Ω→(f (S n))) ∘* glue X n : passoc
... ~* Ω→(to_fun g (S n) ∘* to_fun f (S n)) ∘* glue X n : pwhisker_right (glue X n) (ap1_pcompose _ _))
infixr ` ∘ₛ `:60 := scompose
definition szero [constructor] {N : succ_str} (E F : gen_prespectrum N) : E →ₛ F :=
smap.mk (λn, pconst (E n) (F n))
(λn, calc glue F n ∘* pconst (E n) (F n) ~* pconst (E n) (Ω(F (S n))) : pcompose_pconst
... ~* pconst (Ω(E (S n))) (Ω(F (S n))) ∘* glue E n : pconst_pcompose
... ~* Ω→(pconst (E (S n)) (F (S n))) ∘* glue E n : pwhisker_right (glue E n) (ap1_pconst _ _))
definition stransport [constructor] {N : succ_str} {A : Type} {a a' : A} (p : a = a')
(E : A → gen_prespectrum N) : E a →ₛ E a' :=
smap.mk (λn, ptransport (λa, E a n) p)
begin
intro n, induction p,
exact !pcompose_pid ⬝* !pid_pcompose⁻¹* ⬝* pwhisker_right _ !ap1_pid⁻¹*,
end
structure shomotopy {N : succ_str} {E F : gen_prespectrum N} (f g : E →ₛ F) :=
(to_phomotopy : Πn, f n ~* g n)
(glue_homotopy : Πn, pwhisker_left (glue F n) (to_phomotopy n) ⬝* glue_square g n
= -- Ideally this should be a "phomotopy2"
glue_square f n ⬝* pwhisker_right (glue E n) (ap1_phomotopy (to_phomotopy (S n))))
infix ` ~ₛ `:50 := shomotopy
------------------------------
-- Suspension prespectra
------------------------------
-- This should probably go in 'susp'
definition psuspn : → Type* → Type*
| psuspn 0 X := X
| psuspn (succ n) X := psusp (psuspn n X)
-- Suspension prespectra are one that's naturally indexed on the natural numbers
definition psp_susp (X : Type*) : gen_prespectrum + :=
gen_prespectrum.mk (λn, psuspn n X) (λn, loop_psusp_unit (psuspn n X))
/- Truncations -/
-- We could truncate prespectra too, but since the operation
-- preserves spectra and isn't "correct" acting on prespectra
-- without spectrifying them first anyway, why bother?
definition strunc (k : ℕ₋₂) (E : spectrum) : spectrum :=
spectrum.Mk (λ(n:), ptrunc (k + n) (E n))
(λ(n:), (loop_ptrunc_pequiv (k + n) (E (succ n)))⁻¹ᵉ*
∘*ᵉ (ptrunc_pequiv_ptrunc (k + n) (equiv_glue E (int.of_nat n))))
/---------------------
Homotopy groups
---------------------/
-- Here we start to reap the rewards of using -indexing: we can
-- read off the homotopy groups without any tedious case-analysis of
-- n. We increment by 2 in order to ensure that they are all
-- automatically abelian groups.
definition shomotopy_group (n : ) (E : spectrum) : AbGroup := πag[2] (E (2 - n))
notation `πₛ[`:95 n:0 `]`:0 := shomotopy_group n
definition shomotopy_group_fun (n : ) {E F : spectrum} (f : E →ₛ F) :
πₛ[n] E →g πₛ[n] F :=
π→g[2] (f (2 - n))
notation `πₛ→[`:95 n:0 `]`:0 := shomotopy_group_fun n
/-------------------------------
Cotensor of spectra by types
-------------------------------/
-- Makes sense for any indexing succ_str. Could be done for
-- prespectra too, but as with truncation, why bother?
definition sp_cotensor [constructor] {N : succ_str} (A : Type*) (B : gen_spectrum N) : gen_spectrum N :=
spectrum.MK (λn, ppmap A (B n))
(λn, (loop_ppmap_commute A (B (S n)))⁻¹ᵉ* ∘*ᵉ (pequiv_ppcompose_left (equiv_glue B n)))
----------------------------------------
-- Sections of parametrized spectra
----------------------------------------
definition spi [constructor] {N : succ_str} (A : Type*) (E : A -> gen_spectrum N) : gen_spectrum N :=
spectrum.MK (λn, Π*a, E a n)
(λn, !ppi_loop_pequiv⁻¹ᵉ* ∘*ᵉ ppi_pequiv_right (λa, equiv_glue (E a) n))
/-----------------------------------------
Fibers and long exact sequences
-----------------------------------------/
definition sfiber {N : succ_str} {X Y : gen_spectrum N} (f : X →ₛ Y) : gen_spectrum N :=
spectrum.MK (λn, pfiber (f n))
(λn, (loop_pfiber (f (S n)))⁻¹ᵉ* ∘*ᵉ pfiber_pequiv_of_square _ _ (sglue_square f n))
/- the map from the fiber to the domain -/
definition spoint {N : succ_str} {X Y : gen_spectrum N} (f : X →ₛ Y) : sfiber f →ₛ X :=
smap.mk (λn, ppoint (f n))
begin
intro n,
refine _ ⬝* !passoc,
refine _ ⬝* pwhisker_right _ !ppoint_loop_pfiber_inv⁻¹*,
rexact (pfiber_pequiv_of_square_ppoint (equiv_glue X n) (equiv_glue Y n) (sglue_square f n))⁻¹*
end
definition scompose_spoint {N : succ_str} {X Y : gen_spectrum N} (f : X →ₛ Y)
: f ∘ₛ spoint f ~ₛ szero (sfiber f) Y :=
begin
fapply shomotopy.mk,
{ intro n, exact pcompose_ppoint (f n) },
{ intro n, exact sorry }
end
definition equiv_glue_neg (X : spectrum) (n : ) : X (2 - succ n) ≃* Ω (X (2 - n)) :=
have H : succ (2 - succ n) = 2 - n, from ap succ !sub_sub⁻¹ ⬝ sub_add_cancel (2-n) 1,
equiv_glue X (2 - succ n) ⬝e* loop_pequiv_loop (pequiv_of_eq (ap X H))
definition π_glue (X : spectrum) (n : ) : π[2] (X (2 - succ n)) ≃* π[3] (X (2 - n)) :=
homotopy_group_pequiv 2 (equiv_glue_neg X n)
definition πg_glue (X : spectrum) (n : ) : πg[2] (X (2 - succ n)) ≃g πg[3] (X (2 - n)) :=
by rexact homotopy_group_isomorphism_of_pequiv _ (equiv_glue_neg X n)
definition πg_glue_homotopy_π_glue (X : spectrum) (n : ) : πg_glue X n ~ π_glue X n :=
by reflexivity
definition π_glue_square {X Y : spectrum} (f : X →ₛ Y) (n : ) :
π_glue Y n ∘* π→[2] (f (2 - succ n)) ~* π→[3] (f (2 - n)) ∘* π_glue X n :=
begin
change π→[2] (equiv_glue_neg Y n) ∘* π→[2] (f (2 - succ n)) ~*
π→[2] (Ω→ (f (2 - n))) ∘* π→[2] (equiv_glue_neg X n),
refine homotopy_group_functor_psquare 2 _,
refine !sglue_square ⬝v* ap1_psquare !pequiv_of_eq_commute
end
section
open chain_complex prod fin group
universe variable u
parameters {X Y : spectrum.{u}} (f : X →ₛ Y)
definition LES_of_shomotopy_groups : chain_complex +3 :=
splice (λ(n : ), LES_of_homotopy_groups (f (2 - n))) (2, 0)
(π_glue Y) (π_glue X) (π_glue_square f)
-- This LES is definitionally what we want:
example (n : ) : LES_of_shomotopy_groups (n, 0) = πₛ[n] Y := idp
example (n : ) : LES_of_shomotopy_groups (n, 1) = πₛ[n] X := idp
example (n : ) : LES_of_shomotopy_groups (n, 2) = πₛ[n] (sfiber f) := idp
example (n : ) : cc_to_fn LES_of_shomotopy_groups (n, 0) = πₛ→[n] f := idp
example (n : ) : cc_to_fn LES_of_shomotopy_groups (n, 1) = πₛ→[n] (spoint f) := idp
-- the maps are ugly for (n, 2)
definition ab_group_LES_of_shomotopy_groups : Π(v : +3), ab_group (LES_of_shomotopy_groups v)
| (n, fin.mk 0 H) := proof AbGroup.struct (πₛ[n] Y) qed
| (n, fin.mk 1 H) := proof AbGroup.struct (πₛ[n] X) qed
| (n, fin.mk 2 H) := proof AbGroup.struct (πₛ[n] (sfiber f)) qed
| (n, fin.mk (k+3) H) := begin exfalso, apply lt_le_antisymm H, apply le_add_left end
local attribute ab_group_LES_of_shomotopy_groups [instance]
definition is_mul_hom_LES_of_shomotopy_groups :
Π(v : +3), is_mul_hom (cc_to_fn LES_of_shomotopy_groups v)
| (n, fin.mk 0 H) := proof homomorphism.struct (πₛ→[n] f) qed
| (n, fin.mk 1 H) := proof homomorphism.struct (πₛ→[n] (spoint f)) qed
| (n, fin.mk 2 H) := proof homomorphism.struct
(homomorphism_LES_of_homotopy_groups_fun (f (2 - n)) (1, 2) ∘g πg_glue Y n) qed
| (n, fin.mk (k+3) H) := begin exfalso, apply lt_le_antisymm H, apply le_add_left end
definition is_exact_LES_of_shomotopy_groups : is_exact LES_of_shomotopy_groups :=
begin
apply is_exact_splice, intro n, apply is_exact_LES_of_homotopy_groups,
end
-- In the comments below is a start on an explicit description of the LES for spectra
-- Maybe it's slightly nicer to work with than the above version
definition shomotopy_groups [reducible] : +3 → AbGroup
| (n, fin.mk 0 H) := πₛ[n] Y
| (n, fin.mk 1 H) := πₛ[n] X
| (n, fin.mk k H) := πₛ[n] (sfiber f)
definition shomotopy_groups_fun : Π(v : +3), shomotopy_groups (S v) →g shomotopy_groups v
| (n, fin.mk 0 H) := proof πₛ→[n] f qed
| (n, fin.mk 1 H) := proof πₛ→[n] (spoint f) qed
| (n, fin.mk 2 H) := proof homomorphism_LES_of_homotopy_groups_fun (f (2 - n)) (nat.succ nat.zero, 2) ∘g
πg_glue Y n ∘g (by reflexivity) qed
| (n, fin.mk (k+3) H) := begin exfalso, apply lt_le_antisymm H, apply le_add_left end
--(homomorphism_LES_of_homotopy_groups_fun (f (2 - n)) (1, 2) ∘g πg_glue Y n)
end
structure sp_chain_complex (N : succ_str) : Type :=
(car : N → spectrum)
(fn : Π(n : N), car (S n) →ₛ car n)
(is_chain_complex : Πn, fn n ∘ₛ fn (S n) ~ₛ szero _ _)
section
variables {N : succ_str} (X : sp_chain_complex N) (n : N)
definition scc_to_car [unfold 2] [coercion] := @sp_chain_complex.car
definition scc_to_fn [unfold 2] : X (S n) →ₛ X n := sp_chain_complex.fn X n
definition scc_is_chain_complex [unfold 2] : scc_to_fn X n ∘ₛ scc_to_fn X (S n) ~ₛ szero _ _
:= sp_chain_complex.is_chain_complex X n
end
/- Mapping spectra -/
-- note: see also cotensor above
/- Spectrification -/
open chain_complex
definition spectrify_type_term {N : succ_str} (X : gen_prespectrum N) (n : N) (k : ) : Type* :=
Ω[k] (X (n +' k))
definition spectrify_type_fun' {N : succ_str} (X : gen_prespectrum N) (k : ) (n : N) :
Ω[k] (X n) →* Ω[k+1] (X (S n)) :=
!loopn_succ_in⁻¹ᵉ* ∘* Ω→[k] (glue X n)
definition spectrify_type_fun {N : succ_str} (X : gen_prespectrum N) (n : N) (k : ) :
spectrify_type_term X n k →* spectrify_type_term X n (k+1) :=
spectrify_type_fun' X k (n +' k)
definition spectrify_type {N : succ_str} (X : gen_prespectrum N) (n : N) : Type* :=
pseq_colim (spectrify_type_fun X n)
/-
Let Y = spectify X. Then
Ω Y (n+1) ≡ Ω colim_k Ω^k X ((n + 1) + k)
... = colim_k Ω^{k+1} X ((n + 1) + k)
... = colim_k Ω^{k+1} X (n + (k + 1))
... = colim_k Ω^k X(n + k)
... ≡ Y n
-/
definition spectrify_pequiv {N : succ_str} (X : gen_prespectrum N) (n : N) :
spectrify_type X n ≃* Ω (spectrify_type X (S n)) :=
begin
refine _ ⬝e* !pseq_colim_loop⁻¹ᵉ*,
refine !pshift_equiv ⬝e* _,
transitivity pseq_colim (λk, spectrify_type_fun' X (succ k) (S n +' k)), rotate 1,
refine pseq_colim_equiv_constant (λn, !ap1_pcompose⁻¹*),
fapply pseq_colim_pequiv,
{ intro n, apply loopn_pequiv_loopn, apply pequiv_ap X, apply succ_str.add_succ },
{ intro k, apply to_homotopy,
refine !passoc⁻¹* ⬝* _, refine pwhisker_right _ (loopn_succ_in_inv_natural (succ k) _) ⬝* _,
refine !passoc ⬝* _ ⬝* !passoc⁻¹*, apply pwhisker_left,
refine !apn_pcompose⁻¹* ⬝* _ ⬝* !apn_pcompose, apply apn_phomotopy,
exact !glue_ptransport⁻¹* }
end
definition spectrify [constructor] {N : succ_str} (X : gen_prespectrum N) : gen_spectrum N :=
spectrum.MK (spectrify_type X) (spectrify_pequiv X)
definition gluen {N : succ_str} (X : gen_prespectrum N) (n : N) (k : )
: X n →* Ω[k] (X (n +' k)) :=
by induction k with k f; reflexivity; exact !loopn_succ_in⁻¹ᵉ* ∘* Ω→[k] (glue X (n +' k)) ∘* f
-- 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⁻¹ᵉ*
definition spectrify_map {N : succ_str} {X : gen_prespectrum N} {Y : gen_spectrum N}
(f : X →ₛ Y) : X →ₛ spectrify X :=
begin
fapply smap.mk,
{ intro n, exact pinclusion _ 0 },
{ intro n, exact sorry }
end
definition spectrify.elim {N : succ_str} {X : gen_prespectrum N} {Y : gen_spectrum N}
(f : X →ₛ Y) : spectrify X →ₛ Y :=
begin
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 n, exact sorry }
end
/- Tensor by spaces -/
/- Smash product of spectra -/
/- Cofibers and stability -/
/- The Eilenberg-MacLane spectrum -/
definition EM_spectrum /-[constructor]-/ (G : AbGroup) : spectrum :=
spectrum.Mk (K G) (λn, (loop_EM G n)⁻¹ᵉ*)
end spectrum