Library Float.Others.Dekker
Require Export Div2.
Require Export Even.
Require Export Veltkamp.
Section Generic.
Variable b : Fbound.
Variable radix : Z.
Variable p : 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 pGivesBound : Zpos (vNum b) = Zpower_nat radix p.
Hypothesis precisionGreaterThanOne : 1 < p.
Theorem BoundedL: ∀ (r:R) (x:float) (e:Z),
(e ≤Fexp x)%Z → (-dExp b ≤ e)%Z → (FtoRradix x=r)%R →
(Rabs r < powerRZ radix (e+p))%R →
(∃ x':float, (FtoRradix x'=r) ∧ (Fbounded b x') ∧ Fexp x'=e).
intros.
∃ (Float (Fnum x×Zpower_nat radix (Zabs_nat (Fexp x -e)))%Z e).
split.
rewrite <- H1; unfold FtoRradix, FtoR; simpl.
rewrite mult_IZR; rewrite Zpower_nat_Z_powerRZ.
rewrite Rmult_assoc; rewrite <- powerRZ_add; auto with real zarith.
replace (Zabs_nat (Fexp x - e) + e)%Z with (Fexp x); auto with real.
rewrite <- Zabs_absolu; rewrite Zabs_eq; auto with zarith.
split;[idtac|simpl; auto].
split; simpl; auto.
apply Zlt_Rlt.
rewrite pGivesBound; rewrite <- Rabs_Zabs; rewrite mult_IZR.
repeat rewrite Zpower_nat_Z_powerRZ.
rewrite <- Zabs_absolu; rewrite Zabs_eq; auto with zarith.
rewrite Rabs_mult; rewrite (Rabs_right ( powerRZ radix (Fexp x - e))).
2: apply Rle_ge; auto with real zarith.
apply Rmult_lt_reg_l with (powerRZ radix e); auto with real zarith.
rewrite <- powerRZ_add; auto with real zarith.
apply Rle_lt_trans with (2:=H2); rewrite <- H1.
unfold FtoRradix, FtoR; rewrite Rabs_mult.
rewrite (Rabs_right (powerRZ radix (Fexp x))).
2: apply Rle_ge; auto with real zarith.
right; apply trans_eq with (Rabs (Fnum x)*(powerRZ radix e×powerRZ radix (Fexp x-e)))%R;[ring|idtac].
rewrite <- powerRZ_add; auto with real zarith.
ring_simplify (e+(Fexp x-e))%Z; auto with real.
Qed.
Theorem ClosestZero: ∀ (r:R) (x:float),
(Closest b radix r x) → (r=0)%R → (FtoRradix x=0)%R.
intros.
cut (0 ≤ FtoRradix x)%R;[intros |idtac].
cut (FtoRradix x ≤ 0)%R;[intros; auto with real |idtac].
unfold FtoRradix; apply RleRoundedLessR0 with b p (Closest b radix) r; auto with real.
apply ClosestRoundedModeP with p; auto.
unfold FtoRradix; apply RleRoundedR0 with b p (Closest b radix) r; auto with real.
apply ClosestRoundedModeP with p; auto.
Qed.
Theorem Closestbbext: ∀ bext:Fbound, ∀ fext f:float,
(vNum bext=vNum b) → (dExp b < dExp bext)%Z →
(-dExp b ≤ Fexp fext)%Z →
(Closest b radix fext f) → (Closest bext radix fext f).
intros bext fext f K1 K2; intros.
elim H0; intros.
split.
elim H1; intros; split; auto with zarith.
rewrite K1; auto.
intros g Hg.
case (Zle_or_lt (-(dExp b)) (Fexp g)); intros.
apply H2.
elim Hg; split; auto with zarith.
rewrite <- K1; auto.
case (Zle_lt_or_eq (-(dExp b)) (Fexp (Fnormalize radix b p f))).
cut (Fbounded b (Fnormalize radix b p f));[intros T; elim T; auto|idtac].
apply FnormalizeBounded; auto with zarith.
intros; apply Rle_trans with ((Fulp b radix p f)/2)%R.
apply Rmult_le_reg_l with (INR 2); auto with zarith real.
apply Rle_trans with (Fulp b radix p f);[idtac|simpl; right; field; auto with real].
rewrite <- Rabs_Ropp.
replace (- (FtoR radix f - fext))%R with (fext - FtoR radix f)%R;[idtac|ring].
apply ClosestUlp; auto with zarith.
rewrite <- Rabs_Ropp.
replace (- (FtoR radix g - fext))%R with (fext - FtoR radix g)%R;[idtac|ring].
apply Rle_trans with (Rabs fext -Rabs (FtoR radix g))%R;[idtac|apply Rabs_triang_inv].
apply Rle_trans with ((powerRZ radix (p-1+Fexp (Fnormalize radix b p f))
- powerRZ radix (-1+ Fexp (Fnormalize radix b p f)))
- powerRZ radix (p-1-dExp b))%R; [idtac|unfold Rminus; apply Rplus_le_compat].
apply Rplus_le_reg_l with (powerRZ radix (-1 + Fexp (Fnormalize radix b p f))).
ring_simplify ( powerRZ radix (-1 + Fexp (Fnormalize radix b p f)) +
(powerRZ radix (p - 1 + Fexp (Fnormalize radix b p f)) -
powerRZ radix (-1 + Fexp (Fnormalize radix b p f)) -
powerRZ radix (p - 1 - dExp b)))%R.
apply Rle_trans with (powerRZ radix (Fexp (Fnormalize radix b p f))).
unfold Fulp, Rdiv; apply Rle_trans with
((/2+/radix)* powerRZ radix (Fexp (Fnormalize radix b p f)))%R.
rewrite powerRZ_add; auto with real zarith; simpl; right; field.
repeat apply prod_neq_R0; auto with real zarith.
apply Rle_trans with (1 × powerRZ radix (Fexp (Fnormalize radix b p f)))%R;
[apply Rmult_le_compat_r; auto with real zarith|right; ring].
apply Rmult_le_reg_l with (2×radix)%R;
[apply Rmult_lt_0_compat; auto with real zarith|idtac].
apply Rle_trans with (2+radix)%R;
[right; field; auto with real zarith| ring_simplify (2×radix×1)%R].
apply Rle_trans with (radix+radix)%R;[idtac|right; ring].
replace 2%R with (IZR 2); auto with real zarith.
apply Rle_trans with (powerRZ radix (p-2+Fexp (Fnormalize radix b p f)));
[apply Rle_powerRZ; auto with real zarith|idtac].
apply Rle_trans with (1*(powerRZ radix (p - 2 + Fexp (Fnormalize radix b p f))))%R;
auto with real.
apply Rle_trans with ((radix -1)*(powerRZ radix (p - 2 + Fexp
(Fnormalize radix b p f))))%R;[apply Rmult_le_compat_r; auto with real zarith|idtac].
apply Rplus_le_reg_l with 1%R.
ring_simplify (1+(radix-1))%R; apply Rle_trans with (IZR 2); auto with real zarith.
apply Rle_trans with ( - powerRZ radix (p - 2+ Fexp (Fnormalize radix b p f)) +
powerRZ radix (p - 1 + Fexp (Fnormalize radix b p f)))%R.
right; unfold Zminus; repeat rewrite powerRZ_add; auto with real zarith.
simpl; field.
ring_simplify (radix×1)%R; repeat apply prod_neq_R0; auto with real zarith.
unfold Rminus; rewrite Rplus_comm; apply Rplus_le_compat_l; apply Ropp_le_contravar;
apply Rle_powerRZ; auto with real zarith.
cut (powerRZ radix (p - 1 + Fexp (Fnormalize radix b p f)) +
- powerRZ radix (-1 + Fexp (Fnormalize radix b p f))=
(Float (pPred (vNum b)) (-1+Fexp (Fnormalize radix b p f))))%R.
intros W; rewrite W.
2: unfold FtoRradix, FtoR, pPred.
2: apply trans_eq with (Zpred (Zpos (vNum b))×powerRZ radix
(-1+Fexp (Fnormalize radix b p f)))%R;[idtac|simpl; auto with real].
2: unfold Zpred, Zminus; rewrite plus_IZR.
2: rewrite pGivesBound; rewrite Zpower_nat_Z_powerRZ.
2: repeat rewrite powerRZ_add; auto with real zarith; simpl; field.
2: ring_simplify (radix×1)%R; auto with real zarith.
case (Rle_or_lt (Float (pPred (vNum b)) (-1 + Fexp (Fnormalize radix b p f)))
(Rabs fext)); auto with real; intros V.
absurd ( Rabs f ≤ Float (pPred (vNum b)) (-1 + Fexp (Fnormalize radix b p f)))%R.
apply Rlt_not_le.
apply Rlt_le_trans with (powerRZ radix (p-1+Fexp (Fnormalize radix b p f))).
rewrite <- W; apply Rlt_le_trans with (powerRZ radix (p - 1 +
Fexp (Fnormalize radix b p f))+-0)%R; auto with real zarith.
right; ring.
unfold FtoRradix; rewrite <- FnormalizeCorrect with radix b p f; auto with zarith.
rewrite <- Fabs_correct; auto.
rewrite powerRZ_add; auto with real zarith; unfold FtoRradix, FtoR, Fabs; simpl.
apply Rmult_le_compat_r; auto with real zarith.
apply Rmult_le_reg_l with radix; auto with real zarith.
apply Rle_trans with (powerRZ radix p).
unfold Zminus; rewrite powerRZ_add; auto with real zarith;
simpl; right; field ; auto with real.
ring_simplify (radix×1)%R; auto with real zarith.
cut (Fnormal radix b (Fnormalize radix b p f));[intros Nf|idtac].
rewrite <- Zpower_nat_Z_powerRZ; rewrite <- pGivesBound; rewrite <- mult_IZR;
elim Nf; intros.
rewrite Zabs_Zmult in H6; rewrite Zabs_eq in H6; auto with zarith real.
cut (Fcanonic radix b (Fnormalize radix b p f));[intros X|apply FnormalizeCanonic; auto with zarith].
case X; auto; intros X'.
elim X'; intros H5 H6; elim H6; intros.
absurd (-dExp b < dExp b)%Z; auto with zarith.
unfold FtoRradix; apply RoundAbsMonotoner with b p (Closest b radix) fext;
auto with real zarith.
apply ClosestRoundedModeP with p; auto with zarith.
split.
apply Zle_lt_trans with (pPred (vNum b)); auto with zarith.
simpl; rewrite Zabs_eq; auto with zarith.
apply Zlt_le_weak; apply pPredMoreThanOne with radix p; auto with zarith.
unfold pPred; auto with zarith.
apply Zle_trans with (Zpred (Fexp (Fnormalize radix b p f))); auto with zarith.
unfold Zpred; apply Zle_trans with (-1+Fexp (Fnormalize radix b p f))%Z;auto with zarith.
apply Ropp_le_contravar; rewrite <- Fabs_correct; auto.
unfold FtoR, Fabs; simpl.
apply Rle_trans with ((powerRZ radix p)*(powerRZ radix (-1-dExp b)))%R.
apply Rmult_le_compat; auto with real zarith.
elim Hg; intros; rewrite <- Zpower_nat_Z_powerRZ;
rewrite <- pGivesBound;rewrite <- K1; auto with real zarith.
apply Rle_powerRZ; auto with real zarith.
unfold Zminus; repeat rewrite powerRZ_add; auto with real zarith; right; ring.
intros H4.
apply Rle_trans with 0%R; auto with real; right.
rewrite <- FnormalizeCorrect with radix b p f; auto with zarith.
unfold FtoRradix; rewrite <- Fminus_correct; auto.
rewrite <- Fabs_correct; auto.
unfold FtoR.
replace (Fnum (Fabs (Fminus radix (Fnormalize radix b p f) fext))) with 0%Z;
[simpl; ring|idtac].
apply sym_eq; apply trans_eq with (Zabs (Fnum (Fminus radix
(Fnormalize radix b p f) fext)));[simpl; auto with zarith|idtac].
cut ( 0 ≤ Zabs (Fnum (Fminus radix (Fnormalize radix b p f) fext)))%Z;
auto with real zarith.
cut (Zabs (Fnum (Fminus radix (Fnormalize radix b p f) fext)) < 1)%Z;
auto with real zarith.
apply Zlt_Rlt.
apply Rmult_lt_reg_l with (powerRZ radix (-(dExp b))); auto with real zarith.
apply Rle_lt_trans with (Rabs (f-fext))%R.
unfold FtoRradix; rewrite <- FnormalizeCorrect with radix b p f; auto with zarith.
rewrite <- Fminus_correct; auto; rewrite <- Fabs_correct; auto.
unfold FtoR; simpl.
replace (Zmin (Fexp (Fnormalize radix b p f)) (Fexp fext)) with (-(dExp b))%Z;
[right; ring|idtac].
rewrite Zmin_le1; auto with zarith.
apply Rlt_le_trans with (Fulp b radix p f);
[idtac|unfold Fulp; simpl; rewrite H4; auto with real zarith].
rewrite <- Rabs_Ropp.
replace (- (f - fext))%R with (fext -f)%R;[idtac|ring].
unfold FtoRradix; apply RoundedModeUlp with (Closest b radix); auto with zarith real.
apply ClosestRoundedModeP with p; auto with zarith.
Qed.
Variable b' : Fbound.
Definition Underf_Err (a a' : float) (ra n:R) :=
(Closest b radix ra a) ∧ (Fbounded b' a') ∧
(Rabs (a-a') ≤ n×powerRZ radix (-(dExp b)))%R ∧
( ((-dExp b) ≤ Fexp a')%Z → (FtoRradix a =a')%R).
Theorem Underf_Err1: ∀ (a' a:float),
vNum b=vNum b' → (dExp b ≤ dExp b')%Z →
(Fbounded b' a') → (Closest b radix a' a) →
(Underf_Err a a' (FtoRradix a') (/2)%R).
intros.
unfold Underf_Err.
split; auto.
split; auto.
case (Zle_or_lt (- dExp b)%Z (Fexp a')); intros.
cut (FtoRradix a'=a);[intros H4|idtac].
rewrite H4; split; auto with real.
ring_simplify (a-a)%R; rewrite Rabs_R0; apply Rlt_le; apply Rmult_lt_0_compat; auto with real zarith.
unfold FtoRradix; apply RoundedModeProjectorIdemEq with b p (Closest b radix); auto.
apply ClosestRoundedModeP with p; auto with zarith.
elim H1; intros; split; auto.
rewrite H; auto.
split.
apply Rmult_le_reg_l with (INR 2); auto with real zarith.
apply Rle_trans with (powerRZ radix (- dExp b));[idtac|simpl; right; field; auto with real].
replace (a-a')%R with (-(a'-a))%R;[rewrite Rabs_Ropp|ring].
apply Rle_trans with (Fulp b radix p a).
unfold FtoRradix; apply ClosestUlp; auto with zarith.
unfold Fulp; apply Rle_powerRZ; auto with real zarith.
apply Zle_trans with (Fexp (firstNormalPos radix b p));[idtac|unfold firstNormalPos; simpl; auto with zarith].
apply Fcanonic_Rle_Zle with radix b p; auto with zarith.
apply FnormalizeCanonic; auto with zarith; elim H2; auto.
left; apply firstNormalPosNormal; auto with zarith.
rewrite (Rabs_right ((FtoR radix (firstNormalPos radix b p)))).
rewrite FnormalizeCorrect; auto with zarith.
apply RoundAbsMonotoner with b p (Closest b radix) (FtoRradix a'); auto.
apply ClosestRoundedModeP with p; auto with zarith.
assert (Fnormal radix b (firstNormalPos radix b p));
[apply firstNormalPosNormal; auto with zarith| elim H4; auto].
unfold FtoRradix; rewrite <- Fabs_correct; auto.
unfold firstNormalPos, Fabs, FtoR; simpl.
apply Rle_trans with (powerRZ radix p × powerRZ radix (Fexp a'))%R.
apply Rmult_le_compat_r; auto with real zarith.
elim H1; intros; apply Rle_trans with (IZR (Zpos (vNum b'))); auto with real zarith.
rewrite <- H; rewrite pGivesBound; rewrite Zpower_nat_Z_powerRZ; auto with real zarith.
unfold nNormMin; rewrite Zpower_nat_Z_powerRZ.
repeat rewrite <- powerRZ_add; auto with real zarith.
apply Rle_powerRZ; auto with real zarith.
rewrite inj_pred; auto with zarith; unfold Zpred; auto with zarith.
apply Rle_ge; apply LeFnumZERO; auto.
unfold firstNormalPos, nNormMin; simpl; auto with zarith.
intros ; absurd (Fexp a' < - dExp b)%Z; auto with zarith.
Qed.
Theorem Underf_Err2_aux: ∀ (r:R) (x1:float),
vNum b=vNum b' → (dExp b ≤ dExp b')%Z →
(Fcanonic radix b x1) →
(Closest b radix r x1) →
(∃ x2:float, (Underf_Err x1 x2 r (3/4)%R) ∧ (Closest b' radix r x2)).
intros.
assert (ZH: (0 < 3/4)%R).
apply Rmult_lt_reg_l with 4%R; auto with real.
apply Rmult_lt_0_compat; auto with real.
ring_simplify (4×0)%R; apply Rlt_le_trans with 3%R; auto with real.
apply Rlt_trans with 2%R; auto with real.
right; field; auto with real.
case (Zle_lt_or_eq (-(dExp b))%Z (Fexp x1)).
elim H2; intros I1 I2; elim I1; auto.
intros I.
∃ x1; split.
split; auto.
assert (Fbounded b x1);[elim H2; auto|idtac].
split.
split; auto with zarith.
elim H3; intros; rewrite <- H; auto.
split;[idtac|intros; auto with real].
ring_simplify (x1-x1)%R; rewrite Rabs_R0.
apply Rlt_le; apply Rmult_lt_0_compat; auto with real zarith.
split;[elim H2; intros T T'; elim T; intros; split; try rewrite <- H; auto with zarith|idtac].
intros f H3.
case (Zle_or_lt (-(dExp b)) (Fexp f)); intros.
elim H2; intros T1 T2; apply T2.
elim H3; intros; split; try rewrite H; auto with zarith.
fold FtoRradix; replace (f-r)%R with (-((x1-f)-(x1-r)))%R;[rewrite Rabs_Ropp|ring].
apply Rle_trans with (Rabs (x1 - f) - Rabs (x1 - r))%R;[idtac|apply Rabs_triang_inv].
apply Rplus_le_reg_l with (Rabs (x1-r)).
apply Rle_trans with ((INR 2)*(Rabs (x1-r)))%R;[right; simpl; ring|idtac].
apply Rle_trans with (Rabs (x1 - f));[idtac|right; ring].
apply Rle_trans with (Fulp b radix p x1).
replace (x1-r)%R with (-(r-x1))%R;[rewrite Rabs_Ropp|ring].
unfold FtoRradix; apply ClosestUlp; auto with zarith.
rewrite CanonicFulp; auto with zarith.
apply Rle_trans with (powerRZ radix (Fexp x1));[right; unfold FtoR; simpl; ring|idtac].
apply Rle_trans with ((Rabs x1)-Rabs f)%R;[idtac|apply Rabs_triang_inv].
apply Rplus_le_reg_l with (Rabs f).
apply Rle_trans with (Rabs x1);[idtac|right;ring].
apply Rle_trans with (powerRZ radix (p-2+Fexp x1)+powerRZ radix (p-2+Fexp x1))%R.
apply Rplus_le_compat.
apply Rle_trans with (FtoRradix (Float (Zpos (vNum b')) (Fexp f))).
apply Rlt_le; unfold FtoRradix; apply MaxFloat; auto.
unfold FtoRradix, FtoR; rewrite <- H; rewrite pGivesBound;simpl.
rewrite Zpower_nat_Z_powerRZ; rewrite <- powerRZ_add; auto with real zarith.
apply Rle_powerRZ; auto with zarith real.
apply Rle_powerRZ; auto with zarith real.
apply Rle_trans with (2×powerRZ radix (p - 2 + Fexp x1))%R;[right; ring|idtac].
apply Rle_trans with (radix×powerRZ radix (p - 2 + Fexp x1))%R;
[apply Rmult_le_compat_r; auto with real zarith|idtac].
apply Rle_trans with (IZR 2); auto with real zarith.
unfold FtoRradix; rewrite <- Fabs_correct; auto; unfold FtoR, Fabs; simpl.
rewrite powerRZ_add; auto with real zarith.
rewrite <- Rmult_assoc; apply Rmult_le_compat_r; auto with real zarith.
case H1; intros T.
elim T; intros H5 H6.
apply Rmult_le_reg_l with (IZR radix); auto with real zarith.
apply Rle_trans with (IZR (Zpos (vNum b))).
right; rewrite pGivesBound; rewrite Zpower_nat_Z_powerRZ.
unfold Zminus; rewrite powerRZ_add; auto with real zarith; simpl.
ring_simplify (radix×1)%R; field; auto with real zarith.
apply Rle_trans with (IZR(Zabs (radix × Fnum x1))); auto with real zarith.
rewrite Zabs_Zmult; rewrite Zabs_eq; auto with zarith real.
right; rewrite mult_IZR; ring.
elim T; intros T1 T2; elim T2; intros T3 T4.
absurd (- dExp b < Fexp x1)%Z; auto with zarith.
intros I.
generalize ClosestTotal; unfold TotalP.
intros T; elim T with b' radix p r; auto.
2: rewrite <- H; auto.
intros x2 H3'; clear T.
case (Zle_or_lt (-(dExp b)) (Fexp x2)); intros.
∃ x1; split.
split; auto.
assert (Fbounded b x1);[elim H2; auto|idtac].
split.
elim H4; intros; split; auto with zarith.
rewrite <- H; auto.
split;[idtac|intros; auto with real].
ring_simplify (x1-x1)%R; rewrite Rabs_R0; apply Rlt_le.
apply Rmult_lt_0_compat; auto with real zarith.
split.
elim H2; intros T1 T2; elim T1; intros; split; try rewrite <- H; auto with zarith.
intros f H4.
apply Rle_trans with (Rabs (FtoR radix x2 - r)).
elim H2; intros T1 T2; apply T2.
elim H3'; intros T1' T2'; elim T1'; intros; split; try rewrite H; auto with zarith.
elim H3'; intros T1 T2; apply T2; auto.
∃ x2; split; auto.
split; auto.
split;[elim H3'; auto|idtac].
split.
replace (x1-x2)%R with ((-(r-x1))+(r-x2))%R;[idtac|ring].
apply Rle_trans with (1:=Rabs_triang (-(r-x1))%R (r-x2)%R).
rewrite Rabs_Ropp; apply Rmult_le_reg_l with (INR 2); auto with real zarith.
apply Rle_trans with (S 1 × (Rabs (r - x1)) + S 1 ×Rabs (r - x2))%R;[right; ring|idtac].
apply Rle_trans with ( powerRZ radix (- dExp b)+ (/2)*powerRZ radix (- dExp b))%R;[idtac|simpl; right; field].
apply Rplus_le_compat.
apply Rle_trans with (Fulp b radix p x1).
unfold FtoRradix; apply ClosestUlp; auto.
rewrite CanonicFulp; auto.
rewrite <- I; unfold FtoR; simpl; right; ring.
apply Rle_trans with (Fulp b' radix p x2).
unfold FtoRradix; apply ClosestUlp; auto.
rewrite <- H; auto.
apply Rle_trans with (powerRZ radix (Fexp x2)).
unfold Fulp; apply Rle_powerRZ; auto with zarith real.
apply FcanonicLeastExp with radix b' p; auto with zarith.
rewrite <- H; auto.
rewrite FnormalizeCorrect; auto with zarith real.
elim H3'; auto.
apply FnormalizeCanonic; auto with zarith.
rewrite <- H; auto.
elim H3'; auto.
apply Rmult_le_reg_l with 2%R; auto with real.
apply Rle_trans with (powerRZ radix (- dExp b));[idtac|right; field; auto with real].
apply Rle_trans with (radix × powerRZ radix (Fexp x2))%R;[apply Rmult_le_compat_r; auto with real zarith|idtac].
apply Rle_trans with (IZR 2); auto with real zarith.
apply Rle_trans with (powerRZ radix (Fexp x2+1)).
rewrite powerRZ_add; auto with real zarith; simpl; right; ring.
apply Rle_powerRZ; auto with real zarith.
intros H5; absurd ((Fexp x2 < - dExp b)%Z); auto with zarith.
Qed.
Theorem Underf_Err2: ∀ (r:R) (x1:float),
vNum b=vNum b' → (dExp b ≤ dExp b')%Z →
(Closest b radix r x1) →
(∃ x2:float, (Underf_Err x1 x2 r (3/4)%R) ∧ (Closest b' radix r x2)).
intros.
elim Underf_Err2_aux with r (Fnormalize radix b p x1); auto with zarith.
unfold Underf_Err; intros x2 tmp; elim tmp; intros T Z; elim T; intros V1 T'; elim T';
intros V2 T''; elim T''; intros V3 V4; clear T T' T'' tmp.
∃ x2; split; auto.
split; auto.
split; auto.
split; auto.
replace (x1-x2)%R with (Fnormalize radix b p x1 - x2)%R; auto with real.
unfold FtoRradix; rewrite FnormalizeCorrect; auto.
intros; apply trans_eq with (FtoRradix (Fnormalize radix b p x1)).
unfold FtoRradix; rewrite FnormalizeCorrect; auto.
apply V4; auto.
apply FnormalizeCanonic; auto with zarith; elim H1; auto.
apply ClosestCompatible with (1:=H1); auto.
rewrite <- FnormalizeCorrect with radix b p x1; auto.
apply FnormalizeBounded; auto with zarith; elim H1; auto.
Qed.
Theorem Underf_Err3: ∀ (x x' y y' z' z:float) (rx ry epsx epsy:R),
vNum b=vNum b' → (dExp b ≤ dExp b')%Z →
(Underf_Err x x' rx epsx) → (Underf_Err y y' ry epsy) →
(epsx+epsy ≤ (powerRZ radix (p-1) -1))%R →
(Fbounded b' z') → (FtoRradix z'=x'-y')%R →
(Fexp z' ≤ Fexp x')%Z → (Fexp z' ≤ Fexp y')%Z →
(Closest b radix (x-y) z) →
(Underf_Err z z' (x-y) (epsx+epsy)%R).
intros.
unfold Underf_Err.
split; auto.
split; auto.
unfold Underf_Err in H1; unfold Underf_Err in H2.
case (Zle_or_lt (- dExp b)%Z (Fexp z')); intros.
elim H1; intros V1 T; elim T; intros V2 T'; elim T'; intros V3 V4; clear T T' H1.
elim H2; intros W1 T; elim T; intros W2 T'; elim T'; intros W3 W4; clear T T' H2.
cut (FtoRradix z=z')%R;[intros H9'; rewrite H9'; split; auto|idtac].
ring_simplify (z'-z')%R; rewrite Rabs_R0.
apply Rle_trans with (0× powerRZ radix (- dExp b))%R;[right; ring|apply Rmult_le_compat_r; auto with real zarith].
apply Rle_trans with (0+0)%R; [right; ring|apply Rplus_le_compat; auto with real].
apply Rmult_le_reg_l with (powerRZ radix (- dExp b))%R; auto with real zarith;
ring_simplify (powerRZ radix (- dExp b) × 0)%R; rewrite Rmult_comm.
apply Rle_trans with (2:=V3); auto with real.
apply Rmult_le_reg_l with (powerRZ radix (- dExp b))%R; auto with real zarith;
ring_simplify (powerRZ radix (- dExp b) × 0)%R; rewrite Rmult_comm.
apply Rle_trans with (2:=W3); auto with real.
unfold FtoRradix; apply sym_eq.
apply RoundedModeProjectorIdemEq with b p (Closest b radix); auto with zarith.
apply ClosestRoundedModeP with p; auto with zarith.
elim H4; intros; split; auto with zarith.
rewrite H; auto.
fold FtoRradix; rewrite H5.
rewrite <- V4; auto with zarith.
rewrite <- W4; auto with zarith real.
elim H1; intros V1 T; elim T; intros V2 T'; elim T'; intros V3 V4; clear T T' H1.
elim H2; intros W1 T; elim T; intros W2 T'; elim T'; intros W3 W4; clear T T' H2.
split;[idtac|intros; absurd (- dExp b ≤ Fexp z')%Z; auto with zarith].
replace (z-z')%R with (-((x-y)-z)+((x-x')+-(y-y')))%R;[idtac|rewrite H5; ring].
apply Rle_trans with (1:=Rabs_triang (- (x - y - z))%R ((x - x') + - (y - y'))%R).
apply Rle_trans with ((Rabs (- (x - y - z))) + (Rabs (x - x') +(Rabs (- (y - y')))))%R;
[apply Rplus_le_compat_l; apply Rabs_triang|idtac].
rewrite Rabs_Ropp; rewrite Rabs_Ropp.
apply Rle_trans with (0 + ( epsx × powerRZ radix (- dExp b)
+ epsy × powerRZ radix (- dExp b)))%R;[idtac|right; ring].
apply Rplus_le_compat;[idtac|apply Rplus_le_compat; auto with real].
cut (FtoRradix (Fnormalize radix b p z)=x-y)%R.
unfold FtoRradix; rewrite FnormalizeCorrect; auto.
fold FtoRradix; intros T; rewrite T; ring_simplify (x - y - (x - y))%R; rewrite Rabs_R0; auto with real.
unfold FtoRradix, Rminus; rewrite <- Fopp_correct; auto.
apply plusExact1 with b p; auto.
elim V1; auto.
apply oppBounded; elim W1; auto.
rewrite Fopp_correct; auto with real.
apply ClosestCompatible with (1:=H8); auto.
rewrite FnormalizeCorrect; auto with real.
apply FnormalizeBounded; auto with zarith; elim H8; auto.
apply Zle_trans with (-(dExp b))%Z.
2: apply Zmin_Zle.
2: elim V1; intros T1 T2; elim T1; auto.
2: elim W1; intros T1 T2; elim T1; auto.
apply Zle_trans with (Fexp (Float (pPred (vNum b)) (-(dExp b))%Z));
[idtac| simpl; auto with zarith].
apply Fcanonic_Rle_Zle with radix b p; auto with zarith.
apply FnormalizeCanonic; auto with zarith; elim H8; auto.
apply FcanonicPpred with p; auto with zarith.
rewrite (Rabs_right ((FtoR radix (Float (pPred (vNum b)) (- dExp b))))).
rewrite FnormalizeCorrect; auto with zarith.
apply RoundAbsMonotoner with b p (Closest b radix) (x-y)%R; auto.
apply ClosestRoundedModeP with p; auto with zarith.
assert (Fcanonic radix b (Float (pPred (vNum b)) (- dExp b)));
[apply FcanonicPpred with p; auto with zarith | apply FcanonicBound with radix; auto].
replace (x-y)%R with ((x-x')+-(y-y')+z')%R;[idtac|rewrite H5; ring].
apply Rle_trans with (1:=Rabs_triang (x - x' + - (y - y'))%R z').
apply Rle_trans with ((powerRZ radix (p - 1) - 1)*powerRZ radix (-(dExp b)) +
(powerRZ radix p - 1)*powerRZ radix (-(dExp b)-1))%R;[apply Rplus_le_compat|idtac].
apply Rle_trans with (1:=Rabs_triang (x-x')%R (-(y-y'))%R); rewrite Rabs_Ropp.
apply Rle_trans with (epsx × powerRZ radix (- dExp b)+ epsy × powerRZ radix (- dExp b))%R; auto with real.
apply Rle_trans with ((epsx+epsy) × powerRZ radix (- dExp b))%R;[right; ring|idtac].
apply Rmult_le_compat_r; auto with real zarith.
unfold FtoRradix; rewrite <- Fabs_correct; auto.
unfold Fabs, FtoR; simpl.
apply Rmult_le_compat; auto with real zarith.
elim H4; intros.
apply Rle_trans with (IZR (Zpred (Zpos (vNum b')))); auto with real zarith.
unfold Zpred, Zminus; rewrite plus_IZR.
rewrite <- H; rewrite pGivesBound; rewrite Zpower_nat_Z_powerRZ; auto with real zarith.
apply Rle_powerRZ; auto with real zarith.
apply Rle_trans with ((powerRZ radix p - 1) × powerRZ radix (- dExp b))%R.
apply Rle_trans with (- powerRZ radix (- dExp b)+powerRZ radix p
× powerRZ radix (- dExp b))%R;[idtac|right; ring].
apply Rle_trans with (- powerRZ radix (- dExp b)+ ((powerRZ radix (p - 1)× powerRZ radix (- dExp b)+
(powerRZ radix p×powerRZ radix (- dExp b - 1) - powerRZ radix (- dExp b - 1)))))%R;
[right; ring|apply Rplus_le_compat_l].
repeat rewrite <- powerRZ_add; auto with real zarith.
replace ((p + (- dExp b - 1)))%Z with (p - 1 + - dExp b)%Z;[idtac|ring].
apply Rle_trans with (powerRZ radix (p - 1 + - dExp b) +
(powerRZ radix (p - 1 + - dExp b) - 0))%R; auto with real zarith.
apply Rplus_le_compat_l; unfold Rminus; apply Rplus_le_compat_l; auto with real zarith.
apply Rle_trans with (2*(powerRZ radix (p - 1 + - dExp b)))%R;[right; ring|idtac].
apply Rle_trans with (radix*(powerRZ radix (p - 1 + - dExp b)))%R;
[apply Rmult_le_compat_r; auto with real zarith|idtac].
apply Rle_trans with (IZR 2); auto with real zarith.
unfold Zminus; repeat rewrite powerRZ_add; auto with real zarith; simpl; right; field; auto with real zarith.
unfold FtoR; simpl.
unfold pPred, Zpred, Zminus; rewrite plus_IZR.
rewrite pGivesBound; rewrite Zpower_nat_Z_powerRZ; simpl; auto with real zarith.
apply Rle_ge; apply LeFnumZERO; auto.
simpl; apply Zlt_le_weak.
apply pPredMoreThanOne with radix p; auto with zarith float.
Qed.
Theorem Underf_Err3_bis: ∀ (x x' y y' z' z:float) (rx ry epsx epsy:R),
(4 ≤ p) →
vNum b=vNum b' → (dExp b ≤ dExp b')%Z →
(Underf_Err x x' rx epsx) → (Underf_Err y y' ry epsy) →
(epsx+epsy ≤ 7)%R →
(Fbounded b' z') → (FtoRradix z'=x'-y')%R →
(Fexp z' ≤ Fexp x')%Z → (Fexp z' ≤ Fexp y')%Z →
(Closest b radix (x-y) z) →
(Underf_Err z z' (x-y) (epsx+epsy)%R).
intros.
apply Underf_Err3 with x' y' rx ry; auto.
apply Rle_trans with (1:=H4).
apply Rle_trans with (8-1)%R;[right; ring|unfold Rminus; apply Rplus_le_compat_r].
apply Rle_trans with (powerRZ radix 3)%R; auto with real zarith.
apply Rle_trans with (powerRZ 2 3)%R; auto with real zarith.
simpl; right; ring.
simpl; auto with real zarith.
assert (2 ≤ radix)%R;[apply Rle_trans with (IZR 2); auto with real zarith|idtac].
ring_simplify (2×1)%R; ring_simplify (radix×1)%R.
apply Rmult_le_compat; auto with real zarith.
apply Rlt_le; apply Rmult_lt_0_compat; auto with real.
apply Rle_powerRZ; auto with zarith real.
Qed.
End Generic.
Section Sec1.
Variable radix : Z.
Variable b : Fbound.
Variables s t:nat.
Let b' := Bound
(P_of_succ_nat (pred (Zabs_nat (Zpower_nat radix (minus t s)))))
(dExp b).
Let bt := Bound
(P_of_succ_nat (pred (Zabs_nat (Zpower_nat radix s))))
(dExp b).
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 pGivesBound: Zpos (vNum b)=(Zpower_nat radix t).
Hypothesis SLe: (2 ≤ s)%nat.
Hypothesis SGe: (s ≤ t-2)%nat.
Hypothesis Hst1: (t-1 ≤ s+s)%Z.
Hypothesis Hst2: (s+s ≤ t+1)%Z.
Variables x x1 x2 y y1 y2 r e: float.
Hypotheses Nx: Fnormal radix b x.
Hypotheses Ny: Fnormal radix b y.
Hypothesis K: (-dExp b ≤ Fexp x +Fexp y)%Z.
Hypotheses rDef: Closest b radix (x×y) r.
Hypotheses eeq: (x×y=r+e)%R.
Hypotheses Xeq: (FtoRradix x=x1+x2)%R.
Hypotheses Yeq: (FtoRradix y=y1+y2)%R.
Hypotheses x2Le: (Rabs x2 ≤ (powerRZ radix (s+Fexp x)) /2)%R.
Hypotheses y2Le: (Rabs y2 ≤ (powerRZ radix (s+Fexp y)) /2)%R.
Hypotheses x1Exp: (s+Fexp x ≤ Fexp x1)%Z.
Hypotheses y1Exp: (s+Fexp y ≤ Fexp y1)%Z.
Hypotheses x2Exp: (Fexp x ≤ Fexp x2)%Z.
Hypotheses y2Exp: (Fexp y ≤ Fexp y2)%Z.
Lemma x2y2Le: (Rabs (x2×y2) ≤ (powerRZ radix (2×s+Fexp x+Fexp y)) /4)%R.
rewrite Rabs_mult.
apply Rle_trans with ((powerRZ radix (s + Fexp x) / 2)*(powerRZ radix (s + Fexp y) / 2))%R.
apply Rmult_le_compat; auto with real.
replace (2×s)%Z with (s+s)%Z; auto with zarith.
repeat rewrite powerRZ_add; auto with real zarith.
right; field.
Qed.
Lemma x2y1Le: (Rabs (x2×y1) < (powerRZ radix (t+s+Fexp x+Fexp y)) /2
+ (powerRZ radix (2×s+Fexp x+Fexp y)) /4)%R.
replace (x2×y1)%R with (x2×y+(-(x2×y2)))%R;[idtac|rewrite Yeq; ring].
apply Rle_lt_trans with (1:=Rabs_triang (x2×y)%R (-(x2×y2))%R).
rewrite Rabs_Ropp.
cut ((Rabs (x2 × y) < powerRZ radix (t + s + Fexp x + Fexp y) / 2))%R;[intros I1|idtac].
generalize x2y2Le; auto with real.
rewrite Rabs_mult.
apply Rlt_le_trans with ((powerRZ radix (s + Fexp x) / 2)*powerRZ radix (t+Fexp y))%R.
cut (Rabs y <powerRZ radix (t + Fexp y))%R; auto with real zarith.
intros I; apply Rle_lt_trans with (powerRZ radix (s + Fexp x) / 2 ×Rabs y)%R; auto with real.
apply Rmult_lt_compat_l; auto with real zarith.
unfold Rdiv; apply Rmult_lt_0_compat; auto with real zarith.
unfold FtoRradix; rewrite <- Fabs_correct; auto with zarith.
unfold FtoR, Fabs; simpl; rewrite powerRZ_add; auto with real zarith.
apply Rmult_lt_compat_r; auto with real zarith.
elim Ny; intros I1 I2; elim I1; intros.
apply Rlt_le_trans with (IZR (Zpos (vNum b))); auto with real zarith.
right; rewrite pGivesBound;rewrite Zpower_nat_Z_powerRZ; auto with real.
repeat rewrite powerRZ_add; auto with real zarith.
unfold Rdiv; right; ring.
Qed.
Lemma x1y2Le: (Rabs (x1×y2) < (powerRZ radix (t+s+Fexp x+Fexp y)) /2
+ (powerRZ radix (2×s+Fexp x+Fexp y)) /4)%R.
replace (x1×y2)%R with (x×y2+(-(x2×y2)))%R;[idtac|rewrite Xeq; ring].
apply Rle_lt_trans with (1:=Rabs_triang (x×y2)%R (-(x2×y2))%R).
rewrite Rabs_Ropp.
cut ((Rabs (x × y2) < powerRZ radix (t + s + Fexp x + Fexp y) / 2))%R;[intros I1|idtac].
generalize x2y2Le; auto with real.
rewrite Rabs_mult.
apply Rlt_le_trans with (powerRZ radix (t+Fexp x)*(powerRZ radix (s + Fexp y) / 2))%R.
cut (Rabs x <powerRZ radix (t + Fexp x))%R; auto with real zarith.
intros I; apply Rle_lt_trans with (Rabs x*(powerRZ radix (s + Fexp y) / 2))%R; auto with real.
apply Rmult_lt_compat_r; auto with real zarith.
unfold Rdiv; apply Rmult_lt_0_compat; auto with real zarith.
unfold FtoRradix; rewrite <- Fabs_correct; auto with zarith.
unfold FtoR, Fabs; simpl; rewrite powerRZ_add; auto with real zarith.
apply Rmult_lt_compat_r; auto with real zarith.
elim Nx; intros I1 I2; elim I1; intros.
apply Rlt_le_trans with (IZR (Zpos (vNum b))); auto with real zarith.
right; rewrite pGivesBound;rewrite Zpower_nat_Z_powerRZ; auto with real.
repeat rewrite powerRZ_add; auto with real zarith.
unfold Rdiv; right; ring.
Qed.
Lemma eLe: (Rabs e ≤ (powerRZ radix (t+Fexp x+Fexp y)) /2)%R.
apply Rmult_le_reg_l with (INR 2); auto with real zarith.
replace (FtoRradix e) with (x×y-r)%R;[idtac|rewrite eeq; ring].
apply Rle_trans with (Fulp b radix t r).
unfold FtoRradix; apply ClosestUlp; auto with zarith.
apply Rle_trans with (powerRZ radix (t + Fexp x + Fexp y));
[idtac|simpl; right; field; auto with real].
unfold Fulp; apply Rle_powerRZ; auto with real zarith.
apply Zle_trans with (Fexp (Float (pPred (vNum b)) (t+Fexp x+Fexp y)));
[idtac|simpl; auto with zarith].
apply Fcanonic_Rle_Zle with radix b t; auto with zarith.
apply FnormalizeCanonic; auto with zarith.
elim rDef; auto.
replace (Float (pPred (vNum b)) (t + Fexp x + Fexp y)) with
(FPred b radix t (Float (nNormMin radix t) (t+1+Fexp x+Fexp y))).
apply FPredCanonic; auto with zarith.
apply FcanonicNnormMin; auto with zarith.
rewrite FPredSimpl2; auto with zarith.
simpl; unfold Zpred; auto with zarith.
replace (t+1+Fexp x +Fexp y+-1)%Z with (t+Fexp x+Fexp y)%Z; auto with zarith.
simpl; auto with zarith.
rewrite FnormalizeCorrect; auto with zarith.
rewrite (Rabs_right (FtoR radix (Float (pPred (vNum b)) (t + Fexp x + Fexp y)))%R).
2: apply Rle_ge; apply LeFnumZERO; simpl; auto with zarith.
2: generalize (pPredMoreThanOne b radix t); auto with zarith.
apply RoundAbsMonotoner with b t (Closest b radix) (x×y)%R; auto with zarith.
apply ClosestRoundedModeP with t; auto with zarith.
replace (Float (pPred (vNum b)) (t + Fexp x + Fexp y)) with
(FPred b radix t (Float (nNormMin radix t) (t+1+Fexp x+Fexp y))).
apply FBoundedPred; auto with zarith.
elim FnormalNnormMin with radix b t (t + 1 + Fexp x + Fexp y)%Z; auto with zarith.
rewrite FPredSimpl2; auto with zarith.
simpl; unfold Zpred; auto with zarith.
replace (t+1+Fexp x +Fexp y+-1)%Z with (t+Fexp x+Fexp y)%Z; auto with zarith.
simpl; auto with zarith.
rewrite Rabs_mult.
apply Rle_trans with ((FtoRradix (Float (pPred (vNum b)) (Fexp x)))*(powerRZ radix (t+Fexp y)))%R.
apply Rmult_le_compat; auto with real zarith.
unfold FtoRradix; rewrite <- Fabs_correct; auto with zarith.
unfold FtoR, Fabs; simpl.
apply Rmult_le_compat_r; auto with real zarith.
elim Nx; intros I1 I2; elim I1; intros; unfold pPred; auto with real zarith.
unfold FtoRradix; rewrite <- Fabs_correct; auto with zarith.
unfold FtoR, Fabs; simpl.
rewrite powerRZ_add; auto with real zarith.
apply Rmult_le_compat_r; auto with real zarith.
elim Ny; intros I1 I2; elim I1; intros; apply Rle_trans with (IZR (Zpos (vNum b))); auto with real zarith.
rewrite pGivesBound; rewrite Zpower_nat_Z_powerRZ; auto with real zarith.
unfold FtoRradix, FtoR; simpl; repeat rewrite powerRZ_add; auto with real zarith; right; ring.
Qed.
Lemma rExp: (t - 1 + Fexp x + Fexp y ≤ Fexp r)%Z.
apply Zle_trans with (Fexp (Float (nNormMin radix t) (t-1+Fexp x+Fexp y)));
[simpl; auto with zarith|idtac].
apply Zle_trans with (Fexp (Fnormalize radix b t r)).
apply Fcanonic_Rle_Zle with radix b t; auto with zarith.
apply FcanonicNnormMin; auto with zarith.
apply FnormalizeCanonic; auto with zarith.
elim rDef; auto.
rewrite FnormalizeCorrect; auto with zarith.
rewrite (Rabs_right (FtoR radix (Float (nNormMin radix t) (t-1 + Fexp x + Fexp y)))%R).
2: apply Rle_ge; apply LeFnumZERO; simpl; auto with zarith.
2: unfold nNormMin; auto with zarith.
apply RoundAbsMonotonel with b t (Closest b radix) (x×y)%R; auto with zarith.
apply ClosestRoundedModeP with t; auto with zarith.
apply FcanonicBound with radix; auto with zarith.
apply FcanonicNnormMin; auto with zarith.
fold FtoRradix; replace (FtoRradix (Float (nNormMin radix t) (t-1 + Fexp x + Fexp y))) with
((Float (nNormMin radix t) (Fexp x))*(Float (nNormMin radix t) (Fexp y)))%R.
rewrite Rabs_mult.
apply Rmult_le_compat.
unfold FtoRradix; apply LeFnumZERO; simpl; unfold nNormMin; auto with zarith.
unfold FtoRradix; apply LeFnumZERO; simpl; unfold nNormMin; auto with zarith.
unfold FtoRradix; rewrite <- Fabs_correct; auto with zarith; unfold FtoR; simpl.
apply Rmult_le_compat_r; auto with real zarith; apply Rmult_le_reg_l with (IZR radix); auto with real zarith.
rewrite <- mult_IZR; rewrite <- (PosNormMin radix b t); auto with zarith.
elim Nx; intros I1 I2; rewrite Zabs_Zmult in I2; rewrite Zabs_eq in I2; auto with real zarith.
rewrite <- mult_IZR; auto with real zarith.
unfold FtoRradix; rewrite <- Fabs_correct; auto with zarith; unfold FtoR; simpl.
apply Rmult_le_compat_r; auto with real zarith; apply Rmult_le_reg_l with (IZR radix); auto with real zarith.
rewrite <- mult_IZR; rewrite <- (PosNormMin radix b t); auto with zarith.
elim Ny; intros I1 I2; rewrite Zabs_Zmult in I2; rewrite Zabs_eq in I2; auto with real zarith.
rewrite <- mult_IZR; auto with real zarith.
unfold FtoRradix, FtoR; simpl.
rewrite powerRZ_add; auto with real zarith.
rewrite powerRZ_add; auto with real zarith.
replace (IZR (nNormMin radix t)) with (powerRZ radix (t-1));[ring|idtac].
unfold nNormMin; rewrite Zpower_nat_Z_powerRZ.
rewrite inj_pred; auto with zarith; unfold Zpred; auto with real zarith.
apply FcanonicLeastExp with radix b t; auto with real zarith.
rewrite FnormalizeCorrect; auto with zarith real.
elim rDef; auto.
apply FnormalizeCanonic; auto with zarith; elim rDef; auto.
Qed.
Lemma powerRZSumRle:∀ (e1 e2:Z),
(e2≤ e1)%Z →
(powerRZ radix e1 + powerRZ radix e2 ≤ powerRZ radix (e1+1))%R.
intros.
apply Rle_trans with (powerRZ radix e1 + powerRZ radix e1)%R;
[apply Rplus_le_compat_l; apply Rle_powerRZ; auto with real zarith|idtac].
apply Rle_trans with (powerRZ radix e1×2)%R;[right; ring|rewrite powerRZ_add; auto with real zarith].
apply Rmult_le_compat_l; auto with real zarith.
simpl; ring_simplify (radix×1)%R; replace 2%R with (IZR 2); auto with real zarith.
Qed.
Lemma Boundedt1: (∃ x':float, (FtoRradix x'=r-x1×y1)%R ∧ (Fbounded b x')
∧ (Fexp x'=t-1+Fexp x+Fexp y)%Z).
unfold FtoRradix; apply BoundedL with t (Fminus radix r (Fmult x1 y1)); auto with zarith.
unfold Fminus, Fopp, Fplus, Fmult; simpl.
apply Zmin_Zle; auto with zarith.
apply rExp.
rewrite Fminus_correct; auto with zarith; rewrite Fmult_correct; auto with real zarith.
fold FtoRradix.
replace (r-x1×y1)%R with ((-e)+x1×y2+x2×y1+x2×y2)%R.
2: apply trans_eq with (-e+x×y-(x+0)*y+x1×y2+x2×y1+x2×y2)%R;[ring|idtac].
2: rewrite eeq; rewrite Xeq; rewrite Yeq; ring.
apply Rle_lt_trans with ((Rabs e)+(Rabs (x1 × y2)) + (Rabs (x2 × y1)) + (Rabs (x2 × y2)))%R.
apply Rle_trans with (1:= Rabs_triang (-e+ x1 × y2 + x2 × y1) (x2 × y2)%R).
apply Rplus_le_compat_r.
apply Rle_trans with (1:= Rabs_triang (-e+ x1 × y2) (x2 × y1)%R).
apply Rplus_le_compat_r.
apply Rle_trans with (1:= Rabs_triang (-e) (x1 × y2)%R).
rewrite Rabs_Ropp; right; ring.
generalize eLe; generalize x1y2Le; generalize x2y1Le; generalize x2y2Le; intros.
apply Rlt_le_trans with ( (powerRZ radix (t + Fexp x + Fexp y) / 2) +
(powerRZ radix (t + s + Fexp x + Fexp y) / 2 +powerRZ radix (2 × s + Fexp x + Fexp y) / 4) +
(powerRZ radix (t + s + Fexp x + Fexp y) / 2 +powerRZ radix (2 × s + Fexp x + Fexp y) / 4) +
(powerRZ radix (2 × s + Fexp x + Fexp y) / 4))%R;
auto with real.
apply Rlt_le_trans with (powerRZ radix (t + Fexp x + Fexp y) / 2 +
(powerRZ radix (t + s + Fexp x + Fexp y) / 2 +
powerRZ radix (2 × s + Fexp x + Fexp y) / 4) +
(powerRZ radix (t + s + Fexp x + Fexp y) / 2 +
powerRZ radix (2 × s + Fexp x + Fexp y) / 4) + Rabs (x2 × y2))%R; auto with real.
apply Rplus_lt_compat_r.
apply Rle_lt_trans with (powerRZ radix (t + Fexp x + Fexp y) / 2 +
(powerRZ radix (t + s + Fexp x + Fexp y) / 2 +
powerRZ radix (2 × s + Fexp x + Fexp y) / 4) + Rabs (x2 × y1))%R; auto with real.
apply Rle_trans with (powerRZ radix (t + s + Fexp x + Fexp y)+
powerRZ radix (t + Fexp x + Fexp y) / 2 +3×powerRZ radix (2 × s + Fexp x + Fexp y) / 4)%R;
[right; field; auto with real|idtac].
assert (0 < 8)%R; auto with real.
apply Rlt_le_trans with 2%R; auto with real.
apply Rle_trans with 4%R; auto with real.
apply Rle_trans with (powerRZ radix (t + s + Fexp x + Fexp y) +
powerRZ radix (t + Fexp x + Fexp y) +
powerRZ radix (2 × s + Fexp x + Fexp y))%R;
[apply Rplus_le_compat; try apply Rplus_le_compat_l |idtac].
unfold Rdiv; apply Rle_trans with (powerRZ radix (t + Fexp x + Fexp y)×1)%R;[idtac|right; ring].
apply Rmult_le_compat_l; auto with real zarith.
apply Rle_trans with (/1)%R; auto with real.
unfold Rdiv; apply Rle_trans with (powerRZ radix (2×s + Fexp x + Fexp y)×1)%R;[idtac|right; ring].
apply Rle_trans with (powerRZ radix (2×s + Fexp x + Fexp y)*(3×/4))%R;[right; ring|idtac].
apply Rmult_le_compat_l; auto with real zarith.
assert (0<4)%R.
apply Rlt_le_trans with 2%R; auto with real.
apply Rmult_le_reg_l with (4%R); auto with real.
apply Rle_trans with 3%R;[right; field|idtac]; auto with real.
apply Rle_trans with 4%R; auto with real.
replace 3%R with (INR 3); auto with real zarith.
replace 4%R with (INR 4); auto with real zarith.
simpl; ring.
simpl; ring.
apply Rle_trans with (powerRZ radix (t + s + Fexp x + Fexp y) +
powerRZ radix (t +1+ Fexp x + Fexp y) +
powerRZ radix (2 × s + Fexp x + Fexp y))%R.
apply Rplus_le_compat_r; apply Rplus_le_compat_l.
apply Rle_powerRZ; auto with real zarith.
apply Rle_trans with (powerRZ radix (t + s + Fexp x + Fexp y) +
powerRZ radix (t+1 + Fexp x + Fexp y+1))%R.
rewrite Rplus_assoc; apply Rplus_le_compat_l.
apply powerRZSumRle; auto with zarith.
apply Rle_trans with (powerRZ radix (t + s + Fexp x + Fexp y+1)).
apply powerRZSumRle; auto with zarith.
apply Rle_powerRZ; auto with real zarith.
Qed.
Lemma Boundedt2: (∃ x':float, (FtoRradix x'=r-x1×y1-x1×y2)%R ∧ (Fbounded b x')
∧ (Fexp x'=s+Fexp x+Fexp y)%Z).
elim Boundedt1; intros t1 T; elim T; intros H1 T'; elim T'; intros H2 H3; clear T T'.
unfold FtoRradix; apply BoundedL with t (Fminus radix t1 (Fmult x1 y2)); auto with zarith.
unfold Fminus, Fopp, Fplus, Fmult; simpl.
apply Zmin_Zle; auto with zarith.
rewrite Fminus_correct; auto with zarith; rewrite Fmult_correct; auto with real zarith.
fold FtoRradix; rewrite H1; ring.
fold FtoRradix; replace (r-x1×y1-x1×y2)%R with ((-e)+x2×y1+x2×y2)%R.
2: apply trans_eq with (-e+x×y-(x+0)*y+x2×y1+x2×y2)%R;[ring|idtac].
2: rewrite eeq; rewrite Xeq; rewrite Yeq; ring.
apply Rle_lt_trans with ((Rabs e) + (Rabs (x2 × y1)) + (Rabs (x2 × y2)))%R.
apply Rle_trans with (1:= Rabs_triang (-e + x2 × y1) (x2 × y2)%R).
apply Rplus_le_compat_r.
apply Rle_trans with (1:= Rabs_triang (-e) (x2 × y1)%R).
rewrite Rabs_Ropp; right; ring.
generalize eLe; generalize x2y1Le; generalize x2y2Le; intros.
apply Rle_lt_trans with
( (Rabs e + Rabs (x2 × y1)+ (powerRZ radix (2 × s + Fexp x + Fexp y) / 4)))%R; auto with real.
apply Rlt_le_trans with (Rabs e + (powerRZ radix (t + s + Fexp x + Fexp y) / 2 +
powerRZ radix (2 × s + Fexp x + Fexp y) / 4)+powerRZ radix (2 × s + Fexp x + Fexp y) / 4)%R; auto with real.
apply Rle_trans with (powerRZ radix (t + Fexp x + Fexp y) / 2+ (powerRZ radix (t + s + Fexp x + Fexp y) / 2 +
powerRZ radix (2 × s + Fexp x + Fexp y) / 4) +
powerRZ radix (2 × s + Fexp x + Fexp y) / 4)%R; auto with real.
replace (s + Fexp x + Fexp y + t)%Z with (t+s+Fexp x+Fexp y)%Z;[idtac|ring].
apply Rplus_le_reg_l with (-((powerRZ radix (t + s + Fexp x + Fexp y) / 2)))%R.
apply Rle_trans with (/2× (powerRZ radix (t + Fexp x + Fexp y)+ powerRZ radix (2 × s + Fexp x + Fexp y)))%R;
[right; field; auto with real|idtac].
apply Rle_trans with (/2× powerRZ radix (t + s + Fexp x + Fexp y))%R;[idtac|right; field; auto with real].
apply Rmult_le_compat_l; auto with real.
apply Rle_trans with (powerRZ radix (t+1 + Fexp x + Fexp y) +
powerRZ radix (2 × s + Fexp x + Fexp y))%R; auto with real zarith.
apply Rle_trans with (powerRZ radix (t+1 + Fexp x + Fexp y+1)).
apply powerRZSumRle; auto with real zarith.
apply Rle_powerRZ; auto with real zarith.
Qed.
Lemma Boundedt3: (∃ x':float, (FtoRradix x'=r-x1×y1-x1×y2-x2×y1)%R ∧ (Fbounded b x')
∧ (Fexp x'=s+Fexp x+Fexp y)%Z).
elim Boundedt2; intros t2 T; elim T; intros H1 T'; elim T'; intros H2 H3; clear T T'.
unfold FtoRradix; apply BoundedL with t (Fminus radix t2 (Fmult x2 y1)); auto with zarith.
unfold Fminus, Fopp, Fplus, Fmult; simpl.
apply Zmin_Zle; auto with zarith.
rewrite Fminus_correct; auto with zarith; rewrite Fmult_correct; auto with real zarith.
fold FtoRradix; rewrite H1; ring.
fold FtoRradix; replace (r-x1×y1-x1×y2-x2×y1)%R with ((-e)+x2×y2)%R.
2: apply trans_eq with (-e+x×y-(x+0)*y+x2×y2)%R;[ring|idtac].
2: rewrite eeq; rewrite Xeq; rewrite Yeq; ring.
apply Rle_lt_trans with ((Rabs e) + (Rabs (x2 × y2)))%R.
apply Rle_trans with (1:= Rabs_triang (-e) (x2 × y2)%R).
rewrite Rabs_Ropp; right; ring.
generalize eLe; generalize x2y2Le; intros.
apply Rle_lt_trans with
(powerRZ radix (t + Fexp x + Fexp y) / 2+powerRZ radix (2 × s + Fexp x + Fexp y) / 4)%R; auto with real.
apply Rlt_le_trans with (powerRZ radix (t + Fexp x + Fexp y) +
powerRZ radix (2 × s + Fexp x + Fexp y) / 4)%R.
apply Rplus_lt_compat_r.
apply Rlt_le_trans with (powerRZ radix (t + Fexp x + Fexp y)×1)%R;[idtac|right; ring].
unfold Rdiv; apply Rmult_lt_compat_l; auto with real zarith.
apply Rlt_le_trans with (/1)%R; auto with real.
apply Rle_trans with (powerRZ radix (t+1 + Fexp x + Fexp y) +
powerRZ radix (2 × s + Fexp x + Fexp y))%R;[apply Rplus_le_compat|idtac].
apply Rle_powerRZ; auto with real zarith.
apply Rle_trans with (powerRZ radix (2×s + Fexp x + Fexp y)×1)%R;[idtac|right; ring].
unfold Rdiv; apply Rmult_le_compat_l; auto with real zarith.
assert (0 < 4)%R;[apply Rlt_le_trans with 2%R; auto with real|idtac].
apply Rmult_le_reg_l with 4%R; auto with real.
apply Rle_trans with 1%R;[right; field|ring_simplify (4×1)%R]; auto with real.
apply Rle_trans with 2%R; auto with real.
apply Rle_trans with (powerRZ radix (t + 1 + Fexp x + Fexp y+1)).
apply powerRZSumRle; auto with zarith.
apply Rle_powerRZ; auto with real zarith.
Qed.
Lemma Boundedt4: (∃ x':float, (FtoRradix x'=r-x1×y1-x1×y2-x2×y1-x2×y2)%R ∧ (Fbounded b x')).
elim errorBoundedMult with b radix t (Closest b radix) x y r; auto with zarith.
2: apply ClosestRoundedModeP with t; auto with zarith.
2: elim Nx; auto.
2: elim Ny; auto.
intros g T; elim T; intros H1 T'; elim T'; intros; clear T T'.
∃ (Fopp g); split.
unfold FtoRradix;rewrite Fopp_correct; rewrite H1; fold FtoRradix.
rewrite Xeq; rewrite Yeq; ring.
apply oppBounded; auto.
Qed.
Lemma Boundedt4_aux: (∃ x':float, (FtoRradix x'=r-x1×y1-x1×y2-x2×y1-x2×y2)%R ∧ (Fbounded b x')
∧ (Fexp x'=Fexp x+Fexp y)%Z).
elim errorBoundedMult with b radix t (Closest b radix) x y r; auto with zarith.
2: apply ClosestRoundedModeP with t; auto with zarith.
2: elim Nx; auto.
2: elim Ny; auto.
intros g T; elim T; intros H1 T'; elim T'; intros; clear T T'.
∃ (Fopp g); split.
unfold FtoRradix;rewrite Fopp_correct; rewrite H1; fold FtoRradix.
rewrite Xeq; rewrite Yeq; ring.
split;[apply oppBounded; auto|simpl; auto].
Qed.
Hypotheses Fx1: Fbounded b' x1.
Hypotheses Fx2: Fbounded bt x2.
Hypotheses Fy1: Fbounded b' y1.
Hypotheses Fy2: Fbounded bt y2.
Hypothesis Hst3: (t ≤ s+s)%Z.
Lemma p''GivesBound: Zpos (vNum bt)=(Zpower_nat radix s).
unfold bt in |- *; unfold vNum in |- ×.
apply
trans_eq
with
(Z_of_nat
(nat_of_P
(P_of_succ_nat
(pred (Zabs_nat (Zpower_nat radix s)))))).
unfold Z_of_nat in |- *; rewrite nat_of_P_o_P_of_succ_nat_eq_succ;
auto with zarith.
rewrite nat_of_P_o_P_of_succ_nat_eq_succ; auto with arith zarith.
cut (Zabs (Zpower_nat radix s) = Zpower_nat radix s).
intros H; pattern (Zpower_nat radix s) at 2 in |- *; rewrite <- H.
rewrite Zabs_absolu.
rewrite <- (S_pred (Zabs_nat (Zpower_nat radix s)) 0);
auto with arith zarith.
apply lt_Zlt_inv; simpl in |- *; auto with zarith arith.
rewrite <- Zabs_absolu; rewrite H; auto with arith zarith.
apply Zabs_eq; auto with arith zarith.
Qed.
Lemma Boundedx1y1_aux: (∃ x':float, (FtoRradix x'=x1×y1)%R ∧ (Fbounded b x')
∧ (Fexp x'=Fexp x1+Fexp y1)%Z ).
∃ (Fmult x1 y1).
split;[unfold FtoRradix; rewrite Fmult_correct; auto with real zarith|idtac].
split.
unfold Fmult; split; simpl; auto with zarith.
rewrite Zabs_Zmult.
elim Fx1; elim Fy1; intros.
apply Zlt_le_trans with (Zpos (vNum b')×Zpos (vNum b'))%Z; auto with zarith.
case (Zle_lt_or_eq 0%Z (Zabs (Fnum x1))); auto with zarith.
intros I; apply Zlt_le_trans with (Zabs (Fnum x1) × Zpos (vNum b'))%Z; auto with zarith.
apply Zmult_lt_compat_l; auto with zarith.
intros I; rewrite <- I; auto with zarith.
unfold b'; rewrite p'GivesBound; auto with zarith.
rewrite <- Zpower_nat_is_exp.
rewrite pGivesBound; auto with zarith.
simpl; auto.
Qed.
Lemma Boundedx1y1: (∃ x':float, (FtoRradix x'=x1×y1)%R ∧ (Fbounded b x')).
elim Boundedx1y1_aux; intros f T; elim T ; intros T1 T2; elim T2; intros.
∃ f; split; auto.
Qed.
Lemma Boundedx1y2_aux: (∃ x':float, (FtoRradix x'=x1×y2)%R ∧ (Fbounded b x')
∧ (Fexp x'=Fexp x1+Fexp y2)%Z ).
∃ (Fmult x1 y2).
split;[unfold FtoRradix; rewrite Fmult_correct; auto with real zarith|idtac].
split;[idtac|simpl; auto].
unfold Fmult; split; simpl; auto with zarith.
rewrite Zabs_Zmult.
elim Fx1; elim Fy2; intros.
apply Zlt_le_trans with (Zpos (vNum b')×Zpos (vNum bt))%Z; auto with zarith.
case (Zle_lt_or_eq 0%Z (Zabs (Fnum x1))); auto with zarith.
intros I; apply Zlt_le_trans with (Zabs (Fnum x1) × Zpos (vNum bt))%Z; auto with zarith.
apply Zmult_lt_compat_l; auto with zarith.
intros I; rewrite <- I; auto with zarith.
unfold b'; rewrite p'GivesBound; auto with zarith.
rewrite p''GivesBound; auto with zarith.
rewrite <- Zpower_nat_is_exp.
rewrite pGivesBound; auto with zarith.
Qed.
Lemma Boundedx1y2: (∃ x':float, (FtoRradix x'=x1×y2)%R ∧ (Fbounded b x')).
elim Boundedx1y2_aux; intros f T; elim T ; intros T1 T2; elim T2; intros.
∃ f; split; auto.
Qed.
Lemma Boundedx2y1_aux: (∃ x':float, (FtoRradix x'=x2×y1)%R ∧ (Fbounded b x')
∧ (Fexp x'=Fexp x2+Fexp y1)%Z ).
∃ (Fmult x2 y1).
split;[unfold FtoRradix; rewrite Fmult_correct; auto with real zarith|idtac].
split;[idtac|simpl; auto].
unfold Fmult; split; simpl; auto with zarith.
rewrite Zabs_Zmult.
elim Fx2; elim Fy1; intros.
apply Zlt_le_trans with (Zpos (vNum bt)×Zpos (vNum b'))%Z; auto with zarith.
case (Zle_lt_or_eq 0%Z (Zabs (Fnum x2))); auto with zarith.
intros I; apply Zlt_le_trans with (Zabs (Fnum x2) × Zpos (vNum b'))%Z; auto with zarith.
apply Zmult_lt_compat_l; auto with zarith.
intros I; rewrite <- I; auto with zarith.
unfold b'; rewrite p'GivesBound; auto with zarith.
rewrite p''GivesBound; auto with zarith.
rewrite <- Zpower_nat_is_exp.
rewrite pGivesBound; auto with zarith.
Qed.
Lemma Boundedx2y1: (∃ x':float, (FtoRradix x'=x2×y1)%R ∧ (Fbounded b x')).
elim Boundedx2y1_aux; intros f T; elim T ; intros T1 T2; elim T2; intros.
∃ f; split; auto.
Qed.
End Sec1.
Section Algo.
Variable radix : Z.
Variable b : Fbound.
Variables t: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 pGivesBound: Zpos (vNum b)=(Zpower_nat radix t).
Hypotheses pGe: (4 ≤ t).
Variables x y p q hx tx p' q' hy ty x1y1 x1y2 x2y1 x2y2 r t1 t2 t3 t4:float.
Hypothesis Cx: (Fnormal radix b x).
Hypothesis Cy: (Fnormal radix b y).
Hypothesis Expoxy: (-dExp b ≤ Fexp x+Fexp y)%Z.
Let s:= t- div2 t.
Hypothesis A1: (Closest b radix (x*((powerRZ radix s)+1))%R p).
Hypothesis A2: (Closest b radix (x-p)%R q).
Hypothesis A3: (Closest b radix (q+p)%R hx).
Hypothesis A4: (Closest b radix (x-hx)%R tx).
Hypothesis B1: (Closest b radix (y*((powerRZ radix s)+1))%R p').
Hypothesis B2: (Closest b radix (y-p')%R q').
Hypothesis B3: (Closest b radix (q'+p')%R hy).
Hypothesis B4: (Closest b radix (y-hy)%R ty).
Hypothesis C1: (Closest b radix (hx×hy)%R x1y1).
Hypothesis C2: (Closest b radix (hx×ty)%R x1y2).
Hypothesis C3: (Closest b radix (tx×hy)%R x2y1).
Hypothesis C4: (Closest b radix (tx×ty)%R x2y2).
Hypothesis D1: (Closest b radix (x×y)%R r).
Hypothesis D2: (Closest b radix (r-x1y1)%R t1).
Hypothesis D3: (Closest b radix (t1-x1y2)%R t2).
Hypothesis D4: (Closest b radix (t2-x2y1)%R t3).
Hypothesis D5: (Closest b radix (t3-x2y2)%R t4).
Lemma SLe: (2 ≤ s)%nat.
unfold s; auto with zarith.
assert (2≤ t-div2 t)%Z; auto with zarith.
apply Zmult_le_reg_r with 2%Z; auto with zarith.
replace ((t-div2 t)*2)%Z with (2×t-2×div2 t)%Z; auto with zarith.
replace (2×div2 t)%Z with (Z_of_nat (Div2.double (div2 t))).
case (even_or_odd t); intros I.
rewrite <- even_double; auto with zarith.
apply Zle_trans with (2×t+1-(S ( Div2.double (div2 t))))%Z; auto with zarith.
rewrite <- odd_double; auto with zarith.
replace (Z_of_nat (S ( Div2.double (div2 t)))) with (1+ Div2.double (div2 t))%Z; auto with zarith.
rewrite inj_S; unfold Zsucc; auto with zarith.
unfold Div2.double; rewrite inj_plus; ring.
Qed.
Lemma SGe: (s ≤ t-2)%nat.
unfold s; auto with zarith.
assert (2≤ div2 t)%Z; auto with zarith.
apply Zmult_le_reg_r with 2%Z; auto with zarith.
replace (div2 t×2)%Z with (Z_of_nat (Div2.double (div2 t))).
case (even_or_odd t); intros I.
rewrite <- even_double; auto with zarith.
apply Zle_trans with (-1+(S ( Div2.double (div2 t))))%Z; auto with zarith.
rewrite <- odd_double; auto with zarith.
case (Zle_lt_or_eq 4 t); auto with zarith.
intros I2; absurd (odd t); auto.
intros I3; apply not_even_and_odd with t; auto.
replace t with (4%nat); auto with zarith.
apply even_S; apply odd_S; apply even_S; apply odd_S; apply even_O.
rewrite inj_S; unfold Zsucc; auto with zarith.
unfold Div2.double; rewrite inj_plus; ring.
Qed.
Lemma s2Ge: (t ≤ s + s)%Z.
unfold s.
assert (2*(div2 t) ≤ t)%Z; auto with zarith.
case (even_or_odd t); intros I.
apply Zle_trans with (Div2.double (div2 t)).
unfold Div2.double; rewrite inj_plus; auto with zarith.
rewrite <- even_double; auto with zarith.
apply Zle_trans with (-1+(S ( Div2.double (div2 t))))%Z; auto with zarith.
rewrite inj_S; unfold Zsucc; auto with zarith.
unfold Div2.double; rewrite inj_plus; auto with zarith.
rewrite <- odd_double; auto with zarith.
rewrite inj_minus1; auto with zarith.
Qed.
Lemma s2Le: (s + s ≤ t + 1)%Z.
unfold s.
rewrite inj_minus1; auto with zarith.
2: generalize (lt_div2 t); auto with zarith.
assert (t≤ 2*(div2 t)+1)%Z; auto with zarith.
case (even_or_odd t); intros I.
apply Zle_trans with ((Div2.double (div2 t)+1))%Z.
2:unfold Div2.double; rewrite inj_plus; auto with zarith.
rewrite <- even_double; auto with zarith.
apply Zle_trans with ((S ( Div2.double (div2 t))))%Z; auto with zarith.
2: rewrite inj_S; unfold Zsucc; auto with zarith.
2: unfold Div2.double; rewrite inj_plus; auto with zarith.
rewrite <- odd_double; auto with zarith.
Qed.
Theorem Dekker_aux: (∃ x':float, (FtoRradix x'=tx×ty)%R ∧ (Fbounded b x'))
→ (x×y=r-t4)%R.
intros L1.
generalize SLe; intros Sle; generalize SGe; intros Sge.
generalize s2Le; intros s2le; generalize s2Ge; intros s2ge.
generalize VeltkampU; intros V.
elim V with radix b s t x p q hx tx; auto.
2: left; auto.
intros MX1 T; elim T; intros MX2 T'; clear T; elim T'; intros T1 T2; clear T'.
elim T1; intros hx' T1'; elim T1'; intros MX3 T1''; elim T1''; intros MX4 MX5; clear T1 T1' T1''.
lapply MX5; auto; clear MX5; intros MX5.
elim T2; intros tx' T1'; elim T1'; intros MX6 T1''; elim T1''; intros MX7 MX8; clear T2 T1' T1''.
elim V with radix b s t y p' q' hy ty; auto.
2: left; auto.
intros MY1 T; elim T; intros MY2 T'; clear T; elim T'; intros T1 T2; clear T'.
elim T1; intros hy' T1'; elim T1'; intros MY3 T1''; elim T1''; intros MY4 MY5; clear T1 T1' T1''.
lapply MY5; auto; clear MY5; intros MY5.
elim T2; intros ty' T1'; elim T1'; intros MY6 T1''; elim T1''; intros MY7 MY8; clear T2 T1' T1'' V.
generalize Boundedt1; intros V.
elim V with radix b s t x hx' tx' y hy' ty' r (Fminus radix (Fmult x y) r); auto with zarith real; clear V.
2:rewrite Fminus_correct; auto with zarith; rewrite Fmult_correct; auto with zarith; ring.
2:rewrite MX6; rewrite MX3; exact MX2.
2:rewrite MY6; rewrite MY3; exact MY2.
2:rewrite MX6; replace (FtoR radix tx) with (FtoR radix x-FtoR radix hx)%R; auto with real.
2:rewrite MX2; ring.
2:rewrite MY6; replace (FtoR radix ty) with (FtoR radix y-FtoR radix hy)%R; auto with real.
2:rewrite MY2; ring.
intros t1' T; elim T; intros M11 T'; elim T'; intros M12 M13; clear T T'.
generalize Boundedt2; intros V.
elim V with radix b s t x hx' tx' y hy' ty' r (Fminus radix (Fmult x y) r); auto with zarith real; clear V.
2:rewrite Fminus_correct; auto with zarith; rewrite Fmult_correct; auto with zarith; ring.
2:rewrite MX6; rewrite MX3; exact MX2.
2:rewrite MY6; rewrite MY3; exact MY2.
2:rewrite MX6; replace (FtoR radix tx) with (FtoR radix x-FtoR radix hx)%R; auto with real.
2:rewrite MX2; ring.
2:rewrite MY6; replace (FtoR radix ty) with (FtoR radix y-FtoR radix hy)%R; auto with real.
2:rewrite MY2; ring.
intros t2' T; elim T; intros M21 T'; elim T'; intros M22 M23; clear T T'.
generalize Boundedt3; intros V.
elim V with radix b s t x hx' tx' y hy' ty' r (Fminus radix (Fmult x y) r); auto with zarith real; clear V.
2:rewrite Fminus_correct; auto with zarith; rewrite Fmult_correct; auto with zarith; ring.
2:rewrite MX6; rewrite MX3; exact MX2.
2:rewrite MY6; rewrite MY3; exact MY2.
2:rewrite MX6; replace (FtoR radix tx) with (FtoR radix x-FtoR radix hx)%R; auto with real.
2:rewrite MX2; ring.
2:rewrite MY6; replace (FtoR radix ty) with (FtoR radix y-FtoR radix hy)%R; auto with real.
2:rewrite MY2; ring.
intros t3' T; elim T; intros M31 T'; elim T'; intros M32 M33; clear T T'.
generalize Boundedt4; intros V.
elim V with radix b s t x hx' tx' y hy' ty' r ; auto with zarith real; clear V.
2:rewrite MX6; rewrite MX3; exact MX2.
2:rewrite MY6; rewrite MY3; exact MY2.
intros t4' T; elim T; intros M41 M42; clear T.
cut (FtoRradix t4=r-x×y)%R; auto with real.
intros V; rewrite V; ring.
apply sym_eq.
apply trans_eq with (FtoRradix t4').
unfold FtoRradix; rewrite M41; rewrite MX2; rewrite MY2.
rewrite MX3; rewrite MX6; rewrite MY3; rewrite MY6; ring.
unfold FtoRradix; apply RoundedModeProjectorIdemEq with b t (Closest b radix); auto with zarith.
apply ClosestRoundedModeP with t; auto with zarith.
replace (FtoR radix t4') with (t3 - x2y2)%R; auto.
replace (FtoRradix t3) with (FtoRradix t3').
replace (FtoRradix x2y2) with (tx×ty)%R.
unfold FtoRradix; rewrite M31; rewrite M41.
rewrite <- MY6; rewrite <- MX6; ring.
elim L1; intros v T; elim T; intros L2 L3.
rewrite <- L2; unfold FtoRradix.
apply RoundedModeProjectorIdemEq with b t (Closest b radix); auto with zarith.
apply ClosestRoundedModeP with t; auto with zarith.
replace (FtoR radix v) with (tx×ty)%R; auto with real.
unfold FtoRradix; apply RoundedModeProjectorIdemEq with b t (Closest b radix); auto with zarith.
apply ClosestRoundedModeP with t; auto with zarith.
replace (FtoR radix t3') with (t2-x2y1)%R; auto with real.
replace (FtoRradix t2) with (FtoRradix t2').
replace (FtoRradix x2y1) with (tx×hy)%R.
unfold FtoRradix; rewrite M21; rewrite M31.
rewrite <- MX6; rewrite <- MY3; ring.
elim Boundedx2y1 with radix b s t x tx' y hy'; auto with zarith.
intros v T; elim T; intros L2 L3.
apply trans_eq with (FtoR radix v).
unfold FtoRradix; rewrite L2; rewrite MX6; rewrite MY3; ring.
unfold FtoRradix; apply RoundedModeProjectorIdemEq with b t (Closest b radix); auto with zarith.
apply ClosestRoundedModeP with t; auto with zarith.
replace (FtoR radix v) with (tx×hy)%R; auto with real.
unfold FtoRradix; rewrite L2; rewrite MX6; rewrite MY3; ring.
unfold FtoRradix; apply RoundedModeProjectorIdemEq with b t (Closest b radix); auto with zarith.
apply ClosestRoundedModeP with t; auto with zarith.
replace (FtoR radix t2') with (t1-x1y2)%R; auto with real.
replace (FtoRradix t1) with (FtoRradix t1').
replace (FtoRradix x1y2) with (hx×ty)%R.
unfold FtoRradix; rewrite M21; rewrite M11.
rewrite <- MX3; rewrite <- MY6; ring.
elim Boundedx1y2 with radix b s t x hx' y ty'; auto with zarith.
intros v T; elim T; intros L2 L3; clear T.
apply trans_eq with (FtoR radix v).
unfold FtoRradix; rewrite L2; rewrite MY6; rewrite MX3; ring.
unfold FtoRradix; apply RoundedModeProjectorIdemEq with b t (Closest b radix); auto with zarith.
apply ClosestRoundedModeP with t; auto with zarith.
replace (FtoR radix v) with (hx×ty)%R; auto with real.
unfold FtoRradix; rewrite L2; rewrite MY6; rewrite MX3; ring.
unfold FtoRradix; apply RoundedModeProjectorIdemEq with b t (Closest b radix); auto with zarith.
apply ClosestRoundedModeP with t; auto with zarith.
replace (FtoR radix t1') with (r-x1y1)%R; auto with real.
replace (FtoRradix x1y1) with (hx×hy)%R.
unfold FtoRradix; rewrite M11; rewrite MY3; rewrite MX3; ring.
elim Boundedx1y1 with radix b s t x hx' y hy'; auto with zarith.
intros v T; elim T; intros L2 L3; clear T.
apply trans_eq with (FtoR radix v).
unfold FtoRradix; rewrite L2; rewrite MY3; rewrite MX3; ring.
unfold FtoRradix; apply RoundedModeProjectorIdemEq with b t (Closest b radix); auto with zarith.
apply ClosestRoundedModeP with t; auto with zarith.
replace (FtoR radix v) with (hx×hy)%R; auto with real.
unfold FtoRradix; rewrite L2; rewrite MY3; rewrite MX3; ring.
Qed.
Theorem Boundedx2y2: (radix=2)%Z ∨ (even t) →
(∃ x':float, (FtoRradix x'=tx×ty)%R ∧ (Fbounded b x') ∧ (Fexp x+Fexp y ≤ Fexp x')%Z).
intros H; case H; clear H; intros H.
generalize SLe; intros Sle; generalize SGe; intros Sge.
elim Veltkamp_tail2 with radix b s t x p q hx tx; auto.
2: elim Cx; auto.
intros x2 T; elim T; intros G1 T'; elim T'; intros G2 T''; elim T''; intros G3 G4; clear T T' T''.
elim Veltkamp_tail2 with radix b s t y p' q' hy ty; auto.
2: elim Cy; auto.
intros y2 T; elim T; intros J1 T'; elim T'; intros J2 T''; elim T''; intros J3 J4; clear T T' T''.
∃ (Fmult x2 y2).
split;[unfold FtoRradix; rewrite Fmult_correct; auto with real zarith|idtac].
rewrite G1; rewrite J1; ring.
split.
unfold Fmult; split; simpl; auto with zarith.
rewrite Zabs_Zmult.
elim J3; elim G3; replace (Zpos
(vNum
(Bound
(P_of_succ_nat (pred (Zabs_nat (Zpower_nat radix (s - 1)))))
(dExp b))))%Z with (Zpower_nat radix (s - 1)); intros.
apply Zlt_le_trans with (Zpower_nat radix (s - 1)×Zpower_nat radix (s - 1))%Z; auto with zarith.
case (Zle_lt_or_eq 0%Z (Zabs (Fnum x2))); auto with zarith.
intros I; apply Zlt_le_trans with (Zabs (Fnum x2) × Zpower_nat radix (s-1))%Z; auto with zarith.
apply Zmult_lt_compat_l; auto with zarith.
intros I; rewrite <- I; auto with zarith.
rewrite pGivesBound; rewrite <- Zpower_nat_is_exp; auto with zarith.
assert ((s-1+(s-1)) ≤ t)%Z; auto with zarith.
generalize s2Le; auto with zarith.
apply sym_eq; unfold vNum in |- ×.
apply
trans_eq
with
(Z_of_nat
(nat_of_P
(P_of_succ_nat
(pred (Zabs_nat (Zpower_nat radix (s-1))))))).
unfold Z_of_nat in |- *; rewrite nat_of_P_o_P_of_succ_nat_eq_succ;
auto with zarith.
rewrite nat_of_P_o_P_of_succ_nat_eq_succ; auto with arith zarith.
cut (Zabs (Zpower_nat radix (s-1)) = Zpower_nat radix (s-1)).
intros HA; pattern (Zpower_nat radix (s-1)) at 2 in |- *; rewrite <- HA.
rewrite Zabs_absolu.
rewrite <- (S_pred (Zabs_nat (Zpower_nat radix (s-1))) 0);
auto with arith zarith.
apply lt_Zlt_inv; simpl in |- *; auto with zarith arith.
rewrite <- Zabs_absolu; rewrite HA; auto with arith zarith.
apply Zabs_eq; auto with arith zarith.
apply Zle_trans with (Fexp (Fnormalize radix b t x)+Fexp (Fnormalize radix b t y))%Z; auto with zarith.
rewrite FcanonicFnormalizeEq; auto with zarith.
rewrite FcanonicFnormalizeEq; auto with zarith.
left; auto.
left; auto.
apply Zle_trans with (Fexp (Fnormalize radix b t x)+Fexp (Fnormalize radix b t y))%Z; simpl; auto with zarith.
rewrite FcanonicFnormalizeEq; auto with zarith.
rewrite FcanonicFnormalizeEq; auto with zarith.
left; auto.
left; auto.
generalize SLe; intros Sle; generalize SGe; intros Sge.
elim Veltkamp_tail with radix b s t x p q hx tx; auto.
2: elim Cx; auto.
intros x2 T; elim T; intros G1 T'; elim T'; intros G2 T''; elim T''; intros G3 G4; clear T T' T''.
elim Veltkamp_tail with radix b s t y p' q' hy ty; auto.
2: elim Cy; auto.
intros y2 T; elim T; intros J1 T'; elim T'; intros J2 T''; elim T''; intros J3 J4; clear T T' T''.
∃ (Fmult x2 y2).
split;[unfold FtoRradix; rewrite Fmult_correct; auto with real zarith|idtac].
rewrite G1; rewrite J1; auto with real.
split.
unfold Fmult; split; simpl; auto with zarith.
rewrite Zabs_Zmult.
elim J3; elim G3; replace (Zpos
(vNum
(Bound
(P_of_succ_nat (pred (Zabs_nat (Zpower_nat radix (s)))))
(dExp b))))%Z with (Zpower_nat radix (s)); intros.
apply Zlt_le_trans with (Zpower_nat radix s×Zpower_nat radix s)%Z; auto with zarith.
case (Zle_lt_or_eq 0%Z (Zabs (Fnum x2))); auto with zarith.
intros I; apply Zlt_le_trans with (Zabs (Fnum x2) × Zpower_nat radix s)%Z; auto with zarith.
apply Zmult_lt_compat_l; auto with zarith.
intros I; rewrite <- I; auto with zarith.
rewrite <- Zpower_nat_is_exp; rewrite pGivesBound; auto with zarith.
assert (2×s ≤ t)%Z; auto with zarith.
unfold s.
rewrite inj_minus1; auto with zarith.
assert (t ≤ 2*(div2 t))%Z; auto with zarith.
apply Zle_trans with (Div2.double (div2 t)).
2: unfold Div2.double; rewrite inj_plus; auto with zarith.
rewrite <- even_double; auto with zarith.
generalize (lt_div2 t); auto with zarith.
rewrite p''GivesBound; auto.
apply Zle_trans with (Fexp (Fnormalize radix b t x)+Fexp (Fnormalize radix b t y))%Z; auto with zarith.
rewrite FcanonicFnormalizeEq; auto with zarith.
rewrite FcanonicFnormalizeEq; auto with zarith.
left; auto.
left; auto.
apply Zle_trans with (Fexp (Fnormalize radix b t x)+Fexp (Fnormalize radix b t y))%Z; auto with zarith.
rewrite FcanonicFnormalizeEq; auto with zarith.
rewrite FcanonicFnormalizeEq; auto with zarith.
left; auto.
left; auto.
simpl; auto with zarith.
Qed.
Theorem DekkerN: (radix=2)%Z ∨ (even t) → (x×y=r-t4)%R.
intros H; apply Dekker_aux.
elim Boundedx2y2; auto.
intros f T; ∃ f; intuition.
Qed.
End Algo.
Section AlgoS1.
Variable radix : Z.
Variable b : Fbound.
Variables t: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 pGivesBound: Zpos (vNum b)=(Zpower_nat radix t).
Hypotheses pGe: (4 ≤ t).
Variables x y p q hx tx p' q' hy ty x1y1 x1y2 x2y1 x2y2 r t1 t2 t3 t4:float.
Hypothesis Cx: (Fnormal radix b x).
Hypothesis Cy: (Fsubnormal radix b y).
Hypothesis Expoxy: (-dExp b ≤ Fexp x+Fexp y)%Z.
Let s:= t- div2 t.
Hypothesis A1: (Closest b radix (x*((powerRZ radix s)+1))%R p).
Hypothesis A2: (Closest b radix (x-p)%R q).
Hypothesis A3: (Closest b radix (q+p)%R hx).
Hypothesis A4: (Closest b radix (x-hx)%R tx).
Hypothesis B1: (Closest b radix (y*((powerRZ radix s)+1))%R p').
Hypothesis B2: (Closest b radix (y-p')%R q').
Hypothesis B3: (Closest b radix (q'+p')%R hy).
Hypothesis B4: (Closest b radix (y-hy)%R ty).
Hypothesis C1: (Closest b radix (hx×hy)%R x1y1).
Hypothesis C2: (Closest b radix (hx×ty)%R x1y2).
Hypothesis C3: (Closest b radix (tx×hy)%R x2y1).
Hypothesis C4: (Closest b radix (tx×ty)%R x2y2).
Hypothesis D1: (Closest b radix (x×y)%R r).
Hypothesis D2: (Closest b radix (r-x1y1)%R t1).
Hypothesis D3: (Closest b radix (t1-x1y2)%R t2).
Hypothesis D4: (Closest b radix (t2-x2y1)%R t3).
Hypothesis D5: (Closest b radix (t3-x2y2)%R t4).
Theorem DekkerS1: (radix=2)%Z ∨ (even t) → (x×y=r-t4)%R.
intros H; unfold FtoRradix.
case (Req_dec 0%R y); intros Ny.
cut (FtoRradix r=0)%R;[intros Z1|idtac].
cut (FtoRradix t4=0)%R;[intros Z2|idtac].
fold FtoRradix; rewrite Z1; rewrite Z2; rewrite <- Ny; ring.
cut (FtoRradix hy=0)%R;[intros Z3|idtac].
cut (FtoRradix ty=0)%R;[intros Z4|idtac].
unfold FtoRradix; apply ClosestZero with b t (t3-x2y2)%R; auto with zarith.
cut (FtoRradix t3=0)%R;[intros Z5|idtac].
cut (FtoRradix x2y2=0)%R;[intros Z6|idtac].
rewrite Z5; rewrite Z6; ring.
unfold FtoRradix; apply ClosestZero with b t (tx×ty)%R; auto with zarith.
rewrite Z4; ring.
unfold FtoRradix; apply ClosestZero with b t (t2-x2y1)%R; auto with zarith.
cut (FtoRradix t2=0)%R;[intros Z5|idtac].
cut (FtoRradix x2y1=0)%R;[intros Z6|idtac].
rewrite Z5; rewrite Z6; ring.
unfold FtoRradix; apply ClosestZero with b t (tx×hy)%R; auto with zarith.
rewrite Z3; ring.
unfold FtoRradix; apply ClosestZero with b t (t1-x1y2)%R; auto with zarith.
cut (FtoRradix t1=0)%R;[intros Z5|idtac].
cut (FtoRradix x1y2=0)%R;[intros Z6|idtac].
rewrite Z5; rewrite Z6; ring.
unfold FtoRradix; apply ClosestZero with b t (hx×ty)%R; auto with zarith.
rewrite Z4; ring.
unfold FtoRradix; apply ClosestZero with b t (r-x1y1)%R; auto with zarith.
cut (FtoRradix x1y1=0)%R;[intros Z6|idtac].
rewrite Z1; rewrite Z6; ring.
unfold FtoRradix; apply ClosestZero with b t (hx×hy)%R; auto with zarith.
rewrite Z3; ring.
elim VeltkampU with radix b s t y p' q' hy ty; auto.
intros T1 T; elim T; intros H' T'; clear T1 T T'.
fold FtoRradix in H'; rewrite Z3 in H'; rewrite <- Ny in H'; auto with real.
apply trans_eq with (0+ty)%R; auto with real.
unfold s; apply SLe; auto.
unfold s; apply SGe; auto.
right; auto.
elim Veltkamp with radix b s t y p' q' hy; auto.
intros T1 T; elim T; intros hy' T'; elim T'; intros G1 T''; elim T''; intros ; clear T1 T T' T''.
unfold FtoRradix; rewrite <- G1.
apply ClosestZero with (Bound (P_of_succ_nat (pred (Zabs_nat (Zpower_nat radix (t - s)))))
(dExp b)) (t-s) (FtoR radix y)%R; auto with zarith.
apply p'GivesBound; auto with zarith.
assert (s ≤ t - 2)%Z; auto with zarith.
assert (s ≤ t - 2)%nat; auto with zarith.
unfold s; apply SGe; auto.
unfold s; apply SLe; auto.
unfold s; apply SGe; auto.
elim Cy; auto.
unfold FtoRradix; apply ClosestZero with b t (x×y)%R; auto with zarith.
rewrite <- Ny; ring.
elim bimplybplusNorm with radix b s t y; auto.
2: unfold s; apply SLe; auto.
2: unfold s; apply SGe; auto.
2: elim Cy; auto.
intros yy T; elim T; intros X1 X2; clear T.
rewrite <- X1.
assert (Fnormal radix (plusExp t b) x).
elim Cx; intros F1 F2; elim F1; intros.
split;[split|idtac]; unfold plusExp; simpl; auto with zarith.
cut (∀ (x:N) (y:positive), (x+(Zpos y)=(x +Npos y)%N)%Z).
intros T; simpl; rewrite <- T; auto with zarith.
apply Zle_trans with (-(dExp b))%Z; auto with zarith.
apply Zle_trans with (-(dExp b) + Zneg (P_of_succ_nat (pred (pred t))))%Z; auto with zarith.
apply Zeq_le; ring_simplify; auto with zarith.
apply Zle_trans with (-(dExp b)+0)%Z; auto with zarith.
intros;unfold Nplus.
case x0; auto with zarith.
assert (- dExp (plusExp t b) ≤ Fexp x + Fexp yy)%Z.
elim X2; intros F1 F2; elim F1; intros.
assert (0 ≤ Fexp x)%Z; auto with zarith.
apply Zplus_le_reg_l with (Fexp y).
rewrite (Zplus_comm (Fexp y) (Fexp x)); apply Zle_trans with (2:=Expoxy).
elim Cy; intros F1' F2'; elim F2'; auto with zarith.
assert (Closest (plusExp t b) radix
(FtoR radix x × (powerRZ radix (t - div2 t)%nat + 1)) p).
cut (FtoR radix x × (powerRZ radix (t - div2 t)%nat + 1) =
(FtoRradix (Fmult x (Float (Zpower_nat radix (t - div2 t)%nat + 1) 0))))%R.
intros K'; rewrite K'.
unfold FtoRradix; apply Closestbbplus with 2 t; auto with zarith.
unfold Fmult; simpl.
assert (K:Fbounded b x);[elim Cx; auto|elim K; auto with zarith].
fold FtoRradix; rewrite <- K'; auto with real.
unfold FtoRradix; rewrite Fmult_correct; auto.
unfold FtoR; simpl; rewrite plus_IZR; rewrite Zpower_nat_Z_powerRZ; simpl;ring.
assert (Closest (plusExp t b) radix (FtoR radix x - FtoR radix p) q).
rewrite <- Fminus_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fminus; simpl; apply Zmin_Zle.
assert (K:Fbounded b x);[elim Cx; auto|elim K; auto with zarith].
assert (K:Fbounded b p);[elim A1; auto|elim K; auto with zarith].
rewrite Fminus_correct; auto.
assert (Closest (plusExp t b) radix (FtoR radix q + FtoR radix p) hx).
rewrite <- Fplus_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fplus; simpl; apply Zmin_Zle.
assert (K:Fbounded b q);[elim A2; auto|elim K; auto with zarith].
assert (K:Fbounded b p);[elim A1; auto|elim K; auto with zarith].
rewrite Fplus_correct; auto.
assert (Closest (plusExp t b) radix (FtoR radix x - FtoR radix hx) tx).
rewrite <- Fminus_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fminus; simpl; apply Zmin_Zle.
assert (K:Fbounded b x);[elim Cx; auto|elim K; auto with zarith].
assert (K:Fbounded b hx);[elim A3; auto|elim K; auto with zarith].
rewrite Fminus_correct; auto.
assert (Closest (plusExp t b) radix (FtoR radix yy × (powerRZ radix (t - div2 t)%nat + 1)) p').
rewrite X1; cut (FtoR radix y × (powerRZ radix (t - div2 t)%nat + 1) =
(FtoRradix (Fmult y (Float (Zpower_nat radix (t - div2 t)%nat + 1) 0))))%R.
intros K'; rewrite K'.
unfold FtoRradix; apply Closestbbplus with 2 t; auto with zarith.
unfold Fmult; simpl.
assert (K:Fbounded b y);[elim Cy; auto|elim K; auto with zarith].
fold FtoRradix; rewrite <- K'; auto with real.
unfold FtoRradix; rewrite Fmult_correct; auto.
unfold FtoR; simpl; rewrite plus_IZR; rewrite Zpower_nat_Z_powerRZ; simpl; ring.
assert (Closest (plusExp t b) radix (FtoR radix yy - FtoR radix p') q').
rewrite X1; rewrite <- Fminus_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fminus; simpl; apply Zmin_Zle.
assert (K:Fbounded b y);[elim Cy; auto|elim K; auto with zarith].
assert (K:Fbounded b p');[elim B1; auto|elim K; auto with zarith].
rewrite Fminus_correct; auto.
assert (Closest (plusExp t b) radix (FtoR radix q' + FtoR radix p') hy).
rewrite <- Fplus_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fplus; simpl; apply Zmin_Zle.
assert (K:Fbounded b q');[elim B2; auto|elim K; auto with zarith].
assert (K:Fbounded b p');[elim B1; auto|elim K; auto with zarith].
rewrite Fplus_correct; auto.
assert (Closest (plusExp t b) radix (FtoR radix yy - FtoR radix hy) ty).
rewrite X1; rewrite <- Fminus_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fminus; simpl; apply Zmin_Zle.
assert (K:Fbounded b y);[elim Cy; auto|elim K; auto with zarith].
assert (K:Fbounded b hy);[elim B3; auto|elim K; auto with zarith].
rewrite Fminus_correct; auto.
generalize VeltkampU; intros V.
elim V with radix b s t x p q hx tx; auto.
2: unfold s; apply SLe; auto.
2: unfold s; apply SGe; auto.
2: left; auto.
intros M1 T; elim T; intros M2 T'; elim T'; intros T1 T2; clear T T'.
elim T1; intros hx' T1'; elim T1'; intros M3 T; elim T; intros M4 T'; clear T1 T1' T.
lapply T'; auto; intros M5; clear T'.
elim T2; intros tx' T1'; elim T1'; intros M6 T; elim T; intros M7 M8; clear T2 T1' T V.
elim Veltkamp_tail with radix b s t y p' q' hy ty; auto.
2: unfold s; apply SLe; auto.
2: unfold s; apply SGe; auto.
2: elim Cy; auto.
intros ty' T1'; elim T1'; intros N5 T; elim T; intros N7 T'; elim T'; intros N8 N9; clear T1' T T'.
rewrite FcanonicFnormalizeEq in N9; auto with zarith;[idtac|right; auto].
assert (Fexp y ≤ Fexp hy)%Z.
elim Cy; intros T1 T2; elim T2; intros T3 T4; rewrite T3.
elim B3; intros G1 G2; elim G1; auto.
apply DekkerN with (plusExp t b) t p q hx tx p' q' hy ty x1y1 x1y2 x2y1 x2y2 t1 t2 t3; auto.
rewrite <- M3.
rewrite <- Fmult_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fmult; simpl; auto with zarith.
rewrite Fmult_correct; auto with real; rewrite M3; auto.
rewrite <- M3; rewrite <- N5.
rewrite <- Fmult_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fmult; simpl; auto with zarith.
rewrite Fmult_correct; auto with real; rewrite M3; rewrite N5; auto.
rewrite <- M6.
rewrite <- Fmult_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fmult; simpl; auto with zarith.
rewrite Fmult_correct; auto with real; rewrite M6; auto.
rewrite <- M6; rewrite <- N5.
rewrite <- Fmult_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fmult; simpl; auto with zarith.
rewrite Fmult_correct; auto with real; rewrite M6; rewrite N5; auto.
rewrite X1.
rewrite <- Fmult_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
rewrite Fmult_correct; auto with real.
rewrite <- Fminus_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fminus; simpl; apply Zmin_Zle.
assert (K:Fbounded b r);[elim D1; auto|elim K; auto with zarith].
assert (K:Fbounded b x1y1);[elim C1; auto|elim K; auto with zarith].
rewrite Fminus_correct; auto.
rewrite <- Fminus_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fminus; simpl; apply Zmin_Zle.
assert (K:Fbounded b t1);[elim D2; auto|elim K; auto with zarith].
assert (K:Fbounded b x1y2);[elim C2; auto|elim K; auto with zarith].
rewrite Fminus_correct; auto.
rewrite <- Fminus_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fminus; simpl; apply Zmin_Zle.
assert (K:Fbounded b t2);[elim D3; auto|elim K; auto with zarith].
assert (K:Fbounded b x2y1);[elim C3; auto|elim K; auto with zarith].
rewrite Fminus_correct; auto.
rewrite <- Fminus_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fminus; simpl; apply Zmin_Zle.
assert (K:Fbounded b t3);[elim D4; auto|elim K; auto with zarith].
assert (K:Fbounded b x2y2);[elim C4; auto|elim K; auto with zarith].
rewrite Fminus_correct; auto.
Qed.
End AlgoS1.
Section AlgoS2.
Variable radix : Z.
Variable b : Fbound.
Variables t: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 pGivesBound: Zpos (vNum b)=(Zpower_nat radix t).
Hypotheses pGe: (4 ≤ t).
Variables x y p q hx tx p' q' hy ty x1y1 x1y2 x2y1 x2y2 r t1 t2 t3 t4:float.
Hypothesis Cx: (Fsubnormal radix b x).
Hypothesis Cy: (Fnormal radix b y).
Hypothesis Expoxy: (-dExp b ≤ Fexp x+Fexp y)%Z.
Let s:= t- div2 t.
Hypothesis A1: (Closest b radix (x*((powerRZ radix s)+1))%R p).
Hypothesis A2: (Closest b radix (x-p)%R q).
Hypothesis A3: (Closest b radix (q+p)%R hx).
Hypothesis A4: (Closest b radix (x-hx)%R tx).
Hypothesis B1: (Closest b radix (y*((powerRZ radix s)+1))%R p').
Hypothesis B2: (Closest b radix (y-p')%R q').
Hypothesis B3: (Closest b radix (q'+p')%R hy).
Hypothesis B4: (Closest b radix (y-hy)%R ty).
Hypothesis C1: (Closest b radix (hx×hy)%R x1y1).
Hypothesis C2: (Closest b radix (hx×ty)%R x1y2).
Hypothesis C3: (Closest b radix (tx×hy)%R x2y1).
Hypothesis C4: (Closest b radix (tx×ty)%R x2y2).
Hypothesis D1: (Closest b radix (x×y)%R r).
Hypothesis D2: (Closest b radix (r-x1y1)%R t1).
Hypothesis D3: (Closest b radix (t1-x1y2)%R t2).
Hypothesis D4: (Closest b radix (t2-x2y1)%R t3).
Hypothesis D5: (Closest b radix (t3-x2y2)%R t4).
Theorem DekkerS2: (radix=2)%Z ∨ (even t) → (x×y=r-t4)%R.
intros H; unfold FtoRradix.
case (Req_dec 0%R x); intros Ny.
cut (FtoRradix r=0)%R;[intros Z1|idtac].
cut (FtoRradix t4=0)%R;[intros Z2|idtac].
fold FtoRradix; rewrite Z1; rewrite Z2; rewrite <- Ny; ring.
cut (FtoRradix hx=0)%R;[intros Z3|idtac].
cut (FtoRradix tx=0)%R;[intros Z4|idtac].
unfold FtoRradix; apply ClosestZero with b t (t3-x2y2)%R; auto with zarith.
cut (FtoRradix t3=0)%R;[intros Z5|idtac].
cut (FtoRradix x2y2=0)%R;[intros Z6|idtac].
rewrite Z5; rewrite Z6; ring.
unfold FtoRradix; apply ClosestZero with b t (tx×ty)%R; auto with zarith.
rewrite Z4; ring.
unfold FtoRradix; apply ClosestZero with b t (t2-x2y1)%R; auto with zarith.
cut (FtoRradix t2=0)%R;[intros Z5|idtac].
cut (FtoRradix x2y1=0)%R;[intros Z6|idtac].
rewrite Z5; rewrite Z6; ring.
unfold FtoRradix; apply ClosestZero with b t (tx×hy)%R; auto with zarith.
rewrite Z4; ring.
unfold FtoRradix; apply ClosestZero with b t (t1-x1y2)%R; auto with zarith.
cut (FtoRradix t1=0)%R;[intros Z5|idtac].
cut (FtoRradix x1y2=0)%R;[intros Z6|idtac].
rewrite Z5; rewrite Z6; ring.
unfold FtoRradix; apply ClosestZero with b t (hx×ty)%R; auto with zarith.
rewrite Z3; ring.
unfold FtoRradix; apply ClosestZero with b t (r-x1y1)%R; auto with zarith.
cut (FtoRradix x1y1=0)%R;[intros Z6|idtac].
rewrite Z1; rewrite Z6; ring.
unfold FtoRradix; apply ClosestZero with b t (hx×hy)%R; auto with zarith.
rewrite Z3; ring.
elim VeltkampU with radix b s t x p q hx tx; auto.
intros T1 T; elim T; intros H' T'; clear T1 T T'.
fold FtoRradix in H'; rewrite Z3 in H'; rewrite <- Ny in H'; auto with real.
apply trans_eq with (0+tx)%R; auto with real.
unfold s; apply SLe; auto.
unfold s; apply SGe; auto.
right; auto.
elim Veltkamp with radix b s t x p q hx; auto.
intros T1 T; elim T; intros hy' T'; elim T'; intros G1 T''; elim T''; intros ; clear T1 T T' T''.
unfold FtoRradix; rewrite <- G1.
apply ClosestZero with (Bound (P_of_succ_nat (pred (Zabs_nat (Zpower_nat radix (t - s)))))
(dExp b)) (t-s) (FtoR radix x)%R; auto with zarith.
apply p'GivesBound; auto with zarith.
assert (s ≤ t - 2)%Z; auto with zarith.
assert (s ≤ t - 2)%nat; auto with zarith.
unfold s; apply SGe; auto.
unfold s; apply SLe; auto.
unfold s; apply SGe; auto.
elim Cx; auto.
unfold FtoRradix; apply ClosestZero with b t (x×y)%R; auto with zarith.
rewrite <- Ny; ring.
elim bimplybplusNorm with radix b s t x; auto.
2: unfold s; apply SLe; auto.
2: unfold s; apply SGe; auto.
2: elim Cx; auto.
intros xx T; elim T; intros X1 X2; clear T.
rewrite <- X1.
assert (Fnormal radix (plusExp t b) y).
elim Cy; intros F1 F2; elim F1; intros.
split;[split|idtac]; unfold plusExp; simpl; auto with zarith.
cut (∀ (x:N) (y:positive), (x+(Zpos y)=(x +Npos y)%N)%Z).
intros T; simpl; rewrite <- T; auto with zarith.
apply Zle_trans with (-(dExp b))%Z; auto with zarith.
apply Zle_trans with (-(dExp b) + Zneg (P_of_succ_nat (pred (pred t))))%Z; auto with zarith.
apply Zeq_le; ring_simplify; auto with zarith.
apply Zle_trans with (-(dExp b)+0)%Z; auto with zarith.
intros;unfold Nplus.
case x0; auto with zarith.
assert (- dExp (plusExp t b) ≤ Fexp xx + Fexp y)%Z.
elim X2; intros F1 F2; elim F1; intros.
assert (0 ≤ Fexp y)%Z; auto with zarith.
apply Zplus_le_reg_l with (Fexp x).
apply Zle_trans with (2:=Expoxy).
elim Cx; intros F1' F2'; elim F2'; auto with zarith.
assert (Closest (plusExp t b) radix
(FtoR radix y × (powerRZ radix (t - div2 t)%nat + 1)) p').
cut (FtoR radix y × (powerRZ radix (t - div2 t)%nat + 1) =
(FtoRradix (Fmult y (Float (Zpower_nat radix (t - div2 t)%nat + 1) 0))))%R.
intros K'; rewrite K'.
unfold FtoRradix; apply Closestbbplus with 2 t; auto with zarith.
unfold Fmult; simpl.
assert (K:Fbounded b y);[elim Cy; auto|elim K; auto with zarith].
fold FtoRradix; rewrite <- K'; auto with real.
unfold FtoRradix; rewrite Fmult_correct; auto.
unfold FtoR; simpl; rewrite plus_IZR; rewrite Zpower_nat_Z_powerRZ; simpl; ring.
assert (Closest (plusExp t b) radix (FtoR radix y - FtoR radix p') q').
rewrite <- Fminus_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fminus; simpl; apply Zmin_Zle.
assert (K:Fbounded b y);[elim Cy; auto|elim K; auto with zarith].
assert (K:Fbounded b p');[elim B1; auto|elim K; auto with zarith].
rewrite Fminus_correct; auto.
assert (Closest (plusExp t b) radix (FtoR radix q' + FtoR radix p') hy).
rewrite <- Fplus_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fplus; simpl; apply Zmin_Zle.
assert (K:Fbounded b q');[elim B2; auto|elim K; auto with zarith].
assert (K:Fbounded b p');[elim B1; auto|elim K; auto with zarith].
rewrite Fplus_correct; auto.
assert (Closest (plusExp t b) radix (FtoR radix y - FtoR radix hy) ty).
rewrite <- Fminus_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fminus; simpl; apply Zmin_Zle.
assert (K:Fbounded b y);[elim Cy; auto|elim K; auto with zarith].
assert (K:Fbounded b hy);[elim B3; auto|elim K; auto with zarith].
rewrite Fminus_correct; auto.
assert (Closest (plusExp t b) radix (FtoR radix xx × (powerRZ radix (t - div2 t)%nat + 1)) p).
rewrite X1; cut (FtoR radix x × (powerRZ radix (t - div2 t)%nat + 1) =
(FtoRradix (Fmult x (Float (Zpower_nat radix (t - div2 t)%nat + 1) 0))))%R.
intros K'; rewrite K'.
unfold FtoRradix; apply Closestbbplus with 2 t; auto with zarith.
unfold Fmult; simpl.
assert (K:Fbounded b x);[elim Cx; auto|elim K; auto with zarith].
fold FtoRradix; rewrite <- K'; auto with real.
unfold FtoRradix; rewrite Fmult_correct; auto.
unfold FtoR; simpl; rewrite plus_IZR; rewrite Zpower_nat_Z_powerRZ; simpl; ring.
assert (Closest (plusExp t b) radix (FtoR radix xx - FtoR radix p) q).
rewrite X1; rewrite <- Fminus_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fminus; simpl; apply Zmin_Zle.
assert (K:Fbounded b x);[elim Cx; auto|elim K; auto with zarith].
assert (K:Fbounded b p);[elim A1; auto|elim K; auto with zarith].
rewrite Fminus_correct; auto.
assert (Closest (plusExp t b) radix (FtoR radix q + FtoR radix p) hx).
rewrite <- Fplus_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fplus; simpl; apply Zmin_Zle.
assert (K:Fbounded b q);[elim A2; auto|elim K; auto with zarith].
assert (K:Fbounded b p);[elim A1; auto|elim K; auto with zarith].
rewrite Fplus_correct; auto.
assert (Closest (plusExp t b) radix (FtoR radix xx - FtoR radix hx) tx).
rewrite X1; rewrite <- Fminus_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fminus; simpl; apply Zmin_Zle.
assert (K:Fbounded b x);[elim Cx; auto|elim K; auto with zarith].
assert (K:Fbounded b hx);[elim A3; auto|elim K; auto with zarith].
rewrite Fminus_correct; auto.
generalize VeltkampU; intros V.
elim V with radix b s t y p' q' hy ty; auto.
2: unfold s; apply SLe; auto.
2: unfold s; apply SGe; auto.
2: left; auto.
intros M1 T; elim T; intros M2 T'; elim T'; intros T1 T2; clear T T'.
elim T1; intros hy' T1'; elim T1'; intros M3 T; elim T; intros M4 T'; clear T1 T1' T.
lapply T'; auto; intros M5; clear T'.
elim T2; intros ty' T1'; elim T1'; intros M6 T; elim T; intros M7 M8; clear T2 T1' T V.
elim Veltkamp_tail with radix b s t x p q hx tx; auto.
2: unfold s; apply SLe; auto.
2: unfold s; apply SGe; auto.
2: elim Cx; auto.
intros tx' T1'; elim T1'; intros N5 T; elim T; intros N7 T'; elim T'; intros N8 N9; clear T1' T T'.
rewrite FcanonicFnormalizeEq in N9; auto with zarith;[idtac|right; auto].
assert (Fexp x ≤ Fexp hx)%Z.
elim Cx; intros T1 T2; elim T2; intros T3 T4; rewrite T3.
elim A3; intros G1 G2; elim G1; auto.
apply DekkerN with (plusExp t b) t p q hx tx p' q' hy ty x1y1 x1y2 x2y1 x2y2 t1 t2 t3; auto.
rewrite <- M3.
rewrite <- Fmult_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fmult; simpl; auto with zarith.
rewrite Fmult_correct; auto with real; rewrite M3; auto.
rewrite <- M6.
rewrite <- Fmult_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fmult; simpl; auto with zarith.
rewrite Fmult_correct; auto with real; rewrite M6; auto.
rewrite <- M3; rewrite <- N5.
rewrite <- Fmult_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fmult; simpl; auto with zarith.
rewrite Fmult_correct; auto with real; rewrite M3; rewrite N5; auto.
rewrite <- M6; rewrite <- N5.
rewrite <- Fmult_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fmult; simpl; auto with zarith.
rewrite Fmult_correct; auto with real; rewrite M6; rewrite N5; auto.
rewrite X1.
rewrite <- Fmult_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
rewrite Fmult_correct; auto with real.
rewrite <- Fminus_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fminus; simpl; apply Zmin_Zle.
assert (K:Fbounded b r);[elim D1; auto|elim K; auto with zarith].
assert (K:Fbounded b x1y1);[elim C1; auto|elim K; auto with zarith].
rewrite Fminus_correct; auto.
rewrite <- Fminus_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fminus; simpl; apply Zmin_Zle.
assert (K:Fbounded b t1);[elim D2; auto|elim K; auto with zarith].
assert (K:Fbounded b x1y2);[elim C2; auto|elim K; auto with zarith].
rewrite Fminus_correct; auto.
rewrite <- Fminus_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fminus; simpl; apply Zmin_Zle.
assert (K:Fbounded b t2);[elim D3; auto|elim K; auto with zarith].
assert (K:Fbounded b x2y1);[elim C3; auto|elim K; auto with zarith].
rewrite Fminus_correct; auto.
rewrite <- Fminus_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fminus; simpl; apply Zmin_Zle.
assert (K:Fbounded b t3);[elim D4; auto|elim K; auto with zarith].
assert (K:Fbounded b x2y2);[elim C4; auto|elim K; auto with zarith].
rewrite Fminus_correct; auto.
Qed.
End AlgoS2.
Section Algo1.
Variable radix : Z.
Variable b : Fbound.
Variables t: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 pGivesBound: Zpos (vNum b)=(Zpower_nat radix t).
Hypotheses pGe: (4 ≤ t).
Variables x y p q hx tx p' q' hy ty x1y1 x1y2 x2y1 x2y2 r t1 t2 t3 t4:float.
Hypothesis Cx: (Fcanonic radix b x).
Hypothesis Cy: (Fcanonic radix b y).
Hypothesis Expoxy: (-dExp b ≤ Fexp x+Fexp y)%Z.
Let s:= t- div2 t.
Hypothesis A1: (Closest b radix (x*((powerRZ radix s)+1))%R p).
Hypothesis A2: (Closest b radix (x-p)%R q).
Hypothesis A3: (Closest b radix (q+p)%R hx).
Hypothesis A4: (Closest b radix (x-hx)%R tx).
Hypothesis B1: (Closest b radix (y*((powerRZ radix s)+1))%R p').
Hypothesis B2: (Closest b radix (y-p')%R q').
Hypothesis B3: (Closest b radix (q'+p')%R hy).
Hypothesis B4: (Closest b radix (y-hy)%R ty).
Hypothesis C1: (Closest b radix (hx×hy)%R x1y1).
Hypothesis C2: (Closest b radix (hx×ty)%R x1y2).
Hypothesis C3: (Closest b radix (tx×hy)%R x2y1).
Hypothesis C4: (Closest b radix (tx×ty)%R x2y2).
Hypothesis D1: (Closest b radix (x×y)%R r).
Hypothesis D2: (Closest b radix (r-x1y1)%R t1).
Hypothesis D3: (Closest b radix (t1-x1y2)%R t2).
Hypothesis D4: (Closest b radix (t2-x2y1)%R t3).
Hypothesis D5: (Closest b radix (t3-x2y2)%R t4).
Hypothesis dExpPos: ¬(Z_of_N(dExp b)=0)%Z.
Theorem Dekker1: (radix=2)%Z ∨ (even t) → (x×y=r-t4)%R.
case Cy; case Cx; intros.
unfold FtoRradix; apply DekkerN with b t p q hx tx p' q' hy ty x1y1 x1y2 x2y1 x2y2 t1 t2 t3; auto.
unfold FtoRradix; apply DekkerS2 with b t p q hx tx p' q' hy ty x1y1 x1y2 x2y1 x2y2 t1 t2 t3; auto.
unfold FtoRradix; apply DekkerS1 with b t p q hx tx p' q' hy ty x1y1 x1y2 x2y1 x2y2 t1 t2 t3; auto.
absurd (- dExp b ≤ Fexp x + Fexp y)%Z; auto with zarith.
apply Zlt_not_le.
elim H; intros T1 T2; elim T2; intros G1 T; clear T1 T2 T.
elim H0; intros T1 T2; elim T2; intros G2 T; clear T1 T2 T.
rewrite G1; rewrite G2; auto with zarith.
cut (0 < dExp b)%Z; auto with zarith.
generalize dExpPos; unfold Z_of_N; case (dExp b); auto with zarith.
Qed.
End Algo1.
Section Algo2.
Variable radix : Z.
Variable b : Fbound.
Variables t: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 pGivesBound: Zpos (vNum b)=(Zpower_nat radix t).
Hypotheses pGe: (4 ≤ t).
Let s:= t- div2 t.
Variables x y:float.
Let b' := Bound (vNum b) (Nplus (Ndouble (dExp b)) (Ndouble (Npos (P_of_succ_nat t)))).
Theorem Veltkampb': ∀ (f pf qf hf tf:float),
(dExp b < dExp b')%Z →
(Fbounded b f) →
Closest b radix (f × (powerRZ radix s + 1)) pf → Closest b radix (f - pf) qf →
Closest b radix (qf + pf) hf → Closest b radix (f - hf) tf →
Closest b' radix (f × (powerRZ radix s + 1)) pf ∧
Closest b' radix (f - pf) qf ∧ Closest b' radix (qf + pf) hf ∧
Closest b' radix (f - hf) tf.
intros.
split.
assert (f*(powerRZ radix s + 1)= (FtoRradix (Fplus radix (Fmult f (Float 1 s)) f)))%R.
unfold FtoRradix; rewrite Fplus_correct; auto; rewrite Fmult_correct; auto.
unfold FtoR; simpl; ring.
rewrite H5; unfold FtoRradix; apply Closestbbext with b t; auto with zarith.
simpl; rewrite Zmin_le2; auto with zarith float.
fold FtoRradix; rewrite <- H5; auto.
split.
unfold FtoRradix; rewrite <- Fminus_correct; auto.
apply Closestbbext with b t; auto with zarith.
simpl; apply Zmin_Zle; auto with zarith float.
elim H1; auto with zarith float.
rewrite Fminus_correct; auto.
split.
unfold FtoRradix; rewrite <- Fplus_correct; auto.
apply Closestbbext with b t; auto with zarith.
simpl; apply Zmin_Zle; elim H2; elim H1; auto with zarith float.
rewrite Fplus_correct; auto.
unfold FtoRradix; rewrite <- Fminus_correct; auto.
apply Closestbbext with b t; auto with zarith.
simpl; apply Zmin_Zle; elim H3; auto with zarith float.
rewrite Fminus_correct; auto.
Qed.
Variables p q hx tx p' q' hy ty x1y1 x1y2 x2y1 x2y2 r t1 t2 t3 t4:float.
Hypothesis Cx: (Fcanonic radix b x).
Hypothesis Cy: (Fcanonic radix b y).
Hypothesis Expoxy: (Fexp x+Fexp y < -dExp b)%Z.
Hypothesis A1: (Closest b radix (x*((powerRZ radix s)+1))%R p).
Hypothesis A2: (Closest b radix (x-p)%R q).
Hypothesis A3: (Closest b radix (q+p)%R hx).
Hypothesis A4: (Closest b radix (x-hx)%R tx).
Hypothesis B1: (Closest b radix (y*((powerRZ radix s)+1))%R p').
Hypothesis B2: (Closest b radix (y-p')%R q').
Hypothesis B3: (Closest b radix (q'+p')%R hy).
Hypothesis B4: (Closest b radix (y-hy)%R ty).
Hypothesis C1: (Closest b radix (hx×hy)%R x1y1).
Hypothesis C2: (Closest b radix (hx×ty)%R x1y2).
Hypothesis C3: (Closest b radix (tx×hy)%R x2y1).
Hypothesis C4: (Closest b radix (tx×ty)%R x2y2).
Hypothesis D1: (Closest b radix (x×y)%R r).
Hypothesis D2: (Closest b radix (r-x1y1)%R t1).
Hypothesis D3: (Closest b radix (t1-x1y2)%R t2).
Hypothesis D4: (Closest b radix (t2-x2y1)%R t3).
Hypothesis D5: (Closest b radix (t3-x2y2)%R t4).
Theorem dExpPrim: (dExp b < dExp b')%Z.
unfold b'; simpl; auto with zarith.
cut (∀ (x:N) (y:positive), (x+(Zpos y)=(x +Npos y)%N)%Z).
intros T; simpl; rewrite <- T; auto with zarith.
apply Zle_lt_trans with (Ndouble (dExp b)); auto with zarith.
unfold Ndouble; case (dExp b); auto with zarith.
intros; unfold Z_of_N; auto with zarith.
apply Zle_trans with (2*(Zpos p0))%Z; auto with zarith.
apply Zle_trans with (1*(Zpos p0))%Z; auto with zarith.
apply Zle_lt_trans with (Ndouble (dExp b)+0)%Z; auto with zarith.
intros;unfold Nplus.
case x0; auto with zarith.
Qed.
Theorem dExpPrimEq: (Z_of_N (Ndouble (dExp b) + Npos (xO (P_of_succ_nat t)))
=2*(dExp b)+2×t+2)%Z.
cut (∀ (x:N) (y:positive), (x+(Zpos y)=(x +Npos y)%N)%Z).
intros T; rewrite <- T; auto with zarith.
2:intros;unfold Nplus.
2:case x0; auto with zarith.
replace (Zpos (xO (P_of_succ_nat t))) with (2×t+2)%Z.
unfold Ndouble; case (dExp b); auto with zarith.
apply trans_eq with (2*(Zpos (P_of_succ_nat t)))%Z; auto with zarith.
replace (Zpos (P_of_succ_nat t)) with (t+1)%Z; auto with zarith.
apply trans_eq with
(Z_of_nat
(nat_of_P
(P_of_succ_nat t))); auto with zarith.
rewrite nat_of_P_o_P_of_succ_nat_eq_succ; auto with zarith arith.
replace (S t) with (t+1)%nat; auto with zarith arith; rewrite inj_plus; auto with zarith.
unfold Z_of_nat; rewrite nat_of_P_o_P_of_succ_nat_eq_succ;
auto with zarith.
Qed.
Theorem NormalbPrim: ∀ (f:float), Fcanonic radix b f → (FtoRradix f ≠0) →
(∃ f':float, (Fnormal radix b' f') ∧ FtoRradix f'=f ∧ (-t-dExp b ≤ Fexp f')%Z).
intros.
∃ (Fnormalize radix b' t f).
assert (powerRZ radix (-(dExp b)) ≤ (Fabs (Fnormalize radix b' t f)))%R.
unfold FtoRradix; rewrite Fabs_correct; auto.
rewrite FnormalizeCorrect; auto with zarith; rewrite <- Fabs_correct; auto.
unfold FtoRradix, FtoR, Fabs; simpl.
apply Rle_trans with ((IZR 1)*powerRZ radix (- dExp b))%R;[right; simpl; ring|idtac].
apply Rmult_le_compat; auto with real zarith float.
case (Zle_lt_or_eq 0 (Zabs (Fnum f))); auto with zarith real.
intros; absurd (Rabs f =0)%R.
apply Rabs_no_R0; auto.
unfold FtoRradix; rewrite <- Fabs_correct; auto; unfold FtoR, Fabs; simpl; rewrite <- H1; simpl; ring.
assert (Fbounded b f);[apply FcanonicBound with radix; auto with zarith|idtac].
elim H1; intros; apply Rle_powerRZ; auto with zarith real.
assert (Fcanonic radix b' (Fnormalize radix b' t f)).
apply FnormalizeCanonic; auto with zarith.
assert (Fbounded b f);[apply FcanonicBound with radix; auto with zarith|idtac].
elim H2; generalize dExpPrim; intros; split; auto with zarith.
split.
case H2; auto.
intros; absurd (Fabs f < (firstNormalPos radix b' t))%R.
apply Rle_not_lt.
apply Rle_trans with (powerRZ radix (-(dExp b))).
unfold firstNormalPos, FtoRradix, FtoR; simpl.
unfold nNormMin; rewrite Zpower_nat_Z_powerRZ; rewrite <- powerRZ_add; auto with real zarith.
apply Rle_powerRZ; auto with real zarith.
rewrite dExpPrimEq.
rewrite inj_pred; auto with zarith; unfold Zpred.
ring_simplify (t + -1 + - (2 × dExp b + 2 × t + 2))%Z; auto with zarith.
assert (0 ≤ dExp b)%Z; auto with zarith.
case (dExp b); auto with zarith.
apply Rle_trans with (1:=H1); unfold FtoRradix; repeat rewrite Fabs_correct; auto.
rewrite FnormalizeCorrect; auto with zarith real.
apply Rle_lt_trans with (Fabs (Fnormalize radix b' t f)).
unfold FtoRradix; repeat rewrite Fabs_correct; auto.
rewrite FnormalizeCorrect; auto with zarith real.
unfold FtoRradix; apply FsubnormalLtFirstNormalPos; auto with zarith.
apply FsubnormFabs; auto.
rewrite Fabs_correct; auto with real zarith.
split;[unfold FtoRradix; rewrite FnormalizeCorrect; auto with zarith|idtac].
apply Zle_trans with (Fexp (Float (nNormMin radix t) (-t-dExp b))); auto with zarith.
apply Fcanonic_Rle_Zle with radix b' t; auto with zarith.
apply FcanonicNnormMin; auto with zarith.
unfold b'; simpl; rewrite dExpPrimEq; auto with zarith.
cut (0 ≤ dExp b)%Z; auto with zarith; case (dExp b); auto with zarith.
rewrite Rabs_right.
rewrite <- Fabs_correct; auto; fold FtoRradix; apply Rle_trans with (2:=H1).
unfold FtoRradix, FtoR, nNormMin; simpl; rewrite Zpower_nat_Z_powerRZ.
rewrite <- powerRZ_add; auto with real zarith; apply Rle_powerRZ; auto with zarith real.
rewrite inj_pred; auto with zarith; unfold Zpred; auto with zarith.
apply Rle_ge; apply LeFnumZERO; auto with zarith.
unfold nNormMin; simpl; auto with zarith.
Qed.
Theorem Dekker2_aux:
(FtoRradix x ≠0) → (FtoRradix y ≠0) →
(radix=2)%Z ∨ (even t) → (Rabs (x×y-(r-t4)) ≤ (7/2)*powerRZ radix (-(dExp b)))%R.
intros P1 P2.
intros; generalize dExpPrim; intros.
elim (NormalbPrim x); auto.
intros x' T; elim T; intros Nx' T'; elim T'; intros Hx' Ex'; clear T T'.
elim (NormalbPrim y); auto.
intros y' T; elim T; intros Ny' T'; elim T'; intros Hy' Ey'; clear T T'.
assert (MM:(-(dExp b') ≤ Fexp x'+Fexp y')%Z).
unfold b'; simpl; rewrite dExpPrimEq; auto with zarith float.
generalize Underf_Err2; intros T.
elim T with b radix t b' (x×y)%R r; auto with zarith; clear T.
intros r' T; elim T; intros H1 H2; clear T.
elim Veltkampb' with x p q hx tx; auto.
2: apply FcanonicBound with radix; auto.
intros H4 T; elim T; intros H5 T'; elim T'; intros H6 H7; clear T T'.
elim Veltkampb' with y p' q' hy ty; auto.
2: apply FcanonicBound with radix; auto.
intros H8 T; elim T; intros H9 T'; elim T'; intros H10 H11; clear T T'.
assert (TotalP (Closest b' radix)).
apply ClosestTotal with t; auto with zarith.
unfold TotalP in H3.
elim (H3 (hx × hy)%R); intros x1y1' H12.
elim (H3 (hx × ty)%R); intros x1y2' H13.
elim (H3 (tx × hy)%R); intros x2y1' H14.
elim (H3 (tx × ty)%R); intros x2y2' H15.
elim (H3 (r' - x1y1')%R); intros t1' H16.
elim (H3 (t1' - x1y2')%R); intros t2' H17.
elim (H3 (t2' - x2y1')%R); intros t3' H18.
elim (H3 (t3' - x2y2')%R); intros t4' H19.
rewrite <- Hx'; rewrite <- Hy'; unfold FtoRradix.
rewrite DekkerN with radix b' t x' y' p q hx tx p' q' hy ty x1y1' x1y2' x2y1' x2y2' r' t1' t2' t3' t4';
auto with zarith.
2: fold FtoRradix; rewrite Hx'; auto.
2: fold FtoRradix; rewrite Hx'; auto.
2: fold FtoRradix; rewrite Hx'; auto.
2: fold FtoRradix; rewrite Hy'; auto.
2: fold FtoRradix; rewrite Hy'; auto.
2: fold FtoRradix; rewrite Hy'; auto.
2: fold FtoRradix; rewrite Hx'; rewrite Hy'; auto.
fold FtoRradix.
replace (r' - t4' - (r - t4))%R with (-(r-r')+((t4-t4')))%R;[idtac|ring].
apply Rle_trans with (1:=Rabs_triang (-(r-r'))%R ((t4-t4'))%R).
apply Rle_trans with ((3/4)*powerRZ radix (- dExp b) +(11/4)*powerRZ radix (- dExp b))%R;
[idtac|right; field; apply prod_neq_R0; auto with real; apply prod_neq_R0; auto with real].
apply Rplus_le_compat.
rewrite Rabs_Ropp; auto with real.
elim H1; intros G1 G2; elim G2; intros G3 G4; elim G4; intros G5 G6.
unfold FtoRradix; apply Rle_trans with (1:=G5); right; ring.
cut (2 ≤ s);[intros Sle|unfold s; apply SLe; auto].
cut (s ≤ t-2);[intros Sge|unfold s; apply SGe; auto].
cut (s+s ≤ t+1)%Z;[intros s2le|unfold s; apply s2Le; auto].
cut (t ≤s+s)%Z;[intros s2ge|unfold s; apply s2Ge; auto].
generalize VeltkampU; intros V.
elim V with radix b' s t x' p q hx tx; auto.
2: left; auto.
2: fold FtoRradix; rewrite Hx'; auto.
2: fold FtoRradix; rewrite Hx'; auto.
2: fold FtoRradix; rewrite Hx'; auto.
intros MX1 T; elim T; intros MX2 T'; clear T; elim T'; intros T1 T2; clear T'.
elim T1; intros Chx' T1'; elim T1'; intros MX3 T1''; elim T1''; intros MX4 MX5; clear T1 T1' T1''.
lapply MX5; auto; clear MX5; intros MX5.
elim T2; intros Ctx' T1'; elim T1'; intros MX6 T1''; elim T1''; intros MX7 MX8; clear T2 T1' T1''.
elim V with radix b' s t y' p' q' hy ty; auto.
2: left; auto.
2: fold FtoRradix; rewrite Hy'; auto.
2: fold FtoRradix; rewrite Hy'; auto.
2: fold FtoRradix; rewrite Hy'; auto.
intros MY1 T; elim T; intros MY2 T'; clear T; elim T'; intros T1 T2; clear T'.
elim T1; intros Chy' T1'; elim T1'; intros MY3 T1''; elim T1''; intros MY4 MY5; clear T1 T1' T1''.
lapply MY5; auto; clear MY5; intros MY5.
elim T2; intros Cty' T1'; elim T1'; intros MY6 T1''; elim T1''; intros MY7 MY8; clear T2 T1' T1'' V.
generalize Boundedt1; intros V.
elim V with radix b' s t x' Chx' Ctx' y' Chy' Cty' r' (Fminus radix (Fmult x' y') r');
auto with zarith real; clear V.
2: fold FtoRradix; rewrite Hy';rewrite Hx'; auto.
2:rewrite Fminus_correct; auto with zarith; rewrite Fmult_correct; auto with zarith; ring.
2:rewrite MX6; rewrite MX3; exact MX2.
2:rewrite MY6; rewrite MY3; exact MY2.
2:rewrite MX6; replace (FtoR radix tx) with (FtoR radix x'-FtoR radix hx)%R; auto with real.
2:rewrite MX2; ring.
2:rewrite MY6; replace (FtoR radix ty) with (FtoR radix y'-FtoR radix hy)%R; auto with real.
2:rewrite MY2; ring.
intros Ct1' T; elim T; intros M11 T'; elim T'; intros M12 M13; clear T T'.
generalize Boundedt2; intros V.
elim V with radix b' s t x' Chx' Ctx' y' Chy' Cty' r' (Fminus radix (Fmult x' y') r');
auto with zarith real; clear V.
2: fold FtoRradix; rewrite Hy';rewrite Hx'; auto.
2:rewrite Fminus_correct; auto with zarith; rewrite Fmult_correct; auto with zarith; ring.
2:rewrite MX6; rewrite MX3; exact MX2.
2:rewrite MY6; rewrite MY3; exact MY2.
2:rewrite MX6; replace (FtoR radix tx) with (FtoR radix x'-FtoR radix hx)%R; auto with real.
2:rewrite MX2; ring.
2:rewrite MY6; replace (FtoR radix ty) with (FtoR radix y'-FtoR radix hy)%R; auto with real.
2:rewrite MY2; ring.
intros Ct2' T; elim T; intros M21 T'; elim T'; intros M22 M23; clear T T'.
generalize Boundedt3; intros V.
elim V with radix b' s t x' Chx' Ctx' y' Chy' Cty' r' (Fminus radix (Fmult x' y') r');
auto with zarith real; clear V.
2: fold FtoRradix; rewrite Hy';rewrite Hx'; auto.
2:rewrite Fminus_correct; auto with zarith; rewrite Fmult_correct; auto with zarith; ring.
2:rewrite MX6; rewrite MX3; exact MX2.
2:rewrite MY6; rewrite MY3; exact MY2.
2:rewrite MX6; replace (FtoR radix tx) with (FtoR radix x'-FtoR radix hx)%R; auto with real.
2:rewrite MX2; ring.
2:rewrite MY6; replace (FtoR radix ty) with (FtoR radix y'-FtoR radix hy)%R; auto with real.
2:rewrite MY2; ring.
intros Ct3' T; elim T; intros M31 T'; elim T'; intros M32 M33; clear T T'.
generalize Boundedt4_aux; intros V.
elim V with radix b' s t x' Chx' Ctx' y' Chy' Cty' r' ; auto with zarith real; clear V.
2: fold FtoRradix; rewrite Hy';rewrite Hx'; auto.
2:rewrite MX6; rewrite MX3; exact MX2.
2:rewrite MY6; rewrite MY3; exact MY2.
intros Ct4' T; elim T; intros M41 T'; elim T'; intros M42 M43; clear T T'.
elim Boundedx1y1_aux with radix b' s t x' Chx' y' Chy'; auto with zarith.
intros Cx1y1' T; elim T; intros O1 T'; elim T'; intros O2 O3 ; clear T T'.
elim Boundedx1y2_aux with radix b' s t x' Chx' y' Cty'; auto with zarith.
intros Cx1y2' T; elim T; intros O4 T'; elim T'; intros O5 O6; clear T T'.
elim Boundedx2y1_aux with radix b' s t x' Ctx' y' Chy'; auto with zarith.
intros Cx2y1' T; elim T; intros O7 T'; elim T'; intros O8 O9; clear T T'.
assert (tmp:∀ (f:float) (i:nat), (i ≤ t) →
(Fbounded (Bound (P_of_succ_nat (pred (Zabs_nat (Zpower_nat radix (i)))))
(dExp b')) f) → (Fbounded b' f)).
intros f i J1 J2; elim J2; intros J3 J4; split; auto with zarith.
apply Zlt_le_trans with (1:=J3).
apply Zle_trans with (Zpower_nat radix i);[idtac|unfold b'; simpl; rewrite pGivesBound; auto with zarith].
simpl.
apply
Zle_trans
with
(Z_of_nat
(nat_of_P
(P_of_succ_nat
(pred (Zabs_nat (Zpower_nat radix (i))))))).
unfold Z_of_nat in |- *; rewrite nat_of_P_o_P_of_succ_nat_eq_succ;
auto with zarith.
rewrite nat_of_P_o_P_of_succ_nat_eq_succ; auto with arith zarith.
rewrite <- S_pred with (Zabs_nat (Zpower_nat radix (i))) 0; auto with zarith.
rewrite <- Zabs_absolu; rewrite Zabs_eq; auto with zarith.
cut ( 0 < Zabs_nat (Zpower_nat radix (i)))%Z; auto with zarith.
simpl; rewrite <- Zabs_absolu; rewrite Zabs_eq; auto with zarith.
elim Boundedx2y2 with radix b' t x' y' p q Chx' Ctx' p' q' Chy' Cty'; auto with zarith.
2: fold FtoRradix; rewrite Hx'; auto.
2: fold FtoRradix; rewrite Hx'; auto.
2:apply ClosestCompatible with (1:=H6); auto.
2:apply tmp with (t-s); auto with zarith.
2:apply ClosestCompatible with (1:=H7); auto with real.
2: fold FtoRradix; rewrite Hx'; auto with real.
2:apply tmp with s; auto with zarith.
2: fold FtoRradix; rewrite Hy'; auto.
2: fold FtoRradix; rewrite Hy'; auto.
2:apply ClosestCompatible with (1:=H10); auto.
2:apply tmp with (t-s); auto with zarith.
2:fold FtoRradix; rewrite Hy'; apply ClosestCompatible with (1:=H11); auto with real.
2:apply tmp with s; auto with zarith.
intros Cx2y2' T; elim T; intros O10 T'; elim T'; intros O11 O12; clear T T' tmp.
assert (ZZ:RoundedModeP b' radix (Closest b' radix)).
apply ClosestRoundedModeP with t; auto with zarith.
assert (K1':FtoRradix x1y1'=Cx1y1').
unfold FtoRradix; apply sym_eq; apply RoundedModeProjectorIdemEq with b' t (Closest b' radix); auto with zarith.
rewrite O1; rewrite MY3; rewrite MX3; auto.
assert (K1:FtoRradix Ct1'=t1').
unfold FtoRradix; apply RoundedModeProjectorIdemEq with b' t (Closest b' radix); auto with zarith.
rewrite M11; replace (FtoR radix Chx' × FtoR radix Chy')%R with (FtoRradix x1y1'); auto.
rewrite <- O1; auto.
assert (K2':FtoRradix x1y2'=Cx1y2').
unfold FtoRradix; apply sym_eq; apply RoundedModeProjectorIdemEq with b' t (Closest b' radix); auto with zarith.
rewrite O4; rewrite MY6; rewrite MX3; auto.
assert (K2:FtoRradix Ct2'=t2').
unfold FtoRradix; apply RoundedModeProjectorIdemEq with b' t (Closest b' radix); auto with zarith.
rewrite M21; rewrite <- M11; fold FtoRradix; rewrite K1.
replace (Chx' × Cty')%R with (FtoRradix x1y2'); auto.
unfold FtoRradix; rewrite <- O4; auto.
assert (K3':FtoRradix x2y1'=Cx2y1').
unfold FtoRradix; apply sym_eq; apply RoundedModeProjectorIdemEq with b' t (Closest b' radix); auto with zarith.
rewrite O7; rewrite MY3; rewrite MX6; auto.
assert (K3:FtoRradix Ct3'=t3').
unfold FtoRradix; apply RoundedModeProjectorIdemEq with b' t (Closest b' radix); auto with zarith.
rewrite M31; rewrite <- M21; fold FtoRradix; rewrite K2.
replace (Ctx' × Chy')%R with (FtoRradix x2y1'); auto.
unfold FtoRradix; rewrite <- O7; auto.
assert (K4':FtoRradix x2y2'=Cx2y2').
unfold FtoRradix; apply sym_eq; apply RoundedModeProjectorIdemEq with b' t (Closest b' radix); auto with zarith.
rewrite O10; rewrite MX6; rewrite MY6; auto.
assert (K4:FtoRradix Ct4'=t4').
unfold FtoRradix; apply RoundedModeProjectorIdemEq with b' t (Closest b' radix); auto with zarith.
rewrite M41; rewrite <- M31; fold FtoRradix; rewrite K3.
replace (Ctx' × Cty')%R with (FtoRradix x2y2'); auto.
unfold FtoRradix; rewrite <- O10; auto.
rewrite <- K4.
cut (Underf_Err b radix b' t4 Ct4' (t3-x2y2)%R (11/4)).
unfold FtoRradix; intros G; elim G; intros G1 G2; elim G2; intros G3 G4; elim G4; auto with real.
replace (11/4)%R with (9/4+/2)%R;
[idtac|field; apply prod_neq_R0; auto with real; apply prod_neq_R0; auto with real].
unfold FtoRradix; apply Underf_Err3_bis with t Ct3' Cx2y2' (t2-x2y1)%R (tx×ty)%R; auto with zarith.
replace (9/4)%R with (7/4+/2)%R;[idtac|
field; apply prod_neq_R0; auto with real; apply prod_neq_R0; auto with real].
unfold FtoRradix; apply Underf_Err3_bis with t Ct2' Cx2y1' (t1-x1y2)%R (tx×hy)%R; auto with zarith.
replace (7/4)%R with (5/4+/2)%R;[idtac|
field; apply prod_neq_R0; auto with real; apply prod_neq_R0; auto with real].
unfold FtoRradix; apply Underf_Err3_bis with t Ct1' Cx1y2' (r-x1y1)%R (hx×ty)%R; auto with zarith.
replace (5/4)%R with ((3/4)+/2)%R;[idtac|
field; apply prod_neq_R0; auto with real; apply prod_neq_R0; auto with real].
unfold FtoRradix; apply Underf_Err3_bis with t r' Cx1y1' (x×y)%R (hx×hy)%R; auto with zarith.
cut (hx×hy=FtoRradix Cx1y1')%R.
intros P; rewrite P; unfold FtoRradix; apply Underf_Err1 with t; auto with zarith.
fold FtoRradix; rewrite <- P; auto.
rewrite <- K1'; unfold FtoRradix; rewrite <- MX3; rewrite <- MY3; rewrite <- O1; auto.
apply Rmult_le_reg_l with (IZR 4); auto with real zarith; simpl.
apply Rle_trans with (IZR 5);[simpl; right; field; auto with real|idtac].
repeat apply prod_neq_R0; auto with real.
apply Rle_trans with (IZR 28); [auto with real zarith|simpl; right; ring].
rewrite M11; rewrite <- O1; auto with real.
rewrite M13; apply rExp with radix b' s; auto.
fold FtoRradix; rewrite Hx'; rewrite Hy'; auto.
cut (hx×ty=FtoRradix Cx1y2')%R.
intros P; rewrite P; unfold FtoRradix; apply Underf_Err1 with t; auto with zarith.
fold FtoRradix; rewrite <- P; auto.
unfold FtoRradix; rewrite O4; rewrite MX3; rewrite MY6; auto with real.
apply Rmult_le_reg_l with (IZR 4); auto with real zarith; simpl.
apply Rle_trans with (IZR 7);[simpl; right; field; auto with real|idtac].
repeat apply prod_neq_R0; auto with real.
apply Rle_trans with (IZR 28); [auto with real zarith|simpl; right; ring].
rewrite M21; rewrite M11; rewrite O4; ring.
cut (tx×hy=FtoRradix Cx2y1')%R.
intros P; rewrite P; unfold FtoRradix; apply Underf_Err1 with t; auto with zarith.
fold FtoRradix; rewrite <- P; auto.
unfold FtoRradix; rewrite O7; rewrite MX6; rewrite MY3; auto with real.
apply Rmult_le_reg_l with (IZR 4); auto with real zarith; simpl.
apply Rle_trans with (IZR 9);[simpl; right; field; auto with real|idtac].
repeat apply prod_neq_R0; auto with real.
apply Rle_trans with (IZR 28); [auto with real zarith|simpl; right; ring].
rewrite M21; rewrite M31; rewrite O7; ring.
cut (tx×ty=FtoRradix Cx2y2')%R.
intros P; rewrite P; unfold FtoRradix; apply Underf_Err1 with t; auto with zarith.
fold FtoRradix; rewrite <- P; auto.
unfold FtoRradix; rewrite O10; rewrite MX6; rewrite MY6; auto with real.
apply Rmult_le_reg_l with (IZR 4); auto with real zarith; simpl.
apply Rle_trans with (IZR 11);[simpl; right; field; auto with real|idtac].
repeat apply prod_neq_R0; auto with real.
apply Rle_trans with (IZR 28); [auto with real zarith|simpl; right; ring].
rewrite M41; rewrite M31; rewrite O10; ring.
Qed.
Theorem Dekker2:
(radix=2)%Z ∨ (even t) → (Rabs (x×y-(r-t4)) ≤ (7/2)*powerRZ radix (-(dExp b)))%R.
intros.
case (Req_dec 0%R x); intros Ny.
cut (FtoRradix r=0)%R;[intros Z1|idtac].
cut (FtoRradix t4=0)%R;[intros Z2|idtac].
replace ((x × y - (r - t4)))%R with 0%R.
rewrite Rabs_R0; apply Rlt_le; apply Rmult_lt_0_compat; auto with real zarith.
unfold Rdiv; apply Rmult_lt_0_compat; auto with real zarith.
apply Rlt_le_trans with (IZR 7);[auto with real zarith|simpl; right; ring].
fold FtoRradix; rewrite Z1; rewrite Z2; rewrite <- Ny; ring.
cut (FtoRradix hx=0)%R;[intros Z3|idtac].
cut (FtoRradix tx=0)%R;[intros Z4|idtac].
unfold FtoRradix; apply ClosestZero with b t (t3-x2y2)%R; auto with zarith.
cut (FtoRradix t3=0)%R;[intros Z5|idtac].
cut (FtoRradix x2y2=0)%R;[intros Z6|idtac].
rewrite Z5; rewrite Z6; ring.
unfold FtoRradix; apply ClosestZero with b t (tx×ty)%R; auto with zarith.
rewrite Z4; ring.
unfold FtoRradix; apply ClosestZero with b t (t2-x2y1)%R; auto with zarith.
cut (FtoRradix t2=0)%R;[intros Z5|idtac].
cut (FtoRradix x2y1=0)%R;[intros Z6|idtac].
rewrite Z5; rewrite Z6; ring.
unfold FtoRradix; apply ClosestZero with b t (tx×hy)%R; auto with zarith.
rewrite Z4; ring.
unfold FtoRradix; apply ClosestZero with b t (t1-x1y2)%R; auto with zarith.
cut (FtoRradix t1=0)%R;[intros Z5|idtac].
cut (FtoRradix x1y2=0)%R;[intros Z6|idtac].
rewrite Z5; rewrite Z6; ring.
unfold FtoRradix; apply ClosestZero with b t (hx×ty)%R; auto with zarith.
rewrite Z3; ring.
unfold FtoRradix; apply ClosestZero with b t (r-x1y1)%R; auto with zarith.
cut (FtoRradix x1y1=0)%R;[intros Z6|idtac].
rewrite Z1; rewrite Z6; ring.
unfold FtoRradix; apply ClosestZero with b t (hx×hy)%R; auto with zarith.
rewrite Z3; ring.
elim VeltkampU with radix b s t x p q hx tx; auto.
intros T1 T; elim T; intros H' T'; clear T1 T T'.
fold FtoRradix in H'; rewrite Z3 in H'; rewrite <- Ny in H'; auto with real.
apply trans_eq with (0+tx)%R; auto with real.
unfold s; apply SLe; auto.
unfold s; apply SGe; auto.
elim Veltkamp with radix b s t x p q hx; auto.
intros T1 T; elim T; intros hy' T'; elim T'; intros G1 T''; elim T''; intros ; clear T1 T T' T''.
unfold FtoRradix; rewrite <- G1.
apply ClosestZero with (Bound (P_of_succ_nat (pred (Zabs_nat (Zpower_nat radix (t - s)))))
(dExp b)) (t-s) (FtoR radix x)%R; auto with zarith.
apply p'GivesBound; auto with zarith.
assert (s ≤ t - 2)%Z; auto with zarith.
assert (s ≤ t - 2)%nat; auto with zarith.
unfold s; apply SGe; auto.
unfold s; apply SLe; auto.
unfold s; apply SGe; auto.
apply FcanonicBound with radix; auto.
unfold FtoRradix; apply ClosestZero with b t (x×y)%R; auto with zarith.
rewrite <- Ny; ring.
case (Req_dec 0%R y); intros Nx.
cut (FtoRradix r=0)%R;[intros Z1|idtac].
cut (FtoRradix t4=0)%R;[intros Z2|idtac].
replace ((x × y - (r - t4)))%R with 0%R.
rewrite Rabs_R0; apply Rlt_le; apply Rmult_lt_0_compat; auto with real zarith.
unfold Rdiv; apply Rmult_lt_0_compat; auto with real zarith.
apply Rlt_le_trans with (IZR 7);[auto with real zarith|simpl; right; ring].
fold FtoRradix; rewrite Z1; rewrite Z2; rewrite <- Nx; ring.
cut (FtoRradix hy=0)%R;[intros Z3|idtac].
cut (FtoRradix ty=0)%R;[intros Z4|idtac].
unfold FtoRradix; apply ClosestZero with b t (t3-x2y2)%R; auto with zarith.
cut (FtoRradix t3=0)%R;[intros Z5|idtac].
cut (FtoRradix x2y2=0)%R;[intros Z6|idtac].
rewrite Z5; rewrite Z6; ring.
unfold FtoRradix; apply ClosestZero with b t (tx×ty)%R; auto with zarith.
rewrite Z4; ring.
unfold FtoRradix; apply ClosestZero with b t (t2-x2y1)%R; auto with zarith.
cut (FtoRradix t2=0)%R;[intros Z5|idtac].
cut (FtoRradix x2y1=0)%R;[intros Z6|idtac].
rewrite Z5; rewrite Z6; ring.
unfold FtoRradix; apply ClosestZero with b t (tx×hy)%R; auto with zarith.
rewrite Z3; ring.
unfold FtoRradix; apply ClosestZero with b t (t1-x1y2)%R; auto with zarith.
cut (FtoRradix t1=0)%R;[intros Z5|idtac].
cut (FtoRradix x1y2=0)%R;[intros Z6|idtac].
rewrite Z5; rewrite Z6; ring.
unfold FtoRradix; apply ClosestZero with b t (hx×ty)%R; auto with zarith.
rewrite Z4; ring.
unfold FtoRradix; apply ClosestZero with b t (r-x1y1)%R; auto with zarith.
cut (FtoRradix x1y1=0)%R;[intros Z6|idtac].
rewrite Z1; rewrite Z6; ring.
unfold FtoRradix; apply ClosestZero with b t (hx×hy)%R; auto with zarith.
rewrite Z3; ring.
elim VeltkampU with radix b s t y p' q' hy ty; auto.
intros T1 T; elim T; intros H' T'; clear T1 T T'.
fold FtoRradix in H'; rewrite Z3 in H'; rewrite <- Nx in H'; auto with real.
apply trans_eq with (0+ty)%R; auto with real.
unfold s; apply SLe; auto.
unfold s; apply SGe; auto.
elim Veltkamp with radix b s t y p' q' hy; auto.
intros T1 T; elim T; intros hy' T'; elim T'; intros G1 T''; elim T''; intros ; clear T1 T T' T''.
unfold FtoRradix; rewrite <- G1.
apply ClosestZero with (Bound (P_of_succ_nat (pred (Zabs_nat (Zpower_nat radix (t - s)))))
(dExp b)) (t-s) (FtoR radix y)%R; auto with zarith.
apply p'GivesBound; auto with zarith.
assert (s ≤ t - 2)%Z; auto with zarith.
assert (s ≤ t - 2)%nat; auto with zarith.
unfold s; apply SGe; auto.
unfold s; apply SLe; auto.
unfold s; apply SGe; auto.
apply FcanonicBound with radix; auto.
unfold FtoRradix; apply ClosestZero with b t (x×y)%R; auto with zarith.
rewrite <- Nx; ring.
apply Dekker2_aux; auto.
Qed.
End Algo2.
Section AlgoT.
Variable radix : Z.
Variable b : Fbound.
Variables t: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 pGivesBound: Zpos (vNum b)=(Zpower_nat radix t).
Hypotheses pGe: (4 ≤ t).
Variables x y p q hx tx p' q' hy ty x1y1 x1y2 x2y1 x2y2 r t1 t2 t3 t4:float.
Hypothesis Cx: (Fcanonic radix b x).
Hypothesis Cy: (Fcanonic radix b y).
Let s:= t- div2 t.
Hypothesis A1: (Closest b radix (x*((powerRZ radix s)+1))%R p).
Hypothesis A2: (Closest b radix (x-p)%R q).
Hypothesis A3: (Closest b radix (q+p)%R hx).
Hypothesis A4: (Closest b radix (x-hx)%R tx).
Hypothesis B1: (Closest b radix (y*((powerRZ radix s)+1))%R p').
Hypothesis B2: (Closest b radix (y-p')%R q').
Hypothesis B3: (Closest b radix (q'+p')%R hy).
Hypothesis B4: (Closest b radix (y-hy)%R ty).
Hypothesis C1: (Closest b radix (hx×hy)%R x1y1).
Hypothesis C2: (Closest b radix (hx×ty)%R x1y2).
Hypothesis C3: (Closest b radix (tx×hy)%R x2y1).
Hypothesis C4: (Closest b radix (tx×ty)%R x2y2).
Hypothesis D1: (Closest b radix (x×y)%R r).
Hypothesis D2: (Closest b radix (-r+x1y1)%R t1).
Hypothesis D3: (Closest b radix (t1+x1y2)%R t2).
Hypothesis D4: (Closest b radix (t2+x2y1)%R t3).
Hypothesis D5: (Closest b radix (t3+x2y2)%R t4).
Hypothesis dExpPos: ¬(Z_of_N (dExp b)=0)%Z.
Theorem Dekker: (radix=2)%Z ∨ (even t) →
((-dExp b ≤ Fexp x+Fexp y)%Z → (x×y=r+t4)%R) ∧
(Rabs (x×y-(r+t4)) ≤ (7/2)*powerRZ radix (-(dExp b)))%R.
intros.
case (Zle_or_lt (-dExp b) (Fexp x+Fexp y)); intros.
cut (x × y = r + t4)%R; [intros; split; auto|idtac].
rewrite H1; ring_simplify ( (r + t4) - (r + t4))%R; rewrite Rabs_R0.
apply Rlt_le; apply Rmult_lt_0_compat; auto with real zarith.
unfold Rdiv; apply Rmult_lt_0_compat; auto with real zarith.
apply Rlt_le_trans with (IZR 7);[auto with real zarith|simpl; right; ring].
apply trans_eq with (r-(Fopp t4))%R;[idtac|unfold FtoRradix; rewrite Fopp_correct; ring].
unfold FtoRradix; apply Dekker1 with b t p q hx tx p' q' hy ty x1y1 x1y2 x2y1 x2y2
(Fopp t1) (Fopp t2) (Fopp t3); auto; try rewrite Fopp_correct; fold FtoRradix.
replace (r-x1y1)%R with (-(-r+x1y1))%R;[apply ClosestOpp; auto|ring].
replace (-t1-x1y2)%R with (-(t1+x1y2))%R;[apply ClosestOpp; auto|ring].
replace (-t2-x2y1)%R with (-(t2+x2y1))%R;[apply ClosestOpp; auto|ring].
replace (-t3-x2y2)%R with (-(t3+x2y2))%R;[apply ClosestOpp; auto|ring].
split.
intros; absurd (Fexp x + Fexp y < - dExp b)%Z; auto with zarith.
replace (r+t4)%R with (r-(Fopp t4))%R;[idtac|unfold FtoRradix; rewrite Fopp_correct; ring].
unfold FtoRradix; apply Dekker2 with t p q hx tx p' q' hy ty x1y1 x1y2 x2y1 x2y2
(Fopp t1) (Fopp t2) (Fopp t3); auto; try rewrite Fopp_correct; fold FtoRradix.
replace (r-x1y1)%R with (-(-r+x1y1))%R;[apply ClosestOpp; auto|ring].
replace (-t1-x1y2)%R with (-(t1+x1y2))%R;[apply ClosestOpp; auto|ring].
replace (-t2-x2y1)%R with (-(t2+x2y1))%R;[apply ClosestOpp; auto|ring].
replace (-t3-x2y2)%R with (-(t3+x2y2))%R;[apply ClosestOpp; auto|ring].
Qed.
End AlgoT.
Require Export Even.
Require Export Veltkamp.
Section Generic.
Variable b : Fbound.
Variable radix : Z.
Variable p : 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 pGivesBound : Zpos (vNum b) = Zpower_nat radix p.
Hypothesis precisionGreaterThanOne : 1 < p.
Theorem BoundedL: ∀ (r:R) (x:float) (e:Z),
(e ≤Fexp x)%Z → (-dExp b ≤ e)%Z → (FtoRradix x=r)%R →
(Rabs r < powerRZ radix (e+p))%R →
(∃ x':float, (FtoRradix x'=r) ∧ (Fbounded b x') ∧ Fexp x'=e).
intros.
∃ (Float (Fnum x×Zpower_nat radix (Zabs_nat (Fexp x -e)))%Z e).
split.
rewrite <- H1; unfold FtoRradix, FtoR; simpl.
rewrite mult_IZR; rewrite Zpower_nat_Z_powerRZ.
rewrite Rmult_assoc; rewrite <- powerRZ_add; auto with real zarith.
replace (Zabs_nat (Fexp x - e) + e)%Z with (Fexp x); auto with real.
rewrite <- Zabs_absolu; rewrite Zabs_eq; auto with zarith.
split;[idtac|simpl; auto].
split; simpl; auto.
apply Zlt_Rlt.
rewrite pGivesBound; rewrite <- Rabs_Zabs; rewrite mult_IZR.
repeat rewrite Zpower_nat_Z_powerRZ.
rewrite <- Zabs_absolu; rewrite Zabs_eq; auto with zarith.
rewrite Rabs_mult; rewrite (Rabs_right ( powerRZ radix (Fexp x - e))).
2: apply Rle_ge; auto with real zarith.
apply Rmult_lt_reg_l with (powerRZ radix e); auto with real zarith.
rewrite <- powerRZ_add; auto with real zarith.
apply Rle_lt_trans with (2:=H2); rewrite <- H1.
unfold FtoRradix, FtoR; rewrite Rabs_mult.
rewrite (Rabs_right (powerRZ radix (Fexp x))).
2: apply Rle_ge; auto with real zarith.
right; apply trans_eq with (Rabs (Fnum x)*(powerRZ radix e×powerRZ radix (Fexp x-e)))%R;[ring|idtac].
rewrite <- powerRZ_add; auto with real zarith.
ring_simplify (e+(Fexp x-e))%Z; auto with real.
Qed.
Theorem ClosestZero: ∀ (r:R) (x:float),
(Closest b radix r x) → (r=0)%R → (FtoRradix x=0)%R.
intros.
cut (0 ≤ FtoRradix x)%R;[intros |idtac].
cut (FtoRradix x ≤ 0)%R;[intros; auto with real |idtac].
unfold FtoRradix; apply RleRoundedLessR0 with b p (Closest b radix) r; auto with real.
apply ClosestRoundedModeP with p; auto.
unfold FtoRradix; apply RleRoundedR0 with b p (Closest b radix) r; auto with real.
apply ClosestRoundedModeP with p; auto.
Qed.
Theorem Closestbbext: ∀ bext:Fbound, ∀ fext f:float,
(vNum bext=vNum b) → (dExp b < dExp bext)%Z →
(-dExp b ≤ Fexp fext)%Z →
(Closest b radix fext f) → (Closest bext radix fext f).
intros bext fext f K1 K2; intros.
elim H0; intros.
split.
elim H1; intros; split; auto with zarith.
rewrite K1; auto.
intros g Hg.
case (Zle_or_lt (-(dExp b)) (Fexp g)); intros.
apply H2.
elim Hg; split; auto with zarith.
rewrite <- K1; auto.
case (Zle_lt_or_eq (-(dExp b)) (Fexp (Fnormalize radix b p f))).
cut (Fbounded b (Fnormalize radix b p f));[intros T; elim T; auto|idtac].
apply FnormalizeBounded; auto with zarith.
intros; apply Rle_trans with ((Fulp b radix p f)/2)%R.
apply Rmult_le_reg_l with (INR 2); auto with zarith real.
apply Rle_trans with (Fulp b radix p f);[idtac|simpl; right; field; auto with real].
rewrite <- Rabs_Ropp.
replace (- (FtoR radix f - fext))%R with (fext - FtoR radix f)%R;[idtac|ring].
apply ClosestUlp; auto with zarith.
rewrite <- Rabs_Ropp.
replace (- (FtoR radix g - fext))%R with (fext - FtoR radix g)%R;[idtac|ring].
apply Rle_trans with (Rabs fext -Rabs (FtoR radix g))%R;[idtac|apply Rabs_triang_inv].
apply Rle_trans with ((powerRZ radix (p-1+Fexp (Fnormalize radix b p f))
- powerRZ radix (-1+ Fexp (Fnormalize radix b p f)))
- powerRZ radix (p-1-dExp b))%R; [idtac|unfold Rminus; apply Rplus_le_compat].
apply Rplus_le_reg_l with (powerRZ radix (-1 + Fexp (Fnormalize radix b p f))).
ring_simplify ( powerRZ radix (-1 + Fexp (Fnormalize radix b p f)) +
(powerRZ radix (p - 1 + Fexp (Fnormalize radix b p f)) -
powerRZ radix (-1 + Fexp (Fnormalize radix b p f)) -
powerRZ radix (p - 1 - dExp b)))%R.
apply Rle_trans with (powerRZ radix (Fexp (Fnormalize radix b p f))).
unfold Fulp, Rdiv; apply Rle_trans with
((/2+/radix)* powerRZ radix (Fexp (Fnormalize radix b p f)))%R.
rewrite powerRZ_add; auto with real zarith; simpl; right; field.
repeat apply prod_neq_R0; auto with real zarith.
apply Rle_trans with (1 × powerRZ radix (Fexp (Fnormalize radix b p f)))%R;
[apply Rmult_le_compat_r; auto with real zarith|right; ring].
apply Rmult_le_reg_l with (2×radix)%R;
[apply Rmult_lt_0_compat; auto with real zarith|idtac].
apply Rle_trans with (2+radix)%R;
[right; field; auto with real zarith| ring_simplify (2×radix×1)%R].
apply Rle_trans with (radix+radix)%R;[idtac|right; ring].
replace 2%R with (IZR 2); auto with real zarith.
apply Rle_trans with (powerRZ radix (p-2+Fexp (Fnormalize radix b p f)));
[apply Rle_powerRZ; auto with real zarith|idtac].
apply Rle_trans with (1*(powerRZ radix (p - 2 + Fexp (Fnormalize radix b p f))))%R;
auto with real.
apply Rle_trans with ((radix -1)*(powerRZ radix (p - 2 + Fexp
(Fnormalize radix b p f))))%R;[apply Rmult_le_compat_r; auto with real zarith|idtac].
apply Rplus_le_reg_l with 1%R.
ring_simplify (1+(radix-1))%R; apply Rle_trans with (IZR 2); auto with real zarith.
apply Rle_trans with ( - powerRZ radix (p - 2+ Fexp (Fnormalize radix b p f)) +
powerRZ radix (p - 1 + Fexp (Fnormalize radix b p f)))%R.
right; unfold Zminus; repeat rewrite powerRZ_add; auto with real zarith.
simpl; field.
ring_simplify (radix×1)%R; repeat apply prod_neq_R0; auto with real zarith.
unfold Rminus; rewrite Rplus_comm; apply Rplus_le_compat_l; apply Ropp_le_contravar;
apply Rle_powerRZ; auto with real zarith.
cut (powerRZ radix (p - 1 + Fexp (Fnormalize radix b p f)) +
- powerRZ radix (-1 + Fexp (Fnormalize radix b p f))=
(Float (pPred (vNum b)) (-1+Fexp (Fnormalize radix b p f))))%R.
intros W; rewrite W.
2: unfold FtoRradix, FtoR, pPred.
2: apply trans_eq with (Zpred (Zpos (vNum b))×powerRZ radix
(-1+Fexp (Fnormalize radix b p f)))%R;[idtac|simpl; auto with real].
2: unfold Zpred, Zminus; rewrite plus_IZR.
2: rewrite pGivesBound; rewrite Zpower_nat_Z_powerRZ.
2: repeat rewrite powerRZ_add; auto with real zarith; simpl; field.
2: ring_simplify (radix×1)%R; auto with real zarith.
case (Rle_or_lt (Float (pPred (vNum b)) (-1 + Fexp (Fnormalize radix b p f)))
(Rabs fext)); auto with real; intros V.
absurd ( Rabs f ≤ Float (pPred (vNum b)) (-1 + Fexp (Fnormalize radix b p f)))%R.
apply Rlt_not_le.
apply Rlt_le_trans with (powerRZ radix (p-1+Fexp (Fnormalize radix b p f))).
rewrite <- W; apply Rlt_le_trans with (powerRZ radix (p - 1 +
Fexp (Fnormalize radix b p f))+-0)%R; auto with real zarith.
right; ring.
unfold FtoRradix; rewrite <- FnormalizeCorrect with radix b p f; auto with zarith.
rewrite <- Fabs_correct; auto.
rewrite powerRZ_add; auto with real zarith; unfold FtoRradix, FtoR, Fabs; simpl.
apply Rmult_le_compat_r; auto with real zarith.
apply Rmult_le_reg_l with radix; auto with real zarith.
apply Rle_trans with (powerRZ radix p).
unfold Zminus; rewrite powerRZ_add; auto with real zarith;
simpl; right; field ; auto with real.
ring_simplify (radix×1)%R; auto with real zarith.
cut (Fnormal radix b (Fnormalize radix b p f));[intros Nf|idtac].
rewrite <- Zpower_nat_Z_powerRZ; rewrite <- pGivesBound; rewrite <- mult_IZR;
elim Nf; intros.
rewrite Zabs_Zmult in H6; rewrite Zabs_eq in H6; auto with zarith real.
cut (Fcanonic radix b (Fnormalize radix b p f));[intros X|apply FnormalizeCanonic; auto with zarith].
case X; auto; intros X'.
elim X'; intros H5 H6; elim H6; intros.
absurd (-dExp b < dExp b)%Z; auto with zarith.
unfold FtoRradix; apply RoundAbsMonotoner with b p (Closest b radix) fext;
auto with real zarith.
apply ClosestRoundedModeP with p; auto with zarith.
split.
apply Zle_lt_trans with (pPred (vNum b)); auto with zarith.
simpl; rewrite Zabs_eq; auto with zarith.
apply Zlt_le_weak; apply pPredMoreThanOne with radix p; auto with zarith.
unfold pPred; auto with zarith.
apply Zle_trans with (Zpred (Fexp (Fnormalize radix b p f))); auto with zarith.
unfold Zpred; apply Zle_trans with (-1+Fexp (Fnormalize radix b p f))%Z;auto with zarith.
apply Ropp_le_contravar; rewrite <- Fabs_correct; auto.
unfold FtoR, Fabs; simpl.
apply Rle_trans with ((powerRZ radix p)*(powerRZ radix (-1-dExp b)))%R.
apply Rmult_le_compat; auto with real zarith.
elim Hg; intros; rewrite <- Zpower_nat_Z_powerRZ;
rewrite <- pGivesBound;rewrite <- K1; auto with real zarith.
apply Rle_powerRZ; auto with real zarith.
unfold Zminus; repeat rewrite powerRZ_add; auto with real zarith; right; ring.
intros H4.
apply Rle_trans with 0%R; auto with real; right.
rewrite <- FnormalizeCorrect with radix b p f; auto with zarith.
unfold FtoRradix; rewrite <- Fminus_correct; auto.
rewrite <- Fabs_correct; auto.
unfold FtoR.
replace (Fnum (Fabs (Fminus radix (Fnormalize radix b p f) fext))) with 0%Z;
[simpl; ring|idtac].
apply sym_eq; apply trans_eq with (Zabs (Fnum (Fminus radix
(Fnormalize radix b p f) fext)));[simpl; auto with zarith|idtac].
cut ( 0 ≤ Zabs (Fnum (Fminus radix (Fnormalize radix b p f) fext)))%Z;
auto with real zarith.
cut (Zabs (Fnum (Fminus radix (Fnormalize radix b p f) fext)) < 1)%Z;
auto with real zarith.
apply Zlt_Rlt.
apply Rmult_lt_reg_l with (powerRZ radix (-(dExp b))); auto with real zarith.
apply Rle_lt_trans with (Rabs (f-fext))%R.
unfold FtoRradix; rewrite <- FnormalizeCorrect with radix b p f; auto with zarith.
rewrite <- Fminus_correct; auto; rewrite <- Fabs_correct; auto.
unfold FtoR; simpl.
replace (Zmin (Fexp (Fnormalize radix b p f)) (Fexp fext)) with (-(dExp b))%Z;
[right; ring|idtac].
rewrite Zmin_le1; auto with zarith.
apply Rlt_le_trans with (Fulp b radix p f);
[idtac|unfold Fulp; simpl; rewrite H4; auto with real zarith].
rewrite <- Rabs_Ropp.
replace (- (f - fext))%R with (fext -f)%R;[idtac|ring].
unfold FtoRradix; apply RoundedModeUlp with (Closest b radix); auto with zarith real.
apply ClosestRoundedModeP with p; auto with zarith.
Qed.
Variable b' : Fbound.
Definition Underf_Err (a a' : float) (ra n:R) :=
(Closest b radix ra a) ∧ (Fbounded b' a') ∧
(Rabs (a-a') ≤ n×powerRZ radix (-(dExp b)))%R ∧
( ((-dExp b) ≤ Fexp a')%Z → (FtoRradix a =a')%R).
Theorem Underf_Err1: ∀ (a' a:float),
vNum b=vNum b' → (dExp b ≤ dExp b')%Z →
(Fbounded b' a') → (Closest b radix a' a) →
(Underf_Err a a' (FtoRradix a') (/2)%R).
intros.
unfold Underf_Err.
split; auto.
split; auto.
case (Zle_or_lt (- dExp b)%Z (Fexp a')); intros.
cut (FtoRradix a'=a);[intros H4|idtac].
rewrite H4; split; auto with real.
ring_simplify (a-a)%R; rewrite Rabs_R0; apply Rlt_le; apply Rmult_lt_0_compat; auto with real zarith.
unfold FtoRradix; apply RoundedModeProjectorIdemEq with b p (Closest b radix); auto.
apply ClosestRoundedModeP with p; auto with zarith.
elim H1; intros; split; auto.
rewrite H; auto.
split.
apply Rmult_le_reg_l with (INR 2); auto with real zarith.
apply Rle_trans with (powerRZ radix (- dExp b));[idtac|simpl; right; field; auto with real].
replace (a-a')%R with (-(a'-a))%R;[rewrite Rabs_Ropp|ring].
apply Rle_trans with (Fulp b radix p a).
unfold FtoRradix; apply ClosestUlp; auto with zarith.
unfold Fulp; apply Rle_powerRZ; auto with real zarith.
apply Zle_trans with (Fexp (firstNormalPos radix b p));[idtac|unfold firstNormalPos; simpl; auto with zarith].
apply Fcanonic_Rle_Zle with radix b p; auto with zarith.
apply FnormalizeCanonic; auto with zarith; elim H2; auto.
left; apply firstNormalPosNormal; auto with zarith.
rewrite (Rabs_right ((FtoR radix (firstNormalPos radix b p)))).
rewrite FnormalizeCorrect; auto with zarith.
apply RoundAbsMonotoner with b p (Closest b radix) (FtoRradix a'); auto.
apply ClosestRoundedModeP with p; auto with zarith.
assert (Fnormal radix b (firstNormalPos radix b p));
[apply firstNormalPosNormal; auto with zarith| elim H4; auto].
unfold FtoRradix; rewrite <- Fabs_correct; auto.
unfold firstNormalPos, Fabs, FtoR; simpl.
apply Rle_trans with (powerRZ radix p × powerRZ radix (Fexp a'))%R.
apply Rmult_le_compat_r; auto with real zarith.
elim H1; intros; apply Rle_trans with (IZR (Zpos (vNum b'))); auto with real zarith.
rewrite <- H; rewrite pGivesBound; rewrite Zpower_nat_Z_powerRZ; auto with real zarith.
unfold nNormMin; rewrite Zpower_nat_Z_powerRZ.
repeat rewrite <- powerRZ_add; auto with real zarith.
apply Rle_powerRZ; auto with real zarith.
rewrite inj_pred; auto with zarith; unfold Zpred; auto with zarith.
apply Rle_ge; apply LeFnumZERO; auto.
unfold firstNormalPos, nNormMin; simpl; auto with zarith.
intros ; absurd (Fexp a' < - dExp b)%Z; auto with zarith.
Qed.
Theorem Underf_Err2_aux: ∀ (r:R) (x1:float),
vNum b=vNum b' → (dExp b ≤ dExp b')%Z →
(Fcanonic radix b x1) →
(Closest b radix r x1) →
(∃ x2:float, (Underf_Err x1 x2 r (3/4)%R) ∧ (Closest b' radix r x2)).
intros.
assert (ZH: (0 < 3/4)%R).
apply Rmult_lt_reg_l with 4%R; auto with real.
apply Rmult_lt_0_compat; auto with real.
ring_simplify (4×0)%R; apply Rlt_le_trans with 3%R; auto with real.
apply Rlt_trans with 2%R; auto with real.
right; field; auto with real.
case (Zle_lt_or_eq (-(dExp b))%Z (Fexp x1)).
elim H2; intros I1 I2; elim I1; auto.
intros I.
∃ x1; split.
split; auto.
assert (Fbounded b x1);[elim H2; auto|idtac].
split.
split; auto with zarith.
elim H3; intros; rewrite <- H; auto.
split;[idtac|intros; auto with real].
ring_simplify (x1-x1)%R; rewrite Rabs_R0.
apply Rlt_le; apply Rmult_lt_0_compat; auto with real zarith.
split;[elim H2; intros T T'; elim T; intros; split; try rewrite <- H; auto with zarith|idtac].
intros f H3.
case (Zle_or_lt (-(dExp b)) (Fexp f)); intros.
elim H2; intros T1 T2; apply T2.
elim H3; intros; split; try rewrite H; auto with zarith.
fold FtoRradix; replace (f-r)%R with (-((x1-f)-(x1-r)))%R;[rewrite Rabs_Ropp|ring].
apply Rle_trans with (Rabs (x1 - f) - Rabs (x1 - r))%R;[idtac|apply Rabs_triang_inv].
apply Rplus_le_reg_l with (Rabs (x1-r)).
apply Rle_trans with ((INR 2)*(Rabs (x1-r)))%R;[right; simpl; ring|idtac].
apply Rle_trans with (Rabs (x1 - f));[idtac|right; ring].
apply Rle_trans with (Fulp b radix p x1).
replace (x1-r)%R with (-(r-x1))%R;[rewrite Rabs_Ropp|ring].
unfold FtoRradix; apply ClosestUlp; auto with zarith.
rewrite CanonicFulp; auto with zarith.
apply Rle_trans with (powerRZ radix (Fexp x1));[right; unfold FtoR; simpl; ring|idtac].
apply Rle_trans with ((Rabs x1)-Rabs f)%R;[idtac|apply Rabs_triang_inv].
apply Rplus_le_reg_l with (Rabs f).
apply Rle_trans with (Rabs x1);[idtac|right;ring].
apply Rle_trans with (powerRZ radix (p-2+Fexp x1)+powerRZ radix (p-2+Fexp x1))%R.
apply Rplus_le_compat.
apply Rle_trans with (FtoRradix (Float (Zpos (vNum b')) (Fexp f))).
apply Rlt_le; unfold FtoRradix; apply MaxFloat; auto.
unfold FtoRradix, FtoR; rewrite <- H; rewrite pGivesBound;simpl.
rewrite Zpower_nat_Z_powerRZ; rewrite <- powerRZ_add; auto with real zarith.
apply Rle_powerRZ; auto with zarith real.
apply Rle_powerRZ; auto with zarith real.
apply Rle_trans with (2×powerRZ radix (p - 2 + Fexp x1))%R;[right; ring|idtac].
apply Rle_trans with (radix×powerRZ radix (p - 2 + Fexp x1))%R;
[apply Rmult_le_compat_r; auto with real zarith|idtac].
apply Rle_trans with (IZR 2); auto with real zarith.
unfold FtoRradix; rewrite <- Fabs_correct; auto; unfold FtoR, Fabs; simpl.
rewrite powerRZ_add; auto with real zarith.
rewrite <- Rmult_assoc; apply Rmult_le_compat_r; auto with real zarith.
case H1; intros T.
elim T; intros H5 H6.
apply Rmult_le_reg_l with (IZR radix); auto with real zarith.
apply Rle_trans with (IZR (Zpos (vNum b))).
right; rewrite pGivesBound; rewrite Zpower_nat_Z_powerRZ.
unfold Zminus; rewrite powerRZ_add; auto with real zarith; simpl.
ring_simplify (radix×1)%R; field; auto with real zarith.
apply Rle_trans with (IZR(Zabs (radix × Fnum x1))); auto with real zarith.
rewrite Zabs_Zmult; rewrite Zabs_eq; auto with zarith real.
right; rewrite mult_IZR; ring.
elim T; intros T1 T2; elim T2; intros T3 T4.
absurd (- dExp b < Fexp x1)%Z; auto with zarith.
intros I.
generalize ClosestTotal; unfold TotalP.
intros T; elim T with b' radix p r; auto.
2: rewrite <- H; auto.
intros x2 H3'; clear T.
case (Zle_or_lt (-(dExp b)) (Fexp x2)); intros.
∃ x1; split.
split; auto.
assert (Fbounded b x1);[elim H2; auto|idtac].
split.
elim H4; intros; split; auto with zarith.
rewrite <- H; auto.
split;[idtac|intros; auto with real].
ring_simplify (x1-x1)%R; rewrite Rabs_R0; apply Rlt_le.
apply Rmult_lt_0_compat; auto with real zarith.
split.
elim H2; intros T1 T2; elim T1; intros; split; try rewrite <- H; auto with zarith.
intros f H4.
apply Rle_trans with (Rabs (FtoR radix x2 - r)).
elim H2; intros T1 T2; apply T2.
elim H3'; intros T1' T2'; elim T1'; intros; split; try rewrite H; auto with zarith.
elim H3'; intros T1 T2; apply T2; auto.
∃ x2; split; auto.
split; auto.
split;[elim H3'; auto|idtac].
split.
replace (x1-x2)%R with ((-(r-x1))+(r-x2))%R;[idtac|ring].
apply Rle_trans with (1:=Rabs_triang (-(r-x1))%R (r-x2)%R).
rewrite Rabs_Ropp; apply Rmult_le_reg_l with (INR 2); auto with real zarith.
apply Rle_trans with (S 1 × (Rabs (r - x1)) + S 1 ×Rabs (r - x2))%R;[right; ring|idtac].
apply Rle_trans with ( powerRZ radix (- dExp b)+ (/2)*powerRZ radix (- dExp b))%R;[idtac|simpl; right; field].
apply Rplus_le_compat.
apply Rle_trans with (Fulp b radix p x1).
unfold FtoRradix; apply ClosestUlp; auto.
rewrite CanonicFulp; auto.
rewrite <- I; unfold FtoR; simpl; right; ring.
apply Rle_trans with (Fulp b' radix p x2).
unfold FtoRradix; apply ClosestUlp; auto.
rewrite <- H; auto.
apply Rle_trans with (powerRZ radix (Fexp x2)).
unfold Fulp; apply Rle_powerRZ; auto with zarith real.
apply FcanonicLeastExp with radix b' p; auto with zarith.
rewrite <- H; auto.
rewrite FnormalizeCorrect; auto with zarith real.
elim H3'; auto.
apply FnormalizeCanonic; auto with zarith.
rewrite <- H; auto.
elim H3'; auto.
apply Rmult_le_reg_l with 2%R; auto with real.
apply Rle_trans with (powerRZ radix (- dExp b));[idtac|right; field; auto with real].
apply Rle_trans with (radix × powerRZ radix (Fexp x2))%R;[apply Rmult_le_compat_r; auto with real zarith|idtac].
apply Rle_trans with (IZR 2); auto with real zarith.
apply Rle_trans with (powerRZ radix (Fexp x2+1)).
rewrite powerRZ_add; auto with real zarith; simpl; right; ring.
apply Rle_powerRZ; auto with real zarith.
intros H5; absurd ((Fexp x2 < - dExp b)%Z); auto with zarith.
Qed.
Theorem Underf_Err2: ∀ (r:R) (x1:float),
vNum b=vNum b' → (dExp b ≤ dExp b')%Z →
(Closest b radix r x1) →
(∃ x2:float, (Underf_Err x1 x2 r (3/4)%R) ∧ (Closest b' radix r x2)).
intros.
elim Underf_Err2_aux with r (Fnormalize radix b p x1); auto with zarith.
unfold Underf_Err; intros x2 tmp; elim tmp; intros T Z; elim T; intros V1 T'; elim T';
intros V2 T''; elim T''; intros V3 V4; clear T T' T'' tmp.
∃ x2; split; auto.
split; auto.
split; auto.
split; auto.
replace (x1-x2)%R with (Fnormalize radix b p x1 - x2)%R; auto with real.
unfold FtoRradix; rewrite FnormalizeCorrect; auto.
intros; apply trans_eq with (FtoRradix (Fnormalize radix b p x1)).
unfold FtoRradix; rewrite FnormalizeCorrect; auto.
apply V4; auto.
apply FnormalizeCanonic; auto with zarith; elim H1; auto.
apply ClosestCompatible with (1:=H1); auto.
rewrite <- FnormalizeCorrect with radix b p x1; auto.
apply FnormalizeBounded; auto with zarith; elim H1; auto.
Qed.
Theorem Underf_Err3: ∀ (x x' y y' z' z:float) (rx ry epsx epsy:R),
vNum b=vNum b' → (dExp b ≤ dExp b')%Z →
(Underf_Err x x' rx epsx) → (Underf_Err y y' ry epsy) →
(epsx+epsy ≤ (powerRZ radix (p-1) -1))%R →
(Fbounded b' z') → (FtoRradix z'=x'-y')%R →
(Fexp z' ≤ Fexp x')%Z → (Fexp z' ≤ Fexp y')%Z →
(Closest b radix (x-y) z) →
(Underf_Err z z' (x-y) (epsx+epsy)%R).
intros.
unfold Underf_Err.
split; auto.
split; auto.
unfold Underf_Err in H1; unfold Underf_Err in H2.
case (Zle_or_lt (- dExp b)%Z (Fexp z')); intros.
elim H1; intros V1 T; elim T; intros V2 T'; elim T'; intros V3 V4; clear T T' H1.
elim H2; intros W1 T; elim T; intros W2 T'; elim T'; intros W3 W4; clear T T' H2.
cut (FtoRradix z=z')%R;[intros H9'; rewrite H9'; split; auto|idtac].
ring_simplify (z'-z')%R; rewrite Rabs_R0.
apply Rle_trans with (0× powerRZ radix (- dExp b))%R;[right; ring|apply Rmult_le_compat_r; auto with real zarith].
apply Rle_trans with (0+0)%R; [right; ring|apply Rplus_le_compat; auto with real].
apply Rmult_le_reg_l with (powerRZ radix (- dExp b))%R; auto with real zarith;
ring_simplify (powerRZ radix (- dExp b) × 0)%R; rewrite Rmult_comm.
apply Rle_trans with (2:=V3); auto with real.
apply Rmult_le_reg_l with (powerRZ radix (- dExp b))%R; auto with real zarith;
ring_simplify (powerRZ radix (- dExp b) × 0)%R; rewrite Rmult_comm.
apply Rle_trans with (2:=W3); auto with real.
unfold FtoRradix; apply sym_eq.
apply RoundedModeProjectorIdemEq with b p (Closest b radix); auto with zarith.
apply ClosestRoundedModeP with p; auto with zarith.
elim H4; intros; split; auto with zarith.
rewrite H; auto.
fold FtoRradix; rewrite H5.
rewrite <- V4; auto with zarith.
rewrite <- W4; auto with zarith real.
elim H1; intros V1 T; elim T; intros V2 T'; elim T'; intros V3 V4; clear T T' H1.
elim H2; intros W1 T; elim T; intros W2 T'; elim T'; intros W3 W4; clear T T' H2.
split;[idtac|intros; absurd (- dExp b ≤ Fexp z')%Z; auto with zarith].
replace (z-z')%R with (-((x-y)-z)+((x-x')+-(y-y')))%R;[idtac|rewrite H5; ring].
apply Rle_trans with (1:=Rabs_triang (- (x - y - z))%R ((x - x') + - (y - y'))%R).
apply Rle_trans with ((Rabs (- (x - y - z))) + (Rabs (x - x') +(Rabs (- (y - y')))))%R;
[apply Rplus_le_compat_l; apply Rabs_triang|idtac].
rewrite Rabs_Ropp; rewrite Rabs_Ropp.
apply Rle_trans with (0 + ( epsx × powerRZ radix (- dExp b)
+ epsy × powerRZ radix (- dExp b)))%R;[idtac|right; ring].
apply Rplus_le_compat;[idtac|apply Rplus_le_compat; auto with real].
cut (FtoRradix (Fnormalize radix b p z)=x-y)%R.
unfold FtoRradix; rewrite FnormalizeCorrect; auto.
fold FtoRradix; intros T; rewrite T; ring_simplify (x - y - (x - y))%R; rewrite Rabs_R0; auto with real.
unfold FtoRradix, Rminus; rewrite <- Fopp_correct; auto.
apply plusExact1 with b p; auto.
elim V1; auto.
apply oppBounded; elim W1; auto.
rewrite Fopp_correct; auto with real.
apply ClosestCompatible with (1:=H8); auto.
rewrite FnormalizeCorrect; auto with real.
apply FnormalizeBounded; auto with zarith; elim H8; auto.
apply Zle_trans with (-(dExp b))%Z.
2: apply Zmin_Zle.
2: elim V1; intros T1 T2; elim T1; auto.
2: elim W1; intros T1 T2; elim T1; auto.
apply Zle_trans with (Fexp (Float (pPred (vNum b)) (-(dExp b))%Z));
[idtac| simpl; auto with zarith].
apply Fcanonic_Rle_Zle with radix b p; auto with zarith.
apply FnormalizeCanonic; auto with zarith; elim H8; auto.
apply FcanonicPpred with p; auto with zarith.
rewrite (Rabs_right ((FtoR radix (Float (pPred (vNum b)) (- dExp b))))).
rewrite FnormalizeCorrect; auto with zarith.
apply RoundAbsMonotoner with b p (Closest b radix) (x-y)%R; auto.
apply ClosestRoundedModeP with p; auto with zarith.
assert (Fcanonic radix b (Float (pPred (vNum b)) (- dExp b)));
[apply FcanonicPpred with p; auto with zarith | apply FcanonicBound with radix; auto].
replace (x-y)%R with ((x-x')+-(y-y')+z')%R;[idtac|rewrite H5; ring].
apply Rle_trans with (1:=Rabs_triang (x - x' + - (y - y'))%R z').
apply Rle_trans with ((powerRZ radix (p - 1) - 1)*powerRZ radix (-(dExp b)) +
(powerRZ radix p - 1)*powerRZ radix (-(dExp b)-1))%R;[apply Rplus_le_compat|idtac].
apply Rle_trans with (1:=Rabs_triang (x-x')%R (-(y-y'))%R); rewrite Rabs_Ropp.
apply Rle_trans with (epsx × powerRZ radix (- dExp b)+ epsy × powerRZ radix (- dExp b))%R; auto with real.
apply Rle_trans with ((epsx+epsy) × powerRZ radix (- dExp b))%R;[right; ring|idtac].
apply Rmult_le_compat_r; auto with real zarith.
unfold FtoRradix; rewrite <- Fabs_correct; auto.
unfold Fabs, FtoR; simpl.
apply Rmult_le_compat; auto with real zarith.
elim H4; intros.
apply Rle_trans with (IZR (Zpred (Zpos (vNum b')))); auto with real zarith.
unfold Zpred, Zminus; rewrite plus_IZR.
rewrite <- H; rewrite pGivesBound; rewrite Zpower_nat_Z_powerRZ; auto with real zarith.
apply Rle_powerRZ; auto with real zarith.
apply Rle_trans with ((powerRZ radix p - 1) × powerRZ radix (- dExp b))%R.
apply Rle_trans with (- powerRZ radix (- dExp b)+powerRZ radix p
× powerRZ radix (- dExp b))%R;[idtac|right; ring].
apply Rle_trans with (- powerRZ radix (- dExp b)+ ((powerRZ radix (p - 1)× powerRZ radix (- dExp b)+
(powerRZ radix p×powerRZ radix (- dExp b - 1) - powerRZ radix (- dExp b - 1)))))%R;
[right; ring|apply Rplus_le_compat_l].
repeat rewrite <- powerRZ_add; auto with real zarith.
replace ((p + (- dExp b - 1)))%Z with (p - 1 + - dExp b)%Z;[idtac|ring].
apply Rle_trans with (powerRZ radix (p - 1 + - dExp b) +
(powerRZ radix (p - 1 + - dExp b) - 0))%R; auto with real zarith.
apply Rplus_le_compat_l; unfold Rminus; apply Rplus_le_compat_l; auto with real zarith.
apply Rle_trans with (2*(powerRZ radix (p - 1 + - dExp b)))%R;[right; ring|idtac].
apply Rle_trans with (radix*(powerRZ radix (p - 1 + - dExp b)))%R;
[apply Rmult_le_compat_r; auto with real zarith|idtac].
apply Rle_trans with (IZR 2); auto with real zarith.
unfold Zminus; repeat rewrite powerRZ_add; auto with real zarith; simpl; right; field; auto with real zarith.
unfold FtoR; simpl.
unfold pPred, Zpred, Zminus; rewrite plus_IZR.
rewrite pGivesBound; rewrite Zpower_nat_Z_powerRZ; simpl; auto with real zarith.
apply Rle_ge; apply LeFnumZERO; auto.
simpl; apply Zlt_le_weak.
apply pPredMoreThanOne with radix p; auto with zarith float.
Qed.
Theorem Underf_Err3_bis: ∀ (x x' y y' z' z:float) (rx ry epsx epsy:R),
(4 ≤ p) →
vNum b=vNum b' → (dExp b ≤ dExp b')%Z →
(Underf_Err x x' rx epsx) → (Underf_Err y y' ry epsy) →
(epsx+epsy ≤ 7)%R →
(Fbounded b' z') → (FtoRradix z'=x'-y')%R →
(Fexp z' ≤ Fexp x')%Z → (Fexp z' ≤ Fexp y')%Z →
(Closest b radix (x-y) z) →
(Underf_Err z z' (x-y) (epsx+epsy)%R).
intros.
apply Underf_Err3 with x' y' rx ry; auto.
apply Rle_trans with (1:=H4).
apply Rle_trans with (8-1)%R;[right; ring|unfold Rminus; apply Rplus_le_compat_r].
apply Rle_trans with (powerRZ radix 3)%R; auto with real zarith.
apply Rle_trans with (powerRZ 2 3)%R; auto with real zarith.
simpl; right; ring.
simpl; auto with real zarith.
assert (2 ≤ radix)%R;[apply Rle_trans with (IZR 2); auto with real zarith|idtac].
ring_simplify (2×1)%R; ring_simplify (radix×1)%R.
apply Rmult_le_compat; auto with real zarith.
apply Rlt_le; apply Rmult_lt_0_compat; auto with real.
apply Rle_powerRZ; auto with zarith real.
Qed.
End Generic.
Section Sec1.
Variable radix : Z.
Variable b : Fbound.
Variables s t:nat.
Let b' := Bound
(P_of_succ_nat (pred (Zabs_nat (Zpower_nat radix (minus t s)))))
(dExp b).
Let bt := Bound
(P_of_succ_nat (pred (Zabs_nat (Zpower_nat radix s))))
(dExp b).
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 pGivesBound: Zpos (vNum b)=(Zpower_nat radix t).
Hypothesis SLe: (2 ≤ s)%nat.
Hypothesis SGe: (s ≤ t-2)%nat.
Hypothesis Hst1: (t-1 ≤ s+s)%Z.
Hypothesis Hst2: (s+s ≤ t+1)%Z.
Variables x x1 x2 y y1 y2 r e: float.
Hypotheses Nx: Fnormal radix b x.
Hypotheses Ny: Fnormal radix b y.
Hypothesis K: (-dExp b ≤ Fexp x +Fexp y)%Z.
Hypotheses rDef: Closest b radix (x×y) r.
Hypotheses eeq: (x×y=r+e)%R.
Hypotheses Xeq: (FtoRradix x=x1+x2)%R.
Hypotheses Yeq: (FtoRradix y=y1+y2)%R.
Hypotheses x2Le: (Rabs x2 ≤ (powerRZ radix (s+Fexp x)) /2)%R.
Hypotheses y2Le: (Rabs y2 ≤ (powerRZ radix (s+Fexp y)) /2)%R.
Hypotheses x1Exp: (s+Fexp x ≤ Fexp x1)%Z.
Hypotheses y1Exp: (s+Fexp y ≤ Fexp y1)%Z.
Hypotheses x2Exp: (Fexp x ≤ Fexp x2)%Z.
Hypotheses y2Exp: (Fexp y ≤ Fexp y2)%Z.
Lemma x2y2Le: (Rabs (x2×y2) ≤ (powerRZ radix (2×s+Fexp x+Fexp y)) /4)%R.
rewrite Rabs_mult.
apply Rle_trans with ((powerRZ radix (s + Fexp x) / 2)*(powerRZ radix (s + Fexp y) / 2))%R.
apply Rmult_le_compat; auto with real.
replace (2×s)%Z with (s+s)%Z; auto with zarith.
repeat rewrite powerRZ_add; auto with real zarith.
right; field.
Qed.
Lemma x2y1Le: (Rabs (x2×y1) < (powerRZ radix (t+s+Fexp x+Fexp y)) /2
+ (powerRZ radix (2×s+Fexp x+Fexp y)) /4)%R.
replace (x2×y1)%R with (x2×y+(-(x2×y2)))%R;[idtac|rewrite Yeq; ring].
apply Rle_lt_trans with (1:=Rabs_triang (x2×y)%R (-(x2×y2))%R).
rewrite Rabs_Ropp.
cut ((Rabs (x2 × y) < powerRZ radix (t + s + Fexp x + Fexp y) / 2))%R;[intros I1|idtac].
generalize x2y2Le; auto with real.
rewrite Rabs_mult.
apply Rlt_le_trans with ((powerRZ radix (s + Fexp x) / 2)*powerRZ radix (t+Fexp y))%R.
cut (Rabs y <powerRZ radix (t + Fexp y))%R; auto with real zarith.
intros I; apply Rle_lt_trans with (powerRZ radix (s + Fexp x) / 2 ×Rabs y)%R; auto with real.
apply Rmult_lt_compat_l; auto with real zarith.
unfold Rdiv; apply Rmult_lt_0_compat; auto with real zarith.
unfold FtoRradix; rewrite <- Fabs_correct; auto with zarith.
unfold FtoR, Fabs; simpl; rewrite powerRZ_add; auto with real zarith.
apply Rmult_lt_compat_r; auto with real zarith.
elim Ny; intros I1 I2; elim I1; intros.
apply Rlt_le_trans with (IZR (Zpos (vNum b))); auto with real zarith.
right; rewrite pGivesBound;rewrite Zpower_nat_Z_powerRZ; auto with real.
repeat rewrite powerRZ_add; auto with real zarith.
unfold Rdiv; right; ring.
Qed.
Lemma x1y2Le: (Rabs (x1×y2) < (powerRZ radix (t+s+Fexp x+Fexp y)) /2
+ (powerRZ radix (2×s+Fexp x+Fexp y)) /4)%R.
replace (x1×y2)%R with (x×y2+(-(x2×y2)))%R;[idtac|rewrite Xeq; ring].
apply Rle_lt_trans with (1:=Rabs_triang (x×y2)%R (-(x2×y2))%R).
rewrite Rabs_Ropp.
cut ((Rabs (x × y2) < powerRZ radix (t + s + Fexp x + Fexp y) / 2))%R;[intros I1|idtac].
generalize x2y2Le; auto with real.
rewrite Rabs_mult.
apply Rlt_le_trans with (powerRZ radix (t+Fexp x)*(powerRZ radix (s + Fexp y) / 2))%R.
cut (Rabs x <powerRZ radix (t + Fexp x))%R; auto with real zarith.
intros I; apply Rle_lt_trans with (Rabs x*(powerRZ radix (s + Fexp y) / 2))%R; auto with real.
apply Rmult_lt_compat_r; auto with real zarith.
unfold Rdiv; apply Rmult_lt_0_compat; auto with real zarith.
unfold FtoRradix; rewrite <- Fabs_correct; auto with zarith.
unfold FtoR, Fabs; simpl; rewrite powerRZ_add; auto with real zarith.
apply Rmult_lt_compat_r; auto with real zarith.
elim Nx; intros I1 I2; elim I1; intros.
apply Rlt_le_trans with (IZR (Zpos (vNum b))); auto with real zarith.
right; rewrite pGivesBound;rewrite Zpower_nat_Z_powerRZ; auto with real.
repeat rewrite powerRZ_add; auto with real zarith.
unfold Rdiv; right; ring.
Qed.
Lemma eLe: (Rabs e ≤ (powerRZ radix (t+Fexp x+Fexp y)) /2)%R.
apply Rmult_le_reg_l with (INR 2); auto with real zarith.
replace (FtoRradix e) with (x×y-r)%R;[idtac|rewrite eeq; ring].
apply Rle_trans with (Fulp b radix t r).
unfold FtoRradix; apply ClosestUlp; auto with zarith.
apply Rle_trans with (powerRZ radix (t + Fexp x + Fexp y));
[idtac|simpl; right; field; auto with real].
unfold Fulp; apply Rle_powerRZ; auto with real zarith.
apply Zle_trans with (Fexp (Float (pPred (vNum b)) (t+Fexp x+Fexp y)));
[idtac|simpl; auto with zarith].
apply Fcanonic_Rle_Zle with radix b t; auto with zarith.
apply FnormalizeCanonic; auto with zarith.
elim rDef; auto.
replace (Float (pPred (vNum b)) (t + Fexp x + Fexp y)) with
(FPred b radix t (Float (nNormMin radix t) (t+1+Fexp x+Fexp y))).
apply FPredCanonic; auto with zarith.
apply FcanonicNnormMin; auto with zarith.
rewrite FPredSimpl2; auto with zarith.
simpl; unfold Zpred; auto with zarith.
replace (t+1+Fexp x +Fexp y+-1)%Z with (t+Fexp x+Fexp y)%Z; auto with zarith.
simpl; auto with zarith.
rewrite FnormalizeCorrect; auto with zarith.
rewrite (Rabs_right (FtoR radix (Float (pPred (vNum b)) (t + Fexp x + Fexp y)))%R).
2: apply Rle_ge; apply LeFnumZERO; simpl; auto with zarith.
2: generalize (pPredMoreThanOne b radix t); auto with zarith.
apply RoundAbsMonotoner with b t (Closest b radix) (x×y)%R; auto with zarith.
apply ClosestRoundedModeP with t; auto with zarith.
replace (Float (pPred (vNum b)) (t + Fexp x + Fexp y)) with
(FPred b radix t (Float (nNormMin radix t) (t+1+Fexp x+Fexp y))).
apply FBoundedPred; auto with zarith.
elim FnormalNnormMin with radix b t (t + 1 + Fexp x + Fexp y)%Z; auto with zarith.
rewrite FPredSimpl2; auto with zarith.
simpl; unfold Zpred; auto with zarith.
replace (t+1+Fexp x +Fexp y+-1)%Z with (t+Fexp x+Fexp y)%Z; auto with zarith.
simpl; auto with zarith.
rewrite Rabs_mult.
apply Rle_trans with ((FtoRradix (Float (pPred (vNum b)) (Fexp x)))*(powerRZ radix (t+Fexp y)))%R.
apply Rmult_le_compat; auto with real zarith.
unfold FtoRradix; rewrite <- Fabs_correct; auto with zarith.
unfold FtoR, Fabs; simpl.
apply Rmult_le_compat_r; auto with real zarith.
elim Nx; intros I1 I2; elim I1; intros; unfold pPred; auto with real zarith.
unfold FtoRradix; rewrite <- Fabs_correct; auto with zarith.
unfold FtoR, Fabs; simpl.
rewrite powerRZ_add; auto with real zarith.
apply Rmult_le_compat_r; auto with real zarith.
elim Ny; intros I1 I2; elim I1; intros; apply Rle_trans with (IZR (Zpos (vNum b))); auto with real zarith.
rewrite pGivesBound; rewrite Zpower_nat_Z_powerRZ; auto with real zarith.
unfold FtoRradix, FtoR; simpl; repeat rewrite powerRZ_add; auto with real zarith; right; ring.
Qed.
Lemma rExp: (t - 1 + Fexp x + Fexp y ≤ Fexp r)%Z.
apply Zle_trans with (Fexp (Float (nNormMin radix t) (t-1+Fexp x+Fexp y)));
[simpl; auto with zarith|idtac].
apply Zle_trans with (Fexp (Fnormalize radix b t r)).
apply Fcanonic_Rle_Zle with radix b t; auto with zarith.
apply FcanonicNnormMin; auto with zarith.
apply FnormalizeCanonic; auto with zarith.
elim rDef; auto.
rewrite FnormalizeCorrect; auto with zarith.
rewrite (Rabs_right (FtoR radix (Float (nNormMin radix t) (t-1 + Fexp x + Fexp y)))%R).
2: apply Rle_ge; apply LeFnumZERO; simpl; auto with zarith.
2: unfold nNormMin; auto with zarith.
apply RoundAbsMonotonel with b t (Closest b radix) (x×y)%R; auto with zarith.
apply ClosestRoundedModeP with t; auto with zarith.
apply FcanonicBound with radix; auto with zarith.
apply FcanonicNnormMin; auto with zarith.
fold FtoRradix; replace (FtoRradix (Float (nNormMin radix t) (t-1 + Fexp x + Fexp y))) with
((Float (nNormMin radix t) (Fexp x))*(Float (nNormMin radix t) (Fexp y)))%R.
rewrite Rabs_mult.
apply Rmult_le_compat.
unfold FtoRradix; apply LeFnumZERO; simpl; unfold nNormMin; auto with zarith.
unfold FtoRradix; apply LeFnumZERO; simpl; unfold nNormMin; auto with zarith.
unfold FtoRradix; rewrite <- Fabs_correct; auto with zarith; unfold FtoR; simpl.
apply Rmult_le_compat_r; auto with real zarith; apply Rmult_le_reg_l with (IZR radix); auto with real zarith.
rewrite <- mult_IZR; rewrite <- (PosNormMin radix b t); auto with zarith.
elim Nx; intros I1 I2; rewrite Zabs_Zmult in I2; rewrite Zabs_eq in I2; auto with real zarith.
rewrite <- mult_IZR; auto with real zarith.
unfold FtoRradix; rewrite <- Fabs_correct; auto with zarith; unfold FtoR; simpl.
apply Rmult_le_compat_r; auto with real zarith; apply Rmult_le_reg_l with (IZR radix); auto with real zarith.
rewrite <- mult_IZR; rewrite <- (PosNormMin radix b t); auto with zarith.
elim Ny; intros I1 I2; rewrite Zabs_Zmult in I2; rewrite Zabs_eq in I2; auto with real zarith.
rewrite <- mult_IZR; auto with real zarith.
unfold FtoRradix, FtoR; simpl.
rewrite powerRZ_add; auto with real zarith.
rewrite powerRZ_add; auto with real zarith.
replace (IZR (nNormMin radix t)) with (powerRZ radix (t-1));[ring|idtac].
unfold nNormMin; rewrite Zpower_nat_Z_powerRZ.
rewrite inj_pred; auto with zarith; unfold Zpred; auto with real zarith.
apply FcanonicLeastExp with radix b t; auto with real zarith.
rewrite FnormalizeCorrect; auto with zarith real.
elim rDef; auto.
apply FnormalizeCanonic; auto with zarith; elim rDef; auto.
Qed.
Lemma powerRZSumRle:∀ (e1 e2:Z),
(e2≤ e1)%Z →
(powerRZ radix e1 + powerRZ radix e2 ≤ powerRZ radix (e1+1))%R.
intros.
apply Rle_trans with (powerRZ radix e1 + powerRZ radix e1)%R;
[apply Rplus_le_compat_l; apply Rle_powerRZ; auto with real zarith|idtac].
apply Rle_trans with (powerRZ radix e1×2)%R;[right; ring|rewrite powerRZ_add; auto with real zarith].
apply Rmult_le_compat_l; auto with real zarith.
simpl; ring_simplify (radix×1)%R; replace 2%R with (IZR 2); auto with real zarith.
Qed.
Lemma Boundedt1: (∃ x':float, (FtoRradix x'=r-x1×y1)%R ∧ (Fbounded b x')
∧ (Fexp x'=t-1+Fexp x+Fexp y)%Z).
unfold FtoRradix; apply BoundedL with t (Fminus radix r (Fmult x1 y1)); auto with zarith.
unfold Fminus, Fopp, Fplus, Fmult; simpl.
apply Zmin_Zle; auto with zarith.
apply rExp.
rewrite Fminus_correct; auto with zarith; rewrite Fmult_correct; auto with real zarith.
fold FtoRradix.
replace (r-x1×y1)%R with ((-e)+x1×y2+x2×y1+x2×y2)%R.
2: apply trans_eq with (-e+x×y-(x+0)*y+x1×y2+x2×y1+x2×y2)%R;[ring|idtac].
2: rewrite eeq; rewrite Xeq; rewrite Yeq; ring.
apply Rle_lt_trans with ((Rabs e)+(Rabs (x1 × y2)) + (Rabs (x2 × y1)) + (Rabs (x2 × y2)))%R.
apply Rle_trans with (1:= Rabs_triang (-e+ x1 × y2 + x2 × y1) (x2 × y2)%R).
apply Rplus_le_compat_r.
apply Rle_trans with (1:= Rabs_triang (-e+ x1 × y2) (x2 × y1)%R).
apply Rplus_le_compat_r.
apply Rle_trans with (1:= Rabs_triang (-e) (x1 × y2)%R).
rewrite Rabs_Ropp; right; ring.
generalize eLe; generalize x1y2Le; generalize x2y1Le; generalize x2y2Le; intros.
apply Rlt_le_trans with ( (powerRZ radix (t + Fexp x + Fexp y) / 2) +
(powerRZ radix (t + s + Fexp x + Fexp y) / 2 +powerRZ radix (2 × s + Fexp x + Fexp y) / 4) +
(powerRZ radix (t + s + Fexp x + Fexp y) / 2 +powerRZ radix (2 × s + Fexp x + Fexp y) / 4) +
(powerRZ radix (2 × s + Fexp x + Fexp y) / 4))%R;
auto with real.
apply Rlt_le_trans with (powerRZ radix (t + Fexp x + Fexp y) / 2 +
(powerRZ radix (t + s + Fexp x + Fexp y) / 2 +
powerRZ radix (2 × s + Fexp x + Fexp y) / 4) +
(powerRZ radix (t + s + Fexp x + Fexp y) / 2 +
powerRZ radix (2 × s + Fexp x + Fexp y) / 4) + Rabs (x2 × y2))%R; auto with real.
apply Rplus_lt_compat_r.
apply Rle_lt_trans with (powerRZ radix (t + Fexp x + Fexp y) / 2 +
(powerRZ radix (t + s + Fexp x + Fexp y) / 2 +
powerRZ radix (2 × s + Fexp x + Fexp y) / 4) + Rabs (x2 × y1))%R; auto with real.
apply Rle_trans with (powerRZ radix (t + s + Fexp x + Fexp y)+
powerRZ radix (t + Fexp x + Fexp y) / 2 +3×powerRZ radix (2 × s + Fexp x + Fexp y) / 4)%R;
[right; field; auto with real|idtac].
assert (0 < 8)%R; auto with real.
apply Rlt_le_trans with 2%R; auto with real.
apply Rle_trans with 4%R; auto with real.
apply Rle_trans with (powerRZ radix (t + s + Fexp x + Fexp y) +
powerRZ radix (t + Fexp x + Fexp y) +
powerRZ radix (2 × s + Fexp x + Fexp y))%R;
[apply Rplus_le_compat; try apply Rplus_le_compat_l |idtac].
unfold Rdiv; apply Rle_trans with (powerRZ radix (t + Fexp x + Fexp y)×1)%R;[idtac|right; ring].
apply Rmult_le_compat_l; auto with real zarith.
apply Rle_trans with (/1)%R; auto with real.
unfold Rdiv; apply Rle_trans with (powerRZ radix (2×s + Fexp x + Fexp y)×1)%R;[idtac|right; ring].
apply Rle_trans with (powerRZ radix (2×s + Fexp x + Fexp y)*(3×/4))%R;[right; ring|idtac].
apply Rmult_le_compat_l; auto with real zarith.
assert (0<4)%R.
apply Rlt_le_trans with 2%R; auto with real.
apply Rmult_le_reg_l with (4%R); auto with real.
apply Rle_trans with 3%R;[right; field|idtac]; auto with real.
apply Rle_trans with 4%R; auto with real.
replace 3%R with (INR 3); auto with real zarith.
replace 4%R with (INR 4); auto with real zarith.
simpl; ring.
simpl; ring.
apply Rle_trans with (powerRZ radix (t + s + Fexp x + Fexp y) +
powerRZ radix (t +1+ Fexp x + Fexp y) +
powerRZ radix (2 × s + Fexp x + Fexp y))%R.
apply Rplus_le_compat_r; apply Rplus_le_compat_l.
apply Rle_powerRZ; auto with real zarith.
apply Rle_trans with (powerRZ radix (t + s + Fexp x + Fexp y) +
powerRZ radix (t+1 + Fexp x + Fexp y+1))%R.
rewrite Rplus_assoc; apply Rplus_le_compat_l.
apply powerRZSumRle; auto with zarith.
apply Rle_trans with (powerRZ radix (t + s + Fexp x + Fexp y+1)).
apply powerRZSumRle; auto with zarith.
apply Rle_powerRZ; auto with real zarith.
Qed.
Lemma Boundedt2: (∃ x':float, (FtoRradix x'=r-x1×y1-x1×y2)%R ∧ (Fbounded b x')
∧ (Fexp x'=s+Fexp x+Fexp y)%Z).
elim Boundedt1; intros t1 T; elim T; intros H1 T'; elim T'; intros H2 H3; clear T T'.
unfold FtoRradix; apply BoundedL with t (Fminus radix t1 (Fmult x1 y2)); auto with zarith.
unfold Fminus, Fopp, Fplus, Fmult; simpl.
apply Zmin_Zle; auto with zarith.
rewrite Fminus_correct; auto with zarith; rewrite Fmult_correct; auto with real zarith.
fold FtoRradix; rewrite H1; ring.
fold FtoRradix; replace (r-x1×y1-x1×y2)%R with ((-e)+x2×y1+x2×y2)%R.
2: apply trans_eq with (-e+x×y-(x+0)*y+x2×y1+x2×y2)%R;[ring|idtac].
2: rewrite eeq; rewrite Xeq; rewrite Yeq; ring.
apply Rle_lt_trans with ((Rabs e) + (Rabs (x2 × y1)) + (Rabs (x2 × y2)))%R.
apply Rle_trans with (1:= Rabs_triang (-e + x2 × y1) (x2 × y2)%R).
apply Rplus_le_compat_r.
apply Rle_trans with (1:= Rabs_triang (-e) (x2 × y1)%R).
rewrite Rabs_Ropp; right; ring.
generalize eLe; generalize x2y1Le; generalize x2y2Le; intros.
apply Rle_lt_trans with
( (Rabs e + Rabs (x2 × y1)+ (powerRZ radix (2 × s + Fexp x + Fexp y) / 4)))%R; auto with real.
apply Rlt_le_trans with (Rabs e + (powerRZ radix (t + s + Fexp x + Fexp y) / 2 +
powerRZ radix (2 × s + Fexp x + Fexp y) / 4)+powerRZ radix (2 × s + Fexp x + Fexp y) / 4)%R; auto with real.
apply Rle_trans with (powerRZ radix (t + Fexp x + Fexp y) / 2+ (powerRZ radix (t + s + Fexp x + Fexp y) / 2 +
powerRZ radix (2 × s + Fexp x + Fexp y) / 4) +
powerRZ radix (2 × s + Fexp x + Fexp y) / 4)%R; auto with real.
replace (s + Fexp x + Fexp y + t)%Z with (t+s+Fexp x+Fexp y)%Z;[idtac|ring].
apply Rplus_le_reg_l with (-((powerRZ radix (t + s + Fexp x + Fexp y) / 2)))%R.
apply Rle_trans with (/2× (powerRZ radix (t + Fexp x + Fexp y)+ powerRZ radix (2 × s + Fexp x + Fexp y)))%R;
[right; field; auto with real|idtac].
apply Rle_trans with (/2× powerRZ radix (t + s + Fexp x + Fexp y))%R;[idtac|right; field; auto with real].
apply Rmult_le_compat_l; auto with real.
apply Rle_trans with (powerRZ radix (t+1 + Fexp x + Fexp y) +
powerRZ radix (2 × s + Fexp x + Fexp y))%R; auto with real zarith.
apply Rle_trans with (powerRZ radix (t+1 + Fexp x + Fexp y+1)).
apply powerRZSumRle; auto with real zarith.
apply Rle_powerRZ; auto with real zarith.
Qed.
Lemma Boundedt3: (∃ x':float, (FtoRradix x'=r-x1×y1-x1×y2-x2×y1)%R ∧ (Fbounded b x')
∧ (Fexp x'=s+Fexp x+Fexp y)%Z).
elim Boundedt2; intros t2 T; elim T; intros H1 T'; elim T'; intros H2 H3; clear T T'.
unfold FtoRradix; apply BoundedL with t (Fminus radix t2 (Fmult x2 y1)); auto with zarith.
unfold Fminus, Fopp, Fplus, Fmult; simpl.
apply Zmin_Zle; auto with zarith.
rewrite Fminus_correct; auto with zarith; rewrite Fmult_correct; auto with real zarith.
fold FtoRradix; rewrite H1; ring.
fold FtoRradix; replace (r-x1×y1-x1×y2-x2×y1)%R with ((-e)+x2×y2)%R.
2: apply trans_eq with (-e+x×y-(x+0)*y+x2×y2)%R;[ring|idtac].
2: rewrite eeq; rewrite Xeq; rewrite Yeq; ring.
apply Rle_lt_trans with ((Rabs e) + (Rabs (x2 × y2)))%R.
apply Rle_trans with (1:= Rabs_triang (-e) (x2 × y2)%R).
rewrite Rabs_Ropp; right; ring.
generalize eLe; generalize x2y2Le; intros.
apply Rle_lt_trans with
(powerRZ radix (t + Fexp x + Fexp y) / 2+powerRZ radix (2 × s + Fexp x + Fexp y) / 4)%R; auto with real.
apply Rlt_le_trans with (powerRZ radix (t + Fexp x + Fexp y) +
powerRZ radix (2 × s + Fexp x + Fexp y) / 4)%R.
apply Rplus_lt_compat_r.
apply Rlt_le_trans with (powerRZ radix (t + Fexp x + Fexp y)×1)%R;[idtac|right; ring].
unfold Rdiv; apply Rmult_lt_compat_l; auto with real zarith.
apply Rlt_le_trans with (/1)%R; auto with real.
apply Rle_trans with (powerRZ radix (t+1 + Fexp x + Fexp y) +
powerRZ radix (2 × s + Fexp x + Fexp y))%R;[apply Rplus_le_compat|idtac].
apply Rle_powerRZ; auto with real zarith.
apply Rle_trans with (powerRZ radix (2×s + Fexp x + Fexp y)×1)%R;[idtac|right; ring].
unfold Rdiv; apply Rmult_le_compat_l; auto with real zarith.
assert (0 < 4)%R;[apply Rlt_le_trans with 2%R; auto with real|idtac].
apply Rmult_le_reg_l with 4%R; auto with real.
apply Rle_trans with 1%R;[right; field|ring_simplify (4×1)%R]; auto with real.
apply Rle_trans with 2%R; auto with real.
apply Rle_trans with (powerRZ radix (t + 1 + Fexp x + Fexp y+1)).
apply powerRZSumRle; auto with zarith.
apply Rle_powerRZ; auto with real zarith.
Qed.
Lemma Boundedt4: (∃ x':float, (FtoRradix x'=r-x1×y1-x1×y2-x2×y1-x2×y2)%R ∧ (Fbounded b x')).
elim errorBoundedMult with b radix t (Closest b radix) x y r; auto with zarith.
2: apply ClosestRoundedModeP with t; auto with zarith.
2: elim Nx; auto.
2: elim Ny; auto.
intros g T; elim T; intros H1 T'; elim T'; intros; clear T T'.
∃ (Fopp g); split.
unfold FtoRradix;rewrite Fopp_correct; rewrite H1; fold FtoRradix.
rewrite Xeq; rewrite Yeq; ring.
apply oppBounded; auto.
Qed.
Lemma Boundedt4_aux: (∃ x':float, (FtoRradix x'=r-x1×y1-x1×y2-x2×y1-x2×y2)%R ∧ (Fbounded b x')
∧ (Fexp x'=Fexp x+Fexp y)%Z).
elim errorBoundedMult with b radix t (Closest b radix) x y r; auto with zarith.
2: apply ClosestRoundedModeP with t; auto with zarith.
2: elim Nx; auto.
2: elim Ny; auto.
intros g T; elim T; intros H1 T'; elim T'; intros; clear T T'.
∃ (Fopp g); split.
unfold FtoRradix;rewrite Fopp_correct; rewrite H1; fold FtoRradix.
rewrite Xeq; rewrite Yeq; ring.
split;[apply oppBounded; auto|simpl; auto].
Qed.
Hypotheses Fx1: Fbounded b' x1.
Hypotheses Fx2: Fbounded bt x2.
Hypotheses Fy1: Fbounded b' y1.
Hypotheses Fy2: Fbounded bt y2.
Hypothesis Hst3: (t ≤ s+s)%Z.
Lemma p''GivesBound: Zpos (vNum bt)=(Zpower_nat radix s).
unfold bt in |- *; unfold vNum in |- ×.
apply
trans_eq
with
(Z_of_nat
(nat_of_P
(P_of_succ_nat
(pred (Zabs_nat (Zpower_nat radix s)))))).
unfold Z_of_nat in |- *; rewrite nat_of_P_o_P_of_succ_nat_eq_succ;
auto with zarith.
rewrite nat_of_P_o_P_of_succ_nat_eq_succ; auto with arith zarith.
cut (Zabs (Zpower_nat radix s) = Zpower_nat radix s).
intros H; pattern (Zpower_nat radix s) at 2 in |- *; rewrite <- H.
rewrite Zabs_absolu.
rewrite <- (S_pred (Zabs_nat (Zpower_nat radix s)) 0);
auto with arith zarith.
apply lt_Zlt_inv; simpl in |- *; auto with zarith arith.
rewrite <- Zabs_absolu; rewrite H; auto with arith zarith.
apply Zabs_eq; auto with arith zarith.
Qed.
Lemma Boundedx1y1_aux: (∃ x':float, (FtoRradix x'=x1×y1)%R ∧ (Fbounded b x')
∧ (Fexp x'=Fexp x1+Fexp y1)%Z ).
∃ (Fmult x1 y1).
split;[unfold FtoRradix; rewrite Fmult_correct; auto with real zarith|idtac].
split.
unfold Fmult; split; simpl; auto with zarith.
rewrite Zabs_Zmult.
elim Fx1; elim Fy1; intros.
apply Zlt_le_trans with (Zpos (vNum b')×Zpos (vNum b'))%Z; auto with zarith.
case (Zle_lt_or_eq 0%Z (Zabs (Fnum x1))); auto with zarith.
intros I; apply Zlt_le_trans with (Zabs (Fnum x1) × Zpos (vNum b'))%Z; auto with zarith.
apply Zmult_lt_compat_l; auto with zarith.
intros I; rewrite <- I; auto with zarith.
unfold b'; rewrite p'GivesBound; auto with zarith.
rewrite <- Zpower_nat_is_exp.
rewrite pGivesBound; auto with zarith.
simpl; auto.
Qed.
Lemma Boundedx1y1: (∃ x':float, (FtoRradix x'=x1×y1)%R ∧ (Fbounded b x')).
elim Boundedx1y1_aux; intros f T; elim T ; intros T1 T2; elim T2; intros.
∃ f; split; auto.
Qed.
Lemma Boundedx1y2_aux: (∃ x':float, (FtoRradix x'=x1×y2)%R ∧ (Fbounded b x')
∧ (Fexp x'=Fexp x1+Fexp y2)%Z ).
∃ (Fmult x1 y2).
split;[unfold FtoRradix; rewrite Fmult_correct; auto with real zarith|idtac].
split;[idtac|simpl; auto].
unfold Fmult; split; simpl; auto with zarith.
rewrite Zabs_Zmult.
elim Fx1; elim Fy2; intros.
apply Zlt_le_trans with (Zpos (vNum b')×Zpos (vNum bt))%Z; auto with zarith.
case (Zle_lt_or_eq 0%Z (Zabs (Fnum x1))); auto with zarith.
intros I; apply Zlt_le_trans with (Zabs (Fnum x1) × Zpos (vNum bt))%Z; auto with zarith.
apply Zmult_lt_compat_l; auto with zarith.
intros I; rewrite <- I; auto with zarith.
unfold b'; rewrite p'GivesBound; auto with zarith.
rewrite p''GivesBound; auto with zarith.
rewrite <- Zpower_nat_is_exp.
rewrite pGivesBound; auto with zarith.
Qed.
Lemma Boundedx1y2: (∃ x':float, (FtoRradix x'=x1×y2)%R ∧ (Fbounded b x')).
elim Boundedx1y2_aux; intros f T; elim T ; intros T1 T2; elim T2; intros.
∃ f; split; auto.
Qed.
Lemma Boundedx2y1_aux: (∃ x':float, (FtoRradix x'=x2×y1)%R ∧ (Fbounded b x')
∧ (Fexp x'=Fexp x2+Fexp y1)%Z ).
∃ (Fmult x2 y1).
split;[unfold FtoRradix; rewrite Fmult_correct; auto with real zarith|idtac].
split;[idtac|simpl; auto].
unfold Fmult; split; simpl; auto with zarith.
rewrite Zabs_Zmult.
elim Fx2; elim Fy1; intros.
apply Zlt_le_trans with (Zpos (vNum bt)×Zpos (vNum b'))%Z; auto with zarith.
case (Zle_lt_or_eq 0%Z (Zabs (Fnum x2))); auto with zarith.
intros I; apply Zlt_le_trans with (Zabs (Fnum x2) × Zpos (vNum b'))%Z; auto with zarith.
apply Zmult_lt_compat_l; auto with zarith.
intros I; rewrite <- I; auto with zarith.
unfold b'; rewrite p'GivesBound; auto with zarith.
rewrite p''GivesBound; auto with zarith.
rewrite <- Zpower_nat_is_exp.
rewrite pGivesBound; auto with zarith.
Qed.
Lemma Boundedx2y1: (∃ x':float, (FtoRradix x'=x2×y1)%R ∧ (Fbounded b x')).
elim Boundedx2y1_aux; intros f T; elim T ; intros T1 T2; elim T2; intros.
∃ f; split; auto.
Qed.
End Sec1.
Section Algo.
Variable radix : Z.
Variable b : Fbound.
Variables t: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 pGivesBound: Zpos (vNum b)=(Zpower_nat radix t).
Hypotheses pGe: (4 ≤ t).
Variables x y p q hx tx p' q' hy ty x1y1 x1y2 x2y1 x2y2 r t1 t2 t3 t4:float.
Hypothesis Cx: (Fnormal radix b x).
Hypothesis Cy: (Fnormal radix b y).
Hypothesis Expoxy: (-dExp b ≤ Fexp x+Fexp y)%Z.
Let s:= t- div2 t.
Hypothesis A1: (Closest b radix (x*((powerRZ radix s)+1))%R p).
Hypothesis A2: (Closest b radix (x-p)%R q).
Hypothesis A3: (Closest b radix (q+p)%R hx).
Hypothesis A4: (Closest b radix (x-hx)%R tx).
Hypothesis B1: (Closest b radix (y*((powerRZ radix s)+1))%R p').
Hypothesis B2: (Closest b radix (y-p')%R q').
Hypothesis B3: (Closest b radix (q'+p')%R hy).
Hypothesis B4: (Closest b radix (y-hy)%R ty).
Hypothesis C1: (Closest b radix (hx×hy)%R x1y1).
Hypothesis C2: (Closest b radix (hx×ty)%R x1y2).
Hypothesis C3: (Closest b radix (tx×hy)%R x2y1).
Hypothesis C4: (Closest b radix (tx×ty)%R x2y2).
Hypothesis D1: (Closest b radix (x×y)%R r).
Hypothesis D2: (Closest b radix (r-x1y1)%R t1).
Hypothesis D3: (Closest b radix (t1-x1y2)%R t2).
Hypothesis D4: (Closest b radix (t2-x2y1)%R t3).
Hypothesis D5: (Closest b radix (t3-x2y2)%R t4).
Lemma SLe: (2 ≤ s)%nat.
unfold s; auto with zarith.
assert (2≤ t-div2 t)%Z; auto with zarith.
apply Zmult_le_reg_r with 2%Z; auto with zarith.
replace ((t-div2 t)*2)%Z with (2×t-2×div2 t)%Z; auto with zarith.
replace (2×div2 t)%Z with (Z_of_nat (Div2.double (div2 t))).
case (even_or_odd t); intros I.
rewrite <- even_double; auto with zarith.
apply Zle_trans with (2×t+1-(S ( Div2.double (div2 t))))%Z; auto with zarith.
rewrite <- odd_double; auto with zarith.
replace (Z_of_nat (S ( Div2.double (div2 t)))) with (1+ Div2.double (div2 t))%Z; auto with zarith.
rewrite inj_S; unfold Zsucc; auto with zarith.
unfold Div2.double; rewrite inj_plus; ring.
Qed.
Lemma SGe: (s ≤ t-2)%nat.
unfold s; auto with zarith.
assert (2≤ div2 t)%Z; auto with zarith.
apply Zmult_le_reg_r with 2%Z; auto with zarith.
replace (div2 t×2)%Z with (Z_of_nat (Div2.double (div2 t))).
case (even_or_odd t); intros I.
rewrite <- even_double; auto with zarith.
apply Zle_trans with (-1+(S ( Div2.double (div2 t))))%Z; auto with zarith.
rewrite <- odd_double; auto with zarith.
case (Zle_lt_or_eq 4 t); auto with zarith.
intros I2; absurd (odd t); auto.
intros I3; apply not_even_and_odd with t; auto.
replace t with (4%nat); auto with zarith.
apply even_S; apply odd_S; apply even_S; apply odd_S; apply even_O.
rewrite inj_S; unfold Zsucc; auto with zarith.
unfold Div2.double; rewrite inj_plus; ring.
Qed.
Lemma s2Ge: (t ≤ s + s)%Z.
unfold s.
assert (2*(div2 t) ≤ t)%Z; auto with zarith.
case (even_or_odd t); intros I.
apply Zle_trans with (Div2.double (div2 t)).
unfold Div2.double; rewrite inj_plus; auto with zarith.
rewrite <- even_double; auto with zarith.
apply Zle_trans with (-1+(S ( Div2.double (div2 t))))%Z; auto with zarith.
rewrite inj_S; unfold Zsucc; auto with zarith.
unfold Div2.double; rewrite inj_plus; auto with zarith.
rewrite <- odd_double; auto with zarith.
rewrite inj_minus1; auto with zarith.
Qed.
Lemma s2Le: (s + s ≤ t + 1)%Z.
unfold s.
rewrite inj_minus1; auto with zarith.
2: generalize (lt_div2 t); auto with zarith.
assert (t≤ 2*(div2 t)+1)%Z; auto with zarith.
case (even_or_odd t); intros I.
apply Zle_trans with ((Div2.double (div2 t)+1))%Z.
2:unfold Div2.double; rewrite inj_plus; auto with zarith.
rewrite <- even_double; auto with zarith.
apply Zle_trans with ((S ( Div2.double (div2 t))))%Z; auto with zarith.
2: rewrite inj_S; unfold Zsucc; auto with zarith.
2: unfold Div2.double; rewrite inj_plus; auto with zarith.
rewrite <- odd_double; auto with zarith.
Qed.
Theorem Dekker_aux: (∃ x':float, (FtoRradix x'=tx×ty)%R ∧ (Fbounded b x'))
→ (x×y=r-t4)%R.
intros L1.
generalize SLe; intros Sle; generalize SGe; intros Sge.
generalize s2Le; intros s2le; generalize s2Ge; intros s2ge.
generalize VeltkampU; intros V.
elim V with radix b s t x p q hx tx; auto.
2: left; auto.
intros MX1 T; elim T; intros MX2 T'; clear T; elim T'; intros T1 T2; clear T'.
elim T1; intros hx' T1'; elim T1'; intros MX3 T1''; elim T1''; intros MX4 MX5; clear T1 T1' T1''.
lapply MX5; auto; clear MX5; intros MX5.
elim T2; intros tx' T1'; elim T1'; intros MX6 T1''; elim T1''; intros MX7 MX8; clear T2 T1' T1''.
elim V with radix b s t y p' q' hy ty; auto.
2: left; auto.
intros MY1 T; elim T; intros MY2 T'; clear T; elim T'; intros T1 T2; clear T'.
elim T1; intros hy' T1'; elim T1'; intros MY3 T1''; elim T1''; intros MY4 MY5; clear T1 T1' T1''.
lapply MY5; auto; clear MY5; intros MY5.
elim T2; intros ty' T1'; elim T1'; intros MY6 T1''; elim T1''; intros MY7 MY8; clear T2 T1' T1'' V.
generalize Boundedt1; intros V.
elim V with radix b s t x hx' tx' y hy' ty' r (Fminus radix (Fmult x y) r); auto with zarith real; clear V.
2:rewrite Fminus_correct; auto with zarith; rewrite Fmult_correct; auto with zarith; ring.
2:rewrite MX6; rewrite MX3; exact MX2.
2:rewrite MY6; rewrite MY3; exact MY2.
2:rewrite MX6; replace (FtoR radix tx) with (FtoR radix x-FtoR radix hx)%R; auto with real.
2:rewrite MX2; ring.
2:rewrite MY6; replace (FtoR radix ty) with (FtoR radix y-FtoR radix hy)%R; auto with real.
2:rewrite MY2; ring.
intros t1' T; elim T; intros M11 T'; elim T'; intros M12 M13; clear T T'.
generalize Boundedt2; intros V.
elim V with radix b s t x hx' tx' y hy' ty' r (Fminus radix (Fmult x y) r); auto with zarith real; clear V.
2:rewrite Fminus_correct; auto with zarith; rewrite Fmult_correct; auto with zarith; ring.
2:rewrite MX6; rewrite MX3; exact MX2.
2:rewrite MY6; rewrite MY3; exact MY2.
2:rewrite MX6; replace (FtoR radix tx) with (FtoR radix x-FtoR radix hx)%R; auto with real.
2:rewrite MX2; ring.
2:rewrite MY6; replace (FtoR radix ty) with (FtoR radix y-FtoR radix hy)%R; auto with real.
2:rewrite MY2; ring.
intros t2' T; elim T; intros M21 T'; elim T'; intros M22 M23; clear T T'.
generalize Boundedt3; intros V.
elim V with radix b s t x hx' tx' y hy' ty' r (Fminus radix (Fmult x y) r); auto with zarith real; clear V.
2:rewrite Fminus_correct; auto with zarith; rewrite Fmult_correct; auto with zarith; ring.
2:rewrite MX6; rewrite MX3; exact MX2.
2:rewrite MY6; rewrite MY3; exact MY2.
2:rewrite MX6; replace (FtoR radix tx) with (FtoR radix x-FtoR radix hx)%R; auto with real.
2:rewrite MX2; ring.
2:rewrite MY6; replace (FtoR radix ty) with (FtoR radix y-FtoR radix hy)%R; auto with real.
2:rewrite MY2; ring.
intros t3' T; elim T; intros M31 T'; elim T'; intros M32 M33; clear T T'.
generalize Boundedt4; intros V.
elim V with radix b s t x hx' tx' y hy' ty' r ; auto with zarith real; clear V.
2:rewrite MX6; rewrite MX3; exact MX2.
2:rewrite MY6; rewrite MY3; exact MY2.
intros t4' T; elim T; intros M41 M42; clear T.
cut (FtoRradix t4=r-x×y)%R; auto with real.
intros V; rewrite V; ring.
apply sym_eq.
apply trans_eq with (FtoRradix t4').
unfold FtoRradix; rewrite M41; rewrite MX2; rewrite MY2.
rewrite MX3; rewrite MX6; rewrite MY3; rewrite MY6; ring.
unfold FtoRradix; apply RoundedModeProjectorIdemEq with b t (Closest b radix); auto with zarith.
apply ClosestRoundedModeP with t; auto with zarith.
replace (FtoR radix t4') with (t3 - x2y2)%R; auto.
replace (FtoRradix t3) with (FtoRradix t3').
replace (FtoRradix x2y2) with (tx×ty)%R.
unfold FtoRradix; rewrite M31; rewrite M41.
rewrite <- MY6; rewrite <- MX6; ring.
elim L1; intros v T; elim T; intros L2 L3.
rewrite <- L2; unfold FtoRradix.
apply RoundedModeProjectorIdemEq with b t (Closest b radix); auto with zarith.
apply ClosestRoundedModeP with t; auto with zarith.
replace (FtoR radix v) with (tx×ty)%R; auto with real.
unfold FtoRradix; apply RoundedModeProjectorIdemEq with b t (Closest b radix); auto with zarith.
apply ClosestRoundedModeP with t; auto with zarith.
replace (FtoR radix t3') with (t2-x2y1)%R; auto with real.
replace (FtoRradix t2) with (FtoRradix t2').
replace (FtoRradix x2y1) with (tx×hy)%R.
unfold FtoRradix; rewrite M21; rewrite M31.
rewrite <- MX6; rewrite <- MY3; ring.
elim Boundedx2y1 with radix b s t x tx' y hy'; auto with zarith.
intros v T; elim T; intros L2 L3.
apply trans_eq with (FtoR radix v).
unfold FtoRradix; rewrite L2; rewrite MX6; rewrite MY3; ring.
unfold FtoRradix; apply RoundedModeProjectorIdemEq with b t (Closest b radix); auto with zarith.
apply ClosestRoundedModeP with t; auto with zarith.
replace (FtoR radix v) with (tx×hy)%R; auto with real.
unfold FtoRradix; rewrite L2; rewrite MX6; rewrite MY3; ring.
unfold FtoRradix; apply RoundedModeProjectorIdemEq with b t (Closest b radix); auto with zarith.
apply ClosestRoundedModeP with t; auto with zarith.
replace (FtoR radix t2') with (t1-x1y2)%R; auto with real.
replace (FtoRradix t1) with (FtoRradix t1').
replace (FtoRradix x1y2) with (hx×ty)%R.
unfold FtoRradix; rewrite M21; rewrite M11.
rewrite <- MX3; rewrite <- MY6; ring.
elim Boundedx1y2 with radix b s t x hx' y ty'; auto with zarith.
intros v T; elim T; intros L2 L3; clear T.
apply trans_eq with (FtoR radix v).
unfold FtoRradix; rewrite L2; rewrite MY6; rewrite MX3; ring.
unfold FtoRradix; apply RoundedModeProjectorIdemEq with b t (Closest b radix); auto with zarith.
apply ClosestRoundedModeP with t; auto with zarith.
replace (FtoR radix v) with (hx×ty)%R; auto with real.
unfold FtoRradix; rewrite L2; rewrite MY6; rewrite MX3; ring.
unfold FtoRradix; apply RoundedModeProjectorIdemEq with b t (Closest b radix); auto with zarith.
apply ClosestRoundedModeP with t; auto with zarith.
replace (FtoR radix t1') with (r-x1y1)%R; auto with real.
replace (FtoRradix x1y1) with (hx×hy)%R.
unfold FtoRradix; rewrite M11; rewrite MY3; rewrite MX3; ring.
elim Boundedx1y1 with radix b s t x hx' y hy'; auto with zarith.
intros v T; elim T; intros L2 L3; clear T.
apply trans_eq with (FtoR radix v).
unfold FtoRradix; rewrite L2; rewrite MY3; rewrite MX3; ring.
unfold FtoRradix; apply RoundedModeProjectorIdemEq with b t (Closest b radix); auto with zarith.
apply ClosestRoundedModeP with t; auto with zarith.
replace (FtoR radix v) with (hx×hy)%R; auto with real.
unfold FtoRradix; rewrite L2; rewrite MY3; rewrite MX3; ring.
Qed.
Theorem Boundedx2y2: (radix=2)%Z ∨ (even t) →
(∃ x':float, (FtoRradix x'=tx×ty)%R ∧ (Fbounded b x') ∧ (Fexp x+Fexp y ≤ Fexp x')%Z).
intros H; case H; clear H; intros H.
generalize SLe; intros Sle; generalize SGe; intros Sge.
elim Veltkamp_tail2 with radix b s t x p q hx tx; auto.
2: elim Cx; auto.
intros x2 T; elim T; intros G1 T'; elim T'; intros G2 T''; elim T''; intros G3 G4; clear T T' T''.
elim Veltkamp_tail2 with radix b s t y p' q' hy ty; auto.
2: elim Cy; auto.
intros y2 T; elim T; intros J1 T'; elim T'; intros J2 T''; elim T''; intros J3 J4; clear T T' T''.
∃ (Fmult x2 y2).
split;[unfold FtoRradix; rewrite Fmult_correct; auto with real zarith|idtac].
rewrite G1; rewrite J1; ring.
split.
unfold Fmult; split; simpl; auto with zarith.
rewrite Zabs_Zmult.
elim J3; elim G3; replace (Zpos
(vNum
(Bound
(P_of_succ_nat (pred (Zabs_nat (Zpower_nat radix (s - 1)))))
(dExp b))))%Z with (Zpower_nat radix (s - 1)); intros.
apply Zlt_le_trans with (Zpower_nat radix (s - 1)×Zpower_nat radix (s - 1))%Z; auto with zarith.
case (Zle_lt_or_eq 0%Z (Zabs (Fnum x2))); auto with zarith.
intros I; apply Zlt_le_trans with (Zabs (Fnum x2) × Zpower_nat radix (s-1))%Z; auto with zarith.
apply Zmult_lt_compat_l; auto with zarith.
intros I; rewrite <- I; auto with zarith.
rewrite pGivesBound; rewrite <- Zpower_nat_is_exp; auto with zarith.
assert ((s-1+(s-1)) ≤ t)%Z; auto with zarith.
generalize s2Le; auto with zarith.
apply sym_eq; unfold vNum in |- ×.
apply
trans_eq
with
(Z_of_nat
(nat_of_P
(P_of_succ_nat
(pred (Zabs_nat (Zpower_nat radix (s-1))))))).
unfold Z_of_nat in |- *; rewrite nat_of_P_o_P_of_succ_nat_eq_succ;
auto with zarith.
rewrite nat_of_P_o_P_of_succ_nat_eq_succ; auto with arith zarith.
cut (Zabs (Zpower_nat radix (s-1)) = Zpower_nat radix (s-1)).
intros HA; pattern (Zpower_nat radix (s-1)) at 2 in |- *; rewrite <- HA.
rewrite Zabs_absolu.
rewrite <- (S_pred (Zabs_nat (Zpower_nat radix (s-1))) 0);
auto with arith zarith.
apply lt_Zlt_inv; simpl in |- *; auto with zarith arith.
rewrite <- Zabs_absolu; rewrite HA; auto with arith zarith.
apply Zabs_eq; auto with arith zarith.
apply Zle_trans with (Fexp (Fnormalize radix b t x)+Fexp (Fnormalize radix b t y))%Z; auto with zarith.
rewrite FcanonicFnormalizeEq; auto with zarith.
rewrite FcanonicFnormalizeEq; auto with zarith.
left; auto.
left; auto.
apply Zle_trans with (Fexp (Fnormalize radix b t x)+Fexp (Fnormalize radix b t y))%Z; simpl; auto with zarith.
rewrite FcanonicFnormalizeEq; auto with zarith.
rewrite FcanonicFnormalizeEq; auto with zarith.
left; auto.
left; auto.
generalize SLe; intros Sle; generalize SGe; intros Sge.
elim Veltkamp_tail with radix b s t x p q hx tx; auto.
2: elim Cx; auto.
intros x2 T; elim T; intros G1 T'; elim T'; intros G2 T''; elim T''; intros G3 G4; clear T T' T''.
elim Veltkamp_tail with radix b s t y p' q' hy ty; auto.
2: elim Cy; auto.
intros y2 T; elim T; intros J1 T'; elim T'; intros J2 T''; elim T''; intros J3 J4; clear T T' T''.
∃ (Fmult x2 y2).
split;[unfold FtoRradix; rewrite Fmult_correct; auto with real zarith|idtac].
rewrite G1; rewrite J1; auto with real.
split.
unfold Fmult; split; simpl; auto with zarith.
rewrite Zabs_Zmult.
elim J3; elim G3; replace (Zpos
(vNum
(Bound
(P_of_succ_nat (pred (Zabs_nat (Zpower_nat radix (s)))))
(dExp b))))%Z with (Zpower_nat radix (s)); intros.
apply Zlt_le_trans with (Zpower_nat radix s×Zpower_nat radix s)%Z; auto with zarith.
case (Zle_lt_or_eq 0%Z (Zabs (Fnum x2))); auto with zarith.
intros I; apply Zlt_le_trans with (Zabs (Fnum x2) × Zpower_nat radix s)%Z; auto with zarith.
apply Zmult_lt_compat_l; auto with zarith.
intros I; rewrite <- I; auto with zarith.
rewrite <- Zpower_nat_is_exp; rewrite pGivesBound; auto with zarith.
assert (2×s ≤ t)%Z; auto with zarith.
unfold s.
rewrite inj_minus1; auto with zarith.
assert (t ≤ 2*(div2 t))%Z; auto with zarith.
apply Zle_trans with (Div2.double (div2 t)).
2: unfold Div2.double; rewrite inj_plus; auto with zarith.
rewrite <- even_double; auto with zarith.
generalize (lt_div2 t); auto with zarith.
rewrite p''GivesBound; auto.
apply Zle_trans with (Fexp (Fnormalize radix b t x)+Fexp (Fnormalize radix b t y))%Z; auto with zarith.
rewrite FcanonicFnormalizeEq; auto with zarith.
rewrite FcanonicFnormalizeEq; auto with zarith.
left; auto.
left; auto.
apply Zle_trans with (Fexp (Fnormalize radix b t x)+Fexp (Fnormalize radix b t y))%Z; auto with zarith.
rewrite FcanonicFnormalizeEq; auto with zarith.
rewrite FcanonicFnormalizeEq; auto with zarith.
left; auto.
left; auto.
simpl; auto with zarith.
Qed.
Theorem DekkerN: (radix=2)%Z ∨ (even t) → (x×y=r-t4)%R.
intros H; apply Dekker_aux.
elim Boundedx2y2; auto.
intros f T; ∃ f; intuition.
Qed.
End Algo.
Section AlgoS1.
Variable radix : Z.
Variable b : Fbound.
Variables t: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 pGivesBound: Zpos (vNum b)=(Zpower_nat radix t).
Hypotheses pGe: (4 ≤ t).
Variables x y p q hx tx p' q' hy ty x1y1 x1y2 x2y1 x2y2 r t1 t2 t3 t4:float.
Hypothesis Cx: (Fnormal radix b x).
Hypothesis Cy: (Fsubnormal radix b y).
Hypothesis Expoxy: (-dExp b ≤ Fexp x+Fexp y)%Z.
Let s:= t- div2 t.
Hypothesis A1: (Closest b radix (x*((powerRZ radix s)+1))%R p).
Hypothesis A2: (Closest b radix (x-p)%R q).
Hypothesis A3: (Closest b radix (q+p)%R hx).
Hypothesis A4: (Closest b radix (x-hx)%R tx).
Hypothesis B1: (Closest b radix (y*((powerRZ radix s)+1))%R p').
Hypothesis B2: (Closest b radix (y-p')%R q').
Hypothesis B3: (Closest b radix (q'+p')%R hy).
Hypothesis B4: (Closest b radix (y-hy)%R ty).
Hypothesis C1: (Closest b radix (hx×hy)%R x1y1).
Hypothesis C2: (Closest b radix (hx×ty)%R x1y2).
Hypothesis C3: (Closest b radix (tx×hy)%R x2y1).
Hypothesis C4: (Closest b radix (tx×ty)%R x2y2).
Hypothesis D1: (Closest b radix (x×y)%R r).
Hypothesis D2: (Closest b radix (r-x1y1)%R t1).
Hypothesis D3: (Closest b radix (t1-x1y2)%R t2).
Hypothesis D4: (Closest b radix (t2-x2y1)%R t3).
Hypothesis D5: (Closest b radix (t3-x2y2)%R t4).
Theorem DekkerS1: (radix=2)%Z ∨ (even t) → (x×y=r-t4)%R.
intros H; unfold FtoRradix.
case (Req_dec 0%R y); intros Ny.
cut (FtoRradix r=0)%R;[intros Z1|idtac].
cut (FtoRradix t4=0)%R;[intros Z2|idtac].
fold FtoRradix; rewrite Z1; rewrite Z2; rewrite <- Ny; ring.
cut (FtoRradix hy=0)%R;[intros Z3|idtac].
cut (FtoRradix ty=0)%R;[intros Z4|idtac].
unfold FtoRradix; apply ClosestZero with b t (t3-x2y2)%R; auto with zarith.
cut (FtoRradix t3=0)%R;[intros Z5|idtac].
cut (FtoRradix x2y2=0)%R;[intros Z6|idtac].
rewrite Z5; rewrite Z6; ring.
unfold FtoRradix; apply ClosestZero with b t (tx×ty)%R; auto with zarith.
rewrite Z4; ring.
unfold FtoRradix; apply ClosestZero with b t (t2-x2y1)%R; auto with zarith.
cut (FtoRradix t2=0)%R;[intros Z5|idtac].
cut (FtoRradix x2y1=0)%R;[intros Z6|idtac].
rewrite Z5; rewrite Z6; ring.
unfold FtoRradix; apply ClosestZero with b t (tx×hy)%R; auto with zarith.
rewrite Z3; ring.
unfold FtoRradix; apply ClosestZero with b t (t1-x1y2)%R; auto with zarith.
cut (FtoRradix t1=0)%R;[intros Z5|idtac].
cut (FtoRradix x1y2=0)%R;[intros Z6|idtac].
rewrite Z5; rewrite Z6; ring.
unfold FtoRradix; apply ClosestZero with b t (hx×ty)%R; auto with zarith.
rewrite Z4; ring.
unfold FtoRradix; apply ClosestZero with b t (r-x1y1)%R; auto with zarith.
cut (FtoRradix x1y1=0)%R;[intros Z6|idtac].
rewrite Z1; rewrite Z6; ring.
unfold FtoRradix; apply ClosestZero with b t (hx×hy)%R; auto with zarith.
rewrite Z3; ring.
elim VeltkampU with radix b s t y p' q' hy ty; auto.
intros T1 T; elim T; intros H' T'; clear T1 T T'.
fold FtoRradix in H'; rewrite Z3 in H'; rewrite <- Ny in H'; auto with real.
apply trans_eq with (0+ty)%R; auto with real.
unfold s; apply SLe; auto.
unfold s; apply SGe; auto.
right; auto.
elim Veltkamp with radix b s t y p' q' hy; auto.
intros T1 T; elim T; intros hy' T'; elim T'; intros G1 T''; elim T''; intros ; clear T1 T T' T''.
unfold FtoRradix; rewrite <- G1.
apply ClosestZero with (Bound (P_of_succ_nat (pred (Zabs_nat (Zpower_nat radix (t - s)))))
(dExp b)) (t-s) (FtoR radix y)%R; auto with zarith.
apply p'GivesBound; auto with zarith.
assert (s ≤ t - 2)%Z; auto with zarith.
assert (s ≤ t - 2)%nat; auto with zarith.
unfold s; apply SGe; auto.
unfold s; apply SLe; auto.
unfold s; apply SGe; auto.
elim Cy; auto.
unfold FtoRradix; apply ClosestZero with b t (x×y)%R; auto with zarith.
rewrite <- Ny; ring.
elim bimplybplusNorm with radix b s t y; auto.
2: unfold s; apply SLe; auto.
2: unfold s; apply SGe; auto.
2: elim Cy; auto.
intros yy T; elim T; intros X1 X2; clear T.
rewrite <- X1.
assert (Fnormal radix (plusExp t b) x).
elim Cx; intros F1 F2; elim F1; intros.
split;[split|idtac]; unfold plusExp; simpl; auto with zarith.
cut (∀ (x:N) (y:positive), (x+(Zpos y)=(x +Npos y)%N)%Z).
intros T; simpl; rewrite <- T; auto with zarith.
apply Zle_trans with (-(dExp b))%Z; auto with zarith.
apply Zle_trans with (-(dExp b) + Zneg (P_of_succ_nat (pred (pred t))))%Z; auto with zarith.
apply Zeq_le; ring_simplify; auto with zarith.
apply Zle_trans with (-(dExp b)+0)%Z; auto with zarith.
intros;unfold Nplus.
case x0; auto with zarith.
assert (- dExp (plusExp t b) ≤ Fexp x + Fexp yy)%Z.
elim X2; intros F1 F2; elim F1; intros.
assert (0 ≤ Fexp x)%Z; auto with zarith.
apply Zplus_le_reg_l with (Fexp y).
rewrite (Zplus_comm (Fexp y) (Fexp x)); apply Zle_trans with (2:=Expoxy).
elim Cy; intros F1' F2'; elim F2'; auto with zarith.
assert (Closest (plusExp t b) radix
(FtoR radix x × (powerRZ radix (t - div2 t)%nat + 1)) p).
cut (FtoR radix x × (powerRZ radix (t - div2 t)%nat + 1) =
(FtoRradix (Fmult x (Float (Zpower_nat radix (t - div2 t)%nat + 1) 0))))%R.
intros K'; rewrite K'.
unfold FtoRradix; apply Closestbbplus with 2 t; auto with zarith.
unfold Fmult; simpl.
assert (K:Fbounded b x);[elim Cx; auto|elim K; auto with zarith].
fold FtoRradix; rewrite <- K'; auto with real.
unfold FtoRradix; rewrite Fmult_correct; auto.
unfold FtoR; simpl; rewrite plus_IZR; rewrite Zpower_nat_Z_powerRZ; simpl;ring.
assert (Closest (plusExp t b) radix (FtoR radix x - FtoR radix p) q).
rewrite <- Fminus_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fminus; simpl; apply Zmin_Zle.
assert (K:Fbounded b x);[elim Cx; auto|elim K; auto with zarith].
assert (K:Fbounded b p);[elim A1; auto|elim K; auto with zarith].
rewrite Fminus_correct; auto.
assert (Closest (plusExp t b) radix (FtoR radix q + FtoR radix p) hx).
rewrite <- Fplus_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fplus; simpl; apply Zmin_Zle.
assert (K:Fbounded b q);[elim A2; auto|elim K; auto with zarith].
assert (K:Fbounded b p);[elim A1; auto|elim K; auto with zarith].
rewrite Fplus_correct; auto.
assert (Closest (plusExp t b) radix (FtoR radix x - FtoR radix hx) tx).
rewrite <- Fminus_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fminus; simpl; apply Zmin_Zle.
assert (K:Fbounded b x);[elim Cx; auto|elim K; auto with zarith].
assert (K:Fbounded b hx);[elim A3; auto|elim K; auto with zarith].
rewrite Fminus_correct; auto.
assert (Closest (plusExp t b) radix (FtoR radix yy × (powerRZ radix (t - div2 t)%nat + 1)) p').
rewrite X1; cut (FtoR radix y × (powerRZ radix (t - div2 t)%nat + 1) =
(FtoRradix (Fmult y (Float (Zpower_nat radix (t - div2 t)%nat + 1) 0))))%R.
intros K'; rewrite K'.
unfold FtoRradix; apply Closestbbplus with 2 t; auto with zarith.
unfold Fmult; simpl.
assert (K:Fbounded b y);[elim Cy; auto|elim K; auto with zarith].
fold FtoRradix; rewrite <- K'; auto with real.
unfold FtoRradix; rewrite Fmult_correct; auto.
unfold FtoR; simpl; rewrite plus_IZR; rewrite Zpower_nat_Z_powerRZ; simpl; ring.
assert (Closest (plusExp t b) radix (FtoR radix yy - FtoR radix p') q').
rewrite X1; rewrite <- Fminus_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fminus; simpl; apply Zmin_Zle.
assert (K:Fbounded b y);[elim Cy; auto|elim K; auto with zarith].
assert (K:Fbounded b p');[elim B1; auto|elim K; auto with zarith].
rewrite Fminus_correct; auto.
assert (Closest (plusExp t b) radix (FtoR radix q' + FtoR radix p') hy).
rewrite <- Fplus_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fplus; simpl; apply Zmin_Zle.
assert (K:Fbounded b q');[elim B2; auto|elim K; auto with zarith].
assert (K:Fbounded b p');[elim B1; auto|elim K; auto with zarith].
rewrite Fplus_correct; auto.
assert (Closest (plusExp t b) radix (FtoR radix yy - FtoR radix hy) ty).
rewrite X1; rewrite <- Fminus_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fminus; simpl; apply Zmin_Zle.
assert (K:Fbounded b y);[elim Cy; auto|elim K; auto with zarith].
assert (K:Fbounded b hy);[elim B3; auto|elim K; auto with zarith].
rewrite Fminus_correct; auto.
generalize VeltkampU; intros V.
elim V with radix b s t x p q hx tx; auto.
2: unfold s; apply SLe; auto.
2: unfold s; apply SGe; auto.
2: left; auto.
intros M1 T; elim T; intros M2 T'; elim T'; intros T1 T2; clear T T'.
elim T1; intros hx' T1'; elim T1'; intros M3 T; elim T; intros M4 T'; clear T1 T1' T.
lapply T'; auto; intros M5; clear T'.
elim T2; intros tx' T1'; elim T1'; intros M6 T; elim T; intros M7 M8; clear T2 T1' T V.
elim Veltkamp_tail with radix b s t y p' q' hy ty; auto.
2: unfold s; apply SLe; auto.
2: unfold s; apply SGe; auto.
2: elim Cy; auto.
intros ty' T1'; elim T1'; intros N5 T; elim T; intros N7 T'; elim T'; intros N8 N9; clear T1' T T'.
rewrite FcanonicFnormalizeEq in N9; auto with zarith;[idtac|right; auto].
assert (Fexp y ≤ Fexp hy)%Z.
elim Cy; intros T1 T2; elim T2; intros T3 T4; rewrite T3.
elim B3; intros G1 G2; elim G1; auto.
apply DekkerN with (plusExp t b) t p q hx tx p' q' hy ty x1y1 x1y2 x2y1 x2y2 t1 t2 t3; auto.
rewrite <- M3.
rewrite <- Fmult_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fmult; simpl; auto with zarith.
rewrite Fmult_correct; auto with real; rewrite M3; auto.
rewrite <- M3; rewrite <- N5.
rewrite <- Fmult_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fmult; simpl; auto with zarith.
rewrite Fmult_correct; auto with real; rewrite M3; rewrite N5; auto.
rewrite <- M6.
rewrite <- Fmult_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fmult; simpl; auto with zarith.
rewrite Fmult_correct; auto with real; rewrite M6; auto.
rewrite <- M6; rewrite <- N5.
rewrite <- Fmult_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fmult; simpl; auto with zarith.
rewrite Fmult_correct; auto with real; rewrite M6; rewrite N5; auto.
rewrite X1.
rewrite <- Fmult_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
rewrite Fmult_correct; auto with real.
rewrite <- Fminus_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fminus; simpl; apply Zmin_Zle.
assert (K:Fbounded b r);[elim D1; auto|elim K; auto with zarith].
assert (K:Fbounded b x1y1);[elim C1; auto|elim K; auto with zarith].
rewrite Fminus_correct; auto.
rewrite <- Fminus_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fminus; simpl; apply Zmin_Zle.
assert (K:Fbounded b t1);[elim D2; auto|elim K; auto with zarith].
assert (K:Fbounded b x1y2);[elim C2; auto|elim K; auto with zarith].
rewrite Fminus_correct; auto.
rewrite <- Fminus_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fminus; simpl; apply Zmin_Zle.
assert (K:Fbounded b t2);[elim D3; auto|elim K; auto with zarith].
assert (K:Fbounded b x2y1);[elim C3; auto|elim K; auto with zarith].
rewrite Fminus_correct; auto.
rewrite <- Fminus_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fminus; simpl; apply Zmin_Zle.
assert (K:Fbounded b t3);[elim D4; auto|elim K; auto with zarith].
assert (K:Fbounded b x2y2);[elim C4; auto|elim K; auto with zarith].
rewrite Fminus_correct; auto.
Qed.
End AlgoS1.
Section AlgoS2.
Variable radix : Z.
Variable b : Fbound.
Variables t: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 pGivesBound: Zpos (vNum b)=(Zpower_nat radix t).
Hypotheses pGe: (4 ≤ t).
Variables x y p q hx tx p' q' hy ty x1y1 x1y2 x2y1 x2y2 r t1 t2 t3 t4:float.
Hypothesis Cx: (Fsubnormal radix b x).
Hypothesis Cy: (Fnormal radix b y).
Hypothesis Expoxy: (-dExp b ≤ Fexp x+Fexp y)%Z.
Let s:= t- div2 t.
Hypothesis A1: (Closest b radix (x*((powerRZ radix s)+1))%R p).
Hypothesis A2: (Closest b radix (x-p)%R q).
Hypothesis A3: (Closest b radix (q+p)%R hx).
Hypothesis A4: (Closest b radix (x-hx)%R tx).
Hypothesis B1: (Closest b radix (y*((powerRZ radix s)+1))%R p').
Hypothesis B2: (Closest b radix (y-p')%R q').
Hypothesis B3: (Closest b radix (q'+p')%R hy).
Hypothesis B4: (Closest b radix (y-hy)%R ty).
Hypothesis C1: (Closest b radix (hx×hy)%R x1y1).
Hypothesis C2: (Closest b radix (hx×ty)%R x1y2).
Hypothesis C3: (Closest b radix (tx×hy)%R x2y1).
Hypothesis C4: (Closest b radix (tx×ty)%R x2y2).
Hypothesis D1: (Closest b radix (x×y)%R r).
Hypothesis D2: (Closest b radix (r-x1y1)%R t1).
Hypothesis D3: (Closest b radix (t1-x1y2)%R t2).
Hypothesis D4: (Closest b radix (t2-x2y1)%R t3).
Hypothesis D5: (Closest b radix (t3-x2y2)%R t4).
Theorem DekkerS2: (radix=2)%Z ∨ (even t) → (x×y=r-t4)%R.
intros H; unfold FtoRradix.
case (Req_dec 0%R x); intros Ny.
cut (FtoRradix r=0)%R;[intros Z1|idtac].
cut (FtoRradix t4=0)%R;[intros Z2|idtac].
fold FtoRradix; rewrite Z1; rewrite Z2; rewrite <- Ny; ring.
cut (FtoRradix hx=0)%R;[intros Z3|idtac].
cut (FtoRradix tx=0)%R;[intros Z4|idtac].
unfold FtoRradix; apply ClosestZero with b t (t3-x2y2)%R; auto with zarith.
cut (FtoRradix t3=0)%R;[intros Z5|idtac].
cut (FtoRradix x2y2=0)%R;[intros Z6|idtac].
rewrite Z5; rewrite Z6; ring.
unfold FtoRradix; apply ClosestZero with b t (tx×ty)%R; auto with zarith.
rewrite Z4; ring.
unfold FtoRradix; apply ClosestZero with b t (t2-x2y1)%R; auto with zarith.
cut (FtoRradix t2=0)%R;[intros Z5|idtac].
cut (FtoRradix x2y1=0)%R;[intros Z6|idtac].
rewrite Z5; rewrite Z6; ring.
unfold FtoRradix; apply ClosestZero with b t (tx×hy)%R; auto with zarith.
rewrite Z4; ring.
unfold FtoRradix; apply ClosestZero with b t (t1-x1y2)%R; auto with zarith.
cut (FtoRradix t1=0)%R;[intros Z5|idtac].
cut (FtoRradix x1y2=0)%R;[intros Z6|idtac].
rewrite Z5; rewrite Z6; ring.
unfold FtoRradix; apply ClosestZero with b t (hx×ty)%R; auto with zarith.
rewrite Z3; ring.
unfold FtoRradix; apply ClosestZero with b t (r-x1y1)%R; auto with zarith.
cut (FtoRradix x1y1=0)%R;[intros Z6|idtac].
rewrite Z1; rewrite Z6; ring.
unfold FtoRradix; apply ClosestZero with b t (hx×hy)%R; auto with zarith.
rewrite Z3; ring.
elim VeltkampU with radix b s t x p q hx tx; auto.
intros T1 T; elim T; intros H' T'; clear T1 T T'.
fold FtoRradix in H'; rewrite Z3 in H'; rewrite <- Ny in H'; auto with real.
apply trans_eq with (0+tx)%R; auto with real.
unfold s; apply SLe; auto.
unfold s; apply SGe; auto.
right; auto.
elim Veltkamp with radix b s t x p q hx; auto.
intros T1 T; elim T; intros hy' T'; elim T'; intros G1 T''; elim T''; intros ; clear T1 T T' T''.
unfold FtoRradix; rewrite <- G1.
apply ClosestZero with (Bound (P_of_succ_nat (pred (Zabs_nat (Zpower_nat radix (t - s)))))
(dExp b)) (t-s) (FtoR radix x)%R; auto with zarith.
apply p'GivesBound; auto with zarith.
assert (s ≤ t - 2)%Z; auto with zarith.
assert (s ≤ t - 2)%nat; auto with zarith.
unfold s; apply SGe; auto.
unfold s; apply SLe; auto.
unfold s; apply SGe; auto.
elim Cx; auto.
unfold FtoRradix; apply ClosestZero with b t (x×y)%R; auto with zarith.
rewrite <- Ny; ring.
elim bimplybplusNorm with radix b s t x; auto.
2: unfold s; apply SLe; auto.
2: unfold s; apply SGe; auto.
2: elim Cx; auto.
intros xx T; elim T; intros X1 X2; clear T.
rewrite <- X1.
assert (Fnormal radix (plusExp t b) y).
elim Cy; intros F1 F2; elim F1; intros.
split;[split|idtac]; unfold plusExp; simpl; auto with zarith.
cut (∀ (x:N) (y:positive), (x+(Zpos y)=(x +Npos y)%N)%Z).
intros T; simpl; rewrite <- T; auto with zarith.
apply Zle_trans with (-(dExp b))%Z; auto with zarith.
apply Zle_trans with (-(dExp b) + Zneg (P_of_succ_nat (pred (pred t))))%Z; auto with zarith.
apply Zeq_le; ring_simplify; auto with zarith.
apply Zle_trans with (-(dExp b)+0)%Z; auto with zarith.
intros;unfold Nplus.
case x0; auto with zarith.
assert (- dExp (plusExp t b) ≤ Fexp xx + Fexp y)%Z.
elim X2; intros F1 F2; elim F1; intros.
assert (0 ≤ Fexp y)%Z; auto with zarith.
apply Zplus_le_reg_l with (Fexp x).
apply Zle_trans with (2:=Expoxy).
elim Cx; intros F1' F2'; elim F2'; auto with zarith.
assert (Closest (plusExp t b) radix
(FtoR radix y × (powerRZ radix (t - div2 t)%nat + 1)) p').
cut (FtoR radix y × (powerRZ radix (t - div2 t)%nat + 1) =
(FtoRradix (Fmult y (Float (Zpower_nat radix (t - div2 t)%nat + 1) 0))))%R.
intros K'; rewrite K'.
unfold FtoRradix; apply Closestbbplus with 2 t; auto with zarith.
unfold Fmult; simpl.
assert (K:Fbounded b y);[elim Cy; auto|elim K; auto with zarith].
fold FtoRradix; rewrite <- K'; auto with real.
unfold FtoRradix; rewrite Fmult_correct; auto.
unfold FtoR; simpl; rewrite plus_IZR; rewrite Zpower_nat_Z_powerRZ; simpl; ring.
assert (Closest (plusExp t b) radix (FtoR radix y - FtoR radix p') q').
rewrite <- Fminus_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fminus; simpl; apply Zmin_Zle.
assert (K:Fbounded b y);[elim Cy; auto|elim K; auto with zarith].
assert (K:Fbounded b p');[elim B1; auto|elim K; auto with zarith].
rewrite Fminus_correct; auto.
assert (Closest (plusExp t b) radix (FtoR radix q' + FtoR radix p') hy).
rewrite <- Fplus_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fplus; simpl; apply Zmin_Zle.
assert (K:Fbounded b q');[elim B2; auto|elim K; auto with zarith].
assert (K:Fbounded b p');[elim B1; auto|elim K; auto with zarith].
rewrite Fplus_correct; auto.
assert (Closest (plusExp t b) radix (FtoR radix y - FtoR radix hy) ty).
rewrite <- Fminus_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fminus; simpl; apply Zmin_Zle.
assert (K:Fbounded b y);[elim Cy; auto|elim K; auto with zarith].
assert (K:Fbounded b hy);[elim B3; auto|elim K; auto with zarith].
rewrite Fminus_correct; auto.
assert (Closest (plusExp t b) radix (FtoR radix xx × (powerRZ radix (t - div2 t)%nat + 1)) p).
rewrite X1; cut (FtoR radix x × (powerRZ radix (t - div2 t)%nat + 1) =
(FtoRradix (Fmult x (Float (Zpower_nat radix (t - div2 t)%nat + 1) 0))))%R.
intros K'; rewrite K'.
unfold FtoRradix; apply Closestbbplus with 2 t; auto with zarith.
unfold Fmult; simpl.
assert (K:Fbounded b x);[elim Cx; auto|elim K; auto with zarith].
fold FtoRradix; rewrite <- K'; auto with real.
unfold FtoRradix; rewrite Fmult_correct; auto.
unfold FtoR; simpl; rewrite plus_IZR; rewrite Zpower_nat_Z_powerRZ; simpl; ring.
assert (Closest (plusExp t b) radix (FtoR radix xx - FtoR radix p) q).
rewrite X1; rewrite <- Fminus_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fminus; simpl; apply Zmin_Zle.
assert (K:Fbounded b x);[elim Cx; auto|elim K; auto with zarith].
assert (K:Fbounded b p);[elim A1; auto|elim K; auto with zarith].
rewrite Fminus_correct; auto.
assert (Closest (plusExp t b) radix (FtoR radix q + FtoR radix p) hx).
rewrite <- Fplus_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fplus; simpl; apply Zmin_Zle.
assert (K:Fbounded b q);[elim A2; auto|elim K; auto with zarith].
assert (K:Fbounded b p);[elim A1; auto|elim K; auto with zarith].
rewrite Fplus_correct; auto.
assert (Closest (plusExp t b) radix (FtoR radix xx - FtoR radix hx) tx).
rewrite X1; rewrite <- Fminus_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fminus; simpl; apply Zmin_Zle.
assert (K:Fbounded b x);[elim Cx; auto|elim K; auto with zarith].
assert (K:Fbounded b hx);[elim A3; auto|elim K; auto with zarith].
rewrite Fminus_correct; auto.
generalize VeltkampU; intros V.
elim V with radix b s t y p' q' hy ty; auto.
2: unfold s; apply SLe; auto.
2: unfold s; apply SGe; auto.
2: left; auto.
intros M1 T; elim T; intros M2 T'; elim T'; intros T1 T2; clear T T'.
elim T1; intros hy' T1'; elim T1'; intros M3 T; elim T; intros M4 T'; clear T1 T1' T.
lapply T'; auto; intros M5; clear T'.
elim T2; intros ty' T1'; elim T1'; intros M6 T; elim T; intros M7 M8; clear T2 T1' T V.
elim Veltkamp_tail with radix b s t x p q hx tx; auto.
2: unfold s; apply SLe; auto.
2: unfold s; apply SGe; auto.
2: elim Cx; auto.
intros tx' T1'; elim T1'; intros N5 T; elim T; intros N7 T'; elim T'; intros N8 N9; clear T1' T T'.
rewrite FcanonicFnormalizeEq in N9; auto with zarith;[idtac|right; auto].
assert (Fexp x ≤ Fexp hx)%Z.
elim Cx; intros T1 T2; elim T2; intros T3 T4; rewrite T3.
elim A3; intros G1 G2; elim G1; auto.
apply DekkerN with (plusExp t b) t p q hx tx p' q' hy ty x1y1 x1y2 x2y1 x2y2 t1 t2 t3; auto.
rewrite <- M3.
rewrite <- Fmult_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fmult; simpl; auto with zarith.
rewrite Fmult_correct; auto with real; rewrite M3; auto.
rewrite <- M6.
rewrite <- Fmult_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fmult; simpl; auto with zarith.
rewrite Fmult_correct; auto with real; rewrite M6; auto.
rewrite <- M3; rewrite <- N5.
rewrite <- Fmult_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fmult; simpl; auto with zarith.
rewrite Fmult_correct; auto with real; rewrite M3; rewrite N5; auto.
rewrite <- M6; rewrite <- N5.
rewrite <- Fmult_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fmult; simpl; auto with zarith.
rewrite Fmult_correct; auto with real; rewrite M6; rewrite N5; auto.
rewrite X1.
rewrite <- Fmult_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
rewrite Fmult_correct; auto with real.
rewrite <- Fminus_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fminus; simpl; apply Zmin_Zle.
assert (K:Fbounded b r);[elim D1; auto|elim K; auto with zarith].
assert (K:Fbounded b x1y1);[elim C1; auto|elim K; auto with zarith].
rewrite Fminus_correct; auto.
rewrite <- Fminus_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fminus; simpl; apply Zmin_Zle.
assert (K:Fbounded b t1);[elim D2; auto|elim K; auto with zarith].
assert (K:Fbounded b x1y2);[elim C2; auto|elim K; auto with zarith].
rewrite Fminus_correct; auto.
rewrite <- Fminus_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fminus; simpl; apply Zmin_Zle.
assert (K:Fbounded b t2);[elim D3; auto|elim K; auto with zarith].
assert (K:Fbounded b x2y1);[elim C3; auto|elim K; auto with zarith].
rewrite Fminus_correct; auto.
rewrite <- Fminus_correct; auto.
apply Closestbbplus with 2 t; auto with zarith.
unfold Fminus; simpl; apply Zmin_Zle.
assert (K:Fbounded b t3);[elim D4; auto|elim K; auto with zarith].
assert (K:Fbounded b x2y2);[elim C4; auto|elim K; auto with zarith].
rewrite Fminus_correct; auto.
Qed.
End AlgoS2.
Section Algo1.
Variable radix : Z.
Variable b : Fbound.
Variables t: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 pGivesBound: Zpos (vNum b)=(Zpower_nat radix t).
Hypotheses pGe: (4 ≤ t).
Variables x y p q hx tx p' q' hy ty x1y1 x1y2 x2y1 x2y2 r t1 t2 t3 t4:float.
Hypothesis Cx: (Fcanonic radix b x).
Hypothesis Cy: (Fcanonic radix b y).
Hypothesis Expoxy: (-dExp b ≤ Fexp x+Fexp y)%Z.
Let s:= t- div2 t.
Hypothesis A1: (Closest b radix (x*((powerRZ radix s)+1))%R p).
Hypothesis A2: (Closest b radix (x-p)%R q).
Hypothesis A3: (Closest b radix (q+p)%R hx).
Hypothesis A4: (Closest b radix (x-hx)%R tx).
Hypothesis B1: (Closest b radix (y*((powerRZ radix s)+1))%R p').
Hypothesis B2: (Closest b radix (y-p')%R q').
Hypothesis B3: (Closest b radix (q'+p')%R hy).
Hypothesis B4: (Closest b radix (y-hy)%R ty).
Hypothesis C1: (Closest b radix (hx×hy)%R x1y1).
Hypothesis C2: (Closest b radix (hx×ty)%R x1y2).
Hypothesis C3: (Closest b radix (tx×hy)%R x2y1).
Hypothesis C4: (Closest b radix (tx×ty)%R x2y2).
Hypothesis D1: (Closest b radix (x×y)%R r).
Hypothesis D2: (Closest b radix (r-x1y1)%R t1).
Hypothesis D3: (Closest b radix (t1-x1y2)%R t2).
Hypothesis D4: (Closest b radix (t2-x2y1)%R t3).
Hypothesis D5: (Closest b radix (t3-x2y2)%R t4).
Hypothesis dExpPos: ¬(Z_of_N(dExp b)=0)%Z.
Theorem Dekker1: (radix=2)%Z ∨ (even t) → (x×y=r-t4)%R.
case Cy; case Cx; intros.
unfold FtoRradix; apply DekkerN with b t p q hx tx p' q' hy ty x1y1 x1y2 x2y1 x2y2 t1 t2 t3; auto.
unfold FtoRradix; apply DekkerS2 with b t p q hx tx p' q' hy ty x1y1 x1y2 x2y1 x2y2 t1 t2 t3; auto.
unfold FtoRradix; apply DekkerS1 with b t p q hx tx p' q' hy ty x1y1 x1y2 x2y1 x2y2 t1 t2 t3; auto.
absurd (- dExp b ≤ Fexp x + Fexp y)%Z; auto with zarith.
apply Zlt_not_le.
elim H; intros T1 T2; elim T2; intros G1 T; clear T1 T2 T.
elim H0; intros T1 T2; elim T2; intros G2 T; clear T1 T2 T.
rewrite G1; rewrite G2; auto with zarith.
cut (0 < dExp b)%Z; auto with zarith.
generalize dExpPos; unfold Z_of_N; case (dExp b); auto with zarith.
Qed.
End Algo1.
Section Algo2.
Variable radix : Z.
Variable b : Fbound.
Variables t: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 pGivesBound: Zpos (vNum b)=(Zpower_nat radix t).
Hypotheses pGe: (4 ≤ t).
Let s:= t- div2 t.
Variables x y:float.
Let b' := Bound (vNum b) (Nplus (Ndouble (dExp b)) (Ndouble (Npos (P_of_succ_nat t)))).
Theorem Veltkampb': ∀ (f pf qf hf tf:float),
(dExp b < dExp b')%Z →
(Fbounded b f) →
Closest b radix (f × (powerRZ radix s + 1)) pf → Closest b radix (f - pf) qf →
Closest b radix (qf + pf) hf → Closest b radix (f - hf) tf →
Closest b' radix (f × (powerRZ radix s + 1)) pf ∧
Closest b' radix (f - pf) qf ∧ Closest b' radix (qf + pf) hf ∧
Closest b' radix (f - hf) tf.
intros.
split.
assert (f*(powerRZ radix s + 1)= (FtoRradix (Fplus radix (Fmult f (Float 1 s)) f)))%R.
unfold FtoRradix; rewrite Fplus_correct; auto; rewrite Fmult_correct; auto.
unfold FtoR; simpl; ring.
rewrite H5; unfold FtoRradix; apply Closestbbext with b t; auto with zarith.
simpl; rewrite Zmin_le2; auto with zarith float.
fold FtoRradix; rewrite <- H5; auto.
split.
unfold FtoRradix; rewrite <- Fminus_correct; auto.
apply Closestbbext with b t; auto with zarith.
simpl; apply Zmin_Zle; auto with zarith float.
elim H1; auto with zarith float.
rewrite Fminus_correct; auto.
split.
unfold FtoRradix; rewrite <- Fplus_correct; auto.
apply Closestbbext with b t; auto with zarith.
simpl; apply Zmin_Zle; elim H2; elim H1; auto with zarith float.
rewrite Fplus_correct; auto.
unfold FtoRradix; rewrite <- Fminus_correct; auto.
apply Closestbbext with b t; auto with zarith.
simpl; apply Zmin_Zle; elim H3; auto with zarith float.
rewrite Fminus_correct; auto.
Qed.
Variables p q hx tx p' q' hy ty x1y1 x1y2 x2y1 x2y2 r t1 t2 t3 t4:float.
Hypothesis Cx: (Fcanonic radix b x).
Hypothesis Cy: (Fcanonic radix b y).
Hypothesis Expoxy: (Fexp x+Fexp y < -dExp b)%Z.
Hypothesis A1: (Closest b radix (x*((powerRZ radix s)+1))%R p).
Hypothesis A2: (Closest b radix (x-p)%R q).
Hypothesis A3: (Closest b radix (q+p)%R hx).
Hypothesis A4: (Closest b radix (x-hx)%R tx).
Hypothesis B1: (Closest b radix (y*((powerRZ radix s)+1))%R p').
Hypothesis B2: (Closest b radix (y-p')%R q').
Hypothesis B3: (Closest b radix (q'+p')%R hy).
Hypothesis B4: (Closest b radix (y-hy)%R ty).
Hypothesis C1: (Closest b radix (hx×hy)%R x1y1).
Hypothesis C2: (Closest b radix (hx×ty)%R x1y2).
Hypothesis C3: (Closest b radix (tx×hy)%R x2y1).
Hypothesis C4: (Closest b radix (tx×ty)%R x2y2).
Hypothesis D1: (Closest b radix (x×y)%R r).
Hypothesis D2: (Closest b radix (r-x1y1)%R t1).
Hypothesis D3: (Closest b radix (t1-x1y2)%R t2).
Hypothesis D4: (Closest b radix (t2-x2y1)%R t3).
Hypothesis D5: (Closest b radix (t3-x2y2)%R t4).
Theorem dExpPrim: (dExp b < dExp b')%Z.
unfold b'; simpl; auto with zarith.
cut (∀ (x:N) (y:positive), (x+(Zpos y)=(x +Npos y)%N)%Z).
intros T; simpl; rewrite <- T; auto with zarith.
apply Zle_lt_trans with (Ndouble (dExp b)); auto with zarith.
unfold Ndouble; case (dExp b); auto with zarith.
intros; unfold Z_of_N; auto with zarith.
apply Zle_trans with (2*(Zpos p0))%Z; auto with zarith.
apply Zle_trans with (1*(Zpos p0))%Z; auto with zarith.
apply Zle_lt_trans with (Ndouble (dExp b)+0)%Z; auto with zarith.
intros;unfold Nplus.
case x0; auto with zarith.
Qed.
Theorem dExpPrimEq: (Z_of_N (Ndouble (dExp b) + Npos (xO (P_of_succ_nat t)))
=2*(dExp b)+2×t+2)%Z.
cut (∀ (x:N) (y:positive), (x+(Zpos y)=(x +Npos y)%N)%Z).
intros T; rewrite <- T; auto with zarith.
2:intros;unfold Nplus.
2:case x0; auto with zarith.
replace (Zpos (xO (P_of_succ_nat t))) with (2×t+2)%Z.
unfold Ndouble; case (dExp b); auto with zarith.
apply trans_eq with (2*(Zpos (P_of_succ_nat t)))%Z; auto with zarith.
replace (Zpos (P_of_succ_nat t)) with (t+1)%Z; auto with zarith.
apply trans_eq with
(Z_of_nat
(nat_of_P
(P_of_succ_nat t))); auto with zarith.
rewrite nat_of_P_o_P_of_succ_nat_eq_succ; auto with zarith arith.
replace (S t) with (t+1)%nat; auto with zarith arith; rewrite inj_plus; auto with zarith.
unfold Z_of_nat; rewrite nat_of_P_o_P_of_succ_nat_eq_succ;
auto with zarith.
Qed.
Theorem NormalbPrim: ∀ (f:float), Fcanonic radix b f → (FtoRradix f ≠0) →
(∃ f':float, (Fnormal radix b' f') ∧ FtoRradix f'=f ∧ (-t-dExp b ≤ Fexp f')%Z).
intros.
∃ (Fnormalize radix b' t f).
assert (powerRZ radix (-(dExp b)) ≤ (Fabs (Fnormalize radix b' t f)))%R.
unfold FtoRradix; rewrite Fabs_correct; auto.
rewrite FnormalizeCorrect; auto with zarith; rewrite <- Fabs_correct; auto.
unfold FtoRradix, FtoR, Fabs; simpl.
apply Rle_trans with ((IZR 1)*powerRZ radix (- dExp b))%R;[right; simpl; ring|idtac].
apply Rmult_le_compat; auto with real zarith float.
case (Zle_lt_or_eq 0 (Zabs (Fnum f))); auto with zarith real.
intros; absurd (Rabs f =0)%R.
apply Rabs_no_R0; auto.
unfold FtoRradix; rewrite <- Fabs_correct; auto; unfold FtoR, Fabs; simpl; rewrite <- H1; simpl; ring.
assert (Fbounded b f);[apply FcanonicBound with radix; auto with zarith|idtac].
elim H1; intros; apply Rle_powerRZ; auto with zarith real.
assert (Fcanonic radix b' (Fnormalize radix b' t f)).
apply FnormalizeCanonic; auto with zarith.
assert (Fbounded b f);[apply FcanonicBound with radix; auto with zarith|idtac].
elim H2; generalize dExpPrim; intros; split; auto with zarith.
split.
case H2; auto.
intros; absurd (Fabs f < (firstNormalPos radix b' t))%R.
apply Rle_not_lt.
apply Rle_trans with (powerRZ radix (-(dExp b))).
unfold firstNormalPos, FtoRradix, FtoR; simpl.
unfold nNormMin; rewrite Zpower_nat_Z_powerRZ; rewrite <- powerRZ_add; auto with real zarith.
apply Rle_powerRZ; auto with real zarith.
rewrite dExpPrimEq.
rewrite inj_pred; auto with zarith; unfold Zpred.
ring_simplify (t + -1 + - (2 × dExp b + 2 × t + 2))%Z; auto with zarith.
assert (0 ≤ dExp b)%Z; auto with zarith.
case (dExp b); auto with zarith.
apply Rle_trans with (1:=H1); unfold FtoRradix; repeat rewrite Fabs_correct; auto.
rewrite FnormalizeCorrect; auto with zarith real.
apply Rle_lt_trans with (Fabs (Fnormalize radix b' t f)).
unfold FtoRradix; repeat rewrite Fabs_correct; auto.
rewrite FnormalizeCorrect; auto with zarith real.
unfold FtoRradix; apply FsubnormalLtFirstNormalPos; auto with zarith.
apply FsubnormFabs; auto.
rewrite Fabs_correct; auto with real zarith.
split;[unfold FtoRradix; rewrite FnormalizeCorrect; auto with zarith|idtac].
apply Zle_trans with (Fexp (Float (nNormMin radix t) (-t-dExp b))); auto with zarith.
apply Fcanonic_Rle_Zle with radix b' t; auto with zarith.
apply FcanonicNnormMin; auto with zarith.
unfold b'; simpl; rewrite dExpPrimEq; auto with zarith.
cut (0 ≤ dExp b)%Z; auto with zarith; case (dExp b); auto with zarith.
rewrite Rabs_right.
rewrite <- Fabs_correct; auto; fold FtoRradix; apply Rle_trans with (2:=H1).
unfold FtoRradix, FtoR, nNormMin; simpl; rewrite Zpower_nat_Z_powerRZ.
rewrite <- powerRZ_add; auto with real zarith; apply Rle_powerRZ; auto with zarith real.
rewrite inj_pred; auto with zarith; unfold Zpred; auto with zarith.
apply Rle_ge; apply LeFnumZERO; auto with zarith.
unfold nNormMin; simpl; auto with zarith.
Qed.
Theorem Dekker2_aux:
(FtoRradix x ≠0) → (FtoRradix y ≠0) →
(radix=2)%Z ∨ (even t) → (Rabs (x×y-(r-t4)) ≤ (7/2)*powerRZ radix (-(dExp b)))%R.
intros P1 P2.
intros; generalize dExpPrim; intros.
elim (NormalbPrim x); auto.
intros x' T; elim T; intros Nx' T'; elim T'; intros Hx' Ex'; clear T T'.
elim (NormalbPrim y); auto.
intros y' T; elim T; intros Ny' T'; elim T'; intros Hy' Ey'; clear T T'.
assert (MM:(-(dExp b') ≤ Fexp x'+Fexp y')%Z).
unfold b'; simpl; rewrite dExpPrimEq; auto with zarith float.
generalize Underf_Err2; intros T.
elim T with b radix t b' (x×y)%R r; auto with zarith; clear T.
intros r' T; elim T; intros H1 H2; clear T.
elim Veltkampb' with x p q hx tx; auto.
2: apply FcanonicBound with radix; auto.
intros H4 T; elim T; intros H5 T'; elim T'; intros H6 H7; clear T T'.
elim Veltkampb' with y p' q' hy ty; auto.
2: apply FcanonicBound with radix; auto.
intros H8 T; elim T; intros H9 T'; elim T'; intros H10 H11; clear T T'.
assert (TotalP (Closest b' radix)).
apply ClosestTotal with t; auto with zarith.
unfold TotalP in H3.
elim (H3 (hx × hy)%R); intros x1y1' H12.
elim (H3 (hx × ty)%R); intros x1y2' H13.
elim (H3 (tx × hy)%R); intros x2y1' H14.
elim (H3 (tx × ty)%R); intros x2y2' H15.
elim (H3 (r' - x1y1')%R); intros t1' H16.
elim (H3 (t1' - x1y2')%R); intros t2' H17.
elim (H3 (t2' - x2y1')%R); intros t3' H18.
elim (H3 (t3' - x2y2')%R); intros t4' H19.
rewrite <- Hx'; rewrite <- Hy'; unfold FtoRradix.
rewrite DekkerN with radix b' t x' y' p q hx tx p' q' hy ty x1y1' x1y2' x2y1' x2y2' r' t1' t2' t3' t4';
auto with zarith.
2: fold FtoRradix; rewrite Hx'; auto.
2: fold FtoRradix; rewrite Hx'; auto.
2: fold FtoRradix; rewrite Hx'; auto.
2: fold FtoRradix; rewrite Hy'; auto.
2: fold FtoRradix; rewrite Hy'; auto.
2: fold FtoRradix; rewrite Hy'; auto.
2: fold FtoRradix; rewrite Hx'; rewrite Hy'; auto.
fold FtoRradix.
replace (r' - t4' - (r - t4))%R with (-(r-r')+((t4-t4')))%R;[idtac|ring].
apply Rle_trans with (1:=Rabs_triang (-(r-r'))%R ((t4-t4'))%R).
apply Rle_trans with ((3/4)*powerRZ radix (- dExp b) +(11/4)*powerRZ radix (- dExp b))%R;
[idtac|right; field; apply prod_neq_R0; auto with real; apply prod_neq_R0; auto with real].
apply Rplus_le_compat.
rewrite Rabs_Ropp; auto with real.
elim H1; intros G1 G2; elim G2; intros G3 G4; elim G4; intros G5 G6.
unfold FtoRradix; apply Rle_trans with (1:=G5); right; ring.
cut (2 ≤ s);[intros Sle|unfold s; apply SLe; auto].
cut (s ≤ t-2);[intros Sge|unfold s; apply SGe; auto].
cut (s+s ≤ t+1)%Z;[intros s2le|unfold s; apply s2Le; auto].
cut (t ≤s+s)%Z;[intros s2ge|unfold s; apply s2Ge; auto].
generalize VeltkampU; intros V.
elim V with radix b' s t x' p q hx tx; auto.
2: left; auto.
2: fold FtoRradix; rewrite Hx'; auto.
2: fold FtoRradix; rewrite Hx'; auto.
2: fold FtoRradix; rewrite Hx'; auto.
intros MX1 T; elim T; intros MX2 T'; clear T; elim T'; intros T1 T2; clear T'.
elim T1; intros Chx' T1'; elim T1'; intros MX3 T1''; elim T1''; intros MX4 MX5; clear T1 T1' T1''.
lapply MX5; auto; clear MX5; intros MX5.
elim T2; intros Ctx' T1'; elim T1'; intros MX6 T1''; elim T1''; intros MX7 MX8; clear T2 T1' T1''.
elim V with radix b' s t y' p' q' hy ty; auto.
2: left; auto.
2: fold FtoRradix; rewrite Hy'; auto.
2: fold FtoRradix; rewrite Hy'; auto.
2: fold FtoRradix; rewrite Hy'; auto.
intros MY1 T; elim T; intros MY2 T'; clear T; elim T'; intros T1 T2; clear T'.
elim T1; intros Chy' T1'; elim T1'; intros MY3 T1''; elim T1''; intros MY4 MY5; clear T1 T1' T1''.
lapply MY5; auto; clear MY5; intros MY5.
elim T2; intros Cty' T1'; elim T1'; intros MY6 T1''; elim T1''; intros MY7 MY8; clear T2 T1' T1'' V.
generalize Boundedt1; intros V.
elim V with radix b' s t x' Chx' Ctx' y' Chy' Cty' r' (Fminus radix (Fmult x' y') r');
auto with zarith real; clear V.
2: fold FtoRradix; rewrite Hy';rewrite Hx'; auto.
2:rewrite Fminus_correct; auto with zarith; rewrite Fmult_correct; auto with zarith; ring.
2:rewrite MX6; rewrite MX3; exact MX2.
2:rewrite MY6; rewrite MY3; exact MY2.
2:rewrite MX6; replace (FtoR radix tx) with (FtoR radix x'-FtoR radix hx)%R; auto with real.
2:rewrite MX2; ring.
2:rewrite MY6; replace (FtoR radix ty) with (FtoR radix y'-FtoR radix hy)%R; auto with real.
2:rewrite MY2; ring.
intros Ct1' T; elim T; intros M11 T'; elim T'; intros M12 M13; clear T T'.
generalize Boundedt2; intros V.
elim V with radix b' s t x' Chx' Ctx' y' Chy' Cty' r' (Fminus radix (Fmult x' y') r');
auto with zarith real; clear V.
2: fold FtoRradix; rewrite Hy';rewrite Hx'; auto.
2:rewrite Fminus_correct; auto with zarith; rewrite Fmult_correct; auto with zarith; ring.
2:rewrite MX6; rewrite MX3; exact MX2.
2:rewrite MY6; rewrite MY3; exact MY2.
2:rewrite MX6; replace (FtoR radix tx) with (FtoR radix x'-FtoR radix hx)%R; auto with real.
2:rewrite MX2; ring.
2:rewrite MY6; replace (FtoR radix ty) with (FtoR radix y'-FtoR radix hy)%R; auto with real.
2:rewrite MY2; ring.
intros Ct2' T; elim T; intros M21 T'; elim T'; intros M22 M23; clear T T'.
generalize Boundedt3; intros V.
elim V with radix b' s t x' Chx' Ctx' y' Chy' Cty' r' (Fminus radix (Fmult x' y') r');
auto with zarith real; clear V.
2: fold FtoRradix; rewrite Hy';rewrite Hx'; auto.
2:rewrite Fminus_correct; auto with zarith; rewrite Fmult_correct; auto with zarith; ring.
2:rewrite MX6; rewrite MX3; exact MX2.
2:rewrite MY6; rewrite MY3; exact MY2.
2:rewrite MX6; replace (FtoR radix tx) with (FtoR radix x'-FtoR radix hx)%R; auto with real.
2:rewrite MX2; ring.
2:rewrite MY6; replace (FtoR radix ty) with (FtoR radix y'-FtoR radix hy)%R; auto with real.
2:rewrite MY2; ring.
intros Ct3' T; elim T; intros M31 T'; elim T'; intros M32 M33; clear T T'.
generalize Boundedt4_aux; intros V.
elim V with radix b' s t x' Chx' Ctx' y' Chy' Cty' r' ; auto with zarith real; clear V.
2: fold FtoRradix; rewrite Hy';rewrite Hx'; auto.
2:rewrite MX6; rewrite MX3; exact MX2.
2:rewrite MY6; rewrite MY3; exact MY2.
intros Ct4' T; elim T; intros M41 T'; elim T'; intros M42 M43; clear T T'.
elim Boundedx1y1_aux with radix b' s t x' Chx' y' Chy'; auto with zarith.
intros Cx1y1' T; elim T; intros O1 T'; elim T'; intros O2 O3 ; clear T T'.
elim Boundedx1y2_aux with radix b' s t x' Chx' y' Cty'; auto with zarith.
intros Cx1y2' T; elim T; intros O4 T'; elim T'; intros O5 O6; clear T T'.
elim Boundedx2y1_aux with radix b' s t x' Ctx' y' Chy'; auto with zarith.
intros Cx2y1' T; elim T; intros O7 T'; elim T'; intros O8 O9; clear T T'.
assert (tmp:∀ (f:float) (i:nat), (i ≤ t) →
(Fbounded (Bound (P_of_succ_nat (pred (Zabs_nat (Zpower_nat radix (i)))))
(dExp b')) f) → (Fbounded b' f)).
intros f i J1 J2; elim J2; intros J3 J4; split; auto with zarith.
apply Zlt_le_trans with (1:=J3).
apply Zle_trans with (Zpower_nat radix i);[idtac|unfold b'; simpl; rewrite pGivesBound; auto with zarith].
simpl.
apply
Zle_trans
with
(Z_of_nat
(nat_of_P
(P_of_succ_nat
(pred (Zabs_nat (Zpower_nat radix (i))))))).
unfold Z_of_nat in |- *; rewrite nat_of_P_o_P_of_succ_nat_eq_succ;
auto with zarith.
rewrite nat_of_P_o_P_of_succ_nat_eq_succ; auto with arith zarith.
rewrite <- S_pred with (Zabs_nat (Zpower_nat radix (i))) 0; auto with zarith.
rewrite <- Zabs_absolu; rewrite Zabs_eq; auto with zarith.
cut ( 0 < Zabs_nat (Zpower_nat radix (i)))%Z; auto with zarith.
simpl; rewrite <- Zabs_absolu; rewrite Zabs_eq; auto with zarith.
elim Boundedx2y2 with radix b' t x' y' p q Chx' Ctx' p' q' Chy' Cty'; auto with zarith.
2: fold FtoRradix; rewrite Hx'; auto.
2: fold FtoRradix; rewrite Hx'; auto.
2:apply ClosestCompatible with (1:=H6); auto.
2:apply tmp with (t-s); auto with zarith.
2:apply ClosestCompatible with (1:=H7); auto with real.
2: fold FtoRradix; rewrite Hx'; auto with real.
2:apply tmp with s; auto with zarith.
2: fold FtoRradix; rewrite Hy'; auto.
2: fold FtoRradix; rewrite Hy'; auto.
2:apply ClosestCompatible with (1:=H10); auto.
2:apply tmp with (t-s); auto with zarith.
2:fold FtoRradix; rewrite Hy'; apply ClosestCompatible with (1:=H11); auto with real.
2:apply tmp with s; auto with zarith.
intros Cx2y2' T; elim T; intros O10 T'; elim T'; intros O11 O12; clear T T' tmp.
assert (ZZ:RoundedModeP b' radix (Closest b' radix)).
apply ClosestRoundedModeP with t; auto with zarith.
assert (K1':FtoRradix x1y1'=Cx1y1').
unfold FtoRradix; apply sym_eq; apply RoundedModeProjectorIdemEq with b' t (Closest b' radix); auto with zarith.
rewrite O1; rewrite MY3; rewrite MX3; auto.
assert (K1:FtoRradix Ct1'=t1').
unfold FtoRradix; apply RoundedModeProjectorIdemEq with b' t (Closest b' radix); auto with zarith.
rewrite M11; replace (FtoR radix Chx' × FtoR radix Chy')%R with (FtoRradix x1y1'); auto.
rewrite <- O1; auto.
assert (K2':FtoRradix x1y2'=Cx1y2').
unfold FtoRradix; apply sym_eq; apply RoundedModeProjectorIdemEq with b' t (Closest b' radix); auto with zarith.
rewrite O4; rewrite MY6; rewrite MX3; auto.
assert (K2:FtoRradix Ct2'=t2').
unfold FtoRradix; apply RoundedModeProjectorIdemEq with b' t (Closest b' radix); auto with zarith.
rewrite M21; rewrite <- M11; fold FtoRradix; rewrite K1.
replace (Chx' × Cty')%R with (FtoRradix x1y2'); auto.
unfold FtoRradix; rewrite <- O4; auto.
assert (K3':FtoRradix x2y1'=Cx2y1').
unfold FtoRradix; apply sym_eq; apply RoundedModeProjectorIdemEq with b' t (Closest b' radix); auto with zarith.
rewrite O7; rewrite MY3; rewrite MX6; auto.
assert (K3:FtoRradix Ct3'=t3').
unfold FtoRradix; apply RoundedModeProjectorIdemEq with b' t (Closest b' radix); auto with zarith.
rewrite M31; rewrite <- M21; fold FtoRradix; rewrite K2.
replace (Ctx' × Chy')%R with (FtoRradix x2y1'); auto.
unfold FtoRradix; rewrite <- O7; auto.
assert (K4':FtoRradix x2y2'=Cx2y2').
unfold FtoRradix; apply sym_eq; apply RoundedModeProjectorIdemEq with b' t (Closest b' radix); auto with zarith.
rewrite O10; rewrite MX6; rewrite MY6; auto.
assert (K4:FtoRradix Ct4'=t4').
unfold FtoRradix; apply RoundedModeProjectorIdemEq with b' t (Closest b' radix); auto with zarith.
rewrite M41; rewrite <- M31; fold FtoRradix; rewrite K3.
replace (Ctx' × Cty')%R with (FtoRradix x2y2'); auto.
unfold FtoRradix; rewrite <- O10; auto.
rewrite <- K4.
cut (Underf_Err b radix b' t4 Ct4' (t3-x2y2)%R (11/4)).
unfold FtoRradix; intros G; elim G; intros G1 G2; elim G2; intros G3 G4; elim G4; auto with real.
replace (11/4)%R with (9/4+/2)%R;
[idtac|field; apply prod_neq_R0; auto with real; apply prod_neq_R0; auto with real].
unfold FtoRradix; apply Underf_Err3_bis with t Ct3' Cx2y2' (t2-x2y1)%R (tx×ty)%R; auto with zarith.
replace (9/4)%R with (7/4+/2)%R;[idtac|
field; apply prod_neq_R0; auto with real; apply prod_neq_R0; auto with real].
unfold FtoRradix; apply Underf_Err3_bis with t Ct2' Cx2y1' (t1-x1y2)%R (tx×hy)%R; auto with zarith.
replace (7/4)%R with (5/4+/2)%R;[idtac|
field; apply prod_neq_R0; auto with real; apply prod_neq_R0; auto with real].
unfold FtoRradix; apply Underf_Err3_bis with t Ct1' Cx1y2' (r-x1y1)%R (hx×ty)%R; auto with zarith.
replace (5/4)%R with ((3/4)+/2)%R;[idtac|
field; apply prod_neq_R0; auto with real; apply prod_neq_R0; auto with real].
unfold FtoRradix; apply Underf_Err3_bis with t r' Cx1y1' (x×y)%R (hx×hy)%R; auto with zarith.
cut (hx×hy=FtoRradix Cx1y1')%R.
intros P; rewrite P; unfold FtoRradix; apply Underf_Err1 with t; auto with zarith.
fold FtoRradix; rewrite <- P; auto.
rewrite <- K1'; unfold FtoRradix; rewrite <- MX3; rewrite <- MY3; rewrite <- O1; auto.
apply Rmult_le_reg_l with (IZR 4); auto with real zarith; simpl.
apply Rle_trans with (IZR 5);[simpl; right; field; auto with real|idtac].
repeat apply prod_neq_R0; auto with real.
apply Rle_trans with (IZR 28); [auto with real zarith|simpl; right; ring].
rewrite M11; rewrite <- O1; auto with real.
rewrite M13; apply rExp with radix b' s; auto.
fold FtoRradix; rewrite Hx'; rewrite Hy'; auto.
cut (hx×ty=FtoRradix Cx1y2')%R.
intros P; rewrite P; unfold FtoRradix; apply Underf_Err1 with t; auto with zarith.
fold FtoRradix; rewrite <- P; auto.
unfold FtoRradix; rewrite O4; rewrite MX3; rewrite MY6; auto with real.
apply Rmult_le_reg_l with (IZR 4); auto with real zarith; simpl.
apply Rle_trans with (IZR 7);[simpl; right; field; auto with real|idtac].
repeat apply prod_neq_R0; auto with real.
apply Rle_trans with (IZR 28); [auto with real zarith|simpl; right; ring].
rewrite M21; rewrite M11; rewrite O4; ring.
cut (tx×hy=FtoRradix Cx2y1')%R.
intros P; rewrite P; unfold FtoRradix; apply Underf_Err1 with t; auto with zarith.
fold FtoRradix; rewrite <- P; auto.
unfold FtoRradix; rewrite O7; rewrite MX6; rewrite MY3; auto with real.
apply Rmult_le_reg_l with (IZR 4); auto with real zarith; simpl.
apply Rle_trans with (IZR 9);[simpl; right; field; auto with real|idtac].
repeat apply prod_neq_R0; auto with real.
apply Rle_trans with (IZR 28); [auto with real zarith|simpl; right; ring].
rewrite M21; rewrite M31; rewrite O7; ring.
cut (tx×ty=FtoRradix Cx2y2')%R.
intros P; rewrite P; unfold FtoRradix; apply Underf_Err1 with t; auto with zarith.
fold FtoRradix; rewrite <- P; auto.
unfold FtoRradix; rewrite O10; rewrite MX6; rewrite MY6; auto with real.
apply Rmult_le_reg_l with (IZR 4); auto with real zarith; simpl.
apply Rle_trans with (IZR 11);[simpl; right; field; auto with real|idtac].
repeat apply prod_neq_R0; auto with real.
apply Rle_trans with (IZR 28); [auto with real zarith|simpl; right; ring].
rewrite M41; rewrite M31; rewrite O10; ring.
Qed.
Theorem Dekker2:
(radix=2)%Z ∨ (even t) → (Rabs (x×y-(r-t4)) ≤ (7/2)*powerRZ radix (-(dExp b)))%R.
intros.
case (Req_dec 0%R x); intros Ny.
cut (FtoRradix r=0)%R;[intros Z1|idtac].
cut (FtoRradix t4=0)%R;[intros Z2|idtac].
replace ((x × y - (r - t4)))%R with 0%R.
rewrite Rabs_R0; apply Rlt_le; apply Rmult_lt_0_compat; auto with real zarith.
unfold Rdiv; apply Rmult_lt_0_compat; auto with real zarith.
apply Rlt_le_trans with (IZR 7);[auto with real zarith|simpl; right; ring].
fold FtoRradix; rewrite Z1; rewrite Z2; rewrite <- Ny; ring.
cut (FtoRradix hx=0)%R;[intros Z3|idtac].
cut (FtoRradix tx=0)%R;[intros Z4|idtac].
unfold FtoRradix; apply ClosestZero with b t (t3-x2y2)%R; auto with zarith.
cut (FtoRradix t3=0)%R;[intros Z5|idtac].
cut (FtoRradix x2y2=0)%R;[intros Z6|idtac].
rewrite Z5; rewrite Z6; ring.
unfold FtoRradix; apply ClosestZero with b t (tx×ty)%R; auto with zarith.
rewrite Z4; ring.
unfold FtoRradix; apply ClosestZero with b t (t2-x2y1)%R; auto with zarith.
cut (FtoRradix t2=0)%R;[intros Z5|idtac].
cut (FtoRradix x2y1=0)%R;[intros Z6|idtac].
rewrite Z5; rewrite Z6; ring.
unfold FtoRradix; apply ClosestZero with b t (tx×hy)%R; auto with zarith.
rewrite Z4; ring.
unfold FtoRradix; apply ClosestZero with b t (t1-x1y2)%R; auto with zarith.
cut (FtoRradix t1=0)%R;[intros Z5|idtac].
cut (FtoRradix x1y2=0)%R;[intros Z6|idtac].
rewrite Z5; rewrite Z6; ring.
unfold FtoRradix; apply ClosestZero with b t (hx×ty)%R; auto with zarith.
rewrite Z3; ring.
unfold FtoRradix; apply ClosestZero with b t (r-x1y1)%R; auto with zarith.
cut (FtoRradix x1y1=0)%R;[intros Z6|idtac].
rewrite Z1; rewrite Z6; ring.
unfold FtoRradix; apply ClosestZero with b t (hx×hy)%R; auto with zarith.
rewrite Z3; ring.
elim VeltkampU with radix b s t x p q hx tx; auto.
intros T1 T; elim T; intros H' T'; clear T1 T T'.
fold FtoRradix in H'; rewrite Z3 in H'; rewrite <- Ny in H'; auto with real.
apply trans_eq with (0+tx)%R; auto with real.
unfold s; apply SLe; auto.
unfold s; apply SGe; auto.
elim Veltkamp with radix b s t x p q hx; auto.
intros T1 T; elim T; intros hy' T'; elim T'; intros G1 T''; elim T''; intros ; clear T1 T T' T''.
unfold FtoRradix; rewrite <- G1.
apply ClosestZero with (Bound (P_of_succ_nat (pred (Zabs_nat (Zpower_nat radix (t - s)))))
(dExp b)) (t-s) (FtoR radix x)%R; auto with zarith.
apply p'GivesBound; auto with zarith.
assert (s ≤ t - 2)%Z; auto with zarith.
assert (s ≤ t - 2)%nat; auto with zarith.
unfold s; apply SGe; auto.
unfold s; apply SLe; auto.
unfold s; apply SGe; auto.
apply FcanonicBound with radix; auto.
unfold FtoRradix; apply ClosestZero with b t (x×y)%R; auto with zarith.
rewrite <- Ny; ring.
case (Req_dec 0%R y); intros Nx.
cut (FtoRradix r=0)%R;[intros Z1|idtac].
cut (FtoRradix t4=0)%R;[intros Z2|idtac].
replace ((x × y - (r - t4)))%R with 0%R.
rewrite Rabs_R0; apply Rlt_le; apply Rmult_lt_0_compat; auto with real zarith.
unfold Rdiv; apply Rmult_lt_0_compat; auto with real zarith.
apply Rlt_le_trans with (IZR 7);[auto with real zarith|simpl; right; ring].
fold FtoRradix; rewrite Z1; rewrite Z2; rewrite <- Nx; ring.
cut (FtoRradix hy=0)%R;[intros Z3|idtac].
cut (FtoRradix ty=0)%R;[intros Z4|idtac].
unfold FtoRradix; apply ClosestZero with b t (t3-x2y2)%R; auto with zarith.
cut (FtoRradix t3=0)%R;[intros Z5|idtac].
cut (FtoRradix x2y2=0)%R;[intros Z6|idtac].
rewrite Z5; rewrite Z6; ring.
unfold FtoRradix; apply ClosestZero with b t (tx×ty)%R; auto with zarith.
rewrite Z4; ring.
unfold FtoRradix; apply ClosestZero with b t (t2-x2y1)%R; auto with zarith.
cut (FtoRradix t2=0)%R;[intros Z5|idtac].
cut (FtoRradix x2y1=0)%R;[intros Z6|idtac].
rewrite Z5; rewrite Z6; ring.
unfold FtoRradix; apply ClosestZero with b t (tx×hy)%R; auto with zarith.
rewrite Z3; ring.
unfold FtoRradix; apply ClosestZero with b t (t1-x1y2)%R; auto with zarith.
cut (FtoRradix t1=0)%R;[intros Z5|idtac].
cut (FtoRradix x1y2=0)%R;[intros Z6|idtac].
rewrite Z5; rewrite Z6; ring.
unfold FtoRradix; apply ClosestZero with b t (hx×ty)%R; auto with zarith.
rewrite Z4; ring.
unfold FtoRradix; apply ClosestZero with b t (r-x1y1)%R; auto with zarith.
cut (FtoRradix x1y1=0)%R;[intros Z6|idtac].
rewrite Z1; rewrite Z6; ring.
unfold FtoRradix; apply ClosestZero with b t (hx×hy)%R; auto with zarith.
rewrite Z3; ring.
elim VeltkampU with radix b s t y p' q' hy ty; auto.
intros T1 T; elim T; intros H' T'; clear T1 T T'.
fold FtoRradix in H'; rewrite Z3 in H'; rewrite <- Nx in H'; auto with real.
apply trans_eq with (0+ty)%R; auto with real.
unfold s; apply SLe; auto.
unfold s; apply SGe; auto.
elim Veltkamp with radix b s t y p' q' hy; auto.
intros T1 T; elim T; intros hy' T'; elim T'; intros G1 T''; elim T''; intros ; clear T1 T T' T''.
unfold FtoRradix; rewrite <- G1.
apply ClosestZero with (Bound (P_of_succ_nat (pred (Zabs_nat (Zpower_nat radix (t - s)))))
(dExp b)) (t-s) (FtoR radix y)%R; auto with zarith.
apply p'GivesBound; auto with zarith.
assert (s ≤ t - 2)%Z; auto with zarith.
assert (s ≤ t - 2)%nat; auto with zarith.
unfold s; apply SGe; auto.
unfold s; apply SLe; auto.
unfold s; apply SGe; auto.
apply FcanonicBound with radix; auto.
unfold FtoRradix; apply ClosestZero with b t (x×y)%R; auto with zarith.
rewrite <- Nx; ring.
apply Dekker2_aux; auto.
Qed.
End Algo2.
Section AlgoT.
Variable radix : Z.
Variable b : Fbound.
Variables t: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 pGivesBound: Zpos (vNum b)=(Zpower_nat radix t).
Hypotheses pGe: (4 ≤ t).
Variables x y p q hx tx p' q' hy ty x1y1 x1y2 x2y1 x2y2 r t1 t2 t3 t4:float.
Hypothesis Cx: (Fcanonic radix b x).
Hypothesis Cy: (Fcanonic radix b y).
Let s:= t- div2 t.
Hypothesis A1: (Closest b radix (x*((powerRZ radix s)+1))%R p).
Hypothesis A2: (Closest b radix (x-p)%R q).
Hypothesis A3: (Closest b radix (q+p)%R hx).
Hypothesis A4: (Closest b radix (x-hx)%R tx).
Hypothesis B1: (Closest b radix (y*((powerRZ radix s)+1))%R p').
Hypothesis B2: (Closest b radix (y-p')%R q').
Hypothesis B3: (Closest b radix (q'+p')%R hy).
Hypothesis B4: (Closest b radix (y-hy)%R ty).
Hypothesis C1: (Closest b radix (hx×hy)%R x1y1).
Hypothesis C2: (Closest b radix (hx×ty)%R x1y2).
Hypothesis C3: (Closest b radix (tx×hy)%R x2y1).
Hypothesis C4: (Closest b radix (tx×ty)%R x2y2).
Hypothesis D1: (Closest b radix (x×y)%R r).
Hypothesis D2: (Closest b radix (-r+x1y1)%R t1).
Hypothesis D3: (Closest b radix (t1+x1y2)%R t2).
Hypothesis D4: (Closest b radix (t2+x2y1)%R t3).
Hypothesis D5: (Closest b radix (t3+x2y2)%R t4).
Hypothesis dExpPos: ¬(Z_of_N (dExp b)=0)%Z.
Theorem Dekker: (radix=2)%Z ∨ (even t) →
((-dExp b ≤ Fexp x+Fexp y)%Z → (x×y=r+t4)%R) ∧
(Rabs (x×y-(r+t4)) ≤ (7/2)*powerRZ radix (-(dExp b)))%R.
intros.
case (Zle_or_lt (-dExp b) (Fexp x+Fexp y)); intros.
cut (x × y = r + t4)%R; [intros; split; auto|idtac].
rewrite H1; ring_simplify ( (r + t4) - (r + t4))%R; rewrite Rabs_R0.
apply Rlt_le; apply Rmult_lt_0_compat; auto with real zarith.
unfold Rdiv; apply Rmult_lt_0_compat; auto with real zarith.
apply Rlt_le_trans with (IZR 7);[auto with real zarith|simpl; right; ring].
apply trans_eq with (r-(Fopp t4))%R;[idtac|unfold FtoRradix; rewrite Fopp_correct; ring].
unfold FtoRradix; apply Dekker1 with b t p q hx tx p' q' hy ty x1y1 x1y2 x2y1 x2y2
(Fopp t1) (Fopp t2) (Fopp t3); auto; try rewrite Fopp_correct; fold FtoRradix.
replace (r-x1y1)%R with (-(-r+x1y1))%R;[apply ClosestOpp; auto|ring].
replace (-t1-x1y2)%R with (-(t1+x1y2))%R;[apply ClosestOpp; auto|ring].
replace (-t2-x2y1)%R with (-(t2+x2y1))%R;[apply ClosestOpp; auto|ring].
replace (-t3-x2y2)%R with (-(t3+x2y2))%R;[apply ClosestOpp; auto|ring].
split.
intros; absurd (Fexp x + Fexp y < - dExp b)%Z; auto with zarith.
replace (r+t4)%R with (r-(Fopp t4))%R;[idtac|unfold FtoRradix; rewrite Fopp_correct; ring].
unfold FtoRradix; apply Dekker2 with t p q hx tx p' q' hy ty x1y1 x1y2 x2y1 x2y2
(Fopp t1) (Fopp t2) (Fopp t3); auto; try rewrite Fopp_correct; fold FtoRradix.
replace (r-x1y1)%R with (-(-r+x1y1))%R;[apply ClosestOpp; auto|ring].
replace (-t1-x1y2)%R with (-(t1+x1y2))%R;[apply ClosestOpp; auto|ring].
replace (-t2-x2y1)%R with (-(t2+x2y1))%R;[apply ClosestOpp; auto|ring].
replace (-t3-x2y2)%R with (-(t3+x2y2))%R;[apply ClosestOpp; auto|ring].
Qed.
End AlgoT.