2015-02-21 00:30:32 +00:00
|
|
|
|
/-
|
|
|
|
|
Copyright (c) 2015 Jakob von Raumer. All rights reserved.
|
|
|
|
|
Released under Apache 2.0 license as described in the file LICENSE.
|
2015-04-29 00:48:39 +00:00
|
|
|
|
Authors: Floris van Doorn
|
2015-02-21 00:30:32 +00:00
|
|
|
|
|
2015-04-29 00:48:39 +00:00
|
|
|
|
Properties of is_trunc and trunctype
|
2015-02-21 00:30:32 +00:00
|
|
|
|
-/
|
|
|
|
|
|
2015-06-04 17:55:02 +00:00
|
|
|
|
-- NOTE: the fact that (is_trunc n A) is a mere proposition is proved in .hprop_trunc
|
2015-04-29 00:48:39 +00:00
|
|
|
|
|
2015-08-06 21:19:07 +00:00
|
|
|
|
import types.pi types.eq types.equiv ..function
|
2015-04-29 00:48:39 +00:00
|
|
|
|
|
2015-06-04 05:12:05 +00:00
|
|
|
|
open eq sigma sigma.ops pi function equiv is_trunc.trunctype
|
|
|
|
|
is_equiv prod is_trunc.trunc_index pointed nat
|
2015-02-21 00:30:32 +00:00
|
|
|
|
|
|
|
|
|
namespace is_trunc
|
2015-04-29 00:48:39 +00:00
|
|
|
|
variables {A B : Type} {n : trunc_index}
|
2015-02-21 00:30:32 +00:00
|
|
|
|
|
2015-04-29 00:48:39 +00:00
|
|
|
|
/- theorems about trunctype -/
|
|
|
|
|
protected definition trunctype.sigma_char.{l} (n : trunc_index) :
|
|
|
|
|
(trunctype.{l} n) ≃ (Σ (A : Type.{l}), is_trunc n A) :=
|
2015-02-21 00:30:32 +00:00
|
|
|
|
begin
|
2015-04-29 00:48:39 +00:00
|
|
|
|
fapply equiv.MK,
|
|
|
|
|
{ intro A, exact (⟨carrier A, struct A⟩)},
|
|
|
|
|
{ intro S, exact (trunctype.mk S.1 S.2)},
|
2015-07-29 12:17:16 +00:00
|
|
|
|
{ intro S, induction S with S1 S2, reflexivity},
|
|
|
|
|
{ intro A, induction A with A1 A2, reflexivity},
|
2015-02-21 00:30:32 +00:00
|
|
|
|
end
|
|
|
|
|
|
2015-04-29 00:48:39 +00:00
|
|
|
|
definition trunctype_eq_equiv (n : trunc_index) (A B : n-Type) :
|
|
|
|
|
(A = B) ≃ (carrier A = carrier B) :=
|
|
|
|
|
calc
|
|
|
|
|
(A = B) ≃ (to_fun (trunctype.sigma_char n) A = to_fun (trunctype.sigma_char n) B)
|
|
|
|
|
: eq_equiv_fn_eq_of_equiv
|
|
|
|
|
... ≃ ((to_fun (trunctype.sigma_char n) A).1 = (to_fun (trunctype.sigma_char n) B).1)
|
|
|
|
|
: equiv.symm (!equiv_subtype)
|
|
|
|
|
... ≃ (carrier A = carrier B) : equiv.refl
|
|
|
|
|
|
2015-09-22 16:01:55 +00:00
|
|
|
|
theorem is_trunc_is_embedding_closed (f : A → B) [Hf : is_embedding f] [HB : is_trunc n B]
|
2015-04-29 00:48:39 +00:00
|
|
|
|
(Hn : -1 ≤ n) : is_trunc n A :=
|
2015-02-21 00:30:32 +00:00
|
|
|
|
begin
|
2015-07-29 12:17:16 +00:00
|
|
|
|
induction n with n,
|
2015-04-30 18:00:39 +00:00
|
|
|
|
{exact !empty.elim Hn},
|
|
|
|
|
{apply is_trunc_succ_intro, intro a a',
|
|
|
|
|
fapply @is_trunc_is_equiv_closed_rev _ _ n (ap f)}
|
2015-02-21 00:30:32 +00:00
|
|
|
|
end
|
|
|
|
|
|
2015-09-22 16:01:55 +00:00
|
|
|
|
theorem is_trunc_is_retraction_closed (f : A → B) [Hf : is_retraction f]
|
2015-04-29 00:48:39 +00:00
|
|
|
|
(n : trunc_index) [HA : is_trunc n A] : is_trunc n B :=
|
2015-02-21 00:30:32 +00:00
|
|
|
|
begin
|
2015-04-30 18:00:39 +00:00
|
|
|
|
revert A B f Hf HA,
|
2015-07-29 12:17:16 +00:00
|
|
|
|
induction n with n IH,
|
|
|
|
|
{ intro A B f Hf HA, induction Hf with g ε, fapply is_contr.mk,
|
2015-04-30 18:00:39 +00:00
|
|
|
|
{ exact f (center A)},
|
2015-04-29 00:48:39 +00:00
|
|
|
|
{ intro b, apply concat,
|
|
|
|
|
{ apply (ap f), exact (center_eq (g b))},
|
|
|
|
|
{ apply ε}}},
|
2015-07-29 12:17:16 +00:00
|
|
|
|
{ intro A B f Hf HA, induction Hf with g ε,
|
2015-04-30 18:00:39 +00:00
|
|
|
|
apply is_trunc_succ_intro, intro b b',
|
2015-04-29 00:48:39 +00:00
|
|
|
|
fapply (IH (g b = g b')),
|
|
|
|
|
{ intro q, exact ((ε b)⁻¹ ⬝ ap f q ⬝ ε b')},
|
|
|
|
|
{ apply (is_retraction.mk (ap g)),
|
2015-07-29 12:17:16 +00:00
|
|
|
|
{ intro p, induction p, {rewrite [↑ap, con.left_inv]}}},
|
2015-04-29 00:48:39 +00:00
|
|
|
|
{ apply is_trunc_eq}}
|
2015-02-21 00:30:32 +00:00
|
|
|
|
end
|
|
|
|
|
|
2015-04-29 00:48:39 +00:00
|
|
|
|
definition is_embedding_to_fun (A B : Type) : is_embedding (@to_fun A B) :=
|
2015-09-10 22:32:52 +00:00
|
|
|
|
λf f', !is_equiv_ap_to_fun
|
2015-04-29 00:48:39 +00:00
|
|
|
|
|
2015-09-22 16:01:55 +00:00
|
|
|
|
theorem is_trunc_trunctype [instance] (n : trunc_index) : is_trunc n.+1 (n-Type) :=
|
2015-04-29 00:48:39 +00:00
|
|
|
|
begin
|
2015-04-30 18:00:39 +00:00
|
|
|
|
apply is_trunc_succ_intro, intro X Y,
|
2015-04-29 00:48:39 +00:00
|
|
|
|
fapply is_trunc_equiv_closed,
|
|
|
|
|
{apply equiv.symm, apply trunctype_eq_equiv},
|
|
|
|
|
fapply is_trunc_equiv_closed,
|
|
|
|
|
{apply equiv.symm, apply eq_equiv_equiv},
|
2015-07-29 12:17:16 +00:00
|
|
|
|
induction n,
|
2015-04-29 00:48:39 +00:00
|
|
|
|
{apply @is_contr_of_inhabited_hprop,
|
|
|
|
|
{apply is_trunc_is_embedding_closed,
|
|
|
|
|
{apply is_embedding_to_fun} ,
|
|
|
|
|
{exact unit.star}},
|
|
|
|
|
{apply equiv_of_is_contr_of_is_contr}},
|
|
|
|
|
{apply is_trunc_is_embedding_closed,
|
|
|
|
|
{apply is_embedding_to_fun},
|
|
|
|
|
{exact unit.star}}
|
|
|
|
|
end
|
2015-02-21 00:30:32 +00:00
|
|
|
|
|
|
|
|
|
|
2015-04-29 00:48:39 +00:00
|
|
|
|
/- theorems about decidable equality and axiom K -/
|
2015-09-22 16:01:55 +00:00
|
|
|
|
theorem is_hset_of_axiom_K {A : Type} (K : Π{a : A} (p : a = a), p = idp) : is_hset A :=
|
2015-02-21 00:30:32 +00:00
|
|
|
|
is_hset.mk _ (λa b p q, eq.rec_on q K p)
|
|
|
|
|
|
|
|
|
|
theorem is_hset_of_relation.{u} {A : Type.{u}} (R : A → A → Type.{u})
|
|
|
|
|
(mere : Π(a b : A), is_hprop (R a b)) (refl : Π(a : A), R a a)
|
|
|
|
|
(imp : Π{a b : A}, R a b → a = b) : is_hset A :=
|
|
|
|
|
is_hset_of_axiom_K
|
|
|
|
|
(λa p,
|
2015-04-24 21:00:32 +00:00
|
|
|
|
have H2 : transport (λx, R a x → a = x) p (@imp a a) = @imp a a, from !apd,
|
2015-02-21 00:30:32 +00:00
|
|
|
|
have H3 : Π(r : R a a), transport (λx, a = x) p (imp r)
|
|
|
|
|
= imp (transport (λx, R a x) p r), from
|
2015-02-26 18:19:54 +00:00
|
|
|
|
to_fun (equiv.symm !heq_pi) H2,
|
2015-02-21 00:30:32 +00:00
|
|
|
|
have H4 : imp (refl a) ⬝ p = imp (refl a), from
|
|
|
|
|
calc
|
2015-03-04 05:10:48 +00:00
|
|
|
|
imp (refl a) ⬝ p = transport (λx, a = x) p (imp (refl a)) : transport_eq_r
|
2015-02-21 00:30:32 +00:00
|
|
|
|
... = imp (transport (λx, R a x) p (refl a)) : H3
|
|
|
|
|
... = imp (refl a) : is_hprop.elim,
|
2015-04-24 21:00:32 +00:00
|
|
|
|
cancel_left H4)
|
2015-02-21 00:30:32 +00:00
|
|
|
|
|
|
|
|
|
definition relation_equiv_eq {A : Type} (R : A → A → Type)
|
|
|
|
|
(mere : Π(a b : A), is_hprop (R a b)) (refl : Π(a : A), R a a)
|
|
|
|
|
(imp : Π{a b : A}, R a b → a = b) (a b : A) : R a b ≃ a = b :=
|
|
|
|
|
@equiv_of_is_hprop _ _ _
|
|
|
|
|
(@is_trunc_eq _ _ (is_hset_of_relation R mere refl @imp) a b)
|
|
|
|
|
imp
|
2015-05-01 03:23:12 +00:00
|
|
|
|
(λp, p ▸ refl a)
|
2015-02-21 00:30:32 +00:00
|
|
|
|
|
2015-02-24 22:09:20 +00:00
|
|
|
|
local attribute not [reducible]
|
2015-09-22 16:01:55 +00:00
|
|
|
|
theorem is_hset_of_double_neg_elim {A : Type} (H : Π(a b : A), ¬¬a = b → a = b)
|
2015-02-21 00:30:32 +00:00
|
|
|
|
: is_hset A :=
|
|
|
|
|
is_hset_of_relation (λa b, ¬¬a = b) _ (λa n, n idp) H
|
|
|
|
|
|
|
|
|
|
section
|
|
|
|
|
open decidable
|
2015-02-23 20:33:35 +00:00
|
|
|
|
--this is proven differently in init.hedberg
|
2015-09-22 16:01:55 +00:00
|
|
|
|
theorem is_hset_of_decidable_eq (A : Type) [H : decidable_eq A] : is_hset A :=
|
2015-02-21 00:30:32 +00:00
|
|
|
|
is_hset_of_double_neg_elim (λa b, by_contradiction)
|
|
|
|
|
end
|
|
|
|
|
|
2015-09-22 16:01:55 +00:00
|
|
|
|
theorem is_trunc_of_axiom_K_of_leq {A : Type} (n : trunc_index) (H : -1 ≤ n)
|
2015-02-21 00:30:32 +00:00
|
|
|
|
(K : Π(a : A), is_trunc n (a = a)) : is_trunc (n.+1) A :=
|
|
|
|
|
@is_trunc_succ_intro _ _ (λa b, is_trunc_of_imp_is_trunc_of_leq H (λp, eq.rec_on p !K))
|
|
|
|
|
|
2015-09-22 16:01:55 +00:00
|
|
|
|
theorem is_trunc_succ_of_is_trunc_loop (Hn : -1 ≤ n) (Hp : Π(a : A), is_trunc n (a = a))
|
2015-06-04 05:12:05 +00:00
|
|
|
|
: is_trunc (n.+1) A :=
|
|
|
|
|
begin
|
|
|
|
|
apply is_trunc_succ_intro, intros a a',
|
|
|
|
|
apply is_trunc_of_imp_is_trunc_of_leq Hn, intro p,
|
2015-07-29 12:17:16 +00:00
|
|
|
|
induction p, apply Hp
|
2015-06-04 05:12:05 +00:00
|
|
|
|
end
|
|
|
|
|
|
2015-11-13 22:17:02 +00:00
|
|
|
|
theorem is_hprop_iff_is_contr {A : Type} (a : A) :
|
|
|
|
|
is_hprop A ↔ is_contr A :=
|
|
|
|
|
iff.intro (λH, is_contr.mk a (is_hprop.elim a)) _
|
|
|
|
|
|
2015-09-22 16:01:55 +00:00
|
|
|
|
theorem is_trunc_succ_iff_is_trunc_loop (A : Type) (Hn : -1 ≤ n) :
|
2015-06-04 01:41:21 +00:00
|
|
|
|
is_trunc (n.+1) A ↔ Π(a : A), is_trunc n (a = a) :=
|
|
|
|
|
iff.intro _ (is_trunc_succ_of_is_trunc_loop Hn)
|
2015-11-13 22:17:02 +00:00
|
|
|
|
--set_option pp.all true
|
2015-09-22 16:01:55 +00:00
|
|
|
|
theorem is_trunc_iff_is_contr_loop_succ (n : ℕ) (A : Type)
|
2015-06-04 01:41:21 +00:00
|
|
|
|
: is_trunc n A ↔ Π(a : A), is_contr (Ω[succ n](Pointed.mk a)) :=
|
|
|
|
|
begin
|
|
|
|
|
revert A, induction n with n IH,
|
2015-11-13 22:17:02 +00:00
|
|
|
|
{ intro A, esimp [Iterated_loop_space], transitivity _,
|
|
|
|
|
{ apply is_trunc_succ_iff_is_trunc_loop, apply le.refl},
|
|
|
|
|
{ apply iff.pi_iff_pi, intro a, esimp, apply is_hprop_iff_is_contr, reflexivity}},
|
|
|
|
|
{ intro A, esimp [Iterated_loop_space],
|
|
|
|
|
transitivity _, apply @is_trunc_succ_iff_is_trunc_loop @n, esimp, constructor,
|
|
|
|
|
apply iff.pi_iff_pi, intro a, transitivity _, apply IH,
|
|
|
|
|
transitivity _, apply iff.pi_iff_pi, intro p,
|
|
|
|
|
rewrite [iterated_loop_space_loop_irrel n p], apply iff.refl, esimp,
|
|
|
|
|
apply iff.imp_iff, reflexivity}
|
2015-06-04 01:41:21 +00:00
|
|
|
|
end
|
2015-06-04 05:12:05 +00:00
|
|
|
|
|
2015-09-22 16:01:55 +00:00
|
|
|
|
theorem is_trunc_iff_is_contr_loop (n : ℕ) (A : Type)
|
2015-06-04 01:41:21 +00:00
|
|
|
|
: is_trunc (n.-2.+1) A ↔ (Π(a : A), is_contr (Ω[n](pointed.Mk a))) :=
|
2015-06-04 05:12:05 +00:00
|
|
|
|
begin
|
2015-07-29 12:17:16 +00:00
|
|
|
|
induction n with n,
|
2015-06-04 01:41:21 +00:00
|
|
|
|
{ esimp [sub_two,Iterated_loop_space], apply iff.intro,
|
|
|
|
|
intro H a, exact is_contr_of_inhabited_hprop a,
|
|
|
|
|
intro H, apply is_hprop_of_imp_is_contr, exact H},
|
|
|
|
|
{ apply is_trunc_iff_is_contr_loop_succ},
|
2015-06-04 05:12:05 +00:00
|
|
|
|
end
|
|
|
|
|
|
2015-04-29 00:48:39 +00:00
|
|
|
|
end is_trunc open is_trunc
|
2015-02-26 18:19:54 +00:00
|
|
|
|
|
2015-04-29 00:48:39 +00:00
|
|
|
|
namespace trunc
|
|
|
|
|
variable {A : Type}
|
|
|
|
|
|
2015-05-07 02:48:11 +00:00
|
|
|
|
protected definition code (n : trunc_index) (aa aa' : trunc n.+1 A) : n-Type :=
|
2015-04-29 00:48:39 +00:00
|
|
|
|
trunc.rec_on aa (λa, trunc.rec_on aa' (λa', trunctype.mk' n (trunc n (a = a'))))
|
|
|
|
|
|
2015-05-19 05:35:18 +00:00
|
|
|
|
protected definition encode (n : trunc_index) (aa aa' : trunc n.+1 A) : aa = aa' → trunc.code n aa aa' :=
|
2015-05-16 00:23:34 +00:00
|
|
|
|
begin
|
2015-07-29 12:17:16 +00:00
|
|
|
|
intro p, induction p, apply (trunc.rec_on aa),
|
2015-05-19 05:35:18 +00:00
|
|
|
|
intro a, esimp [trunc.code,trunc.rec_on], exact (tr idp)
|
2015-05-16 00:23:34 +00:00
|
|
|
|
end
|
|
|
|
|
|
2015-05-19 05:35:18 +00:00
|
|
|
|
protected definition decode (n : trunc_index) (aa aa' : trunc n.+1 A) : trunc.code n aa aa' → aa = aa' :=
|
2015-05-16 00:23:34 +00:00
|
|
|
|
begin
|
|
|
|
|
eapply (trunc.rec_on aa'), eapply (trunc.rec_on aa),
|
2015-05-19 05:35:18 +00:00
|
|
|
|
intro a a' x, esimp [trunc.code, trunc.rec_on] at x,
|
2015-05-16 00:23:34 +00:00
|
|
|
|
apply (trunc.rec_on x), intro p, exact (ap tr p)
|
|
|
|
|
end
|
2015-05-07 02:48:11 +00:00
|
|
|
|
|
2015-09-22 16:01:55 +00:00
|
|
|
|
definition trunc_eq_equiv [constructor] (n : trunc_index) (aa aa' : trunc n.+1 A)
|
2015-05-19 05:35:18 +00:00
|
|
|
|
: aa = aa' ≃ trunc.code n aa aa' :=
|
2015-02-26 18:19:54 +00:00
|
|
|
|
begin
|
|
|
|
|
fapply equiv.MK,
|
2015-05-19 05:35:18 +00:00
|
|
|
|
{ apply trunc.encode},
|
|
|
|
|
{ apply trunc.decode},
|
2015-05-01 22:07:28 +00:00
|
|
|
|
{ eapply (trunc.rec_on aa'), eapply (trunc.rec_on aa),
|
2015-05-19 05:35:18 +00:00
|
|
|
|
intro a a' x, esimp [trunc.code, trunc.rec_on] at x,
|
2015-07-29 12:17:16 +00:00
|
|
|
|
refine (@trunc.rec_on n _ _ x _ _),
|
|
|
|
|
intro x, apply is_trunc_eq,
|
|
|
|
|
intro p, induction p, reflexivity},
|
|
|
|
|
{ intro p, induction p, apply (trunc.rec_on aa), intro a, exact idp},
|
2015-02-26 18:19:54 +00:00
|
|
|
|
end
|
|
|
|
|
|
2015-09-22 16:01:55 +00:00
|
|
|
|
definition tr_eq_tr_equiv [constructor] (n : trunc_index) (a a' : A)
|
2015-04-29 00:48:39 +00:00
|
|
|
|
: (tr a = tr a' :> trunc n.+1 A) ≃ trunc n (a = a') :=
|
|
|
|
|
!trunc_eq_equiv
|
|
|
|
|
|
|
|
|
|
definition is_trunc_trunc_of_is_trunc [instance] [priority 500] (A : Type)
|
|
|
|
|
(n m : trunc_index) [H : is_trunc n A] : is_trunc n (trunc m A) :=
|
|
|
|
|
begin
|
2015-05-01 22:07:28 +00:00
|
|
|
|
revert A m H, eapply (trunc_index.rec_on n),
|
2015-04-30 18:00:39 +00:00
|
|
|
|
{ clear n, intro A m H, apply is_contr_equiv_closed,
|
2015-08-07 17:23:00 +00:00
|
|
|
|
{ apply equiv.symm, apply trunc_equiv, apply (@is_trunc_of_leq _ -2), exact unit.star} },
|
2015-07-29 12:17:16 +00:00
|
|
|
|
{ clear n, intro n IH A m H, induction m with m,
|
2015-04-29 00:48:39 +00:00
|
|
|
|
{ apply (@is_trunc_of_leq _ -2), exact unit.star},
|
2015-04-30 18:00:39 +00:00
|
|
|
|
{ apply is_trunc_succ_intro, intro aa aa',
|
2015-04-29 00:48:39 +00:00
|
|
|
|
apply (@trunc.rec_on _ _ _ aa (λy, !is_trunc_succ_of_is_hprop)),
|
2015-05-01 22:07:28 +00:00
|
|
|
|
eapply (@trunc.rec_on _ _ _ aa' (λy, !is_trunc_succ_of_is_hprop)),
|
2015-04-30 18:00:39 +00:00
|
|
|
|
intro a a', apply (is_trunc_equiv_closed_rev),
|
2015-04-29 00:48:39 +00:00
|
|
|
|
{ apply tr_eq_tr_equiv},
|
|
|
|
|
{ exact (IH _ _ _)}}}
|
|
|
|
|
end
|
|
|
|
|
|
2015-08-07 17:23:00 +00:00
|
|
|
|
open equiv.ops
|
|
|
|
|
definition unique_choice {P : A → Type} [H : Πa, is_hprop (P a)] (f : Πa, ∥ P a ∥) (a : A)
|
|
|
|
|
: P a :=
|
|
|
|
|
!trunc_equiv (f a)
|
|
|
|
|
|
|
|
|
|
|
2015-04-29 00:48:39 +00:00
|
|
|
|
end trunc open trunc
|
|
|
|
|
|
|
|
|
|
namespace function
|
|
|
|
|
variables {A B : Type}
|
|
|
|
|
definition is_surjective_of_is_equiv [instance] (f : A → B) [H : is_equiv f] : is_surjective f :=
|
2015-09-10 22:32:52 +00:00
|
|
|
|
λb, !center
|
2015-02-26 18:19:54 +00:00
|
|
|
|
|
2015-09-22 16:01:55 +00:00
|
|
|
|
definition is_equiv_equiv_is_embedding_times_is_surjective [constructor] (f : A → B)
|
2015-04-29 00:48:39 +00:00
|
|
|
|
: is_equiv f ≃ (is_embedding f × is_surjective f) :=
|
|
|
|
|
equiv_of_is_hprop (λH, (_, _))
|
|
|
|
|
(λP, prod.rec_on P (λH₁ H₂, !is_equiv_of_is_surjective_of_is_embedding))
|
2015-02-26 18:19:54 +00:00
|
|
|
|
|
2015-04-29 00:48:39 +00:00
|
|
|
|
end function
|