Update from HH
[hl193./.git] / Library / transc.ml
1 (* ======================================================================== *)
2 (* Properties of power series.                                              *)
3 (* ======================================================================== *)
4
5 needs "Library/analysis.ml";;
6
7 (* ------------------------------------------------------------------------ *)
8 (* More theorems about rearranging finite sums                              *)
9 (* ------------------------------------------------------------------------ *)
10
11 let POWDIFF_LEMMA = prove(
12   `!n x y. sum(0,SUC n)(\p. (x pow p) * y pow ((SUC n) - p)) =
13                 y * sum(0,SUC n)(\p. (x pow p) * (y pow (n - p)))`,
14   REPEAT GEN_TAC THEN REWRITE_TAC[GSYM SUM_CMUL] THEN
15   MATCH_MP_TAC SUM_SUBST THEN X_GEN_TAC `p:num` THEN DISCH_TAC THEN
16   BETA_TAC THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN
17   REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN
18   SUBGOAL_THEN `~(n < p:num)` ASSUME_TAC THENL
19    [POP_ASSUM(MP_TAC o CONJUNCT2) THEN REWRITE_TAC[ADD_CLAUSES] THEN
20     REWRITE_TAC[NOT_LT; CONJUNCT2 LT] THEN
21     DISCH_THEN(DISJ_CASES_THEN2 SUBST1_TAC MP_TAC) THEN
22     REWRITE_TAC[LE_REFL; LT_IMP_LE];
23     ASM_REWRITE_TAC[SUB_OLD] THEN REWRITE_TAC[pow] THEN
24     MATCH_ACCEPT_TAC REAL_MUL_SYM]);;
25
26 let POWDIFF = prove(
27   `!n x y. (x pow (SUC n)) - (y pow (SUC n)) =
28                 (x - y) * sum(0,SUC n)(\p. (x pow p) * (y pow (n - p)))`,
29   INDUCT_TAC THENL
30    [REPEAT GEN_TAC THEN REWRITE_TAC[sum] THEN
31     REWRITE_TAC[REAL_ADD_LID; ADD_CLAUSES; SUB_0] THEN
32     BETA_TAC THEN REWRITE_TAC[pow] THEN
33     REWRITE_TAC[REAL_MUL_RID];
34     REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[sum] THEN
35     REWRITE_TAC[ADD_CLAUSES] THEN BETA_TAC THEN
36     REWRITE_TAC[POWDIFF_LEMMA] THEN REWRITE_TAC[REAL_LDISTRIB] THEN
37     ONCE_REWRITE_TAC[AC REAL_MUL_AC
38       `a * (b * c) = b * (a * c)`] THEN
39     POP_ASSUM(fun th -> ONCE_REWRITE_TAC[GSYM th]) THEN
40     REWRITE_TAC[SUB_REFL] THEN
41     SPEC_TAC(`SUC n`,`n:num`) THEN GEN_TAC THEN
42     REWRITE_TAC[pow; REAL_MUL_RID] THEN
43     REWRITE_TAC[REAL_LDISTRIB; REAL_SUB_LDISTRIB] THEN
44     REWRITE_TAC[real_sub] THEN
45     ONCE_REWRITE_TAC[AC REAL_ADD_AC
46       `(a + b) + (c + d) = (d + a) + (c + b)`] THEN
47     GEN_REWRITE_TAC (funpow 2 LAND_CONV) [REAL_MUL_SYM] THEN
48     CONV_TAC SYM_CONV THEN REWRITE_TAC[REAL_ADD_LID_UNIQ] THEN
49     GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [REAL_MUL_SYM] THEN
50     REWRITE_TAC[REAL_ADD_LINV]]);;
51
52 let POWREV = prove(
53   `!n x y. sum(0,SUC n)(\p. (x pow p) * (y pow (n - p))) =
54                 sum(0,SUC n)(\p. (x pow (n - p)) * (y pow p))`,
55   let REAL_EQ_LMUL2' = CONV_RULE(REDEPTH_CONV FORALL_IMP_CONV) REAL_EQ_LMUL2 in
56   REPEAT GEN_TAC THEN ASM_CASES_TAC `x:real = y` THENL
57    [ASM_REWRITE_TAC[GSYM POW_ADD] THEN
58     MATCH_MP_TAC SUM_SUBST THEN X_GEN_TAC `p:num` THEN
59     BETA_TAC THEN DISCH_TAC THEN AP_TERM_TAC THEN
60     MATCH_ACCEPT_TAC ADD_SYM;
61     GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [REAL_MUL_SYM] THEN
62     RULE_ASSUM_TAC(ONCE_REWRITE_RULE[GSYM REAL_SUB_0]) THEN
63     FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [MATCH_MP REAL_EQ_LMUL2' th]) THEN
64     GEN_REWRITE_TAC RAND_CONV [GSYM REAL_NEGNEG] THEN
65     ONCE_REWRITE_TAC[REAL_NEG_LMUL] THEN
66     ONCE_REWRITE_TAC[REAL_NEG_SUB] THEN
67     REWRITE_TAC[GSYM POWDIFF] THEN REWRITE_TAC[REAL_NEG_SUB]]);;
68
69 (* ------------------------------------------------------------------------ *)
70 (* Show (essentially) that a power series has a "circle" of convergence,    *)
71 (* i.e. if it sums for x, then it sums absolutely for z with |z| < |x|.     *)
72 (* ------------------------------------------------------------------------ *)
73
74 let POWSER_INSIDEA = prove(
75   `!f x z. summable (\n. f(n) * (x pow n)) /\ abs(z) < abs(x)
76         ==> summable (\n. abs(f(n)) * (z pow n))`,
77   let th = (GEN_ALL o CONV_RULE LEFT_IMP_EXISTS_CONV o snd o
78               EQ_IMP_RULE o SPEC_ALL) convergent in
79   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
80   DISCH_THEN(MP_TAC o MATCH_MP SER_ZERO) THEN
81   DISCH_THEN(MP_TAC o MATCH_MP th) THEN REWRITE_TAC[GSYM SEQ_CAUCHY] THEN
82   DISCH_THEN(MP_TAC o MATCH_MP SEQ_CBOUNDED) THEN
83   REWRITE_TAC[SEQ_BOUNDED] THEN BETA_TAC THEN
84   DISCH_THEN(X_CHOOSE_TAC `K:real`) THEN MATCH_MP_TAC SER_COMPAR THEN
85   EXISTS_TAC `\n. (K * abs(z pow n)) / abs(x pow n)` THEN CONJ_TAC THENL
86    [EXISTS_TAC `0` THEN X_GEN_TAC `n:num` THEN DISCH_THEN(K ALL_TAC) THEN
87     BETA_TAC THEN MATCH_MP_TAC REAL_LE_RDIV THEN CONJ_TAC THENL
88      [REWRITE_TAC[GSYM ABS_NZ] THEN MATCH_MP_TAC POW_NZ THEN
89       REWRITE_TAC[ABS_NZ] THEN MATCH_MP_TAC REAL_LET_TRANS THEN
90       EXISTS_TAC `abs(z)` THEN ASM_REWRITE_TAC[ABS_POS];
91       REWRITE_TAC[ABS_MUL; ABS_ABS; GSYM REAL_MUL_ASSOC] THEN
92       ONCE_REWRITE_TAC[AC REAL_MUL_AC
93        `a * b * c = (a * c) * b`] THEN
94       DISJ_CASES_TAC(SPEC `z pow n` ABS_CASES) THEN
95       ASM_REWRITE_TAC[ABS_0; REAL_MUL_RZERO; REAL_LE_REFL] THEN
96       FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_LE_RMUL_EQ th]) THEN
97       MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[GSYM ABS_MUL]];
98     REWRITE_TAC[summable] THEN
99     EXISTS_TAC `K * inv(&1 - (abs(z) / abs(x)))` THEN
100     REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN
101     CONV_TAC(ONCE_DEPTH_CONV HABS_CONV) THEN REWRITE_TAC[] THEN
102     MATCH_MP_TAC SER_CMUL THEN
103     GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) [GSYM real_div] THEN
104     SUBGOAL_THEN `!n. abs(z pow n) / abs(x pow n) =
105                         (abs(z) / abs(x)) pow n`
106     (fun th -> ONCE_REWRITE_TAC[th]) THENL
107      [ALL_TAC; REWRITE_TAC[GSYM real_div] THEN
108       MATCH_MP_TAC GP THEN REWRITE_TAC[real_div; ABS_MUL] THEN
109       SUBGOAL_THEN `~(abs(x) = &0)` (SUBST1_TAC o MATCH_MP ABS_INV) THENL
110        [DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC `abs(z) < &0` THEN
111         REWRITE_TAC[REAL_NOT_LT; ABS_POS];
112         REWRITE_TAC[ABS_ABS; GSYM real_div] THEN
113         MATCH_MP_TAC REAL_LT_1 THEN ASM_REWRITE_TAC[ABS_POS]]] THEN
114     REWRITE_TAC[GSYM POW_ABS] THEN X_GEN_TAC `n:num` THEN
115     REWRITE_TAC[real_div; POW_MUL] THEN AP_TERM_TAC THEN
116     MATCH_MP_TAC POW_INV THEN CONV_TAC(RAND_CONV SYM_CONV) THEN
117     MATCH_MP_TAC REAL_LT_IMP_NE THEN
118     MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(z)` THEN
119     ASM_REWRITE_TAC[ABS_POS]]);;
120
121 (* ------------------------------------------------------------------------ *)
122 (* Weaker but more commonly useful form for non-absolute convergence        *)
123 (* ------------------------------------------------------------------------ *)
124
125 let POWSER_INSIDE = prove(
126   `!f x z. summable (\n. f(n) * (x pow n)) /\ abs(z) < abs(x)
127         ==> summable (\n. f(n) * (z pow n))`,
128   REPEAT GEN_TAC THEN
129   SUBST1_TAC(SYM(SPEC `z:real` ABS_ABS)) THEN
130   DISCH_THEN(MP_TAC o MATCH_MP POWSER_INSIDEA) THEN
131   REWRITE_TAC[POW_ABS; GSYM ABS_MUL] THEN
132   DISCH_THEN((then_) (MATCH_MP_TAC SER_ACONV) o MP_TAC) THEN
133   BETA_TAC THEN DISCH_THEN ACCEPT_TAC);;
134
135 (* ------------------------------------------------------------------------ *)
136 (* Define formal differentiation of power series                            *)
137 (* ------------------------------------------------------------------------ *)
138
139 let diffs = new_definition
140   `diffs c = (\n. &(SUC n) * c(SUC n))`;;
141
142 (* ------------------------------------------------------------------------ *)
143 (* Lemma about distributing negation over it                                *)
144 (* ------------------------------------------------------------------------ *)
145
146 let DIFFS_NEG = prove(
147   `!c. diffs(\n. --(c n)) = \n. --((diffs c) n)`,
148   GEN_TAC THEN REWRITE_TAC[diffs] THEN BETA_TAC THEN
149   REWRITE_TAC[REAL_NEG_RMUL]);;
150
151 (* ------------------------------------------------------------------------ *)
152 (* Show that we can shift the terms down one                                *)
153 (* ------------------------------------------------------------------------ *)
154
155 let DIFFS_LEMMA = prove(
156   `!n c x. sum(0,n) (\n. (diffs c)(n) * (x pow n)) =
157            sum(0,n) (\n. &n * c(n) * (x pow (n - 1))) +
158              (&n * c(n) * x pow (n - 1))`,
159   INDUCT_TAC THEN ASM_REWRITE_TAC[sum; REAL_MUL_LZERO; REAL_ADD_LID] THEN
160   REPEAT GEN_TAC THEN REWRITE_TAC[GSYM REAL_ADD_ASSOC] THEN
161   AP_TERM_TAC THEN BETA_TAC THEN REWRITE_TAC[ADD_CLAUSES] THEN
162   AP_TERM_TAC THEN REWRITE_TAC[diffs] THEN BETA_TAC THEN
163   REWRITE_TAC[SUC_SUB1; REAL_MUL_ASSOC]);;
164
165 let DIFFS_LEMMA2 = prove(
166   `!n c x. sum(0,n) (\n. &n * c(n) * (x pow (n - 1))) =
167            sum(0,n) (\n. (diffs c)(n) * (x pow n)) -
168                 (&n * c(n) * x pow (n - 1))`,
169   REPEAT GEN_TAC THEN REWRITE_TAC[REAL_EQ_SUB_LADD; DIFFS_LEMMA]);;
170
171 let DIFFS_EQUIV = prove(
172   `!c x. summable(\n. (diffs c)(n) * (x pow n)) ==>
173       (\n. &n * c(n) * (x pow (n - 1))) sums
174          (suminf(\n. (diffs c)(n) * (x pow n)))`,
175   REPEAT GEN_TAC THEN DISCH_TAC THEN
176   FIRST_ASSUM(MP_TAC o REWRITE_RULE[diffs] o MATCH_MP SER_ZERO) THEN
177   BETA_TAC THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN DISCH_TAC THEN
178   SUBGOAL_THEN `(\n. &n * c(n) * (x pow (n - 1))) tends_num_real &0`
179   MP_TAC THENL
180    [ONCE_REWRITE_TAC[SEQ_SUC] THEN BETA_TAC THEN
181     ASM_REWRITE_TAC[SUC_SUB1]; ALL_TAC] THEN
182   DISCH_THEN(MP_TAC o CONJ (MATCH_MP SUMMABLE_SUM
183    (ASSUME `summable(\n. (diffs c)(n) * (x pow n))`))) THEN
184   REWRITE_TAC[sums] THEN DISCH_THEN(MP_TAC o MATCH_MP SEQ_SUB) THEN
185   BETA_TAC THEN REWRITE_TAC[GSYM DIFFS_LEMMA2] THEN
186   REWRITE_TAC[REAL_SUB_RZERO]);;
187
188 (* ======================================================================== *)
189 (* Show term-by-term differentiability of power series                      *)
190 (* (NB we hypothesize convergence of first two derivatives; we could prove  *)
191 (*  they all have the same radius of convergence, but we don't need to.)    *)
192 (* ======================================================================== *)
193
194 let TERMDIFF_LEMMA1 = prove(
195   `!m z h.
196      sum(0,m)(\p. (((z + h) pow (m - p)) * (z pow p)) - (z pow m)) =
197        sum(0,m)(\p. (z pow p) *
198        (((z + h) pow (m - p)) - (z pow (m - p))))`,
199   REPEAT GEN_TAC THEN MATCH_MP_TAC SUM_SUBST THEN
200   X_GEN_TAC `p:num` THEN DISCH_TAC THEN BETA_TAC THEN
201   REWRITE_TAC[REAL_SUB_LDISTRIB; GSYM POW_ADD] THEN BINOP_TAC THENL
202    [MATCH_ACCEPT_TAC REAL_MUL_SYM;
203     AP_TERM_TAC THEN ONCE_REWRITE_TAC[ADD_SYM] THEN
204     CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUB_ADD THEN
205     MATCH_MP_TAC LT_IMP_LE THEN
206     POP_ASSUM(MP_TAC o CONJUNCT2) THEN REWRITE_TAC[ADD_CLAUSES]]);;
207
208 let TERMDIFF_LEMMA2 = prove(
209   `!z h. ~(h = &0) ==>
210        (((((z + h) pow n) - (z pow n)) / h) - (&n * (z pow (n - 1))) =
211         h * sum(0,n - 1)(\p. (z pow p) *
212               sum(0,(n - 1) - p)
213                 (\q. ((z + h) pow q) *
214                        (z pow (((n - 2) - p) - q)))))`,
215   REPEAT GEN_TAC THEN DISCH_TAC THEN
216   FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [MATCH_MP REAL_EQ_LMUL2 th]) THEN
217   REWRITE_TAC[REAL_SUB_LDISTRIB] THEN
218   FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_DIV_LMUL th]) THEN
219   DISJ_CASES_THEN2 SUBST1_TAC (X_CHOOSE_THEN `m:num` SUBST1_TAC)
220   (SPEC `n:num` num_CASES) THENL
221    [REWRITE_TAC[pow; REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_SUB_REFL] THEN
222     REWRITE_TAC[SUB_0; sum; REAL_MUL_RZERO]; ALL_TAC] THEN
223   REWRITE_TAC[POWDIFF; REAL_ADD_SUB] THEN
224   ASM_REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; REAL_EQ_LMUL] THEN
225   REWRITE_TAC[SUC_SUB1] THEN
226   GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) [POWREV] THEN
227   REWRITE_TAC[sum] THEN REWRITE_TAC[ADD_CLAUSES] THEN BETA_TAC THEN
228   REWRITE_TAC[SUB_REFL] THEN REWRITE_TAC[REAL; pow] THEN
229   REWRITE_TAC[REAL_MUL_LID; REAL_MUL_RID; REAL_RDISTRIB] THEN
230   REWRITE_TAC[REAL_ADD2_SUB2; REAL_SUB_REFL; REAL_ADD_RID] THEN
231   REWRITE_TAC[SUM_NSUB] THEN BETA_TAC THEN
232   REWRITE_TAC[TERMDIFF_LEMMA1] THEN
233   ONCE_REWRITE_TAC[GSYM SUM_CMUL] THEN BETA_TAC THEN
234   MATCH_MP_TAC SUM_SUBST THEN X_GEN_TAC `p:num` THEN
235   REWRITE_TAC[ADD_CLAUSES] THEN DISCH_TAC THEN BETA_TAC THEN
236   GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN
237   REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN
238   FIRST_ASSUM(MP_TAC o CONJUNCT2) THEN
239   DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC o MATCH_MP LESS_ADD_1) THEN
240   REWRITE_TAC[GSYM ADD1] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN
241   REWRITE_TAC[ADD_SUB] THEN REWRITE_TAC[POWDIFF; REAL_ADD_SUB] THEN
242   GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [REAL_MUL_SYM] THEN
243   AP_TERM_TAC THEN MATCH_MP_TAC SUM_SUBST THEN X_GEN_TAC `q:num` THEN
244   REWRITE_TAC[ADD_CLAUSES] THEN STRIP_TAC THEN BETA_TAC THEN
245   AP_TERM_TAC THEN AP_TERM_TAC THEN CONV_TAC(TOP_DEPTH_CONV num_CONV) THEN
246   REWRITE_TAC[SUB_SUC; SUB_0; ADD_SUB]);;
247
248 let TERMDIFF_LEMMA3 = prove(
249   `!z h n K. ~(h = &0) /\ abs(z) <= K /\ abs(z + h) <= K ==>
250     abs(((((z + h) pow n) - (z pow n)) / h) - (&n * (z pow (n - 1))))
251         <= &n * &(n - 1) * (K pow (n - 2)) * abs(h)`,
252   let tac = W((then_) (MATCH_MP_TAC REAL_LE_TRANS) o
253            EXISTS_TAC o rand o concl o PART_MATCH (rand o rator) ABS_SUM o
254            rand o rator o snd)  THEN REWRITE_TAC[ABS_SUM] in
255   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN
256   FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP TERMDIFF_LEMMA2 th]) THEN
257   REWRITE_TAC[ABS_MUL] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN
258   GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN
259   REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN
260   FIRST_ASSUM(ASSUME_TAC o CONV_RULE(REWR_CONV ABS_NZ)) THEN
261   FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [MATCH_MP REAL_LE_LMUL_LOCAL th]) THEN
262   tac THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN
263   GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN
264   REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN
265   MATCH_MP_TAC SUM_BOUND THEN X_GEN_TAC `p:num` THEN
266   REWRITE_TAC[ADD_CLAUSES] THEN DISCH_THEN STRIP_ASSUME_TAC THEN
267   BETA_TAC THEN REWRITE_TAC[ABS_MUL] THEN
268   DISJ_CASES_THEN2 SUBST1_TAC (X_CHOOSE_THEN `r:num` SUBST_ALL_TAC)
269   (SPEC `n:num` num_CASES) THENL
270    [REWRITE_TAC[SUB_0; sum; ABS_0; REAL_MUL_RZERO; REAL_LE_REFL];
271     ALL_TAC] THEN
272   REWRITE_TAC[SUC_SUB1; num_CONV `2`; SUB_SUC] THEN
273   RULE_ASSUM_TAC(REWRITE_RULE[SUC_SUB1]) THEN
274   SUBGOAL_THEN `p < r:num` MP_TAC THENL
275    [FIRST_ASSUM MATCH_ACCEPT_TAC; ALL_TAC] THEN
276   DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC o MATCH_MP LESS_ADD_1) THEN
277   REWRITE_TAC[GSYM ADD1] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN
278   REWRITE_TAC[ADD_SUB] THEN REWRITE_TAC[ADD_CLAUSES; SUC_SUB1; ADD_SUB] THEN
279   REWRITE_TAC[POW_ADD] THEN GEN_REWRITE_TAC RAND_CONV
280    [AC REAL_MUL_AC
281         `(a * b) * c = b * (c * a)`] THEN
282   MATCH_MP_TAC REAL_LE_MUL2V THEN REWRITE_TAC[ABS_POS] THEN CONJ_TAC THENL
283    [REWRITE_TAC[GSYM POW_ABS] THEN MATCH_MP_TAC POW_LE THEN
284     ASM_REWRITE_TAC[ABS_POS]; ALL_TAC] THEN
285   MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&(SUC d) * (K pow d)` THEN
286   CONJ_TAC THENL
287    [ALL_TAC; SUBGOAL_THEN `&0 <= K` MP_TAC THENL
288      [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs z` THEN
289       ASM_REWRITE_TAC[ABS_POS];
290       DISCH_THEN(MP_TAC o SPEC `d:num` o MATCH_MP POW_POS) THEN
291       DISCH_THEN(DISJ_CASES_THEN MP_TAC o REWRITE_RULE[REAL_LE_LT]) THENL
292        [DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP REAL_LE_RMUL_EQ th]) THEN
293         REWRITE_TAC[REAL_LE; LE_SUC] THEN
294         MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `SUC d` THEN
295         REWRITE_TAC[LE_SUC; LE_ADD] THEN
296         MATCH_MP_TAC LT_IMP_LE THEN REWRITE_TAC[LESS_SUC_REFL];
297         DISCH_THEN(SUBST1_TAC o SYM) THEN
298         REWRITE_TAC[REAL_MUL_RZERO; REAL_LE_REFL]]]] THEN
299   tac THEN MATCH_MP_TAC SUM_BOUND THEN X_GEN_TAC `q:num` THEN
300   REWRITE_TAC[ADD_CLAUSES] THEN STRIP_TAC THEN BETA_TAC THEN
301   UNDISCH_TAC `q < (SUC d)` THEN
302   DISCH_THEN(X_CHOOSE_THEN `e:num` MP_TAC o MATCH_MP LESS_ADD_1) THEN
303   REWRITE_TAC[GSYM ADD1; ADD_CLAUSES; SUC_INJ] THEN
304   DISCH_THEN SUBST_ALL_TAC THEN REWRITE_TAC[POW_ADD] THEN
305   ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN
306   REWRITE_TAC[ABS_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2V THEN
307   REWRITE_TAC[ABS_POS; GSYM POW_ABS] THEN
308   CONJ_TAC THEN MATCH_MP_TAC POW_LE THEN ASM_REWRITE_TAC[ABS_POS]);;
309
310 let TERMDIFF_LEMMA4 = prove(
311   `!f K k. &0 < k /\
312            (!h. &0 < abs(h) /\ abs(h) < k ==> abs(f h) <= K * abs(h))
313         ==> (f tends_real_real &0)(&0)`,
314   REPEAT GEN_TAC THEN STRIP_TAC THEN
315   REWRITE_TAC[LIM; REAL_SUB_RZERO] THEN
316   SUBGOAL_THEN `&0 <= K` MP_TAC THENL
317    [FIRST_ASSUM(MP_TAC o SPEC `k / &2`) THEN
318     MP_TAC(ONCE_REWRITE_RULE[GSYM REAL_LT_HALF1] (ASSUME `&0 < k`)) THEN
319     DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN
320     DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_IMP_LE) THEN
321     DISCH_THEN(fun th -> REWRITE_TAC[th; real_abs]) THEN
322     REWRITE_TAC[GSYM real_abs] THEN
323     ASM_REWRITE_TAC[REAL_LT_HALF1; REAL_LT_HALF2] THEN DISCH_TAC THEN
324     MP_TAC(GEN_ALL(MATCH_MP REAL_LE_RMUL_EQ (ASSUME `&0 < k / &2`))) THEN
325     DISCH_THEN(fun th -> GEN_REWRITE_TAC I [GSYM th]) THEN
326     MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(f(k / &2))` THEN
327     ASM_REWRITE_TAC[REAL_MUL_LZERO; ABS_POS]; ALL_TAC] THEN
328   DISCH_THEN(DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT]) THEN
329   X_GEN_TAC `e:real` THEN DISCH_TAC THENL
330    [ALL_TAC; EXISTS_TAC `k:real` THEN REWRITE_TAC[ASSUME `&0 < k`] THEN
331     GEN_TAC THEN DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN
332     FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[REAL_MUL_LZERO] THEN
333     DISCH_THEN(MP_TAC o C CONJ(SPEC `(f:real->real) x` ABS_POS)) THEN
334     REWRITE_TAC[REAL_LE_ANTISYM] THEN DISCH_THEN SUBST1_TAC THEN
335     FIRST_ASSUM ACCEPT_TAC] THEN
336   SUBGOAL_THEN `&0 < (e / K) / &2` ASSUME_TAC THENL
337    [REWRITE_TAC[real_div] THEN
338     REPEAT(MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC) THEN
339     TRY(MATCH_MP_TAC REAL_INV_POS) THEN ASM_REWRITE_TAC[] THEN
340     REWRITE_TAC[REAL_LT; num_CONV `2`; LT_0]; ALL_TAC] THEN
341   MP_TAC(SPECL [`(e / K) / &2`; `k:real`] REAL_DOWN2) THEN
342   ASM_REWRITE_TAC[] THEN
343   DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
344   EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN
345   X_GEN_TAC `h:real` THEN DISCH_TAC THEN
346   MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `K * abs(h)` THEN CONJ_TAC THENL
347    [FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
348     MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `d:real` THEN
349     ASM_REWRITE_TAC[];
350     MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `K * d` THEN
351     ASM_REWRITE_TAC[MATCH_MP REAL_LT_LMUL_EQ (ASSUME `&0 < K`)] THEN
352     ONCE_REWRITE_TAC[GSYM(MATCH_MP REAL_LT_RDIV (ASSUME `&0 < K`))] THEN
353     REWRITE_TAC[real_div] THEN
354     ONCE_REWRITE_TAC[AC REAL_MUL_AC
355       `(a * b) * c = (c * a) * b`] THEN
356     ASSUME_TAC(GSYM(MATCH_MP REAL_LT_IMP_NE (ASSUME `&0 < K`))) THEN
357     REWRITE_TAC[MATCH_MP REAL_MUL_LINV (ASSUME `~(K = &0)`)] THEN
358     REWRITE_TAC[REAL_MUL_LID] THEN
359     MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `(e / K) / &2` THEN
360     ASM_REWRITE_TAC[GSYM real_div] THEN REWRITE_TAC[REAL_LT_HALF2] THEN
361     ONCE_REWRITE_TAC[GSYM REAL_LT_HALF1] THEN ASM_REWRITE_TAC[]]);;
362
363 let TERMDIFF_LEMMA5 = prove(
364   `!f g k. &0 < k /\
365          summable(f) /\
366          (!h. &0 < abs(h) /\ abs(h) < k ==> !n. abs(g(h) n) <= (f(n) * abs(h)))
367              ==> ((\h. suminf(g h)) tends_real_real &0)(&0)`,
368   REPEAT GEN_TAC THEN
369   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
370   DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o MATCH_MP SUMMABLE_SUM) MP_TAC) THEN
371   ASSUME_TAC((GEN `h:real` o SPEC `abs(h)` o
372     MATCH_MP SER_CMUL) (ASSUME `f sums (suminf f)`)) THEN
373   RULE_ASSUM_TAC(ONCE_REWRITE_RULE[REAL_MUL_SYM]) THEN
374   FIRST_ASSUM(ASSUME_TAC o GEN `h:real` o
375     MATCH_MP SUM_UNIQ o SPEC `h:real`) THEN DISCH_TAC THEN
376   C SUBGOAL_THEN ASSUME_TAC `!h. &0 < abs(h) /\ abs(h) < k ==>
377     abs(suminf(g h)) <= (suminf(f) * abs(h))` THENL
378    [GEN_TAC THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN
379       FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN DISCH_TAC THEN
380     SUBGOAL_THEN `summable(\n. f(n) * abs(h))` ASSUME_TAC THENL
381      [MATCH_MP_TAC SUM_SUMMABLE THEN
382       EXISTS_TAC `suminf(f) * abs(h)` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN
383     SUBGOAL_THEN `summable(\n. abs(g(h:real)(n:num)))` ASSUME_TAC THENL
384      [MATCH_MP_TAC SER_COMPAR THEN
385       EXISTS_TAC `\n:num. f(n) * abs(h)` THEN ASM_REWRITE_TAC[] THEN
386       EXISTS_TAC `0` THEN X_GEN_TAC `n:num` THEN
387       DISCH_THEN(K ALL_TAC) THEN BETA_TAC THEN REWRITE_TAC[ABS_ABS] THEN
388       FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[RIGHT_IMP_FORALL_THM]) THEN
389       ASM_REWRITE_TAC[]; ALL_TAC] THEN
390     MATCH_MP_TAC REAL_LE_TRANS THEN
391     EXISTS_TAC `suminf(\n. abs(g(h:real)(n:num)))` THEN CONJ_TAC THENL
392      [MATCH_MP_TAC SER_ABS THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN
393     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SER_LE THEN
394     REPEAT CONJ_TAC THEN TRY(FIRST_ASSUM ACCEPT_TAC) THEN
395     GEN_TAC THEN BETA_TAC THEN
396     FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[RIGHT_IMP_FORALL_THM]) THEN
397     ASM_REWRITE_TAC[]; ALL_TAC] THEN
398   MATCH_MP_TAC TERMDIFF_LEMMA4 THEN
399   MAP_EVERY EXISTS_TAC [`suminf(f)`; `k:real`] THEN
400   BETA_TAC THEN ASM_REWRITE_TAC[]);;
401
402 let TERMDIFF = prove(
403   `!c K. summable(\n. c(n) * (K pow n)) /\
404          summable(\n. (diffs c)(n) * (K pow n)) /\
405          summable(\n. (diffs(diffs c))(n) * (K pow n)) /\
406          abs(x) < abs(K)
407         ==> ((\x. suminf (\n. c(n) * (x pow n))) diffl
408              (suminf (\n. (diffs c)(n) * (x pow n))))(x)`,
409   REPEAT GEN_TAC THEN STRIP_TAC THEN
410   REWRITE_TAC[diffl] THEN BETA_TAC THEN
411   MATCH_MP_TAC LIM_TRANSFORM THEN
412   EXISTS_TAC `\h. suminf(\n. ((c(n) * ((x + h) pow n)) -
413                              (c(n) * (x pow n))) / h)` THEN CONJ_TAC THENL
414    [BETA_TAC THEN REWRITE_TAC[LIM] THEN BETA_TAC THEN
415     REWRITE_TAC[REAL_SUB_RZERO] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
416     EXISTS_TAC `abs(K) - abs(x)` THEN REWRITE_TAC[REAL_SUB_LT] THEN
417     ASM_REWRITE_TAC[] THEN X_GEN_TAC `h:real` THEN
418     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
419     DISCH_THEN(ASSUME_TAC o MATCH_MP ABS_CIRCLE) THEN
420     W(fun (asl,w) -> SUBGOAL_THEN (mk_eq(rand(rator w),`&0`)) SUBST1_TAC) THEN
421     ASM_REWRITE_TAC[] THEN REWRITE_TAC[ABS_ZERO] THEN
422     REWRITE_TAC[REAL_SUB_0] THEN C SUBGOAL_THEN MP_TAC
423       `(\n. (c n) * (x pow n)) sums
424            (suminf(\n. (c n) * (x pow n))) /\
425        (\n. (c n) * ((x + h) pow n)) sums
426            (suminf(\n. (c n) * ((x + h) pow n)))` THENL
427      [CONJ_TAC THEN MATCH_MP_TAC SUMMABLE_SUM THEN
428       MATCH_MP_TAC POWSER_INSIDE THEN EXISTS_TAC `K:real` THEN
429       ASM_REWRITE_TAC[]; ALL_TAC] THEN
430     ONCE_REWRITE_TAC[CONJ_SYM] THEN
431     DISCH_THEN(MP_TAC o MATCH_MP SER_SUB) THEN BETA_TAC THEN
432     DISCH_THEN(MP_TAC o SPEC `h:real` o MATCH_MP SER_CDIV) THEN
433     BETA_TAC THEN DISCH_THEN(ACCEPT_TAC o MATCH_MP SUM_UNIQ); ALL_TAC] THEN
434   ONCE_REWRITE_TAC[LIM_NULL] THEN BETA_TAC THEN
435   MATCH_MP_TAC LIM_TRANSFORM THEN EXISTS_TAC
436    `\h. suminf (\n. c(n) *
437     (((((x + h) pow n) - (x pow n)) / h) - (&n * (x pow (n - 1)))))` THEN
438   BETA_TAC THEN CONJ_TAC THENL
439    [REWRITE_TAC[LIM] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
440     EXISTS_TAC `abs(K) - abs(x)` THEN REWRITE_TAC[REAL_SUB_LT] THEN
441     ASM_REWRITE_TAC[] THEN X_GEN_TAC `h:real` THEN
442     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
443     DISCH_THEN(ASSUME_TAC o MATCH_MP ABS_CIRCLE) THEN
444     W(fun (asl,w) -> SUBGOAL_THEN (mk_eq(rand(rator w),`&0`)) SUBST1_TAC) THEN
445     ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_SUB_RZERO; ABS_ZERO] THEN
446     BETA_TAC THEN REWRITE_TAC[REAL_SUB_0] THEN
447     SUBGOAL_THEN `summable(\n. (diffs c)(n) * (x pow n))` MP_TAC THENL
448      [MATCH_MP_TAC POWSER_INSIDE THEN EXISTS_TAC `K:real` THEN
449       ASM_REWRITE_TAC[]; ALL_TAC] THEN
450     DISCH_THEN(fun th -> ASSUME_TAC th THEN
451         MP_TAC (MATCH_MP DIFFS_EQUIV th)) THEN
452     DISCH_THEN(fun th -> SUBST1_TAC (MATCH_MP SUM_UNIQ th) THEN MP_TAC th) THEN
453     RULE_ASSUM_TAC(REWRITE_RULE[REAL_SUB_RZERO]) THEN C SUBGOAL_THEN MP_TAC
454       `(\n. (c n) * (x pow n)) sums
455            (suminf(\n. (c n) * (x pow n))) /\
456        (\n. (c n) * ((x + h) pow n)) sums
457            (suminf(\n. (c n) * ((x + h) pow n)))` THENL
458      [CONJ_TAC THEN MATCH_MP_TAC SUMMABLE_SUM THEN
459       MATCH_MP_TAC POWSER_INSIDE THEN EXISTS_TAC `K:real` THEN
460       ASM_REWRITE_TAC[]; ALL_TAC] THEN
461     ONCE_REWRITE_TAC[CONJ_SYM] THEN
462     DISCH_THEN(MP_TAC o MATCH_MP SER_SUB) THEN BETA_TAC THEN
463     DISCH_THEN(MP_TAC o SPEC `h:real` o MATCH_MP SER_CDIV) THEN
464     DISCH_THEN(MP_TAC o MATCH_MP SUMMABLE_SUM o MATCH_MP SUM_SUMMABLE) THEN
465     BETA_TAC THEN DISCH_THEN(fun th -> DISCH_THEN (MP_TAC o
466       MATCH_MP SUMMABLE_SUM o MATCH_MP SUM_SUMMABLE) THEN MP_TAC th) THEN
467     DISCH_THEN(fun th1 -> DISCH_THEN(fun th2 -> MP_TAC(CONJ th1 th2))) THEN
468     DISCH_THEN(MP_TAC o MATCH_MP SER_SUB) THEN BETA_TAC THEN
469     DISCH_THEN(SUBST1_TAC o MATCH_MP SUM_UNIQ) THEN AP_TERM_TAC THEN
470     ABS_TAC THEN REWRITE_TAC[real_div] THEN
471     REWRITE_TAC[REAL_SUB_LDISTRIB; REAL_SUB_RDISTRIB] THEN
472     REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN
473     AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_ACCEPT_TAC REAL_MUL_SYM;
474     ALL_TAC] THEN
475   MP_TAC(SPECL [`abs(x)`; `abs(K)`] REAL_MEAN) THEN ASM_REWRITE_TAC[] THEN
476   DISCH_THEN(X_CHOOSE_THEN `R:real` STRIP_ASSUME_TAC) THEN
477   MP_TAC(SPECL
478    [`\n. abs(c n) * &n * &(n - 1) * (R pow (n - 2))`;
479     `\h n. c(n) * (((((x + h) pow n) - (x pow n)) / h) -
480                      (&n * (x pow (n - 1))))`;
481     `R - abs(x)`] TERMDIFF_LEMMA5) THEN
482   BETA_TAC THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN
483   DISCH_THEN MATCH_MP_TAC THEN REPEAT CONJ_TAC THENL
484    [ASM_REWRITE_TAC[REAL_SUB_LT];
485
486     SUBGOAL_THEN `summable(\n. abs(diffs(diffs c) n) * (R pow n))` MP_TAC THENL
487      [MATCH_MP_TAC POWSER_INSIDEA THEN
488       EXISTS_TAC `K:real` THEN ASM_REWRITE_TAC[] THEN
489       SUBGOAL_THEN `abs(R) = R` (fun th -> ASM_REWRITE_TAC[th]) THEN
490       REWRITE_TAC[ABS_REFL] THEN MATCH_MP_TAC REAL_LE_TRANS THEN
491       EXISTS_TAC `abs(x)` THEN REWRITE_TAC[ABS_POS] THEN
492       MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN
493     REWRITE_TAC[diffs] THEN BETA_TAC THEN REWRITE_TAC[ABS_MUL] THEN
494     REWRITE_TAC[ABS_N] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN
495     C SUBGOAL_THEN (fun th -> ONCE_REWRITE_TAC[GSYM th])
496       `!n. diffs(diffs (\n. abs(c n))) n * (R pow n) =
497            &(SUC n) * &(SUC(SUC n)) * abs(c(SUC(SUC n))) * (R pow n)` THENL
498      [GEN_TAC THEN REWRITE_TAC[diffs] THEN BETA_TAC THEN
499       REWRITE_TAC[REAL_MUL_ASSOC]; ALL_TAC] THEN
500     DISCH_THEN(MP_TAC o MATCH_MP DIFFS_EQUIV) THEN
501     DISCH_THEN(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN
502     REWRITE_TAC[diffs] THEN BETA_TAC THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN
503     SUBGOAL_THEN `(\n. &n * &(SUC n) * abs(c(SUC n)) * (R pow (n - 1))) =
504            \n. diffs(\m. &(m - 1) * abs(c m) / R) n * (R pow n)`
505     SUBST1_TAC THENL
506      [REWRITE_TAC[diffs] THEN BETA_TAC THEN REWRITE_TAC[SUC_SUB1] THEN
507       ABS_TAC THEN
508       DISJ_CASES_THEN2 (SUBST1_TAC) (X_CHOOSE_THEN `m:num` SUBST1_TAC)
509        (SPEC `n:num` num_CASES) THEN
510       REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; SUC_SUB1] THEN
511       REWRITE_TAC[ADD1; POW_ADD] THEN REWRITE_TAC[GSYM ADD1; POW_1] THEN
512       REWRITE_TAC[GSYM REAL_MUL_ASSOC; real_div] THEN
513       ONCE_REWRITE_TAC[AC REAL_MUL_AC
514         `a * b * c * d * e * f = b * a * c * e * d * f`] THEN
515       REPEAT AP_TERM_TAC THEN SUBGOAL_THEN `inv(R) * R = &1` SUBST1_TAC THENL
516        [MATCH_MP_TAC REAL_MUL_LINV THEN REWRITE_TAC[ABS_NZ] THEN
517         MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(x)` THEN
518         ASM_REWRITE_TAC[ABS_POS] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN
519         EXISTS_TAC `R:real` THEN ASM_REWRITE_TAC[ABS_LE];
520         REWRITE_TAC[REAL_MUL_RID]]; ALL_TAC] THEN
521     DISCH_THEN(MP_TAC o MATCH_MP DIFFS_EQUIV) THEN BETA_TAC THEN
522     DISCH_THEN(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN
523     MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
524     CONV_TAC(X_FUN_EQ_CONV `n:num`) THEN BETA_TAC THEN GEN_TAC THEN
525     REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN
526     GEN_REWRITE_TAC RAND_CONV
527      [AC REAL_MUL_AC
528       `a * b * c * d = b * c * a * d`] THEN
529     DISJ_CASES_THEN2 SUBST1_TAC (X_CHOOSE_THEN `m:num` SUBST1_TAC)
530      (SPEC `n:num` num_CASES) THEN REWRITE_TAC[REAL_MUL_LZERO] THEN
531     REWRITE_TAC[num_CONV `2`; SUC_SUB1; SUB_SUC] THEN AP_TERM_TAC THEN
532     DISJ_CASES_THEN2 SUBST1_TAC (X_CHOOSE_THEN `n:num` SUBST1_TAC)
533      (SPEC `m:num` num_CASES) THEN REWRITE_TAC[REAL_MUL_LZERO] THEN
534     REPEAT AP_TERM_TAC THEN REWRITE_TAC[SUC_SUB1] THEN
535     REWRITE_TAC[ADD1; POW_ADD; POW_1] THEN
536     ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN
537     SUBGOAL_THEN `R * inv(R) = &1`
538     (fun th -> REWRITE_TAC[th; REAL_MUL_RID]) THEN
539     MATCH_MP_TAC REAL_MUL_RINV THEN CONV_TAC(RAND_CONV SYM_CONV) THEN
540     MATCH_MP_TAC REAL_LT_IMP_NE THEN MATCH_MP_TAC REAL_LET_TRANS THEN
541     EXISTS_TAC `abs(x)` THEN ASM_REWRITE_TAC[ABS_POS];
542
543     X_GEN_TAC `h:real` THEN DISCH_TAC THEN X_GEN_TAC `n:num` THEN
544     REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[ABS_MUL] THEN
545     MATCH_MP_TAC REAL_LE_LMUL_IMP THEN REWRITE_TAC[ABS_POS] THEN
546     MATCH_MP_TAC TERMDIFF_LEMMA3 THEN ASM_REWRITE_TAC[ABS_NZ] THEN
547     CONJ_TAC THENL
548      [MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[];
549       MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(x) + abs(h)` THEN
550       REWRITE_TAC[ABS_TRIANGLE] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN
551       ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
552       ASM_REWRITE_TAC[GSYM REAL_LT_SUB_LADD]]]);;
553
554 (* ------------------------------------------------------------------------- *)
555 (* I eventually decided to get rid of the pointless side-conditions.         *)
556 (* ------------------------------------------------------------------------- *)
557
558 let SEQ_NPOW = prove
559  (`!x. abs(x) < &1 ==> (\n. &n * x pow n) tends_num_real &0`,
560   REPEAT STRIP_TAC THEN
561   SUBGOAL_THEN `!n. abs(x) / (&1 - abs(x)) < &n <=> &(SUC n) * abs(x) < &n`
562   ASSUME_TAC THENL
563    [ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_SUB_LT] THEN
564     REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN REAL_ARITH_TAC; ALL_TAC] THEN
565   MP_TAC(SPEC `abs(x) / (&1 - abs(x))` REAL_ARCH_SIMPLE) THEN
566   DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN
567   MATCH_MP_TAC SER_ZERO THEN MATCH_MP_TAC SER_RATIO THEN
568   EXISTS_TAC `&(SUC(SUC N)) * abs(x) / &(SUC N)` THEN
569   EXISTS_TAC `SUC N` THEN CONJ_TAC THENL
570    [REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM real_div] THEN
571     SIMP_TAC[REAL_MUL_LID;REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; LT_0] THEN
572     FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [GSYM th]) THEN
573     MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&N` THEN
574     ASM_REWRITE_TAC[REAL_OF_NUM_LT; LT]; ALL_TAC] THEN
575   ABBREV_TAC `m = SUC N` THEN GEN_TAC THEN REWRITE_TAC[GE] THEN DISCH_TAC THEN
576   REWRITE_TAC[real_div; real_pow; REAL_ABS_MUL; GSYM REAL_MUL_ASSOC] THEN
577   GEN_REWRITE_TAC RAND_CONV [AC REAL_MUL_AC
578    `a * b * c * d * e = ((a * d) * c) * (b * e)`] THEN
579   MATCH_MP_TAC REAL_LE_RMUL THEN
580   SIMP_TAC[REAL_ABS_POS; REAL_LE_MUL] THEN
581   SUBGOAL_THEN `&0 < &m` ASSUME_TAC THENL
582    [REWRITE_TAC[REAL_OF_NUM_LT] THEN UNDISCH_TAC `m:num <= n` THEN
583     EXPAND_TAC "m" THEN ARITH_TAC; ALL_TAC] THEN
584   ASM_SIMP_TAC[GSYM real_div; REAL_LE_RDIV_EQ] THEN
585   UNDISCH_TAC `m:num <= n` THEN GEN_REWRITE_TAC LAND_CONV [LE_EXISTS] THEN
586   DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN
587   REWRITE_TAC[REAL_ABS_NUM; REAL_OF_NUM_MUL; REAL_OF_NUM_LE] THEN
588   REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES] THEN ARITH_TAC);;
589
590 let TERMDIFF_CONVERGES = prove
591  (`!K. (!x. abs(x) < K ==> summable(\n. c(n) * x pow n))
592        ==> !x. abs(x) < K ==> summable (\n. diffs c n * x pow n)`,
593   REPEAT STRIP_TAC THEN ASM_CASES_TAC `x = &0` THENL
594    [REWRITE_TAC[summable] THEN
595     EXISTS_TAC `sum(0,1) (\n. diffs c n * x pow n)` THEN
596     MATCH_MP_TAC SER_0 THEN
597     ASM_REWRITE_TAC[REAL_ENTIRE; REAL_POW_EQ_0] THEN
598     SIMP_TAC[ARITH_RULE `1 <= m <=> ~(m = 0)`]; ALL_TAC] THEN
599   SUBGOAL_THEN `?y. abs(x) < abs(y) /\ abs(y) < K` STRIP_ASSUME_TAC THENL
600    [EXISTS_TAC `(abs(x) + K) / &2` THEN
601     SIMP_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_LT_RDIV_EQ; REAL_LT_LDIV_EQ;
602              REAL_OF_NUM_LT; ARITH] THEN
603     UNDISCH_TAC `abs(x) < K` THEN REAL_ARITH_TAC; ALL_TAC] THEN
604   REWRITE_TAC[diffs] THEN
605   SUBGOAL_THEN `summable (\n. (&n * c(n)) * x pow n)` MP_TAC THENL
606    [ALL_TAC;
607     DISCH_THEN(MP_TAC o SPEC `1` o MATCH_MP SER_OFFSET) THEN
608     DISCH_THEN(MP_TAC o SPEC `inv(x)` o MATCH_MP SER_CMUL) THEN
609     REWRITE_TAC[GSYM ADD1; real_pow] THEN
610     ONCE_REWRITE_TAC[AC REAL_MUL_AC
611      `a * (b * c) * d * e = (a * d) * (b * c) * e`] THEN
612     ASM_SIMP_TAC[REAL_MUL_LINV; REAL_MUL_LID] THEN
613     REWRITE_TAC[SUM_SUMMABLE]] THEN
614   MATCH_MP_TAC SER_COMPAR THEN EXISTS_TAC `\n:num. abs(c n * y pow n)` THEN
615   CONJ_TAC THENL
616    [ALL_TAC;
617     REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_POW] THEN
618     MATCH_MP_TAC POWSER_INSIDEA THEN
619     EXISTS_TAC `(abs(y) + K) / &2` THEN
620     SUBGOAL_THEN `abs(abs y) < abs((abs y + K) / &2) /\
621                   abs((abs y + K) / &2) < K`
622      (fun th -> ASM_SIMP_TAC[th]) THEN
623     SIMP_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_LT_RDIV_EQ; REAL_LT_LDIV_EQ;
624              REAL_OF_NUM_LT; ARITH] THEN
625     UNDISCH_TAC `abs y < K` THEN REAL_ARITH_TAC] THEN
626   SUBGOAL_THEN `&0 < abs(y)` ASSUME_TAC THENL
627    [MAP_EVERY UNDISCH_TAC [`abs x < abs y`; `~(x = &0)`] THEN
628     REAL_ARITH_TAC; ALL_TAC] THEN
629   MP_TAC(SPEC `x / y` SEQ_NPOW) THEN
630   ASM_SIMP_TAC[REAL_MUL_LID; REAL_LT_LDIV_EQ; REAL_ABS_DIV] THEN
631   REWRITE_TAC[SEQ] THEN DISCH_THEN(MP_TAC o SPEC `&1`) THEN
632   REWRITE_TAC[REAL_OF_NUM_LT; REAL_SUB_RZERO; ARITH] THEN
633   MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC MONO_FORALL THEN
634   GEN_TAC THEN MATCH_MP_TAC(TAUT `(b ==> c) ==> (a ==> b) ==> (a ==> c)`) THEN
635   REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_MUL; REAL_ABS_POW; REAL_ABS_NUM] THEN
636   REWRITE_TAC[REAL_POW_DIV] THEN
637   REWRITE_TAC[real_div; REAL_MUL_ASSOC; REAL_POW_INV] THEN
638   REWRITE_TAC[GSYM real_div] THEN
639   ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_POW_LT] THEN
640   REWRITE_TAC[REAL_MUL_LID] THEN DISCH_TAC THEN
641   GEN_REWRITE_TAC LAND_CONV [AC REAL_MUL_AC `(a * b) * c = b * a * c`] THEN
642   MATCH_MP_TAC REAL_LE_LMUL THEN
643   ASM_SIMP_TAC[REAL_ABS_POS; REAL_LT_IMP_LE]);;
644
645 let TERMDIFF_STRONG = prove
646  (`!c K x.
647         summable(\n. c(n) * (K pow n)) /\ abs(x) < abs(K)
648         ==> ((\x. suminf (\n. c(n) * (x pow n))) diffl
649              (suminf (\n. (diffs c)(n) * (x pow n))))(x)`,
650   REPEAT STRIP_TAC THEN MATCH_MP_TAC TERMDIFF THEN
651   EXISTS_TAC `(abs(x) + abs(K)) / &2` THEN
652   SUBGOAL_THEN `abs(x) < abs((abs(x) + abs(K)) / &2) /\
653                 abs((abs(x) + abs(K)) / &2) < abs(K)`
654   STRIP_ASSUME_TAC THENL
655    [SIMP_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_LT_RDIV_EQ;
656              REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN
657     UNDISCH_TAC `abs(x) < abs(K)` THEN REAL_ARITH_TAC; ALL_TAC] THEN
658   ASM_REWRITE_TAC[REAL_ABS_ABS] THEN REPEAT CONJ_TAC THENL
659    [MATCH_MP_TAC SER_ACONV THEN
660     REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_POW] THEN
661     MATCH_MP_TAC POWSER_INSIDEA THEN
662     EXISTS_TAC `K:real` THEN ASM_REWRITE_TAC[REAL_ABS_ABS];
663     SUBGOAL_THEN
664      `!x. abs(x) < abs(K) ==> summable (\n. diffs c n * x pow n)`
665      (fun th -> ASM_SIMP_TAC[th]);
666     SUBGOAL_THEN
667      `!x. abs(x) < abs(K) ==> summable (\n. diffs(diffs c) n * x pow n)`
668      (fun th -> ASM_SIMP_TAC[th]) THEN
669     MATCH_MP_TAC TERMDIFF_CONVERGES] THEN
670   MATCH_MP_TAC TERMDIFF_CONVERGES THEN
671   REPEAT STRIP_TAC THEN
672   MATCH_MP_TAC SER_ACONV THEN
673   REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_POW] THEN
674   MATCH_MP_TAC POWSER_INSIDEA THEN
675   EXISTS_TAC `K:real` THEN ASM_REWRITE_TAC[REAL_ABS_ABS]);;
676
677 (* ------------------------------------------------------------------------- *)
678 (* Term-by-term comparison of power series.                                  *)
679 (* ------------------------------------------------------------------------- *)
680
681 let POWSER_0 = prove
682  (`!a. (\n. a n * (&0) pow n) sums a(0)`,
683   GEN_TAC THEN
684   SUBGOAL_THEN `a(0) = sum(0,1) (\n. a n * (&0) pow n)` SUBST1_TAC THENL
685    [CONV_TAC(ONCE_DEPTH_CONV REAL_SUM_CONV) THEN
686     REWRITE_TAC[real_pow; REAL_MUL_RID]; ALL_TAC] THEN
687   MATCH_MP_TAC SER_0 THEN INDUCT_TAC THEN
688   REWRITE_TAC[real_pow; REAL_MUL_LZERO; REAL_MUL_RZERO; ARITH]);;
689
690 let POWSER_LIMIT_0 = prove
691  (`!f a s. &0 < s /\
692            (!x. abs(x) < s ==> (\n. a n * x pow n) sums (f x))
693            ==> (f tends_real_real a(0))(&0)`,
694   REPEAT STRIP_TAC THEN
695   MP_TAC(SPECL [`a:num->real`; `s / &2`; `&0`] TERMDIFF_STRONG) THEN
696   W(C SUBGOAL_THEN (fun th -> REWRITE_TAC[th]) o funpow 2 lhand o snd) THENL
697    [ASM_SIMP_TAC[REAL_ABS_NUM; REAL_ABS_DIV; REAL_LT_DIV; REAL_OF_NUM_LT;
698                  ARITH; REAL_ARITH `&0 < x ==> &0 < abs(x)`] THEN
699     MATCH_MP_TAC SUM_SUMMABLE THEN
700     EXISTS_TAC `(f:real->real) (s / &2)` THEN
701     FIRST_ASSUM MATCH_MP_TAC THEN
702     ASM_SIMP_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_LT_LDIV_EQ; REAL_OF_NUM_LT;
703                  ARITH] THEN
704     UNDISCH_TAC `&0 < s` THEN REAL_ARITH_TAC; ALL_TAC] THEN
705   DISCH_THEN(MP_TAC o MATCH_MP DIFF_CONT) THEN REWRITE_TAC[contl] THEN
706   SUBGOAL_THEN `suminf (\n. a n * &0 pow n) = a(0)` SUBST1_TAC THENL
707    [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_UNIQ THEN
708     REWRITE_TAC[POWSER_0]; ALL_TAC] THEN
709   MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ]
710                LIM_TRANSFORM) THEN
711   REWRITE_TAC[REAL_ADD_LID; LIM] THEN
712   REPEAT STRIP_TAC THEN EXISTS_TAC `s:real` THEN
713   ASM_REWRITE_TAC[REAL_SUB_RZERO] THEN
714   REPEAT STRIP_TAC THEN
715   MATCH_MP_TAC(REAL_ARITH `(a = b) /\ &0 < e ==> abs(a - b) < e`) THEN
716   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUM_UNIQ THEN ASM_SIMP_TAC[]);;
717
718 let POWSER_LIMIT_0_STRONG = prove
719  (`!f a s.
720         &0 < s /\
721         (!x. &0 < abs(x) /\ abs(x) < s ==> (\n. a n * x pow n) sums (f x))
722         ==> (f tends_real_real a(0))(&0)`,
723   REPEAT STRIP_TAC THEN
724   SUBGOAL_THEN
725    `((\x. if x = &0 then a(0):real else f x) tends_real_real a(0))(&0)`
726   MP_TAC THENL
727    [MATCH_MP_TAC POWSER_LIMIT_0 THEN
728     EXISTS_TAC `s:real` THEN ASM_REWRITE_TAC[] THEN
729     X_GEN_TAC `x:real` THEN STRIP_TAC THEN ASM_CASES_TAC `x = &0` THEN
730     ASM_SIMP_TAC[GSYM REAL_ABS_NZ] THEN REWRITE_TAC[sums; SEQ] THEN
731     X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `1` THEN
732     INDUCT_TAC THEN REWRITE_TAC[ARITH; ADD1] THEN DISCH_TAC THEN
733     REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[REAL_EQ_SUB_LADD] SUM_OFFSET)] THEN
734     REWRITE_TAC[REAL_POW_ADD; REAL_POW_1; REAL_MUL_RZERO; SUM_CONST] THEN
735     CONV_TAC(ONCE_DEPTH_CONV REAL_SUM_CONV) THEN
736     REWRITE_TAC[real_pow; REAL_MUL_RID] THEN
737     ASM_REWRITE_TAC[REAL_ADD_LID; REAL_SUB_REFL; REAL_ABS_NUM]; ALL_TAC] THEN
738   MATCH_MP_TAC EQ_IMP THEN
739   MATCH_MP_TAC LIM_EQUAL THEN SIMP_TAC[]);;
740
741 let POWSER_EQUAL_0 = prove
742  (`!f a b P.
743         (!e. &0 < e ==> ?x. P x /\ &0 < abs x /\ abs(x) < e) /\
744         (!x. &0 < abs(x) /\ P x
745              ==> (\n. a n * x pow n) sums (f x) /\
746                  (\n. b n * x pow n) sums (f x))
747         ==> (a(0) = b(0))`,
748   REPEAT STRIP_TAC THEN
749   SUBGOAL_THEN
750    `?s. &0 < s /\
751         !x. abs(x) < s
752             ==> summable (\n. a n * x pow n) /\ summable (\n. b n * x pow n)`
753   MP_TAC THENL
754    [FIRST_ASSUM(MP_TAC o C MATCH_MP REAL_LT_01) THEN
755     DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN
756     EXISTS_TAC `abs(k)` THEN ASM_REWRITE_TAC[] THEN
757     REPEAT STRIP_TAC THEN MATCH_MP_TAC POWSER_INSIDE THEN
758     EXISTS_TAC `k:real` THEN
759     ASM_REWRITE_TAC[summable] THEN
760     EXISTS_TAC `(f:real->real) k` THEN ASM_SIMP_TAC[]; ALL_TAC] THEN
761   REWRITE_TAC[summable; LEFT_AND_EXISTS_THM] THEN
762   REWRITE_TAC[RIGHT_AND_EXISTS_THM; RIGHT_IMP_EXISTS_THM] THEN
763   DISCH_THEN(X_CHOOSE_THEN `s:real` MP_TAC) THEN
764   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
765   REWRITE_TAC[SKOLEM_THM] THEN
766   DISCH_THEN(X_CHOOSE_THEN `g:real->real` MP_TAC) THEN
767   DISCH_THEN(X_CHOOSE_THEN `h:real->real` MP_TAC) THEN DISCH_TAC THEN
768   MATCH_MP_TAC(REAL_ARITH `~(&0 < abs(x - y)) ==> (x = y)`) THEN
769   ABBREV_TAC `e = abs(a 0 - b 0)` THEN DISCH_TAC THEN
770   MP_TAC(SPECL [`g:real->real`; `a:num->real`; `s:real`]
771     POWSER_LIMIT_0_STRONG) THEN
772   ASM_SIMP_TAC[LIM] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN
773   ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; REAL_SUB_RZERO] THEN
774   DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN
775   MP_TAC(SPECL [`h:real->real`; `b:num->real`; `s:real`]
776     POWSER_LIMIT_0_STRONG) THEN
777   ASM_SIMP_TAC[LIM] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN
778   ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; REAL_SUB_RZERO] THEN
779   DISCH_THEN(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC) THEN
780   MP_TAC(SPECL [`d1:real`; `d2:real`] REAL_DOWN2) THEN
781   ASM_REWRITE_TAC[] THEN
782   DISCH_THEN(X_CHOOSE_THEN `d0:real` STRIP_ASSUME_TAC) THEN
783   MP_TAC(SPECL [`d0:real`; `s:real`] REAL_DOWN2) THEN
784   ASM_REWRITE_TAC[] THEN
785   DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
786   UNDISCH_TAC `!e. &0 < e ==> ?x. P x /\ &0 < abs x /\ abs x < e` THEN
787   DISCH_THEN(MP_TAC o SPEC `d:real`) THEN ASM_REWRITE_TAC[] THEN
788   DISCH_THEN(X_CHOOSE_THEN `x:real` STRIP_ASSUME_TAC) THEN
789   SUBGOAL_THEN `abs(a 0 - b 0) < e` MP_TAC THENL
790    [ALL_TAC; ASM_REWRITE_TAC[REAL_LT_REFL]] THEN
791   MATCH_MP_TAC REAL_LTE_TRANS THEN
792   EXISTS_TAC `e / &2 + e / &2` THEN CONJ_TAC THENL
793    [ALL_TAC;
794     SIMP_TAC[GSYM REAL_MUL_2; REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH_EQ] THEN
795     REWRITE_TAC[REAL_LE_REFL]] THEN
796   MATCH_MP_TAC(REAL_ARITH
797    `!f g h. abs(g - a) < e2 /\ abs(h - b) < e2 /\ (g = f) /\ (h = f)
798             ==> abs(a - b) < e2 + e2`) THEN
799   MAP_EVERY EXISTS_TAC
800    [`(f:real->real) x`; `(g:real->real) x`; `(h:real->real) x`] THEN
801   CONJ_TAC THENL [ASM_MESON_TAC[REAL_LT_TRANS]; ALL_TAC] THEN
802   CONJ_TAC THENL [ASM_MESON_TAC[REAL_LT_TRANS]; ALL_TAC] THEN
803   CONJ_TAC THENL
804    [MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `suminf(\n. a n * x pow n)` THEN
805     CONJ_TAC THENL
806      [MATCH_MP_TAC SUM_UNIQ;
807       MATCH_MP_TAC(GSYM SUM_UNIQ)] THEN
808     ASM_SIMP_TAC[] THEN
809     SUBGOAL_THEN `abs(x) < s` (fun th -> ASM_SIMP_TAC[th]) THEN
810     ASM_MESON_TAC[REAL_LT_TRANS];
811     MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `suminf(\n. b n * x pow n)` THEN
812     CONJ_TAC THENL
813      [MATCH_MP_TAC SUM_UNIQ;
814       MATCH_MP_TAC(GSYM SUM_UNIQ)] THEN
815     ASM_SIMP_TAC[] THEN
816     SUBGOAL_THEN `abs(x) < s` (fun th -> ASM_SIMP_TAC[th]) THEN
817     ASM_MESON_TAC[REAL_LT_TRANS]]);;
818
819 let POWSER_EQUAL = prove
820  (`!f a b P.
821         (!e. &0 < e ==> ?x. P x /\ &0 < abs x /\ abs(x) < e) /\
822         (!x. P x ==> (\n. a n * x pow n) sums (f x) /\
823                      (\n. b n * x pow n) sums (f x))
824         ==> (a = b)`,
825   REPEAT STRIP_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN
826   GEN_REWRITE_TAC I [TAUT `p <=> ~ ~ p`] THEN
827   GEN_REWRITE_TAC RAND_CONV [NOT_FORALL_THM] THEN
828   ONCE_REWRITE_TAC[num_WOP] THEN
829   DISCH_THEN(X_CHOOSE_THEN `n:num` MP_TAC) THEN REWRITE_TAC[] THEN
830   REWRITE_TAC[TAUT `~(~a /\ b) <=> b ==> a`] THEN DISCH_TAC THEN
831   SUBGOAL_THEN `(\m. a(m + n):real) 0 = (\m. b(m + n)) 0` MP_TAC THENL
832    [ALL_TAC; REWRITE_TAC[ADD_CLAUSES]] THEN
833   MATCH_MP_TAC POWSER_EQUAL_0 THEN
834   EXISTS_TAC `\x. inv(x pow n) * (f(x) - sum(0,n) (\n. b n * x pow n))` THEN
835   EXISTS_TAC `P:real->bool` THEN ASM_REWRITE_TAC[] THEN
836   X_GEN_TAC `x:real` THEN STRIP_TAC THEN
837   SUBGOAL_THEN `!a m. a(m + n) * x pow m =
838                       inv(x pow n) * a(m + n) * x pow (m + n)`
839    (fun th -> GEN_REWRITE_TAC (BINOP_CONV o LAND_CONV o ONCE_DEPTH_CONV) [th])
840   THENL
841    [REPEAT GEN_TAC THEN REWRITE_TAC[REAL_POW_ADD] THEN
842     ONCE_REWRITE_TAC[AC REAL_MUL_AC `x' * a * b * x = (x * x') * a * b`] THEN
843     ASM_SIMP_TAC[REAL_MUL_RINV; REAL_POW_EQ_0;
844                  REAL_ARITH `(x = &0) <=> ~(&0 < abs x)`] THEN
845     REWRITE_TAC[REAL_MUL_LID]; ALL_TAC] THEN
846   CONJ_TAC THEN MATCH_MP_TAC SER_CMUL THENL
847    [SUBGOAL_THEN `sum(0,n) (\n. b n * x pow n) = sum(0,n) (\n. a n * x pow n)`
848     SUBST1_TAC THENL
849      [MATCH_MP_TAC SUM_EQ THEN ASM_SIMP_TAC[ADD_CLAUSES]; ALL_TAC] THEN
850     SUBGOAL_THEN `f x = suminf (\n. a n * x pow n)` SUBST1_TAC THENL
851      [MATCH_MP_TAC SUM_UNIQ THEN ASM_SIMP_TAC[]; ALL_TAC] THEN
852     MP_TAC(SPEC `\n. a n * x pow n` SER_OFFSET);
853     SUBGOAL_THEN `f x = suminf (\n. b n * x pow n)` SUBST1_TAC THENL
854      [MATCH_MP_TAC SUM_UNIQ THEN ASM_SIMP_TAC[]; ALL_TAC] THEN
855     MP_TAC(SPEC `\n. b n * x pow n` SER_OFFSET)] THEN
856   REWRITE_TAC[] THEN
857   W(C SUBGOAL_THEN (fun th -> SIMP_TAC[th]) o funpow 2 lhand o snd) THEN
858   MATCH_MP_TAC SUM_SUMMABLE THEN
859   EXISTS_TAC `(f:real->real) x` THEN ASM_SIMP_TAC[]);;
860
861 (* ======================================================================== *)
862 (* Definitions of the transcendental functions etc.                         *)
863 (* ======================================================================== *)
864
865 prioritize_num();;
866
867 (* ------------------------------------------------------------------------- *)
868 (* To avoid all those beta redexes vanishing without trace...                *)
869 (* ------------------------------------------------------------------------- *)
870
871 set_basic_rewrites (subtract' equals_thm (basic_rewrites())
872    [SPEC_ALL BETA_THM]);;
873
874 (* ------------------------------------------------------------------------ *)
875 (* Some miscellaneous lemmas                                                *)
876 (* ------------------------------------------------------------------------ *)
877
878 let MULT_DIV_2 = prove
879  (`!n. (2 * n) DIV 2 = n`,
880   GEN_TAC THEN MATCH_MP_TAC DIV_MULT THEN
881   REWRITE_TAC[ARITH]);;
882
883 let EVEN_DIV2 = prove
884  (`!n. ~(EVEN n) ==> ((SUC n) DIV 2 = SUC((n - 1) DIV 2))`,
885   GEN_TAC THEN REWRITE_TAC[GSYM NOT_ODD; ODD_EXISTS] THEN
886   DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN
887   REWRITE_TAC[SUC_SUB1] THEN REWRITE_TAC[ADD1; GSYM ADD_ASSOC] THEN
888   SUBST1_TAC(EQT_ELIM(NUM_REDUCE_CONV `1 + 1 = 2 * 1`)) THEN
889   REWRITE_TAC[GSYM LEFT_ADD_DISTRIB; MULT_DIV_2]);;
890
891 (* ------------------------------------------------------------------------ *)
892 (* Now set up real numbers interface                                        *)
893 (* ------------------------------------------------------------------------ *)
894
895 prioritize_real();;
896
897 (* ------------------------------------------------------------------------- *)
898 (* Another lost lemma.                                                       *)
899 (* ------------------------------------------------------------------------- *)
900
901 let POW_ZERO = prove(
902   `!n x. (x pow n = &0) ==> (x = &0)`,
903   INDUCT_TAC THEN GEN_TAC THEN ONCE_REWRITE_TAC[pow] THEN
904   REWRITE_TAC[REAL_10; REAL_ENTIRE] THEN
905   DISCH_THEN(DISJ_CASES_THEN2 ACCEPT_TAC ASSUME_TAC) THEN
906   FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC);;
907
908 let POW_ZERO_EQ = prove(
909   `!n x. (x pow (SUC n) = &0) <=> (x = &0)`,
910   REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[POW_ZERO] THEN
911   DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[POW_0]);;
912
913 let POW_LT = prove(
914   `!n x y. &0 <= x /\ x < y ==> (x pow (SUC n)) < (y pow (SUC n))`,
915   REPEAT STRIP_TAC THEN SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THENL
916    [ASM_REWRITE_TAC[pow; REAL_MUL_RID];
917     ONCE_REWRITE_TAC[pow] THEN MATCH_MP_TAC REAL_LT_MUL2_ALT THEN
918     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC POW_POS THEN ASM_REWRITE_TAC[]]);;
919
920 let POW_EQ = prove(
921   `!n x y. &0 <= x /\ &0 <= y /\ (x pow (SUC n) = y pow (SUC n))
922         ==> (x = y)`,
923   REPEAT STRIP_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC
924     (SPECL [`x:real`; `y:real`] REAL_LT_TOTAL) THEN
925   ASM_REWRITE_TAC[] THEN
926   UNDISCH_TAC `x pow (SUC n) = y pow (SUC n)` THEN
927   CONV_TAC CONTRAPOS_CONV THEN DISCH_THEN(K ALL_TAC) THENL
928    [ALL_TAC; CONV_TAC(RAND_CONV SYM_CONV)] THEN
929   MATCH_MP_TAC REAL_LT_IMP_NE THEN
930   MATCH_MP_TAC POW_LT THEN ASM_REWRITE_TAC[]);;
931
932 (* ------------------------------------------------------------------------- *)
933 (* Basic differentiation theorems --- none yet.                              *)
934 (* ------------------------------------------------------------------------- *)
935
936 let diff_net = ref empty_net;;
937
938 let add_to_diff_net th =
939   let t = lhand(rator(rand(concl th))) in
940   let net = !diff_net in
941   let net' = enter [] (t,PART_MATCH (lhand o rator o rand) th) net in
942   diff_net := net';;
943
944 (* ------------------------------------------------------------------------ *)
945 (* The three functions we define by series are exp, sin, cos                *)
946 (* ------------------------------------------------------------------------ *)
947
948 let exp = new_definition
949   `exp(x) = suminf(\n. ((\n. inv(&(FACT n)))) n * (x pow n))`;;
950
951 let sin = new_definition
952   `sin(x) = suminf(\n. ((\n. if EVEN n then &0 else
953       ((--(&1)) pow ((n - 1) DIV 2)) / &(FACT n))) n * (x pow n))`;;
954
955 let cos = new_definition
956   `cos(x) = suminf(\n. ((\n. if EVEN n then ((--(&1)) pow (n DIV 2)) / &(FACT n)
957        else &0)) n * (x pow n))`;;
958
959 (* ------------------------------------------------------------------------ *)
960 (* Show the series for exp converges, using the ratio test                  *)
961 (* ------------------------------------------------------------------------ *)
962
963 let REAL_EXP_CONVERGES = prove(
964   `!x. (\n. ((\n. inv(&(FACT n)))) n * (x pow n)) sums exp(x)`,
965   let fnz tm =
966     (GSYM o MATCH_MP REAL_LT_IMP_NE o
967      REWRITE_RULE[GSYM REAL_LT] o C SPEC FACT_LT) tm in
968   GEN_TAC THEN REWRITE_TAC[exp] THEN MATCH_MP_TAC SUMMABLE_SUM THEN
969   MATCH_MP_TAC SER_RATIO THEN
970   MP_TAC (SPEC `&1` REAL_DOWN) THEN REWRITE_TAC[REAL_LT_01] THEN
971   DISCH_THEN(X_CHOOSE_THEN `c:real` STRIP_ASSUME_TAC) THEN
972   EXISTS_TAC `c:real` THEN ASM_REWRITE_TAC[] THEN
973   MP_TAC(SPEC `c:real` REAL_ARCH) THEN ASM_REWRITE_TAC[] THEN
974   DISCH_THEN(MP_TAC o SPEC `abs(x)`) THEN
975   DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `N:num` THEN
976   X_GEN_TAC `n:num` THEN REWRITE_TAC[GE] THEN DISCH_TAC THEN
977   BETA_TAC THEN
978   REWRITE_TAC[ADD1; POW_ADD; ABS_MUL; REAL_MUL_ASSOC; POW_1] THEN
979   GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN
980   REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL_IMP THEN
981   REWRITE_TAC[ABS_POS] THEN REWRITE_TAC[GSYM ADD1; FACT] THEN
982   REWRITE_TAC[GSYM REAL_MUL; MATCH_MP REAL_INV_MUL_WEAK (CONJ
983    (REWRITE_RULE[GSYM REAL_INJ] (SPEC `n:num` NOT_SUC)) (fnz `n:num`))] THEN
984   REWRITE_TAC[ABS_MUL; REAL_MUL_ASSOC] THEN
985   MATCH_MP_TAC REAL_LE_RMUL_IMP THEN REWRITE_TAC[ABS_POS] THEN
986   MP_TAC(SPEC `n:num` LT_0) THEN REWRITE_TAC[GSYM REAL_LT] THEN
987   DISCH_THEN(ASSUME_TAC o GSYM o MATCH_MP REAL_LT_IMP_NE) THEN
988   FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP ABS_INV th]) THEN
989   REWRITE_TAC[GSYM real_div] THEN MATCH_MP_TAC REAL_LE_LDIV THEN
990   ASM_REWRITE_TAC[GSYM ABS_NZ] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
991   REWRITE_TAC[REWRITE_RULE[GSYM ABS_REFL; GSYM REAL_LE] LE_0] THEN
992   MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&N * c` THEN CONJ_TAC THENL
993    [MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_ASSUM ACCEPT_TAC;
994     FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_LE_RMUL_EQ th]) THEN
995     REWRITE_TAC[REAL_LE] THEN MATCH_MP_TAC LE_TRANS THEN
996     EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[LESS_EQ_SUC_REFL]]);;
997
998 (* ------------------------------------------------------------------------ *)
999 (* Show by the comparison test that sin and cos converge                    *)
1000 (* ------------------------------------------------------------------------ *)
1001
1002 let SIN_CONVERGES = prove(
1003   `!x. (\n. ((\n. if EVEN n then &0 else
1004   ((--(&1)) pow ((n - 1) DIV 2)) / &(FACT n))) n * (x pow n)) sums
1005   sin(x)`,
1006   GEN_TAC THEN REWRITE_TAC[sin] THEN MATCH_MP_TAC SUMMABLE_SUM THEN
1007   MATCH_MP_TAC SER_COMPAR THEN
1008   EXISTS_TAC `\n. ((\n. inv(&(FACT n)))) n * (abs(x) pow n)` THEN
1009   REWRITE_TAC[MATCH_MP SUM_SUMMABLE (SPEC_ALL REAL_EXP_CONVERGES)] THEN
1010   EXISTS_TAC `0` THEN X_GEN_TAC `n:num` THEN
1011   DISCH_THEN(K ALL_TAC) THEN BETA_TAC THEN COND_CASES_TAC THEN
1012   REWRITE_TAC[ABS_MUL; POW_ABS] THENL
1013    [REWRITE_TAC[ABS_0; REAL_MUL_LZERO] THEN MATCH_MP_TAC REAL_LE_MUL THEN
1014     REWRITE_TAC[ABS_POS];
1015     REWRITE_TAC[real_div; ABS_MUL; POW_M1; REAL_MUL_LID] THEN
1016     MATCH_MP_TAC REAL_LE_RMUL_IMP THEN REWRITE_TAC[ABS_POS] THEN
1017     MATCH_MP_TAC REAL_EQ_IMP_LE THEN REWRITE_TAC[ABS_REFL]] THEN
1018   MAP_EVERY MATCH_MP_TAC [REAL_LT_IMP_LE; REAL_INV_POS] THEN
1019   REWRITE_TAC[REAL_LT; FACT_LT]);;
1020
1021 let COS_CONVERGES = prove(
1022   `!x. (\n. ((\n. if EVEN n then ((--(&1)) pow (n DIV 2)) / &(FACT n) else &0)) n
1023     * (x pow n)) sums cos(x)`,
1024   GEN_TAC THEN REWRITE_TAC[cos] THEN MATCH_MP_TAC SUMMABLE_SUM THEN
1025   MATCH_MP_TAC SER_COMPAR THEN
1026   EXISTS_TAC `\n. ((\n. inv(&(FACT n)))) n * (abs(x) pow n)` THEN
1027   REWRITE_TAC[MATCH_MP SUM_SUMMABLE (SPEC_ALL REAL_EXP_CONVERGES)] THEN
1028   EXISTS_TAC `0` THEN X_GEN_TAC `n:num` THEN
1029   DISCH_THEN(K ALL_TAC) THEN BETA_TAC THEN COND_CASES_TAC THEN
1030   REWRITE_TAC[ABS_MUL; POW_ABS] THENL
1031    [REWRITE_TAC[real_div; ABS_MUL; POW_M1; REAL_MUL_LID] THEN
1032     MATCH_MP_TAC REAL_LE_RMUL_IMP THEN REWRITE_TAC[ABS_POS] THEN
1033     MATCH_MP_TAC REAL_EQ_IMP_LE THEN REWRITE_TAC[ABS_REFL];
1034     REWRITE_TAC[ABS_0; REAL_MUL_LZERO] THEN MATCH_MP_TAC REAL_LE_MUL THEN
1035     REWRITE_TAC[ABS_POS]] THEN
1036   MAP_EVERY MATCH_MP_TAC [REAL_LT_IMP_LE; REAL_INV_POS] THEN
1037   REWRITE_TAC[REAL_LT; FACT_LT]);;
1038
1039 (* ------------------------------------------------------------------------ *)
1040 (* Show what the formal derivatives of these series are                     *)
1041 (* ------------------------------------------------------------------------ *)
1042
1043 let REAL_EXP_FDIFF = prove(
1044   `diffs (\n. inv(&(FACT n))) = (\n. inv(&(FACT n)))`,
1045   REWRITE_TAC[diffs] THEN BETA_TAC THEN
1046   CONV_TAC(X_FUN_EQ_CONV `n:num`) THEN GEN_TAC THEN BETA_TAC THEN
1047   REWRITE_TAC[FACT; GSYM REAL_MUL] THEN
1048   SUBGOAL_THEN `~(&(SUC n) = &0) /\ ~(&(FACT n) = &0)` ASSUME_TAC THENL
1049    [CONJ_TAC THEN CONV_TAC(RAND_CONV SYM_CONV) THEN
1050     MATCH_MP_TAC REAL_LT_IMP_NE THEN
1051     REWRITE_TAC[REAL_LT; LT_0; FACT_LT];
1052     FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_INV_MUL_WEAK th]) THEN
1053     GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN
1054     REWRITE_TAC[REAL_MUL_ASSOC; REAL_EQ_RMUL] THEN DISJ2_TAC THEN
1055     MATCH_MP_TAC REAL_MUL_RINV THEN ASM_REWRITE_TAC[]]);;
1056
1057 let SIN_FDIFF = prove(
1058   `diffs (\n. if EVEN n then &0 else ((--(&1)) pow ((n - 1) DIV 2)) / &(FACT n))
1059    = (\n. if EVEN n then ((--(&1)) pow (n DIV 2)) / &(FACT n) else &0)`,
1060   REWRITE_TAC[diffs] THEN BETA_TAC THEN
1061   CONV_TAC(X_FUN_EQ_CONV `n:num`) THEN GEN_TAC THEN BETA_TAC THEN
1062   COND_CASES_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[EVEN]) THEN
1063   ASM_REWRITE_TAC[REAL_MUL_RZERO] THEN REWRITE_TAC[SUC_SUB1] THEN
1064   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
1065   REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN
1066   REWRITE_TAC[FACT; GSYM REAL_MUL] THEN
1067   SUBGOAL_THEN `~(&(SUC n) = &0) /\ ~(&(FACT n) = &0)` ASSUME_TAC THENL
1068    [CONJ_TAC THEN CONV_TAC(RAND_CONV SYM_CONV) THEN
1069     MATCH_MP_TAC REAL_LT_IMP_NE THEN
1070     REWRITE_TAC[REAL_LT; LT_0; FACT_LT];
1071     FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_INV_MUL_WEAK th]) THEN
1072     REWRITE_TAC[REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
1073     GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN
1074     REWRITE_TAC[REAL_MUL_ASSOC; REAL_EQ_RMUL] THEN DISJ2_TAC THEN
1075     MATCH_MP_TAC REAL_MUL_RINV THEN ASM_REWRITE_TAC[]]);;
1076
1077 let COS_FDIFF = prove(
1078   `diffs (\n. if EVEN n then ((--(&1)) pow (n DIV 2)) / &(FACT n) else &0) =
1079   (\n. --(((\n. if EVEN n then &0 else ((--(&1)) pow ((n - 1) DIV 2)) /
1080    &(FACT n))) n))`,
1081   REWRITE_TAC[diffs] THEN BETA_TAC THEN
1082   CONV_TAC(X_FUN_EQ_CONV `n:num`) THEN GEN_TAC THEN BETA_TAC THEN
1083   COND_CASES_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[EVEN]) THEN
1084   ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_NEG_0] THEN
1085   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
1086   REWRITE_TAC[real_div; REAL_NEG_LMUL] THEN
1087   REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN BINOP_TAC THENL
1088    [POP_ASSUM(SUBST1_TAC o MATCH_MP EVEN_DIV2) THEN
1089     REWRITE_TAC[pow] THEN REWRITE_TAC[GSYM REAL_NEG_MINUS1];
1090     REWRITE_TAC[FACT; GSYM REAL_MUL] THEN
1091     SUBGOAL_THEN `~(&(SUC n) = &0) /\ ~(&(FACT n) = &0)` ASSUME_TAC THENL
1092      [CONJ_TAC THEN CONV_TAC(RAND_CONV SYM_CONV) THEN
1093       MATCH_MP_TAC REAL_LT_IMP_NE THEN
1094       REWRITE_TAC[REAL_LT; LT_0; FACT_LT];
1095       FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_INV_MUL_WEAK th]) THEN
1096       REWRITE_TAC[REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
1097       GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN
1098       REWRITE_TAC[REAL_MUL_ASSOC; REAL_EQ_RMUL] THEN DISJ2_TAC THEN
1099       MATCH_MP_TAC REAL_MUL_RINV THEN ASM_REWRITE_TAC[]]]);;
1100
1101 (* ------------------------------------------------------------------------ *)
1102 (* Now at last we can get the derivatives of exp, sin and cos               *)
1103 (* ------------------------------------------------------------------------ *)
1104
1105 let SIN_NEGLEMMA = prove(
1106   `!x. --(sin x) = suminf (\n. --(((\n. if EVEN n then &0 else ((--(&1))
1107         pow ((n - 1) DIV 2)) / &(FACT n))) n * (x pow n)))`,
1108   GEN_TAC THEN MATCH_MP_TAC SUM_UNIQ THEN
1109   MP_TAC(MATCH_MP SER_NEG (SPEC `x:real` SIN_CONVERGES)) THEN
1110   BETA_TAC THEN DISCH_THEN ACCEPT_TAC);;
1111
1112 let DIFF_EXP = prove(
1113   `!x. (exp diffl exp(x))(x)`,
1114   GEN_TAC THEN REWRITE_TAC[HALF_MK_ABS exp] THEN
1115   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM REAL_EXP_FDIFF] THEN
1116   CONV_TAC(LAND_CONV BETA_CONV) THEN
1117   MATCH_MP_TAC TERMDIFF THEN EXISTS_TAC `abs(x) + &1` THEN
1118   REWRITE_TAC[REAL_EXP_FDIFF; MATCH_MP SUM_SUMMABLE (SPEC_ALL REAL_EXP_CONVERGES)] THEN
1119   MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `abs(x) + &1` THEN
1120   REWRITE_TAC[ABS_LE; REAL_LT_ADDR] THEN
1121   REWRITE_TAC[REAL_LT; num_CONV `1`; LT_0]);;
1122
1123 let DIFF_SIN = prove(
1124   `!x. (sin diffl cos(x))(x)`,
1125   GEN_TAC THEN REWRITE_TAC[HALF_MK_ABS sin; cos] THEN
1126   ONCE_REWRITE_TAC[GSYM SIN_FDIFF] THEN
1127   MATCH_MP_TAC TERMDIFF THEN EXISTS_TAC `abs(x) + &1` THEN
1128   REPEAT CONJ_TAC THENL
1129    [REWRITE_TAC[MATCH_MP SUM_SUMMABLE (SPEC_ALL SIN_CONVERGES)];
1130     REWRITE_TAC[SIN_FDIFF; MATCH_MP SUM_SUMMABLE (SPEC_ALL COS_CONVERGES)];
1131     REWRITE_TAC[SIN_FDIFF; COS_FDIFF] THEN BETA_TAC THEN
1132     MP_TAC(SPEC `abs(x) + &1` SIN_CONVERGES) THEN
1133     DISCH_THEN(MP_TAC o MATCH_MP SER_NEG) THEN
1134     DISCH_THEN(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN BETA_TAC THEN
1135     REWRITE_TAC[GSYM REAL_NEG_LMUL];
1136     MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `abs(x) + &1` THEN
1137     REWRITE_TAC[ABS_LE; REAL_LT_ADDR] THEN
1138     REWRITE_TAC[REAL_LT; num_CONV `1`; LT_0]]);;
1139
1140 let DIFF_COS = prove(
1141   `!x. (cos diffl --(sin(x)))(x)`,
1142   GEN_TAC THEN REWRITE_TAC[HALF_MK_ABS cos; SIN_NEGLEMMA] THEN
1143   ONCE_REWRITE_TAC[REAL_NEG_LMUL] THEN
1144   REWRITE_TAC[GSYM(CONV_RULE(RAND_CONV BETA_CONV)
1145     (AP_THM COS_FDIFF `n:num`))] THEN
1146   MATCH_MP_TAC TERMDIFF THEN EXISTS_TAC `abs(x) + &1` THEN
1147   REPEAT CONJ_TAC THENL
1148    [REWRITE_TAC[MATCH_MP SUM_SUMMABLE (SPEC_ALL COS_CONVERGES)];
1149     REWRITE_TAC[COS_FDIFF] THEN
1150     MP_TAC(SPEC `abs(x) + &1` SIN_CONVERGES) THEN
1151     DISCH_THEN(MP_TAC o MATCH_MP SER_NEG) THEN
1152     DISCH_THEN(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN BETA_TAC THEN
1153     REWRITE_TAC[GSYM REAL_NEG_LMUL];
1154     REWRITE_TAC[COS_FDIFF; DIFFS_NEG] THEN
1155     MP_TAC SIN_FDIFF THEN BETA_TAC THEN
1156     DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN
1157     MP_TAC(SPEC `abs(x) + &1` COS_CONVERGES) THEN
1158     DISCH_THEN(MP_TAC o MATCH_MP SER_NEG) THEN
1159     DISCH_THEN(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN BETA_TAC THEN
1160     REWRITE_TAC[GSYM REAL_NEG_LMUL];
1161     MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `abs(x) + &1` THEN
1162     REWRITE_TAC[ABS_LE; REAL_LT_ADDR] THEN
1163     REWRITE_TAC[REAL_LT; num_CONV `1`; LT_0]]);;
1164
1165 (* ------------------------------------------------------------------------- *)
1166 (* Differentiation conversion.                                               *)
1167 (* ------------------------------------------------------------------------- *)
1168
1169 let DIFF_CONV =
1170   let lookup_expr tm =
1171     tryfind (fun f -> f tm) (lookup tm (!diff_net)) in
1172   let v = `x:real` and k = `k:real` and diffl_tm = `(diffl)` in
1173   let DIFF_var = SPEC v DIFF_X
1174   and DIFF_const = SPECL [k;v] DIFF_CONST in
1175   let uneta_CONV = REWR_CONV (GSYM ETA_AX) in
1176   let rec DIFF_CONV tm =
1177     if not (is_abs tm) then
1178       let th0 = uneta_CONV tm in
1179       let th1 = DIFF_CONV (rand(concl th0)) in
1180       CONV_RULE (RATOR_CONV(LAND_CONV(K(SYM th0)))) th1 else
1181     let x,bod = dest_abs tm in
1182     if bod = x then INST [x,v] DIFF_var
1183     else if not(free_in x bod) then INST [bod,k; x,v] DIFF_const else
1184     let th = lookup_expr tm in
1185     let hyp = fst(dest_imp(concl th)) in
1186     let hyps = conjuncts hyp in
1187     let dhyps,sides = partition
1188       (fun t -> try funpow 3 rator t = diffl_tm
1189                 with Failure _ -> false) hyps in
1190     let tha = CONJ_ACI_RULE(mk_eq(hyp,list_mk_conj(dhyps@sides))) in
1191     let thb = CONV_RULE (LAND_CONV (K tha)) th in
1192     let dths = map (DIFF_CONV o lhand o rator) dhyps in
1193     MATCH_MP thb (end_itlist CONJ (dths @ map ASSUME sides)) in
1194   fun tm ->
1195     let xv = try bndvar tm with Failure _ -> v in
1196     GEN xv (DISCH_ALL(DIFF_CONV tm));;
1197
1198 (* ------------------------------------------------------------------------- *)
1199 (* Processed versions of composition theorems.                               *)
1200 (* ------------------------------------------------------------------------- *)
1201
1202 let DIFF_COMPOSITE = prove
1203  (`((f diffl l)(x) /\ ~(f(x) = &0) ==>
1204         ((\x. inv(f x)) diffl --(l / (f(x) pow 2)))(x)) /\
1205    ((f diffl l)(x) /\ (g diffl m)(x) /\ ~(g(x) = &0) ==>
1206     ((\x. f(x) / g(x)) diffl (((l * g(x)) - (m * f(x))) / (g(x) pow 2)))(x)) /\
1207    ((f diffl l)(x) /\ (g diffl m)(x) ==>
1208                    ((\x. f(x) + g(x)) diffl (l + m))(x)) /\
1209    ((f diffl l)(x) /\ (g diffl m)(x) ==>
1210                    ((\x. f(x) * g(x)) diffl ((l * g(x)) + (m * f(x))))(x)) /\
1211    ((f diffl l)(x) /\ (g diffl m)(x) ==>
1212                    ((\x. f(x) - g(x)) diffl (l - m))(x)) /\
1213    ((f diffl l)(x) ==> ((\x. --(f x)) diffl --l)(x)) /\
1214    ((g diffl m)(x) ==>
1215          ((\x. (g x) pow n) diffl ((&n * (g x) pow (n - 1)) * m))(x)) /\
1216    ((g diffl m)(x) ==> ((\x. exp(g x)) diffl (exp(g x) * m))(x)) /\
1217    ((g diffl m)(x) ==> ((\x. sin(g x)) diffl (cos(g x) * m))(x)) /\
1218    ((g diffl m)(x) ==> ((\x. cos(g x)) diffl (--(sin(g x)) * m))(x))`,
1219   REWRITE_TAC[DIFF_INV; DIFF_DIV; DIFF_ADD; DIFF_SUB; DIFF_MUL; DIFF_NEG] THEN
1220   REPEAT CONJ_TAC THEN DISCH_TAC THEN
1221   TRY(MATCH_MP_TAC DIFF_CHAIN THEN
1222   ASM_REWRITE_TAC[DIFF_SIN; DIFF_COS; DIFF_EXP]) THEN
1223   MATCH_MP_TAC(BETA_RULE (SPEC `\x. x pow n` DIFF_CHAIN)) THEN
1224   ASM_REWRITE_TAC[DIFF_POW]);;
1225
1226 do_list add_to_diff_net (CONJUNCTS DIFF_COMPOSITE);;
1227
1228 (* ------------------------------------------------------------------------- *)
1229 (* Tactic for goals "(f diffl l) x"                                          *)
1230 (* ------------------------------------------------------------------------- *)
1231
1232 let DIFF_TAC =
1233   W(fun (asl,w) -> MP_TAC(SPEC(rand w) (DIFF_CONV(lhand(rator w)))) THEN
1234                    MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC);;
1235
1236 (* ------------------------------------------------------------------------- *)
1237 (* Prove differentiability terms.                                            *)
1238 (* ------------------------------------------------------------------------- *)
1239
1240 let DIFFERENTIABLE_RULE =
1241   let pth = prove
1242    (`(f diffl l) x ==> f differentiable x`, MESON_TAC[differentiable]) in
1243   let match_pth = MATCH_MP pth in
1244   fun tm ->
1245     let tb,y = dest_comb tm in
1246     let tm' = rand tb in
1247     match_pth (SPEC y (DIFF_CONV tm'));;
1248
1249 let DIFFERENTIABLE_CONV = EQT_INTRO o DIFFERENTIABLE_RULE;;
1250
1251 (* ------------------------------------------------------------------------- *)
1252 (* Prove continuity via differentiability (weak but useful).                 *)
1253 (* ------------------------------------------------------------------------- *)
1254
1255 let CONTINUOUS_RULE =
1256   let pth = prove
1257    (`!f x. f differentiable x ==> f contl x`,
1258     MESON_TAC[differentiable; DIFF_CONT]) in
1259   let match_pth = PART_MATCH rand pth in
1260   fun tm ->
1261    let th1 = match_pth tm in
1262    MP th1 (DIFFERENTIABLE_RULE(lhand(concl th1)));;
1263
1264 let CONTINUOUS_CONV = EQT_INTRO o CONTINUOUS_RULE;;
1265
1266 (* ------------------------------------------------------------------------ *)
1267 (* Properties of the exponential function                                   *)
1268 (* ------------------------------------------------------------------------ *)
1269
1270 let REAL_EXP_0 = prove(
1271   `exp(&0) = &1`,
1272   REWRITE_TAC[exp] THEN CONV_TAC SYM_CONV THEN
1273   MATCH_MP_TAC SUM_UNIQ THEN BETA_TAC THEN
1274   W(MP_TAC o C SPEC SER_0 o rand o rator o snd) THEN
1275   DISCH_THEN(MP_TAC o SPEC `1`) THEN
1276   REWRITE_TAC[num_CONV `1`; sum] THEN
1277   REWRITE_TAC[ADD_CLAUSES; REAL_ADD_LID] THEN BETA_TAC THEN
1278   REWRITE_TAC[FACT; pow; REAL_MUL_RID; REAL_INV1] THEN
1279   REWRITE_TAC[SYM(num_CONV `1`)] THEN DISCH_THEN MATCH_MP_TAC THEN
1280   X_GEN_TAC `n:num` THEN REWRITE_TAC[num_CONV `1`; LE_SUC_LT] THEN
1281   DISCH_THEN(CHOOSE_THEN SUBST1_TAC o MATCH_MP LESS_ADD_1) THEN
1282   REWRITE_TAC[GSYM ADD1; POW_0; REAL_MUL_RZERO; ADD_CLAUSES]);;
1283
1284 let REAL_EXP_LE_X = prove(
1285   `!x. &0 <= x ==> (&1 + x) <= exp(x)`,
1286   GEN_TAC THEN DISCH_THEN(DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT]) THENL
1287    [MP_TAC(SPECL [`\n. ((\n. inv(&(FACT n)))) n * (x pow n)`; `2`]
1288      SER_POS_LE) THEN
1289     REWRITE_TAC[MATCH_MP SUM_SUMMABLE (SPEC_ALL REAL_EXP_CONVERGES)] THEN
1290     REWRITE_TAC[GSYM exp] THEN BETA_TAC THEN
1291     W(C SUBGOAL_THEN (fun t ->REWRITE_TAC[t]) o
1292     funpow 2 (fst o dest_imp) o snd) THENL
1293      [GEN_TAC THEN DISCH_THEN(K ALL_TAC) THEN
1294       MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL
1295        [MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC REAL_INV_POS THEN
1296         REWRITE_TAC[REAL_LT; FACT_LT];
1297         MATCH_MP_TAC POW_POS THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN
1298         FIRST_ASSUM ACCEPT_TAC];
1299       CONV_TAC(TOP_DEPTH_CONV num_CONV) THEN REWRITE_TAC[sum] THEN
1300       BETA_TAC THEN REWRITE_TAC[ADD_CLAUSES; FACT; pow; REAL_ADD_LID] THEN
1301       REWRITE_TAC[MULT_CLAUSES; REAL_INV1; REAL_MUL_LID; ADD_CLAUSES] THEN
1302       REWRITE_TAC[REAL_MUL_RID; SYM(num_CONV `1`)]];
1303     POP_ASSUM(SUBST1_TAC o SYM) THEN
1304     REWRITE_TAC[REAL_EXP_0; REAL_ADD_RID; REAL_LE_REFL]]);;
1305
1306 let REAL_EXP_LT_1 = prove(
1307   `!x. &0 < x ==> &1 < exp(x)`,
1308   GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN
1309   EXISTS_TAC `&1 + x` THEN ASM_REWRITE_TAC[REAL_LT_ADDR] THEN
1310   MATCH_MP_TAC REAL_EXP_LE_X THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN
1311   POP_ASSUM ACCEPT_TAC);;
1312
1313 let REAL_EXP_ADD_MUL = prove(
1314   `!x y. exp(x + y) * exp(--x) = exp(y)`,
1315   REPEAT GEN_TAC THEN
1316   CONV_TAC(LAND_CONV(X_BETA_CONV `x:real`)) THEN
1317   SUBGOAL_THEN `exp(y) = (\x. exp(x + y) * exp(--x))(&0)` SUBST1_TAC THENL
1318    [BETA_TAC THEN REWRITE_TAC[REAL_ADD_LID; REAL_NEG_0] THEN
1319     REWRITE_TAC[REAL_EXP_0; REAL_MUL_RID];
1320     MATCH_MP_TAC DIFF_ISCONST_ALL THEN X_GEN_TAC `x:real` THEN
1321     W(MP_TAC o DIFF_CONV o rand o funpow 2 rator o snd) THEN
1322     DISCH_THEN(MP_TAC o SPEC `x:real`) THEN
1323     MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN
1324     AP_TERM_TAC THEN REWRITE_TAC[GSYM REAL_NEG_LMUL; GSYM REAL_NEG_RMUL] THEN
1325     REWRITE_TAC[GSYM real_sub; REAL_SUB_0; REAL_MUL_RID; REAL_ADD_RID] THEN
1326     MATCH_ACCEPT_TAC REAL_MUL_SYM]);;
1327
1328 let REAL_EXP_NEG_MUL = prove(
1329   `!x. exp(x) * exp(--x) = &1`,
1330   GEN_TAC THEN MP_TAC(SPECL [`x:real`; `&0`] REAL_EXP_ADD_MUL) THEN
1331   REWRITE_TAC[REAL_ADD_RID; REAL_EXP_0]);;
1332
1333 let REAL_EXP_NEG_MUL2 = prove(
1334   `!x. exp(--x) * exp(x) = &1`,
1335   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_ACCEPT_TAC REAL_EXP_NEG_MUL);;
1336
1337 let REAL_EXP_NEG = prove(
1338   `!x. exp(--x) = inv(exp(x))`,
1339   GEN_TAC THEN MATCH_MP_TAC REAL_RINV_UNIQ THEN
1340   MATCH_ACCEPT_TAC REAL_EXP_NEG_MUL);;
1341
1342 let REAL_EXP_ADD = prove(
1343   `!x y. exp(x + y) = exp(x) * exp(y)`,
1344   REPEAT GEN_TAC THEN
1345   MP_TAC(SPECL [`x:real`; `y:real`] REAL_EXP_ADD_MUL) THEN
1346   DISCH_THEN(MP_TAC o C AP_THM `exp(x)` o AP_TERM `(*)`) THEN
1347   REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN
1348   REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] REAL_EXP_NEG_MUL; REAL_MUL_RID] THEN
1349   DISCH_THEN SUBST1_TAC THEN MATCH_ACCEPT_TAC REAL_MUL_SYM);;
1350
1351 let REAL_EXP_POS_LE = prove(
1352   `!x. &0 <= exp(x)`,
1353   GEN_TAC THEN
1354   GEN_REWRITE_TAC (funpow 2 RAND_CONV) [GSYM REAL_HALF_DOUBLE] THEN
1355   REWRITE_TAC[REAL_EXP_ADD] THEN MATCH_ACCEPT_TAC REAL_LE_SQUARE);;
1356
1357 let REAL_EXP_NZ = prove(
1358   `!x. ~(exp(x) = &0)`,
1359   GEN_TAC THEN DISCH_TAC THEN
1360   MP_TAC(SPEC `x:real` REAL_EXP_NEG_MUL) THEN
1361   ASM_REWRITE_TAC[REAL_MUL_LZERO] THEN
1362   CONV_TAC(RAND_CONV SYM_CONV) THEN
1363   MATCH_ACCEPT_TAC REAL_10);;
1364
1365 let REAL_EXP_POS_LT = prove(
1366   `!x. &0 < exp(x)`,
1367   GEN_TAC THEN REWRITE_TAC[REAL_LT_LE] THEN
1368   CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN
1369   REWRITE_TAC[REAL_EXP_POS_LE; REAL_EXP_NZ]);;
1370
1371 let REAL_EXP_N = prove(
1372   `!n x. exp(&n * x) = exp(x) pow n`,
1373   INDUCT_TAC THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_EXP_0; pow] THEN
1374   REWRITE_TAC[ADD1] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN
1375   REWRITE_TAC[GSYM REAL_ADD; REAL_EXP_ADD; REAL_RDISTRIB] THEN
1376   GEN_TAC THEN ASM_REWRITE_TAC[REAL_MUL_LID]);;
1377
1378 let REAL_EXP_SUB = prove(
1379   `!x y. exp(x - y) = exp(x) / exp(y)`,
1380   REPEAT GEN_TAC THEN
1381   REWRITE_TAC[real_sub; real_div; REAL_EXP_ADD; REAL_EXP_NEG]);;
1382
1383 let REAL_EXP_MONO_IMP = prove(
1384   `!x y. x < y ==> exp(x) < exp(y)`,
1385   REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o
1386     MATCH_MP REAL_EXP_LT_1 o ONCE_REWRITE_RULE[GSYM REAL_SUB_LT]) THEN
1387   REWRITE_TAC[REAL_EXP_SUB] THEN
1388   SUBGOAL_THEN `&1 < exp(y) / exp(x) <=>
1389                  (&1 * exp(x)) < ((exp(y) / exp(x)) * exp(x))` SUBST1_TAC THENL
1390    [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_LT_RMUL_EQ THEN
1391     MATCH_ACCEPT_TAC REAL_EXP_POS_LT;
1392     REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC; REAL_EXP_NEG_MUL2;
1393                 GSYM REAL_EXP_NEG] THEN
1394     REWRITE_TAC[REAL_MUL_LID; REAL_MUL_RID]]);;
1395
1396 let REAL_EXP_MONO_LT = prove(
1397   `!x y. exp(x) < exp(y) <=> x < y`,
1398   REPEAT GEN_TAC THEN EQ_TAC THENL
1399    [CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[REAL_NOT_LT] THEN
1400     REWRITE_TAC[REAL_LE_LT] THEN
1401     DISCH_THEN(DISJ_CASES_THEN2 ASSUME_TAC SUBST1_TAC) THEN
1402     REWRITE_TAC[] THEN DISJ1_TAC THEN MATCH_MP_TAC REAL_EXP_MONO_IMP THEN
1403     POP_ASSUM ACCEPT_TAC;
1404     MATCH_ACCEPT_TAC REAL_EXP_MONO_IMP]);;
1405
1406 let REAL_EXP_MONO_LE = prove(
1407   `!x y. exp(x) <= exp(y) <=> x <= y`,
1408   REPEAT GEN_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN
1409   REWRITE_TAC[REAL_EXP_MONO_LT]);;
1410
1411 let REAL_EXP_INJ = prove(
1412   `!x y. (exp(x) = exp(y)) <=> (x = y)`,
1413   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN
1414   REWRITE_TAC[REAL_EXP_MONO_LE]);;
1415
1416 let REAL_EXP_TOTAL_LEMMA = prove(
1417   `!y. &1 <= y ==> ?x. &0 <= x /\ x <= y - &1 /\ (exp(x) = y)`,
1418   GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC IVT THEN
1419   ASM_REWRITE_TAC[REAL_EXP_0; REAL_LE_SUB_LADD; REAL_ADD_LID] THEN CONJ_TAC THENL
1420    [RULE_ASSUM_TAC(ONCE_REWRITE_RULE[GSYM REAL_SUB_LE]) THEN
1421     POP_ASSUM(MP_TAC o MATCH_MP REAL_EXP_LE_X) THEN REWRITE_TAC[REAL_SUB_ADD2];
1422     X_GEN_TAC `x:real` THEN DISCH_THEN(K ALL_TAC) THEN
1423     MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC `exp(x)` THEN
1424     MATCH_ACCEPT_TAC DIFF_EXP]);;
1425
1426 let REAL_EXP_TOTAL = prove(
1427   `!y. &0 < y ==> ?x. exp(x) = y`,
1428   GEN_TAC THEN DISCH_TAC THEN
1429   DISJ_CASES_TAC(SPECL [`&1`; `y:real`] REAL_LET_TOTAL) THENL
1430    [FIRST_ASSUM(X_CHOOSE_TAC `x:real` o MATCH_MP REAL_EXP_TOTAL_LEMMA) THEN
1431     EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[];
1432     MP_TAC(SPEC `y:real` REAL_INV_LT1) THEN ASM_REWRITE_TAC[] THEN
1433     DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_IMP_LE) THEN
1434     DISCH_THEN(X_CHOOSE_TAC `x:real` o MATCH_MP REAL_EXP_TOTAL_LEMMA) THEN
1435     EXISTS_TAC `--x` THEN ASM_REWRITE_TAC[REAL_EXP_NEG] THEN
1436     MATCH_MP_TAC REAL_INVINV THEN CONV_TAC(RAND_CONV SYM_CONV) THEN
1437     MATCH_MP_TAC REAL_LT_IMP_NE THEN ASM_REWRITE_TAC[]]);;
1438
1439 let REAL_EXP_BOUND_LEMMA = prove
1440  (`!x. &0 <= x /\ x <= inv(&2) ==> exp(x) <= &1 + &2 * x`,
1441   GEN_TAC THEN DISCH_TAC THEN
1442   MATCH_MP_TAC REAL_LE_TRANS THEN
1443   EXISTS_TAC `suminf (\n. x pow n)` THEN CONJ_TAC THENL
1444    [REWRITE_TAC[exp; BETA_THM] THEN MATCH_MP_TAC SER_LE THEN
1445     REWRITE_TAC[summable; BETA_THM] THEN REPEAT CONJ_TAC THENL
1446      [GEN_TAC THEN
1447       GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN
1448       MATCH_MP_TAC REAL_LE_RMUL_IMP THEN CONJ_TAC THENL
1449        [MATCH_MP_TAC REAL_POW_LE THEN ASM_REWRITE_TAC[];
1450         MATCH_MP_TAC REAL_INV_LE_1 THEN
1451         REWRITE_TAC[REAL_OF_NUM_LE; num_CONV `1`; LE_SUC_LT] THEN
1452         REWRITE_TAC[FACT_LT]];
1453       EXISTS_TAC `exp x` THEN REWRITE_TAC[BETA_RULE REAL_EXP_CONVERGES];
1454       EXISTS_TAC `inv(&1 - x)` THEN MATCH_MP_TAC GP THEN
1455       ASM_REWRITE_TAC[real_abs] THEN
1456       MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&2)` THEN
1457       ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV];
1458     SUBGOAL_THEN `suminf (\n. x pow n) = inv (&1 - x)` SUBST1_TAC THENL
1459      [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_UNIQ THEN
1460       MATCH_MP_TAC GP THEN
1461       ASM_REWRITE_TAC[real_abs] THEN
1462       MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&2)` THEN
1463       ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV;
1464       MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN
1465       EXISTS_TAC `&1 - x` THEN
1466       SUBGOAL_THEN `(&1 - x) * inv (&1 - x) = &1` SUBST1_TAC THENL
1467        [MATCH_MP_TAC REAL_MUL_RINV THEN
1468         REWRITE_TAC[REAL_ARITH `(&1 - x = &0) <=> (x = &1)`] THEN
1469         DISCH_THEN SUBST_ALL_TAC THEN
1470         POP_ASSUM MP_TAC THEN CONV_TAC REAL_RAT_REDUCE_CONV;
1471         CONJ_TAC THENL
1472          [MATCH_MP_TAC REAL_LET_TRANS THEN
1473           EXISTS_TAC `inv(&2) - x` THEN
1474           ASM_REWRITE_TAC[REAL_ARITH `&0 <= x - y <=> y <= x`] THEN
1475           ASM_REWRITE_TAC[REAL_ARITH `a - x < b - x <=> a < b`] THEN
1476           CONV_TAC REAL_RAT_REDUCE_CONV;
1477           REWRITE_TAC[REAL_ADD_LDISTRIB; REAL_SUB_RDISTRIB] THEN
1478           REWRITE_TAC[REAL_MUL_RID; REAL_MUL_LID] THEN
1479           REWRITE_TAC[REAL_ARITH `&1 <= (&1 + &2 * x) - (x + x * &2 * x) <=>
1480                                   x * (&2 * x) <= x * &1`] THEN
1481           MATCH_MP_TAC REAL_LE_LMUL_IMP THEN ASM_REWRITE_TAC[] THEN
1482           MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `inv(&2)` THEN
1483           REWRITE_TAC[REAL_MUL_ASSOC] THEN
1484           CONV_TAC REAL_RAT_REDUCE_CONV THEN
1485           ASM_REWRITE_TAC[REAL_MUL_LID; real_div]]]]]);;
1486
1487 (* ------------------------------------------------------------------------ *)
1488 (* Properties of the logarithmic function                                   *)
1489 (* ------------------------------------------------------------------------ *)
1490
1491 let ln = new_definition
1492   `ln x = @u. exp(u) = x`;;
1493
1494 let LN_EXP = prove(
1495   `!x. ln(exp x) = x`,
1496   GEN_TAC THEN REWRITE_TAC[ln; REAL_EXP_INJ] THEN
1497   CONV_TAC SYM_CONV THEN CONV_TAC(RAND_CONV(ONCE_DEPTH_CONV SYM_CONV)) THEN
1498   CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN MATCH_MP_TAC SELECT_AX THEN
1499   EXISTS_TAC `x:real` THEN REFL_TAC);;
1500
1501 let REAL_EXP_LN = prove(
1502   `!x. (exp(ln x) = x) <=> &0 < x`,
1503   GEN_TAC THEN EQ_TAC THENL
1504    [DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_ACCEPT_TAC REAL_EXP_POS_LT;
1505     DISCH_THEN(X_CHOOSE_THEN `y:real` MP_TAC o MATCH_MP REAL_EXP_TOTAL) THEN
1506     DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[REAL_EXP_INJ; LN_EXP]]);;
1507
1508 let EXP_LN = prove
1509  (`!x. &0 < x ==> exp(ln x) = x`,
1510   REWRITE_TAC[REAL_EXP_LN]);;
1511
1512 let LN_MUL = prove(
1513   `!x y. &0 < x /\ &0 < y ==> (ln(x * y) = ln(x) + ln(y))`,
1514   REPEAT GEN_TAC THEN STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_EXP_INJ] THEN
1515   REWRITE_TAC[REAL_EXP_ADD] THEN SUBGOAL_THEN `&0 < x * y` ASSUME_TAC THENL
1516    [MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[];
1517     EVERY_ASSUM(fun th -> REWRITE_TAC[ONCE_REWRITE_RULE[GSYM REAL_EXP_LN] th])]);;
1518
1519 let LN_INJ = prove(
1520   `!x y. &0 < x /\ &0 < y ==> ((ln(x) = ln(y)) <=> (x = y))`,
1521   REPEAT GEN_TAC THEN STRIP_TAC THEN
1522   EVERY_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV)
1523     [SYM(REWRITE_RULE[GSYM REAL_EXP_LN] th)]) THEN
1524   CONV_TAC SYM_CONV THEN MATCH_ACCEPT_TAC REAL_EXP_INJ);;
1525
1526 let LN_1 = prove(
1527   `ln(&1) = &0`,
1528   ONCE_REWRITE_TAC[GSYM REAL_EXP_INJ] THEN
1529   REWRITE_TAC[REAL_EXP_0; REAL_EXP_LN; REAL_LT_01]);;
1530
1531 let LN_INV = prove(
1532   `!x. &0 < x ==> (ln(inv x) = --(ln x))`,
1533   GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[GSYM REAL_RNEG_UNIQ] THEN
1534   SUBGOAL_THEN `&0 < x /\ &0 < inv(x)` MP_TAC THENL
1535    [CONJ_TAC THEN TRY(MATCH_MP_TAC REAL_INV_POS) THEN ASM_REWRITE_TAC[];
1536     DISCH_THEN(fun th -> REWRITE_TAC[GSYM(MATCH_MP LN_MUL th)]) THEN
1537     SUBGOAL_THEN `x * (inv x) = &1` SUBST1_TAC THENL
1538      [MATCH_MP_TAC REAL_MUL_RINV THEN
1539       POP_ASSUM(ACCEPT_TAC o MATCH_MP REAL_POS_NZ);
1540       REWRITE_TAC[LN_1]]]);;
1541
1542 let LN_DIV = prove(
1543   `!x. &0 < x /\ &0 < y ==> (ln(x / y) = ln(x) - ln(y))`,
1544   GEN_TAC THEN STRIP_TAC THEN
1545   SUBGOAL_THEN `&0 < x /\ &0 < inv(y)` MP_TAC THENL
1546    [CONJ_TAC THEN TRY(MATCH_MP_TAC REAL_INV_POS) THEN ASM_REWRITE_TAC[];
1547     REWRITE_TAC[real_div] THEN
1548     DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP LN_MUL th]) THEN
1549     REWRITE_TAC[MATCH_MP LN_INV (ASSUME `&0 < y`)] THEN
1550     REWRITE_TAC[real_sub]]);;
1551
1552 let LN_MONO_LT = prove(
1553   `!x y. &0 < x /\ &0 < y ==> (ln(x) < ln(y) <=> x < y)`,
1554   REPEAT GEN_TAC THEN STRIP_TAC THEN
1555   EVERY_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV)
1556     [SYM(REWRITE_RULE[GSYM REAL_EXP_LN] th)]) THEN
1557   CONV_TAC SYM_CONV THEN MATCH_ACCEPT_TAC REAL_EXP_MONO_LT);;
1558
1559 let LN_MONO_LE = prove(
1560   `!x y. &0 < x /\ &0 < y ==> (ln(x) <= ln(y) <=> x <= y)`,
1561   REPEAT GEN_TAC THEN STRIP_TAC THEN
1562   EVERY_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV)
1563     [SYM(REWRITE_RULE[GSYM REAL_EXP_LN] th)]) THEN
1564   CONV_TAC SYM_CONV THEN MATCH_ACCEPT_TAC REAL_EXP_MONO_LE);;
1565
1566 let LN_POW = prove(
1567   `!n x. &0 < x ==> (ln(x pow n) = &n * ln(x))`,
1568   REPEAT GEN_TAC THEN
1569   DISCH_THEN(CHOOSE_THEN (SUBST1_TAC o SYM) o MATCH_MP REAL_EXP_TOTAL) THEN
1570   REWRITE_TAC[GSYM REAL_EXP_N; LN_EXP]);;
1571
1572 let LN_LE = prove(
1573   `!x. &0 <= x ==> ln(&1 + x) <= x`,
1574   GEN_TAC THEN DISCH_TAC THEN
1575   GEN_REWRITE_TAC RAND_CONV  [GSYM LN_EXP] THEN
1576   MP_TAC(SPECL [`&1 + x`; `exp(x)`] LN_MONO_LE) THEN
1577   W(C SUBGOAL_THEN (fun t -> REWRITE_TAC[t]) o funpow 2 (fst o dest_imp) o snd) THENL
1578    [REWRITE_TAC[REAL_EXP_POS_LT] THEN MATCH_MP_TAC REAL_LET_TRANS THEN
1579     EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[REAL_LT_ADDL; REAL_LT_01];
1580     DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC REAL_EXP_LE_X THEN ASM_REWRITE_TAC[]]);;
1581
1582 let LN_LT_X = prove(
1583   `!x. &0 < x ==> ln(x) < x`,
1584   GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN
1585   EXISTS_TAC `ln(&1 + x)` THEN CONJ_TAC THENL
1586    [IMP_SUBST_TAC LN_MONO_LT THEN
1587     ASM_REWRITE_TAC[REAL_LT_ADDL; REAL_LT_01] THEN
1588     MATCH_MP_TAC REAL_LT_ADD THEN ASM_REWRITE_TAC[REAL_LT_01];
1589     MATCH_MP_TAC LN_LE THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN
1590     ASM_REWRITE_TAC[]]);;
1591
1592 let LN_POS = prove
1593  (`!x. &1 <= x ==> &0 <= ln(x)`,
1594   REWRITE_TAC[GSYM LN_1] THEN
1595   SIMP_TAC[LN_MONO_LE; ARITH_RULE `&1 <= x ==> &0 < x`; REAL_LT_01]);;
1596
1597 let LN_POS_LT = prove
1598  (`!x. &1 < x ==> &0 < ln(x)`,
1599   REWRITE_TAC[GSYM LN_1] THEN
1600   SIMP_TAC[LN_MONO_LT; ARITH_RULE `&1 < x ==> &0 < x`; REAL_LT_01]);;
1601
1602 let DIFF_LN = prove(
1603   `!x. &0 < x ==> (ln diffl (inv x))(x)`,
1604   GEN_TAC THEN DISCH_TAC THEN
1605   FIRST_ASSUM(ASSUME_TAC o REWRITE_RULE[GSYM REAL_EXP_LN]) THEN
1606   FIRST_ASSUM (fun th ->  GEN_REWRITE_TAC RAND_CONV  [GSYM th]) THEN
1607   MATCH_MP_TAC DIFF_INVERSE_LT THEN
1608   FIRST_ASSUM(ASSUME_TAC o MATCH_MP REAL_POS_NZ) THEN
1609   ASM_REWRITE_TAC[MATCH_MP DIFF_CONT (SPEC_ALL DIFF_EXP)] THEN
1610   MP_TAC(SPEC `ln(x)` DIFF_EXP) THEN ASM_REWRITE_TAC[] THEN
1611   DISCH_TAC THEN ASM_REWRITE_TAC[LN_EXP] THEN
1612   EXISTS_TAC `&1` THEN MATCH_ACCEPT_TAC REAL_LT_01);;
1613
1614 (* ------------------------------------------------------------------------ *)
1615 (* Some properties of roots (easier via logarithms)                         *)
1616 (* ------------------------------------------------------------------------ *)
1617
1618 let root = new_definition
1619   `root(n) x = @u. (&0 < x ==> &0 < u) /\ (u pow n = x)`;;
1620
1621 let sqrt_def = new_definition
1622   `sqrt(x) = @y. &0 <= y /\ (y pow 2 = x)`;;
1623
1624 let sqrt = prove
1625  (`sqrt(x) = root(2) x`,
1626   REWRITE_TAC[root; sqrt_def] THEN
1627   AP_TERM_TAC THEN REWRITE_TAC[BETA_THM; FUN_EQ_THM] THEN
1628   X_GEN_TAC `y:real` THEN  ASM_CASES_TAC `x = y pow 2` THEN
1629   ASM_REWRITE_TAC[] THEN
1630   REWRITE_TAC[REAL_POW_2; REAL_LT_SQUARE] THEN REAL_ARITH_TAC);;
1631
1632 let ROOT_LT_LEMMA = prove(
1633   `!n x. &0 < x ==> (exp(ln(x) / &(SUC n)) pow (SUC n) = x)`,
1634   REPEAT GEN_TAC THEN DISCH_TAC THEN
1635   REWRITE_TAC[GSYM REAL_EXP_N] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
1636   REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN
1637   SUBGOAL_THEN `inv(&(SUC n)) * &(SUC n) = &1` SUBST1_TAC THENL
1638    [MATCH_MP_TAC REAL_MUL_LINV THEN REWRITE_TAC[REAL_INJ; NOT_SUC];
1639     ASM_REWRITE_TAC[REAL_MUL_RID; REAL_EXP_LN]]);;
1640
1641 let ROOT_LN = prove(
1642   `!x. &0 < x ==> !n. root(SUC n) x = exp(ln(x) / &(SUC n))`,
1643   GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN REWRITE_TAC[root] THEN
1644   MATCH_MP_TAC SELECT_UNIQUE THEN X_GEN_TAC `y:real` THEN BETA_TAC THEN
1645   ASM_REWRITE_TAC[] THEN EQ_TAC THENL
1646    [DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC o SYM)) THEN
1647     SUBGOAL_THEN `!z. &0 < y /\ &0 < exp(z)` MP_TAC THENL
1648      [ASM_REWRITE_TAC[REAL_EXP_POS_LT]; ALL_TAC] THEN
1649     DISCH_THEN(MP_TAC o GEN_ALL o SYM o MATCH_MP LN_INJ o SPEC_ALL) THEN
1650     DISCH_THEN(fun th -> GEN_REWRITE_TAC I [th]) THEN
1651     REWRITE_TAC[LN_EXP] THEN
1652     SUBGOAL_THEN `ln(y) * &(SUC n) = (ln(y pow(SUC n)) / &(SUC n)) * &(SUC n)`
1653     MP_TAC THENL
1654      [REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN
1655       SUBGOAL_THEN `inv(&(SUC n)) * &(SUC n) = &1` SUBST1_TAC THENL
1656        [MATCH_MP_TAC REAL_MUL_LINV THEN REWRITE_TAC[REAL_INJ; NOT_SUC];
1657         REWRITE_TAC[REAL_MUL_RID] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
1658         CONV_TAC SYM_CONV THEN MATCH_MP_TAC LN_POW THEN
1659         ASM_REWRITE_TAC[]];
1660       REWRITE_TAC[REAL_EQ_RMUL; REAL_INJ; NOT_SUC]];
1661     DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_EXP_POS_LT] THEN
1662     MATCH_MP_TAC ROOT_LT_LEMMA THEN ASM_REWRITE_TAC[]]);;
1663
1664 let ROOT_0 = prove(
1665   `!n. root(SUC n) (&0) = &0`,
1666   GEN_TAC THEN REWRITE_TAC[root] THEN
1667   MATCH_MP_TAC SELECT_UNIQUE THEN X_GEN_TAC `y:real` THEN
1668   BETA_TAC THEN REWRITE_TAC[REAL_LT_REFL] THEN EQ_TAC THENL
1669    [SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN ONCE_REWRITE_TAC[pow] THENL
1670      [REWRITE_TAC[pow; REAL_MUL_RID];
1671       REWRITE_TAC[REAL_ENTIRE] THEN DISCH_THEN DISJ_CASES_TAC THEN
1672       ASM_REWRITE_TAC[] THEN FIRST_ASSUM MATCH_MP_TAC THEN
1673       ASM_REWRITE_TAC[]];
1674     DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[pow; REAL_MUL_LZERO]]);;
1675
1676 let ROOT_1 = prove(
1677   `!n. root(SUC n) (&1) = &1`,
1678   GEN_TAC THEN REWRITE_TAC[MATCH_MP ROOT_LN REAL_LT_01] THEN
1679   REWRITE_TAC[LN_1; REAL_DIV_LZERO; REAL_EXP_0]);;
1680
1681 let ROOT_POW_POS = prove(
1682   `!n x. &0 <= x ==> ((root(SUC n) x) pow (SUC n) = x)`,
1683   REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LE_LT] THEN
1684   DISCH_THEN DISJ_CASES_TAC THENL
1685    [FIRST_ASSUM(fun th -> REWRITE_TAC
1686      [MATCH_MP ROOT_LN th; MATCH_MP ROOT_LT_LEMMA th]);
1687     FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[ROOT_0] THEN
1688     MATCH_ACCEPT_TAC POW_0]);;
1689
1690 let POW_ROOT_POS = prove(
1691   `!n x. &0 <= x ==> (root(SUC n)(x pow (SUC n)) = x)`,
1692   REPEAT GEN_TAC THEN DISCH_TAC THEN
1693   REWRITE_TAC[root] THEN MATCH_MP_TAC SELECT_UNIQUE THEN
1694   X_GEN_TAC `y:real` THEN BETA_TAC THEN EQ_TAC THEN
1695   DISCH_TAC THEN ASM_REWRITE_TAC[] THENL
1696    [DISJ_CASES_THEN MP_TAC (REWRITE_RULE[REAL_LE_LT] (ASSUME `&0 <= x`)) THENL
1697      [DISCH_TAC THEN FIRST_ASSUM(UNDISCH_TAC o check is_conj o concl) THEN
1698       FIRST_ASSUM(fun th ->  REWRITE_TAC[MATCH_MP POW_POS_LT th]) THEN
1699       DISCH_TAC THEN MATCH_MP_TAC POW_EQ THEN EXISTS_TAC `n:num` THEN
1700       ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN
1701       ASM_REWRITE_TAC[];
1702       DISCH_THEN(SUBST_ALL_TAC o SYM) THEN
1703       FIRST_ASSUM(UNDISCH_TAC o check is_conj o concl) THEN
1704       REWRITE_TAC[POW_0; REAL_LT_REFL; POW_ZERO]];
1705     ASM_REWRITE_TAC[REAL_LT_LE] THEN CONV_TAC CONTRAPOS_CONV THEN
1706     REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
1707     REWRITE_TAC[POW_0]]);;
1708
1709 let ROOT_POS_POSITIVE = prove
1710  (`!x n. &0 <= x ==> &0 <= root(SUC n) x`,
1711   REPEAT GEN_TAC THEN
1712   DISCH_THEN(DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT]) THENL
1713    [POP_ASSUM(fun th -> REWRITE_TAC[MATCH_MP ROOT_LN th]) THEN
1714     REWRITE_TAC[REAL_EXP_POS_LE];
1715     POP_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[ROOT_0] THEN
1716     REWRITE_TAC[REAL_LE_REFL]]);;
1717
1718 let ROOT_POS_UNIQ = prove
1719  (`!n x y. &0 <= x /\ &0 <= y /\ (y pow (SUC n) = x)
1720            ==> (root (SUC n) x = y)`,
1721   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
1722   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (SUBST1_TAC o SYM)) THEN
1723   ASM_SIMP_TAC[POW_ROOT_POS]);;
1724
1725 let ROOT_MUL = prove
1726  (`!n x y. &0 <= x /\ &0 <= y
1727            ==> (root(SUC n) (x * y) = root(SUC n) x * root(SUC n) y)`,
1728   REPEAT STRIP_TAC THEN MATCH_MP_TAC ROOT_POS_UNIQ THEN
1729   ASM_SIMP_TAC[REAL_POW_MUL; ROOT_POW_POS; REAL_LE_MUL;
1730                ROOT_POS_POSITIVE]);;
1731
1732 let ROOT_INV = prove
1733  (`!n x. &0 <= x ==> (root(SUC n) (inv x) = inv(root(SUC n) x))`,
1734   REPEAT STRIP_TAC THEN MATCH_MP_TAC ROOT_POS_UNIQ THEN
1735   ASM_SIMP_TAC[REAL_LE_INV; ROOT_POS_POSITIVE; REAL_POW_INV;
1736                ROOT_POW_POS]);;
1737
1738 let ROOT_DIV = prove
1739  (`!n x y. &0 <= x /\ &0 <= y
1740            ==> (root(SUC n) (x / y) = root(SUC n) x / root(SUC n) y)`,
1741   SIMP_TAC[real_div; ROOT_MUL; ROOT_INV; REAL_LE_INV]);;
1742
1743 let ROOT_MONO_LT = prove
1744  (`!x y. &0 <= x /\ x < y ==> root(SUC n) x < root(SUC n) y`,
1745   REPEAT STRIP_TAC THEN SUBGOAL_THEN `&0 <= y` ASSUME_TAC THENL
1746    [ASM_MESON_TAC[REAL_LE_TRANS; REAL_LT_IMP_LE]; ALL_TAC] THEN
1747   UNDISCH_TAC `x < y` THEN CONV_TAC CONTRAPOS_CONV THEN
1748   REWRITE_TAC[REAL_NOT_LT] THEN DISCH_TAC THEN
1749   SUBGOAL_THEN `(x = (root(SUC n) x) pow (SUC n)) /\
1750                 (y = (root(SUC n) y) pow (SUC n))`
1751    (CONJUNCTS_THEN SUBST1_TAC)
1752   THENL [ASM_SIMP_TAC[GSYM ROOT_POW_POS]; ALL_TAC] THEN
1753   MATCH_MP_TAC REAL_POW_LE2 THEN
1754   ASM_SIMP_TAC[NOT_SUC; ROOT_POS_POSITIVE]);;
1755
1756 let ROOT_MONO_LE = prove
1757  (`!x y. &0 <= x /\ x <= y ==> root(SUC n) x <= root(SUC n) y`,
1758   MESON_TAC[ROOT_MONO_LT; REAL_LE_LT]);;
1759
1760 let ROOT_MONO_LT_EQ = prove
1761  (`!x y. &0 <= x /\ &0 <= y ==> (root(SUC n) x < root(SUC n) y <=> x < y)`,
1762   MESON_TAC[ROOT_MONO_LT; REAL_NOT_LT; ROOT_MONO_LE]);;
1763
1764 let ROOT_MONO_LE_EQ = prove
1765  (`!x y. &0 <= x /\ &0 <= y ==> (root(SUC n) x <= root(SUC n) y <=> x <= y)`,
1766   MESON_TAC[ROOT_MONO_LT; REAL_NOT_LT; ROOT_MONO_LE]);;
1767
1768 let ROOT_INJ = prove
1769  (`!x y. &0 <= x /\ &0 <= y ==> ((root(SUC n) x = root(SUC n) y) <=> (x = y))`,
1770   SIMP_TAC[GSYM REAL_LE_ANTISYM; ROOT_MONO_LE_EQ]);;
1771
1772 (* ------------------------------------------------------------------------- *)
1773 (* Special case of square roots.                                             *)
1774 (* ------------------------------------------------------------------------- *)
1775
1776 let SQRT_0 = prove(
1777   `sqrt(&0) = &0`,
1778   REWRITE_TAC[sqrt; num_CONV `2`; ROOT_0]);;
1779
1780 let SQRT_1 = prove(
1781   `sqrt(&1) = &1`,
1782   REWRITE_TAC[sqrt; num_CONV `2`; ROOT_1]);;
1783
1784 let SQRT_POS_LT = prove
1785  (`!x. &0 < x ==> &0 < sqrt(x)`,
1786   SIMP_TAC[sqrt; num_CONV `2`; ROOT_LN; REAL_EXP_POS_LT]);;
1787
1788 let SQRT_POS_LE = prove
1789  (`!x. &0 <= x ==> &0 <= sqrt(x)`,
1790   REWRITE_TAC[REAL_LE_LT] THEN MESON_TAC[SQRT_POS_LT; SQRT_0]);;
1791
1792 let SQRT_POW2 = prove(
1793   `!x. (sqrt(x) pow 2 = x) <=> &0 <= x`,
1794   GEN_TAC THEN EQ_TAC THENL
1795    [DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_ACCEPT_TAC REAL_LE_SQUARE_POW;
1796     REWRITE_TAC[sqrt; num_CONV `2`; ROOT_POW_POS]]);;
1797
1798 let SQRT_POW_2 = prove
1799  (`!x. &0 <= x ==> (sqrt(x) pow 2 = x)`,
1800   REWRITE_TAC[SQRT_POW2]);;
1801
1802 let POW_2_SQRT = prove
1803  (`&0 <= x ==> (sqrt(x pow 2) = x)`,
1804   SIMP_TAC[sqrt; num_CONV `2`; POW_ROOT_POS]);;
1805
1806 let SQRT_POS_UNIQ = prove
1807  (`!x y. &0 <= x /\ &0 <= y /\ (y pow 2 = x)
1808            ==> (sqrt x = y)`,
1809   REWRITE_TAC[sqrt; num_CONV `2`; ROOT_POS_UNIQ]);;
1810
1811 let SQRT_MUL = prove
1812  (`!x y. &0 <= x /\ &0 <= y
1813            ==> (sqrt(x * y) = sqrt x * sqrt y)`,
1814   REWRITE_TAC[sqrt; num_CONV `2`; ROOT_MUL]);;
1815
1816 let SQRT_INV = prove
1817  (`!x. &0 <= x ==> (sqrt (inv x) = inv(sqrt x))`,
1818   REWRITE_TAC[sqrt; num_CONV `2`; ROOT_INV]);;
1819
1820 let SQRT_DIV = prove
1821  (`!x y. &0 <= x /\ &0 <= y
1822            ==> (sqrt (x / y) = sqrt x / sqrt y)`,
1823   REWRITE_TAC[sqrt; num_CONV `2`; ROOT_DIV]);;
1824
1825 let SQRT_MONO_LT = prove
1826  (`!x y. &0 <= x /\ x < y ==> sqrt(x) < sqrt(y)`,
1827   REWRITE_TAC[sqrt; num_CONV `2`; ROOT_MONO_LT]);;
1828
1829 let SQRT_MONO_LE = prove
1830  (`!x y. &0 <= x /\ x <= y ==> sqrt(x) <= sqrt(y)`,
1831   REWRITE_TAC[sqrt; num_CONV `2`; ROOT_MONO_LE]);;
1832
1833 let SQRT_MONO_LT_EQ = prove
1834  (`!x y. &0 <= x /\ &0 <= y ==> (sqrt(x) < sqrt(y) <=> x < y)`,
1835   REWRITE_TAC[sqrt; num_CONV `2`; ROOT_MONO_LT_EQ]);;
1836
1837 let SQRT_MONO_LE_EQ = prove
1838  (`!x y. &0 <= x /\ &0 <= y ==> (sqrt(x) <= sqrt(y) <=> x <= y)`,
1839   REWRITE_TAC[sqrt; num_CONV `2`; ROOT_MONO_LE_EQ]);;
1840
1841 let SQRT_INJ = prove
1842  (`!x y. &0 <= x /\ &0 <= y ==> ((sqrt(x) = sqrt(y)) <=> (x = y))`,
1843   REWRITE_TAC[sqrt; num_CONV `2`; ROOT_INJ]);;
1844
1845 let SQRT_EVEN_POW2 = prove
1846  (`!n. EVEN n ==> (sqrt(&2 pow n) = &2 pow (n DIV 2))`,
1847   GEN_TAC THEN REWRITE_TAC[EVEN_MOD] THEN DISCH_TAC THEN
1848   MATCH_MP_TAC SQRT_POS_UNIQ THEN
1849   SIMP_TAC[REAL_POW_LE; REAL_POS; REAL_POW_POW] THEN
1850   AP_TERM_TAC THEN
1851   GEN_REWRITE_TAC RAND_CONV [MATCH_MP DIVISION (ARITH_RULE `~(2 = 0)`)] THEN
1852   ASM_REWRITE_TAC[ADD_CLAUSES]);;
1853
1854 let REAL_DIV_SQRT = prove
1855  (`!x. &0 <= x ==> (x / sqrt(x) = sqrt(x))`,
1856   GEN_TAC THEN ASM_CASES_TAC `x = &0` THENL
1857    [ASM_REWRITE_TAC[SQRT_0; real_div; REAL_MUL_LZERO]; ALL_TAC] THEN
1858   DISCH_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SQRT_POS_UNIQ THEN
1859   ASM_SIMP_TAC[SQRT_POS_LE; REAL_LE_DIV] THEN
1860   REWRITE_TAC[real_div; REAL_POW_MUL; REAL_POW_INV] THEN
1861   ASM_SIMP_TAC[SQRT_POW_2] THEN
1862   REWRITE_TAC[REAL_POW_2; GSYM REAL_MUL_ASSOC] THEN
1863   ASM_SIMP_TAC[REAL_MUL_RINV; REAL_MUL_RID]);;
1864
1865 let POW_2_SQRT_ABS = prove
1866  (`!x. sqrt(x pow 2) = abs(x)`,
1867   GEN_TAC THEN DISJ_CASES_TAC(SPEC `x:real` REAL_LE_NEGTOTAL) THENL
1868    [ASM_SIMP_TAC[real_abs; POW_2_SQRT];
1869     SUBST1_TAC(SYM(SPEC `x:real` REAL_NEG_NEG)) THEN
1870     ONCE_REWRITE_TAC[REAL_ABS_NEG; REAL_POW_NEG] THEN
1871     ASM_SIMP_TAC[POW_2_SQRT; real_abs; ARITH_EVEN]]);;
1872
1873 let SQRT_EQ_0 = prove
1874  (`!x. &0 <= x ==> ((sqrt x = &0) <=> (x = &0))`,
1875   MESON_TAC[SQRT_INJ; SQRT_0; REAL_LE_REFL]);;
1876
1877 let REAL_LE_LSQRT = prove
1878  (`!x y. &0 <= x /\ &0 <= y /\ x <= y pow 2 ==> sqrt(x) <= y`,
1879   MESON_TAC[SQRT_MONO_LE; REAL_POW_LE; POW_2_SQRT]);;
1880
1881 let REAL_LE_POW_2 = prove
1882  (`!x. &0 <= x pow 2`,
1883   REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE]);;
1884
1885 let REAL_LE_RSQRT = prove
1886  (`!x y. x pow 2 <= y ==> x <= sqrt(y)`,
1887   MESON_TAC[REAL_LE_TOTAL; SQRT_MONO_LE; SQRT_POS_LE;
1888             REAL_LE_POW_2; REAL_LE_TRANS; POW_2_SQRT]);;
1889
1890 (* ------------------------------------------------------------------------- *)
1891 (* Derivative of sqrt (could do the other roots with a bit more care).       *)
1892 (* ------------------------------------------------------------------------- *)
1893
1894 let DIFF_SQRT = prove
1895  (`!x. &0 < x ==> (sqrt diffl inv(&2 * sqrt(x))) x`,
1896   REPEAT STRIP_TAC THEN
1897   MP_TAC(SPECL [`\x. x pow 2`; `sqrt`; `&2 * sqrt(x)`; `sqrt(x)`; `sqrt(x)`]
1898         DIFF_INVERSE_LT) THEN
1899   ASM_SIMP_TAC[SQRT_POW_2; REAL_LT_IMP_LE; BETA_THM] THEN
1900   DISCH_THEN MATCH_MP_TAC THEN
1901   ASM_SIMP_TAC[SQRT_POS_LT; REAL_LT_IMP_NZ; REAL_ENTIRE] THEN
1902   REWRITE_TAC[REAL_OF_NUM_EQ; ARITH_EQ] THEN REPEAT CONJ_TAC THENL
1903    [ASM_MESON_TAC[POW_2_SQRT; REAL_ARITH `abs(x - y) < y ==> &0 <= x`];
1904     REPEAT STRIP_TAC THEN CONV_TAC CONTINUOUS_CONV;
1905     DIFF_TAC THEN REWRITE_TAC[ARITH; REAL_POW_1; REAL_MUL_RID]]);;
1906
1907 let DIFF_SQRT_COMPOSITE = prove
1908  (`!g m x. (g diffl m)(x) /\ &0 < g x
1909            ==> ((\x. sqrt(g x)) diffl (inv(&2 * sqrt(g x)) * m))(x)`,
1910   SIMP_TAC[DIFF_CHAIN; DIFF_SQRT]) in
1911 add_to_diff_net (SPEC_ALL DIFF_SQRT_COMPOSITE);;
1912
1913 (* ------------------------------------------------------------------------ *)
1914 (* Basic properties of the trig functions                                   *)
1915 (* ------------------------------------------------------------------------ *)
1916
1917 let SIN_0 = prove(
1918   `sin(&0) = &0`,
1919   REWRITE_TAC[sin] THEN CONV_TAC SYM_CONV THEN
1920   MATCH_MP_TAC SUM_UNIQ THEN BETA_TAC THEN
1921   W(MP_TAC o C SPEC SER_0 o rand o rator o snd) THEN
1922   DISCH_THEN(MP_TAC o SPEC `0`) THEN REWRITE_TAC[LE_0] THEN
1923   BETA_TAC THEN
1924   REWRITE_TAC[sum] THEN DISCH_THEN MATCH_MP_TAC THEN
1925   X_GEN_TAC `n:num` THEN COND_CASES_TAC THEN
1926   ASM_REWRITE_TAC[REAL_MUL_LZERO] THEN
1927   MP_TAC(SPEC `n:num` ODD_EXISTS) THEN ASM_REWRITE_TAC[GSYM NOT_EVEN] THEN
1928   DISCH_THEN(CHOOSE_THEN SUBST1_TAC) THEN
1929   REWRITE_TAC[GSYM ADD1; POW_0; REAL_MUL_RZERO]);;
1930
1931 let COS_0 = prove(
1932   `cos(&0) = &1`,
1933   REWRITE_TAC[cos] THEN CONV_TAC SYM_CONV THEN
1934   MATCH_MP_TAC SUM_UNIQ THEN BETA_TAC THEN
1935   W(MP_TAC o C SPEC SER_0 o rand o rator o snd) THEN
1936   DISCH_THEN(MP_TAC o SPEC `1`) THEN
1937   REWRITE_TAC[num_CONV `1`; sum; ADD_CLAUSES] THEN BETA_TAC THEN
1938   REWRITE_TAC[EVEN; pow; FACT] THEN
1939   REWRITE_TAC[REAL_ADD_LID; REAL_MUL_RID] THEN
1940   SUBGOAL_THEN `0 DIV 2 = 0` SUBST1_TAC THENL
1941    [MATCH_MP_TAC DIV_UNIQ THEN EXISTS_TAC `0` THEN
1942     REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES] THEN
1943     REWRITE_TAC[num_CONV `2`; LT_0];
1944     REWRITE_TAC[pow]] THEN
1945   SUBGOAL_THEN `&1 / &1 = &(SUC 0)` SUBST1_TAC THENL
1946    [REWRITE_TAC[SYM(num_CONV `1`)] THEN MATCH_MP_TAC REAL_DIV_REFL THEN
1947     MATCH_ACCEPT_TAC REAL_10;
1948     DISCH_THEN MATCH_MP_TAC] THEN
1949   X_GEN_TAC `n:num` THEN REWRITE_TAC[LE_SUC_LT] THEN
1950   DISCH_THEN(CHOOSE_THEN SUBST1_TAC o MATCH_MP LESS_ADD_1) THEN
1951   REWRITE_TAC[GSYM ADD1; POW_0; REAL_MUL_RZERO; ADD_CLAUSES]);;
1952
1953 let SIN_CIRCLE = prove(
1954   `!x. (sin(x) pow 2) + (cos(x) pow 2) = &1`,
1955   GEN_TAC THEN CONV_TAC(LAND_CONV(X_BETA_CONV `x:real`)) THEN
1956   SUBGOAL_THEN `&1 = (\x.(sin(x) pow 2) + (cos(x) pow 2))(&0)` SUBST1_TAC THENL
1957    [BETA_TAC THEN REWRITE_TAC[SIN_0; COS_0] THEN
1958     REWRITE_TAC[num_CONV `2`; POW_0] THEN
1959     REWRITE_TAC[pow; POW_1] THEN REWRITE_TAC[REAL_ADD_LID; REAL_MUL_LID];
1960     MATCH_MP_TAC DIFF_ISCONST_ALL THEN X_GEN_TAC `x:real` THEN
1961     W(MP_TAC o DIFF_CONV o rand o funpow 2 rator o snd) THEN
1962     DISCH_THEN(MP_TAC o SPEC `x:real`) THEN
1963     MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN
1964     AP_TERM_TAC THEN REWRITE_TAC[GSYM REAL_NEG_LMUL; GSYM REAL_NEG_RMUL] THEN
1965     REWRITE_TAC[GSYM real_sub; REAL_SUB_0] THEN
1966     REWRITE_TAC[GSYM REAL_MUL_ASSOC; REAL_MUL_RID] THEN
1967     AP_TERM_TAC THEN REWRITE_TAC[num_CONV `2`; SUC_SUB1] THEN
1968     REWRITE_TAC[POW_1] THEN MATCH_ACCEPT_TAC REAL_MUL_SYM]);;
1969
1970 let SIN_BOUND = prove(
1971   `!x. abs(sin x) <= &1`,
1972   GEN_TAC THEN GEN_REWRITE_TAC I [TAUT `a <=> ~ ~a`] THEN
1973   PURE_ONCE_REWRITE_TAC[REAL_NOT_LE] THEN
1974   DISCH_THEN(MP_TAC o MATCH_MP REAL_LT1_POW2) THEN
1975   REWRITE_TAC[REAL_POW2_ABS] THEN
1976   DISCH_THEN(MP_TAC o ONCE_REWRITE_RULE[GSYM REAL_SUB_LT]) THEN
1977   DISCH_THEN(MP_TAC o C CONJ(SPEC `cos(x)` REAL_LE_SQUARE)) THEN
1978   REWRITE_TAC[GSYM POW_2] THEN
1979   DISCH_THEN(MP_TAC o MATCH_MP REAL_LTE_ADD) THEN
1980   REWRITE_TAC[real_sub; GSYM REAL_ADD_ASSOC] THEN
1981   ONCE_REWRITE_TAC[AC REAL_ADD_AC
1982     `a + b + c = (a + c) + b`] THEN
1983   REWRITE_TAC[SIN_CIRCLE; REAL_ADD_RINV; REAL_LT_REFL]);;
1984
1985 let SIN_BOUNDS = prove(
1986   `!x. --(&1) <= sin(x) /\ sin(x) <= &1`,
1987   GEN_TAC THEN REWRITE_TAC[GSYM ABS_BOUNDS; SIN_BOUND]);;
1988
1989 let COS_BOUND = prove(
1990   `!x. abs(cos x) <= &1`,
1991   GEN_TAC THEN GEN_REWRITE_TAC I [TAUT `a <=> ~ ~a`] THEN
1992   PURE_ONCE_REWRITE_TAC[REAL_NOT_LE] THEN
1993   DISCH_THEN(MP_TAC o MATCH_MP REAL_LT1_POW2) THEN
1994   REWRITE_TAC[REAL_POW2_ABS] THEN
1995   DISCH_THEN(MP_TAC o ONCE_REWRITE_RULE[GSYM REAL_SUB_LT]) THEN
1996   DISCH_THEN(MP_TAC o CONJ(SPEC `sin(x)` REAL_LE_SQUARE)) THEN
1997   REWRITE_TAC[GSYM POW_2] THEN
1998   DISCH_THEN(MP_TAC o MATCH_MP REAL_LET_ADD) THEN
1999   REWRITE_TAC[real_sub; REAL_ADD_ASSOC; SIN_CIRCLE;
2000     REAL_ADD_ASSOC; SIN_CIRCLE; REAL_ADD_RINV; REAL_LT_REFL]);;
2001
2002 let COS_BOUNDS = prove(
2003   `!x. --(&1) <= cos(x) /\ cos(x) <= &1`,
2004   GEN_TAC THEN REWRITE_TAC[GSYM ABS_BOUNDS; COS_BOUND]);;
2005
2006 let SIN_COS_ADD = prove(
2007   `!x y. ((sin(x + y) - ((sin(x) * cos(y)) + (cos(x) * sin(y)))) pow 2) +
2008          ((cos(x + y) - ((cos(x) * cos(y)) - (sin(x) * sin(y)))) pow 2) = &0`,
2009   REPEAT GEN_TAC THEN
2010   CONV_TAC(LAND_CONV(X_BETA_CONV `x:real`)) THEN
2011   W(C SUBGOAL_THEN (SUBST1_TAC o SYM) o subst[`&0`,`x:real`] o snd) THENL
2012    [BETA_TAC THEN REWRITE_TAC[SIN_0; COS_0] THEN
2013     REWRITE_TAC[REAL_ADD_LID; REAL_MUL_LZERO; REAL_MUL_LID] THEN
2014     REWRITE_TAC[REAL_SUB_RZERO; REAL_SUB_REFL] THEN
2015     REWRITE_TAC[num_CONV `2`; POW_0; REAL_ADD_LID];
2016     MATCH_MP_TAC DIFF_ISCONST_ALL THEN GEN_TAC THEN
2017     W(MP_TAC o DIFF_CONV o rand o funpow 2 rator o snd) THEN
2018     NUM_REDUCE_TAC THEN REWRITE_TAC[POW_1] THEN
2019     REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_RID; REAL_MUL_RID] THEN
2020     DISCH_THEN(MP_TAC o SPEC `x:real`) THEN
2021     MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN
2022     AP_TERM_TAC THEN REWRITE_TAC[GSYM REAL_NEG_LMUL] THEN
2023     ONCE_REWRITE_TAC[GSYM REAL_EQ_SUB_LADD] THEN
2024     REWRITE_TAC[REAL_SUB_LZERO; GSYM REAL_MUL_ASSOC] THEN
2025     REWRITE_TAC[REAL_NEG_RMUL] THEN AP_TERM_TAC THEN
2026     GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN BINOP_TAC THENL
2027      [REWRITE_TAC[real_sub; REAL_NEG_ADD; REAL_NEGNEG; REAL_NEG_RMUL];
2028       REWRITE_TAC[GSYM REAL_NEG_RMUL; GSYM real_sub]]]);;
2029
2030 let SIN_COS_NEG = prove(
2031   `!x. ((sin(--x) + (sin x)) pow 2) +
2032        ((cos(--x) - (cos x)) pow 2) = &0`,
2033   GEN_TAC THEN CONV_TAC(LAND_CONV(X_BETA_CONV `x:real`)) THEN
2034   W(C SUBGOAL_THEN (SUBST1_TAC o SYM) o subst[`&0`,`x:real`] o snd) THENL
2035    [BETA_TAC THEN REWRITE_TAC[SIN_0; COS_0; REAL_NEG_0] THEN
2036     REWRITE_TAC[REAL_ADD_LID; REAL_SUB_REFL] THEN
2037     REWRITE_TAC[num_CONV `2`; POW_0; REAL_ADD_LID];
2038     MATCH_MP_TAC DIFF_ISCONST_ALL THEN GEN_TAC THEN
2039     W(MP_TAC o DIFF_CONV o rand o funpow 2 rator o snd) THEN
2040     NUM_REDUCE_TAC THEN REWRITE_TAC[POW_1] THEN
2041     DISCH_THEN(MP_TAC o SPEC `x:real`) THEN
2042     MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN
2043     AP_TERM_TAC THEN REWRITE_TAC[GSYM REAL_NEG_RMUL] THEN
2044     REWRITE_TAC[REAL_MUL_RID; real_sub; REAL_NEGNEG; GSYM REAL_MUL_ASSOC] THEN
2045     ONCE_REWRITE_TAC[GSYM REAL_EQ_SUB_LADD] THEN
2046     REWRITE_TAC[REAL_SUB_LZERO; REAL_NEG_RMUL] THEN AP_TERM_TAC THEN
2047     GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN
2048     REWRITE_TAC[GSYM REAL_NEG_LMUL; REAL_NEG_RMUL] THEN AP_TERM_TAC THEN
2049     REWRITE_TAC[REAL_NEG_ADD; REAL_NEGNEG]]);;
2050
2051 let SIN_ADD = prove(
2052   `!x y. sin(x + y) = (sin(x) * cos(y)) + (cos(x) * sin(y))`,
2053   REPEAT GEN_TAC THEN MP_TAC(SPECL [`x:real`; `y:real`] SIN_COS_ADD) THEN
2054   REWRITE_TAC[POW_2; REAL_SUMSQ] THEN REWRITE_TAC[REAL_SUB_0] THEN
2055   DISCH_THEN(fun th -> REWRITE_TAC[th]));;
2056
2057 let COS_ADD = prove(
2058   `!x y. cos(x + y) = (cos(x) * cos(y)) - (sin(x) * sin(y))`,
2059   REPEAT GEN_TAC THEN MP_TAC(SPECL [`x:real`; `y:real`] SIN_COS_ADD) THEN
2060   REWRITE_TAC[POW_2; REAL_SUMSQ] THEN REWRITE_TAC[REAL_SUB_0] THEN
2061   DISCH_THEN(fun th -> REWRITE_TAC[th]));;
2062
2063 let SIN_NEG = prove(
2064   `!x. sin(--x) = --(sin(x))`,
2065   GEN_TAC THEN MP_TAC(SPEC `x:real` SIN_COS_NEG) THEN
2066   REWRITE_TAC[POW_2; REAL_SUMSQ] THEN REWRITE_TAC[REAL_LNEG_UNIQ] THEN
2067   DISCH_THEN(fun th -> REWRITE_TAC[th]));;
2068
2069 let COS_NEG = prove(
2070   `!x. cos(--x) = cos(x)`,
2071   GEN_TAC THEN MP_TAC(SPEC `x:real` SIN_COS_NEG) THEN
2072   REWRITE_TAC[POW_2; REAL_SUMSQ] THEN REWRITE_TAC[REAL_SUB_0] THEN
2073   DISCH_THEN(fun th -> REWRITE_TAC[th]));;
2074
2075 let SIN_DOUBLE = prove(
2076   `!x. sin(&2 * x) = &2 * sin(x) * cos(x)`,
2077   GEN_TAC THEN REWRITE_TAC[GSYM REAL_DOUBLE; SIN_ADD] THEN
2078   AP_TERM_TAC THEN MATCH_ACCEPT_TAC REAL_MUL_SYM);;
2079
2080 let COS_DOUBLE = prove(
2081   `!x. cos(&2 * x) = (cos(x) pow 2) - (sin(x) pow 2)`,
2082   GEN_TAC THEN REWRITE_TAC[GSYM REAL_DOUBLE; COS_ADD; POW_2]);;
2083
2084 let COS_ABS = prove
2085  (`!x. cos(abs x) = cos(x)`,
2086   GEN_TAC THEN REWRITE_TAC[real_abs] THEN
2087   COND_CASES_TAC THEN REWRITE_TAC[COS_NEG]);;
2088
2089 (* ------------------------------------------------------------------------ *)
2090 (* Show that there's a least positive x with cos(x) = 0; hence define pi    *)
2091 (* ------------------------------------------------------------------------ *)
2092
2093 let SIN_PAIRED = prove(
2094   `!x. (\n. (((--(&1)) pow n) / &(FACT((2 * n) + 1)))
2095          * (x pow ((2 * n) + 1))) sums (sin x)`,
2096   GEN_TAC THEN MP_TAC(SPEC `x:real` SIN_CONVERGES) THEN
2097   DISCH_THEN(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN
2098   DISCH_THEN(MP_TAC o MATCH_MP SER_PAIR) THEN REWRITE_TAC[GSYM sin] THEN
2099   BETA_TAC THEN REWRITE_TAC[SUM_2] THEN BETA_TAC THEN
2100   REWRITE_TAC[GSYM ADD1; EVEN_DOUBLE;
2101               REWRITE_RULE[GSYM NOT_EVEN] ODD_DOUBLE] THEN
2102   REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_LID; SUC_SUB1; MULT_DIV_2]);;
2103
2104 let SIN_POS = prove(
2105   `!x. &0 < x /\ x < &2 ==> &0 < sin(x)`,
2106   GEN_TAC THEN STRIP_TAC THEN MP_TAC(SPEC `x:real` SIN_PAIRED) THEN
2107   DISCH_THEN(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN
2108   DISCH_THEN(MP_TAC o MATCH_MP SER_PAIR) THEN
2109   REWRITE_TAC[SYM(MATCH_MP SUM_UNIQ (SPEC `x:real` SIN_PAIRED))] THEN
2110   REWRITE_TAC[SUM_2] THEN BETA_TAC THEN REWRITE_TAC[GSYM ADD1] THEN
2111   REWRITE_TAC[pow; GSYM REAL_NEG_MINUS1; POW_MINUS1] THEN
2112   REWRITE_TAC[real_div; GSYM REAL_NEG_LMUL; GSYM real_sub] THEN
2113   REWRITE_TAC[REAL_MUL_LID] THEN REWRITE_TAC[ADD1] THEN DISCH_TAC THEN
2114   FIRST_ASSUM(SUBST1_TAC o MATCH_MP SUM_UNIQ) THEN
2115   W(C SUBGOAL_THEN SUBST1_TAC o curry mk_eq `&0` o curry mk_comb `sum(0,0)` o
2116   funpow 2 rand o snd) THENL [REWRITE_TAC[sum]; ALL_TAC] THEN
2117   MATCH_MP_TAC SER_POS_LT THEN
2118   FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP SUM_SUMMABLE th]) THEN
2119   X_GEN_TAC `n:num` THEN DISCH_THEN(K ALL_TAC) THEN BETA_TAC THEN
2120   REWRITE_TAC[GSYM ADD1; MULT_CLAUSES] THEN
2121   REWRITE_TAC[num_CONV `2`; ADD_CLAUSES; pow; FACT; GSYM REAL_MUL] THEN
2122   REWRITE_TAC[SYM(num_CONV `2`)] THEN
2123   REWRITE_TAC[num_CONV `1`; ADD_CLAUSES; pow; FACT; GSYM REAL_MUL] THEN
2124   REWRITE_TAC[REAL_SUB_LT] THEN ONCE_REWRITE_TAC[GSYM pow] THEN
2125   REWRITE_TAC[REAL_MUL_ASSOC] THEN
2126   MATCH_MP_TAC REAL_LT_RMUL_IMP THEN CONJ_TAC THENL
2127    [ALL_TAC; MATCH_MP_TAC POW_POS_LT THEN ASM_REWRITE_TAC[]] THEN
2128   REWRITE_TAC[GSYM REAL_MUL_ASSOC; GSYM POW_2] THEN
2129   SUBGOAL_THEN `!n. &0 < &(SUC n)` ASSUME_TAC THENL
2130    [GEN_TAC THEN REWRITE_TAC[REAL_LT; LT_0]; ALL_TAC] THEN
2131   SUBGOAL_THEN `!n. &0 < &(FACT n)` ASSUME_TAC THENL
2132    [GEN_TAC THEN REWRITE_TAC[REAL_LT; FACT_LT]; ALL_TAC] THEN
2133   SUBGOAL_THEN `!n. ~(&(SUC n) = &0)` ASSUME_TAC THENL
2134    [GEN_TAC THEN REWRITE_TAC[REAL_INJ; NOT_SUC]; ALL_TAC] THEN
2135   SUBGOAL_THEN `!n. ~(&(FACT n) = &0)` ASSUME_TAC THENL
2136    [GEN_TAC THEN MATCH_MP_TAC REAL_POS_NZ THEN
2137     REWRITE_TAC[REAL_LT; FACT_LT]; ALL_TAC] THEN
2138   REPEAT(IMP_SUBST_TAC REAL_INV_MUL_WEAK THEN ASM_REWRITE_TAC[REAL_ENTIRE]) THEN
2139   REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN
2140   ONCE_REWRITE_TAC[AC REAL_MUL_AC
2141     `a * b * c * d * e = (a * b * e) * (c * d)`] THEN
2142   GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN
2143   MATCH_MP_TAC REAL_LT_RMUL_IMP THEN CONJ_TAC THENL
2144    [ALL_TAC; MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC THEN
2145     MATCH_MP_TAC REAL_INV_POS THEN ASM_REWRITE_TAC[]] THEN
2146   REWRITE_TAC[REAL_MUL_ASSOC] THEN
2147   IMP_SUBST_TAC ((CONV_RULE(RAND_CONV SYM_CONV) o SPEC_ALL) REAL_INV_MUL_WEAK) THEN
2148   ASM_REWRITE_TAC[REAL_ENTIRE] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
2149   REWRITE_TAC[GSYM real_div] THEN MATCH_MP_TAC REAL_LT_1 THEN
2150   REWRITE_TAC[POW_2] THEN CONJ_TAC THENL
2151    [MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC;
2152     MATCH_MP_TAC REAL_LT_MUL2_ALT THEN REPEAT CONJ_TAC] THEN
2153   TRY(MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[] THEN NO_TAC) THENL
2154    [W((then_) (MATCH_MP_TAC REAL_LT_TRANS) o EXISTS_TAC o
2155       curry mk_comb `&` o funpow 3 rand o snd) THEN
2156     REWRITE_TAC[REAL_LT; LESS_SUC_REFL]; ALL_TAC] THEN
2157   MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&2` THEN
2158   ASM_REWRITE_TAC[] THEN CONV_TAC(REDEPTH_CONV num_CONV) THEN
2159   REWRITE_TAC[REAL_LE; LE_SUC; LE_0]);;
2160
2161 let COS_PAIRED = prove(
2162   `!x. (\n. (((--(&1)) pow n) / &(FACT(2 * n)))
2163          * (x pow (2 * n))) sums (cos x)`,
2164   GEN_TAC THEN MP_TAC(SPEC `x:real` COS_CONVERGES) THEN
2165   DISCH_THEN(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN
2166   DISCH_THEN(MP_TAC o MATCH_MP SER_PAIR) THEN REWRITE_TAC[GSYM cos] THEN
2167   BETA_TAC THEN REWRITE_TAC[SUM_2] THEN BETA_TAC THEN
2168   REWRITE_TAC[GSYM ADD1; EVEN_DOUBLE;
2169               REWRITE_RULE[GSYM NOT_EVEN] ODD_DOUBLE] THEN
2170   REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_RID; MULT_DIV_2]);;
2171
2172 let COS_2 = prove(
2173   `cos(&2) < &0`,
2174   GEN_REWRITE_TAC LAND_CONV [GSYM REAL_NEGNEG] THEN
2175   REWRITE_TAC[REAL_NEG_LT0] THEN MP_TAC(SPEC `&2` COS_PAIRED) THEN
2176   DISCH_THEN(MP_TAC o MATCH_MP SER_NEG) THEN BETA_TAC THEN
2177   DISCH_TAC THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP SUM_UNIQ) THEN
2178   MATCH_MP_TAC REAL_LT_TRANS THEN
2179   EXISTS_TAC `sum(0,3) (\n. --((((--(&1)) pow n) / &(FACT(2 * n)))
2180                 * (&2 pow (2 * n))))` THEN CONJ_TAC THENL
2181    [REWRITE_TAC[num_CONV `3`; sum; SUM_2] THEN BETA_TAC THEN
2182     REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES; pow; FACT] THEN
2183     REWRITE_TAC[REAL_MUL_RID; POW_1; POW_2; GSYM REAL_NEG_RMUL] THEN
2184     IMP_SUBST_TAC REAL_DIV_REFL THEN REWRITE_TAC[REAL_NEGNEG; REAL_10] THEN
2185     NUM_REDUCE_TAC THEN REWRITE_TAC[num_CONV `4`; num_CONV `3`; FACT; pow] THEN
2186     REWRITE_TAC[SYM(num_CONV `4`); SYM(num_CONV `3`)] THEN
2187     REWRITE_TAC[num_CONV `2`; num_CONV `1`; FACT; pow] THEN
2188     REWRITE_TAC[SYM(num_CONV `1`); SYM(num_CONV `2`)] THEN
2189     REWRITE_TAC[REAL_MUL] THEN NUM_REDUCE_TAC THEN
2190     REWRITE_TAC[real_div; REAL_NEG_LMUL; REAL_NEGNEG; REAL_MUL_LID] THEN
2191     REWRITE_TAC[GSYM REAL_NEG_LMUL; REAL_ADD_ASSOC] THEN
2192     REWRITE_TAC[GSYM real_sub; REAL_SUB_LT] THEN
2193     SUBGOAL_THEN `inv(&2) * &4 = &1 + &1` SUBST1_TAC THENL
2194      [MATCH_MP_TAC REAL_EQ_LMUL_IMP THEN EXISTS_TAC `&2` THEN
2195       REWRITE_TAC[REAL_INJ] THEN NUM_REDUCE_TAC THEN
2196       REWRITE_TAC[REAL_ADD; REAL_MUL] THEN NUM_REDUCE_TAC THEN
2197       REWRITE_TAC[REAL_MUL_ASSOC] THEN
2198       SUBGOAL_THEN `&2 * inv(&2) = &1` SUBST1_TAC THEN
2199       REWRITE_TAC[REAL_MUL_LID] THEN MATCH_MP_TAC REAL_MUL_RINV THEN
2200       REWRITE_TAC[REAL_INJ] THEN NUM_REDUCE_TAC;
2201       REWRITE_TAC[REAL_MUL_LID; REAL_ADD_ASSOC] THEN
2202       REWRITE_TAC[REAL_ADD_LINV; REAL_ADD_LID] THEN
2203       ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN
2204       MATCH_MP_TAC REAL_LT_1 THEN REWRITE_TAC[REAL_LE; REAL_LT] THEN
2205       NUM_REDUCE_TAC]; ALL_TAC] THEN
2206   MATCH_MP_TAC SER_POS_LT_PAIR THEN
2207   FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP SUM_SUMMABLE th]) THEN
2208   X_GEN_TAC `d:num` THEN BETA_TAC THEN
2209   REWRITE_TAC[POW_ADD; POW_MINUS1; REAL_MUL_RID] THEN
2210   REWRITE_TAC[num_CONV `3`; pow] THEN REWRITE_TAC[SYM(num_CONV `3`)] THEN
2211   REWRITE_TAC[POW_2; POW_1] THEN
2212   REWRITE_TAC[GSYM REAL_NEG_MINUS1; REAL_NEGNEG] THEN
2213   REWRITE_TAC[real_div; GSYM REAL_NEG_LMUL; GSYM REAL_NEG_RMUL] THEN
2214   REWRITE_TAC[REAL_MUL_LID; REAL_NEGNEG] THEN
2215   REWRITE_TAC[GSYM real_sub; REAL_SUB_LT] THEN
2216   REWRITE_TAC[GSYM ADD1; ADD_CLAUSES; MULT_CLAUSES] THEN
2217   REWRITE_TAC[POW_ADD; REAL_MUL_ASSOC] THEN
2218   MATCH_MP_TAC REAL_LT_RMUL_IMP THEN CONJ_TAC THENL
2219    [ALL_TAC;
2220     REWRITE_TAC[num_CONV `2`; MULT_CLAUSES] THEN
2221     REWRITE_TAC[num_CONV `3`; ADD_CLAUSES] THEN
2222     MATCH_MP_TAC POW_POS_LT THEN REWRITE_TAC[REAL_LT] THEN
2223     NUM_REDUCE_TAC] THEN
2224   REWRITE_TAC[num_CONV `2`; ADD_CLAUSES; FACT] THEN
2225   REWRITE_TAC[SYM(num_CONV `2`)] THEN
2226   REWRITE_TAC[num_CONV `1`; ADD_CLAUSES; FACT] THEN
2227   REWRITE_TAC[SYM(num_CONV `1`)] THEN
2228   SUBGOAL_THEN `!n. &0 < &(SUC n)` ASSUME_TAC THENL
2229    [GEN_TAC THEN REWRITE_TAC[REAL_LT; LT_0]; ALL_TAC] THEN
2230   SUBGOAL_THEN `!n. &0 < &(FACT n)` ASSUME_TAC THENL
2231    [GEN_TAC THEN REWRITE_TAC[REAL_LT; FACT_LT]; ALL_TAC] THEN
2232   SUBGOAL_THEN `!n. ~(&(SUC n) = &0)` ASSUME_TAC THENL
2233    [GEN_TAC THEN REWRITE_TAC[REAL_INJ; NOT_SUC]; ALL_TAC] THEN
2234   SUBGOAL_THEN `!n. ~(&(FACT n) = &0)` ASSUME_TAC THENL
2235    [GEN_TAC THEN MATCH_MP_TAC REAL_POS_NZ THEN
2236     REWRITE_TAC[REAL_LT; FACT_LT]; ALL_TAC] THEN
2237   REWRITE_TAC[GSYM REAL_MUL] THEN
2238   REPEAT(IMP_SUBST_TAC REAL_INV_MUL_WEAK THEN ASM_REWRITE_TAC[REAL_ENTIRE]) THEN
2239   REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN
2240   ONCE_REWRITE_TAC[AC REAL_MUL_AC
2241     `a * b * c * d = (a * b * d) * c`] THEN
2242   GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN
2243   MATCH_MP_TAC REAL_LT_RMUL_IMP THEN CONJ_TAC THENL
2244    [ALL_TAC;
2245     MATCH_MP_TAC REAL_INV_POS THEN REWRITE_TAC[REAL_LT; FACT_LT]] THEN
2246   REWRITE_TAC[REAL_MUL_ASSOC] THEN
2247   IMP_SUBST_TAC ((CONV_RULE(RAND_CONV SYM_CONV) o SPEC_ALL) REAL_INV_MUL_WEAK) THEN
2248   ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
2249   REWRITE_TAC[GSYM real_div] THEN MATCH_MP_TAC REAL_LT_1 THEN
2250   REWRITE_TAC[POW_2; REAL_MUL; REAL_LE; REAL_LT] THEN NUM_REDUCE_TAC THEN
2251   REWRITE_TAC[num_CONV `4`; num_CONV `3`; MULT_CLAUSES; ADD_CLAUSES] THEN
2252   REWRITE_TAC[LT_SUC] THEN
2253   REWRITE_TAC[num_CONV `2`; ADD_CLAUSES; MULT_CLAUSES] THEN
2254   REWRITE_TAC[num_CONV `1`; LT_SUC; LT_0]);;
2255
2256 let COS_ISZERO = prove(
2257   `?!x. &0 <= x /\ x <= &2 /\ (cos x = &0)`,
2258   REWRITE_TAC[EXISTS_UNIQUE_DEF] THEN BETA_TAC THEN
2259   W(C SUBGOAL_THEN ASSUME_TAC o hd o conjuncts o snd) THENL
2260    [MATCH_MP_TAC IVT2 THEN REPEAT CONJ_TAC THENL
2261      [REWRITE_TAC[REAL_LE; LE_0];
2262       MATCH_MP_TAC REAL_LT_IMP_LE THEN ACCEPT_TAC COS_2;
2263       REWRITE_TAC[COS_0; REAL_LE_01];
2264       X_GEN_TAC `x:real` THEN DISCH_THEN(K ALL_TAC) THEN
2265       MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC `--(sin x)` THEN
2266       REWRITE_TAC[DIFF_COS]];
2267     ASM_REWRITE_TAC[] THEN BETA_TAC THEN
2268     MAP_EVERY X_GEN_TAC [`x1:real`; `x2:real`] THEN
2269     GEN_REWRITE_TAC I [TAUT `a <=> ~ ~a`] THEN
2270     PURE_REWRITE_TAC[NOT_IMP] THEN REWRITE_TAC[] THEN STRIP_TAC THEN
2271     MP_TAC(SPECL [`x1:real`; `x2:real`] REAL_LT_TOTAL) THEN
2272     SUBGOAL_THEN `(!x. cos differentiable x) /\
2273                   (!x. cos contl x)` STRIP_ASSUME_TAC THENL
2274      [CONJ_TAC THEN GEN_TAC THENL
2275        [REWRITE_TAC[differentiable]; MATCH_MP_TAC DIFF_CONT] THEN
2276       EXISTS_TAC `--(sin x)` THEN REWRITE_TAC[DIFF_COS]; ALL_TAC] THEN
2277     ASM_REWRITE_TAC[] THEN DISCH_THEN DISJ_CASES_TAC THENL
2278      [MP_TAC(SPECL [`cos`; `x1:real`; `x2:real`] ROLLE);
2279       MP_TAC(SPECL [`cos`; `x2:real`; `x1:real`] ROLLE)] THEN
2280     ASM_REWRITE_TAC[] THEN
2281     DISCH_THEN(X_CHOOSE_THEN `x:real` MP_TAC) THEN REWRITE_TAC[CONJ_ASSOC] THEN
2282     DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN
2283     DISCH_THEN(MP_TAC o CONJ(SPEC `x:real` DIFF_COS)) THEN
2284     DISCH_THEN(MP_TAC o MATCH_MP DIFF_UNIQ) THEN
2285     REWRITE_TAC[REAL_NEG_EQ0] THEN MATCH_MP_TAC REAL_POS_NZ THEN
2286     MATCH_MP_TAC SIN_POS THENL
2287      [CONJ_TAC THENL
2288        [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `x1:real` THEN
2289         ASM_REWRITE_TAC[];
2290         MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `x2:real` THEN
2291         ASM_REWRITE_TAC[]];
2292       CONJ_TAC THENL
2293        [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `x2:real` THEN
2294         ASM_REWRITE_TAC[];
2295         MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `x1:real` THEN
2296         ASM_REWRITE_TAC[]]]]);;
2297
2298 let pi = new_definition
2299   `pi = &2 * @x. &0 <= x /\ x <= &2 /\ (cos x = &0)`;;
2300
2301 (* ------------------------------------------------------------------------ *)
2302 (* Periodicity and related properties of the trig functions                 *)
2303 (* ------------------------------------------------------------------------ *)
2304
2305 let PI2 = prove(
2306   `pi / &2 = @x. &0 <= x /\ x <= &2 /\ (cos(x) = &0)`,
2307   REWRITE_TAC[pi; real_div] THEN
2308   ONCE_REWRITE_TAC[AC REAL_MUL_AC
2309     `(a * b) * c = (c * a) * b`] THEN
2310   IMP_SUBST_TAC REAL_MUL_LINV THEN REWRITE_TAC[REAL_INJ] THEN
2311   NUM_REDUCE_TAC THEN REWRITE_TAC[REAL_MUL_LID]);;
2312
2313 let COS_PI2 = prove(
2314   `cos(pi / &2) = &0`,
2315   MP_TAC(SELECT_RULE (EXISTENCE COS_ISZERO)) THEN
2316   REWRITE_TAC[GSYM PI2] THEN
2317   DISCH_THEN(fun th -> REWRITE_TAC[th]));;
2318
2319 let PI2_BOUNDS = prove(
2320   `&0 < (pi / &2) /\ (pi / &2) < &2`,
2321   MP_TAC(SELECT_RULE (EXISTENCE COS_ISZERO)) THEN
2322   REWRITE_TAC[GSYM PI2] THEN DISCH_TAC THEN
2323   ASM_REWRITE_TAC[REAL_LT_LE] THEN CONJ_TAC THENL
2324    [DISCH_TAC THEN MP_TAC COS_0 THEN ASM_REWRITE_TAC[] THEN
2325     FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[GSYM REAL_10];
2326     DISCH_TAC THEN MP_TAC COS_PI2 THEN FIRST_ASSUM SUBST1_TAC THEN
2327     REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_IMP_NE THEN
2328     MATCH_ACCEPT_TAC COS_2]);;
2329
2330 let PI_POS = prove(
2331   `&0 < pi`,
2332   GEN_REWRITE_TAC RAND_CONV [GSYM REAL_HALF_DOUBLE] THEN
2333   MATCH_MP_TAC REAL_LT_ADD THEN REWRITE_TAC[PI2_BOUNDS]);;
2334
2335 let SIN_PI2 = prove(
2336   `sin(pi / &2) = &1`,
2337   MP_TAC(SPEC `pi / &2` SIN_CIRCLE) THEN
2338   REWRITE_TAC[COS_PI2; POW_2; REAL_MUL_LZERO; REAL_ADD_RID] THEN
2339   GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM REAL_MUL_LID] THEN
2340   ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN
2341   REWRITE_TAC[GSYM REAL_DIFFSQ; REAL_ENTIRE] THEN
2342   DISCH_THEN DISJ_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
2343   POP_ASSUM MP_TAC THEN CONV_TAC CONTRAPOS_CONV THEN DISCH_THEN(K ALL_TAC) THEN
2344   REWRITE_TAC[REAL_LNEG_UNIQ] THEN DISCH_THEN(MP_TAC o AP_TERM `(--)`) THEN
2345   REWRITE_TAC[REAL_NEGNEG] THEN DISCH_TAC THEN
2346   MP_TAC REAL_LT_01 THEN POP_ASSUM(SUBST1_TAC o SYM) THEN
2347   REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_GT THEN
2348   REWRITE_TAC[REAL_NEG_LT0] THEN MATCH_MP_TAC SIN_POS THEN
2349   REWRITE_TAC[PI2_BOUNDS]);;
2350
2351 let COS_PI = prove(
2352   `cos(pi) = --(&1)`,
2353   MP_TAC(SPECL [`pi / &2`; `pi / &2`] COS_ADD) THEN
2354   REWRITE_TAC[SIN_PI2; COS_PI2; REAL_MUL_LZERO; REAL_MUL_LID] THEN
2355   REWRITE_TAC[REAL_SUB_LZERO] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
2356   AP_TERM_TAC THEN REWRITE_TAC[REAL_DOUBLE] THEN
2357   CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_DIV_LMUL THEN
2358   REWRITE_TAC[REAL_INJ] THEN NUM_REDUCE_TAC);;
2359
2360 let SIN_PI = prove(
2361   `sin(pi) = &0`,
2362   MP_TAC(SPECL [`pi / &2`; `pi / &2`] SIN_ADD) THEN
2363   REWRITE_TAC[COS_PI2; REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_ADD_LID] THEN
2364   DISCH_THEN(SUBST1_TAC o SYM) THEN AP_TERM_TAC THEN
2365   REWRITE_TAC[REAL_DOUBLE] THEN CONV_TAC SYM_CONV THEN
2366   MATCH_MP_TAC REAL_DIV_LMUL THEN
2367   REWRITE_TAC[REAL_INJ] THEN NUM_REDUCE_TAC);;
2368
2369 let SIN_COS = prove(
2370   `!x. sin(x) = cos((pi / &2) - x)`,
2371   GEN_TAC THEN REWRITE_TAC[real_sub; COS_ADD] THEN
2372   REWRITE_TAC[SIN_PI2; COS_PI2; REAL_MUL_LZERO] THEN
2373   REWRITE_TAC[REAL_ADD_LID; REAL_MUL_LID] THEN
2374   REWRITE_TAC[SIN_NEG; REAL_NEGNEG]);;
2375
2376 let COS_SIN = prove(
2377   `!x. cos(x) = sin((pi / &2) - x)`,
2378   GEN_TAC THEN REWRITE_TAC[real_sub; SIN_ADD] THEN
2379   REWRITE_TAC[SIN_PI2; COS_PI2; REAL_MUL_LZERO] THEN
2380   REWRITE_TAC[REAL_MUL_LID; REAL_ADD_RID] THEN
2381   REWRITE_TAC[COS_NEG]);;
2382
2383 let SIN_PERIODIC_PI = prove(
2384   `!x. sin(x + pi) = --(sin(x))`,
2385   GEN_TAC THEN REWRITE_TAC[SIN_ADD; SIN_PI; COS_PI] THEN
2386   REWRITE_TAC[REAL_MUL_RZERO; REAL_ADD_RID; GSYM REAL_NEG_RMUL] THEN
2387   REWRITE_TAC[REAL_MUL_RID]);;
2388
2389 let COS_PERIODIC_PI = prove(
2390   `!x. cos(x + pi) = --(cos(x))`,
2391   GEN_TAC THEN REWRITE_TAC[COS_ADD; SIN_PI; COS_PI] THEN
2392   REWRITE_TAC[REAL_MUL_RZERO; REAL_SUB_RZERO; GSYM REAL_NEG_RMUL] THEN
2393   REWRITE_TAC[REAL_MUL_RID]);;
2394
2395 let SIN_PERIODIC = prove(
2396   `!x. sin(x + (&2 * pi)) = sin(x)`,
2397   GEN_TAC THEN REWRITE_TAC[GSYM REAL_DOUBLE; REAL_ADD_ASSOC] THEN
2398   REWRITE_TAC[SIN_PERIODIC_PI; REAL_NEGNEG]);;
2399
2400 let COS_PERIODIC = prove(
2401   `!x. cos(x + (&2 * pi)) = cos(x)`,
2402   GEN_TAC THEN REWRITE_TAC[GSYM REAL_DOUBLE; REAL_ADD_ASSOC] THEN
2403   REWRITE_TAC[COS_PERIODIC_PI; REAL_NEGNEG]);;
2404
2405 let COS_NPI = prove(
2406   `!n. cos(&n * pi) = --(&1) pow n`,
2407   INDUCT_TAC THEN REWRITE_TAC[REAL_MUL_LZERO; COS_0; pow] THEN
2408   REWRITE_TAC[ADD1; GSYM REAL_ADD; REAL_RDISTRIB; COS_ADD] THEN
2409   REWRITE_TAC[REAL_MUL_LID; SIN_PI; REAL_MUL_RZERO; REAL_SUB_RZERO] THEN
2410   ASM_REWRITE_TAC[COS_PI] THEN
2411   MATCH_ACCEPT_TAC REAL_MUL_SYM);;
2412
2413 let SIN_NPI = prove(
2414   `!n. sin(&n * pi) = &0`,
2415   INDUCT_TAC THEN REWRITE_TAC[REAL_MUL_LZERO; SIN_0; pow] THEN
2416   REWRITE_TAC[ADD1; GSYM REAL_ADD; REAL_RDISTRIB; SIN_ADD] THEN
2417   REWRITE_TAC[REAL_MUL_LID; SIN_PI; REAL_MUL_RZERO; REAL_ADD_RID] THEN
2418   ASM_REWRITE_TAC[REAL_MUL_LZERO]);;
2419
2420 let SIN_POS_PI2 = prove(
2421   `!x. &0 < x /\ x < pi / &2 ==> &0 < sin(x)`,
2422   GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC SIN_POS THEN
2423   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_TRANS THEN
2424   EXISTS_TAC `pi / &2` THEN ASM_REWRITE_TAC[PI2_BOUNDS]);;
2425
2426 let COS_POS_PI2 = prove(
2427   `!x. &0 < x /\ x < pi / &2 ==> &0 < cos(x)`,
2428   GEN_TAC THEN STRIP_TAC THEN
2429   GEN_REWRITE_TAC I [TAUT `a <=> ~ ~a`] THEN
2430   PURE_REWRITE_TAC[REAL_NOT_LT] THEN DISCH_TAC THEN
2431   MP_TAC(SPECL [`cos`; `&0`; `x:real`; `&0`] IVT2) THEN
2432   ASM_REWRITE_TAC[COS_0; REAL_LE_01; NOT_IMP] THEN REPEAT CONJ_TAC THENL
2433    [MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[];
2434     X_GEN_TAC `z:real` THEN DISCH_THEN(K ALL_TAC) THEN
2435     MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC `--(sin z)` THEN
2436     REWRITE_TAC[DIFF_COS];
2437     DISCH_THEN(X_CHOOSE_TAC `z:real`) THEN
2438     MP_TAC(CONJUNCT2 (CONV_RULE EXISTS_UNIQUE_CONV COS_ISZERO)) THEN
2439     DISCH_THEN(MP_TAC o SPECL [`z:real`; `pi / &2`]) THEN
2440     ASM_REWRITE_TAC[COS_PI2] THEN REWRITE_TAC[NOT_IMP] THEN
2441     REPEAT CONJ_TAC THENL
2442      [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `x:real` THEN
2443       ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN
2444       EXISTS_TAC `pi / &2` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC;
2445       ALL_TAC;
2446       ALL_TAC;
2447       DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC `x < pi / &2` THEN
2448       ASM_REWRITE_TAC[REAL_NOT_LT]] THEN
2449     MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[PI2_BOUNDS]]);;
2450
2451 let COS_POS_PI = prove(
2452   `!x. --(pi / &2) < x /\ x < pi / &2 ==> &0 < cos(x)`,
2453   GEN_TAC THEN STRIP_TAC THEN
2454   REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC
2455         (SPECL [`x:real`; `&0`] REAL_LT_TOTAL) THENL
2456    [ASM_REWRITE_TAC[COS_0; REAL_LT_01];
2457     ONCE_REWRITE_TAC[GSYM COS_NEG] THEN MATCH_MP_TAC COS_POS_PI2 THEN
2458     ONCE_REWRITE_TAC[GSYM REAL_NEG_LT0] THEN ASM_REWRITE_TAC[REAL_NEGNEG] THEN
2459     ONCE_REWRITE_TAC[GSYM REAL_LT_NEG] THEN ASM_REWRITE_TAC[REAL_NEGNEG];
2460     MATCH_MP_TAC COS_POS_PI2 THEN ASM_REWRITE_TAC[]]);;
2461
2462 let SIN_POS_PI = prove(
2463   `!x. &0 < x /\ x < pi ==> &0 < sin(x)`,
2464   GEN_TAC THEN STRIP_TAC THEN
2465   REWRITE_TAC[SIN_COS] THEN ONCE_REWRITE_TAC[GSYM COS_NEG] THEN
2466   REWRITE_TAC[REAL_NEG_SUB] THEN
2467   MATCH_MP_TAC COS_POS_PI THEN
2468   REWRITE_TAC[REAL_LT_SUB_LADD; REAL_LT_SUB_RADD] THEN
2469   ASM_REWRITE_TAC[REAL_HALF_DOUBLE; REAL_ADD_LINV]);;
2470
2471 let SIN_POS_PI_LE = prove
2472  (`!x. &0 <= x /\ x <= pi ==> &0 <= sin(x)`,
2473   REWRITE_TAC[REAL_LE_LT] THEN
2474   MESON_TAC[SIN_POS_PI; SIN_PI; SIN_0; REAL_LE_REFL]);;
2475
2476 let COS_TOTAL = prove(
2477   `!y. --(&1) <= y /\ y <= &1 ==> ?!x. &0 <= x /\ x <= pi /\ (cos(x) = y)`,
2478   GEN_TAC THEN STRIP_TAC THEN
2479   CONV_TAC EXISTS_UNIQUE_CONV THEN CONJ_TAC THENL
2480    [MATCH_MP_TAC IVT2 THEN ASM_REWRITE_TAC[COS_0; COS_PI] THEN
2481     REWRITE_TAC[MATCH_MP REAL_LT_IMP_LE PI_POS] THEN
2482     GEN_TAC THEN DISCH_THEN(K ALL_TAC) THEN
2483     MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC `--(sin x)` THEN
2484     REWRITE_TAC[DIFF_COS];
2485     MAP_EVERY X_GEN_TAC [`x1:real`; `x2:real`] THEN STRIP_TAC THEN
2486     REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC
2487          (SPECL [`x1:real`; `x2:real`] REAL_LT_TOTAL) THENL
2488      [FIRST_ASSUM ACCEPT_TAC;
2489       MP_TAC(SPECL [`cos`; `x1:real`; `x2:real`] ROLLE);
2490       MP_TAC(SPECL [`cos`; `x2:real`; `x1:real`] ROLLE)]] THEN
2491   ASM_REWRITE_TAC[] THEN
2492   (W(C SUBGOAL_THEN (fun t -> REWRITE_TAC[t]) o funpow 2
2493                     (fst o dest_imp) o snd) THENL
2494     [CONJ_TAC THEN X_GEN_TAC `x:real` THEN DISCH_THEN(K ALL_TAC) THEN
2495      TRY(MATCH_MP_TAC DIFF_CONT) THEN REWRITE_TAC[differentiable] THEN
2496      EXISTS_TAC `--(sin x)` THEN REWRITE_TAC[DIFF_COS]; ALL_TAC]) THEN
2497   DISCH_THEN(X_CHOOSE_THEN `x:real` STRIP_ASSUME_TAC) THEN
2498   UNDISCH_TAC `(cos diffl &0)(x)` THEN
2499   DISCH_THEN(MP_TAC o CONJ (SPEC `x:real` DIFF_COS)) THEN
2500   DISCH_THEN(MP_TAC o MATCH_MP DIFF_UNIQ) THEN
2501   REWRITE_TAC[REAL_NEG_EQ0] THEN DISCH_TAC THEN
2502   MP_TAC(SPEC `x:real` SIN_POS_PI) THEN
2503   ASM_REWRITE_TAC[REAL_LT_REFL] THEN
2504   CONV_TAC CONTRAPOS_CONV THEN DISCH_THEN(K ALL_TAC) THEN
2505   REWRITE_TAC[] THEN CONJ_TAC THENL
2506    [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `x1:real`;
2507     MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `x2:real`;
2508     MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `x2:real`;
2509     MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `x1:real`] THEN
2510   ASM_REWRITE_TAC[]);;
2511
2512 let SIN_TOTAL = prove(
2513   `!y. --(&1) <= y /\ y <= &1 ==>
2514         ?!x.  --(pi / &2) <= x /\ x <= pi / &2 /\ (sin(x) = y)`,
2515   GEN_TAC THEN DISCH_TAC THEN
2516   SUBGOAL_THEN `!x. --(pi / &2) <= x /\ x <= pi / &2 /\ (sin(x) = y) <=>
2517     &0 <= (x + pi / &2) /\ (x + pi / &2) <= pi /\ (cos(x + pi / &2) = --y)`
2518   (fun th -> REWRITE_TAC[th]) THENL
2519    [GEN_TAC THEN REWRITE_TAC[COS_ADD; SIN_PI2; COS_PI2] THEN
2520     REWRITE_TAC[REAL_MUL_RZERO; REAL_MUL_RZERO; REAL_MUL_RID] THEN
2521     REWRITE_TAC[REAL_SUB_LZERO] THEN
2522     REWRITE_TAC[GSYM REAL_LE_SUB_RADD; GSYM REAL_LE_SUB_LADD] THEN
2523     REWRITE_TAC[REAL_SUB_LZERO] THEN AP_TERM_TAC THEN
2524     REWRITE_TAC[REAL_EQ_NEG] THEN AP_THM_TAC THEN
2525     REPEAT AP_TERM_TAC THEN
2526     GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [GSYM REAL_HALF_DOUBLE] THEN
2527     REWRITE_TAC[REAL_ADD_SUB]; ALL_TAC] THEN
2528   MP_TAC(SPEC `--y` COS_TOTAL) THEN ASM_REWRITE_TAC[REAL_LE_NEG] THEN
2529   ONCE_REWRITE_TAC[GSYM REAL_LE_NEG] THEN ASM_REWRITE_TAC[REAL_NEGNEG] THEN
2530   REWRITE_TAC[REAL_LE_NEG] THEN
2531   CONV_TAC(ONCE_DEPTH_CONV EXISTS_UNIQUE_CONV) THEN
2532   DISCH_THEN((then_) CONJ_TAC o MP_TAC) THENL
2533    [DISCH_THEN(X_CHOOSE_TAC `x:real` o CONJUNCT1) THEN
2534     EXISTS_TAC `x - pi / &2` THEN ASM_REWRITE_TAC[REAL_SUB_ADD];
2535     POP_ASSUM(K ALL_TAC) THEN DISCH_THEN(ASSUME_TAC o CONJUNCT2) THEN
2536     REPEAT GEN_TAC THEN
2537     DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN
2538     REWRITE_TAC[REAL_EQ_RADD]]);;
2539
2540 let COS_ZERO_LEMMA = prove(
2541   `!x. &0 <= x /\ (cos(x) = &0) ==>
2542       ?n. ~EVEN n /\ (x = &n * (pi / &2))`,
2543   GEN_TAC THEN STRIP_TAC THEN
2544   MP_TAC(SPEC `x:real` (MATCH_MP REAL_ARCH_LEAST PI_POS)) THEN
2545   ASM_REWRITE_TAC[] THEN
2546   DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN
2547   SUBGOAL_THEN `&0 <= x - &n * pi /\ (x - &n * pi) <= pi /\
2548                 (cos(x - &n * pi) = &0)` ASSUME_TAC THENL
2549    [ASM_REWRITE_TAC[REAL_SUB_LE] THEN
2550     REWRITE_TAC[REAL_LE_SUB_RADD] THEN
2551     REWRITE_TAC[real_sub; COS_ADD; SIN_NEG; COS_NEG; SIN_NPI; COS_NPI] THEN
2552     ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_LID] THEN
2553     REWRITE_TAC[REAL_NEG_RMUL; REAL_NEGNEG; REAL_MUL_RZERO] THEN
2554     MATCH_MP_TAC REAL_LT_IMP_LE THEN UNDISCH_TAC `x < &(SUC n) * pi` THEN
2555     REWRITE_TAC[ADD1] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN
2556     REWRITE_TAC[GSYM REAL_ADD; REAL_RDISTRIB; REAL_MUL_LID];
2557     MP_TAC(SPEC `&0` COS_TOTAL) THEN
2558     REWRITE_TAC[REAL_LE_01; REAL_NEG_LE0] THEN
2559     DISCH_THEN(MP_TAC o CONV_RULE EXISTS_UNIQUE_CONV) THEN
2560     DISCH_THEN(MP_TAC o SPECL [`x - &n * pi`; `pi / &2`] o CONJUNCT2) THEN
2561     ASM_REWRITE_TAC[COS_PI2] THEN
2562     W(C SUBGOAL_THEN MP_TAC o funpow 2 (fst o dest_imp) o snd) THENL
2563      [CONJ_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN MP_TAC PI2_BOUNDS THEN
2564       REWRITE_TAC[REAL_LT_HALF1; REAL_LT_HALF2] THEN DISCH_TAC THEN
2565       ASM_REWRITE_TAC[];
2566       DISCH_THEN(fun th -> REWRITE_TAC[th])] THEN
2567     REWRITE_TAC[REAL_EQ_SUB_RADD] THEN DISCH_TAC THEN
2568     EXISTS_TAC `SUC(2 * n)` THEN
2569     REWRITE_TAC[GSYM NOT_ODD; ODD_DOUBLE] THEN
2570     REWRITE_TAC[ADD1; GSYM REAL_ADD; GSYM REAL_MUL] THEN
2571     REWRITE_TAC[REAL_RDISTRIB; REAL_MUL_LID] THEN
2572     ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN ASM_REWRITE_TAC[] THEN
2573     AP_TERM_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
2574     REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN
2575     CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_DIV_RMUL THEN
2576     REWRITE_TAC[REAL_INJ] THEN NUM_REDUCE_TAC]);;
2577
2578 let SIN_ZERO_LEMMA = prove(
2579   `!x. &0 <= x /\ (sin(x) = &0) ==>
2580         ?n. EVEN n /\ (x = &n * (pi / &2))`,
2581   GEN_TAC THEN DISCH_TAC THEN
2582   MP_TAC(SPEC `x + pi / &2` COS_ZERO_LEMMA) THEN
2583   W(C SUBGOAL_THEN MP_TAC o funpow 2 (fst o dest_imp) o snd) THENL
2584    [CONJ_TAC THENL
2585      [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `x:real` THEN
2586       ASM_REWRITE_TAC[REAL_LE_ADDR] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN
2587       REWRITE_TAC[PI2_BOUNDS];
2588       ASM_REWRITE_TAC[COS_ADD; COS_PI2; REAL_MUL_LZERO; REAL_MUL_RZERO] THEN
2589       MATCH_ACCEPT_TAC REAL_SUB_REFL];
2590     DISCH_THEN(fun th -> REWRITE_TAC[th])] THEN
2591   DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN
2592   MP_TAC(SPEC `n:num` ODD_EXISTS) THEN ASM_REWRITE_TAC[GSYM NOT_EVEN] THEN
2593   DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST_ALL_TAC) THEN
2594   EXISTS_TAC `2 * m` THEN REWRITE_TAC[EVEN_DOUBLE] THEN
2595   RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_EQ_SUB_LADD]) THEN
2596   FIRST_ASSUM SUBST1_TAC THEN
2597   REWRITE_TAC[ADD1; GSYM REAL_ADD; REAL_RDISTRIB; REAL_MUL_LID] THEN
2598   REWRITE_TAC[ONCE_REWRITE_RULE[REAL_ADD_SYM] REAL_ADD_SUB]);;
2599
2600 let COS_ZERO = prove(
2601   `!x. (cos(x) = &0) <=> (?n. ~EVEN n /\ (x = &n * (pi / &2))) \/
2602                          (?n. ~EVEN n /\ (x = --(&n * (pi / &2))))`,
2603   GEN_TAC THEN EQ_TAC THENL
2604    [DISCH_TAC THEN DISJ_CASES_TAC (SPECL [`&0`; `x:real`] REAL_LE_TOTAL) THENL
2605      [DISJ1_TAC THEN MATCH_MP_TAC COS_ZERO_LEMMA THEN ASM_REWRITE_TAC[];
2606       DISJ2_TAC THEN REWRITE_TAC[GSYM REAL_NEG_EQ] THEN
2607       MATCH_MP_TAC COS_ZERO_LEMMA THEN ASM_REWRITE_TAC[COS_NEG] THEN
2608       ONCE_REWRITE_TAC[GSYM REAL_LE_NEG] THEN
2609       ASM_REWRITE_TAC[REAL_NEGNEG; REAL_NEG_0]];
2610     DISCH_THEN(DISJ_CASES_THEN (X_CHOOSE_TAC `n:num`)) THEN
2611     ASM_REWRITE_TAC[COS_NEG] THEN MP_TAC(SPEC `n:num` ODD_EXISTS) THEN
2612     ASM_REWRITE_TAC[GSYM NOT_EVEN] THEN
2613     DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN
2614     REWRITE_TAC[ADD1] THEN SPEC_TAC(`m:num`,`m:num`) THEN INDUCT_TAC THEN
2615     REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES; REAL_MUL_LID; COS_PI2] THEN
2616     REWRITE_TAC[GSYM ADD_ASSOC] THEN ONCE_REWRITE_TAC[GSYM REAL_ADD] THEN
2617     REWRITE_TAC[REAL_RDISTRIB] THEN REWRITE_TAC[COS_ADD] THEN
2618     REWRITE_TAC[GSYM REAL_DOUBLE; REAL_HALF_DOUBLE] THEN
2619     ASM_REWRITE_TAC[COS_PI; SIN_PI; REAL_MUL_LZERO; REAL_MUL_RZERO] THEN
2620     REWRITE_TAC[REAL_SUB_RZERO]]);;
2621
2622 let SIN_ZERO = prove(
2623   `!x. (sin(x) = &0) <=> (?n. EVEN n /\ (x = &n * (pi / &2))) \/
2624                          (?n. EVEN n /\ (x = --(&n * (pi / &2))))`,
2625   GEN_TAC THEN EQ_TAC THENL
2626    [DISCH_TAC THEN DISJ_CASES_TAC (SPECL [`&0`; `x:real`] REAL_LE_TOTAL) THENL
2627      [DISJ1_TAC THEN MATCH_MP_TAC SIN_ZERO_LEMMA THEN ASM_REWRITE_TAC[];
2628       DISJ2_TAC THEN REWRITE_TAC[GSYM REAL_NEG_EQ] THEN
2629       MATCH_MP_TAC SIN_ZERO_LEMMA THEN
2630       ASM_REWRITE_TAC[SIN_NEG; REAL_NEG_0; REAL_NEG_GE0]];
2631     DISCH_THEN(DISJ_CASES_THEN (X_CHOOSE_TAC `n:num`)) THEN
2632     ASM_REWRITE_TAC[SIN_NEG; REAL_NEG_EQ0] THEN
2633     MP_TAC(SPEC `n:num` EVEN_EXISTS) THEN ASM_REWRITE_TAC[] THEN
2634     DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN
2635     REWRITE_TAC[GSYM REAL_MUL] THEN
2636     ONCE_REWRITE_TAC[AC REAL_MUL_AC
2637       `(a * b) * c = b * (a * c)`] THEN
2638     REWRITE_TAC[GSYM REAL_DOUBLE; REAL_HALF_DOUBLE; SIN_NPI]]);;
2639
2640 let SIN_ZERO_PI = prove
2641  (`!x. (sin(x) = &0) <=> (?n. x = &n * pi) \/ (?n. x = --(&n * pi))`,
2642   GEN_TAC THEN REWRITE_TAC[SIN_ZERO; EVEN_EXISTS] THEN
2643   REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN
2644   ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
2645   REWRITE_TAC[UNWIND_THM2] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN
2646   REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN
2647   SIMP_TAC[GSYM REAL_MUL_ASSOC; REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH]);;
2648
2649 let COS_ONE_2PI = prove
2650  (`!x. (cos(x) = &1) <=> (?n. x = &n * &2 * pi) \/ (?n. x = --(&n * &2 * pi))`,
2651   REPEAT GEN_TAC THEN EQ_TAC THENL
2652    [ALL_TAC;
2653     STRIP_TAC THEN ASM_REWRITE_TAC[COS_NEG] THEN
2654     REWRITE_TAC[REAL_MUL_ASSOC; REAL_OF_NUM_MUL; COS_NPI] THEN
2655     REWRITE_TAC[REAL_POW_NEG; EVEN_MULT; ARITH_EVEN; REAL_POW_ONE]] THEN
2656   DISCH_TAC THEN MP_TAC(SPEC `x:real` SIN_CIRCLE) THEN
2657   ASM_REWRITE_TAC[REAL_POW_2; REAL_MUL_LZERO] THEN
2658   REWRITE_TAC[REAL_ARITH `(x + &1 * &1 = &1) <=> (x = &0)`] THEN
2659   REWRITE_TAC[REAL_ENTIRE] THEN REWRITE_TAC[SIN_ZERO_PI] THEN
2660   MATCH_MP_TAC(TAUT `(a ==> a') /\ (b ==> b') ==> (a \/ b ==> a' \/ b')`) THEN
2661   SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN
2662   CONJ_TAC THEN X_GEN_TAC `m:num` THEN DISCH_THEN SUBST_ALL_TAC THEN
2663   POP_ASSUM MP_TAC THEN REWRITE_TAC[REAL_EQ_NEG2; COS_NEG] THEN
2664   REWRITE_TAC[COS_NPI; REAL_POW_NEG; REAL_POW_ONE] THEN
2665   REWRITE_TAC[REAL_MUL_ASSOC; REAL_EQ_MUL_RCANCEL] THEN
2666   SIMP_TAC[PI_POS; REAL_LT_IMP_NZ] THEN
2667   REWRITE_TAC[REAL_OF_NUM_EQ; REAL_OF_NUM_MUL] THEN
2668   ONCE_REWRITE_TAC[MULT_SYM] THEN REWRITE_TAC[GSYM EVEN_EXISTS] THEN
2669   COND_CASES_TAC THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[]);;
2670
2671 (* ------------------------------------------------------------------------ *)
2672 (* Tangent                                                                  *)
2673 (* ------------------------------------------------------------------------ *)
2674
2675 let tan = new_definition
2676   `tan(x) = sin(x) / cos(x)`;;
2677
2678 let TAN_0 = prove(
2679   `tan(&0) = &0`,
2680   REWRITE_TAC[tan; SIN_0; REAL_DIV_LZERO]);;
2681
2682 let TAN_PI = prove(
2683   `tan(pi) = &0`,
2684   REWRITE_TAC[tan; SIN_PI; REAL_DIV_LZERO]);;
2685
2686 let TAN_NPI = prove(
2687   `!n. tan(&n * pi) = &0`,
2688   GEN_TAC THEN REWRITE_TAC[tan; SIN_NPI; REAL_DIV_LZERO]);;
2689
2690 let TAN_NEG = prove(
2691   `!x. tan(--x) = --(tan x)`,
2692   GEN_TAC THEN REWRITE_TAC[tan; SIN_NEG; COS_NEG] THEN
2693   REWRITE_TAC[real_div; REAL_NEG_LMUL]);;
2694
2695 let TAN_PERIODIC = prove(
2696   `!x. tan(x + &2 * pi) = tan(x)`,
2697   GEN_TAC THEN REWRITE_TAC[tan; SIN_PERIODIC; COS_PERIODIC]);;
2698
2699 let TAN_PERIODIC_PI = prove
2700  (`!x. tan(x + pi) = tan(x)`,
2701   REWRITE_TAC[tan; SIN_PERIODIC_PI; COS_PERIODIC_PI;
2702       real_div; REAL_INV_NEG; REAL_MUL_LNEG; REAL_MUL_RNEG; REAL_NEG_NEG]);;
2703
2704 let TAN_PERIODIC_NPI = prove
2705  (`!x n. tan(x + &n * pi) = tan(x)`,
2706   GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_RID] THEN
2707   REWRITE_TAC[GSYM REAL_OF_NUM_SUC; REAL_ADD_RDISTRIB; REAL_MUL_LID] THEN
2708   ASM_REWRITE_TAC[REAL_ADD_ASSOC; TAN_PERIODIC_PI]);;
2709
2710 let TAN_ADD = prove(
2711   `!x y. ~(cos(x) = &0) /\ ~(cos(y) = &0) /\ ~(cos(x + y) = &0) ==>
2712            (tan(x + y) = (tan(x) + tan(y)) / (&1 - tan(x) * tan(y)))`,
2713   REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[tan] THEN
2714   MP_TAC(SPECL [`cos(x) * cos(y)`;
2715                 `&1 - (sin(x) / cos(x)) * (sin(y) / cos(y))`]
2716          REAL_DIV_MUL2) THEN ASM_REWRITE_TAC[REAL_ENTIRE] THEN
2717   W(C SUBGOAL_THEN MP_TAC o funpow 2 (fst o dest_imp) o snd) THENL
2718    [DISCH_THEN(MP_TAC o AP_TERM `(*) (cos(x) * cos(y))`) THEN
2719     REWRITE_TAC[real_div; REAL_SUB_LDISTRIB; GSYM REAL_MUL_ASSOC] THEN
2720     REWRITE_TAC[REAL_MUL_RID; REAL_MUL_RZERO] THEN
2721     UNDISCH_TAC `~(cos(x + y) = &0)` THEN
2722     MATCH_MP_TAC EQ_IMP THEN
2723     AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
2724     REWRITE_TAC[COS_ADD] THEN AP_TERM_TAC;
2725     DISCH_THEN(fun th -> DISCH_THEN(MP_TAC o C MATCH_MP th)) THEN
2726     DISCH_THEN(fun th -> ONCE_REWRITE_TAC[th]) THEN BINOP_TAC THENL
2727      [REWRITE_TAC[real_div; REAL_LDISTRIB; GSYM REAL_MUL_ASSOC] THEN
2728       REWRITE_TAC[SIN_ADD] THEN BINOP_TAC THENL
2729        [ONCE_REWRITE_TAC[AC REAL_MUL_AC
2730           `a * b * c * d = (d * a) * (c * b)`] THEN
2731         IMP_SUBST_TAC REAL_MUL_LINV THEN ASM_REWRITE_TAC[REAL_MUL_LID];
2732         ONCE_REWRITE_TAC[AC REAL_MUL_AC
2733           `a * b * c * d = (d * b) * (a * c)`] THEN
2734         IMP_SUBST_TAC REAL_MUL_LINV THEN ASM_REWRITE_TAC[REAL_MUL_LID]];
2735       REWRITE_TAC[COS_ADD; REAL_SUB_LDISTRIB; REAL_MUL_RID] THEN
2736       AP_TERM_TAC THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC]]] THEN
2737   ONCE_REWRITE_TAC[AC REAL_MUL_AC
2738     `a * b * c * d * e * f = (f * b) * (d * a) * (c * e)`] THEN
2739   REPEAT(IMP_SUBST_TAC REAL_MUL_LINV THEN ASM_REWRITE_TAC[]) THEN
2740   REWRITE_TAC[REAL_MUL_LID]);;
2741
2742 let TAN_DOUBLE = prove(
2743   `!x. ~(cos(x) = &0) /\ ~(cos(&2 * x) = &0) ==>
2744             (tan(&2 * x) = (&2 * tan(x)) / (&1 - (tan(x) pow 2)))`,
2745   GEN_TAC THEN STRIP_TAC THEN
2746   MP_TAC(SPECL [`x:real`; `x:real`] TAN_ADD) THEN
2747   ASM_REWRITE_TAC[REAL_DOUBLE; POW_2]);;
2748
2749 let TAN_POS_PI2 = prove(
2750   `!x. &0 < x /\ x < pi / &2 ==> &0 < tan(x)`,
2751   GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[tan; real_div] THEN
2752   MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC THENL
2753    [MATCH_MP_TAC SIN_POS_PI2;
2754     MATCH_MP_TAC REAL_INV_POS THEN MATCH_MP_TAC COS_POS_PI2] THEN
2755   ASM_REWRITE_TAC[]);;
2756
2757 let DIFF_TAN = prove(
2758   `!x. ~(cos(x) = &0) ==> (tan diffl inv(cos(x) pow 2))(x)`,
2759   GEN_TAC THEN DISCH_TAC THEN MP_TAC(DIFF_CONV `\x. sin(x) / cos(x)`) THEN
2760   DISCH_THEN(MP_TAC o SPEC `x:real`) THEN ASM_REWRITE_TAC[REAL_MUL_RID] THEN
2761   REWRITE_TAC[GSYM tan; GSYM REAL_NEG_LMUL; REAL_NEGNEG; real_sub] THEN
2762   CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
2763   REWRITE_TAC[GSYM POW_2; SIN_CIRCLE; GSYM REAL_INV_1OVER]);;
2764
2765 let DIFF_TAN_COMPOSITE = prove
2766  (`(g diffl m)(x) /\ ~(cos(g x) = &0)
2767    ==> ((\x. tan(g x)) diffl (inv(cos(g x) pow 2) * m))(x)`,
2768   ASM_SIMP_TAC[DIFF_CHAIN; DIFF_TAN]) in
2769 add_to_diff_net DIFF_TAN_COMPOSITE;;
2770
2771 let TAN_TOTAL_LEMMA = prove(
2772   `!y. &0 < y ==> ?x. &0 < x /\ x < pi / &2 /\ y < tan(x)`,
2773   GEN_TAC THEN DISCH_TAC THEN
2774   SUBGOAL_THEN `((\x. cos(x) / sin(x)) tends_real_real &0)(pi / &2)`
2775   MP_TAC THENL
2776    [SUBST1_TAC(SYM(SPEC `&1` REAL_DIV_LZERO)) THEN
2777     CONV_TAC(ONCE_DEPTH_CONV HABS_CONV) THEN MATCH_MP_TAC LIM_DIV THEN
2778     REWRITE_TAC[REAL_10] THEN CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN
2779     SUBST1_TAC(SYM COS_PI2) THEN SUBST1_TAC(SYM SIN_PI2) THEN
2780     REWRITE_TAC[GSYM CONTL_LIM] THEN CONJ_TAC THEN MATCH_MP_TAC DIFF_CONT THENL
2781      [EXISTS_TAC `--(sin(pi / &2))`;
2782       EXISTS_TAC `cos(pi / &2)`] THEN
2783     REWRITE_TAC[DIFF_SIN; DIFF_COS]; ALL_TAC] THEN
2784   REWRITE_TAC[LIM] THEN DISCH_THEN(MP_TAC o SPEC `inv(y)`) THEN
2785   FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_INV_POS th]) THEN
2786   BETA_TAC THEN REWRITE_TAC[REAL_SUB_RZERO] THEN
2787   DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
2788   MP_TAC(SPECL [`d:real`; `pi / &2`] REAL_DOWN2) THEN
2789   ASM_REWRITE_TAC[PI2_BOUNDS] THEN
2790   DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
2791   EXISTS_TAC `(pi / &2) - e` THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN
2792   CONJ_TAC THENL
2793    [REWRITE_TAC[real_sub; GSYM REAL_NOT_LE; REAL_LE_ADDR; REAL_NEG_GE0] THEN
2794     ASM_REWRITE_TAC[REAL_NOT_LE]; ALL_TAC] THEN
2795   FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN
2796   DISCH_THEN(MP_TAC o SPEC `(pi / &2) - e`) THEN
2797   REWRITE_TAC[REAL_SUB_SUB; ABS_NEG] THEN
2798   SUBGOAL_THEN `abs(e) = e` (fun th -> ASM_REWRITE_TAC[th]) THENL
2799    [REWRITE_TAC[ABS_REFL] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN
2800     FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN
2801   SUBGOAL_THEN `&0 < cos((pi / &2) - e) / sin((pi / &2) - e)`
2802   MP_TAC THENL
2803    [ONCE_REWRITE_TAC[real_div] THEN
2804     MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC THENL
2805      [MATCH_MP_TAC COS_POS_PI2;
2806       MATCH_MP_TAC REAL_INV_POS THEN MATCH_MP_TAC SIN_POS_PI2] THEN
2807     ASM_REWRITE_TAC[REAL_SUB_LT] THEN
2808     REWRITE_TAC[GSYM REAL_NOT_LE; real_sub; REAL_LE_ADDR; REAL_NEG_GE0] THEN
2809     ASM_REWRITE_TAC[REAL_NOT_LE]; ALL_TAC] THEN
2810   DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC(MATCH_MP REAL_POS_NZ th)) THEN
2811   REWRITE_TAC[ABS_NZ; IMP_IMP] THEN
2812   DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_INV2) THEN REWRITE_TAC[tan] THEN
2813   MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL
2814    [MATCH_MP_TAC REAL_INVINV THEN MATCH_MP_TAC REAL_POS_NZ THEN
2815     FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN
2816   MP_TAC(ASSUME `&0 < cos((pi / &2) - e) / sin((pi / &2) - e)`) THEN
2817   DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_IMP_LE) THEN
2818   REWRITE_TAC[GSYM ABS_REFL] THEN DISCH_THEN SUBST1_TAC THEN
2819   REWRITE_TAC[real_div] THEN IMP_SUBST_TAC REAL_INV_MUL_WEAK THENL
2820    [REWRITE_TAC[GSYM DE_MORGAN_THM; GSYM REAL_ENTIRE; GSYM real_div] THEN
2821     MATCH_MP_TAC REAL_POS_NZ THEN FIRST_ASSUM ACCEPT_TAC;
2822     GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN AP_TERM_TAC THEN
2823     MATCH_MP_TAC REAL_INVINV THEN MATCH_MP_TAC REAL_POS_NZ THEN
2824     MATCH_MP_TAC SIN_POS_PI2 THEN REWRITE_TAC[REAL_SUB_LT; GSYM real_div] THEN
2825     REWRITE_TAC[GSYM REAL_NOT_LE; real_sub; REAL_LE_ADDR; REAL_NEG_GE0] THEN
2826     ASM_REWRITE_TAC[REAL_NOT_LE]]);;
2827
2828 let TAN_TOTAL_POS = prove(
2829   `!y. &0 <= y ==> ?x. &0 <= x /\ x < pi / &2 /\ (tan(x) = y)`,
2830   GEN_TAC THEN DISCH_THEN(DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT]) THENL
2831    [FIRST_ASSUM(MP_TAC o MATCH_MP TAN_TOTAL_LEMMA) THEN
2832     DISCH_THEN(X_CHOOSE_THEN `x:real` STRIP_ASSUME_TAC) THEN
2833     MP_TAC(SPECL [`tan`; `&0`; `x:real`; `y:real`] IVT) THEN
2834     W(C SUBGOAL_THEN (fun th -> DISCH_THEN(MP_TAC o C MATCH_MP th)) o
2835          funpow 2 (fst o dest_imp) o snd) THENL
2836      [REPEAT CONJ_TAC THEN TRY(MATCH_MP_TAC REAL_LT_IMP_LE) THEN
2837       ASM_REWRITE_TAC[TAN_0] THEN X_GEN_TAC `z:real` THEN STRIP_TAC THEN
2838       MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC `inv(cos(z) pow 2)` THEN
2839       MATCH_MP_TAC DIFF_TAN THEN UNDISCH_TAC `&0 <= z` THEN
2840       REWRITE_TAC[REAL_LE_LT] THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL
2841        [DISCH_TAC THEN MATCH_MP_TAC REAL_POS_NZ THEN
2842         MATCH_MP_TAC COS_POS_PI2 THEN ASM_REWRITE_TAC[] THEN
2843         MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `x:real` THEN
2844         ASM_REWRITE_TAC[];
2845         DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[COS_0; REAL_10]];
2846       DISCH_THEN(X_CHOOSE_THEN `z:real` STRIP_ASSUME_TAC) THEN
2847       EXISTS_TAC `z:real` THEN ASM_REWRITE_TAC[] THEN
2848       MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `x:real` THEN
2849       ASM_REWRITE_TAC[]];
2850     POP_ASSUM(SUBST1_TAC o SYM) THEN EXISTS_TAC `&0` THEN
2851     REWRITE_TAC[TAN_0; REAL_LE_REFL; PI2_BOUNDS]]);;
2852
2853 let TAN_TOTAL = prove(
2854   `!y. ?!x. --(pi / &2) < x /\ x < (pi / &2) /\ (tan(x) = y)`,
2855   GEN_TAC THEN CONV_TAC EXISTS_UNIQUE_CONV THEN CONJ_TAC THENL
2856    [DISJ_CASES_TAC(SPEC `y:real` REAL_LE_NEGTOTAL) THEN
2857     POP_ASSUM(X_CHOOSE_TAC `x:real` o MATCH_MP TAN_TOTAL_POS) THENL
2858      [EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[] THEN
2859       MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&0` THEN
2860       ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM REAL_LT_NEG] THEN
2861       REWRITE_TAC[REAL_NEGNEG; REAL_NEG_0; PI2_BOUNDS];
2862       EXISTS_TAC `--x` THEN ASM_REWRITE_TAC[REAL_LT_NEG] THEN
2863       ASM_REWRITE_TAC[TAN_NEG; REAL_NEG_EQ; REAL_NEGNEG] THEN
2864       ONCE_REWRITE_TAC[GSYM REAL_LT_NEG] THEN
2865       REWRITE_TAC[REAL_LT_NEG] THEN MATCH_MP_TAC REAL_LET_TRANS THEN
2866       EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[REAL_LE_NEGL]];
2867     MAP_EVERY X_GEN_TAC [`x1:real`; `x2:real`] THEN
2868     REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC
2869          (SPECL [`x1:real`; `x2:real`] REAL_LT_TOTAL) THENL
2870      [DISCH_THEN(K ALL_TAC) THEN POP_ASSUM ACCEPT_TAC;
2871       ALL_TAC;
2872       POP_ASSUM MP_TAC THEN SPEC_TAC(`x1:real`,`z1:real`) THEN
2873       SPEC_TAC(`x2:real`,`z2:real`) THEN
2874       MAP_EVERY X_GEN_TAC [`x1:real`; `x2:real`] THEN DISCH_TAC THEN
2875       CONV_TAC(RAND_CONV SYM_CONV) THEN ONCE_REWRITE_TAC[CONJ_SYM]] THEN
2876     (STRIP_TAC THEN MP_TAC(SPECL [`tan`; `x1:real`; `x2:real`] ROLLE) THEN
2877      ASM_REWRITE_TAC[] THEN CONV_TAC CONTRAPOS_CONV THEN
2878      DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[NOT_IMP] THEN
2879      REPEAT CONJ_TAC THENL
2880       [X_GEN_TAC `x:real` THEN STRIP_TAC THEN MATCH_MP_TAC DIFF_CONT THEN
2881        EXISTS_TAC `inv(cos(x) pow 2)` THEN MATCH_MP_TAC DIFF_TAN;
2882        X_GEN_TAC `x:real` THEN
2883        DISCH_THEN(CONJUNCTS_THEN (ASSUME_TAC o MATCH_MP REAL_LT_IMP_LE)) THEN
2884        REWRITE_TAC[differentiable] THEN EXISTS_TAC `inv(cos(x) pow 2)` THEN
2885        MATCH_MP_TAC DIFF_TAN;
2886        REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(X_CHOOSE_THEN `x:real`
2887          (CONJUNCTS_THEN2 (CONJUNCTS_THEN (ASSUME_TAC o MATCH_MP
2888           REAL_LT_IMP_LE)) ASSUME_TAC)) THEN
2889        MP_TAC(SPEC `x:real` DIFF_TAN) THEN
2890        SUBGOAL_THEN `~(cos(x) = &0)` ASSUME_TAC THENL
2891         [ALL_TAC;
2892          ASM_REWRITE_TAC[] THEN
2893          DISCH_THEN(MP_TAC o C CONJ (ASSUME `(tan diffl &0)(x)`)) THEN
2894          DISCH_THEN(MP_TAC o MATCH_MP DIFF_UNIQ) THEN REWRITE_TAC[] THEN
2895          MATCH_MP_TAC REAL_INV_NZ THEN MATCH_MP_TAC POW_NZ THEN
2896          ASM_REWRITE_TAC[]]] THEN
2897      (MATCH_MP_TAC REAL_POS_NZ THEN MATCH_MP_TAC COS_POS_PI THEN
2898       CONJ_TAC THENL
2899        [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `x1:real`;
2900         MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `x2:real`] THEN
2901      ASM_REWRITE_TAC[]))]);;
2902
2903 let PI2_PI4 = prove
2904  (`pi / &2 = &2 * pi / &4`,
2905   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
2906   REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN
2907   CONV_TAC REAL_RAT_REDUCE_CONV);;
2908
2909 let TAN_PI4 = prove
2910  (`tan(pi / &4) = &1`,
2911   REWRITE_TAC[tan; COS_SIN; real_div; GSYM REAL_SUB_LDISTRIB] THEN
2912   CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC REAL_MUL_RINV THEN
2913   REWRITE_TAC[SIN_ZERO] THEN
2914   REWRITE_TAC[real_div; GSYM REAL_MUL_LNEG] THEN
2915   ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c = b * a * c`] THEN
2916   SIMP_TAC[REAL_MUL_LID; REAL_EQ_MUL_LCANCEL; PI_POS; REAL_LT_IMP_NZ] THEN
2917   SIMP_TAC[GSYM real_div; REAL_EQ_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN
2918   CONV_TAC REAL_RAT_REDUCE_CONV THEN
2919   SIMP_TAC[REAL_EQ_LDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN
2920   REWRITE_TAC[REAL_MUL_LNEG; REAL_OF_NUM_MUL; REAL_OF_NUM_EQ] THEN
2921   SIMP_TAC[REAL_ARITH `&0 <= x ==> ~(&1 = --x)`; REAL_POS] THEN
2922   STRIP_TAC THEN FIRST_ASSUM(MP_TAC o AP_TERM `EVEN`) THEN
2923   REWRITE_TAC[EVEN_MULT; ARITH_EVEN]);;
2924
2925 let TAN_COT = prove
2926  (`!x. tan(pi / &2 - x) = inv(tan x)`,
2927   REWRITE_TAC[tan; GSYM SIN_COS; GSYM COS_SIN; REAL_INV_DIV]);;
2928
2929 let TAN_BOUND_PI2 = prove
2930  (`!x. abs(x) < pi / &4 ==> abs(tan x) < &1`,
2931   REPEAT GEN_TAC THEN
2932   SUBGOAL_THEN
2933    `!x. &0 < x /\ x < pi / &4 ==> &0 < tan(x) /\ tan(x) < &1`
2934   ASSUME_TAC THENL
2935    [REPEAT STRIP_TAC THENL
2936      [ASM_SIMP_TAC[tan; REAL_LT_DIV; SIN_POS_PI2; COS_POS_PI2; PI2_PI4;
2937                    REAL_ARITH `&0 < x /\ x < a ==> x < &2 * a`];
2938       ALL_TAC] THEN
2939     MP_TAC(SPECL [`tan`; `\x. inv(cos(x) pow 2)`;
2940                   `x:real`; `pi / &4`] MVT_ALT) THEN
2941     W(C SUBGOAL_THEN (fun th -> REWRITE_TAC[th]) o funpow 2 lhand o snd) THENL
2942      [ASM_REWRITE_TAC[BETA_THM] THEN X_GEN_TAC `z:real` THEN STRIP_TAC THEN
2943       MATCH_MP_TAC DIFF_TAN THEN MATCH_MP_TAC REAL_LT_IMP_NZ THEN
2944       MATCH_MP_TAC COS_POS_PI2 THEN REWRITE_TAC[PI2_PI4] THEN
2945       MAP_EVERY UNDISCH_TAC [`x <= z`; `z <= pi / &4`; `&0 < x`] THEN
2946       REAL_ARITH_TAC;
2947       ALL_TAC] THEN
2948     SIMP_TAC[TAN_PI4; REAL_ARITH `x < &1 <=> &0 < &1 - x`;
2949              LEFT_IMP_EXISTS_THM] THEN
2950     X_GEN_TAC `z:real` THEN REPEAT STRIP_TAC THEN
2951     MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN
2952     REWRITE_TAC[REAL_LT_INV_EQ; BETA_THM] THEN
2953     MATCH_MP_TAC REAL_POW_LT THEN MATCH_MP_TAC COS_POS_PI2 THEN
2954     REWRITE_TAC[PI2_PI4] THEN
2955     MAP_EVERY UNDISCH_TAC [`x < z`; `z < pi / &4`; `&0 < x`] THEN
2956     REAL_ARITH_TAC; ALL_TAC] THEN
2957   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [real_abs] THEN
2958   REWRITE_TAC[REAL_LE_LT] THEN
2959   ASM_CASES_TAC `x = &0` THEN
2960   ASM_REWRITE_TAC[TAN_0; REAL_ABS_NUM; REAL_LT_01] THEN
2961   COND_CASES_TAC THEN
2962   ASM_SIMP_TAC[REAL_ARITH `&0 < x /\ x < &1 ==> abs(x) < &1`] THEN
2963   ONCE_REWRITE_TAC[GSYM REAL_ABS_NEG] THEN REWRITE_TAC[GSYM TAN_NEG] THEN
2964   ASM_SIMP_TAC[REAL_ARITH `&0 < x /\ x < &1 ==> abs(x) < &1`;
2965                REAL_ARITH `~(x = &0) /\ ~(&0 < x) ==> &0 < --x`]);;
2966
2967 let TAN_ABS_GE_X = prove
2968  (`!x. abs(x) < pi / &2 ==> abs(x) <= abs(tan x)`,
2969   SUBGOAL_THEN `!y. &0 < y /\ y < pi / &2 ==> y <= tan(y)` ASSUME_TAC THENL
2970    [ALL_TAC;
2971     GEN_TAC THEN
2972     REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (SPEC `x:real` REAL_LT_NEGTOTAL) THEN
2973     ASM_REWRITE_TAC[TAN_0; REAL_ABS_0; REAL_LE_REFL] THENL
2974      [ALL_TAC;
2975       ONCE_REWRITE_TAC[GSYM REAL_ABS_NEG] THEN REWRITE_TAC[GSYM TAN_NEG]] THEN
2976     MATCH_MP_TAC(REAL_ARITH
2977      `&0 < x /\ (x < p ==> x <= tx)
2978       ==> abs(x) < p ==> abs(x) <= abs(tx)`) THEN ASM_SIMP_TAC[]] THEN
2979   GEN_TAC THEN STRIP_TAC THEN
2980   MP_TAC(SPECL [`tan`; `\x. inv(cos(x) pow 2)`; `&0`; `y:real`] MVT_ALT) THEN
2981   ASM_REWRITE_TAC[TAN_0; REAL_SUB_RZERO] THEN
2982   MATCH_MP_TAC(TAUT `a /\ (b ==> c) ==> (a ==> b) ==> c`) THEN CONJ_TAC THENL
2983    [REPEAT STRIP_TAC THEN BETA_TAC THEN MATCH_MP_TAC DIFF_TAN THEN
2984     MATCH_MP_TAC REAL_LT_IMP_NZ THEN MATCH_MP_TAC COS_POS_PI THEN
2985     POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REAL_ARITH_TAC;
2986     DISCH_THEN(X_CHOOSE_THEN `z:real` STRIP_ASSUME_TAC) THEN
2987     ASM_REWRITE_TAC[BETA_THM] THEN
2988     GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_RID] THEN
2989     MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN
2990     MATCH_MP_TAC REAL_INV_1_LE THEN CONJ_TAC THENL
2991      [MATCH_MP_TAC REAL_POW_LT;
2992       MATCH_MP_TAC REAL_POW_1_LE THEN REWRITE_TAC[COS_BOUNDS] THEN
2993       MATCH_MP_TAC REAL_LT_IMP_LE] THEN
2994     MATCH_MP_TAC COS_POS_PI THEN
2995     POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REAL_ARITH_TAC]);;
2996
2997 (* ------------------------------------------------------------------------ *)
2998 (* Inverse trig functions                                                   *)
2999 (* ------------------------------------------------------------------------ *)
3000
3001 let asn = new_definition
3002   `asn(y) = @x. --(pi / &2) <= x /\ x <= pi / &2 /\ (sin x = y)`;;
3003
3004 let acs = new_definition
3005   `acs(y) = @x. &0 <= x /\ x <= pi /\ (cos x = y)`;;
3006
3007 let atn = new_definition
3008   `atn(y) = @x. --(pi / &2) < x /\ x < pi / &2 /\ (tan x = y)`;;
3009
3010 let ASN = prove(
3011   `!y. --(&1) <= y /\ y <= &1 ==>
3012      --(pi / &2) <= asn(y) /\ asn(y) <= pi / &2 /\ (sin(asn y) = y)`,
3013   GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP SIN_TOTAL) THEN
3014   DISCH_THEN(MP_TAC o CONJUNCT1 o CONV_RULE EXISTS_UNIQUE_CONV) THEN
3015   DISCH_THEN(MP_TAC o SELECT_RULE) THEN REWRITE_TAC[GSYM asn]);;
3016
3017 let ASN_SIN = prove(
3018   `!y. --(&1) <= y /\ y <= &1 ==> (sin(asn(y)) = y)`,
3019   GEN_TAC THEN DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP ASN th]));;
3020
3021 let ASN_BOUNDS = prove(
3022   `!y. --(&1) <= y /\ y <= &1 ==> --(pi / &2) <= asn(y) /\ asn(y) <= pi / &2`,
3023   GEN_TAC THEN DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP ASN th]));;
3024
3025 let ASN_BOUNDS_LT = prove(
3026   `!y. --(&1) < y /\ y < &1 ==> --(pi / &2) < asn(y) /\ asn(y) < pi / &2`,
3027   GEN_TAC THEN STRIP_TAC THEN
3028   EVERY_ASSUM(ASSUME_TAC o MATCH_MP REAL_LT_IMP_LE) THEN
3029   MP_TAC(SPEC `y:real` ASN_BOUNDS) THEN ASM_REWRITE_TAC[] THEN
3030   STRIP_TAC THEN ASM_REWRITE_TAC[REAL_LT_LE] THEN
3031   CONJ_TAC THEN DISCH_THEN(MP_TAC o AP_TERM `sin`) THEN
3032   IMP_SUBST_TAC ASN_SIN THEN ASM_REWRITE_TAC[SIN_NEG; SIN_PI2] THEN
3033   DISCH_THEN((then_) (POP_ASSUM_LIST (MP_TAC o end_itlist CONJ)) o
3034     ASSUME_TAC) THEN ASM_REWRITE_TAC[REAL_LT_REFL]);;
3035
3036 let SIN_ASN = prove(
3037   `!x. --(pi / &2) <= x /\ x <= pi / &2 ==> (asn(sin(x)) = x)`,
3038   GEN_TAC THEN DISCH_TAC THEN
3039   MP_TAC(MATCH_MP SIN_TOTAL (SPEC `x:real` SIN_BOUNDS)) THEN
3040   DISCH_THEN(MATCH_MP_TAC o CONJUNCT2 o CONV_RULE EXISTS_UNIQUE_CONV) THEN
3041   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ASN THEN
3042   MATCH_ACCEPT_TAC SIN_BOUNDS);;
3043
3044 let ACS = prove(
3045   `!y. --(&1) <= y /\ y <= &1 ==>
3046      &0 <= acs(y) /\ acs(y) <= pi  /\ (cos(acs y) = y)`,
3047   GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP COS_TOTAL) THEN
3048   DISCH_THEN(MP_TAC o CONJUNCT1 o CONV_RULE EXISTS_UNIQUE_CONV) THEN
3049   DISCH_THEN(MP_TAC o SELECT_RULE) THEN REWRITE_TAC[GSYM acs]);;
3050
3051 let ACS_COS = prove(
3052   `!y. --(&1) <= y /\ y <= &1 ==> (cos(acs(y)) = y)`,
3053   GEN_TAC THEN DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP ACS th]));;
3054
3055 let ACS_BOUNDS = prove(
3056   `!y. --(&1) <= y /\ y <= &1 ==> &0 <= acs(y) /\ acs(y) <= pi`,
3057   GEN_TAC THEN DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP ACS th]));;
3058
3059 let ACS_BOUNDS_LT = prove(
3060   `!y. --(&1) < y /\ y < &1 ==> &0 < acs(y) /\ acs(y) < pi`,
3061   GEN_TAC THEN STRIP_TAC THEN
3062   EVERY_ASSUM(ASSUME_TAC o MATCH_MP REAL_LT_IMP_LE) THEN
3063   MP_TAC(SPEC `y:real` ACS_BOUNDS) THEN ASM_REWRITE_TAC[] THEN
3064   STRIP_TAC THEN ASM_REWRITE_TAC[REAL_LT_LE] THEN
3065   CONJ_TAC THEN DISCH_THEN(MP_TAC o AP_TERM `cos`) THEN
3066   IMP_SUBST_TAC ACS_COS THEN ASM_REWRITE_TAC[COS_0; COS_PI] THEN
3067   DISCH_THEN((then_) (POP_ASSUM_LIST (MP_TAC o end_itlist CONJ)) o
3068     ASSUME_TAC) THEN ASM_REWRITE_TAC[REAL_LT_REFL]);;
3069
3070 let COS_ACS = prove(
3071   `!x. &0 <= x /\ x <= pi ==> (acs(cos(x)) = x)`,
3072   GEN_TAC THEN DISCH_TAC THEN
3073   MP_TAC(MATCH_MP COS_TOTAL (SPEC `x:real` COS_BOUNDS)) THEN
3074   DISCH_THEN(MATCH_MP_TAC o CONJUNCT2 o CONV_RULE EXISTS_UNIQUE_CONV) THEN
3075   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ACS THEN
3076   MATCH_ACCEPT_TAC COS_BOUNDS);;
3077
3078 let ATN = prove(
3079   `!y. --(pi / &2) < atn(y) /\ atn(y) < (pi / &2) /\ (tan(atn y) = y)`,
3080   GEN_TAC THEN MP_TAC(SPEC `y:real` TAN_TOTAL) THEN
3081   DISCH_THEN(MP_TAC o CONJUNCT1 o CONV_RULE EXISTS_UNIQUE_CONV) THEN
3082   DISCH_THEN(MP_TAC o SELECT_RULE) THEN REWRITE_TAC[GSYM atn]);;
3083
3084 let ATN_TAN = prove(
3085   `!y. tan(atn y) = y`,
3086   REWRITE_TAC[ATN]);;
3087
3088 let ATN_BOUNDS = prove(
3089   `!y. --(pi / &2) < atn(y) /\ atn(y) < (pi / &2)`,
3090   REWRITE_TAC[ATN]);;
3091
3092 let TAN_ATN = prove(
3093   `!x. --(pi / &2) < x /\ x < (pi / &2) ==> (atn(tan(x)) = x)`,
3094   GEN_TAC THEN DISCH_TAC THEN MP_TAC(SPEC `tan(x)` TAN_TOTAL) THEN
3095   DISCH_THEN(MATCH_MP_TAC o CONJUNCT2 o CONV_RULE EXISTS_UNIQUE_CONV) THEN
3096   ASM_REWRITE_TAC[ATN]);;
3097
3098 let ATN_0 = prove
3099  (`atn(&0) = &0`,
3100   GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [SYM TAN_0] THEN
3101   MATCH_MP_TAC TAN_ATN THEN
3102   MATCH_MP_TAC(REAL_ARITH `&0 < a ==> --a < &0 /\ &0 < a`) THEN
3103   SIMP_TAC[REAL_LT_DIV; PI_POS; REAL_OF_NUM_LT; ARITH]);;
3104
3105 let ATN_1 = prove
3106  (`atn(&1) = pi / &4`,
3107   MP_TAC(AP_TERM `atn` TAN_PI4) THEN
3108   DISCH_THEN(SUBST1_TAC o SYM) THEN
3109   MATCH_MP_TAC TAN_ATN THEN
3110   MATCH_MP_TAC(REAL_ARITH
3111    `&0 < a /\ a < b ==> --b < a /\ a < b`) THEN
3112   SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; PI_POS] THEN
3113   SIMP_TAC[real_div; REAL_LT_LMUL_EQ; PI_POS] THEN
3114   CONV_TAC REAL_RAT_REDUCE_CONV);;
3115
3116 let ATN_NEG = prove
3117  (`!x. atn(--x) = --(atn x)`,
3118   GEN_TAC THEN MP_TAC(SPEC `atn(x)` TAN_NEG) THEN
3119   REWRITE_TAC[ATN_TAN] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
3120   MATCH_MP_TAC TAN_ATN THEN
3121   MATCH_MP_TAC(REAL_ARITH
3122    `--a < x /\ x < a ==> --a < --x /\ --x < a`) THEN
3123   REWRITE_TAC[ATN_BOUNDS]);;
3124
3125 (* ------------------------------------------------------------------------- *)
3126 (* Differentiation of arctan.                                                *)
3127 (* ------------------------------------------------------------------------- *)
3128
3129 let COS_ATN_NZ = prove(
3130   `!x. ~(cos(atn(x)) = &0)`,
3131   GEN_TAC THEN REWRITE_TAC[COS_ZERO; DE_MORGAN_THM] THEN CONJ_TAC THEN
3132   CONV_TAC NOT_EXISTS_CONV THEN X_GEN_TAC `n:num` THEN
3133   STRUCT_CASES_TAC(SPEC `n:num` num_CASES) THEN
3134   REWRITE_TAC[EVEN; DE_MORGAN_THM] THEN DISJ2_TAC THEN
3135   DISCH_TAC THEN MP_TAC(SPEC `x:real` ATN_BOUNDS) THEN
3136   ASM_REWRITE_TAC[DE_MORGAN_THM] THENL
3137    [DISJ2_TAC; DISJ1_TAC THEN REWRITE_TAC[REAL_LT_NEG]] THEN
3138   GEN_REWRITE_TAC (RAND_CONV o RAND_CONV)  [GSYM REAL_MUL_LID] THEN
3139   REWRITE_TAC[MATCH_MP REAL_LT_RMUL_EQ (CONJUNCT1 PI2_BOUNDS)] THEN
3140   REWRITE_TAC[ADD1; GSYM REAL_ADD; REAL_NOT_LT] THEN
3141   ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
3142   REWRITE_TAC[REAL_LE_ADDR; REAL_LE; LE_0]);;
3143
3144 let TAN_SEC = prove(
3145   `!x. ~(cos(x) = &0) ==> (&1 + (tan(x) pow 2) = inv(cos x) pow 2)`,
3146   GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[tan] THEN
3147   FIRST_ASSUM(fun th ->  ONCE_REWRITE_TAC[GSYM
3148    (MATCH_MP REAL_DIV_REFL (SPEC `2` (MATCH_MP POW_NZ th)))]) THEN
3149   REWRITE_TAC[real_div; POW_MUL] THEN
3150   POP_ASSUM(fun th ->  REWRITE_TAC[MATCH_MP POW_INV th]) THEN
3151   ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
3152   REWRITE_TAC[GSYM REAL_RDISTRIB; SIN_CIRCLE; REAL_MUL_LID]);;
3153
3154 let DIFF_ATN = prove(
3155   `!x. (atn diffl (inv(&1 + (x pow 2))))(x)`,
3156   GEN_TAC THEN
3157   SUBGOAL_THEN `(atn diffl (inv(&1 + (x pow 2))))(tan(atn x))`
3158   MP_TAC THENL [MATCH_MP_TAC DIFF_INVERSE_LT; REWRITE_TAC[ATN_TAN]] THEN
3159   SUBGOAL_THEN
3160     `?d. &0 < d /\
3161          !z. abs(z - atn(x)) < d ==>  (--(pi / (& 2))) < z /\ z < (pi / (& 2))`
3162   (X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THENL
3163    [ONCE_REWRITE_TAC[ABS_SUB] THEN MATCH_MP_TAC INTERVAL_LEMMA_LT THEN
3164     MATCH_ACCEPT_TAC ATN_BOUNDS;
3165     EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THENL
3166      [MATCH_MP_TAC TAN_ATN THEN FIRST_ASSUM MATCH_MP_TAC THEN
3167       ASM_REWRITE_TAC[];
3168       MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC `inv(cos(z) pow 2)` THEN
3169       MATCH_MP_TAC DIFF_TAN THEN MATCH_MP_TAC REAL_POS_NZ THEN
3170       MATCH_MP_TAC COS_POS_PI THEN FIRST_ASSUM MATCH_MP_TAC THEN
3171       ASM_REWRITE_TAC[];
3172       ASSUME_TAC(SPEC `x:real` COS_ATN_NZ) THEN
3173       FIRST_ASSUM(MP_TAC o MATCH_MP DIFF_TAN) THEN
3174       FIRST_ASSUM(ASSUME_TAC o SYM o MATCH_MP TAN_SEC) THEN
3175       FIRST_ASSUM(ASSUME_TAC o MATCH_MP POW_INV) THEN
3176       ASM_REWRITE_TAC[ATN_TAN];
3177       UNDISCH_TAC `&1 + (x pow 2) = &0` THEN REWRITE_TAC[] THEN
3178       MATCH_MP_TAC REAL_POS_NZ THEN
3179       MATCH_MP_TAC REAL_LTE_ADD THEN
3180       REWRITE_TAC[REAL_LT_01; REAL_LE_SQUARE; POW_2]]]);;
3181
3182 let DIFF_ATN_COMPOSITE = prove
3183  (`(g diffl m)(x) ==> ((\x. atn(g x)) diffl (inv(&1 + (g x) pow 2) * m))(x)`,
3184   ASM_SIMP_TAC[DIFF_CHAIN; DIFF_ATN]) in
3185 add_to_diff_net DIFF_ATN_COMPOSITE;;
3186
3187 (* ------------------------------------------------------------------------- *)
3188 (* A few more lemmas about arctan.                                           *)
3189 (* ------------------------------------------------------------------------- *)
3190
3191 let ATN_MONO_LT = prove
3192  (`!x y. x < y ==> atn(x) < atn(y)`,
3193   REPEAT STRIP_TAC THEN
3194   MP_TAC(SPECL [`atn`; `\x. inv(&1 + x pow 2)`; `x:real`; `y:real`]
3195                MVT_ALT) THEN
3196   BETA_TAC THEN ASM_REWRITE_TAC[DIFF_ATN] THEN STRIP_TAC THEN
3197   FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
3198     `(l - r = d) ==> l < d + e ==> r < e`)) THEN
3199   REWRITE_TAC[REAL_ARITH `a < b + a <=> &0 < b`] THEN
3200   MATCH_MP_TAC REAL_LT_MUL THEN
3201   ASM_REWRITE_TAC[REAL_LT_SUB_LADD; REAL_ADD_LID] THEN
3202   REWRITE_TAC[REAL_LT_INV_EQ] THEN
3203   MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> &0 < &1 + x`) THEN
3204   REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE]);;
3205
3206 let ATN_MONO_LT_EQ = prove
3207  (`!x y. atn(x) < atn(y) <=> x < y`,
3208   MESON_TAC[REAL_NOT_LE; REAL_LE_LT; ATN_MONO_LT]);;
3209
3210 let ATN_MONO_LE_EQ = prove
3211  (`!x y. atn(x) <= atn(y) <=> x <= y`,
3212   REWRITE_TAC[GSYM REAL_NOT_LT; ATN_MONO_LT_EQ]);;
3213
3214 let ATN_INJ = prove
3215  (`!x y. (atn x = atn y) <=> (x = y)`,
3216   REWRITE_TAC[GSYM REAL_LE_ANTISYM; ATN_MONO_LE_EQ]);;
3217
3218 let ATN_POS_LT = prove
3219  (`&0 < atn(x) <=> &0 < x`,
3220   MESON_TAC[ATN_0; ATN_MONO_LT_EQ]);;
3221
3222 let ATN_POS_LE = prove
3223  (`&0 <= atn(x) <=> &0 <= x`,
3224   MESON_TAC[ATN_0; ATN_MONO_LE_EQ]);;
3225
3226 let ATN_LT_PI4_POS = prove
3227  (`!x. x < &1 ==> atn(x) < pi / &4`,
3228   SIMP_TAC[GSYM ATN_1; ATN_MONO_LT]);;
3229
3230 let ATN_LT_PI4_NEG = prove
3231  (`!x. --(&1) < x ==> --(pi / &4) < atn(x)`,
3232   SIMP_TAC[GSYM ATN_1; GSYM ATN_NEG; ATN_MONO_LT]);;
3233
3234 let ATN_LT_PI4 = prove
3235  (`!x. abs(x) < &1 ==> abs(atn x) < pi / &4`,
3236   GEN_TAC THEN
3237   MATCH_MP_TAC(REAL_ARITH
3238    `(&0 < x ==> &0 < y) /\
3239     (x < &0 ==> y < &0) /\
3240     ((x = &0) ==> (y = &0)) /\
3241     (x < a ==> y < b) /\
3242     (--a < x ==> --b < y)
3243     ==> abs(x) < a ==> abs(y) < b`) THEN
3244   SIMP_TAC[ATN_LT_PI4_POS; ATN_LT_PI4_NEG; ATN_0] THEN CONJ_TAC THEN
3245   GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM ATN_0] THEN
3246   SIMP_TAC[ATN_MONO_LT]);;
3247
3248 let ATN_LE_PI4 = prove
3249  (`!x. abs(x) <= &1 ==> abs(atn x) <= pi / &4`,
3250   REWRITE_TAC[REAL_LE_LT] THEN REPEAT STRIP_TAC THEN
3251   ASM_SIMP_TAC[ATN_LT_PI4] THEN DISJ2_TAC THEN
3252   FIRST_ASSUM(DISJ_CASES_THEN SUBST1_TAC o MATCH_MP
3253     (REAL_ARITH `(abs(x) = a) ==> (x = a) \/ (x = --a)`)) THEN
3254   ASM_REWRITE_TAC[ATN_1; ATN_NEG] THEN
3255   REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_ABS_NEG] THEN
3256   SIMP_TAC[real_abs; REAL_LT_IMP_LE; PI_POS]);;
3257
3258 (* ------------------------------------------------------------------------- *)
3259 (* Differentiation of arcsin.                                                *)
3260 (* ------------------------------------------------------------------------- *)
3261
3262 let COS_SIN_SQRT = prove(
3263   `!x. &0 <= cos(x) ==> (cos(x) = sqrt(&1 - (sin(x) pow 2)))`,
3264   GEN_TAC THEN DISCH_TAC THEN
3265   MP_TAC (ONCE_REWRITE_RULE[REAL_ADD_SYM] (SPEC `x:real` SIN_CIRCLE)) THEN
3266   REWRITE_TAC[GSYM REAL_EQ_SUB_LADD] THEN
3267   DISCH_THEN(SUBST1_TAC o SYM) THEN
3268   REWRITE_TAC[sqrt; num_CONV `2`] THEN
3269   CONV_TAC SYM_CONV THEN MATCH_MP_TAC POW_ROOT_POS THEN
3270   ASM_REWRITE_TAC[]);;
3271
3272 let COS_ASN_NZ = prove(
3273   `!x. --(&1) < x /\ x < &1 ==> ~(cos(asn(x)) = &0)`,
3274   GEN_TAC THEN DISCH_TAC THEN
3275   FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP ASN_BOUNDS_LT) THEN
3276   REWRITE_TAC[COS_ZERO; DE_MORGAN_THM] THEN
3277   CONJ_TAC THEN CONV_TAC NOT_EXISTS_CONV THEN
3278   X_GEN_TAC `n:num` THEN STRUCT_CASES_TAC(SPEC `n:num` num_CASES) THEN
3279   REWRITE_TAC[EVEN] THEN STRIP_TAC THENL
3280    [UNDISCH_TAC `asn(x) < (pi / &2)` THEN ASM_REWRITE_TAC[];
3281     UNDISCH_TAC `--(pi / &2) < asn(x)` THEN ASM_REWRITE_TAC[] THEN
3282     REWRITE_TAC[REAL_LT_NEG]] THEN
3283   REWRITE_TAC[ADD1; GSYM REAL_ADD; REAL_RDISTRIB; REAL_MUL_LID] THEN
3284   REWRITE_TAC[GSYM REAL_NOT_LE; REAL_LE_ADDL] THEN
3285   MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_LE; LE_0] THEN
3286   MATCH_MP_TAC REAL_LT_IMP_LE THEN REWRITE_TAC[PI2_BOUNDS]);;
3287
3288 let DIFF_ASN_COS = prove(
3289   `!x. --(&1) < x /\ x < &1 ==> (asn diffl (inv(cos(asn x))))(x)`,
3290   REPEAT STRIP_TAC THEN
3291   EVERY_ASSUM(ASSUME_TAC o MATCH_MP REAL_LT_IMP_LE) THEN
3292   MP_TAC(SPEC `x:real` ASN_SIN) THEN ASM_REWRITE_TAC[] THEN
3293   DISCH_TAC THEN
3294   FIRST_ASSUM(fun th ->  GEN_REWRITE_TAC RAND_CONV  [GSYM th]) THEN
3295   MATCH_MP_TAC DIFF_INVERSE_LT THEN
3296   MP_TAC(SPEC `x:real` ASN_BOUNDS_LT) THEN ASM_REWRITE_TAC[] THEN
3297   DISCH_THEN(fun th ->  STRIP_ASSUME_TAC th THEN
3298     MP_TAC(MATCH_MP INTERVAL_LEMMA_LT th)) THEN
3299   DISCH_THEN(X_CHOOSE_THEN `d:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
3300   DISCH_THEN(ASSUME_TAC o ONCE_REWRITE_RULE[ABS_SUB]) THEN
3301   EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THENL
3302    [MATCH_MP_TAC SIN_ASN THEN
3303     FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN
3304     DISCH_THEN(MP_TAC o SPEC `z:real`) THEN ASM_REWRITE_TAC[] THEN
3305     DISCH_TAC THEN CONJ_TAC THEN
3306     MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[];
3307     MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC `cos(z)` THEN
3308     REWRITE_TAC[DIFF_SIN];
3309     REWRITE_TAC[DIFF_SIN];
3310     POP_ASSUM MP_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC COS_ASN_NZ THEN
3311     ASM_REWRITE_TAC[]]);;
3312
3313 let DIFF_ASN = prove(
3314   `!x. --(&1) < x /\ x < &1 ==> (asn diffl (inv(sqrt(&1 - (x pow 2)))))(x)`,
3315   GEN_TAC THEN DISCH_TAC THEN
3316   FIRST_ASSUM(MP_TAC o MATCH_MP DIFF_ASN_COS) THEN
3317   MATCH_MP_TAC EQ_IMP THEN
3318   AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
3319   SUBGOAL_THEN `sin(asn x) = x` MP_TAC THENL
3320    [MATCH_MP_TAC ASN_SIN THEN CONJ_TAC THEN
3321     MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[];
3322     DISCH_THEN(fun th ->  GEN_REWRITE_TAC
3323       (RAND_CONV o ONCE_DEPTH_CONV)  [GSYM th]) THEN
3324     MATCH_MP_TAC COS_SIN_SQRT THEN
3325     FIRST_ASSUM(ASSUME_TAC o MATCH_MP ASN_BOUNDS_LT) THEN
3326     MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC COS_POS_PI THEN
3327     ASM_REWRITE_TAC[]]);;
3328
3329 let DIFF_ASN_COMPOSITE = prove
3330  (`(g diffl m)(x) /\ -- &1 < g(x) /\ g(x) < &1
3331    ==> ((\x. asn(g x)) diffl (inv(sqrt (&1 - g(x) pow 2)) * m))(x)`,
3332   ASM_SIMP_TAC[DIFF_CHAIN; DIFF_ASN]) in
3333 add_to_diff_net DIFF_ASN_COMPOSITE;;
3334
3335 (* ------------------------------------------------------------------------- *)
3336 (* Differentiation of arccos.                                                *)
3337 (* ------------------------------------------------------------------------- *)
3338
3339 let SIN_COS_SQRT = prove(
3340   `!x. &0 <= sin(x) ==> (sin(x) = sqrt(&1 - (cos(x) pow 2)))`,
3341   GEN_TAC THEN DISCH_TAC THEN
3342   MP_TAC (SPEC `x:real` SIN_CIRCLE) THEN
3343   REWRITE_TAC[GSYM REAL_EQ_SUB_LADD] THEN
3344   DISCH_THEN(SUBST1_TAC o SYM) THEN
3345   REWRITE_TAC[sqrt; num_CONV `2`] THEN
3346   CONV_TAC SYM_CONV THEN MATCH_MP_TAC POW_ROOT_POS THEN
3347   ASM_REWRITE_TAC[]);;
3348
3349 let SIN_ACS_NZ = prove(
3350   `!x. --(&1) < x /\ x < &1 ==> ~(sin(acs(x)) = &0)`,
3351   GEN_TAC THEN DISCH_TAC THEN
3352   FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP ACS_BOUNDS_LT) THEN
3353   REWRITE_TAC[SIN_ZERO; REAL_NEG_EQ0] THEN
3354   REWRITE_TAC[DE_MORGAN_THM] THEN
3355   CONJ_TAC THEN CONV_TAC NOT_EXISTS_CONV THEN
3356   (INDUCT_TAC THENL
3357     [REWRITE_TAC[REAL_MUL_LZERO; EVEN; REAL_NEG_0] THEN
3358      DISCH_THEN SUBST_ALL_TAC THEN
3359      RULE_ASSUM_TAC(REWRITE_RULE[REAL_LT_REFL]) THEN
3360      CONTR_TAC(ASSUME `F`); ALL_TAC] THEN
3361    SPEC_TAC(`n:num`,`n:num`) THEN REWRITE_TAC[EVEN] THEN
3362    INDUCT_TAC THEN REWRITE_TAC[EVEN] THEN STRIP_TAC) THENL
3363     [UNDISCH_TAC `acs(x) < pi` THEN
3364      ASM_REWRITE_TAC[ADD1; GSYM REAL_ADD; REAL_RDISTRIB] THEN
3365      REWRITE_TAC[REAL_MUL_LID; GSYM REAL_ADD_ASSOC] THEN
3366      REWRITE_TAC[REAL_HALF_DOUBLE] THEN
3367      REWRITE_TAC[GSYM REAL_NOT_LE; REAL_LE_ADDL] THEN
3368      MATCH_MP_TAC REAL_LE_MUL THEN
3369      REWRITE_TAC[REAL_LE; LE_0] THEN
3370      MATCH_MP_TAC REAL_LT_IMP_LE THEN REWRITE_TAC[PI2_BOUNDS];
3371      UNDISCH_TAC `&0 < acs(x)` THEN ASM_REWRITE_TAC[] THEN
3372      REWRITE_TAC[REAL_NOT_LT] THEN ONCE_REWRITE_TAC[GSYM REAL_LE_NEG] THEN
3373      REWRITE_TAC[REAL_NEGNEG; REAL_NEG_LMUL; REAL_NEG_0] THEN
3374      MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_LE; LE_0] THEN
3375      MATCH_MP_TAC REAL_LT_IMP_LE THEN REWRITE_TAC[PI2_BOUNDS]]);;
3376
3377 let DIFF_ACS_SIN = prove(
3378   `!x. --(&1) < x /\ x < &1 ==> (acs diffl (inv(--(sin(acs x)))))(x)`,
3379   REPEAT STRIP_TAC THEN
3380   EVERY_ASSUM(ASSUME_TAC o MATCH_MP REAL_LT_IMP_LE) THEN
3381   MP_TAC(SPEC `x:real` ACS_COS) THEN ASM_REWRITE_TAC[] THEN
3382   DISCH_TAC THEN
3383   FIRST_ASSUM(fun th ->  GEN_REWRITE_TAC RAND_CONV  [GSYM th]) THEN
3384   MATCH_MP_TAC DIFF_INVERSE_LT THEN
3385   MP_TAC(SPEC `x:real` ACS_BOUNDS_LT) THEN ASM_REWRITE_TAC[] THEN
3386   DISCH_THEN(fun th ->  STRIP_ASSUME_TAC th THEN
3387     MP_TAC(MATCH_MP INTERVAL_LEMMA_LT th)) THEN
3388   DISCH_THEN(X_CHOOSE_THEN `d:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
3389   DISCH_THEN(ASSUME_TAC o ONCE_REWRITE_RULE[ABS_SUB]) THEN
3390   EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THENL
3391    [MATCH_MP_TAC COS_ACS THEN
3392     FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN
3393     DISCH_THEN(MP_TAC o SPEC `z:real`) THEN ASM_REWRITE_TAC[] THEN
3394     DISCH_TAC THEN CONJ_TAC THEN
3395     MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[];
3396     MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC `--(sin(z))` THEN
3397     REWRITE_TAC[DIFF_COS];
3398     REWRITE_TAC[DIFF_COS];
3399     POP_ASSUM MP_TAC THEN REWRITE_TAC[] THEN
3400     ONCE_REWRITE_TAC[GSYM REAL_EQ_NEG] THEN
3401     REWRITE_TAC[REAL_NEGNEG; REAL_NEG_0] THEN
3402     MATCH_MP_TAC SIN_ACS_NZ THEN ASM_REWRITE_TAC[]]);;
3403
3404 let DIFF_ACS = prove(
3405   `!x. --(&1) < x /\ x < &1 ==> (acs diffl --(inv(sqrt(&1 - (x pow 2)))))(x)`,
3406   GEN_TAC THEN DISCH_TAC THEN
3407   FIRST_ASSUM(MP_TAC o MATCH_MP DIFF_ACS_SIN) THEN
3408   MATCH_MP_TAC EQ_IMP THEN
3409   AP_THM_TAC THEN AP_TERM_TAC THEN
3410   IMP_SUBST_TAC (GSYM REAL_NEG_INV) THENL
3411    [CONV_TAC(RAND_CONV SYM_CONV) THEN
3412     MATCH_MP_TAC SIN_ACS_NZ THEN ASM_REWRITE_TAC[];
3413     REPEAT AP_TERM_TAC] THEN
3414   SUBGOAL_THEN `cos(acs x) = x` MP_TAC THENL
3415    [MATCH_MP_TAC ACS_COS THEN CONJ_TAC THEN
3416     MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[];
3417     DISCH_THEN(fun th ->  GEN_REWRITE_TAC
3418       (RAND_CONV o ONCE_DEPTH_CONV)  [GSYM th]) THEN
3419     MATCH_MP_TAC SIN_COS_SQRT THEN
3420     FIRST_ASSUM(ASSUME_TAC o MATCH_MP ACS_BOUNDS_LT) THEN
3421     MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC SIN_POS_PI THEN
3422     ASM_REWRITE_TAC[]]);;
3423
3424 let DIFF_ACS_COMPOSITE = prove
3425  (`(g diffl m)(x) /\ -- &1 < g(x) /\ g(x) < &1
3426    ==> ((\x. acs(g x)) diffl (--inv(sqrt(&1 - g(x) pow 2)) * m))(x)`,
3427   ASM_SIMP_TAC[DIFF_CHAIN; DIFF_ACS]) in
3428 add_to_diff_net DIFF_ACS_COMPOSITE;;
3429
3430 (* ------------------------------------------------------------------------- *)
3431 (* Back to normal service!                                                   *)
3432 (* ------------------------------------------------------------------------- *)
3433
3434 extend_basic_rewrites [BETA_THM];;
3435
3436 (* ------------------------------------------------------------------------- *)
3437 (* A kind of inverse to SIN_CIRCLE                                           *)
3438 (* ------------------------------------------------------------------------- *)
3439
3440 let CIRCLE_SINCOS = prove
3441  (`!x y. (x pow 2 + y pow 2 = &1) ==> ?t. (x = cos(t)) /\ (y = sin(t))`,
3442   REPEAT STRIP_TAC THEN
3443   SUBGOAL_THEN `abs(x) <= &1 /\ abs(y) <= &1` STRIP_ASSUME_TAC THENL
3444    [MATCH_MP_TAC(REAL_ARITH
3445      `(&1 < x ==> &1 < x pow 2) /\ (&1 < y ==> &1 < y pow 2) /\
3446       &0 <= x pow 2 /\ &0 <= y pow 2 /\ x pow 2 + y pow 2 <= &1
3447       ==> x <= &1 /\ y <= &1`) THEN
3448     ASM_REWRITE_TAC[REAL_POW2_ABS; REAL_LE_REFL] THEN
3449     REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE] THEN
3450     REWRITE_TAC[GSYM REAL_POW_2] THEN
3451     ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN REWRITE_TAC[REAL_POW_2] THEN
3452     CONJ_TAC THEN DISCH_TAC THEN
3453     SUBST1_TAC(SYM(REAL_RAT_REDUCE_CONV `&1 * &1`)) THEN
3454     MATCH_MP_TAC REAL_LT_MUL2 THEN ASM_REWRITE_TAC[REAL_POS];
3455     ALL_TAC] THEN
3456   SUBGOAL_THEN `&0 <= sin(acs x)` MP_TAC THENL
3457    [MATCH_MP_TAC SIN_POS_PI_LE THEN
3458     MATCH_MP_TAC ACS_BOUNDS THEN
3459     POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REAL_ARITH_TAC;
3460     ALL_TAC] THEN
3461   DISCH_THEN(ASSUME_TAC o MATCH_MP SIN_COS_SQRT) THEN
3462   SUBGOAL_THEN `abs(y) = sqrt(&1 - x pow 2)` ASSUME_TAC THENL
3463    [REWRITE_TAC[GSYM POW_2_SQRT_ABS] THEN AP_TERM_TAC THEN
3464     UNDISCH_TAC `x pow 2 + y pow 2 = &1` THEN REAL_ARITH_TAC;
3465     ALL_TAC] THEN
3466   ASM_CASES_TAC `&0 <= y` THENL
3467    [EXISTS_TAC `acs x`; EXISTS_TAC `--(acs x)`] THEN
3468   ASM_SIMP_TAC[COS_NEG; SIN_NEG; ACS_COS; REAL_ARITH
3469    `abs(x) <= &1 ==> --(&1) <= x /\ x <= &1`]
3470   THENL
3471    [MATCH_MP_TAC(REAL_ARITH `&0 <= y /\ (abs(y) = x) ==> (y = x)`);
3472     MATCH_MP_TAC(REAL_ARITH `~(&0 <= y) /\ (abs(y) = x) ==> (y = --x)`)] THEN
3473   ASM_REWRITE_TAC[]);;
3474
3475 (* ------------------------------------------------------------------------- *)
3476 (* More lemmas.                                                              *)
3477 (* ------------------------------------------------------------------------- *)
3478
3479 let ACS_MONO_LT = prove
3480  (`!x y. --(&1) < x /\ x < y /\ y < &1 ==> acs(y) < acs(x)`,
3481   REPEAT STRIP_TAC THEN
3482   MP_TAC(SPECL [`acs`; `\x. --inv(sqrt(&1 - x pow 2))`; `x:real`; `y:real`]
3483                MVT_ALT) THEN
3484   ANTS_TAC THENL
3485    [REPEAT STRIP_TAC THEN ASM_SIMP_TAC[] THEN
3486     MATCH_MP_TAC DIFF_ACS THEN
3487     ASM_MESON_TAC[REAL_LET_TRANS; REAL_LTE_TRANS];
3488     REWRITE_TAC[REAL_EQ_SUB_RADD]] THEN
3489   DISCH_THEN(X_CHOOSE_THEN `z:real` STRIP_ASSUME_TAC) THEN
3490   ASM_REWRITE_TAC[REAL_ARITH `a * --c + x < x <=> &0 < a * c`] THEN
3491   MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN
3492   MATCH_MP_TAC REAL_LT_INV THEN MATCH_MP_TAC SQRT_POS_LT THEN
3493   ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN REWRITE_TAC[REAL_POW_2] THEN
3494   REWRITE_TAC[REAL_ARITH `&0 < &1 - z * z <=> z * z < &1 * &1`] THEN
3495   MATCH_MP_TAC REAL_LT_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN
3496   POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REAL_ARITH_TAC);;
3497
3498 (* ======================================================================== *)
3499 (* Formalization of Kurzweil-Henstock gauge integral                        *)
3500 (* ======================================================================== *)
3501
3502 let LE_MATCH_TAC th (asl,w) =
3503   let thi = PART_MATCH (rand o rator) th (rand(rator w)) in
3504   let tm = rand(concl thi) in
3505   (MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC tm THEN CONJ_TAC THENL
3506     [MATCH_ACCEPT_TAC th; ALL_TAC]) (asl,w);;
3507
3508 (* ------------------------------------------------------------------------ *)
3509 (* Some miscellaneous lemmas                                                *)
3510 (* ------------------------------------------------------------------------ *)
3511
3512 let LESS_SUC_EQ = prove(
3513   `!m n. m < SUC n <=> m <= n`,
3514   REPEAT GEN_TAC THEN REWRITE_TAC[CONJUNCT2 LT; LE_LT] THEN
3515   EQ_TAC THEN DISCH_THEN(DISJ_CASES_THEN(fun th -> REWRITE_TAC[th])));;
3516
3517 let LESS_1 = prove(
3518   `!n. n < 1 <=> (n = 0)`,
3519   REWRITE_TAC[num_CONV `1`; LESS_SUC_EQ; CONJUNCT1 LE]);;
3520
3521 (* ------------------------------------------------------------------------ *)
3522 (* Divisions and tagged divisions etc.                                      *)
3523 (* ------------------------------------------------------------------------ *)
3524
3525 let division = new_definition
3526   `division(a,b) D <=>
3527      (D 0 = a) /\
3528      (?N. (!n. n < N ==> D(n) < D(SUC n)) /\
3529           (!n. n >= N ==> (D(n) = b)))`;;
3530
3531 let dsize = new_definition
3532   `dsize D =
3533       @N. (!n. n < N ==> D(n) < D(SUC n)) /\
3534           (!n. n >= N ==> (D(n) = D(N)))`;;
3535
3536 let tdiv = new_definition
3537   `tdiv(a,b) (D,p) <=>
3538      division(a,b) D /\
3539      (!n. D(n) <= p(n) /\ p(n) <= D(SUC n))`;;
3540
3541 (* ------------------------------------------------------------------------ *)
3542 (* Gauges and gauge-fine divisions                                          *)
3543 (* ------------------------------------------------------------------------ *)
3544
3545 let gauge = new_definition
3546   `gauge(E) (g:real->real) <=> !x. E x ==> &0 < g(x)`;;
3547
3548 let fine = new_definition
3549   `fine(g:real->real) (D,p) <=>
3550      !n. n < (dsize D) ==> (D(SUC n) - D(n)) < g(p(n))`;;
3551
3552 (* ------------------------------------------------------------------------ *)
3553 (* Riemann sum                                                              *)
3554 (* ------------------------------------------------------------------------ *)
3555
3556 let rsum = new_definition
3557   `rsum (D,(p:num->real)) f =
3558         sum(0,dsize(D))(\n. f(p n) * (D(SUC n) - D(n)))`;;
3559
3560 (* ------------------------------------------------------------------------ *)
3561 (* Gauge integrability (definite)                                           *)
3562 (* ------------------------------------------------------------------------ *)
3563
3564 let defint = new_definition
3565   `defint(a,b) f k <=>
3566      !e. &0 < e ==>
3567         ?g. gauge(\x. a <= x /\ x <= b) g /\
3568             !D p. tdiv(a,b) (D,p) /\ fine(g)(D,p) ==>
3569                 abs(rsum(D,p) f - k) < e`;;
3570
3571 (* ------------------------------------------------------------------------ *)
3572 (* Useful lemmas about the size of `trivial` divisions etc.                 *)
3573 (* ------------------------------------------------------------------------ *)
3574
3575 let DIVISION_0 = prove(
3576   `!a b. (a = b) ==> (dsize(\n. if (n = 0) then a else b) = 0)`,
3577   REPEAT GEN_TAC THEN DISCH_THEN SUBST_ALL_TAC THEN REWRITE_TAC[COND_ID] THEN
3578   REWRITE_TAC[dsize] THEN MATCH_MP_TAC SELECT_UNIQUE THEN
3579   X_GEN_TAC `n:num` THEN BETA_TAC THEN
3580   REWRITE_TAC[REAL_LT_REFL; NOT_LT] THEN EQ_TAC THENL
3581    [DISCH_THEN(MP_TAC o SPEC `0`) THEN REWRITE_TAC[CONJUNCT1 LE];
3582     DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[LE_0]]);;
3583
3584 let DIVISION_1 = prove(
3585   `!a b. a < b ==> (dsize(\n. if (n = 0) then a else b) = 1)`,
3586   REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[dsize] THEN
3587   MATCH_MP_TAC SELECT_UNIQUE THEN X_GEN_TAC `n:num` THEN BETA_TAC THEN
3588   REWRITE_TAC[NOT_SUC] THEN EQ_TAC THENL
3589    [DISCH_TAC THEN MATCH_MP_TAC LESS_EQUAL_ANTISYM THEN CONJ_TAC THENL
3590      [POP_ASSUM(MP_TAC o SPEC `1` o CONJUNCT1) THEN
3591       REWRITE_TAC[ARITH] THEN
3592       REWRITE_TAC[REAL_LT_REFL; NOT_LT];
3593       POP_ASSUM(MP_TAC o SPEC `2` o CONJUNCT2) THEN
3594       REWRITE_TAC[num_CONV `2`; GE] THEN
3595       CONV_TAC CONTRAPOS_CONV THEN
3596       REWRITE_TAC[num_CONV `1`; NOT_SUC_LESS_EQ; CONJUNCT1 LE] THEN
3597       DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[NOT_SUC; NOT_IMP] THEN
3598       REWRITE_TAC[LE_0] THEN CONV_TAC(RAND_CONV SYM_CONV) THEN
3599       MATCH_MP_TAC REAL_LT_IMP_NE THEN POP_ASSUM ACCEPT_TAC];
3600     DISCH_THEN SUBST1_TAC THEN CONJ_TAC THENL
3601      [GEN_TAC THEN REWRITE_TAC[num_CONV `1`; CONJUNCT2 LT; NOT_LESS_0] THEN
3602       DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[];
3603       X_GEN_TAC `n:num` THEN REWRITE_TAC[GE; num_CONV `1`] THEN
3604       ASM_CASES_TAC `n = 0` THEN
3605       ASM_REWRITE_TAC[CONJUNCT1 LE; GSYM NOT_SUC; NOT_SUC]]]);;
3606
3607 let DIVISION_SINGLE = prove(
3608   `!a b. a <= b ==> division(a,b)(\n. if (n = 0) then a else b)`,
3609   REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[division] THEN
3610   BETA_TAC THEN REWRITE_TAC[] THEN
3611   POP_ASSUM(DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT]) THENL
3612    [EXISTS_TAC `1` THEN CONJ_TAC THEN X_GEN_TAC `n:num` THENL
3613      [REWRITE_TAC[LESS_1] THEN DISCH_THEN SUBST1_TAC THEN
3614       ASM_REWRITE_TAC[NOT_SUC];
3615       REWRITE_TAC[GE] THEN
3616       COND_CASES_TAC THEN ASM_REWRITE_TAC[num_CONV `1`] THEN
3617       REWRITE_TAC[GSYM NOT_LT; LESS_SUC_REFL]];
3618     EXISTS_TAC `0` THEN REWRITE_TAC[NOT_LESS_0] THEN
3619     ASM_REWRITE_TAC[COND_ID]]);;
3620
3621 let DIVISION_LHS = prove(
3622   `!D a b. division(a,b) D ==> (D(0) = a)`,
3623   REPEAT GEN_TAC THEN REWRITE_TAC[division] THEN
3624   DISCH_THEN(fun th -> REWRITE_TAC[th]));;
3625
3626 let DIVISION_THM = prove(
3627   `!D a b. division(a,b) D <=>
3628         (D(0) = a) /\
3629         (!n. n < (dsize D) ==> D(n) < D(SUC n)) /\
3630         (!n. n >= (dsize D) ==> (D(n) = b))`,
3631   REPEAT GEN_TAC THEN REWRITE_TAC[division] THEN
3632   EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THENL
3633    [ALL_TAC; EXISTS_TAC `dsize D` THEN ASM_REWRITE_TAC[]] THEN
3634   POP_ASSUM(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC o CONJUNCT2) THEN
3635   SUBGOAL_THEN `dsize D = N` (fun th -> ASM_REWRITE_TAC[th]) THEN
3636   REWRITE_TAC[dsize] THEN MATCH_MP_TAC SELECT_UNIQUE THEN
3637   X_GEN_TAC `M:num` THEN BETA_TAC THEN EQ_TAC THENL
3638    [ALL_TAC; DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[] THEN
3639     MP_TAC(SPEC `N:num` (ASSUME `!n:num. n >= N ==> (D n :real = b)`)) THEN
3640     DISCH_THEN(MP_TAC o REWRITE_RULE[GE; LE_REFL]) THEN
3641     DISCH_THEN SUBST1_TAC THEN FIRST_ASSUM MATCH_ACCEPT_TAC] THEN
3642   REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC
3643    (SPECL [`M:num`; `N:num`] LESS_LESS_CASES) THEN
3644   ASM_REWRITE_TAC[] THENL
3645    [DISCH_THEN(MP_TAC o SPEC `SUC M` o CONJUNCT2) THEN
3646     REWRITE_TAC[GE; LESS_EQ_SUC_REFL] THEN DISCH_TAC THEN
3647     UNDISCH_TAC `!n. n < N ==> (D n) < (D(SUC n))` THEN
3648     DISCH_THEN(MP_TAC o SPEC `M:num`) THEN ASM_REWRITE_TAC[REAL_LT_REFL];
3649     DISCH_THEN(MP_TAC o SPEC `N:num` o CONJUNCT1) THEN ASM_REWRITE_TAC[] THEN
3650     UNDISCH_TAC `!n:num. n >= N ==> (D n :real = b)` THEN
3651     DISCH_THEN(fun th -> MP_TAC(SPEC `N:num` th) THEN
3652     MP_TAC(SPEC `SUC N` th)) THEN
3653     REWRITE_TAC[GE; LESS_EQ_SUC_REFL; LE_REFL] THEN
3654     DISCH_THEN SUBST1_TAC THEN DISCH_THEN SUBST1_TAC THEN
3655     REWRITE_TAC[REAL_LT_REFL]]);;
3656
3657 let DIVISION_RHS = prove(
3658   `!D a b. division(a,b) D ==> (D(dsize D) = b)`,
3659   REPEAT GEN_TAC THEN REWRITE_TAC[DIVISION_THM] THEN
3660   DISCH_THEN(MP_TAC o SPEC `dsize D` o last o CONJUNCTS) THEN
3661   REWRITE_TAC[GE; LE_REFL]);;
3662
3663 let DIVISION_LT_GEN = prove(
3664   `!D a b m n. division(a,b) D /\
3665                m < n /\
3666                n <= (dsize D) ==> D(m) < D(n)`,
3667   REPEAT STRIP_TAC THEN UNDISCH_TAC `m:num < n` THEN
3668   DISCH_THEN(X_CHOOSE_THEN `d:num` MP_TAC o MATCH_MP LESS_ADD_1) THEN
3669   REWRITE_TAC[GSYM ADD1] THEN DISCH_THEN SUBST_ALL_TAC THEN
3670   UNDISCH_TAC `(m + (SUC d)) <= (dsize D)` THEN
3671   SPEC_TAC(`d:num`,`d:num`) THEN INDUCT_TAC THENL
3672    [REWRITE_TAC[ADD_CLAUSES] THEN
3673     DISCH_THEN(MP_TAC o MATCH_MP OR_LESS) THEN
3674     RULE_ASSUM_TAC(REWRITE_RULE[DIVISION_THM]) THEN
3675     ASM_REWRITE_TAC[];
3676     REWRITE_TAC[ADD_CLAUSES] THEN
3677     DISCH_THEN(MP_TAC o MATCH_MP OR_LESS) THEN
3678     DISCH_TAC THEN MATCH_MP_TAC REAL_LT_TRANS THEN
3679     EXISTS_TAC `D(m + (SUC d)):real` THEN CONJ_TAC THENL
3680      [FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[ADD_CLAUSES] THEN
3681       MATCH_MP_TAC LT_IMP_LE THEN ASM_REWRITE_TAC[];
3682       REWRITE_TAC[ADD_CLAUSES] THEN
3683       FIRST_ASSUM(MATCH_MP_TAC o el 1 o
3684         CONJUNCTS o REWRITE_RULE[DIVISION_THM]) THEN
3685       ASM_REWRITE_TAC[]]]);;
3686
3687 let DIVISION_LT = prove(
3688   `!D a b. division(a,b) D ==> !n. n < (dsize D) ==> D(0) < D(SUC n)`,
3689   REPEAT GEN_TAC THEN REWRITE_TAC[DIVISION_THM] THEN STRIP_TAC THEN
3690   INDUCT_TAC THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN
3691       FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN
3692   ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
3693   MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `D(SUC n):real` THEN
3694   ASM_REWRITE_TAC[] THEN UNDISCH_TAC `D(0):real = a` THEN
3695   DISCH_THEN(SUBST1_TAC o SYM) THEN FIRST_ASSUM MATCH_MP_TAC THEN
3696   MATCH_MP_TAC LT_TRANS THEN EXISTS_TAC `SUC n` THEN
3697   ASM_REWRITE_TAC[LESS_SUC_REFL]);;
3698
3699 let DIVISION_LE = prove(
3700   `!D a b. division(a,b) D ==> a <= b`,
3701   REPEAT GEN_TAC THEN DISCH_TAC THEN
3702   FIRST_ASSUM(MP_TAC o MATCH_MP DIVISION_LT) THEN
3703   POP_ASSUM(STRIP_ASSUME_TAC o REWRITE_RULE[DIVISION_THM]) THEN
3704   UNDISCH_TAC `D(0):real = a` THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
3705   UNDISCH_TAC `!n. n >= (dsize D) ==> (D n = b)` THEN
3706   DISCH_THEN(MP_TAC o SPEC `dsize D`) THEN
3707   REWRITE_TAC[GE; LE_REFL] THEN
3708   DISCH_THEN(SUBST1_TAC o SYM) THEN
3709   DISCH_THEN(MP_TAC o SPEC `PRE(dsize D)`) THEN
3710   STRUCT_CASES_TAC(SPEC `dsize D` num_CASES) THEN
3711   ASM_REWRITE_TAC[PRE; REAL_LE_REFL; LESS_SUC_REFL; REAL_LT_IMP_LE]);;
3712
3713 let DIVISION_GT = prove(
3714   `!D a b. division(a,b) D ==> !n. n < (dsize D) ==> D(n) < D(dsize D)`,
3715   REPEAT STRIP_TAC THEN MATCH_MP_TAC DIVISION_LT_GEN THEN
3716   MAP_EVERY EXISTS_TAC [`a:real`; `b:real`] THEN
3717   ASM_REWRITE_TAC[LE_REFL]);;
3718
3719 let DIVISION_EQ = prove(
3720   `!D a b. division(a,b) D ==> ((a = b) <=> (dsize D = 0))`,
3721   REPEAT GEN_TAC THEN DISCH_TAC THEN
3722   FIRST_ASSUM(MP_TAC o MATCH_MP DIVISION_LT) THEN
3723   POP_ASSUM(STRIP_ASSUME_TAC o REWRITE_RULE[DIVISION_THM]) THEN
3724   UNDISCH_TAC `D(0):real = a` THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
3725   UNDISCH_TAC `!n. n >= (dsize D) ==> (D n = b)` THEN
3726   DISCH_THEN(MP_TAC o SPEC `dsize D`) THEN
3727   REWRITE_TAC[GE; LE_REFL] THEN
3728   DISCH_THEN(SUBST1_TAC o SYM) THEN
3729   DISCH_THEN(MP_TAC o SPEC `PRE(dsize D)`) THEN
3730   STRUCT_CASES_TAC(SPEC `dsize D` num_CASES) THEN
3731   ASM_REWRITE_TAC[PRE; NOT_SUC; LESS_SUC_REFL; REAL_LT_IMP_NE]);;
3732
3733 let DIVISION_LBOUND = prove(
3734   `!D a b r. division(a,b) D ==> a <= D(r)`,
3735   REWRITE_TAC[DIVISION_THM; RIGHT_FORALL_IMP_THM] THEN
3736   REPEAT GEN_TAC THEN STRIP_TAC THEN
3737   INDUCT_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN
3738   DISJ_CASES_TAC(SPECL [`SUC r`; `dsize D`] LTE_CASES) THENL
3739    [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(D:num->real) r` THEN
3740     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN
3741     FIRST_ASSUM MATCH_MP_TAC THEN
3742     MATCH_MP_TAC LT_TRANS THEN EXISTS_TAC `SUC r` THEN
3743     ASM_REWRITE_TAC[LESS_SUC_REFL];
3744     MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `b:real` THEN CONJ_TAC THENL
3745      [MATCH_MP_TAC DIVISION_LE THEN
3746       EXISTS_TAC `D:num->real` THEN ASM_REWRITE_TAC[DIVISION_THM];
3747       MATCH_MP_TAC REAL_EQ_IMP_LE THEN CONV_TAC SYM_CONV THEN
3748       FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[GE]]]);;
3749
3750 let DIVISION_LBOUND_LT = prove(
3751   `!D a b n. division(a,b) D /\ ~(dsize D = 0) ==> a < D(SUC n)`,
3752   REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REPEAT STRIP_TAC THEN
3753   FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP DIVISION_LHS) THEN
3754   DISJ_CASES_TAC(SPECL [`dsize D`; `SUC n`] LTE_CASES) THENL
3755    [FIRST_ASSUM(MP_TAC o el 2 o CONJUNCTS o REWRITE_RULE[DIVISION_THM]) THEN
3756     DISCH_THEN(MP_TAC o SPEC `SUC n`) THEN REWRITE_TAC[GE] THEN
3757     IMP_RES_THEN ASSUME_TAC LT_IMP_LE THEN ASM_REWRITE_TAC[] THEN
3758     DISCH_THEN SUBST1_TAC THEN
3759     FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP DIVISION_RHS) THEN
3760     FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP DIVISION_GT) THEN
3761     ASM_REWRITE_TAC[GSYM NOT_LE; CONJUNCT1 LE];
3762     FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP DIVISION_LT) THEN
3763     MATCH_MP_TAC OR_LESS THEN ASM_REWRITE_TAC[]]);;
3764
3765 let DIVISION_UBOUND = prove(
3766   `!D a b r. division(a,b) D ==> D(r) <= b`,
3767   REWRITE_TAC[DIVISION_THM] THEN REPEAT STRIP_TAC THEN
3768   DISJ_CASES_TAC(SPECL [`r:num`; `dsize D`] LTE_CASES) THENL
3769    [ALL_TAC;
3770     MATCH_MP_TAC REAL_EQ_IMP_LE THEN FIRST_ASSUM MATCH_MP_TAC THEN
3771     ASM_REWRITE_TAC[GE]] THEN
3772   SUBGOAL_THEN `!r. D((dsize D) - r) <= b` MP_TAC THENL
3773    [ALL_TAC;
3774     DISCH_THEN(MP_TAC o SPEC `(dsize D) - r`) THEN
3775     MATCH_MP_TAC EQ_IMP THEN
3776     AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
3777     FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP SUB_SUB
3778       (MATCH_MP LT_IMP_LE th)]) THEN
3779     ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB]] THEN
3780   UNDISCH_TAC `r < (dsize D)` THEN DISCH_THEN(K ALL_TAC) THEN
3781   INDUCT_TAC THENL
3782    [REWRITE_TAC[SUB_0] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN
3783     FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[GE; LE_REFL];
3784     ALL_TAC] THEN
3785   DISJ_CASES_TAC(SPECL [`r:num`; `dsize D`] LTE_CASES) THENL
3786    [ALL_TAC;
3787     SUBGOAL_THEN `(dsize D) - (SUC r) = 0` SUBST1_TAC THENL
3788      [REWRITE_TAC[SUB_EQ_0] THEN MATCH_MP_TAC LE_TRANS THEN
3789       EXISTS_TAC `r:num` THEN ASM_REWRITE_TAC[LESS_EQ_SUC_REFL];
3790       ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIVISION_LE THEN
3791       EXISTS_TAC `D:num->real` THEN ASM_REWRITE_TAC[DIVISION_THM]]] THEN
3792   MATCH_MP_TAC REAL_LE_TRANS THEN
3793   EXISTS_TAC `D((dsize D) - r):real` THEN ASM_REWRITE_TAC[] THEN
3794   SUBGOAL_THEN `(dsize D) - r = SUC((dsize D) - (SUC r))`
3795   SUBST1_TAC THENL
3796    [ALL_TAC;
3797     MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_ASSUM MATCH_MP_TAC THEN
3798     MATCH_MP_TAC LESS_CASES_IMP THEN
3799     REWRITE_TAC[NOT_LT; LE_LT; SUB_LESS_EQ] THEN
3800     CONV_TAC(RAND_CONV SYM_CONV) THEN
3801     REWRITE_TAC[SUB_EQ_EQ_0; NOT_SUC] THEN
3802     DISCH_THEN SUBST_ALL_TAC THEN
3803     UNDISCH_TAC `r < 0` THEN REWRITE_TAC[NOT_LESS_0]] THEN
3804   MP_TAC(SPECL [`dsize D`; `SUC r`] (CONJUNCT2 SUB_OLD)) THEN
3805   COND_CASES_TAC THENL
3806    [REWRITE_TAC[SUB_EQ_0; LE_SUC] THEN
3807     ASM_REWRITE_TAC[GSYM NOT_LT];
3808     DISCH_THEN (SUBST1_TAC o SYM) THEN REWRITE_TAC[SUB_SUC]]);;
3809
3810 let DIVISION_UBOUND_LT = prove(
3811   `!D a b n. division(a,b) D /\
3812              n < dsize D ==> D(n) < b`,
3813   REPEAT STRIP_TAC THEN
3814   FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP DIVISION_RHS) THEN
3815   FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP DIVISION_GT) THEN
3816   ASM_REWRITE_TAC[]);;
3817
3818 (* ------------------------------------------------------------------------ *)
3819 (* Divisions of adjacent intervals can be combined into one                 *)
3820 (* ------------------------------------------------------------------------ *)
3821
3822 let DIVISION_APPEND_LEMMA1 = prove(
3823   `!a b c D1 D2. division(a,b) D1 /\ division(b,c) D2 ==>
3824         (!n. n < ((dsize D1) + (dsize D2)) ==>
3825                 (\n. if (n < (dsize D1)) then  D1(n) else
3826                      D2(n - (dsize D1)))(n) <
3827    (\n. if (n < (dsize D1)) then  D1(n) else D2(n - (dsize D1)))(SUC n)) /\
3828         (!n. n >= ((dsize D1) + (dsize D2)) ==>
3829                ((\n. if (n < (dsize D1)) then  D1(n) else
3830    D2(n - (dsize D1)))(n) = (\n. if (n < (dsize D1)) then  D1(n) else
3831    D2(n - (dsize D1)))((dsize D1) + (dsize D2))))`,
3832   REPEAT GEN_TAC THEN STRIP_TAC THEN CONJ_TAC THEN
3833   X_GEN_TAC `n:num` THEN DISCH_TAC THEN BETA_TAC THENL
3834    [ASM_CASES_TAC `(SUC n) < (dsize D1)` THEN ASM_REWRITE_TAC[] THENL
3835      [SUBGOAL_THEN `n < (dsize D1)` ASSUME_TAC THEN
3836       ASM_REWRITE_TAC[] THENL
3837        [MATCH_MP_TAC LT_TRANS THEN EXISTS_TAC `SUC n` THEN
3838         ASM_REWRITE_TAC[LESS_SUC_REFL];
3839         UNDISCH_TAC `division(a,b) D1` THEN REWRITE_TAC[DIVISION_THM] THEN
3840         STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN
3841         FIRST_ASSUM ACCEPT_TAC];
3842       ASM_CASES_TAC `n < (dsize D1)` THEN ASM_REWRITE_TAC[] THENL
3843        [RULE_ASSUM_TAC(REWRITE_RULE[NOT_LT]) THEN
3844         MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `b:real` THEN
3845         CONJ_TAC THENL
3846          [MATCH_MP_TAC DIVISION_UBOUND_LT THEN
3847           EXISTS_TAC `a:real` THEN ASM_REWRITE_TAC[];
3848           MATCH_MP_TAC DIVISION_LBOUND THEN
3849           EXISTS_TAC `c:real` THEN ASM_REWRITE_TAC[]];
3850         UNDISCH_TAC `~(n < (dsize D1))` THEN
3851         REWRITE_TAC[NOT_LT] THEN
3852         DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC o
3853           REWRITE_RULE[LE_EXISTS]) THEN
3854         REWRITE_TAC[SUB_OLD; GSYM NOT_LE; LE_ADD] THEN
3855         ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN
3856         FIRST_ASSUM(MATCH_MP_TAC o el 1 o CONJUNCTS o
3857           REWRITE_RULE[DIVISION_THM]) THEN
3858         UNDISCH_TAC `((dsize D1) + d) <
3859                      ((dsize D1) + (dsize D2))` THEN
3860         ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[LT_ADD_RCANCEL]]];
3861     REWRITE_TAC[GSYM NOT_LE; LE_ADD] THEN
3862     ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN
3863     REWRITE_TAC[NOT_LE] THEN COND_CASES_TAC THEN
3864     UNDISCH_TAC `n >= ((dsize D1) + (dsize D2))` THENL
3865      [CONV_TAC CONTRAPOS_CONV THEN DISCH_TAC THEN
3866       REWRITE_TAC[GE; NOT_LE] THEN
3867       MATCH_MP_TAC LTE_TRANS THEN EXISTS_TAC `dsize D1` THEN
3868       ASM_REWRITE_TAC[LE_ADD];
3869       REWRITE_TAC[GE; LE_EXISTS] THEN
3870       DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC) THEN
3871       REWRITE_TAC[GSYM ADD_ASSOC] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN
3872       REWRITE_TAC[ADD_SUB] THEN
3873       FIRST_ASSUM(CHANGED_TAC o
3874        (SUBST1_TAC o MATCH_MP DIVISION_RHS)) THEN
3875       FIRST_ASSUM(MATCH_MP_TAC o el 2 o CONJUNCTS o
3876         REWRITE_RULE[DIVISION_THM]) THEN
3877       REWRITE_TAC[GE; LE_ADD]]]);;
3878
3879 let DIVISION_APPEND_LEMMA2 = prove(
3880   `!a b c D1 D2. division(a,b) D1 /\ division(b,c) D2 ==>
3881                    (dsize(\n. if (n < (dsize D1)) then  D1(n) else
3882        D2(n - (dsize D1))) = dsize(D1) + dsize(D2))`,
3883   REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [dsize] THEN
3884   MATCH_MP_TAC SELECT_UNIQUE THEN
3885   X_GEN_TAC `N:num` THEN BETA_TAC THEN EQ_TAC THENL
3886    [DISCH_THEN((then_) (MATCH_MP_TAC LESS_EQUAL_ANTISYM) o MP_TAC) THEN
3887     CONV_TAC CONTRAPOS_CONV THEN
3888     REWRITE_TAC[DE_MORGAN_THM; NOT_LE] THEN
3889     DISCH_THEN DISJ_CASES_TAC THENL
3890      [DISJ1_TAC THEN
3891       DISCH_THEN(MP_TAC o SPEC `dsize(D1) + dsize(D2)`) THEN
3892       ASM_REWRITE_TAC[] THEN
3893       REWRITE_TAC[GSYM NOT_LE; LE_ADD] THEN
3894       SUBGOAL_THEN `!x y. x <= SUC(x + y)` ASSUME_TAC THENL
3895        [REPEAT GEN_TAC THEN MATCH_MP_TAC LE_TRANS THEN
3896         EXISTS_TAC `x + y:num` THEN
3897         REWRITE_TAC[LE_ADD; LESS_EQ_SUC_REFL]; ALL_TAC] THEN
3898       ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUB_OLD; GSYM NOT_LE] THEN
3899       REWRITE_TAC[LE_ADD] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN
3900       REWRITE_TAC[ADD_SUB] THEN
3901       MP_TAC(ASSUME `division(b,c) D2`) THEN REWRITE_TAC[DIVISION_THM] THEN
3902       DISCH_THEN(MP_TAC o SPEC `SUC(dsize D2)` o el 2 o CONJUNCTS) THEN
3903       REWRITE_TAC[GE; LESS_EQ_SUC_REFL] THEN
3904       DISCH_THEN SUBST1_TAC THEN
3905       FIRST_ASSUM(CHANGED_TAC o SUBST1_TAC o MATCH_MP DIVISION_RHS) THEN
3906       REWRITE_TAC[REAL_LT_REFL];
3907       DISJ2_TAC THEN
3908       DISCH_THEN(MP_TAC o SPEC `dsize(D1) + dsize(D2)`) THEN
3909       FIRST_ASSUM(ASSUME_TAC o MATCH_MP LT_IMP_LE) THEN
3910       ASM_REWRITE_TAC[GE] THEN
3911       REWRITE_TAC[GSYM NOT_LE; LE_ADD] THEN
3912       ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN
3913       COND_CASES_TAC THENL
3914        [SUBGOAL_THEN `D1(N:num) < D2(dsize D2)` MP_TAC THENL
3915          [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `b:real` THEN
3916           CONJ_TAC THENL
3917            [MATCH_MP_TAC DIVISION_UBOUND_LT THEN EXISTS_TAC `a:real` THEN
3918             ASM_REWRITE_TAC[GSYM NOT_LE];
3919             MATCH_MP_TAC DIVISION_LBOUND THEN
3920             EXISTS_TAC `c:real` THEN ASM_REWRITE_TAC[]];
3921           CONV_TAC CONTRAPOS_CONV THEN ASM_REWRITE_TAC[] THEN
3922           DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_LT_REFL]];
3923         RULE_ASSUM_TAC(REWRITE_RULE[]) THEN
3924         SUBGOAL_THEN `D2(N - (dsize D1)) < D2(dsize D2)` MP_TAC THENL
3925          [MATCH_MP_TAC DIVISION_LT_GEN THEN
3926           MAP_EVERY EXISTS_TAC [`b:real`; `c:real`] THEN
3927           ASM_REWRITE_TAC[LE_REFL] THEN
3928           REWRITE_TAC[GSYM NOT_LE] THEN
3929           REWRITE_TAC[SUB_LEFT_LESS_EQ; DE_MORGAN_THM] THEN
3930           ONCE_REWRITE_TAC[ADD_SYM] THEN ASM_REWRITE_TAC[NOT_LE] THEN
3931           UNDISCH_TAC `dsize(D1) <= N` THEN
3932           REWRITE_TAC[LE_EXISTS] THEN
3933           DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC) THEN
3934           RULE_ASSUM_TAC(ONCE_REWRITE_RULE[ADD_SYM]) THEN
3935           RULE_ASSUM_TAC(REWRITE_RULE[LT_ADD_RCANCEL]) THEN
3936           MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `d:num` THEN
3937           ASM_REWRITE_TAC[LE_0];
3938           CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[] THEN
3939           DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_LT_REFL]]]];
3940   DISCH_THEN SUBST1_TAC THEN CONJ_TAC THENL
3941    [X_GEN_TAC `n:num` THEN DISCH_TAC THEN
3942     ASM_CASES_TAC `(SUC n) < (dsize(D1))` THEN
3943     ASM_REWRITE_TAC[] THENL
3944      [SUBGOAL_THEN `n < (dsize(D1))` ASSUME_TAC THENL
3945        [MATCH_MP_TAC LT_TRANS THEN EXISTS_TAC `SUC n` THEN
3946         ASM_REWRITE_TAC[LESS_SUC_REFL]; ALL_TAC] THEN
3947       ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIVISION_LT_GEN THEN
3948       MAP_EVERY EXISTS_TAC [`a:real`; `b:real`] THEN
3949       ASM_REWRITE_TAC[LESS_SUC_REFL] THEN
3950       MATCH_MP_TAC LT_IMP_LE THEN ASM_REWRITE_TAC[];
3951       COND_CASES_TAC THENL
3952        [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `b:real` THEN
3953         CONJ_TAC THENL
3954          [MATCH_MP_TAC DIVISION_UBOUND_LT THEN EXISTS_TAC `a:real` THEN
3955           ASM_REWRITE_TAC[];
3956           FIRST_ASSUM(MATCH_ACCEPT_TAC o MATCH_MP DIVISION_LBOUND)];
3957         MATCH_MP_TAC DIVISION_LT_GEN THEN
3958         MAP_EVERY EXISTS_TAC [`b:real`; `c:real`] THEN
3959         ASM_REWRITE_TAC[] THEN
3960         CONJ_TAC THENL [ASM_REWRITE_TAC[SUB_OLD; LESS_SUC_REFL]; ALL_TAC] THEN
3961         REWRITE_TAC[REWRITE_RULE[GE] SUB_LEFT_GREATER_EQ] THEN
3962         ONCE_REWRITE_TAC[ADD_SYM] THEN ASM_REWRITE_TAC[LE_SUC_LT]]];
3963     X_GEN_TAC `n:num` THEN REWRITE_TAC[GE] THEN DISCH_TAC THEN
3964     REWRITE_TAC[GSYM NOT_LE; LE_ADD] THEN
3965     SUBGOAL_THEN `(dsize D1) <= n` ASSUME_TAC THENL
3966      [MATCH_MP_TAC LE_TRANS THEN
3967       EXISTS_TAC `dsize D1 + dsize D2` THEN
3968       ASM_REWRITE_TAC[LE_ADD];
3969       ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN
3970       REWRITE_TAC[ADD_SUB] THEN
3971       FIRST_ASSUM(CHANGED_TAC o SUBST1_TAC o MATCH_MP DIVISION_RHS) THEN
3972       FIRST_ASSUM(MATCH_MP_TAC o el 2 o
3973         CONJUNCTS o REWRITE_RULE[DIVISION_THM]) THEN
3974       REWRITE_TAC[GE; SUB_LEFT_LESS_EQ] THEN
3975       ONCE_REWRITE_TAC[ADD_SYM] THEN ASM_REWRITE_TAC[]]]]);;
3976
3977 let DIVISION_APPEND_EXPLICIT = prove
3978  (`!a b c g d1 p1 d2 p2.
3979         tdiv(a,b) (d1,p1) /\
3980         fine g (d1,p1) /\
3981         tdiv(b,c) (d2,p2) /\
3982         fine g (d2,p2)
3983         ==> tdiv(a,c)
3984               ((\n. if n < dsize d1 then  d1(n) else d2(n - (dsize d1))),
3985                (\n. if n < dsize d1
3986                     then p1(n) else p2(n - (dsize d1)))) /\
3987             fine g ((\n. if n < dsize d1 then  d1(n) else d2(n - (dsize d1))),
3988                (\n. if n < dsize d1
3989                     then p1(n) else p2(n - (dsize d1)))) /\
3990             !f. rsum((\n. if n < dsize d1 then  d1(n) else d2(n - (dsize d1))),
3991                      (\n. if n < dsize d1
3992                           then p1(n) else p2(n - (dsize d1)))) f =
3993                 rsum(d1,p1) f + rsum(d2,p2) f`,
3994   MAP_EVERY X_GEN_TAC
3995    [`a:real`; `b:real`; `c:real`; `g:real->real`;
3996     `D1:num->real`; `p1:num->real`; `D2:num->real`; `p2:num->real`] THEN
3997   STRIP_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
3998    [ALL_TAC;
3999     GEN_TAC THEN REWRITE_TAC[rsum] THEN
4000     MP_TAC(SPECL [`a:real`; `b:real`; `c:real`;
4001                   `D1:num->real`; `D2:num->real`] DIVISION_APPEND_LEMMA2) THEN
4002     ANTS_TAC THENL [ASM_MESON_TAC[tdiv]; ALL_TAC] THEN
4003     DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[GSYM SUM_SPLIT] THEN
4004     REWRITE_TAC[SUM_REINDEX] THEN BINOP_TAC THEN MATCH_MP_TAC SUM_EQ THEN
4005     SIMP_TAC[ADD_CLAUSES; ARITH_RULE `~(r + d < d:num)`;
4006              ARITH_RULE `~(SUC(r + d) < d)`; ADD_SUB;
4007              ARITH_RULE `SUC(r + d) - d = SUC r`] THEN
4008     X_GEN_TAC `k:num` THEN STRIP_TAC THEN AP_TERM_TAC THEN
4009     ASM_SIMP_TAC[ARITH_RULE `k < n ==> (SUC k < n <=> ~(n = SUC k))`] THEN
4010     ASM_CASES_TAC `dsize D1 = SUC k` THEN ASM_REWRITE_TAC[SUB_REFL] THEN
4011     AP_THM_TAC THEN AP_TERM_TAC THEN
4012     ASM_MESON_TAC[tdiv; DIVISION_LHS; DIVISION_RHS]] THEN
4013   DISJ_CASES_TAC(GSYM (SPEC `dsize(D1)` LESS_0_CASES)) THENL
4014    [ASM_REWRITE_TAC[NOT_LESS_0; SUB_0] THEN
4015     CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN
4016     SUBGOAL_THEN `a:real = b` (fun th -> ASM_REWRITE_TAC[th]) THEN
4017     MP_TAC(SPECL [`D1:num->real`; `a:real`; `b:real`] DIVISION_EQ) THEN
4018     RULE_ASSUM_TAC(REWRITE_RULE[tdiv]) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN
4019   CONJ_TAC THENL
4020    [ALL_TAC;
4021     REWRITE_TAC[fine] THEN X_GEN_TAC `n:num` THEN
4022     RULE_ASSUM_TAC(REWRITE_RULE[tdiv]) THEN
4023     MP_TAC(SPECL [`a:real`; `b:real`; `c:real`;
4024                   `D1:num->real`; `D2:num->real`] DIVISION_APPEND_LEMMA2) THEN
4025     ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN BETA_TAC THEN
4026     DISCH_TAC THEN ASM_CASES_TAC `(SUC n) < (dsize D1)` THEN
4027     ASM_REWRITE_TAC[] THENL
4028      [SUBGOAL_THEN `n < (dsize D1)` ASSUME_TAC THENL
4029        [MATCH_MP_TAC LT_TRANS THEN EXISTS_TAC `SUC n` THEN
4030         ASM_REWRITE_TAC[LESS_SUC_REFL]; ALL_TAC] THEN
4031       ASM_REWRITE_TAC[] THEN
4032       FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[fine]) THEN
4033       ASM_REWRITE_TAC[]; ALL_TAC] THEN
4034     ASM_CASES_TAC `n < (dsize D1)` THEN ASM_REWRITE_TAC[] THENL
4035      [SUBGOAL_THEN `SUC n = dsize D1` ASSUME_TAC THENL
4036        [MATCH_MP_TAC LESS_EQUAL_ANTISYM THEN
4037         ASM_REWRITE_TAC[GSYM NOT_LT] THEN
4038         REWRITE_TAC[NOT_LT] THEN MATCH_MP_TAC LESS_OR THEN
4039         ASM_REWRITE_TAC[];
4040         ASM_REWRITE_TAC[SUB_REFL] THEN
4041         FIRST_ASSUM(CHANGED_TAC o SUBST1_TAC o MATCH_MP DIVISION_LHS o
4042           CONJUNCT1) THEN
4043         FIRST_ASSUM(CHANGED_TAC o SUBST1_TAC o SYM o
4044           MATCH_MP DIVISION_RHS o  CONJUNCT1) THEN
4045         SUBST1_TAC(SYM(ASSUME `SUC n = dsize D1`)) THEN
4046         FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[fine]) THEN
4047         ASM_REWRITE_TAC[]];
4048       ASM_REWRITE_TAC[SUB_OLD] THEN UNDISCH_TAC `~(n < (dsize D1))` THEN
4049       REWRITE_TAC[LE_EXISTS; NOT_LT] THEN
4050       DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC) THEN
4051       ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN
4052       FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[fine]) THEN
4053       RULE_ASSUM_TAC(ONCE_REWRITE_RULE[ADD_SYM]) THEN
4054       RULE_ASSUM_TAC(REWRITE_RULE[LT_ADD_RCANCEL]) THEN
4055       FIRST_ASSUM ACCEPT_TAC]] THEN
4056   REWRITE_TAC[tdiv] THEN BETA_TAC THEN CONJ_TAC THENL
4057    [RULE_ASSUM_TAC(REWRITE_RULE[tdiv]) THEN
4058     REWRITE_TAC[DIVISION_THM] THEN CONJ_TAC THENL
4059      [BETA_TAC THEN ASM_REWRITE_TAC[] THEN
4060       MATCH_MP_TAC DIVISION_LHS THEN EXISTS_TAC `b:real` THEN
4061       ASM_REWRITE_TAC[]; ALL_TAC] THEN
4062     SUBGOAL_THEN `c = (\n. if (n < (dsize D1)) then  D1(n) else D2(n -
4063                   (dsize D1))) (dsize(D1) + dsize(D2))` SUBST1_TAC THENL
4064      [BETA_TAC THEN REWRITE_TAC[GSYM NOT_LE; LE_ADD] THEN
4065       ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN
4066       CONV_TAC SYM_CONV THEN MATCH_MP_TAC DIVISION_RHS THEN
4067       EXISTS_TAC `b:real` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN
4068     MP_TAC(SPECL [`a:real`; `b:real`; `c:real`;
4069                  `D1:num->real`; `D2:num->real`] DIVISION_APPEND_LEMMA2) THEN
4070     ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN
4071     MATCH_MP_TAC (BETA_RULE DIVISION_APPEND_LEMMA1) THEN
4072     MAP_EVERY EXISTS_TAC [`a:real`; `b:real`; `c:real`] THEN
4073     ASM_REWRITE_TAC[]; ALL_TAC] THEN
4074   X_GEN_TAC `n:num` THEN RULE_ASSUM_TAC(REWRITE_RULE[tdiv]) THEN
4075   ASM_CASES_TAC `(SUC n) < (dsize D1)` THEN ASM_REWRITE_TAC[] THENL
4076    [SUBGOAL_THEN `n < (dsize D1)` ASSUME_TAC THENL
4077      [MATCH_MP_TAC LT_TRANS THEN EXISTS_TAC `SUC n` THEN
4078       ASM_REWRITE_TAC[LESS_SUC_REFL]; ALL_TAC] THEN
4079     ASM_REWRITE_TAC[]; ALL_TAC] THEN
4080   COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL
4081    [ASM_REWRITE_TAC[SUB_OLD] THEN
4082     FIRST_ASSUM(CHANGED_TAC o SUBST1_TAC o MATCH_MP DIVISION_LHS o
4083       CONJUNCT1) THEN
4084     FIRST_ASSUM(CHANGED_TAC o SUBST1_TAC o SYM o
4085       MATCH_MP DIVISION_RHS o  CONJUNCT1) THEN
4086     SUBGOAL_THEN `dsize D1 = SUC n` (fun th -> ASM_REWRITE_TAC[th]) THEN
4087     MATCH_MP_TAC LESS_EQUAL_ANTISYM THEN
4088     ASM_REWRITE_TAC[GSYM NOT_LT] THEN REWRITE_TAC[NOT_LT] THEN
4089     MATCH_MP_TAC LESS_OR THEN ASM_REWRITE_TAC[];
4090     ASM_REWRITE_TAC[SUB_OLD]]);;
4091
4092 let DIVISION_APPEND_STRONG = prove
4093  (`!a b c D1 p1 D2 p2.
4094         tdiv(a,b) (D1,p1) /\ fine(g) (D1,p1) /\
4095         tdiv(b,c) (D2,p2) /\ fine(g) (D2,p2)
4096         ==> ?D p. tdiv(a,c) (D,p) /\ fine(g) (D,p) /\
4097                   !f. rsum(D,p) f = rsum(D1,p1) f + rsum(D2,p2) f`,
4098   REPEAT STRIP_TAC THEN MAP_EVERY EXISTS_TAC
4099    [`\n. if n < dsize D1 then D1(n):real else D2(n - (dsize D1))`;
4100     `\n. if n < dsize D1 then p1(n):real else p2(n - (dsize D1))`] THEN
4101   MATCH_MP_TAC DIVISION_APPEND_EXPLICIT THEN ASM_MESON_TAC[]);;
4102
4103 let DIVISION_APPEND = prove(
4104   `!a b c.
4105       (?D1 p1. tdiv(a,b) (D1,p1) /\ fine(g) (D1,p1)) /\
4106       (?D2 p2. tdiv(b,c) (D2,p2) /\ fine(g) (D2,p2)) ==>
4107         ?D p. tdiv(a,c) (D,p) /\ fine(g) (D,p)`,
4108   MESON_TAC[DIVISION_APPEND_STRONG]);;
4109
4110 (* ------------------------------------------------------------------------ *)
4111 (* We can always find a division which is fine wrt any gauge                *)
4112 (* ------------------------------------------------------------------------ *)
4113
4114 let DIVISION_EXISTS = prove(
4115   `!a b g. a <= b /\ gauge(\x. a <= x /\ x <= b) g ==>
4116         ?D p. tdiv(a,b) (D,p) /\ fine(g) (D,p)`,
4117   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
4118   (MP_TAC o C SPEC BOLZANO_LEMMA)
4119     `\(u,v). a <= u /\ v <= b ==> ?D p. tdiv(u,v) (D,p) /\ fine(g) (D,p)` THEN
4120   CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN
4121   W(C SUBGOAL_THEN (fun t ->REWRITE_TAC[t]) o
4122   funpow 2 (fst o dest_imp) o snd) THENL
4123    [CONJ_TAC;
4124     DISCH_THEN(MP_TAC o SPECL [`a:real`; `b:real`]) THEN
4125     REWRITE_TAC[REAL_LE_REFL]]
4126   THENL
4127    [MAP_EVERY X_GEN_TAC [`u:real`; `v:real`; `w:real`] THEN
4128     REPEAT STRIP_TAC THEN MATCH_MP_TAC DIVISION_APPEND THEN
4129     EXISTS_TAC `v:real` THEN CONJ_TAC THEN
4130     FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THENL
4131      [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `w:real`;
4132       MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `u:real`] THEN
4133     ASM_REWRITE_TAC[]; ALL_TAC] THEN
4134   X_GEN_TAC `x:real` THEN ASM_CASES_TAC `a <= x /\ x <= b` THENL
4135    [ALL_TAC;
4136     EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN
4137     MAP_EVERY X_GEN_TAC [`w:real`; `y:real`] THEN STRIP_TAC THEN
4138     CONV_TAC CONTRAPOS_CONV THEN DISCH_THEN(K ALL_TAC) THEN
4139     FIRST_ASSUM(UNDISCH_TAC o check is_neg o concl) THEN
4140     REWRITE_TAC[DE_MORGAN_THM; REAL_NOT_LE] THEN
4141     DISCH_THEN DISJ_CASES_TAC THENL
4142      [DISJ1_TAC THEN MATCH_MP_TAC REAL_LET_TRANS;
4143       DISJ2_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS] THEN
4144     EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[]] THEN
4145   UNDISCH_TAC `gauge(\x. a <= x /\ x <= b) g` THEN
4146   REWRITE_TAC[gauge] THEN BETA_TAC THEN
4147   DISCH_THEN(fun th -> FIRST_ASSUM(ASSUME_TAC o MATCH_MP th)) THEN
4148   EXISTS_TAC `(g:real->real) x` THEN ASM_REWRITE_TAC[] THEN
4149   MAP_EVERY X_GEN_TAC [`w:real`; `y:real`] THEN REPEAT STRIP_TAC THEN
4150   EXISTS_TAC `\n. if (n = 0) then (w:real) else y` THEN
4151   EXISTS_TAC `\n. if (n = 0) then (x:real) else y` THEN
4152   SUBGOAL_THEN `w <= y` ASSUME_TAC THENL
4153    [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `x:real` THEN
4154     ASM_REWRITE_TAC[]; ALL_TAC] THEN
4155   CONJ_TAC THENL
4156    [REWRITE_TAC[tdiv] THEN CONJ_TAC THENL
4157      [MATCH_MP_TAC DIVISION_SINGLE THEN FIRST_ASSUM ACCEPT_TAC;
4158       X_GEN_TAC `n:num` THEN BETA_TAC THEN REWRITE_TAC[NOT_SUC] THEN
4159       COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL]];
4160     REWRITE_TAC[fine] THEN BETA_TAC THEN REWRITE_TAC[NOT_SUC] THEN
4161     X_GEN_TAC `n:num` THEN
4162     DISJ_CASES_THEN MP_TAC (REWRITE_RULE[REAL_LE_LT] (ASSUME `w <= y`)) THENL
4163      [DISCH_THEN(ASSUME_TAC o MATCH_MP DIVISION_1) THEN
4164       ASM_REWRITE_TAC[num_CONV `1`; CONJUNCT2 LT; NOT_LESS_0] THEN
4165       DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[];
4166       DISCH_THEN(SUBST1_TAC o MATCH_MP DIVISION_0) THEN
4167       REWRITE_TAC[NOT_LESS_0]]]);;
4168
4169 (* ------------------------------------------------------------------------ *)
4170 (* Lemmas about combining gauges                                            *)
4171 (* ------------------------------------------------------------------------ *)
4172
4173 let GAUGE_MIN = prove(
4174   `!E g1 g2. gauge(E) g1 /\ gauge(E) g2 ==>
4175         gauge(E) (\x. if g1(x) < g2(x) then g1(x) else g2(x))`,
4176   REPEAT GEN_TAC THEN REWRITE_TAC[gauge] THEN STRIP_TAC THEN
4177   X_GEN_TAC `x:real` THEN BETA_TAC THEN DISCH_TAC THEN
4178   COND_CASES_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN
4179   FIRST_ASSUM ACCEPT_TAC);;
4180
4181 let FINE_MIN = prove(
4182   `!g1 g2 D p. fine (\x. if g1(x) < g2(x) then g1(x) else g2(x)) (D,p) ==>
4183         fine(g1) (D,p) /\ fine(g2) (D,p)`,
4184   REPEAT GEN_TAC THEN REWRITE_TAC[fine] THEN
4185   BETA_TAC THEN DISCH_TAC THEN CONJ_TAC THEN
4186   X_GEN_TAC `n:num` THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN
4187   COND_CASES_TAC THEN REWRITE_TAC[] THEN DISCH_TAC THENL
4188    [RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LT]) THEN
4189     MATCH_MP_TAC REAL_LTE_TRANS;
4190     MATCH_MP_TAC REAL_LT_TRANS] THEN
4191   FIRST_ASSUM(fun th -> EXISTS_TAC(rand(concl th)) THEN
4192                    ASM_REWRITE_TAC[] THEN NO_TAC));;
4193
4194 (* ------------------------------------------------------------------------ *)
4195 (* The integral is unique if it exists                                      *)
4196 (* ------------------------------------------------------------------------ *)
4197
4198 let DINT_UNIQ = prove(
4199   `!a b f k1 k2. a <= b /\ defint(a,b) f k1 /\ defint(a,b) f k2 ==> (k1 = k2)`,
4200   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
4201   GEN_REWRITE_TAC RAND_CONV [GSYM REAL_SUB_0] THEN
4202   CONV_TAC CONTRAPOS_CONV THEN ONCE_REWRITE_TAC[ABS_NZ] THEN DISCH_TAC THEN
4203   REWRITE_TAC[defint] THEN
4204   DISCH_THEN(CONJUNCTS_THEN(MP_TAC o SPEC `abs(k1 - k2) / &2`)) THEN
4205   ASM_REWRITE_TAC[REAL_LT_HALF1] THEN
4206   DISCH_THEN(X_CHOOSE_THEN `g1:real->real` STRIP_ASSUME_TAC) THEN
4207   DISCH_THEN(X_CHOOSE_THEN `g2:real->real` STRIP_ASSUME_TAC) THEN
4208   MP_TAC(SPECL [`\x. a <= x /\ x <= b`;
4209                 `g1:real->real`; `g2:real->real`] GAUGE_MIN) THEN
4210   ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
4211   MP_TAC(SPECL [`a:real`; `b:real`;
4212          `\x:real. if g1(x) < g2(x) then g1(x) else g2(x)`] DIVISION_EXISTS) THEN
4213   ASM_REWRITE_TAC[] THEN
4214   DISCH_THEN(X_CHOOSE_THEN `D:num->real` (X_CHOOSE_THEN `p:num->real`
4215     STRIP_ASSUME_TAC)) THEN
4216   FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP FINE_MIN) THEN
4217   REPEAT(FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN
4218     DISCH_THEN(MP_TAC o SPECL [`D:num->real`; `p:num->real`]) THEN
4219     ASM_REWRITE_TAC[] THEN DISCH_TAC) THEN
4220   SUBGOAL_THEN `abs((rsum(D,p) f - k2) - (rsum(D,p) f - k1)) < abs(k1 - k2)`
4221   MP_TAC THENL
4222    [MATCH_MP_TAC REAL_LET_TRANS THEN
4223     EXISTS_TAC `abs(rsum(D,p) f - k2) + abs(rsum(D,p) f - k1)` THEN
4224     CONJ_TAC THENL
4225      [GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [real_sub] THEN
4226       GEN_REWRITE_TAC (funpow 2 RAND_CONV) [GSYM ABS_NEG] THEN
4227       MATCH_ACCEPT_TAC ABS_TRIANGLE;
4228       GEN_REWRITE_TAC RAND_CONV [GSYM REAL_HALF_DOUBLE] THEN
4229       MATCH_MP_TAC REAL_LT_ADD2 THEN ASM_REWRITE_TAC[]];
4230     REWRITE_TAC[real_sub; REAL_NEG_ADD; REAL_NEG_SUB] THEN
4231     ONCE_REWRITE_TAC[AC REAL_ADD_AC
4232       `(a + b) + (c + d) = (d + a) + (c + b)`] THEN
4233     REWRITE_TAC[REAL_ADD_LINV; REAL_ADD_LID; REAL_LT_REFL]]);;
4234
4235 (* ------------------------------------------------------------------------ *)
4236 (* Integral over a null interval is 0                                       *)
4237 (* ------------------------------------------------------------------------ *)
4238
4239 let INTEGRAL_NULL = prove(
4240   `!f a. defint(a,a) f (&0)`,
4241   REPEAT GEN_TAC THEN REWRITE_TAC[defint] THEN GEN_TAC THEN
4242   DISCH_TAC THEN EXISTS_TAC `\x:real. &1` THEN
4243   REWRITE_TAC[gauge; REAL_LT_01] THEN REPEAT GEN_TAC THEN
4244   REWRITE_TAC[tdiv] THEN STRIP_TAC THEN
4245   FIRST_ASSUM(MP_TAC o MATCH_MP DIVISION_EQ) THEN
4246   REWRITE_TAC[rsum] THEN DISCH_THEN SUBST1_TAC THEN
4247   ASM_REWRITE_TAC[sum; REAL_SUB_REFL; ABS_0]);;
4248
4249 (* ------------------------------------------------------------------------ *)
4250 (* Fundamental theorem of calculus (Part I)                                 *)
4251 (* ------------------------------------------------------------------------ *)
4252
4253 let STRADDLE_LEMMA = prove(
4254   `!f f' a b e. (!x. a <= x /\ x <= b ==> (f diffl f'(x))(x)) /\ &0 < e
4255     ==> ?g. gauge(\x. a <= x /\ x <= b) g /\
4256             !x u v. a <= u /\ u <= x /\ x <= v /\ v <= b /\ (v - u) < g(x)
4257                 ==> abs((f(v) - f(u)) - (f'(x) * (v - u))) <= e * (v - u)`,
4258   REPEAT STRIP_TAC THEN REWRITE_TAC[gauge] THEN BETA_TAC THEN
4259   SUBGOAL_THEN
4260    `!x. a <= x /\ x <= b ==>
4261         ?d. &0 < d /\
4262           !u v. u <= x /\ x <= v /\ (v - u) < d ==>
4263             abs((f(v) - f(u)) - (f'(x) * (v - u))) <= e * (v - u)` MP_TAC THENL
4264    [ALL_TAC;
4265     FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN
4266     DISCH_THEN(K ALL_TAC) THEN
4267     DISCH_THEN(MP_TAC o CONV_RULE
4268       ((ONCE_DEPTH_CONV RIGHT_IMP_EXISTS_CONV) THENC OLD_SKOLEM_CONV)) THEN
4269     DISCH_THEN(X_CHOOSE_THEN `g:real->real` STRIP_ASSUME_TAC) THEN
4270     EXISTS_TAC `g:real->real` THEN CONJ_TAC THENL
4271      [GEN_TAC THEN
4272       DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN
4273       DISCH_THEN(fun th -> REWRITE_TAC[th]);
4274       REPEAT STRIP_TAC THEN
4275       C SUBGOAL_THEN (fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th))
4276       `a <= x /\ x <= b` THENL
4277        [CONJ_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THENL
4278          [EXISTS_TAC `u:real`; EXISTS_TAC `v:real`] THEN
4279         ASM_REWRITE_TAC[];
4280         DISCH_THEN(MATCH_MP_TAC o CONJUNCT2) THEN ASM_REWRITE_TAC[]]]] THEN
4281   X_GEN_TAC `x:real` THEN
4282   DISCH_THEN(fun th -> STRIP_ASSUME_TAC th THEN
4283     FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN
4284     DISCH_THEN(MP_TAC o C MATCH_MP th)) THEN
4285   REWRITE_TAC[diffl; LIM] THEN
4286   DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN
4287   ASM_REWRITE_TAC[REAL_LT_HALF1] THEN
4288   BETA_TAC THEN REWRITE_TAC[REAL_SUB_RZERO] THEN
4289   DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
4290   SUBGOAL_THEN `!z. abs(z - x) < d ==>
4291         abs((f(z) - f(x)) - (f'(x) * (z - x))) <= (e / &2) * abs(z - x)`
4292   ASSUME_TAC THENL
4293    [GEN_TAC THEN ASM_CASES_TAC `&0 < abs(z - x)` THENL
4294      [ALL_TAC;
4295       UNDISCH_TAC `~(&0 < abs(z - x))` THEN
4296       REWRITE_TAC[GSYM ABS_NZ; REAL_SUB_0] THEN
4297       DISCH_THEN SUBST1_TAC THEN
4298       REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO; ABS_0; REAL_LE_REFL]] THEN
4299     DISCH_THEN(MP_TAC o CONJ (ASSUME `&0 < abs(z - x)`)) THEN
4300     DISCH_THEN((then_) (MATCH_MP_TAC REAL_LT_IMP_LE) o MP_TAC) THEN
4301     DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN
4302     FIRST_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV
4303       [GSYM(MATCH_MP REAL_LT_RMUL_EQ th)]) THEN
4304     MATCH_MP_TAC EQ_IMP THEN
4305     AP_THM_TAC THEN AP_TERM_TAC THEN
4306     REWRITE_TAC[GSYM ABS_MUL] THEN AP_TERM_TAC THEN
4307     REWRITE_TAC[REAL_SUB_RDISTRIB] THEN AP_THM_TAC THEN AP_TERM_TAC THEN
4308     REWRITE_TAC[REAL_SUB_ADD2] THEN MATCH_MP_TAC REAL_DIV_RMUL THEN
4309     ASM_REWRITE_TAC[ABS_NZ]; ALL_TAC] THEN
4310   EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN
4311   REPEAT STRIP_TAC THEN
4312   SUBGOAL_THEN `u <= v` (DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT]) THENL
4313    [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `x:real` THEN
4314     ASM_REWRITE_TAC[];
4315     ALL_TAC;
4316     ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO; ABS_0; REAL_LE_REFL]] THEN
4317   MATCH_MP_TAC REAL_LE_TRANS THEN
4318   EXISTS_TAC `abs((f(v) - f(x)) - (f'(x) * (v - x))) +
4319               abs((f(x) - f(u)) - (f'(x) * (x - u)))` THEN
4320   CONJ_TAC THENL
4321    [MP_TAC(SPECL[`(f(v) - f(x)) - (f'(x) * (v - x))`;
4322                  `(f(x) - f(u)) - (f'(x) * (x - u))`] ABS_TRIANGLE) THEN
4323     MATCH_MP_TAC EQ_IMP THEN
4324     AP_THM_TAC THEN REPEAT AP_TERM_TAC THEN
4325     ONCE_REWRITE_TAC[GSYM REAL_ADD2_SUB2] THEN
4326     REWRITE_TAC[REAL_SUB_LDISTRIB] THEN
4327     SUBGOAL_THEN `!a b c. (a - b) + (b - c) = (a - c)`
4328       (fun th -> REWRITE_TAC[th]) THEN
4329     REPEAT GEN_TAC THEN REWRITE_TAC[real_sub] THEN
4330     ONCE_REWRITE_TAC[AC REAL_ADD_AC
4331       `(a + b) + (c + d) = (b + c) + (a + d)`] THEN
4332     REWRITE_TAC[REAL_ADD_LINV; REAL_ADD_LID]; ALL_TAC] THEN
4333   GEN_REWRITE_TAC RAND_CONV [GSYM REAL_HALF_DOUBLE] THEN
4334   MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL
4335    [MATCH_MP_TAC REAL_LE_TRANS THEN
4336     EXISTS_TAC `(e / &2) * abs(v - x)` THEN CONJ_TAC THENL
4337      [FIRST_ASSUM MATCH_MP_TAC THEN
4338       ASM_REWRITE_TAC[real_abs; REAL_SUB_LE] THEN
4339       MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `v - u` THEN
4340       ASM_REWRITE_TAC[] THEN REWRITE_TAC[real_sub; REAL_LE_LADD] THEN
4341       ASM_REWRITE_TAC[REAL_LE_NEG];
4342       ASM_REWRITE_TAC[real_abs; REAL_SUB_LE] THEN REWRITE_TAC[real_div] THEN
4343       GEN_REWRITE_TAC LAND_CONV
4344        [AC REAL_MUL_AC `(a * b) * c = (a * c) * b`] THEN
4345       REWRITE_TAC[GSYM REAL_MUL_ASSOC;
4346         MATCH_MP REAL_LE_LMUL_LOCAL (ASSUME `&0 < e`)] THEN
4347       SUBGOAL_THEN `!x y. (x * inv(&2)) <= (y * inv(&2)) <=> x <= y`
4348       (fun th -> ASM_REWRITE_TAC[th; real_sub; REAL_LE_LADD; REAL_LE_NEG]) THEN
4349       REPEAT GEN_TAC THEN MATCH_MP_TAC REAL_LE_RMUL_EQ THEN
4350       MATCH_MP_TAC REAL_INV_POS THEN
4351       REWRITE_TAC[REAL_LT; num_CONV `2`; LT_0]];
4352     MATCH_MP_TAC REAL_LE_TRANS THEN
4353     EXISTS_TAC `(e / &2) * abs(x - u)` THEN CONJ_TAC THENL
4354      [GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [real_sub] THEN
4355       ONCE_REWRITE_TAC[GSYM ABS_NEG] THEN
4356       REWRITE_TAC[REAL_NEG_ADD; REAL_NEG_SUB] THEN
4357       ONCE_REWRITE_TAC[REAL_NEG_RMUL] THEN
4358       REWRITE_TAC[REAL_NEG_SUB] THEN REWRITE_TAC[GSYM real_sub] THEN
4359       FIRST_ASSUM MATCH_MP_TAC THEN ONCE_REWRITE_TAC[ABS_SUB] THEN
4360       ASM_REWRITE_TAC[real_abs; REAL_SUB_LE] THEN
4361       MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `v - u` THEN
4362       ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[real_sub; REAL_LE_RADD];
4363       ASM_REWRITE_TAC[real_abs; REAL_SUB_LE] THEN REWRITE_TAC[real_div] THEN
4364       GEN_REWRITE_TAC LAND_CONV
4365        [AC REAL_MUL_AC `(a * b) * c = (a * c) * b`] THEN
4366       REWRITE_TAC[GSYM REAL_MUL_ASSOC;
4367         MATCH_MP REAL_LE_LMUL_LOCAL (ASSUME `&0 < e`)] THEN
4368       SUBGOAL_THEN `!x y. (x * inv(&2)) <= (y * inv(&2)) <=> x <= y`
4369       (fun th -> ASM_REWRITE_TAC[th; real_sub; REAL_LE_RADD; REAL_LE_NEG]) THEN
4370       REPEAT GEN_TAC THEN MATCH_MP_TAC REAL_LE_RMUL_EQ THEN
4371       MATCH_MP_TAC REAL_INV_POS THEN
4372       REWRITE_TAC[REAL_LT; num_CONV `2`; LT_0]]]);;
4373
4374 let FTC1 = prove(
4375   `!f f' a b. a <= b /\ (!x. a <= x /\ x <= b ==> (f diffl f'(x))(x))
4376         ==> defint(a,b) f' (f(b) - f(a))`,
4377   REPEAT STRIP_TAC THEN
4378   UNDISCH_TAC `a <= b` THEN REWRITE_TAC[REAL_LE_LT] THEN
4379   DISCH_THEN DISJ_CASES_TAC THENL
4380    [ALL_TAC; ASM_REWRITE_TAC[REAL_SUB_REFL; INTEGRAL_NULL]] THEN
4381   REWRITE_TAC[defint] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
4382   SUBGOAL_THEN
4383     `!e. &0 < e ==>
4384       ?g. gauge(\x. a <= x /\ x <= b)g /\
4385           (!D p.
4386             tdiv(a,b)(D,p) /\ fine g(D,p) ==>
4387             (abs((rsum(D,p)f') - ((f b) - (f a)))) <= e)`
4388   MP_TAC THENL
4389    [ALL_TAC;
4390     DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_LT_HALF1] THEN
4391     DISCH_THEN(X_CHOOSE_THEN `g:real->real` STRIP_ASSUME_TAC) THEN
4392     EXISTS_TAC `g:real->real` THEN ASM_REWRITE_TAC[] THEN
4393     REPEAT GEN_TAC THEN
4394     DISCH_THEN(fun th -> FIRST_ASSUM(ASSUME_TAC o C MATCH_MP th)) THEN
4395     MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `e / &2` THEN
4396     ASM_REWRITE_TAC[REAL_LT_HALF2]] THEN
4397   UNDISCH_TAC `&0 < e` THEN DISCH_THEN(K ALL_TAC) THEN
4398   X_GEN_TAC `e:real` THEN DISCH_TAC THEN
4399   MP_TAC(SPECL [`f:real->real`; `f':real->real`;
4400     `a:real`; `b:real`; `e / (b - a)`] STRADDLE_LEMMA) THEN
4401   ASM_REWRITE_TAC[] THEN
4402   SUBGOAL_THEN `&0 < e / (b - a)` (fun th -> REWRITE_TAC[th]) THENL
4403    [REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LT_MUL THEN
4404     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_INV_POS THEN
4405     ASM_REWRITE_TAC[REAL_SUB_LT]; ALL_TAC] THEN
4406   DISCH_THEN(X_CHOOSE_THEN `g:real->real` STRIP_ASSUME_TAC) THEN
4407   EXISTS_TAC `g:real->real` THEN ASM_REWRITE_TAC[] THEN
4408   MAP_EVERY X_GEN_TAC [`D:num->real`; `p:num->real`] THEN
4409   REWRITE_TAC[tdiv] THEN STRIP_TAC THEN REWRITE_TAC[rsum] THEN
4410   SUBGOAL_THEN `f(b) - f(a) = sum(0,dsize D)(\n. f(D(SUC n)) - f(D(n)))`
4411   SUBST1_TAC THENL
4412    [MP_TAC(SPECL [`\n:num. (f:real->real)(D(n))`; `0`; `dsize D`]
4413       SUM_CANCEL) THEN BETA_TAC THEN DISCH_THEN SUBST1_TAC THEN
4414     ASM_REWRITE_TAC[ADD_CLAUSES] THEN
4415     MAP_EVERY (IMP_RES_THEN SUBST1_TAC) [DIVISION_LHS; DIVISION_RHS] THEN
4416     REFL_TAC; ALL_TAC] THEN
4417   ONCE_REWRITE_TAC[ABS_SUB] THEN REWRITE_TAC[GSYM SUM_SUB] THEN BETA_TAC THEN
4418   LE_MATCH_TAC ABS_SUM THEN BETA_TAC THEN
4419   SUBGOAL_THEN `e = sum(0,dsize D)(\n. (e / (b - a)) * (D(SUC n) - D(n)))`
4420   SUBST1_TAC THENL
4421    [ONCE_REWRITE_TAC[SYM(BETA_CONV `(\n. (D(SUC n) - D(n))) n`)] THEN
4422     ASM_REWRITE_TAC[SUM_CMUL; SUM_CANCEL; ADD_CLAUSES] THEN
4423     MAP_EVERY (IMP_RES_THEN SUBST1_TAC) [DIVISION_LHS; DIVISION_RHS] THEN
4424     CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_DIV_RMUL THEN
4425     REWRITE_TAC[REAL_SUB_0] THEN CONV_TAC(RAND_CONV SYM_CONV) THEN
4426     MATCH_MP_TAC REAL_LT_IMP_NE THEN FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN
4427   MATCH_MP_TAC SUM_LE THEN X_GEN_TAC `r:num` THEN
4428   REWRITE_TAC[ADD_CLAUSES] THEN STRIP_TAC THEN BETA_TAC THEN
4429   FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
4430    [IMP_RES_THEN (fun th -> REWRITE_TAC[th]) DIVISION_LBOUND;
4431     IMP_RES_THEN (fun th -> REWRITE_TAC[th]) DIVISION_UBOUND;
4432     UNDISCH_TAC `fine(g)(D,p)` THEN REWRITE_TAC[fine] THEN
4433     DISCH_THEN MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC]);;
4434
4435 (* ------------------------------------------------------------------------- *)
4436 (* Definition of integral and integrability.                                 *)
4437 (* ------------------------------------------------------------------------- *)
4438
4439 let integrable = new_definition
4440  `integrable(a,b) f = ?i. defint(a,b) f i`;;
4441
4442 let integral = new_definition
4443  `integral(a,b) f = @i. defint(a,b) f i`;;
4444
4445 let INTEGRABLE_DEFINT = prove
4446  (`!f a b. integrable(a,b) f ==> defint(a,b) f (integral(a,b) f)`,
4447   REPEAT GEN_TAC THEN REWRITE_TAC[integrable; integral] THEN
4448   CONV_TAC(RAND_CONV SELECT_CONV) THEN REWRITE_TAC[]);;
4449
4450 (* ------------------------------------------------------------------------- *)
4451 (* Other more or less trivial lemmas.                                        *)
4452 (* ------------------------------------------------------------------------- *)
4453
4454 let DIVISION_BOUNDS = prove
4455  (`!d a b. division(a,b) d ==> !n. a <= d(n) /\ d(n) <= b`,
4456   MESON_TAC[DIVISION_UBOUND; DIVISION_LBOUND]);;
4457
4458 let TDIV_BOUNDS = prove
4459  (`!d p a b. tdiv(a,b) (d,p)
4460              ==> !n. a <= d(n) /\ d(n) <= b /\ a <= p(n) /\ p(n) <= b`,
4461   REWRITE_TAC[tdiv] THEN ASM_MESON_TAC[DIVISION_BOUNDS; REAL_LE_TRANS]);;
4462
4463 let TDIV_LE = prove
4464  (`!d p a b. tdiv(a,b) (d,p) ==> a <= b`,
4465   MESON_TAC[tdiv; DIVISION_LE]);;
4466
4467 let DEFINT_WRONG = prove
4468  (`!a b f i. b < a ==> defint(a,b) f i`,
4469   REWRITE_TAC[defint; gauge] THEN REPEAT STRIP_TAC THEN
4470   EXISTS_TAC `\x:real. &0` THEN
4471   ASM_SIMP_TAC[REAL_ARITH `b < a ==> (a <= x /\ x <= b <=> F)`] THEN
4472   ASM_MESON_TAC[REAL_NOT_LE; TDIV_LE]);;
4473
4474 let DEFINT_INTEGRAL = prove
4475  (`!f a b i. a <= b /\ defint(a,b) f i ==> integral(a,b) f = i`,
4476   REPEAT STRIP_TAC THEN REWRITE_TAC[integral] THEN
4477   MATCH_MP_TAC SELECT_UNIQUE THEN ASM_MESON_TAC[DINT_UNIQ]);;
4478
4479 (* ------------------------------------------------------------------------- *)
4480 (* Linearity.                                                                *)
4481 (* ------------------------------------------------------------------------- *)
4482
4483 let DEFINT_CONST = prove
4484  (`!a b c. defint(a,b) (\x. c) (c * (b - a))`,
4485   REPEAT GEN_TAC THEN
4486   MP_TAC(SPECL [`\x. c * x`; `\x:real. c:real`; `a:real`; `b:real`] FTC1) THEN
4487   DISJ_CASES_TAC(REAL_ARITH `b < a \/ a <= b`) THEN
4488   ASM_SIMP_TAC[DEFINT_WRONG; REAL_SUB_LDISTRIB] THEN
4489   DISCH_THEN MATCH_MP_TAC THEN REPEAT STRIP_TAC THEN
4490   MP_TAC(SPEC `x:real` (DIFF_CONV `\x. c * x`)) THEN
4491   REWRITE_TAC[REAL_MUL_LID; REAL_MUL_LZERO; REAL_ADD_LID]);;
4492
4493 let DEFINT_0 = prove
4494  (`!a b. defint(a,b) (\x. &0) (&0)`,
4495   MP_TAC DEFINT_CONST THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
4496   DISCH_THEN(MP_TAC o SPEC `&0`) THEN REWRITE_TAC[REAL_MUL_LZERO]);;
4497
4498 let DEFINT_NEG = prove
4499  (`!f a b i. defint(a,b) f i ==> defint(a,b) (\x. --f x) (--i)`,
4500   REPEAT GEN_TAC THEN REWRITE_TAC[defint] THEN
4501   REWRITE_TAC[rsum; REAL_MUL_LNEG; SUM_NEG] THEN
4502   REWRITE_TAC[REAL_ARITH `abs(--x - --y) = abs(x - y)`]);;
4503
4504 let DEFINT_CMUL = prove
4505  (`!f a b c i. defint(a,b) f i ==> defint(a,b) (\x. c * f x) (c * i)`,
4506   REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THENL
4507    [MP_TAC(SPECL [`a:real`; `b:real`; `c:real`] DEFINT_CONST) THEN
4508     ASM_SIMP_TAC[REAL_MUL_LZERO];
4509     ALL_TAC] THEN
4510   REWRITE_TAC[defint] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN
4511   DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / abs c`) THEN
4512   ASM_SIMP_TAC[REAL_LT_DIV; GSYM REAL_ABS_NZ] THEN
4513   MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
4514   REWRITE_TAC[rsum; SUM_CMUL; GSYM REAL_MUL_ASSOC] THEN
4515   ASM_SIMP_TAC[GSYM REAL_SUB_LDISTRIB; REAL_ABS_MUL] THEN
4516   ASM_SIMP_TAC[REAL_LT_RDIV_EQ; GSYM REAL_ABS_NZ; REAL_MUL_SYM]);;
4517
4518 let DEFINT_ADD = prove
4519  (`!f g a b i j.
4520         defint(a,b) f i /\ defint(a,b) g j
4521         ==> defint(a,b) (\x. f x + g x) (i + j)`,
4522   REPEAT GEN_TAC THEN REWRITE_TAC[defint] THEN
4523   STRIP_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
4524   REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`)) THEN
4525   ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN
4526   DISCH_THEN(X_CHOOSE_THEN `g1:real->real` STRIP_ASSUME_TAC) THEN
4527   DISCH_THEN(X_CHOOSE_THEN `g2:real->real` STRIP_ASSUME_TAC) THEN
4528   EXISTS_TAC `\x:real. if g1(x) < g2(x) then g1(x) else g2(x)` THEN
4529   ASM_SIMP_TAC[GAUGE_MIN; rsum] THEN REPEAT STRIP_TAC THEN
4530   REWRITE_TAC[REAL_ADD_RDISTRIB; SUM_ADD] THEN REWRITE_TAC[GSYM rsum] THEN
4531   MATCH_MP_TAC(REAL_ARITH
4532    `abs(x - i) < e / &2 /\ abs(y - j) < e / &2
4533     ==> abs((x + y) - (i + j)) < e`) THEN
4534   ASM_MESON_TAC[FINE_MIN]);;
4535
4536 let DEFINT_SUB = prove
4537  (`!f g a b i j.
4538         defint(a,b) f i /\ defint(a,b) g j
4539         ==> defint(a,b) (\x. f x - g x) (i - j)`,
4540   SIMP_TAC[real_sub; DEFINT_ADD; DEFINT_NEG]);;
4541
4542 (* ------------------------------------------------------------------------- *)
4543 (* Ordering properties of integral.                                          *)
4544 (* ------------------------------------------------------------------------- *)
4545
4546 let INTEGRAL_LE = prove
4547  (`!f g a b i j.
4548         a <= b /\ integrable(a,b) f /\ integrable(a,b) g /\
4549         (!x. a <= x /\ x <= b ==> f(x) <= g(x))
4550         ==> integral(a,b) f <= integral(a,b) g`,
4551   REPEAT STRIP_TAC THEN
4552   REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP INTEGRABLE_DEFINT)) THEN
4553   MATCH_MP_TAC(REAL_ARITH `~(&0 < x - y) ==> x <= y`) THEN
4554   ABBREV_TAC `e = integral(a,b) f - integral(a,b) g` THEN DISCH_TAC THEN
4555   REPEAT(FIRST_X_ASSUM(MP_TAC o
4556     SPEC `e / &2` o GEN_REWRITE_RULE I [defint])) THEN
4557   ASM_REWRITE_TAC[REAL_ARITH `&0 < e / &2 <=> &0 < e`] THEN
4558   DISCH_THEN(X_CHOOSE_THEN `g1:real->real` STRIP_ASSUME_TAC) THEN
4559   DISCH_THEN(X_CHOOSE_THEN `g2:real->real` STRIP_ASSUME_TAC) THEN
4560   MP_TAC(SPECL [`a:real`; `b:real`;
4561                 `\x:real. if g1(x) < g2(x) then g1(x) else g2(x)`]
4562                DIVISION_EXISTS) THEN
4563   ASM_SIMP_TAC[GAUGE_MIN; NOT_EXISTS_THM] THEN
4564   MAP_EVERY X_GEN_TAC [`D:num->real`; `p:num->real`] THEN STRIP_TAC THEN
4565   REPEAT(FIRST_X_ASSUM(MP_TAC o SPECL [`D:num->real`; `p:num->real`])) THEN
4566   REPEAT(FIRST_X_ASSUM(MP_TAC o SPECL [`D:num->real`; `p:num->real`])) THEN
4567   FIRST_ASSUM(fun th -> ASM_REWRITE_TAC[MATCH_MP FINE_MIN th]) THEN
4568   MATCH_MP_TAC(REAL_ARITH
4569    `ih - ig = e /\ &0 < e /\ sh <= sg
4570     ==> abs(sg - ig) < e / &2 ==> ~(abs(sh - ih) < e / &2)`) THEN
4571   ASM_REWRITE_TAC[] THEN REWRITE_TAC[rsum] THEN MATCH_MP_TAC SUM_LE THEN
4572   X_GEN_TAC `r:num` THEN REWRITE_TAC[ADD_CLAUSES] THEN STRIP_TAC THEN
4573   MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_SUB_LE] THEN
4574   ASM_MESON_TAC[TDIV_BOUNDS; REAL_LT_IMP_LE; DIVISION_THM; tdiv]);;
4575
4576 let DEFINT_LE = prove
4577  (`!f g a b i j. a <= b /\ defint(a,b) f i /\ defint(a,b) g j /\
4578                  (!x. a <= x /\ x <= b ==> f(x) <= g(x))
4579                  ==> i <= j`,
4580   REPEAT GEN_TAC THEN MP_TAC(SPEC_ALL INTEGRAL_LE) THEN
4581   MESON_TAC[integrable; DEFINT_INTEGRAL]);;
4582
4583 let DEFINT_TRIANGLE = prove
4584  (`!f a b i j. a <= b /\ defint(a,b) f i /\ defint(a,b) (\x. abs(f x)) j
4585                ==> abs(i) <= j`,
4586   REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH
4587    `--a <= b /\ b <= a ==> abs(b) <= a`) THEN
4588   CONJ_TAC THEN MATCH_MP_TAC DEFINT_LE THENL
4589    [MAP_EVERY EXISTS_TAC [`\x:real. --abs(f x)`; `f:real->real`];
4590     MAP_EVERY EXISTS_TAC [`f:real->real`; `\x:real. abs(f x)`]] THEN
4591   MAP_EVERY EXISTS_TAC [`a:real`; `b:real`] THEN
4592   ASM_SIMP_TAC[DEFINT_NEG] THEN REAL_ARITH_TAC);;
4593
4594 let DEFINT_EQ = prove
4595  (`!f g a b i j. a <= b /\ defint(a,b) f i /\ defint(a,b) g j /\
4596                  (!x. a <= x /\ x <= b ==> f(x) = g(x))
4597                  ==> i = j`,
4598   REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN MESON_TAC[DEFINT_LE]);;
4599
4600 let INTEGRAL_EQ = prove
4601  (`!f g a b i. defint(a,b) f i /\
4602                (!x. a <= x /\ x <= b ==> f(x) = g(x))
4603                ==> defint(a,b) g i`,
4604   REPEAT STRIP_TAC THEN ASM_CASES_TAC `a <= b` THENL
4605    [ALL_TAC; ASM_MESON_TAC[REAL_NOT_LE; DEFINT_WRONG]] THEN
4606   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [defint]) THEN
4607   REWRITE_TAC[defint] THEN MATCH_MP_TAC MONO_FORALL THEN
4608   X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN
4609   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real->real` THEN
4610   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN
4611   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `D:num->real` THEN
4612   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `p:num->real` THEN
4613   DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN
4614   MATCH_MP_TAC(REAL_ARITH `x = y ==> abs(x - i) < e ==> abs(y - i) < e`) THEN
4615   REWRITE_TAC[rsum] THEN MATCH_MP_TAC SUM_EQ THEN
4616   REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN AP_THM_TAC THEN AP_TERM_TAC THEN
4617   FIRST_X_ASSUM MATCH_MP_TAC THEN
4618   ASM_MESON_TAC[tdiv; DIVISION_LBOUND; DIVISION_UBOUND; DIVISION_THM;
4619                 REAL_LE_TRANS]);;
4620
4621 (* ------------------------------------------------------------------------- *)
4622 (* Integration by parts.                                                     *)
4623 (* ------------------------------------------------------------------------- *)
4624
4625 let INTEGRATION_BY_PARTS = prove
4626  (`!f g f' g' a b.
4627         a <= b /\
4628         (!x. a <= x /\ x <= b ==> (f diffl f'(x))(x)) /\
4629         (!x. a <= x /\ x <= b ==> (g diffl g'(x))(x))
4630         ==> defint(a,b) (\x. f'(x) * g(x) + f(x) * g'(x))
4631                         (f(b) * g(b) - f(a) * g(a))`,
4632   REPEAT STRIP_TAC THEN MATCH_MP_TAC FTC1 THEN ASM_REWRITE_TAC[] THEN
4633   ONCE_REWRITE_TAC[REAL_ARITH `a + b * c = a + c * b`] THEN
4634   ASM_SIMP_TAC[DIFF_MUL]);;
4635
4636 (* ------------------------------------------------------------------------- *)
4637 (* Various simple lemmas about divisions.                                    *)
4638 (* ------------------------------------------------------------------------- *)
4639
4640 let DIVISION_LE_SUC = prove
4641  (`!d a b. division(a,b) d ==> !n. d(n) <= d(SUC n)`,
4642   REWRITE_TAC[DIVISION_THM; GE] THEN
4643   MESON_TAC[LET_CASES; LE; REAL_LE_REFL; REAL_LT_IMP_LE]);;
4644
4645 let DIVISION_MONO_LE = prove
4646  (`!d a b. division(a,b) d ==> !m n. m <= n ==> d(m) <= d(n)`,
4647   REPEAT GEN_TAC THEN DISCH_THEN(ASSUME_TAC o MATCH_MP DIVISION_LE_SUC) THEN
4648   SIMP_TAC[LE_EXISTS; LEFT_IMP_EXISTS_THM] THEN
4649   GEN_TAC THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN
4650   REWRITE_TAC[LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN
4651   INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; REAL_LE_REFL] THEN
4652   ASM_MESON_TAC[REAL_LE_TRANS]);;
4653
4654 let DIVISION_MONO_LE_SUC = prove
4655  (`!d a b. division(a,b) d ==> !n. d(n) <= d(SUC n)`,
4656   MESON_TAC[DIVISION_MONO_LE; LE; LE_REFL]);;
4657
4658 let DIVISION_INTERMEDIATE = prove
4659  (`!d a b c. division(a,b) d /\ a <= c /\ c <= b
4660              ==> ?n. n <= dsize d /\ d(n) <= c /\ c <= d(SUC n)`,
4661   REPEAT STRIP_TAC THEN
4662   MP_TAC(SPEC `\n. n <= dsize d /\ (d:num->real)(n) <= c` num_MAX) THEN
4663   DISCH_THEN(MP_TAC o fst o EQ_IMP_RULE) THEN ANTS_TAC THENL
4664    [ASM_MESON_TAC[LE_0; DIVISION_THM]; ALL_TAC] THEN
4665   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN SIMP_TAC[] THEN
4666   STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `SUC n`) THEN
4667   REWRITE_TAC[ARITH_RULE `~(SUC n <= n)`] THEN
4668   ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LE] THEN
4669   DISCH_TAC THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; LE_SUC_LT; LT_LE] THEN
4670   DISCH_THEN SUBST_ALL_TAC THEN
4671   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DIVISION_THM]) THEN
4672   DISCH_THEN(MP_TAC o SPEC `SUC(dsize d)` o repeat CONJUNCT2) THEN
4673   REWRITE_TAC[GE; LE; LE_REFL] THEN
4674   ASM_REAL_ARITH_TAC);;
4675
4676 let DIVISION_DSIZE_LE = prove
4677  (`!a b d n. division(a,b) d /\ d(SUC n) = d(n) ==> dsize d <= n`,
4678   REWRITE_TAC[DIVISION_THM] THEN MESON_TAC[REAL_LT_REFL; NOT_LT]);;
4679
4680 let DIVISION_DSIZE_GE = prove
4681  (`!a b d n. division(a,b) d /\ d(n) < d(SUC n) ==> SUC n <= dsize d`,
4682   REWRITE_TAC[DIVISION_THM; LE_SUC_LT; GE] THEN
4683   MESON_TAC[REAL_LT_REFL; LE; NOT_LT]);;
4684
4685 let DIVISION_DSIZE_EQ = prove
4686  (`!a b d n. division(a,b) d /\ d(n) < d(SUC n) /\ d(SUC(SUC n)) = d(SUC n)
4687            ==> dsize d = SUC n`,
4688   REWRITE_TAC[GSYM LE_ANTISYM] THEN
4689   MESON_TAC[DIVISION_DSIZE_LE; DIVISION_DSIZE_GE]);;
4690
4691 let DIVISION_DSIZE_EQ_ALT = prove
4692  (`!a b d n. division(a,b) d /\ d(SUC n) = d(n) /\
4693              (!i. i < n ==> d(i) < d(SUC i))
4694              ==> dsize d = n`,
4695   REPLICATE_TAC 3 GEN_TAC THEN INDUCT_TAC THENL
4696    [MESON_TAC[ARITH_RULE `d <= 0 ==> d = 0`; DIVISION_DSIZE_LE]; ALL_TAC] THEN
4697   REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM LE_ANTISYM] THEN
4698   ASM_MESON_TAC[DIVISION_DSIZE_LE; DIVISION_DSIZE_GE; LT]);;
4699
4700 (* ------------------------------------------------------------------------- *)
4701 (* Combination of adjacent intervals (quite painful in the details).         *)
4702 (* ------------------------------------------------------------------------- *)
4703
4704 let DEFINT_COMBINE = prove
4705  (`!f a b c i j. a <= b /\ b <= c /\ defint(a,b) f i /\ defint(b,c) f j
4706                  ==> defint(a,c) f (i + j)`,
4707   REPEAT GEN_TAC THEN
4708   REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
4709   MP_TAC(ASSUME `a <= b`) THEN REWRITE_TAC[REAL_LE_LT] THEN
4710   ASM_CASES_TAC `a:real = b` THEN ASM_REWRITE_TAC[] THENL
4711    [ASM_MESON_TAC[INTEGRAL_NULL; DINT_UNIQ; REAL_LE_TRANS; REAL_ADD_LID];
4712     DISCH_TAC] THEN
4713   MP_TAC(ASSUME `b <= c`) THEN REWRITE_TAC[REAL_LE_LT] THEN
4714   ASM_CASES_TAC `b:real = c` THEN ASM_REWRITE_TAC[] THENL
4715    [ASM_MESON_TAC[INTEGRAL_NULL; DINT_UNIQ; REAL_LE_TRANS; REAL_ADD_RID];
4716     DISCH_TAC] THEN
4717   REWRITE_TAC[defint; AND_FORALL_THM] THEN
4718   DISCH_THEN(fun th -> X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC th) THEN
4719   DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN
4720   ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN
4721   DISCH_THEN(CONJUNCTS_THEN2
4722    (X_CHOOSE_THEN `g1:real->real` STRIP_ASSUME_TAC)
4723    (X_CHOOSE_THEN `g2:real->real` STRIP_ASSUME_TAC)) THEN
4724   EXISTS_TAC
4725    `\x. if x < b then min (g1 x) (b - x)
4726         else if b < x then min (g2 x) (x - b)
4727         else min (g1 x) (g2 x)` THEN
4728   CONJ_TAC THENL
4729    [REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [gauge])) THEN
4730     REWRITE_TAC[gauge] THEN REPEAT STRIP_TAC THEN
4731     REPEAT COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_LT_MIN; REAL_SUB_LT] THEN
4732     TRY CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
4733     ASM_REAL_ARITH_TAC;
4734     ALL_TAC] THEN
4735   MAP_EVERY X_GEN_TAC [`d:num->real`; `p:num->real`] THEN
4736   REWRITE_TAC[tdiv; rsum] THEN STRIP_TAC THEN
4737   MP_TAC(SPECL [`d:num->real`; `a:real`; `c:real`; `b:real`]
4738                DIVISION_INTERMEDIATE) THEN ASM_REWRITE_TAC[] THEN
4739   DISCH_THEN(X_CHOOSE_THEN `m:num`
4740    (CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC)) THEN REWRITE_TAC[LE_EXISTS] THEN
4741   DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN ASM_REWRITE_TAC[] THEN
4742   ASM_CASES_TAC `n = 0` THENL
4743    [FIRST_X_ASSUM SUBST_ALL_TAC THEN
4744     RULE_ASSUM_TAC(REWRITE_RULE[ADD_CLAUSES]) THEN
4745     FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN
4746     ASM_MESON_TAC[DIVISION_THM; GE; LE_REFL; REAL_NOT_LT];
4747     ALL_TAC] THEN
4748   REWRITE_TAC[GSYM SUM_SPLIT; ADD_CLAUSES] THEN
4749   FIRST_ASSUM(SUBST1_TAC o MATCH_MP (ARITH_RULE
4750    `~(n = 0) ==> n = 1 + PRE n`)) THEN
4751   REWRITE_TAC[GSYM SUM_SPLIT; SUM_1] THEN
4752   SUBGOAL_THEN `(p:num->real) m = b` ASSUME_TAC THENL
4753    [FIRST_X_ASSUM(MP_TAC o SPEC `m:num` o GEN_REWRITE_RULE I [fine]) THEN
4754     ASM_REWRITE_TAC[ARITH_RULE `m < m + n <=> ~(n = 0)`] THEN
4755     FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN
4756     MAP_EVERY UNDISCH_TAC [`(d:num->real) m <= b`; `b:real <= d(SUC m)`] THEN
4757     REAL_ARITH_TAC;
4758     ALL_TAC] THEN
4759   MATCH_MP_TAC(REAL_ARITH
4760    `!b. abs((s1 + x * (b - a)) - i) < e / &2 /\
4761         abs((s2 + x * (c - b)) - j) < e / &2
4762         ==> abs((s1 + x * (c - a) + s2) - (i + j)) < e`) THEN
4763   EXISTS_TAC `b:real` THEN CONJ_TAC THENL
4764    [UNDISCH_TAC
4765      `!D p. tdiv(a,b) (D,p) /\ fine g1 (D,p)
4766             ==> abs(rsum(D,p) f - i) < e / &2` THEN
4767     DISCH_THEN(MP_TAC o SPEC `\i. if i <= m then (d:num->real)(i) else b`) THEN
4768     DISCH_THEN(MP_TAC o SPEC `\i. if i <= m then (p:num->real)(i) else b`) THEN
4769     MATCH_MP_TAC(TAUT `a /\ (a ==> b) /\ (a /\ c ==> d)
4770                        ==> (a /\ b ==> c) ==> d`) THEN
4771     CONJ_TAC THENL
4772      [REWRITE_TAC[tdiv; division] THEN REPEAT CONJ_TAC THENL
4773        [ASM_MESON_TAC[division; LE_0];
4774         ALL_TAC;
4775         X_GEN_TAC `k:num` THEN
4776         REWRITE_TAC[ARITH_RULE `SUC n <= m <=> n <= m /\ ~(m = n)`] THEN
4777         ASM_CASES_TAC `k:num = m` THEN
4778         ASM_REWRITE_TAC[LE_REFL; REAL_LE_REFL] THEN
4779         COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL]] THEN
4780       ASM_CASES_TAC `(d:num->real) m = b` THENL
4781        [EXISTS_TAC `m:num` THEN
4782         SIMP_TAC[ARITH_RULE `n < m ==> n <= m /\ SUC n <= m`] THEN
4783         SIMP_TAC[ARITH_RULE `n >= m ==> (n <= m <=> m = n:num)`] THEN
4784         CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN
4785         FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DIVISION_THM]) THEN
4786         ASM_REWRITE_TAC[] THEN
4787         MESON_TAC[ARITH_RULE `i:num < m ==> i < m + n`];
4788         ALL_TAC] THEN
4789       EXISTS_TAC `SUC m` THEN
4790       SIMP_TAC[ARITH_RULE `n >= SUC m ==> ~(n <= m)`] THEN
4791       SIMP_TAC[ARITH_RULE `n < SUC m ==> n <= m`] THEN
4792       SIMP_TAC[ARITH_RULE `n < SUC m ==> (SUC n <= m <=> ~(m = n))`] THEN
4793       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DIVISION_THM]) THEN
4794       ASM_REWRITE_TAC[] THEN
4795       ASM_MESON_TAC[ARITH_RULE `k < SUC m /\ ~(n = 0) ==> k < m + n`;
4796                     REAL_LT_LE];
4797       ALL_TAC] THEN
4798     CONJ_TAC THENL
4799      [REWRITE_TAC[tdiv; fine] THEN STRIP_TAC THEN X_GEN_TAC `k:num` THEN
4800       REWRITE_TAC[ARITH_RULE `SUC n <= m <=> n <= m /\ ~(m = n)`] THEN
4801       FIRST_X_ASSUM(MP_TAC o SPEC `k:num` o GEN_REWRITE_RULE I [fine]) THEN
4802       MATCH_MP_TAC MONO_IMP THEN ASM_CASES_TAC `k:num = m` THENL
4803        [ASM_REWRITE_TAC[LE_REFL; REAL_LT_REFL] THEN
4804         ASM_REWRITE_TAC[ARITH_RULE `m < m + n <=> ~(n = 0)`] THEN
4805         MAP_EVERY UNDISCH_TAC [`d(m:num) <= b`; `b <= d(SUC m)`] THEN
4806         REAL_ARITH_TAC;
4807         ALL_TAC] THEN
4808       ASM_CASES_TAC `k:num <= m` THEN ASM_REWRITE_TAC[] THENL
4809        [ASM_SIMP_TAC[ARITH_RULE `k <= m /\ ~(n = 0) ==> k < m + n`] THEN
4810         SUBGOAL_THEN `(p:num->real) k <= b` MP_TAC THENL
4811          [ALL_TAC; REAL_ARITH_TAC] THEN
4812         MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(d:num->real) m` THEN
4813         ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN
4814         EXISTS_TAC `(d:num->real) (SUC k)` THEN ASM_REWRITE_TAC[] THEN
4815         ASM_MESON_TAC[DIVISION_MONO_LE; ARITH_RULE
4816          `k <= m /\ ~(k = m) ==> SUC k <= m`];
4817         ALL_TAC] THEN
4818       CONJ_TAC THENL
4819        [MATCH_MP_TAC(ARITH_RULE
4820          `d:num <= SUC m /\ ~(n = 0) ==> k < d ==> k < m + n`) THEN
4821         ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIVISION_DSIZE_LE THEN
4822         MAP_EVERY EXISTS_TAC [`a:real`; `b:real`] THEN ASM_REWRITE_TAC[] THEN
4823         ARITH_TAC;
4824         ALL_TAC] THEN
4825       UNDISCH_TAC `gauge (\x. a <= x /\ x <= b) g1` THEN
4826       ASM_REWRITE_TAC[REAL_SUB_REFL; gauge; REAL_LE_REFL] THEN
4827       DISCH_THEN(fun th -> DISCH_THEN(K ALL_TAC) THEN MP_TAC th) THEN
4828       ASM_MESON_TAC[REAL_LE_REFL];
4829       ALL_TAC] THEN
4830     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
4831     MATCH_MP_TAC(REAL_ARITH
4832      `x = y ==> abs(x - i) < e ==> abs(y - i) < e`) THEN
4833     REWRITE_TAC[rsum] THEN ASM_CASES_TAC `(d:num->real) m = b` THENL
4834      [SUBGOAL_THEN `dsize (\i. if i <= m then d i else b) = m` ASSUME_TAC THENL
4835        [ALL_TAC;
4836         ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO; REAL_ADD_RID] THEN
4837         MATCH_MP_TAC SUM_EQ THEN
4838         SIMP_TAC[ADD_CLAUSES; LT_IMP_LE; LE_SUC_LT]] THEN
4839       MATCH_MP_TAC DIVISION_DSIZE_EQ_ALT THEN
4840       MAP_EVERY EXISTS_TAC [`a:real`; `b:real`] THEN
4841       CONJ_TAC THENL [ASM_MESON_TAC[tdiv]; ALL_TAC] THEN
4842       ASM_REWRITE_TAC[LE_REFL; ARITH_RULE `~(SUC m <= m)`] THEN
4843       SIMP_TAC[LT_IMP_LE; LE_SUC_LT] THEN
4844       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DIVISION_THM]) THEN
4845       ASM_REWRITE_TAC[] THEN MESON_TAC[ARITH_RULE `i < m:num ==> i < m + n`];
4846       ALL_TAC] THEN
4847     SUBGOAL_THEN `dsize (\i. if i <= m then d i else b) = SUC m`
4848     ASSUME_TAC THENL
4849      [ALL_TAC;
4850       ASM_REWRITE_TAC[sum; ADD_CLAUSES; LE_REFL;
4851                       ARITH_RULE `~(SUC m <= m)`] THEN
4852       AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC SUM_EQ THEN
4853       SIMP_TAC[ADD_CLAUSES; LT_IMP_LE; LE_SUC_LT]] THEN
4854     MATCH_MP_TAC DIVISION_DSIZE_EQ THEN
4855     MAP_EVERY EXISTS_TAC [`a:real`; `b:real`] THEN
4856     CONJ_TAC THENL [ASM_MESON_TAC[tdiv]; ALL_TAC] THEN
4857     ASM_REWRITE_TAC[LE_REFL; ARITH_RULE `~(SUC m <= m)`] THEN
4858     REWRITE_TAC[ARITH_RULE `~(SUC(SUC m) <= m)`] THEN
4859     ASM_REWRITE_TAC[REAL_LT_LE];
4860     ALL_TAC] THEN
4861   ASM_CASES_TAC `d(SUC m):real = b` THEN ASM_REWRITE_TAC[] THENL
4862    [ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO; REAL_ADD_RID] THEN
4863     UNDISCH_TAC
4864      `!D p. tdiv(b,c) (D,p) /\ fine g2 (D,p)
4865             ==> abs(rsum(D,p) f - j) < e / &2` THEN
4866     DISCH_THEN(MP_TAC o SPEC `\i. (d:num->real) (i + SUC m)`) THEN
4867     DISCH_THEN(MP_TAC o SPEC `\i. (p:num->real) (i + SUC m)`) THEN
4868     MATCH_MP_TAC(TAUT `a /\ (a ==> b /\ (b /\ c ==> d))
4869                        ==> (a /\ b ==> c) ==> d`) THEN
4870     CONJ_TAC THENL
4871      [ASM_REWRITE_TAC[tdiv; division; ADD_CLAUSES] THEN EXISTS_TAC `PRE n` THEN
4872       FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DIVISION_THM]) THEN
4873       ASM_MESON_TAC[ARITH_RULE
4874                      `~(n = 0) /\ k < PRE n ==> SUC(k + m) < m + n`;
4875                     ARITH_RULE
4876                      `~(n = 0) /\ k >= PRE n ==> SUC(k + m) >= m + n`];
4877       DISCH_TAC] THEN
4878     SUBGOAL_THEN `dsize(\i. d (i + SUC m)) = PRE n` ASSUME_TAC THENL
4879      [MATCH_MP_TAC DIVISION_DSIZE_EQ_ALT THEN
4880       MAP_EVERY EXISTS_TAC [`b:real`; `c:real`] THEN
4881       CONJ_TAC THENL [ASM_MESON_TAC[tdiv]; ALL_TAC] THEN
4882       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DIVISION_THM]) THEN
4883       DISCH_THEN(MP_TAC o CONJUNCT2) THEN ASM_REWRITE_TAC[ADD_CLAUSES] THEN
4884       GEN_REWRITE_TAC RAND_CONV [CONJ_SYM] THEN
4885       MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL
4886        [ALL_TAC;
4887         ASM_MESON_TAC[ARITH_RULE `SUC(PRE n + m) >= m + n /\
4888                                   SUC(SUC(PRE n + m)) >= m + n`]] THEN
4889       DISCH_THEN(fun th -> X_GEN_TAC `k:num` THEN DISCH_TAC THEN
4890                            MATCH_MP_TAC th) THEN
4891       UNDISCH_TAC `k < PRE n` THEN ARITH_TAC;
4892       ALL_TAC] THEN
4893     CONJ_TAC THENL
4894      [ASM_REWRITE_TAC[fine] THEN X_GEN_TAC `k:num` THEN DISCH_TAC THEN
4895       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [fine]) THEN
4896       DISCH_THEN(MP_TAC o SPEC `k + SUC m`) THEN
4897       ASM_REWRITE_TAC[ADD_CLAUSES] THEN ANTS_TAC THENL
4898        [UNDISCH_TAC `k < PRE n` THEN ARITH_TAC; ALL_TAC] THEN
4899       MATCH_MP_TAC(REAL_ARITH `b <= a ==> x < b ==> x < a`) THEN
4900       SUBGOAL_THEN `~(p(SUC (k + m)) < b)`
4901         (fun th -> REWRITE_TAC[th] THEN REAL_ARITH_TAC) THEN
4902       REWRITE_TAC[REAL_NOT_LT] THEN
4903       FIRST_ASSUM(MP_TAC o CONJUNCT1 o SPEC `SUC(k + m)`) THEN
4904       UNDISCH_TAC `b <= d (SUC m)` THEN
4905       FIRST_X_ASSUM(MP_TAC o MATCH_MP DIVISION_MONO_LE) THEN
4906       DISCH_THEN(MP_TAC o SPECL [`SUC m`; `k + SUC m`]) THEN
4907       ANTS_TAC THENL [ARITH_TAC; ALL_TAC] THEN
4908       REWRITE_TAC[ADD_CLAUSES] THEN REAL_ARITH_TAC;
4909       ALL_TAC] THEN
4910      ASM_REWRITE_TAC[rsum] THEN
4911      DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
4912      SUBST1_TAC(ARITH_RULE `m + 1 = 0 + SUC m`) THEN
4913      REWRITE_TAC[SUM_REINDEX] THEN
4914      MATCH_MP_TAC(REAL_ARITH
4915       `x = y ==> abs(x - i) < e ==> abs(y - i) < e`) THEN
4916      MATCH_MP_TAC SUM_EQ THEN REWRITE_TAC[ADD_CLAUSES];
4917      ALL_TAC] THEN
4918   UNDISCH_TAC
4919    `!D p. tdiv(b,c) (D,p) /\ fine g2 (D,p)
4920           ==> abs(rsum(D,p) f - j) < e / &2` THEN
4921   DISCH_THEN(MP_TAC o SPEC `\i. if i = 0 then b:real else d(i + m)`) THEN
4922   DISCH_THEN(MP_TAC o SPEC `\i. if i = 0 then b:real else p(i + m)`) THEN
4923   MATCH_MP_TAC(TAUT `a /\ (a ==> b /\ (b /\ c ==> d))
4924                      ==> (a /\ b ==> c) ==> d`) THEN
4925   CONJ_TAC THENL
4926    [ASM_REWRITE_TAC[tdiv; division; ADD_CLAUSES] THEN CONJ_TAC THENL
4927      [ALL_TAC;
4928       GEN_TAC THEN REWRITE_TAC[NOT_SUC] THEN
4929       COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN
4930       FIRST_X_ASSUM(MP_TAC o CONJUNCT2 o SPEC `m:num`) THEN
4931       ASM_REWRITE_TAC[ADD_CLAUSES]] THEN
4932     EXISTS_TAC `n:num` THEN REWRITE_TAC[NOT_SUC] THEN
4933     FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DIVISION_THM]) THEN
4934     DISCH_THEN(MP_TAC o CONJUNCT2) THEN MATCH_MP_TAC MONO_AND THEN
4935     ASM_REWRITE_TAC[] THEN CONJ_TAC THEN DISCH_THEN(fun th ->
4936       X_GEN_TAC `k:num` THEN MP_TAC(SPEC `k + m:num` th))
4937     THENL [ALL_TAC; UNDISCH_TAC `~(n = 0)` THEN ARITH_TAC] THEN
4938     ASM_CASES_TAC `k:num < n` THEN
4939     ASM_REWRITE_TAC[ARITH_RULE `k + m:num < m + n <=> k < n`] THEN
4940     COND_CASES_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES] THEN
4941     ASM_REWRITE_TAC[REAL_LT_LE];
4942     DISCH_TAC] THEN
4943   SUBGOAL_THEN `dsize(\i. if i = 0 then b else d (i + m)) = n` ASSUME_TAC
4944   THENL
4945    [MATCH_MP_TAC DIVISION_DSIZE_EQ_ALT THEN
4946     MAP_EVERY EXISTS_TAC [`b:real`; `c:real`] THEN
4947     CONJ_TAC THENL [ASM_MESON_TAC[tdiv]; ALL_TAC] THEN
4948     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DIVISION_THM]) THEN
4949     DISCH_THEN(MP_TAC o CONJUNCT2) THEN ASM_REWRITE_TAC[ADD_CLAUSES] THEN
4950     GEN_REWRITE_TAC RAND_CONV [CONJ_SYM] THEN REWRITE_TAC[NOT_SUC] THEN
4951     MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL
4952      [ALL_TAC; MESON_TAC[GE; ADD_SYM; LE_REFL; LE]] THEN
4953     DISCH_THEN(fun th ->
4954       X_GEN_TAC `k:num` THEN MP_TAC(SPEC `k + m:num` th)) THEN
4955     ASM_CASES_TAC `k:num < n` THEN
4956     ASM_REWRITE_TAC[ARITH_RULE `k + m:num < m + n <=> k < n`] THEN
4957     COND_CASES_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES] THEN
4958     ASM_REWRITE_TAC[REAL_LT_LE];
4959     ALL_TAC] THEN
4960   CONJ_TAC THENL
4961    [ASM_REWRITE_TAC[fine] THEN X_GEN_TAC `k:num` THEN DISCH_TAC THEN
4962     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [fine]) THEN
4963     DISCH_THEN(MP_TAC o SPEC `k + m:num`) THEN
4964     ASM_REWRITE_TAC[ADD_CLAUSES; NOT_SUC;
4965                     ARITH_RULE `k + m < m + n <=> k:num < n`] THEN
4966     ASM_CASES_TAC `k = 0` THEN ASM_REWRITE_TAC[] THENL
4967      [ASM_REWRITE_TAC[ADD_CLAUSES; REAL_LT_REFL] THEN
4968       MAP_EVERY UNDISCH_TAC [`(d:num->real) m <= b`; `b <= d (SUC m)`] THEN
4969       REAL_ARITH_TAC;
4970       ALL_TAC] THEN
4971     MATCH_MP_TAC(REAL_ARITH `b <= a ==> x < b ==> x < a`) THEN
4972     SUBGOAL_THEN `~((p:num->real) (k + m) < b)`
4973      (fun th -> REWRITE_TAC[th] THEN REAL_ARITH_TAC) THEN
4974     REWRITE_TAC[REAL_NOT_LT] THEN
4975     MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `d(SUC m):real` THEN
4976     ASM_REWRITE_TAC[] THEN
4977     MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(d:num->real)(k + m)` THEN
4978     ASM_REWRITE_TAC[] THEN
4979     FIRST_X_ASSUM(MP_TAC o MATCH_MP DIVISION_MONO_LE) THEN
4980     DISCH_THEN MATCH_MP_TAC THEN UNDISCH_TAC `~(k = 0)` THEN ARITH_TAC;
4981     ALL_TAC] THEN
4982   ASM_REWRITE_TAC[rsum] THEN
4983   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
4984   MATCH_MP_TAC(REAL_ARITH
4985    `x = y ==> abs(x - i) < e ==> abs(y - i) < e`) THEN
4986   SUBGOAL_THEN `n = 1 + PRE n`
4987    (fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o RAND_CONV) [th])
4988   THENL [UNDISCH_TAC `~(n = 0)` THEN ARITH_TAC; ALL_TAC] THEN
4989   REWRITE_TAC[GSYM SUM_SPLIT; SUM_1; NOT_SUC; ADD_CLAUSES] THEN
4990   MATCH_MP_TAC(REAL_ARITH `a = b ==> x + a = b + x`) THEN
4991   SUBST1_TAC(ARITH_RULE `1 = 0 + 1`) THEN
4992   SUBST1_TAC(ARITH_RULE `m + 0 + 1 = 0 + m + 1`) THEN
4993   ONCE_REWRITE_TAC[SUM_REINDEX] THEN MATCH_MP_TAC SUM_EQ THEN
4994   REWRITE_TAC[ADD_CLAUSES; ADD_EQ_0; ARITH] THEN REWRITE_TAC[ADD_AC]);;
4995
4996 (* ------------------------------------------------------------------------- *)
4997 (* Pointwise perturbation and spike functions.                               *)
4998 (* ------------------------------------------------------------------------- *)
4999
5000 let DEFINT_DELTA_LEFT = prove
5001  (`!a b. defint(a,b) (\x. if x = a then &1 else &0) (&0)`,
5002   REPEAT GEN_TAC THEN DISJ_CASES_TAC(REAL_ARITH `b < a \/ a <= b`) THEN
5003   ASM_SIMP_TAC[DEFINT_WRONG] THEN REWRITE_TAC[defint] THEN
5004   X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `(\x. e):real->real` THEN
5005   ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH;
5006                gauge; fine; rsum; tdiv; REAL_SUB_RZERO] THEN
5007   MAP_EVERY X_GEN_TAC [`d:num->real`; `p:num->real`] THEN STRIP_TAC THEN
5008   ASM_CASES_TAC `dsize d = 0` THEN ASM_REWRITE_TAC[sum; REAL_ABS_NUM] THEN
5009   FIRST_ASSUM(SUBST1_TAC o MATCH_MP
5010    (ARITH_RULE `~(n = 0) ==> n = 1 + PRE n`)) THEN
5011   REWRITE_TAC[GSYM SUM_SPLIT; SUM_1; ADD_CLAUSES] THEN
5012   MATCH_MP_TAC(REAL_ARITH
5013    `(&0 <= x /\ x < e) /\ y = &0 ==> abs(x + y) < e`) THEN
5014   CONJ_TAC THENL
5015    [COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_LE_REFL] THEN
5016     REWRITE_TAC[REAL_MUL_LID; REAL_SUB_LE] THEN
5017     ASM_MESON_TAC[DIVISION_THM; LE_0; LT_NZ];
5018     ALL_TAC] THEN
5019   MATCH_MP_TAC SUM_EQ_0 THEN X_GEN_TAC `r:num` THEN
5020   STRIP_TAC THEN REWRITE_TAC[] THEN
5021   COND_CASES_TAC THEN REWRITE_TAC[REAL_MUL_LZERO] THEN
5022   FIRST_ASSUM(MP_TAC o SPECL [`1`; `r:num`] o MATCH_MP DIVISION_MONO_LE) THEN
5023   ASM_REWRITE_TAC[] THEN
5024   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DIVISION_THM]) THEN
5025   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o CONJUNCT1)) THEN
5026   DISCH_THEN(MP_TAC o SPEC `0`) THEN ASM_REWRITE_TAC[ARITH; LT_NZ] THEN
5027   FIRST_X_ASSUM(MP_TAC o CONJUNCT1 o SPEC `r:num`) THEN
5028   ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);;
5029
5030 let DEFINT_DELTA_RIGHT = prove
5031  (`!a b. defint(a,b) (\x. if x = b then &1 else &0) (&0)`,
5032   REPEAT GEN_TAC THEN DISJ_CASES_TAC(REAL_ARITH `b < a \/ a <= b`) THEN
5033   ASM_SIMP_TAC[DEFINT_WRONG] THEN REWRITE_TAC[defint] THEN
5034   X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `(\x. e):real->real` THEN
5035   ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH;
5036                gauge; fine; rsum; tdiv; REAL_SUB_RZERO] THEN
5037   MAP_EVERY X_GEN_TAC [`d:num->real`; `p:num->real`] THEN STRIP_TAC THEN
5038   ASM_CASES_TAC `dsize d = 0` THEN ASM_REWRITE_TAC[sum; REAL_ABS_NUM] THEN
5039   FIRST_ASSUM(ASSUME_TAC o MATCH_MP
5040    (ARITH_RULE `~(n = 0) ==> n = PRE n + 1`)) THEN
5041   ABBREV_TAC `m = PRE(dsize d)` THEN
5042   ASM_REWRITE_TAC[GSYM SUM_SPLIT; SUM_1; ADD_CLAUSES] THEN
5043   MATCH_MP_TAC(REAL_ARITH
5044    `(&0 <= x /\ x < e) /\ y = &0 ==> abs(y + x) < e`) THEN
5045   CONJ_TAC THENL
5046    [COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_LE_REFL] THEN
5047     REWRITE_TAC[REAL_MUL_LID; REAL_SUB_LE] THEN
5048     ASM_MESON_TAC[DIVISION_THM; ARITH_RULE `m < m + 1`; REAL_LT_IMP_LE];
5049     ALL_TAC] THEN
5050   MATCH_MP_TAC SUM_EQ_0 THEN X_GEN_TAC `r:num` THEN
5051   REWRITE_TAC[ADD_CLAUSES] THEN STRIP_TAC THEN
5052   COND_CASES_TAC THEN REWRITE_TAC[REAL_MUL_LZERO] THEN
5053   FIRST_X_ASSUM(MP_TAC o CONJUNCT2 o SPEC `r:num`) THEN
5054   FIRST_ASSUM(MP_TAC o SPECL [`SUC r`; `m:num`] o
5055     MATCH_MP DIVISION_MONO_LE) THEN
5056   ASM_REWRITE_TAC[LE_SUC_LT] THEN
5057   FIRST_X_ASSUM(MP_TAC o CONJUNCT2 o GEN_REWRITE_RULE I [DIVISION_THM]) THEN
5058   DISCH_THEN(CONJUNCTS_THEN2
5059    (MP_TAC o SPEC `m:num`) (MP_TAC o SPEC `m + 1`)) THEN
5060   ASM_REWRITE_TAC[GE; LE_REFL; ARITH_RULE `x < x + 1`] THEN
5061   REWRITE_TAC[ADD1] THEN REAL_ARITH_TAC);;
5062
5063 let DEFINT_DELTA = prove
5064  (`!a b c. defint(a,b) (\x. if x = c then &1 else &0) (&0)`,
5065   REPEAT GEN_TAC THEN ASM_CASES_TAC `a <= b` THENL
5066    [ALL_TAC; ASM_MESON_TAC[REAL_NOT_LE; DEFINT_WRONG]] THEN
5067   ASM_CASES_TAC `a <= c /\ c <= b` THENL
5068    [ALL_TAC;
5069     MATCH_MP_TAC INTEGRAL_EQ THEN EXISTS_TAC `\x:real. &0` THEN
5070     ASM_REWRITE_TAC[DEFINT_0] THEN ASM_MESON_TAC[]] THEN
5071   GEN_REWRITE_TAC RAND_CONV [GSYM REAL_ADD_LID] THEN
5072   MATCH_MP_TAC DEFINT_COMBINE THEN EXISTS_TAC `c:real` THEN
5073   ASM_REWRITE_TAC[DEFINT_DELTA_LEFT; DEFINT_DELTA_RIGHT]);;
5074
5075 let DEFINT_POINT_SPIKE = prove
5076  (`!f g a b c i.
5077         (!x. a <= x /\ x <= b /\ ~(x = c) ==> (f x = g x)) /\ defint(a,b) f i
5078         ==> defint(a,b) g i`,
5079   REPEAT STRIP_TAC THEN ASM_CASES_TAC `a <= b` THENL
5080    [ALL_TAC; ASM_MESON_TAC[REAL_NOT_LE; DEFINT_WRONG]] THEN
5081   MATCH_MP_TAC INTEGRAL_EQ THEN
5082   EXISTS_TAC `\x:real. f(x) + (g c - f c) * (if x = c then &1 else &0)` THEN
5083   ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
5084    [SUBST1_TAC(REAL_ARITH `i = i + ((g:real->real) c - f c) * &0`) THEN
5085     MATCH_MP_TAC DEFINT_ADD THEN ASM_REWRITE_TAC[] THEN
5086     MATCH_MP_TAC DEFINT_CMUL THEN REWRITE_TAC[DEFINT_DELTA];
5087     REPEAT GEN_TAC THEN COND_CASES_TAC THEN
5088     ASM_SIMP_TAC[REAL_MUL_RZERO; REAL_ADD_RID] THEN
5089     REAL_ARITH_TAC]);;
5090
5091 let DEFINT_FINITE_SPIKE = prove
5092  (`!f g a b s i.
5093         FINITE s /\
5094         (!x. a <= x /\ x <= b /\ ~(x IN s) ==> (f x = g x)) /\
5095         defint(a,b) f i
5096         ==> defint(a,b) g i`,
5097   REPEAT GEN_TAC THEN
5098   REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> c ==> a ==> b ==> d`] THEN
5099   DISCH_TAC THEN MAP_EVERY (fun t -> SPEC_TAC(t,t))
5100    [`g:real->real`; `s:real->bool`] THEN
5101   REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
5102   REWRITE_TAC[NOT_IN_EMPTY] THEN
5103   CONJ_TAC THENL [ASM_MESON_TAC[INTEGRAL_EQ]; ALL_TAC] THEN
5104   MAP_EVERY X_GEN_TAC [`c:real`; `s:real->bool`] THEN STRIP_TAC THEN
5105   X_GEN_TAC `g:real->real` THEN REWRITE_TAC[IN_INSERT; DE_MORGAN_THM] THEN
5106   DISCH_TAC THEN MATCH_MP_TAC DEFINT_POINT_SPIKE THEN
5107   EXISTS_TAC `\x. if x = c then (f:real->real) x else g x` THEN
5108   EXISTS_TAC `c:real` THEN SIMP_TAC[] THEN
5109   FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[]);;
5110
5111 (* ------------------------------------------------------------------------- *)
5112 (* Cauchy-type integrability criterion.                                      *)
5113 (* ------------------------------------------------------------------------- *)
5114
5115 let GAUGE_MIN_FINITE = prove
5116  (`!s gs n. (!m:num. m <= n ==> gauge s (gs m))
5117             ==> ?g. gauge s g /\
5118                     !d p. fine g (d,p) ==> !m. m <= n ==> fine (gs m) (d,p)`,
5119   GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[LE] THENL
5120    [MESON_TAC[]; ALL_TAC] THEN
5121   REWRITE_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN
5122   SIMP_TAC[FORALL_AND_THM; LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN
5123   STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN
5124   ASM_REWRITE_TAC[] THEN
5125   DISCH_THEN(X_CHOOSE_THEN `gm:real->real` STRIP_ASSUME_TAC) THEN
5126   EXISTS_TAC `\x:real. if gm x < gs(SUC n) x then gm x else gs(SUC n) x` THEN
5127   ASM_SIMP_TAC[GAUGE_MIN; ETA_AX] THEN REPEAT GEN_TAC THEN
5128   DISCH_THEN(MP_TAC o MATCH_MP FINE_MIN) THEN ASM_SIMP_TAC[ETA_AX]);;
5129
5130 let INTEGRABLE_CAUCHY = prove
5131  (`!f a b. integrable(a,b) f <=>
5132            !e. &0 < e
5133                ==> ?g. gauge (\x. a <= x /\ x <= b) g /\
5134                        !d1 p1 d2 p2.
5135                             tdiv (a,b) (d1,p1) /\ fine g (d1,p1) /\
5136                             tdiv (a,b) (d2,p2) /\ fine g (d2,p2)
5137                             ==> abs (rsum(d1,p1) f - rsum(d2,p2) f) < e`,
5138   REPEAT GEN_TAC THEN REWRITE_TAC[integrable] THEN EQ_TAC THENL
5139    [REWRITE_TAC[defint] THEN DISCH_THEN(X_CHOOSE_TAC `i:real`) THEN
5140     X_GEN_TAC `e:real` THEN DISCH_TAC THEN
5141     FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN
5142     ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN
5143     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real->real` THEN
5144     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
5145     MAP_EVERY X_GEN_TAC
5146      [`d1:num->real`; `p1:num->real`; `d2:num->real`; `p2:num->real`] THEN
5147     STRIP_TAC THEN FIRST_X_ASSUM(fun th ->
5148       MP_TAC(SPECL [`d1:num->real`; `p1:num->real`] th) THEN
5149       MP_TAC(SPECL [`d2:num->real`; `p2:num->real`] th)) THEN
5150     ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC;
5151     ALL_TAC] THEN
5152   DISCH_TAC THEN DISJ_CASES_TAC(REAL_ARITH `b < a \/ a <= b`) THENL
5153    [ASM_MESON_TAC[DEFINT_WRONG]; ALL_TAC] THEN
5154   FIRST_X_ASSUM(MP_TAC o GEN `n:num` o SPEC `&1 / &2 pow n`) THEN
5155   SIMP_TAC[REAL_LT_DIV; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN
5156   REWRITE_TAC[FORALL_AND_THM; SKOLEM_THM] THEN
5157   DISCH_THEN(X_CHOOSE_THEN `g:num->real->real` STRIP_ASSUME_TAC) THEN
5158   MP_TAC(GEN `n:num`
5159    (SPECL [`\x. a <= x /\ x <= b`; `g:num->real->real`; `n:num`]
5160           GAUGE_MIN_FINITE)) THEN
5161   ASM_REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM] THEN
5162   DISCH_THEN(X_CHOOSE_THEN `G:num->real->real` STRIP_ASSUME_TAC) THEN
5163   MP_TAC(GEN `n:num`
5164     (SPECL [`a:real`; `b:real`; `(G:num->real->real) n`] DIVISION_EXISTS)) THEN
5165   ASM_REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN
5166   MAP_EVERY X_GEN_TAC [`d:num->num->real`; `p:num->num->real`] THEN
5167   STRIP_TAC THEN SUBGOAL_THEN `cauchy (\n. rsum(d n,p n) f)` MP_TAC THENL
5168    [REWRITE_TAC[cauchy] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
5169     MP_TAC(SPEC `&1 / e` REAL_ARCH_POW2) THEN MATCH_MP_TAC MONO_EXISTS THEN
5170     X_GEN_TAC `N:num` THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ] THEN DISCH_TAC THEN
5171     REWRITE_TAC[GE] THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN
5172     STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL
5173      [`N:num`; `(d:num->num->real) m`; `(p:num->num->real) m`;
5174       `(d:num->num->real) n`; `(p:num->num->real) n`]) THEN
5175     ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
5176     MATCH_MP_TAC(REAL_ARITH `d < e ==> x < d ==> x < e`) THEN
5177     ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN
5178     ASM_MESON_TAC[REAL_MUL_SYM];
5179     ALL_TAC] THEN
5180   REWRITE_TAC[SEQ_CAUCHY; convergent; SEQ; defint] THEN
5181   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `i:real` THEN STRIP_TAC THEN
5182   X_GEN_TAC `e:real` THEN DISCH_TAC THEN
5183   FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN
5184   ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN
5185   DISCH_THEN(X_CHOOSE_THEN `N1:num` MP_TAC) THEN
5186   X_CHOOSE_TAC `N2:num` (SPEC `&2 / e` REAL_ARCH_POW2) THEN
5187   DISCH_THEN(MP_TAC o SPEC `N1 + N2:num`) THEN REWRITE_TAC[GE; LE_ADD] THEN
5188   DISCH_TAC THEN EXISTS_TAC `(G:num->real->real)(N1 + N2)` THEN
5189   ASM_REWRITE_TAC[] THEN
5190   MAP_EVERY X_GEN_TAC [`dx:num->real`; `px:num->real`] THEN STRIP_TAC THEN
5191   FIRST_X_ASSUM(MP_TAC o SPECL
5192    [`N1 + N2:num`; `dx:num->real`; `px:num->real`;
5193     `(d:num->num->real)(N1 + N2)`; `(p:num->num->real)(N1 + N2)`]) THEN
5194   ANTS_TAC THENL [ASM_MESON_TAC[LE_REFL]; ALL_TAC] THEN
5195   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
5196    `abs(s1 - i) < e / &2
5197     ==> d < e / &2
5198         ==> abs(s2 - s1) < d ==> abs(s2 - i) < e`)) THEN
5199   REWRITE_TAC[real_div; REAL_MUL_LID] THEN REWRITE_TAC[GSYM real_div] THEN
5200   GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_DIV] THEN
5201   MATCH_MP_TAC REAL_LT_INV2 THEN
5202   ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN
5203   MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&2 pow N2` THEN
5204   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_POW_MONO THEN
5205   REWRITE_TAC[REAL_OF_NUM_LE] THEN ARITH_TAC);;
5206
5207 (* ------------------------------------------------------------------------- *)
5208 (* Limit theorem.                                                            *)
5209 (* ------------------------------------------------------------------------- *)
5210
5211 let SUM_DIFFS = prove
5212  (`!m n. sum(m,n) (\i. d(SUC i) - d(i)) = d(m + n) - d m`,
5213   GEN_TAC THEN INDUCT_TAC THEN
5214   ASM_REWRITE_TAC[sum; ADD_CLAUSES; REAL_SUB_REFL] THEN REAL_ARITH_TAC);;
5215
5216 let RSUM_BOUND = prove
5217  (`!a b d p e f.
5218         tdiv(a,b) (d,p) /\
5219         (!x. a <= x /\ x <= b ==> abs(f x) <= e)
5220         ==> abs(rsum(d,p) f) <= e * (b - a)`,
5221   REPEAT STRIP_TAC THEN REWRITE_TAC[rsum] THEN
5222   MATCH_MP_TAC REAL_LE_TRANS THEN
5223   EXISTS_TAC `sum(0,dsize d) (\i. abs(f(p i :real) * (d(SUC i) - d i)))` THEN
5224   REWRITE_TAC[SUM_ABS_LE] THEN
5225   MATCH_MP_TAC REAL_LE_TRANS THEN
5226   EXISTS_TAC `sum(0,dsize d) (\i. e * abs(d(SUC i) - d(i)))` THEN
5227   CONJ_TAC THENL
5228    [MATCH_MP_TAC SUM_LE THEN REWRITE_TAC[ADD_CLAUSES; REAL_ABS_MUL] THEN
5229     X_GEN_TAC `r:num` THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_RMUL THEN
5230     REWRITE_TAC[REAL_ABS_POS] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
5231     ASM_MESON_TAC[tdiv; DIVISION_UBOUND; DIVISION_LBOUND; REAL_LE_TRANS];
5232     ALL_TAC] THEN
5233   REWRITE_TAC[SUM_CMUL] THEN MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL
5234    [FIRST_X_ASSUM(MP_TAC o SPEC `a:real`) THEN
5235     ASM_MESON_TAC[REAL_LE_REFL; REAL_ABS_POS; REAL_LE_TRANS; DIVISION_LE;
5236                   tdiv];
5237     ALL_TAC] THEN
5238   FIRST_X_ASSUM(CONJUNCTS_THEN ASSUME_TAC o REWRITE_RULE[tdiv]) THEN
5239   FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_MONO_LE_SUC) THEN
5240   ASM_REWRITE_TAC[real_abs; REAL_SUB_LE; SUM_DIFFS; ADD_CLAUSES] THEN
5241   MATCH_MP_TAC(REAL_ARITH `a <= d0 /\ d1 <= b ==> d1 - d0 <= b - a`) THEN
5242   ASM_MESON_TAC[DIVISION_LBOUND; DIVISION_UBOUND]);;
5243
5244 let RSUM_DIFF_BOUND = prove
5245  (`!a b d p e f g.
5246         tdiv(a,b) (d,p) /\
5247         (!x. a <= x /\ x <= b ==> abs(f x - g x) <= e)
5248         ==> abs(rsum (d,p) f - rsum (d,p) g) <= e * (b - a)`,
5249   REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP RSUM_BOUND) THEN
5250   REWRITE_TAC[rsum; SUM_SUB; REAL_SUB_RDISTRIB]);;
5251
5252 let INTEGRABLE_LIMIT = prove
5253  (`!f a b. (!e. &0 < e
5254                 ==> ?g. (!x. a <= x /\ x <= b ==> abs(f x - g x) <= e) /\
5255                         integrable(a,b) g)
5256            ==> integrable(a,b) f`,
5257   REPEAT STRIP_TAC THEN ASM_CASES_TAC `a <= b` THENL
5258    [ALL_TAC; ASM_MESON_TAC[REAL_NOT_LE; DEFINT_WRONG; integrable]] THEN
5259   FIRST_X_ASSUM(MP_TAC o GEN `n:num` o SPEC `&1 / &2 pow n`) THEN
5260   SIMP_TAC[REAL_LT_DIV; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN
5261   REWRITE_TAC[FORALL_AND_THM; SKOLEM_THM; integrable] THEN
5262   DISCH_THEN(X_CHOOSE_THEN `g:num->real->real` (CONJUNCTS_THEN2
5263    ASSUME_TAC (X_CHOOSE_TAC `i:num->real`))) THEN
5264   SUBGOAL_THEN `cauchy i` MP_TAC THENL
5265    [REWRITE_TAC[cauchy] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
5266     MP_TAC(SPEC `(&4 * (b - a)) / e` REAL_ARCH_POW2) THEN
5267     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN
5268     MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN REWRITE_TAC[GE] THEN
5269     STRIP_TAC THEN
5270     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE BINDER_CONV [defint]) THEN
5271     ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN
5272     DISCH_THEN(MP_TAC o SPEC `e / &4`) THEN
5273     ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN
5274     DISCH_THEN(fun th -> MP_TAC(SPEC `m:num` th) THEN
5275       MP_TAC(SPEC `n:num` th)) THEN
5276     DISCH_THEN(X_CHOOSE_THEN `gn:real->real` STRIP_ASSUME_TAC) THEN
5277     DISCH_THEN(X_CHOOSE_THEN `gm:real->real` STRIP_ASSUME_TAC) THEN
5278     MP_TAC(SPECL [`a:real`; `b:real`;
5279                   `\x:real. if gm x < gn x then gm x else gn x`]
5280                  DIVISION_EXISTS) THEN
5281     ASM_SIMP_TAC[GAUGE_MIN; LEFT_IMP_EXISTS_THM] THEN
5282     MAP_EVERY X_GEN_TAC [`d:num->real`; `p:num->real`] THEN
5283     STRIP_TAC THEN
5284     FIRST_X_ASSUM(CONJUNCTS_THEN ASSUME_TAC o MATCH_MP FINE_MIN) THEN
5285     REPEAT(FIRST_X_ASSUM(MP_TAC o SPECL [`d:num->real`; `p:num->real`])) THEN
5286     ASM_REWRITE_TAC[] THEN
5287     SUBGOAL_THEN `abs(rsum(d,p) (g(m:num)) - rsum(d,p) (g n)) <= e / &2`
5288      (fun th -> MP_TAC th THEN REAL_ARITH_TAC) THEN
5289     MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 / &2 pow N * (b - a)` THEN
5290     CONJ_TAC THENL
5291      [MATCH_MP_TAC RSUM_DIFF_BOUND THEN ASM_REWRITE_TAC[] THEN
5292       REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH
5293        `!f. abs(f - gm) <= inv(k) /\ abs(f - gn) <= inv(k)
5294             ==> abs(gm - gn) <= &2 / k`) THEN
5295       EXISTS_TAC `(f:real->real) x` THEN CONJ_TAC THEN
5296       MATCH_MP_TAC REAL_LE_TRANS THENL
5297        [EXISTS_TAC `&1 / &2 pow m`; EXISTS_TAC `&1 / &2 pow n`] THEN
5298       ASM_SIMP_TAC[] THEN REWRITE_TAC[real_div; REAL_MUL_LID] THEN
5299       MATCH_MP_TAC REAL_LE_INV2 THEN
5300       ASM_SIMP_TAC[REAL_POW_LT; REAL_POW_MONO; REAL_OF_NUM_LE;
5301                    REAL_OF_NUM_LT; ARITH];
5302       ALL_TAC] THEN
5303     REWRITE_TAC[REAL_ARITH `&2 / n * x <= e / &2 <=> (&4 * x) / n <= e`] THEN
5304     SIMP_TAC[REAL_LE_LDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN
5305     GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN
5306     ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_LT_IMP_LE];
5307     ALL_TAC] THEN
5308   REWRITE_TAC[SEQ_CAUCHY; convergent] THEN
5309   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `s:real` THEN DISCH_TAC THEN
5310   REWRITE_TAC[defint] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
5311   FIRST_X_ASSUM(MP_TAC o SPEC `e / &3` o GEN_REWRITE_RULE I [SEQ]) THEN
5312   ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; GE] THEN
5313   DISCH_THEN(X_CHOOSE_TAC `N1:num`) THEN
5314   MP_TAC(SPEC `(&3 * (b - a)) / e` REAL_ARCH_POW2) THEN
5315   DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN
5316   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE BINDER_CONV [defint]) THEN
5317   DISCH_THEN(MP_TAC o SPECL [`N1 + N2:num`; `e / &3`]) THEN
5318   ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN
5319   MATCH_MP_TAC MONO_EXISTS THEN
5320   X_GEN_TAC `g:real->real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
5321   MAP_EVERY X_GEN_TAC [`d:num->real`; `p:num->real`] THEN STRIP_TAC THEN
5322   FIRST_X_ASSUM(MP_TAC o SPECL [`d:num->real`; `p:num->real`]) THEN
5323   ASM_REWRITE_TAC[] THEN
5324   FIRST_X_ASSUM(MP_TAC o C MATCH_MP (ARITH_RULE `N1:num <= N1 + N2`)) THEN
5325   MATCH_MP_TAC(REAL_ARITH
5326    `abs(sf - sg) <= e / &3
5327     ==> abs(i - s) < e / &3 ==> abs(sg - i) < e / &3 ==> abs(sf - s) < e`) THEN
5328   MATCH_MP_TAC REAL_LE_TRANS THEN
5329   EXISTS_TAC `&1 / &2 pow (N1 + N2) * (b - a)` THEN CONJ_TAC THENL
5330    [MATCH_MP_TAC RSUM_DIFF_BOUND THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN
5331   REWRITE_TAC[REAL_ARITH `&1 / n * x <= e / &3 <=> (&3 * x) / n <= e`] THEN
5332   SIMP_TAC[REAL_LE_LDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN
5333   GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN
5334   ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_LT_IMP_LE] THEN
5335   MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 pow N2` THEN
5336   ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_POW_MONO; REAL_OF_NUM_LE; ARITH;
5337                ARITH_RULE `N2 <= N1 + N2:num`]);;
5338
5339 (* ------------------------------------------------------------------------- *)
5340 (* Hence continuous functions are integrable.                                *)
5341 (* ------------------------------------------------------------------------- *)
5342
5343 let INTEGRABLE_CONST = prove
5344  (`!a b c. integrable(a,b) (\x. c)`,
5345   REWRITE_TAC[integrable] THEN MESON_TAC[DEFINT_CONST]);;
5346
5347 let INTEGRABLE_COMBINE = prove
5348  (`!f a b c. a <= b /\ b <= c /\ integrable(a,b) f /\ integrable(b,c) f
5349          ==> integrable(a,c) f`,
5350   REWRITE_TAC[integrable] THEN MESON_TAC[DEFINT_COMBINE]);;
5351
5352 let INTEGRABLE_POINT_SPIKE = prove
5353  (`!f g a b c.
5354          (!x. a <= x /\ x <= b /\ ~(x = c) ==> f x = g x) /\ integrable(a,b) f
5355          ==> integrable(a,b) g`,
5356   REWRITE_TAC[integrable] THEN MESON_TAC[DEFINT_POINT_SPIKE]);;
5357
5358 let INTEGRABLE_CONTINUOUS = prove
5359  (`!f a b. (!x. a <= x /\ x <= b ==> f contl x) ==> integrable(a,b) f`,
5360   REPEAT STRIP_TAC THEN DISJ_CASES_TAC(REAL_ARITH `b < a \/ a <= b`) THENL
5361    [ASM_MESON_TAC[integrable; DEFINT_WRONG]; ALL_TAC] THEN
5362   MATCH_MP_TAC INTEGRABLE_LIMIT THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
5363   MP_TAC(SPECL [`f:real->real`; `a:real`; `b:real`] CONT_UNIFORM) THEN
5364   ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN
5365   ASM_REWRITE_TAC[] THEN
5366   DISCH_THEN(X_CHOOSE_THEN `d:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
5367   UNDISCH_TAC `a <= b` THEN MAP_EVERY (fun t -> SPEC_TAC(t,t))
5368    [`b:real`; `a:real`] THEN
5369   MATCH_MP_TAC BOLZANO_LEMMA_ALT THEN CONJ_TAC THENL
5370    [MAP_EVERY X_GEN_TAC [`u:real`; `v:real`; `w:real`] THEN
5371     REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
5372     DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN
5373     MATCH_MP_TAC(TAUT
5374       `(a /\ b) /\ (c /\ d ==> e) ==> (a ==> c) /\ (b ==> d) ==> e`) THEN
5375     CONJ_TAC THENL [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC] THEN
5376     DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `g:real->real`)
5377                                (X_CHOOSE_TAC `h:real->real`)) THEN
5378     EXISTS_TAC `\x. if x <= v then g(x):real else h(x)` THEN
5379     REWRITE_TAC[] THEN CONJ_TAC THENL
5380      [ASM_MESON_TAC[REAL_LE_TOTAL]; ALL_TAC] THEN
5381     MATCH_MP_TAC INTEGRABLE_COMBINE THEN EXISTS_TAC `v:real` THEN
5382     ASM_REWRITE_TAC[] THEN CONJ_TAC THEN
5383     MATCH_MP_TAC INTEGRABLE_POINT_SPIKE THENL
5384      [EXISTS_TAC `g:real->real`; EXISTS_TAC `h:real->real`] THEN
5385     EXISTS_TAC `v:real` THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[] THEN
5386     ASM_MESON_TAC[REAL_ARITH `b <= x /\ x <= c /\ ~(x = b) ==> ~(x <= b)`];
5387     ALL_TAC] THEN
5388   X_GEN_TAC `x:real` THEN EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN
5389   MAP_EVERY X_GEN_TAC [`u:real`; `v:real`] THEN REPEAT STRIP_TAC THEN
5390   EXISTS_TAC `\x:real. (f:real->real) u` THEN
5391   ASM_REWRITE_TAC[INTEGRABLE_CONST] THEN
5392   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN
5393   FIRST_X_ASSUM MATCH_MP_TAC THEN
5394   ASM_REAL_ARITH_TAC);;
5395
5396 (* ------------------------------------------------------------------------- *)
5397 (* Integrability on a subinterval.                                           *)
5398 (* ------------------------------------------------------------------------- *)
5399
5400 let INTEGRABLE_SPLIT_SIDES = prove
5401  (`!f a b c.
5402         a <= c /\ c <= b /\ integrable(a,b) f
5403         ==> ?i. !e. &0 < e
5404                     ==> ?g. gauge(\x. a <= x /\ x <= b) g /\
5405                             !d1 p1 d2 p2. tdiv(a,c) (d1,p1) /\
5406                                           fine g (d1,p1) /\
5407                                           tdiv(c,b) (d2,p2) /\
5408                                           fine g (d2,p2)
5409                                           ==> abs((rsum(d1,p1) f +
5410                                                    rsum(d2,p2) f) - i) < e`,
5411   REPEAT GEN_TAC THEN REWRITE_TAC[integrable; defint] THEN
5412   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
5413   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `i:real` THEN
5414   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
5415   ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN
5416   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real->real` THEN
5417   ASM_MESON_TAC[DIVISION_APPEND_STRONG]);;
5418
5419 let INTEGRABLE_SUBINTERVAL_LEFT = prove
5420  (`!f a b c. a <= c /\ c <= b /\ integrable(a,b) f ==> integrable(a,c) f`,
5421   REPEAT GEN_TAC THEN DISCH_TAC THEN
5422   FIRST_ASSUM(X_CHOOSE_TAC `i:real` o MATCH_MP INTEGRABLE_SPLIT_SIDES) THEN
5423   REWRITE_TAC[INTEGRABLE_CAUCHY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
5424   FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN
5425   SIMP_TAC[ASSUME `&0 < e`; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN
5426   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real->real` THEN
5427   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
5428   CONJ_TAC THENL
5429    [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [gauge]) THEN
5430     REWRITE_TAC[gauge] THEN ASM_MESON_TAC[REAL_LE_TRANS];
5431     ALL_TAC] THEN
5432   REPEAT STRIP_TAC THEN
5433   MP_TAC(SPECL [`c:real`; `b:real`; `g:real->real`] DIVISION_EXISTS) THEN
5434   ANTS_TAC THENL
5435    [ASM_REWRITE_TAC[] THEN
5436     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [gauge]) THEN
5437     REWRITE_TAC[gauge] THEN ASM_MESON_TAC[REAL_LE_TRANS];
5438     ALL_TAC] THEN
5439   REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
5440   MAP_EVERY X_GEN_TAC [`d:num->real`; `p:num->real`] THEN STRIP_TAC THEN
5441   FIRST_X_ASSUM(fun th ->
5442    MP_TAC(SPECL [`d1:num->real`; `p1:num->real`] th) THEN
5443    MP_TAC(SPECL [`d2:num->real`; `p2:num->real`] th)) THEN
5444   REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN
5445   DISCH_THEN(MP_TAC o SPECL [`d:num->real`; `p:num->real`]) THEN
5446   ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);;
5447
5448 let INTEGRABLE_SUBINTERVAL_RIGHT = prove
5449  (`!f a b c. a <= c /\ c <= b /\ integrable(a,b) f ==> integrable(c,b) f`,
5450   REPEAT GEN_TAC THEN DISCH_TAC THEN
5451   FIRST_ASSUM(X_CHOOSE_TAC `i:real` o MATCH_MP INTEGRABLE_SPLIT_SIDES) THEN
5452   REWRITE_TAC[INTEGRABLE_CAUCHY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
5453   FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN
5454   SIMP_TAC[ASSUME `&0 < e`; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN
5455   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real->real` THEN
5456   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
5457   CONJ_TAC THENL
5458    [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [gauge]) THEN
5459     REWRITE_TAC[gauge] THEN ASM_MESON_TAC[REAL_LE_TRANS];
5460     ALL_TAC] THEN
5461   REPEAT STRIP_TAC THEN
5462   MP_TAC(SPECL [`a:real`; `c:real`; `g:real->real`] DIVISION_EXISTS) THEN
5463   ANTS_TAC THENL
5464    [ASM_REWRITE_TAC[] THEN
5465     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [gauge]) THEN
5466     REWRITE_TAC[gauge] THEN ASM_MESON_TAC[REAL_LE_TRANS];
5467     ALL_TAC] THEN
5468   REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
5469   MAP_EVERY X_GEN_TAC [`d:num->real`; `p:num->real`] THEN STRIP_TAC THEN
5470   FIRST_X_ASSUM(MP_TAC o SPECL [`d:num->real`; `p:num->real`]) THEN
5471   DISCH_THEN(fun th ->
5472    MP_TAC(SPECL [`d1:num->real`; `p1:num->real`] th) THEN
5473    MP_TAC(SPECL [`d2:num->real`; `p2:num->real`] th)) THEN
5474   ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);;
5475
5476 let INTEGRABLE_SUBINTERVAL = prove
5477  (`!f a b c d. a <= c /\ c <= d /\ d <= b /\ integrable(a,b) f
5478                ==> integrable(c,d) f`,
5479   MESON_TAC[INTEGRABLE_SUBINTERVAL_LEFT; INTEGRABLE_SUBINTERVAL_RIGHT;
5480             REAL_LE_TRANS]);;
5481
5482 (* ------------------------------------------------------------------------- *)
5483 (* Basic integrability rule for everywhere-differentiable function.          *)
5484 (* ------------------------------------------------------------------------- *)
5485
5486 let INTEGRABLE_RULE =
5487   let pth = prove
5488    (`(!x. f contl x) ==> integrable(a,b) f`,
5489     MESON_TAC[INTEGRABLE_CONTINUOUS]) in
5490   let match_pth = PART_MATCH rand pth
5491   and forsimp = GEN_REWRITE_RULE LAND_CONV [FORALL_SIMP] in
5492   fun tm ->
5493     let th1 = match_pth tm in
5494     let th2 = CONV_RULE (LAND_CONV(BINDER_CONV CONTINUOUS_CONV)) th1 in
5495     MP (forsimp th2) TRUTH;;
5496
5497 let INTEGRABLE_CONV = EQT_INTRO o INTEGRABLE_RULE;;
5498
5499 (* ------------------------------------------------------------------------- *)
5500 (* More basic lemmas about integration.                                      *)
5501 (* ------------------------------------------------------------------------- *)
5502
5503 let INTEGRAL_CONST = prove
5504  (`!a b c. a <= b ==> integral(a,b) (\x. c) = c * (b - a)`,
5505   REPEAT STRIP_TAC THEN MATCH_MP_TAC DEFINT_INTEGRAL THEN
5506   ASM_SIMP_TAC[DEFINT_CONST]);;
5507
5508 let INTEGRAL_CMUL = prove
5509  (`!f c a b. a <= b /\ integrable(a,b) f
5510              ==> integral(a,b) (\x. c * f(x)) = c * integral(a,b) f`,
5511   REPEAT STRIP_TAC THEN MATCH_MP_TAC DEFINT_INTEGRAL THEN
5512   ASM_SIMP_TAC[DEFINT_CMUL; INTEGRABLE_DEFINT]);;
5513
5514 let INTEGRAL_ADD = prove
5515  (`!f g a b. a <= b /\ integrable(a,b) f /\ integrable(a,b) g
5516              ==> integral(a,b) (\x. f(x) + g(x)) =
5517                  integral(a,b) f + integral(a,b) g`,
5518   REPEAT STRIP_TAC THEN MATCH_MP_TAC DEFINT_INTEGRAL THEN
5519   ASM_SIMP_TAC[DEFINT_ADD; INTEGRABLE_DEFINT]);;
5520
5521 let INTEGRAL_SUB = prove
5522  (`!f g a b. a <= b /\ integrable(a,b) f /\ integrable(a,b) g
5523              ==> integral(a,b) (\x. f(x) - g(x)) =
5524                  integral(a,b) f - integral(a,b) g`,
5525   REPEAT STRIP_TAC THEN MATCH_MP_TAC DEFINT_INTEGRAL THEN
5526   ASM_SIMP_TAC[DEFINT_SUB; INTEGRABLE_DEFINT]);;
5527
5528 let INTEGRAL_BY_PARTS = prove
5529  (`!f g f' g' a b.
5530          a <= b /\
5531          (!x. a <= x /\ x <= b ==> (f diffl f' x) x) /\
5532          (!x. a <= x /\ x <= b ==> (g diffl g' x) x) /\
5533          integrable(a,b) (\x. f' x * g x) /\
5534          integrable(a,b) (\x. f x * g' x)
5535          ==> integral(a,b) (\x. f x * g' x) =
5536              (f b * g b - f a * g a) - integral(a,b) (\x. f' x * g x)`,
5537   MP_TAC INTEGRATION_BY_PARTS THEN
5538   REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
5539   DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
5540   ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o CONJ (ASSUME `a <= b`)) THEN
5541   DISCH_THEN(SUBST1_TAC o SYM o MATCH_MP DEFINT_INTEGRAL) THEN
5542   ASM_SIMP_TAC[INTEGRAL_ADD] THEN REAL_ARITH_TAC);;
5543
5544 (* ------------------------------------------------------------------------ *)
5545 (* SYM_CANON_CONV - Canonicalizes single application of symmetric operator  *)
5546 (* Rewrites `so as to make fn true`, e.g. fn = (<<) or fn = (=) `1` o fst   *)
5547 (* ------------------------------------------------------------------------ *)
5548
5549 let SYM_CANON_CONV sym fn =
5550   REWR_CONV sym o check
5551    (not o fn o ((snd o dest_comb) F_F I) o dest_comb);;
5552
5553 (* ----------------------------------------------------------- *)
5554 (* EXT_CONV `!x. f x = g x` = |- (!x. f x = g x) <=> (f = g)   *)
5555 (* ----------------------------------------------------------- *)
5556
5557 let EXT_CONV =  SYM o uncurry X_FUN_EQ_CONV o
5558       (I F_F (mk_eq o (rator F_F rator) o dest_eq)) o dest_forall;;
5559
5560 (* ------------------------------------------------------------------------ *)
5561 (* Mclaurin's theorem with Lagrange form of remainder                       *)
5562 (* We could weaken the hypotheses slightly, but it's not worth it           *)
5563 (* ------------------------------------------------------------------------ *)
5564
5565 let MCLAURIN = prove(
5566   `!f diff h n.
5567     &0 < h /\
5568     0 < n /\
5569     (diff(0) = f) /\
5570     (!m t. m < n /\ &0 <= t /\ t <= h ==>
5571            (diff(m) diffl diff(SUC m)(t))(t)) ==>
5572    (?t. &0 < t /\ t < h /\
5573         (f(h) = sum(0,n)(\m. (diff(m)(&0) / &(FACT m)) * (h pow m)) +
5574                 ((diff(n)(t) / &(FACT n)) * (h pow n))))`,
5575   REPEAT GEN_TAC THEN STRIP_TAC THEN
5576   UNDISCH_TAC `0 < n` THEN
5577   DISJ_CASES_THEN2 SUBST_ALL_TAC (X_CHOOSE_THEN `r:num` MP_TAC)
5578    (SPEC `n:num` num_CASES) THEN REWRITE_TAC[LT_REFL] THEN
5579   DISCH_THEN(ASSUME_TAC o SYM) THEN DISCH_THEN(K ALL_TAC) THEN
5580   SUBGOAL_THEN `?B. f(h) = sum(0,n)(\m. (diff(m)(&0) / &(FACT m)) * (h pow m))
5581                   + (B * ((h pow n) / &(FACT n)))` MP_TAC THENL
5582    [ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
5583     ONCE_REWRITE_TAC[GSYM REAL_EQ_SUB_RADD] THEN
5584     EXISTS_TAC `(f(h) - sum(0,n)(\m. (diff(m)(&0) / &(FACT m)) * (h pow m)))
5585         * &(FACT n) / (h pow n)` THEN REWRITE_TAC[real_div] THEN
5586     REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN
5587     GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) [GSYM REAL_MUL_RID] THEN
5588     AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN
5589     ONCE_REWRITE_TAC[AC REAL_MUL_AC
5590       `a * b * c * d = (d * a) * (b * c)`] THEN
5591     GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN BINOP_TAC THEN
5592     MATCH_MP_TAC REAL_MUL_LINV THENL
5593      [MATCH_MP_TAC REAL_POS_NZ THEN REWRITE_TAC[REAL_LT; FACT_LT];
5594       MATCH_MP_TAC POW_NZ THEN MATCH_MP_TAC REAL_POS_NZ THEN
5595       ASM_REWRITE_TAC[]]; ALL_TAC] THEN
5596   DISCH_THEN(X_CHOOSE_THEN `B:real` (ASSUME_TAC o SYM)) THEN
5597   ABBREV_TAC `g = \t. f(t) -
5598                       (sum(0,n)(\m. (diff(m)(&0) / &(FACT m)) * (t pow m)) +
5599                        (B * ((t pow n) / &(FACT n))))` THEN
5600   SUBGOAL_THEN `(g(&0) = &0) /\ (g(h) = &0)` ASSUME_TAC THENL
5601    [EXPAND_TAC "g" THEN BETA_TAC THEN ASM_REWRITE_TAC[REAL_SUB_REFL] THEN
5602     EXPAND_TAC "n" THEN REWRITE_TAC[POW_0; REAL_DIV_LZERO] THEN
5603     REWRITE_TAC[REAL_MUL_RZERO; REAL_ADD_RID] THEN REWRITE_TAC[REAL_SUB_0] THEN
5604     MP_TAC(GEN `j:num->real`
5605      (SPECL [`j:num->real`; `r:num`; `1`] SUM_OFFSET)) THEN
5606     REWRITE_TAC[ADD1; REAL_EQ_SUB_LADD] THEN
5607     DISCH_THEN(fun th -> REWRITE_TAC[GSYM th]) THEN BETA_TAC THEN
5608     REWRITE_TAC[SUM_1] THEN BETA_TAC THEN REWRITE_TAC[pow; FACT] THEN
5609     ASM_REWRITE_TAC[real_div; REAL_INV1; REAL_MUL_RID] THEN
5610     CONV_TAC SYM_CONV THEN REWRITE_TAC[REAL_ADD_LID_UNIQ] THEN
5611     REWRITE_TAC[GSYM ADD1; POW_0; REAL_MUL_RZERO; SUM_0]; ALL_TAC] THEN
5612   ABBREV_TAC `difg = \m t. diff(m) t -
5613       (sum(0,n - m)(\p. (diff(m + p)(&0) / &(FACT p)) * (t pow p))
5614        + (B * ((t pow (n - m)) / &(FACT(n - m)))))` THEN
5615   SUBGOAL_THEN `difg(0):real->real = g` ASSUME_TAC THENL
5616    [EXPAND_TAC "difg" THEN BETA_TAC THEN EXPAND_TAC "g" THEN
5617     CONV_TAC FUN_EQ_CONV THEN GEN_TAC THEN BETA_TAC THEN
5618     ASM_REWRITE_TAC[ADD_CLAUSES; SUB_0]; ALL_TAC] THEN
5619   SUBGOAL_THEN `(!m t. m < n /\ (& 0) <= t /\ t <= h ==>
5620                    (difg(m) diffl difg(SUC m)(t))(t))` ASSUME_TAC THENL
5621    [REPEAT GEN_TAC THEN DISCH_TAC THEN EXPAND_TAC "difg" THEN BETA_TAC THEN
5622     CONV_TAC((funpow 2 RATOR_CONV o RAND_CONV) HABS_CONV) THEN
5623     MATCH_MP_TAC DIFF_SUB THEN CONJ_TAC THENL
5624      [CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN
5625       FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN
5626     CONV_TAC((funpow 2 RATOR_CONV o RAND_CONV) HABS_CONV) THEN
5627     MATCH_MP_TAC DIFF_ADD THEN CONJ_TAC THENL
5628      [ALL_TAC;
5629       W(MP_TAC o DIFF_CONV o rand o funpow 2 rator o snd) THEN
5630       REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RID; REAL_ADD_LID] THEN
5631       REWRITE_TAC[REAL_FACT_NZ; REAL_SUB_RZERO] THEN
5632       DISCH_THEN(MP_TAC o SPEC `t:real`) THEN
5633       MATCH_MP_TAC EQ_IMP THEN
5634       AP_THM_TAC THEN CONV_TAC(ONCE_DEPTH_CONV(ALPHA_CONV `t:real`)) THEN
5635       AP_TERM_TAC THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN
5636       AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[real_div] THEN
5637       REWRITE_TAC[GSYM REAL_MUL_ASSOC; POW_2] THEN
5638       ONCE_REWRITE_TAC[AC REAL_MUL_AC
5639         `a * b * c * d = b * (a * (d * c))`] THEN
5640       FIRST_ASSUM(X_CHOOSE_THEN `d:num` SUBST1_TAC o
5641         MATCH_MP LESS_ADD_1 o CONJUNCT1) THEN
5642       ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN
5643       REWRITE_TAC[GSYM ADD_ASSOC] THEN
5644       REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] (GSYM ADD1)] THEN
5645       REWRITE_TAC[ADD_SUB] THEN AP_TERM_TAC THEN
5646       IMP_SUBST_TAC REAL_INV_MUL_WEAK THEN REWRITE_TAC[REAL_FACT_NZ] THEN
5647       REWRITE_TAC[GSYM ADD1; FACT; GSYM REAL_MUL] THEN
5648       REPEAT(IMP_SUBST_TAC REAL_INV_MUL_WEAK THEN
5649              REWRITE_TAC[REAL_FACT_NZ; REAL_INJ; NOT_SUC]) THEN
5650       REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN
5651       ONCE_REWRITE_TAC[AC REAL_MUL_AC
5652        `a * b * c * d * e * f * g = (b * a) * (d * f) * (c * g) * e`] THEN
5653       REPEAT(IMP_SUBST_TAC REAL_MUL_LINV THEN REWRITE_TAC[REAL_FACT_NZ] THEN
5654              REWRITE_TAC[REAL_INJ; NOT_SUC]) THEN
5655       REWRITE_TAC[REAL_MUL_LID]] THEN
5656     FIRST_ASSUM(X_CHOOSE_THEN `d:num` SUBST1_TAC o
5657         MATCH_MP LESS_ADD_1 o CONJUNCT1) THEN
5658     ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN
5659     REWRITE_TAC[GSYM ADD_ASSOC] THEN
5660     REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] (GSYM ADD1)] THEN
5661     REWRITE_TAC[ADD_SUB] THEN
5662     REWRITE_TAC[GSYM(REWRITE_RULE[REAL_EQ_SUB_LADD] SUM_OFFSET)] THEN
5663     BETA_TAC THEN REWRITE_TAC[SUM_1] THEN BETA_TAC THEN
5664     CONV_TAC (funpow 2 RATOR_CONV (RAND_CONV HABS_CONV)) THEN
5665     GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) [GSYM REAL_ADD_RID] THEN
5666     MATCH_MP_TAC DIFF_ADD THEN REWRITE_TAC[pow; DIFF_CONST] THEN
5667     (MP_TAC o C SPECL DIFF_SUM)
5668      [`\p x. (diff((p + 1) + m)(&0) / &(FACT(p + 1)))
5669                 * (x pow (p + 1))`;
5670       `\p x. (diff(p + (SUC m))(&0) / &(FACT p)) * (x pow p)`;
5671       `0`; `d:num`; `t:real`] THEN BETA_TAC THEN
5672     DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[ADD_CLAUSES] THEN
5673     X_GEN_TAC `k:num` THEN STRIP_TAC THEN
5674     W(MP_TAC o DIFF_CONV o rand o funpow 2 rator o snd) THEN
5675     DISCH_THEN(MP_TAC o SPEC `t:real`) THEN
5676     MATCH_MP_TAC EQ_IMP THEN
5677     CONV_TAC(ONCE_DEPTH_CONV(ALPHA_CONV `z:real`)) THEN
5678     AP_THM_TAC THEN AP_TERM_TAC THEN
5679     REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_LID; REAL_MUL_RID] THEN
5680     REWRITE_TAC[GSYM ADD1; ADD_CLAUSES; real_div; GSYM REAL_MUL_ASSOC] THEN
5681     REWRITE_TAC[SUC_SUB1] THEN
5682     ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c * d = c * (a * d) * b`] THEN
5683     AP_TERM_TAC THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN
5684     AP_TERM_TAC THEN
5685     SUBGOAL_THEN `&(SUC k) = inv(inv(&(SUC k)))` SUBST1_TAC THENL
5686      [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_INVINV THEN
5687       REWRITE_TAC[REAL_INJ; NOT_SUC]; ALL_TAC] THEN
5688     IMP_SUBST_TAC(GSYM REAL_INV_MUL_WEAK) THENL
5689      [CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN REWRITE_TAC[REAL_FACT_NZ] THEN
5690       MATCH_MP_TAC REAL_POS_NZ THEN MATCH_MP_TAC REAL_INV_POS THEN
5691       REWRITE_TAC[REAL_LT; LT_0]; ALL_TAC] THEN
5692     AP_TERM_TAC THEN REWRITE_TAC[FACT; GSYM REAL_MUL; REAL_MUL_ASSOC] THEN
5693     IMP_SUBST_TAC REAL_MUL_LINV THEN REWRITE_TAC[REAL_MUL_LID] THEN
5694     REWRITE_TAC[REAL_INJ; NOT_SUC]; ALL_TAC] THEN
5695   SUBGOAL_THEN `!m. m < n ==>
5696         ?t. &0 < t /\ t < h /\ (difg(SUC m)(t) = &0)` MP_TAC THENL
5697    [ALL_TAC;
5698     DISCH_THEN(MP_TAC o SPEC `r:num`) THEN EXPAND_TAC "n" THEN
5699     REWRITE_TAC[LESS_SUC_REFL] THEN
5700     DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN
5701     EXISTS_TAC `t:real` THEN ASM_REWRITE_TAC[] THEN
5702     UNDISCH_TAC `difg(SUC r)(t:real) = &0` THEN EXPAND_TAC "difg" THEN
5703     ASM_REWRITE_TAC[SUB_REFL; sum; pow; FACT] THEN
5704     REWRITE_TAC[REAL_SUB_0; REAL_ADD_LID; real_div] THEN
5705     REWRITE_TAC[REAL_INV1; REAL_MUL_RID] THEN DISCH_THEN SUBST1_TAC THEN
5706     GEN_REWRITE_TAC (funpow 2 RAND_CONV)
5707      [AC REAL_MUL_AC
5708       `(a * b) * c = a * (c * b)`] THEN
5709     ASM_REWRITE_TAC[GSYM real_div]] THEN
5710   SUBGOAL_THEN `!m:num. m < n ==> (difg(m)(&0) = &0)` ASSUME_TAC THENL
5711    [X_GEN_TAC `m:num` THEN EXPAND_TAC "difg" THEN
5712     DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC o MATCH_MP LESS_ADD_1) THEN
5713     ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN
5714     MP_TAC(GEN `j:num->real`
5715      (SPECL [`j:num->real`; `d:num`; `1`] SUM_OFFSET)) THEN
5716     REWRITE_TAC[ADD1; REAL_EQ_SUB_LADD] THEN
5717     DISCH_THEN(fun th -> REWRITE_TAC[GSYM th]) THEN BETA_TAC THEN
5718     REWRITE_TAC[SUM_1] THEN BETA_TAC THEN
5719     REWRITE_TAC[FACT; pow; REAL_INV1; ADD_CLAUSES; real_div; REAL_MUL_RID] THEN
5720     REWRITE_TAC[GSYM ADD1; POW_0; REAL_MUL_RZERO; SUM_0; REAL_ADD_LID] THEN
5721     REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_ADD_RID] THEN
5722     REWRITE_TAC[REAL_SUB_REFL]; ALL_TAC] THEN
5723   SUBGOAL_THEN `!m:num. m < n ==> ?t. &0 < t /\ t < h /\
5724                         (difg(m) diffl &0)(t)` MP_TAC THENL
5725    [ALL_TAC;
5726     DISCH_THEN(fun th -> GEN_TAC THEN
5727       DISCH_THEN(fun t -> ASSUME_TAC t THEN MP_TAC(MATCH_MP th t))) THEN
5728     DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN
5729     EXISTS_TAC `t:real` THEN ASM_REWRITE_TAC[] THEN
5730     MATCH_MP_TAC DIFF_UNIQ THEN EXISTS_TAC `difg(m:num):real->real` THEN
5731     EXISTS_TAC `t:real` THEN ASM_REWRITE_TAC[] THEN
5732     FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
5733     CONJ_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN
5734     FIRST_ASSUM ACCEPT_TAC] THEN
5735   INDUCT_TAC THENL
5736    [DISCH_TAC THEN MATCH_MP_TAC ROLLE THEN ASM_REWRITE_TAC[] THEN
5737     SUBGOAL_THEN `!t. &0 <= t /\ t <= h ==> g differentiable t` MP_TAC THENL
5738      [GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[differentiable] THEN
5739       EXISTS_TAC `difg(SUC 0)(t:real):real` THEN
5740       SUBST1_TAC(SYM(ASSUME `difg(0):real->real = g`)) THEN
5741       FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN
5742     DISCH_TAC THEN CONJ_TAC THENL
5743      [GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC DIFF_CONT THEN
5744       REWRITE_TAC[GSYM differentiable] THEN FIRST_ASSUM MATCH_MP_TAC THEN
5745       ASM_REWRITE_TAC[];
5746       GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN
5747       CONJ_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]];
5748     DISCH_TAC THEN
5749     SUBGOAL_THEN `m < n:num`
5750     (fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THENL
5751      [MATCH_MP_TAC LT_TRANS THEN EXISTS_TAC `SUC m` THEN
5752       ASM_REWRITE_TAC[LESS_SUC_REFL]; ALL_TAC] THEN
5753     DISCH_THEN(X_CHOOSE_THEN `t0:real` STRIP_ASSUME_TAC) THEN
5754     SUBGOAL_THEN `?t. (& 0) < t /\ t < t0 /\ ((difg(SUC m)) diffl (& 0))t`
5755     MP_TAC THENL
5756      [MATCH_MP_TAC ROLLE THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
5757        [SUBGOAL_THEN `difg(SUC m)(&0) = &0` SUBST1_TAC THENL
5758          [FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC;
5759           MATCH_MP_TAC DIFF_UNIQ THEN EXISTS_TAC `difg(m:num):real->real` THEN
5760           EXISTS_TAC `t0:real` THEN ASM_REWRITE_TAC[] THEN
5761           FIRST_ASSUM MATCH_MP_TAC THEN REPEAT CONJ_TAC THENL
5762            [MATCH_MP_TAC LT_TRANS THEN EXISTS_TAC `SUC m` THEN
5763             ASM_REWRITE_TAC[LESS_SUC_REFL];
5764             MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[];
5765             MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]]]; ALL_TAC] THEN
5766       SUBGOAL_THEN `!t. &0 <= t /\ t <= t0 ==>
5767                        difg(SUC m) differentiable t` ASSUME_TAC THENL
5768        [GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[differentiable] THEN
5769         EXISTS_TAC `difg(SUC(SUC m))(t:real):real` THEN
5770         FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
5771         MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `t0:real` THEN
5772         ASM_REWRITE_TAC[] THEN
5773         MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN
5774       CONJ_TAC THENL
5775        [GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC DIFF_CONT THEN
5776         REWRITE_TAC[GSYM differentiable] THEN FIRST_ASSUM MATCH_MP_TAC THEN
5777         ASM_REWRITE_TAC[];
5778         GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN
5779         CONJ_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]];
5780       DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN
5781       EXISTS_TAC `t:real` THEN ASM_REWRITE_TAC[] THEN
5782       MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `t0:real` THEN
5783       ASM_REWRITE_TAC[]]]);;
5784
5785 let MCLAURIN_NEG = prove
5786  (`!f diff h n.
5787     h < &0 /\
5788     0 < n /\
5789     (diff(0) = f) /\
5790     (!m t. m < n /\ h <= t /\ t <= &0 ==>
5791            (diff(m) diffl diff(SUC m)(t))(t)) ==>
5792    (?t. h < t /\ t < &0 /\
5793         (f(h) = sum(0,n)(\m. (diff(m)(&0) / &(FACT m)) * (h pow m)) +
5794                 ((diff(n)(t) / &(FACT n)) * (h pow n))))`,
5795   REPEAT GEN_TAC THEN STRIP_TAC THEN
5796   MP_TAC(SPECL [`\x. (f(--x):real)`;
5797                 `\n x. ((--(&1)) pow n) * (diff:num->real->real)(n)(--x)`;
5798                 `--h`; `n:num`] MCLAURIN) THEN
5799   BETA_TAC THEN ASM_REWRITE_TAC[REAL_NEG_GT0; pow; REAL_MUL_LID] THEN
5800   ONCE_REWRITE_TAC[GSYM REAL_LE_NEG] THEN
5801   REWRITE_TAC[REAL_NEGNEG; REAL_NEG_0] THEN
5802   ONCE_REWRITE_TAC[AC CONJ_ACI `a /\ b /\ c <=> a /\ c /\ b`] THEN
5803   W(C SUBGOAL_THEN (fun t -> REWRITE_TAC[t]) o
5804   funpow 2 (fst o dest_imp) o snd) THENL
5805    [REPEAT GEN_TAC THEN
5806     DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN
5807     DISCH_THEN(MP_TAC o C CONJ (SPEC `t:real` (DIFF_CONV `\x. --x`))) THEN
5808     CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN
5809     DISCH_THEN(MP_TAC o MATCH_MP DIFF_CHAIN) THEN
5810     DISCH_THEN(MP_TAC o GEN_ALL o MATCH_MP DIFF_CMUL) THEN
5811     DISCH_THEN(MP_TAC o SPEC `(--(&1)) pow m`) THEN BETA_TAC THEN
5812     MATCH_MP_TAC EQ_IMP THEN
5813     CONV_TAC(ONCE_DEPTH_CONV(ALPHA_CONV `z:real`)) THEN
5814     AP_THM_TAC THEN AP_TERM_TAC THEN
5815     CONV_TAC(AC REAL_MUL_AC);
5816     DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC)] THEN
5817   EXISTS_TAC `--t` THEN ONCE_REWRITE_TAC[GSYM REAL_LT_NEG] THEN
5818   ASM_REWRITE_TAC[REAL_NEGNEG; REAL_NEG_0] THEN
5819   BINOP_TAC THENL
5820    [MATCH_MP_TAC SUM_EQ THEN
5821     X_GEN_TAC `m:num` THEN REWRITE_TAC[ADD_CLAUSES] THEN
5822     DISCH_THEN(ASSUME_TAC o CONJUNCT2) THEN BETA_TAC; ALL_TAC] THEN
5823   REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN
5824   ONCE_REWRITE_TAC[AC REAL_MUL_AC
5825     `a * b * c * d = (b * c) * (a * d)`] THEN
5826   REWRITE_TAC[GSYM POW_MUL; GSYM REAL_NEG_MINUS1; REAL_NEGNEG] THEN
5827   REWRITE_TAC[REAL_MUL_ASSOC]);;
5828
5829 (* ------------------------------------------------------------------------- *)
5830 (* More convenient "bidirectional" version.                                  *)
5831 (* ------------------------------------------------------------------------- *)
5832
5833 let MCLAURIN_BI_LE = prove
5834  (`!f diff x n.
5835         (diff 0 = f) /\
5836         (!m t. m < n /\ abs(t) <= abs(x) ==> (diff m diffl diff (SUC m) t) t)
5837         ==> ?t. abs(t) <= abs(x) /\
5838                 (f x = sum (0,n) (\m. diff m (&0) / &(FACT m) * x pow m) +
5839                        diff n t / &(FACT n) * x pow n)`,
5840   REPEAT STRIP_TAC THEN ASM_CASES_TAC `n = 0` THENL
5841    [ASM_REWRITE_TAC[sum; real_pow; FACT; REAL_DIV_1; REAL_MUL_RID;
5842                     REAL_ADD_LID] THEN
5843     EXISTS_TAC `x:real` THEN REWRITE_TAC[REAL_LE_REFL]; ALL_TAC] THEN
5844   ASM_CASES_TAC `x = &0` THENL
5845    [EXISTS_TAC `&0` THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN
5846     UNDISCH_TAC `~(n = 0)` THEN SPEC_TAC(`n:num`,`n:num`) THEN
5847     INDUCT_TAC THEN ASM_REWRITE_TAC[NOT_SUC] THEN
5848     REWRITE_TAC[ADD1] THEN
5849     REWRITE_TAC[REWRITE_RULE[REAL_EQ_SUB_RADD] (GSYM SUM_OFFSET)] THEN
5850     REWRITE_TAC[REAL_POW_ADD; REAL_POW_1; REAL_MUL_RZERO; SUM_0] THEN
5851     REWRITE_TAC[REAL_ADD_RID; REAL_ADD_LID] THEN
5852     CONV_TAC(ONCE_DEPTH_CONV REAL_SUM_CONV) THEN
5853     ASM_REWRITE_TAC[real_pow; FACT; REAL_MUL_RID; REAL_DIV_1]; ALL_TAC] THEN
5854   FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH
5855    `~(x = &0) ==> &0 < x \/ x < &0`))
5856   THENL
5857    [MP_TAC(SPECL [`f:real->real`; `diff:num->real->real`; `x:real`; `n:num`]
5858                  MCLAURIN) THEN
5859     ASM_SIMP_TAC[REAL_ARITH `&0 <= t /\ t <= x ==> abs(t) <= abs(x)`] THEN
5860     ASM_REWRITE_TAC[LT_NZ] THEN MATCH_MP_TAC MONO_EXISTS THEN
5861     SIMP_TAC[REAL_ARITH `&0 < t /\ t < x ==> abs(t) <= abs(x)`];
5862     MP_TAC(SPECL [`f:real->real`; `diff:num->real->real`; `x:real`; `n:num`]
5863                  MCLAURIN_NEG) THEN
5864     ASM_SIMP_TAC[REAL_ARITH `x <= t /\ t <= &0 ==> abs(t) <= abs(x)`] THEN
5865     ASM_REWRITE_TAC[LT_NZ] THEN MATCH_MP_TAC MONO_EXISTS THEN
5866     SIMP_TAC[REAL_ARITH `x < t /\ t < &0 ==> abs(t) <= abs(x)`]]);;
5867
5868 (* ------------------------------------------------------------------------- *)
5869 (* Simple strong form if a function is differentiable everywhere.            *)
5870 (* ------------------------------------------------------------------------- *)
5871
5872 let MCLAURIN_ALL_LT = prove
5873  (`!f diff.
5874       (diff 0 = f) /\
5875       (!m x. ((diff m) diffl (diff(SUC m) x)) x)
5876       ==> !x n. ~(x = &0) /\ 0 < n
5877             ==> ?t. &0 < abs(t) /\ abs(t) < abs(x) /\
5878                     (f(x) = sum(0,n)(\m. (diff m (&0) / &(FACT m)) * x pow m) +
5879                             (diff n t / &(FACT n)) * x pow n)`,
5880   REPEAT STRIP_TAC THEN
5881   REPEAT_TCL DISJ_CASES_THEN MP_TAC
5882    (SPECL [`x:real`; `&0`] REAL_LT_TOTAL) THEN
5883   ASM_REWRITE_TAC[] THEN DISCH_TAC THENL
5884    [MP_TAC(SPECL [`f:real->real`; `diff:num->real->real`;
5885                   `x:real`; `n:num`] MCLAURIN_NEG) THEN
5886     ASM_REWRITE_TAC[] THEN
5887     DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN
5888     EXISTS_TAC `t:real` THEN ASM_REWRITE_TAC[] THEN
5889     UNDISCH_TAC `t < &0` THEN UNDISCH_TAC `x < t` THEN REAL_ARITH_TAC;
5890     MP_TAC(SPECL [`f:real->real`; `diff:num->real->real`;
5891                   `x:real`; `n:num`] MCLAURIN) THEN
5892     ASM_REWRITE_TAC[] THEN
5893     DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN
5894     EXISTS_TAC `t:real` THEN ASM_REWRITE_TAC[] THEN
5895     UNDISCH_TAC `&0 < t` THEN UNDISCH_TAC `t < x` THEN REAL_ARITH_TAC]);;
5896
5897 let MCLAURIN_ZERO = prove
5898  (`!diff n x. (x = &0) /\ 0 < n ==>
5899        (sum(0,n)(\m. (diff m (&0) / &(FACT m)) * x pow m) = diff 0 (&0))`,
5900   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 SUBST1_TAC MP_TAC) THEN
5901   SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN REWRITE_TAC[LT_REFL] THEN
5902   REWRITE_TAC[LT] THEN
5903   DISCH_THEN(DISJ_CASES_THEN2 (SUBST1_TAC o SYM) MP_TAC) THENL
5904    [REWRITE_TAC[sum; ADD_CLAUSES; FACT; real_pow; real_div; REAL_INV_1] THEN
5905     REWRITE_TAC[REAL_ADD_LID; REAL_MUL_RID];
5906     REWRITE_TAC[sum] THEN
5907     DISCH_THEN(fun th -> ASSUME_TAC th THEN ANTE_RES_THEN SUBST1_TAC th) THEN
5908     UNDISCH_TAC `0 < n` THEN SPEC_TAC(`n:num`,`n:num`) THEN
5909     INDUCT_TAC THEN REWRITE_TAC[LT_REFL] THEN
5910     REWRITE_TAC[ADD_CLAUSES; real_pow; REAL_MUL_LZERO; REAL_MUL_RZERO] THEN
5911     REWRITE_TAC[REAL_ADD_RID]]);;
5912
5913 let MCLAURIN_ALL_LE = prove
5914  (`!f diff.
5915       (diff 0 = f) /\
5916       (!m x. ((diff m) diffl (diff(SUC m) x)) x)
5917       ==> !x n. ?t. abs(t) <= abs(x) /\
5918                     (f(x) = sum(0,n)(\m. (diff m (&0) / &(FACT m)) * x pow m) +
5919                             (diff n t / &(FACT n)) * x pow n)`,
5920   REPEAT STRIP_TAC THEN
5921   DISJ_CASES_THEN MP_TAC(SPECL [`n:num`; `0`] LET_CASES) THENL
5922    [REWRITE_TAC[LE] THEN DISCH_THEN SUBST1_TAC THEN
5923     ASM_REWRITE_TAC[sum; REAL_ADD_LID; FACT] THEN EXISTS_TAC `x:real` THEN
5924     REWRITE_TAC[REAL_LE_REFL; real_pow; REAL_MUL_RID; REAL_DIV_1];
5925     DISCH_TAC THEN ASM_CASES_TAC `x = &0` THENL
5926      [MP_TAC(SPEC_ALL MCLAURIN_ZERO) THEN ASM_REWRITE_TAC[] THEN
5927       DISCH_THEN SUBST1_TAC THEN EXISTS_TAC `&0` THEN
5928       REWRITE_TAC[REAL_LE_REFL] THEN
5929       SUBGOAL_THEN `&0 pow n = &0` SUBST1_TAC THENL
5930        [ASM_REWRITE_TAC[REAL_POW_EQ_0; GSYM (CONJUNCT1 LE); NOT_LE];
5931         REWRITE_TAC[REAL_ADD_RID; REAL_MUL_RZERO]];
5932       MP_TAC(SPEC_ALL MCLAURIN_ALL_LT) THEN ASM_REWRITE_TAC[] THEN
5933       DISCH_THEN(MP_TAC o SPEC_ALL) THEN ASM_REWRITE_TAC[] THEN
5934       DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN
5935       EXISTS_TAC `t:real` THEN ASM_REWRITE_TAC[] THEN
5936       MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]]]);;
5937
5938 (* ------------------------------------------------------------------------- *)
5939 (* Version for exp.                                                          *)
5940 (* ------------------------------------------------------------------------- *)
5941
5942 let MCLAURIN_EXP_LEMMA = prove
5943  (`((\n:num. exp) 0 = exp) /\
5944    (!m x. (((\n:num. exp) m) diffl ((\n:num. exp) (SUC m) x)) x)`,
5945   REWRITE_TAC[DIFF_EXP]);;
5946
5947 let MCLAURIN_EXP_LT = prove
5948  (`!x n. ~(x = &0) /\ 0 < n
5949          ==> ?t. &0 < abs(t) /\
5950                  abs(t) < abs(x) /\
5951                  (exp(x) = sum(0,n)(\m. x pow m / &(FACT m)) +
5952                            (exp(t) / &(FACT n)) * x pow n)`,
5953   MP_TAC (MATCH_MP MCLAURIN_ALL_LT MCLAURIN_EXP_LEMMA) THEN
5954   REWRITE_TAC[REAL_EXP_0; real_div; REAL_MUL_AC; REAL_MUL_LID; REAL_MUL_RID]);;
5955
5956 let MCLAURIN_EXP_LE = prove
5957  (`!x n. ?t. abs(t) <= abs(x) /\
5958              (exp(x) = sum(0,n)(\m. x pow m / &(FACT m)) +
5959                        (exp(t) / &(FACT n)) * x pow n)`,
5960   MP_TAC (MATCH_MP MCLAURIN_ALL_LE MCLAURIN_EXP_LEMMA) THEN
5961   REWRITE_TAC[REAL_EXP_0; real_div; REAL_MUL_AC; REAL_MUL_LID; REAL_MUL_RID]);;
5962
5963 (* ------------------------------------------------------------------------- *)
5964 (* Version for ln(1 +/- x).                                                  *)
5965 (* ------------------------------------------------------------------------- *)
5966
5967 let DIFF_LN_COMPOSITE = prove
5968  (`!g m x. (g diffl m)(x) /\ &0 < g x
5969            ==> ((\x. ln(g x)) diffl (inv(g x) * m))(x)`,
5970   REPEAT STRIP_TAC THEN MATCH_MP_TAC DIFF_CHAIN THEN
5971   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIFF_LN THEN
5972   ASM_REWRITE_TAC[]) in
5973 add_to_diff_net (SPEC_ALL DIFF_LN_COMPOSITE);;
5974
5975 let MCLAURIN_LN_POS = prove
5976  (`!x n.
5977      &0 < x /\ 0 < n
5978      ==> ?t. &0 < t /\
5979              t < x /\
5980              (ln(&1 + x) = sum(0,n)
5981                            (\m. --(&1) pow (SUC m) * (x pow m) / &m) +
5982                --(&1) pow (SUC n) * x pow n / (&n * (&1 + t) pow n))`,
5983   REPEAT STRIP_TAC THEN
5984   MP_TAC(SPEC `\x. ln(&1 + x)` MCLAURIN) THEN
5985   DISCH_THEN(MP_TAC o SPEC
5986     `\n x. if n = 0 then ln(&1 + x)
5987            else --(&1) pow (SUC n) *
5988                 &(FACT(PRE n)) * inv((&1 + x) pow n)`) THEN
5989   DISCH_THEN(MP_TAC o SPECL [`x:real`; `n:num`]) THEN
5990   ASM_REWRITE_TAC[] THEN
5991   REWRITE_TAC[NOT_SUC; REAL_ADD_RID; REAL_POW_ONE] THEN
5992   REWRITE_TAC[LN_1; REAL_INV_1; REAL_MUL_RID] THEN
5993   SUBGOAL_THEN `~(n = 0)` ASSUME_TAC THENL
5994    [UNDISCH_TAC `0 < n` THEN ARITH_TAC; ASM_REWRITE_TAC[]] THEN
5995   SUBGOAL_THEN `!p. ~(p = 0) ==> (&(FACT(PRE p)) / &(FACT p) = inv(&p))`
5996   ASSUME_TAC THENL
5997    [INDUCT_TAC THEN REWRITE_TAC[NOT_SUC; PRE] THEN
5998     REWRITE_TAC[real_div; FACT; GSYM REAL_OF_NUM_MUL] THEN
5999     REWRITE_TAC[REAL_INV_MUL] THEN
6000     ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
6001     GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN
6002     REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN
6003     AP_TERM_TAC THEN MATCH_MP_TAC REAL_MUL_LINV THEN
6004     REWRITE_TAC[REAL_OF_NUM_EQ] THEN
6005     MP_TAC(SPEC `p:num` FACT_LT) THEN ARITH_TAC; ALL_TAC] THEN
6006   SUBGOAL_THEN
6007    `!p. (if p = 0 then &0 else --(&1) pow (SUC p) * &(FACT (PRE p))) /
6008         &(FACT p) = --(&1) pow (SUC p) * inv(&p)`
6009   (fun th -> REWRITE_TAC[th]) THENL
6010    [INDUCT_TAC THENL
6011      [REWRITE_TAC[REAL_INV_0; real_div; REAL_MUL_LZERO; REAL_MUL_RZERO];
6012       REWRITE_TAC[NOT_SUC] THEN
6013       REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN
6014       AP_TERM_TAC THEN REWRITE_TAC[GSYM real_div] THEN
6015       FIRST_ASSUM MATCH_MP_TAC THEN
6016       REWRITE_TAC[NOT_SUC]]; ALL_TAC] THEN
6017   SUBGOAL_THEN
6018     `!t. (--(&1) pow (SUC n) * &(FACT(PRE n)) * inv ((&1 + t) pow n)) /
6019          &(FACT n) * x pow n = --(&1) pow (SUC n) *
6020                                x pow n / (&n * (&1 + t) pow n)`
6021   (fun th -> REWRITE_TAC[th]) THENL
6022    [GEN_TAC THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN
6023     AP_TERM_TAC THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN
6024     GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN AP_TERM_TAC THEN
6025     REWRITE_TAC[REAL_INV_MUL] THEN
6026     GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN
6027     REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN
6028     ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN
6029     FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN
6030   REWRITE_TAC[real_div; REAL_MUL_AC] THEN
6031   DISCH_THEN MATCH_MP_TAC THEN
6032   X_GEN_TAC `m:num` THEN X_GEN_TAC `u:real` THEN STRIP_TAC THEN
6033   ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[] THENL
6034    [W(MP_TAC o SPEC `u:real` o DIFF_CONV o lhand o rator o snd) THEN
6035     REWRITE_TAC[PRE; real_pow; REAL_ADD_LID; REAL_MUL_RID] THEN
6036     REWRITE_TAC[REAL_MUL_RNEG; REAL_MUL_LNEG; REAL_MUL_RID] THEN
6037     REWRITE_TAC[FACT; REAL_MUL_RID; REAL_NEG_NEG] THEN
6038     DISCH_THEN MATCH_MP_TAC THEN UNDISCH_TAC `&0 <= u` THEN REAL_ARITH_TAC;
6039     W(MP_TAC o SPEC `u:real` o DIFF_CONV o lhand o rator o snd) THEN
6040     SUBGOAL_THEN `~((&1 + u) pow m = &0)` (fun th -> REWRITE_TAC[th]) THENL
6041      [REWRITE_TAC[REAL_POW_EQ_0] THEN ASM_REWRITE_TAC[] THEN
6042       UNDISCH_TAC `&0 <= u` THEN REAL_ARITH_TAC;
6043       MATCH_MP_TAC EQ_IMP THEN
6044       AP_THM_TAC THEN AP_TERM_TAC THEN
6045       REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_RID] THEN
6046       REWRITE_TAC[REAL_ADD_LID; REAL_MUL_RID] THEN
6047       REWRITE_TAC[real_div; real_pow; REAL_MUL_LNEG; REAL_MUL_RNEG] THEN
6048       REWRITE_TAC[REAL_NEG_NEG; REAL_MUL_RID; REAL_MUL_LID] THEN
6049       REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN
6050       UNDISCH_TAC `~(m = 0)` THEN SPEC_TAC(`m:num`,`p:num`) THEN
6051       INDUCT_TAC THEN REWRITE_TAC[NOT_SUC] THEN
6052       REWRITE_TAC[SUC_SUB1; PRE] THEN REWRITE_TAC[FACT] THEN
6053       REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN
6054       REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN
6055       GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN
6056       REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN
6057       REWRITE_TAC[real_pow; REAL_POW_2] THEN REWRITE_TAC[REAL_INV_MUL] THEN
6058       REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN
6059       REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN
6060       ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
6061       GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN
6062       REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN
6063       MATCH_MP_TAC REAL_MUL_LINV THEN
6064       REWRITE_TAC[REAL_POW_EQ_0] THEN ASM_REWRITE_TAC[] THEN
6065       REWRITE_TAC[DE_MORGAN_THM] THEN DISJ1_TAC THEN
6066       UNDISCH_TAC `&0 <= u` THEN REAL_ARITH_TAC]]);;
6067
6068 let MCLAURIN_LN_NEG = prove
6069  (`!x n. &0 < x /\ x < &1 /\ 0 < n
6070          ==> ?t. &0 < t /\
6071                  t < x /\
6072                  (--(ln(&1 - x)) = sum(0,n) (\m. (x pow m) / &m) +
6073                                     x pow n / (&n * (&1 - t) pow n))`,
6074   REPEAT STRIP_TAC THEN
6075   MP_TAC(SPEC `\x. --(ln(&1 - x))` MCLAURIN) THEN
6076   DISCH_THEN(MP_TAC o SPEC
6077     `\n x. if n = 0 then --(ln(&1 - x))
6078            else &(FACT(PRE n)) * inv((&1 - x) pow n)`) THEN
6079   DISCH_THEN(MP_TAC o SPECL [`x:real`; `n:num`]) THEN
6080   ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_SUB_RZERO] THEN
6081   REWRITE_TAC[NOT_SUC; LN_1; REAL_POW_ONE] THEN
6082   SUBGOAL_THEN `~(n = 0)` ASSUME_TAC THENL
6083    [UNDISCH_TAC `0 < n` THEN ARITH_TAC; ASM_REWRITE_TAC[]] THEN
6084   REWRITE_TAC[REAL_INV_1; REAL_MUL_RID; REAL_MUL_LID] THEN
6085   SUBGOAL_THEN `!p. ~(p = 0) ==> (&(FACT(PRE p)) / &(FACT p) = inv(&p))`
6086   ASSUME_TAC THENL
6087    [INDUCT_TAC THEN REWRITE_TAC[NOT_SUC; PRE] THEN
6088     REWRITE_TAC[real_div; FACT; GSYM REAL_OF_NUM_MUL] THEN
6089     REWRITE_TAC[REAL_INV_MUL] THEN
6090     ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
6091     GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN
6092     REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN
6093     AP_TERM_TAC THEN MATCH_MP_TAC REAL_MUL_LINV THEN
6094     REWRITE_TAC[REAL_OF_NUM_EQ] THEN
6095     MP_TAC(SPEC `p:num` FACT_LT) THEN ARITH_TAC; ALL_TAC] THEN
6096   REWRITE_TAC[REAL_NEG_0] THEN
6097   SUBGOAL_THEN `!p. (if p = 0 then &0 else &(FACT (PRE p))) / &(FACT p) =
6098                     inv(&p)`
6099   (fun th -> REWRITE_TAC[th]) THENL
6100    [INDUCT_TAC THENL
6101      [REWRITE_TAC[REAL_INV_0; real_div; REAL_MUL_LZERO];
6102       REWRITE_TAC[NOT_SUC] THEN FIRST_ASSUM MATCH_MP_TAC THEN
6103       REWRITE_TAC[NOT_SUC]]; ALL_TAC] THEN
6104   SUBGOAL_THEN
6105     `!t. (&(FACT(PRE n)) * inv ((&1 - t) pow n)) / &(FACT n) * x pow n
6106          = x pow n / (&n * (&1 - t) pow n)`
6107   (fun th -> REWRITE_TAC[th]) THENL
6108    [GEN_TAC THEN REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN
6109     GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN AP_TERM_TAC THEN
6110     REWRITE_TAC[REAL_INV_MUL] THEN
6111     GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN
6112     REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN
6113     ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN
6114     FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN
6115   REWRITE_TAC[real_div; REAL_MUL_AC] THEN
6116   DISCH_THEN MATCH_MP_TAC THEN
6117   X_GEN_TAC `m:num` THEN X_GEN_TAC `u:real` THEN STRIP_TAC THEN
6118   ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[] THENL
6119    [W(MP_TAC o SPEC `u:real` o DIFF_CONV o lhand o rator o snd) THEN
6120     REWRITE_TAC[PRE; pow; FACT; REAL_SUB_LZERO] THEN
6121     REWRITE_TAC[REAL_MUL_RNEG; REAL_NEG_NEG; REAL_MUL_RID] THEN
6122     DISCH_THEN MATCH_MP_TAC THEN
6123     UNDISCH_TAC `x < &1` THEN UNDISCH_TAC `u:real <= x` THEN
6124     REAL_ARITH_TAC;
6125     W(MP_TAC o SPEC `u:real` o DIFF_CONV o lhand o rator o snd) THEN
6126     SUBGOAL_THEN `~((&1 - u) pow m = &0)` (fun th -> REWRITE_TAC[th]) THENL
6127      [REWRITE_TAC[REAL_POW_EQ_0] THEN ASM_REWRITE_TAC[] THEN
6128       UNDISCH_TAC `x < &1` THEN UNDISCH_TAC `u:real <= x` THEN
6129       REAL_ARITH_TAC;
6130       MATCH_MP_TAC EQ_IMP THEN
6131       AP_THM_TAC THEN AP_TERM_TAC THEN
6132       REWRITE_TAC[REAL_SUB_LZERO; real_div; PRE] THEN
6133       REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_RID] THEN
6134       REWRITE_TAC
6135        [REAL_MUL_RNEG; REAL_MUL_LNEG; REAL_NEG_NEG; REAL_MUL_RID] THEN
6136       UNDISCH_TAC `~(m = 0)` THEN SPEC_TAC(`m:num`,`p:num`) THEN
6137       INDUCT_TAC THEN REWRITE_TAC[NOT_SUC] THEN
6138       REWRITE_TAC[SUC_SUB1; PRE] THEN REWRITE_TAC[FACT] THEN
6139       REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN
6140       REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN
6141       GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN
6142       REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN
6143       REWRITE_TAC[real_pow; REAL_POW_2] THEN REWRITE_TAC[REAL_INV_MUL] THEN
6144       REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN
6145       REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN
6146       ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
6147       GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN
6148       REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN
6149       MATCH_MP_TAC REAL_MUL_LINV THEN
6150       REWRITE_TAC[REAL_POW_EQ_0] THEN ASM_REWRITE_TAC[] THEN
6151       UNDISCH_TAC `x < &1` THEN UNDISCH_TAC `u:real <= x` THEN
6152       REAL_ARITH_TAC]]);;
6153
6154 (* ------------------------------------------------------------------------- *)
6155 (* Versions for sin and cos.                                                 *)
6156 (* ------------------------------------------------------------------------- *)
6157
6158 let MCLAURIN_SIN = prove
6159  (`!x n. abs(sin x -
6160              sum(0,n) (\m. (if EVEN m then &0
6161                             else -- &1 pow ((m - 1) DIV 2) / &(FACT m)) *
6162                             x pow m))
6163          <= inv(&(FACT n)) * abs(x) pow n`,
6164   REPEAT STRIP_TAC THEN
6165   MP_TAC(SPECL [`sin`; `\n x. if n MOD 4 = 0 then sin(x)
6166                               else if n MOD 4 = 1 then cos(x)
6167                               else if n MOD 4 = 2 then --sin(x)
6168                               else --cos(x)`] MCLAURIN_ALL_LE) THEN
6169   W(C SUBGOAL_THEN (fun th -> REWRITE_TAC[th]) o funpow 2 lhand o snd) THENL
6170    [CONJ_TAC THENL
6171      [SIMP_TAC[MOD_0; ARITH_EQ; EQT_INTRO(SPEC_ALL ETA_AX)]; ALL_TAC] THEN
6172     X_GEN_TAC `m:num` THEN X_GEN_TAC `y:real` THEN REWRITE_TAC[] THEN
6173     MP_TAC(SPECL [`m:num`; `4`] DIVISION) THEN
6174     REWRITE_TAC[ARITH_EQ] THEN ABBREV_TAC `d = m MOD 4` THEN
6175     DISCH_THEN(CONJUNCTS_THEN2 SUBST1_TAC MP_TAC) THEN
6176     REWRITE_TAC[ADD1; GSYM ADD_ASSOC; MOD_MULT_ADD] THEN
6177     SPEC_TAC(`d:num`,`d:num`) THEN CONV_TAC EXPAND_CASES_CONV THEN
6178     CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[] THEN
6179     REPEAT CONJ_TAC THEN
6180     W(MP_TAC o DIFF_CONV o lhand o rator o snd) THEN
6181     SIMP_TAC[REAL_MUL_RID; REAL_NEG_NEG]; ALL_TAC] THEN
6182   DISCH_THEN(MP_TAC o SPECL [`x:real`; `n:num`]) THEN
6183   DISCH_THEN(X_CHOOSE_THEN `t:real`
6184     (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN
6185   MATCH_MP_TAC(REAL_ARITH
6186     `(x = y) /\ abs(u) <= v ==> abs((x + u) - y) <= v`) THEN
6187   CONJ_TAC THENL
6188    [MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN
6189     REWRITE_TAC[SIN_0; COS_0; REAL_NEG_0] THEN
6190     AP_THM_TAC THEN AP_TERM_TAC THEN
6191     MP_TAC(SPECL [`r:num`; `4`] DIVISION) THEN REWRITE_TAC[ARITH_EQ] THEN
6192     DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
6193     DISCH_THEN(fun th -> GEN_REWRITE_TAC
6194       (RAND_CONV o ONCE_DEPTH_CONV) [th] THEN
6195       MP_TAC(SYM th)) THEN
6196     REWRITE_TAC[EVEN_ADD; EVEN_MULT; ARITH_EVEN] THEN
6197     UNDISCH_TAC `r MOD 4 < 4` THEN
6198     SPEC_TAC(`r MOD 4`,`d:num`) THEN CONV_TAC EXPAND_CASES_CONV THEN
6199     CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[] THEN
6200     REWRITE_TAC[real_div; REAL_MUL_LZERO] THEN
6201     SIMP_TAC[ARITH_RULE `(x + 1) - 1 = x`;
6202              ARITH_RULE `(x + 3) - 1 = x + 2`;
6203              ARITH_RULE `x * 4 + 2 = 2 * (2 * x + 1)`;
6204              ARITH_RULE `x * 4 = 2 * 2 * x`] THEN
6205     SIMP_TAC[DIV_MULT; ARITH_EQ] THEN
6206     REWRITE_TAC[REAL_POW_NEG; EVEN_ADD; EVEN_MULT; ARITH_EVEN; REAL_POW_ONE];
6207     ALL_TAC] THEN
6208   REWRITE_TAC[REAL_ABS_MUL; REAL_INV_MUL] THEN
6209   MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN CONJ_TAC THENL
6210    [REWRITE_TAC[real_div; REAL_ABS_MUL] THEN
6211     GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN
6212     REWRITE_TAC[REAL_ABS_INV; REAL_ABS_NUM] THEN
6213     MATCH_MP_TAC REAL_LE_RMUL THEN
6214     SIMP_TAC[REAL_LE_INV_EQ; REAL_POS] THEN
6215     REPEAT COND_CASES_TAC THEN REWRITE_TAC[REAL_ABS_NEG; SIN_BOUND; COS_BOUND];
6216     ALL_TAC] THEN
6217   REWRITE_TAC[REAL_ABS_POW; REAL_LE_REFL]);;
6218
6219 let MCLAURIN_COS = prove
6220  (`!x n. abs(cos x -
6221                    sum(0,n) (\m. (if EVEN m
6222                                   then -- &1 pow (m DIV 2) / &(FACT m)
6223                                   else &0) * x pow m))
6224                <= inv(&(FACT n)) * abs(x) pow n`,
6225   REPEAT STRIP_TAC THEN
6226   MP_TAC(SPECL [`cos`; `\n x. if n MOD 4 = 0 then cos(x)
6227                               else if n MOD 4 = 1 then --sin(x)
6228                               else if n MOD 4 = 2 then --cos(x)
6229                               else sin(x)`] MCLAURIN_ALL_LE) THEN
6230   W(C SUBGOAL_THEN (fun th -> REWRITE_TAC[th]) o funpow 2 lhand o snd) THENL
6231    [CONJ_TAC THENL
6232      [SIMP_TAC[MOD_0; ARITH_EQ; EQT_INTRO(SPEC_ALL ETA_AX)]; ALL_TAC] THEN
6233     X_GEN_TAC `m:num` THEN X_GEN_TAC `y:real` THEN REWRITE_TAC[] THEN
6234     MP_TAC(SPECL [`m:num`; `4`] DIVISION) THEN
6235     REWRITE_TAC[ARITH_EQ] THEN ABBREV_TAC `d = m MOD 4` THEN
6236     DISCH_THEN(CONJUNCTS_THEN2 SUBST1_TAC MP_TAC) THEN
6237     REWRITE_TAC[ADD1; GSYM ADD_ASSOC; MOD_MULT_ADD] THEN
6238     SPEC_TAC(`d:num`,`d:num`) THEN CONV_TAC EXPAND_CASES_CONV THEN
6239     CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[] THEN
6240     REPEAT CONJ_TAC THEN
6241     W(MP_TAC o DIFF_CONV o lhand o rator o snd) THEN
6242     SIMP_TAC[REAL_MUL_RID; REAL_NEG_NEG]; ALL_TAC] THEN
6243   DISCH_THEN(MP_TAC o SPECL [`x:real`; `n:num`]) THEN
6244   DISCH_THEN(X_CHOOSE_THEN `t:real`
6245     (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN
6246   MATCH_MP_TAC(REAL_ARITH
6247     `(x = y) /\ abs(u) <= v ==> abs((x + u) - y) <= v`) THEN
6248   CONJ_TAC THENL
6249    [MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN
6250     REWRITE_TAC[SIN_0; COS_0; REAL_NEG_0] THEN
6251     AP_THM_TAC THEN AP_TERM_TAC THEN
6252     MP_TAC(SPECL [`r:num`; `4`] DIVISION) THEN REWRITE_TAC[ARITH_EQ] THEN
6253     DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
6254     DISCH_THEN(fun th -> GEN_REWRITE_TAC
6255       (RAND_CONV o ONCE_DEPTH_CONV) [th] THEN
6256       MP_TAC(SYM th)) THEN
6257     REWRITE_TAC[EVEN_ADD; EVEN_MULT; ARITH_EVEN] THEN
6258     UNDISCH_TAC `r MOD 4 < 4` THEN
6259     SPEC_TAC(`r MOD 4`,`d:num`) THEN CONV_TAC EXPAND_CASES_CONV THEN
6260     CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[] THEN
6261     REWRITE_TAC[real_div; REAL_MUL_LZERO] THEN
6262     REWRITE_TAC[ARITH_RULE `x * 4 + 2 = 2 * (2 * x + 1)`;
6263                 ARITH_RULE `x * 4 + 0 = 2 * 2 * x`] THEN
6264     SIMP_TAC[DIV_MULT; ARITH_EQ] THEN
6265     REWRITE_TAC[REAL_POW_NEG; EVEN_ADD; EVEN_MULT; ARITH_EVEN; REAL_POW_ONE];
6266     ALL_TAC] THEN
6267   REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_DIV; REAL_MUL_ASSOC; REAL_ABS_POW] THEN
6268   MATCH_MP_TAC REAL_LE_RMUL THEN SIMP_TAC[REAL_POW_LE; REAL_ABS_POS] THEN
6269   REWRITE_TAC[real_div; REAL_ABS_NUM] THEN
6270   GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN
6271   MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS] THEN
6272   REPEAT COND_CASES_TAC THEN REWRITE_TAC[REAL_ABS_NEG; SIN_BOUND; COS_BOUND]);;
6273
6274 (* ------------------------------------------------------------------------- *)
6275 (* Taylor series for atan; needs a bit more preparation.                     *)
6276 (* ------------------------------------------------------------------------- *)
6277
6278 let REAL_ATN_POWSER_SUMMABLE = prove
6279  (`!x. abs(x) < &1
6280        ==> summable (\n. (if EVEN n then &0
6281                           else --(&1) pow ((n - 1) DIV 2) / &n) * x pow n)`,
6282   REPEAT STRIP_TAC THEN MATCH_MP_TAC SER_COMPAR THEN
6283   EXISTS_TAC `\n. abs(x) pow n` THEN CONJ_TAC THENL
6284    [EXISTS_TAC `0` THEN REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN
6285     COND_CASES_TAC THEN
6286     SIMP_TAC[REAL_POW_LE; REAL_MUL_LZERO; REAL_ABS_POS; REAL_ABS_NUM] THEN
6287     REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_DIV; REAL_ABS_NEG; REAL_ABS_POW] THEN
6288     REWRITE_TAC[REAL_ABS_NUM; REAL_POW_ONE; REAL_MUL_LID] THEN
6289     REWRITE_TAC[real_div; REAL_MUL_LID] THEN
6290     ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN
6291     MATCH_MP_TAC REAL_LE_LDIV THEN
6292     CONJ_TAC THENL [ASM_MESON_TAC[REAL_OF_NUM_LT; EVEN; LT_NZ]; ALL_TAC] THEN
6293     GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_RID] THEN
6294     MATCH_MP_TAC REAL_LE_LMUL THEN
6295     SIMP_TAC[REAL_POW_LE; REAL_ABS_POS] THEN
6296     ASM_MESON_TAC[REAL_OF_NUM_LE; EVEN; ARITH_RULE `1 <= n <=> ~(n = 0)`];
6297     ALL_TAC] THEN
6298   REWRITE_TAC[summable] THEN EXISTS_TAC `inv(&1 - abs x)` THEN
6299   MATCH_MP_TAC GP THEN ASM_REWRITE_TAC[REAL_ABS_ABS]);;
6300
6301 let REAL_ATN_POWSER_DIFFS_SUMMABLE = prove
6302  (`!x. abs(x) < &1
6303        ==> summable (\n. diffs (\n. (if EVEN n then &0
6304                                      else --(&1) pow ((n - 1) DIV 2) / &n)) n *
6305                          x pow n)`,
6306   REPEAT STRIP_TAC THEN REWRITE_TAC[diffs] THEN
6307   MATCH_MP_TAC SER_COMPAR THEN
6308   EXISTS_TAC `\n. abs(x) pow n` THEN CONJ_TAC THENL
6309    [EXISTS_TAC `0` THEN REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN
6310     COND_CASES_TAC THEN
6311     SIMP_TAC[REAL_POW_LE; REAL_MUL_LZERO; REAL_MUL_RZERO;
6312              REAL_ABS_POS; REAL_ABS_NUM] THEN
6313     SIMP_TAC[REAL_MUL_ASSOC; REAL_DIV_LMUL; REAL_OF_NUM_EQ; NOT_SUC] THEN
6314     REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_DIV; REAL_ABS_NEG; REAL_ABS_POW] THEN
6315     REWRITE_TAC[REAL_ABS_NUM; REAL_POW_ONE; REAL_MUL_LID; REAL_LE_REFL];
6316     ALL_TAC] THEN
6317   REWRITE_TAC[summable] THEN EXISTS_TAC `inv(&1 - abs x)` THEN
6318   MATCH_MP_TAC GP THEN ASM_REWRITE_TAC[REAL_ABS_ABS]);;
6319
6320 let REAL_ATN_POWSER_DIFFS_SUM = prove
6321  (`!x. abs(x) < &1
6322        ==> (\n. diffs (\n. (if EVEN n then &0
6323                             else --(&1) pow ((n - 1) DIV 2) / &n)) n * x pow n)
6324            sums (inv(&1 + x pow 2))`,
6325   REPEAT STRIP_TAC THEN
6326   FIRST_ASSUM(MP_TAC o MATCH_MP REAL_ATN_POWSER_DIFFS_SUMMABLE) THEN
6327   DISCH_THEN(fun th -> MP_TAC(MATCH_MP SUMMABLE_SUM th) THEN
6328                        MP_TAC(MATCH_MP SER_PAIR th)) THEN
6329   SUBGOAL_THEN
6330    `(\n. sum (2 * n,2) (\n. diffs
6331       (\n. (if EVEN n then &0
6332             else --(&1) pow ((n - 1) DIV 2) / &n)) n * x pow n)) =
6333     (\n. --(x pow 2) pow n)`
6334   SUBST1_TAC THENL
6335    [ABS_TAC THEN
6336     CONV_TAC(LAND_CONV(LAND_CONV(RAND_CONV(TOP_DEPTH_CONV num_CONV)))) THEN
6337     REWRITE_TAC[sum; diffs; ADD_CLAUSES; EVEN_MULT; ARITH_EVEN; EVEN] THEN
6338     REWRITE_TAC[REAL_ADD_LID; REAL_ADD_RID; REAL_MUL_LZERO;
6339                 REAL_MUL_RZERO] THEN
6340     SIMP_TAC[ARITH_RULE `SUC n - 1 = n`; DIV_MULT; ARITH_EQ] THEN
6341     SIMP_TAC[REAL_MUL_ASSOC; REAL_DIV_LMUL; REAL_OF_NUM_EQ; NOT_SUC] THEN
6342     ONCE_REWRITE_TAC[GSYM REAL_POW_POW] THEN
6343     REWRITE_TAC[GSYM REAL_POW_MUL] THEN
6344     REWRITE_TAC[REAL_MUL_LNEG; REAL_MUL_LID]; ALL_TAC] THEN
6345   SUBGOAL_THEN `(\n. --(x pow 2) pow n) sums inv (&1 + x pow 2)` MP_TAC THENL
6346    [ONCE_REWRITE_TAC[REAL_ARITH `&1 + x = &1 - (--x)`] THEN
6347     MATCH_MP_TAC GP THEN
6348     REWRITE_TAC[REAL_ABS_NEG; REAL_ABS_POW] THEN
6349     GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN
6350     ASM_SIMP_TAC[REAL_POW_2; REAL_LT_MUL2; REAL_ABS_POS]; ALL_TAC] THEN
6351   MESON_TAC[SUM_UNIQ]);;
6352
6353 let REAL_ATN_POWSER_DIFFS_DIFFS_SUMMABLE = prove
6354  (`!x. abs(x) < &1
6355        ==> summable
6356              (\n. diffs (diffs
6357                  (\n. (if EVEN n then &0
6358                        else --(&1) pow ((n - 1) DIV 2) / &n))) n * x pow n)`,
6359   REPEAT STRIP_TAC THEN REWRITE_TAC[diffs] THEN
6360   MATCH_MP_TAC SER_COMPAR THEN
6361   EXISTS_TAC `\n. &(SUC n) * abs(x) pow n` THEN CONJ_TAC THENL
6362    [EXISTS_TAC `0` THEN REPEAT STRIP_TAC THEN
6363     REWRITE_TAC[REAL_ABS_NUM; REAL_ABS_MUL; GSYM REAL_MUL_ASSOC] THEN
6364     MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN
6365     COND_CASES_TAC THEN
6366     SIMP_TAC[REAL_POW_LE; REAL_MUL_LZERO; REAL_MUL_RZERO;
6367              REAL_ABS_POS; REAL_ABS_NUM] THEN
6368     REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_MUL_ASSOC] THEN
6369     SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; NOT_SUC] THEN
6370     REWRITE_TAC[REAL_ABS_POW; REAL_ABS_NEG; REAL_POW_ONE; REAL_MUL_LID;
6371                 REAL_ABS_NUM; REAL_LE_REFL]; ALL_TAC] THEN
6372   MATCH_MP_TAC SER_RATIO THEN
6373   SUBGOAL_THEN `?c. abs(x) < c /\ c < &1` STRIP_ASSUME_TAC THENL
6374    [EXISTS_TAC `(&1 + abs(x)) / &2` THEN
6375     SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN
6376     UNDISCH_TAC `abs(x) < &1` THEN REAL_ARITH_TAC; ALL_TAC] THEN
6377   EXISTS_TAC `c:real` THEN ASM_REWRITE_TAC[] THEN
6378   SUBGOAL_THEN `?N. !n. n >= N ==> &(SUC(SUC n)) * abs(x) <= &(SUC n) * c`
6379   STRIP_ASSUME_TAC THENL
6380    [ALL_TAC;
6381     EXISTS_TAC `N:num` THEN REPEAT STRIP_TAC THEN
6382     REWRITE_TAC[real_pow; REAL_ABS_MUL; REAL_MUL_ASSOC] THEN
6383     MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN
6384     REWRITE_TAC[REAL_ABS_NUM; REAL_ABS_ABS] THEN
6385     GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN ASM_SIMP_TAC[]] THEN
6386   ASM_CASES_TAC `x = &0` THENL
6387    [ASM_REWRITE_TAC[REAL_ABS_NUM; REAL_MUL_RZERO] THEN
6388     EXISTS_TAC `0` THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN
6389     REWRITE_TAC[REAL_POS] THEN UNDISCH_TAC `abs(x) < c` THEN REAL_ARITH_TAC;
6390     ALL_TAC] THEN
6391   ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; GSYM REAL_ABS_NZ] THEN
6392   REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN
6393   REWRITE_TAC[GSYM real_div] THEN
6394   REWRITE_TAC[ADD1; GSYM REAL_OF_NUM_ADD] THEN
6395   ONCE_REWRITE_TAC[REAL_ARITH `x + &1 <= y <=> &1 <= y - x * &1`] THEN
6396   REWRITE_TAC[GSYM REAL_SUB_LDISTRIB] THEN
6397   SUBGOAL_THEN `?N. &1 <= &N * (c / abs x - &1)` STRIP_ASSUME_TAC THENL
6398    [ALL_TAC;
6399     EXISTS_TAC `N:num` THEN REWRITE_TAC[GE] THEN REPEAT STRIP_TAC THEN
6400     FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
6401      `&1 <= x ==> x <= y ==> &1 <= y`)) THEN
6402     MATCH_MP_TAC REAL_LE_RMUL THEN
6403     ASM_SIMP_TAC[REAL_ARITH `a <= b ==> a <= b + &1`;
6404                  REAL_OF_NUM_LE; REAL_LE_RADD] THEN
6405     REWRITE_TAC[REAL_LE_SUB_LADD; REAL_ADD_LID] THEN
6406     ASM_SIMP_TAC[REAL_LE_RDIV_EQ; GSYM REAL_ABS_NZ; REAL_MUL_LID;
6407                  REAL_LT_IMP_LE]] THEN
6408   ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_LT_SUB_LADD; REAL_ADD_LID;
6409                REAL_LT_RDIV_EQ; GSYM REAL_ABS_NZ; REAL_MUL_LID;
6410                REAL_ARCH_SIMPLE]);;
6411
6412 let REAL_ATN_POWSER_DIFFL = prove
6413  (`!x. abs(x) < &1
6414        ==> ((\x. suminf (\n. (if EVEN n then &0
6415                               else --(&1) pow ((n - 1) DIV 2) / &n) * x pow n))
6416             diffl (inv(&1 + x pow 2))) x`,
6417   REPEAT STRIP_TAC THEN
6418   FIRST_ASSUM(MP_TAC o MATCH_MP REAL_ATN_POWSER_DIFFS_SUM) THEN
6419   DISCH_THEN(SUBST1_TAC o MATCH_MP SUM_UNIQ) THEN
6420   MATCH_MP_TAC TERMDIFF THEN
6421   SUBGOAL_THEN `?K. abs(x) < abs(K) /\ abs(K) < &1` STRIP_ASSUME_TAC THENL
6422    [EXISTS_TAC `(&1 + abs(x)) / &2` THEN
6423     SIMP_TAC[REAL_LT_LDIV_EQ; REAL_ABS_DIV; REAL_ABS_NUM;
6424              REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN
6425     UNDISCH_TAC `abs(x) < &1` THEN REAL_ARITH_TAC; ALL_TAC] THEN
6426   EXISTS_TAC `K:real` THEN ASM_REWRITE_TAC[] THEN
6427   ASM_SIMP_TAC[REAL_ATN_POWSER_SUMMABLE; REAL_ATN_POWSER_DIFFS_SUMMABLE;
6428                REAL_ATN_POWSER_DIFFS_DIFFS_SUMMABLE]);;
6429
6430 let REAL_ATN_POWSER = prove
6431  (`!x. abs(x) < &1
6432        ==> (\n. (if EVEN n then &0
6433                  else --(&1) pow ((n - 1) DIV 2) / &n) * x pow n)
6434            sums (atn x)`,
6435   REPEAT STRIP_TAC THEN
6436   FIRST_ASSUM(MP_TAC o MATCH_MP REAL_ATN_POWSER_SUMMABLE) THEN
6437   DISCH_THEN(MP_TAC o MATCH_MP SUMMABLE_SUM) THEN
6438   SUBGOAL_THEN
6439    `suminf (\n. (if EVEN n then &0
6440                  else --(&1) pow ((n - 1) DIV 2) / &n) * x pow n) = atn(x)`
6441    (fun th -> REWRITE_TAC[th]) THEN
6442   ONCE_REWRITE_TAC[REAL_ARITH `(a = b) <=> (a - b = &0)`] THEN
6443   SUBGOAL_THEN
6444    `suminf (\n. (if EVEN n then &0
6445                  else --(&1) pow ((n - 1) DIV 2) / &n) * &0 pow n) -
6446     atn(&0) = &0`
6447   MP_TAC THENL
6448    [MATCH_MP_TAC(REAL_ARITH `(a = &0) /\ (b = &0) ==> (a - b = &0)`) THEN
6449     CONJ_TAC THENL
6450      [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_UNIQ THEN
6451       MP_TAC(SPEC `&0` GP) THEN
6452       REWRITE_TAC[REAL_ABS_NUM; REAL_OF_NUM_LT; ARITH] THEN
6453       DISCH_THEN(MP_TAC o SPEC `&0` o MATCH_MP SER_CMUL) THEN
6454       REWRITE_TAC[REAL_MUL_LZERO] THEN
6455       MATCH_MP_TAC EQ_IMP THEN
6456       AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN
6457       COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_LZERO] THEN
6458       CONV_TAC SYM_CONV THEN
6459       REWRITE_TAC[REAL_ENTIRE; REAL_POW_EQ_0] THEN ASM_MESON_TAC[EVEN];
6460       GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM TAN_0] THEN
6461       MATCH_MP_TAC TAN_ATN THEN
6462       SIMP_TAC[PI2_BOUNDS; REAL_ARITH `&0 < x ==> --x < &0`]];
6463     ALL_TAC] THEN
6464   ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[] THEN
6465   DISCH_THEN(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN
6466   MP_TAC(SPEC `\x. suminf (\n. (if EVEN n then &0
6467
6468                        else --(&1) pow ((n - 1) DIV 2) / &n) * x pow n) -
6469           atn x` DIFF_ISCONST_END_SIMPLE) THEN
6470   FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH
6471     `~(x = &0) ==> &0 < x \/ x < &0`))
6472   THENL
6473    [DISCH_THEN(MP_TAC o SPECL [`&0`; `x:real`]);
6474     CONV_TAC(RAND_CONV SYM_CONV) THEN
6475     DISCH_THEN(MP_TAC o SPECL [`x:real`; `&0`])] THEN
6476   (REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN
6477    ASM_REWRITE_TAC[] THEN
6478    X_GEN_TAC `u:real` THEN REPEAT STRIP_TAC THEN
6479    SUBGOAL_THEN `abs(u) < &1` (MP_TAC o MATCH_MP REAL_ATN_POWSER_DIFFL) THENL
6480     [POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REAL_ARITH_TAC;
6481      ALL_TAC] THEN
6482    DISCH_THEN(MP_TAC o C CONJ (SPEC `u:real` DIFF_ATN)) THEN
6483    DISCH_THEN(MP_TAC o MATCH_MP DIFF_SUB) THEN
6484    REWRITE_TAC[REAL_SUB_REFL]));;
6485
6486 let MCLAURIN_ATN = prove
6487  (`!x n. abs(x) < &1
6488            ==> abs(atn x -
6489                    sum(0,n) (\m. (if EVEN m then &0
6490                                   else --(&1) pow ((m - 1) DIV 2) / &m) *
6491                                   x pow m))
6492                <= abs(x) pow n / (&1 - abs x)`,
6493   REPEAT STRIP_TAC THEN
6494   FIRST_ASSUM(MP_TAC o MATCH_MP REAL_ATN_POWSER) THEN
6495   DISCH_THEN(fun th -> ASSUME_TAC(SYM(MATCH_MP SUM_UNIQ th)) THEN
6496                        MP_TAC(MATCH_MP SUM_SUMMABLE th)) THEN
6497   DISCH_THEN(MP_TAC o MATCH_MP SER_OFFSET) THEN
6498   DISCH_THEN(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[] THEN
6499   DISCH_THEN(MP_TAC o MATCH_MP SUM_UNIQ) THEN
6500   MATCH_MP_TAC(REAL_ARITH
6501    `abs(r) <= e ==> (f - s = r) ==> abs(f - s) <= e`) THEN
6502   SUBGOAL_THEN
6503    `(\m. abs(x) pow (m + n)) sums (abs(x) pow n) * inv(&1 - abs(x))`
6504   ASSUME_TAC THENL
6505    [FIRST_ASSUM(MP_TAC o MATCH_MP GP o MATCH_MP (REAL_ARITH
6506       `abs(x) < &1 ==> abs(abs x) < &1`)) THEN
6507     DISCH_THEN(MP_TAC o SPEC `abs(x) pow n` o MATCH_MP SER_CMUL) THEN
6508     ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[GSYM REAL_POW_ADD];
6509     ALL_TAC] THEN
6510   FIRST_ASSUM(SUBST1_TAC o MATCH_MP SUM_UNIQ o REWRITE_RULE[GSYM real_div]) THEN
6511   SUBGOAL_THEN
6512    `!m. abs((if EVEN (m + n) then &0
6513              else --(&1) pow (((m + n) - 1) DIV 2) / &(m + n)) *
6514              x pow (m + n))
6515         <= abs(x) pow (m + n)`
6516   ASSUME_TAC THENL
6517    [GEN_TAC THEN COND_CASES_TAC THEN
6518     SIMP_TAC[REAL_MUL_LZERO; REAL_ABS_NUM; REAL_POW_LE; REAL_ABS_POS] THEN
6519     REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_DIV; REAL_ABS_POW; REAL_ABS_NEG] THEN
6520     REWRITE_TAC[REAL_ABS_NUM; REAL_POW_ONE; REAL_MUL_LID] THEN
6521     GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN
6522     MATCH_MP_TAC REAL_LE_RMUL THEN SIMP_TAC[REAL_POW_LE; REAL_ABS_POS] THEN
6523     REWRITE_TAC[real_div; REAL_MUL_LID] THEN
6524     GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_1] THEN
6525     MATCH_MP_TAC REAL_LE_INV2 THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
6526     REWRITE_TAC[REAL_OF_NUM_LE; ARITH_RULE `1 <= n <=> ~(n = 0)`] THEN
6527     ASM_MESON_TAC[EVEN]; ALL_TAC] THEN
6528   MATCH_MP_TAC REAL_LE_TRANS THEN
6529   EXISTS_TAC
6530    `suminf (\m. abs((if EVEN (m + n) then &0
6531                      else --(&1) pow (((m + n) - 1) DIV 2) / &(m + n)) *
6532                     x pow (m + n)))` THEN
6533   CONJ_TAC THENL
6534    [MATCH_MP_TAC SER_ABS THEN MATCH_MP_TAC SER_COMPARA THEN
6535     EXISTS_TAC `\m. abs(x) pow (m + n)` THEN
6536     ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[SUM_SUMMABLE]; ALL_TAC] THEN
6537   MATCH_MP_TAC SER_LE THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
6538    [MATCH_MP_TAC SER_COMPARA THEN
6539     EXISTS_TAC `\m. abs(x) pow (m + n)` THEN
6540     ASM_REWRITE_TAC[]; ALL_TAC] THEN
6541   ASM_MESON_TAC[SUM_SUMMABLE]);;