52dd6cf90b
This commit adds truncated 2-quotients, groupoid quotients, Eilenberg MacLane spaces, chain complexes, the long exact sequence of homotopy groups, the Freudenthal Suspension Theorem, Whitehead's principle, and the computation of homotopy groups of almost all spheres which are known in HoTT.
259 lines
8.7 KiB
Text
259 lines
8.7 KiB
Text
/-
|
||
Copyright (c) 2016 Floris van Doorn. All rights reserved.
|
||
Released under Apache 2.0 license as described in the file LICENSE.
|
||
|
||
Authors: Floris van Doorn
|
||
|
||
Eilenberg MacLane spaces
|
||
-/
|
||
|
||
import hit.groupoid_quotient .hopf .freudenthal .homotopy_group
|
||
open algebra pointed nat eq category group algebra is_trunc iso pointed unit trunc equiv is_conn
|
||
|
||
namespace EM
|
||
open groupoid_quotient
|
||
|
||
variable {G : Group}
|
||
definition EM1 (G : Group) : Type :=
|
||
groupoid_quotient (Groupoid_of_Group G)
|
||
definition pEM1 [constructor] (G : Group) : Type* :=
|
||
pointed.MK (EM1 G) (elt star)
|
||
|
||
definition base : EM1 G := elt star
|
||
definition pth : G → base = base := pth
|
||
definition resp_mul (g h : G) : pth (g * h) = pth g ⬝ pth h := resp_comp h g
|
||
definition resp_one : pth (1 : G) = idp :=
|
||
resp_id star
|
||
|
||
definition resp_inv (g : G) : pth (g⁻¹) = (pth g)⁻¹ :=
|
||
resp_inv g
|
||
|
||
local attribute pointed.MK pointed.carrier pEM1 EM1 [reducible]
|
||
protected definition rec {P : EM1 G → Type} [H : Π(x : EM1 G), is_trunc 1 (P x)]
|
||
(Pb : P base) (Pp : Π(g : G), Pb =[pth g] Pb)
|
||
(Pmul : Π(g h : G), change_path (resp_mul g h) (Pp (g * h)) = Pp g ⬝o Pp h) (x : EM1 G) : P x :=
|
||
begin
|
||
induction x,
|
||
{ induction g, exact Pb},
|
||
{ induction a, induction b, exact Pp f},
|
||
{ induction a, induction b, induction c, exact Pmul f g}
|
||
end
|
||
|
||
protected definition rec_on {P : EM1 G → Type} [H : Π(x : EM1 G), is_trunc 1 (P x)]
|
||
(x : EM1 G) (Pb : P base) (Pp : Π(g : G), Pb =[pth g] Pb)
|
||
(Pmul : Π(g h : G), change_path (resp_mul g h) (Pp (g * h)) = Pp g ⬝o Pp h) : P x :=
|
||
EM.rec Pb Pp Pmul x
|
||
|
||
protected definition set_rec {P : EM1 G → Type} [H : Π(x : EM1 G), is_set (P x)]
|
||
(Pb : P base) (Pp : Π(g : G), Pb =[pth g] Pb) (x : EM1 G) : P x :=
|
||
EM.rec Pb Pp !center x
|
||
|
||
protected definition prop_rec {P : EM1 G → Type} [H : Π(x : EM1 G), is_prop (P x)]
|
||
(Pb : P base) (x : EM1 G) : P x :=
|
||
EM.rec Pb !center !center x
|
||
|
||
definition rec_pth {P : EM1 G → Type} [H : Π(x : EM1 G), is_trunc 1 (P x)]
|
||
{Pb : P base} {Pp : Π(g : G), Pb =[pth g] Pb}
|
||
(Pmul : Π(g h : G), change_path (resp_mul g h) (Pp (g * h)) = Pp g ⬝o Pp h)
|
||
(g : G) : apd (EM.rec Pb Pp Pmul) (pth g) = Pp g :=
|
||
proof !rec_pth qed
|
||
|
||
protected definition elim {P : Type} [is_trunc 1 P] (Pb : P) (Pp : Π(g : G), Pb = Pb)
|
||
(Pmul : Π(g h : G), Pp (g * h) = Pp g ⬝ Pp h) (x : EM1 G) : P :=
|
||
begin
|
||
induction x,
|
||
{ exact Pb},
|
||
{ exact Pp f},
|
||
{ exact Pmul f g}
|
||
end
|
||
|
||
protected definition elim_on [reducible] {P : Type} [is_trunc 1 P] (x : EM1 G)
|
||
(Pb : P) (Pp : G → Pb = Pb) (Pmul : Π(g h : G), Pp (g * h) = Pp g ⬝ Pp h) : P :=
|
||
EM.elim Pb Pp Pmul x
|
||
|
||
protected definition set_elim [reducible] {P : Type} [is_set P] (Pb : P) (Pp : G → Pb = Pb)
|
||
(x : EM1 G) : P :=
|
||
EM.elim Pb Pp !center x
|
||
|
||
protected definition prop_elim [reducible] {P : Type} [is_prop P] (Pb : P) (x : EM1 G) : P :=
|
||
EM.elim Pb !center !center x
|
||
|
||
definition elim_pth {P : Type} [is_trunc 1 P] {Pb : P} {Pp : G → Pb = Pb}
|
||
(Pmul : Π(g h : G), Pp (g * h) = Pp g ⬝ Pp h) (g : G) : ap (EM.elim Pb Pp Pmul) (pth g) = Pp g :=
|
||
proof !elim_pth qed
|
||
|
||
protected definition elim_set.{u} (Pb : Set.{u}) (Pp : Π(g : G), Pb ≃ Pb)
|
||
(Pmul : Π(g h : G) (x : Pb), Pp (g * h) x = Pp h (Pp g x)) (x : EM1 G) : Set.{u} :=
|
||
groupoid_quotient.elim_set (λu, Pb) (λu v, Pp) (λu v w g h, proof Pmul h g qed) x
|
||
|
||
theorem elim_set_pth {Pb : Set} {Pp : Π(g : G), Pb ≃ Pb}
|
||
(Pmul : Π(g h : G) (x : Pb), Pp (g * h) x = Pp h (Pp g x)) (g : G) :
|
||
transport (EM.elim_set Pb Pp Pmul) (pth g) = Pp g :=
|
||
!elim_set_pth
|
||
|
||
end EM
|
||
|
||
-- attribute EM.rec EM.elim [recursor 7]
|
||
attribute EM.base [constructor]
|
||
attribute EM.rec EM.elim [unfold 7] [recursor 7]
|
||
attribute EM.rec_on EM.elim_on [unfold 4]
|
||
attribute EM.set_rec EM.set_elim [unfold 6]
|
||
attribute EM.prop_rec EM.prop_elim EM.elim_set [unfold 5]
|
||
|
||
namespace EM
|
||
open groupoid_quotient
|
||
|
||
definition base_eq_base_equiv [constructor] (G : Group) : (base = base :> pEM1 G) ≃ G :=
|
||
!elt_eq_elt_equiv
|
||
|
||
definition fundamental_group_pEM1 (G : Group) : π₁ (pEM1 G) ≃g G :=
|
||
begin
|
||
fapply isomorphism_of_equiv,
|
||
{ exact trunc_equiv_trunc 0 !base_eq_base_equiv ⬝e trunc_equiv 0 G},
|
||
{ intros g h, induction g with p, induction h with q,
|
||
exact encode_con p q}
|
||
end
|
||
|
||
proposition is_trunc_pEM1 [instance] (G : Group) : is_trunc 1 (pEM1 G) :=
|
||
!is_trunc_groupoid_quotient
|
||
|
||
proposition is_trunc_EM1 [instance] (G : Group) : is_trunc 1 (EM1 G) :=
|
||
!is_trunc_groupoid_quotient
|
||
|
||
proposition is_conn_EM1 [instance] (G : Group) : is_conn 0 (EM1 G) :=
|
||
by apply @is_conn_groupoid_quotient; esimp; exact _
|
||
|
||
proposition is_conn_pEM1 [instance] (G : Group) : is_conn 0 (pEM1 G) :=
|
||
is_conn_EM1 G
|
||
|
||
-- TODO: prove this using truncated Whitehead.
|
||
|
||
definition EM1_map [unfold 7] {G : Group} {X : Type*} (e : Ω X ≃ G)
|
||
(r : Πp q, e (p ⬝ q) = e p * e q) [is_conn 0 X] [is_trunc 1 X] : EM1 G → X :=
|
||
begin
|
||
intro x, induction x using EM.elim,
|
||
{ exact Point X},
|
||
{ note p := e⁻¹ᵉ g, exact p},
|
||
{ exact inv_preserve_binary e concat mul r g h}
|
||
end
|
||
|
||
-- TODO
|
||
-- definition EM1_equiv {G : Group} {X : Type*} (e : Ω X ≃ G)
|
||
-- (r : Πp q, e (p ⬝ q) = e p * e q) [is_conn 0 X] [is_trunc 1 X] : EM1 G ≃ X :=
|
||
-- begin
|
||
-- apply equiv.mk (EM1_map e r),
|
||
-- apply whiteheads_principle 1,
|
||
-- { apply is_equiv_of_is_contr},
|
||
-- { intro x n, cases n with n,
|
||
-- { exact sorry},
|
||
-- { apply @is_equiv_of_is_contr, do 2 exact sorry}}
|
||
-- end
|
||
|
||
-- definition pequiv_pEM1 {G : Group} {X : Type*} (e : π₁ X ≃g G) [is_conn 0 X] [is_trunc 1 X]
|
||
-- : X ≃* pEM1 G :=
|
||
-- sorry
|
||
|
||
end EM
|
||
|
||
open hopf susp
|
||
namespace EM
|
||
-- The K(G,n+1):
|
||
variables (G : CommGroup) (n : ℕ)
|
||
|
||
definition EM1_mul [unfold 2 3] {G : CommGroup} (x x' : EM1 G) : EM1 G :=
|
||
begin
|
||
induction x,
|
||
{ exact x'},
|
||
{ induction x' using EM.set_rec,
|
||
{ exact pth g},
|
||
{ exact abstract begin apply loop_pathover, apply square_of_eq,
|
||
refine !resp_mul⁻¹ ⬝ _ ⬝ !resp_mul,
|
||
exact ap pth !mul.comm end end}},
|
||
{ refine EM.prop_rec _ x', esimp, apply resp_mul},
|
||
end
|
||
|
||
definition EM1_mul_one (G : CommGroup) (x : EM1 G) : EM1_mul x base = x :=
|
||
begin
|
||
induction x using EM.set_rec,
|
||
{ reflexivity},
|
||
{ apply eq_pathover_id_right, apply hdeg_square, refine EM.elim_pth _ g}
|
||
end
|
||
|
||
definition h_space_EM1 [constructor] [instance] (G : CommGroup) : h_space (pEM1 G) :=
|
||
begin
|
||
fapply h_space.mk,
|
||
{ exact EM1_mul},
|
||
{ exact base},
|
||
{ intro x', reflexivity},
|
||
{ apply EM1_mul_one}
|
||
end
|
||
|
||
/- K(G, n+1) -/
|
||
definition EMadd1 (G : CommGroup) (n : ℕ) : Type* :=
|
||
ptrunc (n+1) (iterate_psusp n (pEM1 G))
|
||
|
||
definition loop_EM2 (G : CommGroup) : Ω[1] (EMadd1 G 1) ≃* pEM1 G :=
|
||
begin
|
||
apply hopf.delooping, reflexivity
|
||
end
|
||
|
||
definition homotopy_group_EM2 (G : CommGroup) : πg[1+1] (EMadd1 G 1) ≃g G :=
|
||
begin
|
||
refine ghomotopy_group_succ_in _ 0 ⬝g _,
|
||
refine homotopy_group_isomorphism_of_pequiv 0 (loop_EM2 G) ⬝g _,
|
||
apply fundamental_group_pEM1
|
||
end
|
||
|
||
definition homotopy_group_EMadd1 (G : CommGroup) (n : ℕ) : πg[n+1] (EMadd1 G n) ≃g G :=
|
||
begin
|
||
cases n with n,
|
||
{ refine homotopy_group_isomorphism_of_pequiv 0 _ ⬝g fundamental_group_pEM1 G,
|
||
apply ptrunc_pequiv, apply is_trunc_pEM1},
|
||
induction n with n IH,
|
||
{ apply homotopy_group_EM2 G},
|
||
refine _ ⬝g IH,
|
||
refine !ghomotopy_group_ptrunc ⬝g _ ⬝g !ghomotopy_group_ptrunc⁻¹ᵍ,
|
||
apply iterate_psusp_stability_isomorphism,
|
||
rexact add_mul_le_mul_add n 1 1
|
||
end
|
||
|
||
local attribute EMadd1 [reducible]
|
||
definition is_conn_EMadd1 (G : CommGroup) (n : ℕ) : is_conn n (EMadd1 G n) := _
|
||
|
||
definition is_trunc_EMadd1 (G : CommGroup) (n : ℕ) : is_trunc (n+1) (EMadd1 G n) := _
|
||
|
||
/- K(G, n+1) -/
|
||
definition EM (G : CommGroup) : ℕ → Type*
|
||
| 0 := pType_of_Group G
|
||
| (k+1) := EMadd1 G k
|
||
|
||
definition phomotopy_group_EM (G : CommGroup) (n : ℕ) : π*[n] (EM G n) ≃* pType_of_Group G :=
|
||
begin
|
||
cases n with n,
|
||
{ rexact ptrunc_pequiv 0 (pType_of_Group G) _},
|
||
{ apply pequiv_of_isomorphism (homotopy_group_EMadd1 G n)}
|
||
end
|
||
|
||
definition ghomotopy_group_EM (G : CommGroup) (n : ℕ) : πg[n+1] (EM G (n+1)) ≃g G :=
|
||
homotopy_group_EMadd1 G n
|
||
|
||
definition is_conn_EM [instance] (G : CommGroup) (n : ℕ) : is_conn (n.-1) (EM G n) :=
|
||
begin
|
||
cases n with n,
|
||
{ apply is_conn_minus_one, apply tr, unfold [EM], exact 1},
|
||
{ apply is_conn_EMadd1}
|
||
end
|
||
|
||
definition is_conn_EM_succ [instance] (G : CommGroup) (n : ℕ) : is_conn n (EM G (succ n)) :=
|
||
is_conn_EM G (succ n)
|
||
|
||
definition is_trunc_EM [instance] (G : CommGroup) (n : ℕ) : is_trunc n (EM G n) :=
|
||
begin
|
||
cases n with n,
|
||
{ unfold [EM], apply semigroup.is_set_carrier},
|
||
{ apply is_trunc_EMadd1}
|
||
end
|
||
|
||
|
||
|
||
end EM
|