(**
This file is part of the Elfic library

Copyright (C) Boldo, Clément, Leclerc

This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.

This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
COPYING file for more details.
*)

From Coq Require Import
    Utf8
    ssreflect

    Rdefinitions
    RIneq
    Rbasic_fun
    Lia
    Lra
.

From Coquelicot Require Import
    Hierarchy
    Rbar
.

Require Import
    hierarchy_notations
    simpl_fun
    sigma_algebra
    measurable_fun
    series
    R_compl
.

Open Scope nat_scope.
Open Scope R_scope.

(*
Dans cette première section, je reprend exactement le code de Coquelicot où
je retire les existentiels pour obtenir des preuves constructives.
*)

Section filterlim_complete_constr.

    Context {T : Type}.
    Context {U : CompleteSpace}.

    Lemma filterlim_locally_closely_correct :
        forall {F} {FF : ProperFilter F} (f : T -> U),
            filterlim (fun x => (f (fst x), f (snd x))) (filter_prod F F) closely ->
            filterlim f F (locally (lim (filtermap f F))).
    Proof.
        intros F FF f H.
        intros P [eps HP].
        refine (_ (complete_cauchy (filtermap f F) _ _ eps)).
        + now apply filter_imp.
        + apply cauchy_distance'.
        apply filter_le_trans with (2 := H).
        apply prod_filtermap_le.
    Qed.

    Lemma filterlim_locally_cauchy_correct :
        forall {F} {FF : ProperFilter F} (f : T -> U),
            (forall eps : posreal, exists P, F P /\ forall u v : T, P u -> P v -> ball (f u) eps (f v)) ->
            filterlim f F (locally (lim (filtermap f F))).
    Proof.
        intros F FF f H.
        apply (filterlim_locally_closely_correct f).
        apply filterlim_closely => //.
    Qed.

End filterlim_complete_constr.

Definition Cauchy_seq {S : UniformSpace} (u : nat -> S) : Prop :=
    ∀ ɛ : R, ɛ > 0 -> ∃ n : nat, ∀ p q : nat,
        p ≥ n -> q ≥ n -> ball (u p) ɛ (u q).

