(***************************************************************************)
(*   This is part of FA_Landau, it is distributed under the terms of the   *)
(*             GNU Lesser General Public License version 3                 *)
(*                (see file LICENSE for more details)                      *)
(*                                                                         *)
(*           Copyright 2020-2022: Yaoshun Fu and Wensheng Yu.              *)
(***************************************************************************)

(* REALS *)

(* SECTION I Definition *)

Require Export cuts.

Inductive Real : Type :=
  | O : Real
  | P : Cut -> Real
  | N : Cut -> Real.

Definition Equal_R Ξ Γ :=
  match Ξ, Γ with
   | P ξ, P η => ξ ≈ η
   | N ξ, N η => ξ ≈ η
   | O, O => True
   | _, _ => False
  end.

Definition No_Equal_R Ξ Γ := ~ Equal_R Ξ Γ.

Corollary eq3 : ∀ Ξ Γ, Equal_R Ξ Γ <-> Ξ = Γ.
Proof.
  split; intros.
  - destruct Ξ, Γ; auto; try elim H; simpl in H;
    try rewrite (eq2 H); auto.
  - rewrite H; destruct Γ; simpl; auto; apply Theorem116.
Qed.

Corollary No_Equal_Real : ∀ Ξ Γ, No_Equal_R Ξ Γ <-> Ξ <> Γ.
Proof.
  split; intros; intro; apply eq3 in H0; auto.
Qed.

Theorem Theorem163 :∀ (Ξ :Real), Ξ = Ξ.
Proof.
  auto.
Qed.

Theorem Theorem164 : ∀ (Ξ Γ :Real), Ξ = Γ -> Γ = Ξ.
Proof.
  auto.
Qed.

Theorem Theorem165 : ∀ (Ξ Γ Θ :Real), Ξ = Γ -> Γ = Θ -> Ξ = Θ.
Proof.
  intros. rewrite <- H0; auto.
Qed.

(* SECTION II Ordering *)

Definition Abs_R Ξ :=
  match Ξ with
   | N ξ => P ξ
   | Ξ => Ξ
  end.

Notation " | Ξ | " := (Abs_R Ξ)(at level 10).

Theorem Theorem166 : ∀ Ξ, Ξ <> O -> ∃ ξ, |Ξ| = (P ξ).
Proof.
  intros; destruct Ξ; simpl; eauto; elim H; auto.
Qed.

Definition ILT_R Ξ Γ :=
  match Ξ, Γ with
   | P ξ, P η => ξ < η
   | P _, _ => False
   | O, P _ => True
   | O, _ => False
   | N ξ, N η => ξ > η
   | N _, _ => True
  end.
Notation " Ξ < Γ " := (ILT_R Ξ Γ).

Definition IGT_R Ξ Γ := ILT_R Γ Ξ.
Notation " Ξ > Γ " := (IGT_R Ξ Γ).

Theorem Theorem167 : ∀ Ξ Γ, Ξ = Γ \/ Ξ < Γ \/ Ξ > Γ.
Proof.
  intros; destruct Ξ, Γ; simpl; try tauto; destruct
    (Theorem123 c c0) as [H | [H | H]]; try rewrite (eq2 H); auto.
Qed.

Lemma OrdR1 : ∀ {Ξ Γ}, Ξ = Γ -> Ξ > Γ -> False.
Proof.
  intros; destruct Ξ, Γ; simpl in *; auto; try discriminate.
  - apply eq3 in H; simpl in H; EGC H H0.
  - apply eq3 in H; simpl in H; ELC H H0.
Qed.

Lemma OrdR2 : ∀ {Ξ Γ}, Ξ = Γ -> Ξ < Γ -> False.
Proof.
  intros; destruct Ξ, Γ; simpl in *; auto; try discriminate.
  - apply eq3 in H; simpl in H; ELC H H0.
  - apply eq3 in H; simpl in H; EGC H H0.
Qed.

Lemma OrdR3 : ∀ {Ξ Γ}, Ξ < Γ -> Ξ > Γ -> False.
Proof.
  intros; destruct Ξ, Γ; simpl in *; auto; try tauto; LGC H0 H.
Qed.

Ltac EGR H H1 := destruct (OrdR1 H H1).
Ltac ELR H H1 := destruct (OrdR2 H H1).
Ltac LGR H H1 := destruct (OrdR3 H H1).

Definition IGE_R Ξ Γ := Ξ > Γ \/ Ξ = Γ.
Notation " Ξ ≧ Γ " := (IGE_R Ξ Γ).

Definition ILE_R Ξ Γ := Ξ < Γ \/ Ξ = Γ.
Notation " Ξ ≦ Γ " := (ILE_R Ξ Γ).

Lemma OrdR4 : ∀ {Ξ Γ}, Ξ ≦ Γ -> Ξ > Γ -> False.
Proof.
  intros; destruct H; try LGR H H0; EGR H H0.
Qed.

Ltac LEGR H H1 := destruct (OrdR4 H H1).

Lemma OrdR5 : ∀ {Ξ Γ}, Ξ ≦ Γ -> Γ ≦ Ξ -> Ξ = Γ.
Proof.
  intros; destruct H; auto; LEGR H0 H.
Qed.

Ltac LEGER H H1 := pose proof (OrdR5 H H1).

Theorem Theorem168 : ∀ Ξ Γ, Ξ ≧ Γ -> Γ ≦ Ξ.
Proof.
  intros; red in H; red; destruct H; auto.
Qed.

Theorem Theorem168' : ∀ Ξ Γ, Ξ ≦ Γ -> Γ ≧ Ξ.
Proof.
  intros; red in H; red; destruct H; auto.
Qed.

Theorem Theorem169 : ∀ ξ, (P ξ) > O.
Proof.
  intros; simpl; auto.
Qed.

Theorem Theorem169' : ∀ ξ, (N ξ) < O.
Proof.
  intros; simpl; auto.
Qed.

Theorem Theorem170 : ∀ Ξ, | Ξ | ≧ O.
Proof.
  intros; red; destruct Ξ; simpl; tauto.
Qed.

Theorem Theorem170' : ∀ z, O ≦ |z|.
Proof.
  intros. apply Theorem168, Theorem170.
Qed.

Theorem Theorem171 : ∀ Ξ Γ Θ, Ξ < Γ -> Γ < Θ -> Ξ < Θ.
Proof.
  intros; destruct Ξ, Γ, Θ; elim H; elim H0; intros; auto;
  red in H; red in H0; red; eapply Theorem126; eauto.
Qed.

Theorem Theorem172 : ∀ Ξ Γ Θ,
  (Ξ ≦ Γ /\ Γ < Θ) \/ (Ξ < Γ /\ Γ ≦ Θ) -> Ξ < Θ.
Proof.
  intros; destruct H as [[[H | H] H0] | [H [H0 | H0]]].
  - eapply Theorem171; eauto.
  - rewrite H; auto.
  - eapply Theorem171; eauto.
  - rewrite <- H0; auto.
Qed.

Theorem Theorem173 : ∀ Ξ Γ Θ, Ξ ≦ Γ -> Γ ≦ Θ -> Ξ ≦ Θ.
Proof.
  intros; unfold ILE_R in *; destruct H.
  - left; eapply Theorem172; eauto.
  - rewrite <- H in H0; auto.
Qed.

Definition Is_rational Ξ :=
  match Ξ with
   | P ξ => ∃ X :Rat, ξ ≈ X*
   | O => True
   | N ξ => ∃ X :Rat, ξ ≈ X*
  end.

Definition Is_irrational Ξ := ~ (Is_rational Ξ).

Definition Is_integer Ξ :=
  match Ξ with
   | P ξ => ∃ x :Nat, ξ ≈ x*
   | O => True
   | N ξ => ∃ x :Nat, ξ ≈ x*
  end.

Theorem Theorem174 : ∀ x, Is_integer x -> Is_rational x.
Proof.
  intros; destruct x; repeat red in H;
  destruct H; repeat red; eauto.
Qed.

(* SECTION III Addition *)

Lemma Ccase : ∀ ξ η, {IGT_C η ξ} + {IGT_C ξ η} + {ξ ≈ η}.
Proof.
  intros; destruct (classicT (ξ ≈ η)),(classicT (IGT_C ξ η)); auto.
  left; left; destruct (Theorem123 ξ η) as [H | [H | H]]; tauto.
Qed.

Definition Plus_R Ξ Γ : Real :=
  match Ξ, Γ with
   | P ξ, P η => P (ξ + η)
   | N ξ, N η => N (ξ + η)
   | O, _ => Γ
   | _, O => Ξ
   | P ξ, N η => match Ccase ξ η with
                  | inright _ => O
                  | inleft (left l) => N ((η - ξ) l)
                  | inleft (right l) => P ((ξ - η) l)
                 end
   | N ξ, P η => match Ccase ξ η with
                  | inright _ => O
                  | inleft (left l) => P ((η - ξ) l)
                  | inleft (right l) => N ((ξ - η) l)
                 end
  end.
Notation " Ξ + Γ " := (Plus_R Ξ Γ).

Theorem Theorem175 : ∀ Ξ Γ, Ξ + Γ = Γ + Ξ.
Proof.
  intros; destruct Ξ, Γ; simpl; try rewrite (eq2 Theorem130); auto.
  - destruct (Ccase c c0) as [[A|A]|A], (Ccase c0 c) as [[B|B]|B]; auto;
    [LGC A B|rewrite (proof_irr A B); auto|EGC B A|
     rewrite (proof_irr A B); auto|LGC A B|ELC B A|EGC A B|ELC A B].
  - destruct (Ccase c c0) as [[A|A]|A], (Ccase c0 c) as [[B|B]|B]; auto;
    [LGC A B|rewrite (proof_irr A B); auto|EGC B A|
     rewrite (proof_irr A B); auto|LGC A B|ELC B A|EGC A B|ELC A B].
Qed.

Theorem Theorem175' : ∀ Ξ, Ξ + O = Ξ.
Proof.
  intros; rewrite Theorem175; simpl; auto.
Qed.

Theorem Theorem175'' : ∀ Ξ, O + Ξ = Ξ.
Proof.
  intros; simpl; auto.
Qed.

Hint Rewrite Theorem175' Theorem175'' : Real.
Ltac Simpl_R := autorewrite with Real; auto.
Ltac Simpl_Rin H := autorewrite with Real in H; auto.

Definition minus_R Ξ :=
  match Ξ with
   | O => O
   | P ξ => N ξ
   | N ξ => P ξ
  end.
Notation " - Ξ " := (minus_R Ξ).

Theorem Theorem176_1 : ∀ Ξ, Ξ > O -> -Ξ < O.
Proof.
  intros; destruct Ξ; simpl; elim H; auto.
Qed.

Theorem Theorem176_2 : ∀ Ξ, Ξ = O -> -Ξ = O.
Proof.
  intros; rewrite H; simpl; auto.
Qed.

Theorem Theorem176_3 : ∀ Ξ, Ξ < O -> -Ξ > O.
Proof.
  intros; destruct Ξ; simpl; elim H; auto.
Qed.

Theorem Theorem176_1' : ∀ Ξ, -Ξ < O -> Ξ > O.
Proof.
  intros; destruct Ξ; simpl; elim H; auto.
Qed.

Theorem Theorem176_2' : ∀ Ξ, -Ξ = O -> Ξ = O.
Proof.
  intros; destruct Ξ; simpl; auto; inversion H.
Qed.

Theorem Theorem176_3' : ∀ Ξ, -Ξ > O -> Ξ < O.
Proof.
  intros; destruct Ξ; simpl; elim H; auto.
Qed.

Theorem Theorem177 : ∀ Ξ, -(-Ξ) = Ξ.
Proof.
  intros; destruct Ξ; simpl; auto.
Qed.

Theorem Theorem178 : ∀ Ξ, |(-Ξ)| = |Ξ|.
Proof.
  intros; destruct Ξ; simpl; auto.
Qed.

Theorem Theorem179 : ∀ Ξ, (Ξ + (-Ξ)) = O.
Proof.
  intros; destruct Ξ; simpl; auto.
  - destruct (Ccase c c) as [[A|A]|A]; try apply Theorem163;
    [EGC (Theorem116 c) A|EGC (Theorem116 c) A].
  - destruct (Ccase c c) as [[A|A]|A]; try apply Theorem163;
    [EGC (Theorem116 c) A|EGC (Theorem116 c) A].
Qed.

Theorem Theorem179' : ∀ Ξ, ((-Ξ) + Ξ) = O.
Proof.
  intros; rewrite Theorem175; apply Theorem179.
Qed.

Hint Rewrite Theorem177 Theorem179 Theorem179' : Real.

Theorem Theorem180 : ∀ Ξ Γ, -(Ξ + Γ) = (-Ξ) + (-Γ).
Proof.
  intros; destruct Ξ, Γ; simpl; auto;
  destruct (Ccase c c0) as [[A|A]|A], (Ccase c0 c) as [[B|B]|B];
  try apply Theorem163.
Qed.

Definition Minus_R Ξ Γ := Ξ + (-Γ).
Notation " Ξ - Γ " := (Minus_R Ξ Γ).

Corollary RMia : ∀ Ξ, (Ξ - Ξ) = O.
Proof.
  intros; apply Theorem179.
Qed.

Corollary RMib : ∀ Ξ, (Ξ - O) = Ξ.
Proof.
  intros; unfold Minus_R; Simpl_R.
Qed.

Corollary RMic : ∀ Ξ Γ , Ξ + (-Γ) = Ξ - Γ.
Proof.
  intros; unfold Minus_R; auto.
Qed.

Corollary RMid : ∀ Ξ Γ, Ξ - (-Γ) = Ξ + Γ.
Proof.
  intros. unfold Minus_R. now rewrite Theorem177.
Qed.

Hint Rewrite RMia RMib RMic RMid : Real.

Theorem Theorem181 : ∀ Ξ Γ, -(Ξ - Γ) = Γ - Ξ.
Proof.
 intros. unfold Minus_R; rewrite Theorem180, Theorem177.
 apply Theorem175.
Qed.

