From Coq Require Import Lra.

Require Import Gappa_common.
Require Import Gappa_pred_bnd.

Theorem bnd_of_nzr_rel :
 forall a b : R, forall zi : FF,
 NZR b -> REL a b zi ->
 BND ((a - b) / b) zi.
Proof.
intros a b zi Hb (x,(Hr1,Hr2)).
replace ((a - b) / b)%R with x.
exact Hr1.
rewrite Hr2.
field.
exact Hb.
Qed.

Theorem bnd_of_rel :
  forall a b : R, forall zi : FF,
  REL a b zi ->
  contains_zero_helper zi = true ->
  BND ((a - b) / b) zi.
Proof.
  intros a b zi [x [Hx ->]] Hb.
  destruct (Req_dec b 0) as [->|Zb].
  rewrite Rdiv_0_r.
  now apply contains_zero.
  replace (_ / b)%R with x by now field.
  exact Hx.
Qed.

Theorem rel_of_nzr_bnd :
  forall a b : R, forall zi : FF,
  NZR b -> BND ((a - b) / b) zi ->
  REL a b zi.
Proof.
intros a b zi Hb Hr.
exists ((a - b) / b)%R.
split.
exact Hr.
now field.
Qed.

Definition one_plus (xi : FF) :=
  makepairF (Fplus2 (Float2 1 0) (lower xi)) (Fplus2 (Float2 1 0) (upper xi)).

Lemma one_plus_correct :
  forall x xi,
  BND x xi ->
  BND (1 + x) (one_plus xi).
Proof.
intros x xi Hx.
apply IRplus with (xl := 1%R) (xu := 1%R) (4 := Hx) ; simpl.
rewrite Fplus2_correct.
apply Rplus_le_compat_r.
unfold float2R, Defs.F2R. simpl.
rewrite Rmult_1_l.
apply Rle_refl.
rewrite Fplus2_correct.
apply Rplus_le_compat_r.
unfold float2R, Defs.F2R. simpl.
rewrite Rmult_1_l.
apply Rle_refl.
split ; apply Rle_refl.
Qed.

Theorem bnd_of_bnd_rel_p :
  forall x y : R, forall yi ei xi : FF,
  BND y yi -> REL x y ei ->
  mul_pp_helper yi (one_plus ei) xi = true ->
  BND x xi.
Proof.
intros x y yi ei xi Hy (e,(He1,He2)) Hb.
rewrite He2.
apply mul_pp with (1 := Hy) (3 := Hb).
apply one_plus_correct with (1 := He1).
Qed.

Theorem bnd_of_bnd_rel_o :
  forall x y : R, forall yi ei xi : FF,
  BND y yi -> REL x y ei ->
  mul_op_helper yi (one_plus ei) xi = true ->
  BND x xi.
Proof.
intros x y yi ei xi Hy (e,(He1,He2)) Hb.
rewrite He2.
apply mul_op with (1 := Hy) (3 := Hb).
apply one_plus_correct with (1 := He1).
Qed.

Theorem bnd_of_bnd_rel_n :
  forall x y : R, forall yi ei xi : FF,
  BND y yi -> REL x y ei ->
  mul_np_helper yi (one_plus ei) xi = true ->
  BND x xi.
Proof.
intros x y yi ei xi Hy (e,(He1,He2)) Hb.
rewrite He2.
apply mul_np with (1 := Hy) (3 := Hb).
apply one_plus_correct with (1 := He1).
Qed.

Lemma rel_swap :
  forall x y e ei,
  BND e ei ->
  x = (y * (1 + e))%R ->
  Fpos (lower (one_plus ei)) = true ->
  y = (x / (1 + e))%R.
Proof.
intros x y e ei He Hx Hb.
rewrite Hx.
field.
apply Rgt_not_eq.
apply Rlt_gt.
assert (H := one_plus_correct _ _ He).
destruct H as (H,_).
apply Rlt_le_trans with (2 := H).
now apply Fpos_correct.
Qed.

Theorem bnd_of_rel_bnd_p :
  forall x y : R, forall xi ei yi : FF,
  BND x xi -> REL x y ei ->
  div_pp_helper xi (one_plus ei) yi = true ->
  BND y yi.
Proof.
intros x y yi ei xi Hy (e,(He1,He2)) Hb.
destruct (andb_prop _ _ Hb) as (H1,_).
generalize (andb_prop _ _ H1). clear H1. intros (H1,_).
generalize (andb_prop _ _ H1). clear H1. intros (H1,_).
rewrite rel_swap with (1 := He1) (2 := He2) (3 := H1).
apply div_pp with (1 := Hy) (3 := Hb).
apply one_plus_correct with (1 := He1).
Qed.

