Section relations_noetherian.
Variable U : Set.
Variable R : U -> U -> Prop.
(* Sets as characteristic predicates over universe U *)
Definition a_set := U -> Prop.
(* A is a subset of B *)
Definition sub (A B : a_set) := forall x : U, A x -> B x.
(* The full universe *)
Definition universal (A : a_set) := forall x : U, A x.
(* Adjoint map *)
Definition adjoint (A : a_set) : a_set := fun x : U => sub (R x) A.
Definition hereditary (A : a_set) := sub (adjoint A) A.
(*  i.e  (hereditary A) <-> (x:A)(sub (R x) A)->(A x) *)
Definition explicit_noetherian :=
forall A : a_set, hereditary A -> universal A.
End relations_noetherian.
Notation noetherian := (explicit_noetherian _) (only parsing).
(* <Warning> : Syntax is discontinued *)
(**********************)
(* quelques resultats *)
(* sur le Ex *)
Goal
forall (A : Set) (P Q : A -> Prop),
(exists u : A, P u /\ Q u) -> exists u : A, Q u /\ P u.
simple induction 1; intros u1 H1.
elim H1; intros H2 H3.
exists u1; split; assumption.
Save Ex_PQ.
Hint Resolve Ex_PQ.
(* sur les constructions de relations *)
intros A R x y z H; elim H.
intros x0 H1; assumption.
intros x0 y0 z0 H1 H2 H3 H4; apply star_trans1 with y0.
assumption.
exact (H3 H4).
Qed.
Goal
forall (A : Set) (R : A -> A -> Prop) (x y : A),
R x y -> explicit_star _ R x y.
intros; apply star_trans1 with y.
assumption.
apply star_refl.
Save star_step1.
Hint Resolve star_step1.
Goal
forall (A : Set) (R1 R2 : A -> A -> Prop) (M N : A),
explicit_comp_rel _ R1 R2 M N -> exists u : A, R1 M u /\ R2 u N.
intros A R1 R2 M N H; elim H.
intros x y z H1 H2; exists y; split; assumption.
Save comp_case.
Goal
forall (A : Set) (R : A -> A -> Prop) (x y : A),
explicit_comp_rel _ R (explicit_star _ R) x y -> explicit_rel_plus _ R x y.
intros A R x y H; elim H.
intros a b c H1 H2; generalize H1; generalize a.
elim H2.
intros; apply relplus_1step; assumption.
intros x0 y0 z H3 H4 H5 a0 H6; apply relplus_trans1 with x0.
assumption.
apply H5; assumption.
Save comp_relplus.
Goal
forall (A : Set) (R : A -> A -> Prop) (M N : A),
explicit_star _ R M N ->
M = N \/ (exists u : A, R M u /\ explicit_star _ R u N).
intros A R M N H; elim H.
intros x; left; trivial.
intros x y z H1 H2 H3; right; exists y; split; trivial.
Save star_case.
Goal
forall (A : Set) (R : A -> A -> Prop) (x y z : A),
explicit_rel_plus _ R x y ->
explicit_rel_plus _ R y z -> explicit_rel_plus _ R x z.
simple induction 1.
intros; apply relplus_trans1 with y0; trivial.
intros; apply relplus_trans1 with y0; auto.
Save Rplus_transitive.
Goal
forall (A : Set) (R : A -> A -> Prop) (x y : A),
explicit_rel_plus _ R x y -> explicit_star _ R x y.
simple induction 1; intros.
auto.
apply star_trans1 with y0; auto.
Save Rplus_Rstar.
Hint Resolve Rplus_Rstar.
Goal
forall (A : Set) (R : A -> A -> Prop) (x y z : A),
explicit_star _ R x y ->
explicit_rel_plus _ R y z -> exists u : A, R x u /\ explicit_star _ R u z.
simple induction 1; intros.
elim H0; intros.
exists y0; auto.
exists y0; auto.
exists y0; split; trivial.
apply star_trans with z0; auto.
Save Rstar_Rplus_R.
(* sur les relations noetheriennes *)
Goal
forall (A : Set) (R : A -> A -> Prop),
explicit_noetherian _ R ->
forall A1 : a_set A,
hereditary A (explicit_rel_plus _ R) A1 ->
universal A (adjoint A (explicit_star _ R) A1).
unfold explicit_noetherian in |- *; unfold hereditary in |- *;
unfold universal in |- *; unfold sub in |- *; intros A R N A1 H x.
apply (N (adjoint A (explicit_star _ R) A1)).
unfold adjoint in |- *; unfold sub in |- *; intros.
apply H; unfold adjoint in |- *; unfold sub in |- *; intros.
elim Rstar_Rplus_R with A R x0 x1 x2; trivial.
intro z; simple induction 1; intros C1 C2; apply H0 with z; trivial.
Save noetherian_course_of_values.
generalize noetherian_course_of_values.
unfold adjoint in |- *; unfold universal in |- *; unfold sub in |- *; intros.
unfold explicit_noetherian in |- *; unfold universal in |- *;
unfold sub in |- *; intros.
apply (H A R H0 A0 H1 x x).
auto.
Qed.
unfold explicit_noetherian in |- *; unfold universal in |- *;
unfold hereditary in |- *; unfold adjoint in |- *;
unfold sub in |- *; unfold a_set in |- *; intros.
pattern x in |- *; apply H; exact H0.
Qed.
intros; pattern x in |- *;
apply noetherian_induction1 with A (explicit_rel_plus _ R).
apply plus_preserves_noetherian; assumption.
exact H0.
Qed.

Lemma noether_inclus :
forall (A : Set) (R R' : A -> A -> Prop),
explicit_noetherian _ R ->
(forall x y : A, R' x y -> R x y) -> explicit_noetherian _ R'.