Commit f63e1f7b by Guillaume Melquiond

### Used Z -> bool for choice function of rounding to nearest.

parent 4a3af0f6
 ... @@ -152,7 +152,7 @@ Admitted. ... @@ -152,7 +152,7 @@ Admitted. Variable choice : R -> bool. Variable choice : Z -> bool. Variable a1 x1 y1 a x y:R. Variable a1 x1 y1 a x y:R. ... ...
 ... @@ -1113,12 +1113,12 @@ End not_FTZ. ... @@ -1113,12 +1113,12 @@ End not_FTZ. Section Znearest. Section Znearest. (** Roundings to nearest: when in the middle, use the choice function *) (** Roundings to nearest: when in the middle, use the choice function *) Variable choice : R -> bool. Variable choice : Z -> bool. Definition Znearest x := Definition Znearest x := match Rcompare (x - Z2R (Zfloor x)) (/2) with match Rcompare (x - Z2R (Zfloor x)) (/2) with | Lt => Zfloor x | Lt => Zfloor x | Eq => if choice x then Zceil x else Zfloor x | Eq => if choice (Zfloor x) then Zceil x else Zfloor x | Gt => Zceil x | Gt => Zceil x end. end. ... @@ -1144,7 +1144,7 @@ intros x. ... @@ -1144,7 +1144,7 @@ intros x. unfold Znearest. unfold Znearest. case Rcompare_spec ; intros _. case Rcompare_spec ; intros _. now left. now left. case (choice x). case choice. now right. now right. now left. now left. now right. now right. ... @@ -1218,7 +1218,7 @@ rewrite 2!(Rplus_comm (- (Z2R (Zfloor x)))). ... @@ -1218,7 +1218,7 @@ rewrite 2!(Rplus_comm (- (Z2R (Zfloor x)))). change (x - Z2R (Zfloor x) = y - Z2R (Zfloor x))%R. change (x - Z2R (Zfloor x) = y - Z2R (Zfloor x))%R. now rewrite Hy. now rewrite Hy. apply Zle_trans with (Zceil x). apply Zle_trans with (Zceil x). case (choice x). case choice. apply Zle_refl. apply Zle_refl. apply le_Z2R. apply le_Z2R. apply Rle_trans with x. apply Rle_trans with x. ... @@ -1408,7 +1408,7 @@ apply Rle_0_minus. ... @@ -1408,7 +1408,7 @@ apply Rle_0_minus. apply Zfloor_lb. apply Zfloor_lb. case Rcompare_spec ; intros Hm'. case Rcompare_spec ; intros Hm'. now rewrite Rabs_minus_sym. now rewrite Rabs_minus_sym. case (choice mx). case choice. rewrite <- Hm'. rewrite <- Hm'. exact H. exact H. now rewrite Rabs_minus_sym. now rewrite Rabs_minus_sym. ... @@ -1430,7 +1430,7 @@ Qed. ... @@ -1430,7 +1430,7 @@ Qed. Theorem round_N_middle : Theorem round_N_middle : forall x, forall x, (x - round rndDN x = round rndUP x - x)%R -> (x - round rndDN x = round rndUP x - x)%R -> round rndN x = if choice (scaled_mantissa x) then round rndUP x else round rndDN x. round rndN x = if choice (Zfloor (scaled_mantissa x)) then round rndUP x else round rndDN x. Proof. Proof. intros x. intros x. pattern x at 1 4 ; rewrite <- scaled_mantissa_bpow. pattern x at 1 4 ; rewrite <- scaled_mantissa_bpow. ... @@ -1441,12 +1441,12 @@ intros _. ... @@ -1441,12 +1441,12 @@ intros _. rewrite <- Fx. rewrite <- Fx. rewrite Zceil_Z2R, Zfloor_Z2R. rewrite Zceil_Z2R, Zfloor_Z2R. set (m := Zfloor (scaled_mantissa x)). set (m := Zfloor (scaled_mantissa x)). now case (Rcompare (Z2R m - Z2R m) (/ 2)) ; case (choice (Z2R m)). now case (Rcompare (Z2R m - Z2R m) (/ 2)) ; case (choice m). (* *) (* *) intros H. intros H. rewrite Rcompare_floor_ceil_mid with (1 := Fx). rewrite Rcompare_floor_ceil_mid with (1 := Fx). rewrite Rcompare_Eq. rewrite Rcompare_Eq. now case (choice (scaled_mantissa x)). now case choice. apply Rmult_eq_reg_r with (bpow (canonic_exponent x)). apply Rmult_eq_reg_r with (bpow (canonic_exponent x)). now rewrite 2!Rmult_minus_distr_r. now rewrite 2!Rmult_minus_distr_r. apply Rgt_not_eq. apply Rgt_not_eq. ... @@ -1457,14 +1457,14 @@ End Znearest. ... @@ -1457,14 +1457,14 @@ End Znearest. Section rndNA. Section rndNA. Definition rndNA := rndN (Rle_bool 0). Definition rndNA := rndN (Zle_bool 0). Theorem generic_NA_pt : Theorem generic_NA_pt : forall x, forall x, Rnd_NA_pt generic_format x (round rndNA x). Rnd_NA_pt generic_format x (round rndNA x). Proof. Proof. intros x. intros x. generalize (generic_N_pt (Rle_bool 0) x). generalize (generic_N_pt (Zle_bool 0) x). fold rndNA. fold rndNA. set (f := round rndNA x). set (f := round rndNA x). intros Rxf. intros Rxf. ... @@ -1479,8 +1479,9 @@ rewrite Rabs_pos_eq with (1 := Hx). ... @@ -1479,8 +1479,9 @@ rewrite Rabs_pos_eq with (1 := Hx). rewrite Rabs_pos_eq. rewrite Rabs_pos_eq. unfold f, rndNA. unfold f, rndNA. rewrite round_N_middle with (1 := Hm). rewrite round_N_middle with (1 := Hm). rewrite Rle_bool_true. rewrite Zle_bool_true. apply (generic_UP_pt x). apply (generic_UP_pt x). apply Zfloor_lub. apply Rmult_le_pos with (1 := Hx). apply Rmult_le_pos with (1 := Hx). apply bpow_ge_0. apply bpow_ge_0. apply Rnd_N_pt_pos with (2 := Hx) (3 := Rxf). apply Rnd_N_pt_pos with (2 := Hx) (3 := Rxf). ... @@ -1491,8 +1492,12 @@ rewrite Rabs_left1. ... @@ -1491,8 +1492,12 @@ rewrite Rabs_left1. apply Ropp_le_contravar. apply Ropp_le_contravar. unfold f, rndNA. unfold f, rndNA. rewrite round_N_middle with (1 := Hm). rewrite round_N_middle with (1 := Hm). rewrite Rle_bool_false. rewrite Zle_bool_false. apply (generic_DN_pt x). apply (generic_DN_pt x). apply lt_Z2R. apply Rle_lt_trans with (scaled_mantissa x). apply Zfloor_lb. simpl. rewrite <- (Rmult_0_l (bpow (- canonic_exponent x))). rewrite <- (Rmult_0_l (bpow (- canonic_exponent x))). apply Rmult_lt_compat_r with (2 := Hx). apply Rmult_lt_compat_r with (2 := Hx). apply bpow_gt_0. apply bpow_gt_0. ... @@ -1515,7 +1520,7 @@ Section rndN_opp. ... @@ -1515,7 +1520,7 @@ Section rndN_opp. Theorem Znearest_opp : Theorem Znearest_opp : forall choice x, forall choice x, Znearest choice (- x) = (- Znearest (fun t => negb (choice (-t)%R)) x)%Z. Znearest choice (- x) = (- Znearest (fun t => negb (choice (- (t + 1))%Z)) x)%Z. Proof. Proof. intros choice x. intros choice x. destruct (Req_dec (Z2R (Zfloor x)) x) as [Hx|Hx]. destruct (Req_dec (Z2R (Zfloor x)) x) as [Hx|Hx]. ... @@ -1527,13 +1532,13 @@ replace (- x - Z2R (Zfloor (-x)))%R with (Z2R (Zceil x) - x)%R. ... @@ -1527,13 +1532,13 @@ replace (- x - Z2R (Zfloor (-x)))%R with (Z2R (Zceil x) - x)%R. rewrite Rcompare_ceil_floor_mid with (1 := Hx). rewrite Rcompare_ceil_floor_mid with (1 := Hx). rewrite Rcompare_floor_ceil_mid with (1 := Hx). rewrite Rcompare_floor_ceil_mid with (1 := Hx). rewrite Rcompare_sym. rewrite Rcompare_sym. rewrite <- Zceil_floor_neq with (1 := Hx). unfold Zceil. unfold Zceil. rewrite Ropp_involutive. rewrite Ropp_involutive. case Rcompare_spec ; simpl ; trivial. case Rcompare ; simpl ; trivial. intros H. rewrite Zopp_involutive. case (choice (-x)%R); simpl; trivial. case (choice (Zfloor (- x))) ; simpl ; trivial. now rewrite Zopp_involutive. now rewrite Zopp_involutive. intros _. now rewrite Zopp_involutive. now rewrite Zopp_involutive. unfold Zceil. unfold Zceil. rewrite Z2R_opp. rewrite Z2R_opp. ... @@ -1543,7 +1548,7 @@ Qed. ... @@ -1543,7 +1548,7 @@ Qed. Theorem round_N_opp : Theorem round_N_opp : forall choice, forall choice, forall x, forall x, round (rndN choice) (-x) = (- round (rndN (fun t => negb (choice (-t)%R))) x)%R. round (rndN choice) (-x) = (- round (rndN (fun t => negb (choice (- (t + 1))%Z))) x)%R. Proof. Proof. intros choice x. intros choice x. unfold round, F2R. simpl. unfold round, F2R. simpl. ... ...
 ... @@ -332,7 +332,7 @@ apply Rnd_NE_pt_total. ... @@ -332,7 +332,7 @@ apply Rnd_NE_pt_total. apply Rnd_NE_pt_monotone. apply Rnd_NE_pt_monotone. Qed. Qed. Definition rndNE := rndN (fun x => negb (Zeven (Zfloor x))). Definition rndNE := rndN (fun x => negb (Zeven x)). Theorem generic_NE_pt_pos : Theorem generic_NE_pt_pos : forall x, forall x, ... @@ -483,24 +483,20 @@ Theorem round_NE_opp : ... @@ -483,24 +483,20 @@ Theorem round_NE_opp : forall x, forall x, round beta fexp rndNE (-x) = (- round beta fexp rndNE x)%R. round beta fexp rndNE (-x) = (- round beta fexp rndNE x)%R. Proof. Proof. intros x; unfold rndNE. intros x. rewrite round_N_opp. unfold rndNE, round. simpl. unfold round. rewrite scaled_mantissa_opp, canonic_exponent_opp. apply f_equal; apply f_equal; apply f_equal2; trivial. rewrite Znearest_opp. unfold Zrnd; simpl. rewrite opp_F2R. generalize ((scaled_mantissa beta fexp x)); clear x; intros x. apply (f_equal (fun v => F2R (Float beta (-v) _))). unfold Znearest; case Rcompare_spec ; simpl ; trivial. set (m := scaled_mantissa beta fexp x). intros. unfold Znearest. replace (negb (Zeven (Zfloor (- x)))) with (Zeven (Zfloor x)); trivial. case Rcompare ; trivial. rewrite <- (Zopp_involutive (Zfloor (- x))). apply (f_equal (fun (b : bool) => if b then Zceil m else Zfloor m)). fold (Zceil x). rewrite Bool.negb_involutive. rewrite Zeven_opp. rewrite Zeven_opp. rewrite Zceil_floor_neq. rewrite Zeven_plus. rewrite Zeven_plus. now case (Zeven (Zfloor x)). now rewrite eqb_sym. intros H1; contradict H. rewrite H1; ring_simplify (x-x)%R. apply sym_not_eq; apply Rinv_neq_0_compat; replace 2%R with (INR 2); auto with real. Qed. Qed. Theorem generic_NE_pt : Theorem generic_NE_pt : ... ...
 ... @@ -33,7 +33,7 @@ Variable Hp : Zlt 0 prec. ... @@ -33,7 +33,7 @@ Variable Hp : Zlt 0 prec. Notation format := (generic_format beta (FLX_exp prec)). Notation format := (generic_format beta (FLX_exp prec)). Notation cexp := (canonic_exponent beta (FLX_exp prec)). Notation cexp := (canonic_exponent beta (FLX_exp prec)). Variable choice : R -> bool. Variable choice : Z -> bool. Theorem format_add: forall x y (fx fy: float beta), Theorem format_add: forall x y (fx fy: float beta), (x = F2R fx)%R -> (y = F2R fy)%R -> (Rabs (x+y) < bpow (prec+Fexp fx))%R -> (Rabs (x+y) < bpow (prec+Fexp fy))%R (x = F2R fx)%R -> (y = F2R fy)%R -> (Rabs (x+y) < bpow (prec+Fexp fx))%R -> (Rabs (x+y) < bpow (prec+Fexp fy))%R ... ...
 ... @@ -67,7 +67,7 @@ Qed. ... @@ -67,7 +67,7 @@ Qed. Hypothesis monotone_exp : forall ex ey, (ex <= ey)%Z -> (fexp ex <= fexp ey)%Z. Hypothesis monotone_exp : forall ex ey, (ex <= ey)%Z -> (fexp ex <= fexp ey)%Z. Notation format := (generic_format beta fexp). Notation format := (generic_format beta fexp). Variable choice : R -> bool. Variable choice : Z -> bool. Lemma plus_error_aux : Lemma plus_error_aux : forall x y, forall x y, ... ...
 ... @@ -217,7 +217,7 @@ rewrite F2R_0, <- abs_F2R. ... @@ -217,7 +217,7 @@ rewrite F2R_0, <- abs_F2R. now apply Rabs_pos_lt. now apply Rabs_pos_lt. Qed. Qed. Variable choice : R -> bool. Variable choice : Z -> bool. Theorem generic_relative_error_N : Theorem generic_relative_error_N : forall x, forall x, ... @@ -443,7 +443,7 @@ apply bpow_gt_0. ... @@ -443,7 +443,7 @@ apply bpow_gt_0. now apply relative_error_FLT. now apply relative_error_FLT. Qed. Qed. Variable choice : R -> bool. Variable choice : Z -> bool. Theorem relative_error_N_FLT : Theorem relative_error_N_FLT : forall x, forall x, ... @@ -642,7 +642,7 @@ exact Hp. ... @@ -642,7 +642,7 @@ exact Hp. apply He. apply He. Qed. Qed. Variable choice : R -> bool. Variable choice : Z -> bool. Theorem relative_error_N_FLX : Theorem relative_error_N_FLX : forall x, forall x, ... ...
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!