Theorem Theorem182_1 : ∀ Ξ Γ, (Ξ - Γ) > O -> Ξ > Γ.
Proof.
  intros; destruct Ξ, Γ; simpl; auto; simpl in H;
  destruct (Ccase c c0) as [[A|A]|A], H; auto.
Qed.

Theorem Theorem182_2 : ∀ Ξ Γ, Ξ - Γ = O -> Ξ = Γ.
Proof.
  intros; destruct Ξ, Γ; simpl in *; auto; inversion H;
  destruct (Ccase c c0) as [[A|A]|A];
  inversion H; rewrite (eq2 A); auto.
Qed.

Theorem Theorem182_3 : ∀ Ξ Γ, (Ξ - Γ) < O -> Ξ < Γ.
Proof.
  intros; apply Theorem182_1; apply Theorem176_3 in H.
  rewrite Theorem181 in H; auto.
Qed.

Theorem Theorem182_1' : ∀ Ξ Γ, Ξ > Γ -> (Ξ - Γ) > O.
Proof.
  intros; destruct Ξ, Γ; simpl; auto.
  - destruct (Ccase c c0) as [[A|A]|A]; auto; simpl in *.
    + LGC H A. + EGC A H.
  - destruct (Ccase c c0) as [[A|A]|A]; auto; simpl in *.
    + LGC H A. + ELC A H.
Qed.

Theorem Theorem182_2' : ∀ Ξ Γ, Ξ = Γ -> (Ξ - Γ) = O.
Proof.
  intros; subst Ξ; destruct Γ; simpl; auto;
  destruct (Ccase c c) as [[A|A]|A]; auto; EGC (Theorem116 c) A.
Qed.

Theorem Theorem182_3' : ∀ Ξ Γ, Ξ < Γ -> (Ξ - Γ) < O.
Proof.
  intros; apply Theorem182_1' in H; apply Theorem176_1 in H.
  unfold Minus_R in H; now rewrite
    Theorem180, Theorem177, Theorem175 in H.
Qed.

Theorem Theorem183_1 : ∀ Ξ Γ, Ξ > Γ -> -Γ > -Ξ.
Proof.
  intros; destruct Ξ, Γ; simpl; auto.
Qed.

Theorem Theorem183_2 : ∀ Ξ Γ, Ξ = Γ -> -Ξ = -Γ.
Proof.
  intros; rewrite H; auto.
Qed.

Theorem Theorem183_3 : ∀ Ξ Γ, Ξ < Γ -> -Γ < -Ξ.
Proof.
  intros; apply Theorem183_1; auto.
Qed.

Theorem Theorem183_1' : ∀ Ξ Γ, -Γ > -Ξ -> Ξ > Γ.
Proof.
  intros; destruct Ξ, Γ; simpl; auto.
Qed.

Theorem Theorem183_2' : ∀ Ξ Γ,  -Ξ = -Γ -> Ξ = Γ.
Proof.
  intros; rewrite <- Theorem177, <- (Theorem177 Ξ), H; auto.
Qed.

Theorem Theorem183_3' : ∀ Ξ Γ, -Γ < -Ξ -> Ξ < Γ.
Proof.
  intros; apply Theorem183_1'; auto.
Qed.

Theorem Theorem184 : ∀ Ξ, ∃ ξ η, Ξ = (P ξ) - (P η).
Proof.
  intros; destruct Ξ.
  - exists 1, 1; unfold Minus_R; rewrite Theorem179; auto.
  - exists (Plus_C c 1), 1; simpl.
    pose proof (Theorem133 1 c); rewrite (eq2 Theorem130) in H.
    destruct (Ccase (Plus_C c 1) 1) as [[A|A]|A]; Simpl_C; [LGC A H|EGC A H].
  - exists 1,(Plus_C c 1); simpl.
    pose proof (Theorem133 1 c); rewrite (eq2 Theorem130) in H.
    destruct (Ccase 1 (Plus_C c 1)) as [[A|A]|A]; Simpl_C; [LGC A H|ELC A H].
Qed.

Lemma Theorem185Pa : ∀ {Ξ Γ ξ}, (P ξ) = Ξ - Γ -> Ξ > Γ.
Proof.
  intros; apply Theorem182_1; rewrite <- H; simpl; auto.
Qed.

Lemma Theorem185Pb : ∀ {Ξ Γ ξ}, (N ξ) = Ξ - Γ -> Ξ < Γ.
Proof.
  intros; apply Theorem183_2 in H; simpl in H.
  rewrite Theorem181 in H; apply Theorem185Pa in H; auto.
Qed.

Theorem Theorem185P1 : ∀ {ξ η ζ1 ζ2 υ1 υ2},
  (P ξ) = (P ζ1) - (P ζ2) -> (P η) = (P υ1) - (P υ2)
  -> (P ξ) + (P η) = ((P ζ1) + (P υ1)) - ((P ζ2) + (P υ2)).
Proof.
  intros; generalize H, H0; intros.
  apply Theorem185Pa in H; apply Theorem185Pa in H0.
  simpl in H; simpl in H0; rewrite H1, H2.
  pose proof (Theorem137 H H0). unfold Minus_R.
  simpl minus_R; simpl Plus_R at 5; simpl Plus_R at 2.
  destruct (Ccase ζ1 ζ2) as [[A|A]|A]; [LGC H A| |EGC A H].
  simpl Plus_R at 2. destruct (Ccase υ1 υ2) as [[B|B]|B];
  [LGC H0 B| |EGC B H0]. simpl Plus_R at 2.
  destruct (Ccase (Plus_C ζ1 υ1) (Plus_C ζ2 υ2))
    as [[C|C]|C]; [LGC H3 C| |EGC C H3]. simpl; apply eq3; simpl.
  apply Theorem136_2 with (ζ:=(Plus_C ζ2 υ2)); Simpl_C.
  rewrite (eq2 (@Theorem130 ζ2 υ2)), (eq2 Theorem131).
  rewrite <- (eq2 (@Theorem131 _ υ2 ζ2)); Simpl_C.
  rewrite (eq2 (@Theorem130 υ1 ζ2)), <- (eq2 Theorem131).
  Simpl_C; apply Theorem116.
Qed.

Theorem Theorem185P2 : ∀ {Ξ ζ1 ζ2 υ1 υ2},
  O = (P ζ1) - (P ζ2) -> Ξ = (P υ1) - (P υ2)
  -> O + Ξ = ((P ζ1) + (P υ1)) - ((P ζ2) + (P υ2)).
Proof.
  intros; apply Theorem164 in H; apply Theorem182_2 in H.
  destruct Ξ; simpl Plus_R at 1.
  - apply Theorem164 in H0; apply Theorem182_2 in H0.
    rewrite H, H0; apply Theorem164; apply Theorem182_2'; auto.
  - rewrite H; apply Theorem165 with (Γ:=((P υ1) - (P υ2))); auto.
    apply Theorem185Pa in H0; repeat simpl in H.
    assert (IGT_C (Plus_C ζ2 υ1) (Plus_C ζ2 υ2)).
    { rewrite (eq2 Theorem130), (eq2 (@Theorem130 ζ2 υ2)).
      apply Theorem135_1; auto. }
    unfold Minus_R; simpl minus_R; simpl Plus_R at 3.
    simpl Plus_R at 1. destruct (Ccase υ1 υ2) as [[A|A]|A];
    [LGC H0 A| |EGC A H0]. simpl Plus_R at 1.
    destruct (Ccase (Plus_C ζ2 υ1) (Plus_C ζ2 υ2))
      as [[B|B]|B]; [LGC B H1| |EGC B H1]. apply eq3; simpl.
    apply Theorem136_2 with (ζ:=(Plus_C ζ2 υ2)); Simpl_C.
    rewrite (eq2 (@Theorem130 ζ2 υ2)), <- (eq2 Theorem131).
    Simpl_C. rewrite (eq2 Theorem130); apply Theorem116.
  - rewrite H; apply Theorem165 with (Γ:=((P υ1) - (P υ2))); auto.
    apply Theorem185Pb in H0; simpl in H0; simpl in H0.
    assert (IGT_C (Plus_C ζ2 υ2) (Plus_C ζ2 υ1)).
    { rewrite (eq2 Theorem130), (eq2 (@Theorem130 ζ2 υ1)).
      apply Theorem135_1; auto. }
    unfold Minus_R; simpl minus_R; simpl Plus_R at 3.
    simpl Plus_R at 1. destruct (Ccase υ1 υ2) as [[A|A]|A];
    [|LGC H0 A|ELC A H0]. simpl Plus_R.
    destruct (Ccase (Plus_C ζ2 υ1) (Plus_C ζ2 υ2))
      as [[B|B]|B]; [|LGC H1 B|ELC B H1]. apply eq3.
    apply Theorem136_2 with (ζ:=(Plus_C ζ2 υ1)); Simpl_C.
    rewrite (eq2 (@Theorem130 ζ2 υ1)), <- (eq2 Theorem131).
    Simpl_C. rewrite (eq2 Theorem130); apply Theorem116.
Qed.

Theorem Theorem185P3 : ∀ {ξ η ζ1 ζ2 υ1 υ2},
  (P ξ) = (P ζ1) - (P ζ2) -> (N η) = (P υ1) - (P υ2) ->
  (P ξ) + (N η) = ((P ζ1) + (P υ1)) - ((P ζ2) + (P υ2)).
Proof.
  assert (∀ {ζ1 ζ2 υ1 υ2} l1 l2,
    (Minus_C ζ1 ζ2 l1) ≈ (Minus_C υ2 υ1 l2) <->
    (Plus_C ζ1 υ1) ≈ (Plus_C ζ2 υ2)) as G1.
  { split; intros.
    - apply (Theorem135_2 _ _ υ1) in H; Simpl_Cin H. rewrite
        (eq2 Theorem130) in H; apply (Theorem135_2 _ _ ζ2) in H.
      rewrite (eq2 Theorem131) in H; Simpl_Cin H.
      rewrite (eq2 Theorem130), (eq2 (@Theorem130 ζ2 υ2)); auto.
    - apply (Theorem136_2 _ _ υ1); Simpl_C.
      rewrite (eq2 Theorem130). apply (Theorem136_2 _ _ ζ2).
      rewrite (eq2 Theorem131); Simpl_C.
      rewrite (eq2 Theorem130), (eq2 (@Theorem130 υ2 ζ2)); auto. }
  assert (∀ {ζ1 ζ2 υ1 υ2} l1 l2,
    IGT_C (Minus_C ζ1 ζ2 l1) (Minus_C υ2 υ1 l2) ->
    IGT_C (Plus_C ζ1 υ1) (Plus_C ζ2 υ2)) as G2.
  { intros; apply (Theorem135_1 _ _ υ1) in H; Simpl_Cin H. rewrite
      (eq2 Theorem130) in H; apply (Theorem135_1 _ _ ζ2) in H.
    rewrite (eq2 Theorem131) in H; Simpl_Cin H.
    rewrite (eq2 Theorem130), (eq2 (@Theorem130 ζ2 υ2)); auto. }
  intros; generalize H, H0; intros.
  apply Theorem185Pa in H; apply Theorem185Pb in H0.
  simpl in H0, H; rewrite H1, H2. pose proof (Theorem137 H H0).
  unfold Minus_R; simpl minus_R; simpl Plus_R at 5.
  simpl Plus_R at 2. destruct (Ccase ζ1 ζ2) as [[A|A]|A];
  [LGC H A| |EGC A H]. apply eq3; simpl Plus_R at 2.
  destruct (Ccase υ1 υ2) as [[B|B]|B]; [|LGC H0 B|ELC B H0].
  simpl; destruct (Ccase(Plus_C ζ1 υ1)(Plus_C ζ2 υ2)) as [[C|C]|C],
    (Ccase (Minus_C ζ1 ζ2 A) (Minus_C υ2 υ1 B)) as [[D|D]|D];
  simpl; auto.
  - apply G1; rewrite (eq2 (@Theorem130 ζ1 υ1)).
    rewrite <- (eq2 Theorem131); Simpl_C.
    rewrite <- (eq2 Theorem131); Simpl_C.
    rewrite (eq2 Theorem130); apply Theorem116.
  - apply G2 in D; LGC D C.
  - apply G1 in D; ELC D C.
  - apply G2 in D; rewrite (eq2 Theorem130) in D.
    rewrite (eq2 (@Theorem130 υ1 ζ1)) in D; LGC C D.
  - apply G1; rewrite <- (eq2 Theorem131); Simpl_C.
    rewrite (eq2 (@Theorem130 ζ1 υ1)),<- (eq2 Theorem131); Simpl_C.
    rewrite (eq2 Theorem130); apply Theorem116.
  - apply G1 in D; EGC D C.
  - apply G2 in D; rewrite (eq2 Theorem130) in D.
    rewrite (eq2 (@Theorem130 υ1 ζ1)) in D; ELC C D.
  - apply G2 in D; EGC C D.
Qed.

Theorem Theorem185 : ∀ {Ξ Γ ζ1 ζ2 υ1 υ2},
  Ξ = (P ζ1) - (P ζ2) -> Γ = (P υ1) - (P υ2)
  -> Ξ + Γ = ((P ζ1) + (P υ1)) - ((P ζ2) + (P υ2)).
Proof.
  intros; destruct Ξ.
  - apply Theorem185P2; auto.
  - destruct Γ.
    + rewrite (Theorem175 _ (P υ1)), (Theorem175 _ (P υ2)).
      apply Theorem185P2; auto.
    + apply Theorem185P1; auto. + apply Theorem185P3; auto.
  - destruct Γ.
    + rewrite (Theorem175 _ (P υ1)), (Theorem175 _ (P υ2)).
      apply Theorem185P2; auto.
    + rewrite Theorem175, (Theorem175 _ (P υ1)),
        (Theorem175 _ (P υ2)). apply Theorem185P3; auto.
    + apply Theorem183_2 in H; apply Theorem183_2 in H0.
      apply Theorem183_2'; rewrite Theorem181 in H0.
      rewrite Theorem181 in H; rewrite Theorem181, Theorem180.
      simpl minus_R in *; apply Theorem185P1; auto.
