(************************************************************************)
(*         *      The Rocq Prover / The Rocq Development Team           *)
(*  v      *         Copyright INRIA, CNRS and contributors             *)
(* <O___,, * (see version control and CREDITS file for authors & dates) *)
(*   \VV/  **************************************************************)
(*    //   *    This file is distributed under the terms of the         *)
(*         *     GNU Lesser General Public License Version 2.1          *)
(*         *     (see LICENSE file for the text of the license)         *)
(************************************************************************)

From Stdlib Require Import Rbase.
From Stdlib Require Import Ranalysis_reg.
From Stdlib Require Import Rfunctions.
From Stdlib Require Import Rseries.
From Stdlib Require Import RiemannInt.
From Stdlib Require Import SeqProp.
From Stdlib Require Import Lia.
From Stdlib Require Import Lra.
Local Open Scope R_scope.

Local Ltac Tauto.intuition_solver ::= auto with rorders real.

(** * Preliminaries lemmas *)

Lemma f_incr_implies_g_incr_interv : forall f g:R->R, forall lb ub,
       lb < ub ->
       (forall x y, lb <= x -> x < y -> y <= ub -> f x < f y) ->
       (forall x, f lb <= x -> x <= f ub -> (comp f g) x = id x) ->
       (forall x , f lb <= x -> x <= f ub -> lb <= g x <= ub) ->
       (forall x y, f lb <= x -> x < y -> y <= f ub -> g x < g y).
Proof.
  intros f g lb ub lb_lt_ub f_incr f_eq_g g_ok x y lb_le_x x_lt_y y_le_ub.
  assert (x_encad : f lb <= x <= f ub) by lra.
  assert (y_encad : f lb <= y <= f ub) by lra.
  assert (gx_encad := g_ok _ (proj1 x_encad) (proj2 x_encad)).
  assert (gy_encad := g_ok _ (proj1 y_encad) (proj2 y_encad)).
  case (Rlt_dec (g x) (g y)); [ easy |].
  intros Hfalse.
  assert (Temp := Rnot_lt_le _ _ Hfalse).
  enough (y <= x) by lra.
  replace y with (id y) by easy.
  replace x with (id x) by easy.
  rewrite <- f_eq_g by easy.
  rewrite <- f_eq_g by easy.
  assert (f_incr2 : forall x y, lb <= x -> x <= y -> y < ub -> f x <= f y). {
    intros m n lb_le_m m_le_n n_lt_ub.
    case (m_le_n).
    - intros; apply Rlt_le, f_incr, Rlt_le; assumption.
    - intros Hyp; rewrite Hyp; apply Req_le; reflexivity.
  }
  apply f_incr2; intuition.
  enough (g x <> ub) by lra.
  intro Hf.
  assert (Htemp : (comp f g) x = f ub). {
    unfold comp; rewrite Hf; reflexivity.
  }
  rewrite f_eq_g in Htemp by easy.
  unfold id in Htemp.
  lra.
Qed.

Lemma derivable_pt_id_interv : forall (lb ub x:R),
       lb <= x <= ub ->
       derivable_pt id x.
Proof.
intros.
 reg.
Qed.

Lemma pr_nu_var2_interv : forall (f g : R -> R) (lb ub x : R) (pr1 : derivable_pt f x)
                            (pr2 : derivable_pt g x),
    lb < ub ->
    lb < x < ub ->
    (forall h : R, lb < h < ub -> f h = g h) -> derive_pt f x pr1 = derive_pt g x pr2.
Proof.
  intros f g lb ub x Prf Prg lb_lt_ub x_encad local_eq.
  assert (forall x l, lb < x < ub -> (derivable_pt_abs f x l <-> derivable_pt_abs g x l)). {
    intros a l a_encad.
    unfold derivable_pt_abs, derivable_pt_lim.
    split.
    { intros Hyp eps eps_pos.
      elim (Hyp eps eps_pos) ; intros delta Hyp2.
      assert (Pos_cond : Rmin delta (Rmin (ub - a) (a - lb)) > 0).
      { clear-a lb ub a_encad delta.
        apply Rmin_pos ; [exact ((cond_pos delta)) | apply Rmin_pos ] ; apply Rlt_0_minus ; intuition. }
      exists (mkposreal (Rmin delta (Rmin (ub - a) (a - lb))) Pos_cond).
      intros h h_neq h_encad.
      replace (g (a + h) - g a) with (f (a + h) - f a).
      { apply Hyp2 ; intuition.
        apply Rlt_le_trans with (r2:=Rmin delta (Rmin (ub - a) (a - lb))).
        { assumption. } apply Rmin_l. }
      assert (local_eq2 : forall h : R, lb < h < ub -> - f h = - g h).
      { intros ; apply Ropp_eq_compat ; intuition. }
      rewrite local_eq ; unfold Rminus. { rewrite local_eq2. { reflexivity. }
        assumption. }
      assert (Sublemma2 : forall x y, Rabs x < Rabs y -> y > 0 -> x < y).
      { intros m n Hyp_abs y_pos. apply Rlt_le_trans with (r2:=Rabs n).
        { apply Rle_lt_trans with (r2:=Rabs m) ; [ | assumption] ; apply RRle_abs. }
        apply Req_le ; apply Rabs_right ; apply Rgt_ge ; assumption. }
      split.
      { assert (Sublemma : forall x y z, -z < y - x -> x < y + z).
        { intros ; lra. }
        apply Sublemma.
        apply Sublemma2. { rewrite Rabs_Ropp.
                           apply Rlt_le_trans with (r2:=a-lb) ; [| apply RRle_abs] ;
                             apply Rlt_le_trans with (r2:=Rmin (ub - a) (a - lb)) ; [| apply Rmin_r] ;
                             apply Rlt_le_trans with (r2:=Rmin delta (Rmin (ub - a) (a - lb))) ; [| apply Rmin_r] ; assumption. }
        apply Rlt_le_trans with (r2:=Rmin (ub - a) (a - lb)) ; [| apply Rmin_r] ;
          apply Rlt_le_trans with (r2:=Rmin delta (Rmin (ub - a) (a - lb))) ; [| apply Rmin_r] ; assumption. }
      assert (Sublemma : forall x y z, y < z - x -> x + y < z).
      { intros ; lra. }
      apply Sublemma.
      apply Sublemma2.
      { apply Rlt_le_trans with (r2:=ub-a) ; [| apply RRle_abs] ;
          apply Rlt_le_trans with (r2:=Rmin (ub - a) (a - lb)) ; [| apply Rmin_l] ;
          apply Rlt_le_trans with (r2:=Rmin delta (Rmin (ub - a) (a - lb))) ; [| apply Rmin_r] ; assumption. }
      apply Rlt_le_trans with (r2:=Rmin (ub - a) (a - lb)) ; [| apply Rmin_l] ;
        apply Rlt_le_trans with (r2:=Rmin delta (Rmin (ub - a) (a - lb))) ; [| apply Rmin_r] ; assumption. }
    intros Hyp eps eps_pos.
    elim (Hyp eps eps_pos) ; intros delta Hyp2.
    assert (Pos_cond : Rmin delta (Rmin (ub - a) (a - lb)) > 0).
    { clear-a lb ub a_encad delta.
      apply Rmin_pos ; [exact ((cond_pos delta)) | apply Rmin_pos ] ; apply Rlt_0_minus ; intuition. }
    exists (mkposreal (Rmin delta (Rmin (ub - a) (a - lb))) Pos_cond).
    intros h h_neq h_encad.
    replace (f (a + h) - f a) with (g (a + h) - g a).
    { apply Hyp2 ; intuition.
      apply Rlt_le_trans with (r2:=Rmin delta (Rmin (ub - a) (a - lb))).
      { assumption. } apply Rmin_l. }
    assert (local_eq2 : forall h : R, lb < h < ub -> - f h = - g h).
    { intros ; apply Ropp_eq_compat ; intuition. }
    rewrite local_eq ; unfold Rminus. { rewrite local_eq2. { reflexivity. }
      assumption. }
    assert (Sublemma2 : forall x y, Rabs x < Rabs y -> y > 0 -> x < y).
    { intros m n Hyp_abs y_pos. apply Rlt_le_trans with (r2:=Rabs n).
      { apply Rle_lt_trans with (r2:=Rabs m) ; [ | assumption] ; apply RRle_abs. }
      apply Req_le ; apply Rabs_right ; apply Rgt_ge ; assumption. }
    split.
    { assert (Sublemma : forall x y z, -z < y - x -> x < y + z).
      { intros ; lra. }
      apply Sublemma.
      apply Sublemma2. { rewrite Rabs_Ropp.
                         apply Rlt_le_trans with (r2:=a-lb) ; [| apply RRle_abs] ;
                           apply Rlt_le_trans with (r2:=Rmin (ub - a) (a - lb)) ; [| apply Rmin_r] ;
                           apply Rlt_le_trans with (r2:=Rmin delta (Rmin (ub - a) (a - lb))) ; [| apply Rmin_r] ; assumption. }
      apply Rlt_le_trans with (r2:=Rmin (ub - a) (a - lb)) ; [| apply Rmin_r] ;
        apply Rlt_le_trans with (r2:=Rmin delta (Rmin (ub - a) (a - lb))) ; [| apply Rmin_r] ; assumption. }
    assert (Sublemma : forall x y z, y < z - x -> x + y < z).
    { intros ; lra. }
    apply Sublemma.
    apply Sublemma2.
    { apply Rlt_le_trans with (r2:=ub-a) ; [| apply RRle_abs] ;
        apply Rlt_le_trans with (r2:=Rmin (ub - a) (a - lb)) ; [| apply Rmin_l] ;
        apply Rlt_le_trans with (r2:=Rmin delta (Rmin (ub - a) (a - lb))) ; [| apply Rmin_r] ; assumption. }
    apply Rlt_le_trans with (r2:=Rmin (ub - a) (a - lb)) ; [| apply Rmin_l] ;
      apply Rlt_le_trans with (r2:=Rmin delta (Rmin (ub - a) (a - lb))) ; [| apply Rmin_r] ; assumption. }
  unfold derivable_pt in Prf.
  unfold derivable_pt in Prg.
  elim Prf; intros x0 p.
  elim Prg; intros x1 p0.
  assert (Temp := p); rewrite H in Temp.
  { unfold derivable_pt_abs in p.
    unfold derivable_pt_abs in p0.
    simpl in |- *.
    apply (uniqueness_limite g x x0 x1 Temp p0). }
  assumption.
Qed.


(* begin hide *)
Lemma leftinv_is_rightinv : forall (f g:R->R),
    (forall x y, x < y -> f x < f y) ->
    (forall x, (comp f g) x = id x) ->
    (forall x, (comp g f) x = id x).
Proof.
  intros f g f_incr Hyp x.
  assert(f_inj : forall x y, f x = f y -> x = y).
  { intros a b fa_eq_fb.
    pose proof (f_incr a b);pose proof (f_incr b a);lra. }
  apply f_inj,Hyp.
Qed.
(* end hide *)

Lemma leftinv_is_rightinv_interv : forall (f g:R->R) (lb ub:R),
    (forall x y, lb <= x -> x < y -> y <= ub -> f x < f y) ->
    (forall y, f lb <= y -> y <= f ub -> (comp f g) y = id y) ->
    (forall x, f lb <= x -> x <= f ub -> lb <= g x <= ub) ->
    forall x,
      lb <= x <= ub ->
      (comp g f) x = id x.
Proof.
  intros f g lb ub f_incr_interv Hyp g_wf x x_encad.
  assert(f_inj : forall x y, lb <= x <= ub -> lb <= y <= ub -> f x = f y -> x = y).
  { intros a b a_encad b_encad fa_eq_fb.
    case(total_order_T a b).
    { intro s ; case s ; clear s.
      { intro Hf.
        assert (Hfalse := f_incr_interv a b (proj1 a_encad) Hf (proj2 b_encad)).
        apply False_ind. apply (Rlt_not_eq (f a) (f b)) ; assumption. }
      intuition. }
    intro Hf. assert (Hfalse := f_incr_interv b a (proj1 b_encad) Hf (proj2 a_encad)).
    apply False_ind. apply (Rlt_not_eq (f b) (f a)) ; [|symmetry] ; assumption. }
  assert (f_incr_interv2 : forall x y, lb <= x -> x <= y -> y <= ub -> f x <= f y).
  { intros m n cond1 cond2 cond3.
    case cond2.
    { intro cond. apply Rlt_le ; apply f_incr_interv ; assumption. }
    intro cond ; right ; rewrite cond ; reflexivity. }
  assert (Hyp2:forall x, lb <= x <= ub -> f (g (f x)) = f x).
  { intros ; apply Hyp.  { apply f_incr_interv2 ; intuition. }
    apply f_incr_interv2 ; intuition. }
  unfold comp ; unfold comp in Hyp.
  apply f_inj.
  { apply g_wf ; apply f_incr_interv2 ; intuition. }
  { unfold id ; assumption. }
  apply Hyp2 ; unfold id ; assumption.
Qed.


(** Intermediate Value Theorem on an Interval (Proof mainly taken from Reals.Rsqrt_def) and its corollary *)

Lemma IVT_interv_prelim0 : forall (x y:R) (P:R->bool) (N:nat),
    x < y ->
    x <= Dichotomy_ub x y P N <= y /\ x <= Dichotomy_lb x y P N <= y.
Proof.
  assert (Sublemma : forall x y lb ub, lb <= x <= ub /\ lb <= y <= ub -> lb <= (x+y) / 2 <= ub) by (intros;lra).
  intros x y P N x_lt_y.
  induction N.
  { simpl ; intuition. }
  simpl.
  case (P ((Dichotomy_lb x y P N + Dichotomy_ub x y P N) / 2)).
  { split. { apply Sublemma ; intuition. }
    intuition. }
  split. { intuition. }
  apply Sublemma ; intuition.
Qed.

Lemma IVT_interv_prelim1 : forall (x y x0:R) (D : R -> bool),
    x < y ->
    Un_cv (dicho_up x y D) x0 ->
    x <= x0 <= y.
Proof.
  intros x y x0 D x_lt_y bnd.
  assert (Main : forall n, x <= dicho_up x y D n <= y).
  { intro n. unfold dicho_up.
    apply (proj1 (IVT_interv_prelim0 x y D n x_lt_y)). }
  split.
  - apply Rle_cv_lim with (Vn:=dicho_up x y D) (Un:=fun n => x).
    + intro n ; exact (proj1 (Main n)).
    + unfold Un_cv ; intros ; exists 0%nat ; intros ; unfold Rdist ; replace (x -x) with 0 by field ; rewrite Rabs_R0 ; assumption.
    + assumption.
  - apply Rle_cv_lim with (Un:=dicho_up x y D) (Vn:=fun n => y).
    + intro n ; exact (proj2 (Main n)).
    + assumption.
    + unfold Un_cv ; intros ; exists 0%nat ; intros ; unfold Rdist ; replace (y -y) with 0 by field ; rewrite Rabs_R0 ; assumption.
Qed.

Lemma IVT_interv : forall (f : R -> R) (x y : R),
    (forall a, x <= a <= y -> continuity_pt f a) ->
    x < y ->
    f x < 0 ->
    0 < f y ->
    {z : R | x <= z <= y /\ f z = 0}.
Proof.
  intros. (* f x y f_cont_interv x_lt_y fx_neg fy_pos.*)
  assert (x <= y) by (left;assumption).
  generalize (dicho_lb_cv x y (fun z:R => cond_positivity (f z)) H3).
  generalize (dicho_up_cv x y (fun z:R => cond_positivity (f z)) H3).
  intros X X0.
  elim X; intros x0 p.
  elim X0; intros x1 p0.
  assert (H4 := cv_dicho _ _ _ _ _ H3 p0 p).
  rewrite H4 in p0.
  exists x0.
  split.
  1:split.
  { apply Rle_trans with (dicho_lb x y (fun z:R => cond_positivity (f z)) 0).
    { simpl in |- *.
      right; reflexivity. }
    apply growing_ineq.
    { apply dicho_lb_growing; assumption. }
    assumption. }
  { apply Rle_trans with (dicho_up x y (fun z:R => cond_positivity (f z)) 0).
    { apply decreasing_ineq.
      { apply dicho_up_decreasing; assumption. }
      assumption. }
    right; reflexivity. }
  set (Vn := fun n:nat => dicho_lb x y (fun z:R => cond_positivity (f z)) n).
  set (Wn := fun n:nat => dicho_up x y (fun z:R => cond_positivity (f z)) n).
  cut ((forall n:nat, f (Vn n) <= 0) -> f x0 <= 0).
  { cut ((forall n:nat, 0 <= f (Wn n)) -> 0 <= f x0).
    { intros.
      cut (forall n:nat, f (Vn n) <= 0).
      { cut (forall n:nat, 0 <= f (Wn n)).
        { intros.
          assert (H9 := H6 H8).
          assert (H10 := H5 H7).
          apply Rle_antisym; assumption. }
        intro.
        unfold Wn in |- *.
        cut (forall z:R, cond_positivity z = true <-> 0 <= z).
        { intro.
          assert (H8 := dicho_up_car x y (fun z:R => cond_positivity (f z)) n).
          elim (H7 (f (dicho_up x y (fun z:R => cond_positivity (f z)) n))); intros.
          apply H9.
          apply H8.
          elim (H7 (f y)); intros.
          apply H12.
          left; assumption. }
        intro.
        unfold cond_positivity in |- *.
        destruct (Rle_dec 0 z) as [|Hnotle].
        { split.
          { intro; assumption. }
          intro; reflexivity. }
        split.
        { intro feqt;discriminate feqt. }
        intro.
        elim Hnotle; assumption. }
      unfold Vn in |- *.
      cut (forall z:R, cond_positivity z = false <-> z < 0).
      { intros.
        assert (H8 := dicho_lb_car x y (fun z:R => cond_positivity (f z)) n).
        left.
        elim (H7 (f (dicho_lb x y (fun z:R => cond_positivity (f z)) n))); intros.
        apply H9.
        apply H8.
        elim (H7 (f x)); intros.
        apply H12.
        assumption. }
      intro.
      unfold cond_positivity in |- *.
      destruct (Rle_dec 0 z) as [Hle|].
      { split.
        { intro feqt; discriminate feqt. }
        intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ Hle H7)). }
      split.
      { intro; auto with real. }
      intro; reflexivity. }
    cut (Un_cv Wn x0).
    { intros.
      assert (Temp : x <= x0 <= y).
      { apply IVT_interv_prelim1 with (D:=(fun z : R => cond_positivity (f z))) ; assumption. }
      assert (H7 := continuity_seq f Wn x0 (H x0 Temp) H5).
      destruct (total_order_T 0 (f x0)) as [[Hlt|<-]|Hgt].
      - left; assumption.
      - right; reflexivity.
      - unfold Un_cv in H7; unfold Rdist in H7.
        cut (0 < - f x0).
        { intro.
          elim (H7 (- f x0) H8); intros.
          cut (x2 >= x2)%nat; [ intro | unfold ge in |- *; apply le_n ].
          assert (H11 := H9 x2 H10).
          rewrite Rabs_right in H11.
          { pattern (- f x0) at 1 in H11; rewrite <- Rplus_0_r in H11.
            unfold Rminus in H11; rewrite (Rplus_comm (f (Wn x2))) in H11.
            assert (H12 := Rplus_lt_reg_l _ _ _ H11).
            assert (H13 := H6 x2).
            elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H13 H12)). }
          apply Rle_ge; left; unfold Rminus in |- *; apply Rplus_le_lt_0_compat.
          { apply H6. }
          exact H8. }
        apply Ropp_0_gt_lt_contravar; assumption. }
    unfold Wn in |- *; assumption. }
  assert (Un_cv Vn x0) by (unfold Vn; assumption).
  intros.
  assert (Temp : x <= x0 <= y).
  { apply IVT_interv_prelim1 with (D:=(fun z : R => cond_positivity (f z))) ; assumption. }
  assert (H7 := continuity_seq f Vn x0 (H x0 Temp) H5).
  destruct (total_order_T 0 (f x0)) as [[Hlt|Heq]|].
  - unfold Un_cv in H7; unfold Rdist in H7.
    elim (H7 (f x0) Hlt); intros.
    cut (x2 >= x2)%nat; [ intro | unfold ge; apply le_n ].
    assert (H10 := H8 x2 H9).
    rewrite Rabs_left in H10.
    { pattern (f x0) at 2 in H10; rewrite <- Rplus_0_r in H10.
      rewrite Ropp_minus_distr in H10.
      unfold Rminus in H10.
      assert (H11 := Rplus_lt_reg_l _ _ _ H10).
      assert (H12 := H6 x2).
      cut (0 < f (Vn x2)).
      { intro.
        elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H13 H12)). }
      rewrite <- (Ropp_involutive (f (Vn x2))).
      apply Ropp_0_gt_lt_contravar; assumption. }
    apply Rplus_lt_reg_l with (f x0 - f (Vn x2)).
    rewrite Rplus_0_r; replace (f x0 - f (Vn x2) + (f (Vn x2) - f x0)) with 0;
      [ unfold Rminus in |- *; apply Rplus_lt_le_0_compat | ring ].
    { assumption. }
    apply Ropp_0_ge_le_contravar; apply Rle_ge; apply H6.
  - right; rewrite <- Heq; reflexivity.
  - left; assumption.
