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.
intros P H' p q pq H'0.
case
(RoundedModeRep b radix precision)
with (p := Fplus radix p q) (q := pq) (P := P); auto with float arith.
rewrite Fplus_correct; auto with float arith.
simpl in |- *; intros x H'1.
case
(eqExpLess _ radixMoreThanOne b)
with (p := pq) (q := Float x (Fexp (Fplus radix p q)));
auto.
apply (RoundedModeBounded b radix) with (P := P) (r := (p + q)%R); auto.
simpl in |- *; intros x0 H'2; elim H'2; intros H'3 H'4; elim H'4;
intros H'5 H'6; clear H'4 H'2.
exists x0; split; [ idtac | split ]; auto.
unfold FtoRradix in |- *; rewrite H'5; auto.
apply le_IZR; auto.
Qed.
intros P H' p q pq H'0 H'1 H'2.
replace (Z.succ (Zmax (Fexp p) (Fexp q))) with
(Fexp (Float (pPred (vNum b)) (Z.succ (Zmax (Fexp p) (Fexp q)))));
[ idtac | simpl in |- *; auto ].
unfold FtoRradix in |- *; apply eqExpMax; auto.
apply RoundedModeBounded with (radix := radix) (P := P) (r := (p + q)%R);
auto with float arith.
unfold pPred in |- *; apply maxFbounded; auto.
apply Z.le_trans with (Fexp p); auto with float.
apply Z.le_trans with (Z.succ (Fexp p)); auto with float zarith.
replace
(FtoR radix (Float (pPred (vNum b)) (Z.succ (Zmax (Fexp p) (Fexp q))))) with
(radix * Float (pPred (vNum b)) (Zmax (Fexp p) (Fexp q)))%R.
rewrite Fabs_correct; auto with zarith.
unfold FtoRradix in |- *;
apply
RoundedModeMultAbs
with (b := b) (precision := precision) (P := P) (r := (p + q)%R);
auto.
unfold pPred in |- *; apply maxFbounded; auto.
apply Z.le_trans with (Fexp p); auto with float zarith.
apply Rle_trans with (Rabs p + Rabs q)%R.
apply Rabs_triang; auto.
apply
Rle_trans
with
(2%nat * FtoR radix (Float (pPred (vNum b)) (Zmax (Fexp p) (Fexp q))))%R;
auto.
cut (forall r : R, (2%nat * r)%R = (r + r)%R);
[ intros tmp; rewrite tmp; clear tmp | intros; simpl in |- *; ring ].
apply Rplus_le_compat; auto.
rewrite <- (Fabs_correct radix); auto with arith; apply maxMax1; auto;
apply ZmaxLe1.
rewrite <- (Fabs_correct radix); auto with arith; apply maxMax1; auto;
apply ZmaxLe2.
apply Rmult_le_compat; auto with real arith.
replace 0%R with (INR 0); auto with real arith.
apply LeFnumZERO; simpl in |- *; auto; replace 0%Z with (Z_of_nat 0);
auto with zarith.
unfold pPred in |- *; apply Zle_Zpred; auto with zarith.
rewrite INR_IZR_INZ; apply Rle_IZR; simpl in |- *; auto with zarith.
cut (1 < radix)%Z; auto with zarith;intros.
unfold FtoRradix, FtoR in |- *; simpl in |- *.
rewrite powerRZ_Zs; auto with real zarith; ring.
Qed.
intros P H' p q pq H'0 H'1 H'2.
case (plusExpMin P H' _ _ _ H'0).
intros r' H'3; elim H'3; intros H'4 H'5; elim H'5; intros H'6 H'7;
clear H'5 H'3.
case (Zle_or_lt (Fexp r') (Z.succ (Zmax (Fexp p) (Fexp q)))); intros Zl1.
exists r'; repeat (split; auto).
case (plusExpUpperBound P H' _ _ _ H'0); auto.
intros r'' H'3; elim H'3; intros H'5 H'8; elim H'8; intros H'9 H'10;
clear H'8 H'3.
exists
(Fshift radix (Z.abs_nat (Fexp r' - Z.succ (Zmax (Fexp p) (Fexp q)))) r');
split.
apply FboundedShiftLess with (n := Z.abs_nat (Fexp r' - Fexp r'')); auto.
apply ZleLe; auto.
repeat rewrite <- Zabs_absolu.
repeat rewrite Z.abs_eq; auto with zarith.
rewrite FshiftCorrectInv; auto.
apply trans_eq with (FtoRradix pq); auto.
apply Z.le_trans with (1 := H'10); auto with zarith.
split.
unfold FtoRradix in |- *; rewrite FshiftCorrect; auto.
split.
simpl in |- *.
repeat rewrite inj_abs; auto with zarith arith.
apply Z.le_trans with (Zmax (Fexp p) (Fexp q)); auto with zarith.
apply Zmin_Zmax; auto.
simpl in |- *.
repeat rewrite inj_abs; auto with zarith arith.
Qed.
intros P H' p q qmp H'0 H'1 H'2 H'3 H'4 H'5.
case (Rle_or_lt (/ 2%nat * q) p); intros Rle1.
exists p; split; auto.
replace (FtoRradix qmp) with (FtoRradix (Fminus radix q p)).
rewrite (Fminus_correct radix); auto with arith; unfold FtoRradix in |- *;
ring.
apply (RoundedModeProjectorIdemEq b radix precision) with (P := P); auto.
rewrite <- Fopp_Fminus.
apply oppBounded; auto.
apply Sterbenz; auto.
apply Rle_trans with (FtoRradix q); auto with real.
apply Rledouble; auto.
apply Rle_trans with (FtoRradix p); auto with real.
cut (CompatibleP b radix P);
[ intros Cp | apply RoundedModeP_inv2 with (1 := H'); auto ].
apply (Cp (q - p)%R (Fminus radix q p) qmp); auto.
rewrite (Fminus_correct radix); auto with arith.
apply RoundedModeBounded with (radix := radix) (P := P) (r := (q - p)%R);
auto; auto.
exists (Fminus radix q qmp); split.
rewrite <- Fopp_Fminus.
apply oppBounded; auto.
apply Sterbenz; auto.
apply RoundedModeBounded with (radix := radix) (P := P) (r := (q - p)%R);
auto; auto.
case MaxEx with (r := (/ 2%nat * FtoR radix q)%R) (3 := pGivesBound);
auto with arith.
intros max H'6.
apply Rle_trans with (FtoRradix max);
[ apply isMax_inv1 with (1 := H'6); auto | idtac ].
apply (RleBoundRoundl b radix precision) with (P := P) (r := (q - p)%R); auto;
fold FtoRradix in |- *.
case H'6; auto.
case MinEx with (r := (/ 2%nat * FtoR radix q)%R) (3 := pGivesBound);
auto with arith.
intros min H'7.
replace (FtoRradix max) with (q - min)%R.
apply Rplus_le_reg_l with (r := (- q)%R).
cut (forall p q : R, (- p + (p - q))%R = (- q)%R);
[ intros tmp; repeat rewrite tmp; clear tmp | intros; ring ].
apply Ropp_le_contravar.
case H'7.
intros H'8 H'9; elim H'9; intros H'10 H'11; apply H'11; clear H'9; auto.
apply Rlt_le; auto.
unfold FtoRradix in |- *;
rewrite (div2IsBetween b radix precision) with (5 := H'7) (6 := H'6);
auto.
ring.
apply Rle_trans with (FtoRradix q); auto with real.
apply (RleBoundRoundr b radix precision) with (P := P) (r := (q - p)%R); auto;
fold FtoRradix in |- *.
apply Rplus_le_reg_l with (r := (- q)%R).
cut (forall p q : R, (- p + (p - q))%R = (- q)%R);
[ intros tmp; repeat rewrite tmp; clear tmp | intros; ring ].
replace (- q + q)%R with (-0)%R; [ auto with real | ring ].
apply Rle_trans with (FtoRradix q); auto with real.
apply Rledouble; auto.
apply Rle_trans with (FtoRradix p); auto with real.
apply (Fminus_correct radix); auto with arith.
Qed.

Theorem radixRangeBoundExp :
forall p q : float,
Fcanonic radix b p ->
Fcanonic radix b q ->
(0 <= p)%R ->
(p < q)%R -> (q < radix * p)%R -> Fexp p = Fexp q \/ Z.succ (Fexp p) = Fexp q.