Require Import prosa.classic.util.all.
Require Import prosa.classic.model.arrival.basic.task prosa.classic.model.arrival.basic.job prosa.classic.model.arrival.basic.task_arrival prosa.classic.model.priority.
Require Import prosa.classic.model.schedule.global.response_time prosa.classic.model.schedule.global.workload
               prosa.classic.model.schedule.global.schedulability.
Require Import prosa.classic.model.schedule.global.basic.schedule prosa.classic.model.schedule.global.basic.platform
               prosa.classic.model.schedule.global.basic.interference prosa.classic.model.schedule.global.basic.interference_edf.
Require Import prosa.classic.analysis.global.basic.workload_bound
               prosa.classic.analysis.global.basic.interference_bound.
From mathcomp Require Import ssreflect ssrbool eqtype ssrnat seq fintype bigop div path.

Module InterferenceBoundEDF.

  Import Job SporadicTaskset Schedule ScheduleOfSporadicTask Schedulability
         WorkloadBound ResponseTime Priority
         TaskArrival Interference InterferenceEDF.
  Export InterferenceBoundGeneric.

  (* In this section, we define Bertogna and Cirinei's EDF-specific
     interference bound. *)
  Section SpecificBoundDef.

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

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

    (* Consider the interference incurred by tsk in a window of length delta... *)
    Variable delta: time.

    (* ... due to a different task tsk_other, with response-time bound R_other. *)
    Variable tsk_other: sporadic_task.
    Variable R_other: time.

    (* Bertogna and Cirinei define the following bound for task interference
       under EDF scheduling. *)
    Definition edf_specific_interference_bound :=
      let d_tsk := task_deadline tsk in
      let e_other := task_cost tsk_other in
      let p_other := task_period tsk_other in
      let d_other := task_deadline tsk_other in
        (div_floor d_tsk p_other) * e_other +
        minn e_other ((d_tsk %% p_other) - (d_other - R_other)).

  End SpecificBoundDef.

  (* Next, we define the total interference bound for EDF, which combines the generic
     and the EDF-specific bounds. *)
  Section TotalInterferenceBoundEDF.

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

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

    Let task_with_response_time := (sporadic_task * time)%type.

    (* Assume a known response-time bound for each interfering task ... *)
    Variable R_prev: seq task_with_response_time.

    (* ... and an interval length delta. *)
    Variable delta: time.

    Section RecallInterferenceBounds.

      Variable tsk_R: task_with_response_time.
      Let tsk_other := fst tsk_R.
      Let R_other := snd tsk_R.

      (* By combining Bertogna's interference bound for a work-conserving
         scheduler ... *)
      Let basic_interference_bound := interference_bound_generic task_cost task_period tsk delta tsk_R.

      (* ... with and EDF-specific interference bound, ... *)
      Let edf_specific_bound := edf_specific_interference_bound task_cost task_period task_deadline tsk tsk_other R_other.

      (* ... Bertogna and Cirinei define the following interference bound
         under EDF scheduling. *)
      Definition interference_bound_edf :=
        minn basic_interference_bound edf_specific_bound.

    End RecallInterferenceBounds.

    (* Next we define the computation of the total interference for APA scheduling. *)
    Section TotalInterference.

      (* Let other_task denote tasks different from tsk. *)
      Let other_task := different_task tsk.

      (* The total interference incurred by tsk is bounded by the sum
         of individual task interferences of the other tasks. *)
      Definition total_interference_bound_edf :=
        \sum_((tsk_other, R_other) <- R_prev | other_task tsk_other)
           interference_bound_edf (tsk_other, R_other).

    End TotalInterference.

  End TotalInterferenceBoundEDF.

  (* In this section, we show that the EDF-specific interference bound is safe. *)
  Section ProofSpecificBound.

    Import Schedule Interference Platform SporadicTaskset.

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

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

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

    (* ... in which jobs arrive sporadically and have valid parameters. *)
    Hypothesis H_sporadic_tasks:
      sporadic_task_model task_period job_arrival job_task arr_seq.
    Hypothesis H_valid_job_parameters:
      forall j,
        arrives_in arr_seq j ->
        valid_sporadic_job task_cost task_deadline job_cost job_deadline job_task j.

    (* Consider any schedule such that...*)
    Variable num_cpus: nat.
    Variable sched: schedule Job num_cpus.
    Hypothesis H_jobs_come_from_arrival_sequence:
      jobs_come_from_arrival_sequence sched arr_seq.

    (* ...jobs do not execute before their arrival times nor longer
       than their execution costs. *)
    Hypothesis H_jobs_must_arrive_to_execute: jobs_must_arrive_to_execute job_arrival sched.
    Hypothesis H_completed_jobs_dont_execute: completed_jobs_dont_execute job_cost sched.

    (* Also assume that jobs are sequential and that there exists at
       least one processor. *)
    Hypothesis H_sequential_jobs: sequential_jobs sched.
    Hypothesis H_at_least_one_cpu: num_cpus > 0.

    (* Consider a task set ts where all jobs come from the task set
       and tasks have valid parameters and constrained deadlines. *)
    Variable ts: taskset_of sporadic_task.
    Hypothesis all_jobs_from_taskset:
      forall j, arrives_in arr_seq j -> job_task j \in ts.
    Hypothesis H_valid_task_parameters:
      valid_sporadic_taskset task_cost task_period task_deadline ts.
    Hypothesis H_constrained_deadlines:
      forall tsk, tsk \in ts -> task_deadline tsk <= task_period tsk.

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

    (* Assume that the scheduler is a work-conserving EDF scheduler. *)
    Hypothesis H_work_conserving: work_conserving job_arrival job_cost arr_seq sched.
    Hypothesis H_edf_scheduler:
      respects_JLFP_policy job_arrival job_cost arr_seq sched (EDF job_arrival job_deadline).

    (* Let tsk_i be the task to be analyzed, ...*)
    Variable tsk_i: sporadic_task.
    Hypothesis H_tsk_i_in_task_set: tsk_i \in ts.

    (* ... and j_i one of its jobs. *)
    Variable j_i: Job.
    Hypothesis H_j_i_arrives: arrives_in arr_seq j_i.
    Hypothesis H_job_of_tsk_i: job_task j_i = tsk_i.

    (* Let tsk_k denote any interfering task, ... *)
    Variable tsk_k: sporadic_task.
    Hypothesis H_tsk_k_in_task_set: tsk_k \in ts.

    (* ...and R_k its response-time bound. *)
    Variable R_k: time.
    Hypothesis H_R_k_le_deadline: R_k <= task_deadline tsk_k.

    (* Consider a time window of length delta <= D_i, starting with j_i's arrival time. *)
    Variable delta: time.
    Hypothesis H_delta_le_deadline: delta <= task_deadline tsk_i.

    (* Assume that the jobs of tsk_k satisfy the response-time bound before the end of the interval *)
    Hypothesis H_all_previous_jobs_completed_on_time :
      forall j_k,
        arrives_in arr_seq j_k ->
        job_task j_k = tsk_k ->
        job_arrival j_k + R_k < job_arrival j_i + delta ->
        completed job_cost sched j_k (job_arrival j_k + R_k).

    (* In this section, we prove that Bertogna and Cirinei's EDF interference bound
       indeed bounds the interference caused by task tsk_k in the interval [t1, t1 + delta). *)
    Section MainProof.

      (* Let's call x the task interference incurred by job j due to tsk_k. *)
      Let x :=
        task_interference job_arrival job_cost job_task sched j_i tsk_k
                          (job_arrival j_i) (job_arrival j_i + delta).

      (* Also, recall the EDF-specific interference bound for EDF. *)
      Let interference_bound :=
        edf_specific_interference_bound task_cost task_period task_deadline tsk_i tsk_k R_k.

      (* Let's simplify the names a bit. *)
      Let t1 := job_arrival j_i.
      Let t2 := job_arrival j_i + delta.
      Let D_i := task_deadline tsk_i.
      Let D_k := task_deadline tsk_k.
      Let p_k := task_period tsk_k.

      Let n_k := div_floor D_i p_k.

      (* Let's give a simpler name to job interference. *)
      Let interference_caused_by := job_interference job_arrival job_cost sched j_i.

      (* Identify the subset of jobs that actually cause interference *)
      Let interfering_jobs :=
        filter (fun j' =>
                 (job_task j' == tsk_k) && (interference_caused_by j' t1 t2 != 0))
               (jobs_scheduled_between sched t1 t2).

      (* Now, consider the list of interfering jobs sorted by arrival time. *)
      Let earlier_arrival := fun x y => job_arrival x <= job_arrival y.
      Let sorted_jobs := sort earlier_arrival interfering_jobs.

      (* Now we proceed with the proof. The first step consists in simplifying the sum corresponding to the workload. *)
      Section SimplifyJobSequence.

        (* Use the alternative definition of task interference, based on
           individual job interference. *)
        Lemma interference_bound_edf_use_another_definition :
          x <= \sum_(j <- jobs_scheduled_between sched t1 t2 | job_task j == tsk_k)
                interference_caused_by j t1 t2.
        Proof.
          apply interference_le_interference_joblist.
        Qed.

        (* Remove the elements that we don't care about from the sum *)
        Lemma interference_bound_edf_simpl_by_filtering_interfering_jobs :
          \sum_(j <- jobs_scheduled_between sched t1 t2 | job_task j == tsk_k)
             interference_caused_by j t1 t2 =
          \sum_(j <- interfering_jobs) interference_caused_by j t1 t2.
        Proof.
          unfold interfering_jobs; rewrite big_filter.
          rewrite big_mkcond; rewrite [\sum_(_ <- _ | _) _]big_mkcond /=.
          apply eq_bigr; intros i _; clear -i.
          destruct (job_task i == tsk_k); rewrite ?andTb ?andFb; last by done.
          destruct (interference_caused_by i t1 t2 != 0) eqn:DIFF; first by done.
          by apply negbT in DIFF; rewrite negbK in DIFF; apply/eqP.
        Qed.

        (* Then, we consider the sum over the sorted sequence of jobs. *)
        Lemma interference_bound_edf_simpl_by_sorting_interfering_jobs :
          \sum_(j <- interfering_jobs) interference_caused_by j t1 t2 =
           \sum_(j <- sorted_jobs) interference_caused_by j t1 t2.
        Proof.
          by rewrite (perm_big sorted_jobs) /=; last by rewrite -(perm_sort earlier_arrival).
        Qed.

        (* Note that both sequences have the same set of elements. *)
        Lemma interference_bound_edf_job_in_same_sequence :
          forall j,
            (j \in interfering_jobs) = (j \in sorted_jobs).
        Proof.
          by apply perm_mem; rewrite -(perm_sort earlier_arrival).
        Qed.

        (* Also recall that all jobs in the sorted sequence is an interfering job of tsk_k, ... *)
        Lemma interference_bound_edf_all_jobs_from_tsk_k :
          forall j,
            j \in sorted_jobs ->
            arrives_in arr_seq j /\
            job_task j = tsk_k /\
            interference_caused_by j t1 t2 != 0 /\
            j \in jobs_scheduled_between sched t1 t2.
        Proof.
          rename H_jobs_come_from_arrival_sequence into FROMarr.
          intros j LTi.
          rewrite -interference_bound_edf_job_in_same_sequence mem_filter in LTi; des.
          have IN := LTi0.
          unfold jobs_scheduled_between in *; rewrite mem_undup in IN.
          apply mem_bigcat_nat_exists in IN; des.
          rewrite mem_scheduled_jobs_eq_scheduled in IN.
          repeat split; try (by done).
          by apply (FROMarr j i).
        Qed.

        (* ...and consecutive jobs are ordered by arrival. *)
        Lemma interference_bound_edf_jobs_ordered_by_arrival :
          forall i elem,
            i < (size sorted_jobs).-1 ->
            earlier_arrival (nth elem sorted_jobs i) (nth elem sorted_jobs i.+1).
        Proof.
          intros i elem LT.
          assert (SORT: sorted earlier_arrival sorted_jobs).
            by apply sort_sorted; unfold total, earlier_arrival; ins; apply leq_total.
          by destruct sorted_jobs; simpl in *; [by rewrite ltn0 in LT | by apply/pathP].
        Qed.

        (* Finally, for any job of task tsk_k, the interference is bounded by the task cost. *)
        Lemma interference_bound_edf_interference_le_task_cost :
          forall j,
            j \in interfering_jobs ->
            interference_caused_by j t1 t2 <= task_cost tsk_k.
        Proof.
          rename H_valid_job_parameters into PARAMS.
          intros j IN.
          feed (interference_bound_edf_all_jobs_from_tsk_k j);
            first by rewrite -interference_bound_edf_job_in_same_sequence.
          move => [ARRj [TSKj _]].
          apply leq_trans with (n := service_during sched j t1 t2);
            first by apply job_interference_le_service.
          apply cumulative_service_le_task_cost with (job_task0 := job_task)
            (task_deadline0 := task_deadline) (job_cost0 := job_cost) (job_deadline0 := job_deadline);
            try (by done).
          by apply PARAMS.
        Qed.

      End SimplifyJobSequence.

      (* Next, we show that if the number of jobs is no larger than n_k,
         the workload bound trivially holds. *)
      Section InterferenceFewJobs.

        Hypothesis H_few_jobs: size sorted_jobs <= n_k.

        Lemma interference_bound_edf_holds_for_at_most_n_k_jobs :
           \sum_(j <- sorted_jobs) interference_caused_by j t1 t2 <=
             interference_bound.
        Proof.
          rewrite -[\sum_(_ <- _ | _) _]addn0 leq_add //.
          apply leq_trans with (n := \sum_(x <- sorted_jobs) task_cost tsk_k);
            last by rewrite big_const_seq iter_addn addn0 mulnC leq_mul2r; apply/orP; right.
          {
            rewrite [\sum_(_ <- _) interference_caused_by _ _ _]big_seq_cond.
            rewrite [\sum_(_ <- _) task_cost _]big_seq_cond.
            apply leq_sum; intros i; move/andP => [INi _].
            rewrite -interference_bound_edf_job_in_same_sequence in INi.
            by apply interference_bound_edf_interference_le_task_cost.
          }
        Qed.

      End InterferenceFewJobs.

      (* Otherwise, assume that the number of jobs is larger than n_k >= 0. *)
      Section InterferenceManyJobs.

        Hypothesis H_many_jobs: n_k < size sorted_jobs.

        (* This trivially implies that there's at least one job. *)
        Lemma interference_bound_edf_at_least_one_job: size sorted_jobs > 0.
        Proof.
          by apply leq_ltn_trans with (n := n_k).
        Qed.

        (* Let j_fst be the first job, and a_fst its arrival time. *)
        Variable elem: Job.
        Let j_fst := nth elem sorted_jobs 0.
        Let a_fst := job_arrival j_fst.

        (* In this section, we prove some basic lemmas about j_fst. *)
        Section FactsAboutFirstJob.

          (* The first job is an interfering job of task tsk_k. *)
          Lemma interference_bound_edf_j_fst_is_job_of_tsk_k :
            arrives_in arr_seq j_fst /\
            job_task j_fst = tsk_k /\
            interference_caused_by j_fst t1 t2 != 0 /\
            j_fst \in jobs_scheduled_between sched t1 t2.
          Proof.
            by apply interference_bound_edf_all_jobs_from_tsk_k, mem_nth,
                     interference_bound_edf_at_least_one_job.
          Qed.

          (* The deadline of j_fst is the deadline of tsk_k. *)
          Lemma interference_bound_edf_j_fst_deadline :
            job_deadline j_fst = task_deadline tsk_k.
          Proof.
            unfold valid_sporadic_job in *.
            rename H_valid_job_parameters into PARAMS.
            have FST := interference_bound_edf_j_fst_is_job_of_tsk_k.
            destruct FST as [FSTarr [FSTtask _]].
            by specialize (PARAMS j_fst FSTarr); des; rewrite PARAMS1 FSTtask.
          Qed.

          (* The deadline of j_i is the deadline of tsk_i. *)
          Lemma interference_bound_edf_j_i_deadline :
            job_deadline j_i = task_deadline tsk_i.
          Proof.
            unfold valid_sporadic_job in *.
            rename H_valid_job_parameters into PARAMS,
                   H_job_of_tsk_i into JOBtsk.
            by specialize (PARAMS j_i H_j_i_arrives); des; rewrite PARAMS1 JOBtsk.
          Qed.

          (* If j_fst completes by its response-time bound, then t1 <= a_fst + R_k,
             where t1 is the beginning of the time window (arrival of j_i). *)
          Lemma interference_bound_edf_j_fst_completion_implies_rt_bound_inside_interval :
            completed job_cost sched j_fst (a_fst + R_k) ->
            t1 <= a_fst + R_k.
          Proof.
            intros RBOUND.
            rewrite leqNgt; apply/negP; unfold not; intro BUG.
            have FST := interference_bound_edf_j_fst_is_job_of_tsk_k.
            destruct FST as [FSTarr [_ [ FSTserv _]]].
            move: FSTserv => /negP FSTserv; apply FSTserv.
            rewrite -leqn0; apply leq_trans with (n := service_during sched j_fst t1 t2);
              first by apply job_interference_le_service.
            rewrite leqn0; apply/eqP.
            by apply cumulative_service_after_job_rt_zero with (job_cost0 := job_cost) (R := R_k)
              (job_arrival0 := job_arrival); try (by done); apply ltnW.
          Qed.

        End FactsAboutFirstJob.

        (* Now, let's prove the interference bound for the particular case of a single job.
           This case must be solved separately because the single job can simultaneously
           be carry-in and carry-out job, so its response time is not necessarily
           bounded by R_k (from the hypothesis H_all_previous_jobs_completed_on_time). *)
        Section InterferenceSingleJob.

          (* Assume that there's at least one job in the sorted list. *)
          Hypothesis H_only_one_job: size sorted_jobs = 1.

          (* Since there's only one job, we simplify the terms in the interference bound. *)
          Lemma interference_bound_edf_simpl_when_there's_one_job :
            D_i %% p_k - (D_k - R_k) = D_i - (D_k - R_k).
          Proof.
            rename H_many_jobs into NUM,
                   H_valid_task_parameters into TASK_PARAMS,
                   H_tsk_k_in_task_set into INk.
            unfold valid_sporadic_taskset, is_valid_sporadic_task,
                   interference_bound, edf_specific_interference_bound in *.
            rewrite H_only_one_job in NUM.
            rewrite ltnS leqn0 in NUM; move: NUM => /eqP EQnk.
            move: EQnk => /eqP EQnk; unfold n_k, div_floor in EQnk.
            rewrite -leqn0 leqNgt divn_gt0 in EQnk;
              last by specialize (TASK_PARAMS tsk_k INk); des.
            by rewrite -ltnNge in EQnk; rewrite modn_small //.
          Qed.

          (* Next, we show that if j_fst completes by its response-time bound R_k,
             then then interference bound holds. *)
          Section ResponseTimeOfSingleJobBounded.

            Hypothesis H_j_fst_completed_by_rt_bound :
              completed job_cost sched j_fst (a_fst + R_k).

            Lemma interference_bound_edf_holds_for_single_job_that_completes_on_time :
              job_interference job_arrival job_cost sched j_i j_fst t1 t2 <= D_i - (D_k - R_k).
            Proof.
              rename H_j_fst_completed_by_rt_bound into RBOUND.
              have AFTERt1 :=
                interference_bound_edf_j_fst_completion_implies_rt_bound_inside_interval RBOUND.
              have FST := interference_bound_edf_j_fst_is_job_of_tsk_k.
              destruct FST as [FSTarr [_ [ LEdl _]]].
              apply interference_under_edf_implies_shorter_deadlines with
                    (arr_seq0 := arr_seq) (job_deadline0 := job_deadline) in LEdl; try (by done).
              destruct (D_k - R_k <= D_i) eqn:LEdk; last first.
              {
                apply negbT in LEdk; rewrite -ltnNge in LEdk.
                apply leq_trans with (n := 0); last by done.
                apply leq_trans with (n := job_interference job_arrival job_cost sched j_i j_fst
                                                                        (a_fst + R_k) t2).
                {
                  apply extend_sum; last by apply leqnn.
                  rewrite -(leq_add2r D_i).
                  rewrite interference_bound_edf_j_fst_deadline
                          interference_bound_edf_j_i_deadline in LEdl.
                  apply leq_trans with (n := a_fst + D_k); last by done.
                  rewrite -addnA leq_add2l.
                  by apply ltnW; rewrite -ltn_subRL.
                }
                apply leq_trans with (n := service_during sched j_fst (a_fst + R_k) t2);
                  first by apply job_interference_le_service.
                unfold service_during; rewrite leqn0; apply/eqP.
                by apply cumulative_service_after_job_rt_zero with (job_cost0 := job_cost) (R := R_k)
                   (job_arrival0 := job_arrival); try (by done); apply leqnn.
              }
              {
                rewrite -(leq_add2r (D_k - R_k)) subh1 // -addnBA // subnn addn0.
                assert (SUBST: D_k - R_k = \sum_(a_fst + R_k <= i < a_fst + D_k) 1).
                {
                  rewrite big_const_nat iter_addn mul1n addn0.
                  rewrite addnC -subnBA; last by apply leq_addr.
                  by rewrite addnC -addnBA // subnn addn0.
                }
                apply leq_trans with (n := job_interference job_arrival job_cost sched j_i j_fst t1
                                                            (a_fst + D_k) + (D_k - R_k)).
                {
                  rewrite leq_add2r.
                  destruct (t2 <= a_fst + R_k) eqn:LEt2.
                  {
                    apply extend_sum; first by apply leqnn.
                    apply leq_trans with (n := a_fst + R_k); first by done.
                    by rewrite leq_add2l; apply H_R_k_le_deadline.
                  }
                  {
                    unfold job_interference.
                    apply negbT in LEt2; rewrite -ltnNge in LEt2.
                    rewrite -> big_cat_nat with (n := a_fst + R_k);
                      [simpl | by apply AFTERt1 | by apply ltnW].
                    apply leq_trans with (n := job_interference job_arrival job_cost sched j_i j_fst t1
                                 (a_fst + R_k) + service_during sched j_fst (a_fst + R_k) t2).
                    {
                      rewrite leq_add2l.
                      by apply job_interference_le_service.
                    }
                    unfold service_during.
                    rewrite -> cumulative_service_after_job_rt_zero with
                      (job_arrival0 := job_arrival) (job_cost0 := job_cost) (R := R_k); try (by done).
                    rewrite addn0; apply extend_sum; first by apply leqnn.
                    by rewrite leq_add2l; apply H_R_k_le_deadline.
                  }
                }

                unfold job_interference.
                rewrite -> big_cat_nat with (n := a_fst + R_k);
                  [simpl| by apply AFTERt1 | by rewrite leq_add2l; apply H_R_k_le_deadline].
                apply leq_trans with (n := job_interference job_arrival job_cost sched j_i j_fst t1
                  (a_fst+R_k) + service_during sched j_fst (a_fst+R_k) (a_fst+D_k) + (D_k-R_k)).
                {
                  rewrite leq_add2r leq_add2l.
                  by apply job_interference_le_service.
                }
                unfold service_during.
                rewrite -> cumulative_service_after_job_rt_zero with
                  (job_arrival0 := job_arrival) (job_cost0 := job_cost) (R:=R_k); try (by done).
                rewrite addn0.
                apply leq_trans with (n := (\sum_(t1 <= t < a_fst + R_k) 1) +
                                           \sum_(a_fst + R_k <= t < a_fst + D_k) 1).
                {
                  apply leq_add; last by rewrite SUBST.
                  rewrite big_const_nat iter_addn mul1n addn0.
                  rewrite -{1}[a_fst + R_k](addKn t1) -addnBA //.
                  by apply job_interference_le_delta.
                }
                rewrite -big_cat_nat;
                  [simpl | by apply AFTERt1 | by rewrite leq_add2l; apply H_R_k_le_deadline ].
                rewrite big_const_nat iter_addn mul1n addn0 leq_subLR.
                by unfold D_i, D_k, t1, a_fst; rewrite -interference_bound_edf_j_fst_deadline
                                                       -interference_bound_edf_j_i_deadline.
              }
            Qed.

          End ResponseTimeOfSingleJobBounded.

          (* Else, if j_fst did not complete by its response-time bound, then
             we need a separate proof. *)
          Section ResponseTimeOfSingleJobNotBounded.

            Hypothesis H_j_fst_not_complete_by_rt_bound :
              ~~ completed job_cost sched j_fst (a_fst + R_k).

            (* This trivially implies that a_fst + R_k lies after the end of the interval,
               otherwise j_fst would have completed by its response-time bound. *)
            Lemma interference_bound_edf_response_time_bound_of_j_fst_after_interval :
              job_arrival j_fst + R_k >= job_arrival j_i + delta.
            Proof.
              have FST := interference_bound_edf_j_fst_is_job_of_tsk_k.
              destruct FST as [FSTarr [FSTtask _]].
              rewrite leqNgt; apply/negP; intro LT.
              move: H_j_fst_not_complete_by_rt_bound => /negP BUG; apply BUG.
              by apply H_all_previous_jobs_completed_on_time.
            Qed.

            (* If the slack is too big (D_i < D_k - R_k), j_fst causes no interference. *)
            Lemma interference_bound_edf_holds_for_single_job_with_big_slack :
              D_i < D_k - R_k ->
              interference_caused_by j_fst t1 t2 = 0.
            Proof.
              intro LTdk.
              rewrite ltn_subRL in LTdk.
              rewrite -(ltn_add2l a_fst) addnA in LTdk.
              apply leq_ltn_trans with (m := t1 + D_i) in LTdk; last first.
              {
                rewrite leq_add2r.
                apply leq_trans with (n := t1 + delta); first by apply leq_addr.
                by apply interference_bound_edf_response_time_bound_of_j_fst_after_interval.
              }
              apply/eqP; rewrite -[_ _ _ _ == 0]negbK; apply/negP; red; intro BUG.
              have FST := interference_bound_edf_j_fst_is_job_of_tsk_k.
              destruct FST as [FSTarr [_ [LEdl _]]].
              apply interference_under_edf_implies_shorter_deadlines with
                     (arr_seq0 := arr_seq) (job_deadline0 := job_deadline) in BUG; try (by done).
              rewrite interference_bound_edf_j_fst_deadline
                      interference_bound_edf_j_i_deadline in BUG.
              by apply (leq_trans LTdk) in BUG; rewrite ltnn in BUG.
            Qed.

            (* Else, if the slack is small, j_fst causes interference for no longer than
               D_i - (D_k - R_k). *)
            Lemma interference_bound_edf_holds_for_single_job_with_small_slack :
              D_i >= D_k - R_k ->
              interference_caused_by j_fst t1 t2 <= D_i - (D_k - R_k).
            Proof.
              intro LEdk.
              have FST := interference_bound_edf_j_fst_is_job_of_tsk_k.
              destruct FST as [FSTarr [FSTtask [LEdl _]]].
              have LTr := interference_bound_edf_response_time_bound_of_j_fst_after_interval.
              apply subh3.
              apply leq_trans with (n := job_interference job_arrival job_cost sched j_i j_fst t1
                                                          (job_arrival j_fst + R_k) + (D_k - R_k));
                first by rewrite leq_add2r; apply extend_sum; [by apply leqnn|].
              apply leq_trans with (n := \sum_(t1 <= t < a_fst + R_k) 1 +
                                         \sum_(a_fst + R_k <= t < a_fst + D_k)1).
              {
                apply leq_add.
                {
                  rewrite big_const_nat iter_addn mul1n addn0.
                  rewrite -{1}[job_arrival j_fst + R_k](addKn t1) -addnBA;
                    first by apply job_interference_le_delta.
                  by apply leq_trans with (n := t1 + delta); first by apply leq_addr.
                }
                rewrite big_const_nat iter_addn mul1n addn0 addnC.
                rewrite -subnBA; last by apply leq_addr.
                by rewrite addnC -addnBA // subnn addn0.
              }
              rewrite -big_cat_nat; simpl; last 2 first.
              {
                apply leq_trans with (n := t1 + delta); first by apply leq_addr.
                by apply interference_bound_edf_response_time_bound_of_j_fst_after_interval.
              }
              by rewrite leq_add2l; apply H_R_k_le_deadline.
              rewrite big_const_nat iter_addn mul1n addn0 leq_subLR.
              unfold D_i, D_k, t1, a_fst; rewrite -interference_bound_edf_j_fst_deadline
                                                  -interference_bound_edf_j_i_deadline.
              by apply interference_under_edf_implies_shorter_deadlines with
                (arr_seq0 := arr_seq) (job_deadline0 := job_deadline) in LEdl.
            Qed.

          End ResponseTimeOfSingleJobNotBounded.

          (* By combining the results above, we prove that the interference caused by the single job
             is bounded by D_i - (D_k - R_k), ... *)
          Lemma interference_bound_edf_interference_of_j_fst_limited_by_slack :
            interference_caused_by j_fst t1 t2 <= D_i - (D_k - R_k).
          Proof.
            destruct (completed job_cost sched j_fst (a_fst + R_k)) eqn:COMP;
              first by apply interference_bound_edf_holds_for_single_job_that_completes_on_time.
            apply negbT in COMP.
            destruct (ltnP D_i (D_k - R_k)) as [LEdk | LTdk].
              by rewrite interference_bound_edf_holds_for_single_job_with_big_slack.
              by apply interference_bound_edf_holds_for_single_job_with_small_slack.
          Qed.

          (* ... and thus the interference bound holds. *)
          Lemma interference_bound_edf_holds_for_a_single_job :
            interference_caused_by j_fst t1 t2 <= interference_bound.
          Proof.
            have ONE := interference_bound_edf_simpl_when_there's_one_job.
            have SLACK := interference_bound_edf_interference_of_j_fst_limited_by_slack.
            rename H_many_jobs into NUM, H_only_one_job into SIZE.
            unfold interference_caused_by, interference_bound, edf_specific_interference_bound.
            fold D_i D_k p_k n_k.
            rewrite SIZE ltnS leqn0 in NUM; move: NUM => /eqP EQnk.
            rewrite EQnk mul0n add0n.
            rewrite leq_min; apply/andP; split.
            {
              apply interference_bound_edf_interference_le_task_cost.
              rewrite interference_bound_edf_job_in_same_sequence.
              by apply mem_nth; rewrite SIZE.
            }
            by rewrite ONE; apply SLACK.
          Qed.

        End InterferenceSingleJob.

        (* Next, consider the other case where there are at least two jobs:
           the first job j_fst, and the last job j_lst. *)
        Section InterferenceTwoOrMoreJobs.

          (* Assume there are at least two jobs. *)
          Variable num_mid_jobs: nat.
          Hypothesis H_at_least_two_jobs : size sorted_jobs = num_mid_jobs.+2.

          (* Let j_lst be the last job of the sequence and a_lst its arrival time. *)
          Let j_lst := nth elem sorted_jobs num_mid_jobs.+1.
          Let a_lst := job_arrival j_lst.

          (* In this section, we prove some basic lemmas about the first and last jobs. *)
          Section FactsAboutFirstAndLastJobs.

            (* The last job is an interfering job of task tsk_k. *)
            Lemma interference_bound_edf_j_lst_is_job_of_tsk_k :
              arrives_in arr_seq j_lst /\
              job_task j_lst = tsk_k /\
              interference_caused_by j_lst t1 t2 != 0 /\
              j_lst \in jobs_scheduled_between sched t1 t2.
            Proof.
              apply interference_bound_edf_all_jobs_from_tsk_k, mem_nth.
              by rewrite H_at_least_two_jobs.
            Qed.

            (* The deadline of j_lst is the deadline of tsk_k. *)
            Lemma interference_bound_edf_j_lst_deadline :
              job_deadline j_lst = task_deadline tsk_k.
            Proof.
              unfold valid_sporadic_job in *.
              rename H_valid_job_parameters into PARAMS.
              have LST := interference_bound_edf_j_lst_is_job_of_tsk_k.
              destruct LST as [LSTarr [LSTtask _]].
              by specialize (PARAMS j_lst LSTarr); des; rewrite PARAMS1 LSTtask.
            Qed.

            (* The first job arrives before the last job. *)
            Lemma interference_bound_edf_j_fst_before_j_lst :
              job_arrival j_fst <= job_arrival j_lst.
            Proof.
              rename H_at_least_two_jobs into SIZE.
              unfold j_fst, j_lst; rewrite -[num_mid_jobs.+1]add0n.
              apply prev_le_next; last by rewrite SIZE leqnn.
              by intros i LT; apply interference_bound_edf_jobs_ordered_by_arrival.
            Qed.

            (* The last job arrives before the end of the interval. *)
            Lemma interference_bound_edf_last_job_arrives_before_end_of_interval :
              job_arrival j_lst < t2.
            Proof.
              rewrite leqNgt; apply/negP; unfold not; intro LT2.
              exploit interference_bound_edf_all_jobs_from_tsk_k.
              {
                apply mem_nth; instantiate (1 := num_mid_jobs.+1).
                by rewrite -(ltn_add2r 1) addn1 H_at_least_two_jobs addn1.
              }
              instantiate (1 := elem); move => [LSTarr [LSTtsk [/eqP LSTserv LSTin]]].
              apply LSTserv; apply/eqP; rewrite -leqn0.
              apply leq_trans with (n := service_during sched j_lst t1 t2);
                first by apply job_interference_le_service.
              rewrite leqn0; apply/eqP; unfold service_during.
              by apply cumulative_service_before_job_arrival_zero with (job_arrival0 := job_arrival).
            Qed.

            (* Since there are multiple jobs, j_fst is far enough from the end of
               the interval that its response-time bound is valid
               (by the assumption H_all_previous_jobs_completed_on_time). *)
            Lemma interference_bound_edf_j_fst_completed_on_time :
              completed job_cost sched j_fst (a_fst + R_k).
            Proof.
              have FST := interference_bound_edf_j_fst_is_job_of_tsk_k; des.
              set j_snd := nth elem sorted_jobs 1.
              exploit interference_bound_edf_all_jobs_from_tsk_k.
              {
                by apply mem_nth; instantiate (1 := 1); rewrite H_at_least_two_jobs.
              }
              instantiate (1 := elem); move => [SNDarr [SNDtsk [/eqP SNDserv _]]].
              apply H_all_previous_jobs_completed_on_time; try (by done).
              apply leq_ltn_trans with (n := job_arrival j_snd); last first.
              {
                rewrite ltnNge; apply/negP; red; intro BUG; apply SNDserv.
                apply/eqP; rewrite -leqn0; apply leq_trans with (n := service_during
                                                                          sched j_snd t1 t2);
                  first by apply job_interference_le_service.
                rewrite leqn0; apply/eqP.
                by apply cumulative_service_before_job_arrival_zero with (job_arrival0 := job_arrival).
              }
              apply leq_trans with (n := a_fst + p_k).
              {
                by rewrite leq_add2l; apply leq_trans with (n := D_k);
                  [by apply H_R_k_le_deadline | by apply H_constrained_deadlines].
              }

              (* Since jobs are sporadic, we know that the first job arrives
                 at least p_k units before the second. *)
              unfold p_k; rewrite -FST0.
              apply H_sporadic_tasks; try (by done); [| by rewrite SNDtsk | ]; last first.
              {
                apply interference_bound_edf_jobs_ordered_by_arrival.
                by rewrite H_at_least_two_jobs.
              }
              red; move => /eqP BUG.
              by rewrite nth_uniq in BUG; rewrite ?SIZE //;
                [ by apply interference_bound_edf_at_least_one_job
                | by rewrite H_at_least_two_jobs
                | by rewrite sort_uniq; apply filter_uniq, undup_uniq].
            Qed.

          End FactsAboutFirstAndLastJobs.

          (* Next, we prove that the distance between the first and last jobs is at least
             num_mid_jobs + 1 periods. *)
          Lemma interference_bound_edf_many_periods_in_between :
            a_lst - a_fst >= num_mid_jobs.+1 * p_k.
          Proof.
            unfold a_fst, a_lst, j_fst, j_lst.
            assert (EQnk: num_mid_jobs.+1=(size sorted_jobs).-1).
              by rewrite H_at_least_two_jobs.
            rewrite EQnk telescoping_sum;
              last by ins; apply interference_bound_edf_jobs_ordered_by_arrival.
            rewrite -[_ * _ tsk_k]addn0 mulnC -iter_addn -{1}[_.-1]subn0 -big_const_nat.
            rewrite big_nat_cond [\sum_(0 <= i < _)(_-_)]big_nat_cond.
            apply leq_sum; intros i; rewrite andbT; move => /andP LT; des.

            (* To simplify, call the jobs 'cur' and 'next' *)
            set cur := nth elem sorted_jobs i.
            set next := nth elem sorted_jobs i.+1.

            (* Show that cur arrives earlier than next *)
            assert (ARRle: job_arrival cur <= job_arrival next).
              by unfold cur, next; apply interference_bound_edf_jobs_ordered_by_arrival.

            feed (interference_bound_edf_all_jobs_from_tsk_k cur).
              by apply mem_nth, (ltn_trans LT0); destruct sorted_jobs.
            intros [CURarr [CURtsk [_ CURin]]].

            feed (interference_bound_edf_all_jobs_from_tsk_k next).
              by apply mem_nth; destruct sorted_jobs.
            intros [NEXTarr [NEXTtsk [_ NEXTin]]].

            (* Use the sporadic task model to conclude that cur and next are separated
               by at least (task_period tsk) units. Of course this only holds if cur != next.
               Since we don't know much about the list (except that it's sorted), we must
               also prove that it doesn't contain duplicates. *)
            assert (CUR_LE_NEXT: job_arrival cur + task_period (job_task cur) <= job_arrival next).
            {
              apply H_sporadic_tasks; try (by done).
              unfold cur, next, not; intro EQ; move: EQ => /eqP EQ.
              rewrite nth_uniq in EQ; first by move: EQ => /eqP EQ; intuition.
                by apply ltn_trans with (n := (size sorted_jobs).-1); destruct sorted_jobs; ins.
                by destruct sorted_jobs; ins.
                by rewrite sort_uniq -/interfering_jobs filter_uniq // undup_uniq.
                by rewrite CURtsk.
            }
            by rewrite subh3 // addnC /p_k -CURtsk.
          Qed.

          (* Using the lemma above, we prove that the ratio n_k is at least the number of
             middle jobs + 1, ... *)
          Lemma interference_bound_edf_n_k_covers_middle_jobs_plus_one :
            n_k >= num_mid_jobs.+1.
          Proof.
            have DIST := interference_bound_edf_many_periods_in_between.
            have AFTERt1 :=
                interference_bound_edf_j_fst_completion_implies_rt_bound_inside_interval
                interference_bound_edf_j_fst_completed_on_time.
            rename H_valid_task_parameters into TASK_PARAMS,
                   H_tsk_k_in_task_set into INk.
            unfold valid_sporadic_taskset, is_valid_sporadic_task,
                   interference_bound, edf_specific_interference_bound in *.
            rewrite leqNgt; apply/negP; unfold not; intro LTnk; unfold n_k in LTnk.
            rewrite ltn_divLR in LTnk; last by specialize (TASK_PARAMS tsk_k INk); des.
            apply (leq_trans LTnk) in DIST; rewrite ltn_subRL in DIST.
            rewrite -(ltn_add2r D_k) -addnA [D_i + _]addnC addnA in DIST.
            apply leq_ltn_trans with (m := job_arrival j_i + D_i) in DIST; last first.
            {
              rewrite leq_add2r; apply (leq_trans AFTERt1).
              by rewrite leq_add2l; apply H_R_k_le_deadline.
            }
            have LST := interference_bound_edf_j_lst_is_job_of_tsk_k.
            destruct LST as [LSTarr [_ [ LEdl _]]].
            apply interference_under_edf_implies_shorter_deadlines with
                  (arr_seq0 := arr_seq) (job_deadline0 := job_deadline) in LEdl; try (by done).
            unfold D_i, D_k in DIST; rewrite interference_bound_edf_j_lst_deadline
                                             interference_bound_edf_j_i_deadline in LEdl.
            by rewrite ltnNge LEdl in DIST.
          Qed.

          (* ... which allows bounding the interference of the middle and last jobs
             using n_k multiplied by the cost. *)
          Lemma interference_bound_edf_holds_for_middle_and_last_jobs :
            interference_caused_by j_lst t1 t2 +
              \sum_(0 <= i < num_mid_jobs)
                interference_caused_by (nth elem sorted_jobs i.+1) t1 t2
            <= n_k * task_cost tsk_k.
          Proof.
            apply leq_trans with (n := num_mid_jobs.+1 * task_cost tsk_k); last first.
            {
              rewrite leq_mul2r; apply/orP; right.
              by apply interference_bound_edf_n_k_covers_middle_jobs_plus_one.
            }
            rewrite mulSn; apply leq_add.
            {
              apply interference_bound_edf_interference_le_task_cost.
              rewrite interference_bound_edf_job_in_same_sequence.
              by apply mem_nth; rewrite H_at_least_two_jobs.
            }
            {
              apply leq_trans with (n := \sum_(0 <= i < num_mid_jobs) task_cost tsk_k);
                last by rewrite big_const_nat iter_addn addn0 mulnC subn0.
              rewrite big_nat_cond [\sum_(0 <= i < num_mid_jobs) task_cost _]big_nat_cond.
              apply leq_sum; intros i; rewrite andbT; move => /andP LT; des.
              apply interference_bound_edf_interference_le_task_cost.
              rewrite interference_bound_edf_job_in_same_sequence.
              apply mem_nth; rewrite H_at_least_two_jobs.
              by rewrite ltnS; apply leq_trans with (n := num_mid_jobs).
            }
          Qed.

          (* Now, since n_k < sorted_jobs = num_mid_jobs + 2, it follows that
             n_k = num_mid_jobs + 1. *)
          Lemma interference_bound_edf_n_k_equals_num_mid_jobs_plus_one :
            n_k = num_mid_jobs.+1.
          Proof.
            have NK := interference_bound_edf_n_k_covers_middle_jobs_plus_one.
            rename H_many_jobs into NUM, H_at_least_two_jobs into SIZE.
            move: NK; rewrite leq_eqVlt orbC; move => /orP NK; des;
             [by rewrite SIZE ltnS leqNgt NK in NUM | by done].
          Qed.

          (* After proving the bounds of the middle and last jobs, we do the same for
             the first job. This requires a different proof in order to exploit the slack. *)
          Section InterferenceOfFirstJob.

            (* As required by the next lemma, in order to move (D_i %% p_k) to the left of
               the inequality (<=), we must show that it is no smaller than the slack. *)
            Lemma interference_bound_edf_remainder_ge_slack :
              D_k - R_k <= D_i %% p_k.
            Proof.
              have AFTERt1 :=
                interference_bound_edf_j_fst_completion_implies_rt_bound_inside_interval
                interference_bound_edf_j_fst_completed_on_time.
              have NK := interference_bound_edf_n_k_equals_num_mid_jobs_plus_one.
              have DIST := interference_bound_edf_many_periods_in_between.
              rewrite -NK in DIST.
              rewrite -subndiv_eq_mod leq_subLR.
              fold (div_floor D_i p_k) n_k.
              rewrite addnBA; last by apply leq_trunc_div.
              apply leq_trans with (n := R_k + D_i - (a_lst - a_fst)); last by apply leq_sub2l.
              rewrite subnBA; last by apply interference_bound_edf_j_fst_before_j_lst.
              rewrite -(leq_add2r a_lst) subh1; last first.
              {
                apply leq_trans with (n := t2);
                  [by apply ltnW, interference_bound_edf_last_job_arrives_before_end_of_interval|].
                rewrite addnC addnA.
                apply leq_trans with (n := t1 + D_i).
                  unfold t2; rewrite leq_add2l; apply H_delta_le_deadline.
                by rewrite leq_add2r; apply AFTERt1.
              }
              rewrite -addnBA // subnn addn0 [D_k + _]addnC.
              apply leq_trans with (n := t1 + D_i);
                last by rewrite -addnA [D_i + _]addnC addnA leq_add2r addnC AFTERt1.
              have LST := interference_bound_edf_j_lst_is_job_of_tsk_k.
              destruct LST as [LSTarr [_ [ LSTserv _]]].
              unfold D_i, D_k, a_lst, t1; rewrite -interference_bound_edf_j_lst_deadline
                                                  -interference_bound_edf_j_i_deadline.
              by apply interference_under_edf_implies_shorter_deadlines with
                            (arr_seq0 := arr_seq) (job_deadline0 := job_deadline) in LSTserv.
            Qed.

            (* To conclude that the interference bound holds, it suffices to show that
               this reordered inequality holds. *)
            Lemma interference_bound_edf_simpl_by_moving_to_left_side :
              interference_caused_by j_fst t1 t2 + (D_k - R_k) + D_i %/ p_k * p_k <= D_i ->
              interference_caused_by j_fst t1 t2 <= D_i %% p_k - (D_k - R_k).
            Proof.
              intro LE.
              apply subh3.
                by rewrite -subndiv_eq_mod; apply subh3.
            Qed.

            (* Next, we prove that interference caused by j_fst is bounded by the length
               of the interval [t1, a_fst + R_k), ... *)
            Lemma interference_bound_edf_interference_of_j_fst_bounded_by_response_time :
               interference_caused_by j_fst t1 t2 <= \sum_(t1 <= t < a_fst + R_k) 1.
            Proof.
              assert (AFTERt1: t1 <= a_fst + R_k).
              {
                apply interference_bound_edf_j_fst_completion_implies_rt_bound_inside_interval.
                by apply interference_bound_edf_j_fst_completed_on_time.
              }
              destruct (leqP t2 (a_fst + R_k)) as [LEt2 | GTt2].
              {
                apply leq_trans with (n := job_interference job_arrival job_cost sched j_i j_fst t1
                                                                              (a_fst + R_k));
                  first by apply extend_sum; rewrite ?leqnn.
                simpl_sum_const; rewrite -{1}[_ + R_k](addKn t1) -addnBA //.
                by apply job_interference_le_delta.
              }
              {
                unfold interference_caused_by, job_interference.
                rewrite -> big_cat_nat with (n := a_fst + R_k);
                  [simpl | by apply AFTERt1 | by apply ltnW].
                rewrite -[\sum_(_ <= _ < _) 1]addn0; apply leq_add.
                {
                  simpl_sum_const; rewrite -{1}[_ + R_k](addKn t1) -addnBA //.
                  by apply job_interference_le_delta.
                }
                apply leq_trans with (n := service_during sched j_fst (a_fst + R_k) t2);
                  first by apply job_interference_le_service.
                rewrite leqn0; apply/eqP.
                apply cumulative_service_after_job_rt_zero with (job_cost0 := job_cost) (R := R_k)
                  (job_arrival0 := job_arrival); [ by done | | by apply leqnn].
                by apply interference_bound_edf_j_fst_completed_on_time.
              }
            Qed.

            (* ..., which leads to the following bounds based on interval lengths. *)
            Lemma interference_bound_edf_bounding_interference_with_interval_lengths :
              interference_caused_by j_fst t1 t2 + (D_k - R_k) + D_i %/ p_k * p_k <=
              \sum_(t1 <= t < a_fst + R_k) 1
              + \sum_(a_fst + R_k <= t < a_fst + D_k) 1
              + \sum_(a_fst + D_k <= t < a_lst + D_k) 1.
            Proof.
              apply leq_trans with (n := \sum_(t1 <= t < a_fst + R_k) 1 + (D_k - R_k) +
                                                                       D_i %/ p_k * p_k).
              {
                rewrite 2!leq_add2r.
                apply interference_bound_edf_interference_of_j_fst_bounded_by_response_time.
              }
              apply leq_trans with (n := \sum_(t1 <= t < a_fst + R_k) 1 + (D_k - R_k) +
                                                                        (a_lst - a_fst)).
              {
                rewrite leq_add2l; fold (div_floor D_i p_k) n_k.
                rewrite interference_bound_edf_n_k_equals_num_mid_jobs_plus_one.
                by apply interference_bound_edf_many_periods_in_between.
              }
              apply leq_trans with (n := \sum_(t1 <= t < a_fst + R_k) 1 +
                  \sum_(a_fst + R_k <= t < a_fst + D_k) 1 + \sum_(a_fst + D_k <= t < a_lst + D_k) 1).
              {
                by rewrite -2!addnA leq_add2l; apply leq_add;
                rewrite big_const_nat iter_addn mul1n addn0;
                rewrite ?subnDl ?subnDr leqnn.
              }
              by apply leqnn.
            Qed.

            (* To conclude, we show that the concatenation of these interval lengths equals
               (a_lst + D_k) - 1, ... *)
            Lemma interference_bound_edf_simpl_by_concatenation_of_intervals :
              \sum_(t1 <= t < a_fst + R_k) 1
              + \sum_(a_fst + R_k <= t < a_fst + D_k) 1
              + \sum_(a_fst + D_k <= t < a_lst + D_k) 1 = (a_lst + D_k) - t1.
            Proof.
              assert (AFTERt1: t1 <= a_fst + R_k).
              {
                apply interference_bound_edf_j_fst_completion_implies_rt_bound_inside_interval.
                by apply interference_bound_edf_j_fst_completed_on_time.
              }
              rewrite -big_cat_nat;
                [simpl | by apply AFTERt1 | by rewrite leq_add2l; apply H_R_k_le_deadline].
              rewrite -big_cat_nat; simpl; last 2 first.
              {
                apply leq_trans with (n := a_fst + R_k); first by apply AFTERt1.
                by rewrite leq_add2l; apply H_R_k_le_deadline.
              }
              {
                rewrite leq_add2r; unfold a_fst, a_lst, j_fst, j_lst.
                rewrite -[num_mid_jobs.+1]add0n; apply prev_le_next;
                  last by rewrite add0n H_at_least_two_jobs ltnSn.
                by ins; apply interference_bound_edf_jobs_ordered_by_arrival.
              }
              by rewrite big_const_nat iter_addn mul1n addn0.
            Qed.

            (* ... which results in proving that (a_lst + D_k) - t1 <= D_i.
               This holds because high-priority jobs have earlier deadlines. Therefore,
               the interference caused by the first job is bounded by D_i %% p_k - (D_k - R_k). *)
            Lemma interference_bound_edf_interference_of_j_fst_limited_by_remainder_and_slack :
              interference_caused_by j_fst t1 t2 <= D_i %% p_k - (D_k - R_k).
            Proof.
              apply interference_bound_edf_simpl_by_moving_to_left_side.
              apply (leq_trans interference_bound_edf_bounding_interference_with_interval_lengths).
              rewrite interference_bound_edf_simpl_by_concatenation_of_intervals leq_subLR.
              have LST := interference_bound_edf_j_lst_is_job_of_tsk_k.
              destruct LST as [LSTarr [_ [ LSTserv _]]].
              unfold D_i, D_k, a_lst, t1; rewrite -interference_bound_edf_j_lst_deadline
                                                  -interference_bound_edf_j_i_deadline.
              by apply interference_under_edf_implies_shorter_deadlines
                with (arr_seq0 := arr_seq) (job_deadline0 := job_deadline) in LSTserv.
            Qed.

          End InterferenceOfFirstJob.

          (* Using the lemmas above we show that the interference bound works in the
             case of two or more jobs. *)
          Lemma interference_bound_edf_holds_for_multiple_jobs :
            \sum_(0 <= i < num_mid_jobs.+2)
              interference_caused_by (nth elem sorted_jobs i) t1 t2 <= interference_bound.
          Proof.
            (* Knowing that we have at least two elements, we take first and last out of the sum *)
            rewrite [nth]lock big_nat_recl // big_nat_recr // /= -lock.
            rewrite addnA addnC addnA.

            have NK := interference_bound_edf_n_k_equals_num_mid_jobs_plus_one.

            (* We use the lemmas we proved to show that the interference bound holds. *)
            unfold interference_bound, edf_specific_interference_bound.
            fold D_i D_k p_k n_k.
            rewrite addnC addnA; apply leq_add;
              first by rewrite addnC interference_bound_edf_holds_for_middle_and_last_jobs.
            rewrite leq_min; apply/andP; split.
            {
              apply interference_bound_edf_interference_le_task_cost.
              rewrite interference_bound_edf_job_in_same_sequence.
              by apply mem_nth; rewrite H_at_least_two_jobs.
            }
            by apply interference_bound_edf_interference_of_j_fst_limited_by_remainder_and_slack.
          Qed.

        End InterferenceTwoOrMoreJobs.

      End InterferenceManyJobs.

      Theorem interference_bound_edf_bounds_interference :
        x <= interference_bound.
      Proof.
        (* Use the definition of workload based on list of jobs. *)
        apply (leq_trans interference_bound_edf_use_another_definition).

        (* We only care about the jobs that cause interference. *)
        rewrite interference_bound_edf_simpl_by_filtering_interfering_jobs.

        (* Now we order the list by job arrival time. *)
        rewrite interference_bound_edf_simpl_by_sorting_interfering_jobs.

        (* Next, we show that the workload bound holds if n_k
           is no larger than the number of interferings jobs. *)
        destruct (size sorted_jobs <= n_k) eqn:NUM;
          first by apply interference_bound_edf_holds_for_at_most_n_k_jobs.
        apply negbT in NUM; rewrite -ltnNge in NUM.

        (* Find some dummy element to use in the nth function *)
        assert (EX: exists elem: Job, True).
          destruct sorted_jobs as [| j]; [by rewrite ltn0 in NUM | by exists j].
        destruct EX as [elem _].

        (* Now we index the sum to access the first and last elements. *)
        rewrite (big_nth elem).

        (* First, we show that the bound holds for an empty list of jobs. *)
        destruct (size sorted_jobs) as [| n] eqn:SIZE;
          first by rewrite big_geq.

        (* Then, we show the same for a single job, or for multiple jobs. *)
        destruct n as [| num_mid_jobs].
        {
          rewrite big_nat_recr // big_geq //.
          rewrite [nth]lock /= -lock add0n.
          by apply interference_bound_edf_holds_for_a_single_job; rewrite SIZE.
        }
        {
          by apply interference_bound_edf_holds_for_multiple_jobs; first by rewrite SIZE.
        }
      Qed.

    End MainProof.

  End ProofSpecificBound.

  (* As required by the proof of convergence of EDF RTA, we show that the
     EDF-specific bound is monotonically increasing with both the size
     of the interval and the value of the previous response-time bounds. *)
  Section MonotonicitySpecificBound.

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

    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 tsk delta (tsk_other, R) <=
      interference_bound_edf task_cost task_period task_deadline 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 task_cost task_period (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 task_cost task_period (fst (tsk_other, R))
                                                   (snd (tsk_other, R)) delta);
          [by apply geq_minl | by apply W_monotonic].
        apply leq_trans with (n := minn (W task_cost task_period (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 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));
          [by apply geq_minr | by rewrite 2?leq_sub2l 2?leq_sub2r // leq_sub2l].
      }
    Qed.

  End MonotonicitySpecificBound.

End InterferenceBoundEDF.


Set Implicit Arguments.
Unset Strict Implicit.

Require Import mathcomp.ssreflect.ssreflect.
From mathcomp Require Import all_ssreflect.
From mathcomp Require Import all_algebra.

Import GRing.Theory Num.Theory Num.Def.
Require Import QArith.

Require Import games.

Local Open Scope ring_scope.

Module Christodoulou.

  (* ########################################################### *)
  (** * Helper lemmas *)

  Lemma subrr' (rty : realFieldType) (a : rty) :
    - a + a = 0.
  Proof.
    rewrite addrC. apply: subrr.
  Qed.

  Lemma sub_add_0 (rty : realFieldType) (a b : rty) :
    a - b + b = a.
  Proof.
    rewrite -addrA subrr' addrC add0r => //.
  Qed.

  Lemma leq_case (a b : nat) :
    is_true (leq a (S b)) ->
    a = S b \/ is_true (leq a b).
  Proof.
    move => H. rewrite leq_eqVlt in H.
    move: H. move => /orP H.
    destruct H.
    left. move: H. move => /eqP H. apply H.
    right. apply H.
  Qed.

  (* ########################################################### *)
  (** * Subresult proof.

    yz <= y^2 + (1/3)z^2 *)

  (* Multiply both sides by 3 *)
  Lemma s1 (y z : nat) :
    3%:Q * y%:Q * z%:Q <= 3%:Q * y%:Q ^+ 2 + z%:Q ^+ 2 ->
    y%:Q * z%:Q <= (3%:Q / 3%:Q) * y%:Q ^+ 2 + (1%:Q / 3%:Q) * z%:Q ^+ 2.
  Proof.
    move => H0. apply ler_mull2 with (z := 3%:Q); auto.
    rewrite mulrA [3%:~R * (_ + _)] mulrDr mulrA.
    have H1: ((3%:Q / 3%:Q) = 1%:Q) by apply: divff.
    rewrite H1 mulr1 mulrA mulrA mulrA.
    have H2: (3%:Q * (1%:Q / 3%:Q) = 1%:Q) by [].
    rewrite H2 mul1r.
    have H3: (y%:Q ^+ 2 = y%:Q * y%:Q) by [].
    have H4: (z%:Q ^+ 2 = z%:Q * z%:Q) by [].
    rewrite H3 H4 mulrA in H0. apply H0.
  Qed.

  (* Subtract 3*y^2 from both sides *)
  Lemma s2 (y z : nat) :
    (3%:Q * y%:Q * z%:Q - 3%:Q * y%:Q ^+ 2 <= z%:Q ^+ 2) ->
    (3%:Q * y%:Q * z%:Q <= 3%:Q * y%:Q ^+ 2 + z%:Q ^+ 2).
  Proof.
    move => H.
    have H0: (3%:Q * y%:Q * z%:Q - 3%:Q * y%:Q ^+ 2 +
              3%:Q * y%:Q ^+ 2 <= z%:Q ^+ 2 + 3%:Q * y%:Q ^+ 2).
    { apply ler_add. apply H. auto. }
    rewrite sub_add_0 addrC in H0. apply H0.
  Qed.

  (* Distrbute 3*y *)
  Lemma s3 (y z : nat) :
    3%:Q * y%:Q * z%:Q - 3%:Q * y%:Q ^+ 2 =
    3%:Q * y%:Q * (z%:Q - y%:Q).
  Proof. rewrite [_ * (_ - y%:Q)] mulrBr mulrA => //. Qed.

  (* Divide both sides by 3 *)
  Lemma s4 (y z : nat) :
    y%:Q * (z%:Q - y%:Q) <= (z%:Q / 2%:Q) ^+ 2 ->
    3%:Q * y%:Q * (z%:Q - y%:Q) <= 3%:Q * (z%:Q / 2%:Q) ^+ 2.
  Proof.
    move => H.
    have H0: (3%:Q * y%:Q * (z%:Q - y%:Q) = 3%:Q * (y%:Q * (z%:Q - y%:Q))).
    { rewrite mulrA => //. }
    rewrite H0.
    apply ler_mull => //.
  Qed.

  Lemma s5 (y z : nat) :
    z%:Q = y%:Q + (z%:Q - y%:Q).
  Proof. rewrite addrC sub_add_0 => //. Qed.

  (* Divide both sides by 3 then apply AGM inequality *)
  Lemma s6 (y z : nat) :
    3%:Q * y%:Q * (z%:Q - y%:Q) <= 3%:Q * (z%:Q / 2%:Q) ^+ 2.
  Proof.
    apply: s4.
    have H: (z%:Q = y%:~R + (z%:~R - y%:~R)) by apply: s5.
    rewrite {2} H.
    apply: lerif_AGM2.
  Qed.

  Lemma s7 (z : nat) :
    (z%:Q / 2%:Q) * (z%:Q / 2%:Q) = (z%:Q * z%:Q) / 4%:Q.
  Proof.
    have H0: (4%:Q = 2%:Q * 2%:Q) by [].
    rewrite H0 mulrA [z%:~R * z%:~R / _] mulrC.
    rewrite -mulrA -mulrA [2%:~R^-1 * _] mulrC mulrC.
    rewrite [z%:~R / 2%:~R] mulrC mulrA mulrA [2%:~R^-1 / 2%:~R] mulrC.
    rewrite -invrM; auto.
    rewrite mulrC [z%:~R / (2%:~R * 2%:~R) * z%:~R] mulrC mulrA => //.
  Qed.

  Lemma s8 (z : nat) :
    3%:Q * (z%:Q / 2%:Q) * (z%:Q / 2%:Q) =
    z%:Q * z%:Q * (3%:Q / 4%:Q).
  Proof.
    rewrite -[3%:Q * _ * _] mulrA s7 mulrA mulrC.
    rewrite [4%:~R^-1 * _] mulrA mulrC mulrC => //.
  Qed.

  (* 1 <= y -> 0 < y *)
  Lemma s9 (rty : numDomainType) (z : nat) :
    leq (S O) z ->
    0 < (z%:R^-1 : rty).
  Proof.
    rewrite -(ler_nat rty) => H.
    rewrite invr_gt0.
    have H2: (0 : rty) < 1%:R by [].
      by apply: (ltr_le_trans H2 H).
  Qed.

  (* 1 <= z -> z != 0 *)
  Lemma s10 (rty : numDomainType) (z : nat) :
    leq (S O) z ->
    (z%:R : rty) != (0%:R : rty).
  Proof.
    move => H. rewrite -(ler_nat rty) in H.
    rewrite lt0r_neq0 => //.
    have H0: ((0 : rty) < (1%:R : rty)) by [].
      by apply: (ltr_le_trans H0 H).
  Qed.

  Lemma s11 (y z : nat) :
    3%:Q * (z%:Q / 2%:Q) ^+ 2 <= z%:Q ^+ 2.
  Proof.
    case H0: z.
    - (* z = 0 *)
      rewrite mul0r.
      have H1: (0%:Q ^+ 2 = 0%:Q * 0%:Q) by [].
        by rewrite !H1 mul0r mulrC mul0r.
    - (* z > 0 *)
      have H1: ((z%:Q / 2%:Q) ^+ 2 = (z%:Q / 2%:Q) * (z%:Q / 2%:Q)) by [].
      rewrite H0 in H1.
      rewrite H1 mulrA s8.
      have H2: (z%:Q ^+ 2 = z%:Q * z%:Q) by [].
      rewrite H0 in H2. rewrite H2.
      apply ler_mull2 with (z := z%:Q^-1). apply s9 => //; last by rewrite H0.
      rewrite -H0 [z%:Q^-1 * _] mulrA [z%:~R^-1 * _] mulrA [z%:~R^-1 * z%:~R] mulVf.
      rewrite mul1r.
      apply ler_mull2 with (z := z%:Q^-1). apply s9 => //.
        by rewrite H0.
        rewrite [z%:~R^-1 * _] mulrA [z%:~R^-1 * z%:~R] mulVf.
        rewrite  mul1r => //.
        apply s10 => //. by rewrite H0.
        apply s10 => //. by rewrite H0.
  Qed.

  (* this implies the main result when y >= 2 *)
  Lemma subresult (y z : nat) :
      y%:Q * z%:Q <=
      (3%:Q / 3%:Q) * y%:Q ^+ 2 + (1%:Q / 3%:Q) * z%:Q ^+ 2.
  Proof.
    apply: s1. apply: s2. rewrite s3.
    have H1: (3%:Q * y%:Q * (z%:Q - y%:Q) <= 3%:Q * (z%:Q / 2%:Q) ^+ 2)
      by apply: s6.
    have H2: (3%:Q * (z%:Q / 2%:Q) ^+ 2 <= z%:Q ^+ 2) by apply: s11.
    apply: ler_trans. apply H1. apply H2.
  Qed.

  (* ########################################################### *)
  (** * Subresult implies main result proof *)

  (* 2 <= y -> 0 < y *)
  Lemma sr3 (y : nat) :
    leq 2 y ->
    0 < y%:Q.
  Proof.
    move => H0.
    rewrite -(ltr1n rat_numDomainType) in H0.
    have H1: (0%:Q < 1%:Q) by [].
    apply: ltr_trans. apply H1. apply H0.
  Qed.

  (* 2 <= y -> 2/3 <= y *)
  Lemma sr4 (y : nat) :
    leq 2 y ->
    3%:Q / 2%:Q <= y%:Q.
  Proof.
    move => H0.
    rewrite -(ler_nat rat_numDomainType) in H0.
    have H1: (3%:Q / 2%:Q <= 2%:Q) by [].
    apply: ler_trans. apply: H1. apply: H0.
  Qed.

  (* 2 <= y -> y <= (2/3)*y^2 *)
  Lemma sr5 (y : nat) :
    leq 2 y ->
    y%:Q <= 2%:Q / 3%:Q * y%:Q ^+ 2.
  Proof.
    move => H.
    rewrite mulrC.
    have H0: (y%:Q ^+ 2 = y%:Q * y%:Q) by [].
    rewrite H0 mulrA.
    have H1: (y%:Q = y%:Q * 1%:Q). rewrite mulrC mul1r => //.
    rewrite {1} H1.
    have H2: (y%:Q * y%:Q * (2%:Q / 3%:Q) = y%:Q * (y%:Q * (2%:Q / 3%:Q)))
      by rewrite -mulrA.
    rewrite -mulrA  H2.
    apply ler_mull with (x := 1%:Q) (y := y%:Q * (2%:Q / 3%:Q)) (z := y%:Q).
    apply sr3 => //.
    apply ler_mull2 with (z := 3%:Q / 2%:Q) => //.
    rewrite mulrC mul1r.
    have H3: (y%:Q * (2%:Q / 3%:Q) = 2%:Q / 3%:Q * y%:Q) by rewrite mulrC.
    rewrite H3 mulrA.
    have H4: (2%:Q / 3%:Q = (3%:Q / 2%:Q)^-1) by [].
    have H5: (3%:Q / 2%:Q * (2%:Q / 3%:Q) = 1) by rewrite mulrC H4 mulVr.
    rewrite H5 mul1r.
    apply sr4 => //.
  Qed.

  (* Combine terms *)
  Lemma sr6 (y : nat) (a : rat) :
    3%:Q / 3%:Q * y%:Q ^+ 2 + a + 2%:Q / 3%:Q * y%:Q ^+ 2 =
    5%:Q / 3%:Q * y%:Q ^+ 2 + a.
  Proof.
    rewrite addrC addrA -mulrDl.
    have H: (2%:Q / 3%:Q + 3%:Q / 3%:Q = 5%:Q / 3%:Q) by [].
    rewrite H => //.
  Qed.

  (* When 2 <= y, subresult -> main result *)
  Lemma subresult_implies_result (y z: nat) :
      leq 2 y ->
      y%:Q * z%:Q <= (3%:Q / 3%:Q) * y%:Q ^+ 2 + (1%:Q / 3%:Q) * z%:Q ^+ 2 ->
      y%:Q * (z%:Q + 1) <= (5%:Q / 3%:Q) * y%:Q ^+ 2 + (1%:Q / 3%:Q) * z%:Q ^+ 2.
  Proof.
    move => H0 H1.
    have H2: (y%:Q * z%:Q + y%:Q <=
              3%:Q / 3%:Q * y%:Q ^+ 2 +
              1%:Q / 3%:Q * z%:Q ^+ 2 + (2%:Q / 3%:Q) * y%:Q ^+ 2).
    {  apply ler_add. apply H1. apply: sr5 => //. }
    rewrite sr6 in H2.
    rewrite mulrDr mulr1. apply: H2.
  Qed.

  (* 3 <= z -> z <= (1/3)*z^2 *)
  Lemma r1_1 (z : nat) :
    leq 3 z ->
    z%:Q <= 1%:Q / 3%:Q * z%:Q ^+ 2.
  Proof.
    move => H.
    rewrite mulrC.
    have H0: (z%:Q ^+ 2 = z%:Q * z%:Q) by [].
    rewrite H0 mulrA.
    have H1: (z%:Q = z%:Q * 1%:Q). rewrite mulrC mul1r => //.
    rewrite {1} H1.
    have H2: (z%:Q * z%:Q * (1%:Q / 3%:Q) = z%:Q * (z%:Q * (1%:Q / 3%:Q)))
      by rewrite -mulrA.
    rewrite -mulrA  H2.
    apply ler_mull with (x := 1%:Q) (y := z%:Q * (1%:Q / 3%:Q)) (z := z%:Q).
    apply sr3 => //.
    have H3: (ltn (S O) 2) by [].
    apply: ltn_trans. apply H3. apply H.
    apply ler_mull2 with (z := 3%:Q / 1%:Q).
    rewrite mulrC mul1r => //.
    have H3: (z%:Q * (1%:Q / 3%:Q) = 1%:Q / 3%:Q * z%:Q) by rewrite mulrC.
    rewrite H3 mulrA.
    have H4: (1%:Q / 3%:Q = (3%:Q / 1%:Q)^-1) by [].
    have H5: (3%:Q / 1%:Q * (1%:Q / 3%:Q) = 1) by rewrite mulrC H4 mulVr.
    rewrite H5 mul1r mulrC mul1r.
    have H6: (3%:Q / 1%:Q = 3%:Q) by []. rewrite H6.
    rewrite ler_nat. apply H.
  Qed.

  (* This is the main result when y = 1 *)
  Lemma r1 (z : nat) :
      z%:Q + 1 <= 5%:Q / 3%:Q + 1%:Q / 3%:Q * z%:Q ^+ 2.
  Proof.
    have H0: (z%:Q <= 2%:Q / 3%:Q +  1%:Q / 3%:Q * z%:Q ^+ 2).
    { case H: (leq 3 z).
      apply elimT with (P := (le 3 z)%N) in H.
      rewrite addrC.
      have H0: (z%:Q = z%:Q + 0%:Q) by rewrite addrC add0r => //.
      rewrite {1} H0. apply ler_add; auto.
      apply r1_1. move: H. move => /leP => //.
      apply /leP.
      apply negbT in H.  rewrite -ltnNge in H.
      apply leq_case in H. destruct H.
      have H1: (z = 2) by omega. rewrite H1 => //.
      apply leq_case in H. destruct H.
      have H1: (z = S O) by omega. rewrite H1 => //.
      apply leq_case in H. destruct H.
      have H1: (z = O) by omega. rewrite H1 => //.
      rewrite ltn0 in H. congruence. }
    have H1: (5%:Q / 3%:Q = 2%:Q / 3%:Q + 1%:Q) by [].
    rewrite H1 -addrA [1%:~R + _] addrC addrA.
    apply ler_add; by [].
  Qed.

  (* ########################################################### *)
  (** * Main result *)

  Lemma result (y z : nat) :
      y%:Q * (z%:Q + 1) <=
      (5%:Q / 3%:Q) * y%:Q ^+ 2 + (1%:Q / 3%:Q) * z%:Q ^+ 2.
  Proof.
    case H: (leq 2 y).
    - (* y > 1 *)
      apply: subresult_implies_result => //.
      apply: subresult.
      (* other cases *)
      apply negbT in H. rewrite -leqNgt in H.
      apply leq_case in H. destruct H.
      + (* y = 1 *)
        rewrite H. rewrite mul1r. apply: r1.
      + (* y = 0*)
        rewrite leqn0 in H. move: H. move => /eqP H.
        rewrite H mul0r mulrC mul0r add0r.
        apply: mulr_ge0 => //. apply: sqr_ge0.
  Qed.

End Christodoulou.


Require Import Infrastructure.
Require Import List.
Import ListNotations.

Definition size_elem (s : qs) : nat :=
  match s with
  | qs_arr A => size_sty A
  | qs_all _ A => size_sty A
  | qs_rcd _ => 0
end.

Definition sizefs (Q : seqs) :=
  fold_right (fun l acc => l + acc) 0 (map size_elem Q).

(** Q => A in the note *)
Definition applyfs (Q : seqs) (A : sty) :=
  fold_right (fun el acc =>
                match el with
                | qs_arr A => sty_arrow A acc
                | qs_rcd l => sty_rcd l acc
                | qs_all X A => sty_all A (close_sty_wrt_sty X acc)
                end) A Q.

(**

Well-formedness of Q

Q grows at the tail, which requires that variales appearing later should be
fresh with respect to previous items.

The following is not correct.

Inductive wf_fs : seqs -> Prop :=
| fs_empty : wf_fs []
| fs_arr : forall Q A, lc_sty A -> wf_fs Q -> wf_fs ((qs_arr A) :: Q )
| fs_rcd : forall Q l, wf_fs Q -> wf_fs ((qs_rcd l) :: Q)
| fs_all : forall Q X A,
    lc_sty A ->
    X `notin` fv_sty_in_sty A ->
    not_occur X Q ->
    wf_fs Q -> wf_fs ((qs_all X A) :: Q).

 *)

(** [qvars_notin s Q] means all type binders of [Q] do not occur in [s]    *)
Inductive qvars_notin (s : vars) : seqs -> Prop :=
| qvars_empty : qvars_notin s []
| qvars_arr : forall Q A, qvars_notin s Q -> qvars_notin s ((qs_arr A) :: Q)
| qvars_rcd : forall Q l, qvars_notin s Q -> qvars_notin s ((qs_rcd l) :: Q)
| qvars_all : forall Q X A,
    qvars_notin s Q ->
    X `notin` s ->
    qvars_notin s ((qs_all X A) :: Q).

(** [wf_fs Q]: well-formedness of [Q], ensuring that type bidners appearing later are fresh with respect to previous items *)
Inductive wf_fs : seqs -> Prop :=
| fs_empty : wf_fs []
| fs_arr : forall Q A,
    lc_sty A ->
    wf_fs Q ->
    qvars_notin (fv_sty_in_sty A) Q ->
    wf_fs ((qs_arr A) :: Q )
| fs_rcd : forall Q l, wf_fs Q -> wf_fs ((qs_rcd l) :: Q)
| fs_all : forall Q X A,
    lc_sty A ->
    X `notin` fv_sty_in_sty A ->
    qvars_notin (fv_sty_in_sty (sty_var_f X) \u fv_sty_in_sty A) Q ->
    wf_fs Q -> wf_fs ((qs_all X A) :: Q).

Hint Constructors qvars_notin wf_fs.

(** Two meta-functions of coercions  *)
Fixpoint calTop (Q : seqs) : co :=
  match Q with
  | nil => co_top
  | cons l fs' =>
    match l with
    | qs_arr _ => co_trans (co_arr co_top (calTop fs')) co_topArr
    | qs_rcd l => co_trans (calTop fs') co_id
    | qs_all _ _ => co_trans (co_forall (calTop fs')) co_topAll
    end
  end.

Fixpoint calAnd (Q : seqs) : co :=
  match Q with
  | nil => co_id
  | cons l fs' =>
    match l with
    | qs_arr _ => co_trans (co_arr co_id (calAnd fs')) co_distArr
    | qs_rcd l => co_trans (calAnd fs') (co_id)
    | qs_all _ _ => co_trans (co_forall (calAnd fs')) co_distPoly
    end
  end.

(** Algorithmic subtyping *)
Inductive asub : sty -> seqs -> sty -> co -> Prop :=
 | A_nat :
     asub sty_nat  nil  sty_nat co_id
 | A_var : forall (X:typvar),
     asub (sty_var_f X)  nil  (sty_var_f X) co_id
 | A_top : forall (A:sty) (Q:seqs),
     lc_sty A ->
     wf_fs Q ->
     asub A Q sty_top (co_trans  (calTop  Q )  co_top)
 | A_and : forall (A:sty) (Q:seqs) (B1 B2:sty) (c1 c2:co),
     asub A Q B1 c1 ->
     asub A Q B2 c2 ->
     asub A Q (sty_and B1 B2) (co_trans  (calAnd  Q )  (co_pair c1 c2))
 | A_rcdNat : forall (l:i) (A:sty) (Q:seqs) (c:co),
     asub A Q sty_nat c ->
     asub (sty_rcd l A)   (cons  (qs_rcd l)   Q )   sty_nat c
 | A_rcdVar : forall (l:i) (A:sty) (Q:seqs) (X:typvar) (c:co),
     asub A Q (sty_var_f X) c ->
     asub (sty_rcd l A)   (cons  (qs_rcd l)   Q )   (sty_var_f X) c
 | A_rcd : forall (A:sty) (Q:seqs) (l:i) (B:sty) (c:co),
     asub A ( Q  ++ [(qs_rcd l)])   B c ->
     asub A Q (sty_rcd l B) c
 | A_arr : forall (A:sty) (Q:seqs) (B1 B2:sty) (c:co),
     asub A (Q ++ [(qs_arr B1)])   B2 c ->
     asub A Q (sty_arrow B1 B2) c
 | A_forall : forall (L:vars) (A:sty) (Q:seqs) (B1 B2:sty) (c:co),
     (forall X, X \notin  L  ->
           asub A (Q  ++ [(qs_all X B1)]) (open_sty_wrt_sty B2 (sty_var_f X)) c)  ->
     asub A Q (sty_all B1 B2) c
 | A_andNat1 : forall (A1 A2:sty) (Q:seqs) (c:co),
     lc_sty A2 ->
     asub A1 Q sty_nat c ->
     asub (sty_and A1 A2) Q sty_nat (co_trans c co_proj1)
 | A_andNat2 : forall (A1 A2:sty) (Q:seqs) (c:co),
     lc_sty A1 ->
     asub A2 Q sty_nat c ->
     asub (sty_and A1 A2) Q sty_nat (co_trans c co_proj2)
 | A_andVar1 : forall (A1 A2:sty) (Q:seqs) (X:typvar) (c:co),
     lc_sty A2 ->
     asub A1 Q (sty_var_f X) c ->
     asub (sty_and A1 A2) Q (sty_var_f X) (co_trans c co_proj1)
 | A_andVar2 : forall (A1 A2:sty) (Q:seqs) (X:typvar) (c:co),
     lc_sty A1 ->
     asub A2 Q (sty_var_f X) c ->
     asub (sty_and A1 A2) Q (sty_var_f X) (co_trans c co_proj2)
 | A_arrNat : forall (A1 A2 A:sty) (Q:seqs) (c1 c2:co),
     qvars_notin (fv_sty_in_sty A) Q ->
     asub A  nil  A1 c1 ->
     asub A2 Q sty_nat c2 ->
     asub (sty_arrow A1 A2)   (cons (qs_arr A) Q)   sty_nat (co_arr c1 c2)
 | A_arrVar : forall (A1 A2 A:sty) (Q:seqs) (X:typvar) (c1 c2:co),
     qvars_notin (fv_sty_in_sty A) Q ->
     asub A  nil  A1 c1 ->
     asub A2 Q (sty_var_f X) c2 ->
     asub (sty_arrow A1 A2)   (cons (qs_arr A) Q)   (sty_var_f X) (co_arr c1 c2)
 | A_allNat : forall (L:vars) (A1 A2 A:sty) (Q:seqs) (c c':co) (X : typvar),
     X `notin` fv_sty_in_sty A ->
     X `notin` fv_sty_in_sty A1 ->
     X `notin` fv_sty_in_sty A2 ->
     qvars_notin (fv_sty_in_sty A \u fv_sty_in_sty (sty_var_f X)) Q ->
     asub A nil A1 c' ->
     asub  (open_sty_wrt_sty A2 (sty_var_f X) ) Q sty_nat c   ->
     asub (sty_all A1 A2)   (cons (qs_all X A) Q)   sty_nat (co_forall c)
 | A_allVar : forall (L:vars) (A1 A2 A:sty) (Q:seqs) (Y:typvar) (c c':co) (X : typvar),
     X `notin` fv_sty_in_sty A ->
     X `notin` fv_sty_in_sty A1 ->
     X `notin` fv_sty_in_sty A2 ->
     qvars_notin (fv_sty_in_sty A \u fv_sty_in_sty (sty_var_f X)) Q ->
     asub A nil A1 c' ->
     asub  (open_sty_wrt_sty A2 (sty_var_f X) )  Q (sty_var_f Y) c   ->
     asub (sty_all A1 A2)   (cons (qs_all X A) Q)   (sty_var_f Y) (co_forall c).

Hint Constructors asub.


(* infotheo (c) AIST. R. Affeldt, M. Hagiwara, J. Senizergues. GNU GPLv3. *)
From mathcomp Require Import ssreflect ssrbool ssrfun eqtype ssrnat seq path.
From mathcomp Require Import div choice fintype tuple finfun bigop prime ssralg.
From mathcomp Require Import finset fingroup perm finalg zmodp matrix mxalgebra.
From mathcomp Require Import mxrepresentation vector.
Require Import ssr_ext f2.

(** * Additional lemmas about algebraic datatypes *)

Set Implicit Arguments.
Unset Strict Implicit.
Import Prenex Implicits.

Notation "x '``_' i" := (x ord0 i) (at level 9) : vec_ext_scope.
Reserved Notation "v `[ i := x ]" (at level 20).
Reserved Notation "t # V" (at level 55, V at next level).

Import GRing.Theory.
Local Open Scope ring_scope.

Lemma sum_char2 (F : fieldType) (_ : 2 \in [char F]) k (f : 'I_k -> F) :
  (\sum_(i < k) (f i)) ^+ 2 = \sum_(i < k) (f i) ^+ 2.
Proof.
elim/big_ind2 : _ => [|x1 x2 y1 y2 <- <-|//] /=; first by rewrite expr0n.
by rewrite sqrrD mulr2n addrr_char2 // addr0.
Qed.

Section AboutRingType.

Variable R : ringType.

Lemma iter_addr0 : forall n x, iter n (+%R (0 : R)) x = x.
Proof. elim=> //= n IH x. by rewrite IH add0r. Qed.

Lemma iter_addr0_cV r : forall n (x : 'cV[R]_r), iter n (+%R 0) x = x.
Proof. elim=> //= n IH x; by rewrite IH add0r. Qed.

End AboutRingType.

Local Open Scope vec_ext_scope.

(** * (A^n x B^n) <-> (A x B)^n *)

(** Technical lemmas to switch between products of vectors (A^n x B^n) and
   vectors of products (A x B)^n: *)

Section prod_rV.

Variables A B : finType.

Definition prod_rV n (x : 'rV[A]_n * 'rV[B]_n) : 'rV[A * B]_n :=
  \row_(k < n) (x.1 ``_ k, x.2 ``_ k).

Definition rV_prod n (x : 'rV[A * B]_n) : {: 'rV[A]_n * 'rV[B]_n} :=
  (\row_(k < n) (x ``_ k).1, \row_(k < n) (x ``_ k).2).

Lemma prod_rVK n (x : 'rV[A]_n * 'rV[B]_n) : rV_prod (prod_rV x) = x.
Proof.
case: x => x1 x2.
congr (_ , _); apply/matrixP => a b; rewrite {a}(ord1 a); by rewrite !mxE /=.
Qed.

Lemma rV_prodK n (x : 'rV[A * B]_n) : prod_rV (rV_prod x) = x.
Proof.
apply/matrixP => a b; rewrite {a}(ord1 a); rewrite !mxE; by case: (x ``_ b).
Qed.

Lemma fst_tnth_prod_rV n (x : {: 'rV[A]_n * 'rV[B]_n}) i :
  x.1 ``_ i = ((prod_rV x) ``_ i).1.
Proof. by rewrite mxE. Qed.

Lemma snd_tnth_prod_rV n (x : {: 'rV[A]_n * 'rV[B]_n}) i :
  x.2 ``_ i = ((prod_rV x) ``_ i).2.
Proof. by rewrite mxE. Qed.

End prod_rV.

Section support_set.

Variables (R : ringType) (n : nat) (e : 'rV[R]_n).

Definition supp : {set 'I_n} := [set i | e ``_ i != 0].

Lemma insupp i : (i \in supp) = (e ``_ i != 0).
Proof. by rewrite in_set. Qed.

Lemma sum_supp x : \sum_(i < n) e ``_ i * x ^+ i = \sum_(i in supp) e ``_ i * x ^+ i.
Proof.
rewrite (bigID (mem supp)) /= addrC (eq_bigr (fun=> 0)); last first.
  move=> ?; rewrite inE /= negbK => /eqP ->; by rewrite mul0r.
by rewrite big_const /= iter_addr0 add0r.
Qed.

Lemma supp_set0 : (supp == set0) = (e == 0).
Proof.
apply/idP/idP => [/eqP/setP HE |/eqP ]; last first.
  rewrite /supp => ->; by apply/eqP/setP => i; rewrite !inE /= mxE eqxx.
apply/eqP/matrixP => i j; rewrite mxE (ord1 i).
move: (HE j); by rewrite !inE /= => /negbT; rewrite negbK => /eqP.
Qed.

End support_set.

Lemma supp0 n (R : ringType) : supp (0 : 'rV[R]_n) = set0.
Proof. apply/setP => i; by rewrite !inE mxE eqxx. Qed.

Definition row_set B n (n0 : 'I_n) (x : B) (d : 'rV_n) :=
  \row_(i < n) if i == n0 then x else d ``_ i.

Notation "v `[ i := x ]" := (row_set i x v) : vec_ext_scope.

Lemma inj_row_set (A : ringType) n n0 (d : 'rV_n) :
  {in A &, injective ((row_set n0)^~ d)}.
Proof. move=> a b _ _ /= /rowP /(_ n0); by rewrite mxE eqxx mxE eqxx. Qed.

Lemma row_set_comm n A (i1 i2 : 'I_n) (x1 x2 : A) d :
  i1 != i2 -> d `[ i2 := x2 ] `[ i1 := x1 ] = (d `[ i1 := x1 ]) `[ i2 := x2 ].
Proof.
move=> Hneq.
apply/rowP => i; rewrite !mxE.
case Hi1: (i == i1); case Hi2: (i == i2) => //=.
by rewrite -(eqP Hi1) (eqP Hi2) eqxx in Hneq.
Qed.

Section sub_vec_sect.

Variables (A : Type) (n : nat).

Definition sub_vec (t : 'rV[A]_n) (S : {set 'I_n}) : 'rV[A]_#| S | :=
  \row_(j < #|S|) (t ``_ (enum_val j)).
(* NB: enum_val j is the jth item of enum S *)

End sub_vec_sect.

Notation "t # V" := (sub_vec t V) : vec_ext_scope.

Section row_mx_ext.

Context {A : Type}.

Definition rbehead {n} (x : 'rV[A]_n.+1) := \row_(i < n) x ``_ (lift ord0 i).

Lemma rbehead_row_mx {n} (x : 'rV_n) (i : A) : rbehead (row_mx (\row_(j < 1) i) x) = x.
Proof.
apply/matrixP => a b; rewrite {a}(ord1 a) !mxE.
case: splitP; first by move=> j; rewrite {j}(ord1 j) lift0.
by move=> n0; rewrite lift0 add1n => -[] /val_inj ->.
Qed.

Lemma row_mx_row_ord0 {n} (x : 'rV_n) (i : A) : (row_mx (\row_(k < 1) i) x) ``_ ord0 = i.
Proof.
rewrite mxE; case: splitP => [|/=] k; first by rewrite {k}(ord1 k) mxE.
by rewrite add1n.
Qed.

Lemma row_mx_rbehead {n} (x : 'rV_(1 + n)) (i : A) (b : 'I_(1 + n)) :
  x ``_ ord0 = i -> (row_mx (\row__ i) (rbehead x)) ``_ b = x ``_ b.
Proof.
move=> xi.
rewrite mxE; case: splitP => [j|k bk].
  rewrite {j}(ord1 j) => Hb; rewrite mxE -xi; congr (_ ``_ _).
  exact/val_inj.
rewrite mxE; congr (_ ``_ _); exact/val_inj.
Qed.

End row_mx_ext.

Lemma col_matrix (R : ringType) m n (A : 'I_m -> 'cV[R]_(n.+1)) (i : 'I_m) :
  col i (\matrix_(a < n.+1, b < m) (A b) a ord0) = A i.
Proof. apply/matrixP => a b; by rewrite !mxE (ord1 b). Qed.

Section AboutPermPid.

Variable R : comRingType.

(* s : 0 -> s0; 1 -> s1, etc.
in column 0, there is a 1 at line s0

         | 0 1 |
[a b ] * | 1 0 |  = [b a]
*)
Lemma vec_perm_mx : forall n (s : 'S_n) (z : 'rV[R]_n),
  z *m perm_mx s = \matrix_(i < 1, j < n) z i ((s^-1)%g j).
Proof.
move=> n s z; apply/matrixP => i j.
rewrite (ord1 i) {i} !mxE (bigID (pred1 ((s^-1)%g j))) /=.
rewrite big_pred1_eq !mxE {2}permE perm_invK eqxx mulr1 (eq_bigr (fun _ => 0)).
- by rewrite big_const_seq iter_addr0 addr0.
- move=> i H.
  rewrite !mxE (_ : (s i == j) = false); first by rewrite mulr0.
  apply/eqP; move/eqP : H => H; contradict H.
  by rewrite -H -permM (mulgV s) perm1.
Qed.

Lemma perm_mx_vec : forall n (s : 'S_n) (z : 'cV[R]_n),
  perm_mx s *m z = \matrix_(i < n, j < 1) z (s i) j.
Proof.
move=> n s z; apply/matrixP => i j.
rewrite (ord1 j) {j} !mxE (bigID (pred1 (s i))) /=.
rewrite big_pred1_eq {1}/perm_mx !mxE eqxx mul1r (eq_bigr (fun _ => 0)).
- by rewrite big_const_seq iter_addr0 addr0.
- move=> j; move/negbTE => H.
  by rewrite !mxE eq_sym H /= mul0r.
Qed.

Lemma pid_mx_inj : forall r n (a b : 'rV[R]_r), r <= n ->
  a *m (@pid_mx _ r n r) = b *m (@pid_mx _ r n r) -> a = b.
Proof.
move=> r n a b Hrn /matrixP Heq.
apply/matrixP => x y.
move: {Heq}(Heq x (widen_ord Hrn y)).
rewrite !mxE (ord1 x){x} (bigID (pred1 y)) /= big_pred1_eq (eq_bigr (fun _ => 0)); last first.
  move=> i Hiy.
  rewrite mxE /= (_ : nat_of_ord _ == nat_of_ord _ = false) /=; last first.
    by move/negbTE : Hiy.
  by rewrite mulr0.
rewrite big_const_seq iter_addr0 (bigID (pred1 y)) /= big_pred1_eq (eq_bigr (fun _ => 0)); last first.
  move=> i Hiy.
  rewrite mxE /= (_ : nat_of_ord i == nat_of_ord y = false) /=; last first.
    by move/negbTE : Hiy.
  by rewrite mulr0.
by rewrite big_const_seq iter_addr0 !addr0 !mxE /= eqxx /= (ltn_ord y) /= 2!mulr1.
Qed.

End AboutPermPid.

(* NB: similar to mulmx_sum_row in matrix.v *)
Lemma mulmx_sum_col : forall {R : comRingType} m n (u : 'cV[R]_n) (A : 'M_(m, n)),
  A *m u = \sum_i u i 0 *: col i A.
Proof.
move=> R m n u A; apply/colP=> j; rewrite mxE summxE; apply: eq_bigr => i _.
by rewrite !mxE mulrC.
Qed.

Section AboutRowTuple.

Variables A B : predArgType.

Definition tuple_of_row n (v : 'rV[A]_n) := [tuple v ``_ i | i < n].

Local Open Scope tuple_ext_scope.

Definition row_of_tuple n (t : n.-tuple A) := \row_(i < n) (t \_ i).

Lemma row_of_tupleK n (t : n.-tuple A) : tuple_of_row (row_of_tuple t) = t.
Proof. apply eq_from_tnth => n0; by rewrite tnth_mktuple mxE. Qed.

Lemma tuple_of_row_inj n : injective (@tuple_of_row n).
Proof.
move=> i j ij.
apply/rowP => m0.
move/(congr1 (fun x => x \_ m0)) : ij.
by rewrite 2!tnth_mktuple.
Qed.

Local Close Scope tuple_ext_scope.

Lemma tuple_of_rowK n (v : 'rV[A]_n) : row_of_tuple (tuple_of_row v) = v.
Proof. apply tuple_of_row_inj; by rewrite row_of_tupleK. Qed.

Definition row_of_seq
  (f : B -> A) (b : B) (l : seq B) n (H : size l == n) : 'rV[A]_n.
Proof.
exact (matrix_of_fun matrix_key (fun i j => f (nth b l j))).
Defined.

Lemma row_of_seqK n l H f b :
  map f l = tuple_of_row (@row_of_seq f b l n H).
Proof.
apply/(@eq_from_nth _ (f b)) => [|i Hi].
  by rewrite size_map size_tuple (eqP H).
rewrite size_map in Hi.
rewrite (nth_map b) //.
rewrite (eqP H) in Hi.
transitivity (tnth (tuple_of_row (row_of_seq f b H)) (Ordinal Hi)).
  by rewrite tnth_mktuple mxE.
apply set_nth_default; by rewrite size_tuple.
Qed.

Definition col_of_seq
  (f : B -> A) (b : B) (l : seq B) n (H : size l == n) : 'cV[A]_n.
Proof.
exact (matrix_of_fun matrix_key (fun i j => f (nth b l i))).
Defined.

End AboutRowTuple.

Arguments row_of_seq {A} {B} _ _ l n.
Arguments col_of_seq {A} {B} _ _ l n.

Lemma tuple_of_row_ord0 (F : Type) (y : 'rV[F]_0) : tuple_of_row y = [tuple of [::]].
Proof. apply eq_from_tnth; by case. Qed.

Local Open Scope tuple_ext_scope.

Lemma tuple_of_row_row_mx {C : finType} n1 n2 (v1 : 'rV[C]_n1) (B : 'rV[C]_n2) :
  tuple_of_row (row_mx v1 B) = [tuple of tuple_of_row v1 ++ tuple_of_row B].
Proof.
apply eq_from_tnth => n0.
rewrite tnth_mktuple mxE.
case: splitP => [n3 n0n3|n3 n0n1n3].
  rewrite /tnth nth_cat size_tuple (_ : (n0 < n1 = true)%nat); last by rewrite n0n3 ltn_ord.
  transitivity ((tuple_of_row v1) \_ n3); first by rewrite tnth_mktuple.
  rewrite /tnth n0n3; apply set_nth_default; by rewrite size_tuple.
rewrite /tnth nth_cat size_tuple (_ : (n0 < n1 = false)%nat); last first.
  rewrite n0n1n3; apply/negbTE; by rewrite -leqNgt leq_addr.
  transitivity ((tuple_of_row B) \_ n3); first by rewrite tnth_mktuple.
  rewrite /tnth (_ : (n0 - n1 = n3)%nat); last by rewrite n0n1n3 addnC addnK.
  apply set_nth_default; by rewrite size_tuple.
Qed.

Local Close Scope tuple_ext_scope.

Lemma row_to_seq_0 n : tuple_of_row 0 = [tuple of nseq n ( 0 : 'F_2)].
Proof.
apply eq_from_tnth => i.
by rewrite {2}/tnth nth_nseq (ltn_ord i) tnth_mktuple mxE.
Qed.

Definition rowF2_tuplebool {n : nat} (M : 'rV['F_2]_n) : n.-tuple bool :=
  [tuple of map (fun x => x != 0) (tuple_of_row M)].
Definition row_of_bitseq := row_of_seq F2_of_bool false.
Definition col_of_bitseq := col_of_seq F2_of_bool false.

Lemma trmx_cV_0 {k} (x : 'cV['F_2]_k) : (x ^T == 0) = (x == 0).
Proof.
case Hlhs : (_ ^T == _).
  symmetry.
  move/eqP in Hlhs.
  by rewrite -(trmxK x) Hlhs trmx0 eqxx.
symmetry; apply/eqP.
move=> abs; subst x.
by rewrite trmx0 eqxx in Hlhs.
Qed.

Section AboutRank.

Variable F : fieldType.

Lemma rank_I n : \rank (1%:M : 'M[F]_n) = n.
Proof.
apply/eqP. apply/row_freeP.
exists (1%:M : 'M[F]_n); by rewrite mulmx1.
Qed.

Lemma rank_row_mx n (A : 'M[F]_n) m (B : 'M[F]_(n, m)) :
  \rank A = n -> \rank (row_mx A B) = n.
Proof.
move=> HA.
apply/eqP. apply/row_freeP.
exists (col_mx ((invmx (row_ebase A)) *m (invmx (col_ebase A))) 0).
rewrite mul_row_col mulmx0 addr0 -{1}(mulmx_ebase A) HA pid_mx_1 mulmx1 -!mulmxA.
have -> : row_ebase A *m (invmx (row_ebase A) *m invmx (col_ebase A)) =
  invmx (col_ebase A).
  rewrite !mulmxA mulmxV.
  by rewrite mul1mx.
  by apply: row_ebase_unit.
rewrite mulmxV //.
by apply: col_ebase_unit.
Qed.

Lemma empty_rV {A : ringType} (a : 'rV[A]_O) : a = 0.
Proof. apply/matrixP => x []; by rewrite (ord1 x). Qed.

Lemma full_rank_inj m n (A : 'M[F]_(m, n)) : m <= n -> \rank A = m ->
  forall (a b : 'rV[F]_m),  a *m A = b *m A -> a = b.
Proof.
move=> Hmn Hrank a b Hab.
move: Hrank.
rewrite /mxrank.
destruct m => //= [_|].
  by rewrite (empty_rV a) (empty_rV b).
destruct n => //=.
unlock.
move Herk : (Gaussian_elimination A) => LUr /= Htmp.
move: (mulmx_ebase A) => Heq.
rewrite -Heq !mulmxA in Hab.
have {Hab}Hab :
  a *m col_ebase A *m pid_mx (\rank A) *m row_ebase A *m (invmx (row_ebase A)) =
  b *m col_ebase A *m pid_mx (\rank A) *m row_ebase A *m (invmx (row_ebase A)).
  by rewrite Hab.
rewrite -!mulmxA mulmxV in Hab; last by exact: row_ebase_unit.
rewrite mulmx1 !mulmxA /mxrank /= in Hab.
unlock in Hab.
rewrite !Htmp in Hab.
move: {Heq}(@pid_mx_inj _ _ _ (a *m col_ebase A) (b *m col_ebase A) Hmn Hab) => Heq.
have {Hab}Hab : a *m col_ebase A *m (invmx (col_ebase A)) =
  b *m col_ebase A *m (invmx (col_ebase A)) by rewrite Heq.
rewrite -!mulmxA mulmxV in Hab; last by apply: col_ebase_unit.
by rewrite !mulmx1 in Hab.
Qed.

Lemma mxrank_castmx a a' b b' (M : 'M[F]_(a, b)) (H1 : a = a') (H2 : b = b') :
  \rank (castmx (H1, H2) M) = \rank M.
Proof. by subst a' b'. Qed.

End AboutRank.

Section non_trivial_vspace.

Variables (F : finFieldType) (n : nat) (C : {vspace 'rV[F]_n}).

Definition not_trivial := exists cw, (cw \in C) && (cw != 0).

Lemma not_trivialP : not_trivial <-> C != 0%VS.
Proof.
split; rewrite /not_trivial.
- case => x /andP[xC].
  apply: contra => /eqP C0; move: xC; by rewrite C0 memv0.
- rewrite -vpick0 => C0.
  exists (vpick C); by rewrite C0 andbT memv_pick.
Qed.

End non_trivial_vspace.

Section about_row_vectors_on_prime_fields.

Lemma card_rV_wo_zeros p n : prime p ->
  (\sum_(x : 'rV['F_p]_n | [forall j, x ord0 j != 0%R]) 1)%N = p.-1 ^ n.
Proof.
move=> primep.
destruct p as [|p'] => //; destruct p' as [|p'] => //.
set p := p'.+2.
transitivity (\sum_(x : {: n.-tuple 'I_p.-1}) 1)%N; last first.
  by rewrite sum1_card card_tuple card_ord.
pose g : 'F_p -> 'I_p.-1 := fun x =>
  inord (cast_ord (@card_Fp _ primep) (enum_rank x : 'I_#|'F_p|)).-1.
pose g' : 'I_p.-1 -> 'F_p := fun x =>
  enum_val (cast_ord (esym (@card_Fp _ primep)) (inord x.+1)).
have Hg' : forall j, g' j != 0.
  move=> j; apply/eqP => /(congr1 enum_rank).
  rewrite enum_valK => /(congr1 val) /=.
  by rewrite enum_rank_ord /= inordK // ltnS.
have gg' : {in [set x in 'F_p | x != 0], cancel g g'}.
  move=> x; rewrite inE => /andP[Hx x_neq0].
  rewrite /g' inordK //=; last first.
    rewrite enum_rank_ord //= prednK ?lt0n //.
    move: (ltn_ord x) => /=; rewrite ltnS => /leq_trans; apply.
    by rewrite -(ltn_add2r 1) 2!addn1 Zp_cast // ?pdiv_leq // pdiv_id.
  rewrite (enum_rank_ord x) //= prednK ?lt0n //= enum_val_ord /=.
  apply val_inj => /=; rewrite inordK //.
  move: (ltn_ord x) => /leq_trans; apply; by rewrite Zp_cast ?pdiv_id.
have g'g : cancel g' g.
  move=> x; rewrite /g /g' /= enum_valK; apply val_inj => /=.
  by rewrite (@inordK _ x.+1) /= ?inordK // ltnS.
set f : 'rV['F_p]_n -> n.-tuple 'I_p.-1 := fun x => tuple_of_row (map_mx g x).
set f' : n.-tuple 'I_p.-1 -> 'rV['F_p]_n := fun x => map_mx g' (row_of_tuple x).
rewrite (reindex_onto f' f); last first.
  rewrite /= => x /forallP /= H; apply/rowP => j.
  by rewrite /f' /f mxE tuple_of_rowK mxE gg' // !inE /= H.
apply eq_bigl => x; apply/andP; split.
  by apply/forallP => j; rewrite !mxE Hg'.
apply/eqP/eq_from_tnth => i; by rewrite tnth_mktuple !mxE g'g.
Qed.

End about_row_vectors_on_prime_fields.

From mathcomp Require Import finfield.

Section GFqm.

Variables (q m' : nat).
Let m := m'.+1.
Hypothesis primeq : prime q.

Definition GF : finFieldType := sval (@PrimePowerField q m primeq isT).

Lemma char_GFqm : q \in [char GF].
Proof. exact (proj1 (proj2_sig (@PrimePowerField q m primeq isT))). Qed.

Lemma card_GFqm : #| GF | = q ^ m.
Proof. rewrite /GF; by case: (@PrimePowerField q m primeq isT). Qed.

End GFqm.

Section GF2m.

Variable m : nat.

Definition GF2 : finFieldType := @GF 2 m.-1 isT.

Definition GF2_of_F2 : 'F_2 -> GF2 := [eta \0 with 0 |-> 0, 1 |-> 1].

Definition additive_GF2_of_F2 : additive GF2_of_F2.
Proof.
move=> x y; apply/esym; rewrite /GF2_of_F2 /=; case: ifPn=> [/eqP ->|].
- rewrite !add0r; case: ifPn => [/eqP -> /=|]; first by rewrite oppr0.
  case: ifPn => [/eqP -> _ /=|].
  + by rewrite oppr_char2 // char_GFqm.
  + by rewrite -F2_eq0 => /eqP ->.
- rewrite -F2_eq1 => /eqP -> /=.
  case: ifPn => [/eqP -> /=|]; first by rewrite subr0.
  rewrite -F2_eq1 => /eqP -> /=; by rewrite subrr.
Qed.

Definition multiplicative_GF2_of_F2 : multiplicative GF2_of_F2.
Proof.
split => // x y; rewrite /GF2_of_F2 /=; apply/esym.
case: ifPn => [/eqP -> /=|]; first by rewrite mul0r.
rewrite -F2_eq1 => /eqP -> /=; by rewrite !mul1r.
Qed.

Definition rmorphism_GF2_of_F2 : rmorphism GF2_of_F2.
Proof. split; [exact: additive_GF2_of_F2|exact: multiplicative_GF2_of_F2]. Qed.

Lemma GF2_of_F2_eq0 x : (GF2_of_F2 x == 0) = (x == 0).
Proof.
apply/idP/idP => [|/eqP -> //].
rewrite /GF2_of_F2 /=; case: ifPn => //; rewrite -F2_eq1 => ->.
by rewrite oner_eq0.
Qed.

End GF2m.

Arguments GF2_of_F2 [_] _.

Canonical GF2_of_F2_additive m := Additive (additive_GF2_of_F2 m).
Canonical GF2_of_F2_rmorphism m := RMorphism (rmorphism_GF2_of_F2 m).

Definition F2_to_GF2 (m : nat) n (y : 'rV['F_2]_n) := map_mx (@GF2_of_F2 m) y.

Lemma supp_F2_to_GF2 n m (e : 'rV['F_2]_n) : supp (F2_to_GF2 m e) = supp e.
Proof.
apply/setP => i; rewrite !inE !mxE; apply/idP/idP; apply: contra.
  move/eqP => ->; by rewrite rmorph0.
by rewrite GF2_of_F2_eq0.
Qed.


(*** Jonas Kaiser, February 2012 ***)
(*** This file unfolds the TG Axiomatisation in TG0.v
     to Top-Level
 ***)

Set Implicit Arguments.

Require Export TG0.

Declare Module M : TG.
Export M.

(*** Improve Automation for set-theoretic reasoning in TG ***)

Create HintDb TG_set.

(* Creat useful hints for stuff in TG0 *)

Hint Extern 0 =>
  match goal with
  | [ H : In ?A Empty |- _ ] => now destruct (EmptyE H)
  end : TG_set.

Hint Extern 0 =>
  match goal with
  | [ H : ?A = Empty |- _ ] => rewrite H in *
  | [ H : Empty = ?A |- _ ] => rewrite <- H in *
  end : TG_set.

Hint Resolve UPairI1 UPairI2 UnionI ReplI PowerI GUIn GUUPair GUPower GUUnion GURepl : TG_set.

(*** Extensions of the set theory required for Specs.v ***)

(* Singleton sets *)
Definition Sing : set -> set := fun X:set => UPair X X.

Lemma SingI : forall X, X :e (Sing X).
Proof. intros X. exact (UPairI1 X X). Qed.

Lemma SingE : forall X Y, Y :e (Sing X) -> Y = X.
Proof. intros X Y A. destruct (UPairE A) as [B|B]; assumption. Qed.

Lemma GUSing : forall N X, X :e GU N -> Sing X :e GU N.
Proof. intros N X MX. unfold Sing. now auto with TG_set. Qed.

Hint Immediate SingI SingE : TG_set.
Hint Resolve GUSing : TG_set.

(* The set 1 *)
Definition One : set := Sing Empty.

Lemma OneI1 : Empty :e One.
Proof. now apply SingI. Qed.

Lemma OneI2 : forall A, A = Empty -> A :e One.
Proof. intros. subst. exact OneI1. Qed.

Lemma OneE: forall A, A :e One -> A = Empty.
Proof. now apply SingE. Qed.

Hint Immediate OneI1 : TG_set.
Hint Extern 0 =>
  match goal with
  | [ H : ?A = One |- _ ] => rewrite H in *
  | [ H : One = ?A |- _ ] => rewrite <- H in *
  end : TG_set.

(* The set 2 *)
Definition Two : set := UPair Empty One.

Lemma TwoI1 : Empty :e Two.
Proof. now apply UPairI1. Qed.

Lemma TwoI2 : One :e Two.
Proof. now apply UPairI2. Qed.

Lemma TwoI3 : forall A, A = Empty \/ A = One -> A :e Two.
Proof. intros A [E|E]; subst; [now apply TwoI1 | now apply TwoI2]. Qed.

Lemma TwoE : forall A, A :e Two -> A = Empty \/ A = One.
Proof. intros. apply UPairE. exact H. Qed.

Hint Immediate TwoI1 TwoI2 : TG_set.
Hint Resolve TwoI3 : TG_set.
Hint Extern 0 =>
  match goal with
  | [ H : ?A = Two |- _ ] => rewrite H in *
  | [ H : Two = ?A |- _ ] => rewrite <- H in *
  end : TG_set.

(* Notion of a transitive set *)
Definition transitive_set : set -> Prop := fun S: set =>
  forall X x: set, X :e S -> x :e X -> x :e S.

(* When is a set a proper Grothendieck Universe *)
Definition grothendieck_universe : set -> Prop := fun U: set =>
     transitive_set U
  /\ (forall X Y: set, X :e U -> Y :e U -> (UPair X Y) :e U)
  /\ (forall X: set, X :e U -> (Power X) :e U)
  /\ (forall X: set, X :e U -> (Union X) :e U)
  /\ (forall X: set, forall F: set -> set, X :e U ->
      (forall x: set, x :e X -> F x :e U) -> (Repl F X) :e U).