Theorem bnd_of_rel_bnd_o :
  forall x y : R, forall xi ei yi : FF,
  BND x xi -> REL x y ei ->
  div_op_helper xi (one_plus ei) yi = true ->
  BND y yi.
Proof.
intros x y yi ei xi Hy (e,(He1,He2)) Hb.
destruct (andb_prop _ _ Hb) as (H1,_).
generalize (andb_prop _ _ H1). clear H1. intros (H1,_).
generalize (andb_prop _ _ H1). clear H1. intros (H1,_).
generalize (andb_prop _ _ H1). clear H1. intros (H1,_).
rewrite rel_swap with (1 := He1) (2 := He2) (3 := H1).
apply div_op with (1 := Hy) (3 := Hb).
apply one_plus_correct with (1 := He1).
Qed.

Theorem bnd_of_rel_bnd_n :
  forall x y : R, forall xi ei yi : FF,
  BND x xi -> REL x y ei ->
  div_np_helper xi (one_plus ei) yi = true ->
  BND y yi.
Proof.
intros x y yi ei xi Hy (e,(He1,He2)) Hb.
destruct (andb_prop _ _ Hb) as (H1,_).
generalize (andb_prop _ _ H1). clear H1. intros (H1,_).
generalize (andb_prop _ _ H1). clear H1. intros (H1,_).
rewrite rel_swap with (1 := He1) (2 := He2) (3 := H1).
apply div_np with (1 := Hy) (3 := Hb).
apply one_plus_correct with (1 := He1).
Qed.

Theorem rel_refl :
  forall a : R, forall zi : FF,
  contains_zero_helper zi = true ->
  REL a a zi.
Proof.
intros a zi Hb.
exists R0.
split.
now apply contains_zero.
ring.
Qed.

Lemma error_of_rel_generic :
 forall f,
 forall t: (forall x y : R, forall xi yi zi : FF,
            BND x xi -> BND y yi -> f xi yi zi = true ->
            BND (x * y) zi),
 forall a b : R, forall xi yi zi : FF,
 REL a b xi -> BND b yi ->
 f xi yi zi = true ->
 BND (a - b) zi.
Proof.
intros f t a b xi yi zi (x,(Hr1,Hr2)).
replace (a - b)%R with (x * b)%R.
now apply t.
rewrite Hr2.
ring.
Qed.

Definition error_of_rel_pp := error_of_rel_generic mul_pp_helper mul_pp.
Definition error_of_rel_po := error_of_rel_generic mul_po_helper mul_po.
Definition error_of_rel_pn := error_of_rel_generic mul_pn_helper mul_pn.
Definition error_of_rel_op := error_of_rel_generic mul_op_helper mul_op.
Definition error_of_rel_oo := error_of_rel_generic mul_oo_helper mul_oo.
Definition error_of_rel_on := error_of_rel_generic mul_on_helper mul_on.
Definition error_of_rel_np := error_of_rel_generic mul_np_helper mul_np.
Definition error_of_rel_no := error_of_rel_generic mul_no_helper mul_no.
Definition error_of_rel_nn := error_of_rel_generic mul_nn_helper mul_nn.

Theorem rel_subset :
  forall x xr : R, forall xi zi : FF,
  REL x xr xi ->
  subset_helper xi zi = true ->
  REL x xr zi.
Proof.
intros x xr xi zi (xe,(Hx1,Hx2)) Hb.
generalize (andb_prop _ _ Hb). clear Hb. intros (H1,H2).
apply Fle2_correct in H1.
apply Fle2_correct in H2.
exists xe.
split.
apply IRsubset with (1 := H1) (2 := H2) (3 := Hx1).
exact Hx2.
Qed.

Definition intersect_rr_helper (xf yf : float2) (zi : FF) :=
  Fle2 (lower zi) (upper zi) &&
  Fle2 (lower zi) yf &&
  Fle2 xf (upper zi).

Theorem intersect_rr :
  forall z1 z2 : R, forall xi yi zi : FF,
  REL z1 z2 xi -> REL z1 z2 yi ->
  intersect_rr_helper (upper xi) (lower yi) zi = true ->
  REL z1 z2 zi.
