Commit 6f68b82d by Guillaume Melquiond

### Added some new lemmas. Unsuccesfully tried to convert some lemmas from Pff.

parent 12ff1621
 ... ... @@ -333,6 +333,18 @@ apply Zfloor_lb. now apply Zfloor_lub. Qed. Theorem Zfloor_Z : forall n, Zfloor (Z2R n) = n. Proof. intros n. apply Zfloor_imp. split. apply Rle_refl. apply Z2R_lt. apply Zlt_succ. Qed. Definition Zceil (x : R) := (- Zfloor (- x))%Z. Theorem Zceil_ub : ... ... @@ -380,6 +392,16 @@ rewrite opp_Z2R. now apply Ropp_lt_contravar. Qed. Theorem Zceil_Z : forall n, Zceil (Z2R n) = n. Proof. intros n. unfold Zceil. rewrite <- opp_Z2R, Zfloor_Z. apply Zopp_involutive. Qed. Theorem Zceil_floor_neq : forall x : R, (Z2R (Zfloor x) <> x)%R -> ... ... @@ -599,15 +621,14 @@ Qed. Theorem bpow_eq : forall e1 e2 : Z, e1 = e2 -> bpow e1 = bpow e2. bpow e1 = bpow e2 -> e1 = e2. Proof. intros. apply Rle_antisym. apply -> bpow_le. now apply Zeq_le. apply -> bpow_le. apply Zeq_le. now apply sym_eq. apply Zle_antisym. apply <- bpow_le. now apply Req_le. apply <- bpow_le. now apply Req_le. Qed. Theorem bpow_exp : ... ...
 ... ... @@ -699,6 +699,69 @@ rewrite Zopp_involutive. now apply generic_DN_pt_pos. Qed. Theorem generic_DN_pt : forall x, Rnd_DN_pt generic_format x (F2R (Float beta (Zfloor (x * bpow (Zopp (fexp (projT1 (ln_beta beta x)))))) (fexp (projT1 (ln_beta beta x))))). Proof. intros x. destruct (Req_dec x 0) as [Hx|Hx]. (* x = 0 *) rewrite Hx, Rmult_0_l. fold (Z2R 0). rewrite Zfloor_Z, F2R_0. apply Rnd_DN_pt_refl. apply generic_format_0. (* x <> 0 *) destruct (ln_beta beta x) as (ex, Hex). simpl. specialize (Hex Hx). unfold Rabs in Hex. destruct (Rcase_abs x) as [Hx'|Hx']. now apply generic_DN_pt_neg. now apply generic_DN_pt_pos. Qed. Theorem generic_UP_pt : forall x, Rnd_UP_pt generic_format x (F2R (Float beta (Zceil (x * bpow (Zopp (fexp (projT1 (ln_beta beta x)))))) (fexp (projT1 (ln_beta beta x))))). Proof. intros x. destruct (Req_dec x 0) as [Hx|Hx]. (* x = 0 *) rewrite Hx, Rmult_0_l. fold (Z2R 0). rewrite Zceil_Z, F2R_0. apply Rnd_UP_pt_refl. apply generic_format_0. (* x <> 0 *) destruct (ln_beta beta x) as (ex, Hex). simpl. specialize (Hex Hx). unfold Rabs in Hex. destruct (Rcase_abs x) as [Hx'|Hx']. now apply generic_UP_pt_neg. now apply generic_UP_pt_pos. Qed. Theorem generic_format_EM : forall x, generic_format x \/ ~generic_format x. Proof. intros x. destruct (proj1 (satisfies_any_imp_DN _ generic_format_satisfies_any) x) as (d, Hd). destruct (Rle_lt_or_eq_dec d x) as [Hxd|Hxd]. apply Hd. right. intros Fx. apply Rlt_not_le with (1 := Hxd). apply Req_le. apply sym_eq. now apply Rnd_DN_pt_idempotent with (1 := Hd). left. rewrite <- Hxd. apply Hd. Qed. End RND_generic. Theorem canonic_fun_eq : ... ...
 ... ... @@ -214,7 +214,6 @@ rewrite ln_beta_unique with beta xu ex. rewrite ln_beta_unique with (1 := Hd4). rewrite ln_beta_unique with (1 := Hexa). simpl. rewrite <- Rmult_plus_distr_r. intros H. replace (Fnum cu) with (Fnum cd + 1)%Z. replace (Fnum cd + (Fnum cd + 1))%Z with (2 * Fnum cd + 1)%Z by ring. ... ... @@ -223,7 +222,9 @@ now apply Zeven_mult_Zeven_l. apply sym_eq. apply eq_Z2R. rewrite plus_Z2R. apply Rmult_eq_reg_r with (1 := H). apply Rmult_eq_reg_r with (bpow (fexp ex)). rewrite H. simpl. ring. apply Rgt_not_eq. apply bpow_gt_0. rewrite Rabs_pos_eq. ... ...
 ... ... @@ -14,7 +14,7 @@ Variable fexp : Z -> Z. Variable prop_exp : valid_exp fexp. Definition ulp x := F2R (Float beta 1 (fexp (projT1 (ln_beta beta x)))). Definition ulp x := bpow (fexp (projT1 (ln_beta beta x))). Definition F := generic_format beta fexp. ... ... @@ -37,11 +37,9 @@ assert (Hu2 := generic_UP_pt_pos _ _ prop_exp _ _ Hx2). rewrite (Rnd_DN_pt_unicity _ _ _ _ Hd1 Hd2). rewrite (Rnd_UP_pt_unicity _ _ _ _ Hu1 Hu2). unfold F2R. simpl. rewrite <- Rmult_plus_distr_r. change R1 with (Z2R 1). rewrite <- plus_Z2R. apply (f_equal (fun v => (Z2R v * bpow (fexp ex))%R)). apply Zceil_floor_neq. rewrite Zceil_floor_neq. rewrite plus_Z2R, Rmult_plus_distr_r. now rewrite Rmult_1_l. intros Hx4. assert (Hx5 : x = F2R (Float beta (Zfloor (x * bpow (- fexp ex))) (fexp ex))). unfold F2R. simpl. ... ... @@ -56,9 +54,7 @@ apply Hd2. (* positive small *) rewrite Rnd_UP_pt_unicity with F x xu (bpow (fexp ex)). rewrite Rnd_DN_pt_unicity with F x xd R0. rewrite Rplus_0_l. unfold F2R. simpl. now rewrite Rmult_1_l. now rewrite Rplus_0_l. exact Hd1. now apply generic_DN_pt_small_pos with ex. exact Hu1. ... ... @@ -154,8 +150,6 @@ rewrite (proj2 (proj2 Hrnd)). unfold Rminus. rewrite Rplus_opp_r. rewrite Rabs_R0. unfold ulp, F2R. simpl. rewrite Rmult_1_l. apply bpow_gt_0. apply Hd. Qed. ... ... @@ -222,7 +216,7 @@ apply Rmult_le_pos. apply Rlt_le. apply Rinv_0_lt_compat. now apply (Z2R_lt 0 2). now apply F2R_ge_0_compat. apply bpow_ge_0. apply Hd. Qed. ... ... @@ -233,8 +227,6 @@ Theorem ulp_monotone : (ulp x <= ulp y)%R. Proof. intros Hm x y Hx Hxy. unfold ulp. rewrite 2!F2R_bpow. apply -> bpow_le. apply Hm. now apply ln_beta_monotone. ... ... @@ -245,7 +237,7 @@ Theorem ulp_bpow : intros e. unfold ulp. rewrite (ln_beta_unique beta (bpow e) (e + 1)). apply F2R_bpow. easy. rewrite Rabs_pos_eq. split. apply -> bpow_le. ... ... @@ -255,4 +247,38 @@ apply Zlt_succ. apply bpow_ge_0. Qed. Theorem ulp_DN_pt_eq : forall x d : R, (0 < d)%R -> Rnd_DN_pt F x d -> ulp d = ulp x. Proof. intros x d Hd Hxd. unfold ulp. apply (f_equal (fun e => bpow (fexp e))). apply ln_beta_unique. rewrite (Rabs_pos_eq d). destruct (ln_beta beta x) as (ex, He). simpl. assert (Hx: (0 < x)%R). apply Rlt_le_trans with (1 := Hd). apply Hxd. specialize (He (Rgt_not_eq _ _ Hx)). rewrite Rabs_pos_eq in He. 2: now apply Rlt_le. split. assert (Rnd_DN_pt F (bpow (ex - 1)) (bpow (ex - 1))). apply Rnd_DN_pt_refl. apply generic_format_bpow. destruct (Zle_or_lt ex (fexp ex)). elim Rgt_not_eq with (1 := Hd). apply Rnd_DN_pt_unicity with (1 := Hxd). now apply generic_DN_pt_small_pos with (2 := He). ring_simplify (ex - 1 + 1)%Z. omega. apply (Rnd_DN_pt_monotone _ _ _ _ _ H Hxd (proj1 He)). apply Rle_lt_trans with (2 := proj2 He). apply Hxd. now apply Rlt_le. Qed. End Fcore_ulp.
 ... ... @@ -10,7 +10,9 @@ FILES = \ Core/Fcore_generic_fmt.v \ Core/Fcore_rnd_ne.v \ Core/Fcore_ulp.v \ Calc/Fcalc_ops.v Core/Fcore.v \ Calc/Fcalc_ops.v \ Prop/Fprop_nearest.v data_DATA = \$(FILES:=o) EXTRA_DIST = \$(FILES) ... ...