Require Import rt.util.all.
Require Import rt.model.arrival.basic.task rt.model.priority rt.model.schedule.global.workload.
Require Import rt.model.schedule.global.jitter.job rt.model.schedule.global.jitter.schedule.
From mathcomp Require Import ssreflect ssrbool eqtype ssrnat seq fintype bigop.

Module Interference.

  Import ScheduleOfSporadicTaskWithJitter Priority Workload.

  (* We import some of the basic definitions, but we need to re-define almost everything
     since the definition of backlogged (and thus the definition of interference)
     changes with jitter. *)
  Require Import rt.model.schedule.global.basic.interference.
  Export Interference.

  Section InterferenceDefs.

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

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

    (* ... and any schedule of those jobs. *)
    Context {num_cpus: nat}.
    Variable sched: schedule Job num_cpus.

    (* Consider any job j that incurs interference. *)
    Variable j: Job.

    (* Recall the definition of backlogged (pending and not scheduled). *)
    Let job_is_backlogged := backlogged job_arrival job_cost job_jitter sched j.

    (* First, we define total interference. *)
    Section TotalInterference.

      (* The total interference incurred by job j during [t1, t2) is the
         cumulative time in which j is backlogged in this interval. *)
      Definition total_interference (t1 t2: time) :=
        \sum_(t1 <= t < t2) job_is_backlogged t.

    End TotalInterference.

    (* Next, we define job interference. *)
    Section JobInterference.

      (* Let job_other be a job that interferes with j. *)
      Variable job_other: Job.

      (* The interference caused by job_other during [t1, t2) is the cumulative
         time in which j is backlogged while job_other is scheduled. *)
      Definition job_interference (t1 t2: time) :=
        \sum_(t1 <= t < t2)
          \sum_(cpu < num_cpus)
            (job_is_backlogged t &&
            scheduled_on sched job_other cpu t).

    End JobInterference.

    (* Next, we define task interference. *)
    Section TaskInterference.

      (* In order to define task interference, consider any interfering task tsk_other. *)
      Variable tsk_other: sporadic_task.

      (* The interference caused by tsk during [t1, t2) is the cumulative time
         in which j is backlogged while tsk is scheduled. *)
      Definition task_interference (t1 t2: time) :=
        \sum_(t1 <= t < t2)
          \sum_(cpu < num_cpus)
            (job_is_backlogged t &&
            task_scheduled_on job_task sched tsk_other cpu t).

    End TaskInterference.

    (* Next, we define an approximation of the total interference based on
       each per-task interference. *)
    Section TaskInterferenceJobList.

      Variable tsk_other: sporadic_task.

      Definition task_interference_joblist (t1 t2: time) :=
        \sum_(j <- jobs_scheduled_between sched t1 t2 | job_task j == tsk_other)
         job_interference j t1 t2.

    End TaskInterferenceJobList.

    (* Now we prove some basic lemmas about interference. *)
    Section BasicLemmas.

      (* First, we show that total interference cannot be larger than the interval length. *)
      Lemma total_interference_le_delta :
        forall t1 t2,
          total_interference t1 t2 <= t2 - t1.
      Proof.
        unfold total_interference; intros t1 t2.
        apply leq_trans with (n := \sum_(t1 <= t < t2) 1);
          first by apply leq_sum; ins; apply leq_b1.
        by rewrite big_const_nat iter_addn mul1n addn0 leqnn.
      Qed.

      (* Next, we prove that job interference is bounded by the service of the interfering job. *)
      Lemma job_interference_le_service :
        forall j_other t1 t2,
          job_interference j_other t1 t2 <= service_during sched j_other t1 t2.
      Proof.
        intros j_other t1 t2; unfold job_interference, service_during.
        apply leq_sum; intros t _.
        unfold service_at; rewrite [\sum_(_ < _ | scheduled_on _ _ _  _)_]big_mkcond.
        apply leq_sum; intros cpu _.
        destruct (job_is_backlogged t); [rewrite andTb | by rewrite andFb].
        by destruct (scheduled_on sched j_other cpu t).
      Qed.

      (* We also prove that task interference is bounded by the workload of the interfering task. *)
      Lemma task_interference_le_workload :
        forall tsk t1 t2,
          task_interference tsk t1 t2 <= workload job_task sched tsk t1 t2.
      Proof.
        unfold task_interference, workload; intros tsk t1 t2.
        apply leq_sum; intros t _.
        apply leq_sum; intros cpu _.
        destruct (job_is_backlogged t); [rewrite andTb | by rewrite andFb].
        unfold task_scheduled_on, service_of_task.
        by destruct (sched cpu t).
      Qed.

    End BasicLemmas.

    (* Now we prove some bounds on interference for sequential jobs. *)
    Section InterferenceSequentialJobs.

      (* If jobs are sequential, ... *)
      Hypothesis H_sequential_jobs: sequential_jobs sched.

      (* ... then the interference incurred by a job in an interval
         of length delta is at most delta. *)
      Lemma job_interference_le_delta :
        forall j_other t1 delta,
          job_interference j_other t1 (t1 + delta) <= delta.
      Proof.
        rename H_sequential_jobs into SEQ.
        unfold job_interference, sequential_jobs in *.
        intros j_other t1 delta.
        apply leq_trans with (n := \sum_(t1 <= t < t1 + delta) 1);
          last by rewrite big_const_nat iter_addn mul1n addn0 addKn leqnn.
        apply leq_sum; intros t _.
        destruct ([exists cpu, scheduled_on sched j_other cpu t]) eqn:EX.
        {
          move: EX => /existsP [cpu SCHED].
          rewrite (bigD1 cpu) // /=.
          rewrite big_mkcond (eq_bigr (fun x => 0)) /=;
            first by simpl_sum_const; rewrite leq_b1.
          intros cpu' _; des_if_goal; last by done.
          destruct (scheduled_on sched j_other cpu' t) eqn:SCHED'; last by rewrite andbF.
          move: SCHED SCHED' => /eqP SCHED /eqP SCHED'.
          by specialize (SEQ j_other t cpu cpu' SCHED SCHED'); rewrite SEQ in Heq.
        }
        {
          apply negbT in EX; rewrite negb_exists in EX.
          move: EX => /forallP EX.
          rewrite (eq_bigr (fun x => 0)); first by simpl_sum_const.
          by intros cpu _; specialize (EX cpu); apply negbTE in EX; rewrite EX andbF.
        }
      Qed.

    End InterferenceSequentialJobs.

    (* Next, we show that the cumulative per-task interference bounds the total
       interference. *)
    Section BoundUsingPerJobInterference.

      Lemma interference_le_interference_joblist :
        forall tsk t1 t2,
          task_interference tsk t1 t2 <= task_interference_joblist tsk t1 t2.
      Proof.
        intros tsk t1 t2.
        unfold task_interference, task_interference_joblist, job_interference, job_is_backlogged.
        rewrite [\sum_(_ <- _ sched _ _ | _) _]exchange_big /=.
        rewrite big_nat_cond [\sum_(_ <= _ < _ | true) _]big_nat_cond.
        apply leq_sum; move => t /andP [LEt _].
        rewrite exchange_big /=.
        apply leq_sum; intros cpu _.
        destruct (backlogged job_arrival job_cost job_jitter sched j t) eqn:BACK;
          last by rewrite andFb (eq_bigr (fun x => 0));
            first by rewrite big_const_seq iter_addn mul0n addn0.
        rewrite andTb.
        destruct (task_scheduled_on job_task sched tsk cpu t) eqn:SCHED; last by done.
        unfold scheduled_on, task_scheduled_on in *.
        destruct (sched cpu t) as [j' |] eqn:SOME; last by done.
        rewrite big_mkcond /= (bigD1_seq j') /=; last by apply undup_uniq.
        {
          by rewrite SCHED eq_refl.
        }
        {
          unfold jobs_scheduled_between.
          rewrite mem_undup; apply mem_bigcat_nat with (j := t);
            first by done.
          apply mem_bigcat_ord with (j := cpu); first by apply ltn_ord.
          by unfold make_sequence; rewrite SOME mem_seq1 eq_refl.
        }
      Qed.

    End BoundUsingPerJobInterference.

  End InterferenceDefs.

End Interference.


Require Export DataTypes.
Open Scope list_scope.
(*TODO rename *)

(* Binary fields arithmetics *)
Definition B_add (x y : N) : N :=
  N.lxor x y.
Open Scope positive_scope.
Fixpoint B_mod_pos (x y : positive)(ly : nat) : N :=
  match x with
  | 1 =>
    match y with
    | 1 => 0
    | _ => 1
    end
  | p~0 | p~1 =>
      let r'2 := N.double (B_mod_pos p y ly) in
      let r := if even (Npos x) then r'2 else (r'2 + 1)%N in
      if (Nat.eqb (size_nat r) ly) then B_add r (Npos y) else r
  end.

Definition B_mod (x y : N) : N :=
  match x, y with
  | N0, _ => N0
  | _, N0 => x
  | pos xp, pos yp =>
      B_mod_pos xp yp (size_nat y)
  end.

Fixpoint Bp_mul_pos (x : positive)(y : N) : N :=
  match x with
  | 1 => y
  | p~0 => N.double (Bp_mul_pos p y)
  | p~1 => B_add y (N.double (Bp_mul_pos p y))
  end.

Close Scope positive_scope.

(* Polynomial Base *)
Definition Bp_mul_raw (x y : N) : N :=
  match x with
  | N0 => N0
  | Npos p => Bp_mul_pos p y
  end.

Definition Bp_mul (gp x y : N) : N :=
  B_mod (Bp_mul_raw x y) gp.

(* TODO Consider speeding up *)
Definition Bp_sq_raw (x : N) :=
  Bp_mul_raw x x.

Definition Bp_sq (gp x : N) :=
  Bp_mul gp x x.

(* cube *)
Definition Bp_cb (gp x : N) :=
  Bp_mul gp x (Bp_sq gp x).

(* Polynomial Base *)
(*Definition Bp_pow (m : N)(gp : N)(g : N)(a : N) : N :=
  power_general g a (N.shiftl 1 m)(Bp_sq gp)(Bp_mul gp).

Definition Bp_inv (m gp g : N) : N :=
  Bp_pow m gp g ((N.shiftl 1 m) - 2).

Definition Bp_div (m gp x y : N) : N :=
  Bp_mul gp x (Bp_inv m gp y). *)

(*Lemma id0_inrng (po : prime_order) : 0 < order po.
Proof.
destruct po as [p H].
simpl. inversion H.
assert (h : 0 < 3). { reflexivity. }
apply (lt_trans 0 3 p h (gt_lt p 3 H)).
Qed.

Lemma id1_inrng (po : prime_order) : 1 < order po.
Proof.
destruct po as [p H].
simpl. inversion H.
assert (h : 1 < 3). { reflexivity. }
apply (lt_trans 1 3 p h (gt_lt p 3 H)).
Qed.

Definition id0_builder_pf (po : prime_order) : Fpe po :=
  mkFpe po 0 (id0_inrng po).

Definition id1_builder_pf (po : prime_order) : Fpe po :=
  mkFpe po 1 (id1_inrng po).
  *)


(*************************************************************)
(*   Copyright Dominique Larchey-Wendling [*]                 *)
(*                                                            *)
(*                             [*] Affiliation LORIA -- CNRS  *)
(*************************************************************)
(*      This file is distributed under the terms of the       *)
(*         CeCILL v2 FREE SOFTWARE LICENSE AGREEMENT          *)
(*************************************************************)

(* ** Object-level encoding of exponential *)

Require Import Arith ZArith List.

From Undecidability.Shared.Libs.DLW.Utils
  Require Import utils_tac sums rel_iter gcd.

From Undecidability.H10.Matija
  Require Import alpha expo_diophantine.

From Undecidability.H10.Dio
  Require Import dio_logic.

Set Implicit Arguments.

Local Notation power := (mscal mult 1).
Local Notation expo := (mscal mult 1).

(* Here one can witness how workable is automation of recognition
    of Diophantine shapes.

    Notice that alpha_conditions below could probably be optimized
    from the new Diophantine shapes that include Diophantine
    functions. *)

Local Notation "x ≐ ⌞ n ⌟" := (df_cst x n)
      (at level 49, no associativity, format "x  ≐  ⌞ n ⌟").
Local Notation "x ≐ y" := (df_eq x y)
      (at level 49, no associativity, format "x  ≐  y").
Local Notation "x ≐ y ⨢ z" := (df_add x y z)
      (at level 49, no associativity, y at next level, format "x  ≐  y  ⨢  z").
Local Notation "x ≐ y ⨰ z" := (df_mul x y z)
      (at level 49, no associativity, y at next level, format "x  ≐  y  ⨰  z").

Theorem dio_rel_alpha a b c : 𝔻F a -> 𝔻F b -> 𝔻F c
                           -> 𝔻R (fun ν => 3 < b ν /\ a ν = alpha_nat (b ν) (c ν)).
Proof.
  dio by lemma (fun v => alpha_diophantine (a v) (b v) (c v)).
Defined.

#[export] Hint Resolve dio_rel_alpha : dio_rel_db.

Local Fact dio_rel_alpha_example : 𝔻R (fun ν => 3 < ν 1 /\ ν 0 = alpha_nat (ν 1) (ν 2)).
Proof. dio auto. Defined.

(* Eval compute in df_size_Z (proj1_sig dio_rel_alpha_example). *)

Fact dio_rel_alpha_size : df_size_Z (proj1_sig dio_rel_alpha_example) = 1445%Z.
Proof. reflexivity. Qed.

(* This is Matiyasevich theorem stating that q^r is a Diophantine function.

    Notice that expo_conditions below could also probably be optimized *)

Theorem dio_fun_expo q r : 𝔻F q -> 𝔻F r -> 𝔻F (fun ν => expo (r ν) (q ν)).
Proof.
  dio by lemma (fun v => expo_diophantine (v 0) (q v⭳) (r v⭳)).
Defined.

#[export] Hint Resolve dio_fun_expo : dio_fun_db.

Local Fact dio_fun_expo_example : 𝔻F (fun ν => expo (ν 0) (ν 1)).
Proof. dio auto. Defined.

(* Eval compute in df_size_Z (proj1_sig dio_fun_expo_example). *)

(* The new Diophantine shapes (w/o build-in polynimoals)
   build formulas that are a bit bigger ... *)

Local Fact dio_fun_expo_example_size : df_size_Z (proj1_sig dio_fun_expo_example) = 4903%Z.
Proof. reflexivity. Qed.

(* We use the exponantial to characterize digits *)

(* The is_digit c q i y relation stating that

       "y is the i-th digit of c is base q"
 *)

Local Fact is_digit_eq c q i y :
            is_digit c q i y
        <-> y < q
         /\ exists a b p, c = (a*q+y)*p+b
                       /\ b < p
                       /\ p = power i q.
Proof.
  split; intros (H1 & a & b & H2).
  + split; auto; exists a, b, (power i q); repeat split; tauto.
  + destruct H2 as (p & H2 & H3 & H4).
    split; auto; exists a, b; subst; auto.
Qed.

Lemma dio_rel_is_digit c q i y : 𝔻F c -> 𝔻F q -> 𝔻F i -> 𝔻F y
                              -> 𝔻R (fun ν => is_digit (c ν) (q ν) (i ν) (y ν)).
Proof.
  dio by lemma (fun ν => is_digit_eq (c ν) (q ν) (i ν) (y ν)).
Defined.

#[export] Hint Resolve dio_rel_is_digit : dio_rel_db.

Local Fact dio_rel_is_digit_example : 𝔻R (fun ν => is_digit (ν 0) (ν 1) (ν 2) (ν 3)).
Proof. dio auto. Defined.

(* Check dio_rel_is_digit_example. *)
(* Eval compute in df_size_Z (proj1_sig dio_rel_is_digit_example). *)


From Test Require Import tactic.

Section FOFProblem.

Variable Universe : Set.
Variable UniverseElement : Universe.

Variable par_ : Universe -> Universe -> Universe -> Universe -> Prop.
Variable pG_ : Universe -> Universe -> Universe -> Universe -> Prop.
Variable eF_ : Universe -> Universe -> Universe -> Universe -> Universe -> Universe -> Universe -> Universe -> Prop.
Variable cong_3_ : Universe -> Universe -> Universe -> Universe -> Universe -> Universe -> Prop.
Variable congA_ : Universe -> Universe -> Universe -> Universe -> Universe -> Universe -> Prop.
Variable cong_ : Universe -> Universe -> Universe -> Universe -> Prop.
Variable col_ : Universe -> Universe -> Universe -> Prop.
Variable betS_ : Universe -> Universe -> Universe -> Prop.

Variable defparallelogram_1 : (forall A B C D : Universe, (pG_ A B C D -> (par_ A B C D /\ par_ A D B C))).
Variable defparallelogram2_2 : (forall A B C D : Universe, ((par_ A B C D /\ par_ A D B C) -> pG_ A B C D)).
Variable proposition_34_3 : (forall A B C D : Universe, (pG_ A C D B -> (cong_ A B C D /\ (cong_ A C B D /\ (congA_ C A B B D C /\ (congA_ A B D D C A /\ cong_3_ C A B B D C)))))).
Variable lemma_congruencesymmetric_4 : (forall A B C D : Universe, (cong_ B C A D -> cong_ A D B C)).
Variable lemma_congruencetransitive_5 : (forall A B C D E F : Universe, ((cong_ A B C D /\ cong_ C D E F) -> cong_ A B E F)).
Variable lemma_parallelsymmetric_6 : (forall A B C D : Universe, (par_ A B C D -> par_ C D A B)).
Variable lemma_parallelNC_7 : (forall A B C D : Universe, (par_ A B C D -> (~(col_ A B C) /\ (~(col_ A C D) /\ (~(col_ B C D) /\ ~(col_ A B D)))))).
Variable lemma_NCdistinct_8 : (forall A B C : Universe, (~(col_ A B C) -> (A <> B /\ (B <> C /\ (A <> C /\ (B <> A /\ (C <> B /\ C <> A))))))).
Variable axiom_nocollapse_9 : (forall A B C D : Universe, ((A <> B /\ cong_ A B C D) -> C <> D)).
Variable lemma_collinearparallel2_10 : (forall A B C D E F : Universe, ((par_ A B C D /\ (col_ C D E /\ (col_ C D F /\ E <> F))) -> par_ A B E F)).
Variable proposition_33_11 : (forall A B C D M : Universe, ((par_ A B C D /\ (cong_ A B C D /\ (betS_ A M D /\ betS_ B M C))) -> (par_ A C B D /\ cong_ A C B D))).
Variable lemma_parallelflip_12 : (forall A B C D : Universe, (par_ A B C D -> (par_ B A C D /\ (par_ A B D C /\ par_ B A D C)))).
Variable proposition_35_13 : (forall A B C D E F : Universe, ((pG_ A B C D /\ (pG_ E B C F /\ (col_ A D E /\ col_ A D F))) -> eF_ A B C D E B C F)).
Variable lemma_PGsymmetric_14 : (forall A B C D : Universe, (pG_ A B C D -> pG_ C D A B)).
Variable lemma_inequalitysymmetric_15 : (forall A B : Universe, (A <> B -> B <> A)).
Variable lemma_collinear4_16 : (forall A B C D : Universe, ((col_ A B C /\ (col_ A B D /\ A <> B)) -> col_ B C D)).
Variable lemma_collinearorder_17 : (forall A B C : Universe, (col_ A B C -> (col_ B A C /\ (col_ B C A /\ (col_ C A B /\ (col_ A C B /\ col_ C B A)))))).
Variable axiom_EFpermutation_18 : (forall A B C D Ca Cb Cc Cd : Universe, (eF_ A B C D Ca Cb Cc Cd -> (eF_ A B C D Cb Cc Cd Ca /\ (eF_ A B C D Cd Cc Cb Ca /\ (eF_ A B C D Cc Cd Ca Cb /\ (eF_ A B C D Cb Ca Cd Cc /\ (eF_ A B C D Cd Ca Cb Cc /\ (eF_ A B C D Cc Cb Ca Cd /\ eF_ A B C D Ca Cd Cc Cb)))))))).
Variable axiom_EFsymmetric_19 : (forall A B C D Ca Cb Cc Cd : Universe, (eF_ A B C D Ca Cb Cc Cd -> eF_ Ca Cb Cc Cd A B C D)).
Variable axiom_EFtransitive_20 : (forall A B C D P Q R S Ca Cb Cc Cd : Universe, ((eF_ A B C D Ca Cb Cc Cd /\ eF_ Ca Cb Cc Cd P Q R S) -> eF_ A B C D P Q R S)).

Theorem proposition_36A_21 : (forall A B C D E F G H M : Universe, ((pG_ A B C D /\ (pG_ E F G H /\ (col_ A D E /\ (col_ A D H /\ (col_ B C F /\ (col_ B C G /\ (cong_ B C F G /\ (betS_ B M H /\ betS_ C M E)))))))) -> eF_ A B C D E F G H)).
Proof.
  time tac.
Qed.

End FOFProblem.


Require Import init.

Require Export nat_base.
Require Import nat_plus.
Require Import nat_mult.

Require Export order_plus.
Require Export order_mult.
Require Export order_bounds.
Require Export set_order.

Global Instance nat_order : Order nat := {
    le := fix le a b :=
        match a with
        | nat_suc a' =>
            match b with
            | nat_suc b' => le a' b'
            | nat_zero => False
            end
        | nat_zero => True
        end
}.

Definition nat_to_set_type n := set_type (initial_segment n).

Theorem nat_neg_eq : ∀ {a}, a ≤ 0 → 0 = a.
Proof.
    intros a eq.
    nat_destruct a; [>reflexivity|].
    contradiction eq.
Qed.
Lemma nat_pos : ∀ a, 0 ≤ a.
Proof.
    intros a.
    exact true.
Qed.
Theorem nat_pos2 : ∀ n, 0 < nat_suc n.
Proof.
    intros n.
    split; [>apply nat_pos|].
    intro contr.
    exact (nat_zero_suc contr).
Qed.
Lemma nat_neg : ∀ {n}, ¬(nat_suc n ≤ 0).
Proof.
    intros n contr.
    apply nat_neg_eq in contr.
    contradiction (nat_zero_suc contr).
Qed.
Lemma nat_neg2 : ∀ {a}, ¬(a < 0).
Proof.
    intros a [leq neq].
    apply nat_neg_eq in leq.
    symmetry in leq; contradiction.
Qed.

Definition nat_lt_0_false (a : nat_to_set_type 0) := nat_neg2 [|a].

Theorem nat_one_pos : 0 < 1.
Proof.
    apply nat_pos2.
Qed.

Theorem nat_sucs_le : ∀ a b, nat_suc a ≤ nat_suc b ↔ a ≤ b.
Proof.
    intros a b.
    split; intro eq; exact eq.
Qed.
Theorem nat_sucs_lt : ∀ a b, nat_suc a < nat_suc b ↔ a < b.
Proof.
    intros a b.
    unfold strict.
    rewrite nat_sucs_le.
    rewrite nat_suc_eq.
    reflexivity.
Qed.

Global Instance nat_le_connex : Connex le.
Proof.
    split.
    intros a.
    nat_induction a; intros b.
    -   left.
        apply nat_pos.
    -   nat_destruct b.
        +   right.
            apply nat_pos.
        +   apply or_to_strong.
            do 2 rewrite nat_sucs_le.
            apply or_from_strong.
            apply IHa.
Qed.

Global Instance nat_le_antisymmetric : Antisymmetric le.
Proof.
    split.
    intros a.
    nat_induction a; intros b eq1 eq2.
    -   exact (nat_neg_eq eq2).
    -   nat_destruct b.
        +   contradiction eq1.
        +   apply f_equal.
            rewrite nat_sucs_le in eq1, eq2.
            apply IHa; assumption.
Qed.

Global Instance nat_le_transitive : Transitive le.
Proof.
    split.
    intros a b c; revert a b.
    nat_induction c; intros a b eq1 eq2.
    -   apply nat_neg_eq in eq2.
        rewrite <- eq2 in eq1.
        exact eq1.
    -   nat_destruct b.
        +   apply nat_neg_eq in eq1.
            rewrite <- eq1.
            apply nat_pos.
        +   nat_destruct a.
            *   apply nat_pos.
            *   rewrite nat_sucs_le in *.
                apply IHc with b; assumption.
Qed.

Theorem nat_le_suc : ∀ a, a ≤ nat_suc a.
Proof.
    nat_induction a.
    -   apply nat_one_pos.
    -   rewrite nat_sucs_le.
        exact IHa.
Qed.
Theorem nat_lt_suc : ∀ a, a < nat_suc a.
Proof.
    nat_induction a.
    -   exact nat_one_pos.
    -   rewrite nat_sucs_lt.
        exact IHa.
Qed.

Theorem nat_le_ex : ∀ {a b}, a ≤ b → ∃ c, a + c = b.
Proof.
    nat_induction a; intros b ab.
    -   exists b.
        apply plus_lid.
    -   nat_destruct b.
        +   contradiction (nat_neg ab).
        +   rewrite nat_sucs_le in ab.
            specialize (IHa b ab) as [c IHa].
            exists c.
            rewrite nat_plus_lsuc.
            apply f_equal.
            exact IHa.
Qed.

Theorem nat_lt_ex : ∀ {a b}, a < b → ∃ c, a + nat_suc c = b.
Proof.
    intros a b [ab ab_neq].
    pose proof (nat_le_ex ab) as [c eq].
    nat_destruct c.
    -   rewrite plus_rid in eq.
        contradiction.
    -   exists c.
        exact eq.
Qed.

Global Instance nat_le_lplus : OrderLplus nat.
Proof.
    split.
    intros a b c ab.
    nat_induction c.
    -   do 2 rewrite plus_lid.
        exact ab.
    -   do 2 rewrite nat_plus_lsuc.
        rewrite nat_sucs_le.
        exact IHc.
Qed.

Global Instance nat_le_plus_lcancel : OrderPlusLcancel nat.
Proof.
    split.
    intros a b c eq.
    nat_induction c.
    -   do 2 rewrite plus_lid in eq.
        exact eq.
    -   apply IHc.
        do 2 rewrite nat_plus_lsuc in eq.
        rewrite nat_sucs_le in eq.
        exact eq.
Qed.

Global Instance nat_le_mult : OrderMult nat.
Proof.
    split.
    intros.
    apply nat_pos.
Qed.

Theorem nat_le_lmult : ∀ {a b} c, a ≤ b → c * a ≤ c * b.
Proof.
    intros a b c ab.
    nat_induction c.
    -   do 2 rewrite mult_lanni.
        apply refl.
    -   do 2 rewrite nat_mult_lsuc.
        exact (le_lrplus ab IHc).
Qed.

Global Instance nat_le_lmult_class : OrderLmult nat.
Proof.
    split.
    intros a b c c_pos.
    apply nat_le_lmult.
Qed.

Theorem nat_le_rmult : ∀ {a b} c, a ≤ b → a * c ≤ b * c.
Proof.
    intros a b c.
    apply le_rmult_pos.
    apply nat_pos.
Qed.

Theorem nat_le_mult_lcancel : ∀ {a b} c, 0 ≠ c → c * a ≤ c * b → a ≤ b.
Proof.
    intros a b c c_neq eq.
    nat_destruct c; [>contradiction|]; clear c_neq.
    revert b eq.
    nat_induction a; intros b eq.
    -   apply nat_pos.
    -   nat_destruct b.
        +   exfalso.
            rewrite mult_ranni in eq.
            apply nat_neg_eq in eq.
            exact (nat_neq_suc_mult _ _ eq).
        +   rewrite nat_sucs_le.
            apply IHa; clear IHa.
            do 2 rewrite nat_mult_rsuc in eq.
            apply le_plus_lcancel in eq.
            exact eq.
Qed.

Global Instance nat_le_mult_lcancel_class : OrderMultLcancel nat.
Proof.
    split.
    intros a b c [C c_pos].
    apply nat_le_mult_lcancel.
    exact c_pos.
Qed.

Theorem nat_le_mult_rcancel : ∀ {a b} c, 0 ≠ c → a * c ≤ b * c → a ≤ b.
Proof.
    intros a b c c_pos.
    apply le_mult_rcancel_pos.
    split; [>apply nat_pos|exact c_pos].
Qed.

Theorem nat_lt_suc_le : ∀ {a b}, a < nat_suc b ↔ a ≤ b.
Proof.
    intros a b.
    split.
    -   revert b.
        nat_induction a; intros b eq.
        +   apply nat_pos.
        +   rewrite nat_sucs_lt in eq.
            nat_destruct b.
            *   exfalso.
                exact (nat_neg2 eq).
            *   apply IHa.
                exact eq.
    -   intro eq.
        exact (le_lt_trans eq (nat_lt_suc b)).
Qed.
Theorem nat_le_suc_lt : ∀ {a b}, nat_suc a ≤ b ↔ a < b.
Proof.
    intros a b.
    nat_destruct b.
    -   split; intros contr.
        +   contradiction (nat_neg contr).
        +   contradiction (nat_neg2 contr).
    -   rewrite nat_sucs_le.
        symmetry.
        apply nat_lt_suc_le.
Qed.

Theorem nat_le_self_lplus : ∀ a b, a ≤ b + a.
Proof.
    intros a b.
    rewrite <- le_plus_0_a_b_ab.
    apply nat_pos.
Qed.
Theorem nat_le_self_rplus : ∀ a b, a ≤ a + b.
Proof.
    intros a b.
    rewrite plus_comm.
    apply nat_le_self_lplus.
Qed.

Theorem nat_lt_one_eq : ∀ n, n < 1 → 0 = n.
Proof.
    intros n n_lt.
    unfold one in n_lt; cbn in n_lt.
    rewrite nat_lt_suc_le in n_lt.
    apply nat_neg_eq in n_lt.
    exact n_lt.
Qed.

Theorem nat_le_self_lmult : ∀ a b, 0 ≠ b → a ≤ b * a.
Proof.
    intros a b b_nz.
    nat_induction a.
    -   rewrite mult_ranni.
        apply refl.
    -   rewrite nat_mult_rsuc.
        assert (1 ≤ b) as b_gt.
        {
            rewrite <- nlt_le.
            intro eq.
            apply nat_lt_one_eq in eq.
            contradiction.
        }
        exact (le_lrplus b_gt IHa).
Qed.
Theorem nat_le_self_rmult : ∀ a b, 0 ≠ b → a ≤ a * b.
Proof.
    intros a b.
    rewrite mult_comm.
    apply nat_le_self_lmult.
Qed.

Theorem nat_neq0_leq1 : ∀ {a}, 0 ≠ a → 1 ≤ a.
Proof.
    intros a a_neq.
    unfold one; cbn.
    rewrite nat_le_suc_lt.
    split.
    -   apply nat_pos.
    -   exact a_neq.
Qed.

Theorem strong_induction : ∀ S : nat → Prop,
    (∀ n, (∀ m, m < n → S m) → S n) → ∀ n, S n.
Proof.
    intros S ind n.
    pose (T n := ∀ m, m < n → S m).
    assert (∀ n', T n') as all_T.
    {
        nat_induction n'.
        -   unfold T.
            intros m m_lt.
            contradiction (nat_neg2 m_lt).
        -   unfold T in *.
            intros m m_lt.
            apply ind.
            intros m' m'_eq.
            apply IHn'.
            rewrite nat_lt_suc_le in m_lt.
            exact (lt_le_trans m'_eq m_lt).
    }
    apply ind.
    apply all_T.
Qed.

Global Instance nat_wo : WellOrdered le.
Proof.
    split.
    intros S [x Sx].
    classic_contradiction no_least.
    rewrite not_ex in no_least.
    assert (∀ x, ¬S x) as none.
    {
        clear x Sx.
        intros x.
        induction x using strong_induction.
        intros Sx.
        specialize (no_least x).
        rewrite not_and_impl, not_all in no_least.
        specialize (no_least Sx) as [a a_eq].
        apply not_impl in a_eq as [Sa a_eq].
        rewrite nle_lt in a_eq.
        exact (H _ a_eq Sa).
    }
    exact (none _ Sx).
Qed.

Definition subsequence_seq (f : sequence nat) := ∀ n, f n < f (nat_suc n).
Definition subsequence {U} (a b : sequence U) :=
    ∃ f : sequence nat,
        subsequence_seq f ∧
        (∀ n, a (f n) = b n).

Theorem subsequence_seq_leq : ∀ f, subsequence_seq f → ∀ n, n ≤ f n.
Proof.
    intros f f_sub.
    unfold subsequence_seq in f_sub.
    intros n.
    nat_induction n.
    -   apply nat_pos.
    -   rewrite <- nat_lt_suc_le.
        rewrite nat_sucs_lt.
        exact (le_lt_trans IHn (f_sub n)).
Qed.


Require Import List Lia.

From Undecidability.Shared.Libs.DLW.Utils
  Require Import utils_tac utils_nat.

From Undecidability.Shared.Libs.DLW.Vec
  Require Import pos vec.

From Undecidability.H10
  Require Import Dio.dio_single H10 Diophantine.

From Undecidability.MuRec.Util
  Require Import recalg ra_dio_poly MuRec_computable ra_sem_eq ra_recomp.

Set Default Goal Selector "!".
Set Default Proof Using "Type".

Lemma vec_pos_spec {X} {n} (v : Vector.t X n) (i : Fin.t n) :
  vec_pos v i = Vector.nth v i.
Proof.
  induction v; cbn; f_equal.
  - inversion i.
  - eapply (Fin.caseS' i); cbn; eauto.
Qed.

Fixpoint dio_move {k k'} (P : dio_polynomial (pos k) (pos (S k'))) : dio_polynomial (pos (S k)) (pos k') :=
  match P with
  | dp_nat n => dp_nat n
  | dp_var n => dp_var (Fin.FS n)
  | dp_par p => Fin.caseS' p _ (dp_var (Fin.F1)) dp_par
  | dp_comp op P1 P2 => dp_comp op (dio_move P1) (dio_move P2)
  end.

Lemma dio_move_spec {k k'} (P : dio_polynomial (pos k) (pos (S k'))) v w x :
  dp_eval (vec_pos (x ## v)) (vec_pos w) (dio_move P) =
  dp_eval (vec_pos v) (vec_pos (x ## w)) P.
Proof.
  induction P as [n | n | p | op P1 IH1 P2 IH2].
  - reflexivity.
  - reflexivity.
  - unfold dio_move. eapply (Fin.caseS' p); reflexivity.
  - cbn -[vec_pos]; destruct op; congruence.
Qed.

Theorem Diophantine_to_MuRec_computable {k} (R : Vector.t nat k -> nat -> Prop) :
  functional R ->
  Diophantine' R -> MuRec_computable R.
Proof.
  intros HR (k' & P1 & P2 & H).
  eapply (MuRec_computable_functional_iff _ HR).
  unshelve eexists.
  - eapply ra_comp. 1:  refine (ra_project (Fin.F1)).
    2: exact (ra_dio_poly_find (dio_move P1) (dio_move P2) ## vec_nil).
    exact k'.
  - split.
    + intros v m. specialize (H (Vector.cons _ m _ v)).
      cbn -[dp_eval Vector.nth] in H. rewrite H.
      rewrite <- ra_bs_correct, ra_rel_fix_comp. unfold s_comp.
      intros (vi & H1 & H2). revert H1 H2.
      eapply (Vector.caseS' vi). clear vi. intros im.
      refine (Vector.case0 _ _).
      intros Hproj Hfind. specialize (Hfind Fin.F1).

      cbn -[ra_dio_poly_find] in Hfind.
      eapply ra_dio_poly_find_spec_strong1 in Hfind.
      eapply ra_project_rel in Hproj. clear H. subst.
      pose (w := (recomp.project (S k') im)).
      exists (fun j => vec_pos w (Fin.FS j)).
      generalize (eq_refl w). unfold w at 1.
      eapply (Vector.caseS' w). clear w. intros x w Hw.
      rewrite Hw in Hfind. rewrite !dio_move_spec in Hfind.
      erewrite dp_eval_ext.
      * rewrite Hfind. eapply dp_eval_ext.
        -- intros. reflexivity.
        -- intros. rewrite vec_pos_spec. cbn [vec_pos vec_head]. rewrite Hw. reflexivity.
      * intros. reflexivity.
      * intros. cbn [vec_head]. rewrite Hw. unfold vec_pos at 1. cbn [pos_S_inv]. now rewrite vec_pos_spec.
   +  intros v m Hvm. specialize (H (Vector.cons _ m _ v)).
      cbn -[dp_eval Vector.nth] in H. eapply H in Hvm as [ν Hν].
      erewrite dp_eval_ext in Hν at 1.  1: symmetry in Hν.
      1: erewrite dp_eval_ext in Hν at 1.  1: symmetry in Hν.
      1: erewrite <- !dio_move_spec in Hν.
      1: eapply ra_dio_poly_find_spec_strong2 in Hν as [e Hν].
      1: eexists.
      1: rewrite <- ra_bs_correct, ra_rel_fix_comp.  1: unfold s_comp.
      1: eexists.  1: split.
      * eapply ra_project_rel. reflexivity.
      * intros p. eapply (Fin.caseS' p). 2: eapply Fin.case0.
        rewrite vec_pos_map.
        instantiate (1 := e ## vec_nil).
        cbn [vec_pos pos_S_inv].
        eassumption.
      * intros. instantiate (1 := vec_set_pos _). now rewrite vec_pos_set.
      * intros. now rewrite vec_pos_spec.
      * intros. now rewrite vec_pos_set.
      * intros. now rewrite vec_pos_spec. Unshelve.
Qed.


Require Import ssreflect ssrfun ssrbool eqtype ssrnat div prime.

Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.

Section TPPMark2014.

Implicit Types a b c : nat.

Local Open Scope nat_scope.

Lemma lemma1 a : (a ^ 2 == 0 %[mod 3]) || (a ^ 2 == 1 %[mod 3]).
Proof. by rewrite -modnXm; case: modn (ltn_mod a 3) => [|[|[|]]]. Qed.

Lemma lemma2 a b c : a ^ 2 + b ^ 2 = 3 * c ^ 2 -> [&& 3 %| a, 3 %| b & 3 %| c].
Proof.
move=> a2b2_eq_3c2; suff /andP [dvd3a dvd3b] : (3 %| a) && (3 %| b).
  rewrite dvd3a dvd3b /= -[_ %| _]andbT -(Euclid_dvdX _ 2) //.
  by rewrite -(@dvdn_pmul2l 3) // -a2b2_eq_3c2 dvdn_add // (@dvdn_exp2r 3 _ 2).
have /(congr1 (modn^~ 3)) := a2b2_eq_3c2.
rewrite -modnDm modnMr -modnXm -[X in _ + X]modnXm /dvdn.
by move: (a %% 3) (b %% 3) (ltn_mod a 3) (ltn_mod b 3) => [|[|[|?]]] [|[|[|]]].
Qed.

Lemma lemma3 a b c : a ^ 2 + b ^ 2 = 3 * c ^ 2 -> [&& a == 0, b == 0 & c == 0].
Proof.
move/eqP; elim: c {-2}c (leqnn c) => [|n ihn] c leqcn in a b *.
  by rewrite leqn0 in leqcn; rewrite (eqP leqcn) addn_eq0 !expn_eq0 andbT.
move=> /(fun p => (p, p)) [/eqP /lemma2 /and3P [/divnK<- /divnK<- /divnK<-]].
rewrite !muln_eq0 !orbF !expnMn mulnA -mulnDl eqn_mul2r; apply: ihn.
by rewrite (leq_trans (leq_div2r _ leqcn)) // -ltnS ltn_Pdiv.
Qed.

End TPPMark2014.


From mathcomp Require Import ssreflect ssrbool ssrnat div eqtype.
Require Import Coq.omega.Omega.

Ltac nify :=
    repeat match goal with
          | [ H: is_true (leq _ _) |- _ ] => move /ltP in H
          | [ H: is_true (leq _ _) |- _ ] => move /leP in H
          | [ |- is_true (leq _ _) ] => apply /ltP
          | [ |- is_true (leq _ _) ] => apply /leP
          | [ H: ~ (is_true (leq _ _)) |- _ ] => move /negP/leP in H
          | [ |- ~ (is_true (leq _ _)) ] => apply /negP/leP
          | H: is_true (?a == ?b) |- _ => move /eqP in H
          | |- is_true (?a == ?b) => apply /eqP
          | H:context [ ?a + ?b ] |- _ => rewrite -plusE in H
          | |- context [ ?a + ?b ] => rewrite -plusE
          | H:context [ ?a - ?b ] |- _ => rewrite -minusE in H
          | |- context [ ?a - ?b ] => rewrite -minusE
          | H:context [ ?a * ?b ] |- _ => rewrite -multE in H
          | |- context [ ?a * ?b ] => rewrite -multE
          | H:context [ ?a / ?b ] |- _ => rewrite -multE in H
          | |- context [ ?a / ?b ] => rewrite -multE
          | H:context [ uphalf (double ?a) ] |- _ => rewrite uphalf_double in H
          | |- context [ uphalf (double ?a) ] => rewrite uphalf_double
          | H:context [ half (double ?a) ] |- _ => rewrite doubleK in H
          | |- context [ half (double ?a) ] => rewrite doubleK
          | H:context [ double ?a ] |- _ => rewrite -addnn in H
          | |- context [ double ?a ] => rewrite -addnn
    end.

Module nify_test.

Remark test00 a b c: (a + b + c).*2 = (a + a) + (b - b) + (b - b) + (b + b) + (c + c).
Proof. nify. omega. Qed.

Remark test01 a b c: (a + b + c).*2 * 5 = ((a + a) + (b - b) + (b - b) + (b + b) + (c + c))*5.
Proof. nify. omega. Qed.

Remark test02 a: (a.*2)./2.*2 = a + a.
Proof. nify. omega. Qed.

End nify_test.


Require Export GeoCoq.Elements.OriginalProofs.lemma_parallelflip.
Require Export GeoCoq.Elements.OriginalProofs.lemma_parallelsymmetric.

Section Euclid.

Context `{Ax1:euclidean_neutral}.

Lemma lemma_PGflip :
   forall A B C D,
   PG A B C D ->
   PG B A D C.
Proof.
intros.
assert ((Par A B C D /\ Par A D B C)) by (conclude_def PG ).
assert (Par B A D C) by (forward_using lemma_parallelflip).
assert (Par B C A D) by (conclude lemma_parallelsymmetric).
assert (PG B A D C) by (conclude_def PG ).
close.
Qed.

End Euclid.