prove that the cohomology of an Eilenberg-MacLane spectrum satisfies the dimension axiom

algebra/arrow_group.hlean

@@ -1,4 +1,3 @@
-
 import algebra.group_theory ..move_to_lib eq2
 open pi pointed algebra group eq equiv is_trunc trunc
 
@@ -54,6 +53,14 @@ namespace group
         refine whisker_right _ !ap_con_fn ⬝ _, apply con2_con_con2 }}
   end
 
+  definition Group_trunc_pmap_isomorphism [constructor] {A A' B : Type*} (f : A' ≃* A) :
+    Group_trunc_pmap A B ≃g Group_trunc_pmap A' B :=
+  begin
+    apply isomorphism.mk (Group_trunc_pmap_homomorphism f),
+    apply @is_equiv_trunc_functor,
+    exact to_is_equiv (pequiv_ppcompose_right f),
+  end
+
   definition Group_trunc_pmap_pid [constructor] {A B : Type*} (f : Group_trunc_pmap A B) :
     Group_trunc_pmap_homomorphism (pid A) f = f :=
   begin

homotopy/cohomology.hlean

@@ -74,7 +74,7 @@ definition pcompose_pmap_mul {A B C : Type*} (h : B →* C) (f g : A →* Ω B)
   Ω→ h ∘* pmap_mul f g ~* pmap_mul (Ω→ h ∘* f) (Ω→ h ∘* g) :=
 begin
   fconstructor,
-  { intro p, exact ap1_con2 h (f p) (g p) },
+  { intro p, exact ap1_con h (f p) (g p) },
   { refine whisker_left _ !con2_con_con2⁻¹ ⬝ _, refine !con.assoc⁻¹ ⬝ _,
     refine whisker_right _ (eq_of_square !ap1_gen_con_natural) ⬝ _,
     refine !con.assoc ⬝ whisker_left _ _, apply ap1_gen_con_idp }
@@ -84,6 +84,13 @@ definition loop_psusp_intro_pmap_mul {X Y : Type*} (f g : psusp X →* Ω Y) :
   loop_psusp_intro (pmap_mul f g) ~* pmap_mul (loop_psusp_intro f) (loop_psusp_intro g) :=
 pwhisker_right _ !ap1_pmap_mul ⬝* !pmap_mul_pcompose
 
+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
+
 namespace cohomology
 
 definition EM_spectrum /-[constructor]-/ (G : AbGroup) : spectrum :=
