(* Contribution to the Coq Library   V6.3 (July 1999)                    *)
(***************************************************************************)
(* File: axs_comprehension.v                                               *)
(* auteur: alex@sysal.ibp.fr                                               *)
(* date: 19/10/95                                                          *)
(***************************************************************************)
Require Export axs_parties.
(***************************************************************************)
(* Schema d'axiome de comprehension                                        *)
(***************************************************************************)
Parameter subset : (E -> Prop) -> E -> E.
Axiom
axs_comprehension :
forall (F : E -> Prop) (a v0 : E), In v0 (subset F a) <-> In v0 a /\ F v0.
(* Proof of lem_comprehension_lr                                           *)
intros; elim (axs_comprehension F a v0); intros; exact (H0 H).
Qed.
(* End of proof of lem_comprehension_lr                                    *)
(* Proof of lem_comprehension_rl                                           *)
intros; elim (axs_comprehension F a v0); intros; exact (H1 H).
Qed.
(* End of proof of lem_comprehension_rl                                    *)
(***************************************************************************)
(* Consequences                                                            *)
(***************************************************************************)
(***************************************************************************)
(* Existence de l'ensemble vide                                            *)
(***************************************************************************)
Definition def_F_vide (v0 : E) := v0 <> v0.
Definition vide (a : E) := subset def_F_vide a.
(* Proof of lem_vide_propertie                                             *)
intros; unfold vide in |- *; unfold def_F_vide in |- *; unfold not in |- *;
intros.
elim (axs_comprehension def_F_vide v1 v0); unfold def_F_vide in |- *;
unfold not in |- *; intros.
elim H0; clear H0; intros.
clear H; clear H1; clear H0; apply H2; clear H2; reflexivity.
apply H1; clear H1.
split.
elim (axs_comprehension def_F_vide v1 v0); unfold def_F_vide in |- *;
unfold not in |- *; intros.
elim H0; clear H0; intros; assumption.
elim (axs_comprehension def_F_vide v1 v0); unfold def_F_vide in |- *;
unfold not in |- *; intros.
elim H0; clear H0; intros.
apply H3; reflexivity.
assumption.
Qed.
(* End of proof of lem_vide_existence                                      *)
(* Proof of lem_vide_unicite                                               *)
intros; apply axs_extensionnalite; unfold iff in |- *; split; intros.
generalize (lem_vide_propertie v2 v0); intros; elim H0; assumption.
generalize (lem_vide_propertie v2 v1); intros; elim H0; assumption.
Qed.
(* End of proof of lem_vide_unicite                                        *)
Parameter var_vide : E.
Definition Vide := vide var_vide.
(* Proof of lem_x_inc_vide                                                 *)
intros.
unfold inc in H.
apply axs_extensionnalite; intros; unfold iff in |- *; split; intros.
exact (H v2 H0).
generalize (lem_vide_propertie v2 var_vide); intros.
unfold Vide in H0.
absurd (In v2 (vide var_vide)); auto with zfc.
Qed.
(* End of proof of lem_x_inc_vide                                          *)
(* Proof of lem_x_noteq_vide                                               *)
intros.
unfold not in |- *; intros.
generalize H; clear H; rewrite H0; intros.
generalize (lem_vide_propertie y var_vide); intros; unfold Vide in H.
absurd (In y (vide var_vide)); auto with zfc.
Qed.
(* End of proof of lem_x_noteq_vide                                        *)
(* Proof of lem_paire_not_empty                                            *)
intros.
cut (In a (paire a b)); intros.
unfold not in |- *; intros.
generalize H; clear H; rewrite H0; intros.
generalize (lem_vide_propertie a var_vide); intros; unfold Vide in H.
absurd (In a (vide var_vide)); auto with zfc.
elim (axs_paire a b a); intros; apply H0; left; reflexivity.
Qed.
(* End of proof of lem_paire_not_empty                                     *)
(* Proof of lem_not_vide_in_vide                                           *)
unfold not in |- *; intros.
absurd (Vide = Vide); [ unfold not in |- *; intros | reflexivity ].
generalize (lem_x_noteq_vide Vide Vide H); intros.
tauto.
Qed.
(* End of proof of lem_not_vide_in_vide                                    *)
(***************************************************************************)
(* Intersection de deux ensembles                                          *)
(***************************************************************************)
Definition def_F_inter (s x : E) := In x s.
Definition inter (a b : E) := subset (def_F_inter b) a.
(* Proof of lem_inter_propertie                                            *)
intros; unfold iff in |- *; unfold inter in |- *; unfold def_F_inter in |- *;
split; intros.
elim (axs_comprehension (def_F_inter b) a x); unfold def_F_inter in |- *;
intros; auto with zfc.
elim (axs_comprehension (def_F_inter b) a x); unfold def_F_inter in |- *;
intros; auto with zfc.
Qed.
(* End of proof of lem_inter_propertie                                     *)
(* Proof of lem_inter_propertie_lr                                         *)
intros; elim (lem_inter_propertie a b x); intros; exact (H0 H).
Qed.
(* End of proof of lem_inter_propertie_lr                                  *)
(* Proof of lem_inter_propertie_rl                                         *)
intros; elim (lem_inter_propertie a b x); intros; exact (H1 H).
Qed.
(* End of proof of lem_inter_propertie_rl                                  *)
(* Proof of lem_inter_unicite                                              *)
intros; apply axs_extensionnalite; intros.
elim (H v2); clear H; intros.
elim (lem_inter_propertie a b v2); intros; split; intros; auto with zfc.
Qed.
(* End of proof of lem_inter_unicite                                       *)
(* Proof of lem_inter_vide_prop                                            *)
intros; unfold inter in |- *; apply axs_extensionnalite; intros;
unfold iff in |- *; split; intros.
elim (axs_comprehension (def_F_inter Vide) x v2); intros; generalize (H0 H);
clear H H0 H1; intros.
elim H; clear H; unfold def_F_inter in |- *; intros; auto with zfc.
elim (axs_comprehension (def_F_inter Vide) x v2); intros; apply H1;
clear H0 H1; intros.
unfold def_F_inter in |- *.
split; [ idtac | auto with zfc ].
generalize (lem_vide_propertie v2 var_vide); intros.
unfold Vide in H.
absurd (In v2 (vide var_vide)); auto with zfc.
Qed.
(* End of proof of lem_inter_vide_prop                                     *)
(* Proof of notEEexists                                                    *)
unfold not in |- *; intros; elim H; clear H; intros.
elim
(axs_comprehension (fun v0 : E => ~ In v0 v0) x
(subset (fun v0 : E => ~ In v0 v0) x)); intros.
generalize (H (subset (fun v0 : E => ~ In v0 v0) x)); intros.
absurd
(In (subset (fun v0 : E => ~ In v0 v0) x)
(subset (fun v0 : E => ~ In v0 v0) x)); tauto.
Qed.
(* End of proof of notEEexists                                             *)
(***************************************************************************)
(* Intersection d'un ensemble a                                            *)
(* a est un ensemble non vide. On recherche l'ensemble dont tous les       *)
(* elements sont elements des elements de a.                               *)
(***************************************************************************)
Definition Einter (a : E) (Ine : a <> Vide) :=
subset (fun v0 : E => forall v3 : E, In v3 a -> In v0 v3) (reunion a).
(* Proof of lem_Einter_propertie                                           *)
unfold Einter in |- *; intros.
elim
(axs_comprehension (fun v1 : E => forall v3 : E, In v3 a -> In v1 v3)
(reunion a) v0); intros; generalize (H1 H); clear H H1 H2;
intros.
elim H; clear H; intros.
exact (H1 v3 H0).
Qed.
(* End of proof of lem_Einter_propertie                                    *)

Lemma lem_Einter_sing :
forall a : E, Einter (singleton a) (lem_paire_not_empty a a) = a.