mirror of https://github.com/nmvdw/HITs-Examples
Merge remote-tracking branch 'origin/bloop' into properties
This commit is contained in:
Niels
commit
954c273ddf
|
|
@ -1,6 +1,5 @@
|
|||
Require Import HoTT HitTactics.
|
||||
Require Import definition.
|
||||
|
||||
Section operations.
|
||||
|
||||
Context {A : Type}.
|
||||
|
|
@ -48,4 +47,22 @@ intros X Y.
|
|||
apply (comprehension (fun (a : A) => isIn a X) Y).
|
||||
Defined.
|
||||
|
||||
|
||||
Definition subset :
|
||||
FSet A -> FSet A -> Bool.
|
||||
Proof.
|
||||
intros X Y.
|
||||
hrecursion X.
|
||||
- exact true.
|
||||
- exact (fun a => (a ∈ Y)).
|
||||
- exact andb.
|
||||
- intros. compute. destruct x; reflexivity.
|
||||
- intros x y; compute; destruct x, y; reflexivity.
|
||||
- intros x; compute; destruct x; reflexivity.
|
||||
- intros x; compute; destruct x; reflexivity.
|
||||
- intros x; cbn; destruct (x ∈ Y); reflexivity.
|
||||
Defined.
|
||||
|
||||
Notation "⊆" := subset.
|
||||
|
||||
End operations.
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
Require Import HoTT HitTactics.
|
||||
Require Import definition operations.
|
||||
Require Export definition operations.
|
||||
|
||||
Section properties.
|
||||
|
||||
|
|
@ -20,8 +20,7 @@ try (intros ; apply set_path2) ; cbn.
|
|||
rewrite P.
|
||||
rewrite (comm y x).
|
||||
rewrite <- (assoc x y y).
|
||||
rewrite Q.
|
||||
reflexivity.
|
||||
f_ap.
|
||||
Defined.
|
||||
|
||||
|
||||
|
|
@ -177,26 +176,29 @@ Defined.
|
|||
|
||||
Theorem intersection_idem : forall (X : FSet A), intersection X X = X.
|
||||
Proof.
|
||||
hinduction; try (intros; apply set_path2).
|
||||
hinduction; try (intros ; apply set_path2).
|
||||
- reflexivity.
|
||||
- intro a.
|
||||
destruct (dec (a = a)).
|
||||
* reflexivity.
|
||||
* contradiction (n idpath).
|
||||
- intros X Y IHX IHY.
|
||||
f_ap;
|
||||
unfold intersection in *.
|
||||
rewrite comprehension_or.
|
||||
rewrite comprehension_or.
|
||||
+ transitivity (U (comprehension (fun a => isIn a X) X) (comprehension (fun a => isIn a Y) X)).
|
||||
apply comprehension_or.
|
||||
rewrite IHX.
|
||||
rewrite IHY.
|
||||
rewrite comprehension_subset.
|
||||
rewrite (comm X).
|
||||
rewrite comprehension_subset.
|
||||
reflexivity.
|
||||
apply comprehension_subset.
|
||||
+ transitivity (U (comprehension (fun a => isIn a X) Y) (comprehension (fun a => isIn a Y) Y)).
|
||||
apply comprehension_or.
|
||||
rewrite IHY.
|
||||
apply comprehension_subset.
|
||||
Defined.
|
||||
|
||||
(** assorted lattice laws *)
|
||||
Lemma distributive_La (z : FSet A) (a : A) : forall Y : FSet A, intersection (U (L a) z) Y = U (intersection (L a) Y) (intersection z Y).
|
||||
Lemma distributive_La (z : FSet A) (a : A) : forall Y : FSet A,
|
||||
intersection (U (L a) z) Y = U (intersection (L a) Y) (intersection z Y).
|
||||
Proof.
|
||||
hinduction; try (intros ; apply set_path2) ; cbn.
|
||||
- symmetry ; apply nl.
|
||||
|
|
@ -265,11 +267,10 @@ hinduction x; try (intros ; apply set_path2) ; cbn.
|
|||
cbn.
|
||||
rewrite P.
|
||||
rewrite Q.
|
||||
destruct (isIn a X1) ; destruct (isIn a X2) ; destruct (isIn a y) ; reflexivity.
|
||||
destruct (isIn a X1) ; destruct (isIn a X2) ; destruct (isIn a y) ;
|
||||
reflexivity.
|
||||
Defined.
|
||||
|
||||
|
||||
|
||||
Theorem intersection_assoc (X Y Z: FSet A) :
|
||||
intersection X (intersection Y Z) = intersection (intersection X Y) Z.
|
||||
Proof.
|
||||
|
|
@ -312,14 +313,12 @@ hinduction; try (intros ; apply set_path2).
|
|||
* reflexivity.
|
||||
* contradiction (n idpath).
|
||||
- intros X1 X2 P Q.
|
||||
rewrite comprehension_or.
|
||||
rewrite comprehension_or.
|
||||
rewrite P.
|
||||
f_ap; (etransitivity; [ apply comprehension_or |]).
|
||||
rewrite P. rewrite (comm X1).
|
||||
apply comprehension_subset.
|
||||
|
||||
rewrite Q.
|
||||
rewrite comprehension_subset.
|
||||
rewrite (comm X1).
|
||||
rewrite comprehension_subset.
|
||||
reflexivity.
|
||||
apply comprehension_subset.
|
||||
Defined.
|
||||
|
||||
|
||||
|
|
@ -336,17 +335,22 @@ hinduction X1; try (intros ; apply set_path2) ; cbn.
|
|||
rewrite p.
|
||||
rewrite comprehension_subset.
|
||||
reflexivity.
|
||||
- intros. unfold intersection. (* TODO isIn is simplified too much *)
|
||||
rewrite comprehension_or.
|
||||
rewrite comprehension_or.
|
||||
(* rewrite intersection_La. *)
|
||||
- intros.
|
||||
assert (Y = intersection (U (L a) Y) Y) as HY.
|
||||
{ unfold intersection. symmetry.
|
||||
transitivity (U (comprehension (fun x => isIn x (L a)) Y) (comprehension (fun x => isIn x Y) Y)).
|
||||
apply comprehension_or.
|
||||
rewrite comprehension_all.
|
||||
apply comprehension_subset. }
|
||||
rewrite <- HY.
|
||||
admit.
|
||||
- unfold intersection.
|
||||
cbn.
|
||||
intros Z1 Z2 P Q.
|
||||
rewrite comprehension_or.
|
||||
assert (U (U (comprehension (fun a : A => isIn a Z1) X2) (comprehension (fun a : A => isIn a Z2) X2))
|
||||
Y = U (U (comprehension (fun a : A => isIn a Z1) X2) (comprehension (fun a : A => isIn a Z2) X2))
|
||||
assert (U (U (comprehension (fun a : A => isIn a Z1) X2)
|
||||
(comprehension (fun a : A => isIn a Z2) X2))
|
||||
Y = U (U (comprehension (fun a : A => isIn a Z1) X2)
|
||||
(comprehension (fun a : A => isIn a Z2) X2))
|
||||
(U Y Y)).
|
||||
rewrite (union_idem Y).
|
||||
reflexivity.
|
||||
|
|
@ -354,20 +358,24 @@ hinduction X1; try (intros ; apply set_path2) ; cbn.
|
|||
rewrite <- assoc.
|
||||
rewrite (assoc (comprehension (fun a : A => isIn a Z2) X2)).
|
||||
rewrite Q.
|
||||
rewrite (comm (U (comprehension (fun a : A => (isIn a Z2 || isIn a Y)%Bool) X2)
|
||||
cbn.
|
||||
rewrite
|
||||
(comm (U (comprehension (fun a : A => (isIn a Z2 || isIn a Y)%Bool) X2)
|
||||
(comprehension (fun a : A => (isIn a Z2 || isIn a Y)%Bool) Y)) Y).
|
||||
rewrite assoc.
|
||||
rewrite P.
|
||||
rewrite <- assoc.
|
||||
rewrite <- assoc. cbn.
|
||||
rewrite (assoc (comprehension (fun a : A => (isIn a Z1 || isIn a Y)%Bool) Y)).
|
||||
rewrite (comm (comprehension (fun a : A => (isIn a Z1 || isIn a Y)%Bool) Y)).
|
||||
rewrite <- assoc.
|
||||
rewrite assoc.
|
||||
enough (C : (U (comprehension (fun a : A => (isIn a Z1 || isIn a Y)%Bool) X2)
|
||||
(comprehension (fun a : A => (isIn a Z2 || isIn a Y)%Bool) X2)) = (comprehension (fun a : A => (isIn a Z1 || isIn a Z2 || isIn a Y)%Bool) X2)).
|
||||
(comprehension (fun a : A => (isIn a Z2 || isIn a Y)%Bool) X2))
|
||||
= (comprehension (fun a : A => (isIn a Z1 || isIn a Z2 || isIn a Y)%Bool) X2)).
|
||||
rewrite C.
|
||||
enough (D : (U (comprehension (fun a : A => (isIn a Z1 || isIn a Y)%Bool) Y)
|
||||
(comprehension (fun a : A => (isIn a Z2 || isIn a Y)%Bool) Y)) = (comprehension (fun a : A => (isIn a Z1 || isIn a Z2 || isIn a Y)%Bool) Y)).
|
||||
(comprehension (fun a : A => (isIn a Z2 || isIn a Y)%Bool) Y))
|
||||
= (comprehension (fun a : A => (isIn a Z1 || isIn a Z2 || isIn a Y)%Bool) Y)).
|
||||
rewrite D.
|
||||
reflexivity.
|
||||
* repeat (rewrite comprehension_or).
|
||||
|
|
@ -429,10 +437,166 @@ hrecursion X; try (intros ; apply set_path2).
|
|||
rewrite <- Q.
|
||||
Admitted.
|
||||
|
||||
<<<<<<< HEAD
|
||||
Theorem union_isIn (X Y : FSet A) (a : A) : isIn a (U X Y) = orb (isIn a X) (isIn a Y).
|
||||
Proof.
|
||||
reflexivity.
|
||||
Defined.
|
||||
|
||||
|
||||
=======
|
||||
|
||||
(* Properties about subset relation. *)
|
||||
Lemma subset_union `{Funext} (X Y : FSet A) :
|
||||
subset X Y = true -> U X Y = Y.
|
||||
Proof.
|
||||
hinduction X; try (intros; apply path_forall; intro; apply set_path2).
|
||||
- intros. apply nl.
|
||||
- intros a. hinduction Y;
|
||||
try (intros; apply path_forall; intro; apply set_path2).
|
||||
+ intro. contradiction (false_ne_true).
|
||||
+ intros. destruct (dec (a = a0)).
|
||||
rewrite p; apply idem.
|
||||
contradiction (false_ne_true).
|
||||
+ intros X1 X2 IH1 IH2.
|
||||
intro Ho.
|
||||
destruct (isIn a X1);
|
||||
destruct (isIn a X2).
|
||||
* specialize (IH1 idpath).
|
||||
rewrite assoc. f_ap.
|
||||
* specialize (IH1 idpath).
|
||||
rewrite assoc. f_ap.
|
||||
* specialize (IH2 idpath).
|
||||
rewrite (comm X1 X2).
|
||||
rewrite assoc. f_ap.
|
||||
* contradiction (false_ne_true).
|
||||
- intros X1 X2 IH1 IH2 G.
|
||||
destruct (subset X1 Y);
|
||||
destruct (subset X2 Y).
|
||||
* specialize (IH1 idpath).
|
||||
specialize (IH2 idpath).
|
||||
rewrite <- assoc. rewrite IH2. apply IH1.
|
||||
* contradiction (false_ne_true).
|
||||
* contradiction (false_ne_true).
|
||||
* contradiction (false_ne_true).
|
||||
Defined.
|
||||
|
||||
Lemma eq1 (X Y : FSet A) : X = Y <~> (U Y X = X) * (U 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.
|
||||
|
||||
|
||||
Lemma subset_union_l `{Funext} X :
|
||||
forall Y, subset X (U X Y) = true.
|
||||
hinduction X;
|
||||
try (intros; apply path_forall; intro; apply set_path2).
|
||||
- reflexivity.
|
||||
- intros a Y. destruct (dec (a = a)).
|
||||
* reflexivity.
|
||||
* by contradiction n.
|
||||
- intros X1 X2 HX1 HX2 Y.
|
||||
enough (subset X1 (U (U X1 X2) Y) = true).
|
||||
enough (subset X2 (U (U X1 X2) Y) = true).
|
||||
rewrite X. rewrite X0. reflexivity.
|
||||
{ rewrite (comm X1 X2).
|
||||
rewrite <- (assoc X2 X1 Y).
|
||||
apply (HX2 (U X1 Y)). }
|
||||
{ rewrite <- (assoc X1 X2 Y). apply (HX1 (U X2 Y)). }
|
||||
Defined.
|
||||
|
||||
Lemma subset_union_equiv `{Funext}
|
||||
: forall X Y : FSet A, subset X Y = true <~> U X Y = Y.
|
||||
Proof.
|
||||
intros X Y.
|
||||
unshelve eapply BuildEquiv.
|
||||
apply subset_union.
|
||||
unshelve esplit.
|
||||
{ intros HXY. rewrite <- HXY. clear HXY.
|
||||
apply subset_union_l. }
|
||||
all: intro; apply set_path2.
|
||||
Defined.
|
||||
|
||||
Lemma eq_subset `{Funext} (X Y : FSet A) :
|
||||
X = Y <~> ((subset Y X = true) * (subset X Y = true)).
|
||||
Proof.
|
||||
transitivity ((U Y X = X) * (U X Y = Y)).
|
||||
apply eq1.
|
||||
symmetry.
|
||||
eapply equiv_functor_prod'; apply subset_union_equiv.
|
||||
Defined.
|
||||
|
||||
Lemma subset_isIn `{FE : Funext} (X Y : FSet A) :
|
||||
(forall (a : A), isIn a X = true -> isIn a Y = true)
|
||||
<-> (subset X Y = true).
|
||||
Proof.
|
||||
split.
|
||||
- hinduction X ; try (intros ; apply path_forall ; intro ; apply set_path2).
|
||||
* intros ; reflexivity.
|
||||
* intros a H.
|
||||
apply H.
|
||||
destruct (dec (a = a)).
|
||||
+ reflexivity.
|
||||
+ contradiction (n idpath).
|
||||
* intros X1 X2 H1 H2 H.
|
||||
enough (subset X1 Y = true).
|
||||
rewrite X.
|
||||
enough (subset X2 Y = true).
|
||||
rewrite X0.
|
||||
reflexivity.
|
||||
+ apply H2.
|
||||
intros a Ha.
|
||||
apply H.
|
||||
rewrite Ha.
|
||||
destruct (isIn a X1) ; reflexivity.
|
||||
+ apply H1.
|
||||
intros a Ha.
|
||||
apply H.
|
||||
rewrite Ha.
|
||||
reflexivity.
|
||||
- hinduction X .
|
||||
* intros. contradiction (false_ne_true X0).
|
||||
* intros b H a.
|
||||
destruct (dec (a = b)).
|
||||
+ intros ; rewrite p ; apply H.
|
||||
+ intros X ; contradiction (false_ne_true X).
|
||||
* intros X1 X2.
|
||||
intros IH1 IH2 H1 a H2.
|
||||
destruct (subset X1 Y) ; destruct (subset X2 Y);
|
||||
cbv in H1; try by contradiction false_ne_true.
|
||||
specialize (IH1 idpath a). specialize (IH2 idpath a).
|
||||
destruct (isIn a X1); destruct (isIn a X2);
|
||||
cbv in H2; try by contradiction false_ne_true.
|
||||
by apply IH1.
|
||||
by apply IH1.
|
||||
by apply IH2.
|
||||
* repeat (intro; intros; apply path_forall).
|
||||
intros; intro; intros; apply set_path2.
|
||||
* repeat (intro; intros; apply path_forall).
|
||||
intros; intro; intros; apply set_path2.
|
||||
* repeat (intro; intros; apply path_forall).
|
||||
intros; intro; intros; apply set_path2.
|
||||
* repeat (intro; intros; apply path_forall).
|
||||
intros; intro; intros; apply set_path2.
|
||||
* repeat (intro; intros; apply path_forall);
|
||||
intros; intro; intros; apply set_path2.
|
||||
Defined.
|
||||
|
||||
Theorem fset_ext `{Funext} (X Y : FSet A) :
|
||||
X = Y <~> (forall (a : A), isIn a X = isIn a Y).
|
||||
Proof.
|
||||
etransitivity. apply eq_subset.
|
||||
transitivity
|
||||
((forall a, isIn a Y = true -> isIn a X = true)
|
||||
*(forall a, isIn a X = true -> isIn a Y = true)).
|
||||
- eapply equiv_functor_prod'. admit. admit.
|
||||
- eapply equiv_functor_prod'.
|
||||
Admitted.
|
||||
|
||||
End properties.
|
||||
|
|
|
|||
Loading…
Reference in New Issue