(* Contribution to the Coq Library   V6.3 (July 1999)                    *)
(***************************************************************************)
(* File: ZFrelations.v                                                     *)
(* auteur: alex@sysal.ibp.fr                                               *)
(* date: 19/10/95                                                          *)
(***************************************************************************)
Require Export axs_fundation.
(***************************************************************************)
(***************************************************************************)
(* Une relation est un ensemble de couples                                 *)
(* Nous nous interessons ici aux relations binaires.                       *)
(***************************************************************************)
(***************************************************************************)
Definition rel (r : E) :=
forall c : E, In c r -> exists x : E, (exists y : E, c = couple x y).
Definition rel_sig (r a b : E) := inc r (cartesien a b).
(* Proof of lem_rel_sig_is_rel                                             *)
unfold rel_sig in |- *; unfold inc in |- *; intros.
unfold rel in |- *; intros.
generalize (H c H0); clear H H0; intros.
elim (lem_cartesian_propertie a b c); intros; generalize (H0 H);
clear H H0 H1; intros.
elim H; clear H; intros; elim H; clear H; intros; elim H; clear H; intros;
elim H0; clear H0; intros.
exists x; exists x0; auto with zfc.
Qed.
(* End of proof of lem_rel_sig_is_rel                                      *)
(* Proof of lem_rel_to_rel_sig                                             *)
intros.
unfold rel in H.
exists
(subset (fun z : E => exists t : E, In (couple z t) r) (reunion (reunion r))).
exists
(subset (fun t : E => exists z : E, In (couple z t) r) (reunion (reunion r))).
unfold rel_sig in |- *; unfold inc in |- *; intros.
generalize (H v0 H0); intros.
elim H1; clear H1; intros; elim H1; clear H1; intros.
elim
(lem_cartesian_propertie
(subset (fun z : E => exists t : E, In (couple z t) r)
(reunion (reunion r)))
(subset (fun t : E => exists z : E, In (couple z t) r)
(reunion (reunion r))) v0); intros; apply H3;
clear H2 H3; intros.
exists x; exists x0; split; [ idtac | split; [ idtac | auto with zfc ] ].
elim
(axs_comprehension (fun z : E => exists t : E, In (couple z t) r)
(reunion (reunion r)) x); intros; apply H3; clear H2 H3;
intros.
generalize H0; rewrite H1; intros.
split; [ idtac | exists x0; auto with zfc ].
elim (axs_reunion (reunion r) x); intros; apply H4; clear H3 H4; intros.
exists (singleton x); split; [ idtac | apply lem_x_in_sing_x ].
elim (axs_reunion r (singleton x)); intros; apply H4; clear H3 H4; intros.
exists (couple x x0); split; [ auto with zfc | idtac ].
unfold couple in |- *;
elim (axs_paire (singleton x) (paire x x0) (singleton x));
intros; apply H4; left; reflexivity.
generalize H0; rewrite H1; intros.
elim
(axs_comprehension (fun t : E => exists z : E, In (couple z t) r)
(reunion (reunion r)) x0); intros; apply H4; clear H3 H4;
intros.
split; [ idtac | exists x; auto with zfc ].
elim (axs_reunion (reunion r) x0); intros; apply H4; clear H3 H4; intros.
exists (paire x x0); split;
[ idtac | elim (axs_paire x x0 x0); intros; apply H4; right; reflexivity ].
elim (axs_reunion r (paire x x0)); intros; apply H4; clear H3 H4; intros.
exists (couple x x0); split;
[ auto with zfc
| elim (axs_paire (singleton x) (paire x x0) (paire x x0)); intros; apply H4;
right; reflexivity ].
Qed.
(* End of proof of lem_rel_to_rel_sig                                      *)
(***************************************************************************)
(***************************************************************************)
(* Notions de domaine et d'image d'une relation binaire                    *)
(***************************************************************************)
(***************************************************************************)
Definition rdom (r a b : E) (rRel : rel_sig r a b) :=
subset (fun x : E => exists y : E, In (couple x y) r) a.
Definition rImg (r a b : E) (rRel : rel_sig r a b) :=
subset (fun y : E => exists x : E, In (couple x y) r) b.
Definition rdom2 (r : E) (rRel : rel r) :=
subset (fun x : E => exists y : E, In (couple x y) r) (reunion (reunion r)).
Definition rImg2 (r : E) (rRel : rel r) :=
subset (fun y : E => exists x : E, In (couple x y) r) (reunion (reunion r)).
(* Proof of lem_rdom_eq_rdom2                                              *)
intros; apply axs_extensionnalite; unfold iff in |- *; split; intros.
unfold rdom in H.
elim (axs_comprehension (fun x : E => exists y : E, In (couple x y) r) a v2);
intros; generalize (H0 H); clear H H0 H1; intros.
elim H; clear H; intros.
elim H0; clear H0; intros.
unfold rdom2 in |- *.
elim
(axs_comprehension (fun x : E => exists y : E, In (couple x y) r)
(reunion (reunion r)) v2); intros; apply H2; clear H1 H2;
intros.
split; [ idtac | exists x; auto with zfc ].
elim (axs_reunion (reunion r) v2); intros; apply H2; clear H1 H2; intros.
exists (singleton v2); split; [ idtac | apply lem_x_in_sing_x ].
elim (axs_reunion r (singleton v2)); intros; apply H2; clear H1 H2; intros.
exists (couple v2 x); split;
[ auto with zfc
| unfold couple in |- *;
elim (axs_paire (singleton v2) (paire v2 x) (singleton v2));
intros; apply H2; left; reflexivity ].
unfold rdom2 in H.
elim
(axs_comprehension (fun x : E => exists y : E, In (couple x y) r)
(reunion (reunion r)) v2); intros; generalize (H0 H);
clear H H0 H1; intros.
elim H; clear H; intros; elim H0; clear H0; intros.
unfold rdom in |- *.
elim (axs_comprehension (fun x : E => exists y : E, In (couple x y) r) a v2);
intros; apply H2; clear H1 H2; intros.
split; [ idtac | exists x; auto with zfc ].
unfold rel_sig in rRel; unfold inc in rRel.
generalize (rRel (couple v2 x) H0); intros.
elim (lem_cartesian_propertie a b (couple v2 x)); intros; generalize (H2 H1);
clear H1 H2 H3; intros.
elim H1; clear H1; intros; elim H1; clear H1; intros; elim H1; clear H1;
intros; elim H2; clear H2; intros.
elim (lem_couple_propertie v2 x0 x x1); intros; generalize (H4 H3);
clear H3 H4 H5; intros.
elim H3; clear H3; intros.
generalize H1; rewrite H3; tauto.
Qed.
(* End of proof of lem_rdom_eq_rdom2                                       *)
(* Proof of lem_rImg_eq_rImg2                                              *)
intros; apply axs_extensionnalite; unfold iff in |- *; split; intros.
unfold rImg in H.
elim (axs_comprehension (fun y : E => exists x : E, In (couple x y) r) b v2);
intros; generalize (H0 H); clear H H0 H1; intros.
elim H; clear H; intros; elim H0; clear H0; intros.
unfold rImg2 in |- *.
elim
(axs_comprehension (fun y : E => exists x : E, In (couple x y) r)
(reunion (reunion r)) v2); intros; apply H2; clear H1 H2;
intros.
split; [ idtac | exists x; auto with zfc ].
elim (axs_reunion (reunion r) v2); intros; apply H2; clear H1 H2; intros.
exists (paire x v2); split;
[ idtac | elim (axs_paire x v2 v2); intros; apply H2; right; reflexivity ].
elim (axs_reunion r (paire x v2)); intros; apply H2; clear H1 H2; intros.
exists (couple x v2); split;
[ auto with zfc
| unfold couple in |- *;
elim (axs_paire (singleton x) (paire x v2) (paire x v2));
intros; apply H2; right; reflexivity ].
unfold rImg2 in H.
elim
(axs_comprehension (fun y : E => exists x : E, In (couple x y) r)
(reunion (reunion r)) v2); intros; generalize (H0 H);
clear H H0 H1; intros.
elim H; clear H; intros; elim H0; clear H0; intros.
unfold rImg in |- *.
elim (axs_comprehension (fun y : E => exists x : E, In (couple x y) r) b v2);
intros; apply H2; clear H1 H2; intros.
split; [ idtac | exists x; auto with zfc ].
unfold rel_sig in rRel; unfold inc in rRel.
generalize (rRel (couple x v2) H0); clear rRel H H0; intros.
elim (lem_cartesian_propertie a b (couple x v2)); intros; generalize (H0 H);
clear H H0 H1; intros.
elim H; clear H; intros; elim H; clear H; intros; elim H; clear H; intros;
elim H0; clear H0; intros.
elim (lem_couple_propertie x x0 v2 x1); intros; generalize (H2 H1);
clear H1 H2 H3; intros.
elim H1; clear H1; intros; generalize H0; rewrite H2; tauto.
Qed.
(* End of proof of lem_rImg_eq_rImg2                                       *)
(* Proof of lem_rel_and_rdom                                               *)
intros; unfold rdom in |- *.
elim (axs_comprehension (fun x0 : E => exists y : E, In (couple x0 y) r) a x);
intros; apply H1; clear H0 H1; intros.
split; [ idtac | exists y; auto with zfc ].
unfold rel_sig in rRel; unfold inc in rRel.
generalize (rRel (couple x y) H); intros.
elim (lem_cartesian_propertie a b (couple x y)); intros; generalize (H1 H0);
clear H0 H1 H2; intros.
elim H0; clear H0; intros; elim H0; clear H0; intros; elim H0; clear H0;
intros; elim H1; clear H1; intros.
elim (lem_couple_propertie x x0 y x1); intros; generalize (H3 H2);
clear H2 H3 H4; intros.
elim H2; clear H2; intros; generalize H0; rewrite H2; tauto.
Qed.
(* End of proof of lem_rel_and_rdom                                        *)
(* Proof of lem_rel_and_rdom2                                              *)
unfold rdom2 in |- *; intros.
elim
(axs_comprehension (fun x0 : E => exists y : E, In (couple x0 y) r)
(reunion (reunion r)) x); intros; apply H1; clear H0 H1;
intros.
split; [ idtac | exists y; auto with zfc ].
elim (axs_reunion (reunion r) x); intros; apply H1; clear H0 H1; intros.
exists (singleton x); split; [ idtac | apply lem_x_in_sing_x ].
elim (axs_reunion r (singleton x)); intros; apply H1; clear H0 H1; intros.
exists (couple x y); split; [ auto with zfc | idtac ].
elim (axs_paire (singleton x) (paire x y) (singleton x)); intros; apply H1;
clear H0 H1; intros.
left; reflexivity.
Qed.
(* End of proof of lem_rel_and_rdom2                                       *)
(* Proof of lem_rel_and_rImg                                               *)
unfold rImg in |- *; intros.
elim (axs_comprehension (fun y0 : E => exists x : E, In (couple x y0) r) b y);
intros; apply H1; clear H0 H1; intros.
split; [ idtac | exists x; auto with zfc ].
generalize (rRel (couple x y) H); intros.
elim (lem_cartesian_propertie a b (couple x y)); intros; generalize (H1 H0);
clear H0 H1 H2; intros.
elim H0; clear H0; intros; elim H0; clear H0; intros; elim H0; clear H0;
intros; elim H1; clear H1; intros.
elim (lem_couple_propertie x x0 y x1); intros; generalize (H3 H2);
clear H2 H3 H4; intros; elim H2; clear H2; intros.
rewrite H3; auto with zfc.
Qed.
(* End of proof of lem_rel_and_rImg                                        *)
(* Proof of lem_rel_and_rImg2                                              *)
unfold rImg2 in |- *; intros.
elim
(axs_comprehension (fun y0 : E => exists x : E, In (couple x y0) r)
(reunion (reunion r)) y); intros; apply H1; clear H0 H1;
intros.
split; [ idtac | exists x; auto with zfc ].
elim (axs_reunion (reunion r) y); intros; apply H1; clear H0 H1; intros.
exists (paire x y); split;
[ idtac
| elim (axs_paire x y y); intros; apply H1; intros; right; reflexivity ].
elim (axs_reunion r (paire x y)); intros; apply H1; clear H0 H1; intros.
exists (couple x y); split;
[ auto with zfc
| elim (axs_paire (singleton x) (paire x y) (paire x y)); intros; apply H1;
right; reflexivity ].
Qed.
(* End of proof of lem_rel_and_rImg2                                       *)
(***************************************************************************)
(***************************************************************************)
(* Relation partielle vs relation totale                                   *)
(* Nous considerons ici qu'une relation est totale si tous les elements de *)
(* son domaine sont "consommes" par la relation.                           *)
(***************************************************************************)
(***************************************************************************)
Definition rel_total (r a b : E) (rRel : rel_sig r a b) :=
rdom r a b rRel = a.
Definition rel_partiel (r a b : E) (rRel : rel_sig r a b) :=
exists x : E, In x a -> forall y : E, ~ In (couple x y) r.
(***************************************************************************)
(***************************************************************************)
(* Proprietes de base des relations                                        *)
(***************************************************************************)
(***************************************************************************)
(***************************************************************************)
(* Toute application est une relation                                      *)
(***************************************************************************)
(* Proof of lem_fun_is_rel                                                 *)
unfold rel in |- *; intros.
unfold fun_ in Af.
elim Af; clear Af; intros; elim H0; clear H0; intros; elim H0; clear H0;
intros.
unfold inc in H0.
generalize (H0 c H); clear H H0 H1; intros.
elim (lem_cartesian_propertie x x0 c); intros; generalize (H0 H);
clear H H0 H1; intros.
elim H; clear H; intros; elim H; clear H; intros; elim H; clear H; intros;
elim H0; clear H0; intros.
exists x1; exists x2; auto with zfc.
Qed.
(* End of proof of lem_fun_is_rel                                          *)
(***************************************************************************)
(* Le domaine et l'image d'une relation non vide sont non vides            *)
(***************************************************************************)
(* Lemma lem_rel_not_empty_so_rdom_not_empty : (r:E)(rRel:(rel r)) ~(r=Vide) -> ~((rdom2 r rRel)=Vide) . (* Proof of lem_rel_not_empty_so_rdom_not_empty                            *)
Save.
(* End of proof of lem_rel_not_empty_so_rdom_not_empty                     *)
*)
(***************************************************************************)
(* Considerons maintenant des relations dont l'image est tout ou partie du *)
(* domaine.                                                                *)
(***************************************************************************)
(***************************************************************************)
(* Reflexivite & irreflexivite                                             *)
(***************************************************************************)
Definition reflexivity (r a : E) (rRel : rel_sig r a a) :=
forall x : E, In x (rdom r a a rRel) -> In (couple x x) r.
Definition irreflexivity (r a : E) (rRel : rel_sig r a a) :=
forall x : E, In x (rdom r a a rRel) -> ~ In (couple x x) r.
(* Proof of lem_refl_dom_inc_img                                           *)
unfold inc in |- *; intros.
unfold reflexivity in H.
generalize (H v0 H0); clear H; intros.
unfold rImg in |- *.
elim (axs_comprehension (fun y : E => exists x : E, In (couple x y) r) a v0);
intros; apply H2; clear H1 H2; intros.
split; [ idtac | exists v0; auto with zfc ].
unfold rdom in H0.
elim (axs_comprehension (fun x : E => exists y : E, In (couple x y) r) a v0);
intros; generalize (H1 H0); clear H0 H1 H2; intros.
elim H0; clear H0; intros; auto with zfc.
Qed.
(* End of proof of lem_refl_dom_inc_img                                    *)
(* Proof of lem_refl_dom_inc_img_recip                                     *)
intros.
unfold not in |- *; intros.
generalize (lem_refl_dom_inc_img r a rRel H0); intros.
absurd (inc (rdom r a a rRel) (rImg r a a rRel)); auto with zfc.
Qed.
(* End of proof of lem_refl_dom_inc_img_recip                              *)
(***************************************************************************)
(* Une relation non vide reflexive n'est pas irreflexive                   *)
(***************************************************************************)
(* Proof of lem_refl_not_irrefl                                            *)
unfold reflexivity in |- *; unfold irreflexivity in |- *; unfold not in |- *;
intros.
generalize (axs_fundation r rNe); intros.
elim H1; clear H1; intros; elim H1; clear H1; intros.
generalize rRel; intros; unfold rel_sig in rRel0; unfold inc in rRel0; intros.
generalize (rRel0 x H1); clear rRel0; intros.
elim (lem_cartesian_propertie a a x); intros; generalize (H4 H3);
clear H3 H4 H5; intros.
elim H3; clear H3; intros; elim H3; clear H3; intros; elim H3; clear H3;
intros; elim H4; clear H4; intros.
generalize H1; rewrite H5; intros.
cut (In x0 (rdom r a a rRel)); intros.
generalize (H x0 H7) (H0 x0 H7); intros.
absurd (In (couple x0 x0) r); auto with zfc.
unfold rdom in |- *.
elim (axs_comprehension (fun x : E => exists y : E, In (couple x y) r) a x0);
intros; apply H8; clear H7 H8; intros.
split; [ auto with zfc | exists x1; auto with zfc ].
Qed.
(* End of proof of lem_refl_not_irrefl                                     *)
(* Proof of lem_irrefl_not_refl                                            *)
unfold reflexivity in |- *; unfold irreflexivity in |- *; unfold not in |- *;
intros.
generalize (axs_fundation r rNe); intros; elim H1; clear H1; intros; elim H1;
clear H1; intros.
generalize rRel; intros; unfold rel_sig in rRel0; unfold inc in rRel0;
generalize (rRel0 x H1); clear rRel0; intros.
elim (lem_cartesian_propertie a a x); intros; generalize (H4 H3);
clear H3 H4 H5; intros.
elim H3; clear H3; intros; elim H3; clear H3; intros; elim H3; clear H3;
intros; elim H4; clear H4; intros.
generalize H1; clear H1; rewrite H5; intros.
cut (In x0 (rdom r a a rRel)); intros.
generalize (H x0 H6) (H0 x0 H6); intros.
absurd (In (couple x0 x0) r); auto with zfc.
unfold rdom in |- *.
elim (axs_comprehension (fun x : E => exists y : E, In (couple x y) r) a x0);
intros; apply H7; clear H6 H7; intros.
split; [ auto with zfc | exists x1; auto with zfc ].
Qed.
(* End of proof of lem_irrefl_not_refl                                     *)
(***************************************************************************)
(* Symmetrie & antisymetrie                                                *)
(***************************************************************************)
Definition symmetry (r a : E) (rRel : rel_sig r a a) :=
forall x y : E, In (couple x y) r -> In (couple y x) r.
Definition antisymmetry (r a : E) (rRel : rel_sig r a a) :=
forall x y : E, In (couple x y) r -> In (couple y x) r -> x = y.
(* Proof of lem_sym_so_rdom_eq_rImg                                        *)
unfold symmetry in |- *; intros.
apply axs_extensionnalite; unfold iff in |- *; split; intros.
unfold rdom in H0.
elim (axs_comprehension (fun x : E => exists y : E, In (couple x y) r) a v2);
intros; generalize (H1 H0); clear H0 H1 H2; intros.
elim H0; clear H0; intros; elim H1; clear H1; intros.
generalize (H v2 x H1); clear H; intros.
unfold rImg in |- *.
elim (axs_comprehension (fun y : E => exists x : E, In (couple x y) r) a v2);
intros; apply H3; clear H2 H3; intros.
split; [ auto with zfc | exists x; auto with zfc ].
unfold rImg in H0.
elim (axs_comprehension (fun y : E => exists x : E, In (couple x y) r) a v2);
intros; generalize (H1 H0); clear H0 H1 H2; intros.
elim H0; clear H0; intros; elim H1; clear H1; intros.
generalize (H x v2 H1); clear H H1; intros.
unfold rdom in |- *.
elim (axs_comprehension (fun x : E => exists y : E, In (couple x y) r) a v2);
intros; apply H2; clear H1 H2; intros.
split; [ auto with zfc | exists x; auto with zfc ].
Qed.
(* End of proof of lem_sym_so_rdom_eq_rImg                                 *)
(***************************************************************************)
(* Transitivite                                                            *)
(***************************************************************************)
Definition transitivity (r a : E) (rRel : rel_sig r a a) :=
forall x y z : E,
In (couple x y) r -> In (couple y z) r -> In (couple x z) r.
(***************************************************************************)
(***************************************************************************)
(* Autres relations                                                        *)
(***************************************************************************)
(***************************************************************************)
(***************************************************************************)
(* Trois relations sur un ensemble donne                                   *)
(***************************************************************************)
(* Proof of lem_Vide_rel_sig                                               *)
unfold rel_sig in |- *; intros.
exact (lem_vide_is_inc (cartesien a a)).
Qed.
(* End of proof of lem_Vide_rel_sig                                        *)
(* Proof of lem_Vide_dom                                                   *)
intros; apply (lem_x_inc_vide (rdom Vide a a (lem_Vide_rel_sig a)));
unfold inc in |- *; intros.
unfold rdom in H.
elim
(axs_comprehension (fun x : E => exists y : E, In (couple x y) Vide) a v0);
intros; generalize (H0 H); clear H H0 H1; intros;
elim H; clear H; intros; elim H0; clear H0; intros.
generalize (lem_vide_propertie (couple v0 x) var_vide); intros;
absurd (In (couple v0 x) Vide); auto with zfc.
Qed.
(* End of proof of lem_Vide_dom                                            *)
(* Proof of lem_Vide_Img                                                   *)
intros; apply (lem_x_inc_vide (rImg Vide a a (lem_Vide_rel_sig a)));
unfold inc in |- *; unfold rImg in |- *; intros.
elim
(axs_comprehension (fun y : E => exists x : E, In (couple x y) Vide) a v0);
intros; generalize (H0 H); clear H H0 H1; intros;
elim H; clear H; intros; elim H0; clear H0; intros.
generalize (lem_vide_propertie (couple x v0) var_vide); intros;
absurd (In (couple x v0) Vide); auto with zfc.
Qed.
(* End of proof of lem_Vide_Img                                            *)
(***************************************************************************)
(* La relation pleine                                                      *)
(***************************************************************************)
Definition rfull (a : E) :=
subset (fun c : E => exists x : E, (exists y : E, c = couple x y))
(cartesien a a).
(* Proof of lem_rfull_rel_sig                                              *)
unfold rel_sig in |- *; unfold inc in |- *; unfold rfull in |- *; intros.
elim
(axs_comprehension
(fun c : E => exists x : E, (exists y : E, c = couple x y))
(cartesien a a) v0); intros; generalize (H0 H);
clear H H0 H1; intros.
elim H; clear H; intros; auto with zfc.
Qed.
(* End of proof of lem_rfull_rel_sig                                       *)
(* Proof of lem_rfull_dom                                                  *)
unfold rdom in |- *; intros; apply axs_extensionnalite; unfold iff in |- *;
split; intros.
elim
(axs_comprehension (fun x : E => exists y : E, In (couple x y) (rfull a)) a
v2); intros; generalize (H0 H); clear H H0 H1;
intros; elim H; clear H; intros; auto with zfc.
elim
(axs_comprehension (fun x : E => exists y : E, In (couple x y) (rfull a)) a
v2); intros; apply H1; clear H0 H1; split; [ auto with zfc | idtac ].
exists v2; unfold rfull in |- *.
elim
(axs_comprehension
(fun c : E => exists x : E, (exists y : E, c = couple x y))
(cartesien a a) (couple v2 v2)); intros; apply H1;
clear H0 H1; intros; split; [ idtac | exists v2; exists v2; reflexivity ].
elim (lem_cartesian_propertie a a (couple v2 v2)); intros; apply H1;
clear H0 H1; exists v2; exists v2; split;
[ auto with zfc | split; [ auto with zfc | reflexivity ] ].
Qed.
(* End of proof of lem_rfull_dom                                           *)
(* Proof of lem_rfull_Img                                                  *)
unfold rImg in |- *; intros; apply axs_extensionnalite; unfold iff in |- *;
split; intros.
elim
(axs_comprehension (fun y : E => exists x : E, In (couple x y) (rfull a)) a
v2); intros; generalize (H0 H); clear H H0 H1;
intros; elim H; clear H; intros; auto with zfc.
elim
(axs_comprehension (fun y : E => exists x : E, In (couple x y) (rfull a)) a
v2); intros; apply H1; clear H0 H1; intros; split;
[ auto with zfc | unfold rfull in |- *; exists v2 ].
elim
(axs_comprehension
(fun c : E => exists x : E, (exists y : E, c = couple x y))
(cartesien a a) (couple v2 v2)); intros; apply H1;
clear H0 H1; intros.
split;
[ elim (lem_cartesian_propertie a a (couple v2 v2)); intros; apply H1;
exists v2; exists v2; split;
[ auto with zfc | split; [ auto with zfc | reflexivity ] ]
| exists v2; exists v2; reflexivity ].
Qed.
(* End of proof of lem_rfull_Img                                           *)
(* Proof of lem_rfull_eq_cart                                              *)
unfold rfull in |- *; intros; apply axs_extensionnalite; unfold iff in |- *;
split; intros.
elim
(axs_comprehension
(fun c : E => exists x : E, (exists y : E, c = couple x y))
(cartesien a a) v2); intros; generalize (H0 H);
clear H H0 H1; intros; elim H; clear H; intros; auto with zfc.
elim
(axs_comprehension
(fun c : E => exists x : E, (exists y : E, c = couple x y))
(cartesien a a) v2); intros; apply H1; clear H0 H1;
intros; split; [ auto with zfc | idtac ].
elim (lem_cartesian_propertie a a v2); intros; generalize (H0 H);
clear H H0 H1; intros; elim H; clear H; intros; elim H;
clear H; intros; elim H; clear H; intros; elim H0;
clear H0; intros.
exists x; exists x0; auto with zfc.
Qed.
(* End of proof of lem_rfull_eq_cart                                       *)
(* Proof of lem_rfull_prop                                                 *)
unfold rfull in |- *; intros.
elim
(axs_comprehension
(fun c : E => exists x0 : E, (exists y0 : E, c = couple x0 y0))
(cartesien a a) (couple x y)); intros; apply H2;
clear H1 H2; intros.
split;
[ elim (lem_cartesian_propertie a a (couple x y)); intros; apply H2;
exists x; exists y; split;
[ auto with zfc | split; [ auto with zfc | reflexivity ] ]
| exists x; exists y; reflexivity ].
Qed.
(* End of proof of lem_rfull_prop                                          *)
(***************************************************************************)
(* La relation identite                                                    *)
(***************************************************************************)
Definition rId (a : E) :=
subset (fun c : E => exists x : E, c = couple x x) (cartesien a a).
(* Proof of lem_rId_rel_sig                                                *)
unfold rel_sig in |- *; unfold inc in |- *; unfold rId in |- *; intros.
elim
(axs_comprehension (fun c : E => exists x : E, c = couple x x)
(cartesien a a) v0); intros; generalize (H0 H);
clear H H0 H1; intros; elim H; clear H; intros; auto with zfc.
Qed.
(* End of proof of lem_rId_rel_sig                                         *)
(* Proof of lem_rId_dom                                                    *)
unfold rdom in |- *; intros; apply axs_extensionnalite; unfold iff in |- *;
split; intros.
elim
(axs_comprehension (fun x : E => exists y : E, In (couple x y) (rId a)) a v2);
intros; generalize (H0 H); clear H H0 H1; intros;
elim H; clear H; intros; auto with zfc.
elim
(axs_comprehension (fun x : E => exists y : E, In (couple x y) (rId a)) a v2);
intros; apply H1; clear H0 H1; split;
[ auto with zfc | exists v2; unfold rId in |- * ].
elim
(axs_comprehension (fun c : E => exists x : E, c = couple x x)
(cartesien a a) (couple v2 v2)); intros; apply H1;
clear H0 H1; intros.
split;
[ elim (lem_cartesian_propertie a a (couple v2 v2)); intros; apply H1;
exists v2; exists v2; split;
[ auto with zfc | split; [ auto with zfc | reflexivity ] ]
| exists v2; reflexivity ].
Qed.
(* End of proof of lem_rId_dom                                             *)
(***************************************************************************)
(* L'image de l'identite est a                                             *)
(***************************************************************************)
(* Lemma lem_rId_Img : (a:E)(rImg (rId a) a a (lem_rId_rel_sig a))=a . *)
(***************************************************************************)
(* Complementaire d'une relation                                           *)
(***************************************************************************)
Definition rel_Comp (r a b : E) (rRel : rel_sig r a b) :=
Comp (cartesien a b) r.
(* Proof of lem_rel_Comp_rel_sig                                           *)
unfold rel_sig in |- *; unfold rel_Comp in |- *; unfold Comp in |- *;
unfold inc in |- *; intros.
elim (axs_comprehension (fun y : E => ~ In y r) (cartesien a b) v0); intros;
generalize (H0 H); clear H H0 H1; intros; elim H;
clear H; intros; auto with zfc.
Qed.
(* End of proof of lem_rel_Comp_rel_sig                                    *)
(***************************************************************************)
(* Reunion de relations                                                    *)
(***************************************************************************)
Definition rel_union (r1 a1 b1 r2 a2 b2 : E) (rRel1 : rel_sig r1 a1 b1)
(rRel2 : rel_sig r2 a2 b2) := union r1 r2.
(* Proof of lem_rel_union_rel_sig                                          *)
unfold rel_union in |- *; unfold rel_sig in |- *; unfold inc in |- *; intros.
elim (lem_union_propertie r1 r2 v0); intros; generalize (H0 H); clear H H0 H1;
intros.
elim (lem_cartesian_propertie (union a1 a2) (union b1 b2) v0); intros;
apply H1; clear H0 H1; intros.
elim H; clear H; intros.
generalize (rRel1 v0 H); intros.
elim (lem_cartesian_propertie a1 b1 v0); intros; generalize (H1 H0);
clear H0 H1 H2; intros.
elim H0; clear H0; intros; elim H0; clear H0; intros; elim H0; clear H0;
intros; elim H1; clear H1; intros.
exists x; exists x0; split;
[ elim (lem_union_propertie a1 a2 x); intros; apply H4; left;
auto with zfc
| split;
[ elim (lem_union_propertie b1 b2 x0); intros; apply H4; left;
auto with zfc
| auto with zfc ] ].
generalize (rRel2 v0 H); intros.
elim (lem_cartesian_propertie a2 b2 v0); intros; generalize (H1 H0);
clear H0 H1 H2; intros.
elim H0; clear H0; intros; elim H0; clear H0; intros; elim H0; clear H0;
intros; elim H1; clear H1; intros.
exists x; exists x0; split;
[ elim (lem_union_propertie a1 a2 x); intros; apply H4; right;
auto with zfc
| split;
[ elim (lem_union_propertie b1 b2 x0); intros; apply H4; right;
auto with zfc
| auto with zfc ] ].
Qed.
(* End of proof of lem_rel_union_rel_sig                                   *)
(* Proof of lem_rel_union_dom                                              *)
intros; unfold rdom in |- *; apply axs_extensionnalite; unfold iff in |- *;
split; intros.
elim
(axs_comprehension
(fun x : E =>
exists y : E, In (couple x y) (rel_union r1 a1 b1 r2 a2 b2 rRel1 rRel2))
(union a1 a2) v2); intros; generalize (H0 H); clear H H0 H1;
intros.
elim H; clear H; intros; elim H0; clear H0; intros.
unfold rel_union in H0.
elim (lem_union_propertie a1 a2 v2); intros; generalize (H1 H); clear H H1 H2;
intros.
elim (lem_union_propertie r1 r2 (couple v2 x)); intros; generalize (H1 H0);
clear H0 H1 H2; intros.
elim
(lem_union_propertie
(subset (fun x : E => exists y : E, In (couple x y) r1) a1)
(subset (fun x : E => exists y : E, In (couple x y) r2) a2) v2);
intros; apply H2; clear H1 H2; intros.
elim H; elim H0; clear H H0; intros.
left;
elim
(axs_comprehension (fun x : E => exists y : E, In (couple x y) r1) a1 v2);
intros; apply H2; clear H1 H2; split;
[ auto with zfc | exists x; auto with zfc ].
generalize (rRel2 (couple v2 x) H); intros.
elim (lem_cartesian_propertie a2 b2 (couple v2 x)); intros;
generalize (H2 H1); clear H1 H2 H3; intros.
elim H1; clear H1; intros; elim H1; clear H1; intros; elim H1; clear H1;
intros; elim H2; clear H2; intros.
elim (lem_couple_propertie v2 x0 x x1); intros; generalize (H4 H3);
clear H3 H4 H5; intros; elim H3; clear H3; intros;
generalize H1 H2; rewrite <- H3; rewrite <- H4; clear H1 H2 H3 H4;
clear x0 x1; intros.
right;
elim
(axs_comprehension (fun x : E => exists y : E, In (couple x y) r2) a2 v2);
intros; apply H4; split; [ auto with zfc | exists x; auto with zfc ].
generalize (rRel1 (couple v2 x) H); intros.
elim (lem_cartesian_propertie a1 b1 (couple v2 x)); intros;
generalize (H2 H1); clear H1 H2 H3; intros.
elim H1; clear H1; intros; elim H1; clear H1; intros; elim H1; clear H1;
intros; elim H2; clear H2; intros.
elim (lem_couple_propertie v2 x0 x x1); intros; generalize (H4 H3);
clear H3 H4 H5; intros; elim H3; clear H3; intros;
generalize H1 H2; rewrite <- H3; rewrite <- H4; clear H1 H2 H3 H4;
clear x0 x1; intros.
left;
elim
(axs_comprehension (fun x : E => exists y : E, In (couple x y) r1) a1 v2);
intros; apply H4; split; [ auto with zfc | exists x; auto with zfc ].
right;
elim
(axs_comprehension (fun x : E => exists y : E, In (couple x y) r2) a2 v2);
intros; apply H2; split; [ auto with zfc | exists x; auto with zfc ].
elim
(lem_union_propertie
(subset (fun x : E => exists y : E, In (couple x y) r1) a1)
(subset (fun x : E => exists y : E, In (couple x y) r2) a2) v2);
intros; generalize (H0 H); clear H H0 H1; intros.
elim
(axs_comprehension
(fun x : E =>
exists y : E, In (couple x y) (rel_union r1 a1 b1 r2 a2 b2 rRel1 rRel2))
(union a1 a2) v2); intros; apply H1; clear H0 H1;
intros.
elim H; clear H; intros.
elim
(axs_comprehension (fun x : E => exists y : E, In (couple x y) r1) a1 v2);
intros; generalize (H0 H); clear H H0 H1; intros;
elim H; clear H; intros; elim H0; clear H0; intros.
split;
[ elim (lem_union_propertie a1 a2 v2); intros; apply H2; left;
auto with zfc
| exists x; unfold rel_union in |- * ].
elim (lem_union_propertie r1 r2 (couple v2 x)); intros; apply H2; left;
auto with zfc.
elim
(axs_comprehension (fun x : E => exists y : E, In (couple x y) r2) a2 v2);
intros; generalize (H0 H); clear H H0 H1; intros;
elim H; clear H; intros; elim H0; clear H0; intros.
split;
[ elim (lem_union_propertie a1 a2 v2); intros; apply H2; right;
auto with zfc
| unfold rel_union in |- * ].
exists x; elim (lem_union_propertie r1 r2 (couple v2 x)); intros; apply H2;
right; auto with zfc.
Qed.
(* End of proof of lem_rel_union_dom                                       *)
(* Proof of lem_rel_union_Img                                              *)
unfold rImg in |- *; intros; apply axs_extensionnalite; unfold iff in |- *;
split; intros.
elim
(axs_comprehension
(fun y : E =>
exists x : E, In (couple x y) (rel_union r1 a1 b1 r2 a2 b2 rRel1 rRel2))
(union b1 b2) v2); intros; generalize (H0 H); clear H H0 H1;
intros.
elim H; clear H; intros; elim H0; clear H0; intros.
elim (lem_union_propertie r1 r2 (couple x v2)); intros; generalize (H1 H0);
clear H0 H1 H2; intros.
elim (lem_union_propertie b1 b2 v2); intros; generalize (H1 H); clear H H1 H2;
intros.
elim
(lem_union_propertie
(subset (fun y : E => exists x : E, In (couple x y) r1) b1)
(subset (fun y : E => exists x : E, In (couple x y) r2) b2) v2);
intros; apply H2; clear H1 H2; intros.
elim H0; elim H; clear H H0; intros.
left;
elim
(axs_comprehension (fun y : E => exists x : E, In (couple x y) r1) b1 v2);
intros; apply H2; split; [ auto with zfc | exists x; auto with zfc ].
generalize (rRel1 (couple x v2) H0); intros.
elim (lem_cartesian_propertie a1 b1 (couple x v2)); intros;
generalize (H2 H1); clear H1 H2 H3; intros; elim H1;
clear H1; intros; elim H1; clear H1; intros; elim H1;
clear H1; intros; elim H2; clear H2; intros.
elim (lem_couple_propertie x x0 v2 x1); intros; generalize (H4 H3);
clear H3 H4 H5; intros; elim H3; clear H3; intros;
generalize H1 H2; rewrite <- H3; rewrite <- H4; clear H1 H2 H3 H4;
clear x0 x1; intros.
left;
elim
(axs_comprehension (fun y : E => exists x : E, In (couple x y) r1) b1 v2);
intros; apply H4; split; [ auto with zfc | exists x; auto with zfc ].
generalize (rRel2 (couple x v2) H0); intros.
elim (lem_cartesian_propertie a2 b2 (couple x v2)); intros;
generalize (H2 H1); clear H1 H2 H3; intros; elim H1;
clear H1; intros; elim H1; clear H1; intros; elim H1;
clear H1; intros; elim H2; clear H2; intros.
elim (lem_couple_propertie x x0 v2 x1); intros; generalize (H4 H3);
clear H3 H4 H5; intros; elim H3; clear H3; intros;
generalize H1 H2; rewrite <- H3; rewrite <- H4; clear H1 H2 H3 H4;
clear x0 x1; intros.
right;
elim
(axs_comprehension (fun y : E => exists x : E, In (couple x y) r2) b2 v2);
intros; apply H4; split; [ auto with zfc | exists x; auto with zfc ].
right;
elim
(axs_comprehension (fun y : E => exists x : E, In (couple x y) r2) b2 v2);
intros; apply H2; split; [ auto with zfc | exists x; auto with zfc ].
elim
(lem_union_propertie
(subset (fun y : E => exists x : E, In (couple x y) r1) b1)
(subset (fun y : E => exists x : E, In (couple x y) r2) b2) v2);
intros; generalize (H0 H); clear H H0 H1; intros.
elim
(axs_comprehension
(fun y : E =>
exists x : E, In (couple x y) (rel_union r1 a1 b1 r2 a2 b2 rRel1 rRel2))
(union b1 b2) v2); intros; apply H1; clear H0 H1;
intros.
elim H; clear H; intros.
elim
(axs_comprehension (fun y : E => exists x : E, In (couple x y) r1) b1 v2);
intros; generalize (H0 H); clear H H0 H1; intros;
elim H; clear H; intros; elim H0; clear H0; intros.
split;
[ elim (lem_union_propertie b1 b2 v2); intros; apply H2; left;
auto with zfc
| exists x; elim (lem_union_propertie r1 r2 (couple x v2)); intros; apply H2;
left; auto with zfc ].
elim
(axs_comprehension (fun y : E => exists x : E, In (couple x y) r2) b2 v2);
intros; generalize (H0 H); clear H H0 H1; intros;
elim H; clear H; intros; elim H0; clear H0; intros.
split;
[ elim (lem_union_propertie b1 b2 v2); intros; apply H2; right;
auto with zfc
| exists x; elim (lem_union_propertie r1 r2 (couple x v2)); intros; apply H2;
right; auto with zfc ].
Qed.
(* End of proof of lem_rel_union_Img                                       *)
(* Proof of lem_rel_union_prop                                             *)
intros; unfold iff in |- *; unfold rel_union in |- *; split; intros.
elim (lem_union_propertie r1 r2 c); intros; exact (H0 H).
elim (lem_union_propertie r1 r2 c); intros; exact (H1 H).
Qed.
(* End of proof of lem_rel_union_prop                                      *)
(***************************************************************************)
(* Intersection de deux relations                                          *)
(***************************************************************************)
Definition rel_inter (r1 a1 b1 r2 a2 b2 : E) (rRel1 : rel_sig r1 a1 b1)
(rRel2 : rel_sig r2 a2 b2) := inter r1 r2.
(* Proof of lem_rel_inter_rel_sig                                          *)
unfold rel_sig in |- *; unfold inc in |- *; unfold rel_inter in |- *; intros.
elim (lem_inter_propertie r1 r2 v0); intros; generalize (H0 H); clear H H0 H1;
intros; elim H; clear H; intros.
elim (lem_cartesian_propertie (inter a1 a2) (inter b1 b2) v0); intros;
apply H2; clear H1 H2; intros.
generalize (rRel1 v0 H) (rRel2 v0 H0); clear rRel1 rRel2 H H0; intros.
elim (lem_cartesian_propertie a1 b1 v0); intros; generalize (H1 H);
clear H H1 H2; intros; elim H; clear H; intros; elim H;
clear H; intros; elim H; clear H; intros; elim H1;
clear H1; intros.
elim (lem_cartesian_propertie a2 b2 v0); intros; generalize (H3 H0);
clear H0 H3 H4; intros; elim H0; clear H0; intros;
elim H0; clear H0; intros; elim H0; clear H0; intros;
elim H3; clear H3; intros.
generalize H4; rewrite H2; clear H2 H4; intros.
elim (lem_couple_propertie x x1 x0 x2); intros; generalize (H2 H4);
clear H2 H4 H5; intros; elim H2; clear H2; intros;
generalize H0 H3; rewrite <- H2; rewrite <- H4; clear H0 H3 H2 H4;
clear x1 x2; intros.
exists x; exists x0; split;
[ elim (lem_inter_propertie a1 a2 x); intros; apply H4; split;
auto with zfc
| split;
[ elim (lem_inter_propertie b1 b2 x0); intros; apply H4; split;
auto with zfc
| reflexivity ] ].
Qed.
(* End of proof of lem_rel_inter_rel_sig                                   *)
(* Proof of lem_rel_inter_dom                                              *)
unfold inc in |- *; intros.
unfold rdom in H.
elim
(axs_comprehension
(fun x : E =>
exists y : E, In (couple x y) (rel_inter r1 a1 b1 r2 a2 b2 rRel1 rRel2))
(inter a1 a2) v0); intros; generalize (H0 H); clear H H0 H1;
intros.
elim H; clear H; intros; elim H0; clear H0; intros.
elim (lem_inter_propertie r1 r2 (couple v0 x)); intros; generalize (H1 H0);
clear H0 H1 H2; intros; elim H0; clear H0; intros.
generalize (lem_rel_and_rdom r1 a1 b1 rRel1 v0 x H0)
(lem_rel_and_rdom r2 a2 b2 rRel2 v0 x H1); clear H0 H1;
intros.
elim (lem_inter_propertie (rdom r1 a1 b1 rRel1) (rdom r2 a2 b2 rRel2) v0);
intros; apply H3; split; auto with zfc.
Qed.
(* End of proof of lem_rel_inter_dom                                       *)
(* Proof of lem_rel_inter_Img                                              *)
unfold inc in |- *; intros.
unfold rImg in H.
elim
(axs_comprehension
(fun y : E =>
exists x : E, In (couple x y) (rel_inter r1 a1 b1 r2 a2 b2 rRel1 rRel2))
(inter b1 b2) v0); intros; generalize (H0 H); clear H H0 H1;
intros; elim H; clear H; intros; elim H0; clear H0;
intros.
elim (lem_inter_propertie r1 r2 (couple x v0)); intros; generalize (H1 H0);
clear H0 H1 H2; intros; elim H0; clear H0; intros.
generalize (lem_rel_and_rImg r1 a1 b1 rRel1 x v0 H0)
(lem_rel_and_rImg r2 a2 b2 rRel2 x v0 H1); clear H0 H1;
intros;
elim (lem_inter_propertie (rImg r1 a1 b1 rRel1) (rImg r2 a2 b2 rRel2) v0);
intros; apply H3; split; auto with zfc.
Qed.
(* End of proof of lem_rel_inter_Img                                       *)
(* Proof of lem_rel_inter_prop                                             *)
unfold rel_inter in |- *; unfold iff in |- *; intros; split; intros.
elim (lem_inter_propertie r1 r2 c); intros; generalize (H0 H); clear H H0;
intros; auto with zfc.
elim (lem_inter_propertie r1 r2 c); intros; apply H1; auto with zfc.
Qed.
(* End of proof of lem_rel_inter_prop                                      *)
(***************************************************************************)
(* Relation inverse                                                        *)
(***************************************************************************)
Definition rel_inverse (r a b : E) (rRel : rel_sig r a b) :=
subset
(fun c : E =>
exists x : E, (exists y : E, In (couple x y) r /\ c = couple y x))
(cartesien b a).
(* Proof of lem_rel_inv_is_rel_sig                                         *)
unfold rel_sig in |- *; unfold inc in |- *; unfold rel_inverse in |- *;
intros.
elim
(axs_comprehension
(fun c : E =>
exists x : E, (exists y : E, In (couple x y) r /\ c = couple y x))
(cartesien b a) v0); intros; generalize (H0 H);
clear H H0 H1; intros; elim H; clear H; intros; auto with zfc.
Qed.
(* End of proof of lem_rel_inv_is_rel_sig                                  *)
(* Proof of lem_rel_inv_dom                                                *)
unfold rdom in |- *; unfold rImg in |- *; intros; apply axs_extensionnalite;
unfold iff in |- *; split; intros.
elim
(axs_comprehension
(fun x : E => exists y : E, In (couple x y) (rel_inverse r a b rRel)) b
v2); intros; generalize (H0 H); clear H H0 H1;
intros; elim H; clear H; intros.
elim H0; clear H0; unfold rel_inverse in |- *; intros.
elim
(axs_comprehension
(fun c : E =>
exists x0 : E, (exists y : E, In (couple x0 y) r /\ c = couple y x0))
(cartesien b a) (couple v2 x)); intros; generalize (H1 H0);
clear H0 H1 H2; intros.
elim H0; clear H0; intros; elim H1; clear H1; intros; elim H1; clear H1;
intros; elim H1; clear H1; intros.
elim (lem_couple_propertie v2 x1 x x0); intros; generalize (H3 H2);
clear H2 H3 H4; intros; elim H2; clear H2; intros.
generalize H1; rewrite <- H2; rewrite <- H3; clear H1 H2 H3; clear x0 x1;
intros.
elim (axs_comprehension (fun y : E => exists x : E, In (couple x y) r) b v2);
intros; apply H3; clear H2 H3; intros.
split; [ auto with zfc | exists x; auto with zfc ].
elim (axs_comprehension (fun y : E => exists x : E, In (couple x y) r) b v2);
intros; generalize (H0 H); clear H H0 H1; intros;
elim H; clear H; intros; elim H0; clear H0; intros.
elim
(axs_comprehension
(fun x : E => exists y : E, In (couple x y) (rel_inverse r a b rRel)) b
v2); intros; apply H2; clear H1 H2; intros.
split; [ auto with zfc | unfold rel_inverse in |- *; exists x ].
elim
(axs_comprehension
(fun c : E =>
exists x0 : E, (exists y : E, In (couple x0 y) r /\ c = couple y x0))
(cartesien b a) (couple v2 x)); intros; apply H2;
clear H1 H2; intros.
split;
[ idtac | exists x; exists v2; split; [ auto with zfc | reflexivity ] ].
generalize (rRel (couple x v2) H0); intros.
elim (lem_cartesian_propertie a b (couple x v2)); intros; generalize (H2 H1);
clear H1 H2 H3; intros.
elim H1; clear H1; intros; elim H1; clear H1; intros; elim H1; clear H1;
intros; elim H2; clear H2; intros.
elim (lem_couple_propertie x x0 v2 x1); intros; generalize (H4 H3);
clear H3 H4 H5; intros; elim H3; clear H3; intros;
generalize H1 H2; rewrite <- H3; rewrite <- H4; clear H1 H2 H3 H4;
clear x0 x1; intros.
elim (lem_cartesian_propertie b a (couple v2 x)); intros; apply H4;
clear H3 H4; intros.
exists v2; exists x; split;
[ auto with zfc | split; [ auto with zfc | reflexivity ] ].
Qed.
(* End of proof of lem_rel_inv_dom                                         *)
(* Proof of lem_rel_inv_Img                                                *)
unfold rImg in |- *; unfold rdom in |- *; intros; apply axs_extensionnalite;
unfold iff in |- *; split; intros.
elim
(axs_comprehension
(fun y : E => exists x : E, In (couple x y) (rel_inverse r a b rRel)) a
v2); intros; generalize (H0 H); clear H H0 H1;
intros; elim H; clear H; intros; elim H0; clear H0;
unfold rel_inverse in |- *; intros.
elim
(axs_comprehension
(fun c : E =>
exists x0 : E, (exists y : E, In (couple x0 y) r /\ c = couple y x0))
(cartesien b a) (couple x v2)); intros; generalize (H1 H0);
clear H0 H1 H2; intros; elim H0; clear H0; intros;
elim H1; clear H1; intros; elim H1; clear H1; intros.
elim H1; clear H1; intros.
elim (lem_couple_propertie x x1 v2 x0); intros; generalize (H3 H2);
clear H2 H3 H4; intros; elim H2; clear H2; intros;
generalize H1; rewrite <- H2; rewrite <- H3; clear H1 H2 H3;
clear x0 x1; intros.
elim (axs_comprehension (fun x : E => exists y : E, In (couple x y) r) a v2);
intros; apply H3; clear H2 H3; intros.
split; [ auto with zfc | exists x; auto with zfc ].
elim (axs_comprehension (fun x : E => exists y : E, In (couple x y) r) a v2);
intros; generalize (H0 H); clear H H0 H1; intros;
elim H; clear H; intros; elim H0; clear H0; intros.
generalize (rRel (couple v2 x) H0); intros.
elim (lem_cartesian_propertie a b (couple v2 x)); intros; generalize (H2 H1);
clear H2 H3; intros.
elim H2; clear H2; intros; elim H2; clear H2; intros; elim H2; clear H2;
intros; elim H3; clear H3; intros.
elim (lem_couple_propertie v2 x0 x x1); intros; generalize (H5 H4);
clear H4 H5 H6; intros; elim H4; clear H4; intros;
generalize H2 H3; rewrite <- H4; rewrite <- H5; clear H2 H3 H4 H5;
clear x0 x1; intros.
elim
(axs_comprehension
(fun y : E => exists x : E, In (couple x y) (rel_inverse r a b rRel)) a
v2); intros; apply H5; clear H4 H5; intros.
split; [ auto with zfc | exists x; unfold rel_inverse in |- * ].
elim
(axs_comprehension
(fun c : E =>
exists x0 : E, (exists y : E, In (couple x0 y) r /\ c = couple y x0))
(cartesien b a) (couple x v2)); intros; apply H5;
clear H4 H5; intros.
split;
[ elim (lem_cartesian_propertie b a (couple x v2)); intros; apply H5;
exists x; exists v2; split;
[ auto with zfc | split; [ auto with zfc | reflexivity ] ]
| exists v2; exists x; split; [ auto with zfc | reflexivity ] ].
Qed.
(* End of proof of lem_rel_inv_Img                                         *)
(***************************************************************************)
(* Produit de relations                                                    *)
(***************************************************************************)
Definition rel_prod (r1 r2 a : E) (rRel1 : rel_sig r1 a a)
(rRel2 : rel_sig r2 a a) :=
subset
(fun c : E =>
exists x : E,
(exists y : E,
(exists z : E,
In (couple x y) r1 /\ In (couple y z) r2 /\ c = couple x z)))
(cartesien a a).
(* Proof of lem_rel_prod_rel_sig                                           *)
unfold rel_sig in |- *; unfold inc in |- *; unfold rel_prod in |- *; intros.
elim
(axs_comprehension
(fun c : E =>
exists x : E,
(exists y : E,
(exists z : E,
In (couple x y) r1 /\ In (couple y z) r2 /\ c = couple x z)))
(cartesien a a) v0); intros; generalize (H0 H);
clear H H0 H1; intros.
elim H; clear H; intros; auto with zfc.
Qed.
(* End of proof of lem_rel_prod_rel_sig                                    *)

(***************************************************************************)
(* Le domaine de r1.r2 est inclus dans le domaine de r1                    *)
(***************************************************************************)
Lemma lem_rel_prod_dom :
forall (r1 r2 a : E) (rRel1 : rel_sig r1 a a) (rRel2 : rel_sig r2 a a),
inc
(rdom (rel_prod r1 r2 a rRel1 rRel2) a a
(lem_rel_prod_rel_sig r1 r2 a rRel1 rRel2)) (rdom r1 a a rRel1).