Proof.
intros z1 z2 xi yi zi (xe,(Hx1,Hx2)) (ye,(Hy1,Hy2)) Hb.
generalize (andb_prop _ _ Hb). clear Hb. intros (Hb,H3).
generalize (andb_prop _ _ Hb). clear Hb. intros (H1,H2).
apply Fle2_correct in H1.
apply Fle2_correct in H2.
apply Fle2_correct in H3.
case (Req_dec z2 0) ; intro.
exists (float2R (lower zi)).
split.
split.
apply Rle_refl.
exact H1.
rewrite Hx2.
rewrite H.
repeat rewrite Rmult_0_l.
apply refl_equal.
exists xe.
split.
split.
apply Rle_trans with (1 := H2).
replace xe with ye.
apply Hy1.
apply Rplus_eq_reg_l with 1%R.
apply Rmult_eq_reg_l with (2 := H).
now rewrite <- Hy2.
now apply Rle_trans with (2 := H3).
exact Hx2.
Qed.

Definition intersect_rr0_helper (xf yf : float2) (zi : FF) :=
  Flt2 xf yf &&
  Fneg0 (lower zi) &&
  Fpos0 (upper zi).

Theorem intersect_rr0 :
  forall z1 z2 : R, forall xi yi zi : FF,
  REL z1 z2 xi -> REL z1 z2 yi ->
  intersect_rr0_helper (upper xi) (lower yi) zi = true ->
  BND z2 zi.
Proof.
intros z1 z2 xi yi zi (xe,(Hx1,Hx2)) (ye,(Hy1,Hy2)) Hb.
generalize (andb_prop _ _ Hb). clear Hb. intros (Hb,H3).
generalize (andb_prop _ _ Hb). clear Hb. intros (H1,H2).
apply Flt2_correct in H1.
apply Fneg0_correct in H2.
apply Fpos0_correct in H3.
destruct (Req_dec z2 0) as [Hz|Hz].
rewrite Hz.
now split.
elim (Rle_not_lt xe ye).
apply Req_le.
apply Rplus_eq_reg_l with 1%R.
apply Rmult_eq_reg_l with (2 := Hz).
now rewrite <- Hy2.
apply Rle_lt_trans with (1 := proj2 Hx1).
apply Rlt_le_trans with (2 := proj1 Hy1).
exact H1.
Qed.

Definition mul_rr_helper (xi yi zi : FF) :=
  Fle2_m1 (lower xi) &&
  Fle2_m1 (lower yi) &&
  Fle2 (lower zi) (Fplus2 (Fplus2 (lower xi) (lower yi))
                          (Fmult2 (lower xi) (lower yi))) &&
  Fle2 (Fplus2 (Fplus2 (upper xi) (upper yi))
               (Fmult2 (upper xi) (upper yi))) (upper zi).

Theorem mul_rr :
  forall x1 x2 y1 y2 : R, forall xi yi zi : FF,
  REL x1 x2 xi -> REL y1 y2 yi ->
  mul_rr_helper xi yi zi = true ->
  REL (x1 * y1) (x2 * y2) zi.
Proof.
intros x1 x2 y1 y2 xi yi zi (xe,(Hx1,Hx2)) (ye,(Hy1,Hy2)) Hb.
generalize (andb_prop _ _ Hb). clear Hb. intros (Hb,H4).
generalize (andb_prop _ _ Hb). clear Hb. intros (Hb,H3).
generalize (andb_prop _ _ Hb). clear Hb. intros (H1,H2).
apply Fle2_m1_correct in H1.
apply Fle2_m1_correct in H2.
generalize (Fle2_correct _ _ H3).
repeat rewrite Fplus2_correct.
rewrite Fmult2_correct. clear H3. intro H3.
generalize (Fle2_correct _ _ H4).
repeat rewrite Fplus2_correct.
rewrite Fmult2_correct. clear H4. intro H4.
exists (xe + ye + xe * ye)%R.
split.
apply IRcompose with (1 := H1) (2 := H2) (3 := H3) (4 := H4) (5 := Hx1) (6 := Hy1).
rewrite Hx2.
rewrite Hy2.
ring.
Qed.

Definition div_rr_helper (xi yi zi : FF) :=
  Fle2_m1 (lower xi) &&
  Flt2_m1 (lower yi) &&
  Fle2 (upper xi) (Fplus2 (Fplus2 (lower yi) (upper zi))
                          (Fmult2 (lower yi) (upper zi))) &&
  Fle2 (Fplus2 (Fplus2 (upper yi) (lower zi))
               (Fmult2 (upper yi) (lower zi))) (lower xi).

Theorem div_rr' :
  forall x1 x2 y1 y2 : R, forall xi yi zi : FF,
  REL x1 x2 xi -> REL y1 y2 yi ->
  div_rr_helper xi yi zi = true ->
  REL (x1 / y1) (x2 / y2) zi.