Qed.

Theorem Theorem186 : ∀ Ξ Γ Θ, (Ξ + Γ) + Θ = Ξ + (Γ + Θ).
Proof.
  intros; generalize (Theorem184 Ξ),(Theorem184 Γ),(Theorem184 Θ).
  intros. destruct H as [ζ1 [ζ2 H]],
    H0 as [υ1 [υ2 H0]], H1 as [c1 [c2 H1]].
  generalize (Theorem185 H H0), (Theorem185 H0 H1); intros.
  generalize (Theorem185 H2 H1), (Theorem185 H H3); intros.
  simpl Plus_R in H4; simpl Plus_R in H5.
  repeat rewrite (eq2 Theorem131) in H4.
  apply Theorem164 in H5; eapply Theorem165; eauto.
Qed.

Corollary RMi1 : ∀ Ξ Γ, (Ξ - Γ) + Γ = Ξ.
Proof.
  intros; unfold Minus_R; rewrite Theorem186; Simpl_R.
Qed.

Corollary RMi1' : ∀ Ξ Γ, Γ + (Ξ - Γ) = Ξ.
Proof.
  intros; rewrite Theorem175; apply RMi1.
Qed.

Corollary RMi2 : ∀ Ξ Γ, (Ξ + Γ) - Γ = Ξ.
Proof.
  intros; unfold Minus_R; rewrite Theorem186; Simpl_R.
Qed.

Corollary RMi2' : ∀ Ξ Γ, (Γ + Ξ) - Γ = Ξ.
Proof.
  intros; rewrite Theorem175; apply RMi2.
Qed.

Corollary RMi3 : ∀ Ξ Γ, Γ - (Γ - Ξ) = Ξ.
Proof.
  intros; unfold Minus_R; rewrite Theorem175, (Theorem175 Γ _).
  rewrite Theorem180; Simpl_R; rewrite RMi1; auto.
Qed.

Hint Rewrite RMi1 RMi1' RMi2 RMi2' RMi3 : Real.

Theorem Theorem187_1 : ∀ Ξ Γ, ∃ Θ, Γ + Θ = Ξ.
Proof.
  intros; exists (Ξ - Γ); rewrite Theorem175; Simpl_R.
Qed.

Theorem Theorem187_2 : ∀ Ξ Γ Θ, Γ + Θ = Ξ -> Ξ - Γ = Θ.
Proof.
  intros; unfold Minus_R.
  rewrite Theorem175, <- H, <- Theorem186; Simpl_R.
Qed.

Theorem Theorem188_1 : ∀ Ξ Γ Θ, Ξ + Θ > Γ + Θ -> Ξ > Γ.
Proof.
  intros; apply Theorem182_1' in H; apply Theorem182_1.
  unfold Minus_R in H; rewrite Theorem180 in H.
  rewrite (Theorem175 (-Γ) _), Theorem186 in H.
  rewrite <- (Theorem186 Θ _ _) in H; Simpl_Rin H.
Qed.

Theorem Theorem188_2 : ∀ Ξ Γ Θ, Ξ + Θ = Γ + Θ -> Ξ = Γ.
Proof.
  intros; apply Theorem182_2' in H; apply Theorem182_2.
  unfold Minus_R in H; rewrite Theorem180 in H.
  rewrite (Theorem175 (-Γ) _), Theorem186 in H.
  rewrite <- (Theorem186 Θ _ _) in H; Simpl_Rin H.
Qed.

Theorem Theorem188_3 : ∀ Ξ Γ Θ, Ξ + Θ < Γ + Θ -> Ξ < Γ.
Proof.
  intros; eapply Theorem188_1; eauto.
Qed.

Theorem Theorem188_1' : ∀ Ξ Γ Θ, Ξ > Γ -> Ξ + Θ > Γ + Θ.
Proof.
  intros; apply Theorem182_1' in H; apply Theorem182_1.
  unfold Minus_R; rewrite Theorem180.
  pattern ((-Γ) + (- Θ)); rewrite Theorem175, Theorem186.
  pattern (Θ + (- Θ + - Γ)); rewrite <- Theorem186; Simpl_R.
Qed.

Theorem Theorem188_2' : ∀ Ξ Γ Θ, Ξ = Γ -> Ξ + Θ = Γ + Θ.
Proof.
  intros; rewrite H; auto.
Qed.

Theorem Theorem188_3' : ∀ Ξ Γ Θ, Ξ < Γ -> Ξ + Θ < Γ + Θ.
Proof.
  intros; eapply Theorem188_1'; eauto.
Qed.

Corollary LePl_R : ∀ x y z, x ≦ y <-> x + z ≦ y + z.
Proof.
  split; intros; destruct H.
  - left; apply Theorem188_1'; auto. - right; rewrite H; auto.
  - left; eapply Theorem188_1; eauto.
  - right; eapply Theorem188_2; eauto.
Qed.

Theorem Theorem189 : ∀ {Ξ Γ Θ Φ}, Ξ > Γ -> Θ > Φ -> Ξ + Θ > Γ + Φ.
Proof.
  intros; apply Theorem171 with (Γ:=(Γ + Θ)).
  - rewrite Theorem175,(Theorem175 Γ Θ); apply Theorem188_3'; auto.
  - apply Theorem188_3'; auto.
Qed.

Theorem Theorem190 : ∀ Ξ Γ Θ Φ,
  (Ξ ≧ Γ /\ Θ > Φ) \/ (Ξ > Γ /\ Θ ≧ Φ) -> Ξ + Θ > Γ + Φ.
Proof.
  intros; destruct H as [[[H | H] H0] | [H [H0 | H0]]].
  - apply Theorem189; auto.
  - rewrite H, Theorem175,(Theorem175 Γ Φ).
    apply Theorem188_3'; auto.
  - apply Theorem189; auto.
  - rewrite H0; apply Theorem188_1'; auto.
Qed.

Theorem Theorem191 : ∀ {Ξ Γ Θ Φ},
  Ξ ≧ Γ -> Θ ≧ Φ -> (Ξ + Θ) ≧ (Γ + Φ).
Proof.
  intros; destruct H.
  - left; apply Theorem190; auto.
  - destruct H0.
    + left; apply Theorem190; left; split; red; tauto.
    + right; rewrite H, H0; apply Theorem163.
Qed.

Theorem Theorem191' : ∀ {Ξ Γ Θ Φ},
  Ξ ≦ Γ -> Θ ≦ Φ -> (Ξ + Θ) ≦ (Γ + Φ).
Proof.
  intros; apply Theorem168, Theorem191; apply Theorem168'; auto.
Qed.

(* SECTION IV Multiplication *)

Definition Times_R Ξ Γ : Real :=
  match Ξ, Γ with
   | P ξ , P η => P (ξ · η)
   | N ξ , N η => P (ξ · η)
   | P ξ, N η => N (ξ · η)
   | N ξ, P η => N (ξ · η)
   | _ , _ => O
  end.

Notation " Ξ · Γ " := (Times_R Ξ Γ).

Theorem Theorem192 : ∀ Ξ Γ, Ξ · Γ = O -> Ξ = O \/ Γ = O.
Proof.
  intros; destruct Ξ, Γ; try tauto; inversion H.
Qed.

Theorem Theorem193 : ∀ Ξ Γ, |Ξ · Γ| = |Ξ| · |Γ|.
Proof.
  intros; destruct Ξ, Γ; simpl; auto; try apply Theorem116.
Qed.

Theorem Theorem194 : ∀ Ξ Γ, Ξ · Γ = Γ · Ξ.
Proof.
  intros; destruct Ξ, Γ; simpl; try rewrite (eq2 Theorem142); auto.
Qed.

Corollary RTi_O : ∀ Ξ, Ξ · O = O.
Proof.
  intros; rewrite Theorem194; simpl; auto.
Qed.

Corollary RTiO_ : ∀ Ξ, O · Ξ = O.
Proof.
  intros; simpl; auto.
Qed.

Hint Rewrite RTi_O RTiO_ : Real.

Coercion Real_PZ x := P (Cut_I x).

Theorem Theorem195 : ∀ Ξ, Ξ · 1 = Ξ.
Proof.
  intros; destruct Ξ; simpl; auto; Simpl_C.
Qed.

Theorem Theorem195' : ∀ Ξ, Ξ · (- (1))  = - Ξ.
Proof.
  intros; destruct Ξ; simpl; auto; Simpl_C.
Qed.

Corollary RTi1_ : ∀ Ξ, 1 · Ξ = Ξ.
Proof.
  intros; destruct Ξ; simpl; auto; Simpl_C.
Qed.

Corollary RTin1_ : ∀ Ξ, -(1) · Ξ = -Ξ.
Proof.
  intros; destruct Ξ; simpl; auto; Simpl_C.
Qed.

Hint Rewrite Theorem195 Theorem195' RTi1_ RTin1_ : Real.

Theorem Theorem196 : ∀ Ξ Γ, Ξ <> O ->
  Ξ <> O -> Ξ · Γ = |Ξ| · |Γ| \/ Ξ · Γ = - (|Ξ| · |Γ|).
Proof.
  intros; destruct Ξ, Γ; simpl; tauto.
Qed.

Theorem Theorem197 : ∀ Ξ Γ, -Ξ · Γ = Ξ · -Γ.
Proof.
  intros; destruct Ξ, Γ; simpl; auto.
Qed.

Theorem Theorem197' : ∀ Ξ Γ, -Ξ · Γ = - (Ξ · Γ).
Proof.
  intros; destruct Ξ, Γ; simpl; auto.
Qed.

Theorem Theorem197'' : ∀ Ξ Γ, Ξ · -Γ = - (Ξ · Γ).
Proof.
  intros; destruct Ξ, Γ; simpl; auto.
Qed.

Theorem Theorem198 : ∀ Ξ Γ, -Ξ · -Γ = Ξ · Γ.
Proof.
  intros; destruct Ξ, Γ; simpl; auto.
Qed.

Theorem Theorem199 : ∀ Ξ Γ Θ, (Ξ · Γ) · Θ = Ξ · (Γ · Θ).
Proof.
  intros; destruct Ξ, Γ, Θ; simpl;
  try rewrite (eq2 Theorem143); auto.
Qed.

Theorem Theorem200 : ∀ ξ η ζ,
  (P ξ) · ((P η) - (P ζ)) = ((P ξ) · (P η)) - ((P ξ) · (P ζ)).
Proof.
  intros; destruct (Theorem167 (P η) (P ζ)) as [H | [H |H]].
  - rewrite H; unfold Minus_R; repeat rewrite Theorem179; Simpl_R.
  - simpl in H; assert (ILT_C (Times_C ξ η) (Times_C ξ ζ)).
    { rewrite (eq2 Theorem142), (eq2 (@Theorem142 ξ ζ)).
      apply Theorem145_3; auto. } unfold Minus_R; simpl;
    destruct (Ccase η ζ) as [[A|A]|A]; [|LGC H A|ELC A H].
    destruct (Ccase (Times_C ξ η) (Times_C ξ ζ))
      as [[B|B]|B]; [|LGC H0 B|ELC B H0].
    apply eq3; simpl; apply Theorem136_2 with (ζ:=(Times_C ξ η)).
    Simpl_C. rewrite <- (eq2 Theorem144).
    Simpl_C; apply Theorem116.
  - simpl in H; assert (ILT_C (Times_C ξ ζ) (Times_C ξ η)).
    { rewrite (eq2 Theorem142), (eq2 (@Theorem142 ξ η)).
      apply Theorem145_3; auto. } unfold Minus_R; simpl;
    destruct (Ccase η ζ) as [[A|A]|A]; [LGC H A| |EGC A H].
    destruct (Ccase (Times_C ξ η) (Times_C ξ ζ))
      as [[B|B]|B]; [LGC H0 B| |EGC B H0]. apply eq3; simpl.
    apply Theorem136_2 with (ζ:=(Times_C ξ ζ)); Simpl_C.
    rewrite <- (eq2 Theorem144); Simpl_C; apply Theorem116.
Qed.

Theorem Theorem201 : ∀ Ξ Γ Θ, Ξ · (Γ + Θ) = Ξ · Γ + Ξ · Θ.
Proof.
  assert (∀ Γ Θ ξ, (P ξ)·(Γ+Θ) = ((P ξ)·Γ)+((P ξ)·Θ)) as G; intros.
  { destruct (Theorem184 Θ) as [η1 [η2 H]],
      (Theorem184 Γ) as [ζ1 [ζ2 H0]]. rewrite (Theorem185 H0 H).
    simpl Plus_R at 1; simpl Plus_R at 1; rewrite Theorem200.
    simpl Times_R at 1; simpl Times_R at 1.
    repeat rewrite Lemma_T144_1; rewrite H, H0.
    repeat rewrite Theorem200; unfold Minus_R.
    rewrite <- Theorem186, (Theorem186 _ _ (P ξ · P η1)).
    rewrite (Theorem175 _ (P ξ · P η1));
    repeat rewrite <- Theorem186. simpl Times_R.
    simpl Plus_R at 4; simpl minus_R; rewrite Theorem186.
    simpl Plus_R at 3; repeat rewrite (eq2 Theorem144); auto. }
  intros; destruct Ξ; [simpl; auto|apply G|].
  apply Theorem183_2'; rewrite Theorem180.
  repeat rewrite <- Theorem197'', <- Theorem197.
  simpl minus_R; apply G.
Qed.

Theorem Theorem201' : ∀ Ξ Γ Θ, (Γ + Θ) · Ξ = Γ · Ξ +  Θ · Ξ.
Proof.
  intros; rewrite Theorem194, Theorem201,
    Theorem194, (Theorem194 Θ); auto.
Qed.

Theorem Theorem202 : ∀ Ξ Γ Θ, Ξ · (Γ - Θ) = (Ξ · Γ) - (Ξ · Θ).
Proof.
  intros; unfold Minus_R; rewrite Theorem201, Theorem197''.
  apply Theorem163.
Qed.

