(* Proof of lem_rel_prod_assoc                                             *)
unfold rel_prod at 1 3 in |- *; intros; apply axs_extensionnalite;
unfold iff in |- *; split; intros.
elim
(axs_comprehension
(fun c : E =>
exists x : E,
(exists y : E,
(exists z : E,
In (couple x y) (rel_prod r1 r2 a rRel1 rRel2) /\
In (couple y z) r3 /\ c = couple x z)))
(cartesien a a) v2); intros; generalize (H0 H);
clear H H0 H1; intros.
elim H; clear H; intros; elim H0; clear H0; intros; elim H0; clear H0; intros;
elim H0; clear H0; intros; elim H0; clear H0; intros;
elim H1; clear H1; intros.
unfold rel_prod in H0.
elim
(axs_comprehension
(fun c : E =>
exists x1 : E,
(exists y : E,
(exists z : E,
In (couple x1 y) r1 /\ In (couple y z) r2 /\ c = couple x1 z)))
(cartesien a a) (couple x x0)); intros; generalize (H3 H0);
clear H0 H3 H4; intros.
elim H0; clear H0; intros; elim H3; clear H3; intros; elim H3; clear H3;
intros; elim H3; clear H3; intros; elim H3; clear H3;
intros; elim H4; clear H4; intros.
elim (lem_couple_propertie x x2 x0 x4); intros; generalize (H6 H5);
clear H5 H6 H7; intros; elim H5; clear H5; intros;
generalize H3 H4; rewrite <- H5; rewrite <- H6; clear H3 H4 H5 H6;
clear x2 x4; 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) (rel_prod r2 r3 a rRel2 rRel3) /\ c = couple x z)))
(cartesien a a) v2); intros; apply H6; clear H5 H6;
intros.
split;
[ auto with zfc
| exists x; exists x3; exists x1; split;
[ auto with zfc
| unfold rel_prod in |- *; split; [ idtac | auto with zfc ] ] ].
elim
(axs_comprehension
(fun c : E =>
exists x : E,
(exists y : E,
(exists z : E,
In (couple x y) r2 /\ In (couple y z) r3 /\ c = couple x z)))
(cartesien a a) (couple x3 x1)); intros; apply H6;
clear H5 H6; intros.
split;
[ idtac
| exists x3; exists x0; exists x1; split;
[ auto with zfc | split; [ auto with zfc | reflexivity ] ] ].
generalize (rRel3 (couple x0 x1) H1) (rRel1 (couple x x3) H3);
clear H H0 H1 H2 H3 H4; intros.
elim (lem_cartesian_propertie a a (couple x0 x1)); 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_couple_propertie x0 x2 x1 x4); intros; generalize (H3 H2);
clear H2 H3 H4; intros; elim H2; clear H2; intros;
generalize H H1; rewrite <- H2; rewrite <- H3; clear H H1 H2 H3;
clear x2 x4; intros.
elim (lem_cartesian_propertie a a (couple x x3)); intros; generalize (H2 H0);
clear H0 H2 H3; intros.
elim H0; clear H0; intros; elim H0; clear H0; intros; elim H0; clear H0;
intros; elim H2; clear H2; intros.
elim (lem_couple_propertie x x2 x3 x4); intros; generalize (H4 H3);
clear H3 H4 H5; intros; elim H3; clear H3; intros;
generalize H0 H2; rewrite <- H3; rewrite <- H4; clear H0 H2 H3 H4;
clear x2 x4; intros.
elim (lem_cartesian_propertie a a (couple x3 x1)); intros; apply H4;
clear H3 H4; exists x3; exists x1; split;
[ auto with zfc | split; [ auto with zfc | reflexivity ] ].
elim
(axs_comprehension
(fun c : E =>
exists x : E,
(exists y : E,
(exists z : E,
In (couple x y) r1 /\
In (couple y z) (rel_prod r2 r3 a rRel2 rRel3) /\ c = couple x z)))
(cartesien a a) v2); intros; generalize (H0 H);
clear H H0 H1; intros.
elim H; clear H; intros; elim H0; clear H0; intros; elim H0; clear H0; intros;
elim H0; clear H0; intros; elim H0; clear H0; intros;
elim H1; clear H1; intros.
unfold rel_prod in H1.
elim
(axs_comprehension
(fun c : E =>
exists x : E,
(exists y : E,
(exists z : E,
In (couple x y) r2 /\ In (couple y z) r3 /\ c = couple x z)))
(cartesien a a) (couple x0 x1)); intros; generalize (H3 H1);
clear H1 H3 H4; intros.
elim H1; clear H1; intros; elim H3; clear H3; intros; elim H3; clear H3;
intros; elim H3; clear H3; intros; elim H3; clear H3;
intros; elim H4; clear H4; intros.
elim (lem_couple_propertie x0 x2 x1 x4); intros; generalize (H6 H5);
clear H5 H6 H7; intros; elim H5; clear H5; intros;
generalize H3 H4; rewrite <- H5; rewrite <- H6; clear H3 H4 H5 H6;
clear x2 x4; intros.
elim
(axs_comprehension
(fun c : E =>
exists x : E,
(exists y : E,
(exists z : E,
In (couple x y) (rel_prod r1 r2 a rRel1 rRel2) /\
In (couple y z) r3 /\ c = couple x z)))
(cartesien a a) v2); intros; apply H6; clear H5 H6;
intros.
split;
[ auto with zfc
| exists x; exists x3; exists x1; split;
[ unfold rel_prod in |- * | split; auto with zfc ] ].
elim
(axs_comprehension
(fun c : E =>
exists x0 : E,
(exists y : E,
(exists z : E,
In (couple x0 y) r1 /\ In (couple y z) r2 /\ c = couple x0 z)))
(cartesien a a) (couple x x3)); intros; apply H6;
clear H5 H6; intros.
split;
[ idtac
| exists x; exists x0; exists x3; split;
[ auto with zfc | split; [ auto with zfc | reflexivity ] ] ].
generalize (rRel1 (couple x x0) H0) (rRel2 (couple x0 x3) H3);
clear H H0 H1 H2 H3 H4; intros.
elim (lem_cartesian_propertie a a (couple x x0)); 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_couple_propertie x x2 x0 x4); intros; generalize (H3 H2);
clear H2 H3 H4; intros; elim H2; clear H2; intros;
generalize H H1; rewrite <- H2; rewrite <- H3; clear H H1 H2 H3;
clear x2 x4; intros.
elim (lem_cartesian_propertie a a (couple x0 x3)); intros; generalize (H2 H0);
clear H0 H2 H3; intros.
elim H0; clear H0; intros; elim H0; clear H0; intros; elim H0; clear H0;
intros; elim H2; clear H2; intros.
elim (lem_couple_propertie x0 x2 x3 x4); intros; generalize (H4 H3);
clear H3 H4 H5; intros; elim H3; clear H3; intros;
generalize H0 H2; rewrite <- H3; rewrite <- H4; clear H0 H2 H3 H4;
clear x2 x4; intros.
elim (lem_cartesian_propertie a a (couple x x3)); intros; apply H4; exists x;
exists x3; split;
[ auto with zfc | split; [ auto with zfc | reflexivity ] ].
Qed.
(* End of proof of lem_rel_prod_assoc                                      *)
(***************************************************************************)
(* L'identite est un element neutre pour le produit                        *)
(***************************************************************************)
(***************************************************************************)
(***************************************************************************)
(* Relations d'equivalence                                                 *)
(***************************************************************************)
(***************************************************************************)
Definition equivalence (r a : E) (rRel : rel_sig r a a) :=
reflexivity r a rRel /\ symmetry r a rRel /\ transitivity r a rRel.
(***************************************************************************)
(* Classe d'equivalence                                                    *)
(***************************************************************************)
Definition equivClass (r a : E) (rRel : rel_sig r a a)
(rEqv : equivalence r a rRel) (x : E) :=
subset (fun y : E => In (couple x y) r) a.

(***************************************************************************)
(* Si x est en relation avec y alors ils ont meme classe d'equivalence     *)
(***************************************************************************)
Lemma lem_equivClass_eq :
forall (r a : E) (rRel : rel_sig r a a) (rEqv : equivalence r a rRel)
(x y : E),
In (couple x y) r -> equivClass r a rRel rEqv x = equivClass r a rRel rEqv y.