Proof.
intros x1 x2 y1 y2 xi yi zi (xe,(Hx1,Hx2)) (ye,(Hy1,Hy2)) Hb.
generalize (andb_prop _ _ Hb). clear Hb. intros (Hb,H4).
generalize (andb_prop _ _ Hb). clear Hb. intros (Hb,H3).
generalize (andb_prop _ _ Hb). clear Hb. intros (H1,H2).
apply Fle2_m1_correct in H1.
apply Flt2_m1_correct in H2.
generalize (Fle2_correct _ _ H3).
repeat rewrite Fplus2_correct.
rewrite Fmult2_correct. clear H3. intro H3.
generalize (Fle2_correct _ _ H4).
repeat rewrite Fplus2_correct.
rewrite Fmult2_correct. clear H4. intro H4.
exists ((xe - ye) / (1 + ye))%R.
split.
apply IRcompose_inv with (1 := H1) (2 := H2) (3 := H4) (4 := H3) (5 := Hx1) (6 := Hy1).
rewrite Hx2.
rewrite Hy2.
destruct (Req_dec y2 0) as [->|Hz].
now rewrite Rmult_0_l, 2!Rdiv_0_r, Rmult_0_l.
field.
refine (conj _ Hz).
lra.
Qed.

Theorem div_rr :
  forall x1 x2 y1 y2 : R, forall xi yi zi : FF,
  REL x1 x2 xi -> REL y1 y2 yi -> NZR y2 ->
  div_rr_helper xi yi zi = true ->
  REL (x1 / y1) (x2 / y2) zi.
Proof.
intros x1 x2 y1 y2 xi yi zi Hx Hy _.
now apply div_rr'.
Qed.

Definition inv_r_helper (xi zi : FF) :=
  Flt2_m1 (lower xi) &&
  Fpos0 (Fplus2 (Fplus2 (lower xi) (upper zi)) (Fmult2 (lower xi) (upper zi))) &&
  Fneg0 (Fplus2 (Fplus2 (upper xi) (lower zi)) (Fmult2 (upper xi) (lower zi))).

Theorem inv_r' :
  forall x1 x2 y : R, forall xi zi : FF,
  REL x1 x2 xi ->
  inv_r_helper xi zi = true ->
  REL (y / x1) (y / x2) zi.
Proof.
intros x1 x2 y xi zi (xe,(Hx1,Hx2)) Hb.
generalize (andb_prop _ _ Hb). clear Hb. intros (Hb,H3).
generalize (andb_prop _ _ Hb). clear Hb. intros (H1,H2).
apply Flt2_m1_correct in H1.
generalize (Fpos0_correct _ H2).
repeat rewrite Fplus2_correct.
rewrite Fmult2_correct. clear H2. intro H2.
generalize (Fneg0_correct _ H3).
repeat rewrite Fplus2_correct.
rewrite Fmult2_correct. clear H3. intro H3.
exists ((0 - xe) / (1 + xe))%R.
split.
apply IRcompose_inv with (xl := 0%R) (xu := 0%R) (2 := H1) (3 := H3) (4 := H2) (6 := Hx1).
now apply IZR_le.
split ; apply Rle_refl.
rewrite Hx2.
destruct (Req_dec x2 0) as [->|Hz].
now rewrite Rmult_0_l, Rdiv_0_r, Rmult_0_l.
field.
refine (conj _ Hz).
lra.
Qed.

Theorem inv_r :
  forall x1 x2 y : R, forall xi zi : FF,
  REL x1 x2 xi -> NZR x2 ->
  inv_r_helper xi zi = true ->
  REL (y / x1) (y / x2) zi.
Proof.
intros x1 x2 y xi zi Hr _.
now apply inv_r'.
Qed.

Theorem compose :
  forall x1 x2 y2 : R, forall xi yi zi : FF,
  REL x1 x2 xi -> REL x2 y2 yi ->
  mul_rr_helper xi yi zi = true ->
  REL x1 y2 zi.
Proof.
intros x1 x2 y2 xi yi zi (xe,(Hx1,Hx2)) (ye,(Hy1,Hy2)) Hb.
generalize (andb_prop _ _ Hb). clear Hb. intros (Hb,H4).
generalize (andb_prop _ _ Hb). clear Hb. intros (Hb,H3).
generalize (andb_prop _ _ Hb). clear Hb. intros (H1,H2).
apply Fle2_m1_correct in H1.
apply Fle2_m1_correct in H2.
generalize (Fle2_correct _ _ H3).
repeat rewrite Fplus2_correct.
rewrite Fmult2_correct. clear H3. intro H3.
generalize (Fle2_correct _ _ H4).
repeat rewrite Fplus2_correct.
rewrite Fmult2_correct. clear H4. intro H4.
exists (xe + ye + xe * ye)%R.
split.
apply IRcompose with (1 := H1) (2 := H2) (3 := H3) (4 := H4) (5 := Hx1) (6 := Hy1).
rewrite Hx2.
rewrite Hy2.
ring.
Qed.

