Library UniMath.Foundations.Propositions
Generalities on hProp. Vladimir Voevodsky . May - Sep. 2011 .
Contents
- The type hProp of types of h-level 1
- The type tildehProp of pairs (P, p : P) where P : hProp
- Intuitionistic logic on hProp
- Images and surjectivity for functions between types
- The two-out-of-three properties of surjections
- A function between types which is an inclusion and a surjection is a weak equivalence
- Intuitionistic logic on hProp
- Associativity and commutativity of hdisj and hconj up to logical equivalence
- Proof of the only non-trivial axiom of intuitionistic logic for our constructions
- Negation and quantification
- Negation and conjunction ("and") and disjunction ("or")
- Property of being decidable and hdisj ("or")
- The double negation version of hinhabited (does not require RR1)
- Univalence for hProp
Preamble
Universe structure
Definition hProp := total2 (λ X : UU, isaprop X).
Definition make_hProp (X : UU) (is : isaprop X) : hProp
:= tpair (λ X : UU, isaprop X) X is.
Definition hProptoType := @pr1 _ _ : hProp → UU.
Coercion hProptoType : hProp >-> UU.
Definition propproperty (P : hProp) := pr2 P : isaprop (pr1 P).
The type tildehProp of pairs (P, p : P) where P : hProp
Definition tildehProp := total2 (λ P : hProp, P).
Definition make_tildehProp {P : hProp} (p : P) : tildehProp := tpair _ P p.
Corollary subtypeInjectivity_prop {A : UU} (B : A → hProp) :
∏ (x y : total2 B), (x = y) ≃ (pr1 x = pr1 y).
Proof.
intros. apply subtypeInjectivity. intro. apply propproperty.
Defined.
Corollary subtypePath_prop {A : UU} {B : A → hProp}
{s s' : total2 (λ x, B x)} : pr1 s = pr1 s' → s = s'.
Proof.
apply invmap. apply subtypeInjectivity_prop.
Defined.
Corollary impred_prop {T : UU} (P : T → hProp) : isaprop (∏ t : T, P t).
Proof.
intros. apply impred; intro. apply propproperty.
Defined.
Corollary isaprop_total2 (X : hProp) (Y : X → hProp) : isaprop (∑ x, Y x).
Proof.
intros.
apply (isofhleveltotal2 1).
- apply propproperty.
- intro x. apply propproperty.
Defined.
Lemma isaprop_forall_hProp (X : UU) (Y : X → hProp) : isaprop (∏ x, Y x).
Proof.
intros. apply impred_isaprop. intro x. apply propproperty.
Defined.
Definition forall_hProp {X : UU} (Y : X → hProp) : hProp
:= make_hProp (∏ x, Y x) (isaprop_forall_hProp X Y).
Notation "∀ x .. y , P"
:= (forall_hProp (λ x, .. (forall_hProp (λ y, P))..))
(at level 200, x binder, y binder, right associativity) : type_scope.
The following re-definitions should make proofs easier in the future when
the unification algorithms in Coq are improved. At the moment they create more
complications than they eliminate (e.g. try to prove isapropishinh with
isaprop in hProp) so for the time being they are commented out.
Definition iscontr (X : UU) : hProp := make_hProp _ (isapropiscontr X).
Definition isweq {X Y : UU} (f : X -> Y) : hProp
:= make_hProp _ (isapropisweq f).
Definition isofhlevel (n : nat) (X : UU) : hProp
:= make_hProp _ (isapropisofhlevel n X).
Definition isaprop (X : UU) : hProp := make_hProp (isaprop X) (isapropisaprop X).
Definition isaset (X : UU) : hProp := make_hProp _ (isapropisaset X).
Definition isisolated (X : UU) (x : X) : hProp
:= make_hProp _ (isapropisisolated X x).
Definition isdecEq (X : UU) : hProp := make_hProp _ (isapropisdeceq X).
Intuitionistic logic on hProp
The hProp version of the "inhabited" construction.
Definition ishinh_UU (X : UU) : UU := ∏ P : hProp, ((X → P) → P).
Lemma isapropishinh (X : UU) : isaprop (ishinh_UU X).
Proof.
apply impred.
intro P. apply impred.
intro. apply (pr2 P).
Qed.
Definition ishinh (X : UU) : hProp := make_hProp (ishinh_UU X) (isapropishinh X).
Notation nonempty := ishinh (only parsing).
Notation "∥ A ∥" := (ishinh A) (at level 20) : type_scope.
Definition hinhpr {X : UU} : X → ∥ X ∥
:= λ x : X, λ P : hProp, fun f : X → P ⇒ f x.
Definition hinhfun {X Y : UU} (f : X → Y) : ∥ X ∥ → ∥ Y ∥ :=
fun isx : ∥ X ∥ ⇒ λ P : _, fun yp : Y → P ⇒ isx P (λ x : X, yp (f x)).
Note that the previous definitions do not require RR1 in an essential way
(except for the placing of ishinh in hProp UU - without RR1 it would be
placed in hProp UU1). The first place where RR1 is essentially required is
in application of hinhuniv to a function X → ishinh Y
Definition hinhuniv {X : UU} {P : hProp} (f : X → P) (wit : ∥ X ∥) : P
:= wit P f.
Corollary factor_through_squash {X Q : UU} : isaprop Q → (X → Q) → ∥ X ∥ → Q.
Proof.
intros i f h. exact (@hinhuniv X (Q,,i) f h).
Defined.
Corollary squash_to_prop {X Q : UU} : ∥ X ∥ → isaprop Q → (X → Q) → Q.
Proof.
intros h i f. exact (@hinhuniv X (Q,,i) f h).
Defined.
Definition hinhand {X Y : UU} (inx1 : ∥ X ∥) (iny1 : ∥ Y ∥) : ∥ X × Y ∥
:= λ P : _, ddualand (inx1 P) (iny1 P).
Definition hinhuniv2 {X Y : UU} {P : hProp} (f : X → Y → P)
(isx : ∥ X ∥) (isy : ∥ Y ∥) : P
:= hinhuniv (λ xy : X × Y, f (pr1 xy) (pr2 xy)) (hinhand isx isy).
Definition hinhfun2 {X Y Z : UU} (f : X → Y → Z)
(isx : ∥ X ∥) (isy : ∥ Y ∥) : ∥ Z ∥
:= hinhfun (λ xy: X × Y, f (pr1 xy) (pr2 xy)) (hinhand isx isy).
Definition hinhunivcor1 (P : hProp) : ∥ P ∥ → P := hinhuniv (idfun P).
Notation hinhprinv := hinhunivcor1.
Lemma weqishinhnegtoneg (X : UU) : ∥ ¬ X ∥ ≃ ¬ X.
Proof.
assert (lg : logeq (ishinh (neg X)) (neg X)).
{
split.
- simpl. apply (@hinhuniv _ (make_hProp _ (isapropneg X))).
simpl. intro nx. apply nx.
- apply hinhpr.
}
apply (weqimplimpl (pr1 lg) (pr2 lg) (pr2 (ishinh _)) (isapropneg X)).
Defined.
Lemma weqnegtonegishinh (X : UU) : ¬ X ≃ ¬ ∥ X ∥.
Proof.
assert (lg : logeq (neg (ishinh X)) (neg X)).
{
split.
- apply (negf (@hinhpr X)).
- intro nx. unfold neg. simpl.
apply (@hinhuniv _ (make_hProp _ isapropempty)).
apply nx.
}
apply (weqimplimpl (pr2 lg) (pr1 lg) (isapropneg _) (isapropneg _)).
Defined.
Lemma hinhcoprod (X Y : UU) : ∥ (∥ X ∥ ⨿ ∥ Y ∥) ∥ → ∥ X ⨿ Y ∥.
Proof.
intros is. unfold ishinh. intro P. intro CP.
set (CPX := λ x : X, CP (ii1 x)).
set (CPY := λ y : Y, CP (ii2 y)).
set (is1P := is P).
assert (f : (ishinh X) ⨿ (ishinh Y) → P).
apply (sumofmaps (hinhuniv CPX) (hinhuniv CPY)).
apply (is1P f).
Defined.
ishinh and decidability
Lemma decidable_ishinh {X} : decidable X → decidable(∥X∥).
Proof.
intros d.
unfold decidable in ×.
induction d as [x|x'].
- apply ii1. apply hinhpr. assumption.
- apply ii2. intros p.
apply (squash_to_prop p).
+ exact isapropempty.
+ exact x'.
Defined.
Images and surjectivity for functions between types
(both depend only on the behavior of the corresponding function between the sets of connected components)Definition image {X Y : UU} (f : X → Y) : UU
:= total2 (λ y : Y, ishinh (hfiber f y)).
Definition make_image {X Y : UU} (f : X → Y) :
∏ (t : Y), (λ y : Y, ∥ hfiber f y ∥) t → ∑ y : Y, ∥ hfiber f y ∥
:= tpair (λ y : Y, ishinh (hfiber f y)).
Definition pr1image {X Y : UU} (f : X → Y) :
(∑ y : Y, ∥ hfiber f y ∥) → Y
:= @pr1 _ (λ y : Y, ishinh (hfiber f y)).
Definition prtoimage {X Y : UU} (f : X → Y) : X → image f.
Proof.
intros X0.
apply (make_image _ (f X0) (hinhpr (make_hfiber f X0 (idpath _)))).
Defined.
Definition issurjective {X Y : UU} (f : X → Y) := ∏ y : Y, ishinh (hfiber f y).
Lemma isapropissurjective {X Y : UU} (f : X → Y) : isaprop (issurjective f).
Proof.
intros. apply impred.
intro t. apply (pr2 (ishinh (hfiber f t))).
Defined.
Lemma isinclpr1image {X Y : UU} (f : X → Y): isincl (pr1image f).
Proof.
intros. refine (isofhlevelfpr1 _ _ _).
intro. apply (pr2 (ishinh (hfiber f x))).
Defined.
Lemma issurjprtoimage {X Y : UU} (f : X → Y) : issurjective (prtoimage f).
Proof.
intros. intro z.
set (f' := prtoimage f).
assert (ff: hfiber (funcomp f' (pr1image f)) (pr1 z) → hfiber f' z)
by refine (invweq (samehfibers _ _ (isinclpr1image f) z)).
apply (hinhfun ff).
exact (pr2 z).
Defined.
Lemma issurjcomp {X Y Z : UU} (f : X → Y) (g : Y → Z)
(isf : issurjective f) (isg : issurjective g) :
issurjective (funcomp f g).
Proof.
intros. unfold issurjective.
intro z. apply (λ ff, hinhuniv ff (isg z)).
intro ye. apply (hinhfun (hfibersftogf f g z ye)).
apply (isf).
Defined.
Notation issurjtwooutof3c := issurjcomp.
Lemma issurjtwooutof3b {X Y Z : UU} (f : X → Y) (g : Y → Z)
(isgf : issurjective (funcomp f g)) : issurjective g.
Proof.
intros. unfold issurjective.
intro z. apply (hinhfun (hfibersgftog f g z) (isgf z)).
Defined.
Lemma isweqinclandsurj {X Y : UU} (f : X → Y) :
isincl f → issurjective f → isweq f.
Proof.
intros Hincl Hsurj.
intro y.
set (H := make_hProp (iscontr (hfiber f y)) (isapropiscontr _)).
apply (Hsurj y H).
intro x.
simpl.
apply iscontraprop1.
- apply Hincl.
- apply x.
Defined.
On the other hand, a weak equivalence is surjective
Lemma issurjectiveweq (X Y : UU) (f : X → Y) : isweq f → issurjective f.
Proof.
intros H y.
apply hinhpr.
apply (pr1 (H y)).
Defined.
Intuitionistic logic on hProp.
Definition htrue : hProp := make_hProp unit isapropunit.
Definition hfalse : hProp := make_hProp empty isapropempty.
Definition hconj (P Q : hProp) : hProp
:= make_hProp (P × Q) (isapropdirprod _ _ (pr2 P) (pr2 Q)).
Notation "A ∧ B" := (hconj A B) (at level 80, right associativity) : type_scope.
Definition hdisj (P Q : UU) : hProp := ishinh (coprod P Q).
Notation "X ∨ Y" := (hdisj X Y) (at level 85, right associativity) : type_scope.
Definition hdisj_in1 {P Q : UU} : P → P ∨ Q.
Proof.
intros. apply hinhpr. apply ii1. assumption.
Defined.
Definition hdisj_in2 {P Q : UU} : Q → P ∨ Q.
Proof.
intros. apply hinhpr. apply ii2. assumption.
Defined.
Lemma disjoint_disjunction (P Q : hProp) : (P → Q → ∅) → hProp.
Proof.
intros n.
exact (P ⨿ Q,, isapropcoprod P Q (propproperty P) (propproperty Q) n).
Defined.
Definition hneg (P : UU) : hProp := make_hProp (¬ P) (isapropneg P).
Declare Scope logic.
Notation "'¬' X" := (hneg X) (at level 35, right associativity) : logic.
Delimit Scope logic with logic.
Definition himpl (P : UU) (Q : hProp) : hProp.
Proof.
intros. split with (P → Q). apply impred. intro. apply (pr2 Q).
Defined.
Local Notation "A ⇒ B" := (himpl A B) : logic.
Local Open Scope logic.
Definition hexists {X : UU} (P : X → UU) := ∥ total2 P ∥.
Notation "'∃' x .. y , P"
:= (ishinh (∑ x ,.. (∑ y , P)..))
(at level 200, x binder, y binder, right associativity) : type_scope.
Definition wittohexists {X : UU} (P : X → UU) (x : X) (is : P x) : hexists P
:= @hinhpr (total2 P) (tpair _ x is).
Definition total2tohexists {X : UU} (P : X → UU) : total2 P → hexists P
:= hinhpr.
Definition weqneghexistsnegtotal2 {X : UU} (P : X → UU) :
weq (neg (hexists P)) (neg (total2 P)).
Proof.
intros.
assert (lg : (neg (hexists P)) ↔ (neg (total2 P))).
{
split.
- apply (negf (total2tohexists P)).
- intro nt2. unfold neg. change (ishinh_UU (total2 P) → hfalse).
apply (hinhuniv). apply nt2.
}
apply (weqimplimpl (pr1 lg) (pr2 lg) (isapropneg _) (isapropneg _)).
Defined.
Lemma islogeqcommhdisj {P Q : hProp} : hdisj P Q ↔ hdisj Q P.
Proof.
intros. split.
- simpl. apply hinhfun. apply coprodcomm.
- simpl. apply hinhfun. apply coprodcomm.
Defined.
Proof of the only non-trivial axiom of intuitionistic logic for our constructions. For the full list of axioms see e.g. http://plato.stanford.edu/entries/logic-intuitionistic/
Lemma hconjtohdisj (P Q : UU) (R : hProp) : (P ⇒ R) ∧ (Q ⇒ R) → (P ∨ Q) ⇒ R.
Proof.
intros X0.
assert (s1: hdisj P Q → R).
{
intro X1.
assert (s2: coprod P Q → R).
{
intro X2.
induction X2 as [ XP | XQ ].
- apply X0. apply XP.
- apply (pr2 X0). apply XQ.
}
apply (hinhuniv s2). apply X1.
}
unfold himpl. simpl. apply s1.
Defined.
Negation and quantification.
Lemma hexistsnegtonegforall {X : UU} (F : X → UU) :
(∃ x : X, neg (F x)) → neg (∏ x : X, F x).
Proof.
simpl.
apply (@hinhuniv _ (make_hProp _ (isapropneg (∏ x : X, F x)))).
simpl. intros t2 f2. induction t2 as [ x d2 ]. apply (d2 (f2 x)).
Defined.
Lemma forallnegtoneghexists {X : UU} (F : X → UU) :
(∏ x : X, neg (F x)) → neg (∃ x, F x).
Proof.
intros nf.
change ((ishinh_UU (total2 F)) → hfalse).
apply hinhuniv. intro t2. induction t2 as [ x f ]. apply (nf x f).
Defined.
Lemma neghexisttoforallneg {X : UU} (F : X → UU) :
¬ (∃ x, F x) → ∏ x : X, ¬ (F x).
Proof.
intros nhe x. intro fx.
apply (nhe (hinhpr (tpair F x fx))).
Defined.
Definition weqforallnegtonegexists {X : UU} (F : X → UU) :
(∏ x : X, ¬ F x) ≃ (¬ ∃ x, F x).
Proof.
intros.
apply (weqimplimpl (forallnegtoneghexists F) (neghexisttoforallneg F)).
apply impred. intro x. apply isapropneg. apply isapropneg.
Defined.
Negation and conjunction ("and") and disjunction ("or").
Lemma tonegdirprod {X Y : UU} : ¬ X ∨ ¬ Y → ¬ (X × Y).
Proof.
simpl.
apply (@hinhuniv _ (make_hProp _ (isapropneg (X × Y)))).
intro c. induction c as [ nx | ny ].
- simpl. intro xy. apply (nx (pr1 xy)).
- simpl. intro xy. apply (ny (pr2 xy)).
Defined.
Lemma weak_fromnegdirprod (P Q: hProp) : ¬ (P ∧ Q) → ¬¬(¬ P ∨ ¬ Q).
Proof.
intros npq k.
assert (e : ¬¬ Q).
{
intro n. apply k. apply hdisj_in2. assumption.
}
assert (d : ¬¬ P).
{
intro n. apply k. apply hdisj_in1. assumption.
}
clear k.
apply d; clear d. intro p. apply e; clear e. intro q.
refine (npq _). exact (p,,q).
Defined.
Lemma tonegcoprod {X Y : UU} : ¬ X × ¬ Y → ¬ (X ⨿ Y).
Proof.
intros is. intro c. induction c as [ x | y ].
- apply (pr1 is x).
- apply (pr2 is y).
Defined.
Lemma toneghdisj {X Y : UU} : ¬ X × ¬ Y → ¬ (X ∨ Y).
Proof.
intros is. unfold hdisj.
apply weqnegtonegishinh.
apply tonegcoprod.
apply is.
Defined.
Lemma fromnegcoprod {X Y : UU} : ¬ (X ⨿ Y) → ¬X × ¬Y.
Proof.
intros is. split.
- exact (λ x, is (ii1 x)).
- exact (λ y, is (ii2 y)).
Defined.
Corollary fromnegcoprod_prop {X Y : hProp} : ¬ (X ∨ Y) → ¬ X ∧ ¬ Y.
Proof.
intros n.
simpl in ×.
assert (n' := negf hinhpr n); simpl in n'; clear n.
apply fromnegcoprod. assumption.
Defined.
Lemma hdisjtoimpl {P : UU} {Q : hProp} : P ∨ Q → ¬ P → Q.
Proof.
assert (int : isaprop (¬ P → Q)).
{
apply impred. intro.
apply (pr2 Q).
}
simpl. apply (@hinhuniv _ (make_hProp _ int)).
simpl. intro pq. induction pq as [ p | q ].
- intro np. induction (np p).
- intro np. apply q.
Defined.
Property of being decidable and hdisj ("or").
Lemma isdecprophdisj {X Y : UU} (isx : isdecprop X) (isy : isdecprop Y) :
isdecprop (hdisj X Y).
Proof.
intros.
apply isdecpropif. apply (pr2 (hdisj X Y)).
induction (pr1 isx) as [ x | nx ].
- apply (ii1 (hinhpr (ii1 x))).
- induction (pr1 isy) as [ y | ny ].
+ apply (ii1 (hinhpr (ii2 y))).
+ apply (ii2 (toneghdisj (make_dirprod nx ny))).
Defined.
Definition isinhdneg (X : UU) : hProp := make_hProp (dneg X) (isapropdneg X).
Definition inhdnegpr (X : UU) : X → isinhdneg X := todneg X.
Definition inhdnegfun {X Y : UU} (f : X → Y) : isinhdneg X → isinhdneg Y
:= dnegf f.
Definition inhdneguniv (X : UU) (P : UU) (is : isweq (todneg P)) :
(X → P) → ((isinhdneg X) → P)
:= λ xp : _, λ inx0 : _, (invmap (make_weq _ is) (dnegf xp inx0)).
Definition inhdnegand (X Y : UU) (inx0 : isinhdneg X) (iny0 : isinhdneg Y) :
isinhdneg (X × Y) := dneganddnegimpldneg inx0 iny0.
Definition hinhimplinhdneg (X : UU) (inx1 : ishinh X) : isinhdneg X
:= inx1 hfalse.
Theorem hPropUnivalence : ∏ (P Q : hProp), (P → Q) → (Q → P) → P = Q.
Proof.
intros ? ? f g.
apply subtypePath.
- intro X. apply isapropisaprop.
- apply propositionalUnivalenceAxiom.
+ apply propproperty.
+ apply propproperty.
+ assumption.
+ assumption.
Defined.
Definition eqweqmaphProp {P P' : hProp} (e : @paths hProp P P') : P ≃ P'.
Proof.
intros. induction e. apply idweq.
Defined.
Definition weqtopathshProp {P P' : hProp} (w : P ≃ P') : P = P'
:= hPropUnivalence P P' w (invweq w).
Definition weqpathsweqhProp {P P' : hProp} (w : P ≃ P') :
eqweqmaphProp (weqtopathshProp w) = w.
Proof.
intros. apply proofirrelevance.
apply (isapropweqtoprop P P' (pr2 P')).
Defined.
Theorem univfromtwoaxiomshProp (P P' : hProp) : isweq (@eqweqmaphProp P P').
Proof.
intros.
set (P1 := λ XY : hProp × hProp, paths (pr1 XY) (pr2 XY)).
set (P2 := λ XY : hProp × hProp, (pr1 XY) ≃ (pr2 XY)).
set (Z1 := total2 P1).
set (Z2 := total2 P2).
set (f := (totalfun _ _ (λ XY : hProp × hProp,
@eqweqmaphProp (pr1 XY) (pr2 XY)): Z1 → Z2)).
set (g := (totalfun _ _ (λ XY : hProp × hProp,
@weqtopathshProp (pr1 XY) (pr2 XY)): Z2 → Z1)).
assert (efg : ∏ z2 : Z2 , paths (f (g z2)) z2).
{
intros. induction z2 as [ XY w].
exact (maponpaths (fun w : (pr1 XY) ≃ (pr2 XY) ⇒ tpair P2 XY w)
(@weqpathsweqhProp (pr1 XY) (pr2 XY) w)).
}
set (h := λ a1 : Z1, (pr1 (pr1 a1))).
assert (egf0 : ∏ a1 : Z1, paths (pr1 (g (f a1))) (pr1 a1))
by (intro; apply idpath).
assert (egf1 : ∏ a1 a1' : Z1, paths (pr1 a1') (pr1 a1) → a1' = a1).
{
intros ? ? X.
set (X' := maponpaths (@pr1 _ _) X).
assert (is : isweq h) by apply (isweqpr1pr1 hProp).
apply (invmaponpathsweq (make_weq h is) _ _ X').
}
set (egf := λ a1, (egf1 _ _ (egf0 a1))).
set (is2 := isweq_iso _ _ egf efg).
apply (isweqtotaltofib P1 P2 (λ XY : hProp × hProp,
@eqweqmaphProp (pr1 XY) (pr2 XY)) is2
(make_dirprod P P')).
Defined.
Definition weqeqweqhProp (P P' : hProp) : P = P' ≃ (P ≃ P')
:= make_weq _ (univfromtwoaxiomshProp P P').
Corollary isasethProp : isaset hProp.
Proof.
unfold isaset. simpl. intros x x'.
apply (isofhlevelweqb (S O) (weqeqweqhProp x x')
(isapropweqtoprop x x' (pr2 x'))).
Defined.
Definition weqpathsweqhProp' {P P' : hProp} (e : P = P') :
weqtopathshProp (eqweqmaphProp e) = e.
Proof.
intros. apply isasethProp.
Defined.
Lemma iscontrtildehProp : iscontr tildehProp.
Proof.
split with (tpair _ htrue tt). intro tP. induction tP as [ P p ].
apply (invmaponpathsincl _ (isinclpr1 (λ P : hProp, P) (λ P, pr2 P))).
simpl. apply hPropUnivalence. apply (λ x, tt). intro t. apply p.
Defined.
Lemma isaproptildehProp : isaprop tildehProp.
Proof.
apply (isapropifcontr iscontrtildehProp).
Defined.
Lemma isasettildehProp : isaset tildehProp.
Proof.
apply (isasetifcontr iscontrtildehProp).
Defined.
Definition logeqweq (P Q : hProp) : (P → Q) → (Q → P) → P ≃ Q :=
λ f g, weqimplimpl f g (pr2 P) (pr2 Q).
Theorem total2_paths_hProp_equiv {A : UU} (B : A → hProp)
(x y : total2 (λ x, B x)) : (x = y) ≃ (pr1 x = pr1 y).
Proof.
intros.
apply subtypeInjectivity.
intro a. apply (pr2 (B a)).
Defined.