Require Import prosa.classic.util.all.
Require Import prosa.classic.analysis.global.jitter.bertogna_edf_theory.
From mathcomp Require Import ssreflect ssrbool eqtype ssrnat seq fintype bigop div path.

Module ResponseTimeIterationEDF.

  Import ResponseTimeAnalysisEDFJitter.

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

    Context {sporadic_task: eqType}.
    Variable task_cost: sporadic_task -> time.
    Variable task_period: sporadic_task -> time.
    Variable task_deadline: sporadic_task -> time.
    Variable task_jitter: 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_arrival: Job -> time.
    Variable job_cost: Job -> time.
    Variable job_deadline: Job -> time.
    Variable job_task: Job -> sporadic_task.
    Variable job_jitter: Job -> time.

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

    (* First, recall the interference bound under EDF, ... *)
    Let I (rt_bounds: seq task_with_response_time)
          (tsk: sporadic_task) (delta: time) :=
      total_interference_bound_edf task_cost task_period task_deadline task_jitter tsk rt_bounds delta.

    (* ..., which yields the following response-time bound. *)
    Definition edf_response_time_bound (rt_bounds: seq task_with_response_time)
                                           (tsk: sporadic_task) (delta: time) :=
      task_cost tsk + div_floor (I rt_bounds tsk delta) num_cpus.

    (* Also note that a response-time R is only valid if R + jitter is no larger
       than the deadline. *)
    Definition jitter_plus_R_le_deadline (pair: task_with_response_time) :=
      let (tsk, R) := pair in
        task_jitter tsk + R <= task_deadline tsk.

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

    (* Given a sequence 'rt_bounds' of task and response-time bounds
       from the previous iteration, we compute the response-time
       bound of a single task using the RTA for EDF. *)
    Definition update_bound (rt_bounds: seq task_with_response_time)
                        (pair : task_with_response_time) :=
      let (tsk, R) := pair in
        (tsk, edf_response_time_bound rt_bounds tsk R).

    (* To compute the response-time bounds of the entire task set,
       We start the iteration with a sequence of tasks and costs:
       <(task1, cost1), (task2, cost2), ...>. *)
    Let initial_state (ts: seq sporadic_task) :=
      map (fun t => (t, task_cost t)) ts.

    (* Then, we successively update the the response-time bounds based
       on the slack computed in the previous iteration. *)
    Definition edf_rta_iteration (rt_bounds: seq task_with_response_time) :=
      map (update_bound rt_bounds) rt_bounds.

    (* To ensure that the procedure converges, we run the iteration a
       "sufficient" number of times: task_deadline tsk - task_cost tsk + 1.
       This corresponds to the time complexity of the procedure. *)
    Let max_steps (ts: seq sporadic_task) :=
      \sum_(tsk <- ts) (task_deadline tsk - task_cost tsk) + 1.

    (* This yields the following definition for the RTA. At the end of
       the iteration, we check if all computed response-time bounds
       are less than or equal to the deadline, in which case they are
       valid. *)
    Definition edf_claimed_bounds (ts: seq sporadic_task) :=
      let R_values := iter (max_steps ts) edf_rta_iteration (initial_state ts) in
        if (all jitter_plus_R_le_deadline R_values) then
          Some R_values
        else None.

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

    (* In the following section, we prove several helper lemmas about the
       list of tasks/response-time bounds. *)
    Section SimpleLemmas.

      (* Updating a single response-time bound does not modify the task. *)
      Lemma edf_claimed_bounds_unzip1_update_bound :
        forall l rt_bounds,
          unzip1 (map (update_bound rt_bounds) l) = unzip1 l.
      Proof.
        induction l; first by done.
        intros rt_bounds.
        simpl; f_equal; last by done.
        by unfold update_bound; desf.
      Qed.

      (* At any point of the iteration, the tasks are the same. *)
      Lemma edf_claimed_bounds_unzip1_iteration :
        forall l k,
          unzip1 (iter k edf_rta_iteration (initial_state l)) = l.
      Proof.
        intros l k; clear -k.
        induction k; simpl.
        {
          unfold initial_state.
          induction l; first by done.
          by simpl; rewrite IHl.
        }
        {
          unfold edf_rta_iteration.
          by rewrite edf_claimed_bounds_unzip1_update_bound.
        }
      Qed.

      (* The iteration preserves the size of the list. *)
      Lemma edf_claimed_bounds_size :
        forall l k,
          size (iter k edf_rta_iteration (initial_state l)) = size l.
      Proof.
        intros l k; clear -k.
        induction k; simpl; first by rewrite size_map.
        by rewrite size_map.
      Qed.

      (* If the analysis succeeds, the computed response-time bounds are no smaller
         than the task cost. *)
      Lemma edf_claimed_bounds_ge_cost :
        forall l k tsk R,
          (tsk, R) \in (iter k edf_rta_iteration (initial_state l)) ->
          R >= task_cost tsk.
      Proof.
        intros l k tsk R IN.
        destruct k.
        {
          move: IN => /mapP IN; destruct IN as [x IN EQ]; inversion EQ.
          by apply leqnn.
        }
        {
          rewrite iterS in IN.
          move: IN => /mapP IN; destruct IN as [x IN EQ].
          unfold update_bound in EQ; destruct x; inversion EQ.
          by unfold edf_response_time_bound; apply leq_addr.
        }
      Qed.

      (* If the analysis suceeds, the computed response-time bounds are no larger
         than the deadline. *)
      Lemma edf_claimed_bounds_le_deadline :
        forall ts rt_bounds tsk R,
          edf_claimed_bounds ts = Some rt_bounds ->
          (tsk, R) \in rt_bounds ->
          task_jitter tsk + R <= task_deadline tsk.
      Proof.
        intros ts rt_bounds tsk R SOME PAIR; unfold edf_claimed_bounds in SOME.
        destruct (all jitter_plus_R_le_deadline (iter (max_steps ts)
                                          edf_rta_iteration (initial_state ts))) eqn:DEADLINE;
          last by done.
        move: DEADLINE => /allP DEADLINE.
        inversion SOME as [EQ]; rewrite -EQ in PAIR.
        by specialize (DEADLINE (tsk, R) PAIR).
      Qed.

      (* The list contains a response-time bound for every task in the task set. *)
      Lemma edf_claimed_bounds_has_R_for_every_task :
        forall ts rt_bounds tsk,
          edf_claimed_bounds ts = Some rt_bounds ->
          tsk \in ts ->
          exists R,
            (tsk, R) \in rt_bounds.
      Proof.
        intros ts rt_bounds tsk SOME IN.
        unfold edf_claimed_bounds in SOME.
        destruct (all jitter_plus_R_le_deadline (iter (max_steps ts) edf_rta_iteration (initial_state ts)));
          last by done.
        inversion SOME as [EQ]; clear SOME EQ.
        generalize dependent tsk.
        induction (max_steps ts) as [| step]; simpl in *.
        {
          intros tsk IN; unfold initial_state.
          exists (task_cost tsk).
          by apply/mapP; exists tsk.
        }
        {
          intros tsk IN.
          set prev_state := iter step edf_rta_iteration (initial_state ts).
          fold prev_state in IN, IHstep.
          specialize (IHstep tsk IN); des.
          exists (edf_response_time_bound prev_state tsk R).
          by apply/mapP; exists (tsk, R); [by done | by f_equal].
        }
      Qed.

    End SimpleLemmas.

    (* As required by the proof of convergence, we show that the
       interference bound is monotonically increasing with both
       the size of the interval and the value of the previous
       response-time bounds.
       TODO: move to bertogna_edf_theory.v? *)
    Section MonotonicityOfInterferenceBound.

      Variable tsk tsk_other: sporadic_task.
      Hypothesis H_period_positive: task_period tsk_other > 0.

      Variable delta delta' R R': time.
      Hypothesis H_delta_monotonic: delta <= delta'.
      Hypothesis H_response_time_monotonic: R <= R'.
      Hypothesis H_cost_le_rt_bound: task_cost tsk_other <= R.

      Lemma interference_bound_edf_monotonic :
        interference_bound_edf task_cost task_period task_deadline task_jitter tsk delta (tsk_other, R) <=
        interference_bound_edf task_cost task_period task_deadline task_jitter tsk delta' (tsk_other, R').
      Proof.
        rename H_response_time_monotonic into LEr, H_delta_monotonic into LEx,
               H_cost_le_rt_bound into LEcost, H_period_positive into GEperiod.
        unfold interference_bound_edf, interference_bound_generic.
        rewrite leq_min; apply/andP; split.
        {
          rewrite leq_min; apply/andP; split.
          apply leq_trans with (n :=  (minn (W_jitter task_cost task_period task_jitter (fst (tsk_other, R))
                             (snd (tsk_other, R)) delta) (delta - task_cost tsk + 1)));
            first by apply geq_minl.
          apply leq_trans with (n := W_jitter task_cost task_period task_jitter (fst (tsk_other, R))
                                                     (snd (tsk_other, R)) delta);
            [by apply geq_minl | by apply W_monotonic].
          apply leq_trans with (n := minn (W_jitter task_cost task_period task_jitter (fst (tsk_other, R)) (snd (tsk_other, R)) delta) (delta - task_cost tsk + 1));
            first by apply geq_minl.
          apply leq_trans with (n := delta - task_cost tsk + 1);
            first by apply geq_minr.
          by rewrite leq_add2r leq_sub2r.
        }
        {
          apply leq_trans with (n := edf_specific_interference_bound task_cost task_period
                                                            task_deadline task_jitter tsk tsk_other R);
            first by apply geq_minr.
          unfold edf_specific_interference_bound; simpl.
          rewrite leq_add2l leq_min; apply/andP; split; first by apply geq_minl.
          apply leq_trans with (n := task_deadline tsk %% task_period tsk_other -
                                     (task_deadline tsk_other - R - task_jitter tsk_other));
            [by apply geq_minr | by rewrite 2?leq_sub2l 2?leq_sub2r // leq_sub2l].
        }
      Qed.

    End MonotonicityOfInterferenceBound.

    (* In this section, we prove the convergence of the RTA procedure.
       Since we define the RTA procedure as the application of a function
       a fixed number of times, this translates into proving that the value
       of the iteration at (max_steps ts) is equal to the value at (max_steps ts) + 1. *)
    Section Convergence.

      (* Consider any list of tasks with valid parameters. *)
      Variable ts: list sporadic_task.
      Hypothesis H_valid_task_parameters:
        valid_sporadic_taskset task_cost task_period task_deadline ts.

      (* To simplify, let f denote the RTA procedure. *)
      Let f (k: nat) := iter k edf_rta_iteration (initial_state ts).

      (* Since the iteration is applied directly to a list of tasks and response-times,
         we define a corresponding relation "<=" over those lists. *)

      (* Let 'all_le' be a binary relation over lists of tasks/response-time bounds.
         It states that every element of list l1 has a response-time bound R that is less
         than or equal to the corresponding response-time bound R' in list l2 (point-wise).
         In addition, the relation states that the tasks of both lists are unchanged. *)
      Let all_le := fun (l1 l2: list task_with_response_time) =>
        (unzip1 l1 == unzip1 l2) &&
        all (fun p => (snd (fst p)) <= (snd (snd p))) (zip l1 l2).

      (* Similarly, we define a strict version of 'all_le' called 'one_lt', which states that
         there exists at least one element whose response-time bound increases. *)
      Let one_lt := fun (l1 l2: list task_with_response_time) =>
        (unzip1 l1 == unzip1 l2) &&
        has (fun p => (snd (fst p)) < (snd (snd p))) (zip l1 l2).

      (* Next, we prove some basic properties about the relation all_le. *)
      Section RelationProperties.

        (* The relation is reflexive, ... *)
        Lemma all_le_reflexive : reflexive all_le.
        Proof.
          intros l; unfold all_le; rewrite eq_refl andTb.
          destruct l; first by done.
          by apply/(zipP t (fun x y => snd x <= snd y)).
        Qed.

        (* ... and transitive. *)
        Lemma all_le_transitive: transitive all_le.
        Proof.
          unfold transitive, all_le.
          move => y x z /andP [/eqP ZIPxy LExy] /andP [/eqP ZIPyz LEyz].
          apply/andP; split; first by rewrite ZIPxy -ZIPyz.
          move: LExy => /(zipP _ (fun x y => snd x <= snd y)) LExy.
          move: LEyz => /(zipP _ (fun x y => snd x <= snd y)) LEyz.
          assert (SIZExy: size (unzip1 x) = size (unzip1 y)).
            by rewrite ZIPxy.
          assert (SIZEyz: size (unzip1 y) = size (unzip1 z)).
            by rewrite ZIPyz.
          rewrite 2!size_map in SIZExy; rewrite 2!size_map in SIZEyz.
          destruct y.
          {
            apply size0nil in SIZExy; symmetry in SIZEyz.
            by apply size0nil in SIZEyz; subst.
          }
          specialize (LExy t); specialize (LEyz t).
          apply/(zipP t (fun x y => snd x <= snd y));
            first by rewrite SIZExy -SIZEyz.
          intros i LTi.
          exploit LExy; first by rewrite SIZExy.
          {
            rewrite size_zip -SIZEyz -SIZExy minnn in LTi.
            by rewrite size_zip -SIZExy minnn; apply LTi.
          }
          intro LE.
          exploit LEyz; first by apply SIZEyz.
          {
            rewrite size_zip SIZExy SIZEyz minnn in LTi.
            by rewrite size_zip SIZEyz minnn; apply LTi.
          }
          by intro LE'; apply (leq_trans LE).
        Qed.

        (* At any step of the iteration, the corresponding list
           is larger than or equal to the initial state. *)
        Lemma bertogna_edf_comp_iteration_preserves_minimum :
          forall step, all_le (initial_state ts) (f step).
        Proof.
          unfold f.
          intros step; destruct step; first by apply all_le_reflexive.
          apply/andP; split.
          {
            assert (UNZIP0 := edf_claimed_bounds_unzip1_iteration ts 0).
            by simpl in UNZIP0; rewrite UNZIP0 edf_claimed_bounds_unzip1_iteration.
          }
          destruct ts as [| tsk0 ts'].
          {
            clear -step; induction step; first by done.
            by rewrite iterSr IHstep.
          }

          apply/(zipP (tsk0,0) (fun x y => snd x <= snd y));
            first by rewrite edf_claimed_bounds_size size_map.

          intros i LTi; rewrite iterS; unfold edf_rta_iteration at 1.
          have MAP := @nth_map _ (tsk0,0) _ (tsk0,0).
          rewrite size_zip edf_claimed_bounds_size size_map minnn in LTi.
          rewrite MAP; clear MAP; last by rewrite edf_claimed_bounds_size.
          destruct (nth (tsk0, 0) (initial_state (tsk0 :: ts')) i) as [tsk_i R_i] eqn:SUBST.
          rewrite SUBST; unfold update_bound.
          unfold initial_state in SUBST.
          have MAP := @nth_map _ tsk0 _ (tsk0, 0).
          rewrite ?MAP // in SUBST; inversion SUBST; clear MAP.
          assert (EQtsk: tsk_i = fst (nth (tsk0, 0) (iter step edf_rta_iteration
                                                         (initial_state (tsk0 :: ts'))) i)).
          {
            have MAP := @nth_map _ (tsk0,0) _ tsk0 (fun x => fst x).
            rewrite -MAP; clear MAP; last by rewrite edf_claimed_bounds_size.
            have UNZIP := edf_claimed_bounds_unzip1_iteration; unfold unzip1 in UNZIP.
            by rewrite UNZIP; symmetry.
          }
          destruct (nth (tsk0, 0) (iter step edf_rta_iteration (initial_state (tsk0 :: ts')))) as [tsk_i' R_i'].
          by simpl in EQtsk; rewrite -EQtsk; subst; apply leq_addr.
        Qed.

        (* The application of the function is inductive. *)
        Lemma bertogna_edf_comp_iteration_inductive (P : seq task_with_response_time -> Type) :
          P (initial_state ts) ->
          (forall k, P (f k) -> P (f (k.+1))) ->
          P (f (max_steps ts)).
        Proof.
          by intros P0 Pn; induction (max_steps ts); last by apply Pn.
        Qed.

        (* As a last step, we show that edf_rta_iteration preserves order, i.e., for any
           list l1 no smaller than the initial state, and list l2 such that
           l1 <= l2, we have (edf_rta_iteration l1) <= (edf_rta_iteration l2). *)
        Lemma bertogna_edf_comp_iteration_preserves_order :
          forall l1 l2,
            all_le (initial_state ts) l1 ->
            all_le l1 l2 ->
            all_le (edf_rta_iteration l1) (edf_rta_iteration l2).
        Proof.
          rename H_valid_task_parameters into VALID.
          intros x1 x2 LEinit LE.
          move: LE => /andP [/eqP ZIP LE]; unfold all_le.

          assert (UNZIP': unzip1 (edf_rta_iteration x1) = unzip1 (edf_rta_iteration x2)).
          {
            by rewrite 2!edf_claimed_bounds_unzip1_update_bound.
          }

          apply/andP; split; first by rewrite UNZIP'.
          apply f_equal with (B := nat) (f := fun x => size x) in UNZIP'.
          rename UNZIP' into SIZE.
          rewrite size_map [size (unzip1 _)]size_map in SIZE.
          move: LE => /(zipP _ (fun x y => snd x <= snd y)) LE.
          destruct x1 as [| p0 x1'], x2 as [| p0' x2']; try (by ins).
          apply/(zipP p0 (fun x y => snd x <= snd y)); first by done.

          intros i LTi.
          exploit LE; first by rewrite 2!size_map in SIZE.
          {
            by rewrite size_zip 2!size_map -size_zip in LTi; apply LTi.
          }
          rewrite 2!size_map in SIZE.
          instantiate (1 := p0); intro LEi.
          rewrite (nth_map p0);
            last by rewrite size_zip 2!size_map -SIZE minnn in LTi.
          rewrite (nth_map p0);
            last by rewrite size_zip 2!size_map SIZE minnn in LTi.
          unfold update_bound, edf_response_time_bound; desf; simpl.
          rename s into tsk_i, s0 into tsk_i', t into R_i, t0 into R_i', Heq into EQ, Heq0 into EQ'.
          assert (EQtsk: tsk_i = tsk_i').
          {
            destruct p0 as [tsk0 R0], p0' as [tsk0' R0']; simpl in H2; subst.
            have MAP := @nth_map _ (tsk0',R0) _ tsk0' (fun x => fst x) i ((tsk0', R0) :: x1').
            have MAP' := @nth_map _ (tsk0',R0) _ tsk0' (fun x => fst x) i ((tsk0', R0') :: x2').
            assert (FSTeq: fst (nth (tsk0', R0)((tsk0', R0) :: x1') i) =
                           fst (nth (tsk0',R0) ((tsk0', R0') :: x2') i)).
            {
              rewrite -MAP;
                last by simpl; rewrite size_zip 2!size_map /= -H0 minnn in LTi.
              rewrite -MAP';
                last by simpl; rewrite size_zip 2!size_map /= H0 minnn in LTi.
              by f_equal; simpl; f_equal.
            }
            apply f_equal with (B := sporadic_task) (f := fun x => fst x) in EQ.
            apply f_equal with (B := sporadic_task) (f := fun x => fst x) in EQ'.
            by rewrite FSTeq EQ' /= in EQ; rewrite EQ.
          }
          subst tsk_i'; rewrite leq_add2l.
          unfold I, total_interference_bound_edf; apply leq_div2r.
          rewrite 2!big_cons.
          destruct p0 as [tsk0 R0], p0' as [tsk0' R0'].
          simpl in H2; subst tsk0'.
          rename R_i into delta, R_i' into delta'.
          rewrite EQ EQ' in LEi; simpl in LEi.
          rename H0 into SIZE, H1 into UNZIP; clear EQ EQ'.

          assert (SUBST: forall l delta,
                    \sum_(j <- l | let '(tsk_other, _) := j in
                      different_task tsk_i tsk_other)
                        (let '(tsk_other, R_other) := j in
                          interference_bound_edf task_cost task_period task_deadline task_jitter tsk_i delta
                            (tsk_other, R_other)) =
                    \sum_(j <- l | different_task tsk_i (fst j))
                      interference_bound_edf task_cost task_period task_deadline task_jitter tsk_i delta j).
          {
            intros l x; clear -l.
            induction l; first by rewrite 2!big_nil.
            by rewrite 2!big_cons; rewrite IHl; desf; rewrite /= Heq in Heq0.
          } rewrite 2!SUBST; clear SUBST.

          assert (VALID': valid_sporadic_taskset task_cost task_period task_deadline
                                                       (unzip1 ((tsk0, R0) :: x1'))).
          {
            move: LEinit => /andP [/eqP EQinit _].
            rewrite -EQinit; unfold valid_sporadic_taskset.
            move => tsk /mapP IN. destruct IN as [p INinit EQ]; subst.
            by move: INinit => /mapP INinit; destruct INinit as [tsk INtsk]; subst; apply VALID.
          }

          assert (GE_COST: all (fun p => task_cost (fst p) <= snd p) ((tsk0, R0) :: x1')).
          {
            clear LE; move: LEinit => /andP [/eqP UNZIP' LE].
            move: LE => /(zipP _ (fun x y => snd x <= snd y)) LE.
            specialize (LE (tsk0, R0)).
            apply/(all_nthP (tsk0,R0)).
            intros j LTj; generalize UNZIP'; simpl; intro SIZE'.
            have F := @f_equal _ _ size (unzip1 (initial_state ts)).
            apply F in SIZE'; clear F; rewrite /= 3!size_map in SIZE'.
            exploit LE; [by rewrite size_map /= | |].
            {
              rewrite size_zip size_map /= SIZE' minnn.
              by simpl in LTj; apply LTj.
            }
            clear LE; intro LE.
            unfold initial_state in LE.
            have MAP := @nth_map _ tsk0 _ (tsk0,R0).
            rewrite MAP /= in LE;
              [clear MAP | by rewrite SIZE'; simpl in LTj].
            apply leq_trans with (n := task_cost (nth tsk0 ts j));
              [apply eq_leq; f_equal | by done].
            have MAP := @nth_map _ (tsk0, R0) _ tsk0 (fun x => fst x).
            rewrite -MAP; [clear MAP | by done].
            unfold unzip1 in UNZIP'; rewrite -UNZIP'; f_equal.
            clear -ts; induction ts; [by done | by simpl; f_equal].
          }
          move: GE_COST => /allP GE_COST.

          assert (LESUM: \sum_(j <- x1' | different_task tsk_i (fst j))
                          interference_bound_edf task_cost task_period task_deadline task_jitter tsk_i delta j <=
                         \sum_(j <- x2' | different_task tsk_i (fst j))
                        interference_bound_edf task_cost task_period task_deadline task_jitter tsk_i delta' j).
          {
            set elem := (tsk0, R0); rewrite 2!(big_nth elem).
            rewrite -SIZE.
            rewrite big_mkcond [\sum_(_ <- _ | different_task _ _)_]big_mkcond.
            rewrite big_seq_cond [\sum_(_ <- _ | true) _]big_seq_cond.
            apply leq_sum; intros j; rewrite andbT; intros INj.
            rewrite mem_iota add0n subn0 in INj; move: INj => /andP [_ INj].
            assert (FSTeq: fst (nth elem x1' j) = fst (nth elem x2' j)).
            {
              have MAP := @nth_map _ elem _ tsk0 (fun x => fst x).
              by rewrite -2?MAP -?SIZE //; f_equal.
            } rewrite -FSTeq.
            destruct (different_task tsk_i (fst (nth elem x1' j))) eqn:INTERF;
              last by done.
            {
              exploit (LE elem); [by rewrite /= SIZE | | intro LEj].
              {
                rewrite size_zip 2!size_map /= -SIZE minnn in LTi.
                by rewrite size_zip /= -SIZE minnn; apply (leq_ltn_trans INj).
              }
              simpl in LEj.
              exploit (VALID' (fst (nth elem x1' j))); last intro VALIDj.
              {
                apply/mapP; exists (nth elem x1' j); last by done.
                by rewrite in_cons; apply/orP; right; rewrite mem_nth.
              }
              exploit (GE_COST (nth elem x1' j)); last intro GE_COSTj.
              {
                by rewrite in_cons; apply/orP; right; rewrite mem_nth.
              }
              unfold is_valid_sporadic_task in *.
              destruct (nth elem x1' j) as [tsk_j R_j] eqn:SIMPL1,
                       (nth elem x2' j) as [tsk_j' R_j'] eqn:SIMPL2.
              rewrite SIMPL1 SIMPL2 in LEj.
              simpl in FSTeq; rewrite -FSTeq; simpl in LEj; simpl in VALIDj; des.
              by apply interference_bound_edf_monotonic.
            }
          }
          destruct (different_task tsk_i tsk0) eqn:INTERFtsk0; last by done.
          apply leq_add; last by done.
          {
            exploit (LE (tsk0, R0)); [by rewrite /= SIZE | | intro LEj];
              first by instantiate (1 := 0); rewrite size_zip /= -SIZE minnn.
            exploit (VALID' tsk0); first by rewrite in_cons; apply/orP; left.
            exploit (GE_COST (tsk0, R0)); first by rewrite in_cons eq_refl orTb.
            unfold is_valid_sporadic_task; intros GE_COST0 VALID0; des; simpl in LEj.
            by apply interference_bound_edf_monotonic.
          }
        Qed.

        (* It follows from the properties above that the iteration is monotonically increasing. *)
        Lemma bertogna_edf_comp_iteration_monotonic: forall k, all_le (f k) (f k.+1).
        Proof.
          unfold f; intros k.
          apply fun_mon_iter_mon_generic with (x1 := k) (x2 := k.+1);
            try (by done);
            [ by apply all_le_reflexive
            | by apply all_le_transitive
            | by apply bertogna_edf_comp_iteration_preserves_order
            | by apply bertogna_edf_comp_iteration_preserves_minimum].
        Qed.

      End RelationProperties.

      (* Knowing that the iteration is monotonically increasing (with respect to all_le),
         we show that the RTA procedure converges to a fixed point. *)

      (* First, note that when there are no tasks, the iteration trivially converges. *)
      Lemma bertogna_edf_comp_f_converges_with_no_tasks :
        size ts = 0 ->
        f (max_steps ts) = f (max_steps ts).+1.
      Proof.
        intro SIZE; destruct ts; last by inversion SIZE.
        unfold max_steps; rewrite big_nil /=.
        by unfold edf_rta_iteration.
      Qed.

      (* Otherwise, if the iteration reached a fixed point before (max_steps ts), then
         the value at (max_steps ts) is still at a fixed point. *)
      Lemma bertogna_edf_comp_f_converges_early :
        (exists k, k <= max_steps ts /\ f k = f k.+1) ->
        f (max_steps ts) = f (max_steps ts).+1.
      Proof.
        by intros EX; des; apply fixedpoint.iter_fix with (k := k).
      Qed.

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

        (* Assume that there are tasks. *)
        Hypothesis H_at_least_one_task: size ts > 0.

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

        (* Since the iteration is monotonically increasing, it must be
           strictly increasing. *)
        Lemma bertogna_edf_comp_f_increases :
          forall k,
            k <= max_steps ts -> one_lt (f k) (f k.+1).
        Proof.
          rename H_at_least_one_task into NONEMPTY.
          intros step LEstep; unfold one_lt; apply/andP; split;
            first by rewrite 2!edf_claimed_bounds_unzip1_iteration.
          rewrite -[has _ _]negbK; apply/negP; unfold not; intro ALL.
          rewrite -all_predC in ALL.
          move: ALL => /allP ALL.
          exploit (H_keeps_diverging step); [by done | intro DIFF].
          assert (DUMMY: exists tsk: sporadic_task, True).
          {
            destruct ts as [|tsk0]; first by rewrite ltnn in NONEMPTY.
            by exists tsk0.
          }
          des; clear DUMMY.
          move: DIFF => /eqP DIFF; apply DIFF.
          apply eq_from_nth with (x0 := (tsk, 0));
            first by simpl; rewrite size_map.
          {
            intros i LTi.
            remember (nth (tsk, 0)(f step) i) as p_i;rewrite -Heqp_i.
            remember (nth (tsk, 0)(f step.+1) i) as p_i';rewrite -Heqp_i'.
            rename Heqp_i into EQ, Heqp_i' into EQ'.
            exploit (ALL (p_i, p_i')).
            {
              rewrite EQ EQ'.
              rewrite -nth_zip; last by unfold f; rewrite iterS size_map.
              apply mem_nth; rewrite size_zip.
              unfold f; rewrite iterS size_map.
              by rewrite minnn.
            }
            unfold predC; simpl; rewrite -ltnNge; intro LTp.

            have GROWS := bertogna_edf_comp_iteration_monotonic step.
            move: GROWS => /andP [_ /allP GROWS].
            exploit (GROWS (p_i, p_i')).
            {
              rewrite EQ EQ'.
              rewrite -nth_zip; last by unfold f; rewrite iterS size_map.
              apply mem_nth; rewrite size_zip.
              unfold f; rewrite iterS size_map.
              by rewrite minnn.
            }
            simpl; intros LE.
            destruct p_i as [tsk_i R_i], p_i' as [tsk_i' R_i'].
            simpl in *.
            assert (EQtsk: tsk_i = tsk_i').
            {
              unfold edf_rta_iteration in EQ'.
              rewrite (nth_map (tsk, 0)) in EQ'; last by done.
              by unfold update_bound in EQ'; desf.
            }
            rewrite EQtsk; f_equal.
            by apply/eqP; rewrite eqn_leq; apply/andP; split.
          }
        Qed.

        (* In the end, each response-time bound is so high that the sum
           of all response-time bounds exceeds the sum of all deadlines.
           Contradiction! *)
        Lemma bertogna_edf_comp_rt_grows_too_much :
          forall k,
            k <= max_steps ts ->
            \sum_((tsk, R) <- f k) (R - task_cost tsk) + 1 > k.
        Proof.
          have LT := bertogna_edf_comp_f_increases.
          have MONO := bertogna_edf_comp_iteration_monotonic.
          rename H_at_least_one_task into NONEMPTY.
          unfold valid_sporadic_taskset, is_valid_sporadic_task in *.
          rename H_valid_task_parameters into VALID.
          intros step LE.
          assert (DUMMY: exists tsk: sporadic_task, True).
          {
            destruct ts as [|tsk0]; first by rewrite ltnn in NONEMPTY.
            by exists tsk0.
          } destruct DUMMY as [elem _].

          induction step.
          {
            by rewrite addn1.
          }
          {
            rewrite -addn1 ltn_add2r.
            apply leq_ltn_trans with (n := \sum_(i <- f step) (let '(tsk, R) := i in R - task_cost tsk)).
            {
              rewrite -ltnS; rewrite addn1 in IHstep.
              by apply IHstep, ltnW.
            }
            rewrite (eq_bigr (fun x => snd x - task_cost (fst x)));
              last by ins; destruct i.
            rewrite [\sum_(_ <- f step.+1)_](eq_bigr (fun x => snd x - task_cost (fst x)));
              last by ins; destruct i.
            unfold f at 2; rewrite iterS.
            rewrite big_map; fold (f step).
            rewrite -(ltn_add2r (\sum_(i <- f step) task_cost (fst i))).
            rewrite -2!big_split /=.
            rewrite big_seq_cond [\sum_(_ <- _ | true)_]big_seq_cond.
            rewrite (eq_bigr (fun i => snd i)); last first.
            {
              intro i; rewrite andbT; intro IN;
              rewrite subh1; first by rewrite -addnBA // subnn addn0.
              have GE_COST := edf_claimed_bounds_ge_cost ts step.
              by destruct i; apply GE_COST.
            }
            rewrite [\sum_(_ <- _ | _)(_ - _ + _)](eq_bigr (fun i => snd (update_bound (f step) i))); last first.
            {
              intro i; rewrite andbT; intro IN.
              unfold update_bound; destruct i; simpl.
              rewrite subh1; first by rewrite -addnBA // subnn addn0.
              apply (edf_claimed_bounds_ge_cost ts step.+1).
              by rewrite iterS; apply/mapP; exists (s, t).
            }
            rewrite -2!big_seq_cond.

            specialize (LT step (ltnW LE)).
            specialize (MONO step).

            move: LT => /andP [_ LT]; move: LT => /hasP LT.
            destruct LT as [[x1 x2] INzip LT]; simpl in *.
            move: MONO => /andP [_ /(zipP _ (fun x y => snd x <= snd y)) MONO].
            rewrite 2!(big_nth (elem, 0)).
            apply mem_zip_exists with (elem := (elem, 0)) (elem' := (elem, 0)) in INzip; des;
              last by rewrite size_map.
            rewrite -> big_cat_nat with (m := 0) (n := idx) (p := size (f step));
              [simpl | by done | by apply ltnW].
            rewrite -> big_cat_nat with (m := idx) (n := idx.+1) (p := size (f step));
              [simpl | by done | by done].
            rewrite big_nat_recr /=; last by done.
            rewrite -> big_cat_nat with (m := 0) (n := idx) (p := size (f step));
              [simpl | by done | by apply ltnW].
            rewrite -> big_cat_nat with (m := idx) (n := idx.+1) (p := size (f step));
              [simpl | by done | by done].
            rewrite big_nat_recr /=; last by done.
            rewrite [\sum_(idx <= i < idx) _]big_geq // add0n.
            rewrite [\sum_(idx <= i < idx) _]big_geq // add0n.
            rewrite -addn1 -addnA; apply leq_add.
            {
              rewrite big_nat_cond [\sum_(_ <= _ < _ | true) _]big_nat_cond.
              apply leq_sum; move => i /andP [/andP [LT1 LT2] _].
              exploit (MONO (elem,0)); [by rewrite size_map | | intro LEi].
              {
                rewrite size_zip; apply (ltn_trans LT2).
                by apply leq_trans with (n := size (f step));
                  [by done | by rewrite size_map minnn].
              }
              unfold edf_rta_iteration in LEi.
              by rewrite -> nth_map with (x1 := (elem, 0)) in LEi;
                last by apply (ltn_trans LT2).
            }
            rewrite -addnA [_ + 1]addnC addnA; apply leq_add.
            {
              unfold edf_rta_iteration in INzip2; rewrite addn1.
              rewrite -> nth_map with (x1 := (elem, 0)) in INzip2; last by done.
              by rewrite -INzip2 -INzip1.
            }
            {
              rewrite big_nat_cond [\sum_(_ <= _ < _ | true) _]big_nat_cond.
              apply leq_sum; move => i /andP [/andP [LT1 LT2] _].
              exploit (MONO (elem,0));
                [ by rewrite size_map
                | by rewrite size_zip; apply (leq_trans LT2); rewrite size_map minnn | intro LEi ].
              unfold edf_rta_iteration in LEi.
              by rewrite -> nth_map with (x1 := (elem, 0)) in LEi; last by done.
            }
          }
        Qed.

      End DerivingContradiction.

      (* Using the lemmas above, we prove that edf_rta_iteration reaches
         a fixed point after (max_steps ts) step, ... *)
      Lemma edf_claimed_bounds_finds_fixed_point_of_list :
        forall rt_bounds,
          edf_claimed_bounds ts = Some rt_bounds ->
          valid_sporadic_taskset task_cost task_period task_deadline ts ->
          f (max_steps ts) = edf_rta_iteration (f (max_steps ts)).
      Proof.
        intros rt_bounds SOME VALID.
        unfold valid_sporadic_taskset, is_valid_sporadic_task in *.
        unfold edf_claimed_bounds in SOME; desf.
        rename Heq into LE.
        fold (f (max_steps ts)) in *; fold (f (max_steps ts).+1).

        (* Either the task set is empty or not. *)
        destruct (size ts == 0) eqn:EMPTY;
          first by apply bertogna_edf_comp_f_converges_with_no_tasks; apply/eqP.
        apply negbT in EMPTY; rewrite -lt0n in EMPTY.

        (* Either f converges by the deadline or not. *)
        destruct ([exists k in 'I_((max_steps ts).+1), f k == f k.+1]) eqn:EX.
        {
          move: EX => /exists_inP EX; destruct EX as [k _ ITERk].
          destruct k as [k LTk]; simpl in ITERk.
          apply bertogna_edf_comp_f_converges_early.
          exists k; split; [by apply LTk | 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.

        assert (SAMESUM: \sum_(tsk <- ts) task_cost tsk = \sum_(p <- f (max_steps ts)) task_cost (fst p)).
        {
          have MAP := @big_map _ 0 addn _ _ (fun x => fst x) (f (max_steps ts))
                               (fun x => true) (fun x => task_cost x).
          have UNZIP := edf_claimed_bounds_unzip1_iteration ts (max_steps ts).
          fold (f (max_steps ts)) in UNZIP; unfold unzip1 in UNZIP.
          by rewrite UNZIP in MAP; rewrite MAP.
        }

        (* Show that the sum is less than the sum of all deadlines. *)
        assert (SUM: \sum_(p <- f (max_steps ts)) (snd p - task_cost (fst p)) + 1 <= max_steps ts).
        {
          unfold max_steps at 2; rewrite leq_add2r.
          rewrite -(leq_add2r (\sum_(tsk <- ts) task_cost tsk)).
          rewrite {1}SAMESUM -2!big_split /=.
          rewrite big_seq_cond [\sum_(_ <- _ | true)_]big_seq_cond.
          rewrite (eq_bigr (fun x => snd x)); last first.
          {
            intro i; rewrite andbT; intro IN.
            rewrite subh1; first by rewrite -addnBA // subnn addn0.
            have GE_COST := edf_claimed_bounds_ge_cost ts (max_steps ts).
            fold (f (max_steps ts)) in GE_COST.
            by destruct i; apply GE_COST.
          }
          rewrite (eq_bigr (fun x => task_deadline x)); last first.
          {
            intro i; rewrite andbT; intro IN.
            rewrite subh1; first by rewrite -addnBA // subnn addn0.
            by specialize (VALID i IN); des.
          }
          rewrite -2!big_seq_cond.
          have MAP := @big_map _ 0 addn _ _ (fun x => fst x) (f (max_steps ts))
                               (fun x => true) (fun x => task_deadline x).
          have UNZIP := edf_claimed_bounds_unzip1_iteration ts (max_steps ts).
          fold (f (max_steps ts)) in UNZIP; unfold unzip1 in UNZIP.
          rewrite UNZIP in MAP; rewrite MAP.
          rewrite big_seq_cond [\sum_(_ <- _|true)_]big_seq_cond.
          apply leq_sum; intro i; rewrite andbT; intro IN.
          move: LE => /allP LE; unfold jitter_plus_R_le_deadline in LE.
          specialize (LE i IN); destruct i; simpl.
          by apply leq_trans with (n := task_jitter s + s0); first by apply leq_addl.
        }

        have TOOMUCH :=
          bertogna_edf_comp_rt_grows_too_much EMPTY _ (max_steps ts) (leqnn (max_steps ts)).
        exploit TOOMUCH; [| intro BUG].
        {
          intros k LEk; rewrite -ltnS in LEk.
          by exploit (EX (Ordinal LEk)); [by done | by ins].
        }
        rewrite (eq_bigr (fun i => snd i - task_cost (fst i))) in BUG;
          last by ins; destruct i.
        by apply (leq_ltn_trans SUM) in BUG; rewrite ltnn in BUG.
      Qed.

      (* ...and since there cannot be a vector of response-time bounds with values less than
         the task costs, this solution is also the least fixed point. *)
      Lemma edf_claimed_bounds_finds_least_fixed_point :
        forall v,
          all_le (initial_state ts) v ->
          v = edf_rta_iteration v ->
          all_le (f (max_steps ts)) v.
      Proof.
        intros v GE0 EQ.
        apply bertogna_edf_comp_iteration_inductive; first by done.
        intros k GEk.
        rewrite EQ.
        apply bertogna_edf_comp_iteration_preserves_order; last by done.
        by apply bertogna_edf_comp_iteration_preserves_minimum.
      Qed.

      (* Therefore, with regard to the response-time bound recurrence, ...*)

      (* ..., the individual response-time bounds (elements of the list) are also fixed points. *)
      Theorem edf_claimed_bounds_finds_fixed_point_for_each_bound :
        forall tsk R rt_bounds,
          edf_claimed_bounds ts = Some rt_bounds ->
          (tsk, R) \in rt_bounds ->
          R = edf_response_time_bound rt_bounds tsk R.
      Proof.
        intros tsk R rt_bounds SOME IN.
        have CONV := edf_claimed_bounds_finds_fixed_point_of_list rt_bounds.
        rewrite -iterS in CONV; fold (f (max_steps ts).+1) in CONV.
        unfold edf_claimed_bounds in *; desf.
        exploit (CONV); [by done | by done | intro ITER; clear CONV].
        unfold f in ITER.

        cut (update_bound (iter (max_steps ts)
               edf_rta_iteration (initial_state ts)) (tsk,R) = (tsk, R)).
        {
          intros EQ.
          have F := @f_equal _ _ (fun x => snd x) _ (tsk, R).
          by apply F in EQ; simpl in EQ.
        }
        set s := iter (max_steps ts) edf_rta_iteration (initial_state ts).
        fold s in ITER, IN.
        move: IN => /(nthP (tsk,0)) IN; destruct IN as [i LT EQ].
        generalize EQ; rewrite ITER iterS in EQ; intro EQ'.
        fold s in EQ.
        unfold edf_rta_iteration in EQ.
        have MAP := @nth_map _ (tsk,0) _ _ (update_bound s).
        by rewrite MAP // EQ' in EQ; rewrite EQ.
      Qed.

      (* ..., which in turn implies that the response-time bound is the fixed
         point from Bertogna and Cirinei's equation. *)
      Lemma edf_claimed_bounds_converges :
        forall tsk R rt_bounds,
          edf_claimed_bounds ts = Some rt_bounds ->
          (tsk, R) \in rt_bounds ->
          R = task_cost tsk + div_floor (I rt_bounds tsk R) num_cpus.
      Proof.
        intros tsk R rt_bounds SOME IN.
        have CONV := edf_claimed_bounds_finds_fixed_point_of_list rt_bounds.
        rewrite -iterS in CONV; fold (f (max_steps ts).+1) in CONV.
        unfold edf_claimed_bounds in *; desf.
        exploit (CONV); [by done | by done | intro ITER; clear CONV].
        unfold f in ITER.

        cut (update_bound (iter (max_steps ts)
               edf_rta_iteration (initial_state ts)) (tsk,R) = (tsk, R)).
        {
          intros EQ.
          have F := @f_equal _ _ (fun x => snd x) _ (tsk, R).
          by apply F in EQ; simpl in EQ.
        }
        set s := iter (max_steps ts) edf_rta_iteration (initial_state ts).
        fold s in ITER, IN.
        move: IN => /(nthP (tsk,0)) IN; destruct IN as [i LT EQ].
        generalize EQ; rewrite ITER iterS in EQ; intro EQ'.
        fold s in EQ.
        unfold edf_rta_iteration in EQ.
        have MAP := @nth_map _ (tsk,0) _ _ (update_bound s).
        by rewrite MAP // EQ' in EQ; rewrite EQ.
      Qed.

    End Convergence.

    Section MainProof.

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

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

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

      (* 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, arrives_in arr_seq j -> job_task j \in ts.

      (* ...they have valid parameters,...*)
      Hypothesis H_valid_job_parameters:
        forall j,
          arrives_in arr_seq j ->
          valid_sporadic_job_with_jitter task_cost task_deadline task_jitter job_cost
                                         job_deadline job_task job_jitter j.

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

      (* Then, consider any schedule of this arrival sequence such that... *)
      Variable sched: schedule Job num_cpus.
      Hypothesis H_at_least_one_cpu: num_cpus > 0.
      Hypothesis H_jobs_come_from_arrival_sequence:
        jobs_come_from_arrival_sequence sched arr_seq.

      (* ...jobs only execute after jitter and no longer than their execution costs. *)
      Hypothesis H_jobs_execute_after_jitter:
        jobs_execute_after_jitter job_arrival job_jitter sched.
      Hypothesis H_completed_jobs_dont_execute:
        completed_jobs_dont_execute job_cost sched.

      (* Also assume that jobs are sequential. *)
      Hypothesis H_sequential_jobs: sequential_jobs sched.

      (* Assume that we have a work-conserving EDF scheduler. *)
      Hypothesis H_work_conserving: work_conserving job_arrival job_cost job_jitter arr_seq sched.
      Hypothesis H_edf_policy: respects_JLFP_policy job_arrival job_cost job_jitter arr_seq sched
                                                    (EDF job_arrival job_deadline).

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

      (* In the following theorem, we prove that any response-time bound contained
         in edf_claimed_bounds is safe. The proof follows by direct application of
         the main Theorem from bertogna_edf_theory.v. *)
      Theorem edf_analysis_yields_response_time_bounds :
        forall tsk R,
          (tsk, R) \In edf_claimed_bounds ts ->
          response_time_bounded_by tsk (task_jitter tsk + R).
      Proof.
        intros tsk R MATCH.
        assert (SOME: exists rt_bounds, edf_claimed_bounds ts = Some rt_bounds /\ (tsk, R) \in rt_bounds).
        {
          destruct (edf_claimed_bounds ts); last by done.
          by exists l; split.
        } clear MATCH; des.
        unfold edf_rta_iteration in *.
        have BOUND := bertogna_cirinei_response_time_bound_edf.
        unfold response_time_bounded_by, is_response_time_bound_of_task in *.
        intros j JOBtsk.
        apply BOUND with (task_cost := task_cost) (task_period := task_period)
           (arr_seq := arr_seq) (task_deadline := task_deadline) (job_deadline := job_deadline) (job_jitter := job_jitter)
           (job_task := job_task) (ts := ts) (tsk := tsk) (rt_bounds := rt_bounds); try (by ins).
          by unfold edf_claimed_bounds in SOME; desf; rewrite edf_claimed_bounds_unzip1_iteration.
          by ins; apply edf_claimed_bounds_finds_fixed_point_for_each_bound with (ts := ts).
          by ins; rewrite (edf_claimed_bounds_le_deadline ts rt_bounds).
      Qed.

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

      (*... no task misses its deadline. *)
      Theorem taskset_schedulable_by_edf_rta :
        forall tsk, tsk \in ts -> no_deadline_missed_by_task tsk.
      Proof.
        have RLIST := (edf_analysis_yields_response_time_bounds).
        have DL := (edf_claimed_bounds_le_deadline ts).
        have HAS := (edf_claimed_bounds_has_R_for_every_task ts).
        unfold no_deadline_missed_by_task, task_misses_no_deadline,
               job_misses_no_deadline, completed,
               edf_schedulable,
               valid_sporadic_job_with_jitter, valid_sporadic_job in *.
        rename H_valid_job_parameters into JOBPARAMS,
               H_valid_task_parameters into TASKPARAMS,
               H_constrained_deadlines into RESTR,
               H_completed_jobs_dont_execute into COMP,
               H_jobs_execute_after_jitter into AFTER,
               H_all_jobs_from_taskset into ALLJOBS,
               H_test_succeeds into TEST.
        move => tsk INtsk j ARRj JOBtsk.
        destruct (edf_claimed_bounds ts) as [rt_bounds |] eqn:SOME; last by ins.
        exploit (HAS rt_bounds tsk); [by ins | by ins | clear HAS; intro HAS; des].
        have COMPLETED := RLIST tsk R HAS j ARRj JOBtsk.
        exploit (DL rt_bounds tsk R);
          [by ins | by ins | clear DL; intro DL].
        apply leq_trans with (n := service sched j (job_arrival j + task_jitter tsk + R)); last first.
        {
          unfold valid_sporadic_taskset, is_valid_sporadic_task in *.
          rewrite extend_sum // -addnA leq_add2l.
          specialize (JOBPARAMS j ARRj); des; rewrite JOBPARAMS2.
          by rewrite JOBtsk.
        }
        by rewrite -addnA.
      Qed.

      (* For completeness, since all jobs of the arrival sequence
         are spawned by the task set, we conclude that no job misses
         its deadline. *)
      Theorem jobs_schedulable_by_edf_rta :
        forall j, arrives_in arr_seq j -> no_deadline_missed_by_job j.
      Proof.
        intros j ARRj.
        have SCHED := taskset_schedulable_by_edf_rta.
        unfold no_deadline_missed_by_task, task_misses_no_deadline in *.
        apply SCHED with (tsk := job_task j); try (by done).
        by apply H_all_jobs_from_taskset.
      Qed.

    End MainProof.

  End Analysis.

End ResponseTimeIterationEDF.


(* Contribution to the Coq Library   V6.3 (July 1999)                    *)

(****************************************************************************)
(*                                                                          *)
(*           Definitions and lemmas about Paths, Implicants and Primes      *)
(*                                                                          *)
(****************************************************************************)
(*                              Prelude_Paths.v                             *)
(****************************************************************************)

Require Export List.
Require Import Prelude_BDT.
Require Import CanonBDDs.rauzy.algorithme1.Boolean_functions.
Require Import CanonBDDs.rauzy.algorithme1.BDTs.

(*-------------                    Paths                    --------------*)

Definition Path := list nat.
Definition Cons := cons (A:=nat).
Definition Nil := nil (A:=nat).
Definition Of := In (A:=nat).
Hint Unfold Of.

Lemma Of_path_dec : forall (p : Path) (i : nat), Of i p \/ ~ Of i p.
Proof.
exact (In_list_dec nat eq_nat_dec).
Qed.

Lemma I_of_cons_ip : forall (p : Path) (i : nat), Of i (Cons i p).
Proof.
simpl in |- *; auto with arith.
Qed.
Hint Resolve I_of_cons_ip.

Lemma Of_p_of_cons_ip :
 forall (p : Path) (i j : nat), Of j p -> Of j (Cons i p).
Proof.
intros p i j.
unfold Of, Cons in |- *; auto with arith.
Qed.
Hint Resolve Of_p_of_cons_ip.

Lemma Of_cons_ip_of_p :
 forall (p : Path) (i j : nat), Of j (Cons i p) -> i <> j -> Of j p.
Proof.
intros p i j.
unfold Of at 1 in |- *; simpl in |- *; simple induction 1;
 [ intro; simple induction 1; assumption | trivial with arith ].
Qed.

Lemma Not_of_cons_ip :
 forall (p : Path) (i j : nat), ~ Of j p -> i <> j -> ~ Of j (Cons i p).
Proof.
intros.
change (~ (i = j \/ Of j p)) in |- *.
apply deMorgan_not_or; trivial with arith.
Qed.
Hint Resolve Not_of_cons_ip.

Lemma Nil_or_not_Nil : forall p : Path, p = Nil \/ (exists k : nat, Of k p).
Proof.
simple induction p.
auto with arith.
intros a tl H.
right; exists a; auto with arith.
Qed.

Lemma Empty_is_Nil : forall p : Path, (forall i : nat, ~ Of i p) -> p = Nil.
Proof.
intro p; elim (Nil_or_not_Nil p); auto with arith.
simple induction 1; intros k Hk Hp; absurd (Of k p); auto with arith.
Qed.

(*----------     Inclusion of paths   =   Division of products    -----------*)

Definition Divides (p1 p2 : Path) := forall i : nat, Of i p1 -> Of i p2.

Lemma Divides_reflexive : forall p : Path, Divides p p.
Proof.
unfold Divides in |- *; auto with arith.
Qed.
Hint Resolve Divides_reflexive.

Lemma Divides_trans :
 forall p1 p2 p3 : Path, Divides p1 p2 -> Divides p2 p3 -> Divides p1 p3.
Proof.
unfold Divides in |- *; auto with arith.
Qed.

Lemma Divides_p_cons_ip : forall (p : Path) (i : nat), Divides p (Cons i p).
Proof.
unfold Divides in |- *.
intros p i; exact (Of_p_of_cons_ip p i).
Qed.
Hint Resolve Divides_p_cons_ip.

Lemma Nil_divides_all : forall p : Path, Divides Nil p.
Proof.
unfold Divides, Of, Nil in |- *; exact (nil_included_all nat).
Qed.

Lemma Divides_Nil_is_Nil : forall p : Path, Divides p Nil -> p = Nil.
Proof.
intro p.
unfold Divides in |- *; intro H.
apply Empty_is_Nil; exact H.
Qed.

Lemma L8 :
 forall (p1 p2 : Path) (i : nat),
 Divides p1 (Cons i p2) -> ~ Of i p1 -> Divides p1 p2.
Proof.
intros p1 p2 i H1 H2.
unfold Divides in |- *.
intros j Hj.
elim (H1 j Hj);
 [ intro Habs; absurd (Of j p1); [ elim Habs; assumption | assumption ]
 | trivial with arith ].
Qed.

Lemma L80 :
 forall (p1 p2 : Path) (i : nat), Divides p1 p2 -> ~ Of i p2 -> ~ Of i p1.
Proof.
intros p1 p2 i.
unfold Divides in |- *; intros H1 H2.
apply Contra with (Of i p2); auto with arith.
Qed.

Lemma Divides_tail_divides_cons :
 forall (p1 p2 : Path) (i : nat),
 Divides p1 p2 -> Divides (Cons i p1) (Cons i p2).
Proof.
intros p1 p2 i.
unfold Divides in |- *; intros H1 j; simpl in |- *.
simple induction 1; auto with arith.
Qed.
Hint Resolve Divides_tail_divides_cons.

(*-----------     Ordered paths  (for solutions of BDT)       -------------*)

Definition Head (p : Path) :=
  match p return nat with
  | nil =>
      (*   Nil   *)  0
      (* [i,tlp] *)
  | i :: tlp => i
  end.

Lemma Tail_exists :
 forall (p : Path) (i : nat),
 Of i p -> exists p' : Path, p = Cons (Head p) p'.
Proof.
simple induction p.
intros.
absurd (Of i nil); try assumption.
unfold Of in |- *; simpl in |- *; contradiction.
clear p.
intros j p Hp i Hi.
exists p; trivial with arith.
Qed.

Lemma Head_of_p_in_p : forall (p : Path) (i : nat), Of i p -> Of (Head p) p.
Proof.
simple induction p; [ simpl in |- *; contradiction | auto with arith ].
Qed.

Inductive Ordered : Path -> Prop :=
  | Nil_ordered : Ordered Nil
  | Cons_ordered :
      forall p : Path,
      Ordered p -> forall i : nat, i > Head p -> Ordered (Cons i p).

Hint Resolve Nil_ordered Cons_ordered.

Definition inv_Ordered (p : Path) :=
  match p return Prop with
  | nil =>
      (*   Nil   *)  True
      (* [i,tlp] *)
  | i :: tlp => i > Head tlp /\ Ordered tlp
  end.

Lemma p_inv_Ordered : forall p : Path, Ordered p -> inv_Ordered p.
Proof.
simple induction 1; simpl in |- *; auto with arith.
Qed.
Hint Resolve p_inv_Ordered.

Lemma Ordered_cons_ordered_tail :
 forall (i : nat) (p : Path), Ordered (Cons i p) -> Ordered p.
Proof.
intros i p H.
elim (p_inv_Ordered (Cons i p) H); auto with arith.
Qed.

Lemma L11 : forall (i : nat) (p : Path), Ordered (Cons i p) -> ~ Of i p.
Proof.
intro i; simple induction p;
 [ intro; exact (in_nil (a:=i)) | clear p; intros j q Hq H ].
change (~ (j = i \/ Of i q)) in |- *.
apply deMorgan_not_or.
apply Contra with (i = j); [ auto with arith | apply gt_neq ].
elim (p_inv_Ordered (Cons i (Cons j q))); auto with arith.
apply Hq.
elim (p_inv_Ordered (Cons j q));
 [ intros H1 H2 | apply Ordered_cons_ordered_tail with i; assumption ].
apply Cons_ordered;
 [ assumption
 | apply gt_trans with j;
    [ elim (p_inv_Ordered (Cons i (Cons j q))); auto with arith | assumption ] ].
Qed.

Lemma Head_max_of_ordered_path :
 forall p : Path, Ordered p -> forall i : nat, Of i p -> i <= Head p.
Proof.
simple induction 1;
 [ simpl in |- *; contradiction | clear H p; intros p Hp Hrec i Hi j Hj ].
simpl in |- *; simpl in Hj.
elim Hj; [ simple induction 1; trivial with arith | intro ].
apply gt_le_weak; apply gt_le_trans with (Head p); auto with arith.
Qed.

Lemma La_4bis :
 forall p : Path,
 Ordered p ->
 forall i : nat, Of i p -> (forall j : nat, j > i -> ~ Of j p) -> i = Head p.
Proof.
intros p Hp i H1i H2i.
elim (le_lt_or_eq i (Head p) (Head_max_of_ordered_path p Hp i H1i));
 [ intro Habsurde | trivial with arith ].
absurd (Of (Head p) p);
 [ apply H2i; apply lt_gt; assumption
 | apply Head_of_p_in_p with i; assumption ].
Qed.

Lemma Divides_cons_divides_tail :
 forall (p1 p2 : Path) (i : nat),
 Ordered (Cons i p1) ->
 Ordered (Cons i p2) -> Divides (Cons i p1) (Cons i p2) -> Divides p1 p2.
Proof.
intros p1 p2 i H1 H2.
unfold Divides in |- *; simpl in |- *.
intros H j Hj.
elim (H j); [ idtac | trivial with arith | auto with arith ].
intro Habsurde.
absurd (Of i p1); [ exact (L11 i p1 H1) | rewrite Habsurde; assumption ].
Qed.

Lemma Pth_ord8 :
 forall p : Path, Ordered p -> forall i : nat, Of i p -> i > 0.
Proof.
simple induction 1.
intros i Hi.
absurd (Of i Nil); [ exact (in_nil (a:=i)) | assumption ].
clear H p; intros p H Hrec i Hi j Hj.
unfold Of in Hj; elim Hj.
  (* case i=j *)
simple induction 1; apply gt_le_trans with (Head p); auto with arith.
  (* case j in p *)
auto with arith.
Qed.

Lemma Pth_ord9 :
 forall (i : nat) (p1 : Path),
 Ordered (Cons i p1) ->
 forall p2 : Path, Ordered p2 -> Divides p2 p1 -> Ordered (Cons i p2).
Proof.
simple induction p2.
  (* case p2=nil *)
intros.
apply Cons_ordered;
 [ assumption | apply (Pth_ord8 (Cons i p1) H i); auto with arith ].
  (* case p2=/= nil *)
clear p2; intros hp2 tlp2 Hrec Hp2 Hdiv.
apply Cons_ordered; try assumption.
apply gt_le_trans with (Head p1);
 [ elim (p_inv_Ordered (Cons i p1) H); auto with arith
 | apply Head_max_of_ordered_path ].
elim (p_inv_Ordered (Cons i p1) H); auto with arith.
unfold Divides in Hdiv.
apply Hdiv; apply Head_of_p_in_p with (i := hp2); auto with arith.
Qed.

Lemma Cons_equal_head_equal :
 forall (i1 : nat) (tl1 : Path),
 Ordered (Cons i1 tl1) ->
 forall (i2 : nat) (tl2 : Path),
 Ordered (Cons i2 tl2) ->
 Divides (Cons i1 tl1) (Cons i2 tl2) ->
 Divides (Cons i2 tl2) (Cons i1 tl1) -> i1 = i2.
Proof.
intros i1 tl1 HO1 i2 tl2 HO2 Hdiv1 Hdiv2.
apply le_antisym.
change (Head (Cons i1 tl1) <= Head (Cons i2 tl2)) in |- *.
apply Head_max_of_ordered_path; auto with arith.
change (Head (Cons i2 tl2) <= Head (Cons i1 tl1)) in |- *.
apply Head_max_of_ordered_path; auto with arith.
Qed.

Lemma Ordered_paths_eq :
 forall p1 : Path,
 Ordered p1 ->
 forall p2 : Path, Ordered p2 -> Divides p1 p2 -> Divides p2 p1 -> p1 = p2.
Proof.
simple induction 1; clear H p1.
simple induction 1; try clear H p2.
(* case Nil Nil *)
trivial with arith.
(* case Nil Cons *)
intros p1 HO1 Hrec1 i Hi Hdiv1 Hdiv2.
unfold Divides in Hdiv2.
absurd (Of i Nil); [ exact (in_nil (a:=i)) | auto with arith ].
intros tl1 HO_tl1 Hrec_tl1 i1 Hi1.
simple induction 1.
(* case Cons Nil *)
intro Hdiv1.
unfold Divides in Hdiv1.
absurd (Of i1 Nil); [ exact (in_nil (a:=i1)) | auto with arith ].
(* case Cons Cons *)
intros tl2 HO_tl2 Hrec_tl2 i2 Hi2 Hdiv1 Hdiv2.
elim (Hrec_tl1 tl2 HO_tl2).
elim
 (Cons_equal_head_equal i1 tl1 (Cons_ordered tl1 HO_tl1 i1 Hi1) i2 tl2
    (Cons_ordered tl2 HO_tl2 i2 Hi2) Hdiv1 Hdiv2);
 trivial with arith.
apply (Divides_cons_divides_tail tl1 tl2 i1);
 [ auto with arith
 | pattern i1 in |- *;
    rewrite
     (Cons_equal_head_equal i1 tl1 (Cons_ordered tl1 HO_tl1 i1 Hi1) i2 tl2
        (Cons_ordered tl2 HO_tl2 i2 Hi2) Hdiv1 Hdiv2)
     ; auto with arith
 | pattern i1 at 2 in |- *;
    rewrite
     (Cons_equal_head_equal i1 tl1 (Cons_ordered tl1 HO_tl1 i1 Hi1) i2 tl2
        (Cons_ordered tl2 HO_tl2 i2 Hi2) Hdiv1 Hdiv2)
     ; assumption ].
apply (Divides_cons_divides_tail tl2 tl1 i1);
 [ pattern i1 in |- *;
    rewrite
     (Cons_equal_head_equal i1 tl1 (Cons_ordered tl1 HO_tl1 i1 Hi1) i2 tl2
        (Cons_ordered tl2 HO_tl2 i2 Hi2) Hdiv1 Hdiv2)
     ; auto with arith
 | auto with arith
 | pattern i1 at 1 in |- *;
    rewrite
     (Cons_equal_head_equal i1 tl1 (Cons_ordered tl1 HO_tl1 i1 Hi1) i2 tl2
        (Cons_ordered tl2 HO_tl2 i2 Hi2) Hdiv1 Hdiv2)
     ; assumption ].
Qed.

Lemma Ordered_divisor_of_cons_ip :
 forall (i : nat) (p : Path),
 Ordered (Cons i p) ->
 forall p' : Path,
 Divides p' (Cons i p) ->
 Ordered p' -> Of i p' -> exists tl' : Path, p' = Cons i tl'.
Proof.
intros i p HO p' H1 H2 H3.
elim (Tail_exists p' i H3); intros tl' Def_tl'.
exists tl'.
rewrite (La_4bis p' H2 i H3); [ trivial with arith | intros j Hj ].
unfold not in |- *; intro Habs; absurd (j > i);
 [ unfold Divides in H1; apply le_not_gt | assumption ].
change (j <= Head (Cons i p)) in |- *; apply Head_max_of_ordered_path;
 auto with arith.
Qed.

(*------------------         Solutions of a BDT       --------------------*)

Inductive Solution : Path -> BDT -> Prop :=
  | Sol_One : Solution Nil One
  | Sol_Left :
      forall (i : nat) (h l : BDT) (p : Path),
      Solution p h -> Solution (Cons i p) (Node i h l)
  | Sol_Right :
      forall (i : nat) (h l : BDT) (p : Path),
      Solution p l -> Solution p (Node i h l).

Hint Resolve Sol_One Sol_Left Sol_Right.

Definition Inv_Solution (p : Path) (b : BDT) :=
  match b return Prop with
  | Zero =>
      (* Zero *)  False
      (* One  *)
  | One => p = Nil :>Path
      (* Node(i,h,l) *)
  | Node i h l =>
      Solution p l \/ (exists p' : Path, Solution p' h /\ p = Cons i p')
  end.

Hint Unfold Inv_Solution.

Lemma p_inv_Solution :
 forall (p : Path) (b : BDT), Solution p b -> Inv_Solution p b.
Proof.
simple induction 1; [ auto with arith | idtac | auto with arith ].
clear H b p.
intros i h l p Def_p H.
unfold Inv_Solution in |- *.
right; exists p; auto with arith.
Qed.
Hint Resolve p_inv_Solution.

Lemma No_solution_Zero : forall p : Path, ~ Solution p Zero.
Proof.
unfold not in |- *; intros p H.
change (Inv_Solution p Zero) in |- *; auto with arith.
Qed.

Lemma Solution_of_One_is_Nil : forall p : Path, Solution p One -> p = Nil.
Proof.
intros.
change (Inv_Solution p One) in |- *; auto with arith.
Qed.

Lemma L1 :
 forall (i : nat) (h l : BDT) (p : Path),
 Solution p (Node i h l) ->
 Solution p l \/ (exists p' : Path, Solution p' h /\ p = Cons i p').
Proof.
intros i h l p H.
change (Inv_Solution p (Node i h l)) in |- *; auto with arith.
Qed.

Lemma Head_of_solution_le_dim :
 forall (p : Path) (b : BDT), Solution p b -> OBDT b -> Head p <= Dim b.
Proof.
simple induction 1;
 [ auto with arith
 | auto with arith
 | clear H p b; intros i h l p Def_p Hrec HO ].
apply le_trans with (Dim l);
 [ apply Hrec; elim (ordered_node_ordered_sons i h l HO); auto with arith
 | apply gt_le_weak; elim (dim_node_dim_sons i h l); auto with arith ].
Qed.

Lemma Solution_OBDT_ordered :
 forall (b : BDT) (p : Path), Solution p b -> OBDT b -> Ordered p.
Proof.
simple induction 1;
 [ auto with arith
 | clear H p b; intros i h l p Def_p Hrec Hnode
 | clear H p b; intros i h l p Def_p Hrec Hnode ].
apply Cons_ordered.
apply Hrec; elim (ordered_node_ordered_sons i h l Hnode); auto with arith.
apply gt_le_trans with (Dim h);
 [ elim (dim_node_dim_sons i h l); auto with arith
 | apply (Head_of_solution_le_dim p h Def_p);
    elim (ordered_node_ordered_sons i h l Hnode); auto with arith ].
apply Hrec; elim (ordered_node_ordered_sons i h l Hnode); auto with arith.
Qed.

Lemma Gt_dim_out_of_solution :
 forall (b : BDT) (p : Path),
 Solution p b -> OBDT b -> forall i : nat, i > Dim b -> ~ Of i p.
Proof.
intros b p Def_p Hb i Hi.
unfold not in |- *; intro Habsurde.
absurd (i > i); [ auto with arith | apply gt_le_trans with (Head p) ].
apply gt_le_trans with (Dim b);
 [ assumption | exact (Head_of_solution_le_dim p b Def_p Hb) ].
exact
 (Head_max_of_ordered_path p (Solution_OBDT_ordered b p Def_p Hb) i Habsurde).
Qed.

Lemma Tail_exists_with_dim_head :
 forall (i : nat) (h l : BDT),
 OBDT (Node i h l) ->
 forall p : Path,
 Solution p (Node i h l) ->
 forall p' : Path,
 Ordered p' ->
 Of i p' -> Divides p' p -> exists tlp' : Path, p' = Cons i tlp'.
Proof.
intros i h l HO p Def_p p' H1p' H2p' H3p'.
elim (Tail_exists p' i H2p'); intros tlp' Def_tlp'.
exists tlp'.
elim (le_antisym (Head p') i);
 [ assumption | idtac | exact (Head_max_of_ordered_path p' H1p' i H2p') ].
apply le_trans with (Head p);
 [ idtac | exact (Head_of_solution_le_dim p (Node i h l) Def_p HO) ].
apply Head_max_of_ordered_path;
 [ exact (Solution_OBDT_ordered (Node i h l) p Def_p HO) | idtac ].
unfold Divides in H3p'; apply H3p'.
pattern p' at 2 in |- *; rewrite Def_tlp'; trivial with arith.
Qed.

Lemma LT1 :
 forall b : BDT, OBDT b -> b = Zero \/ (exists p : Path, Solution p b).
Proof.
simple induction 1;
 [ auto with arith
 | right; exists Nil; trivial with arith
 | intros l r HOl Hl HOr Hr i H1i H2i Hsons ].
elim Hr; [ intro Hr0 | simple induction 1; intros sr Def_sr ].
elim Hl; [ intro Hl0 | simple induction 1; intros sl Def_sl ].
clear Hl. clear Hr.
elim Hsons; rewrite Hl0; rewrite Hr0; trivial with arith.
right; exists (Cons i sl); auto with arith.
right; exists sr; auto with arith.
Qed.

(*--------------      Assignments defined by a Path        --------------*)

Definition Assignment_of (p : Path) (A : Assign) :=
  (forall i : nat, Of i p -> A i = true) /\
  (forall i : nat, ~ Of i p -> A i = false).

Lemma Ass_of_well_defined :
 forall p : Path, exists A : Assign, Assignment_of p A.
Proof.
simple induction p.
(*  p=Nil  *)
exists (fun i : nat => false).
unfold Assignment_of in |- *; split;
 [ intros i Habs; absurd (Of i nil); try assumption; unfold Of in |- *;
    exact (in_nil (a:=i))
 | trivial with arith ].
(*  p=Cons(a,l)  *)
intros a l.
simple induction 1; intros Al Def_Al; clear H.
unfold Assignment_of in Def_Al; elim Def_Al; intros HAl1 HAl2; clear Def_Al.
exists (Upd Al a true).
unfold Assignment_of in |- *; split.
     (* variables assigned to true *)
intro i; replace (Of i (a :: l)) with (a = i \/ In i l); trivial with arith.
simple induction 1.
(* PB Changein Intros i Hi; Change a=i \/ (In nat i l) in Hi.
Elim Hi; Clear Hi.*)
simple induction 1; exact (L_Assign2 Al a true).
intro H_i_in_l.
elim (eq_nat_dec a i);
 [ simple induction 1; exact (L_Assign2 Al a true)
 | intro adifi; rewrite <- (HAl1 i H_i_in_l);

    (* PB was Exact (L_Assign3 Al a i adifi true)].*)
    exact (L_Assign3 Al a i adifi (Al i)) ].
     (* variables assigned to false *)
intro i; replace (~ Of i (a :: l)) with (~ (a = i \/ In i l));
 trivial with arith; intro Hi.
elim (deMorgan_and_not (a = i) (In i l) Hi); intros Hi_1 Hi_2; clear Hi.
rewrite <- (HAl2 i Hi_2).
exact (L_Assign3 Al a i Hi_1 true).
Qed.

Lemma Div_div_ass_eq :
 forall p1 p2 : Path,
 Divides p1 p2 ->
 Divides p2 p1 ->
 forall A1 : Assign,
 Assignment_of p1 A1 ->
 forall A2 : Assign, Assignment_of p2 A2 -> Ass_eq A1 A2.
Proof.
intros p1 p2.
unfold Divides in |- *; intros H12 H21.
intros A1 Def_A1 A2 Def_A2.
unfold Assignment_of in Def_A1; elim Def_A1; intros HA1_in HA1_out;
 clear Def_A1.
unfold Assignment_of in Def_A2; elim Def_A2; intros HA2_in HA2_out;
 clear Def_A2.
unfold Ass_eq in |- *; intro i.
elim (Of_path_dec p1 i); intro H.
apply (trans_equal (A:=bool)) with true;
 [ auto with arith | symmetry  in |- *; auto with arith ].
apply (trans_equal (A:=bool)) with false;
 [ auto with arith | symmetry  in |- * ].
apply HA2_out; apply Contra with (Of i p1); auto with arith.
Qed.

Lemma Assign_of_cons :
 forall (p : Path) (i : nat) (A : Assign),
 Assignment_of (Cons i p) A -> A i = true.
Proof.
intros p i A.
unfold Assignment_of in |- *.
simple induction 1; intros H1 H2; clear H.
apply H1; unfold Of, Cons in |- *; trivial with arith.
Qed.

Lemma Inv_Assignment_of_true :
 forall (p : Path) (A : Assign),
 Assignment_of p A -> forall i : nat, A i = true -> Of i p.
Proof.
intros p A.
unfold Assignment_of in |- *.
simple induction 1; intros H1 H2; clear H.
intros i Def_i.
elim (Of_path_dec p i);
 [ trivial with arith | intro Habsurde; absurd (A i = false) ].
rewrite Def_i; exact diff_true_false.
auto with arith.
Qed.

Lemma Inv_Assignment_of_false :
 forall (p : Path) (A : Assign),
 Assignment_of p A -> forall i : nat, A i = false -> ~ Of i p.
Proof.
intros p A.
unfold Assignment_of in |- *.
simple induction 1; intros H1 H2; clear H.
intros i Def_i.
elim (Of_path_dec p i);
 [ intro Habsurde; absurd (A i = true) | trivial with arith ].
apply Contra with (true = A i);
 [ auto with arith | rewrite Def_i; exact diff_true_false ].
auto with arith.
Qed.

Lemma Assign_of_cons_eq :
 forall (p : Path) (A : Assign),
 Assignment_of p A ->
 forall (i : nat) (A' : Assign),
 Assignment_of (Cons i p) A' -> A' = Upd A i true.
Proof.
intros p A Def_A i A' Def_A'.
apply Extensionality_Assignments; unfold Ass_eq in |- *.
intro j.
unfold Assignment_of in Def_A'; elim Def_A'; intros HA'_in HA'_out.
(* PB Change (Assignment_of (Cons i p) A') in Def_A'. *)
generalize Def_A';
 change (Assignment_of (Cons i p) A' -> A' j = Upd A i true j) in |- *;
 clear Def_A'; intro Def_A'.
unfold Assignment_of in Def_A; elim Def_A; intros HA_in HA_out.
(* PB Change (Assignment_of p A) in Def_A. *)
generalize Def_A; change (Assignment_of p A -> A' j = Upd A i true j) in |- *;
 clear Def_A; intro Def_A.
elim (Of_path_dec p j); elim (eq_nat_dec i j); intros H1 H2.
(*-- (Of j p) /\ i=j --*)
apply (trans_equal (A:=bool)) with true;
 [ elim H1; apply (Assign_of_cons p); assumption
 | elim H1; symmetry  in |- *; exact (L_Assign2 A i true) ].
(*-- (Of j p) /\ ~ i=j --*)
apply (trans_equal (A:=bool)) with true;
 [ apply HA'_in; auto with arith
 | apply (trans_equal (A:=bool)) with (A j);
    [ symmetry  in |- *; apply HA_in; trivial with arith
    | symmetry  in |- *; exact (L_Assign3 A i j H1 true) ] ].
(*-- ~(Of j p) /\ i=j --*)
apply (trans_equal (A:=bool)) with true;
 [ elim H1; apply (Assign_of_cons p); assumption
 | elim H1; symmetry  in |- *; exact (L_Assign2 A i true) ].
(*-- ~(Of j p) /\ ~ i=j --*)
apply (trans_equal (A:=bool)) with false;
 [ apply HA'_out; auto with arith
 | apply (trans_equal (A:=bool)) with (A j);
    [ symmetry  in |- *; apply HA_out; trivial with arith
    | symmetry  in |- *; exact (L_Assign3 A i j H1 true) ] ].
Qed.

Lemma Cons_of_non_depvar :
 forall (p : Path) (A : Assign),
 Assignment_of p A ->
 forall (i : nat) (A' : Assign),
 Assignment_of (Cons i p) A' -> forall f : BF, ~ Dep_Var f i -> f A = f A'.
Proof.
intros p A Def_A i A' Def_A' f Hi.
rewrite (Assign_of_cons_eq p A Def_A i A' Def_A').
change (f A = Frestr f i true A) in |- *.
generalize A; change (BF_eq f (Frestr f i true)) in |- *.
apply L_Dep_Var1; trivial with arith.
Qed.

(*----------     Subtraction of an element in a Path         --------------*)

Definition Sub (p : Path) (i : nat) : Path :=
  (fix F (l : list nat) : Path :=
     match l with
     | nil => Nil
     | n :: l0 =>
         match eq_nat_dec i n with
         | left _ => F l0
         | right _ => Cons n (F l0)
         end
     end) p.
(*     Nil     *)
(* (Cons j tl) *)

Lemma I_out_of_Sub_ip : forall (p : Path) (i : nat), ~ Of i (Sub p i).
Proof.
simple induction p.
simpl in |- *; unfold not in |- *; trivial with arith.
clear p; intros a p Hp i; simpl in |- *.
elim (eq_nat_dec i a); auto with arith.
Qed.
Hint Resolve I_out_of_Sub_ip.

Lemma jofp_jofsub_ip :
 forall (p : Path) (i j : nat), Of j p -> i <> j -> Of j (Sub p i).
Proof.
simple induction p.
simpl in |- *; contradiction.
clear p; intros a p Hp i j H1j H2j; simpl in |- *.
elim (eq_nat_dec i a); intro H.
apply Hp; try assumption.
apply Of_cons_ip_of_p with i; try assumption.
rewrite H; assumption.
simpl in |- *; simpl in H1j.
elim H1j; auto with arith.
Qed.
Hint Resolve jofp_jofsub_ip.

Lemma Of_sub_pi_of_p :
 forall (p : Path) (i j : nat), Of j (Sub p i) -> Of j p.
Proof.
simple induction p.
simpl in |- *; contradiction.
clear p; intros a p Hp i j; simpl in |- *.
elim (eq_nat_dec i a);
 [ intros; right; apply Hp with i; assumption
 | intro; simpl in |- *; simple induction 1;
    [ auto with arith | intro; right; apply Hp with i; assumption ] ].
Qed.

Lemma Outof_p_outof_sub_ip :
 forall (p : Path) (i j : nat), ~ Of j p -> ~ Of j (Sub p i).
Proof.
intros.
apply Contra with (Of j p); [ exact (Of_sub_pi_of_p p i j) | assumption ].
Qed.
Hint Resolve Outof_p_outof_sub_ip.

Lemma Head_sub_ordered :
 forall p : Path, Ordered p -> forall i : nat, Head (Sub p i) <= Head p.
Proof.
simple induction 1;
 [ simpl in |- *; trivial with arith
 | clear H p; intros p H1p H2p i Hi j; simpl in |- * ].
elim (eq_nat_dec j i); intro Cas.
(* case i=j *)
apply le_trans with (Head p); auto with arith.
(* case i=/=j *)
auto with arith.
Qed.

Lemma Ordered_p_ordered_sub_pi :
 forall (i : nat) (p : Path), Ordered p -> Ordered (Sub p i).
Proof.
intro i; simple induction p;
 [ simpl in |- *; trivial with arith | intros hp tlp Hrec Hp ].
simpl in |- *; elim (eq_nat_dec i hp); intro Cas.
apply Hrec; apply Ordered_cons_ordered_tail with hp; assumption.
apply Cons_ordered;
 [ apply Hrec; apply Ordered_cons_ordered_tail with hp; assumption
 | apply gt_le_trans with (Head tlp) ].
elim (p_inv_Ordered (Cons hp tlp) Hp); auto with arith.
apply Head_sub_ordered; apply Ordered_cons_ordered_tail with hp; assumption.
Qed.

(*------------    Assignments of subtracted paths      ---------------*)

Lemma Assign_of_sub :
 forall (p : Path) (i : nat) (A : Assign),
 Assignment_of (Sub p i) A -> A i = false.
Proof.
intros p i A.
unfold Assignment_of in |- *.
simple induction 1; intros H1 H2; clear H.
apply H2; auto with arith.
Qed.

Lemma Assign_of_sub_eq :
 forall (p : Path) (A : Assign),
 Assignment_of p A ->
 forall (i : nat) (A' : Assign),
 Assignment_of (Sub p i) A' -> A' = Upd A i false.
Proof.
intros p A Def_A i A' Def_A'.
apply Extensionality_Assignments; unfold Ass_eq in |- *.
intro j.
unfold Assignment_of in Def_A'; elim Def_A'; intros HA'_in HA'_out.
(* PB Change (Assignment_of (Sub p i) A') in Def_A'. *)
generalize Def_A';
 change (Assignment_of (Sub p i) A' -> A' j = Upd A i false j) in |- *;
 clear Def_A'; intro Def_A'.
unfold Assignment_of in Def_A; elim Def_A; intros HA_in HA_out.
(* PB Change (Assignment_of p A) in Def_A. *)
generalize Def_A;
 change (Assignment_of p A -> A' j = Upd A i false j) in |- *;
 clear Def_A; intro Def_A.
elim (Of_path_dec p j); elim (eq_nat_dec i j); intros H1 H2.
(*-- (Of j p) /\ i=j --*)
apply (trans_equal (A:=bool)) with false;
 [ elim H1; apply (Assign_of_sub p); assumption
 | elim H1; symmetry  in |- *; exact (L_Assign2 A i false) ].
(*-- (Of j p) /\ ~ i=j --*)
apply (trans_equal (A:=bool)) with true;
 [ apply HA'_in; auto with arith
 | apply (trans_equal (A:=bool)) with (A j);
    [ symmetry  in |- *; apply HA_in; trivial with arith
    | symmetry  in |- *; exact (L_Assign3 A i j H1 false) ] ].
(*-- ~(Of j p) /\ i=j --*)
apply (trans_equal (A:=bool)) with false;
 [ elim H1; apply (Assign_of_sub p); assumption
 | elim H1; symmetry  in |- *; exact (L_Assign2 A i false) ].
(*-- ~(Of j p) /\ ~ i=j --*)
apply (trans_equal (A:=bool)) with false;
 [ apply HA'_out; auto with arith
 | apply (trans_equal (A:=bool)) with (A j);
    [ symmetry  in |- *; apply HA_out; trivial with arith
    | symmetry  in |- *; exact (L_Assign3 A i j H1 false) ] ].
Qed.

Lemma Sub_of_non_depvar :
 forall (p : Path) (A : Assign),
 Assignment_of p A ->
 forall (i : nat) (A' : Assign),
 Assignment_of (Sub p i) A' -> forall f : BF, ~ Dep_Var f i -> f A = f A'.
Proof.
intros p A Def_A i A' Def_A' f Hi.
rewrite (Assign_of_sub_eq p A Def_A i A' Def_A').
change (f A = Frestr f i false A) in |- *.
generalize A; change (BF_eq f (Frestr f i false)) in |- *.
apply L_Dep_Var1; trivial with arith.
Qed.


Require Import Reals MyRIneq Fourier Lia Lra.
Require Import Rsequence_usual_facts.

Local Open Scope R_scope.

Lemma pow_lt_compat : forall x y, 0 <= x -> x < y ->
  forall n, (1 <= n)%nat -> x ^ n < y ^ n.
Proof.
intros x y x_pos x_lt_y n n_lb.
 induction n.
 apply False_ind ; intuition; try lia.
 destruct n.
 simpl ; repeat (rewrite Rmult_1_r) ; assumption.
 assert (Hrew : forall a n, a ^ S (S n) = a * a ^ S n).
  intros a m ; simpl ; reflexivity.
 destruct x_pos as [x_pos | x_null].
 do 2 rewrite Hrew.
  repeat (rewrite Hrew) ; apply Rmult_gt_0_lt_compat ; [apply pow_lt | | | apply IHn] ; intuition.
  apply Rlt_gt ; transitivity x ; assumption.
 rewrite Hrew, <- x_null, Rmult_0_l ; apply pow_lt ;
  apply Rle_lt_trans with x ; [right |] ; auto.
Qed.

Lemma pow_le_compat : forall x y, 0 <= x -> x <= y ->
 forall n, x ^ n <= y ^ n.
Proof.
intros x y x_pos x_lt_y n.
induction n.
simpl ; apply Req_le ; reflexivity.
simpl ; apply Rmult_le_compat ; [| apply pow_le | |] ; assumption.
Qed.

Lemma pow2_sqr : forall r, r² = r ^ 2.
Proof.
intros ; rewrite <- (mult_1_r 2), pow_Rsqr, pow_1 ; reflexivity.
Qed.

Lemma pow2_pos : forall r, 0 <= r ^ 2.
Proof.
intro r ; rewrite <- pow2_sqr ; apply Rle_0_sqr.
Qed.

Lemma Rsqrt_sqr : forall x (y : nonnegreal),
  0 <= x -> (x ^ 2 = y)%R -> Rsqrt y = x.
Proof.
intros x y x_pos Heq ; unfold Rsqrt.
 destruct (Rsqrt_exists y (cond_nonneg y)) as [z [z_pos Hz]].
 apply Rsqr_inj ; try assumption.
 symmetry ; rewrite pow2_sqr, Heq ; apply Hz.
Qed.

Lemma Rsqr_Rsqrt : forall x, Rsqrt x ^ 2 = x.
Proof.
intro ; simpl ; rewrite <- Rmult_assoc, Rsqrt_Rsqrt ; apply Rmult_1_r.
Qed.

Lemma Rsqrt_mult_distr : forall (x y z : nonnegreal), x * y = z ->
  Rsqrt z = Rsqrt x * Rsqrt y.
Proof.
intros x y z Heq ; apply Rsqr_inj.
 apply Rsqrt_positivity.
 apply Rmult_le_pos ; apply Rsqrt_positivity.
 rewrite Rsqr_mult.
 unfold Rsqr ; do 3 rewrite Rsqrt_Rsqrt ; auto.
Qed.

Lemma Rsqrt_pow_even : forall r n, Rsqrt r ^ (2 * n) = r ^ n.
Proof.
intros r n ; rewrite pow_sqr, Rsqrt_Rsqrt ; reflexivity.
Qed.

Lemma sum_pow : forall (q : R) (m k : nat),
  q <> 1 ->
  sum_f_R0 (fun i : nat => q ^ (m + i)) k = q^m * (1 - q ^ S k) / (1 - q).
Proof.
intros q m k q_neq_1.
 induction m.
  assert (H := tech3 q k q_neq_1) ; rewrite Rmult_1_l ; rewrite <- H ; unfold pow ; simpl ;
  apply sum_eq ; intros i i_ub ; intuition.
 replace (sum_f_R0 (fun i : nat => pow q (S m + i)) k) with (q * (sum_f_R0 (fun i : nat => pow q (m + i)) k)).
 rewrite IHm ; simpl ; unfold Rdiv ; repeat (rewrite Rmult_assoc) ; repeat (apply Rmult_eq_compat_l) ;
 reflexivity.
 clear ; induction k.
 simpl ; intuition.
 simpl ; rewrite Rmult_plus_distr_l ; rewrite IHk ; apply Rplus_eq_compat_l ; apply Rmult_eq_compat_l.
 unfold pow ; replace (k + S m)%nat with (S (k + m))%nat by intuition ; simpl ; reflexivity.
Qed.

Lemma Rpser_cv_speed_pow_id : forall x : R, Rabs x < 1 ->
     Un_cv (fun n : nat => INR (S n) *  x ^ S n) 0.
Proof.
intros x x_bd eps eps_pos.
 case (Req_or_neq x) ; intro Hx.
  exists 0%nat ; intros ; unfold R_dist ; rewrite Rminus_0_r ;
  rewrite Hx ; rewrite pow_i ; [| intuition] ; rewrite Rmult_0_r ; rewrite Rabs_R0 ;
  assumption.
 assert (H : Un_cv (fun n => /INR (S n)) 0).
  apply cv_infty_cv_R0.
  intros n Hf ; replace 0 with (INR 0) in Hf by intuition.
  discriminate (INR_eq _ _ Hf).
  intro B ; assert (0 <= IZR (up (Rabs B))).
  apply Rle_trans with (Rabs B) ; [apply Rabs_pos |] ;
  apply Rge_le ; left ; apply (proj1 (archimed (Rabs B))).
  assert (H1 : (0 <= up (Rabs B))%Z).
  apply le_IZR ; assumption.
  destruct (IZN (up (Rabs B)) H1) as (N, HN) ; exists N ;
  intros n n_lb ; apply Rlt_le_trans with (INR (S N)).
  apply Rlt_trans with (IZR (up (Rabs B))).
  apply Rle_lt_trans with (Rabs B) ; [apply RRle_abs |] ;
  apply (proj1 (archimed (Rabs B))).
  rewrite HN.
  rewrite <- INR_IZR_INZ.
  intuition.
  intuition.
  assert (Rinv_r_pos : 0 < (1 + 1 / Rabs x) / 2 - 1).
   apply Rlt_Rminus ; apply Rle_lt_trans with ((1 + 1)/2).
   right ; field.
   unfold Rdiv ; apply Rmult_lt_compat_r.
   apply Rinv_0_lt_compat ; intuition.
   apply Rplus_lt_compat_l ; rewrite Rmult_1_l ; rewrite <- Rinv_1 ;
   apply Rinv_lt_contravar.
   rewrite Rmult_1_r ; apply Rabs_pos_lt ; assumption.
   assumption.
   pose (k := (1 + Rabs x) / 2).
   assert (k_pos : 0 <= k).
    unfold k ; replace 0 with (0/2) by field ; unfold Rdiv ; apply Rmult_le_compat_r.
    left ; apply Rinv_0_lt_compat ; intuition.
    apply Rle_zero_pos_plus1 ; apply Rabs_pos.
 assert (k_lt_1 : ((1 + Rabs x) / 2) < 1).
  apply Rlt_le_trans with ((1 + 1) /2).
  unfold Rdiv ; apply Rmult_lt_compat_r.
  apply Rinv_0_lt_compat ; intuition.
  apply Rplus_lt_compat_l ; assumption.
  right ; field.
  assert (Main : forall M eps, 0 < eps -> 0 < M -> exists N, forall n, (n >= N)%nat ->
             M * ((1 + Rabs x) / 2) ^ n < eps).
   clear -k_lt_1 k_pos ; intros M eps eps_pos M_pos ;
   assert (r_bd : 0 <= (1 + Rabs x) / 2 < 1) by intuition ;
   destruct (Rseq_pow_lt_1_cv ((1 + Rabs x) / 2) r_bd (eps / M)) as (N, HN).
   unfold Rdiv ; apply Rmult_lt_0_compat ; [| apply Rinv_0_lt_compat] ; assumption.
   exists N ; intros n n_lb.
   apply Rlt_le_trans with (M * (eps / M)).
   apply Rmult_lt_compat_l.
   assumption.
   replace (((1 + Rabs x) / 2) ^ n) with (Rabs (((1 + Rabs x) / 2) ^ n - 0)).
   apply HN ; assumption.
   rewrite Rminus_0_r ; apply Rabs_right.
   apply Rle_ge ; apply pow_le ; assumption.
   right ; field ; apply Rgt_not_eq ; assumption.
   destruct (H ((1 + 1 / Rabs x) / 2 - 1) Rinv_r_pos) as (N, HN).
assert (Temp : forall M i : nat, (M >= S N)%nat -> Rabs (INR (i + S M) * x ^ (i + S M)) <
        (1 + Rabs x) / 2 * Rabs (INR (i + M) * x ^ (i + M))).
 intros M i M_lb.
 apply Rle_lt_trans with (Rabs ((INR (i + S M) / (INR (i + M))) * ((INR (i + M)) * x ^ (i + S M)))).
 right ; apply Rabs_eq_compat ; field ; apply Rgt_not_eq ; apply lt_0_INR; lia.
 replace (i + S M)%nat with (S (i + M))%nat by intuition lia.
 rewrite <- tech_pow_Rmult.
 repeat (rewrite Rabs_mult ; rewrite <- Rmult_assoc).
 apply Rmult_lt_compat_r.
 apply Rabs_pos_lt ; apply pow_nonzero ; assumption.
 rewrite Rmult_comm, <- Rmult_assoc.
 apply Rmult_lt_compat_r.
 apply Rabs_pos_lt ; apply Rgt_not_eq ; apply lt_0_INR; lia.
 replace (INR (S (i + M)) / INR (i + M)) with (1 + / INR (i + M)).
 apply Rlt_le_trans with (Rabs x * (1 + 1 / Rabs x) / 2).
 unfold Rdiv ; rewrite Rmult_assoc ; apply Rmult_lt_compat_l.
 apply Rabs_pos_lt ; assumption.
 rewrite Rabs_right.
 assert (Temp : forall a b c, b < c - a -> a + b < c).
  clear ; intros ; lra.
 apply Temp.
 replace (/INR (i + M)) with (R_dist (/INR (S (i + pred M))) 0).
 apply HN ; intuition lia.
 unfold R_dist ; rewrite Rminus_0_r ; replace (S (i + pred M))%nat with (i + M)%nat.
 apply Rabs_right ; left ; apply Rinv_0_lt_compat ; apply lt_0_INR; lia.
 intuition lia.
 apply Rle_ge ; apply Rle_zero_pos_plus1.
 left ; apply Rinv_0_lt_compat; apply lt_0_INR; lia.
 right ; field.
 apply Rgt_not_eq ; apply Rabs_pos_lt ; assumption.
 replace (INR (S (i + M))) with (1 + INR (i + M)).
 field ; apply Rgt_not_eq ; apply lt_0_INR; lia.
 replace (S (i + M)) with (1 + (i + M))%nat by intuition ; rewrite S_O_plus_INR.
 intuition.
 pose (An_0 := Rabs (INR (S N))).
 assert (An_0_pos : 0 < An_0 * Rabs x ^ (S N)).
  apply Rmult_lt_0_compat.
  unfold An_0 ; apply Rabs_pos_lt ; apply Rgt_not_eq ; intuition.
  apply pow_lt ; apply Rabs_pos_lt ; assumption.
 destruct (Main (An_0 * Rabs x ^ (S N)) eps eps_pos An_0_pos) as (N2, HN2).
 exists (N2 + S N)%nat ; intros n n_lb.
 fold k in Temp.
 assert (Temp2 : forall i : nat,
      (fun i0 : nat => Rabs (INR (i0 + S N) * x ^ (i0 + S N))) (S i) <
      k * (fun i0 : nat => Rabs (INR (i0 + S N) * x ^ (i0 + S N))) i).
 intro i.
 replace (S i + S N)%nat with (i + S (S N))%nat by ring.
 apply Temp ; intuition.
 clear Temp.
 unfold R_dist, Rminus ; rewrite Ropp_0 ; rewrite Rplus_0_r.
 assert (Temp : forall m n, (m >= n)%nat -> {p | (m = n + p)%nat}).
   clear ; intros m n ; induction n ; intro H.
   exists m ; intuition lia.
   case (le_lt_eq_dec _ _ H) ; clear H ; intro H.
   assert (H' : (m >= n)%nat) by intuition lia.
   destruct (IHn H') as (p, Hp) ; destruct p.
   exists 0%nat ; apply False_ind ; intuition lia.
   exists p ; intuition lia.
   exists 0%nat ; intuition lia.
  destruct (Temp n (N2 + S N)%nat n_lb) as (p,Hp).
  rewrite Hp. replace (S (N2 + S N + p))%nat with ((S N2 + p) + S N)%nat by intuition lia.
 assert (H' := tech4 (fun i : nat => Rabs (INR (i + S N) * x ^ (i + S N))) k
             (S N2 + p) k_pos Temp2).
 apply Rle_lt_trans with (Rabs (INR (0 + S N) * x ^ (0 + S N)) * k ^ (S N2 + p)).
 apply H'.
 simpl (0 + S N)%nat ; rewrite Rabs_mult ; fold An_0 ; unfold k ; rewrite <- RPow_abs ;
 apply HN2.
 intuition.
Qed.


Inductive bool : Type :=
  | true
  | false.

Definition negb (b:bool) : bool :=
  match b with
  | true => false
  | false => true
  end.

Definition andb (b1:bool) (b2:bool) : bool :=
  match b1 with
  | true => b2
  | false => false
  end.

Definition orb (b1:bool) (b2:bool) : bool :=
  match b1 with
  | true => true
  | false => b2
  end.

Example test_orb1: (orb true false)  = true.
Proof. simpl. reflexivity. Qed.

Example test_orb2: (orb false false) = false.
Proof. simpl. reflexivity. Qed.

Example test_orb3: (orb false true) = true.
Proof. simpl. reflexivity. Qed.

Example testorb4: (orb true true) = true.
Proof. simpl. reflexivity. Qed.

Notation "x && y" := (andb x y).
Notation "x || y" := (orb x y).

Example test_orb5: false || false || true = true.
Proof. simpl. reflexivity. Qed.

Definition ngegb' (b:bool) : bool :=
  if b then false
  else true.

Definition andb' (b1:bool) (b2:bool) : bool :=
  if b1 then b2
  else false.

Definition orb' (b1:bool) (b2:bool) : bool :=
  if b1 then true
  else b2.

(* oh my goodness.
  (* https://softwarefoundations.cis.upenn.edu/lf-current/Basics.html
Since the bool type is not built in, Coq actually supports conditional expressions over any inductively defined type with exactly two clauses in its definition. The guard is considered true if it evaluates to the "constructor" of the first clause of the Inductive definition (which just happens to be called true in this case) and false if it evaluates to the second.
 *)
 *)

Definition nandb (b1:bool) (b2:bool) : bool :=
  match b1 with
  | true => negb b2
  | false => true
  end.

Example test_nandb1: (nandb true false) = true.
Proof. simpl. reflexivity. Qed.

Example test_nandb2: (nandb false false) = true.
Proof. simpl. reflexivity. Qed.

Example test_nandb3: (nandb false true) = true.
Proof. simpl. reflexivity. Qed.

Example test_nandb4: (nandb true true) = false.
Proof. simpl. reflexivity. Qed.

Definition andb3 (b1:bool) (b2: bool) (b3: bool): bool :=
  b1 && b2 && b3.

Example test_andb31: (andb3 true true true) = true.
Proof. simpl. reflexivity. Qed.
Example test_andb32: (andb3 false true true) = false.
Proof. simpl. reflexivity. Qed.
Example test_andb33: (andb3 true false true) = false.
Proof. simpl. reflexivity. Qed.
Example test_andb34: (andb3 true true false) = false.
Proof. simpl. reflexivity. Qed.

(* types *)
Check true.
Check negb.

Inductive rgb : Type :=
  | red
  | green
  | blue.

Inductive color : Type :=
| black
| white
| primary (p : rgb).

Check primary blue.

Definition monochrome (c : color) : bool :=
  match c with
  | black => true
  | white => true
  | primary p => false
  end.

Definition isred (c : color) : bool :=
  match c with
  | black => false
  | white => false
  | primary red => true
  | primary _ => false
  end.

(* modules *)

Module Playground.
  Definition isred (c : color) :bool :=
    match c with
    | primary red => true
    | _ => false
    end.
End Playground.

Check Playground.isred (primary blue) : bool.

Module TuplePlayground.
  Inductive bit : Type :=
  | B0
  | B1.

  Inductive nybble : Type :=
  | bits (b0 b1 b2 b3 : bit).

  Check (bits B1 B0 B1 B0) : nybble.

  Definition all_zero (nb : nybble) : bool :=
    match nb with
    | (bits B0 B0 B0 B0) => true
    | (bits _ _ _ _) => false
    end.

  Compute (all_zero (bits B1 B0 B1 B0)).

  Compute (all_zero (bits B0 B0 B0 B0)).

End TuplePlayground.

Module NatPlayground.

  Inductive nat : Type :=
  | O
  | S (n : nat).

  Inductive nat' : Type :=
  | stop
  | tick (foo : nat').

  Compute S (S O).
  Compute tick (tick (tick stop)).
End NatPlayground.

Check (S (S (S (S O)))).

Definition minustwo (n : nat) : nat :=
  match n with
  | O => O
  | S O => O
  | S (S n') => n'
  end.

Compute (minustwo 4).

Check S : nat -> nat.
Check pred : nat -> nat.
Check minustwo : nat -> nat.

Fixpoint even (n:nat) : bool :=
  match n with
  | O => true
  | S O => false
  | S (S n') => even n'
  end.

Definition odd (n:nat) : bool :=
  negb (even n).

Example test_odd1: odd 1 = true.
Proof. simpl. reflexivity. Qed.

Example test_odd2: odd 4 = false.
Proof. simpl. reflexivity. Qed.

Module NatPlayground2.

  Fixpoint plus (n : nat) (m : nat) : nat :=
    match n with
    | O => m
    | S n' => S (plus n' m)
    end.

  Compute (plus 3 2).

  Fixpoint mult (n m : nat) : nat :=
    match n with
    | O => O
    | S n' => plus m (mult n' m)
    end.

  Example test_mut1: (mult 3 3) = 9.
  Proof. simpl. reflexivity. Qed.

  Fixpoint minus (n m:nat) : nat :=
    match n, m with
    | O, _ => O
    | S _, O => n
    | S n', S m' => minus n' m'
    end.

  Example test_minus1: (minus 3 2) = 1.
  Proof. simpl. reflexivity. Qed.

End NatPlayground2.

Fixpoint exp (base power : nat) : nat :=
  match power with
  | O => S O
  | S p => mult base (exp base p)
  end.

Example test_exp: (exp 2 4) = 16.
Proof. simpl. reflexivity. Qed.

Fixpoint bang (n : nat) : nat :=
  match n with
  | O => S O
  | S n' => mult n (bang n')
  end.

Example test_bang: (bang 4) = 24.
Proof. simpl. reflexivity. Qed.

Example test_bang2: (bang 5)  = (mult 10 12).
Proof. simpl. reflexivity. Qed.
Notation "x + y" := (plus x y)
                      (at level 50, left associativity)
    : nat_scope.

Notation "x - y" := (minus x y)
                      (at level 50, left associativity)
    : nat_scope.

Check ((0 + 1) + 1) : nat.

Fixpoint eqb_nested_match (n m : nat) : bool :=
  match n with
  | O => match m with
         | O => true
         | S m' => false
         end
  | S n' => match m with
            | O => false
            | S m' => eqb_nested_match n' m'
            end
  end.

Example test_eqb_nested_match: (eqb_nested_match 99 100) = false.
Proof. simpl. reflexivity. Qed.

Fixpoint eqb_double_match (n m : nat) : bool :=
  match n, m with
  | O, O => true
  | O, S _ => false
  | S _, O => false
  | S n', S m' => eqb_double_match n' m'
  end.

Example test_eqb_double_match: (eqb_double_match 99 100) = false.
Proof. simpl. reflexivity. Qed.

Fixpoint leb (n m : nat) : bool :=
  match n with
  | O => true
  | S n' =>
      match m with
      | O => false
      | S m' => leb n' m'
      end
  end.

Example test_leb1: leb 2 2 = true.
Proof. simpl. reflexivity. Qed.

Example test_leb2: leb 2 4 = true.
Proof. simpl. reflexivity. Qed.

Example test_leb3: leb 4 2 = false.
Proof. simpl. reflexivity. Qed.

Notation "x =? y" := (eqb_double_match x y) (at level 70) :nat_scope.
Notation " x <=? y" := (leb x y) (at level 70) : nat_scope.

Example test_leb4 : (4 <=? 2) = false.
Proof. simpl. reflexivity. Qed.

Fixpoint ltb (n m : nat) : bool :=
  match n,m with
  | O, S _ => true
  | O, O => false
  | S _, O => false
  | S n', S m' => ltb n' m'
  end.

Notation "x <? y" := (ltb x y) (at level 70) : nat_scope.
Example test_ltb1: (ltb 2 2) = false.
Proof. simpl. reflexivity. Qed.
Example test_ltb2: (ltb 2 4) = true.
Proof. simpl. reflexivity. Qed.
Example test_ltb3: (ltb 4 2) = false.
Proof. simpl. reflexivity. Qed.

Theorem plus_O_n : forall n : nat, O + n = n.
Proof.
  intros n. simpl. reflexivity. Qed.

Theorem plus_O_n'' : forall n : nat, 0 + n = n.
Proof.
  intros m. reflexivity.
Qed.

Theorem plus_1_1: forall n: nat, 1+ n = S n.
Proof.
  intros n. reflexivity.
Qed.

Theorem mult_O_1: forall n : nat, O * n = O.
Proof.
  intros n. reflexivity.
Qed.

Theorem plus_id_example : forall n m:nat,
    n = m -> n + n = m + m.

Proof.
  intros n m.
  intros H.
  rewrite <- H.
  reflexivity.
Qed.

Theorem plust_id_ex : forall n m o : nat,
    n = m -> m = o -> n + m = m + o.

Proof.
  intros n m o.
  intros H.
  rewrite -> H.
  intros H1.
  rewrite -> H1.
  reflexivity.
Qed.

Theorem mult_n_O_m_O : forall p q : nat,
    (p * O) + (q * O) = O.
Proof.
  intros p q.
  rewrite <- mult_n_O.
  rewrite <- mult_n_O.
  reflexivity.
Qed.

Check mult_n_O.

Check mult_n_Sm.

Theorem mult_n_1 : forall p :nat,
    p * 1 = p.
Proof.
  intros p.
  rewrite <- mult_n_Sm.
  rewrite <- mult_n_O.
  simpl.
  reflexivity.
Qed.

Theorem plus_1_neq_O_firstry : forall n : nat,
    (n + 1) =? 0 = false.
Proof.
  intros n.
  destruct n as [| n'] eqn:E.
  - simpl. reflexivity.
  - simpl. reflexivity.
Qed.

Theorem negb_involutive : forall b : bool,
    negb (negb b) = b.
Proof.
  intros b. destruct b eqn:E.
  - simpl. reflexivity.
  - simpl. reflexivity.
Qed.

Theorem andb_commutative : forall b c, andb b c = andb c b.
Proof.
  intros b c. destruct b eqn:Eb.
  - destruct c eqn:Ec.
    -- simpl. reflexivity.
    -- simpl. reflexivity.
  - destruct c eqn:Ec.
    -- simpl. reflexivity.
    -- simpl. reflexivity.
Qed.

Theorem andb_commutative' : forall b c, andb b c = andb c b.
Proof.
  intros b c. destruct b eqn:Eb.
  { destruct c eqn:Ec.
    { reflexivity. }
    { reflexivity. } }
  { destruct c eqn:Ec.
    { reflexivity. }
    { reflexivity. } }
Qed.

Theorem andb3_exchange :
  forall b c d, andb (andb b c) d = andb (andb b d) c.
Proof.
  intros b c d.
  destruct b eqn:Eb.
  - destruct c eqn:Ec.
    -- destruct d eqn:Ed.
       --- simpl. reflexivity.
       --- simpl. reflexivity.
    -- destruct d eqn:Ed.
       --- simpl. reflexivity.
       --- simpl. reflexivity.
  - destruct c eqn:Ec.
    -- destruct d eqn:Ed.
       --- simpl. reflexivity.
       --- simpl. reflexivity.
    -- destruct d eqn:Ed.
       --- simpl. reflexivity.
       --- simpl. reflexivity.
Qed.

Theorem andb_true_elim2 : forall b c : bool,
    andb b c = true -> c = true.
Proof.
  intros b c.
  destruct b eqn:Eb.
  - destruct c eqn:Ec.
    -- reflexivity.
    -- intros H.
       rewrite <- H.
       reflexivity.
  - destruct c eqn:Ec.
    --intros H.
      rewrite <- H.
      reflexivity.
    --intros H.
      rewrite <- H.
      reflexivity.
Qed.

Theorem zero_nbeq_plus_1 : forall n : nat,
    0 =? (n + 1) = false.

Proof.
  intros n.
  destruct n as [|n].
  - reflexivity.
  - reflexivity.
Qed.

(*
Fixpoint fibn (a b n: nat) : nat :=
  match n with
  | O => b
  | S n' => fibn b (a + b) (n - 1)
  end.
 *)

Theorem identity_fn_applied_twice:
  forall (f : bool -> bool),
    (forall (x : bool), f x = x) ->
    forall (b : bool), f (f b) = b.
Proof.
  intros f H b.
  rewrite -> H.
  rewrite -> H.
  reflexivity.
Qed.

Theorem negetion_fn_applied_twice:
  forall (f : bool -> bool),
    (forall (x : bool), f x = negb x) ->
    forall (b : bool), f (f b) = b.
Proof.
  intros f H b.
  rewrite -> H.
  rewrite -> H.
  rewrite -> negb_involutive.
  reflexivity.
Qed.

Theorem andb_eq_orb :
  forall (b c : bool),
    (andb b c = orb b c) ->
    b = c.

Proof.
intros b c.
destruct b eqn:Eb.
  - destruct c eqn:Ec.
    + reflexivity.
    + simpl. rewrite <- Eb. intros H. rewrite -> H. reflexivity.
  - destruct c eqn:Ec.
    + simpl. rewrite <- Eb. intros H. rewrite -> H. reflexivity.
    + reflexivity.
Qed.

Theorem andb_eq_orb' :
  forall (b c: bool),
    (andb b c = orb b c) ->
    b = c.

Proof.
  intros b c.
  destruct b eqn:Eb.
  - destruct c eqn:Ec.
    -- reflexivity.
    -- simpl. intros H. rewrite -> H. reflexivity.
  - destruct c eqn:Ec.
    -- simpl. rewrite <- Eb. rewrite <- Ec. intros H. rewrite -> H. reflexivity.
    -- simpl. intros H. reflexivity.
Qed.

Inductive bin : Type :=
| Z
| B0 (n : bin)
| B1 (n : bin).

Fixpoint incr (m:bin) : bin :=
  match m with
  | Z => B1 Z
  | B0 rest => B1 (incr rest)
  | B1 rest => B0 (B1 rest)
  end.

(*Example test_bin_incr1 : (incr (B1 Z)) = B0 (B1 Z).*)

Example test_bin_incr2 : (incr (B0 (B1 Z))) = B1 (B1 Z).
Proof.
  simpl.

  (* not going to be able proove this wihtout the next chapter, pause for now *)