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

« back to all changes in this revision

Viewing changes to theories/Reals/Rfunctions.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: Rfunctions.v 10762 2008-04-06 16:57:31Z herbelin $ i*)
 
10
 
 
11
(*i Some properties about pow and sum have been made with John Harrison i*)
 
12
(*i Some Lemmas (about pow and powerRZ) have been done by Laurent Thery i*)
 
13
 
 
14
(********************************************************)
 
15
(**          Definition of the sum functions            *)
 
16
(*                                                      *)
 
17
(********************************************************)
 
18
Require Export ArithRing.
 
19
 
 
20
Require Import Rbase.
 
21
Require Export Rpow_def.
 
22
Require Export R_Ifp.
 
23
Require Export Rbasic_fun.
 
24
Require Export R_sqr.
 
25
Require Export SplitAbsolu.
 
26
Require Export SplitRmult.
 
27
Require Export ArithProp.
 
28
Require Import Omega.
 
29
Require Import Zpower.
 
30
Open Local Scope nat_scope.
 
31
Open Local Scope R_scope.
 
32
 
 
33
(*******************************)
 
34
(** * Lemmas about factorial   *)
 
35
(*******************************)
 
36
(*********)
 
37
Lemma INR_fact_neq_0 : forall n:nat, INR (fact n) <> 0.
 
38
Proof.
 
39
  intro; red in |- *; intro; apply (not_O_INR (fact n) (fact_neq_0 n));
 
40
    assumption.
 
41
Qed.    
 
42
 
 
43
(*********)
 
44
Lemma fact_simpl : forall n:nat, fact (S n) = (S n * fact n)%nat.
 
45
Proof.
 
46
  intro; reflexivity.
 
47
Qed. 
 
48
 
 
49
(*********)
 
50
Lemma simpl_fact :
 
51
  forall n:nat, / INR (fact (S n)) * / / INR (fact n) = / INR (S n).
 
52
Proof.
 
53
  intro; rewrite (Rinv_involutive (INR (fact n)) (INR_fact_neq_0 n));
 
54
    unfold fact at 1 in |- *; cbv beta iota in |- *; fold fact in |- *;
 
55
      rewrite (mult_INR (S n) (fact n));
 
56
        rewrite (Rinv_mult_distr (INR (S n)) (INR (fact n))).
 
57
  rewrite (Rmult_assoc (/ INR (S n)) (/ INR (fact n)) (INR (fact n)));
 
58
    rewrite (Rinv_l (INR (fact n)) (INR_fact_neq_0 n));
 
59
      apply (let (H1, H2) := Rmult_ne (/ INR (S n)) in H1).
 
60
  apply not_O_INR; auto.
 
61
  apply INR_fact_neq_0.
 
62
Qed.
 
63
 
 
64
(*******************************)
 
65
(** *       Power              *)
 
66
(*******************************)
 
67
(*********)
 
68
 
 
69
Infix "^" := pow : R_scope.
 
70
 
 
71
Lemma pow_O : forall x:R, x ^ 0 = 1.
 
72
Proof.
 
73
  reflexivity.
 
74
Qed.
 
75
 
 
76
Lemma pow_1 : forall x:R, x ^ 1 = x.
 
77
Proof.
 
78
  simpl in |- *; auto with real.
 
79
Qed.
 
80
 
 
81
Lemma pow_add : forall (x:R) (n m:nat), x ^ (n + m) = x ^ n * x ^ m.
 
82
Proof.
 
83
  intros x n; elim n; simpl in |- *; auto with real.
 
84
  intros n0 H' m; rewrite H'; auto with real.
 
85
Qed.
 
86
 
 
87
Lemma pow_nonzero : forall (x:R) (n:nat), x <> 0 -> x ^ n <> 0.
 
88
Proof.
 
89
  intro; simple induction n; simpl in |- *.
 
90
  intro; red in |- *; intro; apply R1_neq_R0; assumption.
 
91
  intros; red in |- *; intro; elim (Rmult_integral x (x ^ n0) H1).
 
92
  intro; auto.
 
93
  apply H; assumption.
 
94
Qed.
 
95
 
 
96
Hint Resolve pow_O pow_1 pow_add pow_nonzero: real.
 
97
 
 
98
Lemma pow_RN_plus :
 
99
  forall (x:R) (n m:nat), x <> 0 -> x ^ n = x ^ (n + m) * / x ^ m.
 
100
Proof.
 
101
  intros x n; elim n; simpl in |- *; auto with real.
 
102
  intros n0 H' m H'0.
 
103
  rewrite Rmult_assoc; rewrite <- H'; auto.
 
104
Qed.
 
105
 
 
106
Lemma pow_lt : forall (x:R) (n:nat), 0 < x -> 0 < x ^ n.
 
107
Proof.
 
108
  intros x n; elim n; simpl in |- *; auto with real.
 
109
  intros n0 H' H'0; replace 0 with (x * 0); auto with real.
 
110
Qed.
 
111
Hint Resolve pow_lt: real.
 
112
 
 
113
Lemma Rlt_pow_R1 : forall (x:R) (n:nat), 1 < x -> (0 < n)%nat -> 1 < x ^ n.
 
114
Proof.
 
115
  intros x n; elim n; simpl in |- *; auto with real.
 
116
  intros H' H'0; elimtype False; omega.
 
117
  intros n0; case n0.
 
118
  simpl in |- *; rewrite Rmult_1_r; auto.
 
119
  intros n1 H' H'0 H'1.
 
120
  replace 1 with (1 * 1); auto with real.
 