Qed.

(* begin hide *)
Ltac case_le H :=
   let t := type of H in
   let h' := fresh in
      match t with ?x <= ?y => case (total_order_T x y);
         [intros h'; case h'; clear h' |
          intros h'; clear -H h'; exfalso; lra ] end.
(* end hide *)


Lemma f_interv_is_interv : forall (f:R->R) (lb ub y:R),
    lb < ub ->
    f lb <= y <= f ub ->
    (forall x, lb <=  x <= ub -> continuity_pt f x) ->
    {x | lb <= x <= ub /\ f x = y}.
Proof.
  intros f lb ub y lb_lt_ub y_encad f_cont_interv.
  case y_encad ; intro y_encad1.
  case_le y_encad1 ; intros y_encad2 y_encad3 ;
    case_le y_encad3.
  - intro y_encad4.
    clear y_encad y_encad1 y_encad3.
    assert (Cont : forall a : R, lb <= a <= ub -> continuity_pt (fun x => f x - y) a).
    { intros a a_encad. unfold continuity_pt, continue_in, limit1_in, limit_in ; simpl ; unfold Rdist.
      intros eps eps_pos. elim (f_cont_interv a a_encad eps eps_pos).
      intros alpha alpha_pos. destruct alpha_pos as (alpha_pos,Temp).
      exists alpha. split.
      { assumption. } intros x  x_cond.
      replace (f x - y - (f a - y)) with (f x - f a) by field.
      exact (Temp x x_cond). }
    assert (H1 : (fun x : R => f x - y) lb < 0).
    { apply Rlt_minus. assumption. }
    assert (H2 : 0 < (fun x : R => f x - y) ub).
    { apply Rgt_minus ; assumption. }
    destruct (IVT_interv (fun x => f x - y) lb ub Cont lb_lt_ub H1 H2) as (x,Hx).
    exists x.
    destruct Hx as (Hyp,Result).
    intuition.
  - intro H ; exists ub ; intuition.
  - intro H ; exists lb ; intuition.
  - intro H ; exists ub ; intuition.
