Commit 81b2a74c authored by Guillaume Melquiond's avatar Guillaume Melquiond

Added implicit coercions for radix and ln_beta.

parent fb5135b4
...@@ -52,7 +52,7 @@ Qed. ...@@ -52,7 +52,7 @@ Qed.
Theorem implies_MinOrMax_not_bpow: Theorem implies_MinOrMax_not_bpow:
forall x f, format f -> forall x f, format f ->
(0 < f)%R -> (0 < f)%R ->
f <> bpow (projT1 (ln_beta beta f)) -> f <> bpow (ln_beta beta f) ->
(Rabs (f-x) < ulp f)%R -> (Rabs (f-x) < ulp f)%R ->
MinOrMax x f. MinOrMax x f.
intros x f Hf1 Hf2 Hf3 Hxf1. intros x f Hf1 Hf2 Hf3 Hxf1.
...@@ -84,7 +84,7 @@ Qed. ...@@ -84,7 +84,7 @@ Qed.
Theorem implies_MinOrMax_bpow: Theorem implies_MinOrMax_bpow:
forall x f, format f -> forall x f, format f ->
f = bpow (projT1 (ln_beta beta f)) -> f = bpow (ln_beta beta f) ->
(Rabs (f-x) < /2* ulp f)%R -> (Rabs (f-x) < /2* ulp f)%R ->
MinOrMax x f. MinOrMax x f.
intros x f Hf1 Hf2 Hxf. intros x f Hf1 Hf2 Hxf.
......
...@@ -507,17 +507,17 @@ Theorem inbetween_float_new_location : ...@@ -507,17 +507,17 @@ Theorem inbetween_float_new_location :
forall x m e l k, forall x m e l k,
(0 < k)%Z -> (0 < k)%Z ->
inbetween_float m e x l -> inbetween_float m e x l ->
inbetween_float (Zdiv m (Zpower (radix_val beta) k)) (e + k) x (new_location (Zpower (radix_val beta) k) (Zmod m (Zpower (radix_val beta) k)) l). inbetween_float (Zdiv m (Zpower beta k)) (e + k) x (new_location (Zpower beta k) (Zmod m (Zpower beta k)) l).
Proof. Proof.
intros x m e l k Hk Hx. intros x m e l k Hk Hx.
unfold inbetween_float in *. unfold inbetween_float in *.
assert (Hr: forall m, F2R (Float beta m (e + k)) = F2R (Float beta (m * Zpower (radix_val beta) k) e)). assert (Hr: forall m, F2R (Float beta m (e + k)) = F2R (Float beta (m * Zpower beta k) e)).
clear -Hk. intros m. clear -Hk. intros m.
rewrite (F2R_change_exp beta e). rewrite (F2R_change_exp beta e).
apply (f_equal (fun r => F2R (Float beta (m * Zpower _ r) e))). apply (f_equal (fun r => F2R (Float beta (m * Zpower _ r) e))).
ring. ring.
omega. omega.
assert (Hp: (Zpower (radix_val beta) k > 0)%Z). assert (Hp: (Zpower beta k > 0)%Z).
apply Zlt_gt. apply Zlt_gt.
now apply Zpower_gt_0. now apply Zpower_gt_0.
(* . *) (* . *)
...@@ -537,10 +537,10 @@ Qed. ...@@ -537,10 +537,10 @@ Qed.
Theorem inbetween_float_new_location_single : Theorem inbetween_float_new_location_single :
forall x m e l, forall x m e l,
inbetween_float m e x l -> inbetween_float m e x l ->
inbetween_float (Zdiv m (radix_val beta)) (e + 1) x (new_location (radix_val beta) (Zmod m (radix_val beta)) l). inbetween_float (Zdiv m beta) (e + 1) x (new_location beta (Zmod m beta) l).
Proof. Proof.
intros x m e l Hx. intros x m e l Hx.
replace (radix_val beta) with (Zpower (radix_val beta) 1). replace (radix_val beta) with (Zpower beta 1).
now apply inbetween_float_new_location. now apply inbetween_float_new_location.
apply Zmult_1_r. apply Zmult_1_r.
Qed. Qed.
......
...@@ -35,15 +35,15 @@ Hypothesis Hp : (0 <= p)%Z. ...@@ -35,15 +35,15 @@ Hypothesis Hp : (0 <= p)%Z.
Fixpoint digits_aux (nb pow : Z) (n : nat) { struct n } : Z := Fixpoint digits_aux (nb pow : Z) (n : nat) { struct n } : Z :=
match n with match n with
| O => nb | O => nb
| S n => if Zlt_bool p pow then nb else digits_aux (nb + 1) (Zmult (radix_val beta) pow) n | S n => if Zlt_bool p pow then nb else digits_aux (nb + 1) (Zmult beta pow) n
end. end.
Lemma digits_aux_invariant : Lemma digits_aux_invariant :
forall k n nb, forall k n nb,
(0 <= nb)%Z -> (0 <= nb)%Z ->
(Zpower (radix_val beta) (nb + Z_of_nat k - 1) <= p)%Z -> (Zpower beta (nb + Z_of_nat k - 1) <= p)%Z ->
digits_aux (nb + Z_of_nat k) (Zpower (radix_val beta) (nb + Z_of_nat k)) n = digits_aux (nb + Z_of_nat k) (Zpower beta (nb + Z_of_nat k)) n =
digits_aux nb (Zpower (radix_val beta) nb) (n + k). digits_aux nb (Zpower beta nb) (n + k).
Proof. Proof.
induction k ; intros n nb Hnb. induction k ; intros n nb Hnb.
now rewrite Zplus_0_r, plus_0_r. now rewrite Zplus_0_r, plus_0_r.
...@@ -54,7 +54,7 @@ rewrite (Zplus_comm _ 1), Zplus_assoc. ...@@ -54,7 +54,7 @@ rewrite (Zplus_comm _ 1), Zplus_assoc.
rewrite IHk. rewrite IHk.
rewrite <- plus_n_Sm. rewrite <- plus_n_Sm.
simpl. simpl.
generalize (Zlt_cases p (Zpower (radix_val beta) nb)). generalize (Zlt_cases p (Zpower beta nb)).
case Zlt_bool ; intros Hpp. case Zlt_bool ; intros Hpp.
elim (Zlt_irrefl p). elim (Zlt_irrefl p).
apply Zlt_le_trans with (1 := Hpp). apply Zlt_le_trans with (1 := Hpp).
...@@ -81,8 +81,8 @@ End digits_aux. ...@@ -81,8 +81,8 @@ End digits_aux.
Definition digits n := Definition digits n :=
match n with match n with
| Z0 => Z0 | Z0 => Z0
| Zneg p => digits_aux (Zpos p) 1 (radix_val beta) (digits2_Pnat p) | Zneg p => digits_aux (Zpos p) 1 beta (digits2_Pnat p)
| Zpos p => digits_aux n 1 (radix_val beta) (digits2_Pnat p) | Zpos p => digits_aux n 1 beta (digits2_Pnat p)
end. end.
Theorem digits_abs : Theorem digits_abs :
...@@ -94,7 +94,7 @@ Qed. ...@@ -94,7 +94,7 @@ Qed.
Theorem digits_ln_beta : Theorem digits_ln_beta :
forall n, forall n,
n <> Z0 -> n <> Z0 ->
digits n = projT1 (ln_beta beta (Z2R n)). digits n = ln_beta beta (Z2R n).
Proof. Proof.
intros n Hn. intros n Hn.
destruct (ln_beta beta (Z2R n)) as (e, He). destruct (ln_beta beta (Z2R n)) as (e, He).
...@@ -117,7 +117,7 @@ now apply (Zlt_le_succ 0). ...@@ -117,7 +117,7 @@ now apply (Zlt_le_succ 0).
assert (He2: (Z_of_nat (Zabs_nat (e - 1)) = e - 1)%Z). assert (He2: (Z_of_nat (Zabs_nat (e - 1)) = e - 1)%Z).
rewrite inj_Zabs_nat. rewrite inj_Zabs_nat.
now apply Zabs_eq. now apply Zabs_eq.
replace (radix_val beta) with (Zpower (radix_val beta) 1). replace (radix_val beta) with (Zpower beta 1).
replace (digits2_Pnat p) with (digits2_Pnat p - Zabs_nat (e - 1) + Zabs_nat (e - 1)). replace (digits2_Pnat p) with (digits2_Pnat p - Zabs_nat (e - 1) + Zabs_nat (e - 1)).
rewrite <- digits_aux_invariant. rewrite <- digits_aux_invariant.
rewrite He2. rewrite He2.
...@@ -125,7 +125,7 @@ ring_simplify (1 + (e - 1))%Z. ...@@ -125,7 +125,7 @@ ring_simplify (1 + (e - 1))%Z.
destruct (digits2_Pnat p - Zabs_nat (e - 1)) as [|n]. destruct (digits2_Pnat p - Zabs_nat (e - 1)) as [|n].
easy. easy.
simpl. simpl.
generalize (Zlt_cases (Zpos p) (Zpower (radix_val beta) e)). generalize (Zlt_cases (Zpos p) (Zpower beta e)).
case Zlt_bool ; intros Hpp. case Zlt_bool ; intros Hpp.
easy. easy.
elim Rlt_not_le with (1 := proj2 He). elim Rlt_not_le with (1 := proj2 He).
...@@ -154,7 +154,7 @@ exact (proj2 (digits2_Pnat_correct p)). ...@@ -154,7 +154,7 @@ exact (proj2 (digits2_Pnat_correct p)).
clear. clear.
induction (S (digits2_Pnat p)). induction (S (digits2_Pnat p)).
easy. easy.
change (2 * Zpower_nat 2 n <= radix_val beta * Zpower_nat (radix_val beta) n)%Z. change (2 * Zpower_nat 2 n <= beta * Zpower_nat beta n)%Z.
apply Zmult_le_compat ; try easy. apply Zmult_le_compat ; try easy.
apply Zle_bool_imp_le. apply Zle_bool_imp_le.
apply beta. apply beta.
...@@ -188,7 +188,7 @@ Qed. ...@@ -188,7 +188,7 @@ Qed.
Theorem digits_shift : Theorem digits_shift :
forall m e, forall m e,
m <> Z0 -> (0 <= e)%Z -> m <> Z0 -> (0 <= e)%Z ->
digits (m * Zpower (radix_val beta) e) = (digits m + e)%Z. digits (m * Zpower beta e) = (digits m + e)%Z.
Proof. Proof.
intros m e Hm He. intros m e Hm He.
rewrite 2!digits_ln_beta. rewrite 2!digits_ln_beta.
...@@ -316,4 +316,4 @@ rewrite Zmult_0_l, Zplus_0_r, 2!Zplus_0_l. ...@@ -316,4 +316,4 @@ rewrite Zmult_0_l, Zplus_0_r, 2!Zplus_0_l.
apply Zle_refl. apply Zle_refl.
Qed. Qed.
End Fcalc_digits. End Fcalc_digits.
\ No newline at end of file
...@@ -21,7 +21,7 @@ Definition Fdiv_aux prec m1 e1 m2 e2 := ...@@ -21,7 +21,7 @@ Definition Fdiv_aux prec m1 e1 m2 e2 :=
let e := (e1 - e2)%Z in let e := (e1 - e2)%Z in
let (m, e') := let (m, e') :=
match (d2 + prec - d1)%Z with match (d2 + prec - d1)%Z with
| Zpos p => (m1 * Zpower_pos (radix_val beta) p, e + Zneg p)%Z | Zpos p => (m1 * Zpower_pos beta p, e + Zneg p)%Z
| _ => (m1, e) | _ => (m1, e)
end in end in
let '(q, r) := Zdiv_eucl m m2 in let '(q, r) := Zdiv_eucl m m2 in
...@@ -41,7 +41,7 @@ set (d1 := digits beta m1). ...@@ -41,7 +41,7 @@ set (d1 := digits beta m1).
set (d2 := digits beta m2). set (d2 := digits beta m2).
case_eq case_eq
(match (d2 + prec - d1)%Z with (match (d2 + prec - d1)%Z with
| Zpos p => ((m1 * Zpower_pos (radix_val beta) p)%Z, (e1 - e2 + Zneg p)%Z) | Zpos p => ((m1 * Zpower_pos beta p)%Z, (e1 - e2 + Zneg p)%Z)
| _ => (m1, (e1 - e2)%Z) | _ => (m1, (e1 - e2)%Z)
end). end).
intros m' e' Hme. intros m' e' Hme.
...@@ -56,7 +56,7 @@ repeat split. ...@@ -56,7 +56,7 @@ repeat split.
now rewrite <- H0. now rewrite <- H0.
apply Zle_refl. apply Zle_refl.
replace (e1 - e2 + Zneg p + e2)%Z with (e1 - Zpos p)%Z by (unfold Zminus ; simpl ; ring). replace (e1 - e2 + Zneg p + e2)%Z with (e1 - Zpos p)%Z by (unfold Zminus ; simpl ; ring).
fold (Zpower (radix_val beta) (Zpos p)). fold (Zpower beta (Zpos p)).
split. split.
pattern (Zpos p) at 1 ; replace (Zpos p) with (e1 - (e1 - Zpos p))%Z by ring. pattern (Zpos p) at 1 ; replace (Zpos p) with (e1 - (e1 - Zpos p))%Z by ring.
apply sym_eq. apply sym_eq.
......
...@@ -12,8 +12,8 @@ Definition Falign (f1 f2 : float beta) := ...@@ -12,8 +12,8 @@ Definition Falign (f1 f2 : float beta) :=
let '(Float m1 e1) := f1 in let '(Float m1 e1) := f1 in
let '(Float m2 e2) := f2 in let '(Float m2 e2) := f2 in
if Zle_bool e1 e2 if Zle_bool e1 e2
then (m1, (m2 * Zpower (radix_val beta) (e2 - e1))%Z, e1) then (m1, (m2 * Zpower beta (e2 - e1))%Z, e1)
else ((m1 * Zpower (radix_val beta) (e1 - e2))%Z, m2, e2). else ((m1 * Zpower beta (e1 - e2))%Z, m2, e2).
Theorem Falign_spec : Theorem Falign_spec :
forall f1 f2 : float beta, forall f1 f2 : float beta,
......
...@@ -15,7 +15,7 @@ Definition truncate t := ...@@ -15,7 +15,7 @@ Definition truncate t :=
let '(m, e, l) := t in let '(m, e, l) := t in
let k := (fexp (digits beta m + e) - e)%Z in let k := (fexp (digits beta m + e) - e)%Z in
if Zlt_bool 0 k then if Zlt_bool 0 k then
let p := Zpower (radix_val beta) k in let p := Zpower beta k in
(Zdiv m p, (e + k)%Z, new_location p (Zmod m p) l) (Zdiv m p, (e + k)%Z, new_location p (Zmod m p) l)
else t. else t.
...@@ -31,7 +31,7 @@ Proof. ...@@ -31,7 +31,7 @@ Proof.
intros x m e l Hx H1 H2. intros x m e l Hx H1 H2.
unfold truncate. unfold truncate.
set (k := (fexp (digits beta m + e) - e)%Z). set (k := (fexp (digits beta m + e) - e)%Z).
set (p := Zpower (radix_val beta) k). set (p := Zpower beta k).
(* *) (* *)
assert (Hx': (F2R (Float beta m e) <= x < F2R (Float beta (m + 1) e))%R). assert (Hx': (F2R (Float beta m e) <= x < F2R (Float beta (m + 1) e))%R).
apply inbetween_bounds with (2 := H1). apply inbetween_bounds with (2 := H1).
......
...@@ -13,7 +13,7 @@ Definition round_FIX t := ...@@ -13,7 +13,7 @@ Definition round_FIX t :=
let '(m, e, l) := t in let '(m, e, l) := t in
let k := (emin - e)%Z in let k := (emin - e)%Z in
if Zlt_bool 0 k then if Zlt_bool 0 k then
let p := Zpower (radix_val beta) k in let p := Zpower beta k in
(Zdiv m p, (e + k)%Z, new_location p (Zmod m p) l) (Zdiv m p, (e + k)%Z, new_location p (Zmod m p) l)
else t. else t.
...@@ -28,7 +28,7 @@ Proof. ...@@ -28,7 +28,7 @@ Proof.
intros x m e l H1 H2. intros x m e l H1 H2.
unfold round_FIX. unfold round_FIX.
set (k := (emin - e)%Z). set (k := (emin - e)%Z).
set (p := Zpower (radix_val beta) k). set (p := Zpower beta k).
unfold canonic_exponent, FIX_exp. unfold canonic_exponent, FIX_exp.
generalize (Zlt_cases 0 k). generalize (Zlt_cases 0 k).
case (Zlt_bool 0 k) ; intros Hk. case (Zlt_bool 0 k) ; intros Hk.
......
...@@ -124,7 +124,7 @@ Definition Fsqrt_aux prec m e := ...@@ -124,7 +124,7 @@ Definition Fsqrt_aux prec m e :=
let (s', e'') := if Zeven e' then (s, e') else (s + 1, e' - 1)%Z in let (s', e'') := if Zeven e' then (s, e') else (s + 1, e' - 1)%Z in
let m' := let m' :=
match s' with match s' with
| Zpos p => (m * Zpower_pos (radix_val beta) p)%Z | Zpos p => (m * Zpower_pos beta p)%Z
| _ => m | _ => m
end in end in
let (q, r) := Zsqrt m' in let (q, r) := Zsqrt m' in
...@@ -172,7 +172,7 @@ destruct He as (He1, (He2, (He3, He4))). ...@@ -172,7 +172,7 @@ destruct He as (He1, (He2, (He3, He4))).
(* . shift *) (* . shift *)
set (m' := match s' with set (m' := match s' with
| Z0 => m | Z0 => m
| Zpos p => (m * Zpower_pos (radix_val beta) p)%Z | Zpos p => (m * Zpower_pos beta p)%Z
| Zneg _ => m | Zneg _ => m
end). end).
assert (Hs: F2R (Float beta m' e') = F2R (Float beta m e) /\ (2 * prec <= digits beta m')%Z /\ (0 < m')%Z). assert (Hs: F2R (Float beta m' e') = F2R (Float beta m e) /\ (2 * prec <= digits beta m')%Z /\ (0 < m')%Z).
...@@ -182,7 +182,7 @@ destruct s' as [|p|p]. ...@@ -182,7 +182,7 @@ destruct s' as [|p|p].
repeat split ; try easy. repeat split ; try easy.
fold d. fold d.
omega. omega.
fold (Zpower (radix_val beta) (Zpos p)). fold (Zpower beta (Zpos p)).
split. split.
replace (Zpos p) with (Zpos p + e' - e')%Z by ring. replace (Zpos p) with (Zpos p + e' - e')%Z by ring.
rewrite <- F2R_change_exp. rewrite <- F2R_change_exp.
......
...@@ -19,7 +19,7 @@ Variable Hp : Zlt 0 prec. ...@@ -19,7 +19,7 @@ Variable Hp : Zlt 0 prec.
(* floating-point format with gradual underflow *) (* floating-point format with gradual underflow *)
Definition FLT_format (x : R) := Definition FLT_format (x : R) :=
exists f : float beta, exists f : float beta,
x = F2R f /\ (Zabs (Fnum f) < Zpower (radix_val beta) prec)%Z /\ (emin <= Fexp f)%Z. x = F2R f /\ (Zabs (Fnum f) < Zpower beta prec)%Z /\ (emin <= Fexp f)%Z.
Definition FLT_RoundingModeP (rnd : R -> R):= Definition FLT_RoundingModeP (rnd : R -> R):=
Rounding_for_Format FLT_format rnd. Rounding_for_Format FLT_format rnd.
...@@ -256,7 +256,7 @@ generalize (Zmax_spec (emin + 1 - prec) emin). ...@@ -256,7 +256,7 @@ generalize (Zmax_spec (emin + 1 - prec) emin).
omega. omega.
Qed. Qed.
Hypothesis NE_prop : Zeven (radix_val beta) = false \/ (1 < prec)%Z. Hypothesis NE_prop : Zeven beta = false \/ (1 < prec)%Z.
Theorem NE_ex_prop_FLT : Theorem NE_ex_prop_FLT :
NE_ex_prop beta FLT_exp. NE_ex_prop beta FLT_exp.
......
...@@ -18,7 +18,7 @@ Variable Hp : Zlt 0 prec. ...@@ -18,7 +18,7 @@ Variable Hp : Zlt 0 prec.
(* unbounded floating-point format *) (* unbounded floating-point format *)
Definition FLX_format (x : R) := Definition FLX_format (x : R) :=
exists f : float beta, exists f : float beta,
x = F2R f /\ (Zabs (Fnum f) < Zpower (radix_val beta) prec)%Z. x = F2R f /\ (Zabs (Fnum f) < Zpower beta prec)%Z.
Definition FLX_RoundingModeP (rnd : R -> R):= Definition FLX_RoundingModeP (rnd : R -> R):=
Rounding_for_Format FLX_format rnd. Rounding_for_Format FLX_format rnd.
...@@ -106,7 +106,7 @@ apply iff_trans with (FIX_format beta (ex - prec) x). ...@@ -106,7 +106,7 @@ apply iff_trans with (FIX_format beta (ex - prec) x).
apply FLX_format_FIX. apply FLX_format_FIX.
exact (conj (proj1 Hx2) (Rlt_le _ _ (proj2 Hx2))). exact (conj (proj1 Hx2) (Rlt_le _ _ (proj2 Hx2))).
apply FIX_format_generic. apply FIX_format_generic.
assert (Hf: FLX_exp (projT1 (ln_beta beta x)) = FIX_exp (ex - prec) (projT1 (ln_beta beta x))). assert (Hf: FLX_exp (ln_beta beta x) = FIX_exp (ex - prec) (ln_beta beta x)).
unfold FIX_exp, FLX_exp. unfold FIX_exp, FLX_exp.
now rewrite ln_beta_unique with (1 := Hx2). now rewrite ln_beta_unique with (1 := Hx2).
split ; split ;
...@@ -128,7 +128,7 @@ Qed. ...@@ -128,7 +128,7 @@ Qed.
Definition FLXN_format (x : R) := Definition FLXN_format (x : R) :=
exists f : float beta, exists f : float beta,
x = F2R f /\ (x <> R0 -> x = F2R f /\ (x <> R0 ->
Zpower (radix_val beta) (prec - 1) <= Zabs (Fnum f) < Zpower (radix_val beta) prec)%Z. Zpower beta (prec - 1) <= Zabs (Fnum f) < Zpower beta prec)%Z.
Definition FLXN_RoundingModeP (rnd : R -> R):= Definition FLXN_RoundingModeP (rnd : R -> R):=
Rounding_for_Format FLXN_format rnd. Rounding_for_Format FLXN_format rnd.
...@@ -159,7 +159,7 @@ apply H4. ...@@ -159,7 +159,7 @@ apply H4.
rewrite <- Z2R_Zpower, <- abs_Z2R. rewrite <- Z2R_Zpower, <- abs_Z2R.
now apply Z2R_lt. now apply Z2R_lt.
now apply Zlt_le_weak. now apply Zlt_le_weak.
exists (Float beta (xm * Zpower (radix_val beta) (prec - d)) (xe + d - prec)). exists (Float beta (xm * Zpower beta (prec - d)) (xe + d - prec)).
split. split.
unfold F2R. simpl. unfold F2R. simpl.
rewrite mult_Z2R, Z2R_Zpower. rewrite mult_Z2R, Z2R_Zpower.
...@@ -228,7 +228,7 @@ unfold FLX_exp. ...@@ -228,7 +228,7 @@ unfold FLX_exp.
omega. omega.
Qed. Qed.
Hypothesis NE_prop : Zeven (radix_val beta) = false \/ (1 < prec)%Z. Hypothesis NE_prop : Zeven beta = false \/ (1 < prec)%Z.
Theorem NE_ex_prop_FLX : Theorem NE_ex_prop_FLX :
NE_ex_prop beta FLX_exp. NE_ex_prop beta FLX_exp.
......
...@@ -17,7 +17,7 @@ Variable Hp : Zlt 0 prec. ...@@ -17,7 +17,7 @@ Variable Hp : Zlt 0 prec.
(* floating-point format with abrupt underflow *) (* floating-point format with abrupt underflow *)
Definition FTZ_format (x : R) := Definition FTZ_format (x : R) :=
exists f : float beta, exists f : float beta,
x = F2R f /\ (x <> R0 -> Zpower (radix_val beta) (prec - 1) <= Zabs (Fnum f) < Zpower (radix_val beta) prec)%Z /\ x = F2R f /\ (x <> R0 -> Zpower beta (prec - 1) <= Zabs (Fnum f) < Zpower beta prec)%Z /\
(emin <= Fexp f)%Z. (emin <= Fexp f)%Z.
Definition FTZ_RoundingModeP (rnd : R -> R):= Definition FTZ_RoundingModeP (rnd : R -> R):=
......
...@@ -1269,7 +1269,7 @@ End Proof_Irrelevance. ...@@ -1269,7 +1269,7 @@ End Proof_Irrelevance.
Section pow. Section pow.
Record radix := { radix_val : Z ; radix_prop : Zle_bool 2 radix_val = true }. Record radix := { radix_val :> Z ; radix_prop : Zle_bool 2 radix_val = true }.
Theorem radix_val_inj : Theorem radix_val_inj :
forall r1 r2, radix_val r1 = radix_val r2 -> r1 = r2. forall r1 r2, radix_val r1 = radix_val r2 -> r1 = r2.
...@@ -1285,7 +1285,7 @@ Qed. ...@@ -1285,7 +1285,7 @@ Qed.
Variable r : radix. Variable r : radix.
Theorem radix_gt_1 : (1 < radix_val r)%Z. Theorem radix_gt_1 : (1 < r)%Z.
Proof. Proof.
destruct r as (v, Hr). simpl. destruct r as (v, Hr). simpl.
apply Zlt_le_trans with 2%Z. apply Zlt_le_trans with 2%Z.
...@@ -1293,7 +1293,7 @@ easy. ...@@ -1293,7 +1293,7 @@ easy.
now apply Zle_bool_imp_le. now apply Zle_bool_imp_le.
Qed. Qed.
Theorem radix_pos : (0 < Z2R (radix_val r))%R. Theorem radix_pos : (0 < Z2R r)%R.
Proof. Proof.
destruct r as (v, Hr). simpl. destruct r as (v, Hr). simpl.
apply (Z2R_lt 0). apply (Z2R_lt 0).
...@@ -1304,8 +1304,8 @@ Qed. ...@@ -1304,8 +1304,8 @@ Qed.
Definition bpow e := Definition bpow e :=
match e with match e with
| Zpos p => Z2R (Zpower_pos (radix_val r) p) | Zpos p => Z2R (Zpower_pos r p)
| Zneg p => Rinv (Z2R (Zpower_pos (radix_val r) p)) | Zneg p => Rinv (Z2R (Zpower_pos r p))
| Z0 => R1 | Z0 => R1
end. end.
...@@ -1327,7 +1327,7 @@ Qed. ...@@ -1327,7 +1327,7 @@ Qed.
Theorem bpow_powerRZ : Theorem bpow_powerRZ :
forall e, forall e,
bpow e = powerRZ (Z2R (radix_val r)) e. bpow e = powerRZ (Z2R r) e.
Proof. Proof.
destruct e ; unfold bpow. destruct e ; unfold bpow.
reflexivity. reflexivity.
...@@ -1364,14 +1364,14 @@ apply radix_pos. ...@@ -1364,14 +1364,14 @@ apply radix_pos.
Qed. Qed.
Theorem bpow_1 : Theorem bpow_1 :
bpow 1 = Z2R (radix_val r). bpow 1 = Z2R r.
Proof. Proof.
unfold bpow, Zpower_pos, iter_pos. unfold bpow, Zpower_pos, iter_pos.
now rewrite Zmult_1_r. now rewrite Zmult_1_r.
Qed. Qed.
Theorem bpow_add1 : Theorem bpow_add1 :
forall e : Z, (bpow (e+1) = Z2R (radix_val r) * bpow e)%R. forall e : Z, (bpow (e + 1) = Z2R r * bpow e)%R.
Proof. Proof.
intros. intros.
rewrite <- bpow_1. rewrite <- bpow_1.
...@@ -1393,7 +1393,7 @@ Qed. ...@@ -1393,7 +1393,7 @@ Qed.
Theorem Z2R_Zpower_nat : Theorem Z2R_Zpower_nat :
forall e : nat, forall e : nat,
Z2R (Zpower_nat (radix_val r) e) = bpow (Z_of_nat e). Z2R (Zpower_nat r e) = bpow (Z_of_nat e).
Proof. Proof.
intros [|e]. intros [|e].
split. split.
...@@ -1405,7 +1405,7 @@ Qed. ...@@ -1405,7 +1405,7 @@ Qed.
Theorem Z2R_Zpower : Theorem Z2R_Zpower :
forall e : Z, forall e : Z,
(0 <= e)%Z -> (0 <= e)%Z ->
Z2R (Zpower (radix_val r) e) = bpow e. Z2R (Zpower r e) = bpow e.
Proof. Proof.
intros [|e|e] H. intros [|e|e] H.
split. split.
...@@ -1435,7 +1435,7 @@ elim (lt_irrefl 0). ...@@ -1435,7 +1435,7 @@ elim (lt_irrefl 0).
pattern O at 2 ; rewrite <- H. pattern O at 2 ; rewrite <- H.
apply lt_O_nat_of_P. apply lt_O_nat_of_P.
intros n _. intros n _.
assert (1 < Zpower_nat (radix_val r) 1)%Z. assert (1 < Zpower_nat r 1)%Z.
unfold Zpower_nat, iter_nat. unfold Zpower_nat, iter_nat.
rewrite Zmult_1_r. rewrite Zmult_1_r.
apply radix_gt_1. apply radix_gt_1.
...@@ -1502,10 +1502,10 @@ Qed. ...@@ -1502,10 +1502,10 @@ Qed.
Theorem bpow_exp : Theorem bpow_exp :
forall e : Z, forall e : Z,
bpow e = exp (Z2R e * ln (Z2R (radix_val r))). bpow e = exp (Z2R e * ln (Z2R r)).
Proof. Proof.
(* positive case *) (* positive case *)
assert (forall e, bpow (Zpos e) = exp (Z2R (Zpos e) * ln (Z2R (radix_val r)))). assert (forall e, bpow (Zpos e) = exp (Z2R (Zpos e) * ln (Z2R r))).
intros e. intros e.
unfold bpow. unfold bpow.
rewrite Zpower_pos_nat. rewrite Zpower_pos_nat.
...@@ -1534,19 +1534,23 @@ rewrite Rmult_0_l. ...@@ -1534,19 +1534,23 @@ rewrite Rmult_0_l.
now rewrite exp_0. now rewrite exp_0.
apply H. apply H.
unfold bpow. unfold bpow.
change (Z2R (Zpower_pos (radix_val r) e)) with (bpow (Zpos e)). change (Z2R (Zpower_pos r e)) with (bpow (Zpos e)).
rewrite H. rewrite H.
rewrite <- exp_Ropp. rewrite <- exp_Ropp.
rewrite <- Ropp_mult_distr_l_reverse. rewrite <- Ropp_mult_distr_l_reverse.
now rewrite <- opp_Z2R. now rewrite <- opp_Z2R.
Qed. Qed.
Theorem ln_beta : Record ln_beta_prop x := {
forall x : R, ln_beta_val :> Z ;
{e | (x <> 0)%R -> (bpow (e - 1)%Z <= Rabs x < bpow e)%R}. _ : (x <> 0)%R -> (bpow (ln_beta_val - 1)%Z <= Rabs x < bpow ln_beta_val)%R
}.
Definition ln_beta :
forall x : R, ln_beta_prop x.
Proof. Proof.
intros x. intros x.
set (fact := ln (Z2R (radix_val r))). set (fact := ln (Z2R r)).
(* . *) (* . *)
assert (0 < fact)%R. assert (0 < fact)%R.
apply exp_lt_inv. apply exp_lt_inv.
...@@ -1614,7 +1618,7 @@ Qed. ...@@ -1614,7 +1618,7 @@ Qed.
Theorem ln_beta_unique : Theorem ln_beta_unique :
forall (x : R) (e : Z), forall (x : R) (e : Z),
(bpow (e - 1) <= Rabs x < bpow e)%R -> (bpow (e - 1) <= Rabs x < bpow e)%R ->
projT1 (ln_beta x) = e. ln_beta x = e :> Z.
Proof. Proof.
intros x e1 He. intros x e1 He.
destruct (Req_dec x 0) as [Hx|Hx]. destruct (Req_dec x 0) as [Hx|Hx].
...@@ -1629,7 +1633,7 @@ Qed. ...@@ -1629,7 +1633,7 @@ Qed.
Theorem ln_beta_opp : Theorem ln_beta_opp :
forall x, forall x,
projT1 (ln_beta (-x)) = projT1 (ln_beta x). ln_beta (-x) = ln_beta x :> Z.
Proof. Proof.
intros x. intros x.
destruct (Req_dec x 0) as [Hx|Hx]. destruct (Req_dec x 0) as [Hx|Hx].
...@@ -1643,20 +1647,19 @@ Qed. ...@@ -1643,20 +1647,19 @@ Qed.