(* Contribution to the Coq Library   V6.3 (July 1999)                    *)
(***************************************************************************)
(* File: couples.v                                                         *)
(* auteur: alex@sysal.ibp.fr                                               *)
(* date: 19/10/95                                                          *)
(***************************************************************************)
Require Export axs_remplacement.
Definition couple (a b : E) := paire (singleton a) (paire a b).
(* Proof of lem_paire_prop2                                                *)
intros; unfold iff in |- *; split; intros.
elim (lem_paire_propertie a b a c); intros.
elim H0; intros; [ idtac | idtac | auto with zfc ]; elim H2; intros;
[ auto with zfc | rewrite <- H3; rewrite H4; reflexivity ].
rewrite H; reflexivity.
Qed.
(* End of proof of lem_paire_prop2                                         *)
(* Proof of lem_sing_eq_paire                                              *)
intros; unfold singleton in |- *; unfold iff in |- *; split; intros.
elim (lem_paire_propertie a a b c); intros.
elim H0; intros;
[ auto with zfc
| elim H2; intros; split; auto with zfc
| auto with zfc ].
elim H; intros; rewrite <- H0; rewrite <- H1; reflexivity.
Qed.
(* End of proof of lem_sing_eq_paire                                       *)
(* Proof of lem_couple_propertie                                           *)
unfold couple in |- *; intros.
unfold iff in |- *; split; intros.
elim
(lem_paire_propertie (singleton al) (paire al bl)
(singleton ar) (paire ar br)); intros.
clear H1; elim H0; clear H0; intros; [ idtac | idtac | auto with zfc ];
elim H0; clear H0; intros.
elim (lem_singleton_propertie al ar); intros.
generalize H1; clear H1; elim H2; clear H2; intros;
[ idtac | auto with zfc ].
elim (lem_paire_prop2 al bl br); intros.
split; [ reflexivity | auto with zfc ].
elim (lem_sing_eq_paire al ar br); intros.
elim (lem_sing_eq_paire ar al bl); intros.
cut (singleton ar = paire al bl); intros;
[ idtac | symmetry  in |- *; auto with zfc ].
elim H2; intros; [ idtac | auto with zfc ].
elim H4; intros; [ idtac | auto with zfc ].
rewrite <- H10; rewrite <- H7; rewrite <- H8; split; reflexivity.
elim H; clear H; intros.
rewrite H; rewrite H0; reflexivity.
Qed.
(* End of proof of lem_couple_propertie                                    *)
(* Proof of lem_couple_propertie_lr                                        *)
intros; elim (lem_couple_propertie al ar bl br); intros; exact (H0 H).
Qed.
(* End of proof of lem_couple_propertie_lr                                 *)
(* Proof of lem_couple_propertie_rl                                        *)
intros; elim (lem_couple_propertie al ar bl br); intros; exact (H1 H).
Qed.
(* End of proof of lem_couple_propertie_rl                                 *)
(***************************************************************************)
(* Produit cartesien de deux ensembles                                     *)
(***************************************************************************)
Definition cartesien (a b : E) :=
subset
(fun u : E =>
exists x : E, (exists y : E, In x a /\ In y b /\ u = couple x y))
(parties (parties (union a b))).
(* Proof of lem_cartesian_propertie                                        *)
intros; unfold cartesien in |- *.
elim
(axs_comprehension
(fun u : E =>
exists x0 : E, (exists y : E, In x0 a /\ In y b /\ u = couple x0 y))
(parties (parties (union a b))) x); intros.
unfold iff in |- *; split; intros.
elim H; clear H; clear H0; intros; [ idtac | auto with zfc ].
do 2 (elim H0; clear H0; intros); exists x0; exists x1; auto with zfc.
do 2 (elim H1; clear H1; intros); clear H; apply H0; clear H0.
split; [ idtac | exists x0; exists x1; auto with zfc ].
elim H1; clear H1; intros; elim H0; clear H0; intros.
elim (axs_parties (parties (union a b)) x); intros.
clear H2; apply H3; clear H3; intros.
elim (axs_parties (union a b) v3); intros.
clear H3; apply H4; clear H4; intros.
elim (lem_union_propertie a b v0); intros.
clear H4; apply H5; clear H5; intros.
unfold couple in H1.
elim (axs_paire (singleton x0) (paire x0 x1) v3); intros.
generalize H2; rewrite H1; intros.
clear H5; elim H4; clear H4; intros; [ idtac | idtac | auto with zfc ].
generalize H3; rewrite H4; intros.
elim (lem_in_singleton x0 v0); intros.
generalize H; clear H8; elim H7; clear H7; intros;
[ idtac | auto with zfc ]; left; auto with zfc.
generalize H3; rewrite H4; intros.
elim (axs_paire x0 x1 v0); intros.
clear H8; elim H7; clear H7; intros;
[ rewrite H7; left; auto with zfc
| rewrite H7; right; auto with zfc
| auto with zfc ].
Qed.
(* End of proof of lem_cartesian_propertie                                 *)
(* Proof of lem_cartesian_cons                                             *)
intros; unfold cartesien in |- *.
elim
(axs_comprehension
(fun u : E =>
exists x0 : E, (exists y0 : E, In x0 a /\ In y0 b /\ u = couple x0 y0))
(parties (parties (union a b))) (couple x y));
intros; apply H2; clear H1 H2; intros.
split;
[ idtac
| exists x; exists y; split;
[ auto with zfc | split; [ auto with zfc | reflexivity ] ] ].
elim (axs_parties (parties (union a b)) (couple x y)); intros; apply H2;
clear H1 H2; intros.
elim (axs_parties (union a b) v3); intros; apply H3; clear H2 H3; intros.
unfold couple in H1; generalize (axs_paire (singleton x) (paire x y) v3);
unfold iff in |- *; intros.
elim H3; clear H3; intros.
generalize (H3 H1); clear H3 H4; intros.
elim H3; clear H3; intros.
generalize H2; clear H2; rewrite H3; clear H3; intros.
elim (lem_in_singleton x v0); intros.
generalize (H3 H2); clear H2 H3 H4; intros; rewrite H2.
elim (lem_union_propertie a b x); intros.
apply H4; left; auto with zfc.
generalize H2; clear H2; rewrite H3; clear H3; intros.
elim (axs_paire x y v0); intros.
generalize (H3 H2); clear H2 H3 H4; intros; elim H2; clear H2; intros.
rewrite H2; clear H2; elim (lem_union_propertie a b x); intros.
apply H3; left; auto with zfc.
rewrite H2; clear H2; elim (lem_union_propertie a b y); intros.
apply H3; right; auto with zfc.
Qed.
(* End of proof of lem_cartesian_cons                                      *)
(***************************************************************************)
(* Somme disjointe de deux ensembles                                       *)
(***************************************************************************)
(* Old Release                                                             *)
Parameter Odisj_l : E -> E.
Axiom
axs_Odisj_l :
forall a x : E,
In x (Odisj_l a) <-> (exists y : E, In y a /\ x = couple y Vide).
Parameter Odisj_r : E -> E.
Axiom
axs_Odisj_r :
forall a x : E,
In x (Odisj_r a) <->
(exists y : E, In y a /\ x = couple y (singleton Vide)).
Definition Osomme_disj (a b : E) := union (Odisj_l a) (Odisj_r b).
(* New Release                                                             *)
Definition disj_l (a : E) :=
subset (fun y : E => exists x : E, y = couple x Vide /\ In x a)
(cartesien a (singleton Vide)).
Definition disj_r (a : E) :=
subset (fun y : E => exists x : E, y = couple x (singleton Vide) /\ In x a)
(cartesien a (singleton (singleton Vide))).
Definition somme_disj (a b : E) := union (disj_l a) (disj_r b).

(* Old and New                                                             *)
Lemma lem_OaN : forall a b : E, somme_disj a b = Osomme_disj a b.