Theorem Theorem202' : ∀ Ξ Γ Θ, (Γ - Θ) · Ξ = (Γ · Ξ) - (Θ · Ξ).
Proof.
  intros; rewrite Theorem194, (Theorem194 Γ Ξ), (Theorem194 Θ Ξ).
  apply Theorem202.
Qed.

Theorem Theorem203_1 : ∀ Ξ Γ Θ, Ξ > Γ -> Θ > O -> Ξ · Θ > Γ · Θ.
Proof.
   intros; apply Theorem182_1' in H. assert ((Ξ - Γ) · Θ > O).
   { destruct (Ξ - Γ); destruct Θ, H, H0; simpl; auto. }
   rewrite Theorem194, Theorem202 in H1; apply Theorem182_1 in H1.
   rewrite Theorem194, (Theorem194 Γ Θ); auto.
Qed.

Theorem Theorem203_1' : ∀ Ξ Γ Θ, Ξ · Θ > Γ · Θ -> Θ > O -> Ξ > Γ.
Proof.
  intros; destruct Θ; inversion H0; destruct Ξ,Γ; simpl in H; auto;
  apply Theorem146_3 with (ζ:=c); auto.
Qed.

Theorem Theorem203_2 : ∀ Ξ Γ Θ, Ξ > Γ -> Θ = O -> Ξ · Θ = Γ · Θ.
Proof.
  intros; rewrite H0; Simpl_R.
Qed.

Theorem Theorem203_3 : ∀ Ξ Γ Θ, Ξ > Γ -> Θ < O -> Ξ · Θ < Γ · Θ.
Proof.
  intros; rewrite <- Theorem198, <- (Theorem198 Γ Θ).
  apply Theorem203_1; try (apply Theorem183_3; auto).
  destruct Θ; simpl; auto.
Qed.

Theorem Theorem204_1 : ∀ {Γ Θ1 Θ2}, Γ<>O -> Γ·Θ1 = Γ·Θ2 -> Θ1 = Θ2.
Proof.
  intros; apply Theorem182_2' in H0.
  rewrite <- Theorem202 in H0; apply Theorem192 in H0.
  destruct H0; try tauto; apply Theorem182_2 in H0; auto.
Qed.

Definition neq_zero Ξ :=
  match Ξ with
   | O => False
   | _ => True
  end.

Corollary uneqO : ∀ {x}, x <> O -> neq_zero x.
Proof.
  intros. destruct x; simpl; auto.
Qed.

Definition Over_R Ξ Γ : (neq_zero Γ) -> Real :=
  match Γ with
   | O => λ l, match l with end
   | P ξ => λ _, (P (1/ξ)) · Ξ
   | N ξ => λ _, (N (1/ξ)) · Ξ
  end.
Notation " X / Y " := (Over_R X Y).

Corollary Rdt : ∀ Ξ Γ l, Γ · ((Ξ/Γ) l) = Ξ.
Proof.
  intros; destruct Ξ, Γ; simpl; destruct l; auto;
  rewrite <- (eq2 Theorem143), (eq2 (@Theorem142 c0 _)); Simpl_C.
Qed.

Theorem Theorem204_2 : ∀ Ξ Γ, Γ <> O -> ∃ Θ, Γ · Θ = Ξ.
Proof.
  intros. exists ((Ξ/Γ) (uneqO H)). apply Rdt.
Qed.

Corollary ROv_uni : ∀ x y z l, y · z = x <-> z = (x / y) l.
Proof.
  split; intros.
  - apply (@Theorem204_1 y).
    + intro; destruct y; inversion H0; tauto.
    + rewrite H. symmetry. apply Rdt.
  - rewrite H. apply Rdt.
Qed.

Corollary Rdt' : ∀ Ξ Γ l, ((Ξ/Γ) l)·Γ = Ξ.
Proof.
  intros; destruct Ξ, Γ; simpl; destruct l; auto;
  rewrite (eq2 Theorem142), <- (eq2 Theorem143),
  (eq2 (@Theorem142 c0 (Over_C 1 c0))); Simpl_C.
Qed.

Corollary Rtd : ∀ Ξ Γ l, ((Ξ·Γ)/Γ) l = Ξ.
Proof.
  intros; destruct Ξ, Γ; simpl; auto; destruct l;
  rewrite (eq2 Theorem142), (eq2 Theorem143),
  (eq2 (@Theorem142 c0 (Over_C 1 c0))); Simpl_C.
Qed.

Hint Rewrite Rdt Rdt' Rtd : Real.

Corollary Rtd' : ∀ Ξ Γ l, ((Γ · Ξ) / Γ) l = Ξ.
Proof.
  intros; rewrite Theorem194; Simpl_R.
Qed.

Corollary Rd : ∀ Ξ l, (Ξ/Ξ) l = 1.
Proof.
  intros; destruct Ξ; simpl; destruct l; Simpl_C.
Qed.

Corollary RdO_ : ∀ x l, (O/x) l = O.
Proof.
  intros; destruct x; inversion l; auto.
Qed.

Lemma Rd1_ : ∀ a l, (a/1) l = a.
Proof.
  intros; symmetry; apply ROv_uni; Simpl_R.
Qed.

Hint Rewrite Rdt' Rtd' Rd RdO_ Rd1_ : Real.

Corollary Di_Rt : ∀ x y z l, x·(y/z) l = (x·y/z) l.
Proof.
  intros; destruct x, y, z; elim l; simpl; auto; now rewrite
    (eq2 Theorem142), (eq2 Theorem143), (eq2 (@Theorem142 _ c)).
Qed.

Corollary Di_Rp : ∀ x y z l, (x/z) l + (y/z) l = ((x+y)/z) l.
Proof.
  intros; rewrite <- (Theorem195 x), <- (Theorem195 y).
  repeat rewrite <- Di_Rt; rewrite <- Theorem201', Di_Rt; Simpl_R.
Qed.

Corollary Di_Rm : ∀ x y z l, (x/z) l - (y/z) l = ((x-y)/z) l.
Proof.
  intros; rewrite <- (Theorem195 x), <- (Theorem195 y).
  repeat rewrite <- Di_Rt; rewrite <- Theorem202', Di_Rt; Simpl_R.
Qed.


Require Import Metalib.Metatheory.
Require Import Coq.Program.Equality.
Require Import Strings.String.
Require Import Program.Tactics.
Require Import Lia.
Require Import Language Tactical.
Require Import Splitable.

Set Printing Parentheses.

(** * Definition *)

Inductive sub : type -> type -> Prop :=
| Sub_Int :
    sub Int Int
| Sub_Top : forall A,
    sub A Top
| Sub_Arr : forall A B C D,
    sub C A -> sub B D ->
    ordinary D ->
    sub (Arr A B) (Arr C D)
| Sub_Rcd : forall A B l,
    ordinary B ->
    sub A B ->
    sub (Rcd l A) (Rcd l B)
| Sub_And : forall A B B1 B2,
    splitable B B1 B2 ->
    sub A B1 -> sub A B2 ->
    sub A B
| Sub_And_L : forall A B C,
    sub A C -> ordinary C ->
    sub (And A B) C
| Sub_And_R : forall A B C,
    sub B C -> ordinary C ->
    sub (And A B) C.

Hint Constructors sub : core.

Notation "A <: B" := (sub A B) (at level 40).

(** * Generlization *)

(** generlization of [Sub_Arrow] *)

Lemma sub_arrow :
  forall A B C D,
    sub B D ->
    sub C A ->
    sub (Arr A B) (Arr C D).
Proof.
  introv H. dependent induction H; eauto.
Qed.

(** generlization of [Sub_Rcd] *)

Lemma sub_record :
  forall l A B,
    sub A B ->
    sub (Rcd l A) (Rcd l B).
Proof.
  introv H. dependent induction H; eauto.
Qed.

(** generlization of [Sub_And_L] *)

Lemma sub_and_l :
  forall A B C,
    sub A C -> sub (And A B) C.
Proof.
  introv H.
  dependent induction H; eauto.
Qed.

(** generlization of [Sub_And_R] *)

Lemma sub_and_r :
  forall A B C,
    sub B C -> sub (And A B) C.
Proof.
  introv H.
  dependent induction H; eauto.
Qed.

(** add it to local and global hint base **)

Hint Resolve sub_arrow : core.
Hint Resolve sub_record : core.
Hint Resolve sub_and_l : core.
Hint Resolve sub_and_r : core.

(** * Reflexivity *)

Lemma sub_reflexivity:
  forall A,
    sub A A.
Proof.
  dependent induction A; eauto.
Qed.

Hint Resolve sub_reflexivity : core.

(** * Subtyping & Splitable *)

Lemma sub_splitable_l :
  forall A A1 A2,
    splitable A A1 A2 -> sub A A1.
Proof.
  introv H. dependent induction H; eauto.
Qed.

Lemma sub_splitable_r :
  forall A A1 A2,
    splitable A A1 A2 -> sub A A2.
Proof.
  introv H. dependent induction H; eauto.
Qed.

Hint Resolve sub_splitable_l : subtyping.
Hint Resolve sub_splitable_r : subtyping.

Lemma sub_splitable:
  forall A A1 A2,
    splitable A A1 A2 -> sub A (And A1 A2) /\ sub (And A1 A2) A.
Proof.
  introv H. split.
  - eapply Sub_And; eauto with subtyping.
  - dependent induction H; eauto with subtyping.
Qed.

Hint Resolve sub_splitable : subtyping.

(** * Inversion Lemmas *)

Lemma sub_inv_splitable_l :
  forall A B A1 A2,
    sub A B -> splitable A A1 A2 -> ordinary B -> sub A1 B \/ sub A2 B.
Proof.
  introv Sub Spl Ord. gen A1 A2.
  induction Sub; eauto; intros.
  - dependent destruction Spl.
    dependent destruction Ord.
    pose proof (IHSub2 H _ _ Spl) as IH.
    destruct IH; eauto with subtyping.
  - dependent destruction Spl.
    dependent destruction Ord.
    pose proof (IHSub Ord _ _ Spl) as IH.
    destruct IH; eauto with subtyping.
  - dependent destruction Spl.
    left. assumption.
  - dependent destruction Spl.
    right. assumption.
Qed.

Lemma sub_inv_splitable_r :
  forall A B B1 B2,
    sub A B -> splitable B B1 B2 -> sub A B1 /\ sub A B2.
Proof.
  introv Sub Spl.
  dependent destruction Sub; eauto with subtyping.
  subst_splitable; intuition.
Qed.

(** * Proper Types *)

(** ** Definition *)

Inductive proper : type -> Prop :=
| Pr_Int : proper Int
| Pr_Top : proper Top
| Pr_Arr : forall A B,
    ordinary B ->
    proper A -> proper B ->
    proper (Arr A B)
| Pr_Rcd : forall l A,
    ordinary A ->
    proper A ->
    proper (Rcd l A)
| Pr_Spl : forall A A1 A2,
    splitable A A1 A2 ->
    proper A1 -> proper A2 ->
    proper A.

Hint Constructors proper : core.

(** ** Completeness *)

Lemma proper_arrow :
  forall A B,
    proper A -> proper B ->
    proper (Arr A B).
Proof.
  introv Pr_A Pr_B.
  gen A.
  induction Pr_B; eauto.
Qed.

Lemma proper_record :
  forall l A,
    proper A ->
    proper (Rcd l A).
Proof.
  introv Pr_A.
  induction Pr_A; eauto.
Qed.

Lemma proper_complete:
  forall (A : type), proper A.
Proof.
  induction A; eauto.
  eapply proper_arrow; eauto.
  eapply proper_record; eauto.
Qed.

(** We build a new induction principle for [type] *)

(** ** Proper Induction Principle *)

Ltac proper_ind A := assert (Pr: proper A)
    by apply (proper_complete A); induction Pr.

(** * Transitivity *)

Lemma sub_transitivity:
  forall A B C,
    sub A B -> sub B C -> sub A C.
Proof.
  introv Sub1 Sub2.
  gen A C.
  proper_ind B; intros.
  - dependent induction Sub2; eauto.
  - dependent induction Sub2; eauto.
  - dependent induction Sub2; eauto.
    clear IHSub2_1 IHSub2_2.
    dependent induction Sub1; eauto with subtyping.
  - dependent induction Sub2; eauto.
    clear IHSub2.
    dependent induction Sub1; eauto with subtyping.
  - gen A A1.
    proper_ind C; introv Sub1 Sub2 Spl IPr IH; eauto with subtyping.
    + eapply sub_inv_splitable_r in Sub1; eauto. destruct Sub1.
      eapply sub_inv_splitable_l in Sub2; eauto. intuition.
    + eapply sub_inv_splitable_r in Sub1; eauto. destruct Sub1.
      eapply sub_inv_splitable_l in Sub2; eauto. intuition.
    + eapply sub_inv_splitable_r in Sub1; eauto. destruct Sub1.
      eapply sub_inv_splitable_l in Sub2; eauto. intuition.
    + eapply sub_inv_splitable_r in Sub2; eauto.
      destruct Sub2; eauto.
Qed.

(** * Decidablility *)