@@ -130,6 +137,10 @@ definition cohomology_functor_pconst {X X' : Type*} (Y : spectrum) (n : ℤ) (f
   cohomology_functor (pconst X' X) Y n f = 1 :=
 !Group_trunc_pmap_pconst
 
+definition cohomology_isomorphism {X X' : Type*} (f : X' ≃* X) (Y : spectrum) (n : ℤ) :
+  H^n[X, Y] ≃g H^n[X', Y] :=
+Group_trunc_pmap_isomorphism f
+
 /- suspension axiom -/
 
 definition cohomology_psusp_2 (Y : spectrum) (n : ℤ) :
@@ -193,10 +204,31 @@ definition additive_equiv.{u} {I : Type.{u}} (H : has_choice 0 I) (X : I → Typ
   (n : ℤ) : H^n[⋁X, Y] ≃ Πᵍ i, H^n[X i, Y] :=
 trunc_fwedge_pmap_equiv H X (Ω[2] (Y (n+2)))
 
-definition additive {I : Type} (H : has_choice 0 I) (X : I → Type*) (Y : spectrum) (n : ℤ) :
-  is_equiv (additive_hom X Y n) :=
+definition spectrum_additive {I : Type} (H : has_choice 0 I) (X : I → Type*) (Y : spectrum)
+  (n : ℤ) : is_equiv (additive_hom X Y n) :=
 is_equiv_of_equiv_of_homotopy (additive_equiv H X Y n) begin intro f, induction f, reflexivity end
 
+/- dimension axiom for ordinary cohomology -/
+open is_conn trunc_index
+theorem EM_dimension' (G : AbGroup) (n : ℤ) (H : n ≠ 0) :
+  is_contr (ordinary_cohomology pbool G n) :=
+begin
+  apply is_conn_equiv_closed 0 !pmap_pbool_equiv⁻¹ᵉ,
+  apply is_conn_equiv_closed 0 !equiv_glue2⁻¹ᵉ,
+  cases n with n n,
+  { cases n with n,
+    { exfalso, apply H, reflexivity },
+    { apply is_conn_of_le, apply zero_le_of_nat n, exact is_conn_EMadd1 G n, }},
+  { apply is_trunc_trunc_of_is_trunc, apply @is_contr_loop_of_is_trunc (n+1) (K G 0),
+    apply is_trunc_of_le _ (zero_le_of_nat n) }
+end
+
+theorem EM_dimension (G : AbGroup) (n : ℤ) (H : n ≠ 0) :
+  is_contr (ordinary_cohomology (plift pbool) G n) :=
+@(is_trunc_equiv_closed_rev -2
+  (equiv_of_isomorphism (cohomology_isomorphism (pequiv_plift pbool) _ _)))
+  (EM_dimension' G n H)
+
 /- cohomology theory -/
 
 structure cohomology_theory.{u} : Type.{u+1} :=
@@ -224,6 +256,9 @@ cohomology_theory.mk
   (λn A, cohomology_psusp A Y n)
   (λn A B f, cohomology_psusp_natural f Y n)
   (λn A B f, cohomology_exact f Y n)
-  (λn I A H, additive H A Y n)
+  (λn I A H, spectrum_additive H A Y n)
+
+definition ordinary_cohomology_theory_EM [constructor] (G : AbGroup) : ordinary_theory :=
+⦃ordinary_theory, cohomology_theory_spectrum (EM_spectrum G), Hdimension := EM_dimension G ⦄
 
 end cohomology

move_to_lib.hlean

@@ -101,34 +101,6 @@ namespace pointed
     { apply is_set.elim }
   end
 
-  definition ap1_gen {A B : Type} (f : A → B) {a a' : A} (p : a = a')
-    {b b' : B} (q : f a = b) (q' : f a' = b') : b = b' :=
-  q⁻¹ ⬝ ap f p ⬝ q'
-
-  definition ap1_gen_con {A B : Type} (f : A → B) {a₁ a₂ a₃ : A} (p₁ : a₁ = a₂) (p₂ : a₂ = a₃)
-    {b₁ b₂ b₃ : B} (q₁ : f a₁ = b₁) (q₂ : f a₂ = b₂) (q₃ : f a₃ = b₃) :
-    ap1_gen f (p₁ ⬝ p₂) q₁ q₃ = ap1_gen f p₁ q₁ q₂ ⬝ ap1_gen f p₂ q₂ q₃ :=
-  begin induction p₂, induction q₃, induction q₂, reflexivity end
-
-  definition ap1_gen_con_natural {A B : Type} (f : A → B) {a₁ a₂ a₃ : A} {p₁ p₁' : a₁ = a₂}
-    {p₂ p₂' : a₂ = a₃}
-    {b₁ b₂ b₃ : B} (q₁ : f a₁ = b₁) (q₂ : f a₂ = b₂) (q₃ : f a₃ = b₃)
-    (r₁ : p₁ = p₁') (r₂ : p₂ = p₂') :
-      square (ap1_gen_con f p₁ p₂ q₁ q₂ q₃)
-             (ap1_gen_con f p₁' p₂' q₁ q₂ q₃)
-             (ap (λp, ap1_gen f p q₁ q₃) (r₁ ◾ r₂))
-             (ap (λp, ap1_gen f p q₁ q₂) r₁ ◾ ap (λp, ap1_gen f p q₂ q₃) r₂) :=
-  begin induction r₁, induction r₂, exact vrfl end
-
-  definition ap1_gen_con_idp {A B : Type} (f : A → B) {a : A} {b : B} (q : f a = b) :
-    ap1_gen_con f idp idp q q q ⬝ con.left_inv q ◾ con.left_inv q = con.left_inv q :=
-  by induction q; reflexivity
-
-  -- TODO: replace with ap1_con
-  definition ap1_con2 {A B : Type*} (f : A →* B) (p q : Ω A) : ap1 f (p ⬝ q) = ap1 f p ⬝ ap1 f q :=
-  ap1_gen_con f p q (respect_pt f) (respect_pt f) (respect_pt f)
-
-
   definition ap1_gen_con_left {A B : Type} {a a' : A} {b₀ b₁ b₂ : B}
     {f : A → b₀ = b₁} {f' : A → b₁ = b₂} (p : a = a') {q₀ q₁ : b₀ = b₁} {q₀' q₁' : b₁ = b₂}
     (r₀ : f a = q₀) (r₁ : f a' = q₁) (r₀' : f' a = q₀') (r₁' : f' a' = q₁') :
@@ -747,7 +719,6 @@ end is_conn
 
 namespace circle
 
-
 /-
   Suppose for `f, g : A -> B` I prove a homotopy `H : f ~ g` by induction on the element in `A`.
   And suppose `p : a = a'` is a path constructor in `A`.