mirror of https://github.com/nmvdw/HITs-Examples
74 lines
2.1 KiB
Coq
74 lines
2.1 KiB
Coq
(** Extensionality of the FSets *)
|
||
Require Import HoTT HitTactics.
|
||
Require Import representations.definition fsets.operations.
|
||
|
||
Section ext.
|
||
Context {A : Type}.
|
||
Context `{Univalence}.
|
||
|
||
Lemma equiv_subset_l : forall (X Y : FSet A), Y ∪ X = X -> forall a, a ∈ Y -> a ∈ X.
|
||
Proof.
|
||
intros X Y H1 a Ya.
|
||
rewrite <- H1.
|
||
apply (tr(inl Ya)).
|
||
Defined.
|
||
|
||
Lemma equiv_subset_r : forall (X Y : FSet A), (forall a, a ∈ Y -> a ∈ X) -> Y ∪ X = X.
|
||
Proof.
|
||
intros X.
|
||
hinduction ; try (intros ; apply path_forall ; intro ; apply path_ishprop).
|
||
- intros.
|
||
apply nl.
|
||
- intros b sub.
|
||
specialize (sub b (tr idpath)).
|
||
revert sub.
|
||
hinduction X ; try (intros ; apply path_forall ; intro ; apply path_ishprop).
|
||
* contradiction.
|
||
* intros.
|
||
strip_truncations.
|
||
rewrite sub.
|
||
apply union_idem.
|
||
* intros X Y subX subY mem.
|
||
strip_truncations.
|
||
destruct mem.
|
||
** rewrite assoc.
|
||
rewrite (subX t).
|
||
reflexivity.
|
||
** rewrite (comm X).
|
||
rewrite assoc.
|
||
rewrite (subY t).
|
||
reflexivity.
|
||
- intros Y1 Y2 H1 H2 H3.
|
||
rewrite <- assoc.
|
||
rewrite (H2 (fun a HY => H3 a (tr(inr HY)))).
|
||
rewrite (H1 (fun a HY => H3 a (tr(inl HY)))).
|
||
reflexivity.
|
||
Defined.
|
||
|
||
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.
|
||
Defined.
|
||
|
||
Theorem fset_ext (X Y : FSet A) :
|
||
X = Y <~> (forall (a : A), a ∈ X = a ∈ Y).
|
||
Proof.
|
||
refine (@equiv_compose' _ _ _ _ _) ; [ | apply eq_subset' ].
|
||
eapply equiv_iff_hprop_uncurried ; split.
|
||
- intros [H1 H2 a].
|
||
apply path_iff_hprop ; apply equiv_subset_l ; assumption.
|
||
- intros H1.
|
||
split ; apply equiv_subset_r.
|
||
* intros a Ya.
|
||
rewrite (H1 a) ; assumption.
|
||
* intros a Xa.
|
||
rewrite <- (H1 a) ; assumption.
|
||
Defined.
|
||
|
||
End ext. |