(* 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                                 *)

Lemma lem_couple_propertie_rl :
forall al ar bl br : E, al = ar /\ bl = br -> couple al bl = couple ar br.