Library Float.Others.Divnk
Require Export AllFloat.
Section Divnk.
Variables b1 b2 b3 : Fbound.
Variables n k : nat.
Variables x y z: float.
Let radix := 2%Z.
Let FtoRradix := FtoR radix.
Coercion FtoRradix : float >-> R.
Hypotheses nGreaterThanOne : (lt (S O) n).
Hypotheses kGreaterThanOne : (lt (S O) k).
Hypotheses nGivesBound1 : (Zpos (vNum b1)) = (Zpower_nat radix n).
Hypotheses kGivesBound2 : (Zpos (vNum b2)) = (Zpower_nat radix k).
Hypotheses nkGivesBound3 : (Zpos (vNum b3)) = (Zpower_nat radix (plus n k)).
Hypotheses Normz : (Fnormal radix b1 z).
Hypotheses Normy : (Fnormal radix b2 y).
Hypotheses Normx : (Fnormal radix b3 x).
Hypotheses zNonZero: ¬((FtoRradix z)=0)%R.
Hypotheses Roundy : (Closest b2 radix (Rdiv x z) y).
Theorem Divnk_error: (Rabs (x/z-y) ≤ (powerRZ radix (Zpred (Fexp y))))%R.
apply Rmult_le_reg_l with (S (S O)); auto with arith real.
apply Rle_trans with (Fulp b2 radix k y).
unfold FtoRradix; apply ClosestUlp;auto with zarith.
unfold Fulp; rewrite FcanonicFnormalizeEq; auto with zarith.
replace (INR (S (S O))) with (powerRZ radix (Zpos xH)); auto with real zarith.
rewrite <- powerRZ_add; auto with real zarith; unfold Zpred.
ring_simplify (1 + (Fexp y + -1))%Z;auto with real.
left;auto.
Qed.
Theorem Normal_le: ∀ (b:Fbound) (u:float) (p:nat),
(Zpos (vNum b)) = (Zpower_nat radix p) → (Fnormal radix b u)->
((Rabs u) ≤ (((powerRZ radix p)-1)*(powerRZ radix (Fexp u))))%R.
intros b u p H1 H2.
unfold FtoRradix; rewrite <- Fabs_correct;auto with zarith.
unfold Fabs, FtoR;apply Rmult_le_compat_r;auto with real zarith;simpl.
elim H2; intros H3 H4;elim H3; intros H5 H6.
apply Rle_trans with (Zpred (Zpos (vNum b)));auto with zarith real float.
rewrite H1; unfold Zpred; simpl; right.
rewrite plus_IZR;simpl;rewrite Zpower_nat_Z_powerRZ;auto with real zarith.
Qed.
Theorem Normal_ge: ∀ (b:Fbound) (u:float) (p:nat),
(Zpos (vNum b)) = (Zpower_nat radix p) → (Fnormal radix b u)->
(Rle (powerRZ radix (Zplus (Zpred p) (Fexp u))) (Rabs u)).
intros b u p H1 H2.
unfold FtoRradix; rewrite <- Fabs_correct;auto with zarith.
rewrite powerRZ_add; auto with real zarith.
unfold Fabs, FtoR;apply Rmult_le_compat_r;auto with real zarith;simpl.
elim H2; intros H3 H4.
apply Rmult_le_reg_l with radix; auto with real zarith.
apply Rle_trans with (Zpos (vNum b)).
replace (IZR radix) with (powerRZ 2%Z 1%Z);[rewrite <- powerRZ_add|simpl];auto with real zarith.
replace (1 + Zpred p)%Z with (Z_of_nat p);[right;rewrite H1; rewrite Zpower_nat_Z_powerRZ;auto |unfold Zpred;ring].
apply Rle_trans with (IZR (Zabs (Zmult radix (Fnum u))));auto with zarith real.
rewrite Zabs_Zmult;rewrite mult_IZR;auto with real zarith.
Qed.
Theorem Divnk_FexpyGe: (Zle (Zminus (Fexp x) (Fexp z)) (Fexp y)).
cut (Rlt R0 (Rminus (powerRZ radix n) R1));[intros V1|idtac].
2: apply Rplus_lt_reg_r with R1.
2: ring_simplify.
2: replace 1%R with (powerRZ radix 0%Z); auto with real zarith.
cut (Rlt R0 (Rminus (powerRZ radix (Zsucc k)) R1));[intros V2|idtac].
2: apply Rplus_lt_reg_r with R1.
2: ring_simplify.
2: replace 1%R with (powerRZ radix 0%Z); auto with real zarith.
apply Zlt_succ_le.
apply Zlt_powerRZ with radix; auto with zarith real.
apply Rle_lt_trans with (Rmult R1 (powerRZ radix (Zminus (Fexp x) (Fexp z))));
[right;ring|idtac].
apply Rlt_le_trans with (Rmult (Rdiv (powerRZ radix (Zsucc (Zplus n k)))
(Rmult (Rminus (powerRZ radix n) R1) (Rminus (powerRZ radix (Zsucc k)) R1)))
(powerRZ radix (Zminus (Fexp x) (Fexp z)))).
apply Rmult_lt_compat_r; auto with real zarith.
apply Rmult_lt_reg_l with
(Rmult (Rminus (powerRZ radix n) R1) (Rminus (powerRZ radix (Zsucc k)) R1)).
apply Rmult_lt_0_compat;auto.
apply Rlt_le_trans with (powerRZ radix (Zsucc (Zplus n k)));[idtac|right;field;auto with real].
apply Rplus_lt_reg_r with
((powerRZ radix n)+(powerRZ radix (Zsucc k))-(powerRZ radix (Zsucc (Zplus n k))))%R.
ring_simplify.
rewrite <- powerRZ_add; auto with real zarith.
replace (n+(Zsucc k))%Z with (Zsucc (Zplus n k));[idtac|unfold Zsucc;ring].
ring_simplify.
apply Rle_lt_trans with (Rplus R0 R1); auto with real zarith.
apply Rle_lt_trans with (Rplus (powerRZ radix n) R1);auto with real zarith.
apply Rplus_lt_compat_l; apply Rplus_lt_reg_r with (Ropp R1);auto with real.
ring_simplify (-1+1)%R;apply Rlt_le_trans with (1:=V2);right;ring.
apply Rle_trans with ((Rabs x)/(((powerRZ radix n)-
1)*((powerRZ radix (Zsucc k))-
1))*(powerRZ radix (Zsucc (Zsucc (Zopp (Fexp z))))))%R.
unfold Rdiv;rewrite Rmult_comm; rewrite Rmult_comm with (r2:=(powerRZ radix (Zsucc (Zsucc (Zopp (Fexp z))))));rewrite <- Rmult_assoc;rewrite <- Rmult_assoc.
apply Rmult_le_compat_r; auto with real.
apply Rlt_le; apply Rinv_0_lt_compat; apply Rmult_lt_0_compat;auto with real.
apply Rle_trans with ((powerRZ radix (Zsucc (Zsucc (Zopp (Fexp z)))))*(powerRZ radix (Zplus (Zpred (Zplus n k)) (Fexp x))))%R.
repeat rewrite <- powerRZ_add;auto with real zarith.
replace (Zplus (Zminus (Fexp x) (Fexp z)) (Zsucc (Zplus n k))) with
(Zplus (Zsucc (Zsucc (Zopp (Fexp z)))) (Zplus (Zpred (Zplus n k)) (Fexp x)));auto with real.
unfold Zsucc, Zpred;ring.
apply Rmult_le_compat_l;auto with real zarith.
rewrite <- inj_plus; apply Normal_ge with b3;auto.
apply Rle_trans with ((Rabs (x/z))/((powerRZ radix (Zsucc k))-1)*(powerRZ radix (Zsucc (Zsucc 0%Z))))%R.
unfold Rdiv; rewrite Rabs_mult.
repeat rewrite Rmult_assoc; apply Rmult_le_compat_l;auto with real.
rewrite Rinv_mult_distr;auto with real.
rewrite Rmult_comm;rewrite <- Rmult_assoc.
rewrite Rmult_comm with (r2:=(powerRZ radix (Zsucc (Zsucc 0%Z))));rewrite <- Rmult_assoc.
apply Rmult_le_compat_r;auto with real.
apply Rmult_le_reg_l with (powerRZ radix (Zpred (Zpred (Fexp z))));auto with real zarith.
rewrite <- Rmult_assoc; rewrite <- powerRZ_add;auto with real zarith.
replace (Zplus (Zpred (Zpred (Fexp z))) (Zsucc (Zsucc (Zopp (Fexp z))))) with 0%Z
;[idtac|unfold Zsucc, Zpred;ring].
rewrite Rmult_comm with (r2:= (powerRZ radix (Zsucc (Zsucc 0%Z)))); rewrite <- Rmult_assoc.
rewrite <- powerRZ_add;auto with real zarith.
replace (Zplus (Zpred (Zpred (Fexp z))) (Zsucc (Zsucc 0%Z))) with (Fexp z)
;[idtac|unfold Zsucc, Zpred;ring].
apply Rmult_le_reg_l with ((powerRZ radix n)-1)%R;auto with real.
apply Rle_trans with R1;[simpl; right; field;auto with real|idtac].
apply Rmult_le_reg_l with (Rabs z);auto with real.
cut (Rle R0 (Rabs z));[intros W; case W|idtac];auto with real.
intros W'; Contradict W'; apply not_eq_sym ;apply Rabs_no_R0;auto.
apply Rle_trans with (Rabs z);[right;ring|idtac].
apply Rle_trans with (((powerRZ radix n)-1)*(powerRZ radix (Fexp z)))%R.
apply Normal_le with b1;auto.
replace (Rabs (/z))%R with (/(Rabs z))%R.
right;field;auto with real.
apply Rabs_no_R0;auto.
apply Rmult_eq_reg_l with (Rabs z);auto with real.
2:apply Rabs_no_R0;auto.
apply trans_eq with R1;[field|rewrite <- Rabs_mult].
apply Rabs_no_R0;auto.
replace (z×/z)%R with 1%R;auto with real.
rewrite Rabs_right;auto with real;apply Rle_ge;auto with real.
apply Rmult_le_reg_l with (((powerRZ radix (Zsucc k))-1)*(powerRZ radix (Zpred (Zpred 0%Z))))%R.
apply Rmult_lt_0_compat;auto with real zarith.
apply Rle_trans with ((Rabs (x/z)))%R.
right;unfold Rdiv.
apply trans_eq with
((((powerRZ radix (Zsucc k))-1)*/((powerRZ radix (Zsucc k))-1))*
((powerRZ radix (Zpred (Zpred 0%Z)))*(powerRZ radix (Zsucc (Zsucc 0%Z))))*
(Rabs (x×/z)))%R;[ring|idtac].
rewrite Rinv_r;auto with real.
rewrite <- powerRZ_add;auto with real zarith.
replace (Zplus (Zpred (Zpred 0%Z)) (Zsucc (Zsucc 0%Z))) with 0%Z;[simpl|unfold Zpred, Zsucc];ring.
apply Rplus_le_reg_l with (Ropp (Rabs y)).
apply Rle_trans with ((Rabs (x/z))-(Rabs y))%R;[right;ring|idtac].
apply Rle_trans with ((Rabs (x/z-y)))%R;[apply Rabs_triang_inv|idtac].
apply Rle_trans with (1:=Divnk_error).
apply Rplus_le_reg_l with ((Rabs y)-(powerRZ radix (Zpred (Fexp y))))%R.
apply Rle_trans with (Rabs y);[right;ring|idtac].
apply Rle_trans with (Rmult (Rminus (powerRZ radix k) R1) (powerRZ radix (Fexp y))).
apply Normal_le with b2;auto.
right;ring_simplify.
repeat rewrite <- powerRZ_add; auto with real zarith.
replace (Zpred (Zpred 0) + Zsucc (Fexp y))%Z with (Zpred (Fexp y));[idtac|unfold Zsucc, Zpred;ring].
replace (Zsucc k + Zpred (Zpred 0) + Zsucc (Fexp y))%Z with
(Zplus k (Fexp y));[idtac|unfold Zsucc, Zpred;ring].
replace (powerRZ radix (Fexp y)) with (Rplus (powerRZ radix (Zpred (Fexp y))) (powerRZ radix (Zpred (Fexp y))));
[idtac|pattern (Fexp y) at 3 in |-*;replace (Fexp y) with (Zplus 1%Z (Zpred (Fexp y)))].
ring.
rewrite powerRZ_add; auto with zarith real;simpl;ring.
unfold Zpred;ring.
Qed.
Theorem Divnk_FexpyLe: (Zle (Fexp y) (Zplus 2%Z (Zminus (Fexp x) (Fexp z)))).
cut (Rlt R0 (Rminus (powerRZ radix k) R1));[intros V1|idtac].
2: apply Rplus_lt_reg_r with R1.
2: ring_simplify.
2: replace R1 with (powerRZ radix 0%Z); auto with real zarith.
apply Zle_n_Zpred;apply Zle_Zpred.
apply Zlt_powerRZ with radix; auto with zarith real.
apply Rmult_lt_reg_l with ((powerRZ radix k)-1)%R;auto with real.
apply Rle_lt_trans with ((powerRZ radix (Zplus (Zpred k) (Fexp y)))-(powerRZ radix (Zpred (Fexp y))))%R.
right;ring_simplify.
rewrite <- powerRZ_add; auto with real zarith.
replace (Zplus (Zpred k) (Fexp y)) with (Zplus k (Zpred (Fexp y)));[idtac|unfold Zpred]; ring.
apply Rle_lt_trans with ((Rabs y)-(powerRZ radix (Zpred (Fexp y))))%R.
unfold Rminus; apply Rplus_le_compat_r.
apply Normal_ge with b2;auto.
apply Rle_lt_trans with (Rabs (Rdiv x z)).
apply Rplus_le_reg_l with ((powerRZ radix (Zpred (Fexp y)))-(Rabs (x/z)))%R.
ring_simplify.
apply Rle_trans with ((Rabs y)-(Rabs (x/z)))%R;[right;ring|idtac].
apply Rle_trans with ((Rabs (y-x/z)))%R;[apply Rabs_triang_inv|idtac].
apply Rle_trans with (2:=Divnk_error).
replace (y-x/z)%R with (-(x/z-y))%R;[rewrite Rabs_Ropp;auto with real|ring].
unfold Rdiv;rewrite Rabs_mult.
apply Rle_lt_trans with ((((powerRZ radix (Zplus n k))-1)*(powerRZ radix (Fexp x)))*
/(((powerRZ radix (Zplus (Zpred n) (Fexp z))))))%R.
apply Rmult_le_compat;auto with real zarith.
rewrite <- inj_plus; apply Normal_le with b3;auto.
apply Rle_trans with (Rinv (Rabs z)).
right;apply Rmult_eq_reg_l with (Rabs z);auto with real.
2:apply Rabs_no_R0;auto.
apply sym_eq;apply trans_eq with R1;[field|rewrite <- Rabs_mult].
apply Rabs_no_R0;auto.
replace (z×/z)%R with R1;auto with real.
rewrite Rabs_right;auto with real;apply Rle_ge;auto with real.
apply Rle_Rinv;auto with real zarith.
apply Normal_ge with b1;auto.
rewrite Rinv_powerRZ;auto with zarith real.
apply Rmult_lt_reg_l with (powerRZ radix (-(Fexp x)+(Fexp z)+n-1)%Z);auto with zarith real.
rewrite Rmult_comm; rewrite Rmult_assoc;rewrite <- powerRZ_add; auto with real zarith.
rewrite Rmult_assoc;rewrite <- powerRZ_add; auto with real zarith.
replace (Zplus (Fexp x)
(Zplus (Zopp (Zplus (Zpred n) (Fexp z)))
(Zminus (Zplus (Zplus (Zopp (Fexp x)) (Fexp z)) n) (Zpos xH)))) with 0%Z;
[idtac|unfold Zsucc, Zpred;ring].
apply Rle_lt_trans with ((powerRZ radix (Zplus n k))-1)%R;[right;simpl;ring|idtac].
rewrite Rmult_comm; rewrite Rmult_assoc.
rewrite <- powerRZ_add; auto with real zarith.
replace (Zplus (Zplus (Zpos (xO xH)) (Zminus (Fexp x) (Fexp z)))
(Zminus (Zplus (Zplus (Zopp (Fexp x)) (Fexp z)) n) (Zpos xH))) with
(Zsucc n); [idtac|unfold Zsucc, Zpred;ring].
apply Rlt_le_trans with (Rminus (powerRZ radix (Zplus n k)) R0);auto with real.
unfold Rminus; apply Rplus_lt_compat_l;auto with real.
apply Rplus_le_reg_l with ((powerRZ radix (Zsucc n))-(powerRZ radix (Zplus n k)))%R.
apply Rle_trans with (powerRZ radix (Zsucc n));[right;ring|idtac].
apply Rle_trans with (powerRZ radix (Zplus n k));auto with real zarith.
right;ring_simplify.
rewrite <- powerRZ_add; auto with real zarith.
replace (Zplus (Zsucc n) k) with (Zplus (Zpos xH) (Zplus n k));
[repeat rewrite powerRZ_add; auto with real zarith|unfold Zsucc;ring].
simpl;ring.
Qed.
Theorem Divnk_FexpyLe2: (Rle (powerRZ radix (Zplus (Zpred k) (Fexp y))) (Rabs (Rdiv x z)))
→ (Zle (Fexp y) (Zplus 1%Z (Zminus (Fexp x) (Fexp z)))).
intros H.
apply Zle_n_Zpred;apply Zle_Zpred.
apply Zplus_lt_reg_l with k.
apply Zlt_powerRZ with radix; auto with zarith real.
replace (Zplus k (Zpred (Fexp y))) with (Zplus (Zpred k) (Fexp y));[idtac|unfold Zpred;ring].
apply Rle_lt_trans with (1:=H).
unfold Rdiv;rewrite Rabs_mult.
apply Rle_lt_trans with ((Rabs x)*(powerRZ radix (Zopp (Zplus (Zpred n) (Fexp z)))))%R.
apply Rmult_le_compat_l;auto with real.
apply Rle_trans with (Rinv (Rabs z)).
right;apply Rmult_eq_reg_l with (Rabs z);auto with real.
2:apply Rabs_no_R0;auto.
apply sym_eq;apply trans_eq with R1;[field|rewrite <- Rabs_mult].
apply Rabs_no_R0;auto.
replace (z×/z)%R with R1;auto with real.
rewrite Rabs_right;auto with real;apply Rle_ge;auto with real.
rewrite <- Rinv_powerRZ;auto with real zarith.
apply Rle_Rinv;auto with real zarith.
apply Normal_ge with b1;auto.
apply Rlt_le_trans with ((powerRZ radix (Zplus (Zplus n k) (Fexp x)))*(powerRZ radix (Zopp (Zplus (Zpred n) (Fexp z)))))%R.
apply Rmult_lt_compat_r; auto with real zarith.
apply Rle_lt_trans with (Rmult (Rminus (powerRZ radix (plus n k)) R1) (powerRZ radix (Fexp x))).
apply Normal_le with b3;auto.
rewrite powerRZ_add; auto with real zarith.
apply Rmult_lt_compat_r; auto with real zarith.
apply Rlt_le_trans with ((powerRZ radix (plus n k))-0)%R.
unfold Rminus; apply Rplus_lt_compat_l; auto with real.
rewrite inj_plus; auto with real.
right; rewrite <- powerRZ_add; auto with real zarith.
replace (Zplus (Zplus (Zplus n k) (Fexp x))
(Zopp (Zplus (Zpred n) (Fexp z)))) with (Zplus k (Zplus (Zpos xH) (Zminus (Fexp x) (Fexp z))));
[auto with real|unfold Zpred; ring].
Qed.
Theorem Rle_err_pow2: ∀ (b:Fbound) (p:nat) (r:R) (f:float),
(lt (S O) p) → (Zpos (vNum b)) = (Zpower_nat radix p) →
(Fnormal radix b f) → ~((Fexp f) = (Zopp (dExp b))) →
((FtoRradix f)=(powerRZ radix (Zplus (Zpred p) (Fexp f))))%R → (Rlt r f) →
(Closest b radix r f) → (Rle (Rabs (Rminus f r)) (powerRZ radix (Zpred (Zpred (Fexp f))))).
intros.
case (Rle_or_lt (Rabs (Rminus f r)) (powerRZ radix (Zpred (Zpred (Fexp f))))); intros;auto.
absurd (Rlt (Rabs (Rminus (FPred b radix p f) r)) (Rabs (Rminus f r))).
apply Rle_not_lt.
elim H5; intros;unfold FtoRradix;apply H8.
apply FBoundedPred;auto with zarith.
apply Rle_lt_trans with (2:=H6).
rewrite Rabs_left1.
apply Rle_trans with ((r-f)+-((FPred b radix p f)-f))%R;[right;ring|idtac].
apply Rle_trans with (-(powerRZ radix (Zpred (Zpred (Fexp f))))+(powerRZ radix (Zpred (Fexp f))))%R.
apply Rplus_le_compat.
apply Rle_trans with (-(f-r))%R;auto with real.
apply Ropp_le_contravar.
rewrite <- Rabs_right;auto with real.
apply Rle_ge;auto with real.
apply Rle_trans with (f-(FPred b radix p f))%R;[right;ring|idtac].
unfold FtoRradix; rewrite <- Fminus_correct;auto with zarith.
cut (f=(Float (nNormMin radix p) (Fexp f)));[intros|idtac].
rewrite FPredDiff3;auto with zarith.
right; unfold FtoR; simpl;ring.
rewrite H7;simpl;auto with zarith.
apply FnormalUnique with radix b p; auto with zarith.
cut (0 < (nNormMin radix p))%Z;[intros|apply nNormPos;auto with zarith].
repeat split; auto with zarith float.
simpl;rewrite Zabs_eq;[apply ZltNormMinVnum|idtac];auto with zarith float.
simpl; elim H5;auto with zarith float.
rewrite Zabs_eq;auto with zarith float.
rewrite PosNormMin with radix b p;simpl;auto with zarith.
fold FtoRradix; rewrite H3; unfold FtoRradix, FtoR, nNormMin;simpl.
rewrite Zpower_nat_Z_powerRZ; rewrite inj_pred;auto with zarith.
rewrite powerRZ_add; auto with real zarith.
right; pattern (Zpred (Fexp f)) at 2; replace (Zpred (Fexp f)) with (Zplus (Zpos xH) (Zpred (Zpred (Fexp f))));[idtac|unfold Zpred;ring].
rewrite powerRZ_add;auto with zarith real.
simpl;ring.
apply Rplus_le_reg_l with r.
apply Rle_trans with ((FPred b radix p f))%R;[right;ring|idtac].
apply Rle_trans with r;[idtac|right;ring].
case (ClosestMinOrMax b radix r f);auto;intros.
apply Rle_trans with (FtoRradix f);[apply Rlt_le; unfold FtoRradix; apply FPredLt;auto with zarith|idtac].
unfold FtoRradix;elim H7; intros; elim H9; auto with real.
case (Rle_or_lt r (FPred b radix p f));auto with real;intros.
absurd (Rlt (FPred b radix p f) f).
apply Rle_not_lt.
elim H7; intros; elim H10; intros.
unfold FtoRradix; apply H12; auto.
apply FBoundedPred;auto with float zarith.
unfold FtoRradix; apply FPredLt;auto with zarith.
Qed.
Theorem Divnk: ((Fexp y) ≠ (-(dExp b2)))%Z →
(Rlt (Zabs (Fnum (Fminus radix x (Fmult y z)))) (powerRZ radix n)).
intros G.
cut ((Fexp (Fminus radix x (Fmult y z)))=(Fexp x)); [intros H1|idtac].
2:unfold Fminus, Fplus, Fopp, Fmult; simpl.
2:apply Zmin_le1; generalize Divnk_FexpyGe;auto with zarith.
apply Rmult_lt_reg_l with (powerRZ radix (Fexp x));auto with zarith real.
apply Rle_lt_trans with (Rabs (Rminus x (Rmult y z))).
right; unfold FtoRradix; rewrite <- Fmult_correct;auto with zarith.
rewrite <- Fminus_correct;auto with zarith;rewrite <- Fabs_correct;auto with zarith.
unfold FtoR, Fabs; rewrite H1;simpl;ring.
replace (x-y×z)%R with (z*(x/z-y))%R;[idtac|field;auto with real].
rewrite Rabs_mult.
case (Rle_or_lt (powerRZ radix (Zplus (Zpred k) (Fexp y))) (Rabs (Rdiv x z))); intros H.
apply Rle_lt_trans with ((Rabs z)*(powerRZ radix (Zpred (Fexp y))))%R.
apply Rmult_le_compat_l;auto with real;apply Divnk_error.
apply Rlt_le_trans with (((powerRZ radix n)*(powerRZ radix (Fexp z)))*(powerRZ radix (Zpred (Fexp y))))%R.
apply Rmult_lt_compat_r;auto with real zarith.
unfold FtoRradix; rewrite <- Fabs_correct;auto with zarith; unfold Fabs, FtoRradix, FtoR.
simpl; apply Rmult_lt_compat_r;auto with real zarith.
apply Rlt_le_trans with (Zpos (vNum b1));auto with real zarith.
elim Normz; intros V1 V2;elim V1; intros V3 V4;auto with zarith real.
rewrite nGivesBound1;right;rewrite Zpower_nat_Z_powerRZ;auto with real zarith.
repeat rewrite <- powerRZ_add; auto with real zarith.
apply Rle_powerRZ;auto with zarith real.
generalize (Divnk_FexpyLe2 H); unfold Zsucc, Zpred; auto with zarith.
rewrite <- powerRZ_add; auto with real zarith.
cut (Rle R0 ((Rabs (x/z-y)))%R);auto with real; intros H2;case H2.
2: intros W; rewrite <- W; ring_simplify ((Rabs z)*0)%R;auto with real zarith.
clear H2; intros H2.
apply Rlt_le_trans with ((powerRZ radix (Zplus n (Fexp z)))*(Rabs (x/z-y)))%R.
apply Rmult_lt_compat_r; auto with real.
apply Rle_lt_trans with (Rmult (Rminus (powerRZ radix n) R1) (powerRZ radix (Fexp z))).
apply Normal_le with b1;auto.
rewrite powerRZ_add; auto with real zarith.
apply Rmult_lt_compat_r; auto with real zarith.
apply Rlt_le_trans with ((powerRZ radix n)-0)%R;[idtac|right;ring].
unfold Rminus; apply Rplus_lt_compat_l; auto with real.
apply Rmult_le_reg_l with (powerRZ radix (Zopp (Zplus n (Fexp z))));auto with real zarith.
rewrite <- Rmult_assoc; repeat rewrite <- powerRZ_add; auto with real zarith.
ring_simplify (Zplus (Zopp (Zplus n (Fexp z))) (Zplus n (Fexp z)));
ring_simplify (Zplus (Zopp (Zplus n (Fexp z))) (Zplus (Fexp x) n)).
apply Rle_trans with ((Rabs (x/z-y)))%R;[right;simpl;ring|idtac].
apply Rle_trans with (powerRZ radix (Zplus (-2)%Z (Fexp y))).
2: apply Rle_powerRZ;auto with real zarith.
2:generalize Divnk_FexpyLe;auto with zarith.
replace (Zplus (-2)%Z (Fexp y)) with (Zpred (Zpred (Fexp y)));[idtac|unfold Zpred;ring].
rewrite <- Rabs_Ropp.
replace (-(x/z-y))%R with (y-x/z)%R;[idtac|ring].
apply Rle_trans with ((Rabs ((Fabs y)-(Rabs (x/z)))))%R.
unfold FtoRradix; rewrite Fabs_correct;auto with zarith; fold FtoRradix.
case (Rle_or_lt R0 (x/z)%R);intros.
rewrite (Rabs_right (x/z)%R);auto with real.
rewrite (Rabs_right (y)%R);auto with real.
apply Rle_ge; unfold FtoRradix; apply RleRoundedR0 with b2 k (Closest b2 radix) (x/z)%R;auto with zarith float.
apply ClosestRoundedModeP with k;auto with zarith.
right;rewrite (Rabs_left (x/z)%R);auto with real.
rewrite (Rabs_left1 (y)%R);auto with real.
replace (-y- -(x/z))%R with (-(y-x/z))%R;[idtac|ring].
rewrite Rabs_Ropp;auto with real.
unfold FtoRradix; apply RleRoundedLessR0 with b2 k (Closest b2 radix) (x/z)%R;auto with zarith float real.
apply ClosestRoundedModeP with k;auto with zarith.
cut ((Fexp y) = (Fexp (Fabs y)));[intros V2|unfold Fabs;simpl; auto with zarith].
cut ((FtoRradix (Fabs y))=(powerRZ radix (Zplus (Zpred k) (Fexp y))));[intros V1|idtac].
replace (Fexp y) with (Fexp (Fabs y));auto.
apply Rle_err_pow2 with b2 k;auto with zarith float.
apply FnormalFabs;auto with zarith.
rewrite V1;auto with real.
apply ClosestFabs with k;auto with zarith.
apply Rle_antisym.
2: unfold FtoRradix; rewrite Fabs_correct; auto with zarith; fold FtoRradix.
2: apply Normal_ge with b2;auto.
cut ((powerRZ radix (Zplus (Zpred k) (Fexp y)))=(Float (nNormMin radix k) (Fexp y)));[intros|idtac].
rewrite H0;unfold FtoRradix.
generalize (ClosestMonotone b2 radix); unfold MonotoneP;intros T.
apply T with (Rabs (x/z)%R) (powerRZ radix (Zplus (Zpred k) (Fexp y)));auto.
apply ClosestFabs with k;auto with zarith.
rewrite H0; unfold FtoRradix; apply RoundedModeProjectorIdem with b2.
apply ClosestRoundedModeP with k;auto with zarith.
cut (0 < (nNormMin radix k))%Z;[intros|apply nNormPos;auto with zarith].
repeat split; auto with zarith float.
simpl;rewrite Zabs_eq;[apply ZltNormMinVnum|idtac];auto with zarith float.
simpl; elim Normy;auto with zarith float.
unfold FtoRradix, FtoR, nNormMin;simpl.
rewrite Zpower_nat_Z_powerRZ; rewrite inj_pred;auto with zarith.
rewrite powerRZ_add; auto with zarith real.
Qed.
End Divnk.
Section Divnk.
Variables b1 b2 b3 : Fbound.
Variables n k : nat.
Variables x y z: float.
Let radix := 2%Z.
Let FtoRradix := FtoR radix.
Coercion FtoRradix : float >-> R.
Hypotheses nGreaterThanOne : (lt (S O) n).
Hypotheses kGreaterThanOne : (lt (S O) k).
Hypotheses nGivesBound1 : (Zpos (vNum b1)) = (Zpower_nat radix n).
Hypotheses kGivesBound2 : (Zpos (vNum b2)) = (Zpower_nat radix k).
Hypotheses nkGivesBound3 : (Zpos (vNum b3)) = (Zpower_nat radix (plus n k)).
Hypotheses Normz : (Fnormal radix b1 z).
Hypotheses Normy : (Fnormal radix b2 y).
Hypotheses Normx : (Fnormal radix b3 x).
Hypotheses zNonZero: ¬((FtoRradix z)=0)%R.
Hypotheses Roundy : (Closest b2 radix (Rdiv x z) y).
Theorem Divnk_error: (Rabs (x/z-y) ≤ (powerRZ radix (Zpred (Fexp y))))%R.
apply Rmult_le_reg_l with (S (S O)); auto with arith real.
apply Rle_trans with (Fulp b2 radix k y).
unfold FtoRradix; apply ClosestUlp;auto with zarith.
unfold Fulp; rewrite FcanonicFnormalizeEq; auto with zarith.
replace (INR (S (S O))) with (powerRZ radix (Zpos xH)); auto with real zarith.
rewrite <- powerRZ_add; auto with real zarith; unfold Zpred.
ring_simplify (1 + (Fexp y + -1))%Z;auto with real.
left;auto.
Qed.
Theorem Normal_le: ∀ (b:Fbound) (u:float) (p:nat),
(Zpos (vNum b)) = (Zpower_nat radix p) → (Fnormal radix b u)->
((Rabs u) ≤ (((powerRZ radix p)-1)*(powerRZ radix (Fexp u))))%R.
intros b u p H1 H2.
unfold FtoRradix; rewrite <- Fabs_correct;auto with zarith.
unfold Fabs, FtoR;apply Rmult_le_compat_r;auto with real zarith;simpl.
elim H2; intros H3 H4;elim H3; intros H5 H6.
apply Rle_trans with (Zpred (Zpos (vNum b)));auto with zarith real float.
rewrite H1; unfold Zpred; simpl; right.
rewrite plus_IZR;simpl;rewrite Zpower_nat_Z_powerRZ;auto with real zarith.
Qed.
Theorem Normal_ge: ∀ (b:Fbound) (u:float) (p:nat),
(Zpos (vNum b)) = (Zpower_nat radix p) → (Fnormal radix b u)->
(Rle (powerRZ radix (Zplus (Zpred p) (Fexp u))) (Rabs u)).
intros b u p H1 H2.
unfold FtoRradix; rewrite <- Fabs_correct;auto with zarith.
rewrite powerRZ_add; auto with real zarith.
unfold Fabs, FtoR;apply Rmult_le_compat_r;auto with real zarith;simpl.
elim H2; intros H3 H4.
apply Rmult_le_reg_l with radix; auto with real zarith.
apply Rle_trans with (Zpos (vNum b)).
replace (IZR radix) with (powerRZ 2%Z 1%Z);[rewrite <- powerRZ_add|simpl];auto with real zarith.
replace (1 + Zpred p)%Z with (Z_of_nat p);[right;rewrite H1; rewrite Zpower_nat_Z_powerRZ;auto |unfold Zpred;ring].
apply Rle_trans with (IZR (Zabs (Zmult radix (Fnum u))));auto with zarith real.
rewrite Zabs_Zmult;rewrite mult_IZR;auto with real zarith.
Qed.
Theorem Divnk_FexpyGe: (Zle (Zminus (Fexp x) (Fexp z)) (Fexp y)).
cut (Rlt R0 (Rminus (powerRZ radix n) R1));[intros V1|idtac].
2: apply Rplus_lt_reg_r with R1.
2: ring_simplify.
2: replace 1%R with (powerRZ radix 0%Z); auto with real zarith.
cut (Rlt R0 (Rminus (powerRZ radix (Zsucc k)) R1));[intros V2|idtac].
2: apply Rplus_lt_reg_r with R1.
2: ring_simplify.
2: replace 1%R with (powerRZ radix 0%Z); auto with real zarith.
apply Zlt_succ_le.
apply Zlt_powerRZ with radix; auto with zarith real.
apply Rle_lt_trans with (Rmult R1 (powerRZ radix (Zminus (Fexp x) (Fexp z))));
[right;ring|idtac].
apply Rlt_le_trans with (Rmult (Rdiv (powerRZ radix (Zsucc (Zplus n k)))
(Rmult (Rminus (powerRZ radix n) R1) (Rminus (powerRZ radix (Zsucc k)) R1)))
(powerRZ radix (Zminus (Fexp x) (Fexp z)))).
apply Rmult_lt_compat_r; auto with real zarith.
apply Rmult_lt_reg_l with
(Rmult (Rminus (powerRZ radix n) R1) (Rminus (powerRZ radix (Zsucc k)) R1)).
apply Rmult_lt_0_compat;auto.
apply Rlt_le_trans with (powerRZ radix (Zsucc (Zplus n k)));[idtac|right;field;auto with real].
apply Rplus_lt_reg_r with
((powerRZ radix n)+(powerRZ radix (Zsucc k))-(powerRZ radix (Zsucc (Zplus n k))))%R.
ring_simplify.
rewrite <- powerRZ_add; auto with real zarith.
replace (n+(Zsucc k))%Z with (Zsucc (Zplus n k));[idtac|unfold Zsucc;ring].
ring_simplify.
apply Rle_lt_trans with (Rplus R0 R1); auto with real zarith.
apply Rle_lt_trans with (Rplus (powerRZ radix n) R1);auto with real zarith.
apply Rplus_lt_compat_l; apply Rplus_lt_reg_r with (Ropp R1);auto with real.
ring_simplify (-1+1)%R;apply Rlt_le_trans with (1:=V2);right;ring.
apply Rle_trans with ((Rabs x)/(((powerRZ radix n)-
1)*((powerRZ radix (Zsucc k))-
1))*(powerRZ radix (Zsucc (Zsucc (Zopp (Fexp z))))))%R.
unfold Rdiv;rewrite Rmult_comm; rewrite Rmult_comm with (r2:=(powerRZ radix (Zsucc (Zsucc (Zopp (Fexp z))))));rewrite <- Rmult_assoc;rewrite <- Rmult_assoc.
apply Rmult_le_compat_r; auto with real.
apply Rlt_le; apply Rinv_0_lt_compat; apply Rmult_lt_0_compat;auto with real.
apply Rle_trans with ((powerRZ radix (Zsucc (Zsucc (Zopp (Fexp z)))))*(powerRZ radix (Zplus (Zpred (Zplus n k)) (Fexp x))))%R.
repeat rewrite <- powerRZ_add;auto with real zarith.
replace (Zplus (Zminus (Fexp x) (Fexp z)) (Zsucc (Zplus n k))) with
(Zplus (Zsucc (Zsucc (Zopp (Fexp z)))) (Zplus (Zpred (Zplus n k)) (Fexp x)));auto with real.
unfold Zsucc, Zpred;ring.
apply Rmult_le_compat_l;auto with real zarith.
rewrite <- inj_plus; apply Normal_ge with b3;auto.
apply Rle_trans with ((Rabs (x/z))/((powerRZ radix (Zsucc k))-1)*(powerRZ radix (Zsucc (Zsucc 0%Z))))%R.
unfold Rdiv; rewrite Rabs_mult.
repeat rewrite Rmult_assoc; apply Rmult_le_compat_l;auto with real.
rewrite Rinv_mult_distr;auto with real.
rewrite Rmult_comm;rewrite <- Rmult_assoc.
rewrite Rmult_comm with (r2:=(powerRZ radix (Zsucc (Zsucc 0%Z))));rewrite <- Rmult_assoc.
apply Rmult_le_compat_r;auto with real.
apply Rmult_le_reg_l with (powerRZ radix (Zpred (Zpred (Fexp z))));auto with real zarith.
rewrite <- Rmult_assoc; rewrite <- powerRZ_add;auto with real zarith.
replace (Zplus (Zpred (Zpred (Fexp z))) (Zsucc (Zsucc (Zopp (Fexp z))))) with 0%Z
;[idtac|unfold Zsucc, Zpred;ring].
rewrite Rmult_comm with (r2:= (powerRZ radix (Zsucc (Zsucc 0%Z)))); rewrite <- Rmult_assoc.
rewrite <- powerRZ_add;auto with real zarith.
replace (Zplus (Zpred (Zpred (Fexp z))) (Zsucc (Zsucc 0%Z))) with (Fexp z)
;[idtac|unfold Zsucc, Zpred;ring].
apply Rmult_le_reg_l with ((powerRZ radix n)-1)%R;auto with real.
apply Rle_trans with R1;[simpl; right; field;auto with real|idtac].
apply Rmult_le_reg_l with (Rabs z);auto with real.
cut (Rle R0 (Rabs z));[intros W; case W|idtac];auto with real.
intros W'; Contradict W'; apply not_eq_sym ;apply Rabs_no_R0;auto.
apply Rle_trans with (Rabs z);[right;ring|idtac].
apply Rle_trans with (((powerRZ radix n)-1)*(powerRZ radix (Fexp z)))%R.
apply Normal_le with b1;auto.
replace (Rabs (/z))%R with (/(Rabs z))%R.
right;field;auto with real.
apply Rabs_no_R0;auto.
apply Rmult_eq_reg_l with (Rabs z);auto with real.
2:apply Rabs_no_R0;auto.
apply trans_eq with R1;[field|rewrite <- Rabs_mult].
apply Rabs_no_R0;auto.
replace (z×/z)%R with 1%R;auto with real.
rewrite Rabs_right;auto with real;apply Rle_ge;auto with real.
apply Rmult_le_reg_l with (((powerRZ radix (Zsucc k))-1)*(powerRZ radix (Zpred (Zpred 0%Z))))%R.
apply Rmult_lt_0_compat;auto with real zarith.
apply Rle_trans with ((Rabs (x/z)))%R.
right;unfold Rdiv.
apply trans_eq with
((((powerRZ radix (Zsucc k))-1)*/((powerRZ radix (Zsucc k))-1))*
((powerRZ radix (Zpred (Zpred 0%Z)))*(powerRZ radix (Zsucc (Zsucc 0%Z))))*
(Rabs (x×/z)))%R;[ring|idtac].
rewrite Rinv_r;auto with real.
rewrite <- powerRZ_add;auto with real zarith.
replace (Zplus (Zpred (Zpred 0%Z)) (Zsucc (Zsucc 0%Z))) with 0%Z;[simpl|unfold Zpred, Zsucc];ring.
apply Rplus_le_reg_l with (Ropp (Rabs y)).
apply Rle_trans with ((Rabs (x/z))-(Rabs y))%R;[right;ring|idtac].
apply Rle_trans with ((Rabs (x/z-y)))%R;[apply Rabs_triang_inv|idtac].
apply Rle_trans with (1:=Divnk_error).
apply Rplus_le_reg_l with ((Rabs y)-(powerRZ radix (Zpred (Fexp y))))%R.
apply Rle_trans with (Rabs y);[right;ring|idtac].
apply Rle_trans with (Rmult (Rminus (powerRZ radix k) R1) (powerRZ radix (Fexp y))).
apply Normal_le with b2;auto.
right;ring_simplify.
repeat rewrite <- powerRZ_add; auto with real zarith.
replace (Zpred (Zpred 0) + Zsucc (Fexp y))%Z with (Zpred (Fexp y));[idtac|unfold Zsucc, Zpred;ring].
replace (Zsucc k + Zpred (Zpred 0) + Zsucc (Fexp y))%Z with
(Zplus k (Fexp y));[idtac|unfold Zsucc, Zpred;ring].
replace (powerRZ radix (Fexp y)) with (Rplus (powerRZ radix (Zpred (Fexp y))) (powerRZ radix (Zpred (Fexp y))));
[idtac|pattern (Fexp y) at 3 in |-*;replace (Fexp y) with (Zplus 1%Z (Zpred (Fexp y)))].
ring.
rewrite powerRZ_add; auto with zarith real;simpl;ring.
unfold Zpred;ring.
Qed.
Theorem Divnk_FexpyLe: (Zle (Fexp y) (Zplus 2%Z (Zminus (Fexp x) (Fexp z)))).
cut (Rlt R0 (Rminus (powerRZ radix k) R1));[intros V1|idtac].
2: apply Rplus_lt_reg_r with R1.
2: ring_simplify.
2: replace R1 with (powerRZ radix 0%Z); auto with real zarith.
apply Zle_n_Zpred;apply Zle_Zpred.
apply Zlt_powerRZ with radix; auto with zarith real.
apply Rmult_lt_reg_l with ((powerRZ radix k)-1)%R;auto with real.
apply Rle_lt_trans with ((powerRZ radix (Zplus (Zpred k) (Fexp y)))-(powerRZ radix (Zpred (Fexp y))))%R.
right;ring_simplify.
rewrite <- powerRZ_add; auto with real zarith.
replace (Zplus (Zpred k) (Fexp y)) with (Zplus k (Zpred (Fexp y)));[idtac|unfold Zpred]; ring.
apply Rle_lt_trans with ((Rabs y)-(powerRZ radix (Zpred (Fexp y))))%R.
unfold Rminus; apply Rplus_le_compat_r.
apply Normal_ge with b2;auto.
apply Rle_lt_trans with (Rabs (Rdiv x z)).
apply Rplus_le_reg_l with ((powerRZ radix (Zpred (Fexp y)))-(Rabs (x/z)))%R.
ring_simplify.
apply Rle_trans with ((Rabs y)-(Rabs (x/z)))%R;[right;ring|idtac].
apply Rle_trans with ((Rabs (y-x/z)))%R;[apply Rabs_triang_inv|idtac].
apply Rle_trans with (2:=Divnk_error).
replace (y-x/z)%R with (-(x/z-y))%R;[rewrite Rabs_Ropp;auto with real|ring].
unfold Rdiv;rewrite Rabs_mult.
apply Rle_lt_trans with ((((powerRZ radix (Zplus n k))-1)*(powerRZ radix (Fexp x)))*
/(((powerRZ radix (Zplus (Zpred n) (Fexp z))))))%R.
apply Rmult_le_compat;auto with real zarith.
rewrite <- inj_plus; apply Normal_le with b3;auto.
apply Rle_trans with (Rinv (Rabs z)).
right;apply Rmult_eq_reg_l with (Rabs z);auto with real.
2:apply Rabs_no_R0;auto.
apply sym_eq;apply trans_eq with R1;[field|rewrite <- Rabs_mult].
apply Rabs_no_R0;auto.
replace (z×/z)%R with R1;auto with real.
rewrite Rabs_right;auto with real;apply Rle_ge;auto with real.
apply Rle_Rinv;auto with real zarith.
apply Normal_ge with b1;auto.
rewrite Rinv_powerRZ;auto with zarith real.
apply Rmult_lt_reg_l with (powerRZ radix (-(Fexp x)+(Fexp z)+n-1)%Z);auto with zarith real.
rewrite Rmult_comm; rewrite Rmult_assoc;rewrite <- powerRZ_add; auto with real zarith.
rewrite Rmult_assoc;rewrite <- powerRZ_add; auto with real zarith.
replace (Zplus (Fexp x)
(Zplus (Zopp (Zplus (Zpred n) (Fexp z)))
(Zminus (Zplus (Zplus (Zopp (Fexp x)) (Fexp z)) n) (Zpos xH)))) with 0%Z;
[idtac|unfold Zsucc, Zpred;ring].
apply Rle_lt_trans with ((powerRZ radix (Zplus n k))-1)%R;[right;simpl;ring|idtac].
rewrite Rmult_comm; rewrite Rmult_assoc.
rewrite <- powerRZ_add; auto with real zarith.
replace (Zplus (Zplus (Zpos (xO xH)) (Zminus (Fexp x) (Fexp z)))
(Zminus (Zplus (Zplus (Zopp (Fexp x)) (Fexp z)) n) (Zpos xH))) with
(Zsucc n); [idtac|unfold Zsucc, Zpred;ring].
apply Rlt_le_trans with (Rminus (powerRZ radix (Zplus n k)) R0);auto with real.
unfold Rminus; apply Rplus_lt_compat_l;auto with real.
apply Rplus_le_reg_l with ((powerRZ radix (Zsucc n))-(powerRZ radix (Zplus n k)))%R.
apply Rle_trans with (powerRZ radix (Zsucc n));[right;ring|idtac].
apply Rle_trans with (powerRZ radix (Zplus n k));auto with real zarith.
right;ring_simplify.
rewrite <- powerRZ_add; auto with real zarith.
replace (Zplus (Zsucc n) k) with (Zplus (Zpos xH) (Zplus n k));
[repeat rewrite powerRZ_add; auto with real zarith|unfold Zsucc;ring].
simpl;ring.
Qed.
Theorem Divnk_FexpyLe2: (Rle (powerRZ radix (Zplus (Zpred k) (Fexp y))) (Rabs (Rdiv x z)))
→ (Zle (Fexp y) (Zplus 1%Z (Zminus (Fexp x) (Fexp z)))).
intros H.
apply Zle_n_Zpred;apply Zle_Zpred.
apply Zplus_lt_reg_l with k.
apply Zlt_powerRZ with radix; auto with zarith real.
replace (Zplus k (Zpred (Fexp y))) with (Zplus (Zpred k) (Fexp y));[idtac|unfold Zpred;ring].
apply Rle_lt_trans with (1:=H).
unfold Rdiv;rewrite Rabs_mult.
apply Rle_lt_trans with ((Rabs x)*(powerRZ radix (Zopp (Zplus (Zpred n) (Fexp z)))))%R.
apply Rmult_le_compat_l;auto with real.
apply Rle_trans with (Rinv (Rabs z)).
right;apply Rmult_eq_reg_l with (Rabs z);auto with real.
2:apply Rabs_no_R0;auto.
apply sym_eq;apply trans_eq with R1;[field|rewrite <- Rabs_mult].
apply Rabs_no_R0;auto.
replace (z×/z)%R with R1;auto with real.
rewrite Rabs_right;auto with real;apply Rle_ge;auto with real.
rewrite <- Rinv_powerRZ;auto with real zarith.
apply Rle_Rinv;auto with real zarith.
apply Normal_ge with b1;auto.
apply Rlt_le_trans with ((powerRZ radix (Zplus (Zplus n k) (Fexp x)))*(powerRZ radix (Zopp (Zplus (Zpred n) (Fexp z)))))%R.
apply Rmult_lt_compat_r; auto with real zarith.
apply Rle_lt_trans with (Rmult (Rminus (powerRZ radix (plus n k)) R1) (powerRZ radix (Fexp x))).
apply Normal_le with b3;auto.
rewrite powerRZ_add; auto with real zarith.
apply Rmult_lt_compat_r; auto with real zarith.
apply Rlt_le_trans with ((powerRZ radix (plus n k))-0)%R.
unfold Rminus; apply Rplus_lt_compat_l; auto with real.
rewrite inj_plus; auto with real.
right; rewrite <- powerRZ_add; auto with real zarith.
replace (Zplus (Zplus (Zplus n k) (Fexp x))
(Zopp (Zplus (Zpred n) (Fexp z)))) with (Zplus k (Zplus (Zpos xH) (Zminus (Fexp x) (Fexp z))));
[auto with real|unfold Zpred; ring].
Qed.
Theorem Rle_err_pow2: ∀ (b:Fbound) (p:nat) (r:R) (f:float),
(lt (S O) p) → (Zpos (vNum b)) = (Zpower_nat radix p) →
(Fnormal radix b f) → ~((Fexp f) = (Zopp (dExp b))) →
((FtoRradix f)=(powerRZ radix (Zplus (Zpred p) (Fexp f))))%R → (Rlt r f) →
(Closest b radix r f) → (Rle (Rabs (Rminus f r)) (powerRZ radix (Zpred (Zpred (Fexp f))))).
intros.
case (Rle_or_lt (Rabs (Rminus f r)) (powerRZ radix (Zpred (Zpred (Fexp f))))); intros;auto.
absurd (Rlt (Rabs (Rminus (FPred b radix p f) r)) (Rabs (Rminus f r))).
apply Rle_not_lt.
elim H5; intros;unfold FtoRradix;apply H8.
apply FBoundedPred;auto with zarith.
apply Rle_lt_trans with (2:=H6).
rewrite Rabs_left1.
apply Rle_trans with ((r-f)+-((FPred b radix p f)-f))%R;[right;ring|idtac].
apply Rle_trans with (-(powerRZ radix (Zpred (Zpred (Fexp f))))+(powerRZ radix (Zpred (Fexp f))))%R.
apply Rplus_le_compat.
apply Rle_trans with (-(f-r))%R;auto with real.
apply Ropp_le_contravar.
rewrite <- Rabs_right;auto with real.
apply Rle_ge;auto with real.
apply Rle_trans with (f-(FPred b radix p f))%R;[right;ring|idtac].
unfold FtoRradix; rewrite <- Fminus_correct;auto with zarith.
cut (f=(Float (nNormMin radix p) (Fexp f)));[intros|idtac].
rewrite FPredDiff3;auto with zarith.
right; unfold FtoR; simpl;ring.
rewrite H7;simpl;auto with zarith.
apply FnormalUnique with radix b p; auto with zarith.
cut (0 < (nNormMin radix p))%Z;[intros|apply nNormPos;auto with zarith].
repeat split; auto with zarith float.
simpl;rewrite Zabs_eq;[apply ZltNormMinVnum|idtac];auto with zarith float.
simpl; elim H5;auto with zarith float.
rewrite Zabs_eq;auto with zarith float.
rewrite PosNormMin with radix b p;simpl;auto with zarith.
fold FtoRradix; rewrite H3; unfold FtoRradix, FtoR, nNormMin;simpl.
rewrite Zpower_nat_Z_powerRZ; rewrite inj_pred;auto with zarith.
rewrite powerRZ_add; auto with real zarith.
right; pattern (Zpred (Fexp f)) at 2; replace (Zpred (Fexp f)) with (Zplus (Zpos xH) (Zpred (Zpred (Fexp f))));[idtac|unfold Zpred;ring].
rewrite powerRZ_add;auto with zarith real.
simpl;ring.
apply Rplus_le_reg_l with r.
apply Rle_trans with ((FPred b radix p f))%R;[right;ring|idtac].
apply Rle_trans with r;[idtac|right;ring].
case (ClosestMinOrMax b radix r f);auto;intros.
apply Rle_trans with (FtoRradix f);[apply Rlt_le; unfold FtoRradix; apply FPredLt;auto with zarith|idtac].
unfold FtoRradix;elim H7; intros; elim H9; auto with real.
case (Rle_or_lt r (FPred b radix p f));auto with real;intros.
absurd (Rlt (FPred b radix p f) f).
apply Rle_not_lt.
elim H7; intros; elim H10; intros.
unfold FtoRradix; apply H12; auto.
apply FBoundedPred;auto with float zarith.
unfold FtoRradix; apply FPredLt;auto with zarith.
Qed.
Theorem Divnk: ((Fexp y) ≠ (-(dExp b2)))%Z →
(Rlt (Zabs (Fnum (Fminus radix x (Fmult y z)))) (powerRZ radix n)).
intros G.
cut ((Fexp (Fminus radix x (Fmult y z)))=(Fexp x)); [intros H1|idtac].
2:unfold Fminus, Fplus, Fopp, Fmult; simpl.
2:apply Zmin_le1; generalize Divnk_FexpyGe;auto with zarith.
apply Rmult_lt_reg_l with (powerRZ radix (Fexp x));auto with zarith real.
apply Rle_lt_trans with (Rabs (Rminus x (Rmult y z))).
right; unfold FtoRradix; rewrite <- Fmult_correct;auto with zarith.
rewrite <- Fminus_correct;auto with zarith;rewrite <- Fabs_correct;auto with zarith.
unfold FtoR, Fabs; rewrite H1;simpl;ring.
replace (x-y×z)%R with (z*(x/z-y))%R;[idtac|field;auto with real].
rewrite Rabs_mult.
case (Rle_or_lt (powerRZ radix (Zplus (Zpred k) (Fexp y))) (Rabs (Rdiv x z))); intros H.
apply Rle_lt_trans with ((Rabs z)*(powerRZ radix (Zpred (Fexp y))))%R.
apply Rmult_le_compat_l;auto with real;apply Divnk_error.
apply Rlt_le_trans with (((powerRZ radix n)*(powerRZ radix (Fexp z)))*(powerRZ radix (Zpred (Fexp y))))%R.
apply Rmult_lt_compat_r;auto with real zarith.
unfold FtoRradix; rewrite <- Fabs_correct;auto with zarith; unfold Fabs, FtoRradix, FtoR.
simpl; apply Rmult_lt_compat_r;auto with real zarith.
apply Rlt_le_trans with (Zpos (vNum b1));auto with real zarith.
elim Normz; intros V1 V2;elim V1; intros V3 V4;auto with zarith real.
rewrite nGivesBound1;right;rewrite Zpower_nat_Z_powerRZ;auto with real zarith.
repeat rewrite <- powerRZ_add; auto with real zarith.
apply Rle_powerRZ;auto with zarith real.
generalize (Divnk_FexpyLe2 H); unfold Zsucc, Zpred; auto with zarith.
rewrite <- powerRZ_add; auto with real zarith.
cut (Rle R0 ((Rabs (x/z-y)))%R);auto with real; intros H2;case H2.
2: intros W; rewrite <- W; ring_simplify ((Rabs z)*0)%R;auto with real zarith.
clear H2; intros H2.
apply Rlt_le_trans with ((powerRZ radix (Zplus n (Fexp z)))*(Rabs (x/z-y)))%R.
apply Rmult_lt_compat_r; auto with real.
apply Rle_lt_trans with (Rmult (Rminus (powerRZ radix n) R1) (powerRZ radix (Fexp z))).
apply Normal_le with b1;auto.
rewrite powerRZ_add; auto with real zarith.
apply Rmult_lt_compat_r; auto with real zarith.
apply Rlt_le_trans with ((powerRZ radix n)-0)%R;[idtac|right;ring].
unfold Rminus; apply Rplus_lt_compat_l; auto with real.
apply Rmult_le_reg_l with (powerRZ radix (Zopp (Zplus n (Fexp z))));auto with real zarith.
rewrite <- Rmult_assoc; repeat rewrite <- powerRZ_add; auto with real zarith.
ring_simplify (Zplus (Zopp (Zplus n (Fexp z))) (Zplus n (Fexp z)));
ring_simplify (Zplus (Zopp (Zplus n (Fexp z))) (Zplus (Fexp x) n)).
apply Rle_trans with ((Rabs (x/z-y)))%R;[right;simpl;ring|idtac].
apply Rle_trans with (powerRZ radix (Zplus (-2)%Z (Fexp y))).
2: apply Rle_powerRZ;auto with real zarith.
2:generalize Divnk_FexpyLe;auto with zarith.
replace (Zplus (-2)%Z (Fexp y)) with (Zpred (Zpred (Fexp y)));[idtac|unfold Zpred;ring].
rewrite <- Rabs_Ropp.
replace (-(x/z-y))%R with (y-x/z)%R;[idtac|ring].
apply Rle_trans with ((Rabs ((Fabs y)-(Rabs (x/z)))))%R.
unfold FtoRradix; rewrite Fabs_correct;auto with zarith; fold FtoRradix.
case (Rle_or_lt R0 (x/z)%R);intros.
rewrite (Rabs_right (x/z)%R);auto with real.
rewrite (Rabs_right (y)%R);auto with real.
apply Rle_ge; unfold FtoRradix; apply RleRoundedR0 with b2 k (Closest b2 radix) (x/z)%R;auto with zarith float.
apply ClosestRoundedModeP with k;auto with zarith.
right;rewrite (Rabs_left (x/z)%R);auto with real.
rewrite (Rabs_left1 (y)%R);auto with real.
replace (-y- -(x/z))%R with (-(y-x/z))%R;[idtac|ring].
rewrite Rabs_Ropp;auto with real.
unfold FtoRradix; apply RleRoundedLessR0 with b2 k (Closest b2 radix) (x/z)%R;auto with zarith float real.
apply ClosestRoundedModeP with k;auto with zarith.
cut ((Fexp y) = (Fexp (Fabs y)));[intros V2|unfold Fabs;simpl; auto with zarith].
cut ((FtoRradix (Fabs y))=(powerRZ radix (Zplus (Zpred k) (Fexp y))));[intros V1|idtac].
replace (Fexp y) with (Fexp (Fabs y));auto.
apply Rle_err_pow2 with b2 k;auto with zarith float.
apply FnormalFabs;auto with zarith.
rewrite V1;auto with real.
apply ClosestFabs with k;auto with zarith.
apply Rle_antisym.
2: unfold FtoRradix; rewrite Fabs_correct; auto with zarith; fold FtoRradix.
2: apply Normal_ge with b2;auto.
cut ((powerRZ radix (Zplus (Zpred k) (Fexp y)))=(Float (nNormMin radix k) (Fexp y)));[intros|idtac].
rewrite H0;unfold FtoRradix.
generalize (ClosestMonotone b2 radix); unfold MonotoneP;intros T.
apply T with (Rabs (x/z)%R) (powerRZ radix (Zplus (Zpred k) (Fexp y)));auto.
apply ClosestFabs with k;auto with zarith.
rewrite H0; unfold FtoRradix; apply RoundedModeProjectorIdem with b2.
apply ClosestRoundedModeP with k;auto with zarith.
cut (0 < (nNormMin radix k))%Z;[intros|apply nNormPos;auto with zarith].
repeat split; auto with zarith float.
simpl;rewrite Zabs_eq;[apply ZltNormMinVnum|idtac];auto with zarith float.
simpl; elim Normy;auto with zarith float.
unfold FtoRradix, FtoR, nNormMin;simpl.
rewrite Zpower_nat_Z_powerRZ; rewrite inj_pred;auto with zarith.
rewrite powerRZ_add; auto with zarith real.
Qed.
End Divnk.