Theorem compose_swap :
  forall x y r1 r2 : R, forall xi yi zi : FF,
  REL x (y * r2) xi -> REL r1 (1 / r2) yi -> NZR r2 ->
  mul_rr_helper xi yi zi = true ->
  REL (x * r1) y zi.
Proof.
intros x y r1 r2 xi yi zi Hx Hy Hr Hb.
generalize (mul_rr _ _ _ _ _ _ _ Hx Hy Hb).
replace (y * r2 * (1 / r2))%R with y.
easy.
now field.
Qed.

Definition FImult2 (x : float2) (yi : FF) :=
  let (yl,yu) := yi in
  if Fpos0 x then makepairF (Fmult2 x yl) (Fmult2 x yu)
  else makepairF (Fmult2 x yu) (Fmult2 x yl).

Lemma FImult2_correct :
  forall (x : float2) yi y, BND y yi ->
  BND (x * y) (FImult2 x yi).
Proof.
intros x (yl,yu) y Hy.
unfold FImult2.
replace (Fpos0 x) with (Zle_bool 0 (Fnum x)) by now unfold Fpos0 ; case (Fnum x).
case Zle_bool_spec ; split ; simpl ; rewrite Fmult2_correct.
apply monotony_1p.
now apply Float_prop.F2R_ge_0.
apply Hy.
apply monotony_1p.
now apply Float_prop.F2R_ge_0.
apply Hy.
apply monotony_1n.
apply Float_prop.F2R_le_0.
now apply Zlt_le_weak.
apply Hy.
apply monotony_1n.
apply Float_prop.F2R_le_0.
now apply Zlt_le_weak.
apply Hy.
Qed.

Definition add_rr_helper (xi yi qi zi : FF) :=
  let xql := FImult2 (lower qi) xi in
  let xqu := FImult2 (upper qi) xi in
  let yql := FImult2 (Fminus2 (Float2 1 0) (lower qi)) yi in
  let yqu := FImult2 (Fminus2 (Float2 1 0) (upper qi)) yi in
  Fle2 (lower zi) (Fplus2 (lower xql) (lower yql)) &&
  Fle2 (lower zi) (Fplus2 (lower xqu) (lower yqu)) &&
  Fle2 (Fplus2 (upper xql) (upper yql)) (upper zi) &&
  Fle2 (Fplus2 (upper xqu) (upper yqu)) (upper zi).

Theorem add_rr_left :
  forall x1 x2 y1 y2 : R, forall xi yi qi zi : FF,
  REL x1 x2 xi -> REL y1 y2 yi -> LIN x2 (x2 + y2) qi ->
  add_rr_helper xi yi qi zi = true ->
  REL (x1 + y1) (x2 + y2) zi.
Proof.
intros x1 x2 y1 y2 xi yi qi zi [ex [Hx1 Hx2]] [ey [Hy1 Hy2]] [eq [Hq1 Hq2]] Hb.
generalize (andb_prop _ _ Hb). clear Hb. intros [Hb H4].
generalize (andb_prop _ _ Hb). clear Hb. intros [Hb H3].
generalize (andb_prop _ _ Hb). clear Hb. intros [H1 H2].
apply Fle2_correct in H1. rewrite Fplus2_correct in H1.
apply Fle2_correct in H2. rewrite Fplus2_correct in H2.
apply Fle2_correct in H3. rewrite Fplus2_correct in H3.
apply Fle2_correct in H4. rewrite Fplus2_correct in H4.
assert (H5 := FImult2_correct (lower qi) xi _ Hx1).
assert (H6 := FImult2_correct (upper qi) xi _ Hx1).
assert (H7 := FImult2_correct (Fminus2 (Float2 1 0) (lower qi)) yi _ Hy1).
assert (H8 := FImult2_correct (Fminus2 (Float2 1 0) (upper qi)) yi _ Hy1).
assert (H9 : float2R (Float2 1 0) = R1) by apply Rmult_1_r.
assert (Ha : (float2R (Fminus2 (Float2 1 0) (lower qi)) = 1 - lower qi)%R).
now rewrite Fminus2_correct, H9.
assert (Hb : (float2R (Fminus2 (Float2 1 0) (upper qi)) = 1 - upper qi)%R).
now rewrite Fminus2_correct, H9.
destruct (Req_dec (x2 + y2) 0) as [Zxy|Zxy].
{ exists (lower zi).
  split.
  - apply (conj (Rle_refl _)).
    apply Rle_trans with (2 := H3).
    apply Rle_trans with (1 := H1).
    apply Rplus_le_compat.
    eapply Rle_trans ; apply H5.
    eapply Rle_trans ; apply H7.
  - rewrite Zxy, Rmult_0_l.
    assert (Hx: x2 = 0%R).
    { rewrite Hq2, Zxy. apply Rmult_0_l. }
    rewrite Hx2, Hx, Hy2.
    replace y2 with (x2 + y2 - x2)%R by ring.
    rewrite Zxy, Hx.
    ring. }
