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.
intros p H'.
replace (Fulp p) with (Fulp (Fnormalize radix b precision p)).
replace (FtoRradix p) with (FtoRradix (Fnormalize radix b precision p)).
unfold FNSucc in |- *; apply FulpSucCan; auto with float arith.
unfold FtoRradix in |- *; apply FnormalizeCorrect; auto.
apply FulpComp; auto with float arith.
unfold FtoRradix in |- *; apply FnormalizeCorrect; auto.
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 arith.
unfold FtoRradix in |- *; rewrite <- Fminus_correct; auto with arith.
case (Z.eq_dec (Fnum p) (nNormMin radix precision)); intros H1'.
case (Z.eq_dec (Fexp p) (- dExp b)); intros H2'.
rewrite FPredDiff2; auto with arith.
unfold FtoR in |- *; simpl in |- *; rewrite Rmult_1_l; auto with real.
rewrite FPredDiff3; auto with arith.
unfold FtoR in |- *; simpl in |- *; rewrite Rmult_1_l; auto with real.
apply Rlt_le; apply Rlt_powerRZ; auto with real zarith.
replace 1%R with (INR 1); auto with real arith.
unfold Z.pred in |- *; auto with zarith.
rewrite FPredDiff1; auto with arith.
unfold FtoR in |- *; simpl in |- *; rewrite Rmult_1_l; auto with real.
apply FcanonicBound with (1 := H').
Qed.
intros p H'.
replace (Fulp p) with (Fulp (Fnormalize radix b precision p)).
replace (FtoRradix p) with (FtoRradix (Fnormalize radix b precision p)).
unfold FNPred in |- *; apply FulpPredCan; auto with float arith.
unfold FtoRradix in |- *; apply FnormalizeCorrect; auto.
apply FulpComp; auto with float arith.
unfold FtoRradix in |- *; apply FnormalizeCorrect; auto.
Qed.
intros x H.
unfold FtoRradix in |- *; apply FSuccDiff1; auto with arith.
Contradict H; unfold FtoRradix, FtoR in |- *; simpl in |- *; rewrite H.
apply Rlt_not_le.
replace 0%R with (0 * powerRZ radix (Fexp x))%R; [ idtac | ring ].
apply Rlt_monotony_exp; auto with real arith.
generalize (nNormPos _ radixMoreThanOne precision);
replace 0%R with (IZR (- 0%nat)); auto with real zarith arith.
Qed.
intros f Hf1 Hf2 H.
apply LeFulpPos; auto with zarith float; unfold FtoRradix in |- *.
apply R0RltRlePred; auto with arith.
apply Rlt_le; apply FPredLt; auto with arith.
Qed.
intros p H; unfold Fulp in |- *.
rewrite FcanonicFnormalizeEq; auto with arith.
unfold FtoRradix, FtoR in |- *; simpl in |- *; ring.
Qed.
intros x H H0; rewrite CanonicFulp; auto.
apply FSuccDiffPos; auto.
Qed.
intros x H H0.
unfold FNSucc in |- *.
rewrite FcanonicFnormalizeEq; auto with arith.
apply FSuccUlpPos; auto.
Qed.
intros f; unfold Fulp in |- *; case (Rle_or_lt 0 f); intros H'.
replace (Fabs f) with f; auto; unfold Fabs in |- *; apply floatEq;
simpl in |- *; auto with zarith real.
apply sym_eq; apply Z.abs_eq; apply LeR0Fnum with radix; auto with zarith real.
replace (Fabs f) with (Fopp f);
[ rewrite Fnormalize_Fopp | apply floatEq; simpl in |- * ];
auto with arith.
apply sym_eq; apply Zabs_eq_opp; apply R0LeFnum with radix;
auto with zarith real.
Qed.
intros P H' p q H'0.
case (Req_dec p q); intros Eq1.
rewrite <- Eq1.
replace (p - p)%R with 0%R; [ idtac | ring ].
rewrite Rabs_R0; auto.
unfold Fulp, FtoRradix, FtoR in |- *; simpl in |- *; auto with real arith.
case H'.
intros H'1 H'2; elim H'2; intros H'3 H'4; elim H'4; intros H'5 H'6;
case H'5 with (1 := H'0); clear H'5 H'4 H'2; intros H'5.
rewrite Rabs_right; auto.
cut (Fbounded b q); [ intros B0 | case H'5; auto ].
apply Rlt_le_trans with (2 := FulpSuc q B0).
apply Rplus_lt_reg_l with (r := FtoR radix q).
repeat rewrite Rplus_minus; auto.
case (Rle_or_lt (FNSucc b radix precision q) p); auto.
intros H'2; absurd (FNSucc b radix precision q <= q)%R; auto.
apply Rgt_not_le; red in |- *; unfold FtoRradix in |- *;
auto with real float arith.
case H'5; auto.
intros H'4 H'7; elim H'7; intros H'8 H'9; apply H'9; clear H'7; auto.
apply (FcanonicBound radix b); auto with float arith.
apply Rle_ge; apply Rplus_le_reg_l with (r := FtoR radix q).
repeat rewrite Rplus_minus; auto.
rewrite Rplus_0_r; apply isMin_inv1 with (1 := H'5); auto.
rewrite Faux.Rabsolu_left1; auto.
rewrite Ropp_minus_distr; auto.
cut (Fbounded b q); [ intros B0 | case H'5; auto ].
apply Rlt_le_trans with (2 := FulpPred q B0).
apply Ropp_lt_cancel; repeat rewrite Rminus_0_l.
apply Rplus_lt_reg_l with (r := FtoR radix q).
repeat rewrite Rplus_minus; auto.
case (Rle_or_lt p (FNPred b radix precision q)); auto.
intros H'2; absurd (q <= FNPred b radix precision q)%R; auto.
apply Rgt_not_le; red in |- *; unfold FtoRradix in |- *;
auto with real float arith.
case H'5; auto.
intros H'4 H'7; elim H'7; intros H'8 H'9; apply H'9; clear H'7; auto.
apply (FcanonicBound radix b); auto with float arith.
intros H1; apply Rplus_lt_compat_l; auto with real; apply Ropp_lt_contravar;
unfold Rminus in |- *; auto with real.
apply Rplus_le_reg_l with (r := FtoR radix q).
repeat rewrite Rplus_minus; auto.
rewrite Rplus_0_r; apply isMax_inv1 with (1 := H'5).
Qed.
intros P H p q x H0 H1 H2 H3 H4.
apply Zlt_powerRZ with (e := IZR radix); auto with real zarith.
apply Rle_lt_trans with (FtoRradix (Fabs q)).
replace (powerRZ radix (Fexp q)) with (FtoRradix (Float 1%nat (Fexp q)));
unfold FtoRradix in |- *;
[ apply Fop.RleFexpFabs; auto with arith
| unfold FtoR in |- *; simpl in |- *; ring ].
rewrite (Fabs_correct radix); auto with zarith.
fold FtoRradix in |- *; rewrite H3.
apply Rlt_le_trans with (Fulp p);
[ apply RoundedModeUlp with P; auto | unfold Fulp in |- * ].
apply Rle_powerRZ; auto with real zarith.
apply FcanonicLeastExp with radix b precision; auto with real arith.
apply sym_eq; apply FnormalizeCorrect; auto.
apply FnormalizeCanonic; auto with zarith.
Qed.

Theorem RoundedModeProjectorIdem :
forall P (p : float), RoundedModeP b radix P -> Fbounded b p -> P p p.