transcScript.sml
1(*===========================================================================*)
2(* Definitions of the transcendental functions etc. *)
3(*===========================================================================*)
4
5(* ----------------------------------------------------------------------
6 Exponentiation with real exponents (rpow)
7
8 Contributed by
9
10 Umair Siddique
11
12 Email: umair.siddique@rcms.nust.edu.pk
13 DATE: 29-12-2010
14
15 System Analysis & Verification (sAvE) LAB
16
17 National University of Sciences and Technology (NUST)
18 Ialamabad,Pakistan
19 ---------------------------------------------------------------------- *)
20
21Theory transc
22Ancestors
23 pair num prim_rec arithmetic real metric nets real_sigma
24 pred_set iterate real_topology derivative seq lim powser
25Libs
26 reduceLib realLib numLib jrhUtils Diff mesonLib hurdUtils
27
28val _ = Parse.reveal "B";
29
30val MVT = limTheory.MVT;
31val ROLLE = limTheory.ROLLE;
32val summable = seqTheory.summable;
33val differentiable = limTheory.differentiable;
34
35(*---------------------------------------------------------------------------*)
36(* The three functions we define by series are exp, sin, cos *)
37(*---------------------------------------------------------------------------*)
38
39val sin_ser =
40 “\n. if EVEN n then &0
41 else ((~(&1)) pow ((n - 1) DIV 2)) / &(FACT n)”;
42
43val cos_ser =
44 “\n. if EVEN n then ((~(&1)) pow (n DIV 2)) / &(FACT n) else &0”;
45
46val exp_ser = “\n. inv(&(FACT n))”;
47
48Theorem exp :
49 !x. exp(x) = suminf (\n. (^exp_ser) n * (x pow n))
50Proof
51 REWRITE_TAC [exp_def, suminf_univ]
52QED
53
54Definition cos[nocompute]:
55 cos(x) = suminf(\n. (^cos_ser) n * (x pow n))
56End
57
58Definition sin[nocompute]:
59 sin(x) = suminf(\n. (^sin_ser) n * (x pow n))
60End
61
62(*---------------------------------------------------------------------------*)
63(* Show the series for exp converges, using the ratio test *)
64(*---------------------------------------------------------------------------*)
65
66Theorem EXP_CONVERGES :
67 !x. (\n. (^exp_ser) n * (x pow n)) sums exp(x)
68Proof
69 RW_TAC std_ss [Once REAL_MUL_COMM, GSYM real_div]
70 >> REWRITE_TAC [REWRITE_RULE [sums_univ, FROM_0]
71 derivativeTheory.EXP_CONVERGES]
72QED
73
74(*---------------------------------------------------------------------------*)
75(* Show by the comparison test that sin and cos converge *)
76(*---------------------------------------------------------------------------*)
77
78Theorem SIN_CONVERGES:
79 !x. (\n. (^sin_ser) n * (x pow n)) sums sin(x)
80Proof
81 GEN_TAC THEN REWRITE_TAC[sin] THEN MATCH_MP_TAC SUMMABLE_SUM THEN
82 MATCH_MP_TAC SER_COMPAR THEN
83 EXISTS_TAC “\n. ^exp_ser n * (abs(x) pow n)” THEN
84 REWRITE_TAC[MATCH_MP SUM_SUMMABLE (SPEC_ALL EXP_CONVERGES)] THEN
85 EXISTS_TAC “0:num” THEN X_GEN_TAC “n:num” THEN
86 DISCH_THEN(K ALL_TAC) THEN BETA_TAC THEN COND_CASES_TAC THEN
87 REWRITE_TAC[ABS_MUL, POW_ABS] THENL
88 [REWRITE_TAC[ABS_0, REAL_MUL_LZERO] THEN MATCH_MP_TAC REAL_LE_MUL THEN
89 REWRITE_TAC[ABS_POS],
90 REWRITE_TAC[real_div, ABS_MUL, POW_M1, REAL_MUL_LID] THEN
91 MATCH_MP_TAC REAL_LE_RMUL_IMP THEN REWRITE_TAC[ABS_POS] THEN
92 MATCH_MP_TAC REAL_EQ_IMP_LE THEN REWRITE_TAC[ABS_REFL]] THEN
93 MAP_EVERY MATCH_MP_TAC [REAL_LT_IMP_LE, REAL_INV_POS] THEN
94 REWRITE_TAC[REAL_LT, FACT_LESS]
95QED
96
97Theorem COS_CONVERGES:
98 !x. (\n. (^cos_ser) n * (x pow n)) sums cos(x)
99Proof
100 GEN_TAC THEN REWRITE_TAC[cos] THEN MATCH_MP_TAC SUMMABLE_SUM THEN
101 MATCH_MP_TAC SER_COMPAR THEN
102 EXISTS_TAC “\n. (^exp_ser) n * (abs(x) pow n)” THEN
103 REWRITE_TAC[MATCH_MP SUM_SUMMABLE (SPEC_ALL EXP_CONVERGES)] THEN
104 EXISTS_TAC “0:num” THEN X_GEN_TAC “n:num” THEN
105 DISCH_THEN(K ALL_TAC) THEN BETA_TAC THEN COND_CASES_TAC THEN
106 REWRITE_TAC[ABS_MUL, POW_ABS] THENL
107 [REWRITE_TAC[real_div, ABS_MUL, POW_M1, REAL_MUL_LID] THEN
108 MATCH_MP_TAC REAL_LE_RMUL_IMP THEN REWRITE_TAC[ABS_POS] THEN
109 MATCH_MP_TAC REAL_EQ_IMP_LE THEN REWRITE_TAC[ABS_REFL],
110 REWRITE_TAC[ABS_0, REAL_MUL_LZERO] THEN MATCH_MP_TAC REAL_LE_MUL THEN
111 REWRITE_TAC[ABS_POS]] THEN
112 MAP_EVERY MATCH_MP_TAC [REAL_LT_IMP_LE, REAL_INV_POS] THEN
113 REWRITE_TAC[REAL_LT, FACT_LESS]
114QED
115
116(*---------------------------------------------------------------------------*)
117(* Show what the formal derivatives of these series are *)
118(*---------------------------------------------------------------------------*)
119
120(* also known as REAL_EXP_FDIFF *)
121Theorem EXP_FDIFF:
122 diffs ^exp_ser = ^exp_ser
123Proof
124 REWRITE_TAC[diffs] THEN BETA_TAC THEN
125 CONV_TAC(X_FUN_EQ_CONV “n:num”) THEN GEN_TAC THEN BETA_TAC THEN
126 REWRITE_TAC[FACT, GSYM REAL_MUL] THEN
127 SUBGOAL_THEN “~(&(SUC n) = &0) /\ ~(&(FACT n) = &0)” ASSUME_TAC THENL
128 [CONJ_TAC THEN CONV_TAC(RAND_CONV SYM_CONV) THEN
129 MATCH_MP_TAC REAL_LT_IMP_NE THEN
130 REWRITE_TAC[REAL_LT, LESS_0, FACT_LESS],
131 FIRST_ASSUM(fn th => REWRITE_TAC[MATCH_MP REAL_INV_MUL th]) THEN
132 GEN_REWR_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN
133 REWRITE_TAC[REAL_MUL_ASSOC, REAL_EQ_RMUL] THEN DISJ2_TAC THEN
134 MATCH_MP_TAC REAL_MUL_RINV THEN ASM_REWRITE_TAC[]]
135QED
136
137Theorem SIN_FDIFF:
138 diffs ^sin_ser = ^cos_ser
139Proof
140 REWRITE_TAC[diffs] THEN BETA_TAC THEN
141 CONV_TAC(X_FUN_EQ_CONV “n:num”) THEN GEN_TAC THEN BETA_TAC THEN
142 COND_CASES_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[EVEN]) THEN
143 ASM_REWRITE_TAC[REAL_MUL_RZERO] THEN REWRITE_TAC[SUC_SUB1] THEN
144 ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
145 REWRITE_TAC[real_div, GSYM REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN
146 REWRITE_TAC[FACT, GSYM REAL_MUL] THEN
147 SUBGOAL_THEN “~(&(SUC n) = &0) /\ ~(&(FACT n) = &0)” ASSUME_TAC THENL
148 [CONJ_TAC THEN CONV_TAC(RAND_CONV SYM_CONV) THEN
149 MATCH_MP_TAC REAL_LT_IMP_NE THEN
150 REWRITE_TAC[REAL_LT, LESS_0, FACT_LESS],
151 FIRST_ASSUM(fn th => REWRITE_TAC[MATCH_MP REAL_INV_MUL th]) THEN
152 REWRITE_TAC[REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
153 GEN_REWR_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN
154 REWRITE_TAC[REAL_MUL_ASSOC, REAL_EQ_RMUL] THEN DISJ2_TAC THEN
155 MATCH_MP_TAC REAL_MUL_RINV THEN ASM_REWRITE_TAC[]]
156QED
157
158Theorem COS_FDIFF:
159 diffs ^cos_ser = (\n. ~((^sin_ser) n))
160Proof
161 REWRITE_TAC[diffs] THEN BETA_TAC THEN
162 CONV_TAC(X_FUN_EQ_CONV “n:num”) THEN GEN_TAC THEN BETA_TAC THEN
163 COND_CASES_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[EVEN]) THEN
164 ASM_REWRITE_TAC[REAL_MUL_RZERO, REAL_NEG_0] THEN
165 ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
166 REWRITE_TAC[real_div, REAL_NEG_LMUL] THEN
167 REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN BINOP_TAC THENL
168 [POP_ASSUM(SUBST1_TAC o MATCH_MP EVEN_DIV_2) THEN
169 REWRITE_TAC[pow] THEN REWRITE_TAC[GSYM REAL_NEG_MINUS1],
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 REWRITE_TAC[REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
177 GEN_REWR_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN
178 REWRITE_TAC[REAL_MUL_ASSOC, REAL_EQ_RMUL] THEN DISJ2_TAC THEN
179 MATCH_MP_TAC REAL_MUL_RINV THEN ASM_REWRITE_TAC[]]]
180QED
181
182(*---------------------------------------------------------------------------*)
183(* Now at last we can get the derivatives of exp, sin and cos *)
184(*---------------------------------------------------------------------------*)
185
186Theorem SIN_NEGLEMMA:
187 !x. ~(sin x) = suminf (\n. ~((^sin_ser) n * (x pow n)))
188Proof
189 GEN_TAC THEN MATCH_MP_TAC SUM_UNIQ THEN
190 MP_TAC(MATCH_MP SER_NEG (SPEC “x:real” SIN_CONVERGES)) THEN
191 BETA_TAC THEN DISCH_THEN ACCEPT_TAC
192QED
193
194Theorem DIFF_EXP[difftool]:
195 !x. (exp diffl exp(x))(x)
196Proof
197 GEN_TAC THEN REWRITE_TAC[HALF_MK_ABS exp] THEN
198 GEN_REWR_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM EXP_FDIFF] THEN
199 CONV_TAC(LAND_CONV BETA_CONV) THEN
200 MATCH_MP_TAC TERMDIFF THEN EXISTS_TAC “abs(x) + &1” THEN
201 REWRITE_TAC[EXP_FDIFF, MATCH_MP SUM_SUMMABLE (SPEC_ALL EXP_CONVERGES)] THEN
202 MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC “abs(x) + &1” THEN
203 REWRITE_TAC[ABS_LE, REAL_LT_ADDR] THEN
204 REWRITE_TAC[REAL_LT, ONE, LESS_0]
205QED
206
207Theorem diffn_exp :
208 !n x. diffn n exp = exp
209Proof
210 Induct_on ‘n’ >- rw [diffn_0]
211 >> rw [FUN_EQ_THM, diffn_def]
212 >> SELECT_ELIM_TAC
213 >> CONJ_TAC
214 >- (Q.EXISTS_TAC ‘exp x’ \\
215 REWRITE_TAC [DIFF_EXP])
216 >> Q.X_GEN_TAC ‘y’ >> STRIP_TAC
217 >> MATCH_MP_TAC DIFF_UNIQ
218 >> qexistsl_tac [‘exp’, ‘x’]
219 >> simp [DIFF_EXP]
220QED
221
222Theorem higher_differentiable_exp :
223 !n x. higher_differentiable n exp x
224Proof
225 Induct_on ‘n’
226 >- simp [higher_differentiable_def]
227 >> rw [higher_differentiable_def, diffn_exp]
228 >> Q.EXISTS_TAC ‘exp x’
229 >> REWRITE_TAC [DIFF_EXP]
230QED
231
232Theorem DIFF_SIN[difftool]:
233 !x. (sin diffl cos(x))(x)
234Proof
235 GEN_TAC THEN REWRITE_TAC[HALF_MK_ABS sin, cos] THEN
236 ONCE_REWRITE_TAC[GSYM SIN_FDIFF] THEN
237 MATCH_MP_TAC TERMDIFF THEN EXISTS_TAC “abs(x) + &1” THEN
238 REPEAT CONJ_TAC THENL
239 [REWRITE_TAC[MATCH_MP SUM_SUMMABLE (SPEC_ALL SIN_CONVERGES)],
240 REWRITE_TAC[SIN_FDIFF, MATCH_MP SUM_SUMMABLE (SPEC_ALL COS_CONVERGES)],
241 REWRITE_TAC[SIN_FDIFF, COS_FDIFF] THEN BETA_TAC THEN
242 MP_TAC(SPEC “abs(x) + &1” SIN_CONVERGES) THEN
243 DISCH_THEN(MP_TAC o MATCH_MP SER_NEG) THEN
244 DISCH_THEN(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN BETA_TAC THEN
245 REWRITE_TAC[GSYM REAL_NEG_LMUL],
246 MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC “abs(x) + &1” THEN
247 REWRITE_TAC[ABS_LE, REAL_LT_ADDR] THEN
248 REWRITE_TAC[REAL_LT, ONE, LESS_0]]
249QED
250
251Theorem DIFF_COS[difftool]:
252 !x. (cos diffl ~(sin(x)))(x)
253Proof
254 GEN_TAC THEN REWRITE_TAC[HALF_MK_ABS cos, SIN_NEGLEMMA] THEN
255 ONCE_REWRITE_TAC[REAL_NEG_LMUL] THEN
256 REWRITE_TAC[GSYM(CONV_RULE(RAND_CONV BETA_CONV)
257 (AP_THM COS_FDIFF “n:num”))] THEN
258 MATCH_MP_TAC TERMDIFF THEN EXISTS_TAC “abs(x) + &1” THEN
259 REPEAT CONJ_TAC THENL
260 [REWRITE_TAC[MATCH_MP SUM_SUMMABLE (SPEC_ALL COS_CONVERGES)],
261 REWRITE_TAC[COS_FDIFF] THEN
262 MP_TAC(SPEC “abs(x) + &1” SIN_CONVERGES) THEN
263 DISCH_THEN(MP_TAC o MATCH_MP SER_NEG) THEN
264 DISCH_THEN(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN BETA_TAC THEN
265 REWRITE_TAC[GSYM REAL_NEG_LMUL],
266 REWRITE_TAC[COS_FDIFF, DIFFS_NEG] THEN
267 MP_TAC SIN_FDIFF THEN BETA_TAC THEN
268 DISCH_THEN(fn th => REWRITE_TAC[th]) THEN
269 MP_TAC(SPEC “abs(x) + &1” COS_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 MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC “abs(x) + &1” THEN
274 REWRITE_TAC[ABS_LE, REAL_LT_ADDR] THEN
275 REWRITE_TAC[REAL_LT, ONE, LESS_0]]
276QED
277
278(* ------------------------------------------------------------------------- *)
279(* Processed versions of composition theorems. *)
280(* ------------------------------------------------------------------------- *)
281
282Theorem DIFF_COMPOSITE[difftool]:
283 ((f diffl l)(x) /\ ~(f(x) = &0) ==>
284 ((\x. inv(f x)) diffl ~(l / (f(x) pow 2)))(x)) /\
285 ((f diffl l)(x) /\ (g diffl m)(x) /\ ~(g(x) = &0) ==>
286 ((\x. f(x) / g(x)) diffl (((l * g(x)) - (m * f(x)))
287 / (g(x) pow 2)))(x)) /\
288 ((f diffl l)(x) /\ (g diffl m)(x) ==>
289 ((\x. f(x) + g(x)) diffl (l + m))(x)) /\
290 ((f diffl l)(x) /\ (g diffl m)(x) ==>
291 ((\x. f(x) * g(x)) diffl ((l * g(x)) + (m * f(x))))(x)) /\
292 ((f diffl l)(x) /\ (g diffl m)(x) ==>
293 ((\x. f(x) - g(x)) diffl (l - m))(x)) /\
294 ((f diffl l)(x) ==> ((\x. ~(f x)) diffl ~l)(x)) /\
295 ((g diffl m)(x) ==>
296 ((\x. (g x) pow n) diffl ((&n * (g x) pow (n - 1)) * m))(x)) /\
297 ((g diffl m)(x) ==> ((\x. exp(g x)) diffl (exp(g x) * m))(x)) /\
298 ((g diffl m)(x) ==> ((\x. sin(g x)) diffl (cos(g x) * m))(x)) /\
299 ((g diffl m)(x) ==> ((\x. cos(g x)) diffl (~(sin(g x)) * m))(x))
300Proof
301 REWRITE_TAC[DIFF_INV, DIFF_DIV, DIFF_ADD, DIFF_SUB, DIFF_MUL, DIFF_NEG] THEN
302 REPEAT CONJ_TAC THEN DISCH_TAC THEN
303 TRY(MATCH_MP_TAC DIFF_CHAIN THEN
304 ASM_REWRITE_TAC[DIFF_SIN, DIFF_COS, DIFF_EXP]) THEN
305 MATCH_MP_TAC(BETA_RULE (SPEC (Term`\x. x pow n`) DIFF_CHAIN)) THEN
306 ASM_REWRITE_TAC[DIFF_POW]
307QED
308
309(*---------------------------------------------------------------------------*)
310(* Properties of the exponential function *)
311(*---------------------------------------------------------------------------*)
312
313(* also known as REAL_EXP_0 *)
314Theorem EXP_0:
315 exp(&0) = &1
316Proof
317 REWRITE_TAC[exp] THEN CONV_TAC SYM_CONV THEN
318 MATCH_MP_TAC SUM_UNIQ THEN BETA_TAC THEN
319 W(MP_TAC o C SPEC SER_0 o rand o rator o snd) THEN
320 DISCH_THEN(MP_TAC o SPEC “1:num”) THEN
321 REWRITE_TAC[ONE, sum] THEN
322 REWRITE_TAC[ADD_CLAUSES, REAL_ADD_LID] THEN BETA_TAC THEN
323 REWRITE_TAC[FACT, pow, REAL_MUL_RID, REAL_INV1] THEN
324 REWRITE_TAC[SYM(ONE)] THEN DISCH_THEN MATCH_MP_TAC THEN
325 X_GEN_TAC “n:num” THEN REWRITE_TAC[ONE, GSYM LESS_EQ] THEN
326 DISCH_THEN(CHOOSE_THEN SUBST1_TAC o MATCH_MP LESS_ADD_1) THEN
327 REWRITE_TAC[GSYM ADD1, POW_0, REAL_MUL_RZERO, ADD_CLAUSES]
328QED
329
330(* also known as REAL_EXP_LE_X *)
331Theorem EXP_LE_X:
332 !x. &0 <= x ==> (&1 + x) <= exp(x)
333Proof
334GEN_TAC THEN DISCH_THEN(DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT]) THENL
335 [MP_TAC(SPECL [Term`\n. ^exp_ser n * (x pow n)`,Term`2:num`] SER_POS_LE) THEN
336 REWRITE_TAC[MATCH_MP SUM_SUMMABLE (SPEC_ALL EXP_CONVERGES)] THEN
337 REWRITE_TAC[GSYM exp] THEN BETA_TAC THEN
338 W(C SUBGOAL_THEN (fn t => REWRITE_TAC[t]) o
339 funpow 2 (fst o dest_imp) o snd) THENL
340 [GEN_TAC THEN DISCH_THEN(K ALL_TAC) THEN
341 MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL
342 [MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC REAL_INV_POS THEN
343 REWRITE_TAC[REAL_LT, FACT_LESS],
344 MATCH_MP_TAC POW_POS THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN
345 FIRST_ASSUM ACCEPT_TAC],
346 CONV_TAC(TOP_DEPTH_CONV num_CONV) THEN REWRITE_TAC[sum] THEN
347 BETA_TAC THEN REWRITE_TAC[ADD_CLAUSES, FACT, pow, REAL_ADD_LID] THEN
348 (* new term nets require change in proof; old:
349 REWRITE_TAC[MULT_CLAUSES, REAL_INV1, REAL_MUL_LID, ADD_CLAUSES] THEN
350 REWRITE_TAC[REAL_MUL_RID, SYM(ONE)]
351 *)
352 REWRITE_TAC[MULT_RIGHT_1, CONJUNCT1 MULT,REAL_INV1,
353 REAL_MUL_LID, ADD_CLAUSES,REAL_MUL_RID, SYM(ONE)]],
354 POP_ASSUM(SUBST1_TAC o SYM) THEN
355 REWRITE_TAC[EXP_0, REAL_ADD_RID, REAL_LE_REFL]]
356QED
357
358Theorem EXP_LT_X :
359 !x. 0 < x ==> 1 + x < exp x
360Proof
361 rpt STRIP_TAC
362 >> ASSUME_TAC (Q.SPEC ‘x’ (SRULE [] exp))
363 >> ASSUME_TAC (MATCH_MP SUM_SUMMABLE (SRULE [] (Q.SPEC ‘x’ EXP_CONVERGES)))
364 >> qabbrev_tac ‘f = \n. inv (&FACT n) * x pow n’
365 >> MP_TAC (Q.SPECL [‘f’, ‘2’] SER_POS_LT)
366 >> Q.PAT_X_ASSUM ‘exp x = suminf f’ (REWRITE_TAC o wrap o SYM)
367 >> simp [] >> EVAL_TAC
368 >> impl_tac
369 >- (rw [Abbr ‘f’] \\
370 MATCH_MP_TAC REAL_LT_MUL >> simp [REAL_POW_LT, FACT_LESS])
371 >> qabbrev_tac ‘e = suminf f’
372 >> simp [Abbr ‘f’]
373 >> EVAL_TAC >> simp []
374QED
375
376(* also known REAL_EXP_LT_1 *)
377Theorem EXP_LT_1:
378 !x. &0 < x ==> &1 < exp(x)
379Proof
380 GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN
381 EXISTS_TAC “&1 + x” THEN ASM_REWRITE_TAC[REAL_LT_ADDR] THEN
382 MATCH_MP_TAC EXP_LE_X THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN
383 POP_ASSUM ACCEPT_TAC
384QED
385
386(* also known as REAL_EXP_ADD_MUL *)
387Theorem EXP_ADD_MUL:
388 !x y. exp(x + y) * exp(~x) = exp(y)
389Proof
390 REPEAT GEN_TAC THEN
391 CONV_TAC(LAND_CONV(X_BETA_CONV “x:real”)) THEN
392 SUBGOAL_THEN “exp(y) = (\x. exp(x + y) * exp(~x))(&0)” SUBST1_TAC THENL
393 [BETA_TAC THEN REWRITE_TAC[REAL_ADD_LID, REAL_NEG_0] THEN
394 REWRITE_TAC[EXP_0, REAL_MUL_RID],
395 MATCH_MP_TAC DIFF_ISCONST_ALL THEN X_GEN_TAC “x:real” THEN
396 W(MP_TAC o DIFF_CONV o rand o funpow 2 rator o snd) THEN
397 DISCH_THEN(MP_TAC o SPEC “x:real”) THEN
398 MATCH_MP_TAC(TAUT_CONV “(a <=> b) ==> a ==> b”) THEN AP_THM_TAC THEN
399 AP_TERM_TAC THEN REWRITE_TAC[GSYM REAL_NEG_LMUL, GSYM REAL_NEG_RMUL] THEN
400 REWRITE_TAC[GSYM real_sub, REAL_SUB_0, REAL_MUL_RID, REAL_ADD_RID] THEN
401 MATCH_ACCEPT_TAC REAL_MUL_SYM]
402QED
403
404(* also known as REAL_EXP_NEG_MUL *)
405Theorem EXP_NEG_MUL:
406 !x. exp(x) * exp(~x) = &1
407Proof
408 GEN_TAC THEN MP_TAC(SPECL [“x:real”, “&0”] EXP_ADD_MUL) THEN
409 REWRITE_TAC[REAL_ADD_RID, EXP_0]
410QED
411
412(* also known as REAL_EXP_NEG_MUL2 *)
413Theorem EXP_NEG_MUL2:
414 !x. exp(~x) * exp(x) = &1
415Proof
416 ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_ACCEPT_TAC EXP_NEG_MUL
417QED
418
419(* also known as REAL_EXP_NEG *)
420Theorem EXP_NEG:
421 !x. exp(~x) = inv(exp(x))
422Proof
423 GEN_TAC THEN MATCH_MP_TAC REAL_RINV_UNIQ THEN
424 MATCH_ACCEPT_TAC EXP_NEG_MUL
425QED
426
427Theorem EXP_ADD:
428 !x y. exp(x + y) = exp(x) * exp(y)
429Proof
430 REPEAT GEN_TAC THEN
431 MP_TAC(SPECL [“x:real”, “y:real”] EXP_ADD_MUL) THEN
432 DISCH_THEN(MP_TAC o C AP_THM “exp(x)” o AP_TERM “$*”) THEN
433 REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN
434 REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] EXP_NEG_MUL, REAL_MUL_RID] THEN
435 DISCH_THEN SUBST1_TAC THEN MATCH_ACCEPT_TAC REAL_MUL_SYM
436QED
437
438Theorem REAL_EXP_ADD = EXP_ADD
439
440(* also known as REAL_EXP_POS_LE *)
441Theorem EXP_POS_LE:
442 !x. &0 <= exp(x)
443Proof
444 GEN_TAC THEN
445 GEN_REWR_TAC (funpow 2 RAND_CONV) [GSYM REAL_HALF_DOUBLE] THEN
446 REWRITE_TAC[EXP_ADD] THEN MATCH_ACCEPT_TAC REAL_LE_SQUARE
447QED
448
449(* also known as REAL_EXP_NZ *)
450Theorem EXP_NZ:
451 !x. ~(exp(x) = &0)
452Proof
453 GEN_TAC THEN DISCH_TAC THEN
454 MP_TAC(SPEC “x:real” EXP_NEG_MUL) THEN
455 ASM_REWRITE_TAC[REAL_MUL_LZERO] THEN
456 CONV_TAC(RAND_CONV SYM_CONV) THEN
457 MATCH_ACCEPT_TAC REAL_10
458QED
459
460(* also known as REAL_EXP_POS_LT *)
461Theorem EXP_POS_LT:
462 !x. &0 < exp(x)
463Proof
464 GEN_TAC THEN REWRITE_TAC[REAL_LT_LE] THEN
465 CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN
466 REWRITE_TAC[EXP_POS_LE, EXP_NZ]
467QED
468
469(* also known as REAL_EXP_N *)
470Theorem EXP_N:
471 !n x. exp(&n * x) = exp(x) pow n
472Proof
473 INDUCT_TAC THEN REWRITE_TAC[REAL_MUL_LZERO, EXP_0, pow] THEN
474 REWRITE_TAC[ADD1] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN
475 REWRITE_TAC[GSYM REAL_ADD, EXP_ADD, REAL_RDISTRIB] THEN
476 GEN_TAC THEN ASM_REWRITE_TAC[REAL_MUL_LID]
477QED
478
479(* also known as REAL_EXP_SUB *)
480Theorem EXP_SUB:
481 !x y. exp(x - y) = exp(x) / exp(y)
482Proof
483 REPEAT GEN_TAC THEN
484 REWRITE_TAC[real_sub, real_div, EXP_ADD, EXP_NEG]
485QED
486
487(* also known as REAL_EXP_MONO_IMP *)
488Theorem EXP_MONO_IMP:
489 !x y. x < y ==> exp(x) < exp(y)
490Proof
491 REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o
492 MATCH_MP EXP_LT_1 o ONCE_REWRITE_RULE[GSYM REAL_SUB_LT]) THEN
493 REWRITE_TAC[EXP_SUB] THEN
494 SUBGOAL_THEN “&1 < exp(y) / exp(x) <=>
495 (&1 * exp(x)) < ((exp(y) / exp(x)) * exp(x))” SUBST1_TAC THENL
496 [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_LT_RMUL THEN
497 MATCH_ACCEPT_TAC EXP_POS_LT,
498 REWRITE_TAC[real_div, GSYM REAL_MUL_ASSOC, EXP_NEG_MUL2, GSYM EXP_NEG] THEN
499 REWRITE_TAC[REAL_MUL_LID, REAL_MUL_RID]]
500QED
501
502(* also known as REAL_EXP_MONO_LT *)
503Theorem EXP_MONO_LT:
504 !x y. exp(x) < exp(y) <=> x < y
505Proof
506 REPEAT GEN_TAC THEN EQ_TAC THENL
507 [CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[REAL_NOT_LT] THEN
508 REWRITE_TAC[REAL_LE_LT] THEN
509 DISCH_THEN(DISJ_CASES_THEN2 ASSUME_TAC SUBST1_TAC) THEN
510 REWRITE_TAC[] THEN DISJ1_TAC THEN MATCH_MP_TAC EXP_MONO_IMP THEN
511 POP_ASSUM ACCEPT_TAC,
512 MATCH_ACCEPT_TAC EXP_MONO_IMP]
513QED
514
515(* also known as REAL_EXP_MONO_LE *)
516Theorem EXP_MONO_LE:
517 !x y. exp(x) <= exp(y) <=> x <= y
518Proof
519 REPEAT GEN_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN
520 REWRITE_TAC[EXP_MONO_LT]
521QED
522
523(* also known as REAL_EXP_INJ *)
524Theorem EXP_INJ:
525 !x y. (exp(x) = exp(y)) <=> (x = y)
526Proof
527 REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN
528 REWRITE_TAC[EXP_MONO_LE]
529QED
530
531(* also known as REAL_EXP_TOTAL_LEMMA *)
532Theorem EXP_TOTAL_LEMMA:
533 !y. &1 <= y ==> ?x. &0 <= x /\ x <= y - &1 /\ (exp(x) = y)
534Proof
535 GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC IVT THEN
536 ASM_REWRITE_TAC[EXP_0, REAL_LE_SUB_LADD, REAL_ADD_LID] THEN CONJ_TAC THENL
537 [RULE_ASSUM_TAC(ONCE_REWRITE_RULE[GSYM REAL_SUB_LE]) THEN
538 POP_ASSUM(MP_TAC o MATCH_MP EXP_LE_X) THEN REWRITE_TAC[REAL_SUB_ADD2],
539 X_GEN_TAC “x:real” THEN DISCH_THEN(K ALL_TAC) THEN
540 MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC “exp(x)” THEN
541 MATCH_ACCEPT_TAC DIFF_EXP]
542QED
543
544(* also known as REAL_EXP_TOTAL *)
545Theorem EXP_TOTAL:
546 !y. &0 < y ==> ?x. exp(x) = y
547Proof
548 GEN_TAC THEN DISCH_TAC THEN
549 DISJ_CASES_TAC(SPECL [“&1”, “y:real”] REAL_LET_TOTAL) THENL
550 [FIRST_ASSUM(X_CHOOSE_TAC “x:real” o MATCH_MP EXP_TOTAL_LEMMA) THEN
551 EXISTS_TAC “x:real” THEN ASM_REWRITE_TAC[],
552 MP_TAC(SPEC “y:real” REAL_INV_LT1) THEN ASM_REWRITE_TAC[] THEN
553 DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_IMP_LE) THEN
554 DISCH_THEN(X_CHOOSE_TAC “x:real” o MATCH_MP EXP_TOTAL_LEMMA) THEN
555 Q.EXISTS_TAC ‘~x’ THEN ASM_REWRITE_TAC[EXP_NEG] THEN
556 MATCH_MP_TAC REAL_INVINV THEN CONV_TAC(RAND_CONV SYM_CONV) THEN
557 MATCH_MP_TAC REAL_LT_IMP_NE THEN ASM_REWRITE_TAC[]]
558QED
559
560(* recovered from transc.ml *)
561Theorem REAL_EXP_BOUND_LEMMA :
562 !x. &0 <= x /\ x <= inv(&2) ==> exp(x) <= &1 + &2 * x
563Proof
564 GEN_TAC THEN STRIP_TAC THEN
565 MATCH_MP_TAC REAL_LE_TRANS THEN
566 Q.EXISTS_TAC `suminf (\n. x pow n)` THEN CONJ_TAC >| (* 2 subgoals *)
567 [ (* goal 1 (of 2) *)
568 SIMP_TAC std_ss [exp] THEN MATCH_MP_TAC SER_LE THEN
569 SIMP_TAC std_ss [summable] THEN REPEAT CONJ_TAC >| (* 3 subgoals *)
570 [ (* goal 1.1 (of 3) *)
571 GEN_TAC THEN
572 GEN_REWRITE_TAC RAND_CONV empty_rewrites [GSYM REAL_MUL_LID] THEN
573 MATCH_MP_TAC REAL_LE_RMUL_IMP THEN CONJ_TAC >| (* 2 subgoals *)
574 [ (* goal 1.1.1 (of 2) *)
575 MATCH_MP_TAC REAL_POW_LE THEN ASM_REWRITE_TAC[],
576 (* goal 1.1.2 (of 2) *)
577 MATCH_MP_TAC REAL_INV_LE_1 THEN
578 REWRITE_TAC[REAL_OF_NUM_LE, num_CONV ``1:num``, GSYM LESS_EQ] THEN
579 REWRITE_TAC[FACT_LESS] ],
580 (* goal 1.2 (of 3) *)
581 Q.EXISTS_TAC `exp x` THEN REWRITE_TAC[BETA_RULE EXP_CONVERGES],
582 (* goal 1.3 (of 3) *)
583 Q.EXISTS_TAC `inv(&1 - x)` THEN MATCH_MP_TAC GP THEN
584 ASM_REWRITE_TAC[abs] THEN
585 MATCH_MP_TAC REAL_LET_TRANS THEN Q.EXISTS_TAC `inv(&2)` >> rw [] ],
586 (* goal 2 (of 2) *)
587 Q.SUBGOAL_THEN `suminf (\n. x pow n) = inv (&1 - x)` SUBST1_TAC >| (* 2 subgoals *)
588 [ (* goal 2.1 (of 2) *)
589 CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_UNIQ THEN
590 MATCH_MP_TAC GP THEN
591 ASM_REWRITE_TAC[abs] THEN
592 MATCH_MP_TAC REAL_LET_TRANS THEN Q.EXISTS_TAC `inv(&2)` >> rw [],
593 (* goal 2.2 (of 2) *)
594 MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN
595 Q.EXISTS_TAC `&1 - x` THEN
596 Q.SUBGOAL_THEN `(&1 - x) * inv (&1 - x) = &1` SUBST1_TAC >| (* 2 subgoals *)
597 [ (* goal 2.2.1 (of 2) *)
598 MATCH_MP_TAC REAL_MUL_RINV THEN
599 REWRITE_TAC[REAL_ARITH ``(&1 - x = &0) <=> (x = &1)``] THEN
600 DISCH_THEN SUBST_ALL_TAC THEN
601 POP_ASSUM MP_TAC >> rw [],
602 (* goal 2.2.2 (of 2) *)
603 CONJ_TAC >| (* 2 subgoals *)
604 [ (* goal 2.2.2.1 (of 2) *)
605 MATCH_MP_TAC REAL_LET_TRANS THEN
606 Q.EXISTS_TAC `inv(&2) - x` THEN
607 ASM_REWRITE_TAC[REAL_ARITH ``&0 <= x - y <=> y <= x``] THEN
608 ASM_REWRITE_TAC[REAL_ARITH ``a - x < b - x <=> a < b``] THEN
609 rw [],
610 (* goal 2.2.2.2 (of 2) *)
611 REWRITE_TAC[REAL_ADD_LDISTRIB, REAL_SUB_RDISTRIB] THEN
612 REWRITE_TAC[REAL_MUL_RID, REAL_MUL_LID] THEN
613 REWRITE_TAC[REAL_ARITH ``&1 <= (&1 + &2 * x) - (x + x * (&2 * x)) <=>
614 x * (&2 * x) <= x * &1``] THEN
615 MATCH_MP_TAC REAL_LE_LMUL_IMP THEN ASM_REWRITE_TAC[] THEN
616 MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN Q.EXISTS_TAC `inv(&2)` THEN
617 REWRITE_TAC[REAL_MUL_ASSOC] THEN
618 CONJ_TAC >- REWRITE_TAC [REAL_INV_1OVER, REAL_HALF_BETWEEN] \\
619 ASM_SIMP_TAC real_ss [REAL_MUL_RID, REAL_MUL_LINV] ] ] ] ]
620QED
621
622(*---------------------------------------------------------------------------*)
623(* Properties of the logarithmic function *)
624(*---------------------------------------------------------------------------*)
625
626Definition ln[nocompute]:
627 ln x = @u. exp(u) = x
628End
629
630Theorem LN_EXP:
631 !x. ln(exp x) = x
632Proof
633 GEN_TAC THEN REWRITE_TAC[ln, EXP_INJ] THEN
634 CONV_TAC SYM_CONV THEN CONV_TAC(RAND_CONV(ONCE_DEPTH_CONV SYM_CONV)) THEN
635 CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN MATCH_MP_TAC SELECT_AX THEN
636 EXISTS_TAC “x:real” THEN REFL_TAC
637QED
638
639(* also known as REAL_EXP_LN *)
640Theorem EXP_LN:
641 !x. (exp(ln x) = x) <=> &0 < x
642Proof
643 GEN_TAC THEN EQ_TAC THENL
644 [DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_ACCEPT_TAC EXP_POS_LT,
645 DISCH_THEN(X_CHOOSE_THEN “y:real” MP_TAC o MATCH_MP EXP_TOTAL) THEN
646 DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[EXP_INJ, LN_EXP]]
647QED
648
649Theorem LN_MUL:
650 !x y. &0 < x /\ &0 < y ==> (ln(x * y) = ln(x) + ln(y))
651Proof
652 REPEAT GEN_TAC THEN STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM EXP_INJ] THEN
653 REWRITE_TAC[EXP_ADD] THEN SUBGOAL_THEN “&0 < x * y” ASSUME_TAC THENL
654 [MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[],
655 EVERY_ASSUM(fn th => REWRITE_TAC[ONCE_REWRITE_RULE[GSYM EXP_LN] th])]
656QED
657
658Theorem LN_INJ:
659 !x y. &0 < x /\ &0 < y ==> ((ln(x) = ln(y)) = (x = y))
660Proof
661 REPEAT GEN_TAC THEN STRIP_TAC THEN
662 EVERY_ASSUM(fn th => GEN_REWR_TAC (RAND_CONV o ONCE_DEPTH_CONV)
663 [SYM(REWRITE_RULE[GSYM EXP_LN] th)]) THEN
664 CONV_TAC SYM_CONV THEN MATCH_ACCEPT_TAC EXP_INJ
665QED
666
667Theorem LN_1:
668 ln(&1) = &0
669Proof
670 ONCE_REWRITE_TAC[GSYM EXP_INJ] THEN
671 REWRITE_TAC[EXP_0, EXP_LN, REAL_LT_01]
672QED
673
674Theorem LN_INV:
675 !x. &0 < x ==> (ln(inv x) = ~(ln x))
676Proof
677 GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[GSYM REAL_RNEG_UNIQ] THEN
678 SUBGOAL_THEN “&0 < x /\ &0 < inv(x)” MP_TAC THENL
679 [CONJ_TAC THEN TRY(MATCH_MP_TAC REAL_INV_POS) THEN ASM_REWRITE_TAC[],
680 DISCH_THEN(fn th => REWRITE_TAC[GSYM(MATCH_MP LN_MUL th)]) THEN
681 SUBGOAL_THEN “x * (inv x) = &1” SUBST1_TAC THENL
682 [MATCH_MP_TAC REAL_MUL_RINV THEN
683 POP_ASSUM(ACCEPT_TAC o MATCH_MP REAL_POS_NZ),
684 REWRITE_TAC[LN_1]]]
685QED
686
687Theorem LN_DIV:
688 !x y. &0 < x /\ &0 < y ==> (ln(x / y) = ln(x) - ln(y))
689Proof
690 REPEAT GEN_TAC THEN STRIP_TAC THEN
691 SUBGOAL_THEN “&0 < x /\ &0 < inv(y)” MP_TAC THENL
692 [CONJ_TAC THEN TRY(MATCH_MP_TAC REAL_INV_POS) THEN ASM_REWRITE_TAC[],
693 REWRITE_TAC[real_div] THEN
694 DISCH_THEN(fn th => REWRITE_TAC[MATCH_MP LN_MUL th]) THEN
695 REWRITE_TAC[MATCH_MP LN_INV (ASSUME “&0 < y”)] THEN
696 REWRITE_TAC[real_sub]]
697QED
698
699Theorem LN_MONO_LT:
700 !x y. &0 < x /\ &0 < y ==> (ln(x) < ln(y) <=> x < y)
701Proof
702 REPEAT GEN_TAC THEN STRIP_TAC THEN
703 EVERY_ASSUM(fn th => GEN_REWR_TAC (RAND_CONV o ONCE_DEPTH_CONV)
704 [SYM(REWRITE_RULE[GSYM EXP_LN] th)]) THEN
705 CONV_TAC SYM_CONV THEN MATCH_ACCEPT_TAC EXP_MONO_LT
706QED
707
708Theorem LN_MONO_LE:
709 !x y. &0 < x /\ &0 < y ==> (ln(x) <= ln(y) <=> x <= y)
710Proof
711 REPEAT GEN_TAC THEN STRIP_TAC THEN
712 EVERY_ASSUM(fn th => GEN_REWR_TAC (RAND_CONV o ONCE_DEPTH_CONV)
713 [SYM(REWRITE_RULE[GSYM EXP_LN] th)]) THEN
714 CONV_TAC SYM_CONV THEN MATCH_ACCEPT_TAC EXP_MONO_LE
715QED
716
717Theorem LN_POW:
718 !n x. &0 < x ==> (ln(x pow n) = &n * ln(x))
719Proof
720 REPEAT GEN_TAC THEN
721 DISCH_THEN(CHOOSE_THEN (SUBST1_TAC o SYM) o MATCH_MP EXP_TOTAL) THEN
722 REWRITE_TAC[GSYM EXP_N, LN_EXP]
723QED
724
725Theorem LN_LE:
726 !x. &0 <= x ==> ln(&1 + x) <= x
727Proof
728 GEN_TAC THEN DISCH_TAC THEN
729 GEN_REWRITE_TAC RAND_CONV empty_rewrites [GSYM LN_EXP] THEN
730 MP_TAC(SPECL [Term`&1 + x`, Term`exp x`] LN_MONO_LE) THEN
731 W(C SUBGOAL_THEN (fn t => REWRITE_TAC[t]) o funpow 2 (fst o dest_imp) o snd)
732 THENL
733 [REWRITE_TAC[EXP_POS_LT] THEN MATCH_MP_TAC REAL_LET_TRANS THEN
734 EXISTS_TAC (Term`x:real`) THEN ASM_REWRITE_TAC[REAL_LT_ADDL, REAL_LT_01],
735 DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC EXP_LE_X THEN ASM_REWRITE_TAC[]]
736QED
737
738Theorem LN_LT_X:
739 !x. &0 < x ==> ln(x) < x
740Proof
741 GEN_TAC THEN DISCH_TAC THEN
742 GEN_REWR_TAC I [TAUT_CONV “a:bool = ~~a”] THEN
743 PURE_REWRITE_TAC[REAL_NOT_LT] THEN DISCH_TAC THEN
744 MP_TAC(SPEC “ln(x)” EXP_LE_X) THEN
745 SUBGOAL_THEN “&0 <= ln(x)” ASSUME_TAC THENL
746 [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC “x:real” THEN
747 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_IMP_LE, ALL_TAC] THEN
748 ASM_REWRITE_TAC[] THEN MP_TAC(SPEC “x:real” EXP_LN) THEN
749 ASM_REWRITE_TAC[] THEN
750 DISCH_THEN SUBST1_TAC THEN DISCH_TAC THEN
751 SUBGOAL_THEN “(&1 + ln(x)) <= ln(x)” MP_TAC THENL
752 [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC “x:real”, ALL_TAC] THEN
753 ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_NOT_LE] THEN
754 MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC “&0 + ln(x)” THEN
755 REWRITE_TAC[REAL_LT_RADD, REAL_LT_01] THEN
756 REWRITE_TAC[REAL_ADD_LID, REAL_LE_REFL]
757QED
758
759Theorem LN_POS_LT :
760 !(x :real). 1 < x ==> 0 < ln x
761Proof
762 RW_TAC std_ss [GSYM LN_1]
763 >> ASSUME_TAC REAL_LT_01
764 >> ‘0 < x’ by PROVE_TAC [REAL_LT_TRANS]
765 >> RW_TAC std_ss [LN_MONO_LT]
766QED
767
768Theorem LN_POS :
769 !(x :real). 1 <= x ==> 0 <= ln x
770Proof
771 rpt STRIP_TAC
772 >> ‘x = 1 \/ 1 < x’ by PROVE_TAC [REAL_LE_LT] >- rw [LN_1]
773 >> MATCH_MP_TAC REAL_LT_IMP_LE
774 >> MATCH_MP_TAC LN_POS_LT >> art []
775QED
776
777Theorem LN_NEG_LT :
778 !(x :real). 0 < x /\ x < 1 ==> ln x < 0
779Proof
780 rpt STRIP_TAC
781 >> Q.ABBREV_TAC ‘y = inv x’
782 >> ‘1 < y’ by METIS_TAC [REAL_INV_LT1]
783 >> Know ‘x = inv y’
784 >- (MATCH_MP_TAC REAL_RINV_UNIQ \\
785 Q.UNABBREV_TAC ‘y’ \\
786 MATCH_MP_TAC REAL_MUL_LINV \\
787 PROVE_TAC [REAL_LT_IMP_NE])
788 >> Rewr'
789 >> ‘0 < y’ by PROVE_TAC [REAL_LT_01, REAL_LT_TRANS]
790 >> rw [LN_INV]
791 >> MATCH_MP_TAC LN_POS_LT >> art []
792QED
793
794Theorem LN_NEG :
795 !(x :real). 0 < x /\ x <= 1 ==> ln x <= 0
796Proof
797 rpt STRIP_TAC
798 >> ‘x = 1 \/ x < 1’ by PROVE_TAC [REAL_LE_LT] >- rw [LN_1]
799 >> MATCH_MP_TAC REAL_LT_IMP_LE
800 >> MATCH_MP_TAC LN_NEG_LT >> art []
801QED
802
803Theorem DIFF_LN[difftool]:
804 !x. &0 < x ==> (ln diffl (inv x))(x)
805Proof
806 GEN_TAC THEN DISCH_TAC THEN
807 FIRST_ASSUM(ASSUME_TAC o REWRITE_RULE[GSYM EXP_LN]) THEN
808 FIRST_ASSUM (fn th => GEN_REWRITE_TAC RAND_CONV empty_rewrites [GSYM th]) THEN
809 MATCH_MP_TAC DIFF_INVERSE_LT THEN
810 FIRST_ASSUM(ASSUME_TAC o MATCH_MP REAL_POS_NZ) THEN
811 ASM_REWRITE_TAC[MATCH_MP DIFF_CONT (SPEC_ALL DIFF_EXP)] THEN
812 MP_TAC(SPEC (Term`ln(x)`) DIFF_EXP) THEN ASM_REWRITE_TAC[] THEN
813 DISCH_TAC THEN ASM_REWRITE_TAC[LN_EXP] THEN
814 EXISTS_TAC (Term`&1`) THEN MATCH_ACCEPT_TAC REAL_LT_01
815QED
816
817Theorem LN_LT_HALF_X :
818 !x. 2 <= x ==> ln x < x / 2
819Proof
820 RW_TAC std_ss [Once (GSYM REAL_SUB_LT)]
821 >> MP_TAC (DIFF_CONV “\x. x / 2 - ln x”)
822 >> simp [REAL_INV_1OVER] >> DISCH_TAC
823 >> qabbrev_tac ‘f = \x. x / 2 - ln x’ >> simp []
824 >> Cases_on ‘x = 2’
825 >- (simp [Abbr ‘f’, REAL_SUB_LT] \\
826 ‘1 = ln (exp 1)’ by simp [LN_EXP] >> POP_ORW \\
827 irule (iffRL LN_MONO_LT) >> simp [EXP_POS_LT] \\
828 MP_TAC (Q.SPEC ‘1’ EXP_LT_X) >> simp [])
829 >> ‘2 < x’ by PROVE_TAC [REAL_LE_LT]
830 >> Q_TAC (TRANS_TAC REAL_LET_TRANS) ‘f 2’
831 >> CONJ_TAC
832 >- (simp [Abbr ‘f’, REAL_SUB_LE] \\
833 ‘1 = ln (exp 1)’ by simp [LN_EXP] >> POP_ORW \\
834 irule (iffRL LN_MONO_LE) >> simp [EXP_POS_LT] \\
835 MP_TAC (Q.SPEC ‘1’ EXP_LE_X) >> simp [])
836 >> irule DIFF_POS_MONO_LT_CU >> art []
837 >> Q.EXISTS_TAC ‘2’ >> simp []
838 >> reverse CONJ_TAC
839 >- (MATCH_MP_TAC DIFF_CONT \\
840 Q.EXISTS_TAC ‘1 / 2 - 1 / 2’ \\
841 FIRST_X_ASSUM MATCH_MP_TAC >> simp [])
842 >> rpt STRIP_TAC
843 >> Q.EXISTS_TAC ‘1 / 2 - 1 / z’
844 >> Know ‘0 < z’
845 >- (Q_TAC (TRANS_TAC REAL_LT_TRANS) ‘2’ >> simp [])
846 >> DISCH_TAC
847 >> reverse CONJ_TAC
848 >- (FIRST_X_ASSUM MATCH_MP_TAC >> art [])
849 >> REWRITE_TAC [REAL_SUB_LT, GSYM REAL_INV_1OVER]
850 >> irule (iffRL REAL_INV_LT_ANTIMONO) >> simp []
851QED
852
853(*---------------------------------------------------------------------------*)
854(* Some properties of roots (easier via logarithms) *)
855(*---------------------------------------------------------------------------*)
856
857Definition root:
858 root(n) x = @u. (&0 < x ==> &0 < u) /\ (u pow n = x)
859End
860
861Theorem sqrt :
862 !x. sqrt(x) = root(2) x
863Proof
864 REWRITE_TAC [sqrt_def, root]
865QED
866
867Theorem ROOT_LT_LEMMA:
868 !n x. &0 < x ==> (exp(ln(x) / &(SUC n)) pow (SUC n) = x)
869Proof
870 REPEAT GEN_TAC THEN DISCH_TAC THEN
871 REWRITE_TAC[GSYM EXP_N] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
872 REWRITE_TAC[real_div, GSYM REAL_MUL_ASSOC] THEN
873 SUBGOAL_THEN “inv(&(SUC n)) * &(SUC n) = &1” SUBST1_TAC THENL
874 [MATCH_MP_TAC REAL_MUL_LINV THEN REWRITE_TAC[REAL_INJ, NOT_SUC],
875 ASM_REWRITE_TAC[REAL_MUL_RID, EXP_LN]]
876QED
877
878Theorem ROOT_LN:
879 !n x. &0 < x ==> (root(SUC n) x = exp(ln(x) / &(SUC n)))
880Proof
881 REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[root] THEN
882 MATCH_MP_TAC SELECT_UNIQUE THEN X_GEN_TAC “y:real” THEN BETA_TAC THEN
883 ASM_REWRITE_TAC[] THEN EQ_TAC THENL
884 [DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC o SYM)) THEN
885 SUBGOAL_THEN “!z. &0 < y /\ &0 < exp(z)” MP_TAC THENL
886 [ASM_REWRITE_TAC[EXP_POS_LT], ALL_TAC] THEN
887 DISCH_THEN(MP_TAC o GEN_ALL o SYM o MATCH_MP LN_INJ o SPEC_ALL) THEN
888 DISCH_THEN(fn th => GEN_REWR_TAC I [th]) THEN
889 REWRITE_TAC[LN_EXP] THEN
890 SUBGOAL_THEN “ln(y) * &(SUC n) = (ln(y pow(SUC n)) / &(SUC n)) * &(SUC n)”
891 MP_TAC THENL
892 [REWRITE_TAC[real_div, GSYM REAL_MUL_ASSOC] THEN
893 SUBGOAL_THEN “inv(&(SUC n)) * &(SUC n) = &1” SUBST1_TAC THENL
894 [MATCH_MP_TAC REAL_MUL_LINV THEN REWRITE_TAC[REAL_INJ, NOT_SUC],
895 REWRITE_TAC[REAL_MUL_RID] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
896 CONV_TAC SYM_CONV THEN MATCH_MP_TAC LN_POW THEN
897 ASM_REWRITE_TAC[]],
898 REWRITE_TAC[REAL_EQ_RMUL, REAL_INJ, NOT_SUC]],
899 DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[EXP_POS_LT] THEN
900 MATCH_MP_TAC ROOT_LT_LEMMA THEN ASM_REWRITE_TAC[]]
901QED
902
903Theorem EXP_DIV :
904 !n x. 1 < n ==> exp (x / &n) = root n (exp x)
905Proof
906 rw [Once EQ_SYM_EQ]
907 >> Cases_on ‘n’ >> fs []
908 >> rename1 ‘1 < SUC n’
909 >> MP_TAC (Q.SPECL [‘n’, ‘exp x’] ROOT_LN)
910 >> simp [EXP_POS_LT, LN_EXP]
911QED
912
913Theorem ROOT_0:
914 !n. root(SUC n) (&0) = &0
915Proof
916 GEN_TAC THEN REWRITE_TAC[root] THEN
917 MATCH_MP_TAC SELECT_UNIQUE THEN X_GEN_TAC “y:real” THEN
918 BETA_TAC THEN REWRITE_TAC[REAL_LT_REFL] THEN EQ_TAC THENL
919 [SPEC_TAC(“n:num”,“n:num”) THEN INDUCT_TAC THEN ONCE_REWRITE_TAC[pow] THENL
920 [REWRITE_TAC[pow, REAL_MUL_RID],
921 REWRITE_TAC[REAL_ENTIRE] THEN DISCH_THEN DISJ_CASES_TAC THEN
922 ASM_REWRITE_TAC[] THEN FIRST_ASSUM MATCH_MP_TAC THEN
923 ASM_REWRITE_TAC[]],
924 DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[pow, REAL_MUL_LZERO]]
925QED
926
927Theorem ROOT_1:
928 !n. root(SUC n) (&1) = &1
929Proof
930 GEN_TAC THEN REWRITE_TAC[MATCH_MP ROOT_LN REAL_LT_01] THEN
931 REWRITE_TAC[LN_1, REAL_DIV_LZERO, EXP_0]
932QED
933
934Theorem ROOT_POS_LT:
935 !n x. &0 < x ==> &0 < root(SUC n) x
936Proof
937 REPEAT GEN_TAC THEN
938 DISCH_THEN(fn th => REWRITE_TAC[MATCH_MP ROOT_LN th]) THEN
939 REWRITE_TAC[EXP_POS_LT]
940QED
941
942Theorem ROOT_POW_POS:
943 !n x. &0 <= x ==> ((root(SUC n) x) pow (SUC n) = x)
944Proof
945 REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LE_LT] THEN
946 DISCH_THEN DISJ_CASES_TAC THENL
947 [FIRST_ASSUM(fn th => REWRITE_TAC
948 [MATCH_MP ROOT_LN th, MATCH_MP ROOT_LT_LEMMA th]),
949 FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[ROOT_0] THEN
950 MATCH_ACCEPT_TAC POW_0]
951QED
952
953Theorem ROOT_11 :
954 !n x y. &0 <= x /\ &0 <= y /\ root(SUC n) x = root(SUC n) y ==> x = y
955Proof
956 rpt STRIP_TAC
957 >> ‘(root (SUC n) x) pow (SUC n) = (root (SUC n) y) pow (SUC n)’
958 by PROVE_TAC []
959 >> rfs [ROOT_POW_POS]
960QED
961
962Theorem POW_ROOT_POS:
963 !n x. &0 <= x ==> (root(SUC n)(x pow (SUC n)) = x)
964Proof
965 REPEAT GEN_TAC THEN DISCH_TAC THEN
966 REWRITE_TAC[root] THEN MATCH_MP_TAC SELECT_UNIQUE THEN
967 X_GEN_TAC “y:real” THEN BETA_TAC THEN EQ_TAC THEN
968 DISCH_TAC THEN ASM_REWRITE_TAC[] THENL
969 [DISJ_CASES_THEN MP_TAC (REWRITE_RULE[REAL_LE_LT] (ASSUME “&0 <= x”)) THENL
970 [DISCH_TAC THEN FIRST_ASSUM(UNDISCH_TAC o assert is_conj o concl) THEN
971 FIRST_ASSUM(fn th => REWRITE_TAC[MATCH_MP POW_POS_LT th]) THEN
972 DISCH_TAC THEN MATCH_MP_TAC POW_EQ THEN EXISTS_TAC “n:num” THEN
973 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN
974 ASM_REWRITE_TAC[],
975 DISCH_THEN(SUBST_ALL_TAC o SYM) THEN
976 FIRST_ASSUM(UNDISCH_TAC o assert is_conj o concl) THEN
977 REWRITE_TAC[POW_0, REAL_LT_REFL, POW_ZERO]],
978 ASM_REWRITE_TAC[REAL_LT_LE] THEN CONV_TAC CONTRAPOS_CONV THEN
979 REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
980 REWRITE_TAC[POW_0]]
981QED
982
983(* Known in GTT as ROOT_POS_POSITIVE *)
984Theorem ROOT_POS:
985 !n x. &0 <= x ==> &0 <= root(SUC n) x
986Proof
987 REPEAT GEN_TAC THEN
988 DISCH_THEN(DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT]) THENL
989 [MAP_EVERY MATCH_MP_TAC [REAL_LT_IMP_LE, ROOT_POS_LT] THEN
990 POP_ASSUM ACCEPT_TAC,
991 POP_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[ROOT_0, REAL_LE_REFL]]
992QED
993
994Theorem ROOT_POS_UNIQ :
995 !n x y. &0 <= x /\ &0 <= y /\ (y pow (SUC n) = x)
996 ==> (root (SUC n) x = y)
997Proof
998 REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
999 DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (SUBST1_TAC o SYM)) THEN
1000 REWRITE_TAC[POW_ROOT_POS]
1001QED
1002
1003Theorem ROOT_MUL :
1004 !n x y. &0 <= x /\ &0 <= y
1005 ==> (root(SUC n) (x * y) = root(SUC n) x * root(SUC n) y)
1006Proof
1007 REPEAT STRIP_TAC THEN MATCH_MP_TAC ROOT_POS_UNIQ THEN
1008 REWRITE_TAC [POW_MUL] THEN REPEAT CONJ_TAC THENL
1009 [MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[],
1010 MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THEN MATCH_MP_TAC ROOT_POS
1011 THEN ASM_REWRITE_TAC[],
1012 IMP_RES_TAC ROOT_POW_POS THEN ASM_REWRITE_TAC[]]
1013QED
1014
1015Theorem ROOT_INV :
1016 !n x. &0 <= x ==> (root(SUC n) (inv x) = inv(root(SUC n) x))
1017Proof
1018 REPEAT STRIP_TAC THEN MATCH_MP_TAC ROOT_POS_UNIQ THEN REPEAT CONJ_TAC THENL
1019 [IMP_RES_THEN ACCEPT_TAC REAL_LE_INV,
1020 MATCH_MP_TAC REAL_LE_INV THEN IMP_RES_THEN (TRY o MATCH_ACCEPT_TAC) ROOT_POS,
1021 IMP_RES_TAC ROOT_POW_POS THEN MP_TAC (SPEC_ALL ROOT_POS)
1022 THEN ASM_REWRITE_TAC [] THEN REWRITE_TAC [REAL_LE_LT]
1023 THEN STRIP_TAC THENL
1024 [IMP_RES_TAC REAL_POS_NZ THEN IMP_RES_THEN (fn th =>
1025 REWRITE_TAC [GSYM th]) POW_INV THEN ASM_REWRITE_TAC[],
1026 POP_ASSUM (ASSUME_TAC o SYM) THEN ASM_REWRITE_TAC[] THEN
1027 PAT_X_ASSUM (Term `$! M`) (SUBST1_TAC o SYM o SPEC_ALL)
1028 THEN ASM_REWRITE_TAC[REAL_INV_0,POW_0]]]
1029QED
1030
1031Theorem ROOT_DIV :
1032 !n x y. &0 <= x /\ &0 <= y
1033 ==> (root(SUC n) (x / y) = root(SUC n) x / root(SUC n) y)
1034Proof
1035 REWRITE_TAC [real_div] THEN REPEAT STRIP_TAC THEN IMP_RES_TAC REAL_LE_INV
1036 THEN MP_TAC (SPECL [Term`n:num`, Term`x:real`, Term`inv y`] ROOT_MUL)
1037 THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[]
1038 THEN IMP_RES_TAC (SPECL [Term`n:num`, Term`y:real`] ROOT_INV)
1039 THEN ASM_REWRITE_TAC[]
1040QED
1041
1042(* added ‘n’ into quantifiers *)
1043Theorem ROOT_MONO_LE :
1044 !n x y. &0 <= x /\ x <= y ==> root(SUC n) x <= root(SUC n) y
1045Proof
1046 REPEAT STRIP_TAC THEN SUBGOAL_THEN (Term`&0 <= y`) ASSUME_TAC THENL
1047 [ASM_MESON_TAC[REAL_LE_TRANS], ALL_TAC] THEN
1048 UNDISCH_TAC (Term`x <= y`) THEN CONV_TAC CONTRAPOS_CONV THEN
1049 REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC THEN
1050 SUBGOAL_THEN (Term `(x = (root(SUC n) x) pow (SUC n)) /\
1051 (y = (root(SUC n) y) pow (SUC n))`)
1052 (CONJUNCTS_THEN SUBST1_TAC)
1053 THENL [IMP_RES_TAC (GSYM ROOT_POW_POS) THEN ASM_MESON_TAC[], ALL_TAC] THEN
1054 MATCH_MP_TAC REAL_POW_LT2 THEN
1055 ASM_REWRITE_TAC[NOT_SUC] THEN MATCH_MP_TAC ROOT_POS THEN ASM_REWRITE_TAC[]
1056QED
1057
1058Theorem ROOT_MONO_LE_EQ :
1059 !n x y. &0 <= x /\ &0 <= y ==> (root (SUC n) x <= root (SUC n) y <=> x <= y)
1060Proof
1061 rpt STRIP_TAC
1062 >> reverse EQ_TAC >- (DISCH_TAC >> MATCH_MP_TAC ROOT_MONO_LE >> art [])
1063 >> DISCH_TAC
1064 >> CCONTR_TAC >> FULL_SIMP_TAC std_ss [GSYM real_lt]
1065 >> IMP_RES_TAC REAL_LT_IMP_LE
1066 >> ‘root(SUC n) y <= root(SUC n) x’ by PROVE_TAC [ROOT_MONO_LE]
1067 >> ‘root(SUC n) x = root(SUC n) y’ by PROVE_TAC [REAL_LE_ANTISYM]
1068 >> METIS_TAC [ROOT_11, REAL_LT_LE]
1069QED
1070
1071Theorem ROOT_MONO_LT :
1072 !n x y. &0 <= x /\ x < y ==> root(SUC n) x < root(SUC n) y
1073Proof
1074 rw [REAL_LT_LE]
1075 >- (MATCH_MP_TAC ROOT_MONO_LE >> art [])
1076 >> ‘0 <= y’ by PROVE_TAC [REAL_LE_TRANS]
1077 >> PROVE_TAC [ROOT_11]
1078QED
1079
1080Theorem lem[local]:
1081 0<2:num
1082Proof REWRITE_TAC[TWO,LESS_0]
1083QED
1084
1085Theorem EVEN_MOD[local] :
1086 !n. EVEN(n) = (n MOD 2 = 0)
1087Proof
1088 GEN_TAC THEN REWRITE_TAC[EVEN_EXISTS] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN
1089 EQ_TAC THEN STRIP_TAC THENL
1090 [ASM_REWRITE_TAC [MP (SPEC (Term`2:num`) MOD_EQ_0) lem],
1091 EXISTS_TAC (Term `n DIV 2`) THEN
1092 MP_TAC (CONJUNCT1 (SPEC (Term `n:num`) (MATCH_MP DIVISION lem))) THEN
1093 ASM_REWRITE_TAC [ADD_CLAUSES]]
1094QED
1095
1096Theorem SQRT_EVEN_POW2 :
1097 !n. EVEN n ==> (sqrt(&2 pow n) = &2 pow (n DIV 2))
1098Proof
1099 GEN_TAC THEN REWRITE_TAC[EVEN_MOD] THEN DISCH_TAC THEN
1100 MATCH_MP_TAC SQRT_POS_UNIQ THEN REPEAT CONJ_TAC THENL
1101 [MATCH_MP_TAC POW_POS THEN REWRITE_TAC [REAL_POS],
1102 MATCH_MP_TAC POW_POS THEN REWRITE_TAC [REAL_POS],
1103 REWRITE_TAC [REAL_POW_POW] THEN AP_TERM_TAC THEN
1104 MP_TAC (CONJUNCT1 (SPEC (Term `n:num`) (MATCH_MP DIVISION lem)))
1105 THEN ASM_REWRITE_TAC [ADD_CLAUSES] THEN DISCH_THEN (SUBST1_TAC o SYM)
1106 THEN REFL_TAC]
1107QED
1108
1109Theorem REAL_DIV_SQRT :
1110 !x. &0 <= x ==> (x / sqrt(x) = sqrt(x))
1111Proof
1112 GEN_TAC THEN ASM_CASES_TAC (Term`x = &0`) THENL
1113 [ASM_REWRITE_TAC[SQRT_0, real_div, REAL_MUL_LZERO], ALL_TAC] THEN
1114 DISCH_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SQRT_POS_UNIQ THEN
1115 ASM_REWRITE_TAC[] THEN IMP_RES_TAC SQRT_POS_LE THEN
1116 MP_TAC (SPECL[Term`x:real`, Term`sqrt x`] REAL_LE_DIV) THEN ASM_REWRITE_TAC[]
1117 THEN DISCH_THEN (fn th => CONJ_TAC THENL [ACCEPT_TAC th, ALL_TAC]) THEN
1118 REWRITE_TAC[real_div, POW_MUL] THEN PAT_X_ASSUM (Term`_ <= sqrt _`) MP_TAC
1119 THEN REWRITE_TAC [REAL_LE_LT] THEN STRIP_TAC THENL
1120 [IMP_RES_TAC REAL_POS_NZ THEN IMP_RES_THEN (fn th =>
1121 REWRITE_TAC [GSYM th]) POW_INV THEN IMP_RES_THEN (fn th =>
1122 REWRITE_TAC [th]) SQRT_POW_2 THEN REWRITE_TAC[POW_2, GSYM REAL_MUL_ASSOC]
1123 THEN IMP_RES_THEN (fn th => REWRITE_TAC [th]) REAL_MUL_RINV THEN
1124 REWRITE_TAC [REAL_MUL_RID],
1125 PAT_X_ASSUM (Term `& 0 <= x`) MP_TAC THEN
1126 REWRITE_TAC [REAL_LE_LT] THEN STRIP_TAC THENL
1127 [IMP_RES_TAC SQRT_POS_LT THEN
1128 PAT_X_ASSUM (Term `& 0 = _`) (SUBST_ALL_TAC o SYM) THEN
1129 IMP_RES_TAC REAL_LT_REFL,
1130 PAT_X_ASSUM (Term `& 0 = _`) (SUBST_ALL_TAC o SYM)
1131 THEN REWRITE_TAC [POW_0, TWO, REAL_MUL_LZERO]]]
1132QED
1133
1134Theorem REAL_POW_LT_EQ :
1135 !n x y. 0 < n /\ 0 <= x /\ 0 <= y ==> (x pow n < y pow n <=> x < y)
1136Proof
1137 rpt STRIP_TAC
1138 >> reverse EQ_TAC
1139 >- (DISCH_TAC \\
1140 MATCH_MP_TAC REAL_POW_LT2 >> simp [])
1141 >> Cases_on ‘n’ >> fs []
1142 >> rename1 ‘x pow SUC n < _ ==> _’
1143 >> qmatch_abbrev_tac ‘a < b ==> _’
1144 >> DISCH_TAC
1145 >> Know ‘root (SUC n) a < root (SUC n) b’
1146 >- (MATCH_MP_TAC ROOT_MONO_LT >> art [] \\
1147 simp [Abbr ‘a’, POW_POS])
1148 >> MP_TAC (Q.SPECL [‘n’, ‘x’] POW_ROOT_POS) >> simp [Abbr ‘a’]
1149 >> MP_TAC (Q.SPECL [‘n’, ‘y’] POW_ROOT_POS) >> simp [Abbr ‘b’]
1150QED
1151
1152(*---------------------------------------------------------------------------*)
1153(* Basic properties of the trig functions *)
1154(*---------------------------------------------------------------------------*)
1155
1156Theorem SIN_0:
1157 sin(&0) = &0
1158Proof
1159 REWRITE_TAC[sin] THEN CONV_TAC SYM_CONV THEN
1160 MATCH_MP_TAC SUM_UNIQ THEN BETA_TAC THEN
1161 W(MP_TAC o C SPEC SER_0 o rand o rator o snd) THEN
1162 DISCH_THEN(MP_TAC o SPEC “0:num”) THEN REWRITE_TAC[ZERO_LESS_EQ] THEN
1163 BETA_TAC THEN
1164 REWRITE_TAC[sum] THEN DISCH_THEN MATCH_MP_TAC THEN
1165 X_GEN_TAC “n:num” THEN COND_CASES_TAC THEN
1166 ASM_REWRITE_TAC[REAL_MUL_LZERO] THEN
1167 MP_TAC(SPEC “n:num” ODD_EXISTS) THEN ASM_REWRITE_TAC[ODD_EVEN] THEN
1168 DISCH_THEN(CHOOSE_THEN SUBST1_TAC) THEN
1169 REWRITE_TAC[GSYM ADD1, POW_0, REAL_MUL_RZERO]
1170QED
1171
1172Theorem COS_0:
1173 cos(&0) = &1
1174Proof
1175 REWRITE_TAC[cos] THEN CONV_TAC SYM_CONV THEN
1176 MATCH_MP_TAC SUM_UNIQ THEN BETA_TAC THEN
1177 W(MP_TAC o C SPEC SER_0 o rand o rator o snd) THEN
1178 DISCH_THEN(MP_TAC o SPEC “1:num”) THEN
1179 REWRITE_TAC[ONE, sum, ADD_CLAUSES] THEN BETA_TAC THEN
1180 REWRITE_TAC[EVEN, pow, FACT] THEN
1181 REWRITE_TAC[REAL_ADD_LID, REAL_MUL_RID] THEN
1182 SUBGOAL_THEN “0 DIV 2 = 0” SUBST1_TAC THENL
1183 [MATCH_MP_TAC DIV_UNIQUE THEN EXISTS_TAC “0:num” THEN
1184 REWRITE_TAC[MULT_CLAUSES, ADD_CLAUSES] THEN
1185 REWRITE_TAC[TWO, LESS_0],
1186 REWRITE_TAC[pow]] THEN
1187 SUBGOAL_THEN “&1 / &1 = &(SUC 0)” SUBST1_TAC THENL
1188 [REWRITE_TAC[SYM(ONE)] THEN MATCH_MP_TAC REAL_DIV_REFL THEN
1189 MATCH_ACCEPT_TAC REAL_10,
1190 DISCH_THEN MATCH_MP_TAC] THEN
1191 X_GEN_TAC “n:num” THEN REWRITE_TAC[GSYM LESS_EQ] THEN
1192 DISCH_THEN(CHOOSE_THEN SUBST1_TAC o MATCH_MP LESS_ADD_1) THEN
1193 REWRITE_TAC[GSYM ADD1, POW_0, REAL_MUL_RZERO, ADD_CLAUSES]
1194QED
1195
1196Theorem SIN_CIRCLE:
1197 !x. (sin(x) pow 2) + (cos(x) pow 2) = &1
1198Proof
1199 GEN_TAC THEN CONV_TAC(LAND_CONV(X_BETA_CONV “x:real”)) THEN
1200 SUBGOAL_THEN “&1 = (\x.(sin(x) pow 2) + (cos(x) pow 2))(&0)” SUBST1_TAC THENL
1201 [BETA_TAC THEN REWRITE_TAC[SIN_0, COS_0] THEN
1202 REWRITE_TAC[TWO, POW_0] THEN
1203 REWRITE_TAC[pow, POW_1] THEN REWRITE_TAC[REAL_ADD_LID, REAL_MUL_LID],
1204 MATCH_MP_TAC DIFF_ISCONST_ALL THEN X_GEN_TAC “x:real” THEN
1205 W(MP_TAC o DIFF_CONV o rand o funpow 2 rator o snd) THEN
1206 DISCH_THEN(MP_TAC o SPEC “x:real”) THEN
1207 MATCH_MP_TAC(TAUT_CONV “(a <=> b) ==> a ==> b”) THEN AP_THM_TAC THEN
1208 AP_TERM_TAC THEN REWRITE_TAC[GSYM REAL_NEG_LMUL, GSYM REAL_NEG_RMUL] THEN
1209 REWRITE_TAC[GSYM real_sub, REAL_SUB_0] THEN
1210 REWRITE_TAC[GSYM REAL_MUL_ASSOC, REAL_MUL_RID] THEN
1211 AP_TERM_TAC THEN REWRITE_TAC[TWO, SUC_SUB1] THEN
1212 REWRITE_TAC[POW_1] THEN MATCH_ACCEPT_TAC REAL_MUL_SYM]
1213QED
1214
1215Theorem SIN_BOUND:
1216 !x. abs(sin x) <= &1
1217Proof
1218 GEN_TAC THEN GEN_REWR_TAC I [TAUT_CONV “a:bool = ~~a”] THEN
1219 PURE_ONCE_REWRITE_TAC[REAL_NOT_LE] THEN
1220 DISCH_THEN(MP_TAC o MATCH_MP REAL_LT1_POW2) THEN
1221 REWRITE_TAC[REAL_POW2_ABS] THEN
1222 DISCH_THEN(MP_TAC o ONCE_REWRITE_RULE[GSYM REAL_SUB_LT]) THEN
1223 DISCH_THEN(MP_TAC o C CONJ(SPEC “cos(x)” REAL_LE_SQUARE)) THEN
1224 REWRITE_TAC[GSYM POW_2] THEN
1225 DISCH_THEN(MP_TAC o MATCH_MP REAL_LTE_ADD) THEN
1226 REWRITE_TAC[real_sub, GSYM REAL_ADD_ASSOC] THEN
1227 ONCE_REWRITE_TAC[AC(REAL_ADD_ASSOC,REAL_ADD_SYM)
1228 “a + (b + c) = (a + c) + b”] THEN
1229 REWRITE_TAC[SIN_CIRCLE, REAL_ADD_RINV, REAL_LT_REFL]
1230QED
1231
1232Theorem SIN_BOUNDS:
1233 !x. ~(&1) <= sin(x) /\ sin(x) <= &1
1234Proof
1235 GEN_TAC THEN REWRITE_TAC[GSYM ABS_BOUNDS, SIN_BOUND]
1236QED
1237
1238Theorem COS_BOUND:
1239 !x. abs(cos x) <= &1
1240Proof
1241 GEN_TAC THEN GEN_REWR_TAC I [TAUT_CONV “a:bool = ~~a”] THEN
1242 PURE_ONCE_REWRITE_TAC[REAL_NOT_LE] THEN
1243 DISCH_THEN(MP_TAC o MATCH_MP REAL_LT1_POW2) THEN
1244 REWRITE_TAC[REAL_POW2_ABS] THEN
1245 DISCH_THEN(MP_TAC o ONCE_REWRITE_RULE[GSYM REAL_SUB_LT]) THEN
1246 DISCH_THEN(MP_TAC o CONJ(SPEC “sin(x)” REAL_LE_SQUARE)) THEN
1247 REWRITE_TAC[GSYM POW_2] THEN
1248 DISCH_THEN(MP_TAC o MATCH_MP REAL_LET_ADD) THEN
1249 REWRITE_TAC[real_sub, REAL_ADD_ASSOC, SIN_CIRCLE,
1250 REAL_ADD_ASSOC, SIN_CIRCLE, REAL_ADD_RINV, REAL_LT_REFL]
1251QED
1252
1253Theorem COS_BOUNDS:
1254 !x. ~(&1) <= cos(x) /\ cos(x) <= &1
1255Proof
1256 GEN_TAC THEN REWRITE_TAC[GSYM ABS_BOUNDS, COS_BOUND]
1257QED
1258
1259Theorem SIN_COS_ADD:
1260 !x y. ((sin(x + y) - ((sin(x) * cos(y)) + (cos(x) * sin(y)))) pow 2) +
1261 ((cos(x + y) - ((cos(x) * cos(y)) - (sin(x) * sin(y)))) pow 2) = &0
1262Proof
1263 REPEAT GEN_TAC THEN
1264 CONV_TAC(LAND_CONV(X_BETA_CONV “x:real”)) THEN
1265 W(C SUBGOAL_THEN (SUBST1_TAC o SYM) o hol88Lib.subst[(“&0”,“x:real”)] o snd) THENL
1266 [BETA_TAC THEN REWRITE_TAC[SIN_0, COS_0] THEN
1267 REWRITE_TAC[REAL_ADD_LID, REAL_MUL_LZERO, REAL_MUL_LID] THEN
1268 REWRITE_TAC[REAL_SUB_RZERO, REAL_SUB_REFL] THEN
1269 REWRITE_TAC[TWO, POW_0, REAL_ADD_LID],
1270 MATCH_MP_TAC DIFF_ISCONST_ALL THEN GEN_TAC THEN
1271 W(MP_TAC o DIFF_CONV o rand o funpow 2 rator o snd) THEN
1272 REDUCE_TAC THEN REWRITE_TAC[POW_1] THEN
1273 REWRITE_TAC[REAL_MUL_LZERO, REAL_ADD_RID, REAL_MUL_RID] THEN
1274 DISCH_THEN(MP_TAC o SPEC “x:real”) THEN
1275 MATCH_MP_TAC(TAUT_CONV “(a <=> b) ==> a ==> b”) THEN AP_THM_TAC THEN
1276 AP_TERM_TAC THEN REWRITE_TAC[GSYM REAL_NEG_LMUL] THEN
1277 ONCE_REWRITE_TAC[GSYM REAL_EQ_SUB_LADD] THEN
1278 REWRITE_TAC[REAL_SUB_LZERO, GSYM REAL_MUL_ASSOC] THEN
1279 REWRITE_TAC[REAL_NEG_RMUL] THEN AP_TERM_TAC THEN
1280 GEN_REWR_TAC RAND_CONV [REAL_MUL_SYM] THEN BINOP_TAC THENL
1281 [REWRITE_TAC[real_sub, REAL_NEG_ADD, REAL_NEGNEG, REAL_NEG_RMUL],
1282 REWRITE_TAC[GSYM REAL_NEG_RMUL, GSYM real_sub]]]
1283QED
1284
1285Theorem SIN_COS_NEG:
1286 !x. ((sin(~x) + (sin x)) pow 2) +
1287 ((cos(~x) - (cos x)) pow 2) = &0
1288Proof
1289 GEN_TAC THEN CONV_TAC(LAND_CONV(X_BETA_CONV “x:real”)) THEN
1290 W(C SUBGOAL_THEN (SUBST1_TAC o SYM) o hol88Lib.subst[(“&0”,“x:real”)] o snd) THENL
1291 [BETA_TAC THEN REWRITE_TAC[SIN_0, COS_0, REAL_NEG_0] THEN
1292 REWRITE_TAC[REAL_ADD_LID, REAL_SUB_REFL] THEN
1293 REWRITE_TAC[TWO, POW_0, REAL_ADD_LID],
1294 MATCH_MP_TAC DIFF_ISCONST_ALL THEN GEN_TAC THEN
1295 W(MP_TAC o DIFF_CONV o rand o funpow 2 rator o snd) THEN
1296 REDUCE_TAC THEN REWRITE_TAC[POW_1] THEN
1297 DISCH_THEN(MP_TAC o SPEC “x:real”) THEN
1298 MATCH_MP_TAC(TAUT_CONV “(a <=> b) ==> a ==> b”) THEN AP_THM_TAC THEN
1299 AP_TERM_TAC THEN REWRITE_TAC[GSYM REAL_NEG_RMUL] THEN
1300 REWRITE_TAC[REAL_MUL_RID, real_sub, REAL_NEGNEG, GSYM REAL_MUL_ASSOC] THEN
1301 ONCE_REWRITE_TAC[GSYM REAL_EQ_SUB_LADD] THEN
1302 REWRITE_TAC[REAL_SUB_LZERO, REAL_NEG_RMUL] THEN AP_TERM_TAC THEN
1303 GEN_REWR_TAC RAND_CONV [REAL_MUL_SYM] THEN
1304 REWRITE_TAC[GSYM REAL_NEG_LMUL, REAL_NEG_RMUL] THEN AP_TERM_TAC THEN
1305 REWRITE_TAC[REAL_NEG_ADD, REAL_NEGNEG]]
1306QED
1307
1308Theorem SIN_ADD:
1309 !x y. sin(x + y) = (sin(x) * cos(y)) + (cos(x) * sin(y))
1310Proof
1311 REPEAT GEN_TAC THEN MP_TAC(SPECL [“x:real”, “y:real”] SIN_COS_ADD) THEN
1312 REWRITE_TAC[POW_2, REAL_SUMSQ] THEN REWRITE_TAC[REAL_SUB_0] THEN
1313 DISCH_THEN(fn th => REWRITE_TAC[th])
1314QED
1315
1316Theorem COS_ADD:
1317 !x y. cos(x + y) = (cos(x) * cos(y)) - (sin(x) * sin(y))
1318Proof
1319 REPEAT GEN_TAC THEN MP_TAC(SPECL [“x:real”, “y:real”] SIN_COS_ADD) THEN
1320 REWRITE_TAC[POW_2, REAL_SUMSQ] THEN REWRITE_TAC[REAL_SUB_0] THEN
1321 DISCH_THEN(fn th => REWRITE_TAC[th])
1322QED
1323
1324Theorem SIN_NEG:
1325 !x. sin(~x) = ~(sin(x))
1326Proof
1327 GEN_TAC THEN MP_TAC(SPEC “x:real” SIN_COS_NEG) THEN
1328 REWRITE_TAC[POW_2, REAL_SUMSQ] THEN REWRITE_TAC[REAL_LNEG_UNIQ] THEN
1329 DISCH_THEN(fn th => REWRITE_TAC[th])
1330QED
1331
1332Theorem COS_NEG:
1333 !x. cos(~x) = cos(x)
1334Proof
1335 GEN_TAC THEN MP_TAC(SPEC “x:real” SIN_COS_NEG) THEN
1336 REWRITE_TAC[POW_2, REAL_SUMSQ] THEN REWRITE_TAC[REAL_SUB_0] THEN
1337 DISCH_THEN(fn th => REWRITE_TAC[th])
1338QED
1339
1340Theorem SIN_DOUBLE:
1341 !x. sin(&2 * x) = &2 * (sin(x) * cos(x))
1342Proof
1343 GEN_TAC THEN REWRITE_TAC[GSYM REAL_DOUBLE, SIN_ADD] THEN
1344 AP_TERM_TAC THEN MATCH_ACCEPT_TAC REAL_MUL_SYM
1345QED
1346
1347Theorem COS_DOUBLE:
1348 !x. cos(&2 * x) = (cos(x) pow 2) - (sin(x) pow 2)
1349Proof
1350 GEN_TAC THEN REWRITE_TAC[GSYM REAL_DOUBLE, COS_ADD, POW_2]
1351QED
1352
1353(*---------------------------------------------------------------------------*)
1354(* Show that there's a least positive x with cos(x) = 0; hence define pi *)
1355(*---------------------------------------------------------------------------*)
1356
1357Theorem SIN_PAIRED:
1358 !x. (\n. (((~(&1)) pow n) / &(FACT((2 * n) + 1)))
1359 * (x pow ((2 * n) + 1))) sums (sin x)
1360Proof
1361 GEN_TAC THEN MP_TAC(SPEC “x:real” SIN_CONVERGES) THEN
1362 DISCH_THEN(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN
1363 DISCH_THEN(MP_TAC o MATCH_MP SER_PAIR) THEN REWRITE_TAC[GSYM sin] THEN
1364 BETA_TAC THEN REWRITE_TAC[SUM_2] THEN BETA_TAC THEN
1365 REWRITE_TAC[GSYM ADD1, EVEN_DOUBLE, REWRITE_RULE[ODD_EVEN] ODD_DOUBLE] THEN
1366 REWRITE_TAC[REAL_MUL_LZERO, REAL_ADD_LID, SUC_SUB1, MULT_DIV_2]
1367QED
1368
1369Theorem SIN_POS:
1370 !x. &0 < x /\ x < &2 ==> &0 < sin(x)
1371Proof
1372 GEN_TAC THEN STRIP_TAC THEN MP_TAC(SPEC “x:real” SIN_PAIRED) THEN
1373 DISCH_THEN(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN
1374 DISCH_THEN(MP_TAC o MATCH_MP SER_PAIR) THEN
1375 REWRITE_TAC[SYM(MATCH_MP SUM_UNIQ (SPEC “x:real” SIN_PAIRED))] THEN
1376 REWRITE_TAC[SUM_2] THEN BETA_TAC THEN REWRITE_TAC[GSYM ADD1] THEN
1377 REWRITE_TAC[pow, GSYM REAL_NEG_MINUS1, POW_MINUS1] THEN
1378 REWRITE_TAC[real_div, GSYM REAL_NEG_LMUL, GSYM real_sub] THEN
1379 REWRITE_TAC[REAL_MUL_LID] THEN REWRITE_TAC[ADD1] THEN DISCH_TAC THEN
1380 FIRST_ASSUM(SUBST1_TAC o MATCH_MP SUM_UNIQ) THEN
1381 W(C SUBGOAL_THEN SUBST1_TAC o curry mk_eq “&0” o curry mk_comb “sum(0,0)” o
1382 funpow 2 rand o snd) THENL [REWRITE_TAC[sum], ALL_TAC] THEN
1383 MATCH_MP_TAC SER_POS_LT THEN
1384 FIRST_ASSUM(fn th => REWRITE_TAC[MATCH_MP SUM_SUMMABLE th]) THEN
1385 X_GEN_TAC “n:num” THEN DISCH_THEN(K ALL_TAC) THEN BETA_TAC THEN
1386 REWRITE_TAC[GSYM ADD1, MULT_CLAUSES] THEN
1387 REWRITE_TAC[TWO, ADD_CLAUSES, pow, FACT, GSYM REAL_MUL] THEN
1388 REWRITE_TAC[SYM(TWO)] THEN
1389 REWRITE_TAC[ONE, ADD_CLAUSES, pow, FACT, GSYM REAL_MUL] THEN
1390 REWRITE_TAC[REAL_SUB_LT] THEN ONCE_REWRITE_TAC[GSYM pow] THEN
1391 REWRITE_TAC[REAL_MUL_ASSOC] THEN
1392 MATCH_MP_TAC REAL_LT_RMUL_IMP THEN CONJ_TAC THENL
1393 [ALL_TAC, MATCH_MP_TAC POW_POS_LT THEN ASM_REWRITE_TAC[]] THEN
1394 REWRITE_TAC[GSYM REAL_MUL_ASSOC, GSYM POW_2] THEN
1395 SUBGOAL_THEN “!n. &0 < &(SUC n)” ASSUME_TAC THENL
1396 [GEN_TAC THEN REWRITE_TAC[REAL_LT, LESS_0], ALL_TAC] THEN
1397 SUBGOAL_THEN “!n. &0 < &(FACT n)” ASSUME_TAC THENL
1398 [GEN_TAC THEN REWRITE_TAC[REAL_LT, FACT_LESS], ALL_TAC] THEN
1399 SUBGOAL_THEN “!n. ~(&(SUC n) = &0)” ASSUME_TAC THENL
1400 [GEN_TAC THEN REWRITE_TAC[REAL_INJ, NOT_SUC], ALL_TAC] THEN
1401 SUBGOAL_THEN “!n. ~(&(FACT n) = &0)” ASSUME_TAC THENL
1402 [GEN_TAC THEN MATCH_MP_TAC REAL_POS_NZ THEN
1403 REWRITE_TAC[REAL_LT, FACT_LESS], ALL_TAC] THEN
1404 REPEAT(IMP_SUBST_TAC REAL_INV_MUL THEN ASM_REWRITE_TAC[REAL_ENTIRE]) THEN
1405 REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN
1406 ONCE_REWRITE_TAC[AC(REAL_MUL_ASSOC,REAL_MUL_SYM)
1407 “a * (b * (c * (d * e))) =
1408 (a * (b * e)) * (c * d)”] THEN
1409 GEN_REWR_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN
1410 MATCH_MP_TAC REAL_LT_RMUL_IMP THEN CONJ_TAC THENL
1411 [ALL_TAC, MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC THEN
1412 MATCH_MP_TAC REAL_INV_POS THEN ASM_REWRITE_TAC[]] THEN
1413 REWRITE_TAC[REAL_MUL_ASSOC] THEN
1414 IMP_SUBST_TAC ((CONV_RULE(RAND_CONV SYM_CONV) o SPEC_ALL) REAL_INV_MUL) THEN
1415 ASM_REWRITE_TAC[REAL_ENTIRE] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
1416 REWRITE_TAC[GSYM real_div] THEN MATCH_MP_TAC REAL_LT_1 THEN
1417 REWRITE_TAC[POW_2] THEN CONJ_TAC THENL
1418 [MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC,
1419 MATCH_MP_TAC REAL_LT_MUL2 THEN REPEAT CONJ_TAC] THEN
1420 TRY(MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[] THEN NO_TAC) THENL
1421 [W(curry op THEN (MATCH_MP_TAC REAL_LT_TRANS) o EXISTS_TAC o
1422 curry mk_comb “(&)” o funpow 3 rand o snd) THEN
1423 REWRITE_TAC[REAL_LT, LESS_SUC_REFL], ALL_TAC] THEN
1424 MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC “&2” THEN
1425 ASM_REWRITE_TAC[] THEN CONV_TAC(REDEPTH_CONV num_CONV) THEN
1426 REWRITE_TAC[REAL_LE, LESS_EQ_MONO, ZERO_LESS_EQ]
1427QED
1428
1429Theorem COS_PAIRED:
1430 !x. (\n. (((~(&1)) pow n) / &(FACT(2 * n)))
1431 * (x pow (2 * n))) sums (cos x)
1432Proof
1433 GEN_TAC THEN MP_TAC(SPEC “x:real” COS_CONVERGES) THEN
1434 DISCH_THEN(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN
1435 DISCH_THEN(MP_TAC o MATCH_MP SER_PAIR) THEN REWRITE_TAC[GSYM cos] THEN
1436 BETA_TAC THEN REWRITE_TAC[SUM_2] THEN BETA_TAC THEN
1437 REWRITE_TAC[GSYM ADD1, EVEN_DOUBLE, REWRITE_RULE[ODD_EVEN] ODD_DOUBLE] THEN
1438 REWRITE_TAC[REAL_MUL_LZERO, REAL_ADD_RID, MULT_DIV_2]
1439QED
1440
1441Theorem COS_2:
1442 cos(&2) < &0
1443Proof
1444 GEN_REWR_TAC LAND_CONV [GSYM REAL_NEGNEG] THEN
1445 REWRITE_TAC[REAL_NEG_LT0] THEN MP_TAC(SPEC “&2” COS_PAIRED) THEN
1446 DISCH_THEN(MP_TAC o MATCH_MP SER_NEG) THEN BETA_TAC THEN
1447 DISCH_TAC THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP SUM_UNIQ) THEN
1448 MATCH_MP_TAC REAL_LT_TRANS THEN
1449 EXISTS_TAC “sum(0,3) (\n. ~((((~(&1)) pow n) / &(FACT(2 * n)))
1450 * (&2 pow (2 * n))))” THEN CONJ_TAC THENL
1451 [REWRITE_TAC[num_CONV “3:num”, sum, SUM_2] THEN BETA_TAC THEN
1452 REWRITE_TAC[MULT_CLAUSES, ADD_CLAUSES, pow, FACT] THEN
1453 REWRITE_TAC[REAL_MUL_RID, POW_1, POW_2, GSYM REAL_NEG_RMUL] THEN
1454 IMP_SUBST_TAC REAL_DIV_REFL THEN REWRITE_TAC[REAL_NEGNEG, REAL_10] THEN
1455 REDUCE_TAC THEN
1456 REWRITE_TAC[num_CONV “4:num”, num_CONV “3:num”, FACT, pow] THEN
1457 REWRITE_TAC[SYM(num_CONV “4:num”), SYM(num_CONV “3:num”)] THEN
1458 REWRITE_TAC[TWO, ONE, FACT, pow] THEN
1459 REWRITE_TAC[SYM(ONE), SYM(TWO)] THEN
1460 REWRITE_TAC[REAL_MUL] THEN REDUCE_TAC THEN
1461 REWRITE_TAC[real_div, REAL_NEG_LMUL, REAL_NEGNEG, REAL_MUL_LID] THEN
1462 REWRITE_TAC[GSYM REAL_NEG_LMUL, REAL_ADD_ASSOC] THEN
1463 REWRITE_TAC[GSYM real_sub, REAL_SUB_LT] THEN
1464 SUBGOAL_THEN “inv(&2) * &4 = &1 + &1” SUBST1_TAC THENL
1465 [MATCH_MP_TAC REAL_EQ_LMUL_IMP THEN EXISTS_TAC “&2” THEN
1466 REWRITE_TAC[REAL_INJ] THEN REDUCE_TAC THEN
1467 REWRITE_TAC[REAL_ADD, REAL_MUL] THEN REDUCE_TAC THEN
1468 REWRITE_TAC[REAL_MUL_ASSOC] THEN
1469 SUBGOAL_THEN “&2 * inv(&2) = &1” SUBST1_TAC THEN
1470 REWRITE_TAC[REAL_MUL_LID] THEN MATCH_MP_TAC REAL_MUL_RINV THEN
1471 REWRITE_TAC[REAL_INJ] THEN REDUCE_TAC,
1472 REWRITE_TAC[REAL_MUL_LID, REAL_ADD_ASSOC] THEN
1473 REWRITE_TAC[REAL_ADD_LINV, REAL_ADD_LID] THEN
1474 ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN
1475 MATCH_MP_TAC REAL_LT_1 THEN REWRITE_TAC[REAL_LE, REAL_LT] THEN
1476 REDUCE_TAC], ALL_TAC] THEN
1477 MATCH_MP_TAC SER_POS_LT_PAIR THEN
1478 FIRST_ASSUM(fn th => REWRITE_TAC[MATCH_MP SUM_SUMMABLE th]) THEN
1479 X_GEN_TAC “d:num” THEN BETA_TAC THEN
1480 REWRITE_TAC[POW_ADD, POW_MINUS1, REAL_MUL_RID] THEN
1481 REWRITE_TAC[num_CONV “3:num”, pow] THEN REWRITE_TAC[SYM(num_CONV “3:num”)] THEN
1482 REWRITE_TAC[POW_2, POW_1] THEN
1483 REWRITE_TAC[GSYM REAL_NEG_MINUS1, REAL_NEGNEG] THEN
1484 REWRITE_TAC[real_div, GSYM REAL_NEG_LMUL, GSYM REAL_NEG_RMUL] THEN
1485 REWRITE_TAC[REAL_MUL_LID, REAL_NEGNEG] THEN
1486 REWRITE_TAC[GSYM real_sub, REAL_SUB_LT] THEN
1487 REWRITE_TAC[GSYM ADD1, ADD_CLAUSES, MULT_CLAUSES] THEN
1488 REWRITE_TAC[POW_ADD, REAL_MUL_ASSOC] THEN
1489 MATCH_MP_TAC REAL_LT_RMUL_IMP THEN CONJ_TAC THENL
1490 [ALL_TAC,
1491 REWRITE_TAC[TWO, MULT_CLAUSES] THEN
1492 REWRITE_TAC[num_CONV “3:num”, ADD_CLAUSES] THEN
1493 MATCH_MP_TAC POW_POS_LT THEN REWRITE_TAC[REAL_LT] THEN
1494 REDUCE_TAC] THEN
1495 REWRITE_TAC[TWO, ADD_CLAUSES, FACT] THEN
1496 REWRITE_TAC[SYM(TWO)] THEN
1497 REWRITE_TAC[ONE, ADD_CLAUSES, FACT] THEN
1498 REWRITE_TAC[SYM(ONE)] THEN
1499 SUBGOAL_THEN “!n. &0 < &(SUC n)” ASSUME_TAC THENL
1500 [GEN_TAC THEN REWRITE_TAC[REAL_LT, LESS_0], ALL_TAC] THEN
1501 SUBGOAL_THEN “!n. &0 < &(FACT n)” ASSUME_TAC THENL
1502 [GEN_TAC THEN REWRITE_TAC[REAL_LT, FACT_LESS], ALL_TAC] THEN
1503 SUBGOAL_THEN “!n. ~(&(SUC n) = &0)” ASSUME_TAC THENL
1504 [GEN_TAC THEN REWRITE_TAC[REAL_INJ, NOT_SUC], ALL_TAC] THEN
1505 SUBGOAL_THEN “!n. ~(&(FACT n) = &0)” ASSUME_TAC THENL
1506 [GEN_TAC THEN MATCH_MP_TAC REAL_POS_NZ THEN
1507 REWRITE_TAC[REAL_LT, FACT_LESS], ALL_TAC] THEN
1508 REWRITE_TAC[GSYM REAL_MUL] THEN
1509 REPEAT(IMP_SUBST_TAC REAL_INV_MUL THEN ASM_REWRITE_TAC[REAL_ENTIRE]) THEN
1510 REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN
1511 ONCE_REWRITE_TAC[AC(REAL_MUL_ASSOC,REAL_MUL_SYM)
1512 “a * (b * (c * d)) = (a * (b * d)) * c”] THEN
1513 GEN_REWR_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN
1514 MATCH_MP_TAC REAL_LT_RMUL_IMP THEN CONJ_TAC THENL
1515 [ALL_TAC,
1516 MATCH_MP_TAC REAL_INV_POS THEN REWRITE_TAC[REAL_LT, FACT_LESS]] THEN
1517 REWRITE_TAC[REAL_MUL_ASSOC] THEN
1518 IMP_SUBST_TAC ((CONV_RULE(RAND_CONV SYM_CONV) o SPEC_ALL) REAL_INV_MUL) THEN
1519 ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
1520 REWRITE_TAC[GSYM real_div] THEN MATCH_MP_TAC REAL_LT_1 THEN
1521 REWRITE_TAC[POW_2, REAL_MUL, REAL_LE, REAL_LT] THEN REDUCE_TAC THEN
1522 REWRITE_TAC[num_CONV “4:num”, num_CONV “3:num”,
1523 MULT_CLAUSES, ADD_CLAUSES] THEN
1524 REWRITE_TAC[LESS_MONO_EQ] THEN
1525 REWRITE_TAC[TWO, ADD_CLAUSES, MULT_CLAUSES] THEN
1526 REWRITE_TAC[ONE, LESS_MONO_EQ, LESS_0]
1527QED
1528
1529Theorem COS_ISZERO:
1530 ?!x. &0 <= x /\ x <= &2 /\ (cos x = &0)
1531Proof
1532 REWRITE_TAC[EXISTS_UNIQUE_DEF] THEN BETA_TAC THEN
1533 W(C SUBGOAL_THEN ASSUME_TAC o hd o strip_conj o snd) THENL
1534 [MATCH_MP_TAC IVT2 THEN REPEAT CONJ_TAC THENL
1535 [REWRITE_TAC[REAL_LE, ZERO_LESS_EQ],
1536 MATCH_MP_TAC REAL_LT_IMP_LE THEN ACCEPT_TAC COS_2,
1537 REWRITE_TAC[COS_0, REAL_LE_01],
1538 X_GEN_TAC “x:real” THEN DISCH_THEN(K ALL_TAC) THEN
1539 MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC “~(sin x)” THEN
1540 REWRITE_TAC[DIFF_COS]],
1541 ASM_REWRITE_TAC[] THEN BETA_TAC THEN
1542 MAP_EVERY X_GEN_TAC [“x1:real”, “x2:real”] THEN
1543 GEN_REWR_TAC I [TAUT_CONV “a:bool <=> ~~a”] THEN
1544 PURE_REWRITE_TAC[NOT_IMP] THEN REWRITE_TAC[] THEN STRIP_TAC THEN
1545 MP_TAC(SPECL [“x1:real”, “x2:real”] REAL_LT_TOTAL) THEN
1546 SUBGOAL_THEN “(!x. cos differentiable x) /\ (!x. cos contl x)”
1547 STRIP_ASSUME_TAC THENL
1548 [CONJ_TAC THEN GEN_TAC THENL
1549 [REWRITE_TAC[differentiable], MATCH_MP_TAC DIFF_CONT] THEN
1550 EXISTS_TAC “~(sin x)” THEN REWRITE_TAC[DIFF_COS], ALL_TAC] THEN
1551 ASM_REWRITE_TAC[] THEN DISCH_THEN DISJ_CASES_TAC THENL
1552 [MP_TAC(SPECL [“cos”, “x1:real”, “x2:real”] ROLLE),
1553 MP_TAC(SPECL [“cos”, “x2:real”, “x1:real”] ROLLE)] THEN
1554 ASM_REWRITE_TAC[] THEN
1555 DISCH_THEN(X_CHOOSE_THEN “x:real” MP_TAC) THEN REWRITE_TAC[CONJ_ASSOC] THEN
1556 DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN
1557 DISCH_THEN(MP_TAC o CONJ(SPEC “x:real” DIFF_COS)) THEN
1558 DISCH_THEN(MP_TAC o MATCH_MP DIFF_UNIQ) THEN
1559 REWRITE_TAC[REAL_NEG_EQ0] THEN MATCH_MP_TAC REAL_POS_NZ THEN
1560 MATCH_MP_TAC SIN_POS THENL
1561 [CONJ_TAC THENL
1562 [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC “x1:real” THEN
1563 ASM_REWRITE_TAC[],
1564 MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC “x2:real” THEN
1565 ASM_REWRITE_TAC[]],
1566 CONJ_TAC THENL
1567 [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC “x2:real” THEN
1568 ASM_REWRITE_TAC[],
1569 MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC “x1:real” THEN
1570 ASM_REWRITE_TAC[]]]]
1571QED
1572
1573Definition pi[nocompute]:
1574 pi = &2 * @x. &0 <= x /\ x <= &2 /\ (cos x = &0)
1575End
1576
1577(*---------------------------------------------------------------------------*)
1578(* Periodicity and related properties of the trig functions *)
1579(*---------------------------------------------------------------------------*)
1580
1581Theorem PI2:
1582 pi / &2 = @x. &0 <= x /\ x <= &2 /\ (cos(x) = &0)
1583Proof
1584 REWRITE_TAC[pi, real_div] THEN
1585 ONCE_REWRITE_TAC[AC(REAL_MUL_ASSOC,REAL_MUL_SYM)
1586 “(a * b) * c = (c * a) * b”] THEN
1587 IMP_SUBST_TAC REAL_MUL_LINV THEN REWRITE_TAC[REAL_INJ] THEN
1588 REDUCE_TAC THEN REWRITE_TAC[REAL_MUL_LID]
1589QED
1590
1591Theorem COS_PI2:
1592 cos(pi / &2) = &0
1593Proof
1594 MP_TAC(SELECT_RULE (EXISTENCE COS_ISZERO)) THEN
1595 REWRITE_TAC[GSYM PI2] THEN
1596 DISCH_THEN(fn th => REWRITE_TAC[th])
1597QED
1598
1599Theorem PI2_BOUNDS:
1600 &0 < (pi / &2) /\ (pi / &2) < &2
1601Proof
1602 MP_TAC(SELECT_RULE (EXISTENCE COS_ISZERO)) THEN
1603 REWRITE_TAC[GSYM PI2] THEN DISCH_TAC THEN
1604 ASM_REWRITE_TAC[REAL_LT_LE] THEN CONJ_TAC THENL
1605 [DISCH_TAC THEN MP_TAC COS_0 THEN ASM_REWRITE_TAC[] THEN
1606 FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[GSYM REAL_10],
1607 DISCH_TAC THEN MP_TAC COS_PI2 THEN FIRST_ASSUM SUBST1_TAC THEN
1608 REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_IMP_NE THEN
1609 MATCH_ACCEPT_TAC COS_2]
1610QED
1611
1612Theorem PI_POS:
1613 &0 < pi
1614Proof
1615 GEN_REWR_TAC RAND_CONV [GSYM REAL_HALF_DOUBLE] THEN
1616 MATCH_MP_TAC REAL_LT_ADD THEN REWRITE_TAC[PI2_BOUNDS]
1617QED
1618
1619Theorem SIN_PI2:
1620 sin(pi / &2) = &1
1621Proof
1622 MP_TAC(SPEC “pi / &2” SIN_CIRCLE) THEN
1623 REWRITE_TAC[COS_PI2, POW_2, REAL_MUL_LZERO, REAL_ADD_RID] THEN
1624 GEN_REWR_TAC (LAND_CONV o RAND_CONV) [GSYM REAL_MUL_LID] THEN
1625 ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN
1626 REWRITE_TAC[GSYM REAL_DIFFSQ, REAL_ENTIRE] THEN
1627 DISCH_THEN DISJ_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
1628 POP_ASSUM MP_TAC THEN CONV_TAC CONTRAPOS_CONV THEN DISCH_THEN(K ALL_TAC) THEN
1629 REWRITE_TAC[REAL_LNEG_UNIQ] THEN DISCH_THEN(MP_TAC o AP_TERM “$real_neg”) THEN
1630 REWRITE_TAC[REAL_NEGNEG] THEN DISCH_TAC THEN
1631 MP_TAC REAL_LT_01 THEN POP_ASSUM(SUBST1_TAC o SYM) THEN
1632 REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_GT THEN
1633 REWRITE_TAC[REAL_NEG_LT0] THEN MATCH_MP_TAC SIN_POS THEN
1634 REWRITE_TAC[PI2_BOUNDS]
1635QED
1636
1637Theorem COS_PI:
1638 cos(pi) = ~(&1)
1639Proof
1640 MP_TAC(SPECL [“pi / &2”, “pi / &2”] COS_ADD) THEN
1641 REWRITE_TAC[SIN_PI2, COS_PI2, REAL_MUL_LZERO, REAL_MUL_LID] THEN
1642 REWRITE_TAC[REAL_SUB_LZERO] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
1643 AP_TERM_TAC THEN REWRITE_TAC[REAL_DOUBLE] THEN
1644 CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_DIV_LMUL THEN
1645 REWRITE_TAC[REAL_INJ] THEN REDUCE_TAC
1646QED
1647
1648Theorem SIN_PI:
1649 sin(pi) = &0
1650Proof
1651 MP_TAC(SPECL [“pi / &2”, “pi / &2”] SIN_ADD) THEN
1652 REWRITE_TAC[COS_PI2, REAL_MUL_LZERO, REAL_MUL_RZERO, REAL_ADD_LID] THEN
1653 DISCH_THEN(SUBST1_TAC o SYM) THEN AP_TERM_TAC THEN
1654 REWRITE_TAC[REAL_DOUBLE] THEN CONV_TAC SYM_CONV THEN
1655 MATCH_MP_TAC REAL_DIV_LMUL THEN
1656 REWRITE_TAC[REAL_INJ] THEN REDUCE_TAC
1657QED
1658
1659Theorem SIN_COS:
1660 !x. sin(x) = cos((pi / &2) - x)
1661Proof
1662 GEN_TAC THEN REWRITE_TAC[real_sub, COS_ADD] THEN
1663 REWRITE_TAC[SIN_PI2, COS_PI2, REAL_MUL_LZERO] THEN
1664 REWRITE_TAC[REAL_ADD_LID, REAL_MUL_LID] THEN
1665 REWRITE_TAC[SIN_NEG, REAL_NEGNEG]
1666QED
1667
1668Theorem COS_SIN:
1669 !x. cos(x) = sin((pi / &2) - x)
1670Proof
1671 GEN_TAC THEN REWRITE_TAC[real_sub, SIN_ADD] THEN
1672 REWRITE_TAC[SIN_PI2, COS_PI2, REAL_MUL_LZERO] THEN
1673 REWRITE_TAC[REAL_MUL_LID, REAL_ADD_RID] THEN
1674 REWRITE_TAC[COS_NEG]
1675QED
1676
1677Theorem SIN_PERIODIC_PI:
1678 !x. sin(x + pi) = ~(sin(x))
1679Proof
1680 GEN_TAC THEN REWRITE_TAC[SIN_ADD, SIN_PI, COS_PI] THEN
1681 REWRITE_TAC[REAL_MUL_RZERO, REAL_ADD_RID, GSYM REAL_NEG_RMUL] THEN
1682 REWRITE_TAC[REAL_MUL_RID]
1683QED
1684
1685Theorem COS_PERIODIC_PI:
1686 !x. cos(x + pi) = ~(cos(x))
1687Proof
1688 GEN_TAC THEN REWRITE_TAC[COS_ADD, SIN_PI, COS_PI] THEN
1689 REWRITE_TAC[REAL_MUL_RZERO, REAL_SUB_RZERO, GSYM REAL_NEG_RMUL] THEN
1690 REWRITE_TAC[REAL_MUL_RID]
1691QED
1692
1693Theorem SIN_PERIODIC:
1694 !x. sin(x + (&2 * pi)) = sin(x)
1695Proof
1696 GEN_TAC THEN REWRITE_TAC[GSYM REAL_DOUBLE, REAL_ADD_ASSOC] THEN
1697 REWRITE_TAC[SIN_PERIODIC_PI, REAL_NEGNEG]
1698QED
1699
1700Theorem COS_PERIODIC:
1701 !x. cos(x + (&2 * pi)) = cos(x)
1702Proof
1703 GEN_TAC THEN REWRITE_TAC[GSYM REAL_DOUBLE, REAL_ADD_ASSOC] THEN
1704 REWRITE_TAC[COS_PERIODIC_PI, REAL_NEGNEG]
1705QED
1706
1707Theorem COS_NPI:
1708 !n. cos(&n * pi) = ~(&1) pow n
1709Proof
1710 INDUCT_TAC THEN REWRITE_TAC[REAL_MUL_LZERO, COS_0, pow] THEN
1711 REWRITE_TAC[ADD1, GSYM REAL_ADD, REAL_RDISTRIB, COS_ADD] THEN
1712 REWRITE_TAC[REAL_MUL_LID, SIN_PI, REAL_MUL_RZERO, REAL_SUB_RZERO] THEN
1713 ASM_REWRITE_TAC[COS_PI] THEN
1714 MATCH_ACCEPT_TAC REAL_MUL_SYM
1715QED
1716
1717Theorem SIN_NPI:
1718 !n. sin(&n * pi) = &0
1719Proof
1720 INDUCT_TAC THEN REWRITE_TAC[REAL_MUL_LZERO, SIN_0, pow] THEN
1721 REWRITE_TAC[ADD1, GSYM REAL_ADD, REAL_RDISTRIB, SIN_ADD] THEN
1722 REWRITE_TAC[REAL_MUL_LID, SIN_PI, REAL_MUL_RZERO, REAL_ADD_RID] THEN
1723 ASM_REWRITE_TAC[REAL_MUL_LZERO]
1724QED
1725
1726Theorem SIN_POS_PI2:
1727 !x. &0 < x /\ x < pi / &2 ==> &0 < sin(x)
1728Proof
1729 GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC SIN_POS THEN
1730 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_TRANS THEN
1731 EXISTS_TAC “pi / &2” THEN ASM_REWRITE_TAC[PI2_BOUNDS]
1732QED
1733
1734Theorem COS_POS_PI2:
1735 !x. &0 < x /\ x < pi / &2 ==> &0 < cos(x)
1736Proof
1737 GEN_TAC THEN STRIP_TAC THEN
1738 GEN_REWR_TAC I [TAUT_CONV “a:bool = ~~a”] THEN
1739 PURE_REWRITE_TAC[REAL_NOT_LT] THEN DISCH_TAC THEN
1740 MP_TAC(SPECL [“cos”, “&0”, “x:real”, “&0”] IVT2) THEN
1741 ASM_REWRITE_TAC[COS_0, REAL_LE_01, NOT_IMP] THEN REPEAT CONJ_TAC THENL
1742 [MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[],
1743 X_GEN_TAC “z:real” THEN DISCH_THEN(K ALL_TAC) THEN
1744 MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC “~(sin z)” THEN
1745 REWRITE_TAC[DIFF_COS],
1746 DISCH_THEN(X_CHOOSE_TAC “z:real”) THEN
1747 MP_TAC(CONJUNCT2 (CONV_RULE EXISTS_UNIQUE_CONV COS_ISZERO)) THEN
1748 DISCH_THEN(MP_TAC o SPECL [“z:real”, “pi / &2”]) THEN
1749 ASM_REWRITE_TAC[COS_PI2] THEN REWRITE_TAC[NOT_IMP] THEN
1750 REPEAT CONJ_TAC THENL
1751 [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC “x:real” THEN
1752 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN
1753 EXISTS_TAC “pi / &2” THEN ASM_REWRITE_TAC[] THEN CONJ_TAC,
1754 ALL_TAC,
1755 ALL_TAC,
1756 DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC “x < pi / &2” THEN
1757 ASM_REWRITE_TAC[REAL_NOT_LT]] THEN
1758 MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[PI2_BOUNDS]]
1759QED
1760
1761Theorem COS_POS_PI:
1762 !x. ~(pi / &2) < x /\ x < pi / &2 ==> &0 < cos(x)
1763Proof
1764 GEN_TAC THEN STRIP_TAC THEN
1765 REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC
1766 (SPECL [“x:real”, “&0”] REAL_LT_TOTAL) THENL
1767 [ASM_REWRITE_TAC[COS_0, REAL_LT_01],
1768 ONCE_REWRITE_TAC[GSYM COS_NEG] THEN MATCH_MP_TAC COS_POS_PI2 THEN
1769 ONCE_REWRITE_TAC[GSYM REAL_NEG_LT0] THEN ASM_REWRITE_TAC[REAL_NEGNEG] THEN
1770 ONCE_REWRITE_TAC[GSYM REAL_LT_NEG] THEN ASM_REWRITE_TAC[REAL_NEGNEG],
1771 MATCH_MP_TAC COS_POS_PI2 THEN ASM_REWRITE_TAC[]]
1772QED
1773
1774Theorem SIN_POS_PI:
1775 !x. &0 < x /\ x < pi ==> &0 < sin(x)
1776Proof
1777 GEN_TAC THEN STRIP_TAC THEN
1778 REWRITE_TAC[SIN_COS] THEN ONCE_REWRITE_TAC[GSYM COS_NEG] THEN
1779 REWRITE_TAC[REAL_NEG_SUB] THEN
1780 MATCH_MP_TAC COS_POS_PI THEN
1781 REWRITE_TAC[REAL_LT_SUB_LADD, REAL_LT_SUB_RADD] THEN
1782 ASM_REWRITE_TAC[REAL_HALF_DOUBLE, REAL_ADD_LINV]
1783QED
1784
1785Theorem COS_POS_PI2_LE:
1786 !x. &0 <= x /\ x <= (pi / &2) ==> &0 <= cos(x)
1787Proof
1788 GEN_TAC THEN REWRITE_TAC[REAL_LE_LT] THEN
1789 DISCH_THEN(CONJUNCTS_THEN DISJ_CASES_TAC) THEN
1790 ASM_REWRITE_TAC[COS_PI2] THEN
1791 TRY(DISJ1_TAC THEN MATCH_MP_TAC COS_POS_PI2 THEN
1792 ASM_REWRITE_TAC[] THEN NO_TAC) THEN
1793 SUBST1_TAC(SYM(ASSUME “&0 = x”)) THEN
1794 REWRITE_TAC[COS_0, REAL_LT_01]
1795QED
1796
1797Theorem COS_POS_PI_LE:
1798 !x. ~(pi / &2) <= x /\ x <= (pi / &2) ==> &0 <= cos(x)
1799Proof
1800 GEN_TAC THEN REWRITE_TAC[REAL_LE_LT] THEN
1801 DISCH_THEN(CONJUNCTS_THEN DISJ_CASES_TAC) THEN
1802 ASM_REWRITE_TAC[COS_PI2] THENL
1803 [DISJ1_TAC THEN MATCH_MP_TAC COS_POS_PI THEN ASM_REWRITE_TAC[],
1804 FIRST_ASSUM(SUBST1_TAC o SYM) THEN
1805 REWRITE_TAC[COS_NEG, COS_PI2, REAL_LT_01]]
1806QED
1807
1808Theorem SIN_POS_PI2_LE:
1809 !x. &0 <= x /\ x <= (pi / &2) ==> &0 <= sin(x)
1810Proof
1811 GEN_TAC THEN REWRITE_TAC[REAL_LE_LT] THEN
1812 DISCH_THEN(CONJUNCTS_THEN DISJ_CASES_TAC) THEN
1813 ASM_REWRITE_TAC[SIN_PI2, REAL_LT_01] THENL
1814 [DISJ1_TAC THEN MATCH_MP_TAC SIN_POS_PI2 THEN ASM_REWRITE_TAC[],
1815 FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[SIN_0],
1816 MP_TAC PI2_BOUNDS THEN ASM_REWRITE_TAC[REAL_LT_REFL]]
1817QED
1818
1819Theorem SIN_POS_PI_LE:
1820 !x. &0 <= x /\ x <= pi ==> &0 <= sin(x)
1821Proof
1822 GEN_TAC THEN REWRITE_TAC[REAL_LE_LT] THEN
1823 DISCH_THEN(CONJUNCTS_THEN DISJ_CASES_TAC) THEN
1824 ASM_REWRITE_TAC[SIN_PI] THENL
1825 [DISJ1_TAC THEN MATCH_MP_TAC SIN_POS_PI THEN ASM_REWRITE_TAC[],
1826 FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[SIN_0]]
1827QED
1828
1829Theorem COS_TOTAL:
1830 !y. ~(&1) <= y /\ y <= &1 ==> ?!x. &0 <= x /\ x <= pi /\ (cos(x) = y)
1831Proof
1832 GEN_TAC THEN STRIP_TAC THEN
1833 CONV_TAC EXISTS_UNIQUE_CONV THEN CONJ_TAC THENL
1834 [MATCH_MP_TAC IVT2 THEN ASM_REWRITE_TAC[COS_0, COS_PI] THEN
1835 REWRITE_TAC[MATCH_MP REAL_LT_IMP_LE PI_POS] THEN
1836 GEN_TAC THEN DISCH_THEN(K ALL_TAC) THEN
1837 MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC “~(sin x)” THEN
1838 REWRITE_TAC[DIFF_COS],
1839 MAP_EVERY X_GEN_TAC [“x1:real”, “x2:real”] THEN STRIP_TAC THEN
1840 REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC
1841 (SPECL [“x1:real”, “x2:real”] REAL_LT_TOTAL) THENL
1842 [FIRST_ASSUM ACCEPT_TAC,
1843 MP_TAC(SPECL [“cos”, “x1:real”, “x2:real”] ROLLE),
1844 MP_TAC(SPECL [“cos”, “x2:real”, “x1:real”] ROLLE)]] THEN
1845 ASM_REWRITE_TAC[] THEN
1846 (W(C SUBGOAL_THEN (fn t => REWRITE_TAC[t]) o funpow 2
1847 (fst o dest_imp) o snd) THENL
1848 [CONJ_TAC THEN X_GEN_TAC “x:real” THEN DISCH_THEN(K ALL_TAC) THEN
1849 TRY(MATCH_MP_TAC DIFF_CONT) THEN REWRITE_TAC[differentiable] THEN
1850 EXISTS_TAC “~(sin x)” THEN REWRITE_TAC[DIFF_COS], ALL_TAC]) THEN
1851 DISCH_THEN(X_CHOOSE_THEN “x:real” STRIP_ASSUME_TAC) THEN
1852 UNDISCH_TAC “(cos diffl &0)(x)” THEN
1853 DISCH_THEN(MP_TAC o CONJ (SPEC “x:real” DIFF_COS)) THEN
1854 DISCH_THEN(MP_TAC o MATCH_MP DIFF_UNIQ) THEN
1855 REWRITE_TAC[REAL_NEG_EQ0] THEN DISCH_TAC THEN
1856 MP_TAC(SPEC “x:real” SIN_POS_PI) THEN
1857 ASM_REWRITE_TAC[REAL_LT_REFL] THEN
1858 CONV_TAC CONTRAPOS_CONV THEN DISCH_THEN(K ALL_TAC) THEN
1859 REWRITE_TAC[] THEN CONJ_TAC THENL
1860 [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC “x1:real”,
1861 MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC “x2:real”,
1862 MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC “x2:real”,
1863 MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC “x1:real”] THEN
1864 ASM_REWRITE_TAC[]
1865QED
1866
1867Theorem SIN_TOTAL:
1868 !y. ~(&1) <= y /\ y <= &1 ==>
1869 ?!x. ~(pi / &2) <= x /\ x <= pi / &2 /\ (sin(x) = y)
1870Proof
1871 GEN_TAC THEN DISCH_TAC THEN
1872 SUBGOAL_THEN “!x. ~(pi / &2) <= x /\ x <= pi / &2 /\ (sin(x) = y)
1873 <=>
1874 &0 <= (x + pi / &2) /\
1875 (x + pi / &2) <= pi /\
1876 (cos(x + pi / &2) = ~y)”
1877 (fn th => REWRITE_TAC[th]) THENL
1878 [GEN_TAC THEN REWRITE_TAC[COS_ADD, SIN_PI2, COS_PI2] THEN
1879 REWRITE_TAC[REAL_MUL_RZERO, REAL_MUL_RZERO, REAL_MUL_RID] THEN
1880 REWRITE_TAC[REAL_SUB_LZERO] THEN
1881 REWRITE_TAC[GSYM REAL_LE_SUB_RADD, GSYM REAL_LE_SUB_LADD] THEN
1882 REWRITE_TAC[REAL_SUB_LZERO] THEN AP_TERM_TAC THEN
1883 REWRITE_TAC[REAL_EQ_NEG] THEN AP_THM_TAC THEN
1884 REPEAT AP_TERM_TAC THEN
1885 GEN_REWR_TAC (RAND_CONV o LAND_CONV) [GSYM REAL_HALF_DOUBLE] THEN
1886 REWRITE_TAC[REAL_ADD_SUB], ALL_TAC] THEN
1887 MP_TAC(Q.SPEC ‘~y’ COS_TOTAL) THEN ASM_REWRITE_TAC[REAL_LE_NEG] THEN
1888 ONCE_REWRITE_TAC[GSYM REAL_LE_NEG] THEN ASM_REWRITE_TAC[REAL_NEGNEG] THEN
1889 REWRITE_TAC[REAL_LE_NEG] THEN
1890 CONV_TAC(ONCE_DEPTH_CONV EXISTS_UNIQUE_CONV) THEN
1891 DISCH_THEN(curry op THEN CONJ_TAC o MP_TAC) THENL
1892 [DISCH_THEN(X_CHOOSE_TAC “x:real” o CONJUNCT1) THEN
1893 EXISTS_TAC “x - pi / &2” THEN ASM_REWRITE_TAC[REAL_SUB_ADD],
1894 POP_ASSUM(K ALL_TAC) THEN DISCH_THEN(ASSUME_TAC o CONJUNCT2) THEN
1895 REPEAT GEN_TAC THEN
1896 DISCH_THEN(fn th => FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN
1897 REWRITE_TAC[REAL_EQ_RADD]]
1898QED
1899
1900Theorem COS_ZERO_LEMMA:
1901 !x. &0 <= x /\ (cos(x) = &0) ==>
1902 ?n. ~EVEN n /\ (x = &n * (pi / &2))
1903Proof
1904 GEN_TAC THEN STRIP_TAC THEN
1905 MP_TAC(SPEC “x:real” (MATCH_MP REAL_ARCH_LEAST PI_POS)) THEN
1906 ASM_REWRITE_TAC[] THEN
1907 DISCH_THEN(X_CHOOSE_THEN “n:num” STRIP_ASSUME_TAC) THEN
1908 SUBGOAL_THEN “&0 <= x - &n * pi /\ (x - &n * pi) <= pi /\
1909 (cos(x - &n * pi) = &0)” ASSUME_TAC THENL
1910 [ASM_REWRITE_TAC[REAL_SUB_LE] THEN
1911 REWRITE_TAC[REAL_LE_SUB_RADD] THEN
1912 REWRITE_TAC[real_sub, COS_ADD, SIN_NEG, COS_NEG, SIN_NPI, COS_NPI] THEN
1913 ASM_REWRITE_TAC[REAL_MUL_LZERO, REAL_ADD_LID] THEN
1914 REWRITE_TAC[REAL_NEG_RMUL, REAL_NEGNEG, REAL_MUL_RZERO] THEN
1915 MATCH_MP_TAC REAL_LT_IMP_LE THEN UNDISCH_TAC “x < &(SUC n) * pi” THEN
1916 REWRITE_TAC[ADD1] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN
1917 REWRITE_TAC[GSYM REAL_ADD, REAL_RDISTRIB, REAL_MUL_LID],
1918 MP_TAC(SPEC “&0” COS_TOTAL) THEN
1919 REWRITE_TAC[REAL_LE_01, REAL_NEG_LE0] THEN
1920 DISCH_THEN(MP_TAC o CONV_RULE EXISTS_UNIQUE_CONV) THEN
1921 DISCH_THEN(MP_TAC o SPECL [“x - &n * pi”, “pi / &2”] o CONJUNCT2) THEN
1922 ASM_REWRITE_TAC[COS_PI2] THEN
1923 W(C SUBGOAL_THEN MP_TAC o funpow 2 (fst o dest_imp) o snd) THENL
1924 [CONJ_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN MP_TAC PI2_BOUNDS THEN
1925 REWRITE_TAC[REAL_LT_HALF1, REAL_LT_HALF2] THEN DISCH_TAC THEN
1926 ASM_REWRITE_TAC[],
1927 DISCH_THEN(fn th => REWRITE_TAC[th])] THEN
1928 REWRITE_TAC[REAL_EQ_SUB_RADD] THEN DISCH_TAC THEN
1929 EXISTS_TAC “SUC(2 * n)” THEN REWRITE_TAC[EVEN_ODD, ODD_DOUBLE] THEN
1930 REWRITE_TAC[ADD1, GSYM REAL_ADD, GSYM REAL_MUL] THEN
1931 REWRITE_TAC[REAL_RDISTRIB, REAL_MUL_LID] THEN
1932 ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN ASM_REWRITE_TAC[] THEN
1933 AP_TERM_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
1934 REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN
1935 CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_DIV_RMUL THEN
1936 REWRITE_TAC[REAL_INJ] THEN REDUCE_TAC]
1937QED
1938
1939Theorem SIN_ZERO_LEMMA:
1940 !x. &0 <= x /\ (sin(x) = &0) ==>
1941 ?n. EVEN n /\ (x = &n * (pi / &2))
1942Proof
1943 GEN_TAC THEN DISCH_TAC THEN
1944 MP_TAC(SPEC “x + pi / &2” COS_ZERO_LEMMA) THEN
1945 W(C SUBGOAL_THEN MP_TAC o funpow 2 (fst o dest_imp) o snd) THENL
1946 [CONJ_TAC THENL
1947 [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC “x:real” THEN
1948 ASM_REWRITE_TAC[REAL_LE_ADDR] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN
1949 REWRITE_TAC[PI2_BOUNDS],
1950 ASM_REWRITE_TAC[COS_ADD, COS_PI2, REAL_MUL_LZERO, REAL_MUL_RZERO] THEN
1951 MATCH_ACCEPT_TAC REAL_SUB_REFL],
1952 DISCH_THEN(fn th => REWRITE_TAC[th])] THEN
1953 DISCH_THEN(X_CHOOSE_THEN “n:num” STRIP_ASSUME_TAC) THEN
1954 MP_TAC(SPEC “n:num” ODD_EXISTS) THEN ASM_REWRITE_TAC[ODD_EVEN] THEN
1955 DISCH_THEN(X_CHOOSE_THEN “m:num” SUBST_ALL_TAC) THEN
1956 EXISTS_TAC “2 * m:num” THEN REWRITE_TAC[EVEN_DOUBLE] THEN
1957 RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_EQ_SUB_LADD]) THEN
1958 FIRST_ASSUM SUBST1_TAC THEN
1959 REWRITE_TAC[ADD1, GSYM REAL_ADD, REAL_RDISTRIB, REAL_MUL_LID] THEN
1960 REWRITE_TAC[ONCE_REWRITE_RULE[REAL_ADD_SYM] REAL_ADD_SUB]
1961QED
1962
1963Theorem COS_ZERO:
1964 !x. (cos(x) = &0) <=> (?n. ~EVEN n /\ (x = &n * (pi / &2))) \/
1965 (?n. ~EVEN n /\ (x = ~(&n * (pi / &2))))
1966Proof
1967 GEN_TAC THEN EQ_TAC THENL
1968 [DISCH_TAC THEN DISJ_CASES_TAC (SPECL [“&0”, “x:real”] REAL_LE_TOTAL) THENL
1969 [DISJ1_TAC THEN MATCH_MP_TAC COS_ZERO_LEMMA THEN ASM_REWRITE_TAC[],
1970 DISJ2_TAC THEN REWRITE_TAC[GSYM REAL_NEG_EQ] THEN
1971 MATCH_MP_TAC COS_ZERO_LEMMA THEN ASM_REWRITE_TAC[COS_NEG] THEN
1972 ONCE_REWRITE_TAC[GSYM REAL_LE_NEG] THEN
1973 ASM_REWRITE_TAC[REAL_NEGNEG, REAL_NEG_0]],
1974 DISCH_THEN(DISJ_CASES_THEN (X_CHOOSE_TAC “n:num”)) THEN
1975 ASM_REWRITE_TAC[COS_NEG] THEN MP_TAC(SPEC “n:num” ODD_EXISTS) THEN
1976 ASM_REWRITE_TAC[ODD_EVEN] THEN DISCH_THEN(X_CHOOSE_THEN “m:num” SUBST1_TAC) THEN
1977 REWRITE_TAC[ADD1] THEN SPEC_TAC(“m:num”,“m:num”) THEN INDUCT_TAC THEN
1978 REWRITE_TAC[MULT_CLAUSES, ADD_CLAUSES, REAL_MUL_LID, COS_PI2] THEN
1979 REWRITE_TAC[GSYM ADD_ASSOC] THEN ONCE_REWRITE_TAC[GSYM REAL_ADD] THEN
1980 REWRITE_TAC[REAL_RDISTRIB] THEN REWRITE_TAC[COS_ADD] THEN
1981 REWRITE_TAC[GSYM REAL_DOUBLE, REAL_HALF_DOUBLE] THEN
1982 ASM_REWRITE_TAC[COS_PI, SIN_PI, REAL_MUL_LZERO, REAL_MUL_RZERO] THEN
1983 REWRITE_TAC[REAL_SUB_RZERO]]
1984QED
1985
1986Theorem SIN_ZERO:
1987 !x. (sin(x) = &0) <=> (?n. EVEN n /\ (x = &n * (pi / &2))) \/
1988 (?n. EVEN n /\ (x = ~(&n * (pi / &2))))
1989Proof
1990 GEN_TAC THEN EQ_TAC THENL
1991 [DISCH_TAC THEN DISJ_CASES_TAC (SPECL [“&0”, “x:real”] REAL_LE_TOTAL) THENL
1992 [DISJ1_TAC THEN MATCH_MP_TAC SIN_ZERO_LEMMA THEN ASM_REWRITE_TAC[],
1993 DISJ2_TAC THEN REWRITE_TAC[GSYM REAL_NEG_EQ] THEN
1994 MATCH_MP_TAC SIN_ZERO_LEMMA THEN
1995 ASM_REWRITE_TAC[SIN_NEG, REAL_NEG_0, REAL_NEG_GE0]],
1996 DISCH_THEN(DISJ_CASES_THEN (X_CHOOSE_TAC “n:num”)) THEN
1997 ASM_REWRITE_TAC[SIN_NEG, REAL_NEG_EQ0] THEN
1998 MP_TAC(SPEC “n:num” EVEN_EXISTS) THEN ASM_REWRITE_TAC[] THEN
1999 DISCH_THEN(X_CHOOSE_THEN “m:num” SUBST1_TAC) THEN
2000 REWRITE_TAC[GSYM REAL_MUL] THEN
2001 ONCE_REWRITE_TAC[AC(REAL_MUL_ASSOC,REAL_MUL_SYM)
2002 “(a * b) * c = b * (a * c)”] THEN
2003 REWRITE_TAC[GSYM REAL_DOUBLE, REAL_HALF_DOUBLE, SIN_NPI]]
2004QED
2005
2006(*---------------------------------------------------------------------------*)
2007(* Tangent *)
2008(*---------------------------------------------------------------------------*)
2009
2010Definition tan[nocompute]:
2011 tan(x) = sin(x) / cos(x)
2012End
2013
2014Theorem TAN_0:
2015 tan(&0) = &0
2016Proof
2017 REWRITE_TAC[tan, SIN_0, REAL_DIV_LZERO]
2018QED
2019
2020Theorem TAN_PI:
2021 tan(pi) = &0
2022Proof
2023 REWRITE_TAC[tan, SIN_PI, REAL_DIV_LZERO]
2024QED
2025
2026Theorem TAN_NPI:
2027 !n. tan(&n * pi) = &0
2028Proof
2029 GEN_TAC THEN REWRITE_TAC[tan, SIN_NPI, REAL_DIV_LZERO]
2030QED
2031
2032Theorem TAN_NEG:
2033 !x. tan(~x) = ~(tan x)
2034Proof
2035 GEN_TAC THEN REWRITE_TAC[tan, SIN_NEG, COS_NEG] THEN
2036 REWRITE_TAC[real_div, REAL_NEG_LMUL]
2037QED
2038
2039Theorem TAN_PERIODIC:
2040 !x. tan(x + &2 * pi) = tan(x)
2041Proof
2042 GEN_TAC THEN REWRITE_TAC[tan, SIN_PERIODIC, COS_PERIODIC]
2043QED
2044
2045Theorem TAN_ADD:
2046 !x y. ~(cos(x) = &0) /\ ~(cos(y) = &0) /\ ~(cos(x + y) = &0) ==>
2047 (tan(x + y) = (tan(x) + tan(y)) / (&1 - tan(x) * tan(y)))
2048Proof
2049 REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[tan] THEN
2050 MP_TAC(SPECL [“cos(x) * cos(y)”,
2051 “&1 - (sin(x) / cos(x)) * (sin(y) / cos(y))”]
2052 REAL_DIV_MUL2) THEN ASM_REWRITE_TAC[REAL_ENTIRE] THEN
2053 W(C SUBGOAL_THEN MP_TAC o funpow 2 (fst o dest_imp) o snd) THENL
2054 [DISCH_THEN(MP_TAC o AP_TERM “$* (cos(x) * cos(y))”) THEN
2055 REWRITE_TAC[real_div, REAL_SUB_LDISTRIB, GSYM REAL_MUL_ASSOC] THEN
2056 REWRITE_TAC[REAL_MUL_RID, REAL_MUL_RZERO] THEN
2057 UNDISCH_TAC “~(cos(x + y) = &0)” THEN
2058 MATCH_MP_TAC(TAUT_CONV “(a <=> b) ==> a ==> b”) THEN
2059 AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
2060 REWRITE_TAC[COS_ADD] THEN AP_TERM_TAC,
2061 DISCH_THEN(fn th => DISCH_THEN(MP_TAC o C MATCH_MP th)) THEN
2062 DISCH_THEN(fn th => ONCE_REWRITE_TAC[th]) THEN BINOP_TAC THENL
2063 [REWRITE_TAC[real_div, REAL_LDISTRIB, GSYM REAL_MUL_ASSOC] THEN
2064 REWRITE_TAC[SIN_ADD] THEN BINOP_TAC THENL
2065 [ONCE_REWRITE_TAC[AC(REAL_MUL_ASSOC,REAL_MUL_SYM)
2066 “a * (b * (c * d)) = (d * a) * (c * b)”] THEN
2067 IMP_SUBST_TAC REAL_MUL_LINV THEN ASM_REWRITE_TAC[REAL_MUL_LID],
2068 ONCE_REWRITE_TAC[AC(REAL_MUL_ASSOC,REAL_MUL_SYM)
2069 “a * (b * (c * d)) = (d * b) * (a * c)”] THEN
2070 IMP_SUBST_TAC REAL_MUL_LINV THEN ASM_REWRITE_TAC[REAL_MUL_LID]],
2071 REWRITE_TAC[COS_ADD, REAL_SUB_LDISTRIB, REAL_MUL_RID] THEN
2072 AP_TERM_TAC THEN REWRITE_TAC[real_div, GSYM REAL_MUL_ASSOC]]] THEN
2073 ONCE_REWRITE_TAC[AC(REAL_MUL_ASSOC,REAL_MUL_SYM)
2074 “a * (b * (c * (d * (e * f)))) =
2075 (f * b) * ((d * a) * (c * e))”] THEN
2076 REPEAT(IMP_SUBST_TAC REAL_MUL_LINV THEN ASM_REWRITE_TAC[]) THEN
2077 REWRITE_TAC[REAL_MUL_LID]
2078QED
2079
2080Theorem TAN_DOUBLE:
2081 !x. ~(cos(x) = &0) /\ ~(cos(&2 * x) = &0) ==>
2082 (tan(&2 * x) = (&2 * tan(x)) / (&1 - (tan(x) pow 2)))
2083Proof
2084 GEN_TAC THEN STRIP_TAC THEN
2085 MP_TAC(SPECL [“x:real”, “x:real”] TAN_ADD) THEN
2086 ASM_REWRITE_TAC[REAL_DOUBLE, POW_2]
2087QED
2088
2089Theorem TAN_POS_PI2:
2090 !x. &0 < x /\ x < pi / &2 ==> &0 < tan(x)
2091Proof
2092 GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[tan, real_div] THEN
2093 MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC THENL
2094 [MATCH_MP_TAC SIN_POS_PI2,
2095 MATCH_MP_TAC REAL_INV_POS THEN MATCH_MP_TAC COS_POS_PI2] THEN
2096 ASM_REWRITE_TAC[]
2097QED
2098
2099Theorem DIFF_TAN[difftool]:
2100 !x. ~(cos(x) = &0) ==> (tan diffl inv(cos(x) pow 2))(x)
2101Proof
2102 GEN_TAC THEN DISCH_TAC THEN MP_TAC(DIFF_CONV “\x. sin(x) / cos(x)”) THEN
2103 DISCH_THEN(MP_TAC o SPEC “x:real”) THEN ASM_REWRITE_TAC[REAL_MUL_RID] THEN
2104 REWRITE_TAC[GSYM tan, GSYM REAL_NEG_LMUL, REAL_NEGNEG, real_sub] THEN
2105 CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
2106 REWRITE_TAC[GSYM POW_2, SIN_CIRCLE, GSYM REAL_INV_1OVER]
2107QED
2108
2109Theorem TAN_TOTAL_LEMMA :
2110 !y. &0 < y ==> ?x. &0 < x /\ x < pi / &2 /\ y < tan(x)
2111Proof
2112 GEN_TAC THEN DISCH_TAC THEN
2113 SUBGOAL_THEN “((\x. cos(x) / sin(x)) -> &0) (pi / &2)”
2114 MP_TAC THENL
2115 [SUBST1_TAC(SYM(SPEC “&1” REAL_DIV_LZERO)) THEN
2116 CONV_TAC(ONCE_DEPTH_CONV HABS_CONV) THEN MATCH_MP_TAC LIM_DIV THEN
2117 REWRITE_TAC[REAL_10] THEN CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN
2118 SUBST1_TAC(SYM COS_PI2) THEN SUBST1_TAC(SYM SIN_PI2) THEN
2119 REWRITE_TAC[GSYM CONTL_LIM] THEN CONJ_TAC THEN MATCH_MP_TAC DIFF_CONT THENL
2120 [EXISTS_TAC “~(sin(pi / &2))”,
2121 EXISTS_TAC “cos(pi / &2)”] THEN
2122 REWRITE_TAC[DIFF_SIN, DIFF_COS], ALL_TAC] THEN
2123 REWRITE_TAC[LIM] THEN DISCH_THEN(MP_TAC o SPEC “inv(y)”) THEN
2124 FIRST_ASSUM(fn th => REWRITE_TAC[MATCH_MP REAL_INV_POS th]) THEN
2125 BETA_TAC THEN REWRITE_TAC[REAL_SUB_RZERO] THEN
2126 DISCH_THEN(X_CHOOSE_THEN “d:real” STRIP_ASSUME_TAC) THEN
2127 MP_TAC(SPECL [“d:real”, “pi / &2”] REAL_DOWN2) THEN
2128 ASM_REWRITE_TAC[PI2_BOUNDS] THEN
2129 DISCH_THEN(X_CHOOSE_THEN “e:real” STRIP_ASSUME_TAC) THEN
2130 EXISTS_TAC “(pi / &2) - e” THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN
2131 CONJ_TAC THENL
2132 [REWRITE_TAC[real_sub, GSYM REAL_NOT_LE, REAL_LE_ADDR, REAL_NEG_GE0] THEN
2133 ASM_REWRITE_TAC[REAL_NOT_LE], ALL_TAC] THEN
2134 FIRST_ASSUM(UNDISCH_TAC o assert is_forall o concl) THEN
2135 DISCH_THEN(MP_TAC o SPEC “(pi / &2) - e”) THEN
2136 REWRITE_TAC[REAL_SUB_SUB, ABS_NEG] THEN
2137 SUBGOAL_THEN “abs(e) = e” (fn th => ASM_REWRITE_TAC[th]) THENL
2138 [REWRITE_TAC[ABS_REFL] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN
2139 FIRST_ASSUM ACCEPT_TAC, ALL_TAC] THEN
2140 SUBGOAL_THEN “&0 < cos((pi / &2) - e) / sin((pi / &2) - e)”
2141 MP_TAC THENL
2142 [ONCE_REWRITE_TAC[real_div] THEN
2143 MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC THENL
2144 [MATCH_MP_TAC COS_POS_PI2,
2145 MATCH_MP_TAC REAL_INV_POS THEN MATCH_MP_TAC SIN_POS_PI2] THEN
2146 ASM_REWRITE_TAC[REAL_SUB_LT] THEN
2147 REWRITE_TAC[GSYM REAL_NOT_LE, real_sub, REAL_LE_ADDR, REAL_NEG_GE0] THEN
2148 ASM_REWRITE_TAC[REAL_NOT_LE], ALL_TAC] THEN
2149 DISCH_THEN(fn th => ASSUME_TAC th THEN MP_TAC(MATCH_MP REAL_POS_NZ th)) THEN
2150 REWRITE_TAC[ABS_NZ, TAUT_CONV “a ==> b ==> c <=> a /\ b ==> c”] THEN
2151 DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_INV) THEN REWRITE_TAC[tan] THEN
2152 MATCH_MP_TAC (TAUT_CONV “(a <=> b) ==> a ==> b”) THEN BINOP_TAC THENL
2153 [MATCH_MP_TAC REAL_INVINV THEN MATCH_MP_TAC REAL_POS_NZ THEN
2154 FIRST_ASSUM ACCEPT_TAC, ALL_TAC] THEN
2155 MP_TAC(ASSUME“&0 < cos((pi / &2) - e) / sin((pi / &2) - e)”) THEN
2156 DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_IMP_LE) THEN
2157 REWRITE_TAC[GSYM ABS_REFL] THEN DISCH_THEN SUBST1_TAC THEN
2158 REWRITE_TAC[real_div] THEN IMP_SUBST_TAC REAL_INV_MUL THENL
2159 [REWRITE_TAC[GSYM DE_MORGAN_THM, GSYM REAL_ENTIRE, GSYM real_div] THEN
2160 MATCH_MP_TAC REAL_POS_NZ THEN FIRST_ASSUM ACCEPT_TAC,
2161 GEN_REWR_TAC RAND_CONV [REAL_MUL_SYM] THEN AP_TERM_TAC THEN
2162 MATCH_MP_TAC REAL_INVINV THEN MATCH_MP_TAC REAL_POS_NZ THEN
2163 MATCH_MP_TAC SIN_POS_PI2 THEN REWRITE_TAC[REAL_SUB_LT, GSYM real_div] THEN
2164 REWRITE_TAC[GSYM REAL_NOT_LE, real_sub, REAL_LE_ADDR, REAL_NEG_GE0] THEN
2165 ASM_REWRITE_TAC[REAL_NOT_LE]]
2166QED
2167
2168Theorem TAN_TOTAL_POS:
2169 !y. &0 <= y ==> ?x. &0 <= x /\ x < pi / &2 /\ (tan(x) = y)
2170Proof
2171 GEN_TAC THEN DISCH_THEN(DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT]) THENL
2172 [FIRST_ASSUM(MP_TAC o MATCH_MP TAN_TOTAL_LEMMA) THEN
2173 DISCH_THEN(X_CHOOSE_THEN “x:real” STRIP_ASSUME_TAC) THEN
2174 MP_TAC(SPECL [“tan”, “&0”, “x:real”, “y:real”] IVT) THEN
2175 W(C SUBGOAL_THEN (fn th => DISCH_THEN(MP_TAC o C MATCH_MP th)) o
2176 funpow 2 (fst o dest_imp) o snd) THENL
2177 [REPEAT CONJ_TAC THEN TRY(MATCH_MP_TAC REAL_LT_IMP_LE) THEN
2178 ASM_REWRITE_TAC[TAN_0] THEN X_GEN_TAC “z:real” THEN STRIP_TAC THEN
2179 MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC “inv(cos(z) pow 2)” THEN
2180 MATCH_MP_TAC DIFF_TAN THEN UNDISCH_TAC “&0 <= z” THEN
2181 REWRITE_TAC[REAL_LE_LT] THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL
2182 [DISCH_TAC THEN MATCH_MP_TAC REAL_POS_NZ THEN
2183 MATCH_MP_TAC COS_POS_PI2 THEN ASM_REWRITE_TAC[] THEN
2184 MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC “x:real” THEN
2185 ASM_REWRITE_TAC[],
2186 DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[COS_0, REAL_10]],
2187 DISCH_THEN(X_CHOOSE_THEN “z:real” STRIP_ASSUME_TAC) THEN
2188 EXISTS_TAC “z:real” THEN ASM_REWRITE_TAC[] THEN
2189 MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC “x:real” THEN
2190 ASM_REWRITE_TAC[]],
2191 POP_ASSUM(SUBST1_TAC o SYM) THEN EXISTS_TAC “&0” THEN
2192 REWRITE_TAC[TAN_0, REAL_LE_REFL, PI2_BOUNDS]]
2193QED
2194
2195Theorem TAN_TOTAL:
2196 !y. ?!x. ~(pi / &2) < x /\ x < (pi / &2) /\ (tan(x) = y)
2197Proof
2198 GEN_TAC THEN CONV_TAC EXISTS_UNIQUE_CONV THEN CONJ_TAC THENL
2199 [DISJ_CASES_TAC(SPEC “y:real” REAL_LE_NEGTOTAL) THEN
2200 POP_ASSUM(X_CHOOSE_TAC “x:real” o MATCH_MP TAN_TOTAL_POS) THENL
2201 [EXISTS_TAC “x:real” THEN ASM_REWRITE_TAC[] THEN
2202 MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC “&0” THEN
2203 ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM REAL_LT_NEG] THEN
2204 REWRITE_TAC[REAL_NEGNEG, REAL_NEG_0, PI2_BOUNDS],
2205 Q.EXISTS_TAC ‘~x’ THEN ASM_REWRITE_TAC[REAL_LT_NEG] THEN
2206 ASM_REWRITE_TAC[TAN_NEG, REAL_NEG_EQ, REAL_NEGNEG] THEN
2207 ONCE_REWRITE_TAC[GSYM REAL_LT_NEG] THEN
2208 REWRITE_TAC[REAL_LT_NEG] THEN MATCH_MP_TAC REAL_LET_TRANS THEN
2209 EXISTS_TAC “x:real” THEN ASM_REWRITE_TAC[REAL_LE_NEGL]],
2210 MAP_EVERY X_GEN_TAC [“x1:real”, “x2:real”] THEN
2211 REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC
2212 (SPECL [“x1:real”, “x2:real”] REAL_LT_TOTAL) THENL
2213 [DISCH_THEN(K ALL_TAC) THEN POP_ASSUM ACCEPT_TAC,
2214 ALL_TAC,
2215 POP_ASSUM MP_TAC THEN SPEC_TAC(“x1:real”,“z1:real”) THEN
2216 SPEC_TAC(“x2:real”,“z2:real”) THEN
2217 MAP_EVERY X_GEN_TAC [“x1:real”, “x2:real”] THEN DISCH_TAC THEN
2218 CONV_TAC(RAND_CONV SYM_CONV) THEN ONCE_REWRITE_TAC[CONJ_SYM]] THEN
2219 (STRIP_TAC THEN MP_TAC(SPECL [“tan”, “x1:real”, “x2:real”] ROLLE) THEN
2220 ASM_REWRITE_TAC[] THEN CONV_TAC CONTRAPOS_CONV THEN
2221 DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[NOT_IMP] THEN
2222 REPEAT CONJ_TAC THENL
2223 [X_GEN_TAC “x:real” THEN STRIP_TAC THEN MATCH_MP_TAC DIFF_CONT THEN
2224 EXISTS_TAC “inv(cos(x) pow 2)” THEN MATCH_MP_TAC DIFF_TAN,
2225 X_GEN_TAC “x:real” THEN
2226 DISCH_THEN(CONJUNCTS_THEN (ASSUME_TAC o MATCH_MP REAL_LT_IMP_LE)) THEN
2227 REWRITE_TAC[differentiable] THEN EXISTS_TAC “inv(cos(x) pow 2)” THEN
2228 MATCH_MP_TAC DIFF_TAN,
2229 REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(X_CHOOSE_THEN “x:real”
2230 (CONJUNCTS_THEN2 (CONJUNCTS_THEN (ASSUME_TAC o MATCH_MP
2231 REAL_LT_IMP_LE)) ASSUME_TAC)) THEN
2232 MP_TAC(SPEC “x:real” DIFF_TAN) THEN
2233 SUBGOAL_THEN “~(cos(x) = &0)” ASSUME_TAC THENL
2234 [ALL_TAC,
2235 ASM_REWRITE_TAC[] THEN
2236 DISCH_THEN(MP_TAC o C CONJ (ASSUME “(tan diffl &0)(x)”)) THEN
2237 DISCH_THEN(MP_TAC o MATCH_MP DIFF_UNIQ) THEN REWRITE_TAC[] THEN
2238 MATCH_MP_TAC REAL_INV_NZ THEN MATCH_MP_TAC POW_NZ THEN
2239 ASM_REWRITE_TAC[]]] THEN
2240 (MATCH_MP_TAC REAL_POS_NZ THEN MATCH_MP_TAC COS_POS_PI THEN
2241 CONJ_TAC THENL
2242 [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC “x1:real”,
2243 MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC “x2:real”] THEN
2244 ASM_REWRITE_TAC[]))]
2245QED
2246
2247(*---------------------------------------------------------------------------*)
2248(* Inverse trig functions *)
2249(*---------------------------------------------------------------------------*)
2250
2251Definition asn[nocompute]:
2252 asn(y) = @x. ~(pi / &2) <= x /\ x <= pi / &2 /\ (sin x = y)
2253End
2254
2255Definition acs[nocompute]:
2256 acs(y) = @x. &0 <= x /\ x <= pi /\ (cos x = y)
2257End
2258
2259Definition atn[nocompute]:
2260 atn(y) = @x. ~(pi / &2) < x /\ x < pi / &2 /\ (tan x = y)
2261End
2262
2263Theorem ASN:
2264 !y. ~(&1) <= y /\ y <= &1 ==>
2265 ~(pi / &2) <= asn(y) /\ (asn(y) <= pi / &2 /\ (sin(asn y) = y))
2266Proof
2267 GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP SIN_TOTAL) THEN
2268 DISCH_THEN(MP_TAC o CONJUNCT1 o CONV_RULE EXISTS_UNIQUE_CONV) THEN
2269 DISCH_THEN(MP_TAC o SELECT_RULE) THEN REWRITE_TAC[GSYM asn]
2270QED
2271
2272Theorem ASN_SIN:
2273 !y. ~(&1) <= y /\ y <= &1 ==> (sin(asn(y)) = y)
2274Proof
2275 GEN_TAC THEN DISCH_THEN(fn th => REWRITE_TAC[MATCH_MP ASN th])
2276QED
2277
2278Theorem ASN_BOUNDS:
2279 !y. ~(&1) <= y /\ y <= &1
2280 ==> ~(pi / &2) <= asn(y) /\ asn(y) <= pi / &2
2281Proof
2282GEN_TAC THEN DISCH_THEN(fn th => REWRITE_TAC[MATCH_MP ASN th])
2283QED
2284
2285Theorem ASN_BOUNDS_LT:
2286 !y. ~(&1) < y /\ y < &1 ==> ~(pi / &2) < asn(y) /\ asn(y) < pi / &2
2287Proof
2288 GEN_TAC THEN STRIP_TAC THEN
2289 SUBGOAL_THEN “~(pi / &2) <= asn(y) /\ asn(y) <= pi / &2” ASSUME_TAC THENL
2290 [MATCH_MP_TAC ASN_BOUNDS THEN CONJ_TAC THEN
2291 MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[],
2292 ASM_REWRITE_TAC[REAL_LT_LE]] THEN
2293 CONJ_TAC THEN DISCH_THEN(MP_TAC o AP_TERM “sin”) THEN
2294 REWRITE_TAC[SIN_NEG, SIN_PI2] THEN MATCH_MP_TAC REAL_LT_IMP_NE THEN
2295 SUBGOAL_THEN “sin(asn y) = y” (fn th => ASM_REWRITE_TAC[th]) THEN
2296 MATCH_MP_TAC ASN_SIN THEN CONJ_TAC THEN
2297 MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]
2298QED
2299
2300Theorem SIN_ASN:
2301 !x. ~(pi / &2) <= x /\ x <= pi / &2 ==> (asn(sin(x)) = x)
2302Proof
2303 GEN_TAC THEN DISCH_TAC THEN
2304 MP_TAC(MATCH_MP SIN_TOTAL (SPEC “x:real” SIN_BOUNDS)) THEN
2305 DISCH_THEN(MATCH_MP_TAC o CONJUNCT2 o CONV_RULE EXISTS_UNIQUE_CONV) THEN
2306 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ASN THEN
2307 MATCH_ACCEPT_TAC SIN_BOUNDS
2308QED
2309
2310Theorem ACS:
2311 !y. ~(&1) <= y /\ y <= &1 ==>
2312 &0 <= acs(y) /\ acs(y) <= pi /\ (cos(acs y) = y)
2313Proof
2314 GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP COS_TOTAL) THEN
2315 DISCH_THEN(MP_TAC o CONJUNCT1 o CONV_RULE EXISTS_UNIQUE_CONV) THEN
2316 DISCH_THEN(MP_TAC o SELECT_RULE) THEN REWRITE_TAC[GSYM acs]
2317QED
2318
2319Theorem ACS_COS:
2320 !y. ~(&1) <= y /\ y <= &1 ==> (cos(acs(y)) = y)
2321Proof
2322 GEN_TAC THEN DISCH_THEN(fn th => REWRITE_TAC[MATCH_MP ACS th])
2323QED
2324
2325Theorem ACS_BOUNDS:
2326 !y. ~(&1) <= y /\ y <= &1 ==> &0 <= acs(y) /\ acs(y) <= pi
2327Proof
2328 GEN_TAC THEN DISCH_THEN(fn th => REWRITE_TAC[MATCH_MP ACS th])
2329QED
2330
2331Theorem ACS_BOUNDS_LT:
2332 !y. ~(&1) < y /\ y < &1 ==> &0 < acs(y) /\ acs(y) < pi
2333Proof
2334 GEN_TAC THEN STRIP_TAC THEN
2335 SUBGOAL_THEN “&0 <= acs(y) /\ acs(y) <= pi” ASSUME_TAC THENL
2336 [MATCH_MP_TAC ACS_BOUNDS THEN CONJ_TAC THEN
2337 MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[],
2338 ASM_REWRITE_TAC[REAL_LT_LE]] THEN
2339 CONJ_TAC THEN DISCH_THEN(MP_TAC o AP_TERM “cos”) THEN
2340 REWRITE_TAC[COS_0, COS_PI] THEN
2341 CONV_TAC(RAND_CONV SYM_CONV) THEN
2342 MATCH_MP_TAC REAL_LT_IMP_NE THEN
2343 SUBGOAL_THEN “cos(acs y) = y” (fn th => ASM_REWRITE_TAC[th]) THEN
2344 MATCH_MP_TAC ACS_COS THEN CONJ_TAC THEN
2345 MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]
2346QED
2347
2348Theorem COS_ACS:
2349 !x. &0 <= x /\ x <= pi ==> (acs(cos(x)) = x)
2350Proof
2351 GEN_TAC THEN DISCH_TAC THEN
2352 MP_TAC(MATCH_MP COS_TOTAL (SPEC “x:real” COS_BOUNDS)) THEN
2353 DISCH_THEN(MATCH_MP_TAC o CONJUNCT2 o CONV_RULE EXISTS_UNIQUE_CONV) THEN
2354 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ACS THEN
2355 MATCH_ACCEPT_TAC COS_BOUNDS
2356QED
2357
2358Theorem ATN:
2359 !y. ~(pi / &2) < atn(y) /\ atn(y) < (pi / &2) /\ (tan(atn y) = y)
2360Proof
2361 GEN_TAC THEN MP_TAC(SPEC “y:real” TAN_TOTAL) THEN
2362 DISCH_THEN(MP_TAC o CONJUNCT1 o CONV_RULE EXISTS_UNIQUE_CONV) THEN
2363 DISCH_THEN(MP_TAC o SELECT_RULE) THEN REWRITE_TAC[GSYM atn]
2364QED
2365
2366Theorem ATN_TAN:
2367 !y. tan(atn y) = y
2368Proof
2369 REWRITE_TAC[ATN]
2370QED
2371
2372Theorem ATN_BOUNDS:
2373 !y. ~(pi / &2) < atn(y) /\ atn(y) < (pi / &2)
2374Proof
2375 REWRITE_TAC[ATN]
2376QED
2377
2378Theorem TAN_ATN:
2379 !x. ~(pi / &2) < x /\ x < (pi / &2) ==> (atn(tan(x)) = x)
2380Proof
2381 GEN_TAC THEN DISCH_TAC THEN MP_TAC(SPEC “tan(x)” TAN_TOTAL) THEN
2382 DISCH_THEN(MATCH_MP_TAC o CONJUNCT2 o CONV_RULE EXISTS_UNIQUE_CONV) THEN
2383 ASM_REWRITE_TAC[ATN]
2384QED
2385
2386(*---------------------------------------------------------------------------*)
2387(* A few additional results about the trig functions *)
2388(*---------------------------------------------------------------------------*)
2389
2390Theorem TAN_SEC:
2391 !x. ~(cos(x) = &0) ==> (&1 + (tan(x) pow 2) = inv(cos x) pow 2)
2392Proof
2393 GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[tan] THEN
2394 FIRST_ASSUM(fn th => ONCE_REWRITE_TAC[GSYM
2395 (MATCH_MP REAL_DIV_REFL (SPEC “2:num” (MATCH_MP POW_NZ th)))]) THEN
2396 REWRITE_TAC[real_div, POW_MUL] THEN
2397 POP_ASSUM(fn th => REWRITE_TAC[MATCH_MP POW_INV th]) THEN
2398 ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
2399 REWRITE_TAC[GSYM REAL_RDISTRIB, SIN_CIRCLE, REAL_MUL_LID]
2400QED
2401
2402Theorem SIN_COS_SQ:
2403 !x. &0 <= x /\ x <= pi ==> (sin(x) = sqrt(&1 - (cos(x) pow 2)))
2404Proof
2405 GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC SQRT_EQ THEN
2406 REWRITE_TAC[REAL_EQ_SUB_LADD, SIN_CIRCLE] THEN
2407 MATCH_MP_TAC SIN_POS_PI_LE THEN ASM_REWRITE_TAC[]
2408QED
2409
2410Theorem COS_SIN_SQ:
2411 !x. ~(pi / &2) <= x /\ x <= (pi / &2) ==>
2412 (cos(x) = sqrt(&1 - (sin(x) pow 2)))
2413Proof
2414 GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC SQRT_EQ THEN
2415 REWRITE_TAC[REAL_EQ_SUB_LADD] THEN
2416 ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
2417 REWRITE_TAC[SIN_CIRCLE] THEN
2418 MATCH_MP_TAC COS_POS_PI_LE THEN ASM_REWRITE_TAC[]
2419QED
2420
2421Theorem COS_ATN_NZ:
2422 !x. ~(cos(atn(x)) = &0)
2423Proof
2424 GEN_TAC THEN MATCH_MP_TAC REAL_POS_NZ THEN
2425 MATCH_MP_TAC COS_POS_PI THEN MATCH_ACCEPT_TAC ATN_BOUNDS
2426QED
2427
2428Theorem COS_ASN_NZ:
2429 !x. ~(&1) < x /\ x < &1 ==> ~(cos(asn(x)) = &0)
2430Proof
2431 GEN_TAC THEN DISCH_TAC THEN
2432 MAP_EVERY MATCH_MP_TAC [REAL_POS_NZ, COS_POS_PI, ASN_BOUNDS_LT] THEN
2433 POP_ASSUM ACCEPT_TAC
2434QED
2435
2436Theorem SIN_ACS_NZ:
2437 !x. ~(&1) < x /\ x < &1 ==> ~(sin(acs(x)) = &0)
2438Proof
2439 GEN_TAC THEN DISCH_TAC THEN
2440 MAP_EVERY MATCH_MP_TAC [REAL_POS_NZ, SIN_POS_PI, ACS_BOUNDS_LT] THEN
2441 POP_ASSUM ACCEPT_TAC
2442QED
2443
2444Theorem COS_SIN_SQRT:
2445 !x. &0 <= cos(x) ==> (cos(x) = sqrt(&1 - (sin(x) pow 2)))
2446Proof
2447 GEN_TAC THEN DISCH_TAC THEN
2448 MP_TAC (ONCE_REWRITE_RULE[REAL_ADD_SYM] (SPEC (Term`x:real`) SIN_CIRCLE))
2449 THEN REWRITE_TAC[GSYM REAL_EQ_SUB_LADD] THEN
2450 DISCH_THEN(SUBST1_TAC o SYM) THEN
2451 REWRITE_TAC[sqrt, TWO] THEN
2452 CONV_TAC SYM_CONV THEN MATCH_MP_TAC POW_ROOT_POS THEN
2453 ASM_REWRITE_TAC[]
2454QED
2455
2456Theorem SIN_COS_SQRT:
2457 !x. &0 <= sin(x) ==> (sin(x) = sqrt(&1 - (cos(x) pow 2)))
2458Proof
2459 GEN_TAC THEN DISCH_TAC THEN
2460 MP_TAC (SPEC (Term`x:real`) SIN_CIRCLE) THEN
2461 REWRITE_TAC[GSYM REAL_EQ_SUB_LADD] THEN
2462 DISCH_THEN(SUBST1_TAC o SYM) THEN
2463 REWRITE_TAC[sqrt, TWO] THEN
2464 CONV_TAC SYM_CONV THEN MATCH_MP_TAC POW_ROOT_POS THEN
2465 ASM_REWRITE_TAC[]
2466QED
2467
2468
2469(*---------------------------------------------------------------------------*)
2470(* Derivatives of the inverse functions, starting with natural log *)
2471(*---------------------------------------------------------------------------*)
2472
2473(* Known as DIFF_ASN_COS in GTT *)
2474Theorem DIFF_ASN_LEMMA:
2475 !x. ~(&1) < x /\ x < &1 ==> (asn diffl (inv(cos(asn x))))(x)
2476Proof
2477 GEN_TAC THEN STRIP_TAC THEN IMP_RES_TAC REAL_LT_IMP_LE THEN
2478 MP_TAC(SPEC “x:real” ASN_SIN) THEN ASM_REWRITE_TAC[] THEN
2479 DISCH_THEN(fn th => GEN_REWR_TAC RAND_CONV [SYM th]) THEN
2480 MATCH_MP_TAC DIFF_INVERSE_OPEN THEN REWRITE_TAC[DIFF_SIN] THEN
2481 MAP_EVERY EXISTS_TAC [“~(pi / &2)”, “pi / &2”] THEN
2482 MP_TAC(SPEC “x:real” ASN_BOUNDS_LT) THEN ASM_REWRITE_TAC[] THEN
2483 DISCH_THEN(fn th => REWRITE_TAC[th]) THEN CONJ_TAC THENL
2484 [GEN_TAC THEN STRIP_TAC THEN IMP_RES_TAC REAL_LT_IMP_LE THEN
2485 REWRITE_TAC[MATCH_MP DIFF_CONT (SPEC_ALL DIFF_SIN)] THEN
2486 MATCH_MP_TAC SIN_ASN THEN ASM_REWRITE_TAC[],
2487 MATCH_MP_TAC COS_ASN_NZ THEN ASM_REWRITE_TAC[]]
2488QED
2489
2490Theorem DIFF_ASN[difftool]:
2491 !x. ~(&1) < x /\ x < &1 ==> (asn diffl (inv(sqrt(&1 - (x pow 2)))))(x)
2492Proof
2493 GEN_TAC THEN DISCH_TAC THEN
2494 FIRST_ASSUM(MP_TAC o MATCH_MP DIFF_ASN_LEMMA) THEN
2495 MATCH_MP_TAC(TAUT_CONV “(a <=> b) ==> a ==> b”) THEN
2496 AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
2497 SUBGOAL_THEN “cos(asn(x)) = sqrt(&1 - (sin(asn x) pow 2))” SUBST1_TAC THENL
2498 [MATCH_MP_TAC COS_SIN_SQ THEN MATCH_MP_TAC ASN_BOUNDS,
2499 SUBGOAL_THEN “sin(asn x) = x” SUBST1_TAC THEN REWRITE_TAC[] THEN
2500 MATCH_MP_TAC ASN_SIN] THEN
2501 CONJ_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]
2502QED
2503
2504(* Known as DIFF_ACS_SIN in GTT *)
2505Theorem DIFF_ACS_LEMMA:
2506 !x. ~(&1) < x /\ x < &1 ==> (acs diffl inv(~(sin(acs x))))(x)
2507Proof
2508 GEN_TAC THEN STRIP_TAC THEN IMP_RES_TAC REAL_LT_IMP_LE THEN
2509 MP_TAC(SPEC “x:real” ACS_COS) THEN ASM_REWRITE_TAC[] THEN
2510 DISCH_THEN(fn th => GEN_REWR_TAC RAND_CONV [SYM th]) THEN
2511 MATCH_MP_TAC DIFF_INVERSE_OPEN THEN REWRITE_TAC[DIFF_COS] THEN
2512 MAP_EVERY EXISTS_TAC [“&0”, “pi”] THEN
2513 MP_TAC(SPEC “x:real” ACS_BOUNDS_LT) THEN ASM_REWRITE_TAC[] THEN
2514 DISCH_THEN(fn th => REWRITE_TAC[th]) THEN CONJ_TAC THENL
2515 [GEN_TAC THEN STRIP_TAC THEN IMP_RES_TAC REAL_LT_IMP_LE THEN
2516 REWRITE_TAC[MATCH_MP DIFF_CONT (SPEC_ALL DIFF_COS)] THEN
2517 MATCH_MP_TAC COS_ACS THEN ASM_REWRITE_TAC[],
2518 REWRITE_TAC[REAL_NEG_EQ, REAL_NEG_0] THEN
2519 MATCH_MP_TAC SIN_ACS_NZ THEN ASM_REWRITE_TAC[]]
2520QED
2521
2522Theorem DIFF_ACS[difftool]:
2523 !x. ~(&1) < x /\ x < &1 ==> (acs diffl ~(inv(sqrt(&1 - (x pow 2)))))(x)
2524Proof
2525 GEN_TAC THEN DISCH_TAC THEN
2526 FIRST_ASSUM(MP_TAC o MATCH_MP DIFF_ACS_LEMMA) THEN
2527 MATCH_MP_TAC(TAUT_CONV “(a <=> b) ==> a ==> b”) THEN
2528 AP_THM_TAC THEN AP_TERM_TAC THEN
2529 SUBGOAL_THEN “sin(acs(x)) = sqrt(&1 - (cos(acs x) pow 2))” SUBST1_TAC THENL
2530 [MATCH_MP_TAC SIN_COS_SQ THEN MATCH_MP_TAC ACS_BOUNDS,
2531 SUBGOAL_THEN “cos(acs x) = x” SUBST1_TAC THENL
2532 [MATCH_MP_TAC ACS_COS,
2533 CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_NEG_INV THEN
2534 MATCH_MP_TAC REAL_POS_NZ THEN REWRITE_TAC[sqrt, TWO] THEN
2535 MATCH_MP_TAC ROOT_POS_LT THEN
2536 REWRITE_TAC[REAL_LT_SUB_LADD, REAL_ADD_LID] THEN
2537 REWRITE_TAC[SYM(TWO), POW_2] THEN
2538 GEN_REWR_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN
2539 DISJ_CASES_TAC (SPEC “x:real” REAL_LE_NEGTOTAL) THENL
2540 [ALL_TAC, GEN_REWR_TAC LAND_CONV [GSYM REAL_NEG_MUL2]] THEN
2541 MATCH_MP_TAC REAL_LT_MUL2 THEN ASM_REWRITE_TAC[] THEN
2542 ONCE_REWRITE_TAC [GSYM REAL_LT_NEG] THEN
2543 ASM_REWRITE_TAC[REAL_NEGNEG]]] THEN
2544 CONJ_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]
2545QED
2546
2547Theorem DIFF_ATN[difftool]:
2548 !x. (atn diffl (inv(&1 + (x pow 2))))(x)
2549Proof
2550 GEN_TAC THEN
2551 SUBGOAL_THEN “(atn diffl (inv(&1 + (x pow 2))))(tan(atn x))” MP_TAC THENL
2552 [MATCH_MP_TAC DIFF_INVERSE_OPEN, REWRITE_TAC[ATN_TAN]] THEN
2553 MAP_EVERY EXISTS_TAC [“~(pi / &2)”, “pi / &2”] THEN
2554 REWRITE_TAC[ATN_BOUNDS] THEN REPEAT CONJ_TAC THENL
2555 [X_GEN_TAC “x:real” THEN DISCH_TAC THEN
2556 FIRST_ASSUM(fn th => REWRITE_TAC[MATCH_MP TAN_ATN th]) THEN
2557 MATCH_MP_TAC DIFF_CONT THEN
2558 EXISTS_TAC “inv(cos(x) pow 2)” THEN
2559 MATCH_MP_TAC DIFF_TAN THEN
2560 MATCH_MP_TAC REAL_POS_NZ THEN MATCH_MP_TAC COS_POS_PI THEN
2561 ASM_REWRITE_TAC[],
2562 MP_TAC(SPEC “atn(x)” DIFF_TAN) THEN REWRITE_TAC[COS_ATN_NZ] THEN
2563 REWRITE_TAC[MATCH_MP POW_INV (SPEC “x:real” COS_ATN_NZ)] THEN
2564 REWRITE_TAC[GSYM(MATCH_MP TAN_SEC (SPEC “x:real” COS_ATN_NZ))] THEN
2565 REWRITE_TAC[ATN_TAN],
2566 MATCH_MP_TAC REAL_POS_NZ THEN
2567 MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC “&1” THEN
2568 REWRITE_TAC[REAL_LT_01, REAL_LE_ADDR, POW_2, REAL_LE_SQUARE]]
2569QED
2570
2571(* ------------------------------------------------------------------------ *)
2572(* SYM_CANON_CONV - Canonicalizes single application of symmetric operator *)
2573(* Rewrites `so as to make fn true`, e.g. fn = (<<) or fn = curry(=) `1` o fst*)
2574(* ------------------------------------------------------------------------ *)
2575
2576fun SYM_CANON_CONV sym f =
2577 REWR_CONV sym o assert
2578 (not o f o ((snd o dest_comb) ## I) o dest_comb);;
2579
2580(* ----------------------------------------------------------- *)
2581(* EXT_CONV `!x. f x = g x` = |- (!x. f x = g x) = (f = g) *)
2582(* ----------------------------------------------------------- *)
2583
2584val EXT_CONV = SYM o uncurry X_FUN_EQ_CONV o
2585 (I ## (mk_eq o (rator ## rator) o dest_eq)) o dest_forall;;
2586
2587(* ======================================================================== *)
2588(* Mclaurin's theorem with Lagrange form of remainder *)
2589(* We could weaken the hypotheses slightly, but it's not worth it *)
2590(* ======================================================================== *)
2591
2592val _ = Parse.hide "B";
2593
2594Theorem MCLAURIN :
2595 !f diff h n.
2596 &0 < h /\ 0 < n /\ (diff(0) = f) /\
2597 (!m t. m < n /\ &0 <= t /\ t <= h ==>
2598 (diff(m) diffl diff(SUC m)(t))(t)) ==>
2599 (?t. &0 < t /\ t < h /\
2600 (f(h) = sum(0,n)(\m. (diff(m)(&0) / &(FACT m)) * (h pow m))
2601 +
2602 ((diff(n)(t) / &(FACT n)) * (h pow n))))
2603Proof
2604 REPEAT GEN_TAC THEN STRIP_TAC THEN
2605 UNDISCH_TAC (Term`0 < n:num`) THEN
2606 DISJ_CASES_THEN2 SUBST_ALL_TAC (X_CHOOSE_THEN (Term`r:num`) MP_TAC)
2607 (SPEC (Term`n:num`) num_CASES) THEN REWRITE_TAC[LESS_REFL] THEN
2608 DISCH_THEN(ASSUME_TAC o SYM) THEN DISCH_THEN(K ALL_TAC) THEN
2609 SUBGOAL_THEN
2610 (Term`?B. f(h) = sum(0,n)
2611 (\m. (diff(m)(&0) / &(FACT m)) * (h pow m))
2612 + (B * ((h pow n) / &(FACT n)))`) MP_TAC THENL
2613 [ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
2614 ONCE_REWRITE_TAC[GSYM REAL_EQ_SUB_RADD] THEN
2615 EXISTS_TAC (Term
2616 `(f h - sum(0,n) (\m. (diff(m)(&0) / &(FACT m)) * (h pow m)))
2617 * &(FACT n) / (h pow n)`) THEN REWRITE_TAC[real_div] THEN
2618 REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN
2619 GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) empty_rewrites [GSYM REAL_MUL_RID] THEN
2620 AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN
2621 ONCE_REWRITE_TAC[AC (REAL_MUL_ASSOC,REAL_MUL_SYM)
2622 (Term`a * (b * (c * d)) = (d * a) * (b * c)`)] THEN
2623 GEN_REWRITE_TAC RAND_CONV empty_rewrites [GSYM REAL_MUL_LID] THEN BINOP_TAC THEN
2624 MATCH_MP_TAC REAL_MUL_LINV THENL
2625 [MATCH_MP_TAC REAL_POS_NZ THEN REWRITE_TAC[REAL_LT, FACT_LESS],
2626 MATCH_MP_TAC POW_NZ THEN MATCH_MP_TAC REAL_POS_NZ THEN
2627 ASM_REWRITE_TAC[]], ALL_TAC] THEN
2628 DISCH_THEN(X_CHOOSE_THEN (Term`B:real`) (ASSUME_TAC o SYM)) THEN
2629 ABBREV_TAC (Term`g =
2630 \t. f(t) - (sum(0,n)(\m. (diff(m)(&0) / &(FACT m)) * (t pow m))
2631 + (B * ((t pow n) / &(FACT n))))`) THEN
2632 SUBGOAL_THEN (Term`(g(&0) = &0) /\ (g(h) = &0)`) ASSUME_TAC THENL
2633 [EXPAND_TAC "g" THEN BETA_TAC THEN ASM_REWRITE_TAC[REAL_SUB_REFL] THEN
2634 EXPAND_TAC "n" THEN REWRITE_TAC[POW_0, REAL_DIV_LZERO] THEN
2635 REWRITE_TAC[REAL_MUL_RZERO, REAL_ADD_RID] THEN REWRITE_TAC[REAL_SUB_0] THEN
2636 MP_TAC(GEN (Term`j:num->real`)
2637 (SPECL [Term`j:num->real`, Term`r:num`, Term`1:num`] SUM_OFFSET)) THEN
2638 REWRITE_TAC[ADD1, REAL_EQ_SUB_LADD] THEN
2639 DISCH_THEN(fn th => REWRITE_TAC[GSYM th]) THEN BETA_TAC THEN
2640 REWRITE_TAC[SUM_1] THEN BETA_TAC THEN REWRITE_TAC[pow, FACT] THEN
2641 ASM_REWRITE_TAC[real_div, REAL_INV1, REAL_MUL_RID] THEN
2642 CONV_TAC SYM_CONV THEN REWRITE_TAC[REAL_ADD_LID_UNIQ] THEN
2643 REWRITE_TAC[GSYM ADD1, POW_0, REAL_MUL_RZERO, SUM_0], ALL_TAC] THEN
2644 ABBREV_TAC (Term`difg =
2645 \m t. diff(m) t - (sum(0,n-m)(\p. (diff(m+p)(&0) / &(FACT p)) * (t pow p))
2646 + (B * ((t pow (n - m)) / &(FACT(n - m)))))`) THEN
2647 SUBGOAL_THEN (Term`difg(0:num):real->real = g`) ASSUME_TAC THENL
2648 [EXPAND_TAC "difg" THEN BETA_TAC THEN EXPAND_TAC "g" THEN
2649 CONV_TAC FUN_EQ_CONV THEN GEN_TAC THEN BETA_TAC THEN
2650 ASM_REWRITE_TAC[ADD_CLAUSES, SUB_0], ALL_TAC] THEN
2651 SUBGOAL_THEN (Term
2652 `(!m t. m < n /\ (& 0) <= t /\ t <= h
2653 ==> (difg(m) diffl difg(SUC m)(t))(t))`) ASSUME_TAC THENL
2654 [REPEAT GEN_TAC THEN DISCH_TAC THEN EXPAND_TAC "difg" THEN BETA_TAC THEN
2655 CONV_TAC((funpow 2 RATOR_CONV o RAND_CONV) HABS_CONV) THEN
2656 MATCH_MP_TAC DIFF_SUB THEN CONJ_TAC THENL
2657 [CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN
2658 FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[], ALL_TAC] THEN
2659 CONV_TAC((funpow 2 RATOR_CONV o RAND_CONV) HABS_CONV) THEN
2660 MATCH_MP_TAC DIFF_ADD THEN CONJ_TAC THENL
2661 [ALL_TAC,
2662 W(MP_TAC o DIFF_CONV o rand o funpow 2 rator o snd) THEN
2663 REWRITE_TAC[REAL_MUL_LZERO, REAL_MUL_RID, REAL_ADD_LID] THEN
2664 REWRITE_TAC[REAL_FACT_NZ, REAL_SUB_RZERO] THEN
2665 DISCH_THEN(MP_TAC o SPEC (Term`t:real`)) THEN
2666 MATCH_MP_TAC(TAUT_CONV “(a <=> b) ==> a ==> b”) THEN
2667 AP_THM_TAC THEN CONV_TAC(ONCE_DEPTH_CONV(ALPHA_CONV (Term`t:real`))) THEN
2668 AP_TERM_TAC THEN GEN_REWRITE_TAC RAND_CONV empty_rewrites [REAL_MUL_SYM] THEN
2669 AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[real_div] THEN
2670 REWRITE_TAC[GSYM REAL_MUL_ASSOC, POW_2] THEN
2671 ONCE_REWRITE_TAC[AC (REAL_MUL_ASSOC,REAL_MUL_SYM)
2672 (Term`a * (b * (c * d)) = b * (a * (d * c))`)] THEN
2673 FIRST_ASSUM(X_CHOOSE_THEN (Term`d:num`) SUBST1_TAC o
2674 MATCH_MP LESS_ADD_1 o CONJUNCT1) THEN
2675 ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN
2676 REWRITE_TAC[GSYM ADD_ASSOC] THEN
2677 REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] (GSYM ADD1)] THEN
2678 REWRITE_TAC[ADD_SUB] THEN AP_TERM_TAC THEN
2679 (IMP_SUBST_TAC REAL_INV_MUL:tactic) THEN REWRITE_TAC[REAL_FACT_NZ] THEN
2680 REWRITE_TAC[GSYM ADD1, FACT, GSYM REAL_MUL] THEN
2681 REPEAT(IMP_SUBST_TAC REAL_INV_MUL THEN
2682 REWRITE_TAC[REAL_FACT_NZ] THEN
2683 REWRITE_TAC [REAL_INJ, NOT_SUC]) THEN
2684 REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN
2685 ONCE_REWRITE_TAC[AC (REAL_MUL_ASSOC,REAL_MUL_SYM)
2686 (Term `a * (b * (c * (d * (e * (f * g))))) =
2687 (b * a) * ((d * f) * ((c * g) * e))`)] THEN
2688 REPEAT(IMP_SUBST_TAC REAL_MUL_LINV THEN REWRITE_TAC[REAL_FACT_NZ] THEN
2689 REWRITE_TAC[REAL_INJ, NOT_SUC]) THEN
2690 REWRITE_TAC[REAL_MUL_LID]] THEN
2691 FIRST_ASSUM(X_CHOOSE_THEN (Term`d:num`) SUBST1_TAC o
2692 MATCH_MP LESS_ADD_1 o CONJUNCT1) THEN
2693 ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN
2694 REWRITE_TAC[GSYM ADD_ASSOC] THEN
2695 REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] (GSYM ADD1)] THEN
2696 REWRITE_TAC[ADD_SUB] THEN
2697 REWRITE_TAC[GSYM(REWRITE_RULE[REAL_EQ_SUB_LADD] SUM_OFFSET)] THEN
2698 BETA_TAC THEN REWRITE_TAC[SUM_1] THEN BETA_TAC THEN
2699 CONV_TAC (funpow 2 RATOR_CONV (RAND_CONV HABS_CONV)) THEN
2700 GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) empty_rewrites [GSYM REAL_ADD_RID] THEN
2701 MATCH_MP_TAC DIFF_ADD THEN REWRITE_TAC[pow, DIFF_CONST] THEN
2702 (MP_TAC o C SPECL DIFF_SUM)
2703 [Term`\p x. (diff((p + 1) + m)(&0) / &(FACT(p + 1)))
2704 * (x pow (p + 1))`,
2705 Term`\p x. (diff(p + (SUC m))(&0) / &(FACT p)) * (x pow p)`,
2706 Term`0:num`, Term`d:num`, Term`t:real`] THEN BETA_TAC THEN
2707 DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[ADD_CLAUSES] THEN
2708 X_GEN_TAC (Term`k:num`) THEN STRIP_TAC THEN
2709 W(MP_TAC o DIFF_CONV o rand o funpow 2 rator o snd) THEN
2710 DISCH_THEN(MP_TAC o SPEC (Term`t:real`)) THEN
2711 MATCH_MP_TAC(TAUT_CONV “(a <=> b) ==> a ==> b”) THEN
2712 CONV_TAC(ONCE_DEPTH_CONV(ALPHA_CONV (Term`z:real`))) THEN
2713 AP_THM_TAC THEN AP_TERM_TAC THEN
2714 REWRITE_TAC[REAL_MUL_LZERO, REAL_ADD_LID, REAL_MUL_RID] THEN
2715 REWRITE_TAC[GSYM ADD1, ADD_CLAUSES, real_div, GSYM REAL_MUL_ASSOC] THEN
2716 REWRITE_TAC[SUC_SUB1] THEN
2717 ONCE_REWRITE_TAC[AC (REAL_MUL_ASSOC,REAL_MUL_SYM)
2718 (Term`a * (b * (c * d)) = c * ((a * d) * b)`)] THEN
2719 AP_TERM_TAC THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN
2720 AP_TERM_TAC THEN
2721 SUBGOAL_THEN (Term`&(SUC k) = inv(inv(&(SUC k)))`) SUBST1_TAC THENL
2722 [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_INVINV THEN
2723 REWRITE_TAC[REAL_INJ, NOT_SUC], ALL_TAC] THEN
2724 (IMP_SUBST_TAC(GSYM REAL_INV_MUL):tactic) THENL
2725 [CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN REWRITE_TAC[REAL_FACT_NZ] THEN
2726 MATCH_MP_TAC REAL_POS_NZ THEN MATCH_MP_TAC REAL_INV_POS THEN
2727 REWRITE_TAC[REAL_LT, LESS_0], ALL_TAC] THEN
2728 AP_TERM_TAC THEN REWRITE_TAC[FACT, GSYM REAL_MUL, REAL_MUL_ASSOC] THEN
2729 (IMP_SUBST_TAC REAL_MUL_LINV:tactic) THEN REWRITE_TAC[REAL_MUL_LID] THEN
2730 REWRITE_TAC[REAL_INJ, NOT_SUC], ALL_TAC] THEN
2731 SUBGOAL_THEN (Term`!m. m < n ==>
2732 ?t. &0 < t /\ t < h /\ (difg(SUC m)(t) = &0)`) MP_TAC THENL
2733 [ALL_TAC,
2734 DISCH_THEN(MP_TAC o SPEC (Term`r:num`)) THEN EXPAND_TAC "n" THEN
2735 REWRITE_TAC[LESS_SUC_REFL] THEN
2736 DISCH_THEN(X_CHOOSE_THEN (Term`t:real`) STRIP_ASSUME_TAC) THEN
2737 EXISTS_TAC (Term`t:real`) THEN ASM_REWRITE_TAC[] THEN
2738 UNDISCH_TAC (Term`difg(SUC r)(t:real) = &0`) THEN EXPAND_TAC "difg" THEN
2739 ASM_REWRITE_TAC[SUB_EQUAL_0, sum, pow, FACT] THEN
2740 REWRITE_TAC[REAL_SUB_0, REAL_ADD_LID, real_div] THEN
2741 REWRITE_TAC[REAL_INV1, REAL_MUL_RID] THEN DISCH_THEN SUBST1_TAC THEN
2742 GEN_REWRITE_TAC (funpow 2 RAND_CONV) empty_rewrites
2743 [AC (REAL_MUL_ASSOC,REAL_MUL_SYM)
2744 (Term`(a * b) * c = a * (c * b)`)] THEN
2745 ASM_REWRITE_TAC[GSYM real_div]] THEN
2746 SUBGOAL_THEN (Term`!m:num. m<n ==> (difg(m)(&0) = &0)`) ASSUME_TAC THENL
2747 [X_GEN_TAC (Term`m:num`) THEN EXPAND_TAC "difg" THEN
2748 DISCH_THEN(X_CHOOSE_THEN (Term`d:num`) SUBST1_TAC o MATCH_MP LESS_ADD_1)
2749 THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN
2750 MP_TAC(GEN (Term`j:num->real`)
2751 (SPECL [Term`j:num->real`, Term`d:num`, Term`1:num`] SUM_OFFSET)) THEN
2752 REWRITE_TAC[ADD1, REAL_EQ_SUB_LADD] THEN
2753 DISCH_THEN(fn th => REWRITE_TAC[GSYM th]) THEN BETA_TAC THEN
2754 REWRITE_TAC[SUM_1] THEN BETA_TAC THEN
2755 REWRITE_TAC[FACT, pow, REAL_INV1, ADD_CLAUSES, real_div, REAL_MUL_RID] THEN
2756 REWRITE_TAC[GSYM ADD1, POW_0, REAL_MUL_RZERO, SUM_0, REAL_ADD_LID] THEN
2757 REWRITE_TAC[REAL_MUL_LZERO, REAL_MUL_RZERO,REAL_ADD_RID] THEN
2758 REWRITE_TAC[REAL_SUB_REFL], ALL_TAC] THEN
2759 SUBGOAL_THEN (Term`!m:num. m < n ==> ?t. &0 < t /\ t < h /\
2760 (difg(m) diffl &0)(t)`) MP_TAC THENL
2761 [ALL_TAC,
2762 DISCH_THEN(fn th => GEN_TAC THEN
2763 DISCH_THEN(fn t => ASSUME_TAC t THEN MP_TAC(MATCH_MP th t))) THEN
2764 DISCH_THEN(X_CHOOSE_THEN (Term`t:real`) STRIP_ASSUME_TAC) THEN
2765 EXISTS_TAC (Term`t:real`) THEN ASM_REWRITE_TAC[] THEN
2766 MATCH_MP_TAC DIFF_UNIQ THEN EXISTS_TAC (Term`difg(m:num):real->real`) THEN
2767 EXISTS_TAC (Term`t:real`) THEN ASM_REWRITE_TAC[] THEN
2768 FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
2769 CONJ_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN
2770 FIRST_ASSUM ACCEPT_TAC] THEN
2771 INDUCT_TAC THENL
2772 [DISCH_TAC THEN MATCH_MP_TAC ROLLE THEN ASM_REWRITE_TAC[] THEN
2773 SUBGOAL_THEN (Term`!t. &0 <= t /\ t <= h ==> g differentiable t`)
2774 MP_TAC THENL
2775 [GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[differentiable] THEN
2776 EXISTS_TAC (Term`difg(SUC 0)(t:real):real`) THEN
2777 SUBST1_TAC(SYM(ASSUME (Term`difg(0:num):real->real = g`))) THEN
2778 FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[], ALL_TAC] THEN
2779 DISCH_TAC THEN CONJ_TAC THENL
2780 [GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC DIFF_CONT THEN
2781 REWRITE_TAC[GSYM differentiable] THEN FIRST_ASSUM MATCH_MP_TAC THEN
2782 ASM_REWRITE_TAC[],
2783 GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN
2784 CONJ_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]],
2785 DISCH_TAC THEN SUBGOAL_THEN (Term`m < n:num`)
2786 (fn th => FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THENL
2787 [MATCH_MP_TAC LESS_TRANS THEN EXISTS_TAC (Term`SUC m`) THEN
2788 ASM_REWRITE_TAC[LESS_SUC_REFL], ALL_TAC] THEN
2789 DISCH_THEN(X_CHOOSE_THEN (Term`t0:real`) STRIP_ASSUME_TAC) THEN
2790 SUBGOAL_THEN (Term`?t. (& 0) < t /\ t < t0 /\
2791 ((difg(SUC m)) diffl (& 0))t`) MP_TAC THENL
2792 [MATCH_MP_TAC ROLLE THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
2793 [SUBGOAL_THEN (Term`difg(SUC m)(&0) = &0`) SUBST1_TAC THENL
2794 [FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC,
2795 MATCH_MP_TAC DIFF_UNIQ THEN EXISTS_TAC (Term`difg(m:num):real->real`)
2796 THEN EXISTS_TAC (Term`t0:real`) THEN ASM_REWRITE_TAC[] THEN
2797 FIRST_ASSUM MATCH_MP_TAC THEN REPEAT CONJ_TAC THENL
2798 [MATCH_MP_TAC LESS_TRANS THEN EXISTS_TAC (Term`SUC m`) THEN
2799 ASM_REWRITE_TAC[LESS_SUC_REFL],
2800 MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[],
2801 MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]]], ALL_TAC] THEN
2802 SUBGOAL_THEN (Term`!t. &0 <= t /\ t <= t0 ==>
2803 difg(SUC m) differentiable t`) ASSUME_TAC THENL
2804 [GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[differentiable] THEN
2805 EXISTS_TAC (Term`difg(SUC(SUC m))(t:real):real`) THEN
2806 FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
2807 MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC (Term`t0:real`) THEN
2808 ASM_REWRITE_TAC[] THEN
2809 MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[], ALL_TAC] THEN
2810 CONJ_TAC THENL
2811 [GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC DIFF_CONT THEN
2812 REWRITE_TAC[GSYM differentiable] THEN FIRST_ASSUM MATCH_MP_TAC THEN
2813 ASM_REWRITE_TAC[],
2814 GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN
2815 CONJ_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]],
2816 DISCH_THEN(X_CHOOSE_THEN (Term`t:real`) STRIP_ASSUME_TAC) THEN
2817 EXISTS_TAC (Term`t:real`) THEN ASM_REWRITE_TAC[] THEN
2818 MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC (Term`t0:real`) THEN
2819 ASM_REWRITE_TAC[]]]
2820QED
2821
2822Theorem MCLAURIN_ALT_lemma[local] :
2823 !f h n. 0 < h /\ 0 < n /\
2824 (!m t. m < n /\ 0 <= t /\ t <= h ==> higher_differentiable (SUC m) f t) ==>
2825 ?t. 0 < t /\ t < h /\
2826 f h =
2827 SIGMA (λm. diffn m f 0 / &FACT m * h pow m) (count n) +
2828 diffn n f t / &FACT n * h pow n
2829Proof
2830 rpt STRIP_TAC
2831 >> Q.ABBREV_TAC ‘diff' = (λm x. diffn m f x)’
2832 >> MP_TAC (Q.SPECL [‘f’, ‘diff'’, ‘h’, ‘n’] MCLAURIN)
2833 >> impl_tac
2834 >- (simp [] \\
2835 CONJ_TAC >- (rw [Abbr ‘diff'’] >> METIS_TAC []) \\
2836 Q.UNABBREV_TAC ‘diff'’ \\
2837 BETA_TAC \\
2838 qx_genl_tac [‘m’, ‘t’] \\
2839 STRIP_TAC \\
2840 Q.PAT_X_ASSUM ‘!m x. _’ (MP_TAC o Q.SPECL [‘m’, ‘t’]) \\
2841 DISCH_TAC \\
2842 gs [LT_IMP_LE] \\
2843 MP_TAC (Q.SPEC ‘f’ higher_differentiable_thm) >> rw [] \\
2844 POP_ASSUM (STRIP_ASSUME_TAC o Q.SPECL [‘m’, ‘t’]) \\
2845 METIS_TAC [ETA_AX])
2846 >> STRIP_TAC
2847 >> qexists ‘t’ >> fs []
2848 >> MP_TAC (Q.SPECL [‘λm. inv (&FACT m) * diff' m (0:real) * h pow m’, ‘n’]
2849 (INST_TYPE [“:'a” |-> “:num”] REAL_SUM_IMAGE_COUNT))
2850 >> fs []
2851QED
2852
2853(* NOTE: This is modern form of MCLAURIN with SIGMA and higher_differentiable *)
2854Theorem MCLAURIN_ALT :
2855 !f h n. 0 < h /\ 0 < n /\
2856 (!t. 0 <= t /\ t <= h ==> higher_differentiable n f t) ==>
2857 ?t. 0 < t /\ t < h /\
2858 f h =
2859 SIGMA (λm. diffn m f 0 / &FACT m * h pow m) (count n) +
2860 diffn n f t / &FACT n * h pow n
2861Proof
2862 rpt STRIP_TAC
2863 >> MATCH_MP_TAC MCLAURIN_ALT_lemma >> rw []
2864 >> MATCH_MP_TAC higher_differentiable_mono
2865 >> Q.EXISTS_TAC ‘n’ >> rw []
2866QED
2867
2868(* By Kai Phan. This proof is based on the above MCLAURIN *)
2869Theorem TAYLOR_lemma[local] :
2870 !f a x n. a < x /\ 0 < n /\
2871 (!m t. m < n /\ a <= t /\ t <= x ==>
2872 higher_differentiable (SUC m) f t) ==>
2873 ?t. a < t /\ t < x /\
2874 f x = sum (0,n) (λm. diffn m f a / &FACT m * (x - a) pow m) +
2875 diffn n f t / &FACT n * (x - a) pow n
2876Proof
2877 rpt STRIP_TAC
2878 >> Q.ABBREV_TAC ‘g = λx. f (x + a)’
2879 >> ‘!x. g x = f (x + a)’ by rw [Abbr ‘g’]
2880 >> POP_ASSUM (MP_TAC o Q.SPEC ‘x - a’)
2881 >> ‘f (x - a + a) = f x’ by METIS_TAC [REAL_SUB_ADD] >> POP_ORW
2882 >> DISCH_TAC
2883 >> Q.ABBREV_TAC ‘diff' = \n x. diffn n f (x + a)’
2884 >> MP_TAC (Q.SPECL [‘g’, ‘diff'’, ‘x - a’, ‘n’] MCLAURIN)
2885 >> impl_tac
2886 >- (CONJ_TAC >- rw [REAL_SUB_LT] \\
2887 CONJ_TAC >- fs [] \\
2888 CONJ_TAC >- (rw [Abbr ‘diff'’] >> METIS_TAC []) \\
2889 Q.UNABBREV_TAC ‘diff'’ >> BETA_TAC \\
2890 qx_genl_tac [‘m’, ‘t’] >> STRIP_TAC \\
2891 ‘a <= t + a’ by rw [REAL_LE_ADDL] \\
2892 ‘t + a <= x’ by METIS_TAC [REAL_LE_SUB_LADD] \\
2893 Q.PAT_X_ASSUM ‘!m t. m < n /\ a <= t /\ t <= x ==>
2894 higher_differentiable (SUC m) f t’
2895 (MP_TAC o Q.SPECL [‘m’, ‘t + a’]) >> DISCH_TAC \\
2896 MP_TAC (Q.SPECL [‘diffn (m:num) f’, ‘λx. (x + a)’,
2897 ‘diffn (SUC m) f (t + a:real)’, ‘1’, ‘t’]
2898 DIFF_CHAIN) \\
2899 impl_tac
2900 >- (CONJ_TAC
2901 >- (BETA_TAC \\
2902 MP_TAC (Q.SPEC ‘f’ higher_differentiable_thm) >> rw []) \\
2903 Know ‘((λx. x + a) diffl (1 + 0)) t’
2904 >- (MP_TAC (Q.SPECL [‘λx. x’, ‘λx. a’, ‘1’, ‘0’, ‘t’] DIFF_ADD) \\
2905 impl_tac >- METIS_TAC [DIFF_X, DIFF_CONST] \\
2906 simp []) \\
2907 simp [REAL_ADD_RID]) \\
2908 simp [])
2909 >> simp []
2910 >> DISCH_THEN (Q.X_CHOOSE_TAC ‘t’)
2911 >> Q.EXISTS_TAC ‘t + a’
2912 >> CONJ_TAC >- rw [REAL_LT_ADDL]
2913 >> CONJ_TAC >- rw [REAL_LT_ADD_SUB]
2914 >> Know ‘!m. diff' m 0 = diffn m f a’ >- simp [Abbr ‘diff'’]
2915 >> simp []
2916QED
2917
2918(* A modern version based on SIGMA (REAL_SUM_IMAGE) *)
2919Theorem TAYLOR :
2920 !f a x n. a < x /\ 0 < n /\
2921 (!t. a <= t /\ t <= x ==> higher_differentiable n f t) ==>
2922 ?t. a < t /\ t < x /\
2923 f x = SIGMA (λm. diffn m f a / &FACT m * (x - a) pow m) (count n) +
2924 diffn n f t / &FACT n * (x - a) pow n
2925Proof
2926 RW_TAC std_ss [REAL_SUM_IMAGE_COUNT]
2927 >> MATCH_MP_TAC TAYLOR_lemma >> rw []
2928 >> MATCH_MP_TAC higher_differentiable_mono
2929 >> Q.EXISTS_TAC ‘n’ >> rw []
2930QED
2931
2932Theorem MCLAURIN_NEG:
2933 !f diff h n.
2934 h < &0 /\ 0 < n /\ (diff(0) = f) /\
2935 (!m t. m < n /\ h <= t /\ t <= &0 ==>
2936 (diff(m) diffl diff(SUC m)(t))(t)) ==>
2937 (?t. h < t /\ t < &0 /\
2938 (f(h) = sum(0,n)(\m. (diff(m)(&0) / &(FACT m)) * (h pow m))
2939 + ((diff(n)(t) / &(FACT n)) * (h pow n))))
2940Proof
2941 REPEAT GEN_TAC THEN STRIP_TAC THEN
2942 MP_TAC(Q.SPECL[‘\x. (f(~x):real)’,
2943 ‘\n x. ((~(&1)) pow n) * (diff:num->real->real)(n)(~x)’,
2944 ‘~h’, ‘n:num’] MCLAURIN) THEN
2945 BETA_TAC THEN ASM_REWRITE_TAC[REAL_NEG_GT0, pow, REAL_MUL_LID] THEN
2946 ONCE_REWRITE_TAC[GSYM REAL_LE_NEG] THEN
2947 REWRITE_TAC[REAL_NEGNEG, REAL_NEG_0] THEN
2948 ONCE_REWRITE_TAC[TAUT_CONV (Term`a /\ b /\ c <=> a /\ c /\ b`)] THEN
2949 W(C SUBGOAL_THEN (fn t => REWRITE_TAC[t]) o funpow 2 (fst o dest_imp) o snd)
2950 THENL
2951 [REPEAT GEN_TAC THEN
2952 DISCH_THEN(fn th => FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN
2953 DISCH_THEN(MP_TAC o
2954 C CONJ (SPEC “t:real” (DIFF_CONV “\x. -x”))) THEN
2955 CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN
2956 DISCH_THEN(MP_TAC o MATCH_MP DIFF_CHAIN) THEN
2957 DISCH_THEN(MP_TAC o GEN_ALL o MATCH_MP DIFF_CMUL) THEN
2958 DISCH_THEN(MP_TAC o SPEC (Term`(~(&1)) pow m`)) THEN BETA_TAC THEN
2959 MATCH_MP_TAC(TAUT_CONV “(a <=> b) ==> a ==> b”) THEN
2960 CONV_TAC(ONCE_DEPTH_CONV(ALPHA_CONV (Term`z:real`))) THEN
2961 AP_THM_TAC THEN AP_TERM_TAC THEN
2962 CONV_TAC(AC_CONV (REAL_MUL_ASSOC,REAL_MUL_SYM)),
2963 DISCH_THEN(X_CHOOSE_THEN (Term`t:real`) STRIP_ASSUME_TAC)] THEN
2964 Q.EXISTS_TAC ‘-t’ THEN ONCE_REWRITE_TAC[GSYM REAL_LT_NEG] THEN
2965 ASM_REWRITE_TAC[REAL_NEGNEG, REAL_NEG_0] THEN
2966 BINOP_TAC THENL
2967 [MATCH_MP_TAC SUM_EQ THEN
2968 X_GEN_TAC (Term`m:num`) THEN REWRITE_TAC[ADD_CLAUSES] THEN
2969 DISCH_THEN(ASSUME_TAC o CONJUNCT2) THEN BETA_TAC, ALL_TAC] THEN
2970 REWRITE_TAC[real_div, GSYM REAL_MUL_ASSOC] THEN
2971 ONCE_REWRITE_TAC[AC (REAL_MUL_ASSOC,REAL_MUL_SYM)
2972 (Term`a * (b * (c * d)) = (b * c) * (a * d)`)] THEN
2973 REWRITE_TAC[GSYM POW_MUL, GSYM REAL_NEG_MINUS1, REAL_NEGNEG] THEN
2974 REWRITE_TAC[REAL_MUL_ASSOC]
2975QED
2976
2977Theorem TAYLOR_NEG_lemma[local] :
2978 !f a x n.
2979 x < a /\ 0 < n /\
2980 (!m t. m < n /\ x <= t /\ t <= a ==> higher_differentiable (SUC m) f t) ==>
2981 ?t. x < t /\ t < a /\
2982 f x =
2983 sum (0,n) (λm. diffn m f a / &FACT m * (x - a) pow m) +
2984 diffn n f t / &FACT n * (x - a) pow n
2985Proof
2986 rpt STRIP_TAC
2987 >> Q.ABBREV_TAC ‘g = λx. f (x + a)’
2988 >> ‘!x. g x = f (x + a)’ by rw [Abbr ‘g’]
2989 >> POP_ASSUM (MP_TAC o Q.SPEC ‘x - a’)
2990 >> ‘x - a + a = x’ by REAL_ARITH_TAC >> POP_ORW
2991 >> DISCH_TAC
2992 >> Q.ABBREV_TAC ‘diff' = \n x. diffn n f (x + a)’
2993 >> MP_TAC (Q.SPECL [‘g’, ‘diff'’, ‘x - a’, ‘n’] MCLAURIN_NEG)
2994 >> impl_tac
2995 >- (fs [REAL_LT_SUB_RADD, Abbr ‘diff'’, ETA_AX] \\
2996 qx_genl_tac [‘m’, ‘t’] >> STRIP_TAC \\
2997 ‘t + a <= a’ by rw [REAL_ADDL_LE] \\
2998 ‘x <= t + a’ by METIS_TAC [REAL_LE_SUB_RADD] \\
2999 Q.PAT_X_ASSUM ‘!m t. m < n /\ x <= t /\ t <= a ==> _’
3000 (MP_TAC o Q.SPECL [‘m’, ‘t + a’]) >> DISCH_TAC >> gs [] \\
3001 MP_TAC (Q.SPECL [‘diffn (m:num) f’, ‘λx. (x + a)’,
3002 ‘diffn (SUC m) f (t + a:real)’, ‘1’, ‘t’]
3003 DIFF_CHAIN) \\
3004 impl_tac
3005 >- (CONJ_TAC >- (BETA_TAC \\
3006 MP_TAC (Q.SPEC ‘f’ higher_differentiable_thm) >> rw []) \\
3007 Know ‘((λx. x + a) diffl (1 + 0)) t’
3008 >- (MP_TAC (Q.SPECL [‘λx. x’, ‘λx. a’, ‘1’, ‘0’, ‘t’] DIFF_ADD) \\
3009 impl_tac >- METIS_TAC [DIFF_X, DIFF_CONST] >> simp []) \\
3010 simp [REAL_ADD_RID]) \\
3011 simp [])
3012 >> simp []
3013 >> DISCH_THEN (Q.X_CHOOSE_TAC ‘t’)
3014 >> Q.EXISTS_TAC ‘t + a’ >> fs [FORALL_AND_THM]
3015 >> rw [GSYM REAL_LT_SUB_RADD, REAL_LT_ADD_SUB]
3016 >> Know ‘!m. diff' m 0 = diffn m f a’ >- simp [Abbr ‘diff'’]
3017 >> simp []
3018QED
3019
3020Theorem TAYLOR_NEG :
3021 !f a x n.
3022 x < a /\ 0 < n /\
3023 (!t. x <= t /\ t <= a ==> higher_differentiable n f t) ==>
3024 ?t. x < t /\ t < a /\
3025 f x = SIGMA (λm. diffn m f a / &FACT m * (x - a) pow m) (count n) +
3026 diffn n f t / &FACT n * (x - a) pow n
3027Proof
3028 RW_TAC std_ss [REAL_SUM_IMAGE_COUNT]
3029 >> MATCH_MP_TAC TAYLOR_NEG_lemma >> rw []
3030 >> MATCH_MP_TAC higher_differentiable_mono
3031 >> Q.EXISTS_TAC ‘n’ >> rw []
3032QED
3033
3034Theorem TAYLOR_ALL_LT :
3035 !f a x n.
3036 0 < n /\ a <> x /\
3037 (!t. min a x <= t /\ t <= max a x ==> higher_differentiable n f t) ==>
3038 (?t. min a x < t /\ t < max a x /\
3039 f x =
3040 SIGMA (λm. diffn m f a / &FACT m * (x - a) pow m) (count n) +
3041 diffn n f t / &FACT n * (x - a) pow n)
3042Proof
3043 rpt STRIP_TAC
3044 >> Cases_on ‘x < a’
3045 >- (fs [REAL_MIN_REDUCE, REAL_MAX_REDUCE, REAL_LT_IMP_LE] \\
3046 MP_TAC (Q.SPECL [‘f’, ‘a’, ‘x’, ‘n’] TAYLOR_NEG) >> rw [] \\
3047 qexists ‘t’ >> simp [] \\
3048 METIS_TAC [REAL_SUM_IMAGE_COUNT])
3049 >> ‘a < x’ by METIS_TAC [GSYM REAL_LT_LE, REAL_NOT_LT]
3050 >> fs [REAL_MIN_REDUCE, REAL_MAX_REDUCE, REAL_LT_IMP_LE]
3051 >> MP_TAC (Q.SPECL [‘f’, ‘a’, ‘x’, ‘n’] TAYLOR) >> rw []
3052 >> qexists ‘t’ >> simp []
3053 >> METIS_TAC [REAL_SUM_IMAGE_COUNT]
3054QED
3055
3056(* ------------------------------------------------------------------------- *)
3057(* Simple strong form if a function is differentiable everywhere. *)
3058(* ------------------------------------------------------------------------- *)
3059
3060Theorem MCLAURIN_ALL_LT :
3061 !f diff.
3062 (diff 0 = f) /\
3063 (!m x. ((diff m) diffl (diff(SUC m) x)) x)
3064 ==> !x n. ~(x = &0) /\ 0 < n
3065 ==> ?t. &0 < abs(t) /\ abs(t) < abs(x) /\
3066 (f(x) = sum(0,n)
3067 (\m. (diff m (&0) / &(FACT m)) * x pow m)
3068 +
3069 (diff n t / &(FACT n)) * x pow n)
3070Proof
3071 REPEAT STRIP_TAC THEN
3072 REPEAT_TCL DISJ_CASES_THEN MP_TAC
3073 (SPECL [Term`x:real`, Term`&0`] REAL_LT_TOTAL) THEN
3074 ASM_REWRITE_TAC[] THEN DISCH_TAC THENL
3075 [MP_TAC(SPECL [Term`f:real->real`, Term`diff:num->real->real`,
3076 Term`x:real`, Term`n:num`] MCLAURIN_NEG) THEN
3077 ASM_REWRITE_TAC[] THEN
3078 DISCH_THEN(X_CHOOSE_THEN (Term`t:real`) STRIP_ASSUME_TAC) THEN
3079 EXISTS_TAC (Term`t:real`) THEN ASM_REWRITE_TAC[] THEN
3080 UNDISCH_TAC (Term`t < &0`) THEN UNDISCH_TAC (Term`x < t`)
3081 THEN REAL_ARITH_TAC,
3082 MP_TAC(SPECL [Term`f:real->real`, Term`diff:num->real->real`,
3083 Term`x:real`, Term`n:num`] MCLAURIN) THEN
3084 ASM_REWRITE_TAC[] THEN
3085 DISCH_THEN(X_CHOOSE_THEN (Term`t:real`) STRIP_ASSUME_TAC) THEN
3086 EXISTS_TAC (Term`t:real`) THEN ASM_REWRITE_TAC[] THEN
3087 UNDISCH_TAC (Term`&0 < t`) THEN UNDISCH_TAC (Term`t < x`)
3088 THEN REAL_ARITH_TAC]
3089QED
3090
3091Theorem MCLAURIN_ZERO :
3092 !diff n x. (x = &0) /\ 0 < n ==>
3093 (sum(0,n) (\m. (diff m (&0) / &(FACT m)) * x pow m) = diff 0 (&0))
3094Proof
3095 REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 SUBST1_TAC MP_TAC) THEN
3096 SPEC_TAC(Term`n:num`,Term`n:num`) THEN INDUCT_TAC THEN
3097 REWRITE_TAC[LESS_REFL] THEN REWRITE_TAC[LESS_THM] THEN
3098 DISCH_THEN(DISJ_CASES_THEN2 (SUBST1_TAC o SYM) MP_TAC) THENL
3099 [REWRITE_TAC[sum, ADD_CLAUSES] THEN BETA_TAC THEN
3100 REWRITE_TAC[FACT, pow, real_div] THEN MP_TAC(SPEC(Term`&1`) REAL_DIV_REFL)
3101 THEN DISCH_THEN (MP_TAC o REWRITE_RULE
3102 [REAL_OF_NUM_EQ,ONE,NOT_SUC])
3103 THEN REWRITE_TAC [GSYM REAL_INV_1OVER, GSYM (ONE)]
3104 THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_ADD_LID, REAL_MUL_RID],
3105 REWRITE_TAC[sum] THEN
3106 DISCH_THEN(fn th => ASSUME_TAC th THEN ANTE_RES_THEN SUBST1_TAC th) THEN
3107 UNDISCH_TAC (Term`0 < n:num`) THEN SPEC_TAC(Term`n:num`,Term`n:num`) THEN
3108 INDUCT_TAC THEN BETA_TAC THEN REWRITE_TAC[LESS_REFL] THEN
3109 REWRITE_TAC[ADD_CLAUSES, pow, REAL_MUL_LZERO, REAL_MUL_RZERO] THEN
3110 REWRITE_TAC[REAL_ADD_RID]]
3111QED
3112
3113Theorem LET_CASES[local] :
3114 !m n:num. m <= n \/ n < m
3115Proof
3116 ONCE_REWRITE_TAC [DISJ_SYM] THEN MATCH_ACCEPT_TAC LESS_CASES
3117QED
3118
3119Theorem REAL_POW_EQ_0[local] :
3120 !x n. (x pow n = &0) <=> (x = &0) /\ ~(n = 0)
3121Proof
3122 GEN_TAC THEN INDUCT_TAC THEN
3123 ASM_REWRITE_TAC[NOT_SUC, pow, REAL_ENTIRE] THENL
3124 [REWRITE_TAC [REAL_OF_NUM_EQ, ONE,NOT_SUC],
3125 EQ_TAC THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]]
3126QED
3127
3128Theorem MCLAURIN_ALL_LE :
3129 !f diff.
3130 (diff 0 = f) /\
3131 (!m x. ((diff m) diffl (diff(SUC m) x)) x)
3132 ==> !x n. ?t. abs t <= abs x /\
3133 (f(x) = sum(0,n)
3134 (\m. (diff m (&0) / &(FACT m)) * x pow m)
3135 +
3136 (diff n t / &(FACT n)) * x pow n)
3137Proof
3138 REPEAT STRIP_TAC THEN
3139 DISJ_CASES_THEN MP_TAC(SPECL [Term`n:num`, Term`0:num`] LET_CASES) THENL
3140 [REWRITE_TAC[LE] THEN DISCH_THEN SUBST1_TAC THEN
3141 ASM_REWRITE_TAC[sum, REAL_ADD_LID, FACT] THEN EXISTS_TAC (Term`x:real`)
3142 THEN REWRITE_TAC[REAL_LE_REFL, pow, REAL_MUL_RID, REAL_OVER1],
3143 DISCH_TAC THEN ASM_CASES_TAC (Term`x = &0`) THENL
3144 [MP_TAC(SPEC_ALL MCLAURIN_ZERO) THEN ASM_REWRITE_TAC[] THEN
3145 DISCH_THEN SUBST1_TAC THEN EXISTS_TAC (Term`&0`) THEN
3146 REWRITE_TAC[REAL_LE_REFL] THEN
3147 SUBGOAL_THEN (Term`&0 pow n = &0`) SUBST1_TAC THENL
3148 [ASM_REWRITE_TAC[REAL_POW_EQ_0, GSYM (CONJUNCT1 LE), NOT_LESS_EQUAL],
3149 REWRITE_TAC[REAL_ADD_RID, REAL_MUL_RZERO]],
3150 MP_TAC(SPEC_ALL MCLAURIN_ALL_LT) THEN ASM_REWRITE_TAC[] THEN
3151 DISCH_THEN(MP_TAC o SPEC_ALL) THEN ASM_REWRITE_TAC[] THEN
3152 DISCH_THEN(X_CHOOSE_THEN (Term`t:real`) STRIP_ASSUME_TAC) THEN
3153 EXISTS_TAC (Term`t:real`) THEN ASM_REWRITE_TAC[] THEN
3154 MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]]]
3155QED
3156
3157(* ------------------------------------------------------------------------- *)
3158(* Version for exp. *)
3159(* ------------------------------------------------------------------------- *)
3160
3161Theorem MCLAURIN_EXP_LEMMA[local] :
3162 ((\n:num. exp) 0 = exp) /\
3163 (!m x. (((\n:num. exp) m) diffl ((\n:num. exp) (SUC m) x)) x)
3164Proof
3165 REWRITE_TAC[DIFF_EXP]
3166QED
3167
3168Theorem MCLAURIN_EXP_LT :
3169 !x n. ~(x = &0) /\ 0 < n
3170 ==> ?t. &0 < abs(t) /\
3171 abs(t) < abs(x) /\
3172 (exp(x) = sum(0,n)(\m. x pow m / &(FACT m)) +
3173 (exp(t) / &(FACT n)) * x pow n)
3174Proof
3175 MP_TAC (MATCH_MP MCLAURIN_ALL_LT MCLAURIN_EXP_LEMMA) THEN BETA_TAC THEN
3176 REPEAT STRIP_TAC THEN RES_TAC THEN NTAC 3 (POP_ASSUM (K ALL_TAC)) THEN
3177 EXISTS_TAC (Term`t:real`) THEN
3178 ASM_REWRITE_TAC [EXP_0,real_div,REAL_MUL_LID,REAL_MUL_RID]
3179 THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN CONV_TAC FUN_EQ_CONV
3180 THEN GEN_TAC THEN BETA_TAC THEN GEN_REWRITE_TAC LAND_CONV empty_rewrites [REAL_MUL_SYM]
3181 THEN REFL_TAC
3182QED
3183
3184Theorem MCLAURIN_EXP_LE :
3185 !x n. ?t. abs(t) <= abs(x) /\
3186 (exp(x) = sum(0,n)(\m. x pow m / &(FACT m)) +
3187 (exp(t) / &(FACT n)) * x pow n)
3188Proof
3189 MP_TAC (MATCH_MP MCLAURIN_ALL_LE MCLAURIN_EXP_LEMMA) THEN
3190 DISCH_THEN (fn th => REPEAT GEN_TAC THEN STRIP_ASSUME_TAC (SPEC_ALL th))
3191 THEN EXISTS_TAC (Term`t:real`) THEN ASM_REWRITE_TAC [] THEN
3192 AP_THM_TAC THEN REPEAT AP_TERM_TAC THEN CONV_TAC FUN_EQ_CONV
3193 THEN GEN_TAC THEN BETA_TAC THEN
3194 REWRITE_TAC[EXP_0, real_div, REAL_MUL_LID, REAL_MUL_RID] THEN
3195 GEN_REWRITE_TAC LAND_CONV empty_rewrites [REAL_MUL_SYM] THEN REFL_TAC
3196QED
3197
3198(* ------------------------------------------------------------------------- *)
3199(* Version for ln(1 - x). *)
3200(* ------------------------------------------------------------------------- *)
3201
3202Theorem DIFF_LN_COMPOSITE:
3203 !g m x. (g diffl m)(x) /\ &0 < g x
3204 ==> ((\x. ln(g x)) diffl (inv(g x) * m))(x)
3205Proof
3206 REPEAT STRIP_TAC THEN MATCH_MP_TAC DIFF_CHAIN THEN
3207 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIFF_LN THEN
3208 ASM_REWRITE_TAC[]
3209QED
3210
3211Theorem DIFF_LN_COMPOSITE'[difftool] = SPEC_ALL DIFF_LN_COMPOSITE
3212
3213(* ------------------------------------------------------------------------- *)
3214(* Exponentiation with real exponents (rpow) *)
3215(* ------------------------------------------------------------------------- *)
3216
3217Theorem powr_lemma[local] :
3218 !n a. 0 < a ==> exp (ln a * &n) = a pow n
3219Proof
3220 Induct_on ‘n’
3221 >- RW_TAC real_ss [pow, POW_1, GSYM EXP_0]
3222 >> RW_TAC std_ss [pow, REAL, REAL_LDISTRIB, EXP_ADD, REAL_MUL_RID]
3223 >> ‘exp (ln a) = a’ by PROVE_TAC [EXP_LN]
3224 >> POP_ORW
3225 >> REWRITE_TAC [Once REAL_MUL_COMM]
3226QED
3227
3228(* New definition of powr (rpow) *)
3229local
3230 val thm = Q.prove (
3231 ‘?f :real -> real -> real.
3232 (!a b. 0 < a ==> f a b = exp (b * ln a)) /\
3233 (!b. 0 < b ==> f 0 b = 0) /\
3234 (!a n. f a &n = a pow n) /\
3235 (!a n. f a (-&n) = inv (a pow n))’,
3236 (* proof *)
3237 Q.EXISTS_TAC ‘\a b. if 0 < a then exp (b * ln a) else
3238 if a = 0 /\ 0 < b then 0 else
3239 if ?n. b = &n then a pow (flr b) else
3240 if ?n. -b = &n then inv (a pow (flr (-b))) else 0’
3241 >> rw [NUM_FLOOR_EQNS] (* 2 subgoals *)
3242 >| [ (* goal 1 (of 2) *)
3243 MATCH_MP_TAC powr_lemma >> art [],
3244 (* goal 2 (of 2) *)
3245 RW_TAC std_ss [REAL_MUL_LNEG, EXP_NEG] \\
3246 AP_TERM_TAC \\
3247 MATCH_MP_TAC powr_lemma >> art [] ]);
3248in
3249 (* |- (!a b. 0 < a ==> a powr b = exp (b * ln a)) /\
3250 (!b. 0 < b ==> 0 powr b = 0) /\
3251 (!a n. a powr &n = a pow n) /\
3252 !a n. a powr -&n = inv (a pow n)
3253 *)
3254 val powr_def = new_specification ("powr_def", ["powr"], thm);
3255end;
3256
3257(* Infix syntax: ‘a powr b’ *)
3258val _ = set_fixity "powr" (Infixr 700);
3259
3260(* NOTE: the name "rpow" is for backward compatibility purposes *)
3261Overload rpow[inferior] = “$powr”
3262val _ = set_fixity "rpow" (Infixr 700);
3263
3264(* |- !a b. 0 < a ==> powr a b = exp (b * ln a) *)
3265Theorem rpow_def = cj 1 powr_def
3266
3267val rpow = rpow_def;
3268
3269(* Properties of ‘powr’ / ‘rpow’ *)
3270
3271Theorem GEN_RPOW :
3272 !a n. 0 < a ==> (a pow n = a rpow &n)
3273Proof
3274 rw [rpow, powr_lemma]
3275QED
3276
3277Theorem RPOW_SUC_N:
3278 !(a:real) (n:num). 0 < a ==>(a rpow (&n+1)= a pow SUC n)
3279Proof
3280 RW_TAC std_ss [] THEN
3281 KNOW_TAC``&n + (1:real)= & SUC n`` THEN1
3282 RW_TAC std_ss [REAL]THEN
3283 DISCH_TAC THEN ONCE_ASM_REWRITE_TAC[] THEN
3284 RW_TAC std_ss [GEN_RPOW]
3285QED
3286
3287(* NOTE: removed ‘0 < a’ under the new definition *)
3288Theorem RPOW_0 :
3289 !a. a rpow &0 = &1
3290Proof
3291 rw [powr_def]
3292QED
3293
3294(* NOTE: removed ‘0 < a’ under the new definition *)
3295Theorem RPOW_1 :
3296 !a. a rpow &1 = a
3297Proof
3298 rw [powr_def]
3299QED
3300
3301(* NOTE: removed ‘0 < a’ (even under the old definition) *)
3302Theorem ONE_RPOW :
3303 !a. 1 rpow a = 1
3304Proof
3305 rw [rpow, LN_1, EXP_0]
3306QED
3307
3308Theorem RPOW_POS_LT:
3309 !a b. (0 < a)==> (0 < a rpow b)
3310Proof
3311 RW_TAC std_ss [rpow, EXP_POS_LT]
3312QED
3313
3314(* NOTE: the antecedent has changed from ‘0 <> a’ to ‘0 < a’ *)
3315Theorem RPOW_NZ :
3316 !a b. 0 < a ==> a rpow b <> 0
3317Proof
3318 RW_TAC std_ss [rpow, EXP_NZ]
3319QED
3320
3321Theorem LN_RPOW:
3322 !a b. (0 < a)==> (ln (a rpow b)= (b*ln a))
3323Proof
3324 RW_TAC std_ss [rpow, LN_EXP]
3325QED
3326
3327(* NOTE: added antecedent ‘0 < a’ under the new definition *)
3328Theorem RPOW_ADD :
3329 !a b c. 0 < a ==> a rpow (b + c)= (a rpow b)*(a rpow c)
3330Proof
3331 RW_TAC std_ss [rpow, EXP_ADD, REAL_RDISTRIB]
3332QED
3333
3334(* NOTE: added antecedent ‘0 < a’ under the new definition *)
3335Theorem RPOW_ADD_MUL :
3336 !a b c. 0 < a ==> a rpow (b + c)* a rpow (-b)= (a rpow c)
3337Proof
3338 RW_TAC std_ss [rpow, REAL_RDISTRIB, GSYM EXP_ADD]THEN
3339 KNOW_TAC`` ((b * ln a + c * ln a + -b * ln a)=(b * ln a -b * ln a + c*ln a)) ``THEN1
3340 REAL_ARITH_TAC THEN
3341 DISCH_TAC THEN ASM_REWRITE_TAC[] THEN POP_ASSUM K_TAC THEN
3342 KNOW_TAC``((b * ln a - b * ln a + c * ln a) = (c*ln a )) ``THEN1
3343 REAL_ARITH_TAC THEN
3344 RW_TAC real_ss []
3345QED
3346
3347(* NOTE: added antecedent ‘0 < a’ under the new definition *)
3348Theorem RPOW_SUB :
3349 !a b c. 0 < a ==> a rpow (b - c) = (a rpow b)/(a rpow c)
3350Proof
3351 RW_TAC std_ss [rpow, REAL_SUB_RDISTRIB, EXP_SUB]
3352QED
3353
3354Theorem RPOW_DIV :
3355 !a b c. 0 < a /\ 0 < b ==> ((a/b) rpow c = (a rpow c)/(b rpow c))
3356Proof
3357 rpt STRIP_TAC
3358 >> ‘0 < a / b’ by PROVE_TAC [REAL_LT_DIV]
3359 >> RW_TAC std_ss [rpow, LN_DIV, REAL_SUB_LDISTRIB, EXP_SUB]
3360QED
3361
3362Theorem RPOW_INV:
3363 !a b. 0 < a ==> (inv a) rpow b = inv (a rpow b)
3364Proof
3365 RW_TAC real_ss [rpow, REAL_INV_1OVER, LN_DIV, REAL_SUB_LDISTRIB, EXP_SUB, LN_1, EXP_0]
3366QED
3367
3368Theorem RPOW_MUL :
3369 !a b c. 0 < a /\ 0 < b ==> (((a*b) rpow c) = (a rpow c)*(b rpow c))
3370Proof
3371 rpt STRIP_TAC
3372 >> ‘0 < a * b’ by PROVE_TAC [REAL_LT_MUL]
3373 >> RW_TAC std_ss [rpow, LN_MUL, REAL_LDISTRIB, EXP_ADD]
3374QED
3375
3376Theorem RPOW_RPOW :
3377 !a b c. 0 < a ==> ((a rpow b) rpow c = a rpow (b*c))
3378Proof
3379 rpt STRIP_TAC
3380 >> ‘0 < a powr b’ by PROVE_TAC [RPOW_POS_LT]
3381 >> RW_TAC real_ss [rpow, LN_EXP, REAL_MUL_ASSOC]
3382 >> PROVE_TAC [REAL_MUL_COMM]
3383QED
3384
3385Theorem RPOW_LT :
3386 !(a:real) (b:real) (c:real). 1 < a ==> (a rpow b < a rpow c <=> b < c)
3387Proof
3388 rpt STRIP_TAC
3389 >> ‘0 < a’ by PROVE_TAC [REAL_LT_TRANS, REAL_LT_01]
3390 >> RW_TAC std_ss [rpow]
3391 >> KNOW_TAC ``exp (b * ln a) < exp (c * ln a) <=> (b*ln a < c*ln a)``
3392 >- RW_TAC real_ss [EXP_MONO_LT] THEN
3393 DISCH_TAC THEN ASM_REWRITE_TAC[] THEN POP_ASSUM K_TAC THEN
3394 KNOW_TAC``((b:real)*ln a < (c:real)*ln a) <=> (b < c)`` THENL [
3395 MATCH_MP_TAC REAL_LT_RMUL THEN
3396 KNOW_TAC``0 < ln a <=> exp (0) < exp (ln a)`` THEN1
3397 PROVE_TAC[EXP_MONO_LT] THEN
3398 DISCH_TAC THEN
3399 FULL_SIMP_TAC real_ss[] THEN
3400 RW_TAC real_ss [EXP_0] THEN
3401 KNOW_TAC``1 < (a:real) ==> 0 <(a:real)`` THENL [
3402 RW_TAC real_ss [] THEN
3403 MATCH_MP_TAC REAL_LT_TRANS THEN
3404 EXISTS_TAC``(1:real)`` THEN
3405 RW_TAC real_ss [],
3406 RW_TAC real_ss [] THEN
3407 KNOW_TAC``exp (ln a)=(a:real)`` THEN1
3408 RW_TAC real_ss [EXP_LN] THEN
3409 DISCH_TAC THEN ASM_REWRITE_TAC[]],
3410 RW_TAC real_ss []]
3411QED
3412
3413Theorem RPOW_LE :
3414 !a b c. 1 < a ==> (a rpow b <= a rpow c <=> b <= c)
3415Proof
3416 rpt STRIP_TAC
3417 >> ‘0 < a’ by PROVE_TAC [REAL_LT_TRANS, REAL_LT_01]
3418 >> RW_TAC std_ss [rpow] THEN
3419 KNOW_TAC ``exp ((b:real) * ln a) <= exp ((c:real) * ln a) <=>
3420 ((b:real)*ln a <= (c:real)*ln a)`` THEN1
3421 RW_TAC real_ss [EXP_MONO_LE] THEN
3422 DISCH_TAC THEN ASM_REWRITE_TAC[] THEN POP_ASSUM K_TAC THEN
3423 KNOW_TAC``(b*ln a <= c*ln a) <=> ((b:real) <= (c:real))`` THENL[
3424 MATCH_MP_TAC REAL_LE_RMUL THEN
3425 KNOW_TAC``0 < ln a <=> exp (0) < exp (ln a)`` THEN1
3426 PROVE_TAC[EXP_MONO_LT] THEN
3427 DISCH_TAC THEN
3428 FULL_SIMP_TAC real_ss[] THEN
3429 RW_TAC real_ss [EXP_0] THEN
3430 KNOW_TAC``1 < (a:real) ==> 0 <(a:real)`` THENL[
3431 RW_TAC real_ss [] THEN
3432 MATCH_MP_TAC REAL_LT_TRANS THEN
3433 EXISTS_TAC``(1:real)`` THEN
3434 RW_TAC real_ss [] ,
3435 RW_TAC real_ss [] THEN
3436 KNOW_TAC``exp (ln a)=(a:real)`` THEN1
3437 RW_TAC real_ss [EXP_LN] THEN
3438 DISCH_TAC THEN ASM_REWRITE_TAC[]],
3439 RW_TAC real_ss []]
3440QED
3441
3442Theorem BASE_RPOW_LE :
3443 !a b c. 0 < a /\ 0 < c /\ 0 < b ==> (a rpow b <= c rpow b <=> a <= c)
3444Proof
3445RW_TAC std_ss [rpow, EXP_MONO_LE] THEN
3446KNOW_TAC`` (((b:real) * ln a) <= ((b:real) * ln c)) <=> ((ln a <= ln c))`` THENL[
3447 MATCH_MP_TAC REAL_LE_LMUL THEN
3448 RW_TAC real_ss [],
3449
3450 DISCH_TAC THEN ASM_REWRITE_TAC[] THEN POP_ASSUM K_TAC THEN
3451 RW_TAC real_ss [LN_MONO_LE]]
3452QED
3453
3454Theorem BASE_RPOW_LT :
3455 !a b c. 0 < a /\ 0 < c /\ 0 < b ==> (a rpow b < c rpow b <=> a < c)
3456Proof
3457 RW_TAC std_ss [rpow, EXP_MONO_LT] THEN
3458 KNOW_TAC ``((b * ln a) < (b * ln c)) <=> ln a < ln c`` THENL[
3459 MATCH_MP_TAC REAL_LT_LMUL THEN
3460 RW_TAC real_ss [],
3461
3462 DISCH_TAC THEN ASM_REWRITE_TAC[] THEN POP_ASSUM K_TAC THEN
3463 RW_TAC real_ss [LN_MONO_LT] ]
3464QED
3465
3466Theorem RPOW_UNIQ_BASE :
3467 !a b c. 0 < a /\ 0 < c /\ 0 <> b /\ (a rpow b = c rpow b) ==> (a = c)
3468Proof
3469 rpt STRIP_TAC
3470 >> rfs [rpow, GSYM LN_INJ]
3471 >> POP_ASSUM MP_TAC
3472 >> KNOW_TAC ``(exp (b * ln a) = exp (b * ln c)) <=>
3473 (ln (exp (b * ln a)) = ln (exp (b * ln c)))``THEN1
3474 PROVE_TAC[LN_EXP]THEN
3475 DISCH_TAC THEN ASM_REWRITE_TAC[] THEN POP_ASSUM K_TAC THEN
3476 FULL_SIMP_TAC real_ss[LN_EXP] THEN
3477 FULL_SIMP_TAC real_ss[REAL_EQ_MUL_LCANCEL]
3478QED
3479
3480Theorem RPOW_UNIQ_EXP :
3481 !a b c. 1 < a /\ 0 < c /\ 0 < b /\ (a rpow b = a rpow c) ==> (b = c)
3482Proof
3483 rpt STRIP_TAC
3484 >> ‘0 < a’ by PROVE_TAC [REAL_LT_TRANS, REAL_LT_01]
3485 >> fs [rpow, GSYM LN_INJ]
3486 >> Q.PAT_X_ASSUM ‘exp (b * ln a) = exp (c * ln a)’ MP_TAC
3487 >> KNOW_TAC ``(exp (b * ln a) = exp (c * ln a)) <=>
3488 (ln (exp (b * ln a)) = ln (exp (c * ln a)))`` THEN1
3489 PROVE_TAC[LN_EXP] THEN
3490 DISCH_TAC THEN ASM_REWRITE_TAC[] THEN POP_ASSUM K_TAC THEN
3491 FULL_SIMP_TAC real_ss[LN_EXP] THEN
3492 FULL_SIMP_TAC real_ss[REAL_EQ_RMUL] THEN
3493 KNOW_TAC``(1 < (a:real))==> 0 < ln a`` THENL[
3494 RW_TAC real_ss [] THEN
3495 KNOW_TAC``0 < ln a <=> exp (0) < exp (ln a)`` THEN1
3496 PROVE_TAC[EXP_MONO_LT] THEN
3497 DISCH_TAC THEN
3498 FULL_SIMP_TAC real_ss[] THEN
3499 RW_TAC real_ss [EXP_0] THEN
3500 KNOW_TAC``1 < (a:real) ==> 0 <(a:real)`` THENL[
3501 RW_TAC real_ss [] THEN
3502 MATCH_MP_TAC REAL_LT_TRANS THEN
3503 EXISTS_TAC``(1:real)`` THEN
3504 RW_TAC real_ss [] ,
3505 RW_TAC real_ss [] THEN
3506 KNOW_TAC``exp (ln a)=(a:real)`` THEN1
3507 RW_TAC real_ss [EXP_LN] THEN
3508 DISCH_TAC THEN ASM_REWRITE_TAC[] THEN RW_TAC real_ss []],
3509 FULL_SIMP_TAC real_ss[REAL_POS_NZ] ]
3510QED
3511
3512Theorem RPOW_DIV_BASE :
3513 !x t. 0 < x ==> ((x rpow t)/x = x rpow (t-1))
3514Proof
3515RW_TAC std_ss [rpow, REAL_SUB_RDISTRIB, EXP_SUB, REAL_MUL_LID] THEN
3516KNOW_TAC``exp(ln x)= (x:real)`` THEN1
3517 PROVE_TAC[EXP_LN] THEN
3518DISCH_TAC THEN ASM_REWRITE_TAC []
3519QED
3520
3521(* Convert ‘root’ to ‘rpow’,
3522 NOTE: hol-light's version is more general: ‘0 <= x \/ ODD n’
3523 *)
3524Theorem REAL_ROOT_RPOW :
3525 !n x. ~(n = 0) /\ &0 < x ==> root n x = x rpow inv (&n)
3526Proof
3527 rpt STRIP_TAC
3528 >> Cases_on ‘n’ >- fs []
3529 >> rename1 ‘SUC n <> 0’
3530 >> rw [ROOT_LN, rpow, real_div]
3531QED
3532
3533Theorem SQRT_RPOW :
3534 !(x :real). 0 < x ==> sqrt x = x rpow (inv 2)
3535Proof
3536 rw [sqrt, REAL_ROOT_RPOW]
3537QED
3538
3539(*----------------------------------------------------------------*)
3540(* Differentiability of real powers *)
3541(*----------------------------------------------------------------*)
3542
3543Theorem DIFF_COMPOSITE_EXP :
3544 !g m x. ((g diffl m) x ==> ((\x. exp (g x)) diffl (exp (g x) * m)) x)
3545Proof
3546 RW_TAC std_ss [DIFF_COMPOSITE]
3547QED
3548
3549Theorem DIFF_RPOW :
3550 !x y. 0 < x ==> ((\x. x rpow y) diffl (y * (x rpow (y - 1)))) x
3551Proof
3552 RW_TAC real_ss [rpow, GSYM RPOW_DIV_BASE]
3553 (* eliminate ‘rpow’ by LIM_TRANSFORM_WITHIN_OPEN_EQ *)
3554 >> qabbrev_tac ‘l = y * (exp (y * ln x) / x)’
3555 >> Know ‘((\x. x powr y) diffl l) x <=> ((\x. exp (y * ln x)) diffl l) x’
3556 >- (REWRITE_TAC [diffl, GSYM LIM_AT_LIM] \\
3557 Q.ABBREV_TAC ‘f = \z. (z powr y - x powr y) / (z - x)’ \\
3558 ‘(\h. ((x + h) powr y - x powr y) / h) = (\h. f (x + h))’
3559 by simp [FUN_EQ_THM, Abbr ‘f’, REAL_ADD_SUB] >> POP_ORW \\
3560 Q.ABBREV_TAC ‘g = \z. (exp (y * ln z) - exp (y * ln x)) / (z - x)’ \\
3561 ‘(\h. (exp (y * ln (x + h)) - exp (y * ln x)) / h) = (\h. g (x + h))’
3562 by simp [FUN_EQ_THM, Abbr ‘g’, REAL_ADD_SUB] >> POP_ORW \\
3563 MATCH_MP_TAC LIM_TRANSFORM_WITHIN_OPEN_EQ >> simp [] \\
3564 Q.EXISTS_TAC ‘{y | -x < y}’ >> simp [OPEN_INTERVAL_RIGHT] \\
3565 Q.X_GEN_TAC ‘z’ >> rw [] \\
3566 ‘0 < x + z’ by (Q.PAT_X_ASSUM ‘-x < z’ MP_TAC >> REAL_ARITH_TAC) \\
3567 rw [Abbr ‘f’, Abbr ‘g’, REAL_ADD_SUB] \\
3568 rw [rpow_def])
3569 >> Rewr'
3570 >> qunabbrev_tac ‘l’
3571 (* below is the old proof *)
3572 >> RW_TAC real_ss [REAL_MUL_ASSOC,real_div,REAL_MUL_COMM]
3573 >> RW_TAC real_ss [GSYM real_div]
3574 >> Know ‘!x'. exp ((y * ln x')) = exp ((\x'. y * ln x') x')’
3575 >- RW_TAC real_ss []
3576 >> Rewr'
3577 >> Know ‘(y/x) * exp ((\x'. y * ln x') x) = exp ((\x'. y * ln x') x) * (y/x)’
3578 >- RW_TAC std_ss [REAL_MUL_COMM]
3579 >> Rewr'
3580 >> MATCH_MP_TAC DIFF_COMPOSITE_EXP
3581 >> Know ‘((\x. y * ln x) diffl (y/x)) x = ((\x. y * (\x.ln x) x) diffl (y/x)) x’
3582 >- RW_TAC real_ss []
3583 >> Rewr'
3584 >> RW_TAC real_ss [real_div]
3585 >> MATCH_MP_TAC DIFF_CMUL
3586 >> MATCH_MP_TAC DIFF_LN
3587 >> RW_TAC real_ss []
3588QED
3589
3590Theorem lem[local] :
3591 !n:num. 0 < n ==> ~(n=0)
3592Proof
3593 INDUCT_TAC THEN ASM_REWRITE_TAC [NOT_SUC,NOT_LESS_0]
3594QED
3595
3596val real_pow = pow;
3597val REAL_POW_2 = POW_2;
3598val REAL_INV_1 = REAL_INV1;
3599
3600Theorem MCLAURIN_LN_POS :
3601 !x n.
3602 &0 < x /\ 0 < n
3603 ==> ?t. &0 < t /\
3604 t < x /\
3605 (ln(&1 + x)
3606 = sum(0,n) (\m. ~(&1) pow (SUC m) * (x pow m) / &m)
3607 +
3608 ~(&1) pow (SUC n) * x pow n / (&n * (&1 + t) pow n))
3609Proof
3610 REPEAT STRIP_TAC THEN
3611 MP_TAC(SPEC (Term`\x. ln(&1 + x)`) MCLAURIN) THEN
3612 DISCH_THEN(MP_TAC o SPEC
3613 (Term`\n x. if (n=0) then ln(&1 + x)
3614 else ~(&1) pow (SUC n)
3615 * &(FACT(PRE n)) * inv((&1 + x) pow n)`)) THEN
3616 DISCH_THEN(MP_TAC o SPECL [Term`x:real`, Term`n:num`]) THEN
3617 BETA_TAC THEN ASM_REWRITE_TAC[] THEN
3618 REWRITE_TAC[NOT_SUC, REAL_ADD_RID, POW_ONE, LN_1, REAL_INV1,REAL_MUL_RID] THEN
3619 SUBGOAL_THEN (Term`~((n :num) = 0)`) ASSUME_TAC THENL
3620 [IMP_RES_TAC lem, ASM_REWRITE_TAC[]] THEN
3621 SUBGOAL_THEN (Term`!p. ~(p = 0) ==> (&(FACT(PRE p)) / &(FACT p) = inv(&p))`)
3622 ASSUME_TAC THENL
3623 [INDUCT_TAC THEN REWRITE_TAC[NOT_SUC, PRE] THEN
3624 REWRITE_TAC[real_div, FACT, GSYM REAL_OF_NUM_MUL] THEN
3625 SUBGOAL_THEN (Term `~(& (SUC p) = &0) /\ ~(& (FACT p) = &0)`)
3626 (fn th => REWRITE_TAC [MATCH_MP REAL_INV_MUL th]) THENL
3627 [REWRITE_TAC[REAL_OF_NUM_EQ,NOT_SUC] THEN MATCH_MP_TAC lem THEN
3628 MATCH_ACCEPT_TAC FACT_LESS,
3629 ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
3630 GEN_REWRITE_TAC RAND_CONV empty_rewrites [GSYM REAL_MUL_RID] THEN
3631 REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN
3632 AP_TERM_TAC THEN MATCH_MP_TAC REAL_MUL_LINV THEN
3633 REWRITE_TAC[REAL_OF_NUM_EQ] THEN MATCH_MP_TAC lem THEN
3634 MATCH_ACCEPT_TAC FACT_LESS], ALL_TAC] THEN
3635 SUBGOAL_THEN (Term
3636 `!p. (if p = 0 then &0 else ~(&1) pow (SUC p) * &(FACT (PRE p)))
3637 / &(FACT p)
3638 =
3639 ~(&1) pow (SUC p) * inv(&p)`)
3640 (fn th => REWRITE_TAC[th]) THENL
3641 [INDUCT_TAC THENL
3642 [REWRITE_TAC[REAL_INV_0, real_div, REAL_MUL_LZERO, REAL_MUL_RZERO],
3643 REWRITE_TAC[NOT_SUC] THEN
3644 REWRITE_TAC[real_div, GSYM REAL_MUL_ASSOC] THEN
3645 AP_TERM_TAC THEN REWRITE_TAC[GSYM real_div] THEN
3646 FIRST_ASSUM MATCH_MP_TAC THEN
3647 REWRITE_TAC[NOT_SUC]], ALL_TAC] THEN
3648 SUBGOAL_THEN (Term
3649 `!t. ((~(&1) pow (SUC n) * &(FACT(PRE n)) * inv ((&1 + t) pow n))
3650 / &(FACT n)) * x pow n
3651 =
3652 ~(&1) pow (SUC n) * x pow n / (&n * (&1 + t) pow n)`)
3653 (fn th => REWRITE_TAC[th]) THENL
3654 [GEN_TAC THEN REWRITE_TAC[real_div, GSYM REAL_MUL_ASSOC] THEN
3655 AP_TERM_TAC THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN
3656 GEN_REWRITE_TAC LAND_CONV empty_rewrites [REAL_MUL_SYM] THEN AP_TERM_TAC THEN
3657 REWRITE_TAC [REAL_INV_MUL'] THEN
3658 GEN_REWRITE_TAC LAND_CONV empty_rewrites [REAL_MUL_SYM] THEN
3659 REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN
3660 ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN
3661 FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[], ALL_TAC] THEN
3662
3663 rw [real_div] THEN POP_ASSUM MATCH_MP_TAC THEN
3664 qx_genl_tac [`m`, `u`] THEN STRIP_TAC THEN
3665
3666 Cases_on `m = 0` THEN ASM_REWRITE_TAC[] THENL
3667 [ (* goal 1 (of 2) *)
3668 W(MP_TAC o Q.SPEC `u:real` o DIFF_CONV o lhand o rator o snd) THEN
3669 REWRITE_TAC[PRE, real_pow, REAL_ADD_LID, REAL_MUL_RID] THEN
3670 REWRITE_TAC[REAL_MUL_RNEG, REAL_MUL_LNEG, REAL_MUL_RID] THEN
3671 REWRITE_TAC[FACT, REAL_MUL_RID, REAL_MUL_LID, REAL_NEG_NEG] THEN
3672 DISCH_THEN MATCH_MP_TAC THEN
3673 Q.UNDISCH_TAC `&0 <= u` THEN REAL_ARITH_TAC,
3674 (* goal 2 (of 2) *)
3675 W(MP_TAC o Q.SPEC `u:real` o DIFF_CONV o lhand o rator o snd) THEN
3676 Q.SUBGOAL_THEN `~((&1 + u) pow m = &0)` (fn th => REWRITE_TAC[th]) THENL
3677 [ REWRITE_TAC[REAL_POW_EQ_0] THEN ASM_REWRITE_TAC[] THEN
3678 Q.UNDISCH_TAC `&0 <= u` THEN REAL_ARITH_TAC,
3679 MATCH_MP_TAC (TAUT_CONV “(a <=> b) ==> a ==> b”) THEN
3680 AP_THM_TAC THEN AP_TERM_TAC THEN
3681 REWRITE_TAC[REAL_MUL_LZERO, REAL_ADD_RID] THEN
3682 REWRITE_TAC[REAL_ADD_LID, REAL_MUL_RID] THEN
3683 REWRITE_TAC[real_div, real_pow, REAL_MUL_LNEG, REAL_MUL_RNEG] THEN
3684 REWRITE_TAC[REAL_NEG_NEG, REAL_MUL_RID, REAL_MUL_LID] THEN
3685 REWRITE_TAC[REAL_MUL_ASSOC] THEN
3686 Know ‘&FACT m * -1 pow m * inv ((1 + u) * (1 + u) pow m) =
3687 &FACT m * inv ((1 + u) * (1 + u) pow m) * -1 pow m’
3688 >- (METIS_TAC [REAL_MUL_COMM, REAL_MUL_ASSOC]) THEN
3689 DISCH_THEN (fn th => ONCE_REWRITE_TAC [th]) THEN
3690 AP_THM_TAC THEN AP_TERM_TAC THEN
3691 Q.UNDISCH_TAC `~(m = 0)` THEN Q.SPEC_TAC(`m:num`,`p:num`) THEN
3692 INDUCT_TAC THEN REWRITE_TAC[NOT_SUC] THEN
3693 REWRITE_TAC[SUC_SUB1, PRE] THEN REWRITE_TAC[FACT] THEN
3694 REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN
3695 REWRITE_TAC[REAL_MUL_ASSOC] THEN
3696 Know ‘&SUC p * &FACT p * inv ((1 + u) * (1 + u) pow SUC p) =
3697 &SUC p * inv ((1 + u) * (1 + u) pow SUC p) * &FACT p’
3698 >- (METIS_TAC [REAL_MUL_COMM, REAL_MUL_ASSOC]) THEN
3699 DISCH_THEN (fn th => ONCE_REWRITE_TAC [th]) THEN
3700 AP_THM_TAC THEN AP_TERM_TAC THEN
3701 REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN
3702 REWRITE_TAC[real_pow, REAL_POW_2] THEN REWRITE_TAC[REAL_INV_MUL'] THEN
3703
3704 REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN
3705 REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN
3706 ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
3707 GEN_REWRITE_TAC RAND_CONV empty_rewrites [GSYM REAL_MUL_LID] THEN
3708 REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN
3709 MATCH_MP_TAC REAL_MUL_LINV THEN
3710 REWRITE_TAC[REAL_POW_EQ_0] THEN ASM_REWRITE_TAC[] THEN
3711 REWRITE_TAC[DE_MORGAN_THM] THEN DISJ1_TAC THEN
3712 Q.UNDISCH_TAC `&0 <= u` THEN REAL_ARITH_TAC ] ]
3713QED
3714
3715Theorem MCLAURIN_LN_NEG :
3716 !x n. &0 < x /\ x < &1 /\ 0 < n
3717 ==> ?t. &0 < t /\
3718 t < x /\
3719 (~(ln(&1 - x)) = sum (0,n) (\m. (x pow m) / &m) +
3720 x pow n / (&n * (&1 - t) pow n))
3721Proof
3722 REPEAT STRIP_TAC THEN
3723 MP_TAC(Q.SPEC `\x. ~(ln(&1 - x))` MCLAURIN) THEN BETA_TAC THEN
3724 DISCH_THEN(MP_TAC o Q.SPEC
3725 `\n x. if n = 0 then ~(ln(&1 - x))
3726 else &(FACT(PRE n)) * inv((&1 - x) pow n)`) THEN
3727 DISCH_THEN(MP_TAC o Q.SPECL [`x:real`, `n:num`]) THEN BETA_TAC THEN
3728
3729 ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_SUB_RZERO] THEN
3730 REWRITE_TAC[NOT_SUC, LN_1, POW_ONE] THEN
3731 Q.SUBGOAL_THEN `~(n = 0)` ASSUME_TAC THENL
3732 [Q.UNDISCH_TAC `0 < n` THEN ARITH_TAC, ASM_REWRITE_TAC[]] THEN
3733 REWRITE_TAC[REAL_INV_1, REAL_MUL_RID, REAL_MUL_LID] THEN
3734 Q.SUBGOAL_THEN `!p. ~(p = 0) ==> (&(FACT(PRE p)) / &(FACT p) = inv(&p))`
3735 ASSUME_TAC THENL
3736 [INDUCT_TAC THEN REWRITE_TAC[NOT_SUC, PRE] THEN
3737 REWRITE_TAC[real_div, FACT, GSYM REAL_OF_NUM_MUL] THEN
3738 REWRITE_TAC[REAL_INV_MUL'] THEN
3739 ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
3740 GEN_REWRITE_TAC RAND_CONV empty_rewrites [GSYM REAL_MUL_RID] THEN
3741 REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN
3742 AP_TERM_TAC THEN MATCH_MP_TAC REAL_MUL_LINV THEN
3743 REWRITE_TAC[REAL_OF_NUM_EQ] THEN
3744 MP_TAC(Q.SPEC `p:num` FACT_LESS) THEN ARITH_TAC, ALL_TAC] THEN
3745 REWRITE_TAC[REAL_NEG_0] THEN
3746 Q.SUBGOAL_THEN `!p. (if p = 0 then &0 else &(FACT (PRE p))) / &(FACT p) =
3747 inv(&p)`
3748 (fn th => REWRITE_TAC[th]) THENL
3749 [INDUCT_TAC THENL
3750 [REWRITE_TAC[REAL_INV_0, real_div, REAL_MUL_LZERO],
3751 REWRITE_TAC[NOT_SUC] THEN FIRST_ASSUM MATCH_MP_TAC THEN
3752 REWRITE_TAC[NOT_SUC]], ALL_TAC] THEN
3753 Q.SUBGOAL_THEN
3754 `!t. (&(FACT(PRE n)) * inv ((&1 - t) pow n)) / &(FACT n) * x pow n
3755 = x pow n / (&n * (&1 - t) pow n)`
3756 (fn th => REWRITE_TAC[th]) THENL
3757 [GEN_TAC THEN REWRITE_TAC[real_div, REAL_MUL_ASSOC] THEN
3758 GEN_REWRITE_TAC LAND_CONV empty_rewrites [REAL_MUL_SYM] THEN AP_TERM_TAC THEN
3759 REWRITE_TAC[REAL_INV_MUL'] THEN
3760 GEN_REWRITE_TAC LAND_CONV empty_rewrites [REAL_MUL_SYM] THEN
3761 REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN
3762 ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN
3763 FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[], ALL_TAC] THEN
3764 REWRITE_TAC[real_div] THEN
3765 Know ‘!m. inv (&m) * x pow m = x pow m * inv (&m)’
3766 >- METIS_TAC [REAL_MUL_COMM] >> DISCH_THEN (fn th => ONCE_REWRITE_TAC [th]) THEN
3767 DISCH_THEN MATCH_MP_TAC THEN
3768 qx_genl_tac [`m:num`, `u:real`] THEN STRIP_TAC THEN
3769 Cases_on `m = 0` THEN ASM_REWRITE_TAC[] THENL
3770 [ (* goal 1 (of 2) *)
3771 W(MP_TAC o Q.SPEC `u` o DIFF_CONV o lhand o rator o snd) THEN
3772 REWRITE_TAC[PRE, pow, FACT, REAL_SUB_LZERO] THEN
3773 REWRITE_TAC[REAL_MUL_RNEG, REAL_NEG_NEG, REAL_MUL_RID, REAL_MUL_LID] THEN
3774 DISCH_THEN MATCH_MP_TAC THEN
3775 Know ‘u < 1’ >- PROVE_TAC [REAL_LET_TRANS] THEN
3776 REAL_ARITH_TAC,
3777 (* goal 2 (of 2) *)
3778 W(MP_TAC o Q.SPEC `u:real` o DIFF_CONV o lhand o rator o snd) THEN
3779 Q.SUBGOAL_THEN `~((&1 - u) pow m = &0)` (fn th => REWRITE_TAC[th]) THENL
3780 [ REWRITE_TAC[REAL_POW_EQ_0] THEN ASM_REWRITE_TAC[] THEN
3781 Q.UNDISCH_TAC `x < &1` THEN Q.UNDISCH_TAC `u:real <= x` THEN
3782 REAL_ARITH_TAC,
3783 MATCH_MP_TAC (TAUT_CONV “(a <=> b) ==> a ==> b”) THEN
3784 AP_THM_TAC THEN AP_TERM_TAC THEN
3785 REWRITE_TAC[REAL_SUB_LZERO, real_div, PRE] THEN
3786 REWRITE_TAC[REAL_MUL_LZERO, REAL_ADD_RID, REAL_ADD_LID] THEN
3787 REWRITE_TAC
3788 [REAL_MUL_RNEG, REAL_MUL_LNEG, REAL_NEG_NEG, REAL_MUL_RID] THEN
3789 Q.UNDISCH_TAC `~(m = 0)` THEN Q.SPEC_TAC(`m:num`,`p:num`) THEN
3790 INDUCT_TAC THEN REWRITE_TAC[NOT_SUC] THEN
3791 REWRITE_TAC[SUC_SUB1, PRE] THEN REWRITE_TAC[FACT] THEN
3792 REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN
3793 REWRITE_TAC[REAL_MUL_ASSOC] THEN
3794 Know ‘&SUC p * &FACT p * inv ((1 - u) pow SUC (SUC p)) =
3795 &SUC p * inv ((1 - u) pow SUC (SUC p)) * &FACT p’
3796 >- (METIS_TAC [REAL_MUL_COMM, REAL_MUL_ASSOC]) THEN
3797 DISCH_THEN (fn th => ONCE_REWRITE_TAC [th]) THEN
3798 AP_THM_TAC THEN AP_TERM_TAC THEN
3799 REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN
3800 REWRITE_TAC[real_pow, REAL_POW_2] THEN REWRITE_TAC[REAL_INV_MUL'] THEN
3801 REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN
3802 REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN
3803 ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
3804 GEN_REWRITE_TAC RAND_CONV empty_rewrites [GSYM REAL_MUL_LID] THEN
3805 REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN
3806 MATCH_MP_TAC REAL_MUL_LINV THEN
3807 REWRITE_TAC[REAL_POW_EQ_0] THEN ASM_REWRITE_TAC[] THEN
3808 Q.UNDISCH_TAC `x < &1` THEN Q.UNDISCH_TAC `u:real <= x` THEN
3809 REAL_ARITH_TAC ] ]
3810QED
3811
3812(* ------------------------------------------------------------------------- *)
3813(* ----------- exp is a convex function (from "miller" example) ------------ *)
3814(* ------------------------------------------------------------------------- *)
3815
3816Theorem exp_convex_lemma1[local]:
3817 !t. (t + (1 - t) * exp 0 - exp ((1 - t) * 0) = 0) /\
3818 (t * exp 0 + (1 - t) - exp (t * 0) = 0)
3819Proof
3820 RW_TAC real_ss [EXP_0] >> REAL_ARITH_TAC
3821QED
3822
3823Theorem exp_convex_lemma2[local]:
3824 !t x. ((\x. (1 - t) * exp x - exp ((1 - t) * x)) diffl
3825 (\x. (1-t) * exp x - (1 - t)*exp ((1-t)*x)) x) x
3826Proof
3827 RW_TAC std_ss []
3828 >> `(\x. (1 - t) * exp x - exp ((1 - t) * x)) =
3829 (\x. (\x. (1 - t) * exp x) x - (\x. exp ((1 - t) * x)) x)`
3830 by RW_TAC std_ss [FUN_EQ_THM]
3831 >> POP_ASSUM (fn thm => ONCE_REWRITE_TAC [thm])
3832 >> `((1 - t) * exp x - (1 - t) * exp ((1 - t) * x)) =
3833 (\x. (1 - t) * exp x) x - (\x. (1-t) * exp ((1- t) * x)) x`
3834 by RW_TAC std_ss []
3835 >> POP_ASSUM (fn thm => ONCE_REWRITE_TAC [thm])
3836 >> Suff `((\x. (1 - t) * exp x) diffl (\x. (1 - t) * exp x) x) x /\
3837 ((\x. exp ((1 - t) * x)) diffl (\x. (1 - t) * exp ((1 - t) * x)) x) x`
3838 >- METIS_TAC [DIFF_SUB]
3839 >> CONJ_TAC
3840 >- (`(\x. (1 - t) * exp x) x = 0 * exp x + (exp x) * (\x. 1 - t) x` by RW_TAC real_ss [REAL_MUL_COMM]
3841 >> POP_ASSUM (fn thm => ONCE_REWRITE_TAC [thm])
3842 >> Q.ABBREV_TAC `foo = (0 * exp x + exp x * (\x. 1 - t) x)`
3843 >> `(\x. (1 - t) * exp x) = (\x. (\x. 1 - t) x * exp x)` by RW_TAC std_ss [FUN_EQ_THM]
3844 >> POP_ASSUM (fn thm => ONCE_REWRITE_TAC [thm])
3845 >> Q.UNABBREV_TAC `foo`
3846 >> MATCH_MP_TAC DIFF_MUL
3847 >> RW_TAC std_ss [DIFF_CONST, DIFF_EXP])
3848 >> `(\x. exp ((1 - t) * x)) = (\x. exp ((\x. (1-t)*x) x))` by RW_TAC std_ss [FUN_EQ_THM]
3849 >> POP_ASSUM (fn thm => ONCE_REWRITE_TAC [thm])
3850 >> `(\x. (1 - t) * exp ((1 - t) * x)) x = exp ((\x. (1-t)*x) x) * (1-t)`
3851 by RW_TAC real_ss [REAL_MUL_COMM]
3852 >> POP_ASSUM (fn thm => ONCE_REWRITE_TAC [thm])
3853 >> Suff `((\x. (1 - t) * x) diffl (1-t)) x` >- METIS_TAC [DIFF_COMPOSITE]
3854 >> `(1 - t) = (1 - t) * 1` by RW_TAC real_ss []
3855 >> POP_ASSUM (fn thm => ONCE_REWRITE_TAC [thm])
3856 >> `(\x. (1 - t) * 1 * x) = (\x. (1-t) * (\x. x) x)` by RW_TAC real_ss [FUN_EQ_THM]
3857 >> POP_ASSUM (fn thm => ONCE_REWRITE_TAC [thm])
3858 >> MATCH_MP_TAC DIFF_CMUL
3859 >> RW_TAC std_ss [DIFF_X]
3860QED
3861
3862Theorem exp_convex_lemma3[local]:
3863 !t x. (\x. (1-t) * exp x - exp ((1-t)*x)) contl x
3864Proof
3865 METIS_TAC [DIFF_CONT, exp_convex_lemma2]
3866QED
3867
3868Theorem exp_convex_lemma4[local]:
3869 !x. 0 < x /\ 0 < t /\ t < 1 ==> 0 < (\x. (1-t) * exp x - (1 - t)*exp ((1-t)*x)) x
3870Proof
3871 RW_TAC real_ss [REAL_LT_SUB_LADD] >> MATCH_MP_TAC REAL_LT_LMUL_IMP
3872 >> RW_TAC real_ss [REAL_LT_SUB_LADD, EXP_MONO_LT, REAL_SUB_RDISTRIB]
3873 >> RW_TAC real_ss [REAL_LT_SUB_RADD, REAL_LT_ADDR] >> MATCH_MP_TAC REAL_LT_MUL
3874 >> RW_TAC real_ss []
3875QED
3876
3877Theorem exp_convex_lemma5[local]:
3878 !f f' i j. (!x. (f diffl f' x) x) /\
3879 (!x. f contl x) /\
3880 (0 <= i /\ i < j) /\
3881 (!x. i < x /\ x < j ==> 0 < f' x) ==>
3882 f i < f j
3883Proof
3884 REPEAT STRIP_TAC
3885 >> MATCH_MP_TAC REAL_LET_TRANS >> Q.EXISTS_TAC `0 + f i` >> CONJ_TAC >- RW_TAC real_ss []
3886 >> RW_TAC real_ss [GSYM REAL_LT_SUB_LADD]
3887 >> `?l z. i < z /\ z < j /\ (f diffl l) z /\ (f j - f i = (j - i) * l)`
3888 by (MATCH_MP_TAC MVT >> METIS_TAC [differentiable])
3889 >> POP_ASSUM (fn thm => ONCE_REWRITE_TAC [thm])
3890 >> MATCH_MP_TAC REAL_LT_MUL
3891 >> RW_TAC real_ss [REAL_LT_SUB_LADD]
3892 >> `l = f' z`
3893 by (MATCH_MP_TAC DIFF_UNIQ >> Q.EXISTS_TAC `f` >> Q.EXISTS_TAC `z` >> RW_TAC std_ss [])
3894 >> POP_ASSUM (fn thm => ONCE_REWRITE_TAC [thm])
3895 >> Q.PAT_X_ASSUM `!x. i < x /\ x < j ==> 0 < f' x` MATCH_MP_TAC >> RW_TAC std_ss []
3896QED
3897
3898Theorem exp_convex_lemma6[local]:
3899 !x y t. 0 < t /\ t < 1 /\ x < y ==>
3900 exp (t * x + (1 - t) * y) <= t * exp x + (1 - t) * exp y
3901Proof
3902 REPEAT STRIP_TAC
3903 >> Q.ABBREV_TAC `z = y - x`
3904 >> `0 < z` by (Q.UNABBREV_TAC `z` >> RW_TAC real_ss [REAL_LT_SUB_LADD])
3905 >> Suff `exp (t * x + (1 - t) * (x+z)) <= t * exp x + (1 - t) * exp (x+z)`
3906 >- (Q.UNABBREV_TAC `z` >> RW_TAC real_ss [])
3907 >> `t * x + (1 - t) * (x + z) = x + (1 - t) * z` by REAL_ARITH_TAC
3908 >> ASM_REWRITE_TAC [] >> POP_ASSUM (K ALL_TAC)
3909 >> PURE_REWRITE_TAC [EXP_ADD]
3910 >> `t * exp x + (1 - t) * (exp x * exp z) = exp x * (t + (1 - t) * exp z)`
3911 by REAL_ARITH_TAC
3912 >> ASM_REWRITE_TAC [] >> POP_ASSUM (K ALL_TAC)
3913 >> MATCH_MP_TAC REAL_LE_LMUL_IMP >> CONJ_TAC >- SIMP_TAC std_ss [EXP_POS_LE]
3914 >> MATCH_MP_TAC REAL_LE_TRANS >> Q.EXISTS_TAC `0 + exp ((1 - t) * z)` >> CONJ_TAC >- RW_TAC real_ss []
3915 >> ONCE_REWRITE_TAC [GSYM REAL_LE_SUB_LADD]
3916 >> MATCH_MP_TAC REAL_LT_IMP_LE
3917 >> MATCH_MP_TAC REAL_LET_TRANS >> Q.EXISTS_TAC `t + (1 - t) * exp 0 - exp ((1 - t) * 0)`
3918 >> CONJ_TAC >- RW_TAC real_ss [exp_convex_lemma1]
3919 >> `t + (1 - t) * exp 0 - exp ((1 - t) * 0) = ((1 - t) * exp 0 - exp ((1 - t) * 0)) + t`
3920 by REAL_ARITH_TAC >> ASM_REWRITE_TAC [] >> POP_ASSUM (K ALL_TAC)
3921 >> ONCE_REWRITE_TAC [REAL_LT_ADD_SUB]
3922 >> `t + (1 - t) * exp z - exp ((1 - t) * z) - t = (1 - t) * exp z - exp ((1 - t) * z)`
3923 by REAL_ARITH_TAC
3924 >> ASM_REWRITE_TAC [] >> POP_ASSUM (K ALL_TAC)
3925 >> Q.ABBREV_TAC `f = (\x. (1-t) * exp x - exp ((1-t)*x))`
3926 >> Suff `f 0 < f z` >- (Q.UNABBREV_TAC `f` >> RW_TAC std_ss [])
3927 >> MATCH_MP_TAC exp_convex_lemma5
3928 >> Q.EXISTS_TAC `(\x. (1-t) * exp x - (1 - t)*exp ((1-t)*x))`
3929 >> Q.UNABBREV_TAC `f`
3930 >> RW_TAC real_ss [exp_convex_lemma2, exp_convex_lemma3, exp_convex_lemma4]
3931QED
3932
3933Theorem exp_convex:
3934 exp IN convex_fn
3935Proof
3936 RW_TAC std_ss [convex_fn, EXTENSION, NOT_IN_EMPTY, GSPECIFICATION]
3937 >> Cases_on `t = 0` >- RW_TAC real_ss []
3938 >> Cases_on `t = 1` >- RW_TAC real_ss []
3939 >> `0 < t /\ t < 1` by METIS_TAC [REAL_LT_LE]
3940 >> Cases_on `x = y` >- RW_TAC real_ss []
3941 >> (MP_TAC o Q.SPECL [`x`, `y`]) REAL_LT_TOTAL >> RW_TAC std_ss []
3942 >- (MATCH_MP_TAC exp_convex_lemma6 >> RW_TAC std_ss [])
3943 >> Q.ABBREV_TAC `t' = 1 - t`
3944 >> `t = 1 - t'` by (Q.UNABBREV_TAC `t'` >> REAL_ARITH_TAC)
3945 >> POP_ASSUM (fn thm => ONCE_REWRITE_TAC [thm])
3946 >> `0 < t'` by (Q.UNABBREV_TAC `t'` >> RW_TAC real_ss [REAL_LT_SUB_LADD])
3947 >> `t' < 1` by (Q.UNABBREV_TAC `t'` >> RW_TAC real_ss [REAL_LT_SUB_RADD, REAL_LT_ADDR])
3948 >> ONCE_REWRITE_TAC [REAL_ADD_COMM]
3949 >> MATCH_MP_TAC exp_convex_lemma6 >> RW_TAC std_ss []
3950QED
3951
3952(* ------------------------------------------------------------------------- *)
3953(* ------------ ln and lg are concave on (0,infty] ------------------------- *)
3954(* ------------------------------------------------------------------------- *)
3955
3956Theorem pos_concave_ln :
3957 ln IN pos_concave_fn
3958Proof
3959 RW_TAC std_ss [pos_concave_fn, pos_convex_fn, EXTENSION, NOT_IN_EMPTY, GSPECIFICATION]
3960 >> Cases_on `t = 0` >- RW_TAC real_ss []
3961 >> Cases_on `t = 1` >- RW_TAC real_ss []
3962 >> `0 < t /\ t < 1` by RW_TAC std_ss [REAL_LT_LE]
3963 >> `t * ~ln x + (1 - t) * ~ln y = ~ (t * ln x + (1 - t)* ln y)` by REAL_ARITH_TAC
3964 >> POP_ASSUM (fn thm => ONCE_REWRITE_TAC [thm])
3965 >> RW_TAC std_ss [REAL_LE_NEG, ln]
3966 >> MATCH_MP_TAC SELECT_ELIM_THM
3967 >> RW_TAC std_ss [] >- (MATCH_MP_TAC EXP_TOTAL
3968 >> MATCH_MP_TAC REAL_LT_ADD >> CONJ_TAC >> MATCH_MP_TAC REAL_LT_MUL
3969 >> RW_TAC real_ss [GSYM REAL_LT_ADD_SUB])
3970 >> Suff `(\v. t * v + (1 - t) * (@u. exp u = y) <= x') (@u. exp u = x)`
3971 >- RW_TAC std_ss []
3972 >> MATCH_MP_TAC SELECT_ELIM_THM
3973 >> RW_TAC std_ss [] >- (MATCH_MP_TAC EXP_TOTAL >> RW_TAC std_ss [])
3974 >> Suff `(\v. t * x'' + (1 - t) * v <= x') (@u. exp u = y)`
3975 >- RW_TAC std_ss []
3976 >> MATCH_MP_TAC SELECT_ELIM_THM
3977 >> RW_TAC std_ss [] >- (MATCH_MP_TAC EXP_TOTAL >> RW_TAC std_ss [])
3978 >> ONCE_REWRITE_TAC [GSYM EXP_MONO_LE]
3979 >> POP_ASSUM (fn thm => ONCE_REWRITE_TAC [thm])
3980 >> MP_TAC exp_convex
3981 >> RW_TAC std_ss [convex_fn, EXTENSION, NOT_IN_EMPTY, GSPECIFICATION]
3982QED
3983
3984Theorem convex_lemma[local] :
3985 !x y t. 0 < x /\ 0 < y /\ 0 <= t /\ t <= 1 ==> 0 < x * t + y * (1 - t)
3986Proof
3987 rpt STRIP_TAC
3988 >> Cases_on ‘t = 0’ >- rw []
3989 >> Cases_on ‘t = 1’ >- rw []
3990 >> MATCH_MP_TAC REAL_LT_ADD
3991 >> CONJ_TAC
3992 >| [ MATCH_MP_TAC REAL_LT_MUL >> rw [REAL_LT_LE],
3993 MATCH_MP_TAC REAL_LT_MUL >> rw [REAL_LT_SUB_LADD, REAL_LT_LE] ]
3994QED
3995
3996(* inv is pos_convex *)
3997Theorem pos_convex_inv :
3998 inv IN pos_convex_fn
3999Proof
4000 simp [pos_convex_fn]
4001 >> qx_genl_tac [‘x’, ‘y’, ‘t’]
4002 >> STRIP_TAC
4003 >> ‘x <> 0 /\ y <> 0’ by PROVE_TAC [REAL_POS_NZ]
4004 >> Know ‘t * inv x + inv y * (1 - t) = (y * t + x * (1 - t)) / (x * y)’
4005 >- (rw [real_div, REAL_ADD_RDISTRIB, REAL_ADD_LDISTRIB])
4006 >> Rewr'
4007 >> Know ‘(y * t + x * (1 - t)) / (x * y) = inv (x * y / (y * t + x * (1 - t)))’
4008 >- (rw [real_div, REAL_INV_MUL'])
4009 >> Rewr'
4010 >> Know ‘inv (t * x + y * (1 - t)) <= inv (x * y / (y * t + x * (1 - t))) <=>
4011 x * y / (y * t + x * (1 - t)) <= t * x + y * (1 - t)’
4012 >- (MATCH_MP_TAC REAL_INV_LE_ANTIMONO \\
4013 simp [real_div] \\
4014 CONJ_TAC >- PROVE_TAC [REAL_MUL_COMM, convex_lemma] \\
4015 MATCH_MP_TAC REAL_LT_MUL \\
4016 CONJ_TAC >- (MATCH_MP_TAC REAL_LT_MUL >> art []) \\
4017 REWRITE_TAC [REAL_LT_INV_EQ] \\
4018 PROVE_TAC [REAL_MUL_COMM, convex_lemma])
4019 >> Rewr'
4020 >> Know ‘x * y / (y * t + x * (1 - t)) <= t * x + y * (1 - t) <=>
4021 x * y <= (t * x + y * (1 - t)) * (y * t + x * (1 - t))’
4022 >- (MATCH_MP_TAC REAL_LE_LDIV_EQ \\
4023 PROVE_TAC [convex_lemma])
4024 >> Rewr'
4025 >> rw [REAL_ADD_LDISTRIB, REAL_ADD_RDISTRIB, REAL_ADD_ASSOC]
4026 >> Know ‘x * y = t pow 2 * x * y + t * (2 * x * y) * (1 - t) +
4027 x * y * (1 - t) pow 2’
4028 >- (GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) empty_rewrites [GSYM REAL_MUL_RID] \\
4029 Know ‘1 = (t + (1 - t)) pow 2’
4030 >- (‘t + (1 - t) = 1’ by REAL_ARITH_TAC >> POP_ORW \\
4031 rw [pow]) \\
4032 DISCH_THEN ((GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) empty_rewrites) o wrap) \\
4033 REWRITE_TAC [POW_2, REAL_ADD_LDISTRIB, REAL_ADD_RDISTRIB] \\
4034 REAL_ARITH_TAC)
4035 >> DISCH_THEN ((GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) empty_rewrites) o wrap)
4036 >> REWRITE_TAC [REAL_LE_RADD]
4037 >> REWRITE_TAC [GSYM REAL_ADD_ASSOC, REAL_LE_LADD]
4038 >> REWRITE_TAC [GSYM REAL_ADD_LDISTRIB, GSYM REAL_ADD_RDISTRIB]
4039 >> MATCH_MP_TAC REAL_LE_RMUL_IMP
4040 >> CONJ_TAC >- (rw [REAL_LE_SUB_LADD])
4041 >> MATCH_MP_TAC REAL_LE_LMUL_IMP >> art []
4042 >> Know ‘0 <= (x - y) pow 2’ >- PROVE_TAC [REAL_LE_POW2]
4043 >> Know ‘(x - y) pow 2 = x pow 2 + y pow 2 - 2 * x * y’
4044 >- (REWRITE_TAC [POW_2] >> REAL_ARITH_TAC)
4045 >> Rewr'
4046 >> rw [REAL_LE_SUB_LADD]
4047QED
4048
4049(* |- 0 < -x /\ -x < 1 ==>
4050 ?t. 0 < t /\ t < -x /\ ln (1 + x) = x * realinv (1 - t)
4051 *)
4052val lemma =
4053 SIMP_RULE real_ss [REAL_NEG_0, real_div, REAL_INV_0, POW_1, REAL_EQ_NEG]
4054 (REWRITE_RULE [sum, ONE]
4055 (Q.SPECL [‘-x’, ‘1’] MCLAURIN_LN_NEG));
4056
4057(* An extended version of EXP_LE_X to entire reals, based on MCLAURIN_LN_NEG *)
4058Theorem EXP_LE_X_FULL :
4059 !x :real. &1 + x <= exp x
4060Proof
4061 Q.X_GEN_TAC ‘x’
4062 >> Cases_on `0 <= x`
4063 >- (MATCH_MP_TAC EXP_LE_X >> art [])
4064 >> FULL_SIMP_TAC std_ss [GSYM real_lt]
4065 >> Cases_on `x <= -1`
4066 >- (MATCH_MP_TAC REAL_LE_TRANS \\
4067 Q.EXISTS_TAC `0` >> REWRITE_TAC [EXP_POS_LE] \\
4068 `0r = 1 + -1` by RW_TAC real_ss [] \\
4069 POP_ORW >> art [REAL_LE_LADD])
4070 >> FULL_SIMP_TAC std_ss [GSYM real_lt]
4071 >> MP_TAC lemma
4072 >> ‘0 < -x /\ -x < 1’ by REAL_ASM_ARITH_TAC
4073 >> RW_TAC std_ss []
4074 >> MATCH_MP_TAC REAL_LT_IMP_LE
4075 >> Know ‘1 + x < exp x <=> ln (1 + x) < ln (exp x)’
4076 >- (MATCH_MP_TAC (GSYM LN_MONO_LT) \\
4077 REWRITE_TAC [EXP_POS_LT] >> REAL_ASM_ARITH_TAC)
4078 >> Rewr'
4079 >> POP_ORW
4080 >> REWRITE_TAC [LN_EXP]
4081 >> GEN_REWRITE_TAC RAND_CONV empty_rewrites [GSYM REAL_MUL_RID]
4082 >> Know ‘x * inv (1 - t) < x * 1 <=> 1 < inv (1 - t)’
4083 >- (MATCH_MP_TAC REAL_LT_LMUL_NEG >> art [])
4084 >> Rewr'
4085 >> MATCH_MP_TAC REAL_INV_LT1
4086 >> REAL_ASM_ARITH_TAC
4087QED
4088
4089(* ------------------------------------------------------------------------- *)
4090(* Transcendental functions and ‘product’ *)
4091(* ------------------------------------------------------------------------- *)
4092
4093Theorem LN_PRODUCT :
4094 !f s. FINITE s /\ (!x. x IN s ==> &0 < f x) ==>
4095 ln (product s f) = sum s (\x. ln (f x))
4096Proof
4097 rpt STRIP_TAC
4098 >> NTAC 2 (POP_ASSUM MP_TAC)
4099 >> Q.SPEC_TAC (‘s’, ‘s’)
4100 >> HO_MATCH_MP_TAC FINITE_INDUCT
4101 >> rw [PRODUCT_CLAUSES, SUM_CLAUSES, LN_1]
4102 >> ‘0 < f e’ by PROVE_TAC []
4103 >> ‘0 < product s f’ by (MATCH_MP_TAC PRODUCT_POS_LT >> rw [])
4104 >> rw [LN_MUL]
4105QED
4106
4107(* NOTE: added ‘n <> 0 /\ (!x. x IN s ==> &0 <= f x)’ to hol-light's statements *)
4108Theorem ROOT_PRODUCT :
4109 !n f s. FINITE s /\ n <> 0 /\ (!x. x IN s ==> &0 <= f x)
4110 ==> root n (product s f) = product s (\i. root n (f i))
4111Proof
4112 rpt STRIP_TAC
4113 >> Cases_on ‘n’ >- fs []
4114 >> rename1 ‘SUC n <> 0’
4115 >> POP_ASSUM MP_TAC
4116 >> Q.PAT_X_ASSUM ‘FINITE s’ MP_TAC
4117 >> Q.SPEC_TAC (‘s’, ‘s’)
4118 >> HO_MATCH_MP_TAC FINITE_INDUCT
4119 >> rw [PRODUCT_CLAUSES, ROOT_1]
4120 >> ‘0 <= f e’ by PROVE_TAC []
4121 >> ‘0 <= product s f’ by (MATCH_MP_TAC PRODUCT_POS_LE >> rw [])
4122 >> rw [ROOT_MUL]
4123QED
4124
4125(* ------------------------------------------------------------------------- *)
4126(* Some convexity-derived inequalities including AGM and Young's inequality. *)
4127(* Ported from hol-light (AGM stands for "arithmetic and geometric means") *)
4128(* ------------------------------------------------------------------------- *)
4129
4130(* NOTE: changed ‘0 <= x i’ (hol-light) to ‘0 < x i’ *)
4131Theorem AGM_GEN :
4132 !a x s. FINITE s /\ sum s a = &1 /\ (!i. i IN s ==> &0 <= a i /\ &0 < x i)
4133 ==> product s (\i. x i rpow a i) <= sum s (\i. a i * x i)
4134Proof
4135 rpt STRIP_TAC
4136 >> Q.ABBREV_TAC ‘f = \i. x i rpow a i’
4137 >> Know ‘!n. n IN s ==> 0 < f n’
4138 >- (rw [Abbr ‘f’] \\
4139 MATCH_MP_TAC RPOW_POS_LT >> rw [])
4140 >> DISCH_TAC
4141 >> Know ‘product s f <= sum s (\i. a i * x i) <=>
4142 ln (product s f) <= ln (sum s (\i. a i * x i))’
4143 >- (MATCH_MP_TAC (GSYM LN_MONO_LE) >> CONJ_TAC >|
4144 [ (* goal 1 (of 2) *)
4145 MATCH_MP_TAC PRODUCT_POS_LT >> simp [],
4146 (* goal 2 (of 2) *)
4147 MATCH_MP_TAC SUM_POS_LT >> simp [] \\
4148 CONJ_TAC >- (Q.X_GEN_TAC ‘n’ >> DISCH_TAC \\
4149 MATCH_MP_TAC REAL_LE_MUL >> rw [] \\
4150 MATCH_MP_TAC REAL_LT_IMP_LE >> rw []) \\
4151 Cases_on ‘?i. i IN s /\ 0 < a i’
4152 >- (POP_ASSUM STRIP_ASSUME_TAC >> Q.EXISTS_TAC ‘i’ >> art [] \\
4153 MATCH_MP_TAC REAL_LT_MUL >> rw []) \\
4154 FULL_SIMP_TAC std_ss [GSYM IMP_DISJ_THM, GSYM real_lte] \\
4155 Know ‘sum s a <= &CARD s * 0’
4156 >- (MATCH_MP_TAC SUM_BOUND' >> rw []) >> rw [] ])
4157 >> Rewr'
4158 >> Know ‘ln (product s f) = sum s (\x. ln (f x))’
4159 >- (MATCH_MP_TAC LN_PRODUCT >> rw [])
4160 >> Rewr'
4161 >> Know ‘!g. sum s g = SIGMA g s’
4162 >- (Q.X_GEN_TAC ‘g’ \\
4163 MATCH_MP_TAC (GSYM REAL_SUM_IMAGE_sum) >> art [])
4164 >> DISCH_THEN (FULL_SIMP_TAC std_ss o wrap)
4165 >> simp [Abbr ‘f’]
4166 >> Know ‘SIGMA (\x'. ln (x x' rpow a x')) s = SIGMA (\i. a i * ln (x i)) s’
4167 >- (MATCH_MP_TAC REAL_SUM_IMAGE_EQ >> art [] \\
4168 Q.X_GEN_TAC ‘i’ >> rw [] \\
4169 MATCH_MP_TAC LN_RPOW >> rw [])
4170 >> Rewr'
4171 >> MP_TAC (Q.SPECL [‘ln’, ‘a’, ‘x’]
4172 (MATCH_MP jensen_pos_concave_SIGMA (ASSUME “FINITE s”)))
4173 >> rw [pos_concave_ln]
4174 >> POP_ASSUM MATCH_MP_TAC
4175 >> MATCH_MP_TAC SUM_POS_BOUND >> rw []
4176 >> Suff ‘sum s a = SIGMA a s’ >- rw [REAL_LE_REFL]
4177 >> MATCH_MP_TAC (GSYM REAL_SUM_IMAGE_sum) >> art []
4178QED
4179
4180(* NOTE: changed ‘0 <= x i’ (hol-light) to ‘0 < x i’ *)
4181Theorem AGM_RPOW :
4182 !s x n. s HAS_SIZE n /\ ~(n = 0) /\ (!i. i IN s ==> &0 < x(i))
4183 ==> product s (\i. x(i) rpow (&1 / &n)) <= sum s (\i. x(i) / &n)
4184Proof
4185 RW_TAC std_ss [HAS_SIZE]
4186 >> MP_TAC (Q.SPECL [‘\i. &1 / &CARD (s :'a set)’, ‘x’, ‘s’] AGM_GEN)
4187 >> rw [SUM_CONST, GSYM real_div]
4188QED
4189
4190Theorem AGM_ROOT :
4191 !s x n. s HAS_SIZE n /\ ~(n = 0) /\ (!i. i IN s ==> &0 <= x(i))
4192 ==> root n (product s x) <= sum s x / &n
4193Proof
4194 RW_TAC std_ss [HAS_SIZE]
4195 >> Cases_on ‘!i. i IN s ==> &0 < x(i)’
4196 >- (RW_TAC std_ss [ROOT_PRODUCT, real_div] \\
4197 Know ‘product s (\i. root (CARD s) (x i)) =
4198 product s (\i. (x i) rpow (inv &CARD s))’
4199 >- (MATCH_MP_TAC PRODUCT_EQ \\
4200 Q.X_GEN_TAC ‘i’ >> rw [REAL_ROOT_RPOW]) >> Rewr' \\
4201 REWRITE_TAC [GSYM SUM_RMUL] \\
4202 REWRITE_TAC [GSYM real_div, REAL_INV_1OVER] \\
4203 MATCH_MP_TAC AGM_RPOW >> rw [HAS_SIZE])
4204 (* extra work to support ‘!i. i IN s ==> 0 <= x i’ *)
4205 >> FULL_SIMP_TAC std_ss [real_lt]
4206 >> ‘x i = 0’ by PROVE_TAC [REAL_LE_ANTISYM]
4207 >> Know ‘product s x = 0’
4208 >- (REWRITE_TAC [MATCH_MP PRODUCT_EQ_0 (ASSUME “FINITE s”)] \\
4209 Q.EXISTS_TAC ‘i’ >> art [])
4210 >> Rewr'
4211 >> Q.ABBREV_TAC ‘n = CARD s’
4212 >> Cases_on ‘n’ >- fs []
4213 >> rw [ROOT_0]
4214 >> MATCH_MP_TAC SUM_POS_LE >> rw []
4215QED
4216
4217Theorem AGM_SQRT :
4218 !x y. &0 <= x /\ &0 <= y ==> sqrt(x * y) <= (x + y) / &2
4219Proof
4220 rpt STRIP_TAC
4221 >> MP_TAC (ISPECL [“{0; (1:num)}”,
4222 “\(n :num). if n = 0 then (x:real) else (y:real)”,
4223 “(2:num)”] AGM_ROOT)
4224 >> ‘FINITE {0; (1:num)}’ by PROVE_TAC [FINITE_INSERT, FINITE_SING]
4225 >> simp [SUM_CLAUSES, PRODUCT_CLAUSES, sqrt]
4226 >> DISCH_THEN MATCH_MP_TAC
4227 >> rw [HAS_SIZE]
4228QED
4229
4230Theorem AGM :
4231 !s x n. s HAS_SIZE n /\ ~(n = 0) /\ (!i. i IN s ==> &0 <= x(i))
4232 ==> product s x <= (sum s x / &n) pow n
4233Proof
4234 rpt STRIP_TAC
4235 >> Cases_on ‘n’ >- fs []
4236 >> rename1 ‘SUC n <> 0’
4237 >> Know ‘0 <= sum s x / &SUC n’
4238 >- (MATCH_MP_TAC REAL_LE_DIV >> rw [] \\
4239 MATCH_MP_TAC SUM_POS_LE >> rw [])
4240 >> DISCH_TAC
4241 >> Know ‘product s x <= (sum s x / &SUC n) pow (SUC n) <=>
4242 root (SUC n) (product s x) <=
4243 root (SUC n) ((sum s x / &(SUC n)) pow (SUC n))’
4244 >- (MATCH_MP_TAC (GSYM ROOT_MONO_LE_EQ) >> rw [] \\
4245 MATCH_MP_TAC PRODUCT_POS_LE >> fs [HAS_SIZE])
4246 >> Rewr'
4247 >> RW_TAC std_ss [POW_ROOT_POS]
4248 >> MATCH_MP_TAC AGM_ROOT >> rw []
4249QED
4250
4251(* NOTE: changed ‘0 <= x /\ 0 <= y’ (hol-light) to ‘0 < x /\ 0 < y’ *)
4252Theorem AGM_2 :
4253 !x y u v. &0 < x /\ &0 < y /\ &0 <= u /\ &0 <= v /\ u + v = &1
4254 ==> x rpow u * y rpow v <= u * x + v * y
4255Proof
4256 rpt STRIP_TAC
4257 >> qspecl_then [‘\i. if i = 0n then u else v’, ‘\i. if i = 0 then x else y’,
4258 ‘{0..SUC 0}’] MP_TAC AGM_GEN
4259 >> simp [SUM_CLAUSES_NUMSEG, PRODUCT_CLAUSES_NUMSEG, FINITE_NUMSEG]
4260 >> DISCH_THEN MATCH_MP_TAC
4261 >> rw []
4262QED
4263
4264(* NOTE: changed ‘0 <= a /\ 0 <= b’ (hol-light) to ‘0 < a /\ 0 < b’ *)
4265Theorem YOUNG_INEQUALITY :
4266 !a b p q. &0 < a /\ &0 < b /\ &0 < p /\ &0 < q /\ inv(p) + inv(q) = &1
4267 ==> a * b <= a rpow p / p + b rpow q / q
4268Proof
4269 rpt STRIP_TAC
4270 >> ‘p <> 0 /\ q <> 0’ by PROVE_TAC [REAL_LT_IMP_NE]
4271 >> ‘0 <= p /\ 0 <= q’ by PROVE_TAC [REAL_LT_IMP_LE]
4272 >> MP_TAC (Q.SPECL [`a rpow p`, `b rpow q`, `inv p:real`, `inv q:real`] AGM_2)
4273 >> rw [RPOW_RPOW, RPOW_1, RPOW_POS_LT, real_div]
4274QED
4275
4276(* ------------------------------------------------------------------------- *)
4277(* Real-valued power, log, and log base 2 functions (from util_probTheory) *)
4278(* ------------------------------------------------------------------------- *)
4279
4280Definition logr_def :
4281 logr a x = ln x / ln a
4282End
4283
4284Definition lg_def :
4285 lg x = logr 2 x
4286End
4287
4288Theorem lg_1 :
4289 lg 1 = 0
4290Proof
4291 RW_TAC real_ss [lg_def, logr_def, LN_1]
4292QED
4293
4294Theorem logr_1 :
4295 !b. logr b 1 = 0
4296Proof
4297 RW_TAC real_ss [logr_def, LN_1]
4298QED
4299
4300Theorem lg_nonzero :
4301 !x. x <> 0 /\ 0 <= x ==> (lg x <> 0 <=> x <> 1)
4302Proof
4303 RW_TAC std_ss [REAL_ARITH ``x <> 0 /\ 0 <= x <=> 0 < x``]
4304 >> RW_TAC std_ss [GSYM lg_1]
4305 >> RW_TAC std_ss [lg_def, logr_def, real_div, REAL_EQ_RMUL, REAL_INV_EQ_0]
4306 >> (MP_TAC o Q.SPECL [`2`, `1`]) LN_INJ >> RW_TAC real_ss [LN_1]
4307 >> RW_TAC std_ss [GSYM LN_1]
4308 >> MATCH_MP_TAC LN_INJ
4309 >> RW_TAC real_ss []
4310QED
4311
4312Theorem lg_mul :
4313 !x y. 0 < x /\ 0 < y ==> (lg (x * y) = lg x + lg y)
4314Proof
4315 RW_TAC real_ss [lg_def, logr_def, LN_MUL]
4316QED
4317
4318Theorem logr_mul :
4319 !b x y. 0 < x /\ 0 < y ==> (logr b (x * y) = logr b x + logr b y)
4320Proof
4321 RW_TAC real_ss [logr_def, LN_MUL]
4322QED
4323
4324Theorem lg_2 :
4325 lg 2 = 1
4326Proof
4327 RW_TAC real_ss [lg_def, logr_def]
4328 >> MATCH_MP_TAC REAL_DIV_REFL
4329 >> (ASSUME_TAC o Q.SPECL [`1`, `2`]) LN_MONO_LT
4330 >> FULL_SIMP_TAC real_ss [LN_1]
4331 >> ONCE_REWRITE_TAC [EQ_SYM_EQ]
4332 >> MATCH_MP_TAC REAL_LT_IMP_NE >> art []
4333QED
4334
4335Theorem lg_inv :
4336 !x. 0 < x ==> (lg (inv x) = ~lg x)
4337Proof
4338 RW_TAC real_ss [lg_def, logr_def, LN_INV, real_div]
4339QED
4340
4341Theorem logr_inv :
4342 !b x. 0 < x ==> (logr b (inv x) = ~ logr b x)
4343Proof
4344 RW_TAC real_ss [logr_def, LN_INV, real_div]
4345QED
4346
4347Theorem logr_div :
4348 !b x y. 0 < x /\ 0 < y ==> (logr b (x/y) = logr b x - logr b y)
4349Proof
4350 RW_TAC real_ss [real_div, logr_mul, logr_inv, GSYM real_sub]
4351QED
4352
4353Theorem neg_lg :
4354 !x. 0 < x ==> ((~(lg x)) = lg (inv x))
4355Proof
4356 RW_TAC real_ss [lg_def, logr_def, real_div]
4357 >> `~(ln x * inv (ln 2)) = (~ ln x) * inv (ln 2)` by REAL_ARITH_TAC
4358 >> POP_ASSUM (fn thm => ONCE_REWRITE_TAC [thm])
4359 >> RW_TAC real_ss [REAL_EQ_RMUL]
4360 >> DISJ2_TAC >> ONCE_REWRITE_TAC [EQ_SYM_EQ] >> MATCH_MP_TAC LN_INV
4361 >> RW_TAC std_ss []
4362QED
4363
4364Theorem neg_logr :
4365 !b x. 0 < x ==> ((~(logr b x)) = logr b (inv x))
4366Proof
4367 RW_TAC real_ss [logr_def, real_div]
4368 >> `~(ln x * inv (ln b)) = (~ ln x) * inv (ln b)` by REAL_ARITH_TAC
4369 >> POP_ASSUM (fn thm => ONCE_REWRITE_TAC [thm])
4370 >> RW_TAC real_ss [REAL_EQ_RMUL]
4371 >> DISJ2_TAC >> ONCE_REWRITE_TAC [EQ_SYM_EQ] >> MATCH_MP_TAC LN_INV
4372 >> RW_TAC std_ss []
4373QED
4374
4375Theorem lg_pow :
4376 !n. lg (2 pow n) = &n
4377Proof
4378 RW_TAC real_ss [lg_def, logr_def, LN_POW]
4379 >> `~(ln 2 = 0)`
4380 by (ONCE_REWRITE_TAC [EQ_SYM_EQ] >> MATCH_MP_TAC REAL_LT_IMP_NE
4381 >> MATCH_MP_TAC REAL_LET_TRANS >> Q.EXISTS_TAC `ln 1`
4382 >> RW_TAC real_ss [LN_POS, LN_MONO_LT])
4383 >> RW_TAC real_ss [real_div, GSYM REAL_MUL_ASSOC, REAL_MUL_RINV]
4384QED
4385
4386(* cf. LN_MONO_LT *)
4387Theorem LOGR_MONO_LT :
4388 !x :real y b. 0 < x /\ 0 < y /\ 1 < b ==> (logr b x < logr b y <=> x < y)
4389Proof
4390 RW_TAC std_ss [logr_def,real_div]
4391 >> `0 < ln b` by METIS_TAC [REAL_LT_01, LN_1, REAL_LT_TRANS, LN_MONO_LT]
4392 >> METIS_TAC [REAL_LT_INV_EQ, REAL_LT_RMUL, LN_MONO_LT]
4393QED
4394
4395Theorem LOGR_MONO_LE :
4396 !x:real y b. 0 < x /\ 0 < y /\ 1 < b ==> (logr b x <= logr b y <=> x <= y)
4397Proof
4398 RW_TAC std_ss [logr_def,real_div]
4399 >> `0 < ln b` by METIS_TAC [REAL_LT_01, LN_1, REAL_LT_TRANS, LN_MONO_LT]
4400 >> METIS_TAC [REAL_LT_INV_EQ, REAL_LE_RMUL, LN_MONO_LE]
4401QED
4402
4403Theorem LOGR_MONO_LE_IMP :
4404 !x:real y b. 0 < x /\ x <= y /\ 1 <= b ==> (logr b x <= logr b y)
4405Proof
4406 RW_TAC std_ss [logr_def,real_div]
4407 >> `0 <= ln b` by METIS_TAC [REAL_LT_01, LN_1, REAL_LTE_TRANS, LN_MONO_LE]
4408 >> METIS_TAC [REAL_LE_INV_EQ, REAL_LE_RMUL_IMP, LN_MONO_LE, REAL_LTE_TRANS]
4409QED
4410
4411(* from extra_realScript.sml of "miller" example *)
4412Theorem pos_concave_lg :
4413 lg IN pos_concave_fn
4414Proof
4415 RW_TAC std_ss [lg_def, logr_def, pos_concave_fn, pos_convex_fn, EXTENSION,
4416 NOT_IN_EMPTY, GSPECIFICATION]
4417 >> `~(ln (t * x + (1 - t) * y) / ln 2) =
4418 (inv (ln 2))*(~(ln (t * x + (1 - t) * y)))` by (RW_TAC real_ss [real_div] >> REAL_ARITH_TAC)
4419 >> POP_ASSUM (fn thm => ONCE_REWRITE_TAC [thm])
4420 >> `t * ~(ln x / ln 2) + (1 - t) * ~(ln y / ln 2) =
4421 (inv (ln 2)) * (t * ~ ln x + (1-t) * ~ln y)` by (RW_TAC real_ss [real_div] >> REAL_ARITH_TAC)
4422 >> POP_ASSUM (fn thm => ONCE_REWRITE_TAC [thm])
4423 >> MATCH_MP_TAC REAL_LE_LMUL_IMP
4424 >> CONJ_TAC >- (RW_TAC real_ss [REAL_LE_INV_EQ] >> MATCH_MP_TAC LN_POS >> RW_TAC real_ss [])
4425 >> MP_TAC pos_concave_ln
4426 >> RW_TAC std_ss [pos_concave_fn, pos_convex_fn, EXTENSION,
4427 NOT_IN_EMPTY, GSPECIFICATION]
4428QED
4429
4430(* from extra_realScript.sml of "miller" example *)
4431Theorem pos_concave_logr :
4432 !b. 1 <= b ==> (logr b) IN pos_concave_fn
4433Proof
4434 RW_TAC std_ss [logr_def, pos_concave_fn, pos_convex_fn, EXTENSION,
4435 NOT_IN_EMPTY, GSPECIFICATION]
4436 >> `~(ln (t * x + (1 - t) * y) / ln b) =
4437 (inv (ln b))*(~(ln (t * x + (1 - t) * y)))` by (RW_TAC real_ss [real_div] >> REAL_ARITH_TAC)
4438 >> POP_ASSUM (fn thm => ONCE_REWRITE_TAC [thm])
4439 >> `t * ~(ln x / ln b) + (1 - t) * ~(ln y / ln b) =
4440 (inv (ln b)) * (t * ~ ln x + (1-t) * ~ln y)` by (RW_TAC real_ss [real_div] >> REAL_ARITH_TAC)
4441 >> POP_ASSUM (fn thm => ONCE_REWRITE_TAC [thm])
4442 >> MATCH_MP_TAC REAL_LE_LMUL_IMP
4443 >> CONJ_TAC >- (RW_TAC real_ss [REAL_LE_INV_EQ] >> MATCH_MP_TAC LN_POS >> RW_TAC real_ss [])
4444 >> MP_TAC pos_concave_ln
4445 >> RW_TAC std_ss [pos_concave_fn, pos_convex_fn, EXTENSION,
4446 NOT_IN_EMPTY, GSPECIFICATION]
4447QED
4448
4449(*---------------------------------------------------------------------------*)
4450(* SELECT_UNIQUE_ALT = |- !P x. P x /\ (!y. P y ==> (y = x)) ==> ($@ P = x) *)
4451(*---------------------------------------------------------------------------*)
4452
4453Theorem SELECT_UNIQUE_ALT[local]:
4454 !P x. P x /\ (!y. P y ==> y = x) ==> $@ P = x
4455Proof
4456 metis_tac[SELECT_UNIQUE]
4457QED
4458
4459(* boolScript compatible proof *)
4460
4461(*
4462val SELECT_UNIQUE_ALT = let
4463 val asm = ASSUME “P x /\ !y: 'a. P y ==> y = x”
4464 val (witness_th, equiv_th) = CONJ_PAIR asm
4465 val sel_sat_th = MP (SPEC_ALL SELECT_AX) witness_th
4466 val sel_x_th = MP (SPEC “$@ (P: 'a -> bool)” equiv_th) sel_sat_th
4467 val final_th = GENL [“P: 'a -> bool”, “x: 'a”] $ DISCH_ALL sel_x_th
4468in
4469 thm (#(FILE), #(LINE)) ("SELECT_UNIQUE_ALT", final_th)
4470end
4471*)
4472
4473(* ------------------------------------------------------------------------- *)
4474(* Hyperbolic Trigonometry (plus some other stuff) *)
4475(* ------------------------------------------------------------------------- *)
4476
4477val _ = augment_srw_ss [realSimps.REAL_ARITH_ss];
4478
4479(*** Hyperbolic Trig Definitions ***)
4480
4481Definition sinh_def:
4482 sinh x = (exp x - exp (-x)) / 2r
4483End
4484
4485Definition cosh_def:
4486 cosh x = (exp x + exp (-x)) / 2r
4487End
4488
4489Definition tanh_def:
4490 tanh x = sinh x / cosh x
4491End
4492
4493Definition sech_def:
4494 sech x = 1 / cosh x
4495End
4496
4497Definition csch_def:
4498 csch x = 1 / sinh x
4499End
4500
4501Definition coth_def:
4502 coth x = 1 / tanh x
4503End
4504
4505Theorem tanh_alt:
4506 !x. tanh x = (exp x - exp (-x)) / (exp x + exp (-x))
4507Proof
4508 rw[tanh_def,sinh_def,cosh_def]
4509QED
4510
4511Theorem tanh_alt2:
4512 !x. tanh x = (exp (2 * x) - 1) / (exp (2 * x) + 1)
4513Proof
4514 rw[tanh_alt] >>
4515 ‘0 < exp x + exp (-x)’ by simp[REAL_LT_ADD,EXP_POS_LT] >>
4516 ‘0 < exp (2 * x) + 1’ by simp[REAL_LT_ADD,EXP_POS_LT] >>
4517 simp[REAL_ADD_LDISTRIB,REAL_SUB_LDISTRIB,
4518 real_sub,REAL_NEG_ADD,GSYM REAL_EXP_ADD] >>
4519 ‘-x + 2 * x = x’ by simp[] >> pop_assum SUBST1_TAC >> simp[]
4520QED
4521
4522Theorem coth_alt:
4523 !x. coth x = cosh x / sinh x
4524Proof
4525 rw[coth_def,tanh_def]
4526QED
4527
4528(*** Hyperbolic Trig Zero Lemmas ***)
4529
4530Theorem SINH_POS_LT:
4531 !x. 0 < x ==> 0 < sinh x
4532Proof
4533 simp[sinh_def,REAL_SUB_LT,EXP_MONO_LT]
4534QED
4535
4536Theorem SINH_POS_LE:
4537 !x. 0 <= x ==> 0 <= sinh x
4538Proof
4539 simp[sinh_def,REAL_SUB_LE,EXP_MONO_LE]
4540QED
4541
4542Theorem SINH_NEG_LT:
4543 !x. x < 0 ==> sinh x < 0
4544Proof
4545 simp[sinh_def,REAL_LT_SUB_RADD,EXP_MONO_LT]
4546QED
4547
4548Theorem SINH_NEG_LE:
4549 !x. x <= 0 ==> sinh x <= 0
4550Proof
4551 simp[sinh_def,REAL_LE_SUB_RADD,EXP_MONO_LE]
4552QED
4553
4554Theorem SINH_NZ:
4555 !x. sinh x <> 0 <=> x <> 0
4556Proof
4557 strip_tac >> simp[EQ_IMP_THM,sinh_def] >>
4558 CONV_TAC CONTRAPOS_CONV >> rw[] >>
4559 wlog_tac ‘0 < x’ [‘x’]
4560 >- (first_x_assum $ qspec_then ‘-x’ mp_tac >> simp[]) >>
4561 ‘-x < 0’ by simp[] >> ‘-x < x’ by simp[] >>
4562 dxrule EXP_MONO_IMP >> simp[]
4563QED
4564
4565Theorem SINH_0:
4566 sinh 0 = 0
4567Proof
4568 simp[sinh_def,EXP_0]
4569QED
4570
4571Theorem COSH_NZ:
4572 !x. cosh x <> 0
4573Proof
4574 simp[cosh_def,REAL_POS_NZ,REAL_LT_ADD,EXP_POS_LT]
4575QED
4576
4577Theorem COSH_POS_LT:
4578 !x. 0 < cosh x
4579Proof
4580 simp[cosh_def,REAL_LT_ADD,EXP_POS_LT]
4581QED
4582
4583Theorem COSH_0:
4584 cosh 0 = 1
4585Proof
4586 simp[cosh_def,EXP_0]
4587QED
4588
4589Theorem TANH_NZ:
4590 !x. tanh x <> 0 <=> x <> 0
4591Proof
4592 simp[tanh_def,COSH_NZ] >> metis_tac[SINH_NZ]
4593QED
4594
4595Theorem TANH_POS_LT:
4596 !x. 0 < x ==> 0 < tanh x
4597Proof
4598 simp[tanh_def,COSH_POS_LT,COSH_NZ,SINH_POS_LT]
4599QED
4600
4601Theorem TANH_POS_LE:
4602 !x. 0 <= x ==> 0 <= tanh x
4603Proof
4604 simp[tanh_def,COSH_POS_LT,COSH_NZ,SINH_POS_LE]
4605QED
4606
4607Theorem TANH_NEG_LT:
4608 !x. x < 0 ==> tanh x < 0
4609Proof
4610 simp[tanh_def,COSH_POS_LT,COSH_NZ,SINH_NEG_LT]
4611QED
4612
4613Theorem TANH_NEG_LE:
4614 !x. x <= 0 ==> tanh x <= 0
4615Proof
4616 simp[tanh_def,COSH_POS_LT,COSH_NZ,SINH_NEG_LE]
4617QED
4618
4619Theorem TANH_0:
4620 tanh 0 = 0
4621Proof
4622 simp[tanh_def,COSH_0,SINH_0]
4623QED
4624
4625Theorem SECH_NZ:
4626 !x. sech x <> 0
4627Proof
4628 simp[sech_def,COSH_NZ]
4629QED
4630
4631Theorem SECH_POS_LT:
4632 !x. 0 < sech x
4633Proof
4634 simp[sech_def,COSH_POS_LT,COSH_NZ]
4635QED
4636
4637Theorem SECH_0:
4638 sech 0 = 1
4639Proof
4640 simp[sech_def,COSH_0]
4641QED
4642
4643Theorem CSCH_NZ:
4644 !x. x <> 0 ==> csch x <> 0
4645Proof
4646 simp[csch_def,SINH_NZ]
4647QED
4648
4649Theorem CSCH_0:
4650 csch 0 = 0
4651Proof
4652 simp[csch_def,SINH_0,GSYM REAL_INV_1OVER,REAL_INV_0]
4653QED
4654
4655Theorem CSCH_POS_LT:
4656 !x. 0 < x ==> 0 < csch x
4657Proof
4658 simp[csch_def,SINH_POS_LT,SINH_NZ]
4659QED
4660
4661Theorem CSCH_NEG_LT:
4662 !x. x < 0 ==> csch x < 0
4663Proof
4664 simp[csch_def,SINH_NEG_LT,SINH_NZ]
4665QED
4666
4667Theorem COTH_NZ:
4668 !x. x <> 0 ==> coth x <> 0
4669Proof
4670 simp[coth_def,TANH_NZ]
4671QED
4672
4673Theorem COTH_POS_LT:
4674 !x. 0 < x ==> 0 < coth x
4675Proof
4676 simp[coth_def,TANH_POS_LT,TANH_NZ]
4677QED
4678
4679Theorem COTH_NEG_LT:
4680 !x. x < 0 ==> coth x < 0
4681Proof
4682 simp[coth_def,TANH_NEG_LT,TANH_NZ]
4683QED
4684
4685(*** Hyperbolic Trig Negative Inputs ***)
4686
4687Theorem SINH_NEG:
4688 !x. sinh (-x) = -sinh x
4689Proof
4690 simp[sinh_def]
4691QED
4692
4693Theorem COSH_NEG:
4694 !x. cosh (-x) = cosh x
4695Proof
4696 simp[cosh_def]
4697QED
4698
4699Theorem TANH_NEG:
4700 !x. tanh (-x) = -tanh x
4701Proof
4702 simp[tanh_def,SINH_NEG,COSH_NEG]
4703QED
4704
4705Theorem SECH_NEG:
4706 !x. sech (-x) = sech x
4707Proof
4708 simp[sech_def,COSH_NEG]
4709QED
4710
4711Theorem CSCH_NEG:
4712 !x. csch (-x) = -csch x
4713Proof
4714 simp[csch_def,SINH_NEG,neg_rat]
4715QED
4716
4717Theorem COTH_NEG:
4718 !x. coth (-x) = -coth x
4719Proof
4720 simp[coth_def,TANH_NEG,neg_rat]
4721QED
4722
4723(*** Hyperbolic Trig Derivatives ***)
4724
4725Theorem DIFF_SINH:
4726 !x. (sinh diffl cosh x) x
4727Proof
4728 rw[] >> mp_tac $ DIFF_CONV “λx. (exp x - exp (-x)) / 2r” >>
4729 simp[GSYM sinh_def,cosh_def,ETA_THM] >>
4730 disch_then $ qspec_then ‘x’ mp_tac >>
4731 qmatch_abbrev_tac ‘(_ diffl l1) _ ==> (_ diffl l2) _’ >>
4732 ‘l1 = l2’ suffices_by simp[] >> UNABBREV_ALL_TAC >> simp[]
4733QED
4734
4735Theorem DIFF_COSH:
4736 !x. (cosh diffl sinh x) x
4737Proof
4738 rw[] >> mp_tac $ DIFF_CONV “λx. (exp x + exp (-x)) / 2r” >>
4739 simp[GSYM cosh_def,sinh_def,ETA_THM] >>
4740 disch_then $ qspec_then ‘x’ mp_tac >>
4741 qmatch_abbrev_tac ‘(_ diffl l1) _ ==> (_ diffl l2) _’ >>
4742 ‘l1 = l2’ suffices_by simp[] >> UNABBREV_ALL_TAC >> simp[]
4743QED
4744
4745Theorem DIFF_TANH:
4746 !x. (tanh diffl (1 - (tanh x)²)) x
4747Proof
4748 rw[] >> mp_tac $ DIFF_CONV “λx. (exp x - exp (-x)) / (exp x + exp (-x))” >>
4749 simp[GSYM tanh_alt,ETA_THM] >> disch_then $ qspec_then ‘x’ mp_tac >>
4750 ‘0 < (exp x + exp (-x))’ by (irule REAL_LT_ADD >> simp[EXP_POS_LT]) >>
4751 simp[REAL_POS_NZ] >> qmatch_abbrev_tac ‘(_ diffl l1) _ ==> (_ diffl l2) _’ >>
4752 ‘l1 = l2’ suffices_by simp[] >> UNABBREV_ALL_TAC >> simp[tanh_alt] >>
4753 ‘(exp x + exp (-x))² / (exp x + exp (-x))² = 1’ by (
4754 irule REAL_DIV_REFL >> simp[]) >>
4755 pop_assum (SUBST1_TAC o SYM) >> simp[REAL_DIV_SUB,REAL_SUB_RNEG,GSYM real_sub]
4756QED
4757
4758Theorem DIFF_SECH:
4759 !x. (sech diffl -(tanh x * sech x)) x
4760Proof
4761 rw[] >> mp_tac $ DIFF_CONV “λx. 1 / cosh x” >>
4762 simp[GSYM sech_def,ETA_THM] >>
4763 disch_then $ qspecl_then [‘sinh x’,‘x’] mp_tac >>
4764 simp[DIFF_COSH] >> impl_tac
4765 >- simp[cosh_def,REAL_POS_NZ,REAL_LT_ADD,EXP_POS_LT] >>
4766 qmatch_abbrev_tac ‘(_ diffl l1) _ ==> (_ diffl l2) _’ >>
4767 ‘l1 = l2’ suffices_by simp[] >> UNABBREV_ALL_TAC >>
4768 simp[sech_def,tanh_def]
4769QED
4770
4771Theorem DIFF_CSCH:
4772 !x. x <> 0 ==> (csch diffl -(coth x * csch x)) x
4773Proof
4774 rw[] >> mp_tac $ DIFF_CONV “λx. 1 / sinh x” >>
4775 simp[GSYM csch_def,ETA_THM] >>
4776 disch_then $ qspecl_then [‘cosh x’,‘x’] mp_tac >>
4777 simp[DIFF_SINH] >> ‘sinh x <> 0’ by simp[SINH_NZ] >>
4778 simp[] >> qmatch_abbrev_tac ‘(_ diffl l1) _ ==> (_ diffl l2) _’ >>
4779 ‘l1 = l2’ suffices_by simp[] >> UNABBREV_ALL_TAC >>
4780 simp[csch_def,coth_def,tanh_def]
4781QED
4782
4783Theorem DIFF_COTH:
4784 !x. x <> 0 ==> (coth diffl (1 - (coth x)²)) x
4785Proof
4786 rw[] >> mp_tac $ DIFF_CONV “λx. 1 / tanh x” >>
4787 simp[GSYM coth_def,ETA_THM] >>
4788 disch_then $ qspecl_then [‘1 - (tanh x)²’,‘x’] mp_tac >>
4789 simp[DIFF_TANH] >> ‘tanh x <> 0’ by simp[TANH_NZ] >>
4790 simp[] >> qmatch_abbrev_tac ‘(_ diffl l1) _ ==> (_ diffl l2) _’ >>
4791 ‘l1 = l2’ suffices_by simp[] >> UNABBREV_ALL_TAC >>
4792 simp[coth_def,REAL_SUB_LDISTRIB]
4793QED
4794
4795(*** Hyperbolic Trig Bounds ***)
4796
4797Theorem COSH_BOUNDS:
4798 !x. 1 <= cosh x
4799Proof
4800 rw[] >> Cases_on ‘x = 0’ >- simp[COSH_0] >> wlog_tac ‘0 < x’ [‘x’]
4801 >- (first_x_assum $ qspec_then ‘-x’ mp_tac >> simp[COSH_NEG]) >>
4802 qspecl_then [‘cosh’,‘0’,‘x’] mp_tac MVT >> impl_tac
4803 >- (assume_tac DIFF_COSH >> metis_tac[DIFF_CONT,differentiable]) >>
4804 simp[COSH_0,REAL_EQ_SUB_RADD] >> rw[] >> simp[] >>
4805 irule REAL_LE_MUL >> simp[] >>
4806 dxrule_then (qspec_then ‘sinh z’ mp_tac) DIFF_UNIQ >>
4807 simp[DIFF_COSH,SINH_POS_LE]
4808QED
4809
4810Theorem TANH_BOUNDS:
4811 !x. -1 < tanh x /\ tanh x < 1
4812Proof
4813 strip_tac >> wlog_tac ‘0 <= x’ [‘x’]
4814 >- (first_x_assum $ qspec_then ‘-x’ mp_tac >> simp[TANH_NEG]) >>
4815 irule_at (Pos hd) REAL_LTE_TRANS >> qexists ‘0’ >>
4816 simp[tanh_def,COSH_POS_LT,COSH_NZ,SINH_POS_LE] >>
4817 simp[sinh_def,cosh_def,real_sub] >>
4818 irule REAL_LT_TRANS >> qexists ‘0’ >> simp[EXP_POS_LT]
4819QED
4820
4821Theorem SECH_BOUNDS:
4822 !x. 0 < sech x /\ sech x <= 1
4823Proof
4824 simp[sech_def,COSH_POS_LT,COSH_NZ,COSH_BOUNDS]
4825QED
4826
4827Theorem CSCH_BOUNDS:
4828 !x. x <> 0 ==> csch x <> 0
4829Proof
4830 simp[csch_def,SINH_NZ]
4831QED
4832
4833Theorem COTH_BOUNDS:
4834 !x. x <> 0 ==> coth x < -1 \/ 1 < coth x
4835Proof
4836 rw[coth_def] >> qspec_then ‘x’ assume_tac TANH_BOUNDS >>
4837 ‘tanh x = 0 \/ tanh x < 0 \/ 0 < tanh x’ by simp[]
4838 >- metis_tac[TANH_NZ] >>
4839 gs[]
4840QED
4841
4842(*** Hyperbolic Trig Monotonicity ***)
4843
4844Theorem SINH_MONO_LT:
4845 !x y. x < y ==> sinh x < sinh y
4846Proof
4847 rw[] >> irule DIFF_POS_MONO_LT_UU >> simp[] >>
4848 rw[] >> qexists ‘cosh z’ >> simp[COSH_POS_LT,DIFF_SINH]
4849QED
4850
4851Theorem SINH_MONO_LE:
4852 !x y. x <= y ==> sinh x <= sinh y
4853Proof
4854 rw[] >> Cases_on ‘x = y’ >> gs[REAL_LE_LT,SINH_MONO_LT]
4855QED
4856
4857Theorem COSH_MONO_LT:
4858 !x y. 0 <= x /\ x < y ==> cosh x < cosh y
4859Proof
4860 rw[] >> irule DIFF_POS_MONO_LT_CU >> simp[] >>
4861 qexists ‘0’ >> simp[] >> reverse conj_tac
4862 >- (metis_tac[DIFF_COSH,DIFF_CONT]) >>
4863 rw[] >> qexists ‘sinh z’ >> simp[SINH_POS_LT,DIFF_COSH]
4864QED
4865
4866Theorem COSH_MONO_LE:
4867 !x y. 0 <= x /\ x <= y ==> cosh x <= cosh y
4868Proof
4869 rw[] >> Cases_on ‘x = y’ >> gs[REAL_LE_LT,COSH_MONO_LT]
4870QED
4871
4872Theorem COSH_ANTIMONO_LT:
4873 !x y. x < y /\ y <= 0 ==> cosh y < cosh x
4874Proof
4875 rw[] >> irule DIFF_NEG_ANTIMONO_LT_UC >> simp[] >>
4876 qexists ‘0’ >> simp[] >> reverse conj_tac
4877 >- (metis_tac[DIFF_COSH,DIFF_CONT]) >>
4878 rw[] >> qexists ‘sinh z’ >> simp[SINH_NEG_LT,DIFF_COSH]
4879QED
4880
4881Theorem COSH_ANTIMONO_LE:
4882 !x y. x <= y /\ y <= 0 ==> cosh y <= cosh x
4883Proof
4884 rw[] >> Cases_on ‘x = y’ >> gs[REAL_LE_LT,COSH_ANTIMONO_LT]
4885QED
4886
4887Theorem TANH_MONO_LT:
4888 !x y. x < y ==> tanh x < tanh y
4889Proof
4890 rw[] >> irule DIFF_POS_MONO_LT_UU >> simp[] >>
4891 rw[] >> qexists ‘1 - (tanh z)²’ >> simp[DIFF_TANH,REAL_SUB_LT] >>
4892 wlog_tac ‘0 <= z’ [‘z’]
4893 >- (first_x_assum $ qspec_then ‘-z’ mp_tac >> simp[TANH_NEG]) >>
4894 qspecl_then [‘1’,‘tanh z’,‘1’] mp_tac POW_LT >>
4895 simp[] >> disch_then irule >> simp[TANH_BOUNDS,TANH_POS_LE]
4896QED
4897
4898Theorem TANH_MONO_LE:
4899 !x y. x <= y ==> tanh x <= tanh y
4900Proof
4901 rw[] >> Cases_on ‘x = y’ >> gs[REAL_LE_LT,TANH_MONO_LT]
4902QED
4903
4904Theorem SECH_ANTIMONO_LT:
4905 !x y. 0 <= x /\ x < y ==> sech y < sech x
4906Proof
4907 rw[] >> irule DIFF_NEG_ANTIMONO_LT_CU >> simp[] >>
4908 qexists ‘0’ >> simp[] >> reverse conj_tac
4909 >- (metis_tac[DIFF_SECH,DIFF_CONT]) >>
4910 rw[] >> qexists ‘-(tanh z * sech z)’ >> simp[DIFF_SECH] >>
4911 irule REAL_LT_MUL >> simp[SECH_POS_LT,TANH_POS_LT]
4912QED
4913
4914Theorem SECH_ANTIMONO_LE:
4915 !x y. 0 <= x /\ x <= y ==> sech y <= sech x
4916Proof
4917 rw[] >> Cases_on ‘x = y’ >> gs[REAL_LE_LT,SECH_ANTIMONO_LT]
4918QED
4919
4920Theorem SECH_MONO_LT:
4921 !x y. x < y /\ y <= 0 ==> sech x < sech y
4922Proof
4923 rw[] >> irule DIFF_POS_MONO_LT_UC >> simp[] >>
4924 qexists ‘0’ >> simp[] >> reverse conj_tac
4925 >- (metis_tac[DIFF_SECH,DIFF_CONT]) >>
4926 rw[] >> qexists ‘-(tanh z * sech z)’ >> simp[DIFF_SECH] >>
4927 ‘0 < sech z /\ tanh z < 0’ by simp[SECH_POS_LT,TANH_NEG_LT] >>
4928 dxrule_all_then mp_tac REAL_LT_RMUL_IMP >> simp[]
4929QED
4930
4931Theorem SECH_MONO_LE:
4932 !x y. x < y /\ y <= 0 ==> sech x < sech y
4933Proof
4934 rw[] >> Cases_on ‘x = y’ >> gs[REAL_LE_LT,SECH_MONO_LT]
4935QED
4936
4937Theorem CSCH_ANTIMONO_LT:
4938 !x y. (y < 0 \/ 0 < x) /\ x < y ==> csch y < csch x
4939Proof
4940 ntac 2 strip_tac >> wlog_tac ‘0 < x’ [‘x’,‘y’]
4941 >- (simp[] >> rw[] >>
4942 first_x_assum $ qspecl_then [‘-y’,‘-x’] mp_tac >> simp[CSCH_NEG]) >>
4943 simp[] >> rw[] >> irule DIFF_NEG_ANTIMONO_LT_OU >> simp[] >>
4944 qexists ‘0’ >> simp[] >> rw[] >> qexists ‘-(coth z * csch z)’ >>
4945 simp[DIFF_CSCH] >> irule REAL_LT_MUL >> simp[COTH_POS_LT,CSCH_POS_LT]
4946QED
4947
4948Theorem CSCH_ANTIMONO_LE:
4949 !x y. (y < 0 \/ 0 < x) /\ x <= y ==> csch y <= csch x
4950Proof
4951 rw[] >> Cases_on ‘x = y’ >> gs[REAL_LE_LT,CSCH_ANTIMONO_LT]
4952QED
4953
4954Theorem COTH_ANTIMONO_LT:
4955 !x y. (y < 0 \/ 0 < x) /\ x < y ==> coth y < coth x
4956Proof
4957 ntac 2 strip_tac >> wlog_tac ‘0 < x’ [‘x’,‘y’]
4958 >- (simp[] >> rw[] >>
4959 first_x_assum $ qspecl_then [‘-y’,‘-x’] mp_tac >> simp[COTH_NEG]) >>
4960 simp[] >> rw[] >> irule DIFF_NEG_ANTIMONO_LT_OU >> simp[] >>
4961 qexists ‘0’ >> simp[] >> rw[] >> qexists ‘1 - (coth z)²’ >>
4962 simp[DIFF_COTH,REAL_LT_SUB_RADD] >>
4963 qspecl_then [‘1’,‘1’,‘coth z’] mp_tac POW_LT >>
4964 simp[] >> disch_then irule >> qspec_then ‘z’ mp_tac COTH_BOUNDS >> rw[] >>
4965 ‘0 < coth z’ by simp[COTH_POS_LT] >> dxrule_all REAL_LT_TRANS >> simp[]
4966QED
4967
4968Theorem COTH_ANTIMONO_LE:
4969 !x y. (y < 0 \/ 0 < x) /\ x <= y ==> coth y <= coth x
4970Proof
4971 rw[] >> Cases_on ‘x = y’ >> gs[REAL_LE_LT,COTH_ANTIMONO_LT]
4972QED
4973
4974(*** Hyperbolic Trig Pythagorean-likes ***)
4975
4976Theorem COSH_SQ_SINH_SQ:
4977 !x. (cosh x)² - (sinh x)² = 1
4978Proof
4979 rw[cosh_def,sinh_def,REAL_DIV_SUB] >>
4980 simp[ADD_POW_2,SUB_POW_2,EXP_NEG_MUL,real_sub,REAL_NEG_ADD]
4981QED
4982
4983Theorem SECH_SQ_TANH_SQ:
4984 !x. (sech x)² + (tanh x)² = 1
4985Proof
4986 simp[sech_def,tanh_def,REAL_DIV_ADD,POW_NZ,COSH_NZ] >>
4987 simp[SRULE [REAL_EQ_SUB_RADD] COSH_SQ_SINH_SQ]
4988QED
4989
4990Theorem COTH_SQ_CSCH_SQ:
4991 !x. x <> 0 ==> (coth x)² - (csch x)² = 1
4992Proof
4993 simp[coth_alt,csch_def,REAL_DIV_SUB,POW_NZ,SINH_NZ] >>
4994 simp[SRULE [REAL_EQ_SUB_RADD] COSH_SQ_SINH_SQ]
4995QED
4996
4997(*** Inverse Hyperbolic Trig Definitions ***)
4998
4999Definition asinh_def:
5000 asinh y = @x. sinh x = y
5001End
5002
5003Definition acosh_def:
5004 acosh y = @x. 0 <= x /\ cosh x = y
5005End
5006
5007Definition atanh_def:
5008 atanh y = @x. tanh x = y
5009End
5010
5011Definition asech_def:
5012 asech y = @x. 0 <= x /\ sech x = y
5013End
5014
5015Definition acsch_def:
5016 acsch y = @x. x <> 0 /\ csch x = y
5017End
5018
5019Definition acoth_def:
5020 acoth y = @x. x <> 0 /\ coth x = y
5021End
5022
5023(*** Inverse Hyperbolic Trig Witnesses, Inversions, and Zero Lemmas ***)
5024
5025Theorem ASINH_WITNESS[local]:
5026 !y. sinh (ln (y + sqrt (y² + 1))) = y
5027Proof
5028 rw[] >> simp[sinh_def] >> qabbrev_tac ‘z = (y + sqrt (y² + 1))’ >>
5029 ‘0 < z’ by (simp[Abbr ‘z’] >> irule ABS_BOUND >>
5030 simp[] >> irule REAL_LET_TRANS >> irule_at Any SQRT_MONO_LT >>
5031 qexists ‘y²’ >> simp[SQRT_POW_2_ABS]) >>
5032 simp[GSYM LN_INV,iffRL EXP_LN,REAL_INV_1OVER] >>
5033 irule REAL_EQ_LMUL_IMP >> qexists ‘z’ >>
5034 simp[REAL_SUB_LDISTRIB,Excl "REAL_EQ_LMUL",Excl "RMUL_EQNORM1",Excl "RMUL_EQNORM2"] >>
5035 qunabbrev_tac ‘z’ >> simp[ADD_POW_2,REAL_ADD_LDISTRIB] >>
5036 ‘0 <= y² + 1’ by simp[REAL_LE_ADD] >> simp[SQRT_POW_2]
5037QED
5038
5039Theorem ASINH_UNIQUE[local]:
5040 !x y z. sinh x = y /\ sinh z = y ==> x = z
5041Proof
5042 simp[] >> rpt gen_tac >> CONV_TAC CONTRAPOS_CONV >>
5043 rw[] >> wlog_tac ‘x < z’ [‘x’,‘z’]
5044 >- (first_x_assum $ irule o GSYM >> simp[]) >>
5045 dxrule_then mp_tac SINH_MONO_LT >> simp[]
5046QED
5047
5048Theorem ASINH_SINH:
5049 !x. asinh (sinh x) = x
5050Proof
5051 rw[asinh_def] >> irule SELECT_UNIQUE_ALT >> simp[ASINH_UNIQUE]
5052QED
5053
5054Theorem SINH_ASINH:
5055 !x. sinh (asinh x) = x
5056Proof
5057 rw[asinh_def] >> SELECT_ELIM_TAC >>
5058 simp[ASINH_UNIQUE] >> metis_tac[ASINH_WITNESS]
5059QED
5060
5061Theorem ASINH_POS_LE:
5062 !x. 0 <= x ==> 0 <= asinh x
5063Proof
5064 strip_tac >> CONV_TAC CONTRAPOS_CONV >> simp[REAL_NOT_LE] >>
5065 qspec_then ‘asinh x’ mp_tac SINH_NEG_LT >> simp[SINH_ASINH]
5066QED
5067
5068Theorem ASINH_POS_LT:
5069 !x. 0 < x ==> 0 < asinh x
5070Proof
5071 strip_tac >> CONV_TAC CONTRAPOS_CONV >> simp[REAL_NOT_LT] >>
5072 qspec_then ‘asinh x’ mp_tac SINH_NEG_LE >> simp[SINH_ASINH]
5073QED
5074
5075Theorem ASINH_NEG_LE:
5076 !x. x <= 0 ==> asinh x <= 0
5077Proof
5078 strip_tac >> CONV_TAC CONTRAPOS_CONV >> simp[REAL_NOT_LE] >>
5079 qspec_then ‘asinh x’ mp_tac SINH_POS_LT >> simp[SINH_ASINH]
5080QED
5081
5082Theorem ASINH_NEG_LT:
5083 !x. x < 0 ==> asinh x < 0
5084Proof
5085 strip_tac >> CONV_TAC CONTRAPOS_CONV >> simp[REAL_NOT_LT] >>
5086 qspec_then ‘asinh x’ mp_tac SINH_POS_LE >> simp[SINH_ASINH]
5087QED
5088
5089Theorem ASINH_NZ:
5090 !x. asinh x <> 0 <=> x <> 0
5091Proof
5092 rw[] >> qspec_then ‘asinh x’ mp_tac SINH_NZ >> simp[SINH_ASINH]
5093QED
5094
5095Theorem ASINH_0:
5096 asinh 0 = 0
5097Proof
5098 simp[SRULE [] ASINH_NZ]
5099QED
5100
5101Theorem ACOSH_WITNESS[local]:
5102 !y. 1 <= y ==> 0 <= ln (y + sqrt (y² - 1)) /\ cosh (ln (y + sqrt (y² - 1))) = y
5103Proof
5104 gen_tac >> strip_tac >> irule_at Any LN_POS >> conj_asm1_tac
5105 >- (irule REAL_LE_TRANS >> first_assum $ irule_at Any >> simp[] >>
5106 irule SQRT_POS_LE >> simp[REAL_SUB_LE,REAL_LE1_POW2]) >>
5107 simp[cosh_def] >> qabbrev_tac ‘z = (y + sqrt (y² - 1))’ >>
5108 ‘0 < z’ by (simp[]) >> simp[GSYM LN_INV,iffRL EXP_LN,REAL_INV_1OVER] >>
5109 irule REAL_EQ_LMUL_IMP >> qexists ‘z’ >>
5110 simp[REAL_ADD_LDISTRIB,Excl "REAL_EQ_LMUL",Excl "RMUL_EQNORM1",Excl "RMUL_EQNORM2"] >>
5111 qunabbrev_tac ‘z’ >> simp[ADD_POW_2,REAL_ADD_LDISTRIB] >>
5112 ‘0 <= y² - 1’ by simp[REAL_SUB_LE,REAL_LE1_POW2] >> simp[SQRT_POW_2]
5113QED
5114
5115Theorem ACOSH_UNIQUE[local]:
5116 !x y z. 0 <= x /\ cosh x = y /\ 0 <= z /\ cosh z = y ==> x = z
5117Proof
5118 rw[] >> qpat_x_assum ‘_ = _’ mp_tac >>
5119 CONV_TAC CONTRAPOS_CONV >>
5120 rw[] >> wlog_tac ‘x < z’ [‘x’,‘z’]
5121 >- (first_x_assum $ irule o GSYM >> simp[]) >>
5122 dxrule_all_then mp_tac COSH_MONO_LT >> simp[]
5123QED
5124
5125Theorem ACOSH_COSH:
5126 !x. 0 <= x ==> acosh (cosh x) = x
5127Proof
5128 rw[acosh_def] >> irule SELECT_UNIQUE_ALT >> simp[ACOSH_UNIQUE]
5129QED
5130
5131Theorem ACOSH_COSH_NEG:
5132 !x. x <= 0 ==> acosh (cosh x) = -x
5133Proof
5134 rw[] >> qspec_then ‘-x’ mp_tac ACOSH_COSH >>
5135 simp[COSH_NEG]
5136QED
5137
5138Theorem COSH_ACOSH:
5139 !x. 1 <= x ==> cosh (acosh x) = x
5140Proof
5141 rw[acosh_def] >> SELECT_ELIM_TAC >>
5142 simp[ACOSH_UNIQUE] >> metis_tac[ACOSH_WITNESS]
5143QED
5144
5145Theorem ACOSH_1:
5146 acosh 1 = 0
5147Proof
5148 mp_tac COSH_0 >> disch_then $ SUBST1_TAC o SYM >> simp[ACOSH_COSH]
5149QED
5150
5151Theorem ACOSH_NZ:
5152 !x. 1 < x ==> acosh x <> 0
5153Proof
5154 rw[] >> simp[acosh_def] >> SELECT_ELIM_TAC >>
5155 conj_asm1_tac >- metis_tac[ACOSH_WITNESS,REAL_LE_LT] >>
5156 gs[] >> strip_tac >> gs[COSH_0]
5157QED
5158
5159Theorem ACOSH_POS_LE:
5160 !x. 1 <= x ==> 0 <= acosh x
5161Proof
5162 rw[acosh_def] >> SELECT_ELIM_TAC >>
5163 simp[ACOSH_UNIQUE] >> metis_tac[ACOSH_WITNESS]
5164QED
5165
5166Theorem ACOSH_POS_LT:
5167 !x. 1 < x ==> 0 < acosh x
5168Proof
5169 rw[] >> ‘acosh x <> 0’ suffices_by metis_tac[SRULE [REAL_LE_LT] ACOSH_POS_LE] >>
5170 simp[ACOSH_NZ]
5171QED
5172
5173Theorem ATANH_WITNESS[local]:
5174 !y. -1 < y /\ y < 1 ==> tanh (ln ((1 + y) / (1 - y)) / 2) = y
5175Proof
5176 rw[tanh_alt2] >> qabbrev_tac ‘z = ((1 + y) / (1 - y))’ >>
5177 ‘0 < z’ by simp[Abbr ‘z’] >> simp[iffRL EXP_LN] >>
5178 simp[Abbr ‘z’] >> simp[real_sub,add_ratl]
5179QED
5180
5181Theorem ATANH_UNIQUE[local]:
5182 !x y z. tanh x = y /\ tanh z = y ==> x = z
5183Proof
5184 simp[] >> rpt gen_tac >> CONV_TAC CONTRAPOS_CONV >>
5185 rw[] >> wlog_tac ‘x < z’ [‘x’,‘z’]
5186 >- (first_x_assum $ irule o GSYM >> simp[]) >>
5187 dxrule_all_then mp_tac TANH_MONO_LT >> simp[]
5188QED
5189
5190Theorem ATANH_TANH:
5191 !x. atanh (tanh x) = x
5192Proof
5193 rw[atanh_def] >> irule SELECT_UNIQUE_ALT >> simp[ATANH_UNIQUE]
5194QED
5195
5196Theorem TANH_ATANH:
5197 !x. -1 < x /\ x < 1 ==> tanh (atanh x) = x
5198Proof
5199 rw[atanh_def] >> SELECT_ELIM_TAC >>
5200 simp[ATANH_UNIQUE] >> metis_tac[ATANH_WITNESS]
5201QED
5202
5203Theorem ATANH_NZ:
5204 !x. -1 < x /\ x <> 0 /\ x < 1 ==> atanh x <> 0
5205Proof
5206 rw[] >> qspec_then ‘atanh x’ mp_tac TANH_NZ >> simp[TANH_ATANH]
5207QED
5208
5209Theorem ATANH_0:
5210 atanh 0 = 0
5211Proof
5212 mp_tac TANH_0 >> disch_then $ SUBST1_TAC o SYM >>
5213 simp[ATANH_TANH] >> simp[TANH_0]
5214QED
5215
5216Theorem ATANH_POS_LE:
5217 !x. 0 <= x /\ x < 1 ==> 0 <= atanh x
5218Proof
5219 rw[] >> ‘-1 < x’ by (irule REAL_LTE_TRANS >> qexists ‘0’ >> simp[]) >>
5220 qpat_x_assum ‘0 <= _’ mp_tac >> CONV_TAC CONTRAPOS_CONV >> simp[REAL_NOT_LE] >>
5221 qspec_then ‘atanh x’ mp_tac TANH_NEG_LT >> simp[TANH_ATANH]
5222QED
5223
5224Theorem ATANH_POS_LT:
5225 !x. 0 < x /\ x < 1 ==> 0 < atanh x
5226Proof
5227 rw[] >> ‘-1 < x’ by (irule REAL_LTE_TRANS >> qexists ‘0’ >> simp[]) >>
5228 qpat_x_assum ‘0 < _’ mp_tac >> CONV_TAC CONTRAPOS_CONV >> simp[REAL_NOT_LT] >>
5229 qspec_then ‘atanh x’ mp_tac TANH_NEG_LE >> simp[TANH_ATANH]
5230QED
5231
5232Theorem ATANH_NEG_LE:
5233 !x. -1 < x /\ x <= 0 ==> atanh x <= 0
5234Proof
5235 rw[] >> ‘x < 1’ by (irule REAL_LET_TRANS >> qexists ‘0’ >> simp[]) >>
5236 qpat_x_assum ‘_ <= 0’ mp_tac >> CONV_TAC CONTRAPOS_CONV >> simp[REAL_NOT_LE] >>
5237 qspec_then ‘atanh x’ mp_tac TANH_POS_LT >> simp[TANH_ATANH]
5238QED
5239
5240Theorem ATANH_NEG_LT:
5241 !x. -1 < x /\ x < 0 ==> atanh x < 0
5242Proof
5243 rw[] >> ‘x < 1’ by (irule REAL_LET_TRANS >> qexists ‘0’ >> simp[]) >>
5244 qpat_x_assum ‘_ < 0’ mp_tac >> CONV_TAC CONTRAPOS_CONV >> simp[REAL_NOT_LT] >>
5245 qspec_then ‘atanh x’ mp_tac TANH_POS_LE >> simp[TANH_ATANH]
5246QED
5247
5248Theorem ASECH_WITNESS[local]:
5249 !y. 0 < y /\ y <= 1 ==> 0 <= (acosh y⁻¹) /\ sech (acosh y⁻¹) = y
5250Proof
5251 gen_tac >> strip_tac >> simp[sech_def,ACOSH_POS_LE,COSH_ACOSH]
5252QED
5253
5254Theorem ASECH_UNIQUE[local]:
5255 !x y z. 0 <= x /\ sech x = y /\ 0 <= z /\ sech z = y ==> x = z
5256Proof
5257 rw[] >> qpat_x_assum ‘_ = _’ mp_tac >>
5258 CONV_TAC CONTRAPOS_CONV >>
5259 rw[] >> wlog_tac ‘x < z’ [‘x’,‘z’]
5260 >- (first_x_assum $ irule o GSYM >> simp[]) >>
5261 dxrule_all_then mp_tac SECH_ANTIMONO_LT >> simp[]
5262QED
5263
5264Theorem ASECH_SECH:
5265 !x. 0 <= x ==> asech (sech x) = x
5266Proof
5267 rw[asech_def] >> irule SELECT_UNIQUE_ALT >> simp[ASECH_UNIQUE]
5268QED
5269
5270Theorem ASECH_SECH_NEG:
5271 !x. x <= 0 ==> asech (sech x) = -x
5272Proof
5273 rw[] >> qspec_then ‘-x’ mp_tac ASECH_SECH >>
5274 simp[SECH_NEG]
5275QED
5276
5277Theorem SECH_ASECH:
5278 !x. 0 < x /\ x <= 1 ==> sech (asech x) = x
5279Proof
5280 rw[asech_def] >> SELECT_ELIM_TAC >>
5281 simp[ASECH_UNIQUE] >> metis_tac[ASECH_WITNESS]
5282QED
5283
5284Theorem ASECH_1:
5285 asech 1 = 0
5286Proof
5287 mp_tac SECH_0 >> disch_then $ SUBST1_TAC o SYM >> simp[ASECH_SECH]
5288QED
5289
5290Theorem ASECH_POS_LE:
5291 !x. 0 < x /\ x <= 1 ==> 0 <= asech x
5292Proof
5293 rw[asech_def] >> SELECT_ELIM_TAC >>
5294 simp[ASECH_UNIQUE] >> metis_tac[ASECH_WITNESS]
5295QED
5296
5297Theorem ASECH_NZ:
5298 !x. 0 < x /\ x < 1 ==> asech x <> 0
5299Proof
5300 rw[] >> simp[asech_def] >> SELECT_ELIM_TAC >>
5301 conj_asm1_tac >- metis_tac[ASECH_WITNESS,REAL_LE_LT] >>
5302 gs[] >> strip_tac >> gs[SECH_0]
5303QED
5304
5305Theorem ASECH_POS_LT:
5306 !x. 0 < x /\ x < 1 ==> 0 < asech x
5307Proof
5308 metis_tac[REAL_LE_LT,ASECH_POS_LE,ASECH_NZ]
5309QED
5310
5311Theorem ACSCH_WITNESS[local]:
5312 !y. y <> 0 ==> asinh y⁻¹ <> 0 /\ csch (asinh y⁻¹) = y
5313Proof
5314 gen_tac >> strip_tac >> simp[csch_def,SINH_ASINH,ASINH_NZ]
5315QED
5316
5317Theorem ACSCH_UNIQUE[local]:
5318 !x y z. x <> 0 /\ csch x = y /\ z <> 0 /\ csch z = y ==> x = z
5319Proof
5320 rw[] >> qpat_x_assum ‘_ = _’ mp_tac >>
5321 CONV_TAC CONTRAPOS_CONV >>
5322 rw[] >> wlog_tac ‘x < z’ [‘x’,‘z’]
5323 >- (first_x_assum $ irule o GSYM >> simp[]) >>
5324 Cases_on ‘z < 0 \/ 0 < x’
5325 >- (dxrule_all_then mp_tac CSCH_ANTIMONO_LT >> simp[]) >>
5326 gs[] >> ‘csch x < csch z’ suffices_by simp[] >>
5327 irule REAL_LT_TRANS >> qexists ‘0’ >> simp[CSCH_NEG_LT,CSCH_POS_LT]
5328QED
5329
5330Theorem ACSCH_CSCH:
5331 !x. x <> 0 ==> acsch (csch x) = x
5332Proof
5333 rw[acsch_def] >> irule SELECT_UNIQUE_ALT >> simp[ACSCH_UNIQUE]
5334QED
5335
5336Theorem CSCH_ACSCH:
5337 !x. x <> 0 ==> csch (acsch x) = x
5338Proof
5339 rw[acsch_def] >> SELECT_ELIM_TAC >>
5340 simp[ACSCH_UNIQUE] >> metis_tac[ACSCH_WITNESS]
5341QED
5342
5343Theorem ACSCH_NZ:
5344 !x. x <> 0 ==> acsch x <> 0
5345Proof
5346 rw[acsch_def] >> SELECT_ELIM_TAC >>
5347 simp[ACSCH_UNIQUE] >> metis_tac[ACSCH_WITNESS]
5348QED
5349
5350Theorem ACSCH_POS_LT:
5351 !x. 0 < x ==> 0 < acsch x
5352Proof
5353 rw[] >> ‘x <> 0’ by simp[REAL_LT_IMP_NE] >>
5354 last_x_assum mp_tac >> CONV_TAC CONTRAPOS_CONV >>
5355 simp[REAL_NOT_LT,REAL_LE_LT,ACSCH_NZ] >>
5356 qspec_then ‘acsch x’ mp_tac CSCH_NEG_LT >> simp[CSCH_ACSCH]
5357QED
5358
5359Theorem ACSCH_NEG_LT:
5360 !x. x < 0 ==> acsch x < 0
5361Proof
5362 rw[] >> ‘x <> 0’ by simp[REAL_LT_IMP_NE] >>
5363 last_x_assum mp_tac >> CONV_TAC CONTRAPOS_CONV >>
5364 simp[REAL_NOT_LT,REAL_LE_LT,ACSCH_NZ] >>
5365 qspec_then ‘acsch x’ mp_tac CSCH_POS_LT >> simp[CSCH_ACSCH]
5366QED
5367
5368Theorem ACOTH_WITNESS[local]:
5369 !y. y < -1 \/ 1 < y ==> atanh y⁻¹ <> 0 /\ coth (atanh y⁻¹) = y
5370Proof
5371 gen_tac >> strip_tac >> simp[coth_def,TANH_ATANH,ATANH_NZ]
5372QED
5373
5374Theorem ACOTH_UNIQUE[local]:
5375 !x y z. x <> 0 /\ coth x = y /\ z <> 0 /\ coth z = y ==> x = z
5376Proof
5377 rw[] >> qpat_x_assum ‘_ = _’ mp_tac >>
5378 CONV_TAC CONTRAPOS_CONV >> rw[] >> wlog_tac ‘x < z’ [‘x’,‘z’]
5379 >- (first_x_assum $ irule o GSYM >> simp[]) >>
5380 Cases_on ‘z < 0 \/ 0 < x’
5381 >- (dxrule_all_then mp_tac COTH_ANTIMONO_LT >> simp[]) >>
5382 gs[] >> ‘coth x < coth z’ suffices_by simp[] >>
5383 irule REAL_LT_TRANS >> qexists ‘0’ >> simp[COTH_NEG_LT,COTH_POS_LT]
5384QED
5385
5386Theorem ACOTH_COTH:
5387 !x. x <> 0 ==> acoth (coth x) = x
5388Proof
5389 rw[acoth_def] >> irule SELECT_UNIQUE_ALT >> simp[ACOTH_UNIQUE]
5390QED
5391
5392Theorem COTH_ACOTH:
5393 !x. x < -1 \/ 1 < x ==> coth (acoth x) = x
5394Proof
5395 rw[acoth_def] >> SELECT_ELIM_TAC >>
5396 simp[ACOTH_UNIQUE] >> metis_tac[ACOTH_WITNESS]
5397QED
5398
5399Theorem ACOTH_NZ:
5400 !x. x < -1 \/ 1 < x ==> acoth x <> 0
5401Proof
5402 rw[acoth_def] >> SELECT_ELIM_TAC >>
5403 simp[ACOTH_UNIQUE] >> metis_tac[ACOTH_WITNESS]
5404QED
5405
5406Theorem ACOTH_POS_LT:
5407 !x. 1 < x ==> 0 < acoth x
5408Proof
5409 rw[] >> qspec_then ‘acoth x’ mp_tac COTH_NEG_LT >> simp[COTH_ACOTH] >>
5410 simp[REAL_NOT_LT,REAL_LE_LT,ACOTH_NZ]
5411QED
5412
5413Theorem ACOTH_NEG_LT:
5414 !x. x < -1 ==> acoth x < 0
5415Proof
5416 rw[] >> qspec_then ‘acoth x’ mp_tac COTH_POS_LT >> simp[COTH_ACOTH] >>
5417 simp[REAL_NOT_LT,REAL_LE_LT,ACOTH_NZ]
5418QED
5419
5420(*** Inverse Hyperbolic Trig as Arguement Inverses ***)
5421
5422Theorem ASECH_EQ_ACOSH:
5423 !x. 0 < x /\ x <= 1 ==> asech x = acosh x⁻¹
5424Proof
5425 qx_gen_tac ‘y’ >> rw[asech_def] >> irule SELECT_UNIQUE_ALT >>
5426 simp[ASECH_WITNESS,ASECH_UNIQUE]
5427QED
5428
5429Theorem ACSCH_EQ_ASINH:
5430 !x. x <> 0 ==> acsch x = asinh x⁻¹
5431Proof
5432 qx_gen_tac ‘y’ >> rw[acsch_def] >> irule SELECT_UNIQUE_ALT >>
5433 simp[ACSCH_WITNESS,ACSCH_UNIQUE]
5434QED
5435
5436Theorem ACOTH_EQ_ATANH:
5437 !x. x < -1 \/ 1 < x ==> acoth x = atanh x⁻¹
5438Proof
5439 qx_gen_tac ‘y’ >> rw[acoth_def] >> irule SELECT_UNIQUE_ALT >>
5440 simp[ACOTH_WITNESS,ACOTH_UNIQUE]
5441QED
5442
5443(*** Inverse Hyperbolic Trig as Natural Log ***)
5444
5445Theorem ASINH_EQ_LN:
5446 !x. asinh x = ln (x + sqrt (x² + 1))
5447Proof
5448 qx_gen_tac ‘y’ >> simp[asinh_def] >> irule SELECT_UNIQUE_ALT >>
5449 simp[ASINH_WITNESS,ASINH_UNIQUE]
5450QED
5451
5452Theorem ACOSH_EQ_LN:
5453 !x. 1 <= x ==> acosh x = ln (x + sqrt (x² - 1))
5454Proof
5455 qx_gen_tac ‘y’ >> rw[acosh_def] >> irule SELECT_UNIQUE_ALT >>
5456 simp[ACOSH_WITNESS,ACOSH_UNIQUE]
5457QED
5458
5459Theorem ATANH_EQ_LN:
5460 !x. -1 < x /\ x < 1 ==> atanh x = ln ((1 + x) / (1 - x)) / 2
5461Proof
5462 qx_gen_tac ‘y’ >> rw[atanh_def,Excl "RMUL_EQNORM4"] >>
5463 irule SELECT_UNIQUE_ALT >> simp[ATANH_WITNESS,ATANH_UNIQUE,Excl "RMUL_EQNORM4"]
5464QED
5465
5466Theorem ASECH_EQ_LN:
5467 !x. 0 < x /\ x <= 1 ==> asech x = ln (x⁻¹ + sqrt (x⁻¹ ² - 1))
5468Proof
5469 simp[ASECH_EQ_ACOSH,ACOSH_EQ_LN]
5470QED
5471
5472Theorem ACSCH_EQ_LN:
5473 !x. x <> 0 ==> acsch x = ln (x⁻¹ + sqrt (x⁻¹ ² + 1))
5474Proof
5475 simp[ACSCH_EQ_ASINH,ASINH_EQ_LN]
5476QED
5477
5478Theorem ACOTH_EQ_LN:
5479 !x. (x < -1 \/ 1 < x) ==> acoth x = ln ((x + 1) / (x - 1)) / 2
5480Proof
5481 rw[] >> simp[ACOTH_EQ_ATANH,ATANH_EQ_LN] >> AP_TERM_TAC >>
5482 simp[REAL_INV_1OVER,REAL_SUB_LDISTRIB,REAL_ADD_LDISTRIB]
5483QED
5484
5485(* natural log as atanh *)
5486
5487Theorem LN_EQ_ATANH:
5488 !x. 0 < x ==> ln x = 2 * atanh ((x - 1) / (x + 1))
5489Proof
5490 rw[] >> qabbrev_tac ‘y = (x - 1) / (x + 1)’ >>
5491 ‘-1 < y /\ y < 1’ by simp[Abbr ‘y’] >> simp[ATANH_EQ_LN] >>
5492 AP_TERM_TAC >> simp[Abbr ‘y’,real_sub,neg_rat,add_ratr]
5493QED
5494
5495(*** Inverse Hyperbolic Trig Negative Inputs ***)
5496
5497(*
5498SINH, TANH
5499CSCH, COTH
5500*)
5501
5502Theorem ASINH_NEG:
5503 !x. asinh (-x) = -asinh x
5504Proof
5505 rw[] >> qspec_then ‘x’ mp_tac ASINH_WITNESS >> rename [‘sinh x’] >>
5506 disch_then $ SUBST1_TAC o SYM >> simp[ASINH_SINH,GSYM SINH_NEG]
5507QED
5508
5509Theorem ATANH_NEG:
5510 !x. -1 < x /\ x < 1 ==> atanh (-x) = -atanh x
5511Proof
5512 rw[] >> qspec_then ‘x’ mp_tac ATANH_WITNESS >> simp[] >> rename [‘tanh x’] >>
5513 disch_then $ SUBST1_TAC o SYM >> simp[ATANH_TANH,GSYM TANH_NEG]
5514QED
5515
5516Theorem ACSCH_NEG:
5517 !x. x <> 0 ==> acsch (-x) = -acsch x
5518Proof
5519 rw[] >> qspec_then ‘x’ mp_tac ACSCH_WITNESS >>
5520 ‘asinh x⁻¹ <> 0’ by simp[ASINH_NZ,REAL_INV_NZ] >> simp[] >> rename [‘csch x’] >>
5521 disch_then $ SUBST1_TAC o SYM >> simp[ACSCH_CSCH,GSYM CSCH_NEG]
5522QED
5523
5524Theorem ACOTH_NEG:
5525 !x. x < -1 \/ 1 < x ==> acoth (-x) = -acoth x
5526Proof
5527 rw[] >> qspec_then ‘x’ mp_tac ACOTH_WITNESS >>
5528 ‘atanh x⁻¹ <> 0’ by (irule ATANH_NZ >> simp[]) >>
5529 simp[] >> rename [‘coth x’] >>
5530 disch_then $ SUBST1_TAC o SYM >> simp[ACOTH_COTH,GSYM COTH_NEG]
5531QED
5532
5533(*** Inverse Hyperbolic Trig Mixed Inverses ***)
5534
5535(*
5536https://en.wikipedia.org/wiki/Inverse_hyperbolic_functions#Composition_of_hyperbolic_and_inverse_hyperbolic_functions
5537*)
5538
5539Theorem SINH_ACOSH:
5540 !x. 1 < x ==> sinh (acosh x) = sqrt (x² - 1)
5541Proof
5542 ‘!x. 0 <= x ==> sinh x = sqrt ((cosh x)² - 1)’ suffices_by (rw[] >>
5543 first_x_assum $ qspec_then ‘acosh x’ mp_tac >> simp[COSH_ACOSH,ACOSH_POS_LE]) >>
5544 rw[] >> irule EQ_SYM >> irule SQRT_POS_UNIQ >> (*HERE*)
5545 simp[SRULE [REAL_EQ_SUB_RADD] COSH_SQ_SINH_SQ,REAL_SUB_LE,SINH_POS_LE]
5546QED
5547
5548Theorem COSH_ASINH:
5549 !x. cosh (asinh x) = sqrt (x² + 1)
5550Proof
5551 ‘!x. cosh x = sqrt ((sinh x)² + 1)’ suffices_by simp[SINH_ASINH] >>
5552 rw[] >> irule EQ_SYM >> irule SQRT_POS_UNIQ >>
5553 simp[SRULE [REAL_EQ_SUB_RADD] COSH_SQ_SINH_SQ,REAL_LE_ADD,REAL_LE_LT,COSH_POS_LT]
5554QED
5555
5556(*** Inverse Hyperbolic Trig Derivatives ***)
5557
5558Theorem DIFF_ASINH:
5559 !x. (asinh diffl (sqrt (x² + 1))⁻¹) x
5560Proof
5561 rw[] >>
5562 qspecl_then [‘sinh’,‘asinh’,‘sqrt (x² + 1)’,‘asinh x - 1’,‘asinh x’,‘asinh x + 1’]
5563 mp_tac DIFF_INVERSE_OPEN >>
5564 simp[SINH_ASINH,ASINH_SINH] >> disch_then irule >> rw[]
5565 >- metis_tac[DIFF_SINH,DIFF_CONT]
5566 >- (irule SQRT_POS_NE >> irule REAL_LTE_TRANS >> qexists ‘1’ >> simp[])
5567 >- (qspecl_then [‘asinh x’] mp_tac DIFF_SINH >> simp[COSH_ASINH])
5568QED
5569
5570Theorem DIFF_ACOSH:
5571 !x. 1 < x ==> (acosh diffl (sqrt (x² - 1))⁻¹) x
5572Proof
5573 rw[] >>
5574 qspecl_then [‘cosh’,‘acosh’,‘sqrt (x² - 1)’,‘0’,‘acosh x’,‘acosh x + 1’]
5575 mp_tac DIFF_INVERSE_OPEN >>
5576 simp[COSH_ACOSH,ACOSH_COSH] >> disch_then irule >> rw[]
5577 >- metis_tac[DIFF_COSH,DIFF_CONT]
5578 >- (irule SQRT_POS_NE >> simp[REAL_SUB_LT] >>
5579 qspecl_then [‘1’,‘x’,‘1’,‘x’] mp_tac REAL_LT_MUL2 >> simp[])
5580 >- simp[ACOSH_POS_LT]
5581 >- (qspecl_then [‘acosh x’] mp_tac DIFF_COSH >> simp[SINH_ACOSH])
5582QED
5583
5584Theorem DIFF_ATANH:
5585 !x. -1 < x /\ x < 1 ==> (atanh diffl (1 - x²)⁻¹) x
5586Proof
5587 rw[] >>
5588 qspecl_then [‘tanh’,‘atanh’,‘1 - x²’,‘atanh x - 1’,‘atanh x’,‘atanh x + 1’]
5589 mp_tac DIFF_INVERSE_OPEN >>
5590 simp[TANH_ATANH,ATANH_TANH] >> disch_then irule >> rw[]
5591 >- metis_tac[DIFF_TANH,DIFF_CONT]
5592 >- (wlog_tac ‘0 <= x’ [‘x’] >- (first_x_assum $ qspec_then ‘-x’ mp_tac >> simp[]) >>
5593 qspecl_then [‘x’,‘1’,‘x’,‘1’] mp_tac REAL_LT_MUL2 >> simp[])
5594 >- (qspecl_then [‘atanh x’] mp_tac DIFF_TANH >> simp[TANH_ATANH])
5595QED
5596
5597Theorem DIFF_ASECH:
5598 !x. 0 < x /\ x < 1 ==> (asech diffl -(x * sqrt (1 - x²))⁻¹) x
5599Proof
5600 rw[] >>
5601 qspecl_then [‘acosh’,‘λx. x⁻¹’] mp_tac DIFF_CHAIN >> simp[] >>
5602 disch_then (resolve_then Any
5603 (resolve_then Any (qspec_then ‘x’ mp_tac) DIFF_ACOSH) $ DIFF_CONV “λx:real. x⁻¹”) >>
5604 simp[] >> strip_tac >> irule $ iffLR DIFF_CONG >> pop_assum $ irule_at Any >>
5605 qexistsl [‘1’,‘0’] >> simp[ASECH_EQ_ACOSH,iffRL REAL_LE_LT,REAL_INV_MUL'] >>
5606 ‘0 < sqrt (x⁻¹ ² - 1) /\ 0 < sqrt (1 - x²) /\ 0 < x⁻¹ ² - 1’ by (
5607 ntac 2 $ irule_at Any SQRT_POS_LT >> simp[REAL_SUB_LT,POW_2_LT_1]) >>
5608 simp[] >> irule EQ_SYM >> irule SQRT_EQ >>
5609 simp[REAL_LE_MUL,POW_MUL,SQRT_POW_2,REAL_SUB_LDISTRIB]
5610QED
5611
5612Theorem DIFF_ACSCH:
5613 !x. x <> 0 ==> (acsch diffl -(abs x * sqrt (1 + x²))⁻¹) x
5614Proof
5615 rw[] >>
5616 qspecl_then [‘asinh’,‘λx. x⁻¹’] mp_tac DIFF_CHAIN >> simp[] >>
5617 disch_then (resolve_then Any
5618 (resolve_then Any (qspec_then ‘x’ mp_tac) DIFF_ASINH) $ DIFF_CONV “λx:real. x⁻¹”) >>
5619 simp[] >> strip_tac >>
5620 ‘-x⁻¹ ² * (sqrt (x⁻¹ ² + 1))⁻¹ = -(abs x * sqrt (1 + x²))⁻¹’ by (
5621 pop_assum kall_tac >> simp[REAL_INV_MUL'] >>
5622 ‘0 < sqrt (x⁻¹ ² + 1) /\ 0 < sqrt (1 + x²) /\ 0 < x⁻¹ ² + 1 /\ 0 < 1 + x²’ by (
5623 ntac 2 $ irule_at Any SQRT_POS_LT >> simp[REAL_LT_ADD]) >>
5624 simp[] >>
5625 qspecl_then [‘abs x * sqrt (1 + x²)’,‘x² * sqrt (x⁻¹ ² + 1)’]
5626 mp_tac REAL_EQ_SQUARE_ABS >>
5627 simp[REAL_ABS_MUL,iffRL ABS_REFL] >> disch_then kall_tac >>
5628 simp[POW_MUL,SQRT_POW_2,REAL_ADD_LDISTRIB]) >>
5629 pop_assum SUBST_ALL_TAC >> irule $ iffLR DIFF_CONG >> pop_assum $ irule_at Any >>
5630 simp[] >> ‘x < 0 \/ 0 < x’ by simp[]
5631 >| [qexistsl [‘0’,‘x - 1’],qexistsl [‘x + 1’,‘0’]] >> simp[ACSCH_EQ_ASINH]
5632QED
5633
5634Theorem DIFF_ACOTH:
5635 !x. x < -1 \/ 1 < x ==> (acoth diffl (1 - x²)⁻¹) x
5636Proof
5637 rw[] >>
5638 qspecl_then [‘atanh’,‘λx. x⁻¹’] mp_tac DIFF_CHAIN >> simp[] >>
5639 disch_then (resolve_then Any
5640 (resolve_then Any (qspec_then ‘x’ mp_tac) DIFF_ATANH) $ DIFF_CONV “λx:real. x⁻¹”) >>
5641 simp[] >> strip_tac >> irule $ iffLR DIFF_CONG >> pop_assum $ irule_at Any
5642 >| [qexistsl [‘-1’,‘x - 1’],qexistsl [‘x + 1’,‘1’]] >>
5643 simp[ACOTH_EQ_ATANH] >>
5644 ‘1 - x⁻¹ ² <> 0 /\ 1 - x² <> 0’ by (
5645 ‘1 < x²’ suffices_by simp[] >> simp[POW_2_1_LT]) >>
5646 simp[REAL_SUB_LDISTRIB]
5647QED
5648
5649(*** Inverse Hyperbolic Trig Monotonicity ***)
5650
5651Theorem ASINH_MONO_LT:
5652 !x y. x < y ==> asinh x < asinh y
5653Proof
5654 rw[] >> irule DIFF_POS_MONO_LT_UU >> simp[] >>
5655 rw[] >> irule_at Any DIFF_ASINH >> simp[SQRT_POS_LT,REAL_LET_ADD]
5656QED
5657
5658Theorem ASINH_MONO_LE:
5659 !x y. x <= y ==> asinh x <= asinh y
5660Proof
5661 rw[] >> Cases_on ‘x = y’ >> gs[REAL_LE_LT,ASINH_MONO_LT]
5662QED
5663
5664Theorem ACOSH_MONO_LT:
5665 !x y. 1 <= x /\ x < y ==> acosh x < acosh y
5666Proof
5667 reverse $ rw[REAL_LE_LT] >- simp[ACOSH_1,ACOSH_POS_LT] >>
5668 irule DIFF_POS_MONO_LT_OU >> simp[] >>
5669 qexists ‘1’ >> simp[] >> rw[] >>
5670 irule_at Any DIFF_ACOSH >> simp[] >> irule SQRT_POS_LT >>
5671 simp[REAL_SUB_LT,REAL_LT1_POW2]
5672QED
5673
5674Theorem ACOSH_MONO_LE:
5675 !x y. 1 <= x /\ x <= y ==> acosh x <= acosh y
5676Proof
5677 rw[] >> Cases_on ‘x = y’ >> gs[REAL_LE_LT,ACOSH_MONO_LT]
5678QED
5679
5680Theorem ATANH_MONO_LT:
5681 !x y. -1 < x /\ y < 1 /\ x < y ==> atanh x < atanh y
5682Proof
5683 rw[] >> irule DIFF_POS_MONO_LT_OO >> simp[] >>
5684 qexistsl [‘-1’,‘1’] >> simp[] >> rw[] >>
5685 irule_at Any DIFF_ATANH >> simp[REAL_SUB_LT,POW_2_LT_1]
5686QED
5687
5688Theorem ATANH_MONO_LE:
5689 !x y. -1 < x /\ y < 1 /\ x <= y ==> atanh x <= atanh y
5690Proof
5691 rw[] >> Cases_on ‘x = y’ >> gs[REAL_LE_LT,ATANH_MONO_LT]
5692QED
5693
5694Theorem ASECH_ANTIMONO_LT:
5695 !x y. 0 < x /\ y <= 1 /\ x < y ==> asech y < asech x
5696Proof
5697 reverse $ rw[REAL_LE_LT] >- simp[ASECH_1,ASECH_POS_LT] >>
5698 irule DIFF_NEG_ANTIMONO_LT_OO >> simp[] >>
5699 qexistsl [‘0’,‘1’] >> simp[] >> rw[] >>
5700 irule_at Any DIFF_ASECH >> simp[] >> irule REAL_LT_MUL >>
5701 simp[] >> irule SQRT_POS_LT >> simp[REAL_SUB_LT,POW_2_LT_1]
5702QED
5703
5704Theorem ASECH_ANTIMONO_LE:
5705 !x y. 0 < x /\ y <= 1 /\ x <= y ==> asech y <= asech x
5706Proof
5707 rw[] >> Cases_on ‘x = y’ >> gs[REAL_LE_LT,ASECH_ANTIMONO_LT]
5708QED
5709
5710Theorem ACSCH_ANTIMONO_LT:
5711 !x y. (y < 0 \/ 0 < x) /\ x < y ==> acsch y < acsch x
5712Proof
5713 ntac 2 strip_tac >> wlog_tac ‘0 < x’ [‘x’,‘y’]
5714 >- (simp[] >> rw[] >> ‘y <> 0 /\ x <> 0’ by (CCONTR_TAC >> gs[]) >>
5715 last_x_assum $ qspecl_then [‘-y’,‘-x’] mp_tac >> simp[ACSCH_NEG]) >>
5716 rw[] >> irule DIFF_NEG_ANTIMONO_LT_OU >> simp[] >>
5717 qexists ‘0’ >> rw[] >> irule_at Any DIFF_ACSCH >>
5718 simp[] >> irule REAL_LT_MUL >> simp[] >>
5719 irule SQRT_POS_LT >> simp[REAL_LT_ADD]
5720QED
5721
5722Theorem ACSCH_ANTIMONO_LE:
5723 !x y. (y < 0 \/ 0 < x) /\ x <= y ==> acsch y <= acsch x
5724Proof
5725 rw[] >> Cases_on ‘x = y’ >> gs[REAL_LE_LT,ACSCH_ANTIMONO_LT]
5726QED
5727
5728Theorem ACOTH_ANTIMONO_LT:
5729 !x y. (y < -1 \/ 1 < x) /\ x < y ==> acoth y < acoth x
5730Proof
5731 ntac 2 strip_tac >> wlog_tac ‘1 < x’ [‘x’,‘y’]
5732 >- (simp[] >> rw[] >> ‘x < -1’ by (simp[REAL_LT_TRANS]) >>
5733 last_x_assum $ qspecl_then [‘-y’,‘-x’] mp_tac >> simp[ACOTH_NEG]) >>
5734 rw[] >> irule DIFF_NEG_ANTIMONO_LT_OU >> simp[] >>
5735 qexists ‘1’ >> rw[] >> irule_at Any DIFF_ACOTH >>
5736 simp[REAL_LT_SUB_RADD,REAL_LT1_POW2]
5737QED
5738
5739Theorem ACOTH_ANTIMONO_LE:
5740 !x y. (y < -1 \/ 1 < x) /\ x <= y ==> acoth y <= acoth x
5741Proof
5742 rw[] >> Cases_on ‘x = y’ >> gs[REAL_LE_LT,ACOTH_ANTIMONO_LT]
5743QED
5744
5745(* END *)