diff --git a/algebra/arrow_group.hlean b/algebra/arrow_group.hlean index b2bb0cb..7bfc731 100644 --- a/algebra/arrow_group.hlean +++ b/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 diff --git a/homotopy/cohomology.hlean b/homotopy/cohomology.hlean index f02691d..b8068d2 100644 --- a/homotopy/cohomology.hlean +++ b/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 diff --git a/move_to_lib.hlean b/move_to_lib.hlean index c4e6eb5..6e3c374 100644 --- a/move_to_lib.hlean +++ b/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`.