37fbe56b8c
The maps on every level are just the functorial action of the homotopy groups (possibly composed by a cast), but there are no compositions with path inversion. There are also some updates in various files after changes in the HoTT library.
801 lines
31 KiB
Text
801 lines
31 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
|
||
|
||
We define the fiber sequence of a pointed map f : X →* Y. We mostly follow the proof in section 8.4
|
||
of the book.
|
||
|
||
PART 1:
|
||
We define a sequence fiber_sequence as in Definition 8.4.3.
|
||
It has types X(n) : Type*
|
||
X(0) := Y,
|
||
X(1) := X,
|
||
X(n+1) := fiber (f(n))
|
||
with functions f(n) : X(n+1) →* X(n)
|
||
f(0) := f
|
||
f(n+1) := point (f(n)) [this is the first projection]
|
||
We prove that this is an exact sequence.
|
||
Then we prove Lemma 8.4.3, by showing that X(n+3) ≃* Ω(X(n)) and that this equivalence sends
|
||
the pointed map f(n+3) to -Ω(f(n)), i.e. the composition of Ω(f(n)) with path inversion.
|
||
Using this equivalence we get a boundary_map : Ω(Y) → pfiber f.
|
||
|
||
PART 2:
|
||
Now we can define a new fiber sequence X'(n) : Type*, and here we slightly diverge from the book.
|
||
We define it as
|
||
X'(0) := Y,
|
||
X'(1) := X,
|
||
X'(2) := fiber f
|
||
X'(n+3) := Ω(X'(n))
|
||
with maps f'(n) : X'(n+1) →* X'(n)
|
||
f'(0) := f
|
||
f'(1) := point f
|
||
f'(2) := boundary_map
|
||
f'(n+3) := Ω(f'(n))
|
||
|
||
This sequence is not equivalent to the previous sequence. The difference is in the signs.
|
||
The sequence f has negative signs (i.e. is composed with the inverse maps) for n ≡ 3, 4, 5 mod 6.
|
||
This sign information is captured by e : X'(n) ≃* X'(n) such that
|
||
e(k) := 1 for k = 0,1,2,3
|
||
e(k+3) := Ω(e(k)) ∘ (-)⁻¹ for k > 0
|
||
|
||
Now the sequence (X', f' ∘ e) is equivalent to (X, f), Hence (X', f' ∘ e) is an exact sequence.
|
||
We then prove that (X', f') is an exact sequence by using that there are other equivalences
|
||
eₗ and eᵣ such that
|
||
f' = eᵣ ∘ f' ∘ e
|
||
f' ∘ eₗ = e ∘ f'.
|
||
(this fact is type_chain_complex_cancel_aut and is_exact_at_t_cancel_aut in the file chain_complex)
|
||
eₗ and eᵣ are almost the same as e, except that the places where the inverse is taken is
|
||
slightly shifted:
|
||
eᵣ = (-)⁻¹ for n ≡ 3, 4, 5 mod 6 and eᵣ = 1 otherwise
|
||
e = (-)⁻¹ for n ≡ 4, 5, 6 mod 6 (except for n = 0) and e = 1 otherwise
|
||
eₗ = (-)⁻¹ for n ≡ 5, 6, 7 mod 6 (except for n = 0, 1) and eₗ = 1 otherwise
|
||
|
||
PART 3:
|
||
We change the type over which the sequence of types and maps are indexed from ℕ to ℕ × 3
|
||
(where 3 is the finite type with 3 elements). The reason is that we have that X'(3n) = Ωⁿ(Y), but
|
||
this equality is not definitionally true. Hence we cannot even state whether f'(3n) = Ωⁿ(f) without
|
||
using transports. This gets ugly. However, if we use as index type ℕ × 3, we can do this. We can
|
||
define
|
||
Y : ℕ × 3 → Type* as
|
||
Y(n, 0) := Ωⁿ(Y)
|
||
Y(n, 1) := Ωⁿ(X)
|
||
Y(n, 2) := Ωⁿ(fiber f)
|
||
with maps g(n) : Y(S n) →* Y(n) (where the successor is defined in the obvious way)
|
||
g(n, 0) := Ωⁿ(f)
|
||
g(n, 1) := Ωⁿ(point f)
|
||
g(n, 2) := Ωⁿ(boundary_map) ∘ cast
|
||
|
||
Here "cast" is the transport over the equality Ωⁿ⁺¹(Y) = Ωⁿ(Ω(Y)). We show that the sequence
|
||
(ℕ, X', f') is equivalent to (ℕ × 3, Y, g).
|
||
|
||
PART 4:
|
||
We get the long exact sequence of homotopy groups by taking the set-truncation of (Y, g).
|
||
-/
|
||
|
||
import .chain_complex algebra.homotopy_group
|
||
|
||
open eq pointed sigma fiber equiv is_equiv sigma.ops is_trunc nat trunc algebra function sum
|
||
|
||
section MOVE
|
||
-- TODO: MOVE
|
||
open group chain_complex
|
||
definition pinverse_pinverse (A : Type*) : pinverse ∘* pinverse ~* pid (Ω A) :=
|
||
begin
|
||
fapply phomotopy.mk,
|
||
{ apply inv_inv},
|
||
{ reflexivity}
|
||
end
|
||
|
||
definition to_pmap_pequiv_of_pmap {A B : Type*} (f : A →* B) (H : is_equiv f)
|
||
: pequiv.to_pmap (pequiv_of_pmap f H) = f :=
|
||
by cases f; reflexivity
|
||
|
||
definition to_pmap_pequiv_trans {A B C : Type*} (f : A ≃* B) (g : B ≃* C)
|
||
: pequiv.to_pmap (f ⬝e* g) = g ∘* f :=
|
||
!to_pmap_pequiv_of_pmap
|
||
|
||
definition pequiv_pinverse (A : Type*) : Ω A ≃* Ω A :=
|
||
pequiv_of_pmap pinverse !is_equiv_eq_inverse
|
||
|
||
definition tr_mul_tr {A : Type*} (n : ℕ) (p q : Ω[n + 1] A) :
|
||
tr p *[πg[n+1] A] tr q = tr (p ⬝ q) :=
|
||
by reflexivity
|
||
|
||
definition is_homomorphism_cast_loop_space_succ_eq_in {A : Type*} (n : ℕ) :
|
||
is_homomorphism
|
||
(cast (ap (trunc 0 ∘ pointed.carrier) (loop_space_succ_eq_in A (succ n)))
|
||
: πg[n+1+1] A → πg[n+1] Ω A) :=
|
||
begin
|
||
intro g h, induction g with g, induction h with h,
|
||
xrewrite [tr_mul_tr, - + fn_cast_eq_cast_fn _ (λn, tr), tr_mul_tr, ↑cast, -tr_compose,
|
||
loop_space_succ_eq_in_concat, - + tr_compose],
|
||
end
|
||
|
||
definition is_homomorphism_inverse (A : Type*) (n : ℕ)
|
||
: is_homomorphism (λp, p⁻¹ : πag[n+2] A → πag[n+2] A) :=
|
||
begin
|
||
intro g h, rewrite mul.comm,
|
||
induction g with g, induction h with h,
|
||
exact ap tr !con_inv
|
||
end
|
||
|
||
end MOVE
|
||
|
||
/--------------
|
||
PART 1
|
||
--------------/
|
||
|
||
namespace chain_complex
|
||
|
||
definition fiber_sequence_helper [constructor] (v : Σ(X Y : Type*), X →* Y)
|
||
: Σ(Z X : Type*), Z →* X :=
|
||
⟨pfiber v.2.2, v.1, ppoint v.2.2⟩
|
||
|
||
definition fiber_sequence_helpern (v : Σ(X Y : Type*), X →* Y) (n : ℕ)
|
||
: Σ(Z X : Type*), Z →* X :=
|
||
iterate fiber_sequence_helper n v
|
||
|
||
section
|
||
universe variable u
|
||
parameters {X Y : pType.{u}} (f : X →* Y)
|
||
include f
|
||
|
||
definition fiber_sequence_carrier (n : ℕ) : Type* :=
|
||
(fiber_sequence_helpern ⟨X, Y, f⟩ n).2.1
|
||
|
||
definition fiber_sequence_fun (n : ℕ)
|
||
: fiber_sequence_carrier (n + 1) →* fiber_sequence_carrier n :=
|
||
(fiber_sequence_helpern ⟨X, Y, f⟩ n).2.2
|
||
|
||
/- Definition 8.4.3 -/
|
||
definition fiber_sequence : type_chain_complex.{0 u} +ℕ :=
|
||
begin
|
||
fconstructor,
|
||
{ exact fiber_sequence_carrier},
|
||
{ exact fiber_sequence_fun},
|
||
{ intro n x, cases n with n,
|
||
{ exact point_eq x},
|
||
{ exact point_eq x}}
|
||
end
|
||
|
||
definition is_exact_fiber_sequence : is_exact_t fiber_sequence :=
|
||
λn x p, fiber.mk (fiber.mk x p) rfl
|
||
|
||
/- (generalization of) Lemma 8.4.4(i)(ii) -/
|
||
definition fiber_sequence_carrier_equiv (n : ℕ)
|
||
: fiber_sequence_carrier (n+3) ≃ Ω(fiber_sequence_carrier n) :=
|
||
calc
|
||
fiber_sequence_carrier (n+3) ≃ fiber (fiber_sequence_fun (n+1)) pt : erfl
|
||
... ≃ Σ(x : fiber_sequence_carrier _), fiber_sequence_fun (n+1) x = pt
|
||
: fiber.sigma_char
|
||
... ≃ Σ(x : fiber (fiber_sequence_fun n) pt), fiber_sequence_fun _ x = pt
|
||
: erfl
|
||
... ≃ Σ(v : Σ(x : fiber_sequence_carrier _), fiber_sequence_fun _ x = pt),
|
||
fiber_sequence_fun _ (fiber.mk v.1 v.2) = pt
|
||
: by exact sigma_equiv_sigma !fiber.sigma_char (λa, erfl)
|
||
... ≃ Σ(v : Σ(x : fiber_sequence_carrier _), fiber_sequence_fun _ x = pt),
|
||
v.1 = pt
|
||
: erfl
|
||
... ≃ Σ(v : Σ(x : fiber_sequence_carrier _), x = pt),
|
||
fiber_sequence_fun _ v.1 = pt
|
||
: sigma_assoc_comm_equiv
|
||
... ≃ fiber_sequence_fun _ !center.1 = pt
|
||
: @(sigma_equiv_of_is_contr_left _) !is_contr_sigma_eq'
|
||
... ≃ fiber_sequence_fun _ pt = pt
|
||
: erfl
|
||
... ≃ pt = pt
|
||
: by exact !equiv_eq_closed_left !respect_pt
|
||
... ≃ Ω(fiber_sequence_carrier n) : erfl
|
||
|
||
/- computation rule -/
|
||
definition fiber_sequence_carrier_equiv_eq (n : ℕ)
|
||
(x : fiber_sequence_carrier (n+1)) (p : fiber_sequence_fun n x = pt)
|
||
(q : fiber_sequence_fun (n+1) (fiber.mk x p) = pt)
|
||
: fiber_sequence_carrier_equiv n (fiber.mk (fiber.mk x p) q)
|
||
= !respect_pt⁻¹ ⬝ ap (fiber_sequence_fun n) q⁻¹ ⬝ p :=
|
||
begin
|
||
refine _ ⬝ !con.assoc⁻¹,
|
||
apply whisker_left,
|
||
refine transport_eq_Fl _ _ ⬝ _,
|
||
apply whisker_right,
|
||
refine inverse2 !ap_inv ⬝ !inv_inv ⬝ _,
|
||
refine ap_compose (fiber_sequence_fun n) pr₁ _ ⬝
|
||
ap02 (fiber_sequence_fun n) !ap_pr1_center_eq_sigma_eq',
|
||
end
|
||
|
||
definition fiber_sequence_carrier_equiv_inv_eq (n : ℕ)
|
||
(p : Ω(fiber_sequence_carrier n)) : (fiber_sequence_carrier_equiv n)⁻¹ᵉ p =
|
||
fiber.mk (fiber.mk pt (respect_pt (fiber_sequence_fun n) ⬝ p)) idp :=
|
||
begin
|
||
apply inv_eq_of_eq,
|
||
refine _ ⬝ !fiber_sequence_carrier_equiv_eq⁻¹, esimp,
|
||
exact !inv_con_cancel_left⁻¹
|
||
end
|
||
|
||
definition fiber_sequence_carrier_pequiv (n : ℕ)
|
||
: fiber_sequence_carrier (n+3) ≃* Ω(fiber_sequence_carrier n) :=
|
||
pequiv_of_equiv (fiber_sequence_carrier_equiv n)
|
||
begin
|
||
esimp,
|
||
apply con.left_inv
|
||
end
|
||
|
||
definition fiber_sequence_carrier_pequiv_eq (n : ℕ)
|
||
(x : fiber_sequence_carrier (n+1)) (p : fiber_sequence_fun n x = pt)
|
||
(q : fiber_sequence_fun (n+1) (fiber.mk x p) = pt)
|
||
: fiber_sequence_carrier_pequiv n (fiber.mk (fiber.mk x p) q)
|
||
= !respect_pt⁻¹ ⬝ ap (fiber_sequence_fun n) q⁻¹ ⬝ p :=
|
||
fiber_sequence_carrier_equiv_eq n x p q
|
||
|
||
definition fiber_sequence_carrier_pequiv_inv_eq (n : ℕ)
|
||
(p : Ω(fiber_sequence_carrier n)) : (fiber_sequence_carrier_pequiv n)⁻¹ᵉ* p =
|
||
fiber.mk (fiber.mk pt (respect_pt (fiber_sequence_fun n) ⬝ p)) idp :=
|
||
by rexact fiber_sequence_carrier_equiv_inv_eq n p
|
||
|
||
/- Lemma 8.4.4(iii) -/
|
||
definition fiber_sequence_fun_eq_helper (n : ℕ)
|
||
(p : Ω(fiber_sequence_carrier (n + 1))) :
|
||
fiber_sequence_carrier_pequiv n
|
||
(fiber_sequence_fun (n + 3)
|
||
((fiber_sequence_carrier_pequiv (n + 1))⁻¹ᵉ* p)) =
|
||
ap1 (fiber_sequence_fun n) p⁻¹ :=
|
||
begin
|
||
refine ap (λx, fiber_sequence_carrier_pequiv n (fiber_sequence_fun (n + 3) x))
|
||
(fiber_sequence_carrier_pequiv_inv_eq (n+1) p) ⬝ _,
|
||
/- the following three lines are rewriting some reflexivities: -/
|
||
-- replace (n + 3) with (n + 2 + 1),
|
||
-- refine ap (fiber_sequence_carrier_pequiv n)
|
||
-- (fiber_sequence_fun_eq1 (n+2) _ idp) ⬝ _,
|
||
refine fiber_sequence_carrier_pequiv_eq n pt (respect_pt (fiber_sequence_fun n)) _ ⬝ _,
|
||
esimp,
|
||
apply whisker_right,
|
||
apply whisker_left,
|
||
apply ap02, apply inverse2, apply idp_con,
|
||
end
|
||
|
||
theorem fiber_sequence_carrier_pequiv_eq_point_eq_idp (n : ℕ) :
|
||
fiber_sequence_carrier_pequiv_eq n
|
||
(Point (fiber_sequence_carrier (n+1)))
|
||
(respect_pt (fiber_sequence_fun n))
|
||
(respect_pt (fiber_sequence_fun (n + 1))) = idp :=
|
||
begin
|
||
apply con_inv_eq_idp,
|
||
refine ap (λx, whisker_left _ (_ ⬝ x)) _ ⬝ _,
|
||
{ reflexivity},
|
||
{ reflexivity},
|
||
refine ap (whisker_left _)
|
||
(transport_eq_Fl_idp_left (fiber_sequence_fun n)
|
||
(respect_pt (fiber_sequence_fun n))) ⬝ _,
|
||
apply whisker_left_idp_con_eq_assoc
|
||
end
|
||
|
||
theorem fiber_sequence_fun_phomotopy_helper (n : ℕ) :
|
||
(fiber_sequence_carrier_pequiv n ∘*
|
||
fiber_sequence_fun (n + 3)) ∘*
|
||
(fiber_sequence_carrier_pequiv (n + 1))⁻¹ᵉ* ~*
|
||
ap1 (fiber_sequence_fun n) ∘* pinverse :=
|
||
begin
|
||
fapply phomotopy.mk,
|
||
{ exact chain_complex.fiber_sequence_fun_eq_helper f n},
|
||
{ esimp, rewrite [idp_con], refine _ ⬝ whisker_left _ !idp_con⁻¹,
|
||
apply whisker_right,
|
||
apply whisker_left,
|
||
exact chain_complex.fiber_sequence_carrier_pequiv_eq_point_eq_idp f n}
|
||
end
|
||
|
||
theorem fiber_sequence_fun_eq (n : ℕ) : Π(x : fiber_sequence_carrier (n + 4)),
|
||
fiber_sequence_carrier_pequiv n (fiber_sequence_fun (n + 3) x) =
|
||
ap1 (fiber_sequence_fun n) (fiber_sequence_carrier_pequiv (n + 1) x)⁻¹ :=
|
||
begin
|
||
apply homotopy_of_inv_homotopy_pre (fiber_sequence_carrier_pequiv (n + 1)),
|
||
apply fiber_sequence_fun_eq_helper n
|
||
end
|
||
|
||
theorem fiber_sequence_fun_phomotopy (n : ℕ) :
|
||
fiber_sequence_carrier_pequiv n ∘*
|
||
fiber_sequence_fun (n + 3) ~*
|
||
(ap1 (fiber_sequence_fun n) ∘* pinverse) ∘* fiber_sequence_carrier_pequiv (n + 1) :=
|
||
begin
|
||
apply phomotopy_of_pinv_right_phomotopy,
|
||
apply fiber_sequence_fun_phomotopy_helper
|
||
end
|
||
|
||
definition boundary_map : Ω Y →* pfiber f :=
|
||
fiber_sequence_fun 2 ∘* (fiber_sequence_carrier_pequiv 0)⁻¹ᵉ*
|
||
|
||
/--------------
|
||
PART 2
|
||
--------------/
|
||
|
||
/- Now we are ready to define the long exact sequence of homotopy groups.
|
||
First we define its carrier -/
|
||
definition loop_spaces : ℕ → Type*
|
||
| 0 := Y
|
||
| 1 := X
|
||
| 2 := pfiber f
|
||
| (k+3) := Ω (loop_spaces k)
|
||
|
||
/- The maps between the homotopy groups -/
|
||
definition loop_spaces_fun
|
||
: Π(n : ℕ), loop_spaces (n+1) →* loop_spaces n
|
||
| 0 := proof f qed
|
||
| 1 := proof ppoint f qed
|
||
| 2 := proof boundary_map qed
|
||
| (k+3) := proof ap1 (loop_spaces_fun k) qed
|
||
|
||
definition loop_spaces_fun_add3 [unfold_full] (n : ℕ) :
|
||
loop_spaces_fun (n + 3) = ap1 (loop_spaces_fun n) :=
|
||
proof idp qed
|
||
|
||
definition fiber_sequence_pequiv_loop_spaces :
|
||
Πn, fiber_sequence_carrier n ≃* loop_spaces n
|
||
| 0 := by reflexivity
|
||
| 1 := by reflexivity
|
||
| 2 := by reflexivity
|
||
| (k+3) :=
|
||
begin
|
||
refine fiber_sequence_carrier_pequiv k ⬝e* _,
|
||
apply loop_pequiv_loop,
|
||
exact fiber_sequence_pequiv_loop_spaces k
|
||
end
|
||
|
||
definition fiber_sequence_pequiv_loop_spaces_add3 (n : ℕ)
|
||
: fiber_sequence_pequiv_loop_spaces (n + 3) =
|
||
ap1 (fiber_sequence_pequiv_loop_spaces n) ∘* fiber_sequence_carrier_pequiv n :=
|
||
by reflexivity
|
||
|
||
definition fiber_sequence_pequiv_loop_spaces_3_phomotopy
|
||
: fiber_sequence_pequiv_loop_spaces 3 ~* proof fiber_sequence_carrier_pequiv nat.zero qed :=
|
||
begin
|
||
refine pwhisker_right _ ap1_id ⬝* _,
|
||
apply pid_comp
|
||
end
|
||
|
||
definition pid_or_pinverse : Π(n : ℕ), loop_spaces n ≃* loop_spaces n
|
||
| 0 := pequiv.rfl
|
||
| 1 := pequiv.rfl
|
||
| 2 := pequiv.rfl
|
||
| 3 := pequiv.rfl
|
||
| (k+4) := !pequiv_pinverse ⬝e* loop_pequiv_loop (pid_or_pinverse (k+1))
|
||
|
||
definition pid_or_pinverse_add4 (n : ℕ)
|
||
: pid_or_pinverse (n + 4) = !pequiv_pinverse ⬝e* loop_pequiv_loop (pid_or_pinverse (n + 1)) :=
|
||
by reflexivity
|
||
|
||
definition pid_or_pinverse_add4_rev : Π(n : ℕ),
|
||
pid_or_pinverse (n + 4) ~* pinverse ∘* Ω→(pid_or_pinverse (n + 1))
|
||
| 0 := begin rewrite [pid_or_pinverse_add4, + to_pmap_pequiv_trans],
|
||
replace pid_or_pinverse (0 + 1) with pequiv.refl X,
|
||
rewrite [loop_pequiv_loop_rfl, ▸*], refine !pid_comp ⬝* _,
|
||
exact !comp_pid⁻¹* ⬝* pwhisker_left _ !ap1_id⁻¹* end
|
||
| 1 := begin rewrite [pid_or_pinverse_add4, + to_pmap_pequiv_trans],
|
||
replace pid_or_pinverse (1 + 1) with pequiv.refl (pfiber f),
|
||
rewrite [loop_pequiv_loop_rfl, ▸*], refine !pid_comp ⬝* _,
|
||
exact !comp_pid⁻¹* ⬝* pwhisker_left _ !ap1_id⁻¹* end
|
||
| 2 := begin rewrite [pid_or_pinverse_add4, + to_pmap_pequiv_trans],
|
||
replace pid_or_pinverse (2 + 1) with pequiv.refl (Ω Y),
|
||
rewrite [loop_pequiv_loop_rfl, ▸*], refine !pid_comp ⬝* _,
|
||
exact !comp_pid⁻¹* ⬝* pwhisker_left _ !ap1_id⁻¹* end
|
||
| (k+3) :=
|
||
begin
|
||
replace (k + 3 + 1) with (k + 4),
|
||
rewrite [+ pid_or_pinverse_add4, + to_pmap_pequiv_trans],
|
||
refine _ ⬝* pwhisker_left _ !ap1_compose⁻¹*,
|
||
refine _ ⬝* !passoc,
|
||
apply pconcat2,
|
||
{ refine ap1_phomotopy (pid_or_pinverse_add4_rev k) ⬝* _,
|
||
refine !ap1_compose ⬝* _, apply pwhisker_right, apply ap1_pinverse},
|
||
{ refine !ap1_pinverse⁻¹*}
|
||
end
|
||
|
||
theorem fiber_sequence_phomotopy_loop_spaces : Π(n : ℕ),
|
||
fiber_sequence_pequiv_loop_spaces n ∘* fiber_sequence_fun n ~*
|
||
(loop_spaces_fun n ∘* pid_or_pinverse (n + 1)) ∘* fiber_sequence_pequiv_loop_spaces (n + 1)
|
||
| 0 := proof proof phomotopy.rfl qed ⬝* pwhisker_right _ !comp_pid⁻¹* qed
|
||
| 1 := by reflexivity
|
||
| 2 :=
|
||
begin
|
||
refine !pid_comp ⬝* _,
|
||
replace loop_spaces_fun 2 with boundary_map,
|
||
refine _ ⬝* pwhisker_left _ fiber_sequence_pequiv_loop_spaces_3_phomotopy⁻¹*,
|
||
apply phomotopy_of_pinv_right_phomotopy,
|
||
exact !pid_comp⁻¹*
|
||
end
|
||
| (k+3) :=
|
||
begin
|
||
replace (k + 3 + 1) with (k + 1 + 3),
|
||
rewrite [fiber_sequence_pequiv_loop_spaces_add3 k,
|
||
fiber_sequence_pequiv_loop_spaces_add3 (k+1)],
|
||
refine !passoc ⬝* _,
|
||
refine pwhisker_left _ (fiber_sequence_fun_phomotopy k) ⬝* _,
|
||
refine !passoc⁻¹* ⬝* _ ⬝* !passoc,
|
||
apply pwhisker_right,
|
||
replace (k + 1 + 3) with (k + 4),
|
||
xrewrite [loop_spaces_fun_add3, pid_or_pinverse_add4, to_pmap_pequiv_trans],
|
||
refine _ ⬝* !passoc⁻¹*,
|
||
refine _ ⬝* pwhisker_left _ !passoc⁻¹*,
|
||
refine _ ⬝* pwhisker_left _ (pwhisker_left _ !ap1_compose_pinverse),
|
||
refine !passoc⁻¹* ⬝* _ ⬝* !passoc ⬝* !passoc,
|
||
apply pwhisker_right,
|
||
refine !ap1_compose⁻¹* ⬝* _ ⬝* !ap1_compose ⬝* pwhisker_right _ !ap1_compose,
|
||
apply ap1_phomotopy,
|
||
exact fiber_sequence_phomotopy_loop_spaces k
|
||
end
|
||
|
||
definition pid_or_pinverse_right : Π(n : ℕ), loop_spaces n →* loop_spaces n
|
||
| 0 := !pid
|
||
| 1 := !pid
|
||
| 2 := !pid
|
||
| (k+3) := Ω→(pid_or_pinverse_right k) ∘* pinverse
|
||
|
||
definition pid_or_pinverse_left : Π(n : ℕ), loop_spaces n →* loop_spaces n
|
||
| 0 := pequiv.rfl
|
||
| 1 := pequiv.rfl
|
||
| 2 := pequiv.rfl
|
||
| 3 := pequiv.rfl
|
||
| 4 := pequiv.rfl
|
||
| (k+5) := Ω→(pid_or_pinverse_left (k+2)) ∘* pinverse
|
||
|
||
definition pid_or_pinverse_right_add3 (n : ℕ)
|
||
: pid_or_pinverse_right (n + 3) = Ω→(pid_or_pinverse_right n) ∘* pinverse :=
|
||
by reflexivity
|
||
|
||
definition pid_or_pinverse_left_add5 (n : ℕ)
|
||
: pid_or_pinverse_left (n + 5) = Ω→(pid_or_pinverse_left (n+2)) ∘* pinverse :=
|
||
by reflexivity
|
||
|
||
theorem pid_or_pinverse_commute_right : Π(n : ℕ),
|
||
loop_spaces_fun n ~* pid_or_pinverse_right n ∘* loop_spaces_fun n ∘* pid_or_pinverse (n + 1)
|
||
| 0 := proof !comp_pid⁻¹* ⬝* !pid_comp⁻¹* qed
|
||
| 1 := proof !comp_pid⁻¹* ⬝* !pid_comp⁻¹* qed
|
||
| 2 := proof !comp_pid⁻¹* ⬝* !pid_comp⁻¹* qed
|
||
| (k+3) :=
|
||
begin
|
||
replace (k + 3 + 1) with (k + 4),
|
||
rewrite [pid_or_pinverse_right_add3, loop_spaces_fun_add3],
|
||
refine _ ⬝* pwhisker_left _ (pwhisker_left _ !pid_or_pinverse_add4_rev⁻¹*),
|
||
refine ap1_phomotopy (pid_or_pinverse_commute_right k) ⬝* _,
|
||
refine !ap1_compose ⬝* _ ⬝* !passoc⁻¹*,
|
||
apply pwhisker_left,
|
||
refine !ap1_compose ⬝* _ ⬝* !passoc ⬝* !passoc,
|
||
apply pwhisker_right,
|
||
refine _ ⬝* pwhisker_right _ !ap1_compose_pinverse,
|
||
refine _ ⬝* !passoc⁻¹*,
|
||
refine !comp_pid⁻¹* ⬝* pwhisker_left _ _,
|
||
symmetry, apply pinverse_pinverse
|
||
end
|
||
|
||
theorem pid_or_pinverse_commute_left : Π(n : ℕ),
|
||
loop_spaces_fun n ∘* pid_or_pinverse_left (n + 1) ~* pid_or_pinverse n ∘* loop_spaces_fun n
|
||
| 0 := proof !comp_pid ⬝* !pid_comp⁻¹* qed
|
||
| 1 := proof !comp_pid ⬝* !pid_comp⁻¹* qed
|
||
| 2 := proof !comp_pid ⬝* !pid_comp⁻¹* qed
|
||
| 3 := proof !comp_pid ⬝* !pid_comp⁻¹* qed
|
||
| (k+4) :=
|
||
begin
|
||
replace (k + 4 + 1) with (k + 5),
|
||
rewrite [pid_or_pinverse_left_add5, pid_or_pinverse_add4, to_pmap_pequiv_trans],
|
||
replace (k + 4) with (k + 1 + 3),
|
||
rewrite [loop_spaces_fun_add3],
|
||
refine !passoc⁻¹* ⬝* _ ⬝* !passoc⁻¹*,
|
||
refine _ ⬝* pwhisker_left _ !ap1_compose_pinverse,
|
||
refine _ ⬝* !passoc,
|
||
apply pwhisker_right,
|
||
refine !ap1_compose⁻¹* ⬝* _ ⬝* !ap1_compose,
|
||
exact ap1_phomotopy (pid_or_pinverse_commute_left (k+1))
|
||
end
|
||
|
||
definition LES_of_loop_spaces' [constructor] : type_chain_complex +ℕ :=
|
||
transfer_type_chain_complex
|
||
fiber_sequence
|
||
(λn, loop_spaces_fun n ∘* pid_or_pinverse (n + 1))
|
||
fiber_sequence_pequiv_loop_spaces
|
||
fiber_sequence_phomotopy_loop_spaces
|
||
|
||
definition LES_of_loop_spaces [constructor] : type_chain_complex +ℕ :=
|
||
type_chain_complex_cancel_aut
|
||
LES_of_loop_spaces'
|
||
loop_spaces_fun
|
||
pid_or_pinverse
|
||
pid_or_pinverse_right
|
||
(λn x, idp)
|
||
pid_or_pinverse_commute_right
|
||
|
||
definition is_exact_LES_of_loop_spaces : is_exact_t LES_of_loop_spaces :=
|
||
begin
|
||
intro n,
|
||
refine is_exact_at_t_cancel_aut n pid_or_pinverse_left _ _ pid_or_pinverse_commute_left _,
|
||
apply is_exact_at_t_transfer,
|
||
apply is_exact_fiber_sequence
|
||
end
|
||
|
||
open prod succ_str fin
|
||
|
||
/--------------
|
||
PART 3
|
||
--------------/
|
||
|
||
definition loop_spaces2 [reducible] : +3ℕ → Type*
|
||
| (n, fin.mk 0 H) := Ω[n] Y
|
||
| (n, fin.mk 1 H) := Ω[n] X
|
||
| (n, fin.mk k H) := Ω[n] (pfiber f)
|
||
|
||
definition loop_spaces2_add1 (n : ℕ) : Π(x : fin (nat.succ 2)),
|
||
loop_spaces2 (n+1, x) = Ω (loop_spaces2 (n, x))
|
||
| (fin.mk 0 H) := by reflexivity
|
||
| (fin.mk 1 H) := by reflexivity
|
||
| (fin.mk 2 H) := by reflexivity
|
||
| (fin.mk (k+3) H) := begin exfalso, apply lt_le_antisymm H, apply le_add_left end
|
||
|
||
definition loop_spaces_fun2 : Π(n : +3ℕ), loop_spaces2 (S n) →* loop_spaces2 n
|
||
| (n, fin.mk 0 H) := proof Ω→[n] f qed
|
||
| (n, fin.mk 1 H) := proof Ω→[n] (ppoint f) qed
|
||
| (n, fin.mk 2 H) := proof Ω→[n] boundary_map ∘* pcast (loop_space_succ_eq_in Y n) qed
|
||
| (n, fin.mk (k+3) H) := begin exfalso, apply lt_le_antisymm H, apply le_add_left end
|
||
|
||
definition loop_spaces_fun2_add1_0 (n : ℕ) (H : 0 < succ 2)
|
||
: loop_spaces_fun2 (n+1, fin.mk 0 H) ~*
|
||
cast proof idp qed ap1 (loop_spaces_fun2 (n, fin.mk 0 H)) :=
|
||
by reflexivity
|
||
|
||
definition loop_spaces_fun2_add1_1 (n : ℕ) (H : 1 < succ 2)
|
||
: loop_spaces_fun2 (n+1, fin.mk 1 H) ~*
|
||
cast proof idp qed ap1 (loop_spaces_fun2 (n, fin.mk 1 H)) :=
|
||
by reflexivity
|
||
|
||
definition loop_spaces_fun2_add1_2 (n : ℕ) (H : 2 < succ 2)
|
||
: loop_spaces_fun2 (n+1, fin.mk 2 H) ~*
|
||
cast proof idp qed ap1 (loop_spaces_fun2 (n, fin.mk 2 H)) :=
|
||
begin
|
||
esimp,
|
||
refine _ ⬝* !ap1_compose⁻¹*,
|
||
apply pwhisker_left,
|
||
apply pcast_ap_loop_space
|
||
end
|
||
|
||
definition nat_of_str [unfold 2] [reducible] {n : ℕ} : ℕ × fin (succ n) → ℕ :=
|
||
λx, succ n * pr1 x + val (pr2 x)
|
||
|
||
definition str_of_nat {n : ℕ} : ℕ → ℕ × fin (succ n) :=
|
||
λm, (m / (succ n), mk_mod n m)
|
||
|
||
definition nat_of_str_3S [unfold 2] [reducible]
|
||
: Π(x : stratified +ℕ 2), nat_of_str x + 1 = nat_of_str (@S (stratified +ℕ 2) x)
|
||
| (n, fin.mk 0 H) := by reflexivity
|
||
| (n, fin.mk 1 H) := by reflexivity
|
||
| (n, fin.mk 2 H) := by reflexivity
|
||
| (n, fin.mk (k+3) H) := begin exfalso, apply lt_le_antisymm H, apply le_add_left end
|
||
|
||
definition fin_prod_nat_equiv_nat [constructor] (n : ℕ) : ℕ × fin (succ n) ≃ ℕ :=
|
||
equiv.MK nat_of_str str_of_nat
|
||
abstract begin
|
||
intro m, unfold [nat_of_str, str_of_nat, mk_mod],
|
||
refine _ ⬝ (eq_div_mul_add_mod m (succ n))⁻¹,
|
||
rewrite [mul.comm]
|
||
end end
|
||
abstract begin
|
||
intro x, cases x with m k,
|
||
cases k with k H,
|
||
apply prod_eq: esimp [str_of_nat],
|
||
{ rewrite [add.comm, add_mul_div_self_left _ _ (!zero_lt_succ), ▸*,
|
||
div_eq_zero_of_lt H, zero_add]},
|
||
{ apply eq_of_veq, esimp [mk_mod],
|
||
rewrite [add.comm, add_mul_mod_self_left, ▸*, mod_eq_of_lt H]}
|
||
end end
|
||
|
||
/-
|
||
note: in the following theorem the (n+1) case is 3 times the same,
|
||
so maybe this can be simplified
|
||
-/
|
||
definition loop_spaces2_pequiv' : Π(n : ℕ) (x : fin (nat.succ 2)),
|
||
loop_spaces (nat_of_str (n, x)) ≃* loop_spaces2 (n, x)
|
||
| 0 (fin.mk 0 H) := by reflexivity
|
||
| 0 (fin.mk 1 H) := by reflexivity
|
||
| 0 (fin.mk 2 H) := by reflexivity
|
||
| (n+1) (fin.mk 0 H) :=
|
||
begin
|
||
apply loop_pequiv_loop,
|
||
rexact loop_spaces2_pequiv' n (fin.mk 0 H)
|
||
end
|
||
| (n+1) (fin.mk 1 H) :=
|
||
begin
|
||
apply loop_pequiv_loop,
|
||
rexact loop_spaces2_pequiv' n (fin.mk 1 H)
|
||
end
|
||
| (n+1) (fin.mk 2 H) :=
|
||
begin
|
||
apply loop_pequiv_loop,
|
||
rexact loop_spaces2_pequiv' n (fin.mk 2 H)
|
||
end
|
||
| n (fin.mk (k+3) H) := begin exfalso, apply lt_le_antisymm H, apply le_add_left end
|
||
|
||
definition loop_spaces2_pequiv : Π(x : +3ℕ),
|
||
loop_spaces (nat_of_str x) ≃* loop_spaces2 x
|
||
| (n, x) := loop_spaces2_pequiv' n x
|
||
|
||
local attribute loop_pequiv_loop [reducible]
|
||
/- all cases where n>0 are basically the same -/
|
||
definition loop_spaces_fun2_phomotopy (x : +3ℕ) :
|
||
loop_spaces2_pequiv x ∘* loop_spaces_fun (nat_of_str x) ~*
|
||
(loop_spaces_fun2 x ∘* loop_spaces2_pequiv (S x))
|
||
∘* pcast (ap (loop_spaces) (nat_of_str_3S x)) :=
|
||
begin
|
||
cases x with n x, cases x with k H,
|
||
cases k with k, rotate 1, cases k with k, rotate 1, cases k with k, rotate 2,
|
||
{ /-k=0-/
|
||
induction n with n IH,
|
||
{ refine !pid_comp ⬝* _ ⬝* !comp_pid⁻¹* ⬝* !comp_pid⁻¹*,
|
||
reflexivity},
|
||
{ refine _ ⬝* !comp_pid⁻¹*,
|
||
refine _ ⬝* pwhisker_right _ !loop_spaces_fun2_add1_0⁻¹*,
|
||
refine !ap1_compose⁻¹* ⬝* _ ⬝* !ap1_compose, apply ap1_phomotopy,
|
||
exact IH ⬝* !comp_pid}},
|
||
{ /-k=1-/
|
||
induction n with n IH,
|
||
{ refine !pid_comp ⬝* _ ⬝* !comp_pid⁻¹* ⬝* !comp_pid⁻¹*,
|
||
reflexivity},
|
||
{ refine _ ⬝* !comp_pid⁻¹*,
|
||
refine _ ⬝* pwhisker_right _ !loop_spaces_fun2_add1_1⁻¹*,
|
||
refine !ap1_compose⁻¹* ⬝* _ ⬝* !ap1_compose, apply ap1_phomotopy,
|
||
exact IH ⬝* !comp_pid}},
|
||
{ /-k=2-/
|
||
induction n with n IH,
|
||
{ refine !pid_comp ⬝* _ ⬝* !comp_pid⁻¹*,
|
||
refine !comp_pid⁻¹* ⬝* pconcat2 _ _,
|
||
{ exact (comp_pid (chain_complex.boundary_map f))⁻¹*},
|
||
{ refine cast (ap (λx, _ ~* x) !loop_pequiv_loop_rfl)⁻¹ _, reflexivity}},
|
||
{ refine _ ⬝* !comp_pid⁻¹*,
|
||
refine _ ⬝* pwhisker_right _ !loop_spaces_fun2_add1_2⁻¹*,
|
||
refine !ap1_compose⁻¹* ⬝* _ ⬝* !ap1_compose, apply ap1_phomotopy,
|
||
exact IH ⬝* !comp_pid}},
|
||
{ /-k=k'+3-/ exfalso, apply lt_le_antisymm H, apply le_add_left}
|
||
end
|
||
|
||
definition LES_of_loop_spaces2 [constructor] : type_chain_complex +3ℕ :=
|
||
transfer_type_chain_complex2
|
||
LES_of_loop_spaces
|
||
!fin_prod_nat_equiv_nat
|
||
nat_of_str_3S
|
||
@loop_spaces_fun2
|
||
@loop_spaces2_pequiv
|
||
begin
|
||
intro m x,
|
||
refine loop_spaces_fun2_phomotopy m x ⬝ _,
|
||
apply ap (loop_spaces_fun2 m), apply ap (loop_spaces2_pequiv (S m)),
|
||
esimp, exact ap010 cast !ap_compose⁻¹ x
|
||
end
|
||
|
||
definition is_exact_LES_of_loop_spaces2 : is_exact_t LES_of_loop_spaces2 :=
|
||
begin
|
||
intro n,
|
||
apply is_exact_at_transfer2,
|
||
apply is_exact_LES_of_loop_spaces
|
||
end
|
||
|
||
definition LES_of_homotopy_groups' [constructor] : chain_complex +3ℕ :=
|
||
trunc_chain_complex LES_of_loop_spaces2
|
||
|
||
/--------------
|
||
PART 4
|
||
--------------/
|
||
|
||
definition homotopy_groups [reducible] : +3ℕ → Set*
|
||
| (n, fin.mk 0 H) := π*[n] Y
|
||
| (n, fin.mk 1 H) := π*[n] X
|
||
| (n, fin.mk k H) := π*[n] (pfiber f)
|
||
|
||
definition homotopy_groups_pequiv_loop_spaces2 [reducible]
|
||
: Π(n : +3ℕ), ptrunc 0 (loop_spaces2 n) ≃* homotopy_groups n
|
||
| (n, fin.mk 0 H) := by reflexivity
|
||
| (n, fin.mk 1 H) := by reflexivity
|
||
| (n, fin.mk 2 H) := by reflexivity
|
||
| (n, fin.mk (k+3) H) := begin exfalso, apply lt_le_antisymm H, apply le_add_left end
|
||
|
||
definition homotopy_groups_fun : Π(n : +3ℕ), homotopy_groups (S n) →* homotopy_groups n
|
||
| (n, fin.mk 0 H) := proof π→*[n] f qed
|
||
| (n, fin.mk 1 H) := proof π→*[n] (ppoint f) qed
|
||
| (n, fin.mk 2 H) :=
|
||
proof π→*[n] boundary_map ∘* pcast (ap (ptrunc 0) (loop_space_succ_eq_in Y n)) qed
|
||
| (n, fin.mk (k+3) H) := begin exfalso, apply lt_le_antisymm H, apply le_add_left end
|
||
|
||
definition homotopy_groups_fun_phomotopy_loop_spaces_fun2 [reducible]
|
||
: Π(n : +3ℕ), homotopy_groups_pequiv_loop_spaces2 n ∘* ptrunc_functor 0 (loop_spaces_fun2 n) ~*
|
||
homotopy_groups_fun n ∘* homotopy_groups_pequiv_loop_spaces2 (S n)
|
||
| (n, fin.mk 0 H) := by reflexivity
|
||
| (n, fin.mk 1 H) := by reflexivity
|
||
| (n, fin.mk 2 H) :=
|
||
begin
|
||
refine !pid_comp ⬝* _ ⬝* !comp_pid⁻¹*,
|
||
refine !ptrunc_functor_pcompose ⬝* _,
|
||
apply pwhisker_left, apply ptrunc_functor_pcast,
|
||
end
|
||
| (n, fin.mk (k+3) H) := begin exfalso, apply lt_le_antisymm H, apply le_add_left end
|
||
|
||
definition LES_of_homotopy_groups [constructor] : chain_complex +3ℕ :=
|
||
transfer_chain_complex
|
||
LES_of_homotopy_groups'
|
||
homotopy_groups_fun
|
||
homotopy_groups_pequiv_loop_spaces2
|
||
homotopy_groups_fun_phomotopy_loop_spaces_fun2
|
||
|
||
definition is_exact_LES_of_homotopy_groups : is_exact LES_of_homotopy_groups :=
|
||
begin
|
||
intro n,
|
||
apply is_exact_at_transfer,
|
||
apply is_exact_at_trunc,
|
||
apply is_exact_LES_of_loop_spaces2
|
||
end
|
||
|
||
variable (n : ℕ)
|
||
|
||
/- the carrier of the fiber sequence is definitionally what we want (as pointed sets) -/
|
||
example : LES_of_homotopy_groups (str_of_nat 6) = π*[2] Y :> Set* := by reflexivity
|
||
example : LES_of_homotopy_groups (str_of_nat 7) = π*[2] X :> Set* := by reflexivity
|
||
example : LES_of_homotopy_groups (str_of_nat 8) = π*[2] (pfiber f) :> Set* := by reflexivity
|
||
example : LES_of_homotopy_groups (str_of_nat 9) = π*[3] Y :> Set* := by reflexivity
|
||
example : LES_of_homotopy_groups (str_of_nat 10) = π*[3] X :> Set* := by reflexivity
|
||
example : LES_of_homotopy_groups (str_of_nat 11) = π*[3] (pfiber f) :> Set* := by reflexivity
|
||
|
||
definition LES_of_homotopy_groups_0 : LES_of_homotopy_groups (n, 0) = π*[n] Y :=
|
||
by reflexivity
|
||
definition LES_of_homotopy_groups_1 : LES_of_homotopy_groups (n, 1) = π*[n] X :=
|
||
by reflexivity
|
||
definition LES_of_homotopy_groups_2 : LES_of_homotopy_groups (n, 2) = π*[n] (pfiber f) :=
|
||
by reflexivity
|
||
|
||
/- the functions of the fiber sequence is definitionally what we want (as pointed function).
|
||
-/
|
||
|
||
definition LES_of_homotopy_groups_fun_0 :
|
||
cc_to_fn LES_of_homotopy_groups (n, 0) = π→*[n] f :=
|
||
by reflexivity
|
||
definition LES_of_homotopy_groups_fun_1 :
|
||
cc_to_fn LES_of_homotopy_groups (n, 1) = π→*[n] (ppoint f) :=
|
||
by reflexivity
|
||
definition LES_of_homotopy_groups_fun_2 : cc_to_fn LES_of_homotopy_groups (n, 2) =
|
||
π→*[n] boundary_map ∘* pcast (ap (ptrunc 0) (loop_space_succ_eq_in Y n)) :=
|
||
by reflexivity
|
||
|
||
open group
|
||
|
||
definition group_LES_of_homotopy_groups_0
|
||
: Π(x : fin (succ 2)), group (LES_of_homotopy_groups (1, x))
|
||
| (fin.mk 0 H) := begin rexact group_homotopy_group 0 Y end
|
||
| (fin.mk 1 H) := begin rexact group_homotopy_group 0 X end
|
||
| (fin.mk 2 H) := begin rexact group_homotopy_group 0 (pfiber f) end
|
||
| (fin.mk (k+3) H) := begin exfalso, apply lt_le_antisymm H, apply le_add_left end
|
||
|
||
definition comm_group_LES_of_homotopy_groups (n : ℕ) : Π(x : fin (succ 2)),
|
||
comm_group (LES_of_homotopy_groups (n + 2, x))
|
||
| (fin.mk 0 H) := proof comm_group_homotopy_group n Y qed
|
||
| (fin.mk 1 H) := proof comm_group_homotopy_group n X qed
|
||
| (fin.mk 2 H) := proof comm_group_homotopy_group n (pfiber f) qed
|
||
| (fin.mk (k+3) H) := begin exfalso, apply lt_le_antisymm H, apply le_add_left end
|
||
|
||
definition CommGroup_LES_of_homotopy_groups (n : +3ℕ) : CommGroup.{u} :=
|
||
CommGroup.mk (LES_of_homotopy_groups (pr1 n + 2, pr2 n))
|
||
(comm_group_LES_of_homotopy_groups (pr1 n) (pr2 n))
|
||
|
||
definition homomorphism_LES_of_homotopy_groups_fun : Π(k : +3ℕ),
|
||
CommGroup_LES_of_homotopy_groups (S k) →g CommGroup_LES_of_homotopy_groups k
|
||
| (k, fin.mk 0 H) :=
|
||
proof homomorphism.mk (cc_to_fn LES_of_homotopy_groups (k + 2, 0))
|
||
(phomotopy_group_functor_mul _ _) qed
|
||
| (k, fin.mk 1 H) :=
|
||
proof homomorphism.mk (cc_to_fn LES_of_homotopy_groups (k + 2, 1))
|
||
(phomotopy_group_functor_mul _ _) qed
|
||
| (k, fin.mk 2 H) :=
|
||
begin
|
||
apply homomorphism.mk (cc_to_fn LES_of_homotopy_groups (k + 2, 2)),
|
||
exact abstract begin rewrite [LES_of_homotopy_groups_fun_2],
|
||
refine @is_homomorphism_compose _ _ _ _ _ _ (π→*[k + 2] boundary_map) _ _ _,
|
||
{ apply group_homotopy_group (k + 1)},
|
||
{ apply phomotopy_group_functor_mul},
|
||
{ rewrite [▸*, -ap_compose', ▸*],
|
||
apply is_homomorphism_cast_loop_space_succ_eq_in} end end
|
||
end
|
||
| (k, fin.mk (l+3) H) := begin exfalso, apply lt_le_antisymm H, apply le_add_left end
|
||
|
||
end
|
||
end chain_complex
|