Section FRoundP.
Variable b : Fbound.
Variable radix : Z.
Variable precision : nat.
Let FtoRradix := FtoR radix.
Coercion FtoRradix : float >-> R.
Hypothesis radixMoreThanOne : (1 < radix)%Z.
Let radixMoreThanZERO := Zlt_1_O _ (Zlt_le_weak _ _ radixMoreThanOne).
Hint Resolve radixMoreThanZERO: zarith.
Hypothesis precisionGreaterThanOne : 1 < precision.
Hypothesis pGivesBound : Zpos (vNum b) = Zpower_nat radix precision.
Definition Fulp (p : float) :=
powerRZ radix (Fexp (Fnormalize radix b precision p)).
intros p q H' H'0 H'1; unfold Fulp in |- *.
rewrite
FcanonicUnique
with
(p := Fnormalize radix b precision p)
(q := Fnormalize radix b precision q)
(3 := pGivesBound); auto with float arith.
apply trans_eq with (FtoR radix p).
apply FnormalizeCorrect; auto.
apply trans_eq with (FtoR radix q); auto.
apply sym_eq; apply FnormalizeCorrect; auto.
Qed.
intros p H'; unfold Fulp, FtoRradix, FtoR, Fnormalize in |- *; simpl in |- *;
rewrite Rmult_1_l.
case (Z_zerop (Fnum p)); simpl in |- *; auto.
intros H'0; apply (Rle_powerRZ radix (- dExp b) (Fexp p));
auto with float real zarith.
intros H'0; apply Rle_powerRZ; auto with real zarith arith.
Qed.
intros x; unfold is_Fzero, Fulp, Fnormalize in |- *; case (Z_zerop (Fnum x));
simpl in |- *; auto.
intros H' H'0; Contradict H'; auto.
Qed.
intros p H1 H2; unfold Fulp in |- *.
replace (FtoRradix p) with (FtoRradix (Fnormalize radix b precision p));
[ idtac | unfold FtoRradix in |- *; apply FnormalizeCorrect; auto ].
apply Rmult_le_reg_l with (powerRZ radix (Z.pred precision)).
apply powerRZ_lt; auto with real arith.
replace
(powerRZ radix (Z.pred precision) *
(Rabs (Fnormalize radix b precision p) *
powerRZ radix (Z.succ (- precision))))%R with
(Rabs (Fnormalize radix b precision p)).
unfold FtoRradix in |- *; rewrite <- Fabs_correct; auto with arith real.
unfold Fabs, FtoR in |- *; simpl in |- *.
apply Rmult_le_compat_r; [ apply powerRZ_le | rewrite <- inj_pred ];
auto with real arith zarith.
rewrite <- Zpower_nat_Z_powerRZ.
replace (Zpower_nat radix (pred precision)) with (nNormMin radix precision);
auto; apply Rle_IZR.
apply pNormal_absolu_min with b; auto with arith zarith real.
apply
trans_eq
with
(Rabs (Fnormalize radix b precision p) *
(powerRZ radix (Z.pred precision) * powerRZ radix (Z.succ (- precision))))%R;
[ idtac | ring ].
rewrite <- powerRZ_add; auto with zarith real.
replace (Z.pred precision + Z.succ (- precision))%Z with 0%Z;
[ simpl in |- *; ring | unfold Z.succ, Z.pred in |- *; ring ];
auto with real zarith.
Qed.
intros p H.
replace (FtoRradix p) with (FtoRradix (Fnormalize radix b precision p));
[ idtac | unfold FtoRradix in |- *; apply FnormalizeCorrect; auto ].
unfold FtoRradix in |- *; rewrite <- Fabs_correct; auto with arith real.
unfold FtoR in |- *; simpl in |- *; unfold Fulp in |- *.
apply Rmult_le_compat_r; [ apply powerRZ_le | idtac ];
auto with real arith zarith.
apply Rle_trans with (IZR (Z.pred (Zpos (vNum b))));
[ apply Rle_IZR; auto with float zarith | idtac ].
unfold Z.pred in |- *; right; rewrite pGivesBound; replace 1%R with (IZR 1);
auto with real.
rewrite <- Zpower_nat_Z_powerRZ; rewrite Z_R_minus;auto.
Qed.
intros x y Hx Hy H1 H2; unfold Fulp in |- *.
apply Rle_powerRZ; auto with real zarith.
apply Fcanonic_Rle_Zle with radix b precision; auto with zarith arith.
apply FnormalizeCanonic; auto with zarith arith.
apply FnormalizeCanonic; auto with zarith arith.
repeat rewrite FnormalizeCorrect; auto with zarith arith real.
repeat rewrite Rabs_right; auto with zarith arith real.
apply Rge_trans with (FtoRradix x); auto with real.
Qed.
intros p H'.
replace (Fulp p) with (powerRZ radix (Fexp p)).
2: unfold Fulp in |- *; replace (Fnormalize radix b precision p) with p; auto;
apply sym_equal; apply FcanonicUnique with (3 := pGivesBound);
auto with arith; apply FnormalizeCanonic || apply FnormalizeCorrect;
auto with float zarith.
2: apply FcanonicBound with (1 := H'); auto with float zarith.
unfold FtoRradix in |- *; rewrite <- Fminus_correct; auto with zarith.
case (Z.eq_dec (Fnum p) (- nNormMin radix precision)); intros H1'.
case (Z.eq_dec (Fexp p) (- dExp b)); intros H2'.
rewrite FSuccDiff2; auto with arith.
unfold FtoR in |- *; simpl in |- *; rewrite Rmult_1_l; auto with real.
rewrite FSuccDiff3; auto with arith.
unfold FtoR in |- *; simpl in |- *; rewrite Rmult_1_l.
apply Rlt_le; apply Rlt_powerRZ; auto with real zarith.
unfold Z.pred in |- *; auto with zarith.
rewrite FSuccDiff1; auto with arith.
unfold FtoR in |- *; simpl in |- *; rewrite Rmult_1_l; auto with real.
Qed.

Theorem FulpSuc :
forall p : float,
Fbounded b p -> (FNSucc b radix precision p - p <= Fulp p)%R.