lean2/hott/homotopy/red_susp.hlean
Floris van Doorn 52dd6cf90b feat(hott): Port files from other repositories to the HoTT library.
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.
2016-05-06 14:27:27 -07:00

85 lines
2.6 KiB
Text

/-
Copyright (c) 2015 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn
Declaration of the reduced suspension
-/
import hit.two_quotient types.pointed algebra.e_closure
open simple_two_quotient eq unit pointed e_closure
namespace red_susp
section
parameter {A : pType}
inductive red_susp_R : unit → unit → Type :=
| Rmk : Π(a : A), red_susp_R star star
open red_susp_R
inductive red_susp_Q : Π⦃x : unit⦄, e_closure red_susp_R x x → Type :=
| Qmk : red_susp_Q [Rmk pt]
open red_susp_Q
local abbreviation R := red_susp_R
local abbreviation Q := red_susp_Q
definition red_susp : Type := simple_two_quotient R Q -- TODO: define this in root namespace
definition base : red_susp :=
incl0 R Q star
definition merid (a : A) : base = base :=
incl1 R Q (Rmk a)
definition merid_pt : merid pt = idp :=
incl2 R Q Qmk
protected definition rec {P : red_susp → Type} (Pb : P base) (Pm : Π(a : A), Pb =[merid a] Pb)
(Pe : change_path merid_pt (Pm pt) = idpo) (x : red_susp) : P x :=
begin
induction x,
{ induction a, exact Pb},
{ induction s, exact Pm a},
{ induction q, esimp, exact Pe}
end
protected definition rec_on [reducible] {P : red_susp → Type} (x : red_susp) (Pb : P base)
(Pm : Π(a : A), Pb =[merid a] Pb) (Pe : change_path merid_pt (Pm pt) = idpo) : P x :=
red_susp.rec Pb Pm Pe x
definition rec_merid {P : red_susp → Type} (Pb : P base) (Pm : Π(a : A), Pb =[merid a] Pb)
(Pe : change_path merid_pt (Pm pt) = idpo) (a : A)
: apd (rec Pb Pm Pe) (merid a) = Pm a :=
!rec_incl1
protected definition elim {P : Type} (Pb : P) (Pm : Π(a : A), Pb = Pb)
(Pe : Pm pt = idp) (x : red_susp) : P :=
begin
induction x,
exact Pb,
induction s, exact Pm a,
induction q, exact Pe
end
protected definition elim_on [reducible] {P : Type} (x : red_susp) (Pb : P)
(Pm : Π(a : A), Pb = Pb) (Pe : Pm pt = idp) : P :=
elim Pb Pm Pe x
definition elim_merid {P : Type} {Pb : P} {Pm : Π(a : A), Pb = Pb}
(Pe : Pm pt = idp) (a : A)
: ap (elim Pb Pm Pe) (merid a) = Pm a :=
!elim_incl1
theorem elim_merid_pt {P : Type} (Pb : P) (Pm : Π(a : A), Pb = Pb)
(Pe : Pm pt = idp) : square (ap02 (elim Pb Pm Pe) merid_pt) Pe (elim_merid Pe pt) idp :=
!elim_incl2
end
end red_susp
attribute red_susp.base [constructor]
attribute red_susp.rec red_susp.elim [unfold 6] [recursor 6]
--attribute red_susp.elim_type [unfold 9]
attribute red_susp.rec_on red_susp.elim_on [unfold 3]
--attribute red_susp.elim_type_on [unfold 6]