intros p q r H' H'0 H'1 H'2.
cut (Fcanonic radix b (Fnormalize radix b precision r));
[ intros tmp; Casec tmp; intros Fs | idtac ].
3: apply FnormalizeCanonic; auto with arith.
3: apply
RoundedModeBounded
with (radix := radix) (P := Closest b radix) (r := (p + q)%R);
auto.
3: apply ClosestRoundedModeP with (precision := precision); auto.
2: rewrite <- (plusExact1 p q (Fnormalize radix b precision r)); auto.
2: unfold FtoRradix in |- *; rewrite FnormalizeCorrect; auto with arith.
2: replace (FtoR radix r - FtoR radix r)%R with 0%R; [ idtac | ring ].
2: rewrite Rabs_R0.
2: replace 0%R with (0 * (radix * / pPred (vNum b)))%R;
[ apply Rmult_lt_compat_r | ring ].
2: replace 0%R with (0 * / pPred (vNum b))%R;
[ apply Rmult_lt_compat_r | ring ].
2: apply Rinv_0_lt_compat; replace 0%R with (IZR 0); auto with real zarith.
2: apply Rlt_IZR; unfold pPred in |- *; apply Zlt_succ_pred; simpl in |- *.
2: apply vNumbMoreThanOne with (radix := radix) (precision := precision);
auto with real zarith.
2: cut (1 < radix)%Z; auto with real zarith.
2: replace 0%R with (0 * / 2%nat)%R; [ apply Rmult_lt_compat_r | ring ];
auto with real.
2: case (Rabs_pos (FtoR radix r)); auto.
2: intros H'3; Contradict H'2.
2: apply is_Fzero_rep2 with (radix := radix); auto with real arith.
2: generalize H'3; fold FtoRradix in |- *; unfold Rabs in |- *;
case (Rcase_abs r); auto.
2: intros r0 H'2; replace 0%R with (-0)%R; [ rewrite H'2 | idtac ]; ring.
2: apply (ClosestCompatible b radix (p + q)%R (p + q)%R r); auto.
2: apply sym_eq; apply FnormalizeCorrect; auto.
2: apply FnormalizeBounded; auto with arith.
2: apply
RoundedModeBounded
with (radix := radix) (P := Closest b radix) (r := (p + q)%R);
auto.
2: apply ClosestRoundedModeP with (precision := precision); auto.
2: replace (Fexp (Fnormalize radix b precision r)) with (- dExp b)%Z.
2: unfold Zmin in |- *; case (Fexp p ?= Fexp q)%Z; auto with float.
2: apply sym_equal; case Fs; intros H1 H2; case H2; auto.
apply Rle_lt_trans with (/ 2%nat * Fulp b radix precision r)%R.
apply Rmult_le_reg_l with (r := INR 2); auto with real.
rewrite <- Rmult_assoc; rewrite Rinv_r; auto with real; rewrite Rmult_1_l.
unfold FtoRradix in |- *; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr;
rewrite <- (Fplus_correct radix); auto with zarith.
apply ClosestUlp; auto.
rewrite Fplus_correct; auto with arith.
replace (Rabs r * / 2%nat * (radix * / pPred (vNum b)))%R with
(/ 2%nat * (Rabs r * (radix * / pPred (vNum b))))%R;
[ apply Rmult_lt_compat_l; auto with real | ring ].
replace (Fulp b radix precision r) with
(Float (pPred (vNum b)) (Zpred (Fexp (Fnormalize radix b precision r))) *
(radix * / pPred (vNum b)))%R.
apply Rmult_lt_compat_r.
replace 0%R with (radix * 0)%R; [ apply Rmult_lt_compat_l | ring ];
auto with real arith.
apply Rinv_0_lt_compat; replace 0%R with (IZR 0%nat); auto with real arith;
apply Rlt_IZR.
unfold pPred in |- *; apply Zlt_succ_pred;
apply (vNumbMoreThanOne radix) with (precision := precision);
auto with zarith.
unfold FtoRradix in |- *;
rewrite <- (FnormalizeCorrect _ radixMoreThanOne b precision r).
rewrite <- (Fabs_correct radix); auto with arith.
apply FnormalBoundAbs; auto with zarith.
unfold Fulp, FtoRradix, FtoR in |- *; simpl in |- *.
apply
trans_eq
with
(pPred (vNum b) * / pPred (vNum b) *
(radix * powerRZ radix (Zpred (Fexp (Fnormalize radix b precision r)))))%R;
[ ring | idtac ]; auto.
rewrite Rinv_r; auto with real arith.
rewrite <- powerRZ_Zs; auto with real.
cut (forall r : Z, Zsucc (Zpred r) = r);
[ intros Er; rewrite Er | intros r'; unfold Zsucc, Zpred in |- * ];
ring.
apply Rlt_dichotomy_converse; right; red in |- *.
replace 0%R with (IZR 0); cut (1 < radix)%Z; auto with real zarith.
apply Rlt_dichotomy_converse; right; red in |- *.
replace 0%R with (IZR 0); auto with real zarith.
unfold pPred in |- *; apply Rlt_IZR; apply Zlt_succ_pred; simpl in |- *.
apply vNumbMoreThanOne with (radix := radix) (precision := precision);
auto with real arith.
Qed.

(* Specifications: *)
Theorem plusErrorBound1bis :
forall p q r : float,
Fbounded b p ->
Fbounded b q ->
Closest b radix (p + q) r ->
~ is_Fzero r ->
(Rabs (r - (p + q)) <= Rabs r * / 2%nat * (radix * / Zpos (vNum b)))%R.