mirror of
https://github.com/nmvdw/HITs-Examples
synced 2025-11-04 07:33:51 +01:00
Simplified proof of extensionalty and proofs in interface.v
This commit is contained in:
Niels
@@ -6,29 +6,86 @@ Section ext.
|
||||
Context {A : Type}.
|
||||
Context `{Univalence}.
|
||||
|
||||
Lemma equiv_subset1_l (X Y : FSet A) (H1 : Y ∪ X = X) (a : A) (Ya : a ∈ Y) : a ∈ X.
|
||||
Proof.
|
||||
apply (transport (fun Z => a ∈ Z) H1 (tr(inl Ya))).
|
||||
Defined.
|
||||
|
||||
Lemma equiv_subset1_r X : forall (Y : FSet A), (forall a, a ∈ Y -> a ∈ X) -> Y ∪ X = X.
|
||||
Proof.
|
||||
hinduction ; try (intros ; apply path_ishprop).
|
||||
- intros.
|
||||
apply nl.
|
||||
- intros b sub.
|
||||
specialize (sub b (tr idpath)).
|
||||
revert sub.
|
||||
hinduction X ; try (intros ; apply path_ishprop).
|
||||
* contradiction.
|
||||
* intros.
|
||||
strip_truncations.
|
||||
rewrite sub.
|
||||
apply union_idem.
|
||||
* intros X Y subX subY mem.
|
||||
strip_truncations.
|
||||
destruct mem as [t | t].
|
||||
** rewrite assoc, (subX t).
|
||||
reflexivity.
|
||||
** rewrite (comm X), assoc, (subY t).
|
||||
reflexivity.
|
||||
- intros Y1 Y2 H1 H2 H3.
|
||||
rewrite <- assoc.
|
||||
rewrite (H2 (fun a HY => H3 a (tr(inr HY)))).
|
||||
apply (H1 (fun a HY => H3 a (tr(inl HY)))).
|
||||
Defined.
|
||||
|
||||
Lemma eq_subset1 X Y : (Y ∪ X = X) * (X ∪ Y = Y) <~> forall (a : A), a ∈ X = a ∈ Y.
|
||||
Proof.
|
||||
eapply equiv_iff_hprop_uncurried ; split.
|
||||
- intros [H1 H2] a.
|
||||
apply path_iff_hprop ; apply equiv_subset1_l ; assumption.
|
||||
- intros H1.
|
||||
split ; apply equiv_subset1_r ; intros.
|
||||
* rewrite H1 ; assumption.
|
||||
* rewrite <- H1 ; assumption.
|
||||
Defined.
|
||||
|
||||
Lemma eq_subset2 (X Y : FSet A) : X = Y <~> (Y ∪ X = X) * (X ∪ Y = Y).
|
||||
Proof.
|
||||
eapply equiv_iff_hprop_uncurried ; split.
|
||||
- intro Heq.
|
||||
split.
|
||||
* apply (ap (fun Z => Z ∪ X) Heq^ @ union_idem X).
|
||||
* apply (ap (fun Z => Z ∪ Y) Heq @ union_idem Y).
|
||||
- intros [H1 H2].
|
||||
apply (H1^ @ comm Y X @ H2).
|
||||
Defined.
|
||||
|
||||
Theorem fset_ext (X Y : FSet A) :
|
||||
X = Y <~> forall (a : A), a ∈ X = a ∈ Y.
|
||||
Proof.
|
||||
apply (equiv_compose' (eq_subset1 X Y) (eq_subset2 X Y)).
|
||||
Defined.
|
||||
|
||||
Lemma subset_union (X Y : FSet A) :
|
||||
X ⊆ Y -> X ∪ Y = Y.
|
||||
Proof.
|
||||
hinduction X ; try (intros; apply path_forall; intro; apply set_path2).
|
||||
- intros. apply nl.
|
||||
hinduction X ; try (intros ; apply path_ishprop).
|
||||
- intros.
|
||||
apply nl.
|
||||
- intros a.
|
||||
hinduction Y ; try (intros; apply path_forall; intro; apply set_path2).
|
||||
hinduction Y ; try (intros ; apply path_ishprop).
|
||||
+ intro.
|
||||
contradiction.
|
||||
+ intro a0.
|
||||
simple refine (Trunc_ind _ _).
|
||||
intro p ; simpl.
|
||||
rewrite p; apply idem.
|
||||
+ intros X1 X2 IH1 IH2.
|
||||
simple refine (Trunc_ind _ _).
|
||||
intros [e1 | e2].
|
||||
++ rewrite assoc.
|
||||
rewrite (IH1 e1).
|
||||
+ intros b p.
|
||||
strip_truncations.
|
||||
rewrite p.
|
||||
apply idem.
|
||||
+ intros X1 X2 IH1 IH2 t.
|
||||
strip_truncations.
|
||||
destruct t as [t | t].
|
||||
++ rewrite assoc, (IH1 t).
|
||||
reflexivity.
|
||||
++ rewrite comm.
|
||||
rewrite <- assoc.
|
||||
rewrite (comm X2).
|
||||
rewrite (IH2 e2).
|
||||
++ rewrite comm, <- assoc, (comm X2), (IH2 t).
|
||||
reflexivity.
|
||||
- intros X1 X2 IH1 IH2 [G1 G2].
|
||||
rewrite <- assoc.
|
||||
@@ -39,15 +96,16 @@ Section ext.
|
||||
Lemma subset_union_l (X : FSet A) :
|
||||
forall Y, X ⊆ X ∪ Y.
|
||||
Proof.
|
||||
hinduction X ; try (repeat (intro; intros; apply path_forall);
|
||||
intro ; apply path_ishprop).
|
||||
hinduction X ; try (intros ; apply path_ishprop).
|
||||
- apply (fun _ => tt).
|
||||
- intros a Y.
|
||||
- intros.
|
||||
apply (tr(inl(tr idpath))).
|
||||
- intros X1 X2 HX1 HX2 Y.
|
||||
split ; unfold subset in *.
|
||||
* rewrite <- assoc. apply HX1.
|
||||
* rewrite (comm X1 X2). rewrite <- assoc. apply HX2.
|
||||
* rewrite <- assoc.
|
||||
apply HX1.
|
||||
* rewrite (comm X1 X2), <- assoc.
|
||||
apply HX2.
|
||||
Defined.
|
||||
|
||||
Lemma subset_union_equiv
|
||||
@@ -61,92 +119,23 @@ Section ext.
|
||||
rewrite <- HXY.
|
||||
apply subset_union_l.
|
||||
Defined.
|
||||
|
||||
|
||||
Lemma subset_isIn (X Y : FSet A) :
|
||||
(forall (a : A), a ∈ X -> a ∈ Y)
|
||||
<~> X ⊆ Y.
|
||||
X ⊆ Y <~> forall (a : A), a ∈ X -> a ∈ Y.
|
||||
Proof.
|
||||
eapply equiv_iff_hprop_uncurried.
|
||||
split.
|
||||
- hinduction X ;
|
||||
try (intros; repeat (apply path_forall; intro); apply path_ishprop).
|
||||
+ intros ; reflexivity.
|
||||
+ intros a f.
|
||||
apply f.
|
||||
apply tr ; reflexivity.
|
||||
+ intros X1 X2 H1 H2 f.
|
||||
enough (X1 ⊆ Y).
|
||||
enough (X2 ⊆ Y).
|
||||
{ split. apply X. apply X0. }
|
||||
* apply H2.
|
||||
intros a Ha.
|
||||
refine (f _ (tr _)).
|
||||
right.
|
||||
apply Ha.
|
||||
* apply H1.
|
||||
intros a Ha.
|
||||
refine (f _ (tr _)).
|
||||
left.
|
||||
apply Ha.
|
||||
- hinduction X ;
|
||||
try (intros; repeat (apply path_forall; intro); apply path_ishprop).
|
||||
+ intros. contradiction.
|
||||
+ intros b f a.
|
||||
simple refine (Trunc_ind _ _) ; cbn.
|
||||
intro p.
|
||||
rewrite p^ in f.
|
||||
apply f.
|
||||
+ intros X1 X2 IH1 IH2 [H1 H2] a.
|
||||
simple refine (Trunc_ind _ _) ; cbn.
|
||||
intros [C1 | C2].
|
||||
++ apply (IH1 H1 a C1).
|
||||
++ apply (IH2 H2 a C2).
|
||||
Defined.
|
||||
|
||||
(** ** Extensionality proof *)
|
||||
|
||||
Lemma eq_subset' (X Y : FSet A) : X = Y <~> (Y ∪ X = X) * (X ∪ Y = Y).
|
||||
Proof.
|
||||
unshelve eapply BuildEquiv.
|
||||
{ intro H'. rewrite H'. split; apply union_idem. }
|
||||
unshelve esplit.
|
||||
{ intros [H1 H2]. etransitivity. apply H1^.
|
||||
rewrite comm. apply H2. }
|
||||
intro; apply path_prod; apply set_path2.
|
||||
all: intro; apply set_path2.
|
||||
etransitivity.
|
||||
- apply subset_union_equiv.
|
||||
- eapply equiv_iff_hprop_uncurried ; split.
|
||||
* apply equiv_subset1_l.
|
||||
* apply equiv_subset1_r.
|
||||
Defined.
|
||||
|
||||
Lemma eq_subset (X Y : FSet A) :
|
||||
X = Y <~> (Y ⊆ X * X ⊆ Y).
|
||||
Proof.
|
||||
transitivity ((Y ∪ X = X) * (X ∪ Y = Y)).
|
||||
apply eq_subset'.
|
||||
symmetry.
|
||||
eapply equiv_functor_prod'; apply subset_union_equiv.
|
||||
etransitivity ((Y ∪ X = X) * (X ∪ Y = Y)).
|
||||
- apply eq_subset2.
|
||||
- symmetry.
|
||||
eapply equiv_functor_prod' ; apply subset_union_equiv.
|
||||
Defined.
|
||||
|
||||
Theorem fset_ext (X Y : FSet A) :
|
||||
X = Y <~> (forall (a : A), a ∈ X = a ∈ Y).
|
||||
Proof.
|
||||
refine (@equiv_compose' _ _ _ _ _) ; [ | apply eq_subset ].
|
||||
refine (@equiv_compose' _ ((forall a, a ∈ Y -> a ∈ X)
|
||||
*(forall a, a ∈ X -> a ∈ Y)) _ _ _).
|
||||
- apply equiv_iff_hprop_uncurried.
|
||||
split.
|
||||
* intros [H1 H2 a].
|
||||
specialize (H1 a) ; specialize (H2 a).
|
||||
apply path_iff_hprop.
|
||||
apply H2.
|
||||
apply H1.
|
||||
* intros H1.
|
||||
split ; intro a ; intro H2.
|
||||
+ rewrite (H1 a).
|
||||
apply H2.
|
||||
+ rewrite <- (H1 a).
|
||||
apply H2.
|
||||
- eapply equiv_functor_prod' ;
|
||||
apply equiv_iff_hprop_uncurried ;
|
||||
split ; apply subset_isIn.
|
||||
Defined.
|
||||
|
||||
End ext.
|
||||
End ext.
|
||||
@@ -1,68 +0,0 @@
|
||||
(** Extensionality of the FSets *)
|
||||
Require Import HoTT HitTactics.
|
||||
Require Import representations.definition fsets.operations.
|
||||
|
||||
Section ext.
|
||||
Context {A : Type}.
|
||||
Context `{Univalence}.
|
||||
|
||||
Lemma equiv_subset1_l (X Y : FSet A) (H1 : Y ∪ X = X) (a : A) (Ya : a ∈ Y) : a ∈ X.
|
||||
Proof.
|
||||
apply (transport (fun Z => a ∈ Z) H1 (tr(inl Ya))).
|
||||
Defined.
|
||||
|
||||
Lemma equiv_subset1_r X : forall (Y : FSet A), (forall a, a ∈ Y -> a ∈ X) -> Y ∪ X = X.
|
||||
Proof.
|
||||
hinduction ; try (intros ; apply path_ishprop).
|
||||
- intros.
|
||||
apply nl.
|
||||
- intros b sub.
|
||||
specialize (sub b (tr idpath)).
|
||||
revert sub.
|
||||
hinduction X ; try (intros ; apply path_ishprop).
|
||||
* contradiction.
|
||||
* intros.
|
||||
strip_truncations.
|
||||
rewrite sub.
|
||||
apply union_idem.
|
||||
* intros X Y subX subY mem.
|
||||
strip_truncations.
|
||||
destruct mem as [t | t].
|
||||
** rewrite assoc, (subX t).
|
||||
reflexivity.
|
||||
** rewrite (comm X), assoc, (subY t).
|
||||
reflexivity.
|
||||
- intros Y1 Y2 H1 H2 H3.
|
||||
rewrite <- assoc.
|
||||
rewrite (H2 (fun a HY => H3 a (tr(inr HY)))).
|
||||
apply (H1 (fun a HY => H3 a (tr(inl HY)))).
|
||||
Defined.
|
||||
|
||||
Lemma eq_subset1 X Y : (Y ∪ X = X) * (X ∪ Y = Y) <~> forall (a : A), a ∈ X = a ∈ Y.
|
||||
Proof.
|
||||
eapply equiv_iff_hprop_uncurried ; split.
|
||||
- intros [H1 H2] a.
|
||||
apply path_iff_hprop ; apply equiv_subset1_l ; assumption.
|
||||
- intros H1.
|
||||
split ; apply equiv_subset1_r ; intros.
|
||||
* rewrite H1 ; assumption.
|
||||
* rewrite <- H1 ; assumption.
|
||||
Defined.
|
||||
|
||||
Lemma eq_subset2 (X Y : FSet A) : X = Y <~> (Y ∪ X = X) * (X ∪ Y = Y).
|
||||
Proof.
|
||||
eapply equiv_iff_hprop_uncurried ; split.
|
||||
- intro Heq.
|
||||
split.
|
||||
* apply (ap (fun Z => Z ∪ X) Heq^ @ union_idem X).
|
||||
* apply (ap (fun Z => Z ∪ Y) Heq @ union_idem Y).
|
||||
- intros [H1 H2].
|
||||
apply (H1^ @ comm Y X @ H2).
|
||||
Defined.
|
||||
|
||||
Theorem fset_ext (X Y : FSet A) :
|
||||
X = Y <~> forall (a : A), a ∈ X = a ∈ Y.
|
||||
Proof.
|
||||
apply (equiv_compose' (eq_subset1 X Y) (eq_subset2 X Y)).
|
||||
Defined.
|
||||
End ext.
|
||||
Reference in New Issue
Block a user