1(*===========================================================================*)
2(* Definitions of the transcendental functions etc.                          *)
3(*===========================================================================*)
4
5(*
6app load ["hol88Lib",
7          "numLib",
8          "reduceLib",
9          "pairTheory",
10          "jrhUtils",
11          "powserTheory",
12          "Diff",
13          "mesonLib",
14          "RealArith"];
15
16*)
17
18open HolKernel Parse boolLib;
19
20open hol88Lib
21     reduceLib
22     pairTheory
23     numTheory
24     prim_recTheory
25     arithmeticTheory
26     realTheory
27     metricTheory
28     netsTheory
29     seqTheory
30     limTheory
31     powserTheory
32     numLib
33     PairedLambda
34     jrhUtils
35     Diff
36     mesonLib
37     RealArith;
38
39val _ = new_theory "transc";
40
41
42val _ = Parse.reveal "B";
43
44(*---------------------------------------------------------------------------*)
45(* Some miscellaneous lemmas                                                 *)
46(*---------------------------------------------------------------------------*)
47
48val MULT_DIV_2 = prove
49 (���!n. (2 * n) DIV 2 = n���,
50  GEN_TAC THEN ONCE_REWRITE_TAC[MULT_SYM] THEN
51  MP_TAC(SPECL [���2:num���, ���0:num���] DIV_MULT) THEN REDUCE_TAC THEN
52  REWRITE_TAC[ADD_CLAUSES] THEN DISCH_THEN MATCH_ACCEPT_TAC);
53
54val EVEN_DIV2 = prove
55 (���!n. ~(EVEN n) ==> ((SUC n) DIV 2 = SUC((n - 1) DIV 2))���,
56  GEN_TAC THEN REWRITE_TAC[EVEN_ODD, ODD_EXISTS] THEN
57  DISCH_THEN(X_CHOOSE_THEN ���m:num��� SUBST1_TAC) THEN
58  REWRITE_TAC[SUC_SUB1] THEN REWRITE_TAC[ADD1, GSYM ADD_ASSOC] THEN
59  SUBST1_TAC(EQT_ELIM(REDUCE_CONV ���1 + 1:num = 2 * 1���)) THEN
60  REWRITE_TAC[GSYM LEFT_ADD_DISTRIB, MULT_DIV_2]);
61
62
63(*---------------------------------------------------------------------------*)
64(* The three functions we define by series are exp, sin, cos                 *)
65(*---------------------------------------------------------------------------*)
66
67val sin_ser =
68 ���\n. if EVEN n then &0
69         else ((~(&1)) pow ((n - 1) DIV 2)) / &(FACT n)���;
70
71val cos_ser =
72   ���\n. if EVEN n then ((~(&1)) pow (n DIV 2)) / &(FACT n) else &0���;
73
74val exp_ser = ���\n. inv(&(FACT n))���;
75
76val exp = new_definition("exp",
77  ���exp(x) = suminf(\n. (^exp_ser) n * (x pow n))���);
78
79val cos = new_definition("cos",
80  ���cos(x) = suminf(\n. (^cos_ser) n * (x pow n))���);
81
82val sin = new_definition("sin",
83  ���sin(x) = suminf(\n. (^sin_ser) n * (x pow n))���);
84
85(*---------------------------------------------------------------------------*)
86(* Show the series for exp converges, using the ratio test                   *)
87(*---------------------------------------------------------------------------*)
88
89val EXP_CONVERGES = store_thm("EXP_CONVERGES",
90  ���!x. (\n. (^exp_ser) n * (x pow n)) sums exp(x)���,
91  let fun fnz tm =
92    (GSYM o MATCH_MP REAL_LT_IMP_NE o
93     REWRITE_RULE[GSYM REAL_LT] o C SPEC FACT_LESS) tm in
94  GEN_TAC THEN REWRITE_TAC[exp] THEN MATCH_MP_TAC SUMMABLE_SUM THEN
95  MATCH_MP_TAC SER_RATIO THEN
96  MP_TAC (SPEC ���&1��� REAL_DOWN) THEN REWRITE_TAC[REAL_LT_01] THEN
97  DISCH_THEN(X_CHOOSE_THEN ���c:real��� STRIP_ASSUME_TAC) THEN
98  EXISTS_TAC ���c:real��� THEN ASM_REWRITE_TAC[] THEN
99  MP_TAC(SPEC ���c:real��� REAL_ARCH) THEN ASM_REWRITE_TAC[] THEN
100  DISCH_THEN(MP_TAC o SPEC ���abs(x)���) THEN
101  DISCH_THEN(X_CHOOSE_TAC ���N:num���) THEN EXISTS_TAC ���N:num��� THEN
102  X_GEN_TAC ���n:num��� THEN REWRITE_TAC[GREATER_EQ] THEN DISCH_TAC THEN BETA_TAC THEN
103  REWRITE_TAC[ADD1, POW_ADD, ABS_MUL, REAL_MUL_ASSOC, POW_1] THEN
104  GEN_REWR_TAC LAND_CONV  [REAL_MUL_SYM] THEN
105  REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL_IMP THEN
106  REWRITE_TAC[ABS_POS] THEN REWRITE_TAC[GSYM ADD1, FACT] THEN
107  REWRITE_TAC[GSYM REAL_MUL, MATCH_MP REAL_INV_MUL (CONJ
108   (REWRITE_RULE[GSYM REAL_INJ] (SPEC ���n:num��� NOT_SUC)) (fnz ���n:num���))] THEN
109  REWRITE_TAC[ABS_MUL, REAL_MUL_ASSOC] THEN
110  MATCH_MP_TAC REAL_LE_RMUL_IMP THEN REWRITE_TAC[ABS_POS] THEN
111  MP_TAC(SPEC ���n:num��� LESS_0) THEN REWRITE_TAC[GSYM REAL_LT] THEN
112  DISCH_THEN(ASSUME_TAC o GSYM o MATCH_MP REAL_LT_IMP_NE) THEN
113  FIRST_ASSUM(fn th => REWRITE_TAC[MATCH_MP ABS_INV th]) THEN
114  REWRITE_TAC[GSYM real_div] THEN MATCH_MP_TAC REAL_LE_LDIV THEN
115  ASM_REWRITE_TAC[GSYM ABS_NZ] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
116  REWRITE_TAC[REWRITE_RULE[GSYM ABS_REFL, GSYM REAL_LE] ZERO_LESS_EQ] THEN
117  MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC ���&N * c��� THEN CONJ_TAC THENL
118   [MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_ASSUM ACCEPT_TAC,
119    FIRST_ASSUM(fn th => REWRITE_TAC[MATCH_MP REAL_LE_RMUL th]) THEN
120    REWRITE_TAC[REAL_LE] THEN MATCH_MP_TAC LESS_EQ_TRANS THEN
121    EXISTS_TAC ���n:num��� THEN ASM_REWRITE_TAC[LESS_EQ_SUC_REFL]] end);
122
123(*---------------------------------------------------------------------------*)
124(* Show by the comparison test that sin and cos converge                     *)
125(*---------------------------------------------------------------------------*)
126
127val SIN_CONVERGES = store_thm("SIN_CONVERGES",
128  ���!x. (\n. (^sin_ser) n * (x pow n)) sums sin(x)���,
129  GEN_TAC THEN REWRITE_TAC[sin] THEN MATCH_MP_TAC SUMMABLE_SUM THEN
130  MATCH_MP_TAC SER_COMPAR THEN
131  EXISTS_TAC ���\n. ^exp_ser n * (abs(x) pow n)��� THEN
132  REWRITE_TAC[MATCH_MP SUM_SUMMABLE (SPEC_ALL EXP_CONVERGES)] THEN
133  EXISTS_TAC ���0:num��� THEN X_GEN_TAC ���n:num��� THEN
134  DISCH_THEN(K ALL_TAC) THEN BETA_TAC THEN COND_CASES_TAC THEN
135  REWRITE_TAC[ABS_MUL, POW_ABS] THENL
136   [REWRITE_TAC[ABS_0, REAL_MUL_LZERO] THEN MATCH_MP_TAC REAL_LE_MUL THEN
137    REWRITE_TAC[ABS_POS],
138    REWRITE_TAC[real_div, ABS_MUL, POW_M1, REAL_MUL_LID] THEN
139    MATCH_MP_TAC REAL_LE_RMUL_IMP THEN REWRITE_TAC[ABS_POS] THEN
140    MATCH_MP_TAC REAL_EQ_IMP_LE THEN REWRITE_TAC[ABS_REFL]] THEN
141  MAP_EVERY MATCH_MP_TAC [REAL_LT_IMP_LE, REAL_INV_POS] THEN
142  REWRITE_TAC[REAL_LT, FACT_LESS]);
143
144val COS_CONVERGES = store_thm("COS_CONVERGES",
145  ���!x. (\n. (^cos_ser) n * (x pow n)) sums cos(x)���,
146  GEN_TAC THEN REWRITE_TAC[cos] THEN MATCH_MP_TAC SUMMABLE_SUM THEN
147  MATCH_MP_TAC SER_COMPAR THEN
148  EXISTS_TAC ���\n. (^exp_ser) n * (abs(x) pow n)��� THEN
149  REWRITE_TAC[MATCH_MP SUM_SUMMABLE (SPEC_ALL EXP_CONVERGES)] THEN
150  EXISTS_TAC ���0:num��� THEN X_GEN_TAC ���n:num��� THEN
151  DISCH_THEN(K ALL_TAC) THEN BETA_TAC THEN COND_CASES_TAC THEN
152  REWRITE_TAC[ABS_MUL, POW_ABS] THENL
153   [REWRITE_TAC[real_div, ABS_MUL, POW_M1, REAL_MUL_LID] THEN
154    MATCH_MP_TAC REAL_LE_RMUL_IMP THEN REWRITE_TAC[ABS_POS] THEN
155    MATCH_MP_TAC REAL_EQ_IMP_LE THEN REWRITE_TAC[ABS_REFL],
156    REWRITE_TAC[ABS_0, REAL_MUL_LZERO] THEN MATCH_MP_TAC REAL_LE_MUL THEN
157    REWRITE_TAC[ABS_POS]] THEN
158  MAP_EVERY MATCH_MP_TAC [REAL_LT_IMP_LE, REAL_INV_POS] THEN
159  REWRITE_TAC[REAL_LT, FACT_LESS]);
160
161(*---------------------------------------------------------------------------*)
162(* Show what the formal derivatives of these series are                      *)
163(*---------------------------------------------------------------------------*)
164
165val EXP_FDIFF = store_thm("EXP_FDIFF",
166  ���diffs ^exp_ser = ^exp_ser���,
167  REWRITE_TAC[diffs] THEN BETA_TAC THEN
168  CONV_TAC(X_FUN_EQ_CONV ���n:num���) THEN GEN_TAC THEN BETA_TAC THEN
169  REWRITE_TAC[FACT, GSYM REAL_MUL] THEN
170  SUBGOAL_THEN ���~(&(SUC n) = &0) /\ ~(&(FACT n) = &0)��� ASSUME_TAC THENL
171   [CONJ_TAC THEN CONV_TAC(RAND_CONV SYM_CONV) THEN
172    MATCH_MP_TAC REAL_LT_IMP_NE THEN
173    REWRITE_TAC[REAL_LT, LESS_0, FACT_LESS],
174    FIRST_ASSUM(fn th => REWRITE_TAC[MATCH_MP REAL_INV_MUL th]) THEN
175    GEN_REWR_TAC RAND_CONV  [GSYM REAL_MUL_LID] THEN
176    REWRITE_TAC[REAL_MUL_ASSOC, REAL_EQ_RMUL] THEN DISJ2_TAC THEN
177    MATCH_MP_TAC REAL_MUL_RINV THEN ASM_REWRITE_TAC[]]);
178
179val SIN_FDIFF = store_thm("SIN_FDIFF",
180  ���diffs ^sin_ser = ^cos_ser���,
181  REWRITE_TAC[diffs] THEN BETA_TAC THEN
182  CONV_TAC(X_FUN_EQ_CONV ���n:num���) THEN GEN_TAC THEN BETA_TAC THEN
183  COND_CASES_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[EVEN]) THEN
184  ASM_REWRITE_TAC[REAL_MUL_RZERO] THEN REWRITE_TAC[SUC_SUB1] THEN
185  ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
186  REWRITE_TAC[real_div, GSYM REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN
187  REWRITE_TAC[FACT, GSYM REAL_MUL] THEN
188  SUBGOAL_THEN ���~(&(SUC n) = &0) /\ ~(&(FACT n) = &0)��� ASSUME_TAC THENL
189   [CONJ_TAC THEN CONV_TAC(RAND_CONV SYM_CONV) THEN
190    MATCH_MP_TAC REAL_LT_IMP_NE THEN
191    REWRITE_TAC[REAL_LT, LESS_0, FACT_LESS],
192    FIRST_ASSUM(fn th => REWRITE_TAC[MATCH_MP REAL_INV_MUL th]) THEN
193    REWRITE_TAC[REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
194    GEN_REWR_TAC RAND_CONV  [GSYM REAL_MUL_LID] THEN
195    REWRITE_TAC[REAL_MUL_ASSOC, REAL_EQ_RMUL] THEN DISJ2_TAC THEN
196    MATCH_MP_TAC REAL_MUL_RINV THEN ASM_REWRITE_TAC[]]);
197
198val COS_FDIFF = store_thm("COS_FDIFF",
199  ���diffs ^cos_ser = (\n. ~((^sin_ser) n))���,
200  REWRITE_TAC[diffs] THEN BETA_TAC THEN
201  CONV_TAC(X_FUN_EQ_CONV ���n:num���) THEN GEN_TAC THEN BETA_TAC THEN
202  COND_CASES_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[EVEN]) THEN
203  ASM_REWRITE_TAC[REAL_MUL_RZERO, REAL_NEG_0] THEN
204  ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
205  REWRITE_TAC[real_div, REAL_NEG_LMUL] THEN
206  REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN BINOP_TAC THENL
207   [POP_ASSUM(SUBST1_TAC o MATCH_MP EVEN_DIV2) THEN
208    REWRITE_TAC[pow] THEN REWRITE_TAC[GSYM REAL_NEG_MINUS1],
209    REWRITE_TAC[FACT, GSYM REAL_MUL] THEN
210    SUBGOAL_THEN ���~(&(SUC n) = &0) /\ ~(&(FACT n) = &0)��� ASSUME_TAC THENL
211     [CONJ_TAC THEN CONV_TAC(RAND_CONV SYM_CONV) THEN
212      MATCH_MP_TAC REAL_LT_IMP_NE THEN
213      REWRITE_TAC[REAL_LT, LESS_0, FACT_LESS],
214      FIRST_ASSUM(fn th => REWRITE_TAC[MATCH_MP REAL_INV_MUL th]) THEN
215      REWRITE_TAC[REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
216      GEN_REWR_TAC RAND_CONV  [GSYM REAL_MUL_LID] THEN
217      REWRITE_TAC[REAL_MUL_ASSOC, REAL_EQ_RMUL] THEN DISJ2_TAC THEN
218      MATCH_MP_TAC REAL_MUL_RINV THEN ASM_REWRITE_TAC[]]]);
219
220(*---------------------------------------------------------------------------*)
221(* Now at last we can get the derivatives of exp, sin and cos                *)
222(*---------------------------------------------------------------------------*)
223
224val SIN_NEGLEMMA = store_thm("SIN_NEGLEMMA",
225  ���!x. ~(sin x) = suminf (\n. ~((^sin_ser) n * (x pow n)))���,
226  GEN_TAC THEN MATCH_MP_TAC SUM_UNIQ THEN
227  MP_TAC(MATCH_MP SER_NEG (SPEC ���x:real��� SIN_CONVERGES)) THEN
228  BETA_TAC THEN DISCH_THEN ACCEPT_TAC);
229
230val DIFF_EXP = store_thm("DIFF_EXP",
231  ���!x. (exp diffl exp(x))(x)���,
232  GEN_TAC THEN REWRITE_TAC[HALF_MK_ABS exp] THEN
233  GEN_REWR_TAC (LAND_CONV o ONCE_DEPTH_CONV)  [GSYM EXP_FDIFF] THEN
234  CONV_TAC(LAND_CONV BETA_CONV) THEN
235  MATCH_MP_TAC TERMDIFF THEN EXISTS_TAC ���abs(x) + &1��� THEN
236  REWRITE_TAC[EXP_FDIFF, MATCH_MP SUM_SUMMABLE (SPEC_ALL EXP_CONVERGES)] THEN
237  MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC ���abs(x) + &1��� THEN
238  REWRITE_TAC[ABS_LE, REAL_LT_ADDR] THEN
239  REWRITE_TAC[REAL_LT, ONE, LESS_0]);
240
241val DIFF_SIN = store_thm("DIFF_SIN",
242  ���!x. (sin diffl cos(x))(x)���,
243  GEN_TAC THEN REWRITE_TAC[HALF_MK_ABS sin, cos] THEN
244  ONCE_REWRITE_TAC[GSYM SIN_FDIFF] THEN
245  MATCH_MP_TAC TERMDIFF THEN EXISTS_TAC ���abs(x) + &1��� THEN
246  REPEAT CONJ_TAC THENL
247   [REWRITE_TAC[MATCH_MP SUM_SUMMABLE (SPEC_ALL SIN_CONVERGES)],
248    REWRITE_TAC[SIN_FDIFF, MATCH_MP SUM_SUMMABLE (SPEC_ALL COS_CONVERGES)],
249    REWRITE_TAC[SIN_FDIFF, COS_FDIFF] THEN BETA_TAC THEN
250    MP_TAC(SPEC ���abs(x) + &1��� SIN_CONVERGES) THEN
251    DISCH_THEN(MP_TAC o MATCH_MP SER_NEG) THEN
252    DISCH_THEN(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN BETA_TAC THEN
253    REWRITE_TAC[GSYM REAL_NEG_LMUL],
254    MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC ���abs(x) + &1��� THEN
255    REWRITE_TAC[ABS_LE, REAL_LT_ADDR] THEN
256    REWRITE_TAC[REAL_LT, ONE, LESS_0]]);
257
258val DIFF_COS = store_thm("DIFF_COS",
259  ���!x. (cos diffl ~(sin(x)))(x)���,
260  GEN_TAC THEN REWRITE_TAC[HALF_MK_ABS cos, SIN_NEGLEMMA] THEN
261  ONCE_REWRITE_TAC[REAL_NEG_LMUL] THEN
262  REWRITE_TAC[GSYM(CONV_RULE(RAND_CONV BETA_CONV)
263    (AP_THM COS_FDIFF ���n:num���))] THEN
264  MATCH_MP_TAC TERMDIFF THEN EXISTS_TAC ���abs(x) + &1��� THEN
265  REPEAT CONJ_TAC THENL
266   [REWRITE_TAC[MATCH_MP SUM_SUMMABLE (SPEC_ALL COS_CONVERGES)],
267    REWRITE_TAC[COS_FDIFF] THEN
268    MP_TAC(SPEC ���abs(x) + &1��� SIN_CONVERGES) THEN
269    DISCH_THEN(MP_TAC o MATCH_MP SER_NEG) THEN
270    DISCH_THEN(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN BETA_TAC THEN
271    REWRITE_TAC[GSYM REAL_NEG_LMUL],
272    REWRITE_TAC[COS_FDIFF, DIFFS_NEG] THEN
273    MP_TAC SIN_FDIFF THEN BETA_TAC THEN
274    DISCH_THEN(fn th => REWRITE_TAC[th]) THEN
275    MP_TAC(SPEC ���abs(x) + &1��� COS_CONVERGES) THEN
276    DISCH_THEN(MP_TAC o MATCH_MP SER_NEG) THEN
277    DISCH_THEN(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN BETA_TAC THEN
278    REWRITE_TAC[GSYM REAL_NEG_LMUL],
279    MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC ���abs(x) + &1��� THEN
280    REWRITE_TAC[ABS_LE, REAL_LT_ADDR] THEN
281    REWRITE_TAC[REAL_LT, ONE, LESS_0]]);
282
283val _ = basic_diffs := !basic_diffs@[DIFF_EXP, DIFF_SIN, DIFF_COS];
284
285
286(* ------------------------------------------------------------------------- *)
287(* Processed versions of composition theorems.                               *)
288(* ------------------------------------------------------------------------- *)
289
290val DIFF_COMPOSITE = store_thm("DIFF_COMPOSITE",
291 Term
292  `((f diffl l)(x) /\ ~(f(x) = &0) ==>
293        ((\x. inv(f x)) diffl ~(l / (f(x) pow 2)))(x)) /\
294   ((f diffl l)(x) /\ (g diffl m)(x) /\ ~(g(x) = &0) ==>
295    ((\x. f(x) / g(x)) diffl (((l * g(x)) - (m * f(x)))
296                               / (g(x) pow 2)))(x)) /\
297   ((f diffl l)(x) /\ (g diffl m)(x) ==>
298                   ((\x. f(x) + g(x)) diffl (l + m))(x)) /\
299   ((f diffl l)(x) /\ (g diffl m)(x) ==>
300                   ((\x. f(x) * g(x)) diffl ((l * g(x)) + (m * f(x))))(x)) /\
301   ((f diffl l)(x) /\ (g diffl m)(x) ==>
302                   ((\x. f(x) - g(x)) diffl (l - m))(x)) /\
303   ((f diffl l)(x) ==> ((\x. ~(f x)) diffl ~l)(x)) /\
304   ((g diffl m)(x) ==>
305         ((\x. (g x) pow n) diffl ((&n * (g x) pow (n - 1)) * m))(x)) /\
306   ((g diffl m)(x) ==> ((\x. exp(g x)) diffl (exp(g x) * m))(x)) /\
307   ((g diffl m)(x) ==> ((\x. sin(g x)) diffl (cos(g x) * m))(x)) /\
308   ((g diffl m)(x) ==> ((\x. cos(g x)) diffl (~(sin(g x)) * m))(x))`,
309  REWRITE_TAC[DIFF_INV, DIFF_DIV, DIFF_ADD, DIFF_SUB, DIFF_MUL, DIFF_NEG] THEN
310  REPEAT CONJ_TAC THEN DISCH_TAC THEN
311  TRY(MATCH_MP_TAC DIFF_CHAIN THEN
312  ASM_REWRITE_TAC[DIFF_SIN, DIFF_COS, DIFF_EXP]) THEN
313  MATCH_MP_TAC(BETA_RULE (SPEC (Term`\x. x pow n`) DIFF_CHAIN)) THEN
314  ASM_REWRITE_TAC[DIFF_POW]);
315
316val _ = basic_diffs := !basic_diffs @ CONJUNCTS DIFF_COMPOSITE;
317
318
319(*---------------------------------------------------------------------------*)
320(* Properties of the exponential function                                    *)
321(*---------------------------------------------------------------------------*)
322
323val EXP_0 = store_thm("EXP_0",
324  ���exp(&0) = &1���,
325  REWRITE_TAC[exp] THEN CONV_TAC SYM_CONV THEN
326  MATCH_MP_TAC SUM_UNIQ THEN BETA_TAC THEN
327  W(MP_TAC o C SPEC SER_0 o rand o rator o snd) THEN
328  DISCH_THEN(MP_TAC o SPEC ���1:num���) THEN
329  REWRITE_TAC[ONE, sum] THEN
330  REWRITE_TAC[ADD_CLAUSES, REAL_ADD_LID] THEN BETA_TAC THEN
331  REWRITE_TAC[FACT, pow, REAL_MUL_RID, REAL_INV1] THEN
332  REWRITE_TAC[SYM(ONE)] THEN DISCH_THEN MATCH_MP_TAC THEN
333  X_GEN_TAC ���n:num��� THEN REWRITE_TAC[ONE, GSYM LESS_EQ] THEN
334  DISCH_THEN(CHOOSE_THEN SUBST1_TAC o MATCH_MP LESS_ADD_1) THEN
335  REWRITE_TAC[GSYM ADD1, POW_0, REAL_MUL_RZERO, ADD_CLAUSES]);
336
337val EXP_LE_X = store_thm("EXP_LE_X",
338���!x. &0 <= x ==> (&1 + x) <= exp(x)���,
339GEN_TAC THEN DISCH_THEN(DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT]) THENL
340 [MP_TAC(SPECL [Term`\n. ^exp_ser n * (x pow n)`,Term`2:num`] SER_POS_LE) THEN
341    REWRITE_TAC[MATCH_MP SUM_SUMMABLE (SPEC_ALL EXP_CONVERGES)] THEN
342    REWRITE_TAC[GSYM exp] THEN BETA_TAC THEN
343    W(C SUBGOAL_THEN (fn t => REWRITE_TAC[t]) o
344    funpow 2 (fst o dest_imp) o snd) THENL
345     [GEN_TAC THEN DISCH_THEN(K ALL_TAC) THEN
346      MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL
347       [MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC REAL_INV_POS THEN
348        REWRITE_TAC[REAL_LT, FACT_LESS],
349        MATCH_MP_TAC POW_POS THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN
350        FIRST_ASSUM ACCEPT_TAC],
351      CONV_TAC(TOP_DEPTH_CONV num_CONV) THEN REWRITE_TAC[sum] THEN
352      BETA_TAC THEN REWRITE_TAC[ADD_CLAUSES, FACT, pow, REAL_ADD_LID] THEN
353      (* new term nets require change in proof; old:
354        REWRITE_TAC[MULT_CLAUSES, REAL_INV1, REAL_MUL_LID, ADD_CLAUSES] THEN
355        REWRITE_TAC[REAL_MUL_RID, SYM(ONE)]
356       *)
357      REWRITE_TAC[MULT_RIGHT_1, CONJUNCT1 MULT,REAL_INV1,
358      REAL_MUL_LID, ADD_CLAUSES,REAL_MUL_RID, SYM(ONE)]],
359    POP_ASSUM(SUBST1_TAC o SYM) THEN
360    REWRITE_TAC[EXP_0, REAL_ADD_RID, REAL_LE_REFL]]);
361
362val EXP_LT_1 = store_thm("EXP_LT_1",
363  ���!x. &0 < x ==> &1 < exp(x)���,
364  GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN
365  EXISTS_TAC ���&1 + x��� THEN ASM_REWRITE_TAC[REAL_LT_ADDR] THEN
366  MATCH_MP_TAC EXP_LE_X THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN
367  POP_ASSUM ACCEPT_TAC);
368
369val EXP_ADD_MUL = store_thm("EXP_ADD_MUL",
370  ���!x y. exp(x + y) * exp(~x) = exp(y)���,
371  REPEAT GEN_TAC THEN
372  CONV_TAC(LAND_CONV(X_BETA_CONV ���x:real���)) THEN
373  SUBGOAL_THEN ���exp(y) = (\x. exp(x + y) * exp(~x))(&0)��� SUBST1_TAC THENL
374   [BETA_TAC THEN REWRITE_TAC[REAL_ADD_LID, REAL_NEG_0] THEN
375    REWRITE_TAC[EXP_0, REAL_MUL_RID],
376    MATCH_MP_TAC DIFF_ISCONST_ALL THEN X_GEN_TAC ���x:real��� THEN
377    W(MP_TAC o DIFF_CONV o rand o funpow 2 rator o snd) THEN
378    DISCH_THEN(MP_TAC o SPEC ���x:real���) THEN
379    MATCH_MP_TAC(TAUT_CONV ���(a = b) ==> a ==> b���) THEN AP_THM_TAC THEN
380    AP_TERM_TAC THEN REWRITE_TAC[GSYM REAL_NEG_LMUL, GSYM REAL_NEG_RMUL] THEN
381    REWRITE_TAC[GSYM real_sub, REAL_SUB_0, REAL_MUL_RID, REAL_ADD_RID] THEN
382    MATCH_ACCEPT_TAC REAL_MUL_SYM]);
383
384val EXP_NEG_MUL = store_thm("EXP_NEG_MUL",
385  ���!x. exp(x) * exp(~x) = &1���,
386  GEN_TAC THEN MP_TAC(SPECL [���x:real���, ���&0���] EXP_ADD_MUL) THEN
387  REWRITE_TAC[REAL_ADD_RID, EXP_0]);
388
389val EXP_NEG_MUL2 = store_thm("EXP_NEG_MUL2",
390  ���!x. exp(~x) * exp(x) = &1���,
391  ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_ACCEPT_TAC EXP_NEG_MUL);
392
393val EXP_NEG = store_thm("EXP_NEG",
394  ���!x. exp(~x) = inv(exp(x))���,
395  GEN_TAC THEN MATCH_MP_TAC REAL_RINV_UNIQ THEN
396  MATCH_ACCEPT_TAC EXP_NEG_MUL);
397
398val EXP_ADD = store_thm("EXP_ADD",
399  ���!x y. exp(x + y) = exp(x) * exp(y)���,
400  REPEAT GEN_TAC THEN
401  MP_TAC(SPECL [���x:real���, ���y:real���] EXP_ADD_MUL) THEN
402  DISCH_THEN(MP_TAC o C AP_THM ���exp(x)��� o AP_TERM ���$*���) THEN
403  REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN
404  REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] EXP_NEG_MUL, REAL_MUL_RID] THEN
405  DISCH_THEN SUBST1_TAC THEN MATCH_ACCEPT_TAC REAL_MUL_SYM);
406
407val EXP_POS_LE = store_thm("EXP_POS_LE",
408  ���!x. &0 <= exp(x)���,
409  GEN_TAC THEN
410  GEN_REWR_TAC (funpow 2 RAND_CONV)  [GSYM REAL_HALF_DOUBLE] THEN
411  REWRITE_TAC[EXP_ADD] THEN MATCH_ACCEPT_TAC REAL_LE_SQUARE);
412
413val EXP_NZ = store_thm("EXP_NZ",
414  ���!x. ~(exp(x) = &0)���,
415  GEN_TAC THEN DISCH_TAC THEN
416  MP_TAC(SPEC ���x:real��� EXP_NEG_MUL) THEN
417  ASM_REWRITE_TAC[REAL_MUL_LZERO] THEN
418  CONV_TAC(RAND_CONV SYM_CONV) THEN
419  MATCH_ACCEPT_TAC REAL_10);
420
421val EXP_POS_LT = store_thm("EXP_POS_LT",
422  ���!x. &0 < exp(x)���,
423  GEN_TAC THEN REWRITE_TAC[REAL_LT_LE] THEN
424  CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN
425  REWRITE_TAC[EXP_POS_LE, EXP_NZ]);
426
427val EXP_N = store_thm("EXP_N",
428  ���!n x. exp(&n * x) = exp(x) pow n���,
429  INDUCT_TAC THEN REWRITE_TAC[REAL_MUL_LZERO, EXP_0, pow] THEN
430  REWRITE_TAC[ADD1] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN
431  REWRITE_TAC[GSYM REAL_ADD, EXP_ADD, REAL_RDISTRIB] THEN
432  GEN_TAC THEN ASM_REWRITE_TAC[REAL_MUL_LID]);
433
434val EXP_SUB = store_thm("EXP_SUB",
435  ���!x y. exp(x - y) = exp(x) / exp(y)���,
436  REPEAT GEN_TAC THEN
437  REWRITE_TAC[real_sub, real_div, EXP_ADD, EXP_NEG]);
438
439val EXP_MONO_IMP = store_thm("EXP_MONO_IMP",
440  ���!x y. x < y ==> exp(x) < exp(y)���,
441  REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o
442    MATCH_MP EXP_LT_1 o ONCE_REWRITE_RULE[GSYM REAL_SUB_LT]) THEN
443  REWRITE_TAC[EXP_SUB] THEN
444  SUBGOAL_THEN ���&1 < exp(y) / exp(x) =
445                 (&1 * exp(x)) < ((exp(y) / exp(x)) * exp(x))��� SUBST1_TAC THENL
446   [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_LT_RMUL THEN
447    MATCH_ACCEPT_TAC EXP_POS_LT,
448    REWRITE_TAC[real_div, GSYM REAL_MUL_ASSOC, EXP_NEG_MUL2, GSYM EXP_NEG] THEN
449    REWRITE_TAC[REAL_MUL_LID, REAL_MUL_RID]]);
450
451val EXP_MONO_LT = store_thm("EXP_MONO_LT",
452  ���!x y. exp(x) < exp(y) = x < y���,
453  REPEAT GEN_TAC THEN EQ_TAC THENL
454   [CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[REAL_NOT_LT] THEN
455    REWRITE_TAC[REAL_LE_LT] THEN
456    DISCH_THEN(DISJ_CASES_THEN2 ASSUME_TAC SUBST1_TAC) THEN
457    REWRITE_TAC[] THEN DISJ1_TAC THEN MATCH_MP_TAC EXP_MONO_IMP THEN
458    POP_ASSUM ACCEPT_TAC,
459    MATCH_ACCEPT_TAC EXP_MONO_IMP]);
460
461val EXP_MONO_LE = store_thm("EXP_MONO_LE",
462  ���!x y. exp(x) <= exp(y) = x <= y���,
463  REPEAT GEN_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN
464  REWRITE_TAC[EXP_MONO_LT]);
465
466val EXP_INJ = store_thm("EXP_INJ",
467  ���!x y. (exp(x) = exp(y)) = (x = y)���,
468  REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN
469  REWRITE_TAC[EXP_MONO_LE]);
470
471val EXP_TOTAL_LEMMA = store_thm("EXP_TOTAL_LEMMA",
472  ���!y. &1 <= y ==> ?x. &0 <= x /\ x <= y - &1 /\ (exp(x) = y)���,
473  GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC IVT THEN
474  ASM_REWRITE_TAC[EXP_0, REAL_LE_SUB_LADD, REAL_ADD_LID] THEN CONJ_TAC THENL
475   [RULE_ASSUM_TAC(ONCE_REWRITE_RULE[GSYM REAL_SUB_LE]) THEN
476    POP_ASSUM(MP_TAC o MATCH_MP EXP_LE_X) THEN REWRITE_TAC[REAL_SUB_ADD2],
477    X_GEN_TAC ���x:real��� THEN DISCH_THEN(K ALL_TAC) THEN
478    MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC ���exp(x)��� THEN
479    MATCH_ACCEPT_TAC DIFF_EXP]);
480
481val EXP_TOTAL = store_thm("EXP_TOTAL",
482  ���!y. &0 < y ==> ?x. exp(x) = y���,
483  GEN_TAC THEN DISCH_TAC THEN
484  DISJ_CASES_TAC(SPECL [���&1���, ���y:real���] REAL_LET_TOTAL) THENL
485   [FIRST_ASSUM(X_CHOOSE_TAC ���x:real��� o MATCH_MP EXP_TOTAL_LEMMA) THEN
486    EXISTS_TAC ���x:real��� THEN ASM_REWRITE_TAC[],
487    MP_TAC(SPEC ���y:real��� REAL_INV_LT1) THEN ASM_REWRITE_TAC[] THEN
488    DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_IMP_LE) THEN
489    DISCH_THEN(X_CHOOSE_TAC ���x:real��� o MATCH_MP EXP_TOTAL_LEMMA) THEN
490    EXISTS_TAC ���~x��� THEN ASM_REWRITE_TAC[EXP_NEG] THEN
491    MATCH_MP_TAC REAL_INVINV THEN CONV_TAC(RAND_CONV SYM_CONV) THEN
492    MATCH_MP_TAC REAL_LT_IMP_NE THEN ASM_REWRITE_TAC[]]);
493
494(* new
495let REAL_EXP_BOUND_LEMMA = prove
496 (`!x. &0 <= x /\ x <= inv(&2) ==> exp(x) <= &1 + &2 * x`,
497  GEN_TAC THEN DISCH_TAC THEN
498  MATCH_MP_TAC REAL_LE_TRANS THEN
499  EXISTS_TAC `suminf (\n. x pow n)` THEN CONJ_TAC THENL
500   [REWRITE_TAC[exp; BETA_THM] THEN MATCH_MP_TAC SER_LE THEN
501    REWRITE_TAC[summable; BETA_THM] THEN REPEAT CONJ_TAC THENL
502     [GEN_TAC THEN
503      GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN
504      MATCH_MP_TAC REAL_LE_RMUL_IMP THEN CONJ_TAC THENL
505       [MATCH_MP_TAC REAL_POW_LE THEN ASM_REWRITE_TAC[];
506        MATCH_MP_TAC REAL_INV_LE_1 THEN
507        REWRITE_TAC[REAL_OF_NUM_LE; num_CONV `1`; LE_SUC_LT] THEN
508        REWRITE_TAC[FACT_LT]];
509      EXISTS_TAC `exp x` THEN REWRITE_TAC[BETA_RULE REAL_EXP_CONVERGES];
510      EXISTS_TAC `inv(&1 - x)` THEN MATCH_MP_TAC GP THEN
511      ASM_REWRITE_TAC[real_abs] THEN
512      MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&2)` THEN
513      ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV];
514    SUBGOAL_THEN `suminf (\n. x pow n) = inv (&1 - x)` SUBST1_TAC THENL
515     [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_UNIQ THEN
516      MATCH_MP_TAC GP THEN
517      ASM_REWRITE_TAC[real_abs] THEN
518      MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&2)` THEN
519      ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV;
520      MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN
521      EXISTS_TAC `&1 - x` THEN
522      SUBGOAL_THEN `(&1 - x) * inv (&1 - x) = &1` SUBST1_TAC THENL
523       [MATCH_MP_TAC REAL_MUL_RINV THEN
524        REWRITE_TAC[REAL_ARITH `(&1 - x = &0) = (x = &1)`] THEN
525        DISCH_THEN SUBST_ALL_TAC THEN
526        POP_ASSUM MP_TAC THEN CONV_TAC REAL_RAT_REDUCE_CONV;
527        CONJ_TAC THENL
528         [MATCH_MP_TAC REAL_LET_TRANS THEN
529          EXISTS_TAC `inv(&2) - x` THEN
530          ASM_REWRITE_TAC[REAL_ARITH `&0 <= x - y = y <= x`] THEN
531          ASM_REWRITE_TAC[REAL_ARITH `a - x < b - x = a < b`] THEN
532          CONV_TAC REAL_RAT_REDUCE_CONV;
533          REWRITE_TAC[REAL_ADD_LDISTRIB; REAL_SUB_RDISTRIB] THEN
534          REWRITE_TAC[REAL_MUL_RID; REAL_MUL_LID] THEN
535          REWRITE_TAC[REAL_ARITH `&1 <= (&1 + &2 * x) - (x + x * &2 * x) =
536                                  x * (&2 * x) <= x * &1`] THEN
537          MATCH_MP_TAC REAL_LE_LMUL_IMP THEN ASM_REWRITE_TAC[] THEN
538          MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `inv(&2)` THEN
539          REWRITE_TAC[REAL_MUL_ASSOC] THEN
540          CONV_TAC REAL_RAT_REDUCE_CONV THEN
541          ASM_REWRITE_TAC[REAL_MUL_LID; real_div]]]]]);;
542end new*)
543
544(*---------------------------------------------------------------------------*)
545(* Properties of the logarithmic function                                    *)
546(*---------------------------------------------------------------------------*)
547
548val ln = new_definition("ln",
549  ���ln x = @u. exp(u) = x���);
550
551val LN_EXP = store_thm("LN_EXP",
552  ���!x. ln(exp x) = x���,
553  GEN_TAC THEN REWRITE_TAC[ln, EXP_INJ] THEN
554  CONV_TAC SYM_CONV THEN CONV_TAC(RAND_CONV(ONCE_DEPTH_CONV SYM_CONV)) THEN
555  CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN MATCH_MP_TAC SELECT_AX THEN
556  EXISTS_TAC ���x:real��� THEN REFL_TAC);
557
558val EXP_LN = store_thm("EXP_LN",
559  ���!x. (exp(ln x) = x) = &0 < x���,
560  GEN_TAC THEN EQ_TAC THENL
561   [DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_ACCEPT_TAC EXP_POS_LT,
562    DISCH_THEN(X_CHOOSE_THEN ���y:real��� MP_TAC o MATCH_MP EXP_TOTAL) THEN
563    DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[EXP_INJ, LN_EXP]]);
564
565val LN_MUL = store_thm("LN_MUL",
566  ���!x y. &0 < x /\ &0 < y ==> (ln(x * y) = ln(x) + ln(y))���,
567  REPEAT GEN_TAC THEN STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM EXP_INJ] THEN
568  REWRITE_TAC[EXP_ADD] THEN SUBGOAL_THEN ���&0 < x * y��� ASSUME_TAC THENL
569   [MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[],
570    EVERY_ASSUM(fn th => REWRITE_TAC[ONCE_REWRITE_RULE[GSYM EXP_LN] th])]);
571
572val LN_INJ = store_thm("LN_INJ",
573  ���!x y. &0 < x /\ &0 < y ==> ((ln(x) = ln(y)) = (x = y))���,
574  REPEAT GEN_TAC THEN STRIP_TAC THEN
575  EVERY_ASSUM(fn th => GEN_REWR_TAC (RAND_CONV o ONCE_DEPTH_CONV)
576    [SYM(REWRITE_RULE[GSYM EXP_LN] th)]) THEN
577  CONV_TAC SYM_CONV THEN MATCH_ACCEPT_TAC EXP_INJ);
578
579val LN_1 = store_thm("LN_1",
580  ���ln(&1) = &0���,
581  ONCE_REWRITE_TAC[GSYM EXP_INJ] THEN
582  REWRITE_TAC[EXP_0, EXP_LN, REAL_LT_01]);
583
584val LN_INV = store_thm("LN_INV",
585  ���!x. &0 < x ==> (ln(inv x) = ~(ln x))���,
586  GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[GSYM REAL_RNEG_UNIQ] THEN
587  SUBGOAL_THEN ���&0 < x /\ &0 < inv(x)��� MP_TAC THENL
588   [CONJ_TAC THEN TRY(MATCH_MP_TAC REAL_INV_POS) THEN ASM_REWRITE_TAC[],
589    DISCH_THEN(fn th => REWRITE_TAC[GSYM(MATCH_MP LN_MUL th)]) THEN
590    SUBGOAL_THEN ���x * (inv x) = &1��� SUBST1_TAC THENL
591     [MATCH_MP_TAC REAL_MUL_RINV THEN
592      POP_ASSUM(ACCEPT_TAC o MATCH_MP REAL_POS_NZ),
593      REWRITE_TAC[LN_1]]]);
594
595val LN_DIV = store_thm("LN_DIV",
596  ���!x y. &0 < x /\ &0 < y ==> (ln(x / y) = ln(x) - ln(y))���,
597  REPEAT GEN_TAC THEN STRIP_TAC THEN
598  SUBGOAL_THEN ���&0 < x /\ &0 < inv(y)��� MP_TAC THENL
599   [CONJ_TAC THEN TRY(MATCH_MP_TAC REAL_INV_POS) THEN ASM_REWRITE_TAC[],
600    REWRITE_TAC[real_div] THEN
601    DISCH_THEN(fn th => REWRITE_TAC[MATCH_MP LN_MUL th]) THEN
602    REWRITE_TAC[MATCH_MP LN_INV (ASSUME ���&0 < y���)] THEN
603    REWRITE_TAC[real_sub]]);
604
605val LN_MONO_LT = store_thm("LN_MONO_LT",
606  ���!x y. &0 < x /\ &0 < y ==> (ln(x) < ln(y) = x < y)���,
607  REPEAT GEN_TAC THEN STRIP_TAC THEN
608  EVERY_ASSUM(fn th => GEN_REWR_TAC (RAND_CONV o ONCE_DEPTH_CONV)
609    [SYM(REWRITE_RULE[GSYM EXP_LN] th)]) THEN
610  CONV_TAC SYM_CONV THEN MATCH_ACCEPT_TAC EXP_MONO_LT);
611
612val LN_MONO_LE = store_thm("LN_MONO_LE",
613  ���!x y. &0 < x /\ &0 < y ==> (ln(x) <= ln(y) = x <= y)���,
614  REPEAT GEN_TAC THEN STRIP_TAC THEN
615  EVERY_ASSUM(fn th => GEN_REWR_TAC (RAND_CONV o ONCE_DEPTH_CONV)
616    [SYM(REWRITE_RULE[GSYM EXP_LN] th)]) THEN
617  CONV_TAC SYM_CONV THEN MATCH_ACCEPT_TAC EXP_MONO_LE);
618
619val LN_POW = store_thm("LN_POW",
620  ���!n x. &0 < x ==> (ln(x pow n) = &n * ln(x))���,
621  REPEAT GEN_TAC THEN
622  DISCH_THEN(CHOOSE_THEN (SUBST1_TAC o SYM) o MATCH_MP EXP_TOTAL) THEN
623  REWRITE_TAC[GSYM EXP_N, LN_EXP]);
624
625
626val LN_LE = store_thm("LN_LE",
627  Term `!x. &0 <= x ==> ln(&1 + x) <= x`,
628  GEN_TAC THEN DISCH_TAC THEN
629  GEN_REWRITE_TAC RAND_CONV  [] [GSYM LN_EXP] THEN
630  MP_TAC(SPECL [Term`&1 + x`, Term`exp x`] LN_MONO_LE) THEN
631  W(C SUBGOAL_THEN (fn t => REWRITE_TAC[t]) o funpow 2 (fst o dest_imp) o snd)
632  THENL
633   [REWRITE_TAC[EXP_POS_LT] THEN MATCH_MP_TAC REAL_LET_TRANS THEN
634    EXISTS_TAC (Term`x:real`) THEN ASM_REWRITE_TAC[REAL_LT_ADDL, REAL_LT_01],
635    DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC EXP_LE_X THEN ASM_REWRITE_TAC[]]);;
636
637
638val LN_LT_X = store_thm("LN_LT_X",
639  ���!x. &0 < x ==> ln(x) < x���,
640  GEN_TAC THEN DISCH_TAC THEN
641  GEN_REWR_TAC I  [TAUT_CONV ���a:bool = ~~a���] THEN
642  PURE_REWRITE_TAC[REAL_NOT_LT] THEN DISCH_TAC THEN
643  MP_TAC(SPEC ���ln(x)��� EXP_LE_X) THEN
644  SUBGOAL_THEN ���&0 <= ln(x)��� ASSUME_TAC THENL
645   [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC ���x:real��� THEN
646    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_IMP_LE, ALL_TAC] THEN
647  ASM_REWRITE_TAC[] THEN MP_TAC(SPEC ���x:real��� EXP_LN) THEN
648  ASM_REWRITE_TAC[] THEN
649  DISCH_THEN SUBST1_TAC THEN DISCH_TAC THEN
650  SUBGOAL_THEN ���(&1 + ln(x)) <= ln(x)��� MP_TAC THENL
651   [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC ���x:real���, ALL_TAC] THEN
652  ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_NOT_LE] THEN
653  MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC ���&0 + ln(x)��� THEN
654  REWRITE_TAC[REAL_LT_RADD, REAL_LT_01] THEN
655  REWRITE_TAC[REAL_ADD_LID, REAL_LE_REFL]);
656
657val LN_POS = store_thm("LN_POS",
658  Term `!x. &1 <= x ==> &0 <= ln(x)`,
659  GEN_TAC THEN DISCH_TAC THEN SUBGOAL_THEN (Term `&0 < x`) ASSUME_TAC THENL
660   [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC (Term`&1`) THEN
661    ASM_REWRITE_TAC[REAL_LT_01],
662    UNDISCH_TAC (Term`&1 <= x`) THEN SUBST1_TAC(SYM EXP_0) THEN
663    POP_ASSUM(MP_TAC o REWRITE_RULE[GSYM EXP_LN]) THEN
664    DISCH_THEN(fn th => GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [] [SYM th])
665    THEN REWRITE_TAC[EXP_MONO_LE]]);;
666
667
668val DIFF_LN = store_thm("DIFF_LN",
669  Term `!x. &0 < x ==> (ln diffl (inv x))(x)`,
670  GEN_TAC THEN DISCH_TAC THEN
671  FIRST_ASSUM(ASSUME_TAC o REWRITE_RULE[GSYM EXP_LN]) THEN
672  FIRST_ASSUM (fn th =>  GEN_REWRITE_TAC RAND_CONV [] [GSYM th]) THEN
673  MATCH_MP_TAC DIFF_INVERSE_LT THEN
674  FIRST_ASSUM(ASSUME_TAC o MATCH_MP REAL_POS_NZ) THEN
675  ASM_REWRITE_TAC[MATCH_MP DIFF_CONT (SPEC_ALL DIFF_EXP)] THEN
676  MP_TAC(SPEC (Term`ln(x)`) DIFF_EXP) THEN ASM_REWRITE_TAC[] THEN
677  DISCH_TAC THEN ASM_REWRITE_TAC[LN_EXP] THEN
678  EXISTS_TAC (Term`&1`) THEN MATCH_ACCEPT_TAC REAL_LT_01);;
679
680
681(*---------------------------------------------------------------------------*)
682(* Some properties of roots (easier via logarithms)                          *)
683(*---------------------------------------------------------------------------*)
684
685val root = new_definition("root",
686  ���root(n) x = @u. (&0 < x ==> &0 < u) /\ (u pow n = x)���);
687
688val sqrt = new_definition("sqrt",
689  ���sqrt(x) = root(2) x���);
690
691val ROOT_LT_LEMMA = store_thm("ROOT_LT_LEMMA",
692  ���!n x. &0 < x ==> (exp(ln(x) / &(SUC n)) pow (SUC n) = x)���,
693  REPEAT GEN_TAC THEN DISCH_TAC THEN
694  REWRITE_TAC[GSYM EXP_N] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
695  REWRITE_TAC[real_div, GSYM REAL_MUL_ASSOC] THEN
696  SUBGOAL_THEN ���inv(&(SUC n)) * &(SUC n) = &1��� SUBST1_TAC THENL
697   [MATCH_MP_TAC REAL_MUL_LINV THEN REWRITE_TAC[REAL_INJ, NOT_SUC],
698    ASM_REWRITE_TAC[REAL_MUL_RID, EXP_LN]]);
699
700val ROOT_LN = store_thm("ROOT_LN",
701  ���!n x. &0 < x ==> (root(SUC n) x = exp(ln(x) / &(SUC n)))���,
702  REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[root] THEN
703  MATCH_MP_TAC SELECT_UNIQUE THEN X_GEN_TAC ���y:real��� THEN BETA_TAC THEN
704  ASM_REWRITE_TAC[] THEN EQ_TAC THENL
705   [DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC o SYM)) THEN
706    SUBGOAL_THEN ���!z. &0 < y /\ &0 < exp(z)��� MP_TAC THENL
707     [ASM_REWRITE_TAC[EXP_POS_LT], ALL_TAC] THEN
708    DISCH_THEN(MP_TAC o GEN_ALL o SYM o MATCH_MP LN_INJ o SPEC_ALL) THEN
709    DISCH_THEN(fn th => GEN_REWR_TAC I  [th]) THEN
710    REWRITE_TAC[LN_EXP] THEN
711    SUBGOAL_THEN ���ln(y) * &(SUC n) = (ln(y pow(SUC n)) / &(SUC n)) * &(SUC n)���
712    MP_TAC THENL
713     [REWRITE_TAC[real_div, GSYM REAL_MUL_ASSOC] THEN
714      SUBGOAL_THEN ���inv(&(SUC n)) * &(SUC n) = &1��� SUBST1_TAC THENL
715       [MATCH_MP_TAC REAL_MUL_LINV THEN REWRITE_TAC[REAL_INJ, NOT_SUC],
716        REWRITE_TAC[REAL_MUL_RID] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
717        CONV_TAC SYM_CONV THEN MATCH_MP_TAC LN_POW THEN
718        ASM_REWRITE_TAC[]],
719      REWRITE_TAC[REAL_EQ_RMUL, REAL_INJ, NOT_SUC]],
720    DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[EXP_POS_LT] THEN
721    MATCH_MP_TAC ROOT_LT_LEMMA THEN ASM_REWRITE_TAC[]]);
722
723val ROOT_0 = store_thm("ROOT_0",
724  ���!n. root(SUC n) (&0) = &0���,
725  GEN_TAC THEN REWRITE_TAC[root] THEN
726  MATCH_MP_TAC SELECT_UNIQUE THEN X_GEN_TAC ���y:real��� THEN
727  BETA_TAC THEN REWRITE_TAC[REAL_LT_REFL] THEN EQ_TAC THENL
728   [SPEC_TAC(���n:num���,���n:num���) THEN INDUCT_TAC THEN ONCE_REWRITE_TAC[pow] THENL
729     [REWRITE_TAC[pow, REAL_MUL_RID],
730      REWRITE_TAC[REAL_ENTIRE] THEN DISCH_THEN DISJ_CASES_TAC THEN
731      ASM_REWRITE_TAC[] THEN FIRST_ASSUM MATCH_MP_TAC THEN
732      ASM_REWRITE_TAC[]],
733    DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[pow, REAL_MUL_LZERO]]);
734
735val ROOT_1 = store_thm("ROOT_1",
736  ���!n. root(SUC n) (&1) = &1���,
737  GEN_TAC THEN REWRITE_TAC[MATCH_MP ROOT_LN REAL_LT_01] THEN
738  REWRITE_TAC[LN_1, REAL_DIV_LZERO, EXP_0]);
739
740val ROOT_POS_LT = store_thm("ROOT_POS_LT",
741  ���!n x. &0 < x ==> &0 < root(SUC n) x���,
742  REPEAT GEN_TAC THEN
743  DISCH_THEN(fn th => REWRITE_TAC[MATCH_MP ROOT_LN th]) THEN
744  REWRITE_TAC[EXP_POS_LT]);
745
746val ROOT_POW_POS = store_thm("ROOT_POW_POS",
747  ���!n x. &0 <= x ==> ((root(SUC n) x) pow (SUC n) = x)���,
748  REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LE_LT] THEN
749  DISCH_THEN DISJ_CASES_TAC THENL
750   [FIRST_ASSUM(fn th => REWRITE_TAC
751     [MATCH_MP ROOT_LN th, MATCH_MP ROOT_LT_LEMMA th]),
752    FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[ROOT_0] THEN
753    MATCH_ACCEPT_TAC POW_0]);
754
755val POW_ROOT_POS = store_thm("POW_ROOT_POS",
756  ���!n x. &0 <= x ==> (root(SUC n)(x pow (SUC n)) = x)���,
757  REPEAT GEN_TAC THEN DISCH_TAC THEN
758  REWRITE_TAC[root] THEN MATCH_MP_TAC SELECT_UNIQUE THEN
759  X_GEN_TAC ���y:real��� THEN BETA_TAC THEN EQ_TAC THEN
760  DISCH_TAC THEN ASM_REWRITE_TAC[] THENL
761   [DISJ_CASES_THEN MP_TAC (REWRITE_RULE[REAL_LE_LT] (ASSUME ���&0 <= x���)) THENL
762     [DISCH_TAC THEN FIRST_ASSUM(UNDISCH_TAC o assert is_conj o concl) THEN
763      FIRST_ASSUM(fn th => REWRITE_TAC[MATCH_MP POW_POS_LT th]) THEN
764      DISCH_TAC THEN MATCH_MP_TAC POW_EQ THEN EXISTS_TAC ���n:num��� THEN
765      ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN
766      ASM_REWRITE_TAC[],
767      DISCH_THEN(SUBST_ALL_TAC o SYM) THEN
768      FIRST_ASSUM(UNDISCH_TAC o assert is_conj o concl) THEN
769      REWRITE_TAC[POW_0, REAL_LT_REFL, POW_ZERO]],
770    ASM_REWRITE_TAC[REAL_LT_LE] THEN CONV_TAC CONTRAPOS_CONV THEN
771    REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
772    REWRITE_TAC[POW_0]]);
773
774
775(* Known in GTT as ROOT_POS_POSITIVE *)
776val ROOT_POS = store_thm("ROOT_POS",
777  ���!n x. &0 <= x ==> &0 <= root(SUC n) x���,
778  REPEAT GEN_TAC THEN
779  DISCH_THEN(DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT]) THENL
780   [MAP_EVERY MATCH_MP_TAC [REAL_LT_IMP_LE, ROOT_POS_LT] THEN
781    POP_ASSUM ACCEPT_TAC,
782    POP_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[ROOT_0, REAL_LE_REFL]]);
783
784val ROOT_POS_UNIQ = store_thm("ROOT_POS_UNIQ",
785 Term`!n x y. &0 <= x /\ &0 <= y /\ (y pow (SUC n) = x)
786           ==> (root (SUC n) x = y)`,
787  REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
788  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (SUBST1_TAC o SYM)) THEN
789  REWRITE_TAC[POW_ROOT_POS]);;
790
791val ROOT_MUL = store_thm("ROOT_MUL",
792 Term`!n x y. &0 <= x /\ &0 <= y
793           ==> (root(SUC n) (x * y) = root(SUC n) x * root(SUC n) y)`,
794  REPEAT STRIP_TAC THEN MATCH_MP_TAC ROOT_POS_UNIQ THEN
795  REWRITE_TAC [POW_MUL] THEN REPEAT CONJ_TAC THENL
796  [MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[],
797   MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THEN MATCH_MP_TAC ROOT_POS
798   THEN ASM_REWRITE_TAC[],
799   IMP_RES_TAC ROOT_POW_POS THEN ASM_REWRITE_TAC[]]);
800
801
802val ROOT_INV = store_thm("ROOT_INV",
803 Term`!n x. &0 <= x ==> (root(SUC n) (inv x) = inv(root(SUC n) x))`,
804REPEAT STRIP_TAC THEN MATCH_MP_TAC ROOT_POS_UNIQ THEN REPEAT CONJ_TAC THENL
805 [IMP_RES_THEN ACCEPT_TAC REAL_LE_INV,
806  MATCH_MP_TAC REAL_LE_INV THEN IMP_RES_THEN (TRY o MATCH_ACCEPT_TAC) ROOT_POS,
807  IMP_RES_TAC ROOT_POW_POS THEN MP_TAC (SPEC_ALL ROOT_POS)
808   THEN ASM_REWRITE_TAC [] THEN REWRITE_TAC [REAL_LE_LT]
809    THEN STRIP_TAC THENL
810    [IMP_RES_TAC REAL_POS_NZ THEN IMP_RES_THEN (fn th =>
811       REWRITE_TAC [GSYM th]) POW_INV THEN ASM_REWRITE_TAC[],
812     POP_ASSUM (ASSUME_TAC o SYM) THEN ASM_REWRITE_TAC[] THEN
813     PAT_X_ASSUM (Term `$! M`) (SUBST1_TAC o SYM o SPEC_ALL)
814      THEN ASM_REWRITE_TAC[REAL_INV_0,POW_0]]])
815
816val ROOT_DIV = store_thm("ROOT_DIV",
817 Term`!n x y. &0 <= x /\ &0 <= y
818           ==> (root(SUC n) (x / y) = root(SUC n) x / root(SUC n) y)`,
819REWRITE_TAC [real_div] THEN REPEAT STRIP_TAC THEN IMP_RES_TAC REAL_LE_INV
820 THEN MP_TAC (SPECL [Term`n:num`, Term`x:real`, Term`inv y`] ROOT_MUL)
821 THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[]
822 THEN IMP_RES_TAC (SPECL [Term`n:num`, Term`y:real`] ROOT_INV)
823 THEN ASM_REWRITE_TAC[]);
824
825
826val ROOT_MONO_LE = store_thm("ROOT_MONO_LE",
827 Term`!x y. &0 <= x /\ x <= y ==> root(SUC n) x <= root(SUC n) y`,
828  REPEAT STRIP_TAC THEN SUBGOAL_THEN (Term`&0 <= y`) ASSUME_TAC THENL
829   [ASM_MESON_TAC[REAL_LE_TRANS], ALL_TAC] THEN
830  UNDISCH_TAC (Term`x <= y`) THEN CONV_TAC CONTRAPOS_CONV THEN
831  REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC THEN
832  SUBGOAL_THEN (Term `(x = (root(SUC n) x) pow (SUC n)) /\
833                      (y = (root(SUC n) y) pow (SUC n))`)
834   (CONJUNCTS_THEN SUBST1_TAC)
835  THENL [IMP_RES_TAC (GSYM ROOT_POW_POS) THEN ASM_MESON_TAC[], ALL_TAC] THEN
836  MATCH_MP_TAC REAL_POW_LT2 THEN
837  ASM_REWRITE_TAC[NOT_SUC] THEN MATCH_MP_TAC ROOT_POS THEN ASM_REWRITE_TAC[]);
838
839val SQRT_0 = store_thm("SQRT_0",
840  ���sqrt(&0) = &0���,
841  REWRITE_TAC[sqrt, TWO, ROOT_0]);
842
843val SQRT_1 = store_thm("SQRT_1",
844  ���sqrt(&1) = &1���,
845  REWRITE_TAC[sqrt, TWO, ROOT_1]);
846
847val SQRT_POS_LT = store_thm("SQRT_POS_LT",
848 Term`!x. &0 < x ==> &0 < sqrt(x)`,
849 REWRITE_TAC [sqrt,TWO] THEN REPEAT STRIP_TAC
850  THEN IMP_RES_TAC ROOT_LN THEN ASM_REWRITE_TAC[EXP_POS_LT]);
851
852val SQRT_POS_LE = store_thm("SQRT_POS_LE",
853 Term`!x. &0 <= x ==> &0 <= sqrt(x)`,
854  REWRITE_TAC[REAL_LE_LT] THEN MESON_TAC[SQRT_POS_LT, SQRT_0]);;
855
856val SQRT_POW2 = store_thm("SQRT_POW2",
857  ���!x. (sqrt(x) pow 2 = x) = &0 <= x���,
858  GEN_TAC THEN EQ_TAC THENL
859   [DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_ACCEPT_TAC REAL_LE_POW2,
860    REWRITE_TAC[sqrt, TWO, ROOT_POW_POS]]);
861
862val SQRT_POW_2 = store_thm("SQRT_POW_2",
863 Term `!x. &0 <= x ==> (sqrt(x) pow 2 = x)`,
864  REWRITE_TAC[SQRT_POW2]);;
865
866val POW_2_SQRT = store_thm("POW_2_SQRT",
867 Term`&0 <= x ==> (sqrt(x pow 2) = x)`,
868 REWRITE_TAC [sqrt,TWO,POW_ROOT_POS]);
869
870val SQRT_POS_UNIQ = store_thm("SQRT_POS_UNIQ",
871 Term`!x y. &0 <= x /\ &0 <= y /\ (y pow 2 = x)
872           ==> (sqrt x = y)`,
873  REWRITE_TAC[sqrt, TWO, ROOT_POS_UNIQ]);
874
875val SQRT_MUL = store_thm("SQRT_MUL",
876 Term`!x y. &0 <= x /\ &0 <= y
877           ==> (sqrt(x * y) = sqrt x * sqrt y)`,
878  REWRITE_TAC[sqrt, TWO, ROOT_MUL]);;
879
880val SQRT_INV = store_thm("SQRT_INV",
881 Term`!x. &0 <= x ==> (sqrt (inv x) = inv(sqrt x))`,
882  REWRITE_TAC[sqrt, TWO, ROOT_INV]);;
883
884val SQRT_DIV = store_thm("SQRT_DIV",
885 Term`!x y. &0 <= x /\ &0 <= y
886           ==> (sqrt (x / y) = sqrt x / sqrt y)`,
887  REWRITE_TAC[sqrt, TWO, ROOT_DIV]);;
888
889val SQRT_MONO_LE = store_thm("SQRT_MONO_LE",
890 Term`!x y. &0 <= x /\ x <= y ==> sqrt(x) <= sqrt(y)`,
891  REWRITE_TAC[sqrt, TWO, ROOT_MONO_LE]);;
892
893val lem = prove(Term`0<2:num`, REWRITE_TAC[TWO,LESS_0]);
894
895val EVEN_MOD = prove
896 (Term `!n. EVEN(n) = (n MOD 2 = 0)`,
897  GEN_TAC THEN REWRITE_TAC[EVEN_EXISTS] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN
898  EQ_TAC THEN STRIP_TAC THENL
899  [ASM_REWRITE_TAC [MP (SPEC (Term`2:num`) MOD_EQ_0) lem],
900   EXISTS_TAC (Term `n DIV 2`) THEN
901     MP_TAC (CONJUNCT1 (SPEC (Term `n:num`) (MATCH_MP DIVISION lem))) THEN
902     ASM_REWRITE_TAC [ADD_CLAUSES]]);
903
904val SQRT_EVEN_POW2 = store_thm("SQRT_EVEN_POW2",
905 Term`!n. EVEN n ==> (sqrt(&2 pow n) = &2 pow (n DIV 2))`,
906 GEN_TAC THEN REWRITE_TAC[EVEN_MOD] THEN DISCH_TAC THEN
907  MATCH_MP_TAC SQRT_POS_UNIQ THEN REPEAT CONJ_TAC THENL
908  [MATCH_MP_TAC POW_POS THEN REWRITE_TAC [REAL_POS],
909   MATCH_MP_TAC POW_POS THEN REWRITE_TAC [REAL_POS],
910   REWRITE_TAC [REAL_POW_POW] THEN AP_TERM_TAC THEN
911   MP_TAC (CONJUNCT1 (SPEC (Term `n:num`) (MATCH_MP DIVISION lem)))
912   THEN ASM_REWRITE_TAC [ADD_CLAUSES] THEN DISCH_THEN (SUBST1_TAC o SYM)
913   THEN REFL_TAC]);
914
915
916val REAL_DIV_SQRT = store_thm("REAL_DIV_SQRT",
917 Term`!x. &0 <= x ==> (x / sqrt(x) = sqrt(x))`,
918 GEN_TAC THEN ASM_CASES_TAC (Term`x = &0`) THENL
919   [ASM_REWRITE_TAC[SQRT_0, real_div, REAL_MUL_LZERO], ALL_TAC] THEN
920  DISCH_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SQRT_POS_UNIQ THEN
921  ASM_REWRITE_TAC[] THEN IMP_RES_TAC SQRT_POS_LE THEN
922  MP_TAC (SPECL[Term`x:real`, Term`sqrt x`] REAL_LE_DIV) THEN ASM_REWRITE_TAC[]
923  THEN DISCH_THEN (fn th => CONJ_TAC THENL [ACCEPT_TAC th, ALL_TAC]) THEN
924  REWRITE_TAC[real_div, POW_MUL] THEN PAT_X_ASSUM (Term`_ <= sqrt _`) MP_TAC
925  THEN REWRITE_TAC [REAL_LE_LT] THEN STRIP_TAC THENL
926  [IMP_RES_TAC REAL_POS_NZ THEN IMP_RES_THEN (fn th =>
927    REWRITE_TAC [GSYM th]) POW_INV THEN IMP_RES_THEN (fn th =>
928    REWRITE_TAC [th]) SQRT_POW_2 THEN REWRITE_TAC[POW_2, GSYM REAL_MUL_ASSOC]
929    THEN IMP_RES_THEN (fn th => REWRITE_TAC [th]) REAL_MUL_RINV THEN
930    REWRITE_TAC [REAL_MUL_RID],
931   PAT_X_ASSUM (Term `& 0 <= x`) MP_TAC THEN
932   REWRITE_TAC [REAL_LE_LT] THEN STRIP_TAC THENL
933   [IMP_RES_TAC SQRT_POS_LT THEN
934     PAT_X_ASSUM (Term `& 0 = _`) (SUBST_ALL_TAC o SYM) THEN
935     IMP_RES_TAC REAL_LT_REFL,
936   PAT_X_ASSUM (Term `& 0 = _`) (SUBST_ALL_TAC o SYM)
937   THEN REWRITE_TAC [POW_0, TWO, REAL_MUL_LZERO]]]);
938
939val SQRT_EQ = store_thm("SQRT_EQ",
940  ���!x y. (x pow 2 = y) /\ (&0 <= x) ==> (x = (sqrt(y)))���,
941  REPEAT GEN_TAC THEN STRIP_TAC THEN
942  SUBGOAL_THEN ���&0 <= y��� ASSUME_TAC THENL
943   [FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[POW_2, REAL_LE_SQUARE],
944    ALL_TAC] THEN
945  MP_TAC(SPECL [���1:num���, ���y:real���] ROOT_POW_POS) THEN
946  ASM_REWRITE_TAC[GSYM(TWO), GSYM sqrt] THEN
947  FIRST_ASSUM(fn th => GEN_REWR_TAC (LAND_CONV o RAND_CONV)  [SYM th]) THEN
948  GEN_REWR_TAC LAND_CONV  [GSYM REAL_SUB_0] THEN
949  REWRITE_TAC[POW_2, GSYM REAL_DIFFSQ, REAL_ENTIRE] THEN
950  REWRITE_TAC[REAL_SUB_0] THEN
951  DISCH_THEN DISJ_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
952  SUBGOAL_THEN ���&0 <= sqrt(y)��� ASSUME_TAC THENL
953   [REWRITE_TAC[sqrt, TWO] THEN MATCH_MP_TAC ROOT_POS THEN
954    ASM_REWRITE_TAC[], ALL_TAC] THEN
955  SUBGOAL_THEN ���x = &0��� SUBST_ALL_TAC THENL
956   [ASM_REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN
957    GEN_REWR_TAC I  [TAUT_CONV ���a:bool = ~~a���] THEN
958    PURE_REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC THEN
959    UNDISCH_TAC ���sqrt(y) + x = &0��� THEN REWRITE_TAC[] THEN
960    MATCH_MP_TAC REAL_POS_NZ THEN
961    MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC ���sqrt(y)��� THEN
962    ASM_REWRITE_TAC[REAL_LT_ADDR],
963    UNDISCH_TAC ���&0 pow 2 = y��� THEN REWRITE_TAC[POW_0, TWO] THEN
964    DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[SQRT_0]]);
965
966(*---------------------------------------------------------------------------*)
967(* Basic properties of the trig functions                                    *)
968(*---------------------------------------------------------------------------*)
969
970val SIN_0 = store_thm("SIN_0",
971  ���sin(&0) = &0���,
972  REWRITE_TAC[sin] THEN CONV_TAC SYM_CONV THEN
973  MATCH_MP_TAC SUM_UNIQ THEN BETA_TAC THEN
974  W(MP_TAC o C SPEC SER_0 o rand o rator o snd) THEN
975  DISCH_THEN(MP_TAC o SPEC ���0:num���) THEN REWRITE_TAC[ZERO_LESS_EQ] THEN
976  BETA_TAC THEN
977  REWRITE_TAC[sum] THEN DISCH_THEN MATCH_MP_TAC THEN
978  X_GEN_TAC ���n:num��� THEN COND_CASES_TAC THEN
979  ASM_REWRITE_TAC[REAL_MUL_LZERO] THEN
980  MP_TAC(SPEC ���n:num��� ODD_EXISTS) THEN ASM_REWRITE_TAC[ODD_EVEN] THEN
981  DISCH_THEN(CHOOSE_THEN SUBST1_TAC) THEN
982  REWRITE_TAC[GSYM ADD1, POW_0, REAL_MUL_RZERO]);
983
984val COS_0 = store_thm("COS_0",
985  ���cos(&0) = &1���,
986  REWRITE_TAC[cos] THEN CONV_TAC SYM_CONV THEN
987  MATCH_MP_TAC SUM_UNIQ THEN BETA_TAC THEN
988  W(MP_TAC o C SPEC SER_0 o rand o rator o snd) THEN
989  DISCH_THEN(MP_TAC o SPEC ���1:num���) THEN
990  REWRITE_TAC[ONE, sum, ADD_CLAUSES] THEN BETA_TAC THEN
991  REWRITE_TAC[EVEN, pow, FACT] THEN
992  REWRITE_TAC[REAL_ADD_LID, REAL_MUL_RID] THEN
993  SUBGOAL_THEN ���0 DIV 2 = 0��� SUBST1_TAC THENL
994   [MATCH_MP_TAC DIV_UNIQUE THEN EXISTS_TAC ���0:num��� THEN
995    REWRITE_TAC[MULT_CLAUSES, ADD_CLAUSES] THEN
996    REWRITE_TAC[TWO, LESS_0],
997    REWRITE_TAC[pow]] THEN
998  SUBGOAL_THEN ���&1 / &1 = &(SUC 0)��� SUBST1_TAC THENL
999   [REWRITE_TAC[SYM(ONE)] THEN MATCH_MP_TAC REAL_DIV_REFL THEN
1000    MATCH_ACCEPT_TAC REAL_10,
1001    DISCH_THEN MATCH_MP_TAC] THEN
1002  X_GEN_TAC ���n:num��� THEN REWRITE_TAC[GSYM LESS_EQ] THEN
1003  DISCH_THEN(CHOOSE_THEN SUBST1_TAC o MATCH_MP LESS_ADD_1) THEN
1004  REWRITE_TAC[GSYM ADD1, POW_0, REAL_MUL_RZERO, ADD_CLAUSES]);
1005
1006val SIN_CIRCLE = store_thm("SIN_CIRCLE",
1007  ���!x. (sin(x) pow 2) + (cos(x) pow 2) = &1���,
1008  GEN_TAC THEN CONV_TAC(LAND_CONV(X_BETA_CONV ���x:real���)) THEN
1009  SUBGOAL_THEN ���&1 = (\x.(sin(x) pow 2) + (cos(x) pow 2))(&0)��� SUBST1_TAC THENL
1010   [BETA_TAC THEN REWRITE_TAC[SIN_0, COS_0] THEN
1011    REWRITE_TAC[TWO, POW_0] THEN
1012    REWRITE_TAC[pow, POW_1] THEN REWRITE_TAC[REAL_ADD_LID, REAL_MUL_LID],
1013    MATCH_MP_TAC DIFF_ISCONST_ALL THEN X_GEN_TAC ���x:real��� THEN
1014    W(MP_TAC o DIFF_CONV o rand o funpow 2 rator o snd) THEN
1015    DISCH_THEN(MP_TAC o SPEC ���x:real���) THEN
1016    MATCH_MP_TAC(TAUT_CONV ���(a = b) ==> a ==> b���) THEN AP_THM_TAC THEN
1017    AP_TERM_TAC THEN REWRITE_TAC[GSYM REAL_NEG_LMUL, GSYM REAL_NEG_RMUL] THEN
1018    REWRITE_TAC[GSYM real_sub, REAL_SUB_0] THEN
1019    REWRITE_TAC[GSYM REAL_MUL_ASSOC, REAL_MUL_RID] THEN
1020    AP_TERM_TAC THEN REWRITE_TAC[TWO, SUC_SUB1] THEN
1021    REWRITE_TAC[POW_1] THEN MATCH_ACCEPT_TAC REAL_MUL_SYM]);
1022
1023val SIN_BOUND = store_thm("SIN_BOUND",
1024  ���!x. abs(sin x) <= &1���,
1025  GEN_TAC THEN GEN_REWR_TAC I  [TAUT_CONV ���a:bool = ~~a���] THEN
1026  PURE_ONCE_REWRITE_TAC[REAL_NOT_LE] THEN
1027  DISCH_THEN(MP_TAC o MATCH_MP REAL_LT1_POW2) THEN
1028  REWRITE_TAC[REAL_POW2_ABS] THEN
1029  DISCH_THEN(MP_TAC o ONCE_REWRITE_RULE[GSYM REAL_SUB_LT]) THEN
1030  DISCH_THEN(MP_TAC o C CONJ(SPEC ���cos(x)��� REAL_LE_SQUARE)) THEN
1031  REWRITE_TAC[GSYM POW_2] THEN
1032  DISCH_THEN(MP_TAC o MATCH_MP REAL_LTE_ADD) THEN
1033  REWRITE_TAC[real_sub, GSYM REAL_ADD_ASSOC] THEN
1034  ONCE_REWRITE_TAC[AC(REAL_ADD_ASSOC,REAL_ADD_SYM)
1035    ���a + (b + c) = (a + c) + b���] THEN
1036  REWRITE_TAC[SIN_CIRCLE, REAL_ADD_RINV, REAL_LT_REFL]);
1037
1038val SIN_BOUNDS = store_thm("SIN_BOUNDS",
1039  ���!x. ~(&1) <= sin(x) /\ sin(x) <= &1���,
1040  GEN_TAC THEN REWRITE_TAC[GSYM ABS_BOUNDS, SIN_BOUND]);
1041
1042val COS_BOUND = store_thm("COS_BOUND",
1043  ���!x. abs(cos x) <= &1���,
1044  GEN_TAC THEN GEN_REWR_TAC I  [TAUT_CONV ���a:bool = ~~a���] THEN
1045  PURE_ONCE_REWRITE_TAC[REAL_NOT_LE] THEN
1046  DISCH_THEN(MP_TAC o MATCH_MP REAL_LT1_POW2) THEN
1047  REWRITE_TAC[REAL_POW2_ABS] THEN
1048  DISCH_THEN(MP_TAC o ONCE_REWRITE_RULE[GSYM REAL_SUB_LT]) THEN
1049  DISCH_THEN(MP_TAC o CONJ(SPEC ���sin(x)��� REAL_LE_SQUARE)) THEN
1050  REWRITE_TAC[GSYM POW_2] THEN
1051  DISCH_THEN(MP_TAC o MATCH_MP REAL_LET_ADD) THEN
1052  REWRITE_TAC[real_sub, REAL_ADD_ASSOC, SIN_CIRCLE,
1053    REAL_ADD_ASSOC, SIN_CIRCLE, REAL_ADD_RINV, REAL_LT_REFL]);
1054
1055val COS_BOUNDS = store_thm("COS_BOUNDS",
1056  ���!x. ~(&1) <= cos(x) /\ cos(x) <= &1���,
1057  GEN_TAC THEN REWRITE_TAC[GSYM ABS_BOUNDS, COS_BOUND]);
1058
1059val SIN_COS_ADD = store_thm("SIN_COS_ADD",
1060  ���!x y. ((sin(x + y) - ((sin(x) * cos(y)) + (cos(x) * sin(y)))) pow 2) +
1061         ((cos(x + y) - ((cos(x) * cos(y)) - (sin(x) * sin(y)))) pow 2) = &0���,
1062  REPEAT GEN_TAC THEN
1063  CONV_TAC(LAND_CONV(X_BETA_CONV ���x:real���)) THEN
1064  W(C SUBGOAL_THEN (SUBST1_TAC o SYM) o subst[(���&0���,���x:real���)] o snd) THENL
1065   [BETA_TAC THEN REWRITE_TAC[SIN_0, COS_0] THEN
1066    REWRITE_TAC[REAL_ADD_LID, REAL_MUL_LZERO, REAL_MUL_LID] THEN
1067    REWRITE_TAC[REAL_SUB_RZERO, REAL_SUB_REFL] THEN
1068    REWRITE_TAC[TWO, POW_0, REAL_ADD_LID],
1069    MATCH_MP_TAC DIFF_ISCONST_ALL THEN GEN_TAC THEN
1070    W(MP_TAC o DIFF_CONV o rand o funpow 2 rator o snd) THEN
1071    REDUCE_TAC THEN REWRITE_TAC[POW_1] THEN
1072    REWRITE_TAC[REAL_MUL_LZERO, REAL_ADD_RID, REAL_MUL_RID] THEN
1073    DISCH_THEN(MP_TAC o SPEC ���x:real���) THEN
1074    MATCH_MP_TAC(TAUT_CONV ���(a = b) ==> a ==> b���) THEN AP_THM_TAC THEN
1075    AP_TERM_TAC THEN REWRITE_TAC[GSYM REAL_NEG_LMUL] THEN
1076    ONCE_REWRITE_TAC[GSYM REAL_EQ_SUB_LADD] THEN
1077    REWRITE_TAC[REAL_SUB_LZERO, GSYM REAL_MUL_ASSOC] THEN
1078    REWRITE_TAC[REAL_NEG_RMUL] THEN AP_TERM_TAC THEN
1079    GEN_REWR_TAC RAND_CONV  [REAL_MUL_SYM] THEN BINOP_TAC THENL
1080     [REWRITE_TAC[real_sub, REAL_NEG_ADD, REAL_NEGNEG, REAL_NEG_RMUL],
1081      REWRITE_TAC[GSYM REAL_NEG_RMUL, GSYM real_sub]]]);
1082
1083val SIN_COS_NEG = store_thm("SIN_COS_NEG",
1084  ���!x. ((sin(~x) + (sin x)) pow 2) +
1085       ((cos(~x) - (cos x)) pow 2) = &0���,
1086  GEN_TAC THEN CONV_TAC(LAND_CONV(X_BETA_CONV ���x:real���)) THEN
1087  W(C SUBGOAL_THEN (SUBST1_TAC o SYM) o subst[(���&0���,���x:real���)] o snd) THENL
1088   [BETA_TAC THEN REWRITE_TAC[SIN_0, COS_0, REAL_NEG_0] THEN
1089    REWRITE_TAC[REAL_ADD_LID, REAL_SUB_REFL] THEN
1090    REWRITE_TAC[TWO, POW_0, REAL_ADD_LID],
1091    MATCH_MP_TAC DIFF_ISCONST_ALL THEN GEN_TAC THEN
1092    W(MP_TAC o DIFF_CONV o rand o funpow 2 rator o snd) THEN
1093    REDUCE_TAC THEN REWRITE_TAC[POW_1] THEN
1094    DISCH_THEN(MP_TAC o SPEC ���x:real���) THEN
1095    MATCH_MP_TAC(TAUT_CONV ���(a = b) ==> a ==> b���) THEN AP_THM_TAC THEN
1096    AP_TERM_TAC THEN REWRITE_TAC[GSYM REAL_NEG_RMUL] THEN
1097    REWRITE_TAC[REAL_MUL_RID, real_sub, REAL_NEGNEG, GSYM REAL_MUL_ASSOC] THEN
1098    ONCE_REWRITE_TAC[GSYM REAL_EQ_SUB_LADD] THEN
1099    REWRITE_TAC[REAL_SUB_LZERO, REAL_NEG_RMUL] THEN AP_TERM_TAC THEN
1100    GEN_REWR_TAC RAND_CONV  [REAL_MUL_SYM] THEN
1101    REWRITE_TAC[GSYM REAL_NEG_LMUL, REAL_NEG_RMUL] THEN AP_TERM_TAC THEN
1102    REWRITE_TAC[REAL_NEG_ADD, REAL_NEGNEG]]);
1103
1104val SIN_ADD = store_thm("SIN_ADD",
1105  ���!x y. sin(x + y) = (sin(x) * cos(y)) + (cos(x) * sin(y))���,
1106  REPEAT GEN_TAC THEN MP_TAC(SPECL [���x:real���, ���y:real���] SIN_COS_ADD) THEN
1107  REWRITE_TAC[POW_2, REAL_SUMSQ] THEN REWRITE_TAC[REAL_SUB_0] THEN
1108  DISCH_THEN(fn th => REWRITE_TAC[th]));
1109
1110val COS_ADD = store_thm("COS_ADD",
1111  ���!x y. cos(x + y) = (cos(x) * cos(y)) - (sin(x) * sin(y))���,
1112  REPEAT GEN_TAC THEN MP_TAC(SPECL [���x:real���, ���y:real���] SIN_COS_ADD) THEN
1113  REWRITE_TAC[POW_2, REAL_SUMSQ] THEN REWRITE_TAC[REAL_SUB_0] THEN
1114  DISCH_THEN(fn th => REWRITE_TAC[th]));
1115
1116val SIN_NEG = store_thm("SIN_NEG",
1117  ���!x. sin(~x) = ~(sin(x))���,
1118  GEN_TAC THEN MP_TAC(SPEC ���x:real��� SIN_COS_NEG) THEN
1119  REWRITE_TAC[POW_2, REAL_SUMSQ] THEN REWRITE_TAC[REAL_LNEG_UNIQ] THEN
1120  DISCH_THEN(fn th => REWRITE_TAC[th]));
1121
1122val COS_NEG = store_thm("COS_NEG",
1123  ���!x. cos(~x) = cos(x)���,
1124  GEN_TAC THEN MP_TAC(SPEC ���x:real��� SIN_COS_NEG) THEN
1125  REWRITE_TAC[POW_2, REAL_SUMSQ] THEN REWRITE_TAC[REAL_SUB_0] THEN
1126  DISCH_THEN(fn th => REWRITE_TAC[th]));
1127
1128val SIN_DOUBLE = store_thm("SIN_DOUBLE",
1129  ���!x. sin(&2 * x) = &2 * (sin(x) * cos(x))���,
1130  GEN_TAC THEN REWRITE_TAC[GSYM REAL_DOUBLE, SIN_ADD] THEN
1131  AP_TERM_TAC THEN MATCH_ACCEPT_TAC REAL_MUL_SYM);
1132
1133val COS_DOUBLE = store_thm("COS_DOUBLE",
1134  ���!x. cos(&2 * x) = (cos(x) pow 2) - (sin(x) pow 2)���,
1135  GEN_TAC THEN REWRITE_TAC[GSYM REAL_DOUBLE, COS_ADD, POW_2]);
1136
1137(*---------------------------------------------------------------------------*)
1138(* Show that there's a least positive x with cos(x) = 0; hence define pi     *)
1139(*---------------------------------------------------------------------------*)
1140
1141val SIN_PAIRED = store_thm("SIN_PAIRED",
1142  ���!x. (\n. (((~(&1)) pow n) / &(FACT((2 * n) + 1)))
1143         * (x pow ((2 * n) + 1))) sums (sin x)���,
1144  GEN_TAC THEN MP_TAC(SPEC ���x:real��� SIN_CONVERGES) THEN
1145  DISCH_THEN(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN
1146  DISCH_THEN(MP_TAC o MATCH_MP SER_PAIR) THEN REWRITE_TAC[GSYM sin] THEN
1147  BETA_TAC THEN REWRITE_TAC[SUM_2] THEN BETA_TAC THEN
1148  REWRITE_TAC[GSYM ADD1, EVEN_DOUBLE, REWRITE_RULE[ODD_EVEN] ODD_DOUBLE] THEN
1149  REWRITE_TAC[REAL_MUL_LZERO, REAL_ADD_LID, SUC_SUB1, MULT_DIV_2]);
1150
1151val SIN_POS = store_thm("SIN_POS",
1152  ���!x. &0 < x /\ x < &2 ==> &0 < sin(x)���,
1153  GEN_TAC THEN STRIP_TAC THEN MP_TAC(SPEC ���x:real��� SIN_PAIRED) THEN
1154  DISCH_THEN(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN
1155  DISCH_THEN(MP_TAC o MATCH_MP SER_PAIR) THEN
1156  REWRITE_TAC[SYM(MATCH_MP SUM_UNIQ (SPEC ���x:real��� SIN_PAIRED))] THEN
1157  REWRITE_TAC[SUM_2] THEN BETA_TAC THEN REWRITE_TAC[GSYM ADD1] THEN
1158  REWRITE_TAC[pow, GSYM REAL_NEG_MINUS1, POW_MINUS1] THEN
1159  REWRITE_TAC[real_div, GSYM REAL_NEG_LMUL, GSYM real_sub] THEN
1160  REWRITE_TAC[REAL_MUL_LID] THEN REWRITE_TAC[ADD1] THEN DISCH_TAC THEN
1161  FIRST_ASSUM(SUBST1_TAC o MATCH_MP SUM_UNIQ) THEN
1162  W(C SUBGOAL_THEN SUBST1_TAC o curry mk_eq ���&0��� o curry mk_comb ���sum(0,0)��� o
1163  funpow 2 rand o snd) THENL [REWRITE_TAC[sum], ALL_TAC] THEN
1164  MATCH_MP_TAC SER_POS_LT THEN
1165  FIRST_ASSUM(fn th => REWRITE_TAC[MATCH_MP SUM_SUMMABLE th]) THEN
1166  X_GEN_TAC ���n:num��� THEN DISCH_THEN(K ALL_TAC) THEN BETA_TAC THEN
1167  REWRITE_TAC[GSYM ADD1, MULT_CLAUSES] THEN
1168  REWRITE_TAC[TWO, ADD_CLAUSES, pow, FACT, GSYM REAL_MUL] THEN
1169  REWRITE_TAC[SYM(TWO)] THEN
1170  REWRITE_TAC[ONE, ADD_CLAUSES, pow, FACT, GSYM REAL_MUL] THEN
1171  REWRITE_TAC[REAL_SUB_LT] THEN ONCE_REWRITE_TAC[GSYM pow] THEN
1172  REWRITE_TAC[REAL_MUL_ASSOC] THEN
1173  MATCH_MP_TAC REAL_LT_RMUL_IMP THEN CONJ_TAC THENL
1174   [ALL_TAC, MATCH_MP_TAC POW_POS_LT THEN ASM_REWRITE_TAC[]] THEN
1175  REWRITE_TAC[GSYM REAL_MUL_ASSOC, GSYM POW_2] THEN
1176  SUBGOAL_THEN ���!n. &0 < &(SUC n)��� ASSUME_TAC THENL
1177   [GEN_TAC THEN REWRITE_TAC[REAL_LT, LESS_0], ALL_TAC] THEN
1178  SUBGOAL_THEN ���!n. &0 < &(FACT n)��� ASSUME_TAC THENL
1179   [GEN_TAC THEN REWRITE_TAC[REAL_LT, FACT_LESS], ALL_TAC] THEN
1180  SUBGOAL_THEN ���!n. ~(&(SUC n) = &0)��� ASSUME_TAC THENL
1181   [GEN_TAC THEN REWRITE_TAC[REAL_INJ, NOT_SUC], ALL_TAC] THEN
1182  SUBGOAL_THEN ���!n. ~(&(FACT n) = &0)��� ASSUME_TAC THENL
1183   [GEN_TAC THEN MATCH_MP_TAC REAL_POS_NZ THEN
1184    REWRITE_TAC[REAL_LT, FACT_LESS], ALL_TAC] THEN
1185  REPEAT(IMP_SUBST_TAC REAL_INV_MUL THEN ASM_REWRITE_TAC[REAL_ENTIRE]) THEN
1186  REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN
1187  ONCE_REWRITE_TAC[AC(REAL_MUL_ASSOC,REAL_MUL_SYM)
1188    ���a * (b * (c * (d * e))) =
1189        (a * (b * e)) * (c * d)���] THEN
1190  GEN_REWR_TAC RAND_CONV  [GSYM REAL_MUL_LID] THEN
1191  MATCH_MP_TAC REAL_LT_RMUL_IMP THEN CONJ_TAC THENL
1192   [ALL_TAC, MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC THEN
1193    MATCH_MP_TAC REAL_INV_POS THEN ASM_REWRITE_TAC[]] THEN
1194  REWRITE_TAC[REAL_MUL_ASSOC] THEN
1195  IMP_SUBST_TAC ((CONV_RULE(RAND_CONV SYM_CONV) o SPEC_ALL) REAL_INV_MUL) THEN
1196  ASM_REWRITE_TAC[REAL_ENTIRE] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
1197  REWRITE_TAC[GSYM real_div] THEN MATCH_MP_TAC REAL_LT_1 THEN
1198  REWRITE_TAC[POW_2] THEN CONJ_TAC THENL
1199   [MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC,
1200    MATCH_MP_TAC REAL_LT_MUL2 THEN REPEAT CONJ_TAC] THEN
1201  TRY(MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[] THEN NO_TAC) THENL
1202   [W(curry op THEN (MATCH_MP_TAC REAL_LT_TRANS) o EXISTS_TAC o
1203      curry mk_comb ���(&)��� o funpow 3 rand o snd) THEN
1204    REWRITE_TAC[REAL_LT, LESS_SUC_REFL], ALL_TAC] THEN
1205  MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC ���&2��� THEN
1206  ASM_REWRITE_TAC[] THEN CONV_TAC(REDEPTH_CONV num_CONV) THEN
1207  REWRITE_TAC[REAL_LE, LESS_EQ_MONO, ZERO_LESS_EQ]);
1208
1209val COS_PAIRED = store_thm("COS_PAIRED",
1210  ���!x. (\n. (((~(&1)) pow n) / &(FACT(2 * n)))
1211         * (x pow (2 * n))) sums (cos x)���,
1212  GEN_TAC THEN MP_TAC(SPEC ���x:real��� COS_CONVERGES) THEN
1213  DISCH_THEN(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN
1214  DISCH_THEN(MP_TAC o MATCH_MP SER_PAIR) THEN REWRITE_TAC[GSYM cos] THEN
1215  BETA_TAC THEN REWRITE_TAC[SUM_2] THEN BETA_TAC THEN
1216  REWRITE_TAC[GSYM ADD1, EVEN_DOUBLE, REWRITE_RULE[ODD_EVEN] ODD_DOUBLE] THEN
1217  REWRITE_TAC[REAL_MUL_LZERO, REAL_ADD_RID, MULT_DIV_2]);
1218
1219val COS_2 = store_thm("COS_2",
1220  ���cos(&2) < &0���,
1221  GEN_REWR_TAC LAND_CONV  [GSYM REAL_NEGNEG] THEN
1222  REWRITE_TAC[REAL_NEG_LT0] THEN MP_TAC(SPEC ���&2��� COS_PAIRED) THEN
1223  DISCH_THEN(MP_TAC o MATCH_MP SER_NEG) THEN BETA_TAC THEN
1224  DISCH_TAC THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP SUM_UNIQ) THEN
1225  MATCH_MP_TAC REAL_LT_TRANS THEN
1226  EXISTS_TAC ���sum(0,3) (\n. ~((((~(&1)) pow n) / &(FACT(2 * n)))
1227                * (&2 pow (2 * n))))��� THEN CONJ_TAC THENL
1228   [REWRITE_TAC[num_CONV ���3:num���, sum, SUM_2] THEN BETA_TAC THEN
1229    REWRITE_TAC[MULT_CLAUSES, ADD_CLAUSES, pow, FACT] THEN
1230    REWRITE_TAC[REAL_MUL_RID, POW_1, POW_2, GSYM REAL_NEG_RMUL] THEN
1231    IMP_SUBST_TAC REAL_DIV_REFL THEN REWRITE_TAC[REAL_NEGNEG, REAL_10] THEN
1232    REDUCE_TAC THEN
1233    REWRITE_TAC[num_CONV ���4:num���, num_CONV ���3:num���, FACT, pow] THEN
1234    REWRITE_TAC[SYM(num_CONV ���4:num���), SYM(num_CONV ���3:num���)] THEN
1235    REWRITE_TAC[TWO, ONE, FACT, pow] THEN
1236    REWRITE_TAC[SYM(ONE), SYM(TWO)] THEN
1237    REWRITE_TAC[REAL_MUL] THEN REDUCE_TAC THEN
1238    REWRITE_TAC[real_div, REAL_NEG_LMUL, REAL_NEGNEG, REAL_MUL_LID] THEN
1239    REWRITE_TAC[GSYM REAL_NEG_LMUL, REAL_ADD_ASSOC] THEN
1240    REWRITE_TAC[GSYM real_sub, REAL_SUB_LT] THEN
1241    SUBGOAL_THEN ���inv(&2) * &4 = &1 + &1��� SUBST1_TAC THENL
1242     [MATCH_MP_TAC REAL_EQ_LMUL_IMP THEN EXISTS_TAC ���&2��� THEN
1243      REWRITE_TAC[REAL_INJ] THEN REDUCE_TAC THEN
1244      REWRITE_TAC[REAL_ADD, REAL_MUL] THEN REDUCE_TAC THEN
1245      REWRITE_TAC[REAL_MUL_ASSOC] THEN
1246      SUBGOAL_THEN ���&2 * inv(&2) = &1��� SUBST1_TAC THEN
1247      REWRITE_TAC[REAL_MUL_LID] THEN MATCH_MP_TAC REAL_MUL_RINV THEN
1248      REWRITE_TAC[REAL_INJ] THEN REDUCE_TAC,
1249      REWRITE_TAC[REAL_MUL_LID, REAL_ADD_ASSOC] THEN
1250      REWRITE_TAC[REAL_ADD_LINV, REAL_ADD_LID] THEN
1251      ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN
1252      MATCH_MP_TAC REAL_LT_1 THEN REWRITE_TAC[REAL_LE, REAL_LT] THEN
1253      REDUCE_TAC], ALL_TAC] THEN
1254  MATCH_MP_TAC SER_POS_LT_PAIR THEN
1255  FIRST_ASSUM(fn th => REWRITE_TAC[MATCH_MP SUM_SUMMABLE th]) THEN
1256  X_GEN_TAC ���d:num��� THEN BETA_TAC THEN
1257  REWRITE_TAC[POW_ADD, POW_MINUS1, REAL_MUL_RID] THEN
1258  REWRITE_TAC[num_CONV ���3:num���, pow] THEN REWRITE_TAC[SYM(num_CONV ���3:num���)] THEN
1259  REWRITE_TAC[POW_2, POW_1] THEN
1260  REWRITE_TAC[GSYM REAL_NEG_MINUS1, REAL_NEGNEG] THEN
1261  REWRITE_TAC[real_div, GSYM REAL_NEG_LMUL, GSYM REAL_NEG_RMUL] THEN
1262  REWRITE_TAC[REAL_MUL_LID, REAL_NEGNEG] THEN
1263  REWRITE_TAC[GSYM real_sub, REAL_SUB_LT] THEN
1264  REWRITE_TAC[GSYM ADD1, ADD_CLAUSES, MULT_CLAUSES] THEN
1265  REWRITE_TAC[POW_ADD, REAL_MUL_ASSOC] THEN
1266  MATCH_MP_TAC REAL_LT_RMUL_IMP THEN CONJ_TAC THENL
1267   [ALL_TAC,
1268    REWRITE_TAC[TWO, MULT_CLAUSES] THEN
1269    REWRITE_TAC[num_CONV ���3:num���, ADD_CLAUSES] THEN
1270    MATCH_MP_TAC POW_POS_LT THEN REWRITE_TAC[REAL_LT] THEN
1271    REDUCE_TAC] THEN
1272  REWRITE_TAC[TWO, ADD_CLAUSES, FACT] THEN
1273  REWRITE_TAC[SYM(TWO)] THEN
1274  REWRITE_TAC[ONE, ADD_CLAUSES, FACT] THEN
1275  REWRITE_TAC[SYM(ONE)] THEN
1276  SUBGOAL_THEN ���!n. &0 < &(SUC n)��� ASSUME_TAC THENL
1277   [GEN_TAC THEN REWRITE_TAC[REAL_LT, LESS_0], ALL_TAC] THEN
1278  SUBGOAL_THEN ���!n. &0 < &(FACT n)��� ASSUME_TAC THENL
1279   [GEN_TAC THEN REWRITE_TAC[REAL_LT, FACT_LESS], ALL_TAC] THEN
1280  SUBGOAL_THEN ���!n. ~(&(SUC n) = &0)��� ASSUME_TAC THENL
1281   [GEN_TAC THEN REWRITE_TAC[REAL_INJ, NOT_SUC], ALL_TAC] THEN
1282  SUBGOAL_THEN ���!n. ~(&(FACT n) = &0)��� ASSUME_TAC THENL
1283   [GEN_TAC THEN MATCH_MP_TAC REAL_POS_NZ THEN
1284    REWRITE_TAC[REAL_LT, FACT_LESS], ALL_TAC] THEN
1285  REWRITE_TAC[GSYM REAL_MUL] THEN
1286  REPEAT(IMP_SUBST_TAC REAL_INV_MUL THEN ASM_REWRITE_TAC[REAL_ENTIRE]) THEN
1287  REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN
1288  ONCE_REWRITE_TAC[AC(REAL_MUL_ASSOC,REAL_MUL_SYM)
1289    ���a * (b * (c * d)) = (a * (b * d)) * c���] THEN
1290  GEN_REWR_TAC RAND_CONV  [GSYM REAL_MUL_LID] THEN
1291  MATCH_MP_TAC REAL_LT_RMUL_IMP THEN CONJ_TAC THENL
1292   [ALL_TAC,
1293    MATCH_MP_TAC REAL_INV_POS THEN REWRITE_TAC[REAL_LT, FACT_LESS]] THEN
1294  REWRITE_TAC[REAL_MUL_ASSOC] THEN
1295  IMP_SUBST_TAC ((CONV_RULE(RAND_CONV SYM_CONV) o SPEC_ALL) REAL_INV_MUL) THEN
1296  ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
1297  REWRITE_TAC[GSYM real_div] THEN MATCH_MP_TAC REAL_LT_1 THEN
1298  REWRITE_TAC[POW_2, REAL_MUL, REAL_LE, REAL_LT] THEN REDUCE_TAC THEN
1299  REWRITE_TAC[num_CONV ���4:num���, num_CONV ���3:num���,
1300              MULT_CLAUSES, ADD_CLAUSES] THEN
1301  REWRITE_TAC[LESS_MONO_EQ] THEN
1302  REWRITE_TAC[TWO, ADD_CLAUSES, MULT_CLAUSES] THEN
1303  REWRITE_TAC[ONE, LESS_MONO_EQ, LESS_0]);
1304
1305val COS_ISZERO = store_thm("COS_ISZERO",
1306  ���?!x. &0 <= x /\ x <= &2 /\ (cos x = &0)���,
1307  REWRITE_TAC[EXISTS_UNIQUE_DEF] THEN BETA_TAC THEN
1308  W(C SUBGOAL_THEN ASSUME_TAC o hd o strip_conj o snd) THENL
1309   [MATCH_MP_TAC IVT2 THEN REPEAT CONJ_TAC THENL
1310     [REWRITE_TAC[REAL_LE, ZERO_LESS_EQ],
1311      MATCH_MP_TAC REAL_LT_IMP_LE THEN ACCEPT_TAC COS_2,
1312      REWRITE_TAC[COS_0, REAL_LE_01],
1313      X_GEN_TAC ���x:real��� THEN DISCH_THEN(K ALL_TAC) THEN
1314      MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC ���~(sin x)��� THEN
1315      REWRITE_TAC[DIFF_COS]],
1316    ASM_REWRITE_TAC[] THEN BETA_TAC THEN
1317    MAP_EVERY X_GEN_TAC [���x1:real���, ���x2:real���] THEN
1318    GEN_REWR_TAC I  [TAUT_CONV ���a:bool = ~~a���] THEN
1319    PURE_REWRITE_TAC[NOT_IMP] THEN REWRITE_TAC[] THEN STRIP_TAC THEN
1320    MP_TAC(SPECL [���x1:real���, ���x2:real���] REAL_LT_TOTAL) THEN
1321    SUBGOAL_THEN ���(!x. cos differentiable x) /\ (!x. cos contl x)���
1322    STRIP_ASSUME_TAC THENL
1323     [CONJ_TAC THEN GEN_TAC THENL
1324       [REWRITE_TAC[differentiable], MATCH_MP_TAC DIFF_CONT] THEN
1325      EXISTS_TAC ���~(sin x)��� THEN REWRITE_TAC[DIFF_COS], ALL_TAC] THEN
1326    ASM_REWRITE_TAC[] THEN DISCH_THEN DISJ_CASES_TAC THENL
1327     [MP_TAC(SPECL [���cos���, ���x1:real���, ���x2:real���] ROLLE),
1328      MP_TAC(SPECL [���cos���, ���x2:real���, ���x1:real���] ROLLE)] THEN
1329    ASM_REWRITE_TAC[] THEN
1330    DISCH_THEN(X_CHOOSE_THEN ���x:real��� MP_TAC) THEN REWRITE_TAC[CONJ_ASSOC] THEN
1331    DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN
1332    DISCH_THEN(MP_TAC o CONJ(SPEC ���x:real��� DIFF_COS)) THEN
1333    DISCH_THEN(MP_TAC o MATCH_MP DIFF_UNIQ) THEN
1334    REWRITE_TAC[REAL_NEG_EQ0] THEN MATCH_MP_TAC REAL_POS_NZ THEN
1335    MATCH_MP_TAC SIN_POS THENL
1336     [CONJ_TAC THENL
1337       [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC ���x1:real��� THEN
1338        ASM_REWRITE_TAC[],
1339        MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC ���x2:real��� THEN
1340        ASM_REWRITE_TAC[]],
1341      CONJ_TAC THENL
1342       [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC ���x2:real��� THEN
1343        ASM_REWRITE_TAC[],
1344        MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC ���x1:real��� THEN
1345        ASM_REWRITE_TAC[]]]]);
1346
1347val pi = new_definition("pi",
1348  Term `pi = &2 * @x. &0 <= x /\ x <= &2 /\ (cos x = &0)`);
1349
1350(*---------------------------------------------------------------------------*)
1351(* Periodicity and related properties of the trig functions                  *)
1352(*---------------------------------------------------------------------------*)
1353
1354val PI2 = store_thm("PI2",
1355  ���pi / &2 = @x. &0 <= x /\ x <= &2 /\ (cos(x) = &0)���,
1356  REWRITE_TAC[pi, real_div] THEN
1357  ONCE_REWRITE_TAC[AC(REAL_MUL_ASSOC,REAL_MUL_SYM)
1358    ���(a * b) * c = (c * a) * b���] THEN
1359  IMP_SUBST_TAC REAL_MUL_LINV THEN REWRITE_TAC[REAL_INJ] THEN
1360  REDUCE_TAC THEN REWRITE_TAC[REAL_MUL_LID]);
1361
1362val COS_PI2 = store_thm("COS_PI2",
1363  ���cos(pi / &2) = &0���,
1364  MP_TAC(SELECT_RULE (EXISTENCE COS_ISZERO)) THEN
1365  REWRITE_TAC[GSYM PI2] THEN
1366  DISCH_THEN(fn th => REWRITE_TAC[th]));
1367
1368val PI2_BOUNDS = store_thm("PI2_BOUNDS",
1369  ���&0 < (pi / &2) /\ (pi / &2) < &2���,
1370  MP_TAC(SELECT_RULE (EXISTENCE COS_ISZERO)) THEN
1371  REWRITE_TAC[GSYM PI2] THEN DISCH_TAC THEN
1372  ASM_REWRITE_TAC[REAL_LT_LE] THEN CONJ_TAC THENL
1373   [DISCH_TAC THEN MP_TAC COS_0 THEN ASM_REWRITE_TAC[] THEN
1374    FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[GSYM REAL_10],
1375    DISCH_TAC THEN MP_TAC COS_PI2 THEN FIRST_ASSUM SUBST1_TAC THEN
1376    REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_IMP_NE THEN
1377    MATCH_ACCEPT_TAC COS_2]);
1378
1379val PI_POS = store_thm("PI_POS",
1380  ���&0 < pi���,
1381  GEN_REWR_TAC RAND_CONV  [GSYM REAL_HALF_DOUBLE] THEN
1382  MATCH_MP_TAC REAL_LT_ADD THEN REWRITE_TAC[PI2_BOUNDS]);
1383
1384val SIN_PI2 = store_thm("SIN_PI2",
1385  ���sin(pi / &2) = &1���,
1386  MP_TAC(SPEC ���pi / &2��� SIN_CIRCLE) THEN
1387  REWRITE_TAC[COS_PI2, POW_2, REAL_MUL_LZERO, REAL_ADD_RID] THEN
1388  GEN_REWR_TAC (LAND_CONV o RAND_CONV)  [GSYM REAL_MUL_LID] THEN
1389  ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN
1390  REWRITE_TAC[GSYM REAL_DIFFSQ, REAL_ENTIRE] THEN
1391  DISCH_THEN DISJ_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
1392  POP_ASSUM MP_TAC THEN CONV_TAC CONTRAPOS_CONV THEN DISCH_THEN(K ALL_TAC) THEN
1393  REWRITE_TAC[REAL_LNEG_UNIQ] THEN DISCH_THEN(MP_TAC o AP_TERM ���$~���) THEN
1394  REWRITE_TAC[REAL_NEGNEG] THEN DISCH_TAC THEN
1395  MP_TAC REAL_LT_01 THEN POP_ASSUM(SUBST1_TAC o SYM) THEN
1396  REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_GT THEN
1397  REWRITE_TAC[REAL_NEG_LT0] THEN MATCH_MP_TAC SIN_POS THEN
1398  REWRITE_TAC[PI2_BOUNDS]);
1399
1400val COS_PI = store_thm("COS_PI",
1401  ���cos(pi) = ~(&1)���,
1402  MP_TAC(SPECL [���pi / &2���, ���pi / &2���] COS_ADD) THEN
1403  REWRITE_TAC[SIN_PI2, COS_PI2, REAL_MUL_LZERO, REAL_MUL_LID] THEN
1404  REWRITE_TAC[REAL_SUB_LZERO] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
1405  AP_TERM_TAC THEN REWRITE_TAC[REAL_DOUBLE] THEN
1406  CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_DIV_LMUL THEN
1407  REWRITE_TAC[REAL_INJ] THEN REDUCE_TAC);
1408
1409val SIN_PI = store_thm("SIN_PI",
1410  ���sin(pi) = &0���,
1411  MP_TAC(SPECL [���pi / &2���, ���pi / &2���] SIN_ADD) THEN
1412  REWRITE_TAC[COS_PI2, REAL_MUL_LZERO, REAL_MUL_RZERO, REAL_ADD_LID] THEN
1413  DISCH_THEN(SUBST1_TAC o SYM) THEN AP_TERM_TAC THEN
1414  REWRITE_TAC[REAL_DOUBLE] THEN CONV_TAC SYM_CONV THEN
1415  MATCH_MP_TAC REAL_DIV_LMUL THEN
1416  REWRITE_TAC[REAL_INJ] THEN REDUCE_TAC);
1417
1418val SIN_COS = store_thm("SIN_COS",
1419  ���!x. sin(x) = cos((pi / &2) - x)���,
1420  GEN_TAC THEN REWRITE_TAC[real_sub, COS_ADD] THEN
1421  REWRITE_TAC[SIN_PI2, COS_PI2, REAL_MUL_LZERO] THEN
1422  REWRITE_TAC[REAL_ADD_LID, REAL_MUL_LID] THEN
1423  REWRITE_TAC[SIN_NEG, REAL_NEGNEG]);
1424
1425val COS_SIN = store_thm("COS_SIN",
1426  ���!x. cos(x) = sin((pi / &2) - x)���,
1427  GEN_TAC THEN REWRITE_TAC[real_sub, SIN_ADD] THEN
1428  REWRITE_TAC[SIN_PI2, COS_PI2, REAL_MUL_LZERO] THEN
1429  REWRITE_TAC[REAL_MUL_LID, REAL_ADD_RID] THEN
1430  REWRITE_TAC[COS_NEG]);
1431
1432val SIN_PERIODIC_PI = store_thm("SIN_PERIODIC_PI",
1433  ���!x. sin(x + pi) = ~(sin(x))���,
1434  GEN_TAC THEN REWRITE_TAC[SIN_ADD, SIN_PI, COS_PI] THEN
1435  REWRITE_TAC[REAL_MUL_RZERO, REAL_ADD_RID, GSYM REAL_NEG_RMUL] THEN
1436  REWRITE_TAC[REAL_MUL_RID]);
1437
1438val COS_PERIODIC_PI = store_thm("COS_PERIODIC_PI",
1439  ���!x. cos(x + pi) = ~(cos(x))���,
1440  GEN_TAC THEN REWRITE_TAC[COS_ADD, SIN_PI, COS_PI] THEN
1441  REWRITE_TAC[REAL_MUL_RZERO, REAL_SUB_RZERO, GSYM REAL_NEG_RMUL] THEN
1442  REWRITE_TAC[REAL_MUL_RID]);
1443
1444val SIN_PERIODIC = store_thm("SIN_PERIODIC",
1445  ���!x. sin(x + (&2 * pi)) = sin(x)���,
1446  GEN_TAC THEN REWRITE_TAC[GSYM REAL_DOUBLE, REAL_ADD_ASSOC] THEN
1447  REWRITE_TAC[SIN_PERIODIC_PI, REAL_NEGNEG]);
1448
1449val COS_PERIODIC = store_thm("COS_PERIODIC",
1450  ���!x. cos(x + (&2 * pi)) = cos(x)���,
1451  GEN_TAC THEN REWRITE_TAC[GSYM REAL_DOUBLE, REAL_ADD_ASSOC] THEN
1452  REWRITE_TAC[COS_PERIODIC_PI, REAL_NEGNEG]);
1453
1454val COS_NPI = store_thm("COS_NPI",
1455  ���!n. cos(&n * pi) = ~(&1) pow n���,
1456  INDUCT_TAC THEN REWRITE_TAC[REAL_MUL_LZERO, COS_0, pow] THEN
1457  REWRITE_TAC[ADD1, GSYM REAL_ADD, REAL_RDISTRIB, COS_ADD] THEN
1458  REWRITE_TAC[REAL_MUL_LID, SIN_PI, REAL_MUL_RZERO, REAL_SUB_RZERO] THEN
1459  ASM_REWRITE_TAC[COS_PI] THEN
1460  MATCH_ACCEPT_TAC REAL_MUL_SYM);
1461
1462val SIN_NPI = store_thm("SIN_NPI",
1463  ���!n. sin(&n * pi) = &0���,
1464  INDUCT_TAC THEN REWRITE_TAC[REAL_MUL_LZERO, SIN_0, pow] THEN
1465  REWRITE_TAC[ADD1, GSYM REAL_ADD, REAL_RDISTRIB, SIN_ADD] THEN
1466  REWRITE_TAC[REAL_MUL_LID, SIN_PI, REAL_MUL_RZERO, REAL_ADD_RID] THEN
1467  ASM_REWRITE_TAC[REAL_MUL_LZERO]);
1468
1469val SIN_POS_PI2 = store_thm("SIN_POS_PI2",
1470  ���!x. &0 < x /\ x < pi / &2 ==> &0 < sin(x)���,
1471  GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC SIN_POS THEN
1472  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_TRANS THEN
1473  EXISTS_TAC ���pi / &2��� THEN ASM_REWRITE_TAC[PI2_BOUNDS]);
1474
1475val COS_POS_PI2 = store_thm("COS_POS_PI2",
1476  ���!x. &0 < x /\ x < pi / &2 ==> &0 < cos(x)���,
1477  GEN_TAC THEN STRIP_TAC THEN
1478  GEN_REWR_TAC I  [TAUT_CONV ���a:bool = ~~a���] THEN
1479  PURE_REWRITE_TAC[REAL_NOT_LT] THEN DISCH_TAC THEN
1480  MP_TAC(SPECL [���cos���, ���&0���, ���x:real���, ���&0���] IVT2) THEN
1481  ASM_REWRITE_TAC[COS_0, REAL_LE_01, NOT_IMP] THEN REPEAT CONJ_TAC THENL
1482   [MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[],
1483    X_GEN_TAC ���z:real��� THEN DISCH_THEN(K ALL_TAC) THEN
1484    MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC ���~(sin z)��� THEN
1485    REWRITE_TAC[DIFF_COS],
1486    DISCH_THEN(X_CHOOSE_TAC ���z:real���) THEN
1487    MP_TAC(CONJUNCT2 (CONV_RULE EXISTS_UNIQUE_CONV COS_ISZERO)) THEN
1488    DISCH_THEN(MP_TAC o SPECL [���z:real���, ���pi / &2���]) THEN
1489    ASM_REWRITE_TAC[COS_PI2] THEN REWRITE_TAC[NOT_IMP] THEN
1490    REPEAT CONJ_TAC THENL
1491     [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC ���x:real��� THEN
1492      ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN
1493      EXISTS_TAC ���pi / &2��� THEN ASM_REWRITE_TAC[] THEN CONJ_TAC,
1494      ALL_TAC,
1495      ALL_TAC,
1496      DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC ���x < pi / &2��� THEN
1497      ASM_REWRITE_TAC[REAL_NOT_LT]] THEN
1498    MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[PI2_BOUNDS]]);
1499
1500val COS_POS_PI = store_thm("COS_POS_PI",
1501  ���!x. ~(pi / &2) < x /\ x < pi / &2 ==> &0 < cos(x)���,
1502  GEN_TAC THEN STRIP_TAC THEN
1503  REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC
1504        (SPECL [���x:real���, ���&0���] REAL_LT_TOTAL) THENL
1505   [ASM_REWRITE_TAC[COS_0, REAL_LT_01],
1506    ONCE_REWRITE_TAC[GSYM COS_NEG] THEN MATCH_MP_TAC COS_POS_PI2 THEN
1507    ONCE_REWRITE_TAC[GSYM REAL_NEG_LT0] THEN ASM_REWRITE_TAC[REAL_NEGNEG] THEN
1508    ONCE_REWRITE_TAC[GSYM REAL_LT_NEG] THEN ASM_REWRITE_TAC[REAL_NEGNEG],
1509    MATCH_MP_TAC COS_POS_PI2 THEN ASM_REWRITE_TAC[]]);
1510
1511val SIN_POS_PI = store_thm("SIN_POS_PI",
1512  ���!x. &0 < x /\ x < pi ==> &0 < sin(x)���,
1513  GEN_TAC THEN STRIP_TAC THEN
1514  REWRITE_TAC[SIN_COS] THEN ONCE_REWRITE_TAC[GSYM COS_NEG] THEN
1515  REWRITE_TAC[REAL_NEG_SUB] THEN
1516  MATCH_MP_TAC COS_POS_PI THEN
1517  REWRITE_TAC[REAL_LT_SUB_LADD, REAL_LT_SUB_RADD] THEN
1518  ASM_REWRITE_TAC[REAL_HALF_DOUBLE, REAL_ADD_LINV]);
1519
1520val COS_POS_PI2_LE = store_thm("COS_POS_PI2_LE",
1521  ���!x. &0 <= x /\ x <= (pi / &2) ==> &0 <= cos(x)���,
1522  GEN_TAC THEN REWRITE_TAC[REAL_LE_LT] THEN
1523  DISCH_THEN(CONJUNCTS_THEN DISJ_CASES_TAC) THEN
1524  ASM_REWRITE_TAC[COS_PI2] THEN
1525  TRY(DISJ1_TAC THEN MATCH_MP_TAC COS_POS_PI2 THEN
1526      ASM_REWRITE_TAC[] THEN NO_TAC) THEN
1527  SUBST1_TAC(SYM(ASSUME ���&0 = x���)) THEN
1528  REWRITE_TAC[COS_0, REAL_LT_01]);
1529
1530val COS_POS_PI_LE = store_thm("COS_POS_PI_LE",
1531  ���!x. ~(pi / &2) <= x /\ x <= (pi / &2) ==> &0 <= cos(x)���,
1532  GEN_TAC THEN REWRITE_TAC[REAL_LE_LT] THEN
1533  DISCH_THEN(CONJUNCTS_THEN DISJ_CASES_TAC) THEN
1534  ASM_REWRITE_TAC[COS_PI2] THENL
1535   [DISJ1_TAC THEN MATCH_MP_TAC COS_POS_PI THEN ASM_REWRITE_TAC[],
1536    FIRST_ASSUM(SUBST1_TAC o SYM) THEN
1537    REWRITE_TAC[COS_NEG, COS_PI2, REAL_LT_01]]);
1538
1539val SIN_POS_PI2_LE = store_thm("SIN_POS_PI2_LE",
1540  ���!x. &0 <= x /\ x <= (pi / &2) ==> &0 <= sin(x)���,
1541  GEN_TAC THEN REWRITE_TAC[REAL_LE_LT] THEN
1542  DISCH_THEN(CONJUNCTS_THEN DISJ_CASES_TAC) THEN
1543  ASM_REWRITE_TAC[SIN_PI2, REAL_LT_01] THENL
1544   [DISJ1_TAC THEN MATCH_MP_TAC SIN_POS_PI2 THEN ASM_REWRITE_TAC[],
1545    FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[SIN_0],
1546    MP_TAC PI2_BOUNDS THEN ASM_REWRITE_TAC[REAL_LT_REFL]]);
1547
1548val SIN_POS_PI_LE = store_thm("SIN_POS_PI_LE",
1549  ���!x. &0 <= x /\ x <= pi ==> &0 <= sin(x)���,
1550  GEN_TAC THEN REWRITE_TAC[REAL_LE_LT] THEN
1551  DISCH_THEN(CONJUNCTS_THEN DISJ_CASES_TAC) THEN
1552  ASM_REWRITE_TAC[SIN_PI] THENL
1553   [DISJ1_TAC THEN MATCH_MP_TAC SIN_POS_PI THEN ASM_REWRITE_TAC[],
1554    FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[SIN_0]]);
1555
1556
1557val COS_TOTAL = store_thm("COS_TOTAL",
1558  ���!y. ~(&1) <= y /\ y <= &1 ==> ?!x. &0 <= x /\ x <= pi /\ (cos(x) = y)���,
1559  GEN_TAC THEN STRIP_TAC THEN
1560  CONV_TAC EXISTS_UNIQUE_CONV THEN CONJ_TAC THENL
1561   [MATCH_MP_TAC IVT2 THEN ASM_REWRITE_TAC[COS_0, COS_PI] THEN
1562    REWRITE_TAC[MATCH_MP REAL_LT_IMP_LE PI_POS] THEN
1563    GEN_TAC THEN DISCH_THEN(K ALL_TAC) THEN
1564    MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC ���~(sin x)��� THEN
1565    REWRITE_TAC[DIFF_COS],
1566    MAP_EVERY X_GEN_TAC [���x1:real���, ���x2:real���] THEN STRIP_TAC THEN
1567    REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC
1568         (SPECL [���x1:real���, ���x2:real���] REAL_LT_TOTAL) THENL
1569     [FIRST_ASSUM ACCEPT_TAC,
1570      MP_TAC(SPECL [���cos���, ���x1:real���, ���x2:real���] ROLLE),
1571      MP_TAC(SPECL [���cos���, ���x2:real���, ���x1:real���] ROLLE)]] THEN
1572  ASM_REWRITE_TAC[] THEN
1573  (W(C SUBGOAL_THEN (fn t => REWRITE_TAC[t]) o funpow 2
1574                    (fst o dest_imp) o snd) THENL
1575    [CONJ_TAC THEN X_GEN_TAC ���x:real��� THEN DISCH_THEN(K ALL_TAC) THEN
1576     TRY(MATCH_MP_TAC DIFF_CONT) THEN REWRITE_TAC[differentiable] THEN
1577     EXISTS_TAC ���~(sin x)��� THEN REWRITE_TAC[DIFF_COS], ALL_TAC]) THEN
1578  DISCH_THEN(X_CHOOSE_THEN ���x:real��� STRIP_ASSUME_TAC) THEN
1579  UNDISCH_TAC ���(cos diffl &0)(x)��� THEN
1580  DISCH_THEN(MP_TAC o CONJ (SPEC ���x:real��� DIFF_COS)) THEN
1581  DISCH_THEN(MP_TAC o MATCH_MP DIFF_UNIQ) THEN
1582  REWRITE_TAC[REAL_NEG_EQ0] THEN DISCH_TAC THEN
1583  MP_TAC(SPEC ���x:real��� SIN_POS_PI) THEN
1584  ASM_REWRITE_TAC[REAL_LT_REFL] THEN
1585  CONV_TAC CONTRAPOS_CONV THEN DISCH_THEN(K ALL_TAC) THEN
1586  REWRITE_TAC[] THEN CONJ_TAC THENL
1587   [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC ���x1:real���,
1588    MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC ���x2:real���,
1589    MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC ���x2:real���,
1590    MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC ���x1:real���] THEN
1591  ASM_REWRITE_TAC[]);
1592
1593val SIN_TOTAL = store_thm("SIN_TOTAL",
1594  ���!y. ~(&1) <= y /\ y <= &1 ==>
1595        ?!x.  ~(pi / &2) <= x /\ x <= pi / &2 /\ (sin(x) = y)���,
1596  GEN_TAC THEN DISCH_TAC THEN
1597  SUBGOAL_THEN ���!x. ~(pi / &2) <= x /\ x <= pi / &2 /\ (sin(x) = y)
1598                           =
1599                       &0 <= (x + pi / &2) /\
1600                       (x + pi / &2) <= pi  /\
1601                       (cos(x + pi / &2) = ~y)���
1602  (fn th => REWRITE_TAC[th]) THENL
1603   [GEN_TAC THEN REWRITE_TAC[COS_ADD, SIN_PI2, COS_PI2] THEN
1604    REWRITE_TAC[REAL_MUL_RZERO, REAL_MUL_RZERO, REAL_MUL_RID] THEN
1605    REWRITE_TAC[REAL_SUB_LZERO] THEN
1606    REWRITE_TAC[GSYM REAL_LE_SUB_RADD, GSYM REAL_LE_SUB_LADD] THEN
1607    REWRITE_TAC[REAL_SUB_LZERO] THEN AP_TERM_TAC THEN
1608    REWRITE_TAC[REAL_EQ_NEG] THEN AP_THM_TAC THEN
1609    REPEAT AP_TERM_TAC THEN
1610    GEN_REWR_TAC (RAND_CONV o LAND_CONV)  [GSYM REAL_HALF_DOUBLE] THEN
1611    REWRITE_TAC[REAL_ADD_SUB], ALL_TAC] THEN
1612  MP_TAC(SPEC ���~y��� COS_TOTAL) THEN ASM_REWRITE_TAC[REAL_LE_NEG] THEN
1613  ONCE_REWRITE_TAC[GSYM REAL_LE_NEG] THEN ASM_REWRITE_TAC[REAL_NEGNEG] THEN
1614  REWRITE_TAC[REAL_LE_NEG] THEN
1615  CONV_TAC(ONCE_DEPTH_CONV EXISTS_UNIQUE_CONV) THEN
1616  DISCH_THEN(curry op THEN CONJ_TAC o MP_TAC) THENL
1617   [DISCH_THEN(X_CHOOSE_TAC ���x:real��� o CONJUNCT1) THEN
1618    EXISTS_TAC ���x - pi / &2��� THEN ASM_REWRITE_TAC[REAL_SUB_ADD],
1619    POP_ASSUM(K ALL_TAC) THEN DISCH_THEN(ASSUME_TAC o CONJUNCT2) THEN
1620    REPEAT GEN_TAC THEN
1621    DISCH_THEN(fn th => FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN
1622    REWRITE_TAC[REAL_EQ_RADD]]);
1623
1624val COS_ZERO_LEMMA = store_thm("COS_ZERO_LEMMA",
1625  ���!x. &0 <= x /\ (cos(x) = &0) ==>
1626      ?n. ~EVEN n /\ (x = &n * (pi / &2))���,
1627  GEN_TAC THEN STRIP_TAC THEN
1628  MP_TAC(SPEC ���x:real��� (MATCH_MP REAL_ARCH_LEAST PI_POS)) THEN
1629  ASM_REWRITE_TAC[] THEN
1630  DISCH_THEN(X_CHOOSE_THEN ���n:num��� STRIP_ASSUME_TAC) THEN
1631  SUBGOAL_THEN ���&0 <= x - &n * pi /\ (x - &n * pi) <= pi /\
1632                (cos(x - &n * pi) = &0)��� ASSUME_TAC THENL
1633   [ASM_REWRITE_TAC[REAL_SUB_LE] THEN
1634    REWRITE_TAC[REAL_LE_SUB_RADD] THEN
1635    REWRITE_TAC[real_sub, COS_ADD, SIN_NEG, COS_NEG, SIN_NPI, COS_NPI] THEN
1636    ASM_REWRITE_TAC[REAL_MUL_LZERO, REAL_ADD_LID] THEN
1637    REWRITE_TAC[REAL_NEG_RMUL, REAL_NEGNEG, REAL_MUL_RZERO] THEN
1638    MATCH_MP_TAC REAL_LT_IMP_LE THEN UNDISCH_TAC ���x < &(SUC n) * pi��� THEN
1639    REWRITE_TAC[ADD1] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN
1640    REWRITE_TAC[GSYM REAL_ADD, REAL_RDISTRIB, REAL_MUL_LID],
1641    MP_TAC(SPEC ���&0��� COS_TOTAL) THEN
1642    REWRITE_TAC[REAL_LE_01, REAL_NEG_LE0] THEN
1643    DISCH_THEN(MP_TAC o CONV_RULE EXISTS_UNIQUE_CONV) THEN
1644    DISCH_THEN(MP_TAC o SPECL [���x - &n * pi���, ���pi / &2���] o CONJUNCT2) THEN
1645    ASM_REWRITE_TAC[COS_PI2] THEN
1646    W(C SUBGOAL_THEN MP_TAC o funpow 2 (fst o dest_imp) o snd) THENL
1647     [CONJ_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN MP_TAC PI2_BOUNDS THEN
1648      REWRITE_TAC[REAL_LT_HALF1, REAL_LT_HALF2] THEN DISCH_TAC THEN
1649      ASM_REWRITE_TAC[],
1650      DISCH_THEN(fn th => REWRITE_TAC[th])] THEN
1651    REWRITE_TAC[REAL_EQ_SUB_RADD] THEN DISCH_TAC THEN
1652    EXISTS_TAC ���SUC(2 * n)��� THEN REWRITE_TAC[EVEN_ODD, ODD_DOUBLE] THEN
1653    REWRITE_TAC[ADD1, GSYM REAL_ADD, GSYM REAL_MUL] THEN
1654    REWRITE_TAC[REAL_RDISTRIB, REAL_MUL_LID] THEN
1655    ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN ASM_REWRITE_TAC[] THEN
1656    AP_TERM_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
1657    REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN
1658    CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_DIV_RMUL THEN
1659    REWRITE_TAC[REAL_INJ] THEN REDUCE_TAC]);
1660
1661val SIN_ZERO_LEMMA = store_thm("SIN_ZERO_LEMMA",
1662  ���!x. &0 <= x /\ (sin(x) = &0) ==>
1663        ?n. EVEN n /\ (x = &n * (pi / &2))���,
1664  GEN_TAC THEN DISCH_TAC THEN
1665  MP_TAC(SPEC ���x + pi / &2��� COS_ZERO_LEMMA) THEN
1666  W(C SUBGOAL_THEN MP_TAC o funpow 2 (fst o dest_imp) o snd) THENL
1667   [CONJ_TAC THENL
1668     [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC ���x:real��� THEN
1669      ASM_REWRITE_TAC[REAL_LE_ADDR] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN
1670      REWRITE_TAC[PI2_BOUNDS],
1671      ASM_REWRITE_TAC[COS_ADD, COS_PI2, REAL_MUL_LZERO, REAL_MUL_RZERO] THEN
1672      MATCH_ACCEPT_TAC REAL_SUB_REFL],
1673    DISCH_THEN(fn th => REWRITE_TAC[th])] THEN
1674  DISCH_THEN(X_CHOOSE_THEN ���n:num��� STRIP_ASSUME_TAC) THEN
1675  MP_TAC(SPEC ���n:num��� ODD_EXISTS) THEN ASM_REWRITE_TAC[ODD_EVEN] THEN
1676  DISCH_THEN(X_CHOOSE_THEN ���m:num��� SUBST_ALL_TAC) THEN
1677  EXISTS_TAC ���2 * m:num��� THEN REWRITE_TAC[EVEN_DOUBLE] THEN
1678  RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_EQ_SUB_LADD]) THEN
1679  FIRST_ASSUM SUBST1_TAC THEN
1680  REWRITE_TAC[ADD1, GSYM REAL_ADD, REAL_RDISTRIB, REAL_MUL_LID] THEN
1681  REWRITE_TAC[ONCE_REWRITE_RULE[REAL_ADD_SYM] REAL_ADD_SUB]);
1682
1683val COS_ZERO = store_thm("COS_ZERO",
1684  ���!x. (cos(x) = &0) = (?n. ~EVEN n /\ (x = &n * (pi / &2))) \/
1685                       (?n. ~EVEN n /\ (x = ~(&n * (pi / &2))))���,
1686  GEN_TAC THEN EQ_TAC THENL
1687   [DISCH_TAC THEN DISJ_CASES_TAC (SPECL [���&0���, ���x:real���] REAL_LE_TOTAL) THENL
1688     [DISJ1_TAC THEN MATCH_MP_TAC COS_ZERO_LEMMA THEN ASM_REWRITE_TAC[],
1689      DISJ2_TAC THEN REWRITE_TAC[GSYM REAL_NEG_EQ] THEN
1690      MATCH_MP_TAC COS_ZERO_LEMMA THEN ASM_REWRITE_TAC[COS_NEG] THEN
1691      ONCE_REWRITE_TAC[GSYM REAL_LE_NEG] THEN
1692      ASM_REWRITE_TAC[REAL_NEGNEG, REAL_NEG_0]],
1693    DISCH_THEN(DISJ_CASES_THEN (X_CHOOSE_TAC ���n:num���)) THEN
1694    ASM_REWRITE_TAC[COS_NEG] THEN MP_TAC(SPEC ���n:num��� ODD_EXISTS) THEN
1695    ASM_REWRITE_TAC[ODD_EVEN] THEN DISCH_THEN(X_CHOOSE_THEN ���m:num��� SUBST1_TAC) THEN
1696    REWRITE_TAC[ADD1] THEN SPEC_TAC(���m:num���,���m:num���) THEN INDUCT_TAC THEN
1697    REWRITE_TAC[MULT_CLAUSES, ADD_CLAUSES, REAL_MUL_LID, COS_PI2] THEN
1698    REWRITE_TAC[GSYM ADD_ASSOC] THEN ONCE_REWRITE_TAC[GSYM REAL_ADD] THEN
1699    REWRITE_TAC[REAL_RDISTRIB] THEN REWRITE_TAC[COS_ADD] THEN
1700    REWRITE_TAC[GSYM REAL_DOUBLE, REAL_HALF_DOUBLE] THEN
1701    ASM_REWRITE_TAC[COS_PI, SIN_PI, REAL_MUL_LZERO, REAL_MUL_RZERO] THEN
1702    REWRITE_TAC[REAL_SUB_RZERO]]);
1703
1704val SIN_ZERO = store_thm("SIN_ZERO",
1705  ���!x. (sin(x) = &0) = (?n. EVEN n /\ (x = &n * (pi / &2))) \/
1706                       (?n. EVEN n /\ (x = ~(&n * (pi / &2))))���,
1707  GEN_TAC THEN EQ_TAC THENL
1708   [DISCH_TAC THEN DISJ_CASES_TAC (SPECL [���&0���, ���x:real���] REAL_LE_TOTAL) THENL
1709     [DISJ1_TAC THEN MATCH_MP_TAC SIN_ZERO_LEMMA THEN ASM_REWRITE_TAC[],
1710      DISJ2_TAC THEN REWRITE_TAC[GSYM REAL_NEG_EQ] THEN
1711      MATCH_MP_TAC SIN_ZERO_LEMMA THEN
1712      ASM_REWRITE_TAC[SIN_NEG, REAL_NEG_0, REAL_NEG_GE0]],
1713    DISCH_THEN(DISJ_CASES_THEN (X_CHOOSE_TAC ���n:num���)) THEN
1714    ASM_REWRITE_TAC[SIN_NEG, REAL_NEG_EQ0] THEN
1715    MP_TAC(SPEC ���n:num��� EVEN_EXISTS) THEN ASM_REWRITE_TAC[] THEN
1716    DISCH_THEN(X_CHOOSE_THEN ���m:num��� SUBST1_TAC) THEN
1717    REWRITE_TAC[GSYM REAL_MUL] THEN
1718    ONCE_REWRITE_TAC[AC(REAL_MUL_ASSOC,REAL_MUL_SYM)
1719      ���(a * b) * c = b * (a * c)���] THEN
1720    REWRITE_TAC[GSYM REAL_DOUBLE, REAL_HALF_DOUBLE, SIN_NPI]]);
1721
1722(*---------------------------------------------------------------------------*)
1723(* Tangent                                                                   *)
1724(*---------------------------------------------------------------------------*)
1725
1726val tan = new_definition("tan",
1727  ���tan(x) = sin(x) / cos(x)���);
1728
1729val TAN_0 = store_thm("TAN_0",
1730  ���tan(&0) = &0���,
1731  REWRITE_TAC[tan, SIN_0, REAL_DIV_LZERO]);
1732
1733val TAN_PI = store_thm("TAN_PI",
1734  ���tan(pi) = &0���,
1735  REWRITE_TAC[tan, SIN_PI, REAL_DIV_LZERO]);
1736
1737val TAN_NPI = store_thm("TAN_NPI",
1738  ���!n. tan(&n * pi) = &0���,
1739  GEN_TAC THEN REWRITE_TAC[tan, SIN_NPI, REAL_DIV_LZERO]);
1740
1741val TAN_NEG = store_thm("TAN_NEG",
1742  ���!x. tan(~x) = ~(tan x)���,
1743  GEN_TAC THEN REWRITE_TAC[tan, SIN_NEG, COS_NEG] THEN
1744  REWRITE_TAC[real_div, REAL_NEG_LMUL]);
1745
1746val TAN_PERIODIC = store_thm("TAN_PERIODIC",
1747  ���!x. tan(x + &2 * pi) = tan(x)���,
1748  GEN_TAC THEN REWRITE_TAC[tan, SIN_PERIODIC, COS_PERIODIC]);
1749
1750val TAN_ADD = store_thm("TAN_ADD",
1751  ���!x y. ~(cos(x) = &0) /\ ~(cos(y) = &0) /\ ~(cos(x + y) = &0) ==>
1752           (tan(x + y) = (tan(x) + tan(y)) / (&1 - tan(x) * tan(y)))���,
1753  REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[tan] THEN
1754  MP_TAC(SPECL [���cos(x) * cos(y)���,
1755                ���&1 - (sin(x) / cos(x)) * (sin(y) / cos(y))���]
1756         REAL_DIV_MUL2) THEN ASM_REWRITE_TAC[REAL_ENTIRE] THEN
1757  W(C SUBGOAL_THEN MP_TAC o funpow 2 (fst o dest_imp) o snd) THENL
1758   [DISCH_THEN(MP_TAC o AP_TERM ���$* (cos(x) * cos(y))���) THEN
1759    REWRITE_TAC[real_div, REAL_SUB_LDISTRIB, GSYM REAL_MUL_ASSOC] THEN
1760    REWRITE_TAC[REAL_MUL_RID, REAL_MUL_RZERO] THEN
1761    UNDISCH_TAC ���~(cos(x + y) = &0)��� THEN
1762    MATCH_MP_TAC(TAUT_CONV ���(a = b) ==> a ==> b���) THEN
1763    AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
1764    REWRITE_TAC[COS_ADD] THEN AP_TERM_TAC,
1765    DISCH_THEN(fn th => DISCH_THEN(MP_TAC o C MATCH_MP th)) THEN
1766    DISCH_THEN(fn th => ONCE_REWRITE_TAC[th]) THEN BINOP_TAC THENL
1767     [REWRITE_TAC[real_div, REAL_LDISTRIB, GSYM REAL_MUL_ASSOC] THEN
1768      REWRITE_TAC[SIN_ADD] THEN BINOP_TAC THENL
1769       [ONCE_REWRITE_TAC[AC(REAL_MUL_ASSOC,REAL_MUL_SYM)
1770          ���a * (b * (c * d)) = (d * a) * (c * b)���] THEN
1771        IMP_SUBST_TAC REAL_MUL_LINV THEN ASM_REWRITE_TAC[REAL_MUL_LID],
1772        ONCE_REWRITE_TAC[AC(REAL_MUL_ASSOC,REAL_MUL_SYM)
1773          ���a * (b * (c * d)) = (d * b) * (a * c)���] THEN
1774        IMP_SUBST_TAC REAL_MUL_LINV THEN ASM_REWRITE_TAC[REAL_MUL_LID]],
1775      REWRITE_TAC[COS_ADD, REAL_SUB_LDISTRIB, REAL_MUL_RID] THEN
1776      AP_TERM_TAC THEN REWRITE_TAC[real_div, GSYM REAL_MUL_ASSOC]]] THEN
1777  ONCE_REWRITE_TAC[AC(REAL_MUL_ASSOC,REAL_MUL_SYM)
1778    ���a * (b * (c * (d * (e * f)))) =
1779        (f * b) * ((d * a) * (c * e))���] THEN
1780  REPEAT(IMP_SUBST_TAC REAL_MUL_LINV THEN ASM_REWRITE_TAC[]) THEN
1781  REWRITE_TAC[REAL_MUL_LID]);
1782
1783val TAN_DOUBLE = store_thm("TAN_DOUBLE",
1784  ���!x. ~(cos(x) = &0) /\ ~(cos(&2 * x) = &0) ==>
1785            (tan(&2 * x) = (&2 * tan(x)) / (&1 - (tan(x) pow 2)))���,
1786  GEN_TAC THEN STRIP_TAC THEN
1787  MP_TAC(SPECL [���x:real���, ���x:real���] TAN_ADD) THEN
1788  ASM_REWRITE_TAC[REAL_DOUBLE, POW_2]);
1789
1790val TAN_POS_PI2 = store_thm("TAN_POS_PI2",
1791  ���!x. &0 < x /\ x < pi / &2 ==> &0 < tan(x)���,
1792  GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[tan, real_div] THEN
1793  MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC THENL
1794   [MATCH_MP_TAC SIN_POS_PI2,
1795    MATCH_MP_TAC REAL_INV_POS THEN MATCH_MP_TAC COS_POS_PI2] THEN
1796  ASM_REWRITE_TAC[]);
1797
1798val DIFF_TAN = store_thm("DIFF_TAN",
1799  ���!x. ~(cos(x) = &0) ==> (tan diffl inv(cos(x) pow 2))(x)���,
1800  GEN_TAC THEN DISCH_TAC THEN MP_TAC(DIFF_CONV ���\x. sin(x) / cos(x)���) THEN
1801  DISCH_THEN(MP_TAC o SPEC ���x:real���) THEN ASM_REWRITE_TAC[REAL_MUL_RID] THEN
1802  REWRITE_TAC[GSYM tan, GSYM REAL_NEG_LMUL, REAL_NEGNEG, real_sub] THEN
1803  CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
1804  REWRITE_TAC[GSYM POW_2, SIN_CIRCLE, GSYM REAL_INV_1OVER]);
1805
1806
1807val TAN_TOTAL_LEMMA = store_thm("TAN_TOTAL_LEMMA",
1808  ���!y. &0 < y ==> ?x. &0 < x /\ x < pi / &2 /\ y < tan(x)���,
1809  GEN_TAC THEN DISCH_TAC THEN
1810  SUBGOAL_THEN ���((\x. cos(x) / sin(x)) -> &0) (pi / &2)���
1811  MP_TAC THENL
1812   [SUBST1_TAC(SYM(SPEC ���&1��� REAL_DIV_LZERO)) THEN
1813    CONV_TAC(ONCE_DEPTH_CONV HABS_CONV) THEN MATCH_MP_TAC LIM_DIV THEN
1814    REWRITE_TAC[REAL_10] THEN CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN
1815    SUBST1_TAC(SYM COS_PI2) THEN SUBST1_TAC(SYM SIN_PI2) THEN
1816    REWRITE_TAC[GSYM CONTL_LIM] THEN CONJ_TAC THEN MATCH_MP_TAC DIFF_CONT THENL
1817     [EXISTS_TAC ���~(sin(pi / &2))���,
1818      EXISTS_TAC ���cos(pi / &2)���] THEN
1819    REWRITE_TAC[DIFF_SIN, DIFF_COS], ALL_TAC] THEN
1820  REWRITE_TAC[LIM] THEN DISCH_THEN(MP_TAC o SPEC ���inv(y)���) THEN
1821  FIRST_ASSUM(fn th => REWRITE_TAC[MATCH_MP REAL_INV_POS th]) THEN
1822  BETA_TAC THEN REWRITE_TAC[REAL_SUB_RZERO] THEN
1823  DISCH_THEN(X_CHOOSE_THEN ���d:real��� STRIP_ASSUME_TAC) THEN
1824  MP_TAC(SPECL [���d:real���, ���pi / &2���] REAL_DOWN2) THEN
1825  ASM_REWRITE_TAC[PI2_BOUNDS] THEN
1826  DISCH_THEN(X_CHOOSE_THEN ���e:real��� STRIP_ASSUME_TAC) THEN
1827  EXISTS_TAC ���(pi / &2) - e��� THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN
1828  CONJ_TAC THENL
1829   [REWRITE_TAC[real_sub, GSYM REAL_NOT_LE, REAL_LE_ADDR, REAL_NEG_GE0] THEN
1830    ASM_REWRITE_TAC[REAL_NOT_LE], ALL_TAC] THEN
1831  FIRST_ASSUM(UNDISCH_TAC o assert is_forall o concl) THEN
1832  DISCH_THEN(MP_TAC o SPEC ���(pi / &2) - e���) THEN
1833  REWRITE_TAC[REAL_SUB_SUB, ABS_NEG] THEN
1834  SUBGOAL_THEN ���abs(e) = e��� (fn th => ASM_REWRITE_TAC[th]) THENL
1835   [REWRITE_TAC[ABS_REFL] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN
1836    FIRST_ASSUM ACCEPT_TAC, ALL_TAC] THEN
1837  SUBGOAL_THEN ���&0 < cos((pi / &2) - e) / sin((pi / &2) - e)���
1838  MP_TAC THENL
1839   [ONCE_REWRITE_TAC[real_div] THEN
1840    MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC THENL
1841     [MATCH_MP_TAC COS_POS_PI2,
1842      MATCH_MP_TAC REAL_INV_POS THEN MATCH_MP_TAC SIN_POS_PI2] THEN
1843    ASM_REWRITE_TAC[REAL_SUB_LT] THEN
1844    REWRITE_TAC[GSYM REAL_NOT_LE, real_sub, REAL_LE_ADDR, REAL_NEG_GE0] THEN
1845    ASM_REWRITE_TAC[REAL_NOT_LE], ALL_TAC] THEN
1846  DISCH_THEN(fn th => ASSUME_TAC th THEN MP_TAC(MATCH_MP REAL_POS_NZ th)) THEN
1847  REWRITE_TAC[ABS_NZ, TAUT_CONV ���a ==> b ==> c = a /\ b ==> c���] THEN
1848  DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_INV) THEN REWRITE_TAC[tan] THEN
1849  MATCH_MP_TAC (TAUT_CONV ���(a = b) ==> a ==> b���) THEN BINOP_TAC THENL
1850   [MATCH_MP_TAC REAL_INVINV THEN MATCH_MP_TAC REAL_POS_NZ THEN
1851    FIRST_ASSUM ACCEPT_TAC, ALL_TAC] THEN
1852  MP_TAC(ASSUME���&0 < cos((pi / &2) - e) / sin((pi / &2) - e)���) THEN
1853  DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_IMP_LE) THEN
1854  REWRITE_TAC[GSYM ABS_REFL] THEN DISCH_THEN SUBST1_TAC THEN
1855  REWRITE_TAC[real_div] THEN IMP_SUBST_TAC REAL_INV_MUL THENL
1856   [REWRITE_TAC[GSYM DE_MORGAN_THM, GSYM REAL_ENTIRE, GSYM real_div] THEN
1857    MATCH_MP_TAC REAL_POS_NZ THEN FIRST_ASSUM ACCEPT_TAC,
1858    GEN_REWR_TAC RAND_CONV  [REAL_MUL_SYM] THEN AP_TERM_TAC THEN
1859    MATCH_MP_TAC REAL_INVINV THEN MATCH_MP_TAC REAL_POS_NZ THEN
1860    MATCH_MP_TAC SIN_POS_PI2 THEN REWRITE_TAC[REAL_SUB_LT, GSYM real_div] THEN
1861    REWRITE_TAC[GSYM REAL_NOT_LE, real_sub, REAL_LE_ADDR, REAL_NEG_GE0] THEN
1862    ASM_REWRITE_TAC[REAL_NOT_LE]]);
1863
1864val TAN_TOTAL_POS = store_thm("TAN_TOTAL_POS",
1865  ���!y. &0 <= y ==> ?x. &0 <= x /\ x < pi / &2 /\ (tan(x) = y)���,
1866  GEN_TAC THEN DISCH_THEN(DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT]) THENL
1867   [FIRST_ASSUM(MP_TAC o MATCH_MP TAN_TOTAL_LEMMA) THEN
1868    DISCH_THEN(X_CHOOSE_THEN ���x:real��� STRIP_ASSUME_TAC) THEN
1869    MP_TAC(SPECL [���tan���, ���&0���, ���x:real���, ���y:real���] IVT) THEN
1870    W(C SUBGOAL_THEN (fn th => DISCH_THEN(MP_TAC o C MATCH_MP th)) o
1871         funpow 2 (fst o dest_imp) o snd) THENL
1872     [REPEAT CONJ_TAC THEN TRY(MATCH_MP_TAC REAL_LT_IMP_LE) THEN
1873      ASM_REWRITE_TAC[TAN_0] THEN X_GEN_TAC ���z:real��� THEN STRIP_TAC THEN
1874      MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC ���inv(cos(z) pow 2)��� THEN
1875      MATCH_MP_TAC DIFF_TAN THEN UNDISCH_TAC ���&0 <= z��� THEN
1876      REWRITE_TAC[REAL_LE_LT] THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL
1877       [DISCH_TAC THEN MATCH_MP_TAC REAL_POS_NZ THEN
1878        MATCH_MP_TAC COS_POS_PI2 THEN ASM_REWRITE_TAC[] THEN
1879        MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC ���x:real��� THEN
1880        ASM_REWRITE_TAC[],
1881        DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[COS_0, REAL_10]],
1882      DISCH_THEN(X_CHOOSE_THEN ���z:real��� STRIP_ASSUME_TAC) THEN
1883      EXISTS_TAC ���z:real��� THEN ASM_REWRITE_TAC[] THEN
1884      MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC ���x:real��� THEN
1885      ASM_REWRITE_TAC[]],
1886    POP_ASSUM(SUBST1_TAC o SYM) THEN EXISTS_TAC ���&0��� THEN
1887    REWRITE_TAC[TAN_0, REAL_LE_REFL, PI2_BOUNDS]]);
1888
1889val TAN_TOTAL = store_thm("TAN_TOTAL",
1890  ���!y. ?!x. ~(pi / &2) < x /\ x < (pi / &2) /\ (tan(x) = y)���,
1891  GEN_TAC THEN CONV_TAC EXISTS_UNIQUE_CONV THEN CONJ_TAC THENL
1892   [DISJ_CASES_TAC(SPEC ���y:real��� REAL_LE_NEGTOTAL) THEN
1893    POP_ASSUM(X_CHOOSE_TAC ���x:real��� o MATCH_MP TAN_TOTAL_POS) THENL
1894     [EXISTS_TAC ���x:real��� THEN ASM_REWRITE_TAC[] THEN
1895      MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC ���&0��� THEN
1896      ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM REAL_LT_NEG] THEN
1897      REWRITE_TAC[REAL_NEGNEG, REAL_NEG_0, PI2_BOUNDS],
1898      EXISTS_TAC ���~x��� THEN ASM_REWRITE_TAC[REAL_LT_NEG] THEN
1899      ASM_REWRITE_TAC[TAN_NEG, REAL_NEG_EQ, REAL_NEGNEG] THEN
1900      ONCE_REWRITE_TAC[GSYM REAL_LT_NEG] THEN
1901      REWRITE_TAC[REAL_LT_NEG] THEN MATCH_MP_TAC REAL_LET_TRANS THEN
1902      EXISTS_TAC ���x:real��� THEN ASM_REWRITE_TAC[REAL_LE_NEGL]],
1903    MAP_EVERY X_GEN_TAC [���x1:real���, ���x2:real���] THEN
1904    REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC
1905         (SPECL [���x1:real���, ���x2:real���] REAL_LT_TOTAL) THENL
1906     [DISCH_THEN(K ALL_TAC) THEN POP_ASSUM ACCEPT_TAC,
1907      ALL_TAC,
1908      POP_ASSUM MP_TAC THEN SPEC_TAC(���x1:real���,���z1:real���) THEN
1909      SPEC_TAC(���x2:real���,���z2:real���) THEN
1910      MAP_EVERY X_GEN_TAC [���x1:real���, ���x2:real���] THEN DISCH_TAC THEN
1911      CONV_TAC(RAND_CONV SYM_CONV) THEN ONCE_REWRITE_TAC[CONJ_SYM]] THEN
1912    (STRIP_TAC THEN MP_TAC(SPECL [���tan���, ���x1:real���, ���x2:real���] ROLLE) THEN
1913     ASM_REWRITE_TAC[] THEN CONV_TAC CONTRAPOS_CONV THEN
1914     DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[NOT_IMP] THEN
1915     REPEAT CONJ_TAC THENL
1916      [X_GEN_TAC ���x:real��� THEN STRIP_TAC THEN MATCH_MP_TAC DIFF_CONT THEN
1917       EXISTS_TAC ���inv(cos(x) pow 2)��� THEN MATCH_MP_TAC DIFF_TAN,
1918       X_GEN_TAC ���x:real��� THEN
1919       DISCH_THEN(CONJUNCTS_THEN (ASSUME_TAC o MATCH_MP REAL_LT_IMP_LE)) THEN
1920       REWRITE_TAC[differentiable] THEN EXISTS_TAC ���inv(cos(x) pow 2)��� THEN
1921       MATCH_MP_TAC DIFF_TAN,
1922       REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(X_CHOOSE_THEN ���x:real���
1923         (CONJUNCTS_THEN2 (CONJUNCTS_THEN (ASSUME_TAC o MATCH_MP
1924          REAL_LT_IMP_LE)) ASSUME_TAC)) THEN
1925       MP_TAC(SPEC ���x:real��� DIFF_TAN) THEN
1926       SUBGOAL_THEN ���~(cos(x) = &0)��� ASSUME_TAC THENL
1927        [ALL_TAC,
1928         ASM_REWRITE_TAC[] THEN
1929         DISCH_THEN(MP_TAC o C CONJ (ASSUME ���(tan diffl &0)(x)���)) THEN
1930         DISCH_THEN(MP_TAC o MATCH_MP DIFF_UNIQ) THEN REWRITE_TAC[] THEN
1931         MATCH_MP_TAC REAL_INV_NZ THEN MATCH_MP_TAC POW_NZ THEN
1932         ASM_REWRITE_TAC[]]] THEN
1933     (MATCH_MP_TAC REAL_POS_NZ THEN MATCH_MP_TAC COS_POS_PI THEN
1934      CONJ_TAC THENL
1935       [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC ���x1:real���,
1936        MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC ���x2:real���] THEN
1937     ASM_REWRITE_TAC[]))]);
1938
1939(*---------------------------------------------------------------------------*)
1940(* Inverse trig functions                                                    *)
1941(*---------------------------------------------------------------------------*)
1942
1943val asn = new_definition("asn",
1944  ���asn(y) = @x. ~(pi / &2) <= x /\ x <= pi / &2 /\ (sin x = y)���);
1945
1946val acs = new_definition("acs",
1947  ���acs(y) = @x. &0 <= x /\ x <= pi /\ (cos x = y)���);
1948
1949val atn = new_definition("atn",
1950  ���atn(y) = @x. ~(pi / &2) < x /\ x < pi / &2 /\ (tan x = y)���);
1951
1952val ASN = store_thm("ASN",
1953  ���!y. ~(&1) <= y /\ y <= &1 ==>
1954           ~(pi / &2) <= asn(y) /\ (asn(y) <= pi / &2 /\ (sin(asn y) = y))���,
1955  GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP SIN_TOTAL) THEN
1956  DISCH_THEN(MP_TAC o CONJUNCT1 o CONV_RULE EXISTS_UNIQUE_CONV) THEN
1957  DISCH_THEN(MP_TAC o SELECT_RULE) THEN REWRITE_TAC[GSYM asn]);
1958
1959val ASN_SIN = store_thm("ASN_SIN",
1960  ���!y. ~(&1) <= y /\ y <= &1 ==> (sin(asn(y)) = y)���,
1961  GEN_TAC THEN DISCH_THEN(fn th => REWRITE_TAC[MATCH_MP ASN th]));
1962
1963val ASN_BOUNDS = store_thm("ASN_BOUNDS",
1964  ���!y. ~(&1) <= y /\ y <= &1
1965           ==> ~(pi / &2) <= asn(y) /\ asn(y) <= pi / &2���,
1966GEN_TAC THEN DISCH_THEN(fn th => REWRITE_TAC[MATCH_MP ASN th]));
1967
1968val ASN_BOUNDS_LT = store_thm("ASN_BOUNDS_LT",
1969  ���!y. ~(&1) < y /\ y < &1 ==> ~(pi / &2) < asn(y) /\ asn(y) < pi / &2���,
1970  GEN_TAC THEN STRIP_TAC THEN
1971  SUBGOAL_THEN ���~(pi / &2) <= asn(y) /\ asn(y) <= pi / &2��� ASSUME_TAC THENL
1972   [MATCH_MP_TAC ASN_BOUNDS THEN CONJ_TAC THEN
1973    MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[],
1974    ASM_REWRITE_TAC[REAL_LT_LE]] THEN
1975  CONJ_TAC THEN DISCH_THEN(MP_TAC o AP_TERM ���sin���) THEN
1976  REWRITE_TAC[SIN_NEG, SIN_PI2] THEN MATCH_MP_TAC REAL_LT_IMP_NE THEN
1977  SUBGOAL_THEN ���sin(asn y) = y��� (fn th => ASM_REWRITE_TAC[th]) THEN
1978  MATCH_MP_TAC ASN_SIN THEN CONJ_TAC THEN
1979  MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]);
1980
1981val SIN_ASN = store_thm("SIN_ASN",
1982  ���!x. ~(pi / &2) <= x /\ x <= pi / &2 ==> (asn(sin(x)) = x)���,
1983  GEN_TAC THEN DISCH_TAC THEN
1984  MP_TAC(MATCH_MP SIN_TOTAL (SPEC ���x:real��� SIN_BOUNDS)) THEN
1985  DISCH_THEN(MATCH_MP_TAC o CONJUNCT2 o CONV_RULE EXISTS_UNIQUE_CONV) THEN
1986  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ASN THEN
1987  MATCH_ACCEPT_TAC SIN_BOUNDS);
1988
1989val ACS = store_thm("ACS",
1990  ���!y. ~(&1) <= y /\ y <= &1 ==>
1991     &0 <= acs(y) /\ acs(y) <= pi  /\ (cos(acs y) = y)���,
1992  GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP COS_TOTAL) THEN
1993  DISCH_THEN(MP_TAC o CONJUNCT1 o CONV_RULE EXISTS_UNIQUE_CONV) THEN
1994  DISCH_THEN(MP_TAC o SELECT_RULE) THEN REWRITE_TAC[GSYM acs]);
1995
1996val ACS_COS = store_thm("ACS_COS",
1997  ���!y. ~(&1) <= y /\ y <= &1 ==> (cos(acs(y)) = y)���,
1998  GEN_TAC THEN DISCH_THEN(fn th => REWRITE_TAC[MATCH_MP ACS th]));
1999
2000val ACS_BOUNDS = store_thm("ACS_BOUNDS",
2001  ���!y. ~(&1) <= y /\ y <= &1 ==> &0 <= acs(y) /\ acs(y) <= pi���,
2002  GEN_TAC THEN DISCH_THEN(fn th => REWRITE_TAC[MATCH_MP ACS th]));
2003
2004val ACS_BOUNDS_LT = store_thm("ACS_BOUNDS_LT",
2005  ���!y. ~(&1) < y /\ y < &1 ==> &0 < acs(y) /\ acs(y) < pi���,
2006  GEN_TAC THEN STRIP_TAC THEN
2007  SUBGOAL_THEN ���&0 <= acs(y) /\ acs(y) <= pi��� ASSUME_TAC THENL
2008   [MATCH_MP_TAC ACS_BOUNDS THEN CONJ_TAC THEN
2009    MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[],
2010    ASM_REWRITE_TAC[REAL_LT_LE]] THEN
2011  CONJ_TAC THEN DISCH_THEN(MP_TAC o AP_TERM ���cos���) THEN
2012  REWRITE_TAC[COS_0, COS_PI] THEN
2013  CONV_TAC(RAND_CONV SYM_CONV) THEN
2014  MATCH_MP_TAC REAL_LT_IMP_NE THEN
2015  SUBGOAL_THEN ���cos(acs y) = y��� (fn th => ASM_REWRITE_TAC[th]) THEN
2016  MATCH_MP_TAC ACS_COS THEN CONJ_TAC THEN
2017  MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]);
2018
2019val COS_ACS = store_thm("COS_ACS",
2020  ���!x. &0 <= x /\ x <= pi ==> (acs(cos(x)) = x)���,
2021  GEN_TAC THEN DISCH_TAC THEN
2022  MP_TAC(MATCH_MP COS_TOTAL (SPEC ���x:real��� COS_BOUNDS)) THEN
2023  DISCH_THEN(MATCH_MP_TAC o CONJUNCT2 o CONV_RULE EXISTS_UNIQUE_CONV) THEN
2024  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ACS THEN
2025  MATCH_ACCEPT_TAC COS_BOUNDS);
2026
2027val ATN = store_thm("ATN",
2028  ���!y. ~(pi / &2) < atn(y) /\ atn(y) < (pi / &2) /\ (tan(atn y) = y)���,
2029  GEN_TAC THEN MP_TAC(SPEC ���y:real��� TAN_TOTAL) THEN
2030  DISCH_THEN(MP_TAC o CONJUNCT1 o CONV_RULE EXISTS_UNIQUE_CONV) THEN
2031  DISCH_THEN(MP_TAC o SELECT_RULE) THEN REWRITE_TAC[GSYM atn]);
2032
2033val ATN_TAN = store_thm("ATN_TAN",
2034  ���!y. tan(atn y) = y���,
2035  REWRITE_TAC[ATN]);
2036
2037val ATN_BOUNDS = store_thm("ATN_BOUNDS",
2038  ���!y. ~(pi / &2) < atn(y) /\ atn(y) < (pi / &2)���,
2039  REWRITE_TAC[ATN]);
2040
2041val TAN_ATN = store_thm("TAN_ATN",
2042  ���!x. ~(pi / &2) < x /\ x < (pi / &2) ==> (atn(tan(x)) = x)���,
2043  GEN_TAC THEN DISCH_TAC THEN MP_TAC(SPEC ���tan(x)��� TAN_TOTAL) THEN
2044  DISCH_THEN(MATCH_MP_TAC o CONJUNCT2 o CONV_RULE EXISTS_UNIQUE_CONV) THEN
2045  ASM_REWRITE_TAC[ATN]);
2046
2047(*---------------------------------------------------------------------------*)
2048(* A few additional results about the trig functions                         *)
2049(*---------------------------------------------------------------------------*)
2050
2051val TAN_SEC = store_thm("TAN_SEC",
2052  ���!x. ~(cos(x) = &0) ==> (&1 + (tan(x) pow 2) = inv(cos x) pow 2)���,
2053  GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[tan] THEN
2054  FIRST_ASSUM(fn th => ONCE_REWRITE_TAC[GSYM
2055   (MATCH_MP REAL_DIV_REFL (SPEC ���2:num��� (MATCH_MP POW_NZ th)))]) THEN
2056  REWRITE_TAC[real_div, POW_MUL] THEN
2057  POP_ASSUM(fn th => REWRITE_TAC[MATCH_MP POW_INV th]) THEN
2058  ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
2059  REWRITE_TAC[GSYM REAL_RDISTRIB, SIN_CIRCLE, REAL_MUL_LID]);
2060
2061val SIN_COS_SQ = store_thm("SIN_COS_SQ",
2062  ���!x. &0 <= x /\ x <= pi ==> (sin(x) = sqrt(&1 - (cos(x) pow 2)))���,
2063  GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC SQRT_EQ THEN
2064  REWRITE_TAC[REAL_EQ_SUB_LADD, SIN_CIRCLE] THEN
2065  MATCH_MP_TAC SIN_POS_PI_LE THEN ASM_REWRITE_TAC[]);
2066
2067val COS_SIN_SQ = store_thm("COS_SIN_SQ",
2068  ���!x. ~(pi / &2) <= x /\ x <= (pi / &2) ==>
2069             (cos(x) = sqrt(&1 - (sin(x) pow 2)))���,
2070  GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC SQRT_EQ THEN
2071  REWRITE_TAC[REAL_EQ_SUB_LADD] THEN
2072  ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
2073  REWRITE_TAC[SIN_CIRCLE] THEN
2074  MATCH_MP_TAC COS_POS_PI_LE THEN ASM_REWRITE_TAC[]);
2075
2076val COS_ATN_NZ = store_thm("COS_ATN_NZ",
2077  ���!x. ~(cos(atn(x)) = &0)���,
2078  GEN_TAC THEN MATCH_MP_TAC REAL_POS_NZ THEN
2079  MATCH_MP_TAC COS_POS_PI THEN MATCH_ACCEPT_TAC ATN_BOUNDS);
2080
2081val COS_ASN_NZ = store_thm("COS_ASN_NZ",
2082  ���!x. ~(&1) < x /\ x < &1 ==> ~(cos(asn(x)) = &0)���,
2083  GEN_TAC THEN DISCH_TAC THEN
2084  MAP_EVERY MATCH_MP_TAC [REAL_POS_NZ, COS_POS_PI, ASN_BOUNDS_LT] THEN
2085  POP_ASSUM ACCEPT_TAC);
2086
2087val SIN_ACS_NZ = store_thm("SIN_ACS_NZ",
2088  ���!x. ~(&1) < x /\ x < &1 ==> ~(sin(acs(x)) = &0)���,
2089  GEN_TAC THEN DISCH_TAC THEN
2090  MAP_EVERY MATCH_MP_TAC [REAL_POS_NZ, SIN_POS_PI, ACS_BOUNDS_LT] THEN
2091  POP_ASSUM ACCEPT_TAC);
2092
2093val COS_SIN_SQRT = store_thm("COS_SIN_SQRT",
2094  Term `!x. &0 <= cos(x) ==> (cos(x) = sqrt(&1 - (sin(x) pow 2)))`,
2095  GEN_TAC THEN DISCH_TAC THEN
2096  MP_TAC (ONCE_REWRITE_RULE[REAL_ADD_SYM] (SPEC (Term`x:real`) SIN_CIRCLE))
2097  THEN REWRITE_TAC[GSYM REAL_EQ_SUB_LADD] THEN
2098  DISCH_THEN(SUBST1_TAC o SYM) THEN
2099  REWRITE_TAC[sqrt, TWO] THEN
2100  CONV_TAC SYM_CONV THEN MATCH_MP_TAC POW_ROOT_POS THEN
2101  ASM_REWRITE_TAC[]);;
2102
2103val SIN_COS_SQRT = store_thm("SIN_COS_SQRT",
2104  Term`!x. &0 <= sin(x) ==> (sin(x) = sqrt(&1 - (cos(x) pow 2)))`,
2105  GEN_TAC THEN DISCH_TAC THEN
2106  MP_TAC (SPEC (Term`x:real`) SIN_CIRCLE) THEN
2107  REWRITE_TAC[GSYM REAL_EQ_SUB_LADD] THEN
2108  DISCH_THEN(SUBST1_TAC o SYM) THEN
2109  REWRITE_TAC[sqrt, TWO] THEN
2110  CONV_TAC SYM_CONV THEN MATCH_MP_TAC POW_ROOT_POS THEN
2111  ASM_REWRITE_TAC[]);;
2112
2113
2114(*---------------------------------------------------------------------------*)
2115(* Derivatives of the inverse functions, starting with natural log           *)
2116(*---------------------------------------------------------------------------*)
2117
2118val DIFF_LN = store_thm("DIFF_LN",
2119  ���!x. &0 < x ==> (ln diffl (inv x))(x)���,
2120  GEN_TAC THEN DISCH_TAC THEN
2121  SUBGOAL_THEN ���(ln diffl (inv x))(exp(ln(x)))��� MP_TAC THENL
2122   [MATCH_MP_TAC DIFF_INVERSE_OPEN,
2123    MATCH_MP_TAC(TAUT_CONV ���(a = b) ==> a ==> b���) THEN AP_TERM_TAC THEN
2124    ASM_REWRITE_TAC[EXP_LN]] THEN
2125  MAP_EVERY EXISTS_TAC [���ln(x) - &1���, ���ln(x) + &1���] THEN
2126  REWRITE_TAC[REAL_LT_SUB_RADD, REAL_LT_ADDR, REAL_LT_01, LN_EXP,
2127    MATCH_MP DIFF_CONT (SPEC_ALL DIFF_EXP)] THEN
2128  CONJ_TAC THENL
2129   [MP_TAC(SPEC ���ln(x)��� DIFF_EXP) THEN
2130    RULE_ASSUM_TAC(REWRITE_RULE[GSYM EXP_LN]), MATCH_MP_TAC REAL_POS_NZ] THEN
2131  ASM_REWRITE_TAC[]);
2132
2133(* Known as DIFF_ASN_COS in GTT *)
2134val DIFF_ASN_LEMMA = store_thm("DIFF_ASN_LEMMA",
2135  ���!x. ~(&1) < x /\ x < &1 ==> (asn diffl (inv(cos(asn x))))(x)���,
2136  GEN_TAC THEN STRIP_TAC THEN IMP_RES_TAC REAL_LT_IMP_LE THEN
2137  MP_TAC(SPEC ���x:real��� ASN_SIN) THEN ASM_REWRITE_TAC[] THEN
2138  DISCH_THEN(fn th => GEN_REWR_TAC RAND_CONV  [SYM th]) THEN
2139  MATCH_MP_TAC DIFF_INVERSE_OPEN THEN REWRITE_TAC[DIFF_SIN] THEN
2140  MAP_EVERY EXISTS_TAC [���~(pi / &2)���, ���pi / &2���] THEN
2141  MP_TAC(SPEC ���x:real��� ASN_BOUNDS_LT) THEN ASM_REWRITE_TAC[] THEN
2142  DISCH_THEN(fn th => REWRITE_TAC[th]) THEN CONJ_TAC THENL
2143   [GEN_TAC THEN STRIP_TAC THEN IMP_RES_TAC REAL_LT_IMP_LE THEN
2144    REWRITE_TAC[MATCH_MP DIFF_CONT (SPEC_ALL DIFF_SIN)] THEN
2145    MATCH_MP_TAC SIN_ASN THEN ASM_REWRITE_TAC[],
2146    MATCH_MP_TAC COS_ASN_NZ THEN ASM_REWRITE_TAC[]]);
2147
2148val DIFF_ASN = store_thm("DIFF_ASN",
2149  ���!x. ~(&1) < x /\ x < &1 ==> (asn diffl (inv(sqrt(&1 - (x pow 2)))))(x)���,
2150  GEN_TAC THEN DISCH_TAC THEN
2151  FIRST_ASSUM(MP_TAC o MATCH_MP DIFF_ASN_LEMMA) THEN
2152  MATCH_MP_TAC(TAUT_CONV ���(a = b) ==> a ==> b���) THEN
2153  AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
2154  SUBGOAL_THEN ���cos(asn(x)) = sqrt(&1 - (sin(asn x) pow 2))��� SUBST1_TAC THENL
2155   [MATCH_MP_TAC COS_SIN_SQ THEN MATCH_MP_TAC ASN_BOUNDS,
2156    SUBGOAL_THEN ���sin(asn x) = x��� SUBST1_TAC THEN REWRITE_TAC[] THEN
2157    MATCH_MP_TAC ASN_SIN] THEN
2158  CONJ_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]);
2159
2160(* Known as DIFF_ACS_SIN in GTT *)
2161val DIFF_ACS_LEMMA = store_thm("DIFF_ACS_LEMMA",
2162  ���!x. ~(&1) < x /\ x < &1 ==> (acs diffl inv(~(sin(acs x))))(x)���,
2163  GEN_TAC THEN STRIP_TAC THEN IMP_RES_TAC REAL_LT_IMP_LE THEN
2164  MP_TAC(SPEC ���x:real��� ACS_COS) THEN ASM_REWRITE_TAC[] THEN
2165  DISCH_THEN(fn th => GEN_REWR_TAC RAND_CONV  [SYM th]) THEN
2166  MATCH_MP_TAC DIFF_INVERSE_OPEN THEN REWRITE_TAC[DIFF_COS] THEN
2167  MAP_EVERY EXISTS_TAC [���&0���, ���pi���] THEN
2168  MP_TAC(SPEC ���x:real��� ACS_BOUNDS_LT) THEN ASM_REWRITE_TAC[] THEN
2169  DISCH_THEN(fn th => REWRITE_TAC[th]) THEN CONJ_TAC THENL
2170   [GEN_TAC THEN STRIP_TAC THEN IMP_RES_TAC REAL_LT_IMP_LE THEN
2171    REWRITE_TAC[MATCH_MP DIFF_CONT (SPEC_ALL DIFF_COS)] THEN
2172    MATCH_MP_TAC COS_ACS THEN ASM_REWRITE_TAC[],
2173    REWRITE_TAC[REAL_NEG_EQ, REAL_NEG_0] THEN
2174    MATCH_MP_TAC SIN_ACS_NZ THEN ASM_REWRITE_TAC[]]);
2175
2176val DIFF_ACS = store_thm("DIFF_ACS",
2177  ���!x. ~(&1) < x /\ x <  &1 ==> (acs diffl ~(inv(sqrt(&1 - (x pow 2)))))(x)���,
2178  GEN_TAC THEN DISCH_TAC THEN
2179  FIRST_ASSUM(MP_TAC o MATCH_MP DIFF_ACS_LEMMA) THEN
2180  MATCH_MP_TAC(TAUT_CONV ���(a = b) ==> a ==> b���) THEN
2181  AP_THM_TAC THEN AP_TERM_TAC THEN
2182  SUBGOAL_THEN ���sin(acs(x)) = sqrt(&1 - (cos(acs x) pow 2))��� SUBST1_TAC THENL
2183   [MATCH_MP_TAC SIN_COS_SQ THEN MATCH_MP_TAC ACS_BOUNDS,
2184    SUBGOAL_THEN ���cos(acs x) = x��� SUBST1_TAC THENL
2185     [MATCH_MP_TAC ACS_COS,
2186      CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_NEG_INV THEN
2187      MATCH_MP_TAC REAL_POS_NZ THEN REWRITE_TAC[sqrt, TWO] THEN
2188      MATCH_MP_TAC ROOT_POS_LT THEN
2189      REWRITE_TAC[REAL_LT_SUB_LADD, REAL_ADD_LID] THEN
2190      REWRITE_TAC[SYM(TWO), POW_2] THEN
2191      GEN_REWR_TAC RAND_CONV  [GSYM REAL_MUL_LID] THEN
2192      DISJ_CASES_TAC (SPEC ���x:real��� REAL_LE_NEGTOTAL) THENL
2193       [ALL_TAC, GEN_REWR_TAC LAND_CONV  [GSYM REAL_NEG_MUL2]] THEN
2194      MATCH_MP_TAC REAL_LT_MUL2 THEN ASM_REWRITE_TAC[] THEN
2195      ONCE_REWRITE_TAC [GSYM REAL_LT_NEG] THEN
2196      ASM_REWRITE_TAC[REAL_NEGNEG]]] THEN
2197  CONJ_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]);
2198
2199val DIFF_ATN = store_thm("DIFF_ATN",
2200  ���!x. (atn diffl (inv(&1 + (x pow 2))))(x)���,
2201  GEN_TAC THEN
2202  SUBGOAL_THEN ���(atn diffl (inv(&1 + (x pow 2))))(tan(atn x))��� MP_TAC THENL
2203   [MATCH_MP_TAC DIFF_INVERSE_OPEN, REWRITE_TAC[ATN_TAN]] THEN
2204  MAP_EVERY EXISTS_TAC [���~(pi / &2)���, ���pi / &2���] THEN
2205  REWRITE_TAC[ATN_BOUNDS] THEN REPEAT CONJ_TAC THENL
2206   [X_GEN_TAC ���x:real��� THEN DISCH_TAC THEN
2207    FIRST_ASSUM(fn th => REWRITE_TAC[MATCH_MP TAN_ATN th]) THEN
2208    MATCH_MP_TAC DIFF_CONT THEN
2209    EXISTS_TAC ���inv(cos(x) pow 2)��� THEN
2210    MATCH_MP_TAC DIFF_TAN THEN
2211    MATCH_MP_TAC REAL_POS_NZ THEN MATCH_MP_TAC COS_POS_PI THEN
2212    ASM_REWRITE_TAC[],
2213    MP_TAC(SPEC ���atn(x)��� DIFF_TAN) THEN REWRITE_TAC[COS_ATN_NZ] THEN
2214    REWRITE_TAC[MATCH_MP POW_INV (SPEC ���x:real��� COS_ATN_NZ)] THEN
2215    REWRITE_TAC[GSYM(MATCH_MP TAN_SEC (SPEC ���x:real��� COS_ATN_NZ))] THEN
2216    REWRITE_TAC[ATN_TAN],
2217    MATCH_MP_TAC REAL_POS_NZ THEN
2218    MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC ���&1��� THEN
2219    REWRITE_TAC[REAL_LT_01, REAL_LE_ADDR, POW_2, REAL_LE_SQUARE]]);
2220
2221
2222
2223(* ======================================================================== *)
2224(* Formalization of Kurzweil-Henstock gauge integral                        *)
2225(* ======================================================================== *)
2226
2227fun LE_MATCH_TAC th (asl,w) =
2228  let val thi = PART_MATCH (rand o rator) th (rand(rator w))
2229      val tm = rand(concl thi)
2230  in
2231   (MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC tm THEN CONJ_TAC THENL
2232    [MATCH_ACCEPT_TAC th, ALL_TAC]) (asl,w)
2233  end;
2234
2235(* ------------------------------------------------------------------------ *)
2236(* Some miscellaneous lemmas                                                *)
2237(* ------------------------------------------------------------------------ *)
2238(*
2239let LESS_SUC_EQ = prove(
2240  `!m n. m < SUC n = m <= n`,
2241  REPEAT GEN_TAC THEN REWRITE_TAC[CONJUNCT2 LT; LE_LT] THEN
2242  EQ_TAC THEN DISCH_THEN(DISJ_CASES_THEN(fun th -> REWRITE_TAC[th])));;
2243*)
2244(* ------------------------------------------------------------------------ *)
2245(* Divisions and tagged divisions etc.                                      *)
2246(* ------------------------------------------------------------------------ *)
2247
2248val division = new_definition("division",
2249Term`division(a,b) D =
2250     (D 0 = a) /\
2251     (?N. (!n. n < N ==> D(n) < D(SUC n)) /\
2252          (!n. n >= N ==> (D(n) = b)))`);
2253
2254val dsize = new_definition("dsize",
2255 Term`dsize D =
2256      @N. (!n. n < N ==> D(n) < D(SUC n)) /\
2257          (!n. n >= N ==> (D(n) = D(N)))`);
2258
2259val tdiv = new_definition("tdiv",
2260 Term`tdiv(a,b) (D,p) =
2261     division(a,b) D /\
2262     (!n. D(n) <= p(n) /\ p(n) <= D(SUC n))`);
2263
2264(* ------------------------------------------------------------------------ *)
2265(* Gauges and gauge-fine divisions                                          *)
2266(* ------------------------------------------------------------------------ *)
2267
2268val gauge = new_definition("gauge",
2269  Term`gauge(E) (g:real->real) = !x. E x ==> &0 < g(x)`);;
2270
2271val fine = new_definition("fine",
2272 Term`fine(g:real->real) (D,p) =
2273     !n. n < dsize D ==> D(SUC n) - D(n) < g(p(n))`);
2274
2275(* ------------------------------------------------------------------------ *)
2276(* Riemann sum                                                              *)
2277(* ------------------------------------------------------------------------ *)
2278
2279val rsum = new_definition("rsum",
2280  Term`rsum (D,(p:num->real)) f =
2281        sum(0,dsize(D))(\n. f(p n) * (D(SUC n) - D(n)))`);
2282
2283(* ------------------------------------------------------------------------ *)
2284(* Gauge integrability (definite)                                           *)
2285(* ------------------------------------------------------------------------ *)
2286
2287val Dint = new_definition("Dint",
2288 Term `Dint(a,b) f k =
2289        !e. &0 < e ==>
2290           ?g. gauge(\x. a <= x /\ x <= b) g /\
2291               !D p. tdiv(a,b) (D,p) /\ fine(g)(D,p) ==>
2292                   abs(rsum(D,p) f - k) < e`);;
2293
2294(* ------------------------------------------------------------------------ *)
2295(* Useful lemmas about the size of `trivial` divisions etc.                 *)
2296(* ------------------------------------------------------------------------ *)
2297
2298val DIVISION_0 = store_thm("DIVISION_0",
2299 Term `!a b. (a = b) ==> (dsize(\n:num. if (n = 0) then a else b) = 0)`,
2300  REPEAT GEN_TAC THEN DISCH_THEN SUBST_ALL_TAC THEN REWRITE_TAC[COND_ID] THEN
2301  REWRITE_TAC[dsize] THEN MATCH_MP_TAC SELECT_UNIQUE THEN
2302  X_GEN_TAC (Term `n:num`) THEN BETA_TAC THEN
2303  REWRITE_TAC[REAL_LT_REFL, NOT_LESS] THEN EQ_TAC THENL
2304   [DISCH_THEN(MP_TAC o SPEC (Term `0:num`)) THEN
2305     REWRITE_TAC[LESS_OR_EQ,NOT_LESS_0],
2306    DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[ZERO_LESS_EQ]]);;
2307
2308val DIVISION_1 = store_thm("DIVISION_1",
2309  Term `!a b. a < b ==> (dsize(\n. if (n = 0) then a else b) = 1)`,
2310  REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[dsize] THEN
2311  MATCH_MP_TAC SELECT_UNIQUE THEN X_GEN_TAC (Term `n:num`) THEN BETA_TAC THEN
2312  REWRITE_TAC[NOT_SUC] THEN EQ_TAC THENL
2313   [DISCH_TAC THEN MATCH_MP_TAC LESS_EQUAL_ANTISYM THEN CONJ_TAC THENL
2314     [POP_ASSUM(MP_TAC o SPEC (Term`1:num`) o CONJUNCT1) THEN
2315      REWRITE_TAC[ONE, GSYM SUC_NOT] THEN
2316      REWRITE_TAC[REAL_LT_REFL, NOT_LESS],
2317      POP_ASSUM(MP_TAC o SPEC (Term `2:num`) o CONJUNCT2) THEN
2318      REWRITE_TAC[TWO, GSYM SUC_NOT, GREATER_EQ] THEN
2319      CONV_TAC CONTRAPOS_CONV THEN
2320      REWRITE_TAC[ONE, NOT_SUC_LESS_EQ, CONJUNCT1 LE] THEN
2321      DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[NOT_SUC, NOT_IMP] THEN
2322      REWRITE_TAC[LE] THEN CONV_TAC(RAND_CONV SYM_CONV) THEN
2323      MATCH_MP_TAC REAL_LT_IMP_NE THEN POP_ASSUM ACCEPT_TAC],
2324    DISCH_THEN SUBST1_TAC THEN CONJ_TAC THENL
2325     [GEN_TAC THEN REWRITE_TAC[ONE,LESS_THM, NOT_LESS_0] THEN
2326      DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[],
2327      X_GEN_TAC (Term `n:num`) THEN REWRITE_TAC[GREATER_EQ,ONE]
2328      THEN ASM_CASES_TAC (Term `n:num = 0`) THEN
2329      ASM_REWRITE_TAC[CONJUNCT1 LE, GSYM NOT_SUC, NOT_SUC]]]);
2330
2331val LESS_1 = prove (Term`!x:num. x < 1 = (x = 0)`,
2332 INDUCT_TAC THEN
2333  REWRITE_TAC [ONE,LESS_0,LESS_MONO_EQ,NOT_LESS_0,GSYM SUC_NOT]);
2334
2335val DIVISION_SINGLE = store_thm("DIVISION_SINGLE",
2336  Term `!a b. a <= b ==> division(a,b)(\n. if (n = 0) then a else b)`,
2337  REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[division] THEN
2338  BETA_TAC THEN REWRITE_TAC[] THEN
2339  POP_ASSUM(DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT]) THENL
2340   [EXISTS_TAC (Term `1:num`) THEN CONJ_TAC THEN X_GEN_TAC (Term `n:num`) THENL
2341     [REWRITE_TAC[LESS_1] THEN DISCH_THEN SUBST1_TAC THEN
2342      ASM_REWRITE_TAC[NOT_SUC],
2343      REWRITE_TAC[GREATER_EQ] THEN
2344      COND_CASES_TAC THEN ASM_REWRITE_TAC[ONE] THEN
2345      REWRITE_TAC[LE, NOT_SUC]],
2346    EXISTS_TAC (Term `0:num`) THEN REWRITE_TAC[NOT_LESS_0] THEN
2347    ASM_REWRITE_TAC[COND_ID]]);
2348
2349val DIVISION_LHS = store_thm("DIVISION_LHS",
2350  Term `!D a b. division(a,b) D ==> (D(0) = a)`,
2351  REPEAT GEN_TAC THEN REWRITE_TAC[division] THEN
2352  DISCH_THEN(fn th => REWRITE_TAC[th]));
2353
2354val DIVISION_THM = store_thm("DIVISION_THM",
2355 Term `!D a b.
2356         division(a,b) D
2357           =
2358         (D(0) = a) /\
2359         (!n. n < (dsize D) ==> D(n) < D(SUC n)) /\
2360         (!n. n >= (dsize D) ==> (D(n) = b))`,
2361  REPEAT GEN_TAC THEN REWRITE_TAC[division] THEN
2362  EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THENL
2363   [ALL_TAC, EXISTS_TAC (Term `dsize D`) THEN ASM_REWRITE_TAC[]] THEN
2364  POP_ASSUM(X_CHOOSE_THEN (Term `N:num`) STRIP_ASSUME_TAC o CONJUNCT2) THEN
2365  SUBGOAL_THEN (Term `dsize D:num = N`) (fn th => ASM_REWRITE_TAC[th]) THEN
2366  REWRITE_TAC[dsize] THEN MATCH_MP_TAC SELECT_UNIQUE THEN
2367  X_GEN_TAC (Term `M:num`) THEN BETA_TAC THEN EQ_TAC THENL
2368   [ALL_TAC, DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[] THEN
2369    MP_TAC(SPEC (Term `N:num`) (ASSUME (Term `!n:num. n >= N ==> (D n:real = b)`)))
2370    THEN DISCH_THEN(MP_TAC o REWRITE_RULE[GREATER_EQ, LESS_EQ_REFL]) THEN
2371    DISCH_THEN SUBST1_TAC THEN FIRST_ASSUM MATCH_ACCEPT_TAC] THEN
2372  REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC
2373   (SPECL [Term `M:num`, Term `N:num`] LESS_LESS_CASES) THEN
2374  ASM_REWRITE_TAC[] THENL
2375   [DISCH_THEN(MP_TAC o SPEC (Term `SUC M`) o CONJUNCT2) THEN
2376    REWRITE_TAC[GREATER_EQ, LESS_EQ_SUC_REFL] THEN DISCH_TAC THEN
2377    UNDISCH_TAC (Term `!n:num. n < N ==> (D n) < (D(SUC n))`) THEN
2378    DISCH_THEN(MP_TAC o SPEC (Term`M:num`)) THEN ASM_REWRITE_TAC[REAL_LT_REFL],
2379    DISCH_THEN(MP_TAC o SPEC (Term`N:num`) o CONJUNCT1) THEN ASM_REWRITE_TAC[]
2380    THEN UNDISCH_TAC (Term`!n:num. n >= N ==> (D n:real = b)`) THEN
2381    DISCH_THEN(fn th => MP_TAC(SPEC (Term`N:num`) th) THEN
2382    MP_TAC(SPEC (Term`SUC N`) th)) THEN
2383    REWRITE_TAC[GREATER_EQ, LESS_EQ_SUC_REFL, LESS_EQ_REFL] THEN
2384    DISCH_THEN SUBST1_TAC THEN DISCH_THEN SUBST1_TAC THEN
2385    REWRITE_TAC[REAL_LT_REFL]]);
2386
2387val DIVISION_RHS = store_thm("DIVISION_RHS",
2388  Term`!D a b. division(a,b) D ==> (D(dsize D) = b)`,
2389  REPEAT GEN_TAC THEN REWRITE_TAC[DIVISION_THM] THEN
2390  DISCH_THEN(MP_TAC o SPEC (Term`dsize D`) o last o CONJUNCTS) THEN
2391  REWRITE_TAC[GREATER_EQ, LESS_EQ_REFL]);
2392
2393val DIVISION_LT_GEN = store_thm("DIVISION_LT_GEN",
2394Term`!D a b m n. division(a,b) D /\ m < n /\ n <= (dsize D) ==> D(m) < D(n)`,
2395  REPEAT STRIP_TAC THEN UNDISCH_TAC (Term`m:num < n`) THEN
2396  DISCH_THEN(X_CHOOSE_THEN (Term`d:num`) MP_TAC o MATCH_MP LESS_ADD_1) THEN
2397  REWRITE_TAC[GSYM ADD1] THEN DISCH_THEN SUBST_ALL_TAC THEN
2398  UNDISCH_TAC (Term `m + SUC d <= dsize D`) THEN
2399  SPEC_TAC(Term`d:num`,Term`d:num`) THEN INDUCT_TAC THENL
2400   [REWRITE_TAC[ADD_CLAUSES] THEN
2401    DISCH_THEN(MP_TAC o MATCH_MP OR_LESS) THEN
2402    RULE_ASSUM_TAC(REWRITE_RULE[DIVISION_THM]) THEN ASM_REWRITE_TAC[],
2403    REWRITE_TAC[ADD_CLAUSES] THEN
2404    DISCH_THEN(MP_TAC o MATCH_MP OR_LESS) THEN
2405    DISCH_TAC THEN MATCH_MP_TAC REAL_LT_TRANS THEN
2406    EXISTS_TAC (Term`D(m + SUC d):real`) THEN CONJ_TAC THENL
2407     [FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[ADD_CLAUSES] THEN
2408      MATCH_MP_TAC LESS_IMP_LESS_OR_EQ THEN ASM_REWRITE_TAC[],
2409      REWRITE_TAC[ADD_CLAUSES] THEN
2410      FIRST_ASSUM(MATCH_MP_TAC o el 2 o
2411        CONJUNCTS o REWRITE_RULE[DIVISION_THM]) THEN
2412      ASM_REWRITE_TAC[]]]);;
2413
2414val DIVISION_LT = store_thm("DIVISION_LT",
2415  Term`!D a b. division(a,b) D ==> !n. n < (dsize D) ==> D(0) < D(SUC n)`,
2416  REPEAT GEN_TAC THEN REWRITE_TAC[DIVISION_THM] THEN STRIP_TAC THEN
2417  INDUCT_TAC THEN DISCH_THEN(fn th => ASSUME_TAC th THEN
2418      FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN
2419  ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
2420  MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC (Term`D(SUC n):real`) THEN
2421  ASM_REWRITE_TAC[] THEN UNDISCH_TAC (Term`D(0:num):real = a`) THEN
2422  DISCH_THEN(SUBST1_TAC o SYM) THEN FIRST_ASSUM MATCH_MP_TAC THEN
2423  MATCH_MP_TAC LESS_TRANS THEN EXISTS_TAC (Term`SUC n`) THEN
2424  ASM_REWRITE_TAC[LESS_SUC_REFL]);
2425
2426val DIVISION_LE = store_thm("DIVISION_LE",
2427  Term`!D a b. division(a,b) D ==> a <= b`,
2428  REPEAT GEN_TAC THEN DISCH_TAC THEN
2429  FIRST_ASSUM(MP_TAC o MATCH_MP DIVISION_LT) THEN
2430  POP_ASSUM(STRIP_ASSUME_TAC o REWRITE_RULE[DIVISION_THM]) THEN
2431  UNDISCH_TAC (Term`D(0:num):real = a`) THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
2432  UNDISCH_TAC (Term`!n. n >= (dsize D) ==> (D n = b)`) THEN
2433  DISCH_THEN(MP_TAC o SPEC (Term`dsize D`)) THEN
2434  REWRITE_TAC[GREATER_EQ, LESS_EQ_REFL] THEN
2435  DISCH_THEN(SUBST1_TAC o SYM) THEN
2436  DISCH_THEN(MP_TAC o SPEC (Term`PRE(dsize D)`)) THEN
2437  STRUCT_CASES_TAC(SPEC (Term`dsize D`) num_CASES) THEN
2438  ASM_REWRITE_TAC[PRE, REAL_LE_REFL, LESS_SUC_REFL, REAL_LT_IMP_LE]);;
2439
2440val DIVISION_GT = store_thm("DIVISION_GT",
2441  Term`!D a b. division(a,b) D ==> !n. n < (dsize D) ==> D(n) < D(dsize D)`,
2442  REPEAT STRIP_TAC THEN MATCH_MP_TAC DIVISION_LT_GEN THEN
2443  MAP_EVERY EXISTS_TAC [Term`a:real`, Term`b:real`] THEN
2444  ASM_REWRITE_TAC[LESS_EQ_REFL]);;
2445
2446val DIVISION_EQ = store_thm("DIVISION_EQ",
2447  Term`!D a b. division(a,b) D ==> ((a = b) = (dsize D = 0))`,
2448  REPEAT GEN_TAC THEN DISCH_TAC THEN
2449  FIRST_ASSUM(MP_TAC o MATCH_MP DIVISION_LT) THEN
2450  POP_ASSUM(STRIP_ASSUME_TAC o REWRITE_RULE[DIVISION_THM]) THEN
2451  UNDISCH_TAC (Term`D(0:num):real = a`) THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
2452  UNDISCH_TAC (Term`!n. n >= (dsize D) ==> (D n = b)`) THEN
2453  DISCH_THEN(MP_TAC o SPEC (Term`dsize D`)) THEN
2454  REWRITE_TAC[GREATER_EQ, LESS_EQ_REFL] THEN
2455  DISCH_THEN(SUBST1_TAC o SYM) THEN
2456  DISCH_THEN(MP_TAC o SPEC (Term`PRE(dsize D)`)) THEN
2457  STRUCT_CASES_TAC(SPEC (Term`dsize D`) num_CASES) THEN
2458  ASM_REWRITE_TAC[PRE, NOT_SUC, LESS_SUC_REFL, REAL_LT_IMP_NE]);
2459
2460val DIVISION_LBOUND = store_thm("DIVISION_LBOUND",
2461  Term`!D a b. division(a,b) D ==> !r. a <= D(r)`,
2462  REPEAT GEN_TAC THEN REWRITE_TAC[DIVISION_THM] THEN STRIP_TAC THEN
2463  INDUCT_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN
2464  DISJ_CASES_TAC(SPECL [Term`SUC r`, Term`dsize D`] LESS_CASES) THENL
2465   [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC (Term`(D:num->real) r`) THEN
2466    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN
2467    FIRST_ASSUM MATCH_MP_TAC THEN
2468    MATCH_MP_TAC LESS_TRANS THEN EXISTS_TAC (Term`SUC r`) THEN
2469    ASM_REWRITE_TAC[LESS_SUC_REFL],
2470    MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC (Term`b:real`) THEN CONJ_TAC
2471    THENL
2472     [MATCH_MP_TAC DIVISION_LE THEN
2473      EXISTS_TAC (Term`D:num->real`) THEN ASM_REWRITE_TAC[DIVISION_THM],
2474      MATCH_MP_TAC REAL_EQ_IMP_LE THEN CONV_TAC SYM_CONV THEN
2475      FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[GREATER_EQ]]]);;
2476
2477val DIVISION_LBOUND_LT = store_thm("DIVISION_LBOUND_LT",
2478 Term`!D a b. division(a,b) D /\ ~(dsize D = 0) ==> !n. a < D(SUC n)`,
2479  REPEAT STRIP_TAC THEN
2480  FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP DIVISION_LHS) THEN
2481  DISJ_CASES_TAC(SPECL [Term`dsize D`, Term`SUC n`] LESS_CASES) THENL
2482   [FIRST_ASSUM(MP_TAC o el 3 o CONJUNCTS o REWRITE_RULE[DIVISION_THM]) THEN
2483    DISCH_THEN(MP_TAC o SPEC (Term`SUC n`)) THEN REWRITE_TAC[GREATER_EQ] THEN
2484    IMP_RES_THEN ASSUME_TAC LESS_IMP_LESS_OR_EQ THEN ASM_REWRITE_TAC[] THEN
2485    DISCH_THEN SUBST1_TAC THEN
2486    FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP DIVISION_RHS) THEN
2487    FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP DIVISION_GT) THEN
2488    ASM_REWRITE_TAC[GSYM NOT_LESS_EQUAL, CONJUNCT1 LE],
2489    FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP DIVISION_LT) THEN
2490    MATCH_MP_TAC OR_LESS THEN ASM_REWRITE_TAC[]]);;
2491
2492val DIVISION_UBOUND = store_thm("DIVISION_UBOUND",
2493 Term`!D a b. division(a,b) D ==> !r. D(r) <= b`,
2494  REPEAT GEN_TAC THEN REWRITE_TAC[DIVISION_THM] THEN STRIP_TAC THEN
2495  GEN_TAC THEN DISJ_CASES_TAC(SPECL [Term`r:num`, Term`dsize D`] LESS_CASES)
2496  THENL [ALL_TAC,
2497    MATCH_MP_TAC REAL_EQ_IMP_LE THEN FIRST_ASSUM MATCH_MP_TAC THEN
2498    ASM_REWRITE_TAC[GREATER_EQ]] THEN
2499  SUBGOAL_THEN (Term`!r. D((dsize D) - r) <= b`) MP_TAC THENL
2500   [ALL_TAC,
2501    DISCH_THEN(MP_TAC o SPEC (Term`(dsize D) - r`)) THEN
2502    MATCH_MP_TAC(TAUT_CONV (Term`(a = b) ==> a ==> b`)) THEN
2503    AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
2504    FIRST_ASSUM(fn th => REWRITE_TAC[MATCH_MP SUB_SUB
2505         (MATCH_MP LESS_IMP_LESS_OR_EQ th)])
2506    THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB]] THEN
2507  UNDISCH_TAC (Term`r < dsize D`) THEN DISCH_THEN(K ALL_TAC) THEN
2508  INDUCT_TAC THENL
2509   [REWRITE_TAC[SUB_0] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN
2510    FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[GREATER_EQ, LESS_EQ_REFL],
2511    ALL_TAC] THEN
2512  DISJ_CASES_TAC(SPECL [Term`r:num`, Term`dsize D`] LESS_CASES) THENL
2513   [ALL_TAC,
2514    SUBGOAL_THEN (Term`(dsize D) - (SUC r) = 0`) SUBST1_TAC THENL
2515     [REWRITE_TAC[SUB_EQ_0] THEN MATCH_MP_TAC LESS_EQ_TRANS THEN
2516      EXISTS_TAC (Term`r:num`) THEN ASM_REWRITE_TAC[LESS_EQ_SUC_REFL],
2517      ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIVISION_LE THEN
2518      EXISTS_TAC (Term`D:num->real`) THEN ASM_REWRITE_TAC[DIVISION_THM]]] THEN
2519  MATCH_MP_TAC REAL_LE_TRANS THEN
2520  EXISTS_TAC (Term`D((dsize D) - r):real`) THEN ASM_REWRITE_TAC[] THEN
2521  SUBGOAL_THEN (Term`(dsize D) - r = SUC((dsize D) - (SUC r))`)
2522  SUBST1_TAC THENL
2523   [ALL_TAC,
2524    MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_ASSUM MATCH_MP_TAC THEN
2525    MATCH_MP_TAC LESS_CASES_IMP THEN
2526    REWRITE_TAC[NOT_LESS, SUB_LESS_EQ] THEN
2527    CONV_TAC(RAND_CONV SYM_CONV) THEN
2528    REWRITE_TAC[SUB_EQ_EQ_0, NOT_SUC] THEN
2529    DISCH_THEN SUBST_ALL_TAC THEN
2530    UNDISCH_TAC (Term`r:num < 0`) THEN REWRITE_TAC[NOT_LESS_0]] THEN
2531  MP_TAC(SPECL [Term`dsize D`, Term`SUC r`] (CONJUNCT2 SUB)) THEN
2532  COND_CASES_TAC THENL
2533   [REWRITE_TAC[SUB_EQ_0, LESS_EQ_MONO] THEN
2534    ASM_REWRITE_TAC[GSYM NOT_LESS],
2535    DISCH_THEN (SUBST1_TAC o SYM) THEN REWRITE_TAC[SUB_MONO_EQ]]);
2536
2537val DIVISION_UBOUND_LT = store_thm("DIVISION_UBOUND_LT",
2538 Term`!D a b n. division(a,b) D /\ n < dsize D ==> D(n) < b`,
2539  REPEAT STRIP_TAC THEN
2540  FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP DIVISION_RHS) THEN
2541  FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP DIVISION_GT) THEN
2542  ASM_REWRITE_TAC[]);
2543
2544(* ------------------------------------------------------------------------ *)
2545(* Divisions of adjacent intervals can be combined into one                 *)
2546(* ------------------------------------------------------------------------ *)
2547
2548val D_tm = Term`\n. if n < dsize D1 then D1(n) else D2(n - dsize D1)`
2549and p_tm = Term`\n. if n < dsize D1 then (p1:num->real)(n) else p2(n - dsize D1)`;
2550
2551val DIVISION_APPEND_LEMMA1 = prove(
2552 Term `!a b c D1 D2.
2553   division(a,b) D1 /\ division(b,c) D2
2554    ==>
2555    (!n. n < dsize D1 + dsize D2
2556         ==>
2557         (\n. if n < dsize D1 then D1(n) else D2(n - dsize D1)) (n)
2558            <
2559         (\n. if n < dsize D1 then D1(n) else D2(n - dsize D1)) (SUC n)) /\
2560    (!n. n >= dsize D1 + dsize D2
2561         ==>
2562         ((\n. if n<dsize D1 then D1(n) else D2(n - dsize D1)) (n)
2563           =
2564          (\n. if n<dsize D1 then D1(n) else D2(n - dsize D1)) (dsize D1 + dsize D2)))`,
2565  REPEAT GEN_TAC THEN STRIP_TAC THEN CONJ_TAC THEN
2566  X_GEN_TAC (Term`n:num`) THEN DISCH_TAC THEN BETA_TAC THENL
2567   [ASM_CASES_TAC (Term`SUC n < dsize D1`) THEN ASM_REWRITE_TAC[] THENL
2568     [SUBGOAL_THEN (Term`n < dsize D1`) ASSUME_TAC THEN
2569      ASM_REWRITE_TAC[] THENL
2570       [MATCH_MP_TAC LESS_TRANS THEN EXISTS_TAC (Term`SUC n`) THEN
2571        ASM_REWRITE_TAC[LESS_SUC_REFL],
2572        UNDISCH_TAC (Term`division(a,b) D1`) THEN REWRITE_TAC[DIVISION_THM] THEN
2573        STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN
2574        FIRST_ASSUM ACCEPT_TAC],
2575      ASM_CASES_TAC (Term`n < dsize D1`) THEN ASM_REWRITE_TAC[] THENL
2576       [RULE_ASSUM_TAC(REWRITE_RULE[NOT_LESS]) THEN
2577        MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC (Term`b:real`) THEN
2578        CONJ_TAC THENL
2579         [MATCH_MP_TAC DIVISION_UBOUND_LT THEN
2580          EXISTS_TAC (Term`a:real`) THEN ASM_REWRITE_TAC[],
2581          MATCH_MP_TAC DIVISION_LBOUND THEN
2582          EXISTS_TAC (Term`c:real`) THEN ASM_REWRITE_TAC[]],
2583        UNDISCH_TAC (Term`~(n < dsize D1)`) THEN
2584        REWRITE_TAC[NOT_LESS] THEN
2585        DISCH_THEN(X_CHOOSE_THEN (Term`d:num`) SUBST_ALL_TAC o
2586          REWRITE_RULE[LESS_EQ_EXISTS]) THEN
2587        REWRITE_TAC[SUB, GSYM NOT_LESS_EQUAL, LESS_EQ_ADD] THEN
2588        ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN
2589        FIRST_ASSUM(MATCH_MP_TAC o Lib.trye el 2 o CONJUNCTS o
2590          REWRITE_RULE[DIVISION_THM]) THEN
2591        UNDISCH_TAC (Term`dsize D1 + d < dsize D1 + dsize D2`) THEN
2592        ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[LESS_MONO_ADD_EQ]]],
2593    REWRITE_TAC[GSYM NOT_LESS_EQUAL, LESS_EQ_ADD] THEN
2594    ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN
2595    REWRITE_TAC[NOT_LESS_EQUAL] THEN COND_CASES_TAC THEN
2596    UNDISCH_TAC (Term`n >= dsize D1 + dsize D2`) THENL
2597     [CONV_TAC CONTRAPOS_CONV THEN DISCH_TAC THEN
2598      REWRITE_TAC[GREATER_EQ, NOT_LESS_EQUAL] THEN
2599      MATCH_MP_TAC LESS_IMP_LESS_ADD THEN ASM_REWRITE_TAC[],
2600      REWRITE_TAC[GREATER_EQ, LESS_EQ_EXISTS] THEN
2601      DISCH_THEN(X_CHOOSE_THEN (Term`d:num`) SUBST_ALL_TAC) THEN
2602      REWRITE_TAC[GSYM ADD_ASSOC] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN
2603      REWRITE_TAC[ADD_SUB] THEN
2604      FIRST_ASSUM(CHANGED_TAC o
2605       (SUBST1_TAC o MATCH_MP DIVISION_RHS)) THEN
2606      FIRST_ASSUM(MATCH_MP_TAC o el 3 o CONJUNCTS o
2607        REWRITE_RULE[DIVISION_THM]) THEN
2608      REWRITE_TAC[GREATER_EQ, LESS_EQ_ADD]]]);
2609
2610val DIVISION_APPEND_LEMMA2 = prove(
2611 Term`!a b c D1 D2.
2612    division(a,b) D1 /\ division(b,c) D2
2613      ==>
2614      (dsize(\n. if n < dsize D1 then D1(n) else D2(n - dsize D1))
2615         =
2616       dsize D1 + dsize D2)`,
2617  REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [] [dsize] THEN
2618  MATCH_MP_TAC SELECT_UNIQUE THEN
2619  X_GEN_TAC (Term`N:num`) THEN BETA_TAC THEN EQ_TAC THENL
2620   [DISCH_THEN(curry op THEN (MATCH_MP_TAC LESS_EQUAL_ANTISYM) o MP_TAC) THEN
2621    CONV_TAC CONTRAPOS_CONV THEN
2622    REWRITE_TAC[DE_MORGAN_THM, NOT_LESS_EQUAL] THEN
2623    DISCH_THEN DISJ_CASES_TAC THENL
2624     [DISJ1_TAC THEN
2625      DISCH_THEN(MP_TAC o SPEC (Term`dsize D1 + dsize D2`)) THEN
2626      ASM_REWRITE_TAC[] THEN
2627      REWRITE_TAC[GSYM NOT_LESS_EQUAL, LESS_EQ_ADD] THEN
2628      SUBGOAL_THEN (Term`!x y. x <= SUC(x + y)`) ASSUME_TAC THENL
2629       [REPEAT GEN_TAC THEN MATCH_MP_TAC LESS_EQ_TRANS THEN
2630        EXISTS_TAC (Term`(x:num) + y`) THEN
2631        REWRITE_TAC[LESS_EQ_ADD, LESS_EQ_SUC_REFL], ALL_TAC] THEN
2632      ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUB, GSYM NOT_LESS_EQUAL] THEN
2633      REWRITE_TAC[LESS_EQ_ADD] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN
2634      REWRITE_TAC[ADD_SUB] THEN
2635      MP_TAC(ASSUME (Term`division(b,c) D2`)) THEN REWRITE_TAC[DIVISION_THM]
2636      THEN DISCH_THEN(MP_TAC o SPEC (Term`SUC(dsize D2)`) o el 3 o CONJUNCTS)
2637      THEN REWRITE_TAC[GREATER_EQ, LESS_EQ_SUC_REFL] THEN
2638      DISCH_THEN SUBST1_TAC THEN
2639      FIRST_ASSUM(CHANGED_TAC o SUBST1_TAC o MATCH_MP DIVISION_RHS) THEN
2640      REWRITE_TAC[REAL_LT_REFL],
2641      DISJ2_TAC THEN
2642      DISCH_THEN(MP_TAC o SPEC (Term`dsize D1 + dsize D2`)) THEN
2643      FIRST_ASSUM(ASSUME_TAC o MATCH_MP LESS_IMP_LESS_OR_EQ) THEN
2644      ASM_REWRITE_TAC[GREATER_EQ] THEN
2645      REWRITE_TAC[GSYM NOT_LESS_EQUAL, LESS_EQ_ADD] THEN
2646      ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN
2647      COND_CASES_TAC THENL
2648       [SUBGOAL_THEN (Term`D1(N:num) < D2(dsize D2)`) MP_TAC THENL
2649         [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC (Term`b:real`) THEN
2650          CONJ_TAC THENL
2651           [MATCH_MP_TAC DIVISION_UBOUND_LT THEN EXISTS_TAC (Term`a:real`) THEN
2652            ASM_REWRITE_TAC[GSYM NOT_LESS_EQUAL],
2653            MATCH_MP_TAC DIVISION_LBOUND THEN
2654            EXISTS_TAC (Term`c:real`) THEN ASM_REWRITE_TAC[]],
2655          CONV_TAC CONTRAPOS_CONV THEN ASM_REWRITE_TAC[] THEN
2656          DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_LT_REFL]],
2657        RULE_ASSUM_TAC(REWRITE_RULE[]) THEN
2658        SUBGOAL_THEN (Term`D2(N - dsize D1) < D2(dsize D2)`) MP_TAC THENL
2659         [MATCH_MP_TAC DIVISION_LT_GEN THEN
2660          MAP_EVERY EXISTS_TAC [Term`b:real`, Term`c:real`] THEN
2661          ASM_REWRITE_TAC[LESS_EQ_REFL] THEN
2662          REWRITE_TAC[GSYM NOT_LESS_EQUAL] THEN
2663          REWRITE_TAC[SUB_LEFT_LESS_EQ, DE_MORGAN_THM] THEN
2664          ONCE_REWRITE_TAC[ADD_SYM] THEN ASM_REWRITE_TAC[NOT_LESS_EQUAL] THEN
2665          UNDISCH_TAC (Term`dsize(D1) <= N`) THEN
2666          REWRITE_TAC[LESS_EQ_EXISTS] THEN
2667          DISCH_THEN(X_CHOOSE_THEN (Term`d:num`) SUBST_ALL_TAC) THEN
2668          RULE_ASSUM_TAC(ONCE_REWRITE_RULE[ADD_SYM]) THEN
2669          RULE_ASSUM_TAC(REWRITE_RULE[LESS_MONO_ADD_EQ]) THEN
2670          MATCH_MP_TAC LESS_EQ_LESS_TRANS THEN EXISTS_TAC (Term`d:num`) THEN
2671          ASM_REWRITE_TAC[ZERO_LESS_EQ],
2672          CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[] THEN
2673          DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_LT_REFL]]]],
2674  DISCH_THEN SUBST1_TAC THEN CONJ_TAC THENL
2675   [X_GEN_TAC (Term`n:num`) THEN DISCH_TAC THEN
2676    ASM_CASES_TAC (Term`SUC n < dsize D1`) THEN
2677    ASM_REWRITE_TAC[] THENL
2678     [SUBGOAL_THEN (Term`n < dsize D1`) ASSUME_TAC THENL
2679       [MATCH_MP_TAC LESS_TRANS THEN EXISTS_TAC (Term`SUC n`) THEN
2680        ASM_REWRITE_TAC[LESS_SUC_REFL], ALL_TAC] THEN
2681      ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIVISION_LT_GEN THEN
2682      MAP_EVERY EXISTS_TAC [Term`a:real`, Term`b:real`] THEN
2683      ASM_REWRITE_TAC[LESS_SUC_REFL] THEN
2684      MATCH_MP_TAC LESS_IMP_LESS_OR_EQ THEN ASM_REWRITE_TAC[],
2685      COND_CASES_TAC THENL
2686       [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC (Term`b:real`) THEN
2687        CONJ_TAC THENL
2688         [MATCH_MP_TAC DIVISION_UBOUND_LT THEN EXISTS_TAC (Term`a:real`) THEN
2689          ASM_REWRITE_TAC[],
2690          FIRST_ASSUM(MATCH_ACCEPT_TAC o MATCH_MP DIVISION_LBOUND)],
2691        MATCH_MP_TAC DIVISION_LT_GEN THEN
2692        MAP_EVERY EXISTS_TAC [Term`b:real`, Term`c:real`] THEN
2693        ASM_REWRITE_TAC[] THEN
2694        CONJ_TAC THENL [ASM_REWRITE_TAC[SUB, LESS_SUC_REFL], ALL_TAC] THEN
2695        REWRITE_TAC[REWRITE_RULE[GREATER_EQ] SUB_LEFT_GREATER_EQ] THEN
2696        ONCE_REWRITE_TAC[ADD_SYM] THEN ASM_REWRITE_TAC[GSYM LESS_EQ]]],
2697    X_GEN_TAC (Term`n:num`) THEN REWRITE_TAC[GREATER_EQ] THEN DISCH_TAC THEN
2698    REWRITE_TAC[GSYM NOT_LESS_EQUAL,LESS_EQ_ADD] THEN
2699    SUBGOAL_THEN (Term`dsize D1 <= n`) ASSUME_TAC THENL
2700     [MATCH_MP_TAC LESS_EQ_TRANS THEN
2701      EXISTS_TAC (Term `dsize D1 + dsize D2`) THEN
2702      ASM_REWRITE_TAC[LESS_EQ_ADD],
2703      ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN
2704      REWRITE_TAC[ADD_SUB] THEN
2705      FIRST_ASSUM(CHANGED_TAC o SUBST1_TAC o MATCH_MP DIVISION_RHS) THEN
2706      FIRST_ASSUM(MATCH_MP_TAC o el 3 o
2707        CONJUNCTS o REWRITE_RULE[DIVISION_THM]) THEN
2708      REWRITE_TAC[GREATER_EQ, SUB_LEFT_LESS_EQ] THEN
2709      ONCE_REWRITE_TAC[ADD_SYM] THEN ASM_REWRITE_TAC[]]]]);
2710
2711val DIVISION_APPEND = store_thm("DIVISION_APPEND",
2712  Term`!a b c.
2713      (?D1 p1. tdiv(a,b) (D1,p1) /\ fine(g) (D1,p1)) /\
2714      (?D2 p2. tdiv(b,c) (D2,p2) /\ fine(g) (D2,p2)) ==>
2715        ?D p. tdiv(a,c) (D,p) /\ fine(g) (D,p)`,
2716  REPEAT STRIP_TAC THEN MAP_EVERY EXISTS_TAC [D_tm, p_tm] THEN
2717  DISJ_CASES_TAC(GSYM (SPEC (Term`dsize(D1)`) LESS_0_CASES)) THENL
2718   [ASM_REWRITE_TAC[NOT_LESS_0, SUB_0] THEN
2719    CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN
2720    SUBGOAL_THEN (Term`a:real = b`) (fn th => ASM_REWRITE_TAC[th]) THEN
2721    MP_TAC(SPECL [Term`D1:num->real`, Term`a:real`,Term`b:real`] DIVISION_EQ)
2722    THEN RULE_ASSUM_TAC(REWRITE_RULE[tdiv]) THEN ASM_REWRITE_TAC[], ALL_TAC]
2723  THEN CONJ_TAC THENL
2724   [ALL_TAC,
2725    REWRITE_TAC[fine] THEN X_GEN_TAC (Term`n:num`) THEN
2726    RULE_ASSUM_TAC(REWRITE_RULE[tdiv]) THEN
2727    MP_TAC(SPECL [Term`a:real`, Term`b:real`, Term`c:real`,
2728                  Term`D1:num->real`, Term`D2:num->real`]
2729           DIVISION_APPEND_LEMMA2) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
2730    ASM_REWRITE_TAC[] THEN BETA_TAC THEN DISCH_TAC THEN
2731    ASM_CASES_TAC (Term`SUC n < dsize D1`) THEN ASM_REWRITE_TAC[] THENL
2732     [SUBGOAL_THEN (Term`n < dsize D1`) ASSUME_TAC THENL
2733       [MATCH_MP_TAC LESS_TRANS THEN EXISTS_TAC (Term`SUC n`) THEN
2734        ASM_REWRITE_TAC[LESS_SUC_REFL], ALL_TAC] THEN
2735      ASM_REWRITE_TAC[] THEN
2736      FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[fine]) THEN
2737      ASM_REWRITE_TAC[], ALL_TAC] THEN
2738    ASM_CASES_TAC (Term`n < dsize D1`) THEN ASM_REWRITE_TAC[] THENL
2739     [SUBGOAL_THEN (Term`SUC n = dsize D1`) ASSUME_TAC THENL
2740       [MATCH_MP_TAC LESS_EQUAL_ANTISYM THEN
2741        ASM_REWRITE_TAC[GSYM NOT_LESS] THEN
2742        REWRITE_TAC[NOT_LESS] THEN MATCH_MP_TAC LESS_OR THEN
2743        ASM_REWRITE_TAC[],
2744        ASM_REWRITE_TAC[SUB_EQUAL_0] THEN
2745        FIRST_ASSUM(CHANGED_TAC o SUBST1_TAC o MATCH_MP DIVISION_LHS o
2746          CONJUNCT1) THEN
2747        FIRST_ASSUM(CHANGED_TAC o SUBST1_TAC o SYM o
2748          MATCH_MP DIVISION_RHS o  CONJUNCT1) THEN
2749        SUBST1_TAC(SYM(ASSUME (Term`SUC n = dsize D1`))) THEN
2750        FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[fine]) THEN
2751        ASM_REWRITE_TAC[]],
2752      ASM_REWRITE_TAC[SUB] THEN UNDISCH_TAC (Term`~(n < (dsize D1))`) THEN
2753      REWRITE_TAC[LESS_EQ_EXISTS, NOT_LESS] THEN
2754      DISCH_THEN(X_CHOOSE_THEN (Term`d:num`) SUBST_ALL_TAC) THEN
2755      ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN
2756      FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[fine]) THEN
2757      RULE_ASSUM_TAC(ONCE_REWRITE_RULE[ADD_SYM]) THEN
2758      RULE_ASSUM_TAC(REWRITE_RULE[LESS_MONO_ADD_EQ]) THEN
2759      FIRST_ASSUM ACCEPT_TAC]] THEN
2760  REWRITE_TAC[tdiv] THEN BETA_TAC THEN CONJ_TAC THENL
2761   [RULE_ASSUM_TAC(REWRITE_RULE[tdiv]) THEN
2762    REWRITE_TAC[DIVISION_THM] THEN CONJ_TAC THENL
2763     [BETA_TAC THEN ASM_REWRITE_TAC[] THEN
2764      MATCH_MP_TAC DIVISION_LHS THEN EXISTS_TAC (Term`b:real`) THEN
2765      ASM_REWRITE_TAC[], ALL_TAC] THEN
2766    SUBGOAL_THEN (Term`c = (\n. if n < dsize D1 then D1(n) else D2(n - dsize D1))
2767                           (dsize D1 + dsize D2)`) SUBST1_TAC THENL
2768     [BETA_TAC THEN REWRITE_TAC[GSYM NOT_LESS_EQUAL, LESS_EQ_ADD] THEN
2769      ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN
2770      CONV_TAC SYM_CONV THEN MATCH_MP_TAC DIVISION_RHS THEN
2771      EXISTS_TAC (Term`b:real`) THEN ASM_REWRITE_TAC[], ALL_TAC] THEN
2772    MP_TAC(SPECL [Term`a:real`, Term`b:real`, Term`c:real`,
2773                  Term`D1:num->real`, Term`D2:num->real`]
2774            DIVISION_APPEND_LEMMA2) THEN ASM_REWRITE_TAC[] THEN
2775    DISCH_THEN(fn th => REWRITE_TAC[th]) THEN
2776    MATCH_MP_TAC DIVISION_APPEND_LEMMA1 THEN
2777    MAP_EVERY EXISTS_TAC [Term`a:real`, Term`b:real`, Term`c:real`] THEN
2778    ASM_REWRITE_TAC[], ALL_TAC] THEN
2779  X_GEN_TAC (Term`n:num`) THEN RULE_ASSUM_TAC(REWRITE_RULE[tdiv]) THEN
2780  ASM_CASES_TAC (Term`SUC n < dsize D1`) THEN ASM_REWRITE_TAC[] THENL
2781   [SUBGOAL_THEN (Term`n < dsize D1`) ASSUME_TAC THENL
2782     [MATCH_MP_TAC LESS_TRANS THEN EXISTS_TAC (Term`SUC n`) THEN
2783      ASM_REWRITE_TAC[LESS_SUC_REFL], ALL_TAC] THEN
2784    ASM_REWRITE_TAC[], ALL_TAC] THEN
2785  COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL
2786   [ASM_REWRITE_TAC[SUB] THEN
2787    FIRST_ASSUM(CHANGED_TAC o SUBST1_TAC o MATCH_MP DIVISION_LHS o
2788      CONJUNCT1) THEN
2789    FIRST_ASSUM(CHANGED_TAC o SUBST1_TAC o SYM o
2790      MATCH_MP DIVISION_RHS o  CONJUNCT1) THEN
2791    SUBGOAL_THEN (Term`dsize D1 = SUC n`) (fn th => ASM_REWRITE_TAC[th]) THEN
2792    MATCH_MP_TAC LESS_EQUAL_ANTISYM THEN
2793    ASM_REWRITE_TAC[GSYM NOT_LESS] THEN REWRITE_TAC[NOT_LESS] THEN
2794    MATCH_MP_TAC LESS_OR THEN ASM_REWRITE_TAC[],
2795    ASM_REWRITE_TAC[SUB]]);
2796
2797(* ------------------------------------------------------------------------ *)
2798(* We can always find a division which is fine wrt any gauge                *)
2799(* ------------------------------------------------------------------------ *)
2800
2801val DIVISION_EXISTS = store_thm("DIVISION_EXISTS",
2802 Term `!a b g. a <= b /\ gauge(\x. a <= x /\ x <= b) g
2803                ==>
2804                ?D p. tdiv(a,b) (D,p) /\ fine(g) (D,p)`,
2805  REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
2806  (MP_TAC o C SPEC BOLZANO_LEMMA)
2807    (Term `\(u,v). a <= u /\ v <= b
2808                   ==> ?D p. tdiv(u,v) (D,p) /\ fine(g) (D,p)`) THEN
2809  CONV_TAC(ONCE_DEPTH_CONV PAIRED_BETA_CONV) THEN
2810  W(C SUBGOAL_THEN (fn t => REWRITE_TAC[t]) o
2811  funpow 2 (fst o dest_imp) o snd) THENL
2812   [CONJ_TAC,
2813    DISCH_THEN(MP_TAC o SPECL [Term`a:real`, Term`b:real`]) THEN
2814    REWRITE_TAC[REAL_LE_REFL]]
2815  THENL
2816   [MAP_EVERY X_GEN_TAC [Term`u:real`, Term`v:real`, Term`w:real`] THEN
2817    REPEAT STRIP_TAC THEN MATCH_MP_TAC DIVISION_APPEND THEN
2818    EXISTS_TAC (Term`v:real`) THEN CONJ_TAC THEN
2819    FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THENL
2820     [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC (Term`w:real`),
2821      MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC (Term`u:real`)] THEN
2822    ASM_REWRITE_TAC[], ALL_TAC] THEN
2823  X_GEN_TAC (Term`x:real`) THEN ASM_CASES_TAC (Term`a <= x /\ x <= b`) THENL
2824   [ALL_TAC,
2825    EXISTS_TAC (Term`&1`) THEN REWRITE_TAC[REAL_LT_01] THEN
2826    MAP_EVERY X_GEN_TAC [Term`w:real`, Term`y:real`] THEN STRIP_TAC THEN
2827    CONV_TAC CONTRAPOS_CONV THEN DISCH_THEN(K ALL_TAC) THEN
2828    FIRST_ASSUM(UNDISCH_TAC o assert is_neg o concl) THEN
2829    REWRITE_TAC[DE_MORGAN_THM, REAL_NOT_LE] THEN
2830    DISCH_THEN DISJ_CASES_TAC THENL
2831     [DISJ1_TAC THEN MATCH_MP_TAC REAL_LET_TRANS,
2832      DISJ2_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS] THEN
2833    EXISTS_TAC (Term`x:real`) THEN ASM_REWRITE_TAC[]] THEN
2834  UNDISCH_TAC (Term`gauge(\x. a <= x /\ x <= b) g`) THEN
2835  REWRITE_TAC[gauge] THEN BETA_TAC THEN
2836  DISCH_THEN(fn th => FIRST_ASSUM(ASSUME_TAC o MATCH_MP th)) THEN
2837  EXISTS_TAC (Term`(g:real->real) x`) THEN ASM_REWRITE_TAC[] THEN
2838  MAP_EVERY X_GEN_TAC [Term`w:real`, Term`y:real`] THEN REPEAT STRIP_TAC THEN
2839  EXISTS_TAC (Term`\n:num. if (n = 0) then (w:real) else y`) THEN
2840  EXISTS_TAC (Term`\n:num. if (n = 0) then (x:real) else y`) THEN
2841  SUBGOAL_THEN (Term`w <= y`) ASSUME_TAC THENL
2842   [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC (Term`x:real`) THEN
2843    ASM_REWRITE_TAC[], ALL_TAC] THEN
2844  CONJ_TAC THENL
2845   [REWRITE_TAC[tdiv] THEN CONJ_TAC THENL
2846     [MATCH_MP_TAC DIVISION_SINGLE THEN FIRST_ASSUM ACCEPT_TAC,
2847      X_GEN_TAC (Term`n:num`) THEN BETA_TAC THEN REWRITE_TAC[NOT_SUC] THEN
2848      COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL]],
2849    REWRITE_TAC[fine] THEN BETA_TAC THEN REWRITE_TAC[NOT_SUC] THEN
2850    X_GEN_TAC (Term`n:num`) THEN
2851    DISJ_CASES_THEN MP_TAC (REWRITE_RULE[REAL_LE_LT] (ASSUME(Term`w <= y`)))
2852    THENL
2853     [DISCH_THEN(ASSUME_TAC o MATCH_MP DIVISION_1) THEN
2854      ASM_REWRITE_TAC[num_CONV (Term`1:num`), LESS_THM, NOT_LESS_0] THEN
2855      DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[],
2856      DISCH_THEN(SUBST1_TAC o MATCH_MP DIVISION_0) THEN
2857      REWRITE_TAC[NOT_LESS_0]]]);
2858
2859(* ------------------------------------------------------------------------ *)
2860(* Lemmas about combining gauges                                            *)
2861(* ------------------------------------------------------------------------ *)
2862
2863val GAUGE_MIN = store_thm("GAUGE_MIN",
2864  Term`!E g1 g2. gauge(E) g1 /\ gauge(E) g2 ==>
2865        gauge(E) (\x. if g1(x) < g2(x) then g1(x) else g2(x))`,
2866  REPEAT GEN_TAC THEN REWRITE_TAC[gauge] THEN STRIP_TAC THEN
2867  X_GEN_TAC (Term`x:real`) THEN BETA_TAC THEN DISCH_TAC THEN
2868  COND_CASES_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN
2869  FIRST_ASSUM ACCEPT_TAC);;
2870
2871val FINE_MIN = store_thm("FINE_MIN",
2872  Term`!g1 g2 D p.
2873        fine (\x. if g1(x) < g2(x) then g1(x) else g2(x)) (D,p) ==>
2874        fine(g1) (D,p) /\ fine(g2) (D,p)`,
2875  REPEAT GEN_TAC THEN REWRITE_TAC[fine] THEN
2876  BETA_TAC THEN DISCH_TAC THEN CONJ_TAC THEN
2877  X_GEN_TAC (Term`n:num`) THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN
2878  COND_CASES_TAC THEN REWRITE_TAC[] THEN DISCH_TAC THENL
2879   [RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LT]) THEN
2880    MATCH_MP_TAC REAL_LTE_TRANS,
2881    MATCH_MP_TAC REAL_LT_TRANS] THEN
2882  FIRST_ASSUM(fn th => EXISTS_TAC(rand(concl th)) THEN
2883                   ASM_REWRITE_TAC[] THEN NO_TAC));;
2884
2885(* ------------------------------------------------------------------------ *)
2886(* The integral is unique if it exists                                      *)
2887(* ------------------------------------------------------------------------ *)
2888
2889val DINT_UNIQ = store_thm("DINT_UNIQ",
2890 Term`!a b f k1 k2.
2891        a <= b /\ Dint(a,b) f k1 /\ Dint(a,b) f k2 ==> (k1 = k2)`,
2892  REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
2893  GEN_REWRITE_TAC RAND_CONV [] [GSYM REAL_SUB_0] THEN
2894  CONV_TAC CONTRAPOS_CONV THEN ONCE_REWRITE_TAC[ABS_NZ] THEN DISCH_TAC THEN
2895  REWRITE_TAC[Dint] THEN
2896  DISCH_THEN(CONJUNCTS_THEN(MP_TAC o SPEC (Term`abs(k1 - k2) / &2`))) THEN
2897  ASM_REWRITE_TAC[REAL_LT_HALF1] THEN
2898  DISCH_THEN(X_CHOOSE_THEN (Term`g1:real->real`) STRIP_ASSUME_TAC) THEN
2899  DISCH_THEN(X_CHOOSE_THEN (Term`g2:real->real`) STRIP_ASSUME_TAC) THEN
2900  MP_TAC(SPECL [Term`\x. a <= x /\ x <= b`,
2901                Term`g1:real->real`, Term`g2:real->real`] GAUGE_MIN) THEN
2902  ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
2903  MP_TAC(SPECL [Term`a:real`, Term`b:real`,
2904                Term`\x:real. if g1(x) < g2(x) then g1(x) else g2(x)`]
2905         DIVISION_EXISTS) THEN ASM_REWRITE_TAC[] THEN
2906  DISCH_THEN(X_CHOOSE_THEN (Term`D:num->real`)
2907     (X_CHOOSE_THEN(Term`p:num->real`) STRIP_ASSUME_TAC)) THEN
2908  FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP FINE_MIN) THEN
2909  REPEAT(FIRST_ASSUM(UNDISCH_TAC o assert is_forall o concl) THEN
2910    DISCH_THEN(MP_TAC o SPECL [Term`D:num->real`, Term`p:num->real`]) THEN
2911    ASM_REWRITE_TAC[] THEN DISCH_TAC) THEN
2912  SUBGOAL_THEN (Term`abs((rsum(D,p) f - k2) - (rsum(D,p) f - k1))
2913                     < abs(k1 - k2)`) MP_TAC THENL
2914   [MATCH_MP_TAC REAL_LET_TRANS THEN
2915    EXISTS_TAC (Term`abs(rsum(D,p) f - k2) + abs(rsum(D,p) f - k1)`) THEN
2916    CONJ_TAC THENL
2917     [GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [] [real_sub] THEN
2918      GEN_REWRITE_TAC (funpow 2 RAND_CONV) [] [GSYM ABS_NEG] THEN
2919      MATCH_ACCEPT_TAC ABS_TRIANGLE,
2920      GEN_REWRITE_TAC RAND_CONV [] [GSYM REAL_HALF_DOUBLE] THEN
2921      MATCH_MP_TAC REAL_LT_ADD2 THEN ASM_REWRITE_TAC[]],
2922    REWRITE_TAC[real_sub, REAL_NEG_ADD, REAL_NEG_SUB] THEN
2923    ONCE_REWRITE_TAC[AC (REAL_ADD_ASSOC,REAL_ADD_SYM)
2924      (Term`(a + b) + (c + d) = (d + a) + (c + b)`)] THEN
2925    REWRITE_TAC[REAL_ADD_LINV, REAL_ADD_LID, REAL_LT_REFL]]);
2926
2927(* ------------------------------------------------------------------------ *)
2928(* Integral over a null interval is 0                                       *)
2929(* ------------------------------------------------------------------------ *)
2930
2931val INTEGRAL_NULL = store_thm("INTEGRAL_NULL",
2932  Term`!f a. Dint(a,a) f (&0)`,
2933  REPEAT GEN_TAC THEN REWRITE_TAC[Dint] THEN GEN_TAC THEN
2934  DISCH_TAC THEN EXISTS_TAC (Term`\x:real. &1`) THEN
2935  REWRITE_TAC[gauge, REAL_LT_01] THEN REPEAT GEN_TAC THEN
2936  REWRITE_TAC[tdiv] THEN STRIP_TAC THEN
2937  FIRST_ASSUM(MP_TAC o MATCH_MP DIVISION_EQ) THEN
2938  REWRITE_TAC[rsum] THEN DISCH_THEN SUBST1_TAC THEN
2939  ASM_REWRITE_TAC[sum, REAL_SUB_REFL, ABS_0]);;
2940
2941(* ------------------------------------------------------------------------ *)
2942(* Fundamental theorem of calculus (Part I)                                 *)
2943(* ------------------------------------------------------------------------ *)
2944
2945val STRADDLE_LEMMA = prove(
2946 Term
2947  `!f f' a b e. (!x. a <= x /\ x <= b ==> (f diffl f'(x))(x)) /\ &0 < e
2948    ==> ?g. gauge(\x. a <= x /\ x <= b) g /\
2949            !x u v. a <= u /\ u <= x /\
2950                    x <= v /\ v <= b /\ (v - u) < g(x)
2951                ==> abs((f(v) - f(u)) - (f'(x) * (v - u)))
2952                    <= e * (v - u)`,
2953  REPEAT STRIP_TAC THEN REWRITE_TAC[gauge] THEN BETA_TAC THEN
2954  SUBGOAL_THEN
2955   (Term`!x. a <= x /\ x <= b ==>
2956        ?d. &0 < d /\
2957          !u v. u <= x /\ x <= v /\ (v - u) < d
2958                ==>
2959               abs((f(v) - f(u)) - (f'(x) * (v - u)))
2960               <= e * (v - u)`) MP_TAC THENL
2961   [ALL_TAC,
2962    FIRST_ASSUM(UNDISCH_TAC o assert is_forall o concl) THEN
2963    DISCH_THEN(K ALL_TAC) THEN
2964    DISCH_THEN(MP_TAC o CONV_RULE
2965      ((ONCE_DEPTH_CONV RIGHT_IMP_EXISTS_CONV) THENC SKOLEM_CONV)) THEN
2966    DISCH_THEN(X_CHOOSE_THEN (Term`g:real->real`) STRIP_ASSUME_TAC) THEN
2967    EXISTS_TAC (Term`g:real->real`) THEN CONJ_TAC THENL
2968     [GEN_TAC THEN
2969      DISCH_THEN(fn th => FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN
2970      DISCH_THEN(fn th => REWRITE_TAC[th]),
2971      REPEAT STRIP_TAC THEN
2972      C SUBGOAL_THEN (fn th => FIRST_ASSUM(MP_TAC o C MATCH_MP th))
2973      (Term`a <= x /\ x <= b`) THENL
2974       [CONJ_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THENL
2975         [EXISTS_TAC (Term`u:real`), EXISTS_TAC (Term`v:real`)] THEN
2976        ASM_REWRITE_TAC[],
2977        DISCH_THEN(MATCH_MP_TAC o CONJUNCT2) THEN ASM_REWRITE_TAC[]]]] THEN
2978  X_GEN_TAC (Term`x:real`) THEN
2979  DISCH_THEN(fn th => STRIP_ASSUME_TAC th THEN
2980    FIRST_ASSUM(UNDISCH_TAC o assert is_forall o concl) THEN
2981    DISCH_THEN(MP_TAC o C MATCH_MP th)) THEN
2982  REWRITE_TAC[diffl, LIM] THEN
2983  DISCH_THEN(MP_TAC o SPEC (Term`e / &2`)) THEN
2984  ASM_REWRITE_TAC[REAL_LT_HALF1] THEN
2985  BETA_TAC THEN REWRITE_TAC[REAL_SUB_RZERO] THEN
2986  DISCH_THEN(X_CHOOSE_THEN (Term`d:real`) STRIP_ASSUME_TAC) THEN
2987  SUBGOAL_THEN (Term`!z. abs(z - x) < d ==>
2988        abs((f(z) - f(x)) - (f'(x) * (z - x)))
2989        <= (e / &2) * abs(z - x)`)
2990  ASSUME_TAC THENL
2991   [GEN_TAC THEN ASM_CASES_TAC (Term`&0 < abs(z - x)`) THENL
2992     [ALL_TAC,
2993      UNDISCH_TAC (Term`~(&0 < abs(z - x))`) THEN
2994      REWRITE_TAC[GSYM ABS_NZ, REAL_SUB_0] THEN
2995      DISCH_THEN SUBST1_TAC THEN
2996      REWRITE_TAC[REAL_SUB_REFL, REAL_MUL_RZERO, ABS_0, REAL_LE_REFL]] THEN
2997    DISCH_THEN(MP_TAC o CONJ (ASSUME (Term`&0 < abs(z - x)`))) THEN
2998    DISCH_THEN(curry op THEN (MATCH_MP_TAC REAL_LT_IMP_LE) o MP_TAC) THEN
2999    DISCH_THEN(fn th => FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN
3000    FIRST_ASSUM(fn th => GEN_REWRITE_TAC LAND_CONV []
3001      [GSYM(MATCH_MP REAL_LT_RMUL th)]) THEN
3002    MATCH_MP_TAC (TAUT_CONV (Term`(a = b) ==> a ==> b`)) THEN
3003    AP_THM_TAC THEN AP_TERM_TAC THEN
3004    REWRITE_TAC[GSYM ABS_MUL] THEN AP_TERM_TAC THEN
3005    REWRITE_TAC[REAL_SUB_RDISTRIB] THEN AP_THM_TAC THEN AP_TERM_TAC THEN
3006    REWRITE_TAC[REAL_SUB_ADD2] THEN MATCH_MP_TAC REAL_DIV_RMUL THEN
3007    ASM_REWRITE_TAC[ABS_NZ], ALL_TAC] THEN
3008  EXISTS_TAC (Term`d:real`) THEN ASM_REWRITE_TAC[] THEN
3009  REPEAT STRIP_TAC THEN
3010  SUBGOAL_THEN (Term`u <= v`) (DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT])
3011  THENL
3012   [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC (Term`x:real`) THEN
3013    ASM_REWRITE_TAC[],
3014    ALL_TAC,
3015    ASM_REWRITE_TAC[REAL_SUB_REFL, REAL_MUL_RZERO, ABS_0, REAL_LE_REFL]] THEN
3016  MATCH_MP_TAC REAL_LE_TRANS THEN
3017  EXISTS_TAC (Term`abs((f(v) - f(x)) - (f'(x) * (v - x))) +
3018                   abs((f(x) - f(u)) - (f'(x) * (x - u)))`) THEN
3019  CONJ_TAC THENL
3020   [MP_TAC(SPECL[Term`(f(v) - f(x)) - (f'(x) * (v - x))`,
3021                 Term`(f(x) - f(u)) - (f'(x) * (x - u))`] ABS_TRIANGLE)
3022    THEN MATCH_MP_TAC(TAUT_CONV (Term`(a = b) ==> a ==> b`)) THEN
3023    AP_THM_TAC THEN REPEAT AP_TERM_TAC THEN
3024    ONCE_REWRITE_TAC[GSYM REAL_ADD2_SUB2] THEN
3025    REWRITE_TAC[REAL_SUB_LDISTRIB] THEN
3026    SUBGOAL_THEN (Term`!a b c. (a - b) + (b - c) = (a - c)`)
3027      (fn th => REWRITE_TAC[th]) THEN
3028    REPEAT GEN_TAC THEN REWRITE_TAC[real_sub] THEN
3029    ONCE_REWRITE_TAC[AC (REAL_ADD_ASSOC,REAL_ADD_SYM)
3030      (Term`(a + b) + (c + d) = (b + c) + (a + d)`)] THEN
3031    REWRITE_TAC[REAL_ADD_LINV, REAL_ADD_LID], ALL_TAC] THEN
3032  GEN_REWRITE_TAC RAND_CONV [] [GSYM REAL_HALF_DOUBLE] THEN
3033  MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL
3034   [MATCH_MP_TAC REAL_LE_TRANS THEN
3035    EXISTS_TAC (Term`(e / &2) * abs(v - x)`) THEN CONJ_TAC THENL
3036     [FIRST_ASSUM MATCH_MP_TAC THEN
3037      ASM_REWRITE_TAC[abs, REAL_SUB_LE] THEN
3038      MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC (Term`v - u`) THEN
3039      ASM_REWRITE_TAC[] THEN REWRITE_TAC[real_sub, REAL_LE_LADD] THEN
3040      ASM_REWRITE_TAC[REAL_LE_NEG],
3041      ASM_REWRITE_TAC[abs, REAL_SUB_LE] THEN REWRITE_TAC[real_div] THEN
3042      GEN_REWRITE_TAC LAND_CONV [] [AC (REAL_MUL_ASSOC,REAL_MUL_SYM)
3043         (Term`(a * b) * c = (a * c) * b`)] THEN
3044     REWRITE_TAC[GSYM REAL_MUL_ASSOC,
3045        MATCH_MP REAL_LE_LMUL (ASSUME (Term`&0 < e`))] THEN
3046      SUBGOAL_THEN (Term`!x y. (x * inv(&2)) <= (y * inv(&2)) = x <= y`)
3047      (fn th => ASM_REWRITE_TAC[th, real_sub, REAL_LE_LADD, REAL_LE_NEG]) THEN
3048      REPEAT GEN_TAC THEN MATCH_MP_TAC REAL_LE_RMUL THEN
3049      MATCH_MP_TAC REAL_INV_POS THEN
3050      REWRITE_TAC[REAL_LT, TWO, LESS_0]],
3051    MATCH_MP_TAC REAL_LE_TRANS THEN
3052    EXISTS_TAC (Term`(e / &2) * abs(x - u)`) THEN CONJ_TAC THENL
3053     [GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [] [real_sub] THEN
3054      ONCE_REWRITE_TAC[GSYM ABS_NEG] THEN
3055      REWRITE_TAC[REAL_NEG_ADD, REAL_NEG_SUB] THEN
3056      ONCE_REWRITE_TAC[REAL_NEG_RMUL] THEN
3057      REWRITE_TAC[REAL_NEG_SUB] THEN REWRITE_TAC[GSYM real_sub] THEN
3058      FIRST_ASSUM MATCH_MP_TAC THEN ONCE_REWRITE_TAC[ABS_SUB] THEN
3059      ASM_REWRITE_TAC[abs, REAL_SUB_LE] THEN
3060      MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC (Term`v - u`) THEN
3061      ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[real_sub, REAL_LE_RADD],
3062      ASM_REWRITE_TAC[abs, REAL_SUB_LE] THEN REWRITE_TAC[real_div] THEN
3063      GEN_REWRITE_TAC LAND_CONV [] [AC (REAL_MUL_ASSOC,REAL_MUL_SYM)
3064        (Term `(a * b) * c = (a * c) * b`)] THEN
3065      REWRITE_TAC[GSYM REAL_MUL_ASSOC,
3066        MATCH_MP REAL_LE_LMUL (ASSUME (Term`&0 < e`))] THEN
3067      SUBGOAL_THEN (Term`!x y. (x * inv(&2)) <= (y * inv(&2)) = x <= y`)
3068      (fn th => ASM_REWRITE_TAC[th, real_sub, REAL_LE_RADD, REAL_LE_NEG]) THEN
3069      REPEAT GEN_TAC THEN MATCH_MP_TAC REAL_LE_RMUL THEN
3070      MATCH_MP_TAC REAL_INV_POS THEN
3071      REWRITE_TAC[REAL_LT, TWO, LESS_0]]]);
3072
3073val FTC1 = store_thm("FTC1",
3074 Term `!f f' a b.
3075       a <= b /\ (!x. a <= x /\ x <= b ==> (f diffl f'(x))(x))
3076        ==> Dint(a,b) f' (f(b) - f(a))`,
3077  REPEAT STRIP_TAC THEN
3078  UNDISCH_TAC (Term`a <= b`) THEN REWRITE_TAC[REAL_LE_LT] THEN
3079  DISCH_THEN DISJ_CASES_TAC THENL
3080   [ALL_TAC, ASM_REWRITE_TAC[REAL_SUB_REFL, INTEGRAL_NULL]] THEN
3081  REWRITE_TAC[Dint] THEN X_GEN_TAC (Term`e:real`) THEN DISCH_TAC THEN
3082  SUBGOAL_THEN
3083    (Term`!e. &0 < e ==>
3084              ?g. gauge(\x. a <= x /\ x <= b) g /\
3085                  (!D p. tdiv(a,b)(D,p) /\ fine g(D,p)
3086                         ==>
3087                         (abs((rsum(D,p)f') - (f b - f a))) <= e)`)
3088  MP_TAC THENL
3089   [ALL_TAC,
3090    DISCH_THEN(MP_TAC o SPEC (Term`e / &2`)) THEN
3091    ASM_REWRITE_TAC[REAL_LT_HALF1] THEN
3092    DISCH_THEN(X_CHOOSE_THEN (Term`g:real->real`) STRIP_ASSUME_TAC) THEN
3093    EXISTS_TAC (Term`g:real->real`) THEN ASM_REWRITE_TAC[] THEN
3094    REPEAT GEN_TAC THEN
3095    DISCH_THEN(fn th => FIRST_ASSUM(ASSUME_TAC o C MATCH_MP th)) THEN
3096    MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC (Term`e / &2`) THEN
3097    ASM_REWRITE_TAC[REAL_LT_HALF2]] THEN
3098  UNDISCH_TAC (Term`&0 < e`) THEN DISCH_THEN(K ALL_TAC) THEN
3099  X_GEN_TAC (Term`e:real`) THEN DISCH_TAC THEN
3100  MP_TAC(SPECL [Term`f:real->real`, Term`f':real->real`,
3101    Term`a:real`, Term`b:real`, Term`e / (b - a)`] STRADDLE_LEMMA) THEN
3102  ASM_REWRITE_TAC[] THEN
3103  SUBGOAL_THEN (Term`&0 < e / (b - a)`) (fn th => REWRITE_TAC[th]) THENL
3104   [REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LT_MUL THEN
3105    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_INV_POS THEN
3106    ASM_REWRITE_TAC[REAL_SUB_LT], ALL_TAC] THEN
3107  DISCH_THEN(X_CHOOSE_THEN (Term`g:real->real`) STRIP_ASSUME_TAC) THEN
3108  EXISTS_TAC (Term`g:real->real`) THEN ASM_REWRITE_TAC[] THEN
3109  MAP_EVERY X_GEN_TAC [Term`D:num->real`, Term`p:num->real`] THEN
3110  REWRITE_TAC[tdiv] THEN STRIP_TAC THEN REWRITE_TAC[rsum] THEN
3111  SUBGOAL_THEN (Term`f b - f a = sum(0,dsize D)(\n. f(D(SUC n)) - f(D(n)))`)
3112  SUBST1_TAC THENL
3113   [MP_TAC(SPECL [Term`\n:num. (f:real->real)(D(n))`, Term`0:num`, Term`dsize D`]
3114      SUM_CANCEL) THEN BETA_TAC THEN DISCH_THEN SUBST1_TAC THEN
3115    ASM_REWRITE_TAC[ADD_CLAUSES] THEN
3116    MAP_EVERY (IMP_RES_THEN SUBST1_TAC) [DIVISION_LHS, DIVISION_RHS] THEN
3117    REFL_TAC, ALL_TAC] THEN
3118  ONCE_REWRITE_TAC[ABS_SUB] THEN REWRITE_TAC[GSYM SUM_SUB] THEN BETA_TAC THEN
3119  LE_MATCH_TAC ABS_SUM THEN BETA_TAC THEN
3120  SUBGOAL_THEN (Term`e = sum(0,dsize D)
3121                            (\n. (e / (b - a)) * (D(SUC n) - D n))`)
3122  SUBST1_TAC THENL
3123   [ONCE_REWRITE_TAC[SYM(BETA_CONV (Term`(\n. (D(SUC n) - D n)) n`))] THEN
3124    ASM_REWRITE_TAC[SUM_CMUL, SUM_CANCEL, ADD_CLAUSES] THEN
3125    MAP_EVERY (IMP_RES_THEN SUBST1_TAC) [DIVISION_LHS, DIVISION_RHS] THEN
3126    CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_DIV_RMUL THEN
3127    REWRITE_TAC[REAL_SUB_0] THEN CONV_TAC(RAND_CONV SYM_CONV) THEN
3128    MATCH_MP_TAC REAL_LT_IMP_NE THEN FIRST_ASSUM ACCEPT_TAC, ALL_TAC] THEN
3129  MATCH_MP_TAC SUM_LE THEN X_GEN_TAC (Term`r:num`) THEN
3130  REWRITE_TAC[ADD_CLAUSES] THEN STRIP_TAC THEN BETA_TAC THEN
3131  FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
3132   [IMP_RES_THEN (fn th => REWRITE_TAC[th]) DIVISION_LBOUND,
3133    IMP_RES_THEN (fn th => REWRITE_TAC[th]) DIVISION_UBOUND,
3134    UNDISCH_TAC (Term`fine(g)(D,p)`) THEN REWRITE_TAC[fine] THEN
3135    DISCH_THEN MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC]);
3136
3137(* ======================================================================== *)
3138(* MacLaurin's theorem.                                                     *)
3139(* ======================================================================== *)
3140
3141(* ------------------------------------------------------------------------ *)
3142(* SYM_CANON_CONV - Canonicalizes single application of symmetric operator  *)
3143(* Rewrites `so as to make fn true`, e.g. fn = (<<) or fn = curry(=) `1` o fst*)
3144(* ------------------------------------------------------------------------ *)
3145
3146fun SYM_CANON_CONV sym f =
3147  REWR_CONV sym o assert
3148   (not o f o ((snd o dest_comb) ## I) o dest_comb);;
3149
3150(* ----------------------------------------------------------- *)
3151(* EXT_CONV `!x. f x = g x` = |- (!x. f x = g x) = (f = g)     *)
3152(* ----------------------------------------------------------- *)
3153
3154val EXT_CONV =  SYM o uncurry X_FUN_EQ_CONV o
3155      (I ## (mk_eq o (rator ## rator) o dest_eq)) o dest_forall;;
3156
3157(* ======================================================================== *)
3158(* Mclaurin's theorem with Lagrange form of remainder                       *)
3159(* We could weaken the hypotheses slightly, but it's not worth it           *)
3160(* ======================================================================== *)
3161
3162val _ = Parse.hide "B";
3163
3164val MCLAURIN = store_thm("MCLAURIN",
3165 Term
3166  `!f diff h n.
3167    &0 < h /\ 0 < n /\ (diff(0) = f) /\
3168    (!m t. m < n /\ &0 <= t /\ t <= h ==>
3169           (diff(m) diffl diff(SUC m)(t))(t)) ==>
3170   (?t. &0 < t /\ t < h /\
3171        (f(h) = sum(0,n)(\m. (diff(m)(&0) / &(FACT m)) * (h pow m))
3172                +
3173                ((diff(n)(t) / &(FACT n)) * (h pow n))))`,
3174  REPEAT GEN_TAC THEN STRIP_TAC THEN
3175  UNDISCH_TAC (Term`0 < n:num`) THEN
3176  DISJ_CASES_THEN2 SUBST_ALL_TAC (X_CHOOSE_THEN (Term`r:num`) MP_TAC)
3177   (SPEC (Term`n:num`) num_CASES) THEN REWRITE_TAC[LESS_REFL] THEN
3178  DISCH_THEN(ASSUME_TAC o SYM) THEN DISCH_THEN(K ALL_TAC) THEN
3179  SUBGOAL_THEN
3180   (Term`?B. f(h) = sum(0,n)
3181                       (\m. (diff(m)(&0) / &(FACT m)) * (h pow m))
3182                    + (B * ((h pow n) / &(FACT n)))`) MP_TAC THENL
3183   [ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
3184    ONCE_REWRITE_TAC[GSYM REAL_EQ_SUB_RADD] THEN
3185    EXISTS_TAC (Term
3186       `(f h - sum(0,n) (\m. (diff(m)(&0) / &(FACT m)) * (h pow m)))
3187        * &(FACT n) / (h pow n)`) THEN REWRITE_TAC[real_div] THEN
3188    REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN
3189    GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) [] [GSYM REAL_MUL_RID] THEN
3190    AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN
3191    ONCE_REWRITE_TAC[AC (REAL_MUL_ASSOC,REAL_MUL_SYM)
3192        (Term`a * (b * (c * d)) = (d * a) * (b * c)`)] THEN
3193    GEN_REWRITE_TAC RAND_CONV [] [GSYM REAL_MUL_LID] THEN BINOP_TAC THEN
3194    MATCH_MP_TAC REAL_MUL_LINV THENL
3195     [MATCH_MP_TAC REAL_POS_NZ THEN REWRITE_TAC[REAL_LT, FACT_LESS],
3196      MATCH_MP_TAC POW_NZ THEN MATCH_MP_TAC REAL_POS_NZ THEN
3197      ASM_REWRITE_TAC[]], ALL_TAC] THEN
3198  DISCH_THEN(X_CHOOSE_THEN (Term`B:real`) (ASSUME_TAC o SYM)) THEN
3199  ABBREV_TAC (Term`g =
3200   \t. f(t) - (sum(0,n)(\m. (diff(m)(&0) / &(FACT m)) * (t pow m))
3201                + (B * ((t pow n) / &(FACT n))))`) THEN
3202  SUBGOAL_THEN (Term`(g(&0) = &0) /\ (g(h) = &0)`) ASSUME_TAC THENL
3203   [EXPAND_TAC "g" THEN BETA_TAC THEN ASM_REWRITE_TAC[REAL_SUB_REFL] THEN
3204    EXPAND_TAC "n" THEN REWRITE_TAC[POW_0, REAL_DIV_LZERO] THEN
3205    REWRITE_TAC[REAL_MUL_RZERO, REAL_ADD_RID] THEN REWRITE_TAC[REAL_SUB_0] THEN
3206    MP_TAC(GEN (Term`j:num->real`)
3207     (SPECL [Term`j:num->real`, Term`r:num`, Term`1:num`] SUM_OFFSET)) THEN
3208    REWRITE_TAC[ADD1, REAL_EQ_SUB_LADD] THEN
3209    DISCH_THEN(fn th => REWRITE_TAC[GSYM th]) THEN BETA_TAC THEN
3210    REWRITE_TAC[SUM_1] THEN BETA_TAC THEN REWRITE_TAC[pow, FACT] THEN
3211    ASM_REWRITE_TAC[real_div, REAL_INV1, REAL_MUL_RID] THEN
3212    CONV_TAC SYM_CONV THEN REWRITE_TAC[REAL_ADD_LID_UNIQ] THEN
3213    REWRITE_TAC[GSYM ADD1, POW_0, REAL_MUL_RZERO, SUM_0], ALL_TAC] THEN
3214  ABBREV_TAC (Term`difg =
3215    \m t. diff(m) t - (sum(0,n-m)(\p. (diff(m+p)(&0) / &(FACT p)) * (t pow p))
3216       + (B * ((t pow (n - m)) / &(FACT(n - m)))))`) THEN
3217  SUBGOAL_THEN (Term`difg(0:num):real->real = g`) ASSUME_TAC THENL
3218   [EXPAND_TAC "difg" THEN BETA_TAC THEN EXPAND_TAC "g" THEN
3219    CONV_TAC FUN_EQ_CONV THEN GEN_TAC THEN BETA_TAC THEN
3220    ASM_REWRITE_TAC[ADD_CLAUSES, SUB_0], ALL_TAC] THEN
3221  SUBGOAL_THEN (Term
3222     `(!m t. m < n /\ (& 0) <= t /\ t <= h
3223              ==> (difg(m) diffl difg(SUC m)(t))(t))`) ASSUME_TAC THENL
3224   [REPEAT GEN_TAC THEN DISCH_TAC THEN EXPAND_TAC "difg" THEN BETA_TAC THEN
3225    CONV_TAC((funpow 2 RATOR_CONV o RAND_CONV) HABS_CONV) THEN
3226    MATCH_MP_TAC DIFF_SUB THEN CONJ_TAC THENL
3227     [CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN
3228      FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[], ALL_TAC] THEN
3229    CONV_TAC((funpow 2 RATOR_CONV o RAND_CONV) HABS_CONV) THEN
3230    MATCH_MP_TAC DIFF_ADD THEN CONJ_TAC THENL
3231     [ALL_TAC,
3232      W(MP_TAC o DIFF_CONV o rand o funpow 2 rator o snd) THEN
3233      REWRITE_TAC[REAL_MUL_LZERO, REAL_MUL_RID, REAL_ADD_LID] THEN
3234      REWRITE_TAC[REAL_FACT_NZ, REAL_SUB_RZERO] THEN
3235      DISCH_THEN(MP_TAC o SPEC (Term`t:real`)) THEN
3236      MATCH_MP_TAC(TAUT_CONV (Term`(a = b) ==> a ==> b`)) THEN
3237      AP_THM_TAC THEN CONV_TAC(ONCE_DEPTH_CONV(ALPHA_CONV (Term`t:real`))) THEN
3238      AP_TERM_TAC THEN GEN_REWRITE_TAC RAND_CONV [] [REAL_MUL_SYM] THEN
3239      AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[real_div] THEN
3240      REWRITE_TAC[GSYM REAL_MUL_ASSOC, POW_2] THEN
3241      ONCE_REWRITE_TAC[AC (REAL_MUL_ASSOC,REAL_MUL_SYM)
3242        (Term`a * (b * (c * d)) = b * (a * (d * c))`)] THEN
3243      FIRST_ASSUM(X_CHOOSE_THEN (Term`d:num`) SUBST1_TAC o
3244        MATCH_MP LESS_ADD_1 o CONJUNCT1) THEN
3245      ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN
3246      REWRITE_TAC[GSYM ADD_ASSOC] THEN
3247      REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] (GSYM ADD1)] THEN
3248      REWRITE_TAC[ADD_SUB] THEN AP_TERM_TAC THEN
3249      (IMP_SUBST_TAC REAL_INV_MUL:tactic) THEN REWRITE_TAC[REAL_FACT_NZ] THEN
3250      REWRITE_TAC[GSYM ADD1, FACT, GSYM REAL_MUL] THEN
3251      REPEAT(IMP_SUBST_TAC REAL_INV_MUL THEN
3252             REWRITE_TAC[REAL_FACT_NZ] THEN
3253             REWRITE_TAC [REAL_INJ, NOT_SUC]) THEN
3254      REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN
3255      ONCE_REWRITE_TAC[AC (REAL_MUL_ASSOC,REAL_MUL_SYM)
3256       (Term `a * (b * (c * (d * (e * (f * g))))) =
3257              (b * a) * ((d * f) * ((c * g) * e))`)] THEN
3258      REPEAT(IMP_SUBST_TAC REAL_MUL_LINV THEN REWRITE_TAC[REAL_FACT_NZ] THEN
3259             REWRITE_TAC[REAL_INJ, NOT_SUC]) THEN
3260      REWRITE_TAC[REAL_MUL_LID]] THEN
3261    FIRST_ASSUM(X_CHOOSE_THEN (Term`d:num`) SUBST1_TAC o
3262        MATCH_MP LESS_ADD_1 o CONJUNCT1) THEN
3263    ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN
3264    REWRITE_TAC[GSYM ADD_ASSOC] THEN
3265    REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] (GSYM ADD1)] THEN
3266    REWRITE_TAC[ADD_SUB] THEN
3267    REWRITE_TAC[GSYM(REWRITE_RULE[REAL_EQ_SUB_LADD] SUM_OFFSET)] THEN
3268    BETA_TAC THEN REWRITE_TAC[SUM_1] THEN BETA_TAC THEN
3269    CONV_TAC (funpow 2 RATOR_CONV (RAND_CONV HABS_CONV)) THEN
3270    GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) [] [GSYM REAL_ADD_RID] THEN
3271    MATCH_MP_TAC DIFF_ADD THEN REWRITE_TAC[pow, DIFF_CONST] THEN
3272    (MP_TAC o C SPECL DIFF_SUM)
3273     [Term`\p x. (diff((p + 1) + m)(&0) / &(FACT(p + 1)))
3274                * (x pow (p + 1))`,
3275      Term`\p x. (diff(p + (SUC m))(&0) / &(FACT p)) * (x pow p)`,
3276      Term`0:num`, Term`d:num`, Term`t:real`] THEN BETA_TAC THEN
3277    DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[ADD_CLAUSES] THEN
3278    X_GEN_TAC (Term`k:num`) THEN STRIP_TAC THEN
3279    W(MP_TAC o DIFF_CONV o rand o funpow 2 rator o snd) THEN
3280    DISCH_THEN(MP_TAC o SPEC (Term`t:real`)) THEN
3281    MATCH_MP_TAC(TAUT_CONV (Term`(a = b) ==> a ==> b`)) THEN
3282    CONV_TAC(ONCE_DEPTH_CONV(ALPHA_CONV (Term`z:real`))) THEN
3283    AP_THM_TAC THEN AP_TERM_TAC THEN
3284    REWRITE_TAC[REAL_MUL_LZERO, REAL_ADD_LID, REAL_MUL_RID] THEN
3285    REWRITE_TAC[GSYM ADD1, ADD_CLAUSES, real_div, GSYM REAL_MUL_ASSOC] THEN
3286    REWRITE_TAC[SUC_SUB1] THEN
3287    ONCE_REWRITE_TAC[AC (REAL_MUL_ASSOC,REAL_MUL_SYM)
3288       (Term`a * (b * (c * d)) = c * ((a * d) * b)`)] THEN
3289    AP_TERM_TAC THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN
3290    AP_TERM_TAC THEN
3291    SUBGOAL_THEN (Term`&(SUC k) = inv(inv(&(SUC k)))`) SUBST1_TAC THENL
3292     [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_INVINV THEN
3293      REWRITE_TAC[REAL_INJ, NOT_SUC], ALL_TAC] THEN
3294    (IMP_SUBST_TAC(GSYM REAL_INV_MUL):tactic) THENL
3295     [CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN REWRITE_TAC[REAL_FACT_NZ] THEN
3296      MATCH_MP_TAC REAL_POS_NZ THEN MATCH_MP_TAC REAL_INV_POS THEN
3297      REWRITE_TAC[REAL_LT, LESS_0], ALL_TAC] THEN
3298    AP_TERM_TAC THEN REWRITE_TAC[FACT, GSYM REAL_MUL, REAL_MUL_ASSOC] THEN
3299    (IMP_SUBST_TAC REAL_MUL_LINV:tactic) THEN REWRITE_TAC[REAL_MUL_LID] THEN
3300    REWRITE_TAC[REAL_INJ, NOT_SUC], ALL_TAC] THEN
3301  SUBGOAL_THEN (Term`!m. m < n ==>
3302        ?t. &0 < t /\ t < h /\ (difg(SUC m)(t) = &0)`) MP_TAC THENL
3303   [ALL_TAC,
3304    DISCH_THEN(MP_TAC o SPEC (Term`r:num`)) THEN EXPAND_TAC "n" THEN
3305    REWRITE_TAC[LESS_SUC_REFL] THEN
3306    DISCH_THEN(X_CHOOSE_THEN (Term`t:real`) STRIP_ASSUME_TAC) THEN
3307    EXISTS_TAC (Term`t:real`) THEN ASM_REWRITE_TAC[] THEN
3308    UNDISCH_TAC (Term`difg(SUC r)(t:real) = &0`) THEN EXPAND_TAC "difg" THEN
3309    ASM_REWRITE_TAC[SUB_EQUAL_0, sum, pow, FACT] THEN
3310    REWRITE_TAC[REAL_SUB_0, REAL_ADD_LID, real_div] THEN
3311    REWRITE_TAC[REAL_INV1, REAL_MUL_RID] THEN DISCH_THEN SUBST1_TAC THEN
3312    GEN_REWRITE_TAC (funpow 2 RAND_CONV) []
3313     [AC (REAL_MUL_ASSOC,REAL_MUL_SYM)
3314         (Term`(a * b) * c = a * (c * b)`)] THEN
3315    ASM_REWRITE_TAC[GSYM real_div]] THEN
3316  SUBGOAL_THEN (Term`!m:num. m<n ==> (difg(m)(&0) = &0)`) ASSUME_TAC THENL
3317   [X_GEN_TAC (Term`m:num`) THEN EXPAND_TAC "difg" THEN
3318    DISCH_THEN(X_CHOOSE_THEN (Term`d:num`) SUBST1_TAC o MATCH_MP LESS_ADD_1)
3319    THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN
3320    MP_TAC(GEN (Term`j:num->real`)
3321     (SPECL [Term`j:num->real`, Term`d:num`, Term`1:num`] SUM_OFFSET)) THEN
3322    REWRITE_TAC[ADD1, REAL_EQ_SUB_LADD] THEN
3323    DISCH_THEN(fn th => REWRITE_TAC[GSYM th]) THEN BETA_TAC THEN
3324    REWRITE_TAC[SUM_1] THEN BETA_TAC THEN
3325    REWRITE_TAC[FACT, pow, REAL_INV1, ADD_CLAUSES, real_div, REAL_MUL_RID] THEN
3326    REWRITE_TAC[GSYM ADD1, POW_0, REAL_MUL_RZERO, SUM_0, REAL_ADD_LID] THEN
3327    REWRITE_TAC[REAL_MUL_LZERO, REAL_MUL_RZERO,REAL_ADD_RID] THEN
3328    REWRITE_TAC[REAL_SUB_REFL], ALL_TAC] THEN
3329  SUBGOAL_THEN (Term`!m:num. m < n ==> ?t. &0 < t /\ t < h /\
3330                        (difg(m) diffl &0)(t)`) MP_TAC THENL
3331   [ALL_TAC,
3332    DISCH_THEN(fn th => GEN_TAC THEN
3333      DISCH_THEN(fn t => ASSUME_TAC t THEN MP_TAC(MATCH_MP th t))) THEN
3334    DISCH_THEN(X_CHOOSE_THEN (Term`t:real`) STRIP_ASSUME_TAC) THEN
3335    EXISTS_TAC (Term`t:real`) THEN ASM_REWRITE_TAC[] THEN
3336    MATCH_MP_TAC DIFF_UNIQ THEN EXISTS_TAC (Term`difg(m:num):real->real`) THEN
3337    EXISTS_TAC (Term`t:real`) THEN ASM_REWRITE_TAC[] THEN
3338    FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
3339    CONJ_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN
3340    FIRST_ASSUM ACCEPT_TAC] THEN
3341  INDUCT_TAC THENL
3342   [DISCH_TAC THEN MATCH_MP_TAC ROLLE THEN ASM_REWRITE_TAC[] THEN
3343    SUBGOAL_THEN (Term`!t. &0 <= t /\ t <= h ==> g differentiable t`)
3344    MP_TAC THENL
3345     [GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[differentiable] THEN
3346      EXISTS_TAC (Term`difg(SUC 0)(t:real):real`) THEN
3347      SUBST1_TAC(SYM(ASSUME (Term`difg(0:num):real->real = g`))) THEN
3348      FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[], ALL_TAC] THEN
3349    DISCH_TAC THEN CONJ_TAC THENL
3350     [GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC DIFF_CONT THEN
3351      REWRITE_TAC[GSYM differentiable] THEN FIRST_ASSUM MATCH_MP_TAC THEN
3352      ASM_REWRITE_TAC[],
3353      GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN
3354      CONJ_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]],
3355    DISCH_TAC THEN SUBGOAL_THEN (Term`m < n:num`)
3356    (fn th => FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THENL
3357     [MATCH_MP_TAC LESS_TRANS THEN EXISTS_TAC (Term`SUC m`) THEN
3358      ASM_REWRITE_TAC[LESS_SUC_REFL], ALL_TAC] THEN
3359    DISCH_THEN(X_CHOOSE_THEN (Term`t0:real`) STRIP_ASSUME_TAC) THEN
3360    SUBGOAL_THEN (Term`?t. (& 0) < t /\ t < t0 /\
3361                           ((difg(SUC m)) diffl (& 0))t`) MP_TAC THENL
3362     [MATCH_MP_TAC ROLLE THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
3363       [SUBGOAL_THEN (Term`difg(SUC m)(&0) = &0`) SUBST1_TAC THENL
3364         [FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC,
3365          MATCH_MP_TAC DIFF_UNIQ THEN EXISTS_TAC (Term`difg(m:num):real->real`)
3366          THEN EXISTS_TAC (Term`t0:real`) THEN ASM_REWRITE_TAC[] THEN
3367          FIRST_ASSUM MATCH_MP_TAC THEN REPEAT CONJ_TAC THENL
3368           [MATCH_MP_TAC LESS_TRANS THEN EXISTS_TAC (Term`SUC m`) THEN
3369            ASM_REWRITE_TAC[LESS_SUC_REFL],
3370            MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[],
3371            MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]]], ALL_TAC] THEN
3372      SUBGOAL_THEN (Term`!t. &0 <= t /\ t <= t0 ==>
3373                       difg(SUC m) differentiable t`) ASSUME_TAC THENL
3374       [GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[differentiable] THEN
3375        EXISTS_TAC (Term`difg(SUC(SUC m))(t:real):real`) THEN
3376        FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
3377        MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC (Term`t0:real`) THEN
3378        ASM_REWRITE_TAC[] THEN
3379        MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[], ALL_TAC] THEN
3380      CONJ_TAC THENL
3381       [GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC DIFF_CONT THEN
3382        REWRITE_TAC[GSYM differentiable] THEN FIRST_ASSUM MATCH_MP_TAC THEN
3383        ASM_REWRITE_TAC[],
3384        GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN
3385        CONJ_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]],
3386      DISCH_THEN(X_CHOOSE_THEN (Term`t:real`) STRIP_ASSUME_TAC) THEN
3387      EXISTS_TAC (Term`t:real`) THEN ASM_REWRITE_TAC[] THEN
3388      MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC (Term`t0:real`) THEN
3389      ASM_REWRITE_TAC[]]]);
3390
3391val MCLAURIN_NEG = store_thm("MCLAURIN_NEG",
3392 Term `!f diff h n.
3393    h < &0 /\ 0<n /\ (diff(0) = f) /\
3394    (!m t. m < n /\ h <= t /\ t <= &0 ==>
3395           (diff(m) diffl diff(SUC m)(t))(t)) ==>
3396   (?t. h < t /\ t < &0 /\
3397        (f(h) = sum(0,n)(\m. (diff(m)(&0) / &(FACT m)) * (h pow m))
3398                + ((diff(n)(t) / &(FACT n)) * (h pow n))))`,
3399  REPEAT GEN_TAC THEN STRIP_TAC THEN
3400  MP_TAC(SPECL[Term`\x. (f(~x):real)`,
3401               Term`\n x. ((~(&1)) pow n) * (diff:num->real->real)(n)(~x)`,
3402               Term`~h`, Term`n:num`] MCLAURIN) THEN
3403  BETA_TAC THEN ASM_REWRITE_TAC[REAL_NEG_GT0, pow, REAL_MUL_LID] THEN
3404  ONCE_REWRITE_TAC[GSYM REAL_LE_NEG] THEN
3405  REWRITE_TAC[REAL_NEGNEG, REAL_NEG_0] THEN
3406  ONCE_REWRITE_TAC[TAUT_CONV (Term`a /\ b /\ c = a /\ c /\ b`)] THEN
3407  W(C SUBGOAL_THEN (fn t => REWRITE_TAC[t]) o funpow 2 (fst o dest_imp) o snd)
3408  THENL
3409   [REPEAT GEN_TAC THEN
3410    DISCH_THEN(fn th => FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN
3411    DISCH_THEN(MP_TAC o
3412     C CONJ (SPEC (Term`t:real`) (DIFF_CONV (Term`\x. ~x`)))) THEN
3413    CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN
3414    DISCH_THEN(MP_TAC o MATCH_MP DIFF_CHAIN) THEN
3415    DISCH_THEN(MP_TAC o GEN_ALL o MATCH_MP DIFF_CMUL) THEN
3416    DISCH_THEN(MP_TAC o SPEC (Term`(~(&1)) pow m`)) THEN BETA_TAC THEN
3417    MATCH_MP_TAC(TAUT_CONV (Term`(a = b) ==> a ==> b`)) THEN
3418    CONV_TAC(ONCE_DEPTH_CONV(ALPHA_CONV (Term`z:real`))) THEN
3419    AP_THM_TAC THEN AP_TERM_TAC THEN
3420    CONV_TAC(AC_CONV (REAL_MUL_ASSOC,REAL_MUL_SYM)),
3421    DISCH_THEN(X_CHOOSE_THEN (Term`t:real`) STRIP_ASSUME_TAC)] THEN
3422  EXISTS_TAC (Term`~t`) THEN ONCE_REWRITE_TAC[GSYM REAL_LT_NEG] THEN
3423  ASM_REWRITE_TAC[REAL_NEGNEG, REAL_NEG_0] THEN
3424  BINOP_TAC THENL
3425   [MATCH_MP_TAC SUM_EQ THEN
3426    X_GEN_TAC (Term`m:num`) THEN REWRITE_TAC[ADD_CLAUSES] THEN
3427    DISCH_THEN(ASSUME_TAC o CONJUNCT2) THEN BETA_TAC, ALL_TAC] THEN
3428  REWRITE_TAC[real_div, GSYM REAL_MUL_ASSOC] THEN
3429  ONCE_REWRITE_TAC[AC (REAL_MUL_ASSOC,REAL_MUL_SYM)
3430    (Term`a * (b * (c * d)) = (b * c) * (a * d)`)] THEN
3431  REWRITE_TAC[GSYM POW_MUL, GSYM REAL_NEG_MINUS1, REAL_NEGNEG] THEN
3432  REWRITE_TAC[REAL_MUL_ASSOC]);
3433
3434(* ------------------------------------------------------------------------- *)
3435(* Simple strong form if a function is differentiable everywhere.            *)
3436(* ------------------------------------------------------------------------- *)
3437
3438val MCLAURIN_ALL_LT = store_thm("MCLAURIN_ALL_LT",
3439 Term`!f diff.
3440      (diff 0 = f) /\
3441      (!m x. ((diff m) diffl (diff(SUC m) x)) x)
3442      ==> !x n. ~(x = &0) /\ 0 < n
3443            ==> ?t. &0 < abs(t) /\ abs(t) < abs(x) /\
3444                    (f(x) = sum(0,n)
3445                                (\m. (diff m (&0) / &(FACT m)) * x pow m)
3446                            +
3447                            (diff n t / &(FACT n)) * x pow n)`,
3448  REPEAT STRIP_TAC THEN
3449  REPEAT_TCL DISJ_CASES_THEN MP_TAC
3450   (SPECL [Term`x:real`, Term`&0`] REAL_LT_TOTAL) THEN
3451  ASM_REWRITE_TAC[] THEN DISCH_TAC THENL
3452   [MP_TAC(SPECL [Term`f:real->real`, Term`diff:num->real->real`,
3453                  Term`x:real`, Term`n:num`] MCLAURIN_NEG) THEN
3454    ASM_REWRITE_TAC[] THEN
3455    DISCH_THEN(X_CHOOSE_THEN (Term`t:real`) STRIP_ASSUME_TAC) THEN
3456    EXISTS_TAC (Term`t:real`) THEN ASM_REWRITE_TAC[] THEN
3457    UNDISCH_TAC (Term`t < &0`) THEN UNDISCH_TAC (Term`x < t`)
3458    THEN REAL_ARITH_TAC,
3459    MP_TAC(SPECL [Term`f:real->real`, Term`diff:num->real->real`,
3460                  Term`x:real`, Term`n:num`] MCLAURIN) THEN
3461    ASM_REWRITE_TAC[] THEN
3462    DISCH_THEN(X_CHOOSE_THEN (Term`t:real`) STRIP_ASSUME_TAC) THEN
3463    EXISTS_TAC (Term`t:real`) THEN ASM_REWRITE_TAC[] THEN
3464    UNDISCH_TAC (Term`&0 < t`) THEN UNDISCH_TAC (Term`t < x`)
3465    THEN REAL_ARITH_TAC]);
3466
3467val MCLAURIN_ZERO = store_thm("MCLAURIN_ZERO",
3468 Term`!diff n x. (x = &0) /\ 0 < n
3469       ==>
3470       (sum(0,n) (\m. (diff m (&0) / &(FACT m)) * x pow m)
3471        =
3472       diff 0 (&0))`,
3473  REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 SUBST1_TAC MP_TAC) THEN
3474  SPEC_TAC(Term`n:num`,Term`n:num`) THEN INDUCT_TAC THEN
3475  REWRITE_TAC[LESS_REFL] THEN REWRITE_TAC[LESS_THM] THEN
3476  DISCH_THEN(DISJ_CASES_THEN2 (SUBST1_TAC o SYM) MP_TAC) THENL
3477   [REWRITE_TAC[sum, ADD_CLAUSES] THEN BETA_TAC THEN
3478    REWRITE_TAC[FACT, pow, real_div] THEN MP_TAC(SPEC(Term`&1`) REAL_DIV_REFL)
3479    THEN DISCH_THEN (MP_TAC o REWRITE_RULE
3480        [REAL_OF_NUM_EQ,ONE,NOT_SUC])
3481    THEN REWRITE_TAC [GSYM REAL_INV_1OVER,  GSYM (ONE)]
3482    THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_ADD_LID, REAL_MUL_RID],
3483    REWRITE_TAC[sum] THEN
3484    DISCH_THEN(fn th => ASSUME_TAC th THEN ANTE_RES_THEN SUBST1_TAC th) THEN
3485    UNDISCH_TAC (Term`0 < n:num`) THEN SPEC_TAC(Term`n:num`,Term`n:num`) THEN
3486    INDUCT_TAC THEN BETA_TAC THEN REWRITE_TAC[LESS_REFL] THEN
3487    REWRITE_TAC[ADD_CLAUSES, pow, REAL_MUL_LZERO, REAL_MUL_RZERO] THEN
3488    REWRITE_TAC[REAL_ADD_RID]]);
3489
3490
3491
3492val LET_CASES = prove(Term`!m n:num. m <= n \/ n < m`,
3493ONCE_REWRITE_TAC [DISJ_SYM] THEN MATCH_ACCEPT_TAC LESS_CASES);
3494
3495val REAL_POW_EQ_0 = prove
3496 (Term`!x n. (x pow n = &0) = (x = &0) /\ ~(n = 0)`,
3497  GEN_TAC THEN INDUCT_TAC THEN
3498  ASM_REWRITE_TAC[NOT_SUC, pow, REAL_ENTIRE] THENL
3499   [REWRITE_TAC [REAL_OF_NUM_EQ, ONE,NOT_SUC],
3500    EQ_TAC THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]]);
3501
3502val MCLAURIN_ALL_LE = store_thm("MCLAURIN_ALL_LE",
3503 Term`!f diff.
3504      (diff 0 = f) /\
3505      (!m x. ((diff m) diffl (diff(SUC m) x)) x)
3506      ==> !x n. ?t. abs t  <= abs x /\
3507                   (f(x) = sum(0,n)
3508                             (\m. (diff m (&0) / &(FACT m)) * x pow m)
3509                           +
3510                            (diff n t / &(FACT n)) * x pow n)`,
3511  REPEAT STRIP_TAC THEN
3512  DISJ_CASES_THEN MP_TAC(SPECL [Term`n:num`, Term`0:num`] LET_CASES) THENL
3513   [REWRITE_TAC[LE] THEN DISCH_THEN SUBST1_TAC THEN
3514    ASM_REWRITE_TAC[sum, REAL_ADD_LID, FACT] THEN EXISTS_TAC (Term`x:real`)
3515    THEN REWRITE_TAC[REAL_LE_REFL, pow, REAL_MUL_RID, REAL_OVER1],
3516    DISCH_TAC THEN ASM_CASES_TAC (Term`x = &0`) THENL
3517     [MP_TAC(SPEC_ALL MCLAURIN_ZERO) THEN ASM_REWRITE_TAC[] THEN
3518      DISCH_THEN SUBST1_TAC THEN EXISTS_TAC (Term`&0`) THEN
3519      REWRITE_TAC[REAL_LE_REFL] THEN
3520      SUBGOAL_THEN (Term`&0 pow n = &0`) SUBST1_TAC THENL
3521       [ASM_REWRITE_TAC[REAL_POW_EQ_0, GSYM (CONJUNCT1 LE), NOT_LESS_EQUAL],
3522        REWRITE_TAC[REAL_ADD_RID, REAL_MUL_RZERO]],
3523      MP_TAC(SPEC_ALL MCLAURIN_ALL_LT) THEN ASM_REWRITE_TAC[] THEN
3524      DISCH_THEN(MP_TAC o SPEC_ALL) THEN ASM_REWRITE_TAC[] THEN
3525      DISCH_THEN(X_CHOOSE_THEN (Term`t:real`) STRIP_ASSUME_TAC) THEN
3526      EXISTS_TAC (Term`t:real`) THEN ASM_REWRITE_TAC[] THEN
3527      MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]]]);
3528
3529
3530(* ------------------------------------------------------------------------- *)
3531(* Version for exp.                                                          *)
3532(* ------------------------------------------------------------------------- *)
3533
3534val MCLAURIN_EXP_LEMMA = prove
3535 (Term`((\n:num. exp) 0 = exp) /\
3536   (!m x. (((\n:num. exp) m) diffl ((\n:num. exp) (SUC m) x)) x)`,
3537  REWRITE_TAC[DIFF_EXP]);
3538
3539val MCLAURIN_EXP_LT = store_thm("MCLAURIN_EXP_LT",
3540 Term`!x n. ~(x = &0) /\ 0 < n
3541         ==> ?t. &0 < abs(t) /\
3542                 abs(t) < abs(x) /\
3543                 (exp(x) = sum(0,n)(\m. x pow m / &(FACT m)) +
3544                           (exp(t) / &(FACT n)) * x pow n)`,
3545  MP_TAC (MATCH_MP MCLAURIN_ALL_LT MCLAURIN_EXP_LEMMA) THEN BETA_TAC THEN
3546  REPEAT STRIP_TAC THEN RES_TAC THEN NTAC 3 (POP_ASSUM (K ALL_TAC)) THEN
3547  EXISTS_TAC (Term`t:real`) THEN
3548  ASM_REWRITE_TAC [EXP_0,real_div,REAL_MUL_LID,REAL_MUL_RID]
3549  THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN CONV_TAC FUN_EQ_CONV
3550  THEN GEN_TAC THEN BETA_TAC THEN GEN_REWRITE_TAC LAND_CONV [] [REAL_MUL_SYM]
3551  THEN REFL_TAC);
3552
3553val MCLAURIN_EXP_LE = store_thm("MCLAURIN_EXP_LE",
3554 Term`!x n. ?t. abs(t) <= abs(x) /\
3555             (exp(x) = sum(0,n)(\m. x pow m / &(FACT m)) +
3556                       (exp(t) / &(FACT n)) * x pow n)`,
3557  MP_TAC (MATCH_MP MCLAURIN_ALL_LE MCLAURIN_EXP_LEMMA) THEN
3558  DISCH_THEN (fn th => REPEAT GEN_TAC THEN STRIP_ASSUME_TAC (SPEC_ALL th))
3559  THEN EXISTS_TAC (Term`t:real`) THEN  ASM_REWRITE_TAC [] THEN
3560  AP_THM_TAC THEN REPEAT AP_TERM_TAC THEN CONV_TAC FUN_EQ_CONV
3561  THEN GEN_TAC THEN BETA_TAC THEN
3562  REWRITE_TAC[EXP_0, real_div, REAL_MUL_LID, REAL_MUL_RID] THEN
3563  GEN_REWRITE_TAC LAND_CONV [] [REAL_MUL_SYM] THEN REFL_TAC);
3564
3565(* ------------------------------------------------------------------------- *)
3566(* Version for ln(1 - x).                                                    *)
3567(* ------------------------------------------------------------------------- *)
3568
3569val DIFF_LN_COMPOSITE = store_thm("DIFF_LN_COMPOSITE",
3570 Term`!g m x. (g diffl m)(x) /\ &0 < g x
3571           ==> ((\x. ln(g x)) diffl (inv(g x) * m))(x)`,
3572  REPEAT STRIP_TAC THEN MATCH_MP_TAC DIFF_CHAIN THEN
3573  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIFF_LN THEN
3574  ASM_REWRITE_TAC[]);
3575
3576val _ = basic_diffs := !basic_diffs@[SPEC_ALL DIFF_LN_COMPOSITE];
3577
3578val lem = prove(Term`!n:num. 0 < n ==> ~(n=0)`,
3579INDUCT_TAC THEN ASM_REWRITE_TAC [NOT_SUC,NOT_LESS_0]);
3580
3581(* ----------------------------------------------------------------------
3582    Exponentiation with real exponents
3583
3584    Contributed by
3585
3586       Umair Siddique
3587
3588       Email: umair.siddique@rcms.nust.edu.pk
3589       DATE: 29-12-2010
3590
3591       System Analysis & Verification (sAvE)  LAB
3592
3593       National University of Sciences and Technology (NUST)
3594       Ialamabad,Pakistan
3595    ---------------------------------------------------------------------- *)
3596
3597fun K_TAC _ = ALL_TAC;
3598
3599open bossLib realSimps
3600
3601(* Definition *)
3602val _ = set_fixity "rpow" (Infixr 700);
3603
3604val rpow = Define `a rpow b = exp (b * ln a)`;
3605
3606(* Properties *)
3607
3608val  GEN_RPOW = store_thm
3609        ("GEN_RPOW",
3610        ``! a n. 0 < a ==> (a pow n = a rpow  &n)``,
3611 Induct_on `n` THENL [
3612 RW_TAC real_ss [pow,POW_1, rpow, GSYM EXP_0],
3613
3614GEN_TAC THEN
3615        RW_TAC std_ss[rpow,pow,REAL,REAL_RDISTRIB,EXP_ADD,REAL_MUL_LID] THEN
3616
3617        KNOW_TAC ``exp(ln a)= a`` THEN1
3618          PROVE_TAC[EXP_LN] THEN
3619        DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
3620        KNOW_TAC ``a* exp (&n * ln a) = exp (&n * ln a)*a`` THEN1
3621          RW_TAC std_ss[REAL_MUL_COMM] THEN
3622        DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC]);
3623
3624val  RPOW_SUC_N = store_thm
3625        ("RPOW_SUC_N",
3626        ``!(a:real) (n:num). 0 < a ==>(a rpow (&n+1)= a pow SUC n)``,
3627 RW_TAC std_ss [] THEN
3628 KNOW_TAC``&n + (1:real)= & SUC n`` THEN1
3629     RW_TAC std_ss [REAL]THEN
3630       DISCH_TAC THEN ONCE_ASM_REWRITE_TAC[] THEN
3631       RW_TAC std_ss [GEN_RPOW]) ;
3632
3633val RPOW_0= store_thm
3634        ("RPOW_0",
3635        ``! a. (0 < a)==> (a rpow  &0 = &1)``,
3636  RW_TAC std_ss [rpow]THEN
3637  RW_TAC std_ss [REAL_MUL_LZERO]THEN
3638  RW_TAC std_ss [EXP_0]);
3639
3640val  RPOW_1= store_thm
3641        ("RPOW_1",
3642        ``! a. (0 < a)==> ( a rpow  &1 = a)``,
3643   RW_TAC std_ss [GSYM GEN_RPOW,POW_1]);
3644
3645val  ONE_RPOW= store_thm
3646        ("ONE_RPOW",
3647        ``! a. (0 < a)==> (1 rpow a  = 1)``,
3648RW_TAC real_ss [rpow,LN_1,EXP_0]);
3649
3650val  RPOW_POS_LT= store_thm
3651        ("RPOW_POS_LT",
3652        ``! a b. (0 < a)==> (0 < a rpow b)``,
3653              RW_TAC std_ss [rpow, EXP_POS_LT]);
3654
3655val  RPOW_NZ= store_thm
3656        ("RPOW_NZ",
3657        ``! a b. (0 <> a)==> ( a rpow b <>0)``,
3658RW_TAC std_ss [rpow,EXP_NZ]);
3659
3660
3661val  LN_RPOW= store_thm
3662        ("LN_RPOW",
3663        ``! a b. (0 < a)==> (ln (a rpow b)= (b*ln a))``,
3664 RW_TAC std_ss [rpow,LN_EXP]);
3665
3666val  RPOW_ADD= store_thm
3667        ("RPOW_ADD",
3668        ``! a b c. a rpow (b + c)= (a rpow  b)*(a rpow  c)``,
3669 RW_TAC std_ss [rpow, EXP_ADD, REAL_RDISTRIB] );
3670
3671val  RPOW_ADD_MUL= store_thm
3672        ("RPOW_ADD_MUL",
3673        ``! a b c. a rpow (b + c)* a rpow (-b)= (a rpow c)``,
3674 RW_TAC std_ss [rpow, REAL_RDISTRIB, GSYM EXP_ADD]THEN
3675 KNOW_TAC`` ((b * ln a + c * ln a + -b * ln a)=(b * ln a  -b * ln a + c*ln a)) ``THEN1
3676    REAL_ARITH_TAC THEN
3677         DISCH_TAC THEN ASM_REWRITE_TAC[] THEN POP_ASSUM K_TAC THEN
3678     KNOW_TAC``((b * ln a - b * ln a + c * ln a) = (c*ln a )) ``THEN1
3679         REAL_ARITH_TAC THEN
3680         RW_TAC real_ss []);
3681
3682val  RPOW_SUB= store_thm
3683        ("RPOW_SUB",
3684        ``! a b c. a rpow (b - c)= (a rpow b)/(a rpow c)``,
3685RW_TAC std_ss [rpow, REAL_SUB_RDISTRIB, EXP_SUB]);
3686
3687val  RPOW_DIV= store_thm
3688        ("RPOW_DIV",
3689        ``! a b c.  (0 < a)/\ (0<b)==> ((a/b) rpow  c= (a rpow c)/(b rpow c))``,
3690   RW_TAC std_ss [rpow ,LN_DIV, REAL_SUB_LDISTRIB, EXP_SUB]);
3691
3692val  RPOW_INV= store_thm
3693        ("RPOW_INV",
3694        ``! a b .  (0 < a)==>((inv a) rpow b= inv (a rpow b))``,
3695
3696RW_TAC real_ss [rpow, REAL_INV_1OVER, LN_DIV, REAL_SUB_LDISTRIB, EXP_SUB, LN_1, EXP_0]);
3697
3698
3699val  RPOW_MUL= store_thm
3700        ("RPOW_MUL",
3701        ``! a b c. (0<a) /\ (0<b)==> (((a*b) rpow c)=(a rpow c)*(b rpow c))``,
3702RW_TAC std_ss [rpow, LN_MUL, REAL_LDISTRIB, EXP_ADD]);
3703
3704val  RPOW_RPOW= store_thm
3705        ("RPOW_RPOW",
3706        ``! a b c. (0<a)==> ((a rpow b) rpow c = a rpow (b*c))``,
3707  RW_TAC real_ss [rpow, LN_EXP, REAL_MUL_ASSOC] THEN
3708  PROVE_TAC[ REAL_MUL_COMM] );
3709
3710
3711val  RPOW_LT= store_thm
3712        ("RPOW_LT",
3713        ``! (a:real) (b:real) (c:real).(1 < a)==>((a rpow b < a rpow c)= b < c )``,
3714 RW_TAC std_ss [rpow]  THEN
3715 KNOW_TAC`` exp (b * ln a) < exp (c * ln a)= (b*ln a < c*ln a)``  THEN1
3716      RW_TAC real_ss [EXP_MONO_LT]  THEN
3717      DISCH_TAC THEN ASM_REWRITE_TAC[] THEN POP_ASSUM K_TAC  THEN
3718      KNOW_TAC``((b:real)*ln a < (c:real)*ln a)= (b < c)``  THENL   [
3719      MATCH_MP_TAC REAL_LT_RMUL  THEN
3720      KNOW_TAC``0 < ln a = exp (0) < exp (ln a)``  THEN1
3721         PROVE_TAC[EXP_MONO_LT]  THEN
3722         DISCH_TAC  THEN
3723         FULL_SIMP_TAC real_ss[]  THEN
3724         RW_TAC real_ss [EXP_0]  THEN
3725         KNOW_TAC``1 < (a:real) ==> 0 <(a:real)``  THENL [
3726             RW_TAC real_ss []  THEN
3727             MATCH_MP_TAC REAL_LT_TRANS  THEN
3728             EXISTS_TAC``(1:real)`` THEN
3729             RW_TAC real_ss [],
3730             RW_TAC real_ss []  THEN
3731             KNOW_TAC``exp (ln a)=(a:real)``  THEN1
3732                  RW_TAC real_ss [EXP_LN] THEN
3733                  DISCH_TAC THEN ASM_REWRITE_TAC[]],
3734            RW_TAC real_ss []]);
3735
3736val  RPOW_LE = store_thm
3737        ("RPOW_LE",
3738        ``!a b c. (1 < a)==>((a rpow b <= a rpow c)= b <= c )``,
3739 RW_TAC std_ss [rpow] THEN
3740 KNOW_TAC`` exp ((b:real) * ln a) <= exp ((c:real) * ln a)= ((b:real)*ln a <= (c:real)*ln a)`` THEN1
3741      RW_TAC real_ss [EXP_MONO_LE] THEN
3742 DISCH_TAC THEN ASM_REWRITE_TAC[] THEN POP_ASSUM K_TAC THEN
3743 KNOW_TAC``(b*ln a <= c*ln a)= ((b:real) <= (c:real))`` THENL[
3744          MATCH_MP_TAC REAL_LE_RMUL THEN
3745     KNOW_TAC``0 < ln a = exp (0) < exp (ln a)`` THEN1
3746         PROVE_TAC[EXP_MONO_LT] THEN
3747          DISCH_TAC THEN
3748          FULL_SIMP_TAC real_ss[] THEN
3749          RW_TAC real_ss [EXP_0] THEN
3750     KNOW_TAC``1 < (a:real) ==> 0 <(a:real)`` THENL[
3751          RW_TAC real_ss [] THEN
3752          MATCH_MP_TAC REAL_LT_TRANS THEN
3753          EXISTS_TAC``(1:real)`` THEN
3754          RW_TAC real_ss [] ,
3755          RW_TAC real_ss [] THEN
3756          KNOW_TAC``exp (ln a)=(a:real)`` THEN1
3757             RW_TAC real_ss [EXP_LN] THEN
3758             DISCH_TAC THEN ASM_REWRITE_TAC[]],
3759 RW_TAC real_ss []]);
3760
3761
3762val  BASE_RPOW_LE= store_thm
3763        ("BASE_RPOW_LE",
3764        ``! a b c. (0 < a)/\ (0 < c)/\ (0 < b)==>((a rpow b <= c rpow b)= a <= c )``,
3765RW_TAC std_ss [rpow, EXP_MONO_LE] THEN
3766KNOW_TAC`` (((b:real) * ln a) <= ((b:real) * ln c))= ((ln a <= ln c))`` THENL[
3767  MATCH_MP_TAC REAL_LE_LMUL   THEN
3768  RW_TAC real_ss [],
3769
3770  DISCH_TAC THEN ASM_REWRITE_TAC[] THEN POP_ASSUM K_TAC  THEN
3771  RW_TAC real_ss [LN_MONO_LE]]);
3772
3773val  BASE_RPOW_LT= store_thm
3774        ("BASE_RPOW_LT",
3775        ``! a b c. (0 < a)/\ (0 < c)/\ (0 < b)==>((a rpow b < c rpow b)= a < c )``,
3776
3777 RW_TAC std_ss [rpow, EXP_MONO_LT]  THEN
3778 KNOW_TAC ``((b * ln a) < (b * ln c))= ((ln a < ln c))``  THENL[
3779       MATCH_MP_TAC REAL_LT_LMUL  THEN
3780       RW_TAC real_ss []  ,
3781
3782       DISCH_TAC THEN ASM_REWRITE_TAC[] THEN POP_ASSUM K_TAC  THEN
3783       RW_TAC real_ss [LN_MONO_LT] ]);
3784
3785val  RPOW_UNIQ_BASE= store_thm (
3786  "RPOW_UNIQ_BASE",
3787  ``!a b c. 0 < a /\ 0 < c /\ 0 <> b /\ (a rpow b = c rpow b)==> (a = c)``,
3788
3789
3790 RW_TAC std_ss [rpow, GSYM LN_INJ]THEN
3791 POP_ASSUM MP_TAC  THEN
3792 KNOW_TAC`` (exp (b * ln a) = exp (b * ln c)) = (ln (exp (b * ln a)) = ln (exp (b * ln c)))``THEN1
3793     PROVE_TAC[LN_EXP]THEN
3794     DISCH_TAC THEN ASM_REWRITE_TAC[] THEN POP_ASSUM K_TAC THEN
3795     FULL_SIMP_TAC real_ss[LN_EXP] THEN
3796     FULL_SIMP_TAC real_ss[REAL_EQ_MUL_LCANCEL]);
3797
3798
3799val  RPOW_UNIQ_EXP = store_thm
3800        ("RPOW_UNIQ_EXP",
3801        ``!a b c. 1 < a /\ 0 < c /\ 0 < b /\ (a rpow b = a rpow c) ==>
3802                  (b = c)``,
3803 RW_TAC std_ss [rpow, GSYM LN_INJ] THEN
3804 POP_ASSUM MP_TAC THEN
3805 KNOW_TAC`` (exp (b * ln a) = exp (c * ln a)) = (ln (exp (b * ln a)) = ln (exp (c * ln a)))`` THEN1
3806      PROVE_TAC[LN_EXP] THEN
3807          DISCH_TAC THEN ASM_REWRITE_TAC[] THEN POP_ASSUM K_TAC THEN
3808          FULL_SIMP_TAC real_ss[LN_EXP] THEN
3809          FULL_SIMP_TAC real_ss[REAL_EQ_RMUL] THEN
3810          KNOW_TAC``(1 < (a:real))==> 0 < ln a`` THENL[
3811      RW_TAC real_ss [] THEN
3812      KNOW_TAC``0 < ln a = exp (0) < exp (ln a)`` THEN1
3813          PROVE_TAC[EXP_MONO_LT] THEN
3814          DISCH_TAC THEN
3815          FULL_SIMP_TAC real_ss[] THEN
3816          RW_TAC real_ss [EXP_0] THEN
3817              KNOW_TAC``1 < (a:real) ==> 0 <(a:real)`` THENL[
3818                   RW_TAC real_ss [] THEN
3819                   MATCH_MP_TAC REAL_LT_TRANS THEN
3820                   EXISTS_TAC``(1:real)`` THEN
3821                   RW_TAC real_ss [] ,
3822                   RW_TAC real_ss [] THEN
3823                   KNOW_TAC``exp (ln a)=(a:real)`` THEN1
3824                      RW_TAC real_ss [EXP_LN] THEN
3825       DISCH_TAC THEN ASM_REWRITE_TAC[] THEN  RW_TAC real_ss []],
3826 FULL_SIMP_TAC real_ss[REAL_POS_NZ] ]);
3827
3828val  RPOW_DIV_BASE= store_thm
3829        ("RPOW_DIV_BASE",
3830        `` ! x t. (0 < x)==> ((x rpow t)/x = x rpow (t-1))``,
3831RW_TAC std_ss [rpow, REAL_SUB_RDISTRIB, EXP_SUB, REAL_MUL_LID] THEN
3832KNOW_TAC``exp(ln x)= (x:real)`` THEN1
3833    PROVE_TAC[EXP_LN] THEN
3834DISCH_TAC THEN ASM_REWRITE_TAC [] );
3835
3836(*----------------------------------------------------------------*)
3837(* Differentiability of real powers                               *)
3838(*----------------------------------------------------------------*)
3839
3840val  DIFF_COMPOSITE_EXP = store_thm
3841        ("DIFF_COMPOSITE_EXP",
3842        ``!g m x. ((g diffl m) x ==> ((\x. exp (g x)) diffl (exp (g x) * m)) x)``,
3843       RW_TAC std_ss [DIFF_COMPOSITE]);
3844
3845val  DIFF_RPOW = store_thm
3846        ("DIFF_RPOW",
3847        ``!x y. 0 < x ==> (((\x. (x rpow y)) diffl (y* (x rpow (y-1))))x )``,
3848RW_TAC real_ss [rpow,GSYM RPOW_DIV_BASE] THEN
3849RW_TAC real_ss [REAL_MUL_ASSOC,real_div,REAL_MUL_COMM]THEN
3850RW_TAC real_ss [GSYM real_div] THEN
3851KNOW_TAC ``!x'. exp ((y * ln x')) = exp ((\x'. y *ln x') x')`` THEN1
3852     RW_TAC real_ss [] THEN
3853DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
3854KNOW_TAC `` ((y / x) * exp ((\x'. y * ln x') x))= ( exp ((\x'. y * ln x') x)*(y/x) ) `` THEN1
3855     RW_TAC std_ss [REAL_MUL_COMM] THEN
3856DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
3857MATCH_MP_TAC DIFF_COMPOSITE_EXP THEN
3858KNOW_TAC ``((\x. y * ln x) diffl (y/x)) x = ((\x. y * (\x.ln x) x) diffl (y/x)) x`` THEN1
3859     RW_TAC real_ss [] THEN
3860DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN
3861RW_TAC real_ss [real_div] THEN
3862MATCH_MP_TAC DIFF_CMUL THEN
3863MATCH_MP_TAC DIFF_LN THEN
3864RW_TAC real_ss []);
3865
3866
3867(*
3868val MCLAURIN_LN_POS = store_thm("MCLAURIN_LN_POS",
3869 Term`!x n.
3870     &0 < x /\ 0 < n
3871     ==> ?t. &0 < t /\
3872             t < x  /\
3873             (ln(&1 + x)
3874              = sum(0,n) (\m. ~(&1) pow (SUC m) * (x pow m) / &m)
3875                +
3876               ~(&1) pow (SUC n) * x pow n / (&n * (&1 + t) pow n))`,
3877  REPEAT STRIP_TAC THEN
3878  MP_TAC(SPEC (Term`\x. ln(&1 + x)`) MCLAURIN) THEN
3879  DISCH_THEN(MP_TAC o SPEC
3880    (Term`\n x. (n=0) => ln(&1 + x)
3881                      |  ~(&1) pow (SUC n)
3882                         *  &(FACT(PRE n)) * inv((&1 + x) pow n)`)) THEN
3883  DISCH_THEN(MP_TAC o SPECL [Term`x:real`, Term`n:num`]) THEN
3884  BETA_TAC THEN ASM_REWRITE_TAC[] THEN
3885  REWRITE_TAC[NOT_SUC, REAL_ADD_RID, POW_ONE, LN_1, REAL_INV1,REAL_MUL_RID] THEN
3886  SUBGOAL_THEN (Term`~(n = 0)`) ASSUME_TAC THENL
3887   [IMP_RES_TAC lem, ASM_REWRITE_TAC[]] THEN
3888  SUBGOAL_THEN (Term`!p. ~(p = 0) ==> (&(FACT(PRE p)) / &(FACT p) = inv(&p))`)
3889  ASSUME_TAC THENL
3890   [INDUCT_TAC THEN REWRITE_TAC[NOT_SUC, PRE] THEN
3891    REWRITE_TAC[real_div, FACT, GSYM REAL_OF_NUM_MUL] THEN
3892    SUBGOAL_THEN (Term `~(& (SUC p) = &0) /\ ~(& (FACT p) = &0)`)
3893     (fn th => REWRITE_TAC [MATCH_MP REAL_INV_MUL th]) THENL
3894    [REWRITE_TAC[REAL_OF_NUM_EQ,NOT_SUC] THEN MATCH_MP_TAC lem THEN
3895     MATCH_ACCEPT_TAC FACT_LESS,
3896     ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
3897     GEN_REWRITE_TAC RAND_CONV [] [GSYM REAL_MUL_RID] THEN
3898     REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN
3899     AP_TERM_TAC THEN MATCH_MP_TAC REAL_MUL_LINV THEN
3900     REWRITE_TAC[REAL_OF_NUM_EQ] THEN MATCH_MP_TAC lem THEN
3901     MATCH_ACCEPT_TAC FACT_LESS], ALL_TAC] THEN
3902  SUBGOAL_THEN (Term
3903   `!p. (p = 0 => &0 | ~(&1) pow (SUC p) * &(FACT (PRE p)))
3904         / &(FACT p)
3905         =
3906        ~(&1) pow (SUC p) * inv(&p)`)
3907   (fn th => REWRITE_TAC[th]) THENL
3908   [INDUCT_TAC THENL
3909     [REWRITE_TAC[REAL_INV_0, real_div, REAL_MUL_LZERO, REAL_MUL_RZERO],
3910      REWRITE_TAC[NOT_SUC] THEN
3911      REWRITE_TAC[real_div, GSYM REAL_MUL_ASSOC] THEN
3912      AP_TERM_TAC THEN REWRITE_TAC[GSYM real_div] THEN
3913      FIRST_ASSUM MATCH_MP_TAC THEN
3914      REWRITE_TAC[NOT_SUC]], ALL_TAC] THEN
3915  SUBGOAL_THEN (Term -- what does this parse to???
3916    `!t. ((~(&1) pow (SUC n) * &(FACT(PRE n)) * inv ((&1 + t) pow n))
3917          / &(FACT n)) * x pow n
3918        =
3919         ~(&1) pow (SUC n) * x pow n / (&n * (&1 + t) pow n)`)
3920   (fn th => REWRITE_TAC[th]) THENL
3921   [GEN_TAC THEN REWRITE_TAC[real_div, GSYM REAL_MUL_ASSOC] THEN
3922    AP_TERM_TAC THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN
3923    GEN_REWRITE_TAC LAND_CONV [] [REAL_MUL_SYM] THEN AP_TERM_TAC THEN
3924    SUBGOAL_THEN (Term`~(& n = &0) /\ ~((& 1 + t) pow n = &0)`)
3925      (fn th => REWRITE_TAC [MATCH_MP REAL_INV_MUL th]) THENL
3926    [CONJ_TAC THENL
3927      [REWRITE_TAC [REAL_OF_NUM_EQ] THEN IMP_RES_TAC lem,
3928       MATCH_MP_TAC POW_NZ THEN REWRITE_TAC [REAL_OF_NUM_EQ]
3929    ,GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN
3930    REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN
3931    ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN
3932    FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[], ALL_TAC] THEN
3933  REWRITE_TAC[real_div, REAL_MUL_AC] THEN
3934  DISCH_THEN MATCH_MP_TAC THEN
3935  X_GEN_TAC `m:num` THEN X_GEN_TAC `u:real` THEN STRIP_TAC THEN
3936  ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[] THENL
3937   [W(MP_TAC o SPEC `u:real` o DIFF_CONV o lhand o rator o snd) THEN
3938    REWRITE_TAC[PRE, real_pow, REAL_ADD_LID, REAL_MUL_RID] THEN
3939    REWRITE_TAC[REAL_MUL_RNEG, REAL_MUL_LNEG, REAL_MUL_RID] THEN
3940    REWRITE_TAC[FACT, REAL_MUL_RID, REAL_NEG_NEG] THEN
3941    DISCH_THEN MATCH_MP_TAC THEN UNDISCH_TAC `&0 <= u` THEN REAL_ARITH_TAC,
3942    W(MP_TAC o SPEC `u:real` o DIFF_CONV o lhand o rator o snd) THEN
3943    SUBGOAL_THEN `~((&1 + u) pow m = &0)` (fun th -> REWRITE_TAC[th]) THENL
3944     [REWRITE_TAC[REAL_POW_EQ_0] THEN ASM_REWRITE_TAC[] THEN
3945      UNDISCH_TAC `&0 <= u` THEN REAL_ARITH_TAC,
3946      MATCH_MP_TAC (TAUT `(a = b) ==> a ==> b`) THEN
3947      AP_THM_TAC THEN AP_TERM_TAC THEN
3948      REWRITE_TAC[REAL_MUL_LZERO, REAL_ADD_RID] THEN
3949      REWRITE_TAC[REAL_ADD_LID, REAL_MUL_RID] THEN
3950      REWRITE_TAC[real_div, real_pow, REAL_MUL_LNEG, REAL_MUL_RNEG] THEN
3951      REWRITE_TAC[REAL_NEG_NEG, REAL_MUL_RID, REAL_MUL_LID] THEN
3952      REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN
3953      UNDISCH_TAC `~(m = 0)` THEN SPEC_TAC(`m:num`,`p:num`) THEN
3954      INDUCT_TAC THEN REWRITE_TAC[NOT_SUC] THEN
3955      REWRITE_TAC[SUC_SUB1, PRE] THEN REWRITE_TAC[FACT] THEN
3956      REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN
3957      REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN
3958      GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN
3959      REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN
3960      REWRITE_TAC[real_pow, REAL_POW_2] THEN REWRITE_TAC[REAL_INV_MUL] THEN
3961      REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN
3962      REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN
3963      ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
3964      GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN
3965      REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN
3966      MATCH_MP_TAC REAL_MUL_LINV THEN
3967      REWRITE_TAC[REAL_POW_EQ_0] THEN ASM_REWRITE_TAC[] THEN
3968      REWRITE_TAC[DE_MORGAN_THM] THEN DISJ1_TAC THEN
3969      UNDISCH_TAC `&0 <= u` THEN REAL_ARITH_TAC]]),,
3970
3971let MCLAURIN_LN_NEG = prove
3972 (`!x n. &0 < x /\ x < &1 /\ 0 < n
3973         ==> ?t. &0 < t /\
3974                 t < x /\
3975                 (--(ln(&1 - x)) = Sum(0,n) (\m. (x pow m) / &m) +
3976                                    x pow n / (&n * (&1 - t) pow n))`,
3977  REPEAT STRIP_TAC THEN
3978  MP_TAC(SPEC `\x. --(ln(&1 - x))` MCLAURIN) THEN
3979  DISCH_THEN(MP_TAC o SPEC
3980    `\n x. if n = 0 then --(ln(&1 - x))
3981           else &(FACT(PRE n)) * inv((&1 - x) pow n)`) THEN
3982  DISCH_THEN(MP_TAC o SPECL [`x:real`, `n:num`]) THEN
3983  ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_SUB_RZERO] THEN
3984  REWRITE_TAC[NOT_SUC, LN_1, REAL_POW_ONE] THEN
3985  SUBGOAL_THEN `~(n = 0)` ASSUME_TAC THENL
3986   [UNDISCH_TAC `0 < n` THEN ARITH_TAC, ASM_REWRITE_TAC[]] THEN
3987  REWRITE_TAC[REAL_INV_1, REAL_MUL_RID, REAL_MUL_LID] THEN
3988  SUBGOAL_THEN `!p. ~(p = 0) ==> (&(FACT(PRE p)) / &(FACT p) = inv(&p))`
3989  ASSUME_TAC THENL
3990   [INDUCT_TAC THEN REWRITE_TAC[NOT_SUC, PRE] THEN
3991    REWRITE_TAC[real_div, FACT, GSYM REAL_OF_NUM_MUL] THEN
3992    REWRITE_TAC[REAL_INV_MUL] THEN
3993    ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
3994    GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN
3995    REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN
3996    AP_TERM_TAC THEN MATCH_MP_TAC REAL_MUL_LINV THEN
3997    REWRITE_TAC[REAL_OF_NUM_EQ] THEN
3998    MP_TAC(SPEC `p:num` FACT_LT) THEN ARITH_TAC, ALL_TAC] THEN
3999  REWRITE_TAC[REAL_NEG_0] THEN
4000  SUBGOAL_THEN `!p. (if p = 0 then &0 else &(FACT (PRE p))) / &(FACT p) =
4001                    inv(&p)`
4002  (fun th -> REWRITE_TAC[th]) THENL
4003   [INDUCT_TAC THENL
4004     [REWRITE_TAC[REAL_INV_0, real_div, REAL_MUL_LZERO],
4005      REWRITE_TAC[NOT_SUC] THEN FIRST_ASSUM MATCH_MP_TAC THEN
4006      REWRITE_TAC[NOT_SUC]], ALL_TAC] THEN
4007  SUBGOAL_THEN
4008    `!t. (&(FACT(PRE n)) * inv ((&1 - t) pow n)) / &(FACT n) * x pow n
4009         = x pow n / (&n * (&1 - t) pow n)`
4010  (fun th -> REWRITE_TAC[th]) THENL
4011   [GEN_TAC THEN REWRITE_TAC[real_div, REAL_MUL_ASSOC] THEN
4012    GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN AP_TERM_TAC THEN
4013    REWRITE_TAC[REAL_INV_MUL] THEN
4014    GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN
4015    REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN
4016    ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN
4017    FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[], ALL_TAC] THEN
4018  REWRITE_TAC[real_div, REAL_MUL_AC] THEN
4019  DISCH_THEN MATCH_MP_TAC THEN
4020  X_GEN_TAC `m:num` THEN X_GEN_TAC `u:real` THEN STRIP_TAC THEN
4021  ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[] THENL
4022   [W(MP_TAC o SPEC `u:real` o DIFF_CONV o lhand o rator o snd) THEN
4023    REWRITE_TAC[PRE, pow, FACT, REAL_SUB_LZERO] THEN
4024    REWRITE_TAC[REAL_MUL_RNEG, REAL_NEG_NEG, REAL_MUL_RID] THEN
4025    DISCH_THEN MATCH_MP_TAC THEN
4026    UNDISCH_TAC `x < &1` THEN UNDISCH_TAC `u:real <= x` THEN
4027    REAL_ARITH_TAC,
4028    W(MP_TAC o SPEC `u:real` o DIFF_CONV o lhand o rator o snd) THEN
4029    SUBGOAL_THEN `~((&1 - u) pow m = &0)` (fun th -> REWRITE_TAC[th]) THENL
4030     [REWRITE_TAC[REAL_POW_EQ_0] THEN ASM_REWRITE_TAC[] THEN
4031      UNDISCH_TAC `x < &1` THEN UNDISCH_TAC `u:real <= x` THEN
4032      REAL_ARITH_TAC,
4033      MATCH_MP_TAC (TAUT `(a = b) ==> a ==> b`) THEN
4034      AP_THM_TAC THEN AP_TERM_TAC THEN
4035      REWRITE_TAC[REAL_SUB_LZERO, real_div, PRE] THEN
4036      REWRITE_TAC[REAL_MUL_LZERO, REAL_ADD_RID] THEN
4037      REWRITE_TAC
4038       [REAL_MUL_RNEG, REAL_MUL_LNEG, REAL_NEG_NEG, REAL_MUL_RID] THEN
4039      UNDISCH_TAC `~(m = 0)` THEN SPEC_TAC(`m:num`,`p:num`) THEN
4040      INDUCT_TAC THEN REWRITE_TAC[NOT_SUC] THEN
4041      REWRITE_TAC[SUC_SUB1, PRE] THEN REWRITE_TAC[FACT] THEN
4042      REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN
4043      REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN
4044      GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN
4045      REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN
4046      REWRITE_TAC[real_pow, REAL_POW_2] THEN REWRITE_TAC[REAL_INV_MUL] THEN
4047      REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN
4048      REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN
4049      ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
4050      GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN
4051      REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN
4052      MATCH_MP_TAC REAL_MUL_LINV THEN
4053      REWRITE_TAC[REAL_POW_EQ_0] THEN ASM_REWRITE_TAC[] THEN
4054      UNDISCH_TAC `x < &1` THEN UNDISCH_TAC `u:real <= x` THEN
4055      REAL_ARITH_TAC]]);
4056endnew*)
4057
4058val _ = export_theory();
4059