~ubuntu-branches/ubuntu/wily/coq-doc/wily

« back to all changes in this revision

Viewing changes to theories/Reals/RIneq.v

  • Committer: Bazaar Package Importer
  • Author(s): Stéphane Glondu, Stéphane Glondu, Samuel Mimram
  • Date: 2010-01-07 22:50:39 UTC
  • mfrom: (1.2.2 upstream)
  • Revision ID: james.westby@ubuntu.com-20100107225039-n3cq82589u0qt0s2
Tags: 8.2pl1-1
[ Stéphane Glondu ]
* New upstream release (Closes: #563669)
  - remove patches
* Packaging overhaul:
  - use git, advertise it in Vcs-* fields of debian/control
  - use debhelper 7 and dh with override
  - use source format 3.0 (quilt)
* debian/control:
  - set Maintainer to d-o-m, set Uploaders to Sam and myself
  - add Homepage field
  - bump Standards-Version to 3.8.3
* Register PDF documentation into doc-base
* Add debian/watch
* Update debian/copyright

[ Samuel Mimram ]
* Change coq-doc's description to mention that it provides documentation in
  pdf format, not postscript, closes: #543545.

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
(************************************************************************)
 
2
(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
 
3
(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
 
4
(*   \VV/  **************************************************************)
 
5
(*    //   *      This file is distributed under the terms of the       *)
 
6
(*         *       GNU Lesser General Public License Version 2.1        *)
 
7
(************************************************************************)
 
8
 
 
9
(*i $Id: RIneq.v 11887 2009-02-06 19:57:33Z herbelin $ i*)
 
10
 
 
11
(*********************************************************)
 
12
(** * Basic lemmas for the classical real numbers        *)
 
13
(*********************************************************)
 
14
 
 
15
Require Export Raxioms.
 
16
Require Import Rpow_def.
 
17
Require Import Zpower.
 
18
Require Export ZArithRing.
 
19
Require Import Omega.
 
20
Require Export RealField.
 
21
 
 
22
Open Local Scope Z_scope.
 
23
Open Local Scope R_scope.
 
24
 
 
25
Implicit Type r : R.
 
26
 
 
27
(*********************************************************)
 
28
(** ** Relation between orders and equality              *)
 
29
(*********************************************************)
 
30
 
 
31
(** Reflexivity of the large order *)
 
32
 
 
33
Lemma Rle_refl : forall r, r <= r.
 
34
Proof.
 
35
  intro; right; reflexivity.
 
36
Qed.
 
37
Hint Immediate Rle_refl: rorders.
 
38
 
 
39
Lemma Rge_refl : forall r, r <= r.
 
40
Proof. exact Rle_refl. Qed.
 
41
Hint Immediate Rge_refl: rorders.
 
42
 
 
43
(** Irreflexivity of the strict order *)
 
44
 
 
45
Lemma Rlt_irrefl : forall r, ~ r < r.
 
46
Proof.
 
47
  generalize Rlt_asym. intuition eauto.
 
48
Qed.
 
49
Hint Resolve Rlt_irrefl: real.
 
50
 
 
51
Lemma Rgt_irrefl : forall r, ~ r > r.
 
52
Proof. exact Rlt_irrefl. Qed.
 
53
 
 
54
Lemma Rlt_not_eq : forall r1 r2, r1 < r2 -> r1 <> r2.
 
55
Proof.
 
56
  red in |- *; intros r1 r2 H H0; apply (Rlt_irrefl r1).
 
57
  pattern r1 at 2 in |- *; rewrite H0; trivial.
 
58
Qed.
 
59
 
 
60
Lemma Rgt_not_eq : forall r1 r2, r1 > r2 -> r1 <> r2.
 
61
Proof.
 
62
  intros; apply sym_not_eq; apply Rlt_not_eq; auto with real.
 
63
Qed.
 
64
 
 
65
(**********)
 
66
Lemma Rlt_dichotomy_converse : forall r1 r2, r1 < r2 \/ r1 > r2 -> r1 <> r2.
 
67
Proof.
 
68
  generalize Rlt_not_eq Rgt_not_eq. intuition eauto.
 
69
Qed.
 
70
Hint Resolve Rlt_dichotomy_converse: real.
 
71
 
 
72
(** Reasoning by case on equality and order *)
 
73
 
 
74
(**********)
 
75
Lemma Req_dec : forall r1 r2, r1 = r2 \/ r1 <> r2.
 
76
Proof.
 
77
  intros; generalize (total_order_T r1 r2) Rlt_dichotomy_converse;
 
78
    intuition eauto 3. 
 
79
Qed.
 
80
Hint Resolve Req_dec: real.
 
81
 
 
82
(**********)
 
83
Lemma Rtotal_order : forall r1 r2, r1 < r2 \/ r1 = r2 \/ r1 > r2.
 
84
Proof.
 
85
  intros; generalize (total_order_T r1 r2); tauto.
 
86
Qed.
 
87
 
 
88
(**********)
 
89
Lemma Rdichotomy : forall r1 r2, r1 <> r2 -> r1 < r2 \/ r1 > r2.
 
90
Proof.
 
91
  intros; generalize (total_order_T r1 r2); tauto.
 
92
Qed.
 
93
 
 
94
(*********************************************************)
 
95
(** ** Relating [<], [>], [<=] and [>=]                  *)
 
96
(*********************************************************)
 
97
 
 
98
(*********************************************************)
 
99
(** ** Order                                             *)
 
100
(*********************************************************)
 
101
 
 
102
(** *** Relating strict and large orders *)
 
103
 
 
104
Lemma Rlt_le : forall r1 r2, r1 < r2 -> r1 <= r2.
 
105
Proof.
 
106
  intros; red in |- *; tauto.
 
107
Qed.
 
108
Hint Resolve Rlt_le: real.
 
109
 
 
110
Lemma Rgt_ge : forall r1 r2, r1 > r2 -> r1 >= r2.
 
111
Proof.
 
112
  intros; red; tauto.
 
113
Qed.
 
114
 
 
115
(**********)
 
116
Lemma Rle_ge : forall r1 r2, r1 <= r2 -> r2 >= r1.
 
117
Proof.
 
118
  destruct 1; red in |- *; auto with real.
 
119
Qed.
 
120
Hint Immediate Rle_ge: real.
 
121
Hint Resolve Rle_ge: rorders.
 
122
 
 
123
Lemma Rge_le : forall r1 r2, r1 >= r2 -> r2 <= r1.
 
124
Proof.
 
125
  destruct 1; red in |- *; auto with real.
 
126
Qed.
 
127
Hint Resolve Rge_le: real.
 
128
Hint Immediate Rge_le: rorders.
 
129
 
 
130
(**********)
 
131
Lemma Rlt_gt : forall r1 r2, r1 < r2 -> r2 > r1.
 
132
Proof. 
 
133
  trivial.
 
134
Qed.
 
135
Hint Resolve Rlt_gt: rorders.
 
136
 
 
137
Lemma Rgt_lt : forall r1 r2, r1 > r2 -> r2 < r1.
 
138
Proof.
 
139
  trivial.
 
140
Qed.
 
141
Hint Immediate Rgt_lt: rorders.
 
142
 
 
143
(**********)
 
144
 
 
145
Lemma Rnot_le_lt : forall r1 r2, ~ r1 <= r2 -> r2 < r1.
 
146
Proof.
 
147
  intros r1 r2; generalize (Rtotal_order r1 r2); unfold Rle in |- *; tauto.
 
148
Qed.
 
149
Hint Immediate Rnot_le_lt: real.
 
150
 
 
151
Lemma Rnot_ge_gt : forall r1 r2, ~ r1 >= r2 -> r2 > r1.
 
152
Proof. intros; red; apply Rnot_le_lt. auto with real. Qed.
 
153
 
 
154
Lemma Rnot_le_gt : forall r1 r2, ~ r1 <= r2 -> r1 > r2.
 
155
Proof. intros; red; apply Rnot_le_lt. auto with real. Qed.
 
156
 
 
157
Lemma Rnot_ge_lt : forall r1 r2, ~ r1 >= r2 -> r1 < r2.
 
158
Proof. intros; apply Rnot_le_lt. auto with real. Qed.
 
159
 
 
160
Lemma Rnot_lt_le : forall r1 r2, ~ r1 < r2 -> r2 <= r1.
 
161
Proof.
 
162
  intros r1 r2 H; destruct (Rtotal_order r1 r2) as [ | [ H0 | H0 ] ].
 
163
    contradiction. subst; auto with rorders. auto with real.
 
164
Qed.
 
165
 
 
166
Lemma Rnot_gt_le : forall r1 r2, ~ r1 > r2 -> r1 <= r2.
 
167
Proof. auto using Rnot_lt_le with real. Qed.
 
168
 
 
169
Lemma Rnot_gt_ge : forall r1 r2, ~ r1 > r2 -> r2 >= r1.
 
170
Proof. intros; eauto using Rnot_lt_le with rorders. Qed.
 
171
 
 
172
Lemma Rnot_lt_ge : forall r1 r2, ~ r1 < r2 -> r1 >= r2.
 
173
Proof. eauto using Rnot_gt_ge with rorders. Qed.
 
174
 
 
175
(**********)
 
176
Lemma Rlt_not_le : forall r1 r2, r2 < r1 -> ~ r1 <= r2.
 
177
Proof.
 
178
  generalize Rlt_asym Rlt_dichotomy_converse; unfold Rle in |- *.
 
179
  intuition eauto 3.
 
180
Qed.
 
181
Hint Immediate Rlt_not_le: real.
 
182
 
 
183
Lemma Rgt_not_le : forall r1 r2, r1 > r2 -> ~ r1 <= r2.
 
184
Proof. exact Rlt_not_le. Qed.
 
185
 
 
186
Lemma Rlt_not_ge : forall r1 r2, r1 < r2 -> ~ r1 >= r2.
 
187
Proof. red; intros; eapply Rlt_not_le; eauto with real. Qed.
 
188
Hint Immediate Rlt_not_ge: real.
 
189
 
 
190
Lemma Rgt_not_ge : forall r1 r2, r2 > r1 -> ~ r1 >= r2.
 
191
Proof. exact Rlt_not_ge. Qed.
 
192
 
 
193
Lemma Rle_not_lt : forall r1 r2, r2 <= r1 -> ~ r1 < r2.
 
194
Proof.
 
195
  intros r1 r2. generalize (Rlt_asym r1 r2) (Rlt_dichotomy_converse r1 r2).
 
196
  unfold Rle in |- *; intuition.
 
197
Qed.
 
198
 
 
199
Lemma Rge_not_lt : forall r1 r2, r1 >= r2 -> ~ r1 < r2.
 
200
Proof. intros; apply Rle_not_lt; auto with real. Qed.
 
201
 
 
202
Lemma Rle_not_gt : forall r1 r2, r1 <= r2 -> ~ r1 > r2.
 
203
Proof. do 2 intro; apply Rle_not_lt. Qed.
 
204
 
 
205
Lemma Rge_not_gt : forall r1 r2, r2 >= r1 -> ~ r1 > r2.
 
206
Proof. do 2 intro; apply Rge_not_lt. Qed.
 
207
 
 
208
(**********)
 
209
Lemma Req_le : forall r1 r2, r1 = r2 -> r1 <= r2.
 
210
Proof.
 
211
  unfold Rle in |- *; tauto.
 
212
Qed.
 
213
Hint Immediate Req_le: real.
 
214
 
 
215
Lemma Req_ge : forall r1 r2, r1 = r2 -> r1 >= r2.
 
216
Proof.
 
217
  unfold Rge in |- *; tauto.
 
218
Qed.
 
219
Hint Immediate Req_ge: real.
 
220
 
 
221
Lemma Req_le_sym : forall r1 r2, r2 = r1 -> r1 <= r2.
 
222
Proof.
 
223
  unfold Rle in |- *; auto.
 
224
Qed.
 
225
Hint Immediate Req_le_sym: real.
 
226
 
 
227
Lemma Req_ge_sym : forall r1 r2, r2 = r1 -> r1 >= r2.
 
228
Proof.
 
229
  unfold Rge in |- *; auto.
 
230
Qed.
 
231
Hint Immediate Req_ge_sym: real.
 
232
 
 
233
(** *** Asymmetry *)
 
234
 
 
235
(** Remark: [Rlt_asym] is an axiom *)
 
236
 
 
237
Lemma Rgt_asym : forall r1 r2:R, r1 > r2 -> ~ r2 > r1.
 
238
Proof. do 2 intro; apply Rlt_asym. Qed.
 
239
 
 
240
(** *** Antisymmetry *)
 
241
 
 
242
Lemma Rle_antisym : forall r1 r2, r1 <= r2 -> r2 <= r1 -> r1 = r2.
 
243
Proof.
 
244
  intros r1 r2; generalize (Rlt_asym r1 r2); unfold Rle in |- *; intuition.
 
245
Qed.
 
246
Hint Resolve Rle_antisym: real.
 
247
 
 
248
Lemma Rge_antisym : forall r1 r2, r1 >= r2 -> r2 >= r1 -> r1 = r2.
 
249
Proof. auto with real. Qed.
 
250
 
 
251
(**********)
 
252
Lemma Rle_le_eq : forall r1 r2, r1 <= r2 /\ r2 <= r1 <-> r1 = r2.
 
253
Proof.
 
254
  intuition.
 
255
Qed.
 
256
 
 
257
Lemma Rge_ge_eq : forall r1 r2, r1 >= r2 /\ r2 >= r1 <-> r1 = r2.
 
258
Proof.
 
259
  intuition.
 
260
Qed.
 
261
 
 
262
(** *** Compatibility with equality *)
 
263
 
 
264
Lemma Rlt_eq_compat :
 
265
  forall r1 r2 r3 r4, r1 = r2 -> r2 < r4 -> r4 = r3 -> r1 < r3.
 
266
Proof.
 
267
  intros x x' y y'; intros; replace x with x'; replace y with y'; assumption.
 
268
Qed.
 
269
 
 
270
Lemma Rgt_eq_compat :
 
271
  forall r1 r2 r3 r4, r1 = r2 -> r2 > r4 -> r4 = r3 -> r1 > r3.
 
272
Proof. intros; red; apply Rlt_eq_compat with (r2:=r4) (r4:=r2); auto. Qed.
 
273
 
 
274
(** *** Transitivity *)
 
275
 
 
276
(** Remark: [Rlt_trans] is an axiom *)
 
277
 
 
278
Lemma Rle_trans : forall r1 r2 r3, r1 <= r2 -> r2 <= r3 -> r1 <= r3.
 
279
Proof.
 
280
  generalize trans_eq Rlt_trans Rlt_eq_compat.
 
281
  unfold Rle in |- *.
 
282
  intuition eauto 2.
 
283
Qed.
 
284
 
 
285
Lemma Rge_trans : forall r1 r2 r3, r1 >= r2 -> r2 >= r3 -> r1 >= r3.
 
286
Proof. eauto using Rle_trans with rorders. Qed.
 
287
 
 
288
Lemma Rgt_trans : forall r1 r2 r3, r1 > r2 -> r2 > r3 -> r1 > r3.
 
289
Proof. eauto using Rlt_trans with rorders. Qed.
 
290
 
 
291
(**********)
 
292
Lemma Rle_lt_trans : forall r1 r2 r3, r1 <= r2 -> r2 < r3 -> r1 < r3.
 
293
Proof.
 
294
  generalize Rlt_trans Rlt_eq_compat. 
 
295
  unfold Rle in |- *.
 
296
  intuition eauto 2.
 
297
Qed.
 
298
 
 
299
Lemma Rlt_le_trans : forall r1 r2 r3, r1 < r2 -> r2 <= r3 -> r1 < r3.
 
300
Proof.
 
301
  generalize Rlt_trans Rlt_eq_compat; unfold Rle in |- *; intuition eauto 2.
 
302
Qed.
 
303
 
 
304
Lemma Rge_gt_trans : forall r1 r2 r3, r1 >= r2 -> r2 > r3 -> r1 > r3.
 
305
Proof. eauto using Rlt_le_trans with rorders. Qed.
 
306
 
 
307
Lemma Rgt_ge_trans : forall r1 r2 r3, r1 > r2 -> r2 >= r3 -> r1 > r3.
 
308
Proof. eauto using Rle_lt_trans with rorders. Qed.
 
309
 
 
310
(** *** (Classical) decidability *)
 
311
 
 
312
Lemma Rlt_dec : forall r1 r2, {r1 < r2} + {~ r1 < r2}.
 
313
Proof.
 
314
  intros; generalize (total_order_T r1 r2) (Rlt_dichotomy_converse r1 r2);
 
315
    intuition.
 
316
Qed.
 
317
 
 
318
Lemma Rle_dec : forall r1 r2, {r1 <= r2} + {~ r1 <= r2}.
 
319
Proof.
 
320
  intros r1 r2.
 
321
  generalize (total_order_T r1 r2) (Rlt_dichotomy_converse r1 r2).
 
322
  intuition eauto 4 with real.
 
323
Qed.
 
324
 
 
325
Lemma Rgt_dec : forall r1 r2, {r1 > r2} + {~ r1 > r2}.
 
326
Proof. do 2 intro; apply Rlt_dec. Qed.
 
327
 
 
328
Lemma Rge_dec : forall r1 r2, {r1 >= r2} + {~ r1 >= r2}.
 
329
Proof. intros; edestruct Rle_dec; [left|right]; eauto with rorders. Qed.
 
330
 
 
331
Lemma Rlt_le_dec : forall r1 r2, {r1 < r2} + {r2 <= r1}.
 
332
Proof.
 
333
  intros; generalize (total_order_T r1 r2); intuition.
 
334
Qed.
 
335
 
 
336
Lemma Rgt_ge_dec : forall r1 r2, {r1 > r2} + {r2 >= r1}.
 
337
Proof. intros; edestruct Rlt_le_dec; [left|right]; eauto with rorders. Qed.
 
338
 
 
339
Lemma Rle_lt_dec : forall r1 r2, {r1 <= r2} + {r2 < r1}.
 
340
Proof.
 
341
  intros; generalize (total_order_T r1 r2); intuition.
 
342
Qed.
 
343
 
 
344
Lemma Rge_gt_dec : forall r1 r2, {r1 >= r2} + {r2 > r1}.
 
345
Proof. intros; edestruct Rle_lt_dec; [left|right]; eauto with rorders. Qed.
 
346
 
 
347
Lemma Rlt_or_le : forall r1 r2, r1 < r2 \/ r2 <= r1.
 
348
Proof.
 
349
  intros n m; elim (Rle_lt_dec m n); auto with real.
 
350
Qed.
 
351
 
 
352
Lemma Rgt_or_ge : forall r1 r2, r1 > r2 \/ r2 >= r1.
 
353
Proof. intros; edestruct Rlt_or_le; [left|right]; eauto with rorders. Qed.
 
354
 
 
355
Lemma Rle_or_lt : forall r1 r2, r1 <= r2 \/ r2 < r1.
 
356
Proof.
 
357
  intros n m; elim (Rlt_le_dec m n); auto with real.
 
358
Qed.
 
359
 
 
360
Lemma Rge_or_gt : forall r1 r2, r1 >= r2 \/ r2 > r1.
 
361
Proof. intros; edestruct Rle_or_lt; [left|right]; eauto with rorders. Qed.
 
362
 
 
363
Lemma Rle_lt_or_eq_dec : forall r1 r2, r1 <= r2 -> {r1 < r2} + {r1 = r2}.
 
364
Proof.
 
365
  intros r1 r2 H; generalize (total_order_T r1 r2); intuition.
 
366
Qed.
 
367
 
 
368
(**********)
 
369
Lemma inser_trans_R :
 
370
  forall r1 r2 r3 r4, r1 <= r2 < r3 -> {r1 <= r2 < r4} + {r4 <= r2 < r3}.
 
371
Proof.
 
372
  intros n m p q; intros; generalize (Rlt_le_dec m q); intuition.
 
373
Qed.
 
374
 
 
375
(*********************************************************)
 
376
(** ** Addition                                          *)
 
377
(*********************************************************)
 
378
 
 
379
(** Remark: [Rplus_0_l] is an axiom *)
 
380
 
 
381
Lemma Rplus_0_r : forall r, r + 0 = r.
 
382
Proof.
 
383
  intro; ring.
 
384
Qed.
 
385
Hint Resolve Rplus_0_r: real.
 
386
 
 
387
Lemma Rplus_ne : forall r, r + 0 = r /\ 0 + r = r.
 
388
Proof.
 
389
  split; ring.
 
390
Qed.
 
391
Hint Resolve Rplus_ne: real v62.
 
392
 
 
393
(**********)
 
394
 
 
395
(** Remark: [Rplus_opp_r] is an axiom *)
 
396
 
 
397
Lemma Rplus_opp_l : forall r, - r + r = 0.
 
398
Proof.
 
399
  intro; ring.
 
400
Qed.
 
401
Hint Resolve Rplus_opp_l: real.
 
402
 
 
403
(**********)
 
404
Lemma Rplus_opp_r_uniq : forall r1 r2, r1 + r2 = 0 -> r2 = - r1.
 
405
Proof.
 
406
  intros x y H;
 
407
    replace y with (- x + x + y) by ring.
 
408
  rewrite Rplus_assoc; rewrite H; ring.
 
409
Qed.
 
410
 
 
411
Hint Resolve (f_equal (A:=R)): real.
 
412
 
 
413
Lemma Rplus_eq_compat_l : forall r r1 r2, r1 = r2 -> r + r1 = r + r2.
 
414
Proof.
 
415
  auto with real.
 
416
Qed.
 
417
 
 
418
(*i Old i*)Hint Resolve Rplus_eq_compat_l: v62.
 
419
 
 
420
(**********)
 
421
Lemma Rplus_eq_reg_l : forall r r1 r2, r + r1 = r + r2 -> r1 = r2.
 
422
Proof.
 
423
  intros; transitivity (- r + r + r1).
 
424
  ring.
 
425
  transitivity (- r + r + r2).
 
426
  repeat rewrite Rplus_assoc; rewrite <- H; reflexivity.
 
427
  ring.
 
428
Qed.
 
429
Hint Resolve Rplus_eq_reg_l: real.
 
430
 
 
431
(**********)
 
432
Lemma Rplus_0_r_uniq : forall r r1, r + r1 = r -> r1 = 0.
 
433
Proof.
 
434
  intros r b; pattern r at 2 in |- *; replace r with (r + 0); eauto with real.
 
435
Qed.
 
436
 
 
437
(***********)
 
438
Lemma Rplus_eq_0_l :
 
439
  forall r1 r2, 0 <= r1 -> 0 <= r2 -> r1 + r2 = 0 -> r1 = 0.
 
440
Proof.
 
441
  intros a b H [H0| H0] H1; auto with real.
 
442
    absurd (0 < a + b).
 
443
      rewrite H1; auto with real.
 
444
      apply Rle_lt_trans with (a + 0).
 
445
        rewrite Rplus_0_r in |- *; assumption.
 
446
        auto using Rplus_lt_compat_l with real.
 
447
    rewrite <- H0, Rplus_0_r in H1; assumption.
 
448
Qed.
 
449
 
 
450
Lemma Rplus_eq_R0 :
 
451
  forall r1 r2, 0 <= r1 -> 0 <= r2 -> r1 + r2 = 0 -> r1 = 0 /\ r2 = 0.
 
452
Proof.
 
453
  intros a b; split.
 
454
  apply Rplus_eq_0_l with b; auto with real.
 
455
  apply Rplus_eq_0_l with a; auto with real.
 
456
  rewrite Rplus_comm; auto with real.
 
457
Qed.
 
458
 
 
459
(*********************************************************)       
 
460
(** ** Multiplication                                    *)
 
461
(*********************************************************)
 
462
 
 
463
(**********)
 
464
Lemma Rinv_r : forall r, r <> 0 -> r * / r = 1.
 
465
Proof.
 
466
  intros; field; trivial.
 
467
Qed.
 
468
Hint Resolve Rinv_r: real.
 
469
 
 
470
Lemma Rinv_l_sym : forall r, r <> 0 -> 1 = / r * r.
 
471
Proof.
 
472
  intros; field; trivial.
 
473
Qed.
 
474
Hint Resolve Rinv_l_sym: real.
 
475
 
 
476
Lemma Rinv_r_sym : forall r, r <> 0 -> 1 = r * / r.
 
477
Proof.
 
478
  intros; field; trivial.
 
479
Qed.
 
480
Hint Resolve Rinv_r_sym: real.
 
481
 
 
482
(**********)
 
483
Lemma Rmult_0_r : forall r, r * 0 = 0.
 
484
Proof.
 
485
  intro; ring.
 
486
Qed.
 
487
Hint Resolve Rmult_0_r: real v62.
 
488
 
 
489
(**********)
 
490
Lemma Rmult_0_l : forall r, 0 * r = 0.
 
491
Proof.
 
492
  intro; ring.
 
493
Qed.
 
494
Hint Resolve Rmult_0_l: real v62.
 
495
 
 
496
(**********)
 
497
Lemma Rmult_ne : forall r, r * 1 = r /\ 1 * r = r.
 
498
Proof.
 
499
  intro; split; ring.
 
500
Qed.
 
501
Hint Resolve Rmult_ne: real v62.
 
502
 
 
503
(**********)
 
504
Lemma Rmult_1_r : forall r, r * 1 = r.
 
505
Proof.
 
506
  intro; ring.
 
507
Qed.
 
508
Hint Resolve Rmult_1_r: real.
 
509
 
 
510
(**********)
 
511
Lemma Rmult_eq_compat_l : forall r r1 r2, r1 = r2 -> r * r1 = r * r2.
 
512
Proof.
 
513
  auto with real.
 
514
Qed.
 
515
 
 
516
(*i Old i*)Hint Resolve Rmult_eq_compat_l: v62.
 
517
 
 
518
(**********)
 
519
Lemma Rmult_eq_reg_l : forall r r1 r2, r * r1 = r * r2 -> r <> 0 -> r1 = r2.
 
520
Proof.
 
521
  intros; transitivity (/ r * r * r1).
 
522
  field; trivial.
 
523
  transitivity (/ r * r * r2).
 
524
  repeat rewrite Rmult_assoc; rewrite H; trivial.
 
525
  field; trivial.
 
526
Qed.
 
527
 
 
528
(**********)
 
529
Lemma Rmult_integral : forall r1 r2, r1 * r2 = 0 -> r1 = 0 \/ r2 = 0.
 
530
Proof.
 
531
  intros; case (Req_dec r1 0); [ intro Hz | intro Hnotz ].
 
532
  auto.
 
533
  right; apply Rmult_eq_reg_l with r1; trivial.
 
534
  rewrite H; auto with real.
 
535
Qed.
 
536
 
 
537
(**********)
 
538
Lemma Rmult_eq_0_compat : forall r1 r2, r1 = 0 \/ r2 = 0 -> r1 * r2 = 0.
 
539
Proof.
 
540
  intros r1 r2 [H| H]; rewrite H; auto with real.
 
541
Qed.
 
542
 
 
543
Hint Resolve Rmult_eq_0_compat: real.
 
544
 
 
545
(**********)
 
546
Lemma Rmult_eq_0_compat_r : forall r1 r2, r1 = 0 -> r1 * r2 = 0.
 
547
Proof.
 
548
  auto with real.
 
549
Qed.
 
550
 
 
551
(**********)
 
552
Lemma Rmult_eq_0_compat_l : forall r1 r2, r2 = 0 -> r1 * r2 = 0.
 
553
Proof.
 
554
  auto with real.
 
555
Qed.
 
556
 
 
557
(**********) 
 
558
Lemma Rmult_neq_0_reg : forall r1 r2, r1 * r2 <> 0 -> r1 <> 0 /\ r2 <> 0.
 
559
Proof.
 
560
  intros r1 r2 H; split; red in |- *; intro; apply H; auto with real.
 
561
Qed.
 
562
 
 
563
(**********) 
 
564
Lemma Rmult_integral_contrapositive :
 
565
  forall r1 r2, r1 <> 0 /\ r2 <> 0 -> r1 * r2 <> 0.
 
566
Proof.
 
567
  red in |- *; intros r1 r2 [H1 H2] H.
 
568
  case (Rmult_integral r1 r2); auto with real.
 
569
Qed.
 
570
Hint Resolve Rmult_integral_contrapositive: real.
 
571
 
 
572
Lemma Rmult_integral_contrapositive_currified : 
 
573
  forall r1 r2, r1 <> 0 -> r2 <> 0 -> r1 * r2 <> 0.
 
574
Proof. auto using Rmult_integral_contrapositive. Qed.
 
575
 
 
576
(**********) 
 
577
Lemma Rmult_plus_distr_r :
 
578
  forall r1 r2 r3, (r1 + r2) * r3 = r1 * r3 + r2 * r3.
 
579
Proof.
 
580
  intros; ring.
 
581
Qed.
 
582
 
 
583
(*********************************************************)
 
584
(** ** Square function                                   *)
 
585
(*********************************************************)
 
586
 
 
587
(***********)
 
588
Definition Rsqr r : R := r * r.
 
589
 
 
590
Notation "r ²" := (Rsqr r) (at level 1, format "r ²") : R_scope.
 
591
 
 
592
(***********)
 
593
Lemma Rsqr_0 : Rsqr 0 = 0.
 
594
  unfold Rsqr in |- *; auto with real.
 
595
Qed.
 
596
 
 
597
(***********)
 
598
Lemma Rsqr_0_uniq : forall r, Rsqr r = 0 -> r = 0.
 
599
  unfold Rsqr in |- *; intros; elim (Rmult_integral r r H); trivial.
 
600
Qed.
 
601
 
 
602
(*********************************************************)
 
603
(** ** Opposite                                          *)
 
604
(*********************************************************)
 
605
 
 
606
(**********)
 
607
Lemma Ropp_eq_compat : forall r1 r2, r1 = r2 -> - r1 = - r2.
 
608
Proof.
 
609
  auto with real.
 
610
Qed.
 
611
Hint Resolve Ropp_eq_compat: real.
 
612
 
 
613
(**********)
 
614
Lemma Ropp_0 : -0 = 0.
 
615
Proof.
 
616
  ring.
 
617
Qed.
 
618
Hint Resolve Ropp_0: real v62.
 
619
 
 
620
(**********)
 
621
Lemma Ropp_eq_0_compat : forall r, r = 0 -> - r = 0.
 
622
Proof.
 
623
  intros; rewrite H; auto with real.
 
624
Qed.
 
625
Hint Resolve Ropp_eq_0_compat: real.
 
626
 
 
627
(**********)
 
628
Lemma Ropp_involutive : forall r, - - r = r.
 
629
Proof.
 
630
  intro; ring.
 
631
Qed.
 
632
Hint Resolve Ropp_involutive: real.
 
633
 
 
634
(*********)
 
635
Lemma Ropp_neq_0_compat : forall r, r <> 0 -> - r <> 0.
 
636
Proof.
 
637
  red in |- *; intros r H H0.
 
638
  apply H.
 
639
  transitivity (- - r); auto with real.
 
640
Qed.
 
641
Hint Resolve Ropp_neq_0_compat: real.
 
642
 
 
643
(**********)
 
644
Lemma Ropp_plus_distr : forall r1 r2, - (r1 + r2) = - r1 + - r2.
 
645
Proof.
 
646
  intros; ring.
 
647
Qed.
 
648
Hint Resolve Ropp_plus_distr: real.
 
649
 
 
650
(*********************************************************)
 
651
(** ** Opposite and multiplication                       *)
 
652
(*********************************************************)
 
653
 
 
654
Lemma Ropp_mult_distr_l_reverse : forall r1 r2, - r1 * r2 = - (r1 * r2).
 
655
Proof.
 
656
  intros; ring.
 
657
Qed.
 
658
Hint Resolve Ropp_mult_distr_l_reverse: real.
 
659
 
 
660
(**********)
 
661
Lemma Rmult_opp_opp : forall r1 r2, - r1 * - r2 = r1 * r2.
 
662
Proof.
 
663
  intros; ring.
 
664
Qed.
 
665
Hint Resolve Rmult_opp_opp: real.
 
666
 
 
667
Lemma Ropp_mult_distr_r_reverse : forall r1 r2, r1 * - r2 = - (r1 * r2).
 
668
Proof.
 
669
  intros; ring.
 
670
Qed.
 
671
 
 
672
(*********************************************************)
 
673
(** ** Substraction                                      *)
 
674
(*********************************************************)
 
675
 
 
676
Lemma Rminus_0_r : forall r, r - 0 = r.
 
677
Proof.
 
678
  intro; ring.
 
679
Qed.
 
680
Hint Resolve Rminus_0_r: real.
 
681
 
 
682
Lemma Rminus_0_l : forall r, 0 - r = - r.
 
683
Proof.
 
684
  intro; ring.
 
685
Qed.
 
686
Hint Resolve Rminus_0_l: real.
 
687
 
 
688
(**********)
 
689
Lemma Ropp_minus_distr : forall r1 r2, - (r1 - r2) = r2 - r1.
 
690
Proof.
 
691
  intros; ring.
 
692
Qed.
 
693
Hint Resolve Ropp_minus_distr: real.
 
694
 
 
695
Lemma Ropp_minus_distr' : forall r1 r2, - (r2 - r1) = r1 - r2.
 
696
Proof.
 
697
  intros; ring.
 
698
Qed.
 
699
 
 
700
(**********)
 
701
Lemma Rminus_diag_eq : forall r1 r2, r1 = r2 -> r1 - r2 = 0.
 
702
Proof.
 
703
  intros; rewrite H; ring.
 
704
Qed.
 
705
Hint Resolve Rminus_diag_eq: real.
 
706
 
 
707
(**********)
 
708
Lemma Rminus_diag_uniq : forall r1 r2, r1 - r2 = 0 -> r1 = r2.
 
709
Proof.
 
710
  intros r1 r2; unfold Rminus in |- *; rewrite Rplus_comm; intro.
 
711
  rewrite <- (Ropp_involutive r2); apply (Rplus_opp_r_uniq (- r2) r1 H).
 
712
Qed.
 
713
Hint Immediate Rminus_diag_uniq: real.
 
714
 
 
715
Lemma Rminus_diag_uniq_sym : forall r1 r2, r2 - r1 = 0 -> r1 = r2.
 
716
Proof.
 
717
  intros; generalize (Rminus_diag_uniq r2 r1 H); clear H; intro H; rewrite H;
 
718
    ring.
 
719
Qed.
 
720
Hint Immediate Rminus_diag_uniq_sym: real.
 
721
 
 
722
Lemma Rplus_minus : forall r1 r2, r1 + (r2 - r1) = r2.
 
723
Proof.
 
724
  intros; ring.
 
725
Qed.
 
726
Hint Resolve Rplus_minus: real.
 
727
 
 
728
(**********)
 
729
Lemma Rminus_eq_contra : forall r1 r2, r1 <> r2 -> r1 - r2 <> 0.
 
730
Proof.
 
731
  red in |- *; intros r1 r2 H H0.
 
732
  apply H; auto with real.
 
733
Qed.
 
734
Hint Resolve Rminus_eq_contra: real.
 
735
 
 
736
Lemma Rminus_not_eq : forall r1 r2, r1 - r2 <> 0 -> r1 <> r2.
 
737
Proof.
 
738
  red in |- *; intros; elim H; apply Rminus_diag_eq; auto.
 
739
Qed.
 
740
Hint Resolve Rminus_not_eq: real.
 
741
 
 
742
Lemma Rminus_not_eq_right : forall r1 r2, r2 - r1 <> 0 -> r1 <> r2.
 
743
Proof.
 
744
  red in |- *; intros; elim H; rewrite H0; ring.
 
745
Qed.
 
746
Hint Resolve Rminus_not_eq_right: real. 
 
747
 
 
748
(**********)
 
749
Lemma Rmult_minus_distr_l :
 
750
  forall r1 r2 r3, r1 * (r2 - r3) = r1 * r2 - r1 * r3.
 
751
Proof.
 
752
  intros; ring.
 
753
Qed.
 
754
 
 
755
(*********************************************************)
 
756
(** ** Inverse                                           *)
 
757
(*********************************************************)
 
758
 
 
759
Lemma Rinv_1 : / 1 = 1.
 
760
Proof.
 
761
  field.
 
762
Qed.
 
763
Hint Resolve Rinv_1: real.
 
764
 
 
765
(*********)
 
766
Lemma Rinv_neq_0_compat : forall r, r <> 0 -> / r <> 0.
 
767
Proof.
 
768
  red in |- *; intros; apply R1_neq_R0.
 
769
  replace 1 with (/ r * r); auto with real.
 
770
Qed.
 
771
Hint Resolve Rinv_neq_0_compat: real.
 
772
 
 
773
(*********)
 
774
Lemma Rinv_involutive : forall r, r <> 0 -> / / r = r.
 
775
Proof.
 
776
  intros; field; trivial.
 
777
Qed.
 
778
Hint Resolve Rinv_involutive: real.
 
779
 
 
780
(*********)
 
781
Lemma Rinv_mult_distr :
 
782
  forall r1 r2, r1 <> 0 -> r2 <> 0 -> / (r1 * r2) = / r1 * / r2.
 
783
Proof.
 
784
  intros; field; auto.
 
785
Qed.
 
786
 
 
787
(*********)
 
788
Lemma Ropp_inv_permute : forall r, r <> 0 -> - / r = / - r.
 
789
Proof.
 
790
  intros; field; trivial.
 
791
Qed.
 
792
 
 
793
Lemma Rinv_r_simpl_r : forall r1 r2, r1 <> 0 -> r1 * / r1 * r2 = r2.
 
794
Proof.
 
795
  intros; transitivity (1 * r2); auto with real.
 
796
  rewrite Rinv_r; auto with real.
 
797
Qed.
 
798
 
 
799
Lemma Rinv_r_simpl_l : forall r1 r2, r1 <> 0 -> r2 * r1 * / r1 = r2.
 
800
Proof.
 
801
  intros; transitivity (r2 * 1); auto with real.
 
802
  transitivity (r2 * (r1 * / r1)); auto with real.
 
803
Qed.
 
804
 
 
805
Lemma Rinv_r_simpl_m : forall r1 r2, r1 <> 0 -> r1 * r2 * / r1 = r2.
 
806
Proof.
 
807
  intros; transitivity (r2 * 1); auto with real.
 
808
  transitivity (r2 * (r1 * / r1)); auto with real.
 
809
  ring.
 
810
Qed.
 
811
Hint Resolve Rinv_r_simpl_l Rinv_r_simpl_r Rinv_r_simpl_m: real.
 
812
 
 
813
(*********)
 
814
Lemma Rinv_mult_simpl :
 
815
  forall r1 r2 r3, r1 <> 0 -> r1 * / r2 * (r3 * / r1) = r3 * / r2.
 
816
Proof.
 
817
  intros a b c; intros.
 
818
  transitivity (a * / a * (c * / b)); auto with real.
 
819
  ring.
 
820
Qed.
 
821
 
 
822
(*********************************************************)
 
823
(** ** Order and addition                                *)
 
824
(*********************************************************)
 
825
 
 
826
(** *** Compatibility *)
 
827
 
 
828
(** Remark: [Rplus_lt_compat_l] is an axiom *)
 
829
 
 
830
Lemma Rplus_gt_compat_l : forall r r1 r2, r1 > r2 -> r + r1 > r + r2.
 
831
Proof. eauto using Rplus_lt_compat_l with rorders. Qed.
 
832
Hint Resolve Rplus_gt_compat_l: real.
 
833
 
 
834
(**********)
 
835
Lemma Rplus_lt_compat_r : forall r r1 r2, r1 < r2 -> r1 + r < r2 + r.
 
836
Proof.
 
837
  intros.
 
838
  rewrite (Rplus_comm r1 r); rewrite (Rplus_comm r2 r); auto with real.
 
839
Qed.
 
840
Hint Resolve Rplus_lt_compat_r: real.
 
841
 
 
842
Lemma Rplus_gt_compat_r : forall r r1 r2, r1 > r2 -> r1 + r > r2 + r.
 
843
Proof. do 3 intro; apply Rplus_lt_compat_r. Qed.
 
844
 
 
845
(**********)
 
846
Lemma Rplus_le_compat_l : forall r r1 r2, r1 <= r2 -> r + r1 <= r + r2.
 
847
Proof.
 
848
  unfold Rle in |- *; intros; elim H; intro.
 
849
  left; apply (Rplus_lt_compat_l r r1 r2 H0).
 
850
  right; rewrite <- H0; auto with zarith real.
 
851
Qed.
 
852
 
 
853
Lemma Rplus_ge_compat_l : forall r r1 r2, r1 >= r2 -> r + r1 >= r + r2.
 
854
Proof. auto using Rplus_le_compat_l with rorders. Qed.
 
855
Hint Resolve Rplus_ge_compat_l: real.
 
856
 
 
857
(**********)
 
858
Lemma Rplus_le_compat_r : forall r r1 r2, r1 <= r2 -> r1 + r <= r2 + r.
 
859
Proof.
 
860
  unfold Rle in |- *; intros; elim H; intro.
 
861
  left; apply (Rplus_lt_compat_r r r1 r2 H0).
 
862
  right; rewrite <- H0; auto with real.
 
863
Qed.
 
864
 
 
865
Hint Resolve Rplus_le_compat_l Rplus_le_compat_r: real.
 
866
 
 
867
Lemma Rplus_ge_compat_r : forall r r1 r2, r1 >= r2 -> r1 + r >= r2 + r.
 
868
Proof. auto using Rplus_le_compat_r with rorders. Qed.
 
869
 
 
870
(*********)
 
871
Lemma Rplus_lt_compat :
 
872
  forall r1 r2 r3 r4, r1 < r2 -> r3 < r4 -> r1 + r3 < r2 + r4.
 
873
Proof.
 
874
  intros; apply Rlt_trans with (r2 + r3); auto with real.
 
875
Qed.
 
876
Hint Immediate Rplus_lt_compat: real.
 
877
 
 
878
Lemma Rplus_le_compat :
 
879
  forall r1 r2 r3 r4, r1 <= r2 -> r3 <= r4 -> r1 + r3 <= r2 + r4.
 
880
Proof.
 
881
  intros; apply Rle_trans with (r2 + r3); auto with real.
 
882
Qed.
 
883
Hint Immediate Rplus_le_compat: real.
 
884
 
 
885
Lemma Rplus_gt_compat :
 
886
  forall r1 r2 r3 r4, r1 > r2 -> r3 > r4 -> r1 + r3 > r2 + r4.
 
887
Proof. auto using Rplus_lt_compat with rorders. Qed.
 
888
 
 
889
Lemma Rplus_ge_compat :
 
890
  forall r1 r2 r3 r4, r1 >= r2 -> r3 >= r4 -> r1 + r3 >= r2 + r4.
 
891
Proof. auto using Rplus_le_compat with rorders. Qed.
 
892
 
 
893
(*********)
 
894
Lemma Rplus_lt_le_compat :
 
895
  forall r1 r2 r3 r4, r1 < r2 -> r3 <= r4 -> r1 + r3 < r2 + r4.
 
896
Proof.
 
897
  intros; apply Rlt_le_trans with (r2 + r3); auto with real.
 
898
Qed.
 
899
 
 
900
Lemma Rplus_le_lt_compat :
 
901
  forall r1 r2 r3 r4, r1 <= r2 -> r3 < r4 -> r1 + r3 < r2 + r4.
 
902
Proof.
 
903
  intros; apply Rle_lt_trans with (r2 + r3); auto with real.
 
904
Qed.
 
905
 
 
906
Hint Immediate Rplus_lt_le_compat Rplus_le_lt_compat: real.
 
907
 
 
908
Lemma Rplus_gt_ge_compat :
 
909
  forall r1 r2 r3 r4, r1 > r2 -> r3 >= r4 -> r1 + r3 > r2 + r4.
 
910
Proof. auto using Rplus_lt_le_compat with rorders. Qed.
 
911
 
 
912
Lemma Rplus_ge_gt_compat :
 
913
  forall r1 r2 r3 r4, r1 >= r2 -> r3 > r4 -> r1 + r3 > r2 + r4.
 
914
Proof. auto using Rplus_le_lt_compat with rorders. Qed.
 
915
 
 
916
(**********)
 
917
Lemma Rplus_lt_0_compat : forall r1 r2, 0 < r1 -> 0 < r2 -> 0 < r1 + r2.
 
918
Proof.
 
919
  intros x y; intros; apply Rlt_trans with x;
 
920
    [ assumption
 
921
      | pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_lt_compat_l;
 
922
        assumption ].
 
923
Qed.
 
924
 
 
925
Lemma Rplus_le_lt_0_compat : forall r1 r2, 0 <= r1 -> 0 < r2 -> 0 < r1 + r2.
 
926
Proof.
 
927
  intros x y; intros; apply Rle_lt_trans with x;
 
928
    [ assumption
 
929
      | pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_lt_compat_l;
 
930
        assumption ].
 
931
Qed.
 
932
 
 
933
Lemma Rplus_lt_le_0_compat : forall r1 r2, 0 < r1 -> 0 <= r2 -> 0 < r1 + r2.
 
934
Proof.
 
935
  intros x y; intros; rewrite <- Rplus_comm; apply Rplus_le_lt_0_compat;
 
936
    assumption.
 
937
Qed.
 
938
 
 
939
Lemma Rplus_le_le_0_compat : forall r1 r2, 0 <= r1 -> 0 <= r2 -> 0 <= r1 + r2.
 
940
Proof.
 
941
  intros x y; intros; apply Rle_trans with x;
 
942
    [ assumption
 
943
      | pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l;
 
944
        assumption ].
 
945
Qed.
 
946
 
 
947
(**********)
 
948
Lemma sum_inequa_Rle_lt :
 
949
  forall a x b c y d:R,
 
950
    a <= x -> x < b -> c < y -> y <= d -> a + c < x + y < b + d.
 
951
Proof.
 
952
  intros; split.
 
953
  apply Rlt_le_trans with (a + y); auto with real.
 
954
  apply Rlt_le_trans with (b + y); auto with real.
 
955
Qed.
 
956
 
 
957
(** *** Cancellation *)
 
958
 
 
959
Lemma Rplus_lt_reg_r : forall r r1 r2, r + r1 < r + r2 -> r1 < r2.
 
960
Proof.
 
961
  intros; cut (- r + r + r1 < - r + r + r2).
 
962
  rewrite Rplus_opp_l.
 
963
  elim (Rplus_ne r1); elim (Rplus_ne r2); intros; rewrite <- H3; rewrite <- H1;
 
964
    auto with zarith real.
 
965
  rewrite Rplus_assoc; rewrite Rplus_assoc;
 
966
    apply (Rplus_lt_compat_l (- r) (r + r1) (r + r2) H).
 
967
Qed.
 
968
 
 
969
Lemma Rplus_le_reg_l : forall r r1 r2, r + r1 <= r + r2 -> r1 <= r2.
 
970
Proof.
 
971
  unfold Rle in |- *; intros; elim H; intro.
 
972
  left; apply (Rplus_lt_reg_r r r1 r2 H0).
 
973
  right; apply (Rplus_eq_reg_l r r1 r2 H0).
 
974
Qed.
 
975
 
 
976
Lemma Rplus_gt_reg_l : forall r r1 r2, r + r1 > r + r2 -> r1 > r2.
 
977
Proof.
 
978
  unfold Rgt in |- *; intros; apply (Rplus_lt_reg_r r r2 r1 H).
 
979
Qed.
 
980
 
 
981
Lemma Rplus_ge_reg_l : forall r r1 r2, r + r1 >= r + r2 -> r1 >= r2.
 
982
Proof.
 
983
  intros; apply Rle_ge; apply Rplus_le_reg_l with r; auto with real.
 
984
Qed.
 
985
 
 
986
(**********)
 
987
Lemma Rplus_le_reg_pos_r :
 
988
  forall r1 r2 r3, 0 <= r2 -> r1 + r2 <= r3 -> r1 <= r3.
 
989
Proof.
 
990
  intros x y z; intros; apply Rle_trans with (x + y);
 
991
    [ pattern x at 1; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l;
 
992
      assumption
 
993
      | assumption ].
 
994
Qed.
 
995
 
 
996
Lemma Rplus_lt_reg_pos_r : forall r1 r2 r3, 0 <= r2 -> r1 + r2 < r3 -> r1 < r3.
 
997
Proof.
 
998
  intros x y z; intros; apply Rle_lt_trans with (x + y);
 
999
    [ pattern x at 1; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l;
 
1000
      assumption
 
1001
      | assumption ].
 
1002
Qed.
 
1003
 
 
1004
Lemma Rplus_ge_reg_neg_r :
 
1005
  forall r1 r2 r3, 0 >= r2 -> r1 + r2 >= r3 -> r1 >= r3.
 
1006
Proof.
 
1007
  intros x y z; intros; apply Rge_trans with (x + y);
 
1008
    [ pattern x at 1; rewrite <- (Rplus_0_r x); apply Rplus_ge_compat_l;
 
1009
      assumption
 
1010
      | assumption ].
 
1011
Qed.
 
1012
 
 
1013
Lemma Rplus_gt_reg_neg_r : forall r1 r2 r3, 0 >= r2 -> r1 + r2 > r3 -> r1 > r3.
 
1014
Proof.
 
1015
  intros x y z; intros; apply Rge_gt_trans with (x + y);
 
1016
    [ pattern x at 1; rewrite <- (Rplus_0_r x); apply Rplus_ge_compat_l;
 
1017
      assumption
 
1018
      | assumption ].
 
1019
Qed.
 
1020
 
 
1021
(*********************************************************)
 
1022
(** ** Order and opposite                                *)
 
1023
(*********************************************************)
 
1024
 
 
1025
(** *** Contravariant compatibility *)
 
1026
 
 
1027
Lemma Ropp_gt_lt_contravar : forall r1 r2, r1 > r2 -> - r1 < - r2.
 
1028
Proof.
 
1029
  unfold Rgt in |- *; intros.
 
1030
  apply (Rplus_lt_reg_r (r2 + r1)).
 
1031
  replace (r2 + r1 + - r1) with r2.
 
1032
  replace (r2 + r1 + - r2) with r1.
 
1033
  trivial.
 
1034
  ring.
 
1035
  ring.
 
1036
Qed.
 
1037
Hint Resolve Ropp_gt_lt_contravar.
 
1038
 
 
1039
Lemma Ropp_lt_gt_contravar : forall r1 r2, r1 < r2 -> - r1 > - r2.
 
1040
Proof.
 
1041
  unfold Rgt in |- *; auto with real.
 
1042
Qed.
 
1043
Hint Resolve Ropp_lt_gt_contravar: real.
 
1044
 
 
1045
(**********)
 
1046
Lemma Ropp_lt_contravar : forall r1 r2, r2 < r1 -> - r1 < - r2.
 
1047
Proof.
 
1048
  auto with real.
 
1049
Qed.
 
1050
Hint Resolve Ropp_lt_contravar: real.
 
1051
 
 
1052
Lemma Ropp_gt_contravar : forall r1 r2, r2 > r1 -> - r1 > - r2.
 
1053
Proof. auto with real. Qed.
 
1054
 
 
1055
(**********)
 
1056
Lemma Ropp_le_ge_contravar : forall r1 r2, r1 <= r2 -> - r1 >= - r2.
 
1057
Proof.
 
1058
  unfold Rge; intros r1 r2 [H| H]; auto with real.
 
1059
Qed.
 
1060
Hint Resolve Ropp_le_ge_contravar: real.
 
1061
 
 
1062
Lemma Ropp_ge_le_contravar : forall r1 r2, r1 >= r2 -> - r1 <= - r2.
 
1063
Proof.
 
1064
  unfold Rle; intros r1 r2 [H| H]; auto with real.
 
1065
Qed.
 
1066
Hint Resolve Ropp_ge_le_contravar: real.
 
1067
 
 
1068
(**********)
 
1069
Lemma Ropp_le_contravar : forall r1 r2, r2 <= r1 -> - r1 <= - r2.
 
1070
Proof.
 
1071
  intros r1 r2 H; elim H; auto with real.
 
1072
Qed.
 
1073
Hint Resolve Ropp_le_contravar: real.
 
1074
 
 
1075
Lemma Ropp_ge_contravar : forall r1 r2, r2 >= r1 -> - r1 >= - r2.
 
1076
Proof. auto using Ropp_le_contravar with real. Qed.
 
1077
 
 
1078
(**********)
 
1079
Lemma Ropp_0_lt_gt_contravar : forall r, 0 < r -> 0 > - r.
 
1080
Proof.
 
1081
  intros; replace 0 with (-0); auto with real.
 
1082
Qed.
 
1083
Hint Resolve Ropp_0_lt_gt_contravar: real.
 
1084
 
 
1085
Lemma Ropp_0_gt_lt_contravar : forall r, 0 > r -> 0 < - r.
 
1086
Proof.
 
1087
  intros; replace 0 with (-0); auto with real.
 
1088
Qed.
 
1089
Hint Resolve Ropp_0_gt_lt_contravar: real.
 
1090
 
 
1091
(**********)
 
1092
Lemma Ropp_lt_gt_0_contravar : forall r, r > 0 -> - r < 0.
 
1093
Proof.
 
1094
  intros; rewrite <- Ropp_0; auto with real.
 
1095
Qed.
 
1096
Hint Resolve Ropp_lt_gt_0_contravar: real.
 
1097
 
 
1098
Lemma Ropp_gt_lt_0_contravar : forall r, r < 0 -> - r > 0.
 
1099
Proof.
 
1100
  intros; rewrite <- Ropp_0; auto with real.
 
1101
Qed.
 
1102
Hint Resolve Ropp_gt_lt_0_contravar: real.
 
1103
 
 
1104
(**********)
 
1105
Lemma Ropp_0_le_ge_contravar : forall r, 0 <= r -> 0 >= - r.
 
1106
Proof.
 
1107
  intros; replace 0 with (-0); auto with real.
 
1108
Qed.
 
1109
Hint Resolve Ropp_0_le_ge_contravar: real.
 
1110
 
 
1111
Lemma Ropp_0_ge_le_contravar : forall r, 0 >= r -> 0 <= - r.
 
1112
Proof.
 
1113
  intros; replace 0 with (-0); auto with real.
 
1114
Qed.
 
1115
Hint Resolve Ropp_0_ge_le_contravar: real.
 
1116
 
 
1117
(** *** Cancellation *)
 
1118
 
 
1119
Lemma Ropp_lt_cancel : forall r1 r2, - r2 < - r1 -> r1 < r2.
 
1120
Proof.
 
1121
  intros x y H'.
 
1122
  rewrite <- (Ropp_involutive x); rewrite <- (Ropp_involutive y);
 
1123
    auto with real.
 
1124
Qed.
 
1125
Hint Immediate Ropp_lt_cancel: real.
 
1126
 
 
1127
Lemma Ropp_gt_cancel : forall r1 r2, - r2 > - r1 -> r1 > r2.
 
1128
Proof. auto using Ropp_lt_cancel with rorders. Qed.
 
1129
 
 
1130
Lemma Ropp_le_cancel : forall r1 r2, - r2 <= - r1 -> r1 <= r2.
 
1131
Proof.
 
1132
  intros x y H.
 
1133
  elim H; auto with real.
 
1134
  intro H1; rewrite <- (Ropp_involutive x); rewrite <- (Ropp_involutive y);
 
1135
    rewrite H1; auto with real.
 
1136
Qed.
 
1137
Hint Immediate Ropp_le_cancel: real.
 
1138
 
 
1139
Lemma Ropp_ge_cancel : forall r1 r2, - r2 >= - r1 -> r1 >= r2.
 
1140
Proof. auto using Ropp_le_cancel with rorders. Qed.
 
1141
 
 
1142
(*********************************************************)
 
1143
(** ** Order and multiplication                          *)
 
1144
(*********************************************************)
 
1145
 
 
1146
(** Remark: [Rmult_lt_compat_l] is an axiom *)
 
1147
 
 
1148
(** *** Covariant compatibility *)
 
1149
 
 
1150
Lemma Rmult_lt_compat_r : forall r r1 r2, 0 < r -> r1 < r2 -> r1 * r < r2 * r.
 
1151
Proof.
 
1152
  intros; rewrite (Rmult_comm r1 r); rewrite (Rmult_comm r2 r); auto with real.
 
1153
Qed.
 
1154
Hint Resolve Rmult_lt_compat_r.
 
1155
 
 
1156
Lemma Rmult_gt_compat_r : forall r r1 r2, r > 0 -> r1 > r2 -> r1 * r > r2 * r.
 
1157
Proof. eauto using Rmult_lt_compat_r with rorders. Qed.
 
1158
 
 
1159
Lemma Rmult_gt_compat_l : forall r r1 r2, r > 0 -> r1 > r2 -> r * r1 > r * r2.
 
1160
Proof. eauto using Rmult_lt_compat_l with rorders. Qed.
 
1161
 
 
1162
(**********)
 
1163
Lemma Rmult_le_compat_l :
 
1164
  forall r r1 r2, 0 <= r -> r1 <= r2 -> r * r1 <= r * r2.
 
1165
Proof.
 
1166
  intros r r1 r2 H H0; destruct H; destruct H0; unfold Rle in |- *;
 
1167
    auto with real.
 
1168
  right; rewrite <- H; do 2 rewrite Rmult_0_l; reflexivity.
 
1169
Qed.
 
1170
Hint Resolve Rmult_le_compat_l: real.
 
1171
 
 
1172
Lemma Rmult_le_compat_r :
 
1173
  forall r r1 r2, 0 <= r -> r1 <= r2 -> r1 * r <= r2 * r.
 
1174
Proof.
 
1175
  intros r r1 r2 H; rewrite (Rmult_comm r1 r); rewrite (Rmult_comm r2 r);
 
1176
    auto with real.
 
1177
Qed.
 
1178
Hint Resolve Rmult_le_compat_r: real.
 
1179
 
 
1180
Lemma Rmult_ge_compat_l :
 
1181
  forall r r1 r2, r >= 0 -> r1 >= r2 -> r * r1 >= r * r2.
 
1182
Proof. eauto using Rmult_le_compat_l with rorders. Qed.
 
1183
 
 
1184
Lemma Rmult_ge_compat_r :
 
1185
  forall r r1 r2, r >= 0 -> r1 >= r2 -> r1 * r >= r2 * r.
 
1186
Proof. eauto using Rmult_le_compat_r with rorders. Qed.
 
1187
 
 
1188
(**********)
 
1189
Lemma Rmult_le_compat :
 
1190
  forall r1 r2 r3 r4,
 
1191
    0 <= r1 -> 0 <= r3 -> r1 <= r2 -> r3 <= r4 -> r1 * r3 <= r2 * r4.
 
1192
Proof.
 
1193
  intros x y z t H' H'0 H'1 H'2.
 
1194
  apply Rle_trans with (r2 := x * t); auto with real.
 
1195
  repeat rewrite (fun x => Rmult_comm x t).
 
1196
  apply Rmult_le_compat_l; auto.
 
1197
  apply Rle_trans with z; auto.
 
1198
Qed.
 
1199
Hint Resolve Rmult_le_compat: real.
 
1200
 
 
1201
Lemma Rmult_ge_compat :
 
1202
  forall r1 r2 r3 r4,
 
1203
    r2 >= 0 -> r4 >= 0 -> r1 >= r2 -> r3 >= r4 -> r1 * r3 >= r2 * r4.
 
1204
Proof. auto with real rorders. Qed.
 
1205
 
 
1206
Lemma Rmult_gt_0_lt_compat :
 
1207
  forall r1 r2 r3 r4,
 
1208
    r3 > 0 -> r2 > 0 -> r1 < r2 -> r3 < r4 -> r1 * r3 < r2 * r4.
 
1209
Proof.
 
1210
  intros; apply Rlt_trans with (r2 * r3); auto with real.
 
1211
Qed.
 
1212
 
 
1213
(*********)
 
1214
Lemma Rmult_le_0_lt_compat :
 
1215
  forall r1 r2 r3 r4,
 
1216
    0 <= r1 -> 0 <= r3 -> r1 < r2 -> r3 < r4 -> r1 * r3 < r2 * r4.
 
1217
Proof.
 
1218
  intros; apply Rle_lt_trans with (r2 * r3);
 
1219
    [ apply Rmult_le_compat_r; [ assumption | left; assumption ]
 
1220
      | apply Rmult_lt_compat_l;
 
1221
        [ apply Rle_lt_trans with r1; assumption | assumption ] ].
 
1222
Qed.
 
1223
 
 
1224
(*********)
 
1225
Lemma Rmult_lt_0_compat : forall r1 r2, 0 < r1 -> 0 < r2 -> 0 < r1 * r2.
 
1226
Proof. intros; replace 0 with (0 * r2); auto with real. Qed.
 
1227
 
 
1228
Lemma Rmult_gt_0_compat : forall r1 r2, r1 > 0 -> r2 > 0 -> r1 * r2 > 0.
 
1229
Proof Rmult_lt_0_compat.
 
1230
 
 
1231
(** *** Contravariant compatibility *)
 
1232
 
 
1233
Lemma Rmult_le_compat_neg_l :
 
1234
  forall r r1 r2, r <= 0 -> r1 <= r2 -> r * r2 <= r * r1.
 
1235
Proof.
 
1236
  intros; replace r with (- - r); auto with real.
 
1237
  do 2 rewrite (Ropp_mult_distr_l_reverse (- r)).
 
1238
  apply Ropp_le_contravar; auto with real.
 
1239
Qed.
 
1240
Hint Resolve Rmult_le_compat_neg_l: real.
 
1241
 
 
1242
Lemma Rmult_le_ge_compat_neg_l :
 
1243
  forall r r1 r2, r <= 0 -> r1 <= r2 -> r * r1 >= r * r2.
 
1244
Proof.
 
1245
  intros; apply Rle_ge; auto with real.
 
1246
Qed.
 
1247
Hint Resolve Rmult_le_ge_compat_neg_l: real.
 
1248
 
 
1249
Lemma Rmult_lt_gt_compat_neg_l :
 
1250
  forall r r1 r2, r < 0 -> r1 < r2 -> r * r1 > r * r2.
 
1251
Proof.
 
1252
  intros; replace r with (- - r); auto with real.
 
1253
  rewrite (Ropp_mult_distr_l_reverse (- r));
 
1254
    rewrite (Ropp_mult_distr_l_reverse (- r)).
 
1255
  apply Ropp_lt_gt_contravar; auto with real.
 
1256
Qed.
 
1257
 
 
1258
(** *** Cancellation *)
 
1259
 
 
1260
Lemma Rmult_lt_reg_l : forall r r1 r2, 0 < r -> r * r1 < r * r2 -> r1 < r2.
 
1261
Proof.
 
1262
  intros z x y H H0.
 
1263
  case (Rtotal_order x y); intros Eq0; auto; elim Eq0; clear Eq0; intros Eq0.
 
1264
  rewrite Eq0 in H0; elimtype False; apply (Rlt_irrefl (z * y)); auto.
 
1265
  generalize (Rmult_lt_compat_l z y x H Eq0); intro; elimtype False;
 
1266
    generalize (Rlt_trans (z * x) (z * y) (z * x) H0 H1); 
 
1267
      intro; apply (Rlt_irrefl (z * x)); auto.
 
1268
Qed.
 
1269
 
 
1270
Lemma Rmult_gt_reg_l : forall r r1 r2, 0 < r -> r * r1 < r * r2 -> r1 < r2.
 
1271
Proof. eauto using Rmult_lt_reg_l with rorders. Qed.
 
1272
 
 
1273
Lemma Rmult_le_reg_l : forall r r1 r2, 0 < r -> r * r1 <= r * r2 -> r1 <= r2.
 
1274
Proof.
 
1275
  intros z x y H H0; case H0; auto with real.
 
1276
  intros H1; apply Rlt_le.
 
1277
  apply Rmult_lt_reg_l with (r := z); auto.
 
1278
  intros H1; replace x with (/ z * (z * x)); auto with real.
 
1279
  replace y with (/ z * (z * y)).
 
1280
  rewrite H1; auto with real.
 
1281
  rewrite <- Rmult_assoc; rewrite Rinv_l; auto with real.
 
1282
  rewrite <- Rmult_assoc; rewrite Rinv_l; auto with real.
 
1283
Qed.
 
1284
 
 
1285
(*********************************************************)
 
1286
(** ** Order and substraction                            *)
 
1287
(*********************************************************)
 
1288
 
 
1289
Lemma Rlt_minus : forall r1 r2, r1 < r2 -> r1 - r2 < 0.
 
1290
Proof.
 
1291
  intros; apply (Rplus_lt_reg_r r2).
 
1292
  replace (r2 + (r1 - r2)) with r1.
 
1293
  replace (r2 + 0) with r2; auto with real.
 
1294
  ring.
 
1295
Qed.
 
1296
Hint Resolve Rlt_minus: real.
 
1297
 
 
1298
Lemma Rgt_minus : forall r1 r2, r1 > r2 -> r1 - r2 > 0.
 
1299
Proof. 
 
1300
  intros; apply (Rplus_lt_reg_r r2).
 
1301
  replace (r2 + (r1 - r2)) with r1.
 
1302
  replace (r2 + 0) with r2; auto with real.
 
1303
  ring.
 
1304
Qed.
 
1305
 
 
1306
(**********)
 
1307
Lemma Rle_minus : forall r1 r2, r1 <= r2 -> r1 - r2 <= 0.
 
1308
Proof.
 
1309
  destruct 1; unfold Rle in |- *; auto with real.
 
1310
Qed.
 
1311
 
 
1312
Lemma Rge_minus : forall r1 r2, r1 >= r2 -> r1 - r2 >= 0.
 
1313
Proof. 
 
1314
  destruct 1.
 
1315
    auto using Rgt_minus, Rgt_ge.
 
1316
    right; auto using Rminus_diag_eq with rorders.
 
1317
Qed.
 
1318
 
 
1319
(**********)
 
1320
Lemma Rminus_lt : forall r1 r2, r1 - r2 < 0 -> r1 < r2.
 
1321
Proof.
 
1322
  intros; replace r1 with (r1 - r2 + r2).
 
1323
  pattern r2 at 3 in |- *; replace r2 with (0 + r2); auto with real.
 
1324
  ring.
 
1325
Qed.
 
1326
 
 
1327
Lemma Rminus_gt : forall r1 r2, r1 - r2 > 0 -> r1 > r2.
 
1328
Proof.
 
1329
  intros; replace r2 with (0 + r2); auto with real.
 
1330
  replace r1 with (r1 - r2 + r2).
 
1331
  apply Rplus_gt_compat_r; assumption.
 
1332
  ring.
 
1333
Qed.
 
1334
 
 
1335
(**********)
 
1336
Lemma Rminus_le : forall r1 r2, r1 - r2 <= 0 -> r1 <= r2.
 
1337
Proof.
 
1338
  intros; replace r1 with (r1 - r2 + r2).
 
1339
  pattern r2 at 3 in |- *; replace r2 with (0 + r2); auto with real.
 
1340
  ring.
 
1341
Qed.
 
1342
 
 
1343
Lemma Rminus_ge : forall r1 r2, r1 - r2 >= 0 -> r1 >= r2.
 
1344
Proof.
 
1345
  intros; replace r2 with (0 + r2); auto with real.
 
1346
  replace r1 with (r1 - r2 + r2).
 
1347
  apply Rplus_ge_compat_r; assumption.
 
1348
  ring.
 
1349
Qed.
 
1350
 
 
1351
(**********)
 
1352
Lemma tech_Rplus : forall r (s:R), 0 <= r -> 0 < s -> r + s <> 0.
 
1353
Proof.
 
1354
  intros; apply sym_not_eq; apply Rlt_not_eq.
 
1355
  rewrite Rplus_comm; replace 0 with (0 + 0); auto with real.
 
1356
Qed.
 
1357
Hint Immediate tech_Rplus: real.
 
1358
 
 
1359
(*********************************************************)
 
1360
(** ** Order and square function                         *)
 
1361
(*********************************************************)
 
1362
 
 
1363
Lemma Rle_0_sqr : forall r, 0 <= Rsqr r.
 
1364
Proof.
 
1365
  intro; case (Rlt_le_dec r 0); unfold Rsqr in |- *; intro.
 
1366
  replace (r * r) with (- r * - r); auto with real.
 
1367
  replace 0 with (- r * 0); auto with real.
 
1368
  replace 0 with (0 * r); auto with real.
 
1369
Qed.
 
1370
 
 
1371
(***********)
 
1372
Lemma Rlt_0_sqr : forall r, r <> 0 -> 0 < Rsqr r.
 
1373
Proof.
 
1374
  intros; case (Rdichotomy r 0); trivial; unfold Rsqr in |- *; intro.
 
1375
  replace (r * r) with (- r * - r); auto with real.
 
1376
  replace 0 with (- r * 0); auto with real.
 
1377
  replace 0 with (0 * r); auto with real.
 
1378
Qed.
 
1379
Hint Resolve Rle_0_sqr Rlt_0_sqr: real.
 
1380
 
 
1381
(***********)
 
1382
Lemma Rplus_sqr_eq_0_l : forall r1 r2, Rsqr r1 + Rsqr r2 = 0 -> r1 = 0.
 
1383
Proof.
 
1384
  intros a b; intros; apply Rsqr_0_uniq; apply Rplus_eq_0_l with (Rsqr b);
 
1385
    auto with real.
 
1386
Qed.
 
1387
 
 
1388
Lemma Rplus_sqr_eq_0 :
 
1389
  forall r1 r2, Rsqr r1 + Rsqr r2 = 0 -> r1 = 0 /\ r2 = 0.
 
1390
Proof.
 
1391
  intros a b; split.
 
1392
  apply Rplus_sqr_eq_0_l with b; auto with real.
 
1393
  apply Rplus_sqr_eq_0_l with a; auto with real.
 
1394
  rewrite Rplus_comm; auto with real.
 
1395
Qed.
 
1396
 
 
1397
(*********************************************************)
 
1398
(** ** Zero is less than one                             *)
 
1399
(*********************************************************)
 
1400
 
 
1401
Lemma Rlt_0_1 : 0 < 1.
 
1402
Proof.
 
1403
  replace 1 with (Rsqr 1); auto with real.
 
1404
  unfold Rsqr in |- *; auto with real.
 
1405
Qed.
 
1406
Hint Resolve Rlt_0_1: real.
 
1407
 
 
1408
Lemma Rle_0_1 : 0 <= 1.
 
1409
Proof.
 
1410
  left.
 
1411
  exact Rlt_0_1.
 
1412
Qed.
 
1413
 
 
1414
(*********************************************************)
 
1415
(** ** Order and inverse                                 *)
 
1416
(*********************************************************)
 
1417
 
 
1418
Lemma Rinv_0_lt_compat : forall r, 0 < r -> 0 < / r.
 
1419
Proof.
 
1420
  intros; apply Rnot_le_lt; red in |- *; intros.
 
1421
  absurd (1 <= 0); auto with real.
 
1422
  replace 1 with (r * / r); auto with real.
 
1423
  replace 0 with (r * 0); auto with real.
 
1424
Qed.
 
1425
Hint Resolve Rinv_0_lt_compat: real.
 
1426
 
 
1427
(*********)
 
1428
Lemma Rinv_lt_0_compat : forall r, r < 0 -> / r < 0.
 
1429
Proof.
 
1430
  intros; apply Rnot_le_lt; red in |- *; intros.
 
1431
  absurd (1 <= 0); auto with real.
 
1432
  replace 1 with (r * / r); auto with real.
 
1433
  replace 0 with (r * 0); auto with real.
 
1434
Qed.
 
1435
Hint Resolve Rinv_lt_0_compat: real.
 
1436
 
 
1437
(*********)
 
1438
Lemma Rinv_lt_contravar : forall r1 r2, 0 < r1 * r2 -> r1 < r2 -> / r2 < / r1.
 
1439
Proof.
 
1440
  intros; apply Rmult_lt_reg_l with (r1 * r2); auto with real.
 
1441
  case (Rmult_neq_0_reg r1 r2); intros; auto with real.
 
1442
  replace (r1 * r2 * / r2) with r1.
 
1443
  replace (r1 * r2 * / r1) with r2; trivial.
 
1444
  symmetry  in |- *; auto with real.
 
1445
  symmetry  in |- *; auto with real.
 
1446
Qed.
 
1447
 
 
1448
Lemma Rinv_1_lt_contravar : forall r1 r2, 1 <= r1 -> r1 < r2 -> / r2 < / r1.
 
1449
Proof.
 
1450
  intros x y H' H'0.
 
1451
  cut (0 < x); [ intros Lt0 | apply Rlt_le_trans with (r2 := 1) ];
 
1452
    auto with real.
 
1453
  apply Rmult_lt_reg_l with (r := x); auto with real.
 
1454
  rewrite (Rmult_comm x (/ x)); rewrite Rinv_l; auto with real.
 
1455
  apply Rmult_lt_reg_l with (r := y); auto with real.
 
1456
  apply Rlt_trans with (r2 := x); auto.
 
1457
  cut (y * (x * / y) = x).
 
1458
  intro H1; rewrite H1; rewrite (Rmult_1_r y); auto.
 
1459
  rewrite (Rmult_comm x); rewrite <- Rmult_assoc; rewrite (Rmult_comm y (/ y));
 
1460
    rewrite Rinv_l; auto with real.
 
1461
  apply Rlt_dichotomy_converse; right.
 
1462
  red in |- *; apply Rlt_trans with (r2 := x); auto with real.
 
1463
Qed.
 
1464
Hint Resolve Rinv_1_lt_contravar: real.
 
1465
 
 
1466
(*********************************************************)        
 
1467
(** ** Miscellaneous                                     *)
 
1468
(*********************************************************)
 
1469
 
 
1470
(**********)
 
1471
Lemma Rle_lt_0_plus_1 : forall r, 0 <= r -> 0 < r + 1.
 
1472
Proof.
 
1473
  intros.
 
1474
  apply Rlt_le_trans with 1; auto with real.
 
1475
  pattern 1 at 1 in |- *; replace 1 with (0 + 1); auto with real.
 
1476
Qed.
 
1477
Hint Resolve Rle_lt_0_plus_1: real.
 
1478
 
 
1479
(**********)
 
1480
Lemma Rlt_plus_1 : forall r, r < r + 1.
 
1481
Proof.
 
1482
  intros.
 
1483
  pattern r at 1 in |- *; replace r with (r + 0); auto with real.
 
1484
Qed.
 
1485
Hint Resolve Rlt_plus_1: real.
 
1486
 
 
1487
(**********)
 
1488
Lemma tech_Rgt_minus : forall r1 r2, 0 < r2 -> r1 > r1 - r2.
 
1489
Proof.
 
1490
  red in |- *; unfold Rminus in |- *; intros.
 
1491
  pattern r1 at 2 in |- *; replace r1 with (r1 + 0); auto with real.
 
1492
Qed.
 
1493
 
 
1494
(*********************************************************) 
 
1495
(** ** Injection from [N] to [R]                         *)
 
1496
(*********************************************************)
 
1497
 
 
1498
(**********)
 
1499
Lemma S_INR : forall n:nat, INR (S n) = INR n + 1.
 
1500
Proof.
 
1501
  intro; case n; auto with real.
 
1502
Qed.
 
1503
 
 
1504
(**********)
 
1505
Lemma S_O_plus_INR : forall n:nat, INR (1 + n) = INR 1 + INR n.
 
1506
Proof.
 
1507
  intro; simpl in |- *; case n; intros; auto with real.
 
1508
Qed.
 
1509
 
 
1510
(**********)
 
1511
Lemma plus_INR : forall n m:nat, INR (n + m) = INR n + INR m. 
 
1512
Proof.
 
1513
  intros n m; induction  n as [| n Hrecn].
 
1514
  simpl in |- *; auto with real.
 
1515
  replace (S n + m)%nat with (S (n + m)); auto with arith.
 
1516
  repeat rewrite S_INR.
 
1517
  rewrite Hrecn; ring.
 
1518
Qed.
 
1519
Hint Resolve plus_INR: real.
 
1520
 
 
1521
(**********)
 
1522
Lemma minus_INR : forall n m:nat, (m <= n)%nat -> INR (n - m) = INR n - INR m.
 
1523
Proof.
 
1524
  intros n m le; pattern m, n in |- *; apply le_elim_rel; auto with real.
 
1525
  intros; rewrite <- minus_n_O; auto with real.
 
1526
  intros; repeat rewrite S_INR; simpl in |- *.
 
1527
  rewrite H0; ring.
 
1528
Qed.
 
1529
Hint Resolve minus_INR: real.
 
1530
 
 
1531
(*********)
 
1532
Lemma mult_INR : forall n m:nat, INR (n * m) = INR n * INR m.
 
1533
Proof.
 
1534
  intros n m; induction  n as [| n Hrecn].
 
1535
  simpl in |- *; auto with real.
 
1536
  intros; repeat rewrite S_INR; simpl in |- *.
 
1537
  rewrite plus_INR; rewrite Hrecn; ring.
 
1538
Qed.
 
1539
Hint Resolve mult_INR: real.
 
1540
 
 
1541
(*********)
 
1542
Lemma lt_0_INR : forall n:nat, (0 < n)%nat -> 0 < INR n.
 
1543
Proof.
 
1544
  simple induction 1; intros; auto with real.
 
1545
  rewrite S_INR; auto with real.
 
1546
Qed.
 
1547
Hint Resolve lt_0_INR: real.
 
1548
 
 
1549
Lemma lt_INR : forall n m:nat, (n < m)%nat -> INR n < INR m.
 
1550
Proof.
 
1551
  simple induction 1; intros; auto with real.
 
1552
  rewrite S_INR; auto with real.
 
1553
  rewrite S_INR; apply Rlt_trans with (INR m0); auto with real.
 
1554
Qed.
 
1555
Hint Resolve lt_INR: real.
 
1556
 
 
1557
Lemma lt_1_INR : forall n:nat, (1 < n)%nat -> 1 < INR n.
 
1558
Proof.
 
1559
  intros; replace 1 with (INR 1); auto with real.
 
1560
Qed.
 
1561
Hint Resolve lt_1_INR: real.
 
1562
 
 
1563
(**********)
 
1564
Lemma pos_INR_nat_of_P : forall p:positive, 0 < INR (nat_of_P p).
 
1565
Proof.
 
1566
  intro; apply lt_0_INR.
 
1567
  simpl in |- *; auto with real.
 
1568
  apply lt_O_nat_of_P.
 
1569
Qed.
 
1570
Hint Resolve pos_INR_nat_of_P: real.
 
1571
 
 
1572
(**********)
 
1573
Lemma pos_INR : forall n:nat, 0 <= INR n.
 
1574
Proof.
 
1575
  intro n; case n.
 
1576
  simpl in |- *; auto with real.
 
1577
  auto with arith real.
 
1578
Qed.
 
1579
Hint Resolve pos_INR: real.
 
1580
 
 
1581
Lemma INR_lt : forall n m:nat, INR n < INR m -> (n < m)%nat.
 
1582
Proof.
 
1583
  double induction n m; intros.
 
1584
  simpl in |- *; elimtype False; apply (Rlt_irrefl 0); auto.
 
1585
  auto with arith.
 
1586
  generalize (pos_INR (S n0)); intro; cut (INR 0 = 0);
 
1587
    [ intro H2; rewrite H2 in H0; idtac | simpl in |- *; trivial ]. 
 
1588
  generalize (Rle_lt_trans 0 (INR (S n0)) 0 H1 H0); intro; elimtype False;
 
1589
    apply (Rlt_irrefl 0); auto.
 
1590
  do 2 rewrite S_INR in H1; cut (INR n1 < INR n0).
 
1591
  intro H2; generalize (H0 n0 H2); intro; auto with arith.
 
1592
  apply (Rplus_lt_reg_r 1 (INR n1) (INR n0)).
 
1593
  rewrite Rplus_comm; rewrite (Rplus_comm 1 (INR n0)); trivial.
 
1594
Qed.
 
1595
Hint Resolve INR_lt: real.
 
1596
 
 
1597
(*********)
 
1598
Lemma le_INR : forall n m:nat, (n <= m)%nat -> INR n <= INR m.
 
1599
Proof.
 
1600
  simple induction 1; intros; auto with real.
 
1601
  rewrite S_INR.
 
1602
  apply Rle_trans with (INR m0); auto with real.
 
1603
Qed.
 
1604
Hint Resolve le_INR: real.
 
1605
 
 
1606
(**********)
 
1607
Lemma INR_not_0 : forall n:nat, INR n <> 0 -> n <> 0%nat.
 
1608
Proof.
 
1609
  red in |- *; intros n H H1.
 
1610
  apply H.
 
1611
  rewrite H1; trivial.
 
1612
Qed.
 
1613
Hint Immediate INR_not_0: real.
 
1614
 
 
1615
(**********)
 
1616
Lemma not_0_INR : forall n:nat, n <> 0%nat -> INR n <> 0.
 
1617
Proof.
 
1618
  intro n; case n.
 
1619
  intro; absurd (0%nat = 0%nat); trivial.
 
1620
  intros; rewrite S_INR.
 
1621
  apply Rgt_not_eq; red in |- *; auto with real.
 
1622
Qed.
 
1623
Hint Resolve not_0_INR: real.
 
1624
 
 
1625
Lemma not_INR : forall n m:nat, n <> m -> INR n <> INR m.
 
1626
Proof.
 
1627
  intros n m H; case (le_or_lt n m); intros H1.
 
1628
  case (le_lt_or_eq _ _ H1); intros H2.
 
1629
  apply Rlt_dichotomy_converse; auto with real.
 
1630
  elimtype False; auto.
 
1631
  apply sym_not_eq; apply Rlt_dichotomy_converse; auto with real.
 
1632
Qed.
 
1633
Hint Resolve not_INR: real.
 
1634
 
 
1635
Lemma INR_eq : forall n m:nat, INR n = INR m -> n = m.
 
1636
Proof.
 
1637
  intros; case (le_or_lt n m); intros H1.
 
1638
  case (le_lt_or_eq _ _ H1); intros H2; auto.
 
1639
  cut (n <> m).
 
1640
  intro H3; generalize (not_INR n m H3); intro H4; elimtype False; auto.
 
1641
  omega.
 
1642
  symmetry  in |- *; cut (m <> n).
 
1643
  intro H3; generalize (not_INR m n H3); intro H4; elimtype False; auto.
 
1644
  omega.
 
1645
Qed.
 
1646
Hint Resolve INR_eq: real.
 
1647
 
 
1648
Lemma INR_le : forall n m:nat, INR n <= INR m -> (n <= m)%nat.
 
1649
Proof.
 
1650
  intros; elim H; intro.
 
1651
  generalize (INR_lt n m H0); intro; auto with arith.
 
1652
  generalize (INR_eq n m H0); intro; rewrite H1; auto.
 
1653
Qed.
 
1654
Hint Resolve INR_le: real.
 
1655
 
 
1656
Lemma not_1_INR : forall n:nat, n <> 1%nat -> INR n <> 1.
 
1657
Proof.
 
1658
  replace 1 with (INR 1); auto with real.
 
1659
Qed.
 
1660
Hint Resolve not_1_INR: real.
 
1661
 
 
1662
(*********************************************************) 
 
1663
(** ** Injection from [Z] to [R]                         *)
 
1664
(*********************************************************)
 
1665
 
 
1666
 
 
1667
(**********)
 
1668
Lemma IZN : forall n:Z, (0 <= n)%Z ->  exists m : nat, n = Z_of_nat m.
 
1669
Proof.
 
1670
  intros z; idtac; apply Z_of_nat_complete; assumption.
 
1671
Qed.
 
1672
 
 
1673
(**********)
 
1674
Lemma INR_IZR_INZ : forall n:nat, INR n = IZR (Z_of_nat n).
 
1675
Proof.
 
1676
  simple induction n; auto with real.
 
1677
  intros; simpl in |- *; rewrite nat_of_P_o_P_of_succ_nat_eq_succ;
 
1678
    auto with real.
 
1679
Qed.
 
1680
 
 
1681
Lemma plus_IZR_NEG_POS :
 
1682
  forall p q:positive, IZR (Zpos p + Zneg q) = IZR (Zpos p) + IZR (Zneg q).
 
1683
Proof.
 
1684
  intros.
 
1685
  case (lt_eq_lt_dec (nat_of_P p) (nat_of_P q)).
 
1686
  intros [H| H]; simpl in |- *.
 
1687
  rewrite nat_of_P_lt_Lt_compare_complement_morphism; simpl in |- *; trivial.
 
1688
  rewrite (nat_of_P_minus_morphism q p).
 
1689
  rewrite minus_INR; auto with arith; ring.
 
1690
  apply ZC2; apply nat_of_P_lt_Lt_compare_complement_morphism; trivial.
 
1691
  rewrite (nat_of_P_inj p q); trivial.
 
1692
  rewrite Pcompare_refl; simpl in |- *; auto with real.
 
1693
  intro H; simpl in |- *.
 
1694
  rewrite nat_of_P_gt_Gt_compare_complement_morphism; simpl in |- *;
 
1695
    auto with arith.
 
1696
  rewrite (nat_of_P_minus_morphism p q).
 
1697
  rewrite minus_INR; auto with arith; ring.
 
1698
  apply ZC2; apply nat_of_P_lt_Lt_compare_complement_morphism; trivial.
 
1699
Qed.
 
1700
 
 
1701
(**********)
 
1702
Lemma plus_IZR : forall n m:Z, IZR (n + m) = IZR n + IZR m.
 
1703
Proof.
 
1704
  intro z; destruct z; intro t; destruct t; intros; auto with real.
 
1705
  simpl in |- *; intros; rewrite nat_of_P_plus_morphism; auto with real.
 
1706
  apply plus_IZR_NEG_POS.
 
1707
  rewrite Zplus_comm; rewrite Rplus_comm; apply plus_IZR_NEG_POS.
 
1708
  simpl in |- *; intros; rewrite nat_of_P_plus_morphism; rewrite plus_INR;
 
1709
    auto with real.
 
1710
Qed.
 
1711
 
 
1712
(**********)
 
1713
Lemma mult_IZR : forall n m:Z, IZR (n * m) = IZR n * IZR m.
 
1714
Proof.
 
1715
  intros z t; case z; case t; simpl in |- *; auto with real.
 
1716
  intros t1 z1; rewrite nat_of_P_mult_morphism; auto with real.
 
1717
  intros t1 z1; rewrite nat_of_P_mult_morphism; auto with real.
 
1718
  rewrite Rmult_comm.
 
1719
  rewrite Ropp_mult_distr_l_reverse; auto with real.
 
1720
  apply Ropp_eq_compat; rewrite mult_comm; auto with real.
 
1721
  intros t1 z1; rewrite nat_of_P_mult_morphism; auto with real.
 
1722
  rewrite Ropp_mult_distr_l_reverse; auto with real.
 
1723
  intros t1 z1; rewrite nat_of_P_mult_morphism; auto with real.
 
1724
  rewrite Rmult_opp_opp; auto with real.
 
1725
Qed.
 
1726
 
 
1727
Lemma pow_IZR : forall z n, pow (IZR z) n = IZR (Zpower z (Z_of_nat n)).
 
1728
Proof.
 
1729
 intros z [|n];simpl;trivial.
 
1730
 rewrite Zpower_pos_nat.
 
1731
 rewrite nat_of_P_o_P_of_succ_nat_eq_succ. unfold Zpower_nat;simpl.
 
1732
 rewrite mult_IZR.
 
1733
 induction n;simpl;trivial.
 
1734
 rewrite mult_IZR;ring[IHn].
 
1735
Qed.
 
1736
 
 
1737
(**********)
 
1738
Lemma succ_IZR : forall n:Z, IZR (Zsucc n) = IZR n + 1.
 
1739
Proof.
 
1740
  intro; change 1 with (IZR 1); unfold Zsucc; apply plus_IZR.
 
1741
Qed.
 
1742
 
 
1743
(**********)
 
1744
Lemma Ropp_Ropp_IZR : forall n:Z, IZR (- n) = - IZR n.
 
1745
Proof.
 
1746
  intro z; case z; simpl in |- *; auto with real.
 
1747
Qed.
 
1748
 
 
1749
(**********)
 
1750
Lemma Z_R_minus : forall n m:Z, IZR n - IZR m = IZR (n - m).
 
1751
Proof.
 
1752
  intros z1 z2; unfold Rminus in |- *; unfold Zminus in |- *.
 
1753
  rewrite <- (Ropp_Ropp_IZR z2); symmetry  in |- *; apply plus_IZR.
 
1754
Qed. 
 
1755
 
 
1756
(**********)
 
1757
Lemma lt_0_IZR : forall n:Z, 0 < IZR n -> (0 < n)%Z.
 
1758
Proof.
 
1759
  intro z; case z; simpl in |- *; intros.
 
1760
  absurd (0 < 0); auto with real.
 
1761
  unfold Zlt in |- *; simpl in |- *; trivial.
 
1762
  case Rlt_not_le with (1 := H).
 
1763
  replace 0 with (-0); auto with real.
 
1764
Qed.
 
1765
 
 
1766
(**********)
 
1767
Lemma lt_IZR : forall n m:Z, IZR n < IZR m -> (n < m)%Z.
 
1768
Proof.
 
1769
  intros z1 z2 H; apply Zlt_0_minus_lt. 
 
1770
  apply lt_0_IZR.
 
1771
  rewrite <- Z_R_minus.
 
1772
  exact (Rgt_minus (IZR z2) (IZR z1) H).
 
1773
Qed.
 
1774
 
 
1775
(**********)
 
1776
Lemma eq_IZR_R0 : forall n:Z, IZR n = 0 -> n = 0%Z.
 
1777
Proof.
 
1778
  intro z; destruct z; simpl in |- *; intros; auto with zarith.
 
1779
  case (Rlt_not_eq 0 (INR (nat_of_P p))); auto with real.
 
1780
  case (Rlt_not_eq (- INR (nat_of_P p)) 0); auto with real.
 
1781
  apply Ropp_lt_gt_0_contravar. unfold Rgt in |- *; apply pos_INR_nat_of_P.
 
1782
Qed.
 
1783
 
 
1784
(**********)
 
1785
Lemma eq_IZR : forall n m:Z, IZR n = IZR m -> n = m.
 
1786
Proof.
 
1787
  intros z1 z2 H; generalize (Rminus_diag_eq (IZR z1) (IZR z2) H);
 
1788
    rewrite (Z_R_minus z1 z2); intro; generalize (eq_IZR_R0 (z1 - z2) H0); 
 
1789
      intro; omega.
 
1790
Qed.
 
1791
 
 
1792
(**********)
 
1793
Lemma not_0_IZR : forall n:Z, n <> 0%Z -> IZR n <> 0.
 
1794
Proof.
 
1795
  intros z H; red in |- *; intros H0; case H.
 
1796
  apply eq_IZR; auto.
 
1797
Qed.
 
1798
 
 
1799
(*********)
 
1800
Lemma le_0_IZR : forall n:Z, 0 <= IZR n -> (0 <= n)%Z.
 
1801
Proof.
 
1802
  unfold Rle in |- *; intros z [H| H].
 
1803
  red in |- *; intro; apply (Zlt_le_weak 0 z (lt_0_IZR z H)); assumption.
 
1804
  rewrite (eq_IZR_R0 z); auto with zarith real.
 
1805
Qed.
 
1806
 
 
1807
(**********)
 
1808
Lemma le_IZR : forall n m:Z, IZR n <= IZR m -> (n <= m)%Z.
 
1809
Proof.
 
1810
  unfold Rle in |- *; intros z1 z2 [H| H].
 
1811
  apply (Zlt_le_weak z1 z2); auto with real.
 
1812
  apply lt_IZR; trivial.
 
1813
  rewrite (eq_IZR z1 z2); auto with zarith real.
 
1814
Qed.
 
1815
 
 
1816
(**********)
 
1817
Lemma le_IZR_R1 : forall n:Z, IZR n <= 1 -> (n <= 1)%Z.
 
1818
Proof.
 
1819
  pattern 1 at 1 in |- *; replace 1 with (IZR 1); intros; auto.
 
1820
  apply le_IZR; trivial.
 
1821
Qed.
 
1822
 
 
1823
(**********)
 
1824
Lemma IZR_ge : forall n m:Z, (n >= m)%Z -> IZR n >= IZR m.
 
1825
Proof.
 
1826
  intros m n H; apply Rnot_lt_ge; red in |- *; intro.
 
1827
  generalize (lt_IZR m n H0); intro; omega.
 
1828
Qed.
 
1829
 
 
1830
Lemma IZR_le : forall n m:Z, (n <= m)%Z -> IZR n <= IZR m.
 
1831
Proof.
 
1832
  intros m n H; apply Rnot_gt_le; red in |- *; intro.
 
1833
  unfold Rgt in H0; generalize (lt_IZR n m H0); intro; omega.
 
1834
Qed.
 
1835
 
 
1836
Lemma IZR_lt : forall n m:Z, (n < m)%Z -> IZR n < IZR m.
 
1837
Proof.
 
1838
  intros m n H; cut (m <= n)%Z.
 
1839
  intro H0; elim (IZR_le m n H0); intro; auto.
 
1840
  generalize (eq_IZR m n H1); intro; elimtype False; omega.
 
1841
  omega.
 
1842
Qed.
 
1843
 
 
1844
Lemma one_IZR_lt1 : forall n:Z, -1 < IZR n < 1 -> n = 0%Z.
 
1845
Proof.
 
1846
  intros z [H1 H2].
 
1847
  apply Zle_antisym.
 
1848
  apply Zlt_succ_le; apply lt_IZR; trivial.
 
1849
  replace 0%Z with (Zsucc (-1)); trivial.
 
1850
  apply Zlt_le_succ; apply lt_IZR; trivial.
 
1851
Qed.
 
1852
 
 
1853
Lemma one_IZR_r_R1 :
 
1854
  forall r (n m:Z), r < IZR n <= r + 1 -> r < IZR m <= r + 1 -> n = m.
 
1855
Proof.
 
1856
  intros r z x [H1 H2] [H3 H4].
 
1857
  cut ((z - x)%Z = 0%Z); auto with zarith.
 
1858
  apply one_IZR_lt1.
 
1859
  rewrite <- Z_R_minus; split.
 
1860
  replace (-1) with (r - (r + 1)).
 
1861
  unfold Rminus in |- *; apply Rplus_lt_le_compat; auto with real.
 
1862
  ring.
 
1863
  replace 1 with (r + 1 - r).
 
1864
  unfold Rminus in |- *; apply Rplus_le_lt_compat; auto with real.
 
1865
  ring.
 
1866
Qed.
 
1867
 
 
1868
 
 
1869
(**********)
 
1870
Lemma single_z_r_R1 :
 
1871
  forall r (n m:Z),
 
1872
    r < IZR n -> IZR n <= r + 1 -> r < IZR m -> IZR m <= r + 1 -> n = m.
 
1873
Proof.
 
1874
  intros; apply one_IZR_r_R1 with r; auto.
 
1875
Qed.
 
1876
 
 
1877
(**********)
 
1878
Lemma tech_single_z_r_R1 :
 
1879
  forall r (n:Z),
 
1880
    r < IZR n ->
 
1881
    IZR n <= r + 1 ->
 
1882
    (exists s : Z, s <> n /\ r < IZR s /\ IZR s <= r + 1) -> False.
 
1883
Proof.
 
1884
  intros r z H1 H2 [s [H3 [H4 H5]]].
 
1885
  apply H3; apply single_z_r_R1 with r; trivial.
 
1886
Qed.
 
1887
 
 
1888
(*********)
 
1889
Lemma Rmult_le_pos : forall r1 r2, 0 <= r1 -> 0 <= r2 -> 0 <= r1 * r2.
 
1890
Proof.
 
1891
  intros x y H H0; rewrite <- (Rmult_0_l x); rewrite <- (Rmult_comm x);
 
1892
    apply (Rmult_le_compat_l x 0 y H H0).
 
1893
Qed.
 
1894
 
 
1895
Lemma double : forall r1, 2 * r1 = r1 + r1.
 
1896
Proof.
 
1897
  intro; ring.
 
1898
Qed.
 
1899
 
 
1900
Lemma double_var : forall r1, r1 = r1 / 2 + r1 / 2.
 
1901
Proof.
 
1902
  intro; rewrite <- double; unfold Rdiv in |- *; rewrite <- Rmult_assoc;
 
1903
    symmetry  in |- *; apply Rinv_r_simpl_m.
 
1904
  replace 2 with (INR 2);
 
1905
  [ apply not_0_INR; discriminate | unfold INR in |- *; ring ].
 
1906
Qed.
 
1907
 
 
1908
(*********************************************************)
 
1909
(** ** Other rules about < and <=                        *)
 
1910
(*********************************************************)
 
1911
 
 
1912
Lemma Rmult_ge_0_gt_0_lt_compat :
 
1913
  forall r1 r2 r3 r4,
 
1914
    r3 >= 0 -> r2 > 0 -> r1 < r2 -> r3 < r4 -> r1 * r3 < r2 * r4.
 
1915
Proof.
 
1916
  intros; apply Rle_lt_trans with (r2 * r3); auto with real.
 
1917
Qed.
 
1918
 
 
1919
Lemma le_epsilon :
 
1920
  forall r1 r2, (forall eps:R, 0 < eps -> r1 <= r2 + eps) -> r1 <= r2.
 
1921
Proof.
 
1922
  intros x y; intros; elim (Rtotal_order x y); intro.
 
1923
  left; assumption.
 
1924
  elim H0; intro.
 
1925
  right; assumption.
 
1926
  clear H0; generalize (Rgt_minus x y H1); intro H2; change (0 < x - y) in H2.
 
1927
  cut (0 < 2).
 
1928
  intro.
 
1929
  generalize (Rmult_lt_0_compat (x - y) (/ 2) H2 (Rinv_0_lt_compat 2 H0));
 
1930
    intro H3; generalize (H ((x - y) * / 2) H3);
 
1931
      replace (y + (x - y) * / 2) with ((y + x) * / 2).
 
1932
  intro H4;
 
1933
    generalize (Rmult_le_compat_l 2 x ((y + x) * / 2) (Rlt_le 0 2 H0) H4);
 
1934
      rewrite <- (Rmult_comm ((y + x) * / 2)); rewrite Rmult_assoc;
 
1935
        rewrite <- Rinv_l_sym.
 
1936
  rewrite Rmult_1_r; replace (2 * x) with (x + x).
 
1937
  rewrite (Rplus_comm y); intro H5; apply Rplus_le_reg_l with x; assumption.
 
1938
  ring. 
 
1939
  replace 2 with (INR 2); [ apply not_0_INR; discriminate | reflexivity ].
 
1940
  pattern y at 2 in |- *; replace y with (y / 2 + y / 2).
 
1941
  unfold Rminus, Rdiv in |- *.
 
1942
  repeat rewrite Rmult_plus_distr_r.
 
1943
  ring.
 
1944
  cut (forall z:R, 2 * z = z + z).
 
1945
  intro.
 
1946
  rewrite <- (H4 (y / 2)).
 
1947
  unfold Rdiv in |- *.
 
1948
  rewrite <- Rmult_assoc; apply Rinv_r_simpl_m.
 
1949
  replace 2 with (INR 2).
 
1950
  apply not_0_INR.
 
1951
  discriminate.
 
1952
  unfold INR in |- *; reflexivity.
 
1953
  intro; ring.
 
1954
  cut (0%nat <> 2%nat);
 
1955
    [ intro H0; generalize (lt_0_INR 2 (neq_O_lt 2 H0)); unfold INR in |- *;
 
1956
      intro; assumption
 
1957
      | discriminate ].
 
1958
Qed.
 
1959
 
 
1960
(**********)
 
1961
Lemma completeness_weak :
 
1962
  forall E:R -> Prop,
 
1963
    bound E -> (exists x : R, E x) ->  exists m : R, is_lub E m.
 
1964
Proof.
 
1965
  intros; elim (completeness E H H0); intros; split with x; assumption.
 
1966
Qed.
 
1967
 
 
1968
(*********************************************************)
 
1969
(** * Definitions of new types                           *)
 
1970
(*********************************************************)
 
1971
 
 
1972
Record nonnegreal : Type := mknonnegreal
 
1973
  {nonneg :> R; cond_nonneg : 0 <= nonneg}.
 
1974
 
 
1975
Record posreal : Type := mkposreal {pos :> R; cond_pos : 0 < pos}.
 
1976
 
 
1977
Record nonposreal : Type := mknonposreal
 
1978
  {nonpos :> R; cond_nonpos : nonpos <= 0}.
 
1979
 
 
1980
Record negreal : Type := mknegreal {neg :> R; cond_neg : neg < 0}.
 
1981
 
 
1982
Record nonzeroreal : Type := mknonzeroreal
 
1983
  {nonzero :> R; cond_nonzero : nonzero <> 0}.
 
1984
 
 
1985
(** Compatibility *)
 
1986
 
 
1987
Notation prod_neq_R0 := Rmult_integral_contrapositive_currified (only parsing).
 
1988
Notation minus_Rgt := Rminus_gt (only parsing).
 
1989
Notation minus_Rge := Rminus_ge (only parsing).
 
1990
Notation plus_le_is_le := Rplus_le_reg_pos_r (only parsing).
 
1991
Notation plus_lt_is_lt := Rplus_lt_reg_pos_r (only parsing).
 
1992
Notation INR_lt_1 := lt_1_INR (only parsing).
 
1993
Notation lt_INR_0 := lt_0_INR (only parsing).
 
1994
Notation not_nm_INR := not_INR (only parsing).
 
1995
Notation INR_pos := pos_INR_nat_of_P (only parsing).
 
1996
Notation not_INR_O := INR_not_0 (only parsing).
 
1997
Notation not_O_INR := not_0_INR (only parsing).
 
1998
Notation not_O_IZR := not_0_IZR (only parsing).
 
1999
Notation le_O_IZR := le_0_IZR (only parsing).
 
2000
Notation lt_O_IZR := lt_0_IZR (only parsing).