Section FMinMax.
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 precisionNotZero : precision <> 0.
Hypothesis pGivesBound : Zpos (vNum b) = Zpower_nat radix precision.
(* a function that returns a boundd greater than a given nat *)
Definition boundNat (n : nat) := Float 1%nat (digit radix n).
intros n; unfold FtoRradix, FtoR, boundNat in |- *; simpl in |- *.
rewrite Rmult_1_l.
rewrite <- Zpower_nat_Z_powerRZ; auto with real zarith.
rewrite INR_IZR_INZ; auto with real zarith.
apply Rle_lt_trans with (Z.abs n); [rewrite (Z.abs_eq (Z_of_nat n))|idtac];auto with real zarith.
Qed.
intros n; repeat split; unfold boundNat in |- *; simpl in |- *;
auto with zarith.
apply vNumbMoreThanOne with (radix := radix) (precision := precision);
auto with zarith.
apply Z.le_trans with 0%Z;[case (dExp b)|idtac]; auto with zarith.
Qed.
(* A function that returns a bounded greater than a given r *)
Definition boundR (r : R) := boundNat (Z.abs_nat (up (Rabs r))).
intros r; case (Rle_or_lt r 0); intros H'.
apply Rle_lt_trans with (1 := H').
unfold boundR, boundNat, FtoRradix, FtoR in |- *; simpl in |- *;
auto with real.
rewrite Rmult_1_l; auto with real zarith.
apply Rlt_trans with (2 := boundNatCorrect (Z.abs_nat (up (Rabs r)))).
replace (Rabs r) with r; auto with real.
apply Rlt_le_trans with (r2 := IZR (up r)); auto with real zarith.
case (archimed r); auto.
rewrite INR_IZR_INZ; auto with real zarith.
unfold Rabs in |- *; case (Rcase_abs r); auto with real.
intros H'0; Contradict H'0; auto with real.
Qed.
intros R; unfold boundR in |- *.
rewrite Rabs_Ropp; auto.
Qed.
intros r; case (Rle_or_lt r 0); intros H'.
rewrite boundRrOpp.
pattern r at 2 in |- *; rewrite <- (Ropp_involutive r).
unfold FtoRradix in |- *; rewrite Fopp_correct.
apply Ropp_lt_contravar; apply boundRCorrect1; auto.
apply Rle_lt_trans with 0%R; auto.
replace 0%R with (-0)%R; auto with real.
unfold FtoRradix in |- *; rewrite Fopp_correct.
apply Ropp_le_contravar.
unfold boundR, boundNat, FtoRradix, FtoR in |- *; simpl in |- *;
auto with real zarith.
rewrite Rmult_1_l; apply Rlt_le; auto with real zarith arith.
Qed.
(* A function that returns a list containing all the bounded smaller than a given real *)
Definition mBFloat (p : R) :=
map (fun p : Z * Z => Float (fst p) (snd p))
(mProd Z Z (Z * Z)
(mZlist (- pPred (vNum b)) (pPred (vNum b)))
(mZlist (- dExp b) (Fexp (boundR p)))).
intros r q.
case (Zle_or_lt (Fexp (boundR r)) (Fexp q)); intros H'.
intros H'0 H'1 H'2 H'3; case H'0.
apply is_Fzero_rep2 with (radix := radix); auto.
rewrite <-
FshiftCorrect with (n := Z.abs_nat (Fexp q - Fexp (boundR r))) (x := q);
auto with arith.
apply is_Fzero_rep1 with (radix := radix).
unfold is_Fzero in |- *.
cut (forall p : Z, (- 1%nat < p)%Z -> (p < 1%nat)%Z -> p = 0%Z);
[ intros tmp; apply tmp | idtac ].
replace (- 1%nat)%Z with (Fnum (Fopp (boundR r))).
apply Rlt_Fexp_eq_Zlt with (radix := radix); auto with real zarith.
rewrite FshiftCorrect; auto.
unfold Fshift in |- *; simpl in |- *.
rewrite (fun x y => inj_abs (x - y)); auto with zarith.
simpl in |- *; auto.
replace (Z_of_nat 1) with (Fnum (boundR r)).
apply Rlt_Fexp_eq_Zlt with (radix := radix); auto with zarith.
rewrite FshiftCorrect; auto.
unfold Fshift in |- *; simpl in |- *.
rewrite inj_abs; auto with zarith.
generalize H'; simpl in |- *; auto with zarith.
simpl in |- *; auto.
intros p0; case p0; simpl in |- *; auto with zarith.
intros H'0 H'1 H'2 H'3; unfold mBFloat in |- *.
replace q with
((fun p : Z * Z => Float (fst p) (snd p)) (Fnum q, Fexp q)).
apply in_map with (f := fun p : Z * Z => Float (fst p) (snd p));
auto.
apply mProd_correct; auto.
apply mZlist_correct; auto with float.
apply Zle_Zabs_inv1; auto with float.
unfold pPred in |- *; apply Zle_Zpred; auto with float.
apply Zle_Zabs_inv2; auto with float.
unfold pPred in |- *; apply Zle_Zpred; auto with float.
apply mZlist_correct; auto with float.
auto with zarith.
case q; simpl in |- *; auto with zarith.
Qed.
intros r; unfold mBFloat in |- *.
replace (boundR r) with
((fun p : Z * Z => Float (fst p) (snd p))
(Fnum (boundR r), Fexp (boundR r))).
apply in_map with (f := fun p : Z * Z => Float (fst p) (snd p));
auto.
apply mProd_correct; auto.
apply mZlist_correct; auto.
unfold boundR, boundNat in |- *; simpl in |- *; auto with zarith.
apply Z.le_trans with (- (0))%Z; auto with zarith.
apply Zle_Zopp; unfold pPred in |- *; apply Zle_Zpred; simpl in |- *.
apply Z.lt_trans with 1%Z; auto with zarith.
apply vNumbMoreThanOne with (3 := pGivesBound); auto.
unfold boundR, boundNat in |- *; simpl in |- *; auto with zarith.
unfold pPred in |- *; apply Zle_Zpred; simpl in |- *.
unfold boundR, boundNat in |- *; simpl in |- *; auto with zarith.
apply vNumbMoreThanOne with (3 := pGivesBound); auto.
apply mZlist_correct; auto.
unfold boundR, boundNat in |- *; simpl in |- *; auto with zarith.
apply Z.le_trans with 0%Z; auto with zarith arith.
case (dExp b); auto with zarith.
case (boundR r); simpl in |- *; auto with zarith.
case (boundR r); simpl in |- *; auto with zarith.
Qed.
intros r; unfold mBFloat in |- *.
replace (Fopp (boundR r)) with
((fun p : Z * Z => Float (fst p) (snd p))
(Fnum (Fopp (boundR r)), Fexp (Fopp (boundR r)))).
apply in_map with (f := fun p : Z * Z => Float (fst p) (snd p));
auto.
apply mProd_correct; auto.
apply mZlist_correct; auto.
unfold boundR, boundNat in |- *; simpl in |- *; auto with zarith.
replace (-1)%Z with (- Z_of_nat 1)%Z; auto with zarith.
apply Zle_Zopp.
unfold pPred in |- *; apply Zle_Zpred; simpl in |- *.
apply (vNumbMoreThanOne radix) with (precision := precision);
auto with zarith.
unfold pPred in |- *; apply Zle_Zpred; simpl in |- *.
red in |- *; simpl in |- *; auto.
apply mZlist_correct; auto.
unfold boundR, boundNat in |- *; simpl in |- *; auto with zarith.
apply Z.le_trans with 0%Z; auto with zarith.
case (dExp b); auto with zarith.
case (boundR r); simpl in |- *; auto with zarith.
case (boundR r); simpl in |- *; auto with zarith.
Qed.

Theorem mBFadic_correct4 :
forall r : R, In (Float 0%nat (- dExp b)) (mBFloat r).