c3650048f0
add some properties about pointed maps and groups
726 lines
31 KiB
Text
726 lines
31 KiB
Text
-- Authors: Floris van Doorn
|
||
|
||
import homotopy.EM algebra.category.functor.equivalence types.pointed2 ..pointed_pi ..pointed
|
||
..move_to_lib .susp ..algebra.exactness ..univalent_subcategory
|
||
|
||
open eq equiv is_equiv algebra group nat pointed EM.ops is_trunc trunc susp function is_conn nat
|
||
universe variable u
|
||
/- TODO: try to fix the compilation time of this file -/
|
||
|
||
|
||
namespace EM
|
||
|
||
definition EM1_functor_gid (G : Group) : EM1_functor (gid G) ~* !pid :=
|
||
begin
|
||
fapply phomotopy.mk,
|
||
{ intro x, induction x,
|
||
{ reflexivity },
|
||
{ apply eq_pathover_id_right, apply hdeg_square, apply elim_pth, },
|
||
{ apply @is_prop.elim, apply is_trunc_pathover }},
|
||
{ reflexivity },
|
||
end
|
||
|
||
definition EMadd1_functor_gid (G : AbGroup) (n : ℕ) : EMadd1_functor (gid G) n ~* !pid :=
|
||
begin
|
||
induction n with n p,
|
||
{ apply EM1_functor_gid },
|
||
{ refine !EMadd1_functor_succ ⬝* _,
|
||
refine ptrunc_functor_phomotopy _ (susp_functor_phomotopy p ⬝* !susp_functor_pid) ⬝* _,
|
||
apply ptrunc_functor_pid }
|
||
end
|
||
|
||
definition EM_functor_gid (G : AbGroup) (n : ℕ) : EM_functor (gid G) n ~* !pid :=
|
||
begin
|
||
cases n with n,
|
||
{ apply pmap_of_homomorphism_gid },
|
||
{ apply EMadd1_functor_gid }
|
||
end
|
||
|
||
definition EM1_functor_gcompose {G H K : Group} (ψ : H →g K) (φ : G →g H) :
|
||
EM1_functor (ψ ∘g φ) ~* EM1_functor ψ ∘* EM1_functor φ :=
|
||
begin
|
||
fapply phomotopy.mk,
|
||
{ intro x, induction x,
|
||
{ reflexivity },
|
||
{ apply eq_pathover, apply hdeg_square, esimp,
|
||
refine !elim_pth ⬝ _ ⬝ (ap_compose (EM1_functor ψ) _ _)⁻¹,
|
||
refine _ ⬝ ap02 _ !elim_pth⁻¹, exact !elim_pth⁻¹ },
|
||
{ apply @is_prop.elim, apply is_trunc_pathover }},
|
||
{ reflexivity },
|
||
end
|
||
|
||
definition EMadd1_functor_gcompose {G H K : AbGroup} (ψ : H →g K) (φ : G →g H) (n : ℕ) :
|
||
EMadd1_functor (ψ ∘g φ) n ~* EMadd1_functor ψ n ∘* EMadd1_functor φ n :=
|
||
begin
|
||
induction n with n p,
|
||
{ apply EM1_functor_gcompose },
|
||
{ refine !EMadd1_functor_succ ⬝* _,
|
||
refine ptrunc_functor_phomotopy _ (susp_functor_phomotopy p ⬝* !susp_functor_pcompose) ⬝* _,
|
||
apply ptrunc_functor_pcompose }
|
||
end
|
||
|
||
definition EM_functor_gcompose {G H K : AbGroup} (ψ : H →g K) (φ : G →g H) (n : ℕ) :
|
||
EM_functor (ψ ∘g φ) n ~* EM_functor ψ n ∘* EM_functor φ n :=
|
||
begin
|
||
cases n with n,
|
||
{ apply pmap_of_homomorphism_gcompose },
|
||
{ apply EMadd1_functor_gcompose }
|
||
end
|
||
|
||
definition EM1_functor_phomotopy {G H : Group} {φ ψ : G →g H} (p : φ ~ ψ) :
|
||
EM1_functor φ ~* EM1_functor ψ :=
|
||
begin
|
||
fapply phomotopy.mk,
|
||
{ intro x, induction x,
|
||
{ reflexivity },
|
||
{ apply eq_pathover, apply hdeg_square, esimp,
|
||
refine !elim_pth ⬝ _ ⬝ !elim_pth⁻¹, exact ap pth (p g) },
|
||
{ apply @is_prop.elim, apply is_trunc_pathover }},
|
||
{ reflexivity },
|
||
end
|
||
|
||
definition EMadd1_functor_phomotopy {G H : AbGroup} {φ ψ : G →g H} (p : φ ~ ψ) (n : ℕ) :
|
||
EMadd1_functor φ n ~* EMadd1_functor ψ n :=
|
||
begin
|
||
induction n with n q,
|
||
{ exact EM1_functor_phomotopy p },
|
||
{ exact ptrunc_functor_phomotopy _ (susp_functor_phomotopy q) }
|
||
end
|
||
|
||
definition EM_functor_phomotopy {G H : AbGroup} {φ ψ : G →g H} (p : φ ~ ψ) (n : ℕ) :
|
||
EM_functor φ n ~* EM_functor ψ n :=
|
||
begin
|
||
cases n with n,
|
||
{ exact pmap_of_homomorphism_phomotopy p },
|
||
{ exact EMadd1_functor_phomotopy p n }
|
||
end
|
||
|
||
definition EM_equiv_EM [constructor] {G H : AbGroup} (φ : G ≃g H) (n : ℕ) : K G n ≃* K H n :=
|
||
begin
|
||
fapply pequiv.MK',
|
||
{ exact EM_functor φ n },
|
||
{ exact EM_functor φ⁻¹ᵍ n },
|
||
{ intro x, refine (EM_functor_gcompose φ⁻¹ᵍ φ n)⁻¹* x ⬝ _,
|
||
refine _ ⬝ EM_functor_gid G n x,
|
||
refine EM_functor_phomotopy _ n x,
|
||
rexact left_inv φ },
|
||
{ intro x, refine (EM_functor_gcompose φ φ⁻¹ᵍ n)⁻¹* x ⬝ _,
|
||
refine _ ⬝ EM_functor_gid H n x,
|
||
refine EM_functor_phomotopy _ n x,
|
||
rexact right_inv φ }
|
||
end
|
||
|
||
definition is_equiv_EM_functor [constructor] {G H : AbGroup} (φ : G →g H) [H2 : is_equiv φ]
|
||
(n : ℕ) : is_equiv (EM_functor φ n) :=
|
||
to_is_equiv (EM_equiv_EM (isomorphism.mk φ H2) n)
|
||
|
||
definition fundamental_group_EM1' (G : Group) : G ≃g π₁ (EM1 G) :=
|
||
(fundamental_group_EM1 G)⁻¹ᵍ
|
||
|
||
definition ghomotopy_group_EMadd1' (G : AbGroup) (n : ℕ) : G ≃g πg[n+1] (EMadd1 G n) :=
|
||
begin
|
||
change G ≃g π₁ (Ω[n] (EMadd1 G n)),
|
||
refine _ ⬝g homotopy_group_isomorphism_of_pequiv 0 (loopn_EMadd1_pequiv_EM1 G n),
|
||
apply fundamental_group_EM1'
|
||
end
|
||
|
||
definition homotopy_group_functor_EM1_functor {G H : Group} (φ : G →g H) :
|
||
π→g[1] (EM1_functor φ) ∘ fundamental_group_EM1' G ~ fundamental_group_EM1' H ∘ φ :=
|
||
begin
|
||
intro g, apply ap tr, exact !idp_con ⬝ !elim_pth,
|
||
end
|
||
|
||
section
|
||
|
||
definition ghomotopy_group_EMadd1'_0 (G : AbGroup) :
|
||
ghomotopy_group_EMadd1' G 0 ~ fundamental_group_EM1' G :=
|
||
begin
|
||
refine _ ⬝hty id_compose _,
|
||
unfold [ghomotopy_group_EMadd1'],
|
||
apply hwhisker_right (fundamental_group_EM1' G),
|
||
refine _ ⬝hty trunc_functor_id _ _,
|
||
exact trunc_functor_homotopy _ ap1_pid,
|
||
end
|
||
|
||
definition loopn_EMadd1_pequiv_EM1_succ (G : AbGroup) (n : ℕ) :
|
||
loopn_EMadd1_pequiv_EM1 G (succ n) ~* (loopn_succ_in n (EMadd1 G (succ n)))⁻¹ᵉ* ∘*
|
||
Ω→[n] (loop_EMadd1 G n) ∘* loopn_EMadd1_pequiv_EM1 G n :=
|
||
by reflexivity
|
||
|
||
-- definition is_trunc_EMadd1' [instance] (G : AbGroup) (n : ℕ) : is_trunc (succ n) (EMadd1 G n) :=
|
||
-- is_trunc_EMadd1 G n
|
||
|
||
definition loop_EMadd1_succ (G : AbGroup) (n : ℕ) :
|
||
loop_EMadd1 G (n+1) ~* (loop_ptrunc_pequiv (n+1+1) (susp (EMadd1 G (n+1))))⁻¹ᵉ* ∘*
|
||
freudenthal_pequiv (add_mul_le_mul_add n 1 1) (EMadd1 G (n+1)) ∘*
|
||
(ptrunc_pequiv (n+1+1) (EMadd1 G (n+1)))⁻¹ᵉ* :=
|
||
by reflexivity
|
||
|
||
definition ap1_EMadd1_natural {G H : AbGroup} (φ : G →g H) (n : ℕ) :
|
||
psquare (loop_EMadd1 G n) (loop_EMadd1 H n)
|
||
(EMadd1_functor φ n) (Ω→ (EMadd1_functor φ (succ n))) :=
|
||
begin
|
||
refine _ ⬝hp* Ω⇒ !EMadd1_functor_succ,
|
||
induction n with n IH,
|
||
{ refine !hopf.to_pmap_delooping_pinv ⬝pv* _ ⬝vp* !hopf.to_pmap_delooping_pinv,
|
||
exact !loop_susp_unit_natural ⬝h* ap1_psquare !ptr_natural },
|
||
{ refine !loop_EMadd1_succ ⬝pv* _ ⬝vp* !loop_EMadd1_succ,
|
||
refine _ ⬝h* !ap1_ptrunc_functor,
|
||
refine (@(ptrunc_pequiv_natural (n+1+1) _) _ _)⁻¹ʰ* ⬝h* _,
|
||
refine !to_pmap_freudenthal_pequiv ⬝pv* _ ⬝vp* !to_pmap_freudenthal_pequiv,
|
||
apply ptrunc_functor_psquare,
|
||
exact !loop_susp_unit_natural }
|
||
end
|
||
|
||
definition apn_EMadd1_pequiv_EM1_natural {G H : AbGroup} (φ : G →g H) (n : ℕ) :
|
||
psquare (loopn_EMadd1_pequiv_EM1 G n) (loopn_EMadd1_pequiv_EM1 H n)
|
||
(EM1_functor φ) (Ω→[n] (EMadd1_functor φ n)) :=
|
||
begin
|
||
induction n with n IH,
|
||
{ exact phomotopy.rfl },
|
||
{ refine pwhisker_left _ !loopn_EMadd1_pequiv_EM1_succ ⬝* _,
|
||
refine _ ⬝* pwhisker_right _ !loopn_EMadd1_pequiv_EM1_succ⁻¹*,
|
||
refine _ ⬝h* !loopn_succ_in_inv_natural,
|
||
exact IH ⬝h* (apn_psquare n !ap1_EMadd1_natural) }
|
||
end
|
||
|
||
definition homotopy_group_functor_EMadd1_functor {G H : AbGroup} (φ : G →g H) (n : ℕ) :
|
||
hsquare (ghomotopy_group_EMadd1' G n) (ghomotopy_group_EMadd1' H n)
|
||
φ (π→g[n+1] (EMadd1_functor φ n)) :=
|
||
begin
|
||
refine hwhisker_left _ (to_fun_isomorphism_trans _ _) ⬝hty _ ⬝hty
|
||
hwhisker_right _ (to_fun_isomorphism_trans _ _)⁻¹ʰᵗʸ,
|
||
refine _ ⬝htyh (homotopy_group_homomorphism_psquare 1 (apn_EMadd1_pequiv_EM1_natural φ n)),
|
||
apply homotopy_group_functor_EM1_functor
|
||
end
|
||
|
||
definition homotopy_group_functor_EMadd1_functor' {G H : AbGroup} (φ : G →g H) (n : ℕ) :
|
||
hsquare (ghomotopy_group_EMadd1' G n)⁻¹ᵍ (ghomotopy_group_EMadd1' H n)⁻¹ᵍ
|
||
(π→g[n+1] (EMadd1_functor φ n)) φ :=
|
||
(homotopy_group_functor_EMadd1_functor φ n)⁻¹ʰᵗʸʰ
|
||
|
||
definition EM1_pmap_natural {G H : Group} {X Y : Type*} (f : X →* Y) (eX : G → Ω X)
|
||
(eY : H → Ω Y) (rX : Πg h, eX (g * h) = eX g ⬝ eX h) (rY : Πg h, eY (g * h) = eY g ⬝ eY h)
|
||
[H2 : is_trunc 1 X] [is_trunc 1 Y] (φ : G →g H) (p : hsquare eX eY φ (Ω→ f)) :
|
||
psquare (EM1_pmap eX rX) (EM1_pmap eY rY) (EM1_functor φ) f :=
|
||
begin
|
||
fapply phomotopy.mk,
|
||
{ intro x, induction x using EM.set_rec,
|
||
{ exact respect_pt f },
|
||
{ apply eq_pathover,
|
||
refine ap_compose f _ _ ⬝ph _ ⬝hp (ap_compose (EM1_pmap eY rY) _ _)⁻¹,
|
||
refine ap02 _ !elim_pth ⬝ph _ ⬝hp ap02 _ !elim_pth⁻¹,
|
||
refine _ ⬝hp !elim_pth⁻¹, apply transpose, exact square_of_eq_bot (p g) }},
|
||
{ exact !idp_con⁻¹ }
|
||
end
|
||
|
||
definition EM1_pequiv'_natural {G H : Group} {X Y : Type*} (f : X →* Y) (eX : G ≃* Ω X)
|
||
(eY : H ≃* Ω Y) (rX : Πg h, eX (g * h) = eX g ⬝ eX h) (rY : Πg h, eY (g * h) = eY g ⬝ eY h)
|
||
[H1 : is_conn 0 X] [H2 : is_trunc 1 X] [is_conn 0 Y] [is_trunc 1 Y]
|
||
(φ : G →g H) (p : hsquare eX eY φ (Ω→ f)) :
|
||
psquare (EM1_pequiv' eX rX) (EM1_pequiv' eY rY) (EM1_functor φ) f :=
|
||
EM1_pmap_natural f eX eY rX rY φ p
|
||
|
||
definition EM1_pequiv_natural {G H : Group} {X Y : Type*} (f : X →* Y) (eX : G ≃g π₁ X)
|
||
(eY : H ≃g π₁ Y) [H1 : is_conn 0 X] [H2 : is_trunc 1 X] [is_conn 0 Y] [is_trunc 1 Y]
|
||
(φ : G →g H) (p : hsquare eX eY φ (π→g[1] f)) :
|
||
psquare (EM1_pequiv eX) (EM1_pequiv eY) (EM1_functor φ) f :=
|
||
EM1_pequiv'_natural f _ _ _ _ φ
|
||
begin
|
||
assert p' : ptrunc_functor 0 (Ω→ f) ∘* pequiv_of_isomorphism eX ~*
|
||
pequiv_of_isomorphism eY ∘* pmap_of_homomorphism φ, exact phomotopy_of_homotopy p,
|
||
exact p' ⬝h* (ptrunc_pequiv_natural 0 (Ω→ f)),
|
||
end
|
||
|
||
definition EM1_pequiv_type_natural {X Y : Type*} (f : X →* Y)
|
||
[H1 : is_conn 0 X] [H2 : is_trunc 1 X] [H3 : is_conn 0 Y] [H4 : is_trunc 1 Y] :
|
||
psquare (EM1_pequiv_type X) (EM1_pequiv_type Y) (EM1_functor (π→g[1] f)) f :=
|
||
begin refine EM1_pequiv_natural f _ _ _ _, exact homotopy.rfl end
|
||
|
||
definition EM_up_natural {G H : AbGroup} (φ : G →g H) {X Y : Type*} (f : X →* Y) {n : ℕ}
|
||
(eX : G →* Ω[succ (succ n)] X) (eY : H →* Ω[succ (succ n)] Y)
|
||
(p : hsquare eX eY φ (Ω→[succ (succ n)] f))
|
||
: hsquare (EM_up eX) (EM_up eY) φ (Ω→[succ n] (Ω→ f)) :=
|
||
begin
|
||
refine p ⬝htyh hsquare_of_psquare (loopn_succ_in_natural (succ n) f),
|
||
end
|
||
|
||
definition EMadd1_pmap_natural {G H : AbGroup} {X Y : Type*} (f : X →* Y) (n : ℕ)
|
||
(eX : G →* Ω[succ n] X) (eY : H →* Ω[succ n] Y) (rX : Π(g h : G), eX (g * h) = eX g ⬝ eX h)
|
||
(rY : Π(g h : H), eY (g * h) = eY g ⬝ eY h) [HX : is_trunc (n.+1) X] [HY : is_trunc (n.+1) Y]
|
||
(φ : G →g H) (p : hsquare eX eY φ (Ω→[succ n] f)) :
|
||
psquare (EMadd1_pmap n eX rX) (EMadd1_pmap n eY rY) (EMadd1_functor φ n) f :=
|
||
begin
|
||
revert X Y f eX eY rX rY HX HY p, induction n with n IH: intros,
|
||
{ apply EM1_pmap_natural, exact p },
|
||
{ do 2 rewrite [EMadd1_pmap_succ], refine _ ⬝* pwhisker_left _ !EMadd1_functor_succ⁻¹*,
|
||
refine (ptrunc_elim_pcompose ((succ n).+1) _ _)⁻¹* ⬝* _ ⬝*
|
||
(ptrunc_elim_ptrunc_functor ((succ n).+1) _ _)⁻¹*,
|
||
apply ptrunc_elim_phomotopy,
|
||
refine _ ⬝* !susp_elim_susp_functor⁻¹*,
|
||
refine _ ⬝* susp_elim_phomotopy (IH _ _ _ _ _ (is_homomorphism_EM_up eX rX) _
|
||
(@is_trunc_loop _ _ HX) _ (EM_up_natural φ f eX eY p)),
|
||
apply susp_elim_natural }
|
||
end
|
||
|
||
definition EMadd1_pequiv'_natural {G H : AbGroup} {X Y : Type*} (f : X →* Y) (n : ℕ)
|
||
(eX : G ≃* Ω[succ n] X) (eY : H ≃* Ω[succ n] Y) (rX : Π(g h : G), eX (g * h) = eX g ⬝ eX h)
|
||
(rY : Π(g h : H), eY (g * h) = eY g ⬝ eY h)
|
||
[H1 : is_conn n X] [H2 : is_trunc (n.+1) X] [is_conn n Y] [is_trunc (n.+1) Y]
|
||
(φ : G →g H) (p : hsquare eX eY φ (Ω→[succ n] f)) :
|
||
psquare (EMadd1_pequiv' n eX rX) (EMadd1_pequiv' n eY rY) (EMadd1_functor φ n) f :=
|
||
EMadd1_pmap_natural f n eX eY rX rY φ p
|
||
|
||
definition EMadd1_pequiv_natural_local_instance {X : Type*} (n : ℕ) [H : is_trunc (n.+1) X] :
|
||
is_set (Ω[succ n] X) :=
|
||
@(is_set_loopn (succ n) X) H
|
||
|
||
local attribute EMadd1_pequiv_natural_local_instance [instance]
|
||
|
||
definition EMadd1_pequiv_natural {G H : AbGroup} {X Y : Type*} (f : X →* Y) (n : ℕ) (eX : G ≃g πg[n+1] X)
|
||
(eY : H ≃g πg[n+1] Y) [H1 : is_conn n X] [H2 : is_trunc (n.+1) X] [H3 : is_conn n Y]
|
||
[H4 : is_trunc (n.+1) Y] (φ : G →g H) (p : hsquare eX eY φ (π→g[n+1] f)) :
|
||
psquare (EMadd1_pequiv n eX) (EMadd1_pequiv n eY) (EMadd1_functor φ n) f :=
|
||
EMadd1_pequiv'_natural f n
|
||
(pequiv_of_isomorphism eX ⬝e* ptrunc_pequiv 0 (Ω[succ n] X))
|
||
(pequiv_of_isomorphism eY ⬝e* ptrunc_pequiv 0 (Ω[succ n] Y))
|
||
_ _ φ (p ⬝htyh hsquare_of_psquare (ptrunc_pequiv_natural 0 (Ω→[succ n] f)))
|
||
|
||
definition EMadd1_pequiv_succ_natural {G H : AbGroup} {X Y : Type*} (f : X →* Y) (n : ℕ)
|
||
(eX : G ≃g πag[n+2] X) (eY : H ≃g πag[n+2] Y) [is_conn (n.+1) X] [is_trunc (n.+2) X]
|
||
[is_conn (n.+1) Y] [is_trunc (n.+2) Y] (φ : G →g H) (p : hsquare eX eY φ (π→g[n+2] f)) :
|
||
psquare (EMadd1_pequiv_succ n eX) (EMadd1_pequiv_succ n eY) (EMadd1_functor φ (n+1)) f :=
|
||
@(EMadd1_pequiv_natural f (succ n) eX eY) _ _ _ _ φ p
|
||
|
||
definition EMadd1_pequiv_type_natural {X Y : Type*} (f : X →* Y) (n : ℕ)
|
||
[H1 : is_conn (n+1) X] [H2 : is_trunc (n+1+1) X]
|
||
[H3 : is_conn (n+1) Y] [H4 : is_trunc (n+1+1) Y] :
|
||
psquare (EMadd1_pequiv_type X n) (EMadd1_pequiv_type Y n)
|
||
(EMadd1_functor (π→g[n+2] f) (succ n)) f :=
|
||
EMadd1_pequiv_succ_natural f n !isomorphism.refl !isomorphism.refl (π→g[n+2] f)
|
||
proof λa, idp qed
|
||
|
||
definition EMadd1_pmap_equiv (n : ℕ) (X Y : Type*) [is_conn (n+1) X] [is_trunc (n+1+1) X]
|
||
[is_conn (n+1) Y] [is_trunc (n+1+1) Y] : (X →* Y) ≃ πag[n+2] X →g πag[n+2] Y :=
|
||
begin
|
||
fapply equiv.MK,
|
||
{ exact π→g[n+2] },
|
||
{ exact λφ, (EMadd1_pequiv_type Y n ∘* EMadd1_functor φ (n+1)) ∘* (EMadd1_pequiv_type X n)⁻¹ᵉ* },
|
||
{ intro φ, apply homomorphism_eq,
|
||
refine homotopy_group_functor_pcompose (n+2) _ _ ⬝hty _, exact sorry }, -- easy but tedious
|
||
{ intro f, apply eq_of_phomotopy, refine (phomotopy_pinv_right_of_phomotopy _)⁻¹*,
|
||
apply EMadd1_pequiv_type_natural }
|
||
end
|
||
|
||
definition EM1_functor_trivial_homomorphism [constructor] (G H : Group) :
|
||
EM1_functor (trivial_homomorphism G H) ~* pconst (EM1 G) (EM1 H) :=
|
||
begin
|
||
fapply phomotopy.mk,
|
||
{ intro x, induction x using EM.set_rec,
|
||
{ reflexivity },
|
||
{ apply eq_pathover_constant_right, apply hdeg_square,
|
||
refine !elim_pth ⬝ _, apply resp_one }},
|
||
{ reflexivity }
|
||
end
|
||
|
||
definition EMadd1_functor_trivial_homomorphism (G H : AbGroup) (n : ℕ) :
|
||
EMadd1_functor (trivial_homomorphism G H) n ~* pconst (EMadd1 G n) (EMadd1 H n) :=
|
||
begin
|
||
induction n with n h,
|
||
{ exact EM1_functor_trivial_homomorphism G H },
|
||
{ refine !EMadd1_functor_succ ⬝* ptrunc_functor_phomotopy (n+2) _ ⬝* !ptrunc_functor_pconst,
|
||
refine susp_functor_phomotopy h ⬝* !susp_functor_pconst }
|
||
end
|
||
|
||
definition EMadd1_pfunctor [constructor] (G H : AbGroup) (n : ℕ) :
|
||
(G →gg H) →* EMadd1 G n →** EMadd1 H n :=
|
||
pmap.mk (λφ, EMadd1_functor φ n) (eq_of_phomotopy (EMadd1_functor_trivial_homomorphism G H n))
|
||
|
||
definition loopn_EMadd1_add (G : AbGroup) (n m : ℕ) : Ω[n] (EMadd1 G (m + n)) ≃* EMadd1 G m :=
|
||
begin
|
||
induction n with n e,
|
||
{ reflexivity },
|
||
{ refine !loopn_succ_in ⬝e* Ω≃[n] (loop_EMadd1 G (m + n))⁻¹ᵉ* ⬝e* e }
|
||
end
|
||
|
||
|
||
/- The Eilenberg-MacLane space K(G,n) with the same homotopy group as X on level n.
|
||
On paper this is written K(πₙ(X), n). The problem is that for
|
||
* n = 0 the expression π₀(X) is a pointed set, and K(X,0) needs X to be a pointed set
|
||
* n = 1 the expression π₁(X) is a group, and K(G,1) needs G to be a group
|
||
* n ≥ 2 the expression πₙ(X) is an abelian, and K(G,n) needs X to be an abelian group
|
||
|
||
-/
|
||
definition EM_type (X : Type*) : ℕ → Type*
|
||
| 0 := ptrunc 0 X
|
||
| 1 := EM1 (π₁ X)
|
||
| (n+2) := EMadd1 (πag[n+2] X) (n+1)
|
||
|
||
definition EM_type_pequiv {X Y : pType.{u}} (n : ℕ) [Hn : is_succ n] (e : πg[n] Y ≃g πg[n] X)
|
||
[H1 : is_conn (n.-1) X] [H2 : is_trunc n X] : EM_type Y n ≃* X :=
|
||
begin
|
||
induction Hn with n, cases n with n,
|
||
{ have is_conn 0 X, from H1,
|
||
have is_trunc 1 X, from H2,
|
||
exact EM1_pequiv e },
|
||
{ have is_conn (n+1) X, from H1,
|
||
have is_trunc ((n+1).+1) X, from H2,
|
||
exact EMadd1_pequiv (n+1) e }
|
||
end
|
||
|
||
-- definition EM1_functor_equiv' (X Y : Type*) [H1 : is_conn 0 X] [H2 : is_trunc 1 X]
|
||
-- [H3 : is_conn 0 Y] [H4 : is_trunc 1 Y] : (X →* Y) ≃ (π₁ X →g π₁ Y) :=
|
||
-- begin
|
||
-- fapply equiv.MK,
|
||
-- { intro f, exact π→g[1] f },
|
||
-- { intro φ, exact EM1_pequiv_type Y ∘* EM1_functor φ ∘* (EM1_pequiv_type X)⁻¹ᵉ* },
|
||
-- { intro φ, apply homomorphism_eq,
|
||
-- refine homotopy_group_homomorphism_pcompose _ _ _ ⬝hty _,
|
||
-- refine hwhisker_left _ (homotopy_group_homomorphism_pcompose _ _ _) ⬝hty _,
|
||
-- refine (hassoc _ _ _)⁻¹ʰᵗʸ ⬝hty _, exact sorry },
|
||
-- { intro f, apply eq_of_phomotopy, refine !passoc⁻¹* ⬝* _, apply pinv_right_phomotopy_of_phomotopy,
|
||
-- exact sorry }
|
||
-- end
|
||
|
||
-- definition EMadd1_functor_equiv' (n : ℕ) (X Y : Type*) [H1 : is_conn (n+1) X] [H2 : is_trunc (n+1+1) X]
|
||
-- [H3 : is_conn (n+1) Y] [H4 : is_trunc (n+1+1) Y] : (X →* Y) ≃ (πag[n+2] X →g πag[n+2] Y) :=
|
||
-- begin
|
||
-- fapply equiv.MK,
|
||
-- { intro f, exact π→g[n+2] f },
|
||
-- { intro φ, exact EMadd1_pequiv_type Y n ∘* EMadd1_functor φ (n+1) ∘* (EMadd1_pequiv_type X n)⁻¹ᵉ* },
|
||
-- { intro φ, apply homomorphism_eq,
|
||
-- refine homotopy_group_homomorphism_pcompose _ _ _ ⬝hty _,
|
||
-- refine hwhisker_left _ (homotopy_group_homomorphism_pcompose _ _ _) ⬝hty _,
|
||
-- intro g, exact sorry },
|
||
-- { intro f, apply eq_of_phomotopy, refine !passoc⁻¹* ⬝* _, apply pinv_right_phomotopy_of_phomotopy,
|
||
-- exact !EMadd1_pequiv_type_natural⁻¹* }
|
||
-- end
|
||
|
||
-- definition EM_functor_equiv (n : ℕ) (G H : AbGroup) : (G →g H) ≃ (EMadd1 G (n+1) →* EMadd1 H (n+1)) :=
|
||
-- begin
|
||
-- fapply equiv.MK,
|
||
-- { intro φ, exact EMadd1_functor φ (n+1) },
|
||
-- { intro f, exact ghomotopy_group_EMadd1 H (n+1) ∘g π→g[n+2] f ∘g (ghomotopy_group_EMadd1 G (n+1))⁻¹ᵍ },
|
||
-- { intro f, apply homomorphism_eq, },
|
||
-- { }
|
||
-- end
|
||
|
||
|
||
-- definition EMadd1_pmap {G : AbGroup} {X : Type*} (n : ℕ)
|
||
-- (e : Ω[succ n] X ≃* G)
|
||
-- (r : Πp q, e (p ⬝ q) = e p * e q)
|
||
-- [H1 : is_conn n X] [H2 : is_trunc (n.+1) X] : EMadd1 G n →* X :=
|
||
-- begin
|
||
-- revert X e r H1 H2, induction n with n f: intro X e r H1 H2,
|
||
-- { exact EM1_pmap e⁻¹ᵉ* (equiv.inv_preserve_binary e concat mul r) },
|
||
-- rewrite [EMadd1_succ],
|
||
-- exact ptrunc.elim ((succ n).+1)
|
||
-- (susp.elim (f _ (EM_up e) (is_mul_hom_EM_up e r) _ _)),
|
||
-- end
|
||
|
||
-- definition is_set_pmap_ptruncconntype {n : ℕ₋₂} (X Y : (n.+1)-Type*[n]) : is_set (X →* Y) :=
|
||
-- begin
|
||
-- apply is_trunc_succ_intro,
|
||
-- intro f g,
|
||
-- apply @(is_trunc_equiv_closed_rev -1 (pmap_eq_equiv f g)),
|
||
-- apply is_prop.mk,
|
||
-- exact sorry
|
||
-- end
|
||
|
||
|
||
end
|
||
|
||
section category
|
||
/- category -/
|
||
structure ptruncconntype' (n : ℕ₋₂) : Type :=
|
||
(A : Type*)
|
||
(H1 : is_conn n A)
|
||
(H2 : is_trunc (n+1) A)
|
||
|
||
attribute ptruncconntype'.A [coercion]
|
||
attribute ptruncconntype'.H1 ptruncconntype'.H2 [instance]
|
||
|
||
definition ptruncconntype'_equiv_ptruncconntype [constructor] (n : ℕ₋₂) :
|
||
(ptruncconntype' n : Type.{u+1}) ≃ ((n+1)-Type*[n] : Type.{u+1}) :=
|
||
begin
|
||
fapply equiv.MK,
|
||
{ intro X, exact ptruncconntype.mk (ptruncconntype'.A X) _ pt _ },
|
||
{ intro X, exact ptruncconntype'.mk X _ _ },
|
||
{ intro X, induction X with X H1 x₀ H2, reflexivity },
|
||
{ intro X, induction X with X H1 H2, induction X with X x₀, reflexivity }
|
||
end
|
||
|
||
definition EM1_pequiv_ptruncconntype' (X : ptruncconntype' 0) : EM1 (πg[1] X) ≃* X :=
|
||
@(EM1_pequiv_type X) _ (ptruncconntype'.H2 X)
|
||
|
||
definition EMadd1_pequiv_ptruncconntype' {n : ℕ} (X : ptruncconntype' (n+1)) :
|
||
EMadd1 (πag[n+2] X) (succ n) ≃* X :=
|
||
@(EMadd1_pequiv_type X n) _ (ptruncconntype'.H2 X)
|
||
|
||
open trunc_index
|
||
definition is_set_pmap_ptruncconntype {n : ℕ₋₂} (X Y : ptruncconntype' n) : is_set (X →* Y) :=
|
||
begin
|
||
cases n with n, { exact _ },
|
||
cases Y with Y H1 H2, cases Y with Y y₀,
|
||
exact is_trunc_pmap_of_is_conn X n _ -1 _ (pointed.MK Y y₀) !le.refl H2,
|
||
end
|
||
|
||
open category functor nat_trans
|
||
|
||
definition precategory_ptruncconntype' [constructor] (n : ℕ₋₂) :
|
||
precategory.{u+1 u} (ptruncconntype' n) :=
|
||
begin
|
||
fapply precategory.mk,
|
||
{ exact λX Y, X →* Y },
|
||
{ exact is_set_pmap_ptruncconntype },
|
||
{ exact λX Y Z g f, g ∘* f },
|
||
{ exact λX, pid X },
|
||
{ intros, apply eq_of_phomotopy, exact !passoc⁻¹* },
|
||
{ intros, apply eq_of_phomotopy, apply pid_pcompose },
|
||
{ intros, apply eq_of_phomotopy, apply pcompose_pid }
|
||
end
|
||
|
||
definition cptruncconntype' [constructor] (n : ℕ₋₂) : Precategory :=
|
||
precategory.Mk (precategory_ptruncconntype' n)
|
||
|
||
notation `cType*[`:95 n `]`:0 := cptruncconntype' n
|
||
|
||
definition tEM1 [constructor] (G : Group) : ptruncconntype' 0 :=
|
||
ptruncconntype'.mk (EM1 G) _ !is_trunc_EM1
|
||
|
||
definition tEM [constructor] (G : AbGroup) (n : ℕ) : ptruncconntype' (n.-1) :=
|
||
ptruncconntype'.mk (EM G n) _ !is_trunc_EM
|
||
|
||
definition EM1_cfunctor : Grp ⇒ cType*[0] :=
|
||
functor.mk
|
||
(λG, tEM1 G)
|
||
(λG H φ, EM1_functor φ)
|
||
begin intro, fapply eq_of_phomotopy, apply EM1_functor_gid end
|
||
begin intros, fapply eq_of_phomotopy, apply EM1_functor_gcompose end
|
||
|
||
definition EM_cfunctor (n : ℕ) : AbGrp ⇒ cType*[n.-1] :=
|
||
functor.mk
|
||
(λG, tEM G n)
|
||
(λG H φ, EM_functor φ n)
|
||
begin intro, fapply eq_of_phomotopy, apply EM_functor_gid end
|
||
begin intros, fapply eq_of_phomotopy, apply EM_functor_gcompose end
|
||
|
||
definition homotopy_group_cfunctor : cType*[0] ⇒ Grp :=
|
||
functor.mk
|
||
(λX, πg[1] X)
|
||
(λX Y f, π→g[1] f)
|
||
begin intro, apply homomorphism_eq, exact to_homotopy !homotopy_group_functor_pid end
|
||
begin intros, apply homomorphism_eq, exact to_homotopy !homotopy_group_functor_pcompose end
|
||
|
||
definition ab_homotopy_group_cfunctor (n : ℕ) : cType*[n.+1] ⇒ AbGrp :=
|
||
functor.mk
|
||
(λX, πag[n+2] X)
|
||
(λX Y f, π→g[n+2] f)
|
||
begin intro, apply homomorphism_eq, exact to_homotopy !homotopy_group_functor_pid end
|
||
begin intros, apply homomorphism_eq, exact to_homotopy !homotopy_group_functor_pcompose end
|
||
|
||
definition is_equivalence_EM1_cfunctor : is_equivalence EM1_cfunctor.{u} :=
|
||
begin
|
||
fapply is_equivalence.mk,
|
||
{ exact homotopy_group_cfunctor.{u} },
|
||
{ fapply natural_iso.mk,
|
||
{ fapply nat_trans.mk,
|
||
{ intro G, exact (fundamental_group_EM1' G)⁻¹ᵍ },
|
||
{ intro G H φ, apply homomorphism_eq, exact hhinverse (homotopy_group_functor_EM1_functor φ) }},
|
||
{ intro G, fapply iso.is_iso.mk,
|
||
{ exact fundamental_group_EM1' G },
|
||
{ apply homomorphism_eq,
|
||
exact to_right_inv (equiv_of_isomorphism (fundamental_group_EM1' G)), },
|
||
{ apply homomorphism_eq,
|
||
exact to_left_inv (equiv_of_isomorphism (fundamental_group_EM1' G)), }}},
|
||
{ fapply natural_iso.mk,
|
||
{ fapply nat_trans.mk,
|
||
{ intro X, exact EM1_pequiv_ptruncconntype' X },
|
||
{ intro X Y f, apply eq_of_phomotopy, apply EM1_pequiv_type_natural }},
|
||
{ intro X, fapply iso.is_iso.mk,
|
||
{ exact (EM1_pequiv_ptruncconntype' X)⁻¹ᵉ* },
|
||
{ apply eq_of_phomotopy, apply pleft_inv },
|
||
{ apply eq_of_phomotopy, apply pright_inv }}}
|
||
end
|
||
|
||
definition is_equivalence_EM_cfunctor (n : ℕ) : is_equivalence (EM_cfunctor.{u} (n+2)) :=
|
||
begin
|
||
fapply is_equivalence.mk,
|
||
{ exact ab_homotopy_group_cfunctor.{u} n },
|
||
{ fapply natural_iso.mk,
|
||
{ fapply nat_trans.mk,
|
||
{ intro G, exact (ghomotopy_group_EMadd1' G (n+1))⁻¹ᵍ },
|
||
{ intro G H φ, apply homomorphism_eq, exact homotopy_group_functor_EMadd1_functor' φ (n+1) }},
|
||
{ intro G, fapply iso.is_iso.mk,
|
||
{ exact ghomotopy_group_EMadd1' G (n+1) },
|
||
{ apply homomorphism_eq,
|
||
exact to_right_inv (equiv_of_isomorphism (ghomotopy_group_EMadd1' G (n+1))), },
|
||
{ apply homomorphism_eq,
|
||
exact to_left_inv (equiv_of_isomorphism (ghomotopy_group_EMadd1' G (n+1))), }}},
|
||
{ fapply natural_iso.mk,
|
||
{ fapply nat_trans.mk,
|
||
{ intro X, exact EMadd1_pequiv_ptruncconntype' X },
|
||
{ intro X Y f, apply eq_of_phomotopy, apply EMadd1_pequiv_type_natural }},
|
||
{ intro X, fapply iso.is_iso.mk,
|
||
{ exact (EMadd1_pequiv_ptruncconntype' X)⁻¹ᵉ* },
|
||
{ apply eq_of_phomotopy, apply pleft_inv },
|
||
{ apply eq_of_phomotopy, apply pright_inv }}}
|
||
end
|
||
|
||
definition Grp_equivalence_cptruncconntype' [constructor] : Grp.{u} ≃c cType*[0] :=
|
||
equivalence.mk EM1_cfunctor.{u} is_equivalence_EM1_cfunctor.{u}
|
||
|
||
definition AbGrp_equivalence_cptruncconntype' [constructor] (n : ℕ) : AbGrp.{u} ≃c cType*[n.+1] :=
|
||
equivalence.mk (EM_cfunctor.{u} (n+2)) (is_equivalence_EM_cfunctor.{u} n)
|
||
end category
|
||
|
||
definition pequiv_EMadd1_of_loopn_pequiv_EM1 {G : AbGroup} {X : Type*} (n : ℕ)
|
||
(e : Ω[n] X ≃* EM1 G) [H1 : is_conn n X] : X ≃* EMadd1 G n :=
|
||
begin
|
||
symmetry, apply EMadd1_pequiv, symmetry,
|
||
refine isomorphism_of_eq (ap (λx, πg[x+1] X) !zero_add⁻¹) ⬝g homotopy_group_add X 0 n ⬝g _ ⬝g
|
||
!fundamental_group_EM1,
|
||
exact homotopy_group_isomorphism_of_pequiv 0 e,
|
||
refine is_trunc_of_is_trunc_loopn n 1 X _ (@is_conn_of_is_conn_succ _ _ H1),
|
||
exact is_trunc_equiv_closed_rev 1 e _
|
||
end
|
||
|
||
definition EM1_pequiv_EM1 {G H : Group} (φ : G ≃g H) : EM1 G ≃* EM1 H :=
|
||
pequiv.MK (EM1_functor φ) (EM1_functor φ⁻¹ᵍ)
|
||
abstract (EM1_functor_gcompose φ⁻¹ᵍ φ)⁻¹* ⬝* EM1_functor_phomotopy proof left_inv φ qed ⬝*
|
||
EM1_functor_gid G end
|
||
abstract (EM1_functor_gcompose φ φ⁻¹ᵍ)⁻¹* ⬝* EM1_functor_phomotopy proof right_inv φ qed ⬝*
|
||
EM1_functor_gid H end
|
||
|
||
definition is_contr_EM1 {G : Group} (H : is_contr G) : is_contr (EM1 G) :=
|
||
is_contr_of_is_conn_of_is_trunc
|
||
(is_trunc_succ_succ_of_is_trunc_loop _ _ (is_trunc_equiv_closed _ !loop_EM1 _) _) !is_conn_EM1
|
||
|
||
definition is_contr_EMadd1 (n : ℕ) {G : AbGroup} (H : is_contr G) : is_contr (EMadd1 G n) :=
|
||
begin
|
||
induction n with n IH,
|
||
{ exact is_contr_EM1 H },
|
||
{ have is_contr (ptrunc (n+2) (susp (EMadd1 G n))), from _,
|
||
exact this }
|
||
end
|
||
|
||
definition is_contr_EM (n : ℕ) {G : AbGroup} (H : is_contr G) : is_contr (K G n) :=
|
||
begin
|
||
cases n with n,
|
||
{ exact H },
|
||
{ exact is_contr_EMadd1 n H }
|
||
end
|
||
|
||
definition EMadd1_pequiv_EMadd1 (n : ℕ) {G H : AbGroup} (φ : G ≃g H) : EMadd1 G n ≃* EMadd1 H n :=
|
||
pequiv.MK (EMadd1_functor φ n) (EMadd1_functor φ⁻¹ᵍ n)
|
||
abstract (EMadd1_functor_gcompose φ⁻¹ᵍ φ n)⁻¹* ⬝* EMadd1_functor_phomotopy proof left_inv φ qed n ⬝*
|
||
EMadd1_functor_gid G n end
|
||
abstract (EMadd1_functor_gcompose φ φ⁻¹ᵍ n)⁻¹* ⬝* EMadd1_functor_phomotopy proof right_inv φ qed n ⬝*
|
||
EMadd1_functor_gid H n end
|
||
|
||
definition EM_pequiv_EM (n : ℕ) {G H : AbGroup} (φ : G ≃g H) : K G n ≃* K H n :=
|
||
begin
|
||
cases n with n,
|
||
{ exact pequiv_of_isomorphism φ },
|
||
{ exact EMadd1_pequiv_EMadd1 n φ }
|
||
end
|
||
|
||
definition ppi_EMadd1 {X : Type*} (Y : X → Type*) (n : ℕ) :
|
||
(Π*(x : X), EMadd1 (πag[n+2] (Y x)) (n+1)) ≃* EMadd1 (πag[n+2] (Π*(x : X), Y x)) (n+1) :=
|
||
begin
|
||
exact sorry
|
||
end
|
||
--EM_spectrum (πₛ[s] (spi X Y)) k ≃* spi X (λx, EM_spectrum (πₛ[s] (Y x))) k
|
||
|
||
|
||
/- fiber of EM_functor -/
|
||
open fiber
|
||
definition is_trunc_fiber_EM1_functor {G H : Group} (φ : G →g H) :
|
||
is_trunc 1 (pfiber (EM1_functor φ)) :=
|
||
!is_trunc_fiber
|
||
|
||
definition is_conn_fiber_EM1_functor {G H : Group} (φ : G →g H) :
|
||
is_conn -1 (pfiber (EM1_functor φ)) :=
|
||
begin
|
||
apply is_conn_fiber
|
||
end
|
||
|
||
definition is_trunc_fiber_EMadd1_functor {G H : AbGroup} (φ : G →g H) (n : ℕ) :
|
||
is_trunc (n+1) (pfiber (EMadd1_functor φ n)) :=
|
||
begin
|
||
apply is_trunc_fiber
|
||
end
|
||
|
||
definition is_conn_fiber_EMadd1_functor {G H : AbGroup} (φ : G →g H) (n : ℕ) :
|
||
is_conn (n.-1) (pfiber (EMadd1_functor φ n)) :=
|
||
begin
|
||
apply is_conn_fiber, apply is_conn_of_is_conn_succ, apply is_conn_EMadd1,
|
||
apply is_conn_EMadd1
|
||
end
|
||
|
||
definition is_trunc_fiber_EM_functor {G H : AbGroup} (φ : G →g H) (n : ℕ) :
|
||
is_trunc n (pfiber (EM_functor φ n)) :=
|
||
begin
|
||
apply is_trunc_fiber
|
||
end
|
||
|
||
definition is_conn_fiber_EM_functor {G H : AbGroup} (φ : G →g H) (n : ℕ) :
|
||
is_conn (n.-2) (pfiber (EM_functor φ n)) :=
|
||
begin
|
||
apply is_conn_fiber, apply is_conn_of_is_conn_succ
|
||
end
|
||
|
||
section
|
||
open chain_complex prod fin
|
||
|
||
/- TODO: other cases -/
|
||
definition LES_isomorphism_kernel_of_trivial
|
||
{X Y : pType.{u}} (f : X →* Y) (n : ℕ) [H : is_succ n]
|
||
(H1 : is_contr (πg[n+1] Y)) : πg[n] (pfiber f) ≃g Kernel (π→g[n] f) :=
|
||
begin
|
||
induction H with n,
|
||
have H2 : is_exact (π→g[n+1] (ppoint f)) (π→g[n+1] f),
|
||
from is_exact_of_is_exact_at (is_exact_LES_of_homotopy_groups f (n+1, 0)),
|
||
have H3 : is_exact (π→g[n+1] (boundary_map f) ∘g ghomotopy_group_succ_in n Y)
|
||
(π→g[n+1] (ppoint f)),
|
||
from is_exact_of_is_exact_at (is_exact_LES_of_homotopy_groups f (n+1, 1)),
|
||
exact isomorphism_kernel_of_is_exact H3 H2 H1
|
||
end
|
||
|
||
end
|
||
|
||
open group algebra is_trunc
|
||
definition homotopy_group_fiber_EM1_functor {G H : Group.{u}} (φ : G →g H) :
|
||
π₁ (pfiber (EM1_functor φ)) ≃g Kernel φ :=
|
||
have H1 : is_trunc 1 (EM1 H), from sorry,
|
||
have H2 : 1 <[ℕ] 1 + 1, from sorry,
|
||
LES_isomorphism_kernel_of_trivial (EM1_functor φ) 1
|
||
(@trivial_homotopy_group_of_is_trunc _ 1 2 H1 H2) ⬝g
|
||
sorry
|
||
|
||
definition homotopy_group_fiber_EMadd1_functor {G H : AbGroup} (φ : G →g H) (n : ℕ) :
|
||
πg[n+1] (pfiber (EMadd1_functor φ n)) ≃g Kernel φ :=
|
||
sorry
|
||
|
||
/- TODO: move-/
|
||
definition cokernel {G H : AbGroup} (φ : G →g H) : AbGroup :=
|
||
quotient_ab_group (image φ)
|
||
|
||
/- todo: in algebra/quotient_group, do the first steps without assuming that N is normal,
|
||
then this is qg for (image φ) in H -/
|
||
definition image_cosets {G H : Group} (φ : G →g H) : Set* :=
|
||
sorry
|
||
|
||
definition homotopy_group_EMadd1_functor1 {G H : AbGroup} (φ : G →g H) (n : ℕ) :
|
||
πg[n+1] (pfiber (EMadd1_functor φ (n+1))) ≃g cokernel φ :=
|
||
sorry
|
||
|
||
definition homotopy_group_EMadd1_functor2 {G H : AbGroup} (φ : G →g H) (n : ℕ) :
|
||
πg[n+1] (pfiber (EMadd1_functor φ n)) ≃g Kernel φ :=
|
||
sorry
|
||
|
||
definition trunc_fiber_EM1_functor {G H : Group} (φ : G →g H) :
|
||
ptrunc 0 (pfiber (EM1_functor φ)) ≃* image_cosets φ :=
|
||
sorry
|
||
|
||
end EM
|