exists ((x1 + y1) / (x2 + y2) - 1)%R.
split.
2: now field.
rewrite Hx2, Hy2.
replace y2 with (x2 + y2 - x2)%R at 1 3 by ring.
rewrite Hq2 at 1 3 5 7.
replace (_ / (x2 + y2) - 1)%R with (ey + eq * (ex - ey))%R by now field.
destruct (Rle_or_lt (ex - ey) 0) as [He|He].
- split.
  + apply Rle_trans with (ey + upper qi * (ex - ey))%R.
    replace (ey + upper qi * (ex - ey))%R with (upper qi * ex + (1 - upper qi) * ey)%R by ring.
    apply Rle_trans with (1 := H2).
    apply Rplus_le_compat.
    apply H6.
    rewrite <- Hb.
    apply H8.
    apply Rplus_le_compat_l.
    now apply monotony_2n.
  + apply Rle_trans with (ey + lower qi * (ex - ey))%R.
    apply Rplus_le_compat_l.
    now apply monotony_2n.
    replace (ey + lower qi * (ex - ey))%R with (lower qi * ex + (1 - lower qi) * ey)%R by ring.
    apply Rle_trans with (2 := H3).
    apply Rplus_le_compat.
    apply H5.
    rewrite <- Ha.
    apply H7.
- apply Rlt_le in He.
  split.
  + apply Rle_trans with (ey + lower qi * (ex - ey))%R.
    replace (ey + lower qi * (ex - ey))%R with (lower qi * ex + (1 - lower qi) * ey)%R by ring.
    apply Rle_trans with (1 := H1).
    apply Rplus_le_compat.
    apply H5.
    rewrite <- Ha.
    apply H7.
    apply Rplus_le_compat_l.
    now apply monotony_2p.
  + apply Rle_trans with (ey + upper qi * (ex - ey))%R.
    apply Rplus_le_compat_l.
    now apply monotony_2p.
    replace (ey + upper qi * (ex - ey))%R with (upper qi * ex + (1 - upper qi) * ey)%R by ring.
    apply Rle_trans with (2 := H4).
    apply Rplus_le_compat.
    apply H6.
    rewrite <- Hb.
    apply H8.
Qed.

Theorem add_rr_right :
  forall x1 x2 y1 y2 : R, forall xi yi qi zi : FF,
  REL x1 x2 xi -> REL y1 y2 yi -> LIN y2 (x2 + y2) qi ->
  add_rr_helper yi xi qi zi = true ->
  REL (x1 + y1) (x2 + y2) zi.
Proof.
intros x1 x2 y1 y2 xi yi qi zi Hx Hy Hq Hb.
rewrite (Rplus_comm x1), (Rplus_comm x2).
apply add_rr_left with (1 := Hy) (2 := Hx) (4 := Hb).
now rewrite Rplus_comm.
Qed.

Theorem sub_rr_left :
  forall x1 x2 y1 y2 : R, forall xi yi qi zi : FF,
  REL x1 x2 xi -> REL y1 y2 yi -> LIN x2 (x2 - y2) qi ->
  add_rr_helper xi yi qi zi = true ->
  REL (x1 - y1) (x2 - y2) zi.
Proof.
intros x1 x2 y1 y2 xi yi qi zi Hx [ey [Hy1 Hy2]] Hq Hb.
apply add_rr_left with (1 := Hx) (3 := Hq) (4 := Hb).
exists ey.
apply (conj Hy1).
rewrite Hy2.
ring.
Qed.

Definition sub_rr_helper (xi yi qi zi : FF) :=
  let ri := makepairF (Fopp2 (upper qi)) (Fopp2 (lower qi)) in
  add_rr_helper xi yi ri zi.

Theorem sub_rr_right :
  forall x1 x2 y1 y2 : R, forall xi yi qi zi : FF,
  REL x1 x2 xi -> REL y1 y2 yi -> LIN y2 (x2 - y2) qi ->
  sub_rr_helper yi xi qi zi = true ->
  REL (x1 - y1) (x2 - y2) zi.
Proof.
intros x1 x2 y1 y2 xi yi qi zi Hx [ey [Hy1 Hy2]] [eq [Hq1 Hq2]] Hb.
apply add_rr_right with (1 := Hx) (4 := Hb).
exists ey.
apply (conj Hy1).
rewrite Hy2.
ring.
exists (- eq)%R.
split.
2: rewrite Hq2 at 1 ; ring.
simpl.
rewrite 2!Fopp2_correct.
now split ; apply Ropp_le_contravar.
Qed.