Section Cauchy_lim_seq_def.

    Context {S : CompleteSpace}.

    Definition lim_seq (u : nat -> S) :=
        lim (filtermap u eventually).

    Lemma lim_seq_ext :
        ∀ u u' : nat -> S,
            (∀ n : nat, u n = u' n) -> ∀ l : S,
            filterlim u eventually (locally l) -> filterlim u' eventually (locally l).
    Proof.
        move => u u' Huu' l Hl.
        apply filterlim_ext with u => //.
    Qed.

    Lemma filterlim_cauchy_seq_correct :
        ∀ u : nat → S,
            (∀ eps : posreal, ∃ P, eventually P ∧ ∀ p q : nat, P p → P q → ball (u p) eps (u q))
            -> filterlim u eventually (locally (lim_seq u)).
    Proof.
        move => u Hu.
        apply filterlim_locally_cauchy_correct => //.
    Qed.

    Lemma Cauchy_seq_eventually {u : nat -> S} :
        Cauchy_seq u -> (∀ eps : posreal, ∃ P, eventually P ∧ ∀ p q : nat, P p → P q → ball (u p) eps (u q)).
    Proof.
        unfold Cauchy_seq => Hu ɛ.
        case: ɛ => ɛ Pɛ.
        pose Pɛ' := Rlt_gt _ _ Pɛ; clearbody Pɛ'.
        case: (Hu ɛ Pɛ') => N HuN.
        exists (fun n => n ≥ N); split => //.
        exists N => //.
    Qed.

    Lemma is_filterlim_Cauchy_lim_seq :
        ∀ (u : nat -> S), Cauchy_seq u ->
            filterlim u eventually (locally (lim_seq u)).
    Proof.
        move => u /Cauchy_seq_eventually π.
        apply (filterlim_cauchy_seq_correct u π).
    Qed.

End Cauchy_lim_seq_def.

Section lim_seq_prop.

    Context {S : UniformSpace}.
    Context {T : UniformSpace}.

    Lemma lim_seq_cte :
        ∀ s : S,
        filterlim (fun _ : nat => s) eventually (locally s).
    Proof.
        move => s.
        apply filterlim_const.
    Qed.

    Lemma lim_seq_continuity :
        ∀ f : S -> T, ∀ s : S,
        filterlim f (locally s) (locally (f s))
            -> ∀ u : nat -> S,
            filterlim u eventually (locally s) -> filterlim (fun n => f (u n)) eventually (locally (f s)).
    Proof.
        move => f s Hf u Hu.
        apply filterlim_comp with (locally s) => //.
    Qed.

    Lemma lim_seq_pair :
        ∀ u : nat -> S, ∀ v : nat -> T, ∀ lu : S, ∀ lv : T,
            filterlim u eventually (locally lu) ->
            filterlim v eventually (locally lv) ->
            filterlim (fun n => (u n, v n)) eventually (filter_prod (locally lu) (locally lv)).
    Proof.
        move => u v lu lv Hu Hv.
        apply filterlim_pair => //.
    Qed.

End lim_seq_prop.

Definition NM_Cauchy_seq {A : AbsRing} {E : NormedModule A} (u : nat -> E) : Prop :=
    ∀ ɛ : R, ɛ > 0 -> ∃ n : nat, ∀ p q : nat,
        p ≥ n -> q ≥ n -> ball_norm (u p) ɛ (u q).

Section NM_Cauchy_lim_seq_def.

    Context {A : AbsRing}.
    Context {E : CompleteNormedModule A}.

    Lemma NM_Cauchy_seq_Cauchy_seq :
        ∀ u : nat -> E, NM_Cauchy_seq u -> Cauchy_seq u.
    Proof.
        move => u.
        unfold NM_Cauchy_seq, Cauchy_seq.
        move => Hnorm ɛ Hɛ.
        case: (Hnorm ɛ Hɛ).
        move => N Hn.
        exists N => p q Hp Hq.
        pose HnormNpq := Hn p q Hp Hq; clearbody HnormNpq.
        apply: norm_compat1 => //.
    Qed.

    Lemma NM_Cauchy_seq_lim_seq_correct :
        ∀ (u : nat -> E), ∀ (π : NM_Cauchy_seq u),
            is_lim_seq u (lim_seq u).
    Proof.
        move => u /NM_Cauchy_seq_Cauchy_seq π.
        apply: is_filterlim_Cauchy_lim_seq => //.
    Qed.

    Lemma NM_is_lim_seq_unique :
        ∀ u : nat -> E, ∀ l l' : E,
            is_lim_seq u l -> is_lim_seq u l' -> l = l'.
    Proof.
        move => u l l' Hl Hl';
            unfold is_lim_seq in Hl;
            unfold is_lim_seq in Hl'.
        pose H := filterlim_locally_unique u l l'.
        pose H' := H eventually (Proper_StrongProper _ eventually_filter);
            clearbody H'.
        apply H' => //.
    Qed.

    Lemma lim_seq_eq :
        ∀ u : nat -> E, ∀ l : E,
            is_lim_seq u l -> lim_seq u = l.
    Proof.
        move => u l Hl.
        assert (is_lim_seq u (lim_seq u)).
            apply NM_Cauchy_seq_lim_seq_correct.
            unfold NM_Cauchy_seq => ɛ Hɛ.
            move: Hl => /filterlim_locally_ball_norm => Hl.
            pose sighalfɛ := RIneq.mkposreal (ɛ * /2) (R_compl.Rmult_lt_pos_pos_pos _ _ (RIneq.Rgt_lt _ _ Hɛ) RIneq.pos_half_prf).
            case: (Hl sighalfɛ) => N /= HN; clear Hl.
            exists N => p q Hp Hq; replace ɛ with (ɛ*/2 + ɛ*/2)
                by rewrite Rlimit.eps2 => //.
            apply ball_norm_triangle with l.
            apply (ball_norm_sym l (u p) sighalfɛ) => /=.
            1, 2 : apply HN => //.
        apply (NM_is_lim_seq_unique u) => //.
    Qed.

End NM_Cauchy_lim_seq_def.

Section NM_lim_seq_prop.

    Open Scope hy_scope.
    Open Scope fun_scope.

    Lemma is_lim_seq_epsilon {A : AbsRing} {E : NormedModule A} :
        ∀ u : nat -> E, ∀ l : E,
            is_lim_seq u l <->
            (∀ ɛ : R, 0 < ɛ -> ∃ N : nat, ∀ n : nat, N ≤ n -> (‖ minus (u n) l ‖%hy < ɛ)%R).
    Proof.
        move => u l; split.
        unfold is_lim_seq, filterlim, eventually.
        move => H.
        assert (filter_le
        (filtermap u (λ P : nat → Prop, ∃ N : nat, ∀ n : nat, N ≤ n → P n))
        (locally_norm l)).
        apply filter_le_trans with (locally l) => //.
        apply locally_le_locally_norm.
        clear H => ɛ Hɛ.
        unfold filter_le, filtermap, locally_norm in H0.
        assert (∃ η : posreal, ∀ y : E, ball_norm l η y -> ball_norm l ɛ y).
        exists (RIneq.mkposreal ɛ Hɛ) => //.
        case: (H0 _ H) => N HN.
        exists N; unfold ball_norm in HN.
        assumption.
        move => Hloc.
        unfold is_lim_seq, filterlim, eventually.
        suff: (filter_le (filtermap u (λ P : nat → Prop, ∃ N : nat, ∀ n : nat, N ≤ n → P n))
        (locally_norm l)).
        move => H.
        apply filter_le_trans with (locally_norm l) => //.
        apply locally_norm_le_locally.
        unfold locally_norm, filter_le, filtermap.
        move => P; case; case => ɛ Hɛ Hloc'.
        case: (Hloc ɛ Hɛ) => N HN.
        exists N => n; move => /HN/Hloc'//.
    Qed.

    Context {A : AbsRing}.
    Context {E : NormedModule A}.

    Lemma lim_seq_plus :
        ∀ u v : nat -> E, ∀ lu lv : E,
            is_lim_seq u lu -> is_lim_seq v lv ->
                is_lim_seq (u + v) (lu + lv)%hy.
    Proof.
        move => u v lu lv Hu Hv.
        apply
            (filterlim_comp
                nat (E * E) E
                (fun n : nat => (u n, v n)) (fun c : E * E => fst c + snd c)%hy
                eventually (filter_prod (locally lu) (locally lv)) (locally (lu + lv)%hy)
            ).
        apply lim_seq_pair => //.
        apply filterlim_plus.
    Qed.

    Lemma lim_seq_scal :
        ∀ a : nat -> A, ∀ u : nat -> E, ∀ la : A, ∀ lu : E,
            is_lim_seq a la -> is_lim_seq u lu ->
                is_lim_seq (fun n : nat => (a n) ⋅ (u n))%hy (la ⋅ lu)%hy.
    Proof.
        move => a u la lu Ha Hu.
        apply
            (filterlim_comp
                nat (A * E) E
                (fun n : nat => (a n, u n)) (fun c : A * E => (fst c) ⋅ (snd c))%hy
                eventually (filter_prod (locally la) (locally lu)) (locally (la ⋅ lu)%hy)
            ).
        apply lim_seq_pair => //.
        apply filterlim_scal.
    Qed.

    Lemma lim_seq_scal_r :
        ∀ a : A, ∀ u : nat -> E, ∀ lu : E,
            is_lim_seq u lu ->
                is_lim_seq (a ⋅ u) (a ⋅ lu)%hy.
    Proof.
        move => a u lu Hu.
        apply (lim_seq_continuity (fun x : E => a ⋅ x)%hy) => //.
        apply filterlim_scal_r.
    Qed.

    Lemma lim_seq_scal_l :
        ∀ a : nat -> A, ∀ u : E, ∀ la : A,
            is_lim_seq a la ->
                is_lim_seq (fun n => a n ⋅ u)%hy (la ⋅ u)%hy.
    Proof.
        move => a u la Ha.
        apply (lim_seq_continuity (fun b : A => b ⋅ u)%hy) => //.
        apply filterlim_scal_l.
    Qed.

    Lemma lim_seq_opp :
        ∀ u : nat -> E, ∀ lu : E,
            is_lim_seq u lu ->
                is_lim_seq (fun n : nat => opp (u n)) (opp lu).
    Proof.
        move => u lu Hu.
        apply (lim_seq_continuity (fun x : E => opp x)) => //.
        apply filterlim_opp.
    Qed.

    Lemma lim_seq_mult :
        ∀ a b : nat -> A, ∀ la lb : A,
        is_lim_seq a la -> is_lim_seq b lb ->
            is_lim_seq (fun n => (a n) * (b n)) (la * lb)%hy.
    Proof.
        move => a b la lb Ha Hb.
        apply
            (filterlim_comp
                nat (A * A) A
                (fun n : nat => (a n, b n)) (fun c : A * A => fst c * snd c)%hy
                eventually (filter_prod (locally la) (locally lb)) (locally (la * lb)%hy)
            ).
        apply lim_seq_pair => //.
        apply filterlim_mult.
    Qed.

    Lemma lim_seq_norm :
        ∀ u : nat -> E, ∀ lu : E,
        is_lim_seq u lu -> is_lim_seq (‖ u ‖)%fn (‖ lu ‖)%hy.
    Proof.
        move => u lu Hu.
        apply (lim_seq_continuity (fun x : E => norm x)) => //.
        apply filterlim_norm.
    Qed.

    Lemma lim_seq_norm_zero :
        ∀ u : nat -> E,
        is_lim_seq (‖u‖)%fn 0 -> is_lim_seq u zero.
    Proof.
        move => u Hu.
        apply filterlim_norm_zero => //.
    Qed.

    Lemma lim_seq_power :
        ∀ p : posreal, ∀ u : nat -> R, (∀ n : nat, 0 <= u n) -> ∀ l : R,
        is_lim_seq u l -> is_lim_seq (u ^ p) (Rpow l p).
    Proof.
        move => p u u_pos l Hu.
        unfold fun_power, Rpow.
        assert (0 <= l) as l_pos.
            assert (Lim_seq.is_lim_seq u (Rbar.Finite l)) as Hu' by easy.
            suff: Rbar.Rbar_le (Rbar.Finite 0) (Rbar.Finite l).
            simpl => //.
            apply Lim_seq.is_lim_seq_le with (fun _ => 0) u.
            assumption.
            apply lim_seq_cte.
            assumption.
        case: (Req_EM_T l 0); swap 1 2.
        move => H.
        suff: (Lim_seq.is_lim_seq (λ x : nat,
        match Req_EM_T (u x) 0 with | left _ => 0 | right _ => Rtrigo_def.exp (p * Rpower.ln (u x)) end)
        (Rbar.Finite (Rtrigo_def.exp (p * Rpower.ln l)))).
        easy.
        apply Lim_seq.is_lim_seq_ext_loc with (fun n => Rtrigo_def.exp (p * Rpower.ln (u n))).
        assert (0 < l) as l_stpos by lra.
        pose sigl := {| RIneq.pos := l; RIneq.cond_pos := l_stpos |}.
        move: Hu => /is_lim_seq_epsilon Hu.
        case: (Hu sigl) => //.
        move => N HN; exists N => n /HN.
        unfold norm => /=; unfold abs => /=.
        unfold minus, plus, opp => /=/Rcomplements.Rabs_lt_between'.
        move => [Hul _]; rewrite Rminus_eq_0 in Hul.
        case: (Req_EM_T (u n) 0); lra.
        apply: filterlim_comp.
        2 : apply: ElemFct.continuous_exp.
        suff: (Lim_seq.is_lim_seq (λ x : nat, (p * Rpower.ln (u x))%R) (Rbar_mult p (Rpower.ln l))%R).
        easy.
        apply Lim_seq.is_lim_seq_scal_l.
        apply: filterlim_comp.
        exact Hu.
        apply ElemFct.continuous_ln.
        lra.

        move => Eql0; rewrite Eql0 in Hu.
        apply is_lim_seq_epsilon => ɛ Hɛ.
        move: ElemFct.is_lim_exp_m.
        unfold Continuity.is_lim, filterlim, filter_le, filtermap,
            Rbar_locally, Rbar_locally', locally => Hexp.
        move: ElemFct.is_lim_ln_0.
        unfold Continuity.is_lim, filterlim, filter_le, filtermap,
            Rbar_locally, Rbar_locally', at_right, within, locally => Hln.
            assert ((∃ eps : posreal, ∀ y : R_UniformSpace, ball 0 eps y → ball 0 ɛ y)) as Hballɛ.
            exists (RIneq.mkposreal ɛ Hɛ); easy.
            case: (Hexp _ Hballɛ) => M HM; clear Hballɛ.
            assert (∃ M' : R, ∀ x : R, x < M' → x < M*/p) as HMloc.
            exists (M*/p) => //.
            case: (Hln _ HMloc) => sigη Hη; clear HMloc.
        unfold is_lim_seq, filterlim, eventually, filter_le, filtermap, locally in Hu.
        assert (∃ eps : posreal, ∀ y : R_NormedModule, ball 0 eps y → ball 0 sigη y) as Hballη.
        exists sigη => //.
        case: (Hu _ Hballη) => N HN; clear Hballη.
        exists N => n /HN/Hη Hun.
        case: (Req_EM_T (u n) 0).
        move => _; rewrite minus_eq_zero.
        rewrite norm_zero //.
        move => Nequn0.
        assert (Rpower.ln (u n) < M * / p).
        apply Hun; pose Hun' := u_pos n; lra.
        assert (p * Rpower.ln (u n) < M).
        replace M with (p.(RIneq.pos) * (M * /p.(RIneq.pos))).
        all : swap 1 2.
        setoid_rewrite Rmult_comm.
        rewrite Rmult_assoc.
        rewrite Raxioms.Rinv_l.
        rewrite Rmult_1_r => //.
        case p => p' Hp' /=; lra.
        unfold mult => /=.
        apply Rmult_lt_compat_l.
        case p => p' Hp' /=; lra.
        assumption.
        clear H; move: H0 => /HM//.
    Qed.

    Lemma lim_seq_bounded :
        ∀ u : nat -> E,
            (∃ lu : E, is_lim_seq u lu)
            -> { M : R | ∀ n : nat, (‖ u n ‖)%hy <= M }.
    Proof.
        move => u Hu.
        apply filterlim_bounded => //.
    Qed.

    Lemma measurable_fun_lim_seq {X : Set} {gen : (X -> Prop) -> Prop} :
        ∀ s : nat -> X -> E, (∀ n : nat, measurable_fun gen open (s n)) ->
        ∀ f : X -> E,
            (∀ x : X, is_lim_seq (fun n => s n x) (f x))
            -> measurable_fun gen open f.
    Proof.
        move => s Hs f Hf.
        suff: (∀ U : E -> Prop, open U -> measurable gen (λ x : X, U (f x))).
            move => H P HP.
            induction HP.
            move: H0 => /H//.
            apply measurable_empty.
            apply measurable_compl => //.
            apply measurable_union_countable => //.
            move => U HU.
        pose Ω := fun r : nat => (fun x : E => ∃ d : R, ( / (INR r + 1)) < d ∧ (∀ y : E, U y ∨ (‖ minus x y ‖%hy > d))).
        assert (∀ x : X, (∃ r : nat, Ω r (f x)) ↔ U (f x)) as Decomp.
            move => x; split.
            case => r; unfold Ω; case => [d [Hlt H]].
            case (H (f x)) => //.
            rewrite minus_eq_zero norm_zero => Abs.
            apply False_ind.
            assert (0 < /(INR r + 1)).
            apply RiemannInt.RinvN_pos.
            apply (Rlt_asym _ _ H0) => //.
            apply Rlt_trans with d => //.
            move => Ufx.
            unfold open in HU.
            move: (HU (f x) Ufx) => /locally_norm_le_locally.
            case; move => [ɛ Hɛ] Hloc.
            assert (0 < ɛ*/2) as Hhalfɛ by lra.
            case: (Rtrigo_def.archimed_cor1 (ɛ*/2) Hhalfɛ).
            move => m' [Hm'0 Hm'1].
            assert (m' = (m' - 1) + 1)%nat by lia.
            pose m := (m' - 1)%nat.
            fold m in H; rewrite H in Hm'0.
            replace (m + 1)%nat with (S m) in Hm'0 by lia.
            rewrite RIneq.S_INR in Hm'0.
            clear H; clearbody m; clear Hm'1 m'.
            exists m.
            exists (ɛ*/2); split => //.
            move => y.
            case: (ball_norm_dec (f x) y {| pos := ɛ; cond_pos := Hɛ |}).
                move => /Hloc; left => //.
                move => /Rnot_gt_le/=H; right.
                apply Rlt_gt, RIneq.Rlt_le_trans with ɛ => //.
                apply Rlimit.Rlt_eps2_eps => //.
                rewrite <-norm_opp, opp_minus => //.
        apply measurable_ext with (fun x => ∃ r : nat, Ω r (f x)).
        exact Decomp.
        apply measurable_ext with (fun x => ∃ r : nat, ∃ m : nat, ∀ n : nat, m ≤ n -> Ω r (s n x)).
            move => x; split.
            case => r; case => m H.
            apply Decomp.
            unfold Ω in H.
            unfold is_lim_seq in Hf.
            pose sigr := {|
                RIneq.pos := / (INR r + 1);
                RIneq.cond_pos := RiemannInt.RinvN_pos r |}.
            assert (locally (f x) (ball_norm (f x) sigr)) as Hloc_norm.
            apply locally_le_locally_norm; unfold locally_norm.
                exists sigr => //.
            pose Hloc := Hf x (ball_norm (f x) sigr) Hloc_norm; clearbody Hloc; clear Hloc_norm.
            case: Hloc => N /= HN.
            assert (m ≤ max m N) as Ineq by lia.
            case: (H (max m N) Ineq) => d [Hlt {}H].
            case: (H (f x)) => //.
            move => Abs; apply False_ind.
            assert (N ≤ max m N) as Ineq' by lia.
            pose Abs' := (HN (max m N) Ineq'); clearbody Abs'.
            unfold ball_norm in Abs'.
            apply (Rlt_asym _ _ Abs).
            apply Rlt_trans with (/ (INR r + 1)) => //.
            case => r Ωrfx.
            exists r.
            unfold is_lim_seq, filterlim, eventually, filter_le, filtermap
                in Hf.
            case: Ωrfx => d; move => [Hlt Hloc].
            apply Hf.
            pose ɛ := (d - / (INR r + 1))%R.
            assert (0 < ɛ) as Hɛ.
            apply Rlt_Rminus => //.
            pose sigɛ := {| pos := ɛ; cond_pos := Hɛ |}.
            suff: locally_norm (f x) (Ω r).
            apply locally_le_locally_norm.
            exists sigɛ => y Hy.
            pose (d' := (d - ‖ minus y (f x) ‖%hy)%R).
            assert (/ (INR r + 1) < d') as Hlt'.
            unfold ball_norm in Hy; simpl in Hy.
            unfold d'; unfold ɛ in Hy; lra.
            exists d'; split => //.
            move => z.
            case: (Hloc z).
                left => //.
                move => Hz.
                right.
                unfold d'.
                apply Rlt_gt.
                unfold Rminus.
                apply Rlt_le_trans with ((‖ minus (f x) z ‖)%hy + - (‖ minus y (f x) ‖)%hy)%R.
                apply Rplus_lt_compat_r => //.
                setoid_rewrite <-norm_opp at 2.
                setoid_rewrite opp_minus.
                apply Rle_trans with (‖ minus (minus (f x) z) (minus (f x) y) ‖)%hy.
                apply Rle_trans with (| ‖ minus (f x) z ‖%hy - ‖ minus (f x) y ‖%hy |)%R.
                apply Rbasic_fun.Rle_abs.
                apply norm_triangle_inv.
                unfold minus.
                rewrite opp_plus opp_opp.
                rewrite plus_assoc.
                rewrite plus_comm.
                rewrite plus_assoc.
                setoid_rewrite plus_comm at 3.
                do 2 rewrite <-plus_assoc.
                rewrite plus_opp_r plus_zero_r.
                apply Rle_refl.
                apply measurable_union_countable => r.
                apply measurable_union_countable => m.
                apply measurable_inter_countable => n.
                case_eq (m <=? n).
                    move => /Nat.leb_le Lemn.
                    apply measurable_ext with (λ x : X, Ω r (s n x)).
                    move => x; split => //.
                    move => H; exact (H Lemn).
                    apply (Hs n).
                    apply measurable_gen.
                    move => x; case => d [Hd H].
                    suff: (locally_norm x (Ω r)).
                    apply locally_le_locally_norm.
                    pose ɛ := (d - / (INR r + 1))%R.
                    assert (0 < ɛ) as Hɛ.
                    apply Rlt_Rminus => //.
                    pose sigɛ := {| pos := ɛ; cond_pos := Hɛ |}.
                    exists sigɛ => y Hy.
                    pose (d' := (d - ‖ minus y x ‖%hy)%R).
                    assert (/ (INR r + 1) < d') as Hlt'.
                    unfold ball_norm in Hy; simpl in Hy.
                    unfold d'; unfold ɛ in Hy; lra.
                    exists d'; split => //.
                    move => z.
                    case: (H z).
                        left => //.
                        move => Hz.
                        right.
                        unfold d'.
                        apply Rlt_gt.
                        unfold Rminus.
                        apply Rlt_le_trans with ((‖ minus x z ‖)%hy + - (‖ minus y x ‖)%hy)%R.
                        apply Rplus_lt_compat_r => //.
                        setoid_rewrite <-norm_opp at 2.
                        setoid_rewrite opp_minus.
                        apply Rle_trans with (‖ minus (minus x z) (minus x y) ‖)%hy.
                        apply Rle_trans with (| ‖ minus x z ‖%hy - ‖ minus x y ‖%hy |)%R.
                        apply Rbasic_fun.Rle_abs.
                        apply norm_triangle_inv.
                        unfold minus.
                        rewrite opp_plus opp_opp.
                        rewrite plus_assoc.
                        rewrite plus_comm.
                        rewrite plus_assoc.
                        setoid_rewrite plus_comm at 3.
                        do 2 rewrite <-plus_assoc.
                        rewrite plus_opp_r plus_zero_r.
                        apply Rle_refl.
                move => /Nat.leb_gt Ltnm.
                apply measurable_ext with (fun _ => True).
                move => x; split => //.
                    move => _ Abs; lia.
                apply measurable_full.
    Qed.

End NM_lim_seq_prop.


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

(* Instantiation of the Ring tactic for the naturals of Arith $*)

Require Import Bool.
Require Export LegacyRing.
Require Export Arith.
Require Import Eqdep_dec.

Local Open Scope nat_scope.

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

Lemma nateq_prop : forall n m:nat, Is_true (nateq n m) -> n = m.
Proof.
  simple induction n; simple induction m; intros; try contradiction.
  trivial.
  unfold Is_true in H1.
  rewrite (H n1 H1).
  trivial.
Qed.

Hint Resolve nateq_prop: arithring.

Definition NatTheory : Semi_Ring_Theory plus mult 1 0 nateq.
  split; intros; auto with arith arithring.
(*  apply (fun n m p:nat => plus_reg_l m p n) with (n := n).
  trivial.*)
Defined.

Add Legacy Semi Ring nat plus mult 1 0 nateq NatTheory [ 0 S ].

Goal forall n:nat, S n = 1 + n.
intro; reflexivity.
Save S_to_plus_one.

(* Replace all occurrences of (S exp) by (plus (S O) exp), except when
   exp is already O and only for those occurrences than can be reached by going
   down plus and mult operations  *)
Ltac rewrite_S_to_plus_term t :=
  match constr:(t) with
  | 1 => constr:(1)
  | (S ?X1) =>
      let t1 := rewrite_S_to_plus_term X1 in
      constr:(1 + t1)
  | (?X1 + ?X2) =>
      let t1 := rewrite_S_to_plus_term X1
      with t2 := rewrite_S_to_plus_term X2 in
      constr:(t1 + t2)
  | (?X1 * ?X2) =>
      let t1 := rewrite_S_to_plus_term X1
      with t2 := rewrite_S_to_plus_term X2 in
      constr:(t1 * t2)
  | _ => constr:(t)
  end.

(* Apply S_to_plus on both sides of an equality *)
Ltac rewrite_S_to_plus :=
  match goal with
  |  |- (?X1 = ?X2) =>
      try
       let t1 :=
       (**)  (**)
       rewrite_S_to_plus_term X1
       with t2 := rewrite_S_to_plus_term X2 in
       change (t1 = t2)
  |  |- (?X1 = ?X2) =>
      try
       let t1 :=
       (**)  (**)
       rewrite_S_to_plus_term X1
       with t2 := rewrite_S_to_plus_term X2 in
       change (t1 = t2)
  end.

Ltac ring_nat := rewrite_S_to_plus; ring.


Load LFindLoad.
From lfind Require Import LFind.
From adtind Require Import goal11.

Set Printing Depth 1000.
Definition lfind_eval  y:=
append y Nil.

Compute lfind_eval  (Cons Zero (Cons (Succ Zero) (Cons (Succ Zero) Nil))).

Compute lfind_eval  (Cons (Succ (Succ Zero)) Nil).

Compute lfind_eval  (Cons (Succ (Succ Zero)) (Cons (Succ Zero) Nil)).

Compute lfind_eval  (Cons Zero (Cons (Succ Zero) (Cons (Succ (Succ Zero)) Nil))).

Compute lfind_eval  (Cons Zero (Cons (Succ Zero) Nil)).

Compute lfind_eval  (Cons (Succ (Succ (Succ Zero))) Nil).

Compute lfind_eval  (Cons (Succ Zero) Nil).

Compute lfind_eval  (Cons (Succ (Succ (Succ (Succ (Succ Zero))))) Nil).

Compute lfind_eval  (Cons Zero (Cons Zero Nil)).

Compute lfind_eval  (Cons Zero Nil).

Compute lfind_eval  (Cons Zero (Cons (Succ (Succ Zero)) (Cons (Succ Zero) (Cons (Succ (Succ (Succ Zero))) (Cons (Succ Zero) Nil))))).

Compute lfind_eval  (Nil).


Require Import prosa.classic.util.all.
Require Import prosa.classic.model.arrival.basic.job prosa.classic.model.arrival.basic.task prosa.classic.model.priority prosa.classic.model.arrival.basic.task_arrival.
Require Import prosa.classic.model.schedule.global.basic.schedule.
Require Import prosa.classic.model.schedule.apa.interference prosa.classic.model.schedule.apa.affinity prosa.classic.model.schedule.apa.platform.
From mathcomp Require Import ssreflect ssrbool ssrfun eqtype ssrnat seq fintype bigop.

Module ConstrainedDeadlines.

  Import Job SporadicTaskset ScheduleOfSporadicTask SporadicTaskset
         TaskArrival Interference Priority Affinity Platform.

  Section Lemmas.

    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.

    (* ... and any schedule of this arrival sequence. *)
    Context {num_cpus: nat}.
    Variable sched: schedule Job num_cpus.
    Hypothesis H_jobs_come_from_arrival_sequence:
      jobs_come_from_arrival_sequence sched arr_seq.

    (* Assume that every task has a processor affinity alpha. *)
    Variable alpha: task_affinity sporadic_task num_cpus.

    (* Assume all jobs have valid parameters, ...*)
    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.

    (* In this section we prove the absence of multiple jobs of the same
       task when constrained deadlines are assumed.  *)
    Section NoMultipleJobs.

      (* Assume any work-conserving priority-based scheduler. *)
      Variable higher_eq_priority: JLDP_policy Job.
      Hypothesis H_work_conserving:
        apa_work_conserving job_arrival job_cost job_task arr_seq sched alpha.
      Hypothesis H_respects_JLDP_policy:
        respects_JLDP_policy_under_weak_APA job_arrival job_cost job_task arr_seq
                                            sched alpha higher_eq_priority.

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

      (* Assume that all jobs come from the taskset. *)
      Hypothesis H_all_jobs_from_taskset:
        forall j, arrives_in arr_seq j -> job_task j \in ts.

      (* Suppose that jobs are sequential, ...*)
      Hypothesis H_sequential_jobs: sequential_jobs sched.
      (* ... jobs only execute after they arrive, ... *)
      Hypothesis H_jobs_must_arrive_to_execute: jobs_must_arrive_to_execute job_arrival sched.
      (* ... and jobs do not execute after completion. *)
      Hypothesis H_completed_jobs_dont_execute: completed_jobs_dont_execute job_cost sched.

      (* Assume that the schedule satisfies the sporadic task model ...*)
      Hypothesis H_sporadic_tasks:
        sporadic_task_model task_period job_arrival job_task arr_seq.

      (* Consider a valid task tsk, ...*)
      Variable tsk: sporadic_task.
      Hypothesis H_valid_task: is_valid_sporadic_task task_cost task_period task_deadline tsk.

      (*... whose job j ... *)
      Variable j: Job.
      Hypothesis H_j_arrives: arrives_in arr_seq j.
      Hypothesis H_job_of_tsk: job_task j = tsk.

      (*... is backlogged at time t. *)
      Variable t: time.
      Hypothesis H_j_backlogged: backlogged job_arrival job_cost sched j t.

      (* Assume that any previous jobs of tsk have completed by the period. *)
      Hypothesis H_all_previous_jobs_completed :
        forall j_other tsk_other,
          arrives_in arr_seq j_other ->
          job_task j_other = tsk_other ->
          job_arrival j_other + task_period tsk_other <= t ->
          completed job_cost sched j_other (job_arrival j_other + task_period (job_task j_other)).

      Let scheduled_task_other_than (tsk tsk_other: sporadic_task) :=
        task_is_scheduled job_task sched tsk_other t && (tsk_other != tsk).

      (* Then, there can be at most one pending job of each task at time t. *)
      Lemma platform_at_most_one_pending_job_of_each_task :
        forall j1 j2,
          arrives_in arr_seq j1 ->
          arrives_in arr_seq j2 ->
          pending job_arrival job_cost sched j1 t ->
          pending job_arrival job_cost sched j2 t ->
          job_task j1 = job_task j2 ->
          j1 = j2.
      Proof.
        rename H_sporadic_tasks into SPO, H_all_previous_jobs_completed into PREV.
        intros j1 j2 ARR1 ARR2 PENDING1 PENDING2 SAMEtsk.
        apply/eqP; rewrite -[_ == _]negbK; apply/negP; red; move => /eqP DIFF.
        move: PENDING1 PENDING2 => /andP [ARRIVED1 /negP NOTCOMP1] /andP [ARRIVED2 /negP NOTCOMP2].
        destruct (leqP (job_arrival j1) (job_arrival j2)) as [BEFORE1 | BEFORE2].
        {
          specialize (SPO j1 j2 DIFF ARR1 ARR2 SAMEtsk BEFORE1).
          assert (LEt: job_arrival j1 + task_period (job_task j1) <= t).
          {
            by apply leq_trans with (n := job_arrival j2); first by done.
          }
          exploit (PREV j1 (job_task j1)); try (by done).
          intros COMP1; apply NOTCOMP1.
          by apply completion_monotonic with (t0 := job_arrival j1 + task_period (job_task j1)).
        }
        {
          apply ltnW in BEFORE2.
          exploit (SPO j2 j1); try (by done); [by red; ins; subst | intro SPO'].
          assert (LEt: job_arrival j2 + task_period (job_task j2) <= t).
          {
            by apply leq_trans with (n := job_arrival j1); first by done.
          }
          exploit (PREV j2 (job_task j2)); try (by done).
          intros COMP2; apply NOTCOMP2.
          by apply completion_monotonic with (t0 := job_arrival j2 + task_period (job_task j2)).
        }
      Qed.

    End NoMultipleJobs.

    (* In this section we also prove the absence of multiple jobs of the same
       task when constrained deadlines are assumed, but in the specific case
       of fixed-priority scheduling.  *)
    Section NoMultipleJobsFP.

      (* Assume any work-conserving priority-based scheduler. *)
      Variable higher_eq_priority: FP_policy sporadic_task.
      Hypothesis H_work_conserving: apa_work_conserving job_arrival job_cost job_task
                                                        arr_seq sched alpha.
      Hypothesis H_respects_JLDP_policy:
        respects_FP_policy_under_weak_APA job_arrival job_cost job_task arr_seq
                                          sched alpha higher_eq_priority.

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

      (* Assume that all jobs come from the taskset. *)
      Hypothesis H_all_jobs_from_taskset:
        forall j, arrives_in arr_seq j -> job_task j \in ts.

      (* Suppose that jobs are sequential, ...*)
      Hypothesis H_sequential_jobs: sequential_jobs sched.
      (* ... jobs only execute after the jitter, ... *)
      Hypothesis H_jobs_must_arrive_to_execute:
        jobs_must_arrive_to_execute job_arrival sched.
      (* ... and jobs do not execute after completion. *)
      Hypothesis H_completed_jobs_dont_execute:
        completed_jobs_dont_execute job_cost sched.

      (* Assume that the schedule satisfies the sporadic task model ...*)
      Hypothesis H_sporadic_tasks:
        sporadic_task_model task_period job_arrival job_task arr_seq.

      (* Consider a valid task tsk, ...*)
      Variable tsk: sporadic_task.
      Hypothesis H_valid_task: is_valid_sporadic_task task_cost task_period task_deadline tsk.

      (*... whose job j ... *)
      Variable j: Job.
      Hypothesis H_j_arrives: arrives_in arr_seq j.
      Variable H_job_of_tsk: job_task j = tsk.

      (*... is backlogged at time t <= job_arrival j + task_period tsk. *)
      Variable t: time.
      Hypothesis H_j_backlogged: backlogged job_arrival job_cost sched j t.
      Hypothesis H_t_before_period: t < job_arrival j + task_period tsk.

      (* Recall the definition of a higher-priority task in affinity (alpha' tsk). *)
      Let hp_task_in alpha' := higher_priority_task_in alpha higher_eq_priority tsk alpha'.

      (* Assume that any jobs of higher-priority tasks complete by their period. *)
      Hypothesis H_all_previous_jobs_completed :
        forall j_other tsk_other,
          arrives_in arr_seq j_other ->
          job_task j_other = tsk_other ->
          hp_task_in (alpha tsk) tsk_other ->
          completed job_cost sched j_other (job_arrival j_other + task_period tsk_other).

      (* Assume that any jobs of tsk prior to j complete by their period. *)
      Hypothesis H_all_previous_jobs_of_tsk_completed :
        forall j0,
          arrives_in arr_seq j0 ->
          job_task j0 = tsk ->
          job_arrival j0 < job_arrival j ->
          completed job_cost sched j0 (job_arrival j0 + task_period tsk).

      Definition scheduled_task_with_higher_eq_priority (tsk tsk_other: sporadic_task) :=
        task_is_scheduled job_task sched tsk_other t &&
        hp_task_in (alpha tsk) tsk_other.

      (* Then, there can be at most one pending job of higher-priority tasks at time t. *)
      Lemma platform_fp_no_multiple_jobs_of_interfering_tasks :
          forall j1 j2,
            arrives_in arr_seq j1 ->
            arrives_in arr_seq j2 ->
            pending job_arrival job_cost sched j1 t ->
            pending job_arrival job_cost sched j2 t ->
            job_task j1 = job_task j2 ->
            hp_task_in (alpha tsk) (job_task j1) ->
            j1 = j2.
      Proof.
        unfold sporadic_task_model in *.
        rename H_sporadic_tasks into SPO, H_all_previous_jobs_of_tsk_completed into PREVtsk,
               H_all_previous_jobs_completed into PREV.
        intros j1 j2 ARR1 ARR2 PENDING1 PENDING2 SAMEtsk INTERF.
        apply/eqP; rewrite -[_ == _]negbK; apply/negP; red; move => /eqP DIFF.
        move: PENDING1 PENDING2 => /andP [ARRIVED1 /negP NOTCOMP1] /andP [ARRIVED2 /negP NOTCOMP2].
        destruct (leqP (job_arrival j1) (job_arrival j2)) as [BEFORE1 | BEFORE2].
        {
          specialize (SPO j1 j2 DIFF ARR1 ARR2 SAMEtsk BEFORE1).
          assert (LEt: job_arrival j1 + task_period (job_task j1) <= t).
            by apply leq_trans with (n := job_arrival j2).
          exploit (PREV j1 (job_task j1) ARR1); [by done | by apply INTERF | intros COMP1].
          apply NOTCOMP1.
          by apply completion_monotonic with (t0 := job_arrival j1 + task_period (job_task j1)).
        }
        {
          apply ltnW in BEFORE2.
          exploit (SPO j2 j1); try (by done); [by red; ins; subst j2 | intro SPO'].
          assert (LEt: job_arrival j2 + task_period (job_task j2) <= t).
            by apply leq_trans with (n := job_arrival j1).
          exploit (PREV j2 (job_task j2) ARR2);
            [by done | by rewrite -SAMEtsk | intro COMP2 ].
          apply NOTCOMP2.
          by apply completion_monotonic with (t0 := job_arrival j2 + task_period (job_task j2)).
        }
      Qed.

      (* Also, there can be at most one pending job of tsk at time t. *)
      Lemma platform_fp_no_multiple_jobs_of_tsk :
        forall j',
          arrives_in arr_seq j' ->
          pending job_arrival job_cost sched j' t ->
          job_task j' = tsk ->
          j' = j.
      Proof.
        unfold sporadic_task_model in *.
        rename H_sporadic_tasks into SPO,
               H_valid_task into PARAMS,
               H_all_previous_jobs_of_tsk_completed into PREVtsk,
               H_all_previous_jobs_completed into PREV,
               H_j_backlogged into BACK, H_job_of_tsk into JOBtsk.
        intros j' ARR' PENDING' SAMEtsk.
        apply/eqP; rewrite -[_ == _]negbK; apply/negP; red; move => /eqP DIFF.
        move: BACK PENDING' => /andP [/andP [ARRIVED /negP NOTCOMP] NOTSCHED]
                               /andP [ARRIVED' /negP NOTCOMP'].
        destruct (leqP (job_arrival j') (job_arrival j)) as [BEFORE | BEFORE'].
        {
          exploit (SPO j' j DIFF ARR' H_j_arrives); [by rewrite JOBtsk | by done | intro SPO'].
          assert (LEt: job_arrival j' + task_period tsk <= t).
            by apply leq_trans with (n := job_arrival j); first by rewrite -SAMEtsk.
          apply NOTCOMP'.
          apply completion_monotonic with (t0 := job_arrival j' + task_period tsk); [by done |].
          apply PREVtsk; try (by done).
          apply leq_trans with (n := job_arrival j' + task_period tsk); last by rewrite -SAMEtsk.
          rewrite -addn1; apply leq_add; first by done.
          by unfold is_valid_sporadic_task in *; des.
        }
        {
          unfold has_arrived in *.
          rewrite leqNgt in ARRIVED'; move: ARRIVED' => /negP BUG; apply BUG.
          apply leq_trans with (n := job_arrival j + task_period tsk); first by done.
          by rewrite -JOBtsk; apply SPO; try (by done);
            [by red; ins; subst j' | by rewrite SAMEtsk | by apply ltnW].
        }
      Qed.

    End NoMultipleJobsFP.

  End Lemmas.

End ConstrainedDeadlines.


Structure Hatcsucsu : Type := make_Hatcsucsu
{
  n :> nat;

  E'' :> nat -> nat -> bool ;

  hatcsucsu : n = 6;
  undirected'' : forall (a : nat) (b : nat), (a < 6 /\ b < 6) -> implb (E'' a b) (E'' b a) = true;
  noloop'' : forall (a : nat), (a < 6) -> negb (E'' a a) = true;
}.
Require Import Bool.
Require Import Notations Logic Datatypes.
Require Decimal Hexadecimal Number.
Local Open Scope nat_scope.
Require Import Arith.
Print Arith.
Fixpoint sum_to (n:nat) : nat :=
  match n with
  | 0 => 0
  | S k => n + sum_to k
  end.
Eval compute in sum_to 6.

Definition elek1 (a:nat)(b:nat):bool:=
  match a,b with
    | 0,1 => true
    | 1,0 => true
    | 0,2 => true
    | 2,0 => true
    | 0,3 => true
    | 0,5 => true
    | 3,0 => true
    | 5,0 => true
    | _,_ => false
    end.

Definition rossz:Hatcsucsu.
  apply (make_Hatcsucsu 6 elek1).
  auto.
  compute.
  induction a;compute;auto;auto.
  induction b.
  auto.
  induction b.
  auto.
  induction b;auto.
  auto.
  induction b;auto;auto.
  induction b;auto;auto.
  induction b;auto;auto.
  induction b;auto;auto.
  induction a;auto.
  auto.
  induction a;auto.
  induction a;auto.
  induction a;auto.
  induction a;auto.
  induction a;auto.
  induction a;auto.
  induction a,b;auto;auto.
  induction a;auto;auto.
  induction a;auto;auto.
  induction a;auto;auto.
  induction a;auto;auto.
  induction a;auto.
  induction a;auto.
  induction a;auto.
  induction a;auto.
  induction a;auto.
  induction a;auto.
Defined.

Definition sajatif (b:bool)(n:nat)(k:nat):=
  match b with
  | true => n
  | false => k
  end.

Eval compute in sajatif true 1 6.

Definition nkval (G:Hatcsucsu)(n:nat)(k:nat) :=
  sajatif(E'' G n k) (1)(0).

Eval compute in nkval rossz 0 5.

Definition fokszam (G:Hatcsucsu)(a:nat):nat:=
  (nkval G a 0)+(nkval G a 1)+(nkval G a 2)+(nkval G a 3)+(nkval G a 4)+(nkval G a 5).

Eval compute in fokszam rossz 4.

Theorem egyenlo(a:bool)(b:bool): ((implb(a)(b)=true) /\ (implb(b)(a))=true)-> a=b.
  intros.
  induction a,b;auto.
  destruct H.
  discriminate.
  destruct H.
  discriminate.
Qed.

Theorem elekodavissza: forall (G1:Hatcsucsu),forall (a:nat) (b:nat), (a < 6 /\ b < 6) ->E'' G1 a b = E'' G1 b a.
  intros.
  enough (implb (E'' G1 a b) (E'' G1 b a) = true).
  enough (implb(E'' G1 b a) (E'' G1 a b) = true).
  apply (egyenlo (E'' G1 a b)(E'' G1 b a)).
  rewrite H0.
  rewrite H1.
  auto.
  rewrite undirected''.
  auto.
  destruct H.
  split.
  apply H1.
  apply H.
  rewrite undirected''.
  auto.
  apply H.
Defined.

Definition fokszamossz (G:Hatcsucsu):=
   nkval G 0 0 + (nkval G 0 1 + nkval G 1 0) + (nkval G 0 2 + nkval G 2 0) +
   (nkval G 0 3 + nkval G 3 0) + (nkval G 0 4 + nkval G 4 0) + (nkval G 0 5 + nkval G 5 0) +
    nkval G 1 1 +
   (nkval G 1 2 + nkval G 2 1) + (nkval G 1 3 + nkval G 3 1) + (nkval G 1 4 +
    nkval G 4 1) +
   (nkval G 1 5 + nkval G 5 1) + nkval G 2 2 + (nkval G 2 3 + nkval G 3 2) +
    (nkval G 2 4 +
   nkval G 4 2) + (nkval G 2 5 + nkval G 5 2) + nkval G 3 3 + (nkval G 3 4 +
    nkval G 4 3) + (nkval G 3 5 + nkval G 5 3) + nkval G 4 4 + (nkval G 4 5 + nkval G 5 4) +
    nkval G 5 5.

Eval compute in fokszamossz rossz.

Fixpoint paros n : bool :=
  match n with
    | 0 => true
    | S n' => negb(paros n')
  end.

Theorem S_1: forall n:nat, n+1=S n.
  intros.
  induction n0.
  auto.
  simpl.
  rewrite IHn0.
  auto.
Defined.
Require Import Coq.Bool.Bool.

Lemma paros_ad m n :
  paros (m + n) = negb (xorb (paros m) (paros n)).
  Proof.
  induction m.
  simpl.
  -destruct (paros n);compute;auto.
  -simpl. rewrite IHm. now destruct (paros m); destruct (paros n).
Qed.

Lemma parosszorz m n:
  paros(m*n)=paros m || paros n.
Proof.
  induction m;auto;simpl.
  rewrite paros_ad.
  rewrite IHm.
  now destruct (paros m); destruct (paros n).
Qed.

Theorem ketszervalamiazparos: forall n:nat, paros(2*n)=true.
Proof.
  intros.
  rewrite parosszorz.
  auto.
Qed.

Definition elszam (G:Hatcsucsu):=
  fokszamossz G/2.

Eval compute in elszam rossz.

Require Import Omega.

Theorem szer2_egymegegy(n:nat): n+n = 2 * n.
  induction n;auto.
  simpl.

  omega.
Qed.

Theorem nullmegval: forall n:nat, n+0=n.
  auto.
Qed.

Theorem valmegnull: forall n:nat, 0+n=n.
  auto.
Qed.

Theorem nullmegnull: 0=0+0.
  auto.
Qed.

Theorem egyrend: forall a b c:nat, a+b=c+b -> a=c.
Proof.
  intros.
  induction a,b,c;compute;auto.
  rewrite nullmegnull.
  rewrite H.
  auto with arith.
  Require Import Omega.
  omega.
  omega.
  omega.
  omega.
  omega.
Defined.

Theorem egyetatir(k:nat):forall F:Hatcsucsu,forall b:nat,(k < 6 /\ b < 6) -> E'' F k b = E'' F b k.
  intros.
  rewrite elekodavissza.
  auto.
  apply H.
Qed.

Theorem nkvalokra(a:nat): forall G:Hatcsucsu, forall b:nat, (a < 6 /\ b < 6) -> nkval G a b = nkval G b a.
  intros.
  unfold nkval.
  unfold sajatif.
  rewrite elekodavissza.
  auto.
  apply H.
Qed.

Require Import PeanoNat.

Check PeanoNat.Nat.add_assoc.

Theorem osszegbolketszer(n1 n2 n3 n4 n5 n6 n7 n8 n9 n10 n11 n12 n13 n14 n15:nat):
0 + 2 * n1 + 2 * n2 + 2 * n3 + 2 * n4 + 2 * n5 +
  0 + 2 * n6 + 2 * n7 + 2 * n7 + 2 * n9 + 0 +
  2 * n10 + 2 * n11 + 2 * n12 + 2 * n13 +
  2 * n14 + 0 + 2 * n15 + 0 = 2 * (n1 + n2 + n3 + n4 + n5 + n6 + n7 + n8 + n9 +n10 + n11 + n12 + n13 + n14 + n15).
Proof.
  Require Import Lia.
  rewrite nullmegval.
  repeat rewrite nullmegval.
  rewrite valmegnull.
  simpl.
  repeat rewrite nullmegval.
  lia.
  auto.

  auto.
  lia.
  omega.

  lia.
  enough
  compute.
  rewrite szer2_egymegegy.
  omega.
  simpl.
  auto with arith.
  reflexivity.
  induction n1, n2, n3, n4, n5, n6, n7, n8, n9, n10, n11, n12, n13, n14, n15.
  compute.

Theorem nk:forall G:Hatcsucsu, exists k:nat, fokszamossz G=2*k.
intros.
unfold fokszamossz.
  unfold fokszam.
  enough (nkval G 0 1 + nkval G 1 0 = 2*nkval G 0 1).
  rewrite H.
  enough (nkval G 0 2 + nkval G 2 0 = 2*nkval G 0 2).
  enough (nkval G 0 3 + nkval G 3 0 = 2*nkval G 0 3).
  enough (nkval G 0 4 + nkval G 4 0 = 2*nkval G 0 4).
  enough (nkval G 0 5 + nkval G 5 0 = 2*nkval G 0 5).
  enough (nkval G 1 2 + nkval G 2 1 = 2*nkval G 1 2).
  enough (nkval G 1 3 + nkval G 3 1 = 2*nkval G 1 3).
  enough (nkval G 1 4 + nkval G 4 1 = 2*nkval G 1 4).
  enough (nkval G 1 5 + nkval G 5 1 = 2*nkval G 1 5).
  enough (nkval G 2 3 + nkval G 3 2 = 2*nkval G 2 3).
  enough (nkval G 2 4 + nkval G 4 2 = 2*nkval G 2 4).
  enough (nkval G 2 5 + nkval G 5 2 = 2*nkval G 2 5).
  enough (nkval G 3 4 + nkval G 4 3 = 2*nkval G 3 4).
  enough (nkval G 3 5 + nkval G 5 3 = 2*nkval G 3 5).
  enough (nkval G 4 5 + nkval G 5 4 = 2*nkval G 4 5).
  rewrite H0.
  rewrite H4.
  rewrite H5.
  rewrite H6.
  rewrite H7.
  rewrite H8.
  rewrite H9.
  rewrite H10.
  rewrite H11.
  rewrite H12.
  rewrite H13.
  rewrite H1.
  rewrite H2.
  rewrite H3.
  enough (nkval G 0 0 = 0).
  rewrite H14.
  enough (nkval G 1 1 = 0).
  enough (nkval G 2 2 = 0).
  enough (nkval G 3 3 = 0).
  enough (nkval G 4 4 = 0).
  enough (nkval G 5 5 = 0).
  rewrite H15.
  rewrite H16.
  rewrite H17.
  rewrite H18.
  rewrite H19.

  apply (szer2_egymegegy (nkval G 0 1)).
  unfold paros.

Theorem fokszamosszparos: forall G:Hatcsucsu, paros(fokszamossz G)=true.
Proof.
  intros.
  unfold fokszamossz.
  unfold fokszam.
  rewrite (nkvalokra 5).
  rewrite (nkvalokra 4).
  rewrite (nkvalokra 3).
  unfold paros.

  rewrite (szer2_egymegegy (nkval G 0 1)).

Theorem fokok_ketszer:forall G:Hatcsucsu, fokszamossz G=elszam G*2.
  intros.
  unfold elszam.
  Require Import Omega.
  rewrite nkval_ugyanaz.

Theorem fokszamosszegparos:forall G:Hatcsucsu, paros (fokszamossz G)=true.
Proof.
  enough (~ exists G0:Hatcsucsu, paros (fokszamossz G0) = false).
  enough (forall G:Hatcsucsu, paros (fokszamossz G)=true).
  contradiction.
  induction (fokszamossz G).
  auto.

  contradiction.

  compute;auto.


From discprob.basic Require Import base order nify seq_ext.
From discprob.prob Require Import prob countable finite stochastic_order.
From discprob.monad Require Import monad monad_par_hoare monad_par par_quicksort par_quicksort_correct.
From discprob.monad Require  quicksort_cost.
From discprob.monad Require Import max_triangle.
From discprob.rec Require Import rec_convert quicksort_rec.
From mathcomp Require Import ssreflect ssrbool ssrfun eqtype ssrnat seq div choice fintype.
From mathcomp Require Import tuple finfun bigop prime binomial finset.
From mathcomp Require Import path.
Require Import Reals Fourier Psatz Omega.

Definition h (l: seq nat) :=
  match l with
  | [::] => mret ([::], [::])
  | [::a] => mret ([::], [::])
  | a :: l =>
      p ← draw_pivot a l;
      spl ← dist_ret _ (partition' (sval p) (a :: l));
      mret (lower (sval spl), upper (sval spl))
  end.
Definition rsize (l: seq nat) := INR (size l).

Definition m x :=
  match (Rlt_dec x (4/3)) with
  | left _ => 0
  | _ => x * (3 / 4)
  end.

Lemma uniq_unif n:
  uniq (outcomes (unif n)).
Proof.
  rewrite /unif//=.
  rewrite map_inj_uniq.
  - apply enum_uniq.
  - intros (?&?) (?&?). inversion 1; auto.
    subst; f_equal. apply bool_irrelevance.
Qed.

Lemma uniq_unif2 n:
  uniq ([seq i.2 | i <- outcomes (unif n)]).
Proof.
  rewrite /unif//=.
  rewrite map_inj_in_uniq.
  - apply uniq_unif.
  - intros (?&?) (?&?).
    move /mapP => [? ? Heq1]. inversion Heq1; subst.
    move /mapP => [? ? Heq2]. inversion Heq2; subst.
    rewrite //=. inversion 1. repeat f_equal.
    apply val_inj => //=.
Qed.

Lemma unif_all n x (Hle: (x <= n)%nat):
  {| work := O; span := O; result := exist _ x Hle|} \in [seq i.2 | i <- outcomes (unif n)].
Proof.
  apply /mapP.
  set (a := exist _ x Hle).
  replace {| work := 0; span := 0; result := a|} with
          (1/INR (S n), {| work := 0; span :=0; result := a|}).2; last done.
  do 2 apply /mapP; eexists; eauto.
  rewrite /unif => //=.
  apply /mapP => //=.
  assert (Hlt: (x < S n)%nat) by auto.
  exists (Ordinal Hlt).
  - apply mem_enum.
  - rewrite /a; repeat f_equal. apply bool_irrelevance.
Qed.

Lemma unif_all2 n x (Hle: (x <= n)%nat):
  exist _ x Hle \in [seq (result (i.2)) | i <- outcomes (unif n)].
Proof.
  apply /mapP.
  set (a := exist _ x Hle).
  replace a with
          (result (1/INR (S n), {| work := 0; span :=0; result := a|}).2); last done.
  do 2 apply /mapP; eexists; eauto.
  rewrite /unif => //=.
  apply /mapP => //=.
  assert (Hlt: (x < S n)%nat) by auto.
  exists (Ordinal Hlt).
  - apply mem_enum.
  - rewrite /a; repeat f_equal. apply bool_irrelevance.
Qed.

Lemma unif_cost n a w s :
  {| work := w; span := s; result := a|} \in [seq i.2 | i <- outcomes (unif n)] →
  w = O ∧ s = O.
Proof.
  replace {| work := w; span := s; result := a|} with
          (1/INR (S n), {| work := w; span := s; result := a|}).2; last done.
  move /mapP => [[r' [w' s' a']] Hin].
  move: Hin. rewrite /unif//=.
  move /mapP => [[w'' s'' a''] Hin] [] => ???. subst. inversion Hin. done.
Qed.

Lemma unif_cost2 n:
  [seq {| work := O; span := O; result := result (i.2) |} | i <- unif n] =
  [seq i.2 | i <- unif n].
Proof.
  rewrite -eq_in_map.
  intros (r, a) Hin.
  edestruct (unif_cost n (result a) (work a) (span a)) as [Heq1 Heq2].
  apply /mapP. exists (r, a); destruct a; eauto.
  destruct a as [w s a] => //=. rewrite //= in Heq1 Heq2. subst.
  done.
Qed.

Lemma unif_cost3 n:
  [seq {| work := O; span := O; result := i|}
  | i <- [seq result (i.2) | i <- unif n]] = [seq i.2 | i <- unif n].
Proof.
  rewrite -map_comp -unif_cost2 => //=.
Qed.

Lemma unif_pr n a :
  a \in [seq i.2 | i <- outcomes (unif n)] →
  pr_eq (rvar_of_ldist (unif n)) a = 1 / INR (S n).
Proof.
  intros Hin. rewrite pr_rvar_ldist /unif//=.
  rewrite big_map -big_filter //=.
  destruct a as [w s (x&Hle)] => //=.
  assert (w = O ∧ s = O) as (?&?); last subst.
  { eapply unif_cost. apply Hin. }
  assert (Hlt: (x < S n)%nat) by auto.
  rewrite (bigD1_seq (Ordinal Hlt)) => //=.
  - rewrite -[a in _ = a]Rplus_0_r; f_equal.
    rewrite -big_filter -filter_predI big_filter. apply big_pred0.
    intros i => //=. apply negbTE. apply /andP => [] []. move /eqP => Heq.
    move /eqP => []. intros. subst. apply Heq.
    destruct i. f_equal. apply bool_irrelevance.
  - rewrite mem_filter. apply /andP; split; auto.
    * apply /eqP; f_equal; auto. f_equal. apply bool_irrelevance.
    * apply mem_enum.
  - apply /filter_uniq/enum_uniq.
Qed.

Lemma partition_split l pv:
  let x := partition' pv l in
  lower (sval (result x)) = [ seq n <- l | ltn n pv] ∧
  middle (sval (result x)) = [ seq n <- l | n == pv] ∧
  upper (sval (result x)) = [ seq n <- l | ltn pv n].
Proof.
      induction l as [|a l]; first by rewrite //=.
      rewrite //=; case (ltngtP a pv) => //= ?;
      destruct (IHl) as (?&?&?); repeat split; auto; f_equal; done.
Qed.

Lemma Ex_max_partition_sum l:
  Ex (rvar_comp (rvar_of_ldist (h l)) (λ x, Rmax (rsize (result x).1) (rsize (result x).2))) <=
  match (size l) with
     | O => 0
     | _ => \big[Rplus/0]_(i < size l) (/INR (size l) * (Rmax (INR i) (INR (size l - i - 1))))
  end.
Proof.
  destruct l as [| a l].
  - rewrite Ex_fin_comp.
    rewrite -(big_map _ (λ x, true) (λ a, pr_eq _ a * _ (_ (fst (result a))) (_ (snd (result a))))).
    rewrite img_rvar_of_ldist//=/img/undup//= !big_cons ?big_nil.
    rewrite pr_mret_simpl //= /m/rsize//=.
    rewrite Rmax_left //; last (fourier).
    rewrite /INR. ring_simplify. fourier.
  - destruct l as [| b0 l0].
    {
      rewrite Ex_fin_comp.
      rewrite -(big_map _ (λ x, true) (λ a, pr_eq _ a * _ (_ (fst (result a))) (_ (snd (result a))))).
      rewrite img_rvar_of_ldist//=/img/undup//= !big_cons ?big_nil.
      rewrite pr_mret_simpl //= /m/rsize//=.
      rewrite Rmax_left //; last (fourier).
      replace (INR 0) with 0 by auto. ring_simplify.
      apply Rle_big0 => i _ //=.
      destruct i as (i&Hlt) => //=. assert (i = O) as -> by (nify; omega).
      replace (1 - 0 - 1)%nat with O by (nify; omega).
      replace (INR 0) with 0 by auto. rewrite Rmax_left; last fourier.
      replace (INR 1) with 1 by auto. fourier.
    }
    remember (b0 :: l0) as l eqn:Heql0.

    replace (size (a :: l)) with (S (size l)) by auto.
    rewrite -(Ex_mbind_mret (h (a :: l))).
    rewrite /h Heql0. rewrite -Heql0. clear l0 Heql0.

    rewrite ldist_assoc. rewrite ldist_assoc.
    rewrite Ex_mbind_ldist2.
    rewrite undup_id; last first.
    { apply uniq_unif2. }
    rewrite -unif_cost3 big_map.
    edestruct (quicksort_cost.perm_eq_bij O) as (f&Hfspec&Hfsize&Hinv&Hinj).
    { rewrite perm_eq_sym. apply (perm_eqlE (perm_sort leq (a :: l))). }
    eapply sum_reidx_map_le with
        (h := (λ (H : {x : nat | (x <= size l)%nat}),
               let (x, i) := H in
                (Ordinal (n:=(size l).+1) (m:=f x) (Hfsize x i)))).
    * intros (x, Hle) Hin.
      rewrite unif_pr. rewrite /Rdiv Rmult_1_l. apply Rmult_le_compat_l.
      ** left. apply Rinv_0_lt_compat. apply lt_0_INR. rewrite //=. omega.
      ** rewrite -ldist_assoc. rewrite Ex_mbind_mret.
         apply Ex_bound.
         rewrite (ldist_cost_bind_fold (λ x, spl ← dist_ret _ (partition' (sval x) (a :: l));
                                             mret (lower (sval spl), upper (sval spl)))).
         rewrite ?ldist_left_id.
         assert (Hlt: (x < size (a :: l))%nat) by auto.
         rewrite //= in Hlt.
         eapply (@cspec_mspec _ _ (λ x0 : (seq nat * seq nat),
                                      Rmax (rsize x0.1) (rsize x0.2)
                                      <= Rmax (INR (f (Ordinal (n:= S (size l)) Hle)))
                                              (INR (S (size l) - (f (Ordinal (n := S (size l)) Hle))
                                                    - 1)))).
         tbind (λ y, nth 0%nat (a :: l) x = sval y).
         { apply mspec_mret => //=. }
         intros (pv&Hin') Heq.
         tbind (λ x, lower (sval x) = [ seq n <- (a :: l) | ltn n pv] ∧
                     middle (sval x) = [ seq n <- (a :: l) | n == pv] ∧
                     upper (sval x) = [ seq n <- (a :: l) | ltn pv n]).
         { apply mspec_mret. apply partition_split. }
         remember (a :: l) as l0 eqn:Heql0.
         assert (Hsize: S (size l) = (size l0)) by (rewrite Heql0; auto).
         intros (spl&Hin'') => //=. intros (Hl&Hm&Hu).
         apply mspec_mret => //=.
         rewrite /rsize.
         rewrite !Rmax_INR. apply le_INR.
         rewrite Hl Hu.
         apply Nat.max_le_compat.
         *** rewrite //= in Heq. rewrite -Heq.
             apply /leP. rewrite Hfspec.
             specialize (perm_eqlE (perm_sort leq l0)) => Hperm.
             rewrite -(perm_eq_size (quicksort_cost.perm_filter _ _ Hperm)).
             apply quicksort_cost.lower_split_size_sorted_nth; auto.
             **** apply sort_sorted => ??. apply leq_total.
             **** rewrite (perm_eq_size (perm_eqlE (perm_sort leq l0))) /=.
                  apply Hfsize. rewrite Heql0. done.
             **** rewrite Heql0 //=.
         *** rewrite //= in Heq. rewrite -Heq.
             apply /leP. rewrite Hfspec.
             assert (Hsize': (size l).+1 = size l0) by rewrite Heql0 //.
             rewrite Hsize'.
             specialize (perm_eqlE (perm_sort leq l0)) => Hperm.
             rewrite -(perm_eq_size (perm_eqlE (perm_sort leq l0))).
             rewrite -(perm_eq_size (quicksort_cost.perm_filter _ _ Hperm)).
             apply quicksort_cost.upper_split_size_sorted_nth; auto.
             **** apply sort_sorted => ??. apply leq_total.
             **** rewrite (perm_eq_size (perm_eqlE (perm_sort leq l0))) /=.
                  apply Hfsize. rewrite Heql0. done.
             **** rewrite Heql0 //=.
      ** rewrite -unif_cost3 //. apply /mapP. eexists; eauto.
    * intros (?&?) Hin; split; auto.
      rewrite /index_enum. rewrite -enumT. rewrite mem_enum => //=.
    * intros b Hin _ Hfalse. contradiction Hfalse.
      destruct b as (m, Hle).
      destruct (Hinv m Hle) as (x'&Hle'&Heq).
      exists (exist _ x' Hle'); repeat split; auto.
      ** apply unif_all2.
      ** apply ord_inj => //=.
    * eapply map_uniq with (f := λ x, {| work := O; span := 0; result := x|}).
      rewrite unif_cost3. eapply uniq_unif2.
    * rewrite /index_enum. rewrite -enumT. apply enum_uniq.
    * intros (?&?) (?&?) _ => //=. inversion 1; subst. apply /val_inj/Hinj => //=.
Qed.

Lemma Ex_max_partition l:
  Ex (rvar_comp (rvar_of_ldist (h l)) (λ x, Rmax (rsize (result x).1) (rsize (result x).2))) <=
   m (rsize l).
Proof.
  eapply Rle_trans; [ apply Ex_max_partition_sum | apply quicksort_cost.sum_le_m ].
Qed.

Definition T := λ x, rvar_comp (rvar_of_ldist (qs x)) (λ x, INR (span x)).
  Definition a x :=
    match Rle_dec x 1 with
      | left _ => 0
      | _ =>
        match Rlt_dec x 2 with
        | left _ => (x - 1)
        | _ => 1
        end
    end.
Definition h' x := rvar_comp (rvar_of_ldist (h x)) result.

Lemma Trec:
    ∀ x r,  pr_eq (T x) r =
            \big[Rplus/0]_(x' : imgT (h' x))
                        (pr_eq (h' x) (sval x') *
                         pr_eq (rvar_comp (rvar_pair (T (fst (sval x'))) (T (snd (sval x'))))
                                         (fun xy => Rmax (fst xy) (snd xy))) (r - a (rsize x))).
Proof.
  intros ls r.
  induction ls as [| a0 ls].
  - rewrite /T. rewrite -pr_mbind_mret.
    rewrite -(big_map _ (λ x, true)
     (λ x',
     (pr_eq (h' [::]) x' *
      pr_eq (rvar_comp
               (rvar_pair
                  (rvar_comp (rvar_of_ldist (qs x'.1)) (λ x, INR (span x)))
                  (rvar_comp (rvar_of_ldist (qs x'.2)) (λ x, INR (span x))))
               (λ xy : prod_eqType R_eqType R_eqType, Rmax xy.1 xy.2)) (r - a (rsize [::]))))).
    rewrite img_rvar_comp map_comp.
    rewrite img_rvar_of_ldist /h.
    rewrite big_cons big_nil Rplus_0_r.
    rewrite /a/rsize/size.
    replace (INR 0) with 0 by auto.
    destruct (Rlt_dec); last nra.
    specialize (pr_rvar_ldist ((x ← qs [::]; mret (INR (span x))))) => -> //=.
    rewrite big_cons big_nil /=.
    rewrite /pr_eq; rewrite 2!pr_eq_alt_comp.
    destruct (Rle_dec); last nra.

    rewrite -(big_map _ (λ x, true) (λ v, if result v == _ then
                                            pr_eq _ v
                                          else
                                            0)).
    rewrite -(big_map _ (λ x, true) (λ v, if Rmax (fst v) (snd v) == r - 0 then
                                            pr_eq _ v
                                          else
                                            0)).
    rewrite (eq_big_perm _ (img_pair_rv _ _ _ _)).
    rewrite allpairs_comp.
    rewrite img_rvar_comp map_comp (map_comp span).
    specialize (img_rvar_of_ldist (qs [::])) => ->.
    specialize (img_rvar_of_ldist (h [::])) => ->.
    rewrite ?big_cons ?big_nil ?Rplus_0_r //= ?Rminus_0_r.
    rewrite Rmax_left; last reflexivity.
    case: ifP; last (intros; field).
    rewrite pr_mret_simpl //=. intros. ring_simplify. rewrite pr_eq_rvar_pair //=.
    rewrite /pr_eq pr_eq_alt_comp.
    rewrite -(big_map _ (λ x, true) (λ v, if INR (span (v)) == 0 then pr_eq _ v else 0)).
    rewrite -(big_map _ (λ x, true) (λ v, if INR (span (v)) == 0 then pr_eq _ v else 0)).
    specialize (img_rvar_of_ldist (qs [::])) => -> //=.
    rewrite ?big_cons ?big_nil //= eq_refl.
    rewrite pr_mret_simpl //=. field.
  - destruct ls as [| b0 ls0].
    { rewrite /T. rewrite -pr_mbind_mret.
    rewrite -(big_map _ (λ x, true)
     (λ x',
     (pr_eq (h' _) x' *
      pr_eq (rvar_comp
               (rvar_pair
                  (rvar_comp (rvar_of_ldist (qs x'.1)) (λ x, INR (span x)))
                  (rvar_comp (rvar_of_ldist (qs x'.2)) (λ x, INR (span x))))
               (λ xy : prod_eqType R_eqType R_eqType, Rmax xy.1 xy.2)) (r - a (rsize _))))).
    rewrite img_rvar_comp map_comp.
    rewrite img_rvar_of_ldist /h.
    rewrite big_cons big_nil Rplus_0_r.
    rewrite /a/rsize/size.
    replace (INR 1) with 1 by auto.
    destruct (Rlt_dec); last nra.
    specialize (pr_rvar_ldist ((x ← qs [:: a0]; mret (INR (span x))))) => -> //=.
    rewrite big_cons big_nil /=.
    rewrite /h'/h.
    rewrite {1}/pr_eq. rewrite 1!pr_eq_alt_comp.
    rewrite -(big_map _ (λ x, true) (λ v, if (result v) == _ then
                                            pr_eq _ v
                                          else
                                            0)).
    specialize (img_rvar_of_ldist (h [::a0])) => ->. rewrite /h.
    rewrite ?big_cons ?big_nil ?Rplus_0_r //= ?Rminus_0_r.
    rewrite pr_mret_simpl //=. ring_simplify.
    rewrite {1}/pr_eq. rewrite 1!pr_eq_alt_comp.
    destruct (Rle_dec); last nra.
    rewrite /Rminus Ropp_0 Rplus_0_r.
    rewrite -(big_map _ (λ x, true) (λ v, if Rmax (fst v) (snd v) == r then
                                            pr_eq _ v
                                          else
                                            0)).
    rewrite (eq_big_perm _ (img_pair_rv _ _ _ _)).
    rewrite allpairs_comp.
    rewrite img_rvar_comp map_comp (map_comp span).
    specialize (img_rvar_of_ldist (qs [::])) => -> //=.
    rewrite ?big_cons ?big_nil //=. replace (INR 0) with 0 by auto.
    rewrite ?Rplus_0_r.
    rewrite Rmax_left; last reflexivity.
    case: ifP; intros; last field.
    rewrite pr_eq_rvar_pair.
    f_equal.
    * rewrite /pr_eq pr_eq_alt_comp.
      rewrite -(big_map _ (λ x, true) (λ v, if INR (span (v)) == 0 then pr_eq _ v else 0)).
      specialize (img_rvar_of_ldist (qs [::])) => -> //=.
      rewrite ?big_cons ?big_nil //= eq_refl.
      rewrite pr_mret_simpl //=. field.
    * rewrite /pr_eq pr_eq_alt_comp.
      rewrite -(big_map _ (λ x, true) (λ v, if INR (span (v)) == 0 then pr_eq _ v else 0)).
      specialize (img_rvar_of_ldist (qs [::])) => -> //=.
      rewrite ?big_cons ?big_nil //= eq_refl.
      rewrite pr_mret_simpl //=. field.
    }
    remember (b0 :: ls0) as ls eqn:Heql0.
   rewrite /T.
    rewrite qs_unfold.
    transitivity
  (pr_eq (rvar_comp (rvar_of_ldist
         ('(ll, lu) ← h (a0 :: ls);
            rpar2 (qs ll) (qs lu)
            )) (λ x, INR (span x)))  r); last first.
    {
      rewrite /h'.
    rewrite -(big_map _ (λ x, true)
     (λ x',
     (pr_eq (h' _) x' *
      pr_eq (rvar_comp
               (rvar_pair
                  (rvar_comp (rvar_of_ldist (qs x'.1)) (λ x, INR (span x)))
                  (rvar_comp (rvar_of_ldist (qs x'.2)) (λ x, INR (span x))))
               (λ xy : prod_eqType R_eqType R_eqType, Rmax xy.1 xy.2)) (r - a (rsize _))))).

    rewrite img_rvar_comp map_comp.
    rewrite img_rvar_of_ldist.
    rewrite (cost_bind_const (3 * (size (a0 :: ls)))%nat (S O)).
      * rewrite -undup_map. rewrite -map_comp.
        eapply eq_bigr. intros (ll&lu) _.
        f_equal.
        specialize (ldist_cost_rpair_span (qs ll) (qs lu)
                                    (λ x, INR (x + 1))) => ->.
        rewrite !rvar_pair_comp !rvar_comp_comp.
          rewrite {1}/pr_eq {1}[a in _ = a]/pr_eq.
          rewrite ?pr_eq_alt_comp /=. eapply eq_bigr => x ?.
          apply if_case_match. rewrite ?plus_INR ?Rmax_INR /rsize//=/a//=.
          rewrite Heql0 //=. specialize (S_INR (size ls0)) => /= => ->.
          destruct (Rlt_dec).
          {specialize (pos_INR (size ls0)). intros. nra. }
          destruct (Rle_dec); first nra.
          apply /eqP; apply /eqP. case: ifP; first by (move /eqP => ->; nra).
          move /eqP. intros. nra.
      * intros d'. rewrite map_comp. move /mapP. intros [? Hin Heq]. rewrite Heq.
        cut (cspec (h (a0 :: ls )) (λ x, work x = 3 * size (a0 :: ls)))%nat; first by auto.
        rewrite /h. rewrite Heql0. rewrite -Heql0.
        cbind (λ x, work x = O).
        {
          rewrite /draw_pivot.
          cbind (λ x, work x = O).
          { rewrite /cspec/coutput. destruct y as [w s a].
            rewrite /work. eapply unif_cost; auto. }
          intros ? => /= ->.
          apply cspec_mret => //=.
        }
        intros pv ->.
        cbind (λ x, work x = 3 * size (a0 :: ls))%nat.
        {
         eapply cspec_dist_ret.
         clear. rewrite /result. destruct pv as [w0 s0 (pv&?)]. rewrite /sval.
         apply (partition_work (a0 :: ls) pv).
        }
        intros ? ->.
        apply cspec_mret => //=. nify. omega.
      (* Should re-work the lemma, because much of this is tedious and the same,
         it's just the final application of work/span of partition calculation *)
      * intros d'. rewrite map_comp. move /mapP. intros [? Hin Heq]. rewrite Heq.
        cut (cspec (h (a0 :: ls )) (λ x, span x = 1))%nat; first by auto.
        rewrite /h. rewrite Heql0. rewrite -Heql0.
        cbind (λ x, span x = O).
        {
          rewrite /draw_pivot.
          cbind (λ x, span x = O).
          { rewrite /cspec/coutput. destruct y as [w s a].
            rewrite /work. eapply unif_cost; auto. }
          intros ? => /= ->.
          apply cspec_mret => //=.
        }
        intros pv ->.
        cbind (λ x, span x = 1)%nat.
        {
         eapply cspec_dist_ret.
         clear. rewrite /result. destruct pv as [w0 s0 (pv&?)]. rewrite /sval.
         apply (partition_span a0 ls pv).
        }
        intros ? ->.
        apply cspec_mret => //=.
    }
    (* TODO TODO: a good deal of this could be automated *)
    rewrite Heql0.
    rewrite /h.
    rewrite -?pr_mbind_mret.
    f_equal.
    apply outcomes_eq_dist.
    rewrite ?ldist_assoc.
    f_equal; eapply ldist_bind_ext.
    intros ?.
    eapply ldist_bind_ext.
    intros ?.
    rewrite ?ldist_assoc.
    eapply ldist_bind_ext.
    intros ?.
    rewrite ?ldist_assoc.
    rewrite ?ldist_left_id ?ldist_right_id.
    rewrite ?ldist_assoc.
    eapply ldist_bind_ext.
    intros ?.
    rewrite ?ldist_assoc.
    eapply ldist_bind_ext.
    intros ?.
    rewrite ?ldist_left_id ?ldist_right_id.
    f_equal => //=. f_equal. nify. omega.
Qed.

Definition k := -/ ln(3/4).

Theorem bound x w:
    rsize x > 1 →
    pr_gt (T x) ((k * ln (rsize x) + 1) + INR w)
       ≤ (rsize x) * (3/4)^w.
Proof.
  specialize (quicksort_rec.recurrence_span2.qs_span_bound _ _ _ _ T h' (λ x, true)).
  rewrite /size/rsize => Hrec. eapply Hrec; clear; try done.
  - intros l ?. rewrite //=.
    rewrite /quicksort_rec.recurrence_span2.size //=.
    cut (∀ n, INR (length (fst (result (rvar_of_ldist (h l) n)))) +
              INR (length (snd (result (rvar_of_ldist (h l) n)))) <=
                   INR (length l)); first by rewrite //=.
    intros n'. apply fun_to_cspec.
    rewrite /h.
    destruct l as [| a l].
    { apply cspec_mret => //=. replace (INR 0) with 0 by auto. nra. }
    destruct l as [| b l0].
    { apply cspec_mret => //=. replace (INR 0) with 0 by auto. replace (INR 1) with 1 by auto. nra. }
    remember (b::l0) as l eqn:Heql0.
    clear b l0 Heql0.
    eapply (cspec_mspec _ (λ x, INR (length (fst x)) + INR (length (snd x)) <= INR (length _))).
    tbind (λ x, sval x \in a :: l).
    { intros (?&?) => //. }
    intros (pv&Hin) _.
    tbind (λ x, lower (sval x) = [ seq n <- (a :: l) | ltn n pv] ∧
                middle (sval x) = [ seq n <- (a :: l) | n == pv] ∧
                upper (sval x) = [ seq n <- (a :: l) | ltn pv n]).
    { remember (a :: l) as l0 eqn:Heql0.
      apply mspec_mret => //=. clear. induction l0 as [|a l]; first by rewrite //=.
      rewrite //=; case (ltngtP a pv) => //= ?;
      destruct (IHl) as (?&?&?); repeat split; auto; f_equal; done.
    }
    remember (a :: l) as l0 eqn:Heql0.
    intros (spl&Hin') => //= ?. apply mspec_mret.
    move /andP in Hin'.
    destruct Hin' as (pf1&pf2); move /implyP in pf2.
    replace (length l0) with (size l0) by auto.
    rewrite -(perm_eq_size pf1) //= ?size_cat -?plusE //.
    assert (Hlt: (lt O (size (middle spl)))) by
            ( apply /ltP; apply pf2 => //=; destruct p; eauto; subst; rewrite //=).
    rewrite -plus_INR. apply le_INR. rewrite //=.
    assert (length (lower spl) = size (lower spl)) as Heq by auto.
    rewrite Heq. clear Heq.
    assert (length (upper spl) = size (upper spl)) as Heq by auto.
    rewrite Heq. clear Heq.
    clear -Hlt. rewrite //=. omega.
  - rewrite /quicksort_rec.recurrence_span2.size //=.
    intros l ? Hgt. rewrite //=.
    cut (∀ n, INR (length (fst (result (rvar_of_ldist (h l) n)))) +
              INR (length (snd (result (rvar_of_ldist (h l) n)))) <=
                   INR (length l) - 1); first by rewrite //=.
    intros n'. apply fun_to_cspec.
    rewrite /h.
    destruct l as [| a l].
    { move : Hgt. rewrite //=. replace (INR 0) with 0 by auto. nra. }
    destruct l as [| b l0].
    { move : Hgt. rewrite //=. replace (INR 1) with 1 by auto. nra. }
    remember (b::l0) as l eqn:Heql0.
    clear b l0 Heql0.
    eapply (cspec_mspec _ (λ x, INR (length (fst x)) + INR (length (snd x)) <= INR (length _) - 1)).
    tbind (λ x, sval x \in a :: l).
    { intros (?&?) => //. }
    intros (pv&Hin) _.
    tbind (λ x, lower (sval x) = [ seq n <- (a :: l) | ltn n pv] ∧
                middle (sval x) = [ seq n <- (a :: l) | n == pv] ∧
                upper (sval x) = [ seq n <- (a :: l) | ltn pv n]).
    { remember (a :: l) as l0 eqn:Heql0.
      apply mspec_mret => //=. clear. induction l0 as [|a l]; first by rewrite //=.
      rewrite //=; case (ltngtP a pv) => //= ?;
      destruct (IHl) as (?&?&?); repeat split; auto; f_equal; done.
    }
    remember (a :: l) as l0 eqn:Heql0.
    intros (spl&Hin') => //= ?. apply mspec_mret.
    move /andP in Hin'.
    destruct Hin' as (pf1&pf2); move /implyP in pf2.
    replace (length l0) with (size l0) by auto.
    rewrite -(perm_eq_size pf1) //= ?size_cat -?plusE //.
    assert (Hlt: (lt O (size (middle spl)))) by
            ( apply /ltP; apply pf2 => //=; destruct p; eauto; subst; rewrite //=).
    rewrite ?plus_INR.
    assert (length (lower spl) = size (lower spl)) as Heq by auto.
    rewrite Heq. clear Heq.
    assert (length (upper spl) = size (upper spl)) as Heq by auto.
    rewrite Heq. clear Heq.
    specialize (pos_INR (size (lower (spl)))).
    specialize (pos_INR (size (upper (spl)))).
    rewrite //=. intros.
    assert (Hge1: 1 <= INR (size (middle spl))).
    { replace 1 with (INR 1) by auto. apply le_INR. omega. }
    rewrite //= in Hge1. nra.
  - rewrite /quicksort_rec.recurrence_span2.size/quicksort_rec.recurrence_span2.rec_solution.d //=.
    intros x n Hle.
    replace 1 with (INR 1) in Hle by auto. apply INR_le in Hle.
    cut (INR (span (rvar_of_ldist (qs x) n)) = 0); first by rewrite //=.
    apply fun_to_cspec.
    destruct x; [| destruct x].
    * rewrite qs_unfold.
      apply cspec_mret => //=.
    * rewrite qs_unfold.
      apply cspec_mret => //=.
    * rewrite //= in Hle. omega.
  - intros. eapply (rec_pr_rec_gt _ rsize _ _ _ _ T h' (λ x, true) (λ xy, Rmax (fst xy) (snd xy)));
              auto; intros; apply Trec.
  - intros x.
    rewrite /quicksort_rec.recurrence_span2.size/quicksort_rec.recurrence_span2.rec_solution.d
            /quicksort_rec.recurrence_span2.rec_solution.m
            /quicksort_rec.recurrence_span2.qs_factor.alpha.
    etransitivity; first eapply Ex_max_partition.
    rewrite /m/rsize/size/length. do 2 destruct Rlt_dec; try nra.
Qed.


Require Import prosa.classic.util.all.
Require Import prosa.classic.model.arrival.basic.job prosa.classic.model.arrival.basic.task prosa.classic.model.priority.
Require Import prosa.classic.model.schedule.global.schedulability.
Require Import prosa.classic.model.schedule.global.basic.schedule prosa.classic.model.schedule.global.basic.platform.
Require Import prosa.classic.analysis.global.basic.workload_bound
               prosa.classic.analysis.global.basic.interference_bound_fp
               prosa.classic.analysis.global.basic.bertogna_fp_comp.
Require Import prosa.classic.implementation.job prosa.classic.implementation.task
               prosa.classic.implementation.arrival_sequence.
Require Import prosa.classic.implementation.global.basic.schedule.
From mathcomp Require Import ssreflect ssrbool ssrnat eqtype seq bigop div.

Module ResponseTimeAnalysisFP.

  Import Job Schedule SporadicTaskset Priority Schedulability Platform InterferenceBoundFP WorkloadBound ResponseTimeIterationFP.
  Import ConcreteJob ConcreteTask ConcreteArrivalSequence ConcreteScheduler.

  (* In this section, we instantiate a simple example to show that the theorems
     contain no contradictory assumptions. *)
  Section ExampleRTA.

    Let tsk1 := {| task_id := 1; task_cost := 2; task_period := 5; task_deadline := 3|}.
    Let tsk2 := {| task_id := 2; task_cost := 4; task_period := 6; task_deadline := 5|}.
    Let tsk3 := {| task_id := 3; task_cost := 3; task_period := 12; task_deadline := 11|}.

    (* Let ts be a task set containing these three tasks (sorted by rate-monotonic priority). *)
    Program Let ts := Build_set [:: tsk1; tsk2; tsk3] _.

    Section FactsAboutTaskset.

      Fact ts_has_valid_parameters:
        valid_sporadic_taskset task_cost task_period task_deadline ts.
      Proof.
        intros tsk IN.
        repeat (move: IN => /orP [/eqP EQ | IN]; subst; compute); by done.
      Qed.

      Fact ts_has_constrained_deadlines:
        forall tsk,
          tsk \in ts ->
          task_deadline tsk <= task_period tsk.
      Proof.
        intros tsk IN.
        repeat (move: IN => /orP [/eqP EQ | IN]; subst; compute); by done.
      Qed.

    End FactsAboutTaskset.

    (* Assume there are two processors. *)
    Let num_cpus := 2.

    (* Recall the FP RTA schedulability test. *)
    Let schedulability_test :=
      fp_schedulable task_cost task_period task_deadline num_cpus.

    (* Now we show that the schedulability test returns true. *)
    Fact schedulability_test_succeeds :
      schedulability_test ts = true.
    Proof.
      unfold schedulability_test, fp_schedulable, fp_claimed_bounds; simpl.
      unfold total_interference_bound_fp, div_floor.
      rewrite big_nil div0n addn0 /=.
      unfold div_floor; simpl.
      set I2 := total_interference_bound_fp task_cost task_period tsk2
                                            [:: (tsk1, 2)].
      assert (H1: I2 4 = 1).
      {
        by unfold I2, total_interference_bound_fp; rewrite big_cons big_nil; compute.
      }
      rewrite H1.
      have H2: 4 + 1 %/ num_cpus = 4 by compute.
      rewrite H2 H1 H2.
      have H3: 3 < 5 by compute.
      rewrite H3.
      unfold fp_bound_of_task.
      have H4: per_task_rta task_cost task_period num_cpus tsk3 [:: (tsk1, 2); (tsk2, 4)]
                            (max_steps task_cost task_deadline tsk3) = 5.
      {
        unfold per_task_rta; simpl.
        unfold total_interference_bound_fp at 9.
        rewrite !big_cons big_nil /=.
        unfold total_interference_bound_fp at 8.
        rewrite !big_cons big_nil /=.
        unfold total_interference_bound_fp at 7.
        rewrite !big_cons big_nil /=.
        unfold total_interference_bound_fp at 6.
        rewrite !big_cons big_nil /=.
        unfold total_interference_bound_fp at 5.
        rewrite !big_cons big_nil /=.
        unfold total_interference_bound_fp at 4.
        rewrite !big_cons big_nil /=.
        unfold total_interference_bound_fp at 3.
        rewrite !big_cons big_nil /=.
        unfold total_interference_bound_fp at 2.
        rewrite !big_cons big_nil /=.
        unfold total_interference_bound_fp at 1.
        by rewrite !big_cons big_nil /=; compute.
      }
      by rewrite H4.
    Qed.

    (* Let arr_seq be the periodic arrival sequence from ts. *)
    Let arr_seq := periodic_arrival_sequence ts.

    (* Assume rate-monotonic priorities. *)
    Let higher_priority := FP_to_JLDP job_task (RM task_period).

    Section FactsAboutPriorityOrder.

      Lemma ts_has_unique_priorities :
        FP_is_antisymmetric_over_task_set (RM task_period) ts.
      Proof.
        unfold RM; intros tsk tsk' IN IN' HP HP'.
        have EQ: task_period tsk = task_period tsk' by apply/eqP; rewrite eqn_leq HP HP'.
        clear HP HP'.
        rewrite !in_cons 2!in_nil 2!orbF in IN IN'; des; rewrite IN IN'; try (by done);
        subst tsk tsk'; simpl in *; by done.
      Qed.

      Lemma priority_is_total :
        FP_is_total_over_task_set (RM task_period) ts.
      Proof.
        unfold RM; intros tsk tsk' IN IN'.
        destruct (leqP (task_period tsk) (task_period tsk'));
          [by left | by right; apply ltnW].
      Qed.

    End FactsAboutPriorityOrder.

    (* Let sched be the work-conserving RM scheduler. *)
    Let sched := scheduler job_arrival job_cost num_cpus arr_seq higher_priority.

    (* Recall the definition of deadline miss. *)
    Let no_deadline_missed_by :=
      task_misses_no_deadline job_arrival job_cost job_deadline job_task arr_seq sched.

    (* Next, we prove that ts is schedulable with the result of the test. *)
    Corollary ts_is_schedulable:
      forall tsk,
        tsk \in ts ->
        no_deadline_missed_by tsk.
    Proof.
      intros tsk IN.
      have VALID := periodic_arrivals_valid_job_parameters ts ts_has_valid_parameters.
      have TSVALID := ts_has_valid_parameters.
      unfold valid_sporadic_job, valid_realtime_job in *; des.
      apply taskset_schedulable_by_fp_rta with (task_cost := task_cost)
       (task_period := task_period) (task_deadline := task_deadline)
       (ts0 := ts) (higher_priority0 := RM task_period); try (by done).
      - by apply ts_has_constrained_deadlines.
      - by apply ts_has_unique_priorities.
      - by apply priority_is_total.
      - by apply RM_is_transitive.
      - by apply periodic_arrivals_all_jobs_from_taskset.
      - by apply periodic_arrivals_are_sporadic.
      - by apply scheduler_jobs_come_from_arrival_sequence.
      - by apply scheduler_jobs_must_arrive_to_execute.
      - apply scheduler_completed_jobs_dont_execute.
        -- by apply periodic_arrivals_are_consistent.
        -- by apply periodic_arrivals_is_a_set.
      - apply scheduler_sequential_jobs.
        -- by apply periodic_arrivals_are_consistent.
        -- by apply periodic_arrivals_is_a_set.
      - by apply scheduler_work_conserving, periodic_arrivals_are_consistent.
      - apply scheduler_respects_policy.
        -- by apply periodic_arrivals_are_consistent.
        -- by intros t; apply RM_is_transitive.
        -- by intros t x y; apply leq_total.
      - by apply schedulability_test_succeeds.
    Qed.

  End ExampleRTA.

End ResponseTimeAnalysisFP.


Require Import Rel.Definitions.
Require Import Rel.BasicFacts.
Require Import Util.Subset.
Require Import Lang.Static.
Require Import Lang.StaticFacts.
Set Implicit Arguments.

Section section_compat_tm_app.

Context (EV HV V : Set).
Context (Ξ : XEnv EV HV).
Context (Γ : V → ty EV HV ∅).
Context (P : HV → F).
Context (T : ty EV HV ∅).
Context (𝓔 : eff EV HV ∅).
Context (v₁ v₂ : val EV HV V ∅).

Hint Resolve subset_trans subset_refl.

Lemma compat_tm_val n :
n ⊨ ⟦ Ξ P Γ ⊢ v₁ ≼ˡᵒᵍᵥ v₂ : T ⟧ →
n ⊨ ⟦ Ξ P Γ ⊢ v₁ ≼ˡᵒᵍ v₂ : T # 𝓔 ⟧.
Proof.
intro Ht.
iintro ξ₁ ; iintro ξ₂ ; iintro δ₁ ; iintro δ₂ ; iintro δ ;
iintro ρ₁ ; iintro ρ₂ ; iintro ρ ; iintro γ₁ ; iintro γ₂ ;
iintro Hξ ; iintro cl_δ ; iintro cl_ρ₁ρ₂ ; iintro Hρ ; iintro Hγ.
simpl.
apply 𝓥_in_𝓣.

iespecialize Ht.
repeat (ispecialize Ht ; [ eassumption | ]).
exact Ht.
Qed.

End section_compat_tm_app.


(* Set Implicit Arguments. *)

(* Require Import Coq.Program.Basics. *)
(* Require Import Coq.QArith.QArith. *)

(* Require Import order. *)
(* Require Import set. *)
(* Open Scope program_scope. *)
(* Open Scope set_scope. *)

(* Class MeasurableSpace (A : Type) (sigma : pow A) : Prop := *)
(*   { sigma_A : @full A ∈ sigma *)
(*   ; sigma_complement : forall U, U ∈ sigma -> ! U ∈ sigma *)
(*   ; sigma_union : forall seq : sequence (set A), *)
(*       (forall i, seq i ∈ sigma) -> *)
(*       countable_union seq ∈ sigma *)
(*   }. *)

(* Lemma sigma_empty (A : Type) `{meas : MeasurableSpace A} : *)
(*   ∅ A ∈ sigma. *)
(* Proof. *)
(*   destruct meas as [sigma_A sigma_comp ?]. *)
(*   rewrite <- complement_full_empty; firstorder. *)
(* Qed. *)

(* Lemma sigma_intersection (A : Type) *)
(*       `{meas : MeasurableSpace A} (seq : sequence (set A)) : *)
(*   (forall i, seq i ∈ sigma) -> *)
(*   countable_intersection seq ∈ sigma. *)
(* Admitted. *)

(* Class MeasureSpace (A : Type) `{MeasurableSpace A} (mu : set A -> Q) : Prop := *)
(*   { mu_empty : mu (∅ A) == 0 *)
(*     ; mu_add : forall seq : sequence (set A), *)
(*         (forall i j, i <> j -> disjoint (seq i) (seq j)) -> *)
(*         supremum (mu (countable_union seq)) (mu ∘ seq) *)
(*   }. *)

(* Definition is_measurable {A : Type} `{MeasurableSpace A} (U : set A) := U ∈ sigma. *)

(* Definition is_measurable_fun {A B : Type} *)
(*            `{MeasurableSpace A} `{MeasurableSpace B} (f : A -> B) := *)
(*   forall V, is_measurable V -> is_measurable (preimage f V). *)

(* (** Lifting a sigma-algebra to the option type. *) *)
(* Definition option_sigma {A : Type} (sigma : pow A) (U : option A -> Prop) : Prop := *)
(*   (fun x => Some x ∈ U) ∈ sigma. *)

(* Program Instance OptionMeasurableSpace {A : Type} `{MeasurableSpace A} *)
(*   : MeasurableSpace (option_sigma sigma). *)
(* Solve Obligations with firstorder. *)
(* Next Obligation. destruct H as [? ? Hunion]; apply Hunion, H0. Qed. *)

(* Definition discrete_sigma {A : Type} : pow A := const True. *)

(* Program Instance DiscreteMeasurableSpace {A : Type} *)
(*   : MeasurableSpace (@discrete_sigma A). *)
(* Solve Obligations with firstorder. *)

(* Definition partial_fun (A B : Type) : Type := A -> option B. *)