(* Proof of lem_equiv_comp_unicite                                         *)
intros; apply axs_extensionnalite; unfold iff in |- *; split; intros.
elim Afs; elim Ags; intros.
elim H2; elim H4; clear H2 H4; intros.
generalize (lem_x_in_fun_form g H1 v2 H0); intros.
elim H7; clear H7; intros; elim H7; clear H7; intros.
generalize H0; rewrite H7; clear H0 H7; intros.
generalize (lem_fun_and_dom g x x0 H1 H0) (lem_fun_and_img g x x0 H1 H0);
intros.
generalize H7; rewrite H5; intros.
unfold equiv_comp in |- *.
elim
(axs_comprehension
(fun z : E =>
exists x1 : E,
In x1 a /\
z =
couple (equivClass r a rRel rEqv x1)
(App f (lem_fun_sig_is_fun f a s Afs) x1))
(cartesien (quotient r a rRel rEqv rD) s) (couple x x0));
intros; apply H11; clear H10 H11; intros.
generalize (H6 x0 H8); intros.
split.
elim (lem_cartesian_propertie (quotient r a rRel rEqv rD) s (couple x x0));
intros; apply H12; clear H11 H12; intros.
exists x; exists x0; split;
[ auto with zfc | split; [ auto with zfc | reflexivity ] ].
unfold quotient in H9.
elim
(axs_comprehension
(fun x0 : E => exists y : E, In y a /\ x0 = equivClass r a rRel rEqv y)
(parties a) x); intros; generalize (H11 H9); clear H9 H11 H12;
intros.
elim H9; clear H9; intros; elim H11; clear H11; intros; elim H11; clear H11;
intros.
exists x1; split; [ auto with zfc | idtac ].
elim
(lem_couple_propertie x (equivClass r a rRel rEqv x1) x0
(App f (lem_fun_sig_is_fun f a s Afs) x1)); intros;
apply H14; clear H13 H14; intros.
split; [ auto with zfc | idtac ].
generalize (lem_x_equiv_in_projQ r a rRel rEqv rD x1 H11); rewrite <- H12;
intros.
generalize
(lem_comp_make (projQuotient r a rRel rEqv rD) g a
(quotient r a rRel rEqv rD) s x1 x x0
(lem_projQuotient_sig r a rRel rEqv rD) Ags H13 H0);
rewrite <- H; intros.
exact (lem_eval_propertie f x1 x0 H3 H14).
unfold equiv_comp in H0.
elim
(axs_comprehension
(fun z : E =>
exists x : E,
In x a /\
z =
couple (equivClass r a rRel rEqv x)
(App f (lem_fun_sig_is_fun f a s Afs) x))
(cartesien (quotient r a rRel rEqv rD) s) 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 (lem_cartesian_propertie (quotient r a rRel rEqv rD) s v2); 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 H2; rewrite H4; clear H2 H4; intros.
elim
(lem_couple_propertie x0 (equivClass r a rRel rEqv x) x1
(App f (lem_fun_sig_is_fun f a s Afs) x)); intros;
generalize (H4 H2); clear H2 H4 H5; intros.
elim H2; clear H2; intros.
generalize (lem_x_equiv_in_projQ r a rRel rEqv rD x H1); rewrite <- H2;
intros.
elim Afs; intros; elim H7; clear H7; intros.
generalize H1; rewrite <- H7; intros.
cut
(In (couple x (App f (lem_fun_sig_is_fun f a s Afs) x))
(comp (projQuotient r a rRel rEqv rD) g a (quotient r a rRel rEqv rD) s
(lem_projQuotient_sig r a rRel rEqv rD) Ags));
intros.
generalize
(lem_comp_intermed (projQuotient r a rRel rEqv rD) g a
(quotient r a rRel rEqv rD) s x (App f (lem_fun_sig_is_fun f a s Afs) x)
(lem_projQuotient_sig r a rRel rEqv rD) Ags H10);
clear H10; intros.
elim H10; clear H10; intros; elim H10; clear H10; intros.
generalize (lem_projQuotient_is_fun r a rRel rEqv rD); intros.
elim H12; clear H12; intros.
generalize (H13 x x0 x2 H5 H10); clear H12 H13; intros.
generalize H11; rewrite <- H12; rewrite <- H4; tauto.
rewrite <- H.
exact (lem_eval_prop2 f x (lem_fun_sig_is_fun f a s Afs) H9).
Qed.
(* End of proof of lem_equiv_comp_unicite                                  *)

(* Specifications: *)
(***************************************************************************)
(* On propose un ennonce plus traditionnel du thm fondamental sur les      *)
(* ensembles quotients.                                                    *)
(***************************************************************************)
Theorem thm_ens_quotient_fond :
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),
exUniq _
(fun g : E =>
fun_sig g (quotient r a rRel rEqv rD) s /\
f =
comp2 (projQuotient r a rRel rEqv rD) g a (quotient r a rRel rEqv rD) s).