Section Fclosestp2.
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 r H'; split.
apply oppBounded; auto.
case H'; auto.
intros f H'0.
rewrite Fopp_correct.
replace (- FtoR radix p - - r)%R with (- (FtoR radix p - r))%R;
[ idtac | ring ].
replace (FtoR radix f - - r)%R with (- (- FtoR radix f - r))%R;
[ idtac | ring ].
rewrite <- Fopp_correct.
repeat rewrite Rabs_Ropp.
case H'; auto with float.
Qed.
intros p r H'; case (Rle_or_lt 0 r); intros Rl0.
rewrite Rabs_right; auto with real.
replace (Fabs p) with p; auto.
unfold Fabs in |- *; apply floatEq; simpl in |- *; auto.
cut (0 <= Fnum p)%Z.
case (Fnum p); simpl in |- *; auto; intros p' H0; Contradict H0;
apply Zlt_not_le; red in |- *; simpl in |- *; auto with zarith.
apply LeR0Fnum with (radix := radix); auto.
apply
RleRoundedR0
with (b := b) (precision := precision) (P := Closest b radix) (r := r);
auto.
apply ClosestRoundedModeP with (precision := precision); auto with real.
rewrite Faux.Rabsolu_left1; auto.
replace (Fabs p) with (Fopp p).
apply ClosestOpp; auto.
unfold Fabs in |- *; apply floatEq; simpl in |- *; auto.
cut (Fnum p <= 0)%Z.
case (Fnum p); simpl in |- *; auto; intros p' H0; Contradict H0;
apply Zlt_not_le; red in |- *; simpl in |- *; auto with zarith.
apply R0LeFnum with (radix := radix); auto.
apply
RleRoundedLessR0
with (b := b) (precision := precision) (P := Closest b radix) (r := r);
auto.
apply ClosestRoundedModeP with (precision := precision); auto.
apply Rlt_le; auto.
apply Rlt_le; auto.
Qed.
intros p q H'.
case (Req_dec p q); intros Eqpq.
rewrite Eqpq.
replace (Rabs (q - q)) with 0%R;
[ rewrite Rmult_0_r
| replace (q - q)%R with 0%R; try ring; rewrite Rabs_right; auto with real ].
unfold Fulp in |- *; apply Rlt_le; auto with real arith.
replace (2%nat * Rabs (p - q))%R with (Rabs (p - q) + Rabs (p - q))%R;
[ idtac | simpl in |- *; ring ].
case ClosestMinOrMax with (1 := H'); intros H'1.
apply Rle_trans with (Rabs (p - q) + Rabs (FNSucc b radix precision q - p))%R.
apply Rplus_le_compat_l.
rewrite <- (Rabs_Ropp (p - q)).
rewrite Ropp_minus_distr.
elim H'; auto.
intros H'0 H'2; apply H'2; auto.
apply FcanonicBound with (radix := radix); auto with float arith.
rewrite Rabs_right.
rewrite Rabs_right.
replace (p - q + (FNSucc b radix precision q - p))%R with
(FNSucc b radix precision q - q)%R; [ idtac | ring ].
unfold FtoRradix in |- *; apply FulpSuc; auto.
case H'1; auto.
apply Rge_minus; apply Rle_ge; auto with real float.
case MinMax with (3 := pGivesBound) (r := p) (p := q); auto with arith.
intros H'0 H'2; elim H'2; intros H'3 H'4; apply H'3; clear H'2; auto.
apply Rge_minus; apply Rle_ge; auto with real float.
apply isMin_inv1 with (1 := H'1).
apply Rle_trans with (Rabs (p - q) + Rabs (p - FNPred b radix precision q))%R.
apply Rplus_le_compat_l.
rewrite <- (Rabs_Ropp (p - q));
rewrite <- (Rabs_Ropp (p - FNPred b radix precision q)).
repeat rewrite Ropp_minus_distr.
elim H'; auto.
intros H'0 H'2; apply H'2; auto.
apply FcanonicBound with (radix := radix); auto with float arith.
rewrite <- (Rabs_Ropp (p - q)); rewrite Ropp_minus_distr.
rewrite Rabs_right.
rewrite Rabs_right.
replace (q - p + (p - FNPred b radix precision q))%R with
(q - FNPred b radix precision q)%R; [ idtac | ring ].
unfold FtoRradix in |- *; apply FulpPred; auto.
case H'1; auto.
apply Rge_minus; apply Rle_ge; auto with real float.
case MaxMin with (3 := pGivesBound) (r := p) (p := q); auto with arith.
intros H'0 H'2; elim H'2; intros H'3 H'4; apply H'3; clear H'2; auto.
apply Rge_minus; apply Rle_ge; auto with real float.
apply isMax_inv1 with (1 := H'1).
Qed.
intros p q H'.
apply Rle_trans with (Fulp b radix precision q).
apply (ClosestUlp p q); auto.
replace (powerRZ radix (Fexp q)) with (FtoRradix (Float 1%nat (Fexp q))).
apply (FulpLe b radix); auto.
apply
RoundedModeBounded with (radix := radix) (P := Closest b radix) (r := p);
auto.
apply ClosestRoundedModeP with (precision := precision); auto.
unfold FtoRradix, FtoR in |- *; simpl in |- *.
ring.
Qed.
intros.
case (Zle_or_lt (Fexp p) (Fexp q)); auto; intros Z1.
absurd (powerRZ radix (Fexp p) <= powerRZ radix (Fexp q))%R.
2: apply Rle_powerRZ; auto with real arith.
apply Rgt_not_le.
red in |- *; apply Rlt_le_trans with (2%nat * powerRZ radix (Fexp q))%R.
apply Rltdouble; auto with real arith.
apply Rle_trans with (2%nat * Fabs q)%R.
apply Rmult_le_compat_l; auto with real arith.
replace 0%R with (INR 0); auto with real arith.
replace (powerRZ radix (Fexp q)) with (FtoRradix (Float 1%nat (Fexp q)));
auto.
apply (Fop.RleFexpFabs radix); auto with real zarith.
unfold FtoRradix, FtoR in |- *; simpl in |- *; ring.
rewrite (Fabs_correct radix); auto with arith.
replace (FtoR radix q) with (x - p)%R; auto.
apply ClosestExp; auto.
Qed.
intros p q H' H'0.
case (Rabs_pos (q - p)); intros H1.
Contradict H1; apply Rle_not_lt.
replace 0%R with (Rabs (p - p)); [ case H'0; auto | idtac ].
replace (p - p)%R with 0%R; [ apply Rabs_R0; auto | ring ].
apply Rplus_eq_reg_l with (r := (- p)%R).
apply trans_eq with 0%R; [ ring | idtac ].
apply trans_eq with (q - p)%R; [ idtac | ring ].
generalize H1; unfold Rabs in |- *; case (Rcase_abs (q - p)); auto.
intros r H0; replace 0%R with (-0)%R; [ rewrite H0 | idtac ]; ring.
Qed.
intros r1 r2 min max p q H' H'0 H'1 H'2 H'3.
case (Rle_or_lt r2 max); intros H'4.
2: apply (ClosestMonotone b radix) with (p := r1) (q := r2); auto.
2: apply Rle_lt_trans with (FtoRradix max); auto.
2: apply isMax_inv1 with (1 := H'0).
case H'4; clear H'4; intros H'4.
2: replace (FtoRradix q) with (FtoRradix max).
2: case ClosestMinOrMax with (1 := H'2); intros H'5.
2: replace (FtoRradix p) with (FtoRradix min).
2: apply Rle_trans with r1.
2: apply isMin_inv1 with (1 := H').
2: apply isMax_inv1 with (1 := H'0).
2: apply MinEq with (1 := H'); auto.
2: replace (FtoRradix p) with (FtoRradix max); auto with real.
2: apply MaxEq with (1 := H'0); auto.
2: apply ClosestIdem; auto.
2: case H'0; auto.
2: rewrite <- H'4; auto.
cut (min < r2)%R.
2: apply Rmult_lt_reg_l with (r := INR 2); auto with real.
2: replace (2%nat * min)%R with (min + min)%R;
[ idtac | simpl in |- *; ring ].
2: apply Rle_lt_trans with (2 := H'1).
2: apply Rplus_le_compat_l; auto with real.
2: apply Rle_trans with r1.
2: apply isMin_inv1 with (1 := H').
2: apply isMax_inv1 with (1 := H'0).
intros H'5.
replace (FtoRradix q) with (FtoRradix max).
case ClosestMinOrMax with (1 := H'2); intros H'6.
replace (FtoRradix p) with (FtoRradix min).
apply Rle_trans with r1.
apply isMin_inv1 with (1 := H').
apply isMax_inv1 with (1 := H'0).
apply MinEq with (1 := H'); auto.
replace (FtoRradix p) with (FtoRradix max); auto with real.
apply MaxEq with (1 := H'0); auto.
apply sym_eq.
apply (ClosestMaxEq b radix) with (r := r2) (min := min); auto.
apply isMinComp with (2 := H'0); auto.
apply isMaxComp with (1 := H'); auto.
Qed.

Theorem FmultRadixInv :
forall (x z : float) (y : R),
Fbounded b x ->
Closest b radix y z -> (/ 2%nat * x < y)%R -> (/ 2%nat * x <= z)%R.