(* Proof of lem_equiv_comp_dom                                             *)
intros; apply axs_extensionnalite; unfold iff in |- *; split; intros.
unfold dom in H.
elim
(axs_comprehension
(fun v0 : E =>
fun_ (equiv_comp r a rRel rEqv rD s f Afs Pr) ->
exists v1 : E,
In (couple v0 v1) (equiv_comp r a rRel rEqv rD s f Afs Pr))
(reunion (reunion (equiv_comp r a rRel rEqv rD s f Afs Pr))) v2);
intros; generalize (H0 H); clear H H0 H1; intros.
elim H; clear H; intros.
elim (H0 (lem_equiv_comp_is_fun r a rRel rEqv rD s f Afs Pr)); clear H0;
intros.
unfold equiv_comp in H0.
elim
(axs_comprehension
(fun z : E =>
exists x0 : E,
In x0 a /\
z =
couple (equivClass r a rRel rEqv x0)
(App f (lem_fun_sig_is_fun f a s Afs) x0))
(cartesien (quotient r a rRel rEqv rD) s) (couple v2 x));
intros; generalize (H1 H0); clear H0 H1 H2; intros.
elim H0; clear H0; intros; clear H1.
elim (lem_cartesian_propertie (quotient r a rRel rEqv rD) s (couple v2 x));
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 v2 x0 x x1); intros; generalize (H3 H2);
clear H2 H3 H4; intros.
elim H2; clear H2; intros.
generalize H0; rewrite <- H2; tauto.
unfold dom in |- *.
elim
(axs_comprehension
(fun v0 : E =>
fun_ (equiv_comp r a rRel rEqv rD s f Afs Pr) ->
exists v1 : E,
In (couple v0 v1) (equiv_comp r a rRel rEqv rD s f Afs Pr))
(reunion (reunion (equiv_comp r a rRel rEqv rD s f Afs Pr))) v2);
intros; apply H1; clear H0 H1; intros.
generalize H; unfold quotient in |- *; intros.
elim
(axs_comprehension
(fun x : E => exists y : E, In y a /\ x = equivClass r a rRel rEqv y)
(parties a) 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.
split; intros.
elim (axs_reunion (reunion (equiv_comp r a rRel rEqv rD s f Afs Pr)) v2);
intros; apply H4; clear H3 H4; intros.
exists (singleton v2); split; [ idtac | apply lem_x_in_sing_x ].
elim (axs_reunion (equiv_comp r a rRel rEqv rD s f Afs Pr) (singleton v2));
intros; apply H4; clear H3 H4; intros.
exists (couple v2 (App f (lem_fun_sig_is_fun f a s Afs) x)); split;
[ idtac
| elim
(axs_paire (singleton v2)
(paire v2 (App f (lem_fun_sig_is_fun f a s Afs) x))
(singleton v2)); intros; apply H4; left; reflexivity ].
unfold equiv_comp in |- *.
elim
(axs_comprehension
(fun z : E =>
exists x0 : E,
In x0 a /\
z =
couple (equivClass r a rRel rEqv x0)
(App f (lem_fun_sig_is_fun f a s Afs) x0))
(cartesien (quotient r a rRel rEqv rD) s)
(couple v2 (App f (lem_fun_sig_is_fun f a s Afs) x)));
intros; apply H4; clear H3 H4; intros.
split;
[ idtac | exists x; split; [ auto with zfc | rewrite H2; reflexivity ] ].
elim
(lem_cartesian_propertie (quotient r a rRel rEqv rD) s
(couple v2 (App f (lem_fun_sig_is_fun f a s Afs) x)));
intros; apply H4; clear H3 H4; intros.
exists v2; exists (App f (lem_fun_sig_is_fun f a s Afs) x); split;
[ unfold quotient in |- * | split; [ idtac | reflexivity ] ].
elim
(axs_comprehension
(fun x : E => exists y : E, In y a /\ x = equivClass r a rRel rEqv y)
(parties a) v2); intros; apply H4; clear H3 H4;
intros.
split;
[ rewrite H2; exact (lem_equivClass_in_parties_a r a rRel rEqv x)
| exists x; split; auto with zfc ].
elim Afs; intros.
elim H4; clear H4; intros.
cut (In x (dom f)); intros; [ idtac | rewrite H4; auto with zfc ].
generalize (lem_eval_prop2 f x (lem_fun_sig_is_fun f a s Afs) H6); clear H6;
intros.
generalize
(lem_fun_and_img f x (App f (lem_fun_sig_is_fun f a s Afs) x)
(lem_fun_sig_is_fun f a s Afs) H6); clear H6; intros.
unfold inc in H5.
exact (H5 (App f (lem_fun_sig_is_fun f a s Afs) x) H6).
exists (App f (lem_fun_sig_is_fun f a s Afs) x); unfold equiv_comp in |- *.
elim
(axs_comprehension
(fun z : E =>
exists x0 : E,
In x0 a /\
z =
couple (equivClass r a rRel rEqv x0)
(App f (lem_fun_sig_is_fun f a s Afs) x0))
(cartesien (quotient r a rRel rEqv rD) s)
(couple v2 (App f (lem_fun_sig_is_fun f a s Afs) x)));
intros; apply H5; clear H4 H5; intros.
split;
[ idtac
| exists x; split; [ auto with zfc | rewrite H2; auto with zfc ] ].
elim
(lem_cartesian_propertie (quotient r a rRel rEqv rD) s
(couple v2 (App f (lem_fun_sig_is_fun f a s Afs) x)));
intros; apply H5; clear H4 H5; intros.
exists v2; exists (App f (lem_fun_sig_is_fun f a s Afs) x); split;
[ idtac | split; [ idtac | reflexivity ] ].
unfold quotient in |- *.
elim
(axs_comprehension
(fun x : E => exists y : E, In y a /\ x = equivClass r a rRel rEqv y)
(parties a) v2); intros; apply H5; clear H4 H5;
intros.
split;
[ rewrite H2; exact (lem_equivClass_in_parties_a r a rRel rEqv x)
| exists x; split; auto with zfc ].
elim Afs; intros.
elim H5; clear H5; intros.
cut (In x (dom f)); intros; [ idtac | rewrite H5; auto with zfc ].
generalize (lem_eval_prop2 f x (lem_fun_sig_is_fun f a s Afs) H7); intros.
generalize
(lem_fun_and_img f x (App f (lem_fun_sig_is_fun f a s Afs) x)
(lem_fun_sig_is_fun f a s Afs) H8); clear H8; intros.
exact (H6 (App f (lem_fun_sig_is_fun f a s Afs) x) H8).
Qed.
(* End of proof of lem_equiv_comp_dom                                      *)

(* Specifications: *)
(***************************************************************************)
(* L'image de equiv_comp est une partie de s                               *)
(***************************************************************************)
Lemma lem_equiv_comp_img :
forall (r a : E) (rRel : rel_sig r a a) (rEqv : equivalence r a rRel)
(rD : rdom r a a rRel = a) (s f : E) (Afs : fun_sig f a s)
(Pr : forall x y : E,
In (couple x y) r ->
App f (lem_fun_sig_is_fun f a s Afs) x =
App f (lem_fun_sig_is_fun f a s Afs) y),
inc (Img (equiv_comp r a rRel rEqv rD s f Afs Pr)) s.