Qed.

(** ** The derivative of a reciprocal function       *)


(** * Continuity of the reciprocal function *)

Lemma continuity_pt_recip_prelim : forall (f g:R->R) (lb ub : R) (Pr1:lb < ub),
    (forall x y, lb <= x -> x < y -> y <= ub -> f x < f y) ->
    (forall x, lb <= x <= ub -> (comp g f) x = id x) ->
    (forall a, lb <= a <= ub -> continuity_pt f a) ->
    forall b,
      f lb < b < f ub ->
      continuity_pt g b.
Proof.
  assert (Sublemma : forall x y z, Rmax x y < z <-> x < z /\ y < z).
  { intros x y z. split.
    { unfold Rmax. case (Rle_dec x y) ; intros Hyp Hyp2.
      { split. { apply Rle_lt_trans with (r2:=y) ; assumption. } assumption. }
      split. { assumption. } apply Rlt_trans with (r2:=x).
      { assert (Temp : forall x y, ~ x <= y -> x > y).
        { intros m n Hypmn. intuition. }
        apply Temp ; clear Temp ; assumption. }
      assumption. }
    intros Hyp.
    unfold Rmax. case (Rle_dec x y).
    { intro ; exact (proj2 Hyp). }
    intro ; exact (proj1 Hyp). }
  assert (Sublemma2 : forall x y z, Rmin x y > z <-> x > z /\ y > z).
  { intros x y z. split.
    { unfold Rmin. case (Rle_dec x y) ; intros Hyp Hyp2.
      { split. { assumption. }
        apply Rlt_le_trans with (r2:=x) ; intuition. }
      split.
      { apply Rlt_trans with (r2:=y). { intuition. }
        assert (Temp : forall x y, ~ x <= y -> x > y).
        { intros m n Hypmn. intuition. }
        apply Temp ; clear Temp ; assumption. }
      assumption. }
    intros Hyp.
    unfold Rmin. case (Rle_dec x y).
    { intro ; exact (proj1 Hyp). }
    intro ; exact (proj2 Hyp). }
  assert (Sublemma3 : forall x y, x <= y /\ x <> y -> x < y).
  { intros m n Hyp. unfold Rle in Hyp.
    destruct Hyp as (Hyp1,Hyp2).
    case Hyp1.
    { intuition. }
    intro Hfalse ; apply False_ind ; apply Hyp2 ; exact Hfalse. }
  intros f g lb ub lb_lt_ub f_incr_interv f_eq_g f_cont_interv b b_encad.
  assert (f_incr_interv2 : forall x y, lb <= x -> x <= y -> y <= ub -> f x <= f y).
  { intros m n cond1 cond2 cond3.
    case cond2.
    { intro cond. apply Rlt_le ; apply f_incr_interv ; assumption. }
    intro cond ; right ; rewrite cond ; reflexivity. }
  unfold continuity_pt, continue_in, limit1_in, limit_in ; intros eps eps_pos.
  unfold dist ; simpl ; unfold Rdist.
  assert (b_encad_e : f lb <= b <= f ub) by intuition.
  elim (f_interv_is_interv f lb ub b lb_lt_ub b_encad_e f_cont_interv) ; intros x Temp.
  destruct Temp as (x_encad,f_x_b).
  assert (lb_lt_x : lb < x).
  { assert (Temp : x <> lb).
    { intro Hfalse.
      assert (Temp' : b = f lb).
      { rewrite <- f_x_b ; rewrite Hfalse ; reflexivity. }
      assert (Temp'' : b <> f lb).
      { apply Rgt_not_eq ; exact (proj1 b_encad). }
      apply Temp'' ; exact Temp'. }
    apply Sublemma3.
    split. { exact (proj1 x_encad). }
    assert (Temp2 : forall x y:R, x <> y <-> y <> x).
    { intros m n. split ; intuition. }
    rewrite Temp2 ; assumption. }
  assert (x_lt_ub : x < ub).
  { assert (Temp : x <> ub).
    { intro Hfalse.
      assert (Temp' : b = f ub).
      { rewrite <- f_x_b ; rewrite Hfalse ; reflexivity. }
      assert (Temp'' : b <> f ub).
      { apply Rlt_not_eq ; exact (proj2 b_encad). }
      apply Temp'' ; exact Temp'. }
    apply Sublemma3.
    split ; [exact (proj2 x_encad) | assumption]. }
  pose (x1 := Rmax (x - eps) lb).
  pose (x2 := Rmin (x + eps) ub).
  assert (Hx1 : x1 = Rmax (x - eps) lb) by intuition.
  assert (Hx2 : x2 = Rmin (x + eps) ub) by intuition.
  assert (x1_encad : lb <= x1 <= ub).
  { split. { apply RmaxLess2. }
    apply Rlt_le. rewrite Hx1. rewrite Sublemma.
    split. { apply Rlt_trans with (r2:=x) ; lra. }
    assumption. }
  assert (x2_encad : lb <= x2 <= ub).
  { split. { apply Rlt_le ; rewrite Hx2 ; apply Rgt_lt ; rewrite Sublemma2.
             split. { apply Rgt_trans with (r2:=x) ; lra. }
             assumption. }
    apply Rmin_r. }
  assert (x_lt_x2 : x < x2).
  { rewrite Hx2.
    apply Rgt_lt. rewrite Sublemma2.
    split ; lra. }
  assert (x1_lt_x : x1 < x).
  { rewrite Hx1.
    rewrite Sublemma.
    split ; lra. }
  exists (Rmin (f x - f x1) (f x2 - f x)).
  split. { apply Rmin_pos ; apply Rgt_minus. { apply f_incr_interv ; [apply RmaxLess2 | | ] ; lra. }
    apply f_incr_interv ; intuition. }
  intros y Temp.
  destruct Temp as (_,y_cond).
  rewrite <- f_x_b in y_cond.
  assert (Temp : forall x y d1 d2, d1 > 0 -> d2 > 0 -> Rabs (y - x) < Rmin d1 d2 -> x - d1 <= y <= x + d2).
  { intros.
    split. { assert (H10 : forall x y z, x - y <= z -> x - z <= y). { intuition. lra. }
      apply H10. apply Rle_trans with (r2:=Rabs (y0 - x0)).
             { replace (Rabs (y0 - x0)) with (Rabs (x0 - y0)). { apply RRle_abs. }
               rewrite <- Rabs_Ropp. unfold Rminus ; rewrite Ropp_plus_distr. rewrite Ropp_involutive.
               intuition. }
             apply Rle_trans with (r2:= Rmin d1 d2). { apply Rlt_le ; assumption. }
             apply Rmin_l. }
    assert (H10 : forall x y z, x - y <= z -> x <= y + z). { intuition. lra. }
    apply H10. apply Rle_trans with (r2:=Rabs (y0 - x0)). { apply RRle_abs. }
    apply Rle_trans with (r2:= Rmin d1 d2). { apply Rlt_le ; assumption. }
    apply Rmin_r. }
  assert (Temp' := Temp (f x) y (f x - f x1) (f x2 - f x)).
  replace (f x - (f x - f x1)) with (f x1) in Temp' by field.
  replace (f x + (f x2 - f x)) with (f x2) in Temp' by field.
  assert (T : f x - f x1 > 0).
  { apply Rgt_minus. apply f_incr_interv ; intuition. }
  assert (T' : f x2 - f x > 0).
  { apply Rgt_minus. apply f_incr_interv ; intuition. }
  assert (Main := Temp' T T' y_cond).
  clear Temp Temp' T T'.
  assert (x1_lt_x2 : x1 < x2).
  { apply Rlt_trans with (r2:=x) ; assumption. }
  assert (f_cont_myinterv : forall a : R, x1 <= a <= x2 -> continuity_pt f a).
  { intros ; apply f_cont_interv ; split.
    { apply Rle_trans with (r2 := x1) ; intuition. }
    apply Rle_trans with (r2 := x2) ; intuition. }
  elim (f_interv_is_interv f x1 x2 y x1_lt_x2 Main f_cont_myinterv) ; intros x' Temp.
  destruct Temp as (x'_encad,f_x'_y).
  rewrite <- f_x_b ; rewrite <- f_x'_y.
  unfold comp in f_eq_g. rewrite f_eq_g.
  2:{ split. { apply Rle_trans with (r2:=x1) ; intuition. }
    apply Rle_trans with (r2:=x2) ; intuition. }
  rewrite f_eq_g.
  2:assumption.
  unfold id.
  assert (x'_encad2 : x - eps <= x' <= x + eps).
  { split.
    { apply Rle_trans with (r2:=x1) ; [ apply RmaxLess1|] ; intuition. }
    apply Rle_trans with (r2:=x2) ; [ | apply Rmin_l] ; intuition. }
  assert (x1_lt_x' : x1 < x').
  { apply Sublemma3.
    assert (x1_neq_x' : x1 <> x').
    { intro Hfalse. rewrite Hfalse, f_x'_y in y_cond.
      assert (Hf : Rabs (y - f x) < f x - y).
      { apply Rlt_le_trans with (r2:=Rmin (f x - y) (f x2 - f x)). { lra. }
        apply Rmin_l. }
      assert(Hfin : f x - y < f x - y).
      { apply Rle_lt_trans with (r2:=Rabs (y - f x)).
        { replace (Rabs (y - f x)) with (Rabs (f x - y)). { apply RRle_abs. }
          rewrite <- Rabs_Ropp. replace (- (f x - y)) with (y - f x) by field ; reflexivity. } lra. }
      apply (Rlt_irrefl (f x - y)) ; assumption. }
    split ; intuition. }
  assert (x'_lb : x - eps < x').
  { apply Sublemma3.
    split. { intuition. } apply Rlt_not_eq.
    apply Rle_lt_trans with (r2:=x1) ; [ apply RmaxLess1|] ; intuition. }
  assert (x'_lt_x2 : x' < x2).
  { apply Sublemma3.
    assert (x1_neq_x' : x' <> x2).
    { intro Hfalse. rewrite <- Hfalse, f_x'_y in y_cond.
      assert (Hf : Rabs (y - f x) < y - f x).
      { apply Rlt_le_trans with (r2:=Rmin (f x - f x1) (y - f x)). { lra. }
        apply Rmin_r. }
      assert(Hfin : y - f x < y - f x).
      { apply Rle_lt_trans with (r2:=Rabs (y - f x)). { apply RRle_abs. } lra. }
      apply (Rlt_irrefl (y - f x)) ; assumption. }
    split ; intuition. }
  assert (x'_ub : x' < x + eps).
  { apply Sublemma3.
    split. { intuition. } apply Rlt_not_eq.
    apply Rlt_le_trans with (r2:=x2) ; [ |rewrite Hx2 ; apply Rmin_l] ; intuition. }
  apply Rabs_def1 ; lra.
Qed.

Lemma continuity_pt_recip_interv : forall (f g:R->R) (lb ub : R) (Pr1:lb < ub),
       (forall x y, lb <= x -> x < y -> y <= ub -> f x < f y) ->
       (forall x, f lb <= x -> x <= f ub -> (comp f g) x = id x) ->
       (forall x, f lb <= x -> x <= f ub -> lb <= g x <= ub) ->
       (forall a, lb <= a <= ub -> continuity_pt f a) ->
       forall b,
       f lb < b < f ub ->
       continuity_pt g b.
Proof.
intros f g lb ub lb_lt_ub f_incr_interv f_eq_g g_wf.
assert (g_eq_f_prelim := leftinv_is_rightinv_interv f g lb ub f_incr_interv f_eq_g).
assert (g_eq_f : forall x, lb <= x <= ub -> (comp g f) x = id x).
{ intro x ; apply g_eq_f_prelim ; assumption. }
apply (continuity_pt_recip_prelim f g lb ub lb_lt_ub f_incr_interv g_eq_f).
Qed.

(** *   Derivability of the reciprocal function        *)

Lemma derivable_pt_lim_recip_interv : forall (f g:R->R) (lb ub x:R)
                                        (Prf:forall a : R, g lb <= a <= g ub -> derivable_pt f a) (Prg : continuity_pt g x),
    lb < ub ->
    lb < x < ub ->
    forall (Prg_incr:g lb <= g x <= g ub),
      (forall x, lb <= x <= ub -> (comp f g) x = id x) ->
      derive_pt f (g x) (Prf (g x) Prg_incr) <> 0 ->
      derivable_pt_lim g x (1 / derive_pt f (g x) (Prf (g x) Prg_incr)).
Proof.
  intros f g lb ub x Prf g_cont_pur lb_lt_ub x_encad Prg_incr f_eq_g df_neq.
  assert (x_encad2 : lb <= x <= ub).
  { split ; apply Rlt_le ; intuition. }
  elim (Prf (g x)); simpl; intros l Hl.
  unfold derivable_pt_lim.
  intros eps eps_pos.
  pose (y := g x).
  assert (Hlinv := limit_inv).
  assert (Hf_deriv : forall eps:R,
             0 < eps ->
             exists delta : posreal,
               (forall h:R,
                   h <> 0 -> Rabs h < delta -> Rabs ((f (g x + h) - f (g x)) / h - l) < eps)).
  { intros eps0 eps0_pos.
    red in Hl ; red in Hl. elim (Hl eps0 eps0_pos).
    intros deltatemp Htemp.
    exists deltatemp ; exact Htemp. }
  elim (Hf_deriv eps eps_pos).
  intros deltatemp Htemp.
  red in Hlinv ; red in Hlinv ; unfold dist in Hlinv ; unfold Rdist in Hlinv.
  assert (Hlinv' := Hlinv (fun h => (f (y+h) - f y)/h) (fun h => h <>0) l 0).
  unfold limit1_in, limit_in, dist in Hlinv' ; simpl in Hlinv'. unfold Rdist in Hlinv'.
  assert (Premisse : forall eps : R,
             eps > 0 ->
             exists alp : R,
               alp > 0 /\
                 (forall x : R,
                     (fun h => h <>0) x /\ Rabs (x - 0) < alp ->
                     Rabs ((f (y + x) - f y) / x - l) < eps)).
  { intros eps0 eps0_pos.
    elim (Hf_deriv eps0 eps0_pos).
    intros deltatemp' Htemp'.
    exists deltatemp'.
    split.
    { exact (cond_pos deltatemp'). }
    intros htemp cond.
    apply (Htemp' htemp).
    { exact (proj1 cond). }
    replace (htemp) with (htemp - 0).
    { exact (proj2 cond). }
    intuition. }
  assert (Premisse2 : l <> 0).
  { intro l_null.
    rewrite l_null in Hl.
    apply df_neq.
    rewrite derive_pt_eq.
    exact Hl. }
  elim (Hlinv' Premisse Premisse2 eps eps_pos).
  intros alpha cond.
  assert (alpha_pos := proj1 cond) ; assert (inv_cont := proj2 cond) ; clear cond.
  unfold derivable, derivable_pt, derivable_pt_abs, derivable_pt_lim in Prf.
  elim (Hl eps eps_pos).
  intros delta f_deriv.
  assert (g_cont := g_cont_pur).
  unfold continuity_pt, continue_in, limit1_in, limit_in in g_cont.
  pose (mydelta := Rmin delta alpha).
  assert (mydelta_pos : mydelta > 0).
  { unfold mydelta, Rmin.
    case (Rle_dec delta alpha).
    { intro ; exact ((cond_pos delta)). }
    intro ; exact alpha_pos. }
  elim (g_cont mydelta mydelta_pos).
  intros delta' new_g_cont.
  assert(delta'_pos := proj1 (new_g_cont)).
  clear g_cont ; assert (g_cont := proj2 (new_g_cont)) ; clear new_g_cont.
  pose (mydelta'' := Rmin delta' (Rmin (x - lb) (ub - x))).
  assert(mydelta''_pos : mydelta'' > 0).
  { unfold mydelta''.
    apply Rmin_pos ; [intuition | apply Rmin_pos] ; apply Rgt_minus ; intuition. }
  pose (delta'' := mkposreal mydelta'' mydelta''_pos: posreal).
  exists delta''.
  intros h h_neq h_le_delta'.
  assert (lb <= x +h <= ub).
  { assert (Sublemma2 : forall x y, Rabs x < Rabs y -> y > 0 -> x < y).
    { intros m n Hyp_abs y_pos. apply Rlt_le_trans with (r2:=Rabs n).
      { apply Rle_lt_trans with (r2:=Rabs m) ; [ | assumption] ; apply RRle_abs. }
      apply Req_le ; apply Rabs_right ; apply Rgt_ge ; assumption. }
    split.
    { assert (Sublemma : forall x y z, -z <= y - x -> x <= y + z).
      { intros ; lra. }
      apply Sublemma.
      apply Rlt_le ; apply Sublemma2.
      { rewrite Rabs_Ropp.
        apply Rlt_le_trans with (r2:=x-lb) ; [| apply RRle_abs] ;
          apply Rlt_le_trans with (r2:=Rmin (x - lb) (ub - x)) ; [| apply Rmin_l] ;
          apply Rlt_le_trans with (r2:=Rmin delta' (Rmin (x - lb) (ub - x))).
        { apply Rlt_le_trans with (r2:=delta''). { assumption. } intuition. } apply Rmin_r. }
      apply Rgt_minus. intuition. }
    assert (Sublemma : forall x y z, y <= z - x -> x + y <= z).
    { intros ; lra. }
    apply Sublemma.
    apply Rlt_le ; apply Sublemma2.
    { apply Rlt_le_trans with (r2:=ub-x) ; [| apply RRle_abs] ;
        apply Rlt_le_trans with (r2:=Rmin (x - lb) (ub - x)) ; [| apply Rmin_r] ;
        apply Rlt_le_trans with (r2:=Rmin delta' (Rmin (x - lb) (ub - x))) ; [| apply Rmin_r] ; assumption. }
    apply Rlt_le_trans with (r2:=delta''). { assumption. }
    apply Rle_trans with (r2:=Rmin delta' (Rmin (x - lb) (ub - x))). { intuition. }
    apply Rle_trans with (r2:=Rmin (x - lb) (ub - x)). { apply Rmin_r. } apply Rmin_r. }
  replace ((g (x + h) - g x) / h) with (1/ (h / (g (x + h) - g x))).
  2:{ field ; split.
      { assumption. }
      intro Hfalse ; apply h_neq.
      apply (Rplus_0_r_uniq x).
      assert (Hfin : (comp f g) (x+h) = (comp f g) x).
      { apply Rminus_diag_uniq in Hfalse.
        unfold comp.
        rewrite Hfalse ; reflexivity. }
      rewrite f_eq_g in Hfin.
      { rewrite f_eq_g in Hfin.
        { unfold id in Hfin. exact Hfin. }
        assumption. }
      assumption. }
  assert (Hrewr : h = (comp f g ) (x+h) - (comp f g) x).
  { rewrite f_eq_g.
    { rewrite f_eq_g.
      { unfold id ; rewrite Rplus_comm ;
          unfold Rminus ; rewrite Rplus_assoc ; rewrite Rplus_opp_r ; intuition. }
      assumption. }
    assumption. }
  rewrite Hrewr at 1.
  unfold comp.
  replace (g(x+h)) with (g x + (g (x+h) - g(x))) by field.
  pose (h':=g (x+h) - g x).
  replace (g (x+h) - g x) with h' by intuition.
  replace (g x + h' - g x) with h' by field.
  assert (h'_neq : h' <> 0).
  { unfold h'.
    intro Hfalse.
    unfold Rminus in Hfalse ; apply Rminus_diag_uniq in Hfalse.
    assert (Hfalse' : (comp f g) (x+h) = (comp f g) x).
    { intros ; unfold comp ; rewrite Hfalse ; trivial. }
    rewrite f_eq_g in Hfalse' ; rewrite f_eq_g in Hfalse'.
    - unfold id in Hfalse'.
      apply Rplus_0_r_uniq in Hfalse'.
      apply h_neq ; exact Hfalse'.
    - assumption.
    - assumption.
    - assumption. }
  unfold Rdiv at 1 3; rewrite Rmult_1_l ; rewrite Rmult_1_l.
  apply inv_cont.
  split.
  { exact h'_neq. }
  rewrite Rminus_0_r.
  unfold continuity_pt, continue_in, limit1_in, limit_in in g_cont_pur.
  elim (g_cont_pur mydelta mydelta_pos).
  intros delta3 cond3.
  unfold dist in cond3 ; simpl in cond3 ; unfold Rdist in cond3.
  unfold h'.
  assert (mydelta_le_alpha : mydelta <= alpha).
  { unfold mydelta, Rmin ; case (Rle_dec delta alpha).
    { trivial. }
    intro ; intuition. }
  apply Rlt_le_trans with (r2:=mydelta).
  2:assumption.
  unfold dist in g_cont ; simpl in g_cont ; unfold Rdist in g_cont ; apply g_cont.
  split.
  { unfold D_x ; simpl.
    split.
    { unfold no_cond ; trivial. }
    intro Hfalse ; apply h_neq.
    apply (Rplus_0_r_uniq x).
    symmetry ; assumption. }
  replace (x + h - x) with h by field.
  apply Rlt_le_trans with (r2:=delta'').
  { assumption ; unfold delta''. } intuition.
  apply Rle_trans with (r2:=mydelta''). { apply Req_le. unfold delta''. intuition. }
  apply Rmin_l.
Qed.

Lemma derivable_pt_recip_interv_prelim0 : forall (f g : R -> R) (lb ub x : R)
       (Prf : forall a : R, g lb <= a <= g ub -> derivable_pt f a),
       continuity_pt g x ->
       lb < ub ->
       lb < x < ub ->
       forall Prg_incr : g lb <= g x <= g ub,
       (forall x0 : R, lb <= x0 <= ub -> comp f g x0 = id x0) ->
       derive_pt f (g x) (Prf (g x) Prg_incr) <> 0 ->
       derivable_pt g x.
Proof.
intros f g lb ub x Prf g_cont_pt lb_lt_ub x_encad Prg_incr f_eq_g Df_neq.
unfold derivable_pt, derivable_pt_abs.
exists (1 / derive_pt f (g x) (Prf (g x) Prg_incr)).
apply derivable_pt_lim_recip_interv ; assumption.
Qed.

Lemma derivable_pt_recip_interv_prelim1 : forall (f g:R->R) (lb ub x : R),
         lb < ub ->
         f lb < x < f ub ->
         (forall x : R, f lb <= x -> x <= f ub -> lb <= g x <= ub) ->
         (forall a : R, lb <= a <= ub -> derivable_pt f a) ->
         derivable_pt f (g x).
Proof.
  intros f g lb ub x lb_lt_ub x_encad g_wf f_deriv.
  apply f_deriv.
  apply g_wf; lra.
Qed.

Lemma derivable_pt_recip_interv_prelim1_decr : forall (f g:R->R) (lb ub x : R),
         lb < ub ->
         f ub < x < f lb ->
         (forall x : R, f ub <= x -> x <= f lb -> lb <= g x <= ub) ->
         (forall a : R, lb <= a <= ub -> derivable_pt f a) ->
         derivable_pt f (g x).
Proof.
  intros f g lb ub x lb_lt_ub x_encad g_wf f_deriv.
  apply f_deriv.
  apply g_wf; lra.
Qed.

Lemma derivable_pt_recip_interv
      (f g:R->R) (lb ub x : R)
      (lb_lt_ub:lb < ub) (x_encad:f lb < x < f ub)
      (f_eq_g:forall x : R, f lb <= x -> x <= f ub -> comp f g x = id x)
      (g_wf:forall x : R, f lb <= x -> x <= f ub -> lb <= g x <= ub)
      (f_incr:forall x y : R, lb <= x -> x < y -> y <= ub -> f x < f y)
      (f_derivable:forall a : R, lb <= a <= ub -> derivable_pt f a)
  : derive_pt f (g x)
              (derivable_pt_recip_interv_prelim1 f g lb ub x lb_lt_ub
                                                 x_encad g_wf f_derivable)
    <> 0 ->
    derivable_pt g x.
Proof.
  intros Df_neq.
  assert(g_incr : g (f lb) < g x < g (f ub)).
  { assert (Temp:= f_incr_implies_g_incr_interv f g lb ub lb_lt_ub f_incr f_eq_g g_wf).
    split ; apply Temp ; intuition.
    - exact (proj1 x_encad).
    - apply Rlt_le ; exact (proj2 x_encad).
    - apply Rlt_le ; exact (proj1 x_encad).
    - exact (proj2 x_encad). }
  assert(g_incr2 :  g (f lb) <= g x <= g (f ub)).
  { split ; apply Rlt_le ; intuition. }
  assert (g_eq_f :=  leftinv_is_rightinv_interv f g lb ub f_incr f_eq_g g_wf).
  unfold comp, id in g_eq_f.
  assert (f_derivable2 : forall a : R, g (f lb) <= a <= g (f ub) -> derivable_pt f a).
  { intros a a_encad ; apply f_derivable.
    rewrite g_eq_f in a_encad ; rewrite g_eq_f in a_encad ; intuition. }
  apply derivable_pt_recip_interv_prelim0 with
    (f:=f) (lb:=f lb) (ub:=f ub)
    (Prf:=f_derivable2) (Prg_incr:=g_incr2).
  - apply continuity_pt_recip_interv with (f:=f) (lb:=lb) (ub:=ub) ; intuition.
    + apply derivable_continuous_pt ; apply f_derivable ; intuition.
    + exact (proj1 x_encad).
    + exact (proj2 x_encad).
  - apply f_incr ; intuition.
  - assumption.
  - intros x0 x0_encad ; apply f_eq_g ; intuition.
  - rewrite pr_nu_var2_interv with
      (g:=f) (lb:=lb) (ub:=ub)
      (pr2:=derivable_pt_recip_interv_prelim1 f g lb ub x lb_lt_ub x_encad g_wf f_derivable);
      [| |rewrite g_eq_f in g_incr ; rewrite g_eq_f in g_incr| ] ; intuition.
Qed.

Lemma derivable_pt_recip_interv_decr (f g:R->R) (lb ub x : R)
      (lb_lt_ub:lb < ub)
      (x_encad:f ub < x < f lb)
      (f_eq_g:forall x : R, f ub <= x -> x <= f lb -> comp f g x = id x)
      (g_wf:forall x : R, f ub <= x -> x <= f lb -> lb <= g x <= ub)
      (f_decr:forall x y : R, lb <= x -> x < y -> y <= ub -> f y < f x)
      (f_derivable:forall a : R, lb <= a <= ub -> derivable_pt f a)
  : derive_pt f (g x)
              (derivable_pt_recip_interv_prelim1_decr f g lb ub x lb_lt_ub
                                                      x_encad g_wf f_derivable)
    <> 0 ->
    derivable_pt g x.
Proof.
  intros.
  apply derivable_pt_opp_rev.
  unshelve eapply (derivable_pt_recip_interv (mirr_fct f) (opp_fct g) (-ub) (-lb) (x)).
- lra.
- unfold mirr_fct; repeat rewrite Ropp_involutive; lra.
- intros x0 H1 H2.
  unfold mirr_fct in H1,H2; unfold opp_fct.
  rewrite Ropp_involutive in H1,H2.
  pose proof g_wf x0 as g_wfs; lra.
- intros x0 H1.
  apply derivable_pt_mirr, f_derivable; lra.
- intros x0 H1 H2.
  unfold mirr_fct in H1,H2 |-*; unfold opp_fct, comp.
  rewrite Ropp_involutive in H1,H2 |-*.
  apply f_eq_g; lra.
- intros x0 y0 H1 H2 H3.
  unfold mirr_fct.
  apply f_decr; lra.
- (* In order to rewrite with derive_pt_mirr the term must have the form
     derive_pt (mirr_fct f) _ (derivable_pt_mirr ...
     pr_nu is a sort of proof irrelevance lemma for derive_pt equalities *)
  unshelve erewrite (pr_nu _ _ _).
  + apply derivable_pt_mirr.
    unfold opp_fct; rewrite Ropp_involutive.
    apply f_derivable; apply g_wf; lra.
  + rewrite derive_pt_mirr.
    unfold opp_fct; rewrite Ropp_involutive.
    match goal with H:context[derive_pt _ _ ?pr] |- _ => rewrite (pr_nu f (g x) _ pr) end.
    apply Ropp_neq_0_compat.
    assumption.
Qed.

(****************************************************)
(** *   Value of the derivative of the reciprocal function        *)
(****************************************************)

Lemma derive_pt_recip_interv_prelim0 (f g:R->R) (lb ub x:R)
      (Prf:derivable_pt f (g x)) (Prg:derivable_pt g x)
  : lb < ub ->
    lb < x < ub ->
    (forall x, lb < x < ub -> (comp f g) x = id x) ->
    derive_pt f (g x) Prf <> 0 ->
    derive_pt g x Prg = 1 / (derive_pt f (g x) Prf).
Proof.
  intros lb_lt_ub x_encad local_recip Df_neq.
  replace (derive_pt g x Prg) with
    ((derive_pt g x Prg) * (derive_pt f (g x) Prf) * / (derive_pt f (g x) Prf)).
  { unfold Rdiv.
    rewrite (Rmult_comm _ (/ derive_pt f (g x) Prf)).
    rewrite (Rmult_comm _ (/ derive_pt f (g x) Prf)).
    apply Rmult_eq_compat_l.
    rewrite Rmult_comm.
    rewrite <- derive_pt_comp.
    assert (x_encad2 : lb <= x <= ub) by intuition.
    rewrite pr_nu_var2_interv with (g:=id) (pr2:= derivable_pt_id_interv lb ub x x_encad2) (lb:=lb) (ub:=ub) ; [reg| | |] ; assumption. }
  rewrite Rmult_assoc, Rinv_r.
  { intuition. }
  assumption.
Qed.

Lemma derive_pt_recip_interv_prelim1_0 : forall (f g:R->R) (lb ub x:R),
       lb < ub ->
       f lb < x < f ub ->
       (forall x y : R, lb <= x -> x < y -> y <= ub -> f x < f y) ->
       (forall x : R, f lb <= x -> x <= f ub -> lb <= g x <= ub) ->
       (forall x, f lb <= x -> x <= f ub -> (comp f g) x = id x) ->
       lb < g x < ub.
Proof.
intros f g lb ub x lb_lt_ub x_encad f_incr g_wf f_eq_g.
 assert (Temp:= f_incr_implies_g_incr_interv f g lb ub lb_lt_ub f_incr f_eq_g g_wf).
 assert (Left_inv := leftinv_is_rightinv_interv f g lb ub f_incr f_eq_g g_wf).
 unfold comp, id in Left_inv.
 split ; [rewrite <- Left_inv with (x:=lb) | rewrite <- Left_inv ];intuition.
Qed.

Lemma derive_pt_recip_interv_prelim1_1 : forall (f g:R->R) (lb ub x:R),
       lb < ub ->
       f lb < x < f ub ->
       (forall x y : R, lb <= x -> x < y -> y <= ub -> f x < f y) ->
       (forall x : R, f lb <= x -> x <= f ub -> lb <= g x <= ub) ->
       (forall x, f lb <= x -> x <= f ub -> (comp f g) x = id x) ->
       lb <= g x <= ub.
Proof.
intros f g lb ub x lb_lt_ub x_encad f_incr g_wf f_eq_g.
 assert (Temp := derive_pt_recip_interv_prelim1_0 f g lb ub x lb_lt_ub x_encad f_incr g_wf f_eq_g).
 split ; apply Rlt_le ; intuition.
Qed.

Lemma derive_pt_recip_interv_prelim1_1_decr : forall (f g:R->R) (lb ub x:R),
       lb < ub ->
       f ub < x < f lb ->
       (forall x y : R, lb <= x -> x < y -> y <= ub -> f y < f x) ->
       (forall x : R, f ub <= x -> x <= f lb -> lb <= g x <= ub) ->
       (forall x, f ub <= x -> x <= f lb -> (comp f g) x = id x) ->
       lb <= g x <= ub.
Proof.
  intros f g lb ub x lb_lt_ub x_encad f_decr g_wf f_eq_g.
  enough (-ub <= - g x <= - lb) by lra.
  unshelve eapply (derive_pt_recip_interv_prelim1_1 (mirr_fct f) (opp_fct g) (-ub) (-lb) (x)).
- lra.
- unfold mirr_fct; repeat rewrite Ropp_involutive; lra.
- intros x0 y0 H1 H2 H3.
  unfold mirr_fct.
  apply f_decr; lra.
- intros x0 H1 H2.
  unfold mirr_fct in H1,H2; unfold opp_fct.
  rewrite Ropp_involutive in H1,H2.
  pose proof g_wf x0 as g_wfs; lra.
- intros x0 H1 H2.
  unfold mirr_fct in H1,H2 |-*; unfold opp_fct, comp.
  rewrite Ropp_involutive in H1,H2 |-*.
  apply f_eq_g; lra.
Qed.

Lemma derive_pt_recip_interv : forall (f g:R->R) (lb ub x:R)
       (lb_lt_ub:lb < ub) (x_encad:f lb < x < f ub)
       (f_incr:forall x y : R, lb <= x -> x < y -> y <= ub -> f x < f y)
       (g_wf:forall x : R, f lb <= x -> x <= f ub -> lb <= g x <= ub)
       (Prf:forall a : R, lb <= a <= ub -> derivable_pt f a)
       (f_eq_g:forall x, f lb <= x -> x <= f ub -> (comp f g) x = id x)
       (Df_neq:derive_pt f (g x) (derivable_pt_recip_interv_prelim1 f g lb ub x
                 lb_lt_ub x_encad g_wf Prf) <> 0),
       derive_pt g x (derivable_pt_recip_interv f g lb ub x lb_lt_ub x_encad f_eq_g
                 g_wf f_incr Prf Df_neq)
       =
       1 / (derive_pt f (g x) (Prf (g x) (derive_pt_recip_interv_prelim1_1 f g lb ub x
       lb_lt_ub x_encad f_incr g_wf f_eq_g))).
Proof.
intros.
 assert(g_incr := (derive_pt_recip_interv_prelim1_1 f g lb ub x lb_lt_ub
        x_encad f_incr g_wf f_eq_g)).
 apply derive_pt_recip_interv_prelim0 with (lb:=f lb) (ub:=f ub) ;
 [intuition |assumption | intuition |].
 intro Hfalse ; apply Df_neq.  rewrite pr_nu_var2_interv with (g:=f) (lb:=lb) (ub:=ub)
        (pr2:= (Prf (g x) (derive_pt_recip_interv_prelim1_1 f g lb ub x lb_lt_ub x_encad
                 f_incr g_wf f_eq_g))) ;
 [intuition | intuition | | intuition].
 exact (derive_pt_recip_interv_prelim1_0 f g lb ub x lb_lt_ub x_encad f_incr g_wf f_eq_g).
Qed.

Lemma derive_pt_recip_interv_decr : forall (f g:R->R) (lb ub x:R)
       (lb_lt_ub:lb < ub)
       (x_encad:f ub < x < f lb)
       (f_decr:forall x y : R, lb <= x -> x < y -> y <= ub -> f y < f x)
       (g_wf:forall x : R, f ub <= x -> x <= f lb -> lb <= g x <= ub)
       (Prf:forall a : R, lb <= a <= ub -> derivable_pt f a)
       (f_eq_g:forall x, f ub <= x -> x <= f lb -> (comp f g) x = id x)
       (Df_neq:derive_pt f (g x) (derivable_pt_recip_interv_prelim1_decr f g lb ub x
                 lb_lt_ub x_encad g_wf Prf) <> 0),
       derive_pt g x (derivable_pt_recip_interv_decr f g lb ub x lb_lt_ub x_encad f_eq_g
                 g_wf f_decr Prf Df_neq)
       =
       1 / (derive_pt f (g x) (Prf (g x) (derive_pt_recip_interv_prelim1_1_decr f g lb ub x
       lb_lt_ub x_encad f_decr g_wf f_eq_g))).
Proof.
  (* This proof based on derive_pt_recip_interv looks fairly long compared to the direct proof above,
     but the direct proof needs a lot of lengthy preparation lemmas e.g. derivable_pt_lim_recip_interv. *)
  intros.
  (* Note: here "unshelve epose" with proving the premises first does not work.
     The more abstract form with the unbound evars has less issues with dependent rewriting. *)
  epose proof (derive_pt_recip_interv (mirr_fct f) (opp_fct g) (-ub) (-lb) (x) _ _ _ _ _ _ _).
  rewrite derive_pt_mirr_rev in H.
  rewrite derive_pt_opp_rev in H.
  unfold opp_fct in H.
  match goal with
  | H:context[derive_pt ?f ?x1 ?pr1] |- context[derive_pt ?f ?x2 ?pr2] =>
      rewrite (pr_nu_xeq f x1 x2 pr1 pr2 (Ropp_involutive x2)) in H
  end.
  match goal with
  | H:context[derive_pt ?f ?x ?pr1] |- context[derive_pt ?f ?x ?pr2] =>
      rewrite (pr_nu f x pr1 pr2) in H
  end.
  apply Ropp_eq_compat in H; rewrite Ropp_involutive in H.
  rewrite H; field.
  pose proof Df_neq as Df_neq'.
  match goal with
  | H:context[derive_pt ?f ?x ?pr1] |- context[derive_pt ?f ?x ?pr2] =>
      rewrite (pr_nu f x pr1 pr2) in H
  end.
  assumption.

Unshelve.
- abstract lra.
- unfold mirr_fct; repeat rewrite Ropp_involutive; abstract lra.
- intros x0 y0 H1 H2 H3.
  unfold mirr_fct.
  apply f_decr; abstract lra.
- intros x0 H1 H2.
  unfold mirr_fct in H1,H2; unfold opp_fct.
  rewrite Ropp_involutive in H1,H2.
  pose proof g_wf x0 as g_wfs; abstract lra.
- intros x0 H1.
  apply derivable_pt_mirr, Prf; abstract lra.
- intros x0 H1 H2.
  unfold mirr_fct in H1,H2 |-*; unfold opp_fct, comp.
  rewrite Ropp_involutive in H1,H2 |-*.
  apply f_eq_g; abstract lra.
- unshelve erewrite (pr_nu _ _ _).
  { apply derivable_pt_mirr.
    unfold opp_fct; rewrite Ropp_involutive.
    apply Prf; apply g_wf; abstract lra. }
  rewrite derive_pt_mirr.
  unfold opp_fct; rewrite Ropp_involutive.
  apply Ropp_neq_0_compat.
  erewrite (pr_nu _ _ _).
  apply Df_neq.
Qed.

(****************************************************)
(** * Existence of the derivative of a function which is the limit of a sequence of functions *)
(****************************************************)

(* begin hide *)
Lemma ub_lt_2_pos : forall x ub lb, lb < x -> x < ub -> 0 < (ub-lb)/2.
Proof.
intros x ub lb lb_lt_x x_lt_ub.
lra.
Qed.

Definition mkposreal_lb_ub (x lb ub:R) (lb_lt_x:lb<x) (x_lt_ub:x<ub) : posreal.
 apply (mkposreal ((ub-lb)/2) (ub_lt_2_pos x ub lb lb_lt_x x_lt_ub)).
Defined.
(* end hide *)

Lemma derivable_pt_lim_CVU (fn fn':nat -> R -> R) (f g:R->R)
      (x:R) : forall c r,
    Boule c r x ->
    (forall y n, Boule c r y -> derivable_pt_lim (fn n) y (fn' n y)) ->
    (forall y, Boule c r y -> Un_cv (fun n => fn n y) (f y)) ->
    (CVU fn' g c r) ->
    (forall y, Boule c r y -> continuity_pt g y) ->
    derivable_pt_lim f x (g x).
Proof.
  intros c' r xinb Dfn_eq_fn' fn_CV_f fn'_CVU_g g_cont eps eps_pos.
  assert (eps_8_pos : 0 < eps / 8) by lra.
  elim (g_cont x xinb _ eps_8_pos) ; clear g_cont ;
    intros delta1 (delta1_pos, g_cont).
  destruct (Ball_in_inter _ _ _ _ _ xinb
                          (Boule_center x (mkposreal _ delta1_pos)))
    as [delta Pdelta].
  exists delta; intros h hpos hinbdelta.
  assert (eps'_pos : 0 < (Rabs h) * eps / 4).
  { unfold Rdiv ; rewrite Rmult_assoc ; apply Rmult_lt_0_compat.
    { apply Rabs_pos_lt ; assumption. }
    lra. }
  destruct (fn_CV_f x xinb ((Rabs h) * eps / 4) eps'_pos) as [N2 fnx_CV_fx].
  assert (xhinbxdelta : Boule x delta (x + h)).
  { clear -hinbdelta; apply Rabs_def2 in hinbdelta; unfold Boule; simpl.
    destruct hinbdelta; apply Rabs_def1; lra. }
  assert (t : Boule c' r (x + h)).
  { apply Pdelta in xhinbxdelta; tauto. }
  destruct (fn_CV_f (x+h) t ((Rabs h) * eps / 4) eps'_pos) as [N1 fnxh_CV_fxh].
  clear fn_CV_f t.
  destruct (fn'_CVU_g (eps/8) eps_8_pos) as [N3 fn'c_CVU_gc].
  pose (N := ((N1 + N2) + N3)%nat).
  assert (Main : Rabs ((f (x+h) - fn N (x+h)) - (f x - fn N x) + (fn N (x+h) - fn N x - h * (g x))) < (Rabs h)*eps).
  2:{ replace ((f (x + h) - f x) / h - g x) with ((/h) * ((f (x + h) - f x) - h * g x))
    by (field;assumption).
      rewrite Rabs_mult ; rewrite Rabs_inv.
      replace eps with (/ Rabs h * (Rabs h * eps)).
      { apply Rmult_lt_compat_l.
        { apply Rinv_0_lt_compat ; apply Rabs_pos_lt ; assumption. }
        replace (f (x + h) - f x - h * g x) with
          (f (x + h) - fn N (x + h) - (f x - fn N x) + (fn N (x + h) - fn N x - h * g x))
          by field.
        assumption. }
      field ; apply Rgt_not_eq ; apply Rabs_pos_lt ; assumption. }
  apply Rle_lt_trans with (Rabs (f (x + h) - fn N (x + h) - (f x - fn N x)) +  Rabs ((fn N (x + h) - fn N x - h * g x))).
  { solve[apply Rabs_triang]. }
  apply Rle_lt_trans with (Rabs (f (x + h) - fn N (x + h)) + Rabs (- (f x - fn N x)) + Rabs (fn N (x + h) - fn N x - h * g x)).
  { solve[apply Rplus_le_compat_r ; apply Rabs_triang]. }
  rewrite Rabs_Ropp.
  case (Rlt_le_dec h 0) ; intro sgn_h.
  { assert (pr1 : forall c : R, x + h < c < x -> derivable_pt (fn N) c).
    { intros c c_encad ; unfold derivable_pt.
      exists (fn' N c) ; apply Dfn_eq_fn'.
      assert (t : Boule x delta c).
      { apply Rabs_def2 in xhinbxdelta; destruct xhinbxdelta; destruct c_encad.
        apply Rabs_def2 in xinb; apply Rabs_def1; lra. }
      apply Pdelta in t; tauto. }
    assert (pr2 : forall c : R, x + h < c < x -> derivable_pt id c).
    { solve[intros; apply derivable_id]. }
    assert (xh_x : x+h < x) by lra.
    assert (pr3 : forall c : R, x + h <= c <= x -> continuity_pt (fn N) c).
    { intros c c_encad ; apply derivable_continuous_pt.
      exists (fn' N c) ; apply Dfn_eq_fn' ; intuition.
      assert (t : Boule x delta c).
      { apply Rabs_def2 in xhinbxdelta; destruct xhinbxdelta.
        apply Rabs_def2 in xinb; apply Rabs_def1; lra. }
      apply Pdelta in t; tauto. }
    assert (pr4 : forall c : R, x + h <= c <= x -> continuity_pt id c).
    { solve[intros; apply derivable_continuous ; apply derivable_id]. }
    destruct (MVT (fn N) id (x+h) x pr1 pr2 xh_x pr3 pr4) as [c [P Hc]].
    assert (Hc' : h * derive_pt (fn N) c (pr1 c P) = (fn N (x+h) - fn N x)).
    { apply Rmult_eq_reg_l with (-1).
      { replace (-1 * (h * derive_pt (fn N) c (pr1 c P))) with (-h * derive_pt (fn N) c (pr1 c P)) by field.
        replace (-1 * (fn N (x + h) - fn N x)) with (- (fn N (x + h) - fn N x)) by field.
        replace (-h) with (id x - id (x + h)) by (unfold id; field).
        rewrite <- Rmult_1_r ; replace 1 with (derive_pt id c (pr2 c P)) by reg.
        replace (- (fn N (x + h) - fn N x)) with (fn N x - fn N (x + h)) by field.
        assumption. }
      now apply Rlt_not_eq, IZR_lt. }
    rewrite <- Hc'; clear Hc Hc'.
    replace (derive_pt (fn N) c (pr1 c P)) with (fn' N c).
    2:{ assert (H := pr1 c P) ; elim H ; clear H ; intros l Hl.
        assert (Temp : l = fn' N c).
        { assert (bc'rc : Boule c' r c).
          { assert (t : Boule x delta c).
            { clear - xhinbxdelta P.
              destruct P; apply Rabs_def2 in xhinbxdelta; destruct xhinbxdelta.
              apply Rabs_def1; lra. }
            apply Pdelta in t; tauto. }
          assert (Hl' := Dfn_eq_fn' c N bc'rc).
          unfold derivable_pt_abs in Hl; clear -Hl Hl'.
          apply uniqueness_limite with (f:= fn N) (x:=c) ; assumption. }
        rewrite <- Temp.
        assert (Hl' : derivable_pt (fn N) c).
        { exists l ; apply Hl. }
        rewrite pr_nu_var with (g:= fn N) (pr2:=Hl').
        { elim Hl' ; clear Hl' ; intros l' Hl'.
          assert (Main : l = l').
          { apply uniqueness_limite with (f:= fn N) (x:=c) ; assumption. }
          rewrite Main ; reflexivity. }
        reflexivity. }
    replace (h * fn' N c - h * g x) with (h * (fn' N c - g x)) by field.
    rewrite Rabs_mult.
    apply Rlt_trans with (Rabs h * eps / 4 + Rabs (f x - fn N x) + Rabs h * Rabs (fn' N c - g x)).
    { apply Rplus_lt_compat_r ; apply Rplus_lt_compat_r ; unfold Rdist in fnxh_CV_fxh ;
        rewrite Rabs_minus_sym ; apply fnxh_CV_fxh.
      unfold N; lia. }
    apply Rlt_trans with (Rabs h * eps / 4 + Rabs h * eps / 4 + Rabs h * Rabs (fn' N c - g x)).
    { apply Rplus_lt_compat_r ; apply Rplus_lt_compat_l.
      unfold Rdist in fnx_CV_fx ; rewrite Rabs_minus_sym ; apply fnx_CV_fx.
      unfold N ; lia. }
    replace (fn' N c - g x)  with ((fn' N c - g c) +  (g c - g x)) by field.
    apply Rle_lt_trans with (Rabs h * eps / 4 + Rabs h * eps / 4 +
                               Rabs h * Rabs (fn' N c - g c) + Rabs h * Rabs (g c - g x)).
    { rewrite Rplus_assoc ; rewrite Rplus_assoc ; rewrite Rplus_assoc ;
        apply Rplus_le_compat_l ; apply Rplus_le_compat_l ;
        rewrite <- Rmult_plus_distr_l ; apply Rmult_le_compat_l.
      { solve[apply Rabs_pos]. }
      solve[apply Rabs_triang]. }
    apply Rlt_trans with (Rabs h * eps / 4 + Rabs h * eps / 4 +
                            Rabs h * (eps / 8) + Rabs h * Rabs (g c - g x)).
    { apply Rplus_lt_compat_r; apply Rplus_lt_compat_l; apply Rmult_lt_compat_l.
      { apply Rabs_pos_lt ; assumption. }
      rewrite Rabs_minus_sym ; apply fn'c_CVU_gc.
      { unfold N ; lia. }
      assert (t : Boule x delta c).
      { destruct P.
        apply Rabs_def2 in xhinbxdelta; destruct xhinbxdelta.
        apply Rabs_def2 in xinb; apply Rabs_def1; lra. }
      apply Pdelta in t; tauto. }
    apply Rlt_trans with (Rabs h * eps / 4 + Rabs h * eps / 4 + Rabs h * (eps / 8) +
                            Rabs h * (eps / 8)).
    { rewrite Rplus_assoc ; rewrite Rplus_assoc ; rewrite Rplus_assoc ; rewrite Rplus_assoc ;
        apply Rplus_lt_compat_l ; apply Rplus_lt_compat_l ; rewrite <- Rmult_plus_distr_l ;
        rewrite <- Rmult_plus_distr_l ; apply Rmult_lt_compat_l.
      { apply Rabs_pos_lt ; assumption. }
      apply Rplus_lt_compat_l ; simpl in g_cont ; apply g_cont ; split ; [unfold D_x ; split |].
      - solve[unfold no_cond ; intuition].
      - apply Rgt_not_eq ; exact (proj2 P).
      - apply Rlt_trans with (Rabs h).
        { apply Rabs_def1.
          { apply Rlt_trans with 0.
            { destruct P; lra. }
            apply Rabs_pos_lt ; assumption. }
          rewrite <- Rabs_Ropp, Rabs_pos_eq, Ropp_involutive;[ | lra].
          destruct P; lra. }
        clear -Pdelta xhinbxdelta.
        apply Pdelta in xhinbxdelta; destruct xhinbxdelta as [_ P'].
        apply Rabs_def2 in P'; simpl in P'; destruct P';
          apply Rabs_def1; lra. }
    rewrite Rplus_assoc ; rewrite Rplus_assoc ; rewrite <- Rmult_plus_distr_l.
    replace (Rabs h * eps / 4 + (Rabs h * eps / 4 + Rabs h * (eps / 8 + eps / 8))) with
      (Rabs h * (eps / 4 + eps / 4 + eps / 8 + eps / 8)) by field.
    apply Rmult_lt_compat_l.
    { apply Rabs_pos_lt ; assumption. }
    lra. }
  assert (h_pos : h > 0).
  { case sgn_h ; intro Hyp.
    { assumption. }
    apply False_ind ; apply hpos ; symmetry ; assumption. }
  clear sgn_h.
  assert (pr1 : forall c : R, x < c < x + h -> derivable_pt (fn N) c).
  { intros c c_encad ; unfold derivable_pt.
    exists (fn' N c) ; apply Dfn_eq_fn'.
    assert (t : Boule x delta c).
    { apply Rabs_def2 in xhinbxdelta; destruct xhinbxdelta; destruct c_encad.
      apply Rabs_def2 in xinb; apply Rabs_def1; lra. }
    apply Pdelta in t; tauto. }
  assert (pr2 : forall c : R, x < c < x + h -> derivable_pt id c).
  { solve[intros; apply derivable_id]. }
  assert (xh_x : x < x + h) by lra.
  assert (pr3 : forall c : R, x <= c <= x + h -> continuity_pt (fn N) c).
  { intros c c_encad ; apply derivable_continuous_pt.
    exists (fn' N c) ; apply Dfn_eq_fn' ; intuition.
    assert (t : Boule x delta c).
    { apply Rabs_def2 in xhinbxdelta; destruct xhinbxdelta.
      apply Rabs_def2 in xinb; apply Rabs_def1; lra. }
    apply Pdelta in t; tauto. }
  assert (pr4 : forall c : R, x <= c <= x + h -> continuity_pt id c).
  { solve[intros; apply derivable_continuous ; apply derivable_id]. }
  destruct (MVT (fn N) id x (x+h) pr1 pr2 xh_x pr3 pr4) as [c [P Hc]].
  assert (Hc' : h * derive_pt (fn N) c (pr1 c P) = fn N (x+h) - fn N x).
  { pattern h at 1; replace h with (id (x + h) - id x) by (unfold id; field).
    rewrite <- Rmult_1_r ; replace 1 with (derive_pt id c (pr2 c P)) by reg.
    assumption. }
  rewrite <- Hc'; clear Hc Hc'.
  replace (derive_pt (fn N) c (pr1 c P)) with (fn' N c).
  { replace (h * fn' N c - h * g x) with (h * (fn' N c - g x)) by field.
    rewrite Rabs_mult.
    apply Rlt_trans with (Rabs h * eps / 4 + Rabs (f x - fn N x) + Rabs h * Rabs (fn' N c - g x)).
    { apply Rplus_lt_compat_r ; apply Rplus_lt_compat_r ; unfold Rdist in fnxh_CV_fxh ;
        rewrite Rabs_minus_sym ; apply fnxh_CV_fxh.
      unfold N; lia. }
    apply Rlt_trans with (Rabs h * eps / 4 + Rabs h * eps / 4 + Rabs h * Rabs (fn' N c - g x)).
    { apply Rplus_lt_compat_r ; apply Rplus_lt_compat_l.
      unfold Rdist in fnx_CV_fx ; rewrite Rabs_minus_sym ; apply fnx_CV_fx.
      unfold N ; lia. }
    replace (fn' N c - g x)  with ((fn' N c - g c) +  (g c - g x)) by field.
    apply Rle_lt_trans with (Rabs h * eps / 4 + Rabs h * eps / 4 +
                               Rabs h * Rabs (fn' N c - g c) + Rabs h * Rabs (g c - g x)).
    { rewrite Rplus_assoc ; rewrite Rplus_assoc ; rewrite Rplus_assoc ;
        apply Rplus_le_compat_l ; apply Rplus_le_compat_l ;
        rewrite <- Rmult_plus_distr_l ; apply Rmult_le_compat_l.
      { solve[apply Rabs_pos]. }
      solve[apply Rabs_triang]. }
    apply Rlt_trans with (Rabs h * eps / 4 + Rabs h * eps / 4 +
                            Rabs h * (eps / 8) + Rabs h * Rabs (g c - g x)).
    { apply Rplus_lt_compat_r; apply Rplus_lt_compat_l; apply Rmult_lt_compat_l.
      { apply Rabs_pos_lt ; assumption. }
      rewrite Rabs_minus_sym ; apply fn'c_CVU_gc.
      { unfold N ; lia. }
      assert (t : Boule x delta c).
      { destruct P.
        apply Rabs_def2 in xhinbxdelta; destruct xhinbxdelta.
        apply Rabs_def2 in xinb; apply Rabs_def1; lra. }
      apply Pdelta in t; tauto. }
    apply Rlt_trans with (Rabs h * eps / 4 + Rabs h * eps / 4 + Rabs h * (eps / 8) +
                            Rabs h * (eps / 8)).
    { rewrite Rplus_assoc ; rewrite Rplus_assoc ; rewrite Rplus_assoc ; rewrite Rplus_assoc ;
        apply Rplus_lt_compat_l ; apply Rplus_lt_compat_l ; rewrite <- Rmult_plus_distr_l ;
        rewrite <- Rmult_plus_distr_l ; apply Rmult_lt_compat_l.
      { apply Rabs_pos_lt ; assumption. }
      apply Rplus_lt_compat_l ; simpl in g_cont ; apply g_cont ; split ; [unfold D_x ; split |].
      - solve[unfold no_cond ; intuition].
      - apply Rlt_not_eq ; exact (proj1 P).
      - apply Rlt_trans with (Rabs h).
        { apply Rabs_def1.
          { destruct P; rewrite Rabs_pos_eq;lra. }
          apply Rle_lt_trans with 0.
          { assert (t := Rabs_pos h); clear -t; lra. }
          clear -P; destruct P; lra. }
        clear -Pdelta xhinbxdelta.
        apply Pdelta in xhinbxdelta; destruct xhinbxdelta as [_ P'].
        apply Rabs_def2 in P'; simpl in P'; destruct P';
          apply Rabs_def1; lra. }
    rewrite Rplus_assoc ; rewrite Rplus_assoc ; rewrite <- Rmult_plus_distr_l.
    replace (Rabs h * eps / 4 + (Rabs h * eps / 4 + Rabs h * (eps / 8 + eps / 8))) with
      (Rabs h * (eps / 4 + eps / 4 + eps / 8 + eps / 8)) by field.
    apply Rmult_lt_compat_l.
    { apply Rabs_pos_lt ; assumption. }
    lra. }
  assert (H := pr1 c P) ; elim H ; clear H ; intros l Hl.
  assert (Temp : l = fn' N c).
  { assert (bc'rc : Boule c' r c).
    { assert (t : Boule x delta c).
      { clear - xhinbxdelta P.
        destruct P; apply Rabs_def2 in xhinbxdelta; destruct xhinbxdelta.
        apply Rabs_def1; lra. }
      apply Pdelta in t; tauto. }
    assert (Hl' := Dfn_eq_fn' c N bc'rc).
    unfold derivable_pt_abs in Hl; clear -Hl Hl'.
    apply uniqueness_limite with (f:= fn N) (x:=c) ; assumption. }
  rewrite <- Temp.
  assert (Hl' : derivable_pt (fn N) c).
  { exists l ; apply Hl. }
  rewrite pr_nu_var with (g:= fn N) (pr2:=Hl').
  { elim Hl' ; clear Hl' ; intros l' Hl'.
    assert (Main : l = l').
    { apply uniqueness_limite with (f:= fn N) (x:=c) ; assumption. }
    rewrite Main ; reflexivity. }
  reflexivity.
Qed.