121
  apply Rlt_trans with (r2 := x * 1); auto with real.
 
122
  apply Rmult_lt_compat_l; auto with real.
 
123
  apply Rlt_trans with (r2 := 1); auto with real.
 
124
  apply H'; auto with arith.
 
125
Qed.
 
126
Hint Resolve Rlt_pow_R1: real.
 
127
 
 
128
Lemma Rlt_pow : forall (x:R) (n m:nat), 1 < x -> (n < m)%nat -> x ^ n < x ^ m.
 
129
Proof.
 
130
  intros x n m H' H'0; replace m with (m - n + n)%nat.
 
131
  rewrite pow_add.
 
132
  pattern (x ^ n) at 1 in |- *; replace (x ^ n) with (1 * x ^ n);
 
133
    auto with real.
 
134
  apply Rminus_lt.
 
135
  repeat rewrite (fun y:R => Rmult_comm y (x ^ n));
 
136
    rewrite <- Rmult_minus_distr_l.
 
137
  replace 0 with (x ^ n * 0); auto with real.
 
138
  apply Rmult_lt_compat_l; auto with real.
 
139
  apply pow_lt; auto with real.
 
140
  apply Rlt_trans with (r2 := 1); auto with real.
 
141
  apply Rlt_minus; auto with real.
 
142
  apply Rlt_pow_R1; auto with arith.
 
143
  apply plus_lt_reg_l with (p := n); auto with arith.
 
144
  rewrite le_plus_minus_r; auto with arith; rewrite <- plus_n_O; auto.
 
145
  rewrite plus_comm; auto with arith.
 
146
Qed.
 
147
Hint Resolve Rlt_pow: real.
 
148
 
 
149
(*********)
 
150
Lemma tech_pow_Rmult : forall (x:R) (n:nat), x * x ^ n = x ^ S n.
 
151
Proof.
 
152
  simple induction n; simpl in |- *; trivial.
 
153
Qed.
 
154
 
 
155
(*********)
 
156
Lemma tech_pow_Rplus :
 
157
  forall (x:R) (a n:nat), x ^ a + INR n * x ^ a = INR (S n) * x ^ a.
 
158
Proof.
 
159
  intros; pattern (x ^ a) at 1 in |- *;
 
160
    rewrite <- (let (H1, H2) := Rmult_ne (x ^ a) in H1);
 
161
      rewrite (Rmult_comm (INR n) (x ^ a));
 
162
        rewrite <- (Rmult_plus_distr_l (x ^ a) 1 (INR n));
 
163
          rewrite (Rplus_comm 1 (INR n)); rewrite <- (S_INR n); 
 
164
            apply Rmult_comm.
 
165
Qed.
 
166
 
 
167
Lemma poly : forall (n:nat) (x:R), 0 < x -> 1 + INR n * x <= (1 + x) ^ n.
 
168
Proof.
 
169
  intros; elim n.
 
170
  simpl in |- *; cut (1 + 0 * x = 1).
 
171
  intro; rewrite H0; unfold Rle in |- *; right; reflexivity.
 
172
  ring.
 
173
  intros; unfold pow in |- *; fold pow in |- *;
 
174
    apply
 
175
      (Rle_trans (1 + INR (S n0) * x) ((1 + x) * (1 + INR n0 * x))
 
176
        ((1 + x) * (1 + x) ^ n0)).
 
177
  cut ((1 + x) * (1 + INR n0 * x) = 1 + INR (S n0) * x + INR n0 * (x * x)).
 
178
  intro; rewrite H1; pattern (1 + INR (S n0) * x) at 1 in |- *;
 
179
    rewrite <- (let (H1, H2) := Rplus_ne (1 + INR (S n0) * x) in H1);
 
180
      apply Rplus_le_compat_l; elim n0; intros.
 
181
  simpl in |- *; rewrite Rmult_0_l; unfold Rle in |- *; right; auto.
 
182
  unfold Rle in |- *; left; generalize Rmult_gt_0_compat; unfold Rgt in |- *;
 
183
    intro; fold (Rsqr x) in |- *;
 
184
      apply (H3 (INR (S n1)) (Rsqr x) (lt_INR_0 (S n1) (lt_O_Sn n1)));
 
185
        fold (x > 0) in H;
 
186
          apply (Rlt_0_sqr x (Rlt_dichotomy_converse x 0 (or_intror (x < 0) H))).
 
187
  rewrite (S_INR n0); ring.
 
188
  unfold Rle in H0; elim H0; intro. 
 
189
  unfold Rle in |- *; left; apply Rmult_lt_compat_l.
 
190
  rewrite Rplus_comm; apply (Rle_lt_0_plus_1 x (Rlt_le 0 x H)).
 
191
  assumption.
 
192
  rewrite H1; unfold Rle in |- *; right; trivial.
 
193
Qed.
 
194
 
 
195
Lemma Power_monotonic :
 
196
  forall (x:R) (m n:nat),
 
197
    Rabs x > 1 -> (m <= n)%nat -> Rabs (x ^ m) <= Rabs (x ^ n).
 
198
Proof.
 
199
  intros x m n H; induction  n as [| n Hrecn]; intros; inversion H0.
 
200
  unfold Rle in |- *; right; reflexivity.
 
201
  unfold Rle in |- *; right; reflexivity.
 
202
  apply (Rle_trans (Rabs (x ^ m)) (Rabs (x ^ n)) (Rabs (x ^ S n))).
 
203
  apply Hrecn; assumption.
 
204
  simpl in |- *; rewrite Rabs_mult.
 
