(** Load required packages.  Not all of these packages are needed right away,
but they may be useful later. **)

Require Export Setoid List Sorted Constructive_sets Utf8_core Wf_nat
ProofIrrelevance Permutation IndefiniteDescription ChoiceFacts
Description Classical_Prop Utf8.

(** Math symbols for cut and paste: ∀ ∃ → ↔ ∧ ∨ ¬ ≠ ≤ ≥ ∅ ℕ ℤ ∈ ∉ ⊂ ∑ ∏ λ **)

(** Axioms for the integers. **)

Parameter Z : Set.

Parameter add mult : Z → Z → Z.
Parameter neg : Z → Z.
Parameter zero one : Z.
Notation "0" := zero.
Notation "1" := one.
Infix "+" := add.
Infix "*" := mult.
Notation "- x" := (neg x).
Notation "- 0" := (neg 0).
Notation "- 1" := (neg 1).
Definition sub a b := a + -b.
Infix "-" := sub.

Axiom A1 : ∀ a b   : Z, a + b = b + a.
Axiom A2 : ∀ a b c : Z, a + (b + c) = (a + b) + c.
Axiom A3 : ∀ a     : Z, a + 0 = a.
Axiom A4 : ∀ a     : Z, a + -a = 0.
Axiom M1 : ∀ a b   : Z, a * b = b * a.
Axiom M2 : ∀ a b c : Z, a * (b * c) = (a * b) * c.
Axiom M3 : ∀ a     : Z, a * 1 = a.
Axiom D1 : ∀ a b c : Z, (a + b) * c = a * c + b * c.

(** Some useful lemmas. **)
Lemma S1 : ∀ a b c : Z, a = b → a + c = b + c.
Proof.
intros a b c H.
rewrite H.
reflexivity.
Qed.

Lemma S2 : ∀ a b c : Z, a = b → a * c = b * c.
Proof.
intros a b c H.
rewrite H.
reflexivity.
Qed.

Theorem A1P1 : ∀ a : Z, 0 + a = a.
Proof.
intros.
pose proof (A3 a).
rewrite (A1 a 0) in H.
exact H.
Qed.

Theorem A1P2 : ∀ a : Z, -a + a = 0.
Proof.
intros.
pose proof (A4 a).
rewrite (A1) in H.
exact H.
Qed.

Theorem A1P3 : ∀ a : Z, 1 * a = a.
Proof.
intros.
pose proof (M3 a).
rewrite (M1 a 1) in H.
exact H.
Qed.

Theorem A1P4 : ∀ a b : Z, a + b = 0 → b = -a.
Proof.
intros.
rewrite (A1) in H.
pose proof (S1 (b+a) 0 (-a)).
pose (J := H0 H).
rewrite <-(A2 b a (-a)) in J.
rewrite (A4 a) in J.
rewrite (A3 b) in J.
rewrite (A1 0 (-a)) in J.
rewrite (A3 (-a)) in J.
exact J.
Qed.

Theorem A1P5 : forall a : Z, -(-a) = a.
intros.
symmetry.
apply A1P4.
rewrite A1.
pose proof (A4 a).
exact H.
Qed.

Theorem A1P6 : ∀ a : Z, 0 * a = 0.
Proof.
intros.
pose proof (A3 (0*a)).
rewrite <-(A4 a) in H at 2.
rewrite <-(M3 a) in H at 2.
rewrite (M1 a 1) in H.
rewrite A2 in H.
rewrite <-D1 in H.
rewrite (A1 0 1) in H.
rewrite A3 in H.
rewrite M1 in H.
rewrite M3 in H.
rewrite A4 in H.
symmetry.
trivial.
Qed.

Theorem A1P7 : ∀ a : Z, -1 * a = -a.
Proof.
intros.
pose proof (A3 (-1*a)).
rewrite <-(A4 a) in H.
rewrite (A2 (-1*a) a (-a)) in H.
rewrite <-(M3 a) in H at 2.
rewrite (M1 a 1) in H.
rewrite <-(D1) in H.
rewrite (A1 (-1) 1) in H.
rewrite (A4 1) in H.
rewrite A1P6 in H.
rewrite A1P1 in H.
symmetry.
trivial.
Qed.

Theorem A1P8 : ∀ a b : Z, -a * -b = a * b.
Proof.
intros.
pose proof (A1P7 (-a * b)).
rewrite <-(A1P7 a) in H at 1.
rewrite (M1 (-1) a) in H.
rewrite (A1P7) in H.
rewrite <-(M2 a (-1) b) in H.
rewrite <-(A1P7) in H at 1.
rewrite M2 in H.
rewrite A1P7 in H.
rewrite A1P7 in H.
rewrite <-(A1P7 a) in H at 2.
rewrite <-M2 in H.
rewrite (A1P7 (a * b)) in H.
rewrite (A1P5) in H.
trivial.
Qed.

Theorem A1P9 : ∀ a b : Z, a + b = a → b = 0.
Proof.
intros.
apply (S1 (a+b) a (-a)) in H.
rewrite (A1 a b) in H.
rewrite <-A2 in H.
rewrite (A4 a) in H.
rewrite A3 in H.
trivial.
Qed.

(*
Theorem A1P11yeet : ∀ a b : Z, a * b = 0 → a = 0 ∨ b = 0.
Proof.
intros a b H.
apply (S1 (a*b) 0 (1*b)) in H.
rewrite <-D1 in H.
rewrite A1P3 in H.
rewrite A1P1 in H.
rewrite M1 in H.
apply A1P10 in H.
destruct H.
apply (S1 (a+1) 1 (-1)) in H.
rewrite <-A2 in H.
rewrite A4 in H.
rewrite A3 in H.
left.
exact H.
right.
exact H.
Qed.

Theorem A1P11_v2 : ∀ a b : Z, a * b = 0 → a = 0 ∨ b = 0.
Proof.
intros a b H.
apply (S1 (a*b) 0 (1*b)) in H.
rewrite <-D1 in H.
rewrite A1P3 in H.
rewrite A1P1 in H.
rewrite M1 in H.
apply A1P10 in H.
destruct H.
apply (S1 (a+1) 1 (-1)) in H.
rewrite <-A2 in H.
rewrite A4 in H.
rewrite A3 in H.
left.
exact H.
right.
exact H.
Qed.   *)

(** Definition of divides. In the course notes, the notation is
slightly different: "a|b" instead of "(a|b)". Coq requires
extra parentheses or else this notation would conflict with
set notation. **)

Definition divide (x y : Z) := ∃ z : Z, y = z * x.
Notation "( x | y )" := (divide x y).

(**
Definition of ℕ. You need to fill in the content of the definition.
If you wish to declare ℕ as an axiom, change "Definition" to "Parameter".
**)

Parameter ℕ : Ensemble Z.
Infix "∋" := (In Z) (at level 70).
Notation "x ∈ S" := (S ∋ x) (at level 70).
Infix "⊂" := (Included Z) (at level 70).
Notation "{ x : A | P }" := (λ x : A, P).

Check {x : Z | x = x+1}.
Infix "∋" := (In Z) (at level 70).
Notation "x ∈ S" := (S ∋ x) (at level 70).
Infix "⊂" := (Included Z) (at level 70).
Notation "{ x : A | P }" := (λ x : A, P).

(******************************Axioms for natural numbers****************)

Axiom N1 : 1 ∈ ℕ.
Axiom N2 : ∀ a b : Z, a ∈ ℕ → b ∈ ℕ → a+b ∈ ℕ. (*closure*)
Axiom N3 : ∀ a : Z, a ∈ ℕ -> ¬(-a ∈ ℕ).
Axiom O8 : forall a b : Z, a ∈ ℕ -> b ∈ ℕ -> a*b ∈  ℕ.

Axiom T : ∀ a : Z, (a ∈ ℕ ∧ a ≠ 0 ∧ ¬(-a ∈ ℕ))
∨ a=0 /\(¬(a ∈ ℕ) ∧ ¬(-a ∈ ℕ))
∨ -a ∈ ℕ /\(¬(a ∈ ℕ) ∧ a ≠ 0).

(*************************************************************************************************************************************************************************************************************************************)
(* ℕ = {x : Z | x > 0} *)
Definition lt (a b : Z) := b-a ∈ ℕ.
Definition le (a b : Z) := ((lt a b) ∨ a = b).

Infix "<" := lt.
Notation "a > b" := (b < a) (only parsing).
Infix "≤" := le (at level 70).
Notation "a ≥ b" := (b ≤ a) (at level 70, only parsing).

Theorem S1converse : forall a b c: Z, a+c = b+c -> a=b.
intros.
apply (S1 (a+c) (b+c) (-c)) in H.
rewrite <-A2, <-A2, A4, 2 A3 in H.
auto.
Qed.

Theorem neqadd : forall a b c : Z, a≠b -> a+c≠b+c.
Proof.
intros.
unfold not in *.
pose (S1 a b c).
intros.
apply S1converse in H0.
pose (H H0).
auto.
Qed.

Theorem T2 : ∀ a b : Z, b<a ∧ a≠b ∧ ¬a<b ∨ a<b ∧ a≠b ∧ ¬b<a ∨ a=b ∧ ¬b<a ∧ ¬a<b.
Proof.
intros.
pose (T (a-b)).
unfold lt.
destruct (T a) as [[H3 [H4 H5]]| [[H6 [H7 H8]]| [H9 [H10 H11]]]].
Admitted.
(***********
Theorem T2 : ∀ a b : Z, b<a ∧ a≠b ∧ ¬a<b ∨ a<b ∧ a≠b ∧ ¬b<a ∨ a=b ∧ ¬b<a ∧ ¬a<b.
Proof.
intros.
destruct (T (a-b)) as [[K3 [K4 K5]]| [[K6 [K7 K8]]| [K9 [K10 K11]]]].
unfold lt.
left.
split.
exact K3.
split.
apply (neqadd (a-b) 0 b) in K4.
unfold sub in K4.
rewrite <-A2, A1P2, A1P1, A3 in K4.
exact K4.
unfold sub in K5.
rewrite A1, <-A1P7, M1, D1, A1P8, M1, A1P3, M1, A1P7 in K5.
unfold sub.
exact K5.
unfold lt.
rewrite <-A1P7, <-A1P7 in K8. M1, D1 in K8.
tauto.
Admitted.
******************************************)

Theorem zeronotnat : 0 ∈ ℕ -> False.
Proof.
pose proof (T 0).
tauto.
Qed.

Theorem negzero : -0 = 0.
Proof.
rewrite <-A1P7.
rewrite M1.
rewrite A1P6.
reflexivity.
Qed.

Theorem A1P11 : ∀ a b : Z, a * b = 0 → a = 0 ∨ b = 0.
Proof.
intros.
destruct (T a) as [[H3 [H4 H5]]| [[H6 [H7 H8]]| [H9 [H10 H11]]]].
destruct (T b) as [[s3 [s4 s5]]| [[s6 [s7 s8]]| [s9 [s10 s11]]]].
pose ((O8 a b) H3 s3).
rewrite H in i.
now pose zeronotnat.
auto.
pose ((O8 a (-b)) H3 s9).
rewrite <-A1P7, M2, (M1 a (-1)), <-M2, H, M1, A1P6  in i.
now pose zeronotnat.
auto.
destruct (T b) as [[s3 [s4 s5]]| [[s6 [s7 s8]]| [s9 [s10 s11]]]].
pose ((O8 (-a) b) H9 s3).
rewrite <-A1P7, <-M2, H, M1, A1P6 in i.
now pose zeronotnat.
auto.
pose ((O8 (-a) (-b)) H9 s9).
rewrite A1P8, H in i.
now pose zeronotnat.
Qed.

Theorem C1 : forall a b c : Z, a * c = b * c -> a = b \/ c = 0.
Proof.
intros.
eapply S1 in H.
rewrite (A4 (b*c)) in H.
rewrite <-A1P7, M2, A1P7, <-D1 in H.
apply A1P11 in H.
destruct H.
eapply S1 in H.
rewrite <-A2, A1P2, A3, A1P1 in H.
auto.
auto.
Qed.

Theorem A1P10 : ∀ a b : Z, a * b = a → b = 1 \/ a = 0.
Proof.
intros.
pose proof (C1 b 1 a).
rewrite A1P3 in H0.
rewrite M1 in H.
pose (J := H0 H).
exact J.
Qed.

Theorem am0 : forall a : Z, a - 0=a.
Proof.
intros.
unfold sub.
rewrite negzero, A3.
reflexivity.
Qed.

Theorem am02: forall a : Z, 0 - a = -a.
Proof.
intros.
unfold sub.
rewrite A1, A3.
reflexivity.
Qed.

Theorem O9 : forall a : Z, a ∈ ℕ <->  0 < a.
Proof.
intros.
unfold lt.
rewrite am0.
reflexivity.
Qed.

Theorem O92 : forall a : Z, a<0 -> ¬(a ∈ ℕ).
Proof.
intros.
pose (T a).
unfold lt in H.
rewrite am02 in H.
tauto.
Qed.

Theorem O1 : ∀ a b : Z, a < b → a ≠ b.
intros.
pose (T2 a b).
tauto.
Qed.

Theorem O1_V2 : ∀ a b : Z, a < b → a ≠ b. (*Old*)
intros.
unfold lt in *.
pose (T (b-a)).
pose (J := (N3 (b-a)) H).
intuition.
apply (S1 a b (-a)) in H0.
symmetry in H0.
rewrite A4 in H0.
unfold sub in *.
pose (K := H1 H0).
exact K.
Qed.

Theorem O2 : ∀ a b c : Z, a < b → a+c < b+c.
Proof.
intros.
unfold lt, sub in *.
rewrite <-A1P7.
rewrite M1.
rewrite D1.
rewrite 2 (M1 _ (-1)).
rewrite 2 A1P7.
rewrite (A1 (-a)).
rewrite A2.
rewrite <-(A2 b).
rewrite A4.
rewrite A3.
exact H.
Qed.

Print Assumptions O2. (*prints out all of the axioms used in proving theorem 02*)

Theorem lttrans : ∀ a b c : Z, a < b → b < c → a < c. (*old O3*)
Proof.
intros.
unfold lt, sub in *.
rewrite <-A3.
rewrite <-(A4 b).
rewrite (A1 b (-b)).
rewrite A2.
rewrite <-(A2 c (-a) (-b)).
rewrite (A1 (-a) (-b)).
rewrite A2.
rewrite <-(A2 (c + -b) (-a) b).
rewrite (A1 (-a) b) .
apply (N2 (c+ -b) (b + -a)).
exact H0.
exact H.
Qed.

Theorem O4 : 0 < 1.
Proof.
unfold lt, sub.
pose N1.
rewrite <-A3 in i.
rewrite negzero.
exact i.
Qed.

Lemma L2P1 : ∀ a m x : Z, (a | m) → (a | m * x).
Proof.
intros.
unfold divide in *.
destruct H.
apply (S2 m (x0*a) x) in H.
rewrite <-M2 in H.
rewrite (M1 a x) in H.
rewrite M2 in H.
exists (x0*x).
exact H.
Qed.

Theorem A2P1 : ∀ a m n x y : Z, (a | m) → (a | n) → (a | m * x + n * y).
Proof.
intros a m n x y [k H] [l H0].
exists (k*x+l*y).
rewrite H,H0, ? (M1 _ a), <-? M2, ? (M1 a), D1.
reflexivity.
Qed.

Theorem A2P2: ∀ x a b c : Z, (a | b) → (b | c) → (a | c).
Proof.
intros.
unfold divide in *.
destruct H.
rewrite H in H0.
destruct H0.
rewrite H0.
rewrite M2.
exists (x1*x0).
trivial.
Qed.

Theorem O5 : forall a b : Z, a = b \/ a ≠ b.
intros.
pose (T2 a b).
tauto.
Qed.

Theorem O7 : forall a b : Z, a ≠ b -> a > b \/ a < b.
intros.
pose (T2 a b).
tauto.
Qed.

Theorem A2P3 : ∀ a b : Z, a < b ∨ a = b ∨ a > b.
intros.
pose (T2 a b).
tauto.
Qed.

Theorem A2P3_old : ∀ a b : Z, a < b ∨ a = b ∨ a > b.
Proof.
intros a b.
destruct (classic (a < b)), (classic (a=b)), (classic (b < a)).
left.
exact H.
right; left; exact H0.
right; right; exact H1.
left; exact H.
right; left; exact H0.
right; left; exact H0.
right; right; exact H1.
pose proof (O7 a b).
pose (J := H2 H0).
destruct J.
contradiction.
contradiction.
Qed.

