(* Proof of lem_equiv_comp_bij_under                                       *)
unfold fun_bij in |- *; intros.
split;
[ exact
(lem_equiv_comp_is_fun r a rRel rEqv rD s f (lem_surj_to_sig f a s Afs)
Pr)
| idtac ].
split;
[ exact
(lem_equiv_comp_dom r a rRel rEqv rD s f (lem_surj_to_sig f a s Afs) Pr)
| idtac ].
split;
[ apply axs_extensionnalite; unfold iff in |- *; split; intros | intros ].
exact
(lem_equiv_comp_img r a rRel rEqv rD s f (lem_surj_to_sig f a s Afs) Pr v2 H).
elim Afs; intros; elim H1; clear H1; intros.
cut (In v2 (Img f)); intros; [ idtac | rewrite H2; auto with zfc ].
generalize (lem_App_rev f v2 H0 H3); intros.
elim H4; clear H4; intros; elim H4; clear H4; intros.
cut (In x a); intros; [ idtac | rewrite <- H1; auto with zfc ].
generalize (lem_eval_propertie f x v2 H0 H5); intros.
generalize H H3 H5; rewrite H7; clear H H3 H5 H7; intros.
generalize
(lem_equiv_comp_prop r a rRel rEqv rD s f (lem_surj_to_sig f a s Afs) Pr);
intros.
cut
(In (couple x (App f H0 x))
(comp (projQuotient r a rRel rEqv rD)
(equiv_comp r a rRel rEqv rD s f (lem_surj_to_sig f a s Afs) Pr) a
(quotient r a rRel rEqv rD) s (lem_projQuotient_sig r a rRel rEqv rD)
(lem_equiv_comp_sig r a rRel rEqv rD s f (lem_surj_to_sig f a s Afs)
Pr))); intros; [ idtac | rewrite <- H7; auto with zfc ].
generalize
(lem_comp_intermed (projQuotient r a rRel rEqv rD)
(equiv_comp r a rRel rEqv rD s f (lem_surj_to_sig f a s Afs) Pr) a
(quotient r a rRel rEqv rD) s x (App f H0 x)
(lem_projQuotient_sig r a rRel rEqv rD)
(lem_equiv_comp_sig r a rRel rEqv rD s f (lem_surj_to_sig f a s Afs) Pr)
H8); clear H7 H8; intros.
elim H7; clear H7; intros; elim H7; clear H7; intros.
exact
(lem_fun_and_img
(equiv_comp r a rRel rEqv rD s f (lem_surj_to_sig f a s Afs) Pr) x0
(App f H0 x)
(lem_equiv_comp_is_fun r a rRel rEqv rD s f (lem_surj_to_sig f a s Afs)
Pr) H8).
unfold exUniq in |- *; intros.
generalize
(lem_App_rev
(equiv_comp r a rRel rEqv rD s f (lem_surj_to_sig f a s Afs) Pr) b
(lem_equiv_comp_is_fun r a rRel rEqv rD s f (lem_surj_to_sig f a s Afs)
Pr) H); intros.
elim H0; clear H0; intros; elim H0; clear H0; intros.
exists x; split; [ auto with zfc | intros ].
generalize
(lem_fun_and_dom
(equiv_comp r a rRel rEqv rD s f (lem_surj_to_sig f a s Afs) Pr) y b
(lem_equiv_comp_is_fun r a rRel rEqv rD s f (lem_surj_to_sig f a s Afs)
Pr) H2); intros.
generalize H0 H3;
rewrite
(lem_equiv_comp_dom r a rRel rEqv rD s f (lem_surj_to_sig f a s Afs) Pr)
; clear H0 H3; intros.
unfold quotient in H0.
elim
(axs_comprehension
(fun x0 : E => exists y : E, In y a /\ x0 = equivClass r a rRel rEqv y)
(parties a) x); intros; generalize (H4 H0); clear H0 H4 H5;
intros.
unfold quotient in H3.
elim
(axs_comprehension
(fun x : E => exists y0 : E, In y0 a /\ x = equivClass r a rRel rEqv y0)
(parties a) y); intros; generalize (H4 H3); clear H3 H4 H5;
intros.
elim H0; clear H0; intros; clear H0; elim H4; clear H4; intros; elim H0;
clear H0; intros.
elim H3; clear H3; intros; clear H3; elim H5; clear H5; intros; elim H3;
clear H3; intros.
generalize H1 H2; rewrite H4; rewrite H5; clear H1 H2 H4 H5; intros.
generalize (lem_x_equiv_in_projQ r a rRel rEqv rD x0 H0)
(lem_x_equiv_in_projQ r a rRel rEqv rD x1 H3); intros.
generalize
(lem_comp_make (projQuotient r a rRel rEqv rD)
(equiv_comp r a rRel rEqv rD s f (lem_surj_to_sig f a s Afs) Pr) a
(quotient r a rRel rEqv rD) s x0 (equivClass r a rRel rEqv x0) b
(lem_projQuotient_sig r a rRel rEqv rD)
(lem_equiv_comp_sig r a rRel rEqv rD s f (lem_surj_to_sig f a s Afs) Pr)
H4 H1); intros.
generalize
(lem_comp_make (projQuotient r a rRel rEqv rD)
(equiv_comp r a rRel rEqv rD s f (lem_surj_to_sig f a s Afs) Pr) a
(quotient r a rRel rEqv rD) s x1 (equivClass r a rRel rEqv x1) b
(lem_projQuotient_sig r a rRel rEqv rD)
(lem_equiv_comp_sig r a rRel rEqv rD s f (lem_surj_to_sig f a s Afs) Pr)
H5 H2); intros.
generalize
(lem_equiv_comp_prop r a rRel rEqv rD s f (lem_surj_to_sig f a s Afs) Pr);
intros.
generalize H6 H7; rewrite <- H8; clear H6 H7 H8; intros.
generalize
(lem_eval_propertie f x0 b
(lem_fun_sig_is_fun f a s (lem_surj_to_sig f a s Afs)) H6)
(lem_eval_propertie f x1 b
(lem_fun_sig_is_fun f a s (lem_surj_to_sig f a s Afs)) H7);
intros.
generalize H9; rewrite H8; intros.
generalize (Prinv x0 x1 H10); intros.
exact (lem_equivClass_eq r a rRel rEqv x0 x1 H11).
Qed.
(* End of proof of lem_equiv_comp_bij_under                                *)
(***************************************************************************)
(***************************************************************************)
(* Deux corollaires au thm fondamental                                     *)
(***************************************************************************)
(***************************************************************************)
(***************************************************************************)
(* Corollaire 1                                                            *)
(***************************************************************************)
(***************************************************************************)
(* On s'interesse a equiv_comp dans le cas ou la relation r est le noyau   *)
(* d'equivalence de f.                                                     *)
(***************************************************************************)
Definition equiv_comp_fun (f a s : E) (Afs : fun_sig f a s) :=
equiv_comp (equiv_fun f (lem_fun_sig_is_fun f a s Afs)) a
(lem_sig_fun_equiv_is_rel f a s Afs)
(lem_sig_fun_equiv_is_equiv f a s Afs) (lem_sig_fun_equiv_dom f a s Afs)
s f Afs (lem_fun_equiv_prop f (lem_fun_sig_is_fun f a s Afs)).

(* Specifications: *)
(***************************************************************************)
(* Cette nouvelle "instance" de equiv_comp est une injection               *)
(***************************************************************************)
Lemma lem_equiv_comp_fun_is_inj :
forall (f a s : E) (Afs : fun_sig f a s),
fun_inj (equiv_comp_fun f a s Afs)
(quotient (equiv_fun f (lem_fun_sig_is_fun f a s Afs)) a
(lem_sig_fun_equiv_is_rel f a s Afs)
(lem_sig_fun_equiv_is_equiv f a s Afs)
(lem_sig_fun_equiv_dom f a s Afs)) s.