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