Theorem add_rr :
  forall x1 x2 y1 y2 : R, forall xi yi qi zi : FF,
  REL x1 x2 xi -> REL y1 y2 yi -> BND (x2 / (x2 + y2)) qi -> NZR (x2 + y2) ->
  add_rr_helper xi yi qi zi = true ->
  REL (x1 + y1) (x2 + y2) zi.
Proof.
intros x1 x2 y1 y2 xi yi qi zi Hx Hy Hq Zxy Hb.
apply add_rr_left with (1 := Hx) (2 := Hy) (4 := Hb).
exists (x2 / (x2 + y2))%R.
apply (conj Hq).
now field.
Qed.

Theorem sub_rr :
  forall x1 x2 y1 y2 : R, forall xi yi qi zi : FF,
  REL x1 x2 xi -> REL y1 y2 yi -> BND (x2 / (x2 - y2)) qi -> NZR (x2 - y2) ->
  add_rr_helper xi yi qi zi = true ->
  REL (x1 - y1) (x2 - y2) zi.
Proof.
intros x1 x2 y1 y2 xi yi qi zi Hx (ey,(Hy1,Hy2)) Hq Zxy Hb.
apply add_rr with (1 := Hx) (3 := Hq) (4 := Zxy) (5 := Hb).
exists ey.
split.
exact Hy1.
rewrite Hy2.
ring.
Qed.

Definition mul_helper (xi yi zi : FF) :=
  let xly := FImult2 (lower xi) yi in
  let xuy := FImult2 (upper xi) yi in
  Fle2 (lower zi) (lower xly) &&
  Fle2 (lower zi) (lower xuy) &&
  Fle2 (upper xly) (upper zi) &&
  Fle2 (upper xuy) (upper zi).

Theorem bnd_div_of_rel_bnd_div :
  forall x1 x2 y : R, forall xi yi zi : FF,
  REL x1 x2 xi -> BND (x2 / y) yi -> NZR y ->
  mul_helper xi yi zi = true ->
  BND ((x1 - x2) / y) zi.
Proof.
intros x1 x2 y xi yi zi (ex,(Hx1,Hx2)) Hxy Zy Hb.
rewrite Hx2.
replace ((x2 * (1 + ex) - x2) / y)%R with (ex * (x2 / y))%R by now field.
generalize (andb_prop _ _ Hb). clear Hb. intros (Hb, H4).
generalize (andb_prop _ _ Hb). clear Hb. intros (Hb, H3).
generalize (andb_prop _ _ Hb). clear Hb. intros (H1, H2).
apply Fle2_correct in H1.
apply Fle2_correct in H2.
apply Fle2_correct in H3.
apply Fle2_correct in H4.
assert (H5 := FImult2_correct (lower xi) yi _ Hxy).
assert (H6 := FImult2_correct (upper xi) yi _ Hxy).
destruct (Rle_or_lt 0 (x2 / y)) as [Hy|Hy].
split.
apply Rle_trans with (1 := H1).
apply Rle_trans with (1 := proj1 H5).
now apply monotony_2p.
apply Rle_trans with (2 := H4).
apply Rle_trans with (2 := proj2 H6).
now apply monotony_2p.
apply Rlt_le in Hy.
split.
apply Rle_trans with (1 := H2).
apply Rle_trans with (1 := proj1 H6).
now apply monotony_2n.
apply Rle_trans with (2 := H3).
apply Rle_trans with (2 := proj2 H5).
now apply monotony_2n.
Qed.

Lemma lin_of_lin_rel1_generic :
  forall f,
  (forall x y : R, forall xi yi zi : FF,
   BND x xi -> BND y yi -> f xi yi zi = true ->
   BND (x * y) zi) ->
  forall (a b c : R) (xi yi zi : FF),
  LIN a b xi -> REL c a yi ->
  f xi (one_plus yi) zi = true ->
  LIN c b zi.
Proof.
intros f Hf a b c xi yi zi [x [Hx1 Hx2]] [y [Hy1 Hy2]] Hb.
rewrite Hy2, Hx2.
exists (x * (1 + y))%R.
split. 2: ring.
apply Hf with (1 := Hx1) (3 := Hb).
now apply one_plus_correct.
Qed.

Definition lin_of_lin_rel1_p := lin_of_lin_rel1_generic _ mul_pp.
Definition lin_of_lin_rel1_o := lin_of_lin_rel1_generic _ mul_op.
Definition lin_of_lin_rel1_n := lin_of_lin_rel1_generic _ mul_np.

