diff --git a/FiniteSets/disjunction.v b/FiniteSets/disjunction.v index 9aacaa5..0475146 100644 --- a/FiniteSets/disjunction.v +++ b/FiniteSets/disjunction.v @@ -13,64 +13,41 @@ Section lor_props. Context `{Univalence}. Variable X Y Z : hProp. + Local Ltac lor_intros := + let x := fresh in intro x + ; repeat (strip_truncations ; destruct x as [x | x]). + + Lemma lor_assoc : (X ∨ Y) ∨ Z = X ∨ Y ∨ Z. Proof. - apply path_iff_hprop ; cbn. - * simple refine (Trunc_ind _ _). - intros [xy | z] ; cbn. - + simple refine (Trunc_ind _ _ xy). - intros [x | y]. - ++ apply (tr (inl x)). - ++ apply (tr (inr (tr (inl y)))). - + apply (tr (inr (tr (inr z)))). - * simple refine (Trunc_ind _ _). - intros [x | yz] ; cbn. - + apply (tr (inl (tr (inl x)))). - + simple refine (Trunc_ind _ _ yz). - intros [y | z]. - ++ apply (tr (inl (tr (inr y)))). - ++ apply (tr (inr z)). - Defined. + apply path_iff_hprop ; lor_intros + ; apply tr ; auto + ; try (left ; apply tr) + ; try (right ; apply tr) ; auto. + Defined. Lemma lor_comm : X ∨ Y = Y ∨ X. Proof. - apply path_iff_hprop ; cbn. - * simple refine (Trunc_ind _ _). - intros [x | y]. - + apply (tr (inr x)). - + apply (tr (inl y)). - * simple refine (Trunc_ind _ _). - intros [y | x]. - + apply (tr (inr y)). - + apply (tr (inl x)). + apply path_iff_hprop ; lor_intros + ; apply tr ; auto. Defined. Lemma lor_nl : False_hp ∨ X = X. Proof. - apply path_iff_hprop ; cbn. - * simple refine (Trunc_ind _ _). - intros [ | x]. - + apply Empty_rec. - + apply x. - * apply (fun x => tr (inr x)). + apply path_iff_hprop ; lor_intros ; try contradiction + ; try (refine (tr(inr _))) ; auto. Defined. Lemma lor_nr : X ∨ False_hp = X. Proof. - apply path_iff_hprop ; cbn. - * simple refine (Trunc_ind _ _). - intros [x | ]. - + apply x. - + apply Empty_rec. - * apply (fun x => tr (inl x)). + apply path_iff_hprop ; lor_intros ; try contradiction + ; try (refine (tr(inl _))) ; auto. Defined. Lemma lor_idem : X ∨ X = X. Proof. - apply path_iff_hprop ; cbn. - - simple refine (Trunc_ind _ _). - intros [x | x] ; apply x. - - apply (fun x => tr (inl x)). + apply path_iff_hprop ; lor_intros + ; try(refine (tr(inl _))) ; auto. Defined. End lor_props. diff --git a/FiniteSets/fsets/extensionality_alt.v b/FiniteSets/fsets/extensionality_alt.v index 34701f2..7c2cc1d 100644 --- a/FiniteSets/fsets/extensionality_alt.v +++ b/FiniteSets/fsets/extensionality_alt.v @@ -6,23 +6,20 @@ 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. + Lemma equiv_subset1_l (X Y : FSet A) (H1 : Y ∪ X = X) (a : A) (Ya : a ∈ Y) : a ∈ X. Proof. - intros X Y H1 a Ya. - rewrite <- H1. - apply (tr(inl Ya)). + apply (transport (fun Z => a ∈ Z) H1 (tr(inl Ya))). Defined. - - Lemma equiv_subset_r : forall (X Y : FSet A), (forall a, a ∈ Y -> a ∈ X) -> Y ∪ X = X. + + Lemma equiv_subset1_r X : forall (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). + 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_forall ; intro ; apply path_ishprop). + hinduction X ; try (intros ; apply path_ishprop). * contradiction. * intros. strip_truncations. @@ -30,45 +27,42 @@ Section ext. apply union_idem. * intros X Y subX subY mem. strip_truncations. - destruct mem. - ** rewrite assoc. - rewrite (subX t). + destruct mem as [t | t]. + ** rewrite assoc, (subX t). reflexivity. - ** rewrite (comm X). - rewrite assoc. - rewrite (subY t). + ** 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)))). - rewrite (H1 (fun a HY => H3 a (tr(inl HY)))). - reflexivity. - Defined. + apply (H1 (fun a HY => H3 a (tr(inl HY)))). + Defined. - Lemma eq_subset' (X Y : FSet A) : X = Y <~> (Y ∪ X = X) * (X ∪ Y = Y). + 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. - 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. + 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). + 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. + apply (equiv_compose' (eq_subset1 X Y) (eq_subset2 X Y)). Defined. - End ext. \ No newline at end of file