michael/lean2
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

style(hott): rename Pointed to pType

Browse source 
also rename sigma_equiv_sigma_id to sigma_equiv_sigma_right and similarly for pi
This commit is contained in:
Floris van Doorn 2016-02-15 16:05:31 -05:00 committed by Leonardo de Moura
parent 43cf2ad23d
commit bac6d99cc7
23 changed files with 82 additions and 82 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
hott/algebra/category/functor/attributes.hlean
View file

@ -143,15 +143,15 @@ namespace category
calc
fully_faithful F
≃ (Π(c c' : C), is_embedding (to_fun_hom F) × is_surjective (to_fun_hom F))
: pi_equiv_pi_id (λc, pi_equiv_pi_id
: pi_equiv_pi_right (λc, pi_equiv_pi_right
(λc', !is_equiv_equiv_is_embedding_times_is_surjective))
... ≃ (Π(c : C), (Π(c' : C), is_embedding (to_fun_hom F)) ×
(Π(c' : C), is_surjective (to_fun_hom F)))
: pi_equiv_pi_id (λc, !equiv_prod_corec)
: pi_equiv_pi_right (λc, !equiv_prod_corec)
... ≃ (Π(c c' : C), is_embedding (to_fun_hom F)) × full F
: equiv_prod_corec
... ≃ faithful F × full F
: prod_equiv_prod_right (pi_equiv_pi_id (λc, pi_equiv_pi_id
: prod_equiv_prod_right (pi_equiv_pi_right (λc, pi_equiv_pi_right
(λc', !is_embedding_equiv_is_injective)))
-/

2
hott/algebra/category/functor/yoneda.hlean
View file

@ -142,7 +142,7 @@ namespace yoneda
: is_prop (is_representable F) :=
begin
fapply is_trunc_equiv_closed,
{ exact proof fiber.sigma_char ɏ F qed ⬝e sigma.sigma_equiv_sigma_id (λc, !eq_equiv_iso)},
{ exact proof fiber.sigma_char ɏ F qed ⬝e sigma.sigma_equiv_sigma_right (λc, !eq_equiv_iso)},
{ apply function.is_prop_fiber_of_is_embedding, apply is_embedding_yoneda_embedding}
end
end

4
hott/algebra/homotopy_group.hlean
View file

@ -31,7 +31,7 @@ namespace eq
local attribute comm_group_homotopy_group [instance]
definition Pointed_homotopy_group [constructor] (n : ℕ) (A : Type*) : Type* :=
definition pType_homotopy_group [constructor] (n : ℕ) (A : Type*) : Type* :=
pointed.Mk (π[n] A)
definition Group_homotopy_group [constructor] (n : ℕ) (A : Type*) : Group :=
@ -43,7 +43,7 @@ namespace eq
definition fundamental_group [constructor] (A : Type*) : Group :=
Group_homotopy_group zero A
notation `πP[`:95 n:0 `] `:0 A:95 := Pointed_homotopy_group n A
notation `πP[`:95 n:0 `] `:0 A:95 := pType_homotopy_group n A
notation `πG[`:95 n:0 ` +1] `:0 A:95 := Group_homotopy_group n A
notation `πaG[`:95 n:0 ` +2] `:0 A:95 := CommGroup_homotopy_group n A

2
hott/function.hlean
View file

@ -158,7 +158,7 @@ namespace function
end,
apply is_trunc_equiv_closed, exact H2,
fapply is_trunc_equiv_closed,
{apply sigma_equiv_sigma_id, intro g, apply eq_equiv_homotopy},
{apply sigma_equiv_sigma_right, intro g, apply eq_equiv_homotopy},
fapply is_trunc_equiv_closed,
{apply fiber.sigma_char},
fapply is_contr_fiber_of_is_equiv,

2
hott/hit/coeq.hlean
View file

@ -131,7 +131,7 @@ section
{ intros b b' r, cases r, reflexivity },
rewrite (eq_of_homotopy3 H2) },
apply ap10 H1 },
apply equiv.trans (sigma_equiv_sigma_id H),
apply equiv.trans (sigma_equiv_sigma_right H),
apply equiv.trans !quotient.flattening.flattening_lemma,
fapply quotient.equiv,
{ reflexivity },

4
hott/hit/pointed_pushout.hlean
View file

@ -3,7 +3,7 @@ Copyright (c) 2016 Jakob von Raumer. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jakob von Raumer, Floris van Doorn
Pointed Pushouts
pType Pushouts
-/
import .pushout types.pointed2
@ -17,7 +17,7 @@ namespace pointed
end pointed
open pointed Pointed
open pointed pType
namespace pushout
section

2
hott/hit/pushout.hlean
View file

@ -170,7 +170,7 @@ namespace pushout
{ intros a a' r, cases r, reflexivity },
rewrite (eq_of_homotopy3 H2) },
apply ap10 H1 },
apply equiv.trans (sigma_equiv_sigma_id H),
apply equiv.trans (sigma_equiv_sigma_right H),
apply equiv.trans (quotient.flattening.flattening_lemma R (sum.rec Pinl Pinr) Pglue'),
fapply equiv.MK,
{ intro q, induction q with z z z' fr,

2
hott/homotopy/cofiber.hlean
View file

@ -48,7 +48,7 @@ namespace cofiber
end
end cofiber
-- Pointed version
-- pType version
definition Cofiber {A B : Type*} (f : A →* B) : Type* := Pushout (pconst A Unit) f

6
hott/homotopy/connectedness.hlean
View file

@ -83,11 +83,11 @@ namespace homotopy
rewrite [-(apd10_ap_precompose_dependent f (eq_of_homotopy r))],
apply equiv.symm,
apply eq_equiv_fn_eq (@apd10 A (λa, P (f a)) (λa, g (f a)) (λa, h (f a))) },
apply equiv.trans (sigma.sigma_equiv_sigma_id e'), clear e',
apply equiv.trans (sigma.sigma_equiv_sigma_right e'), clear e',
apply equiv.trans (equiv.symm (sigma.sigma_equiv_sigma_left
eq_equiv_homotopy)),
apply equiv.symm, apply equiv.trans !fiber_eq_equiv,
apply sigma.sigma_equiv_sigma_id, intro r,
apply sigma.sigma_equiv_sigma_right, intro r,
apply eq_equiv_eq_symm },
apply @is_trunc_equiv_closed _ _ k e, clear e,
apply IH (λb : B, trunctype.mk (g b = h b)
@ -155,7 +155,7 @@ namespace homotopy
-- as special case we get elimination principles for pointed connected types
namespace is_conn
open pointed Pointed unit
open pointed pType unit
section
parameters {n : trunc_index} {A : Type*}
[H : is_conn n .+1 A] (P : A → n -Type)

2
hott/homotopy/red_susp.hlean
View file

@ -13,7 +13,7 @@ open simple_two_quotient eq unit pointed e_closure
namespace red_susp
section
parameter {A : Pointed}
parameter {A : pType}
inductive red_susp_R : unit → unit → Type :=
| Rmk : Π(a : A), red_susp_R star star

16
hott/homotopy/smash.hlean
View file

@ -8,12 +8,12 @@ The Smash Product of Types
import hit.pushout .wedge .cofiber .susp .sphere
open eq pushout prod pointed Pointed is_trunc
open eq pushout prod pointed pType is_trunc
definition product_of_wedge [constructor] (A B : Type*) : Wedge A B →* A ×* B :=
begin
fconstructor,
intro x, induction x with [a, b], exact (a, point B), exact (point A, b),
intro x, induction x with [a, b], exact (a, point B), exact (point A, b),
do 2 reflexivity
end
@ -52,7 +52,7 @@ namespace smash
{ fconstructor,
{ intro x, fapply cofiber.pelim_on x, clear x, exact point X, intro p,
cases p with [x', b], cases b with [x, x'], exact point X, exact x',
clear x, intro w, induction w with [y, b], reflexivity,
clear x, intro w, induction w with [y, b], reflexivity,
cases b, reflexivity, reflexivity, esimp,
apply eq_pathover, refine !ap_constant ⬝ph _, cases x, esimp, apply hdeg_square,
apply inverse, apply concat, apply ap_compose (λ a, prod.cases_on a _),
@ -63,15 +63,15 @@ namespace smash
{ intro x, reflexivity },
{ intro s, esimp, induction s,
{ cases x, apply (glue (inr bool.tt))⁻¹ },
{ cases x with [x, b], cases b,
{ cases x with [x, b], cases b,
apply inverse, apply concat, apply (glue (inl x))⁻¹, apply (glue (inr bool.tt)),
reflexivity },
{ esimp, apply eq_pathover, induction x,
esimp, apply hinverse, krewrite ap_id, apply move_bot_of_left,
reflexivity },
{ esimp, apply eq_pathover, induction x,
esimp, apply hinverse, krewrite ap_id, apply move_bot_of_left,
krewrite con.right_inv,
refine _ ⬝hp !(ap_compose (λ a, inr (pair a _)))⁻¹,
apply transpose, apply square_of_eq_bot, rewrite [con_idp, con.left_inv],
apply inverse, apply concat, apply ap (ap _),
apply inverse, apply concat, apply ap (ap _),
} } }
definition susp_equiv_circle_smash (X : Type*) : Susp X ≃* Smash (Sphere 1) X :=

12
hott/homotopy/sphere.hlean
View file

@ -92,7 +92,7 @@ namespace sphere
definition base {n : ℕ} : sphere n := north
definition pointed_sphere [instance] [constructor] (n : ℕ) : pointed (sphere n) :=
pointed.mk base
definition Sphere [constructor] (n : ℕ) : Pointed := pointed.mk' (sphere n)
definition Sphere [constructor] (n : ℕ) : pType := pointed.mk' (sphere n)
namespace ops
abbreviation S := sphere
@ -106,7 +106,7 @@ namespace sphere
definition surf {n : ℕ} : Ω[n] S. n :=
nat.rec_on n (proof base qed)
(begin intro m s, refine cast _ (apn m (equator m) s),
exact ap Pointed.carrier !loop_space_succ_eq_in⁻¹ end)
exact ap pType.carrier !loop_space_succ_eq_in⁻¹ end)
definition bool_of_sphere : S 0 → bool :=
@ -126,10 +126,10 @@ namespace sphere
ua sphere_equiv_bool
definition sphere_eq_bool_pointed : S. 0 = Bool :=
Pointed_eq sphere_equiv_bool idp
pType_eq sphere_equiv_bool idp
-- TODO: the commented-out part makes the forward function below "apn _ surf"
definition pmap_sphere (A : Pointed) (n : ℕ) : map₊ (S. n) A ≃ Ω[n] A :=
definition pmap_sphere (A : pType) (n : ℕ) : map₊ (S. n) A ≃ Ω[n] A :=
begin
-- fapply equiv_change_fun,
-- {
@ -143,10 +143,10 @@ namespace sphere
-- { exact sorry}}
end
protected definition elim {n : ℕ} {P : Pointed} (p : Ω[n] P) : map₊ (S. n) P :=
protected definition elim {n : ℕ} {P : pType} (p : Ω[n] P) : map₊ (S. n) P :=
to_inv !pmap_sphere p
-- definition elim_surf {n : ℕ} {P : Pointed} (p : Ω[n] P) : apn n (sphere.elim p) surf = p :=
-- definition elim_surf {n : ℕ} {P : pType} (p : Ω[n] P) : apn n (sphere.elim p) surf = p :=
-- begin
-- induction n with n IH,
-- { esimp [apn,surf,sphere.elim,pmap_sphere], apply sorry},

14
hott/homotopy/susp.hlean
View file

@ -80,12 +80,12 @@ attribute susp.elim_type_on [unfold 2]
namespace susp
open pointed
variables {X Y Z : Pointed}
variables {X Y Z : pType}
definition pointed_susp [instance] [constructor] (X : Type) : pointed (susp X) :=
pointed.mk north
definition Susp [constructor] (X : Type) : Pointed :=
definition Susp [constructor] (X : Type) : pType :=
pointed.mk' (susp X)
definition Susp_functor (f : X →* Y) : Susp X →* Susp Y :=
@ -112,7 +112,7 @@ namespace susp
-- adjunction from Coq-HoTT
definition loop_susp_unit [constructor] (X : Pointed) : X →* Ω(Susp X) :=
definition loop_susp_unit [constructor] (X : pType) : X →* Ω(Susp X) :=
begin
fconstructor,
{ intro x, exact merid x ⬝ (merid pt)⁻¹},
@ -141,7 +141,7 @@ namespace susp
xrewrite [idp_con_idp, -ap_compose (concat idp)]},
end
definition loop_susp_counit [constructor] (X : Pointed) : Susp (Ω X) →* X :=
definition loop_susp_counit [constructor] (X : pType) : Susp (Ω X) →* X :=
begin
fconstructor,
{ intro x, induction x, exact pt, exact pt, exact a},
@ -162,7 +162,7 @@ namespace susp
{ reflexivity}
end
definition loop_susp_counit_unit (X : Pointed)
definition loop_susp_counit_unit (X : pType)
: ap1 (loop_susp_counit X) ∘* loop_susp_unit (Ω X) ~* pid (Ω X) :=
begin
induction X with X x, fconstructor,
@ -176,7 +176,7 @@ namespace susp
xrewrite [ap_con_right_inv (susp.elim x x (λa, a)) (merid idp),idp_con_idp,-ap_compose]}
end
definition loop_susp_unit_counit (X : Pointed)
definition loop_susp_unit_counit (X : pType)
: loop_susp_counit (Susp X) ∘* Susp_functor (loop_susp_unit X) ~* pid (Susp X) :=
begin
induction X with X x, fconstructor,
@ -189,7 +189,7 @@ namespace susp
{ reflexivity}
end
definition susp_adjoint_loop (X Y : Pointed) : map₊ (pointed.mk' (susp X)) Y ≃ map₊ X (Ω Y) :=
definition susp_adjoint_loop (X Y : pType) : map₊ (pointed.mk' (susp X)) Y ≃ map₊ X (Ω Y) :=
begin
fapply equiv.MK,
{ intro f, exact ap1 f ∘* loop_susp_unit X},

4
hott/homotopy/wedge.hlean
View file

@ -3,11 +3,11 @@ Copyright (c) 2016 Jakob von Raumer. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jakob von Raumer, Ulrik Buchholtz
The Wedge Sum of Two Pointed Types
The Wedge Sum of Two pType Types
-/
import hit.pointed_pushout .connectedness
open eq pushout pointed Pointed unit
open eq pushout pointed pType unit
definition Wedge (A B : Type*) : Type* := Pushout (pconst Unit A) (pconst Unit B)

2
hott/types/arrow.hlean
View file

@ -49,7 +49,7 @@ namespace pi
variables {B}
definition arrow_equiv_arrow_right' [constructor] (f1 : A → (B ≃ B')) : (A → B) ≃ (A → B') :=
pi_equiv_pi_id f1
pi_equiv_pi_right f1
/- Equivalence if one of the types is contractible -/

4
hott/types/equiv.hlean
View file

@ -32,7 +32,7 @@ namespace is_equiv
definition is_contr_right_inverse : is_contr (Σ(g : B → A), f ∘ g ~ id) :=
begin
fapply is_trunc_equiv_closed,
{apply sigma_equiv_sigma_id, intro g, apply eq_equiv_homotopy},
{apply sigma_equiv_sigma_right, intro g, apply eq_equiv_homotopy},
fapply is_trunc_equiv_closed,
{apply fiber.sigma_char},
fapply is_contr_fiber_of_is_equiv,
@ -45,7 +45,7 @@ namespace is_equiv
fapply is_trunc_equiv_closed,
{apply equiv.symm, apply sigma_pi_equiv_pi_sigma},
fapply is_trunc_equiv_closed,
{apply pi_equiv_pi_id, intro a,
{apply pi_equiv_pi_right, intro a,
apply (fiber_eq_equiv (fiber.mk (u.1 (f a)) (u.2 (f a))) (fiber.mk a idp))},
end

16
hott/types/fiber.hlean
View file

@ -34,7 +34,7 @@ namespace fiber
apply eq_equiv_fn_eq_of_equiv, apply fiber.sigma_char,
apply equiv.trans,
apply sigma_eq_equiv,
apply sigma_equiv_sigma_id,
apply sigma_equiv_sigma_right,
intro p,
apply pathover_eq_equiv_Fl,
end
@ -48,13 +48,13 @@ namespace fiber
calc
fiber pr1 a ≃ Σu, u.1 = a : fiber.sigma_char
... ≃ Σa' (b : B a'), a' = a : sigma_assoc_equiv
... ≃ Σa' (p : a' = a), B a' : sigma_equiv_sigma_id (λa', !comm_equiv_nondep)
... ≃ Σa' (p : a' = a), B a' : sigma_equiv_sigma_right (λa', !comm_equiv_nondep)
... ≃ Σu, B u.1 : sigma_assoc_equiv
... ≃ B a : !sigma_equiv_of_is_contr_left
definition sigma_fiber_equiv (f : A → B) : (Σb, fiber f b) ≃ A :=
calc
(Σb, fiber f b) ≃ Σb a, f a = b : sigma_equiv_sigma_id (λb, !fiber.sigma_char)
(Σb, fiber f b) ≃ Σb a, f a = b : sigma_equiv_sigma_right (λb, !fiber.sigma_char)
... ≃ Σa b, f a = b : sigma_comm_equiv
... ≃ A : sigma_equiv_of_is_contr_right
@ -77,7 +77,7 @@ namespace fiber
calc
fiber (g ∘ f) (g b) ≃ Σa : A, g (f a) = g b : fiber.sigma_char
... ≃ Σa : A, f a = b : begin
apply sigma_equiv_sigma_id, intro a,
apply sigma_equiv_sigma_right, intro a,
apply equiv.symm, apply eq_equiv_fn_eq
end
... ≃ fiber f b : fiber.sigma_char
@ -142,14 +142,14 @@ namespace fiber
... ≃ Σ(x : A), Σ(p : P x), Σ(H : x = a), f x p =[H] q
:
begin
apply sigma_equiv_sigma_id, intro x,
apply sigma_equiv_sigma_id, intro p,
apply sigma_equiv_sigma_right, intro x,
apply sigma_equiv_sigma_right, intro p,
apply sigma_eq_equiv
end
... ≃ Σ(x : A), Σ(H : x = a), Σ(p : P x), f x p =[H] q
:
begin
apply sigma_equiv_sigma_id, intro x,
apply sigma_equiv_sigma_right, intro x,
apply sigma_comm_equiv
end
... ≃ Σ(w : Σx, x = a), Σ(p : P w.1), f w.1 p =[w.2] q
@ -161,7 +161,7 @@ namespace fiber
... ≃ Σ(p : P a), f a p = q
:
begin
apply sigma_equiv_sigma_id, intro p,
apply sigma_equiv_sigma_right, intro p,
apply pathover_idp
end
... ≃ fiber (f a) q

2
hott/types/pi.hlean
View file

@ -214,7 +214,7 @@ namespace pi
: (Πa, B a) ≃ (Πa', B' a') :=
pi_equiv_pi_of_is_equiv (to_fun f0) (λa', to_fun (f1 a'))
definition pi_equiv_pi_id [constructor] {P Q : A → Type} (g : Πa, P a ≃ Q a)
definition pi_equiv_pi_right [constructor] {P Q : A → Type} (g : Πa, P a ≃ Q a)
: (Πa, P a) ≃ (Πa, Q a) :=
pi_equiv_pi equiv.refl g

26
hott/types/pointed.hlean
View file

@ -12,23 +12,23 @@ open is_trunc eq prod sigma nat equiv option is_equiv bool unit algebra equiv.op
structure pointed [class] (A : Type) :=
(point : A)
structure Pointed :=
structure pType :=
(carrier : Type)
(Point : carrier)
open Pointed
open pType
notation `Type*` := Pointed
notation `Type*` := pType
namespace pointed
attribute Pointed.carrier [coercion]
attribute pType.carrier [coercion]
variables {A B : Type}
definition pt [unfold 2] [H : pointed A] := point A
protected definition Mk [constructor] {A : Type} (a : A) := Pointed.mk A a
protected definition MK [constructor] (A : Type) (a : A) := Pointed.mk A a
protected definition Mk [constructor] {A : Type} (a : A) := pType.mk A a
protected definition MK [constructor] (A : Type) (a : A) := pType.mk A a
protected definition mk' [constructor] (A : Type) [H : pointed A] : Type* :=
Pointed.mk A (point A)
pType.mk A (point A)
definition pointed_carrier [instance] [constructor] (A : Type*) : pointed A :=
pointed.mk (Point A)
@ -89,15 +89,15 @@ namespace pointed
Ω[n] (pointed.mk' A)
open equiv.ops
definition Pointed_eq {A B : Type*} (f : A ≃ B) (p : f pt = pt) : A = B :=
definition pType_eq {A B : Type*} (f : A ≃ B) (p : f pt = pt) : A = B :=
begin
cases A with A a, cases B with B b, esimp at *,
fapply apd011 @Pointed.mk,
fapply apd011 @pType.mk,
{ apply ua f},
{ rewrite [cast_ua,p]},
end
protected definition Pointed.sigma_char.{u} : Pointed.{u} ≃ Σ(X : Type.{u}), X :=
protected definition pType.sigma_char.{u} : pType.{u} ≃ Σ(X : Type.{u}), X :=
begin
fapply equiv.MK,
{ intro x, induction x with X x, exact ⟨X, x⟩},
@ -149,7 +149,7 @@ namespace pointed
definition loop_space_loop_irrel (p : point A = point A) : Ω(pointed.Mk p) = Ω[2] A :=
begin
intros, fapply Pointed_eq,
intros, fapply pType_eq,
{ esimp, transitivity _,
apply eq_equiv_fn_eq_of_equiv (equiv_eq_closed_right _ p⁻¹),
esimp, apply eq_equiv_eq_closed, apply con.right_inv, apply con.right_inv},
@ -157,7 +157,7 @@ namespace pointed
end
definition iterated_loop_space_loop_irrel (n : ℕ) (p : point A = point A)
: Ω[succ n](pointed.Mk p) = Ω[succ (succ n)] A :> Pointed :=
: Ω[succ n](pointed.Mk p) = Ω[succ (succ n)] A :> pType :=
calc
Ω[succ n](pointed.Mk p) = Ω[n](Ω (pointed.Mk p)) : loop_space_succ_eq_in
... = Ω[n] (Ω[2] A) : loop_space_loop_irrel
@ -297,7 +297,7 @@ namespace pointed
end
definition pcast [constructor] {A B : Type*} (p : A = B) : A →* B :=
proof pmap.mk (cast (ap Pointed.carrier p)) (by induction p; reflexivity) qed
proof pmap.mk (cast (ap pType.carrier p)) (by induction p; reflexivity) qed
definition pinverse [constructor] {X : Type*} : Ω X →* Ω X :=
pmap.mk eq.inverse idp

6
hott/types/pointed2.hlean
View file

@ -19,7 +19,7 @@ structure pequiv (A B : Type*) extends equiv A B, pmap A B
section
universe variable u
structure ptrunctype (n : trunc_index) extends trunctype.{u} n, Pointed.{u}
structure ptrunctype (n : trunc_index) extends trunctype.{u} n, pType.{u}
end
namespace pointed
@ -45,7 +45,7 @@ namespace pointed
pmap.mk f⁻¹ (ap f⁻¹ (respect_pt f)⁻¹ ⬝ !left_inv)
definition pua {A B : Type*} (f : A ≃* B) : A = B :=
Pointed_eq (equiv_of_pequiv f) !respect_pt
pType_eq (equiv_of_pequiv f) !respect_pt
protected definition pequiv.refl [refl] [constructor] (A : Type*) : A ≃* A :=
pequiv_of_pmap !pid !is_equiv_id
@ -76,7 +76,7 @@ namespace pointed
pequiv_of_eq p ⬝e* q
definition eq_of_pequiv {A B : Type*} (p : A ≃* B) : A = B :=
Pointed_eq (equiv_of_pequiv p) !respect_pt
pType_eq (equiv_of_pequiv p) !respect_pt
definition peap {A B : Type*} (F : Type* → Type*) (p : A ≃* B) : F A ≃* F B :=
pequiv_of_pmap (pcast (ap F (eq_of_pequiv p))) begin cases eq_of_pequiv p, apply is_equiv_id end

8
hott/types/sigma.hlean
View file

@ -242,7 +242,7 @@ namespace sigma
(Σa, B a) ≃ (Σa', B' a') :=
sigma_equiv_sigma_of_is_equiv (to_fun Hf) (λ a, to_fun (Hg a))
definition sigma_equiv_sigma_id [constructor] {B' : A → Type} (Hg : Π a, B a ≃ B' a)
definition sigma_equiv_sigma_right [constructor] {B' : A → Type} (Hg : Π a, B a ≃ B' a)
: (Σa, B a) ≃ Σa, B' a :=
sigma_equiv_sigma equiv.refl Hg
@ -332,9 +332,9 @@ namespace sigma
: (Σ(v : Σa, B a), C v.1) ≃ (Σ(u : Σa, C a), B u.1) :=
calc (Σ(v : Σa, B a), C v.1)
≃ (Σa (b : B a), C a) : !sigma_assoc_equiv⁻¹ᵉ
... ≃ (Σa, B a × C a) : sigma_equiv_sigma_id (λa, !equiv_prod)
... ≃ (Σa, C a × B a) : sigma_equiv_sigma_id (λa, !prod_comm_equiv)
... ≃ (Σa (c : C a), B a) : sigma_equiv_sigma_id (λa, !equiv_prod)
... ≃ (Σa, B a × C a) : sigma_equiv_sigma_right (λa, !equiv_prod)
... ≃ (Σa, C a × B a) : sigma_equiv_sigma_right (λa, !prod_comm_equiv)
... ≃ (Σa (c : C a), B a) : sigma_equiv_sigma_right (λa, !equiv_prod)
... ≃ (Σ(u : Σa, C a), B u.1) : sigma_assoc_equiv
/- Interaction with other type constructors -/

18
hott/types/univ.hlean
View file

@ -103,26 +103,26 @@ namespace univ
end
definition is_object_classifier (f : A → B)
: pullback_square (pointed_fiber f) (fiber f) f Pointed.carrier :=
: pullback_square (pointed_fiber f) (fiber f) f pType.carrier :=
pullback_square.mk
(λa, idp)
(is_equiv_of_equiv_of_homotopy
(calc
A ≃ Σb, fiber f b : sigma_fiber_equiv
... ≃ Σb (v : ΣX, X = fiber f b), v.1 : sigma_equiv_sigma_id
... ≃ Σb (v : ΣX, X = fiber f b), v.1 : sigma_equiv_sigma_right
(λb, !sigma_equiv_of_is_contr_left)
... ≃ Σb X (p : X = fiber f b), X : sigma_equiv_sigma_id
... ≃ Σb X (p : X = fiber f b), X : sigma_equiv_sigma_right
(λb, !sigma_assoc_equiv)
... ≃ Σb X (x : X), X = fiber f b : sigma_equiv_sigma_id
(λb, sigma_equiv_sigma_id
... ≃ Σb X (x : X), X = fiber f b : sigma_equiv_sigma_right
(λb, sigma_equiv_sigma_right
(λX, !comm_equiv_nondep))
... ≃ Σb (v : ΣX, X), v.1 = fiber f b : sigma_equiv_sigma_id
... ≃ Σb (v : ΣX, X), v.1 = fiber f b : sigma_equiv_sigma_right
(λb, !sigma_assoc_equiv⁻¹)
... ≃ Σb (Y : Type*), Y = fiber f b : sigma_equiv_sigma_id
(λb, sigma_equiv_sigma (Pointed.sigma_char)⁻¹
... ≃ Σb (Y : Type*), Y = fiber f b : sigma_equiv_sigma_right
(λb, sigma_equiv_sigma (pType.sigma_char)⁻¹
(λv, sigma.rec_on v (λx y, equiv.refl)))
... ≃ Σ(Y : Type*) b, Y = fiber f b : sigma_comm_equiv
... ≃ pullback Pointed.carrier (fiber f) : !pullback.sigma_char⁻¹ᵉ
... ≃ pullback pType.carrier (fiber f) : !pullback.sigma_char⁻¹ᵉ
)
proof λb, idp qed)

4
src/emacs/lean-syntax.el
View file

@ -175,8 +175,8 @@
(,(rx word-start (group "example") ".") (1 'font-lock-keyword-face))
(,(rx (or "∎")) . 'font-lock-keyword-face)
;; Types
(,(rx word-start (or "Prop" "Type" "Type'" "Type₊" "Type₀" "Type₁" "Type₂" "Type₃" "Type*" "Set") symbol-end) . 'font-lock-type-face)
(,(rx word-start (group (or "Prop" "Type" "Set")) ".") (1 'font-lock-type-face))
(,(rx word-start (or "Prop" "Type" "Type'" "Type₊" "Type₀" "Type₁" "Type₂" "Type₃" "Type*" "pType" "Set") symbol-end) . 'font-lock-type-face)
(,(rx word-start (group (or "Prop" "Type" "Set" "pType")) ".") (1 'font-lock-type-face))
;; String
("\"[^\"]*\"" . 'font-lock-string-face)
;; ;; Constants