Spectral/homotopy/chain_complex.hlean
Floris van Doorn 5c9355c4c1 feat(chain_complex): give the construction of the LES of homotopy groups
This commit defines "type_chain_complex" which is a typal variant of a chain complex, where the exactness condition is formulated without a propositional truncation in it. The fiber sequence of a pointed map is an instance of this structure.
It also defines "chain_complex" which is the usual notion of a chain complex: a sequence of pointed sets with pointed maps between them, such that the kernel and image of consecutive maps coincide.
The biggest part of this commit is the definition of the long exact sequence of homotopy groups of a pointed map. The definition uses the fiber sequence of a pointed map.
2016-02-22 20:53:48 -05:00

243 lines
10 KiB
Text
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

/-
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
-/
import types.int types.pointed2 types.trunc
open eq pointed int unit is_equiv equiv is_trunc trunc equiv.ops
namespace eq
definition transport_eq_Fl_idp_left {A B : Type} {a : A} {b : B} (f : A → B) (q : f a = b)
: transport_eq_Fl idp q = !idp_con⁻¹ :=
by induction q; reflexivity
definition whisker_left_idp_con_eq_assoc
{A : Type} {a₁ a₂ a₃ : A} (p : a₁ = a₂) (q : a₂ = a₃)
: whisker_left p (idp_con q)⁻¹ = con.assoc p idp q :=
by induction q; reflexivity
end eq open eq
namespace chain_complex
-- are chain complexes with the "set"-requirement removed interesting?
structure type_chain_complex : Type :=
(car : → Type*)
(fn : Π(n : ), car (n + 1) →* car n)
(is_chain_complex : Π{n : } (x : car ((n + 1) + 1)), fn n (fn (n+1) x) = pt)
structure left_type_chain_complex : Type := -- chain complex on the naturals with maps going down
(car : → Type*)
(fn : Π(n : ), car (n + 1) →* car n)
(is_chain_complex : Π{n : } (x : car ((n + 1) + 1)), fn n (fn (n+1) x) = pt)
structure right_type_chain_complex : Type := -- chain complex on the naturals with maps going up
(car : → Type*)
(fn : Π(n : ), car n →* car (n + 1))
(is_chain_complex : Π{n : } (x : car n), fn (n+1) (fn n x) = pt)
definition tcc_to_car [unfold 1] [coercion] := @type_chain_complex.car
definition tcc_to_fn [unfold 1] := @type_chain_complex.fn
definition tcc_is_chain_complex [unfold 1] := @type_chain_complex.is_chain_complex
definition ltcc_to_car [unfold 1] [coercion] := @left_type_chain_complex.car
definition ltcc_to_fn [unfold 1] := @left_type_chain_complex.fn
definition ltcc_is_chain_complex [unfold 1] := @left_type_chain_complex.is_chain_complex
definition rtcc_to_car [unfold 1] [coercion] := @right_type_chain_complex.car
definition rtcc_to_fn [unfold 1] := @right_type_chain_complex.fn
definition rtcc_is_chain_complex [unfold 1] := @right_type_chain_complex.is_chain_complex
-- important: these notions are shifted by one! (this is to avoid transports)
definition is_exact_at_t [reducible] (X : type_chain_complex) (n : ) : Type :=
Π(x : X (n + 1)), tcc_to_fn X n x = pt → fiber (tcc_to_fn X (n+1)) x
definition is_exact_at_lt [reducible] (X : left_type_chain_complex) (n : ) : Type :=
Π(x : X (n + 1)), ltcc_to_fn X n x = pt → fiber (ltcc_to_fn X (n+1)) x
definition is_exact_at_rt [reducible] (X : right_type_chain_complex) (n : ) : Type :=
Π(x : X (n + 1)), rtcc_to_fn X (n+1) x = pt → fiber (rtcc_to_fn X n) x
definition is_exact_t [reducible] (X : type_chain_complex) : Type :=
Π(n : ), is_exact_at_t X n
definition is_exact_lt [reducible] (X : left_type_chain_complex) : Type :=
Π(n : ), is_exact_at_lt X n
definition is_exact_rt [reducible] (X : right_type_chain_complex) : Type :=
Π(n : ), is_exact_at_rt X n
definition type_chain_complex_from_left (X : left_type_chain_complex) : type_chain_complex :=
type_chain_complex.mk (int.rec X (λn, punit))
begin
intro n, fconstructor,
{ induction n with n n,
{ exact @ltcc_to_fn X n},
{ esimp, intro x, exact star}},
{ induction n with n n,
{ apply respect_pt},
{ reflexivity}}
end
begin
intro n, induction n with n n,
{ exact ltcc_is_chain_complex X},
{ esimp, intro x, reflexivity}
end
definition is_exact_t_from_left {X : left_type_chain_complex} {n : } (H : is_exact_at_lt X n)
: is_exact_at_t (type_chain_complex_from_left X) n :=
H
definition transfer_left_type_chain_complex [constructor] (X : left_type_chain_complex)
{Y : → Type*} (g : Π{n : }, Y (n + 1) →* Y n) (e : Π{n}, X n ≃* Y n)
(p : Π{n} (x : X (n + 1)), e (ltcc_to_fn X n x) = g (e x)) : left_type_chain_complex :=
left_type_chain_complex.mk Y @g
begin
intro n, apply equiv_rect (equiv_of_pequiv e), intro x,
refine ap g (p x)⁻¹ ⬝ _,
refine (p _)⁻¹ ⬝ _,
refine ap e (ltcc_is_chain_complex X _) ⬝ _,
apply respect_pt
end
definition is_exact_at_lt_transfer {X : left_type_chain_complex} {Y : → Type*}
{g : Π{n : }, Y (n + 1) →* Y n} (e : Π{n}, X n ≃* Y n)
(p : Π{n} (x : X (n + 1)), e (ltcc_to_fn X n x) = g (e x)) {n : }
(H : is_exact_at_lt X n) : is_exact_at_lt (transfer_left_type_chain_complex X @g @e @p) n :=
begin
intro y q, esimp at *,
assert H2 : ltcc_to_fn X n (e⁻¹ᵉ* y) = pt,
{ refine (inv_commute (λn, equiv_of_pequiv e) _ _ @p _)⁻¹ᵖ ⬝ _,
refine ap _ q ⬝ _,
exact respect_pt e⁻¹ᵉ*},
cases (H _ H2) with x r,
refine fiber.mk (e x) _,
refine (p x)⁻¹ ⬝ _,
refine ap e r ⬝ _,
apply right_inv
end
definition trunc_left_type_chain_complex [constructor] (X : left_type_chain_complex)
(k : trunc_index) : left_type_chain_complex :=
left_type_chain_complex.mk
(λn, ptrunc k (X n))
(λn, ptrunc_functor k (ltcc_to_fn X n))
begin
intro n x, esimp at *,
refine trunc.rec _ x, -- why doesn't induction work here?
clear x, intro x, esimp,
exact ap tr (ltcc_is_chain_complex X x)
end
/- actual (set) chain complexes -/
structure chain_complex : Type :=
(car : → Set*)
(fn : Π(n : ), car (n + 1) →* car n)
(is_chain_complex : Π{n : } (x : car ((n + 1) + 1)), fn n (fn (n+1) x) = pt)
structure left_chain_complex : Type := -- chain complex on the naturals with maps going down
(car : → Set*)
(fn : Π(n : ), car (n + 1) →* car n)
(is_chain_complex : Π{n : } (x : car ((n + 1) + 1)), fn n (fn (n+1) x) = pt)
structure right_chain_complex : Type := -- chain complex on the naturals with maps going up
(car : → Set*)
(fn : Π(n : ), car n →* car (n + 1))
(is_chain_complex : Π{n : } (x : car n), fn (n+1) (fn n x) = pt)
definition cc_to_car [unfold 1] [coercion] := @chain_complex.car
definition cc_to_fn [unfold 1] := @chain_complex.fn
definition cc_is_chain_complex [unfold 1] := @chain_complex.is_chain_complex
definition lcc_to_car [unfold 1] [coercion] := @left_chain_complex.car
definition lcc_to_fn [unfold 1] := @left_chain_complex.fn
definition lcc_is_chain_complex [unfold 1] := @left_chain_complex.is_chain_complex
definition rcc_to_car [unfold 1] [coercion] := @right_chain_complex.car
definition rcc_to_fn [unfold 1] := @right_chain_complex.fn
definition rcc_is_chain_complex [unfold 1] := @right_chain_complex.is_chain_complex
-- important: these notions are shifted by one! (this is to avoid transports)
definition is_exact_at [reducible] (X : chain_complex) (n : ) : Type :=
Π(x : X (n + 1)), cc_to_fn X n x = pt → image (cc_to_fn X (n+1)) x
definition is_exact_at_l [reducible] (X : left_chain_complex) (n : ) : Type :=
Π(x : X (n + 1)), lcc_to_fn X n x = pt → image (lcc_to_fn X (n+1)) x
definition is_exact_at_r [reducible] (X : right_chain_complex) (n : ) : Type :=
Π(x : X (n + 1)), rcc_to_fn X (n+1) x = pt → image (rcc_to_fn X n) x
definition is_exact [reducible] (X : chain_complex) : Type := Π(n : ), is_exact_at X n
definition is_exact_l [reducible] (X : left_chain_complex) : Type := Π(n : ), is_exact_at_l X n
definition is_exact_r [reducible] (X : right_chain_complex) : Type := Π(n : ), is_exact_at_r X n
definition chain_complex_from_left (X : left_chain_complex) : chain_complex :=
chain_complex.mk (int.rec X (λn, punit))
begin
intro n, fconstructor,
{ induction n with n n,
{ exact @lcc_to_fn X n},
{ esimp, intro x, exact star}},
{ induction n with n n,
{ apply respect_pt},
{ reflexivity}}
end
begin
intro n, induction n with n n,
{ exact lcc_is_chain_complex X},
{ esimp, intro x, reflexivity}
end
definition is_exact_from_left {X : left_chain_complex} {n : } (H : is_exact_at_l X n)
: is_exact_at (chain_complex_from_left X) n :=
H
definition transfer_left_chain_complex [constructor] (X : left_chain_complex) {Y : → Set*}
(g : Π{n : }, Y (n + 1) →* Y n) (e : Π{n}, X n ≃* Y n)
(p : Π{n} (x : X (n + 1)), e (lcc_to_fn X n x) = g (e x)) : left_chain_complex :=
left_chain_complex.mk Y @g
begin
intro n, apply equiv_rect (equiv_of_pequiv e), intro x,
refine ap g (p x)⁻¹ ⬝ _,
refine (p _)⁻¹ ⬝ _,
refine ap e (lcc_is_chain_complex X _) ⬝ _,
apply respect_pt
end
definition transfer_is_exact_at_l (X : left_chain_complex) {Y : → Set*}
(g : Π{n : }, Y (n + 1) →* Y n) (e : Π{n}, X n ≃* Y n)
(p : Π{n} (x : X (n + 1)), e (lcc_to_fn X n x) = g (e x))
{n : } (H : is_exact_at_l X n) : is_exact_at_l (transfer_left_chain_complex X @g @e @p) n :=
begin
intro y q, esimp at *,
assert H2 : lcc_to_fn X n (e⁻¹ᵉ* y) = pt,
{ refine (inv_commute (λn, equiv_of_pequiv e) _ _ @p _)⁻¹ᵖ ⬝ _,
refine ap _ q ⬝ _,
exact respect_pt e⁻¹ᵉ*},
induction (H _ H2) with x,
induction x with x r,
refine image.mk (e x) _,
refine (p x)⁻¹ ⬝ _,
refine ap e r ⬝ _,
apply right_inv
end
definition trunc_left_chain_complex [constructor] (X : left_type_chain_complex)
: left_chain_complex :=
left_chain_complex.mk
(λn, ptrunc 0 (X n))
(λn, ptrunc_functor 0 (ltcc_to_fn X n))
begin
intro n x, esimp at *,
refine @trunc.rec _ _ _ (λH, !is_trunc_eq) _ x,
clear x, intro x, esimp,
exact ap tr (ltcc_is_chain_complex X x)
end
definition is_exact_at_l_trunc (X : left_type_chain_complex) {n : }
(H : is_exact_at_lt X n) : is_exact_at_l (trunc_left_chain_complex X) n :=
begin
intro x p, esimp at *,
induction x with x, esimp at *,
note q := !tr_eq_tr_equiv p,
induction q with q,
induction H x q with y r,
refine image.mk (tr y) _,
esimp, exact ap tr r
end
end chain_complex