Library Float.Expansions.ThreeSumProps

Require Export ThreeSum2.

Section F2.
Variable b : Fbound.
Variable precision : nat.

Let radix := 2%Z.

Let TMTO : (1 < radix)%Z := TwoMoreThanOne.
Hint Resolve TMTO: zarith.

Let FtoRradix := FtoR radix.
Coercion FtoRradix : float >-> R.
Hypothesis precisionNotZero : 1 < precision.
Hypothesis pGivesBound : Zpos (vNum b) = Zpower_nat radix precision.
Variables (p : float) (q : float) (r : float) (u : float) (
  v : float) (w : float) (p' : float) (q' : float) (
  r' : float).
Hypothesis Fp : Fbounded b p.
Hypothesis Fq : Fbounded b q.
Hypothesis Fr : Fbounded b r.
Hypothesis Fu : Fbounded b u.
Hypothesis Fv : Fbounded b v.
Hypothesis Fw : Fbounded b w.
Hypothesis Fp' : Fbounded b p'.
Hypothesis Fq' : Fbounded b q'.
Hypothesis Fr' : Fbounded b r'.
Hypothesis epq : (Fexp q <= Fexp p)%Z.
Hypothesis eqr : (Fexp r <= Fexp q)%Z.
Hypothesis uDef : Closest b radix (q + r) u.
Hypothesis vDef : v = (q + r - u)%R :>R.
Hypothesis p'Def : Closest b radix (p + u) p'.
Hypothesis wDef : w = (p + u - p')%R :>R.
Hypothesis q'Def : Closest b radix (w + v) q'.
Hypothesis r'Def : r' = (w + v - q')%R :>R.
Hypothesis Ngd : (1 <= pPred (vNum b) * (1 - / radix))%R.
Hypothesis
  Hplus :
    (p = 0%R :>R \/ q = 0%R :>R \/ r = 0%R :>R) \/
    (Rabs q <= pPred (vNum b) * (Float 1%nat (Fexp p) - Float 1%nat (Fexp r)))%R.
Hypothesis Ngd2 : (6%nat <= pPred (vNum b) * (1 - / radix * / radix))%R.

Theorem FTS :
 (Rabs q <= pPred (vNum b) * (Float 1%nat (Fexp p) - Float 1%nat (Fexp r)))%R ->
 exists u'' : float,
   FtoRradix u'' = u /\ Fbounded b u'' /\ (Fexp u'' <= Fexp p)%Z.
intros H.
case (Req_dec u 0); intros Hu.
exists (Fzero (Fexp p)).
split.
replace (FtoRradix u) with 0%R; auto with real; unfold FtoRradix in |- *;
 apply FzeroisReallyZero.
split; auto with zarith.
apply FboundedZeroSameExp; auto.
exists (Fnormalize radix b precision u).
cut (FtoRradix (Fnormalize radix b precision u) = u); intros.
split; auto with float.
2: unfold FtoRradix in |- *; apply FnormalizeCorrect; auto with arith.
split.
apply FcanonicBound with (radix := radix).
apply FnormalizeCanonic; auto with arith.
cut (Fcanonic radix b (Fnormalize radix b precision u)).
2: apply FnormalizeCanonic; auto with arith.
intros H1; case H1.
intros H2.
rewrite (Zsucc_pred (Fexp (Fnormalize radix b precision u))).
apply Zlt_le_succ.
apply Zlt_powerRZ with (e := IZR radix); auto with real arith zarith.
apply Rmult_lt_reg_l with (r := IZR (pPred (vNum b))); auto with real zarith.
apply Rlt_IZRO; apply (pPredMoreThanOne b radix precision);
 auto with real zarith.
apply
 Rlt_le_trans
  with
    (Zabs (Fnum (Fnormalize radix b precision u)) *
     powerRZ radix (Fexp (Fnormalize radix b precision u)))%R.
unfold Zpred in |- *; rewrite powerRZ_add; auto with real arith zarith.
replace
 (pPred (vNum b) *
  (powerRZ radix (Fexp (Fnormalize radix b precision u)) * powerRZ radix (-1)))%R
 with
 (pPred (vNum b) * powerRZ radix (-1) *
  powerRZ radix (Fexp (Fnormalize radix b precision u)))%R;
 [ idtac | ring ].
apply Rmult_lt_compat_r; auto with real zarith.
apply Rmult_lt_reg_l with (IZR radix); auto with real zarith.
replace (radix * (pPred (vNum b) * powerRZ radix (-1)))%R with
 (radix * / radix * pPred (vNum b))%R;
 [ rewrite Rinv_r; auto with real zarith; rewrite Rmult_1_l | idtac ].
rewrite <- Rmult_IZR; apply Rlt_IZR.
rewrite <- (Zabs_eq radix); auto with zarith; rewrite <- Zabs_Zmult.
unfold pPred in |- *; apply Zle_Zpred_Zlt; case H2; auto with float.
replace (powerRZ radix (-1)) with (/ radix)%R;
 [ ring | simpl in |- *; rewrite Rmult_1_r; auto ].
change
  (FtoRradix (Fabs (Fnormalize radix b precision u)) <=
   Float (pPred (vNum b)) (Fexp p))%R in |- *.
rewrite (Fabs_correct radix); auto with zarith; fold FtoRradix in |- *;
 rewrite H0; auto with zarith.
apply
 (RoundAbsMonotoner b radix precision)
  with (P := Closest b radix) (p := (FtoRradix q + FtoRradix r)%R);
 auto.
apply (ClosestRoundedModeP b radix precision); auto with real zarith.
unfold pPred in |- *; apply maxFbounded; auto with float.
apply Rle_trans with (Rabs q + Rabs r)%R; auto with real.
apply Rabs_triang; auto with real.
apply
 Rle_trans
  with (Rabs q + pPred (vNum b) * FtoRradix (Float 1%nat (Fexp r)))%R;
 auto with real.
apply Rplus_le_compat_l.
replace (pPred (vNum b) * FtoRradix (Float 1%nat (Fexp r)))%R with
 (FtoRradix (Float (pPred (vNum b)) (Fexp r)));
 [ idtac | unfold FtoRradix, FtoR in |- *; simpl in |- *; ring ].
rewrite <- (Fabs_correct radix); auto with real zarith; apply (maxMax1 radix);
 auto with real zarith.
fold FtoRradix in |- *;
 replace (FtoRradix (Float (pPred (vNum b)) (Fexp p))) with
  (pPred (vNum b) * FtoRradix (Float 1%nat (Fexp p)))%R;
 [ idtac | unfold FtoRradix, FtoR in |- *; simpl in |- *; ring ].
replace (pPred (vNum b) * FtoRradix (Float 1%nat (Fexp p)))%R with
 (pPred (vNum b) *
  (FtoRradix (Float 1%nat (Fexp p)) - FtoRradix (Float 1%nat (Fexp r))) +
  pPred (vNum b) * FtoRradix (Float 1%nat (Fexp r)))%R;
 [ auto with real zarith
 | unfold FtoRradix, FtoR in |- *; simpl in |- *; ring ].
intros H'; case H'; (intros H2 (H3, H4); rewrite H3).
case Fp; auto.
Qed.

Theorem FTSinSum3_allcases :
 p <> 0%R :>R ->
 exists u'' : float, u'' = u :>R /\ Fbounded b u'' /\ (Fexp u'' <= Fexp p)%Z.
intros H.
case Hplus; [ intros [H1| [H2| H3]] | intros H1 ].
case H; auto.
exists r; split; [ idtac | split ]; auto.
apply (ClosestIdem b radix); auto.
apply (ClosestCompatible b radix) with (1 := uDef); auto.
rewrite H2; fold FtoRradix; ring.
apply Zle_trans with (1 := eqr); auto.
exists q; split; [ idtac | split ]; auto.
apply (ClosestIdem b radix); auto.
apply (ClosestCompatible b radix) with (1 := uDef); auto.
rewrite H3; fold FtoRradix; ring.
apply FTS; auto.
Qed.

Theorem PuissLessThanHalf :
 forall z : Z, (Float 1%nat z * / radix <= Float 1%nat z)%R.
intros z.
pattern (FtoRradix (Float 1%nat z)) at 2 in |- *;
 replace (FtoRradix (Float 1%nat z)) with (Float 1%nat z * 1)%R;
 [ apply Rmult_le_compat_l | ring ].
unfold FtoRradix in |- *; unfold FtoR in |- *; simpl in |- *;
 auto with real zarith.
replace (1 * powerRZ 2 z)%R with (powerRZ 2 z);
 [ apply powerRZ_le; auto with real | ring ].
apply Rlt_le.
replace 1%R with (/ 1)%R; [ apply Rinv_1_lt_contravar | idtac ];
 auto with real.
Qed.

Theorem Rle_Rminus_ZERO : forall r1 r2 : R, (r2 <= r1)%R -> (0 <= r1 - r2)%R.
intros r1 r2 H; case H; auto with real.
intros H1; rewrite H1; auto with real.
rewrite Rminus_diag_eq; auto with real.
Qed.

Theorem ThreeSumLoop :
 exists p'' : float,
   (exists q'' : float,
      (exists r'' : float,
         (Fbounded b p'' /\ Fbounded b q'' /\ Fbounded b r'') /\
         ((p'' = p' :>R /\ q'' = q' :>R /\ r'' = r' :>R) /\
          (Fexp r <= Fexp r'')%Z /\
          ((Fexp r'' <= Fexp q'')%Z /\ (Fexp q'' <= Fexp p'')%Z) /\
          Fexp r'' = Fexp r) /\
         (r' = 0%R :>R /\
          (p'' = 0%R :>R \/
           (Rabs q'' <=
            pPred (vNum b) * (Float 1%nat (Fexp p'') - Float 1%nat (Fexp r)))%R) \/
          r' <> 0%R :>R /\
          (Rabs r'' <=
           pPred (vNum b) * (Float 1%nat (Fexp q'') - Float 1%nat (Fexp r)))%R))).
cut (0 < pPred (vNum b))%Z;
 [ intros Pp1
 | apply (pPredMoreThanOne b radix) with (precision := precision);
    auto with zarith ].
case (plusExactExp b radix precision) with (p := q) (q := r) (pq := u);
 auto with zarith.
intros v' (u', (H1, (H2, (H3, (H4, (H5, (H6, H7))))))).
cut (Fbounded b (Fzero (Fexp r)));
 [ intros Fbr | apply FboundedZeroSameExp; auto ].
case (Req_dec p 0); intros Hp.
cut (w = 0%R :>R); [ intros v'Def | idtac ].
exists u'; exists v'; exists (Fzero (Fexp r)); repeat (split; auto).
apply sym_eq;
 apply TwoSumOneNul with (precision := precision) (p := p) (b := b);
 auto.
fold radix in |- *; rewrite H3; auto.
apply sym_eq;
 apply TwoSumOneNul with (precision := precision) (p := w) (b := b);
 auto.
fold radix in |- *; replace (FtoR radix v') with (FtoR radix v);
 auto with real.
fold radix in |- *; rewrite H4; auto with real.
fold radix in |- *; rewrite H3; auto with real.
replace (FtoRradix (Fzero (Fexp r))) with 0%R; apply sym_eq;
 [ idtac | unfold FtoRradix in |- *; apply FzeroisReallyZero ].
apply
 TwoSumOneNul2
  with (b := b) (precision := precision) (p := w) (q := v) (pq := q');
 auto.
simpl in |- *; auto with zarith.
simpl in |- *; auto with zarith.
rewrite H5; auto with zarith.
apply Zmin_Zle; auto with zarith.
left; split; auto with float zarith.
apply
 TwoSumOneNul2
  with (b := b) (precision := precision) (p := w) (q := v) (pq := q');
 auto.
case (Req_dec u' 0); intros Hu'; auto.
right.
case (Req_dec v' 0); intros Hv'; auto.
rewrite Hv'.
replace (Rabs 0) with (pPred (vNum b) * 0)%R;
 [ apply Rmult_le_compat_l | rewrite Rabs_R0; ring ];
 auto with real zarith.
apply Rle_Rminus_ZERO; auto with float real.
apply (oneExp_le radix); auto with float real.
apply Zle_trans with (2 := H6); rewrite H5.
apply Zmin_Zle; auto with zarith.
apply Rle_trans with (FtoR radix (Float 1%nat (Fexp u')) * / radix)%R;
 [ unfold FtoRradix in |- *;
    apply
     ClosestErrorBound
      with (b := b) (x := (q + r)%R) (q := v') (precision := precision)
 | apply Rle_trans with (FtoR radix (Float 1%nat (Fexp u'))) ];
 auto with real arith.
apply (ClosestCompatible b radix (q + r)%R (q + r)%R u); auto.
apply PuissLessThanHalf.
unfold FtoRradix in |- *; unfold FtoR in |- *; simpl in |- *.
apply Rle_trans with (pPred (vNum b) * (1 - / 2) * powerRZ 2 (Fexp u'))%R.
apply Rmult_le_compat_r; auto with real.
replace (pPred (vNum b) * (1 - / 2) * powerRZ 2 (Fexp u'))%R with
 (pPred (vNum b) * (powerRZ 2 (Fexp u') - powerRZ 2 (Zpred (Fexp u'))))%R.
apply Rmult_le_compat_l; auto with real zarith.
simpl in |- *; repeat rewrite Rmult_1_l.
unfold Rminus in |- *; apply Rplus_le_compat_l.
apply Ropp_le_contravar; apply Rle_powerRZ; auto with real zarith.
apply Zle_Zpred.
replace (Fexp r) with (Fexp v'); auto.
apply
 ClosestErrorExpStrict
  with (x := (q + r)%R) (b := b) (radix := radix) (precision := precision);
 auto.
apply (ClosestCompatible b radix (q + r)%R (q + r)%R u); auto.
rewrite H5; apply Zmin_le2; auto.
unfold Zpred in |- *; rewrite (powerRZ_add 2 (Fexp u') (-1)); auto.
replace (powerRZ 2 (-1)) with (/ radix)%R.
unfold radix; simpl; ring.
unfold powerRZ in |- *; simpl in |- *.
replace (2 * 1)%R with 2%R; auto with real.
replace 2%R with (IZR radix); auto with real zarith.
apply
 TwoSumOneNul2
  with (b := b) (precision := precision) (p := p) (q := u) (pq := p');
 auto.
case (Req_dec v 0); intros Hv.
case (plusExactExp b radix precision) with (p := p) (q := u') (pq := p');
 auto with zarith.
rewrite H3; auto.
intros w' (p'', (H'1, (H'2, (H'3, (H'4, (H'5, (H'6, H'7))))))).
cut (w' = w :>R);
 [ intros w'Def
 | unfold FtoRradix in |- *; replace (FtoR radix w) with (p + u - p')%R;
    unfold FtoRradix in |- *; replace (FtoR radix u) with (FtoR radix u');
    replace (FtoR radix p') with (FtoR radix p'');
    auto with real ].
exists p''; exists w'; exists (Fzero (Fexp r)); repeat (split; auto).
apply sym_eq;
 apply TwoSumOneNul with (precision := precision) (p := v) (b := b);
 auto.
fold radix FtoRradix in |- *; rewrite w'Def; auto.
rewrite Rplus_comm; auto.
replace (FtoRradix (Fzero (Fexp r))) with 0%R; apply sym_eq;
 [ idtac | unfold FtoRradix in |- *; apply FzeroisReallyZero ].
apply
 TwoSumOneNul2
  with (b := b) (precision := precision) (p := v) (q := w) (pq := q');
 auto.
rewrite Rplus_comm; auto.
rewrite Rplus_comm; fold radix FtoRradix in |- *; rewrite r'Def; ring.
simpl in |- *; auto with zarith.
simpl in |- *; rewrite H'5; apply Zmin_Zle; auto with zarith.
apply Zle_trans with (Fexp v'); auto with zarith.
simpl in |- *; rewrite H5; apply Zmin_Zle; auto with zarith.
left.
split; auto with float zarith.
apply
 TwoSumOneNul2
  with (b := b) (precision := precision) (p := v) (q := w) (pq := q');
 auto.
rewrite Rplus_comm; auto.
rewrite Rplus_comm; fold radix FtoRradix in |- *; rewrite r'Def; ring.
case (Req_dec p'' 0); intros Hp''; auto.
right.
case (Req_dec w' 0); intros Hw'; auto.
rewrite Hw'.
replace (Rabs 0) with (pPred (vNum b) * 0)%R;
 [ apply Rmult_le_compat_l | rewrite Rabs_R0; ring ];
 auto with real zarith.
apply Rle_Rminus_ZERO; auto with float real.
apply (oneExp_le radix); auto with float real.
apply Zle_trans with (Fexp w'); auto with zarith.
rewrite H'5; apply Zmin_Zle; auto.
apply Zle_trans with (Fexp q); auto.
apply Zle_trans with (Fexp v'); auto with zarith.
rewrite H5; apply Zmin_Zle; auto with zarith.
apply Rle_trans with (FtoR radix (Float 1%nat (Fexp p'')) * / radix)%R;
 [ unfold FtoRradix in |- *;
    apply
     ClosestErrorBound
      with (b := b) (x := (p + u')%R) (precision := precision)
 | apply Rle_trans with (FtoR radix (Float 1%nat (Fexp p''))) ];
 auto with real arith.
apply (ClosestCompatible b radix (p + u')%R (p + u')%R p'); auto.
unfold FtoRradix in |- *; rewrite H3; auto.
apply PuissLessThanHalf.
unfold FtoRradix in |- *; unfold FtoR in |- *; simpl in |- *.
apply
 Rle_trans with (pPred (vNum b) * (1 - / radix) * powerRZ 2 (Fexp p''))%R.
apply Rmult_le_compat_r; auto with real zarith.
replace (pPred (vNum b) * (1 - / radix) * powerRZ 2 (Fexp p''))%R with
 (pPred (vNum b) * (powerRZ 2 (Fexp p'') - powerRZ 2 (Zpred (Fexp p''))))%R.
apply Rmult_le_compat_l; auto with real zarith.
simpl in |- *; repeat rewrite Rmult_1_l.
unfold Rminus in |- *; apply Rplus_le_compat_l.
apply Ropp_le_contravar; apply Rle_powerRZ; auto with real zarith.
apply Zle_Zpred.
apply Zle_lt_trans with (Fexp w'); auto.
rewrite H'5; apply Zmin_Zle; auto.
apply Zle_trans with (Fexp q); auto.
apply Zle_trans with (Fexp v'); auto with zarith.
rewrite H5; apply Zmin_Zle; auto with zarith.
apply
 ClosestErrorExpStrict
  with (x := (p + u')%R) (b := b) (radix := radix) (precision := precision);
 auto.
apply (ClosestCompatible b radix (p + u')%R (p + u')%R p'); auto.
unfold FtoRradix in |- *; rewrite H3; auto.
unfold Zpred in |- *; rewrite (powerRZ_add 2 (Fexp p'') (-1)); auto.
replace (powerRZ 2 (-1)) with (/ radix)%R.
ring; ring.
unfold powerRZ in |- *; simpl in |- *.
replace (2 * 1)%R with 2%R; auto with real.
replace 2%R with (IZR radix); auto with real zarith.
case (FTSinSum3_allcases Hp); intros u'' (Z1, (Z2, Z3)).
case (plusExactExp b radix precision) with (p := p) (q := u'') (pq := p');
 auto with zarith.
fold radix FtoRradix in |- *; rewrite Z1; auto.
intros w' (p'', (H''1, (H''2, (H''3, (H''4, (H''5, (H''6, H''7))))))).
cut (v = v' :>R);
 [ intros v'Def
 | rewrite vDef; auto with real; unfold FtoRradix in |- *;
    replace (FtoR radix u) with (FtoR radix u'); auto with real ].
cut (w' = w :>R);
 [ intros w'Def
 | unfold FtoRradix in |- *; replace (FtoR radix w) with (p + u - p')%R;
    unfold FtoRradix in |- *; replace (FtoR radix u) with (FtoR radix u'');
    replace (FtoR radix p') with (FtoR radix p'');
    auto with real ].
case (plusExactExp b radix precision) with (p := w') (q := v') (pq := q');
 auto with zarith.
fold radix FtoRradix in |- *; rewrite w'Def; rewrite <- v'Def; auto.
intros r'' (q'', (H'''1, (H'''2, (H'''3, (H'''4, (H'''5, (H'''6, H'''7))))))).
cut (r' = r'' :>R);
 [ intros r'Def1
 | rewrite r'Def; unfold FtoRradix in |- *;
    replace (FtoR radix w) with (FtoR radix w');
    replace (FtoR radix v) with (FtoR radix v');
    replace (FtoR radix q') with (FtoR radix q'');
    auto with real ].
case (Req_dec w' 0); intros Hw'.
exists p''; exists v'; exists (Fzero (Fexp r)); repeat (split; auto).
apply sym_eq;
 apply TwoSumOneNul with (b := b) (precision := precision) (p := w);
 auto.
fold radix FtoRradix in |- *; rewrite <- v'Def; auto.
fold radix FtoRradix in |- *; rewrite <- w'Def; auto.
replace (FtoRradix (Fzero (Fexp r))) with 0%R;
 [ apply sym_eq
 | apply sym_eq; unfold FtoRradix in |- *; apply FzeroisReallyZero ].
rewrite r'Def; fold radix FtoRradix in |- *; rewrite <- w'Def; rewrite Hw'.
apply Rminus_diag_eq; auto; rewrite Rplus_0_l.
apply sym_eq;
 apply TwoSumOneNul with (b := b) (precision := precision) (p := w);
 auto.
fold radix FtoRradix in |- *; rewrite <- w'Def; auto.
simpl in |- *; auto with real.
simpl in |- *; auto with zarith.
simpl in |- *; rewrite H5; apply Zmin_Zle; auto with zarith.
apply Zle_trans with (Fexp u''); auto with zarith.
apply Zlt_le_weak.
apply
 ClosestErrorExpStrict
  with (b := b) (radix := radix) (precision := precision) (x := (q + r)%R);
 auto.
apply (ClosestCompatible b radix (q + r)%R (q + r)%R u); auto.
replace (FtoR radix u'') with (FtoR radix u'); auto with real.
replace (FtoR radix u'') with (FtoR radix u); auto with real.
replace (FtoR radix v') with (FtoR radix v); auto with real.
apply Zle_trans with (Fexp w'); [ rewrite H''5 | auto with zarith ].
apply Zmin_Zle; auto with zarith.
left.
split; auto.
rewrite r'Def; unfold FtoRradix in |- *;
 replace (FtoR radix w) with (FtoR radix w');
 replace (FtoR radix w') with 0%R; auto.
rewrite Rplus_0_l; apply Rminus_diag_eq.
apply sym_eq;
 apply TwoSumOneNul with (b := b) (precision := precision) (p := w);
 auto.
fold radix FtoRradix in |- *; rewrite <- w'Def; auto.
right.
apply Rle_trans with (Float 1%nat (Fexp u'') * / radix)%R.
unfold FtoRradix in |- *;
 apply
  ClosestErrorBound with (b := b) (precision := precision) (x := (q + r)%R);
 auto with real.
apply (ClosestCompatible b radix (q + r)%R (q + r)%R u); auto.
replace (FtoR radix u'') with (FtoR radix u);
 replace (FtoR radix v') with (FtoR radix v); auto with real.
apply Rle_trans with (FtoRradix (Float 1%nat (Fexp u''))); auto with real.
apply PuissLessThanHalf.
apply Rle_trans with (FtoRradix (Float 1%nat (Fexp p''))); auto with real.
unfold FtoRradix in |- *; unfold FtoR in |- *; simpl in |- *.
repeat rewrite Rmult_1_l; apply Rle_powerRZ; auto with real.
apply Zle_trans with (Fexp w'); auto.
rewrite H''5.
apply Zmin_Zle; auto with zarith.
unfold FtoRradix in |- *; unfold FtoR in |- *; simpl in |- *.
apply
 Rle_trans with (pPred (vNum b) * (1 - / radix) * powerRZ 2 (Fexp p''))%R.
apply Rmult_le_compat_r; auto with real.
replace (pPred (vNum b) * (1 - / radix) * powerRZ 2 (Fexp p''))%R with
 (pPred (vNum b) * (powerRZ 2 (Fexp p'') - powerRZ 2 (Zpred (Fexp p''))))%R.
apply Rmult_le_compat_l; auto with real zarith.
replace (powerRZ 2 (Fexp p'') - powerRZ 2 (Zpred (Fexp p'')))%R with
 (powerRZ 2 (Fexp p'') + - powerRZ 2 (Zpred (Fexp p'')))%R;
 [ idtac | ring ].
repeat rewrite Rmult_1_l; auto with real.
unfold Rminus in |- *; apply Rplus_le_compat_l.
apply Ropp_le_contravar; apply Rle_powerRZ; auto with real.
apply Zle_Zpred.
apply Zlt_le_trans with (Fexp w'); auto.
replace (Fexp r) with (Zmin (Fexp q) (Fexp r));
 [ rewrite <- H5 | rewrite Zmin_le2; auto ].
rewrite H''5; rewrite Zmin_le2; auto.
apply
 ClosestErrorExpStrict
  with (b := b) (radix := radix) (precision := precision) (x := (q + r)%R);
 auto.
apply (ClosestCompatible b radix (q + r)%R (q + r)%R u); auto.
fold radix FtoRradix in |- *; rewrite Z1; unfold FtoRradix in |- *;
 rewrite <- H3; auto.
fold radix FtoRradix in |- *; rewrite <- v'Def; auto.
unfold Zpred in |- *.
rewrite (powerRZ_add 2 (Fexp p'') (-1)); auto.
replace (powerRZ 2 (-1)) with (/ radix)%R.
ring; ring.
unfold powerRZ in |- *; simpl in |- *.
rewrite Rmult_1_r; auto with real.
replace 2%R with (IZR radix); auto with real zarith.
exists p''; exists q''; exists r''; repeat (split; simpl in |- *; auto).
apply Zle_trans with (Fexp v'); auto with zarith.
replace (Fexp r) with (Zmin (Fexp q) (Fexp r));
 [ rewrite <- H5 | rewrite Zmin_le2 ]; auto with zarith.
rewrite H'''5; rewrite Zmin_le2; auto with zarith.
rewrite H''5; rewrite Zmin_le2; auto with zarith.
apply Zlt_le_weak.
apply
 ClosestErrorExpStrict
  with (b := b) (radix := radix) (precision := precision) (x := (q + r)%R);
 auto.
apply (ClosestCompatible b radix (q + r)%R (q + r)%R u); auto.
replace (FtoR radix u'') with (FtoR radix u'); auto with real.
replace (FtoR radix u'') with (FtoR radix u); auto with real.
replace (FtoR radix v') with (FtoR radix v); auto with real.
apply Zle_trans with (1 := H'''7).
apply Zlt_le_succ; replace (Zmax (Fexp w') (Fexp v')) with (Fexp w').
apply
 ClosestErrorExpStrict
  with (b := b) (radix := radix) (precision := precision) (x := (p + u'')%R);
 auto.
apply (ClosestCompatible b radix (p + u)%R (p + u'')%R p'); auto.
replace (FtoR radix u'') with (FtoR radix u); auto with real.
apply sym_eq; apply Zmax_le1; auto.
apply Zlt_le_weak.
replace (Fexp w') with (Fexp u'').
apply
 ClosestErrorExpStrict
  with (b := b) (radix := radix) (precision := precision) (x := (q + r)%R);
 auto.
apply (ClosestCompatible b radix (q + r)%R (q + r)%R u); auto.
replace (FtoR radix u'') with (FtoR radix u'); auto with real.
replace (FtoR radix u'') with (FtoR radix u); auto with real.
replace (FtoR radix v') with (FtoR radix v); auto with real.
rewrite H''5; apply sym_eq; apply Zmin_le2; auto.
replace (Fexp r) with (Fexp v'); auto.
rewrite H'''5; apply Zmin_le2.
replace (Fexp w') with (Fexp u'').
apply Zlt_le_weak.
apply
 ClosestErrorExpStrict
  with (b := b) (radix := radix) (precision := precision) (x := (q + r)%R);
 auto.
apply (ClosestCompatible b radix (q + r)%R (q + r)%R u); auto.
replace (FtoR radix u'') with (FtoR radix u'); auto with real.
replace (FtoR radix u'') with (FtoR radix u); auto with real.
replace (FtoR radix v') with (FtoR radix v); auto with real.
rewrite H''5; apply sym_eq; apply Zmin_le2; auto.
rewrite H5; apply Zmin_le2; auto.
case (Req_dec r' 0); intros Hr'.
left; split; auto.
right.
replace (FtoRradix q'') with (w' + v')%R.
apply Rle_trans with (Rabs w' + Rabs v')%R; [ apply Rabs_triang | idtac ].
apply
 Rle_trans
  with
    (Rabs w' + Rabs (FtoR radix u) * / radix * (radix * / pPred (vNum b)))%R.
apply Rplus_le_compat_l.
rewrite <- v'Def; rewrite vDef.
apply Rlt_le.
replace (FtoRradix q + FtoRradix r - FtoRradix u)%R with (- (u - (q + r)))%R;
 [ rewrite Rabs_Ropp | ring ].
unfold FtoRradix in |- *; apply plusErrorBound1 with (precision := precision);
 auto.
unfold is_Fzero in |- *.
Contradict Hw'.
apply
 TwoSumOneNul2
  with (precision := precision) (p := u) (q := p) (pq := p') (b := b);
 auto.
rewrite Rplus_comm; auto.
unfold FtoR in |- *; simpl in |- *; rewrite Hw'; simpl; ring.
fold radix FtoRradix in |- *; rewrite w'Def; (rewrite Rplus_comm; auto).
replace (Rabs (FtoR radix u) * / radix * (radix * / pPred (vNum b)))%R with
 (Rabs (FtoR radix u) * / pPred (vNum b) * (/ radix * radix))%R;
 [ rewrite Rinv_l; auto with real zarith; try rewrite Rmult_1_r | ring ].
apply
 Rle_trans
  with
    (radix * / pPred (vNum b) *
     Rmax (Rabs (FtoR radix p)) (Rabs (FtoR radix u'')) +
     Rabs (FtoR radix u) * / pPred (vNum b))%R.
replace (Rabs w' + Rabs (FtoR radix u) * / pPred (vNum b))%R with
 (Rabs (FtoR radix u) * / pPred (vNum b) + Rabs w')%R;
 [ idtac | ring ].
replace
 (radix * / pPred (vNum b) *
  Rmax (Rabs (FtoR radix p)) (Rabs (FtoR radix u'')) +
  Rabs (FtoR radix u) * / pPred (vNum b))%R with
 (Rabs (FtoR radix u) * / pPred (vNum b) +
  radix * / pPred (vNum b) *
  Rmax (Rabs (FtoR radix p)) (Rabs (FtoR radix u'')))%R;
 [ idtac | ring ].
apply Rplus_le_compat_l.
replace (FtoRradix w') with (p + u'' - p'')%R; auto with real.
apply Rlt_le.
replace (FtoRradix p + FtoRradix u'' - FtoRradix p'')%R with
 (- (FtoRradix p'' - (FtoRradix p + FtoRradix u'')))%R;
 [ rewrite Rabs_Ropp | ring ].
apply plusErrorBound2 with (b := b) (precision := precision); auto.
apply (ClosestCompatible b radix (p + u)%R (p + u'')%R p'); auto.
replace (FtoR radix u'') with (FtoR radix u); auto with real.
cut (p' <> 0%R :>R);
 [ intros T1; Contradict T1; unfold FtoRradix in |- *; rewrite <- H''3;
    apply is_Fzero_rep1; auto
 | idtac ].
apply
 TwoSumNonNul
  with (b := b) (precision := precision) (r := w') (p := p) (q := u'');
 auto.
apply (ClosestCompatible b radix (p + u)%R (p + u'')%R p'); auto.
replace (FtoR radix u'') with (FtoR radix u); auto with real.
fold radix in |- *; rewrite <- H''3; auto.
apply
 Rle_trans
  with
    (radix * / pPred (vNum b) *
     Rmax (Rabs (FtoR radix p)) (Rabs (FtoR radix u'')) +
     Rmax (Rabs (FtoR radix p)) (Rabs (FtoR radix u'')) * / pPred (vNum b))%R.
apply Rplus_le_compat_l.
apply Rmult_le_compat_r; auto with real zarith.
replace (FtoR radix u) with (FtoR radix u''); auto with real.
apply RmaxLess2.
replace
 (radix * / pPred (vNum b) *
  Rmax (Rabs (FtoR radix p)) (Rabs (FtoR radix u'')) +
  Rmax (Rabs (FtoR radix p)) (Rabs (FtoR radix u'')) * / pPred (vNum b))%R
 with
 (3%nat * / pPred (vNum b) *
  Rmax (Rabs (FtoR radix p)) (Rabs (FtoR radix u'')))%R;
 [ idtac | simpl in |- *; ring ].
apply Rle_trans with (Rabs p'' * (6%nat * / pPred (vNum b)))%R.
replace
 (3%nat * / pPred (vNum b) *
  Rmax (Rabs (FtoR radix p)) (Rabs (FtoR radix u'')))%R with
 (3%nat * Rmax (Rabs (FtoR radix p)) (Rabs (FtoR radix u'')) *
  / pPred (vNum b))%R; [ idtac | ring ].
replace (Rabs p'' * (6%nat * / pPred (vNum b)))%R with
 (Rabs p'' * 6%nat * / pPred (vNum b))%R; [ idtac | ring ].
apply Rmult_le_compat_r; auto with real zarith.
replace (3%nat * Rmax (Rabs (FtoR radix p)) (Rabs (FtoR radix u'')))%R with
 (/ radix * Rmax (Rabs (FtoR radix p)) (Rabs (FtoR radix u'')) * 6%nat)%R.
apply Rmult_le_compat_r; auto with real.
apply plusClosestLowerBound with (b := b) (precision := precision); auto.
apply (ClosestCompatible b radix (p + u)%R (p + u'')%R p'); auto.
replace (FtoR radix u'') with (FtoR radix u); auto with real.
Contradict Hw'.
unfold FtoRradix in |- *; rewrite H''4; unfold radix, FtoRradix in |- *;
 rewrite Hw'; ring.
replace (INR 3) with (/ radix * 6%nat)%R; [ ring | idtac ].
replace (INR 6) with (radix * 3%nat)%R;
 [ idtac | simpl in |- *; auto with real zarith ].
rewrite <- Rmult_assoc; rewrite Rinv_l; auto with real zarith.
simpl in |- *; ring.
apply Rle_trans with (6%nat * powerRZ 2 (Fexp p''))%R.
replace (Rabs p'' * (6%nat * / pPred (vNum b)))%R with
 (6%nat * (Rabs p'' * / pPred (vNum b)))%R;
 [ apply Rmult_le_compat_l | ring ].
replace 0%R with (INR 0); auto with real arith.
replace (powerRZ 2 (Fexp p'')) with
 (Float (pPred (vNum b)) (Fexp p'') * / pPred (vNum b))%R;
 [ apply Rmult_le_compat_r; auto with real zarith
 | unfold FtoRradix, FtoR; simpl; field; auto with zarith real].
rewrite <- (Fabs_correct radix); auto with zarith; apply (maxMax1 radix);
 auto with zarith.
apply
 Rle_trans
  with (pPred (vNum b) * (1 - / radix * / radix) * powerRZ 2 (Fexp p''))%R.
apply Rmult_le_compat_r; auto with real zarith.
replace (pPred (vNum b) * (1 - / radix * / radix) * powerRZ 2 (Fexp p''))%R
 with
 (pPred (vNum b) *
  (powerRZ 2 (Fexp p'') - powerRZ 2 (Zpred (Zpred (Fexp p'')))))%R;
 [ apply Rmult_le_compat_l; auto with real zarith | ring_simplify ].
replace (powerRZ 2 (Fexp p'') - powerRZ 2 (Zpred (Zpred (Fexp p''))))%R with
 (powerRZ 2 (Fexp p'') + - powerRZ 2 (Zpred (Zpred (Fexp p''))))%R;
 [ idtac | ring ].
unfold FtoRradix in |- *; unfold FtoR in |- *; simpl in |- *.
repeat rewrite Rmult_1_l.
unfold Rminus in |- *; apply Rplus_le_compat_l; auto with real zarith.
apply Ropp_le_contravar; apply Rle_powerRZ; auto with real zarith.
apply Zle_Zpred.
apply Zlt_le_trans with (Fexp u'').
replace (Fexp r) with (Fexp v'); auto.
apply
 ClosestErrorExpStrict
  with (b := b) (radix := radix) (precision := precision) (x := (q + r)%R);
 auto.
apply (ClosestCompatible b radix (q + r)%R (q + r)%R u); auto.
replace (FtoR radix u'') with (FtoR radix u'); auto with real.
replace (FtoR radix u'') with (FtoR radix u); auto with real.
replace (FtoR radix v') with (FtoR radix v); auto with real.
rewrite H5; apply Zmin_le2; auto.
apply Zle_Zpred.
replace (Fexp u'') with (Fexp w'); auto.
apply
 ClosestErrorExpStrict
  with (b := b) (radix := radix) (precision := precision) (x := (p + u'')%R);
 auto.
apply (ClosestCompatible b radix (p + u'')%R (p + u'')%R p'); auto.
replace (FtoRradix u'') with (FtoRradix u); auto with real.
rewrite H''5; apply Zmin_le2; auto.
replace (powerRZ 2 (Zpred (Zpred (Fexp p'')))) with
 (powerRZ 2 (Fexp p'') * (/ radix * / radix))%R; [ ring | idtac ].
unfold Zpred in |- *; repeat rewrite powerRZ_add; auto with real zarith.
replace (/ radix)%R with (powerRZ 2 (-1)); [ ring | idtac ].
unfold powerRZ in |- *; simpl in |- *.
ring_simplify (2*1)%R; auto.
replace (w' + v')%R with (r'' + q'')%R.
replace (FtoRradix r'') with 0%R; [ ring | idtac ].
replace (FtoRradix r'') with (FtoRradix r'); auto.
replace (FtoRradix r'') with
 (FtoR radix w' + FtoR radix v' - FtoR radix q'')%R;
 auto with real.
unfold FtoRradix in |- *; ring; ring.
right; split; auto.
unfold FtoRradix in |- *;
 apply Rle_trans with (FtoR radix (Float 1%nat (Fexp q'')) * / radix)%R.
apply
 ClosestErrorBound with (b := b) (precision := precision) (x := (w' + v')%R);
 auto.
apply (ClosestCompatible b radix (w' + v')%R (w' + v')%R q'); auto.
replace (FtoRradix w') with (FtoRradix w);
 replace (FtoRradix v') with (FtoRradix v); auto with real.
apply Rle_trans with (FtoR radix (Float 1%nat (Fexp q''))).
apply PuissLessThanHalf.
unfold FtoR in |- *; simpl in |- *.
apply
 Rle_trans with (pPred (vNum b) * (1 - / radix) * powerRZ 2 (Fexp q''))%R.
apply Rmult_le_compat_r; auto with real zarith.
repeat rewrite Rmult_1_l; auto.
replace (pPred (vNum b) * (1 - / radix) * powerRZ 2 (Fexp q''))%R with
 (pPred (vNum b) * ((1 - / radix) * powerRZ 2 (Fexp q'')))%R;
 [ apply Rmult_le_compat_l; auto with real zarith | ring; ring ].
replace ((1 - / radix) * powerRZ 2 (Fexp q''))%R with
 (powerRZ 2 (Fexp q'') - powerRZ 2 (Zpred (Fexp q'')))%R.
unfold Rminus in |- *; apply Rplus_le_compat_l; auto with real zarith.
apply Ropp_le_contravar; apply Rle_powerRZ; auto with real zarith.
apply Zle_Zpred.
replace (Fexp r) with (Fexp r'').
apply
 ClosestErrorExpStrict
  with (b := b) (radix := radix) (precision := precision) (x := (w' + v')%R);
 auto.
apply (ClosestCompatible b radix (w' + v')%R (w' + v')%R q'); auto.
replace (FtoRradix w') with (FtoRradix w);
 replace (FtoRradix v') with (FtoRradix v); auto with real.
replace (FtoR radix r'') with (FtoR radix r'); auto with real.
replace (Fexp r) with (Fexp v'); auto.
rewrite H'''5; apply Zmin_le2.
replace (Fexp w') with (Fexp u'').
apply Zlt_le_weak.
apply
 ClosestErrorExpStrict
  with (b := b) (radix := radix) (precision := precision) (x := (q + r)%R);
 auto.
apply (ClosestCompatible b radix (q + r)%R (q + r)%R u); auto.
replace (FtoR radix u'') with (FtoR radix u'); auto with real.
replace (FtoR radix u'') with (FtoR radix u); auto with real.
replace (FtoR radix v') with (FtoR radix v); auto with real.
rewrite H''5; apply sym_eq; apply Zmin_le2; auto.
rewrite H5; apply Zmin_le2; auto.
replace (powerRZ 2 (Zpred (Fexp q''))) with
 (/ radix * powerRZ 2 (Fexp q''))%R; auto with real.
ring.
unfold Zpred in |- *.
rewrite (powerRZ_add 2 (Fexp q'') (-1)); auto with real.
replace (powerRZ 2 (-1)) with (/ radix)%R;
 [ ring | unfold powerRZ in |- *; simpl in |- * ].
repeat rewrite Rmult_1_r; auto.
Qed.

End F2.