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.

Theorem LeFulpPos :
forall x y : float,
Fbounded b x ->
Fbounded b y -> (0 <= x)%R -> (x <= y)%R -> (Fulp x <= Fulp y)%R.