Theorem A2P4 : ∀ a b c : Z, a < b → c > 0 -> a * c < b * c.
Proof.
intros.
unfold lt, sub in H.
unfold lt, sub.
rewrite <-A1P7.
rewrite M2.
rewrite <-D1.
rewrite A1P7.
apply O8.
exact H.
apply (O9 c) in H0.
exact H0.
Qed.

Theorem A2P5 : ∀ a b c : Z, a * c = b * c → c ≠ 0 → a = b.
Proof.
intros.
pose proof S1 (a*c) (b*c) (-b*c).
rewrite <-D1 in H1.
rewrite <-D1 in H1.
rewrite A4 in H1.
rewrite A1P6 in H1.
apply A1P11 in H1.
destruct H1.
apply (S1 (a+-b) 0 b) in H1.
rewrite <-A2 in H1.
rewrite A1P2 in H1.
rewrite A3, A1P1 in H1.
exact H1.
contradiction.
exact H.
Qed.

Definition pm (a b : Z) := (a = b ∨ a = -b).
Notation "a = ± b" := (pm a b) (at level 60).
Definition assoc (a b : Z) := (a | b) ∧ (b | a).
Infix "~" := assoc (at level 70).

Theorem A3P1 : 0 ≠ 1.
Proof.
pose proof (O1 0 1).
pose proof O4.
pose (J := H H0).
exact J.
Qed.

Lemma symm : forall a b : Z, (a=b) -> (b=a).
Proof.
intros.
symmetry.
trivial.
Qed.

Theorem NTP : forall a b : Z, (a>0) -> (b<0) -> (a*b<0).
Proof.
intros.
Admitted.

Theorem O13 : forall a b : Z, a < b -> ¬((a=b)\/(b<a)).
Admitted.

Theorem O14 : forall a b : Z, a<b -> (-a)>(-b).
Proof.
intros.
pose (J:= (O2 a b (-a + -b)) H).
rewrite (A1 (-a) (-b)) in J at 2.
rewrite ? A2 in *.
rewrite 2 A4 in J.
rewrite 2 A1P1 in J.
exact J.
Qed.

Theorem O15 : forall a b : Z, a>0 -> b<0 -> a*b<0.
Admitted.

Theorem O16 : forall b : Z, ¬ 0<b -> b=0\/b<0.
Admitted.

Lemma N_0_lt : ∀ x : Z, x ∈ ℕ ↔ 0 < x.
Admitted.

Lemma le_lt_opp : ∀ a b : Z, a ≤ b ↔ ¬ b < a.
Admitted.

Lemma lt_trans : ∀ a b c : Z, a < b → b < c → a < c.
Admitted.

Lemma mult_0 : ∀n m, n * m = 0 ↔ n = 0 ∨ m = 0.
Admitted.
Lemma mult_0_3 :
∀n m p, n * m * p = 0 ↔ n = 0 ∨ m = 0 ∨ p = 0.
Proof.
intros n m p.
rewrite mult_0.
rewrite mult_0. rewrite or_assoc.
reflexivity.
Qed.

Theorem ONN : forall a : Z,  a=0 -> ¬ a ∈ ℕ.
Admitted.

Theorem NNT : forall a : Z,  ¬ a∈ ℕ/\a≠ 0 -> -a∈ ℕ.
Admitted.

Theorem NTNN : forall a b : Z, a∈ℕ-> ¬b∈ℕ ->  ¬a*b∈ℕ.
Admitted.

Theorem facsofNat : forall a b : Z, 0<a*b -> 0<a/\0<b \/ a<0/\ b<0. (*need an axiom that separates int from mod*)
Proof.
intros.
destruct (O9 (a*b)).
pose (H1 H).
destruct (T a) as [[K3 [K4 K5]]| [[K6 [K7 K8]]| [K9 [K10 K11]]]].
destruct (T b) as [[H3 [H4 H5]]| [[H6 [H7 H8]]| [H9 [H10 H11]]]].
unfold lt in *.
rewrite ? am0, ? am02 in *.
auto.
rewrite M1, H6, A1P6 in i.
pose zeronotnat.
contradiction.
pose ((O8 a (-b)) K3 H9).
apply N3 in i0.
rewrite M1, <-A1P7 in i0.
rewrite <-(A1P7 b), 2 M2, A1P7, A1P5, A1P3, M1 in i0.
contradiction.
rewrite K6,A1P6 in i.
pose zeronotnat.
contradiction.
destruct (T b) as [[H3 [H4 H5]]| [[H6 [H7 H8]]| [H9 [H10 H11]]]].
pose ((O8 (-a) b) K9 H3).
apply N3 in i0.
rewrite <-A1P7 in i0.
rewrite <-(A1P7 a) in i0.
rewrite 2 M2, A1P7, A1P5, A1P3  in i0.
contradiction.
rewrite H6, M1, A1P6 in i.
pose zeronotnat.
contradiction.
right.
unfold lt.
rewrite ? am02.
auto.
Qed.

Theorem MN : forall a b : Z, a*b∈ℕ -> a≠0/\b≠0.
intros.
rewrite O9 in H.
pose ((facsofNat a b) H).
pose (T a).
rewrite O9 in *.
split.
destruct o as [[m1 m2] | [m3 m4]].
tauto.
destruct o0 as [[H3 [H4 H5]]| [[H6 [H7 H8]]| [H9 [H10 H11]]]].
auto.
unfold lt in m3.
rewrite am02 in m3.
contradiction.
auto.
clear o0.
destruct (T b) as [[H3 [H4 H5]]| [[H6 [H7 H8]]| [H9 [H10 H11]]]].
auto.
destruct o as [[m1 m2] | [m3 m4]].
unfold lt in m2; rewrite am0 in m2.
contradiction.
unfold lt in m4; rewrite am02 in m4; contradiction.
auto.
Qed.

Theorem albNbla : forall a b : Z, a<b ->  ¬ b<a.
intros.
pose (T2 a b).
tauto.
Qed.

Theorem albNblea : forall a b : Z, a<b -> ¬ b≤a.
intros.
destruct (T2 a b) as [[H3 [H4 H5]]| [[H6 [H7 H8]]| [H9 [H10 H11]]]].
contradiction.
unfold le, not.
intros.
destruct H0.
contradiction.
symmetry in H0; contradiction.
contradiction.
Qed.

Theorem A3P2 : ∀ a b : Z, 0 < a → (0 < b ↔ 0 < a * b).
Proof.
intros.
unfold iff, lt in *.
split.
rewrite ? am0 in *.
pose ((O8 a b) H).
exact i.
rewrite ? am0 in *.
intros.
rewrite O9 in *.
apply facsofNat in H0.
destruct H0 as [[k1 k2] | [k3 k4]].
auto.
apply albNbla in k3.
contradiction.
Qed.

(*********************************SETS**********************************************************************************************************)

Notation "x < y < z" := (x < y ∧ y < z).
Notation "x ≤ y < z" :=
(x ≤ y ∧ y < z) (at level 70, y at next level).

Infix "∋" := (In Z) (at level 70).
Notation "x ∈ S" := (S ∋ x) (at level 70).
Notation "x ∉ S" := (¬(x ∈ S)) (at level 70).
Infix "⊂" := (Included Z) (at level 70).
Notation "∅" := (Empty_set Z).
Notation "{ x : A | P }" := (λ x : A, P).

Axiom WOP : ∀ S, S ≠ ∅ →
S ⊂ ℕ → ∃ x, x ∈ S ∧ ∀ y, y ∈ S → x ≤ y.

(*Messiest, luckiest thing*)
Theorem A3P3_me : ∀ a : Z, 0 < a → a < 1 → False.
Proof.
intros.
destruct (WOP {x:Z | 0<x<1}).
unfold not.
intros.
assert (a∈∅).
rewrite <-H1.
unfold In.
auto.
contradiction.
unfold Included.
intros.
destruct H1.
rewrite <-O9 in H1.
auto.
destruct H1.
unfold In in H1.
pose (H2 (x*x)).
destruct H1.
pose ((A2P4 x 1 x) H3 H1).
rewrite (A1P3 x) in l0.
apply albNblea in l0.
unfold In in *.
contradiction l0. (*even when contradiction is from H1: P->Q, and H2 : not Q *)
destruct l.
assert (x*x<x).
{eapply A2P4 in H3.
erewrite A1P3 in H3.
eauto.
auto. }
eapply A2P4 in H1.
rewrite A1P6 in H1.
split.
eauto.
eauto using lttrans.
auto.
unfold le in l0.
destruct l0.
left.
auto.
destruct l0.
right.
auto.
Qed.
(*contradiction between rationals and integers... naturalrationals  are screaming to come to the suface in X*x<1 from x<1**)

Theorem A3P3 : ∀ a : Z, 0 < a → a < 1 → False.
Proof.
intros.
destruct (WOP {x : Z | 0 < x < 1}).
- unfold not.
intros.
assert (a ∈ ∅).
{ rewrite <-H1.
(* Locate "∈". *)
unfold In.
tauto. }
contradiction.
- unfold Included.
intros.
unfold In in H1.
rewrite N_0_lt.
tauto.
- unfold In in H1.
destruct H1 as [[H1 H2] H3].
pose proof (H3 (x*x)).
assert (x*x < x).
{ eapply A2P4 in H2.
rewrite A1P3 in H2.
exact H2.
exact H1. }
rewrite le_lt_opp in H4.
contradiction H4.
split.
+ eapply A2P4 in H1.
* rewrite A1P6 in H1.
eauto.
* auto.
+ eauto using lt_trans.
Qed.

Theorem MxP : forall a b : Z, a∈ℕ-> ¬b∈ℕ -> ¬a*b∈ℕ.
Proof.
intros.
destruct (T b) as [[K3 [K4 K5]]| [[K6 [K7 K8]]| [K9 [K10 K11]]]].
contradiction.
pose (A1P6 a).
rewrite <-K6 in e at 1.
rewrite M1 in e.
pose (T (a*b)).
tauto.
Admitted.

Theorem A3P4 : ∀ a b : Z, (a | b) -> 0<b → a ≤ b.
Proof.
intros.
unfold le,lt, divide in *.
rewrite am0 in *.
elim H; intros.
destruct (T2 a b) as [[H3 [H4 H5]]| [[H6 [H7 H8]]| [H9 [H10 H11]]]].
destruct (T2 x 1) as [[K3 [K4 K5]]| [[K6 [K7 K8]]| [K9 [K10 K11]]]].
rewrite ? O9 in *.
pose ((lttrans 0 b a) H0 H3).
apply (A2P4 1 x a) in K3.
rewrite <-H1, A1P3 in K3.
contradiction.
exact l.
rewrite O9 in H0.
pose ((lttrans  0 b a) H0 H3).
destruct (facsofNat x a).
rewrite <-H1.
auto.
destruct H2.
pose ((A3P3 x) H2 K6).
contradiction.
destruct H2.
apply albNbla in H6.
contradiction.
rewrite K9, A1P3 in H1.
symmetry in H1.
right.
auto.
unfold lt in H6.
left; auto.
right;auto.
Qed.

Theorem div1 : forall a : Z, (1|a).
Proof.
intros.
exists a.
rewrite M3.
trivial.
Qed.

Theorem aa : forall a : Z, ¬a<a.
Proof.
intros.
unfold lt, sub.
rewrite A4.
exact zeronotnat.
Qed.

Theorem lt_x_neg : forall a b c : Z, a<b -> c<0 -> b*c < a*c.
Proof.
intros.
Admitted.

Theorem help1 : forall x: Z, x<0 -> 1≤-x.
Proof.
intros.
pose O4.
apply (O2 0 1 (-1)) in l.
rewrite A4, A1P1 in l.
pose ((lt_x_neg x 0 (-1)) H l).
rewrite A1P6, M1, A1P7 in l0.
pose (div1 (-x)).
pose ((A3P4 1 (-x)) d l0).
exact l1.
Qed.

Theorem help2 : forall x : Z, 0<x -> 1≤x.
intros.
destruct (T x) as [[K3 [K4 K5]]| [[K6 [K7 K8]]| [K9 [K10 K11]]]].
rewrite O9 in K3.
pose (div1 x).
pose ((A3P4 1 x) d H).
exact l.
rewrite K6 in H.
pose (aa 0).
contradiction.
rewrite <-O9 in H.
contradiction.
Qed.

Theorem lts : forall a b : Z, a<b -> ¬b<a.
Proof.
intros.
pose (T2 a b).
tauto.
Qed.

Theorem gtg0 : forall a : Z, 1<a -> 0<a.
intros.
pose ((lttrans 0 1 a) O4 H).
auto.
Qed.

(*can apply things in goal if P->Q, P Q is the goal*)

Lemma aleblea : forall a b : Z,  a ≤ b-> b ≤ a -> a=b.
intros.
destruct H.
unfold le in *.
pose (A2P3 a b).
destruct o, H0.
apply albNbla in H.
contradiction.
symmetry in H0; exact H0.
apply albNbla in H0.
contradiction.
symmetry; auto.
destruct H0.
pose (T2 a b).
tauto.
auto.
Qed.

Lemma alt0ltnega : forall a : Z, a<0 -> 0< -a.
intros.
eapply O2 in H.
rewrite A4, A1P1 in H.
auto.
Qed.

Lemma negdiv : forall a b : Z, (b | a) -> (-b | -a).
intros.
unfold divide in *.
destruct H.
eapply S2 in H.
erewrite (M1 a (-1))  in H.
erewrite <-M2, (M1 b _), 2 A1P7 in H.
exists x.
auto.
Qed.

Theorem negeqneg : forall a b: Z, -a=-b -> a =b.
intros.
apply (S2 _ _ (-1)) in H.
rewrite 2 (M1 _ (-1)), ? A1P7, ? A1P5 in H.
easy.
Qed.

Theorem facsofNat2 : forall a b : Z, a*b<0 -> a<0/\0<b \/0<a/\b<0.
intros.
unfold lt.
apply O14 in H.
rewrite <-(A1P7 (a*b)), M2, (M1 (-1) _), <-M2, A1P7 in H.
rewrite negzero in H.
pose ((facsofNat a (-b)) H).
unfold lt in o.
rewrite ? am0, ? am02 in *.
rewrite A1P5 in o.
tauto.
Qed.

Theorem S2le : forall a b c: Z, a≤b -> 0<c -> a*c≤b*c.
Proof.
intros.
destruct H.
pose ((A2P4 a b c) H H0).
unfold le.
left.
auto.
apply (S2 a b c) in H.
unfold le.
right.
auto.
Qed.

Theorem negLe : forall a b: Z, -a≤b -> -b≤a.
Proof.
intros.
unfold le in *.
destruct H.
apply (O2 (-a) b (a + -b)) in H.
rewrite (A1 a (-b))  in H at 2.
rewrite 2 A2 in H.
rewrite A4, A1P2, 2 A1P1 in H.
left.
auto.
apply (S2 (-a) b (-1)) in H.
rewrite <-A1P7, 3 M1, (M1 b (-1)) in H.
rewrite 3 A1P7, A1P5 in H.
right.
auto.
Qed.

Lemma Ordering12 : ∀ a : Z, 0 < -a ↔ a < 0.
Admitted.

Lemma Ordering13 : ∀ a b : Z, a ≤ b → b ≤ a → a = b.
Admitted.
Theorem A3P5 : ∀ a b : Z, a ~ b → a = ± b.
Proof.
intros a b [H H0].
assert (-a | -b).
{ destruct H.
exists (x).
now rewrite <-(A1P7 a), M2, (M1 x), <-M2, A1P7, H. }
assert (-b | -a).
{ destruct H0.
exists (x).
now rewrite <-(A1P7 b), M2, (M1 x), <-M2, A1P7, H0. }
destruct (A2P3 a 0) as [H3 | [H3 | H3]], (A2P3 b 0) as [H4 | [H4 | H4]].
- rewrite <-Ordering12 in *.
apply A3P4 in H1; auto.
apply A3P4 in H2; auto.
left.
apply Ordering13 in H1; auto.
apply (S2 _ _ (-1)) in H1.
rewrite ? (M1 _ (-1)), ? A1P7, ? A1P5 in H1.
congruence.
-
Admitted.