(** subtyping is decidable, refer https://github.com/andongfan/CP-Foundations/blob/main/fiplus/coq/Subtyping.v#L1214 *)
Axiom dec_sub : forall A B, sumbool (sub A B) (not (sub A B)).


Require Export Exor.
Require Export ExorEx.
Section ml.
Theorem Exore: forall (A B:Set -> Prop),
(exists x:Set, ((A x) \/ (B x))) <->
(exists x:Set, A x) \/ (exists x:Set, B x).
Proof.
split.
apply Exor.
apply ExorEx.
Qed.
End ml.

Check Exore.


Set Implicit Arguments.

Require Import Arith.
Require Import List Ensembles.
Import ListNotations.

Inductive rexp (A : Type) :=
  | Empty : rexp A
  | Atom : A -> rexp A
  | Alt : rexp A -> rexp A -> rexp A
  | Conc : rexp A -> rexp A -> rexp A
  | Star : rexp A -> rexp A.

Section Semantic.

Print List.

Variable A : Type.
Definition word := list A.
Definition lang := Ensemble word.

Variable w : word.
Variable wb we : word.
Variable l : lang.

Definition langEps : lang := Singleton _ nil.
Definition lang0 : lang := Empty_set _.
Definition langAtom (a : A) := Singleton _ [a].

(*Le star d'un langage*)
Inductive star (L : lang) : lang :=
  (*On reconnait par défault le mot vide*)
  | In_star_nil : star L nil
  (*Sinon, une partie de la liste doit etre reconnu par L et l'autre par
  star de L*)
  | In_star_cons : forall wb we : list A, L wb -> star L we -> star L (wb ++ we).

Lemma NilI: star l nil.
  apply In_star_nil.
Qed.

Lemma LConsI: l wb -> star l we -> star l (wb ++ we).
  apply In_star_cons.
Qed.

Lemma epsilonExists: star langEps = langEps.
  apply Extensionality_Ensembles.
  split.
  intros v H.
  induction H.
  reflexivity.
  inversion_clear H.
  inversion_clear IHstar.
  reflexivity.
  intros v H.
  inversion_clear H.
  apply In_star_nil.
Qed.

Lemma epsilonAlt: star lang0 = langEps.
  apply Extensionality_Ensembles.
  split.
  induction 1.
  reflexivity.
  exfalso.
  inversion_clear H.
  intros v H.
  inversion_clear H.
  apply In_star_nil.
Qed.

Lemma epsilon': star (star langEps) = langEps.
  repeat rewrite epsilonExists.
  reflexivity.
Qed.

Lemma epsilon'': star (star (star langEps)) = langEps.
  repeat rewrite epsilonExists.
  reflexivity.
Qed.

(*La concaténation de deux langages*)
Inductive conc (l1 l2 : lang): lang :=
  (*une partie de la liste est reconnu par l1 et l'autre par l2*)
  | In_conc : forall wb we, l1 wb -> l2 we -> conc l1 l2 (wb ++ we).

Fixpoint L (r : rexp A): lang :=
  match r with
  | Empty _ => lang0
  | Atom a => langAtom a
  | Alt r1 r2 => Union _ (L r1) (L r2)
  | Conc r1 r2 => conc (L r1) (L r2)
  | Star r1 => star (L r1)
  end.

Lemma alt_commute : forall r1 r2, L (Alt r1 r2) = L (Alt r2 r1).
Proof.
  intros r1 r2.
  simpl.
  apply Extensionality_Ensembles.
  split; intros v H.
  inversion_clear H; [right | left]; assumption.
  inversion_clear H; [right | left]; assumption.
Qed.

Lemma mt_seq : L (Conc (Empty _) (Empty _)) = lang0.
Proof.
  simpl.
  apply Extensionality_Ensembles.
  split; intros v H.
  *inversion_clear H.
  inversion_clear H0.
  *inversion_clear H.
Qed.

Lemma eps : L (Star (Empty _)) = langEps.
Proof.
  simpl.
  apply Extensionality_Ensembles.
  split; intros v H.
  *inversion_clear H.
    +apply In_singleton.
    +inversion_clear H0.
  *inversion_clear H.
  apply In_star_nil.
Qed.

End Semantic.

Section Test.

Definition regexA := Conc (Atom 1) (Atom 2).
Definition LA := L regexA.

Goal LA [1; 2].
  unfold LA.
  simpl.
  apply In_conc with (wb := [1]) (we := [2]); apply In_singleton.
Qed.

Definition regexB := Alt regexA (Atom 1).
Definition LB := L regexB.

Goal LB [1] /\ LB [1; 2].
  unfold LB.
  simpl.
  split.
  right.
  compute.
  reflexivity.
  left.
  apply In_conc with (wb := [1]) (we := [2]); reflexivity.
Qed.

End Test.


Require Import ExtLib.Data.HList.
Require Import ExtLib.Data.Member.
Require Import ExtLib.Data.Fin.

Section fin_get.
  Context {T : Type}.

  Fixpoint fin_get {ls : list T} (f : fin (length ls)) : T.
  destruct ls.
  - apply fin0_elim. eapply f.
  - simpl in f.
    refine (match f in fin (S x)
                 return x = length ls -> _
           with
           | F0 => fun _ => t
           | FS f => fun pf => fin_get _ (match pf in _ = X return fin X with
                                      | eq_refl => f
                                      end)
           end eq_refl).
  Defined.

  Definition fin_get_hlist' {U}
  : forall n (f : fin n) (ls : list T) (hs : hlist U ls) (pf : n = length ls),
      U (fin_get match pf in _ = X return fin X with
                 | eq_refl => f
                 end).
    induction f.
    - destruct ls.
      + inversion pf.
      + simpl.
        inversion pf. subst.
        rewrite (Eqdep_dec.UIP_refl_nat _ pf).
        eapply hlist_hd. eapply hs.
    - destruct ls.
      + inversion pf.
      + inversion pf. subst.
        rewrite (Eqdep_dec.UIP_refl_nat _ pf).
        simpl. apply (IHf _ (hlist_tl hs) eq_refl).
  Defined.

  Definition fin_get_hlist {U}
  : forall (ls : list T) (hs : hlist U ls) (f : fin (length ls)),
      U (fin_get f).
  Proof. intros. eapply (@fin_get_hlist' _ _ f ls hs eq_refl). Defined.

  Definition hlist_fins : forall (ls : list T),
      hlist (fun t => { f : fin (length ls) | fin_get f = t }) ls.
  induction ls.
  - constructor.
  - constructor.
    + exists F0. reflexivity.
    + revert IHls. eapply hlist_map.
      destruct 1.
      exists (FS x0). exact e.
  Defined.
End fin_get.


(** * Categories in essentially algebraic and generalized algebraic style *)

(**
    Essentially algebraic categories:
    - a type of objects
    - a type of morphisms
    - composition is partially defined

    Generalized algebraic categories:
    - a type of objects
    - a family of types of morphisms, parametrized by pairs of objects
    - composition is a dependent function

In this file, we define functions back and forth and show that
    the two variants are equivalent
*)

Require Import UniMath.Foundations.Sets.
Require Import UniMath.CategoryTheory.Core.Categories.
Require Import UniMath.CategoryTheory.Core.EssentiallyAlgebraic.
Require Import TypeTheory.Auxiliary.Auxiliary.
Require Import TypeTheory.Auxiliary.CategoryTheory.
Require Import TypeTheory.Categories.ess_alg_categories.

(** * From generalized algebraic precategories to essentially algebraic ones.*)

(** We need extra assumption that the gen. alg. precategory is a category, i.e. has hom-sets *)

Section ess_alg_from_gen_alg.

Variable C : category.
Variable H : isaset C.

(* TODO: now we are writing compositional in diagrammatic order,
should we switch the names of [idtomor_left] and [idtomor_right]
(and similar lemmas? *)
Lemma idtomor_left (a b : C) (f : a --> b) (e : b = b) :
   f ;; idtomor _ _ e = f.
Proof.
  set (H1 := H b b).
  set (H2:=proofirrelevance _ H1 e (idpath _ )).
  rewrite H2. simpl.
  rewrite id_right.
  apply idpath.
Qed.

Lemma idtomor_right (a b : C) (f : a --> b) (e : a = a) :
   idtomor _ _ e ;; f = f.
Proof.
  set (H1 := H a a).
  set (H2:=proofirrelevance _ H1 e (idpath _ )).
  rewrite H2. simpl.
  rewrite id_left.
  apply idpath.
Qed.

Definition obmor : UU × UU := make_dirprod (ob C) (total_morphisms C).

Definition graph_from_gen_alg : graph.
Proof.
  exists obmor.
  exists (precategory_source C).
  exact (precategory_target C).
Defined.

Definition graph_from_gen_alg_comp : @comp_op graph_from_gen_alg.
Proof.
  intros f g e.
  exists (make_dirprod (pr1 (pr1 f)) (pr2 (pr1 g))).
  exact ((pr2 f ;; idtomor _ _ e) ;; pr2 g).
Defined.

Definition graph_w_comp_from_gen_alg : graph_w_comp :=
  tpair _ graph_from_gen_alg graph_from_gen_alg_comp.

Definition id_op1 : @id_op graph_w_comp_from_gen_alg :=
  λ c : C, tpair _ (make_dirprod c c) (identity c).

(** This proof should probably be transparent, since otherwise identity does not compute *)

Lemma ess_alg_cat_axioms_from_gen_alg : ess_alg_cat_axioms graph_w_comp_from_gen_alg.
Proof.
  split; [ | split].
  - repeat split.
    + exists id_op1.
      repeat split.
      { unfold id_comp_l_ax. simpl. intros f p.
        destruct f as [[a b] f].
        simpl in *.
        unfold target, source in p. simpl in *.
        unfold precategory_source, precategory_target in p. simpl in *.
        unfold graph_from_gen_alg_comp. simpl.
        apply maponpaths.
        rewrite id_left.
        rewrite idtomor_right.
        apply idpath. }
      { intros f p. destruct f as [[a b] f].
        simpl in *.
        unfold target, source in p. simpl in *.
        unfold precategory_source, precategory_target in p. simpl in *.
        unfold graph_from_gen_alg_comp. simpl.
        apply maponpaths.
        rewrite id_right.
        rewrite idtomor_left. apply idpath. }
  - repeat split.
    intros f g h p q p' q'; simpl.
    unfold graph_from_gen_alg_comp; simpl.
    apply maponpaths; simpl.
    destruct f as [[a b] f].
    destruct g as [[b' c] g].
    destruct h as [[c' d] h].
    simpl in *. unfold target, source in *; simpl in *.
    unfold precategory_source, precategory_target in *; simpl in *.
    repeat (match goal with | [ H : _ = _ |- _ ] => destruct H end).
    simpl.
    rewrite id_right.
    rewrite idtomor_left.
    rewrite id_right.
    rewrite idtomor_left.
    apply Categories.assoc.
 - split.
   + apply H.
   + apply isaset_total2. apply isaset_dirprod; try assumption.
     intro x; apply homset_property.
Qed.

End ess_alg_from_gen_alg.

(** * From ess. alg. categories to gen. alg. ones *)

Section gen_alg_from_ess_alg.

Variable C : ess_alg_cat.

Definition hom (a b : C) : UU := ∑ f : mor C, source f = a × target f = b.

Lemma hom_eq (a b : C) (f f' : hom a b) : pr1 f = pr1 f' → f = f'.
Proof.
  intro H.
  apply subtypePath; try assumption.
  intro x. apply isapropdirprod; apply (isaset_objects C (pr2 C)).
Qed.

Definition composition {a b c : C} (f : hom a b) (g : hom b c) : hom a c.
Proof.
  assert (H : target (pr1 f) = source (pr1 g)).
  { eapply pathscomp0.
    - apply (pr2 (pr2 f)).
    - apply (!pr1 (pr2 g)). }
  exists (comp (pr1 f) (pr1 g) H).
  destruct f as [f [fs ft]].
  destruct g as [g [gs gt]]. simpl in *.
  split.
  - eapply pathscomp0.
    + apply comp_source.
    + assumption.
  - eapply pathscomp0.
    + apply comp_target.
    + assumption.
Defined.

Definition composition_assoc (a b c d : C) (f : hom a b) (g : hom b c) (h : hom c d):
  composition f (composition g h) = composition (composition f g) h.
Proof.
  apply hom_eq, assoc.
Qed.

Definition identity (a : C) : hom a a.
Proof.
  exists (id C a).
  split.
  + apply id_source.
  + apply id_target.
Defined.

Definition precategory_ob_mor_from_ess_alg_cat : precategory_ob_mor.
Proof.
  exists C.
  exact (λ a b, hom a b).
Defined.

Definition precategory_data_from_ess_alg_cat : precategory_data.
Proof.
  exists precategory_ob_mor_from_ess_alg_cat.
  repeat split.
  - apply identity.
  - apply @composition.
Defined.

Lemma is_precategory_precategory_data_from_ess_alg_cat :
  is_precategory (precategory_data_from_ess_alg_cat).
Proof.
  use make_is_precategory_one_assoc; intros.
  - apply hom_eq. simpl. apply id_comp_l.
    apply (pr1 (pr2 f)).
  - apply hom_eq, id_comp_r, (pr2 (pr2 f)).
  - apply composition_assoc.
Qed.

Definition precategory_from_ess_alg_cat : precategory :=
  (_,,is_precategory_precategory_data_from_ess_alg_cat).

End gen_alg_from_ess_alg.


Require Import rt.util.all.
Require Import rt.analysis.basic.bertogna_fp_theory.
From mathcomp Require Import ssreflect ssrbool ssrfun eqtype ssrnat seq fintype bigop div path.

Module ResponseTimeIterationFP.

  Import ResponseTimeAnalysisFP.

  (* In this section, we define the algorithm of Bertogna and Cirinei's
     response-time analysis for FP scheduling. *)
  Section Analysis.

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

    (* As input for each iteration of the algorithm, we consider pairs
       of tasks and computed response-time bounds. *)
    Let task_with_response_time := (sporadic_task * time)%type.

    Context {Job: eqType}.
    Variable job_cost: Job -> time.
    Variable job_deadline: Job -> time.
    Variable job_task: Job -> sporadic_task.

    (* Consider a platform with num_cpus processors, ... *)
    Variable num_cpus: nat.

    (* ..., and priorities based on an FP policy. *)
    Variable higher_priority: FP_policy sporadic_task.

    (* Next we define the fixed-point iteration for computing
       Bertogna's response-time bound of a task set. *)

    (* First, given a sequence of pairs R_prev = <..., (tsk_hp, R_hp)> of
       response-time bounds for the higher-priority tasks, we define an
       iteration that computes the response-time bound of the current task:

           R_tsk (0) = task_cost tsk
           R_tsk (step + 1) =  f (R step),

       where f is the response-time recurrence, step is the number of iterations,
       and R_tsk (0) is the initial state. *)
    Definition per_task_rta (tsk: sporadic_task)
                            (R_prev: seq task_with_response_time) (step: nat) :=
      iter step
        (fun t => task_cost tsk +
                  div_floor
                    (total_interference_bound_fp task_cost task_period tsk
                                                R_prev t higher_priority)
                    num_cpus)
        (task_cost tsk).

    (* To ensure that the iteration converges, we will apply per_task_rta
       a "sufficient" number of times: task_deadline tsk - task_cost tsk + 1.
       This corresponds to the time complexity of the iteration. *)
    Definition max_steps (tsk: sporadic_task) := task_deadline tsk - task_cost tsk + 1.

    (* Next we compute the response-time bounds for the entire task set.
       Since high-priority tasks may not be schedulable, we allow the
       computation to fail.
       Thus, given the response-time bound of previous tasks, we either
       (a) append the computed response-time bound (tsk, R) of the current task
           to the list of pairs, or,
       (b) return None if the response-time analysis failed. *)
    Definition fp_bound_of_task hp_pairs tsk :=
      if hp_pairs is Some rt_bounds then
        let R := per_task_rta tsk rt_bounds (max_steps tsk) in
          if R <= task_deadline tsk then
            Some (rcons rt_bounds (tsk, R))
          else None
      else None.

    (* The response-time analysis for a given task set is defined
       as a left-fold (reduce) based on the function above.
       This either returns a list of task and response-time bounds, or None. *)
    Definition fp_claimed_bounds (ts: taskset_of sporadic_task) :=
      foldl fp_bound_of_task (Some [::]) ts.

    (* The schedulability test simply checks if we got a list of
       response-time bounds (i.e., if the computation did not fail). *)
    Definition fp_schedulable (ts: taskset_of sporadic_task) :=
      fp_claimed_bounds ts != None.

    (* In the following section, we prove several helper lemmas about the
       list of response-time bounds. The results seem trivial, but must be proven
       nonetheless since the list of response-time bounds is computed with
       a specific algorithm and there are no lemmas in the library for that. *)
    Section SimpleLemmas.

      (* First, we show that the first component of the computed list is the set of tasks. *)
      Lemma fp_claimed_bounds_unzip :
        forall ts hp_bounds,
          fp_claimed_bounds ts = Some hp_bounds ->
          unzip1 hp_bounds = ts.
      Proof.
        unfold fp_claimed_bounds in *; intros ts.
        induction ts using last_ind; first by destruct hp_bounds.
        {
          intros hp_bounds SOME.
          destruct (lastP hp_bounds) as [| hp_bounds'].
          {
            rewrite -cats1 foldl_cat /= in SOME.
            unfold fp_bound_of_task at 1 in SOME; simpl in *; desf.
            by destruct l.
          }
          rewrite -cats1 foldl_cat /= in SOME.
          unfold fp_bound_of_task at 1 in SOME; simpl in *; desf.
          move: H0 => /eqP EQSEQ.
          rewrite eqseq_rcons in EQSEQ.
          move: EQSEQ => /andP [/eqP SUBST /eqP EQSEQ]; subst.
          unfold unzip1; rewrite map_rcons; f_equal.
          by apply IHts.
        }
      Qed.

      (* Next, we show that some properties of the analysis are preserved for the
         prefixes of the list: (a) the tasks do not change, (b) R <= deadline,
         (c) R is computed using the response-time equation, ... *)
      Lemma fp_claimed_bounds_rcons :
        forall ts' hp_bounds tsk1 tsk2 R,
          (fp_claimed_bounds (rcons ts' tsk1) = Some (rcons hp_bounds (tsk2, R)) ->
           (fp_claimed_bounds ts' = Some hp_bounds /\
            tsk1 = tsk2 /\
            R = per_task_rta tsk1 hp_bounds (max_steps tsk1) /\
            R <= task_deadline tsk1)).
      Proof.
        intros ts hp_bounds tsk tsk' R.
        rewrite -cats1.
        unfold fp_claimed_bounds in *.
        rewrite foldl_cat /=.
        unfold fp_bound_of_task at 1; simpl; desf.
        intros EQ; inversion EQ; move: EQ H0 => _ /eqP EQ.
        rewrite eqseq_rcons in EQ.
        move: EQ => /andP [/eqP EQ /eqP RESP].
        by inversion RESP; repeat split; subst.
      Qed.

      (* ..., which implies that any prefix of the computation is the computation
         of the prefix. *)
      Lemma fp_claimed_bounds_take :
        forall ts hp_bounds i,
          fp_claimed_bounds ts = Some hp_bounds ->
          i <= size hp_bounds ->
          fp_claimed_bounds (take i ts) = Some (take i hp_bounds).
      Proof.
        intros ts hp_bounds i SOME LTi.
        have UNZIP := fp_claimed_bounds_unzip ts hp_bounds SOME.
        rewrite <- UNZIP in *.
        rewrite -[hp_bounds]take_size /unzip1 map_take in SOME.
        fold (unzip1 hp_bounds) in *; clear UNZIP.
        rewrite leq_eqVlt in LTi.
        move: LTi => /orP [/eqP EQ | LTi]; first by subst.
        remember (size hp_bounds) as len; apply eq_leq in Heqlen.
        induction len; first by rewrite ltn0 in LTi.
        {
          assert (TAKElen: fp_claimed_bounds (take len (unzip1 (hp_bounds))) =
                             Some (take len (hp_bounds))).
          {
            assert (exists p, p \in hp_bounds).
            {
              destruct hp_bounds; first by rewrite ltn0 in Heqlen.
              by exists t; rewrite in_cons eq_refl orTb.
            } destruct H as [[tsk R] _].
             rewrite (take_nth tsk) in SOME; last by rewrite size_map.
            rewrite (take_nth (tsk,R)) in SOME; last by done.
            destruct (nth (tsk, R) hp_bounds len) as [tsk_len R_len].
            by apply fp_claimed_bounds_rcons in SOME; des.
          }
          rewrite ltnS leq_eqVlt in LTi.
          move: LTi => /orP [/eqP EQ | LESS]; first by subst.
          apply ltnW in Heqlen.
          by specialize (IHlen Heqlen TAKElen LESS).
        }
      Qed.

      (* If the analysis suceeds, the computed response-time bounds are no larger
         than the deadlines ... *)
      Lemma fp_claimed_bounds_le_deadline :
        forall ts' rt_bounds tsk R,
          fp_claimed_bounds ts' = Some rt_bounds ->
          (tsk, R) \in rt_bounds ->
          R <= task_deadline tsk.
      Proof.
        intros ts; induction ts as [| ts' tsk_lst] using last_ind.
        {
          intros rt_bounds tsk R SOME IN.
          by inversion SOME; subst; rewrite in_nil in IN.
        }
        {
          intros rt_bounds tsk_i R SOME IN.
          destruct (lastP rt_bounds) as [|rt_bounds (tsk_lst', R_lst)];
            first by rewrite in_nil in IN.
          rewrite mem_rcons in_cons in IN; move: IN => /orP IN.
          destruct IN as [LAST | FRONT].
          {
            move: LAST => /eqP LAST.
            rewrite -cats1 in SOME.
            unfold fp_claimed_bounds in *.
            rewrite foldl_cat /= in SOME.
            unfold fp_bound_of_task in SOME.
            desf; rename H0 into EQ.
            move: EQ => /eqP EQ.
            rewrite eqseq_rcons in EQ.
            move: EQ => /andP [_ /eqP EQ].
            inversion EQ; subst.
            by apply Heq0.
          }
          {
            apply IHts with (rt_bounds := rt_bounds); last by ins.
            by apply fp_claimed_bounds_rcons in SOME; des.
          }
        }
      Qed.

      (* ... and no smaller than the task costs. *)
      Lemma fp_claimed_bounds_ge_cost :
        forall ts' rt_bounds tsk R,
          fp_claimed_bounds ts' = Some rt_bounds ->
          (tsk, R) \in rt_bounds ->
          R >= task_cost tsk.
      Proof.
        intros ts; induction ts as [| ts' tsk_lst] using last_ind.
        {
          intros rt_bounds tsk R SOME IN.
          by inversion SOME; subst; rewrite in_nil in IN.
        }
        {
          intros rt_bounds tsk_i R SOME IN.
          destruct (lastP rt_bounds) as [|rt_bounds (tsk_lst', R_lst)];
            first by rewrite in_nil in IN.
          rewrite mem_rcons in_cons in IN; move: IN => /orP IN.
          destruct IN as [LAST | FRONT].
          {
            move: LAST => /eqP LAST.
            rewrite -cats1 in SOME.
            unfold fp_claimed_bounds in *.
            rewrite foldl_cat /= in SOME.
            unfold fp_bound_of_task in SOME.
            desf; rename H0 into EQ.
            move: EQ => /eqP EQ.
            rewrite eqseq_rcons in EQ.
            move: EQ => /andP [_ /eqP EQ].
            inversion EQ; subst.
            by destruct (max_steps tsk_lst');
              [by apply leqnn | by apply leq_addr].
          }
          {
            apply IHts with (rt_bounds := rt_bounds); last by ins.
            by apply fp_claimed_bounds_rcons in SOME; des.
          }
        }
      Qed.

      (* Short lemma about unfolding the iteration one step. *)
      Lemma per_task_rta_fold :
        forall tsk rt_bounds,
          task_cost tsk +
           div_floor (total_interference_bound_fp task_cost task_period tsk rt_bounds
                     (per_task_rta tsk rt_bounds (max_steps tsk)) higher_priority) num_cpus
          = per_task_rta tsk rt_bounds (max_steps tsk).+1.
      Proof.
          by done.
      Qed.

    End SimpleLemmas.

    (* In this section, we prove that if the task set is sorted by priority,
       the tasks in fp_claimed_bounds are interfering tasks.  *)
    Section HighPriorityTasks.

      (* Consider a list of previous tasks and a task tsk to be analyzed. *)
      Variable ts: taskset_of sporadic_task.

      (* Assume that the task set doesn't contain duplicates and is sorted by priority, ... *)
      Hypothesis H_task_set_is_a_set: uniq ts.
      Hypothesis H_task_set_is_sorted: sorted higher_priority ts.

      (* ...the priority order is strict (<), ...*)
      Hypothesis H_priority_irreflexive: irreflexive higher_priority.
      Hypothesis H_priority_transitive: transitive higher_priority.
      Hypothesis H_priority_antissymetric: antisymmetric higher_priority.

      (* ... and that the response-time analysis succeeds. *)
      Variable hp_bounds: seq task_with_response_time.
      Variable R: time.
      Hypothesis H_analysis_succeeds: fp_claimed_bounds ts = Some hp_bounds.

      (* Let's refer to tasks by index. *)
      Variable elem: sporadic_task.
      Let TASK := nth elem ts.

      (* Then, the tasks in the prefix of fp_claimed_bounds are exactly interfering tasks
         under FP scheduling.*)
      Lemma fp_claimed_bounds_interf:
        forall idx,
          idx < size ts ->
          [seq tsk_hp <- ts | fp_can_interfere_with higher_priority (TASK idx) tsk_hp] = take idx ts.
      Proof.
        rename H_task_set_is_sorted into SORT,
               H_task_set_is_a_set into UNIQ,
               H_priority_antissymetric into ANTI,
               H_priority_irreflexive into IRR.
        induction idx.
        {
          intros LT.
          destruct ts as [| tsk0 ts']; [by done | simpl in SORT].
          unfold fp_can_interfere_with; rewrite /= eq_refl andbF.
          apply eq_trans with (y := filter pred0 ts');
            last by apply filter_pred0.
          apply eq_in_filter; red; intros x INx; rewrite /TASK /=.
          destruct (x != tsk0) eqn:SAME; rewrite ?andbT ?andbF //.
          apply negbTE; apply/negP; unfold not; intro HP.
          move: SAME => /eqP SAME; apply SAME; clear SAME.
          apply ANTI; apply/andP; split; first by done.
          apply order_path_min in SORT; last by done.
          by move: SORT => /allP SORT; apply SORT.
        }
        {
          intros LT.
          generalize LT; intro LT'; apply ltSnm in LT.
          feed IHidx; first by done.
          rewrite -filter_idx_le_takeS //.
          apply eq_in_filter; red; intros x INx.
          unfold fp_can_interfere_with.
          generalize INx; intro SUBST; apply nth_index with (x0 := elem) in SUBST.
          rewrite -SUBST; clear SUBST.
          rewrite index_uniq; [ | by rewrite index_mem | by done].
          apply/idP/idP.
          {
            move => /andP [HP DIFF].
            unfold TASK in *.
            apply sorted_uniq_rel_implies_le_idx in HP; try (by done);
              last by rewrite index_mem.
            by rewrite leq_eqVlt in HP; move: HP => /orP [/eqP SAME | LESS];
                first by rewrite SAME eq_refl in DIFF.
          }
          {
            intros LEidx; apply/andP; split;
              first by apply sorted_lt_idx_implies_rel.
            apply/eqP; red; intro BUG.
            eapply f_equal with (f := fun x => index x ts) in BUG.
            rewrite nth_index in BUG; last by done.
            rewrite BUG in LEidx.
            by rewrite index_uniq // ltnn in LEidx.
          }
        }
      Qed.

    End HighPriorityTasks.

    (* In this section, we show that the fixed-point iteration converges. *)
    Section Convergence.

      (* Consider any set of higher-priority tasks. *)
      Variable ts_hp: taskset_of sporadic_task.

      (* Assume that the response-time analysis succeeds for the higher-priority tasks. *)
      Variable rt_bounds: seq task_with_response_time.
      Hypothesis H_test_succeeds: fp_claimed_bounds ts_hp = Some rt_bounds.

      (* Consider any task tsk to be analyzed, ... *)
      Variable tsk: sporadic_task.

      (* ... and assume all tasks have valid parameters. *)
      Hypothesis H_valid_task_parameters:
        valid_sporadic_taskset task_cost task_period task_deadline (rcons ts_hp tsk).

      (* To simplify, let f denote the fixed-point iteration. *)
      Let f := per_task_rta tsk rt_bounds.

      (* Assume that f (max_steps tsk) is no larger than the deadline. *)
      Hypothesis H_no_larger_than_deadline: f (max_steps tsk) <= task_deadline tsk.

      (* First, we show that f is monotonically increasing. *)
      Lemma bertogna_fp_comp_f_monotonic :
        forall x1 x2, x1 <= x2 -> f x1 <= f x2.
      Proof.
        unfold valid_sporadic_taskset, is_valid_sporadic_task in *.
        rename H_test_succeeds into SOME,
               H_valid_task_parameters into VALID.
        intros x1 x2 LEx; unfold f, per_task_rta.
        apply fun_mon_iter_mon; [by ins | by ins; apply leq_addr |].
        clear LEx x1 x2; intros x1 x2 LEx.
        unfold div_floor, total_interference_bound_fp.
        rewrite big_seq_cond [\sum_(i <- _ | let '(tsk_other, _) := i in
                                 _ && (tsk_other != tsk))_]big_seq_cond.
        rewrite leq_add2l leq_div2r // leq_sum //.

        intros i; destruct (i \in rt_bounds) eqn:HP; last by rewrite andFb.
        destruct i as [i R]; intros _.
        have GE_COST := fp_claimed_bounds_ge_cost ts_hp rt_bounds i R SOME.
        have UNZIP := fp_claimed_bounds_unzip ts_hp rt_bounds SOME.
        assert (IN: i \in ts_hp).
        {
          by rewrite -UNZIP; apply/mapP; exists (i,R).
        }
        unfold interference_bound_generic; simpl.
        rewrite leq_min; apply/andP; split.
        {
          apply leq_trans with (n := W task_cost task_period i R x1); first by apply geq_minl.
            exploit (VALID i); [by rewrite mem_rcons in_cons IN orbT | ins; des].
            by apply W_monotonic; try by ins; apply GE_COST.
        }
        {
          apply leq_trans with (n := x1 - task_cost tsk + 1); first by apply geq_minr.
          by rewrite leq_add2r leq_sub2r //.
        }
      Qed.

      (* If the iteration converged at an earlier step, it remains as a fixed point. *)
      Lemma bertogna_fp_comp_f_converges_early :
        (exists k, k <= max_steps tsk /\ f k = f k.+1) ->
        f (max_steps tsk) = f (max_steps tsk).+1.
      Proof.
        by intros EX; des; apply iter_fix with (k := k).
      Qed.

      (* Else, we derive a contradiction. *)
      Section DerivingContradiction.

        (* Assume instead that the iteration continued to diverge. *)
        Hypothesis H_keeps_diverging:
          forall k,
            k <= max_steps tsk -> f k != f k.+1.

        (* By monotonicity, it follows that the value always increases. *)
        Lemma bertogna_fp_comp_f_increases :
          forall k,
            k <= max_steps tsk ->
            f k < f k.+1.
        Proof.
          intros k LT.
          rewrite ltn_neqAle; apply/andP; split.
            by apply H_keeps_diverging.
            by apply bertogna_fp_comp_f_monotonic, leqnSn.
        Qed.

        (* In the end, the response-time bound must exceed the deadline. Contradiction! *)
        Lemma bertogna_fp_comp_rt_grows_too_much :
          forall k,
            k <= max_steps tsk ->
            f k > k + task_cost tsk - 1.
        Proof.
          have INC := bertogna_fp_comp_f_increases.
          rename H_valid_task_parameters into TASK_PARAMS.
          unfold valid_sporadic_taskset, is_valid_sporadic_task in *; des.
          exploit (TASK_PARAMS tsk);
            [by rewrite mem_rcons in_cons eq_refl orTb | intro PARAMS; des].
          induction k.
          {
            intros _; rewrite add0n -addn1 subh1;
              first by rewrite -addnBA // subnn addn0 /= leqnn.
            by apply PARAMS.
          }
          {
            intros LT.
            specialize (IHk (ltnW LT)).
            apply leq_ltn_trans with (n := f k); last by apply INC, ltnW.
            rewrite -addn1 -addnA [1 + _]addnC addnA -addnBA // subnn addn0.
            rewrite -(ltn_add2r 1) in IHk.
            rewrite subh1 in IHk;
              last by apply leq_trans with (n := task_cost tsk);
                [by apply PARAMS | by apply leq_addl].
            by rewrite -addnBA // subnn addn0 addn1 ltnS in IHk.
          }
        Qed.

      End DerivingContradiction.

      (* Using the lemmas above, we prove the convergence of the iteration after max_steps. *)
      Lemma per_task_rta_converges:
        f (max_steps tsk) = f (max_steps tsk).+1.
      Proof.
        have TOOMUCH := bertogna_fp_comp_rt_grows_too_much.
        have INC := bertogna_fp_comp_f_increases.
        rename H_no_larger_than_deadline into LE,
               H_valid_task_parameters into TASK_PARAMS.
        unfold valid_sporadic_taskset, is_valid_sporadic_task in *; des.

        (* Either f converges by the deadline or not. *)
        destruct ([exists k in 'I_(max_steps tsk).+1, f k == f k.+1]) eqn:EX.
        {
          move: EX => /exists_inP EX; destruct EX as [k _ ITERk].
          apply bertogna_fp_comp_f_converges_early.
          by exists k; split; [by rewrite -ltnS; apply ltn_ord | by apply/eqP].
        }

        (* If not, then we reach a contradiction *)
        apply negbT in EX; rewrite negb_exists_in in EX.
        move: EX => /forall_inP EX.
        rewrite leqNgt in LE; move: LE => /negP LE.
        exfalso; apply LE.

        assert (DIFF: forall k : nat, k <= max_steps tsk -> f k != f k.+1).
        {
          intros k LEk; rewrite -ltnS in LEk.
          by exploit (EX (Ordinal LEk)); [by done | intro DIFF; apply DIFF].
        }
        exploit TOOMUCH; [by apply DIFF | by apply leq_addr |].
        exploit (TASK_PARAMS tsk);
          [by rewrite mem_rcons in_cons eq_refl orTb | intro PARAMS; des].
        rewrite subh1; last by apply PARAMS2.
        rewrite -addnBA // subnn addn0 subn1 prednK //.
        intros LT; apply (leq_ltn_trans LT).
        by rewrite /max_steps [_ - _ + 1]addn1; apply INC, leq_addr.
      Qed.

    End Convergence.

    Section MainProof.

      (* Consider a task set ts. *)
      Variable ts: taskset_of sporadic_task.

      (* Assume that higher_priority is a total strict order (<).
         TODO: it doesn't have to be total over the universe of tasks,
         but only within the task set. However, to weaken this hypothesis
         we need to re-prove some lemmas from ssreflect. *)
      Hypothesis H_irreflexive: irreflexive higher_priority.
      Hypothesis H_transitive: transitive higher_priority.
      Hypothesis H_unique_priorities: antisymmetric higher_priority.
      Hypothesis H_total: total higher_priority.

      (* Assume the task set has no duplicates, ... *)
      Hypothesis H_ts_is_a_set: uniq ts.

      (* ...all tasks have valid parameters, ... *)
      Hypothesis H_valid_task_parameters:
        valid_sporadic_taskset task_cost task_period task_deadline ts.

      (* ...constrained deadlines, ...*)
      Hypothesis H_constrained_deadlines:
        forall tsk, tsk \in ts -> task_deadline tsk <= task_period tsk.

      (* ...and tasks are ordered by increasing priorities. *)
      Hypothesis H_sorted_ts: sorted higher_priority ts.

      (* Next, consider any arrival sequence such that...*)
      Context {arr_seq: arrival_sequence Job}.

     (* ...all jobs come from task set ts, ...*)
      Hypothesis H_all_jobs_from_taskset:
        forall (j: JobIn arr_seq), job_task j \in ts.

      (* ...jobs have valid parameters,...*)
      Hypothesis H_valid_job_parameters:
        forall (j: JobIn arr_seq),
          valid_sporadic_job task_cost task_deadline job_cost job_deadline job_task j.

      (* ... and satisfy the sporadic task model.*)
      Hypothesis H_sporadic_tasks:
        sporadic_task_model task_period arr_seq job_task.

      (* Then, consider any platform with at least one CPU such that...*)
      Variable sched: schedule num_cpus arr_seq.
      Hypothesis H_at_least_one_cpu :
        num_cpus > 0.

      (* ...jobs only execute after they arrived and no longer
         than their execution costs. *)
      Hypothesis H_jobs_must_arrive_to_execute:
        jobs_must_arrive_to_execute sched.
      Hypothesis H_completed_jobs_dont_execute:
        completed_jobs_dont_execute job_cost sched.

      (* Also assume that jobs are sequential (as required by the workload bound). *)
      Hypothesis H_sequential_jobs: sequential_jobs sched.

      (* Assume that the scheduler is work-conserving and enforces the FP policy. *)
      Hypothesis H_work_conserving: work_conserving job_cost sched.
      Hypothesis H_enforces_FP_policy:
        enforces_FP_policy job_cost job_task sched higher_priority.

      Let no_deadline_missed_by_task (tsk: sporadic_task) :=
        task_misses_no_deadline job_cost job_deadline job_task sched tsk.
      Let no_deadline_missed_by_job :=
        job_misses_no_deadline job_cost job_deadline sched.
      Let response_time_bounded_by (tsk: sporadic_task) :=
        is_response_time_bound_of_task job_cost job_task tsk sched.

      (* In the following theorem, we prove that any response-time bound contained
         in fp_claimed_bounds is safe. The proof follows by induction on the task set:

           Induction hypothesis: assume all higher-priority tasks have safe response-time bounds.
           Inductive step: we prove that the response-time bound of the current task is safe.

         Note that the inductive step is a direct application of the main Theorem from
         bertogna_fp_theory.v. *)
      Theorem fp_analysis_yields_response_time_bounds :
        forall tsk R,
          (tsk, R) \In fp_claimed_bounds ts ->
          response_time_bounded_by tsk R.
      Proof.
        rename H_valid_job_parameters into JOBPARAMS, H_valid_task_parameters into TASKPARAMS.
        unfold valid_sporadic_taskset in *.
        intros tsk R MATCH.
        assert (SOME: exists hp_bounds, fp_claimed_bounds ts = Some hp_bounds /\
                                        (tsk, R) \in hp_bounds).
        {
          destruct (fp_claimed_bounds ts); last by done.
          by exists l; split.
        } clear MATCH; des; rename SOME0 into IN.

        have UNZIP := fp_claimed_bounds_unzip ts hp_bounds SOME.

        set elem := (tsk,R).
        move: IN => /(nthP elem) [idx LTidx EQ].
        set NTH := fun k => nth elem hp_bounds k.
        set TASK := fun k => (NTH k).1.
        set RESP := fun k => (NTH k).2.
        cut (response_time_bounded_by (TASK idx) (RESP idx));
          first by unfold TASK, RESP, NTH; rewrite EQ.
        clear EQ.

        assert (PAIR: forall idx, (TASK idx, RESP idx) = NTH idx).
        {
          by intros i; unfold TASK, RESP; destruct (NTH i).
        }

        assert (SUBST: forall i, i < size hp_bounds -> TASK i = nth tsk ts i).
        {

          by intros i LTi; rewrite /TASK /NTH -UNZIP (nth_map elem) //.
        }

        assert (SIZE: size hp_bounds = size ts).
        {
          by rewrite -UNZIP size_map.
        }

        induction idx as [idx IH'] using strong_ind.

        assert (IH: forall tsk_hp R_hp, (tsk_hp, R_hp) \in take idx hp_bounds -> response_time_bounded_by tsk_hp R_hp).
        {
          intros tsk_hp R_hp INhp.
          move: INhp => /(nthP elem) [k LTk EQ].
          rewrite size_take LTidx in LTk.
          rewrite nth_take in EQ; last by done.
          cut (response_time_bounded_by (TASK k) (RESP k));
            first by unfold TASK, RESP, NTH; rewrite EQ.
          by apply IH'; try (by done); apply (ltn_trans LTk).
        } clear IH'.

        unfold response_time_bounded_by in *.

        exploit (fp_claimed_bounds_rcons (take idx ts) (take idx hp_bounds) (TASK idx) (TASK idx) (RESP idx)).
        {
          by rewrite PAIR SUBST // -2?take_nth -?SIZE // (fp_claimed_bounds_take _ hp_bounds).
        }
        intros [_ [_ [REC DL]]].

        apply bertogna_cirinei_response_time_bound_fp with
              (task_cost0 := task_cost) (task_period0 := task_period)
              (task_deadline0 := task_deadline) (job_deadline0 := job_deadline) (tsk0 := (TASK idx))
              (job_task0 := job_task) (ts0 := ts) (hp_bounds0 := take idx hp_bounds)
              (higher_eq_priority := higher_priority); try (by done).
        {
          cut (NTH idx \in hp_bounds = true); [intros IN | by apply mem_nth].
          by rewrite -UNZIP; apply/mapP; exists (TASK idx, RESP idx); rewrite PAIR.
        }
        {
          unfold unzip1 in *; rewrite map_take UNZIP SUBST //.
          by apply fp_claimed_bounds_interf with (hp_bounds := hp_bounds); rewrite -?SIZE.
        }
        {
          intros hp_tsk R_hp IN; apply mem_take in IN.
          by apply fp_claimed_bounds_ge_cost with (ts' := ts) (rt_bounds := hp_bounds).
        }
        {
          intros hp_tsk R_hp IN; apply mem_take in IN.
          by apply fp_claimed_bounds_le_deadline with (ts' := ts) (rt_bounds := hp_bounds).
        }
        {
          rewrite REC per_task_rta_fold.
          apply per_task_rta_converges with (ts_hp := take idx ts);
            [by apply fp_claimed_bounds_take; try (by apply ltnW) | | by rewrite -REC ].
          rewrite SUBST // -take_nth -?SIZE //.
          by intros i IN; eapply TASKPARAMS, mem_take, IN.
        }
      Qed.

      (* Therefore, if the schedulability test suceeds, ...*)
      Hypothesis H_test_succeeds: fp_schedulable ts.

      (*..., no task misses its deadline. *)
      Theorem taskset_schedulable_by_fp_rta :
        forall tsk, tsk \in ts -> no_deadline_missed_by_task tsk.
      Proof.
        have RLIST := (fp_analysis_yields_response_time_bounds).
        have UNZIP := (fp_claimed_bounds_unzip ts).
        have DL := (fp_claimed_bounds_le_deadline ts).

        unfold no_deadline_missed_by_task, task_misses_no_deadline,
               job_misses_no_deadline, completed,
               fp_schedulable, valid_sporadic_job in *.
        rename H_valid_job_parameters into JOBPARAMS.
        move => tsk INtsk j JOBtsk.
        destruct (fp_claimed_bounds ts) as [rt_bounds |]; last by ins.
        feed (UNZIP rt_bounds); first by done.
        assert (EX: exists R, (tsk, R) \in rt_bounds).
        {
          rewrite -UNZIP in INtsk; move: INtsk => /mapP EX.
          by destruct EX as [p]; destruct p as [tsk' R]; simpl in *; subst tsk'; exists R.
        } des.
        exploit (RLIST tsk R); [by ins | by apply JOBtsk | intro COMPLETED].
        exploit (DL rt_bounds tsk R); [by ins | by ins | clear DL; intro DL].
        rewrite eqn_leq; apply/andP; split; first by apply cumulative_service_le_job_cost.
        apply leq_trans with (n := service sched j (job_arrival j + R)); last first.
        {
          unfold valid_sporadic_taskset, is_valid_sporadic_task in *.
          apply extend_sum; rewrite // leq_add2l.
          specialize (JOBPARAMS j); des; rewrite JOBPARAMS1.
          by rewrite JOBtsk.
        }
        rewrite leq_eqVlt; apply/orP; left; rewrite eq_sym.
        by apply COMPLETED.
      Qed.

      (* For completeness, since all jobs of the arrival sequence
         are spawned by the task set, we also conclude that no job in
         the schedule misses its deadline. *)
      Theorem jobs_schedulable_by_fp_rta :
        forall (j: JobIn arr_seq), no_deadline_missed_by_job j.
      Proof.
        intros j.
        have SCHED := taskset_schedulable_by_fp_rta.
        unfold no_deadline_missed_by_task, task_misses_no_deadline in *.
        apply SCHED with (tsk := job_task j); last by done.
        by apply H_all_jobs_from_taskset.
      Qed.

    End MainProof.

  End Analysis.

End ResponseTimeIterationFP.


(* Copyright 2012-2015 by Adam Petcher.				*
 * Use of this source code is governed by the license described	*
 * in the LICENSE file at the root of the source tree.		*)

(* An operation that returns a (uniformly distributed) random element from a list *)

Set Implicit Arguments.

Require Import FCF.FCF.

Section RndListElem.

  Variable A : Set.
  Hypothesis eqd : EqDec A.

  Local Open Scope list_scope.

  Definition rndListElem(ls : list A) : Comp (option A) :=
    match (length ls) with
      | O => ret None
      | S _ =>
        i <-$ [0 .. (length ls));
          ret (nth_option ls i)
    end.

  Theorem rndListElem_wf :
    forall (ls : list A),
      well_formed_comp (rndListElem ls).

    intuition.
    unfold rndListElem.
    case_eq (length ls); intuition; wftac.
  Qed.

End RndListElem.

Local Open Scope list_scope.

Theorem nth_option_In :
  forall (A : Set)(ls : list A)(a : A) i,
    nth_option ls i = Some a ->
    In a ls.

  induction ls; intuition; simpl in *.
  discriminate.

  destruct i.
  inversion H; clear H; subst.
  intuition.
  right.
  eapply IHls.
  eauto.

Qed.

Fixpoint firstIndexOf(A : Set)(eqd : eq_dec A)(ls : list A)(a : A)(def : nat) :=
  match ls with
      | nil => def
      | a' :: ls' =>
        if (eqd a a') then O else (S (firstIndexOf eqd ls' a def))
  end.

Theorem firstIndexOf_in_lt :
  forall (A : Set)(eqd : eq_dec A)(ls : list A)(a : A)(def : nat),
    In a ls ->
    firstIndexOf eqd ls a def < length ls.

  induction ls; intuition; simpl in *;
  intuition.

  subst.
  destruct (eqd a0 a0); subst.
  omega.
  intuition.

  destruct (eqd a0 a); subst.
  omega.

  eapply lt_n_S.
  eauto.
Qed.

Theorem nth_firstIndexOf :
  forall (A : Set)(eqd : eq_dec A)(ls : list A)(a : A)(def : nat),
    In a ls ->
    nth_option ls (firstIndexOf eqd ls a def) = Some a.

  induction ls; intuition; simpl in *.
  intuition.

  intuition.
  subst.
  destruct (eqd a0 a0); subst; intuition.

  destruct (eqd a0 a); subst; intuition.

Qed.

Lemma rndListElem_support:
  forall (A : Set)(eqd : EqDec A)(ls : list A) a,
    In a ls <->
    In (Some a) (getSupport (rndListElem eqd ls)).

  intuition.
  unfold rndListElem.
  case_eq (length ls); intuition.
  exfalso.
  destruct ls; simpl in *; intuition.

  eapply getSupport_In_Seq.

  eapply in_getSupport_RndNat.

  rewrite <- H0.
  eapply firstIndexOf_in_lt; eauto.
  simpl.
  left.

  eapply nth_firstIndexOf; trivial.

  unfold rndListElem in *.
  repeat simp_in_support.
  discriminate.

  eapply nth_option_In; eauto.

  Grab Existential Variables.
  apply O.
  unfold eq_dec.
  eapply (EqDec_dec eqd).
Qed.

Theorem nth_firstIndexOf_if :
  forall (A : Set)(eqd : eq_dec A)(ls : list A) n a,
    nth_option ls n = Some a ->
    NoDup ls ->
    firstIndexOf eqd ls a 0 = n.

  induction ls; intuition; simpl in *.
  discriminate.
  inversion H0; clear H0; subst.
  destruct n.
  inversion H; clear H; subst.
  destruct (eqd a0 a0); subst; intuition.

  destruct (eqd a0 a); subst; intuition.
  exfalso.
  eapply H3.

  eapply nth_option_In.
  eauto.

Qed.

Theorem nth_option_some :
  forall (A : Set)(ls : list A) n,
    n < length ls ->
    exists a, nth_option ls n = Some a.

  induction ls; intuition; simpl in *.
  omega.

  destruct n.
  econstructor; eauto.

  destruct (IHls n).
  omega.

  econstructor; eauto.

Qed.

Theorem rndListElem_support_None :
  forall (A : Set) eqd (ls : list A),
    In None (getSupport (rndListElem eqd ls)) <->
    ls = nil.

  intuition.
  unfold rndListElem in *.
  case_eq (length ls); intuition.
  destruct ls; simpl in *; trivial; discriminate.

  rewrite H0 in H.
  repeat simp_in_support.
  apply RndNat_support_lt in H1.

  edestruct (nth_option_some ls); eauto.
  rewrite H0.
  eauto.
  congruence.

  subst.
  simpl.
  intuition.

Qed.

Theorem rndListElem_uniform :
  forall (A : Set)(eqd : EqDec A)(ls : list A)(a1 a2 : option A),
    NoDup ls ->
    In a1 (getSupport (rndListElem _ ls)) ->
    In a2 (getSupport (rndListElem _ ls)) ->
    evalDist (rndListElem _ ls) a1 ==
    evalDist (rndListElem _ ls) a2.

  intuition.

  destruct a1.
  destruct a2.

  rewrite <- rndListElem_support in *.

  unfold rndListElem.
  case_eq (length ls); intuition.
  destruct ls; simpl in *. intuition. omega.

  eapply comp_spec_impl_eq.

  eapply comp_spec_seq.
  apply (Some a).
  apply (Some a).
  eapply eq_impl_comp_spec.
  eapply well_formed_RndNat.
  omega.
  eapply well_formed_RndNat.
  omega.
  eapply RndNat_uniform.
  3:{
    intros.
    simpl in H5.

    eapply comp_spec_ret.
    assert (a1 = (firstIndexOf (EqDec_dec _) ls a 0) <->
      b = (firstIndexOf (EqDec_dec _) ls a0 0)).
    eapply H5.
    clear H5.
    intuition; subst.

    rewrite H5.
    eapply nth_firstIndexOf; trivial.

    symmetry.
    eapply nth_firstIndexOf_if; intuition.

    rewrite H7.
    eapply nth_firstIndexOf; trivial.
    symmetry.
    eapply nth_firstIndexOf_if; intuition.
  }

  rewrite <- H2.
  apply firstIndexOf_in_lt; trivial.

  rewrite <- H2.
  apply firstIndexOf_in_lt; trivial.

  apply rndListElem_support in H0.

  apply rndListElem_support_None in H1.
  subst.
  simpl in *.
  intuition.

  destruct a2.
  apply rndListElem_support in H1.
  apply rndListElem_support_None in H0.
  subst.
  simpl in *.
  intuition.

  intuition.

Qed.

Lemma not_in_nth_option :
  forall (A : Set)(ls : list A)(a : A)(i : nat),
    (~In a ls) ->
    nth_option ls i = Some a ->
    False.

  induction ls; intuition; simpl in *.
  discriminate.

  destruct i.
  inversion H0; clear H0; subst.
  intuition.

  eapply IHls; eauto.

Qed.

Theorem nth_firstIndexOf_None :
  forall (A : Set)(eqd : eq_dec A)(ls : list A),
    NoDup ls ->
    forall (a a' : A) i,
    In a ls ->
    i <> firstIndexOf eqd ls a O ->
    nth_option ls i = Some a' ->
    a <> a'.

  induction 1; intuition; simpl in *.
  intuition; subst.
  destruct (eqd a' a'); subst; intuition.

  destruct i; intuition.

  eapply not_in_nth_option; eauto.

  destruct i; intuition.
  inversion H3; clear H3; subst.
  destruct (eqd a' a'); subst; intuition.

  destruct (eqd a' x); subst; intuition.
  eapply IHNoDup; eauto.
Qed.

Lemma nth_option_not_None :
  forall (A : Set)(ls : list A)(i : nat),
    i < length ls ->
    nth_option ls i = None ->
    False.

  induction ls; intuition; simpl in *.
  omega.

  destruct i.
  discriminate.
  assert (i < length ls).
  omega.
  eauto.

Qed.

Theorem rndListElem_uniform_gen :
  forall (A B : Set)(eqda : EqDec A)(eqdb : EqDec B)(ls1 : list A)(ls2 : list B)(a1 :  A)(a2 : B),
    NoDup ls1 ->
    NoDup ls2 ->
    length ls1 = length ls2 ->
    In a1 ls1 ->
    In a2 ls2 ->
    comp_spec
      (fun x y => x = Some a1 <-> y = Some a2)
      (rndListElem _ ls1) (rndListElem _ ls2).

  intuition.

  unfold rndListElem.
  case_eq (length ls1); intuition.
  rewrite <- H1.
  rewrite H4.

  eapply comp_spec_ret; intuition.
  discriminate.
  discriminate.

  rewrite <- H1.
  rewrite H4.

  eapply comp_spec_seq; try eapply None.
  eapply eq_impl_comp_spec.
  eapply well_formed_RndNat; omega.
  eapply well_formed_RndNat; omega.
  eapply (@RndNat_uniform  (firstIndexOf (EqDec_dec _) ls1 a1 O) (firstIndexOf (EqDec_dec _) ls2 a2 O)).

  rewrite <- H4.
  apply firstIndexOf_in_lt; trivial.
  rewrite <- H4.
  rewrite H1.
  apply firstIndexOf_in_lt; trivial.

  intuition.
  eapply comp_spec_ret.
  intuition.

  destruct (eq_nat_dec a (firstIndexOf (EqDec_dec _) ls1 a1 O)).
  subst.
  assert (b = firstIndexOf (EqDec_dec _) ls2 a2 0); intuition.
  subst.
  repeat rewrite nth_firstIndexOf; intuition.

  assert (b <> firstIndexOf (EqDec_dec _) ls2 a2 0).
  intuition.

  exfalso.
  eapply nth_firstIndexOf_None.
  eapply H.
  eapply H2.
  eapply n0.
  eauto.
  intuition.

  destruct (eq_nat_dec a (firstIndexOf (EqDec_dec _) ls1 a1 O)).
  subst.
  assert (b = firstIndexOf (EqDec_dec _) ls2 a2 0); intuition.
  subst.
  repeat rewrite nth_firstIndexOf; intuition.

  assert (b <> firstIndexOf (EqDec_dec _) ls2 a2 0).
  intuition.

  exfalso.
  eapply nth_firstIndexOf_None.
  eapply H0.
  eapply H3.
  eapply H10.
  eauto.
  intuition.
Qed.

Theorem rndListElem_support_exists :
  forall (A : Set)(eqd : EqDec A)(ls : list A),
    exists x,
      In x (getSupport (rndListElem eqd ls)).

  destruct ls; intuition.
  econstructor.
  left.
  eauto.

  unfold rndListElem.
  unfold length.
  econstructor.
  eapply getSupport_In_Seq.

  eapply (@in_getSupport_RndNat O).
  omega.
  simpl.
  intuition.
Qed.

    (*

    Theorem rndListElem_uniform_remove_eq :
      forall (A : Set)(eqd : EqDec A)(ls : list A)(a1 a2 : A),
        NoDup ls ->
        evalDist (rndListElem _ (removeFirst (EqDec_dec _) ls a1)) (Some a1) == 0.

      intuition.
      eapply getSupport_not_In_evalDist.
      intuition.
      rewrite <- rndListElem_support in H0.
      eapply removeFirst_NoDup_not_in; eauto.
    Qed.

    Notation "$ c1 " := (rndListElem _ c1%comp)
                          (right associativity, at level 89, c1 at next level) : comp_scope.

 Theorem rndListElem_support_exists :
      forall (A : Set)(eqd : EqDec A)(ls : list A),
        exists x,
          In x (getSupport (rndListElem eqd ls)).

      destruct ls; intuition.
      econstructor.
      left.
      eauto.

      unfold rndListElem.
      unfold length.
      econstructor.
      eapply getSupport_In_Seq.

      eapply (@in_getSupport_RndNat O).
      omega.
      simpl.
      intuition.
    Qed.

*)