Fprop_relative.v 15.3 KB
 Guillaume Melquiond committed Jun 08, 2010 1 2 3 4 5 6 7 8 9 10 11 12 ``````Require Import Fcore. Section Fprop_relative. Variable beta : radix. Notation bpow e := (bpow beta e). Section Fprop_relative_generic. Variable fexp : Z -> Z. Hypothesis prop_exp : valid_exp fexp. `````` Guillaume Melquiond committed Aug 27, 2010 13 ``````Theorem generic_relative_error_lt_conversion : `````` Guillaume Melquiond committed Aug 27, 2010 14 `````` forall rnd x b, (0 < b)%R -> `````` Guillaume Melquiond committed Aug 27, 2010 15 16 17 18 `````` (Rabs (rounding beta fexp rnd x - x) < b * Rabs x)%R -> exists eps, (Rabs eps < b)%R /\ rounding beta fexp rnd x = (x * (1 + eps))%R. Proof. `````` Guillaume Melquiond committed Aug 27, 2010 19 ``````intros rnd x b Hb0 Hxb. `````` Guillaume Melquiond committed Aug 27, 2010 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 ``````destruct (Req_dec x 0) as [Hx0|Hx0]. (* *) exists R0. split. now rewrite Rabs_R0. rewrite Hx0, Rmult_0_l. apply rounding_0. (* *) exists ((rounding beta fexp rnd x - x) / x)%R. split. 2: now field. unfold Rdiv. rewrite Rabs_mult. apply Rmult_lt_reg_r with (Rabs x). now apply Rabs_pos_lt. rewrite Rmult_assoc, <- Rabs_mult. rewrite Rinv_l with (1 := Hx0). now rewrite Rabs_R1, Rmult_1_r. Qed. `````` Guillaume Melquiond committed Aug 27, 2010 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 ``````Theorem generic_relative_error_le_conversion : forall rnd x b, (0 <= b)%R -> (Rabs (rounding beta fexp rnd x - x) <= b * Rabs x)%R -> exists eps, (Rabs eps <= b)%R /\ rounding beta fexp rnd x = (x * (1 + eps))%R. Proof. intros rnd x b Hb0 Hxb. destruct (Req_dec x 0) as [Hx0|Hx0]. (* *) exists R0. split. now rewrite Rabs_R0. rewrite Hx0, Rmult_0_l. apply rounding_0. (* *) exists ((rounding beta fexp rnd x - x) / x)%R. split. 2: now field. unfold Rdiv. rewrite Rabs_mult. apply Rmult_le_reg_r with (Rabs x). now apply Rabs_pos_lt. rewrite Rmult_assoc, <- Rabs_mult. rewrite Rinv_l with (1 := Hx0). now rewrite Rabs_R1, Rmult_1_r. Qed. Variable rnd : Zrounding. `````` Guillaume Melquiond committed Aug 27, 2010 67 68 69 ``````Variable emin p : Z. Hypothesis Hmin : forall k, (emin < k)%Z -> (p <= k - fexp k)%Z. `````` Guillaume Melquiond committed Jun 08, 2010 70 71 72 ``````Theorem generic_relative_error : forall x, (bpow emin <= Rabs x)%R -> `````` Guillaume Melquiond committed Jun 08, 2010 73 74 `````` (Rabs (rounding beta fexp rnd x - x) < bpow (-p + 1) * Rabs x)%R. Proof. `````` Guillaume Melquiond committed Aug 27, 2010 75 ``````intros x Hx. `````` Guillaume Melquiond committed Jun 08, 2010 76 77 78 ``````apply Rlt_le_trans with (ulp beta fexp x)%R. now apply ulp_error. unfold ulp, canonic_exponent. `````` Guillaume Melquiond committed Jun 08, 2010 79 80 81 82 83 ``````assert (Hx': (x <> 0)%R). intros H. apply Rlt_not_le with (2 := Hx). rewrite H, Rabs_R0. apply bpow_gt_0. `````` Guillaume Melquiond committed Jun 08, 2010 84 85 ``````destruct (ln_beta beta x) as (ex, He). simpl. `````` Guillaume Melquiond committed Jun 08, 2010 86 ``````specialize (He Hx'). `````` Guillaume Melquiond committed Jun 08, 2010 87 88 89 90 91 92 ``````apply Rle_trans with (bpow (-p + 1) * bpow (ex - 1))%R. rewrite <- bpow_add. apply -> bpow_le. assert (emin < ex)%Z. apply <- bpow_lt. apply Rle_lt_trans with (2 := proj2 He). `````` Guillaume Melquiond committed Jun 08, 2010 93 94 95 96 97 98 99 100 ``````exact Hx. generalize (Hmin ex). omega. apply Rmult_le_compat_l. apply bpow_ge_0. apply He. Qed. `````` Guillaume Melquiond committed Aug 27, 2010 101 102 103 104 105 106 107 108 109 110 111 112 ``````Theorem generic_relative_error_ex : forall x, (bpow emin <= Rabs x)%R -> exists eps, (Rabs eps < bpow (-p + 1))%R /\ rounding beta fexp rnd x = (x * (1 + eps))%R. Proof. intros x Hx. apply generic_relative_error_lt_conversion. apply bpow_gt_0. now apply generic_relative_error. Qed. `````` Guillaume Melquiond committed Jun 08, 2010 113 114 115 116 117 ``````Theorem generic_relative_error_F2R : forall m, let x := F2R (Float beta m emin) in (x <> 0)%R -> (Rabs (rounding beta fexp rnd x - x) < bpow (-p + 1) * Rabs x)%R. Proof. `````` Guillaume Melquiond committed Aug 27, 2010 118 119 ``````intros m x Hx. apply generic_relative_error. `````` Guillaume Melquiond committed Jun 08, 2010 120 121 122 123 124 125 ``````unfold x. rewrite abs_F2R. apply bpow_le_F2R. apply F2R_lt_reg with beta emin. rewrite F2R_0, <- abs_F2R. now apply Rabs_pos_lt. `````` Guillaume Melquiond committed Jun 08, 2010 126 127 ``````Qed. `````` Guillaume Melquiond committed Aug 27, 2010 128 129 130 131 132 133 134 135 136 137 138 139 ``````Theorem generic_relative_error_F2R_ex : forall m, let x := F2R (Float beta m emin) in (x <> 0)%R -> exists eps, (Rabs eps < bpow (-p + 1))%R /\ rounding beta fexp rnd x = (x * (1 + eps))%R. Proof. intros m x Hx. apply generic_relative_error_lt_conversion. apply bpow_gt_0. now apply generic_relative_error_F2R. Qed. `````` Guillaume Melquiond committed Jun 08, 2010 140 ``````Theorem generic_relative_error_2 : `````` Guillaume Melquiond committed Aug 27, 2010 141 `````` (0 < p)%Z -> `````` Guillaume Melquiond committed Jun 08, 2010 142 143 144 145 `````` forall x, (bpow emin <= Rabs x)%R -> (Rabs (rounding beta fexp rnd x - x) < bpow (-p + 1) * Rabs (rounding beta fexp rnd x))%R. Proof. `````` Guillaume Melquiond committed Aug 27, 2010 146 ``````intros Hp x Hx. `````` Guillaume Melquiond committed Jun 08, 2010 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 ``````apply Rlt_le_trans with (ulp beta fexp x)%R. now apply ulp_error. assert (Hx': (x <> 0)%R). intros H. apply Rlt_not_le with (2 := Hx). rewrite H, Rabs_R0. apply bpow_gt_0. unfold ulp, canonic_exponent. destruct (ln_beta beta x) as (ex, He). simpl. specialize (He Hx'). assert (He': (emin < ex)%Z). apply <- bpow_lt. apply Rle_lt_trans with (2 := proj2 He). exact Hx. apply Rle_trans with (bpow (-p + 1) * bpow (ex - 1))%R. rewrite <- bpow_add. apply -> bpow_le. `````` Guillaume Melquiond committed Jun 08, 2010 165 166 167 168 ``````generalize (Hmin ex). omega. apply Rmult_le_compat_l. apply bpow_ge_0. `````` Guillaume Melquiond committed Jun 08, 2010 169 170 171 172 173 174 175 176 177 178 179 180 181 182 ``````generalize He. apply rounding_abs_abs. exact prop_exp. clear rnd x Hx Hx' He. intros rnd x Hx. rewrite <- (rounding_generic beta fexp rnd (bpow (ex - 1))). now apply rounding_monotone. apply generic_format_bpow. ring_simplify (ex - 1 + 1)%Z. generalize (Hmin ex). omega. Qed. Theorem generic_relative_error_F2R_2 : `````` Guillaume Melquiond committed Aug 27, 2010 183 `````` (0 < p)%Z -> `````` Guillaume Melquiond committed Jun 08, 2010 184 185 186 187 `````` forall m, let x := F2R (Float beta m emin) in (x <> 0)%R -> (Rabs (rounding beta fexp rnd x - x) < bpow (-p + 1) * Rabs (rounding beta fexp rnd x))%R. Proof. `````` Guillaume Melquiond committed Aug 27, 2010 188 189 190 ``````intros Hp m x Hx. apply generic_relative_error_2. exact Hp. `````` Guillaume Melquiond committed Jun 08, 2010 191 192 193 194 195 196 ``````unfold x. rewrite abs_F2R. apply bpow_le_F2R. apply F2R_lt_reg with beta emin. rewrite F2R_0, <- abs_F2R. now apply Rabs_pos_lt. `````` Guillaume Melquiond committed Jun 08, 2010 197 198 199 200 ``````Qed. Variable choice : R -> bool. `````` Guillaume Melquiond committed Jun 08, 2010 201 202 203 204 205 ``````Theorem generic_relative_error_N : forall x, (bpow emin <= Rabs x)%R -> (Rabs (rounding beta fexp (ZrndN choice) x - x) <= /2 * bpow (-p + 1) * Rabs x)%R. Proof. `````` Guillaume Melquiond committed Aug 27, 2010 206 ``````intros x Hx. `````` Guillaume Melquiond committed Jun 08, 2010 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 ``````apply Rle_trans with (/2 * ulp beta fexp x)%R. now apply ulp_half_error. rewrite Rmult_assoc. apply Rmult_le_compat_l. apply Rlt_le. apply Rinv_0_lt_compat. now apply (Z2R_lt 0 2). assert (Hx': (x <> 0)%R). intros H. apply Rlt_not_le with (2 := Hx). rewrite H, Rabs_R0. apply bpow_gt_0. unfold ulp, canonic_exponent. destruct (ln_beta beta x) as (ex, He). simpl. specialize (He Hx'). apply Rle_trans with (bpow (-p + 1) * bpow (ex - 1))%R. rewrite <- bpow_add. apply -> bpow_le. assert (emin < ex)%Z. apply <- bpow_lt. apply Rle_lt_trans with (2 := proj2 He). exact Hx. generalize (Hmin ex). omega. apply Rmult_le_compat_l. apply bpow_ge_0. apply He. Qed. `````` Guillaume Melquiond committed Aug 27, 2010 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 ``````Theorem generic_relative_error_N_ex : forall x, (bpow emin <= Rabs x)%R -> exists eps, (Rabs eps <= /2 * bpow (-p + 1))%R /\ rounding beta fexp (ZrndN choice) x = (x * (1 + eps))%R. Proof. intros x Hx. apply generic_relative_error_le_conversion. apply Rlt_le. apply Rmult_lt_0_compat. apply Rinv_0_lt_compat. now apply (Z2R_lt 0 2). apply bpow_gt_0. now apply generic_relative_error_N. Qed. `````` Guillaume Melquiond committed Jun 08, 2010 253 ``````Theorem generic_relative_error_N_F2R : `````` Guillaume Melquiond committed Jun 08, 2010 254 255 256 `````` forall m, let x := F2R (Float beta m emin) in (Rabs (rounding beta fexp (ZrndN choice) x - x) <= /2 * bpow (-p + 1) * Rabs x)%R. Proof. `````` Guillaume Melquiond committed Aug 27, 2010 257 ``````intros m x. `````` Guillaume Melquiond committed Jun 08, 2010 258 259 260 261 262 263 264 265 ``````destruct (Req_dec x 0) as [Hx|Hx]. (* . *) rewrite Hx, rounding_0. unfold Rminus. rewrite Rplus_0_l, Rabs_Ropp, Rabs_R0. rewrite Rmult_0_r. apply Rle_refl. (* . *) `````` Guillaume Melquiond committed Aug 27, 2010 266 ``````apply generic_relative_error_N. `````` Guillaume Melquiond committed Jun 08, 2010 267 268 269 270 271 272 273 274 ``````unfold x. rewrite abs_F2R. apply bpow_le_F2R. apply F2R_lt_reg with beta emin. rewrite F2R_0, <- abs_F2R. now apply Rabs_pos_lt. Qed. `````` Guillaume Melquiond committed Aug 27, 2010 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 ``````Theorem generic_relative_error_N_F2R_ex : forall m, let x := F2R (Float beta m emin) in exists eps, (Rabs eps <= /2 * bpow (-p + 1))%R /\ rounding beta fexp (ZrndN choice) x = (x * (1 + eps))%R. Proof. intros m x. apply generic_relative_error_le_conversion. apply Rlt_le. apply Rmult_lt_0_compat. apply Rinv_0_lt_compat. now apply (Z2R_lt 0 2). apply bpow_gt_0. now apply generic_relative_error_N_F2R. Qed. `````` Guillaume Melquiond committed Jun 08, 2010 290 ``````Theorem generic_relative_error_N_2 : `````` Guillaume Melquiond committed Aug 27, 2010 291 `````` (0 < p)%Z -> `````` Guillaume Melquiond committed Jun 08, 2010 292 293 294 295 `````` forall x, (bpow emin <= Rabs x)%R -> (Rabs (rounding beta fexp (ZrndN choice) x - x) <= /2 * bpow (-p + 1) * Rabs (rounding beta fexp (ZrndN choice) x))%R. Proof. `````` Guillaume Melquiond committed Aug 27, 2010 296 ``````intros Hp x Hx. `````` Guillaume Melquiond committed Jun 08, 2010 297 298 299 300 301 302 303 ``````apply Rle_trans with (/2 * ulp beta fexp x)%R. now apply ulp_half_error. rewrite Rmult_assoc. apply Rmult_le_compat_l. apply Rlt_le. apply Rinv_0_lt_compat. now apply (Z2R_lt 0 2). `````` Guillaume Melquiond committed Jun 08, 2010 304 305 306 307 308 309 310 311 312 313 314 315 316 ``````assert (Hx': (x <> 0)%R). intros H. apply Rlt_not_le with (2 := Hx). rewrite H, Rabs_R0. apply bpow_gt_0. unfold ulp, canonic_exponent. destruct (ln_beta beta x) as (ex, He). simpl. specialize (He Hx'). assert (He': (emin < ex)%Z). apply <- bpow_lt. apply Rle_lt_trans with (2 := proj2 He). exact Hx. `````` Guillaume Melquiond committed Jun 08, 2010 317 318 319 ``````apply Rle_trans with (bpow (-p + 1) * bpow (ex - 1))%R. rewrite <- bpow_add. apply -> bpow_le. `````` Guillaume Melquiond committed Jun 08, 2010 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 ``````generalize (Hmin ex). omega. apply Rmult_le_compat_l. apply bpow_ge_0. generalize He. apply rounding_abs_abs. exact prop_exp. clear rnd x Hx Hx' He. intros rnd x Hx. rewrite <- (rounding_generic beta fexp rnd (bpow (ex - 1))). now apply rounding_monotone. apply generic_format_bpow. ring_simplify (ex - 1 + 1)%Z. generalize (Hmin ex). omega. Qed. Theorem generic_relative_error_N_F2R_2 : `````` Guillaume Melquiond committed Aug 27, 2010 338 `````` (0 < p)%Z -> `````` Guillaume Melquiond committed Jun 08, 2010 339 340 341 `````` forall m, let x := F2R (Float beta m emin) in (Rabs (rounding beta fexp (ZrndN choice) x - x) <= /2 * bpow (-p + 1) * Rabs (rounding beta fexp (ZrndN choice) x))%R. Proof. `````` Guillaume Melquiond committed Aug 27, 2010 342 ``````intros Hp m x. `````` Guillaume Melquiond committed Jun 08, 2010 343 344 345 346 347 348 349 350 ``````destruct (Req_dec x 0) as [Hx|Hx]. (* . *) rewrite Hx, rounding_0. unfold Rminus. rewrite Rplus_0_l, Rabs_Ropp, Rabs_R0. rewrite Rmult_0_r. apply Rle_refl. (* . *) `````` Guillaume Melquiond committed Aug 27, 2010 351 ``````apply generic_relative_error_N_2 with (1 := Hp). `````` Guillaume Melquiond committed Jun 08, 2010 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 ``````unfold x. rewrite abs_F2R. apply bpow_le_F2R. apply F2R_lt_reg with beta emin. rewrite F2R_0, <- abs_F2R. now apply Rabs_pos_lt. Qed. End Fprop_relative_generic. Section Fprop_relative_FLT. Variable emin prec : Z. Variable Hp : Zlt 0 prec. Variable rnd : Zrounding. `````` Guillaume Melquiond committed Jun 08, 2010 369 ``````Theorem relative_error_FLT_F2R : `````` Guillaume Melquiond committed Jun 08, 2010 370 371 372 373 374 `````` forall m, let x := F2R (Float beta m (emin + prec - 1)) in (x <> 0)%R -> (Rabs (rounding beta (FLT_exp emin prec) rnd x - x) < bpow (-prec + 1) * Rabs x)%R. Proof. intros m x Hx. `````` Guillaume Melquiond committed Jun 08, 2010 375 ``````apply generic_relative_error_F2R. `````` Guillaume Melquiond committed Jun 08, 2010 376 377 378 379 380 381 382 383 ``````now apply FLT_exp_correct. intros k Hk. unfold FLT_exp. generalize (Zmax_spec (k - prec) emin). omega. exact Hx. Qed. `````` Guillaume Melquiond committed Jun 08, 2010 384 ``````Theorem relative_error_FLT : `````` Guillaume Melquiond committed Jun 08, 2010 385 386 387 388 389 `````` forall x, (bpow (emin + prec - 1) <= Rabs x)%R -> (Rabs (rounding beta (FLT_exp emin prec) rnd x - x) < bpow (-prec + 1) * Rabs x)%R. Proof. intros x Hx. `````` Guillaume Melquiond committed Jun 08, 2010 390 ``````apply generic_relative_error with (emin + prec - 1)%Z. `````` Guillaume Melquiond committed Jun 08, 2010 391 ``````now apply FLT_exp_correct. `````` Guillaume Melquiond committed Jun 08, 2010 392 ``````intros k Hk. `````` Guillaume Melquiond committed Jun 08, 2010 393 ``````unfold FLT_exp. `````` Guillaume Melquiond committed Jun 08, 2010 394 ``````generalize (Zmax_spec (k - prec) emin). `````` Guillaume Melquiond committed Jun 08, 2010 395 ``````omega. `````` Guillaume Melquiond committed Jun 08, 2010 396 ``````exact Hx. `````` Guillaume Melquiond committed Jun 08, 2010 397 398 ``````Qed. `````` Guillaume Melquiond committed Aug 27, 2010 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 ``````Theorem relative_error_FLT_F2R_ex : forall m, let x := F2R (Float beta m (emin + prec - 1)) in (x <> 0)%R -> exists eps, (Rabs eps < bpow (-prec + 1))%R /\ rounding beta (FLT_exp emin prec) rnd x = (x * (1 + eps))%R. Proof. intros m x Hx. apply generic_relative_error_lt_conversion. apply bpow_gt_0. now apply relative_error_FLT_F2R. Qed. Theorem relative_error_FLT_ex : forall x, (bpow (emin + prec - 1) <= Rabs x)%R -> exists eps, (Rabs eps < bpow (-prec + 1))%R /\ rounding beta (FLT_exp emin prec) rnd x = (x * (1 + eps))%R. Proof. intros x Hx. apply generic_relative_error_lt_conversion. apply bpow_gt_0. now apply relative_error_FLT. Qed. `````` Guillaume Melquiond committed Jun 08, 2010 423 424 ``````Variable choice : R -> bool. `````` Guillaume Melquiond committed Jun 08, 2010 425 426 427 ``````Theorem relative_error_N_FLT : forall x, (bpow (emin + prec - 1) <= Rabs x)%R -> `````` Guillaume Melquiond committed Jun 08, 2010 428 429 `````` (Rabs (rounding beta (FLT_exp emin prec) (ZrndN choice) x - x) <= /2 * bpow (-prec + 1) * Rabs x)%R. Proof. `````` Guillaume Melquiond committed Jun 08, 2010 430 431 ``````intros x Hx. apply generic_relative_error_N with (emin + prec - 1)%Z. `````` Guillaume Melquiond committed Jun 08, 2010 432 433 434 435 436 ``````now apply FLT_exp_correct. intros k Hk. unfold FLT_exp. generalize (Zmax_spec (k - prec) emin). omega. `````` Guillaume Melquiond committed Jun 08, 2010 437 ``````exact Hx. `````` Guillaume Melquiond committed Jun 08, 2010 438 439 ``````Qed. `````` Guillaume Melquiond committed Aug 27, 2010 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 ``````Theorem relative_error_N_FLT_ex : forall x, (bpow (emin + prec - 1) <= Rabs x)%R -> exists eps, (Rabs eps <= /2 * bpow (-prec + 1))%R /\ rounding beta (FLT_exp emin prec) (ZrndN choice) x = (x * (1 + eps))%R. Proof. intros x Hx. apply generic_relative_error_le_conversion. apply Rlt_le. apply Rmult_lt_0_compat. apply Rinv_0_lt_compat. now apply (Z2R_lt 0 2). apply bpow_gt_0. now apply relative_error_N_FLT. Qed. `````` Guillaume Melquiond committed Jun 08, 2010 456 ``````Theorem relative_error_N_FLT_2 : `````` Guillaume Melquiond committed Jun 08, 2010 457 458 `````` forall x, (bpow (emin + prec - 1) <= Rabs x)%R -> `````` Guillaume Melquiond committed Jun 08, 2010 459 `````` (Rabs (rounding beta (FLT_exp emin prec) (ZrndN choice) x - x) <= /2 * bpow (-prec + 1) * Rabs (rounding beta (FLT_exp emin prec) (ZrndN choice) x))%R. `````` Guillaume Melquiond committed Jun 08, 2010 460 461 ``````Proof. intros x Hx. `````` Guillaume Melquiond committed Jun 08, 2010 462 ``````apply generic_relative_error_N_2 with (emin + prec - 1)%Z. `````` Guillaume Melquiond committed Jun 08, 2010 463 ``````now apply FLT_exp_correct. `````` Guillaume Melquiond committed Jun 08, 2010 464 ``````intros k Hk. `````` Guillaume Melquiond committed Jun 08, 2010 465 ``````unfold FLT_exp. `````` Guillaume Melquiond committed Jun 08, 2010 466 467 ``````generalize (Zmax_spec (k - prec) emin). omega. `````` Guillaume Melquiond committed Aug 27, 2010 468 ``````exact Hp. `````` Guillaume Melquiond committed Jun 08, 2010 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 ``````exact Hx. Qed. Theorem relative_error_N_FLT_F2R : forall m, let x := F2R (Float beta m (emin + prec - 1)) in (Rabs (rounding beta (FLT_exp emin prec) (ZrndN choice) x - x) <= /2 * bpow (-prec + 1) * Rabs x)%R. Proof. intros m x. apply generic_relative_error_N_F2R. now apply FLT_exp_correct. intros k Hk. unfold FLT_exp. generalize (Zmax_spec (k - prec) emin). omega. Qed. `````` Guillaume Melquiond committed Aug 27, 2010 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 ``````Theorem relative_error_N_FLT_F2R_ex : forall m, let x := F2R (Float beta m (emin + prec - 1)) in exists eps, (Rabs eps <= /2 * bpow (-prec + 1))%R /\ rounding beta (FLT_exp emin prec) (ZrndN choice) x = (x * (1 + eps))%R. Proof. intros m x. apply generic_relative_error_le_conversion. apply Rlt_le. apply Rmult_lt_0_compat. apply Rinv_0_lt_compat. now apply (Z2R_lt 0 2). apply bpow_gt_0. now apply relative_error_N_FLT_F2R. Qed. `````` Guillaume Melquiond committed Jun 08, 2010 500 501 502 503 504 505 506 507 508 509 ``````Theorem relative_error_N_FLT_F2R_2 : forall m, let x := F2R (Float beta m (emin + prec - 1)) in (Rabs (rounding beta (FLT_exp emin prec) (ZrndN choice) x - x) <= /2 * bpow (-prec + 1) * Rabs (rounding beta (FLT_exp emin prec) (ZrndN choice) x))%R. Proof. intros m x. apply generic_relative_error_N_F2R_2. now apply FLT_exp_correct. intros k Hk. unfold FLT_exp. generalize (Zmax_spec (k - prec) emin). `````` Guillaume Melquiond committed Jun 08, 2010 510 ``````omega. `````` Guillaume Melquiond committed Aug 27, 2010 511 ``````exact Hp. `````` Guillaume Melquiond committed Jun 08, 2010 512 513 ``````Qed. `````` BOLDO Sylvie committed Sep 03, 2010 514 515 516 517 518 519 520 521 522 523 524 `````` Theorem error_N_FLT : forall x, exists eps, exists eta, (Rabs eps <= /2 * bpow (-prec + 1))%R /\ (Rabs eta <= /2 * bpow (emin))%R /\ (eps*eta=0)%R /\ rounding beta (FLT_exp emin prec) (ZrndN choice) x = (x * (1 + eps) + eta)%R. Proof. Admitted. (* SB *) `````` Guillaume Melquiond committed Jun 08, 2010 525 526 527 528 529 530 531 532 533 ``````End Fprop_relative_FLT. Section Fprop_relative_FLX. Variable prec : Z. Variable Hp : Zlt 0 prec. Variable rnd : Zrounding. `````` Guillaume Melquiond committed Jun 08, 2010 534 ``````Theorem relative_error_FLX : `````` Guillaume Melquiond committed Jun 08, 2010 535 536 537 538 539 `````` forall x, (x <> 0)%R -> (Rabs (rounding beta (FLX_exp prec) rnd x - x) < bpow (-prec + 1) * Rabs x)%R. Proof. intros x Hx. `````` Guillaume Melquiond committed Jun 08, 2010 540 541 542 ``````destruct (ln_beta beta x) as (ex, He). specialize (He Hx). apply generic_relative_error with (ex - 1)%Z. `````` Guillaume Melquiond committed Jun 08, 2010 543 ``````now apply FLX_exp_correct. `````` Guillaume Melquiond committed Jun 08, 2010 544 545 546 547 548 549 ``````intros k _. unfold FLX_exp. omega. apply He. Qed. `````` Guillaume Melquiond committed Aug 27, 2010 550 551 552 553 554 555 556 557 558 559 560 561 ``````Theorem relative_error_FLX_ex : forall x, (x <> 0)%R -> exists eps, (Rabs eps < bpow (-prec + 1))%R /\ rounding beta (FLX_exp prec) rnd x = (x * (1 + eps))%R. Proof. intros x Hx. apply generic_relative_error_lt_conversion. apply bpow_gt_0. now apply relative_error_FLX. Qed. `````` Guillaume Melquiond committed Jun 08, 2010 562 563 564 565 566 567 ``````Theorem relative_error_FLX_2 : forall x, (x <> 0)%R -> (Rabs (rounding beta (FLX_exp prec) rnd x - x) < bpow (-prec + 1) * Rabs (rounding beta (FLX_exp prec) rnd x))%R. Proof. intros x Hx. `````` Guillaume Melquiond committed Jun 08, 2010 568 569 ``````destruct (ln_beta beta x) as (ex, He). specialize (He Hx). `````` Guillaume Melquiond committed Jun 08, 2010 570 571 572 ``````apply generic_relative_error_2 with (ex - 1)%Z. now apply FLX_exp_correct. intros k _. `````` Guillaume Melquiond committed Jun 08, 2010 573 574 ``````unfold FLX_exp. omega. `````` Guillaume Melquiond committed Aug 27, 2010 575 ``````exact Hp. `````` Guillaume Melquiond committed Jun 08, 2010 576 577 578 579 580 ``````apply He. Qed. Variable choice : R -> bool. `````` Guillaume Melquiond committed Jun 08, 2010 581 ``````Theorem relative_error_N_FLX : `````` Guillaume Melquiond committed Jun 08, 2010 582 583 584 585 586 587 588 589 590 591 592 593 `````` forall x, (Rabs (rounding beta (FLX_exp prec) (ZrndN choice) x - x) <= /2 * bpow (-prec + 1) * Rabs x)%R. Proof. intros x. destruct (Req_dec x 0) as [Hx|Hx]. (* . *) rewrite Hx, rounding_0. unfold Rminus. rewrite Rplus_0_l, Rabs_Ropp, Rabs_R0. rewrite Rmult_0_r. apply Rle_refl. (* . *) `````` Guillaume Melquiond committed Jun 08, 2010 594 595 596 ``````destruct (ln_beta beta x) as (ex, He). specialize (He Hx). apply generic_relative_error_N with (ex - 1)%Z. `````` Guillaume Melquiond committed Jun 08, 2010 597 ``````now apply FLX_exp_correct. `````` Guillaume Melquiond committed Jun 08, 2010 598 599 600 601 602 603 ``````intros k _. unfold FLX_exp. omega. apply He. Qed. `````` Guillaume Melquiond committed Aug 27, 2010 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 ``````Theorem relative_error_N_FLX_ex : forall x, exists eps, (Rabs eps <= /2 * bpow (-prec + 1))%R /\ rounding beta (FLX_exp prec) (ZrndN choice) x = (x * (1 + eps))%R. Proof. intros x. apply generic_relative_error_le_conversion. apply Rlt_le. apply Rmult_lt_0_compat. apply Rinv_0_lt_compat. now apply (Z2R_lt 0 2). apply bpow_gt_0. now apply relative_error_N_FLX. Qed. `````` Guillaume Melquiond committed Jun 08, 2010 619 620 621 622 623 624 625 626 627 628 629 630 631 ``````Theorem relative_error_N_FLX_2 : forall x, (Rabs (rounding beta (FLX_exp prec) (ZrndN choice) x - x) <= /2 * bpow (-prec + 1) * Rabs (rounding beta (FLX_exp prec) (ZrndN choice) x))%R. Proof. intros x. destruct (Req_dec x 0) as [Hx|Hx]. (* . *) rewrite Hx, rounding_0. unfold Rminus. rewrite Rplus_0_l, Rabs_Ropp, Rabs_R0. rewrite Rmult_0_r. apply Rle_refl. (* . *) `````` Guillaume Melquiond committed Jun 08, 2010 632 633 ``````destruct (ln_beta beta x) as (ex, He). specialize (He Hx). `````` Guillaume Melquiond committed Jun 08, 2010 634 635 636 ``````apply generic_relative_error_N_2 with (ex - 1)%Z. now apply FLX_exp_correct. intros k _. `````` Guillaume Melquiond committed Jun 08, 2010 637 638 ``````unfold FLX_exp. omega. `````` Guillaume Melquiond committed Aug 27, 2010 639 ``````exact Hp. `````` Guillaume Melquiond committed Jun 08, 2010 640 641 642 643 644 645 ``````apply He. Qed. End Fprop_relative_FLX. End Fprop_relative.``````