Lemma lexlt1 : forall a : Z,  1≤-a -> a<1.
intros.
destruct H.
apply O14 in H.
rewrite A1P5 in H.
pose O4.
apply (O2 0 1 (-1)) in l.
rewrite A1P1, A4 in l.
pose  ((lttrans a (-1) 0) H l).
pose  ((lttrans a 0 1) l0 O4).
exact l1.
eapply S2 in H.
rewrite (A1P8 _ 1), A1P3, M3 in H.
rewrite <-H.
pose ((O2 0 1 (-1)) O4).
rewrite A1, A3, A4 in l.
pose ((lttrans (-1) 0 1) l O4).
exact l0.
Qed.

Theorem S2leneg : forall a b c : Z, a≤b ->  c<0 -> b*c ≤a*c.
Proof.
intros.
unfold le in *.
destruct H.
eapply lt_x_neg in H.
left.
eauto.
auto.
eapply S2 in H.
right.
eauto.
Qed.

Theorem A3P5_me : ∀ a b : Z, a ~ b → a = ± b.
Proof.
intros.
(*a and b are less than 0*)
destruct (A2P3 a 0) as [H1 H2| H2].
destruct (A2P3 b 0) as [h1 h2| h2].
(*a and b are less than 0*)
destruct H.
destruct H, H0.
rewrite H in h1.
pose ((facsofNat2 x a) h1).
destruct o as [[k]|[k2 k3]].
apply albNbla in H2.
contradiction.
apply help2 in k2.
eapply S2leneg in k2.
rewrite <-H, A1P3 in k2.
(*make b le a*)
rewrite H0 in H1.
pose ((facsofNat2 x0 b) H1).
destruct o as [[l]|[l2 l3]].
apply albNbla in H2.
rewrite H in H2.
contradiction.
apply help2 in l2.
eapply S2leneg in l2.   (*b is negative tho!! still works by multiplying by (-b)*)
rewrite A1P3, <-H0 in l2.
pose ((aleblea a b) l2 k2).
left; auto.
auto.
auto.
(*now for b=0 and 0<b*)

destruct H.
pose negdiv.
pose ((negdiv a b) H0).
apply A3P4 in d0.
destruct H0.
destruct (facsofNat2 x b).
rewrite <-H0.
auto.
destruct H2.
apply help1 in H2.
eapply S2le in H2.
rewrite <-A1P7, <-M2, <-H0, A1P7, A1P3  in H2.
eapply S2le in H2.
rewrite M1, A1P7, A1P8, M3 in H2.
apply negLe in H2.
destruct d0, H2.
pose ((lttrans (-b) (-a) b) H4 H2).

destruct H0, H.
destruct h2.
Admitted.

Theorem A3P5_d : ∀ a b : Z, a ~ b → a = ± b.
Proof.
intros.
unfold pm, assoc in *.
destruct H; destruct H; destruct H0.
pose (help1 x).
pose (help2 x).
pose (help1 x0).
pose (help2 x0).
destruct (T x) as [[K3 [K4 K5]]| [[K6 [K7 K8]]| [K9 [K10 K11]]]].

destruct (T x0) as [[J3 [J4 J5]]| [[J6 [J7 J8]]| [J9 [J10 J11]]]].
rewrite <-O9 in *.
pose (l0 K3). (*1 le x*)
pose (l2 J3).
destruct l3, l4.
pose ((A2P4 1 x a) H1).
pose ((A2P4 1 x0 b) H2).
rewrite ? A1P3 in *.
destruct (classic (0<a)).
destruct (classic (0<b)).
pose (l4 H4).
pose (l3 H3).
rewrite <-H in l6.
rewrite <-H0 in l5.
pose (lts a b).
pose (n l6).
contradiction.
assert ( ¬ 0 < b -> b=0\/b<0).
{intros.
pose (T2 b 0).
tauto.
  }
  pose (H5 H4).
  destruct o.
  rewrite H6 in H0.
  rewrite M1, A1P6 in H0.
  left.
  rewrite <-H0 in H6.
  auto.

  apply O92 in H6.
  pose ((NTNN x0 b) J3 H6).
  rewrite <-O9 in H3.
  rewrite  <-H0 in n.
  contradiction.
  apply gtg0 in H2.
  Admitted.

  Definition unit (a : Z) := (a | 1).

  Notation "x < y < z" := (x < y ∧ y < z).
  Notation "x ≤ y < z" :=
  (x ≤ y ∧ y < z) (at level 70, y at next level).
  Notation "x ≠ ± y" := (¬ (x = ± y)) (at level 60).

  Infix "∋" := (In Z) (at level 70).
  Notation "x ∈ S" := (S ∋ x) (at level 70).
  Notation "x ∉ S" := (¬(x ∈ S)) (at level 70).
  Infix "⊂" := (Included Z) (at level 70).
  Notation "∅" := (Empty_set Z).
  Notation "{ x : A | P }" := (λ x : A, P).

  Notation "2" := (1+1).

  Definition prime (p : Z) :=
  p ≠ ± 1 ∧ ∀ d : Z, (d | p) → d = ± 1 ∨ d = ± p.

  Theorem m1m0 : forall a : Z, 1<a -> 0<a.
  Proof.
  intros.
  pose N1.
  rewrite O9 in i.
  eauto using lttrans.
  Qed.

  Theorem l1le0 : forall a : Z, a<1 -> a≤0.
  Proof.
  intros.
  pose (A3P3 a).
  destruct (T a) as [[H3 [H4 H5]]| [[H6 [H7 H8]]| [H9 [H10 H11]]]].
  rewrite <-O9 in *.
  unfold le.
  pose (f H3 H).
  contradiction.
  unfold le.
  right.
  exact H6.
  rewrite O9 in *.
  apply O14 in H9.
  rewrite A1P5 in H9.
  unfold le; left.
  rewrite negzero in H9.
  exact H9.
  Qed.

  Theorem l0nN : forall a : Z, a<0 -> a∉ℕ.
  Proof.
  intros.
  unfold lt in H.
  rewrite am02 in H.
  apply N3 in H.
  rewrite A1P5 in H.
  auto.
  Qed.

  Lemma S1le : forall a b c : Z, a≤ b -> a+c≤b+c.
  Proof.
  intros.
  destruct H.
  apply (O2 a b c) in H.
  unfold le; left.
  exact H.
  apply (S1 a b c) in H.
  unfold le; right; exact H.
  Qed.

  Theorem Ns : forall a : Z, 0<a -> -a∉ℕ.
  Proof.
  intros.
  rewrite <-O9 in H.
  pose (T a).
  tauto.
  Qed.

  Lemma l0P :  forall a b : Z, a<0 -> b*a<0 -> 0<b.
  Proof.
  intros.
  pose (T b).
  rewrite <-O9 in *.
  rewrite O9 in *.
  apply l0nN in H.
  pose (T a).
  pose (T (a*b)).
  apply l0nN in H0.
  intuition.
  Admitted.

  Lemma nN : forall a : Z, a∉ℕ -> a<0\/a=0.
  Proof.
  intros.
  pose (T a).
  unfold lt, sub.
  rewrite A1P1.
  tauto.
  Qed.

  Lemma leNm : forall a b : Z, a≤b -> ¬b<a.
  Proof.
  intros.
  unfold le in H.
  pose (T2 a b).
  tauto.
  Qed.

  Theorem A4P1 : ∀ a : Z, a ∈ unit ↔ a = ± 1.
  Proof.
  unfold iff, In, pm, unit, divide.
  split.
  intros.
  destruct H.
  destruct (T2 x 1) as [[K3 [K4 K5]]| [[K6 [K7 K8]]| [K9 [K10 K11]]]].
  destruct (T a) as [[H3 [H4 H5]]| [[H6 [H7 H8]]| [H9 [H10 H11]]]].
  rewrite O9 in H3.
  apply (A2P4 1 x a) in K3.
  rewrite A1P3, <-H in K3.
  pose ((A3P3 a) H3).
  contradiction.
  exact H3.
  rewrite H6,M1, A1P6 in H.
  pose A3P1.
  symmetry in H.
  contradiction.
  apply m1m0 in K3.
  apply O9 in K3.
  pose ((NTNN x a) K3 H10).
  rewrite <-H in n.
  pose N1.
  contradiction.
  destruct (T a) as [[H3 [H4 H5]]| [[H6 [H7 H8]]| [H9 [H10 H11]]]].
  apply l1le0 in K6.
  destruct K6.
  apply l0nN in H0.
  pose ((NTNN a x) H3 H0).
  rewrite M1, <-H in n.
  pose N1.
  contradiction.
  rewrite H0, A1P6 in H.
  pose A3P1.
  symmetry in H.
  contradiction.
  rewrite H6, M1, A1P6 in H.
  pose A3P1.
  symmetry in H.
  contradiction.
  apply l1le0 in K6.
  destruct K6.
  pose ((help1 x) H0).
  rewrite H in l.
  apply (S1le (x*a) (-x) x) in l.
  rewrite A1P2, M1 in l.
  rewrite <-(A1P3 x) in l at 2.
  rewrite <-D1 in l.
  destruct l.
  pose ((l0P x (a+1)) H0 H1).
  pose ((nN a) H10).
  destruct o.
  apply help1 in H2.
  apply (S1le 1 (-a) a) in H2.
  rewrite A1P2 in H2.
  apply leNm in H2.
  rewrite A1 in H2.
  contradiction.
  contradiction.
  pose (A1P11 (a+1) x).
  destruct o.
  exact H1.
  apply (S1 (a+1) 0 (-1)) in H2.
  rewrite <-A2, A4, A1P1, A3 in H2.
  right.
  auto.
  rewrite H2 in H.
  rewrite A1P6 in H.
  pose A3P1.
  symmetry in H.
  contradiction.
  rewrite H0 in H.
  rewrite A1P6 in H.
  pose A3P1.
  symmetry in H.
  contradiction.
  rewrite K9, A1P3 in H.
  left.
  auto.
  intros.
  destruct H.
  exists 1.
  rewrite A1P3.
  auto.
  exists (-1).
  rewrite A1P7.
  apply (S2 a (-1) (-1)) in H.
  rewrite M1, 2 A1P7, A1P5 in H.
  auto.
  Qed.

  Theorem beqnega : forall a b : Z, a=-b -> b=-a.
  Proof.
  intros.
  apply (S2 a (-b) (-1)) in H.
  rewrite M1, A1P7 in H.
  rewrite M1, A1P7, A1P5 in H.
  auto.
  Qed.

  Theorem A4P2 : ∀ a b : Z, a ~ b ↔ ∃ u : Z, u ∈ unit ∧ b = a * u.
  Proof.
  unfold iff.
  split.
  intros.
  apply A3P5 in H.
  destruct H.
  exists 1.
  assert (1∈unit).
  {exists 1.
  rewrite M3.
  trivial. }
  rewrite <-(M3 a) in H.
  auto.
  exists (-1).
  assert (-1∈unit).
  {exists (-1).
  rewrite A1P7, A1P5.
  trivial. }
  apply (S2 a (-b) (-1)) in H.
  rewrite (M1 (-b) (-1)) in H.
  rewrite (A1P7 (-b))  in H.
  rewrite A1P5 in H.
  auto.      (*second part of the proof.*)
  intros; destruct H.
  unfold assoc.
  split.
  exists x.
  rewrite M1.
  tauto.
  destruct H.
  apply A4P1 in H.
  unfold pm in H.
  destruct H.
  rewrite H, M3 in H0.
  exists 1.
  rewrite A1P3.
  auto.
  rewrite H, M1, A1P7 in H0.
  exists (-1).
  rewrite A1P7.
  apply beqnega in H0.
  auto.
  Qed.

  Theorem m0me1 : forall a : Z,  0<a -> 1≤a.
  Proof.
  intros.
  destruct (T2 1 a) as [[K3 [K4 K5]]| [[K6 [K7 K8]]| [K9 [K10 K11]]]].
  pose ((A3P3 a) H K3).
  contradiction.
  unfold le; left; auto.
  unfold le; right; auto.
  Qed.

  Theorem ltle : forall a b : Z, a<b -> a≤b-1.
  Proof.
  intros.
  pose (m0me1 (b-a)).
  apply (O2 a b (-a)) in H.
  rewrite A4 in H.
  unfold sub in l.
  pose (l H).
  apply (S1le 1 (b + -a) (a + -1)) in l0.
  rewrite A1 in l0.
  rewrite A2 in l0.
  rewrite <-A2 in l0.
  rewrite A1P2, A3 in l0.
  rewrite A1 in l0.
  rewrite  <-A2, A1P2, A3, A1  in l0.
  trivial.
  Qed.

  Theorem twominus1 : (2-1 = 1).
  Proof.
  unfold sub.
  now rewrite <-A2, A4, A3.
  Qed.

  Theorem m1me0 : forall a : Z, 1≤a -> 0<a.
  Proof.
  intros.
  unfold le in H.
  destruct H.
  pose ((lttrans 0 1 a) O4 H).
  auto.
  pose O4.
  rewrite H in l.
  auto.
  Qed.

  Theorem A4P3 : forall a : Z,  a= 1 -> a + 1∈ prime.
  Proof.
  unfold In, prime, pm.
  intros.
  split.
  pose A3P1.
  destruct (classic (a+1=1)).
  apply (S1 (a+1) 1 (-1)) in H0.
  rewrite <-A2, ? A4, A3 in H0.
  rewrite H in H0.
  symmetry in H0.
  contradiction.
  pose (N2 a 1).
  rewrite <-H in i.
  rewrite H in i at 4.
  pose ((N3 1) N1).
  destruct (classic (a+1 = -1)).
  rewrite H1 in i.
  rewrite H in i.
  pose (i N1 N1).
  contradiction.
  tauto. (* 2 is not pm 1 done proving*)
  intros.
  rewrite H in H0. (*might need to change*)
  assert (2 ∈ ℕ).
  {pose ((N2 1 1) N1 N1).
  auto. }  (*2 is nat proof*)
  rewrite O9 in H1.
  pose ((A3P4 d 2) H0 H1).
  destruct H0.
  pose (facsofNat x d).
  rewrite <-e in o.
  pose (o H1).
  destruct o as [[o1 o2]|[o3 o4]]. (*instances*)  (*0< d <= 2*)
  destruct l as [l1 |l2].
  pose ((help2 d) o2).
  destruct l as [l3 | l4].
  pose (A3P3 d).
  apply ltle in l1.
  rewrite twominus1 in l1.
  destruct l1.
  tauto.
  left; left.
  exact H0.
  pose ((help2 d) o2).
  apply ltle in l1.
  rewrite twominus1 in l1.
  destruct l1, l.
  apply (O13 1 d) in H2.
  auto.
  apply (O13 d 1) in H0.
  auto.
  auto.
  auto.
  right; left.
  rewrite H.
  auto. (*now show true when both negative*)
  pose ((help1 x) o3).
  pose ((help1 d) o4).
  pose ((m1me0 (-d)) l1).
  apply (S2le 1 (-x) (-d)) in l0.
  rewrite <-A1P7 in l0 at 2.
  rewrite <-(A1P7 x) in l0.
  rewrite M2  in l0.
  rewrite <-M2, <-M2  in l0.
  rewrite (M1 (-1)  (x * (-1 * d))) in l0.
  rewrite (M1 (-1) d) in l0.
  rewrite M2 in l0.
  rewrite <-M2 in l0.
  rewrite A1P7, A1P5 in l0.
  rewrite <-A1P7, M2, (M1 1 (-1)), ? A1P7, M3, <-e in l0.
  apply (negLe d 2) in l0.
  destruct l0.
  assert (-(2)<d -> -1≤d).
  {
	  intros.
	  apply ltle in H2.
	  apply (S1le (- (2)) (d-1) 1) in H2.
	  unfold sub in H2.
	  rewrite <-A2, A1P2, A3 in H2.
	  (*bruh*)

	  rewrite <-twominus1 in H2 at 2.
	  unfold sub in H2.
	  rewrite (A1 2 (-1)), A2 in H2.
	  rewrite A4 in H2.
	  admit. }
	  pose (H2 H0).
	  destruct l0. (*-1<=d*)
	  assert (-1<d /\ d<0 -> False).
	  admit.
	  tauto.
	  left; right.
	  auto.
	  rewrite H.
	  right. right.
	  auto.
	  auto.
	  Admitted.

	  Theorem A4P4 :
	  ∀ p : Z, 1 < p → p ∉ prime → ∃ n, 1 < n < p ∧ (n | p).
	  Proof.
	  Admitted.

	  Theorem A4P5 : ∀ a b : Z,
	  0 < a → 0 < b → (∃ q r : Z, a = b * q + r ∧ 0 ≤ r < b).
	  Proof.
	  Admitted.

	  Theorem abeq1 :
	  ∀ a b : Z, a * b = 1 → (a = 1 ∧ b = 1) ∨ (a = -1 ∧ b = -1).
	  Proof.
	  intros a b H.
	  assert (a ∈ unit).
	  - unfold unit, In.
	  unfold divide.
	  exists b.
	  rewrite M1.
	  congruence.
	  - apply A4P1 in H0.
	  destruct H0.
	  + left.
	  split; auto.
	  rewrite H0, A1P3 in H.
	  trivial.
	  + right.
	  split; auto.
	  apply (S2 _ _ (-1)) in H.
	  rewrite H0, A1P3, A1P7, M1, A1P7, A1P5 in H.
	  trivial.
	  Qed.

	  Theorem A3P5_v100 : ∀ a b : Z, a ~ b → a = ± b.
	  Proof.
	  intros.
	  unfold pm, assoc in *.
	  destruct H.
	  destruct H, H0.
	  rewrite <-(A1P3 a), H, M2 in H0.
	  apply C1 in H0.
	  destruct H0.
	  symmetry in H0.
	  apply abeq1 in H0.
	  destruct H0 as [[h1 h2] |[h3 h4]].
	  rewrite h2, A1P3 in H.
	  auto.
	  rewrite h4, A1P7 in H.
	  apply beqnega in H.
	  auto.
	  rewrite H0, M1, A1P6, <-H0 in H.
	  auto.
	  Qed.

	  Definition gcd (a b d : Z) :=
	  (d | a) ∧ (d | b) ∧ ∀ x : Z, (x | a) → (x | b) → (x | d).

	  Notation "'gcd' ( a , b )  = d" := (gcd a b d) (at level 80).

	  Theorem A5P1 : ∀ a b : Z, gcd (a,b) = 1 → a≠0 -> b≠0  -> ∃ x y : Z, 1 = a * x + b * y.
	  Proof.
	  intros.
	  destruct H as [w1 [w2 w3]].
	  destruct (WOP {d : Z | exists x y : Z, d = a*x + b*y/\ d>0}).
	  unfold not.
	  intros.
	  destruct (T a) as [[K3 [K4 K5]]| [[K6 [K7 K8]]| [K9 [K10 K11]]]].
	  - assert (a∈∅).
	  intros.
	  rewrite <-H.
	  unfold In.
	  exists 1, 0.
	  apply O9 in K3.
	  now rewrite M3, M1, A1P6, A3.
	  contradiction.
	  - contradiction.
	  - assert (-a∈∅).
	  rewrite <-H.
	  intros; unfold In.
	  exists (-1), 0.
	  rewrite M1, A1P7, M1, A1P6, A3.
	  rewrite O9 in K9.
	  firstorder.
	  contradiction. (*done with non empty*)
	  - unfold Included.
	  intros.
	  unfold In in H.
	  destruct H; destruct H; destruct H.
	  now rewrite O9.
	  - destruct H.
	  unfold In in H2, H.
	  (*assert (x ∈ unit).*  its a differnt x tho!*)
	  pose (A4P5 x 1).
	  destruct e.
	  destruct H; destruct H; now destruct H.
	  now pose O4.
	  destruct H3.  (* how to change name of remainder*)
	  assert (x1=0).
	  + destruct H3 as [H4 [H5 H6]].
	  destruct H5.
	  now destruct (A3P3 x1); auto.
	  now symmetry. (*remainder is 0*) (* now prove gcd=1 is the least*)
	  + destruct H; destruct H.
	  pose ((A2P1 1 a b x2 x3) w1 w2).
	  apply A3P4 in d. (*1<= least element*)
	  destruct H.
	  rewrite <-H in d.
	  pose (H2 1).
	  apply aleblea in d.
	  rewrite <-d.
	  now exists x2, x3.
	  destruct l.

	  pose ((A2P1 1 a b x2 x3) w1 w2).
	  unfold divide in d0.
	  destruct d0.
	  eapply S1 in H6.
	  rewrite <-A2, A4, A3 in H6.
	  pose A4P5.

	  rewrite <-H in H6.
	  destruct w1.

	  + Pose A3P4.

	  Admitted.

	  Theorem A5P2 : ∀ a b c : Z, gcd (a,b) = 1 → (a | b * c) → (a | c).
	  Proof.
	  intros.
	  apply A5P1 in H.
	  unfold divide in *.
	  destruct H.
	  destruct H.
	  destruct H0.
	  eapply S2 in H.
	  rewrite (A1P3 c), D1, <-(M2 b x0 c), (M1 x0 c), M2, H0 in H.
	  rewrite <-(M2 x1 _ _), (M1 a x0) in H.
	  rewrite <-M2, (M1 a _), M2, <-D1 in H.
	  now exists (x * c + x1 * x0).
	  Qed.

	  Theorem A6P1 : ∀ p a : Z, p ∈ prime → ¬ (p | a) → gcd (a,p) = 1.
	  Proof.

	  Theorem A6P2 : ∀ a b p : Z, p ∈ prime → (p | a * b) → (p | a) ∨ (p | b).
	  Proof.
	  Admitted.