205
  pattern (Rabs (x ^ n)) at 1 in |- *.
 
206
  rewrite <- Rmult_1_r.
 
207
  rewrite (Rmult_comm (Rabs x) (Rabs (x ^ n))).
 
208
  apply Rmult_le_compat_l.
 
209
  apply Rabs_pos.
 
210
  unfold Rgt in H.
 
211
  apply Rlt_le; assumption.
 
212
Qed.
 
213
 
 
214
Lemma RPow_abs : forall (x:R) (n:nat), Rabs x ^ n = Rabs (x ^ n).
 
215
Proof.
 
216
  intro; simple induction n; simpl in |- *.
 
217
  apply sym_eq; apply Rabs_pos_eq; apply Rlt_le; apply Rlt_0_1.
 
218
  intros; rewrite H; apply sym_eq; apply Rabs_mult.
 
219
Qed.
 
220
 
 
221
 
 
222
Lemma Pow_x_infinity :
 
223
  forall x:R,
 
224
    Rabs x > 1 ->
 
225
    forall b:R,
 
226
      exists N : nat, (forall n:nat, (n >= N)%nat -> Rabs (x ^ n) >= b).
 
227
Proof.
 
228
  intros; elim (archimed (b * / (Rabs x - 1))); intros; clear H1;
 
229
    cut (exists N : nat, INR N >= b * / (Rabs x - 1)).
 
230
  intro; elim H1; clear H1; intros; exists x0; intros;
 
231
    apply (Rge_trans (Rabs (x ^ n)) (Rabs (x ^ x0)) b).
 
232
  apply Rle_ge; apply Power_monotonic; assumption.
 
233
  rewrite <- RPow_abs; cut (Rabs x = 1 + (Rabs x - 1)).
 
234
  intro; rewrite H3;
 
235
    apply (Rge_trans ((1 + (Rabs x - 1)) ^ x0) (1 + INR x0 * (Rabs x - 1)) b).
 
236
  apply Rle_ge; apply poly; fold (Rabs x - 1 > 0) in |- *; apply Rgt_minus;
 
237
    assumption.
 
238
  apply (Rge_trans (1 + INR x0 * (Rabs x - 1)) (INR x0 * (Rabs x - 1)) b).
 
239
  apply Rle_ge; apply Rlt_le; rewrite (Rplus_comm 1 (INR x0 * (Rabs x - 1)));
 
240
    pattern (INR x0 * (Rabs x - 1)) at 1 in |- *;
 
241
      rewrite <- (let (H1, H2) := Rplus_ne (INR x0 * (Rabs x - 1)) in H1);
 
242
        apply Rplus_lt_compat_l; apply Rlt_0_1.
 
243
  cut (b = b * / (Rabs x - 1) * (Rabs x - 1)).
 
244
  intros; rewrite H4; apply Rmult_ge_compat_r.
 
245
  apply Rge_minus; unfold Rge in |- *; left; assumption.
 
246
  assumption.
 
247
  rewrite Rmult_assoc; rewrite Rinv_l.
 
248
  ring.
 
249
  apply Rlt_dichotomy_converse; right; apply Rgt_minus; assumption.
 
250
  ring.
 
251
  cut ((0 <= up (b * / (Rabs x - 1)))%Z \/ (up (b * / (Rabs x - 1)) <= 0)%Z).
 
252
  intros; elim H1; intro.
 
253
  elim (IZN (up (b * / (Rabs x - 1))) H2); intros; exists x0;
 
254
    apply
 
255
      (Rge_trans (INR x0) (IZR (up (b * / (Rabs x - 1)))) (b * / (Rabs x - 1))).
 
256
  rewrite INR_IZR_INZ; apply IZR_ge; omega.
 
257
  unfold Rge in |- *; left; assumption.
 
258
  exists 0%nat;
 
259
    apply
 
260
      (Rge_trans (INR 0) (IZR (up (b * / (Rabs x - 1)))) (b * / (Rabs x - 1))).
 
261
  rewrite INR_IZR_INZ; apply IZR_ge; simpl in |- *; omega.
 
262
  unfold Rge in |- *; left; assumption.
 
263
  omega.
 
264
Qed.
 
265
 
 
266
Lemma pow_ne_zero : forall n:nat, n <> 0%nat -> 0 ^ n = 0.
 
267
Proof.
 
268
  simple induction n.
 
269
  simpl in |- *; auto.
 
270
  intros; elim H; reflexivity.
 
271
  intros; simpl in |- *; apply Rmult_0_l.
 
272
Qed.
 
273
 
 
274
Lemma Rinv_pow : forall (x:R) (n:nat), x <> 0 -> / x ^ n = (/ x) ^ n.
 
275
Proof.
 
276
  intros; elim n; simpl in |- *.
 
277
  apply Rinv_1.
 
278
  intro m; intro; rewrite Rinv_mult_distr.
 
279
  rewrite H0; reflexivity; assumption.
 
280
  assumption.
 
281
  apply pow_nonzero; assumption.
 
282
Qed.
 
283
 
 
284
Lemma pow_lt_1_zero :
 
285
  forall x:R,
 
286
    Rabs x < 1 ->
 
287
    forall y:R,
 
288
      0 < y ->
 
289
      exists N : nat, (forall n:nat, (n >= N)%nat -> Rabs (x ^ n) < y).
 
290
Proof.
 
291
  intros; elim (Req_dec x 0); intro. 
 
292
  exists 1%nat; rewrite H1; intros n GE; rewrite pow_ne_zero.
 
293
  rewrite Rabs_R0; assumption.
 
