-
Notifications
You must be signed in to change notification settings - Fork 1
/
lecture4_solution.v
149 lines (122 loc) · 5.84 KB
/
lecture4_solution.v
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
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
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
(******************************************************************************)
(* *)
(* LECTURE : Floating-point numbers and formal proof *)
(* Laurent.Thery@inria.fr 12/04/2013 *)
(* *)
(******************************************************************************)
(* Solutions of lecture 4 *)
Require Import Psatz ZArith Reals SpecFloat.
From Flocq Require Import FTZ Core Operations BinarySingleNaN Binary Bits.
Open Scope R_scope.
Section Solution4.
Variable r : radix.
Variable phi : Z -> Z.
Hypothesis vPhi : Valid_exp phi.
Variable rnd : R -> Z.
Hypothesis vRound : Valid_rnd rnd.
Variable choice : Z -> bool.
(*
Prove that if phi is monotone so is ulp
*)
Fact ex1 x y :
x <> 0 -> Monotone_exp phi ->
Rabs x <= Rabs y -> ulp r phi x <= ulp r phi y.
Proof.
intros NZx Mphi Rxy.
assert (NZy : y <> 0) by (split_Rabs; lra).
rewrite !ulp_neq_0; auto.
apply bpow_le.
apply Mphi.
apply mag_le_abs; assumption.
Qed.
(*
Hints:
Check mag_le_abs.
Check bpow_le.
*)
(*
Reprove round_UP_DN_ulp
*)
Fact ext2 x :
~ generic_format r phi x ->
round r phi Zceil x = round r phi Zfloor x + ulp r phi x.
Proof.
intros H.
assert (NZx : x <> 0).
contradict H; rewrite H; apply generic_format_0.
rewrite ulp_neq_0; auto.
unfold round, F2R; simpl.
rewrite Zceil_floor_neq; rewrite ?plus_IZR; simpl; try ring.
contradict H.
unfold generic_format, F2R; simpl.
rewrite <- H, Ztrunc_IZR, H.
rewrite scaled_mantissa_mult_bpow; auto.
Qed.
(*
Hints:
Check scaled_mantissa_mult_bpow.
Check Zceil_floor_neq.
Check Ztrunc_IZR.
*)
(*
Reprove error_lt_ulp
*)
Fact ext3 x : x <> 0 -> Rabs (round r phi rnd x - x) < ulp r phi x.
Proof.
intro NZx.
assert (H : generic_format r phi x \/ ~ generic_format r phi x).
unfold generic_format, F2R; simpl.
set (y := _ * _); case (Req_dec x y); auto.
destruct H.
set (y := _ - _); replace y with 0.
rewrite Rabs_R0, ulp_neq_0; auto; apply bpow_gt_0.
unfold y; rewrite round_generic; auto; ring.
assert (H1 := round_DN_UP_lt _ _ _ H).
assert (H2 := round_UP_DN_ulp _ _ _ H).
destruct (round_DN_or_UP r phi rnd x).
split_Rabs; lra.
split_Rabs; lra.
Qed.
(*
Hints :
Check round_DN_UP_lt.
Check round_DN_or_UP.
Check round_UP_DN_ulp.
*)
(*
Reprove error_le_half_ulp
*)
Fact ext4 x :
Rabs (round r phi (Znearest choice) x - x) <=
/ 2 * ulp r phi x.
Proof.
assert (H : generic_format r phi x \/ ~ generic_format r phi x).
unfold generic_format, F2R; simpl.
set (y := _ * _); case (Req_dec x y); auto.
destruct H.
set (y := _ - _); replace y with 0.
rewrite Rabs_R0.
apply Rmult_le_pos; try lra; apply ulp_ge_0.
unfold y; rewrite round_generic; auto; try ring.
apply valid_rnd_N.
destruct (round_N_pt r phi choice x) as (Hr1, Hr2).
assert (H1 := generic_format_round r phi Zfloor x).
assert (H2 := generic_format_round r phi Zceil x).
assert (H3 := Hr2 _ H1).
assert (H4 := Hr2 _ H2).
assert (H5 := round_UP_DN_ulp _ _ _ H).
assert (H6 := round_DN_UP_lt _ _ _ H).
destruct (round_DN_or_UP r phi (Znearest choice) x).
revert H3 H4.
split_Rabs; try lra.
split_Rabs; try lra.
Qed.
(*
Hints:
Check round_N_pt.
Check generic_format_round.
Check round_DN_UP_lt.
Check round_DN_or_UP.
Check round_UP_DN_ulp.
*)
End Solution4.