(* Contribution to the Coq Library   V6.3 (July 1999)                    *)
(***************************************************************************)
(* File: applications.v                                                    *)
(* auteur: alex@sysal.ibp.fr                                               *)
(* date: 19/10/95                                                          *)
(***************************************************************************)
Require Export couples.
(***************************************************************************)
(***************************************************************************)
(* Relations n-aires                                                       *)
(***************************************************************************)
(***************************************************************************)
Definition n_aire (n : nat) (a : E) (F : E -> Prop) :=
subset F (cart_power n a).
(* Pas de reciproque (dixit pagano pb des ensembles non decidables)        *)
(* Proof of lem_subset                                                     *)
intros; elim (axs_comprehension F b y); intros.
generalize H1; rewrite <- H; clear H H1 H2; intros.
elim H1; intros; auto with zfc.
Qed.
(* End of proof of lem_subset                                              *)
(***************************************************************************)
(***************************************************************************)
(* applications                                                            *)
(***************************************************************************)
(***************************************************************************)
Definition fun_ (f : E) :=
(exists a : E, (exists b : E, inc f (cartesien a b))) /\
(forall x y z : E, In (couple x y) f -> In (couple x z) f -> y = z).
(***************************************************************************)
(* Domaine d'une application                                               *)
(***************************************************************************)
Definition dom (f : E) :=
subset (fun v0 : E => fun_ f -> exists v1 : E, In (couple v0 v1) f)
(reunion (reunion f)).
(***************************************************************************)
(* Image d'une application                                                 *)
(***************************************************************************)
Definition Img (f : E) :=
subset (fun v1 : E => fun_ f -> exists v0 : E, In (couple v0 v1) f)
(reunion (reunion f)).
(***************************************************************************)
(* f est une application de a vers b                                       *)
(***************************************************************************)
Definition fun_sig (f a b : E) := fun_ f /\ dom f = a /\ inc (Img f) b.
(* Proof of lem_fun_sig_is_fun                                             *)
unfold fun_sig in |- *; intros.
elim H; clear H; intros; auto with zfc.
Qed.
(* End of proof of lem_fun_sig_is_fun                                      *)
(* Proof of lem_fun_sig_dom                                                *)
intros; elim H; clear H; intros; elim H0; clear H0; intros; auto with zfc.
Qed.
(* End of proof of lem_fun_sig_dom                                         *)
(* Proof of lem_fun_sig_img                                                *)
intros; elim H; clear H; intros; elim H0; clear H0; intros; auto with zfc.
Qed.
(* End of proof of lem_fun_sig_img                                         *)
(***************************************************************************)
(* f est une application surjective de a vers b                            *)
(***************************************************************************)
Definition fun_surj (f a b : E) := fun_ f /\ dom f = a /\ Img f = b.
(***************************************************************************)
(* f est une application injective                                         *)
(***************************************************************************)
Definition fun_inj (f a b : E) :=
fun_ f /\
dom f = a /\
inc (Img f) b /\
(forall b : E, In b (Img f) -> exUniq _ (fun a : E => In (couple a b) f)).
(***************************************************************************)
(* f est une bijection                                                     *)
(***************************************************************************)
Definition fun_bij (f a b : E) :=
fun_ f /\
dom f = a /\
Img f = b /\
(forall b : E, In b (Img f) -> exUniq _ (fun a : E => In (couple a b) f)).
(* Proof of lem_surj_to_sig                                                *)
unfold fun_surj in |- *; unfold fun_sig in |- *; intros.
elim H; clear H; intros; elim H0; clear H0; intros.
split;
[ auto with zfc
| split; [ auto with zfc | unfold inc in |- *; intros ] ].
generalize H2; rewrite H1; tauto.
Qed.
(* End of proof of lem_surj_to_sig                                         *)
(* Proof of lem_inj_to_sig                                                 *)
unfold fun_inj in |- *; unfold fun_sig in |- *; intros.
elim H; clear H; intros; elim H0; clear H0; intros; elim H1; clear H1; intros.
split; [ auto with zfc | split; auto with zfc ].
Qed.
(* End of proof of lem_inj_to_sig                                          *)
(* Proof of lem_bij_to_sig                                                 *)
unfold fun_bij in |- *; unfold fun_sig in |- *; intros.
elim H; clear H; intros; elim H0; clear H0; intros; elim H1; clear H1; intros.
split;
[ auto with zfc
| split; [ auto with zfc | unfold inc in |- *; intros ] ].
rewrite <- H1; auto with zfc.
Qed.
(* End of proof of lem_bij_to_sig                                          *)
(* Proof of lem_bij_is_inj                                                 *)
unfold fun_bij, fun_inj in |- *; intros.
elim H; clear H; intros; elim H0; clear H0; intros; elim H1; clear H1; intros.
split;
[ auto with zfc
| split;
[ auto with zfc
| split;
[ unfold inc in |- *; intros; rewrite <- H1; auto with zfc
| auto with zfc ] ] ].
Qed.
(* End of proof of lem_bij_is_inj                                          *)
(* Proof of lem_bij_is_inj                                                 *)
unfold fun_bij, fun_surj in |- *; intros.
elim H; clear H; intros; elim H0; clear H0; intros; elim H1; clear H1; intros.
split; [ auto with zfc | split; auto with zfc ].
Qed.
(* End of proof of lem_bij_is_inj                                          *)
(* Proof of lem_inj_surj_is_bij                                            *)
unfold fun_surj, fun_inj, fun_bij in |- *; intros.
elim H; clear H; intros; clear H; elim H1; clear H1; intros; clear H.
elim H0; clear H0; intros; elim H0; clear H0; intros; elim H2; clear H2;
intros.
split;
[ auto with zfc
| split; [ auto with zfc | split; auto with zfc ] ].
Qed.
(* End of proof of lem_inj_surj_is_bij                                     *)
(***************************************************************************)
(***************************************************************************)
(* L'application Vide                                                      *)
(***************************************************************************)
(***************************************************************************)
(* Proof of lem_vide_application                                           *)
unfold fun_ in |- *; split;
[ exists Vide; exists Vide; exact (lem_vide_is_inc (cartesien Vide Vide))
| intros ].
unfold Vide in H; elim (lem_vide_propertie (couple x y) var_vide);
auto with zfc.
Qed.
(* End of proof of lem_vide_application                                    *)
(* Proof of lem_dom_vide                                                   *)
apply axs_extensionnalite; intros; unfold iff in |- *; split; intros;
unfold dom in H.
elim
(axs_comprehension
(fun v0 : E => fun_ Vide -> exists v1 : E, In (couple v0 v1) Vide)
(reunion (reunion Vide)) v2); intros; generalize (H0 H);
clear H H0 H1; intros.
generalize H; rewrite lem_reunion_vide; rewrite lem_reunion_vide; tauto.
elim (lem_vide_propertie v2 var_vide); auto with zfc.
Qed.
(* End of proof of  lem_dom_vide                                           *)
(* Proof of lem_img_vide                                                   *)
apply axs_extensionnalite; intros; unfold iff in |- *; split; intros;
unfold Img in H.
elim
(axs_comprehension
(fun v1 : E => fun_ Vide -> exists v0 : E, In (couple v0 v1) Vide)
(reunion (reunion Vide)) v2); intros; generalize (H0 H);
clear H H0 H1; intros.
elim H; clear H; intros.
generalize H; rewrite lem_reunion_vide; rewrite lem_reunion_vide; tauto.
unfold Vide in H; elim (lem_vide_propertie v2 var_vide); auto with zfc.
Qed.
(* End of proof of lem_img_vide                                            *)
(* Proof of lem_fun_vide_sig                                               *)
unfold fun_sig in |- *; intros.
split;
[ exact lem_vide_application
| split;
[ exact lem_dom_vide | rewrite lem_img_vide; exact (lem_vide_is_inc a) ] ].
Qed.
(* End of proof of lem_fun_vide_sig                                        *)
(* Proof of lem_fun_and_dom                                                *)
intros; unfold dom in |- *.
elim
(axs_comprehension
(fun v0 : E => fun_ f -> exists v1 : E, In (couple v0 v1) f)
(reunion (reunion f)) a); intros; apply H2; clear H1 H2;
intros.
split; [ idtac | intros; exists b; auto with zfc ].
elim (axs_reunion (reunion f) a); intros; apply H2; clear H1 H2; intros.
exists (singleton a); split; [ idtac | exact (lem_x_in_sing_x a) ].
elim (axs_reunion f (singleton a)); intros; apply H2; clear H1 H2; intros.
exists (couple a b); split;
[ auto with zfc
| unfold couple in |- *;
elim (axs_paire (singleton a) (paire a b) (singleton a));
intros; apply H2; left; reflexivity ].
Qed.
(* End of proof of lem_fun_and_dom                                         *)
(* Proof of lem_fun_and_img                                                *)
intros; unfold Img in |- *.
elim
(axs_comprehension
(fun v1 : E => fun_ f -> exists v0 : E, In (couple v0 v1) f)
(reunion (reunion f)) b); intros; apply H2; clear H1 H2;
intros.
split; [ idtac | intros; exists a; auto with zfc ].
elim (axs_reunion (reunion f) b); intros; apply H2; clear H1 H2; intros;
exists (paire a b).
split;
[ idtac | elim (axs_paire a b b); intros; apply H2; right; reflexivity ].
elim (axs_reunion f (paire a b)); intros; apply H2; clear H1 H2; intros.
exists (couple a b); split;
[ auto with zfc
| unfold couple in |- *;
elim (axs_paire (singleton a) (paire a b) (paire a b));
intros; apply H2; right; reflexivity ].
Qed.
(* End of proof of lem_fun_and_img                                         *)
(* Proof of lem_App                                                   *)
intros; unfold dom in H0.
elim
(axs_comprehension
(fun v0 : E => fun_ f -> exists v1 : E, In (couple v0 v1) f)
(reunion (reunion f)) x); intros; generalize (H1 H0);
clear H0 H1 H2; intros.
elim H0; clear H0; intros; generalize (H1 H); clear H1; intros.
elim H1; clear H1; intros.
exists x0; split; [ exact (lem_fun_and_img f x x0 H H1) | auto with zfc ].
Qed.
(* End of proof of lem_App                                            *)
(* Proof of lem_App_rev                                               *)
intros; unfold Img in H0.
elim
(axs_comprehension
(fun v1 : E => fun_ f -> exists v0 : E, In (couple v0 v1) f)
(reunion (reunion f)) y); intros; generalize (H1 H0);
clear H0 H1 H2; intros.
elim H0; clear H0; intros; generalize (H1 H); clear H1; intros; elim H1;
clear H1; intros.
exists x; split; [ exact (lem_fun_and_dom f x y H H1) | auto with zfc ].
Qed.
(* End of proof of lem_App_rev                                        *)
(***************************************************************************)
(***************************************************************************)
(* Composition d'application                                               *)
(***************************************************************************)
(***************************************************************************)
Definition comp (f g a b c : E) (Af : fun_sig f a b)
(Ag : fun_sig g b c) :=
subset
(fun c : E =>
exists y : E, In (couple (first c) y) f /\ In (couple y (second c)) g)
(cartesien a c).
(***************************************************************************)
(* Il peut paraitre necessaire de reformuler la definition de la           *)
(* composition.                                                            *)
(***************************************************************************)
Definition comp2 (f g a b c : E) :=
subset
(fun x : E =>
fun_sig f a b ->
fun_sig g b c ->
exists y : E, In (couple (first x) y) f /\ In (couple y (second x)) g)
(cartesien a c).
(* Proof of lem_comp2_eq_comp                                              *)
intros; apply axs_extensionnalite; unfold iff in |- *; split; intros.
unfold comp in H.
elim
(axs_comprehension
(fun c0 : E =>
exists y : E, In (couple (first c0) y) f /\ In (couple y (second c0)) g)
(cartesien a c) 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.
unfold comp2 in |- *.
elim
(axs_comprehension
(fun x : E =>
fun_sig f a b ->
fun_sig g b c ->
exists y : E, In (couple (first x) y) f /\ In (couple y (second x)) g)
(cartesien a c) v2); intros; apply H3; clear H2 H3;
intros.
split; [ auto with zfc | intros; exists x; split; auto with zfc ].
unfold comp2 in H.
elim
(axs_comprehension
(fun x : E =>
fun_sig f a b ->
fun_sig g b c ->
exists y : E, In (couple (first x) y) f /\ In (couple y (second x)) g)
(cartesien a c) v2); intros; generalize (H0 H);
clear H H0 H1; intros.
elim H; clear H; intros.
elim (H0 Af Ag); clear H0; intros; elim H0; clear H0; intros.
unfold comp in |- *.
elim
(axs_comprehension
(fun c0 : E =>
exists y : E, In (couple (first c0) y) f /\ In (couple y (second c0)) g)
(cartesien a c) v2); intros; apply H3; clear H2 H3;
intros.
split; [ auto with zfc | exists x; split; auto with zfc ].
Qed.
(* End of proof of lem_comp2_eq_comp                                       *)
(* Proof of lem_comp_is_fun                                                *)
intros.
unfold fun_ in |- *; split; [ exists a; exists c | intros ].
unfold inc in |- *; intros.
unfold comp in H.
elim
(axs_comprehension
(fun c0 : E =>
exists y : E, In (couple (first c0) y) f /\ In (couple y (second c0)) g)
(cartesien a c) v0); intros; generalize (H0 H);
clear H H0 H1; intros.
elim H; clear H; intros; elim H0; clear H0; intros; elim H0; clear H0; intros.
unfold fun_sig in Af; unfold fun_sig in Ag.
elim Af; clear Af; intros.
elim H3; clear H3; intros.
elim Ag; clear Ag; intros.
elim H6; clear H6; intros.
auto with zfc.
unfold comp in H; unfold comp in H0.
elim
(axs_comprehension
(fun c0 : E =>
exists y0 : E,
In (couple (first c0) y0) f /\ In (couple y0 (second c0)) g)
(cartesien a c) (couple x y)); intros; generalize (H1 H);
clear H H1 H2; intros.
elim
(axs_comprehension
(fun c0 : E =>
exists y : E, In (couple (first c0) y) f /\ In (couple y (second c0)) g)
(cartesien a c) (couple x z)); intros; generalize (H1 H0);
clear H0 H1 H2; intros.
elim H; clear H; intros; elim H1; clear H1; intros; elim H1; clear H1; intros.
elim H0; clear H0; intros; elim H3; clear H3; intros; elim H3; clear H3;
intros.
generalize H3; clear H3; rewrite (lem_first_propertie x z); intros.
generalize H4; clear H4; rewrite (lem_second_propertie x z); intros.
generalize H1; clear H1; rewrite (lem_first_propertie x y); intros.
generalize H2; clear H2; rewrite (lem_second_propertie x y); intros.
unfold fun_sig in Af; elim Af; intros.
unfold fun_sig in Ag; elim Ag; intros.
unfold fun_ in H5; unfold fun_ in H7; clear H6 H8.
elim H5; clear H5; intros; clear H5.
elim H7; clear H7; intros; clear H5.
generalize (H6 x x0 x1 H1 H3); clear H1 H3; intros.
generalize H4; clear H4; rewrite <- H1; clear H1; intros.
exact (H7 x0 y z H2 H4).
Qed.
(* End of proof of lem_comp_is_fun                                         *)
(* Proof of lem_comp_dom                                                   *)
intros; apply axs_extensionnalite; intros; unfold iff in |- *; split; intros.
unfold dom in H.
elim
(axs_comprehension
(fun v0 : E =>
fun_ (comp f g a b c Af Ag) ->
exists v1 : E, In (couple v0 v1) (comp f g a b c Af Ag))
(reunion (reunion (comp f g a b c Af Ag))) v2);
intros; generalize (H0 H); clear H H0 H1; intros.
elim H; clear H; intros.
generalize (H0 (lem_comp_is_fun f g a b c Af Ag)); clear H0; intros.
elim H0; clear H0; intros.
unfold comp in H0.
elim
(axs_comprehension
(fun c0 : E =>
exists y : E, In (couple (first c0) y) f /\ In (couple y (second c0)) g)
(cartesien a c) (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.
generalize H1; clear H1 H2; rewrite (lem_first_propertie v2 x); intros.
unfold fun_sig in Af; elim Af; intros.
exact (lem_fun_and_dom f v2 x0 H2 H1).
generalize Af Ag; intros.
unfold fun_sig in Af0; unfold fun_sig in Ag0.
elim Af; clear Af; intros; elim H1; clear H1; intros.
elim Ag; clear Ag; intros; elim H4; clear H4; intros.
generalize (lem_App f v2 H0 H); intros; elim H6; clear H6; intros; elim H6;
clear H6; intros.
unfold inc in H2.
generalize (H2 x); intros.
generalize (H8 H6); clear H6 H8; intros.
cut (In x (dom g)); [ intros | rewrite H4; auto with zfc ].
generalize (lem_App g x H3 H8); intros.
elim H9; clear H9; intros; elim H9; clear H9; intros.
unfold dom in |- *.
elim
(axs_comprehension
(fun v0 : E =>
fun_ (comp f g a b c Af0 Ag0) ->
exists v1 : E, In (couple v0 v1) (comp f g a b c Af0 Ag0))
(reunion (reunion (comp f g a b c Af0 Ag0))) v2);
intros; apply H12; clear H11 H12; intros.
split.
elim (axs_reunion (reunion (comp f g a b c Af0 Ag0)) v2); intros; apply H12;
clear H11 H12; intros.
exists (singleton v2); split; [ idtac | apply lem_x_in_sing_x ].
elim (axs_reunion (comp f g a b c Af0 Ag0) (singleton v2)); intros; intros;
apply H12; clear H11 H12; intros.
exists (couple v2 x0); split;
[ idtac
| unfold couple in |- *;
elim (axs_paire (singleton v2) (paire v2 x0) (singleton v2));
intros; apply H12; left; reflexivity ].
unfold comp in |- *.
elim
(axs_comprehension
(fun c0 : E =>
exists y : E, In (couple (first c0) y) f /\ In (couple y (second c0)) g)
(cartesien a c) (couple v2 x0)); intros; apply H12;
clear H11 H12; intros.
split; [ idtac | exists x ].
elim (lem_cartesian_propertie a c (couple v2 x0)); intros; apply H12;
clear H11 H12; intros.
exists v2; exists x0.
rewrite <- H1; split; [ auto with zfc | split; [ idtac | reflexivity ] ].
unfold inc in H5; generalize (H5 x0); intros; exact (H11 H9).
rewrite (lem_first_propertie v2 x0); rewrite (lem_second_propertie v2 x0);
split; auto with zfc.
intros; exists x0.
unfold comp in |- *.
elim
(axs_comprehension
(fun c0 : E =>
exists y : E, In (couple (first c0) y) f /\ In (couple y (second c0)) g)
(cartesien a c) (couple v2 x0)); intros; apply H13;
clear H12 H13; intros.
split; [ idtac | exists x ].
elim (lem_cartesian_propertie a c (couple v2 x0)); intros; apply H13;
clear H12 H13; intros.
exists v2; exists x0.
rewrite <- H1; split; [ auto with zfc | split; [ idtac | reflexivity ] ].
unfold inc in H5; generalize (H5 x0); intros; exact (H12 H9).
rewrite (lem_first_propertie v2 x0); rewrite (lem_second_propertie v2 x0);
split; auto with zfc.
Qed.
(* End of proof of lem_comp_dom                                            *)
(* Proof of lem_comp_img                                                   *)
intros; unfold inc in |- *; intros.
elim Af; intros; elim H1; clear H1; intros.
elim Ag; intros; elim H4; clear H4; intros.
elim
(lem_App_rev (comp f g a b c Af Ag) v0 (lem_comp_is_fun f g a b c Af Ag) H);
intros.
elim H6; clear H6; intros.
unfold comp in H7.
elim
(axs_comprehension
(fun c0 : E =>
exists y : E, In (couple (first c0) y) f /\ In (couple y (second c0)) g)
(cartesien a c) (couple x v0)); intros; generalize (H8 H7);
clear H7 H8 H9; intros.
elim H7; clear H7; intros; elim H8; clear H8; intros; elim H8; clear H8;
intros.
generalize H9; clear H9; rewrite (lem_second_propertie x v0); intros.
exact (lem_fun_and_img g x0 v0 H3 H9).
Qed.
(* End of proof of lem_comp_img                                            *)
(* Proof of lem_comp_make                                                  *)
intros; unfold comp in |- *.
elim
(axs_comprehension
(fun c0 : E =>
exists y : E, In (couple (first c0) y) f /\ In (couple y (second c0)) g)
(cartesien a c) (couple x z)); intros; apply H2;
clear H1 H2; intros.
split;
[ idtac
| exists y; rewrite (lem_first_propertie x z);
rewrite (lem_second_propertie x z); split; auto with zfc ].
elim Af; clear Af; intros; elim H2; clear H2; intros.
elim Ag; clear Ag; intros; elim H5; clear H5; intros.
elim (lem_cartesian_propertie a c (couple x z)); intros; apply H8;
clear H7 H8; intros.
exists x; exists z; split;
[ rewrite <- H2; exact (lem_fun_and_dom f x y H1 H)
| split; [ idtac | reflexivity ] ].
generalize (lem_fun_and_img g y z H4 H0); intros.
unfold inc in H6; exact (H6 z H7).
Qed.
(* End of proof of lem_comp_make                                           *)

(***************************************************************************)
(* (x,z) in g o f -> il existe un y tel que (x,y) in f et (y,z) in g       *)
(***************************************************************************)
Lemma lem_comp_intermed :
forall (f g a b c x z : E) (Af : fun_sig f a b) (Ag : fun_sig g b c),
In (couple x z) (comp f g a b c Af Ag) ->
exists y : E, In (couple x y) f /\ In (couple y z) g.