294
  inversion GE; auto.
 
295
  cut (Rabs (/ x) > 1).
 
296
  intros; elim (Pow_x_infinity (/ x) H2 (/ y + 1)); intros N.
 
297
  exists N; intros; rewrite <- (Rinv_involutive y).
 
298
  rewrite <- (Rinv_involutive (Rabs (x ^ n))).
 
299
  apply Rinv_lt_contravar.
 
300
  apply Rmult_lt_0_compat.
 
301
  apply Rinv_0_lt_compat.
 
302
  assumption.
 
303
  apply Rinv_0_lt_compat.
 
304
  apply Rabs_pos_lt.
 
305
  apply pow_nonzero.
 
306
  assumption.
 
307
  rewrite <- Rabs_Rinv.
 
308
  rewrite Rinv_pow.
 
309
  apply (Rlt_le_trans (/ y) (/ y + 1) (Rabs ((/ x) ^ n))).
 
310
  pattern (/ y) at 1 in |- *.
 
311
  rewrite <- (let (H1, H2) := Rplus_ne (/ y) in H1).
 
312
  apply Rplus_lt_compat_l.
 
313
  apply Rlt_0_1.
 
314
  apply Rge_le.
 
315
  apply H3.
 
316
  assumption.
 
317
  assumption.
 
318
  apply pow_nonzero.
 
319
  assumption.
 
320
  apply Rabs_no_R0.
 
321
  apply pow_nonzero.
 
322
  assumption.
 
323
  apply Rlt_dichotomy_converse.
 
324
  right; unfold Rgt in |- *; assumption.
 
325
  rewrite <- (Rinv_involutive 1).
 
326
  rewrite Rabs_Rinv.
 
327
  unfold Rgt in |- *; apply Rinv_lt_contravar.
 
328
  apply Rmult_lt_0_compat.
 
329
  apply Rabs_pos_lt.
 
330
  assumption.
 
331
  rewrite Rinv_1; apply Rlt_0_1.
 
332
  rewrite Rinv_1; assumption.
 
333
  assumption.
 
334
  red in |- *; intro; apply R1_neq_R0; assumption.
 
335
Qed.
 
336
 
 
337
Lemma pow_R1 : forall (r:R) (n:nat), r ^ n = 1 -> Rabs r = 1 \/ n = 0%nat.
 
338
Proof.
 
339
  intros r n H'.
 
340
  case (Req_dec (Rabs r) 1); auto; intros H'1.
 
