114 lines
3.9 KiB
Text
114 lines
3.9 KiB
Text
/-
|
||
Copyright (c) 2018 Ulrik Buchholtz. All rights reserved.
|
||
Released under Apache 2.0 license as described in the file LICENSE.
|
||
Authors: Ulrik Buchholtz
|
||
-/
|
||
|
||
import algebra.group_theory hit.set_quotient types.list homotopy.vankampen
|
||
homotopy.susp .pushout ..algebra.free_group
|
||
|
||
open eq pointed equiv is_equiv is_trunc set_quotient sum list susp trunc algebra
|
||
group pi pushout is_conn fiber unit function category paths
|
||
|
||
-- special purpose lemmas
|
||
definition tr_trunc_eq (A : Type) (a : A) {x y : A} (p : x = y) (q : x = a)
|
||
: transport (λ(z : A), trunc 0 (z = a)) p (tr q) = tr (p⁻¹ ⬝ q) :=
|
||
by induction p; induction q; reflexivity
|
||
|
||
namespace susp
|
||
section
|
||
universe variable u
|
||
parameters (A : pType.{u}) [H : is_set A]
|
||
include H
|
||
|
||
local notation `F` := Π₁⇒ (λ(a : A), star)
|
||
|
||
local abbreviation C : Groupoid := Groupoid_bpushout (@id A) F F
|
||
local abbreviation N : C := inl star
|
||
local abbreviation S : C := inr star
|
||
|
||
-- local notation `N` := a
|
||
|
||
-- hom group of fundamental groupoid is fundamental group
|
||
-- the fundamental group of the suspension is the free group on A
|
||
-- could go via van Kampen, but would have to compose with opposite, which is not so well developed
|
||
-- definition fundamental_group_of_susp : π₁(⅀ A) ≃g free_group A :=
|
||
-- sorry
|
||
|
||
/-
|
||
van Kampen instead?
|
||
|
||
game plan:
|
||
1. lift to 1-connected cover
|
||
2. apply flattening lemma
|
||
3. provide equivalences F A ≃ ∥N = N∥ ≃ ∥S = N∥
|
||
4. move to is_contr
|
||
5. induction induction induction!
|
||
-/
|
||
|
||
definition pglueNS (a : A) : hom N S :=
|
||
class_of [ bpushout_prehom_index.DE (@id A) F F a ]
|
||
|
||
definition pglueSN (a : A) : hom S N :=
|
||
class_of [ bpushout_prehom_index.ED (@id A) F F a ]
|
||
|
||
definition f : A × hom N N → hom S N :=
|
||
prod.rec (λ a p, p ∘ pglueSN a)
|
||
|
||
definition g : A × trunc 0 (@susp.north A = @susp.north A) → trunc 0 (@susp.south A = @susp.north A) :=
|
||
prod.rec (λ a p, tconcat (tr (merid a)⁻¹) p)
|
||
|
||
--set_option pp.notation false
|
||
--set_option pp.implicit true
|
||
|
||
|
||
definition foo : (Σ(z : susp A), trunc 0 (z = susp.north)) ≃ pushout prod.pr2 g :=
|
||
begin
|
||
apply equiv.trans !pushout.flattening',
|
||
fapply pushout.equiv,
|
||
{ apply sigma.equiv_prod },
|
||
{ apply sigma.sigma_unit_left },
|
||
{ apply sigma.sigma_unit_left },
|
||
{ intro z, induction z with a p, induction p with p, reflexivity },
|
||
{ intro z, induction z with a p, induction p with p, apply tr_trunc_eq }
|
||
end
|
||
|
||
definition bar : pushout prod.pr2 g ≃ pushout prod.pr2 f :=
|
||
begin
|
||
fapply pushout.equiv,
|
||
{ apply prod.prod_equiv_prod_right, apply vankampen },
|
||
{ apply vankampen },
|
||
{ apply vankampen },
|
||
{ intro z, induction z with a p, reflexivity },
|
||
{ intro z, induction z with a p,
|
||
change (encode (@id A) (λ(z : A), star) (λ(z : A), star) (tconcat (tr (merid a)⁻¹) p))
|
||
= (encode (@id A) (λ(z : A), star) (λ(z : A), star) p ∘ pglueSN a),
|
||
revert p, fapply @trunc.rec 0 (@susp.north A = @susp.north A),
|
||
{ intro p, apply is_trunc_succ, apply is_trunc_eq, apply is_set_code }, intro p,
|
||
apply trans (encode_tcon (@id A) (λ(z : A), star) (λ(z : A), star) (tr (merid a)⁻¹) (tr p)),
|
||
apply ap (λ h, encode (@id A) (λ(z : A), star) (λ(z : A), star) (tr p) ∘ h),
|
||
apply encode_decode_singleton }
|
||
end
|
||
|
||
definition is_contr_susp_fiber_tr : is_contr (Σ(z : susp A), trunc 0 (z = susp.north)) := sorry
|
||
|
||
definition pfiber_susp_equiv_sigma : pfiber (ptr 1 (⅀ A)) ≃ (Σ(z : susp A), trunc 0 (z = susp.north)) :=
|
||
begin
|
||
apply equiv.trans !fiber.sigma_char,
|
||
apply sigma.sigma_equiv_sigma_right,
|
||
intro z, apply tr_eq_tr_equiv
|
||
end
|
||
|
||
definition is_trunc_susp_of_is_set : is_trunc 1 (susp A) :=
|
||
begin
|
||
apply is_trunc_of_is_equiv_tr,
|
||
apply is_equiv_of_is_contr_fun,
|
||
fapply @is_conn.elim -1 (ptrunc 1 (⅀ A)),
|
||
change is_contr (pfiber (ptr 1 (⅀ A))),
|
||
apply is_contr_equiv_closed_rev pfiber_susp_equiv_sigma,
|
||
apply is_contr_susp_fiber_tr
|
||
end
|
||
|
||
end
|
||
|
||
end susp
|