Lemma lin_of_lin_rel2_generic :
  forall f,
  (forall x y : R, forall xi yi zi : FF,
   BND x xi -> BND y yi -> f xi yi zi = true ->
   BND (x / y) zi) ->
  (forall xi yi zi : FF, f xi yi zi = true -> Fpos (lower yi) = true) ->
  forall (a b c : R) (xi yi zi : FF),
  LIN a b xi -> REL c b yi ->
  f xi (one_plus yi) zi = true ->
  LIN a c zi.
Proof.
intros f Hf1 Hf2 a b c xi yi zi [x [Hx1 Hx2]] [y [Hy1 Hy2]] Hb.
rewrite Hy2, Hx2.
exists (x / (1 + y))%R.
split.
{ apply Hf1 with (1 := Hx1) (3 := Hb).
  now apply one_plus_correct. }
field.
apply Rgt_not_eq, Rlt_le_trans with (lower (one_plus yi)).
apply Fpos_correct.
apply Hf2 with (1 := Hb).
now apply one_plus_correct.
Qed.

Lemma lin_of_lin_rel2_p :
  forall (a b c : R) (xi yi zi : FF),
  LIN a b xi -> REL c b yi ->
  div_pp_helper xi (one_plus yi) zi = true ->
  LIN a c zi.
Proof.
apply (lin_of_lin_rel2_generic _ div_pp).
intros xi yi zi.
unfold div_pp_helper.
now destruct Fpos.
Qed.

Lemma lin_of_lin_rel2_o :
  forall (a b c : R) (xi yi zi : FF),
  LIN a b xi -> REL c b yi ->
  div_op_helper xi (one_plus yi) zi = true ->
  LIN a c zi.
Proof.
apply (lin_of_lin_rel2_generic _ div_op).
intros xi yi zi.
unfold div_op_helper.
now destruct Fpos.
Qed.

Lemma lin_of_lin_rel2_n :
  forall (a b c : R) (xi yi zi : FF),
  LIN a b xi -> REL c b yi ->
  div_np_helper xi (one_plus yi) zi = true ->
  LIN a c zi.
Proof.
apply (lin_of_lin_rel2_generic _ div_np).
intros xi yi zi.
unfold div_np_helper.
now destruct Fpos.
Qed.

Lemma lin_of_lin_rel3_generic :
  forall f,
  (forall x y : R, forall xi yi zi : FF,
   BND x xi -> BND y yi -> f xi yi zi = true ->
   BND (x / y) zi) ->
  (forall xi yi zi : FF, f xi yi zi = true -> Fpos (lower yi) = true) ->
  forall (a b c : R) (xi yi zi : FF),
  LIN a b xi -> REL a c yi ->
  f xi (one_plus yi) zi = true ->
  LIN c b zi.
Proof.
intros f Hf1 Hf2 a b c xi yi zi [x [Hx1 Hx2]] [y [Hy1 Hy2]] Hb.
exists (x / (1 + y))%R.
unfold Rdiv.
split.
{ apply Hf1 with (1 := Hx1) (3 := Hb).
  now apply one_plus_correct. }
rewrite <- Rmult_assoc, <- Hx2, Hy2.
field.
apply Rgt_not_eq, Rlt_le_trans with (lower (one_plus yi)).
apply Fpos_correct.
apply Hf2 with (1 := Hb).
now apply one_plus_correct.
Qed.

Lemma lin_of_lin_rel3_p :
  forall (a b c : R) (xi yi zi : FF),
  LIN a b xi -> REL a c yi ->
  div_pp_helper xi (one_plus yi) zi = true ->
  LIN c b zi.
Proof.
apply (lin_of_lin_rel3_generic _ div_pp).
intros xi yi zi.
unfold div_pp_helper.
now destruct Fpos.
Qed.

Lemma lin_of_lin_rel3_o :
  forall (a b c : R) (xi yi zi : FF),
  LIN a b xi -> REL a c yi ->
  div_op_helper xi (one_plus yi) zi = true ->
  LIN c b zi.
Proof.
apply (lin_of_lin_rel3_generic _ div_op).
intros xi yi zi.
unfold div_op_helper.
now destruct Fpos.
Qed.

Lemma lin_of_lin_rel3_n :
  forall (a b c : R) (xi yi zi : FF),
  LIN a b xi -> REL a c yi ->
  div_np_helper xi (one_plus yi) zi = true ->
  LIN c b zi.
Proof.
apply (lin_of_lin_rel3_generic _ div_np).
intros xi yi zi.
unfold div_np_helper.
now destruct Fpos.
Qed.
