Skip to content

GitLab

Attention une mise à jour du serveur va être effectuée le lundi 17 mai entre 13h et 13h30. Cette mise à jour va générer une interruption du service de quelques minutes.

Commit ae25c54d authored by Guillaume Melquiond's avatar Guillaume Melquiond
Browse files
Options

Replaced some Rnd_DN/UP_pt with explicit formulas for rounded values.

parent f544763b
Hide whitespace changes
Inline Side-by-side
Showing with 311 additions and 246 deletions
src/Calc/Fcalc_bracket.v
View file @ ae25c54d
...@@ -334,12 +334,7 @@ Variable Hstep : (0 < step)%R. ...@@ -334,12 +334,7 @@ Variable Hstep : (0 < step)%R.
Lemma double_div2 : Lemma double_div2 :
((start + start)/2 = start)%R. ((start + start)/2 = start)%R.
Proof. Proof.
rewrite <- (Rmult_1_r start). field.
unfold Rdiv.
rewrite <- Rmult_plus_distr_l, Rmult_assoc.
apply f_equal.
apply Rinv_r.
now apply (Z2R_neq 2 0).
Qed. Qed.
Lemma ordered_steps : Lemma ordered_steps :
...@@ -479,19 +474,9 @@ Lemma middle_odd : ...@@ -479,19 +474,9 @@ Lemma middle_odd :
(((start + Z2R k * step) + (start + Z2R (k + 1) * step))/2 = start + Z2R nb_steps * step * /2)%R. (((start + Z2R k * step) + (start + Z2R (k + 1) * step))/2 = start + Z2R nb_steps * step * /2)%R.
Proof. Proof.
intros k Hk. intros k Hk.
apply Rminus_diag_uniq. rewrite <- Hk.
rewrite plus_Z2R. rewrite 2!plus_Z2R, mult_Z2R.
simpl (Z2R 1). simpl. field.
unfold Rdiv.
match goal with
| |- ?v = R0 => replace v with (start * (2 * /2 + -1) + step * /2 * ((2 * Z2R k + 1) - Z2R nb_steps))%R by ring
end.
rewrite Rinv_r, Rplus_opp_r, Rmult_0_r, Rplus_0_l.
apply Rmult_eq_0_compat_l.
change (Z2R 2 * Z2R k + Z2R 1 - Z2R nb_steps = 0)%R.
rewrite <- mult_Z2R, <- plus_Z2R, <- minus_Z2R.
now rewrite Hk, Zminus_diag.
now apply (Z2R_neq 2 0).
Qed. Qed.
Theorem inbetween_step_Lo_Mi_odd : Theorem inbetween_step_Lo_Mi_odd :
...@@ -937,7 +922,7 @@ Theorem inbetween_float_DN : ...@@ -937,7 +922,7 @@ Theorem inbetween_float_DN :
forall x m l, forall x m l,
let e := canonic_exponent beta fexp x in let e := canonic_exponent beta fexp x in
inbetween_float m e x l -> inbetween_float m e x l ->
Rnd_DN_pt format x (F2R (Float beta m e)). F2R (Float beta m e) = rounding beta fexp ZrndDN x.
Proof. Proof.
intros x m l e Hl. intros x m l e Hl.
assert (Hb: (F2R (Float beta m e) <= x < F2R (Float beta (m + 1) e))%R). assert (Hb: (F2R (Float beta m e) <= x < F2R (Float beta (m + 1) e))%R).
...@@ -945,7 +930,7 @@ apply inbetween_bounds_strict with (2 := Hl). ...@@ -945,7 +930,7 @@ apply inbetween_bounds_strict with (2 := Hl).
apply F2R_lt_compat. apply F2R_lt_compat.
apply Zlt_succ. apply Zlt_succ.
replace m with (Zfloor (x * bpow (- e))). replace m with (Zfloor (x * bpow (- e))).
now apply generic_DN_pt. apply refl_equal.
apply Zfloor_imp. apply Zfloor_imp.
split. split.
apply Rmult_le_reg_r with (bpow e). apply Rmult_le_reg_r with (bpow e).
...@@ -970,7 +955,7 @@ Theorem inbetween_float_UP : ...@@ -970,7 +955,7 @@ Theorem inbetween_float_UP :
forall x m l, forall x m l,
let e := canonic_exponent beta fexp x in let e := canonic_exponent beta fexp x in
inbetween_float m e x l -> inbetween_float m e x l ->
Rnd_UP_pt format x (F2R (Float beta (cond_incr (round_UP l) m) e)). F2R (Float beta (cond_incr (round_UP l) m) e) = rounding beta fexp ZrndUP x.
Proof. Proof.
intros x m l e Hl. intros x m l e Hl.
assert (Hl': l = loc_Eq \/ l <> loc_Eq). assert (Hl': l = loc_Eq \/ l <> loc_Eq).
...@@ -981,7 +966,8 @@ rewrite Hl' in Hl. ...@@ -981,7 +966,8 @@ rewrite Hl' in Hl.
inversion_clear Hl. inversion_clear Hl.
rewrite H, Hl'. rewrite H, Hl'.
simpl. simpl.
apply Rnd_UP_pt_refl. rewrite rounding_generic.
apply refl_equal.
apply generic_format_canonic. apply generic_format_canonic.
unfold canonic. unfold canonic.
now rewrite <- H. now rewrite <- H.
...@@ -994,7 +980,7 @@ apply F2R_lt_compat. ...@@ -994,7 +980,7 @@ apply F2R_lt_compat.
apply Zlt_succ. apply Zlt_succ.
exact Hl'. exact Hl'.
replace (m + 1)%Z with (Zceil (x * bpow (- e))). replace (m + 1)%Z with (Zceil (x * bpow (- e))).
now apply generic_UP_pt. apply refl_equal.
apply Zceil_imp. apply Zceil_imp.
ring_simplify (m + 1 - 1)%Z. ring_simplify (m + 1 - 1)%Z.
split. split.
...@@ -1033,59 +1019,75 @@ assert (Hd := inbetween_float_DN _ _ _ Hl). ...@@ -1033,59 +1019,75 @@ assert (Hd := inbetween_float_DN _ _ _ Hl).
unfold round_NE. unfold round_NE.
generalize (inbetween_float_UP _ _ _ Hl). generalize (inbetween_float_UP _ _ _ Hl).
fold e in Hd |- *. fold e in Hd |- *.
assert (Hd': Rnd_DN_pt format x (F2R (Float beta m e))).
rewrite Hd.
now apply generic_DN_pt.
assert (Hu': Rnd_UP_pt format x (rounding beta fexp ZrndUP x)).
now apply generic_UP_pt.
destruct l ; simpl ; intros Hu. destruct l ; simpl ; intros Hu.
(* loc_Eq *) (* loc_Eq *)
inversion_clear Hl. inversion_clear Hl.
rewrite H. rewrite H.
apply Rnd_NG_pt_refl. apply Rnd_NG_pt_refl.
apply Hd. rewrite Hd.
now apply generic_format_rounding.
(* loc_Lo *) (* loc_Lo *)
split. split.
now apply (Rnd_N_pt_bracket_not_Hi _ _ _ _ Hd Hu loc_Lo). rewrite <- Hu in Hu'.
now apply (Rnd_N_pt_bracket_not_Hi _ _ _ _ Hd' Hu' loc_Lo).
right. right.
intros g Hg. intros g Hg.
destruct (Rnd_N_pt_DN_or_UP _ _ _ Hg) as [H|H]. destruct (generic_N_pt_DN_or_UP _ _ prop_exp _ _ Hg) as [H|H].
now apply Rnd_DN_pt_unicity with (1 := H). now rewrite Hd.
rewrite (Rnd_UP_pt_unicity _ _ _ _ H Hu) in Hg. rewrite H in Hg.
now elim (Rnd_not_N_pt_bracket_Lo _ _ _ _ Hd Hl). elim (Rnd_not_N_pt_bracket_Lo _ _ _ _ Hd' Hl).
now rewrite Hu.
(* loc_Mi *) (* loc_Mi *)
assert (Hm: (0 <= m)%Z). assert (Hm: (0 <= m)%Z).
apply Zlt_succ_le. apply Zlt_succ_le.
apply F2R_gt_0_reg with beta e. apply F2R_gt_0_reg with beta e.
apply Rlt_le_trans with (1 := Hx). apply Rlt_le_trans with (1 := Hx).
apply Hu. unfold Zsucc.
rewrite Hu.
apply (generic_UP_pt beta fexp prop_exp x).
destruct (Z_le_lt_eq_dec _ _ Hm) as [Hm'|Hm']. destruct (Z_le_lt_eq_dec _ _ Hm) as [Hm'|Hm'].
(* - 0 < m *) (* - 0 < m *)
assert (Hcd : canonic beta fexp (Float beta m e)). assert (Hcd : canonic beta fexp (Float beta m e)).
unfold canonic. unfold canonic.
apply sym_eq. apply sym_eq.
apply canonic_exponent_DN_pt ; try easy. rewrite Hd.
apply canonic_exponent_DN ; try easy.
rewrite <- Hd.
now apply F2R_gt_0_compat. now apply F2R_gt_0_compat.
destruct (Zeven_odd_bool m) as ([|], Heo) ; simpl. destruct (Zeven_odd_bool m) as ([|], Heo) ; simpl.
split. split.
now apply (Rnd_N_pt_bracket_not_Hi _ _ _ _ Hd Hu loc_Mi). apply (Rnd_N_pt_bracket_not_Hi _ _ _ _ Hd' Hu' loc_Mi).
easy.
now rewrite <- Hu.
left. left.
now eexists ; repeat split. now eexists ; repeat split.
split. split.
apply (Rnd_N_pt_bracket_Mi_Hi _ _ _ _ Hd Hu loc_Mi). rewrite <- Hu in Hu'.
apply (Rnd_N_pt_bracket_Mi_Hi _ _ _ _ Hd' Hu' loc_Mi).
now left. now left.
exact Hl. exact Hl.
left. left.
generalize (proj1 Hu). generalize (proj1 Hu').
rewrite <- Hu.
unfold generic_format. unfold generic_format.
fold e. fold e.
set (cu := Float beta (Ztrunc (scaled_mantissa beta fexp (F2R (Float beta (m + 1) e)))) set (cu := Float beta (Ztrunc (scaled_mantissa beta fexp (F2R (Float beta (m + 1) e))))
(canonic_exponent beta fexp (F2R (Float beta (m + 1) e)))). (canonic_exponent beta fexp (F2R (Float beta (m + 1) e)))).
intros Hu'. intros Hu''.
assert (Hcu : canonic beta fexp cu). assert (Hcu : canonic beta fexp cu).
unfold canonic. unfold canonic.
now rewrite <- Hu'. now rewrite <- Hu''.
rewrite Hu'. rewrite Hu''.
eexists ; repeat split. eexists ; repeat split.
exact Hcu. exact Hcu.
replace (Fnum cu) with (Fnum (Float beta m e) + Fnum cu + -Fnum (Float beta m e))%Z by ring. replace (Fnum cu) with (Fnum (Float beta m e) + Fnum cu + -Fnum (Float beta m e))%Z by ring.
apply Zodd_plus_Zodd. apply Zodd_plus_Zodd.
rewrite Hu' in Hu. rewrite Hu'' in Hu.
apply (DN_UP_parity_generic beta fexp prop_exp strong_fexp x (Float beta m e) cu) ; try easy. apply (DN_UP_parity_generic beta fexp prop_exp strong_fexp x (Float beta m e) cu) ; try easy.
apply (generic_format_discrete beta fexp x m). apply (generic_format_discrete beta fexp x m).
apply inbetween_bounds_strict_not_Eq with (2 := Hl). apply inbetween_bounds_strict_not_Eq with (2 := Hl).
...@@ -1097,7 +1099,9 @@ now apply Zodd_mult_Zodd. ...@@ -1097,7 +1099,9 @@ now apply Zodd_mult_Zodd.
(* - m = 0 *) (* - m = 0 *)
destruct (Zeven_odd_bool m) as ([|], Heo) ; simpl. destruct (Zeven_odd_bool m) as ([|], Heo) ; simpl.
split. split.
now apply (Rnd_N_pt_bracket_not_Hi _ _ _ _ Hd Hu loc_Mi). apply (Rnd_N_pt_bracket_not_Hi _ _ _ _ Hd' Hu' loc_Mi).
easy.
now rewrite <- Hu.
left. left.
rewrite <- Hm', F2R_0. rewrite <- Hm', F2R_0.
exists (Float beta 0 (canonic_exponent beta fexp 0)). exists (Float beta 0 (canonic_exponent beta fexp 0)).
...@@ -1108,15 +1112,18 @@ rewrite <- Hm' in Heo. ...@@ -1108,15 +1112,18 @@ rewrite <- Hm' in Heo.
elim Heo. elim Heo.
(* loc_Hi *) (* loc_Hi *)
split. split.
apply (Rnd_N_pt_bracket_Mi_Hi _ _ _ _ Hd Hu loc_Hi). rewrite <- Hu in Hu'.
apply (Rnd_N_pt_bracket_Mi_Hi _ _ _ _ Hd' Hu' loc_Hi).
now right. now right.
exact Hl. exact Hl.
right. right.
intros g Hg. intros g Hg.
destruct (Rnd_N_pt_DN_or_UP _ _ _ Hg) as [H|H]. destruct (generic_N_pt_DN_or_UP _ _ prop_exp _ _ Hg) as [H|H].
rewrite (Rnd_DN_pt_unicity _ _ _ _ H Hd) in Hg. rewrite H in Hg.
now elim (Rnd_not_N_pt_bracket_Hi _ _ _ _ Hu Hl). rewrite <- Hu in Hu'.
now apply Rnd_UP_pt_unicity with (1 := H). elim (Rnd_not_N_pt_bracket_Hi _ _ _ _ Hu' Hl).
now rewrite Hd.
now rewrite H.
Qed. Qed.
End Fcalc_bracket_generic. End Fcalc_bracket_generic.
src/Core/Fcore_generic_fmt.v
View file @ ae25c54d
...@@ -346,6 +346,29 @@ Let Zrnd := Zrnd rnd. ...@@ -346,6 +346,29 @@ Let Zrnd := Zrnd rnd.
Let Zrnd_monotone := Zrnd_monotone rnd. Let Zrnd_monotone := Zrnd_monotone rnd.
Let Zrnd_Z2R := Zrnd_Z2R rnd. Let Zrnd_Z2R := Zrnd_Z2R rnd.
Theorem Zrnd_DN_or_UP :
forall x, Zrnd x = Zfloor x \/ Zrnd x = Zceil x.
Proof.
intros x.
destruct (Zle_or_lt (Zrnd x) (Zfloor x)) as [Hx|Hx].
left.
apply Zle_antisym with (1 := Hx).
rewrite <- (Zrnd_Z2R (Zfloor x)).
apply Zrnd_monotone.
apply Zfloor_lb.
right.
apply Zle_antisym.
rewrite <- (Zrnd_Z2R (Zceil x)).
apply Zrnd_monotone.
apply Zceil_ub.
rewrite Zceil_floor_neq.
omega.
intros H.
rewrite <- H in Hx.
rewrite Zfloor_Z2R, Zrnd_Z2R in Hx.
apply Zlt_irrefl with (1 := Hx).
Qed.
Definition rounding x := Definition rounding x :=
F2R (Float beta (Zrnd (scaled_mantissa x)) (canonic_exponent x)). F2R (Float beta (Zrnd (scaled_mantissa x)) (canonic_exponent x)).
...@@ -455,6 +478,18 @@ End Fcore_generic_rounding_pos. ...@@ -455,6 +478,18 @@ End Fcore_generic_rounding_pos.
Definition ZrndDN := mkZrounding Zfloor Zfloor_le Zfloor_Z2R. Definition ZrndDN := mkZrounding Zfloor Zfloor_le Zfloor_Z2R.
Definition ZrndUP := mkZrounding Zceil Zceil_le Zceil_Z2R. Definition ZrndUP := mkZrounding Zceil Zceil_le Zceil_Z2R.
Theorem rounding_DN_or_UP :
forall rnd x,
rounding rnd x = rounding ZrndDN x \/ rounding rnd x = rounding ZrndUP x.
Proof.
intros rnd x.
unfold rounding.
unfold Zrnd at 2 4. simpl.
destruct (Zrnd_DN_or_UP rnd (scaled_mantissa x)) as [Hx|Hx].
left. now rewrite Hx.
right. now rewrite Hx.
Qed.
Section Fcore_generic_rounding. Section Fcore_generic_rounding.
Theorem rounding_monotone : Theorem rounding_monotone :
...@@ -519,10 +554,10 @@ End Fcore_generic_rounding. ...@@ -519,10 +554,10 @@ End Fcore_generic_rounding.
Theorem generic_DN_pt_pos : Theorem generic_DN_pt_pos :
forall x, (0 < x)%R -> forall x, (0 < x)%R ->
Rnd_DN_pt generic_format x (F2R (Float beta (Zfloor (scaled_mantissa x)) (canonic_exponent x))). Rnd_DN_pt generic_format x (rounding ZrndDN x).
Proof. Proof.
intros x H0x. intros x H0x.
unfold scaled_mantissa, canonic_exponent. unfold rounding, scaled_mantissa, canonic_exponent.
destruct (ln_beta beta x) as (ex, He). destruct (ln_beta beta x) as (ex, He).
simpl. simpl.
specialize (He (Rgt_not_eq _ _ H0x)). specialize (He (Rgt_not_eq _ _ H0x)).
...@@ -621,10 +656,10 @@ Qed. ...@@ -621,10 +656,10 @@ Qed.
Theorem generic_DN_pt_neg : Theorem generic_DN_pt_neg :
forall x, (x < 0)%R -> forall x, (x < 0)%R ->
Rnd_DN_pt generic_format x (F2R (Float beta (Zfloor (scaled_mantissa x)) (canonic_exponent x))). Rnd_DN_pt generic_format x (rounding ZrndDN x).
Proof. Proof.
intros x Hx0. intros x Hx0.
unfold scaled_mantissa, canonic_exponent. unfold rounding, scaled_mantissa, canonic_exponent.
destruct (ln_beta beta x) as (ex, He). destruct (ln_beta beta x) as (ex, He).
simpl. simpl.
specialize (He (Rlt_not_eq _ _ Hx0)). specialize (He (Rlt_not_eq _ _ Hx0)).
...@@ -815,11 +850,12 @@ Qed. ...@@ -815,11 +850,12 @@ Qed.
Theorem generic_DN_pt : Theorem generic_DN_pt :
forall x, forall x,
Rnd_DN_pt generic_format x (F2R (Float beta (Zfloor (x * bpow (- canonic_exponent x))) (canonic_exponent x))). Rnd_DN_pt generic_format x (rounding ZrndDN x).
Proof. Proof.
intros x. intros x.
destruct (total_order_T 0 x) as [[Hx|Hx]|Hx]. destruct (total_order_T 0 x) as [[Hx|Hx]|Hx].
now apply generic_DN_pt_pos. now apply generic_DN_pt_pos.
unfold rounding, scaled_mantissa.
rewrite <- Hx, Rmult_0_l. rewrite <- Hx, Rmult_0_l.
fold (Z2R 0). fold (Z2R 0).
rewrite Zfloor_Z2R, F2R_0. rewrite Zfloor_Z2R, F2R_0.
...@@ -828,57 +864,93 @@ apply generic_format_0. ...@@ -828,57 +864,93 @@ apply generic_format_0.
now apply generic_DN_pt_neg. now apply generic_DN_pt_neg.
Qed. Qed.
Theorem generic_DN_opp :
forall x,
rounding ZrndDN (-x) = (- rounding ZrndUP x)%R.
Proof.
intros x.
unfold rounding.
rewrite scaled_mantissa_opp.
rewrite opp_F2R.
unfold Zrnd. simpl.
unfold Zceil.
rewrite Zopp_involutive.
now rewrite canonic_exponent_opp.
Qed.
Theorem generic_UP_opp :
forall x,
rounding ZrndUP (-x) = (- rounding ZrndDN x)%R.
Proof.
intros x.
unfold rounding.
rewrite scaled_mantissa_opp.
rewrite opp_F2R.
unfold Zrnd. simpl.
unfold Zceil.
rewrite Ropp_involutive.
now rewrite canonic_exponent_opp.
Qed.
Theorem generic_UP_pt : Theorem generic_UP_pt :
forall x, forall x,
Rnd_UP_pt generic_format x (F2R (Float beta (Zceil (x * bpow (- canonic_exponent x))) (canonic_exponent x))). Rnd_UP_pt generic_format x (rounding ZrndUP x).
Proof. Proof.
intros x. intros x.
apply Rnd_DN_UP_pt_sym. apply Rnd_DN_UP_pt_sym.
apply generic_format_satisfies_any. apply generic_format_satisfies_any.
unfold Zceil. pattern x at 2 ; rewrite <- Ropp_involutive.
rewrite <- Ropp_mult_distr_l_reverse. rewrite generic_UP_opp.
rewrite opp_F2R, Zopp_involutive. rewrite Ropp_involutive.
rewrite <- canonic_exponent_opp.
apply generic_DN_pt. apply generic_DN_pt.
Qed. Qed.
Theorem generic_DN_pt_small_pos : Theorem generic_format_rounding :
forall rnd x,
generic_format (rounding rnd x).
Proof.
intros rnd x.
destruct (rounding_DN_or_UP rnd x) as [H|H] ; rewrite H.
apply (generic_DN_pt x).
apply (generic_UP_pt x).
Qed.
Theorem generic_DN_small_pos :
forall x ex, forall x ex,
(bpow (ex - 1) <= x < bpow ex)%R -> (bpow (ex - 1) <= x < bpow ex)%R ->
(ex <= fexp ex)%Z -> (ex <= fexp ex)%Z ->
Rnd_DN_pt generic_format x R0. rounding ZrndDN x = R0.
Proof. Proof.
intros x ex Hx He. intros x ex Hx He.
rewrite <- (F2R_0 beta (canonic_exponent x)). rewrite <- (F2R_0 beta (canonic_exponent x)).
rewrite <- mantissa_DN_small_pos with (1 := Hx) (2 := He). rewrite <- mantissa_DN_small_pos with (1 := Hx) (2 := He).
rewrite <- canonic_exponent_fexp_pos with (1 := Hx). now rewrite <- canonic_exponent_fexp_pos with (1 := Hx).
apply generic_DN_pt.
Qed. Qed.
Theorem generic_UP_pt_small_pos : Theorem generic_UP_small_pos :
forall x ex, forall x ex,
(bpow (ex - 1) <= x < bpow ex)%R -> (bpow (ex - 1) <= x < bpow ex)%R ->
(ex <= fexp ex)%Z -> (ex <= fexp ex)%Z ->
Rnd_UP_pt generic_format x (bpow (fexp ex)). rounding ZrndUP x = (bpow (fexp ex)).
Proof. Proof.
intros x ex Hx He. intros x ex Hx He.
rewrite <- F2R_bpow. rewrite <- F2R_bpow.
rewrite <- mantissa_UP_small_pos with (1 := Hx) (2 := He). rewrite <- mantissa_UP_small_pos with (1 := Hx) (2 := He).
rewrite <- canonic_exponent_fexp_pos with (1 := Hx). now rewrite <- canonic_exponent_fexp_pos with (1 := Hx).
apply generic_UP_pt.
Qed. Qed.
Theorem generic_UP_pt_large_pos_le_pow : Theorem generic_UP_large_pos_le_pow :
forall x xu ex, forall x ex,
(bpow (ex - 1) <= x < bpow ex)%R -> (bpow (ex - 1) <= x < bpow ex)%R ->
(fexp ex < ex)%Z -> (fexp ex < ex)%Z ->
Rnd_UP_pt generic_format x xu -> (rounding ZrndUP x <= bpow ex)%R.
(xu <= bpow ex)%R.
Proof. Proof.
intros x xu ex Hx He (_, (_, Hu4)). intros x ex Hx He.
apply Hu4 with (2 := Rlt_le _ _ (proj2 Hx)). apply (generic_UP_pt x).
apply generic_format_bpow. apply generic_format_bpow.
exact (proj1 (prop_exp _) He). exact (proj1 (prop_exp _) He).
apply Rlt_le.
apply Hx.
Qed. Qed.
Theorem generic_format_EM : Theorem generic_format_EM :
...@@ -900,18 +972,17 @@ rewrite <- Hxd. ...@@ -900,18 +972,17 @@ rewrite <- Hxd.
apply Hd. apply Hd.
Qed. Qed.
Theorem generic_DN_pt_large_pos_ge_pow : Theorem generic_DN_large_pos_ge_pow :
forall x d e, forall x e,
(0 < d)%R -> (0 < rounding ZrndDN x)%R ->
Rnd_DN_pt generic_format x d ->
(bpow e <= x)%R -> (bpow e <= x)%R ->
(bpow e <= d)%R. (bpow e <= rounding ZrndDN x)%R.
Proof. Proof.
intros x d e Hd Hxd Hex. intros x e Hd Hex.
destruct (ln_beta beta x) as (ex, He). destruct (ln_beta beta x) as (ex, He).
assert (Hx: (0 < x)%R). assert (Hx: (0 < x)%R).
apply Rlt_le_trans with (1 := Hd). apply Rlt_le_trans with (1 := Hd).
apply Hxd. apply (generic_DN_pt x).
specialize (He (Rgt_not_eq _ _ Hx)). specialize (He (Rgt_not_eq _ _ Hx)).
rewrite Rabs_pos_eq in He. 2: now apply Rlt_le. rewrite Rabs_pos_eq in He. 2: now apply Rlt_le.
apply Rle_trans with (bpow (ex - 1)). apply Rle_trans with (bpow (ex - 1)).
...@@ -919,38 +990,52 @@ apply -> bpow_le. ...@@ -919,38 +990,52 @@ apply -> bpow_le.
cut (e < ex)%Z. omega. cut (e < ex)%Z. omega.
apply <- bpow_lt. apply <- bpow_lt.
now apply Rle_lt_trans with (2 := proj2 He). now apply Rle_lt_trans with (2 := proj2 He).
apply Hxd with (2 := proj1 He). apply (generic_DN_pt x) with (2 := proj1 He).
apply generic_format_bpow. apply generic_format_bpow.
destruct (Zle_or_lt ex (fexp ex)). destruct (Zle_or_lt ex (fexp ex)).
elim Rgt_not_eq with (1 := Hd). elim Rgt_not_eq with (1 := Hd).
apply Rnd_DN_pt_unicity with (1 := Hxd). now apply generic_DN_small_pos with (1 := He).
now apply generic_DN_pt_small_pos with (1 := He).
ring_simplify (ex - 1 + 1)%Z. ring_simplify (ex - 1 + 1)%Z.
omega. omega.
Qed. Qed.
Theorem canonic_exponent_DN_pt : Theorem canonic_exponent_DN :
forall x