341
  case (Rdichotomy _ _ H'1); intros H'2.
 
342
  generalize H'; case n; auto.
 
343
  intros n0 H'0.
 
344
  cut (r <> 0); [ intros Eq1 | idtac ].
 
345
  cut (Rabs r <> 0); [ intros Eq2 | apply Rabs_no_R0 ]; auto.
 
346
  absurd (Rabs (/ r) ^ 0 < Rabs (/ r) ^ S n0); auto.
 
347
  replace (Rabs (/ r) ^ S n0) with 1.
 
348
  simpl in |- *; apply Rlt_irrefl; auto.
 
349
  rewrite Rabs_Rinv; auto.
 
350
  rewrite <- Rinv_pow; auto.
 
351
  rewrite RPow_abs; auto.
 
352
  rewrite H'0; rewrite Rabs_right; auto with real rorders.
 
353
  apply Rlt_pow; auto with arith.
 
354
  rewrite Rabs_Rinv; auto.
 
355
  apply Rmult_lt_reg_l with (r := Rabs r).
 
356
  case (Rabs_pos r); auto.
 
357
  intros H'3; case Eq2; auto.
 
358
  rewrite Rmult_1_r; rewrite Rinv_r; auto with real.
 
359
  red in |- *; intro; absurd (r ^ S n0 = 1); auto.
 
360
  simpl in |- *; rewrite H; rewrite Rmult_0_l; auto with real.
 
361
  generalize H'; case n; auto.
 
362
  intros n0 H'0.
 
363
  cut (r <> 0); [ intros Eq1 | auto with real ].
 
364
  cut (Rabs r <> 0); [ intros Eq2 | apply Rabs_no_R0 ]; auto.
 
365
  absurd (Rabs r ^ 0 < Rabs r ^ S n0); auto with real arith.
 
366
  repeat rewrite RPow_abs; rewrite H'0; simpl in |- *; auto with real.
 
367
  red in |- *; intro; absurd (r ^ S n0 = 1); auto.
 
368
  simpl in |- *; rewrite H; rewrite Rmult_0_l; auto with real.
 
369
Qed.
 
370
 
 
371
Lemma pow_Rsqr : forall (x:R) (n:nat), x ^ (2 * n) = Rsqr x ^ n.
 
372
Proof.
 
373
  intros; induction  n as [| n Hrecn].
 
374
  reflexivity.
 
375
  replace (2 * S n)%nat with (S (S (2 * n))).
 
376
  replace (x ^ S (S (2 * n))) with (x * x * x ^ (2 * n)).
 
377
  rewrite Hrecn; reflexivity.
 
378
  simpl in |- *; ring.
 
379
  ring.
 
380
Qed.
 
381
 
 
382
Lemma pow_le : forall (a:R) (n:nat), 0 <= a -> 0 <= a ^ n.
 
383
Proof.
 
384
  intros; induction  n as [| n Hrecn].
 
385
  simpl in |- *; left; apply Rlt_0_1.
 
386
  simpl in |- *; apply Rmult_le_pos; assumption.
 
387
Qed.
 
388
 
 
389
(**********)
 
390
Lemma pow_1_even : forall n:nat, (-1) ^ (2 * n) = 1.
 
391
Proof.
 
392
  intro; induction  n as [| n Hrecn].
 
393
  reflexivity.
 
394
  replace (2 * S n)%nat with (2 + 2 * n)%nat by ring.
 
395
  rewrite pow_add; rewrite Hrecn; simpl in |- *; ring.
 
396
Qed.
 
397
 
 
398
(**********)
 
399
Lemma pow_1_odd : forall n:nat, (-1) ^ S (2 * n) = -1.
 
400
Proof.
 
401
  intro; replace (S (2 * n)) with (2 * n + 1)%nat by ring.
 
402
  rewrite pow_add; rewrite pow_1_even; simpl in |- *; ring.
 
403
Qed.
 
404
 
 
405
(**********)
 
406
Lemma pow_1_abs : forall n:nat, Rabs ((-1) ^ n) = 1.
 
407
Proof.
 
408
  intro; induction  n as [| n Hrecn].
 
409
  simpl in |- *; apply Rabs_R1.
 
410
  replace (S n) with (n + 1)%nat; [ rewrite pow_add | ring ].
 
411
  rewrite Rabs_mult.
 
412
  rewrite Hrecn; rewrite Rmult_1_l; simpl in |- *; rewrite Rmult_1_r;
 
413
    rewrite Rabs_Ropp; apply Rabs_R1.
 
414
Qed.
 
415
 
 
416
Lemma pow_mult : forall (x:R) (n1 n2:nat), x ^ (n1 * n2) = (x ^ n1) ^ n2.
 
417
Proof.
 
418
  intros; induction  n2 as [| n2 Hrecn2].
 
419
  simpl in |- *; replace (n1 * 0)%nat with 0%nat; [ reflexivity | ring ].
 
420
  replace (n1 * S n2)%nat with (n1 * n2 + n1)%nat.
 
421
  replace (S n2) with (n2 + 1)%nat by ring.
 
422
  do 2 rewrite pow_add.
 
423
  rewrite Hrecn2.
 
424
  simpl in |- *.
 
425
  ring.
 
426
  ring.
 
427
Qed.
 
428
 
 
429
Lemma pow_incr : forall (x y:R) (n:nat), 0 <= x <= y -> x ^ n <= y ^ n.
 
430
Proof.
 
431
  intros.
 
432
  induction  n as [| n Hrecn].
 
433
  right; reflexivity.
 
434
  simpl in |- *.
 
435
  elim H; intros.
 
436
  apply Rle_trans with (y * x ^ n).
 
437
  do 2 rewrite <- (Rmult_comm (x ^ n)).
 
438
  apply Rmult_le_compat_l.
 
439
  apply pow_le; assumption.
 
440
  assumption.
 
441
  apply Rmult_le_compat_l.
 
442
  apply Rle_trans with x; assumption.
 
443
  apply Hrecn.
 
444
Qed.
 
445
 
 
446
Lemma pow_R1_Rle : forall (x:R) (k:nat), 1 <= x -> 1 <= x ^ k.
 
447
Proof.
 
448
  intros.
 
449
  induction  k as [| k Hreck].
 
450
  right; reflexivity.
 
451
  simpl in |- *.
 
452
  apply Rle_trans with (x * 1).
 
453
  rewrite Rmult_1_r; assumption.
 
454
  apply Rmult_le_compat_l.
 
455
  left; apply Rlt_le_trans with 1; [ apply Rlt_0_1 | assumption ].
 
456
  exact Hreck.
 
457
Qed.
 
458
 
 
459
Lemma Rle_pow :
 
460
  forall (x:R) (m n:nat), 1 <= x -> (m <= n)%nat -> x ^ m <= x ^ n.
 
461
Proof.
 
462
  intros.
 
463
  replace n with (n - m + m)%nat.
 
464
  rewrite pow_add.
 
465
  rewrite Rmult_comm.
 
466
  pattern (x ^ m) at 1 in |- *; rewrite <- Rmult_1_r.
 
467
  apply Rmult_le_compat_l.
 
468
  apply pow_le; left; apply Rlt_le_trans with 1; [ apply Rlt_0_1 | assumption ].
 
469
  apply pow_R1_Rle; assumption.
 
470
  rewrite plus_comm.
 
471
  symmetry  in |- *; apply le_plus_minus; assumption.
 
472
Qed.
 
473
 
 
474
Lemma pow1 : forall n:nat, 1 ^ n = 1.
 
475
Proof.
 
476
  intro; induction  n as [| n Hrecn].
 
477
  reflexivity.
 
478
  simpl in |- *; rewrite Hrecn; rewrite Rmult_1_r; reflexivity.
 
479
Qed.
 
480
 
 
481
Lemma pow_Rabs : forall (x:R) (n:nat), x ^ n <= Rabs x ^ n.
 
482
Proof.
 
483
  intros; induction  n as [| n Hrecn].
 
484
  right; reflexivity.
 
485
  simpl in |- *; case (Rcase_abs x); intro.
 
486
  apply Rle_trans with (Rabs (x * x ^ n)).
 
487
  apply RRle_abs.
 
488
  rewrite Rabs_mult.
 
489
  apply Rmult_le_compat_l.
 
490
  apply Rabs_pos.
 
491
  right; symmetry  in |- *; apply RPow_abs.
 
492
  pattern (Rabs x) at 1 in |- *; rewrite (Rabs_right x r);
 
493
    apply Rmult_le_compat_l.
 
494
  apply Rge_le; exact r.
 
495
  apply Hrecn.
 
496
Qed.
 
497
 
 
498
Lemma pow_maj_Rabs : forall (x y:R) (n:nat), Rabs y <= x -> y ^ n <= x ^ n.
 
499
Proof.
 
500
  intros; cut (0 <= x).
 
501
  intro; apply Rle_trans with (Rabs y ^ n).
 
502
  apply pow_Rabs.
 
503
  induction  n as [| n Hrecn].
 
504
  right; reflexivity.
 
505
  simpl in |- *; apply Rle_trans with (x * Rabs y ^ n).
 
506
  do 2 rewrite <- (Rmult_comm (Rabs y ^ n)).
 
507
  apply Rmult_le_compat_l.
 
508
  apply pow_le; apply Rabs_pos.
 
509
  assumption.
 
510
  apply Rmult_le_compat_l.
 
511
  apply H0.
 
512
  apply Hrecn.
 
513
  apply Rle_trans with (Rabs y); [ apply Rabs_pos | exact H ].
 
514
Qed.
 
515
 
 
516
(*******************************)
 
517
(** *       PowerRZ            *)
 
518
(*******************************)
 
519
(*i Due to L.Thery i*)
 
520
 
 
521
Ltac case_eq name :=
 
522
  generalize (refl_equal name); pattern name at -1 in |- *; case name.
 
523
 
 
524
Definition powerRZ (x:R) (n:Z) :=
 
525
  match n with
 
526
    | Z0 => 1
 
527
    | Zpos p => x ^ nat_of_P p
 
528
    | Zneg p => / x ^ nat_of_P p
 
529
  end.
 
530
 
 
531
Infix Local "^Z" := powerRZ (at level 30, right associativity) : R_scope.
 
532
 
 
533
Lemma Zpower_NR0 :
 
534
  forall (x:Z) (n:nat), (0 <= x)%Z -> (0 <= Zpower_nat x n)%Z.
 
535
Proof.
 
536
  induction n; unfold Zpower_nat in |- *; simpl in |- *; auto with zarith.
 
537
Qed.
 
538
 
 
539
Lemma powerRZ_O : forall x:R, x ^Z 0 = 1.
 
540
Proof.
 
541
  reflexivity.
 
542
Qed.
 
543
 
 
544
Lemma powerRZ_1 : forall x:R, x ^Z Zsucc 0 = x.
 
545
Proof.
 
546
  simpl in |- *; auto with real.
 
547
Qed.
 
548
 
 
549
Lemma powerRZ_NOR : forall (x:R) (z:Z), x <> 0 -> x ^Z z <> 0.
 
550
Proof.
 
551
  destruct z; simpl in |- *; auto with real.
 
552
Qed.
 
553
 
 
554
Lemma powerRZ_add :
 
555
  forall (x:R) (n m:Z), x <> 0 -> x ^Z (n + m) = x ^Z n * x ^Z m.
 
556
Proof.
 
557
  intro x; destruct n as [| n1| n1]; destruct m as [| m1| m1]; simpl in |- *;
 
558
    auto with real.
 
559
(* POS/POS *)
 
560
  rewrite nat_of_P_plus_morphism; auto with real.
 
561
(* POS/NEG *)
 
562
  case_eq ((n1 ?= m1)%positive Datatypes.Eq); simpl in |- *; auto with real.
 
563
  intros H' H'0; rewrite Pcompare_Eq_eq with (1 := H'); auto with real.
 
564
  intros H' H'0; rewrite (nat_of_P_minus_morphism m1 n1); auto with real.
 
565
  rewrite (pow_RN_plus x (nat_of_P m1 - nat_of_P n1) (nat_of_P n1));
 
566
    auto with real.
 
567
  rewrite plus_comm; rewrite le_plus_minus_r; auto with real.
 
568
  rewrite Rinv_mult_distr; auto with real.
 
569
  rewrite Rinv_involutive; auto with real.
 
570
  apply lt_le_weak.
 
571
  apply nat_of_P_lt_Lt_compare_morphism; auto.
 
572
  apply ZC2; auto.
 
573
  intros H' H'0; rewrite (nat_of_P_minus_morphism n1 m1); auto with real.
 
574
  rewrite (pow_RN_plus x (nat_of_P n1 - nat_of_P m1) (nat_of_P m1));
 
575
    auto with real.
 
576
  rewrite plus_comm; rewrite le_plus_minus_r; auto with real.
 
577
  apply lt_le_weak.
 
578
  change (nat_of_P n1 > nat_of_P m1)%nat in |- *.
 
579
  apply nat_of_P_gt_Gt_compare_morphism; auto.
 
580
(* NEG/POS *)
 
581
  case_eq ((n1 ?= m1)%positive Datatypes.Eq); simpl in |- *; auto with real.
 
582
  intros H' H'0; rewrite Pcompare_Eq_eq with (1 := H'); auto with real.
 
583
  intros H' H'0; rewrite (nat_of_P_minus_morphism m1 n1); auto with real.
 
584
  rewrite (pow_RN_plus x (nat_of_P m1 - nat_of_P n1) (nat_of_P n1));
 
585
    auto with real.
 
586
  rewrite plus_comm; rewrite le_plus_minus_r; auto with real.
 
587
  apply lt_le_weak.
 
588
  apply nat_of_P_lt_Lt_compare_morphism; auto.
 
589
  apply ZC2; auto.
 
590
  intros H' H'0; rewrite (nat_of_P_minus_morphism n1 m1); auto with real.
 
591
  rewrite (pow_RN_plus x (nat_of_P n1 - nat_of_P m1) (nat_of_P m1));
 
592
    auto with real.
 
593
  rewrite plus_comm; rewrite le_plus_minus_r; auto with real.
 
594
  rewrite Rinv_mult_distr; auto with real.
 
595
  apply lt_le_weak.
 
596
  change (nat_of_P n1 > nat_of_P m1)%nat in |- *.
 
597
  apply nat_of_P_gt_Gt_compare_morphism; auto.
 
598
(* NEG/NEG *)
 
599
  rewrite nat_of_P_plus_morphism; auto with real.
 
600
  intros H'; rewrite pow_add; auto with real.
 
601
  apply Rinv_mult_distr; auto.
 
602
  apply pow_nonzero; auto.
 
603
  apply pow_nonzero; auto.
 
604
Qed.
 
605
Hint Resolve powerRZ_O powerRZ_1 powerRZ_NOR powerRZ_add: real.
 
606
 
 
607
Lemma Zpower_nat_powerRZ :
 
608
  forall n m:nat, IZR (Zpower_nat (Z_of_nat n) m) = INR n ^Z Z_of_nat m.
 
609
Proof.
 
610
  intros n m; elim m; simpl in |- *; auto with real.
 
611
  intros m1 H'; rewrite nat_of_P_o_P_of_succ_nat_eq_succ; simpl in |- *.
 
612
  replace (Zpower_nat (Z_of_nat n) (S m1)) with
 
613
  (Z_of_nat n * Zpower_nat (Z_of_nat n) m1)%Z.
 
614
  rewrite mult_IZR; auto with real.
 
615
  repeat rewrite <- INR_IZR_INZ; simpl in |- *.
 
616
  rewrite H'; simpl in |- *.
 
617
  case m1; simpl in |- *; auto with real.
 
618
  intros m2; rewrite nat_of_P_o_P_of_succ_nat_eq_succ; auto.
 
619
  unfold Zpower_nat in |- *; auto.
 
620
Qed.
 
621
 
 
622
Lemma powerRZ_lt : forall (x:R) (z:Z), 0 < x -> 0 < x ^Z z.
 
623
Proof.
 
624
  intros x z; case z; simpl in |- *; auto with real.
 
625
Qed.
 
626
Hint Resolve powerRZ_lt: real.
 
627
 
 
628
Lemma powerRZ_le : forall (x:R) (z:Z), 0 < x -> 0 <= x ^Z z.
 
629
Proof.
 
630
  intros x z H'; apply Rlt_le; auto with real.
 
631
Qed.
 
632
Hint Resolve powerRZ_le: real.
 
633
 
 
634
Lemma Zpower_nat_powerRZ_absolu :
 
635
  forall n m:Z, (0 <= m)%Z -> IZR (Zpower_nat n (Zabs_nat m)) = IZR n ^Z m.
 
636
Proof.
 
637
  intros n m; case m; simpl in |- *; auto with zarith.
 
638
  intros p H'; elim (nat_of_P p); simpl in |- *; auto with zarith.
 
639
  intros n0 H'0; rewrite <- H'0; simpl in |- *; auto with zarith.
 
640
  rewrite <- mult_IZR; auto.
 
641
  intros p H'; absurd (0 <= Zneg p)%Z; auto with zarith.
 
642
Qed.
 
643
 
 
644
Lemma powerRZ_R1 : forall n:Z, 1 ^Z n = 1.
 
645
Proof.
 
646
  intros n; case n; simpl in |- *; auto.
 
647
  intros p; elim (nat_of_P p); simpl in |- *; auto; intros n0 H'; rewrite H';
 
648
    ring.
 
649
  intros p; elim (nat_of_P p); simpl in |- *.
 
650
  exact Rinv_1.
 
651
  intros n1 H'; rewrite Rinv_mult_distr; try rewrite Rinv_1; try rewrite H';
 
652
    auto with real.
 
653
Qed.
 
654
 
 
655
(*******************************)
 
656
(* For easy interface          *)
 
657
(*******************************)
 
658
(* decimal_exp r z is defined as r 10^z *)
 
659
 
 
660
Definition decimal_exp (r:R) (z:Z) : R := (r * 10 ^Z z).
 
661
 
 
662
 
 
663
(*******************************)
 
664
(** * Sum of n first naturals  *)
 
665
(*******************************)
 
666
(*********)
 
667
Boxed Fixpoint sum_nat_f_O (f:nat -> nat) (n:nat) {struct n} : nat :=
 
668
  match n with
 
669
    | O => f 0%nat
 
670
    | S n' => (sum_nat_f_O f n' + f (S n'))%nat
 
671
  end.
 
672
 
 
673
(*********)
 
674
Definition sum_nat_f (s n:nat) (f:nat -> nat) : nat :=
 
675
  sum_nat_f_O (fun x:nat => f (x + s)%nat) (n - s).
 
676
 
 
677
(*********)
 
678
Definition sum_nat_O (n:nat) : nat := sum_nat_f_O (fun x:nat => x) n.
 
679
 
 
680
(*********)
 
681
Definition sum_nat (s n:nat) : nat := sum_nat_f s n (fun x:nat => x).
 
682
 
 
683
(*******************************)
 
684
(** *          Sum             *)
 
685
(*******************************)
 
686
(*********)
 
687
Fixpoint sum_f_R0 (f:nat -> R) (N:nat) {struct N} : R :=
 
688
  match N with
 
689
    | O => f 0%nat
 
690
    | S i => sum_f_R0 f i + f (S i)
 
691
  end.
 
692
 
 
693
(*********)
 
694
Definition sum_f (s n:nat) (f:nat -> R) : R :=
 
695
  sum_f_R0 (fun x:nat => f (x + s)%nat) (n - s).
 
696
 
 
697
Lemma GP_finite :
 
698
  forall (x:R) (n:nat),
 
699
    sum_f_R0 (fun n:nat => x ^ n) n * (x - 1) = x ^ (n + 1) - 1.
 
700
Proof.
 
701
  intros; induction  n as [| n Hrecn]; simpl in |- *.
 
702
  ring.
 
703
  rewrite Rmult_plus_distr_r; rewrite Hrecn; cut ((n + 1)%nat = S n).
 
704
  intro H; rewrite H; simpl in |- *; ring.
 
705
  omega.
 
706
Qed.
 
707
 
 
708
Lemma sum_f_R0_triangle :
 
709
  forall (x:nat -> R) (n:nat),
 
710
    Rabs (sum_f_R0 x n) <= sum_f_R0 (fun i:nat => Rabs (x i)) n.
 
711
Proof.
 
712
  intro; simple induction n; simpl in |- *.
 
713
  unfold Rle in |- *; right; reflexivity.
 
714
  intro m; intro;
 
715
    apply
 
716
      (Rle_trans (Rabs (sum_f_R0 x m + x (S m)))
 
717
        (Rabs (sum_f_R0 x m) + Rabs (x (S m)))
 
718
        (sum_f_R0 (fun i:nat => Rabs (x i)) m + Rabs (x (S m)))).
 
719
  apply Rabs_triang.
 
720
  rewrite Rplus_comm;
 
721
    rewrite (Rplus_comm (sum_f_R0 (fun i:nat => Rabs (x i)) m) (Rabs (x (S m))));
 
722
      apply Rplus_le_compat_l; assumption.
 
723
Qed.
 
724
 
 
725
(*******************************)
 
726
(** *     Distance  in R       *)
 
727
(*******************************)
 
728
 
 
729
(*********)
 
730
Definition R_dist (x y:R) : R := Rabs (x - y).
 
731
 
 
732
(*********)
 
733
Lemma R_dist_pos : forall x y:R, R_dist x y >= 0.
 
734
Proof.
 
735
  intros; unfold R_dist in |- *; unfold Rabs in |- *; case (Rcase_abs (x - y));
 
736
    intro l.
 
737
  unfold Rge in |- *; left; apply (Ropp_gt_lt_0_contravar (x - y) l).
 
738
  trivial.
 
739
Qed.
 
740
 
 
741
(*********)
 
742
Lemma R_dist_sym : forall x y:R, R_dist x y = R_dist y x.
 
743
Proof.
 
744
  unfold R_dist in |- *; intros; split_Rabs; try ring.
 
745
  generalize (Ropp_gt_lt_0_contravar (y - x) r); intro;
 
746
    rewrite (Ropp_minus_distr y x) in H; generalize (Rlt_asym (x - y) 0 r0);
 
747
      intro; unfold Rgt in H; elimtype False; auto.
 
748
  generalize (minus_Rge y x r); intro; generalize (minus_Rge x y r0); intro;
 
749
    generalize (Rge_antisym x y H0 H); intro; rewrite H1; 
 
750
      ring.
 
751
Qed.
 
752
 
 
753
(*********)
 
754
Lemma R_dist_refl : forall x y:R, R_dist x y = 0 <-> x = y.
 
755
Proof.
 
756
  unfold R_dist in |- *; intros; split_Rabs; split; intros.
 
757
  rewrite (Ropp_minus_distr x y) in H; apply sym_eq;
 
758
    apply (Rminus_diag_uniq y x H).
 
759
  rewrite (Ropp_minus_distr x y); generalize (sym_eq H); intro;
 
760
    apply (Rminus_diag_eq y x H0).
 
761
  apply (Rminus_diag_uniq x y H).
 
762
  apply (Rminus_diag_eq x y H). 
 
763
Qed.
 
764
 
 
765
Lemma R_dist_eq : forall x:R, R_dist x x = 0.
 
766
Proof.
 
767
  unfold R_dist in |- *; intros; split_Rabs; intros; ring.
 
768
Qed.
 
769
 
 
770
(***********)
 
771
Lemma R_dist_tri : forall x y z:R, R_dist x y <= R_dist x z + R_dist z y.
 
772
Proof.
 
773
  intros; unfold R_dist in |- *; replace (x - y) with (x - z + (z - y));
 
774
    [ apply (Rabs_triang (x - z) (z - y)) | ring ].
 
775
Qed.
 
776
 
 
777
(*********)
 
778
Lemma R_dist_plus :
 
779
  forall a b c d:R, R_dist (a + c) (b + d) <= R_dist a b + R_dist c d.
 
780
Proof.
 
781
  intros; unfold R_dist in |- *;
 
782
    replace (a + c - (b + d)) with (a - b + (c - d)).
 
783
  exact (Rabs_triang (a - b) (c - d)).
 
784
  ring.
 
785
Qed.
 
786
 
 
787
(*******************************)
 
788
(** *     Infinite Sum          *)
 
789
(*******************************)
 
790
(*********)
 
791
Definition infinite_sum (s:nat -> R) (l:R) : Prop :=
 
792
  forall eps:R,
 
793
    eps > 0 ->
 
794
    exists N : nat,
 
795
      (forall n:nat, (n >= N)%nat -> R_dist (sum_f_R0 s n) l < eps).
 
796
 
 
797
(** Compatibility with previous versions *)
 
798
Notation infinit_sum := infinite_sum (only parsing).