(**************************************************************************
* TLC: A library for Coq                                                  *
* Variable names, and freshness properties                                *
**************************************************************************)

Set Implicit Arguments.
From TLC Require Import LibTactics LibList LibLogic LibNat LibEpsilon LibReflect.
From TLC Require Export LibFset.

(* ********************************************************************** *)
(** * Abstract Definition of Variables *)

Module Type VariablesType.

(** We leave the type of variables abstract. *)

Parameter var : Set.

(** This type is inhabited. *)

Parameter Inhab_var : Inhab var.

(** This type is comparable. *)

Parameter var_compare : var -> var -> bool.

Parameter var_compare_eq : forall (x y:var),
  var_compare x y = isTrue (x = y).

  (* DEPRECATED
  Parameter var_comp : Comparable var.
  Instance var_comparable : Comparable var := var_comp.
  *)

(** We can build sets of variables. *)

Definition vars := fset var.

(** Finally, we have a means of generating fresh variables. *)

Parameter var_gen : vars -> var.
Parameter var_gen_spec : forall E, (var_gen E) \notin E.
Parameter var_fresh : forall (L : vars), { x : var | x \notin L }.

End VariablesType.

(* ********************************************************************** *)
(** * Concrete Implementation of Variables *)

Module Export Variables : VariablesType.

Definition var := nat.

Lemma Inhab_var : Inhab var.
Proof using. apply (Inhab_of_val 0). Qed.

(* --LATER: reuse nat_compare *)
Fixpoint var_compare (x y : nat) :=
  match x, y with
  | O, O => true
  | S x', S y' => var_compare x' y'
  | _, _ => false
  end.

Lemma var_compare_eq : forall (x y:var),
  var_compare x y = isTrue (x = y).
Proof using.
  unfold var. intros x; induction x; intros y; destruct y;
   simpl; rew_bool_eq; try nat_math.
  rewrite IHx. rew_bool_eq. nat_math.
Qed.

  (* DEPRECATED
  Lemma var_comp : Comparable var.
  Proof using. apply nat_comparable. Qed.

  Instance var_comparable : Comparable var := var_comp.
  *)

Definition vars := fset var.

Definition var_gen_list (l : list nat) :=
  1 + fold_right plus O l.

Lemma var_gen_list_spec : forall n l,
  n \in from_list l -> n < var_gen_list l.
Proof using.
  unfold var_gen_list. induction l; introv I.
  rewrite from_list_nil in I. false (in_empty_inv I).
  rewrite from_list_cons in I. rew_listx.
   rewrite in_union in I. destruct I as [H|H].
     rewrite in_singleton in H. subst. nat_math.
     specializes IHl H. nat_math.
Qed.

Definition var_gen (E : vars) : var :=
  var_gen_list (epsilon (fun l => E = from_list l)).

Lemma var_gen_spec : forall E, (var_gen E) \notin E.
Proof using.
  intros. unfold var_gen. epsilon l. applys fset_finite.
  intros Hl. rewrite Hl. introv H.
  forwards M: var_gen_list_spec H. nat_math.
Qed.

Lemma var_fresh : forall (L : vars), { x : var | x \notin L }.
Proof using. intros L. exists (var_gen L). apply var_gen_spec. Qed.

End Variables.

(* ********************************************************************** *)
(** ** Lists of variables of given length and given freshness *)

(** Freshness of n variables from a set L and from one another. *)

Fixpoint fresh (L : vars) (n : nat) (xs : list var) {struct xs} : Prop :=
  match xs, n with
  | nil, O => True
  | x::xs', S n' => x \notin L /\ fresh (L \u \{x}) n' xs'
  | _,_ => False
  end.

#[global]
Hint Extern 1 (fresh _ _ _) => simpl.

(* It is possible to build a list of n fresh variables. *)

Lemma var_freshes : forall L n,
  { xs : list var | fresh L n xs }.
Proof using.
  intros. gen L. induction n; intros L.
  exists* (nil : list var).
  destruct (var_fresh L) as [x Fr].
   destruct (IHn (L \u \{x})) as [xs Frs].
   exists* (x::xs).
Qed.

(* ********************************************************************** *)
(** ** Picking fresh names *)

(** [gather_vars_for_type T F] return the union of all the finite sets
  of variables [F x] where [x] is a variable from the context such that
  [F x] type checks. In other words [x] has to be of the type of the
  argument of [F]. The resulting union of sets does not contain any
  duplicated item. This tactic is an extreme piece of hacking necessary
  because the tactic language does not support a "fold" operation on
  the context. *)

Ltac gather_vars_with F :=
  let rec gather V :=
    match goal with
    | H: ?S |- _ =>
      let FH := constr:(F H) in
      match V with
      | \{} => gather FH
      | context [FH] => fail 1
      | _ => gather (FH \u V)
      end
    | _ => V
    end in
  let L := gather (\{}:vars) in eval simpl in L.

(** [beautify_fset V] assumes that [V] is built as a union of finite
  sets and return the same set cleaned up: empty sets are removed and
  items are laid out in a nicely parenthesized way *)

Ltac beautify_fset V :=
  let rec go Acc E :=
     match E with
     | ?E1 \u ?E2 => let Acc1 := go Acc E1 in
                     go Acc1 E2
     | \{}  => Acc
     | ?E1 => match Acc with
              | \{} => E1
              | _ => constr:(Acc \u E1)
              end
     end
  in go (\{}:vars) V.

(** [pick_fresh_gen L Y] expects [L] to be a finite set of variables
  and adds to the context a variable with name [Y] and a proof that
  [Y] is fresh for [L]. *)

Ltac pick_fresh_gen L Y :=
  let Fr := fresh "Fr" in
  let L := beautify_fset L in
  (destruct (var_fresh L) as [Y Fr]).

(** [pick_fresh_gens L n Y] expects [L] to be a finite set of variables
  and adds to the context a list of variables with name [Y] and a proof
  that [Y] is of length [n] and contains variable fresh for [L] and
  distinct from one another. *)

Ltac pick_freshes_gen L n Y :=
  let Fr := fresh "Fr" in
  let L := beautify_fset L in
  (destruct (var_freshes L n) as [Y Fr]).

(* ********************************************************************** *)
(** ** Tactics for [notin] *)

Implicit Types x : var.

(** For efficiency, we avoid rewrites by splitting equivalence. *)

Lemma notin_singleton_r : forall x y,
  x \notin \{y} -> x <> y.
Proof using. intros. rewrite~ <- notin_singleton. Qed.

Lemma notin_singleton_l : forall x y,
  x <> y -> x \notin \{y}.
Proof using. intros. rewrite~ notin_singleton. Qed.

Lemma notin_singleton_swap : forall x y,
  x \notin \{y} -> y \notin \{x}.
Proof using.
  intros. apply notin_singleton_l.
  apply sym_not_eq. apply~ notin_singleton_r.
Qed.

Lemma notin_union_r : forall x E F,
  x \notin (E \u F) -> (x \notin E) /\ (x \notin F).
Proof using. intros. rewrite~ <- notin_union. Qed.

Lemma notin_union_r1 : forall x E F,
  x \notin (E \u F) -> (x \notin E).
Proof using. introv. rewrite* notin_union. Qed.

Lemma notin_union_r2 : forall x E F,
  x \notin (E \u F) -> (x \notin F).
Proof using. introv. rewrite* notin_union. Qed.

Lemma notin_union_l : forall x E F,
  x \notin E -> x \notin F -> x \notin (E \u F).
Proof using. intros. rewrite~ notin_union. Qed.

Lemma notin_var_gen : forall E F,
  (forall x, x \notin E -> x \notin F) ->
  (var_gen E) \notin F.
Proof using. intros. autos~ var_gen_spec. Qed.

Arguments notin_singleton_r [x] [y].
Arguments notin_singleton_l [x] [y].
Arguments notin_singleton_swap [x] [y].
Arguments notin_union_r [x] [E] [F].
Arguments notin_union_r1 [x] [E] [F].
Arguments notin_union_r2 [x] [E] [F].
Arguments notin_union_l [x] [E] [F].

(** Tactics to deal with notin.  *)

Ltac notin_solve_target_from x E H :=
  match type of H with
  | x \notin E => constr:(H)
  | x \notin (?F \u ?G) =>
     let H' :=
        match F with
        | context [E] => constr:(notin_union_r1 H)
        | _ => match G with
          | context [E] => constr:(notin_union_r2 H)
          | _ => fail 20
          end
        end in
     notin_solve_target_from x E H'
  end.

Ltac notin_solve_target x E :=
  match goal with
  | H: x \notin ?L |- _ =>
    match L with context[E] =>
      let F := notin_solve_target_from x E H in
      apply F
    end
  | H: x <> ?y |- _ =>
     match E with \{y} =>
       apply (notin_singleton_l H)
     end
  end.

Ltac notin_solve_one :=
  match goal with
  | |- ?x \notin \{?y} =>
     apply notin_singleton_swap;
     notin_solve_target y (\{x})
  | |- ?x \notin ?E =>
    notin_solve_target x E
  end.
  (*
    LATER: add support for these special cases
      | |- ?x \notin ?E =>
            progress (unfold x); notin_simpl
      | |- (var_gen ?x) \notin _ =>
            apply notin_var_gen; intros; notin_simpl
  *)
  (* Remark: if x is an evar, we could try to instantiate it.
     But, problem: it might loop !
    | |- ?x \notin ?E =>
       match goal with y:var |- _ =>
         match y with
         | x => fail 1
         | _ =>
           let H := fresh in cuts H: (y \notin E);
           [ apply H | notin_solve_target y E ]
          end
       end
  *)

Ltac notin_simpl :=
  match goal with
  | |- _ \notin (_ \u _) => apply notin_union_l; notin_simpl
  | |- _ \notin (\{}) => apply notin_empty; notin_simpl
  | |- ?x <> ?y => apply notin_singleton_r; notin_simpl
  | |- _ => idtac
  end.

Ltac notin_solve_false :=
  match goal with
  | H: ?x \notin ?E |- _ =>
    match E with context[x] =>
      apply (@notin_same _ x);
      let F := notin_solve_target_from x (\{x}) H in
      apply F
    end
  | H: ?x <> ?x |- _ => apply H; reflexivity
  end.

Ltac notin_false :=
  match goal with
  | |- False => notin_solve_false
  | _ => intros_all; false; notin_solve_false
  end.

Ltac notin_of_fresh_in_context :=
  repeat (match goal with H: fresh _ _ _ |- _ =>
    progress (simpl in H; destructs H) end).

Ltac notin_solve :=
  notin_of_fresh_in_context;
  first [ notin_simpl; try notin_solve_one
        | notin_false ].

#[global]
Hint Extern 1 (_ \notin _) => notin_solve.
#[global]
Hint Extern 1 (_ <> _ :> var) => notin_solve.
#[global]
Hint Extern 1 ((_ \notin _) /\ _) => splits.

(* ********************************************************************** *)
(** ** Tactics for [fresh] *)

(* --TODO: cleanup proofs of fresh using calc_fset *)

Lemma fresh_union_r : forall xs L1 L2 n,
  fresh (L1 \u L2) n xs -> fresh L1 n xs /\ fresh L2 n xs.
Proof using.
  induction xs; simpl; intros; destruct n;
  tryfalse*. auto.
  destruct H. split; split; auto.
  forwards*: (@IHxs (L1 \u \{a}) L2 n).
   rewrite union_comm.
   rewrite union_comm_assoc.
   rewrite* union_assoc.
  forwards*: (@IHxs L1 (L2 \u \{a}) n).
   rewrite* union_assoc.
Qed.

