realScript.sml
1(*---------------------------------------------------------------------------*)
2(* Develop the theory of reals *)
3(*---------------------------------------------------------------------------*)
4
5Theory real
6Ancestors
7 arithmetic num prim_rec While pred_set realax
8 marker[qualified] (* for unint *)
9Libs
10 numLib reduceLib pairLib mesonLib tautLib simpLib Arithconv
11 jrhUtils Canon_Port BasicProvers TotalDefn metisLib hurdUtils
12 RealArith
13
14val TAUT_CONV = jrhUtils.TAUT_CONV; (* conflict with tautLib.TAUT_CONV *)
15val GEN_ALL = hol88Lib.GEN_ALL; (* it has old reverted variable order *)
16val NUM_EQ_CONV = NEQ_CONV;
17
18(*---------------------------------------------------------------------------*)
19(* Now define the inclusion homomorphism &:num->real. (moved to realax) *)
20(*---------------------------------------------------------------------------*)
21
22Theorem real_of_num = real_of_num;
23
24Theorem REAL_0 = REAL_0;
25Theorem REAL_1 = REAL_1;
26
27(* These are primitive real theorems being re-exported here *)
28Theorem REAL_10 = REAL_10';
29Theorem REAL_ADD_SYM = REAL_ADD_SYM;
30Theorem REAL_ADD_COMM = REAL_ADD_SYM;
31Theorem REAL_ADD_ASSOC = REAL_ADD_ASSOC;
32Theorem REAL_ADD_LID[simp] = REAL_ADD_LID';
33Theorem REAL_ADD_LINV[simp] = REAL_ADD_LINV';
34Theorem REAL_LDISTRIB = REAL_LDISTRIB;
35Theorem REAL_LT_TOTAL = REAL_LT_TOTAL;
36Theorem REAL_LT_REFL[simp] = REAL_LT_REFL;
37Theorem REAL_LT_TRANS = REAL_LT_TRANS;
38Theorem REAL_LT_IADD = REAL_LT_IADD;
39Theorem REAL_SUP_ALLPOS = REAL_SUP_ALLPOS';
40Theorem REAL_MUL_SYM = REAL_MUL_SYM;
41Theorem REAL_MUL_COMM = REAL_MUL_SYM;
42Theorem REAL_MUL_ASSOC = REAL_MUL_ASSOC;
43Theorem REAL_MUL_LID[simp] = REAL_MUL_LID';
44Theorem REAL_MUL_LINV = REAL_MUL_LINV';
45Theorem REAL_LT_MUL = REAL_LT_MUL';
46Theorem REAL_INV_0[simp] = REAL_INV_0';
47
48
49(*---------------------------------------------------------------------------*)
50(* Define subtraction, division and the other orderings (moved to realax) *)
51(*---------------------------------------------------------------------------*)
52
53Theorem real_sub = real_sub;
54Theorem real_lte = real_lte;
55Theorem real_gt = real_gt;
56Theorem real_ge = real_ge;
57Theorem real_div = real_div;
58
59(*---------------------------------------------------------------------------*)
60(* Prove lots of boring field theorems *)
61(*---------------------------------------------------------------------------*)
62
63(* |- !x. x + 0 = x *)
64Theorem REAL_ADD_RID[simp] = REAL_ADD_RID;
65
66Theorem REAL_ADD_RINV[simp] = REAL_ADD_RINV;
67
68(* |- !x. x * 1 = x *)
69Theorem REAL_MUL_RID[simp] = REAL_MUL_RID;
70
71Theorem REAL_MUL_RINV:
72 !x. ~(x = 0) ==> (x * inv x = 1)
73Proof
74 GEN_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
75 MATCH_ACCEPT_TAC REAL_MUL_LINV
76QED
77
78(* |- !x y z. (x + y) * z = x * z + y * z *)
79Theorem REAL_RDISTRIB = REAL_RDISTRIB;
80
81Theorem REAL_EQ_LADD[simp] = REAL_EQ_ADD_LCANCEL;
82
83Theorem REAL_EQ_RADD[simp] = REAL_EQ_ADD_RCANCEL;
84
85(* also known as REAL_EQ_ADD_LCANCEL_0 *)
86Theorem REAL_ADD_LID_UNIQ:
87 !x y. (x + y = y) <=> (x = 0)
88Proof
89 REAL_ARITH_TAC
90QED
91
92(* also known as REAL_EQ_ADD_RCANCEL_0 *)
93Theorem REAL_ADD_RID_UNIQ:
94 !x y. (x + y = x) <=> (y = 0)
95Proof
96 REAL_ARITH_TAC
97QED
98
99(* |- !x y. (x + y = 0) <=> (x = -y) *)
100Theorem REAL_LNEG_UNIQ = REAL_LNEG_UNIQ;
101
102(* |- !x y. (x + y = 0) <=> (y = -x) *)
103Theorem REAL_RNEG_UNIQ = REAL_RNEG_UNIQ;
104
105(* |- !x y. -(x + y) = -x + -y *)
106Theorem REAL_NEG_ADD = REAL_NEG_ADD;
107
108(* |- !x. 0 * x = 0 *)
109Theorem REAL_MUL_LZERO[simp] = REAL_MUL_LZERO;
110
111(* |- !x. x * 0 = 0 *)
112Theorem REAL_MUL_RZERO[simp] = REAL_MUL_RZERO;
113
114(* |- !x y. -(x * y) = -x * y *)
115Theorem REAL_NEG_LMUL = REAL_NEG_LMUL;
116
117(* |- !x y. -(x * y) = x * -y *)
118Theorem REAL_NEG_RMUL = REAL_NEG_RMUL;
119
120(* |- !x. --x = x *)
121Theorem REAL_NEGNEG[simp] = REAL_NEG_NEG;
122
123Theorem REAL_NEG_MUL2:
124 !x y. ~x * ~y = x * y
125Proof
126 REAL_ARITH_TAC
127QED
128
129(* |- !x y. (x * y = 0) <=> (x = 0) \/ (y = 0) *)
130Theorem REAL_ENTIRE[simp] = REAL_ENTIRE;
131
132(* |- !x y z. x + y < x + z <=> y < z *)
133Theorem REAL_LT_LADD[simp] = REAL_LT_LADD;
134
135(* |- !x y z. x + z < y + z <=> x < y *)
136Theorem REAL_LT_RADD[simp] = REAL_LT_RADD;
137
138(* |- !x y. ~(x < y) <=> y <= x *)
139Theorem REAL_NOT_LT = REAL_NOT_LT;
140
141(* |- !x y. ~(x < y /\ y < x) *)
142Theorem REAL_LT_ANTISYM = REAL_LT_ANTISYM;
143
144(* |- !x y. x < y ==> ~(y < x) *)
145Theorem REAL_LT_GT = REAL_LT_GT;
146
147(* |- !x y. ~(x <= y) <=> y < x *)
148Theorem REAL_NOT_LE = REAL_NOT_LE;
149
150(* |- !x y. x <= y \/ y <= x *)
151Theorem REAL_LE_TOTAL = REAL_LE_TOTAL;
152
153(* |- !x y. x <= y \/ y < x *)
154Theorem REAL_LET_TOTAL = REAL_LET_TOTAL;
155
156(* |- !x y. x < y \/ y <= x *)
157Theorem REAL_LTE_TOTAL = REAL_LTE_TOTAL;
158
159(* |- !x. x <= x *)
160Theorem REAL_LE_REFL[simp] = REAL_LE_REFL;
161
162(* |- !x y. x <= y <=> x < y \/ (x = y) *)
163Theorem REAL_LE_LT = REAL_LE_LT;
164
165(* |- !x y. x < y <=> x <= y /\ x <> y *)
166Theorem REAL_LT_LE = REAL_LT_LE;
167
168(* |- !x y. x < y ==> x <= y *)
169Theorem REAL_LT_IMP_LE = REAL_LT_IMP_LE;
170
171(* |- !x y z. x < y /\ y <= z ==> x < z *)
172Theorem REAL_LTE_TRANS = REAL_LTE_TRANS;
173
174(* |- !x y z. x <= y /\ y < z ==> x < z *)
175Theorem REAL_LET_TRANS = REAL_LET_TRANS;
176
177(* |- !x y z. x <= y /\ y <= z ==> x <= z *)
178Theorem REAL_LE_TRANS = REAL_LE_TRANS;
179
180(* |- !x y. x <= y /\ y <= x <=> (x = y) *)
181Theorem REAL_LE_ANTISYM = REAL_LE_ANTISYM;
182
183Theorem REAL_LET_ANTISYM:
184 !x y. ~(x < y /\ y <= x)
185Proof
186 REAL_ARITH_TAC
187QED
188
189(* |- !x y. ~(x <= y /\ y < x) *)
190Theorem REAL_LTE_ANTISYM = REAL_LTE_ANTISYM;
191
192(* old name with typo *)
193Theorem REAL_LTE_ANTSYM = REAL_LTE_ANTISYM;
194
195(* |- !x. -x < 0 <=> 0 < x *)
196Theorem REAL_NEG_LT0[simp] = REAL_NEG_LT0
197
198Theorem REAL_NEG_GT0[simp]:
199 !x. 0 < ~x <=> x < 0
200Proof
201 REAL_ARITH_TAC
202QED
203
204Theorem REAL_NEG_LE0[simp]:
205 !x. ~x <= 0 <=> 0 <= x
206Proof
207 REAL_ARITH_TAC
208QED
209
210Theorem REAL_NEG_GE0[simp]:
211 !x. 0 <= ~x <=> x <= 0
212Proof
213 REAL_ARITH_TAC
214QED
215
216(* |- !x. (x = 0) \/ 0 < x \/ 0 < -x *)
217Theorem REAL_LT_NEGTOTAL = REAL_LT_NEGTOTAL
218
219(* |- !x. 0 <= x \/ 0 <= -x *)
220Theorem REAL_LE_NEGTOTAL = REAL_LE_NEGTOTAL
221
222(* |- !x y. 0 <= x /\ 0 <= y ==> 0 <= x * y *)
223Theorem REAL_LE_MUL = REAL_LE_MUL;
224
225(* |- !x. 0 <= x * x *)
226Theorem REAL_LE_SQUARE = REAL_LE_SQUARE;
227
228(* |- 0 <= 1 *)
229Theorem REAL_LE_01 = REAL_LE_01;
230
231(* |- 0 < 1 *)
232Theorem REAL_LT_01 = REAL_LT_01;
233
234(* |- !x y z. x + y <= x + z <=> y <= z *)
235Theorem REAL_LE_LADD[simp] = REAL_LE_LADD;
236
237(* |- !x y z. x + z <= y + z <=> x <= y *)
238Theorem REAL_LE_RADD[simp] = REAL_LE_RADD;
239
240Theorem REAL_LT_ADD2:
241 !w x y z. w < x /\ y < z ==> (w + y) < (x + z)
242Proof
243 REAL_ARITH_TAC
244QED
245
246Theorem REAL_LE_ADD2:
247 !w x y z. w <= x /\ y <= z ==> (w + y) <= (x + z)
248Proof
249 REAL_ARITH_TAC
250QED
251
252(* |- !x y. 0 <= x /\ 0 <= y ==> 0 <= x + y *)
253Theorem REAL_LE_ADD = REAL_LE_ADD;
254
255(* |- !x y. 0 < x /\ 0 < y ==> 0 < x + y *)
256Theorem REAL_LT_ADD = REAL_LT_ADD;
257
258Theorem REAL_LT_ADDNEG:
259 !x y z. y < x + ~z <=> y + z < x
260Proof
261 REAL_ARITH_TAC
262QED
263
264Theorem REAL_LT_ADDNEG2:
265 !x y z. (x + ~y) < z <=> x < (z + y)
266Proof
267 REAL_ARITH_TAC
268QED
269
270Theorem REAL_LT_ADD1:
271 !x y. x <= y ==> x < (y + &1)
272Proof
273 REAL_ARITH_TAC
274QED
275
276Theorem REAL_SUB_ADD:
277 !x y. (x - y) + y = x
278Proof
279 REAL_ARITH_TAC
280QED
281
282Theorem REAL_SUB_ADD2:
283 !x y. y + (x - y) = x
284Proof
285 REAL_ARITH_TAC
286QED
287
288Theorem REAL_SUB_REFL[simp]:
289 !x. x - x = 0
290Proof
291 REAL_ARITH_TAC
292QED
293
294(* |- !x y. (x - y = 0) <=> (x = y) *)
295Theorem REAL_SUB_0[simp] = REAL_SUB_0;
296
297Theorem REAL_LE_DOUBLE:
298 !x. 0 <= x + x <=> 0 <= x
299Proof
300 REAL_ARITH_TAC
301QED
302
303Theorem REAL_LE_NEGL:
304 !x. (~x <= x) <=> (0 <= x)
305Proof
306 REAL_ARITH_TAC
307QED
308
309Theorem REAL_LE_NEGR:
310 !x. (x <= ~x) <=> (x <= 0)
311Proof
312 REAL_ARITH_TAC
313QED
314
315Theorem REAL_NEG_EQ0[simp]:
316 !x. (-x = 0) <=> (x = 0)
317Proof
318 REAL_ARITH_TAC
319QED
320
321(* |- -0 = 0 *)
322Theorem REAL_NEG_0[simp] = REAL_NEG_0;
323
324(* |- !x y. -(x - y) = y - x *)
325Theorem REAL_NEG_SUB = REAL_NEG_SUB;
326
327(* |- !x y. 0 < x - y <=> y < x *)
328Theorem REAL_SUB_LT = REAL_SUB_LT;
329
330Theorem REAL_SUB_LT_NEG :
331 !x (y :real). x - y < 0 <=> x < y
332Proof
333 REAL_ARITH_TAC
334QED
335
336(* |- !x y. 0 <= x - y <=> y <= x *)
337Theorem REAL_SUB_LE = REAL_SUB_LE;
338
339Theorem REAL_ADD_SUB:
340 !x y. (x + y) - x = y
341Proof
342 REAL_ARITH_TAC
343QED
344
345Theorem REAL_SUB_LDISTRIB:
346 !x y z. x * (y - z) = (x * y) - (x * z)
347Proof
348 REAL_ARITH_TAC
349QED
350
351Theorem REAL_SUB_RDISTRIB:
352 !x y z. (x - y) * z = (x * z) - (y * z)
353Proof
354 REAL_ARITH_TAC
355QED
356
357Theorem REAL_SUB_LZERO[simp]:
358 !x. 0 - x = ~x
359Proof REAL_ARITH_TAC
360QED
361
362Theorem REAL_SUB_RZERO[simp]:
363 !x. x - 0 = x
364Proof REAL_ARITH_TAC
365QED
366
367(* also known as REAL_EQ_MUL_LCANCEL *)
368Theorem REAL_EQ_LMUL[simp]:
369 !x y z. (x * y = x * z) <=> (x = 0) \/ (y = z)
370Proof
371 REPEAT GEN_TAC THEN
372 ONCE_REWRITE_TAC[REAL_ARITH “(x = y) <=> (x - y = &0)”] THEN
373 REWRITE_TAC[GSYM REAL_SUB_LDISTRIB, REAL_ENTIRE, REAL_SUB_RZERO]
374QED
375
376(* also known as REAL_EQ_MUL_RCANCEL *)
377Theorem REAL_EQ_RMUL[simp]:
378 !x y z. (x * z = y * z) <=> (z = 0) \/ (x = y)
379Proof
380 ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
381 REWRITE_TAC[REAL_EQ_LMUL] THEN
382 MESON_TAC[]
383QED
384
385Theorem REAL_NEG_EQ:
386 !x y:real. (~x = y) <=> (x = ~y)
387Proof
388 REAL_ARITH_TAC
389QED
390
391Theorem REAL_NEG_MINUS1:
392 !x. ~x = ~1 * x
393Proof
394 REAL_ARITH_TAC
395QED
396
397Theorem REAL_INV_NZ:
398 !x. ~(x = 0) ==> ~(inv x = 0)
399Proof
400 GEN_TAC THEN DISCH_TAC THEN
401 DISCH_THEN(MP_TAC o C AP_THM “x:real” o AP_TERM “$*”) THEN
402 FIRST_ASSUM(fn th => REWRITE_TAC[MATCH_MP REAL_MUL_LINV th]) THEN
403 REWRITE_TAC[REAL_MUL_LZERO, REAL_10]
404QED
405
406Theorem REAL_INVINV:
407 !x. ~(x = 0) ==> (inv (inv x) = x)
408Proof
409 GEN_TAC THEN DISCH_TAC THEN
410 FIRST_ASSUM(MP_TAC o MATCH_MP REAL_MUL_RINV) THEN
411 ASM_CASES_TAC “inv x = 0” THEN
412 ASM_REWRITE_TAC[REAL_MUL_RZERO, GSYM REAL_10] THEN
413 MP_TAC(SPECL [“inv(inv x)”, “x:real”, “inv x”] REAL_EQ_RMUL)
414 THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
415 DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC REAL_MUL_LINV THEN
416 FIRST_ASSUM ACCEPT_TAC
417QED
418
419Theorem REAL_LT_IMP_NE:
420 !x y. x < y ==> ~(x = y)
421Proof
422 REAL_ARITH_TAC
423QED
424
425Theorem REAL_INV_POS:
426 !x. 0 < x ==> 0 < inv x
427Proof
428 GEN_TAC THEN DISCH_TAC THEN REPEAT_TCL DISJ_CASES_THEN
429 MP_TAC (SPECL [“inv x”, “0”] REAL_LT_TOTAL) THENL
430 [POP_ASSUM(ASSUME_TAC o MATCH_MP REAL_INV_NZ o
431 GSYM o MATCH_MP REAL_LT_IMP_NE) THEN ASM_REWRITE_TAC[],
432 ONCE_REWRITE_TAC[GSYM REAL_NEG_GT0] THEN
433 DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_MUL o C CONJ (ASSUME “0 < x”)) THEN
434 REWRITE_TAC[GSYM REAL_NEG_LMUL] THEN
435 POP_ASSUM(fn th => REWRITE_TAC
436 [MATCH_MP REAL_MUL_LINV (GSYM (MATCH_MP REAL_LT_IMP_NE th))]) THEN
437 REWRITE_TAC[REAL_NEG_GT0] THEN DISCH_THEN(MP_TAC o CONJ REAL_LT_01) THEN
438 REWRITE_TAC[REAL_LT_ANTISYM],
439 REWRITE_TAC[]]
440QED
441
442Theorem REAL_LT_LMUL_0:
443 !x y. 0 < x ==> (0 < (x * y) <=> 0 < y)
444Proof
445 REPEAT GEN_TAC THEN DISCH_TAC THEN EQ_TAC THENL
446 [FIRST_ASSUM(fn th => DISCH_THEN(MP_TAC o CONJ (MATCH_MP REAL_INV_POS th))) THEN
447 DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_MUL) THEN
448 REWRITE_TAC[REAL_MUL_ASSOC] THEN
449 FIRST_ASSUM(fn th => REWRITE_TAC
450 [MATCH_MP REAL_MUL_LINV (GSYM (MATCH_MP REAL_LT_IMP_NE th))]) THEN
451 REWRITE_TAC[REAL_MUL_LID],
452 DISCH_TAC THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[]]
453QED
454
455Theorem REAL_LT_RMUL_0:
456 !x y. 0 < y ==> (0 < (x * y) <=> 0 < x)
457Proof
458 REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
459 MATCH_ACCEPT_TAC REAL_LT_LMUL_0
460QED
461
462(* also known as REAL_LT_LMUL_EQ *)
463Theorem REAL_LT_LMUL:
464 !x y z. 0 < x ==> ((x * y) < (x * z) <=> y < z)
465Proof
466 REPEAT GEN_TAC THEN DISCH_TAC THEN
467 ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN
468 REWRITE_TAC[GSYM REAL_SUB_LDISTRIB] THEN
469 POP_ASSUM MP_TAC THEN MATCH_ACCEPT_TAC REAL_LT_LMUL_0
470QED
471
472(* also known as REAL_LT_RMUL_EQ *)
473Theorem REAL_LT_RMUL:
474 !x y z. 0 < z ==> ((x * z) < (y * z) <=> x < y)
475Proof
476 REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
477 MATCH_ACCEPT_TAC REAL_LT_LMUL
478QED
479
480Theorem REAL_LT_RMUL_IMP:
481 !x y z. x < y /\ 0 < z ==> (x * z) < (y * z)
482Proof
483 REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
484 POP_ASSUM(fn th => REWRITE_TAC[GEN_ALL(MATCH_MP REAL_LT_RMUL th)])
485QED
486
487Theorem REAL_LT_LMUL_IMP:
488 !x y z. y < z /\ 0 < x ==> (x * y) < (x * z)
489Proof
490 REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
491 POP_ASSUM(fn th => REWRITE_TAC[GEN_ALL(MATCH_MP REAL_LT_LMUL th)])
492QED
493
494(* also known as REAL_LE_LMUL_LOCAL *)
495Theorem REAL_LE_LMUL:
496 !x y z. 0 < x ==> ((x * y) <= (x * z) <=> y <= z)
497Proof
498 REPEAT GEN_TAC THEN DISCH_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_NOT_LT] THEN
499 AP_TERM_TAC THEN MATCH_MP_TAC REAL_LT_LMUL THEN ASM_REWRITE_TAC[]
500QED
501
502(* also known as REAL_LE_RMUL_EQ *)
503Theorem REAL_LE_RMUL:
504 !x y z. 0 < z ==> ((x * z) <= (y * z) <=> x <= y)
505Proof
506 REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
507 MATCH_ACCEPT_TAC REAL_LE_LMUL
508QED
509
510(* recovered from transc.ml *)
511Theorem REAL_LE_LCANCEL_IMP :
512 !x y z. 0 < x /\ x * y <= x * z ==> y <= z
513Proof
514 rpt STRIP_TAC
515 >> drule (GSYM REAL_LE_LMUL)
516 >> DISCH_THEN (fn th => ASM_REWRITE_TAC [th])
517QED
518
519(* dual theorem of the above *)
520Theorem REAL_LE_RCANCEL_IMP :
521 !x y z. 0 < z /\ x * z <= y * z ==> x <= y
522Proof
523 ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REAL_LE_LCANCEL_IMP]
524QED
525
526Theorem REAL_LINV_UNIQ:
527 !x y. (x * y = &1) ==> (x = inv y)
528Proof
529 REPEAT GEN_TAC THEN ASM_CASES_TAC “x = 0” THEN
530 ASM_REWRITE_TAC[REAL_MUL_LZERO, GSYM REAL_10] THEN
531 DISCH_THEN(MP_TAC o AP_TERM “$* (inv x)”) THEN
532 REWRITE_TAC[REAL_MUL_ASSOC] THEN
533 FIRST_ASSUM(fn th => REWRITE_TAC[MATCH_MP REAL_MUL_LINV th]) THEN
534 REWRITE_TAC[REAL_MUL_LID, REAL_MUL_RID] THEN
535 DISCH_THEN SUBST1_TAC THEN CONV_TAC SYM_CONV THEN
536 POP_ASSUM MP_TAC THEN MATCH_ACCEPT_TAC REAL_INVINV
537QED
538
539Theorem REAL_RINV_UNIQ:
540 !x y. (x * y = &1) ==> (y = inv x)
541Proof
542 REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
543 MATCH_ACCEPT_TAC REAL_LINV_UNIQ
544QED
545
546(* cf. REAL_INVINV *)
547Theorem REAL_INV_INV:
548 !x. inv(inv x) = x
549Proof
550 GEN_TAC THEN ASM_CASES_TAC (Term `x = 0`) THEN
551 ASM_REWRITE_TAC[REAL_INV_0] THEN
552 ONCE_REWRITE_TAC [EQ_SYM_EQ] THEN
553 MATCH_MP_TAC REAL_RINV_UNIQ THEN
554 MATCH_MP_TAC REAL_MUL_LINV THEN
555 ASM_REWRITE_TAC[]
556QED
557
558Theorem REAL_INV_EQ_0[simp]:
559 !x. (inv(x) = 0) <=> (x = 0)
560Proof
561 GEN_TAC THEN EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[REAL_INV_0] THEN
562 ONCE_REWRITE_TAC[GSYM REAL_INV_INV] THEN ASM_REWRITE_TAC[REAL_INV_0]
563QED
564
565Theorem REAL_INV_EQ_0'[simp]:
566 !x. (0 = inv x) <=> (x = 0)
567Proof metis_tac[REAL_INV_EQ_0]
568QED
569
570Theorem REAL_NEG_INV:
571 !x. ~(x = 0) ==> (~inv x = inv (~x))
572Proof
573 GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LINV_UNIQ THEN
574 REWRITE_TAC[GSYM REAL_NEG_LMUL, GSYM REAL_NEG_RMUL] THEN
575 POP_ASSUM(fn th => REWRITE_TAC[MATCH_MP REAL_MUL_LINV th]) THEN
576 REWRITE_TAC[REAL_NEGNEG]
577QED
578
579Theorem REAL_NEG_INV':
580 -inv x = inv (-x)
581Proof
582 Cases_on ‘x = 0’ >> simp[REAL_NEG_INV]
583QED
584
585(* |- !x. inv (-x) = -inv x (HOL-Light compatible name and statements) *)
586Theorem REAL_INV_NEG = GEN_ALL (SYM REAL_NEG_INV')
587
588Theorem REAL_INV_1OVER:
589 !x. inv x = &1 / x
590Proof
591 GEN_TAC THEN REWRITE_TAC[real_div, REAL_MUL_LID]
592QED
593
594Theorem REAL_LT_INV_EQ[simp]:
595 !x. 0 < inv x <=> 0 < x
596Proof
597 GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[REAL_INV_POS] THEN
598 GEN_REWRITE_TAC (funpow 2 RAND_CONV) empty_rewrites [GSYM REAL_INV_INV] THEN
599 REWRITE_TAC[REAL_INV_POS]
600QED
601
602Theorem REAL_LE_INV_EQ[simp]:
603 !x. 0 <= inv x <=> 0 <= x
604Proof
605 REWRITE_TAC[REAL_LE_LT, REAL_LT_INV_EQ, REAL_INV_EQ_0] THEN
606 MESON_TAC[REAL_INV_EQ_0]
607QED
608
609Theorem REAL_LE_INV:
610 !x. 0 <= x ==> 0 <= inv(x)
611Proof
612 REWRITE_TAC[REAL_LE_INV_EQ]
613QED
614
615Theorem REAL_LE_ADDR[simp] = REAL_LE_ADDR
616
617Theorem REAL_LE_ADDL[simp]:
618 !x y. y <= x + y <=> 0 <= x
619Proof
620 REAL_ARITH_TAC
621QED
622
623(* |- !x y. x < x + y <=> 0 < y *)
624Theorem REAL_LT_ADDR[simp] = REAL_LT_ADDR
625
626Theorem REAL_LT_ADDL[simp]:
627 !x y. y < x + y <=> 0 < x
628Proof
629 REAL_ARITH_TAC
630QED
631
632(*---------------------------------------------------------------------------*)
633(* Prove homomorphisms for the inclusion map *)
634(*---------------------------------------------------------------------------*)
635
636(* |- !n. &SUC n = &n + 1 *)
637Theorem REAL = REAL;
638
639(* !n. 0 <= &n *)
640Theorem REAL_POS[simp] = REAL_POS;
641
642(* !n. 0 < &SUC n *)
643Theorem REAL_POS_LT = REAL_POS_LT;
644
645(* |- !m n. &m <= &n <=> m <= n *)
646Theorem REAL_LE[simp] = REAL_LE;
647
648Theorem REAL_LT[simp]:
649 !m n. &m < &n <=> m < n
650Proof
651 REPEAT GEN_TAC THEN MATCH_ACCEPT_TAC
652 ((REWRITE_RULE[] o AP_TERM “$~:bool->bool” o
653 REWRITE_RULE[GSYM NOT_LESS, GSYM REAL_NOT_LT]) (SPEC_ALL REAL_LE))
654QED
655
656Theorem REAL_INJ[simp] = REAL_INJ;
657
658(* |- !m n. &m + &n = &(m + n) *)
659Theorem REAL_ADD[simp] = REAL_ADD;
660
661(* |- !m n. &m * &n = &(m * n) *)
662Theorem REAL_MUL[simp] = REAL_MUL;
663
664(*---------------------------------------------------------------------------*)
665(* Now more theorems *)
666(*---------------------------------------------------------------------------*)
667
668Theorem REAL_INV1[simp]:
669 inv(&1) = &1
670Proof
671 CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_LINV_UNIQ THEN
672 REWRITE_TAC[REAL_MUL_LID]
673QED
674
675(* HOL-Light compatible name *)
676Theorem REAL_INV_1 = REAL_INV1
677
678Theorem REAL_OVER1[simp]:
679 !x. x / &1 = x
680Proof
681 GEN_TAC THEN REWRITE_TAC[real_div, REAL_INV1, REAL_MUL_RID]
682QED
683
684Theorem REAL_DIV_REFL:
685 !x. ~(x = 0) ==> (x / x = &1)
686Proof
687 GEN_TAC THEN REWRITE_TAC[real_div, REAL_MUL_RINV]
688QED
689
690Theorem REAL_DIV_LZERO:
691 !x. 0 / x = 0
692Proof
693 REPEAT GEN_TAC THEN REWRITE_TAC[real_div, REAL_MUL_LZERO]
694QED
695
696(* |- !n. &n <> 0 <=> 0 < &n *)
697Theorem REAL_LT_NZ = REAL_LT_NZ;
698
699Theorem REAL_NZ_IMP_LT:
700 !n. ~(n = 0) ==> 0 < &n
701Proof
702 GEN_TAC THEN REWRITE_TAC[GSYM REAL_INJ, REAL_LT_NZ]
703QED
704
705Theorem REAL_LT_RDIV_0:
706 !y z. 0 < z ==> (0 < (y / z) <=> 0 < y)
707Proof
708 REPEAT GEN_TAC THEN DISCH_TAC THEN
709 REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LT_RMUL_0 THEN
710 MATCH_MP_TAC REAL_INV_POS THEN POP_ASSUM ACCEPT_TAC
711QED
712
713Theorem REAL_LT_RDIV:
714 !x y z. 0 < z ==> ((x / z) < (y / z) <=> x < y)
715Proof
716 REPEAT GEN_TAC THEN DISCH_TAC THEN
717 REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LT_RMUL THEN
718 MATCH_MP_TAC REAL_INV_POS THEN POP_ASSUM ACCEPT_TAC
719QED
720
721Theorem REAL_LT_FRACTION_0:
722 !n d. ~(n = 0) ==> (0 < (d / &n) <=> 0 < d)
723Proof
724 REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LT_RDIV_0 THEN
725 ASM_REWRITE_TAC[GSYM REAL_LT_NZ, REAL_INJ]
726QED
727
728Theorem REAL_LT_MULTIPLE:
729 !(n:num) d. 1 < n ==> (d < (&n * d) <=> 0 < d)
730Proof
731 ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN INDUCT_TAC THENL
732 [REWRITE_TAC[num_CONV “1:num”, NOT_LESS_0],
733 POP_ASSUM MP_TAC THEN ASM_CASES_TAC “1 < n:num” THEN
734 ASM_REWRITE_TAC[] THENL
735 [DISCH_TAC THEN GEN_TAC THEN DISCH_THEN(K ALL_TAC) THEN
736 REWRITE_TAC[REAL, REAL_LDISTRIB, REAL_MUL_RID, REAL_LT_ADDL] THEN
737 MATCH_MP_TAC REAL_LT_RMUL_0 THEN REWRITE_TAC[REAL_LT] THEN
738 MATCH_MP_TAC LESS_TRANS THEN EXISTS_TAC “1:num” THEN
739 ASM_REWRITE_TAC[] THEN REWRITE_TAC[num_CONV “1:num”, LESS_0],
740 GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP LESS_LEMMA1) THEN
741 ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
742 REWRITE_TAC[REAL, REAL_LDISTRIB, REAL_MUL_RID] THEN
743 REWRITE_TAC[REAL_LT_ADDL]]]
744QED
745
746Theorem REAL_LT_FRACTION:
747 !(n:num) d. 1 < n ==> ((d / &n) < d <=> 0 < d)
748Proof
749 REPEAT GEN_TAC THEN ASM_CASES_TAC “n = 0:num” THEN
750 ASM_REWRITE_TAC[NOT_LESS_0] THEN DISCH_TAC THEN
751 UNDISCH_TAC “1 < n:num” THEN
752 FIRST_ASSUM(fn th => let val th1 = REWRITE_RULE[GSYM REAL_INJ] th in
753 MAP_EVERY ASSUME_TAC [th1, REWRITE_RULE[REAL_LT_NZ] th1] end) THEN
754 FIRST_ASSUM(fn th => GEN_REWR_TAC (RAND_CONV o LAND_CONV)
755 [GSYM(MATCH_MP REAL_LT_RMUL th)]) THEN
756 REWRITE_TAC[real_div, GSYM REAL_MUL_ASSOC] THEN
757 FIRST_ASSUM(fn th => REWRITE_TAC[MATCH_MP REAL_MUL_LINV th]) THEN
758 REWRITE_TAC[REAL_MUL_RID] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
759 MATCH_ACCEPT_TAC REAL_LT_MULTIPLE
760QED
761
762Theorem REAL_LT_HALF1:
763 !d. 0 < (d / &2) <=> 0 < d
764Proof
765 GEN_TAC THEN MATCH_MP_TAC REAL_LT_FRACTION_0 THEN
766 REWRITE_TAC[num_CONV “2:num”, NOT_SUC]
767QED
768
769Theorem REAL_LT_HALF2:
770 !d. (d / &2) < d <=> 0 < d
771Proof
772 GEN_TAC THEN MATCH_MP_TAC REAL_LT_FRACTION THEN
773 CONV_TAC(RAND_CONV num_CONV) THEN
774 REWRITE_TAC[LESS_SUC_REFL]
775QED
776
777Theorem REAL_DOUBLE:
778 !x. x + x = &2 * x
779Proof
780 REAL_ARITH_TAC
781QED
782
783Theorem REAL_DIV_LMUL:
784 !x y. ~(y = 0) ==> (y * (x / y) = x)
785Proof
786 REPEAT GEN_TAC THEN DISCH_TAC THEN
787 ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
788 REWRITE_TAC[real_div] THEN
789 REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN
790 FIRST_ASSUM(SUBST1_TAC o MATCH_MP REAL_MUL_LINV) THEN
791 REWRITE_TAC[REAL_MUL_RID]
792QED
793
794Theorem REAL_DIV_RMUL:
795 !x y. ~(y = 0) ==> ((x / y) * y = x)
796Proof
797 REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
798 MATCH_ACCEPT_TAC REAL_DIV_LMUL
799QED
800
801Theorem REAL_HALF_DOUBLE:
802 !x. (x / &2) + (x / &2) = x
803Proof
804 GEN_TAC THEN REWRITE_TAC[REAL_DOUBLE] THEN
805 MATCH_MP_TAC REAL_DIV_LMUL THEN REWRITE_TAC[REAL_INJ] THEN
806 CONV_TAC(ONCE_DEPTH_CONV NUM_EQ_CONV) THEN REWRITE_TAC[]
807QED
808
809Theorem REAL_DOWN:
810 !x. 0 < x ==> ?y. 0 < y /\ y < x
811Proof
812 GEN_TAC THEN DISCH_TAC THEN EXISTS_TAC “x / &2” THEN
813 ASM_REWRITE_TAC[REAL_LT_HALF1, REAL_LT_HALF2]
814QED
815
816Theorem REAL_DOWN2:
817 !x y. 0 < x /\ 0 < y ==> ?z. 0 < z /\ z < x /\ z < y
818Proof
819 REPEAT GEN_TAC THEN
820 REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC
821 (SPECL [“x:real”, “y:real”] REAL_LT_TOTAL) THENL
822 [ASM_REWRITE_TAC[REAL_DOWN],
823 DISCH_THEN(X_CHOOSE_TAC “z:real” o MATCH_MP REAL_DOWN o CONJUNCT1),
824 DISCH_THEN(X_CHOOSE_TAC “z:real” o MATCH_MP REAL_DOWN o CONJUNCT2)] THEN
825 EXISTS_TAC “z:real” THEN ASM_REWRITE_TAC[] THEN
826 MATCH_MP_TAC REAL_LT_TRANS THENL
827 [EXISTS_TAC “x:real”, EXISTS_TAC “y:real”] THEN
828 ASM_REWRITE_TAC[]
829QED
830
831Theorem REAL_SUB_SUB:
832 !x y. (x - y) - x = ~y
833Proof
834 REAL_ARITH_TAC
835QED
836
837Theorem REAL_LT_ADD_SUB:
838 !x y z. (x + y) < z <=> x < (z - y)
839Proof
840 REAL_ARITH_TAC
841QED
842
843Theorem REAL_LT_SUB_RADD:
844 !x y z. (x - y) < z <=> x < z + y
845Proof
846 REAL_ARITH_TAC
847QED
848
849Theorem REAL_LT_SUB_LADD:
850 !x y z. x < (y - z) <=> (x + z) < y
851Proof
852 REAL_ARITH_TAC
853QED
854
855Theorem REAL_LE_SUB_LADD:
856 !x y z. x <= (y - z) <=> (x + z) <= y
857Proof
858 REAL_ARITH_TAC
859QED
860
861Theorem REAL_LE_SUB_RADD:
862 !x y z. (x - y) <= z <=> x <= z + y
863Proof
864 REAL_ARITH_TAC
865QED
866
867Theorem REAL_LT_NEG[simp]:
868 !x y. ~x < ~y <=> y < x
869Proof
870 REAL_ARITH_TAC
871QED
872
873(* |- !x y. -x <= -y <=> y <= x *)
874Theorem REAL_LE_NEG[simp] = REAL_LE_NEG2;
875
876Theorem REAL_ADD2_SUB2:
877 !a b c d. (a + b) - (c + d) = (a - c) + (b - d)
878Proof
879 REAL_ARITH_TAC
880QED
881
882Theorem REAL_LET_ADD2:
883 !w x y z. w <= x /\ y < z ==> (w + y) < (x + z)
884Proof
885 REAL_ARITH_TAC
886QED
887
888Theorem REAL_LTE_ADD2:
889 !w x y z. w < x /\ y <= z ==> (w + y) < (x + z)
890Proof
891 REAL_ARITH_TAC
892QED
893
894(* |- !x y. 0 <= x /\ 0 < y ==> 0 < x + y *)
895Theorem REAL_LET_ADD = REAL_LET_ADD;
896
897(* |- !x y. 0 < x /\ 0 <= y ==> 0 < x + y *)
898Theorem REAL_LTE_ADD = REAL_LTE_ADD;
899
900(* also known as REAL_LT_MUL2_ALT *)
901Theorem REAL_LT_MUL2:
902 !x1 x2 y1 y2. 0 <= x1 /\ 0 <= y1 /\ x1 < x2 /\ y1 < y2 ==>
903 (x1 * y1) < (x2 * y2)
904Proof
905 REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN
906 REWRITE_TAC[REAL_SUB_RZERO] THEN
907 SUBGOAL_THEN “!a b c d.
908 (a * b) - (c * d) = ((a * b) - (a * d)) + ((a * d) - (c * d))”
909 MP_TAC THENL
910 [REPEAT GEN_TAC THEN REWRITE_TAC[real_sub] THEN
911 ONCE_REWRITE_TAC[AC(REAL_ADD_ASSOC,REAL_ADD_SYM)
912 “(a + b) + (c + d) = (b + c) + (a + d)”] THEN
913 REWRITE_TAC[REAL_ADD_LINV, REAL_ADD_LID],
914 DISCH_THEN(fn th => ONCE_REWRITE_TAC[th]) THEN
915 REWRITE_TAC[GSYM REAL_SUB_LDISTRIB, GSYM REAL_SUB_RDISTRIB] THEN
916 DISCH_THEN STRIP_ASSUME_TAC THEN
917 MATCH_MP_TAC REAL_LTE_ADD THEN CONJ_TAC THENL
918 [MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[] THEN
919 MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC “x1:real” THEN
920 ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN
921 ASM_REWRITE_TAC[],
922 MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN
923 MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]]]
924QED
925
926Theorem REAL_LT_INV:
927 !x y. 0 < x /\ x < y ==> inv y < inv x
928Proof
929 REPEAT GEN_TAC THEN
930 DISCH_THEN STRIP_ASSUME_TAC THEN
931 SUBGOAL_THEN “0 < y” ASSUME_TAC THENL
932 [MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC “x:real” THEN
933 ASM_REWRITE_TAC[], ALL_TAC] THEN
934 SUBGOAL_THEN “0 < (x * y)” ASSUME_TAC THENL
935 [MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[], ALL_TAC] THEN
936 SUBGOAL_THEN “(inv y) < (inv x) <=>
937 ((x * y) * (inv y)) < ((x * y) * (inv x))” SUBST1_TAC
938 THENL
939 [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_LT_LMUL THEN
940 ASM_REWRITE_TAC[], ALL_TAC] THEN
941 REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN
942 SUBGOAL_THEN “(x * (inv x) = &1) /\ (y * (inv y) = &1)”
943 STRIP_ASSUME_TAC THENL
944 [CONJ_TAC THEN MATCH_MP_TAC REAL_MUL_RINV THEN
945 CONV_TAC(RAND_CONV SYM_CONV) THEN MATCH_MP_TAC REAL_LT_IMP_NE THEN
946 ASM_REWRITE_TAC[], ALL_TAC] THEN
947 ASM_REWRITE_TAC[REAL_MUL_RID] THEN
948 ONCE_REWRITE_TAC[AC(REAL_MUL_ASSOC,REAL_MUL_SYM)
949 “x * (y * z) = (x * z) * y”] THEN
950 ASM_REWRITE_TAC[REAL_MUL_LID]
951QED
952
953Theorem REAL_LE_INV2 :
954 !x y. 0 < x /\ x <= y ==> inv y <= inv x
955Proof
956 metis_tac [REAL_LE_LT, REAL_LT_INV]
957QED
958
959Theorem REAL_SUB_LNEG:
960 !x y. ~x - y = ~(x + y)
961Proof
962 REAL_ARITH_TAC
963QED
964
965Theorem REAL_SUB_RNEG:
966 !x y. x - ~y = x + y
967Proof
968 REAL_ARITH_TAC
969QED
970
971Theorem REAL_SUB_NEG2:
972 !x y. ~x - ~y = y - x
973Proof
974 REAL_ARITH_TAC
975QED
976
977Theorem REAL_SUB_TRIANGLE:
978 !a b c. (a - b) + (b - c) = a - c
979Proof
980 REAL_ARITH_TAC
981QED
982
983Theorem REAL_EQ_SUB_LADD:
984 !x y z. (x = y - z) = (x + z = y)
985Proof
986 REAL_ARITH_TAC
987QED
988
989Theorem REAL_EQ_SUB_RADD:
990 !x y z. (x - y = z) = (x = z + y)
991Proof
992 REAL_ARITH_TAC
993QED
994
995(* also known as REAL_INV_MUL_WEAK *)
996Theorem REAL_INV_MUL:
997 !x y. ~(x = 0) /\ ~(y = 0) ==>
998 (inv(x * y) = inv(x) * inv(y))
999Proof
1000 REPEAT GEN_TAC THEN DISCH_THEN STRIP_ASSUME_TAC THEN
1001 CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_RINV_UNIQ THEN
1002 ONCE_REWRITE_TAC[AC(REAL_MUL_ASSOC,REAL_MUL_SYM)
1003 “(a * b) * (c * d) = (c * a) * (d * b)”] THEN
1004 GEN_REWR_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN
1005 BINOP_TAC THEN MATCH_MP_TAC REAL_MUL_LINV THEN ASM_REWRITE_TAC[]
1006QED
1007
1008(* Stronger version *)
1009Theorem REAL_INV_MUL':
1010 !x y. inv(x * y) = inv(x) * inv(y)
1011Proof
1012 REPEAT GEN_TAC THEN
1013 MAP_EVERY Cases_on [‘x = 0’, ‘y = 0’] THEN
1014 ASM_REWRITE_TAC[REAL_INV_0, REAL_MUL_LZERO, REAL_MUL_RZERO] THEN
1015 MATCH_MP_TAC REAL_INV_MUL THEN ASM_REWRITE_TAC []
1016QED
1017
1018Theorem REAL_INV_DIV :
1019 !x y. x <> 0 /\ y <> 0 ==> (inv (x / y) = y * inv x)
1020Proof
1021 rpt STRIP_TAC
1022 >> ‘inv y <> 0’ by PROVE_TAC [REAL_INV_NZ]
1023 >> ASM_SIMP_TAC std_ss [real_div, REAL_INV_MUL, REAL_INVINV]
1024 >> PROVE_TAC [REAL_MUL_COMM]
1025QED
1026
1027(* HOL-Light compatible *)
1028Theorem REAL_INV_DIV' :
1029 !x y. inv (x / y) = y * inv x
1030Proof
1031 REWRITE_TAC [real_div, REAL_INV_MUL', REAL_INV_INV, Once REAL_MUL_COMM]
1032QED
1033
1034Theorem REAL_SUB_INV2:
1035 !x y. ~(x = 0) /\ ~(y = 0) ==>
1036 (inv(x) - inv(y) = (y - x) / (x * y))
1037Proof
1038 REPEAT GEN_TAC THEN DISCH_THEN STRIP_ASSUME_TAC THEN
1039 REWRITE_TAC[real_div, REAL_SUB_RDISTRIB] THEN
1040 SUBGOAL_THEN “inv(x * y) = inv(x) * inv(y)” SUBST1_TAC THENL
1041 [MATCH_MP_TAC REAL_INV_MUL THEN ASM_REWRITE_TAC[], ALL_TAC] THEN
1042 REWRITE_TAC[REAL_MUL_ASSOC] THEN
1043 EVERY_ASSUM(fn th => REWRITE_TAC[MATCH_MP REAL_MUL_RINV th]) THEN
1044 REWRITE_TAC[REAL_MUL_LID] THEN AP_THM_TAC THEN AP_TERM_TAC THEN
1045 ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN
1046 EVERY_ASSUM(fn th => REWRITE_TAC[MATCH_MP REAL_MUL_LINV th]) THEN
1047 REWRITE_TAC[REAL_MUL_LID]
1048QED
1049
1050Theorem REAL_SUB_SUB2:
1051 !x y. x - (x - y) = y
1052Proof
1053 REAL_ARITH_TAC
1054QED
1055
1056Theorem REAL_ADD_SUB2:
1057 !x y. x - (x + y) = ~y
1058Proof
1059 REAL_ARITH_TAC
1060QED
1061
1062Theorem REAL_ADDL_LE[simp]:
1063 !x y. (x :real) + y <= y <=> x <= 0
1064Proof
1065 REAL_ARITH_TAC
1066QED
1067
1068Theorem REAL_MEAN:
1069 !x y. x < y ==> ?z. x < z /\ z < y
1070Proof
1071 REPEAT GEN_TAC THEN
1072 DISCH_THEN(MP_TAC o MATCH_MP REAL_DOWN o ONCE_REWRITE_RULE[GSYM REAL_SUB_LT])
1073 THEN DISCH_THEN(X_CHOOSE_THEN “d:real” STRIP_ASSUME_TAC) THEN
1074 EXISTS_TAC “x + d” THEN ASM_REWRITE_TAC[REAL_LT_ADDR] THEN
1075 ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
1076 ASM_REWRITE_TAC[GSYM REAL_LT_SUB_LADD]
1077QED
1078
1079Theorem REAL_EQ_LMUL2:
1080 !x y z. ~(x = 0) ==> ((y = z) <=> (x * y = x * z))
1081Proof
1082 REPEAT GEN_TAC THEN DISCH_TAC THEN
1083 MP_TAC(SPECL [“x:real”, “y:real”, “z:real”] REAL_EQ_LMUL) THEN
1084 ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST_ALL_TAC THEN REFL_TAC
1085QED
1086
1087(* also known as REAL_LE_MUL2V *)
1088Theorem REAL_LE_MUL2:
1089 !x1 x2 y1 y2.
1090 (& 0) <= x1 /\ (& 0) <= y1 /\ x1 <= x2 /\ y1 <= y2 ==>
1091 (x1 * y1) <= (x2 * y2)
1092Proof
1093 REPEAT GEN_TAC THEN
1094 SUBST1_TAC(SPECL [“x1:real”, “x2:real”] REAL_LE_LT) THEN
1095 ASM_CASES_TAC “x1:real = x2” THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THENL
1096 [UNDISCH_TAC “0 <= x2” THEN
1097 DISCH_THEN(DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT]) THENL
1098 [FIRST_ASSUM(fn th => ASM_REWRITE_TAC[MATCH_MP REAL_LE_LMUL th]),
1099 SUBST1_TAC(SYM(ASSUME “0 = x2”)) THEN
1100 REWRITE_TAC[REAL_MUL_LZERO, REAL_LE_REFL]], ALL_TAC] THEN
1101 UNDISCH_TAC “y1 <= y2” THEN
1102 DISCH_THEN(DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT]) THENL
1103 [MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC REAL_LT_MUL2 THEN
1104 ASM_REWRITE_TAC[],
1105 ASM_REWRITE_TAC[]] THEN
1106 UNDISCH_TAC “0 <= y1” THEN ASM_REWRITE_TAC[] THEN
1107 DISCH_THEN(DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT]) THENL
1108 [FIRST_ASSUM(fn th => ASM_REWRITE_TAC[MATCH_MP REAL_LE_RMUL th]) THEN
1109 MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[],
1110 SUBST1_TAC(SYM(ASSUME “0 = y2”)) THEN
1111 REWRITE_TAC[REAL_MUL_RZERO, REAL_LE_REFL]]
1112QED
1113
1114Theorem REAL_LE_LDIV:
1115 !x y z. 0 < x /\ y <= (z * x) ==> (y / x) <= z
1116Proof
1117 REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
1118 MATCH_MP_TAC(TAUT_CONV “(a = b) ==> a ==> b”) THEN
1119 SUBGOAL_THEN “y = (y / x) * x” MP_TAC THENL
1120 [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_DIV_RMUL THEN
1121 CONV_TAC(RAND_CONV SYM_CONV) THEN
1122 MATCH_MP_TAC REAL_LT_IMP_NE THEN POP_ASSUM ACCEPT_TAC,
1123 DISCH_THEN(fn t => GEN_REWR_TAC (funpow 2 LAND_CONV) [t])
1124 THEN MATCH_MP_TAC REAL_LE_RMUL THEN POP_ASSUM ACCEPT_TAC]
1125QED
1126
1127Theorem REAL_LE_RDIV:
1128 !x y z. 0 < x /\ (y * x) <= z ==> y <= (z / x)
1129Proof
1130 REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
1131 MATCH_MP_TAC(TAUT_CONV “(a = b) ==> a ==> b”) THEN
1132 SUBGOAL_THEN “z = (z / x) * x” MP_TAC THENL
1133 [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_DIV_RMUL THEN
1134 CONV_TAC(RAND_CONV SYM_CONV) THEN
1135 MATCH_MP_TAC REAL_LT_IMP_NE THEN POP_ASSUM ACCEPT_TAC,
1136 DISCH_THEN(fn t => GEN_REWR_TAC (LAND_CONV o RAND_CONV) [t])
1137 THEN MATCH_MP_TAC REAL_LE_RMUL THEN POP_ASSUM ACCEPT_TAC]
1138QED
1139
1140Theorem REAL_LT_DIV:
1141 !x y. 0 < x /\ 0 < y ==> 0 < x / y
1142Proof
1143 REWRITE_TAC [real_div] THEN REPEAT STRIP_TAC
1144 THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC [REAL_LT_INV_EQ]
1145QED
1146
1147Theorem REAL_LE_DIV:
1148 !x y. 0 <= x /\ 0 <= y ==> 0 <= x / y
1149Proof
1150 REWRITE_TAC [real_div] THEN REPEAT STRIP_TAC
1151 THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC [REAL_LE_INV_EQ]
1152QED
1153
1154Theorem REAL_LT_1:
1155 !x y. 0 <= x /\ x < y ==> (x / y) < &1
1156Proof
1157 REPEAT GEN_TAC THEN DISCH_TAC THEN
1158 SUBGOAL_THEN “(x / y) < &1 <=> ((x / y) * y) < (&1 * y)” SUBST1_TAC THENL
1159 [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_LT_RMUL THEN
1160 MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC “x:real” THEN
1161 ASM_REWRITE_TAC[],
1162 SUBGOAL_THEN “(x / y) * y = x” SUBST1_TAC THENL
1163 [MATCH_MP_TAC REAL_DIV_RMUL THEN CONV_TAC(RAND_CONV SYM_CONV) THEN
1164 MATCH_MP_TAC REAL_LT_IMP_NE THEN MATCH_MP_TAC REAL_LET_TRANS THEN
1165 EXISTS_TAC “x:real” THEN ASM_REWRITE_TAC[],
1166 ASM_REWRITE_TAC[REAL_MUL_LID]]]
1167QED
1168
1169Theorem REAL_LE_LMUL_IMP :
1170 !x y z. 0 <= x /\ y <= z ==> x * y <= x * z
1171Proof
1172 REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN
1173 REWRITE_TAC[GSYM REAL_SUB_LDISTRIB, REAL_SUB_RZERO, REAL_LE_MUL]
1174QED
1175
1176(* HOL-light compatibility, moved from iterateTheory *)
1177Theorem REAL_LE_LMUL1 = REAL_LE_LMUL_IMP
1178
1179Theorem REAL_LE_RMUL_IMP :
1180 !x y z. 0 <= x /\ y <= z ==> y * x <= z * x
1181Proof
1182 ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_ACCEPT_TAC REAL_LE_LMUL_IMP
1183QED
1184
1185(* HOL-light compatibility, moved from iterateTheory *)
1186Theorem REAL_LE_RMUL1 = REAL_LE_RMUL_IMP
1187
1188Theorem REAL_EQ_IMP_LE:
1189 !x y. (x = y) ==> x <= y
1190Proof
1191 REAL_ARITH_TAC
1192QED
1193
1194Theorem REAL_INV_LT1:
1195 !x. 0 < x /\ x < &1 ==> &1 < inv(x)
1196Proof
1197 GEN_TAC THEN STRIP_TAC THEN
1198 FIRST_ASSUM(ASSUME_TAC o MATCH_MP REAL_INV_POS) THEN
1199 GEN_REWR_TAC I [TAUT_CONV “a = ~~a:bool”] THEN
1200 PURE_REWRITE_TAC[REAL_NOT_LT] THEN REWRITE_TAC[REAL_LE_LT] THEN
1201 DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL
1202 [DISCH_TAC THEN
1203 MP_TAC(SPECL [“inv(x)”, “&1”, “x:real”, “&1”] REAL_LT_MUL2) THEN
1204 ASM_REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL
1205 [MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[],
1206 MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[],
1207 DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_IMP_NE) THEN
1208 REWRITE_TAC[REAL_MUL_LID] THEN MATCH_MP_TAC REAL_MUL_LINV THEN
1209 DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC “0 < 0” THEN
1210 REWRITE_TAC[REAL_LT_REFL]],
1211 DISCH_THEN(MP_TAC o AP_TERM “inv”) THEN REWRITE_TAC[REAL_INV1] THEN
1212 SUBGOAL_THEN “inv(inv x) = x” SUBST1_TAC THENL
1213 [MATCH_MP_TAC REAL_INVINV THEN CONV_TAC(RAND_CONV SYM_CONV) THEN
1214 MATCH_MP_TAC REAL_LT_IMP_NE THEN FIRST_ASSUM ACCEPT_TAC,
1215 DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC “&1 < &1” THEN
1216 REWRITE_TAC[REAL_LT_REFL]]]
1217QED
1218
1219Theorem REAL_POS_NZ:
1220 !x. 0 < x ==> ~(x = 0)
1221Proof
1222 REAL_ARITH_TAC
1223QED
1224
1225Theorem REAL_EQ_RMUL_IMP:
1226 !x y z. ~(z = 0) /\ (x * z = y * z) ==> (x = y)
1227Proof
1228 REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
1229 ASM_REWRITE_TAC[REAL_EQ_RMUL]
1230QED
1231
1232Theorem REAL_EQ_LMUL_IMP:
1233 !x y z. ~(x = 0) /\ (x * y = x * z) ==> (y = z)
1234Proof
1235 ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_ACCEPT_TAC REAL_EQ_RMUL_IMP
1236QED
1237
1238Theorem REAL_FACT_NZ:
1239 !n. ~(&(FACT n) = 0)
1240Proof
1241 GEN_TAC THEN MATCH_MP_TAC REAL_POS_NZ THEN
1242 REWRITE_TAC[REAL_LT, FACT_LESS]
1243QED
1244
1245Theorem REAL_DIFFSQ:
1246 !x y. (x + y) * (x - y) = (x * x) - (y * y)
1247Proof
1248 REAL_ARITH_TAC
1249QED
1250
1251Theorem REAL_POSSQ[simp]:
1252 !x. 0 < (x * x) <=> ~(x = 0)
1253Proof
1254 GEN_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LE] THEN AP_TERM_TAC THEN EQ_TAC THENL
1255 [DISCH_THEN(MP_TAC o C CONJ (SPEC “x:real” REAL_LE_SQUARE)) THEN
1256 REWRITE_TAC[REAL_LE_ANTISYM, REAL_ENTIRE],
1257 DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_MUL_LZERO, REAL_LE_REFL]]
1258QED
1259
1260Theorem REAL_SUMSQ:
1261 !x y. ((x * x) + (y * y) = 0) <=> (x = 0) /\ (y = 0)
1262Proof
1263 REPEAT GEN_TAC THEN EQ_TAC THENL
1264 [CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[DE_MORGAN_THM] THEN
1265 DISCH_THEN DISJ_CASES_TAC THEN MATCH_MP_TAC REAL_POS_NZ THENL
1266 [MATCH_MP_TAC REAL_LTE_ADD, MATCH_MP_TAC REAL_LET_ADD] THEN
1267 ASM_REWRITE_TAC[REAL_POSSQ, REAL_LE_SQUARE],
1268 DISCH_TAC THEN ASM_REWRITE_TAC[REAL_MUL_LZERO, REAL_ADD_LID]]
1269QED
1270
1271Theorem REAL_EQ_NEG[simp]:
1272 !x y. (-x = -y) <=> (x = y)
1273Proof
1274 REAL_ARITH_TAC
1275QED
1276
1277Theorem REAL_DIV_MUL2:
1278 !x z. ~(x = 0) /\ ~(z = 0) ==> !y. y / z = (x * y) / (x * z)
1279Proof
1280 REPEAT GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN
1281 REWRITE_TAC[real_div] THEN IMP_SUBST_TAC REAL_INV_MUL THEN
1282 ASM_REWRITE_TAC[] THEN
1283 ONCE_REWRITE_TAC[AC(REAL_MUL_ASSOC,REAL_MUL_SYM)
1284 “(a * b) * (c * d) = (c * a) * (b * d)”] THEN
1285 IMP_SUBST_TAC REAL_MUL_LINV THEN ASM_REWRITE_TAC[] THEN
1286 REWRITE_TAC[REAL_MUL_LID]
1287QED
1288
1289Theorem REAL_DIV_PROD:
1290 !a b c (d :real). a / b * (c / d) = (a * c) / (b * d)
1291Proof
1292 rpt STRIP_TAC
1293 >> simp[real_div,REAL_INV_MUL'] >> metis_tac[REAL_MUL_ASSOC,REAL_MUL_SYM]
1294QED
1295
1296Theorem REAL_DIV_LT:
1297 !a b c (d :real). 0 < b * d ==> (a / b < c / d <=> a * d < c * b)
1298Proof
1299 rw[real_div]
1300 >> ‘b<>0 /\ d<>0’ by (CCONTR_TAC >> gs[])
1301 >> ‘a * inv b <c * inv d <=> a * inv b * (b*d) < c * inv d * (b*d)’ by simp[REAL_LT_RMUL]
1302 >> ‘a * inv b * (b*d) = a*d * (inv b * b)’ by metis_tac[REAL_MUL_ASSOC,REAL_MUL_SYM]
1303 >> ‘_ = a*d’ by simp[REAL_MUL_RID,REAL_MUL_LINV]
1304 >> ‘c * inv d * (b*d) = c*b * (inv d * d)’ by metis_tac[REAL_MUL_ASSOC,REAL_MUL_SYM]
1305 >> ‘_ = c*b’ by simp[REAL_MUL_RID,REAL_MUL_LINV]
1306 >> simp[]
1307QED
1308
1309Theorem REAL_MIDDLE1:
1310 !a b. a <= b ==> a <= (a + b) / &2
1311Proof
1312 REPEAT GEN_TAC THEN DISCH_TAC THEN
1313 MATCH_MP_TAC REAL_LE_RDIV THEN
1314 ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
1315 REWRITE_TAC[GSYM REAL_DOUBLE] THEN
1316 ASM_REWRITE_TAC[GSYM REAL_DOUBLE, REAL_LE_LADD] THEN
1317 REWRITE_TAC[num_CONV “2:num”, REAL_LT, LESS_0]
1318QED
1319
1320Theorem REAL_MIDDLE2:
1321 !a b. a <= b ==> ((a + b) / &2) <= b
1322Proof
1323 REPEAT GEN_TAC THEN DISCH_TAC THEN
1324 MATCH_MP_TAC REAL_LE_LDIV THEN
1325 ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
1326 REWRITE_TAC[GSYM REAL_DOUBLE] THEN
1327 ASM_REWRITE_TAC[GSYM REAL_DOUBLE, REAL_LE_RADD] THEN
1328 REWRITE_TAC[num_CONV “2:num”, REAL_LT, LESS_0]
1329QED
1330
1331(*---------------------------------------------------------------------------*)
1332(* Define usual norm (absolute distance) on the real line *)
1333(*---------------------------------------------------------------------------*)
1334
1335Theorem abs = real_abs; (* moved to realaxTheory *)
1336
1337Theorem ABS_ZERO[simp]:
1338 !x. (abs(x) = 0) <=> (x = 0)
1339Proof
1340 GEN_TAC THEN REWRITE_TAC[abs] THEN
1341 COND_CASES_TAC THEN REWRITE_TAC[REAL_NEG_EQ0]
1342QED
1343
1344(* HOL-Light compatible name *)
1345val REAL_ABS_ZERO = ABS_ZERO;
1346
1347Theorem ABS_0[simp]: abs(0) = 0
1348Proof REWRITE_TAC[ABS_ZERO]
1349QED
1350
1351Theorem ABS_1[simp]: abs(&1) = &1
1352Proof REWRITE_TAC[abs, REAL_LE, ZERO_LESS_EQ]
1353QED
1354
1355Theorem ABS_NEG[simp] = REAL_ABS_NEG
1356
1357Theorem ABS_TRIANGLE:
1358 !x y. abs(x + y) <= abs(x) + abs(y)
1359Proof
1360 REPEAT GEN_TAC THEN REWRITE_TAC[abs] THEN
1361 REPEAT COND_CASES_TAC THEN
1362 REWRITE_TAC[REAL_NEG_ADD, REAL_LE_REFL, REAL_LE_LADD, REAL_LE_RADD] THEN
1363 ASM_REWRITE_TAC[GSYM REAL_NEG_ADD, REAL_LE_NEGL, REAL_LE_NEGR] THEN
1364 RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN
1365 TRY(MATCH_MP_TAC REAL_LT_IMP_LE) THEN TRY(FIRST_ASSUM ACCEPT_TAC) THEN
1366 TRY(UNDISCH_TAC “(x + y) < 0”) THEN SUBST1_TAC(SYM(SPEC “0” REAL_ADD_LID))
1367 THEN REWRITE_TAC[REAL_NOT_LT] THEN
1368 MAP_FIRST MATCH_MP_TAC [REAL_LT_ADD2, REAL_LE_ADD2] THEN
1369 ASM_REWRITE_TAC[]
1370QED
1371
1372(* |- !x y. abs(x - y) <= abs(x) + abs(y) *)
1373Theorem ABS_TRIANGLE_NEG =
1374 ((Q.GENL [`x`, `y`]) o (REWRITE_RULE [ABS_NEG, GSYM real_sub]) o
1375 (Q.SPECL [`x`, `-y`])) ABS_TRIANGLE;
1376
1377Theorem ABS_TRIANGLE_SUB:
1378 !x y:real. abs(x) <= abs(y) + abs(x - y)
1379Proof
1380 MESON_TAC[ABS_TRIANGLE, REAL_SUB_ADD2]
1381QED
1382
1383Theorem ABS_TRIANGLE_LT:
1384 !x y. abs(x) + abs(y) < e ==> abs(x + y) < e:real
1385Proof
1386 MESON_TAC[REAL_LET_TRANS, ABS_TRIANGLE]
1387QED
1388
1389Theorem ABS_POS[simp]: !x. 0 <= abs(x)
1390Proof
1391 GEN_TAC THEN ASM_CASES_TAC “0 <= x” THENL
1392 [ALL_TAC,
1393 MP_TAC(SPEC “x:real” REAL_LE_NEGTOTAL) THEN ASM_REWRITE_TAC[] THEN
1394 DISCH_TAC] THEN
1395 ASM_REWRITE_TAC[abs]
1396QED
1397
1398Theorem ABS_MUL:
1399 !x y. abs(x * y) = abs(x) * abs(y)
1400Proof
1401 REPEAT GEN_TAC THEN ASM_CASES_TAC “0 <= x” THENL
1402 [ALL_TAC,
1403 MP_TAC(SPEC “x:real” REAL_LE_NEGTOTAL) THEN ASM_REWRITE_TAC[] THEN
1404 POP_ASSUM(K ALL_TAC) THEN DISCH_TAC THEN
1405 GEN_REWR_TAC LAND_CONV [GSYM ABS_NEG] THEN
1406 GEN_REWR_TAC (RAND_CONV o LAND_CONV) [GSYM ABS_NEG]
1407 THEN REWRITE_TAC[REAL_NEG_LMUL]] THEN
1408 (ASM_CASES_TAC “0 <= y” THENL
1409 [ALL_TAC,
1410 MP_TAC(SPEC “y:real” REAL_LE_NEGTOTAL) THEN ASM_REWRITE_TAC[] THEN
1411 POP_ASSUM(K ALL_TAC) THEN DISCH_TAC THEN
1412 GEN_REWR_TAC LAND_CONV [GSYM ABS_NEG] THEN
1413 GEN_REWR_TAC (RAND_CONV o RAND_CONV)
1414 [GSYM ABS_NEG] THEN
1415 REWRITE_TAC[REAL_NEG_RMUL]]) THEN
1416 ASSUM_LIST(ASSUME_TAC o MATCH_MP REAL_LE_MUL o LIST_CONJ o rev) THEN
1417 ASM_REWRITE_TAC[abs]
1418QED
1419
1420Theorem ABS_LT_MUL2:
1421 !w x y z. abs(w) < y /\ abs(x) < z ==> abs(w * x) < (y * z)
1422Proof
1423 REPEAT GEN_TAC THEN DISCH_TAC THEN
1424 REWRITE_TAC[ABS_MUL] THEN MATCH_MP_TAC REAL_LT_MUL2 THEN
1425 ASM_REWRITE_TAC[ABS_POS]
1426QED
1427
1428Theorem ABS_SUB:
1429 !x y. abs(x - y) = abs(y - x)
1430Proof
1431 REPEAT GEN_TAC THEN
1432 GEN_REWR_TAC (RAND_CONV o RAND_CONV) [GSYM REAL_NEG_SUB] THEN
1433 REWRITE_TAC[ABS_NEG]
1434QED
1435
1436Theorem ABS_NZ:
1437 !x. ~(x = 0) <=> 0 < abs(x)
1438Proof
1439 GEN_TAC THEN EQ_TAC THENL
1440 [ONCE_REWRITE_TAC[GSYM ABS_ZERO] THEN
1441 REWRITE_TAC[TAUT_CONV “~a ==> b <=> b \/ a”] THEN
1442 CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN
1443 REWRITE_TAC[GSYM REAL_LE_LT, ABS_POS],
1444 CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[] THEN
1445 DISCH_THEN SUBST1_TAC THEN
1446 REWRITE_TAC[abs, REAL_LT_REFL, REAL_LE_REFL]]
1447QED
1448
1449(* |- !x. 0 < abs x <=> x <> 0 *)
1450Theorem ABS_NZ'[simp] = GSYM ABS_NZ
1451
1452Theorem ABS_NOT_ZERO :
1453 !(x :real). abs x <> 0 <=> x <> 0
1454Proof
1455 PROVE_TAC [ABS_ZERO]
1456QED
1457
1458Theorem ABS_INV:
1459 !x. ~(x = 0) ==> (abs(inv x) = inv(abs(x)))
1460Proof
1461 GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LINV_UNIQ THEN
1462 REWRITE_TAC[GSYM ABS_MUL] THEN
1463 FIRST_ASSUM(fn th => REWRITE_TAC[MATCH_MP REAL_MUL_LINV th]) THEN
1464 REWRITE_TAC[abs, REAL_LE] THEN
1465 REWRITE_TAC[num_CONV “1:num”, GSYM NOT_LESS, NOT_LESS_0]
1466QED
1467
1468Theorem ABS_ABS[simp]:
1469 !x. abs(abs(x)) = abs(x)
1470Proof
1471 GEN_TAC THEN
1472 GEN_REWR_TAC LAND_CONV [abs] THEN
1473 REWRITE_TAC[ABS_POS]
1474QED
1475
1476Theorem ABS_LE:
1477 !x. x <= abs(x)
1478Proof
1479 GEN_TAC THEN REWRITE_TAC[abs] THEN
1480 COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN
1481 REWRITE_TAC[REAL_LE_NEGR] THEN
1482 MATCH_MP_TAC REAL_LT_IMP_LE THEN
1483 POP_ASSUM MP_TAC THEN REWRITE_TAC[REAL_NOT_LE]
1484QED
1485
1486Theorem ABS_REFL[simp]:
1487 !x. (abs(x) = x) <=> 0 <= x
1488Proof
1489 GEN_TAC THEN REWRITE_TAC[abs] THEN
1490 ASM_CASES_TAC “0 <= x” THEN ASM_REWRITE_TAC[] THEN
1491 CONV_TAC(RAND_CONV SYM_CONV) THEN
1492 ONCE_REWRITE_TAC[GSYM REAL_RNEG_UNIQ] THEN
1493 REWRITE_TAC[REAL_DOUBLE, REAL_ENTIRE, REAL_INJ] THEN
1494 CONV_TAC(ONCE_DEPTH_CONV NUM_EQ_CONV) THEN REWRITE_TAC[] THEN
1495 DISCH_THEN SUBST_ALL_TAC THEN POP_ASSUM MP_TAC THEN
1496 REWRITE_TAC[REAL_LE_REFL]
1497QED
1498
1499Theorem ABS_REDUCE :
1500 !(x :real). 0 <= x ==> abs x = x
1501Proof
1502 RW_TAC std_ss [ABS_REFL]
1503QED
1504
1505Theorem ABS_EQ_NEG :
1506 !(x :real). x < 0 ==> abs x = -x
1507Proof
1508 RW_TAC std_ss [real_lt, real_abs]
1509QED
1510
1511Theorem ABS_EQ_NEG' :
1512 !(x :real). x <= 0 ==> abs x = -x
1513Proof
1514 RW_TAC std_ss [REAL_LE_LT]
1515 >- (MATCH_MP_TAC ABS_EQ_NEG >> art [])
1516 >> REWRITE_TAC [ABS_0, REAL_NEG_0]
1517QED
1518
1519(* |- !n. abs (&n) = &n *)
1520Theorem ABS_N[simp] = REAL_ABS_NUM
1521
1522Theorem ABS_BETWEEN:
1523 !x y d. 0 < d /\ ((x - d) < y) /\ (y < (x + d)) <=> abs(y - x) < d
1524Proof
1525 REPEAT GEN_TAC THEN REWRITE_TAC[abs] THEN
1526 REWRITE_TAC[REAL_SUB_LE] THEN REWRITE_TAC[REAL_NEG_SUB] THEN
1527 COND_CASES_TAC THEN REWRITE_TAC[REAL_LT_SUB_RADD] THEN
1528 GEN_REWR_TAC (funpow 2 RAND_CONV) [REAL_ADD_SYM] THEN
1529 EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THENL
1530 [SUBGOAL_THEN “x < (x + d)” MP_TAC THENL
1531 [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC “y:real” THEN
1532 ASM_REWRITE_TAC[], ALL_TAC] THEN
1533 REWRITE_TAC[REAL_LT_ADDR] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
1534 MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC “y:real” THEN
1535 ASM_REWRITE_TAC[REAL_LT_ADDR],
1536 RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN
1537 SUBGOAL_THEN “y < (y + d)” MP_TAC THENL
1538 [MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC “x:real” THEN
1539 ASM_REWRITE_TAC[], ALL_TAC] THEN
1540 REWRITE_TAC[REAL_LT_ADDR] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
1541 MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC “x:real” THEN
1542 ASM_REWRITE_TAC[REAL_LT_ADDR]]
1543QED
1544
1545Theorem ABS_BOUND:
1546 !x y d. abs(x - y) < d ==> y < (x + d)
1547Proof
1548 REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[ABS_SUB] THEN
1549 ONCE_REWRITE_TAC[GSYM ABS_BETWEEN] THEN
1550 DISCH_TAC THEN ASM_REWRITE_TAC[]
1551QED
1552
1553Theorem ABS_STILLNZ:
1554 !x y. abs(x - y) < abs(y) ==> ~(x = 0)
1555Proof
1556 REPEAT GEN_TAC THEN CONV_TAC CONTRAPOS_CONV THEN
1557 REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN
1558 REWRITE_TAC[REAL_SUB_LZERO, ABS_NEG, REAL_LT_REFL]
1559QED
1560
1561Theorem ABS_CASES:
1562 !x. (x = 0) \/ 0 < abs(x)
1563Proof
1564 GEN_TAC THEN REWRITE_TAC[GSYM ABS_NZ] THEN
1565 BOOL_CASES_TAC “x = 0” THEN ASM_REWRITE_TAC[]
1566QED
1567
1568Theorem ABS_BETWEEN1:
1569 !x y z. x < z /\ (abs(y - x)) < (z - x) ==> y < z
1570Proof
1571 REPEAT GEN_TAC THEN
1572 DISJ_CASES_TAC (SPECL [“x:real”, “y:real”] REAL_LET_TOTAL) THENL
1573 [ASM_REWRITE_TAC[abs, REAL_SUB_LE] THEN
1574 REWRITE_TAC[real_sub, REAL_LT_RADD] THEN
1575 DISCH_THEN(ACCEPT_TAC o CONJUNCT2),
1576 DISCH_TAC THEN MATCH_MP_TAC REAL_LT_TRANS THEN
1577 EXISTS_TAC “x:real” THEN ASM_REWRITE_TAC[]]
1578QED
1579
1580Theorem ABS_SIGN:
1581 !x y. abs(x - y) < y ==> 0 < x
1582Proof
1583 REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP ABS_BOUND) THEN
1584 REWRITE_TAC[REAL_LT_ADDL]
1585QED
1586
1587Theorem ABS_SIGN2:
1588 !x y. abs(x - y) < ~y ==> x < 0
1589Proof
1590 REPEAT GEN_TAC THEN DISCH_TAC THEN
1591 MP_TAC(Q.SPECL [‘~x’, ‘~y’] ABS_SIGN) THEN
1592 REWRITE_TAC[REAL_SUB_NEG2] THEN
1593 ONCE_REWRITE_TAC[ABS_SUB] THEN
1594 DISCH_THEN(fn th => FIRST_ASSUM(MP_TAC o MATCH_MP th)) THEN
1595 REWRITE_TAC[GSYM REAL_NEG_LT0, REAL_NEGNEG]
1596QED
1597
1598Theorem ABS_DIV:
1599 !y. ~(y = 0) ==> !x. abs(x / y) = abs(x) / abs(y)
1600Proof
1601 GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN REWRITE_TAC[real_div] THEN
1602 REWRITE_TAC[ABS_MUL] THEN
1603 POP_ASSUM(fn th => REWRITE_TAC[MATCH_MP ABS_INV th])
1604QED
1605
1606(* HOL-Light compatible, use with cautions *)
1607Theorem REAL_ABS_DIV :
1608 !x y. abs (x / y) = abs x / abs y
1609Proof
1610 rpt GEN_TAC
1611 >> reverse (Cases_on ‘y = 0’)
1612 >- (MATCH_MP_TAC ABS_DIV >> ASM_REWRITE_TAC [])
1613 >> POP_ASSUM (fn th => REWRITE_TAC [th, ABS_0, real_div, REAL_INV_0, REAL_MUL_RZERO])
1614QED
1615
1616Theorem ABS_CIRCLE:
1617 !x y h. abs(h) < (abs(y) - abs(x)) ==> abs(x + h) < abs(y)
1618Proof
1619 REPEAT GEN_TAC THEN DISCH_TAC THEN
1620 MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC “abs(x) + abs(h)” THEN
1621 REWRITE_TAC[ABS_TRIANGLE] THEN
1622 POP_ASSUM(MP_TAC o CONJ (SPEC “abs(x)” REAL_LE_REFL)) THEN
1623 DISCH_THEN(MP_TAC o MATCH_MP REAL_LET_ADD2) THEN
1624 REWRITE_TAC[REAL_SUB_ADD2]
1625QED
1626
1627Theorem REAL_SUB_ABS:
1628 !x y. (abs(x) - abs(y)) <= abs(x - y)
1629Proof
1630 REPEAT GEN_TAC THEN
1631 MATCH_MP_TAC REAL_LE_TRANS THEN
1632 EXISTS_TAC “(abs(x - y) + abs(y)) - abs(y)” THEN CONJ_TAC THENL
1633 [ONCE_REWRITE_TAC[real_sub] THEN REWRITE_TAC[REAL_LE_RADD] THEN
1634 SUBST1_TAC(SYM(SPECL [“x:real”, “y:real”] REAL_SUB_ADD)) THEN
1635 GEN_REWR_TAC (RAND_CONV o ONCE_DEPTH_CONV) [REAL_SUB_ADD] THEN
1636 MATCH_ACCEPT_TAC ABS_TRIANGLE,
1637 ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
1638 REWRITE_TAC[REAL_ADD_SUB, REAL_LE_REFL]]
1639QED
1640
1641Theorem ABS_SUB_ABS:
1642 !x y. abs(abs(x) - abs(y)) <= abs(x - y)
1643Proof
1644 REPEAT GEN_TAC THEN
1645 GEN_REWR_TAC (RATOR_CONV o ONCE_DEPTH_CONV) [abs] THEN
1646 COND_CASES_TAC THEN REWRITE_TAC[REAL_SUB_ABS] THEN
1647 REWRITE_TAC[REAL_NEG_SUB] THEN
1648 ONCE_REWRITE_TAC[ABS_SUB] THEN
1649 REWRITE_TAC[REAL_SUB_ABS]
1650QED
1651
1652Theorem ABS_BETWEEN2:
1653 !x0 x y0 y.
1654 x0 < y0 /\
1655 abs(x - x0) < (y0 - x0) / &2 /\
1656 abs(y - y0) < (y0 - x0) / &2
1657 ==> x < y
1658Proof
1659 REPEAT GEN_TAC THEN STRIP_TAC THEN
1660 SUBGOAL_THEN “x < y0 /\ x0 < y” STRIP_ASSUME_TAC THENL
1661 [CONJ_TAC THENL
1662 [MP_TAC(SPECL [“x0:real”, “x:real”,
1663 “y0 - x0”] ABS_BOUND) THEN
1664 REWRITE_TAC[REAL_SUB_ADD2] THEN DISCH_THEN MATCH_MP_TAC THEN
1665 ONCE_REWRITE_TAC[ABS_SUB] THEN
1666 MATCH_MP_TAC REAL_LT_TRANS THEN
1667 EXISTS_TAC “(y0 - x0) / &2” THEN
1668 ASM_REWRITE_TAC[REAL_LT_HALF2] THEN
1669 ASM_REWRITE_TAC[REAL_SUB_LT],
1670 GEN_REWR_TAC I [TAUT_CONV “a = ~~a:bool”] THEN
1671 PURE_REWRITE_TAC[REAL_NOT_LT] THEN DISCH_TAC THEN
1672 MP_TAC(AC(REAL_ADD_ASSOC,REAL_ADD_SYM)
1673 “(y0 + ~x0) + (x0 + ~y) = (~x0 + x0) + (y0 + ~y)”) THEN
1674 REWRITE_TAC[GSYM real_sub, REAL_ADD_LINV, REAL_ADD_LID] THEN
1675 DISCH_TAC THEN
1676 MP_TAC(SPECL [“y0 - x0”,
1677 “x0 - y”] REAL_LE_ADDR) THEN
1678 ASM_REWRITE_TAC[REAL_SUB_LE] THEN DISCH_TAC THEN
1679 SUBGOAL_THEN “~(y0 <= y)” ASSUME_TAC THENL
1680 [REWRITE_TAC[REAL_NOT_LE] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN
1681 MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC “y0 - x0” THEN
1682 ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[REAL_SUB_LT], ALL_TAC] THEN
1683 UNDISCH_TAC “abs(y - y0) < (y0 - x0) / &2” THEN
1684 ASM_REWRITE_TAC[abs, REAL_SUB_LE] THEN
1685 REWRITE_TAC[REAL_NEG_SUB] THEN DISCH_TAC THEN
1686 SUBGOAL_THEN “(y0 - x0) < (y0 - x0) / &2”
1687 MP_TAC THENL
1688 [MATCH_MP_TAC REAL_LET_TRANS THEN
1689 EXISTS_TAC “y0 - y” THEN ASM_REWRITE_TAC[], ALL_TAC] THEN
1690 REWRITE_TAC[REAL_NOT_LT] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN
1691 REWRITE_TAC[REAL_LT_HALF2] THEN ASM_REWRITE_TAC[REAL_SUB_LT]],
1692 ALL_TAC] THEN
1693 GEN_REWR_TAC I [TAUT_CONV “a = ~~a:bool”] THEN
1694 PURE_REWRITE_TAC[REAL_NOT_LT] THEN DISCH_TAC THEN
1695 SUBGOAL_THEN “abs(x0 - y) < (y0 - x0) / &2” ASSUME_TAC
1696 THENL
1697 [REWRITE_TAC[abs, REAL_SUB_LE] THEN ASM_REWRITE_TAC[GSYM REAL_NOT_LT] THEN
1698 REWRITE_TAC[REAL_NEG_SUB] THEN MATCH_MP_TAC REAL_LET_TRANS THEN
1699 EXISTS_TAC “x - x0” THEN
1700 REWRITE_TAC[real_sub, REAL_LE_RADD] THEN
1701 ASM_REWRITE_TAC[GSYM real_sub] THEN
1702 MATCH_MP_TAC REAL_LET_TRANS THEN
1703 EXISTS_TAC “abs(x - x0)” THEN
1704 ASM_REWRITE_TAC[ABS_LE], ALL_TAC] THEN
1705 SUBGOAL_THEN
1706 “abs(y0 - x0) < ((y0 - x0) / &2) + ((y0 - x0) / &2)”
1707 MP_TAC
1708 THENL
1709 [ALL_TAC,
1710 REWRITE_TAC[REAL_HALF_DOUBLE, REAL_NOT_LT, ABS_LE]] THEN
1711 MATCH_MP_TAC REAL_LET_TRANS THEN
1712 EXISTS_TAC “abs(y0 - y) + abs(y - x0)” THEN
1713 CONJ_TAC THENL
1714 [ALL_TAC,
1715 MATCH_MP_TAC REAL_LT_ADD2 THEN ONCE_REWRITE_TAC[ABS_SUB] THEN
1716 ASM_REWRITE_TAC[]] THEN
1717 SUBGOAL_THEN “y0 - x0 = (y0 - y) + (y - x0)” SUBST1_TAC THEN
1718 REWRITE_TAC[ABS_TRIANGLE] THEN REAL_ARITH_TAC
1719QED
1720
1721Theorem ABS_BOUNDS:
1722 !x k. abs(x) <= k <=> ~k <= x /\ x <= k
1723Proof
1724 REPEAT GEN_TAC THEN
1725 GEN_REWR_TAC (RAND_CONV o LAND_CONV) [GSYM REAL_LE_NEG] THEN
1726 REWRITE_TAC[REAL_NEGNEG] THEN REWRITE_TAC[abs] THEN
1727 COND_CASES_TAC THENL
1728 [REWRITE_TAC[TAUT_CONV “(a <=> b /\ a) <=> a ==> b”] THEN
1729 DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
1730 EXISTS_TAC “x:real” THEN ASM_REWRITE_TAC[REAL_LE_NEGL],
1731 REWRITE_TAC[TAUT_CONV “(a <=> a /\ b) <=> a ==> b”] THEN
1732 DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
1733 Q.EXISTS_TAC ‘-x’ THEN ASM_REWRITE_TAC[] THEN
1734 REWRITE_TAC[REAL_LE_NEGR] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN
1735 ASM_REWRITE_TAC[GSYM REAL_NOT_LE]]
1736QED
1737
1738Theorem ABS_BOUNDS_LT :
1739 !(x :real) k. abs(x) < k <=> -k < x /\ x < k
1740Proof
1741 RW_TAC std_ss [abs]
1742 >| [ (* goal 1 (of 2) *)
1743 EQ_TAC >> RW_TAC std_ss [] \\
1744 MATCH_MP_TAC REAL_LTE_TRANS \\
1745 Q.EXISTS_TAC ‘-x’ \\
1746 RW_TAC std_ss [REAL_LT_NEG, REAL_LE_NEGL],
1747 (* goal 2 (of 2) *)
1748 FULL_SIMP_TAC std_ss [REAL_NOT_LE] \\
1749 ‘-x < k <=> -k < x’ by METIS_TAC [REAL_LT_NEG, REAL_NEGNEG] \\
1750 EQ_TAC >> RW_TAC std_ss [] \\
1751 ‘-k < 0’ by PROVE_TAC [REAL_LT_TRANS] \\
1752 ‘0 < k’ by METIS_TAC [REAL_LT_NEG, REAL_NEGNEG, REAL_NEG_0] \\
1753 MATCH_MP_TAC REAL_LT_TRANS \\
1754 Q.EXISTS_TAC ‘0’ >> ASM_REWRITE_TAC [] ]
1755QED
1756
1757Theorem LE_ABS_BOUNDS :
1758 !k x :real. k <= abs x <=> x <= -k \/ k <= x
1759Proof
1760 METIS_TAC [real_lt, ABS_BOUNDS_LT]
1761QED
1762
1763(*---------------------------------------------------------------------------*)
1764(* Define integer powers *)
1765(*---------------------------------------------------------------------------*)
1766
1767(* |- (!x. x pow 0 = 1) /\ !x n. x pow SUC n = x * x pow n *)
1768Theorem pow = real_pow
1769
1770(* from arithmeticTheory.EXP *)
1771val _ = overload_on (UnicodeChars.sup_2, “\x. x pow 2”);
1772val _ = overload_on (UnicodeChars.sup_3, “\x. x pow 3”);
1773
1774Theorem REAL_POW : (* from examples/miller *)
1775 !m n. &m pow n = &(m EXP n)
1776Proof
1777 REWRITE_TAC [REAL_OF_NUM_POW]
1778QED
1779
1780Theorem pow0[simp] = CONJUNCT1 pow;
1781
1782Theorem POW_0:
1783 !n. 0 pow (SUC n) = 0
1784Proof
1785 INDUCT_TAC THEN REWRITE_TAC[pow, REAL_MUL_LZERO]
1786QED
1787
1788Theorem POW_NZ:
1789 !c n. ~(c = 0) ==> ~(c pow n = 0)
1790Proof
1791 REPEAT GEN_TAC THEN DISCH_TAC THEN SPEC_TAC(“n:num”,“n:num”) THEN
1792 INDUCT_TAC THEN ASM_REWRITE_TAC[pow, REAL_10, REAL_ENTIRE]
1793QED
1794
1795Theorem POW_INV:
1796 !c. ~(c = 0) ==> !n. (inv(c pow n) = (inv c) pow n)
1797Proof
1798 GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN REWRITE_TAC[pow, REAL_INV1] THEN
1799 MP_TAC(SPECL [“c:real”, “c pow n”] REAL_INV_MUL) THEN
1800 ASM_REWRITE_TAC[] THEN SUBGOAL_THEN “~(c pow n = 0)” ASSUME_TAC THENL
1801 [MATCH_MP_TAC POW_NZ THEN ASM_REWRITE_TAC[], ALL_TAC] THEN
1802 ASM_REWRITE_TAC[]
1803QED
1804
1805Theorem POW_ABS:
1806 !c n. abs(c) pow n = abs(c pow n)
1807Proof
1808 GEN_TAC THEN INDUCT_TAC THEN
1809 ASM_REWRITE_TAC[pow, ABS_1, ABS_MUL]
1810QED
1811
1812Theorem POW_PLUS1:
1813 !e. 0 < e ==> !n. (&1 + (&n * e)) <= (&1 + e) pow n
1814Proof
1815 GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN
1816 REWRITE_TAC[pow, REAL_MUL_LZERO, REAL_ADD_RID, REAL_LE_REFL] THEN
1817 MATCH_MP_TAC REAL_LE_TRANS THEN
1818 EXISTS_TAC “(&1 + e) * (&1 + (&n * e))” THEN CONJ_TAC THENL
1819 [REWRITE_TAC[REAL_LDISTRIB, REAL_RDISTRIB, REAL, REAL_MUL_LID] THEN
1820 REWRITE_TAC[REAL_MUL_RID, REAL_ADD_ASSOC, REAL_LE_ADDR] THEN
1821 MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL
1822 [MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[], ALL_TAC] THEN
1823 MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL
1824 [ALL_TAC, MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]] THEN
1825 REWRITE_TAC[REAL_LE, ZERO_LESS_EQ],
1826 SUBGOAL_THEN “0 < (&1 + e)”
1827 (fn th => ASM_REWRITE_TAC[MATCH_MP REAL_LE_LMUL th]) THEN
1828 GEN_REWR_TAC LAND_CONV [GSYM REAL_ADD_LID] THEN
1829 MATCH_MP_TAC REAL_LT_ADD2 THEN ASM_REWRITE_TAC[] THEN
1830 REWRITE_TAC[REAL_LT] THEN REWRITE_TAC[num_CONV “1:num”, LESS_0]]
1831QED
1832
1833Theorem POW_ADD:
1834 !c m n. c pow (m + n) = (c pow m) * (c pow n)
1835Proof
1836 GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN
1837 ASM_REWRITE_TAC[pow, ADD_CLAUSES, REAL_MUL_RID] THEN
1838 CONV_TAC(AC_CONV(REAL_MUL_ASSOC,REAL_MUL_SYM))
1839QED
1840
1841Theorem POW_1[simp]:
1842 !x. x pow 1 = x
1843Proof
1844 REWRITE_TAC[ONE, pow] >> simp[]
1845QED
1846
1847(* |- !x. x pow 2 = x * x *)
1848Theorem POW_2 = REAL_POW_2;
1849
1850Theorem POW_ONE[simp]:
1851 !n. &1 pow n = &1
1852Proof
1853 Induct THEN ASM_REWRITE_TAC[pow, REAL_MUL_LID]
1854QED
1855
1856Theorem POW_POS:
1857 !x. 0 <= x ==> !n. 0 <= (x pow n)
1858Proof
1859 GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN
1860 REWRITE_TAC[pow, REAL_LE_01] THEN
1861 MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[]
1862QED
1863
1864Theorem POW_LE:
1865 !n x y. 0 <= x /\ x <= y ==> (x pow n) <= (y pow n)
1866Proof
1867 INDUCT_TAC THEN REWRITE_TAC[pow, REAL_LE_REFL] THEN
1868 REPEAT GEN_TAC THEN STRIP_TAC THEN
1869 MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
1870 [MATCH_MP_TAC POW_POS THEN FIRST_ASSUM ACCEPT_TAC,
1871 FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]
1872QED
1873
1874Theorem POW_M1[simp]:
1875 !n. abs(~1 pow n) = 1
1876Proof
1877 INDUCT_TAC THEN REWRITE_TAC[pow, ABS_NEG, ABS_1] THEN
1878 ASM_REWRITE_TAC[ABS_MUL, ABS_NEG, ABS_1, REAL_MUL_LID]
1879QED
1880
1881Theorem POW_MUL:
1882 !n x y. (x * y) pow n = (x pow n) * (y pow n)
1883Proof
1884 INDUCT_TAC THEN REWRITE_TAC[pow, REAL_MUL_LID] THEN
1885 REPEAT GEN_TAC THEN ASM_REWRITE_TAC[] THEN
1886 CONV_TAC(AC_CONV(REAL_MUL_ASSOC,REAL_MUL_SYM))
1887QED
1888
1889Theorem REAL_LE_POW2:
1890 !x. 0 <= x pow 2
1891Proof
1892 GEN_TAC THEN REWRITE_TAC[POW_2, REAL_LE_SQUARE]
1893QED
1894
1895Theorem ABS_POW2[simp]:
1896 !x. abs(x pow 2) = x pow 2
1897Proof
1898 GEN_TAC THEN REWRITE_TAC[ABS_REFL, REAL_LE_POW2]
1899QED
1900
1901Theorem REAL_POW2_ABS[simp]:
1902 !x. abs(x) pow 2 = x pow 2
1903Proof
1904 GEN_TAC THEN REWRITE_TAC[POW_2, POW_MUL] THEN
1905 REWRITE_TAC[GSYM ABS_MUL] THEN
1906 REWRITE_TAC[GSYM POW_2, ABS_POW2]
1907QED
1908
1909Theorem REAL_LE1_POW2:
1910 !x. &1 <= x ==> &1 <= (x pow 2)
1911Proof
1912 GEN_TAC THEN REWRITE_TAC[POW_2] THEN DISCH_TAC THEN
1913 GEN_REWR_TAC LAND_CONV [GSYM REAL_MUL_LID] THEN
1914 MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[REAL_LE_01]
1915QED
1916
1917Theorem REAL_LT1_POW2:
1918 !x. &1 < x ==> &1 < (x pow 2)
1919Proof
1920 GEN_TAC THEN REWRITE_TAC[POW_2] THEN DISCH_TAC THEN
1921 GEN_REWR_TAC LAND_CONV [GSYM REAL_MUL_LID] THEN
1922 MATCH_MP_TAC REAL_LT_MUL2 THEN ASM_REWRITE_TAC[REAL_LE_01]
1923QED
1924
1925Theorem POW_POS_LT:
1926 !x n. 0 < x ==> 0 < (x pow (SUC n))
1927Proof
1928 REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LT_LE] THEN
1929 DISCH_TAC THEN CONJ_TAC THENL
1930 [MATCH_MP_TAC POW_POS THEN ASM_REWRITE_TAC[],
1931 CONV_TAC(RAND_CONV SYM_CONV) THEN
1932 MATCH_MP_TAC POW_NZ THEN
1933 CONV_TAC(RAND_CONV SYM_CONV) THEN ASM_REWRITE_TAC[]]
1934QED
1935
1936Theorem POW_2_LE1:
1937 !n. &1 <= &2 pow n
1938Proof
1939 INDUCT_TAC THEN REWRITE_TAC[pow, REAL_LE_REFL] THEN
1940 GEN_REWR_TAC LAND_CONV [GSYM REAL_MUL_LID] THEN
1941 MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[REAL_LE] THEN
1942 REWRITE_TAC[ZERO_LESS_EQ, num_CONV “2:num”, LESS_EQ_SUC_REFL]
1943QED
1944
1945Theorem POW_2_LT:
1946 !n. &n < &2 pow n
1947Proof
1948 INDUCT_TAC THEN REWRITE_TAC[pow, REAL_LT_01] THEN
1949 REWRITE_TAC[ADD1, GSYM REAL_ADD, GSYM REAL_DOUBLE] THEN
1950 MATCH_MP_TAC REAL_LTE_ADD2 THEN ASM_REWRITE_TAC[POW_2_LE1]
1951QED
1952
1953Theorem POW_MINUS1[simp]:
1954 !n. ~1 pow (2 * n) = 1
1955Proof
1956 INDUCT_TAC THEN REWRITE_TAC[MULT_CLAUSES, pow] THEN
1957 REWRITE_TAC(map num_CONV [Term`2:num`,Term`1:num`] @ [ADD_CLAUSES]) THEN
1958 REWRITE_TAC[pow] THEN
1959 REWRITE_TAC[SYM(num_CONV “2:num”), SYM(num_CONV “1:num”)] THEN
1960 ASM_REWRITE_TAC[] THEN
1961 REWRITE_TAC[GSYM REAL_NEG_LMUL, GSYM REAL_NEG_RMUL] THEN
1962 REWRITE_TAC[REAL_MUL_LID, REAL_NEGNEG]
1963QED
1964
1965Theorem POW_MINUS1_ODD: !n. ~1 pow (2 * n + 1) = ~1
1966Proof simp[POW_ADD]
1967QED
1968
1969Theorem NEGATED_POW[simp]:
1970 ((-x) pow NUMERAL (BIT1 n) = -(x pow NUMERAL (BIT1 n))) /\
1971 ((-x) pow NUMERAL (BIT2 n) = x pow NUMERAL (BIT2 n))
1972Proof
1973 reverse conj_tac >> ONCE_REWRITE_TAC [REAL_NEG_MINUS1] >>
1974 REWRITE_TAC [POW_MUL]
1975 >- (‘NUMERAL (BIT2 n) = 2 * (n + 1)’ suffices_by
1976 (disch_then SUBST_ALL_TAC >> simp[]) >>
1977 CONV_TAC (LAND_CONV (REWRITE_CONV [NUMERAL_DEF, BIT2])) >>
1978 simp[]) >>
1979 ‘NUMERAL (BIT1 n) = 2 * n + 1’ suffices_by
1980 (disch_then SUBST_ALL_TAC >> simp[POW_MINUS1_ODD]) >>
1981 CONV_TAC (LAND_CONV (REWRITE_CONV [NUMERAL_DEF, BIT1])) >>
1982 simp[]
1983QED
1984
1985Theorem POW_LT:
1986 !n x y. 0 <= x /\ x < y ==> (x pow (SUC n)) < (y pow (SUC n))
1987Proof
1988 REPEAT STRIP_TAC THEN SPEC_TAC(“n:num”,“n:num”)
1989 THEN INDUCT_TAC THENL
1990 [ASM_REWRITE_TAC[pow, REAL_MUL_RID],
1991 ONCE_REWRITE_TAC[pow] THEN MATCH_MP_TAC REAL_LT_MUL2 THEN
1992 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC POW_POS THEN ASM_REWRITE_TAC[]]
1993QED
1994
1995Theorem REAL_POW_LT:
1996 !x n. 0 < x ==> 0 < (x pow n)
1997Proof
1998 REPEAT STRIP_TAC THEN SPEC_TAC(Term`n:num`,Term`n:num`) THEN
1999 INDUCT_TAC THEN REWRITE_TAC[pow, REAL_LT_01] THEN
2000 MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[]
2001QED
2002
2003Theorem REAL_POW_LE_1 :
2004 !(n:num) (x:real). (&1:real) <= x ==> (&1:real) <= x pow n
2005Proof
2006 INDUCT_TAC THENL
2007 [REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[pow, REAL_LE_REFL],
2008 GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC [pow] THEN
2009 GEN_REWRITE_TAC LAND_CONV empty_rewrites [GSYM REAL_MUL_LID] THEN
2010 MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[REAL_LE_01] THEN
2011 FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]
2012QED
2013
2014Theorem REAL_POW_1_LE :
2015 !n x:real. &0 <= x /\ x <= &1 ==> x pow n <= &1
2016Proof
2017 REPEAT STRIP_TAC THEN
2018 MP_TAC(SPECL [``n:num``, ``x:real``, ``&1:real``] POW_LE) THEN
2019 ASM_REWRITE_TAC[POW_ONE]
2020QED
2021
2022Theorem POW_EQ:
2023 !n x y. 0 <= x /\ 0 <= y /\ (x pow (SUC n) = y pow (SUC n))
2024 ==> (x = y)
2025Proof
2026 REPEAT STRIP_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC
2027 (SPECL [“x:real”, “y:real”] REAL_LT_TOTAL) THEN
2028 ASM_REWRITE_TAC[] THEN
2029 UNDISCH_TAC “x pow (SUC n) = y pow (SUC n)” THEN
2030 CONV_TAC CONTRAPOS_CONV THEN DISCH_THEN(K ALL_TAC) THENL
2031 [ALL_TAC, CONV_TAC(RAND_CONV SYM_CONV)] THEN
2032 MATCH_MP_TAC REAL_LT_IMP_NE THEN
2033 MATCH_MP_TAC POW_LT THEN ASM_REWRITE_TAC[]
2034QED
2035
2036Theorem POW_ZERO:
2037 !n x. (x pow n = 0) ==> (x = 0)
2038Proof
2039 INDUCT_TAC THEN GEN_TAC THEN ONCE_REWRITE_TAC[pow] THEN
2040 REWRITE_TAC[REAL_10, REAL_ENTIRE] THEN
2041 DISCH_THEN(DISJ_CASES_THEN2 ACCEPT_TAC ASSUME_TAC) THEN
2042 FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC
2043QED
2044
2045Theorem REAL_POW_EQ_0 :
2046 !x n. (x pow n = &0) <=> (x = &0) /\ ~(n = 0)
2047Proof
2048 GEN_TAC THEN INDUCT_TAC THEN
2049 ASM_REWRITE_TAC[NOT_SUC, real_pow, REAL_ENTIRE] THENL
2050 [ REAL_ARITH_TAC, TAUT_TAC ]
2051QED
2052
2053Theorem POW_ZERO_EQ:
2054 !n x. (x pow (SUC n) = 0) <=> (x = 0)
2055Proof
2056 REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[POW_ZERO] THEN
2057 DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[POW_0]
2058QED
2059
2060Theorem REAL_POW_LT2:
2061 !n x y. ~(n = 0) /\ 0 <= x /\ x < y ==> x pow n < y pow n
2062Proof
2063 INDUCT_TAC THEN REWRITE_TAC[NOT_SUC, pow] THEN REPEAT STRIP_TAC THEN
2064 ASM_CASES_TAC (Term `n = 0:num`) THEN ASM_REWRITE_TAC[pow, REAL_MUL_RID] THEN
2065 MATCH_MP_TAC REAL_LT_MUL2 THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
2066 [MATCH_MP_TAC POW_POS THEN ASM_REWRITE_TAC[],
2067 FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]
2068QED
2069
2070Theorem REAL_POW_INV :
2071 !x n. (inv x) pow n = inv(x pow n)
2072Proof
2073 Induct_on `n` THEN REWRITE_TAC [pow] THENL
2074 [REWRITE_TAC [REAL_INV1],
2075 GEN_TAC THEN Cases_on `x = 0r` THENL
2076 [POP_ASSUM SUBST_ALL_TAC
2077 THEN REWRITE_TAC [REAL_INV_0,REAL_MUL_LZERO],
2078 `~(x pow n = 0)` by PROVE_TAC [POW_NZ] THEN
2079 IMP_RES_TAC REAL_INV_MUL THEN ASM_REWRITE_TAC []]]
2080QED
2081
2082Theorem REAL_POW_DIV :
2083 !x y n. (x / y) pow n = (x pow n) / (y pow n)
2084Proof
2085 REWRITE_TAC[real_div, POW_MUL, REAL_POW_INV]
2086QED
2087
2088Theorem REAL_POW_ADD :
2089 !x m n. x pow (m + n) = x pow m * x pow n
2090Proof
2091 Induct_on `m` THEN
2092 ASM_REWRITE_TAC[ADD_CLAUSES, pow, REAL_MUL_LID, REAL_MUL_ASSOC]
2093QED
2094
2095Theorem REAL_POW_MONO :
2096 !m n x. &1 <= x /\ m <= n ==> x pow m <= x pow n
2097Proof
2098 REPEAT GEN_TAC THEN REWRITE_TAC[LESS_EQ_EXISTS] THEN
2099 DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
2100 DISCH_THEN(X_CHOOSE_THEN “d:num” SUBST1_TAC) THEN
2101 REWRITE_TAC[REAL_POW_ADD] THEN
2102 GEN_REWRITE_TAC LAND_CONV empty_rewrites [GSYM REAL_MUL_RID] THEN
2103 MATCH_MP_TAC REAL_LE_LMUL_IMP THEN CONJ_TAC THENL
2104 [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC “&1” THEN
2105 RW_TAC arith_ss [REAL_LE] THEN
2106 MATCH_MP_TAC REAL_POW_LE_1 THEN ASM_REWRITE_TAC[],
2107 MATCH_MP_TAC REAL_POW_LE_1 THEN ASM_REWRITE_TAC[]]
2108QED
2109
2110Theorem REAL_POW_MONO_LT :
2111 !m n x. &1 < x /\ m < n ==> x pow m < x pow n
2112Proof
2113 REPEAT GEN_TAC THEN REWRITE_TAC[LT_EXISTS] THEN
2114 DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
2115 DISCH_THEN(CHOOSE_THEN SUBST_ALL_TAC) THEN
2116 REWRITE_TAC[POW_ADD] THEN
2117 GEN_REWRITE_TAC LAND_CONV empty_rewrites [GSYM REAL_MUL_RID] THEN
2118 MATCH_MP_TAC REAL_LT_LMUL_IMP THEN CONJ_TAC THENL
2119 [SPEC_TAC(Term`d:num`,Term`d:num`) THEN
2120 INDUCT_TAC THEN ONCE_REWRITE_TAC[pow] THENL
2121 [ASM_REWRITE_TAC[pow, REAL_MUL_RID], ALL_TAC] THEN
2122 GEN_REWRITE_TAC LAND_CONV empty_rewrites [GSYM REAL_MUL_LID] THEN
2123 MATCH_MP_TAC REAL_LT_MUL2 THEN
2124 ASM_REWRITE_TAC[REAL_LE, ZERO_LESS_EQ],
2125 MATCH_MP_TAC REAL_POW_LT THEN
2126 MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC (Term`&1`) THEN
2127 ASM_REWRITE_TAC[REAL_LT,prim_recTheory.LESS_0, ONE]]
2128QED
2129
2130Theorem REAL_POW_MONO_EQ :
2131 !m n (x :real). 1 < x ==> (x pow m <= x pow n <=> m <= n)
2132Proof
2133 rpt STRIP_TAC
2134 >> reverse EQ_TAC
2135 >- (DISCH_TAC \\
2136 MATCH_MP_TAC REAL_POW_MONO >> art [] \\
2137 MATCH_MP_TAC REAL_LT_IMP_LE >> art [])
2138 >> DISCH_TAC
2139 >> SPOSE_NOT_THEN (ASSUME_TAC o REWRITE_RULE [NOT_LE])
2140 >> ‘x pow n < (x pow m) :real’ by PROVE_TAC [REAL_POW_MONO_LT]
2141 >> METIS_TAC [REAL_LET_ANTISYM]
2142QED
2143
2144Theorem REAL_POW_POW :
2145 !x m n. (x pow m) pow n = x pow (m * n)
2146Proof
2147 GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN
2148 ASM_REWRITE_TAC[pow, MULT_CLAUSES, POW_ADD]
2149QED
2150
2151(*---------------------------------------------------------------------------*)
2152(* Derive the supremum property for an arbitrary bounded nonempty set *)
2153(*---------------------------------------------------------------------------*)
2154
2155(* cf. REAL_SUP_ALLPOS *)
2156Theorem REAL_SUP_SOMEPOS:
2157 !P. (?x. P x /\ 0 < x) /\ (?z. !x. P x ==> x < z) ==>
2158 (?s. !y. (?x. P x /\ y < x) <=> y < s)
2159Proof
2160 let val lemma = TAUT_CONV “a /\ b ==> b” in
2161 GEN_TAC THEN DISCH_TAC THEN
2162 MP_TAC (SPEC “\x. P x /\ 0 < x” REAL_SUP_ALLPOS) THEN
2163 BETA_TAC THEN ASM_REWRITE_TAC[lemma] THEN
2164 SUBGOAL_THEN
2165 “?z. !x. P x /\ 0 < x ==> x < z” (SUBST1_TAC o EQT_INTRO)
2166 THENL
2167 [POP_ASSUM(X_CHOOSE_TAC “z:real” o CONJUNCT2) THEN
2168 EXISTS_TAC “z:real” THEN
2169 GEN_TAC THEN
2170 DISCH_THEN(curry op THEN (FIRST_ASSUM MATCH_MP_TAC) o ASSUME_TAC) THEN
2171 ASM_REWRITE_TAC[], ALL_TAC] THEN
2172 REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN “s:real” MP_TAC) THEN
2173 DISCH_THEN(curry op THEN (EXISTS_TAC “s:real” THEN GEN_TAC) o
2174 (SUBST1_TAC o SYM o SPEC “y:real”)) THEN EQ_TAC THENL
2175 [REPEAT_TCL DISJ_CASES_THEN MP_TAC (SPECL [“y:real”, “0”]
2176 REAL_LT_TOTAL)
2177 THENL
2178 [DISCH_THEN SUBST1_TAC THEN DISCH_THEN(X_CHOOSE_TAC “x:real”) THEN
2179 EXISTS_TAC “x:real” THEN ASM_REWRITE_TAC[],
2180 POP_ASSUM(X_CHOOSE_TAC “x:real” o CONJUNCT1) THEN
2181 DISCH_THEN(fn th => FIRST_ASSUM(MP_TAC o CONJ th o CONJUNCT2)) THEN
2182 DISCH_THEN(ASSUME_TAC o MATCH_MP REAL_LT_TRANS) THEN
2183 DISCH_THEN(K ALL_TAC) THEN
2184 EXISTS_TAC “x:real” THEN ASM_REWRITE_TAC[],
2185 POP_ASSUM(K ALL_TAC) THEN DISCH_TAC THEN
2186 DISCH_THEN(X_CHOOSE_TAC “x:real”) THEN
2187 EXISTS_TAC “x:real” THEN
2188 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_TRANS THEN
2189 EXISTS_TAC “y:real” THEN ASM_REWRITE_TAC[]],
2190 DISCH_THEN(X_CHOOSE_TAC “x:real”) THEN
2191 EXISTS_TAC “x:real” THEN
2192 ASM_REWRITE_TAC[]] end
2193QED
2194
2195Theorem SUP_LEMMA1:
2196 !P s d. (!y. (?x. (\x. P(x + d)) x /\ y < x) <=> y < s)
2197 ==> (!y. (?x. P x /\ y < x) <=> y < (s + d))
2198Proof
2199 REPEAT GEN_TAC THEN BETA_TAC THEN DISCH_TAC THEN GEN_TAC THEN
2200 POP_ASSUM(MP_TAC o SPEC “y + ~d”) THEN
2201 REWRITE_TAC[REAL_LT_ADDNEG2] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
2202 EQ_TAC THEN DISCH_THEN(X_CHOOSE_TAC “x:real”) THENL
2203 [EXISTS_TAC “x + ~d” THEN
2204 ASM_REWRITE_TAC[GSYM REAL_ADD_ASSOC, REAL_ADD_LINV, REAL_ADD_RID],
2205 EXISTS_TAC “x + d” THEN POP_ASSUM ACCEPT_TAC]
2206QED
2207
2208Theorem SUP_LEMMA2:
2209 !P. (?x. P x) ==> ?d. ?x. (\x. P(x + d)) x /\ 0 < x
2210Proof
2211 GEN_TAC THEN DISCH_THEN(X_CHOOSE_TAC “x:real”) THEN BETA_TAC THEN
2212 REPEAT_TCL DISJ_CASES_THEN MP_TAC (SPECL [“x:real”, “0”]
2213 REAL_LT_TOTAL)
2214 THENL
2215 [DISCH_THEN SUBST_ALL_TAC THEN
2216 MAP_EVERY EXISTS_TAC [“~1”, “1”] THEN
2217 ASM_REWRITE_TAC[REAL_ADD_RINV, REAL_LT_01],
2218 DISCH_TAC THEN
2219 qexistsl_tac [‘x + x’, ‘~x’] THEN
2220 ASM_REWRITE_TAC[REAL_ADD_ASSOC, REAL_ADD_LINV, REAL_ADD_LID, REAL_NEG_GT0],
2221 DISCH_TAC THEN MAP_EVERY EXISTS_TAC [“0”, “x:real”] THEN
2222 ASM_REWRITE_TAC[REAL_ADD_RID]]
2223QED
2224
2225Theorem SUP_LEMMA3:
2226 !d. (?z. !x. P x ==> x < z) ==>
2227 (?z. !x. (\x. P(x + d)) x ==> x < z)
2228Proof
2229 GEN_TAC THEN DISCH_THEN(X_CHOOSE_TAC “z:real”) THEN
2230 EXISTS_TAC “z + ~d” THEN GEN_TAC THEN BETA_TAC THEN
2231 DISCH_THEN(fn th => FIRST_ASSUM(ASSUME_TAC o C MATCH_MP th)) THEN
2232 ASM_REWRITE_TAC[REAL_LT_ADDNEG]
2233QED
2234
2235(*----------------------------------------------------------------------------*)
2236(* Derive the supremum property for an arbitrary bounded nonempty set *)
2237(*----------------------------------------------------------------------------*)
2238
2239Theorem REAL_SUP_EXISTS:
2240 !P. (?x. P x) /\ (?z. !x. P x ==> x < z) ==>
2241 (?s. !y. (?x. P x /\ y < x) <=> y < s)
2242Proof
2243 GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2
2244 (X_CHOOSE_TAC “d:real” o MATCH_MP SUP_LEMMA2) MP_TAC) THEN
2245 DISCH_THEN(MP_TAC o MATCH_MP (SPEC “d:real” SUP_LEMMA3)) THEN
2246 POP_ASSUM(fn th => DISCH_THEN(MP_TAC o MATCH_MP REAL_SUP_SOMEPOS o CONJ th))
2247 THEN
2248 DISCH_THEN(X_CHOOSE_TAC “s:real”) THEN
2249 EXISTS_TAC “s + d” THEN
2250 MATCH_MP_TAC SUP_LEMMA1 THEN POP_ASSUM ACCEPT_TAC
2251QED
2252
2253Theorem REAL_SUP_EXISTS' :
2254 !P. P <> {} /\ (?z. !x. x IN P ==> x < z) ==>
2255 (?s. !y. (?x. x IN P /\ y < x) <=> y < s)
2256Proof
2257 REWRITE_TAC [IN_APP, REAL_SUP_EXISTS, GSYM MEMBER_NOT_EMPTY]
2258QED
2259
2260Definition sup[nocompute]:
2261 sup P = @s. !y. (?x. P x /\ y < x) <=> y < s
2262End
2263
2264Theorem REAL_SUP:
2265 !P. (?x. P x) /\ (?z. !x. P x ==> x < z) ==>
2266 (!y. (?x. P x /\ y < x) <=> y < sup P)
2267Proof
2268 GEN_TAC THEN DISCH_THEN(MP_TAC o SELECT_RULE o MATCH_MP REAL_SUP_EXISTS)
2269 THEN REWRITE_TAC[GSYM sup]
2270QED
2271
2272Theorem REAL_SUP' :
2273 !P. P <> {} /\ (?z. !x. x IN P ==> x < z) ==>
2274 (!y. (?x. x IN P /\ y < x) <=> y < sup P)
2275Proof
2276 REWRITE_TAC [IN_APP, REAL_SUP, GSYM MEMBER_NOT_EMPTY]
2277QED
2278
2279Theorem REAL_SUP_UBOUND:
2280 !P. (?x. P x) /\ (?z. !x. P x ==> x < z) ==>
2281 (!y. P y ==> y <= sup P)
2282Proof
2283 GEN_TAC THEN DISCH_THEN(MP_TAC o SPEC “sup P” o MATCH_MP REAL_SUP) THEN
2284 REWRITE_TAC[REAL_LT_REFL] THEN
2285 DISCH_THEN(ASSUME_TAC o CONV_RULE NOT_EXISTS_CONV) THEN
2286 X_GEN_TAC “x:real” THEN RULE_ASSUM_TAC(SPEC “x:real”) THEN
2287 DISCH_THEN (SUBST_ALL_TAC o EQT_INTRO) THEN POP_ASSUM MP_TAC THEN
2288 REWRITE_TAC[REAL_NOT_LT]
2289QED
2290
2291Theorem REAL_SUP_UBOUND' :
2292 !P. P <> {} /\ (?z. !x. x IN P ==> x < z) ==>
2293 (!y. y IN P ==> y <= sup P)
2294Proof
2295 REWRITE_TAC [IN_APP, REAL_SUP_UBOUND, GSYM MEMBER_NOT_EMPTY]
2296QED
2297
2298Theorem SETOK_LE_LT:
2299 !P. (?x. P x) /\ (?z. !x. P x ==> x <= z) <=>
2300 (?x. P x) /\ (?z. !x. P x ==> x < z)
2301Proof
2302 GEN_TAC THEN AP_TERM_TAC THEN EQ_TAC THEN
2303 DISCH_THEN(X_CHOOSE_TAC “z:real”)
2304 THENL (map EXISTS_TAC [“z + &1”, “z:real”]) THEN
2305 GEN_TAC THEN DISCH_THEN(fn th => FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN
2306 REWRITE_TAC[REAL_LT_ADD1, REAL_LT_IMP_LE]
2307QED
2308
2309Theorem REAL_SUP_LE:
2310 !P. (?x. P x) /\ (?z. !x. P x ==> x <= z) ==>
2311 (!y. (?x. P x /\ y < x) <=> y < sup P)
2312Proof
2313 GEN_TAC THEN REWRITE_TAC[SETOK_LE_LT, REAL_SUP]
2314QED
2315
2316Theorem REAL_SUP_LE' :
2317 !P. P <> {} /\ (?z. !x. x IN P ==> x <= z) ==>
2318 (!y. (?x. x IN P /\ y < x) <=> y < sup P)
2319Proof
2320 REWRITE_TAC [IN_APP, REAL_SUP_LE, GSYM MEMBER_NOT_EMPTY]
2321QED
2322
2323Theorem REAL_SUP_UBOUND_LE:
2324 !P. (?x. P x) /\ (?z. !x. P x ==> x <= z) ==>
2325 (!y. P y ==> y <= sup P)
2326Proof
2327 GEN_TAC THEN REWRITE_TAC[SETOK_LE_LT, REAL_SUP_UBOUND]
2328QED
2329
2330Theorem REAL_SUP_UBOUND_LE' :
2331 !P. P <> {} /\ (?z. !x. x IN P ==> x <= z) ==>
2332 (!y. y IN P ==> y <= sup P)
2333Proof
2334 REWRITE_TAC [IN_APP, REAL_SUP_UBOUND_LE, GSYM MEMBER_NOT_EMPTY]
2335QED
2336
2337(*---------------------------------------------------------------------------*)
2338(* Prove the Archimedean property *)
2339(*---------------------------------------------------------------------------*)
2340
2341Theorem REAL_ARCH:
2342 !x. 0 < x ==> !y. ?n. y < &n * x
2343Proof
2344 GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN
2345 ONCE_REWRITE_TAC[TAUT_CONV “a = ~(~a):bool”] THEN
2346 CONV_TAC(ONCE_DEPTH_CONV NOT_EXISTS_CONV) THEN
2347 REWRITE_TAC[REAL_NOT_LT] THEN DISCH_TAC THEN
2348 MP_TAC(SPEC “\z. ?n. z = &n * x” REAL_SUP_LE) THEN
2349 BETA_TAC THEN
2350 W(C SUBGOAL_THEN(fn th => REWRITE_TAC[th]) o funpow 2 (fst o dest_imp) o snd)
2351 THENL [CONJ_TAC THENL
2352 [MAP_EVERY EXISTS_TAC [“&n * x”, “n:num”] THEN REFL_TAC,
2353 EXISTS_TAC “y:real” THEN GEN_TAC THEN
2354 DISCH_THEN(CHOOSE_THEN SUBST1_TAC) THEN ASM_REWRITE_TAC[]], ALL_TAC] THEN
2355 DISCH_TAC THEN
2356 FIRST_ASSUM(MP_TAC o SPEC “sup(\z. ?n. z = &n * x) - x”)
2357 THEN
2358 REWRITE_TAC[REAL_LT_SUB_RADD, REAL_LT_ADDR] THEN ASM_REWRITE_TAC[] THEN
2359 DISCH_THEN(X_CHOOSE_THEN “z:real” MP_TAC) THEN
2360 DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC “n:num”) MP_TAC) THEN
2361 ASM_REWRITE_TAC[] THEN
2362 GEN_REWR_TAC (funpow 3 RAND_CONV) [GSYM REAL_MUL_LID] THEN
2363 REWRITE_TAC[GSYM REAL_RDISTRIB] THEN DISCH_TAC THEN
2364 FIRST_ASSUM(MP_TAC o SPEC “sup(\z. ?n. z = &n * x)”) THEN
2365 REWRITE_TAC[REAL_LT_REFL] THEN EXISTS_TAC “(&n + &1) * x”
2366 THEN
2367 ASM_REWRITE_TAC[] THEN EXISTS_TAC “n + 1:num” THEN
2368 REWRITE_TAC[REAL_ADD]
2369QED
2370
2371Theorem REAL_ARCH_LEAST:
2372 !y. 0 < y
2373 ==> !x. 0 <= x
2374 ==> ?n. (&n * y) <= x
2375 /\ x < (&(SUC n) * y)
2376Proof
2377 GEN_TAC THEN DISCH_THEN(ASSUME_TAC o MATCH_MP REAL_ARCH) THEN
2378 GEN_TAC THEN POP_ASSUM(ASSUME_TAC o SPEC “x:real”) THEN
2379 POP_ASSUM(X_CHOOSE_THEN “n:num” MP_TAC o CONV_RULE EXISTS_LEAST_CONV)
2380 THEN
2381 REWRITE_TAC[REAL_NOT_LT] THEN
2382 DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (ASSUME_TAC o SPEC “PRE n”)) THEN
2383 DISCH_TAC THEN EXISTS_TAC “PRE n” THEN
2384 SUBGOAL_THEN “SUC(PRE n) = n” ASSUME_TAC THENL
2385 [DISJ_CASES_THEN2 SUBST_ALL_TAC (CHOOSE_THEN SUBST_ALL_TAC)
2386 (SPEC “n:num” num_CASES) THENL
2387 [UNDISCH_TAC “x < 0 * y” THEN
2388 ASM_REWRITE_TAC[REAL_MUL_LZERO, GSYM REAL_NOT_LE],
2389 REWRITE_TAC[PRE]],
2390 ASM_REWRITE_TAC[] THEN FIRST_ASSUM MATCH_MP_TAC THEN
2391 FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[PRE, LESS_SUC_REFL]]
2392QED
2393
2394Theorem REAL_BIGNUM :
2395 !(r :real). ?(n :num). r < &n
2396Proof
2397 GEN_TAC
2398 THEN MP_TAC (Q.SPEC `1` REAL_ARCH)
2399 THEN REWRITE_TAC [REAL_LT_01, REAL_MUL_RID]
2400 THEN PROVE_TAC []
2401QED
2402
2403Theorem SIMP_REAL_ARCH :
2404 !(x:real). ?n. x <= &n
2405Proof
2406 Q.X_GEN_TAC ‘x’
2407 >> STRIP_ASSUME_TAC (Q.SPEC ‘x’ REAL_BIGNUM)
2408 >> Q.EXISTS_TAC ‘n’
2409 >> MATCH_MP_TAC REAL_LT_IMP_LE >> art []
2410QED
2411
2412Theorem REAL_ARCH_INV :
2413 !e. &0 < e <=> ?n. ~(n = 0) /\ &0:real < inv(&n) /\ inv(&n) < e:real
2414Proof
2415 GEN_TAC THEN EQ_TAC THENL [ALL_TAC, MESON_TAC[REAL_LT_TRANS]] THEN
2416 DISCH_TAC THEN MP_TAC(SPEC ``inv(e:real)`` REAL_BIGNUM) THEN
2417 STRIP_TAC THEN EXISTS_TAC ``n:num`` THEN
2418 ASM_MESON_TAC[REAL_LT_INV, REAL_INV_INV, REAL_LT_INV_EQ, REAL_LT_TRANS,
2419 REAL_LT_ANTISYM]
2420QED
2421
2422(*---------------------------------------------------------------------------*)
2423(* Now define finite sums; NB: sum(m,n) f = f(m) + f(m+1) + ... + f(m+n-1) *)
2424(*---------------------------------------------------------------------------*)
2425
2426Definition sum:
2427 (sum (n,0) f = 0) /\
2428 (sum (n,SUC m) f = sum (n,m) f + f (n + m): real)
2429End
2430
2431(*---------------------------------------------------------------------------*)
2432(* Useful manipulative theorems for sums *)
2433(*---------------------------------------------------------------------------*)
2434
2435Theorem SUM_TWO:
2436 !f n p. sum(0,n) f + sum(n,p) f = sum(0,n + p) f
2437Proof
2438 GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN
2439 REWRITE_TAC[sum, REAL_ADD_RID, ADD_CLAUSES] THEN
2440 ASM_REWRITE_TAC[REAL_ADD_ASSOC]
2441QED
2442
2443Theorem SUM_DIFF:
2444 !f m n. sum(m,n) f = sum(0,m + n) f - sum(0,m) f
2445Proof
2446 REPEAT GEN_TAC THEN REWRITE_TAC[REAL_EQ_SUB_LADD] THEN
2447 ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN MATCH_ACCEPT_TAC SUM_TWO
2448QED
2449
2450Theorem ABS_SUM:
2451 !f m n. abs(sum(m,n) f) <= sum(m,n) (\n. abs(f n))
2452Proof
2453 GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN
2454 REWRITE_TAC[sum, ABS_0, REAL_LE_REFL] THEN BETA_TAC THEN
2455 MATCH_MP_TAC REAL_LE_TRANS THEN
2456 EXISTS_TAC “abs(sum(m,n) f) + abs(f(m + n))” THEN
2457 ASM_REWRITE_TAC[ABS_TRIANGLE, REAL_LE_RADD]
2458QED
2459
2460Theorem SUM_LE:
2461 !f g m n. (!r. m <= r /\ r < (n + m) ==> f(r) <= g(r))
2462 ==> (sum(m,n) f <= sum(m,n) g)
2463Proof
2464 EVERY [GEN_TAC, GEN_TAC, GEN_TAC] THEN
2465 INDUCT_TAC THEN REWRITE_TAC[sum, REAL_LE_REFL] THEN
2466 DISCH_TAC THEN MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THEN
2467 FIRST_ASSUM MATCH_MP_TAC THENL
2468 [GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN
2469 ASM_REWRITE_TAC[ADD_CLAUSES] THEN
2470 MATCH_MP_TAC LESS_TRANS THEN EXISTS_TAC “n + m:num”,
2471 GEN_REWR_TAC (RAND_CONV o RAND_CONV) [ADD_SYM]] THEN
2472 ASM_REWRITE_TAC[ADD_CLAUSES, LESS_EQ_ADD, LESS_SUC_REFL]
2473QED
2474
2475(* moved here from seqTheory *)
2476Theorem SUM_LT :
2477 !f g m n.
2478 (!r. m <= r /\ r < n + m ==> f r < g r) /\ 0 < n ==>
2479 sum (m,n) f < sum (m,n) g
2480Proof
2481 RW_TAC std_ss []
2482 >> POP_ASSUM MP_TAC
2483 >> Cases_on `n` >- RW_TAC arith_ss []
2484 >> RW_TAC arith_ss []
2485 >> Induct_on `n'` >- RW_TAC arith_ss [sum, REAL_ADD_LID]
2486 >> ONCE_REWRITE_TAC [sum]
2487 >> RW_TAC std_ss []
2488 >> MATCH_MP_TAC REAL_LT_ADD2
2489 >> CONJ_TAC
2490 >- (Q.PAT_X_ASSUM `a ==> b` MATCH_MP_TAC >> RW_TAC arith_ss [])
2491 >> RW_TAC arith_ss []
2492QED
2493
2494(* moved here from seqTheory *)
2495Theorem SUM_PICK :
2496 !n k x. sum (0, n) (\m. if m = k then x else 0) = if k < n then x else 0
2497Proof
2498 Induct >- RW_TAC arith_ss [sum]
2499 >> RW_TAC arith_ss [sum, REAL_ADD_RID, REAL_ADD_LID]
2500 >> Suff `F` >- PROVE_TAC []
2501 >> NTAC 2 (POP_ASSUM MP_TAC)
2502 >> DECIDE_TAC
2503QED
2504
2505Theorem SUM_EQ:
2506 !f g m n. (!r. m <= r /\ r < (n + m) ==> (f(r) = g(r)))
2507 ==> (sum(m,n) f = sum(m,n) g)
2508Proof
2509 REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN
2510 CONJ_TAC THEN MATCH_MP_TAC SUM_LE THEN GEN_TAC THEN
2511 DISCH_THEN(fn th => MATCH_MP_TAC REAL_EQ_IMP_LE THEN
2512 FIRST_ASSUM(SUBST1_TAC o C MATCH_MP th)) THEN REFL_TAC
2513QED
2514
2515Theorem SUM_POS:
2516 !f. (!n. 0 <= f(n)) ==> !m n. 0 <= sum(m,n) f
2517Proof
2518 GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN INDUCT_TAC THEN
2519 REWRITE_TAC[sum, REAL_LE_REFL] THEN
2520 MATCH_MP_TAC REAL_LE_ADD THEN ASM_REWRITE_TAC[]
2521QED
2522
2523Theorem SUM_POS_GEN:
2524 !f m. (!n. m <= n ==> 0 <= f(n)) ==>
2525 !n. 0 <= sum(m,n) f
2526Proof
2527 REPEAT GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN
2528 REWRITE_TAC[sum, REAL_LE_REFL] THEN
2529 MATCH_MP_TAC REAL_LE_ADD THEN
2530 ASM_REWRITE_TAC[] THEN FIRST_ASSUM MATCH_MP_TAC THEN
2531 MATCH_ACCEPT_TAC LESS_EQ_ADD
2532QED
2533
2534Theorem SUM_ABS:
2535 !f m n. abs(sum(m,n) (\m. abs(f m))) = sum(m,n) (\m. abs(f m))
2536Proof
2537 GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[ABS_REFL] THEN
2538 GEN_TAC THEN MATCH_MP_TAC SUM_POS THEN BETA_TAC THEN
2539 REWRITE_TAC[ABS_POS]
2540QED
2541
2542Theorem SUM_ABS_LE:
2543 !f m n. abs(sum(m,n) f) <= sum(m,n)(\n. abs(f n))
2544Proof
2545 GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN
2546 REWRITE_TAC[sum, ABS_0, REAL_LE_REFL] THEN
2547 MATCH_MP_TAC REAL_LE_TRANS THEN
2548 EXISTS_TAC “abs(sum(m,n) f) + abs(f(m + n))” THEN
2549 REWRITE_TAC[ABS_TRIANGLE] THEN BETA_TAC THEN
2550 ASM_REWRITE_TAC[REAL_LE_RADD]
2551QED
2552
2553Theorem SUM_ZERO:
2554 !f N. (!n. n >= N ==> (f(n) = 0))
2555 ==>
2556 (!m n. m >= N ==> (sum(m,n) f = 0))
2557Proof
2558 REPEAT GEN_TAC THEN DISCH_TAC THEN
2559 MAP_EVERY X_GEN_TAC [“m:num”, “n:num”] THEN
2560 REWRITE_TAC[GREATER_EQ] THEN
2561 DISCH_THEN(X_CHOOSE_THEN “d:num” SUBST1_TAC o MATCH_MP LESS_EQUAL_ADD)
2562 THEN
2563 SPEC_TAC(“n:num”,“n:num”) THEN INDUCT_TAC THEN REWRITE_TAC[sum]
2564 THEN
2565 ASM_REWRITE_TAC[REAL_ADD_LID] THEN FIRST_ASSUM MATCH_MP_TAC THEN
2566 REWRITE_TAC[GREATER_EQ, GSYM ADD_ASSOC, LESS_EQ_ADD]
2567QED
2568
2569Theorem SUM_ADD:
2570 !f g m n.
2571 sum(m,n) (\n. f(n) + g(n))
2572 =
2573 sum(m,n) f + sum(m,n) g
2574Proof
2575 EVERY [GEN_TAC, GEN_TAC, GEN_TAC] THEN INDUCT_TAC THEN
2576 ASM_REWRITE_TAC[sum, REAL_ADD_LID] THEN BETA_TAC THEN
2577 CONV_TAC(AC_CONV(REAL_ADD_ASSOC,REAL_ADD_SYM))
2578QED
2579
2580Theorem SUM_CMUL:
2581 !f c m n. sum(m,n) (\n. c * f(n)) = c * sum(m,n) f
2582Proof
2583 EVERY [GEN_TAC, GEN_TAC, GEN_TAC] THEN INDUCT_TAC THEN
2584 ASM_REWRITE_TAC[sum, REAL_MUL_RZERO] THEN BETA_TAC THEN
2585 REWRITE_TAC[REAL_LDISTRIB]
2586QED
2587
2588Theorem SUM_NEG:
2589 !f n d. sum(n,d) (\n. ~(f n)) = ~(sum(n,d) f)
2590Proof
2591 GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN
2592 ASM_REWRITE_TAC[sum, REAL_NEG_0] THEN
2593 BETA_TAC THEN REWRITE_TAC[REAL_NEG_ADD]
2594QED
2595
2596Theorem SUM_SUB:
2597 !f g m n.
2598 sum(m,n)(\n. (f n) - (g n))
2599 = sum(m,n) f - sum(m,n) g
2600Proof
2601 REPEAT GEN_TAC THEN REWRITE_TAC[real_sub, GSYM SUM_NEG, GSYM SUM_ADD] THEN
2602 BETA_TAC THEN REFL_TAC
2603QED
2604
2605Theorem SUM_SUBST:
2606 !f g m n. (!p. m <= p /\ p < (m + n) ==> (f p = g p))
2607 ==> (sum(m,n) f = sum(m,n) g)
2608Proof
2609 EVERY [GEN_TAC, GEN_TAC, GEN_TAC] THEN INDUCT_TAC THEN REWRITE_TAC[sum] THEN
2610 ASM_REWRITE_TAC[] THEN DISCH_TAC THEN BINOP_TAC THEN
2611 FIRST_ASSUM MATCH_MP_TAC THENL
2612 [GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN
2613 ASM_REWRITE_TAC[ADD_CLAUSES] THEN
2614 MATCH_MP_TAC LESS_EQ_IMP_LESS_SUC THEN
2615 MATCH_MP_TAC LESS_IMP_LESS_OR_EQ THEN ASM_REWRITE_TAC[],
2616 REWRITE_TAC[LESS_EQ_ADD] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN
2617 MATCH_MP_TAC LESS_MONO_ADD THEN REWRITE_TAC[LESS_SUC_REFL]]
2618QED
2619
2620Theorem SUM_NSUB:
2621 !n f c.
2622 sum(0,n) f - (&n * c)
2623 =
2624 sum(0,n)(\p. f(p) - c)
2625Proof
2626 INDUCT_TAC THEN REWRITE_TAC[sum, REAL_MUL_LZERO, REAL_SUB_REFL] THEN
2627 REWRITE_TAC[ADD_CLAUSES, REAL, REAL_RDISTRIB] THEN BETA_TAC THEN
2628 REPEAT GEN_TAC THEN POP_ASSUM(fn th => REWRITE_TAC[GSYM th]) THEN
2629 REWRITE_TAC[real_sub, REAL_NEG_ADD, REAL_MUL_LID] THEN
2630 CONV_TAC(AC_CONV(REAL_ADD_ASSOC,REAL_ADD_SYM))
2631QED
2632
2633Theorem SUM_BOUND:
2634 !f k m n. (!p. m <= p /\ p < (m + n) ==> (f(p) <= k))
2635 ==> (sum(m,n) f <= (&n * k))
2636Proof
2637 EVERY [GEN_TAC, GEN_TAC, GEN_TAC] THEN INDUCT_TAC THEN
2638 REWRITE_TAC[sum, REAL_MUL_LZERO, REAL_LE_REFL] THEN
2639 DISCH_TAC THEN REWRITE_TAC[REAL, REAL_RDISTRIB] THEN
2640 MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL
2641 [FIRST_ASSUM MATCH_MP_TAC THEN GEN_TAC THEN DISCH_TAC THEN
2642 FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
2643 FIRST_ASSUM(MP_TAC o CONJUNCT2) THEN REWRITE_TAC[ADD_CLAUSES] THEN
2644 MATCH_ACCEPT_TAC LESS_SUC,
2645 REWRITE_TAC[REAL_MUL_LID] THEN FIRST_ASSUM MATCH_MP_TAC THEN
2646 REWRITE_TAC[ADD_CLAUSES, LESS_EQ_ADD] THEN
2647 MATCH_ACCEPT_TAC LESS_SUC_REFL]
2648QED
2649
2650Theorem SUM_GROUP:
2651 !n k f. sum(0,n)(\m. sum(m * k,k) f) = sum(0,n * k) f
2652Proof
2653 INDUCT_TAC THEN REWRITE_TAC[sum, MULT_CLAUSES] THEN
2654 REPEAT GEN_TAC THEN BETA_TAC THEN ASM_REWRITE_TAC[] THEN
2655 REWRITE_TAC[ADD_CLAUSES, SUM_TWO]
2656QED
2657
2658Theorem SUM_1:
2659 !f n. sum(n,1) f = f(n)
2660Proof
2661 REPEAT GEN_TAC THEN
2662 REWRITE_TAC[num_CONV “1:num”, sum, ADD_CLAUSES, REAL_ADD_LID]
2663QED
2664
2665Theorem SUM_2:
2666 !f n. sum(n,2) f = f(n) + f(n + 1)
2667Proof
2668 REPEAT GEN_TAC THEN CONV_TAC(REDEPTH_CONV num_CONV) THEN
2669 REWRITE_TAC[sum, ADD_CLAUSES, REAL_ADD_LID]
2670QED
2671
2672Theorem SUM_OFFSET:
2673 !f n k.
2674 sum(0,n)(\m. f(m + k))
2675 = sum(0,n + k) f - sum(0,k) f
2676Proof
2677 REPEAT GEN_TAC THEN
2678 GEN_REWR_TAC (RAND_CONV o ONCE_DEPTH_CONV) [ADD_SYM] THEN
2679 REWRITE_TAC[GSYM SUM_TWO, REAL_ADD_SUB] THEN
2680 SPEC_TAC(“n:num”,“n:num”) THEN
2681 INDUCT_TAC THEN REWRITE_TAC[sum] THEN
2682 BETA_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES] THEN AP_TERM_TAC THEN
2683 AP_TERM_TAC THEN MATCH_ACCEPT_TAC ADD_SYM
2684QED
2685
2686Theorem SUM_REINDEX:
2687 !f m k n. sum(m + k,n) f = sum(m,n)(\r. f(r + k))
2688Proof
2689 EVERY [GEN_TAC, GEN_TAC, GEN_TAC] THEN INDUCT_TAC THEN REWRITE_TAC[sum] THEN
2690 ASM_REWRITE_TAC[REAL_EQ_LADD] THEN BETA_TAC THEN AP_TERM_TAC THEN
2691 CONV_TAC(AC_CONV(ADD_ASSOC,ADD_SYM))
2692QED
2693
2694Theorem SUM_0:
2695 !m n. sum(m,n)(\r. 0) = 0
2696Proof
2697 GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[sum] THEN
2698 BETA_TAC THEN ASM_REWRITE_TAC[REAL_ADD_LID]
2699QED
2700
2701(* moved here from integralTheory *)
2702Theorem SUM_EQ_0:
2703 (!r. m <= r /\ r < m + n ==> (f(r) = &0)) ==> (sum(m,n) f = &0)
2704Proof
2705 REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN
2706 EXISTS_TAC ``sum(m,n) (\r. &0)`` THEN
2707 CONJ_TAC THENL [ALL_TAC, REWRITE_TAC[SUM_0]] THEN
2708 MATCH_MP_TAC SUM_EQ THEN ASM_REWRITE_TAC[] THEN
2709 ONCE_REWRITE_TAC[ADD_SYM] THEN ASM_REWRITE_TAC[]
2710QED
2711
2712Theorem SUM_PERMUTE_0:
2713 !n p. (!y. y < n ==> ?!x. x < n /\ (p(x) = y))
2714 ==> !f. sum(0,n)(\n. f(p n)) = sum(0,n) f
2715Proof
2716 INDUCT_TAC THEN GEN_TAC THEN TRY(REWRITE_TAC[sum] THEN NO_TAC) THEN
2717 DISCH_TAC THEN GEN_TAC THEN FIRST_ASSUM(MP_TAC o SPEC “n:num”) THEN
2718 REWRITE_TAC[LESS_SUC_REFL] THEN
2719 CONV_TAC(ONCE_DEPTH_CONV EXISTS_UNIQUE_CONV) THEN
2720 DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
2721 DISCH_THEN(X_CHOOSE_THEN “k:num” STRIP_ASSUME_TAC) THEN
2722 GEN_REWR_TAC RAND_CONV [sum] THEN
2723 REWRITE_TAC[ADD_CLAUSES] THEN
2724 ABBREV_TAC “q:num->num = \r. if r < k then p(r) else p(SUC r)” THEN
2725 SUBGOAL_THEN “!y:num. y < n ==> ?!x. x < n /\ (q x = y)” MP_TAC
2726 THENL
2727 [X_GEN_TAC “y:num” THEN DISCH_TAC THEN
2728 (MP_TAC o ASSUME) “!y. y<SUC n ==> ?!x. x<SUC n /\ (p x = y)” THEN
2729 DISCH_THEN(MP_TAC o SPEC “y:num”) THEN
2730 W(C SUBGOAL_THEN MP_TAC o funpow 2 (fst o dest_imp) o snd) THENL
2731 [MATCH_MP_TAC LESS_TRANS THEN EXISTS_TAC “n:num” THEN
2732 ASM_REWRITE_TAC[LESS_SUC_REFL],
2733 DISCH_THEN(fn th => DISCH_THEN(MP_TAC o C MP th))] THEN
2734 CONV_TAC(ONCE_DEPTH_CONV EXISTS_UNIQUE_CONV) THEN
2735 DISCH_THEN(X_CHOOSE_THEN “x:num” STRIP_ASSUME_TAC o CONJUNCT1) THEN
2736 CONJ_TAC THENL
2737 [DISJ_CASES_TAC(SPECL [“x:num”, “k:num”] LESS_CASES) THENL
2738 [EXISTS_TAC “x:num” THEN EXPAND_TAC "q" THEN BETA_TAC THEN
2739 ASM_REWRITE_TAC[] THEN
2740 REWRITE_TAC[GSYM REAL_LT] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN
2741 EXISTS_TAC “&k” THEN ASM_REWRITE_TAC[REAL_LE, REAL_LT] THEN
2742 UNDISCH_TAC “k < SUC n” THEN
2743 REWRITE_TAC[LESS_EQ, LESS_EQ_MONO],
2744 MP_TAC(ASSUME “k <= x:num”) THEN REWRITE_TAC[LESS_OR_EQ] THEN
2745 DISCH_THEN(DISJ_CASES_THEN2 ASSUME_TAC SUBST_ALL_TAC) THENL
2746 [EXISTS_TAC “x - 1:num” THEN EXPAND_TAC "q" THEN BETA_TAC THEN
2747 UNDISCH_TAC “k < x:num” THEN
2748 DISCH_THEN(X_CHOOSE_THEN “d:num” MP_TAC o MATCH_MP LESS_ADD_1)
2749 THEN
2750 REWRITE_TAC[GSYM ADD1, ADD_CLAUSES] THEN
2751 DISCH_THEN SUBST_ALL_TAC THEN REWRITE_TAC[SUC_SUB1] THEN
2752 RULE_ASSUM_TAC(REWRITE_RULE[LESS_MONO_EQ]) THEN
2753 ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN REWRITE_TAC[] THEN
2754 UNDISCH_TAC “(k + d) < k:num” THEN
2755 REWRITE_TAC[LESS_EQ] THEN CONV_TAC CONTRAPOS_CONV THEN
2756 REWRITE_TAC[GSYM NOT_LESS, REWRITE_RULE[ADD_CLAUSES] LESS_ADD_SUC],
2757 SUBST_ALL_TAC(ASSUME “(p:num->num) x = n”) THEN
2758 UNDISCH_TAC “y < n:num” THEN ASM_REWRITE_TAC[LESS_REFL]]],
2759 SUBGOAL_THEN
2760 “!z. q z :num = p(if z < k then z else SUC z)” MP_TAC THENL
2761 [GEN_TAC THEN EXPAND_TAC "q" THEN BETA_TAC THEN COND_CASES_TAC THEN
2762 REWRITE_TAC[],
2763 DISCH_THEN(fn th => REWRITE_TAC[th])] THEN
2764 MAP_EVERY X_GEN_TAC [“x1:num”, “x2:num”] THEN STRIP_TAC THEN
2765 UNDISCH_TAC “!y. y < SUC n ==> ?!x. x < SUC n /\ (p x = y)” THEN
2766 DISCH_THEN(MP_TAC o SPEC “y:num”) THEN
2767 REWRITE_TAC[MATCH_MP LESS_SUC (ASSUME “y < n:num”)] THEN
2768 CONV_TAC(ONCE_DEPTH_CONV EXISTS_UNIQUE_CONV) THEN
2769 DISCH_THEN(MP_TAC
2770 o SPECL [“if x1 < (k:num) then x1 else SUC x1”,
2771 “if x2 < (k:num) then x2 else SUC x2”]
2772 o CONJUNCT2) THEN
2773 ASM_REWRITE_TAC[] THEN
2774 W(C SUBGOAL_THEN MP_TAC o funpow 2 (fst o dest_imp) o snd) THENL
2775 [CONJ_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[LESS_MONO_EQ] THEN
2776 MATCH_MP_TAC LESS_SUC THEN ASM_REWRITE_TAC[],
2777 DISCH_THEN(fn th => DISCH_THEN(MP_TAC o C MATCH_MP th)) THEN
2778 REPEAT COND_CASES_TAC THEN REWRITE_TAC[INV_SUC_EQ] THENL
2779 [DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC “~(x2 < k:num)” THEN
2780 CONV_TAC CONTRAPOS_CONV THEN DISCH_THEN(K ALL_TAC) THEN
2781 REWRITE_TAC[] THEN MATCH_MP_TAC LESS_TRANS THEN
2782 EXISTS_TAC “SUC x2” THEN ASM_REWRITE_TAC[LESS_SUC_REFL],
2783 DISCH_THEN(SUBST_ALL_TAC o SYM) THEN
2784 UNDISCH_TAC “~(x1 < k:num)” THEN
2785 CONV_TAC CONTRAPOS_CONV THEN DISCH_THEN(K ALL_TAC) THEN
2786 REWRITE_TAC[] THEN MATCH_MP_TAC LESS_TRANS THEN
2787 EXISTS_TAC “SUC x1” THEN ASM_REWRITE_TAC[LESS_SUC_REFL]]]],
2788 DISCH_THEN(fn th => FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN
2789 DISCH_THEN(fn th => GEN_REWR_TAC(RAND_CONV o ONCE_DEPTH_CONV)[GSYM th])THEN
2790 BETA_TAC THEN UNDISCH_TAC “k < SUC n” THEN
2791 REWRITE_TAC[LESS_EQ, LESS_EQ_MONO] THEN
2792 DISCH_THEN(X_CHOOSE_TAC “d:num” o MATCH_MP LESS_EQUAL_ADD) THEN
2793 GEN_REWR_TAC (RAND_CONV o RATOR_CONV o ONCE_DEPTH_CONV)
2794 [ASSUME “n = k + d:num”] THEN
2795 REWRITE_TAC[GSYM SUM_TWO] THEN
2796 GEN_REWR_TAC (RATOR_CONV o ONCE_DEPTH_CONV)
2797 [ASSUME “n = k + d:num”] THEN
2798 REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] ADD_SUC] THEN
2799 REWRITE_TAC[GSYM SUM_TWO, sum, ADD_CLAUSES] THEN BETA_TAC THEN
2800 REWRITE_TAC[GSYM REAL_ADD_ASSOC] THEN BINOP_TAC THENL
2801 [MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC “r:num” THEN
2802 REWRITE_TAC[ADD_CLAUSES] THEN STRIP_TAC THEN
2803 BETA_TAC THEN EXPAND_TAC "q" THEN ASM_REWRITE_TAC[],
2804 GEN_REWR_TAC RAND_CONV [REAL_ADD_SYM] THEN
2805 REWRITE_TAC[ASSUME “(p:num->num) k = n”, REAL_EQ_LADD] THEN
2806 REWRITE_TAC[ADD1, SUM_REINDEX] THEN BETA_TAC THEN
2807 MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC “r:num” THEN BETA_TAC THEN
2808 REWRITE_TAC[GSYM NOT_LESS] THEN DISCH_TAC THEN
2809 EXPAND_TAC "q" THEN BETA_TAC THEN ASM_REWRITE_TAC[ADD1]]]
2810QED
2811
2812Theorem SUM_CANCEL:
2813 !f n d.
2814 sum(n,d) (\n. f(SUC n) - f(n))
2815 = f(n + d) - f(n)
2816Proof
2817 GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN
2818 ASM_REWRITE_TAC[sum, ADD_CLAUSES, REAL_SUB_REFL] THEN
2819 BETA_TAC THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
2820 REWRITE_TAC[real_sub, REAL_NEG_ADD, REAL_ADD_ASSOC] THEN
2821 AP_THM_TAC THEN AP_TERM_TAC THEN
2822 REWRITE_TAC[GSYM REAL_ADD_ASSOC, REAL_ADD_LINV, REAL_ADD_RID]
2823QED
2824
2825(* moved here from integralTheory, added missing quantifier ‘m’ *)
2826Theorem SUM_SPLIT :
2827 !f m n p. sum(m,n) f + sum(m + n,p) f = sum(m,n + p) f
2828Proof
2829 REPEAT GEN_TAC THEN
2830 GEN_REWRITE_TAC(LAND_CONV o LAND_CONV) empty_rewrites [SUM_DIFF] THEN
2831 GEN_REWRITE_TAC(LAND_CONV o RAND_CONV) empty_rewrites [SUM_DIFF] THEN
2832 CONV_TAC SYM_CONV THEN
2833 GEN_REWRITE_TAC LAND_CONV empty_rewrites [SUM_DIFF] THEN
2834 RW_TAC arith_ss[] THEN
2835 SUBGOAL_THEN “!a b c. b-a + (c-b)=c-a”
2836 (fn th => ONCE_REWRITE_TAC[GEN_ALL th])
2837 >| [ REWRITE_TAC [Once REAL_ADD_COMM, REAL_SUB_TRIANGLE],
2838 REWRITE_TAC[] ]
2839QED
2840
2841(* moved here from integralTheory, added missing quantifier ‘d’ *)
2842Theorem SUM_DIFFS :
2843 !d m n. sum(m,n) (\i. d(SUC i) - d(i)) = d(m + n) - d m
2844Proof
2845 NTAC 2 GEN_TAC THEN INDUCT_TAC THEN
2846 ASM_REWRITE_TAC[sum, ADD_CLAUSES, REAL_SUB_REFL] THEN REWRITE_TAC[sum] THEN
2847 RW_TAC arith_ss[ETA_AX] THEN ASM_REWRITE_TAC[ADD_CLAUSES] THEN
2848 SUBGOAL_THEN“!a b c d. a-b+(c-a) = -b+a+(c-a)”
2849 (fn th => ONCE_REWRITE_TAC[GEN_ALL th]) THENL
2850 [REPEAT GEN_TAC THEN REWRITE_TAC[real_sub] THEN
2851 ASM_SIMP_TAC arith_ss[GSYM REAL_ADD_SYM],
2852 SUBGOAL_THEN“!a b c d. a+b+(c-b) = a+c”
2853 (fn th => ONCE_REWRITE_TAC[GEN_ALL th]) THENL
2854 [REPEAT GEN_TAC THEN REWRITE_TAC[GSYM REAL_ADD_ASSOC] THEN
2855 REWRITE_TAC[REAL_EQ_LADD] THEN
2856 REWRITE_TAC[REAL_SUB_ADD2], REWRITE_TAC[real_sub] THEN
2857 GEN_REWR_TAC LAND_CONV [REAL_ADD_COMM] THEN PROVE_TAC[]]]
2858QED
2859
2860(* ------------------------------------------------------------------------- *)
2861(* Theorems to be compatible with hol-light. *)
2862(* ------------------------------------------------------------------------- *)
2863
2864(* |- !x y. x * -y = -(x * y) *)
2865Theorem REAL_MUL_RNEG = REAL_MUL_RNEG;
2866
2867(* |- !x y. -x * y = -(x * y) *)
2868Theorem REAL_MUL_LNEG = REAL_MUL_LNEG;
2869
2870Theorem REAL_DIV_RNEG :
2871 !x y. x / -y = -(x / y)
2872Proof
2873 simp [real_div, REAL_INV_NEG, REAL_MUL_RNEG]
2874QED
2875
2876Theorem REAL_DIV_LNEG :
2877 !x y. -x / y = -(x / y)
2878Proof
2879 simp [real_div, REAL_INV_NEG, REAL_MUL_LNEG]
2880QED
2881
2882Theorem REAL_LE_LMUL_NEG:
2883 !x y z. x < 0 ==> (x * y <= x * z <=> z <= y)
2884Proof
2885 rpt strip_tac >>
2886 ‘0 < -x’ by simp[] >>
2887 Cases_on ‘z <= y’
2888 >- (‘-x * z <= -x * y’ by simp[REAL_LE_LMUL] >>
2889 fs[REAL_LE_NEG, REAL_MUL_LNEG]) >>
2890 fs[REAL_NOT_LE] >>
2891 ‘-x * y < -x * z’ by simp[REAL_LT_LMUL] >>
2892 fs[REAL_LT_NEG, REAL_MUL_LNEG] >>
2893 metis_tac[REAL_LET_ANTISYM]
2894QED
2895
2896Theorem REAL_LT_LMUL_NEG:
2897 !x y z. x < 0 ==> (x * y < x * z <=> z < y)
2898Proof
2899 rpt strip_tac >>
2900 ‘0 < -x’ by simp[] >>
2901 Cases_on ‘z < y’
2902 >- (‘-x * z < -x * y’ by simp[REAL_LT_LMUL] >>
2903 fs[REAL_LT_NEG, REAL_MUL_LNEG]) >>
2904 ‘y <= z’ by fs[REAL_NOT_LT] >>
2905 ‘-x * y <= -x * z’ by simp[REAL_LE_LMUL] >>
2906 fs[REAL_LE_NEG, REAL_MUL_LNEG] >> metis_tac[REAL_LET_ANTISYM]
2907QED
2908
2909(* |- !y x. x < y <=> ~(y <= x)
2910
2911 NOTE: the order of quantifiers is first ‘y’ then ‘x’. Don't "fix".
2912 *)
2913Theorem real_lt = real_lt;
2914
2915(* |- !x y z. y <= z ==> x + y <= x + z *)
2916Theorem REAL_LE_LADD_IMP = REAL_LE_LADD_IMP;
2917
2918(* |- !x y. -x <= y <=> 0 <= x + y *)
2919Theorem REAL_LE_LNEG = REAL_LE_LNEG
2920
2921(* |- !x y. -x <= -y <=> y <= x *)
2922Theorem REAL_LE_NEG2 = REAL_LE_NEG2
2923
2924(* |- !x. --x = x *)
2925Theorem REAL_NEG_NEG = REAL_NEG_NEG
2926
2927Theorem SIMP_REAL_ARCH_NEG:
2928 !x:real. ?n. - &n <= x
2929Proof
2930 RW_TAC std_ss []
2931 >> `?n. -x <= &n` by PROVE_TAC [SIMP_REAL_ARCH]
2932 >> Q.EXISTS_TAC `n`
2933 >> PROVE_TAC [REAL_LE_NEG, REAL_NEG_NEG]
2934QED
2935
2936(* |- !x y. x <= -y <=> x + y <= 0 *)
2937Theorem REAL_LE_RNEG = REAL_LE_RNEG;
2938
2939Theorem REAL_LT_RNEG:
2940 !x y. x < -y <=> x + y < &0:real
2941Proof
2942 SIMP_TAC std_ss [real_lt, REAL_LE_LNEG, REAL_ADD_ASSOC, REAL_ADD_SYM]
2943QED
2944
2945Theorem REAL_LE_RDIV_EQ:
2946 !x y z. &0 < z ==> (x <= y / z <=> x * z <= y)
2947Proof
2948 REPEAT STRIP_TAC THEN
2949 FIRST_ASSUM(fn th =>
2950 GEN_REWRITE_TAC LAND_CONV empty_rewrites
2951 [GSYM(MATCH_MP REAL_LE_RMUL th)]) THEN
2952 RW_TAC bool_ss [real_div, GSYM REAL_MUL_ASSOC, REAL_MUL_LINV,
2953 REAL_MUL_RID, REAL_POS_NZ]
2954QED
2955
2956Theorem REAL_LE_LDIV_EQ:
2957 !x y z. &0 < z ==> (x / z <= y <=> x <= y * z)
2958Proof
2959 REPEAT STRIP_TAC THEN
2960 FIRST_ASSUM(fn th =>
2961 GEN_REWRITE_TAC LAND_CONV empty_rewrites
2962 [GSYM(MATCH_MP REAL_LE_RMUL th)]) THEN
2963 RW_TAC bool_ss [real_div, GSYM REAL_MUL_ASSOC, REAL_MUL_LINV,
2964 REAL_MUL_RID, REAL_POS_NZ]
2965QED
2966
2967Theorem REAL_LT_RDIV_EQ:
2968 !x y z. &0 < z ==> (x < y / z <=> x * z < y)
2969Proof
2970 RW_TAC bool_ss [GSYM REAL_NOT_LE, REAL_LE_LDIV_EQ]
2971QED
2972
2973Theorem REAL_LT_LDIV_EQ:
2974 !x y z. &0 < z ==> (x / z < y <=> x < y * z)
2975Proof
2976 RW_TAC bool_ss [GSYM REAL_NOT_LE, REAL_LE_RDIV_EQ]
2977QED
2978
2979Theorem REAL_EQ_RDIV_EQ:
2980 !x y z. &0 < z ==> ((x = y / z) <=> (x * z = y))
2981Proof
2982 REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN
2983 RW_TAC bool_ss [REAL_LE_RDIV_EQ, REAL_LE_LDIV_EQ]
2984QED
2985
2986Theorem REAL_EQ_LDIV_EQ:
2987 !x y z. &0 < z ==> ((x / z = y) <=> (x = y * z))
2988Proof
2989 REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN
2990 RW_TAC bool_ss [REAL_LE_RDIV_EQ, REAL_LE_LDIV_EQ]
2991QED
2992
2993(* !x n. &x pow n = &(x ** n) *)
2994Theorem REAL_OF_NUM_POW = REAL_OF_NUM_POW;
2995
2996(* |- !z y x. x * (y + z) = x * y + x * z *)
2997Theorem REAL_ADD_LDISTRIB = REAL_LDISTRIB;
2998
2999(* |- !x y z. (x + y) * z = x * z + y * z *)
3000Theorem REAL_ADD_RDISTRIB = REAL_RDISTRIB;
3001
3002(* !m n. &m + &n = &(m + n) *)
3003Theorem REAL_OF_NUM_ADD = REAL_ADD;
3004
3005Theorem REAL_OF_NUM_SUB = realaxTheory.REAL_OF_NUM_SUB;
3006
3007(* |- !m n. &m <= &n <=> m <= n *)
3008Theorem REAL_OF_NUM_LE = REAL_LE;
3009Theorem REAL_OF_NUM_LT = REAL_LT;
3010
3011(* |- !m n. &m * &n = &(m * n) *)
3012Theorem REAL_OF_NUM_MUL = REAL_MUL;
3013
3014Theorem REAL_OF_NUM_SUC:
3015 !n. &n + &1 = &(SUC n)
3016Proof
3017 REWRITE_TAC[ADD1, REAL_ADD]
3018QED
3019
3020Theorem REAL_OF_NUM_EQ = REAL_INJ;
3021
3022Theorem REAL_EQ_MUL_LCANCEL:
3023 !x y z. (x * y = x * z) <=> (x = 0) \/ (y = z)
3024Proof
3025 REWRITE_TAC [REAL_EQ_LMUL]
3026QED
3027
3028Theorem REAL_ABS_0[simp] = ABS_0;
3029
3030Theorem REAL_ABS_TRIANGLE = ABS_TRIANGLE;
3031
3032Theorem REAL_ABS_MUL = ABS_MUL;
3033
3034Theorem REAL_ABS_POS = ABS_POS;
3035
3036Theorem REAL_LE_EPSILON:
3037 !x y : real. (!e. 0 < e ==> x <= y + e) ==> x <= y
3038Proof
3039 RW_TAC boolSimps.bool_ss []
3040 THEN (SUFF_TAC ``~(0r < x - y)``
3041 THEN1 RW_TAC boolSimps.bool_ss
3042 [REAL_NOT_LT, REAL_LE_SUB_RADD, REAL_ADD_LID])
3043 THEN STRIP_TAC
3044 THEN Q.PAT_X_ASSUM `!e. P e` MP_TAC
3045 THEN RW_TAC boolSimps.bool_ss []
3046 THEN (KNOW_TAC ``!a b c : real. ~(a <= b + c) <=> c < a - b``
3047 THEN1 (RW_TAC boolSimps.bool_ss [REAL_LT_SUB_LADD, REAL_NOT_LE]
3048 THEN PROVE_TAC [REAL_ADD_SYM]))
3049 THEN DISCH_THEN (fn th => ONCE_REWRITE_TAC [th])
3050 THEN PROVE_TAC [REAL_DOWN]
3051QED
3052
3053Theorem REAL_INV_LT_ANTIMONO:
3054 !x y : real. 0 < x /\ 0 < y ==> (inv x < inv y <=> y < x)
3055Proof
3056 RW_TAC boolSimps.bool_ss []
3057 THEN (REVERSE EQ_TAC THEN1 PROVE_TAC [REAL_LT_INV])
3058 THEN STRIP_TAC
3059 THEN ONCE_REWRITE_TAC [GSYM REAL_INV_INV]
3060 THEN MATCH_MP_TAC REAL_LT_INV
3061 THEN RW_TAC boolSimps.bool_ss [REAL_INV_POS]
3062QED
3063
3064Theorem REAL_INV_GT1 :
3065 !(x :real). 1 < x ==> inv x < 1
3066Proof
3067 rpt STRIP_TAC
3068 >> ONCE_REWRITE_TAC [SYM REAL_INV1]
3069 >> Suff ‘inv x < inv 1 <=> 1 < x’ >- RW_TAC std_ss []
3070 >> MATCH_MP_TAC REAL_INV_LT_ANTIMONO
3071 >> REWRITE_TAC [REAL_LT_01]
3072 >> Q_TAC (TRANS_TAC REAL_LT_TRANS) ‘1’ >> art [REAL_LT_01]
3073QED
3074
3075Theorem REAL_INV_INJ[simp]: !x y : real. (inv x = inv y) <=> (x = y)
3076Proof PROVE_TAC [REAL_INV_INV]
3077QED
3078
3079Theorem REAL_DIV_RMUL_CANCEL:
3080 !c a b : real. ~(c = 0) ==> ((a * c) / (b * c) = a / b)
3081Proof
3082 RW_TAC boolSimps.bool_ss [real_div]
3083 THEN Cases_on `b = 0`
3084 THEN RW_TAC boolSimps.bool_ss
3085 [REAL_MUL_LZERO, REAL_INV_0, REAL_INV_MUL, REAL_MUL_RZERO,
3086 REAL_EQ_MUL_LCANCEL, GSYM REAL_MUL_ASSOC]
3087 THEN DISJ2_TAC
3088 THEN (KNOW_TAC ``!a b c : real. a * (b * c) = (a * c) * b``
3089 THEN1 PROVE_TAC [REAL_MUL_ASSOC, REAL_MUL_SYM])
3090 THEN DISCH_THEN (fn th => ONCE_REWRITE_TAC [th])
3091 THEN RW_TAC boolSimps.bool_ss [REAL_MUL_RINV, REAL_MUL_LID]
3092QED
3093
3094Theorem REAL_DIV_LMUL_CANCEL:
3095 !c a b : real. ~(c = 0) ==> ((c * a) / (c * b) = a / b)
3096Proof
3097 METIS_TAC [REAL_DIV_RMUL_CANCEL, REAL_MUL_SYM]
3098QED
3099
3100Theorem REAL_DIV_ADD:
3101 !x y z : real. y / x + z / x = (y + z) / x
3102Proof
3103 RW_TAC boolSimps.bool_ss [real_div, REAL_ADD_RDISTRIB]
3104QED
3105
3106Theorem REAL_DIV_SUB :
3107 !x y z :real. y / x - z / x = (y - z) / x
3108Proof
3109 RW_TAC bool_ss [real_div, REAL_SUB_RDISTRIB]
3110QED
3111
3112Theorem REAL_ADD_RAT:
3113 !a b c d : real.
3114 ~(b = 0) /\ ~(d = 0) ==>
3115 (a / b + c / d = (a * d + b * c) / (b * d))
3116Proof
3117 RW_TAC boolSimps.bool_ss
3118 [GSYM REAL_DIV_ADD, REAL_DIV_RMUL_CANCEL, REAL_DIV_LMUL_CANCEL]
3119QED
3120
3121Theorem REAL_SUB_RAT:
3122 !a b c d : real.
3123 ~(b = 0) /\ ~(d = 0) ==>
3124 (a / b - c / d = (a * d - b * c) / (b * d))
3125Proof
3126 RW_TAC boolSimps.bool_ss [real_sub, real_div, REAL_NEG_LMUL]
3127 THEN RW_TAC boolSimps.bool_ss [GSYM real_div]
3128 THEN METIS_TAC [REAL_ADD_RAT, REAL_NEG_LMUL, REAL_NEG_RMUL]
3129QED
3130
3131Theorem REAL_SUB:
3132 !m n : num.
3133 (& m : real) - & n = if m - n = 0 then ~(& (n - m)) else & (m - n)
3134Proof
3135 RW_TAC old_arith_ss [REAL_EQ_SUB_RADD, REAL_ADD]
3136 THEN ONCE_REWRITE_TAC [REAL_ADD_SYM]
3137 THEN RW_TAC old_arith_ss [GSYM real_sub, REAL_EQ_SUB_LADD, REAL_ADD]
3138QED
3139
3140Theorem REAL_SUB_NUMERAL[simp] =
3141 REAL_SUB |> SPECL [“NUMERAL m”, “NUMERAL n”]
3142
3143(* ------------------------------------------------------------------------- *)
3144(* Define a constant for extracting "the positive part" of real numbers. *)
3145(* ------------------------------------------------------------------------- *)
3146
3147Definition pos_def: pos (x : real) = if 0 <= x then x else 0
3148End
3149
3150Theorem REAL_POS_POS:
3151 !x. 0 <= pos x
3152Proof
3153 RW_TAC boolSimps.bool_ss [pos_def, REAL_LE_REFL]
3154QED
3155
3156Theorem REAL_POS_ID:
3157 !x. 0 <= x ==> (pos x = x)
3158Proof
3159 RW_TAC boolSimps.bool_ss [pos_def]
3160QED
3161
3162Theorem REAL_POS_INFLATE:
3163 !x. x <= pos x
3164Proof
3165 RW_TAC boolSimps.bool_ss [pos_def, REAL_LE_REFL]
3166 THEN PROVE_TAC [REAL_LE_TOTAL]
3167QED
3168
3169Theorem REAL_POS_MONO:
3170 !x y. x <= y ==> pos x <= pos y
3171Proof
3172 RW_TAC boolSimps.bool_ss [pos_def, REAL_LE_REFL]
3173 THEN PROVE_TAC [REAL_LE_TOTAL, REAL_LE_TRANS]
3174QED
3175
3176Theorem REAL_POS_EQ_ZERO:
3177 !x. (pos x = 0) <=> x <= 0
3178Proof
3179 RW_TAC boolSimps.bool_ss [pos_def]
3180 THEN PROVE_TAC [REAL_LE_ANTISYM, REAL_LE_TOTAL]
3181QED
3182
3183Theorem REAL_POS_LE_ZERO:
3184 !x. (pos x <= 0) <=> x <= 0
3185Proof
3186 RW_TAC boolSimps.bool_ss [pos_def]
3187 THEN PROVE_TAC [REAL_LE_ANTISYM, REAL_LE_TOTAL]
3188QED
3189
3190(* ------------------------------------------------------------------------- *)
3191(* Define the minimum of two real numbers *)
3192(* ------------------------------------------------------------------------- *)
3193
3194Theorem min_def = real_min; (* moved to realaxTheory *)
3195
3196Theorem REAL_MIN_REFL:
3197 !x. min x x = x
3198Proof
3199 RW_TAC boolSimps.bool_ss [min_def]
3200QED
3201
3202Theorem REAL_LE_MIN:
3203 !z x y. z <= min x y <=> z <= x /\ z <= y
3204Proof
3205 RW_TAC boolSimps.bool_ss [min_def]
3206 THEN PROVE_TAC [REAL_LE_TRANS, REAL_LE_TOTAL]
3207QED
3208
3209Theorem REAL_MIN_LE:
3210 !z x y. min x y <= z <=> x <= z \/ y <= z
3211Proof
3212 RW_TAC boolSimps.bool_ss [min_def, REAL_LE_REFL]
3213 THEN PROVE_TAC [REAL_LE_TOTAL, REAL_LE_TRANS]
3214QED
3215
3216Theorem REAL_MIN_LE1:
3217 !x y. min x y <= x
3218Proof
3219 RW_TAC boolSimps.bool_ss [REAL_MIN_LE, REAL_LE_REFL]
3220QED
3221
3222Theorem REAL_MIN_LE2:
3223 !x y. min x y <= y
3224Proof
3225 RW_TAC boolSimps.bool_ss [REAL_MIN_LE, REAL_LE_REFL]
3226QED
3227
3228Theorem REAL_LT_MIN:
3229 !x y z. z < min x y <=> z < x /\ z < y
3230Proof
3231 RW_TAC boolSimps.bool_ss [min_def]
3232 THEN PROVE_TAC [REAL_LTE_TRANS, REAL_LT_TRANS, REAL_NOT_LE]
3233QED
3234
3235Theorem REAL_MIN_LT:
3236 !x y z:real. min x y < z <=> x < z \/ y < z
3237Proof
3238 RW_TAC boolSimps.bool_ss [min_def]
3239 THEN PROVE_TAC [REAL_LTE_TRANS, REAL_LT_TRANS, REAL_NOT_LE]
3240QED
3241
3242Theorem REAL_MIN_ALT:
3243 !x y. (x <= y ==> (min x y = x)) /\ (y <= x ==> (min x y = y))
3244Proof
3245 RW_TAC boolSimps.bool_ss [min_def]
3246 THEN PROVE_TAC [REAL_LE_ANTISYM]
3247QED
3248
3249Theorem REAL_MIN_LE_LIN:
3250 !z x y. 0 <= z /\ z <= 1 ==> min x y <= z * x + (1 - z) * y
3251Proof
3252 RW_TAC boolSimps.bool_ss []
3253 THEN MP_TAC (Q.SPECL [`x`, `y`] REAL_LE_TOTAL)
3254 THEN (STRIP_TAC THEN RW_TAC boolSimps.bool_ss [REAL_MIN_ALT])
3255 THENL [MATCH_MP_TAC REAL_LE_TRANS
3256 THEN Q.EXISTS_TAC `z * x + (1 - z) * x`
3257 THEN (CONJ_TAC THEN1
3258 RW_TAC boolSimps.bool_ss
3259 [GSYM REAL_RDISTRIB, REAL_SUB_ADD2, REAL_LE_REFL, REAL_MUL_LID])
3260 THEN MATCH_MP_TAC REAL_LE_ADD2
3261 THEN (CONJ_TAC THEN1 PROVE_TAC [REAL_LE_REFL])
3262 THEN MATCH_MP_TAC REAL_LE_LMUL_IMP
3263 THEN ASM_REWRITE_TAC [REAL_SUB_LE],
3264 MATCH_MP_TAC REAL_LE_TRANS
3265 THEN Q.EXISTS_TAC `z * y + (1 - z) * y`
3266 THEN (CONJ_TAC THEN1
3267 RW_TAC boolSimps.bool_ss
3268 [GSYM REAL_RDISTRIB, REAL_SUB_ADD2, REAL_LE_REFL, REAL_MUL_LID])
3269 THEN MATCH_MP_TAC REAL_LE_ADD2
3270 THEN (REVERSE CONJ_TAC THEN1 PROVE_TAC [REAL_LE_REFL])
3271 THEN MATCH_MP_TAC REAL_LE_LMUL_IMP
3272 THEN ASM_REWRITE_TAC []]
3273QED
3274
3275Theorem REAL_MIN_ADD:
3276 !z x y. min (x + z) (y + z) = min x y + z
3277Proof
3278 RW_TAC boolSimps.bool_ss [min_def, REAL_LE_RADD]
3279QED
3280
3281Theorem REAL_MIN_SUB:
3282 !z x y. min (x - z) (y - z) = min x y - z
3283Proof
3284 RW_TAC boolSimps.bool_ss [min_def, REAL_LE_SUB_RADD, REAL_SUB_ADD]
3285QED
3286
3287Theorem REAL_IMP_MIN_LE2:
3288 !x1 x2 y1 y2. x1 <= y1 /\ x2 <= y2 ==> min x1 x2 <= min y1 y2
3289Proof
3290 RW_TAC boolSimps.bool_ss [REAL_LE_MIN]
3291 THEN RW_TAC boolSimps.bool_ss [REAL_MIN_LE]
3292QED
3293
3294(* from real_topologyTheory *)
3295Theorem REAL_MIN_ACI:
3296 !x y z. (min x y = min y x) /\
3297 (min (min x y) z = min x (min y z)) /\
3298 (min x (min y z) = min y (min x z)) /\
3299 (min x x = x) /\
3300 (min x (min x y) = min x y)
3301Proof
3302 RW_TAC bool_ss [min_def]
3303 >> FULL_SIMP_TAC bool_ss [] (* 7 subgoals *)
3304 >| [ PROVE_TAC [REAL_LE_ANTISYM],
3305 PROVE_TAC [REAL_NOT_LE, REAL_LT_ANTISYM],
3306 REV_FULL_SIMP_TAC bool_ss [],
3307 Cases_on `y <= z`
3308 >- ( FULL_SIMP_TAC bool_ss [] \\
3309 PROVE_TAC [REAL_LE_TRANS] ) \\
3310 FULL_SIMP_TAC bool_ss [] >> FULL_SIMP_TAC bool_ss [REAL_NOT_LE] \\
3311 `x <= y` by PROVE_TAC [REAL_LET_TRANS, REAL_LT_IMP_LE] \\
3312 FULL_SIMP_TAC bool_ss [] \\
3313 PROVE_TAC [REAL_LTE_ANTISYM],
3314 REVERSE (Cases_on `(y <= z)`)
3315 >- ( FULL_SIMP_TAC bool_ss [] >> REV_FULL_SIMP_TAC bool_ss [REAL_NOT_LE] \\
3316 PROVE_TAC [REAL_LTE_ANTISYM, REAL_LTE_TRANS] ) \\
3317 FULL_SIMP_TAC bool_ss [] \\
3318 FULL_SIMP_TAC bool_ss [REAL_NOT_LE] \\
3319 `x <= z` by PROVE_TAC [REAL_LE_TRANS] \\
3320 FULL_SIMP_TAC bool_ss [] >> PROVE_TAC [REAL_LE_ANTISYM],
3321 FULL_SIMP_TAC bool_ss [REAL_NOT_LE] \\
3322 PROVE_TAC [REAL_LT_ANTISYM],
3323 REV_FULL_SIMP_TAC bool_ss [] ]
3324QED
3325
3326(* ------------------------------------------------------------------------- *)
3327(* Define the maximum of two real numbers *)
3328(* ------------------------------------------------------------------------- *)
3329
3330Theorem max_def = real_max; (* moved to realaxTheory *)
3331
3332Theorem REAL_MAX_REFL:
3333 !x. max x x = x
3334Proof
3335 RW_TAC boolSimps.bool_ss [max_def]
3336QED
3337
3338Theorem REAL_LE_MAX:
3339 !z x y. z <= max x y <=> z <= x \/ z <= y
3340Proof
3341 RW_TAC boolSimps.bool_ss [max_def]
3342 THEN PROVE_TAC [REAL_LE_TOTAL, REAL_LE_TRANS]
3343QED
3344
3345Theorem REAL_LE_MAX1:
3346 !x y. x <= max x y
3347Proof
3348 RW_TAC boolSimps.bool_ss [REAL_LE_MAX, REAL_LE_REFL]
3349QED
3350
3351Theorem REAL_LE_MAX2:
3352 !x y. y <= max x y
3353Proof
3354 RW_TAC boolSimps.bool_ss [REAL_LE_MAX, REAL_LE_REFL]
3355QED
3356
3357Theorem REAL_MAX_LE:
3358 !z x y. max x y <= z <=> x <= z /\ y <= z
3359Proof
3360 RW_TAC boolSimps.bool_ss [max_def]
3361 THEN PROVE_TAC [REAL_LE_TRANS, REAL_LE_TOTAL]
3362QED
3363
3364Theorem REAL_LT_MAX:
3365 !x y z. z < max x y <=> z < x \/ z < y
3366Proof
3367 RW_TAC boolSimps.bool_ss [max_def]
3368 THEN PROVE_TAC [REAL_LT_TRANS, REAL_LTE_TRANS, REAL_NOT_LE]
3369QED
3370
3371Theorem REAL_MAX_LT:
3372 !x y z. max x y < z <=> x < z /\ y < z
3373Proof
3374 RW_TAC boolSimps.bool_ss [max_def]
3375 THEN PROVE_TAC [REAL_LT_TRANS, REAL_LTE_TRANS, REAL_NOT_LE]
3376QED
3377
3378Theorem REAL_MAX_ALT:
3379 !x y. (x <= y ==> (max x y = y)) /\ (y <= x ==> (max x y = x))
3380Proof
3381 RW_TAC boolSimps.bool_ss [max_def]
3382 THEN PROVE_TAC [REAL_LE_ANTISYM]
3383QED
3384
3385Theorem REAL_MAX_MIN:
3386 !x y. max x y = ~min (~x) (~y)
3387Proof
3388 REPEAT GEN_TAC
3389 THEN MP_TAC (Q.SPECL [`x`, `y`] REAL_LE_TOTAL)
3390 THEN STRIP_TAC
3391 THEN RW_TAC boolSimps.bool_ss
3392 [REAL_MAX_ALT, REAL_MIN_ALT, REAL_LE_NEG2, REAL_NEGNEG]
3393QED
3394
3395Theorem REAL_MIN_MAX:
3396 !x y. min x y = ~max (~x) (~y)
3397Proof
3398 REPEAT GEN_TAC
3399 THEN MP_TAC (Q.SPECL [`x`, `y`] REAL_LE_TOTAL)
3400 THEN STRIP_TAC
3401 THEN RW_TAC boolSimps.bool_ss
3402 [REAL_MAX_ALT, REAL_MIN_ALT, REAL_LE_NEG2, REAL_NEGNEG]
3403QED
3404
3405Theorem REAL_LIN_LE_MAX:
3406 !z x y. 0 <= z /\ z <= 1 ==> z * x + (1 - z) * y <= max x y
3407Proof
3408 RW_TAC boolSimps.bool_ss []
3409 THEN MP_TAC (Q.SPECL [`z`, `~x`, `~y`] REAL_MIN_LE_LIN)
3410 THEN RW_TAC boolSimps.bool_ss
3411 [REAL_MIN_MAX, REAL_NEGNEG, REAL_MUL_RNEG, GSYM REAL_NEG_ADD,
3412 REAL_LE_NEG2]
3413QED
3414
3415Theorem REAL_MAX_ADD:
3416 !z x y. max (x + z) (y + z) = max x y + z
3417Proof
3418 RW_TAC boolSimps.bool_ss [max_def, REAL_LE_RADD]
3419QED
3420
3421Theorem REAL_MAX_SUB:
3422 !z x y. max (x - z) (y - z) = max x y - z
3423Proof
3424 RW_TAC boolSimps.bool_ss [max_def, REAL_LE_SUB_RADD, REAL_SUB_ADD]
3425QED
3426
3427Theorem REAL_IMP_MAX_LE2:
3428 !x1 x2 y1 y2. x1 <= y1 /\ x2 <= y2 ==> max x1 x2 <= max y1 y2
3429Proof
3430 RW_TAC boolSimps.bool_ss [REAL_MAX_LE]
3431 THEN RW_TAC boolSimps.bool_ss [REAL_LE_MAX]
3432QED
3433
3434(* from real_topologyTheory *)
3435Theorem REAL_MAX_ACI:
3436 !x y z. (max x y = max y x) /\
3437 (max (max x y) z = max x (max y z)) /\
3438 (max x (max y z) = max y (max x z)) /\
3439 (max x x = x) /\
3440 (max x (max x y) = max x y)
3441Proof
3442 RW_TAC bool_ss [max_def]
3443 >> FULL_SIMP_TAC bool_ss [] (* 7 subgoals *)
3444 >| [ PROVE_TAC [REAL_LE_ANTISYM],
3445 PROVE_TAC [REAL_NOT_LE, REAL_LT_ANTISYM],
3446 REVERSE (Cases_on `(y <= z)`)
3447 >- ( FULL_SIMP_TAC bool_ss [] >> FULL_SIMP_TAC bool_ss [REAL_NOT_LE] \\
3448 PROVE_TAC [REAL_LT_ANTISYM, REAL_LET_TRANS] ) \\
3449 FULL_SIMP_TAC bool_ss [] \\
3450 FULL_SIMP_TAC bool_ss [REAL_NOT_LE] \\
3451 `~(x <= y)` by PROVE_TAC [REAL_LET_TRANS, REAL_NOT_LE] \\
3452 FULL_SIMP_TAC bool_ss [] \\
3453 PROVE_TAC [REAL_LT_ANTISYM, REAL_LET_TRANS],
3454 REV_FULL_SIMP_TAC bool_ss [],
3455 REV_FULL_SIMP_TAC bool_ss [],
3456 PROVE_TAC [REAL_LE_ANTISYM],
3457 Cases_on `y <= z`
3458 >- ( FULL_SIMP_TAC bool_ss [] >> REV_FULL_SIMP_TAC bool_ss [] \\
3459 FULL_SIMP_TAC bool_ss [REAL_NOT_LE] \\
3460 PROVE_TAC [REAL_LT_ANTISYM, REAL_LTE_TRANS] ) \\
3461 FULL_SIMP_TAC bool_ss [] >> FULL_SIMP_TAC bool_ss [REAL_NOT_LE] \\
3462 PROVE_TAC [REAL_LT_ANTISYM, REAL_LET_TRANS] ]
3463QED
3464
3465(* extracted from integrationTheory *)
3466Theorem REAL_MIN_LE_MAX :
3467 !x:real y. min x y <= max x y
3468Proof
3469 rpt GEN_TAC
3470 >> MATCH_MP_TAC REAL_LE_TRANS
3471 >> Q.EXISTS_TAC ‘x’
3472 >> REWRITE_TAC [REAL_MIN_LE1, REAL_LE_MAX1]
3473QED
3474
3475(* extracted from integrationTheory *)
3476Theorem REAL_MAX_SUB_MIN :
3477 !x:real y. max x y - min x y = abs (y - x)
3478Proof
3479 RW_TAC std_ss [min_def, max_def, abs, REAL_SUB_LE, REAL_NEG_SUB]
3480QED
3481
3482(* extracted from integrationTheory *)
3483Theorem ABS_BOUNDS_MIN_MAX :
3484 !a b x B:real. abs(x) <= B ==> min a (-B) <= x /\ x <= max b B
3485Proof
3486 rpt GEN_TAC
3487 >> DISCH_THEN (STRIP_ASSUME_TAC o REWRITE_RULE [ABS_BOUNDS])
3488 >> PROVE_TAC [REAL_LE_MAX, REAL_MIN_LE]
3489QED
3490
3491(* ------------------------------------------------------------------------- *)
3492(* More theorems about sup, and corresponding theorems about an inf operator *)
3493(* ------------------------------------------------------------------------- *)
3494
3495Definition inf_def: inf p = ~(sup (\r. p (~r)))
3496End
3497
3498Theorem inf_alt :
3499 !p. inf p = ~(sup (IMAGE $~ p))
3500Proof
3501 RW_TAC std_ss [inf_def]
3502 >> Suff `(\r. p (-r)) = (IMAGE numeric_negate p)` >- rw []
3503 >> SET_EQ_TAC
3504 >> RW_TAC std_ss [IN_IMAGE, IN_APP]
3505 >> EQ_TAC >> RW_TAC std_ss []
3506 >- (Q.EXISTS_TAC `-x` >> rw [REAL_NEG_NEG])
3507 >> rw [REAL_NEG_NEG]
3508QED
3509
3510Theorem INF_DEF_ALT :
3511 !p. inf p = ~(sup (\r. ~r IN p)):real
3512Proof
3513 RW_TAC std_ss []
3514 >> PURE_REWRITE_TAC [inf_def, IMAGE_DEF]
3515 >> Suff `(\r. p (-r)) = (\r. -r IN p)`
3516 >- RW_TAC std_ss []
3517 >> RW_TAC std_ss [FUN_EQ_THM, SPECIFICATION]
3518QED
3519
3520(* dual theorem of REAL_SUP *)
3521Theorem REAL_INF :
3522 !P. (?x. P x) /\ (?z. !x. P x ==> z < x) ==>
3523 (!y. (?x. P x /\ x < y) <=> inf P < y)
3524Proof
3525 RW_TAC std_ss [inf_def]
3526 >> Know ‘-sup (\r. P (-r)) < --y <=> -y < sup (\r. P (-r))’
3527 >- REWRITE_TAC [REAL_LT_NEG]
3528 >> REWRITE_TAC [REAL_NEG_NEG]
3529 >> Rewr'
3530 >> MP_TAC (BETA_RULE (Q.SPEC ‘\x. P (~x)’ REAL_SUP))
3531 >> Know ‘(?x. P (-x)) /\ (?z. !x. P (-x) ==> x < z)’
3532 >- (CONJ_TAC >- (Q.EXISTS_TAC ‘-x’ >> rw [REAL_NEG_NEG]) \\
3533 Q.EXISTS_TAC ‘-z’ >> rpt STRIP_TAC >> rename1 ‘P (-y)’ \\
3534 Q.PAT_X_ASSUM ‘!x. P x ==> z < x’ (MP_TAC o (Q.SPEC ‘-y’)) \\
3535 RW_TAC std_ss [] \\
3536 Know ‘y < -z <=> --y < -z’ >- REWRITE_TAC [REAL_NEG_NEG] >> Rewr' \\
3537 ASM_REWRITE_TAC [REAL_LT_NEG])
3538 >> Rewr
3539 >> DISCH_THEN (ONCE_REWRITE_TAC o wrap o (ONCE_REWRITE_RULE [EQ_SYM_EQ]))
3540 >> EQ_TAC >> rpt STRIP_TAC
3541 >| [ (* goal 1 (of 2) *)
3542 rename1 ‘w < y’ >> Q.EXISTS_TAC ‘-w’ \\
3543 ASM_REWRITE_TAC [REAL_NEG_NEG, REAL_LT_NEG],
3544 (* goal 2 (of 2) *)
3545 rename1 ‘-y < w’ >> Q.EXISTS_TAC ‘-w’ \\
3546 ASM_REWRITE_TAC [] \\
3547 Know ‘-w < y <=> -w < --y’ >- REWRITE_TAC [REAL_NEG_NEG] >> Rewr' \\
3548 ASM_REWRITE_TAC [REAL_LT_NEG] ]
3549QED
3550
3551Theorem REAL_INF' :
3552 !P. P <> {} /\ (?z. !x. x IN P ==> z < x) ==>
3553 (!y. (?x. x IN P /\ x < y) <=> inf P < y)
3554Proof
3555 REWRITE_TAC [IN_APP, REAL_INF, GSYM MEMBER_NOT_EMPTY]
3556QED
3557
3558Theorem REAL_SUP_EXISTS_UNIQUE:
3559 !p : real -> bool.
3560 (?x. p x) /\ (?z. !x. p x ==> x <= z) ==>
3561 ?!s. !y. (?x. p x /\ y < x) <=> y < s
3562Proof
3563 REPEAT STRIP_TAC
3564 THEN CONV_TAC EXISTS_UNIQUE_CONV
3565 THEN (RW_TAC boolSimps.bool_ss []
3566 THEN1 (MP_TAC (Q.SPEC `p` REAL_SUP_LE) THEN PROVE_TAC []))
3567 THEN REWRITE_TAC [GSYM REAL_LE_ANTISYM, GSYM REAL_NOT_LT]
3568 THEN REPEAT STRIP_TAC
3569 THENL [(SUFF_TAC ``!x : real. p x ==> ~(s' < x)`` THEN1 PROVE_TAC [])
3570 THEN REPEAT STRIP_TAC
3571 THEN (SUFF_TAC ``~((s' : real) < s')`` THEN1 PROVE_TAC [])
3572 THEN REWRITE_TAC [REAL_LT_REFL],
3573 (SUFF_TAC ``!x : real. p x ==> ~(s < x)`` THEN1 PROVE_TAC [])
3574 THEN REPEAT STRIP_TAC
3575 THEN (SUFF_TAC ``~((s : real) < s)`` THEN1 PROVE_TAC [])
3576 THEN REWRITE_TAC [REAL_LT_REFL]]
3577QED
3578
3579Theorem REAL_SUP_EXISTS_UNIQUE' :
3580 !p : real -> bool.
3581 p <> {} /\ (?z. !x. x IN p ==> x <= z) ==>
3582 ?!s. !y. (?x. x IN p /\ y < x) <=> y < s
3583Proof
3584 REWRITE_TAC [IN_APP, REAL_SUP_EXISTS_UNIQUE, GSYM MEMBER_NOT_EMPTY]
3585QED
3586
3587Theorem REAL_SUP_MAX:
3588 !p z. p z /\ (!x. p x ==> x <= z) ==> (sup p = z)
3589Proof
3590 REPEAT STRIP_TAC
3591 THEN (KNOW_TAC ``!y : real. (?x. p x /\ y < x) <=> y < z``
3592 THEN1 (STRIP_TAC
3593 THEN REVERSE EQ_TAC THEN1 PROVE_TAC []
3594 THEN REPEAT STRIP_TAC
3595 THEN PROVE_TAC [REAL_LTE_TRANS]))
3596 THEN STRIP_TAC
3597 THEN (KNOW_TAC ``!y. (?x. p x /\ y < x) <=> y < sup p``
3598 THEN1 PROVE_TAC [REAL_SUP_LE])
3599 THEN STRIP_TAC
3600 THEN (KNOW_TAC ``(?x : real. p x) /\ (?z. !x. p x ==> x <= z)``
3601 THEN1 PROVE_TAC [])
3602 THEN STRIP_TAC
3603 THEN ASSUME_TAC ((SPEC ``p:real->bool`` o CONV_RULE
3604 (DEPTH_CONV EXISTS_UNIQUE_CONV)) REAL_SUP_EXISTS_UNIQUE)
3605 THEN RES_TAC
3606QED
3607
3608Theorem REAL_SUP_MAX' :
3609 !p z. z IN p /\ (!x. x IN p ==> x <= z) ==> (sup p = z)
3610Proof
3611 REWRITE_TAC [IN_APP, REAL_SUP_MAX]
3612QED
3613
3614Theorem REAL_IMP_SUP_LE:
3615 !p x. (?r. p r) /\ (!r. p r ==> r <= x) ==> sup p <= x
3616Proof
3617 RW_TAC boolSimps.bool_ss []
3618 THEN REWRITE_TAC [GSYM REAL_NOT_LT]
3619 THEN STRIP_TAC
3620 THEN MP_TAC (SPEC ``p:real->bool`` REAL_SUP_LE)
3621 THEN RW_TAC boolSimps.bool_ss []
3622 THENL [PROVE_TAC [],
3623 PROVE_TAC [],
3624 EXISTS_TAC ``x:real``
3625 THEN RW_TAC boolSimps.bool_ss []
3626 THEN PROVE_TAC [real_lte]]
3627QED
3628
3629Theorem REAL_IMP_SUP_LE' :
3630 !p x. p <> {} /\ (!r. r IN p ==> r <= x) ==> sup p <= x
3631Proof
3632 REWRITE_TAC [IN_APP, REAL_IMP_SUP_LE, GSYM MEMBER_NOT_EMPTY]
3633QED
3634
3635(* NOTE: removed unnecessary ‘(?r. p r)’ from antecedents *)
3636Theorem REAL_IMP_LE_SUP :
3637 !p x. (?z. !r. p r ==> r <= z) /\ (?r. p r /\ x <= r) ==> x <= sup p
3638Proof
3639 RW_TAC bool_ss []
3640 >> (SUFF_TAC ``!y. p y ==> y <= sup p`` >- PROVE_TAC [REAL_LE_TRANS])
3641 >> MATCH_MP_TAC REAL_SUP_UBOUND_LE
3642 >> PROVE_TAC []
3643QED
3644
3645Theorem REAL_IMP_LE_SUP' :
3646 !p x. (?z. !r. r IN p ==> r <= z) /\ (?r. r IN p /\ x <= r) ==> x <= sup p
3647Proof
3648 REWRITE_TAC [IN_APP, REAL_IMP_LE_SUP]
3649QED
3650
3651Theorem REAL_IMP_LT_SUP :
3652 !p x. (?z. !r. p r ==> r <= z) /\ ~p (sup p) /\ p x ==> x < sup p
3653Proof
3654 reverse (RW_TAC bool_ss [REAL_LT_LE])
3655 >- (CCONTR_TAC >> FULL_SIMP_TAC bool_ss [])
3656 >> MATCH_MP_TAC REAL_IMP_LE_SUP
3657 >> reverse CONJ_TAC
3658 >- (Q.EXISTS_TAC ‘x’ >> ASM_REWRITE_TAC [REAL_LE_REFL])
3659 >> Q.EXISTS_TAC ‘z’ >> RW_TAC bool_ss []
3660QED
3661
3662Theorem REAL_IMP_LT_SUP' :
3663 !p x. (?z. !r. r IN p ==> r <= z) /\ sup p NOTIN p /\ p x ==> x < sup p
3664Proof
3665 REWRITE_TAC [IN_APP, REAL_IMP_LT_SUP]
3666QED
3667
3668Theorem REAL_INF_MIN:
3669 !p z. p z /\ (!x. p x ==> z <= x) ==> (inf p = z)
3670Proof
3671 RW_TAC boolSimps.bool_ss []
3672 THEN MP_TAC (SPECL [``(\r. (p:real->bool) (~r))``, ``~(z:real)``]
3673 REAL_SUP_MAX)
3674 THEN RW_TAC boolSimps.bool_ss [REAL_NEGNEG, inf_def]
3675 THEN (SUFF_TAC ``!x : real. p ~x ==> x <= ~z`` THEN1 PROVE_TAC [REAL_NEGNEG])
3676 THEN REPEAT STRIP_TAC
3677 THEN ONCE_REWRITE_TAC [GSYM REAL_NEGNEG]
3678 THEN ONCE_REWRITE_TAC [REAL_LE_NEG]
3679 THEN REWRITE_TAC [REAL_NEGNEG]
3680 THEN PROVE_TAC []
3681QED
3682
3683Theorem REAL_INF_MIN' :
3684 !p z. z IN p /\ (!x. x IN p ==> z <= x) ==> (inf p = z)
3685Proof
3686 REWRITE_TAC [IN_APP, REAL_INF_MIN]
3687QED
3688
3689Theorem REAL_IMP_LE_INF:
3690 !p r. (?x. p x) /\ (!x. p x ==> r <= x) ==> r <= inf p
3691Proof
3692 RW_TAC boolSimps.bool_ss [inf_def]
3693 THEN POP_ASSUM MP_TAC
3694 THEN ONCE_REWRITE_TAC [GSYM REAL_NEGNEG]
3695 THEN Q.SPEC_TAC (`~r`, `r`)
3696 THEN RW_TAC boolSimps.bool_ss [REAL_NEGNEG, REAL_LE_NEG]
3697 THEN MATCH_MP_TAC REAL_IMP_SUP_LE
3698 THEN RW_TAC boolSimps.bool_ss []
3699 THEN PROVE_TAC [REAL_NEGNEG]
3700QED
3701
3702Theorem REAL_IMP_LE_INF' :
3703 !p r. p <> {} /\ (!x. x IN p ==> r <= x) ==> r <= inf p
3704Proof
3705 REWRITE_TAC [IN_APP, REAL_IMP_LE_INF, GSYM MEMBER_NOT_EMPTY]
3706QED
3707
3708Theorem REAL_IMP_INF_LE:
3709 !p r. (?z. !x. p x ==> z <= x) /\ (?x. p x /\ x <= r) ==> inf p <= r
3710Proof
3711 RW_TAC boolSimps.bool_ss [inf_def]
3712 THEN POP_ASSUM MP_TAC
3713 THEN ONCE_REWRITE_TAC [GSYM REAL_NEGNEG]
3714 THEN Q.SPEC_TAC (`~r`, `r`)
3715 THEN RW_TAC boolSimps.bool_ss [REAL_NEGNEG, REAL_LE_NEG]
3716 THEN MATCH_MP_TAC REAL_IMP_LE_SUP
3717 THEN RW_TAC boolSimps.bool_ss []
3718 THEN PROVE_TAC [REAL_NEGNEG, REAL_LE_NEG]
3719QED
3720
3721Theorem REAL_IMP_INF_LE' :
3722 !p r. (?z. !x. x IN p ==> z <= x) /\ (?x. x IN p /\ x <= r) ==> inf p <= r
3723Proof
3724 REWRITE_TAC [IN_APP, REAL_IMP_INF_LE]
3725QED
3726
3727Theorem REAL_INF_LT:
3728 !p z. (?x. p x) /\ inf p < z ==> (?x. p x /\ x < z)
3729Proof
3730 RW_TAC boolSimps.bool_ss []
3731 THEN (SUFF_TAC ``~(!x. p x ==> ~(x < z))`` THEN1 PROVE_TAC [])
3732 THEN REWRITE_TAC [GSYM real_lte]
3733 THEN STRIP_TAC
3734 THEN Q.PAT_X_ASSUM `inf p < z` MP_TAC
3735 THEN RW_TAC boolSimps.bool_ss [GSYM real_lte]
3736 THEN MATCH_MP_TAC REAL_IMP_LE_INF
3737 THEN PROVE_TAC []
3738QED
3739
3740Theorem REAL_INF_LT' :
3741 !p z. p <> {} /\ inf p < z ==> ?x. x IN p /\ x < z
3742Proof
3743 REWRITE_TAC [IN_APP, REAL_INF_LT, GSYM MEMBER_NOT_EMPTY]
3744QED
3745
3746Theorem REAL_INF_CLOSE:
3747 !p e. (?x. p x) /\ 0 < e ==> (?x. p x /\ x < inf p + e)
3748Proof
3749 RW_TAC boolSimps.bool_ss []
3750 THEN MATCH_MP_TAC REAL_INF_LT
3751 THEN (CONJ_TAC THEN1 PROVE_TAC [])
3752 THEN RW_TAC boolSimps.bool_ss [REAL_LT_ADDR]
3753QED
3754
3755Theorem REAL_INF_CLOSE' :
3756 !p e. p <> {} /\ 0 < e ==> ?x. x IN p /\ x < inf p + e
3757Proof
3758 REWRITE_TAC [IN_APP, REAL_INF_CLOSE, GSYM MEMBER_NOT_EMPTY]
3759QED
3760
3761Theorem SUP_EPSILON:
3762 !p e.
3763 0 < e /\ (?x. p x) /\ (?z. !x. p x ==> x <= z) ==>
3764 ?x. p x /\ sup p <= x + e
3765Proof
3766 REPEAT GEN_TAC
3767 THEN REPEAT DISCH_TAC
3768 THEN REWRITE_TAC [GSYM REAL_NOT_LT]
3769 THEN MP_TAC (Q.SPEC `p` REAL_SUP_LE)
3770 THEN ASM_REWRITE_TAC []
3771 THEN DISCH_THEN (fn th => REWRITE_TAC [GSYM th])
3772 THEN POP_ASSUM MP_TAC
3773 THEN RW_TAC boolSimps.bool_ss [GSYM IMP_DISJ_THM, REAL_NOT_LT]
3774 THEN (SUFF_TAC
3775 ``?n : num.
3776 ?x : real. p x /\ z - &(SUC n) * e <= x /\ x <= z - & n * e /\
3777 !y. p y ==> y <= z - &n * e``
3778 THEN1 (RW_TAC boolSimps.bool_ss []
3779 THEN Q.EXISTS_TAC `x'`
3780 THEN RW_TAC boolSimps.bool_ss []
3781 THEN Q.PAT_X_ASSUM `!x. P x` (MP_TAC o Q.SPEC `x''`)
3782 THEN RW_TAC boolSimps.bool_ss []
3783 THEN MATCH_MP_TAC REAL_LE_TRANS
3784 THEN Q.EXISTS_TAC `z - &n * e`
3785 THEN RW_TAC boolSimps.bool_ss []
3786 THEN (SUFF_TAC ``(z:real) - &n * e = z - &(SUC n) * e + 1 * e``
3787 THEN1 RW_TAC boolSimps.bool_ss
3788 [REAL_MUL_LID, REAL_LE_RADD])
3789 THEN RW_TAC boolSimps.bool_ss
3790 [real_sub, GSYM REAL_ADD_ASSOC, REAL_EQ_LADD]
3791 THEN ONCE_REWRITE_TAC [GSYM REAL_EQ_NEG]
3792 THEN RW_TAC boolSimps.bool_ss
3793 [REAL_NEGNEG, REAL_NEG_ADD, GSYM REAL_MUL_LNEG,
3794 GSYM REAL_ADD_RDISTRIB, REAL_EQ_RMUL]
3795 THEN DISJ2_TAC
3796 THEN RW_TAC boolSimps.bool_ss
3797 [REAL_EQ_SUB_LADD, GSYM real_sub, REAL_ADD, REAL_INJ,
3798 arithmeticTheory.ADD1]))
3799 THEN (KNOW_TAC ``?n : num. ?x : real. p x /\ z - &(SUC n) * e <= x``
3800 THEN1 (MP_TAC (Q.SPEC `(z - x) / e` REAL_BIGNUM)
3801 THEN STRIP_TAC
3802 THEN Q.EXISTS_TAC `n`
3803 THEN Q.EXISTS_TAC `x`
3804 THEN RW_TAC boolSimps.bool_ss [REAL_LE_SUB_RADD]
3805 THEN ONCE_REWRITE_TAC [REAL_ADD_SYM]
3806 THEN REWRITE_TAC [GSYM REAL_LE_SUB_RADD]
3807 THEN (KNOW_TAC ``((z - x) / e) * e = (z:real) - x``
3808 THEN1 (MATCH_MP_TAC REAL_DIV_RMUL
3809 THEN PROVE_TAC [REAL_LT_LE]))
3810 THEN DISCH_THEN (fn th => ONCE_REWRITE_TAC [GSYM th])
3811 THEN RW_TAC boolSimps.bool_ss [REAL_LE_RMUL]
3812 THEN MATCH_MP_TAC REAL_LE_TRANS
3813 THEN Q.EXISTS_TAC `&n`
3814 THEN REWRITE_TAC [REAL_LE]
3815 THEN PROVE_TAC
3816 [arithmeticTheory.LESS_EQ_SUC_REFL, REAL_LT_LE]))
3817 THEN DISCH_THEN (MP_TAC o HO_MATCH_MP LEAST_EXISTS_IMP)
3818 THEN Q.SPEC_TAC (`$LEAST (\n. ?x. p x /\ z - & (SUC n) * e <= x)`, `m`)
3819 THEN RW_TAC boolSimps.bool_ss [GSYM IMP_DISJ_THM]
3820 THEN Q.EXISTS_TAC `m`
3821 THEN Q.EXISTS_TAC `x'`
3822 THEN ASM_REWRITE_TAC []
3823 THEN (Cases_on `m`
3824 THEN1 RW_TAC boolSimps.bool_ss [REAL_MUL_LZERO, REAL_SUB_RZERO])
3825 THEN POP_ASSUM (MP_TAC o Q.SPEC `n`)
3826 THEN RW_TAC boolSimps.bool_ss [prim_recTheory.LESS_SUC_REFL, GSYM real_lt]
3827 THEN PROVE_TAC [REAL_LT_LE]
3828QED
3829
3830Theorem SUP_EPSILON' :
3831 !p e.
3832 0 < e /\ p <> {} /\ (?z. !x. x IN p ==> x <= z) ==>
3833 ?x. x IN p /\ sup p <= x + e
3834Proof
3835 REWRITE_TAC [IN_APP, SUP_EPSILON, GSYM MEMBER_NOT_EMPTY]
3836QED
3837
3838(* This theorem is slightly more general than SUP_EPSILON (in sense of REAL_LT_IMP_LE)
3839 but actually can be proved as a corollary of SUP_EPSILON.
3840 *)
3841Theorem SUP_LT_EPSILON :
3842 !p e. 0 < e /\ (?x. p x) /\ (?z. !x. p x ==> x <= z) ==>
3843 ?x. p x /\ sup p < x + e
3844Proof
3845 rpt STRIP_TAC
3846 >> MP_TAC (Q.SPECL [‘p’, ‘e / 2’] SUP_EPSILON)
3847 >> KNOW_TAC “0 < e / 2”
3848 >- (MATCH_MP_TAC REAL_LT_DIV >> RW_TAC arith_ss [REAL_LT])
3849 >> KNOW_TAC “?(x :real). p x”
3850 >- (Q.EXISTS_TAC ‘x’ >> ASM_REWRITE_TAC [])
3851 >> KNOW_TAC “?(z :real). !x. p x ==> x <= z”
3852 >- (Q.EXISTS_TAC ‘z’ >> RW_TAC std_ss [])
3853 >> RW_TAC std_ss []
3854 >> rename1 ‘sup p <= y + e / 2’
3855 >> Q.EXISTS_TAC ‘y’ >> ASM_REWRITE_TAC []
3856 >> MATCH_MP_TAC REAL_LET_TRANS
3857 >> Q.EXISTS_TAC ‘y + e / 2’ >> ASM_REWRITE_TAC []
3858 >> MATCH_MP_TAC REAL_LT_IADD
3859 >> ASM_REWRITE_TAC [REAL_LT_HALF2]
3860QED
3861
3862Theorem SUP_LT_EPSILON' :
3863 !p e. 0 < e /\ p <> {} /\ (?z. !x. x IN p ==> x <= z) ==>
3864 ?x. x IN p /\ sup p < x + e
3865Proof
3866 REWRITE_TAC [IN_APP, SUP_LT_EPSILON, GSYM MEMBER_NOT_EMPTY]
3867QED
3868
3869Theorem REAL_LE_SUP:
3870 !p x : real.
3871 (?y. p y) /\ (?y. !z. p z ==> z <= y) ==>
3872 (x <= sup p <=> !y. (!z. p z ==> z <= y) ==> x <= y)
3873Proof
3874 RW_TAC boolSimps.bool_ss []
3875 THEN EQ_TAC
3876 THENL [RW_TAC boolSimps.bool_ss []
3877 THEN MATCH_MP_TAC REAL_LE_EPSILON
3878 THEN RW_TAC boolSimps.bool_ss [GSYM REAL_LE_SUB_RADD]
3879 THEN (KNOW_TAC ``(x:real) - e < sup p``
3880 THEN1 (MATCH_MP_TAC REAL_LTE_TRANS
3881 THEN Q.EXISTS_TAC `x`
3882 THEN RW_TAC boolSimps.bool_ss
3883 [REAL_LT_SUB_RADD, REAL_LT_ADDR]))
3884 THEN Q.PAT_X_ASSUM `0 < e` (K ALL_TAC)
3885 THEN Q.PAT_X_ASSUM `x <= sup p` (K ALL_TAC)
3886 THEN Q.SPEC_TAC (`x - e`, `x`)
3887 THEN GEN_TAC
3888 THEN MP_TAC (Q.SPEC `p` REAL_SUP_LE)
3889 THEN MATCH_MP_TAC (PROVE [] ``x /\ (y ==> z) ==> (x ==> y) ==> z``)
3890 THEN (CONJ_TAC THEN1 PROVE_TAC [])
3891 THEN DISCH_THEN (fn th => REWRITE_TAC [GSYM th])
3892 THEN STRIP_TAC
3893 THEN MATCH_MP_TAC REAL_LE_TRANS
3894 THEN PROVE_TAC [REAL_LT_LE],
3895 RW_TAC boolSimps.bool_ss []
3896 THEN MATCH_MP_TAC REAL_LE_EPSILON
3897 THEN RW_TAC boolSimps.bool_ss [GSYM REAL_LE_SUB_RADD]
3898 THEN (SUFF_TAC ``(x:real) - e < sup p`` THEN1 PROVE_TAC [REAL_LT_LE])
3899 THEN Q.PAT_X_ASSUM `!y. P y` (MP_TAC o Q.SPEC `x - e`)
3900 THEN (KNOW_TAC ``!a b : real. a <= a - b <=> ~(0 < b)``
3901 THEN1 (RW_TAC boolSimps.bool_ss [real_lt, REAL_LE_SUB_LADD]
3902 THEN PROVE_TAC [REAL_ADD_RID, REAL_LE_LADD]))
3903 THEN DISCH_THEN (fn th => ASM_REWRITE_TAC [th])
3904 THEN POP_ASSUM (K ALL_TAC)
3905 THEN Q.SPEC_TAC (`x - e`, `x`)
3906 THEN GEN_TAC
3907 THEN RW_TAC boolSimps.bool_ss []
3908 THEN MP_TAC (Q.SPEC `p` REAL_SUP_LE)
3909 THEN MATCH_MP_TAC (PROVE [] ``x /\ (y ==> z) ==> (x ==> y) ==> z``)
3910 THEN (CONJ_TAC THEN1 PROVE_TAC [])
3911 THEN DISCH_THEN (fn th => REWRITE_TAC [GSYM th])
3912 THEN PROVE_TAC [real_lt]]
3913QED
3914
3915Theorem REAL_LE_SUP' :
3916 !p x : real.
3917 p <> {} /\ (?y. !z. z IN p ==> z <= y) ==>
3918 (x <= sup p <=> !y. (!z. z IN p ==> z <= y) ==> x <= y)
3919Proof
3920 REWRITE_TAC [IN_APP, REAL_LE_SUP, GSYM MEMBER_NOT_EMPTY]
3921QED
3922
3923Theorem REAL_INF_LE:
3924 !p x : real.
3925 (?y. p y) /\ (?y. !z. p z ==> y <= z) ==>
3926 (inf p <= x <=> !y. (!z. p z ==> y <= z) ==> y <= x)
3927Proof
3928 RW_TAC boolSimps.bool_ss []
3929 THEN MP_TAC (Q.SPECL [`\r. p ~r`, `~x`] REAL_LE_SUP)
3930 THEN MATCH_MP_TAC (PROVE [] ``x /\ (y ==> z) ==> (x ==> y) ==> z``)
3931 THEN (CONJ_TAC THEN1 PROVE_TAC [REAL_NEGNEG, REAL_LE_NEG])
3932 THEN ONCE_REWRITE_TAC [GSYM REAL_NEGNEG]
3933 THEN REWRITE_TAC [GSYM inf_def]
3934 THEN REWRITE_TAC [REAL_LE_NEG]
3935 THEN RW_TAC boolSimps.bool_ss [REAL_NEGNEG]
3936 THEN POP_ASSUM (K ALL_TAC)
3937 THEN EQ_TAC
3938 THEN RW_TAC boolSimps.bool_ss []
3939 THEN Q.PAT_X_ASSUM `!a. (!b. P a b) ==> Q a` (MP_TAC o Q.SPEC `~y''`)
3940 THEN PROVE_TAC [REAL_NEGNEG, REAL_LE_NEG]
3941QED
3942
3943Theorem REAL_INF_LE' :
3944 !p x : real.
3945 p <> {} /\ (?y. !z. z IN p ==> y <= z) ==>
3946 (inf p <= x <=> !y. (!z. z IN p ==> y <= z) ==> y <= x)
3947Proof
3948 REWRITE_TAC [IN_APP, REAL_INF_LE, GSYM MEMBER_NOT_EMPTY]
3949QED
3950
3951Theorem REAL_SUP_CONST:
3952 !x : real. sup (\r. r = x) = x
3953Proof
3954 RW_TAC boolSimps.bool_ss []
3955 THEN ONCE_REWRITE_TAC [GSYM REAL_LE_ANTISYM]
3956 THEN CONJ_TAC
3957 THENL [MATCH_MP_TAC REAL_IMP_SUP_LE
3958 THEN PROVE_TAC [REAL_LE_REFL],
3959 MATCH_MP_TAC REAL_IMP_LE_SUP
3960 THEN PROVE_TAC [REAL_LE_REFL]]
3961QED
3962
3963(* ------------------------------------------------------------------------- *)
3964(* Theorems to put in the real simpset *)
3965(* ------------------------------------------------------------------------- *)
3966
3967Theorem REAL_MUL_SUB2_CANCEL:
3968 !z x y : real. x * y + (z - x) * y = z * y
3969Proof
3970 RW_TAC boolSimps.bool_ss [GSYM REAL_RDISTRIB, REAL_SUB_ADD2]
3971QED
3972
3973Theorem REAL_MUL_SUB1_CANCEL:
3974 !z x y : real. y * x + y * (z - x) = y * z
3975Proof
3976 RW_TAC boolSimps.bool_ss [GSYM REAL_LDISTRIB, REAL_SUB_ADD2]
3977QED
3978
3979Theorem REAL_NEG_HALF:
3980 !x : real. x - x / 2 = x / 2
3981Proof
3982 STRIP_TAC
3983 THEN (SUFF_TAC ``((x:real) - x / 2) + x / 2 = x / 2 + x / 2``
3984 THEN1 RW_TAC boolSimps.bool_ss [REAL_EQ_RADD])
3985 THEN RW_TAC boolSimps.bool_ss [REAL_SUB_ADD, REAL_HALF_DOUBLE]
3986QED
3987
3988Theorem REAL_NEG_THIRD:
3989 !x : real. x - x / 3 = (2 * x) / 3
3990Proof
3991 STRIP_TAC
3992 THEN MATCH_MP_TAC REAL_EQ_LMUL_IMP
3993 THEN Q.EXISTS_TAC `3`
3994 THEN (KNOW_TAC ``~(3r = 0)``
3995 THEN1 (REWRITE_TAC [REAL_INJ] THEN numLib.ARITH_TAC))
3996 THEN RW_TAC boolSimps.bool_ss [REAL_SUB_LDISTRIB, REAL_DIV_LMUL]
3997 THEN (KNOW_TAC ``!x y z : real. (y = 1 * x + z) ==> (y - x = z)``
3998 THEN1 RW_TAC boolSimps.bool_ss [REAL_MUL_LID, REAL_ADD_SUB])
3999 THEN DISCH_THEN MATCH_MP_TAC
4000 THEN RW_TAC boolSimps.bool_ss [GSYM REAL_ADD_RDISTRIB, REAL_ADD,
4001 REAL_EQ_RMUL, REAL_INJ]
4002 THEN DISJ2_TAC
4003 THEN numLib.ARITH_TAC
4004QED
4005
4006Theorem REAL_DIV_DENOM_CANCEL:
4007 !x y z : real. ~(x = 0) ==> ((y / x) / (z / x) = y / z)
4008Proof
4009 RW_TAC boolSimps.bool_ss [real_div]
4010 THEN (Cases_on `y = 0` THEN1 RW_TAC boolSimps.bool_ss [REAL_MUL_LZERO])
4011 THEN (Cases_on `z = 0`
4012 THEN1 RW_TAC boolSimps.bool_ss
4013 [REAL_INV_0, REAL_MUL_RZERO, REAL_MUL_LZERO])
4014 THEN RW_TAC boolSimps.bool_ss [REAL_INV_MUL, REAL_INV_EQ_0, REAL_INVINV]
4015 THEN (KNOW_TAC ``!a b c d : real. a * b * (c * d) = (a * c) * (b * d)``
4016 THEN1 metisLib.METIS_TAC [REAL_MUL_SYM, REAL_MUL_ASSOC])
4017 THEN DISCH_THEN (fn th => ONCE_REWRITE_TAC [th])
4018 THEN RW_TAC boolSimps.bool_ss [REAL_MUL_LINV, REAL_MUL_RID]
4019QED
4020
4021Theorem REAL_DIV_DENOM_CANCEL2 =
4022 SIMP_RULE boolSimps.bool_ss [numLib.ARITH_PROVE ``~(2n = 0)``, REAL_INJ]
4023 (Q.SPEC `2` REAL_DIV_DENOM_CANCEL);
4024
4025Theorem REAL_DIV_DENOM_CANCEL3 =
4026 SIMP_RULE boolSimps.bool_ss [numLib.ARITH_PROVE ``~(3n = 0)``, REAL_INJ]
4027 (Q.SPEC `3` REAL_DIV_DENOM_CANCEL);
4028
4029Theorem REAL_DIV_INNER_CANCEL:
4030 !x y z : real. ~(x = 0) ==> ((y / x) * (x / z) = y / z)
4031Proof
4032 RW_TAC boolSimps.bool_ss [real_div]
4033 THEN (KNOW_TAC ``!a b c d : real. a * b * (c * d) = (a * d) * (b * c)``
4034 THEN1 metisLib.METIS_TAC [REAL_MUL_SYM, REAL_MUL_ASSOC])
4035 THEN DISCH_THEN (fn th => ONCE_REWRITE_TAC [th])
4036 THEN RW_TAC boolSimps.bool_ss [REAL_MUL_LINV, REAL_MUL_RID]
4037QED
4038
4039Theorem REAL_DIV_INNER_CANCEL2 =
4040 SIMP_RULE boolSimps.bool_ss [numLib.ARITH_PROVE ``~(2n = 0)``, REAL_INJ]
4041 (Q.SPEC `2` REAL_DIV_INNER_CANCEL);
4042
4043Theorem REAL_DIV_INNER_CANCEL3 =
4044 SIMP_RULE boolSimps.bool_ss [numLib.ARITH_PROVE ``~(3n = 0)``, REAL_INJ]
4045 (Q.SPEC `3` REAL_DIV_INNER_CANCEL);
4046
4047Theorem REAL_DIV_OUTER_CANCEL:
4048 !x y z : real. ~(x = 0) ==> ((x / y) * (z / x) = z / y)
4049Proof
4050 RW_TAC boolSimps.bool_ss [real_div]
4051 THEN (KNOW_TAC ``!a b c d : real. a * b * (c * d) = (a * d) * (c * b)``
4052 THEN1 metisLib.METIS_TAC [REAL_MUL_SYM, REAL_MUL_ASSOC])
4053 THEN DISCH_THEN (fn th => ONCE_REWRITE_TAC [th])
4054 THEN RW_TAC boolSimps.bool_ss [REAL_MUL_RINV, REAL_MUL_LID]
4055QED
4056
4057Theorem REAL_DIV_OUTER_CANCEL2 =
4058 SIMP_RULE boolSimps.bool_ss [numLib.ARITH_PROVE ``~(2n = 0)``, REAL_INJ]
4059 (Q.SPEC `2` REAL_DIV_OUTER_CANCEL);
4060
4061Theorem REAL_DIV_OUTER_CANCEL3 =
4062 SIMP_RULE boolSimps.bool_ss [numLib.ARITH_PROVE ``~(3n = 0)``, REAL_INJ]
4063 (Q.SPEC `3` REAL_DIV_OUTER_CANCEL);
4064
4065Theorem REAL_DIV_REFL2 =
4066 SIMP_RULE boolSimps.bool_ss [numLib.ARITH_PROVE ``~(2n = 0)``, REAL_INJ]
4067 (Q.SPEC `2` REAL_DIV_REFL);
4068
4069Theorem REAL_DIV_REFL3 =
4070 SIMP_RULE boolSimps.bool_ss [numLib.ARITH_PROVE ``~(3n = 0)``, REAL_INJ]
4071 (Q.SPEC `3` REAL_DIV_REFL);
4072
4073Theorem REAL_HALF_BETWEEN:
4074 ((0:real) < 1 / 2 /\ 1 / 2 < (1:real)) /\
4075 ((0:real) <= 1 / 2 /\ 1 / 2 <= (1:real))
4076Proof
4077 MATCH_MP_TAC (PROVE [] ``(x ==> y) /\ x ==> x /\ y``)
4078 THEN (CONJ_TAC THEN1 PROVE_TAC [REAL_LE_TOTAL, real_lt])
4079 THEN RW_TAC boolSimps.bool_ss [real_lt]
4080 THEN MP_TAC (Q.SPEC `2` REAL_LE_LMUL)
4081 THEN (KNOW_TAC ``0r < 2 /\ ~(2r = 0)``
4082 THEN1 (REWRITE_TAC [REAL_LT, REAL_INJ] THEN numLib.ARITH_TAC))
4083 THEN STRIP_TAC
4084 THEN ASM_REWRITE_TAC []
4085 THEN DISCH_THEN (fn th => ONCE_REWRITE_TAC [GSYM th])
4086 THEN ONCE_REWRITE_TAC [REAL_MUL_SYM]
4087 THEN RW_TAC boolSimps.bool_ss [real_div, GSYM REAL_MUL_ASSOC]
4088 THEN RW_TAC boolSimps.bool_ss [REAL_MUL_LINV, REAL_INJ]
4089 THEN RW_TAC boolSimps.bool_ss [REAL_MUL, REAL_LE]
4090 THEN numLib.ARITH_TAC
4091QED
4092
4093Theorem REAL_THIRDS_BETWEEN:
4094 ((0:real) < 1 / 3 /\ 1 / 3 < (1:real) /\
4095 (0:real) < 2 / 3 /\ 2 / 3 < (1:real)) /\
4096 ((0:real) <= 1 / 3 /\ 1 / 3 <= (1:real) /\
4097 (0:real) <= 2 / 3 /\ 2 / 3 <= (1:real))
4098Proof
4099 MATCH_MP_TAC (PROVE [] ``(x ==> y) /\ x ==> x /\ y``)
4100 THEN (CONJ_TAC THEN1 PROVE_TAC [REAL_LE_TOTAL, real_lt])
4101 THEN RW_TAC boolSimps.bool_ss [real_lt]
4102 THEN MP_TAC (Q.SPEC `3` REAL_LE_LMUL)
4103 THEN (KNOW_TAC ``0r < 3 /\ ~(3r = 0)``
4104 THEN1 (REWRITE_TAC [REAL_LT, REAL_INJ] THEN numLib.ARITH_TAC))
4105 THEN STRIP_TAC
4106 THEN ASM_REWRITE_TAC []
4107 THEN DISCH_THEN (fn th => ONCE_REWRITE_TAC [GSYM th])
4108 THEN ONCE_REWRITE_TAC [REAL_MUL_SYM]
4109 THEN RW_TAC boolSimps.bool_ss [real_div, GSYM REAL_MUL_ASSOC]
4110 THEN RW_TAC boolSimps.bool_ss [REAL_MUL_LINV, REAL_INJ]
4111 THEN RW_TAC boolSimps.bool_ss [REAL_MUL, REAL_LE]
4112 THEN numLib.ARITH_TAC
4113QED
4114
4115Theorem REAL_LE_SUB_CANCEL2:
4116 !x y z : real. x - z <= y - z <=> x <= y
4117Proof
4118 RW_TAC boolSimps.bool_ss [REAL_LE_SUB_RADD, REAL_SUB_ADD]
4119QED
4120
4121(* |- !x y z :real. z - x <= z - y <=> y <= x *)
4122Theorem REAL_LE_SUB_CANCEL1 =
4123 REAL_LE_SUB_CANCEL2 |> (Q.SPECL [‘-x’, ‘-y’, ‘-z’])
4124 |> (REWRITE_RULE [REAL_SUB_NEG2, REAL_LE_NEG])
4125 |> (Q.GENL [‘x’, ‘y’, ‘z’]);
4126
4127Theorem REAL_ADD_SUB_ALT:
4128 !x y : real. (x + y) - y = x
4129Proof
4130 RW_TAC boolSimps.bool_ss [REAL_EQ_SUB_RADD]
4131QED
4132
4133Theorem INFINITE_REAL_UNIV[simp] :
4134 INFINITE univ(:real)
4135Proof
4136 REWRITE_TAC [] THEN STRIP_TAC THEN
4137 `FINITE (IMAGE real_of_num univ(:num))`
4138 by METIS_TAC [SUBSET_FINITE, SUBSET_UNIV] THEN
4139 FULL_SIMP_TAC (srw_ss()) [INJECTIVE_IMAGE_FINITE]
4140QED
4141
4142(* ----------------------------------------------------------------------
4143 theorems for calculating with the reals; naming scheme taken from
4144 Joe Hurd's development of the positive reals with an infinity
4145 ---------------------------------------------------------------------- *)
4146
4147val ui = markerTheory.unint_def
4148
4149Theorem add_rat:
4150 x / y + u / v =
4151 if y = 0 then unint (x/y) + u/v
4152 else if v = 0 then x/y + unint (u/v)
4153 else if y = v then (x + u) / v
4154 else (x * v + u * y) / (y * v)
4155Proof
4156 SRW_TAC [][ui, REAL_DIV_LZERO, REAL_DIV_ADD] THEN
4157 SRW_TAC [][REAL_ADD_RAT, REAL_MUL_COMM]
4158QED
4159
4160Theorem add_ratl:
4161 x / y + z =
4162 if y = 0 then unint(x/y) + z
4163 else (x + z * y) / y
4164Proof
4165 SRW_TAC [][ui, REAL_DIV_LZERO] THEN
4166 `z = z/1` by SRW_TAC [][] THEN
4167 POP_ASSUM (fn th => CONV_TAC (LAND_CONV (ONCE_REWRITE_CONV [th]))) THEN
4168 SRW_TAC [][REAL_ADD_RAT, REAL_MUL_COMM]
4169QED
4170
4171Theorem add_ratr:
4172 x + y / z =
4173 if z = 0 then x + unint (y/z)
4174 else (x * z + y) / z
4175Proof
4176 ONCE_REWRITE_TAC [REAL_ADD_COMM] THEN
4177 SRW_TAC [][add_ratl, REAL_DIV_LZERO]
4178QED
4179
4180Theorem add_ints:
4181 (&n + &m = &(n + m)) /\
4182 (~&n + &m = if n <= m then &(m - n) else ~&(n - m)) /\
4183 (&n + ~&m = if n < m then ~&(m - n) else &(n - m)) /\
4184 (~&n + ~&m = ~&(n + m))
4185Proof
4186 `!x y. ~x + y = y + ~x` by SRW_TAC [][REAL_ADD_COMM] THEN
4187 SRW_TAC [][GSYM REAL_NEG_ADD, GSYM real_sub, REAL_SUB] THEN
4188 FULL_SIMP_TAC (srw_ss() ++ old_ARITH_ss) [] THEN
4189 `m = n` by SRW_TAC [old_ARITH_ss][] THEN SRW_TAC [][]
4190QED
4191
4192Theorem mult_rat:
4193 (x / y) * (u / v) =
4194 if y = 0 then unint (x/y) * (u/v)
4195 else if v = 0 then (x/y) * unint(u/v)
4196 else (x * u) / (y * v)
4197Proof
4198 SRW_TAC [][ui, REAL_DIV_LZERO] THEN
4199 SRW_TAC [][REAL_DIV_LZERO] THEN
4200 MATCH_MP_TAC REAL_EQ_LMUL_IMP THEN
4201 Q.EXISTS_TAC `y * v` THEN ASM_REWRITE_TAC [REAL_MUL_ASSOC, REAL_ENTIRE] THEN
4202 SRW_TAC [][REAL_DIV_LMUL, REAL_ENTIRE] THEN
4203 `y * v * (x / y) * (u / v) = (y * (x / y)) * (v * (u / v))`
4204 by CONV_TAC (AC_CONV (REAL_MUL_ASSOC, REAL_MUL_COMM)) THEN
4205 POP_ASSUM SUBST_ALL_TAC THEN
4206 SRW_TAC [][REAL_DIV_LMUL]
4207QED
4208
4209Theorem mult_ratl:
4210 (x / y) * z = if y = 0 then unint (x/y) * z else (x * z) / y
4211Proof
4212 SRW_TAC [][ui] THEN
4213 SRW_TAC [][REAL_DIV_LZERO] THEN
4214 `z = z / 1` by SRW_TAC [][] THEN
4215 POP_ASSUM (fn th => CONV_TAC (LAND_CONV (ONCE_REWRITE_CONV[th]))) THEN
4216 REWRITE_TAC [mult_rat] THEN SRW_TAC [][]
4217QED
4218
4219Theorem mult_ratr:
4220 x * (y/z) = if z = 0 then x * unint (y/z) else (x * y) / z
4221Proof
4222 CONV_TAC (LAND_CONV (REWR_CONV REAL_MUL_COMM)) THEN
4223 SRW_TAC [][mult_ratl] THEN SRW_TAC [][ui, REAL_MUL_COMM]
4224QED
4225
4226Theorem mult_ints:
4227 (&a * &b = &(a * b)) /\
4228 (~&a * &b = ~&(a * b)) /\
4229 (&a * ~&b = ~&(a * b)) /\
4230 (~&a * ~&b = &(a * b))
4231Proof
4232 SRW_TAC [][REAL_MUL_LNEG, REAL_MUL_RNEG]
4233QED
4234
4235Theorem pow_rat:
4236 (x pow 0 = 1) /\
4237 (0 pow (NUMERAL (BIT1 n)) = 0) /\
4238 (0 pow (NUMERAL (BIT2 n)) = 0) /\
4239 (&(NUMERAL a) pow (NUMERAL n) = &(NUMERAL a EXP NUMERAL n)) /\
4240 (~&(NUMERAL a) pow (NUMERAL n) =
4241 (if ODD (NUMERAL n) then (~) else (\x.x))
4242 (&(NUMERAL a EXP NUMERAL n))) /\
4243 ((x / y) pow n = (x pow n) / (y pow n))
4244Proof
4245 SIMP_TAC bool_ss [pow, NUMERAL_DEF, BIT1, BIT2, POW_ADD,
4246 ALT_ZERO, ADD_CLAUSES, REAL_MUL, MULT_CLAUSES,
4247 REAL_MUL_RZERO, REAL_OF_NUM_POW, REAL_POW_DIV, EXP] THEN
4248 Induct_on `n` THEN ASM_SIMP_TAC bool_ss [pow, ODD, EXP] THEN
4249 Cases_on `ODD n` THEN
4250 ASM_SIMP_TAC bool_ss [REAL_MUL, REAL_MUL_LNEG,
4251 REAL_MUL_RNEG, REAL_NEG_NEG]
4252QED
4253
4254Theorem neg_rat:
4255 (-(x / y) = -x / y) /\ (x / -y = -x/y)
4256Proof
4257 Cases_on ‘y = 0’ >> simp[] >- simp[real_div] >>
4258 SRW_TAC [][ui] >>
4259 SRW_TAC [][real_div, GSYM REAL_NEG_INV, REAL_MUL_LNEG, REAL_MUL_RNEG]
4260QED
4261
4262Theorem eq_rat:
4263 (x / y = u / v) <=> if y = 0 then (u = 0) \/ (v = 0)
4264 else if v = 0 then x = 0
4265 else if y = v then x = u
4266 else x * v = y * u
4267Proof
4268 SRW_TAC [][ui] THENL [
4269 simp[real_div],
4270 simp[real_div],
4271 METIS_TAC [REAL_DIV_LMUL, REAL_EQ_LMUL],
4272 `~(y * v = 0)` by SRW_TAC [][REAL_ENTIRE] THEN
4273 `(x/y = u/v) = ((y * v) * (x/y) = (y * v) * (u/v))`
4274 by METIS_TAC [REAL_EQ_LMUL2] THEN
4275 POP_ASSUM SUBST_ALL_TAC THEN
4276 `((y * v) * (x/y) = v * (y * (x/y))) /\
4277 ((y * v) * (u/v) = y * (v * (u/v)))`
4278 by (CONJ_TAC THEN
4279 CONV_TAC (AC_CONV(REAL_MUL_ASSOC, REAL_MUL_COMM))) THEN
4280 ASM_REWRITE_TAC [] THEN SRW_TAC [][REAL_DIV_LMUL] THEN
4281 SRW_TAC [][REAL_MUL_COMM]
4282 ]
4283QED
4284
4285Theorem eq_ratl:
4286 (x/y = z) <=> if y = 0 then unint(x/y) = z else x = y * z
4287Proof
4288 SRW_TAC [][ui] THEN METIS_TAC [REAL_DIV_LMUL, REAL_EQ_LMUL]
4289QED
4290
4291Theorem eq_ratr:
4292 (z = x/y) <=> if y = 0 then z = unint(x/y) else y * z = x
4293Proof
4294 METIS_TAC [eq_ratl]
4295QED
4296
4297Theorem eq_ints:
4298 ((&n = &m) <=> (n = m)) /\
4299 ((~&n = &m) <=> (n = 0) /\ (m = 0)) /\
4300 ((&n = ~&m) <=> (n = 0) /\ (m = 0)) /\
4301 ((~&n = ~&m) <=> (n = m))
4302Proof
4303 REWRITE_TAC [REAL_INJ, REAL_EQ_NEG] THEN
4304 Q_TAC SUFF_TAC `!n m. (&n = ~&m) <=> (n = 0) /\ (m = 0)` THEN1
4305 METIS_TAC [] THEN
4306 REPEAT GEN_TAC THEN EQ_TAC THENL [
4307 STRIP_TAC THEN
4308 `&n <= ~&m` by METIS_TAC [REAL_LE_ANTISYM] THEN
4309 `0 <= ~&m` by METIS_TAC [REAL_LE_TRANS, REAL_LE,
4310 arithmeticTheory.ZERO_LESS_EQ] THEN
4311 `m <= 0` by METIS_TAC [REAL_LE, REAL_NEG_GE0] THEN
4312 `m = 0` by SRW_TAC [old_ARITH_ss][] THEN
4313 FULL_SIMP_TAC (srw_ss()) [],
4314 SRW_TAC [][]
4315 ]
4316QED
4317
4318val REALMUL_AC = CONV_TAC (AC_CONV (REAL_MUL_ASSOC, REAL_MUL_COMM))
4319
4320Theorem div_ratr:
4321 x / (y / z) = x * z / y
4322Proof
4323 Cases_on ‘y = 0’ >- simp[real_div] >>
4324 Cases_on ‘z = 0’ >- simp[real_div] >>
4325 SRW_TAC [][ui] THEN
4326 FULL_SIMP_TAC (srw_ss()) [] THEN
4327 SRW_TAC [][real_div, REAL_INV_MUL, REAL_INV_EQ_0, REAL_INV_INV] THEN
4328 REALMUL_AC
4329QED
4330
4331Theorem div_ratl:
4332 (x/y) / z = if y = 0 then unint(x/y) / z
4333 else if z = 0 then unint((x/y)/ z)
4334 else x / (y * z)
4335Proof
4336 SRW_TAC [][ui, real_div, REAL_INV_MUL, REAL_INV_EQ_0, REAL_INV_INV] THEN
4337 REALMUL_AC
4338QED
4339
4340Theorem div_rat:
4341 (x/y) / (u/v) =
4342 if (u = 0) \/ (v = 0) then (x/y) / unint (u/v)
4343 else if y = 0 then unint(x/y) / (u/v)
4344 else (x * v) / (y * u)
4345Proof
4346 SRW_TAC [][ui] THEN
4347 FULL_SIMP_TAC (srw_ss()) [] THEN
4348 SRW_TAC [][real_div, REAL_INV_MUL, REAL_INV_EQ_0, REAL_INV_INV] THEN
4349 REALMUL_AC
4350QED
4351
4352Theorem le_rat:
4353 x / &n <= u / &m <=> if n = 0 then unint(x/0) <= u / &m
4354 else if m = 0 then x/ &n <= unint(u/0)
4355 else &m * x <= &n * u
4356Proof
4357 SRW_TAC [][ui] THEN
4358 `0 < m /\ 0 < n` by SRW_TAC [old_ARITH_ss][] THEN
4359 `0 < &m * &n` by SRW_TAC [][REAL_LT_MUL] THEN
4360 POP_ASSUM (ASSUME_TAC o MATCH_MP REAL_LE_LMUL) THEN
4361 POP_ASSUM (fn th => CONV_TAC (LHS_CONV (ONCE_REWRITE_CONV [GSYM th]))) THEN
4362 `&m * &n * (x / &n) = &m * (&n * (x/ &n))` by REALMUL_AC THEN
4363 `&m * &n * (u / &m) = &n * (&m * (u / &m))` by REALMUL_AC THEN
4364 SRW_TAC [][REAL_DIV_LMUL]
4365QED
4366
4367Theorem le_ratl =
4368 SIMP_RULE (srw_ss()) [] (Thm.INST [``m:num`` |-> ``1n``] le_rat);
4369
4370Theorem le_ratr =
4371 SIMP_RULE (srw_ss()) [] (Thm.INST [``n:num`` |-> ``1n``] le_rat);
4372
4373Theorem le_int:
4374 (&n <= &m <=> n <= m) /\
4375 (~&n <= &m <=> T) /\
4376 (&n <= ~&m <=> (n = 0) /\ (m = 0)) /\
4377 (~&n <= ~&m <=> m <= n)
4378Proof
4379 SRW_TAC [][REAL_LE_NEG] THENL [
4380 MATCH_MP_TAC REAL_LE_TRANS THEN
4381 Q.EXISTS_TAC `0` THEN SRW_TAC [][REAL_NEG_LE0],
4382 Cases_on `m` THEN SRW_TAC [][REAL_NEG_LE0] THEN
4383 SRW_TAC [][REAL_NOT_LE] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN
4384 Q.EXISTS_TAC `0` THEN SRW_TAC [][REAL_NEG_LT0]
4385 ]
4386QED
4387
4388Theorem lt_rat:
4389 x / &n < u / &m <=> if n = 0 then unint(x/0) < u / &m
4390 else if m = 0 then x / & n < unint(u/0)
4391 else &m * x < &n * u
4392Proof
4393 SRW_TAC [][ui] THEN
4394 `0 < m /\ 0 < n` by SRW_TAC [old_ARITH_ss][] THEN
4395 `0 < &m * &n` by SRW_TAC [][REAL_LT_MUL] THEN
4396 POP_ASSUM (ASSUME_TAC o MATCH_MP REAL_LT_LMUL) THEN
4397 POP_ASSUM (fn th => CONV_TAC (LHS_CONV (ONCE_REWRITE_CONV [GSYM th]))) THEN
4398 `&m * &n * (x / &n) = &m * (&n * (x / &n))` by REALMUL_AC THEN
4399 `&m * &n * (u / &m) = &n * (&m * (u / &m))` by REALMUL_AC THEN
4400 SRW_TAC [][REAL_DIV_LMUL]
4401QED
4402
4403Theorem lt_ratl =
4404 SIMP_RULE (srw_ss()) [] (Thm.INST [``m:num`` |-> ``1n``] lt_rat);
4405
4406Theorem lt_ratr =
4407 SIMP_RULE (srw_ss()) [] (Thm.INST [``n:num`` |-> ``1n``] lt_rat);
4408
4409Theorem lt_int:
4410 (&n < &m <=> n < m) /\
4411 (~&n < &m <=> ~(n = 0) \/ ~(m = 0)) /\
4412 (&n < ~&m <=> F) /\
4413 (~&n < ~&m <=> m < n)
4414Proof
4415 SRW_TAC [][REAL_LT_NEG] THENL [
4416 Cases_on `m` THEN SRW_TAC [old_ARITH_ss][REAL_NEG_LT0] THEN
4417 MATCH_MP_TAC REAL_LET_TRANS THEN Q.EXISTS_TAC `0` THEN
4418 SRW_TAC [old_ARITH_ss][REAL_NEG_LE0],
4419 SRW_TAC [][REAL_NOT_LT] THEN MATCH_MP_TAC REAL_LE_TRANS THEN
4420 Q.EXISTS_TAC `0` THEN SRW_TAC [][REAL_NEG_LE0]
4421 ]
4422QED
4423
4424(*---------------------------------------------------------------------------*)
4425(* Floor and ceiling (nums) (NOTE: Their definitions are moved to realax) *)
4426(*---------------------------------------------------------------------------*)
4427
4428Theorem NUM_FLOOR_def = NUM_FLOOR_def
4429Theorem NUM_CEILING_def = NUM_CEILING_def
4430
4431val lem = SIMP_RULE arith_ss [REAL_POS,REAL_ADD_RID]
4432 (Q.SPECL[`y`,`&n`,`0r`,`1r`] REAL_LTE_ADD2);
4433
4434Theorem add1_gt_exists[local]:
4435 !y : real. ?n. & (n + 1) > y
4436Proof
4437 GEN_TAC THEN Q.SPEC_THEN `1` MP_TAC REAL_ARCH THEN
4438 SIMP_TAC (srw_ss()) [] THEN
4439 DISCH_THEN (Q.SPEC_THEN `y` STRIP_ASSUME_TAC) THEN
4440 Q.EXISTS_TAC `n` THEN
4441 SIMP_TAC arith_ss [GSYM REAL_ADD,real_gt,REAL_LT_ADDL,REAL_LT_ADDR] THEN
4442 METIS_TAC [lem]
4443QED
4444
4445Theorem lt_add1_exists[local]:
4446 !y: real. ?n. y < &(n + 1)
4447Proof
4448 GEN_TAC THEN Q.SPEC_THEN `1` MP_TAC REAL_ARCH THEN
4449 SIMP_TAC (srw_ss()) [] THEN
4450 DISCH_THEN (Q.SPEC_THEN `y` STRIP_ASSUME_TAC) THEN
4451 Q.EXISTS_TAC `n` THEN
4452 SIMP_TAC bool_ss [GSYM REAL_ADD] THEN METIS_TAC [lem]
4453QED
4454
4455Theorem NUM_FLOOR_LE:
4456 0 <= x ==> &(NUM_FLOOR x) <= x
4457Proof
4458 SRW_TAC [][NUM_FLOOR_def] THEN
4459 LEAST_ELIM_TAC THEN
4460 SRW_TAC [][add1_gt_exists] THEN
4461 Cases_on `n` THEN SRW_TAC [][] THEN
4462 FIRST_X_ASSUM (Q.SPEC_THEN `n'` MP_TAC) THEN
4463 SRW_TAC [old_ARITH_ss] [real_gt, REAL_NOT_LT, ADD1]
4464QED
4465
4466Theorem NUM_FLOOR_LE2:
4467 0 <= y ==> (x <= NUM_FLOOR y <=> &x <= y)
4468Proof
4469 SRW_TAC [][NUM_FLOOR_def] THEN LEAST_ELIM_TAC THEN
4470 SRW_TAC [][lt_add1_exists, real_gt,REAL_NOT_LT, EQ_IMP_THM]
4471 THENL [
4472 Cases_on `n` THENL [
4473 FULL_SIMP_TAC (srw_ss()) [],
4474 FIRST_X_ASSUM (Q.SPEC_THEN `n'` MP_TAC) THEN
4475 FULL_SIMP_TAC (bool_ss ++ old_ARITH_ss)
4476 [ADD1, GSYM REAL_ADD, GSYM REAL_LE] THEN
4477 METIS_TAC [REAL_LE_TRANS]
4478 ],
4479 `&x < &(n + 1):real` by PROVE_TAC [REAL_LET_TRANS] THEN
4480 FULL_SIMP_TAC (srw_ss() ++ old_ARITH_ss) []
4481 ]
4482QED
4483
4484Theorem NUM_FLOOR_MONO :
4485 !x y. 0 <= x /\ 0 <= y /\ x <= y ==> NUM_FLOOR x <= NUM_FLOOR y
4486Proof
4487 rpt STRIP_TAC
4488 >> ASM_SIMP_TAC std_ss [NUM_FLOOR_LE2]
4489 >> MATCH_MP_TAC REAL_LE_TRANS
4490 >> Q.EXISTS_TAC ‘x’
4491 >> ASM_SIMP_TAC std_ss [NUM_FLOOR_LE]
4492QED
4493
4494Theorem NUM_FLOOR_LET:
4495 (NUM_FLOOR x <= y) <=> (x < &y + 1)
4496Proof
4497 SRW_TAC [][NUM_FLOOR_def] THEN LEAST_ELIM_TAC THEN
4498 SRW_TAC [][lt_add1_exists, real_gt,REAL_NOT_LT, EQ_IMP_THM]
4499 THENL [
4500 FULL_SIMP_TAC bool_ss [GSYM REAL_LE,GSYM REAL_ADD] THEN
4501 MATCH_MP_TAC REAL_LTE_TRANS THEN
4502 Q.EXISTS_TAC `&n + 1` THEN SRW_TAC [][],
4503 Cases_on `n` THEN SRW_TAC [][] THEN
4504 FIRST_X_ASSUM (Q.SPEC_THEN `n'` MP_TAC) THEN
4505 FULL_SIMP_TAC (bool_ss ++ old_ARITH_ss) [ADD1] THEN
4506 STRIP_TAC THEN
4507 `&(n' + 1) < &(y + 1):real` by METIS_TAC [REAL_LET_TRANS] THEN
4508 FULL_SIMP_TAC (srw_ss() ++ old_ARITH_ss) []
4509 ]
4510QED
4511
4512Theorem NUM_FLOOR_LT :
4513 !x :real. x - 1 < &(NUM_FLOOR x)
4514Proof
4515 RW_TAC std_ss [REAL_LT_SUB_RADD, GSYM NUM_FLOOR_LET]
4516QED
4517
4518Theorem NUM_FLOOR_DIV:
4519 0 <= x /\ 0 < y ==> &(NUM_FLOOR (x / y)) * y <= x
4520Proof
4521 SRW_TAC [][NUM_FLOOR_def] THEN LEAST_ELIM_TAC THEN
4522 SRW_TAC [][add1_gt_exists] THEN
4523 Cases_on `n` THEN1 SRW_TAC [][] THEN
4524 FIRST_X_ASSUM (Q.SPEC_THEN `n'` MP_TAC) THEN
4525 SRW_TAC [old_ARITH_ss] [real_gt,REAL_NOT_LT,ADD1,REAL_LE_RDIV_EQ]
4526QED
4527
4528Theorem NUM_FLOOR_DIV_LOWERBOUND:
4529 0 <= x:real /\ 0 < y:real ==> x < &(NUM_FLOOR (x/y) + 1) * y
4530Proof
4531 SRW_TAC [][NUM_FLOOR_def] THEN LEAST_ELIM_TAC THEN
4532 SRW_TAC [][add1_gt_exists] THEN Cases_on `n` THEN
4533 POP_ASSUM MP_TAC THEN SRW_TAC [][real_gt, REAL_LT_LDIV_EQ]
4534QED
4535
4536Theorem NUM_FLOOR_BASE:
4537 !r. r < 1 ==> (NUM_FLOOR r = 0)
4538Proof
4539 SRW_TAC [] [NUM_FLOOR_def]
4540 THEN numLib.LEAST_ELIM_TAC
4541 THEN SRW_TAC [] []
4542 THEN1 (Q.EXISTS_TAC `0` THEN ASM_SIMP_TAC std_ss [real_gt])
4543 THEN Cases_on `n = 0`
4544 THEN1 ASM_REWRITE_TAC []
4545 THEN `0 < n` by DECIDE_TAC
4546 THEN RES_TAC
4547 THEN FULL_SIMP_TAC arith_ss [real_gt]
4548QED
4549
4550val lem =
4551 metisLib.METIS_PROVE [REAL_LT_01, REAL_LET_TRANS]
4552 ``!r: real. r <= 0 ==> r < 1``
4553
4554Theorem NUM_FLOOR_NEG[local]:
4555 NUM_FLOOR (~real_of_num n) = 0
4556Proof
4557 MATCH_MP_TAC NUM_FLOOR_BASE
4558 THEN MATCH_MP_TAC lem
4559 THEN REWRITE_TAC [REAL_NEG_LE0, REAL_POS]
4560QED
4561
4562Theorem NUM_FLOOR_NEGQ[local]:
4563 0 < m ==> (NUM_FLOOR (~real_of_num n / real_of_num m) = 0)
4564Proof
4565 ONCE_REWRITE_TAC [GSYM REAL_LT]
4566 THEN STRIP_TAC
4567 THEN MATCH_MP_TAC NUM_FLOOR_BASE
4568 THEN ASM_SIMP_TAC std_ss [REAL_LT_LDIV_EQ, REAL_MUL_LID, lt_int]
4569 THEN FULL_SIMP_TAC arith_ss [REAL_LT]
4570QED
4571
4572Theorem NUM_FLOOR_EQNS:
4573 (NUM_FLOOR (real_of_num n) = n) /\
4574 (NUM_FLOOR (~real_of_num n) = 0) /\
4575 (0 < m ==> (NUM_FLOOR (real_of_num n / real_of_num m) = n DIV m)) /\
4576 (0 < m ==> (NUM_FLOOR (~real_of_num n / real_of_num m) = 0))
4577Proof
4578 REWRITE_TAC [NUM_FLOOR_NEG, NUM_FLOOR_NEGQ]
4579 THEN SRW_TAC [][NUM_FLOOR_def] THEN LEAST_ELIM_TAC THENL [
4580 SIMP_TAC (srw_ss()) [real_gt, REAL_LT] THEN
4581 CONJ_TAC THENL
4582 [Q.EXISTS_TAC `n` THEN RW_TAC old_arith_ss [],
4583 Cases THEN FULL_SIMP_TAC old_arith_ss []
4584 THEN STRIP_TAC
4585 THEN Q.PAT_X_ASSUM `$! M` (MP_TAC o Q.SPEC `n''`)
4586 THEN RW_TAC old_arith_ss []],
4587 ASM_SIMP_TAC (srw_ss()) [real_gt, REAL_LT_LDIV_EQ] THEN
4588 CONJ_TAC THENL [
4589 Q.EXISTS_TAC `n` THEN
4590 SRW_TAC [][RIGHT_ADD_DISTRIB] THEN
4591 MATCH_MP_TAC LESS_EQ_LESS_TRANS THEN
4592 Q.EXISTS_TAC `n * m` THEN
4593 SRW_TAC [old_ARITH_ss][] THEN
4594 CONV_TAC (LAND_CONV (REWR_CONV (GSYM MULT_RIGHT_1))) THEN
4595 SRW_TAC [old_ARITH_ss][],
4596 Q.HO_MATCH_ABBREV_TAC
4597 `!p:num. (!i. i < p ==> ~(n < (i + 1) * m)) /\ n < (p + 1) * m
4598 ==> (p = n DIV m)` THEN
4599 REPEAT STRIP_TAC THEN
4600 CONV_TAC (REWR_CONV EQ_SYM_EQ) THEN
4601 MATCH_MP_TAC DIV_UNIQUE THEN
4602 `(p = 0) \/ (?p0. p = SUC p0)`
4603 by PROVE_TAC [arithmeticTheory.num_CASES] THEN
4604 FULL_SIMP_TAC (srw_ss() ++ old_ARITH_ss)
4605 [ADD1,RIGHT_ADD_DISTRIB] THEN
4606 FIRST_X_ASSUM (Q.SPEC_THEN `p0` MP_TAC) THEN
4607 SRW_TAC [old_ARITH_ss][NOT_LESS] THEN
4608 Q.EXISTS_TAC `n - (m + p0 * m)` THEN
4609 SRW_TAC [old_ARITH_ss][]
4610 ]
4611 ]
4612QED
4613
4614Theorem NUM_FLOOR_LOWER_BOUND:
4615 (x:real < &n) <=> (NUM_FLOOR(x+1) <= n)
4616Proof
4617 MP_TAC (Q.INST [`x` |-> `x + 1`, `y` |-> `n`] NUM_FLOOR_LET) THEN
4618 SIMP_TAC (srw_ss()) []
4619QED
4620
4621Theorem NUM_FLOOR_upper_bound:
4622 (&n <= x:real) <=> (n < NUM_FLOOR(x + 1))
4623Proof
4624 MP_TAC (AP_TERM negation NUM_FLOOR_LOWER_BOUND) THEN
4625 PURE_REWRITE_TAC [REAL_NOT_LT, NOT_LESS_EQUAL,IMP_CLAUSES]
4626QED
4627
4628Theorem NUM_FLOOR_upper_bound' :
4629 !x n. 1 < x ==> (n < NUM_FLOOR x <=> &n <= x - 1)
4630Proof
4631 rpt STRIP_TAC
4632 >> rw [NUM_FLOOR_upper_bound, REAL_SUB_ADD]
4633QED
4634
4635Theorem NUM_FLOOR_POS :
4636 !x. 0 < NUM_FLOOR x <=> 1 <= x
4637Proof
4638 Q.X_GEN_TAC ‘x’
4639 >> EQ_TAC
4640 >- (DISCH_TAC >> CCONTR_TAC \\
4641 ‘x < 1’ by rw [real_lt] \\
4642 ‘flr x = 0’ by rw [NUM_FLOOR_BASE] \\
4643 fs [])
4644 >> DISCH_TAC
4645 >> ‘x = 1 \/ 1 < x’ by PROVE_TAC [REAL_LE_LT]
4646 >- rw [NUM_FLOOR_EQNS]
4647 >> rw [NUM_FLOOR_upper_bound', REAL_SUB_LE]
4648QED
4649
4650Theorem NUM_FLOOR_lower_bound :
4651 !x. 1 <= x ==> x / 2 < &NUM_FLOOR(x)
4652Proof
4653 rpt STRIP_TAC
4654 >> SRW_TAC [] [NUM_FLOOR_def]
4655 >> numLib.LEAST_ELIM_TAC
4656 >> RW_TAC arith_ss [add1_gt_exists, real_gt]
4657 >> Cases_on ‘n = 0’ >- (FULL_SIMP_TAC arith_ss [] \\
4658 PROVE_TAC [REAL_LET_ANTISYM])
4659 >> ‘0 < n’ by DECIDE_TAC
4660 >> ‘0 < (2 :real)’ by SRW_TAC [][]
4661 >> Cases_on ‘n = 1’
4662 >- (FULL_SIMP_TAC arith_ss [REAL_LT_LDIV_EQ, REAL_MUL_LID])
4663 >> ‘1 < n’ by DECIDE_TAC
4664 >> RW_TAC arith_ss [REAL_LT_LDIV_EQ]
4665 >> MATCH_MP_TAC REAL_LT_TRANS
4666 >> Q.EXISTS_TAC ‘&(n + 1)’
4667 >> RW_TAC arith_ss [REAL_MUL, REAL_LT, real_of_num]
4668QED
4669
4670Theorem NUM_FLOOR_MUL_LOWERBOUND : (* cf. NUM_FLOOR_DIV_LOWERBOUND *)
4671 !(n :num) (x :real). 1 < n /\ 1 <= x ==> x < &(n * flr x)
4672Proof
4673 RW_TAC std_ss [GSYM REAL_MUL]
4674 >> ‘0 <= x’ by PROVE_TAC [REAL_LE_01, REAL_LE_TRANS]
4675 >> MATCH_MP_TAC REAL_LTE_TRANS
4676 >> Q.EXISTS_TAC ‘2 * &flr x’
4677 >> reverse CONJ_TAC
4678 >- (MATCH_MP_TAC REAL_LE_RMUL_IMP \\
4679 RW_TAC arith_ss [REAL_LE])
4680 >> ONCE_REWRITE_TAC [REAL_MUL_COMM]
4681 >> ‘0 < (2 :real)’ by SRW_TAC [][]
4682 >> ASM_SIMP_TAC std_ss [GSYM REAL_LT_LDIV_EQ]
4683 >> MATCH_MP_TAC NUM_FLOOR_lower_bound
4684 >> ASM_REWRITE_TAC []
4685QED
4686
4687Theorem NUM_CEILING_NUM_FLOOR:
4688 !r. NUM_CEILING r =
4689 let n = NUM_FLOOR r in
4690 if r <= 0 \/ (r = real_of_num n) then n else n + 1
4691Proof
4692 SRW_TAC [boolSimps.LET_ss] [NUM_CEILING_def, NUM_FLOOR_BASE]
4693 THEN1 (IMP_RES_TAC lem
4694 THEN ASM_SIMP_TAC std_ss [NUM_FLOOR_BASE]
4695 THEN numLib.LEAST_ELIM_TAC
4696 THEN CONJ_TAC
4697 THEN1 METIS_TAC []
4698 THEN SRW_TAC [] []
4699 THEN FULL_SIMP_TAC std_ss [REAL_NOT_LE]
4700 THEN SPOSE_NOT_THEN STRIP_ASSUME_TAC
4701 THEN `0 < n` by DECIDE_TAC
4702 THEN METIS_TAC [REAL_LTE_ANTSYM])
4703 THEN1 (POP_ASSUM (fn th => CONV_TAC (LHS_CONV (ONCE_REWRITE_CONV [th])))
4704 THEN SRW_TAC [] [NUM_FLOOR_LET, NUM_FLOOR_def, real_gt])
4705 THEN FULL_SIMP_TAC std_ss [REAL_NOT_LE]
4706 THEN numLib.LEAST_ELIM_TAC
4707 THEN CONJ_TAC
4708 THEN1 (Q.EXISTS_TAC `flr r + 1`
4709 THEN Cases_on `r < 1`
4710 THEN1 SRW_TAC [] [NUM_FLOOR_BASE, REAL_LT_IMP_LE]
4711 THEN `0 <= r` by METIS_TAC [REAL_NOT_LT, REAL_LE_01, REAL_LE_TRANS]
4712 THEN METIS_TAC
4713 [NUM_FLOOR_DIV_LOWERBOUND
4714 |> Q.INST [`y` |-> `1r`]
4715 |> SIMP_RULE (srw_ss()) [],
4716 REAL_LT_IMP_LE])
4717 THEN SRW_TAC [] []
4718 THEN Q.PAT_X_ASSUM `x <> y` MP_TAC
4719 THEN SIMP_TAC std_ss [NUM_FLOOR_def]
4720 THEN numLib.LEAST_ELIM_TAC
4721 THEN CONJ_TAC
4722 THEN1 (Q.EXISTS_TAC `n`
4723 THEN ASM_SIMP_TAC std_ss [real_gt, GSYM REAL_ADD, REAL_LT_ADD1])
4724 THEN SRW_TAC [] [real_gt]
4725 THEN FULL_SIMP_TAC std_ss [REAL_NOT_LE, REAL_NOT_LT]
4726 THEN Cases_on `n' + 1 < n`
4727 THEN1 METIS_TAC [REAL_LT_ANTISYM]
4728 THEN Cases_on `n' + 1 = n`
4729 THEN1 ASM_REWRITE_TAC []
4730 THEN `n < n' + 1` by DECIDE_TAC
4731 THEN Cases_on `n = 0`
4732 THEN FULL_SIMP_TAC std_ss []
4733 THEN1 METIS_TAC [REAL_LET_ANTISYM]
4734 THEN `n - 1 < n'` by DECIDE_TAC
4735 THEN RES_TAC
4736 THEN FULL_SIMP_TAC arith_ss []
4737 THEN REV_FULL_SIMP_TAC std_ss [DECIDE ``n <> 0n ==> (n - 1 + 1 = n)``]
4738 THEN IMP_RES_TAC REAL_LE_ANTISYM
4739 THEN FULL_SIMP_TAC (srw_ss()) []
4740 THEN `n' - 1 < n'` by DECIDE_TAC
4741 THEN RES_TAC
4742 THEN FULL_SIMP_TAC arith_ss []
4743QED
4744
4745Theorem SIMP_REAL_ARCH_SUC :
4746 !(x :real). 0 <= x ==> ?n. &n <= x /\ x < &SUC n
4747Proof
4748 rpt STRIP_TAC
4749 >> Q.EXISTS_TAC ‘flr x’
4750 >> ASM_SIMP_TAC std_ss [NUM_FLOOR_LE, ADD1, GSYM REAL_OF_NUM_ADD]
4751 >> MP_TAC (Q.SPEC ‘x’ NUM_FLOOR_LT)
4752 >> REAL_ARITH_TAC
4753QED
4754
4755(*---------------------------------------------------------------------------*)
4756(* Ceiling function *)
4757(*---------------------------------------------------------------------------*)
4758
4759Theorem LE_NUM_CEILING:
4760 !x. x <= &(clg x)
4761Proof
4762 RW_TAC std_ss [NUM_CEILING_def]
4763 THEN numLib.LEAST_ELIM_TAC
4764 THEN Q.SPEC_THEN `1` MP_TAC REAL_ARCH
4765 THEN SIMP_TAC (srw_ss()) []
4766 THEN METIS_TAC [REAL_LT_IMP_LE]
4767QED
4768
4769Theorem NUM_CEILING_BASE:
4770 !x. x <= 0 ==> clg x = 0
4771Proof
4772 metis_tac[NUM_FLOOR_BASE, REAL_LT_ADD1, REAL_ADD_LID,
4773 REWRITE_RULE [boolTheory.LET_THM] NUM_CEILING_NUM_FLOOR]
4774QED
4775
4776Theorem NUM_CEILING_LE:
4777 !x n. x <= &n ==> clg(x) <= n
4778Proof
4779 RW_TAC std_ss [NUM_CEILING_def]
4780 THEN numLib.LEAST_ELIM_TAC
4781 THEN METIS_TAC [NOT_LESS_EQUAL]
4782QED
4783
4784Theorem NUM_CEILING_UPPER_BOUND :
4785 !x. 0 <= x ==> &(clg x) < x + 1
4786Proof
4787 RW_TAC std_ss [NUM_CEILING_def]
4788 >> numLib.LEAST_ELIM_TAC
4789 >> REWRITE_TAC [SIMP_REAL_ARCH]
4790 >> RW_TAC arith_ss []
4791 >> FULL_SIMP_TAC arith_ss [GSYM real_lt]
4792 >> Q.PAT_X_ASSUM `!m. P` (MP_TAC o Q.SPEC `n-1`)
4793 >> RW_TAC arith_ss []
4794 >> Cases_on `n = 0` >- METIS_TAC [REAL_LET_ADD2, REAL_LT_01, REAL_ADD_RID]
4795 >> `0 < n` by RW_TAC arith_ss []
4796 >> `&(n - 1) < x:real` by RW_TAC arith_ss []
4797 >> `0 <= n-1` by RW_TAC arith_ss []
4798 >> `0:real <= (&(n-1))` by SRW_TAC[][]
4799 >> `0 < x` by METIS_TAC [REAL_LET_TRANS]
4800 >> Cases_on `n = 1`
4801 >- METIS_TAC [REAL_LE_REFL, REAL_ADD_RID, REAL_LTE_ADD2, REAL_ADD_COMM]
4802 >> `0 <> n-1` by RW_TAC arith_ss []
4803 >> `&n - 1 < x` by RW_TAC arith_ss [REAL_SUB]
4804 >> FULL_SIMP_TAC std_ss [REAL_LT_SUB_RADD]
4805QED
4806
4807(* backward compatible name of NUM_CEILING_UPPER_BOUND *)
4808Theorem CLG_UBOUND = NUM_CEILING_UPPER_BOUND
4809
4810Theorem NUM_CEILING_NUM[simp]:
4811 clg (&n) = n
4812Proof
4813 simp[NUM_CEILING_def]
4814QED
4815
4816Theorem NUM_CEILING_MONO:
4817 !r s. r <= s ==> clg r <= clg s
4818Proof
4819 rpt strip_tac >> irule NUM_CEILING_LE >> simp[NUM_CEILING_def] >>
4820 numLib.LEAST_ELIM_TAC >> simp[SIMP_REAL_ARCH] >>
4821 metis_tac[REAL_LE_TRANS]
4822QED
4823
4824(* ----------------------------------------------------------------------
4825 nonzerop : real -> real
4826
4827 a helper for normalisation: x * inv x = nonzerop x
4828 ---------------------------------------------------------------------- *)
4829
4830Definition nonzerop_def:
4831 nonzerop r = if r = 0r then 0r else 1r
4832End
4833Overload NZ = “nonzerop”
4834
4835Theorem nonzerop_mulXX[simp]:
4836 nonzerop r * nonzerop r = nonzerop r
4837Proof
4838 rw[nonzerop_def]
4839QED
4840
4841Theorem nonzerop_0[simp]:
4842 nonzerop 0 = 0
4843Proof
4844 rw[nonzerop_def]
4845QED
4846
4847Theorem nonzerop_NUMERAL[simp]:
4848 (NZ (&NUMERAL (BIT1 n)) = 1) /\ (NZ (&NUMERAL (BIT2 n)) = 1)
4849Proof
4850 REWRITE_TAC[NUMERAL_DEF, BIT1, BIT2, ALT_ZERO, ADD_CLAUSES,
4851 nonzerop_def, REAL_OF_NUM_EQ, NOT_SUC]
4852QED
4853
4854Theorem REAL_INV_nonzerop:
4855 (x * inv x = nonzerop x) /\ (inv x * x = nonzerop x)
4856Proof
4857 rw[nonzerop_def, REAL_MUL_LINV, REAL_MUL_RINV]
4858QED
4859
4860Theorem nonzerop_mult[simp]:
4861 nonzerop (x * y) = nonzerop x * nonzerop y
4862Proof
4863 rw[nonzerop_def]
4864QED
4865
4866Theorem nonzerop_nonzerop[simp]:
4867 NZ (NZ x) = NZ x
4868Proof
4869 rw[nonzerop_def] >> fs[]
4870QED
4871
4872Theorem nonzerop_EQ0[simp]:
4873 (NZ r = 0) <=> (r = 0)
4874Proof
4875 rw[nonzerop_def]
4876QED
4877
4878Theorem nonzerop_EQ1_I[simp]:
4879 r <> 0 ==> (nonzerop r = 1)
4880Proof
4881 rw[nonzerop_def]
4882QED
4883
4884Theorem nonzerop_inv[simp]:
4885 nonzerop (inv x) = nonzerop x
4886Proof
4887 rw[nonzerop_def] >> fs[REAL_INV_EQ_0, REAL_INV_0]
4888QED
4889
4890Theorem pow_eq0[simp]:
4891 (x pow y = 0) <=> (x = 0) /\ 0 < y
4892Proof
4893 Induct_on ‘y’ >> simp[pow, EQ_IMP_THM, DISJ_IMP_THM]
4894QED
4895
4896Theorem nonzerop_pow[simp]:
4897 nonzerop (x pow n) = nonzerop x pow n
4898Proof
4899 simp[nonzerop_def, pow] >> Cases_on ‘x = 0’ >> simp[] >> rw[] >>
4900 Cases_on ‘n’ >> simp[pow]
4901QED
4902
4903Theorem nonzerop_nonzero_pow:
4904 0 < n ==> (nonzerop x pow n = nonzerop x)
4905Proof
4906 Induct_on ‘n’ >> simp[pow] >> Cases_on ‘0 < n’ >> fs[]
4907QED
4908
4909Theorem pow_inv_mul:
4910 0 < n ==> (x pow n * inv x = x pow (n - 1) * NZ x)
4911Proof
4912 Cases_on ‘n’ >> simp[pow] >>
4913 metis_tac[REAL_MUL_ASSOC, REAL_MUL_COMM, REAL_INV_nonzerop]
4914QED
4915
4916Theorem POW_0':
4917 0 < n ==> (0 pow n = 0)
4918Proof
4919 Cases_on ‘n’ >> simp[POW_0]
4920QED
4921
4922Theorem pow_inv_mul_powlt:
4923 !x m n. m < n ==> (x pow m * inv x pow n = inv x pow (n - m))
4924Proof
4925 rpt strip_tac >>
4926 qabbrev_tac ‘d = n - m’ >> ‘0 < d’ by simp[Abbr‘d’] >>
4927 ‘n = m + d’ by simp[Abbr‘d’] >>
4928 Cases_on ‘x = 0’ >>
4929 simp[nonzerop_EQ1_I, REAL_INV_0, REAL_POW_INV, REAL_POW_ADD,
4930 REAL_INV_MUL, POW_0'] >>
4931 qmatch_abbrev_tac ‘XM * (XDi * inv XM) = XDi’ >>
4932 ‘XM * (XDi * inv XM) = (XM * inv XM) * XDi’
4933 by simp[simpLib.AC REAL_MUL_ASSOC REAL_MUL_COMM] >>
4934 ‘XM <> 0’ by simp[Abbr‘XM’] >>
4935 simp[REAL_MUL_RINV]
4936QED
4937
4938Theorem pow_inv_mul_invlt:
4939 !x m n. n < m ==> (x pow m * inv x pow n = x pow (m - n))
4940Proof
4941 rpt strip_tac >>
4942 qabbrev_tac ‘d = m - n’ >> ‘0 < d /\ (m = n + d)’ by simp[Abbr‘d’] >>
4943 Cases_on ‘x = 0’ >>
4944 simp[nonzerop_EQ1_I, REAL_INV_0, REAL_POW_INV, REAL_POW_ADD,
4945 REAL_INV_MUL, POW_0'] >>
4946 ‘x pow n <> 0’ by simp[] >>
4947 metis_tac[REAL_MUL_ASSOC, REAL_MUL_RINV, REAL_MUL_RID]
4948QED
4949
4950Theorem pow_inv_eq:
4951 x pow m * inv x pow m = NZ x pow m
4952Proof
4953 Cases_on ‘x = 0’ >> simp[nonzerop_EQ1_I, REAL_POW_INV, REAL_MUL_RINV] >>
4954 Cases_on ‘m’ >> simp[pow]
4955QED
4956
4957Theorem ZERO_LT_POW[simp]:
4958 (0 < x pow NUMERAL (BIT2 n) <=> x <> 0) /\
4959 (0 < x pow NUMERAL (BIT1 n) <=> 0 < x)
4960Proof
4961 REWRITE_TAC[NUMERAL_DEF, BIT2, BIT1, ADD_CLAUSES] >>
4962 simp[EQ_IMP_THM] >> rpt strip_tac
4963 >- fs[pow]
4964 >- (‘SUC (SUC (2 * n)) = 2 * (n + 1)’ by simp[] >>
4965 simp[GSYM REAL_POW_POW, POW_2, REAL_POW_LT])
4966 >- (fs[pow] >> Cases_on ‘x = 0’ >> fs[] >>
4967 ‘0 < x pow (2 * n)’ suffices_by metis_tac[REAL_LT_RMUL_0] >>
4968 simp[GSYM REAL_POW_POW, POW_2, REAL_POW_LT]) >>
4969 simp[pow] >> ‘0 < x pow (2 * n)’ suffices_by metis_tac[REAL_LT_RMUL_0] >>
4970 simp[GSYM REAL_POW_POW, POW_2, REAL_POW_LT]
4971QED
4972
4973Theorem REAL_INV_LT0[simp]:
4974 inv x < 0 <=> x < 0
4975Proof
4976 PURE_ONCE_REWRITE_TAC[DECIDE “(p <=> q) <=> (~p <=> ~q)”] >>
4977 PURE_REWRITE_TAC [REAL_NOT_LT] >> simp[]
4978QED
4979
4980Theorem REAL_POW_POS:
4981 0 < x pow n <=> (n = 0) \/ 0 < x \/ x < 0 /\ EVEN n
4982Proof
4983 Induct_on ‘n’ >> simp[pow] >> eq_tac >> simp[EVEN] >>
4984 Cases_on ‘EVEN n’ >> fs[]
4985 >- (Cases_on ‘0 < x pow n’ >> simp[REAL_LT_RMUL_0] >> rfs[] >>
4986 fs[REAL_NOT_LT] >> ‘x = 0’ by metis_tac[REAL_LE_ANTISYM] >>
4987 simp[])
4988 >- (Cases_on ‘0 < x pow n’ >> simp[REAL_LT_RMUL_0] >> rfs[] >>
4989 fs[REAL_NOT_LT] >> fs[REAL_LE_LT])
4990 >- simp[REAL_LT_LMUL_0]
4991 >- (strip_tac >> simp[REAL_LT_LMUL_0] >>
4992 Cases_on ‘0 < x pow n’ >> simp[REAL_LT_RMUL_0] >> rfs[] >> fs[] >>
4993 fs[REAL_NOT_LT] >> fs[REAL_LE_LT] >> fs[] >> rfs[] >>
4994 metis_tac[REAL_NEG_GT0, REAL_NEG_MUL2, REAL_LT_MUL])
4995QED
4996
4997(* cf. realaxTheory.REAL_POW_NEG (different statements) *)
4998Theorem REAL_POW_NEG[simp] :
4999 x pow n < 0 <=> ODD n /\ x < 0
5000Proof
5001 ‘!r. r < 0 <=> r <> 0 /\ ~(0 < r)’
5002 by metis_tac[REAL_LT_NEGTOTAL,REAL_NEG_GT0,REAL_LT_REFL,REAL_LT_ANTISYM] >>
5003 pop_assum (fn th => simp[SimpLHS, th]) >>
5004 simp[REAL_POW_POS] >> csimp[REAL_NOT_LT, arithmeticTheory.ODD_EVEN] >>
5005 csimp[REAL_LE_LT] >>
5006 metis_tac[REAL_LT_REFL, arithmeticTheory.EVEN, REAL_LT_ANTISYM]
5007QED
5008
5009(* !x n. -x pow n = if EVEN n then x pow n else -(x pow n) *)
5010Theorem REAL_POW_NEG2 = realaxTheory.REAL_POW_NEG;
5011
5012Theorem REAL_POW_GE0[simp]:
5013 0 <= x pow n <=> 0 <= x \/ EVEN n
5014Proof
5015 PURE_ONCE_REWRITE_TAC[DECIDE “(p <=> q) <=> (~p <=> ~q)”] >>
5016 PURE_REWRITE_TAC[REAL_NOT_LE] >>
5017 simp[REAL_POW_NEG, REAL_NOT_LE, arithmeticTheory.ODD_EVEN, CONJ_COMM]
5018QED
5019
5020(* recovered from transc.ml *)
5021Theorem REAL_POW_LE :
5022 !x n. 0 <= x ==> 0 <= x pow n
5023Proof
5024 RW_TAC std_ss [REAL_POW_GE0]
5025QED
5026
5027Theorem REAL_POW_LE0:
5028 x pow n <= 0 <=> 0 < n /\ (x = 0) \/ x < 0 /\ ODD n
5029Proof
5030 PURE_ONCE_REWRITE_TAC[DECIDE “(p <=> q) <=> (~p <=> ~q)”] >>
5031 PURE_REWRITE_TAC[REAL_NOT_LE] >>
5032 simp[REAL_POW_POS] >>
5033 csimp[arithmeticTheory.ODD_EVEN, REAL_NOT_LT, REAL_LE_LT] >>
5034 Cases_on ‘n = 0’ >> simp[] >> Cases_on ‘0 < x’ >> csimp[]
5035 >- (strip_tac >> fs[]) >>
5036 fs[REAL_NOT_LT, REAL_LE_LT] >> metis_tac[REAL_LT_REFL]
5037QED
5038
5039Theorem ZERO_LT_invx[simp]:
5040 0 < inv x pow n <=> 0 < x pow n
5041Proof
5042 simp[REAL_POW_POS]
5043QED
5044
5045Theorem REAL_ABS_LE0:
5046 !v.
5047 (abs v <= 0) <=> (v = 0)
5048Proof
5049 fs[ABS_BOUNDS] >> rpt strip_tac >> EQ_TAC >> strip_tac
5050 >> metis_tac[REAL_LE_ANTISYM]
5051QED
5052
5053Theorem REAL_INV_LE_ANTIMONO:
5054 ! x y.
5055 0 < x /\ 0 < y ==> (inv x <= inv y <=> y <= x)
5056Proof
5057 rpt strip_tac
5058 >> `inv x < inv y <=> y < x`
5059 by (match_mp_tac REAL_INV_LT_ANTIMONO >> fs [])
5060 >> EQ_TAC
5061 >> fs [REAL_LE_LT]
5062 >> strip_tac
5063 >> fs [REAL_INV_INJ]
5064QED
5065
5066(* NOTE: ‘0 < x’ is not necessary *)
5067Theorem REAL_INV_LE_ANTIMONO_IMPR:
5068 ! x y.
5069 0 < x /\ 0 < y /\ y <= x ==> inv x <= inv y
5070Proof
5071 rpt strip_tac >> fs[REAL_INV_LE_ANTIMONO]
5072QED
5073
5074Theorem REAL_INV_LE_1 :
5075 !x:real. &1 <= x ==> inv(x) <= &1
5076Proof
5077 REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_INV1] THEN
5078 MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[REAL_LT_01]
5079QED
5080
5081Theorem REAL_INV_1_LE :
5082 !x:real. &0 < x /\ x <= &1 ==> &1 <= inv(x)
5083Proof
5084 REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_INV1] THEN
5085 MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[REAL_LT_01]
5086QED
5087
5088(* NOTE: ‘y < 0’ is not necessary *)
5089Theorem REAL_INV_LE_ANTIMONO_IMPL:
5090 ! x y.
5091 x < 0 /\ y < 0 /\ y <= x ==> inv x <= inv y
5092Proof
5093 rpt strip_tac
5094 >> once_rewrite_tac [GSYM REAL_LE_NEG]
5095 >> `- inv y = inv (- y)` by (irule REAL_NEG_INV >> CCONTR_TAC >> fs[])
5096 >> `- inv x = inv (- x)` by (irule REAL_NEG_INV >> CCONTR_TAC >> fs[])
5097 >> ntac 2(FIRST_X_ASSUM (fn thm => once_rewrite_tac [ thm]))
5098 >> irule REAL_INV_LE_ANTIMONO_IMPR >> fs[]
5099QED
5100
5101Theorem REAL_LE_LMUL_NEG_IMP:
5102 ! a b c.
5103 a <= 0 /\ b <= c ==> a * c <= a * b
5104Proof
5105 rpt strip_tac
5106 >> once_rewrite_tac [SYM (SPEC ``a:real`` REAL_NEG_NEG)]
5107 >> once_rewrite_tac [SYM (SPECL [``a:real``, ``c:real``] REAL_MUL_LNEG)]
5108 >> once_rewrite_tac [REAL_LE_NEG]
5109 >> `0 <= - (a:real)`
5110 by (once_rewrite_tac [SYM (SPEC ``-(a:real)`` REAL_NEG_LE0)]
5111 >> fs [REAL_NEG_NEG])
5112 >> match_mp_tac REAL_LE_LMUL_IMP >> fs[]
5113QED
5114
5115Theorem REAL_DIV_ZERO:
5116 !a b.
5117 (a / b = 0) <=> ((a = 0) \/ (b = 0))
5118Proof
5119 rpt strip_tac \\ EQ_TAC \\ fs[REAL_DIV_LZERO, real_div]
5120QED
5121
5122(* cf. REAL_POW_MONO *)
5123Theorem REAL_POW_ANTIMONO :
5124 !(m :num) n (x :real). 0 < x /\ x <= 1 /\ m <= n ==> x pow n <= x pow m
5125Proof
5126 rpt STRIP_TAC
5127 >> KNOW_TAC “(x :real) pow n <= x pow m <=> inv (x pow m) <= inv (x pow n)”
5128 >- (ONCE_REWRITE_TAC [EQ_SYM_EQ] \\
5129 MATCH_MP_TAC REAL_INV_LE_ANTIMONO \\
5130 rw [REAL_POW_POS])
5131 >> DISCH_THEN (fn th => ONCE_REWRITE_TAC [th])
5132 >> ‘x <> 0’ by PROVE_TAC [REAL_LT_IMP_NE]
5133 >> ASM_SIMP_TAC std_ss [POW_INV]
5134 >> MATCH_MP_TAC REAL_POW_MONO
5135 >> ASM_REWRITE_TAC []
5136 >> MATCH_MP_TAC REAL_INV_1_LE
5137 >> ASM_REWRITE_TAC []
5138QED
5139
5140(* cf. REAL_POW_MONO_LT *)
5141Theorem REAL_POW_ANTIMONO_LT :
5142 !(m :num) n (x :real). 0 < x /\ x < 1 /\ m < n ==> x pow n < x pow m
5143Proof
5144 rpt STRIP_TAC
5145 >> KNOW_TAC “(x :real) pow n < x pow m <=> inv (x pow m) < inv (x pow n)”
5146 >- (ONCE_REWRITE_TAC [EQ_SYM_EQ] \\
5147 MATCH_MP_TAC REAL_INV_LT_ANTIMONO \\
5148 rw [REAL_POW_POS])
5149 >> DISCH_THEN (fn th => ONCE_REWRITE_TAC [th])
5150 >> ‘x <> 0’ by PROVE_TAC [REAL_LT_IMP_NE]
5151 >> ASM_SIMP_TAC std_ss [POW_INV]
5152 >> MATCH_MP_TAC REAL_POW_MONO_LT
5153 >> ASM_REWRITE_TAC []
5154 >> MATCH_MP_TAC REAL_INV_LT1
5155 >> ASM_REWRITE_TAC []
5156QED
5157
5158(* cf. REAL_LT_RDIV *)
5159Theorem REAL_LE_RDIV_CANCEL :
5160 !x y (z :real). 0 < z ==> (x / z <= y / z <=> x <= y)
5161Proof
5162 rpt STRIP_TAC
5163 >> ‘0 < inv z’ by PROVE_TAC [REAL_INV_POS]
5164 >> ASM_SIMP_TAC bool_ss [real_div, REAL_LE_RMUL]
5165QED
5166
5167(* ------------------------------------------------------------------------- *)
5168(* More variants of the Archimedian property and useful consequences. *)
5169(* ------------------------------------------------------------------------- *)
5170
5171Theorem REAL_POW_LBOUND :
5172 !x n. &0 <= x ==> &1 + &n * x <= (&1 + x) pow n
5173Proof
5174 Q.X_GEN_TAC ‘x’
5175 >> SIMP_TAC arith_ss [RIGHT_FORALL_IMP_THM]
5176 >> DISCH_TAC
5177 >> INDUCT_TAC
5178 >> REWRITE_TAC [pow, REAL_MUL_LZERO, REAL_ADD_RID, REAL_LE_REFL]
5179 >> REWRITE_TAC [GSYM REAL_OF_NUM_SUC]
5180 >> MATCH_MP_TAC REAL_LE_TRANS
5181 >> Q.EXISTS_TAC ‘(&1 + x) * (&1 + &n * x)’
5182 >> reverse CONJ_TAC
5183 >- (MATCH_MP_TAC REAL_LE_LMUL_IMP >> ASM_REWRITE_TAC [] \\
5184 MATCH_MP_TAC REAL_LE_TRANS \\
5185 Q.EXISTS_TAC ‘1’ >> ASM_REWRITE_TAC [REAL_LE_01, REAL_LE_ADDR])
5186 >> SIMP_TAC arith_ss [REAL_ADD_RDISTRIB, REAL_ADD_LDISTRIB, REAL_ADD_ASSOC,
5187 REAL_MUL_LID, REAL_MUL_RID]
5188 >> REWRITE_TAC [GSYM REAL_ADD_ASSOC]
5189 >> MATCH_MP_TAC REAL_LE_LADD_IMP
5190 >> REWRITE_TAC [REAL_ADD_ASSOC, REAL_LE_ADDR]
5191 >> MATCH_MP_TAC REAL_LE_MUL >> ASM_REWRITE_TAC []
5192 >> MATCH_MP_TAC REAL_LE_MUL
5193 >> ASM_SIMP_TAC arith_ss [real_of_num, REAL_OF_NUM_LE]
5194QED
5195
5196Theorem REAL_ARCH_POW :
5197 !x y. &1 < x ==> ?n. y < x pow n
5198Proof
5199 rpt STRIP_TAC
5200 >> MP_TAC (Q.SPEC ‘x - &1’ REAL_ARCH)
5201 >> ASM_REWRITE_TAC [REAL_SUB_LT]
5202 >> DISCH_THEN (MP_TAC o SPEC ``y:real``)
5203 >> HO_MATCH_MP_TAC MONO_EXISTS
5204 >> Q.X_GEN_TAC ‘n’
5205 >> DISCH_TAC
5206 >> MATCH_MP_TAC REAL_LTE_TRANS
5207 >> Q.EXISTS_TAC ‘&1 + &n * (x - &1)’
5208 >> CONJ_TAC
5209 >- (MATCH_MP_TAC REAL_LT_TRANS \\
5210 Q.EXISTS_TAC ‘1 + y’ \\
5211 reverse CONJ_TAC >- (ASM_REWRITE_TAC [REAL_LT_LADD]) \\
5212 REWRITE_TAC [REAL_LT_ADDL, REAL_LT_01])
5213 >> MATCH_MP_TAC (REWRITE_RULE [REAL_SUB_ADD2]
5214 (Q.SPECL [‘x - 1’, ‘n’] REAL_POW_LBOUND))
5215 >> REWRITE_TAC [REAL_SUB_LE]
5216 >> MATCH_MP_TAC REAL_LT_IMP_LE >> ASM_REWRITE_TAC []
5217QED
5218
5219Theorem REAL_ARCH_POW_INV :
5220 !x:real y. &0 < y /\ x < &1 ==> ?n. x pow n < y
5221Proof
5222 rpt STRIP_TAC
5223 >> reverse (Cases_on ‘0 < x’)
5224 >- ASM_MESON_TAC[POW_1, REAL_LET_TRANS, REAL_NOT_LT]
5225 >> KNOW_TAC “inv(&1) < inv(x:real)”
5226 >- (MATCH_MP_TAC REAL_LT_INV >> ASM_REWRITE_TAC [])
5227 >> REWRITE_TAC [REAL_INV1]
5228 >> DISCH_THEN (MP_TAC o (Q.SPEC ‘inv y’) o (MATCH_MP REAL_ARCH_POW))
5229 >> STRIP_TAC
5230 >> Q.EXISTS_TAC ‘n’
5231 >> GEN_REWR_TAC BINOP_CONV [GSYM REAL_INV_INV]
5232 >> ASM_SIMP_TAC std_ss [GSYM REAL_POW_INV, REAL_LT_INV_EQ, REAL_LT_INV]
5233QED
5234
5235Theorem REAL_ARCH_POW2 : (* was: REAL_ARCH_POW *)
5236 !x. ?n. x < &2 pow n
5237Proof
5238 SIMP_TAC arith_ss[REAL_ARCH_POW, REAL_LT]
5239QED
5240
5241(* moved here from util_probTheory, needed below and also in metricTheory *)
5242Theorem ADD_POW_2 :
5243 !x y :real. (x + y) pow 2 = x pow 2 + y pow 2 + 2 * x * y
5244Proof
5245 RW_TAC std_ss [REAL_ADD_LDISTRIB, REAL_ADD_RDISTRIB, REAL_ADD_ASSOC, POW_2,
5246 GSYM REAL_DOUBLE]
5247 >> REWRITE_TAC [GSYM REAL_ADD_ASSOC, REAL_EQ_LADD]
5248 >> ‘y * x = x * y’ by PROVE_TAC [REAL_MUL_COMM] >> POP_ORW
5249 >> ‘x * y + y * y = y * y + x * y’ by PROVE_TAC [REAL_ADD_COMM] >> POP_ORW
5250 >> REWRITE_TAC [REAL_ADD_ASSOC, REAL_EQ_RADD]
5251 >> METIS_TAC [REAL_ADD_COMM]
5252QED
5253
5254(* moved here from util_probTheory *)
5255Theorem SUB_POW_2 :
5256 !x y :real. (x - y) pow 2 = x pow 2 + y pow 2 - 2 * x * y
5257Proof
5258 rpt GEN_TAC
5259 >> REWRITE_TAC [SIMP_RULE (srw_ss()) [GSYM real_sub]
5260 (Q.SPECL [‘x’, ‘-y’] ADD_POW_2),
5261 real_sub]
5262 >> AP_TERM_TAC
5263 >> REWRITE_TAC [REAL_MUL_RNEG]
5264QED
5265
5266(* ------------------------------------------------------------------------- *)
5267(* The sign of a real number, as a real number. (ported from HOL-Light) *)
5268(* ------------------------------------------------------------------------- *)
5269
5270Definition real_sgn :
5271 (real_sgn:real->real) x =
5272 if &0 < x then &1 else if x < &0 then ~&1 else &0
5273End
5274
5275Overload sgn = “real_sgn”
5276
5277Theorem REAL_SGN_0 :
5278 real_sgn(&0) = &0
5279Proof
5280 REWRITE_TAC[real_sgn] THEN REAL_ARITH_TAC
5281QED
5282
5283Theorem REAL_SGN_NEG :
5284 !x. real_sgn(~x) = ~(real_sgn x)
5285Proof
5286 REWRITE_TAC[real_sgn] THEN REAL_ARITH_TAC
5287QED
5288
5289Theorem REAL_SGN_ABS :
5290 !x. real_sgn(x) * abs(x) = x
5291Proof
5292 REWRITE_TAC[real_sgn] THEN REAL_ARITH_TAC
5293QED
5294
5295Theorem REAL_SGN_ABS_ALT :
5296 !x. real_sgn x * x = abs x
5297Proof
5298 GEN_TAC THEN REWRITE_TAC[real_sgn] THEN REAL_ARITH_TAC
5299QED
5300
5301Theorem REAL_EQ_SGN_ABS :
5302 !x y:real. x = y <=> real_sgn x = real_sgn y /\ abs x = abs y
5303Proof
5304 MESON_TAC[REAL_SGN_ABS]
5305QED
5306
5307Theorem REAL_ABS_SGN :
5308 !x. abs(real_sgn x) = real_sgn(abs x)
5309Proof
5310 REWRITE_TAC[real_sgn] THEN REAL_ARITH_TAC
5311QED
5312
5313Theorem REAL_SGN :
5314 !x. real_sgn x = x / abs x
5315Proof
5316 GEN_TAC THEN ASM_CASES_TAC “x = &0”
5317 >- ASM_REWRITE_TAC[real_div, REAL_MUL_LZERO, REAL_SGN_0]
5318 >> GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) empty_rewrites [GSYM REAL_SGN_ABS]
5319 >> ASM_SIMP_TAC std_ss [real_div, GSYM REAL_MUL_ASSOC, REAL_ABS_ZERO,
5320 REAL_MUL_RINV, REAL_MUL_RID]
5321QED
5322
5323Theorem REAL_SGN_MUL :
5324 !x y. real_sgn(x * y) = real_sgn(x) * real_sgn(y)
5325Proof
5326 REWRITE_TAC[REAL_SGN, REAL_ABS_MUL, real_div, REAL_INV_MUL'] THEN
5327 REAL_ARITH_TAC
5328QED
5329
5330Theorem REAL_SGN_INV :
5331 !x. real_sgn(inv x) = real_sgn x
5332Proof
5333 REWRITE_TAC[real_sgn, REAL_LT_INV_EQ, GSYM REAL_INV_NEG,
5334 REAL_ARITH “x < &0 <=> &0 < ~x”]
5335QED
5336
5337Theorem REAL_SGN_DIV :
5338 !x y. real_sgn(x / y) = real_sgn(x) / real_sgn(y)
5339Proof
5340 REWRITE_TAC[REAL_SGN, REAL_ABS_DIV] THEN
5341 REWRITE_TAC[real_div, REAL_INV_MUL', REAL_INV_INV] THEN
5342 REAL_ARITH_TAC
5343QED
5344
5345Theorem REAL_SGN_EQ :
5346 (!x. real_sgn x = &0 <=> x = &0) /\
5347 (!x. real_sgn x = &1 <=> x > &0) /\
5348 (!x. real_sgn x = ~ &1 <=> x < &0)
5349Proof
5350 REWRITE_TAC[real_sgn] THEN REAL_ARITH_TAC
5351QED
5352
5353Theorem REAL_SGN_CASES :
5354 !x. real_sgn x = &0 \/ real_sgn x = &1 \/ real_sgn x = ~&1
5355Proof
5356 REWRITE_TAC[real_sgn] THEN METIS_TAC[] (* was: MESON_TAC *)
5357QED
5358
5359Theorem REAL_SGN_INEQS :
5360 (!x. &0 <= real_sgn x <=> &0 <= x) /\
5361 (!x. &0 < real_sgn x <=> &0 < x) /\
5362 (!x. &0 >= real_sgn x <=> &0 >= x) /\
5363 (!x. &0 > real_sgn x <=> &0 > x) /\
5364 (!x. &0 = real_sgn x <=> &0 = x) /\
5365 (!x. real_sgn x <= &0 <=> x <= &0) /\
5366 (!x. real_sgn x < &0 <=> x < &0) /\
5367 (!x. real_sgn x >= &0 <=> x >= &0) /\
5368 (!x. real_sgn x > &0 <=> x > &0) /\
5369 (!x. real_sgn x = &0 <=> x = &0)
5370Proof
5371 REWRITE_TAC[real_sgn] THEN REAL_ARITH_TAC
5372QED
5373
5374Theorem REAL_SGN_POW :
5375 !x n. real_sgn(x pow n) = real_sgn(x) pow n
5376Proof
5377 GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[REAL_SGN_MUL, real_pow] THEN
5378 REWRITE_TAC[real_sgn, REAL_LT_01]
5379QED
5380
5381val REAL_LE_POW_2 = REAL_LE_POW2;
5382
5383Theorem REAL_SGN_POW_2 :
5384 !x. real_sgn(x pow 2) = real_sgn(abs x)
5385Proof
5386 REWRITE_TAC[real_sgn] THEN
5387 SIMP_TAC arith_ss [GSYM REAL_NOT_LE, REAL_ABS_POS, REAL_LE_POW_2,
5388 REAL_ARITH “&0 <= x ==> (x <= &0 <=> x = &0)”] THEN
5389 SIMP_TAC arith_ss [REAL_POW_EQ_0, REAL_ABS_ZERO]
5390QED
5391
5392Theorem REAL_SGN_REAL_SGN :
5393 !x. real_sgn(real_sgn x) = real_sgn x
5394Proof
5395 REWRITE_TAC[real_sgn] THEN REAL_ARITH_TAC
5396QED
5397
5398Theorem REAL_INV_SGN :
5399 !x. inv(real_sgn x) = real_sgn x
5400Proof
5401 GEN_TAC THEN REWRITE_TAC[real_sgn] THEN
5402 REPEAT COND_CASES_TAC THEN
5403 REWRITE_TAC[REAL_INV_0, REAL_INV_1, REAL_INV_NEG]
5404QED
5405
5406(* NOTE: REAL_ARITH_TAC takes quite long steps to prove this theorem *)
5407Theorem REAL_SGN_EQ_INEQ :
5408 !x y. real_sgn x = real_sgn y <=>
5409 x = y \/ abs(x - y) < max (abs x) (abs y)
5410Proof
5411 REWRITE_TAC[real_sgn] THEN REAL_ARITH_TAC
5412QED
5413
5414Theorem REAL_SGNS_EQ :
5415 !x y. real_sgn x = real_sgn y <=>
5416 (x = &0 <=> y = &0) /\
5417 (x > &0 <=> y > &0) /\
5418 (x < &0 <=> y < &0)
5419Proof
5420 REWRITE_TAC[real_sgn] THEN REAL_ARITH_TAC
5421QED
5422
5423Theorem REAL_SGNS_EQ_ALT :
5424 !x y. real_sgn x = real_sgn y <=>
5425 (x = &0 ==> y = &0) /\
5426 (x > &0 ==> y > &0) /\
5427 (x < &0 ==> y < &0)
5428Proof
5429 REWRITE_TAC[real_sgn] THEN REAL_ARITH_TAC
5430QED
5431
5432(*---------------------------------------------------------------------------*)
5433(* Some properties of (square) roots (without transcendental functions) *)
5434(*---------------------------------------------------------------------------*)
5435
5436Definition sqrt_def[nocompute]: sqrt x = @u. (0 < x ==> 0 < u) /\ (u pow 2 = x)
5437End
5438
5439Theorem SQRT_0 :
5440 sqrt(&0) = &0
5441Proof
5442 rw [sqrt_def]
5443QED
5444
5445Theorem SQRT_1 :
5446 sqrt(&1) = &1
5447Proof
5448 REWRITE_TAC [sqrt_def]
5449 >> SELECT_ELIM_TAC >> rw []
5450 >- (Q.EXISTS_TAC ‘1’ >> rw [])
5451 >> CCONTR_TAC
5452 >> ‘x < 1 \/ 1 < x’ by METIS_TAC [REAL_LT_TOTAL]
5453 >| [ (* goal 1 (of 2) *)
5454 Know ‘x pow SUC 1 < 1 pow SUC 1’
5455 >- (MATCH_MP_TAC POW_LT >> rw [REAL_LT_IMP_LE]) >> rw [],
5456 (* goal 2 (of 2) *)
5457 Know ‘1 pow SUC 1 < x pow SUC 1’
5458 >- (MATCH_MP_TAC POW_LT >> rw []) >> rw [] ]
5459QED
5460
5461(* NOTE: adding quantifier may break isqrtLib *)
5462Theorem POW_2_SQRT :
5463 &0 <= x ==> (sqrt(x pow 2) = x)
5464Proof
5465 RW_TAC std_ss [sqrt_def]
5466 >> SELECT_ELIM_TAC
5467 >> CONJ_TAC
5468 >- (Q.EXISTS_TAC ‘x’ >> rw [REAL_LT_LE])
5469 >> Q.X_GEN_TAC ‘y’
5470 >> rpt STRIP_TAC
5471 >> MATCH_MP_TAC POW_EQ
5472 >> Q.EXISTS_TAC ‘1’ >> rw []
5473 >> ‘(x = 0) \/ 0 < x’ by METIS_TAC [REAL_LE_LT]
5474 >- fs [pow_rat]
5475 >> MATCH_MP_TAC REAL_LT_IMP_LE
5476 >> FIRST_X_ASSUM MATCH_MP_TAC
5477 >> MATCH_MP_TAC REAL_POW_LT >> rw []
5478QED
5479
5480Theorem SQRT_POS_UNIQ :
5481 !x y. &0 <= x /\ &0 <= y /\ (y pow 2 = x) ==> (sqrt x = y)
5482Proof
5483 RW_TAC std_ss [sqrt_def]
5484 >> SELECT_ELIM_TAC
5485 >> CONJ_TAC
5486 >- (Q.EXISTS_TAC ‘y’ >> rw [REAL_LT_LE])
5487 >> rpt STRIP_TAC
5488 >> MATCH_MP_TAC POW_EQ
5489 >> Q.EXISTS_TAC ‘1’ >> rw []
5490 >> ‘(y = 0) \/ 0 < y’ by METIS_TAC [REAL_LE_LT]
5491 >- fs [pow_rat]
5492 >> MATCH_MP_TAC REAL_LT_IMP_LE
5493 >> FIRST_X_ASSUM MATCH_MP_TAC
5494 >> MATCH_MP_TAC REAL_POW_LT >> rw []
5495QED
5496
5497(* Elementary proof (without using transcTheory) by Chun Tian *)
5498Theorem SQRT_EXISTS[local] :
5499 !c. 0 < c ==> ?x. 0 < x /\ (x pow 2 = c)
5500Proof
5501 rpt STRIP_TAC
5502 >> Suff ‘?x. 0 <= x /\ (x pow 2 = c)’
5503 >- (STRIP_TAC >> Q.EXISTS_TAC ‘x’ >> rw [] \\
5504 fs [REAL_LE_LT] >> PROVE_TAC [])
5505 >> Q.ABBREV_TAC ‘s = (\y. 0 < y /\ c <= y pow 2)’
5506 >> Know ‘?x. s x’
5507 >- (rw [Abbr ‘s’] \\
5508 Cases_on ‘c < 1’
5509 >- (Q.EXISTS_TAC ‘1’ >> rw [] \\
5510 MATCH_MP_TAC REAL_LT_IMP_LE >> rw []) \\
5511 POP_ASSUM (ASSUME_TAC o (REWRITE_RULE [real_lt])) \\
5512 Q.EXISTS_TAC ‘c’ >> rw [POW_2] \\
5513 GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) empty_rewrites
5514 [GSYM REAL_MUL_RID] \\
5515 MATCH_MP_TAC REAL_LE_LMUL_IMP >> rw [] \\
5516 MATCH_MP_TAC REAL_LT_IMP_LE >> rw [])
5517 >> DISCH_TAC
5518 >> Q.ABBREV_TAC ‘g = inf s’
5519 >> Q.EXISTS_TAC ‘g’
5520 >> STRONG_CONJ_TAC (* ‘0 <= g’ is useful later *)
5521 >- (Q.UNABBREV_TAC ‘g’ >> MATCH_MP_TAC REAL_IMP_LE_INF \\
5522 rw [Abbr ‘s’] >> MATCH_MP_TAC REAL_LT_IMP_LE >> rw [])
5523 >> DISCH_TAC
5524 (* stage work, now "reductio ad absurdum" *)
5525 >> CCONTR_TAC
5526 >> ‘g pow 2 < c \/ c < g pow 2’ by PROVE_TAC [REAL_LT_TOTAL]
5527 >| [ (* goal 1 (of 2) *)
5528 MP_TAC (Q.SPEC ‘c - g pow 2’ REAL_ARCH) \\
5529 ASM_SIMP_TAC std_ss [REAL_SUB_LT, real_lt] \\
5530 Q.EXISTS_TAC ‘1 + 2 * g’ >> Q.X_GEN_TAC ‘n’ \\
5531 ‘(n = 0) \/ 0 < n’ by RW_TAC arith_ss []
5532 >- (rw [] >> MATCH_MP_TAC REAL_LE_ADD >> rw [] \\
5533 MATCH_MP_TAC REAL_LE_MUL >> rw []) \\
5534 GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) empty_rewrites [REAL_MUL_COMM] \\
5535 Know ‘(c - g pow 2) * &n <= 1 + 2 * g <=>
5536 c - g pow 2 <= (1 + 2 * g) / &n’
5537 >- (MATCH_MP_TAC (GSYM REAL_LE_RDIV_EQ) >> rw []) >> Rewr' \\
5538 SPOSE_NOT_THEN (ASSUME_TAC o REWRITE_RULE [GSYM real_lt, real_div]) \\
5539 Know ‘(g + inv (&n)) pow 2 < c’
5540 >- (rw [ADD_POW_2, GSYM REAL_ADD_ASSOC] \\
5541 ‘c = g pow 2 + (c - g pow 2)’ by PROVE_TAC [REAL_SUB_ADD2] >> POP_ORW \\
5542 MATCH_MP_TAC REAL_LT_IADD \\
5543 MATCH_MP_TAC REAL_LET_TRANS \\
5544 Q.EXISTS_TAC ‘1 * inv (&n) + 2 * g * inv (&n)’ \\
5545 CONJ_TAC >- (RW_TAC std_ss [REAL_LE_RADD, POW_2] \\
5546 MATCH_MP_TAC REAL_LE_RMUL_IMP >> rw [REAL_LE_INV_EQ] \\
5547 MATCH_MP_TAC REAL_INV_LE_1 >> rw []) \\
5548 rw [GSYM REAL_ADD_RDISTRIB]) >> DISCH_TAC \\
5549 Know ‘!x. s x ==> g + inv (&n) < x’
5550 >- (Q.PAT_X_ASSUM ‘?x. s x’ K_TAC \\
5551 rw [Abbr ‘s’] \\
5552 ‘(g + inv (&n)) pow 2 < x pow 2’ by PROVE_TAC [REAL_LTE_TRANS] \\
5553 SPOSE_NOT_THEN (ASSUME_TAC o (REWRITE_RULE [real_lt])) \\
5554 ‘x pow 2 <= (g + inv (&n)) pow 2’ by METIS_TAC [REAL_LT_IMP_LE, POW_LE] \\
5555 METIS_TAC [REAL_LET_ANTISYM]) >> DISCH_TAC \\
5556 Suff ‘?x. s x /\ x < g + inv (&n)’ >- METIS_TAC [REAL_LT_ANTISYM] \\
5557 MATCH_MP_TAC REAL_INF_LT >> rw [],
5558 (* goal 2 (of 2) *)
5559 ‘(g = 0) \/ 0 < g’ by METIS_TAC [REAL_LE_LT]
5560 >- (fs [pow_rat] >> METIS_TAC [REAL_LT_ANTISYM]) \\
5561 STRIP_ASSUME_TAC (REWRITE_RULE [ASSUME “0 < (g :real)”]
5562 (Q.SPEC ‘g’ REAL_ARCH_INV)) \\
5563 MP_TAC (Q.SPEC ‘g pow 2 - c’ REAL_ARCH) \\
5564 ASM_SIMP_TAC std_ss [REAL_SUB_LT, real_lt] \\
5565 Q.EXISTS_TAC ‘2 * g’ >> Q.X_GEN_TAC ‘m’ \\
5566 ‘(m = 0) \/ 0 < m’ by RW_TAC arith_ss []
5567 >- (rw [] >> MATCH_MP_TAC REAL_LE_MUL >> rw []) \\
5568 GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) empty_rewrites [REAL_MUL_COMM] \\
5569 Know ‘(g pow 2 - c) * &m <= 2 * g <=>
5570 g pow 2 - c <= (2 * g) / &m’
5571 >- (MATCH_MP_TAC (GSYM REAL_LE_RDIV_EQ) >> rw []) >> Rewr' \\
5572 SPOSE_NOT_THEN (ASSUME_TAC o REWRITE_RULE [GSYM real_lt, real_div]) \\
5573 Q.ABBREV_TAC ‘N = MAX m n’ \\
5574 Know ‘c < (g - inv (&N)) pow 2’
5575 >- (rw [SUB_POW_2] \\
5576 REWRITE_TAC [real_sub, GSYM REAL_ADD_ASSOC] \\
5577 REWRITE_TAC [GSYM real_sub] \\
5578 ONCE_REWRITE_TAC [REAL_ADD_COMM] \\
5579 REWRITE_TAC [GSYM REAL_LT_SUB_RADD] \\
5580 ONCE_REWRITE_TAC [GSYM REAL_LT_NEG] \\
5581 REWRITE_TAC [REAL_NEG_SUB] \\
5582 MATCH_MP_TAC REAL_LET_TRANS \\
5583 Q.EXISTS_TAC ‘2 * g * inv (&m)’ >> rw [REAL_LE_SUB_RADD] \\
5584 MATCH_MP_TAC REAL_LE_TRANS \\
5585 Q.EXISTS_TAC ‘2 * g * inv (&m)’ \\
5586 CONJ_TAC >- (MATCH_MP_TAC REAL_LE_LMUL_IMP \\
5587 CONJ_TAC >- (MATCH_MP_TAC REAL_LE_MUL >> rw []) \\
5588 MATCH_MP_TAC REAL_LE_INV2 >> rw [Abbr ‘N’, REAL_LE_MAX]) \\
5589 rw [REAL_LE_ADDR]) >> DISCH_TAC \\
5590 Know ‘s (g - inv (&N))’
5591 >- (rw [Abbr ‘s’, REAL_SUB_LT] >| (* 2 subgoals *)
5592 [ (* goal 2.1 (of 2) *)
5593 MATCH_MP_TAC REAL_LET_TRANS \\
5594 Q.EXISTS_TAC ‘inv (&n)’ >> rw [] \\
5595 MATCH_MP_TAC REAL_LE_INV2 >> rw [Abbr ‘N’, REAL_LE_MAX],
5596 (* goal 2.2 (of 2) *)
5597 MATCH_MP_TAC REAL_LT_IMP_LE >> rw [] ]) >> DISCH_TAC \\
5598 Suff ‘inf s <= g - inv (&N)’
5599 >- (simp [GSYM real_lt, REAL_LT_SUB_RADD, Abbr ‘N’, REAL_LT_MAX]) \\
5600 MATCH_MP_TAC REAL_IMP_INF_LE \\
5601 CONJ_TAC >- (Q.EXISTS_TAC ‘0’ >> rw [Abbr ‘s’] \\
5602 MATCH_MP_TAC REAL_LT_IMP_LE >> rw []) \\
5603 Q.EXISTS_TAC ‘g - inv (&N)’ >> rw [] ]
5604QED
5605
5606Theorem SQRT_POS_LT :
5607 !x. &0 < x ==> &0 < sqrt(x)
5608Proof
5609 RW_TAC std_ss [sqrt_def]
5610 >> SELECT_ELIM_TAC
5611 >> rw [SQRT_EXISTS]
5612QED
5613
5614Theorem SQRT_POS_NE :
5615 !(x :real). &0 < x ==> sqrt(x) <> &0
5616Proof
5617 Q.X_GEN_TAC ‘x’
5618 >> DISCH_THEN (ASSUME_TAC o (MATCH_MP SQRT_POS_LT))
5619 >> ONCE_REWRITE_TAC [EQ_SYM_EQ]
5620 >> MATCH_MP_TAC REAL_LT_IMP_NE
5621 >> ASM_REWRITE_TAC []
5622QED
5623
5624Theorem SQRT_POS_LE :
5625 !x. &0 <= x ==> &0 <= sqrt(x)
5626Proof
5627 rpt STRIP_TAC
5628 >> ‘(x = 0) \/ 0 < x’ by METIS_TAC [REAL_LE_LT]
5629 >- rw [SQRT_0]
5630 >> MATCH_MP_TAC REAL_LT_IMP_LE
5631 >> MATCH_MP_TAC SQRT_POS_LT >> rw []
5632QED
5633
5634Theorem SQRT_POW2 :
5635 !x. (sqrt(x) pow 2 = x) <=> &0 <= x
5636Proof
5637 GEN_TAC
5638 >> EQ_TAC >> RW_TAC std_ss []
5639 >- (SPOSE_NOT_THEN (ASSUME_TAC o REWRITE_RULE [GSYM real_lt]) \\
5640 ASSUME_TAC (Q.SPEC ‘sqrt x’ REAL_LE_POW2) \\
5641 ‘x < sqrt x pow 2’ by PROVE_TAC [REAL_LTE_TRANS] \\
5642 METIS_TAC [REAL_LT_IMP_NE])
5643 >> ‘(x = 0) \/ 0 < x’ by METIS_TAC [REAL_LE_LT]
5644 >- rw [SQRT_0]
5645 >> REWRITE_TAC [sqrt_def]
5646 >> SELECT_ELIM_TAC
5647 >> rw [SQRT_EXISTS]
5648QED
5649
5650Theorem SQRT_POW_2 :
5651 !x. &0 <= x ==> (sqrt(x) pow 2 = x)
5652Proof
5653 REWRITE_TAC[SQRT_POW2]
5654QED
5655
5656Theorem SQRT_MUL :
5657 !x y. &0 <= x /\ &0 <= y ==> (sqrt(x * y) = sqrt x * sqrt y)
5658Proof
5659 rpt STRIP_TAC
5660 >> ‘(x = 0) \/ 0 < x’ by METIS_TAC [REAL_LE_LT] >- rw [SQRT_0]
5661 >> ‘(y = 0) \/ 0 < y’ by METIS_TAC [REAL_LE_LT] >- rw [SQRT_0]
5662 >> REWRITE_TAC [sqrt_def]
5663 >> SELECT_ELIM_TAC (* 1st *)
5664 >> ‘0 < x * y’ by PROVE_TAC [REAL_LT_MUL]
5665 >> rw [SQRT_EXISTS]
5666 >> rename1 ‘c pow 2 = x * y’
5667 >> SELECT_ELIM_TAC (* 2nd *)
5668 >> rw [SQRT_EXISTS]
5669 >> rename1 ‘0 < a pow 2 * y’
5670 >> SELECT_ELIM_TAC (* 3rd *)
5671 >> rw [SQRT_EXISTS]
5672 >> fs [GSYM POW_MUL]
5673 >> MATCH_MP_TAC POW_EQ
5674 >> Q.EXISTS_TAC ‘1’ >> rw []
5675 >- (MATCH_MP_TAC REAL_LT_IMP_LE >> rw [])
5676 >> MATCH_MP_TAC REAL_LE_MUL
5677 >> CONJ_TAC
5678 >> MATCH_MP_TAC REAL_LT_IMP_LE >> rw []
5679QED
5680
5681Theorem SQRT_INV :
5682 !x. &0 <= x ==> (sqrt (inv x) = inv(sqrt x))
5683Proof
5684 rpt STRIP_TAC
5685 >> ‘(x = 0) \/ 0 < x’ by METIS_TAC [REAL_LE_LT]
5686 >- rw [SQRT_0]
5687 >> RW_TAC std_ss [sqrt_def]
5688 >> SELECT_ELIM_TAC
5689 >> CONJ_TAC
5690 >- (‘0 < inv x’ by PROVE_TAC [REAL_INV_POS] \\
5691 MP_TAC (MATCH_MP (Q.SPEC ‘inv x’ SQRT_EXISTS) (ASSUME “0 < inv x”)) \\
5692 DISCH_THEN (Q.X_CHOOSE_THEN ‘y’ STRIP_ASSUME_TAC) \\
5693 Q.EXISTS_TAC ‘y’ >> rw [])
5694 >> Q.X_GEN_TAC ‘y’
5695 >> rw [REAL_LT_INV_EQ]
5696 >> SELECT_ELIM_TAC
5697 >> rw [SQRT_EXISTS]
5698 >> rename1 ‘y = inv z’
5699 >> fs [GSYM REAL_POW_INV]
5700 >> CCONTR_TAC
5701 >> ‘y < inv z \/ inv z < y’ by METIS_TAC [REAL_LT_TOTAL]
5702 >| [ (* goal 1 (of 2) *)
5703 Know ‘y pow SUC 1 < (inv z) pow SUC 1’
5704 >- (MATCH_MP_TAC POW_LT >> rw [REAL_LT_IMP_LE]) >> rw [],
5705 (* goal 2 (of 2) *)
5706 Know ‘(inv z) pow SUC 1 < y pow SUC 1’
5707 >- (MATCH_MP_TAC POW_LT >> rw [REAL_LE_LT]) >> rw [] ]
5708QED
5709
5710Theorem SQRT_MONO_LE :
5711 !x y. &0 <= x /\ x <= y ==> sqrt(x) <= sqrt(y)
5712Proof
5713 rpt STRIP_TAC
5714 >> ‘(x = 0) \/ 0 < x’ by METIS_TAC [REAL_LE_LT]
5715 >- rw [SQRT_0, SQRT_POS_LE]
5716 >> REWRITE_TAC [sqrt_def]
5717 >> SELECT_ELIM_TAC
5718 >> rw [SQRT_EXISTS] >> rename1 ‘0 < x’
5719 >> SELECT_ELIM_TAC
5720 >> ‘0 < y’ by PROVE_TAC [REAL_LTE_TRANS]
5721 >> rw [SQRT_EXISTS] >> rename1 ‘0 < z’
5722 >> SPOSE_NOT_THEN (ASSUME_TAC o (REWRITE_RULE [GSYM real_lt]))
5723 >> Know ‘z pow (SUC 1) < x pow (SUC 1)’
5724 >- (MATCH_MP_TAC POW_LT >> rw [REAL_LT_IMP_LE])
5725 >> rw [real_lt]
5726QED
5727
5728Theorem SQRT_MONO_LT :
5729 !x y. &0 <= x /\ x < y ==> sqrt(x) < sqrt(y)
5730Proof
5731 rpt STRIP_TAC
5732 >> fs [REAL_LT_LE]
5733 >> CONJ_TAC >- (MATCH_MP_TAC SQRT_MONO_LE >> rw [])
5734 >> ‘0 <= y’ by PROVE_TAC [REAL_LE_TRANS]
5735 >> CCONTR_TAC >> fs []
5736 >> METIS_TAC [SQRT_POW2]
5737QED
5738
5739Theorem SQRT_DIV :
5740 !x y. &0 <= x /\ &0 <= y ==> (sqrt (x / y) = sqrt x / sqrt y)
5741Proof
5742 rpt STRIP_TAC
5743 >> ‘(x = 0) \/ 0 < x’ by METIS_TAC [REAL_LE_LT]
5744 >- rw [SQRT_0, REAL_DIV_LZERO]
5745 >> ‘(y = 0) \/ 0 < y’ by METIS_TAC [REAL_LE_LT]
5746 >- rw [SQRT_0, real_div, REAL_INV_0]
5747 >> REWRITE_TAC [sqrt_def]
5748 >> SELECT_ELIM_TAC (* 1st *)
5749 >> ‘0 < x / y’ by PROVE_TAC [REAL_LT_DIV]
5750 >> rw [SQRT_EXISTS]
5751 >> rename1 ‘z pow 2 = x / y’
5752 >> SELECT_ELIM_TAC (* 2nd *)
5753 >> rw [SQRT_EXISTS]
5754 >> rename1 ‘z pow 2 = u pow 2 / y’
5755 >> SELECT_ELIM_TAC (* 3rd *)
5756 >> rw [SQRT_EXISTS]
5757 >> fs [GSYM REAL_POW_DIV]
5758 >> ‘0 < u / x’ by PROVE_TAC [REAL_LT_DIV]
5759 >> CCONTR_TAC
5760 >> ‘z < u / x \/ u / x < z’ by METIS_TAC [REAL_LT_TOTAL]
5761 >| [ (* goal 1 (of 2) *)
5762 Know ‘z pow SUC 1 < (u / x) pow SUC 1’
5763 >- (MATCH_MP_TAC POW_LT >> rw [REAL_LT_IMP_LE]) >> rw [],
5764 (* goal 2 (of 2) *)
5765 Know ‘(u / x) pow SUC 1 < z pow SUC 1’
5766 >- (MATCH_MP_TAC POW_LT >> rw [REAL_LE_LT]) >> rw [] ]
5767QED
5768
5769Theorem SQRT_EQ :
5770 !x y. (x pow 2 = y) /\ &0 <= x ==> (x = sqrt y)
5771Proof
5772 rpt STRIP_TAC
5773 >> ‘(x = 0) \/ 0 < x’ by METIS_TAC [REAL_LE_LT]
5774 >- fs [pow_rat, SQRT_0]
5775 >> REWRITE_TAC [sqrt_def]
5776 >> SELECT_ELIM_TAC
5777 >> Know ‘0 < y’
5778 >- (Q.PAT_X_ASSUM ‘x pow 2 = y’ (ONCE_REWRITE_TAC o wrap o SYM) \\
5779 rw [REAL_POW_LT, REAL_LT_IMP_NE])
5780 >> rw [SQRT_EXISTS]
5781 >> rename1 ‘y pow 2 = x pow 2’
5782 >> MATCH_MP_TAC POW_EQ
5783 >> Q.EXISTS_TAC ‘1’ >> rw [REAL_LT_IMP_LE]
5784QED
5785
5786(*---------------------------------------------------------------------------*)
5787(* Miscellaneous Results (generally for use in descendant theories) *)
5788(*---------------------------------------------------------------------------*)
5789
5790Theorem REAL_MUL_SIGN:
5791 (!x y. 0 <= x * y <=> (0 <= x /\ 0 <= y) \/ (x <= 0 /\ y <= 0)) /\
5792 (!x y. x * y <= 0 <=> (0 <= x /\ y <= 0) \/ (x <= 0 /\ 0 <= y))
5793Proof
5794 rw[] >> eq_tac >> rw[] >> fs[GSYM REAL_NEG_GE0,Excl "REAL_NEG_GE0"] >>
5795 TRY $ dxrule_all_then assume_tac $ REAL_LE_MUL >>
5796 fs[REAL_MUL_LNEG,REAL_MUL_RNEG,REAL_MUL_COMM] >>
5797 pop_assum mp_tac >> CONV_TAC CONTRAPOS_CONV >> rw[] >> fs[real_lte,REAL_LT_GT] >>
5798 fs[GSYM REAL_NEG_GT0,Excl "REAL_NEG_GT0"] >>
5799 dxrule_all_then assume_tac $ REAL_LT_MUL >>
5800 fs[REAL_MUL_LNEG,REAL_MUL_RNEG,REAL_MUL_COMM]
5801QED
5802
5803Theorem POW_2_LT_1:
5804 !x. -1 < x /\ x < 1 ==> x pow 2 < 1
5805Proof
5806 rw[] >> wlog_tac ‘0 <= x’ [‘x’]
5807 >- (first_x_assum $ qspec_then ‘-x’ mp_tac >> simp[] >>
5808 disch_then irule >> irule_at Any $ iffLR REAL_LT_NEG >>
5809 simp[REAL_NEG_NEG,Excl "REAL_LT_NEG"] >>
5810 gs[REAL_NOT_LE,REAL_LE_LT]) >>
5811 qspecl_then [‘x’,‘1’,‘x’,‘1’] mp_tac REAL_LT_MUL2 >> simp[REAL_POW_2]
5812QED
5813
5814Theorem POW_2_1_LT:
5815 !x. x < -1 \/ 1 < x ==> 1 < x pow 2
5816Proof
5817 strip_tac >> wlog_tac ‘0 <= x’ [‘x’]
5818 >- (first_x_assum $ qspec_then ‘-x’ mp_tac >>
5819 gs[REAL_NOT_LE,REAL_LE_LT] >> rw[] >> first_x_assum irule >> simp[] >>
5820 disj2_tac >> irule_at Any $ iffLR REAL_LT_NEG >>
5821 simp[REAL_NEG_NEG,Excl "REAL_LT_NEG"]) >>
5822 rw[] >> qspecl_then [‘1’,‘x’,‘1’,‘x’] mp_tac REAL_LT_MUL2 >> simp[REAL_POW_2] >>
5823 ‘F’ suffices_by simp[] >> dxrule_all REAL_LET_TRANS >> simp[]
5824QED
5825
5826Theorem SQRT_POW_2_ABS:
5827 !x. sqrt (x pow 2) = abs x
5828Proof
5829 rw[] >> Cases_on ‘0 <= x’ >- simp[POW_2_SQRT] >> simp[abs] >>
5830 ‘0 <= -x’ by gs[REAL_NOT_LE,REAL_LE_LT] >>
5831 dxrule_then (SUBST1_TAC o SYM) POW_2_SQRT >> simp[]
5832QED
5833
5834Theorem SQUARE_ROOTS:
5835 !x y. x pow 2 = y ==> x = sqrt y \/ x = -sqrt y
5836Proof
5837 rw[] >> Cases_on ‘0 <= x’ >- simp[POW_2_SQRT] >> disj2_tac >>
5838 qspec_then ‘-x’ mp_tac $ GENL [“x:real”] POW_2_SQRT >>
5839 ‘0 <= -x’ by gs[REAL_NOT_LE,REAL_LE_LT] >> simp[]
5840QED
5841
5842Theorem REAL_EQ_RDIV_EQ':
5843 !x y z. z <> 0 ==> (x = y / z <=> x * z = y)
5844Proof
5845 rw[real_div] >> eq_tac >> rw[] >>
5846 simp[GSYM REAL_MUL_ASSOC,REAL_MUL_RINV,REAL_MUL_LINV]
5847QED
5848
5849Theorem QUADRATIC_FORMULA:
5850 !a b c x. a <> 0 ==> a * x pow 2 + b * x + c = 0 ==>
5851 x = (-b + sqrt(b pow 2 - 4 * a * c)) / (2 * a) \/
5852 x = (-b - sqrt(b pow 2 - 4 * a * c)) / (2 * a)
5853Proof
5854 rw[real_sub,REAL_EQ_RDIV_EQ'] >>
5855 ‘!x y. x = -b + y <=> x + b = y’ by
5856 simp[Once REAL_ADD_COMM,GSYM real_sub,REAL_EQ_SUB_LADD] >>
5857 simp[] >> pop_assum kall_tac >> simp[GSYM real_sub] >>
5858 irule SQUARE_ROOTS >> simp[ADD_POW_2,POW_MUL,REAL_EQ_SUB_LADD] >>
5859 (* I'm sure there is a better way to do this, I don't know it *)
5860 pop_assum $ mp_tac o AP_TERM “λy. 4r * a * y + b²” >>
5861 simp[REAL_ADD_LDISTRIB,REAL_POW_2] >>
5862 qmatch_abbrev_tac ‘l1:real = r ==> l2 = r’ >> ‘l1 = l2’ suffices_by simp[] >>
5863 UNABBREV_ALL_TAC >> ‘2r * 2 = 4’ by simp[] >> simp[REAL_MUL_ASSOC] >>
5864 ‘2 * x * 2 * a * b = (2 * 2) * a * b * x’
5865 by metis_tac[REAL_MUL_COMM,REAL_MUL_ASSOC] >>
5866 ntac 2 $ pop_assum SUBST1_TAC >>
5867 ‘x * x * 4 * a * a = 4 * a * a * x * x’
5868 by metis_tac[REAL_MUL_COMM,REAL_MUL_ASSOC] >>
5869 pop_assum SUBST1_TAC >> metis_tac[REAL_ADD_COMM,REAL_ADD_ASSOC]
5870QED
5871
5872(* ------------------------------------------------------------------------- *)
5873(* Various handy lemmas (for REAL_ARITH2_TAC). *)
5874(* ------------------------------------------------------------------------- *)
5875
5876(* cf. REAL_ADD_RAT *)
5877Theorem RAT_LEMMA1 :
5878 ~(y1 = &0) /\ ~(y2 = &0) ==>
5879 ((x1 / y1) + (x2 / y2) = (x1 * y2 + x2 * y1) * inv(y1) * inv(y2))
5880Proof
5881 RW_TAC std_ss [GSYM REAL_MUL_ASSOC, GSYM REAL_INV_MUL, GSYM real_div]
5882 >> METIS_TAC [REAL_ADD_RAT, REAL_MUL_COMM]
5883QED
5884
5885Theorem RAT_LEMMA2 :
5886 &0 < y1 /\ &0 < y2 ==>
5887 ((x1 / y1) + (x2 / y2) = (x1 * y2 + x2 * y1) * inv(y1) * inv(y2))
5888Proof
5889 METIS_TAC [REAL_LT_IMP_NE, RAT_LEMMA1]
5890QED
5891
5892(* cf. REAL_SUB_RAT *)
5893Theorem RAT_LEMMA3 :
5894 &0 < y1 /\ &0 < y2 ==>
5895 ((x1 / y1) - (x2 / y2) = (x1 * y2 - x2 * y1) * inv(y1) * inv(y2))
5896Proof
5897 DISCH_THEN(MP_TAC o GEN_ALL o MATCH_MP RAT_LEMMA2) THEN
5898 REWRITE_TAC[real_div] THEN DISCH_TAC THEN
5899 ASM_REWRITE_TAC[real_sub, GSYM REAL_MUL_LNEG]
5900QED
5901
5902Theorem lemma[local]:
5903 !x y. &0 < y ==> (&0 <= x * y <=> &0 <= x)
5904Proof
5905 rpt GEN_TAC THEN DISCH_TAC THEN EQ_TAC THEN DISCH_TAC THENL
5906 [ (* goal 1 (of 2) *)
5907 Q.SUBGOAL_THEN `&0 <= x * (y * inv y)` MP_TAC THENL
5908 [ (* goal 1.1 (of 2) *)
5909 REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_MUL THEN
5910 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV THEN
5911 MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[],
5912 (* goal 1.2 (of 2) *)
5913 Q.SUBGOAL_THEN `y * inv y = &1` (fn th =>
5914 REWRITE_TAC[th, REAL_MUL_RID]) THEN
5915 MATCH_MP_TAC REAL_MUL_RINV THEN
5916 Q.UNDISCH_TAC `&0 < y` THEN REAL_ARITH_TAC ],
5917 (* goal 2 (of 2) *)
5918 MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN
5919 MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[] ]
5920QED
5921
5922(* These are HOL-Light compatible names (locally used):
5923 |- !x y. 0 < x /\ x < y ==> realinv y < realinv x
5924 *)
5925Theorem REAL_LT_INV2 = REAL_LT_INV
5926
5927(* |- !x. 0 < x ==> 0 < inv x *)
5928Theorem REAL_LT_INV' = REAL_INV_POS
5929
5930Theorem RAT_LEMMA4 :
5931 &0 < y1 /\ &0 < y2 ==> (x1 / y1 <= x2 / y2 <=> x1 * y2 <= x2 * y1)
5932Proof
5933 ONCE_REWRITE_TAC[CONJ_SYM] THEN DISCH_TAC THEN
5934 ONCE_REWRITE_TAC[REAL_ARITH ``a <= b <=> &0 <= b - a``] THEN
5935 FIRST_ASSUM(fn th => REWRITE_TAC[MATCH_MP RAT_LEMMA3 th]) THEN
5936 MATCH_MP_TAC EQ_TRANS THEN
5937 Q.EXISTS_TAC `&0 <= (x2 * y1 - x1 * y2) * inv y2` THEN
5938 REWRITE_TAC[REAL_MUL_ASSOC] THEN CONJ_TAC THEN
5939 MATCH_MP_TAC lemma THEN MATCH_MP_TAC REAL_LT_INV' THEN
5940 ASM_REWRITE_TAC[]
5941QED
5942
5943Theorem RAT_LEMMA5 :
5944 &0 < y1 /\ &0 < y2 ==> ((x1 / y1 = x2 / y2) <=> (x1 * y2 = x2 * y1))
5945Proof
5946 REPEAT DISCH_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN
5947 MATCH_MP_TAC(TAUT `(a <=> a') /\ (b <=> b') ==> (a /\ b <=> a' /\ b')`) THEN
5948 CONJ_TAC THEN MATCH_MP_TAC RAT_LEMMA4 THEN ASM_REWRITE_TAC[]
5949QED
5950
5951Theorem RAT_LEMMA5_BETTER:
5952 y1 <> 0:real /\ y2 <> 0 ==> (x1 / y1 = x2 / y2 <=> x1 * y2 = x2 * y1)
5953Proof
5954 rw[]
5955 >> ‘y1*y2 <> 0’ by simp[] >> simp[real_div]
5956 >> ‘x1 * inv y1 = x2 * inv y2 <=>
5957 x1 * inv y1 * (y1 * y2) = x2 * inv y2 * (y1 * y2)’ by simp[REAL_EQ_RMUL]
5958 >> ‘x1 * inv y1 * (y1 * y2) = x2 * inv y2 * (y1 * y2) <=>
5959 x1 * y2 * (inv y1 * y1) = x2 * y1 * (inv y2 * y2)’ by
5960 metis_tac[REAL_MUL_ASSOC, REAL_MUL_SYM]
5961 >> ‘x1 * y2 * (inv y1 * y1) = x2 * y1 * (inv y2 * y2) <=>
5962 x1 * y2 = x2 * y1’ by simp[REAL_MUL_LINV]
5963 >> metis_tac[]
5964QED
5965
5966(* The following common used HALF theorems were moved from seqTheory *)
5967Theorem HALF_POS :
5968 0:real < 1/2
5969Proof
5970 PROVE_TAC [REAL_LT_01, REAL_LT_HALF1]
5971QED
5972
5973Theorem HALF_LT_1 :
5974 1 / 2 < 1:real
5975Proof
5976 ONCE_REWRITE_TAC [GSYM REAL_INV_1OVER, GSYM REAL_INV1]
5977 >> MATCH_MP_TAC REAL_LT_INV
5978 >> RW_TAC arith_ss [REAL_LT]
5979QED
5980
5981Theorem HALF_CANCEL :
5982 2 * (1 / 2) = 1:real
5983Proof
5984 Suff `2 * inv 2 = 1:real` >- PROVE_TAC [REAL_INV_1OVER]
5985 >> PROVE_TAC [REAL_MUL_RINV, REAL_ARITH ``~(2:real = 0)``]
5986QED
5987
5988Theorem X_HALF_HALF :
5989 !x:real. 1/2 * x + 1/2 * x = x
5990Proof
5991 STRIP_TAC
5992 >> MATCH_MP_TAC (REAL_ARITH ``(2 * (a:real) = 2 * b) ==> (a = b)``)
5993 >> RW_TAC std_ss [REAL_ADD_LDISTRIB, REAL_MUL_ASSOC, HALF_CANCEL]
5994 >> REAL_ARITH_TAC
5995QED
5996
5997Theorem ONE_MINUS_HALF :
5998 (1:real) - 1 / 2 = 1 / 2
5999Proof
6000 MP_TAC (Q.SPEC `1` X_HALF_HALF)
6001 >> RW_TAC std_ss [REAL_MUL_RID]
6002 >> MATCH_MP_TAC (REAL_ARITH ``((x:real) + 1 / 2 = y + 1 / 2) ==> (x = y)``)
6003 >> RW_TAC std_ss [REAL_SUB_ADD]
6004QED
6005
6006Theorem POW_HALF_POS :
6007 !n. 0:real < (1/2) pow n
6008Proof
6009 STRIP_TAC
6010 >> Cases_on `n` >- PROVE_TAC [REAL_LT_01, pow]
6011 >> PROVE_TAC [HALF_POS, POW_POS_LT]
6012QED
6013
6014(* NOTE: This theorem shows that the ring of real numbers is an intergal domain. *)
6015Theorem REAL_INTEGRAL :
6016 (!(x :real). &0 * x = &0) /\
6017 (!(x :real) y z. (x + y = x + z) <=> (y = z)) /\
6018 (!(w :real) x y z. (w * y + x * z = w * z + x * y) <=> (w = x) \/ (y = z))
6019Proof
6020 ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN
6021 REWRITE_TAC[GSYM REAL_ENTIRE] THEN REAL_ARITH_TAC
6022QED
6023
6024(* NOTE: Perhaps this theorem is related to "Rabinowitsch trick". See also
6025 https://en.wikipedia.org/wiki/Rabinowitsch_trick
6026 *)
6027Theorem REAL_RABINOWITSCH :
6028 !x y:real. ~(x = y) <=> ?z. (x - y) * z = &1
6029Proof
6030 REWRITE_TAC[EQ_IMP_THM]
6031 >> rpt strip_tac
6032 >> FULL_SIMP_TAC std_ss [EQ_IMP_THM, REAL_SUB_REFL, REAL_MUL_LZERO, REAL_10]
6033 >> irule_at Any REAL_MUL_RINV
6034 >> ASM_REWRITE_TAC [REAL_SUB_0]
6035QED
6036
6037Theorem REAL_MUL_POS_LT :
6038 !x y:real. &0 < x * y <=> &0 < x /\ &0 < y \/ x < &0 /\ y < &0
6039Proof
6040 REPEAT STRIP_TAC THEN
6041 STRIP_ASSUME_TAC(SPEC ``x:real`` REAL_LT_NEGTOTAL) THEN
6042 STRIP_ASSUME_TAC(SPEC ``y:real`` REAL_LT_NEGTOTAL) THEN
6043 ASM_REWRITE_TAC[REAL_MUL_LZERO, REAL_MUL_RZERO, REAL_LT_REFL] THEN
6044 ASSUM_LIST(MP_TAC o MATCH_MP REAL_LT_MUL o end_itlist CONJ) THEN
6045 REPEAT(POP_ASSUM MP_TAC) THEN REAL_ARITH_TAC
6046QED
6047
6048Theorem REAL_CHOOSE_SIZE :
6049 !c. &0 <= c ==> (?x. abs x = c:real)
6050Proof
6051 METIS_TAC [ABS_REFL]
6052QED
6053
6054(* Temporarily re-enable printing of numeral bits for help documents *)
6055val _ = temp_remove_user_printer ("num.numeral_computations", “n:num”);
6056
6057(* END *)