Section Fbounded_Def.
Variable radix : Z.
Hypothesis radixMoreThanOne : (1 < radix)%Z.
Let radixMoreThanZERO := Zlt_1_O _ (Zlt_le_weak _ _ radixMoreThanOne).
Hint Resolve radixMoreThanZERO: zarith.
Let FtoRradix := FtoR radix.
Local Coercion FtoRradix : float >-> R.
Coercion Z_of_N: N >-> Z.
Record Fbound : Set := Bound {vNum : positive; dExp : N}.
Definition Fbounded (b : Fbound) (d : float) :=
(Z.abs (Fnum d) < Zpos (vNum b))%Z /\ (- dExp b <= Fexp d)%Z.
intros b p H; case H; intros H1 H2; case H1; auto.
Qed.
intros b p H; case H; auto.
Qed.
Hint Resolve FboundedNum FboundedExp: float.
intros b p; case (Z_le_gt_dec (Zpos (vNum b)) (Z.abs (Fnum p)));
intros H'.
right; red in |- *; intros H'3; Contradict H'; auto with float zarith.
case (Z_le_gt_dec (- dExp b) (Fexp p)); intros H'1.
left; repeat split; auto with zarith.
right; red in |- *; intros H'3; Contradict H'1; auto with float zarith.
Qed.
intros b; unfold FtoRradix, FtoR in |- *; simpl in |- *; auto with real.
Qed.
intros b; repeat (split; simpl in |- *).
replace 0%Z with (- 0%nat)%Z; [ idtac | simpl in |- *; auto ].
apply Zeq_le; auto with arith.
Qed.
Hint Unfold Fbounded.
intros b p H'; (repeat split; simpl in |- *; auto with float zarith).
Qed.
intros b p n H'; repeat split; simpl in |- *; auto with float.
apply Z.le_trans with (Fexp p); auto with float.
pattern (Fexp p) at 1 in |- *;
(replace (Fexp p) with (Fexp p + 0%nat)%Z; [ idtac | simpl in |- *; ring ]).
apply Zplus_le_compat_l.
apply inj_le; auto with arith.
Qed.
intros b p n; unfold FtoRradix, FtoR in |- *; simpl in |- *.
rewrite powerRZ_add; auto with real zarith.
ring.
Qed.
intros b x H'; repeat split; simpl in |- *; auto with float zarith.
replace (Z.abs (- Fnum x)) with (Z.abs (Fnum x)); auto with float.
case (Fnum x); simpl in |- *; auto.
Qed.
intros b x H'; rewrite <- (Fopp_Fopp x).
apply oppBounded; auto.
Qed.
intros b z p H'; elim H'; intros r E; elim E; intros H'0 H'1; elim H'1;
intros H'2 H'3; clear H'1 E H'.
exists (Fopp r); split; auto.
rewrite <- (Ropp_involutive p).
rewrite <- H'0; auto.
unfold FtoRradix in |- *; apply Fopp_correct; auto.
split.
apply oppBounded; auto.
simpl in |- *; auto.
Qed.
intros b f H'; repeat split; simpl in |- *; auto with float.
replace (Z.abs (Z.abs (Fnum f))) with (Z.abs (Fnum f)); auto with float.
case (Fnum f); auto.
Qed.
intros b p q H' H'0 H'1 H'2.
cut (0 <= Fnum p)%Z;
[ intros Z1
| apply (LeR0Fnum radix); auto with real arith; fold FtoRradix in |- *;
rewrite H'0; auto ].
cut (0 <= Fnum q)%Z;
[ intros Z2 | apply (LeR0Fnum radix); auto with real arith ].
split.
apply Z.le_lt_trans with (Z.abs (Fnum p)); [ idtac | auto with float ].
repeat rewrite Z.abs_eq; auto.
apply Z.le_trans with (Fnum (Fshift radix (Z.abs_nat (Fexp q - Fexp p)) q));
auto.
unfold Fshift in |- *; simpl in |- *; auto.
pattern (Fnum q) at 1 in |- *; replace (Fnum q) with (Fnum q * 1)%Z;
auto with zarith.
apply (Rle_Fexp_eq_Zle radix); auto with real zarith.
rewrite FshiftCorrect; auto with real zarith.
unfold Fshift in |- *; simpl in |- *; rewrite inj_abs; try ring.
apply Zle_Zminus_ZERO; apply le_IZR; auto with real arith.
apply Z.le_trans with (Fexp p).
case H'; auto.
apply le_IZR; auto with real arith.
Qed.
intros b p q H' H'0 H'1; split.
apply Z.le_lt_trans with (Z.abs (Fnum p)); [ idtac | auto with float ].
apply
Z.le_trans with (Z.abs (Fnum (Fshift radix (Z.abs_nat (Fexp q - Fexp p)) q)));
auto.
unfold Fshift in |- *; simpl in |- *; auto.
rewrite Zabs_Zmult.
pattern (Z.abs (Fnum q)) at 1 in |- *;
replace (Z.abs (Fnum q)) with (Z.abs (Fnum q) * 1%nat)%Z;
[ apply Zle_Zmult_comp_l | auto with zarith ]; auto with zarith.
rewrite Z.abs_eq; simpl in |- *; auto with zarith.
simpl in |- *; ring.
cut (Fexp p <= Fexp q)%Z; [ intros E2 | idtac ].
apply le_IZR; auto.
apply (Rle_monotony_contra_exp radix) with (z := Fexp p);
auto with real arith.
pattern (Fexp p) at 2 in |- *;
replace (Fexp p) with (Fexp (Fshift radix (Z.abs_nat (Fexp q - Fexp p)) q));
auto.
rewrite <- (fun x => Rabs_pos_eq (powerRZ radix x)); auto with real zarith.
rewrite <- Faux.Rabsolu_Zabs.
rewrite <- Rabs_mult.
change
(Rabs (FtoRradix (Fshift radix (Z.abs_nat (Fexp q - Fexp p)) q)) <=
Z.abs (Fnum p) * powerRZ radix (Fexp p))%R in |- *.
unfold FtoRradix in |- *; rewrite FshiftCorrect; auto.
fold FtoRradix in |- *; rewrite <- H'0.
rewrite <- (Fabs_correct radix); auto with real zarith.
unfold Fshift in |- *; simpl in |- *.
rewrite inj_abs; [ ring | auto with zarith ].
cut (Fexp p <= Fexp q)%Z; [ intros E2 | apply le_IZR ]; auto.
apply Z.le_trans with (Fexp p); [ idtac | apply le_IZR ]; auto with float.
Qed.
intros b p q H' H'0.
case (Rle_or_lt (Fexp q) (Fexp p)); intros H'1.
exists p; repeat (split; auto).
exists q; split; [ idtac | split ]; auto with real.
apply FboundedEqExp with (p := p); auto.
apply Rlt_le; auto.
Qed.
intros b f n m H' H'0; split; auto.
simpl in |- *; auto.
apply Z.le_lt_trans with (Z.abs (Fnum (Fshift radix n f))).
simpl in |- *; replace m with (m + 0); auto with arith.
replace n with (m + (n - m)); auto with arith.
repeat rewrite Zpower_nat_is_exp.
repeat rewrite Zabs_Zmult; auto.
apply Zle_Zmult_comp_l; auto with zarith.
apply Zle_Zmult_comp_l; auto with zarith.
repeat rewrite Z.abs_eq; auto with zarith.
case H'0; auto.
apply Z.le_trans with (Fexp (Fshift radix n f)); auto with float.
simpl in |- *; unfold Zminus in |- *; auto with zarith.
Qed.

Theorem eqExpMax :
forall (b : Fbound) (p q : float),
Fbounded b p ->
Fbounded b q ->
(Fabs p <= q)%R ->
exists r : float, Fbounded b r /\ r = p :>R /\ (Fexp r <= Fexp q)%Z.