Lemma fresh_union_r1 : forall xs L1 L2 n,
  fresh (L1 \u L2) n xs -> fresh L1 n xs.
Proof using. intros. forwards*: fresh_union_r. Qed.

Lemma fresh_union_r2 : forall xs L1 L2 n,
  fresh (L1 \u L2) n xs -> fresh L2 n xs.
Proof using. intros. forwards*: fresh_union_r. Qed.

Lemma fresh_union_l : forall xs L1 L2 n,
  fresh L1 n xs -> fresh L2 n xs -> fresh (L1 \u L2) n xs.
Proof using.
  induction xs; simpl; intros; destruct n; tryfalse*. auto.
  destruct H. destruct H0. split~.
  forwards~ K: (@IHxs (L1 \u \{a}) (L2 \u \{a}) n).
  rewrite <- (union_same \{a}).
  rewrite union_assoc.
  rewrite <- (union_assoc L1).
  rewrite (union_comm L2).
  rewrite (union_assoc L1).
  rewrite* <- union_assoc.
Qed.

Lemma fresh_empty : forall L n xs,
  fresh L n xs -> fresh \{} n xs.
Proof using.
  intros. rewrite <- (union_empty_r L) in H.
  destruct* (fresh_union_r _ _ _ _ H).
Qed.

Lemma fresh_length : forall L n xs,
  fresh L n xs -> n = length xs.
Proof using.
  intros. gen n L. induction xs; simpl; intros n L Fr;
    destruct n; tryfalse*.
  auto.
  rew_list. rewrite* <- (@IHxs n (L \u \{a})).
Qed.

Lemma fresh_resize : forall L n xs,
  fresh L n xs -> forall m, m = n -> fresh L m xs.
Proof using.
  introv Fr Eq. subst~.
Qed.

Lemma fresh_resize_length : forall L n xs,
  fresh L n xs -> fresh L (length xs) xs.
Proof using.
  introv Fr. rewrite* <- (fresh_length _ _ _ Fr).
Qed.

Arguments fresh_union_r [xs] [L1] [L2] [n].
Arguments fresh_union_r1 [xs] [L1] [L2] [n].
Arguments fresh_union_r2 [xs] [L1] [L2] [n].
Arguments fresh_union_l [xs] [L1] [L2] [n].
Arguments fresh_empty [L] [n] [xs].
Arguments fresh_length [L] [n] [xs].
Arguments fresh_resize [L] [n] [xs].
Arguments fresh_resize_length [L] [n] [xs].

Lemma fresh_single_notin : forall x xs n,
  fresh \{x} n xs ->
  x \notin from_list xs.
Proof using.
  induction xs; destruct n; introv F; simpl in F; tryfalse.
  rewrite~ from_list_nil.
  destruct F as [Fr F']. lets [? ?]: (fresh_union_r F').
   specializes IHxs n. rewrite~ from_list_cons.
Qed.

Ltac fresh_solve_target_from E n xs H :=
  match type of H with
  | fresh E n xs => constr:(H)
  | fresh E ?m xs =>
      match n with
      | length xs => constr:(fresh_resize_length H)
      | _ =>
         match goal with
         | Eq: m = n |- _ => constr:(fresh_resize H _ (sym_eq Eq))
         | Eq: n = m |- _ => constr:(fresh_resize H _ Eq)
         end
      end
  | fresh (?F \u ?G) ?m xs =>
     let H' :=
        match F with
        | context [E] => constr:(fresh_union_r1 H)
        | _ => match G with
          | context [E] => constr:(fresh_union_r2 H)
          | _ => fail 20
          end
        end in
     fresh_solve_target_from E n xs H'
  end.

Ltac fresh_solve_target E n xs :=
  match goal with H: fresh ?L _ xs |- _ =>
    match L with context[E] =>
      let F := fresh_solve_target_from E n xs H in
      apply F
    end
  end.

Ltac fresh_solve_one :=
  match goal with
  | |- fresh ?E ?n ?xs =>
    fresh_solve_target E n xs
  | |- fresh \{} ?n ?xs =>
    match goal with H: fresh ?F ?m xs |- _ =>
      apply (fresh_empty H);
      fresh_solve_target F n xs
    end
  end.

Ltac fresh_simpl :=
  try match goal with |- fresh (_ \u _) _ _ =>
    apply fresh_union_l; fresh_simpl end.

Ltac fresh_solve_by_notins :=
  simpl; splits; try notin_solve.

Ltac fresh_solve :=
  fresh_simpl;
  first [ fresh_solve_one
        | fresh_solve_by_notins
        | idtac ].

#[global]
Hint Extern 1 (fresh _ _ _) => fresh_solve.

(* --LATER: more automation of fresh_length properties *)


Require Import List.
Import ListNotations.

Set Implicit Arguments.

