-
Notifications
You must be signed in to change notification settings - Fork 0
/
RealAux.v
236 lines (200 loc) · 7.19 KB
/
RealAux.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
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
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
Require Export Reals.
Require Import Psatz.
(******************************************)
(** Relevant lemmas from Rcomplements.v. **)
(******************************************)
Open Scope R_scope.
Lemma Rle_minus_l : forall a b c,(a - c <= b <-> a <= b + c). Proof. intros. lra. Qed.
Lemma Rlt_minus_r : forall a b c,(a < b - c <-> a + c < b). Proof. intros. lra. Qed.
Lemma Rlt_minus_l : forall a b c,(a - c < b <-> a < b + c). Proof. intros. lra. Qed.
Lemma Rle_minus_r : forall a b c,(a <= b - c <-> a + c <= b). Proof. intros. lra. Qed.
Lemma Rminus_le_0 : forall a b, a <= b <-> 0 <= b - a. Proof. intros. lra. Qed.
Lemma Rminus_lt_0 : forall a b, a < b <-> 0 < b - a. Proof. intros. lra. Qed.
(* Automation *)
Lemma Rminus_unfold : forall r1 r2, (r1 - r2 = r1 + -r2). Proof. reflexivity. Qed.
Lemma Rdiv_unfold : forall r1 r2, (r1 / r2 = r1 */ r2). Proof. reflexivity. Qed.
Hint Rewrite Rminus_unfold Rdiv_unfold Ropp_0 Ropp_involutive Rplus_0_l Rplus_0_r
Rmult_0_l Rmult_0_r Rmult_1_l Rmult_1_r : R_db.
Hint Rewrite <- Ropp_mult_distr_l Ropp_mult_distr_r : R_db.
Hint Rewrite Rinv_l Rinv_r sqrt_sqrt using lra : R_db.
Notation "√ n" := (sqrt n) (at level 20) : R_scope.
(* Useful Lemmas *)
Lemma Rmult_div_assoc : forall (x y z : R), x * (y / z) = x * y / z.
Proof. intros. unfold Rdiv. rewrite Rmult_assoc. reflexivity. Qed.
Lemma Rmult_div : forall r1 r2 r3 r4 : R, r2 <> 0 -> r4 <> 0 ->
r1 / r2 * (r3 / r4) = r1 * r3 / (r2 * r4).
Proof. intros. unfold Rdiv. rewrite Rinv_mult_distr; trivial. lra. Qed.
Lemma Rdiv_cancel : forall r r1 r2 : R, r1 = r2 -> r / r1 = r / r2.
Proof. intros. rewrite H. reflexivity. Qed.
Lemma Rsum_nonzero : forall r1 r2 : R, r1 <> 0 \/ r2 <> 0 -> r1 * r1 + r2 * r2 <> 0.
Proof.
intros.
replace (r1 * r1)%R with (r1 ^ 2)%R by lra.
replace (r2 * r2)%R with (r2 ^ 2)%R by lra.
specialize (pow2_ge_0 (r1)). intros GZ1.
specialize (pow2_ge_0 (r2)). intros GZ2.
destruct H.
- specialize (pow_nonzero r1 2 H). intros NZ. lra.
- specialize (pow_nonzero r2 2 H). intros NZ. lra.
Qed.
Lemma Rpow_le1: forall (x : R) (n : nat), 0 <= x <= 1 -> x ^ n <= 1.
Proof.
intros; induction n.
- simpl; lra.
- simpl.
rewrite <- Rmult_1_r.
apply Rmult_le_compat; try lra.
apply pow_le; lra.
Qed.
(* The other side of Rle_pow, needed below *)
Lemma Rle_pow_le1: forall (x : R) (m n : nat), 0 <= x <= 1 -> (m <= n)%nat -> x ^ n <= x ^ m.
Proof.
intros x m n [G0 L1] L.
remember (n - m)%nat as p.
replace n with (m+p)%nat in * by lia.
clear -G0 L1.
rewrite pow_add.
rewrite <- Rmult_1_r.
apply Rmult_le_compat; try lra.
apply pow_le; trivial.
apply pow_le; trivial.
apply Rpow_le1; lra.
Qed.
(****************)
(* Square Roots *)
(****************)
Lemma pow2_sqrt : forall x:R, 0 <= x -> (√ x) ^ 2 = x.
Proof. intros; simpl; rewrite Rmult_1_r, sqrt_def; auto. Qed.
Lemma sqrt_pow : forall (r : R) (n : nat), (0 <= r)%R -> (√ (r ^ n) = √ r ^ n)%R.
Proof.
intros r n Hr.
induction n.
simpl. apply sqrt_1.
rewrite <- 2 tech_pow_Rmult.
rewrite sqrt_mult_alt by assumption.
rewrite IHn. reflexivity.
Qed.
Lemma pow2_sqrt2 : (√ 2) ^ 2 = 2.
Proof. apply pow2_sqrt; lra. Qed.
Lemma pown_sqrt : forall (x : R) (n : nat),
0 <= x -> √ x ^ (S (S n)) = x * √ x ^ n.
Proof.
intros. simpl. rewrite <- Rmult_assoc. rewrite sqrt_sqrt; auto.
Qed.
Lemma sqrt_neq_0_compat : forall r : R, 0 < r -> √ r <> 0.
Proof. intros. specialize (sqrt_lt_R0 r). lra. Qed.
Lemma sqrt_inv : forall (r : R), 0 < r -> √ (/ r) = (/ √ r)%R.
Proof.
intros.
replace (/r)%R with (1/r)%R by lra.
rewrite sqrt_div_alt, sqrt_1 by lra.
lra.
Qed.
Lemma sqrt2_div2 : (√ 2 / 2)%R = (1 / √ 2)%R.
Proof.
field_simplify_eq; try (apply sqrt_neq_0_compat; lra).
rewrite pow2_sqrt2; easy.
Qed.
Lemma sqrt2_inv : √ (/ 2) = (/ √ 2)%R.
Proof. apply sqrt_inv; lra. Qed.
Lemma sqrt_sqrt_inv : forall (r : R), 0 < r -> (√ r * √ / r)%R = 1.
Proof.
intros.
rewrite sqrt_inv; trivial.
rewrite Rinv_r; trivial.
apply sqrt_neq_0_compat; easy.
Qed.
Lemma sqrt2_sqrt2_inv : (√ 2 * √ / 2)%R = 1.
Proof. apply sqrt_sqrt_inv. lra. Qed.
Lemma sqrt2_inv_sqrt2 : ((√ / 2) * √ 2)%R = 1.
Proof. rewrite Rmult_comm. apply sqrt2_sqrt2_inv. Qed.
Lemma sqrt2_inv_sqrt2_inv : ((√ / 2) * (√ / 2) = /2)%R.
Proof.
rewrite sqrt2_inv. field_simplify.
rewrite pow2_sqrt2. easy.
apply sqrt_neq_0_compat; lra.
Qed.
(* Automation *)
Ltac R_field_simplify := repeat field_simplify_eq [pow2_sqrt2 sqrt2_inv].
Ltac R_field := R_field_simplify; easy.
(* Trigonometry *)
Lemma sin_upper_bound_aux : forall x : R, 0 < x < 1 -> sin x <= x.
Proof.
intros x H.
specialize (SIN_bound x) as B.
destruct (SIN x) as [_ B2]; try lra.
specialize PI2_1 as PI1. lra.
unfold sin_ub, sin_approx in *.
simpl in B2.
unfold sin_term at 1 in B2.
simpl in B2.
unfold Rdiv in B2.
rewrite Rinv_1, Rmult_1_l, !Rmult_1_r in B2.
(* Now just need to show that the other terms are negative... *)
assert (sin_term x 1 + sin_term x 2 + sin_term x 3 + sin_term x 4 <= 0); try lra.
unfold sin_term.
remember (INR (fact (2 * 1 + 1))) as d1.
remember (INR (fact (2 * 2 + 1))) as d2.
remember (INR (fact (2 * 3 + 1))) as d3.
remember (INR (fact (2 * 4 + 1))) as d4.
assert (0 < d1) as L0.
{ subst. apply lt_0_INR. apply lt_O_fact. }
assert (d1 <= d2) as L1.
{ subst. apply le_INR. apply fact_le. simpl; lia. }
assert (d2 <= d3) as L2.
{ subst. apply le_INR. apply fact_le. simpl; lia. }
assert (d3 <= d4) as L3.
{ subst. apply le_INR. apply fact_le. simpl; lia. }
simpl.
ring_simplify.
assert ( - (x * (x * (x * 1)) / d1) + x * (x * (x * (x * (x * 1)))) / d2 <= 0).
rewrite Rplus_comm.
apply Rle_minus.
field_simplify; try lra.
assert (x ^ 5 <= x ^ 3).
{ apply Rle_pow_le1; try lra; try lia. }
apply Rmult_le_compat; try lra.
apply pow_le; lra.
left. apply Rinv_0_lt_compat. lra.
apply Rinv_le_contravar; lra.
unfold Rminus.
assert (- (x * (x * (x * (x * (x * (x * (x * 1)))))) / d3) +
x * (x * (x * (x * (x * (x * (x * (x * (x * 1)))))))) / d4 <= 0).
rewrite Rplus_comm.
apply Rle_minus.
field_simplify; try lra.
assert (x ^ 9 <= x ^ 7).
{ apply Rle_pow_le1; try lra; try lia. }
apply Rmult_le_compat; try lra.
apply pow_le; lra.
left. apply Rinv_0_lt_compat. lra.
apply Rinv_le_contravar; lra.
lra.
Qed.
Lemma sin_upper_bound : forall x : R, Rabs (sin x) <= Rabs x.
Proof.
intros x.
specialize (SIN_bound x) as B.
destruct (Rlt_or_le (Rabs x) 1).
(* abs(x) > 1 *)
2:{ apply Rabs_le in B. lra. }
destruct (Rtotal_order x 0) as [G | [E| L]].
- (* x < 0 *)
rewrite (Rabs_left x) in * by lra.
rewrite (Rabs_left (sin x)).
2:{ apply sin_lt_0_var; try lra.
specialize PI2_1 as PI1.
lra. }
rewrite <- sin_neg.
apply sin_upper_bound_aux.
lra.
- (* x = 0 *)
subst. rewrite sin_0. lra.
- rewrite (Rabs_right x) in * by lra.
rewrite (Rabs_right (sin x)).
2:{ apply Rle_ge.
apply sin_ge_0; try lra.
specialize PI2_1 as PI1. lra. }
apply sin_upper_bound_aux; lra.
Qed.
Hint Rewrite sin_0 sin_PI4 sin_PI2 sin_PI cos_0 cos_PI4 cos_PI2 cos_PI sin_neg cos_neg : trig_db.