(**
This file is part of the Coquelicot formalization of real
analysis in Coq: http://coquelicot.saclay.inria.fr/

Copyright (C) 2011-2015 Sylvie Boldo
#
#
Copyright (C) 2011-2015 Catherine Lelay
#
#
Copyright (C) 2011-2015 Guillaume Melquiond

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 Reals ssreflect.

Require Import Rcomplements Rbar Hierarchy Compactness Lim_seq.

(** This file describes defineitions and properties of continuity on
[R] and on uniform spaces. It also contains many results about the
limit of a real function (predicates [is_lim] and [ex_lim] and total
function [Lim]). This limit may be either a real or an extended
real. *)

(** * Limit of fonctions *)

(** ** Definition *)

Definition is_lim (f : R -> R) (x l : Rbar) :=
  filterlim f (Rbar_locally' x) (Rbar_locally l).

Definition is_lim' (f : R -> R) (x l : Rbar) :=
  match l with
    | Finite l =>
      forall eps : posreal, Rbar_locally' x (fun y => Rabs (f y - l) < eps)
    | p_infty => forall M : R, Rbar_locally' x (fun y => M < f y)
    | m_infty => forall M : R, Rbar_locally' x (fun y => f y < M)
  end.
Definition ex_lim (f : R -> R) (x : Rbar) := exists l : Rbar, is_lim f x l.
Definition ex_finite_lim (f : R -> R) (x : Rbar) := exists l : R, is_lim f x l.
Definition Lim (f : R -> R) (x : Rbar) := Lim_seq (fun n => f (Rbar_loc_seq x n)).

Lemma is_lim_spec :
  forall f x l,
  is_lim' f x l <-> is_lim f x l.
Proof.
destruct l as [l| |] ; split.
- intros H P [eps LP].
  unfold filtermap.
  generalize (H eps).
  apply filter_imp.
  intros u.
  apply LP.
- intros H eps.
  apply (H (fun y => Rabs (y - l) < eps)).
  now exists eps.
- intros H P [M LP].
  unfold filtermap.
  generalize (H M).
  apply filter_imp.
  intros u.
  apply LP.
- intros H M.
  apply (H (fun y => M < y)).
  now exists M.
- intros H P [M LP].
  unfold filtermap.
  generalize (H M).
  apply filter_imp.
  intros u.
  apply LP.
- intros H M.
  apply (H (fun y => y < M)).
  now exists M.
Qed.

(** Equivalence with standard library Reals *)

Lemma is_lim_Reals_0 (f : R -> R) (x l : R) :
  is_lim f x l -> limit1_in f (fun y => y <> x) l x.
Proof.
  intros H e He.
  apply is_lim_spec in H.
  destruct (H (mkposreal e He)) as [d Hd].
  exists d ; split.
  apply cond_pos.
  intros y [H1 H2].
  now apply (Hd y).
Qed.
Lemma is_lim_Reals_1 (f : R -> R) (x l : R) :
  limit1_in f (fun y => y <> x) l x -> is_lim f x l.
Proof.
  intros H.
  apply is_lim_spec.
  intros [e He].
  destruct (H e He) as [d [Hd H']].
  exists (mkposreal d Hd).
  intros y Hy Hxy.
  apply (H' y).
  now split.
Qed.
Lemma is_lim_Reals (f : R -> R) (x l : R) :
  is_lim f x l <-> limit1_in f (fun y => y <> x) l x.
Proof.
  split ; [apply is_lim_Reals_0|apply is_lim_Reals_1].
Qed.

(** Composition *)

Lemma is_lim_comp' :
  forall {T} {F} {FF : @Filter T F} (f : T -> R) (g : R -> R) (x l : Rbar),
  filterlim f F (Rbar_locally x) -> is_lim g x l ->
  F (fun y => Finite (f y) <> x) ->
  filterlim (fun y => g (f y)) F (Rbar_locally l).
Proof.
intros T F FF f g x l Lf Lg Hf.
revert Lg.
apply filterlim_comp.
intros P HP.
destruct x as [x| |] ; try now apply Lf.
specialize (Lf _ HP).
unfold filtermap in Lf |- *.
generalize (filter_and _ _ Hf Lf).
apply filter_imp.
intros y [H Hi].
apply Hi.
contradict H.
now apply f_equal.
Qed.

Lemma is_lim_comp_seq (f : R -> R) (u : nat -> R) (x l : Rbar) :
  is_lim f x l ->
  eventually (fun n => Finite (u n) <> x) ->
  is_lim_seq u x -> is_lim_seq (fun n => f (u n)) l.
Proof.
intros Lf Hu Lu.
exact (is_lim_comp' u f x l Lu Lf Hu).
Qed.

(** Uniqueness *)

Lemma is_lim_unique (f : R -> R) (x l : Rbar) :
  is_lim f x l -> Lim f x = l.
Proof.
  intros.
  unfold Lim.
  rewrite (is_lim_seq_unique _ l) //.
  apply (is_lim_comp_seq f _ x l H).
  exists 1%nat => n Hn.
  case: x {H} => [x | | ] //=.
  apply Rbar_finite_neq, Rgt_not_eq, Rminus_lt_0.
  ring_simplify.
  by apply RinvN_pos.
  by apply is_lim_seq_Rbar_loc_seq.
Qed.
Lemma Lim_correct (f : R -> R) (x : Rbar) :
  ex_lim f x -> is_lim f x (Lim f x).
Proof.
  intros (l,H).
  replace (Lim f x) with l.
    apply H.
  apply sym_eq, is_lim_unique, H.
Qed.

Lemma ex_finite_lim_correct (f : R -> R) (x : Rbar) :
  ex_finite_lim f x <-> ex_lim f x /\ is_finite (Lim f x).
Proof.
  split.
  case => l Hf.
  move: (is_lim_unique f x l Hf) => Hf0.
  split.
  by exists l.
  by rewrite Hf0.
  case ; case => l Hf Hf0.
  exists (real l).
  rewrite -(is_lim_unique _ _ _ Hf).
  rewrite Hf0.
  by rewrite (is_lim_unique _ _ _ Hf).
Qed.
Lemma Lim_correct' (f : R -> R) (x : Rbar) :
  ex_finite_lim f x -> is_lim f x (real (Lim f x)).
Proof.
  intro Hf.
  apply ex_finite_lim_correct in Hf.
  rewrite (proj2 Hf).
  by apply Lim_correct, Hf.
Qed.

(** ** Operations and order *)

(** Extensionality *)

Lemma is_lim_ext_loc (f g : R -> R) (x l : Rbar) :
  Rbar_locally' x (fun y => f y = g y)
  -> is_lim f x l -> is_lim g x l.
Proof.
apply filterlim_ext_loc.
Qed.
Lemma ex_lim_ext_loc (f g : R -> R) (x : Rbar) :
  Rbar_locally' x (fun y => f y = g y)
  -> ex_lim f x -> ex_lim g x.
Proof.
  move => H [l Hf].
  exists l.
  by apply is_lim_ext_loc with f.
Qed.
Lemma Lim_ext_loc (f g : R -> R) (x : Rbar) :
  Rbar_locally' x (fun y => f y = g y)
  -> Lim g x = Lim f x.
Proof.
  move => H.
  apply sym_eq.
  apply Lim_seq_ext_loc.
  apply: filterlim_Rbar_loc_seq H.
Qed.

Lemma is_lim_ext (f g : R -> R) (x l : Rbar) :
  (forall y, f y = g y)
  -> is_lim f x l -> is_lim g x l.
Proof.
  move => H.
  apply is_lim_ext_loc.
  by apply filter_forall.
Qed.
Lemma ex_lim_ext (f g : R -> R) (x : Rbar) :
  (forall y, f y = g y)
  -> ex_lim f x -> ex_lim g x.
Proof.
  move => H [l Hf].
  exists l.
  by apply is_lim_ext with f.
Qed.
Lemma Lim_ext (f g : R -> R) (x : Rbar) :
  (forall y, f y = g y)
  -> Lim g x = Lim f x.
Proof.
  move => H.
  apply Lim_ext_loc.
  by apply filter_forall.
Qed.

(** Composition *)

Lemma is_lim_comp (f g : R -> R) (x k l : Rbar) :
  is_lim f l k -> is_lim g x l -> Rbar_locally' x (fun y => Finite (g y) <> l)
    -> is_lim (fun x => f (g x)) x k.
Proof.
intros Lf Lg Hg.
by apply (is_lim_comp' g f l k Lg Lf Hg).
Qed.
Lemma ex_lim_comp (f g : R -> R) (x : Rbar) :
  ex_lim f (Lim g x) -> ex_lim g x -> Rbar_locally' x (fun y => Finite (g y) <> Lim g x)
    -> ex_lim (fun x => f (g x)) x.
Proof.
  intros.
  exists (Lim f (Lim g x)).
  apply is_lim_comp with (Lim g x).
  by apply Lim_correct.
  by apply Lim_correct.
  by apply H1.
Qed.
Lemma Lim_comp (f g : R -> R) (x : Rbar) :
  ex_lim f (Lim g x) -> ex_lim g x -> Rbar_locally' x (fun y => Finite (g y) <> Lim g x)
    -> Lim (fun x => f (g x)) x = Lim f (Lim g x).
Proof.
  intros.
  apply is_lim_unique.
  apply is_lim_comp with (Lim g x).
  by apply Lim_correct.
  by apply Lim_correct.
  by apply H1.
Qed.

(** Identity *)

Lemma is_lim_id (x : Rbar) :
  is_lim (fun y => y) x x.
Proof.
intros P HP.
apply filterlim_id.
now apply Rbar_locally'_le.
Qed.
Lemma ex_lim_id (x : Rbar) :
  ex_lim (fun y => y) x.
Proof.
  exists x.
  by apply is_lim_id.
Qed.
Lemma Lim_id (x : Rbar) :
  Lim (fun y => y) x = x.
Proof.
  apply is_lim_unique.
  by apply is_lim_id.
Qed.

(** Constant *)

Lemma is_lim_const (a : R) (x : Rbar) :
  is_lim (fun _ => a) x a.
Proof.
intros P HP.
now apply filterlim_const.
Qed.
Lemma ex_lim_const (a : R) (x : Rbar) :
  ex_lim (fun _ => a) x.
Proof.
  exists a.
  by apply is_lim_const.
Qed.
Lemma Lim_const (a : R) (x : Rbar) :
  Lim (fun _ => a) x = a.
Proof.
  apply is_lim_unique.
  by apply is_lim_const.
Qed.

(** *** Additive operators *)

(** Opposite *)

Lemma is_lim_opp (f : R -> R) (x l : Rbar) :
  is_lim f x l -> is_lim (fun y => - f y) x (Rbar_opp l).
Proof.
intros Cf.
eapply filterlim_comp.
apply Cf.
apply filterlim_Rbar_opp.
Qed.
Lemma ex_lim_opp (f : R -> R) (x : Rbar) :
  ex_lim f x -> ex_lim (fun y => - f y) x.
Proof.
  case => l Hf.
  exists (Rbar_opp l).
  by apply is_lim_opp.
Qed.
Lemma Lim_opp (f : R -> R) (x : Rbar) :
  Lim (fun y => - f y) x = Rbar_opp (Lim f x).
Proof.
  rewrite -Lim_seq_opp.
  by apply Lim_seq_ext.
Qed.

(** Addition *)

Lemma is_lim_plus (f g : R -> R) (x lf lg l : Rbar) :
  is_lim f x lf -> is_lim g x lg ->
  is_Rbar_plus lf lg l ->
  is_lim (fun y => f y + g y) x l.
Proof.
intros Cf Cg Hp.
eapply filterlim_comp_2 ; try eassumption.
by apply filterlim_Rbar_plus.
Qed.
Lemma is_lim_plus' (f g : R -> R) (x : Rbar) (lf lg : R) :
  is_lim f x lf -> is_lim g x lg ->
  is_lim (fun y => f y + g y) x (lf + lg).
Proof.
  intros Hf Hg.
  eapply is_lim_plus.
  by apply Hf.
  by apply Hg.
  by [].
Qed.
Lemma ex_lim_plus (f g : R -> R) (x : Rbar) :
  ex_lim f x -> ex_lim g x ->
  ex_Rbar_plus (Lim f x) (Lim g x) ->
  ex_lim (fun y => f y + g y) x.
Proof.
  move => /Lim_correct Hf /Lim_correct Hg Hl.
  exists (Rbar_plus (Lim f x) (Lim g x)).
  eapply is_lim_plus ; try eassumption.
  by apply Rbar_plus_correct.
Qed.
Lemma Lim_plus (f g : R -> R) (x : Rbar) :
  ex_lim f x -> ex_lim g x ->
  ex_Rbar_plus (Lim f x) (Lim g x) ->
  Lim (fun y => f y + g y) x = Rbar_plus (Lim f x) (Lim g x).
Proof.
  move => /Lim_correct Hf /Lim_correct Hg Hl.
  apply is_lim_unique.
  eapply is_lim_plus ; try eassumption.
  by apply Rbar_plus_correct.
Qed.

(** Subtraction *)

Lemma is_lim_minus (f g : R -> R) (x lf lg l : Rbar) :
  is_lim f x lf -> is_lim g x lg ->
  is_Rbar_minus lf lg l ->
  is_lim (fun y => f y - g y) x l.
Proof.
  move => Hf Hg Hl.
  eapply is_lim_plus ; try eassumption.
  now apply is_lim_opp.
Qed.
Lemma is_lim_minus' (f g : R -> R) (x : Rbar) (lf lg : R) :
  is_lim f x lf -> is_lim g x lg ->
  is_lim (fun y => f y - g y) x (lf - lg).
Proof.
  intros Hf Hg.
  eapply is_lim_minus ; try eassumption.
  by [].
Qed.
Lemma ex_lim_minus (f g : R -> R) (x : Rbar) :
  ex_lim f x -> ex_lim g x ->
  ex_Rbar_minus (Lim f x) (Lim g x) ->
  ex_lim (fun y => f y - g y) x.
Proof.
  move => Hf Hg Hl.
  apply ex_lim_plus.
  by apply Hf.
  apply ex_lim_opp.
  by apply Hg.
  rewrite Lim_opp.
  by apply Hl.
Qed.
Lemma Lim_minus (f g : R -> R) (x : Rbar) :
  ex_lim f x -> ex_lim g x ->
  ex_Rbar_minus (Lim f x) (Lim g x) ->
  Lim (fun y => f y - g y) x = Rbar_minus (Lim f x) (Lim g x).
Proof.
  move => Hf Hg Hl.
  rewrite Lim_plus.
  by rewrite Lim_opp.
  by apply Hf.
  apply ex_lim_opp.
  by apply Hg.
  rewrite Lim_opp.
  by apply Hl.
Qed.

(** ** Multiplicative operators *)
(** Multiplicative inverse *)

Lemma is_lim_inv (f : R -> R) (x l : Rbar) :
  is_lim f x l -> l <> 0 -> is_lim (fun y => / f y) x (Rbar_inv l).
Proof.
  intros Hf Hl.
  apply filterlim_comp with (1 := Hf).
  now apply filterlim_Rbar_inv.
Qed.
Lemma ex_lim_inv (f : R -> R) (x : Rbar) :
  ex_lim f x -> Lim f x <> 0 -> ex_lim (fun y => / f y) x.
Proof.
  move => /Lim_correct Hf Hlf.
  exists (Rbar_inv (Lim f x)).
  by apply is_lim_inv.
Qed.
Lemma Lim_inv (f : R -> R) (x : Rbar) :
  ex_lim f x -> Lim f x <> 0 -> Lim (fun y => / f y) x = Rbar_inv (Lim f x).
Proof.
  move => /Lim_correct Hf Hlf.
  apply is_lim_unique.
  by apply is_lim_inv.
Qed.

(** Multiplication *)

Lemma is_lim_mult (f g : R -> R) (x lf lg : Rbar) :
  is_lim f x lf -> is_lim g x lg ->
  ex_Rbar_mult lf lg ->
  is_lim (fun y => f y * g y) x (Rbar_mult lf lg).
Proof.
intros Cf Cg Hp.
eapply filterlim_comp_2 ; try eassumption.
by apply filterlim_Rbar_mult, Rbar_mult_correct.
Qed.
Lemma ex_lim_mult (f g : R -> R) (x : Rbar) :
  ex_lim f x -> ex_lim g x ->
  ex_Rbar_mult (Lim f x) (Lim g x) ->
  ex_lim (fun y => f y * g y) x.
Proof.
  move => /Lim_correct Hf /Lim_correct Hg Hl.
  exists (Rbar_mult (Lim f x) (Lim g x)).
  now apply is_lim_mult.
Qed.
Lemma Lim_mult (f g : R -> R) (x : Rbar) :
  ex_lim f x -> ex_lim g x ->
  ex_Rbar_mult (Lim f x) (Lim g x) ->
  Lim (fun y => f y * g y) x = Rbar_mult (Lim f x) (Lim g x).
Proof.
  move => /Lim_correct Hf /Lim_correct Hg Hl.
  apply is_lim_unique.
  now apply is_lim_mult.
Qed.

(** Scalar multiplication *)

Lemma is_lim_scal_l (f : R -> R) (a : R) (x l : Rbar) :
  is_lim f x l -> is_lim (fun y => a * f y) x (Rbar_mult a l).
Proof.
  move => Hf.
  case: (Req_dec 0 a) => [<- {a} | Ha].
  rewrite Rbar_mult_0_l.
  apply is_lim_ext with (fun _ => 0).
  move => y ; by rewrite Rmult_0_l.
  by apply is_lim_const.

  apply is_lim_mult.
  by apply is_lim_const.
  by apply Hf.
  apply sym_not_eq in Ha.
  case: l {Hf} => [l | | ] //=.
Qed.
Lemma ex_lim_scal_l (f : R -> R) (a : R) (x : Rbar) :
  ex_lim f x -> ex_lim (fun y => a * f y) x.
Proof.
  case => l Hf.
  exists (Rbar_mult a l).
  by apply is_lim_scal_l.
Qed.
Lemma Lim_scal_l (f : R -> R) (a : R) (x : Rbar) :
  Lim (fun y => a * f y) x = Rbar_mult a (Lim f x).
Proof.
  apply Lim_seq_scal_l.
Qed.

Lemma is_lim_scal_r (f : R -> R) (a : R) (x l : Rbar) :
  is_lim f x l -> is_lim (fun y => f y * a) x (Rbar_mult l a).
Proof.
  move => Hf.
  rewrite Rbar_mult_comm.
  apply is_lim_ext with (fun y => a * f y).
  move => y ; by apply Rmult_comm.
  by apply is_lim_scal_l.
Qed.
Lemma ex_lim_scal_r (f : R -> R) (a : R) (x : Rbar) :
  ex_lim f x -> ex_lim (fun y => f y * a) x.
Proof.
  case => l Hf.
  exists (Rbar_mult l a).
  by apply is_lim_scal_r.
Qed.
Lemma Lim_scal_r (f : R -> R) (a : R) (x : Rbar) :
  Lim (fun y => f y * a) x = Rbar_mult (Lim f x) a.
Proof.
  rewrite Rbar_mult_comm -Lim_seq_scal_l.
  apply Lim_seq_ext.
  move => y ; by apply Rmult_comm.
Qed.

(** Division *)

Lemma is_lim_div (f g : R -> R) (x lf lg : Rbar) :
  is_lim f x lf -> is_lim g x lg -> lg <> 0 ->
  ex_Rbar_div lf lg ->
  is_lim (fun y => f y / g y) x (Rbar_div lf lg).
Proof.
  move => Hf Hg Hlg Hl.
  apply is_lim_mult ; try assumption.
  now apply is_lim_inv.
Qed.
Lemma ex_lim_div (f g : R -> R) (x : Rbar) :
  ex_lim f x -> ex_lim g x -> Lim g x <> 0 ->
  ex_Rbar_div (Lim f x) (Lim g x) ->
  ex_lim (fun y => f y / g y) x.
Proof.
  move => Hf Hg Hlg Hl.
  apply ex_lim_mult ; try assumption.
  now apply ex_lim_inv.
  now rewrite Lim_inv.
Qed.
Lemma Lim_div (f g : R -> R) (x : Rbar) :
  ex_lim f x -> ex_lim g x -> Lim g x <> 0 ->
  ex_Rbar_div (Lim f x) (Lim g x) ->
  Lim (fun y => f y / g y) x = Rbar_div (Lim f x) (Lim g x).
Proof.
  move => Hf Hg Hlg Hl.
  apply is_lim_unique.
  apply is_lim_div ; try apply Lim_correct ; assumption.
Qed.

(** Composition by linear functions *)

Lemma is_lim_comp_lin (f : R -> R) (a b : R) (x l : Rbar) :
  is_lim f (Rbar_plus (Rbar_mult a x) b) l -> a <> 0
  -> is_lim (fun y => f (a * y + b)) x l.
Proof.
  move => Hf Ha.
  apply is_lim_comp with (Rbar_plus (Rbar_mult a x) b).
  by apply Hf.
  eapply is_lim_plus.
  apply is_lim_scal_l.
  apply is_lim_id.
  apply is_lim_const.
  apply Rbar_plus_correct.
  case: (Rbar_mult a x) => //.
  case: x {Hf} => [x | | ] //=.
  exists (mkposreal _ Rlt_0_1) => y _ Hy.
  apply Rbar_finite_neq, Rminus_not_eq ; ring_simplify (a * y + b - (a * x + b)).
  rewrite -Rmult_minus_distr_l.
  apply Rmult_integral_contrapositive ; split.
  by [].
  by apply Rminus_eq_contra.
  exists 0 => x Hx.
  apply sym_not_eq in Ha.
  case: Rle_dec => // H.
  case: Rle_lt_or_eq_dec => //.
  exists 0 => x Hx.
  apply sym_not_eq in Ha.
  case: Rle_dec => // H.
  case: Rle_lt_or_eq_dec => //.
Qed.
Lemma ex_lim_comp_lin (f : R -> R) (a b : R) (x : Rbar) :
  ex_lim f (Rbar_plus (Rbar_mult a x) b)
  -> ex_lim (fun y => f (a * y + b)) x.
Proof.
  case => l Hf.
  case: (Req_dec a 0) => [-> {a Hf} | Ha].
  apply ex_lim_ext with (fun _ => f b).
  move => y ; by rewrite Rmult_0_l Rplus_0_l.
  by apply ex_lim_const.
  exists l ; by apply is_lim_comp_lin.
Qed.
Lemma Lim_comp_lin (f : R -> R) (a b : R) (x : Rbar) :
  ex_lim f (Rbar_plus (Rbar_mult a x) b) -> a <> 0 ->
  Lim (fun y => f (a * y + b)) x = Lim f (Rbar_plus (Rbar_mult a x) b).
Proof.
  move => Hf Ha.
  apply is_lim_unique.
  apply is_lim_comp_lin.
  by apply Lim_correct.
  exact: Ha.
Qed.

(** Continuity and limit *)

Lemma is_lim_continuity (f : R -> R) (x : R) :
  continuity_pt f x -> is_lim f x (f x).
Proof.
intros cf.
now apply continuity_pt_filterlim'.
Qed.
Lemma ex_lim_continuity (f : R -> R) (x : R) :
  continuity_pt f x -> ex_finite_lim f x.
Proof.
  move => Hf.
  exists (f x).
  by apply is_lim_continuity.
Qed.
Lemma Lim_continuity (f : R -> R) (x : R) :
  continuity_pt f x -> Lim f x = f x.
Proof.
  move => Hf.
  apply is_lim_unique.
  by apply is_lim_continuity.
Qed.

Lemma C0_extension_right {T : UniformSpace} (f : R -> T) lb (a b : R) :
   a
   (forall c : R, a < c  filterlim f (locally c) (locally (f c))) ->
   (filterlim f (at_left b) (locally lb)) ->
   {g : R -> T | (forall c, a < c -> filterlim g (locally c) (locally (g c)))
     /\ (forall c : R, c  g c = f c) /\ g b = lb}.
Proof.
  intros Hab ; intros.

  set g := fun x => match Rlt_dec x b with
                    | left _ => f x
                    | right _ => lb
                    end.
  assert (Gab : forall c : R, c  g c = f c).
    intros c Hcb.
    unfold g.
    by (case: Rlt_dec).
  assert (Gb : forall c : R, b <= c -> g c = lb).
    intros c Hbc.
    unfold g.
    case: Rlt_dec (Rle_not_lt _ _ Hbc) => //.

  exists g ; split.
  intros c Hac.
  case: (Rlt_le_dec c b) ; (try case) => Hbc.
  - apply filterlim_ext_loc with f.
    apply locally_interval with m_infty b => //= y _ Hyb.
    by apply sym_eq, Gab.
    rewrite Gab //.
    apply H ; by split.
  - rewrite Gb.
    2: by apply Rlt_le.
    eapply filterlim_ext_loc.
    2: by apply filterlim_const.
    apply locally_interval with b p_infty => //= y Hby _.
    apply sym_eq, Gb.
    by apply Rlt_le.
  - rewrite -Hbc => {c Hbc Hac}.
    rewrite Gb.
    2: by apply Rle_refl.
    apply filterlim_locally => eps /= {H}.
    destruct (proj1 (filterlim_locally _ _) H0 eps) as [d Hd].
    simpl in Hd.
    exists d => x Hx.
    case: (Rlt_le_dec x b) => Hxb.
    rewrite Gab //.
    by apply Hd.
    rewrite Gb //.
    by apply ball_center.
  - split.
    by apply Gab.
    apply Gb ; by apply Rle_refl.
Qed.
Lemma filterlim_Ropp_left (x : R) :
  filterlim Ropp (at_left x) (at_right (- x)).
Proof.
  move => P [d /= Hd].
  exists d => y /= Hy Hy'.
  apply Hd.
  rewrite /ball /= /AbsRing_ball /abs /minus /plus /opp /=.
  rewrite -Ropp_plus_distr Rabs_Ropp.
  by apply Hy.
  by apply Ropp_lt_contravar.
Qed.
Lemma filterlim_Ropp_right (x : R) :
  filterlim Ropp (at_right x) (at_left (- x)).
Proof.
  move => P [d /= Hd].
  exists d => y /= Hy Hy'.
  apply Hd.
  rewrite /ball /= /AbsRing_ball /abs /minus /plus /opp /=.
  rewrite -Ropp_plus_distr Rabs_Ropp.
  by apply Hy.
  by apply Ropp_lt_contravar.
Qed.

Lemma C0_extension_left {T : UniformSpace} (f : R -> T) la (a b : R) :
   a
   (forall c : R, a < c  filterlim f (locally c) (locally (f c))) ->
   (filterlim f (at_right a) (locally la)) ->
   {g : R -> T | (forall c, c  filterlim g (locally c) (locally (g c)))
     /\ (forall c : R, a < c -> g c = f c) /\ g a = la}.
Proof.
  intros.
  destruct (C0_extension_right (fun x => f (- x)) la (-b) (-a)) as [g Hg].
  by apply Ropp_lt_contravar.
  intros.
  eapply filterlim_comp.
  apply (filterlim_opp c).
  apply H0.
  split ; apply Ropp_lt_cancel ; rewrite Ropp_involutive ; by apply H2.
  eapply filterlim_comp.
  apply filterlim_Ropp_left.
  by rewrite Ropp_involutive.
  exists (fun x => g (- x)) ; split.
  intros c Hc.
  eapply filterlim_comp.
  apply (filterlim_opp c).
  by apply Hg, Ropp_lt_contravar.
  split.
  intros c Hc.
  rewrite (proj1 (proj2 Hg)).
  by rewrite Ropp_involutive.
  by apply Ropp_lt_contravar.
  by apply Hg.
Qed.

Lemma C0_extension_lt {T : UniformSpace} (f : R -> T) la lb (a b : R) :
  a
   (forall c : R, a < c  filterlim f (locally c) (locally (f c))) ->
   (filterlim f (at_right a) (locally la)) ->
   (filterlim f (at_left b) (locally lb)) ->
   {g : R -> T | (forall c, filterlim g (locally c) (locally (g c)))
     /\ (forall c : R, a < c  g c = f c) /\ g a = la /\ g b = lb}.
Proof.
  intros.
  destruct (C0_extension_left f la a b) as [g [Cg [Gab Ga]]] => //.
  destruct (C0_extension_right g lb a b) as [h [Ch [Hab Hb]]] => //.
  intros.
  apply Cg, H3.
  eapply filterlim_ext_loc.
  2: by apply H2.
  apply Rminus_lt_0 in H.
  exists (mkposreal _ H) => y /= Hy Hy'.
  apply sym_eq, Gab.
  apply Ropp_lt_cancel, (Rplus_lt_reg_l b).
  eapply Rle_lt_trans, Hy.
  rewrite -abs_opp opp_minus.
  apply Rle_abs.
  exists h ; repeat split.
  intros c.
  case: (Rlt_le_dec a c) => Hac.
  by apply Ch.
  rewrite Hab.
  eapply filterlim_ext_loc.
  2: apply Cg.
  apply locally_interval with m_infty b => //.
  by eapply Rle_lt_trans, H.
  intros y _ Hy ; by apply sym_eq, Hab.
  by eapply Rle_lt_trans, H.
  by eapply Rle_lt_trans, H.
  intros c [Hac Hcb].
  rewrite Hab => //.
  by apply Gab.
  by rewrite Hab.
  by [].
Qed.

Lemma C0_extension_le {T : UniformSpace} (f : R -> T) (a b : R) :
   (forall c : R, a <= c <= b -> filterlim f (locally c) (locally (f c))) ->
   {g : R -> T | (forall c, filterlim g (locally c) (locally (g c)))
     /\ (forall c : R, a <= c <= b -> g c = f c)}.
Proof.
  intros.
  case: (Rlt_le_dec a b) => Hab.

  destruct (C0_extension_lt f (f a) (f b) a b Hab) as [g [Cg [Gab [Ga Gb]]]].
  intros c Hc.
  apply H ; split ; apply Rlt_le, Hc.
  eapply filterlim_filter_le_1, H.
  by apply filter_le_within.
  intuition.
  eapply filterlim_filter_le_1, H.
  by apply filter_le_within.
  intuition.
  exists g ; repeat split => //.
  intros c [Hac Hcb].
  case: Hac => [ Hac | <-] //.
  case: Hcb => [ Hcb | ->] //.
  apply Gab ; by split.

  exists (fun _ => f a) ; split ; simpl.
  move => c.
  by apply filterlim_const.
  intros c [Hac Hca].
  case: Hab => Hab.
  contradict Hab ; apply Rle_not_lt.
  by apply Rle_trans with c.
  rewrite Hab in Hca.
  by apply f_equal, Rle_antisym.
Qed.

Lemma bounded_continuity {K : AbsRing} {V : NormedModule K}
  (f : R -> V) a b :
  (forall x, a <= x <= b -> filterlim f (locally x) (locally (f x)))
  -> {M : R | forall x, a <= x <= b -> norm (f x) < M}.
Proof.
  destruct (Rle_dec b a) as [Hab|Hab].
    exists (norm (f a) + 1).
    intros x [Hax Hxb].
    replace x with a.
    rewrite -{1}(Rplus_0_r (norm (f a))).
    apply Rplus_lt_compat_l, Rlt_0_1.
    apply Rle_antisym with (1 := Hax).
    now apply Rle_trans with b.
  apply Rnot_le_lt in Hab.

  wlog: f / (forall x, filterlim f (locally x) (locally (f x))) => [ Hw Cf | Cf _ ].
    destruct (C0_extension_le f a b) as [g [Cg Hg]].
    by apply Cf.
    destruct (Hw g) as [M HM] => //.
    exists M ; intros.
    rewrite -Hg //.
    by apply HM.

  assert (forall x : R, locally x (fun y : R => Rabs (norm (f y) - norm (f x)) < 1)).
    intro x.
    generalize (proj1 (filterlim_locally_ball_norm _ _) (Cf x)) => {Cf} Cf.
    apply: filter_imp (Cf (mkposreal _ Rlt_0_1)) => y Hy.
    apply Rle_lt_trans with (2 := Hy).
    apply norm_triangle_inv.
  assert (forall x y : R, Rabs (norm (f y) - norm (f x)) < 1 \/ ~ Rabs (norm (f y) - norm (f x)) < 1).
    intros x y ; edestruct Rlt_dec.
    left ; by apply r.
    by right.

  set delta := (fun (x : R) => proj1_sig (locally_ex_dec x _ (H0 x) (H x))).
  destruct (compactness_value_1d a b delta) as [d Hd].
  destruct (nfloor_ex ((b - a) / d)) as [N HN].
    apply Rdiv_le_0_compat.
    now apply Rlt_le, Rlt_Rminus.
    apply cond_pos.
  set (M := (fix g n := match n with O => 0 | S n => Rmax (norm (f (a + INR n * d)) + 3) (g n) end) (S N)).
  exists M => x Hx.
  apply Rnot_le_lt => H2.
  apply (Hd x Hx) ; case => t.
  unfold delta.
  case: locally_ex_dec => e /= He [Ht [Hxt Hde]].
  contradict H2 ; apply Rlt_not_le.
  move: (fun (y : R) Hy => He y (norm_compat1 _ _ _ Hy)) => {He} He.
  apply He in Hxt.
  rewrite -(Rabs_pos_eq (norm _) (norm_ge_0 _)).
  replace (norm (f x)) with ((norm (f x) - norm (f t)) + norm (f t))%R by ring.
  eapply Rle_lt_trans.
  apply Rabs_triang.
  eapply Rlt_trans.
  apply Rplus_lt_compat_r.
  by apply Hxt.
  rewrite Rplus_comm ; apply Rlt_minus_r.
  clear x Hx Hxt.
  destruct (nfloor_ex ((t - a) / d)) as [n Hn].
    apply Rdiv_le_0_compat.
    apply Rplus_le_reg_r with a.
    now ring_simplify.
    apply cond_pos.
  set (y := a + INR n * d).
  replace (norm (f t)) with (-(norm (f y) - norm (f t)) + norm (f y))%R by ring.
  eapply Rle_lt_trans.

  apply Rabs_triang.
  eapply Rlt_trans.
  apply Rplus_lt_compat_r.
  rewrite Rabs_Ropp.
  apply He.
  change (Rabs (a + INR n * d - t) < e).
  replace (a + INR n * d - t) with (-((t - a) / d - INR n) * d).
  rewrite Rabs_mult (Rabs_pos_eq d).
  2: apply Rlt_le, cond_pos.
  apply Rlt_le_trans with (1 * d).
  apply Rmult_lt_compat_r with (1 := cond_pos d).
  rewrite Rabs_Ropp Rabs_pos_eq.
  apply Rplus_lt_reg_r with (INR n).
  now rewrite /Rminus Rplus_assoc Rplus_opp_l Rplus_0_r (Rplus_comm 1).
  apply Rplus_le_reg_r with (INR n).
  now ring_simplify.
  now rewrite Rmult_1_l.
  field.
  apply Rgt_not_eq, cond_pos.

  apply Rplus_lt_reg_l with 1.
  ring_simplify.
  rewrite -> Rabs_pos_eq by apply norm_ge_0.
  assert (n < S N)%nat.
  apply INR_lt.
  apply Rle_lt_trans with (1 := proj1 Hn).
  rewrite S_INR.
  apply Rle_lt_trans with (2 := proj2 HN).
  apply Rmult_le_compat_r.
  apply Rlt_le, Rinv_0_lt_compat, cond_pos.
  now apply Rplus_le_compat_r.
  unfold M, y.
  clear -H1.
  induction N.
  apply Rlt_le_trans with (2 := Rmax_l _ _).
  destruct n.
  apply Rplus_lt_compat_l, Rplus_lt_compat_l.
  now apply (IZR_lt 1 2).
  now apply lt_S_n in H1.
  destruct (le_lt_eq_dec _ _ (lt_n_Sm_le _ _ H1)) as [H2|H2].
  apply Rlt_le_trans with (2 := Rmax_r _ _).
  now apply IHN.
  apply Rlt_le_trans with (2 := Rmax_l _ _).
  rewrite H2.
  apply Rplus_lt_compat_l, Rplus_lt_compat_l.
  now apply (IZR_lt 1 2).
Qed.

(** *** Order *)

Lemma is_lim_le_loc (f g : R -> R) (x lf lg : Rbar) :
  Rbar_locally' x (fun y => f y <= g y) ->
  is_lim f x lf -> is_lim g x lg ->
  Rbar_le lf lg.
Proof.
  apply filterlim_le.
Qed.

Lemma is_lim_le_p_loc (f g : R -> R) (x : Rbar) :
  Rbar_locally' x (fun y => f y <= g y) ->
  is_lim f x p_infty ->
  is_lim g x p_infty.
Proof.
  apply filterlim_ge_p_infty.
Qed.

Lemma is_lim_le_m_loc (f g : R -> R) (x : Rbar) :
  Rbar_locally' x (fun y => g y <= f y) ->
  is_lim f x m_infty ->
  is_lim g x m_infty.
Proof.
  apply filterlim_le_m_infty.
Qed.

Lemma is_lim_le_le_loc (f g h : R -> R) (x : Rbar) (l : Rbar) :
  Rbar_locally' x (fun y => f y <= h y <= g y) ->
  is_lim f x l -> is_lim g x l ->
  is_lim h x l.
Proof.
  apply filterlim_le_le.
Qed.

(** ** Generalized intermediate value theorem *)

Lemma IVT_gen (f : R -> R) (a b y : R) :
  Ranalysis1.continuity f
  -> Rmin (f a) (f b) <= y <= Rmax (f a) (f b)
  -> { x : R | Rmin a b <= x <= Rmax a b /\ f x = y }.
Proof.
  case: (Req_EM_T a b) => [ <- {b} | Hab].
    rewrite /Rmin /Rmax ; case: Rle_dec (Rle_refl a) (Rle_refl (f a)) ;
    case: Rle_dec => // _ _ _ _ Cf Hy.
    exists a ; split.
    split ; by apply Rle_refl.
    apply Rle_antisym ; by apply Hy.
  wlog: a b Hab / (a  [Hw | {Hab} Hab].
    case: (Rle_lt_dec a b) => Hab'.
    case: (Rle_lt_or_eq_dec _ _ Hab') => {Hab'} // Hab'.
    by apply Hw.
    rewrite (Rmin_comm (f a)) (Rmin_comm a) (Rmax_comm (f a)) (Rmax_comm a) ;
    apply Hw => //.
    by apply Rlt_not_eq.
  rewrite /(Rmin a) /(Rmax a) ; case: Rle_dec (Rlt_le _ _ Hab) => // _ _.
  wlog: f y / (f a <= f b) => [Hw |].
    case: (Rle_lt_dec (f a) (f b)) => Hf' Hf Hy.
    by apply Hw.
    case: (Hw (fun y => - f y) (- y)).
    by apply Ropp_le_contravar, Rlt_le.
    by apply Ranalysis1.continuity_opp.
    rewrite Rmin_opp_Rmax Rmax_opp_Rmin ;
    split ; apply Ropp_le_contravar, Hy.
    move => x [Hx Hfx].
    exists x ; intuition.
    by rewrite -(Ropp_involutive y) -Hfx Ropp_involutive.
  rewrite /Rmin /Rmax ; case: Rle_dec =>  // _ _.
  wlog: y / (f a < y < f b) => [Hw Hf Hy | Hy Hf _].
    case: Hy => Hay Hyb.
    case: (Rle_lt_or_eq_dec _ _ Hay) => {Hay} [Hay | <- ].
    case: (Rle_lt_or_eq_dec _ _ Hyb) => {Hyb} [Hyb | -> ].
    apply Hw ; intuition.
    exists b ; intuition.
    exists a ; intuition.

  case (IVT (fun x => f x - y) a b).
  apply Ranalysis1.continuity_minus.
  exact Hf.
  apply continuity_const.
  intros _ _ ; reflexivity.
  exact Hab.
  apply Rlt_minus_l ; rewrite Rplus_0_l ; apply Hy.
  apply Rlt_minus_r ; rewrite Rplus_0_l ; apply Hy.
  intros x [Hx Hfx].
  apply Rminus_diag_uniq in Hfx.
  by exists x.
Qed.

Lemma IVT_Rbar_incr (f : R -> R) (a b la lb : Rbar) (y : R) :
  is_lim f a la -> is_lim f b lb
  -> (forall (x : R), Rbar_lt a x -> Rbar_lt x b -> continuity_pt f x)
  -> Rbar_lt a b
  -> Rbar_lt la y /\ Rbar_lt y lb
  -> {x : R | Rbar_lt a x /\ Rbar_lt x b /\ f x = y}.
Proof.
intros Hfa Hfb Cf Hab Hy.
assert (Hb' : exists b' : R, Rbar_lt b' b /\
        is_upper_bound (fun x => Rbar_lt a x /\ Rbar_lt x b /\ f x <= y) b').
{ assert (Hfb' : Rbar_locally' b (fun x => y < f x)).
    apply Hfb.
    now apply (open_Rbar_gt' _ y).
  clear -Hab Hfb'.
  destruct b as [b| |].
  - destruct Hfb' as [eps He].
    exists (b - eps).
    split.
    apply Rminus_lt_0.
    replace (b - (b - eps)) with (pos eps) by ring.
    apply cond_pos.
    intros u [_ [H1 H2]].
    apply Rnot_lt_le.
    intros Hu.
    apply Rle_not_lt with (1 := H2).
    apply He.
    apply Rabs_lt_between'.
    split.
    exact Hu.
    apply Rlt_le_trans with (1 := H1).
    apply Rlt_le.
    apply Rminus_lt_0.
    replace (b + eps - b) with (pos eps) by ring.
    apply cond_pos.
    now apply Rlt_not_eq.
  - destruct Hfb' as [M HM].
    exists M.
    repeat split.
    intros u [_ [H1 H2]].
    apply Rnot_lt_le.
    intros Hu.
    apply Rle_not_lt with (1 := H2).
    now apply HM.
  - now destruct a. }
assert (Hex : exists x : R, Rbar_lt a x /\ Rbar_lt x b /\ f x <= y).
{ assert (Hfa' : Rbar_locally' a (fun x => Rbar_lt x b /\ f x < y)).
    apply filter_and.
    apply Rbar_locally'_le.
    now apply open_Rbar_lt'.
    apply (Hfa (fun u => u < y)).
    now apply (open_Rbar_lt' _ y).
  clear -Hab Hfa'.
  destruct a as [a| |].
  - destruct Hfa' as [eps He].
    exists (a + eps / 2).
    assert (Ha : a < a + eps / 2).
      apply Rminus_lt_0.
      replace (a + eps / 2 - a) with (eps / 2) by ring.
      apply is_pos_div_2.
    split.
    exact Ha.
    assert (H : Rbar_lt (a + eps / 2) b /\ (f (a + eps / 2) < y)).
      apply He.
      rewrite /ball /= /AbsRing_ball /abs /minus /plus /opp /=.
      replace (a + eps / 2 + - a) with (eps / 2) by ring.
      rewrite Rabs_pos_eq.
      apply Rlt_eps2_eps.
      apply cond_pos.
      apply Rlt_le.
      apply is_pos_div_2.
      now apply Rgt_not_eq.
    destruct H as [H1 H2].
    split.
    exact H1.
    now apply Rlt_le.
  - easy.
  - destruct Hfa' as [M HM].
    exists (M - 1).
    assert (H : Rbar_lt (M - 1) b /\ f (M - 1) < y).
      apply HM.
      apply Rminus_lt_0.
      replace (M - (M - 1)) with 1 by ring.
      apply Rlt_0_1.
    destruct H as [H1 H2].
    repeat split.
    exact H1.
    now apply Rlt_le. }
destruct (completeness (fun x => Rbar_lt a x /\ Rbar_lt x b /\ f x <= y)) as [x [Hub Hlub]].
destruct Hb' as [b' Hb'].
now exists b'.
exact Hex.
exists x.
destruct Hb' as [b' [Hb Hb']].
destruct Hex as [x' Hx'].
assert (Hax : Rbar_lt a x).
  apply Rbar_lt_le_trans with x'.
  apply Hx'.
  now apply Hub.
assert (Hxb : Rbar_lt x b).
  apply Rbar_le_lt_trans with b'.
  now apply Hlub.
  exact Hb.
repeat split ; try assumption.
specialize (Cf _ Hax Hxb).
apply continuity_pt_filterlim in Cf.
destruct (total_order_T (f x) y) as [[H|H]|H].
- assert (H': locally x (fun u => (Rbar_lt a u /\ Rbar_lt u b) /\ f u < y)).
    apply filter_and.
    apply filter_and.
    now apply open_Rbar_gt.
    now apply open_Rbar_lt.
    apply (Cf (fun u => u < y)).
    now apply open_lt.
  destruct H' as [eps H'].
  elim Rle_not_lt with x (x + eps / 2).
  apply Hub.
  destruct (H' (x + eps / 2)) as [[H1 H2] H3].
  rewrite /ball /= /AbsRing_ball /abs /minus /plus /opp /=.
  replace (x + eps / 2 + - x) with (eps / 2) by ring.
  rewrite Rabs_pos_eq.
  apply Rlt_eps2_eps.
  apply cond_pos.
  apply Rlt_le.
  apply is_pos_div_2.
  split.
  exact H1.
  split.
  exact H2.
  now apply Rlt_le.
  apply Rminus_lt_0.
  replace (x + eps / 2 - x) with (eps / 2) by ring.
  apply is_pos_div_2.
- exact H.
- assert (H': locally x (fun u => y < f u)).
    apply (Cf (fun u => y < u)).
    now apply open_gt.
  destruct H' as [eps H'].
  elim Rle_not_lt with (x - eps) x.
  apply Hlub.
  intros u Hfu.
  apply Rnot_lt_le.
  intros Hu.
  apply Rle_not_lt with (1 := proj2 (proj2 Hfu)).
  apply H'.
  apply Rabs_lt_between'.
  split.
  exact Hu.
  apply Rle_lt_trans with (1 := Hub u Hfu).
  apply Rminus_lt_0.
  replace (x + eps - x) with (pos eps) by ring.
  apply cond_pos.
  apply Rminus_lt_0.
  replace (x - (x - eps)) with (pos eps) by ring.
  apply cond_pos.
Qed.

Lemma IVT_Rbar_decr (f : R -> R) (a b la lb : Rbar) (y : R) :
  is_lim f a la -> is_lim f b lb
  -> (forall (x : R), Rbar_lt a x -> Rbar_lt x b -> continuity_pt f x)
  -> Rbar_lt a b
  -> Rbar_lt lb y /\ Rbar_lt y la
  -> {x : R | Rbar_lt a x /\ Rbar_lt x b /\ f x = y}.
Proof.
  move => Hla Hlb Cf Hab Hy.
  case: (IVT_Rbar_incr (fun x => - f x) a b (Rbar_opp la) (Rbar_opp lb) (-y)).
  by apply is_lim_opp.
  by apply is_lim_opp.
  move => x Hax Hxb.
  by apply continuity_pt_opp, Cf.
  by apply Hab.
  split ; apply Rbar_opp_lt ;
  rewrite Rbar_opp_involutive /Rbar_opp Ropp_involutive ;
  by apply Hy.
  move => x Hx ; exists x ; intuition.
  by rewrite -(Ropp_involutive y) -H4 Ropp_involutive.
Qed.

(** * 2D-continuity *)

(** ** Definitions *)

Definition continuity_2d_pt f x y :=
  forall eps : posreal, locally_2d (fun u v => Rabs (f u v - f x y) < eps) x y.

Lemma continuity_2d_pt_filterlim :
  forall f x y,
  continuity_2d_pt f x y <->
  filterlim (fun z : R * R => f (fst z) (snd z)) (locally (x,y)) (locally (f x y)).
Proof.
split.
- intros Cf P [eps He].
  specialize (Cf eps).
  apply locally_2d_locally in Cf.
  apply filter_imp with (2 := Cf).
  intros [u v].
  apply He.
- intros Cf eps.
  apply locally_2d_locally.
  specialize (Cf (fun z => Rabs (z - f x y) < eps)).
  unfold filtermap in Cf.
  apply Cf.
  now exists eps.
Qed.

Lemma uniform_continuity_2d :
  forall f a b c d,
  (forall x y, a <= x <= b -> c <= y <= d -> continuity_2d_pt f x y) ->
  forall eps : posreal, exists delta : posreal,
  forall x y u v,
  a <= x <= b -> c <= y <= d ->
  a <= u <= b -> c <= v <= d ->
  Rabs (u - x) < delta -> Rabs (v - y) < delta ->
  Rabs (f u v - f x y) < eps.
Proof.
intros f a b c d Cf eps.
set (P x y u v := Rabs (f u v - f x y) < pos_div_2 eps).
refine (_ (fun x y Hx Hy => locally_2d_ex_dec (P x y) x y _ (Cf x y Hx Hy _))).
intros delta1.
set (delta2 x y := match Rle_dec a x, Rle_dec x b, Rle_dec c y, Rle_dec y d with
  left Ha, left Hb, left Hc, left Hd => pos_div_2 (proj1_sig (delta1 x y (conj Ha Hb) (conj Hc Hd))) |
  _, _, _, _ => mkposreal _ Rlt_0_1 end).
destruct (compactness_value_2d a b c d delta2) as (delta,Hdelta).
exists (pos_div_2 delta) => x y u v Hx Hy Hu Hv Hux Hvy.
specialize (Hdelta x y Hx Hy).
apply Rnot_le_lt.
apply: false_not_not Hdelta => Hdelta.
apply Rlt_not_le.
destruct Hdelta as (p&q&(Hap,Hpb)&(Hcq,Hqd)&Hxp&Hyq&Hd).
replace (f u v - f x y) with (f u v - f p q + (f p q - f x y)) by ring.
apply Rle_lt_trans with (1 := Rabs_triang _ _).
rewrite (double_var eps).
revert Hxp Hyq Hd.
unfold delta2.
case Rle_dec => Hap' ; try easy.
case Rle_dec => Hpb' ; try easy.
case Rle_dec => Hcq' ; try easy.
case Rle_dec => Hqd' ; try easy.
clear delta2.
case delta1 => /= r Hr Hxp Hyq Hd.
apply Rplus_lt_compat.
apply Hr.
replace (u - p) with (u - x + (x - p)) by ring.
apply Rle_lt_trans with (1 := Rabs_triang _ _).
rewrite (double_var r).
apply Rplus_lt_compat with (2 := Hxp).
apply Rlt_le_trans with (2 := Hd).
apply Rlt_trans with (1 := Hux).
apply: Rlt_eps2_eps.
apply cond_pos.
replace (v - q) with (v - y + (y - q)) by ring.
apply Rle_lt_trans with (1 := Rabs_triang _ _).
rewrite (double_var r).
apply Rplus_lt_compat with (2 := Hyq).
apply Rlt_le_trans with (2 := Hd).
apply Rlt_trans with (1 := Hvy).
apply: Rlt_eps2_eps.
apply cond_pos.
rewrite Rabs_minus_sym.
apply Hr.
apply Rlt_trans with (1 := Hxp).
apply Rlt_eps2_eps.
apply cond_pos.
apply Rlt_trans with (1 := Hyq).
apply Rlt_eps2_eps.
apply cond_pos.
intros u v.
unfold P.
destruct (Rlt_dec (Rabs (f u v - f x y)) (pos_div_2 eps)) ; [left|right]; assumption.
Qed.

Lemma uniform_continuity_2d_1d :
  forall f a b c,
  (forall x, a <= x <= b -> continuity_2d_pt f x c) ->
  forall eps : posreal, exists delta : posreal,
  forall x y u v,
  a <= x <= b -> c - delta <= y <= c + delta ->
  a <= u <= b -> c - delta <= v <= c + delta ->
  Rabs (u - x) < delta ->
  Rabs (f u v - f x y) < eps.
Proof.
intros f a b c Cf eps.
set (P x y u v := Rabs (f u v - f x y) < pos_div_2 eps).
refine (_ (fun x Hx => locally_2d_ex_dec (P x c) x c _ (Cf x Hx _))).
intros delta1.
set (delta2 x := match Rle_dec a x, Rle_dec x b with
  left Ha, left Hb => pos_div_2 (proj1_sig (delta1 x (conj Ha Hb))) |
  _, _ => mkposreal _ Rlt_0_1 end).
destruct (compactness_value_1d a b delta2) as (delta,Hdelta).
exists (pos_div_2 delta) => x y u v Hx Hy Hu Hv Hux.
specialize (Hdelta x Hx).
apply Rnot_le_lt.
apply: false_not_not Hdelta => Hdelta.
apply Rlt_not_le.
destruct Hdelta as (p&(Hap,Hpb)&Hxp&Hd).
replace (f u v - f x y) with (f u v - f p c + (f p c - f x y)) by ring.
apply Rle_lt_trans with (1 := Rabs_triang _ _).
rewrite (double_var eps).
revert Hxp Hd.
unfold delta2.
case Rle_dec => Hap' ; try easy.
case Rle_dec => Hpb' ; try easy.
clear delta2.
case delta1 => /= r Hr Hxp Hd.
apply Rplus_lt_compat.
apply Hr.
replace (u - p) with (u - x + (x - p)) by ring.
apply Rle_lt_trans with (1 := Rabs_triang _ _).
rewrite (double_var r).
apply Rplus_lt_compat with (2 := Hxp).
apply Rlt_le_trans with (2 := Hd).
apply Rlt_trans with (1 := Hux).
apply: Rlt_eps2_eps.
apply cond_pos.
apply Rle_lt_trans with (pos_div_2 delta).
now apply Rabs_le_between'.
apply Rlt_le_trans with(1 := Rlt_eps2_eps _ (cond_pos delta)).
apply Rle_trans with (1 := Hd).
apply Rlt_le.
apply Rlt_eps2_eps.
apply cond_pos.
rewrite Rabs_minus_sym.
apply Hr.
apply Rlt_trans with (1 := Hxp).
apply Rlt_eps2_eps.
apply cond_pos.
apply Rle_lt_trans with (pos_div_2 delta).
now apply Rabs_le_between'.
apply Rlt_le_trans with(1 := Rlt_eps2_eps _ (cond_pos delta)).
apply Rle_trans with (1 := Hd).
apply Rlt_le.
apply Rlt_eps2_eps.
apply cond_pos.
intros u v.
unfold P.
destruct (Rlt_dec (Rabs (f u v - f x c)) (pos_div_2 eps)); [left|right] ; assumption.
Qed.

Lemma uniform_continuity_2d_1d' :
  forall f a b c,
  (forall x, a <= x <= b -> continuity_2d_pt f c x) ->
  forall eps : posreal, exists delta : posreal,
  forall x y u v,
  a <= x <= b -> c - delta <= y <= c + delta ->
  a <= u <= b -> c - delta <= v <= c + delta ->
  Rabs (u - x) < delta ->
  Rabs (f v u - f y x) < eps.
Proof.
intros f a b c Cf eps.
assert (T:(forall x : R, a <= x <= b -> continuity_2d_pt (fun x0 y : R => f y x0) x c) ).
intros x Hx e.
destruct (Cf x Hx e) as (d,Hd).
exists d.
intros; now apply Hd.
destruct (uniform_continuity_2d_1d (fun x y => f y x) a b c T eps) as (d,Hd).
exists d; intros.
now apply Hd.
Qed.

Lemma continuity_2d_pt_neq_0 :
  forall f x y,
  continuity_2d_pt f x y -> f x y <> 0 ->
  locally_2d (fun u v => f u v <> 0) x y.
Proof.
intros f x y Cf H.
apply continuity_2d_pt_filterlim in Cf.
apply locally_2d_locally.
apply (Cf (fun y => y <> 0)).
now apply open_neq.
Qed.

(** ** Operations *)

(** Identity *)

Lemma continuity_pt_id :
  forall x, continuity_pt (fun x => x) x.
Proof.
intros x.
apply continuity_pt_filterlim.
now intros P.
Qed.

Lemma continuity_2d_pt_id1 :
  forall x y, continuity_2d_pt (fun u v => u) x y.
Proof.
  intros x y eps; exists eps; tauto.
Qed.

Lemma continuity_2d_pt_id2 :
  forall x y, continuity_2d_pt (fun u v => v) x y.
Proof.
  intros x y eps; exists eps; tauto.
Qed.

(** Constant functions *)

Lemma continuity_2d_pt_const :
  forall x y c, continuity_2d_pt (fun u v => c) x y.
Proof.
  intros x y c eps; exists eps; rewrite Rminus_eq_0 Rabs_R0.
  intros; apply cond_pos.
Qed.

(** *** Extensionality *)

Lemma continuity_pt_ext_loc :
  forall f g x,
  locally x (fun x => f x = g x) ->
  continuity_pt f x -> continuity_pt g x.
Proof.
intros f g x Heq Cf.
apply continuity_pt_filterlim in Cf.
apply continuity_pt_filterlim.
rewrite -(locally_singleton _ _ Heq).
by apply filterlim_ext_loc with f.
Qed.

Lemma continuity_pt_ext :
  forall f g x,
  (forall x, f x = g x) ->
  continuity_pt f x -> continuity_pt g x.
Proof.
intros f g x Heq.
apply continuity_pt_ext_loc.
by apply filter_forall.
Qed.

Lemma continuity_2d_pt_ext_loc :
  forall f g x y,
  locally_2d (fun u v => f u v = g u v) x y ->
  continuity_2d_pt f x y -> continuity_2d_pt g x y.
Proof.
intros f g x y Heq Cf.
apply locally_2d_locally in Heq.
apply continuity_2d_pt_filterlim in Cf.
apply continuity_2d_pt_filterlim.
rewrite -(locally_singleton _ _ Heq).
apply filterlim_ext_loc with (2 := Cf).
by apply Heq.
Qed.

Lemma continuity_2d_pt_ext :
  forall f g x y,
  (forall x y, f x y = g x y) ->
  continuity_2d_pt f x y -> continuity_2d_pt g x y.
Proof.
intros f g x y Heq.
apply continuity_2d_pt_ext_loc.
apply locally_2d_locally.
apply filter_forall.
now intros [u v].
Qed.

(** *** Composition *)

Lemma continuity_1d_2d_pt_comp :
  forall f g x y,
  continuity_pt f (g x y) ->
  continuity_2d_pt g x y ->
  continuity_2d_pt (fun x y => f (g x y)) x y.
Proof.
intros f g x y Cf Cg.
apply continuity_pt_filterlim in Cf.
apply continuity_2d_pt_filterlim in Cg.
apply continuity_2d_pt_filterlim.
apply: filterlim_comp Cg Cf.
Qed.

(** *** Additive operators *)

Lemma continuity_2d_pt_opp (f : R -> R -> R) (x y : R) :
  continuity_2d_pt f x y ->
  continuity_2d_pt (fun u v => - f u v) x y.
Proof.
apply continuity_1d_2d_pt_comp.
apply continuity_pt_opp.
apply continuity_pt_id.
Qed.

Lemma continuity_2d_pt_plus (f g : R -> R -> R) (x y : R) :
  continuity_2d_pt f x y ->
  continuity_2d_pt g x y ->
  continuity_2d_pt (fun u v => f u v + g u v) x y.
Proof.
intros Cf Cg.
apply continuity_2d_pt_filterlim in Cf.
apply continuity_2d_pt_filterlim in Cg.
apply continuity_2d_pt_filterlim.
eapply filterlim_comp_2.
apply Cf.
apply Cg.
apply: filterlim_plus.
Qed.

Lemma continuity_2d_pt_minus (f g : R -> R -> R) (x y : R) :
  continuity_2d_pt f x y ->
  continuity_2d_pt g x y ->
  continuity_2d_pt (fun u v => f u v - g u v) x y.
Proof.
  move => Cf Cg.
  apply continuity_2d_pt_plus.
  exact: Cf.
  by apply continuity_2d_pt_opp.
Qed.

(** *** Multiplicative operators *)

Lemma continuity_2d_pt_inv (f : R -> R -> R) (x y : R) :
  continuity_2d_pt f x y ->
  f x y <> 0 ->
  continuity_2d_pt (fun u v => / f u v) x y.
Proof.
intros Cf Df.
apply continuity_2d_pt_filterlim in Cf.
apply continuity_2d_pt_filterlim.
apply filterlim_comp with (1 := Cf).
apply (filterlim_Rbar_inv (f x y)).
contradict Df.
now injection Df.
Qed.

Lemma continuity_2d_pt_mult (f g : R -> R -> R) (x y : R) :
  continuity_2d_pt f x y ->
  continuity_2d_pt g x y ->
  continuity_2d_pt (fun u v => f u v * g u v) x y.
Proof.
intros Cf Cg.
apply continuity_2d_pt_filterlim in Cf.
apply continuity_2d_pt_filterlim in Cg.
apply continuity_2d_pt_filterlim.
eapply filterlim_comp_2.
apply Cf.
apply Cg.
by apply (filterlim_Rbar_mult (f x y) (g x y) (f x y * g x y)).
Qed.

(** * Continuity in Uniform Spaces *)

(** ** Continuity *)

Section Continuity.

Context {T U : UniformSpace}.

Definition continuous_on (D : T -> Prop) (f : T -> U) :=
  forall x, D x -> filterlim f (within D (locally x)) (locally (f x)).

Definition continuous (f : T -> U) (x : T) :=
  filterlim f (locally x) (locally (f x)).

Lemma continuous_continuous_on :
  forall (D : T -> Prop) (f : T -> U) (x : T),
  locally x D ->
  continuous_on D f ->
  continuous f x.
Proof.
intros D f x Dx CD P Pfx.
assert (Dx' := locally_singleton _ _ Dx).
generalize (filter_and _ _ Dx (CD x Dx' P Pfx)).
unfold filtermap, within.
apply filter_imp.
intros t [H1 H2].
now apply H2.
Qed.

Lemma continuous_on_subset :
  forall (D E : T -> Prop) (f : T -> U),
  (forall x, E x -> D x) ->
  continuous_on D f ->
  continuous_on E f.
Proof.
intros D E f H CD x Ex P Pfx.
generalize (CD x (H x Ex) P Pfx).
unfold filtermap, within.
apply filter_imp.
intros t H' Et.
now apply H', H.
Qed.

Lemma continuous_on_forall :
  forall (D : T -> Prop) (f : T -> U),
  (forall x, D x -> continuous f x) ->
  continuous_on D f.
Proof.
intros D f H x Dx P Pfx.
generalize (H x Dx P Pfx).
unfold filtermap, within.
now apply filter_imp.
Qed.

Lemma continuous_ext_loc (f g : T -> U) (x : T) :
  locally x (fun y : T => g y = f y)
  -> continuous g x -> continuous f x.
Proof.
  intros.
  eapply filterlim_ext_loc.
  by apply H.
  by rewrite -(locally_singleton _ _ H).
Qed.
Lemma continuous_ext :
  forall (f g : T -> U) (x : T),
  (forall x, f x = g x) ->
  continuous f x ->
  continuous g x.
Proof.
intros f g x H Cf.
apply filterlim_ext with (1 := H).
now rewrite <- H.
Qed.

Lemma continuous_on_ext :
  forall (D : T -> Prop) (f g : T -> U),
  (forall x, D x -> f x = g x) ->
  continuous_on D f ->
  continuous_on D g.
Proof.
intros D f g H Cf x Dx.
apply filterlim_within_ext with (1 := H).
rewrite <- H with (1 := Dx).
now apply Cf.
Qed.

End Continuity.

Lemma continuous_comp {U V W : UniformSpace} (f : U -> V) (g : V -> W) (x : U) :
  continuous f x -> continuous g (f x)
  -> continuous (fun x => g (f x)) x.
Proof.
  by apply filterlim_comp.
Qed.
Lemma continuous_comp_2 {U V W X : UniformSpace}
  (f : U -> V) (g : U -> W) (h : V -> W -> X) (x : U) :
  continuous f x -> continuous g x
  -> continuous (fun (x : V * W) => h (fst x) (snd x)) (f x,g x)
  -> continuous (fun x => h (f x) (g x)) x.
Proof.
  intros Cf Cg Ch.
  eapply filterlim_comp_2.
  by apply Cf.
  by apply Cg.
  apply filterlim_locally => eps.
  case: (proj1 (filterlim_locally _ _) Ch eps) => /= del Hdel.
  rewrite {1}/ball /= /prod_ball /= in Hdel.
  exists (fun y => ball (f x) (pos del) y) (fun y => ball (g x) (pos del) y).
  apply locally_ball.
  apply locally_ball.
  move => y z /= Hy Hz.
  apply (Hdel (y,z)).
  by split.
Qed.

Lemma is_lim_comp_continuous (f g : R -> R) (x : Rbar) (l : R) :
  is_lim f x l -> continuous g l
    -> is_lim (fun x => g (f x)) x (g l).
Proof.
  intros Hf Hg.
  apply filterlim_locally => eps.
  destruct (proj1 (filterlim_locally _ _) Hg eps) as [e He] ; clear Hg.
  eapply filter_imp.
  intros y Hy.
  apply He, Hy.
  by apply Hf, locally_ball.
Qed.

Lemma continuous_fst {U V : UniformSpace} (x : U) (y : V) :
  continuous (fst (B:=V)) (x, y).
Proof.
  intros P [d Hd].
  exists d => z [/= Hz1 Hz2].
  by apply Hd => /=.
Qed.
Lemma continuous_snd {U V : UniformSpace} (x : U) (y : V) :
  continuous (snd (B:=V)) (x, y).
Proof.
  intros P [d Hd].
  exists d => z [/= Hz1 Hz2].
  by apply Hd => /=.
Qed.

Lemma continuous_const {U V : UniformSpace} (c : V) (x : U) :
  continuous (fun _ => c) x.
Proof.
  apply filterlim_const.
Qed.

Lemma continuous_id {U : UniformSpace} (x : U) :
  continuous (fun y => y) x.
Proof.
  apply filterlim_id.
Qed.

Section Continuity_op.

Context {U : UniformSpace} {K : AbsRing} {V : NormedModule K}.

Lemma continuous_opp (f : U -> V) (x : U) :
  continuous f x ->
  continuous (fun x : U => opp (f x)) x.
Proof.
  intros.
  eapply filterlim_comp.
  by apply H.
  apply (filterlim_opp (f x)).
Qed.

Lemma continuous_plus (f g : U -> V) (x : U) :
  continuous f x -> continuous g x ->
  continuous (fun x : U => plus (f x) (g x)) x.
Proof.
  intros.
  eapply filterlim_comp_2.
  by apply H.
  by apply H0.
  apply (filterlim_plus (f x) (g x)).
Qed.

Lemma continuous_minus (f g : U -> V) (x : U) :
  continuous f x -> continuous g x ->
  continuous (fun x : U => minus (f x) (g x)) x.
Proof.
  intros.
  apply continuous_plus.
  apply H.
  by apply continuous_opp.
Qed.

Lemma continuous_scal (k : U -> K) (f : U -> V) (x : U) :
  continuous k x -> continuous f x -> continuous (fun y => scal (k y) (f y)) x.
Proof.
  intros.
  by eapply filterlim_comp_2, filterlim_scal.
Qed.
Lemma continuous_scal_r (k : K) (f : U -> V) (x : U) :
  continuous f x -> continuous (fun y => scal k (f y)) x.
Proof.
  intros.
  by apply continuous_comp, filterlim_scal_r.
Qed.
Lemma continuous_scal_l (f : U -> K) (k : V) (x : U) :
  continuous f x -> continuous (fun y => scal (f y) k) x.
Proof.
  intros.
  apply (continuous_comp f (fun y => scal y k)) => //.
  apply filterlim_scal_l.
Qed.

End Continuity_op.

Lemma continuous_mult {U : UniformSpace} {K : AbsRing}
  (f g : U -> K) (x : U) :
  continuous f x -> continuous g x
  -> continuous (fun y => mult (f y) (g y)) x.
Proof.
  intros.
  by eapply filterlim_comp_2, filterlim_mult.
Qed.

Section UnifCont.

Context {V : UniformSpace}.

Lemma unifcont_1d (f : R -> V) a b :
  (forall x, a <= x <= b -> continuous f x) ->
  forall eps : posreal, {delta : posreal | forall x y,
    a <= x <= b -> a <= y <= b -> ball x delta y -> ~~ ball (f x) eps (f y)}.
Proof.
  intros Cf eps.
  wlog: f Cf / (forall z : R, continuous f z) => [ Hw | {Cf} Cf ].
    destruct (C0_extension_le f a b) as [g [Cg Hg]].
    by apply Cf.
    destruct (Hw g) as [d Hd].
    intros x Hx ; apply Cg.
    apply Cg.
    exists d => x y Hx Hy Hxy.
    rewrite -!Hg //.
    by apply Hd.

  assert (forall (x : R), {delta : posreal | forall y : R,
    ball x delta y -> ~~ ball (f x) (pos_div_2 eps) (f y)}).
    move: (pos_div_2 eps) => {eps} eps x.
    assert (Rbar_lt 0 (Lub.Lub_Rbar (fun d => forall y : R, ball x d y -> ball (f x) eps (f y)))).
      case: (Lub.Lub_Rbar_correct (fun d => forall y : R, ball x d y -> ball (f x) eps (f y))).
      move: (Lub.Lub_Rbar _) => l H1 H2.
      case: (proj1 (filterlim_locally _ _) (Cf x) eps) => d Hd.
      eapply Rbar_lt_le_trans, H1.
      by apply d.
      by apply Hd.
    assert (0 < Rbar_min 1 (Lub.Lub_Rbar (fun d => forall y : R, ball x d y -> ball (f x) eps (f y)))).
      move: H ; case: (Lub.Lub_Rbar (fun d => forall y : R, ball x d y -> ball (f x) eps (f y))) => [l | | ] //= H0.
      apply Rmin_case => //.
      by apply Rlt_0_1.
      by apply Rlt_0_1.
    set d := mkposreal _ H0.
    exists d.
    unfold d ; clear d ; simpl.
    case: (Lub.Lub_Rbar_correct (fun d => forall y : R, ball x d y -> ball (f x) eps (f y))).
    move: (Lub.Lub_Rbar (fun d => forall y : R, ball x d y -> ball (f x) eps (f y))) H => {H0} l H0 H1 H2 y Hy.
    contradict Hy.
    apply Rle_not_lt.
    apply (Rbar_le_trans (Finite _) l (Finite _)).
    case: (l) H0 => [r | | ] //= H0.
    apply Rmin_r.
    apply H2 => d /= Hd.
    apply Rnot_lt_le ; contradict Hy.
    by apply Hd.
  destruct (compactness_value_1d a b (fun x => pos_div_2 (proj1_sig (H x)))) as [d Hd].
  exists d => x y Hx Hy Hxy Hf.
  apply (Hd x Hx).
  case => {Hd} t [Ht].
  case: H => /= delta Hdelta [Htx Hdt].
  apply (Hdelta x).
    eapply ball_le, Htx.
    rewrite {2}(double_var delta).
    apply Rminus_le_0 ; ring_simplify.
    apply Rlt_le, is_pos_div_2.
  intro Hftx.
  apply (Hdelta y).
    rewrite (double_var delta).
    apply ball_triangle with x.
    apply Htx.
    by eapply ball_le, Hxy.
  contradict Hf.
  rewrite (double_var eps).
  eapply ball_triangle, Hf.
  by apply ball_sym.
Qed.

End UnifCont.

Section UnifCont_N.

Context {K : AbsRing} {V : NormedModule K}.

Lemma unifcont_normed_1d (f : R -> V) a b :
  (forall x, a <= x <= b -> continuous f x) ->
  forall eps : posreal, {delta : posreal | forall x y,
    a <= x <= b -> a <= y <= b -> ball x delta y -> ball_norm (f x) eps (f y)}.
Proof.
  intros H eps.
  assert (0 < eps / (@norm_factor _ V)).
    apply Rdiv_lt_0_compat.
    apply cond_pos.
    exact norm_factor_gt_0.
  destruct (unifcont_1d f a b H (mkposreal _ H0)) as [d Hd].
  exists d => x y Hx Hy Hxy.
  specialize (Hd x y Hx Hy Hxy).
  apply Rnot_le_lt.
  contradict Hd ; contradict Hd.
  apply Rlt_not_le.
  evar_last.
  apply norm_compat2, Hd.
  simpl ; field.
  apply Rgt_not_eq, norm_factor_gt_0.
Qed.

End UnifCont_N.


Require Import ExtLib.Core.RelDec.

Require Import MirrorCore.Lambda.Expr.
Require Import MirrorCore.Lemma.
Require Import MirrorCore.TypesI.
Require Import MirrorCore.Reify.Reify.

Require Import Charge.ModularFunc.ILogicFunc.

Section ReifyLemma.
	Context {typ func : Type} {HIL : ILogicFunc typ func}.
	Context {RType_typ : RType typ}.
    Context {Typ0_tyProp : Typ0 RType_typ Prop}.
    Context {Heq : RelDec (@eq typ)}.

    Let tyProp : typ := @typ0 _ _ _ _.

	Fixpoint get_alls (e : expr typ func) : list typ * expr typ func :=
	  match e with
	    | App f (Abs _ e) =>
	      match ilogicS f with
	      	| Some (ilf_forall t t') =>
	      		if t' ?[ eq ] tyProp then
	      			 let (alls, e) := get_alls e in (t :: alls, e)
	      		else
	      			 (nil, e)
	      	| _ => (nil, e)
	      end
	    | _ => (nil, e)
	  end.

	Fixpoint get_impls (e : expr typ func) : list (expr typ func) * expr typ func :=
	  match e with
	    | App (App f P) Q =>
	      match ilogicS f with
	        | Some (ilf_impl t) =>
	        	if t ?[ eq ] tyProp then
	        		let (impls,e) := get_impls Q in (P :: impls,e)
	        	else
	        		(nil, e)
	        | _ => (nil, e)
	      end
	    | _ => (nil, e)
	  end.

	Definition convert_to_lemma (e : expr typ func)
	: lemma typ (expr typ func) (expr typ func) :=
	  let (alls, e) := get_alls e in
	  let (impls, e) := get_impls e in
	  {| vars := rev alls
	   ; premises := impls
	   ; concl := e |}.

End ReifyLemma.

Ltac reify_lemma_aux reify T :=
  let k e :=
    let e := constr:(convert_to_lemma e) in
    let e := eval unfold convert_to_lemma in e in
    let e := eval simpl in e in
      refine e
  in
    reify_expr reify k [ True ] [ T ].

Ltac reify_lemma reify e :=
	let T := type of e in reify_lemma_aux reify T.


From iris.base_logic Require Export invariants.
From iris.program_logic Require Export weakestpre.
From iris.heap_lang Require Export lang proofmode notation.
From iris.heap_lang.lib Require Export nondet_bool.
From iris.prelude Require Import options.

(** The clairvoyant coin predicts all the values that it will
*non-deterministically* choose throughout the execution of the
program. This can be seen in the spec. The predicate [coin c bs]
expresses that [bs] is the list of all the values of the coin in the
future. The [read_coin] operation always returns the head of [bs] and the
[toss_coin] operation takes the [tail] of [bs]. *)

Definition new_coin: val :=
  λ: <>, (ref (nondet_bool #()), NewProph).

Definition read_coin : val := λ: "cp", !(Fst "cp").

Definition toss_coin : val :=
  λ: "cp",
  let: "c" := Fst "cp" in
  let: "p" := Snd "cp" in
  let: "r" := nondet_bool #() in
  "c" <- "r";; resolve_proph: "p" to: "r";; #().

Section proof.
  Context `{!heapGS Σ}.

  Definition prophecy_to_list_bool (vs : list (val * val)) : list bool :=
    (λ v, bool_decide (v = #true)) ∘ snd <$> vs.

  Definition coin (cp : val) (bs : list bool) : iProp Σ :=
    ∃ (c : loc) (p : proph_id) (vs : list (val * val)),
       ⌜cp = (#c, #p)%V⌝ ∗
       ⌜bs ≠ []⌝ ∗ ⌜tail bs = prophecy_to_list_bool vs⌝ ∗
       proph p vs ∗
       from_option (λ b : bool, c ↦ #b) (∃ b : bool, c ↦ #b) (head bs).

  Lemma new_coin_spec : {{{ True }}} new_coin #() {{{ c bs, RET c; coin c bs }}}.
  Proof.
    iIntros (Φ) "_ HΦ".
    wp_lam.
    wp_apply wp_new_proph as (vs p) "Hp"; first done.
    wp_apply nondet_bool_spec as (b) "_"; first done.
    wp_alloc c as "Hc".
    wp_pair.
    iApply ("HΦ" $! (#c, #p)%V (b :: prophecy_to_list_bool vs)).
    rewrite /coin; eauto 10 with iFrame.
  Qed.

  Lemma read_coin_spec cp bs :
    {{{ coin cp bs }}}
      read_coin cp
    {{{b bs', RET #b; ⌜bs = b :: bs'⌝ ∗ coin cp bs }}}.
  Proof.
    iIntros (Φ) "Hc HΦ".
    iDestruct "Hc" as (c p vs -> ? ?) "[Hp Hb]".
    destruct bs as [|b bs]; simplify_eq/=.
    wp_lam. wp_load.
    iApply "HΦ"; iSplitR; first done.
    rewrite /coin; eauto 10 with iFrame.
  Qed.

  Lemma toss_coin_spec cp bs :
    {{{ coin cp bs }}}
      toss_coin cp
    {{{b bs', RET #(); ⌜bs = b :: bs'⌝ ∗ coin cp bs' }}}.
  Proof.
    iIntros (Φ) "Hc HΦ".
    iDestruct "Hc" as (c p vs -> ? ?) "[Hp Hb]".
    destruct bs as [|b bs]; simplify_eq/=.
    wp_lam. do 2 (wp_proj; wp_let).
    wp_apply nondet_bool_spec as (r) "_"; first done.
    wp_store.
    wp_apply (wp_resolve_proph with "[Hp]") as (ws) "[-> Hp]"; first done.
    wp_seq.
    iApply "HΦ"; iSplitR; first done.
    destruct r; rewrite /coin; eauto 10 with iFrame.
  Qed.

End proof.


Require Import rt.util.all.
Require Import rt.model.arrival.basic.job rt.model.arrival.basic.task rt.model.arrival.basic.arrival_sequence
               rt.model.priority rt.model.suspension.
Require Import rt.model.schedule.uni.schedule rt.model.schedule.uni.schedulability.
Require Import rt.model.schedule.uni.basic.platform.
Require Import rt.model.schedule.uni.susp.suspension_intervals
               rt.model.schedule.uni.susp.schedule rt.model.schedule.uni.susp.platform.
Require Import rt.model.schedule.uni.transformation.construction.
Require Import rt.implementation.uni.basic.schedule.
From mathcomp Require Import ssreflect ssrbool eqtype ssrnat seq fintype bigop path.

Module ReductionToBasicSchedule.

  Import Job SporadicTaskset Suspension Priority SuspensionIntervals
         Schedulability ScheduleConstruction.

  (* Recall the platform constraints for suspension-oblivious and suspension-aware schedules. *)
  Module susp := ScheduleWithSuspensions.
  Module susp_oblivious := Platform.
  Module susp_aware := PlatformWithSuspensions.

  (* In this section, we perform a reduction from a suspension-aware schedule
     to a suspension-oblivious schedule, in which jobs have inflated execution costs. *)
  Section Reduction.

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

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

    (* Let ts be any task set to be analyzed. *)
    Variable ts: seq Task.

    (* Next, consider any consistent job arrival sequence... *)
    Variable arr_seq: arrival_sequence Job.
    Hypothesis H_arrival_times_are_consistent: arrival_times_are_consistent job_arrival arr_seq.

    (* ...whose jobs come from task set ts. *)
    Hypothesis H_jobs_from_taskset:
      forall j, arrives_in arr_seq j -> job_task j \in ts.

    (* Consider any JLDP policy that is reflexive, transitive and total, i.e., that
       indicates "higher or equal priority". *)
    Variable higher_eq_priority: JLDP_policy Job.
    Hypothesis H_priority_is_reflexive: JLDP_is_reflexive higher_eq_priority.
    Hypothesis H_priority_is_transitive: JLDP_is_transitive higher_eq_priority.
    Hypothesis H_priority_is_total: JLDP_is_total arr_seq higher_eq_priority.

    (* Consider the original job and task costs. *)
    Variable original_job_cost: Job -> time.
    Variable original_task_cost: Task -> time.

    (* Assume that the maximum suspension time of any job is bounded according
       to the dynamic suspension model. *)
    Variable next_suspension: job_suspension Job.
    Variable task_suspension_bound: Task -> time.
    Hypothesis H_dynamic_suspensions:
      dynamic_suspension_model original_job_cost job_task next_suspension task_suspension_bound.

    (* Next, consider any suspension-aware schedule of this arrival sequence. *)
    Variable sched_susp: schedule Job.
    Hypothesis H_jobs_come_from_arrival_sequence:
      jobs_come_from_arrival_sequence sched_susp arr_seq.

    (* Assume that jobs only execute after they arrive... *)
    Hypothesis H_jobs_must_arrive_to_execute:
      jobs_must_arrive_to_execute job_arrival sched_susp.

    (* ...and no longer than their execution costs. *)
    Hypothesis H_completed_jobs_dont_execute:
      completed_jobs_dont_execute original_job_cost sched_susp.

    (* Also assume that the schedule is work-conserving if there are non-suspended jobs, ... *)
    Hypothesis H_work_conserving:
      susp_aware.work_conserving job_arrival original_job_cost next_suspension arr_seq sched_susp.

    (* ...that the schedule respects job priority... *)
    Hypothesis H_respects_priority:
      susp_aware.respects_JLDP_policy job_arrival original_job_cost next_suspension
                                      arr_seq sched_susp higher_eq_priority.

    (* ...and that suspended jobs are not allowed to be scheduled. *)
    Hypothesis H_respects_self_suspensions:
      respects_self_suspensions job_arrival original_job_cost next_suspension sched_susp.

    (* Now we proceed with the reduction. First, we formalize the inflation of job and task costs. *)
    Section CostInflation.

      (* Recall the total suspension time of a job in the original schedule. *)
      Let job_total_suspension :=
        total_suspension original_job_cost next_suspension.

      (* To inflate job costs, we just add the total suspension of the job. *)
      Definition inflated_job_cost (j: Job) :=
        original_job_cost j + job_total_suspension j.

      (* Similarly, to inflate task costs, we just add its suspension bound. *)
      Definition inflated_task_cost (tsk: Task) :=
        original_task_cost tsk + task_suspension_bound tsk.

      (* As shown next, this inflation produces job valid parameters. *)
      Section NewParametersAreValid.

        (* Recall the definition of valid sporadic jobs and tasks. *)
        Let jobs_are_valid job_cost task_cost :=
          forall j,
            arrives_in arr_seq j ->
            valid_sporadic_job task_cost task_deadline job_cost job_deadline job_task j.
        Let tasks_are_valid task_cost :=
          valid_sporadic_taskset task_cost task_period task_deadline ts.

        (* If the inflated task costs are no larger than the deadline nor period of each task, ... *)
        Hypothesis H_inflated_cost_le_deadline_and_period:
          forall tsk,
            tsk \in ts ->
            inflated_task_cost tsk <= task_deadline tsk /\
            inflated_task_cost tsk <= task_period tsk.

        (* ...then we can prove that job parameters remain valid after the inflation. *)
        Lemma suspension_oblivious_job_parameters_remain_valid:
          jobs_are_valid original_job_cost original_task_cost ->
          jobs_are_valid inflated_job_cost inflated_task_cost.
        Proof.
          rename H_inflated_cost_le_deadline_and_period into LEdl,
                 H_dynamic_suspensions into DYN, H_jobs_from_taskset into FROMTS.
          unfold jobs_are_valid, valid_sporadic_job, valid_realtime_job.
          intros VALIDjob j ARRj; specialize (VALIDjob j ARRj); des.
          split.
          {
            split;
              first by apply leq_trans with (n := original_job_cost j);
                last by apply leq_addr.
            split; last by done.
            rewrite /job_cost_le_deadline /inflated_job_cost.
            feed (LEdl (job_task j)); [by apply FROMTS | move: LEdl => [LEdl _]].
            apply leq_trans with (n := inflated_task_cost (job_task j));
              last by rewrite VALIDjob1 LEdl.
            by apply leq_add; last by apply DYN.
          }
          split; last by done.
          by apply leq_add; last by apply DYN.
        Qed.

        (* The same applies for task parameters. *)
        Lemma suspension_oblivious_task_parameters_remain_valid:
          tasks_are_valid original_task_cost -> tasks_are_valid inflated_task_cost.
        Proof.
          rename H_inflated_cost_le_deadline_and_period into LEdl.
          unfold tasks_are_valid, valid_sporadic_taskset, is_valid_sporadic_task.
          intros VALIDtask tsk IN; specialize (VALIDtask tsk IN); des.
          split;
            first by apply: (leq_trans VALIDtask); last by apply leq_addr.
          specialize (LEdl tsk IN); move: LEdl => [LEdl LEp].
          by repeat split.
        Qed.

      End NewParametersAreValid.

    End CostInflation.

    (* Now, we are going to generate a suspension-oblivious schedule with the inflated
       job costs. For that, we always try to copy the original schedule, as long as that
       doesn't break the priority enforcement in the generated schedule. *)

    Section ScheduleConstruction.

      (* In this section, we define the schedule construction function. *)
      Section ConstructionStep.

        (* For any time t, suppose that we have generated the schedule prefix in the
           interval [0, t). Then, we must define what should be scheduled at time t. *)
        Variable sched_prefix: schedule Job.
        Variable t: time.

        (* First, consider the list of pending jobs at time t in the generated schedule. *)
        Let job_is_pending := pending job_arrival inflated_job_cost sched_prefix.
        Definition pending_jobs :=
          [seq j <- jobs_arrived_up_to arr_seq t | job_is_pending j t].

        (* From the list of pending jobs, we take one of the (possibly many) highest-priority
           jobs, or None, in case there are no pending jobs. *)
        Definition highest_priority_job := seq_min (higher_eq_priority t) pending_jobs.

        (* Then, we construct the schedule at time t as follows.
           a) If there's a job scheduled in the original schedule at time t that is also a
              highest-priority pending job in the generated schedule, copy this job.
           b) Else, pick one of the highest priority pending jobs in the generated schedule. *)

        Definition build_schedule : option Job :=
          (* If there is a highest-priority job j_hp in the generated schedule, ...*)
          if highest_priority_job is Some j_hp then
            (* ...and there is some job scheduled in the original schedule... *)
            if (sched_susp t) is Some j_sched then
              (* ...that is a highest-priority pending job,...*)
              if job_is_pending j_sched t && higher_eq_priority t j_sched j_hp then
                Some j_sched (* ...copy this scheduled job. *)
              else
                highest_priority_job     (* In the remaining cases, just pick the           *)
            else highest_priority_job    (* highest-priority job in the generated schedule. *)
          else highest_priority_job.

      End ConstructionStep.

      (* Next, starting from the empty schedule, ...*)
      Let empty_schedule : schedule Job := fun t => None.

      (* ...we use the recursive definition above to construct the suspension-oblivious schedule. *)
      Definition sched_new := build_schedule_from_prefixes build_schedule empty_schedule.

      (* Then, by showing that the construction function depends only on the previous service, ... *)
      Lemma sched_new_depends_only_on_service:
        forall sched1 sched2 t,
          (forall j, service sched1 j t = service sched2 j t) ->
          build_schedule sched1 t = build_schedule sched2 t.
      Proof.
        intros sched1 sched2 t ALL.
        rewrite /build_schedule /highest_priority_job.
        have SAME: pending_jobs sched1 t = pending_jobs sched2 t.
        {
          apply eq_in_filter.
          intros j IN.
          eapply in_arrivals_implies_arrived_before in IN; last by eauto.
          rewrite /arrived_before ltnS in IN.
          rewrite /pending /has_arrived IN 2!andTb.
          by rewrite /completed_by ALL.
        }
        have SAME': forall j, pending job_arrival inflated_job_cost sched1 j t =
                              pending job_arrival inflated_job_cost sched2 j t.
        {
          intros j; rewrite /pending.
          case: (has_arrived _ j t); [rewrite 2!andTb | by done].
          by rewrite /completed_by ALL.
        }
        rewrite SAME.
        desf; try (by done).
        - by rewrite SAME' in Heq1.
        - by rewrite -SAME' in Heq2.
      Qed.

      (* ...we infer that the generated schedule is indeed based on the construction function. *)
      Corollary sched_new_uses_construction_function:
        forall t,
          sched_new t = build_schedule sched_new t.
      Proof.
        by ins; apply service_dependent_schedule_construction,
                      sched_new_depends_only_on_service.
      Qed.

    End ScheduleConstruction.

    (* Next, we prove that the generated schedule is well-formed. *)
    Section GeneratedScheduleIsValid.

      (* First, we show that scheduled jobs come from the arrival sequence. *)
      Lemma sched_newjobs_come_from_arrival_sequence:
        jobs_come_from_arrival_sequence sched_new arr_seq.
      Proof.
        rename H_jobs_come_from_arrival_sequence into FROM.
        move => j t /eqP SCHED.
        rewrite sched_new_uses_construction_function in SCHED.
        rewrite /build_schedule in SCHED.
        destruct (highest_priority_job sched_new t) as [j_hp|] eqn:HP; last by done.
        have ARRhp: arrives_in arr_seq j_hp.
        {
          rewrite /highest_priority_job in HP.
          apply seq_min_in_seq in HP.
          rewrite mem_filter in HP; move: HP => /andP [_ ARR].
          by eapply in_arrivals_implies_arrived, ARR.
        }
        destruct (sched_susp t) eqn:SUSP; last by case: SCHED => SAME; subst.
        by move: SCHED; case PEND: (_ && _); case => EQ; subst;
          first by apply (FROM j t); apply/eqP.
      Qed.

      (* Next, we show that jobs do not execute before their arrival times... *)
      Lemma sched_new_jobs_must_arrive_to_execute:
        jobs_must_arrive_to_execute job_arrival sched_new.
      Proof.
        move => j t /eqP SCHED.
        rewrite sched_new_uses_construction_function in SCHED.
        rewrite /build_schedule in SCHED.
        destruct (highest_priority_job sched_new t) as [j_hp|] eqn:HP; last by done.
        have IN: has_arrived job_arrival j_hp t.
        {
          suff IN: j_hp \in pending_jobs sched_new t.
            by rewrite mem_filter in IN; move: IN => /andP [/andP [ARR _] _].
          by apply: (seq_min_in_seq (higher_eq_priority t)).
        }
        destruct (sched_susp t) eqn:SUSP; last by move: SCHED; case => EQ; subst.
        move: SCHED; case: ifP; last by move => _; case => SAME; subst.
        by move => /andP [/andP [ARR _] _]; case => SAME; subst.
      Qed.

      (* ...nor longer than their execution costs. *)
      Lemma sched_new_completed_jobs_dont_execute:
        completed_jobs_dont_execute inflated_job_cost sched_new.
      Proof.
        intros j t.
        induction t;
          first by rewrite /service /service_during big_geq //.
        rewrite /service /service_during big_nat_recr //=.
        rewrite leq_eqVlt in IHt; move: IHt => /orP [/eqP EQ | LT]; last first.
        {
          apply: leq_trans LT; rewrite -addn1.
            by apply leq_add; last by apply leq_b1.
        }
        rewrite -[inflated_job_cost _]addn0; apply leq_add; first by rewrite -EQ.
        rewrite leqn0 eqb0 /scheduled_at.
        rewrite sched_new_uses_construction_function.
        rewrite /build_schedule.
        destruct (highest_priority_job sched_new t) as [j_hp|] eqn:HP; last by done.
        rewrite /highest_priority_job in HP.
        destruct (sched_susp t) eqn:SUSP.
        {
          case: ifP => [PEND | NOTPEND].
          {
            apply/eqP; case => SAME; subst.
            move: PEND => /andP [PEND _].
              by rewrite /pending /completed_by EQ eq_refl andbF in PEND.
          }
          {
            apply/eqP; case => SAME; subst.
            suff IN: j \in pending_jobs sched_new t.
            {
              rewrite mem_filter in IN; move: IN => /andP [/andP [_ NOTCOMP] _].
              by rewrite /completed_by EQ eq_refl in NOTCOMP.
            }
            by apply: (seq_min_in_seq (higher_eq_priority t)).
          }
        }
        {
          apply/eqP; case => SAME; subst.
          suff IN: j \in pending_jobs sched_new t.
          {
            rewrite mem_filter in IN; move: IN => /andP [/andP [_ NOTCOMP] _].
            by rewrite /completed_by EQ eq_refl in NOTCOMP.
          }
          by apply: (seq_min_in_seq (higher_eq_priority t)).
        }
      Qed.

      (* In addition, we prove that the schedule is (suspension-oblivious) work-conserving... *)
      Lemma sched_new_work_conserving:
        susp_oblivious.work_conserving job_arrival inflated_job_cost arr_seq sched_new.
      Proof.
        intros j t ARRj BACK.
        move: BACK => /andP [/andP [ARR NOTCOMP] NOTSCHED].
        rewrite /scheduled_at sched_new_uses_construction_function /build_schedule in NOTSCHED.
        rewrite /scheduled_at sched_new_uses_construction_function /build_schedule.
        destruct (highest_priority_job sched_new t) as [j_hp|] eqn:HP.
        {
          destruct (sched_susp t) as [j0 |] eqn:SUSP; last by exists j_hp.
          by case: ifP => [_ | _]; [exists j0 | exists j_hp].
        }
        {
          rewrite /highest_priority_job in HP.
          have IN: j \in pending_jobs sched_new t.
          {
            rewrite mem_filter /pending ARR NOTCOMP 2!andTb.
            by eapply arrived_between_implies_in_arrivals, ARR.
          }
          by apply seq_min_exists with (rel := higher_eq_priority t) in IN; rewrite HP eq_refl in IN.
        }
      Qed.

      (* ...and respects job priorities. *)
      Lemma sched_new_respects_policy:
        susp_oblivious.respects_JLDP_policy job_arrival inflated_job_cost
                                            arr_seq sched_new higher_eq_priority.
      Proof.
        rename H_priority_is_transitive into TRANS, H_priority_is_total into TOTAL,
               H_priority_is_reflexive into REFL.
        move => j1 j2 t ARRj1 BACK /eqP SCHED.
        move: BACK => /andP [/andP [ARR NOTCOMP] NOTSCHED].
        rewrite /scheduled_at sched_new_uses_construction_function /build_schedule in NOTSCHED.
        rewrite /scheduled_at sched_new_uses_construction_function /build_schedule in SCHED.
        destruct (highest_priority_job sched_new t) as [j_hp|] eqn:HP; last by done.
        rewrite /highest_priority_job in HP.
        have ALL: forall j, j \in pending_jobs sched_new t -> higher_eq_priority t j_hp j.
        {
          intros j IN; apply seq_min_computes_min with (y := j) in HP; try (by done).
          intros x y; rewrite 2!mem_filter; move => /andP [_ INx] /andP [_ INy].
          by apply TOTAL; eapply in_arrivals_implies_arrived; eauto 1.
        }
        have IN: j1 \in pending_jobs sched_new t.
        {
          rewrite mem_filter /pending ARR NOTCOMP 2!andTb.
          by eapply arrived_between_implies_in_arrivals, ARR.
        }
        destruct (sched_susp t) as [j0|] eqn:SUSP;
          last by case: SCHED => SAME; subst; apply ALL; last by done.
        destruct (pending job_arrival inflated_job_cost sched_new j0 t
                          && higher_eq_priority t j0 j_hp) eqn:PEND;
          last by case: SCHED => SAME; subst; apply ALL.
        move: PEND => /andP [PEND HPj]; case: SCHED => SAME; subst.
        by apply: (TRANS _ j_hp); last by apply ALL.
      Qed.

      (* In addition, due to the copy step in the schedule construction, we show that in case
         there are multiple highest-priority jobs, we pick the same job as in the original
         schedule. *)
      Lemma sched_new_breaks_ties:
        forall j1 j2 t,
          higher_eq_priority t j1 j2 ->
          higher_eq_priority t j2 j1 ->
          scheduled_at sched_susp j1 t ->
          pending job_arrival inflated_job_cost sched_new j1 t ->
          scheduled_at sched_new j2 t ->
          j1 = j2.
      Proof.
        move => j1 j2 t HP1 HP2 /eqP SCHEDs PEND /eqP SCHEDn.
        rewrite sched_new_uses_construction_function /build_schedule in SCHEDn.
        destruct (highest_priority_job sched_new t) as [j_hp|] eqn:HP; last by done.
        destruct (sched_susp t) eqn:SUSP; last by done.
        case: SCHEDs => SAME; subst.
        rewrite PEND andTb in SCHEDn.
        move: SCHEDn; case: ifP => HP'; case => SAME; subst; first by done.
        by rewrite HP1 in HP'.
      Qed.

      (* To reason about schedulability, we now prove that the generated schedule
         preserves the service received by each job. *)
      Section Service.

        (* Recall the definitions of suspended job, cumulative service and
         cumulative suspension time in the suspension-aware schedule. *)
        Let job_suspended_at (sched: schedule Job) :=
          suspended_at job_arrival original_job_cost next_suspension sched.
        Let job_cumulative_suspension :=
          cumulative_suspension job_arrival original_job_cost next_suspension sched_susp.
        Let job_service_with_suspensions := service sched_susp.

        (* Also recall the definition of cumulative service in the generated schedule. *)
        Let job_service_without_suspensions := service sched_new.

        (* We are going to prove that for any job j, at any time t, the service received by j
           in the generated schedule (without suspensions) is no larger than the sum of the
           cumulative service plus suspension time in the original schedule (with suspensions).
           The proof follows by induction on time. Since the base case is trivial, we focus
           on the inductive step.  *)
        Section InductiveStep.

          (* Assume that the claim we want to prove holds for the interval [0, t). *)
          Variable t: time.
          Hypothesis H_induction_hypothesis:
            forall j,
              arrives_in arr_seq j ->
              job_service_without_suspensions j t <=
              job_service_with_suspensions j t + job_cumulative_suspension j t.

          (* Now, let j be any job in arrival sequence. We are going to prove that the claim
           continues to hold for job j in the interval [0, t + 1). *)
          Variable j: Job.
          Hypothesis H_comes_from_arrival_sequence: arrives_in arr_seq j.

          (* If j has not arrived by time t, then the proof is trivial, ... *)
          Lemma reduction_inductive_step_not_arrived:
            ~~ has_arrived job_arrival j t ->
            job_service_without_suspensions j t.+1 <=
            job_service_with_suspensions j t.+1 + job_cumulative_suspension j t.+1.
          Proof.
            rewrite -ltnNge; intro NOTARR.
            rewrite /job_service_without_suspensions /job_service_with_suspensions
                    /service /service_during.
            rewrite (cumulative_service_before_job_arrival_zero job_arrival) //.
            by apply sched_new_jobs_must_arrive_to_execute.
          Qed.

          (* ...so let's assume instead that j has arrived by time t. *)
          Hypothesis H_j_has_arrived: has_arrived job_arrival j t.

          (* We begin by performing a case analysis on whether j has completed in the
           suspension-aware schedule. *)
          Section CompletedInSuspensionAwareSchedule.

            (* Case 1) If j has completed by time t in the suspension-aware schedule, ... *)
            Hypothesis H_j_has_completed:
              completed_by original_job_cost sched_susp j t.

            (* ...then it follows from the induction hypothesis that the service
             received by j is preserved up in the interval [0, t + 1). *)
            Lemma reduction_inductive_step_case1_completed:
              job_service_without_suspensions j t.+1 <=
              job_service_with_suspensions j t.+1 + job_cumulative_suspension j t.+1.
            Proof.
              rename H_j_has_completed into COMP, H_induction_hypothesis into IH.
              apply leq_trans with (n := original_job_cost j +
                                         total_suspension original_job_cost next_suspension j).
              {
                by apply leq_trans with (n := inflated_job_cost j);
                  first by apply cumulative_service_le_job_cost,
                                 sched_new_completed_jobs_dont_execute.
              }
              have SERVs: job_service_with_suspensions j t.+1 = original_job_cost j.
              {
                  by apply/eqP; apply completion_monotonic with (t0 := t).
              } rewrite SERVs; clear SERVs.
              rewrite leq_add2l.
              apply completion_monotonic with (t' := t.+1) in COMP; try (by done).
              rewrite /job_cumulative_suspension.
                by rewrite -> cumulative_suspension_eq_total_suspension with
                   (job_cost := original_job_cost).
            Qed.

          End CompletedInSuspensionAwareSchedule.

          (* Next, consider the complementary case. *)
          Section PendingInSuspensionAwareSchedule.

            (* Case 2) Since job j has arrived by time t, let's assume that j has not completed
               by time t in the suspension-aware schedule, i.e., j is still pending. *)
            Hypothesis H_j_is_pending:
              ~~ completed_by original_job_cost sched_susp j t.

            (* Since we know from the induction hypothesis that the service received by j is
               preserved in the interval [0, t), now we only have to consider the state of job j
               at time t in both schedules. That is, we need to prove the following property:

                scheduled_at sched_new j t <=
                    job_suspended_at sched_susp j t + scheduled_at sched_susp j t.               *)

            (* If j is not scheduled in the suspension-oblivious schedule, then the claim follows. *)
            Lemma reduction_inductive_step_not_scheduled_in_new:
              ~~ scheduled_at sched_new j t ->
              scheduled_at sched_new j t <=
              job_suspended_at sched_susp j t + scheduled_at sched_susp j t.
            Proof.
                by case: scheduled_at.
            Qed.

            (* Likewise, if j is scheduled in the suspension-aware schedule, then the claim is also
               trivial. *)
            Lemma reduction_inductive_step_scheduled_in_susp:
              scheduled_at sched_susp j t ->
              scheduled_at sched_new j t <=
              job_suspended_at sched_susp j t + scheduled_at sched_susp j t.
            Proof.
                by move ->; case: scheduled_at; [by apply leq_addl | by rewrite addn1].
            Qed.

            (* Having proved the simple cases, let's now move to the harder case. *)
            Section NotScheduledInSuspensionAware.

              (* Assume that j is scheduled in the suspension-oblivious schedule, but
                 not in the suspension-aware schedule. *)
              Hypothesis H_j_scheduled_in_new: scheduled_at sched_new j t.
              Hypothesis H_j_not_scheduled_in_susp: ~~ scheduled_at sched_susp j t.

              (* It remains to show that j is suspended at time t in the suspension-aware schedule.
                 We are going to prove that by contradiction. *)
              Section ProofByContradiction.

                (* Assume that j it not suspended at time t in the suspension-aware schedule, ... *)
                Hypothesis H_j_is_not_suspended: ~~ job_suspended_at sched_susp j t.

                (* ...which implies that j is backlogged at time t in the suspension-aware schedule. *)
                Lemma reduction_inductive_step_j_is_backlogged:
                  susp.backlogged job_arrival original_job_cost next_suspension sched_susp j t.
                Proof.
                  by repeat (apply/andP; split).
                Qed.

                (* By work conservation, there must be a scheduled job with higher or equal
                   priority in the suspension-aware schedule. *)
                Lemma reduction_inductive_step_exists_hep_job:
                  exists j_hp, arrives_in arr_seq j_hp /\
                               scheduled_at sched_susp j_hp t /\
                               higher_eq_priority t j_hp j.
                Proof.
                  rename H_work_conserving into WORKs, H_respects_priority into PRIOs,
                         H_jobs_come_from_arrival_sequence into FROM.
                  have BACKs := reduction_inductive_step_j_is_backlogged.
                  move: (BACKs) => BACKs'; apply WORKs in BACKs; last by done.
                  move: BACKs => [j_hp SCHEDhp]; exists j_hp.
                  split; first by apply (FROM j_hp t).
                  by split; last by apply PRIOs.
                Qed.

                (* Let j_hp be this job with higher-or-equal priority. *)
                Variable j_hp: Job.
                Hypothesis H_j_hp_comes_from_sequence: arrives_in arr_seq j_hp.
                Hypothesis H_j_hp_is_scheduled: scheduled_at sched_susp j_hp t.
                Hypothesis H_higher_or_equal_priority: higher_eq_priority t j_hp j.

                (* First, note that j and j_hp cannot be the same job, since j is not scheduled
                   in the suspension-aware schedule at time t. Moreover, since the generated
                   schedule breaks ties when there are multiple highest-priority jobs (by copying
                   the original schedule), it follows that the higher-priority job j_hp must have
                   completed earlier in the suspension-oblivious schedule. *)
                Lemma reduction_inductive_step_j_hp_completed_in_new:
                  completed_by inflated_job_cost sched_new j_hp t.
                Proof.
                  rename H_j_not_scheduled_in_susp into NOTSCHEDs, H_j_scheduled_in_new into SCHEDn.
                  move: H_j_hp_is_scheduled (H_j_hp_is_scheduled) => SCHEDhp PENDhp.
                  apply scheduled_implies_pending with (job_arrival0 := job_arrival)
                                   (job_cost := original_job_cost) in PENDhp; try (by done).
                  move: PENDhp => /andP [ARRhp _].
                  apply contraT; intro NOTCOMPhp.
                  have PENDhp: pending job_arrival inflated_job_cost sched_new j_hp t
                    by apply/andP; split.
                  destruct (boolP (scheduled_at sched_new j_hp t)) as [SCHEDhp' | NOTSCHEDhp'].
                  {
                    have SAME: j = j_hp by apply only_one_job_scheduled with (j1 := j) in SCHEDhp'.
                    by subst; rewrite SCHEDhp in NOTSCHEDs.
                  }
                  have BACKhp: backlogged job_arrival inflated_job_cost sched_new j_hp t by apply/andP.
                  have HP': higher_eq_priority t j j_hp by apply sched_new_respects_policy.
                  apply sched_new_breaks_ties in HP'; try (by done).
                  by subst; rewrite SCHEDn in NOTSCHEDhp'.
                Qed.

                (* However, recall from the induction hypothesis how the service in the two schedules
                   are related. From that, we can conclude that j_hp must have completed in the
                   suspension-aware schedule as well, ... *)
                Lemma reduction_inductive_step_j_hp_completed_in_susp:
                  completed_by original_job_cost sched_susp j_hp t.
                Proof.
                  have COMPNEW := reduction_inductive_step_j_hp_completed_in_new.
                  rename H_induction_hypothesis into IHt.
                  rewrite /completed_by eqn_leq; apply/andP; split;
                    first by apply cumulative_service_le_job_cost.
                  rewrite -(leq_add2r (total_suspension original_job_cost next_suspension j_hp)).
                  rewrite -/(inflated_job_cost _).
                  apply leq_trans with (n := job_service_without_suspensions j_hp t);
                    first by apply eq_leq; symmetry; apply/eqP; apply COMPNEW.
                  feed (IHt j_hp); first by done.
                  apply: (leq_trans IHt).
                  by rewrite leq_add2l; apply cumulative_suspension_le_total_suspension.
                Qed.

                (* ...which of course is a contradiction, since we assumed that j_hp was scheduled
                   in the the suspension-aware schedule at time t. *)
                Lemma reduction_inductive_step_contradiction: False.
                Proof.
                  have COMPhp' := reduction_inductive_step_j_hp_completed_in_susp.
                  rename H_j_hp_is_scheduled into SCHEDhp.
                  apply completed_implies_not_scheduled in COMPhp'; try (by done).
                  by rewrite SCHEDhp in COMPhp'.
                Qed.

              End ProofByContradiction.

            End NotScheduledInSuspensionAware.

            (* From the lemmas above, we infer that the claim to be proven holds if job j
               is pending in the suspension-aware schedule. *)
            Lemma reduction_inductive_step_case2_pending:
              job_service_without_suspensions j t.+1 <=
              job_service_with_suspensions j t.+1 + job_cumulative_suspension j t.+1.
            Proof.
              have CONTRA := reduction_inductive_step_contradiction.
              have HP := reduction_inductive_step_exists_hep_job.
              rename H_induction_hypothesis into IHt.
              rewrite /job_service_without_suspensions /job_service_with_suspensions
                      /job_cumulative_suspension /cumulative_suspension
                      /cumulative_suspension_during /service /service_during /service_at.
              rewrite !big_nat_recr //=.
              rewrite -addnA [scheduled_at sched_susp _ _ + _]addnC !addnA -addnA.
              apply leq_add; first by apply IHt.
              destruct (boolP (scheduled_at sched_new j t)) as [SCHEDn |]; last by done.
              destruct (boolP (scheduled_at sched_susp j t)) as [SCHEDs | NOTSCHEDs];
                [by apply leq_addl | rewrite addn0].
              apply eq_leq; symmetry; apply/eqP; rewrite eqb1.
              apply contraT; intro NOTSUSP.
              specialize (HP NOTSCHEDs NOTSUSP); specialize (CONTRA SCHEDn NOTSCHEDs NOTSUSP).
              move: HP => [j_hp [INhp [SCHEDhp HP]]].
              by exfalso; apply CONTRA with (j_hp := j_hp).
            Qed.

          End PendingInSuspensionAwareSchedule.

        End InductiveStep.

        (* Using the proof by induction, we show that the service received by any
           job j at any time t is preserved in the suspension-aware schedule. *)
        Theorem suspension_oblivious_preserves_service:
          forall j t,
            arrives_in arr_seq j ->
            job_service_without_suspensions j t <= job_service_with_suspensions j t
                                                   + job_cumulative_suspension j t.
        Proof.
          have CASE1 := reduction_inductive_step_case1_completed.
          have CASE2 := reduction_inductive_step_case2_pending.
          move => j t; move: t j.
          induction t;
            first by ins; rewrite /job_service_without_suspensions/service/service_during big_geq.
          intros j ARRj.
          destruct (boolP (has_arrived job_arrival j t)) as [ARR | NOTARR];
            last by apply reduction_inductive_step_not_arrived.
          destruct (boolP (completed_by original_job_cost sched_susp j t)) as [COMP | NOTCOMP];
            first by apply CASE1.
          by apply CASE2.
        Qed.

        (* As a corollary, we show that if a job has completed in the suspension-oblivious
           schedule, it must have completed in the suspension-aware schedule as well. *)
        Corollary suspension_oblivious_preserves_completion:
          forall j t,
            arrives_in arr_seq j ->
            completed_by inflated_job_cost sched_new j t ->
            completed_by original_job_cost sched_susp j t.
        Proof.
          have COMP := sched_new_completed_jobs_dont_execute.
          have SERV := suspension_oblivious_preserves_service.
          intros j t ARRj COMPLETED.
          rewrite /completed_by eqn_leq; apply/andP; split;
            first by apply cumulative_service_le_job_cost.
          rewrite -(leq_add2r (total_suspension original_job_cost next_suspension j)).
          rewrite -/(inflated_job_cost j).
          move: COMPLETED => /eqP EQ; rewrite -EQ.
          apply: (leq_trans (SERV j t ARRj)); rewrite leq_add2l.
          by apply cumulative_suspension_le_total_suspension.
        Qed.

      End Service.

    End GeneratedScheduleIsValid.

    (* To conclude, based on the definition of schedulability, ...*)
    Let schedulable_without_suspensions :=
      job_misses_no_deadline job_arrival inflated_job_cost job_deadline sched_new.
    Let schedulable_with_suspensions :=
      job_misses_no_deadline job_arrival original_job_cost job_deadline sched_susp.

    (* ...we prove that if no job misses a deadline in the suspension-oblivious schedule, ... *)
    Hypothesis H_schedulable_without_suspensions:
      forall j,
        arrives_in arr_seq j ->
        schedulable_without_suspensions j.

    (* ...then no job misses a deadline in the suspension-aware schedule. *)
    Corollary suspension_oblivious_preserves_schedulability:
      forall j,
        arrives_in arr_seq j ->
        schedulable_with_suspensions j.
    Proof.
      rename H_schedulable_without_suspensions into SCHED.
      by intros j ARRj; apply suspension_oblivious_preserves_completion, SCHED.
    Qed.

  End Reduction.

End ReductionToBasicSchedule.


Require Import WildCat.
Require Import Modalities.ReflectiveSubuniverse.
Require Import Algebra.AbGroups.
Require Import Algebra.Rings.CRing.
Require Import Algebra.Rings.Ideal.
Require Import Algebra.Rings.QuotientRing.

(** * Chinese remainder theorem *)

Import Ideal.Notation.
Local Open Scope ring_scope.
Local Open Scope wc_iso_scope.

Section ChineseRemainderTheorem.

  (** We assume [Univalence] in order to work with quotients. We also need it for [Funext] in a few places.*)
  Context `{Univalence}
    (** We need two coprime ideals [I] and [J] to state the theorem. We don't introduce the coprimeness assumption as of yet in order to show something slightly stronger. *)
    {R : CRing} (I J : Ideal R).

  (** We begin with the homomorphism which will show to be a surjection. Using the first isomorphism theorem for rings we can improve this to be the isomorphism we want. *)
  (** This is the corecursion of the two quotient maps *)
  Definition rng_homo_crt : R $-> (R / I) × (R / J).
  Proof.
    apply cring_product_corec.
    1,2: apply rng_quotient_map.
  Defined.

  (** Since we are working with quotients, we make the following notation to make working with the proof somewhat easier. *)
  Notation "[ x ]" := (rng_quotient_map _ x).

  (** We then need to prove the following lemma. The hypotheses here can be derived by coprimality of [I] and [J]. But we don't need that here. *)
  Lemma issurjection_rng_homo_crt' (x y : R)
    (q1 : rng_homo_crt x = (0, 1)) (q2 : rng_homo_crt y = (1, 0))
    : IsSurjection rng_homo_crt.
  Proof.
    (** In order to show that [rng_homo_crt] is a surjection, we need to show that its propositional truncation of the fiber at any point is contractible. *)
    intros [a b].
    revert a; srapply QuotientRing_ind_hprop; intro a.
    revert b; srapply QuotientRing_ind_hprop; intro b.
    (** We can think of [a] and [b] as the pair [(a mod I, b mod J)]. We need to show that there merely exists some element in [R] that gets mapped by  [rng_homo_crt] to the pair. *)
    snrapply Build_Contr; [|intros z; strip_truncations; apply path_ishprop].
    (** We make this choice and show it maps as desired. *)
    apply tr; exists (b * x + a * y).
    (** Finally using some simple ring laws we can show it maps to our pair. *)
    rewrite rng_homo_plus.
    rewrite 2 rng_homo_mult.
    rewrite q1, q2.
    apply path_prod.
    + change ([b] * 0 + [a] * 1 = [a] :> R / I).
      by rewrite rng_mult_one_r, rng_mult_zero_r, rng_plus_zero_l.
    + change ([b] * 1 + [a] * 0 = [b] :> R / J).
      by rewrite rng_mult_one_r, rng_mult_zero_r, rng_plus_zero_r.
  Defined.

  (** Now we show that if [x + y = 1] for [I x] and [J y] then we can satisfy the hypotheses of the previous lemma. *)
  Section rng_homo_crt_beta.

    Context (x y : R) (ix : I x) (iy : J y) (p : x + y = 1).

    Lemma rng_homo_crt_beta_left : rng_homo_crt x = (0, 1).
    Proof.
      apply rng_moveR_Mr in p.
      rewrite rng_plus_comm in p.
      apply path_prod; apply qglue.
      - change (I (-x + 0)).
        apply ideal_in_negate_plus.
        1: assumption.
        apply ideal_in_zero.
      - change (J (-x + 1)).
        rewrite rng_plus_comm.
        by rewrite <- p.
    Defined.

    Lemma rng_homo_crt_beta_right : rng_homo_crt y = (1, 0).
    Proof.
      apply rng_moveR_rM in p.
      rewrite rng_plus_comm in p.
      apply path_prod; apply qglue.
      - change (I (-y + 1)).
        by rewrite <- p.
      - change (J (-y + 0)).
        apply ideal_in_negate_plus.
        1: assumption.
        apply ideal_in_zero.
    Defined.

  End rng_homo_crt_beta.

  (** We can now show the map is surjective from coprimality of [I] and [J]. *)
  Global Instance issurjection_rng_homo_crt
    : Coprime I J -> IsSurjection rng_homo_crt.
  Proof.
    intros c.
    (** First we turn the coprimality assumption into an equivalent assumption about the mere existence of two elements of each ideal which sum to one. *)
    apply equiv_coprime_sum in c.
    (** Since the goal is a hprop we may strip the truncations. *)
    strip_truncations.
    (** Now we can break apart the data of this witness. *)
    destruct c as [[[x ix] [y jy]] p];
    change (x + y = 1) in p.
    (** Now we apply all our previous lemmas *)
    apply (issurjection_rng_homo_crt' x y).
    1: exact (rng_homo_crt_beta_left x y ix jy p).
    exact (rng_homo_crt_beta_right x y ix jy p).
  Defined.

  (** Now suppose [I] and [J] are coprime. *)
  Context (c : Coprime I J).

  (** The Chinese Remainder Theorem *)
  Theorem chinese_remainder : R / (I ∩ J)%ideal ≅ (R / I) × (R / J).
  Proof.
    (** We use the first isomorphism theorem. Coq can already infer which map we wish to use, so for clarity we tell it not to do so. *)
    snrapply rng_first_iso'.
    1: rapply rng_homo_crt.
    1: exact _.
    (** Finally we must show the ideal of this map is the intersection. *)
    apply ideal_subset_antisymm.
    - intros r [i j].
      apply path_prod; apply qglue.
      1: change (I (- r + 0)).
      2: change (J (- r + 0)).
      1,2: rewrite rng_plus_comm.
      1,2: apply ideal_in_plus_negate.
      1,3: apply ideal_in_zero.
      1,2: assumption.
    - intros i p.
      apply equiv_path_prod in p.
      destruct p as [p q].
      apply ideal_in_negate'.
      rewrite <- rng_plus_zero_r.
      (** Here we need to derive the relation from paths in the quotient. This is what requires univalence. *)
      split.
      1: exact (related_quotient_paths _ _ _ p).
      1: exact (related_quotient_paths _ _ _ q).
  Defined.

  (** We also have the same for products of ideals. *)
  Theorem chinese_remainder_prod : R / (I ⋅ J)%ideal ≅ (R / I) × (R / J).
  Proof.
    etransitivity.
    { rapply rng_quotient_invar.
      symmetry.
      rapply ideal_intersection_is_product. }
    rapply chinese_remainder.
  Defined.

End ChineseRemainderTheorem.