Section assoc.
  Variable K V : Type.
  Variable K_eq_dec : forall k k' : K, {k = k'} + {k <> k'}.

  Fixpoint assoc (l : list (K * V)) (k : K) : option V :=
    match l with
      | [] => None
      | (k', v) :: l' =>
        if K_eq_dec k k' then
          Some v
        else
          assoc l' k
    end.

  Fixpoint assoc_set (l : list (K * V)) (k : K) (v : V) : list (K * V) :=
    match l with
      | [] => [(k, v)]
      | (k', v') :: l' =>
        if K_eq_dec k k' then
          (k, v) :: l'
        else
          (k', v') :: (assoc_set l' k v)
    end.

  Lemma get_set_same :
    forall k v l,
      assoc (assoc_set l k v) k = Some v.
  Proof using.
    induction l; intros; simpl.
    - destruct (K_eq_dec _ _); simpl; subst; congruence.
    - destruct a; repeat (destruct (K_eq_dec _ _); simpl; subst; try congruence).
  Qed.

  Lemma get_set_diff :
    forall k k' v l,
      k <> k' ->
      assoc (assoc_set l k v) k' = assoc l k'.
  Proof using.
    induction l; intros; simpl.
    - destruct (K_eq_dec _ _); simpl; subst; congruence.
    - destruct a.
      repeat (destruct (K_eq_dec _ _); simpl; subst; try congruence).
      rewrite IHl; auto.
  Qed.

  Ltac assoc_rewrite :=
    match goal with
    | [  |- context [assoc (assoc_set _ ?k0' _) ?k0 ] ] =>
      first [rewrite get_set_same with (k := k0) by auto |
             rewrite get_set_diff with (k' := k0) by auto ]
    end.

  Definition a_equiv (l1 : list (K * V)) l2 :=
    forall k,assoc l1 k = assoc l2 k.

  Lemma assoc_set_assoc_set_diff :
    forall l (k : K) (v : V) k' v',
      k <> k' ->
      a_equiv (assoc_set (assoc_set l k v) k' v')
              (assoc_set (assoc_set l k' v') k v).
  Proof using.
    unfold a_equiv.
    intros.
    destruct (K_eq_dec k0 k'); [subst k'; rewrite get_set_same with (k := k0)|
                                   rewrite get_set_diff with (k' := k0) by auto].
    - now repeat assoc_rewrite.
    - destruct (K_eq_dec k0 k); [subst k; rewrite get_set_same with (k := k0)|
                                   rewrite get_set_diff with (k' := k0) by auto].
      + now repeat assoc_rewrite.
      + now repeat assoc_rewrite.
  Qed.
End assoc.


Require Import List.
Require Import ZArith.

Section AUXLIST.

Variable A : Set.
Variable default : A.

Definition hd l := match l with hd :: _ => hd | _ => default end.

Definition tl (l : list A) := match l with _ :: tl => tl | _ => nil end.

Fixpoint jump (p : positive) (l : list A) {struct p} : (list A) :=
  match p with
  | xH => tl l
  | xO p => jump p (jump p l)
  | xI p  => jump p (jump p (tl l))
  end.

Fixpoint pos_nth (p : positive) (l : list A) {struct p} : A :=
  match p with
  | xH => hd l
  | xO p => pos_nth p (jump p l)
  | xI p => pos_nth p (jump p (tl l))
  end.

End AUXLIST.

Arguments pos_nth [A] _ _ _.

Ltac Trev l :=
  let rec rev_append rev l :=
      match l with
      |  nil  => constr:(rev)
      | (cons ?h ?t) => let rev := constr:(cons h rev) in
                       rev_append rev t
      end
  in
  match type of l with
  | (list ?X) => rev_append (@nil X) l
  end.


(* Selection sort *)

From sortalgs Require Import sorted.

Require List.
Import ListNotations.

Require Import Recdef.

Fixpoint select {A} `{DecTotalOrder A} (x : A) (l : list A) : A * list A :=
  match l with
  | h :: t =>
    if leb x h then
      let (y, l2) := select x t in
      (y, h :: l2)
    else
      let (y, l2) := select h t in
      (y, x :: l2)
  | [] =>
    (x, [])
  end.

Lemma lem_select_length `{DecTotalOrder} :
  forall l l' x y, select x l = (y, l') -> length l' = length l.
Proof.
  induction l; hauto.
Qed.

Lemma lem_select_perm `{DecTotalOrder} :
  forall l l' x y, select x l = (y, l') -> Permutation (x :: l) (y :: l').
Proof.
  induction l; hauto q: on inv: Permutation ctrs: Permutation.
Qed.

Lemma lem_select_leb `{DecTotalOrder} :
  forall l l' x y, select x l = (y, l') -> leb y x.
Proof.
  induction l; [ sauto | sauto use: lem_neg_leb ].
Qed.

Lemma lem_select_lelst `{DecTotalOrder} :
  forall l l' x y, select x l = (y, l') -> LeLst y l'.
Proof.
  induction l; sauto use: lem_select_leb, lem_neg_leb.
Qed.

Function ssort {A} {dto: DecTotalOrder A} (l : list A) {measure length l}
  : list A :=
  match l with
  | h :: t =>
    let (x, l2) := select h t in
    x :: ssort l2
  | [] => []
  end.
Proof.
  intros; sauto lq: on use: lem_select_length.
  (* Without explicit "intros" lem_select_length would be added to
     the context first, with introductions done afterwards. This
     confuses sauto in this particular case. *)
Defined.

Arguments ssort {_ _}.

Lemma lem_ssort_perm `{DecTotalOrder} :
  forall l, Permutation (ssort l) l.
Proof.
  intro l.
  functional induction (ssort l).
  - hauto use: lem_select_perm, Permutation_sym, Permutation_cons, perm_trans.
  - sauto.
Qed.

Lemma lem_ssort_sorted `{DecTotalOrder} :
  forall l, Sorted (ssort l).
Proof.
  intro l.
  functional induction (ssort l).
  - rewrite lem_lelst_sorted.
    hauto use: lem_select_lelst, lem_ssort_perm.
  - sauto.
Qed.


Require Import Essentials.Notations.
Require Import Essentials.Types.
Require Import Essentials.Facts_Tactics.
Require Import Category.Main.
Require Import Functor.Functor Functor.Functor_Ops.
Require Import Coq_Cats.Type_Cat.Type_Cat.
Require Import Ext_Cons.Prod_Cat.Prod_Cat Ext_Cons.Prod_Cat.Operations.
Require Import Functor.Representable.Hom_Func.
Require Import Cat.Cat Cat.Cat_Iso.
Require Import NatTrans.NatTrans NatTrans.Func_Cat NatTrans.NatIso.

Local Open Scope functor_scope.

Section Hom_Func_Twist.
  Context (C : Category).

  (** (Hom_Func Cᵒᵖ) = (Hom_Func C) ∘ (Twist_Func C Cᵒᵖ)

  Note that: (Home_Func C) : Cᵒᵖ×C -> Type_Cat and (Twist_Func C Cᵒᵖ) : C×Cᵒᴾ → Cᵒᵖ×C.
*)
  Theorem Hom_Func_Twist : (Hom_Func (C^op)) = (Hom_Func C) ∘ (Twist_Func C (C^op)).
  Proof.
    Func_eq_simpl; cbn; auto.
  Qed.

End Hom_Func_Twist.

Section Prod_Func_Hom_Func_NT.
  Context {A B C D : Category}
          {F : A –≻ C^op}
          {F' : A –≻ D^op}
          {G : B –≻ C}
          {G' : B –≻ D}
          (N : (((Hom_Func C) ∘ (Prod_Functor F G))
                –≻ ((Hom_Func D) ∘ (Prod_Functor F' G')))%nattrans
          )
  .

  Local Obligation Tactic := idtac.

  (** Given a natural transformation from ((Hom_Func C) ∘ (Prod_Functor F G)) to ((Hom_Func D) ∘ (Prod_Functor F' G')), we construct a natural transformation from ((Hom_Func C^op) ∘ (Prod_Functor G F)) to ((Hom_Func D^op) ∘ (Prod_Functor G' F')). *)
  Program Definition Prod_Func_Hom_Func_NT :
    (((Hom_Func (C^op)) ∘ (Prod_Functor G F)) –≻ ((Hom_Func (D^op)) ∘ (Prod_Functor G' F')))%nattrans :=
    {|
      Trans := fun c h => Trans N (snd c, fst c) h
    |}.

  Next Obligation.
  Proof.
    intros [c1 c2] [c1' c2'] [h1 h2].
    extensionality x; cbn.
    repeat rewrite assoc_sym.
    exact (equal_f (@Trans_com _ _ _ _ N (c2, c1) (c2', c1') (h2, h1)) x).
  Qed.

  Next Obligation.
  Proof.
    intros.
    symmetry.
    apply Prod_Func_Hom_Func_NT_obligation_1.
  Qed.

End Prod_Func_Hom_Func_NT.

Section Prod_Func_Hom_Func.
  Context {A B C D : Category}
          {F : A –≻ C^op}
          {F' : A –≻ D^op}
          {G : B –≻ C}
          {G' : B –≻ D}
          (N : (
                 ((Hom_Func C) ∘ (Prod_Functor F G))%functor
                   ≃ ((Hom_Func D) ∘ (Prod_Functor F' G'))%functor
               )%natiso
          )
  .

  Local Ltac TRC :=
  match goal with
    [|- ?W = _] =>
    match W with
      Trans ?A ?X (Trans ?B ?X ?Z) =>
      change W with (Trans (NatTrans_compose B A) X Z)
    end
  end.

  Local Obligation Tactic :=
    apply NatTrans_eq_simplify; FunExt; basic_simpl; TRC; solve [(cbn_rewrite (right_inverse N); trivial) |  (cbn_rewrite (left_inverse N); trivial)].

  (** Given a natural isomorphism ((Hom_Func C) ∘ (Prod_Functor F G)) ≃ ((Hom_Func D) ∘ (Prod_Functor F' G')), we construct a natural ismorphism ((Hom_Func C^op) ∘ (Prod_Functor G F)) ≃ ((Hom_Func D^op) ∘ (Prod_Functor G' F')). *)
  Program Definition Prod_Func_Hom_Func :
    ((((Hom_Func (C^op)) ∘ (Prod_Functor G F))%functor)
       ≃ ((Hom_Func (D^op)) ∘ (Prod_Functor G' F'))%functor)%natiso
    :=
      {|
        iso_morphism := Prod_Func_Hom_Func_NT (iso_morphism N);
        inverse_morphism := Prod_Func_Hom_Func_NT (inverse_morphism N)
      |}
  .

End Prod_Func_Hom_Func.

Section Prod_Func_Hom_Func_invl.
  Context {A B C D : Category}
          {F : A –≻ C^op}
          {F' : A –≻ D^op}
          {G : B –≻ C}
          {G' : B –≻ D}
          (N :
             (
               ((Hom_Func C) ∘ (Prod_Functor F G))%functor
                 ≃ ((Hom_Func D) ∘ (Prod_Functor F' G'))%functor
             )%natiso
          )
  .

  (** Prod_Func_Hom_Func defined above is involutive. *)
  Theorem Prod_Func_Hom_Func_invl : N = Prod_Func_Hom_Func (Prod_Func_Hom_Func N).
  Proof.
    apply Isomorphism_eq_simplify; apply NatTrans_eq_simplify; extensionality x; trivial.
  Qed.

End Prod_Func_Hom_Func_invl.
(*
(** If I : C ≃ D is an isomorphism of categories, then hom functor of C is naturally isomorphic to hom functor of D taken after conversion from C to D through I. In this section we prove this by providing both sides of natural isomorphism and showing that they are inverses. *)
Section Hom_Func_to_Iso_Hom_Func.
  Context {C D : Category} (I : (C ≃≃ D ::> Cat)%isomorphism).

  Local Obligation Tactic := idtac.

  Program Definition Hom_Func_to_Iso_Hom_Func : ((Hom_Func C) –≻ ((Hom_Func D) ∘ (Prod_Functor ((iso_morphism I)^op) (iso_morphism I))))%nattrans :=
    {|
      Trans := fun c h => ((iso_morphism I) _a h)%morphism
    |}.

  Next Obligation.
  Proof.
    basic_simpl; auto.
  Qed.

  Next Obligation.
  Proof.
    symmetry.
    apply Hom_Func_to_Iso_Hom_Func_obligation_1.
  Qed.

  Program Definition Iso_Hom_Func_to_Hom_Func :
    (((Hom_Func D) ∘ (Prod_Functor ((iso_morphism I)^op) (iso_morphism I))) –≻ (Hom_Func C))%nattrans
    :=
    {|
      Trans := fun c h => Cat_Iso_conv_inv I ((inverse_morphism I) _a h)
    |}.

  Next Obligation.
  Proof.
    basic_simpl; FunExt.
    repeat rewrite F_compose.
    repeat rewrite Cat_Iso_conv_inv_compose.
    repeat rewrite Cat_Iso_conv_inv_I_inv_I; trivial.
  Qed.

  Next Obligation.
  Proof.
    symmetry.
    apply Iso_Hom_Func_to_Hom_Func_obligation_1.
  Qed.

  Program Definition Hom_Func_Cat_Iso :
    (
      (Hom_Func C)
        ≃ ((Hom_Func D) ∘ (Prod_Functor ((iso_morphism I)^op) (iso_morphism I)))%functor
    )%natiso :=
    {|
      iso_morphism := Hom_Func_to_Iso_Hom_Func;
      inverse_morphism := Iso_Hom_Func_to_Hom_Func
    |}.

  Next Obligation.
  Proof.
    apply NatTrans_eq_simplify; basic_simpl; FunExt.
    apply Cat_Iso_conv_inv_I_inv_I.
  Qed.

  Next Obligation.
  Proof.
    apply NatTrans_eq_simplify.
    extensionality c; cbn.
    extensionality f.
    destruct (Cat_Iso_inv I f) as [g H].
    rewrite H.
    rewrite Cat_Iso_conv_inv_I_inv_I; trivial.
  Qed.

End Hom_Func_to_Iso_Hom_Func.
*)


(************************************************************************)
(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010     *)
(*   \VV/  **************************************************************)
(*    //   *      This file is distributed under the terms of the       *)
(*         *       GNU Lesser General Public License Version 2.1        *)
(************************************************************************)

Require Import Rbase.
Require Import Rfunctions.
Open Local Scope R_scope.

Inductive Rlist : Type :=
| nil : Rlist
| cons : R -> Rlist -> Rlist.

Fixpoint In (x:R) (l:Rlist) : Prop :=
  match l with
    | nil => False
    | cons a l' => x = a \/ In x l'
  end.

Fixpoint Rlength (l:Rlist) : nat :=
  match l with
    | nil => 0%nat
    | cons a l' => S (Rlength l')
  end.

Fixpoint MaxRlist (l:Rlist) : R :=
  match l with
    | nil => 0
    | cons a l1 =>
      match l1 with
        | nil => a
        | cons a' l2 => Rmax a (MaxRlist l1)
      end
  end.

Fixpoint MinRlist (l:Rlist) : R :=
  match l with
    | nil => 1
    | cons a l1 =>
      match l1 with
        | nil => a
        | cons a' l2 => Rmin a (MinRlist l1)
      end
  end.

Lemma MaxRlist_P1 : forall (l:Rlist) (x:R), In x l -> x <= MaxRlist l.
Proof.
  intros; induction  l as [| r l Hrecl].
  simpl in H; elim H.
  induction  l as [| r0 l Hrecl0].
  simpl in H; elim H; intro.
  simpl in |- *; right; assumption.
  elim H0.
  replace (MaxRlist (cons r (cons r0 l))) with (Rmax r (MaxRlist (cons r0 l))).
  simpl in H; decompose [or] H.
  rewrite H0; apply RmaxLess1.
  unfold Rmax in |- *; case (Rle_dec r (MaxRlist (cons r0 l))); intro.
  apply Hrecl; simpl in |- *; tauto.
  apply Rle_trans with (MaxRlist (cons r0 l));
    [ apply Hrecl; simpl in |- *; tauto | left; auto with real ].
  unfold Rmax in |- *; case (Rle_dec r (MaxRlist (cons r0 l))); intro.
  apply Hrecl; simpl in |- *; tauto.
  apply Rle_trans with (MaxRlist (cons r0 l));
    [ apply Hrecl; simpl in |- *; tauto | left; auto with real ].
  reflexivity.
Qed.

Fixpoint AbsList (l:Rlist) (x:R) : Rlist :=
  match l with
    | nil => nil
    | cons a l' => cons (Rabs (a - x) / 2) (AbsList l' x)
  end.

Lemma MinRlist_P1 : forall (l:Rlist) (x:R), In x l -> MinRlist l <= x.
Proof.
  intros; induction  l as [| r l Hrecl].
  simpl in H; elim H.
  induction  l as [| r0 l Hrecl0].
  simpl in H; elim H; intro.
  simpl in |- *; right; symmetry  in |- *; assumption.
  elim H0.
  replace (MinRlist (cons r (cons r0 l))) with (Rmin r (MinRlist (cons r0 l))).
  simpl in H; decompose [or] H.
  rewrite H0; apply Rmin_l.
  unfold Rmin in |- *; case (Rle_dec r (MinRlist (cons r0 l))); intro.
  apply Rle_trans with (MinRlist (cons r0 l)).
  assumption.
  apply Hrecl; simpl in |- *; tauto.
  apply Hrecl; simpl in |- *; tauto.
  apply Rle_trans with (MinRlist (cons r0 l)).
  apply Rmin_r.
  apply Hrecl; simpl in |- *; tauto.
  reflexivity.
Qed.

Lemma AbsList_P1 :
  forall (l:Rlist) (x y:R), In y l -> In (Rabs (y - x) / 2) (AbsList l x).
Proof.
  intros; induction  l as [| r l Hrecl].
  elim H.
  simpl in |- *; simpl in H; elim H; intro.
  left; rewrite H0; reflexivity.
  right; apply Hrecl; assumption.
Qed.

Lemma MinRlist_P2 :
  forall l:Rlist, (forall y:R, In y l -> 0 < y) -> 0 < MinRlist l.
Proof.
  intros; induction  l as [| r l Hrecl].
  apply Rlt_0_1.
  induction  l as [| r0 l Hrecl0].
  simpl in |- *; apply H; simpl in |- *; tauto.
  replace (MinRlist (cons r (cons r0 l))) with (Rmin r (MinRlist (cons r0 l))).
  unfold Rmin in |- *; case (Rle_dec r (MinRlist (cons r0 l))); intro.
  apply H; simpl in |- *; tauto.
  apply Hrecl; intros; apply H; simpl in |- *; simpl in H0; tauto.
  reflexivity.
Qed.

Lemma AbsList_P2 :
  forall (l:Rlist) (x y:R),
    In y (AbsList l x) ->  exists z : R, In z l /\ y = Rabs (z - x) / 2.
Proof.
  intros; induction  l as [| r l Hrecl].
  elim H.
  elim H; intro.
  exists r; split.
  simpl in |- *; tauto.
  assumption.
  assert (H1 := Hrecl H0); elim H1; intros; elim H2; clear H2; intros;
    exists x0; simpl in |- *; simpl in H2; tauto.
Qed.

Lemma MaxRlist_P2 :
  forall l:Rlist, (exists y : R, In y l) -> In (MaxRlist l) l.
Proof.
  intros; induction  l as [| r l Hrecl].
  simpl in H; elim H; trivial.
  induction  l as [| r0 l Hrecl0].
  simpl in |- *; left; reflexivity.
  change (In (Rmax r (MaxRlist (cons r0 l))) (cons r (cons r0 l))) in |- *;
    unfold Rmax in |- *; case (Rle_dec r (MaxRlist (cons r0 l)));
      intro.
  right; apply Hrecl; exists r0; left; reflexivity.
  left; reflexivity.
Qed.

Fixpoint pos_Rl (l:Rlist) (i:nat) : R :=
  match l with
    | nil => 0
    | cons a l' => match i with
                     | O => a
                     | S i' => pos_Rl l' i'
                   end
  end.

Lemma pos_Rl_P1 :
  forall (l:Rlist) (a:R),
    (0 < Rlength l)%nat ->
    pos_Rl (cons a l) (Rlength l) = pos_Rl l (pred (Rlength l)).
Proof.
  intros; induction  l as [| r l Hrecl];
    [ elim (lt_n_O _ H)
      | simpl in |- *; case (Rlength l); [ reflexivity | intro; reflexivity ] ].
Qed.

Lemma pos_Rl_P2 :
  forall (l:Rlist) (x:R),
    In x l <-> (exists i : nat, (i < Rlength l)%nat /\ x = pos_Rl l i).
Proof.
  intros; induction  l as [| r l Hrecl].
  split; intro;
    [ elim H | elim H; intros; elim H0; intros; elim (lt_n_O _ H1) ].
  split; intro.
  elim H; intro.
  exists 0%nat; split;
    [ simpl in |- *; apply lt_O_Sn | simpl in |- *; apply H0 ].
  elim Hrecl; intros; assert (H3 := H1 H0); elim H3; intros; elim H4; intros;
    exists (S x0); split;
      [ simpl in |- *; apply lt_n_S; assumption | simpl in |- *; assumption ].
  elim H; intros; elim H0; intros; elim (zerop x0); intro.
  rewrite a in H2; simpl in H2; left; assumption.
  right; elim Hrecl; intros; apply H4; assert (H5 : S (pred x0) = x0).
  symmetry  in |- *; apply S_pred with 0%nat; assumption.
  exists (pred x0); split;
    [ simpl in H1; apply lt_S_n; rewrite H5; assumption
      | rewrite <- H5 in H2; simpl in H2; assumption ].
Qed.

Lemma Rlist_P1 :
  forall (l:Rlist) (P:R -> R -> Prop),
    (forall x:R, In x l ->  exists y : R, P x y) ->
    exists l' : Rlist,
      Rlength l = Rlength l' /\
      (forall i:nat, (i < Rlength l)%nat -> P (pos_Rl l i) (pos_Rl l' i)).
Proof.
  intros; induction  l as [| r l Hrecl].
  exists nil; intros; split;
    [ reflexivity | intros; simpl in H0; elim (lt_n_O _ H0) ].
  assert (H0 : In r (cons r l)).
  simpl in |- *; left; reflexivity.
  assert (H1 := H _ H0);
    assert (H2 : forall x:R, In x l ->  exists y : R, P x y).
  intros; apply H; simpl in |- *; right; assumption.
  assert (H3 := Hrecl H2); elim H1; intros; elim H3; intros; exists (cons x x0);
    intros; elim H5; clear H5; intros; split.
  simpl in |- *; rewrite H5; reflexivity.
  intros; elim (zerop i); intro.
  rewrite a; simpl in |- *; assumption.
  assert (H8 : i = S (pred i)).
  apply S_pred with 0%nat; assumption.
  rewrite H8; simpl in |- *; apply H6; simpl in H7; apply lt_S_n; rewrite <- H8;
    assumption.
Qed.

Definition ordered_Rlist (l:Rlist) : Prop :=
  forall i:nat, (i < pred (Rlength l))%nat -> pos_Rl l i <= pos_Rl l (S i).

Fixpoint insert (l:Rlist) (x:R) : Rlist :=
  match l with
    | nil => cons x nil
    | cons a l' =>
      match Rle_dec a x with
        | left _ => cons a (insert l' x)
        | right _ => cons x l
      end
  end.

Fixpoint cons_Rlist (l k:Rlist) : Rlist :=
  match l with
    | nil => k
    | cons a l' => cons a (cons_Rlist l' k)
  end.

Fixpoint cons_ORlist (k l:Rlist) : Rlist :=
  match k with
    | nil => l
    | cons a k' => cons_ORlist k' (insert l a)
  end.

Fixpoint app_Rlist (l:Rlist) (f:R -> R) : Rlist :=
  match l with
    | nil => nil
    | cons a l' => cons (f a) (app_Rlist l' f)
  end.

Fixpoint mid_Rlist (l:Rlist) (x:R) : Rlist :=
  match l with
    | nil => nil
    | cons a l' => cons ((x + a) / 2) (mid_Rlist l' a)
  end.

Definition Rtail (l:Rlist) : Rlist :=
  match l with
    | nil => nil
    | cons a l' => l'
  end.

Definition FF (l:Rlist) (f:R -> R) : Rlist :=
  match l with
    | nil => nil
    | cons a l' => app_Rlist (mid_Rlist l' a) f
  end.

Lemma RList_P0 :
  forall (l:Rlist) (a:R),
    pos_Rl (insert l a) 0 = a \/ pos_Rl (insert l a) 0 = pos_Rl l 0.
Proof.
  intros; induction  l as [| r l Hrecl];
    [ left; reflexivity
      | simpl in |- *; case (Rle_dec r a); intro;
        [ right; reflexivity | left; reflexivity ] ].
Qed.

Lemma RList_P1 :
  forall (l:Rlist) (a:R), ordered_Rlist l -> ordered_Rlist (insert l a).
Proof.
  intros; induction  l as [| r l Hrecl].
  simpl in |- *; unfold ordered_Rlist in |- *; intros; simpl in H0;
    elim (lt_n_O _ H0).
  simpl in |- *; case (Rle_dec r a); intro.
  assert (H1 : ordered_Rlist l).
  unfold ordered_Rlist in |- *; unfold ordered_Rlist in H; intros;
    assert (H1 : (S i < pred (Rlength (cons r l)))%nat);
      [ simpl in |- *; replace (Rlength l) with (S (pred (Rlength l)));
        [ apply lt_n_S; assumption
          | symmetry  in |- *; apply S_pred with 0%nat; apply neq_O_lt; red in |- *;
            intro; rewrite <- H1 in H0; simpl in H0; elim (lt_n_O _ H0) ]
        | apply (H _ H1) ].
  assert (H2 := Hrecl H1); unfold ordered_Rlist in |- *; intros;
    induction  i as [| i Hreci].
  simpl in |- *; assert (H3 := RList_P0 l a); elim H3; intro.
  rewrite H4; assumption.
  induction  l as [| r1 l Hrecl0];
    [ simpl in |- *; assumption
      | rewrite H4; apply (H 0%nat); simpl in |- *; apply lt_O_Sn ].
  simpl in |- *; apply H2; simpl in H0; apply lt_S_n;
    replace (S (pred (Rlength (insert l a)))) with (Rlength (insert l a));
    [ assumption
      | apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro;
        rewrite <- H3 in H0; elim (lt_n_O _ H0) ].
  unfold ordered_Rlist in |- *; intros; induction  i as [| i Hreci];
    [ simpl in |- *; auto with real
      | change (pos_Rl (cons r l) i <= pos_Rl (cons r l) (S i)) in |- *; apply H;
        simpl in H0; simpl in |- *; apply (lt_S_n _ _ H0) ].
Qed.

Lemma RList_P2 :
  forall l1 l2:Rlist, ordered_Rlist l2 -> ordered_Rlist (cons_ORlist l1 l2).
Proof.
  simple induction l1;
    [ intros; simpl in |- *; apply H
      | intros; simpl in |- *; apply H; apply RList_P1; assumption ].
Qed.

Lemma RList_P3 :
  forall (l:Rlist) (x:R),
    In x l <-> (exists i : nat, x = pos_Rl l i /\ (i < Rlength l)%nat).
Proof.
  intros; split; intro;
    [ induction  l as [| r l Hrecl] | induction  l as [| r l Hrecl] ].
  elim H.
  elim H; intro;
    [ exists 0%nat; split; [ apply H0 | simpl in |- *; apply lt_O_Sn ]
      | elim (Hrecl H0); intros; elim H1; clear H1; intros; exists (S x0); split;
        [ apply H1 | simpl in |- *; apply lt_n_S; assumption ] ].
  elim H; intros; elim H0; intros; elim (lt_n_O _ H2).
  simpl in |- *; elim H; intros; elim H0; clear H0; intros;
    induction  x0 as [| x0 Hrecx0];
      [ left; apply H0
        | right; apply Hrecl; exists x0; split;
          [ apply H0 | simpl in H1; apply lt_S_n; assumption ] ].
Qed.

Lemma RList_P4 :
  forall (l1:Rlist) (a:R), ordered_Rlist (cons a l1) -> ordered_Rlist l1.
Proof.
  intros; unfold ordered_Rlist in |- *; intros; apply (H (S i)); simpl in |- *;
    replace (Rlength l1) with (S (pred (Rlength l1)));
    [ apply lt_n_S; assumption
      | symmetry  in |- *; apply S_pred with 0%nat; apply neq_O_lt; red in |- *;
        intro; rewrite <- H1 in H0; elim (lt_n_O _ H0) ].
Qed.

Lemma RList_P5 :
  forall (l:Rlist) (x:R), ordered_Rlist l -> In x l -> pos_Rl l 0 <= x.
Proof.
  intros; induction  l as [| r l Hrecl];
    [ elim H0
      | simpl in |- *; elim H0; intro;
        [ rewrite H1; right; reflexivity
          | apply Rle_trans with (pos_Rl l 0);
            [ apply (H 0%nat); simpl in |- *; induction  l as [| r0 l Hrecl0];
              [ elim H1 | simpl in |- *; apply lt_O_Sn ]
              | apply Hrecl; [ eapply RList_P4; apply H | assumption ] ] ] ].
Qed.

Lemma RList_P6 :
  forall l:Rlist,
    ordered_Rlist l <->
    (forall i j:nat,
      (i <= j)%nat -> (j < Rlength l)%nat -> pos_Rl l i <= pos_Rl l j).
Proof.
  simple induction l; split; intro.
  intros; right; reflexivity.
  unfold ordered_Rlist in |- *; intros; simpl in H0; elim (lt_n_O _ H0).
  intros; induction  i as [| i Hreci];
    [ induction  j as [| j Hrecj];
      [ right; reflexivity
        | simpl in |- *; apply Rle_trans with (pos_Rl r0 0);
          [ apply (H0 0%nat); simpl in |- *; simpl in H2; apply neq_O_lt;
            red in |- *; intro; rewrite <- H3 in H2;
              assert (H4 := lt_S_n _ _ H2); elim (lt_n_O _ H4)
            | elim H; intros; apply H3;
              [ apply RList_P4 with r; assumption
                | apply le_O_n
                | simpl in H2; apply lt_S_n; assumption ] ] ]
      | induction  j as [| j Hrecj];
        [ elim (le_Sn_O _ H1)
          | simpl in |- *; elim H; intros; apply H3;
            [ apply RList_P4 with r; assumption
              | apply le_S_n; assumption
              | simpl in H2; apply lt_S_n; assumption ] ] ].
  unfold ordered_Rlist in |- *; intros; apply H0;
    [ apply le_n_Sn | simpl in |- *; simpl in H1; apply lt_n_S; assumption ].
Qed.

Lemma RList_P7 :
  forall (l:Rlist) (x:R),
    ordered_Rlist l -> In x l -> x <= pos_Rl l (pred (Rlength l)).
Proof.
  intros; assert (H1 := RList_P6 l); elim H1; intros H2 _; assert (H3 := H2 H);
    clear H1 H2; assert (H1 := RList_P3 l x); elim H1;
      clear H1; intros; assert (H4 := H1 H0); elim H4; clear H4;
        intros; elim H4; clear H4; intros; rewrite H4;
          assert (H6 : Rlength l = S (pred (Rlength l))).
  apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro;
    rewrite <- H6 in H5; elim (lt_n_O _ H5).
  apply H3;
    [ rewrite H6 in H5; apply lt_n_Sm_le; assumption
      | apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H7 in H5;
        elim (lt_n_O _ H5) ].
Qed.

Lemma RList_P8 :
  forall (l:Rlist) (a x:R), In x (insert l a) <-> x = a \/ In x l.
Proof.
  simple induction l.
  intros; split; intro; simpl in H; apply H.
  intros; split; intro;
    [ simpl in H0; generalize H0; case (Rle_dec r a); intros;
      [ simpl in H1; elim H1; intro;
        [ right; left; assumption
          | elim (H a x); intros; elim (H3 H2); intro;
            [ left; assumption | right; right; assumption ] ]
        | simpl in H1; decompose [or] H1;
          [ left; assumption
            | right; left; assumption
            | right; right; assumption ] ]
      | simpl in |- *; case (Rle_dec r a); intro;
        [ simpl in H0; decompose [or] H0;
          [ right; elim (H a x); intros; apply H3; left
            | left
            | right; elim (H a x); intros; apply H3; right ]
          | simpl in H0; decompose [or] H0; [ left | right; left | right; right ] ];
        assumption ].
Qed.

Lemma RList_P9 :
  forall (l1 l2:Rlist) (x:R), In x (cons_ORlist l1 l2) <-> In x l1 \/ In x l2.
Proof.
  simple induction l1.
  intros; split; intro;
    [ simpl in H; right; assumption
      | simpl in |- *; elim H; intro; [ elim H0 | assumption ] ].
  intros; split.
  simpl in |- *; intros; elim (H (insert l2 r) x); intros; assert (H3 := H1 H0);
    elim H3; intro;
      [ left; right; assumption
        | elim (RList_P8 l2 r x); intros H5 _; assert (H6 := H5 H4); elim H6; intro;
          [ left; left; assumption | right; assumption ] ].
  intro; simpl in |- *; elim (H (insert l2 r) x); intros _ H1; apply H1;
    elim H0; intro;
      [ elim H2; intro;
        [ right; elim (RList_P8 l2 r x); intros _ H4; apply H4; left; assumption
          | left; assumption ]
        | right; elim (RList_P8 l2 r x); intros _ H3; apply H3; right; assumption ].
Qed.

Lemma RList_P10 :
  forall (l:Rlist) (a:R), Rlength (insert l a) = S (Rlength l).
Proof.
  intros; induction  l as [| r l Hrecl];
    [ reflexivity
      | simpl in |- *; case (Rle_dec r a); intro;
        [ simpl in |- *; rewrite Hrecl; reflexivity | reflexivity ] ].
Qed.

Lemma RList_P11 :
  forall l1 l2:Rlist,
    Rlength (cons_ORlist l1 l2) = (Rlength l1 + Rlength l2)%nat.
Proof.
  simple induction l1;
    [ intro; reflexivity
      | intros; simpl in |- *; rewrite (H (insert l2 r)); rewrite RList_P10;
        apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR;
          rewrite S_INR; ring ].
Qed.

Lemma RList_P12 :
  forall (l:Rlist) (i:nat) (f:R -> R),
    (i < Rlength l)%nat -> pos_Rl (app_Rlist l f) i = f (pos_Rl l i).
Proof.
  simple induction l;
    [ intros; elim (lt_n_O _ H)
      | intros; induction  i as [| i Hreci];
        [ reflexivity | simpl in |- *; apply H; apply lt_S_n; apply H0 ] ].
Qed.

Lemma RList_P13 :
  forall (l:Rlist) (i:nat) (a:R),
    (i < pred (Rlength l))%nat ->
    pos_Rl (mid_Rlist l a) (S i) = (pos_Rl l i + pos_Rl l (S i)) / 2.
Proof.
  simple induction l.
  intros; simpl in H; elim (lt_n_O _ H).
  simple induction r0.
  intros; simpl in H0; elim (lt_n_O _ H0).
  intros; simpl in H1; induction  i as [| i Hreci].
  reflexivity.
  change
    (pos_Rl (mid_Rlist (cons r1 r2) r) (S i) =
      (pos_Rl (cons r1 r2) i + pos_Rl (cons r1 r2) (S i)) / 2)
    in |- *; apply H0; simpl in |- *; apply lt_S_n; assumption.
Qed.

Lemma RList_P14 : forall (l:Rlist) (a:R), Rlength (mid_Rlist l a) = Rlength l.
Proof.
  simple induction l; intros;
    [ reflexivity | simpl in |- *; rewrite (H r); reflexivity ].
Qed.

Lemma RList_P15 :
  forall l1 l2:Rlist,
    ordered_Rlist l1 ->
    ordered_Rlist l2 ->
    pos_Rl l1 0 = pos_Rl l2 0 -> pos_Rl (cons_ORlist l1 l2) 0 = pos_Rl l1 0.
Proof.
  intros; apply Rle_antisym.
  induction  l1 as [| r l1 Hrecl1];
    [ simpl in |- *; simpl in H1; right; symmetry  in |- *; assumption
      | elim (RList_P9 (cons r l1) l2 (pos_Rl (cons r l1) 0)); intros;
        assert
          (H4 :
            In (pos_Rl (cons r l1) 0) (cons r l1) \/ In (pos_Rl (cons r l1) 0) l2);
          [ left; left; reflexivity
            | assert (H5 := H3 H4); apply RList_P5;
              [ apply RList_P2; assumption | assumption ] ] ].
  induction  l1 as [| r l1 Hrecl1];
    [ simpl in |- *; simpl in H1; right; assumption
      | assert
        (H2 :
          In (pos_Rl (cons_ORlist (cons r l1) l2) 0) (cons_ORlist (cons r l1) l2));
        [ elim
          (RList_P3 (cons_ORlist (cons r l1) l2)
            (pos_Rl (cons_ORlist (cons r l1) l2) 0));
          intros; apply H3; exists 0%nat; split;
            [ reflexivity | rewrite RList_P11; simpl in |- *; apply lt_O_Sn ]
          | elim (RList_P9 (cons r l1) l2 (pos_Rl (cons_ORlist (cons r l1) l2) 0));
            intros; assert (H5 := H3 H2); elim H5; intro;
              [ apply RList_P5; assumption
                | rewrite H1; apply RList_P5; assumption ] ] ].
Qed.

Lemma RList_P16 :
  forall l1 l2:Rlist,
    ordered_Rlist l1 ->
    ordered_Rlist l2 ->
    pos_Rl l1 (pred (Rlength l1)) = pos_Rl l2 (pred (Rlength l2)) ->
    pos_Rl (cons_ORlist l1 l2) (pred (Rlength (cons_ORlist l1 l2))) =
    pos_Rl l1 (pred (Rlength l1)).
Proof.
  intros; apply Rle_antisym.
  induction  l1 as [| r l1 Hrecl1].
  simpl in |- *; simpl in H1; right; symmetry  in |- *; assumption.
  assert
    (H2 :
      In
      (pos_Rl (cons_ORlist (cons r l1) l2)
        (pred (Rlength (cons_ORlist (cons r l1) l2))))
      (cons_ORlist (cons r l1) l2));
    [ elim
      (RList_P3 (cons_ORlist (cons r l1) l2)
        (pos_Rl (cons_ORlist (cons r l1) l2)
          (pred (Rlength (cons_ORlist (cons r l1) l2)))));
      intros; apply H3; exists (pred (Rlength (cons_ORlist (cons r l1) l2)));
        split; [ reflexivity | rewrite RList_P11; simpl in |- *; apply lt_n_Sn ]
      | elim
        (RList_P9 (cons r l1) l2
          (pos_Rl (cons_ORlist (cons r l1) l2)
            (pred (Rlength (cons_ORlist (cons r l1) l2)))));
        intros; assert (H5 := H3 H2); elim H5; intro;
          [ apply RList_P7; assumption | rewrite H1; apply RList_P7; assumption ] ].
  induction  l1 as [| r l1 Hrecl1].
  simpl in |- *; simpl in H1; right; assumption.
  elim
    (RList_P9 (cons r l1) l2 (pos_Rl (cons r l1) (pred (Rlength (cons r l1)))));
    intros;
      assert
        (H4 :
          In (pos_Rl (cons r l1) (pred (Rlength (cons r l1)))) (cons r l1) \/
          In (pos_Rl (cons r l1) (pred (Rlength (cons r l1)))) l2);
        [ left; change (In (pos_Rl (cons r l1) (Rlength l1)) (cons r l1)) in |- *;
          elim (RList_P3 (cons r l1) (pos_Rl (cons r l1) (Rlength l1)));
            intros; apply H5; exists (Rlength l1); split;
              [ reflexivity | simpl in |- *; apply lt_n_Sn ]
          | assert (H5 := H3 H4); apply RList_P7;
            [ apply RList_P2; assumption
              | elim
                (RList_P9 (cons r l1) l2
                  (pos_Rl (cons r l1) (pred (Rlength (cons r l1)))));
                intros; apply H7; left;
                  elim
                    (RList_P3 (cons r l1)
                      (pos_Rl (cons r l1) (pred (Rlength (cons r l1)))));
                    intros; apply H9; exists (pred (Rlength (cons r l1)));
                      split; [ reflexivity | simpl in |- *; apply lt_n_Sn ] ] ].
Qed.

Lemma RList_P17 :
  forall (l1:Rlist) (x:R) (i:nat),
    ordered_Rlist l1 ->
    In x l1 ->
    pos_Rl l1 i < x -> (i < pred (Rlength l1))%nat -> pos_Rl l1 (S i) <= x.
Proof.
  simple induction l1.
  intros; elim H0.
  intros; induction  i as [| i Hreci].
  simpl in |- *; elim H1; intro;
    [ simpl in H2; rewrite H4 in H2; elim (Rlt_irrefl _ H2)
      | apply RList_P5; [ apply RList_P4 with r; assumption | assumption ] ].
  simpl in |- *; simpl in H2; elim H1; intro.
  rewrite H4 in H2; assert (H5 : r <= pos_Rl r0 i);
    [ apply Rle_trans with (pos_Rl r0 0);
      [ apply (H0 0%nat); simpl in |- *; simpl in H3; apply neq_O_lt;
        red in |- *; intro; rewrite <- H5 in H3; elim (lt_n_O _ H3)
        | elim (RList_P6 r0); intros; apply H5;
          [ apply RList_P4 with r; assumption
            | apply le_O_n
            | simpl in H3; apply lt_S_n; apply lt_trans with (Rlength r0);
              [ apply H3 | apply lt_n_Sn ] ] ]
      | elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H5 H2)) ].
  apply H; try assumption;
    [ apply RList_P4 with r; assumption
      | simpl in H3; apply lt_S_n;
        replace (S (pred (Rlength r0))) with (Rlength r0);
        [ apply H3
          | apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro;
            rewrite <- H5 in H3; elim (lt_n_O _ H3) ] ].
Qed.

Lemma RList_P18 :
  forall (l:Rlist) (f:R -> R), Rlength (app_Rlist l f) = Rlength l.
Proof.
  simple induction l; intros;
    [ reflexivity | simpl in |- *; rewrite H; reflexivity ].
Qed.

Lemma RList_P19 :
  forall l:Rlist,
    l <> nil ->  exists r : R, (exists r0 : Rlist, l = cons r r0).
Proof.
  intros; induction  l as [| r l Hrecl];
    [ elim H; reflexivity | exists r; exists l; reflexivity ].
Qed.

Lemma RList_P20 :
  forall l:Rlist,
    (2 <= Rlength l)%nat ->
    exists r : R,
      (exists r1 : R, (exists l' : Rlist, l = cons r (cons r1 l'))).
Proof.
  intros; induction  l as [| r l Hrecl];
    [ simpl in H; elim (le_Sn_O _ H)
      | induction  l as [| r0 l Hrecl0];
        [ simpl in H; elim (le_Sn_O _ (le_S_n _ _ H))
          | exists r; exists r0; exists l; reflexivity ] ].
Qed.

Lemma RList_P21 : forall l l':Rlist, l = l' -> Rtail l = Rtail l'.
Proof.
  intros; rewrite H; reflexivity.
Qed.

Lemma RList_P22 :
  forall l1 l2:Rlist, l1 <> nil -> pos_Rl (cons_Rlist l1 l2) 0 = pos_Rl l1 0.
Proof.
  simple induction l1; [ intros; elim H; reflexivity | intros; reflexivity ].
Qed.

Lemma RList_P23 :
  forall l1 l2:Rlist,
    Rlength (cons_Rlist l1 l2) = (Rlength l1 + Rlength l2)%nat.
Proof.
  simple induction l1;
    [ intro; reflexivity | intros; simpl in |- *; rewrite H; reflexivity ].
Qed.

Lemma RList_P24 :
  forall l1 l2:Rlist,
    l2 <> nil ->
    pos_Rl (cons_Rlist l1 l2) (pred (Rlength (cons_Rlist l1 l2))) =
    pos_Rl l2 (pred (Rlength l2)).
Proof.
  simple induction l1.
  intros; reflexivity.
  intros; rewrite <- (H l2 H0); induction  l2 as [| r1 l2 Hrecl2].
  elim H0; reflexivity.
  do 2 rewrite RList_P23;
    replace (Rlength (cons r r0) + Rlength (cons r1 l2))%nat with
    (S (S (Rlength r0 + Rlength l2)));
    [ replace (Rlength r0 + Rlength (cons r1 l2))%nat with
      (S (Rlength r0 + Rlength l2));
      [ reflexivity
        | simpl in |- *; apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR;
          rewrite S_INR; ring ]
      | simpl in |- *; apply INR_eq; do 3 rewrite S_INR; do 2 rewrite plus_INR;
        rewrite S_INR; ring ].
Qed.

Lemma RList_P25 :
  forall l1 l2:Rlist,
    ordered_Rlist l1 ->
    ordered_Rlist l2 ->
    pos_Rl l1 (pred (Rlength l1)) <= pos_Rl l2 0 ->
    ordered_Rlist (cons_Rlist l1 l2).
Proof.
  simple induction l1.
  intros; simpl in |- *; assumption.
  simple induction r0.
  intros; simpl in |- *; simpl in H2; unfold ordered_Rlist in |- *; intros;
    simpl in H3.
  induction  i as [| i Hreci].
  simpl in |- *; assumption.
  change (pos_Rl l2 i <= pos_Rl l2 (S i)) in |- *; apply (H1 i); apply lt_S_n;
    replace (S (pred (Rlength l2))) with (Rlength l2);
    [ assumption
      | apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro;
        rewrite <- H4 in H3; elim (lt_n_O _ H3) ].
  intros; clear H; assert (H : ordered_Rlist (cons_Rlist (cons r1 r2) l2)).
  apply H0; try assumption.
  apply RList_P4 with r; assumption.
  unfold ordered_Rlist in |- *; intros; simpl in H4;
    induction  i as [| i Hreci].
  simpl in |- *; apply (H1 0%nat); simpl in |- *; apply lt_O_Sn.
  change
    (pos_Rl (cons_Rlist (cons r1 r2) l2) i <=
      pos_Rl (cons_Rlist (cons r1 r2) l2) (S i)) in |- *;
    apply (H i); simpl in |- *; apply lt_S_n; assumption.
Qed.

Lemma RList_P26 :
  forall (l1 l2:Rlist) (i:nat),
    (i < Rlength l1)%nat -> pos_Rl (cons_Rlist l1 l2) i = pos_Rl l1 i.
Proof.
  simple induction l1.
  intros; elim (lt_n_O _ H).
  intros; induction  i as [| i Hreci].
  apply RList_P22; discriminate.
  apply (H l2 i); simpl in H0; apply lt_S_n; assumption.
Qed.

Lemma RList_P27 :
  forall l1 l2 l3:Rlist,
    cons_Rlist l1 (cons_Rlist l2 l3) = cons_Rlist (cons_Rlist l1 l2) l3.
Proof.
  simple induction l1; intros;
    [ reflexivity | simpl in |- *; rewrite (H l2 l3); reflexivity ].
Qed.

Lemma RList_P28 : forall l:Rlist, cons_Rlist l nil = l.
Proof.
  simple induction l;
    [ reflexivity | intros; simpl in |- *; rewrite H; reflexivity ].
Qed.

Lemma RList_P29 :
  forall (l2 l1:Rlist) (i:nat),
    (Rlength l1 <= i)%nat ->
    (i < Rlength (cons_Rlist l1 l2))%nat ->
    pos_Rl (cons_Rlist l1 l2) i = pos_Rl l2 (i - Rlength l1).
Proof.
  simple induction l2.
  intros; rewrite RList_P28 in H0; elim (lt_irrefl _ (le_lt_trans _ _ _ H H0)).
  intros;
    replace (cons_Rlist l1 (cons r r0)) with
    (cons_Rlist (cons_Rlist l1 (cons r nil)) r0).
  inversion H0.
  rewrite <- minus_n_n; simpl in |- *; rewrite RList_P26.
  clear l2 r0 H i H0 H1 H2; induction  l1 as [| r0 l1 Hrecl1].
  reflexivity.
  simpl in |- *; assumption.
  rewrite RList_P23; rewrite plus_comm; simpl in |- *; apply lt_n_Sn.
  replace (S m - Rlength l1)%nat with (S (S m - S (Rlength l1))).
  rewrite H3; simpl in |- *;
    replace (S (Rlength l1)) with (Rlength (cons_Rlist l1 (cons r nil))).
  apply (H (cons_Rlist l1 (cons r nil)) i).
  rewrite RList_P23; rewrite plus_comm; simpl in |- *; rewrite <- H3;
    apply le_n_S; assumption.
  repeat rewrite RList_P23; simpl in |- *; rewrite RList_P23 in H1;
    rewrite plus_comm in H1; simpl in H1; rewrite (plus_comm (Rlength l1));
      simpl in |- *; rewrite plus_comm; apply H1.
  rewrite RList_P23; rewrite plus_comm; reflexivity.
  change (S (m - Rlength l1) = (S m - Rlength l1)%nat) in |- *;
    apply minus_Sn_m; assumption.
  replace (cons r r0) with (cons_Rlist (cons r nil) r0);
  [ symmetry  in |- *; apply RList_P27 | reflexivity ].
Qed.


Require Import prosa.classic.util.all.
Require Import prosa.classic.model.arrival.basic.task prosa.classic.model.arrival.basic.job prosa.classic.model.arrival.basic.arrival_sequence.
From mathcomp Require Import ssreflect ssrbool eqtype ssrnat seq.

(* Definitions of FP, JLFP and JLDP priority relations. *)
Module Priority.

  Import SporadicTaskset ArrivalSequence.

  Section PriorityDefs.

    Variable Task: eqType.
    Variable Job: eqType.

    (* We define an FP policy as a relation between tasks, ... *)
    Definition FP_policy := rel Task.

    (* ...JLFP policy as a relation between jobs, ... *)
    Definition JLFP_policy := rel Job.

    (* ...and JLDP as any time-dependent relation between jobs. *)
    Definition JLDP_policy := time -> rel Job.

  End PriorityDefs.

  (* Since FP policies are also JLFP and JLDP policies, we define
     next conversion functions to do the generalization. *)
  Section Generalization.

    (* Consider any arrival sequence of jobs spawned by tasks. *)
    Context {Task: eqType}.
    Context {Job: eqType}.
    Variable job_task: Job -> Task.

    (* We show how to convert FP to JLFP,... *)
    Definition FP_to_JLFP (task_hp: FP_policy Task) :=
      fun (jhigh jlow: Job) =>
        task_hp (job_task jhigh) (job_task jlow).

    (* ...FP to JLDP, ... *)
    Definition FP_to_JLDP (task_hp: FP_policy Task) :=
      fun (t: time) => FP_to_JLFP task_hp.

    (* ...and JLFP to JLDP. *)
    Definition JLFP_to_JLDP (job_hp: JLFP_policy Job) :=
      fun (t: time) => job_hp.

  End Generalization.

  (* Next we define properties of an FP policy. *)
  Section PropertiesFP.

    (* Assume that jobs are spawned by tasks. *)
    Context {Task: eqType}.
    Context {Job: eqType}.
    Variable job_task: Job -> Task.

    (* Let task_priority be any FP policy. *)
    Variable task_priority: FP_policy Task.

    (* Now we define the properties. *)

    (* Whether the FP policy is reflexive. *)
    Definition FP_is_reflexive := reflexive task_priority.

    (* Whether the FP policy is irreflexive. *)
    Definition FP_is_irreflexive := irreflexive task_priority.

    (* Whether the FP policy is transitive. *)
    Definition FP_is_transitive := transitive task_priority.

    Section Antisymmetry.

      (* Consider any task set ts. *)
      Variable ts: seq Task.

      (* First we define whether task set ts is totally ordered with
         the priority. *)
      Definition FP_is_total_over_task_set :=
        total_over_list task_priority ts.

      (* Then we define whether an FP policy is antisymmetric over task set ts, i.e.,
         whether the task set has unique priorities. *)
      Definition FP_is_antisymmetric_over_task_set :=
        antisymmetric_over_list task_priority ts.

    End Antisymmetry.

  End PropertiesFP.

  (* Next, we define properties of a JLFP policy. *)
  Section PropertiesJLFP.

    Context {Task: eqType}.
    Context {Job: eqType}.
    Variable job_task: Job -> Task.
    Variable job_arrival: Job -> time.

    (* Consider any arrival sequence. *)
    Variable arr_seq: arrival_sequence Job.

    (* Consider any JLFP policy. *)
    Variable job_priority: JLFP_policy Job.

    (* Now we define the properties. *)

    (* Whether the JLFP policy is reflexive. *)
    Definition JLFP_is_reflexive := reflexive job_priority.

    (* Whether the JLFP policy is irreflexive. *)
    Definition JLFP_is_irreflexive := irreflexive job_priority.

    (* Whether the JLFP policy is transitive. *)
    Definition JLFP_is_transitive := transitive job_priority.

    (* Whether the JLFP policy is total over the arrival sequence. *)
    Definition JLFP_is_total :=
      forall j1 j2,
        arrives_in arr_seq j1 ->
        arrives_in arr_seq j2 ->
        job_priority j1 j2 || job_priority j2 j1.

    (* Recall that the jobs are sequential if they are executed
       in the order they arrived (for more details see file
       prosa.classic.model.schedule.uni.schedule.v).

       An arbitrary JLFP can violate the sequential jobs hypothesis.
       For example, consider two jobs j1, j2 of the same task such that
       [job_arrival j1 < job_arrival j2]. It is possible that the policy
       will assign a higher priority to the second job [i.e., π(j1) < π(j2)].
       But this situation contradicts to sequential job hypothesis.

       We say that JLFP respects sequential jobs if for any two jobs
       j1, j2 from the same task the fact that [job_arrival j1 <= job_arrival j2]
       implies [π(j1) >= π(j2)]. *)
    Definition JLFP_respects_sequential_jobs :=
      forall j1 j2,
        job_task j1 == job_task j2 ->
        job_arrival j1 <= job_arrival j2 ->
        job_priority j1 j2.

  End PropertiesJLFP.

  (* Next, we define properties of a JLDP policy. *)
  Section PropertiesJLDP.

    (* Consider any JLDP policy. *)
    Context {Job: eqType}.
    Variable arr_seq: arrival_sequence Job.

    Variable job_priority: JLDP_policy Job.

    (* Now we define the properties. *)

    (* Whether the JLDP policy is reflexive. *)
    Definition JLDP_is_reflexive :=
      forall t, reflexive (job_priority t).

    (* Whether the JLDP policy is irreflexive. *)
    Definition JLDP_is_irreflexive :=
      forall t, irreflexive (job_priority t).

    (* Whether the JLDP policy is transitive. *)
    Definition JLDP_is_transitive :=
      forall t, transitive (job_priority t).

    (* Whether the JLDP policy is total. *)
    Definition JLDP_is_total :=
      forall j1 j2 t,
        arrives_in arr_seq j1 ->
        arrives_in arr_seq j2 ->
        job_priority t j1 j2 || job_priority t j2 j1.

  End PropertiesJLDP.

  (* Next we define some known FP policies. *)
  Section KnownFPPolicies.

    Context {Job: eqType}.
    Context {Task: eqType}.
    Variable task_period: Task -> time.
    Variable task_deadline: Task -> time.
    Variable job_arrival: Job -> time.
    Variable job_task: Job -> Task.

    (* Rate-monotonic orders tasks by smaller periods. *)
    Definition RM (tsk1 tsk2: Task) :=
      task_period tsk1 <= task_period tsk2.

    (* Deadline-monotonic orders tasks by smaller relative deadlines. *)
    Definition DM (tsk1 tsk2: Task) :=
      task_deadline tsk1 <= task_deadline tsk2.

    Section Properties.

      (* RM is reflexive. *)
      Lemma RM_is_reflexive : FP_is_reflexive RM.
      Proof.
        unfold FP_is_reflexive, reflexive, RM.
        by intros tsk; apply leqnn.
      Qed.

      (* RM is transitive. *)
      Lemma RM_is_transitive : FP_is_transitive RM.
      Proof.
        unfold FP_is_transitive, transitive, RM.
        by intros y x z; apply leq_trans.
      Qed.

      (* DM is reflexive. *)
      Lemma DM_is_reflexive : FP_is_reflexive DM.
      Proof.
        unfold FP_is_reflexive, reflexive, DM.
        by intros tsk; apply leqnn.
      Qed.

      (* DM is transitive. *)
      Lemma DM_is_transitive : FP_is_transitive DM.
      Proof.
        unfold FP_is_transitive, transitive, DM.
        by intros y x z; apply leq_trans.
      Qed.

      (* Any FP respects sequential jobs. *)
      Lemma any_reflexive_FP_respects_sequential_jobs:
        forall job_priority: FP_policy Task,
          FP_is_reflexive job_priority ->
          JLFP_respects_sequential_jobs
            job_task job_arrival (FP_to_JLFP job_task job_priority).
      Proof.
        intros HP REFL j1 j2 TSK ARR.
        move: TSK => /eqP TSK.
        unfold FP_to_JLFP; rewrite TSK.
          by apply REFL.
      Qed.

    End Properties.

  End KnownFPPolicies.

  (* In this section, we define known JLFP policies. *)
  Section KnownJLFPPolicies.

    (* EDF policy. *)
    Section EDF.

      Context {Job: eqType}.
      Variable job_arrival: Job -> time.
      Variable job_deadline: Job -> time.

      Variable arr_seq: arrival_sequence Job.

      (* We define earliest deadline first (EDF) as ordering jobs by absolute deadlines. *)
      Definition EDF (j1 j2: Job) :=
        job_arrival j1 + job_deadline j1 <= job_arrival j2 + job_deadline j2.

      Section Properties.

        (* EDF is reflexive. *)
        Lemma EDF_is_reflexive : JLFP_is_reflexive EDF.
        Proof.
            by intros j; apply leqnn.
        Qed.

        (* EDF is transitive. *)
        Lemma EDF_is_transitive : JLFP_is_transitive EDF.
        Proof.
            by intros y x z; apply leq_trans.
        Qed.

        (* EDF is total. *)
        Lemma EDF_is_total : JLFP_is_total arr_seq EDF.
        Proof.
          unfold EDF; intros x y ARRx ARRy.
          case (leqP (job_arrival x + job_deadline x)
                     (job_arrival y + job_deadline y));
            [by rewrite orTb | by move/ltnW => ->].
        Qed.

      End Properties.

    End EDF.

    (* EDF in the presence of tasks. *)
    Section EDFwithTasks.

      Context {Task: eqType}.
      Variable task_deadline: Task -> time.

      Context {Job: eqType}.
      Variable job_arrival: Job -> time.
      Variable job_task: Job -> Task.

      (* Notice that in the presence of tasks the relative dealine
         of a job is equal to the relative deadline of its task. *)
      Definition job_relative_dealine (j: Job) := task_deadline (job_task j).

      (* EDF respects sequential jobs.*)
      Lemma EDF_respects_sequential_jobs:
        JLFP_respects_sequential_jobs
          job_task job_arrival (EDF job_arrival job_relative_dealine).
      Proof.
        intros j1 j2 TSK ARR.
        move: TSK => /eqP TSK.
        unfold EDF, job_relative_dealine; rewrite TSK.
          by rewrite leq_add2r.
      Qed.

    End EDFwithTasks.

  End KnownJLFPPolicies.

  (* In this section, we define the notion of a possible interfering task. *)
  Section PossibleInterferingTasks.

    Context {sporadic_task: eqType}.
    Variable task_cost: sporadic_task -> time.
    Variable task_period: sporadic_task -> time.
    Variable task_deadline: sporadic_task -> time.

    Section FP.

      (* Assume an FP policy. *)
      Variable higher_eq_priority: FP_policy sporadic_task.

      (* Let tsk be the task to be analyzed ... *)
      Variable tsk: sporadic_task.

      (* ...and let tsk_other be another task. *)
      Variable tsk_other: sporadic_task.

      (* Under FP scheduling with constrained deadlines, tsk_other can only interfere
         with tsk if it is a different task with higher priority. *)
      Definition higher_priority_task :=
        higher_eq_priority tsk_other tsk &&
        (tsk_other != tsk).

    End FP.

    Section JLFP.

      (* Let tsk be the task to be analyzed ... *)
      Variable tsk: sporadic_task.

      (* ...and let tsk_other be another task. *)
      Variable tsk_other: sporadic_task.

      (* Under JLFP/JLDP scheduling with constrained deadlines, tsk_other can only interfere
         with tsk if it is a different task. *)
      Definition different_task := tsk_other != tsk.

    End JLFP.

  End PossibleInterferingTasks.

End Priority.