numberScript.sml

1(* ------------------------------------------------------------------------- *)
2(* Elementary Number Theory - a collection of useful results for numbers     *)
3(*                                                                           *)
4(* Author: (Joseph) Hing-Lun Chan (Australian National University, 2019)     *)
5(* ------------------------------------------------------------------------- *)
6Theory number
7Ancestors
8  prim_rec arithmetic divides gcd gcdset logroot pred_set list
9  rich_list listRange indexedLists
10
11
12(* Overload non-decreasing functions with different arity. *)
13Overload MONO = ``\f:num -> num. !x y. x <= y ==> f x <= f y``
14Overload MONO2 =
15      ``\f:num -> num -> num.
16           !x1 y1 x2 y2. x1 <= x2 /\ y1 <= y2 ==> f x1 y1 <= f x2 y2``
17Overload MONO3 =
18      ``\f:num -> num -> num -> num.
19           !x1 y1 z1 x2 y2 z2. x1 <= x2 /\ y1 <= y2 /\ z1 <= z2 ==>
20                               f x1 y1 z1 <= f x2 y2 z2``
21
22(* Overload non-increasing functions with different arity. *)
23Overload RMONO = ``\f:num -> num. !x y. x <= y ==> f y <= f x``
24Overload RMONO2 =
25      ``\f:num -> num -> num.
26           !x1 y1 x2 y2. x1 <= x2 /\ y1 <= y2 ==> f x2 y2 <= f x1 y1``
27Overload RMONO3 =
28      ``\f:num -> num -> num -> num.
29           !x1 y1 z1 x2 y2 z2. x1 <= x2 /\ y1 <= y2 /\ z1 <= z2 ==>
30                               f x2 y2 z2 <= f x1 y1 z1``
31
32(* ------------------------------------------------------------------------- *)
33(* More Set Theorems                                                         *)
34(* ------------------------------------------------------------------------- *)
35
36(* Theorem: DISJOINT (s DIFF t) t /\ DISJOINT t (s DIFF t) *)
37(* Proof:
38       DISJOINT (s DIFF t) t
39   <=> (s DIFF t) INTER t = {}              by DISJOINT_DEF
40   <=> !x. x IN (s DIFF t) INTER t <=> F    by MEMBER_NOT_EMPTY
41       x IN (s DIFF t) INTER t
42   <=> x IN (s DIFF t) /\ x IN t            by IN_INTER
43   <=> (x IN s /\ x NOTIN t) /\ x IN t      by IN_DIFF
44   <=> x IN s /\ (x NOTIN t /\ x IN t)
45   <=> x IN s /\ F
46   <=> F
47   Similarly for DISJOINT t (s DIFF t)
48*)
49Theorem DISJOINT_DIFF:
50    !s t. (DISJOINT (s DIFF t) t) /\ (DISJOINT t (s DIFF t))
51Proof
52  (rw[DISJOINT_DEF, EXTENSION] >> metis_tac[])
53QED
54
55(* Theorem: DISJOINT s t <=> ((s DIFF t) = s) *)
56(* Proof: by DISJOINT_DEF, DIFF_DEF, EXTENSION *)
57Theorem DISJOINT_DIFF_IFF:
58    !s t. DISJOINT s t <=> ((s DIFF t) = s)
59Proof
60  rw[DISJOINT_DEF, DIFF_DEF, EXTENSION] >>
61  metis_tac[]
62QED
63
64(* Theorem: s UNION (t DIFF s) = s UNION t *)
65(* Proof:
66   By EXTENSION,
67     x IN (s UNION (t DIFF s))
68   = x IN s \/ x IN (t DIFF s)                    by IN_UNION
69   = x IN s \/ (x IN t /\ x NOTIN s)              by IN_DIFF
70   = (x IN s \/ x IN t) /\ (x IN s \/ x NOTIN s)  by LEFT_OR_OVER_AND
71   = (x IN s \/ x IN t) /\ T                      by EXCLUDED_MIDDLE
72   = x IN (s UNION t)                             by IN_UNION
73*)
74Theorem UNION_DIFF_EQ_UNION:
75    !s t. s UNION (t DIFF s) = s UNION t
76Proof
77  rw_tac std_ss[EXTENSION, IN_UNION, IN_DIFF] >>
78  metis_tac[]
79QED
80
81(* Theorem: (s INTER (t DIFF s) = {}) /\ ((t DIFF s) INTER s = {}) *)
82(* Proof: by DISJOINT_DIFF, GSYM DISJOINT_DEF *)
83Theorem INTER_DIFF:
84    !s t. (s INTER (t DIFF s) = {}) /\ ((t DIFF s) INTER s = {})
85Proof
86  rw[DISJOINT_DIFF, GSYM DISJOINT_DEF]
87QED
88
89(* Theorem: {x} SUBSET s /\ SING s <=> (s = {x}) *)
90(* Proof:
91   Note {x} SUBSET s ==> x IN s           by SUBSET_DEF
92    and SING s ==> ?y. s = {y}            by SING_DEF
93   Thus x IN {y} ==> x = y                by IN_SING
94*)
95Theorem SING_SUBSET :
96    !s x. {x} SUBSET s /\ SING s <=> (s = {x})
97Proof
98    metis_tac[SING_DEF, IN_SING, SUBSET_DEF]
99QED
100
101(* Theorem: x IN (if b then {y} else {}) ==> (x = y) *)
102(* Proof: by IN_SING, MEMBER_NOT_EMPTY *)
103Theorem IN_SING_OR_EMPTY:
104    !b x y. x IN (if b then {y} else {}) ==> (x = y)
105Proof
106  rw[]
107QED
108
109(* Theorem: FINITE s ==> ((CARD s = 1) <=> SING s) *)
110(* Proof:
111   If part: CARD s = 1 ==> SING s
112      Since CARD s = 1
113        ==> s <> {}        by CARD_EMPTY
114        ==> ?x. x IN s     by MEMBER_NOT_EMPTY
115      Claim: !y . y IN s ==> y = x
116      Proof: By contradiction, suppose y <> x.
117             Then y NOTIN {x}             by EXTENSION
118               so CARD {y; x} = 2         by CARD_DEF
119              and {y; x} SUBSET s         by SUBSET_DEF
120             thus CARD {y; x} <= CARD s   by CARD_SUBSET
121             This contradicts CARD s = 1.
122      Hence SING s         by SING_ONE_ELEMENT (or EXTENSION, SING_DEF)
123      Or,
124      With x IN s, {x} SUBSET s         by SUBSET_DEF
125      If s <> {x}, then {x} PSUBSET s   by PSUBSET_DEF
126      so CARD {x} < CARD s              by CARD_PSUBSET
127      But CARD {x} = 1                  by CARD_SING
128      and this contradicts CARD s = 1.
129
130   Only-if part: SING s ==> CARD s = 1
131      Since SING s
132        <=> ?x. s = {x}    by SING_DEF
133        ==> CARD {x} = 1   by CARD_SING
134*)
135Theorem CARD_EQ_1:
136    !s. FINITE s ==> ((CARD s = 1) <=> SING s)
137Proof
138  rw[SING_DEF, EQ_IMP_THM] >| [
139    `1 <> 0` by decide_tac >>
140    `s <> {} /\ ?x. x IN s` by metis_tac[CARD_EMPTY, MEMBER_NOT_EMPTY] >>
141    qexists_tac `x` >>
142    spose_not_then strip_assume_tac >>
143    `{x} PSUBSET s` by rw[PSUBSET_DEF] >>
144    `CARD {x} < CARD s` by rw[CARD_PSUBSET] >>
145    `CARD {x} = 1` by rw[CARD_SING] >>
146    decide_tac,
147    rw[CARD_SING]
148  ]
149QED
150
151(* Theorem: x <> y ==> ((x INSERT s) DELETE y = x INSERT (s DELETE y)) *)
152(* Proof:
153       z IN (x INSERT s) DELETE y
154   <=> z IN (x INSERT s) /\ z <> y                by IN_DELETE
155   <=> (z = x \/ z IN s) /\ z <> y                by IN_INSERT
156   <=> (z = x /\ z <> y) \/ (z IN s /\ z <> y)    by RIGHT_AND_OVER_OR
157   <=> (z = x) \/ (z IN s /\ z <> y)              by x <> y
158   <=> (z = x) \/ (z IN DELETE y)                 by IN_DELETE
159   <=> z IN  x INSERT (s DELETE y)                by IN_INSERT
160*)
161Theorem INSERT_DELETE_COMM:
162    !s x y. x <> y ==> ((x INSERT s) DELETE y = x INSERT (s DELETE y))
163Proof
164  (rw[EXTENSION] >> metis_tac[])
165QED
166
167(* Theorem: x NOTIN s ==> (x INSERT s) DELETE x = s *)
168(* Proof:
169    (x INSERT s) DELETE x
170   = s DELETE x         by DELETE_INSERT
171   = s                  by DELETE_NON_ELEMENT
172*)
173Theorem INSERT_DELETE_NON_ELEMENT:
174  !x s. x NOTIN s ==> (x INSERT s) DELETE x = s
175Proof
176  simp[DELETE_INSERT, DELETE_NON_ELEMENT]
177QED
178
179(* Theorem: s SUBSET u ==> (s INTER t) SUBSET u *)
180(* Proof:
181   Note (s INTER t) SUBSET s     by INTER_SUBSET
182    ==> (s INTER t) SUBSET u     by SUBSET_TRANS
183*)
184Theorem SUBSET_INTER_SUBSET:
185    !s t u. s SUBSET u ==> (s INTER t) SUBSET u
186Proof
187  metis_tac[INTER_SUBSET, SUBSET_TRANS]
188QED
189
190(* Theorem: s DIFF (s DIFF t) = s INTER t *)
191(* Proof: by IN_DIFF, IN_INTER *)
192Theorem DIFF_DIFF_EQ_INTER:
193    !s t. s DIFF (s DIFF t) = s INTER t
194Proof
195  rw[EXTENSION] >>
196  metis_tac[]
197QED
198
199(* Theorem: (s = t) <=> (s SUBSET t /\ (t DIFF s = {})) *)
200(* Proof:
201       s = t
202   <=> s SUBSET t /\ t SUBSET s       by SET_EQ_SUBSET
203   <=> s SUBSET t /\ (t DIFF s = {})  by SUBSET_DIFF_EMPTY
204*)
205Theorem SET_EQ_BY_DIFF:
206    !s t. (s = t) <=> (s SUBSET t /\ (t DIFF s = {}))
207Proof
208  rw[SET_EQ_SUBSET, SUBSET_DIFF_EMPTY]
209QED
210
211(* in pred_setTheory:
212SUBSET_DELETE_BOTH |- !s1 s2 x. s1 SUBSET s2 ==> s1 DELETE x SUBSET s2 DELETE x
213*)
214
215(* Theorem: s1 SUBSET s2 ==> x INSERT s1 SUBSET x INSERT s2 *)
216(* Proof: by SUBSET_DEF *)
217Theorem SUBSET_INSERT_BOTH:
218  !s1 s2 x. s1 SUBSET s2 ==> x INSERT s1 SUBSET x INSERT s2
219Proof
220  simp[SUBSET_DEF]
221QED
222
223(* Theorem: x NOTIN s /\ (x INSERT s) SUBSET t ==> s SUBSET (t DELETE x) *)
224(* Proof: by SUBSET_DEF *)
225Theorem INSERT_SUBSET_SUBSET:
226    !s t x. x NOTIN s /\ (x INSERT s) SUBSET t ==> s SUBSET (t DELETE x)
227Proof
228  rw[SUBSET_DEF]
229QED
230
231(* DIFF_INSERT  |- !s t x. s DIFF (x INSERT t) = s DELETE x DIFF t *)
232
233(* Theorem: (s DIFF t) DELETE x = s DIFF (x INSERT t) *)
234(* Proof: by EXTENSION *)
235Theorem DIFF_DELETE:
236    !s t x. (s DIFF t) DELETE x = s DIFF (x INSERT t)
237Proof
238  (rw[EXTENSION] >> metis_tac[])
239QED
240
241(* Theorem: FINITE a /\ b SUBSET a ==> (CARD (a DIFF b) = CARD a - CARD b) *)
242(* Proof:
243   Note FINITE b                   by SUBSET_FINITE
244     so a INTER b = b              by SUBSET_INTER2
245        CARD (a DIFF b)
246      = CARD a - CARD (a INTER b)  by CARD_DIFF
247      = CARD a - CARD b            by above
248*)
249Theorem SUBSET_DIFF_CARD:
250  !a b. FINITE a /\ b SUBSET a ==> (CARD (a DIFF b) = CARD a - CARD b)
251Proof
252  metis_tac[CARD_DIFF, SUBSET_FINITE, SUBSET_INTER2]
253QED
254
255(* Theorem: s SUBSET {x} <=> ((s = {}) \/ (s = {x})) *)
256(* Proof:
257   Note !y. y IN s ==> y = x   by SUBSET_DEF, IN_SING
258   If s = {}, then trivially true.
259   If s <> {},
260     then ?y. y IN s           by MEMBER_NOT_EMPTY, s <> {}
261       so y = x                by above
262      ==> s = {x}              by EXTENSION
263*)
264Theorem SUBSET_SING_IFF:
265  !s x. s SUBSET {x} <=> ((s = {}) \/ (s = {x}))
266Proof
267  rw[SUBSET_DEF, EXTENSION] >>
268  metis_tac[]
269QED
270
271(* Theorem: FINITE t /\ s SUBSET t ==> (CARD s = CARD t <=> s = t) *)
272(* Proof:
273   If part: CARD s = CARD t ==> s = t
274      By contradiction, suppose s <> t.
275      Then s PSUBSET t         by PSUBSET_DEF
276        so CARD s < CARD t     by CARD_PSUBSET, FINITE t
277      This contradicts CARD s = CARD t.
278   Only-if part is trivial.
279*)
280Theorem SUBSET_CARD_EQ:
281  !s t. FINITE t /\ s SUBSET t ==> (CARD s = CARD t <=> s = t)
282Proof
283  rw[EQ_IMP_THM] >>
284  spose_not_then strip_assume_tac >>
285  `s PSUBSET t` by rw[PSUBSET_DEF] >>
286  `CARD s < CARD t` by rw[CARD_PSUBSET] >>
287  decide_tac
288QED
289
290(* Theorem: (!x. x IN s ==> f x IN t) <=> (IMAGE f s) SUBSET t *)
291(* Proof:
292   If part: (!x. x IN s ==> f x IN t) ==> (IMAGE f s) SUBSET t
293       y IN (IMAGE f s)
294   ==> ?x. (y = f x) /\ x IN s   by IN_IMAGE
295   ==> f x = y IN t              by given
296   hence (IMAGE f s) SUBSET t    by SUBSET_DEF
297   Only-if part: (IMAGE f s) SUBSET t ==>  (!x. x IN s ==> f x IN t)
298       x IN s
299   ==> f x IN (IMAGE f s)        by IN_IMAGE
300   ==> f x IN t                  by SUBSET_DEF
301*)
302Theorem IMAGE_SUBSET_TARGET:
303    !f s t. (!x. x IN s ==> f x IN t) <=> (IMAGE f s) SUBSET t
304Proof
305  metis_tac[IN_IMAGE, SUBSET_DEF]
306QED
307
308(* Theorem: SURJ f s t ==> CARD (IMAGE f s) = CARD t *)
309(* Proof:
310   Note IMAGE f s = t              by IMAGE_SURJ
311   Thus CARD (IMAGE f s) = CARD t  by above
312*)
313Theorem SURJ_CARD_IMAGE:
314  !f s t. SURJ f s t ==> CARD (IMAGE f s) = CARD t
315Proof
316  simp[IMAGE_SURJ]
317QED
318
319(* ------------------------------------------------------------------------- *)
320(* Image and Bijection (from examples/algebra)                               *)
321(* ------------------------------------------------------------------------- *)
322
323(* Theorem: INJ f s t ==> INJ f s UNIV *)
324(* Proof:
325   Note s SUBSET s                        by SUBSET_REFL
326    and t SUBSET univ(:'b)                by SUBSET_UNIV
327     so INJ f s t ==> INJ f s univ(:'b)   by INJ_SUBSET
328*)
329Theorem INJ_UNIV:
330    !f s t. INJ f s t ==> INJ f s UNIV
331Proof
332  metis_tac[INJ_SUBSET, SUBSET_REFL, SUBSET_UNIV]
333QED
334
335(* Theorem: INJ f s UNIV ==> BIJ f s (IMAGE f s) *)
336(* Proof: by definitions. *)
337Theorem INJ_IMAGE_BIJ_ALT:
338    !f s. INJ f s UNIV ==> BIJ f s (IMAGE f s)
339Proof
340  rw[BIJ_DEF, INJ_DEF, SURJ_DEF]
341QED
342
343(* Theorem: s <> {} ==> !e. IMAGE (K e) s = {e} *)
344(* Proof:
345       IMAGE (K e) s
346   <=> {(K e) x | x IN s}    by IMAGE_DEF
347   <=> {e | x IN s}          by K_THM
348   <=> {e}                   by EXTENSION, if s <> {}
349*)
350Theorem IMAGE_K:
351    !s. s <> {} ==> !e. IMAGE (K e) s = {e}
352Proof
353  rw[EXTENSION, EQ_IMP_THM]
354QED
355
356(* Theorem: (!x y. (f x = f y) ==> (x = y)) ==> (!s e. e IN s <=> f e IN IMAGE f s) *)
357(* Proof:
358   If part: e IN s ==> f e IN IMAGE f s
359     True by IMAGE_IN.
360   Only-if part: f e IN IMAGE f s ==> e IN s
361     ?x. (f e = f x) /\ x IN s   by IN_IMAGE
362     f e = f x ==> e = x         by given implication
363     Hence x IN s
364*)
365Theorem IMAGE_ELEMENT_CONDITION:
366    !f:'a -> 'b. (!x y. (f x = f y) ==> (x = y)) ==> (!s e. e IN s <=> f e IN IMAGE f s)
367Proof
368  rw[EQ_IMP_THM] >>
369  metis_tac[]
370QED
371
372(* Theorem: BIGUNION (IMAGE (\x. {x}) s) = s *)
373(* Proof:
374       z IN BIGUNION (IMAGE (\x. {x}) s)
375   <=> ?t. z IN t /\ t IN (IMAGE (\x. {x}) s)   by IN_BIGUNION
376   <=> ?t. z IN t /\ (?y. y IN s /\ (t = {y}))  by IN_IMAGE
377   <=> z IN {z} /\ (?y. y IN s /\ {z} = {y})    by picking t = {z}
378   <=> T /\ z IN s                              by picking y = z, IN_SING
379   Hence  BIGUNION (IMAGE (\x. {x}) s) = s      by EXTENSION
380*)
381Theorem BIGUNION_ELEMENTS_SING:
382    !s. BIGUNION (IMAGE (\x. {x}) s) = s
383Proof
384  rw[EXTENSION, EQ_IMP_THM] >-
385  metis_tac[] >>
386  qexists_tac `{x}` >>
387  metis_tac[IN_SING]
388QED
389
390(* Theorem: s SUBSET t /\ INJ f t UNIV ==> (IMAGE f (t DIFF s) = (IMAGE f t) DIFF (IMAGE f s)) *)
391(* Proof: by SUBSET_DEF, INJ_DEF, EXTENSION, IN_IMAGE, IN_DIFF *)
392Theorem IMAGE_DIFF:
393  !s t f. s SUBSET t /\ INJ f t UNIV ==> (IMAGE f (t DIFF s) = (IMAGE f t) DIFF (IMAGE f s))
394Proof
395  rw[SUBSET_DEF, INJ_DEF, EXTENSION] >>
396  metis_tac[]
397QED
398
399(* ------------------------------------------------------------------------- *)
400(* Set of Proper Subsets                                                     *)
401(* ------------------------------------------------------------------------- *)
402
403(* Define the set of all proper subsets of a set *)
404Overload PPOW = ``\s. (POW s) DIFF {s}``
405
406(* Theorem: !s e. e IN PPOW s ==> e PSUBSET s *)
407(* Proof:
408     e IN PPOW s
409   = e IN ((POW s) DIFF {s})       by notation
410   = (e IN POW s) /\ e NOTIN {s}   by IN_DIFF
411   = (e SUBSET s) /\ e NOTIN {s}   by IN_POW
412   = (e SUBSET s) /\ e <> s        by IN_SING
413   = e PSUBSET s                   by PSUBSET_DEF
414*)
415Theorem IN_PPOW:
416    !s e. e IN PPOW s ==> e PSUBSET s
417Proof
418  rw[PSUBSET_DEF, IN_POW]
419QED
420
421(* Theorem: FINITE (PPOW s) *)
422(* Proof:
423   Since PPOW s = (POW s) DIFF {s},
424       FINITE s
425   ==> FINITE (POW s)     by FINITE_POW
426   ==> FINITE ((POW s) DIFF {s})  by FINITE_DIFF
427   ==> FINITE (PPOW s)            by above
428*)
429Theorem FINITE_PPOW:
430    !s. FINITE s ==> FINITE (PPOW s)
431Proof
432  rw[FINITE_POW]
433QED
434
435(* Theorem: FINITE s ==> CARD (PPOW s) = PRE (2 ** CARD s) *)
436(* Proof:
437     CARD (PPOW s)
438   = CARD ((POW s) DIFF {s})      by notation
439   = CARD (POW s) - CARD ((POW s) INTER {s})   by CARD_DIFF
440   = CARD (POW s) - CARD {s}      by INTER_SING, since s IN POW s
441   = 2 ** CARD s  - CARD {s}      by CARD_POW
442   = 2 ** CARD s  - 1             by CARD_SING
443   = PRE (2 ** CARD s)            by PRE_SUB1
444*)
445Theorem CARD_PPOW:
446    !s. FINITE s ==> (CARD (PPOW s) = PRE (2 ** CARD s))
447Proof
448  rpt strip_tac >>
449  `FINITE {s}` by rw[FINITE_SING] >>
450  `FINITE (POW s)` by rw[FINITE_POW] >>
451  `s IN (POW s)` by rw[IN_POW, SUBSET_REFL] >>
452  `CARD (PPOW s) = CARD (POW s) - CARD ((POW s) INTER {s})` by rw[CARD_DIFF] >>
453  `_ = CARD (POW s) - CARD {s}` by rw[INTER_SING] >>
454  `_ = 2 ** CARD s  - CARD {s}` by rw[CARD_POW] >>
455  `_ = 2 ** CARD s  - 1` by rw[CARD_SING] >>
456  `_ = PRE (2 ** CARD s)` by rw[PRE_SUB1] >>
457  rw[]
458QED
459
460(* Theorem: FINITE s ==> CARD (PPOW s) = PRE (2 ** CARD s) *)
461(* Proof: by CARD_PPOW *)
462Theorem CARD_PPOW_EQN:
463    !s. FINITE s ==> (CARD (PPOW s) = (2 ** CARD s) - 1)
464Proof
465  rw[CARD_PPOW]
466QED
467
468(* ------------------------------------------------------------------------- *)
469(* Partition Property                                                        *)
470(* ------------------------------------------------------------------------- *)
471
472(* Overload partition by split *)
473Overload split = ``\s u v. (s = u UNION v) /\ (DISJOINT u v)``
474
475(* Pretty printing of partition by split *)
476val _ = add_rule {block_style = (AroundEachPhrase, (PP.CONSISTENT, 2)),
477                       fixity = Infix(NONASSOC, 450),
478                  paren_style = OnlyIfNecessary,
479                    term_name = "split",
480                  pp_elements = [HardSpace 1, TOK "=|=", HardSpace 1, TM,
481                                 BreakSpace(1,1), TOK "#", BreakSpace(1,1)]};
482
483(* Theorem: FINITE s ==> !u v. s =|= u # v ==> (PROD_SET s = PROD_SET u * PROD_SET v) *)
484(* Proof:
485   By finite induction on s.
486   Base: {} = u UNION v ==> PROD_SET {} = PROD_SET u * PROD_SET v
487      Note u = {} and v = {}       by EMPTY_UNION
488       and PROD_SET {} = 1         by PROD_SET_EMPTY
489      Hence true.
490   Step: !u v. (s = u UNION v) /\ DISJOINT u v ==> (PROD_SET s = PROD_SET u * PROD_SET v) ==>
491         e NOTIN s /\ e INSERT s = u UNION v ==> PROD_SET (e INSERT s) = PROD_SET u * PROD_SET v
492      Note e IN u \/ e IN v        by IN_INSERT, IN_UNION
493      If e IN u,
494         Then e NOTIN v            by IN_DISJOINT
495         Let w = u DELETE e.
496         Then e NOTIN w            by IN_DELETE
497          and u = e INSERT w       by INSERT_DELETE
498         Note s = w UNION v        by EXTENSION, IN_INSERT, IN_UNION
499          ==> FINITE w             by FINITE_UNION
500          and DISJOINT w v         by DISJOINT_INSERT
501        PROD_SET (e INSERT s)
502      = e * PROD_SET s                       by PROD_SET_INSERT, FINITE s
503      = e * (PROD_SET w * PROD_SET v)        by induction hypothesis
504      = (e * PROD_SET w) * PROD_SET v        by MULT_ASSOC
505      = PROD_SET (e INSERT w) * PROD_SET v   by PROD_SET_INSERT, FINITE w
506      = PROD_SET u * PROD_SET v
507
508      Similarly for e IN v.
509*)
510Theorem PROD_SET_PRODUCT_BY_PARTITION:
511    !s. FINITE s ==> !u v. s =|= u # v ==> (PROD_SET s = PROD_SET u * PROD_SET v)
512Proof
513  Induct_on `FINITE` >>
514  rpt strip_tac >-
515  fs[PROD_SET_EMPTY] >>
516  `e IN u \/ e IN v` by metis_tac[IN_INSERT, IN_UNION] >| [
517    qabbrev_tac `w = u DELETE e` >>
518    `u = e INSERT w` by rw[Abbr`w`] >>
519    `e NOTIN w` by rw[Abbr`w`] >>
520    `e NOTIN v` by metis_tac[IN_DISJOINT] >>
521    `s = w UNION v` by
522  (rw[EXTENSION] >>
523    metis_tac[IN_INSERT, IN_UNION]) >>
524    `FINITE w` by metis_tac[FINITE_UNION] >>
525    `DISJOINT w v` by metis_tac[DISJOINT_INSERT] >>
526    `PROD_SET (e INSERT s) = e * PROD_SET s` by rw[PROD_SET_INSERT] >>
527    `_ = e * (PROD_SET w * PROD_SET v)` by rw[] >>
528    `_ = (e * PROD_SET w) * PROD_SET v` by rw[] >>
529    `_ = PROD_SET u * PROD_SET v` by rw[PROD_SET_INSERT] >>
530    rw[],
531    qabbrev_tac `w = v DELETE e` >>
532    `v = e INSERT w` by rw[Abbr`w`] >>
533    `e NOTIN w` by rw[Abbr`w`] >>
534    `e NOTIN u` by metis_tac[IN_DISJOINT] >>
535    `s = u UNION w` by
536  (rw[EXTENSION] >>
537    metis_tac[IN_INSERT, IN_UNION]) >>
538    `FINITE w` by metis_tac[FINITE_UNION] >>
539    `DISJOINT u w` by metis_tac[DISJOINT_INSERT, DISJOINT_SYM] >>
540    `PROD_SET (e INSERT s) = e * PROD_SET s` by rw[PROD_SET_INSERT] >>
541    `_ = e * (PROD_SET u * PROD_SET w)` by rw[] >>
542    `_ = PROD_SET u * (e * PROD_SET w)` by rw[] >>
543    `_ = PROD_SET u * PROD_SET v` by rw[PROD_SET_INSERT] >>
544    rw[]
545  ]
546QED
547
548(* ------------------------------------------------------------------------- *)
549(* Arithmetic Theorems (from examples/algebra)                               *)
550(* ------------------------------------------------------------------------- *)
551
552(* Theorem: 3 = SUC 2 *)
553(* Proof: by arithmetic *)
554Theorem THREE:
555    3 = SUC 2
556Proof
557  decide_tac
558QED
559
560(* Theorem: 4 = SUC 3 *)
561(* Proof: by arithmetic *)
562Theorem FOUR:
563    4 = SUC 3
564Proof
565  decide_tac
566QED
567
568(* Theorem: 5 = SUC 4 *)
569(* Proof: by arithmetic *)
570Theorem FIVE:
571    5 = SUC 4
572Proof
573  decide_tac
574QED
575
576(* Overload squaring (temporalized by Chun Tian) *)
577Overload SQ[local] = ``\n. n * n``(* not n ** 2 *)
578
579(* Overload half of a number (temporalized by Chun Tian) *)
580Overload HALF[local] = ``\n. n DIV 2``
581
582(* Overload twice of a number (temporalized by Chun Tian) *)
583Overload TWICE[local] = ``\n. 2 * n``
584
585(* make divides infix *)
586val _ = set_fixity "divides" (Infixl 480); (* relation is 450, +/- is 500, * is 600. *)
587
588(* Theorem alias *)
589Theorem ZERO_LE_ALL = ZERO_LESS_EQ;
590(* val ZERO_LE_ALL = |- !n. 0 <= n: thm *)
591
592(* Extract theorem *)
593Theorem ONE_NOT_0  = DECIDE``1 <> 0``;
594(* val ONE_NOT_0 = |- 1 <> 0: thm *)
595
596(* Theorem: !n. 1 < n ==> 0 < n *)
597(* Proof: by arithmetic. *)
598Theorem ONE_LT_POS:
599    !n. 1 < n ==> 0 < n
600Proof
601  decide_tac
602QED
603
604(* Theorem: !n. 1 < n ==> n <> 0 *)
605(* Proof: by arithmetic. *)
606Theorem ONE_LT_NONZERO:
607    !n. 1 < n ==> n <> 0
608Proof
609  decide_tac
610QED
611
612(* Theorem: ~(1 < n) <=> (n = 0) \/ (n = 1) *)
613(* Proof: by arithmetic. *)
614Theorem NOT_LT_ONE:
615    !n. ~(1 < n) <=> (n = 0) \/ (n = 1)
616Proof
617  decide_tac
618QED
619
620(* Theorem: n <> 0 <=> 1 <= n *)
621(* Proof: by arithmetic. *)
622Theorem NOT_ZERO_GE_ONE:
623    !n. n <> 0 <=> 1 <= n
624Proof
625  decide_tac
626QED
627
628(* Theorem: n <= 1 <=> (n = 0) \/ (n = 1) *)
629(* Proof: by arithmetic *)
630Theorem LE_ONE:
631    !n. n <= 1 <=> (n = 0) \/ (n = 1)
632Proof
633  decide_tac
634QED
635
636(* arithmeticTheory.LESS_EQ_SUC_REFL |- !m. m <= SUC m *)
637
638(* Theorem: n < SUC n *)
639(* Proof: by arithmetic. *)
640Theorem LESS_SUC:
641    !n. n < SUC n
642Proof
643  decide_tac
644QED
645
646(* Theorem: 0 < n ==> PRE n < n *)
647(* Proof: by arithmetic. *)
648Theorem PRE_LESS:
649    !n. 0 < n ==> PRE n < n
650Proof
651  decide_tac
652QED
653
654(* Theorem: 0 < n ==> ?m. n = SUC m *)
655(* Proof: by NOT_ZERO_LT_ZERO, num_CASES. *)
656Theorem SUC_EXISTS:
657    !n. 0 < n ==> ?m. n = SUC m
658Proof
659  metis_tac[NOT_ZERO_LT_ZERO, num_CASES]
660QED
661
662
663(* Theorem: 1 <> 0 *)
664(* Proof: by ONE, SUC_ID *)
665Theorem ONE_NOT_ZERO:
666    1 <> 0
667Proof
668  decide_tac
669QED
670
671(* Theorem: (SUC m) + (SUC n) = m + n + 2 *)
672(* Proof:
673     (SUC m) + (SUC n)
674   = (m + 1) + (n + 1)     by ADD1
675   = m + n + 2             by arithmetic
676*)
677Theorem SUC_ADD_SUC:
678    !m n. (SUC m) + (SUC n) = m + n + 2
679Proof
680  decide_tac
681QED
682
683(* Theorem: (SUC m) * (SUC n) = m * n + m + n + 1 *)
684(* Proof:
685     (SUC m) * (SUC n)
686   = SUC m + (SUC m) * n   by MULT_SUC
687   = SUC m + n * (SUC m)   by MULT_COMM
688   = SUC m + (n + n * m)   by MULT_SUC
689   = m * n + m + n + 1     by arithmetic
690*)
691Theorem SUC_MULT_SUC:
692    !m n. (SUC m) * (SUC n) = m * n + m + n + 1
693Proof
694  rw[MULT_SUC]
695QED
696
697(* Theorem: (SUC m = SUC n) <=> (m = n) *)
698(* Proof: by prim_recTheory.INV_SUC_EQ *)
699Theorem SUC_EQ:
700    !m n. (SUC m = SUC n) <=> (m = n)
701Proof
702  rw[]
703QED
704
705(* Theorem: (TWICE n = 0) <=> (n = 0) *)
706(* Proof: MULT_EQ_0 *)
707Theorem TWICE_EQ_0:
708    !n. (TWICE n = 0) <=> (n = 0)
709Proof
710  rw[]
711QED
712
713(* Theorem: (SQ n = 0) <=> (n = 0) *)
714(* Proof: MULT_EQ_0 *)
715Theorem SQ_EQ_0:
716    !n. (SQ n = 0) <=> (n = 0)
717Proof
718  rw[]
719QED
720
721(* Theorem: (SQ n = 1) <=> (n = 1) *)
722(* Proof: MULT_EQ_1 *)
723Theorem SQ_EQ_1:
724    !n. (SQ n = 1) <=> (n = 1)
725Proof
726  rw[]
727QED
728
729(* Theorem: (x * y * z = 0) <=> ((x = 0) \/ (y = 0) \/ (z = 0)) *)
730(* Proof: by MULT_EQ_0 *)
731Theorem MULT3_EQ_0:
732    !x y z. (x * y * z = 0) <=> ((x = 0) \/ (y = 0) \/ (z = 0))
733Proof
734  metis_tac[MULT_EQ_0]
735QED
736
737(* Theorem: (x * y * z = 1) <=> ((x = 1) /\ (y = 1) /\ (z = 1)) *)
738(* Proof: by MULT_EQ_1 *)
739Theorem MULT3_EQ_1:
740    !x y z. (x * y * z = 1) <=> ((x = 1) /\ (y = 1) /\ (z = 1))
741Proof
742  metis_tac[MULT_EQ_1]
743QED
744
745(* Theorem: 0 ** 2 = 0 *)
746(* Proof: by ZERO_EXP *)
747Theorem SQ_0:
748  0 ** 2 = 0
749Proof
750  simp[]
751QED
752
753(* Theorem: (n ** 2 = 0) <=> (n = 0) *)
754(* Proof: by EXP_2, MULT_EQ_0 *)
755Theorem EXP_2_EQ_0:
756  !n. (n ** 2 = 0) <=> (n = 0)
757Proof
758  simp[]
759QED
760
761(* LE_MULT_LCANCEL |- !m n p. m * n <= m * p <=> m = 0 \/ n <= p *)
762
763(* Theorem: n <= p ==> m * n <= m * p *)
764(* Proof:
765   If m = 0, this is trivial.
766   If m <> 0, this is true by LE_MULT_LCANCEL.
767*)
768Theorem LE_MULT_LCANCEL_IMP:
769  !m n p. n <= p ==> m * n <= m * p
770Proof
771  simp[]
772QED
773
774(* ------------------------------------------------------------------------- *)
775(* Maximum and minimum                                                       *)
776(* ------------------------------------------------------------------------- *)
777
778(* Theorem: MAX m n = if m <= n then n else m *)
779(* Proof: by MAX_DEF *)
780Theorem MAX_ALT:
781    !m n. MAX m n = if m <= n then n else m
782Proof
783  rw[MAX_DEF]
784QED
785
786(* Theorem: MIN m n = if m <= n then m else n *)
787(* Proof: by MIN_DEF *)
788Theorem MIN_ALT:
789    !m n. MIN m n = if m <= n then m else n
790Proof
791  rw[MIN_DEF]
792QED
793
794(* Theorem: (!x y. x <= y ==> f x <= f y) ==> !x y. f (MAX x y) = MAX (f x) (f y) *)
795(* Proof: by MAX_DEF *)
796Theorem MAX_SWAP:
797    !f. (!x y. x <= y ==> f x <= f y) ==> !x y. f (MAX x y) = MAX (f x) (f y)
798Proof
799  rw[MAX_DEF] >>
800  Cases_on `x < y` >| [
801    `f x <= f y` by rw[] >>
802    Cases_on `f x = f y` >-
803    rw[] >>
804    rw[],
805    `y <= x` by decide_tac >>
806    `f y <= f x` by rw[] >>
807    rw[]
808  ]
809QED
810
811(* Theorem: (!x y. x <= y ==> f x <= f y) ==> !x y. f (MIN x y) = MIN (f x) (f y) *)
812(* Proof: by MIN_DEF *)
813Theorem MIN_SWAP:
814    !f. (!x y. x <= y ==> f x <= f y) ==> !x y. f (MIN x y) = MIN (f x) (f y)
815Proof
816  rw[MIN_DEF] >>
817  Cases_on `x < y` >| [
818    `f x <= f y` by rw[] >>
819    Cases_on `f x = f y` >-
820    rw[] >>
821    rw[],
822    `y <= x` by decide_tac >>
823    `f y <= f x` by rw[] >>
824    rw[]
825  ]
826QED
827
828(* Theorem: SUC (MAX m n) = MAX (SUC m) (SUC n) *)
829(* Proof:
830   If m < n, then SUC m < SUC n    by LESS_MONO_EQ
831      hence true by MAX_DEF.
832   If m = n, then true by MAX_IDEM.
833   If n < m, true by MAX_COMM of the case m < n.
834*)
835Theorem SUC_MAX:
836    !m n. SUC (MAX m n) = MAX (SUC m) (SUC n)
837Proof
838  rw[MAX_DEF]
839QED
840
841(* Theorem: SUC (MIN m n) = MIN (SUC m) (SUC n) *)
842(* Proof: by MIN_DEF *)
843Theorem SUC_MIN:
844    !m n. SUC (MIN m n) = MIN (SUC m) (SUC n)
845Proof
846  rw[MIN_DEF]
847QED
848
849(* Reverse theorems *)
850Theorem MAX_SUC = GSYM SUC_MAX;
851(* val MAX_SUC = |- !m n. MAX (SUC m) (SUC n) = SUC (MAX m n): thm *)
852Theorem MIN_SUC = GSYM SUC_MIN;
853(* val MIN_SUC = |- !m n. MIN (SUC m) (SUC n) = SUC (MIN m n): thm *)
854
855(* Theorem: x < n /\ y < n ==> MAX x y < n *)
856(* Proof:
857        MAX x y
858      = if x < y then y else x    by MAX_DEF
859      = either x or y
860      < n                         for either case
861*)
862Theorem MAX_LESS:
863    !x y n. x < n /\ y < n ==> MAX x y < n
864Proof
865  rw[]
866QED
867
868(* Theorem: m <= MAX m n /\ n <= MAX m n *)
869(* Proof: by MAX_DEF *)
870Theorem MAX_IS_MAX:
871    !m n. m <= MAX m n /\ n <= MAX m n
872Proof
873  rw_tac std_ss[MAX_DEF]
874QED
875
876(* Theorem: MIN m n <= m /\ MIN m n <= n *)
877(* Proof: by MIN_DEF *)
878Theorem MIN_IS_MIN:
879    !m n. MIN m n <= m /\ MIN m n <= n
880Proof
881  rw_tac std_ss[MIN_DEF]
882QED
883
884(* Theorem: (MAX (MAX m n) n = MAX m n) /\ (MAX m (MAX m n) = MAX m n) *)
885(* Proof: by MAX_DEF *)
886Theorem MAX_ID:
887    !m n. (MAX (MAX m n) n = MAX m n) /\ (MAX m (MAX m n) = MAX m n)
888Proof
889  rw[MAX_DEF]
890QED
891
892(* Theorem: (MIN (MIN m n) n = MIN m n) /\ (MIN m (MIN m n) = MIN m n) *)
893(* Proof: by MIN_DEF *)
894Theorem MIN_ID:
895    !m n. (MIN (MIN m n) n = MIN m n) /\ (MIN m (MIN m n) = MIN m n)
896Proof
897  rw[MIN_DEF]
898QED
899
900(* Theorem: a <= b /\ c <= d ==> MAX a c <= MAX b d *)
901(* Proof: by MAX_DEF *)
902Theorem MAX_LE_PAIR:
903    !a b c d. a <= b /\ c <= d ==> MAX a c <= MAX b d
904Proof
905  rw[]
906QED
907
908(* Theorem: a <= b /\ c <= d ==> MIN a c <= MIN b d *)
909(* Proof: by MIN_DEF *)
910Theorem MIN_LE_PAIR:
911    !a b c d. a <= b /\ c <= d ==> MIN a c <= MIN b d
912Proof
913  rw[]
914QED
915
916(* Theorem: MAX a (b + c) <= MAX a b + MAX a c *)
917(* Proof: by MAX_DEF *)
918Theorem MAX_ADD:
919    !a b c. MAX a (b + c) <= MAX a b + MAX a c
920Proof
921  rw[MAX_DEF]
922QED
923
924(* Theorem: MIN a (b + c) <= MIN a b + MIN a c *)
925(* Proof: by MIN_DEF *)
926Theorem MIN_ADD:
927    !a b c. MIN a (b + c) <= MIN a b + MIN a c
928Proof
929  rw[MIN_DEF]
930QED
931
932(* Theorem: 0 < n ==> (MAX 1 n = n) *)
933(* Proof: by MAX_DEF *)
934Theorem MAX_1_POS:
935    !n. 0 < n ==> (MAX 1 n = n)
936Proof
937  rw[MAX_DEF]
938QED
939
940(* Theorem: 0 < n ==> (MIN 1 n = 1) *)
941(* Proof: by MIN_DEF *)
942Theorem MIN_1_POS:
943    !n. 0 < n ==> (MIN 1 n = 1)
944Proof
945  rw[MIN_DEF]
946QED
947
948(* Theorem: MAX m n <= m + n *)
949(* Proof:
950   If m < n,  MAX m n = n <= m + n  by arithmetic
951   Otherwise, MAX m n = m <= m + n  by arithmetic
952*)
953Theorem MAX_LE_SUM:
954    !m n. MAX m n <= m + n
955Proof
956  rw[MAX_DEF]
957QED
958
959(* Theorem: MIN m n <= m + n *)
960(* Proof:
961   If m < n,  MIN m n = m <= m + n  by arithmetic
962   Otherwise, MIN m n = n <= m + n  by arithmetic
963*)
964Theorem MIN_LE_SUM:
965    !m n. MIN m n <= m + n
966Proof
967  rw[MIN_DEF]
968QED
969
970(* Theorem: MAX 1 (m ** n) = (MAX 1 m) ** n *)
971(* Proof:
972   If m = 0,
973      Then 0 ** n = 0 or 1          by ZERO_EXP
974      Thus MAX 1 (0 ** n) = 1       by MAX_DEF
975       and (MAX 1 0) ** n = 1       by MAX_DEF, EXP_1
976   If m <> 0,
977      Then 0 < m ** n               by EXP_POS
978        so MAX 1 (m ** n) = m ** n  by MAX_DEF
979       and (MAX 1 m) ** n = m ** n  by MAX_DEF, 0 < m
980*)
981Theorem MAX_1_EXP:
982    !n m. MAX 1 (m ** n) = (MAX 1 m) ** n
983Proof
984  rpt strip_tac >>
985  Cases_on `m = 0` >-
986  rw[ZERO_EXP, MAX_DEF] >>
987  `0 < m /\ 0 < m ** n` by rw[] >>
988  `MAX 1 (m ** n) = m ** n` by rw[MAX_DEF] >>
989  `MAX 1 m = m` by rw[MAX_DEF] >>
990  fs[]
991QED
992
993(* Theorem: MIN 1 (m ** n) = (MIN 1 m) ** n *)
994(* Proof:
995   If m = 0,
996      Then 0 ** n = 0 or 1          by ZERO_EXP
997      Thus MIN 1 (0 ** n) = 0 when n <> 0 or 1 when n = 0  by MIN_DEF
998       and (MIN 1 0) ** n = 0 ** n  by MIN_DEF
999   If m <> 0,
1000      Then 0 < m ** n               by EXP_POS
1001        so MIN 1 (m ** n) = 1 ** n  by MIN_DEF
1002       and (MIN 1 m) ** n = 1 ** n  by MIN_DEF, 0 < m
1003*)
1004Theorem MIN_1_EXP:
1005    !n m. MIN 1 (m ** n) = (MIN 1 m) ** n
1006Proof
1007  rpt strip_tac >>
1008  Cases_on `m = 0` >-
1009  rw[ZERO_EXP, MIN_DEF] >>
1010  `0 < m ** n` by rw[] >>
1011  `MIN 1 (m ** n) = 1` by rw[MIN_DEF] >>
1012  `MIN 1 m = 1` by rw[MIN_DEF] >>
1013  fs[]
1014QED
1015
1016(* ------------------------------------------------------------------------- *)
1017(* Arithmetic Manipulations                                                  *)
1018(* ------------------------------------------------------------------------- *)
1019
1020(* Theorem: (n * n = n) <=> ((n = 0) \/ (n = 1)) *)
1021(* Proof:
1022   If part: n * n = n ==> (n = 0) \/ (n = 1)
1023      By contradiction, suppose n <> 0 /\ n <> 1.
1024      Since n * n = n = n * 1     by MULT_RIGHT_1
1025       then     n = 1             by MULT_LEFT_CANCEL, n <> 0
1026       This contradicts n <> 1.
1027   Only-if part: (n = 0) \/ (n = 1) ==> n * n = n
1028      That is, 0 * 0 = 0          by MULT
1029           and 1 * 1 = 1          by MULT_RIGHT_1
1030*)
1031Theorem SQ_EQ_SELF:
1032    !n. (n * n = n) <=> ((n = 0) \/ (n = 1))
1033Proof
1034  rw_tac bool_ss[EQ_IMP_THM] >-
1035  metis_tac[MULT_RIGHT_1, MULT_LEFT_CANCEL] >-
1036  rw[] >>
1037  rw[]
1038QED
1039
1040(* Theorem: m <= n /\ 0 < c ==> b ** c ** m <= b ** c ** n *)
1041(* Proof:
1042   If b = 0,
1043      Note 0 < c ** m /\ 0 < c ** n   by EXP_POS, by 0 < c
1044      Thus 0 ** c ** m = 0            by ZERO_EXP
1045       and 0 ** c ** n = 0            by ZERO_EXP
1046      Hence true.
1047   If b <> 0,
1048      Then c ** m <= c ** n           by EXP_BASE_LEQ_MONO_IMP, 0 < c
1049        so b ** c ** m <= b ** c ** n by EXP_BASE_LEQ_MONO_IMP, 0 < b
1050*)
1051Theorem EXP_EXP_BASE_LE:
1052    !b c m n. m <= n /\ 0 < c ==> b ** c ** m <= b ** c ** n
1053Proof
1054  rpt strip_tac >>
1055  Cases_on `b = 0` >-
1056  rw[ZERO_EXP] >>
1057  rw[EXP_BASE_LEQ_MONO_IMP]
1058QED
1059
1060(* Theorem: a <= b ==> a ** n <= b ** n *)
1061(* Proof:
1062   Note a ** n <= b ** n                 by EXP_EXP_LE_MONO
1063   Thus size (a ** n) <= size (b ** n)   by size_monotone_le
1064*)
1065Theorem EXP_EXP_LE_MONO_IMP:
1066    !a b n. a <= b ==> a ** n <= b ** n
1067Proof
1068  rw[]
1069QED
1070
1071(* Theorem: m <= n ==> !p. p ** n = p ** m * p ** (n - m) *)
1072(* Proof:
1073   Note n = (n - m) + m          by m <= n
1074        p ** n
1075      = p ** (n - m) * p ** m    by EXP_ADD
1076      = p ** m * p ** (n - m)    by MULT_COMM
1077*)
1078Theorem EXP_BY_ADD_SUB_LE:
1079    !m n. m <= n ==> !p. p ** n = p ** m * p ** (n - m)
1080Proof
1081  rpt strip_tac >>
1082  `n = (n - m) + m` by decide_tac >>
1083  metis_tac[EXP_ADD, MULT_COMM]
1084QED
1085
1086(* Theorem: m < n ==> (p ** n = p ** m * p ** (n - m)) *)
1087(* Proof: by EXP_BY_ADD_SUB_LE, LESS_IMP_LESS_OR_EQ *)
1088Theorem EXP_BY_ADD_SUB_LT:
1089    !m n. m < n ==> !p. p ** n = p ** m * p ** (n - m)
1090Proof
1091  rw[EXP_BY_ADD_SUB_LE]
1092QED
1093
1094(* Theorem: 0 < m ==> m ** (SUC n) DIV m = m ** n *)
1095(* Proof:
1096     m ** (SUC n) DIV m
1097   = (m * m ** n) DIV m    by EXP
1098   = m ** n                by MULT_TO_DIV, 0 < m
1099*)
1100Theorem EXP_SUC_DIV:
1101    !m n. 0 < m ==> (m ** (SUC n) DIV m = m ** n)
1102Proof
1103  simp[EXP, MULT_TO_DIV]
1104QED
1105
1106(* Theorem: n <= n ** 2 *)
1107(* Proof:
1108   If n = 0,
1109      Then n ** 2 = 0 >= 0       by ZERO_EXP
1110   If n <> 0, then 0 < n         by NOT_ZERO_LT_ZERO
1111      Hence n = n ** 1           by EXP_1
1112             <= n ** 2           by EXP_BASE_LEQ_MONO_IMP
1113*)
1114Theorem SELF_LE_SQ:
1115    !n. n <= n ** 2
1116Proof
1117  rpt strip_tac >>
1118  Cases_on `n = 0` >-
1119  rw[] >>
1120  `0 < n /\ 1 <= 2` by decide_tac >>
1121  metis_tac[EXP_BASE_LEQ_MONO_IMP, EXP_1]
1122QED
1123
1124(* Theorem: a <= b /\ c <= d ==> a + c <= b + d *)
1125(* Proof: by LESS_EQ_LESS_EQ_MONO, or
1126   Note a <= b ==>  a + c <= b + c    by LE_ADD_RCANCEL
1127    and c <= d ==>  b + c <= b + d    by LE_ADD_LCANCEL
1128   Thus             a + c <= b + d    by LESS_EQ_TRANS
1129*)
1130Theorem LE_MONO_ADD2:
1131    !a b c d. a <= b /\ c <= d ==> a + c <= b + d
1132Proof
1133  rw[LESS_EQ_LESS_EQ_MONO]
1134QED
1135
1136(* Theorem: a < b /\ c < d ==> a + c < b + d *)
1137(* Proof:
1138   Note a < b ==>  a + c < b + c    by LT_ADD_RCANCEL
1139    and c < d ==>  b + c < b + d    by LT_ADD_LCANCEL
1140   Thus            a + c < b + d    by LESS_TRANS
1141*)
1142Theorem LT_MONO_ADD2:
1143    !a b c d. a < b /\ c < d ==> a + c < b + d
1144Proof
1145  rw[LT_ADD_RCANCEL, LT_ADD_LCANCEL]
1146QED
1147
1148(* Theorem: a <= b /\ c <= d ==> a * c <= b * d *)
1149(* Proof: by LESS_MONO_MULT2, or
1150   Note a <= b ==> a * c <= b * c  by LE_MULT_RCANCEL
1151    and c <= d ==> b * c <= b * d  by LE_MULT_LCANCEL
1152   Thus            a * c <= b * d  by LESS_EQ_TRANS
1153*)
1154Theorem LE_MONO_MULT2:
1155    !a b c d. a <= b /\ c <= d ==> a * c <= b * d
1156Proof
1157  rw[LESS_MONO_MULT2]
1158QED
1159
1160(* Theorem: a < b /\ c < d ==> a * c < b * d *)
1161(* Proof:
1162   Note 0 < b, by a < b.
1163    and 0 < d, by c < d.
1164   If c = 0,
1165      Then a * c = 0 < b * d   by MULT_EQ_0
1166   If c <> 0, then 0 < c       by NOT_ZERO_LT_ZERO
1167      a < b ==> a * c < b * c  by LT_MULT_RCANCEL, 0 < c
1168      c < d ==> b * c < b * d  by LT_MULT_LCANCEL, 0 < b
1169   Thus         a * c < b * d  by LESS_TRANS
1170*)
1171Theorem LT_MONO_MULT2:
1172    !a b c d. a < b /\ c < d ==> a * c < b * d
1173Proof
1174  rpt strip_tac >>
1175  `0 < b /\ 0 < d` by decide_tac >>
1176  Cases_on `c = 0` >-
1177  metis_tac[MULT_EQ_0, NOT_ZERO_LT_ZERO] >>
1178  metis_tac[LT_MULT_RCANCEL, LT_MULT_LCANCEL, LESS_TRANS, NOT_ZERO_LT_ZERO]
1179QED
1180
1181(* Theorem: 1 < m /\ 1 < n ==> (m + n <= m * n) *)
1182(* Proof:
1183   Let m = m' + 1, n = n' + 1.
1184   Note m' <> 0 /\ n' <> 0.
1185   Thus m' * n' <> 0               by MULT_EQ_0
1186     or 1 <= m' * n'
1187       m * n
1188     = (m' + 1) * (n' + 1)
1189     = m' * n' + m' + n' + 1       by arithmetic
1190    >= 1 + m' + n' + 1             by 1 <= m' * n'
1191     = m + n
1192*)
1193Theorem SUM_LE_PRODUCT:
1194    !m n. 1 < m /\ 1 < n ==> (m + n <= m * n)
1195Proof
1196  rpt strip_tac >>
1197  `m <> 0 /\ n <> 0` by decide_tac >>
1198  `?m' n'. (m = m' + 1) /\ (n = n' + 1)` by metis_tac[num_CASES, ADD1] >>
1199  `m * n = (m' + 1) * n' + (m' + 1)` by rw[LEFT_ADD_DISTRIB] >>
1200  `_ = m' * n' + n' + (m' + 1)` by rw[RIGHT_ADD_DISTRIB] >>
1201  `_ = m + (n' + m' * n')` by decide_tac >>
1202  `m' * n' <> 0` by fs[] >>
1203  decide_tac
1204QED
1205
1206(* Theorem: 0 < n ==> k * n + 1 <= (k + 1) * n *)
1207(* Proof:
1208        k * n + 1
1209     <= k * n + n          by 1 <= n
1210     <= (k + 1) * n        by RIGHT_ADD_DISTRIB
1211*)
1212Theorem MULTIPLE_SUC_LE:
1213    !n k. 0 < n ==> k * n + 1 <= (k + 1) * n
1214Proof
1215  decide_tac
1216QED
1217
1218(* ------------------------------------------------------------------------- *)
1219(* Simple Theorems                                                           *)
1220(* ------------------------------------------------------------------------- *)
1221
1222(* Theorem: 0 < m /\ 0 < n /\ (m + n = 2) ==> m = 1 /\ n = 1 *)
1223(* Proof: by arithmetic. *)
1224Theorem ADD_EQ_2:
1225    !m n. 0 < m /\ 0 < n /\ (m + n = 2) ==> (m = 1) /\ (n = 1)
1226Proof
1227  rw_tac arith_ss[]
1228QED
1229
1230(* Theorem: EVEN 0 *)
1231(* Proof: by EVEN. *)
1232Theorem EVEN_0:
1233    EVEN 0
1234Proof
1235  simp[]
1236QED
1237
1238(* Theorem: ODD 1 *)
1239(* Proof: by ODD. *)
1240Theorem ODD_1:
1241    ODD 1
1242Proof
1243  simp[]
1244QED
1245
1246(* Theorem: EVEN 2 *)
1247(* Proof: by EVEN_MOD2. *)
1248Theorem EVEN_2:
1249    EVEN 2
1250Proof
1251  EVAL_TAC
1252QED
1253
1254(*
1255EVEN_ADD  |- !m n. EVEN (m + n) <=> (EVEN m <=> EVEN n)
1256ODD_ADD   |- !m n. ODD (m + n) <=> (ODD m <=/=> ODD n)
1257EVEN_MULT |- !m n. EVEN (m * n) <=> EVEN m \/ EVEN n
1258ODD_MULT  |- !m n. ODD (m * n) <=> ODD m /\ ODD n
1259*)
1260
1261(* Derive theorems. *)
1262Theorem EVEN_SQ =
1263    EVEN_MULT |> SPEC ``n:num`` |> SPEC ``n:num`` |> SIMP_RULE arith_ss[] |> GEN_ALL;
1264(* val EVEN_SQ = |- !n. EVEN (n ** 2) <=> EVEN n: thm *)
1265Theorem ODD_SQ =
1266    ODD_MULT |> SPEC ``n:num`` |> SPEC ``n:num`` |> SIMP_RULE arith_ss[] |> GEN_ALL;
1267(* val ODD_SQ = |- !n. ODD (n ** 2) <=> ODD n: thm *)
1268
1269(* Theorem: EVEN (2 * a + b) <=> EVEN b *)
1270(* Proof:
1271       EVEN (2 * a + b)
1272   <=> EVEN (2 * a) /\ EVEN b      by EVEN_ADD
1273   <=>            T /\ EVEN b      by EVEN_DOUBLE
1274   <=> EVEN b
1275*)
1276Theorem EQ_PARITY:
1277  !a b. EVEN (2 * a + b) <=> EVEN b
1278Proof
1279  rw[EVEN_ADD, EVEN_DOUBLE]
1280QED
1281
1282(* Theorem: ODD x <=> (x MOD 2 = 1) *)
1283(* Proof:
1284   If part: ODD x ==> x MOD 2 = 1
1285      Since  ODD x
1286         <=> ~EVEN x          by ODD_EVEN
1287         <=> ~(x MOD 2 = 0)   by EVEN_MOD2
1288         But x MOD 2 < 2      by MOD_LESS, 0 < 2
1289          so x MOD 2 = 1      by arithmetic
1290   Only-if part: x MOD 2 = 1 ==> ODD x
1291      By contradiction, suppose ~ODD x.
1292      Then EVEN x             by ODD_EVEN
1293       and x MOD 2 = 0        by EVEN_MOD2
1294      This contradicts x MOD 2 = 1.
1295*)
1296Theorem ODD_MOD2:
1297    !x. ODD x <=> (x MOD 2 = 1)
1298Proof
1299  metis_tac[EVEN_MOD2, ODD_EVEN, MOD_LESS,
1300             DECIDE``0 <> 1 /\ 0 < 2 /\ !n. n < 2 /\ n <> 1 ==> (n = 0)``]
1301QED
1302
1303(* Theorem: (EVEN n <=> ODD (SUC n)) /\ (ODD n <=> EVEN (SUC n)) *)
1304(* Proof: by EVEN, ODD, EVEN_OR_ODD *)
1305Theorem EVEN_ODD_SUC:
1306    !n. (EVEN n <=> ODD (SUC n)) /\ (ODD n <=> EVEN (SUC n))
1307Proof
1308  metis_tac[EVEN, ODD, EVEN_OR_ODD]
1309QED
1310
1311(* Theorem: 0 < n ==> (EVEN n <=> ODD (PRE n)) /\ (ODD n <=> EVEN (PRE n)) *)
1312(* Proof: by EVEN, ODD, EVEN_OR_ODD, PRE_SUC_EQ *)
1313Theorem EVEN_ODD_PRE:
1314    !n. 0 < n ==> (EVEN n <=> ODD (PRE n)) /\ (ODD n <=> EVEN (PRE n))
1315Proof
1316  metis_tac[EVEN, ODD, EVEN_OR_ODD, PRE_SUC_EQ]
1317QED
1318
1319(* Theorem: EVEN (n * (n + 1)) *)
1320(* Proof:
1321   If EVEN n, true        by EVEN_MULT
1322   If ~(EVEN n),
1323      Then EVEN (SUC n)   by EVEN
1324        or EVEN (n + 1)   by ADD1
1325      Thus true           by EVEN_MULT
1326*)
1327Theorem EVEN_PARTNERS:
1328    !n. EVEN (n * (n + 1))
1329Proof
1330  metis_tac[EVEN, EVEN_MULT, ADD1]
1331QED
1332
1333(* Theorem: EVEN n ==> (n = 2 * HALF n) *)
1334(* Proof:
1335   Note EVEN n ==> ?m. n = 2 * m     by EVEN_EXISTS
1336    and HALF n = HALF (2 * m)        by above
1337               = m                   by MULT_TO_DIV, 0 < 2
1338   Thus n = 2 * m = 2 * HALF n       by above
1339*)
1340Theorem EVEN_HALF:
1341    !n. EVEN n ==> (n = 2 * HALF n)
1342Proof
1343  metis_tac[EVEN_EXISTS, MULT_TO_DIV, DECIDE``0 < 2``]
1344QED
1345
1346(* Theorem: ODD n ==> (n = 2 * HALF n + 1 *)
1347(* Proof:
1348   Since n = HALF n * 2 + n MOD 2  by DIVISION, 0 < 2
1349           = 2 * HALF n + n MOD 2  by MULT_COMM
1350           = 2 * HALF n + 1        by ODD_MOD2
1351*)
1352Theorem ODD_HALF:
1353    !n. ODD n ==> (n = 2 * HALF n + 1)
1354Proof
1355  metis_tac[DIVISION, MULT_COMM, ODD_MOD2, DECIDE``0 < 2``]
1356QED
1357
1358(* Theorem: EVEN n ==> (HALF (SUC n) = HALF n) *)
1359(* Proof:
1360   Note n = (HALF n) * 2 + (n MOD 2)   by DIVISION, 0 < 2
1361          = (HALF n) * 2               by EVEN_MOD2
1362    Now SUC n
1363      = n + 1                          by ADD1
1364      = (HALF n) * 2 + 1               by above
1365   Thus HALF (SUC n)
1366      = ((HALF n) * 2 + 1) DIV 2       by above
1367      = HALF n                         by DIV_MULT, 1 < 2
1368*)
1369Theorem EVEN_SUC_HALF:
1370    !n. EVEN n ==> (HALF (SUC n) = HALF n)
1371Proof
1372  rpt strip_tac >>
1373  `n MOD 2 = 0` by rw[GSYM EVEN_MOD2] >>
1374  `n = HALF n * 2 + n MOD 2` by rw[DIVISION] >>
1375  `SUC n = HALF n * 2 + 1` by rw[] >>
1376  metis_tac[DIV_MULT, DECIDE``1 < 2``]
1377QED
1378
1379(* Theorem: ODD n ==> (HALF (SUC n) = SUC (HALF n)) *)
1380(* Proof:
1381     SUC n
1382   = SUC (2 * HALF n + 1)              by ODD_HALF
1383   = 2 * HALF n + 1 + 1                by ADD1
1384   = 2 * HALF n + 2                    by arithmetic
1385   = 2 * (HALF n + 1)                  by LEFT_ADD_DISTRIB
1386   = 2 * SUC (HALF n)                  by ADD1
1387   = SUC (HALF n) * 2 + 0              by MULT_COMM, ADD_0
1388   Hence HALF (SUC n) = SUC (HALF n)   by DIV_UNIQUE, 0 < 2
1389*)
1390Theorem ODD_SUC_HALF:
1391    !n. ODD n ==> (HALF (SUC n) = SUC (HALF n))
1392Proof
1393  rpt strip_tac >>
1394  `SUC n = SUC (2 * HALF n + 1)` by rw[ODD_HALF] >>
1395  `_ = SUC (HALF n) * 2 + 0` by rw[] >>
1396  metis_tac[DIV_UNIQUE, DECIDE``0 < 2``]
1397QED
1398
1399(* Theorem: (HALF n = 0) <=> ((n = 0) \/ (n = 1)) *)
1400(* Proof:
1401   If part: (HALF n = 0) ==> ((n = 0) \/ (n = 1))
1402      Note n = (HALF n) * 2 + (n MOD 2)    by DIVISION, 0 < 2
1403             = n MOD 2                     by HALF n = 0
1404       and n MOD 2 < 2                     by MOD_LESS, 0 < 2
1405        so n < 2, or n = 0 or n = 1        by arithmetic
1406   Only-if part: HALF 0 = 0, HALF 1 = 0.
1407      True since both 0 or 1 < 2           by LESS_DIV_EQ_ZERO, 0 < 2
1408*)
1409Theorem HALF_EQ_0:
1410    !n. (HALF n = 0) <=> ((n = 0) \/ (n = 1))
1411Proof
1412  rw[LESS_DIV_EQ_ZERO, EQ_IMP_THM] >>
1413  `n = (HALF n) * 2 + (n MOD 2)` by rw[DIVISION] >>
1414  `n MOD 2 < 2` by rw[MOD_LESS] >>
1415  decide_tac
1416QED
1417
1418(* Theorem: (HALF n = n) <=> (n = 0) *)
1419(* Proof:
1420   If part: HALF n = n ==> n = 0
1421      Note n = 2 * HALF n + (n MOD 2)    by DIVISION, MULT_COMM
1422        so n = 2 * n + (n MOD 2)         by HALF n = n
1423        or 0 = n + (n MOD 2)             by arithmetic
1424      Thus n  = 0  and (n MOD 2 = 0)     by ADD_EQ_0
1425   Only-if part: HALF 0 = 0, true        by ZERO_DIV, 0 < 2
1426*)
1427Theorem HALF_EQ_SELF:
1428    !n. (HALF n = n) <=> (n = 0)
1429Proof
1430  rw[EQ_IMP_THM] >>
1431  `n = 2 * HALF n + (n MOD 2)` by metis_tac[DIVISION, MULT_COMM, DECIDE``0 < 2``] >>
1432  rw[ADD_EQ_0]
1433QED
1434
1435(* Theorem: 0 < n ==> HALF n < n *)
1436(* Proof:
1437   Note HALF n <= n     by DIV_LESS_EQ, 0 < 2
1438    and HALF n <> n     by HALF_EQ_SELF, n <> 0
1439     so HALF n < n      by arithmetic
1440*)
1441Theorem HALF_LT:
1442    !n. 0 < n ==> HALF n < n
1443Proof
1444  rpt strip_tac >>
1445  `HALF n <= n` by rw[DIV_LESS_EQ] >>
1446  `HALF n <> n` by rw[HALF_EQ_SELF] >>
1447  decide_tac
1448QED
1449
1450(* Theorem: 2 < n ==> (1 + HALF n < n) *)
1451(* Proof:
1452   If EVEN n,
1453      then     2 * HALF n = n      by EVEN_HALF
1454        so 2 + 2 * HALF n < n + n  by 2 < n
1455        or     1 + HALF n < n      by arithmetic
1456   If ~EVEN n, then ODD n          by ODD_EVEN
1457      then 1 + 2 * HALF n = 2      by ODD_HALF
1458        so 1 + 2 * HALF n < n      by 2 < n
1459      also 2 + 2 * HALF n < n + n  by 1 < n
1460        or     1 + HALF n < n      by arithmetic
1461*)
1462Theorem HALF_ADD1_LT:
1463  !n. 2 < n ==> 1 + HALF n < n
1464Proof
1465  rpt strip_tac >>
1466  Cases_on `EVEN n` >| [
1467    `2 * HALF n = n` by rw[EVEN_HALF] >>
1468    decide_tac,
1469    `1 + 2 * HALF n = n` by rw[ODD_HALF, ODD_EVEN] >>
1470    decide_tac
1471  ]
1472QED
1473
1474(* Theorem alias *)
1475Theorem HALF_TWICE = MULT_DIV_2;
1476(* val HALF_TWICE = |- !n. HALF (2 * n) = n: thm *)
1477
1478(* Theorem: n * HALF m <= HALF (n * m) *)
1479(* Proof:
1480   Let k = HALF m.
1481   If EVEN m,
1482      Then m = 2 * k           by EVEN_HALF
1483        HALF (n * m)
1484      = HALF (n * (2 * k))     by above
1485      = HALF (2 * (n * k))     by arithmetic
1486      = n * k                  by HALF_TWICE
1487   If ~EVEN m, then ODD m      by ODD_EVEN
1488      Then m = 2 * k + 1       by ODD_HALF
1489      so   HALF (n * m)
1490         = HALF (n * (2 * k + 1))        by above
1491         = HALF (2 * (n * k) + n)        by LEFT_ADD_DISTRIB
1492         = HALF (2 * (n * k)) + HALF n   by ADD_DIV_ADD_DIV
1493         = n * k + HALF n                by HALF_TWICE
1494         >= n * k                        by arithmetic
1495*)
1496Theorem HALF_MULT: !m n. n * (m DIV 2) <= (n * m) DIV 2
1497Proof
1498  rpt strip_tac >>
1499  qabbrev_tac `k = m DIV 2` >>
1500  Cases_on `EVEN m`
1501  >- (`m = 2 * k` by rw[EVEN_HALF, Abbr`k`] >>
1502      simp[]) >>
1503  `ODD m` by rw[ODD_EVEN] >>
1504  `m = 2 * k + 1` by rw[ODD_HALF, Abbr`k`] >>
1505  simp[LEFT_ADD_DISTRIB]
1506QED
1507
1508(* Theorem: 2 * HALF n <= n /\ n <= SUC (2 * HALF n) *)
1509(* Proof:
1510   If EVEN n,
1511      Then n = 2 * HALF n         by EVEN_HALF
1512       and n = n < SUC n          by LESS_SUC
1513        or n <= n <= SUC n,
1514      Giving 2 * HALF n <= n /\ n <= SUC (2 * HALF n)
1515   If ~(EVEN n), then ODD n       by EVEN_ODD
1516      Then n = 2 * HALF n + 1     by ODD_HALF
1517             = SUC (2 * HALF n)   by ADD1
1518        or n - 1 < n = n
1519        or n - 1 <= n <= n,
1520      Giving 2 * HALF n <= n /\ n <= SUC (2 * HALF n)
1521*)
1522Theorem TWO_HALF_LE_THM:
1523    !n. 2 * HALF n <= n /\ n <= SUC (2 * HALF n)
1524Proof
1525  strip_tac >>
1526  Cases_on `EVEN n` >-
1527  rw[GSYM EVEN_HALF] >>
1528  `ODD n` by rw[ODD_EVEN] >>
1529  `n <> 0` by metis_tac[ODD] >>
1530  `n = SUC (2 * HALF n)` by rw[ODD_HALF, ADD1] >>
1531  `2 * HALF n = PRE n` by rw[] >>
1532  rw[]
1533QED
1534
1535(* Theorem: 2 * ((HALF n) * m) <= n * m *)
1536(* Proof:
1537      2 * ((HALF n) * m)
1538    = 2 * (m * HALF n)      by MULT_COMM
1539   <= 2 * (HALF (m * n))    by HALF_MULT
1540   <= m * n                 by TWO_HALF_LE_THM
1541    = n * m                 by MULT_COMM
1542*)
1543Theorem TWO_HALF_TIMES_LE:
1544    !m n. 2 * ((HALF n) * m) <= n * m
1545Proof
1546  rpt strip_tac >>
1547  `2 * (m * HALF n) <= 2 * (HALF (m * n))` by rw[HALF_MULT] >>
1548  `2 * (HALF (m * n)) <= m * n` by rw[TWO_HALF_LE_THM] >>
1549  fs[]
1550QED
1551
1552(* Theorem: 0 < n ==> 1 + HALF n <= n *)
1553(* Proof:
1554   If n = 1,
1555      HALF 1 = 0, hence true.
1556   If n <> 1,
1557      Then HALF n <> 0       by HALF_EQ_0, n <> 0, n <> 1
1558      Thus 1 + HALF n
1559        <= HALF n + HALF n   by 1 <= HALF n
1560         = 2 * HALF n
1561        <= n                 by TWO_HALF_LE_THM
1562*)
1563Theorem HALF_ADD1_LE:
1564    !n. 0 < n ==> 1 + HALF n <= n
1565Proof
1566  rpt strip_tac >>
1567  (Cases_on `n = 1` >> simp[]) >>
1568  `HALF n <> 0` by metis_tac[HALF_EQ_0, NOT_ZERO] >>
1569  `1 + HALF n <= 2 * HALF n` by decide_tac >>
1570  `2 * HALF n <= n` by rw[TWO_HALF_LE_THM] >>
1571  decide_tac
1572QED
1573
1574(* Theorem: (HALF n) ** 2 <= (n ** 2) DIV 4 *)
1575(* Proof:
1576   Let k = HALF n.
1577   Then 2 * k <= n                by TWO_HALF_LE_THM
1578     so (2 * k) ** 2 <= n ** 2                by EXP_EXP_LE_MONO
1579    and (2 * k) ** 2 DIV 4 <= n ** 2 DIV 4    by DIV_LE_MONOTONE, 0 < 4
1580    But (2 * k) ** 2 DIV 4
1581      = 4 * k ** 2 DIV 4          by EXP_BASE_MULT
1582      = k ** 2                    by MULT_TO_DIV, 0 < 4
1583   Thus k ** 2 <= n ** 2 DIV 4.
1584*)
1585Theorem HALF_SQ_LE:
1586    !n. (HALF n) ** 2 <= (n ** 2) DIV 4
1587Proof
1588  rpt strip_tac >>
1589  qabbrev_tac `k = HALF n` >>
1590  `2 * k <= n` by rw[TWO_HALF_LE_THM, Abbr`k`] >>
1591  `(2 * k) ** 2 <= n ** 2` by rw[] >>
1592  `(2 * k) ** 2 DIV 4 <= n ** 2 DIV 4` by rw[DIV_LE_MONOTONE] >>
1593  `(2 * k) ** 2 DIV 4 = 4 * k ** 2 DIV 4` by rw[EXP_BASE_MULT] >>
1594  `_ = k ** 2` by rw[MULT_TO_DIV] >>
1595  decide_tac
1596QED
1597
1598(* Obtain theorems *)
1599Theorem HALF_LE =
1600    DIV_LESS_EQ |> SPEC ``2`` |> SIMP_RULE (arith_ss) [] |> SPEC ``n:num`` |> GEN_ALL;
1601(* val HALF_LE = |- !n. HALF n <= n: thm *)
1602Theorem HALF_LE_MONO =
1603    DIV_LE_MONOTONE |> SPEC ``2`` |> SIMP_RULE (arith_ss) [];
1604(* val HALF_LE_MONO = |- !x y. x <= y ==> HALF x <= HALF y: thm *)
1605
1606(* Theorem: HALF (SUC n) <= n *)
1607(* Proof:
1608   If EVEN n,
1609      Then ?k. n = 2 * k                       by EVEN_EXISTS
1610       and SUC n = 2 * k + 1
1611        so HALF (SUC n) = k <= k + k = n       by ineqaulities
1612   Otherwise ODD n,                            by ODD_EVEN
1613      Then ?k. n = 2 * k + 1                   by ODD_EXISTS
1614       and SUC n = 2 * k + 2
1615        so HALF (SUC n) = k + 1 <= k + k + 1 = n
1616*)
1617Theorem HALF_SUC:
1618  !n. HALF (SUC n) <= n
1619Proof
1620  rpt strip_tac >>
1621  Cases_on `EVEN n` >| [
1622    `?k. n = 2 * k` by metis_tac[EVEN_EXISTS] >>
1623    `HALF (SUC n) = k` by simp[ADD1] >>
1624    decide_tac,
1625    `?k. n = 2 * k + 1` by metis_tac[ODD_EXISTS, ODD_EVEN, ADD1] >>
1626    `HALF (SUC n) = k + 1` by simp[ADD1] >>
1627    decide_tac
1628  ]
1629QED
1630
1631(* Theorem: 0 < n ==> HALF (SUC (SUC n)) <= n *)
1632(* Proof:
1633   Note SUC (SUC n) = n + 2        by ADD1
1634   If EVEN n,
1635      then ?k. n = 2 * k           by EVEN_EXISTS
1636      Since n = 2 * k <> 0         by NOT_ZERO, 0 < n
1637        so k <> 0, or 1 <= k       by MULT_EQ_0
1638           HALF (n + 2)
1639         = k + 1                   by arithmetic
1640        <= k + k                   by above
1641         = n
1642   Otherwise ODD n,                by ODD_EVEN
1643      then ?k. n = 2 * k + 1       by ODD_EXISTS
1644           HALF (n + 2)
1645         = HALF (2 * k + 3)        by arithmetic
1646         = k + 1                   by arithmetic
1647        <= k + k + 1               by ineqaulities
1648         = n
1649*)
1650Theorem HALF_SUC_SUC:
1651  !n. 0 < n ==> HALF (SUC (SUC n)) <= n
1652Proof
1653  rpt strip_tac >>
1654  Cases_on `EVEN n` >| [
1655    `?k. n = 2 * k` by metis_tac[EVEN_EXISTS] >>
1656    `0 < k` by metis_tac[MULT_EQ_0, NOT_ZERO] >>
1657    `1 <= k` by decide_tac >>
1658    `HALF (SUC (SUC n)) = k + 1` by simp[ADD1] >>
1659    fs[],
1660    `?k. n = 2 * k + 1` by metis_tac[ODD_EXISTS, ODD_EVEN, ADD1] >>
1661    `HALF (SUC (SUC n)) = k + 1` by simp[ADD1] >>
1662    fs[]
1663  ]
1664QED
1665
1666(* Theorem: n < HALF (SUC m) ==> 2 * n + 1 <= m *)
1667(* Proof:
1668   If EVEN m,
1669      Then m = 2 * HALF m                      by EVEN_HALF
1670       and SUC m = 2 * HALF m + 1              by ADD1
1671        so     n < (2 * HALF m + 1) DIV 2      by given
1672        or     n < HALF m                      by arithmetic
1673           2 * n < 2 * HALF m                  by LT_MULT_LCANCEL
1674           2 * n < m                           by above
1675       2 * n + 1 <= m                          by arithmetic
1676    Otherwise, ODD m                           by ODD_EVEN
1677       Then m = 2 * HALF m + 1                 by ODD_HALF
1678        and SUC m = 2 * HALF m + 2             by ADD1
1679         so     n < (2 * HALF m + 2) DIV 2     by given
1680         or     n < HALF m + 1                 by arithmetic
1681        2 * n + 1 < 2 * HALF m + 1             by LT_MULT_LCANCEL, LT_ADD_RCANCEL
1682         or 2 * n + 1 < m                      by above
1683    Overall, 2 * n + 1 <= m.
1684*)
1685Theorem HALF_SUC_LE:
1686  !n m. n < HALF (SUC m) ==> 2 * n + 1 <= m
1687Proof
1688  rpt strip_tac >>
1689  Cases_on `EVEN m` >| [
1690    `m = 2 * HALF m` by simp[EVEN_HALF] >>
1691    `HALF (SUC m) = HALF (2 * HALF m + 1)` by metis_tac[ADD1] >>
1692    `_ = HALF m` by simp[] >>
1693    simp[],
1694    `m = 2 * HALF m + 1` by simp[ODD_HALF, ODD_EVEN] >>
1695    `HALF (SUC m) = HALF (2 * HALF m + 1 + 1)` by metis_tac[ADD1] >>
1696    `_ = HALF m + 1` by simp[] >>
1697    simp[]
1698  ]
1699QED
1700
1701(* Theorem: 2 * n < m ==> n <= HALF m *)
1702(* Proof:
1703   If EVEN m,
1704      Then m = 2 * HALF m                      by EVEN_HALF
1705        so 2 * n < 2 * HALF m                  by above
1706        or     n < HALF m                      by LT_MULT_LCANCEL
1707    Otherwise, ODD m                           by ODD_EVEN
1708       Then m = 2 * HALF m + 1                 by ODD_HALF
1709         so 2 * n < 2 * HALF m + 1             by above
1710         so 2 * n <= 2 * HALF m                by removing 1
1711         or     n <= HALF m                    by LE_MULT_LCANCEL
1712    Overall, n <= HALF m.
1713*)
1714Theorem HALF_EVEN_LE:
1715  !n m. 2 * n < m ==> n <= HALF m
1716Proof
1717  rpt strip_tac >>
1718  Cases_on `EVEN m` >| [
1719    `2 * n < 2 * HALF m` by metis_tac[EVEN_HALF] >>
1720    simp[],
1721    `2 * n < 2 * HALF m + 1` by metis_tac[ODD_HALF, ODD_EVEN] >>
1722    simp[]
1723  ]
1724QED
1725
1726(* Theorem: 2 * n + 1 < m ==> n < HALF m *)
1727(* Proof:
1728   If EVEN m,
1729      Then m = 2 * HALF m                      by EVEN_HALF
1730        so 2 * n + 1 < 2 * HALF m              by above
1731        or     2 * n < 2 * HALF m              by removing 1
1732        or     n < HALF m                      by LT_MULT_LCANCEL
1733    Otherwise, ODD m                           by ODD_EVEN
1734       Then m = 2 * HALF m + 1                 by ODD_HALF
1735         so 2 * n + 1 < 2 * HALF m + 1         by above
1736         or     2 * n < 2 * HALF m             by LT_ADD_RCANCEL
1737         or         n < HALF m                 by LT_MULT_LCANCEL
1738    Overall, n < HALF m.
1739*)
1740Theorem HALF_ODD_LT:
1741  !n m. 2 * n + 1 < m ==> n < HALF m
1742Proof
1743  rpt strip_tac >>
1744  Cases_on `EVEN m` >| [
1745    `2 * n + 1 < 2 * HALF m` by metis_tac[EVEN_HALF] >>
1746    simp[],
1747    `2 * n + 1 < 2 * HALF m + 1` by metis_tac[ODD_HALF, ODD_EVEN] >>
1748    simp[]
1749  ]
1750QED
1751
1752(* Theorem: EVEN n ==> !m. m * n = (TWICE m) * (HALF n) *)
1753(* Proof:
1754     (TWICE m) * (HALF n)
1755   = (2 * m) * (HALF n)   by notation
1756   = m * TWICE (HALF n)   by MULT_COMM, MULT_ASSOC
1757   = m * n                by EVEN_HALF
1758*)
1759Theorem MULT_EVEN:
1760    !n. EVEN n ==> !m. m * n = (TWICE m) * (HALF n)
1761Proof
1762  metis_tac[MULT_COMM, MULT_ASSOC, EVEN_HALF]
1763QED
1764
1765(* Theorem: ODD n ==> !m. m * n = m + (TWICE m) * (HALF n) *)
1766(* Proof:
1767     m + (TWICE m) * (HALF n)
1768   = m + (2 * m) * (HALF n)     by notation
1769   = m + m * (TWICE (HALF n))   by MULT_COMM, MULT_ASSOC
1770   = m * (SUC (TWICE (HALF n))) by MULT_SUC
1771   = m * (TWICE (HALF n) + 1)   by ADD1
1772   = m * n                      by ODD_HALF
1773*)
1774Theorem MULT_ODD:
1775    !n. ODD n ==> !m. m * n = m + (TWICE m) * (HALF n)
1776Proof
1777  metis_tac[MULT_COMM, MULT_ASSOC, ODD_HALF, MULT_SUC, ADD1]
1778QED
1779
1780(* Theorem: EVEN m /\ m <> 0 ==> !n. EVEN n <=> EVEN (n MOD m) *)
1781(* Proof:
1782   Note ?k. m = 2 * k                by EVEN_EXISTS, EVEN m
1783    and k <> 0                       by MULT_EQ_0, m <> 0
1784    ==> (n MOD m) MOD 2 = n MOD 2    by MOD_MULT_MOD
1785   The result follows                by EVEN_MOD2
1786*)
1787Theorem EVEN_MOD_EVEN:
1788    !m. EVEN m /\ m <> 0 ==> !n. EVEN n <=> EVEN (n MOD m)
1789Proof
1790  rpt strip_tac >>
1791  `?k. m = 2 * k` by rw[GSYM EVEN_EXISTS] >>
1792  `(n MOD m) MOD 2 = n MOD 2` by rw[MOD_MULT_MOD] >>
1793  metis_tac[EVEN_MOD2]
1794QED
1795
1796(* Theorem: EVEN m /\ m <> 0 ==> !n. ODD n <=> ODD (n MOD m) *)
1797(* Proof: by EVEN_MOD_EVEN, ODD_EVEN *)
1798Theorem EVEN_MOD_ODD:
1799    !m. EVEN m /\ m <> 0 ==> !n. ODD n <=> ODD (n MOD m)
1800Proof
1801  rw_tac std_ss[EVEN_MOD_EVEN, ODD_EVEN]
1802QED
1803
1804(* Theorem: c <= a ==> ((a - b) - (a - c) = c - b) *)
1805(* Proof:
1806     a - b - (a - c)
1807   = a - (b + (a - c))     by SUB_RIGHT_SUB, no condition
1808   = a - ((a - c) + b)     by ADD_COMM, no condition
1809   = a - (a - c) - b       by SUB_RIGHT_SUB, no condition
1810   = a + c - a - b         by SUB_SUB, c <= a
1811   = c + a - a - b         by ADD_COMM, no condition
1812   = c + (a - a) - b       by LESS_EQ_ADD_SUB, a <= a
1813   = c + 0 - b             by SUB_EQUAL_0
1814   = c - b
1815*)
1816Theorem SUB_SUB_SUB:
1817    !a b c. c <= a ==> ((a - b) - (a - c) = c - b)
1818Proof
1819  decide_tac
1820QED
1821
1822(* Theorem: c <= a ==> (a + b - (a - c) = c + b) *)
1823(* Proof:
1824     a + b - (a - c)
1825   = a + b + c - a      by SUB_SUB, a <= c
1826   = a + (b + c) - a    by ADD_ASSOC
1827   = (b + c) + a - a    by ADD_COMM
1828   = b + c - (a - a)    by SUB_SUB, a <= a
1829   = b + c - 0          by SUB_EQUAL_0
1830   = b + c              by SUB_0
1831*)
1832Theorem ADD_SUB_SUB:
1833    !a b c. c <= a ==> (a + b - (a - c) = c + b)
1834Proof
1835  decide_tac
1836QED
1837
1838(* Theorem: 0 < p ==> !m n. (m - n = p) <=> (m = n + p) *)
1839(* Proof:
1840   If part: m - n = p ==> m = n + p
1841      Note 0 < m - n          by 0 < p
1842        so n < m              by LESS_MONO_ADD
1843        or m = m - n + n      by SUB_ADD, n <= m
1844             = p + n          by m - n = p
1845             = n + p          by ADD_COMM
1846   Only-if part: m = n + p ==> m - n = p
1847        m - n
1848      = (n + p) - n           by m = n + p
1849      = p + n - n             by ADD_COMM
1850      = p                     by ADD_SUB
1851*)
1852Theorem SUB_EQ_ADD:
1853    !p. 0 < p ==> !m n. (m - n = p) <=> (m = n + p)
1854Proof
1855  decide_tac
1856QED
1857
1858(* Note: ADD_EQ_SUB |- !m n p. n <= p ==> ((m + n = p) <=> (m = p - n)) *)
1859
1860(* Theorem: 0 < a /\ 0 < b /\ a < c /\ (a * b = c * d) ==> (d < b) *)
1861(* Proof:
1862   By contradiction, suppose b <= d.
1863   Since a * b <> 0         by MULT_EQ_0, 0 < a, 0 < b
1864      so d <> 0, or 0 < d   by MULT_EQ_0, a * b <> 0
1865     Now a * b <= a * d     by LE_MULT_LCANCEL, b <= d, a <> 0
1866     and a * d < c * d      by LT_MULT_LCANCEL, a < c, d <> 0
1867      so a * b < c * d      by LESS_EQ_LESS_TRANS
1868    This contradicts a * b = c * d.
1869*)
1870Theorem MULT_EQ_LESS_TO_MORE:
1871    !a b c d. 0 < a /\ 0 < b /\ a < c /\ (a * b = c * d) ==> (d < b)
1872Proof
1873  spose_not_then strip_assume_tac >>
1874  `b <= d` by decide_tac >>
1875  `0 < d` by decide_tac >>
1876  `a * b <= a * d` by rw[LE_MULT_LCANCEL] >>
1877  `a * d < c * d` by rw[LT_MULT_LCANCEL] >>
1878  decide_tac
1879QED
1880
1881(* Theorem: 0 < c /\ 0 < d /\ a * b <= c * d /\ d < b ==> a < c *)
1882(* Proof:
1883   By contradiction, suppose c <= a.
1884   With d < b, which gives d <= b    by LESS_IMP_LESS_OR_EQ
1885   Thus c * d <= a * b               by LE_MONO_MULT2
1886     or a * b = c * d                by a * b <= c * d
1887   Note 0 < c /\ 0 < d               by given
1888    ==> a < c                        by MULT_EQ_LESS_TO_MORE
1889   This contradicts c <= a.
1890
1891MULT_EQ_LESS_TO_MORE
1892|- !a b c d. 0 < a /\ 0 < b /\ a < c /\ a * b = c * d ==> d < b
1893             0 < d /\ 0 < c /\ d < b /\ d * c = b * a ==> a < c
1894*)
1895Theorem LE_IMP_REVERSE_LT:
1896    !a b c d. 0 < c /\ 0 < d /\ a * b <= c * d /\ d < b ==> a < c
1897Proof
1898  spose_not_then strip_assume_tac >>
1899  `c <= a` by decide_tac >>
1900  `c * d <= a * b` by rw[LE_MONO_MULT2] >>
1901  `a * b = c * d` by decide_tac >>
1902  `a < c` by metis_tac[MULT_EQ_LESS_TO_MORE, MULT_COMM]
1903QED
1904
1905(* ------------------------------------------------------------------------- *)
1906(* Exponential Theorems                                                      *)
1907(* ------------------------------------------------------------------------- *)
1908
1909(* Theorem: EVEN n ==> !m. m ** n = (SQ m) ** (HALF n) *)
1910(* Proof:
1911     (SQ m) ** (HALF n)
1912   = (m ** 2) ** (HALF n)   by notation
1913   = m ** (2 * HALF n)      by EXP_EXP_MULT
1914   = m ** n                 by EVEN_HALF
1915*)
1916Theorem EXP_EVEN:
1917    !n. EVEN n ==> !m. m ** n = (SQ m) ** (HALF n)
1918Proof
1919  rpt strip_tac >>
1920  `(SQ m) ** (HALF n) = m ** (2 * HALF n)` by rw[EXP_EXP_MULT] >>
1921  `_ = m ** n` by rw[GSYM EVEN_HALF] >>
1922  rw[]
1923QED
1924
1925(* Theorem: ODD n ==> !m. m ** n = m * (SQ m) ** (HALF n) *)
1926(* Proof:
1927     m * (SQ m) ** (HALF n)
1928   = m * (m ** 2) ** (HALF n)   by notation
1929   = m * m ** (2 * HALF n)      by EXP_EXP_MULT
1930   = m ** (SUC (2 * HALF n))    by EXP
1931   = m ** (2 * HALF n + 1)      by ADD1
1932   = m ** n                     by ODD_HALF
1933*)
1934Theorem EXP_ODD:
1935    !n. ODD n ==> !m. m ** n = m * (SQ m) ** (HALF n)
1936Proof
1937  rpt strip_tac >>
1938  `m * (SQ m) ** (HALF n) = m * m ** (2 * HALF n)` by rw[EXP_EXP_MULT] >>
1939  `_ = m ** (2 * HALF n + 1)` by rw[GSYM EXP, ADD1] >>
1940  `_ = m ** n` by rw[GSYM ODD_HALF] >>
1941  rw[]
1942QED
1943
1944(* An exponentiation identity *)
1945(* val EXP_THM = save_thm("EXP_THM", CONJ EXP_EVEN EXP_ODD); *)
1946(*
1947val EXP_THM = |- (!n. EVEN n ==> !m. m ** n = SQ m ** HALF n) /\
1948                  !n. ODD n ==> !m. m ** n = m * SQ m ** HALF n: thm
1949*)
1950(* Next is better *)
1951
1952(* Theorem: m ** n = if n = 0 then 1 else if n = 1 then m else
1953            if EVEN n then (m * m) ** HALF n else m * ((m * m) ** (HALF n)) *)
1954(* Proof: mainly by EXP_EVEN, EXP_ODD. *)
1955Theorem EXP_THM:
1956  !m n. m ** n = if n = 0 then 1 else if n = 1 then m
1957                 else if EVEN n then (m * m) ** HALF n
1958                 else m * ((m * m) ** (HALF n))
1959Proof
1960  metis_tac[EXP_0, EXP_1, EXP_EVEN, EXP_ODD, EVEN_ODD]
1961QED
1962
1963(* Theorem: m ** n =
1964            if n = 0 then 1
1965            else if EVEN n then (m * m) ** (HALF n) else m * (m * m) ** (HALF n) *)
1966(* Proof:
1967   If n = 0, to show:
1968      m ** 0 = 1, true                      by EXP_0
1969   If EVEN n, to show:
1970      m ** n = (m * m) ** (HALF n), true    by EXP_EVEN
1971   If ~EVEN n, ODD n, to show:              by EVEN_ODD
1972      m ** n = m * (m * m) ** HALF n, true  by EXP_ODD
1973*)
1974Theorem EXP_EQN:
1975    !m n. m ** n =
1976         if n = 0 then 1
1977         else if EVEN n then (m * m) ** (HALF n) else m * (m * m) ** (HALF n)
1978Proof
1979  rw[] >-
1980  rw[Once EXP_EVEN] >>
1981  `ODD n` by metis_tac[EVEN_ODD] >>
1982  rw[Once EXP_ODD]
1983QED
1984
1985(* Theorem: m ** n = if n = 0 then 1 else (if EVEN n then 1 else m) * (m * m) ** (HALF n) *)
1986(* Proof: by EXP_EQN *)
1987Theorem EXP_EQN_ALT:
1988    !m n. m ** n =
1989         if n = 0 then 1
1990         else (if EVEN n then 1 else m) * (m * m) ** (HALF n)
1991Proof
1992  rw[Once EXP_EQN]
1993QED
1994
1995(* Theorem: m ** n = (if n = 0 then 1 else (if EVEN n then 1 else m) * (m ** 2) ** HALF n) *)
1996(* Proof: by EXP_EQN_ALT, EXP_2 *)
1997Theorem EXP_ALT_EQN:
1998    !m n. m ** n = (if n = 0 then 1 else (if EVEN n then 1 else m) * (m ** 2) ** HALF n)
1999Proof
2000  metis_tac[EXP_EQN_ALT, EXP_2]
2001QED
2002
2003(* Theorem: 1 < m ==>
2004      (b ** n) MOD m = if (n = 0) then 1
2005                       else let result = (b * b) ** (HALF n) MOD m
2006                             in if EVEN n then result else (b * result) MOD m *)
2007(* Proof:
2008   This is to show:
2009   (1) 1 < m ==> b ** 0 MOD m = 1
2010         b ** 0 MOD m
2011       = 1 MOD m            by EXP_0
2012       = 1                  by ONE_MOD, 1 < m
2013   (2) EVEN n ==> b ** n MOD m = (b ** 2) ** HALF n MOD m
2014         b ** n MOD m
2015       = (b * b) ** HALF n MOD m    by EXP_EVEN
2016       = (b ** 2) ** HALF n MOD m   by EXP_2
2017   (3) ~EVEN n ==> b ** n MOD m = (b * (b ** 2) ** HALF n) MOD m
2018         b ** n MOD m
2019       = (b * (b * b) ** HALF n) MOD m      by EXP_ODD, EVEN_ODD
2020       = (b * (b ** 2) ** HALF n) MOD m     by EXP_2
2021*)
2022Theorem EXP_MOD_EQN:
2023  !b n m. 1 < m ==>
2024      ((b ** n) MOD m =
2025       if (n = 0) then 1
2026       else let result = (b * b) ** (HALF n) MOD m
2027             in if EVEN n then result else (b * result) MOD m)
2028Proof
2029  rw[]
2030  >- metis_tac[EXP_EVEN, EXP_2] >>
2031  metis_tac[EXP_ODD, EXP_2, EVEN_ODD]
2032QED
2033
2034(* Pretty version of EXP_MOD_EQN, same pattern as EXP_EQN_ALT. *)
2035
2036(* Theorem: 1 < m ==> b ** n MOD m =
2037           if n = 0 then 1 else
2038           ((if EVEN n then 1 else b) * ((SQ b ** HALF n) MOD m)) MOD m *)
2039(* Proof: by EXP_MOD_EQN *)
2040Theorem EXP_MOD_ALT:
2041    !b n m. 1 < m ==> b ** n MOD m =
2042           if n = 0 then 1 else
2043           ((if EVEN n then 1 else b) * ((SQ b ** HALF n) MOD m)) MOD m
2044Proof
2045  rpt strip_tac >>
2046  imp_res_tac EXP_MOD_EQN >>
2047  last_x_assum (qspecl_then [`n`, `b`] strip_assume_tac) >>
2048  rw[]
2049QED
2050
2051(* Theorem: x ** (y ** SUC n) = (x ** y) ** y ** n *)
2052(* Proof:
2053      x ** (y ** SUC n)
2054    = x ** (y * y ** n)     by EXP
2055    = (x ** y) ** (y ** n)  by EXP_EXP_MULT
2056*)
2057Theorem EXP_EXP_SUC:
2058    !x y n. x ** (y ** SUC n) = (x ** y) ** y ** n
2059Proof
2060  rw[EXP, EXP_EXP_MULT]
2061QED
2062
2063(* Theorem: 1 + n * m <= (1 + m) ** n *)
2064(* Proof:
2065   By induction on n.
2066   Base: 1 + 0 * m <= (1 + m) ** 0
2067        LHS = 1 + 0 * m = 1            by arithmetic
2068        RHS = (1 + m) ** 0 = 1         by EXP_0
2069        Hence true.
2070   Step: 1 + n * m <= (1 + m) ** n ==>
2071         1 + SUC n * m <= (1 + m) ** SUC n
2072          1 + SUC n * m
2073        = 1 + n * m + m                     by MULT
2074        <= (1 + m) ** n + m                 by induction hypothesis
2075        <= (1 + m) ** n + m * (1 + m) ** n  by EXP_POS
2076        <= (1 + m) * (1 + m) ** n           by RIGHT_ADD_DISTRIB
2077         = (1 + m) ** SUC n                 by EXP
2078*)
2079Theorem EXP_LOWER_LE_LOW:
2080    !n m. 1 + n * m <= (1 + m) ** n
2081Proof
2082  rpt strip_tac >>
2083  Induct_on `n` >-
2084  rw[EXP_0] >>
2085  `0 < (1 + m) ** n` by rw[] >>
2086  `1 + SUC n * m = 1 + (n * m + m)` by rw[MULT] >>
2087  `_ = 1 + n * m + m` by decide_tac >>
2088  `m <= m * (1 + m) ** n` by rw[] >>
2089  `1 + SUC n * m <= (1 + m) ** n + m * (1 + m) ** n` by decide_tac >>
2090  `(1 + m) ** n + m * (1 + m) ** n = (1 + m) * (1 + m) ** n` by decide_tac >>
2091  `_ = (1 + m) ** SUC n` by rw[EXP] >>
2092  decide_tac
2093QED
2094
2095(* Theorem: 0 < m /\ 1 < n ==> 1 + n * m < (1 + m) ** n *)
2096(* Proof:
2097   By induction on n.
2098   Base: 1 < 0 ==> 1 + 0 * m <= (1 + m) ** 0
2099        True since 1 < 0 = F.
2100   Step: 1 < n ==> 1 + n * m < (1 + m) ** n ==>
2101         1 < SUC n ==> 1 + SUC n * m < (1 + m) ** SUC n
2102      Note n <> 0, since SUC 0 = 1          by ONE
2103      If n = 1,
2104         Note m * m <> 0                    by MULT_EQ_0, m <> 0
2105           (1 + m) ** SUC 1
2106         = (1 + m) ** 2                     by TWO
2107         = 1 + 2 * m + m * m                by expansion
2108         > 1 + 2 * m                        by 0 < m * m
2109         = 1 + (SUC 1) * m
2110      If n <> 1, then 1 < n.
2111          1 + SUC n * m
2112        = 1 + n * m + m                     by MULT
2113         < (1 + m) ** n + m                 by induction hypothesis, 1 < n
2114        <= (1 + m) ** n + m * (1 + m) ** n  by EXP_POS
2115        <= (1 + m) * (1 + m) ** n           by RIGHT_ADD_DISTRIB
2116         = (1 + m) ** SUC n                 by EXP
2117*)
2118Theorem EXP_LOWER_LT_LOW:
2119    !n m. 0 < m /\ 1 < n ==> 1 + n * m < (1 + m) ** n
2120Proof
2121  rpt strip_tac >>
2122  Induct_on `n` >-
2123  rw[] >>
2124  rpt strip_tac >>
2125  `n <> 0` by fs[] >>
2126  Cases_on `n = 1` >| [
2127    simp[] >>
2128    `(m + 1) ** 2 = (m + 1) * (m + 1)` by rw[GSYM EXP_2] >>
2129    `_ = m * m + 2 * m + 1` by decide_tac >>
2130    `0 < SQ m` by metis_tac[SQ_EQ_0, NOT_ZERO_LT_ZERO] >>
2131    decide_tac,
2132    `1 < n` by decide_tac >>
2133    `0 < (1 + m) ** n` by rw[] >>
2134    `1 + SUC n * m = 1 + (n * m + m)` by rw[MULT] >>
2135    `_ = 1 + n * m + m` by decide_tac >>
2136    `m <= m * (1 + m) ** n` by rw[] >>
2137    `1 + SUC n * m < (1 + m) ** n + m * (1 + m) ** n` by decide_tac >>
2138    `(1 + m) ** n + m * (1 + m) ** n = (1 + m) * (1 + m) ** n` by decide_tac >>
2139    `_ = (1 + m) ** SUC n` by rw[EXP] >>
2140    decide_tac
2141  ]
2142QED
2143
2144(*
2145Note: EXP_LOWER_LE_LOW collects the first two terms of binomial expansion.
2146  but EXP_LOWER_LE_HIGH collects the last two terms of binomial expansion.
2147*)
2148
2149(* Theorem: n * m ** (n - 1) + m ** n <= (1 + m) ** n *)
2150(* Proof:
2151   By induction on n.
2152   Base: 0 * m ** (0 - 1) + m ** 0 <= (1 + m) ** 0
2153        LHS = 0 * m ** (0 - 1) + m ** 0
2154            = 0 + 1                      by EXP_0
2155            = 1
2156           <= 1 = (1 + m) ** 0 = RHS     by EXP_0
2157   Step: n * m ** (n - 1) + m ** n <= (1 + m) ** n ==>
2158         SUC n * m ** (SUC n - 1) + m ** SUC n <= (1 + m) ** SUC n
2159        If n = 0,
2160           LHS = 1 * m ** 0 + m ** 1
2161               = 1 + m                   by EXP_0, EXP_1
2162               = (1 + m) ** 1 = RHS      by EXP_1
2163        If n <> 0,
2164           Then SUC (n - 1) = n          by n <> 0.
2165           LHS = SUC n * m ** (SUC n - 1) + m ** SUC n
2166               = (n + 1) * m ** n + m * m ** n     by EXP, ADD1
2167               = (n + 1 + m) * m ** n              by arithmetic
2168               = n * m ** n + (1 + m) * m ** n     by arithmetic
2169               = n * m ** SUC (n - 1) + (1 + m) * m ** n    by SUC (n - 1) = n
2170               = n * m * m ** (n - 1) + (1 + m) * m ** n    by EXP
2171               = m * (n * m ** (n - 1)) + (1 + m) * m ** n  by arithmetic
2172              <= (1 + m) * (n * m ** (n - 1)) + (1 + m) * m ** n   by m < 1 + m
2173               = (1 + m) * (n * m ** (n - 1) + m ** n)      by LEFT_ADD_DISTRIB
2174              <= (1 + m) * (1 + m) ** n                     by induction hypothesis
2175               = (1 + m) ** SUC n                           by EXP
2176*)
2177Theorem EXP_LOWER_LE_HIGH:
2178    !n m. n * m ** (n - 1) + m ** n <= (1 + m) ** n
2179Proof
2180  rpt strip_tac >>
2181  Induct_on `n` >-
2182  simp[] >>
2183  Cases_on `n = 0` >-
2184  simp[EXP_0] >>
2185  `SUC (n - 1) = n` by decide_tac >>
2186  simp[EXP] >>
2187  simp[ADD1] >>
2188  `m * m ** n + (n + 1) * m ** n = (m + (n + 1)) * m ** n` by rw[LEFT_ADD_DISTRIB] >>
2189  `_ = (n + (m + 1)) * m ** n` by decide_tac >>
2190  `_ = n * m ** n + (m + 1) * m ** n` by rw[LEFT_ADD_DISTRIB] >>
2191  `_ = n * m ** SUC (n - 1) + (m + 1) * m ** n` by rw[] >>
2192  `_ = n * (m * m ** (n - 1)) + (m + 1) * m ** n` by rw[EXP] >>
2193  `_ = m * (n * m ** (n - 1)) + (m + 1) * m ** n` by decide_tac >>
2194  `m * (n * m ** (n - 1)) + (m + 1) * m ** n <= (m + 1) * (n * m ** (n - 1)) + (m + 1) * m ** n` by decide_tac >>
2195  qabbrev_tac `t = n * m ** (n - 1) + m ** n` >>
2196  `(m + 1) * (n * m ** (n - 1)) + (m + 1) * m ** n = (m + 1) * t` by rw[LEFT_ADD_DISTRIB, Abbr`t`] >>
2197  `t <= (m + 1) ** n` by metis_tac[ADD_COMM] >>
2198  `(m + 1) * t <= (m + 1) * (m + 1) ** n` by rw[] >>
2199  decide_tac
2200QED
2201
2202(* Theorem: 1 < n ==> SUC n < 2 ** n *)
2203(* Proof:
2204   Note 1 + n < (1 + 1) ** n    by EXP_LOWER_LT_LOW, m = 1
2205     or SUC n < SUC 1 ** n      by ADD1
2206     or SUC n < 2 ** n          by TWO
2207*)
2208Theorem SUC_X_LT_2_EXP_X:
2209    !n. 1 < n ==> SUC n < 2 ** n
2210Proof
2211  rpt strip_tac >>
2212  `1 + n * 1 < (1 + 1) ** n` by rw[EXP_LOWER_LT_LOW] >>
2213  fs[]
2214QED
2215
2216(* ------------------------------------------------------------------------- *)
2217(* DIVIDES Theorems                                                          *)
2218(* ------------------------------------------------------------------------- *)
2219
2220(* Theorem: 0 < m ==> m * (n DIV m) <= n /\ n < m * SUC (n DIV m) *)
2221(* Proof:
2222   Note n = n DIV m * m + n MOD m /\
2223        n MOD m < m                      by DIVISION
2224   Thus m * (n DIV m) <= n               by MULT_COMM
2225    and n < m * (n DIV m) + m
2226          = m * (n DIV m  + 1)           by LEFT_ADD_DISTRIB
2227          = m * SUC (n DIV m)            by ADD1
2228*)
2229Theorem DIV_MULT_LESS_EQ:
2230    !m n. 0 < m ==> m * (n DIV m) <= n /\ n < m * SUC (n DIV m)
2231Proof
2232  ntac 3 strip_tac >>
2233  `(n = n DIV m * m + n MOD m) /\ n MOD m < m` by rw[DIVISION] >>
2234  `n < m * (n DIV m) + m` by decide_tac >>
2235  `m * (n DIV m) + m = m * (SUC (n DIV m))` by rw[ADD1] >>
2236  decide_tac
2237QED
2238
2239(* Theorem: 0 < n ==> (m - n) DIV n = if m < n then 0 else (m DIV n - 1) *)
2240(* Proof:
2241   If m < n, then m - n = 0, so (m - n) DIV n = 0     by ZERO_DIV
2242   Otherwise, n <= m, and (m - n) DIV n = m DIV n - 1 by SUB_DIV
2243*)
2244Theorem SUB_DIV_EQN:
2245    !m n. 0 < n ==> ((m - n) DIV n = if m < n then 0 else (m DIV n - 1))
2246Proof
2247  rw[SUB_DIV] >>
2248  `m - n = 0` by decide_tac >>
2249  rw[ZERO_DIV]
2250QED
2251
2252(* Theorem: 0 < n ==> (m - n) MOD n = if m < n then 0 else m MOD n *)
2253(* Proof:
2254   If m < n, then m - n = 0, so (m - n) MOD n = 0     by ZERO_MOD
2255   Otherwise, n <= m, and (m - n) MOD n = m MOD n     by SUB_MOD
2256*)
2257Theorem SUB_MOD_EQN:
2258    !m n. 0 < n ==> ((m - n) MOD n = if m < n then 0 else m MOD n)
2259Proof
2260  rw[SUB_MOD]
2261QED
2262
2263(* Theorem: 0 < m /\ 0 < n /\ (n MOD m = 0) ==> n DIV (SUC m) < n DIV m *)
2264(* Proof:
2265   Note n = n DIV (SUC m) * (SUC m) + n MOD (SUC m)   by DIVISION
2266          = n DIV m * m + n MOD m                     by DIVISION
2267          = n DIV m * m                               by n MOD m = 0
2268   Thus n DIV SUC m * SUC m <= n DIV m * m            by arithmetic
2269   Note m < SUC m                                     by LESS_SUC
2270    and n DIV m <> 0, or 0 < n DIV m                  by DIV_MOD_EQ_0
2271   Thus n DIV (SUC m) < n DIV m                       by LE_IMP_REVERSE_LT
2272*)
2273Theorem DIV_LT_SUC:
2274    !m n. 0 < m /\ 0 < n /\ (n MOD m = 0) ==> n DIV (SUC m) < n DIV m
2275Proof
2276  rpt strip_tac >>
2277  `n DIV m * m = n` by metis_tac[DIVISION, ADD_0] >>
2278  `_ = n DIV (SUC m) * (SUC m) + n MOD (SUC m)` by metis_tac[DIVISION, SUC_POS] >>
2279  `n DIV SUC m * SUC m <= n DIV m * m` by decide_tac >>
2280  `m < SUC m` by decide_tac >>
2281  `0 < n DIV m` by metis_tac[DIV_MOD_EQ_0, NOT_ZERO_LT_ZERO] >>
2282  metis_tac[LE_IMP_REVERSE_LT]
2283QED
2284
2285(* Theorem: 0 < x /\ 0 < y /\ x < y ==> !n. 0 < n /\ (n MOD x = 0) ==> n DIV y < n DIV x *)
2286(* Proof:
2287   Note x < y ==> SUC x <= y                by arithmetic
2288   Thus n DIV y <= n DIV (SUC x)            by DIV_LE_MONOTONE_REVERSE
2289    But 0 < x /\ 0 < n /\ (n MOD x = 0)     by given
2290    ==> n DIV (SUC x) < n DIV x             by DIV_LT_SUC
2291   Hence n DIV y < n DIV x                  by inequalities
2292*)
2293Theorem DIV_LT_MONOTONE_REVERSE:
2294    !x y. 0 < x /\ 0 < y /\ x < y ==> !n. 0 < n /\ (n MOD x = 0) ==> n DIV y < n DIV x
2295Proof
2296  rpt strip_tac >>
2297  `SUC x <= y` by decide_tac >>
2298  `n DIV y <= n DIV (SUC x)` by rw[DIV_LE_MONOTONE_REVERSE] >>
2299  `n DIV (SUC x) < n DIV x` by rw[DIV_LT_SUC] >>
2300  decide_tac
2301QED
2302
2303(* Theorem: k <> 0 ==> (m divides n <=> (k * m) divides (k * n)) *)
2304(* Proof:
2305       m divides n
2306   <=> ?q. n = q * m             by divides_def
2307   <=> ?q. k * n = k * (q * m)   by EQ_MULT_LCANCEL, k <> 0
2308   <=> ?q. k * n = q * (k * m)   by MULT_ASSOC, MULT_COMM
2309   <=> (k * m) divides (k * n)   by divides_def
2310*)
2311Theorem DIVIDES_MULTIPLE_IFF:
2312    !m n k. k <> 0 ==> (m divides n <=> (k * m) divides (k * n))
2313Proof
2314  rpt strip_tac >>
2315  `m divides n <=> ?q. n = q * m` by rw[GSYM divides_def] >>
2316  `_ = ?q. (k * n = k * (q * m))` by rw[EQ_MULT_LCANCEL] >>
2317  metis_tac[divides_def, MULT_COMM, MULT_ASSOC]
2318QED
2319
2320(* Theorem: 0 < n /\ n divides m ==> m = n * (m DIV n) *)
2321(* Proof:
2322   n divides m <=> m MOD n = 0    by DIVIDES_MOD_0
2323   m = (m DIV n) * n + (m MOD n)  by DIVISION
2324     = (m DIV n) * n              by above
2325     = n * (m DIV n)              by MULT_COMM
2326*)
2327Theorem DIVIDES_FACTORS:
2328    !m n. 0 < n /\ n divides m ==> (m = n * (m DIV n))
2329Proof
2330  metis_tac[DIVISION, DIVIDES_MOD_0, ADD_0, MULT_COMM]
2331QED
2332
2333(* Theorem: 0 < n /\ n divides m ==> (m DIV n) divides m *)
2334(* Proof:
2335   By DIVIDES_FACTORS: m = (m DIV n) * n
2336   Hence (m DIV n) | m    by divides_def
2337*)
2338Theorem DIVIDES_COFACTOR:
2339    !m n. 0 < n /\ n divides m ==> (m DIV n) divides m
2340Proof
2341  metis_tac[DIVIDES_FACTORS, divides_def]
2342QED
2343
2344(* Theorem: n divides q ==> p * (q DIV n) = (p * q) DIV n *)
2345(* Proof:
2346   n divides q ==> q MOD n = 0               by DIVIDES_MOD_0
2347   p * q = p * ((q DIV n) * n + q MOD n)     by DIVISION
2348         = p * ((q DIV n) * n)               by ADD_0
2349         = p * (q DIV n) * n                 by MULT_ASSOC
2350         = p * (q DIV n) * n + 0             by ADD_0
2351   Hence (p * q) DIV n = p * (q DIV n)       by DIV_UNIQUE, 0 < n:
2352   |- !n k q. (?r. (k = q * n + r) /\ r < n) ==> (k DIV n = q)
2353*)
2354Theorem MULTIPLY_DIV:
2355    !n p q. 0 < n /\ n divides q ==> (p * (q DIV n) = (p * q) DIV n)
2356Proof
2357  rpt strip_tac >>
2358  `q MOD n = 0` by rw[GSYM DIVIDES_MOD_0] >>
2359  `p * q = p * ((q DIV n) * n)` by metis_tac[DIVISION, ADD_0] >>
2360  `_ = p * (q DIV n) * n + 0` by rw[MULT_ASSOC] >>
2361  metis_tac[DIV_UNIQUE]
2362QED
2363
2364(* Note: The condition: n divides q is important:
2365> EVAL ``5 * (10 DIV 3)``;
2366val it = |- 5 * (10 DIV 3) = 15: thm
2367> EVAL ``(5 * 10) DIV 3``;
2368val it = |- 5 * 10 DIV 3 = 16: thm
2369*)
2370
2371(* Theorem: 0 < n /\ m divides n ==> !x. (x MOD n) MOD m = x MOD m *)
2372(* Proof:
2373   Note 0 < m                                   by ZERO_DIVIDES, 0 < n
2374   Given divides m n ==> ?q. n = q * m          by divides_def
2375   Since x = (x DIV n) * n + (x MOD n)          by DIVISION
2376           = (x DIV n) * (q * m) + (x MOD n)    by above
2377           = ((x DIV n) * q) * m + (x MOD n)    by MULT_ASSOC
2378   Hence     x MOD m
2379           = ((x DIV n) * q) * m + (x MOD n)) MOD m                by above
2380           = (((x DIV n) * q * m) MOD m + (x MOD n) MOD m) MOD m   by MOD_PLUS
2381           = (0 + (x MOD n) MOD m) MOD m                           by MOD_EQ_0
2382           = (x MOD n) MOD m                                       by ADD, MOD_MOD
2383*)
2384Theorem DIVIDES_MOD_MOD:
2385    !m n. 0 < n /\ m divides n ==> !x. (x MOD n) MOD m = x MOD m
2386Proof
2387  rpt strip_tac >>
2388  `0 < m` by metis_tac[ZERO_DIVIDES, NOT_ZERO] >>
2389  `?q. n = q * m` by rw[GSYM divides_def] >>
2390  `x MOD m = ((x DIV n) * n + (x MOD n)) MOD m` by rw[GSYM DIVISION] >>
2391  `_ = (((x DIV n) * q) * m + (x MOD n)) MOD m` by rw[MULT_ASSOC] >>
2392  `_ = (((x DIV n) * q * m) MOD m + (x MOD n) MOD m) MOD m` by rw[MOD_PLUS] >>
2393  rw[MOD_EQ_0, MOD_MOD]
2394QED
2395
2396(* Theorem: m divides n <=> (m * k) divides (n * k) *)
2397(* Proof: by divides_def and EQ_MULT_LCANCEL. *)
2398Theorem DIVIDES_CANCEL:
2399    !k. 0 < k ==> !m n. m divides n <=> (m * k) divides (n * k)
2400Proof
2401  rw[divides_def] >>
2402  `k <> 0` by decide_tac >>
2403  `!q. (q * m) * k = q * (m * k)` by rw_tac arith_ss[] >>
2404  metis_tac[EQ_MULT_LCANCEL, MULT_COMM]
2405QED
2406
2407(* Theorem: m divides n ==> (k * m) divides (k * n) *)
2408(* Proof:
2409       m divides n
2410   ==> ?q. n = q * m              by divides_def
2411   So  k * n = k * (q * m)
2412             = (k * q) * m        by MULT_ASSOC
2413             = (q * k) * m        by MULT_COMM
2414             = q * (k * m)        by MULT_ASSOC
2415   Hence (k * m) divides (k * n)  by divides_def
2416*)
2417Theorem DIVIDES_CANCEL_COMM:
2418    !m n k. m divides n ==> (k * m) divides (k * n)
2419Proof
2420  metis_tac[MULT_ASSOC, MULT_COMM, divides_def]
2421QED
2422
2423(* Theorem: 0 < n /\ 0 < m ==> !x. n divides x ==> ((m * x) DIV (m * n) = x DIV n) *)
2424(* Proof:
2425    n divides x ==> x = n * (x DIV n)              by DIVIDES_FACTORS
2426   or           m * x = (m * n) * (x DIV n)        by MULT_ASSOC
2427       n divides x
2428   ==> divides (m * n) (m * x)                     by DIVIDES_CANCEL_COMM
2429   ==> m * x = (m * n) * ((m * x) DIV (m * n))     by DIVIDES_FACTORS
2430   Equating expressions for m * x,
2431       (m * n) * (x DIV n) = (m * n) * ((m * x) DIV (m * n))
2432   or              x DIV n = (m * x) DIV (m * n)   by MULT_LEFT_CANCEL
2433*)
2434Theorem DIV_COMMON_FACTOR:
2435    !m n. 0 < n /\ 0 < m ==> !x. n divides x ==> ((m * x) DIV (m * n) = x DIV n)
2436Proof
2437  rpt strip_tac >>
2438  `!n. n <> 0 <=> 0 < n` by decide_tac >>
2439  `0 < m * n` by metis_tac[MULT_EQ_0] >>
2440  metis_tac[DIVIDES_CANCEL_COMM, DIVIDES_FACTORS, MULT_ASSOC, MULT_LEFT_CANCEL]
2441QED
2442
2443(* Theorem: 0 < n /\ 0 < m /\ 0 < m DIV n /\
2444           n divides m /\ m divides x /\ (m DIV n) divides x ==>
2445           (x DIV (m DIV n) = n * (x DIV m)) *)
2446(* Proof:
2447     x DIV (m DIV n)
2448   = (n * x) DIV (n * (m DIV n))   by DIV_COMMON_FACTOR, (m DIV n) divides x, 0 < m DIV n.
2449   = (n * x) DIV m                 by DIVIDES_FACTORS, n divides m, 0 < n.
2450   = n * (x DIV m)                 by MULTIPLY_DIV, m divides x, 0 < m.
2451*)
2452Theorem DIV_DIV_MULT:
2453    !m n x. 0 < n /\ 0 < m /\ 0 < m DIV n /\
2454           n divides m /\ m divides x /\ (m DIV n) divides x ==>
2455           (x DIV (m DIV n) = n * (x DIV m))
2456Proof
2457  metis_tac[DIV_COMMON_FACTOR, DIVIDES_FACTORS, MULTIPLY_DIV]
2458QED
2459
2460(* ------------------------------------------------------------------------- *)
2461(* Basic Divisibility                                                        *)
2462(* ------------------------------------------------------------------------- *)
2463
2464(* Idea: a little trick to make divisibility to mean equality. *)
2465
2466(* Theorem: 0 < n /\ n < 2 * m ==> (m divides n <=> n = m) *)
2467(* Proof:
2468   If part: 0 < n /\ n < 2 * m /\ m divides n ==> n = m
2469      Note ?k. n = k * m           by divides_def
2470       Now k * m < 2 * m           by n < 2 * m
2471        so 0 < m /\ k < 2          by LT_MULT_LCANCEL
2472       and 0 < k                   by MULT
2473        so 1 <= k                  by LE_MULT_LCANCEL, 0 < m
2474      Thus k = 1, or n = m.
2475   Only-if part: true              by DIVIDES_REFL
2476*)
2477Theorem divides_iff_equal:
2478  !m n. 0 < n /\ n < 2 * m ==> (m divides n <=> n = m)
2479Proof
2480  rw[EQ_IMP_THM] >>
2481  `?k. n = k * m` by rw[GSYM divides_def] >>
2482  `0 < m /\ k < 2` by fs[LT_MULT_LCANCEL] >>
2483  `0 < k` by fs[] >>
2484  `k = 1` by decide_tac >>
2485  simp[]
2486QED
2487
2488(* Theorem: 0 < m /\ n divides m ==> !t. m divides (t * n) <=> (m DIV n) divides t *)
2489(* Proof:
2490   Let k = m DIV n.
2491   Since m <> 0, n divides m ==> n <> 0       by ZERO_DIVIDES
2492    Thus m = k * n                            by DIVIDES_EQN, 0 < n
2493      so 0 < k                                by MULT, NOT_ZERO_LT_ZERO
2494   Hence k * n divides t * n <=> k divides t  by DIVIDES_CANCEL, 0 < k
2495*)
2496Theorem dividend_divides_divisor_multiple:
2497    !m n. 0 < m /\ n divides m ==> !t. m divides (t * n) <=> (m DIV n) divides t
2498Proof
2499  rpt strip_tac >>
2500  qabbrev_tac `k = m DIV n` >>
2501  `0 < n` by metis_tac[ZERO_DIVIDES, NOT_ZERO_LT_ZERO] >>
2502  `m = k * n` by rw[GSYM DIVIDES_EQN, Abbr`k`] >>
2503  `0 < k` by metis_tac[MULT, NOT_ZERO_LT_ZERO] >>
2504  metis_tac[DIVIDES_CANCEL]
2505QED
2506
2507(* Theorem: 0 < n /\ m divides n ==> 0 < m *)
2508(* Proof:
2509   Since 0 < n means n <> 0,
2510    then m divides n ==> m <> 0     by ZERO_DIVIDES
2511      or 0 < m                      by NOT_ZERO_LT_ZERO
2512*)
2513(* Theorem: 1 < p ==> !m n. p ** m divides p ** n <=> m <= n *)
2514(* Proof:
2515   Note p <> 0 /\ p <> 1                      by 1 < p
2516
2517   If-part: p ** m divides p ** n ==> m <= n
2518      By contradiction, suppose n < m.
2519      Let d = m - n, then d <> 0              by n < m
2520      Note p ** m = p ** n * p ** d           by EXP_BY_ADD_SUB_LT
2521       and p ** n <> 0                        by EXP_EQ_0, p <> 0
2522       Now ?q. p ** n = q * p ** m            by divides_def
2523                      = q * p ** d * p ** n   by MULT_ASSOC_COMM
2524      Thus 1 * p ** n = q * p ** d * p ** n   by MULT_LEFT_1
2525        or          1 = q * p ** d            by MULT_RIGHT_CANCEL
2526       ==>     p ** d = 1                     by MULT_EQ_1
2527        or          d = 0                     by EXP_EQ_1, p <> 1
2528      This contradicts d <> 0.
2529
2530  Only-if part: m <= n ==> p ** m divides p ** n
2531      Note p ** n = p ** m * p ** (n - m)     by EXP_BY_ADD_SUB_LE
2532      Thus p ** m divides p ** n              by divides_def, MULT_COMM
2533*)
2534Theorem power_divides_iff:
2535    !p. 1 < p ==> !m n. p ** m divides p ** n <=> m <= n
2536Proof
2537  rpt strip_tac >>
2538  `p <> 0 /\ p <> 1` by decide_tac >>
2539  rw[EQ_IMP_THM] >| [
2540    spose_not_then strip_assume_tac >>
2541    `n < m /\ m - n <> 0` by decide_tac >>
2542    qabbrev_tac `d = m - n` >>
2543    `p ** m = p ** n * p ** d` by rw[EXP_BY_ADD_SUB_LT, Abbr`d`] >>
2544    `p ** n <> 0` by rw[EXP_EQ_0] >>
2545    `?q. p ** n = q * p ** m` by rw[GSYM divides_def] >>
2546    `_ = q * p ** d * p ** n` by metis_tac[MULT_ASSOC_COMM] >>
2547    `1 = q * p ** d` by metis_tac[MULT_RIGHT_CANCEL, MULT_LEFT_1] >>
2548    `p ** d = 1` by metis_tac[MULT_EQ_1] >>
2549    metis_tac[EXP_EQ_1],
2550    `p ** n = p ** m * p ** (n - m)` by rw[EXP_BY_ADD_SUB_LE] >>
2551    metis_tac[divides_def, MULT_COMM]
2552  ]
2553QED
2554
2555(* Theorem: prime p ==> !m n. p ** m divides p ** n <=> m <= n *)
2556(* Proof: by power_divides_iff, ONE_LT_PRIME *)
2557Theorem prime_power_divides_iff:
2558    !p. prime p ==> !m n. p ** m divides p ** n <=> m <= n
2559Proof
2560  rw[power_divides_iff, ONE_LT_PRIME]
2561QED
2562
2563(* Theorem: 0 < n /\ 1 < p ==> p divides p ** n *)
2564(* Proof:
2565   Note 0 < n <=> 1 <= n         by arithmetic
2566     so p ** 1 divides p ** n    by power_divides_iff
2567     or      p divides p ** n    by EXP_1
2568*)
2569Theorem divides_self_power:
2570    !n p. 0 < n /\ 1 < p ==> p divides p ** n
2571Proof
2572  metis_tac[power_divides_iff, EXP_1, DECIDE``0 < n <=> 1 <= n``]
2573QED
2574
2575(* Theorem: a divides b /\ 0 < b /\ b < 2 * a ==> (b = a) *)
2576(* Proof:
2577   Note ?k. b = k * a      by divides_def
2578    and 0 < k              by MULT_EQ_0, 0 < b
2579    and k < 2              by LT_MULT_RCANCEL, k * a < 2 * a
2580   Thus k = 1              by 0 < k < 2
2581     or b = k * a = a      by arithmetic
2582*)
2583Theorem divides_eq_thm:
2584  !a b. a divides b /\ 0 < b /\ b < 2 * a ==> (b = a)
2585Proof
2586  rpt strip_tac >>
2587  `?k. b = k * a` by rw[GSYM divides_def] >>
2588  `0 < k` by metis_tac[MULT_EQ_0, NOT_ZERO] >>
2589  `k < 2` by metis_tac[LT_MULT_RCANCEL] >>
2590  `k = 1` by decide_tac >>
2591  simp[]
2592QED
2593
2594(* Idea: factor equals cofactor iff the number is a square of the factor. *)
2595
2596(* Theorem: 0 < m /\ m divides n ==> (m = n DIV m <=> n = m ** 2) *)
2597(* Proof:
2598        n
2599      = n DIV m * m + n MOD m    by DIVISION, 0 < m
2600      = n DIV m * m + 0          by DIVIDES_MOD_0, m divides n
2601      = n DIV m * m              by ADD_0
2602   If m = n DIV m,
2603     then n = m * m = m ** 2     by EXP_2
2604   If n = m ** 2,
2605     then n = m * m              by EXP_2
2606       so m = n DIV m            by EQ_MULT_RCANCEL
2607*)
2608Theorem factor_eq_cofactor:
2609  !m n. 0 < m /\ m divides n ==> (m = n DIV m <=> n = m ** 2)
2610Proof
2611  rw[EQ_IMP_THM] >>
2612  `n = n DIV m * m + n MOD m` by rw[DIVISION] >>
2613  `_ = m * m + 0` by metis_tac[DIVIDES_MOD_0] >>
2614  simp[]
2615QED
2616
2617(* Theorem alias *)
2618Theorem euclid_prime = gcdTheory.P_EUCLIDES;
2619(* |- !p a b. prime p /\ p divides a * b ==> p divides a \/ p divides b *)
2620
2621(* Theorem alias *)
2622Theorem euclid_coprime = gcdTheory.L_EUCLIDES;
2623(* |- !a b c. coprime a b /\ b divides a * c ==> b divides c *)
2624
2625(* Both MOD_EQ_DIFF and MOD_EQ are required in MOD_MULT_LCANCEL *)
2626
2627(* Idea: equality exchange for MOD without negative. *)
2628
2629(* Theorem: b < n /\ c < n ==>
2630              ((a + b) MOD n = (c + d) MOD n <=>
2631               (a + (n - c)) MOD n = (d + (n - b)) MOD n) *)
2632(* Proof:
2633   Note 0 < n                  by b < n or c < n
2634   Let x = n - b, y = n - c.
2635   The goal is: (a + b) MOD n = (c + d) MOD n <=>
2636                (a + y) MOD n = (d + x) MOD n
2637   Note n = b + x, n = c + y   by arithmetic
2638       (a + b) MOD n = (c + d) MOD n
2639   <=> (a + b + x + y) MOD n = (c + d + x + y) MOD n   by ADD_MOD
2640   <=> (a + y + n) MOD n = (d + x + n) MOD n           by above
2641   <=> (a + y) MOD n = (d + x) MOD n                   by ADD_MOD
2642
2643   For integers, this is simply: a + b = c + d <=> a - c = b - d.
2644*)
2645Theorem mod_add_eq_sub:
2646  !n a b c d. b < n /\ c < n ==>
2647              ((a + b) MOD n = (c + d) MOD n <=>
2648               (a + (n - c)) MOD n = (d + (n - b)) MOD n)
2649Proof
2650  rpt strip_tac >>
2651  `0 < n` by decide_tac >>
2652  `n = b + (n - b)` by decide_tac >>
2653  `n = c + (n - c)` by decide_tac >>
2654  qabbrev_tac `x = n - b` >>
2655  qabbrev_tac `y = n - c` >>
2656  `a + b + x + y = a + y + n` by decide_tac >>
2657  `c + d + x + y = d + x + n` by decide_tac >>
2658  `(a + b) MOD n = (c + d) MOD n <=>
2659    (a + b + x + y) MOD n = (c + d + x + y) MOD n` by simp[ADD_MOD] >>
2660  fs[ADD_MOD]
2661QED
2662
2663(* Idea: generalise above equality exchange for MOD. *)
2664
2665(* Theorem: 0 < n ==>
2666            ((a + b) MOD n = (c + d) MOD n <=>
2667             (a + (n - c MOD n)) MOD n = (d + (n - b MOD n)) MOD n) *)
2668(* Proof:
2669   Let b' = b MOD n, c' = c MOD n.
2670   Note b' < n            by MOD_LESS, 0 < n
2671    and c' < n            by MOD_LESS, 0 < n
2672        (a + b) MOD n = (c + d) MOD n
2673    <=> (a + b') MOD n = (d + c') MOD n              by MOD_PLUS2
2674    <=> (a + (n - c')) MOD n = (d + (n - b')) MOD n  by mod_add_eq_sub
2675*)
2676Theorem mod_add_eq_sub_eq:
2677  !n a b c d. 0 < n ==>
2678              ((a + b) MOD n = (c + d) MOD n <=>
2679               (a + (n - c MOD n)) MOD n = (d + (n - b MOD n)) MOD n)
2680Proof
2681  rpt strip_tac >>
2682  `b MOD n < n /\ c MOD n < n` by rw[] >>
2683  `(a + b) MOD n = (a + b MOD n) MOD n` by simp[Once MOD_PLUS2] >>
2684  `(c + d) MOD n = (d + c MOD n) MOD n` by simp[Once MOD_PLUS2] >>
2685  prove_tac[mod_add_eq_sub]
2686QED
2687
2688(*
2689MOD_EQN is a trick to eliminate MOD:
2690|- !n. 0 < n ==> !a b. a MOD n = b <=> ?c. a = c * n + b /\ b < n
2691*)
2692
2693(* Idea: remove MOD for divides: need b divides (a MOD n) ==> b divides a. *)
2694
2695(* Theorem: 0 < n /\ b divides n /\ b divides (a MOD n) ==> b divides a *)
2696(* Proof:
2697   Note ?k. n = k * b                    by divides_def, b divides n
2698    and ?h. a MOD n = h * b              by divides_def, b divides (a MOD n)
2699    and ?c. a = c * n + h * b            by MOD_EQN, 0 < n
2700              = c * (k * b) + h * b      by above
2701              = (c * k + h) * b          by RIGHT_ADD_DISTRIB
2702   Thus b divides a                      by divides_def
2703*)
2704Theorem mod_divides:
2705  !n a b. 0 < n /\ b divides n /\ b divides (a MOD n) ==> b divides a
2706Proof
2707  rpt strip_tac >>
2708  `?k. n = k * b` by rw[GSYM divides_def] >>
2709  `?h. a MOD n = h * b` by rw[GSYM divides_def] >>
2710  `?c. a = c * n + h * b` by metis_tac[MOD_EQN] >>
2711  `_ = (c * k + h) * b` by simp[] >>
2712  metis_tac[divides_def]
2713QED
2714
2715(* Idea: include converse of mod_divides. *)
2716
2717(* Theorem: 0 < n /\ b divides n ==> (b divides (a MOD n) <=> b divides a) *)
2718(* Proof:
2719   If part: b divides n /\ b divides a MOD n ==> b divides a
2720      This is true                       by mod_divides
2721   Only-if part: b divides n /\ b divides a ==> b divides a MOD n
2722   Note ?c. a = c * n + a MOD n          by MOD_EQN, 0 < n
2723              = c * n + 1 * a MOD n      by MULT_LEFT_1
2724   Thus b divides (a MOD n)              by divides_linear_sub
2725*)
2726Theorem mod_divides_iff:
2727  !n a b. 0 < n /\ b divides n ==> (b divides (a MOD n) <=> b divides a)
2728Proof
2729  rw[EQ_IMP_THM] >-
2730  metis_tac[mod_divides] >>
2731  `?c. a = c * n + a MOD n` by metis_tac[MOD_EQN] >>
2732  metis_tac[divides_linear_sub, MULT_LEFT_1]
2733QED
2734
2735(* An application of
2736DIVIDES_MOD_MOD:
2737|- !m n. 0 < n /\ m divides n ==> !x. x MOD n MOD m = x MOD m
2738Let x = a linear combination.
2739(linear) MOD n MOD m = linear MOD m
2740change n to a product m * n, for z = linear MOD (m * n).
2741(linear) MOD (m * n) MOD g = linear MOD g
2742z MOD g = linear MOD g
2743requires: g divides (m * n)
2744*)
2745
2746(* Idea: generalise for MOD equation: a MOD n = b. Need c divides a ==> c divides b. *)
2747
2748(* Theorem: 0 < n /\ a MOD n = b /\ c divides n /\ c divides a ==> c divides b *)
2749(* Proof:
2750   Note 0 < c                      by ZERO_DIVIDES, c divides n, 0 < n.
2751       a MOD n = b
2752   ==> (a MOD n) MOD c = b MOD c
2753   ==>         a MOD c = b MOD c   by DIVIDES_MOD_MOD, 0 < n, c divides n
2754   But a MOD c = 0                 by DIVIDES_MOD_0, c divides a
2755    so b MOD c = 0, or c divides b by DIVIDES_MOD_0, 0 < c
2756*)
2757Theorem mod_divides_divides:
2758  !n a b c. 0 < n /\ a MOD n = b /\ c divides n /\ c divides a ==> c divides b
2759Proof
2760  simp[mod_divides_iff]
2761QED
2762
2763(* Idea: include converse of mod_divides_divides. *)
2764
2765(* Theorem: 0 < n /\ a MOD n = b /\ c divides n ==> (c divides a <=> c divides b) *)
2766(* Proof:
2767   If part: c divides a ==> c divides b, true  by mod_divides_divides
2768   Only-if part: c divides b ==> c divides a
2769      Note b = a MOD n, so this is true        by mod_divides
2770*)
2771Theorem mod_divides_divides_iff:
2772  !n a b c. 0 < n /\ a MOD n = b /\ c divides n ==> (c divides a <=> c divides b)
2773Proof
2774  simp[mod_divides_iff]
2775QED
2776
2777(* Idea: divides across MOD: from a MOD n = b MOD n to c divides a ==> c divides b. *)
2778
2779(* Theorem: 0 < n /\ a MOD n = b MOD n /\ c divides n /\ c divides a ==> c divides b *)
2780(* Proof:
2781   Note c divides (b MOD n)        by mod_divides_divides
2782     so c divides b                by mod_divides
2783   Or, simply have both            by mod_divides_iff
2784*)
2785Theorem mod_eq_divides:
2786  !n a b c. 0 < n /\ a MOD n = b MOD n /\ c divides n /\ c divides a ==> c divides b
2787Proof
2788  metis_tac[mod_divides_iff]
2789QED
2790
2791(* Idea: include converse of mod_eq_divides. *)
2792
2793(* Theorem: 0 < n /\ a MOD n = b MOD n /\ c divides n ==> (c divides a <=> c divides b) *)
2794(* Proof:
2795   If part: c divides a ==> c divides b, true  by mod_eq_divides, a MOD n = b MOD n
2796   Only-if: c divides b ==> c divides a, true  by mod_eq_divides, b MOD n = a MOD n
2797*)
2798Theorem mod_eq_divides_iff:
2799  !n a b c. 0 < n /\ a MOD n = b MOD n /\ c divides n ==> (c divides a <=> c divides b)
2800Proof
2801  metis_tac[mod_eq_divides]
2802QED
2803
2804(* Idea: special cross-multiply equality of MOD (m * n) implies pair equality:
2805         from (m * a) MOD (m * n) = (n * b) MOD (m * n) to a = n /\ b = m. *)
2806
2807(* Theorem: coprime m n /\ 0 < a /\ a < 2 * n /\ 0 < b /\ b < 2 * m /\
2808            (m * a) MOD (m * n) = (n * b) MOD (m * n) ==> (a = n /\ b = m) *)
2809(* Proof:
2810   Given (m * a) MOD (m * n) = (n * b) MOD (m * n)
2811   Note n divides (n * b)      by factor_divides
2812    and n divides (m * n)      by factor_divides
2813     so n divides (m * a)      by mod_eq_divides
2814    ==> n divides a            by euclid_coprime, MULT_COMM
2815   Thus a = n                  by divides_iff_equal
2816   Also m divides (m * a)      by factor_divides
2817    and m divides (m * n)      by factor_divides
2818     so m divides (n * b)      by mod_eq_divides
2819    ==> m divides b            by euclid_coprime, GCD_SYM
2820   Thus b = m                  by divides_iff_equal
2821*)
2822Theorem mod_mult_eq_mult:
2823  !m n a b. coprime m n /\ 0 < a /\ a < 2 * n /\ 0 < b /\ b < 2 * m /\
2824            (m * a) MOD (m * n) = (n * b) MOD (m * n) ==> (a = n /\ b = m)
2825Proof
2826  ntac 5 strip_tac >>
2827  `0 < m /\ 0 < n` by decide_tac >>
2828  `0 < m * n` by rw[] >>
2829  strip_tac >| [
2830    `n divides (n * b)` by rw[DIVIDES_MULTIPLE] >>
2831    `n divides (m * n)` by rw[DIVIDES_MULTIPLE] >>
2832    `n divides (m * a)` by metis_tac[mod_eq_divides] >>
2833    `n divides a` by metis_tac[euclid_coprime, MULT_COMM] >>
2834    metis_tac[divides_iff_equal],
2835    `m divides (m * a)` by rw[DIVIDES_MULTIPLE] >>
2836    `m divides (m * n)` by metis_tac[DIVIDES_REFL, DIVIDES_MULTIPLE, MULT_COMM] >>
2837    `m divides (n * b)` by metis_tac[mod_eq_divides] >>
2838    `m divides b` by metis_tac[euclid_coprime, GCD_SYM] >>
2839    metis_tac[divides_iff_equal]
2840  ]
2841QED
2842
2843(* ------------------------------------------------------------------------- *)
2844(* Even and Odd Parity.                                                      *)
2845(* ------------------------------------------------------------------------- *)
2846
2847(* Theorem: 0 < n /\ EVEN m ==> EVEN (m ** n) *)
2848(* Proof:
2849   Since EVEN m, m MOD 2 = 0       by EVEN_MOD2
2850       EVEN (m ** n)
2851   <=> (m ** n) MOD 2 = 0          by EVEN_MOD2
2852   <=> (m MOD 2) ** n MOD 2 = 0    by EXP_MOD, 0 < 2
2853   ==> 0 ** n MOD 2 = 0            by above
2854   <=> 0 MOD 2 = 0                 by ZERO_EXP, n <> 0
2855   <=> 0 = 0                       by ZERO_MOD
2856   <=> T
2857*)
2858(* Note: arithmeticTheory.EVEN_EXP  |- !m n. 0 < n /\ EVEN m ==> EVEN (m ** n) *)
2859
2860(* Theorem: !m n. 0 < n /\ ODD m ==> ODD (m ** n) *)
2861(* Proof:
2862   Since ODD m, m MOD 2 = 1        by ODD_MOD2
2863       ODD (m ** n)
2864   <=> (m ** n) MOD 2 = 1          by ODD_MOD2
2865   <=> (m MOD 2) ** n MOD 2 = 1    by EXP_MOD, 0 < 2
2866   ==> 1 ** n MOD 2 = 1            by above
2867   <=> 1 MOD 2 = 1                 by EXP_1, n <> 0
2868   <=> 1 = 1                       by ONE_MOD, 1 < 2
2869   <=> T
2870*)
2871Theorem ODD_EXP:
2872    !m n. 0 < n /\ ODD m ==> ODD (m ** n)
2873Proof
2874  rw[ODD_MOD2] >>
2875  `n <> 0 /\ 0 < 2` by decide_tac >>
2876  metis_tac[EXP_MOD, EXP_1, ONE_MOD]
2877QED
2878
2879(* Theorem: 0 < n ==> !m. (EVEN m <=> EVEN (m ** n)) /\ (ODD m <=> ODD (m ** n)) *)
2880(* Proof:
2881   First goal: EVEN m <=> EVEN (m ** n)
2882     If part: EVEN m ==> EVEN (m ** n), true by EVEN_EXP
2883     Only-if part: EVEN (m ** n) ==> EVEN m.
2884        By contradiction, suppose ~EVEN m.
2885        Then ODD m                           by EVEN_ODD
2886         and ODD (m ** n)                    by ODD_EXP
2887          or ~EVEN (m ** n)                  by EVEN_ODD
2888        This contradicts EVEN (m ** n).
2889   Second goal: ODD m <=> ODD (m ** n)
2890     Just mirror the reasoning of first goal.
2891*)
2892Theorem power_parity:
2893    !n. 0 < n ==> !m. (EVEN m <=> EVEN (m ** n)) /\ (ODD m <=> ODD (m ** n))
2894Proof
2895  metis_tac[EVEN_EXP, ODD_EXP, ODD_EVEN]
2896QED
2897
2898(* Theorem: 0 < n ==> EVEN (2 ** n) *)
2899(* Proof:
2900       EVEN (2 ** n)
2901   <=> (2 ** n) MOD 2 = 0          by EVEN_MOD2
2902   <=> (2 MOD 2) ** n MOD 2 = 0    by EXP_MOD
2903   <=> 0 ** n MOD 2 = 0            by DIVMOD_ID, 0 < 2
2904   <=> 0 MOD 2 = 0                 by ZERO_EXP, n <> 0
2905   <=> 0 = 0                       by ZERO_MOD
2906   <=> T
2907*)
2908Theorem EXP_2_EVEN:  !n. 0 < n ==> EVEN (2 ** n)
2909Proof rw[EVEN_MOD2, ZERO_EXP]
2910QED
2911(* Michael's proof by induction
2912val EXP_2_EVEN = store_thm(
2913  "EXP_2_EVEN",
2914  ``!n. 0 < n ==> EVEN (2 ** n)``,
2915  Induct >> rw[EXP, EVEN_DOUBLE]);
2916 *)
2917
2918(* Theorem: 0 < n ==> ODD (2 ** n - 1) *)
2919(* Proof:
2920   Since 0 < 2 ** n                  by EXP_POS, 0 < 2
2921      so 1 <= 2 ** n                 by LESS_EQ
2922    thus SUC (2 ** n - 1)
2923       = 2 ** n - 1 + 1              by ADD1
2924       = 2 ** n                      by SUB_ADD, 1 <= 2 ** n
2925     and EVEN (2 ** n)               by EXP_2_EVEN
2926   Hence ODD (2 ** n - 1)            by EVEN_ODD_SUC
2927*)
2928Theorem EXP_2_PRE_ODD:
2929    !n. 0 < n ==> ODD (2 ** n - 1)
2930Proof
2931  rpt strip_tac >>
2932  `0 < 2 ** n` by rw[EXP_POS] >>
2933  `SUC (2 ** n - 1) = 2 ** n` by decide_tac >>
2934  metis_tac[EXP_2_EVEN, EVEN_ODD_SUC]
2935QED
2936
2937(* ------------------------------------------------------------------------- *)
2938(* Modulo Inverse                                                            *)
2939(* ------------------------------------------------------------------------- *)
2940
2941(* Theorem: [Cancellation Law for MOD p]
2942   For prime p, if x MOD p <> 0,
2943      (x*y) MOD p = (x*z) MOD p ==> y MOD p = z MOD p *)
2944(* Proof:
2945       (x*y) MOD p = (x*z) MOD p
2946   ==> ((x*y) - (x*z)) MOD p = 0   by MOD_EQ_DIFF
2947   ==>       (x*(y-z)) MOD p = 0   by arithmetic LEFT_SUB_DISTRIB
2948   ==>           (y-z) MOD p = 0   by EUCLID_LEMMA, x MOD p <> 0
2949   ==>               y MOD p = z MOD p    if z <= y
2950
2951   Since this theorem is symmetric in y, z,
2952   First prove the theorem assuming z <= y,
2953   then use the same proof for y <= z.
2954*)
2955Theorem MOD_MULT_LCANCEL:
2956  !p x y z. prime p /\ (x * y) MOD p = (x * z) MOD p /\ x MOD p <> 0 ==> y MOD p = z MOD p
2957Proof
2958  rpt strip_tac >>
2959  `!a b c. c <= b /\ (a * b) MOD p = (a * c) MOD p /\ a MOD p <> 0 ==> b MOD p = c MOD p` by
2960  (rpt strip_tac >>
2961  `0 < p` by rw[PRIME_POS] >>
2962  `(a * b - a * c) MOD p = 0` by rw[MOD_EQ_DIFF] >>
2963  `(a * (b - c)) MOD p = 0` by rw[LEFT_SUB_DISTRIB] >>
2964  metis_tac[EUCLID_LEMMA, MOD_EQ]) >>
2965  Cases_on `z <= y` >-
2966  metis_tac[] >>
2967  `y <= z` by decide_tac >>
2968  metis_tac[]
2969QED
2970
2971(* Theorem: prime p /\ (y * x) MOD p = (z * x) MOD p /\ x MOD p <> 0 ==>
2972            y MOD p = z MOD p *)
2973(* Proof: by MOD_MULT_LCANCEL, MULT_COMM *)
2974Theorem MOD_MULT_RCANCEL:
2975  !p x y z. prime p /\ (y * x) MOD p = (z * x) MOD p /\ x MOD p <> 0 ==>
2976            y MOD p = z MOD p
2977Proof
2978  metis_tac[MOD_MULT_LCANCEL, MULT_COMM]
2979QED
2980
2981(* Theorem: For prime p, 0 < x < p ==> ?y. 0 < y /\ y < p /\ (y*x) MOD p = 1 *)
2982(* Proof:
2983       0 < x < p
2984   ==> ~ divides p x                    by NOT_LT_DIVIDES
2985   ==> gcd p x = 1                      by gcdTheory.PRIME_GCD
2986   ==> ?k q. k * x = q * p + 1          by gcdTheory.LINEAR_GCD
2987   ==> k*x MOD p = (q*p + 1) MOD p      by arithmetic
2988   ==> k*x MOD p = 1                    by MOD_MULT, 1 < p.
2989   ==> (k MOD p)*(x MOD p) MOD p = 1    by MOD_TIMES2
2990   ==> ((k MOD p) * x) MOD p = 1        by LESS_MOD, x < p.
2991   Now   k MOD p < p                    by MOD_LESS
2992   and   0 < k MOD p since (k*x) MOD p <> 0  (by 1 <> 0)
2993                       and x MOD p <> 0      (by ~ divides p x)
2994                                        by EUCLID_LEMMA
2995   Hence take y = k MOD p, then 0 < y < p.
2996*)
2997Theorem MOD_MULT_INV_EXISTS:
2998    !p x. prime p /\ 0 < x /\ x < p ==> ?y. 0 < y /\ y < p /\ ((y * x) MOD p = 1)
2999Proof
3000  rpt strip_tac >>
3001  `0 < p /\ 1 < p` by metis_tac[PRIME_POS, ONE_LT_PRIME] >>
3002  `gcd p x = 1` by metis_tac[PRIME_GCD, NOT_LT_DIVIDES] >>
3003  `?k q. k * x = q * p + 1` by metis_tac[LINEAR_GCD, NOT_ZERO_LT_ZERO] >>
3004  `1 = (k * x) MOD p` by metis_tac[MOD_MULT] >>
3005  `_ = ((k MOD p) * (x MOD p)) MOD p` by metis_tac[MOD_TIMES2] >>
3006  `0 < k MOD p` by
3007  (`1 <> 0` by decide_tac >>
3008  `x MOD p <> 0` by metis_tac[DIVIDES_MOD_0, NOT_LT_DIVIDES] >>
3009  `k MOD p <> 0` by metis_tac[EUCLID_LEMMA, MOD_MOD] >>
3010  decide_tac) >>
3011  metis_tac[MOD_LESS, LESS_MOD]
3012QED
3013
3014(* Convert this theorem into MUL_INV_DEF *)
3015
3016(* Step 1: move ?y forward by collecting quantifiers *)
3017Theorem lemma[local]:
3018    !p x. ?y. prime p /\ 0 < x /\ x < p ==> 0 < y /\ y < p /\ ((y * x) MOD p = 1)
3019Proof
3020  metis_tac[MOD_MULT_INV_EXISTS]
3021QED
3022
3023(* Step 2: apply SKOLEM_THM *)
3024(*
3025- SKOLEM_THM;
3026> val it = |- !P. (!x. ?y. P x y) <=> ?f. !x. P x (f x) : thm
3027*)
3028val MOD_MULT_INV_DEF = new_specification(
3029  "MOD_MULT_INV_DEF",
3030  ["MOD_MULT_INV"], (* avoid MOD_MULT_INV_EXISTS: thm *)
3031  SIMP_RULE (srw_ss()) [SKOLEM_THM] lemma);
3032(*
3033> val MOD_MULT_INV_DEF =
3034    |- !p x.
3035         prime p /\ 0 < x /\ x < p ==>
3036         0 < MOD_MULT_INV p x /\ MOD_MULT_INV p x < p /\
3037         ((MOD_MULT_INV p x * x) MOD p = 1) : thm
3038*)
3039
3040(* ------------------------------------------------------------------------- *)
3041(* FACTOR Theorems                                                           *)
3042(* ------------------------------------------------------------------------- *)
3043
3044(* Theorem: ~ prime n ==> n has a proper prime factor p *)
3045(* Proof: apply PRIME_FACTOR:
3046   !n. n <> 1 ==> ?p. prime p /\ p divides n : thm
3047*)
3048Theorem PRIME_FACTOR_PROPER:
3049    !n. 1 < n /\ ~prime n ==> ?p. prime p /\ p < n /\ (p divides n)
3050Proof
3051  rpt strip_tac >>
3052  `0 < n /\ n <> 1` by decide_tac >>
3053  `?p. prime p /\ p divides n` by metis_tac[PRIME_FACTOR] >>
3054  `~(n < p)` by metis_tac[NOT_LT_DIVIDES] >>
3055  Cases_on `n = p` >-
3056  full_simp_tac std_ss[] >>
3057  `p < n` by decide_tac >>
3058  metis_tac[]
3059QED
3060
3061(* Theorem: If p divides n, then there is a (p ** m) that maximally divides n. *)
3062(* Proof:
3063   Consider the set s = {k | p ** k divides n}
3064   Since p IN s, s <> {}           by MEMBER_NOT_EMPTY
3065   For k IN s, p ** k n divides ==> p ** k <= n    by DIVIDES_LE
3066   Since ?z. n <= p ** z           by EXP_ALWAYS_BIG_ENOUGH
3067   p ** k <= p ** z
3068        k <= z                     by EXP_BASE_LE_MONO
3069     or k < SUC z
3070   Hence s SUBSET count (SUC z)    by SUBSET_DEF
3071   and FINITE s                    by FINITE_COUNT, SUBSET_FINITE
3072   Let m = MAX_SET s
3073   Then p ** m n divides           by MAX_SET_DEF
3074   Let q = n DIV (p ** m)
3075   i.e.  n = q * (p ** m)
3076   If p divides q, then q = t * p
3077   or n = t * p * (p ** m)
3078        = t * (p * p ** m)         by MULT_ASSOC
3079        = t * p ** SUC m           by EXP
3080   i.e. p ** SUC m  divides n, or SUC m IN s.
3081   Since m < SUC m                 by LESS_SUC
3082   This contradicts the maximal property of m.
3083*)
3084Theorem FACTOR_OUT_POWER:
3085    !n p. 0 < n /\ 1 < p /\ p divides n ==> ?m. (p ** m) divides n /\ ~(p divides (n DIV (p ** m)))
3086Proof
3087  rpt strip_tac >>
3088  `p <= n` by rw[DIVIDES_LE] >>
3089  `1 < n` by decide_tac >>
3090  qabbrev_tac `s = {k | (p ** k) divides n }` >>
3091  qexists_tac `MAX_SET s` >>
3092  qabbrev_tac `m = MAX_SET s` >>
3093  `!k. k IN s <=> (p ** k) divides n` by rw[Abbr`s`] >>
3094  `s <> {}` by metis_tac[MEMBER_NOT_EMPTY, EXP_1] >>
3095  `?z. n <= p ** z` by rw[EXP_ALWAYS_BIG_ENOUGH] >>
3096  `!k. k IN s ==> k <= z` by metis_tac[DIVIDES_LE, EXP_BASE_LE_MONO, LESS_EQ_TRANS] >>
3097  `!k. k <= z ==> k < SUC z` by decide_tac >>
3098  `s SUBSET (count (SUC z))` by metis_tac[IN_COUNT, SUBSET_DEF, LESS_EQ_TRANS] >>
3099  `FINITE s` by metis_tac[FINITE_COUNT, SUBSET_FINITE] >>
3100  `m IN s /\ !y. y IN s ==> y <= m` by metis_tac[MAX_SET_DEF] >>
3101  `(p ** m) divides n` by metis_tac[] >>
3102  rw[] >>
3103  spose_not_then strip_assume_tac >>
3104  `0 < p` by decide_tac >>
3105  `0 < p ** m` by rw[EXP_POS] >>
3106  `n = (p ** m) * (n DIV (p ** m))` by rw[DIVIDES_FACTORS] >>
3107  `?q. n DIV (p ** m) = q * p` by rw[GSYM divides_def] >>
3108  `n = q * p ** SUC m` by metis_tac[MULT_COMM, MULT_ASSOC, EXP] >>
3109  `SUC m <= m` by metis_tac[divides_def] >>
3110  decide_tac
3111QED
3112
3113(* ------------------------------------------------------------------------- *)
3114(* Useful Theorems.                                                          *)
3115(* ------------------------------------------------------------------------- *)
3116
3117(* binomial_add: same as SUM_SQUARED *)
3118
3119(* Theorem: (a + b) ** 2 = a ** 2 + b ** 2 + 2 * a * b *)
3120(* Proof:
3121     (a + b) ** 2
3122   = (a + b) * (a + b)                   by EXP_2
3123   = a * (a + b) + b * (a + b)           by RIGHT_ADD_DISTRIB
3124   = (a * a + a * b) + (b * a + b * b)   by LEFT_ADD_DISTRIB
3125   = a * a + b * b + 2 * a * b           by arithmetic
3126   = a ** 2 + b ** 2 + 2 * a * b         by EXP_2
3127*)
3128Theorem binomial_add:
3129  !a b. (a + b) ** 2 = a ** 2 + b ** 2 + 2 * a * b
3130Proof
3131  rpt strip_tac >>
3132  `(a + b) ** 2 = (a + b) * (a + b)` by simp[] >>
3133  `_ = a * a + b * b + 2 * a * b` by decide_tac >>
3134  simp[]
3135QED
3136
3137(* Theorem: b <= a ==> ((a - b) ** 2 = a ** 2 + b ** 2 - 2 * a * b) *)
3138(* Proof:
3139   If b = 0,
3140      RHS = a ** 2 + 0 ** 2 - 2 * a * 0
3141          = a ** 2 + 0 - 0
3142          = a ** 2
3143          = (a - 0) ** 2
3144          = LHS
3145   If b <> 0,
3146      Then b * b <= a * b                      by LE_MULT_RCANCEL, b <> 0
3147       and b * b <= 2 * a * b
3148
3149      LHS = (a - b) ** 2
3150          = (a - b) * (a - b)                  by EXP_2
3151          = a * (a - b) - b * (a - b)          by RIGHT_SUB_DISTRIB
3152          = (a * a - a * b) - (b * a - b * b)  by LEFT_SUB_DISTRIB
3153          = a * a - (a * b + (a * b - b * b))  by SUB_PLUS
3154          = a * a - (a * b + a * b - b * b)    by LESS_EQ_ADD_SUB, b * b <= a * b
3155          = a * a - (2 * a * b - b * b)
3156          = a * a + b * b - 2 * a * b          by SUB_SUB, b * b <= 2 * a * b
3157          = a ** 2 + b ** 2 - 2 * a * b        by EXP_2
3158          = RHS
3159*)
3160Theorem binomial_sub:
3161  !a b. b <= a ==> ((a - b) ** 2 = a ** 2 + b ** 2 - 2 * a * b)
3162Proof
3163  rpt strip_tac >>
3164  Cases_on `b = 0` >-
3165  simp[] >>
3166  `b * b <= a * b` by rw[] >>
3167  `b * b <= 2 * a * b` by decide_tac >>
3168  `(a - b) ** 2 = (a - b) * (a - b)` by simp[] >>
3169  `_ = a * a + b * b - 2 * a * b` by decide_tac >>
3170  rw[]
3171QED
3172
3173(* Theorem: 2 * a * b <= a ** 2 + b ** 2 *)
3174(* Proof:
3175   If a = b,
3176      LHS = 2 * a * a
3177          = a * a + a * a
3178          = a ** 2 + a ** 2        by EXP_2
3179          = RHS
3180   If a < b, then 0 < b - a.
3181      Thus 0 < (b - a) * (b - a)   by MULT_EQ_0
3182        or 0 < (b - a) ** 2        by EXP_2
3183        so 0 < b ** 2 + a ** 2 - 2 * b * a   by binomial_sub, a <= b
3184       ==> 2 * a * b < a ** 2 + b ** 2       due to 0 < RHS.
3185   If b < a, then 0 < a - b.
3186      Thus 0 < (a - b) * (a - b)   by MULT_EQ_0
3187        or 0 < (a - b) ** 2        by EXP_2
3188        so 0 < a ** 2 + b ** 2 - 2 * a * b   by binomial_sub, b <= a
3189       ==> 2 * a * b < a ** 2 + b ** 2       due to 0 < RHS.
3190*)
3191Theorem binomial_means:
3192  !a b. 2 * a * b <= a ** 2 + b ** 2
3193Proof
3194  rpt strip_tac >>
3195  Cases_on `a = b` >-
3196  simp[] >>
3197  Cases_on `a < b` >| [
3198    `b - a <> 0` by decide_tac >>
3199    `(b - a) * (b - a) <> 0` by metis_tac[MULT_EQ_0] >>
3200    `(b - a) * (b - a) = (b - a) ** 2` by simp[] >>
3201    `_ = b ** 2 + a ** 2 - 2 * b * a` by rw[binomial_sub] >>
3202    decide_tac,
3203    `a - b <> 0` by decide_tac >>
3204    `(a - b) * (a - b) <> 0` by metis_tac[MULT_EQ_0] >>
3205    `(a - b) * (a - b) = (a - b) ** 2` by simp[] >>
3206    `_ = a ** 2 + b ** 2 - 2 * a * b` by rw[binomial_sub] >>
3207    decide_tac
3208  ]
3209QED
3210
3211(* Theorem: b <= a ==> (a - b) ** 2 + 2 * a * b = a ** 2 + b ** 2 *)
3212(* Proof:
3213   Note (a - b) ** 2 = a ** 2 + b ** 2 - 2 * a * b     by binomial_sub
3214    and 2 * a * b <= a ** 2 + b ** 2                   by binomial_means
3215   Thus (a - b) ** 2 + 2 * a * b = a ** 2 + b ** 2
3216*)
3217Theorem binomial_sub_sum:
3218  !a b. b <= a ==> (a - b) ** 2 + 2 * a * b = a ** 2 + b ** 2
3219Proof
3220  rpt strip_tac >>
3221  imp_res_tac binomial_sub >>
3222  assume_tac (binomial_means |> SPEC_ALL) >>
3223  decide_tac
3224QED
3225
3226(* Theorem: b <= a ==> ((a - b) ** 2 + 4 * a * b = (a + b) ** 2) *)
3227(* Proof:
3228   Note: 2 * a * b <= a ** 2 + b ** 2          by binomial_means, as [1]
3229     (a - b) ** 2 + 4 * a * b
3230   = a ** 2 + b ** 2 - 2 * a * b + 4 * a * b   by binomial_sub, b <= a
3231   = a ** 2 + b ** 2 + 4 * a * b - 2 * a * b   by SUB_ADD, [1]
3232   = a ** 2 + b ** 2 + 2 * a * b
3233   = (a + b) ** 2                              by binomial_add
3234*)
3235Theorem binomial_sub_add:
3236  !a b. b <= a ==> ((a - b) ** 2 + 4 * a * b = (a + b) ** 2)
3237Proof
3238  rpt strip_tac >>
3239  `2 * a * b <= a ** 2 + b ** 2` by rw[binomial_means] >>
3240  `(a - b) ** 2 + 4 * a * b = a ** 2 + b ** 2 - 2 * a * b + 4 * a * b` by rw[binomial_sub] >>
3241  `_ = a ** 2 + b ** 2 + 4 * a * b - 2 * a * b` by decide_tac >>
3242  `_ = a ** 2 + b ** 2 + 2 * a * b` by decide_tac >>
3243  `_ = (a + b) ** 2` by rw[binomial_add] >>
3244  decide_tac
3245QED
3246
3247(* Theorem: a ** 2 - b ** 2 = (a - b) * (a + b) *)
3248(* Proof:
3249     a ** 2 - b ** 2
3250   = a * a - b * b                       by EXP_2
3251   = a * a + a * b - a * b - b * b       by ADD_SUB
3252   = a * a + a * b - (b * a + b * b)     by SUB_PLUS
3253   = a * (a + b) - b * (a + b)           by LEFT_ADD_DISTRIB
3254   = (a - b) * (a + b)                   by RIGHT_SUB_DISTRIB
3255*)
3256Theorem difference_of_squares:
3257  !a b. a ** 2 - b ** 2 = (a - b) * (a + b)
3258Proof
3259  rpt strip_tac >>
3260  `a ** 2 - b ** 2 = a * a - b * b` by simp[] >>
3261  `_ = a * a + a * b - a * b - b * b` by decide_tac >>
3262  decide_tac
3263QED
3264
3265(* Theorem: a * a - b * b = (a - b) * (a + b) *)
3266(* Proof:
3267     a * a - b * b
3268   = a ** 2 - b ** 2       by EXP_2
3269   = (a + b) * (a - b)     by difference_of_squares
3270*)
3271Theorem difference_of_squares_alt:
3272  !a b. a * a - b * b = (a - b) * (a + b)
3273Proof
3274  rw[difference_of_squares]
3275QED
3276
3277(* binomial_2: same as binomial_add, or SUM_SQUARED *)
3278
3279(* Theorem: (m + n) ** 2 = m ** 2 + n ** 2 + 2 * m * n *)
3280(* Proof:
3281     (m + n) ** 2
3282   = (m + n) * (m + n)                 by EXP_2
3283   = m * m + n * m + m * n + n * n     by LEFT_ADD_DISTRIB, RIGHT_ADD_DISTRIB
3284   = m ** 2 + n ** 2 + 2 * m * n       by EXP_2
3285*)
3286Theorem binomial_2:
3287    !m n. (m + n) ** 2 = m ** 2 + n ** 2 + 2 * m * n
3288Proof
3289  rpt strip_tac >>
3290  `(m + n) ** 2 = (m + n) * (m + n)` by rw[] >>
3291  `_ = m * m + n * m + m * n + n * n` by decide_tac >>
3292  `_ = m ** 2 + n ** 2 + 2 * m * n` by rw[] >>
3293  decide_tac
3294QED
3295
3296(* Obtain a corollary *)
3297Theorem SUC_SQ =
3298    binomial_2 |> SPEC ``1`` |> SIMP_RULE (srw_ss()) [GSYM SUC_ONE_ADD];
3299(* val SUC_SQ = |- !n. SUC n ** 2 = SUC (n ** 2) + TWICE n: thm *)
3300
3301(* Theorem: m <= n ==> SQ m <= SQ n *)
3302(* Proof:
3303   Since m * m <= n * n    by LE_MONO_MULT2
3304      so  SQ m <= SQ n     by notation
3305*)
3306Theorem SQ_LE:
3307    !m n. m <= n ==> SQ m <= SQ n
3308Proof
3309  rw[]
3310QED
3311
3312(* Theorem: EVEN n /\ prime n <=> n = 2 *)
3313(* Proof:
3314   If part: EVEN n /\ prime n ==> n = 2
3315      EVEN n ==> n MOD 2 = 0       by EVEN_MOD2
3316             ==> 2 divides n       by DIVIDES_MOD_0, 0 < 2
3317             ==> n = 2             by prime_def, 2 <> 1
3318   Only-if part: n = 2 ==> EVEN n /\ prime n
3319      Note EVEN 2                  by EVEN_2
3320       and prime 2                 by prime_2
3321*)
3322(* Proof:
3323   EVEN n ==> n MOD 2 = 0    by EVEN_MOD2
3324          ==> 2 divides n    by DIVIDES_MOD_0, 0 < 2
3325          ==> n = 2          by prime_def, 2 <> 1
3326*)
3327Theorem EVEN_PRIME:
3328  !n. EVEN n /\ prime n <=> n = 2
3329Proof
3330  rw[EQ_IMP_THM] >>
3331  `0 < 2 /\ 2 <> 1` by decide_tac >>
3332  `2 divides n` by rw[DIVIDES_MOD_0, GSYM EVEN_MOD2] >>
3333  metis_tac[prime_def]
3334QED
3335
3336(* Theorem: prime n /\ n <> 2 ==> ODD n *)
3337(* Proof:
3338   By contradiction, suppose ~ODD n.
3339   Then EVEN n                        by EVEN_ODD
3340    but EVEN n /\ prime n ==> n = 2   by EVEN_PRIME
3341   This contradicts n <> 2.
3342*)
3343Theorem ODD_PRIME:
3344    !n. prime n /\ n <> 2 ==> ODD n
3345Proof
3346  metis_tac[EVEN_PRIME, EVEN_ODD]
3347QED
3348
3349(* Theorem: prime p ==> 2 <= p *)
3350(* Proof: by ONE_LT_PRIME *)
3351Theorem TWO_LE_PRIME:
3352    !p. prime p ==> 2 <= p
3353Proof
3354  metis_tac[ONE_LT_PRIME, DECIDE``1 < n <=> 2 <= n``]
3355QED
3356
3357(* Theorem: ~prime 4 *)
3358(* Proof:
3359   Note 4 = 2 * 2      by arithmetic
3360     so 2 divides 4    by divides_def
3361   thus ~prime 4       by primes_def
3362*)
3363Theorem NOT_PRIME_4:
3364  ~prime 4
3365Proof
3366  rpt strip_tac >>
3367  `4 = 2 * 2` by decide_tac >>
3368  `4 <> 2 /\ 4 <> 1 /\ 2 <> 1` by decide_tac >>
3369  metis_tac[prime_def, divides_def]
3370QED
3371
3372(* Theorem: prime n /\ prime m ==> (n divides m <=> (n = m)) *)
3373(* Proof:
3374   If part: prime n /\ prime m /\ n divides m ==> (n = m)
3375      Note prime n
3376       ==> n <> 1           by NOT_PRIME_1
3377      With n divides m      by given
3378       and prime m          by given
3379      Thus n = m            by prime_def
3380   Only-if part; prime n /\ prime m /\ (n = m) ==> n divides m
3381      True as m divides m   by DIVIDES_REFL
3382*)
3383Theorem prime_divides_prime:
3384    !n m. prime n /\ prime m ==> (n divides m <=> (n = m))
3385Proof
3386  rw[EQ_IMP_THM] >>
3387  `n <> 1` by metis_tac[NOT_PRIME_1] >>
3388  metis_tac[prime_def]
3389QED
3390(* This is: dividesTheory.prime_divides_only_self;
3391|- !m n. prime m /\ prime n /\ m divides n ==> (m = n)
3392*)
3393
3394(* Theorem: 0 < m /\ 1 < n /\ (!p. prime p /\ p divides m ==> (p MOD n = 1)) ==> (m MOD n = 1) *)
3395(* Proof:
3396   By complete induction on m.
3397   If m = 1, trivially true               by ONE_MOD
3398   If m <> 1,
3399      Then ?p. prime p /\ p divides m     by PRIME_FACTOR, m <> 1
3400       and ?q. m = q * p                  by divides_def
3401       and q divides m                    by divides_def, MULT_COMM
3402      In order to apply induction hypothesis,
3403      Show: q < m
3404            Note q <= m                   by DIVIDES_LE, 0 < m
3405             But p <> 1                   by NOT_PRIME_1
3406            Thus q <> m                   by MULT_RIGHT_1, EQ_MULT_LCANCEL, m <> 0
3407             ==> q < m
3408      Show: 0 < q
3409            Since m = q * p  and m <> 0   by above
3410            Thus q <> 0, or 0 < q         by MULT
3411      Show: !p. prime p /\ p divides q ==> (p MOD n = 1)
3412            If p divides q, and q divides m,
3413            Then p divides m              by DIVIDES_TRANS
3414             ==> p MOD n = 1              by implication
3415
3416      Hence q MOD n = 1                   by induction hypothesis
3417        and p MOD n = 1                   by implication
3418        Now 0 < n                         by 1 < n
3419            m MDO n
3420          = (q * p) MOD n                 by m = q * p
3421          = (q MOD n * p MOD n) MOD n     by MOD_TIMES2, 0 < n
3422          = (1 * 1) MOD n                 by above
3423          = 1                             by MULT_RIGHT_1, ONE_MOD
3424*)
3425Theorem ALL_PRIME_FACTORS_MOD_EQ_1:
3426    !m n. 0 < m /\ 1 < n /\ (!p. prime p /\ p divides m ==> (p MOD n = 1)) ==> (m MOD n = 1)
3427Proof
3428  completeInduct_on `m` >>
3429  rpt strip_tac >>
3430  Cases_on `m = 1` >-
3431  rw[] >>
3432  `?p. prime p /\ p divides m` by rw[PRIME_FACTOR] >>
3433  `?q. m = q * p` by rw[GSYM divides_def] >>
3434  `q divides m` by metis_tac[divides_def, MULT_COMM] >>
3435  `p <> 1` by metis_tac[NOT_PRIME_1] >>
3436  `m <> 0` by decide_tac >>
3437  `q <> m` by metis_tac[MULT_RIGHT_1, EQ_MULT_LCANCEL] >>
3438  `q <= m` by metis_tac[DIVIDES_LE] >>
3439  `q < m` by decide_tac >>
3440  `q <> 0` by metis_tac[MULT] >>
3441  `0 < q` by decide_tac >>
3442  `!p. prime p /\ p divides q ==> (p MOD n = 1)` by metis_tac[DIVIDES_TRANS] >>
3443  `q MOD n = 1` by rw[] >>
3444  `p MOD n = 1` by rw[] >>
3445  `0 < n` by decide_tac >>
3446  metis_tac[MOD_TIMES2, MULT_RIGHT_1, ONE_MOD]
3447QED
3448
3449(* Theorem: prime p /\ 0 < n ==> !b. p divides (b ** n) <=> p divides b *)
3450(* Proof:
3451   If part: p divides b ** n ==> p divides b
3452      By induction on n.
3453      Base: 0 < 0 ==> p divides b ** 0 ==> p divides b
3454         True by 0 < 0 = F.
3455      Step: 0 < n ==> p divides b ** n ==> p divides b ==>
3456            0 < SUC n ==> p divides b ** SUC n ==> p divides b
3457         If n = 0,
3458              b ** SUC 0
3459            = b ** 1                  by ONE
3460            = b                       by EXP_1
3461            so p divides b.
3462         If n <> 0, 0 < n.
3463              b ** SUC n
3464            = b * b ** n              by EXP
3465            Thus p divides b,
3466              or p divides (b ** n)   by P_EUCLIDES
3467            For the latter case,
3468                 p divides b          by induction hypothesis, 0 < n
3469
3470   Only-if part: p divides b ==> p divides b ** n
3471      Since n <> 0, ?m. n = SUC m     by num_CASES
3472        and b ** n
3473          = b ** SUC m
3474          = b * b ** m                by EXP
3475       Thus p divides b ** n          by DIVIDES_MULTIPLE, MULT_COMM
3476*)
3477Theorem prime_divides_power:
3478    !p n. prime p /\ 0 < n ==> !b. p divides (b ** n) <=> p divides b
3479Proof
3480  rw[EQ_IMP_THM] >| [
3481    Induct_on `n` >-
3482    rw[] >>
3483    rpt strip_tac >>
3484    Cases_on `n = 0` >-
3485    metis_tac[ONE, EXP_1] >>
3486    `0 < n` by decide_tac >>
3487    `b ** SUC n = b * b ** n` by rw[EXP] >>
3488    metis_tac[P_EUCLIDES],
3489    `n <> 0` by decide_tac >>
3490    `?m. n = SUC m` by metis_tac[num_CASES] >>
3491    `b ** SUC m = b * b ** m` by rw[EXP] >>
3492    metis_tac[DIVIDES_MULTIPLE, MULT_COMM]
3493  ]
3494QED
3495
3496(* Theorem: prime p ==> !n. 0 < n ==> p divides p ** n *)
3497(* Proof:
3498   Since p divides p        by DIVIDES_REFL
3499      so p divides p ** n   by prime_divides_power, 0 < n
3500*)
3501Theorem prime_divides_self_power:
3502    !p. prime p ==> !n. 0 < n ==> p divides p ** n
3503Proof
3504  rw[prime_divides_power, DIVIDES_REFL]
3505QED
3506
3507(* Theorem: prime p ==> !b n m. 0 < m /\ (b ** n = p ** m) ==> ?k. (b = p ** k) /\ (k * n = m) *)
3508(* Proof:
3509   Note 1 < p                    by ONE_LT_PRIME
3510     so p <> 0, 0 < p, p <> 1    by arithmetic
3511   also m <> 0                   by 0 < m
3512   Thus p ** m <> 0              by EXP_EQ_0, p <> 0
3513    and p ** m <> 1              by EXP_EQ_1, p <> 1, m <> 0
3514    ==> n <> 0, 0 < n            by EXP, b ** n = p ** m <> 1
3515   also b <> 0, 0 < b            by EXP_EQ_0, b ** n = p ** m <> 0, 0 < n
3516
3517   Step 1: show p divides b.
3518   Note p divides (p ** m)       by prime_divides_self_power, 0 < m
3519     so p divides (b ** n)       by given, b ** n = p ** m
3520     or p divides b              by prime_divides_power, 0 < b
3521
3522   Step 2: express b = q * p ** u  where ~(p divides q).
3523   Note 1 < p /\ 0 < b /\ p divides b
3524    ==> ?u. p ** u divides b /\ ~(p divides b DIV p ** u)  by FACTOR_OUT_POWER
3525    Let q = b DIV p ** u, v = u * n.
3526   Since p ** u <> 0             by EXP_EQ_0, p <> 0
3527      so b = q * p ** u          by DIVIDES_EQN, 0 < p ** u
3528         p ** m
3529       = (q * p ** u) ** n       by b = q * p ** u
3530       = q ** n * (p ** u) ** n  by EXP_BASE_MULT
3531       = q ** n * p ** (u * n)   by EXP_EXP_MULT
3532       = q ** n * p ** v         by v = u * n
3533
3534   Step 3: split cases
3535   If v = m,
3536      Then q ** n * p ** m = 1 * p ** m     by above
3537        or          q ** n = 1              by EQ_MULT_RCANCEL, p ** m <> 0
3538      giving             q = 1              by EXP_EQ_1, 0 < n
3539      Thus b = p ** u                       by b = q * p ** u
3540      Take k = u, the result follows.
3541
3542   If v < m,
3543      Let d = m - v.
3544      Then 0 < d /\ (m = d + v)             by arithmetic
3545       and p ** m = p ** d * p ** v         by EXP_ADD
3546      Note p ** v <> 0                      by EXP_EQ_0, p <> 0
3547           q ** n * p ** v = p ** d * p ** v
3548       ==>          q ** n = p ** d         by EQ_MULT_RCANCEL, p ** v <> 0
3549      Now p divides p ** d                  by prime_divides_self_power, 0 < d
3550       so p divides q ** n                  by above, q ** n = p ** d
3551      ==> p divides q                       by prime_divides_power, 0 < n
3552      This contradicts ~(p divides q)
3553
3554   If m < v,
3555      Let d = v - m.
3556      Then 0 < d /\ (v = d + m)             by arithmetic
3557       and q ** n * p ** v
3558         = q ** n * (p ** d * p ** m)       by EXP_ADD
3559         = q ** n * p ** d * p ** m         by MULT_ASSOC
3560         = 1 * p ** m                       by arithmetic, b ** n = p ** m
3561      Hence q ** n * p ** d = 1             by EQ_MULT_RCANCEL, p ** m <> 0
3562        ==> (q ** n = 1) /\ (p ** d = 1)    by MULT_EQ_1
3563        But p ** d <> 1                     by EXP_EQ_1, 0 < d
3564       This contradicts p ** d = 1.
3565*)
3566Theorem power_eq_prime_power:
3567  !p. prime p ==>
3568      !b n m. 0 < m /\ (b ** n = p ** m) ==> ?k. (b = p ** k) /\ (k * n = m)
3569Proof
3570  rpt strip_tac >>
3571  `1 < p` by rw[ONE_LT_PRIME] >>
3572  `m <> 0 /\ 0 < p /\ p <> 0 /\ p <> 1` by decide_tac >>
3573  `p ** m <> 0` by rw[EXP_EQ_0] >>
3574  `p ** m <> 1` by rw[EXP_EQ_1] >>
3575  `n <> 0` by metis_tac[EXP] >>
3576  `0 < n /\ 0 < p ** m` by decide_tac >>
3577  `b <> 0` by metis_tac[EXP_EQ_0] >>
3578  `0 < b` by decide_tac >>
3579  `p divides (p ** m)` by rw[prime_divides_self_power] >>
3580  `p divides b` by metis_tac[prime_divides_power] >>
3581  `?u. p ** u divides b /\ ~(p divides b DIV p ** u)` by metis_tac[FACTOR_OUT_POWER] >>
3582  qabbrev_tac `q = b DIV p ** u` >>
3583  `p ** u <> 0` by rw[EXP_EQ_0] >>
3584  `0 < p ** u` by decide_tac >>
3585  `b = q * p ** u` by rw[GSYM DIVIDES_EQN, Abbr`q`] >>
3586  `q ** n * p ** (u * n) = p ** m` by metis_tac[EXP_BASE_MULT, EXP_EXP_MULT] >>
3587  qabbrev_tac `v = u * n` >>
3588  Cases_on `v = m` >| [
3589    `p ** m = 1 * p ** m` by simp[] >>
3590    `q ** n = 1` by metis_tac[EQ_MULT_RCANCEL] >>
3591    `q = 1` by metis_tac[EXP_EQ_1] >>
3592    `b = p ** u` by simp[] >>
3593    metis_tac[],
3594    Cases_on `v < m` >| [
3595      `?d. d = m - v` by rw[] >>
3596      `0 < d /\ (m = d + v)` by rw[] >>
3597      `p ** m = p ** d * p ** v` by rw[EXP_ADD] >>
3598      `p ** v <> 0` by metis_tac[EXP_EQ_0] >>
3599      `q ** n = p ** d` by metis_tac[EQ_MULT_RCANCEL] >>
3600      `p divides p ** d` by metis_tac[prime_divides_self_power] >>
3601      metis_tac[prime_divides_power],
3602      `m < v` by decide_tac >>
3603      `?d. d = v - m` by rw[] >>
3604      `0 < d /\ (v = d + m)` by rw[] >>
3605      `d <> 0` by decide_tac >>
3606      `q ** n * p ** d * p ** m = p ** m` by metis_tac[EXP_ADD, MULT_ASSOC] >>
3607      `_ = 1 * p ** m` by rw[] >>
3608      `q ** n * p ** d = 1` by metis_tac[EQ_MULT_RCANCEL] >>
3609      `(q ** n = 1) /\ (p ** d = 1)` by metis_tac[MULT_EQ_1] >>
3610      metis_tac[EXP_EQ_1]
3611    ]
3612  ]
3613QED
3614
3615(* Theorem: 1 < n ==> !m. (n ** m = n) <=> (m = 1) *)
3616(* Proof:
3617   If part: n ** m = n ==> m = 1
3618      Note n = n ** 1           by EXP_1
3619        so n ** m = n ** 1      by given
3620        or      m = 1           by EXP_BASE_INJECTIVE, 1 < n
3621   Only-if part: m = 1 ==> n ** m = n
3622      This is true              by EXP_1
3623*)
3624Theorem POWER_EQ_SELF:
3625    !n. 1 < n ==> !m. (n ** m = n) <=> (m = 1)
3626Proof
3627  metis_tac[EXP_BASE_INJECTIVE, EXP_1]
3628QED
3629
3630(* Theorem: k < HALF n <=> k + 1 < n - k *)
3631(* Proof:
3632   If part: k < HALF n ==> k + 1 < n - k
3633      Claim: 1 < n - 2 * k.
3634      Proof: If EVEN n,
3635                Claim: n - 2 * k <> 0
3636                Proof: By contradiction, assume n - 2 * k = 0.
3637                       Then 2 * k = n = 2 * HALF n      by EVEN_HALF
3638                         or     k = HALF n              by MULT_LEFT_CANCEL, 2 <> 0
3639                         but this contradicts k < HALF n.
3640                Claim: n - 2 * k <> 1
3641                Proof: By contradiction, assume n - 2 * k = 1.
3642                       Then n = 2 * k + 1               by SUB_EQ_ADD, 0 < 1
3643                         or ODD n                       by ODD_EXISTS, ADD1
3644                        but this contradicts EVEN n     by EVEN_ODD
3645                Thus n - 2 * k <> 1, or 1 < n - 2 * k   by above claims.
3646      Since 1 < n - 2 * k         by above
3647         so 2 * k + 1 < n         by arithmetic
3648         or k + k + 1 < n         by TIMES2
3649         or     k + 1 < n - k     by arithmetic
3650
3651   Only-if part: k + 1 < n - k ==> k < HALF n
3652      Since     k + 1 < n - k
3653         so 2 * k + 1 < n                by arithmetic
3654        But n = 2 * HALF n + (n MOD 2)   by DIVISION, MULT_COMM, 0 < 2
3655        and n MOD 2 < 2                  by MOD_LESS, 0 < 2
3656         so n <= 2 * HALF n + 1          by arithmetic
3657       Thus 2 * k + 1 < 2 * HALF n + 1   by LESS_LESS_EQ_TRANS
3658         or         k < HALF             by LT_MULT_LCANCEL
3659*)
3660Theorem LESS_HALF_IFF:
3661    !n k. k < HALF n <=> k + 1 < n - k
3662Proof
3663  rw[EQ_IMP_THM] >| [
3664    `1 < n - 2 * k` by
3665  (Cases_on `EVEN n` >| [
3666      `n - 2 * k <> 0` by
3667  (spose_not_then strip_assume_tac >>
3668      `2 * HALF n = n` by metis_tac[EVEN_HALF] >>
3669      decide_tac) >>
3670      `n - 2 * k <> 1` by
3671    (spose_not_then strip_assume_tac >>
3672      `n = 2 * k + 1` by decide_tac >>
3673      `ODD n` by metis_tac[ODD_EXISTS, ADD1] >>
3674      metis_tac[EVEN_ODD]) >>
3675      decide_tac,
3676      `n MOD 2 = 1` by metis_tac[EVEN_ODD, ODD_MOD2] >>
3677      `n = 2 * HALF n + (n MOD 2)` by metis_tac[DIVISION, MULT_COMM, DECIDE``0 < 2``] >>
3678      decide_tac
3679    ]) >>
3680    decide_tac,
3681    `2 * k + 1 < n` by decide_tac >>
3682    `n = 2 * HALF n + (n MOD 2)` by metis_tac[DIVISION, MULT_COMM, DECIDE``0 < 2``] >>
3683    `n MOD 2 < 2` by rw[] >>
3684    decide_tac
3685  ]
3686QED
3687
3688(* Theorem: HALF n < k ==> n - k <= HALF n *)
3689(* Proof:
3690   If k < n,
3691      If EVEN n,
3692         Note HALF n + HALF n < k + HALF n   by HALF n < k
3693           or      2 * HALF n < k + HALF n   by TIMES2
3694           or               n < k + HALF n   by EVEN_HALF, EVEN n
3695           or           n - k < HALF n       by LESS_EQ_SUB_LESS, k <= n
3696         Hence true.
3697      If ~EVEN n, then ODD n                 by EVEN_ODD
3698         Note HALF n + HALF n + 1 < k + HALF n + 1   by HALF n < k
3699           or      2 * HALF n + 1 < k + HALF n + 1   by TIMES2
3700           or         n < k + HALF n + 1     by ODD_HALF
3701           or         n <= k + HALF n        by arithmetic
3702           so     n - k <= HALF n            by SUB_LESS_EQ_ADD, k <= n
3703   If ~(k < n), then n <= k.
3704      Thus n - k = 0, hence n - k <= HALF n  by arithmetic
3705*)
3706Theorem MORE_HALF_IMP:
3707    !n k. HALF n < k ==> n - k <= HALF n
3708Proof
3709  rpt strip_tac >>
3710  Cases_on `k < n` >| [
3711    Cases_on `EVEN n` >| [
3712      `n = 2 * HALF n` by rw[EVEN_HALF] >>
3713      `n < k + HALF n` by decide_tac >>
3714      `n - k < HALF n` by decide_tac >>
3715      decide_tac,
3716      `ODD n` by rw[ODD_EVEN] >>
3717      `n = 2 * HALF n + 1` by rw[ODD_HALF] >>
3718      decide_tac
3719    ],
3720    decide_tac
3721  ]
3722QED
3723
3724(* Theorem: (!k. k < m ==> f k < f (k + 1)) ==> !k. k < m ==> f k < f m *)
3725(* Proof:
3726   By induction on the difference (m - k):
3727   Base: 0 = m - k /\ k < m ==> f k < f m
3728      Note m = k and k < m contradicts, hence true.
3729   Step: !m k. (v = m - k) ==> k < m ==> f k < f m ==>
3730         SUC v = m - k /\ k < m ==> f k < f m
3731      Note v + 1 = m - k        by ADD1
3732        so v = m - (k + 1)      by arithmetic
3733      If v = 0,
3734         Then m = k + 1
3735           so f k < f (k + 1)   by implication
3736           or f k < f m         by m = k + 1
3737      If v <> 0, then 0 < v.
3738         Then 0 < m - (k + 1)   by v = m - (k + 1)
3739           or k + 1 < m         by arithmetic
3740          Now f k < f (k + 1)   by implication, k < m
3741          and f (k + 1) < f m   by induction hypothesis, put k = k + 1
3742           so f k < f m         by LESS_TRANS
3743*)
3744Theorem MONOTONE_MAX:
3745    !f m. (!k. k < m ==> f k < f (k + 1)) ==> !k. k < m ==> f k < f m
3746Proof
3747  rpt strip_tac >>
3748  Induct_on `m - k` >| [
3749    rpt strip_tac >>
3750    decide_tac,
3751    rpt strip_tac >>
3752    `v + 1 = m - k` by rw[] >>
3753    `v = m - (k + 1)` by decide_tac >>
3754    Cases_on `v = 0` >| [
3755      `m = k + 1` by decide_tac >>
3756      rw[],
3757      `k + 1 < m` by decide_tac >>
3758      `f k < f (k + 1)` by rw[] >>
3759      `f (k + 1) < f m` by rw[] >>
3760      decide_tac
3761    ]
3762  ]
3763QED
3764
3765(* Theorem: (multiple gap)
3766   If n divides m, n cannot divide any x: m - n < x < m, or m < x < m + n
3767   n divides m ==> !x. m - n < x /\ x < m + n /\ n divides x ==> (x = m) *)
3768(* Proof:
3769   All these x, when divided by n, have non-zero remainders.
3770   Since n divides m and n divides x
3771     ==> ?h. m = h * n, and ?k. x = k * n  by divides_def
3772   Hence m - n < x
3773     ==> (h-1) * n < k * n                 by RIGHT_SUB_DISTRIB, MULT_LEFT_1
3774     and x < m + n
3775     ==>     k * n < (h+1) * n             by RIGHT_ADD_DISTRIB, MULT_LEFT_1
3776      so 0 < n, and h-1 < k, and k < h+1   by LT_MULT_RCANCEL
3777     that is, h <= k, and k <= h
3778   Therefore  h = k, or m = h * n = k * n = x.
3779*)
3780Theorem MULTIPLE_INTERVAL:
3781    !n m. n divides m ==> !x. m - n < x /\ x < m + n /\ n divides x ==> (x = m)
3782Proof
3783  rpt strip_tac >>
3784  `(?h. m = h*n) /\ (?k. x = k * n)` by metis_tac[divides_def] >>
3785  `(h-1) * n < k * n` by metis_tac[RIGHT_SUB_DISTRIB, MULT_LEFT_1] >>
3786  `k * n < (h+1) * n` by metis_tac[RIGHT_ADD_DISTRIB, MULT_LEFT_1] >>
3787  `0 < n /\ h-1 < k /\ k < h+1` by metis_tac[LT_MULT_RCANCEL] >>
3788  `h = k` by decide_tac >>
3789  metis_tac[]
3790QED
3791
3792(* Theorem: 0 < m ==> (SUC (n MOD m) = SUC n MOD m + (SUC n DIV m - n DIV m) * m) *)
3793(* Proof:
3794   Let x = n DIV m, y = (SUC n) DIV m.
3795   Let a = SUC (n MOD m), b = (SUC n) MOD m.
3796   Note SUC n = y * m + b                 by DIVISION, 0 < m, for (SUC n), [1]
3797    and     n = x * m + (n MOD m)         by DIVISION, 0 < m, for n
3798     so SUC n = SUC (x * m + (n MOD m))   by above
3799              = x * m + a                 by ADD_SUC, [2]
3800   Equating, x * m + a = y * m + b        by [1], [2]
3801   Now n < SUC n                          by SUC_POS
3802    so n DIV m <= (SUC n) DIV m           by DIV_LE_MONOTONE, n <= SUC n
3803    or       x <= y
3804    so   x * m <= y * m                   by LE_MULT_RCANCEL, m <> 0
3805
3806   Thus a = b + (y * m - x * m)           by arithmetic
3807          = b + (y - x) * m               by RIGHT_SUB_DISTRIB
3808*)
3809Theorem MOD_SUC_EQN:
3810    !m n. 0 < m ==> (SUC (n MOD m) = SUC n MOD m + (SUC n DIV m - n DIV m) * m)
3811Proof
3812  rpt strip_tac >>
3813  qabbrev_tac `x = n DIV m` >>
3814  qabbrev_tac `y = (SUC n) DIV m` >>
3815  qabbrev_tac `a = SUC (n MOD m)` >>
3816  qabbrev_tac `b = (SUC n) MOD m` >>
3817  `SUC n = y * m + b` by rw[DIVISION, Abbr`y`, Abbr`b`] >>
3818  `n = x * m + (n MOD m)` by rw[DIVISION, Abbr`x`] >>
3819  `SUC n = x * m + a` by rw[Abbr`a`] >>
3820  `n < SUC n` by rw[] >>
3821  `x <= y` by rw[DIV_LE_MONOTONE, Abbr`x`, Abbr`y`] >>
3822  `x * m <= y * m` by rw[] >>
3823  `a = b + (y * m - x * m)` by decide_tac >>
3824  `_ = b + (y - x) * m` by rw[] >>
3825  rw[]
3826QED
3827
3828(* Note: Compare this result with these in arithmeticTheory:
3829MOD_SUC      |- 0 < y /\ SUC x <> SUC (x DIV y) * y ==> (SUC x MOD y = SUC (x MOD y))
3830MOD_SUC_IFF  |- 0 < y ==> ((SUC x MOD y = SUC (x MOD y)) <=> SUC x <> SUC (x DIV y) * y)
3831*)
3832
3833(* Theorem: 1 < n ==> 1 < HALF (n ** 2) *)
3834(* Proof:
3835       1 < n
3836   ==> 2 <= n                            by arithmetic
3837   ==> 2 ** 2 <= n ** 2                  by EXP_EXP_LE_MONO
3838   ==> (2 ** 2) DIV 2 <= (n ** 2) DIV 2  by DIV_LE_MONOTONE
3839   ==> 2 <= (n ** 2) DIV 2               by arithmetic
3840   ==> 1 < (n ** 2) DIV 2                by arithmetic
3841*)
3842Theorem ONE_LT_HALF_SQ:
3843    !n. 1 < n ==> 1 < HALF (n ** 2)
3844Proof
3845  rpt strip_tac >>
3846  `2 <= n` by decide_tac >>
3847  `2 ** 2 <= n ** 2` by rw[] >>
3848  `(2 ** 2) DIV 2 <= (n ** 2) DIV 2` by rw[DIV_LE_MONOTONE] >>
3849  `(2 ** 2) DIV 2 = 2` by EVAL_TAC >>
3850  decide_tac
3851QED
3852
3853(* Theorem: 0 < n ==> (HALF (2 ** n) = 2 ** (n - 1)) *)
3854(* Proof
3855   By induction on n.
3856   Base: 0 < 0 ==> 2 ** 0 DIV 2 = 2 ** (0 - 1)
3857      This is trivially true as 0 < 0 = F.
3858   Step:  0 < n ==> HALF (2 ** n) = 2 ** (n - 1)
3859      ==> 0 < SUC n ==> HALF (2 ** SUC n) = 2 ** (SUC n - 1)
3860        HALF (2 ** SUC n)
3861      = HALF (2 * 2 ** n)          by EXP
3862      = 2 ** n                     by MULT_TO_DIV
3863      = 2 ** (SUC n - 1)           by SUC_SUB1
3864*)
3865Theorem EXP_2_HALF:
3866  !n. 0 < n ==> (HALF (2 ** n) = 2 ** (n - 1))
3867Proof
3868  Induct >> simp[EXP, MULT_TO_DIV]
3869QED
3870
3871(*
3872There is EVEN_MULT    |- !m n. EVEN (m * n) <=> EVEN m \/ EVEN n
3873There is EVEN_DOUBLE  |- !n. EVEN (TWICE n)
3874*)
3875
3876(* Theorem: EVEN n ==> (HALF (m * n) = m * HALF n) *)
3877(* Proof:
3878   Note n = TWICE (HALF n)  by EVEN_HALF
3879   Let k = HALF n.
3880     HALF (m * n)
3881   = HALF (m * (2 * k))  by above
3882   = HALF (2 * (m * k))  by MULT_COMM_ASSOC
3883   = m * k               by HALF_TWICE
3884   = m * HALF n          by notation
3885*)
3886Theorem HALF_MULT_EVEN:
3887    !m n. EVEN n ==> (HALF (m * n) = m * HALF n)
3888Proof
3889  metis_tac[EVEN_HALF, MULT_COMM_ASSOC, HALF_TWICE]
3890QED
3891
3892(* Theorem: 0 < k /\ k * m < n ==> m < n *)
3893(* Proof:
3894   Note ?h. k = SUC h     by num_CASES, k <> 0
3895        k * m
3896      = SUC h * m         by above
3897      = (h + 1) * m       by ADD1
3898      = h * m + 1 * m     by LEFT_ADD_DISTRIB
3899      = h * m + m         by MULT_LEFT_1
3900   Since 0 <= h * m,
3901      so k * m < n ==> m < n.
3902*)
3903Theorem MULT_LT_IMP_LT:
3904    !m n k. 0 < k /\ k * m < n ==> m < n
3905Proof
3906  rpt strip_tac >>
3907  `k <> 0` by decide_tac >>
3908  `?h. k = SUC h` by metis_tac[num_CASES] >>
3909  `k * m = h * m + m` by rw[ADD1] >>
3910  decide_tac
3911QED
3912
3913(* Theorem: 0 < k /\ k * m <= n ==> m <= n *)
3914(* Proof:
3915   Note     1 <= k                 by 0 < k
3916     so 1 * m <= k * m             by LE_MULT_RCANCEL
3917     or     m <= k * m <= n        by inequalities
3918*)
3919Theorem MULT_LE_IMP_LE:
3920  !m n k. 0 < k /\ k * m <= n ==> m <= n
3921Proof
3922  rpt strip_tac >>
3923  `1 <= k` by decide_tac >>
3924  `1 * m <= k * m` by simp[] >>
3925  decide_tac
3926QED
3927
3928(* Theorem: n * HALF ((SQ n) ** 2) <= HALF (n ** 5) *)
3929(* Proof:
3930      n * HALF ((SQ n) ** 2)
3931   <= HALF (n * (SQ n) ** 2)     by HALF_MULT
3932    = HALF (n * (n ** 2) ** 2)   by EXP_2
3933    = HALF (n * n ** 4)          by EXP_EXP_MULT
3934    = HALF (n ** 5)              by EXP
3935*)
3936Theorem HALF_EXP_5:
3937    !n. n * HALF ((SQ n) ** 2) <= HALF (n ** 5)
3938Proof
3939  rpt strip_tac >>
3940  `n * ((SQ n) ** 2) = n * n ** 4` by rw[EXP_2, EXP_EXP_MULT] >>
3941  `_ = n ** 5` by rw[EXP] >>
3942  metis_tac[HALF_MULT]
3943QED
3944
3945(* Theorem: n <= 2 * m <=> (n <> 0 ==> HALF (n - 1) < m) *)
3946(* Proof:
3947   Let k = n - 1, then n = SUC k.
3948   If part: n <= TWICE m /\ n <> 0 ==> HALF k < m
3949      Note HALF (SUC k) <= m                by DIV_LE_MONOTONE, HALF_TWICE
3950      If EVEN n,
3951         Then ODD k                         by EVEN_ODD_SUC
3952          ==> HALF (SUC k) = SUC (HALF k)   by ODD_SUC_HALF
3953         Thus SUC (HALF k) <= m             by above
3954           or        HALF k < m             by LESS_EQ
3955      If ~EVEN n, then ODD n                by EVEN_ODD
3956         Thus EVEN k                        by EVEN_ODD_SUC
3957          ==> HALF (SUC k) = HALF k         by EVEN_SUC_HALF
3958          But k <> TWICE m                  by k = n - 1, n <= TWICE m
3959          ==> HALF k <> m                   by EVEN_HALF
3960         Thus  HALF k < m                   by HALF k <= m, HALF k <> m
3961
3962   Only-if part: n <> 0 ==> HALF k < m ==> n <= TWICE m
3963      If n = 0, trivially true.
3964      If n <> 0, has HALF k < m.
3965         If EVEN n,
3966            Then ODD k                        by EVEN_ODD_SUC
3967             ==> HALF (SUC k) = SUC (HALF k)  by ODD_SUC_HALF
3968             But SUC (HALF k) <= m            by HALF k < m
3969            Thus HALF n <= m                  by n = SUC k
3970             ==> TWICE (HALF n) <= TWICE m    by LE_MULT_LCANCEL
3971              or              n <= TWICE m    by EVEN_HALF
3972         If ~EVEN n, then ODD n               by EVEN_ODD
3973            Then EVEN k                       by EVEN_ODD_SUC
3974             ==> TWICE (HALF k) < TWICE m     by LT_MULT_LCANCEL
3975              or              k < TWICE m     by EVEN_HALF
3976              or             n <= TWICE m     by n = k + 1
3977*)
3978Theorem LE_TWICE_ALT:
3979    !m n. n <= 2 * m <=> (n <> 0 ==> HALF (n - 1) < m)
3980Proof
3981  rw[EQ_IMP_THM] >| [
3982    `n = SUC (n - 1)` by decide_tac >>
3983    qabbrev_tac `k = n - 1` >>
3984    `HALF (SUC k) <= m` by metis_tac[DIV_LE_MONOTONE, HALF_TWICE, DECIDE``0 < 2``] >>
3985    Cases_on `EVEN n` >| [
3986      `ODD k` by rw[EVEN_ODD_SUC] >>
3987      `HALF (SUC k) = SUC (HALF k)` by rw[ODD_SUC_HALF] >>
3988      decide_tac,
3989      `ODD n` by metis_tac[EVEN_ODD] >>
3990      `EVEN k` by rw[EVEN_ODD_SUC] >>
3991      `HALF (SUC k) = HALF k` by rw[EVEN_SUC_HALF] >>
3992      `k <> TWICE m` by rw[Abbr`k`] >>
3993      `HALF k <> m` by metis_tac[EVEN_HALF] >>
3994      decide_tac
3995    ],
3996    Cases_on `n = 0` >-
3997    rw[] >>
3998    `n = SUC (n - 1)` by decide_tac >>
3999    qabbrev_tac `k = n - 1` >>
4000    Cases_on `EVEN n` >| [
4001      `ODD k` by rw[EVEN_ODD_SUC] >>
4002      `HALF (SUC k) = SUC (HALF k)` by rw[ODD_SUC_HALF] >>
4003      `HALF n <= m` by rw[] >>
4004      metis_tac[LE_MULT_LCANCEL, EVEN_HALF, DECIDE``2 <> 0``],
4005      `ODD n` by metis_tac[EVEN_ODD] >>
4006      `EVEN k` by rw[EVEN_ODD_SUC] >>
4007      `k < TWICE m` by metis_tac[LT_MULT_LCANCEL, EVEN_HALF, DECIDE``0 < 2``] >>
4008      rw[Abbr`k`]
4009    ]
4010  ]
4011QED
4012
4013(* Theorem: (HALF n) DIV 2 ** m = n DIV (2 ** SUC m) *)
4014(* Proof:
4015     (HALF n) DIV 2 ** m
4016   = (n DIV 2) DIV (2 ** m)    by notation
4017   = n DIV (2 * 2 ** m)        by DIV_DIV_DIV_MULT, 0 < 2, 0 < 2 ** m
4018   = n DIV (2 ** (SUC m))      by EXP
4019*)
4020Theorem HALF_DIV_TWO_POWER:
4021    !m n. (HALF n) DIV 2 ** m = n DIV (2 ** SUC m)
4022Proof
4023  rw[DIV_DIV_DIV_MULT, EXP]
4024QED
4025
4026(* Theorem: 1 + 2 + 3 + 4 = 10 *)
4027(* Proof: by calculation. *)
4028Theorem fit_for_10:
4029  1 + 2 + 3 + 4 = 10
4030Proof
4031  decide_tac
4032QED
4033
4034(* Theorem: 1 * 2 + 3 * 4 + 5 * 6 + 7 * 8 = 100 *)
4035(* Proof: by calculation. *)
4036Theorem fit_for_100:
4037  1 * 2 + 3 * 4 + 5 * 6 + 7 * 8 = 100
4038Proof
4039  decide_tac
4040QED
4041
4042(* ------------------------------------------------------------------------- *)
4043
4044(* Theorem: If prime p divides n, ?m. 0 < m /\ (p ** m) divides n /\ n DIV (p ** m) has no p *)
4045(* Proof:
4046   Let s = {j | (p ** j) divides n }
4047   Since p ** 1 = p, 1 IN s, so s <> {}.
4048       (p ** j) divides n
4049   ==> p ** j <= n                  by DIVIDES_LE
4050   ==> p ** j <= p ** z             by EXP_ALWAYS_BIG_ENOUGH
4051   ==>      j <= z                  by EXP_BASE_LE_MONO
4052   ==> s SUBSET count (SUC z),
4053   so FINITE s                      by FINITE_COUNT, SUBSET_FINITE
4054   Let m = MAX_SET s,
4055   m IN s, so (p ** m) divides n    by MAX_SET_DEF
4056   1 <= m, or 0 < m.
4057   ?q. n = q * (p ** m)             by divides_def
4058   To prove: !k. gcd (p ** k) (n DIV (p ** m)) = 1
4059   By contradiction, suppose there is a k such that
4060   gcd (p ** k) (n DIV (p ** m)) <> 1
4061   So there is a prime pp that divides this gcd, by PRIME_FACTOR
4062   but pp | p ** k, a pure prime, so pp = p      by DIVIDES_EXP_BASE, prime_divides_only_self
4063       pp | n DIV (p ** m)
4064   or  pp * p ** m | n
4065       p * SUC m | n, making m not MAX_SET s.
4066*)
4067Theorem FACTOR_OUT_PRIME:
4068    !n p. 0 < n /\ prime p /\ p divides n ==> ?m. 0 < m /\ (p ** m) divides n /\ !k. gcd (p ** k) (n DIV (p ** m)) = 1
4069Proof
4070  rpt strip_tac >>
4071  qabbrev_tac `s = {j | (p ** j) divides n }` >>
4072  `!j. j IN s <=> (p ** j) divides n` by rw[Abbr`s`] >>
4073  `p ** 1 = p` by rw[] >>
4074  `1 IN s` by metis_tac[] >>
4075  `1 < p` by rw[ONE_LT_PRIME] >>
4076  `?z. n <= p ** z` by rw[EXP_ALWAYS_BIG_ENOUGH] >>
4077  `!j. j IN s ==> p ** j <= n` by metis_tac[DIVIDES_LE] >>
4078  `!j. j IN s ==> p ** j <= p ** z` by metis_tac[LESS_EQ_TRANS] >>
4079  `!j. j IN s ==> j <= z` by metis_tac[EXP_BASE_LE_MONO] >>
4080  `!j. j <= z <=> j < SUC z` by decide_tac >>
4081  `!j. j < SUC z <=> j IN count (SUC z)` by rw[] >>
4082  `s SUBSET count (SUC z)` by metis_tac[SUBSET_DEF] >>
4083  `FINITE s` by metis_tac[FINITE_COUNT, SUBSET_FINITE] >>
4084  `s <> {}` by metis_tac[MEMBER_NOT_EMPTY] >>
4085  qabbrev_tac `m = MAX_SET s` >>
4086  `m IN s /\ !y. y IN s ==> y <= m`by rw[MAX_SET_DEF, Abbr`m`] >>
4087  qexists_tac `m` >>
4088  CONJ_ASM1_TAC >| [
4089    `1 <= m` by metis_tac[] >>
4090    decide_tac,
4091    CONJ_ASM1_TAC >-
4092    metis_tac[] >>
4093    qabbrev_tac `pm = p ** m` >>
4094    `0 < p` by decide_tac >>
4095    `0 < pm` by rw[ZERO_LT_EXP, Abbr`pm`] >>
4096    `n MOD pm = 0` by metis_tac[DIVIDES_MOD_0] >>
4097    `n = n DIV pm * pm` by metis_tac[DIVISION, ADD_0] >>
4098    qabbrev_tac `qm = n DIV pm` >>
4099    spose_not_then strip_assume_tac >>
4100    `?q. prime q /\ q divides (gcd (p ** k) qm)` by rw[PRIME_FACTOR] >>
4101    `0 <> pm /\ n <> 0` by decide_tac >>
4102    `qm <> 0` by metis_tac[MULT] >>
4103    `0 < qm` by decide_tac >>
4104    qabbrev_tac `pk = p ** k` >>
4105    `0 < pk` by rw[ZERO_LT_EXP, Abbr`pk`] >>
4106    `(gcd pk qm) divides pk /\ (gcd pk qm) divides qm` by metis_tac[GCD_DIVIDES, DIVIDES_MOD_0] >>
4107    `q divides pk /\ q divides qm` by metis_tac[DIVIDES_TRANS] >>
4108    `k <> 0` by metis_tac[EXP, GCD_1] >>
4109    `0 < k` by decide_tac >>
4110    `q divides p` by metis_tac[DIVIDES_EXP_BASE] >>
4111    `q = p` by rw[prime_divides_only_self] >>
4112    `?x. qm = x * q` by rw[GSYM divides_def] >>
4113    `n = x * p * pm` by metis_tac[] >>
4114    `_ = x * (p * pm)` by rw_tac arith_ss[] >>
4115    `_ = x * (p ** SUC m)` by rw[EXP, Abbr`pm`] >>
4116    `(p ** SUC m) divides n` by metis_tac[divides_def] >>
4117    `SUC m <= m` by metis_tac[] >>
4118    decide_tac
4119  ]
4120QED
4121
4122(* Theorem: For 1 < n /\ 0 < x /\ x < n /\ coprime n x ==>
4123            ?y. 0 < y /\ y < n /\ coprime n y /\ ((y * x) MOD n = 1) *)
4124(* Proof:
4125       gcd n x = 1
4126   ==> ?k. (k * x) MOD n = 1 /\ coprime n k   by GCD_ONE_PROPERTY
4127       (k * x) MOD n = 1
4128   ==> (k MOD n * x MOD n) MOD n = 1          by MOD_TIMES2
4129   ==> ((k MOD n) * x) MOD n = 1              by LESS_MOD, x < n.
4130
4131   Now   k MOD n < n                          by MOD_LESS
4132   and   0 < k MOD n                          by MOD_MULTIPLE_ZERO and 1 <> 0.
4133
4134   Hence take y = k MOD n, then 0 < y < n.
4135   and gcd n k = 1 ==> gcd n (k MOD n) = 1    by MOD_WITH_GCD_ONE.
4136*)
4137Theorem GCD_MOD_MULT_INV:
4138    !n x. 1 < n /\ 0 < x /\ x < n /\ coprime n x ==>
4139      ?y. 0 < y /\ y < n /\ coprime n y /\ ((y * x) MOD n = 1)
4140Proof
4141  rpt strip_tac >>
4142  `?k. ((k * x) MOD n = 1) /\ coprime n k` by rw_tac std_ss[GCD_ONE_PROPERTY] >>
4143  `0 < n` by decide_tac >>
4144  `((k MOD n) * (x MOD n)) MOD n = 1` by rw_tac std_ss[MOD_TIMES2] >>
4145  `((k MOD n) * x) MOD n = 1` by metis_tac[LESS_MOD] >>
4146  `k MOD n < n` by rw_tac std_ss[MOD_LESS] >>
4147  `1 <> 0` by decide_tac >>
4148  `0 <> k MOD n` by metis_tac[MOD_MULTIPLE_ZERO] >>
4149  `0 < k MOD n` by decide_tac >>
4150  metis_tac[MOD_WITH_GCD_ONE]
4151QED
4152
4153(* Convert this into an existence definition *)
4154Theorem lemma[local]:
4155    !n x. ?y. 1 < n /\ 0 < x /\ x < n /\ coprime n x ==>
4156              0 < y /\ y < n /\ coprime n y /\ ((y * x) MOD n = 1)
4157Proof
4158  metis_tac[GCD_MOD_MULT_INV]
4159QED
4160
4161val GEN_MULT_INV_DEF = new_specification(
4162  "GEN_MULT_INV_DEF",
4163  ["GCD_MOD_MUL_INV"],
4164  SIMP_RULE (srw_ss()) [SKOLEM_THM] lemma);
4165(* > val GEN_MULT_INV_DEF =
4166    |- !n x. 1 < n /\ 0 < x /\ x < n /\ coprime n x ==>
4167       0 < GCD_MOD_MUL_INV n x /\ GCD_MOD_MUL_INV n x < n /\ coprime n (GCD_MOD_MUL_INV n x) /\
4168       ((GCD_MOD_MUL_INV n x * x) MOD n = 1) : thm *)
4169
4170(* Theorem: If 1/c = 1/b - 1/a, then lcm a b = lcm a c.
4171            a * b = c * (a - b) ==> lcm a b = lcm a c *)
4172(* Proof:
4173   Idea:
4174     lcm a c
4175   = (a * c) DIV (gcd a c)              by lcm_def
4176   = (a * b * c) DIV (gcd a c) DIV b    by MULT_DIV
4177   = (a * b * c) DIV b * (gcd a c)      by DIV_DIV_DIV_MULT
4178   = (a * b * c) DIV gcd b*a b*c        by GCD_COMMON_FACTOR
4179   = (a * b * c) DIV gcd c*(a-b) c*b    by given
4180   = (a * b * c) DIV c * gcd (a-b) b    by GCD_COMMON_FACTOR
4181   = (a * b * c) DIV c * gcd a b        by GCD_SUB_L
4182   = (a * b * c) DIV c DIV gcd a b      by DIV_DIV_DIV_MULT
4183   = a * b DIV gcd a b                  by MULT_DIV
4184   = lcm a b                            by lcm_def
4185
4186   Details:
4187   If a = 0,
4188      lcm 0 b = 0 = lcm 0 c          by LCM_0
4189   If a <> 0,
4190      If b = 0, a * b = 0 = c * a    by MULT_0, SUB_0
4191      Hence c = 0, hence true        by MULT_EQ_0
4192      If b <> 0, c <> 0.             by MULT_EQ_0
4193      So 0 < gcd a c, 0 < gcd a b    by GCD_EQ_0
4194      and  (gcd a c) divides a       by GCD_IS_GREATEST_COMMON_DIVISOR
4195      thus (gcd a c) divides (a * c) by DIVIDES_MULT
4196      Note (a - b) <> 0              by MULT_EQ_0
4197       so  ~(a <= b)                 by SUB_EQ_0
4198       or  b < a, or b <= a          for GCD_SUB_L later.
4199   Now,
4200      lcm a c
4201    = (a * c) DIV (gcd a c)                      by lcm_def
4202    = (b * ((a * c) DIV (gcd a c))) DIV b        by MULT_COMM, MULT_DIV
4203    = ((b * (a * c)) DIV (gcd a c)) DIV b        by MULTIPLY_DIV
4204    = (b * (a * c)) DIV ((gcd a c) * b)          by DIV_DIV_DIV_MULT
4205    = (b * a * c) DIV ((gcd a c) * b)            by MULT_ASSOC
4206    = c * (a * b) DIV (b * (gcd a c))            by MULT_COMM
4207    = c * (a * b) DIV (gcd (b * a) (b * c))      by GCD_COMMON_FACTOR
4208    = c * (a * b) DIV (gcd (a * b) (c * b))      by MULT_COMM
4209    = c * (a * b) DIV (gcd (c * (a-b)) (c * b))  by a * b = c * (a - b)
4210    = c * (a * b) DIV (c * gcd (a-b) b)          by GCD_COMMON_FACTOR
4211    = c * (a * b) DIV (c * gcd a b)              by GCD_SUB_L
4212    = c * (a * b) DIV c DIV (gcd a b)            by DIV_DIV_DIV_MULT
4213    = a * b DIV gcd a b                          by MULT_COMM, MULT_DIV
4214    = lcm a b                                    by lcm_def
4215*)
4216Theorem LCM_EXCHANGE:
4217    !a b c. (a * b = c * (a - b)) ==> (lcm a b = lcm a c)
4218Proof
4219  rpt strip_tac >>
4220  Cases_on `a = 0` >-
4221  rw[] >>
4222  Cases_on `b = 0` >| [
4223    `c = 0` by metis_tac[MULT_EQ_0, SUB_0] >>
4224    rw[],
4225    `c <> 0` by metis_tac[MULT_EQ_0] >>
4226    `0 < b /\ 0 < c` by decide_tac >>
4227    `(gcd a c) divides a` by rw[GCD_IS_GREATEST_COMMON_DIVISOR] >>
4228    `(gcd a c) divides (a * c)` by rw[DIVIDES_MULT] >>
4229    `0 < gcd a c /\ 0 < gcd a b` by metis_tac[GCD_EQ_0, NOT_ZERO_LT_ZERO] >>
4230    `~(a <= b)` by metis_tac[SUB_EQ_0, MULT_EQ_0] >>
4231    `b <= a` by decide_tac >>
4232    `lcm a c = (a * c) DIV (gcd a c)` by rw[lcm_def] >>
4233    `_ = (b * ((a * c) DIV (gcd a c))) DIV b` by metis_tac[MULT_COMM, MULT_DIV] >>
4234    `_ = ((b * (a * c)) DIV (gcd a c)) DIV b` by rw[MULTIPLY_DIV] >>
4235    `_ = (b * (a * c)) DIV ((gcd a c) * b)` by rw[DIV_DIV_DIV_MULT] >>
4236    `_ = (b * a * c) DIV ((gcd a c) * b)` by rw[MULT_ASSOC] >>
4237    `_ = c * (a * b) DIV (b * (gcd a c))` by rw_tac std_ss[MULT_COMM] >>
4238    `_ = c * (a * b) DIV (gcd (b * a) (b * c))` by rw[GCD_COMMON_FACTOR] >>
4239    `_ = c * (a * b) DIV (gcd (a * b) (c * b))` by rw_tac std_ss[MULT_COMM] >>
4240    `_ = c * (a * b) DIV (gcd (c * (a-b)) (c * b))` by rw[] >>
4241    `_ = c * (a * b) DIV (c * gcd (a-b) b)` by rw[GCD_COMMON_FACTOR] >>
4242    `_ = c * (a * b) DIV (c * gcd a b)` by rw[GCD_SUB_L] >>
4243    `_ = c * (a * b) DIV c DIV (gcd a b)` by rw[DIV_DIV_DIV_MULT] >>
4244    `_ = a * b DIV gcd a b` by metis_tac[MULT_COMM, MULT_DIV] >>
4245    `_ = lcm a b` by rw[lcm_def] >>
4246    decide_tac
4247  ]
4248QED
4249
4250(* Theorem: k * a <= b ==> gcd a b = gcd a (b - k * a) *)
4251(* Proof:
4252   By induction on k.
4253   Base case: 0 * a <= b ==> gcd a b = gcd a (b - 0 * a)
4254     True since b - 0 * a = b       by MULT, SUB_0
4255   Step case: k * a <= b ==> (gcd a b = gcd a (b - k * a)) ==>
4256              SUC k * a <= b ==> (gcd a b = gcd a (b - SUC k * a))
4257         SUC k * a <= b
4258     ==> k * a + a <= b             by MULT
4259        so       a <= b - k * a     by arithmetic [1]
4260       and   k * a <= b             by 0 <= b - k * a, [2]
4261       gcd a (b - SUC k * a)
4262     = gcd a (b - (k * a + a))      by MULT
4263     = gcd a (b - k * a - a)        by arithmetic
4264     = gcd a (b - k * a - a + a)    by GCD_ADD_L, ADD_COMM
4265     = gcd a (b - k * a)            by SUB_ADD, a <= b - k * a [1]
4266     = gcd a b                      by induction hypothesis, k * a <= b [2]
4267*)
4268Theorem GCD_SUB_MULTIPLE:
4269    !a b k. k * a <= b ==> (gcd a b = gcd a (b - k * a))
4270Proof
4271  rpt strip_tac >>
4272  Induct_on `k` >-
4273  rw[] >>
4274  rw_tac std_ss[] >>
4275  `k * a + a <= b` by metis_tac[MULT] >>
4276  `a <= b - k * a` by decide_tac >>
4277  `k * a <= b` by decide_tac >>
4278  `gcd a (b - SUC k * a) = gcd a (b - (k * a + a))` by rw[MULT] >>
4279  `_ = gcd a (b - k * a - a)` by rw_tac arith_ss[] >>
4280  `_ = gcd a (b - k * a - a + a)` by rw[GCD_ADD_L, ADD_COMM] >>
4281  rw_tac std_ss[SUB_ADD]
4282QED
4283
4284(* Theorem: k * a <= b ==> (gcd b a = gcd a (b - k * a)) *)
4285(* Proof: by GCD_SUB_MULTIPLE, GCD_SYM *)
4286Theorem GCD_SUB_MULTIPLE_COMM:
4287    !a b k. k * a <= b ==> (gcd b a = gcd a (b - k * a))
4288Proof
4289  metis_tac[GCD_SUB_MULTIPLE, GCD_SYM]
4290QED
4291
4292(* Idea: a crude upper bound for greatest common divisor.
4293         A better upper bound is: gcd m n <= MIN m n, by MIN_LE *)
4294
4295(* Theorem: 0 < m /\ 0 < n ==> gcd m n <= m /\ gcd m n <= n *)
4296(* Proof:
4297   Let g = gcd m n.
4298   Then g divides m /\ g divides n   by GCD_PROPERTY
4299     so g <= m /\ g <= n             by DIVIDES_LE,  0 < m, 0 < n
4300*)
4301Theorem gcd_le:
4302  !m n. 0 < m /\ 0 < n ==> gcd m n <= m /\ gcd m n <= n
4303Proof
4304  ntac 3 strip_tac >>
4305  qabbrev_tac `g = gcd m n` >>
4306  `g divides m /\ g divides n` by metis_tac[GCD_PROPERTY] >>
4307  simp[DIVIDES_LE]
4308QED
4309
4310(* Idea: a generalisation of GCD_LINEAR:
4311|- !j k. 0 < j ==> ?p q. p * j = q * k + gcd j k
4312   This imposes a condition for (gcd a b) divides c.
4313*)
4314
4315(* Theorem: 0 < a ==> ((gcd a b) divides c <=> ?p q. p * a = q * b + c) *)
4316(* Proof:
4317   Let d = gcd a b.
4318   If part: d divides c ==> ?p q. p * a = q * b + c
4319      Note ?k. c = k * d                 by divides_def
4320       and ?u v. u * a = v * b + d       by GCD_LINEAR, 0 < a
4321        so (k * u) * a = (k * v) * b + (k * d)
4322      Take p = k * u, q = k * v,
4323      Then p * q = q * b + c
4324   Only-if part: p * a = q * b + c ==> d divides c
4325      Note d divides a /\ d divides b    by GCD_PROPERTY
4326        so d divides c                   by divides_linear_sub
4327*)
4328Theorem gcd_divides_iff:
4329  !a b c. 0 < a ==> ((gcd a b) divides c <=> ?p q. p * a = q * b + c)
4330Proof
4331  rpt strip_tac >>
4332  qabbrev_tac `d = gcd a b` >>
4333  rw_tac bool_ss[EQ_IMP_THM] >| [
4334    `?k. c = k * d` by rw[GSYM divides_def] >>
4335    `?p q. p * a = q * b + d` by rw[GCD_LINEAR, Abbr`d`] >>
4336    `k * (p * a) = k * (q * b + d)` by fs[] >>
4337    `_ = k * (q * b) + k * d` by decide_tac >>
4338    metis_tac[MULT_ASSOC],
4339    `d divides a /\ d divides b` by metis_tac[GCD_PROPERTY] >>
4340    metis_tac[divides_linear_sub]
4341  ]
4342QED
4343
4344(* Theorem alias *)
4345Theorem gcd_linear_thm = gcd_divides_iff;
4346(* val gcd_linear_thm =
4347|- !a b c. 0 < a ==> (gcd a b divides c <=> ?p q. p * a = q * b + c): thm *)
4348
4349(* Idea: a version of GCD_LINEAR for MOD, without negatives.
4350   That is: in MOD n. gcd (a b) can be expressed as a linear combination of a b. *)
4351
4352(* Theorem: 0 < n /\ 0 < a ==> ?p q. (p * a + q * b) MOD n = gcd a b MOD n *)
4353(* Proof:
4354   Let d = gcd a b.
4355   Then ?h k. h * a = k * b + d                by GCD_LINEAR, 0 < a
4356   Let p = h, q = k * n - k.
4357   Then q + k = k * n.
4358          (p * a) MOD n = (k * b + d) MOD n
4359   <=>    (p * a + q * b) MOD n = (q * b + k * b + d) MOD n    by ADD_MOD
4360   <=>    (p * a + q * b) MOD n = (k * b * n + d) MOD n        by above
4361   <=>    (p * a + q * b) MOD n = d MOD n                      by MOD_TIMES
4362*)
4363Theorem gcd_linear_mod_thm:
4364  !n a b. 0 < n /\ 0 < a ==> ?p q. (p * a + q * b) MOD n = gcd a b MOD n
4365Proof
4366  rpt strip_tac >>
4367  qabbrev_tac `d = gcd a b` >>
4368  `?p k. p * a = k * b + d` by rw[GCD_LINEAR, Abbr`d`] >>
4369  `k <= k * n` by fs[] >>
4370  `k * n - k + k = k * n` by decide_tac >>
4371  qabbrev_tac `q = k * n - k` >>
4372  qexists_tac `p` >>
4373  qexists_tac `q` >>
4374  `(p * a + q * b) MOD n = (q * b + k * b + d) MOD n` by rw[ADD_MOD] >>
4375  `_ = ((q + k) * b + d) MOD n` by decide_tac >>
4376  `_ = (k * b * n + d) MOD n` by rfs[] >>
4377  simp[MOD_TIMES]
4378QED
4379
4380(* Idea: a simplification of gcd_linear_mod_thm when n = a. *)
4381
4382(* Theorem: 0 < a ==> ?q. (q * b) MOD a = (gcd a b) MOD a *)
4383(* Proof:
4384   Let g = gcd a b.
4385   Then ?p q. (p * a + q * b) MOD a = g MOD a  by gcd_linear_mod_thm, n = a
4386     so               (q * b) MOD a = g MOD a  by MOD_TIMES
4387*)
4388Theorem gcd_linear_mod_1:
4389  !a b. 0 < a ==> ?q. (q * b) MOD a = (gcd a b) MOD a
4390Proof
4391  metis_tac[gcd_linear_mod_thm, MOD_TIMES]
4392QED
4393
4394(* Idea: symmetric version of of gcd_linear_mod_1. *)
4395
4396(* Theorem: 0 < b ==> ?p. (p * a) MOD b = (gcd a b) MOD b *)
4397(* Proof:
4398   Note ?p. (p * a) MOD b = (gcd b a) MOD b    by gcd_linear_mod_1
4399     or                   = (gcd a b) MOD b    by GCD_SYM
4400*)
4401Theorem gcd_linear_mod_2:
4402  !a b. 0 < b ==> ?p. (p * a) MOD b = (gcd a b) MOD b
4403Proof
4404  metis_tac[gcd_linear_mod_1, GCD_SYM]
4405QED
4406
4407(* Idea: replacing n = a * b in gcd_linear_mod_thm. *)
4408
4409(* Theorem: 0 < a /\ 0 < b ==> ?p q. (p * a + q * b) MOD (a * b) = (gcd a b) MOD (a * b) *)
4410(* Proof: by gcd_linear_mod_thm, n = a * b. *)
4411Theorem gcd_linear_mod_prod:
4412  !a b. 0 < a /\ 0 < b ==> ?p q. (p * a + q * b) MOD (a * b) = (gcd a b) MOD (a * b)
4413Proof
4414  simp[gcd_linear_mod_thm]
4415QED
4416
4417(* Idea: specialise gcd_linear_mod_prod for coprime a b. *)
4418
4419(* Theorem: 0 < a /\ 0 < b /\ coprime a b ==>
4420            ?p q. (p * a + q * b) MOD (a * b) = 1 MOD (a * b) *)
4421(* Proof: by gcd_linear_mod_prod. *)
4422Theorem coprime_linear_mod_prod:
4423  !a b. 0 < a /\ 0 < b /\ coprime a b ==>
4424  ?p q. (p * a + q * b) MOD (a * b) = 1 MOD (a * b)
4425Proof
4426  metis_tac[gcd_linear_mod_prod]
4427QED
4428
4429(* Idea: generalise gcd_linear_mod_thm for multiple of gcd a b. *)
4430
4431(* Theorem: 0 < n /\ 0 < a /\ gcd a b divides c ==>
4432            ?p q. (p * a + q * b) MOD n = c MOD n *)
4433(* Proof:
4434   Let d = gcd a b.
4435   Note k. c = k * d                           by divides_def
4436    and ?p q. (p * a + q * b) MOD n = d MOD n  by gcd_linear_mod_thm
4437   Thus (k * d) MOD n
4438      = (k * (p * a + q * b)) MOD n            by MOD_TIMES2, 0 < n
4439      = (k * p * a + k * q * b) MOD n          by LEFT_ADD_DISTRIB
4440   Take (k * p) and (k * q) for the eventual p and q.
4441*)
4442Theorem gcd_multiple_linear_mod_thm:
4443  !n a b c. 0 < n /\ 0 < a /\ gcd a b divides c ==>
4444            ?p q. (p * a + q * b) MOD n = c MOD n
4445Proof
4446  rpt strip_tac >>
4447  qabbrev_tac `d = gcd a b` >>
4448  `?k. c = k * d` by rw[GSYM divides_def] >>
4449  `?p q. (p * a + q * b) MOD n = d MOD n` by metis_tac[gcd_linear_mod_thm] >>
4450  `(k * (p * a + q * b)) MOD n = (k * d) MOD n` by metis_tac[MOD_TIMES2] >>
4451  `k * (p * a + q * b) = k * p * a + k * q * b` by decide_tac >>
4452  metis_tac[]
4453QED
4454
4455(* Idea: specialise gcd_multiple_linear_mod_thm for n = a * b. *)
4456
4457(* Theorem: 0 < a /\ 0 < b /\ gcd a b divides c ==>
4458            ?p q. (p * a + q * b) MOD (a * b) = c MOD (a * b)) *)
4459(* Proof: by gcd_multiple_linear_mod_thm. *)
4460Theorem gcd_multiple_linear_mod_prod:
4461  !a b c. 0 < a /\ 0 < b /\ gcd a b divides c ==>
4462          ?p q. (p * a + q * b) MOD (a * b) = c MOD (a * b)
4463Proof
4464  simp[gcd_multiple_linear_mod_thm]
4465QED
4466
4467(* Idea: specialise gcd_multiple_linear_mod_prod for coprime a b. *)
4468
4469(* Theorem: 0 < a /\ 0 < b /\ coprime a b ==>
4470            ?p q. (p * a + q * b) MOD (a * b) = c MOD (a * b) *)
4471(* Proof:
4472   Note coprime a b means gcd a b = 1    by notation
4473    and 1 divides c                      by ONE_DIVIDES_ALL
4474     so the result follows               by gcd_multiple_linear_mod_prod
4475*)
4476Theorem coprime_multiple_linear_mod_prod:
4477  !a b c. 0 < a /\ 0 < b /\ coprime a b ==>
4478          ?p q. (p * a + q * b) MOD (a * b) = c MOD (a * b)
4479Proof
4480  metis_tac[gcd_multiple_linear_mod_prod, ONE_DIVIDES_ALL]
4481QED
4482
4483(* ------------------------------------------------------------------------- *)
4484(* Coprime Theorems                                                          *)
4485(* ------------------------------------------------------------------------- *)
4486
4487(* Theorem: 0 < n ==> !a b. coprime a b <=> coprime a (b ** n) *)
4488(* Proof:
4489   If part: coprime a b ==> coprime a (b ** n)
4490      True by coprime_exp_comm.
4491   Only-if part: coprime a (b ** n) ==> coprime a b
4492      If a = 0,
4493         then b ** n = 1        by GCD_0L
4494          and b = 1             by EXP_EQ_1, n <> 0
4495         Hence coprime 0 1      by GCD_0L
4496      If a <> 0,
4497      Since coprime a (b ** n) means
4498            ?h k. h * a = k * b ** n + 1   by LINEAR_GCD, GCD_SYM
4499   Let d = gcd a b.
4500   Since d divides a and d divides b       by GCD_IS_GREATEST_COMMON_DIVISOR
4501     and d divides b ** n                  by divides_exp, 0 < n
4502      so d divides 1                       by divides_linear_sub
4503    Thus d = 1                             by DIVIDES_ONE
4504      or coprime a b                       by notation
4505*)
4506Theorem coprime_iff_coprime_exp:
4507    !n. 0 < n ==> !a b. coprime a b <=> coprime a (b ** n)
4508Proof
4509  rw[EQ_IMP_THM] >-
4510  rw[coprime_exp_comm] >>
4511  `n <> 0` by decide_tac >>
4512  Cases_on `a = 0` >-
4513  metis_tac[GCD_0L, EXP_EQ_1] >>
4514  `?h k. h * a = k * b ** n + 1` by metis_tac[LINEAR_GCD, GCD_SYM] >>
4515  qabbrev_tac `d = gcd a b` >>
4516  `d divides a /\ d divides b` by rw[GCD_IS_GREATEST_COMMON_DIVISOR, Abbr`d`] >>
4517  `d divides (b ** n)` by rw[divides_exp] >>
4518  `d divides 1` by metis_tac[divides_linear_sub] >>
4519  rw[GSYM DIVIDES_ONE]
4520QED
4521
4522(* Theorem: 1 < n /\ coprime n m ==> ~(n divides m) *)
4523(* Proof:
4524       coprime n m
4525   ==> gcd n m = 1       by notation
4526   ==> n MOD m <> 0      by MOD_NONZERO_WHEN_GCD_ONE, with 1 < n
4527   ==> ~(n divides m)    by DIVIDES_MOD_0, with 0 < n
4528*)
4529Theorem coprime_not_divides:
4530    !m n. 1 < n /\ coprime n m ==> ~(n divides m)
4531Proof
4532  metis_tac[MOD_NONZERO_WHEN_GCD_ONE, DIVIDES_MOD_0, ONE_LT_POS, NOT_ZERO_LT_ZERO]
4533QED
4534
4535(* Theorem: 1 < n ==> (!j. 0 < j /\ j <= m ==> coprime n j) ==> m < n *)
4536(* Proof:
4537   By contradiction. Suppose n <= m.
4538   Since 1 < n means 0 < n and n <> 1,
4539   The implication shows
4540       coprime n n, or n = 1   by notation
4541   But gcd n n = n             by GCD_REF
4542   This contradicts n <> 1.
4543*)
4544Theorem coprime_all_le_imp_lt:
4545    !n. 1 < n ==> !m. (!j. 0 < j /\ j <= m ==> coprime n j) ==> m < n
4546Proof
4547  spose_not_then strip_assume_tac >>
4548  `n <= m` by decide_tac >>
4549  `0 < n /\ n <> 1` by decide_tac >>
4550  metis_tac[GCD_REF]
4551QED
4552
4553(* Theorem: (!j. 1 < j /\ j <= m ==> ~(j divides n)) <=> (!j. 1 < j /\ j <= m ==> coprime j n) *)
4554(* Proof:
4555   If part: (!j. 1 < j /\ j <= m ==> ~(j divides n)) /\ 1 < j /\ j <= m ==> coprime j n
4556      Let d = gcd j n.
4557      Then d divides j /\ d divides n         by GCD_IS_GREATEST_COMMON_DIVISOR
4558       Now 1 < j ==> 0 < j /\ j <> 0
4559        so d <= j                             by DIVIDES_LE, 0 < j
4560       and d <> 0                             by GCD_EQ_0, j <> 0
4561      By contradiction, suppose d <> 1.
4562      Then 1 < d /\ d <= m                    by d <> 1, d <= j /\ j <= m
4563        so ~(d divides n), a contradiction    by implication
4564
4565   Only-if part: (!j. 1 < j /\ j <= m ==> coprime j n) /\ 1 < j /\ j <= m ==> ~(j divides n)
4566      Since coprime j n                       by implication
4567         so ~(j divides n)                    by coprime_not_divides
4568*)
4569Theorem coprime_condition:
4570    !m n. (!j. 1 < j /\ j <= m ==> ~(j divides n)) <=> (!j. 1 < j /\ j <= m ==> coprime j n)
4571Proof
4572  rw[EQ_IMP_THM] >| [
4573    spose_not_then strip_assume_tac >>
4574    qabbrev_tac `d = gcd j n` >>
4575    `d divides j /\ d divides n` by rw[GCD_IS_GREATEST_COMMON_DIVISOR, Abbr`d`] >>
4576    `0 < j /\ j <> 0` by decide_tac >>
4577    `d <= j` by rw[DIVIDES_LE] >>
4578    `d <> 0` by metis_tac[GCD_EQ_0] >>
4579    `1 < d /\ d <= m` by decide_tac >>
4580    metis_tac[],
4581    metis_tac[coprime_not_divides]
4582  ]
4583QED
4584
4585(* Note:
4586The above is the generalization of this observation:
4587- a prime n  has all 1 < j < n coprime to n. Therefore,
4588- a number n has all 1 < j < m coprime to n, where m is the first non-trivial factor of n.
4589  Of course, the first non-trivial factor of n must be a prime.
4590*)
4591
4592(* Theorem: 1 < m /\ (!j. 1 < j /\ j <= m ==> ~(j divides n)) ==> coprime m n *)
4593(* Proof: by coprime_condition, taking j = m. *)
4594Theorem coprime_by_le_not_divides:
4595    !m n. 1 < m /\ (!j. 1 < j /\ j <= m ==> ~(j divides n)) ==> coprime m n
4596Proof
4597  rw[coprime_condition]
4598QED
4599
4600(* Idea: establish coprime (p * a + q * b) (a * b). *)
4601(* Note: the key is to apply coprime_by_prime_factor. *)
4602
4603(* Theorem: coprime a b /\ coprime p b /\ coprime q a ==> coprime (p * a + q * b) (a * b) *)
4604(* Proof:
4605   Let z = p * a + q * b, c = a * b, d = gcd z c.
4606   Then d divides z /\ d divides c       by GCD_PROPERTY
4607   By coprime_by_prime_factor, we need to show:
4608      !t. prime t ==> ~(t divides z /\ t divides c)
4609   By contradiction, suppose t divides z /\ t divides c.
4610   Then t divides d                      by GCD_PROPERTY
4611     or t divides c where c = a * b      by DIVIDES_TRANS
4612     so t divides a or p divides b       by P_EUCLIDES
4613
4614   If t divides a,
4615      Then t divides (q * b)             by divides_linear_sub
4616       and ~(t divides b)                by coprime_common_factor, NOT_PRIME_1
4617        so t divides q                   by P_EUCLIDES
4618       ==> t = 1                         by coprime_common_factor
4619       This contradicts prime t          by NOT_PRIME_1
4620   If t divides b,
4621      Then t divides (p * a)             by divides_linear_sub
4622       and ~(t divides a)                by coprime_common_factor, NOT_PRIME_1
4623        so t divides p                   by P_EUCLIDES
4624       ==> t = 1                         by coprime_common_factor
4625       This contradicts prime t          by NOT_PRIME_1
4626   Since all lead to contradiction, we have shown:
4627     !t. prime t ==> ~(t divides z /\ t divides c)
4628   Thus coprime z c                      by coprime_by_prime_factor
4629*)
4630Theorem coprime_linear_mult:
4631  !a b p q. coprime a b /\ coprime p b /\ coprime q a ==> coprime (p * a + q * b) (a * b)
4632Proof
4633  rpt strip_tac >>
4634  qabbrev_tac `z = p * a + q * b` >>
4635  qabbrev_tac `c = a * b` >>
4636  irule (coprime_by_prime_factor |> SPEC_ALL |> #2 o EQ_IMP_RULE) >>
4637  rpt strip_tac >>
4638  `p' divides a \/ p' divides b` by metis_tac[P_EUCLIDES] >| [
4639    `p' divides (q * b)` by metis_tac[divides_linear_sub, MULT_LEFT_1] >>
4640    `~(p' divides b)` by metis_tac[coprime_common_factor, NOT_PRIME_1] >>
4641    `p' divides q` by metis_tac[P_EUCLIDES] >>
4642    metis_tac[coprime_common_factor, NOT_PRIME_1],
4643    `p' divides (p * a)` by metis_tac[divides_linear_sub, MULT_LEFT_1, ADD_COMM] >>
4644    `~(p' divides a)` by metis_tac[coprime_common_factor, NOT_PRIME_1, MULT_COMM] >>
4645    `p' divides p` by metis_tac[P_EUCLIDES] >>
4646    metis_tac[coprime_common_factor, NOT_PRIME_1]
4647  ]
4648QED
4649
4650(* Idea: include converse of coprime_linear_mult. *)
4651
4652(* Theorem: coprime a b ==>
4653            ((coprime p b /\ coprime q a) <=> coprime (p * a + q * b) (a * b)) *)
4654(* Proof:
4655   If part: coprime p b /\ coprime q a ==> coprime (p * a + q * b) (a * b)
4656      This is true by coprime_linear_mult.
4657   Only-if: coprime (p * a + q * b) (a * b) ==> coprime p b /\ coprime q a
4658      Let z = p * a + q * b. Consider a prime t.
4659      For coprime p b.
4660          If t divides p /\ t divides b,
4661          Then t divides z         by divides_linear
4662           and t divides (a * b)   by DIVIDES_MULTIPLE
4663            so t = 1               by coprime_common_factor
4664          This contradicts prime t by NOT_PRIME_1
4665          Thus coprime p b         by coprime_by_prime_factor
4666      For coprime q a.
4667          If t divides q /\ t divides a,
4668          Then t divides z         by divides_linear
4669           and t divides (a * b)   by DIVIDES_MULTIPLE
4670            so t = 1               by coprime_common_factor
4671          This contradicts prime t by NOT_PRIME_1
4672          Thus coprime q a         by coprime_by_prime_factor
4673*)
4674Theorem coprime_linear_mult_iff:
4675  !a b p q. coprime a b ==>
4676            ((coprime p b /\ coprime q a) <=> coprime (p * a + q * b) (a * b))
4677Proof
4678  rw_tac std_ss[EQ_IMP_THM] >-
4679  simp[coprime_linear_mult] >-
4680 (irule (coprime_by_prime_factor |> SPEC_ALL |> #2 o EQ_IMP_RULE) >>
4681  rpt strip_tac >>
4682  `p' divides (p * a + q * b)` by metis_tac[divides_linear, MULT_COMM] >>
4683  `p' divides (a * b)` by rw[DIVIDES_MULTIPLE] >>
4684  metis_tac[coprime_common_factor, NOT_PRIME_1]) >>
4685  irule (coprime_by_prime_factor |> SPEC_ALL |> #2 o EQ_IMP_RULE) >>
4686  rpt strip_tac >>
4687  `p' divides (p * a + q * b)` by metis_tac[divides_linear, MULT_COMM] >>
4688  `p' divides (a * b)` by metis_tac[DIVIDES_MULTIPLE, MULT_COMM] >>
4689  metis_tac[coprime_common_factor, NOT_PRIME_1]
4690QED
4691
4692(* Idea: condition for a number to be coprime with prime power. *)
4693
4694(* Theorem: prime p /\ 0 < n ==> !q. coprime q (p ** n) <=> ~(p divides q) *)
4695(* Proof:
4696   If part: prime p /\ 0 < n /\ coprime q (p ** n) ==> ~(p divides q)
4697      By contradiction, suppose p divides q.
4698      Note p divides (p ** n)  by prime_divides_self_power, 0 < n
4699      Thus p = 1               by coprime_common_factor
4700      This contradicts p <> 1  by NOT_PRIME_1
4701   Only-if part: prime p /\ 0 < n /\ ~(p divides q) ==> coprime q (p ** n)
4702      Note coprime q p         by prime_not_divides_coprime, GCD_SYM
4703      Thus coprime q (p ** n)  by coprime_iff_coprime_exp, 0 < n
4704*)
4705Theorem coprime_prime_power:
4706  !p n. prime p /\ 0 < n ==> !q. coprime q (p ** n) <=> ~(p divides q)
4707Proof
4708  rw[EQ_IMP_THM] >-
4709  metis_tac[prime_divides_self_power, coprime_common_factor, NOT_PRIME_1] >>
4710  metis_tac[prime_not_divides_coprime, coprime_iff_coprime_exp, GCD_SYM]
4711QED
4712
4713(* Theorem: prime n ==> !m. 0 < m /\ m < n ==> coprime n m *)
4714(* Proof:
4715   By contradiction. Let d = gcd n m, and d <> 1.
4716   Since prime n, 0 < n       by PRIME_POS
4717   Thus d divides n, and d m divides    by GCD_IS_GREATEST_COMMON_DIVISOR, n <> 0, m <> 0.
4718   ==>  d = n                           by prime_def, d <> 1.
4719   ==>  n divides m                     by d divides m
4720   ==>  n <= m                          by DIVIDES_LE
4721   which contradicts m < n.
4722*)
4723Theorem prime_coprime_all_lt:
4724    !n. prime n ==> !m. 0 < m /\ m < n ==> coprime n m
4725Proof
4726  rpt strip_tac >>
4727  spose_not_then strip_assume_tac >>
4728  qabbrev_tac `d = gcd n m` >>
4729  `0 < n` by rw[PRIME_POS] >>
4730  `n <> 0 /\ m <> 0` by decide_tac >>
4731  `d divides n /\ d divides m` by rw[GCD_IS_GREATEST_COMMON_DIVISOR, Abbr`d`] >>
4732  `d = n` by metis_tac[prime_def] >>
4733  `n <= m` by rw[DIVIDES_LE] >>
4734  decide_tac
4735QED
4736
4737(* Theorem: prime n /\ m < n ==> (!j. 0 < j /\ j <= m ==> coprime n j) *)
4738(* Proof:
4739   Since m < n, all j < n.
4740   Hence true by prime_coprime_all_lt
4741*)
4742Theorem prime_coprime_all_less:
4743    !m n. prime n /\ m < n ==> (!j. 0 < j /\ j <= m ==> coprime n j)
4744Proof
4745  rpt strip_tac >>
4746  `j < n` by decide_tac >>
4747  rw[prime_coprime_all_lt]
4748QED
4749
4750(* Theorem: prime n <=> 1 < n /\ (!j. 0 < j /\ j < n ==> coprime n j)) *)
4751(* Proof:
4752   If part: prime n ==> 1 < n /\ !j. 0 < j /\ j < n ==> coprime n j
4753      (1) prime n ==> 1 < n                          by ONE_LT_PRIME
4754      (2) prime n /\ 0 < j /\ j < n ==> coprime n j  by prime_coprime_all_lt
4755   Only-if part: !j. 0 < j /\ j < n ==> coprime n j ==> prime n
4756      By contradiction, assume ~prime n.
4757      Now, 1 < n /\ ~prime n
4758      ==> ?p. prime p /\ p < n /\ p divides n   by PRIME_FACTOR_PROPER
4759      and prime p ==> 0 < p and 1 < p           by PRIME_POS, ONE_LT_PRIME
4760      Hence ~coprime p n                        by coprime_not_divides, 1 < p
4761      But 0 < p < n ==> coprime n p             by given implication
4762      This is a contradiction                   by coprime_sym
4763*)
4764Theorem prime_iff_coprime_all_lt:
4765    !n. prime n <=> 1 < n /\ (!j. 0 < j /\ j < n ==> coprime n j)
4766Proof
4767  rw[EQ_IMP_THM, ONE_LT_PRIME] >-
4768  rw[prime_coprime_all_lt] >>
4769  spose_not_then strip_assume_tac >>
4770  `?p. prime p /\ p < n /\ p divides n` by rw[PRIME_FACTOR_PROPER] >>
4771  `0 < p` by rw[PRIME_POS] >>
4772  `1 < p` by rw[ONE_LT_PRIME] >>
4773  metis_tac[coprime_not_divides, coprime_sym]
4774QED
4775
4776(* Theorem: prime n <=> (1 < n /\ (!j. 1 < j /\ j < n ==> ~(j divides n))) *)
4777(* Proof:
4778   If part: prime n ==> (1 < n /\ (!j. 1 < j /\ j < n ==> ~(j divides n)))
4779      Note 1 < n                 by ONE_LT_PRIME
4780      By contradiction, suppose j divides n.
4781      Then j = 1 or j = n        by prime_def
4782      This contradicts 1 < j /\ j < n.
4783   Only-if part: (1 < n /\ (!j. 1 < j /\ j < n ==> ~(j divides n))) ==> prime n
4784      This is to show:
4785      !b. b divides n ==> b = 1 or b = n    by prime_def
4786      Since 1 < n, so n <> 0     by arithmetic
4787      Thus b <= n                by DIVIDES_LE
4788       and b <> 0                by ZERO_DIVIDES
4789      By contradiction, suppose b <> 1 and b <> n, but b divides n.
4790      Then 1 < b /\ b < n        by above
4791      giving ~(b divides n)      by implication
4792      This contradicts with b divides n.
4793*)
4794Theorem prime_iff_no_proper_factor:
4795    !n. prime n <=> (1 < n /\ (!j. 1 < j /\ j < n ==> ~(j divides n)))
4796Proof
4797  rw_tac std_ss[EQ_IMP_THM] >-
4798  rw[ONE_LT_PRIME] >-
4799  metis_tac[prime_def, LESS_NOT_EQ] >>
4800  rw[prime_def] >>
4801  `b <= n` by rw[DIVIDES_LE] >>
4802  `n <> 0` by decide_tac >>
4803  `b <> 0` by metis_tac[ZERO_DIVIDES] >>
4804  spose_not_then strip_assume_tac >>
4805  `1 < b /\ b < n` by decide_tac >>
4806  metis_tac[]
4807QED
4808
4809(* Theorem: FINITE s ==> !x. x NOTIN s /\ (!z. z IN s ==> coprime x z) ==> coprime x (PROD_SET s) *)
4810(* Proof:
4811   By finite induction on s.
4812   Base: coprime x (PROD_SET {})
4813      Note PROD_SET {} = 1         by PROD_SET_EMPTY
4814       and coprime x 1 = T         by GCD_1
4815   Step: !x. x NOTIN s /\ (!z. z IN s ==> coprime x z) ==> coprime x (PROD_SET s) ==>
4816        e NOTIN s /\ x NOTIN e INSERT s /\ !z. z IN e INSERT s ==> coprime x z ==>
4817        coprime x (PROD_SET (e INSERT s))
4818      Note coprime x e                               by IN_INSERT
4819       and coprime x (PROD_SET s)                    by induction hypothesis
4820      Thus coprime x (e * PROD_SET s)                by coprime_product_coprime_sym
4821        or coprime x PROD_SET (e INSERT s)           by PROD_SET_INSERT
4822*)
4823Theorem every_coprime_prod_set_coprime:
4824    !s. FINITE s ==> !x. x NOTIN s /\ (!z. z IN s ==> coprime x z) ==> coprime x (PROD_SET s)
4825Proof
4826  Induct_on `FINITE` >>
4827  rpt strip_tac >-
4828  rw[PROD_SET_EMPTY] >>
4829  fs[] >>
4830  rw[PROD_SET_INSERT, coprime_product_coprime_sym]
4831QED
4832
4833(* ------------------------------------------------------------------------- *)
4834(* GCD divisibility condition of Power Predecessors                          *)
4835(* ------------------------------------------------------------------------- *)
4836
4837(* Theorem: 0 < t /\ m <= n ==>
4838           (t ** n - 1 = t ** (n - m) * (t ** m - 1) + (t ** (n - m) - 1)) *)
4839(* Proof:
4840   Note !n. 1 <= t ** n                  by ONE_LE_EXP, 0 < t, [1]
4841
4842   Claim: t ** (n - m) - 1 <= t ** n - 1, because:
4843   Proof: Note n - m <= n                always
4844            so t ** (n - m) <= t ** n    by EXP_BASE_LEQ_MONO_IMP, 0 < t
4845           Now 1 <= t ** (n - m) and
4846               1 <= t ** n               by [1]
4847           Hence t ** (n - m) - 1 <= t ** n - 1.
4848
4849        t ** (n - m) * (t ** m - 1) + t ** (n - m) - 1
4850      = (t ** (n - m) * t ** m - t ** (n - m)) + t ** (n - m) - 1   by LEFT_SUB_DISTRIB
4851      = (t ** (n - m + m) - t ** (n - m)) + t ** (n - m) - 1        by EXP_ADD
4852      = (t ** n - t ** (n - m)) + t ** (n - m) - 1                  by SUB_ADD, m <= n
4853      = (t ** n - (t ** (n - m) - 1 + 1)) + t ** (n - m) - 1        by SUB_ADD, 1 <= t ** (n - m)
4854      = (t ** n - (1 + (t ** (n - m) - 1))) + t ** (n - m) - 1      by ADD_COMM
4855      = (t ** n - 1 - (t ** (n - m) - 1)) + t ** (n - m) - 1        by SUB_PLUS, no condition
4856      = t ** n - 1                                 by SUB_ADD, t ** (n - m) - 1 <= t ** n - 1
4857*)
4858Theorem power_predecessor_division_eqn:
4859    !t m n. 0 < t /\ m <= n ==>
4860           (t ** n - 1 = t ** (n - m) * (t ** m - 1) + (t ** (n - m) - 1))
4861Proof
4862  rpt strip_tac >>
4863  `1 <= t ** n /\ 1 <= t ** (n - m)` by rw[ONE_LE_EXP] >>
4864  `n - m <= n` by decide_tac >>
4865  `t ** (n - m) <= t ** n` by rw[EXP_BASE_LEQ_MONO_IMP] >>
4866  `t ** (n - m) - 1 <= t ** n - 1` by decide_tac >>
4867  qabbrev_tac `z = t ** (n - m) - 1` >>
4868  `t ** (n - m) * (t ** m - 1) + z =
4869    t ** (n - m) * t ** m - t ** (n - m) + z` by decide_tac >>
4870  `_ = t ** (n - m + m) - t ** (n - m) + z` by rw_tac std_ss[EXP_ADD] >>
4871  `_ = t ** n - t ** (n - m) + z` by rw_tac std_ss[SUB_ADD] >>
4872  `_ = t ** n - (z + 1) + z` by rw_tac std_ss[SUB_ADD, Abbr`z`] >>
4873  `_ = t ** n + z - (z + 1)` by decide_tac >>
4874  `_ = t ** n - 1` by decide_tac >>
4875  decide_tac
4876QED
4877
4878(* This shows the pattern:
4879                    1000000    so 9999999999 = 1000000 * 9999 + 999999
4880               ------------    or (b ** 10 - 1) = b ** 6 * (b ** 4 - 1) + (b ** 6 - 1)
4881          9999 | 9999999999    where b = 10.
4882                 9999
4883                 ----------
4884                     999999
4885*)
4886
4887(* Theorem: 0 < t /\ m <= n ==>
4888           (t ** n - 1 - t ** (n - m) * (t ** m - 1) = t ** (n - m) - 1) *)
4889(* Proof: by power_predecessor_division_eqn *)
4890Theorem power_predecessor_division_alt:
4891    !t m n. 0 < t /\ m <= n ==>
4892           (t ** n - 1 - t ** (n - m) * (t ** m - 1) = t ** (n - m) - 1)
4893Proof
4894  rpt strip_tac >>
4895  imp_res_tac power_predecessor_division_eqn >>
4896  fs[]
4897QED
4898
4899(* Theorem: m < n ==> (gcd (t ** n - 1) (t ** m - 1) = gcd ((t ** m - 1)) (t ** (n - m) - 1)) *)
4900(* Proof:
4901   Case t = 0,
4902      If n = 0, t ** 0 = 1             by ZERO_EXP
4903      LHS = gcd 0 x = 0                by GCD_0L
4904          = gcd 0 y = RHS              by ZERO_EXP
4905      If n <> 0, 0 ** n = 0            by ZERO_EXP
4906      LHS = gcd (0 - 1) x
4907          = gcd 0 x = 0                by GCD_0L
4908          = gcd 0 y = RHS              by ZERO_EXP
4909   Case t <> 0,
4910      Note t ** n - 1 = t ** (n - m) * (t ** m - 1) + (t ** (n - m) - 1)
4911                                       by power_predecessor_division_eqn
4912        so t ** (n - m) * (t ** m - 1) <= t ** n - 1    by above, [1]
4913       and t ** n - 1 - t ** (n - m) * (t ** m - 1) = t ** (n - m) - 1, [2]
4914        gcd (t ** n - 1) (t ** m - 1)
4915      = gcd (t ** m - 1) (t ** n - 1)                by GCD_SYM
4916      = gcd (t ** m - 1) ((t ** n - 1) - t ** (n - m) * (t ** m - 1))
4917                                                     by GCD_SUB_MULTIPLE, [1]
4918      = gcd (t ** m - 1)) (t ** (n - m) - 1)         by [2]
4919*)
4920Theorem power_predecessor_gcd_reduction:
4921    !t n m. m <= n ==> (gcd (t ** n - 1) (t ** m - 1) = gcd ((t ** m - 1)) (t ** (n - m) - 1))
4922Proof
4923  rpt strip_tac >>
4924  Cases_on `t = 0` >-
4925  rw[ZERO_EXP] >>
4926  `t ** n - 1 = t ** (n - m) * (t ** m - 1) + (t ** (n - m) - 1)` by rw[power_predecessor_division_eqn] >>
4927  `t ** n - 1 - t ** (n - m) * (t ** m - 1) = t ** (n - m) - 1` by fs[] >>
4928  `gcd (t ** n - 1) (t ** m - 1) = gcd (t ** m - 1) (t ** n - 1)` by rw_tac std_ss[GCD_SYM] >>
4929  `_ = gcd (t ** m - 1) ((t ** n - 1) - t ** (n - m) * (t ** m - 1))` by rw_tac std_ss[GCD_SUB_MULTIPLE] >>
4930  rw_tac std_ss[]
4931QED
4932
4933(* Theorem: gcd (t ** n - 1) (t ** m - 1) = t ** (gcd n m) - 1 *)
4934(* Proof:
4935   By complete induction on (n + m):
4936   Induction hypothesis: !m'. m' < n + m ==>
4937                         !n m. (m' = n + m) ==> (gcd (t ** n - 1) (t ** m - 1) = t ** gcd n m - 1)
4938   Idea: if 0 < m, n < n + m. Put last n = m, m = n - m. That is m' = m + (n - m) = n.
4939   Also  if 0 < n, m < n + m. Put last n = n, m = m - n. That is m' = n + (m - n) = m.
4940
4941   Thus to apply induction hypothesis, need 0 < n or 0 < m.
4942   So take care of these special cases first.
4943
4944   Case: n = 0 ==> gcd (t ** n - 1) (t ** m - 1) = t ** gcd n m - 1
4945         LHS = gcd (t ** 0 - 1) (t ** m - 1)
4946             = gcd 0 (t ** m - 1)                 by EXP
4947             = t ** m - 1                         by GCD_0L
4948             = t ** (gcd 0 m) - 1 = RHS           by GCD_0L
4949   Case: m = 0 ==> gcd (t ** n - 1) (t ** m - 1) = t ** gcd n m - 1
4950         LHS = gcd (t ** n - 1) (t ** 0 - 1)
4951             = gcd (t ** n - 1) 0                 by EXP
4952             = t ** n - 1                         by GCD_0R
4953             = t ** (gcd n 0) - 1 = RHS           by GCD_0R
4954
4955   Case: m <> 0 /\ n <> 0 ==> gcd (t ** n - 1) (t ** m - 1) = t ** gcd n m - 1
4956      That is, 0 < n, and 0 < m
4957          also n < n + m, and m < n + m           by arithmetic
4958
4959      Use trichotomy of numbers:                  by LESS_LESS_CASES
4960      Case: n = m /\ m <> 0 /\ n <> 0 ==> gcd (t ** n - 1) (t ** m - 1) = t ** gcd n m - 1
4961         LHS = gcd (t ** m - 1) (t ** m - 1)
4962             = t ** m - 1                         by GCD_REF
4963             = t ** (gcd m m) - 1 = RHS           by GCD_REF
4964
4965      Case: m < n /\ m <> 0 /\ n <> 0 ==> gcd (t ** n - 1) (t ** m - 1) = t ** gcd n m - 1
4966         Since n < n + m                          by 0 < m
4967           and m + (n - m) = (n - m) + m          by ADD_COMM
4968                           = n                    by SUB_ADD, m <= n
4969           gcd (t ** n - 1) (t ** m - 1)
4970         = gcd ((t ** m - 1)) (t ** (n - m) - 1)  by power_predecessor_gcd_reduction
4971         = t ** gcd m (n - m) - 1                 by induction hypothesis, m + (n - m) = n
4972         = t ** gcd m n - 1                       by GCD_SUB_R, m <= n
4973         = t ** gcd n m - 1                       by GCD_SYM
4974
4975      Case: n < m /\ m <> 0 /\ n <> 0 ==> gcd (t ** n - 1) (t ** m - 1) = t ** gcd n m - 1
4976         Since m < n + m                          by 0 < n
4977           and n + (m - n) = (m - n) + n          by ADD_COMM
4978                           = m                    by SUB_ADD, n <= m
4979          gcd (t ** n - 1) (t ** m - 1)
4980        = gcd (t ** m - 1) (t ** n - 1)           by GCD_SYM
4981        = gcd ((t ** n - 1)) (t ** (m - n) - 1)   by power_predecessor_gcd_reduction
4982        = t ** gcd n (m - n) - 1                  by induction hypothesis, n + (m - n) = m
4983        = t ** gcd n m                            by GCD_SUB_R, n <= m
4984*)
4985Theorem power_predecessor_gcd_identity:
4986    !t n m. gcd (t ** n - 1) (t ** m - 1) = t ** (gcd n m) - 1
4987Proof
4988  rpt strip_tac >>
4989  completeInduct_on `n + m` >>
4990  rpt strip_tac >>
4991  Cases_on `n = 0` >-
4992  rw[EXP] >>
4993  Cases_on `m = 0` >-
4994  rw[EXP] >>
4995  `(n = m) \/ (m < n) \/ (n < m)` by metis_tac[LESS_LESS_CASES] >-
4996  rw[GCD_REF] >-
4997 (`0 < m /\ n < n + m` by decide_tac >>
4998  `m <= n` by decide_tac >>
4999  `m + (n - m) = n` by metis_tac[SUB_ADD, ADD_COMM] >>
5000  `gcd (t ** n - 1) (t ** m - 1) = gcd ((t ** m - 1)) (t ** (n - m) - 1)` by rw[power_predecessor_gcd_reduction] >>
5001  `_ = t ** gcd m (n - m) - 1` by metis_tac[] >>
5002  metis_tac[GCD_SUB_R, GCD_SYM]) >>
5003  `0 < n /\ m < n + m` by decide_tac >>
5004  `n <= m` by decide_tac >>
5005  `n + (m - n) = m` by metis_tac[SUB_ADD, ADD_COMM] >>
5006  `gcd (t ** n - 1) (t ** m - 1) = gcd ((t ** n - 1)) (t ** (m - n) - 1)` by rw[power_predecessor_gcd_reduction, GCD_SYM] >>
5007  `_ = t ** gcd n (m - n) - 1` by metis_tac[] >>
5008  metis_tac[GCD_SUB_R]
5009QED
5010
5011(* Above is the formal proof of the following pattern:
5012   For any base
5013         gcd(999999,9999) = gcd(6 9s, 4 9s) = gcd(6,4) 9s = 2 9s = 99
5014   or        999999 MOD 9999 = (6 9s) MOD (4 9s) = 2 9s = 99
5015   Thus in general,
5016             (m 9s) MOD (n 9s) = (m MOD n) 9s
5017   Repeating the use of Euclidean algorithm then gives:
5018             gcd (m 9s, n 9s) = (gcd m n) 9s
5019
5020Reference: A Mathematical Tapestry (by Jean Pedersen and Peter Hilton)
5021Chapter 4: A number-theory thread -- Folding numbers, a number trick, and some tidbits.
5022*)
5023
5024(* Theorem: 1 < t ==> ((t ** n - 1) divides (t ** m - 1) <=> n divides m) *)
5025(* Proof:
5026       (t ** n - 1) divides (t ** m - 1)
5027   <=> gcd (t ** n - 1) (t ** m - 1) = t ** n - 1   by divides_iff_gcd_fix
5028   <=> t ** (gcd n m) - 1 = t ** n - 1              by power_predecessor_gcd_identity
5029   <=> t ** (gcd n m) = t ** n                      by PRE_SUB1, INV_PRE_EQ, EXP_POS, 0 < t
5030   <=>       gcd n m = n                            by EXP_BASE_INJECTIVE, 1 < t
5031   <=>       n divides m                            by divides_iff_gcd_fix
5032*)
5033Theorem power_predecessor_divisibility:
5034    !t n m. 1 < t ==> ((t ** n - 1) divides (t ** m - 1) <=> n divides m)
5035Proof
5036  rpt strip_tac >>
5037  `0 < t` by decide_tac >>
5038  `!n. 0 < t ** n` by rw[EXP_POS] >>
5039  `!x y. 0 < x /\ 0 < y ==> ((x - 1 = y - 1) <=> (x = y))` by decide_tac >>
5040  `(t ** n - 1) divides (t ** m - 1) <=> ((gcd (t ** n - 1) (t ** m - 1) = t ** n - 1))` by rw[divides_iff_gcd_fix] >>
5041  `_ = (t ** (gcd n m) - 1 = t ** n - 1)` by rw[power_predecessor_gcd_identity] >>
5042  `_ = (t ** (gcd n m) = t ** n)` by rw[] >>
5043  `_ = (gcd n m = n)` by rw[EXP_BASE_INJECTIVE] >>
5044  rw[divides_iff_gcd_fix]
5045QED
5046
5047(* Theorem: t - 1 divides t ** n - 1 *)
5048(* Proof:
5049   If t = 0,
5050      Then t - 1 = 0        by integer subtraction
5051       and t ** n - 1 = 0   by ZERO_EXP, either case of n.
5052      Thus 0 divides 0      by ZERO_DIVIDES
5053   If t = 1,
5054      Then t - 1 = 0        by arithmetic
5055       and t ** n - 1 = 0   by EXP_1
5056      Thus 0 divides 0      by ZERO_DIVIDES
5057   Otherwise, 1 < t
5058       and 1 divides n      by ONE_DIVIDES_ALL
5059       ==> t ** 1 - 1 divides t ** n - 1   by power_predecessor_divisibility
5060        or      t - 1 divides t ** n - 1   by EXP_1
5061*)
5062Theorem power_predecessor_divisor:
5063  !t n. t - 1 divides t ** n - 1
5064Proof
5065  rpt strip_tac >>
5066  Cases_on `t = 0` >-
5067  simp[ZERO_EXP] >>
5068  Cases_on `t = 1` >-
5069  simp[] >>
5070  `1 < t` by decide_tac >>
5071  metis_tac[power_predecessor_divisibility, EXP_1, ONE_DIVIDES_ALL]
5072QED
5073
5074(* Overload power predecessor *)
5075Overload tops = “\b:num n. b ** n - 1”
5076
5077(*
5078   power_predecessor_division_eqn
5079     |- !t m n. 0 < t /\ m <= n ==> tops t n = t ** (n - m) * tops t m + tops t (n - m)
5080   power_predecessor_division_alt
5081     |- !t m n. 0 < t /\ m <= n ==> tops t n - t ** (n - m) * tops t m = tops t (n - m)
5082   power_predecessor_gcd_reduction
5083     |- !t n m. m <= n ==> (gcd (tops t n) (tops t m) = gcd (tops t m) (tops t (n - m)))
5084   power_predecessor_gcd_identity
5085     |- !t n m. gcd (tops t n) (tops t m) = tops t (gcd n m)
5086   power_predecessor_divisibility
5087     |- !t n m. 1 < t ==> (tops t n divides tops t m <=> n divides m)
5088   power_predecessor_divisor
5089     |- !t n. t - 1 divides tops t n
5090*)
5091
5092(* Overload power predecessor base 10 *)
5093Overload nines = ``\n. tops 10 n``
5094
5095(* Obtain corollaries *)
5096
5097Theorem nines_division_eqn =
5098    power_predecessor_division_eqn |> ISPEC ``10`` |> SIMP_RULE (srw_ss()) [];
5099Theorem nines_division_alt =
5100    power_predecessor_division_alt |> ISPEC ``10`` |> SIMP_RULE (srw_ss()) [];
5101Theorem nines_gcd_reduction =
5102    power_predecessor_gcd_reduction |> ISPEC ``10``;
5103Theorem nines_gcd_identity =
5104    power_predecessor_gcd_identity |> ISPEC ``10``;
5105Theorem nines_divisibility =
5106    power_predecessor_divisibility |> ISPEC ``10`` |> SIMP_RULE (srw_ss()) [];
5107Theorem nines_divisor =
5108    power_predecessor_divisor |> ISPEC ``10`` |> SIMP_RULE (srw_ss()) [];
5109(*
5110val nines_division_eqn =
5111   |- !m n. m <= n ==> nines n = 10 ** (n - m) * nines m + nines (n - m): thm
5112val nines_division_alt =
5113   |- !m n. m <= n ==> nines n - 10 ** (n - m) * nines m = nines (n - m): thm
5114val nines_gcd_reduction =
5115   |- !n m. m <= n ==> gcd (nines n) (nines m) = gcd (nines m) (nines (n - m)): thm
5116val nines_gcd_identity = |- !n m. gcd (nines n) (nines m) = nines (gcd n m): thm
5117val nines_divisibility = |- !n m. nines n divides nines m <=> n divides m: thm
5118val nines_divisor = |- !n. 9 divides nines n: thm
5119*)
5120
5121(* ------------------------------------------------------------------------- *)
5122(* GCD involving Powers                                                      *)
5123(* ------------------------------------------------------------------------- *)
5124
5125(* Theorem: prime m /\ prime n /\ m divides (n ** k) ==> (m = n) *)
5126(* Proof:
5127   By induction on k.
5128   Base: m divides n ** 0 ==> (m = n)
5129      Since n ** 0 = 1              by EXP
5130        and m divides 1 ==> m = 1   by DIVIDES_ONE
5131       This contradicts 1 < m       by ONE_LT_PRIME
5132   Step: m divides n ** k ==> (m = n) ==> m divides n ** SUC k ==> (m = n)
5133      Since n ** SUC k = n * n ** k           by EXP
5134       Also m divides n \/ m divides n ** k   by P_EUCLIDES
5135         If m divides n, then m = n           by prime_divides_only_self
5136         If m divides n ** k, then m = n      by induction hypothesis
5137*)
5138Theorem prime_divides_prime_power:
5139    !m n k. prime m /\ prime n /\ m divides (n ** k) ==> (m = n)
5140Proof
5141  rpt strip_tac >>
5142  Induct_on `k` >| [
5143    rpt strip_tac >>
5144    `1 < m` by rw[ONE_LT_PRIME] >>
5145    `m = 1` by metis_tac[EXP, DIVIDES_ONE] >>
5146    decide_tac,
5147    metis_tac[EXP, P_EUCLIDES, prime_divides_only_self]
5148  ]
5149QED
5150
5151(* This is better than FACTOR_OUT_PRIME *)
5152
5153(* Theorem: 0 < n /\ prime p ==> ?q m. (n = (p ** m) * q) /\ coprime p q *)
5154(* Proof:
5155   If p divides n,
5156      Then ?m. 0 < m /\ p ** m divides n /\
5157           !k. coprime (p ** k) (n DIV p ** m)   by FACTOR_OUT_PRIME
5158      Let q = n DIV (p ** m).
5159      Note 0 < p                                 by PRIME_POS
5160        so 0 < p ** m                            by EXP_POS, 0 < p
5161      Take this q and m,
5162      Then n = (p ** m) * q                      by DIVIDES_EQN_COMM
5163       and coprime p q                           by taking k = 1, EXP_1
5164
5165   If ~(p divides n),
5166      Then coprime p n                           by prime_not_divides_coprime
5167      Let q = n, m = 0.
5168      Then n = 1 * q                             by EXP, MULT_LEFT_1
5169       and coprime p q.
5170*)
5171Theorem prime_power_factor:
5172    !n p. 0 < n /\ prime p ==> ?q m. (n = (p ** m) * q) /\ coprime p q
5173Proof
5174  rpt strip_tac >>
5175  Cases_on `p divides n` >| [
5176    `?m. 0 < m /\ p ** m divides n /\ !k. coprime (p ** k) (n DIV p ** m)` by rw[FACTOR_OUT_PRIME] >>
5177    qabbrev_tac `q = n DIV (p ** m)` >>
5178    `0 < p` by rw[PRIME_POS] >>
5179    `0 < p ** m` by rw[EXP_POS] >>
5180    metis_tac[DIVIDES_EQN_COMM, EXP_1],
5181    `coprime p n` by rw[prime_not_divides_coprime] >>
5182    metis_tac[EXP, MULT_LEFT_1]
5183  ]
5184QED
5185
5186(* Even this simple theorem is quite difficult to prove, why? *)
5187(* Because this needs a typical detective-style proof! *)
5188
5189(* Theorem: prime p /\ a divides (p ** n) ==> ?j. j <= n /\ (a = p ** j) *)
5190(* Proof:
5191   Note 0 < p                by PRIME_POS
5192     so 0 < p ** n           by EXP_POS
5193   Thus 0 < a                by ZERO_DIVIDES
5194    ==> ?q m. (a = (p ** m) * q) /\ coprime p q    by prime_power_factor
5195
5196   Claim: q = 1
5197   Proof: By contradiction, suppose q <> 1.
5198          Then ?t. prime t /\ t divides q          by PRIME_FACTOR, q <> 1
5199           Now q divides a           by divides_def
5200            so t divides (p ** n)    by DIVIDES_TRANS
5201           ==> t = p                 by prime_divides_prime_power
5202           But gcd t q = t           by divides_iff_gcd_fix
5203            or gcd p q = p           by t = p
5204           Yet p <> 1                by NOT_PRIME_1
5205            so this contradicts coprime p q.
5206
5207   Thus a = p ** m                   by q = 1, Claim.
5208   Note p ** m <= p ** n             by DIVIDES_LE, 0 < p
5209    and 1 < p                        by ONE_LT_PRIME
5210    ==>      m <= n                  by EXP_BASE_LE_MONO, 1 < p
5211   Take j = m, and the result follows.
5212*)
5213Theorem prime_power_divisor:
5214    !p n a. prime p /\ a divides (p ** n) ==> ?j. j <= n /\ (a = p ** j)
5215Proof
5216  rpt strip_tac >>
5217  `0 < p` by rw[PRIME_POS] >>
5218  `0 < p ** n` by rw[EXP_POS] >>
5219  `0 < a` by metis_tac[ZERO_DIVIDES, NOT_ZERO_LT_ZERO] >>
5220  `?q m. (a = (p ** m) * q) /\ coprime p q` by rw[prime_power_factor] >>
5221  `q = 1` by
5222  (spose_not_then strip_assume_tac >>
5223  `?t. prime t /\ t divides q` by rw[PRIME_FACTOR] >>
5224  `q divides a` by metis_tac[divides_def] >>
5225  `t divides (p ** n)` by metis_tac[DIVIDES_TRANS] >>
5226  `t = p` by metis_tac[prime_divides_prime_power] >>
5227  `gcd t q = t` by rw[GSYM divides_iff_gcd_fix] >>
5228  metis_tac[NOT_PRIME_1]) >>
5229  `a = p ** m` by rw[] >>
5230  metis_tac[DIVIDES_LE, EXP_BASE_LE_MONO, ONE_LT_PRIME]
5231QED
5232
5233(* Theorem: prime p /\ prime q ==>
5234            !m n. 0 < m /\ (p ** m = q ** n) ==> (p = q) /\ (m = n) *)
5235(* Proof:
5236   First goal: p = q.
5237      Since p divides p        by DIVIDES_REFL
5238        ==> p divides p ** m   by divides_exp, 0 < m.
5239         so p divides q ** n   by given, p ** m = q ** n
5240      Hence p = q              by prime_divides_prime_power
5241   Second goal: m = n.
5242      Note p = q               by first goal.
5243      Since 1 < p              by ONE_LT_PRIME
5244      Hence m = n              by EXP_BASE_INJECTIVE, 1 < p
5245*)
5246Theorem prime_powers_eq:
5247    !p q. prime p /\ prime q ==>
5248   !m n. 0 < m /\ (p ** m = q ** n) ==> (p = q) /\ (m = n)
5249Proof
5250  ntac 6 strip_tac >>
5251  conj_asm1_tac >-
5252  metis_tac[divides_exp, prime_divides_prime_power, DIVIDES_REFL] >>
5253  metis_tac[EXP_BASE_INJECTIVE, ONE_LT_PRIME]
5254QED
5255
5256(* Theorem: prime p /\ prime q /\ p <> q ==> !m n. coprime (p ** m) (q ** n) *)
5257(* Proof:
5258   Let d = gcd (p ** m) (q ** n).
5259   By contradiction, d <> 1.
5260   Then d divides (p ** m) /\ d divides (q ** n)   by GCD_PROPERTY
5261    ==> ?j. j <= m /\ (d = p ** j)                 by prime_power_divisor, prime p
5262    and ?k. k <= n /\ (d = q ** k)                 by prime_power_divisor, prime q
5263   Note j <> 0 /\ k <> 0                           by EXP_0
5264     or 0 < j /\ 0 < k                             by arithmetic
5265    ==> p = q, which contradicts p <> q            by prime_powers_eq
5266*)
5267Theorem prime_powers_coprime:
5268    !p q. prime p /\ prime q /\ p <> q ==> !m n. coprime (p ** m) (q ** n)
5269Proof
5270  spose_not_then strip_assume_tac >>
5271  qabbrev_tac `d = gcd (p ** m) (q ** n)` >>
5272  `d divides (p ** m) /\ d divides (q ** n)` by metis_tac[GCD_PROPERTY] >>
5273  metis_tac[prime_power_divisor, prime_powers_eq, EXP_0, NOT_ZERO_LT_ZERO]
5274QED
5275
5276(* Theorem: prime p /\ prime q ==> !m n. 0 < m ==> ((p ** m divides q ** n) <=> (p = q) /\ (m <= n)) *)
5277(* Proof:
5278   If part: p ** m divides q ** n ==> (p = q) /\ m <= n
5279      Note p divides (p ** m)         by prime_divides_self_power, 0 < m
5280        so p divides (q ** n)         by DIVIDES_TRANS
5281      Thus p = q                      by prime_divides_prime_power
5282      Note 1 < p                      by ONE_LT_PRIME
5283      Thus m <= n                     by power_divides_iff
5284   Only-if part: (p = q) /\ m <= n ==> p ** m divides q ** n
5285      Note 1 < p                      by ONE_LT_PRIME
5286      Thus p ** m divides q ** n      by power_divides_iff
5287*)
5288Theorem prime_powers_divide:
5289    !p q. prime p /\ prime q ==> !m n. 0 < m ==> ((p ** m divides q ** n) <=> (p = q) /\ (m <= n))
5290Proof
5291  metis_tac[ONE_LT_PRIME, divides_self_power, prime_divides_prime_power, power_divides_iff, DIVIDES_TRANS]
5292QED
5293
5294(* Theorem: prime p /\ q divides (p ** n) ==> (q = 1) \/ (p divides q) *)
5295(* Proof:
5296   By contradiction, suppose q <> 1 /\ ~(p divides q).
5297   Note ?j. j <= n /\ (q = p ** j)   by prime_power_divisor
5298    and 0 < j                        by EXP_0, q <> 1
5299   then p divides q                  by prime_divides_self_power, 0 < j
5300   This contradicts ~(p divides q).
5301*)
5302Theorem PRIME_EXP_FACTOR:
5303  !p q n. prime p /\ q divides (p ** n) ==> (q = 1) \/ (p divides q)
5304Proof
5305  spose_not_then strip_assume_tac >>
5306  `?j. j <= n /\ (q = p ** j)` by rw[prime_power_divisor] >>
5307  `0 < j` by fs[] >>
5308  metis_tac[prime_divides_self_power]
5309QED
5310
5311(* Theorem: gcd (b ** m) (b ** n) = b ** (MIN m n) *)
5312(* Proof:
5313   If m = n,
5314      LHS = gcd (b ** n) (b ** n)
5315          = b ** n                     by GCD_REF
5316      RHS = b ** (MIN n n)
5317          = b ** n                     by MIN_IDEM
5318   If m < n,
5319      b ** n = b ** (n - m + m)        by arithmetic
5320             = b ** (n - m) * b ** m   by EXP_ADD
5321      so (b ** m) divides (b ** n)     by divides_def
5322      or gcd (b ** m) (b ** n)
5323       = b ** m                        by divides_iff_gcd_fix
5324       = b ** (MIN m n)                by MIN_DEF
5325   If ~(m < n), n < m.
5326      Similar argument as m < n, with m n exchanged, use GCD_SYM.
5327*)
5328Theorem gcd_powers:
5329    !b m n. gcd (b ** m) (b ** n) = b ** (MIN m n)
5330Proof
5331  rpt strip_tac >>
5332  Cases_on `m = n` >-
5333  rw[] >>
5334  Cases_on `m < n` >| [
5335    `b ** n = b ** (n - m + m)` by rw[] >>
5336    `_ = b ** (n - m) * b ** m` by rw[EXP_ADD] >>
5337    `(b ** m) divides (b ** n)` by metis_tac[divides_def] >>
5338    metis_tac[divides_iff_gcd_fix, MIN_DEF],
5339    `n < m` by decide_tac >>
5340    `b ** m = b ** (m - n + n)` by rw[] >>
5341    `_ = b ** (m - n) * b ** n` by rw[EXP_ADD] >>
5342    `(b ** n) divides (b ** m)` by metis_tac[divides_def] >>
5343    metis_tac[divides_iff_gcd_fix, GCD_SYM, MIN_DEF]
5344  ]
5345QED
5346
5347(* Theorem: lcm (b ** m) (b ** n) = b ** (MAX m n) *)
5348(* Proof:
5349   If m = n,
5350      LHS = lcm (b ** n) (b ** n)
5351          = b ** n                     by LCM_REF
5352      RHS = b ** (MAX n n)
5353          = b ** n                     by MAX_IDEM
5354   If m < n,
5355      b ** n = b ** (n - m + m)        by arithmetic
5356             = b ** (n - m) * b ** m   by EXP_ADD
5357      so (b ** m) divides (b ** n)     by divides_def
5358      or lcm (b ** m) (b ** n)
5359       = b ** n                        by divides_iff_lcm_fix
5360       = b ** (MAX m n)                by MAX_DEF
5361   If ~(m < n), n < m.
5362      Similar argument as m < n, with m n exchanged, use LCM_COMM.
5363*)
5364Theorem lcm_powers:
5365    !b m n. lcm (b ** m) (b ** n) = b ** (MAX m n)
5366Proof
5367  rpt strip_tac >>
5368  Cases_on `m = n` >-
5369  rw[LCM_REF] >>
5370  Cases_on `m < n` >| [
5371    `b ** n = b ** (n - m + m)` by rw[] >>
5372    `_ = b ** (n - m) * b ** m` by rw[EXP_ADD] >>
5373    `(b ** m) divides (b ** n)` by metis_tac[divides_def] >>
5374    metis_tac[divides_iff_lcm_fix, MAX_DEF],
5375    `n < m` by decide_tac >>
5376    `b ** m = b ** (m - n + n)` by rw[] >>
5377    `_ = b ** (m - n) * b ** n` by rw[EXP_ADD] >>
5378    `(b ** n) divides (b ** m)` by metis_tac[divides_def] >>
5379    metis_tac[divides_iff_lcm_fix, LCM_COMM, MAX_DEF]
5380  ]
5381QED
5382
5383(* Theorem: 0 < b /\ 0 < m ==> coprime (b ** n) (b ** m - 1) *)
5384(* Proof:
5385   If m = n,
5386          coprime (b ** n) (b ** n - 1)
5387      <=> T                                by coprime_PRE
5388
5389   Claim: !j. j < m ==> coprime (b ** j) (b ** m - 1)
5390   Proof: b ** m
5391        = b ** (m - j + j)                 by SUB_ADD
5392        = b ** (m - j) * b ** j            by EXP_ADD
5393     Thus (b ** j) divides (b ** m)        by divides_def
5394      Now 0 < b ** m                       by EXP_POS
5395       so coprime (b ** j) (PRE (b ** m))  by divides_imp_coprime_with_predecessor
5396       or coprime (b ** j) (b ** m - 1)    by PRE_SUB1
5397
5398   Given 0 < m,
5399          b ** n
5400        = b ** ((n DIV m) * m + n MOD m)          by DIVISION
5401        = b ** (m * (n DIV m) + n MOD m)          by MULT_COMM
5402        = b ** (m * (n DIV m)) * b ** (n MOD m)   by EXP_ADD
5403        = (b ** m) ** (n DIV m) * b ** (n MOD m)  by EXP_EXP_MULT
5404   Let z = b ** m,
5405   Then b ** n = z ** (n DIV m) * b ** (n MOD m)
5406    and 0 < z                                     by EXP_POS
5407   Since coprime z (z - 1)                        by coprime_PRE
5408     ==> coprime (z ** (n DIV m)) (z - 1)         by coprime_exp
5409          gcd (b ** n) (b ** m - 1)
5410        = gcd (z ** (n DIV m) * b ** (n MOD m)) (z - 1)
5411        = gcd (b ** (n MOD m)) (z - 1)            by GCD_SYM, GCD_CANCEL_MULT
5412    Now (n MOD m) < m                             by MOD_LESS
5413    so apply the claim to deduce the result.
5414*)
5415Theorem coprime_power_and_power_predecessor:
5416    !b m n. 0 < b /\ 0 < m ==> coprime (b ** n) (b ** m - 1)
5417Proof
5418  rpt strip_tac >>
5419  `0 < b ** n /\ 0 < b ** m` by rw[EXP_POS] >>
5420  Cases_on `m = n` >-
5421  rw[coprime_PRE] >>
5422  `!j. j < m ==> coprime (b ** j) (b ** m - 1)` by
5423  (rpt strip_tac >>
5424  `b ** m = b ** (m - j + j)` by rw[] >>
5425  `_ = b ** (m - j) * b ** j` by rw[EXP_ADD] >>
5426  `(b ** j) divides (b ** m)` by metis_tac[divides_def] >>
5427  metis_tac[divides_imp_coprime_with_predecessor, PRE_SUB1]) >>
5428  `b ** n = b ** ((n DIV m) * m + n MOD m)` by rw[GSYM DIVISION] >>
5429  `_ = b ** (m * (n DIV m) + n MOD m)` by rw[MULT_COMM] >>
5430  `_ = b ** (m * (n DIV m)) * b ** (n MOD m)` by rw[EXP_ADD] >>
5431  `_ = (b ** m) ** (n DIV m) * b ** (n MOD m)` by rw[EXP_EXP_MULT] >>
5432  qabbrev_tac `z = b ** m` >>
5433  `coprime z (z - 1)` by rw[coprime_PRE] >>
5434  `coprime (z ** (n DIV m)) (z - 1)` by rw[coprime_exp] >>
5435  metis_tac[GCD_SYM, GCD_CANCEL_MULT, MOD_LESS]
5436QED
5437
5438(* Any counter-example? Theorem proved, no counter-example! *)
5439(* This is a most unexpected theorem.
5440   At first I thought it only holds for prime base b,
5441   but in HOL4 using the EVAL function shows it seems to hold for any base b.
5442   As for the proof, I don't have a clue initially.
5443   I try this idea:
5444   For a prime base b, most likely ODD b, then ODD (b ** n) and ODD (b ** m).
5445   But then EVEN (b ** m - 1), maybe ODD and EVEN will give coprime.
5446   If base b is EVEN, then EVEN (b ** n) but ODD (b ** m - 1), so this can work.
5447   However, in general ODD and EVEN do not give coprime:  gcd 6 9 = 3.
5448   Of course, if ODD and EVEN arise from powers of same base, like this theorem, then true!
5449   Actually this follows from divides_imp_coprime_with_predecessor, sort of.
5450   This success inspires the following theorem.
5451*)
5452
5453(* Theorem: 0 < b /\ 0 < m ==> coprime (b ** n) (b ** m + 1) *)
5454(* Proof:
5455   If m = n,
5456          coprime (b ** n) (b ** n + 1)
5457      <=> T                                by coprime_SUC
5458
5459   Claim: !j. j < m ==> coprime (b ** j) (b ** m + 1)
5460   Proof: b ** m
5461        = b ** (m - j + j)                 by SUB_ADD
5462        = b ** (m - j) * b ** j            by EXP_ADD
5463     Thus (b ** j) divides (b ** m)        by divides_def
5464      Now 0 < b ** m                       by EXP_POS
5465       so coprime (b ** j) (SUC (b ** m))  by divides_imp_coprime_with_successor
5466       or coprime (b ** j) (b ** m + 1)    by ADD1
5467
5468   Given 0 < m,
5469          b ** n
5470        = b ** ((n DIV m) * m + n MOD m)          by DIVISION
5471        = b ** (m * (n DIV m) + n MOD m)          by MULT_COMM
5472        = b ** (m * (n DIV m)) * b ** (n MOD m)   by EXP_ADD
5473        = (b ** m) ** (n DIV m) * b ** (n MOD m)  by EXP_EXP_MULT
5474   Let z = b ** m,
5475   Then b ** n = z ** (n DIV m) * b ** (n MOD m)
5476    and 0 < z                                     by EXP_POS
5477   Since coprime z (z + 1)                        by coprime_SUC
5478     ==> coprime (z ** (n DIV m)) (z + 1)         by coprime_exp
5479          gcd (b ** n) (b ** m + 1)
5480        = gcd (z ** (n DIV m) * b ** (n MOD m)) (z + 1)
5481        = gcd (b ** (n MOD m)) (z + 1)            by GCD_SYM, GCD_CANCEL_MULT
5482    Now (n MOD m) < m                             by MOD_LESS
5483    so apply the claim to deduce the result.
5484*)
5485Theorem coprime_power_and_power_successor:
5486    !b m n. 0 < b /\ 0 < m ==> coprime (b ** n) (b ** m + 1)
5487Proof
5488  rpt strip_tac >>
5489  `0 < b ** n /\ 0 < b ** m` by rw[EXP_POS] >>
5490  Cases_on `m = n` >-
5491  rw[coprime_SUC] >>
5492  `!j. j < m ==> coprime (b ** j) (b ** m + 1)` by
5493  (rpt strip_tac >>
5494  `b ** m = b ** (m - j + j)` by rw[] >>
5495  `_ = b ** (m - j) * b ** j` by rw[EXP_ADD] >>
5496  `(b ** j) divides (b ** m)` by metis_tac[divides_def] >>
5497  metis_tac[divides_imp_coprime_with_successor, ADD1]) >>
5498  `b ** n = b ** ((n DIV m) * m + n MOD m)` by rw[GSYM DIVISION] >>
5499  `_ = b ** (m * (n DIV m) + n MOD m)` by rw[MULT_COMM] >>
5500  `_ = b ** (m * (n DIV m)) * b ** (n MOD m)` by rw[EXP_ADD] >>
5501  `_ = (b ** m) ** (n DIV m) * b ** (n MOD m)` by rw[EXP_EXP_MULT] >>
5502  qabbrev_tac `z = b ** m` >>
5503  `coprime z (z + 1)` by rw[coprime_SUC] >>
5504  `coprime (z ** (n DIV m)) (z + 1)` by rw[coprime_exp] >>
5505  metis_tac[GCD_SYM, GCD_CANCEL_MULT, MOD_LESS]
5506QED
5507
5508(* Note:
5509> type_of ``prime``;
5510val it = ":num -> bool": hol_type
5511
5512Thus prime is also a set, or prime = {p | prime p}
5513*)
5514
5515(* Theorem: p IN prime <=> prime p *)
5516(* Proof: by IN_DEF *)
5517Theorem in_prime:
5518    !p. p IN prime <=> prime p
5519Proof
5520  rw[IN_DEF]
5521QED
5522
5523(* Theorem: PROD_SET {x} = x *)
5524(* Proof:
5525   Since FINITE {x}           by FINITE_SING
5526     PROD_SET {x}
5527   = PROD_SET (x INSERT {})   by SING_INSERT
5528   = x * PROD_SET {}          by PROD_SET_THM
5529   = x                        by PROD_SET_EMPTY
5530*)
5531Theorem PROD_SET_SING:
5532    !x. PROD_SET {x} = x
5533Proof
5534  rw[PROD_SET_THM, FINITE_SING]
5535QED
5536
5537(* Theorem: FINITE s /\ 0 NOTIN s ==> 0 < PROD_SET s *)
5538(* Proof:
5539   By FINITE_INDUCT on s.
5540   Base case: 0 NOTIN {} ==> 0 < PROD_SET {}
5541     Since PROD_SET {} = 1        by PROD_SET_THM
5542     Hence true.
5543   Step case: 0 NOTIN s ==> 0 < PROD_SET s ==>
5544              e NOTIN s /\ 0 NOTIN e INSERT s ==> 0 < PROD_SET (e INSERT s)
5545       PROD_SET (e INSERT s)
5546     = e * PROD_SET (s DELETE e)          by PROD_SET_THM
5547     = e * PROD_SET s                     by DELETE_NON_ELEMENT
5548     But e IN e INSERT s                  by COMPONENT
5549     Hence e <> 0, or 0 < e               by implication
5550     and !x. x IN s ==> x IN (e INSERT s) by IN_INSERT
5551     Thus 0 < PROD_SET s                  by induction hypothesis
5552     Henec 0 < e * PROD_SET s             by ZERO_LESS_MULT
5553*)
5554Theorem PROD_SET_NONZERO:
5555    !s. FINITE s /\ 0 NOTIN s ==> 0 < PROD_SET s
5556Proof
5557  `!s. FINITE s ==> 0 NOTIN s ==> 0 < PROD_SET s` suffices_by rw[] >>
5558  ho_match_mp_tac FINITE_INDUCT >>
5559  rpt strip_tac >-
5560  rw[PROD_SET_THM] >>
5561  fs[] >>
5562  `0 < e` by decide_tac >>
5563  `PROD_SET (e INSERT s) = e * PROD_SET (s DELETE e)` by rw[PROD_SET_THM] >>
5564  `_ = e * PROD_SET s` by metis_tac[DELETE_NON_ELEMENT] >>
5565  rw[ZERO_LESS_MULT]
5566QED
5567
5568(* Theorem: FINITE s /\ s <> {} /\ 0 NOTIN s ==>
5569            !f. INJ f s univ(:num) /\ (!x. x < f x) ==> PROD_SET s < PROD_SET (IMAGE f s) *)
5570(* Proof:
5571   By FINITE_INDUCT on s.
5572   Base case: {} <> {} ==> PROD_SET {} < PROD_SET (IMAGE f {})
5573     True since {} <> {} is false.
5574   Step case: s <> {} /\ 0 NOTIN s ==> !f. INJ f s univ(:num) ==> PROD_SET s < PROD_SET (IMAGE f s) ==>
5575              e NOTIN s /\ e INSERT s <> {} /\ 0 NOTIN e INSERT s /\ INJ f (e INSERT s) univ(:num) ==>
5576              PROD_SET (e INSERT s) < PROD_SET (IMAGE f (e INSERT s))
5577     Note INJ f (e INSERT s) univ(:num)
5578      ==> INJ f s univ(:num) /\
5579          !y. y IN s /\ (f e = f y) ==> (e = y)   by INJ_INSERT
5580     First,
5581       PROD_SET (e INSERT s)
5582     = e * PROD_SET (s DELETE e)           by PROD_SET_THM
5583     = e * PROD_SET s                      by DELETE_NON_ELEMENT
5584     Next,
5585       FINITE (IMAGE f s)                  by IMAGE_FINITE
5586       f e NOTIN IMAGE f s                 by IN_IMAGE, e NOTIN s
5587       PROD_SET (IMAGE f (e INSERT s))
5588     = f e * PROD_SET (IMAGE f s)          by PROD_SET_IMAGE_REDUCTION
5589
5590     If s = {},
5591        to show: e * PROD_SET {} < f e * PROD_SET {}    by IMAGE_EMPTY
5592        which is true since PROD_SET {} = 1             by PROD_SET_THM
5593             and e < f e                                by given
5594     If s <> {},
5595     Since e IN e INSERT s                              by COMPONENT
5596     Hence 0 < e                                        by e <> 0
5597     and !x. x IN s ==> x IN (e INSERT s)               by IN_INSERT
5598     Thus PROD_SET s < PROD_SET (IMAGE f s)             by induction hypothesis
5599       or e * PROD_SET s < e * PROD_SET (IMAGE f s)     by LT_MULT_LCANCEL, 0 < e
5600     Note 0 < PROD_SET (IMAGE f s)                      by IN_IMAGE, !x. x < f x /\ x <> 0
5601       so e * PROD_SET (IMAGE f s) < f e * PROD_SET (IMAGE f s) by LT_MULT_LCANCEL, e < f e
5602     Hence PROD_SET (e INSERT s) < PROD_SET (IMAGE f (e INSERT s))
5603*)
5604Theorem PROD_SET_LESS:
5605    !s. FINITE s /\ s <> {} /\ 0 NOTIN s ==>
5606   !f. INJ f s univ(:num) /\ (!x. x < f x) ==> PROD_SET s < PROD_SET (IMAGE f s)
5607Proof
5608  `!s. FINITE s ==> s <> {} /\ 0 NOTIN s ==>
5609    !f. INJ f s univ(:num) /\ (!x. x < f x) ==> PROD_SET s < PROD_SET (IMAGE f s)` suffices_by rw[] >>
5610  ho_match_mp_tac FINITE_INDUCT >>
5611  rpt strip_tac >-
5612  rw[] >>
5613  `PROD_SET (e INSERT s) = e * PROD_SET (s DELETE e)` by rw[PROD_SET_THM] >>
5614  `_ = e * PROD_SET s` by metis_tac[DELETE_NON_ELEMENT] >>
5615  fs[INJ_INSERT] >>
5616  `FINITE (IMAGE f s)` by rw[] >>
5617  `f e NOTIN IMAGE f s` by metis_tac[IN_IMAGE] >>
5618  `PROD_SET (IMAGE f (e INSERT s)) = f e * PROD_SET (IMAGE f s)` by rw[PROD_SET_IMAGE_REDUCTION] >>
5619  Cases_on `s = {}` >-
5620  rw[PROD_SET_SING, PROD_SET_THM] >>
5621  `0 < e` by decide_tac >>
5622  `PROD_SET s < PROD_SET (IMAGE f s)` by rw[] >>
5623  `e * PROD_SET s < e * PROD_SET (IMAGE f s)` by rw[] >>
5624  `e * PROD_SET (IMAGE f s) < (f e) * PROD_SET (IMAGE f s)` by rw[] >>
5625  `(IMAGE f (e INSERT s)) = (f e INSERT IMAGE f s)` by rw[] >>
5626  metis_tac[LESS_TRANS]
5627QED
5628
5629(* Theorem: FINITE s /\ s <> {} /\ 0 NOTIN s ==> PROD_SET s < PROD_SET (IMAGE SUC s) *)
5630(* Proof:
5631   Since !m n. SUC m = SUC n <=> m = n      by INV_SUC
5632    thus INJ INJ SUC s univ(:num)           by INJ_DEF
5633   Hence the result follows                 by PROD_SET_LESS
5634*)
5635Theorem PROD_SET_LESS_SUC:
5636    !s. FINITE s /\ s <> {} /\ 0 NOTIN s ==> PROD_SET s < PROD_SET (IMAGE SUC s)
5637Proof
5638  rpt strip_tac >>
5639  (irule PROD_SET_LESS >> simp[]) >>
5640  rw[INJ_DEF]
5641QED
5642
5643(* Theorem: FINITE s ==> !n x. x IN s /\ n divides x ==> n divides (PROD_SET s) *)
5644(* Proof:
5645   By FINITE_INDUCT on s.
5646   Base case: x IN {} /\ n divides x ==> n divides (PROD_SET {})
5647     True since x IN {} is false   by NOT_IN_EMPTY
5648   Step case: !n x. x IN s /\ n divides x ==> n divides (PROD_SET s) ==>
5649              e NOTIN s /\ x IN e INSERT s /\ n divides x ==> n divides (PROD_SET (e INSERT s))
5650       PROD_SET (e INSERT s)
5651     = e * PROD_SET (s DELETE e)   by PROD_SET_THM
5652     = e * PROD_SET s              by DELETE_NON_ELEMENT
5653     If x = e,
5654        n divides x
5655        means n divides e
5656        hence n divides PROD_SET (e INSERT s)   by DIVIDES_MULTIPLE, MULT_COMM
5657     If x <> e, x IN s             by IN_INSERT
5658        n divides (PROD_SET s)     by induction hypothesis
5659        hence n divides PROD_SET (e INSERT s)   by DIVIDES_MULTIPLE
5660*)
5661Theorem PROD_SET_DIVISORS:
5662    !s. FINITE s ==> !n x. x IN s /\ n divides x ==> n divides (PROD_SET s)
5663Proof
5664  ho_match_mp_tac FINITE_INDUCT >>
5665  rpt strip_tac >-
5666  metis_tac[NOT_IN_EMPTY] >>
5667  `PROD_SET (e INSERT s) = e * PROD_SET (s DELETE e)` by rw[PROD_SET_THM] >>
5668  `_ = e * PROD_SET s` by metis_tac[DELETE_NON_ELEMENT] >>
5669  `(x = e) \/ (x IN s)` by rw[GSYM IN_INSERT] >-
5670  metis_tac[DIVIDES_MULTIPLE, MULT_COMM] >>
5671  metis_tac[DIVIDES_MULTIPLE]
5672QED
5673
5674(* Theorem: (Generalized Euclid's Lemma)
5675            If prime p divides a PROD_SET, it divides a member of the PROD_SET.
5676            FINITE s ==> !p. prime p /\ p divides (PROD_SET s) ==> ?b. b IN s /\ p divides b *)
5677(* Proof: by induction of the PROD_SET, apply Euclid's Lemma.
5678- P_EUCLIDES;
5679> val it =
5680    |- !p a b. prime p /\ p divides (a * b) ==> p divides a \/ p divides b : thm
5681   By finite induction on s.
5682   Base case: prime p /\ p divides (PROD_SET {}) ==> F
5683     Since PROD_SET {} = 1        by PROD_SET_THM
5684       and p divides 1 <=> p = 1  by DIVIDES_ONE
5685       but prime p ==> p <> 1     by NOT_PRIME_1
5686       This gives the contradiction.
5687   Step case: FINITE s /\ (!p. prime p /\ p divides (PROD_SET s) ==> ?b. b IN s /\ p divides b) /\
5688              e NOTIN s /\ prime p /\ p divides (PROD_SET (e INSERT s)) ==>
5689              ?b. ((b = e) \/ b IN s) /\ p divides b
5690     Note PROD_SET (e INSERT s) = e * PROD_SET s   by PROD_SET_THM, DELETE_NON_ELEMENT, e NOTIN s.
5691     So prime p /\ p divides (PROD_SET (e INSERT s))
5692     ==> p divides e, or p divides (PROD_SET s)    by P_EUCLIDES
5693     If p divides e, just take b = e.
5694     If p divides (PROD_SET s), there is such b    by induction hypothesis
5695*)
5696Theorem PROD_SET_EUCLID:
5697    !s. FINITE s ==> !p. prime p /\ p divides (PROD_SET s) ==> ?b. b IN s /\ p divides b
5698Proof
5699  ho_match_mp_tac FINITE_INDUCT >>
5700  rw[] >-
5701  metis_tac[PROD_SET_EMPTY, DIVIDES_ONE, NOT_PRIME_1] >>
5702  `PROD_SET (e INSERT s) = e * PROD_SET s`
5703    by metis_tac[PROD_SET_THM, DELETE_NON_ELEMENT] >>
5704  Cases_on `p divides e` >-
5705  metis_tac[] >>
5706  metis_tac[P_EUCLIDES]
5707QED
5708
5709(* Theorem: FINITE s /\ x IN s ==> x divides PROD_SET s *)
5710(* Proof:
5711   Note !n x. x IN s /\ n divides x
5712    ==> n divides PROD_SET s           by PROD_SET_DIVISORS
5713    Put n = x, and x divides x = T     by DIVIDES_REFL
5714    and the result follows.
5715*)
5716Theorem PROD_SET_ELEMENT_DIVIDES:
5717    !s x. FINITE s /\ x IN s ==> x divides PROD_SET s
5718Proof
5719  metis_tac[PROD_SET_DIVISORS, DIVIDES_REFL]
5720QED
5721
5722(* Theorem: FINITE s ==> !f g. INJ f s univ(:num) /\ INJ g s univ(:num) /\
5723            (!x. x IN s ==> f x <= g x) ==> PROD_SET (IMAGE f s) <= PROD_SET (IMAGE g s) *)
5724(* Proof:
5725   By finite induction on s.
5726   Base: PROD_SET (IMAGE f {}) <= PROD_SET (IMAGE g {})
5727      Note PROD_SET (IMAGE f {})
5728         = PROD_SET {}              by IMAGE_EMPTY
5729         = 1                        by PROD_SET_EMPTY
5730      Thus true.
5731   Step: !f g. (!x. x IN s ==> f x <= g x) ==> PROD_SET (IMAGE f s) <= PROD_SET (IMAGE g s) ==>
5732        e NOTIN s /\ !x. x IN e INSERT s ==> f x <= g x ==>
5733        PROD_SET (IMAGE f (e INSERT s)) <= PROD_SET (IMAGE g (e INSERT s))
5734        Note INJ f s univ(:num)     by INJ_INSERT
5735         and INJ g s univ(:num)     by INJ_INSERT
5736         and f e NOTIN (IMAGE f s)  by IN_IMAGE
5737         and g e NOTIN (IMAGE g s)  by IN_IMAGE
5738       Applying LE_MONO_MULT2,
5739          PROD_SET (IMAGE f (e INSERT s))
5740        = PROD_SET (f e INSERT IMAGE f s)  by INSERT_IMAGE
5741        = f e * PROD_SET (IMAGE f s)       by PROD_SET_INSERT
5742       <= g e * PROD_SET (IMAGE f s)       by f e <= g e
5743       <= g e * PROD_SET (IMAGE g s)       by induction hypothesis
5744        = PROD_SET (g e INSERT IMAGE g s)  by PROD_SET_INSERT
5745        = PROD_SET (IMAGE g (e INSERT s))  by INSERT_IMAGE
5746*)
5747Theorem PROD_SET_LESS_EQ:
5748    !s. FINITE s ==> !f g. INJ f s univ(:num) /\ INJ g s univ(:num) /\
5749       (!x. x IN s ==> f x <= g x) ==> PROD_SET (IMAGE f s) <= PROD_SET (IMAGE g s)
5750Proof
5751  Induct_on `FINITE` >>
5752  rpt strip_tac >-
5753  rw[PROD_SET_EMPTY] >>
5754  fs[INJ_INSERT] >>
5755  `f e NOTIN (IMAGE f s)` by metis_tac[IN_IMAGE] >>
5756  `g e NOTIN (IMAGE g s)` by metis_tac[IN_IMAGE] >>
5757  `f e <= g e` by rw[] >>
5758  `PROD_SET (IMAGE f s) <= PROD_SET (IMAGE g s)` by rw[] >>
5759  rw[PROD_SET_INSERT, LE_MONO_MULT2]
5760QED
5761
5762(* Theorem: FINITE s ==> !n. (!x. x IN s ==> x <= n) ==> PROD_SET s <= n ** CARD s *)
5763(* Proof:
5764   By finite induction on s.
5765   Base: PROD_SET {} <= n ** CARD {}
5766      Note PROD_SET {}
5767         = 1             by PROD_SET_EMPTY
5768         = n ** 0        by EXP_0
5769         = n ** CARD {}  by CARD_EMPTY
5770   Step: !n. (!x. x IN s ==> x <= n) ==> PROD_SET s <= n ** CARD s ==>
5771         e NOTIN s /\ !x. x IN e INSERT s ==> x <= n ==> PROD_SET (e INSERT s) <= n ** CARD (e INSERT s)
5772      Note !x. (x = e) \/ x IN s ==> x <= n   by IN_INSERT
5773         PROD_SET (e INSERT s)
5774       = e * PROD_SET s          by PROD_SET_INSERT
5775      <= n * PROD_SET s          by e <= n
5776      <= n * (n ** CARD s)       by induction hypothesis
5777       = n ** (SUC (CARD s))     by EXP
5778       = n ** CARD (e INSERT s)  by CARD_INSERT, e NOTIN s
5779*)
5780Theorem PROD_SET_LE_CONSTANT:
5781    !s. FINITE s ==> !n. (!x. x IN s ==> x <= n) ==> PROD_SET s <= n ** CARD s
5782Proof
5783  Induct_on `FINITE` >>
5784  rpt strip_tac >-
5785  rw[PROD_SET_EMPTY, EXP_0] >>
5786  fs[] >>
5787  `e <= n /\ PROD_SET s <= n ** CARD s` by rw[] >>
5788  rw[PROD_SET_INSERT, EXP, CARD_INSERT, LE_MONO_MULT2]
5789QED
5790
5791(* Theorem: FINITE s ==> !n f g. INJ f s univ(:num) /\ INJ g s univ(:num) /\ (!x. x IN s ==> n <= f x * g x) ==>
5792            n ** CARD s <= PROD_SET (IMAGE f s) * PROD_SET (IMAGE g s) *)
5793(* Proof:
5794   By finite induction on s.
5795   Base: n ** CARD {} <= PROD_SET (IMAGE f {}) * PROD_SET (IMAGE g {})
5796      Note n ** CARD {}
5797         = n ** 0           by CARD_EMPTY
5798         = 1                by EXP_0
5799       and PROD_SET (IMAGE f {})
5800         = PROD_SET {}      by IMAGE_EMPTY
5801         = 1                by PROD_SET_EMPTY
5802   Step: !n f. INJ f s univ(:num) /\ INJ g s univ(:num) /\
5803               (!x. x IN s ==> n <= f x * g x) ==>
5804               n ** CARD s <= PROD_SET (IMAGE f s) * PROD_SET (IMAGE g s) ==>
5805         e NOTIN s /\ INJ f (e INSERT s) univ(:num) /\ INJ g (e INSERT s) univ(:num) /\
5806         !x. x IN e INSERT s ==> n <= f x * g x ==>
5807         n ** CARD (e INSERT s) <= PROD_SET (IMAGE f (e INSERT s)) * PROD_SET (IMAGE g (e INSERT s))
5808      Note INJ f s univ(:num) /\ INJ g s univ(:num)         by INJ_INSERT
5809       and f e NOTIN (IMAGE f s) /\ g e NOTIN (IMAGE g s)   by IN_IMAGE
5810         PROD_SET (IMAGE f (e INSERT s)) * PROD_SET (IMAGE g (e INSERT s))
5811       = PROD_SET (f e INSERT (IMAGE f s)) * PROD_SET (g e INSERT (IMAGE g s))   by INSERT_IMAGE
5812       = (f e * PROD_SET (IMAGE f s)) * (g e * PROD_SET (IMAGE g s))    by PROD_SET_INSERT
5813       = (f e * g e) * (PROD_SET (IMAGE f s) * PROD_SET (IMAGE g s))    by MULT_ASSOC, MULT_COMM
5814       >= n        * (PROD_SET (IMAGE f s) * PROD_SET (IMAGE g s))      by n <= f e * g e
5815       >= n        * n ** CARD s                                        by induction hypothesis
5816        = n ** (SUC (CARD s))                               by EXP
5817        = n ** (CARD (e INSERT s))                          by CARD_INSERT
5818*)
5819Theorem PROD_SET_PRODUCT_GE_CONSTANT:
5820    !s. FINITE s ==> !n f g. INJ f s univ(:num) /\ INJ g s univ(:num) /\
5821                    (!x. x IN s ==> n <= f x * g x) ==>
5822       n ** CARD s <= PROD_SET (IMAGE f s) * PROD_SET (IMAGE g s)
5823Proof
5824  Induct_on `FINITE` >>
5825  rpt strip_tac >-
5826  rw[PROD_SET_EMPTY, EXP_0] >>
5827  fs[INJ_INSERT] >>
5828  `f e NOTIN (IMAGE f s) /\ g e NOTIN (IMAGE g s)` by metis_tac[IN_IMAGE] >>
5829  `n <= f e * g e /\ n ** CARD s <= PROD_SET (IMAGE f s) * PROD_SET (IMAGE g s)` by rw[] >>
5830  `PROD_SET (f e INSERT IMAGE f s) * PROD_SET (g e INSERT IMAGE g s) =
5831    (f e * PROD_SET (IMAGE f s)) * (g e * PROD_SET (IMAGE g s))` by rw[PROD_SET_INSERT] >>
5832  `_ = (f e * g e) * (PROD_SET (IMAGE f s) * PROD_SET (IMAGE g s))` by metis_tac[MULT_ASSOC, MULT_COMM] >>
5833  metis_tac[EXP, CARD_INSERT, LE_MONO_MULT2]
5834QED
5835
5836(* ------------------------------------------------------------------------- *)
5837(* Pairwise Coprime Property                                                 *)
5838(* ------------------------------------------------------------------------- *)
5839
5840(* Overload pairwise coprime set *)
5841Overload PAIRWISE_COPRIME = ``\s. !x y. x IN s /\ y IN s /\ x <> y ==> coprime x y``
5842
5843(* Theorem: e NOTIN s /\ PAIRWISE_COPRIME (e INSERT s) ==>
5844            (!x. x IN s ==> coprime e x) /\ PAIRWISE_COPRIME s *)
5845(* Proof: by IN_INSERT *)
5846Theorem pairwise_coprime_insert:
5847    !s e. e NOTIN s /\ PAIRWISE_COPRIME (e INSERT s) ==>
5848        (!x. x IN s ==> coprime e x) /\ PAIRWISE_COPRIME s
5849Proof
5850  metis_tac[IN_INSERT]
5851QED
5852
5853(* Theorem: FINITE s /\ PAIRWISE_COPRIME s ==>
5854            !t. t SUBSET s ==> (PROD_SET t) divides (PROD_SET s) *)
5855(* Proof:
5856   Note FINITE t    by SUBSET_FINITE
5857   By finite induction on t.
5858   Base case: PROD_SET {} divides PROD_SET s
5859      Note PROD_SET {} = 1           by PROD_SET_EMPTY
5860       and 1 divides (PROD_SET s)    by ONE_DIVIDES_ALL
5861   Step case: t SUBSET s ==> PROD_SET t divides PROD_SET s ==>
5862              e NOTIN t /\ e INSERT t SUBSET s ==> PROD_SET (e INSERT t) divides PROD_SET s
5863      Let m = PROD_SET s.
5864      Note e IN s /\ t SUBSET s                      by INSERT_SUBSET
5865      Thus e divides m                               by PROD_SET_ELEMENT_DIVIDES
5866       and (PROD_SET t) divides m                    by induction hypothesis
5867      Also coprime e (PROD_SET t)                    by every_coprime_prod_set_coprime, SUBSET_DEF
5868      Note PROD_SET (e INSERT t) = e * PROD_SET t    by PROD_SET_INSERT
5869       ==> e * PROD_SET t divides m                  by coprime_product_divides
5870*)
5871Theorem pairwise_coprime_prod_set_subset_divides:
5872    !s. FINITE s /\ PAIRWISE_COPRIME s ==>
5873   !t. t SUBSET s ==> (PROD_SET t) divides (PROD_SET s)
5874Proof
5875  rpt strip_tac >>
5876  `FINITE t` by metis_tac[SUBSET_FINITE] >>
5877  qpat_x_assum `t SUBSET s` mp_tac >>
5878  qpat_x_assum `FINITE t` mp_tac >>
5879  qid_spec_tac `t` >>
5880  Induct_on `FINITE` >>
5881  rpt strip_tac >-
5882  rw[PROD_SET_EMPTY] >>
5883  fs[] >>
5884  `e divides PROD_SET s` by rw[PROD_SET_ELEMENT_DIVIDES] >>
5885  `coprime e (PROD_SET t)` by prove_tac[every_coprime_prod_set_coprime, SUBSET_DEF] >>
5886  rw[PROD_SET_INSERT, coprime_product_divides]
5887QED
5888
5889(* Theorem: FINITE s /\ PAIRWISE_COPRIME s ==>
5890            !u v. (s = u UNION v) /\ DISJOINT u v ==> coprime (PROD_SET u) (PROD_SET v) *)
5891(* Proof:
5892   By finite induction on s.
5893   Base: {} = u UNION v ==> coprime (PROD_SET u) (PROD_SET v)
5894      Note u = {} and v = {}       by EMPTY_UNION
5895       and PROD_SET {} = 1         by PROD_SET_EMPTY
5896      Hence true                   by GCD_1
5897   Step: PAIRWISE_COPRIME s ==>
5898         !u v. (s = u UNION v) /\ DISJOINT u v ==> coprime (PROD_SET u) (PROD_SET v) ==>
5899         e NOTIN s /\ e INSERT s = u UNION v ==> coprime (PROD_SET u) (PROD_SET v)
5900      Note (!x. x IN s ==> coprime e x) /\
5901           PAIRWISE_COPRIME s      by IN_INSERT
5902      Note e IN u \/ e IN v        by IN_INSERT, IN_UNION
5903      If e IN u,
5904         Then e NOTIN v            by IN_DISJOINT
5905         Let w = u DELETE e.
5906         Then e NOTIN w            by IN_DELETE
5907          and u = e INSERT w       by INSERT_DELETE
5908         Note s = w UNION v        by EXTENSION, IN_INSERT, IN_UNION
5909          ==> FINITE w             by FINITE_UNION
5910          and DISJOINT w v         by DISJOINT_INSERT
5911
5912         Note coprime (PROD_SET w) (PROD_SET v)   by induction hypothesis
5913          and !x. x IN v ==> coprime e x          by v SUBSET s
5914         Also FINITE v                            by FINITE_UNION
5915           so coprime e (PROD_SET v)              by every_coprime_prod_set_coprime, FINITE v
5916          ==> coprime (e * PROD_SET w) PROD_SET v         by coprime_product_coprime
5917           or coprime PROD_SET (e INSERT w) PROD_SET v    by PROD_SET_INSERT
5918            = coprime PROD_SET u PROD_SET v               by above
5919
5920      Similarly for e IN v.
5921*)
5922Theorem pairwise_coprime_partition_coprime:
5923    !s. FINITE s /\ PAIRWISE_COPRIME s ==>
5924   !u v. (s = u UNION v) /\ DISJOINT u v ==> coprime (PROD_SET u) (PROD_SET v)
5925Proof
5926  ntac 2 strip_tac >>
5927  qpat_x_assum `PAIRWISE_COPRIME s` mp_tac >>
5928  qpat_x_assum `FINITE s` mp_tac >>
5929  qid_spec_tac `s` >>
5930  Induct_on `FINITE` >>
5931  rpt strip_tac >-
5932  fs[PROD_SET_EMPTY] >>
5933  `(!x. x IN s ==> coprime e x) /\ PAIRWISE_COPRIME s` by metis_tac[IN_INSERT] >>
5934  `e IN u \/ e IN v` by metis_tac[IN_INSERT, IN_UNION] >| [
5935    qabbrev_tac `w = u DELETE e` >>
5936    `u = e INSERT w` by rw[Abbr`w`] >>
5937    `e NOTIN w` by rw[Abbr`w`] >>
5938    `e NOTIN v` by metis_tac[IN_DISJOINT] >>
5939    `s = w UNION v` by
5940  (rw[EXTENSION] >>
5941    metis_tac[IN_INSERT, IN_UNION]) >>
5942    `FINITE w` by metis_tac[FINITE_UNION] >>
5943    `DISJOINT w v` by metis_tac[DISJOINT_INSERT] >>
5944    `coprime (PROD_SET w) (PROD_SET v)` by rw[] >>
5945    `(!x. x IN v ==> coprime e x)` by rw[] >>
5946    `FINITE v` by metis_tac[FINITE_UNION] >>
5947    `coprime e (PROD_SET v)` by rw[every_coprime_prod_set_coprime] >>
5948    metis_tac[coprime_product_coprime, PROD_SET_INSERT],
5949    qabbrev_tac `w = v DELETE e` >>
5950    `v = e INSERT w` by rw[Abbr`w`] >>
5951    `e NOTIN w` by rw[Abbr`w`] >>
5952    `e NOTIN u` by metis_tac[IN_DISJOINT] >>
5953    `s = u UNION w` by
5954  (rw[EXTENSION] >>
5955    metis_tac[IN_INSERT, IN_UNION]) >>
5956    `FINITE w` by metis_tac[FINITE_UNION] >>
5957    `DISJOINT u w` by metis_tac[DISJOINT_INSERT, DISJOINT_SYM] >>
5958    `coprime (PROD_SET u) (PROD_SET w)` by rw[] >>
5959    `(!x. x IN u ==> coprime e x)` by rw[] >>
5960    `FINITE u` by metis_tac[FINITE_UNION] >>
5961    `coprime (PROD_SET u) e` by rw[every_coprime_prod_set_coprime, coprime_sym] >>
5962    metis_tac[coprime_product_coprime_sym, PROD_SET_INSERT]
5963  ]
5964QED
5965
5966(* Theorem: FINITE s /\ PAIRWISE_COPRIME s ==> !u v. (s = u UNION v) /\ DISJOINT u v ==>
5967            (PROD_SET s = PROD_SET u * PROD_SET v) /\ (coprime (PROD_SET u) (PROD_SET v)) *)
5968(* Proof: by PROD_SET_PRODUCT_BY_PARTITION, pairwise_coprime_partition_coprime *)
5969Theorem pairwise_coprime_prod_set_partition:
5970    !s. FINITE s /\ PAIRWISE_COPRIME s ==> !u v. (s = u UNION v) /\ DISJOINT u v ==>
5971       (PROD_SET s = PROD_SET u * PROD_SET v) /\ (coprime (PROD_SET u) (PROD_SET v))
5972Proof
5973  metis_tac[PROD_SET_PRODUCT_BY_PARTITION, pairwise_coprime_partition_coprime]
5974QED
5975
5976(* Theorem: n! = PROD_SET (count (n+1))  *)
5977(* Proof: by induction on n.
5978   Base case: FACT 0 = PROD_SET (IMAGE SUC (count 0))
5979     LHS = FACT 0
5980         = 1                               by FACT
5981         = PROD_SET {}                     by PROD_SET_THM
5982         = PROD_SET (IMAGE SUC {})         by IMAGE_EMPTY
5983         = PROD_SET (IMAGE SUC (count 0))  by COUNT_ZERO
5984         = RHS
5985   Step case: FACT n = PROD_SET (IMAGE SUC (count n)) ==>
5986              FACT (SUC n) = PROD_SET (IMAGE SUC (count (SUC n)))
5987     Note: (SUC n) NOTIN (IMAGE SUC (count n))  by IN_IMAGE, IN_COUNT [1]
5988     LHS = FACT (SUC n)
5989         = (SUC n) * (FACT n)                            by FACT
5990         = (SUC n) * (PROD_SET (IMAGE SUC (count n)))    by induction hypothesis
5991         = (SUC n) * (PROD_SET (IMAGE SUC (count n)) DELETE (SUC n))         by DELETE_NON_ELEMENT, [1]
5992         = PROD_SET ((SUC n) INSERT ((IMAGE SUC (count n)) DELETE (SUC n)))  by PROD_SET_THM
5993         = PROD_SET (IMAGE SUC (n INSERT (count n)))     by IMAGE_INSERT
5994         = PROD_SET (IMAGE SUC (count (SUC n)))          by COUNT_SUC
5995         = RHS
5996*)
5997Theorem FACT_EQ_PROD:
5998    !n. FACT n = PROD_SET (IMAGE SUC (count n))
5999Proof
6000  Induct_on `n` >-
6001  rw[PROD_SET_THM, FACT] >>
6002  rw[PROD_SET_THM, FACT, COUNT_SUC] >>
6003  `(SUC n) NOTIN (IMAGE SUC (count n))` by rw[] >>
6004  metis_tac[DELETE_NON_ELEMENT]
6005QED
6006
6007(* Theorem: n!/m! = product of (m+1) to n.
6008            m < n ==> (FACT n = PROD_SET (IMAGE SUC ((count n) DIFF (count m))) * (FACT m)) *)
6009(* Proof: by factorial formula.
6010   By induction on n.
6011   Base case: m < 0 ==> ...
6012     True since m < 0 = F.
6013   Step case: !m. m < n ==>
6014              (FACT n = PROD_SET (IMAGE SUC (count n DIFF count m)) * FACT m) ==>
6015              !m. m < SUC n ==>
6016              (FACT (SUC n) = PROD_SET (IMAGE SUC (count (SUC n) DIFF count m)) * FACT m)
6017     Note that m < SUC n ==> m <= n.
6018      and FACT (SUC n) = (SUC n) * FACT n     by FACT
6019     If m = n,
6020        PROD_SET (IMAGE SUC (count (SUC n) DIFF count n)) * FACT n
6021      = PROD_SET (IMAGE SUC {n}) * FACT n     by IN_DIFF, IN_COUNT
6022      = PROD_SET {SUC n} * FACT n             by IN_IMAGE
6023      = (SUC n) * FACT n                      by PROD_SET_THM
6024     If m < n,
6025        n NOTIN (count m)                     by IN_COUNT
6026     so n INSERT ((count n) DIFF (count m))
6027      = (n INSERT (count n)) DIFF (count m)   by INSERT_DIFF
6028      = count (SUC n) DIFF (count m)          by EXTENSION
6029     Since (SUC n) NOTIN (IMAGE SUC ((count n) DIFF (count m)))  by IN_IMAGE, IN_DIFF, IN_COUNT
6030       and FINITE (IMAGE SUC ((count n) DIFF (count m)))         by IMAGE_FINITE, FINITE_DIFF, FINITE_COUNT
6031     Hence PROD_SET (IMAGE SUC (count (SUC n) DIFF count m)) * FACT m
6032         = ((SUC n) * PROD_SET (IMAGE SUC (count n DIFF count m))) * FACT m   by PROD_SET_IMAGE_REDUCTION
6033         = (SUC n) * (PROD_SET (IMAGE SUC (count n DIFF count m))) * FACT m)  by MULT_ASSOC
6034         = (SUC n) * FACT n                                      by induction hypothesis
6035         = FACT (SUC n)                                          by FACT
6036*)
6037Theorem FACT_REDUCTION:
6038    !n m. m < n ==> (FACT n = PROD_SET (IMAGE SUC ((count n) DIFF (count m))) * (FACT m))
6039Proof
6040  Induct_on `n` >-
6041  rw[] >>
6042  rw_tac std_ss[FACT] >>
6043  `m <= n` by decide_tac >>
6044  Cases_on `m = n` >| [
6045    rw_tac std_ss[] >>
6046    `count (SUC m) DIFF count m = {m}` by
6047  (rw[DIFF_DEF] >>
6048    rw[EXTENSION, EQ_IMP_THM]) >>
6049    `PROD_SET (IMAGE SUC {m}) = SUC m` by rw[PROD_SET_THM] >>
6050    metis_tac[],
6051    `m < n` by decide_tac >>
6052    `n NOTIN (count m)` by srw_tac[ARITH_ss][] >>
6053    `n INSERT ((count n) DIFF (count m)) = (n INSERT (count n)) DIFF (count m)` by rw[] >>
6054    `_ = count (SUC n) DIFF (count m)` by srw_tac[ARITH_ss][EXTENSION] >>
6055    `(SUC n) NOTIN (IMAGE SUC ((count n) DIFF (count m)))` by rw[] >>
6056    `FINITE (IMAGE SUC ((count n) DIFF (count m)))` by rw[] >>
6057    metis_tac[PROD_SET_IMAGE_REDUCTION, MULT_ASSOC]
6058  ]
6059QED
6060
6061(* ------------------------------------------------------------------------- *)
6062(* Logic Theorems.                                                           *)
6063(* ------------------------------------------------------------------------- *)
6064
6065(* Theorem: (A <=> B) <=> (A ==> B) /\ ((A ==> B) ==> (B ==> A)) *)
6066(* Proof: by logic. *)
6067Theorem EQ_IMP2_THM:
6068    !A B. (A <=> B) <=> (A ==> B) /\ ((A ==> B) ==> (B ==> A))
6069Proof
6070  metis_tac[]
6071QED
6072
6073(* Theorem: (b1 = b2) ==> (f b1 = f b2) *)
6074(* Proof: by substitution. *)
6075Theorem BOOL_EQ:
6076    !b1:bool b2:bool f. (b1 = b2) ==> (f b1 = f b2)
6077Proof
6078  simp[]
6079QED
6080
6081(* Theorem: b /\ (c ==> d) ==> ((b ==> c) ==> d) *)
6082(* Proof: by logical implication. *)
6083Theorem AND_IMP_IMP:
6084    !b c d. b /\ (c ==> d) ==> ((b ==> c) ==> d)
6085Proof
6086  metis_tac[]
6087QED
6088
6089(* Theorem: p /\ q ==> p \/ ~q *)
6090(* Proof:
6091   Note p /\ q ==> p          by AND1_THM
6092    and p ==> p \/ ~q         by OR_INTRO_THM1
6093   Thus p /\ q ==> p \/ ~q
6094*)
6095Theorem AND_IMP_OR_NEG:
6096    !p q. p /\ q ==> p \/ ~q
6097Proof
6098  metis_tac[]
6099QED
6100
6101(* Theorem: (p \/ q ==> r) ==> (p /\ ~q ==> r) *)
6102(* Proof:
6103       (p \/ q) ==> r
6104     = ~(p \/ q) \/ r      by IMP_DISJ_THM
6105     = (~p /\ ~q) \/ r     by DE_MORGAN_THM
6106   ==> (~p \/ q) \/ r      by AND_IMP_OR_NEG
6107     = ~(p /\ ~q) \/ r     by DE_MORGAN_THM
6108     = (p /\ ~q) ==> r     by IMP_DISJ_THM
6109*)
6110Theorem OR_IMP_IMP:
6111    !p q r. ((p \/ q) ==> r) ==> ((p /\ ~q) ==> r)
6112Proof
6113  metis_tac[]
6114QED
6115
6116(* Theorem: x IN (if b then s else t) <=> if b then x IN s else x IN t *)
6117(* Proof: by boolTheory.COND_RAND:
6118   |- !f b x y. f (if b then x else y) = if b then f x else f y
6119*)
6120Theorem PUSH_IN_INTO_IF:
6121    !b x s t. x IN (if b then s else t) <=> if b then x IN s else x IN t
6122Proof
6123  rw_tac std_ss[]
6124QED
6125
6126(* ------------------------------------------------------------------------- *)
6127(* More Theorems and Sets for Counting                                       *)
6128(* ------------------------------------------------------------------------- *)
6129
6130(* Have simple (count n) *)
6131
6132(* Theorem: count 1 = {0} *)
6133(* Proof: rename COUNT_ZERO *)
6134Theorem COUNT_0 = COUNT_ZERO;
6135(* val COUNT_0 = |- count 0 = {}: thm *)
6136
6137(* Theorem: count 1 = {0} *)
6138(* Proof: by count_def, EXTENSION *)
6139Theorem COUNT_1:
6140    count 1 = {0}
6141Proof
6142  rw[count_def, EXTENSION]
6143QED
6144
6145(* Theorem: n NOTIN (count n) *)
6146(* Proof: by IN_COUNT *)
6147Theorem COUNT_NOT_SELF:
6148    !n. n NOTIN (count n)
6149Proof
6150  rw[]
6151QED
6152
6153(* Theorem: m <= n ==> count m SUBSET count n *)
6154(* Proof: by LENGTH_TAKE_EQ *)
6155Theorem COUNT_SUBSET:
6156    !m n. m <= n ==> count m SUBSET count n
6157Proof
6158  rw[SUBSET_DEF]
6159QED
6160
6161(* Theorem: count (SUC n) SUBSET t <=> count n SUBSET t /\ n IN t *)
6162(* Proof:
6163       count (SUC n) SUBSET t
6164   <=> (n INSERT count n) SUBSET t     by COUNT_SUC
6165   <=> n IN t /\ (count n) SUBSET t    by INSERT_SUBSET
6166   <=> (count n) SUBSET t /\ n IN t    by CONJ_COMM
6167*)
6168Theorem COUNT_SUC_SUBSET:
6169    !n t. count (SUC n) SUBSET t <=> count n SUBSET t /\ n IN t
6170Proof
6171  metis_tac[COUNT_SUC, INSERT_SUBSET]
6172QED
6173
6174(* Theorem: t DIFF (count (SUC n)) = t DIFF (count n) DELETE n *)
6175(* Proof:
6176     t DIFF (count (SUC n))
6177   = t DIFF (n INSERT count n)    by COUNT_SUC
6178   = t DIFF (count n) DELETE n    by EXTENSION
6179*)
6180Theorem DIFF_COUNT_SUC:
6181    !n t. t DIFF (count (SUC n)) = t DIFF (count n) DELETE n
6182Proof
6183  rw[EXTENSION, EQ_IMP_THM]
6184QED
6185
6186(* COUNT_SUC  |- !n. count (SUC n) = n INSERT count n *)
6187
6188(* Theorem: count (SUC n) = 0 INSERT (IMAGE SUC (count n)) *)
6189(* Proof: by EXTENSION *)
6190Theorem COUNT_SUC_BY_SUC:
6191    !n. count (SUC n) = 0 INSERT (IMAGE SUC (count n))
6192Proof
6193  rw[EXTENSION, EQ_IMP_THM] >>
6194  (Cases_on `x` >> simp[])
6195QED
6196
6197(* Theorem: IMAGE f (count (SUC n)) = (f n) INSERT IMAGE f (count n) *)
6198(* Proof:
6199     IMAGE f (count (SUC n))
6200   = IMAGE f (n INSERT (count n))    by COUNT_SUC
6201   = f n INSERT IMAGE f (count n)    by IMAGE_INSERT
6202*)
6203Theorem IMAGE_COUNT_SUC:
6204    !f n. IMAGE f (count (SUC n)) = (f n) INSERT IMAGE f (count n)
6205Proof
6206  rw[COUNT_SUC]
6207QED
6208
6209(* Theorem: IMAGE f (count (SUC n)) = (f 0) INSERT IMAGE (f o SUC) (count n) *)
6210(* Proof:
6211     IMAGE f (count (SUC n))
6212   = IMAGE f (0 INSERT (IMAGE SUC (count n)))    by COUNT_SUC_BY_SUC
6213   = f 0 INSERT IMAGE f (IMAGE SUC (count n))    by IMAGE_INSERT
6214   = f 0 INSERT IMAGE (f o SUC) (count n)        by IMAGE_COMPOSE
6215*)
6216Theorem IMAGE_COUNT_SUC_BY_SUC:
6217    !f n. IMAGE f (count (SUC n)) = (f 0) INSERT IMAGE (f o SUC) (count n)
6218Proof
6219  rw[COUNT_SUC_BY_SUC, IMAGE_COMPOSE]
6220QED
6221
6222(* Introduce countFrom m n, the set {m, m + 1, m + 2, ...., m + n - 1} *)
6223Overload countFrom = ``\m n. IMAGE ($+ m) (count n)``
6224
6225(* Theorem: countFrom m 0 = {} *)
6226(* Proof:
6227     countFrom m 0
6228   = IMAGE ($+ m) (count 0)     by notation
6229   = IMAGE ($+ m) {}            by COUNT_0
6230   = {}                         by IMAGE_EMPTY
6231*)
6232Theorem countFrom_0:
6233    !m. countFrom m 0 = {}
6234Proof
6235  rw[]
6236QED
6237
6238(* Theorem: countFrom m (SUC n) = m INSERT countFrom (m + 1) n *)
6239(* Proof: by IMAGE_COUNT_SUC_BY_SUC *)
6240Theorem countFrom_SUC:
6241    !m n. !m n. countFrom m (SUC n) = m INSERT countFrom (m + 1) n
6242Proof
6243  rpt strip_tac >>
6244  `$+ m o SUC = $+ (m + 1)` by rw[FUN_EQ_THM] >>
6245  rw[IMAGE_COUNT_SUC_BY_SUC]
6246QED
6247
6248(* Theorem: 0 < n ==> m IN countFrom m n *)
6249(* Proof: by IN_COUNT *)
6250Theorem countFrom_first:
6251    !m n. 0 < n ==> m IN countFrom m n
6252Proof
6253  rw[] >>
6254  metis_tac[ADD_0]
6255QED
6256
6257(* Theorem: x < m ==> x NOTIN countFrom m n *)
6258(* Proof: by IN_COUNT *)
6259Theorem countFrom_less:
6260    !m n x. x < m ==> x NOTIN countFrom m n
6261Proof
6262  rw[]
6263QED
6264
6265(* Theorem: count n = countFrom 0 n *)
6266(* Proof: by EXTENSION *)
6267Theorem count_by_countFrom:
6268    !n. count n = countFrom 0 n
6269Proof
6270  rw[EXTENSION]
6271QED
6272
6273(* Theorem: count (SUC n) = 0 INSERT countFrom 1 n *)
6274(* Proof:
6275      count (SUC n)
6276   = 0 INSERT IMAGE SUC (count n)     by COUNT_SUC_BY_SUC
6277   = 0 INSERT IMAGE ($+ 1) (count n)  by FUN_EQ_THM
6278   = 0 INSERT countFrom 1 n           by notation
6279*)
6280Theorem count_SUC_by_countFrom:
6281    !n. count (SUC n) = 0 INSERT countFrom 1 n
6282Proof
6283  rpt strip_tac >>
6284  `SUC = $+ 1` by rw[FUN_EQ_THM] >>
6285  rw[COUNT_SUC_BY_SUC]
6286QED
6287
6288(* Inclusion-Exclusion for two sets:
6289
6290CARD_UNION
6291|- !s. FINITE s ==> !t. FINITE t ==>
6292       (CARD (s UNION t) + CARD (s INTER t) = CARD s + CARD t)
6293CARD_UNION_EQN
6294|- !s t. FINITE s /\ FINITE t ==>
6295         (CARD (s UNION t) = CARD s + CARD t - CARD (s INTER t))
6296CARD_UNION_DISJOINT
6297|- !s t. FINITE s /\ FINITE t /\ DISJOINT s t ==>
6298         (CARD (s UNION t) = CARD s + CARD t)
6299*)
6300
6301(* Inclusion-Exclusion for three sets. *)
6302
6303(* Theorem: FINITE a /\ FINITE b /\ FINITE c ==>
6304            (CARD (a UNION b UNION c) =
6305             CARD a + CARD b + CARD c + CARD (a INTER b INTER c) -
6306             CARD (a INTER b) - CARD (b INTER c) - CARD (a INTER c)) *)
6307(* Proof:
6308   Note FINITE (a UNION b)                            by FINITE_UNION
6309    and FINITE (a INTER c)                            by FINITE_INTER
6310    and FINITE (b INTER c)                            by FINITE_INTER
6311   Also (a INTER c) INTER (b INTER c)
6312       = a INTER b INTER c                            by EXTENSION
6313    and CARD (a INTER b) <= CARD a                    by CARD_INTER_LESS_EQ
6314    and CARD (a INTER b INTER c) <= CARD (b INTER c)  by CARD_INTER_LESS_EQ, INTER_COMM
6315
6316        CARD (a UNION b UNION c)
6317      = CARD (a UNION b) + CARD c - CARD ((a UNION b) INTER c)
6318                                                      by CARD_UNION_EQN
6319      = (CARD a + CARD b - CARD (a INTER b)) +
6320         CARD c - CARD ((a UNION b) INTER c)          by CARD_UNION_EQN
6321      = (CARD a + CARD b - CARD (a INTER b)) +
6322         CARD c - CARD ((a INTER c) UNION (b INTER c))
6323                                                      by UNION_OVER_INTER
6324      = (CARD a + CARD b - CARD (a INTER b)) + CARD c -
6325        (CARD (a INTER c) + CARD (b INTER c) - CARD ((a INTER c) INTER (b INTER c)))
6326                                                      by CARD_UNION_EQN
6327      = CARD a + CARD b + CARD c - CARD (a INTER b) -
6328        (CARD (a INTER c) + CARD (b INTER c) - CARD (a INTER b INTER c))
6329                                                      by CARD (a INTER b) <= CARD a
6330      = CARD a + CARD b + CARD c - CARD (a INTER b) -
6331        (CARD (b INTER c) + CARD (a INTER c) - CARD (a INTER b INTER c))
6332                                                      by ADD_COMM
6333      = CARD a + CARD b + CARD c - CARD (a INTER b)
6334        + CARD (a INTER b INTER c) - CARD (b INTER c) - CARD (a INTER c)
6335                                                      by CARD (a INTER b INTER c) <= CARD (b INTER c)
6336      = CARD a + CARD b + CARD c + CARD (a INTER b INTER c)
6337        - CARD (a INTER b) - CARD (b INTER c) - CARD (a INTER c)
6338                                                      by arithmetic
6339*)
6340Theorem CARD_UNION_3_EQN:
6341  !a b c. FINITE a /\ FINITE b /\ FINITE c ==>
6342          (CARD (a UNION b UNION c) =
6343           CARD a + CARD b + CARD c + CARD (a INTER b INTER c) -
6344           CARD (a INTER b) - CARD (b INTER c) - CARD (a INTER c))
6345Proof
6346  rpt strip_tac >>
6347  `FINITE (a UNION b) /\ FINITE (a INTER c) /\ FINITE (b INTER c)` by rw[] >>
6348  (`(a INTER c) INTER (b INTER c) = a INTER b INTER c` by (rw[EXTENSION] >> metis_tac[])) >>
6349  `CARD (a INTER b) <= CARD a` by rw[CARD_INTER_LESS_EQ] >>
6350  `CARD (a INTER b INTER c) <= CARD (b INTER c)` by metis_tac[INTER_COMM, CARD_INTER_LESS_EQ] >>
6351  `CARD (a UNION b UNION c)
6352      = CARD (a UNION b) + CARD c - CARD ((a UNION b) INTER c)` by rw[CARD_UNION_EQN] >>
6353  `_ = (CARD a + CARD b - CARD (a INTER b)) +
6354         CARD c - CARD ((a UNION b) INTER c)` by rw[CARD_UNION_EQN] >>
6355  `_ = (CARD a + CARD b - CARD (a INTER b)) +
6356         CARD c - CARD ((a INTER c) UNION (b INTER c))` by fs[UNION_OVER_INTER, INTER_COMM] >>
6357  `_ = (CARD a + CARD b - CARD (a INTER b)) + CARD c -
6358        (CARD (a INTER c) + CARD (b INTER c) - CARD (a INTER b INTER c))` by metis_tac[CARD_UNION_EQN] >>
6359  decide_tac
6360QED
6361
6362(* Simplification of the above result for 3 disjoint sets. *)
6363
6364(* Theorem: FINITE a /\ FINITE b /\ FINITE c /\
6365            DISJOINT a b /\ DISJOINT b c /\ DISJOINT a c ==>
6366            (CARD (a UNION b UNION c) = CARD a + CARD b + CARD c) *)
6367(* Proof: by DISJOINT_DEF, CARD_UNION_3_EQN *)
6368Theorem CARD_UNION_3_DISJOINT:
6369  !a b c. FINITE a /\ FINITE b /\ FINITE c /\
6370           DISJOINT a b /\ DISJOINT b c /\ DISJOINT a c ==>
6371           (CARD (a UNION b UNION c) = CARD a + CARD b + CARD c)
6372Proof
6373  rw[DISJOINT_DEF] >>
6374  rw[CARD_UNION_3_EQN]
6375QED
6376
6377(* ------------------------------------------------------------------------- *)
6378(* Maximum and Minimum of a Set                                              *)
6379(* ------------------------------------------------------------------------- *)
6380
6381(* Theorem: FINITE s /\ s <> {} /\ s <> {MIN_SET s} ==> (MAX_SET (s DELETE (MIN_SET s)) = MAX_SET s) *)
6382(* Proof:
6383   Let m = MIN_SET s, t = s DELETE m.
6384    Then t SUBSET s              by DELETE_SUBSET
6385      so FINITE t                by SUBSET_FINITE]);
6386   Since m IN s                  by MIN_SET_IN_SET
6387      so t <> {}                 by DELETE_EQ_SING, s <> {m}
6388     ==> ?x. x IN t              by MEMBER_NOT_EMPTY
6389     and x IN s /\ x <> m        by IN_DELETE
6390    From x IN s ==> m <= x       by MIN_SET_PROPERTY
6391    With x <> m ==> m < x        by LESS_OR_EQ
6392    Also x <= MAX_SET s          by MAX_SET_PROPERTY
6393    Thus MAX_SET s <> m          since m < x <= MAX_SET s
6394     But MAX_SET s IN s          by MAX_SET_IN_SET
6395    Thus MAX_SET s IN t          by IN_DELETE
6396     Now !y. y IN t ==>
6397             y IN s              by SUBSET_DEF
6398          or y <= MAX_SET s      by MAX_SET_PROPERTY
6399   Hence MAX_SET s = MAX_SET t   by MAX_SET_TEST
6400*)
6401Theorem MAX_SET_DELETE:
6402    !s. FINITE s /\ s <> {} /\ s <> {MIN_SET s} ==> (MAX_SET (s DELETE (MIN_SET s)) = MAX_SET s)
6403Proof
6404  rpt strip_tac >>
6405  qabbrev_tac `m = MIN_SET s` >>
6406  qabbrev_tac `t = s DELETE m` >>
6407  `t SUBSET s` by rw[Abbr`t`] >>
6408  `FINITE t` by metis_tac[SUBSET_FINITE] >>
6409  `t <> {}` by metis_tac[MIN_SET_IN_SET, DELETE_EQ_SING] >>
6410  `?x. x IN t /\ x IN s /\ x <> m` by metis_tac[IN_DELETE, MEMBER_NOT_EMPTY] >>
6411  `m <= x` by rw[MIN_SET_PROPERTY, Abbr`m`] >>
6412  `m < x` by decide_tac >>
6413  `x <= MAX_SET s` by rw[MAX_SET_PROPERTY] >>
6414  `MAX_SET s <> m` by decide_tac >>
6415  `MAX_SET s IN t` by rw[MAX_SET_IN_SET, Abbr`t`] >>
6416  metis_tac[SUBSET_DEF, MAX_SET_PROPERTY, MAX_SET_TEST]
6417QED
6418
6419(* Theorem: MAX_SET (IMAGE SUC (count n)) = n *)
6420(* Proof:
6421   By induction on n.
6422   Base case: MAX_SET (IMAGE SUC (count 0)) = 0
6423      LHS = MAX_SET (IMAGE SUC (count 0))
6424          = MAX_SET (IMAGE SUC {})       by COUNT_ZERO
6425          = MAX_SET {}                   by IMAGE_EMPTY
6426          = 0                            by MAX_SET_THM
6427          = RHS
6428   Step case: MAX_SET (IMAGE SUC (count n)) = n ==>
6429              MAX_SET (IMAGE SUC (count (SUC n))) = SUC n
6430      LHS = MAX_SET (IMAGE SUC (count (SUC n)))
6431          = MAX_SET (IMAGE SUC (n INSERT count n))           by COUNT_SUC
6432          = MAX_SET ((SUC n) INSERT (IMAGE SUC (count n)))   by IMAGE_INSERT
6433          = MAX (SUC n) (MAX_SET (IMAGE SUC (count n)))      by MAX_SET_THM
6434          = MAX (SUC n) n                                    by induction hypothesis
6435          = SUC n                                            by LESS_SUC, MAX_DEF
6436          = RHS
6437*)
6438Theorem MAX_SET_IMAGE_SUC_COUNT:
6439  !n. MAX_SET (IMAGE SUC (count n)) = n
6440Proof
6441  Induct_on ‘n’ >-
6442  rw[] >>
6443  ‘MAX_SET (IMAGE SUC (count (SUC n))) =
6444   MAX_SET (IMAGE SUC (n INSERT count n))’ by rw[COUNT_SUC] >>
6445  ‘_ = MAX_SET ((SUC n) INSERT (IMAGE SUC (count n)))’ by rw[] >>
6446  ‘_ = MAX (SUC n) (MAX_SET (IMAGE SUC (count n)))’ by rw[MAX_SET_THM] >>
6447  ‘_ = MAX (SUC n) n’ by rw[] >>
6448  ‘_ = SUC n’ by metis_tac[LESS_SUC, MAX_DEF, MAX_COMM] >>
6449  rw[]
6450QED
6451
6452(* Theorem: HALF x <= c ==> f x <= MAX_SET {f x | HALF x <= c} *)
6453(* Proof:
6454   Let s = {f x | HALF x <= c}
6455   Note !x. HALF x <= c
6456    ==> SUC (2 * HALF x) <= SUC (2 * c)         by arithmetic
6457    and x <= SUC (2 * HALF x)                   by TWO_HALF_LE_THM
6458     so x <= SUC (2 * c) < 2 * c + 2            by arithmetic
6459   Thus s SUBSET (IMAGE f (count (2 * c + 2)))  by SUBSET_DEF
6460   Note FINITE (count (2 * c + 2))              by FINITE_COUNT
6461     so FINITE s                                by IMAGE_FINITE, SUBSET_FINITE
6462    and f x IN s                                by HALF x <= c
6463   Thus f x <= MAX_SET s                        by MAX_SET_PROPERTY
6464*)
6465Theorem MAX_SET_IMAGE_with_HALF:
6466    !f c x. HALF x <= c ==> f x <= MAX_SET {f x | HALF x <= c}
6467Proof
6468  rpt strip_tac >>
6469  qabbrev_tac `s = {f x | HALF x <= c}` >>
6470  `s SUBSET (IMAGE f (count (2 * c + 2)))` by
6471  (rw[SUBSET_DEF, Abbr`s`] >>
6472  `SUC (2 * HALF x'') <= SUC (2 * c)` by rw[] >>
6473  `x'' <= SUC (2 * HALF x'')` by rw[TWO_HALF_LE_THM] >>
6474  `x'' < 2 * c + 2` by decide_tac >>
6475  metis_tac[]) >>
6476  `FINITE s` by metis_tac[FINITE_COUNT, IMAGE_FINITE, SUBSET_FINITE] >>
6477  (`f x IN s` by (rw[Abbr`s`] >> metis_tac[])) >>
6478  rw[MAX_SET_PROPERTY]
6479QED
6480
6481(*
6482Note: A more general version, replacing HALF x by g x, would be desirable.
6483However, there is no way to show FINITE s for arbitrary g x.
6484*)
6485
6486(* Theorem: 0 < b /\ x DIV b <= c ==> f x <= MAX_SET {f x | x DIV b <= c} *)
6487(* Proof:
6488   Let s = {f x | x DIV b <= c}.
6489   Note !x. x DIV b <= c
6490    ==> b * SUC (x DIV b) <= b * SUC c          by arithmetic
6491    and x < b * SUC (x DIV b)                   by DIV_MULT_LESS_EQ, 0 < b
6492     so x < b * SUC c                           by arithmetic
6493   Thus s SUBSET (IMAGE f (count (b * SUC c)))  by SUBSET_DEF
6494   Note FINITE (count (b * SUC c))              by FINITE_COUNT
6495     so FINITE s                                by IMAGE_FINITE, SUBSET_FINITE
6496    and f x IN s                                by HALF x <= c
6497   Thus f x <= MAX_SET s                        by MAX_SET_PROPERTY
6498*)
6499Theorem MAX_SET_IMAGE_with_DIV:
6500    !f b c x. 0 < b /\ x DIV b <= c ==> f x <= MAX_SET {f x | x DIV b <= c}
6501Proof
6502  rpt strip_tac >>
6503  qabbrev_tac `s = {f x | x DIV b <= c}` >>
6504  `s SUBSET (IMAGE f (count (b * SUC c)))` by
6505  (rw[SUBSET_DEF, Abbr`s`] >>
6506  `b * SUC (x'' DIV b) <= b * SUC c` by rw[] >>
6507  `x'' < b * SUC (x'' DIV b)` by rw[DIV_MULT_LESS_EQ] >>
6508  `x'' < b * SUC c` by decide_tac >>
6509  metis_tac[]) >>
6510  `FINITE s` by metis_tac[FINITE_COUNT, IMAGE_FINITE, SUBSET_FINITE] >>
6511  (`f x IN s` by (rw[Abbr`s`] >> metis_tac[])) >>
6512  rw[MAX_SET_PROPERTY]
6513QED
6514
6515(* Theorem: x - b <= c ==> f x <= MAX_SET {f x | x - b <= c} *)
6516(* Proof:
6517   Let s = {f x | x - b <= c}
6518   Note !x. x - b <= c ==> x <= b + c           by arithmetic
6519     so x <= 1 + b + c                          by arithmetic
6520   Thus s SUBSET (IMAGE f (count (1 + b + c)))  by SUBSET_DEF
6521   Note FINITE (count (1 + b + c))              by FINITE_COUNT
6522     so FINITE s                                by IMAGE_FINITE, SUBSET_FINITE
6523    and f x IN s                                by x - b <= c
6524   Thus f x <= MAX_SET s                        by MAX_SET_PROPERTY
6525*)
6526Theorem MAX_SET_IMAGE_with_DEC:
6527    !f b c x. x - b <= c ==> f x <= MAX_SET {f x | x - b <= c}
6528Proof
6529  rpt strip_tac >>
6530  qabbrev_tac `s = {f x | x - b <= c}` >>
6531  `s SUBSET (IMAGE f (count (1 + b + c)))` by
6532  (rw[SUBSET_DEF, Abbr`s`] >>
6533  `x'' < b + (c + 1)` by decide_tac >>
6534  metis_tac[]) >>
6535  `FINITE s` by metis_tac[FINITE_COUNT, IMAGE_FINITE, SUBSET_FINITE] >>
6536  `f x IN s` by
6537    (rw[Abbr`s`] >>
6538  `x <= b + c` by decide_tac >>
6539  metis_tac[]) >>
6540  rw[MAX_SET_PROPERTY]
6541QED
6542
6543(* ------------------------------------------------------------------------- *)
6544(* Finite and Cardinality Theorems                                           *)
6545(* ------------------------------------------------------------------------- *)
6546
6547
6548(* Theorem: INJ f s UNIV /\ FINITE s ==> CARD (IMAGE f s) = CARD s *)
6549(* Proof:
6550   !x y. x IN s /\ y IN s /\ f x = f y == x = y   by INJ_DEF
6551   FINITE s ==> FINITE (IMAGE f s)                by IMAGE_FINITE
6552   Therefore   BIJ f s (IMAGE f s)                by BIJ_DEF, INJ_DEF, SURJ_DEF
6553   Hence       CARD (IMAGE f s) = CARD s          by FINITE_BIJ_CARD_EQ
6554*)
6555Theorem INJ_CARD_IMAGE_EQN:
6556    !f s. INJ f s UNIV /\ FINITE s ==> (CARD (IMAGE f s) = CARD s)
6557Proof
6558  rw[INJ_DEF] >>
6559  `FINITE (IMAGE f s)` by rw[IMAGE_FINITE] >>
6560  `BIJ f s (IMAGE f s)` by rw[BIJ_DEF, INJ_DEF, SURJ_DEF] >>
6561  metis_tac[FINITE_BIJ_CARD_EQ]
6562QED
6563
6564
6565(* Theorem: FINTIE s /\ FINITE t /\ CARD s = CARD t /\ INJ f s t ==> SURJ f s t *)
6566(* Proof:
6567   For any map f from s to t,
6568   (IMAGE f s) SUBSET t            by IMAGE_SUBSET_TARGET
6569   FINITE s ==> FINITE (IMAGE f s) by IMAGE_FINITE
6570   CARD (IMAGE f s) = CARD s       by INJ_CARD_IMAGE
6571                    = CARD t       by given
6572   Hence (IMAGE f s) = t           by SUBSET_EQ_CARD, FINITE t
6573   or SURJ f s t                   by IMAGE_SURJ
6574*)
6575Theorem FINITE_INJ_AS_SURJ:
6576    !f s t. INJ f s t /\ FINITE s /\ FINITE t /\ (CARD s = CARD t) ==> SURJ f s t
6577Proof
6578  rw[INJ_DEF] >>
6579  `(IMAGE f s) SUBSET t` by rw[GSYM IMAGE_SUBSET_TARGET] >>
6580  `FINITE (IMAGE f s)` by rw[IMAGE_FINITE] >>
6581  `CARD (IMAGE f s) = CARD t` by metis_tac[INJ_DEF, INJ_CARD_IMAGE, INJ_SUBSET, SUBSET_REFL, SUBSET_UNIV] >>
6582  rw[SUBSET_EQ_CARD, IMAGE_SURJ]
6583QED
6584
6585(* Reformulate theorem *)
6586
6587(* Theorem: FINITE s /\ FINITE t /\ CARD s = CARD t /\
6588            INJ f s t ==> SURJ f s t *)
6589(* Proof: by FINITE_INJ_AS_SURJ *)
6590Theorem FINITE_INJ_IS_SURJ:
6591  !f s t. FINITE s /\ FINITE t /\ CARD s = CARD t /\
6592          INJ f s t ==> SURJ f s t
6593Proof
6594  simp[FINITE_INJ_AS_SURJ]
6595QED
6596
6597(* Theorem: FINITE s /\ FINITE t /\ CARD s = CARD t /\ INJ f s t ==> BIJ f s t *)
6598(* Proof:
6599   Note SURJ f s t             by FINITE_INJ_IS_SURJ
6600     so BIJ f s t              by BIJ_DEF, INJ f s t
6601*)
6602Theorem FINITE_INJ_IS_BIJ:
6603  !f s t. FINITE s /\ FINITE t /\ CARD s = CARD t /\ INJ f s t ==> BIJ f s t
6604Proof
6605  simp[FINITE_INJ_IS_SURJ, BIJ_DEF]
6606QED
6607
6608(* Note: FINITE_SURJ_IS_BIJ is not easy, see helperFunction. *)
6609
6610(* Theorem: FINITE {P x | x < n}  *)
6611(* Proof:
6612   Since IMAGE (\i. P i) (count n) = {P x | x < n},
6613   this follows by
6614   IMAGE_FINITE  |- !s. FINITE s ==> !f. FINITE (IMAGE f s) : thm
6615   FINITE_COUNT  |- !n. FINITE (count n) : thm
6616*)
6617Theorem FINITE_COUNT_IMAGE:
6618    !P n. FINITE {P x | x < n }
6619Proof
6620  rpt strip_tac >>
6621  `IMAGE (\i. P i) (count n) = {P x | x < n}` by rw[IMAGE_DEF] >>
6622  metis_tac[IMAGE_FINITE, FINITE_COUNT]
6623QED
6624
6625(* Idea: improve FINITE_BIJ_COUNT to include CARD information. *)
6626
6627(* Theorem: FINITE s ==> ?f. BIJ f (count (CARD s)) s *)
6628(* Proof:
6629   Note ?f b. BIJ f (count b) s    by FINITE_BIJ_COUNT
6630    and FINITE (count b)           by FINITE_COUNT
6631     so CARD s
6632      = CARD (count b)             by FINITE_BIJ
6633      = b                          by CARD_COUNT
6634*)
6635Theorem FINITE_BIJ_COUNT_CARD:
6636  !s. FINITE s ==> ?f. BIJ f (count (CARD s)) s
6637Proof
6638  rpt strip_tac >>
6639  imp_res_tac FINITE_BIJ_COUNT >>
6640  metis_tac[FINITE_COUNT, CARD_COUNT, FINITE_BIJ]
6641QED
6642
6643(* Theorem: !n. 0 < n ==> IMAGE (\x. x MOD n) s SUBSET (count n) *)
6644(* Proof: by SUBSET_DEF, MOD_LESS. *)
6645Theorem image_mod_subset_count:
6646    !s n. 0 < n ==> IMAGE (\x. x MOD n) s SUBSET (count n)
6647Proof
6648  rw[SUBSET_DEF] >>
6649  rw[MOD_LESS]
6650QED
6651
6652(* Theorem: !n. 0 < n ==> CARD (IMAGE (\x. x MOD n) s) <= n *)
6653(* Proof:
6654   Let t = IMAGE (\x. x MOD n) s
6655   Since   t SUBSET count n          by SUBSET_DEF, MOD_LESS
6656     Now   FINITE (count n)          by FINITE_COUNT
6657     and   CARD (count n) = n        by CARD_COUNT
6658      So   CARD t <= n               by CARD_SUBSET
6659*)
6660Theorem card_mod_image:
6661    !s n. 0 < n ==> CARD (IMAGE (\x. x MOD n) s) <= n
6662Proof
6663  rpt strip_tac >>
6664  qabbrev_tac `t = IMAGE (\x. x MOD n) s` >>
6665  (`t SUBSET count n` by (rw[SUBSET_DEF, Abbr`t`] >> metis_tac[MOD_LESS])) >>
6666  metis_tac[CARD_SUBSET, FINITE_COUNT, CARD_COUNT]
6667QED
6668(* not used *)
6669
6670(* Theorem: !n. 0 < n /\ 0 NOTIN (IMAGE (\x. x MOD n) s) ==> CARD (IMAGE (\x. x MOD n) s) < n *)
6671(* Proof:
6672   Let t = IMAGE (\x. x MOD n) s
6673   Since   t SUBSET count n          by SUBSET_DEF, MOD_LESS
6674     Now   FINITE (count n)          by FINITE_COUNT
6675     and   CARD (count n) = n        by CARD_COUNT
6676      So   CARD t <= n               by CARD_SUBSET
6677     and   FINITE t                  by SUBSET_FINITE
6678     But   0 IN (count n)            by IN_COUNT
6679     yet   0 NOTIN t                 by given
6680   Hence   t <> (count n)            by NOT_EQUAL_SETS
6681      So   CARD t <> n               by SUBSET_EQ_CARD
6682     Thus  CARD t < n
6683*)
6684Theorem card_mod_image_nonzero:
6685    !s n. 0 < n /\ 0 NOTIN (IMAGE (\x. x MOD n) s) ==> CARD (IMAGE (\x. x MOD n) s) < n
6686Proof
6687  rpt strip_tac >>
6688  qabbrev_tac `t = IMAGE (\x. x MOD n) s` >>
6689  (`t SUBSET count n` by (rw[SUBSET_DEF, Abbr`t`] >> metis_tac[MOD_LESS])) >>
6690  `FINITE (count n) /\ (CARD (count n) = n) ` by rw[] >>
6691  `CARD t <= n` by metis_tac[CARD_SUBSET] >>
6692  `0 IN (count n)` by rw[] >>
6693  `t <> (count n)` by metis_tac[NOT_EQUAL_SETS] >>
6694  `CARD t <> n` by metis_tac[SUBSET_EQ_CARD, SUBSET_FINITE] >>
6695  decide_tac
6696QED
6697(* not used *)
6698
6699(* ------------------------------------------------------------------------- *)
6700(* Partition Property                                                        *)
6701(* ------------------------------------------------------------------------- *)
6702
6703(* Theorem: FINITE s ==> !u v. s =|= u # v ==> ((u = {}) <=> (v = s)) *)
6704(* Proof:
6705   If part: u = {} ==> v = s
6706      Note  s = {} UNION v        by given, u = {}
6707              = v                 by UNION_EMPTY
6708   Only-if part: v = s ==> u = {}
6709      Note FINITE u /\ FINITE v       by FINITE_UNION
6710       ==> CARD v = CARD u + CARD v   by CARD_UNION_DISJOINT
6711       ==>      0 = CARD u            by arithmetic
6712      Thus u = {}                     by CARD_EQ_0
6713*)
6714Theorem finite_partition_property:
6715    !s. FINITE s ==> !u v. s =|= u # v ==> ((u = {}) <=> (v = s))
6716Proof
6717  rw[EQ_IMP_THM] >>
6718  spose_not_then strip_assume_tac >>
6719  `FINITE u /\ FINITE v` by metis_tac[FINITE_UNION] >>
6720  `CARD v = CARD u + CARD v` by metis_tac[CARD_UNION_DISJOINT] >>
6721  `CARD u <> 0` by rw[CARD_EQ_0] >>
6722  decide_tac
6723QED
6724
6725(* Theorem: FINITE s ==> !P. let u = {x | x IN s /\ P x} in let v = {x | x IN s /\ ~P x} in
6726            FINITE u /\ FINITE v /\ s =|= u # v *)
6727(* Proof:
6728   This is to show:
6729   (1) FINITE u, true      by SUBSET_DEF, SUBSET_FINITE
6730   (2) FINITE v, true      by SUBSET_DEF, SUBSET_FINITE
6731   (3) u UNION v = s       by IN_UNION
6732   (4) DISJOINT u v, true  by IN_DISJOINT, MEMBER_NOT_EMPTY
6733*)
6734Theorem finite_partition_by_predicate:
6735  !s. FINITE s ==>
6736      !P. let u = {x | x IN s /\ P x} ;
6737              v = {x | x IN s /\ ~P x}
6738          in
6739              FINITE u /\ FINITE v /\ s =|= u # v
6740Proof
6741  rw_tac std_ss[] >| [
6742    `u SUBSET s` by rw[SUBSET_DEF, Abbr`u`] >>
6743    metis_tac[SUBSET_FINITE],
6744    `v SUBSET s` by rw[SUBSET_DEF, Abbr`v`] >>
6745    metis_tac[SUBSET_FINITE],
6746    simp[EXTENSION, Abbr‘u’, Abbr‘v’] >>
6747    metis_tac[],
6748    simp[Abbr‘u’, Abbr‘v’, DISJOINT_DEF, EXTENSION] >> metis_tac[]
6749  ]
6750QED
6751
6752(* Theorem: u SUBSET s ==> let v = s DIFF u in s =|= u # v *)
6753(* Proof:
6754   This is to show:
6755   (1) u SUBSET s ==> s = u UNION (s DIFF u), true   by UNION_DIFF
6756   (2) u SUBSET s ==> DISJOINT u (s DIFF u), true    by DISJOINT_DIFF
6757*)
6758Theorem partition_by_subset:
6759    !s u. u SUBSET s ==> let v = s DIFF u in s =|= u # v
6760Proof
6761  rw[UNION_DIFF, DISJOINT_DIFF]
6762QED
6763
6764(* Theorem: x IN s ==> s =|= {x} # (s DELETE x) *)
6765(* Proof:
6766   Note x IN s ==> {x} SUBSET s    by SUBSET_DEF, IN_SING
6767    and s DELETE x = s DIFF {x}    by DELETE_DEF
6768   Thus s =|= {x} # (s DELETE x)   by partition_by_subset
6769*)
6770Theorem partition_by_element:
6771    !s x. x IN s ==> s =|= {x} # (s DELETE x)
6772Proof
6773  metis_tac[partition_by_subset, DELETE_DEF, SUBSET_DEF, IN_SING]
6774QED
6775
6776(* ------------------------------------------------------------------------- *)
6777(* Splitting of a set                                                        *)
6778(* ------------------------------------------------------------------------- *)
6779
6780(* Theorem: s =|= {} # t <=> (s = t) *)
6781(* Proof:
6782       s =|= {} # t
6783   <=> (s = {} UNION t) /\ (DISJOINT {} t)     by notation
6784   <=> (s = {} UNION t) /\ T                   by DISJOINT_EMPTY
6785   <=> s = t                                   by UNION_EMPTY
6786*)
6787Theorem SPLIT_EMPTY:
6788    !s t. s =|= {} # t <=> (s = t)
6789Proof
6790  rw[]
6791QED
6792
6793(* Theorem: s =|= u # v /\ v =|= a # b ==> s =|= u UNION a # b /\ u UNION a =|= u # a *)
6794(* Proof:
6795   Note s =|= u # v <=> (s = u UNION v) /\ (DISJOINT u v)   by notation
6796    and v =|= a # b <=> (v = a UNION b) /\ (DISJOINT a b)   by notation
6797   Let c = u UNION a.
6798   Then s = u UNION v                   by above
6799          = u UNION (a UNION b)         by above
6800          = (u UNION a) UNION b         by UNION_ASSOC
6801          = c UNION b
6802   Note  DISJOINT u v
6803     <=> DISJOINT u (a UNION b)
6804     <=> DISJOINT (a UNION b) u         by DISJOINT_SYM
6805     <=> DISJOINT a u /\ DISJOINT b u   by DISJOINT_UNION
6806     <=> DISJOINT u a /\ DISJOINT u b   by DISJOINT_SYM
6807
6808   Thus  DISJOINT c b
6809     <=> DISJOINT (u UNION a) b         by above
6810     <=> DISJOINT u b /\ DISJOINT a b   by DISJOINT_UNION
6811     <=> T /\ T                         by above
6812     <=> T
6813   Therefore,
6814         s =|= c # b       by s = c UNION b /\ DISJOINT c b
6815     and c =|= u # a       by c = u UNION a /\ DISJOINT u a
6816*)
6817Theorem SPLIT_UNION:
6818    !s u v a b. s =|= u # v /\ v =|= a # b ==> s =|= u UNION a # b /\ u UNION a =|= u # a
6819Proof
6820  metis_tac[DISJOINT_UNION, DISJOINT_SYM, UNION_ASSOC]
6821QED
6822
6823(* Theorem: s =|= u # v <=> u SUBSET s /\ (v = s DIFF u) *)
6824(* Proof:
6825   Note s =|= u # v <=> (s = u UNION v) /\ (DISJOINT u v)   by notation
6826   If part: s =|= u # v ==> u SUBSET s /\ (v = s DIFF u)
6827      Note u SUBSET (u UNION v)         by SUBSET_UNION
6828           s DIFF u
6829         = (u UNION v) DIFF u           by s = u UNION v
6830         = v DIFF u                     by DIFF_SAME_UNION
6831         = v                            by DISJOINT_DIFF_IFF, DISJOINT_SYM
6832
6833   Only-if part: u SUBSET s /\ (v = s DIFF u) ==> s =|= u # v
6834      Note s = u UNION (s DIFF u)       by UNION_DIFF, u SUBSET s
6835       and DISJOINT u (s DIFF u)        by DISJOINT_DIFF
6836      Thus s =|= u # v                  by notation
6837*)
6838Theorem SPLIT_EQ:
6839    !s u v. s =|= u # v <=> u SUBSET s /\ (v = s DIFF u)
6840Proof
6841  rw[DISJOINT_DEF, SUBSET_DEF, EXTENSION] >>
6842  metis_tac[]
6843QED
6844
6845(* Theorem: (s =|= u # v) = (s =|= v # u) *)
6846(* Proof:
6847     s =|= u # v
6848   = (s = u UNION v) /\ DISJOINT u v    by notation
6849   = (s = v UNION u) /\ DISJOINT u v    by UNION_COMM
6850   = (s = v UNION u) /\ DISJOINT v u    by DISJOINT_SYM
6851   = s =|= v # u                        by notation
6852*)
6853Theorem SPLIT_SYM:
6854    !s u v. (s =|= u # v) = (s =|= v # u)
6855Proof
6856  rw_tac std_ss[UNION_COMM, DISJOINT_SYM]
6857QED
6858
6859(* Theorem: (s =|= u # v) ==> (s =|= v # u) *)
6860(* Proof: by SPLIT_SYM *)
6861Theorem SPLIT_SYM_IMP:
6862    !s u v. (s =|= u # v) ==> (s =|= v # u)
6863Proof
6864  rw_tac std_ss[SPLIT_SYM]
6865QED
6866
6867(* Theorem: s =|= {x} # v <=> (x IN s /\ (v = s DELETE x)) *)
6868(* Proof:
6869       s =|= {x} # v
6870   <=> {x} SUBSET s /\ (v = s DIFF {x})   by SPLIT_EQ
6871   <=> x IN s       /\ (v = s DIFF {x})   by SUBSET_DEF
6872   <=> x IN s       /\ (v = s DELETE x)   by DELETE_DEF
6873*)
6874Theorem SPLIT_SING:
6875    !s v x. s =|= {x} # v <=> (x IN s /\ (v = s DELETE x))
6876Proof
6877  rw[SPLIT_EQ, SUBSET_DEF, DELETE_DEF]
6878QED
6879
6880(* Theorem: s =|= u # v ==> u SUBSET s /\ v SUBSET s *)
6881(* Proof: by SUBSET_UNION *)
6882Theorem SPLIT_SUBSETS:
6883  !s u v. s =|= u # v ==> u SUBSET s /\ v SUBSET s
6884Proof
6885  rw[]
6886QED
6887
6888(* Theorem: FINITE s /\ s =|= u # v ==> FINITE u /\ FINITE v *)
6889(* Proof: by SPLIT_SUBSETS, SUBSET_FINITE *)
6890Theorem SPLIT_FINITE:
6891  !s u v. FINITE s /\ s =|= u # v ==> FINITE u /\ FINITE v
6892Proof
6893  simp[SPLIT_SUBSETS, SUBSET_FINITE]
6894QED
6895
6896(* Theorem: FINITE s /\ s =|= u # v ==> (CARD s = CARD u + CARD v) *)
6897(* Proof:
6898   Note FINITE u /\ FINITE v   by SPLIT_FINITE
6899     CARD s
6900   = CARD (u UNION v)          by notation
6901   = CARD u + CARD v           by CARD_UNION_DISJOINT
6902*)
6903Theorem SPLIT_CARD:
6904  !s u v. FINITE s /\ s =|= u # v ==> (CARD s = CARD u + CARD v)
6905Proof
6906  metis_tac[CARD_UNION_DISJOINT, SPLIT_FINITE]
6907QED
6908
6909(* Theorem: s =|= u # v <=> (u = s DIFF v) /\ (v = s DIFF u) *)
6910(* Proof:
6911   If part: s =|= u # v ==> (u = s DIFF v) /\ (v = s DIFF u)
6912      True by EXTENSION, IN_UNION, IN_DISJOINT, IN_DIFF.
6913   Only-if part: (u = s DIFF v) /\ (v = s DIFF u) ==> s =|= u # v
6914      True by EXTENSION, IN_UNION, IN_DISJOINT, IN_DIFF.
6915*)
6916Theorem SPLIT_EQ_DIFF:
6917    !s u v. s =|= u # v <=> (u = s DIFF v) /\ (v = s DIFF u)
6918Proof
6919  rpt strip_tac >>
6920  eq_tac >| [
6921    rpt strip_tac >| [
6922      rw[EXTENSION] >>
6923      metis_tac[IN_UNION, IN_DISJOINT, IN_DIFF],
6924      rw[EXTENSION] >>
6925      metis_tac[IN_UNION, IN_DISJOINT, IN_DIFF]
6926    ],
6927    rpt strip_tac >| [
6928      rw[EXTENSION] >>
6929      metis_tac[IN_UNION, IN_DIFF],
6930      metis_tac[IN_DISJOINT, IN_DIFF]
6931    ]
6932  ]
6933QED
6934
6935(* Theorem alias *)
6936Theorem SPLIT_BY_SUBSET = partition_by_subset;
6937(* val SPLIT_BY_SUBSET = |- !s u. u SUBSET s ==> (let v = s DIFF u in s =|= u # v): thm *)
6938
6939(* Theorem alias *)
6940Theorem SUBSET_DIFF_DIFF = DIFF_DIFF_SUBSET;
6941(* val SUBSET_DIFF_DIFF = |- !s t. t SUBSET s ==> (s DIFF (s DIFF t) = t) *)
6942
6943(* Theorem: s1 SUBSET t /\ s2 SUBSET t /\ (t DIFF s1 = t DIFF s2) ==> (s1 = s2) *)
6944(* Proof:
6945   Let u = t DIFF s2.
6946   Then u = t DIFF s1             by given
6947    ==> t =|= u # s1              by SPLIT_BY_SUBSET, s1 SUBSET t
6948   Thus s1 = t DIFF u             by SPLIT_EQ
6949           = t DIFF (t DIFF s2)   by notation
6950           = s2                   by SUBSET_DIFF_DIFF, s2 SUBSET t
6951*)
6952Theorem SUBSET_DIFF_EQ:
6953    !s1 s2 t. s1 SUBSET t /\ s2 SUBSET t /\ (t DIFF s1 = t DIFF s2) ==> (s1 = s2)
6954Proof
6955  metis_tac[SPLIT_BY_SUBSET, SPLIT_EQ, SUBSET_DIFF_DIFF]
6956QED
6957
6958(* ------------------------------------------------------------------------- *)
6959(* Bijective Inverses.                                                       *)
6960(* ------------------------------------------------------------------------- *)
6961
6962(* In pred_setTheory:
6963LINV_DEF        |- !f s t. INJ f s t ==> !x. x IN s ==> (LINV f s (f x) = x)
6964BIJ_LINV_INV    |- !f s t. BIJ f s t ==> !x. x IN t ==> (f (LINV f s x) = x)
6965BIJ_LINV_BIJ    |- !f s t. BIJ f s t ==> BIJ (LINV f s) t s
6966RINV_DEF        |- !f s t. SURJ f s t ==> !x. x IN t ==> (f (RINV f s x) = x)
6967
6968That's it, must be missing some!
6969Must assume: !y. y IN t ==> RINV f s y IN s
6970*)
6971
6972(* Theorem: BIJ f s t ==> !x. x IN t ==> (LINV f s x) IN s *)
6973(* Proof:
6974   Since BIJ f s t ==> BIJ (LINV f s) t s   by BIJ_LINV_BIJ
6975      so x IN t ==> (LINV f s x) IN s       by BIJ_DEF, INJ_DEF
6976*)
6977Theorem BIJ_LINV_ELEMENT:
6978    !f s t. BIJ f s t ==> !x. x IN t ==> (LINV f s x) IN s
6979Proof
6980  metis_tac[BIJ_LINV_BIJ, BIJ_DEF, INJ_DEF]
6981QED
6982
6983(* Theorem: (!x. x IN s ==> (LINV f s (f x) = x)) /\ (!x. x IN t ==> (f (LINV f s x) = x)) *)
6984(* Proof:
6985   Since BIJ f s t ==> INJ f s t      by BIJ_DEF
6986     and INJ f s t ==> !x. x IN s ==> (LINV f s (f x) = x)    by LINV_DEF
6987    also BIJ f s t ==> !x. x IN t ==> (f (LINV f s x) = x)    by BIJ_LINV_INV
6988*)
6989Theorem BIJ_LINV_THM:
6990    !(f:'a -> 'b) s t. BIJ f s t ==>
6991    (!x. x IN s ==> (LINV f s (f x) = x)) /\ (!x. x IN t ==> (f (LINV f s x) = x))
6992Proof
6993  metis_tac[BIJ_DEF, LINV_DEF, BIJ_LINV_INV]
6994QED
6995
6996(* Theorem: BIJ f s t /\ (!y. y IN t ==> RINV f s y IN s) ==>
6997            !x. x IN s ==> (RINV f s (f x) = x) *)
6998(* Proof:
6999   BIJ f s t means INJ f s t /\ SURJ f s t     by BIJ_DEF
7000   Hence x IN s ==> f x IN t                   by INJ_DEF or SURJ_DEF
7001                ==> f (RINV f s (f x)) = f x   by RINV_DEF, SURJ f s t
7002                ==> RINV f s (f x) = x         by INJ_DEF
7003*)
7004Theorem BIJ_RINV_INV:
7005    !(f:'a -> 'b) s t. BIJ f s t /\ (!y. y IN t ==> RINV f s y IN s) ==>
7006   !x. x IN s ==> (RINV f s (f x) = x)
7007Proof
7008  rw[BIJ_DEF] >>
7009  `f x IN t` by metis_tac[INJ_DEF] >>
7010  `f (RINV f s (f x)) = f x` by metis_tac[RINV_DEF] >>
7011  metis_tac[INJ_DEF]
7012QED
7013
7014(* Theorem: BIJ f s t /\ (!y. y IN t ==> RINV f s y IN s) ==> BIJ (RINV f s) t s *)
7015(* Proof:
7016   By BIJ_DEF, this is to show:
7017   (1) INJ (RINV f s) t s
7018       By INJ_DEF, this is to show:
7019       x IN t /\ y IN t /\ RINV f s x = RINV f s y ==> x = y
7020       But  SURJ f s t           by BIJ_DEF
7021        so  f (RINV f s x) = x   by RINV_DEF, SURJ f s t
7022       and  f (RINV f s y) = y   by RINV_DEF, SURJ f s t
7023       Thus x = y.
7024   (2) SURJ (RINV f s) t s
7025       By SURJ_DEF, this is to show:
7026       x IN s ==> ?y. y IN t /\ (RINV f s y = x)
7027       But  INJ f s t            by BIJ_DEF
7028        so  f x IN t             by INJ_DEF
7029       and  RINV f s (f x) = x   by BIJ_RINV_INV
7030       Take y = f x to meet the criteria.
7031*)
7032Theorem BIJ_RINV_BIJ:
7033    !(f:'a -> 'b) s t. BIJ f s t /\ (!y. y IN t ==> RINV f s y IN s) ==> BIJ (RINV f s) t s
7034Proof
7035  rpt strip_tac >>
7036  rw[BIJ_DEF] >-
7037  metis_tac[INJ_DEF, BIJ_DEF, RINV_DEF] >>
7038  rw[SURJ_DEF] >>
7039  metis_tac[INJ_DEF, BIJ_DEF, BIJ_RINV_INV]
7040QED
7041
7042(* Theorem: INJ f t univ(:'b) /\ s SUBSET t ==> !x. x IN s ==> (LINV f t (f x) = x) *)
7043(* Proof: by LINV_DEF, SUBSET_DEF *)
7044Theorem LINV_SUBSET:
7045  !(f:'a -> 'b) s t. INJ f t univ(:'b) /\ s SUBSET t ==> !x. x IN s ==> (LINV f t (f x) = x)
7046Proof
7047  metis_tac[LINV_DEF, SUBSET_DEF]
7048QED
7049
7050(* ------------------------------------------------------------------------- *)
7051(* SUM_IMAGE and PROD_IMAGE Theorems                                         *)
7052(* ------------------------------------------------------------------------- *)
7053
7054(* Theorem: FINITE s ==> !f. (!x y. (f x = f y) ==> (x = y)) ==> (SIGMA f s = SIGMA I (IMAGE f s)) *)
7055(* Proof:
7056   By finite induction on s.
7057   Base case: SIGMA f {} = SIGMA I {}
7058        SIGMA f {}
7059      = 0              by SUM_IMAGE_THM
7060      = SIGMA I {}     by SUM_IMAGE_THM
7061      = SUM_SET {}     by SUM_SET_DEF
7062   Step case: !f. (!x y. (f x = f y) ==> (x = y)) ==> (SIGMA f s = SUM_SET (IMAGE f s)) ==>
7063              e NOTIN s ==> SIGMA f (e INSERT s) = SUM_SET (f e INSERT IMAGE f s)
7064      Note FINITE s ==> FINITE (IMAGE f s)   by IMAGE_FINITE
7065       and e NOTIN s ==> f e NOTIN f s       by the injective property
7066        SIGMA f (e INSERT s)
7067      = f e + SIGMA f (s DELETE e))    by SUM_IMAGE_THM
7068      = f e + SIGMA f s                by DELETE_NON_ELEMENT
7069      = f e + SUM_SET (IMAGE f s))     by induction hypothesis
7070      = f e + SUM_SET ((IMAGE f s) DELETE (f e))   by DELETE_NON_ELEMENT, f e NOTIN f s
7071      = SUM_SET (f e INSERT IMAGE f s)             by SUM_SET_THM
7072*)
7073Theorem SUM_IMAGE_AS_SUM_SET:
7074    !s. FINITE s ==> !f. (!x y. (f x = f y) ==> (x = y)) ==> (SIGMA f s = SUM_SET (IMAGE f s))
7075Proof
7076  HO_MATCH_MP_TAC FINITE_INDUCT >>
7077  rw[SUM_SET_DEF] >-
7078  rw[SUM_IMAGE_THM] >>
7079  rw[SUM_IMAGE_THM, SUM_IMAGE_DELETE] >>
7080  metis_tac[]
7081QED
7082
7083(* Theorem: x <> y ==> SIGMA f {x; y} = f x + f y *)
7084(* Proof:
7085   Let s = {x; y}.
7086   Then FINITE s                   by FINITE_UNION, FINITE_SING
7087    and x INSERT s                 by INSERT_DEF
7088    and s DELETE x = {y}           by DELETE_DEF
7089        SIGMA f s
7090      = SIGMA f (x INSERT s)       by above
7091      = f x + SIGMA f (s DELETE x) by SUM_IMAGE_THM
7092      = f x + SIGMA f {y}          by above
7093      = f x + f y                  by SUM_IMAGE_SING
7094*)
7095Theorem SUM_IMAGE_DOUBLET:
7096  !f x y. x <> y ==> SIGMA f {x; y} = f x + f y
7097Proof
7098  rpt strip_tac >>
7099  qabbrev_tac `s = {x; y}` >>
7100  `FINITE s` by fs[Abbr`s`] >>
7101  `x INSERT s = s` by fs[Abbr`s`] >>
7102  `s DELETE x = {x; y} DELETE x` by simp[Abbr`s`] >>
7103  `_ = if y = x then {} else {y}` by EVAL_TAC >>
7104  `_ = {y}` by simp[] >>
7105  metis_tac[SUM_IMAGE_THM, SUM_IMAGE_SING]
7106QED
7107
7108(* Theorem: x <> y /\ y <> z /\ z <> x ==> SIGMA f {x; y; z} = f x + f y + f z *)
7109(* Proof:
7110   Let s = {x; y; z}.
7111   Then FINITE s                   by FINITE_UNION, FINITE_SING
7112    and x INSERT s                 by INSERT_DEF
7113    and s DELETE x = {y; z}        by DELETE_DEF
7114        SIGMA f s
7115      = SIGMA f (x INSERT s)       by above
7116      = f x + SIGMA f (s DELETE x) by SUM_IMAGE_THM
7117      = f x + SIGMA f {y; z}       by above
7118      = f x + f y + f z            by SUM_IMAGE_DOUBLET
7119*)
7120Theorem SUM_IMAGE_TRIPLET:
7121  !f x y z. x <> y /\ y <> z /\ z <> x ==> SIGMA f {x; y; z} = f x + f y + f z
7122Proof
7123  rpt strip_tac >>
7124  qabbrev_tac `s = {x; y; z}` >>
7125  `FINITE s` by fs[Abbr`s`] >>
7126  `x INSERT s = s` by fs[Abbr`s`] >>
7127  `s DELETE x = {x; y; z} DELETE x` by simp[Abbr`s`] >>
7128  `_ = if y = x then if z = x then {} else {z}
7129      else y INSERT if z = x then {} else {z}` by EVAL_TAC >>
7130  `_ = {y; z}` by simp[] >>
7131  `SIGMA f s = f x + (f y + f z)` by metis_tac[SUM_IMAGE_THM, SUM_IMAGE_DOUBLET, SUM_IMAGE_SING] >>
7132  decide_tac
7133QED
7134
7135(*
7136CARD_BIGUNION_SAME_SIZED_SETS
7137|- !n s. FINITE s /\ (!e. e IN s ==> FINITE e /\ CARD e = n) /\
7138         PAIR_DISJOINT s ==> CARD (BIGUNION s) = CARD s * n
7139*)
7140
7141(* Theorem: If n divides CARD e for all e in s, then n divides SIGMA CARD s.
7142            FINITE s /\ (!e. e IN s ==> n divides (CARD e)) ==> n divides (SIGMA CARD s) *)
7143(* Proof:
7144   Use finite induction and SUM_IMAGE_THM.
7145   Base: n divides SIGMA CARD {}
7146         Note SIGMA CARD {} = 0        by SUM_IMAGE_THM
7147          and n divides 0              by ALL_DIVIDES_0
7148   Step: e NOTIN s /\ n divides (CARD e) ==> n divides SIGMA CARD (e INSERT s)
7149           SIGMA CARD (e INSERT s)
7150         = CARD e + SIGMA CARD (s DELETE e)      by SUM_IMAGE_THM
7151         = CARD e + SIGMA CARD s                 by DELETE_NON_ELEMENT
7152         Note n divides (CARD e)                 by given
7153          and n divides SIGMA CARD s             by induction hypothesis
7154         Thus n divides SIGMA CARD (e INSERT s)  by DIVIDES_ADD_1
7155*)
7156Theorem SIGMA_CARD_FACTOR:
7157  !n s. FINITE s /\ (!e. e IN s ==> n divides (CARD e)) ==> n divides (SIGMA CARD s)
7158Proof
7159  strip_tac >>
7160  Induct_on `FINITE` >>
7161  rw[] >-
7162  rw[SUM_IMAGE_THM] >>
7163  metis_tac[SUM_IMAGE_THM, DELETE_NON_ELEMENT, DIVIDES_ADD_1]
7164QED
7165
7166(* Theorem: FINITE s /\ t PSUBSET s /\ (!x. x IN s ==> f x <> 0) ==> SIGMA f t < SIGMA f s *)
7167(* Proof:
7168   Note t SUBSET s /\ t <> s      by PSUBSET_DEF
7169   Thus SIGMA f t <= SIGMA f s    by SUM_IMAGE_SUBSET_LE
7170   By contradiction, suppose ~(SIGMA f t < SIGMA f s).
7171   Then SIGMA f t = SIGMA f s     by arithmetic [1]
7172
7173   Let u = s DIFF t.
7174   Then DISJOINT u t                        by DISJOINT_DIFF
7175    and u UNION t = s                       by UNION_DIFF
7176   Note FINITE u /\ FINITE t                by FINITE_UNION
7177    ==> SIGMA f s = SIGMA f u + SIGMA f t   by SUM_IMAGE_DISJOINT
7178   Thus SIGMA f u = 0                       by arithmetic, [1]
7179
7180    Now u SUBSET s                          by SUBSET_UNION
7181    and u <> {}                             by finite_partition_property, t <> s
7182   Thus ?x. x IN u                          by MEMBER_NOT_EMPTY
7183    and f x <> 0                            by SUBSET_DEF, implication
7184   This contradicts f x = 0                 by SUM_IMAGE_ZERO
7185*)
7186Theorem SUM_IMAGE_PSUBSET_LT:
7187    !f s t. FINITE s /\ t PSUBSET s /\ (!x. x IN s ==> f x <> 0) ==> SIGMA f t < SIGMA f s
7188Proof
7189  rw[PSUBSET_DEF] >>
7190  `SIGMA f t <= SIGMA f s` by rw[SUM_IMAGE_SUBSET_LE] >>
7191  spose_not_then strip_assume_tac >>
7192  `SIGMA f t = SIGMA f s` by decide_tac >>
7193  qabbrev_tac `u = s DIFF t` >>
7194  `DISJOINT u t` by rw[DISJOINT_DIFF, Abbr`u`] >>
7195  `u UNION t = s` by rw[UNION_DIFF, Abbr`u`] >>
7196  `FINITE u /\ FINITE t` by metis_tac[FINITE_UNION] >>
7197  `SIGMA f s = SIGMA f u + SIGMA f t` by rw[GSYM SUM_IMAGE_DISJOINT] >>
7198  `SIGMA f u = 0` by decide_tac >>
7199  `u SUBSET s` by rw[] >>
7200  `u <> {}` by metis_tac[finite_partition_property] >>
7201  metis_tac[SUM_IMAGE_ZERO, SUBSET_DEF, MEMBER_NOT_EMPTY]
7202QED
7203
7204(* Idea: Let s be a set of sets. If CARD s = SIGMA CARD s,
7205         and all elements in s are non-empty, then all elements in s are SING. *)
7206
7207(* Theorem: FINITE s /\ (!e. e IN s ==> CARD e <> 0) ==> CARD s <= SIGMA CARD s *)
7208(* Proof:
7209   By finite induction on set s.
7210   Base: (!e. e IN {} ==> CARD e <> 0) ==> CARD {} <= SIGMA CARD {}
7211      LHS = CARD {} = 0            by CARD_EMPTY
7212      RHS = SIGMA CARD {} = 0      by SUM_IMAGE_EMPTY
7213      Hence true.
7214   Step: FINITE s /\ ((!e. e IN s ==> CARD e <> 0) ==> CARD s <= SIGMA CARD s) ==>
7215         !e. e NOTIN s ==>
7216             (!e'. e' IN e INSERT s ==> CARD e' <> 0) ==>
7217             CARD (e INSERT s) <= SIGMA CARD (e INSERT s)
7218
7219      Note !e'. e' IN s
7220            ==> e' IN e INSERT s   by IN_INSERT, e NOTIN s
7221            ==> CARD e' <> 0       by implication, so induction hypothesis applies.
7222       and CARD e <> 0             by e IN e INSERT s
7223            CARD (e INSERT s)
7224          = SUC (CARD s)           by CARD_INSERT, e NOTIN s
7225          = 1 + CARD s             by SUC_ONE_ADD
7226
7227         <= 1 + SIGMA CARD s       by induction hypothesis
7228         <= CARD e + SIGMA CARD s  by 1 <= CARD e
7229          = SIGMA (e INSERT s)     by SUM_IMAGE_INSERT, e NOTIN s.
7230*)
7231Theorem card_le_sigma_card:
7232  !s. FINITE s /\ (!e. e IN s ==> CARD e <> 0) ==> CARD s <= SIGMA CARD s
7233Proof
7234  Induct_on `FINITE` >>
7235  rw[] >>
7236  `CARD e <> 0` by fs[] >>
7237  `1 <= CARD e` by decide_tac >>
7238  fs[] >>
7239  simp[SUM_IMAGE_INSERT]
7240QED
7241
7242(* Theorem: FINITE s /\ (!e. e IN s ==> CARD e <> 0) /\
7243            CARD s = SIGMA CARD s ==> !e. e IN s ==> CARD e = 1 *)
7244(* Proof:
7245   By finite induction on set s.
7246   Base: (!e. e IN {} ==> CARD e <> 0) /\ CARD {} = SIGMA CARD {} ==>
7247         !e. e IN {} ==> CARD e = 1
7248      Since e IN {} = F, this is trivially true.
7249   Step: !s. FINITE s /\
7250             ((!e. e IN s ==> CARD e <> 0) /\ CARD s = SIGMA CARD s ==>
7251              !e. e IN s ==> CARD e = 1) ==>
7252         !e. e NOTIN s ==>
7253             (!e'. e' IN e INSERT s ==> CARD e' <> 0) /\
7254             CARD (e INSERT s) = SIGMA CARD (e INSERT s) ==>
7255             !e'. e' IN e INSERT s ==> CARD e' = 1
7256      Note !e'. e' IN s
7257           ==> e' IN e INSERT s    by IN_INSERT, e NOTIN s
7258           ==> CARD e' <> 0        by implication, helps in induction hypothesis
7259      Also e IN e INSERT s         by IN_INSERT
7260        so CARD e <> 0             by implication
7261
7262           CARD e + CARD s
7263        <= CARD e + SIGMA CARD s   by card_le_sigma_card
7264         = SIGMA CARD (e INSERT s) by SUM_IMAGE_INSERT, e NOTIN s
7265         = CARD (e INSERT s)       by given
7266         = SUC (CARD s)            by CARD_INSERT, e NOTIN s
7267         = 1 + CARD s              by SUC_ONE_ADD
7268      Thus CARD e <= 1             by arithmetic
7269        or CARD e = 1              by CARD e <> 0
7270       ==> CARD s = SIGMA CARD s   by arithmetic, helps in induction hypothesis
7271      Thus !e. e IN s ==> CARD e = 1               by induction hypothesis
7272      and  !e'. e' IN e INSERT s ==> CARD e' = 1   by CARD e = 1
7273*)
7274Theorem card_eq_sigma_card:
7275  !s. FINITE s /\ (!e. e IN s ==> CARD e <> 0) /\
7276      CARD s = SIGMA CARD s ==> !e. e IN s ==> CARD e = 1
7277Proof
7278  Induct_on `FINITE` >>
7279  simp[] >>
7280  ntac 6 strip_tac >>
7281  `CARD e <> 0 /\ !e. e IN s ==> CARD e <> 0` by fs[] >>
7282  imp_res_tac card_le_sigma_card >>
7283  `CARD e + CARD s <= CARD e + SIGMA CARD s` by decide_tac >>
7284  `CARD e + SIGMA CARD s = SIGMA CARD (e INSERT s)` by fs[SUM_IMAGE_INSERT] >>
7285  `_ = 1 + CARD s` by rw[] >>
7286  `CARD e <= 1` by fs[] >>
7287  `CARD e = 1` by decide_tac >>
7288  `CARD s = SIGMA CARD s` by fs[] >>
7289  metis_tac[]
7290QED
7291
7292(* ------------------------------------------------------------------------- *)
7293(* SUM_SET and PROD_SET Theorems                                             *)
7294(* ------------------------------------------------------------------------- *)
7295
7296(* Theorem: FINITE s ==> !f. INJ f s UNIV ==> (SUM_SET (IMAGE f s) = SIGMA f s) *)
7297(* Proof:
7298   By finite induction on s.
7299   Base: SUM_SET (IMAGE f {}) = SIGMA f {}
7300         SUM_SET (IMAGE f {})
7301       = SUM_SET {}                  by IMAGE_EMPTY
7302       = 1                           by SUM_SET_EMPTY
7303       = SIGMA f {}                  by SUM_IMAGE_EMPTY
7304   Step: !f. INJ f s univ(:num) ==> (SUM_SET (IMAGE f s) = SIGMA f s) ==>
7305         e NOTIN s /\ INJ f (e INSERT s) univ(:num) ==> SUM_SET (IMAGE f (e INSERT s)) = SIGMA f (e INSERT s)
7306       Note INJ f s univ(:num)               by INJ_INSERT
7307        and f e NOTIN (IMAGE f s)            by IN_IMAGE
7308         SUM_SET (IMAGE f (e INSERT s))
7309       = SUM_SET (f e INSERT (IMAGE f s))    by IMAGE_INSERT
7310       = f e * SUM_SET (IMAGE f s)           by SUM_SET_INSERT
7311       = f e * SIGMA f s                     by induction hypothesis
7312       = SIGMA f (e INSERT s)                by SUM_IMAGE_INSERT
7313*)
7314Theorem SUM_SET_IMAGE_EQN:
7315    !s. FINITE s ==> !f. INJ f s UNIV ==> (SUM_SET (IMAGE f s) = SIGMA f s)
7316Proof
7317  Induct_on `FINITE` >>
7318  rpt strip_tac >-
7319  rw[SUM_SET_EMPTY, SUM_IMAGE_EMPTY] >>
7320  fs[INJ_INSERT] >>
7321  `f e NOTIN (IMAGE f s)` by metis_tac[IN_IMAGE] >>
7322  rw[SUM_SET_INSERT, SUM_IMAGE_INSERT]
7323QED
7324
7325(* Theorem: SUM_SET (count n) = (n * (n - 1)) DIV 2*)
7326(* Proof:
7327   By induction on n.
7328   Base case: SUM_SET (count 0) = 0 * (0 - 1) DIV 2
7329     LHS = SUM_SET (count 0)
7330         = SUM_SET {}           by COUNT_ZERO
7331         = 0                    by SUM_SET_THM
7332         = 0 DIV 2              by ZERO_DIV
7333         = 0 * (0 - 1) DIV 2    by MULT
7334         = RHS
7335   Step case: SUM_SET (count n) = n * (n - 1) DIV 2 ==>
7336              SUM_SET (count (SUC n)) = SUC n * (SUC n - 1) DIV 2
7337     If n = 0, to show: SUM_SET (count 1) = 0
7338        SUM_SET (count 1) = SUM_SET {0} = 0  by SUM_SET_SING
7339     If n <> 0, 0 < n.
7340     First, FINITE (count n)               by FINITE_COUNT
7341            n NOTIN (count n)              by IN_COUNT
7342     LHS = SUM_SET (count (SUC n))
7343         = SUM_SET (n INSERT count n)      by COUNT_SUC
7344         = n + SUM_SET (count n DELETE n)  by SUM_SET_THM
7345         = n + SUM_SET (count n)           by DELETE_NON_ELEMENT
7346         = n + n * (n - 1) DIV 2           by induction hypothesis
7347         = (n * 2 + n * (n - 1)) DIV 2     by ADD_DIV_ADD_DIV
7348         = (n * (2 + (n - 1))) DIV 2       by LEFT_ADD_DISTRIB
7349         = n * (n + 1) DIV 2               by arithmetic, 0 < n
7350         = (SUC n - 1) * (SUC n) DIV 2     by ADD1, SUC_SUB1
7351         = SUC n * (SUC n - 1) DIV 2       by MULT_COMM
7352         = RHS
7353*)
7354Theorem SUM_SET_COUNT:
7355    !n. SUM_SET (count n) = (n * (n - 1)) DIV 2
7356Proof
7357  Induct_on `n` >-
7358  rw[] >>
7359  Cases_on `n = 0` >| [
7360    rw[] >>
7361    EVAL_TAC,
7362    `0 < n` by decide_tac >>
7363    `FINITE (count n)` by rw[] >>
7364    `n NOTIN (count n)` by rw[] >>
7365    `SUM_SET (count (SUC n)) = SUM_SET (n INSERT count n)` by rw[COUNT_SUC] >>
7366    `_ = n + SUM_SET (count n DELETE n)` by rw[SUM_SET_THM] >>
7367    `_ = n + SUM_SET (count n)` by metis_tac[DELETE_NON_ELEMENT] >>
7368    `_ = n + n * (n - 1) DIV 2` by rw[] >>
7369    `_ = (n * 2 + n * (n - 1)) DIV 2` by rw[ADD_DIV_ADD_DIV] >>
7370    `_ = (n * (2 + (n - 1))) DIV 2` by rw[LEFT_ADD_DISTRIB] >>
7371    `_ = n * (n + 1) DIV 2` by rw_tac arith_ss[] >>
7372    `_ = (SUC n - 1) * SUC n DIV 2` by rw[ADD1, SUC_SUB1] >>
7373    `_ = SUC n * (SUC n - 1) DIV 2 ` by rw[MULT_COMM] >>
7374    decide_tac
7375  ]
7376QED
7377
7378(* ------------------------------------------------------------------------- *)
7379
7380
7381(* Theorem: FINITE s ==> !f. INJ f s UNIV ==> (PROD_SET (IMAGE f s) = PI f s) *)
7382(* Proof:
7383   By finite induction on s.
7384   Base: PROD_SET (IMAGE f {}) = PI f {}
7385         PROD_SET (IMAGE f {})
7386       = PROD_SET {}              by IMAGE_EMPTY
7387       = 1                        by PROD_SET_EMPTY
7388       = PI f {}                  by PROD_IMAGE_EMPTY
7389   Step: !f. INJ f s univ(:num) ==> (PROD_SET (IMAGE f s) = PI f s) ==>
7390         e NOTIN s /\ INJ f (e INSERT s) univ(:num) ==> PROD_SET (IMAGE f (e INSERT s)) = PI f (e INSERT s)
7391       Note INJ f s univ(:num)               by INJ_INSERT
7392        and f e NOTIN (IMAGE f s)            by IN_IMAGE
7393         PROD_SET (IMAGE f (e INSERT s))
7394       = PROD_SET (f e INSERT (IMAGE f s))   by IMAGE_INSERT
7395       = f e * PROD_SET (IMAGE f s)          by PROD_SET_INSERT
7396       = f e * PI f s                        by induction hypothesis
7397       = PI f (e INSERT s)                   by PROD_IMAGE_INSERT
7398*)
7399Theorem PROD_SET_IMAGE_EQN:
7400    !s. FINITE s ==> !f. INJ f s UNIV ==> (PROD_SET (IMAGE f s) = PI f s)
7401Proof
7402  Induct_on `FINITE` >>
7403  rpt strip_tac >-
7404  rw[PROD_SET_EMPTY, PROD_IMAGE_EMPTY] >>
7405  fs[INJ_INSERT] >>
7406  `f e NOTIN (IMAGE f s)` by metis_tac[IN_IMAGE] >>
7407  rw[PROD_SET_INSERT, PROD_IMAGE_INSERT]
7408QED
7409
7410(* Theorem: PROD_SET (IMAGE (\j. n ** j) (count m)) = n ** (SUM_SET (count m)) *)
7411(* Proof:
7412   By induction on m.
7413   Base case: PROD_SET (IMAGE (\j. n ** j) (count 0)) = n ** SUM_SET (count 0)
7414     LHS = PROD_SET (IMAGE (\j. n ** j) (count 0))
7415         = PROD_SET (IMAGE (\j. n ** j) {})          by COUNT_ZERO
7416         = PROD_SET {}                               by IMAGE_EMPTY
7417         = 1                                         by PROD_SET_THM
7418     RHS = n ** SUM_SET (count 0)
7419         = n ** SUM_SET {}                           by COUNT_ZERO
7420         = n ** 0                                    by SUM_SET_THM
7421         = 1                                         by EXP
7422         = LHS
7423   Step case: PROD_SET (IMAGE (\j. n ** j) (count m)) = n ** SUM_SET (count m) ==>
7424              PROD_SET (IMAGE (\j. n ** j) (count (SUC m))) = n ** SUM_SET (count (SUC m))
7425     First,
7426          FINITE (count m)                                   by FINITE_COUNT
7427          FINITE (IMAGE (\j. n ** j) (count m))              by IMAGE_FINITE
7428          m NOTIN count m                                    by IN_COUNT
7429     and  (\j. n ** j) m NOTIN IMAGE (\j. n ** j) (count m)  by EXP_BASE_INJECTIVE, 1 < n
7430
7431     LHS = PROD_SET (IMAGE (\j. n ** j) (count (SUC m)))
7432         = PROD_SET (IMAGE (\j. n ** j) (m INSERT count m))  by COUNT_SUC
7433         = n ** m * PROD_SET (IMAGE (\j. n ** j) (count m))  by PROD_SET_IMAGE_REDUCTION
7434         = n ** m * n ** SUM_SET (count m)                   by induction hypothesis
7435         = n ** (m + SUM_SET (count m))                      by EXP_ADD
7436         = n ** SUM_SET (m INSERT count m)                   by SUM_SET_INSERT
7437         = n ** SUM_SET (count (SUC m))                      by COUNT_SUC
7438         = RHS
7439*)
7440Theorem PROD_SET_IMAGE_EXP:
7441    !n. 1 < n ==> !m. PROD_SET (IMAGE (\j. n ** j) (count m)) = n ** (SUM_SET (count m))
7442Proof
7443  rpt strip_tac >>
7444  Induct_on `m` >-
7445  rw[PROD_SET_THM] >>
7446  `FINITE (IMAGE (\j. n ** j) (count m))` by rw[] >>
7447  `(\j. n ** j) m NOTIN IMAGE (\j. n ** j) (count m)` by rw[] >>
7448  `m NOTIN count m` by rw[] >>
7449  `PROD_SET (IMAGE (\j. n ** j) (count (SUC m))) =
7450    PROD_SET (IMAGE (\j. n ** j) (m INSERT count m))` by rw[COUNT_SUC] >>
7451  `_ = n ** m * PROD_SET (IMAGE (\j. n ** j) (count m))` by rw[PROD_SET_IMAGE_REDUCTION] >>
7452  `_ = n ** m * n ** SUM_SET (count m)` by rw[] >>
7453  `_ = n ** (m + SUM_SET (count m))` by rw[EXP_ADD] >>
7454  `_ = n ** SUM_SET (m INSERT count m)` by rw[SUM_SET_INSERT] >>
7455  `_ = n ** SUM_SET (count (SUC m))` by rw[COUNT_SUC] >>
7456  decide_tac
7457QED
7458
7459(* ------------------------------------------------------------------------- *)
7460(* Partition and Equivalent Class                                            *)
7461(* ------------------------------------------------------------------------- *)
7462
7463(* Theorem: y IN equiv_class R s x <=> y IN s /\ R x y *)
7464(* Proof: by GSPECIFICATION *)
7465Theorem equiv_class_element:
7466    !R s x y. y IN equiv_class R s x <=> y IN s /\ R x y
7467Proof
7468  rw[]
7469QED
7470
7471(* Theorem: partition R {} = {} *)
7472(* Proof: by partition_def *)
7473Theorem partition_on_empty:
7474    !R. partition R {} = {}
7475Proof
7476  rw[partition_def]
7477QED
7478
7479(*
7480> partition_def;
7481val it = |- !R s. partition R s = {t | ?x. x IN s /\ (t = equiv_class R s x)}: thm
7482*)
7483
7484(* Theorem: t IN partition R s <=> ?x. x IN s /\ (t = equiv_class R s x) *)
7485(* Proof: by partition_def *)
7486Theorem partition_element:
7487  !R s t. t IN partition R s <=> ?x. x IN s /\ (t = equiv_class R s x)
7488Proof
7489  rw[partition_def]
7490QED
7491
7492(* Theorem: partition R s = IMAGE (equiv_class R s) s *)
7493(* Proof:
7494     partition R s
7495   = {t | ?x. x IN s /\ (t = {y | y IN s /\ R x y})}   by partition_def
7496   = {t | ?x. x IN s /\ (t = equiv_class R s x)}       by notation
7497   = IMAGE (equiv_class R s) s                         by IN_IMAGE
7498*)
7499Theorem partition_elements:
7500    !R s. partition R s = IMAGE (equiv_class R s) s
7501Proof
7502  rw[partition_def, EXTENSION] >>
7503  metis_tac[]
7504QED
7505
7506(* Theorem alias *)
7507Theorem partition_as_image = partition_elements;
7508(* val partition_as_image =
7509   |- !R s. partition R s = IMAGE (\x. equiv_class R s x) s: thm *)
7510
7511(* Theorem: (R1 = R2) /\ (s1 = s2) ==> (partition R1 s1 = partition R2 s2) *)
7512(* Proof: by identity *)
7513Theorem partition_cong:
7514    !R1 R2 s1 s2. (R1 = R2) /\ (s1 = s2) ==> (partition R1 s1 = partition R2 s2)
7515Proof
7516  rw[]
7517QED
7518(* Just in case this is needed. *)
7519
7520(*
7521EMPTY_NOT_IN_partition
7522val it = |- R equiv_on s ==> {} NOTIN partition R s: thm
7523*)
7524
7525(* Theorem: R equiv_on s /\ e IN partition R s ==> e <> {} *)
7526(* Proof: by EMPTY_NOT_IN_partition. *)
7527Theorem partition_element_not_empty:
7528  !R s e. R equiv_on s /\ e IN partition R s ==> e <> {}
7529Proof
7530  metis_tac[EMPTY_NOT_IN_partition]
7531QED
7532
7533(* Theorem: R equiv_on s /\ x IN s ==> equiv_class R s x <> {} *)
7534(* Proof:
7535   Note equiv_class R s x IN partition_element R s     by partition_element
7536     so equiv_class R s x <> {}                        by partition_element_not_empty
7537*)
7538Theorem equiv_class_not_empty:
7539  !R s x. R equiv_on s /\ x IN s ==> equiv_class R s x <> {}
7540Proof
7541  metis_tac[partition_element, partition_element_not_empty]
7542QED
7543
7544(* Theorem: R equiv_on s ==> (x IN s <=> ?e. e IN partition R s /\ x IN e) *)
7545(* Proof:
7546       x IN s
7547   <=> x IN (BIGUNION (partition R s))         by BIGUNION_partition
7548   <=> ?e. e IN partition R s /\ x IN e        by IN_BIGUNION
7549*)
7550Theorem partition_element_exists:
7551  !R s x. R equiv_on s ==> (x IN s <=> ?e. e IN partition R s /\ x IN e)
7552Proof
7553  rpt strip_tac >>
7554  imp_res_tac BIGUNION_partition >>
7555  metis_tac[IN_BIGUNION]
7556QED
7557
7558(* Theorem: When the partitions are equal size of n, CARD s = n * CARD (partition of s).
7559           FINITE s /\ R equiv_on s /\ (!e. e IN partition R s ==> (CARD e = n)) ==>
7560           (CARD s = n * CARD (partition R s)) *)
7561(* Proof:
7562   Note FINITE (partition R s)               by FINITE_partition
7563     so CARD s = SIGMA CARD (partition R s)  by partition_CARD
7564               = n * CARD (partition R s)    by SIGMA_CARD_CONSTANT
7565*)
7566Theorem equal_partition_card:
7567    !R s n. FINITE s /\ R equiv_on s /\ (!e. e IN partition R s ==> (CARD e = n)) ==>
7568           (CARD s = n * CARD (partition R s))
7569Proof
7570  rw_tac std_ss[partition_CARD, FINITE_partition, GSYM SIGMA_CARD_CONSTANT]
7571QED
7572
7573(* Theorem: When the partitions are equal size of n, CARD s = n * CARD (partition of s).
7574           FINITE s /\ R equiv_on s /\ (!e. e IN partition R s ==> (CARD e = n)) ==>
7575           n divides (CARD s) *)
7576(* Proof: by equal_partition_card, divides_def. *)
7577Theorem equal_partition_factor:
7578  !R s n. FINITE s /\ R equiv_on s /\ (!e. e IN partition R s ==> (CARD e = n)) ==>
7579          n divides (CARD s)
7580Proof
7581  metis_tac[equal_partition_card, divides_def, MULT_COMM]
7582QED
7583
7584(* Theorem: When the partition size has a factor n, then n divides CARD s.
7585            FINITE s /\ R equiv_on s /\
7586            (!e. e IN partition R s ==> n divides (CARD e)) ==> n divides (CARD s)  *)
7587(* Proof:
7588   Note FINITE (partition R s)                by FINITE_partition
7589   Thus CARD s = SIGMA CARD (partition R s)   by partition_CARD
7590    But !e. e IN partition R s ==> n divides (CARD e)
7591    ==> n divides SIGMA CARD (partition R s)  by SIGMA_CARD_FACTOR
7592   Hence n divdes CARD s                      by above
7593*)
7594Theorem factor_partition_card:
7595    !R s n. FINITE s /\ R equiv_on s /\
7596   (!e. e IN partition R s ==> n divides (CARD e)) ==> n divides (CARD s)
7597Proof
7598  metis_tac[FINITE_partition, partition_CARD, SIGMA_CARD_FACTOR]
7599QED
7600
7601(* Note:
7602When a set s is partitioned by an equivalence relation R,
7603partition_CARD  |- !R s. R equiv_on s /\ FINITE s ==> (CARD s = SIGMA CARD (partition R s))
7604Can this be generalized to:   f s = SIGMA f (partition R s)  ?
7605If so, we can have         (SIGMA f) s = SIGMA (SIGMA f) (partition R s)
7606Sort of yes, but have to use BIGUNION, and for a set_additive function f.
7607*)
7608
7609(* Overload every element finite of a superset *)
7610Overload EVERY_FINITE = ``\P. (!s. s IN P ==> FINITE s)``
7611
7612(*
7613> FINITE_BIGUNION;
7614val it = |- !P. FINITE P /\ EVERY_FINITE P ==> FINITE (BIGUNION P): thm
7615*)
7616
7617(* Overload pairwise disjoint of a superset *)
7618Overload PAIR_DISJOINT = ``\P. (!s t. s IN P /\ t IN P /\ ~(s = t) ==> DISJOINT s t)``
7619
7620(*
7621> partition_elements_disjoint;
7622val it = |- R equiv_on s ==> PAIR_DISJOINT (partition R s): thm
7623*)
7624
7625(* Theorem: t SUBSET s /\ PAIR_DISJOINT s ==> PAIR_DISJOINT t *)
7626(* Proof: by SUBSET_DEF *)
7627Theorem pair_disjoint_subset:
7628  !s t. t SUBSET s /\ PAIR_DISJOINT s ==> PAIR_DISJOINT t
7629Proof
7630  rw[SUBSET_DEF]
7631QED
7632
7633(* Overload an additive set function *)
7634Overload SET_ADDITIVE =
7635   ``\f. (f {} = 0) /\ (!s t. FINITE s /\ FINITE t ==> (f (s UNION t) + f (s INTER t) = f s + f t))``
7636
7637(* Theorem: FINITE P /\ EVERY_FINITE P /\ PAIR_DISJOINT P ==>
7638            !f. SET_ADDITIVE f ==> (f (BIGUNION P) = SIGMA f P) *)
7639(* Proof:
7640   By finite induction on P.
7641   Base: f (BIGUNION {}) = SIGMA f {}
7642         f (BIGUNION {})
7643       = f {}                by BIGUNION_EMPTY
7644       = 0                   by SET_ADDITIVE f
7645       = SIGMA f {} = RHS    by SUM_IMAGE_EMPTY
7646   Step: e NOTIN P ==> f (BIGUNION (e INSERT P)) = SIGMA f (e INSERT P)
7647       Given !s. s IN e INSERT P ==> FINITE s
7648        thus !s. (s = e) \/ s IN P ==> FINITE s   by IN_INSERT
7649       hence FINITE e              by implication
7650         and EVERY_FINITE P        by IN_INSERT
7651         and FINITE (BIGUNION P)   by FINITE_BIGUNION
7652       Given PAIR_DISJOINT (e INSERT P)
7653          so PAIR_DISJOINT P               by IN_INSERT
7654         and !s. s IN P ==> DISJOINT e s   by IN_INSERT
7655       hence DISJOINT e (BIGUNION P)       by DISJOINT_BIGUNION
7656          so e INTER (BIGUNION P) = {}     by DISJOINT_DEF
7657         and f (e INTER (BIGUNION P)) = 0  by SET_ADDITIVE f
7658         f (BIGUNION (e INSERT P)
7659       = f (BIGUNION (e INSERT P)) + f (e INTER (BIGUNION P))     by ADD_0
7660       = f e + f (BIGUNION P)                                     by SET_ADDITIVE f
7661       = f e + SIGMA f P                   by induction hypothesis
7662       = f e + SIGMA f (P DELETE e)        by DELETE_NON_ELEMENT
7663       = SIGMA f (e INSERT P)              by SUM_IMAGE_THM
7664*)
7665Theorem disjoint_bigunion_add_fun:
7666    !P. FINITE P /\ EVERY_FINITE P /\ PAIR_DISJOINT P ==>
7667   !f. SET_ADDITIVE f ==> (f (BIGUNION P) = SIGMA f P)
7668Proof
7669  `!P. FINITE P ==> EVERY_FINITE P /\ PAIR_DISJOINT P ==>
7670   !f. SET_ADDITIVE f ==> (f (BIGUNION P) = SIGMA f P)` suffices_by rw[] >>
7671  ho_match_mp_tac FINITE_INDUCT >>
7672  rpt strip_tac >-
7673  rw_tac std_ss[BIGUNION_EMPTY, SUM_IMAGE_EMPTY] >>
7674  rw_tac std_ss[BIGUNION_INSERT, SUM_IMAGE_THM] >>
7675  `FINITE e /\ FINITE (BIGUNION P)` by rw[FINITE_BIGUNION] >>
7676  `EVERY_FINITE P /\ PAIR_DISJOINT P` by rw[] >>
7677  `!s. s IN P ==> DISJOINT e s` by metis_tac[IN_INSERT] >>
7678  `f (e INTER (BIGUNION P)) = 0` by metis_tac[DISJOINT_DEF, DISJOINT_BIGUNION] >>
7679  `f (e UNION BIGUNION P) = f (e UNION BIGUNION P) + f (e INTER (BIGUNION P))` by decide_tac >>
7680  `_ = f e + f (BIGUNION P)` by metis_tac[] >>
7681  `_ = f e + SIGMA f P` by prove_tac[] >>
7682  metis_tac[DELETE_NON_ELEMENT]
7683QED
7684
7685(* Theorem: SET_ADDITIVE CARD *)
7686(* Proof:
7687   Since CARD {} = 0                    by CARD_EMPTY
7688     and !s t. FINITE s /\ FINITE t
7689     ==> CARD (s UNION t) + CARD (s INTER t) = CARD s + CARD t   by CARD_UNION
7690   Hence SET_ADDITIVE CARD              by notation
7691*)
7692Theorem set_additive_card:
7693    SET_ADDITIVE CARD
7694Proof
7695  rw[FUN_EQ_THM, CARD_UNION]
7696QED
7697
7698(* Note: DISJ_BIGUNION_CARD is only a prove_thm in pred_setTheoryScript.sml *)
7699(*
7700g `!P. FINITE P ==> EVERY_FINITE P /\ PAIR_DISJOINT P ==> (CARD (BIGUNION P) = SIGMA CARD P)`
7701e (PSet_ind.SET_INDUCT_TAC FINITE_INDUCT);
7702Q. use of this changes P to s, s to s', how?
7703*)
7704
7705(* Theorem: FINITE P /\ EVERY_FINITE P /\ PAIR_DISJOINT P ==> (CARD (BIGUNION P) = SIGMA CARD P) *)
7706(* Proof: by disjoint_bigunion_add_fun, set_additive_card *)
7707Theorem disjoint_bigunion_card:
7708    !P. FINITE P /\ EVERY_FINITE P /\ PAIR_DISJOINT P ==> (CARD (BIGUNION P) = SIGMA CARD P)
7709Proof
7710  rw[disjoint_bigunion_add_fun, set_additive_card]
7711QED
7712
7713(* Theorem alias *)
7714Theorem CARD_BIGUNION_PAIR_DISJOINT = disjoint_bigunion_card;
7715(*
7716val CARD_BIGUNION_PAIR_DISJOINT =
7717   |- !P. FINITE P /\ EVERY_FINITE P /\ PAIR_DISJOINT P ==>
7718          CARD (BIGUNION P) = SIGMA CARD P: thm
7719*)
7720
7721(* Theorem: SET_ADDITIVE (SIGMA f) *)
7722(* Proof:
7723   Since SIGMA f {} = 0         by SUM_IMAGE_EMPTY
7724     and !s t. FINITE s /\ FINITE t
7725     ==> SIGMA f (s UNION t) + SIGMA f (s INTER t) = SIGMA f s + SIGMA f t   by SUM_IMAGE_UNION_EQN
7726   Hence SET_ADDITIVE (SIGMA f)
7727*)
7728Theorem set_additive_sigma:
7729    !f. SET_ADDITIVE (SIGMA f)
7730Proof
7731  rw[SUM_IMAGE_EMPTY, SUM_IMAGE_UNION_EQN]
7732QED
7733
7734(* Theorem: FINITE P /\ EVERY_FINITE P /\ PAIR_DISJOINT P ==> !f. SIGMA f (BIGUNION P) = SIGMA (SIGMA f) P *)
7735(* Proof: by disjoint_bigunion_add_fun, set_additive_sigma *)
7736Theorem disjoint_bigunion_sigma:
7737    !P. FINITE P /\ EVERY_FINITE P /\ PAIR_DISJOINT P ==> !f. SIGMA f (BIGUNION P) = SIGMA (SIGMA f) P
7738Proof
7739  rw[disjoint_bigunion_add_fun, set_additive_sigma]
7740QED
7741
7742(* Theorem: R equiv_on s /\ FINITE s ==> !f. SET_ADDITIVE f ==> (f s = SIGMA f (partition R s)) *)
7743(* Proof:
7744   Let P = partition R s.
7745    Then FINITE s
7746     ==> FINITE P /\ !t. t IN P ==> FINITE t    by FINITE_partition
7747     and R equiv_on s
7748     ==> BIGUNION P = s               by BIGUNION_partition
7749     ==> PAIR_DISJOINT P              by partition_elements_disjoint
7750   Hence f (BIGUNION P) = SIGMA f P   by disjoint_bigunion_add_fun
7751      or f s = SIGMA f P              by above, BIGUNION_partition
7752*)
7753Theorem set_add_fun_by_partition:
7754    !R s. R equiv_on s /\ FINITE s ==> !f. SET_ADDITIVE f ==> (f s = SIGMA f (partition R s))
7755Proof
7756  rpt strip_tac >>
7757  qabbrev_tac `P = partition R s` >>
7758  `FINITE P /\ !t. t IN P ==> FINITE t` by metis_tac[FINITE_partition] >>
7759  `BIGUNION P = s` by rw[BIGUNION_partition, Abbr`P`] >>
7760  `PAIR_DISJOINT P` by metis_tac[partition_elements_disjoint] >>
7761  rw[disjoint_bigunion_add_fun]
7762QED
7763
7764(* Theorem: R equiv_on s /\ FINITE s ==> (CARD s = SIGMA CARD (partition R s)) *)
7765(* Proof: by set_add_fun_by_partition, set_additive_card *)
7766Theorem set_card_by_partition:
7767    !R s. R equiv_on s /\ FINITE s ==> (CARD s = SIGMA CARD (partition R s))
7768Proof
7769  rw[set_add_fun_by_partition, set_additive_card]
7770QED
7771
7772(* This is pred_setTheory.partition_CARD *)
7773
7774(* Theorem: R equiv_on s /\ FINITE s ==> !f. SIGMA f s = SIGMA (SIGMA f) (partition R s) *)
7775(* Proof: by set_add_fun_by_partition, set_additive_sigma *)
7776Theorem set_sigma_by_partition:
7777    !R s. R equiv_on s /\ FINITE s ==> !f. SIGMA f s = SIGMA (SIGMA f) (partition R s)
7778Proof
7779  rw[set_add_fun_by_partition, set_additive_sigma]
7780QED
7781
7782(* Overload a multiplicative set function *)
7783Overload SET_MULTIPLICATIVE =
7784   ``\f. (f {} = 1) /\ (!s t. FINITE s /\ FINITE t ==> (f (s UNION t) * f (s INTER t) = f s * f t))``
7785
7786(* Theorem: FINITE P /\ EVERY_FINITE P /\ PAIR_DISJOINT P ==>
7787            !f. SET_MULTIPLICATIVE f ==> (f (BIGUNION P) = PI f P) *)
7788(* Proof:
7789   By finite induction on P.
7790   Base: f (BIGUNION {}) = PI f {}
7791         f (BIGUNION {})
7792       = f {}                by BIGUNION_EMPTY
7793       = 1                   by SET_MULTIPLICATIVE f
7794       = PI f {} = RHS       by PROD_IMAGE_EMPTY
7795   Step: e NOTIN P ==> f (BIGUNION (e INSERT P)) = PI f (e INSERT P)
7796       Given !s. s IN e INSERT P ==> FINITE s
7797        thus !s. (s = e) \/ s IN P ==> FINITE s   by IN_INSERT
7798       hence FINITE e              by implication
7799         and EVERY_FINITE P        by IN_INSERT
7800         and FINITE (BIGUNION P)   by FINITE_BIGUNION
7801       Given PAIR_DISJOINT (e INSERT P)
7802          so PAIR_DISJOINT P               by IN_INSERT
7803         and !s. s IN P ==> DISJOINT e s   by IN_INSERT
7804       hence DISJOINT e (BIGUNION P)       by DISJOINT_BIGUNION
7805          so e INTER (BIGUNION P) = {}     by DISJOINT_DEF
7806         and f (e INTER (BIGUNION P)) = 1  by SET_MULTIPLICATIVE f
7807         f (BIGUNION (e INSERT P)
7808       = f (BIGUNION (e INSERT P)) * f (e INTER (BIGUNION P))     by MULT_RIGHT_1
7809       = f e * f (BIGUNION P)                                     by SET_MULTIPLICATIVE f
7810       = f e * PI f P                      by induction hypothesis
7811       = f e * PI f (P DELETE e)           by DELETE_NON_ELEMENT
7812       = PI f (e INSERT P)                 by PROD_IMAGE_THM
7813*)
7814Theorem disjoint_bigunion_mult_fun:
7815    !P. FINITE P /\ EVERY_FINITE P /\ PAIR_DISJOINT P ==>
7816   !f. SET_MULTIPLICATIVE f ==> (f (BIGUNION P) = PI f P)
7817Proof
7818  `!P. FINITE P ==> EVERY_FINITE P /\ PAIR_DISJOINT P ==>
7819   !f. SET_MULTIPLICATIVE f ==> (f (BIGUNION P) = PI f P)` suffices_by rw[] >>
7820  ho_match_mp_tac FINITE_INDUCT >>
7821  rpt strip_tac >-
7822  rw_tac std_ss[BIGUNION_EMPTY, PROD_IMAGE_EMPTY] >>
7823  rw_tac std_ss[BIGUNION_INSERT, PROD_IMAGE_THM] >>
7824  `FINITE e /\ FINITE (BIGUNION P)` by rw[FINITE_BIGUNION] >>
7825  `EVERY_FINITE P /\ PAIR_DISJOINT P` by rw[] >>
7826  `!s. s IN P ==> DISJOINT e s` by metis_tac[IN_INSERT] >>
7827  `f (e INTER (BIGUNION P)) = 1` by metis_tac[DISJOINT_DEF, DISJOINT_BIGUNION] >>
7828  `f (e UNION BIGUNION P) = f (e UNION BIGUNION P) * f (e INTER (BIGUNION P))` by metis_tac[MULT_RIGHT_1] >>
7829  `_ = f e * f (BIGUNION P)` by metis_tac[] >>
7830  `_ = f e * PI f P` by prove_tac[] >>
7831  metis_tac[DELETE_NON_ELEMENT]
7832QED
7833
7834(* Theorem: R equiv_on s /\ FINITE s ==> !f. SET_MULTIPLICATIVE f ==> (f s = PI f (partition R s)) *)
7835(* Proof:
7836   Let P = partition R s.
7837    Then FINITE s
7838     ==> FINITE P /\ EVERY_FINITE P   by FINITE_partition
7839     and R equiv_on s
7840     ==> BIGUNION P = s               by BIGUNION_partition
7841     ==> PAIR_DISJOINT P              by partition_elements_disjoint
7842   Hence f (BIGUNION P) = PI f P      by disjoint_bigunion_mult_fun
7843      or f s = PI f P                 by above, BIGUNION_partition
7844*)
7845Theorem set_mult_fun_by_partition:
7846    !R s. R equiv_on s /\ FINITE s ==> !f. SET_MULTIPLICATIVE f ==> (f s = PI f (partition R s))
7847Proof
7848  rpt strip_tac >>
7849  qabbrev_tac `P = partition R s` >>
7850  `FINITE P /\ !t. t IN P ==> FINITE t` by metis_tac[FINITE_partition] >>
7851  `BIGUNION P = s` by rw[BIGUNION_partition, Abbr`P`] >>
7852  `PAIR_DISJOINT P` by metis_tac[partition_elements_disjoint] >>
7853  rw[disjoint_bigunion_mult_fun]
7854QED
7855
7856(* Theorem: FINITE s ==> !g. INJ g s univ(:'a) ==> !f. SIGMA f (IMAGE g s) = SIGMA (f o g) s *)
7857(* Proof:
7858   By finite induction on s.
7859   Base: SIGMA f (IMAGE g {}) = SIGMA (f o g) {}
7860      LHS = SIGMA f (IMAGE g {})
7861          = SIGMA f {}                    by IMAGE_EMPTY
7862          = 0                             by SUM_IMAGE_EMPTY
7863          = SIGMA (f o g) {} = RHS        by SUM_IMAGE_EMPTY
7864   Step: e NOTIN s ==> SIGMA f (IMAGE g (e INSERT s)) = SIGMA (f o g) (e INSERT s)
7865      Note INJ g (e INSERT s) univ(:'a)
7866       ==> INJ g s univ(:'a) /\ g e IN univ(:'a) /\
7867           !y. y IN s /\ (g e = g y) ==> (e = y)       by INJ_INSERT
7868      Thus g e NOTIN (IMAGE g s)                       by IN_IMAGE
7869        SIGMA f (IMAGE g (e INSERT s))
7870      = SIGMA f (g e INSERT IMAGE g s)    by IMAGE_INSERT
7871      = f (g e) + SIGMA f (IMAGE g s)     by SUM_IMAGE_THM, g e NOTIN (IMAGE g s)
7872      = f (g e) + SIGMA (f o g) s         by induction hypothesis
7873      = (f o g) e + SIGMA (f o g) s       by composition
7874      = SIGMA (f o g) (e INSERT s)        by SUM_IMAGE_THM, e NOTIN s
7875*)
7876Theorem sum_image_by_composition:
7877    !s. FINITE s ==> !g. INJ g s univ(:'a) ==> !f. SIGMA f (IMAGE g s) = SIGMA (f o g) s
7878Proof
7879  ho_match_mp_tac FINITE_INDUCT >>
7880  rpt strip_tac >-
7881  rw[SUM_IMAGE_EMPTY] >>
7882  `INJ g s univ(:'a) /\ g e IN univ(:'a) /\ !y. y IN s /\ (g e = g y) ==> (e = y)` by metis_tac[INJ_INSERT] >>
7883  `g e NOTIN (IMAGE g s)` by metis_tac[IN_IMAGE] >>
7884  `(s DELETE e = s) /\ (IMAGE g s DELETE g e = IMAGE g s)` by metis_tac[DELETE_NON_ELEMENT] >>
7885  rw[SUM_IMAGE_THM]
7886QED
7887
7888(* Overload on permutation *)
7889Overload PERMUTES = ``\f s. BIJ f s s``
7890val _ = set_fixity "PERMUTES" (Infix(NONASSOC, 450)); (* same as relation *)
7891
7892(* Theorem: FINITE s ==> !g. g PERMUTES s ==> !f. SIGMA (f o g) s = SIGMA f s *)
7893(* Proof:
7894   Given permutate g s = BIJ g s s       by notation
7895     ==> INJ g s s /\ SURJ g s s         by BIJ_DEF
7896     Now SURJ g s s ==> IMAGE g s = s    by IMAGE_SURJ
7897    Also s SUBSET univ(:'a)              by SUBSET_UNIV
7898     and s SUBSET s                      by SUBSET_REFL
7899   Hence INJ g s univ(:'a)               by INJ_SUBSET
7900    With FINITE s,
7901      SIGMA (f o g) s
7902    = SIGMA f (IMAGE g s)                by sum_image_by_composition
7903    = SIGMA f s                          by above
7904*)
7905Theorem sum_image_by_permutation:
7906    !s. FINITE s ==> !g. g PERMUTES s ==> !f. SIGMA (f o g) s = SIGMA f s
7907Proof
7908  rpt strip_tac >>
7909  `INJ g s s /\ SURJ g s s` by metis_tac[BIJ_DEF] >>
7910  `IMAGE g s = s` by rw[GSYM IMAGE_SURJ] >>
7911  `s SUBSET univ(:'a)` by rw[SUBSET_UNIV] >>
7912  `INJ g s univ(:'a)` by metis_tac[INJ_SUBSET, SUBSET_REFL] >>
7913  `SIGMA (f o g) s = SIGMA f (IMAGE g s)` by rw[sum_image_by_composition] >>
7914  rw[]
7915QED
7916
7917(* Theorem: FINITE s ==> !f:('b -> bool) -> num. (f {} = 0) ==>
7918            !g. (!t. FINITE t /\ (!x. x IN t ==> g x <> {}) ==> INJ g t univ(:num -> bool)) ==>
7919            (SIGMA f (IMAGE g s) = SIGMA (f o g) s) *)
7920(* Proof:
7921   Let s1 = {x | x IN s /\ (g x = {})},
7922       s2 = {x | x IN s /\ (g x <> {})}.
7923    Then s = s1 UNION s2                             by EXTENSION
7924     and DISJOINT s1 s2                              by EXTENSION, DISJOINT_DEF
7925     and DISJOINT (IMAGE g s1) (IMAGE g s2)          by EXTENSION, DISJOINT_DEF
7926     Now s1 SUBSET s /\ s1 SUBSET s                  by SUBSET_DEF
7927   Since FINITE s                                    by given
7928    thus FINITE s1 /\ FINITE s2                      by SUBSET_FINITE
7929     and FINITE (IMAGE g s1) /\ FINITE (IMAGE g s2)  by IMAGE_FINITE
7930
7931   Step 1: decompose left summation
7932         SIGMA f (IMAGE g s)
7933       = SIGMA f (IMAGE g (s1 UNION s2))             by above, s = s1 UNION s2
7934       = SIGMA f ((IMAGE g s1) UNION (IMAGE g s2))   by IMAGE_UNION
7935       = SIGMA f (IMAGE g s1) + SIGMA f (IMAGE g s2) by SUM_IMAGE_DISJOINT
7936
7937   Claim: SIGMA f (IMAGE g s1) = 0
7938   Proof: If s1 = {},
7939            SIGMA f (IMAGE g {})
7940          = SIGMA f {}                               by IMAGE_EMPTY
7941          = 0                                        by SUM_IMAGE_EMPTY
7942          If s1 <> {},
7943            Note !x. x IN s1 ==> (g x = {})          by definition of s1
7944            Thus !y. y IN (IMAGE g s1) ==> (y = {})  by IN_IMAGE, IMAGE_EMPTY
7945           Since s1 <> {}, IMAGE g s1 = {{}}         by SING_DEF, IN_SING, SING_ONE_ELEMENT
7946            SIGMA f (IMAGE g {})
7947          = SIGMA f {{}}                             by above
7948          = f {}                                     by SUM_IMAGE_SING
7949          = 0                                        by given
7950
7951   Step 2: decompose right summation
7952    Also SIGMA (f o g) s
7953       = SIGMA (f o g) (s1 UNION s2)                 by above, s = s1 UNION s2
7954       = SIGMA (f o g) s1 + SIGMA (f o g) s2         by SUM_IMAGE_DISJOINT
7955
7956   Claim: SIGMA (f o g) s1 = 0
7957   Proof: Note !x. x IN s1 ==> (g x = {})            by definition of s1
7958             (f o g) x
7959            = f (g x)                                by function application
7960            = f {}                                   by above
7961            = 0                                      by given
7962          Hence SIGMA (f o g) s1
7963              = 0 * CARD s1                          by SIGMA_CONSTANT
7964              = 0                                    by MULT
7965
7966   Claim: SIGMA f (IMAGE g s2) = SIGMA (f o g) s2
7967   Proof: Note !x. x IN s2 ==> g x <> {}             by definition of s2
7968          Thus INJ g s2 univ(:'b -> bool)            by given
7969          Hence SIGMA f (IMAGE g s2)
7970              = SIGMA (f o g) (s2)                   by sum_image_by_composition
7971
7972   Result follows by combining all the claims and arithmetic.
7973*)
7974Theorem sum_image_by_composition_with_partial_inj:
7975    !s. FINITE s ==> !f:('b -> bool) -> num. (f {} = 0) ==>
7976   !g. (!t. FINITE t /\ (!x. x IN t ==> g x <> {}) ==> INJ g t univ(:'b -> bool)) ==>
7977   (SIGMA f (IMAGE g s) = SIGMA (f o g) s)
7978Proof
7979  rpt strip_tac >>
7980  qabbrev_tac `s1 = {x | x IN s /\ (g x = {})}` >>
7981  qabbrev_tac `s2 = {x | x IN s /\ (g x <> {})}` >>
7982  (`s = s1 UNION s2` by (rw[Abbr`s1`, Abbr`s2`, EXTENSION] >> metis_tac[])) >>
7983  (`DISJOINT s1 s2` by (rw[Abbr`s1`, Abbr`s2`, EXTENSION, DISJOINT_DEF] >> metis_tac[])) >>
7984  (`DISJOINT (IMAGE g s1) (IMAGE g s2)` by (rw[Abbr`s1`, Abbr`s2`, EXTENSION, DISJOINT_DEF] >> metis_tac[])) >>
7985  `s1 SUBSET s /\ s2 SUBSET s` by rw[Abbr`s1`, Abbr`s2`, SUBSET_DEF] >>
7986  `FINITE s1 /\ FINITE s2` by metis_tac[SUBSET_FINITE] >>
7987  `FINITE (IMAGE g s1) /\ FINITE (IMAGE g s2)` by rw[] >>
7988  `SIGMA f (IMAGE g s) = SIGMA f ((IMAGE g s1) UNION (IMAGE g s2))` by rw[] >>
7989  `_ = SIGMA f (IMAGE g s1) + SIGMA f (IMAGE g s2)` by rw[SUM_IMAGE_DISJOINT] >>
7990  `SIGMA f (IMAGE g s1) = 0` by
7991  (Cases_on `s1 = {}` >-
7992  rw[SUM_IMAGE_EMPTY] >>
7993  `!x. x IN s1 ==> (g x = {})` by rw[Abbr`s1`] >>
7994  `!y. y IN (IMAGE g s1) ==> (y = {})` by metis_tac[IN_IMAGE, IMAGE_EMPTY] >>
7995  `{} IN {{}} /\ IMAGE g s1 <> {}` by rw[] >>
7996  `IMAGE g s1 = {{}}` by metis_tac[SING_DEF, IN_SING, SING_ONE_ELEMENT] >>
7997  `SIGMA f (IMAGE g s1) = f {}` by rw[SUM_IMAGE_SING] >>
7998  rw[]
7999  ) >>
8000  `SIGMA (f o g) s = SIGMA (f o g) s1 + SIGMA (f o g) s2` by rw[SUM_IMAGE_DISJOINT] >>
8001  `SIGMA (f o g) s1 = 0` by
8002    (`!x. x IN s1 ==> (g x = {})` by rw[Abbr`s1`] >>
8003  `!x. x IN s1 ==> ((f o g) x = 0)` by rw[] >>
8004  metis_tac[SIGMA_CONSTANT, MULT]) >>
8005  `SIGMA f (IMAGE g s2) = SIGMA (f o g) s2` by
8006      (`!x. x IN s2 ==> g x <> {}` by rw[Abbr`s2`] >>
8007  `INJ g s2 univ(:'b -> bool)` by rw[] >>
8008  rw[sum_image_by_composition]) >>
8009  decide_tac
8010QED
8011
8012(* Theorem: FINITE s ==> !f g. (!x y. x IN s /\ y IN s /\ (g x = g y) ==> (x = y) \/ (f (g x) = 0)) ==>
8013            (SIGMA f (IMAGE g s) = SIGMA (f o g) s) *)
8014(* Proof:
8015   By finite induction on s.
8016   Base: SIGMA f (IMAGE g {}) = SIGMA (f o g) {}
8017        SIGMA f (IMAGE g {})
8018      = SIGMA f {}                 by IMAGE_EMPTY
8019      = 0                          by SUM_IMAGE_EMPTY
8020      = SIGMA (f o g) {}           by SUM_IMAGE_EMPTY
8021   Step: !f g. (!x y. x IN s /\ y IN s /\ (g x = g y) ==> (x = y) \/ (f (g x) = 0)) ==>
8022         (SIGMA f (IMAGE g s) = SIGMA (f o g) s) ==>
8023         e NOTIN s /\ !x y. x IN e INSERT s /\ y IN e INSERT s /\ (g x = g y) ==> (x = y) \/ (f (g x) = 0)
8024         ==> SIGMA f (IMAGE g (e INSERT s)) = SIGMA (f o g) (e INSERT s)
8025      Note !x y. ((x = e) \/ x IN s) /\ ((y = e) \/ y IN s) /\ (g x = g y) ==>
8026                 (x = y) \/ (f (g y) = 0)       by IN_INSERT
8027      If g e IN IMAGE g s,
8028         Then ?x. x IN s /\ (g x = g e)         by IN_IMAGE
8029          and x <> e /\ (f (g e) = 0)           by implication
8030           SIGMA f (g e INSERT IMAGE g s)
8031         = SIGMA f (IMAGE g s)                  by ABSORPTION, g e IN IMAGE g s
8032         = SIGMA (f o g) s                      by induction hypothesis
8033         = f (g x) + SIGMA (f o g) s            by ADD
8034         = (f o g) e + SIGMA (f o g) s          by o_THM
8035         = SIGMA (f o g) (e INSERT s)           by SUM_IMAGE_INSERT, e NOTIN s
8036      If g e NOTIN IMAGE g s,
8037           SIGMA f (g e INSERT IMAGE g s)
8038         = f (g e) + SIGMA f (IMAGE g s)        by SUM_IMAGE_INSERT, g e NOTIN IMAGE g s
8039         = f (g e) + SIGMA (f o g) s            by induction hypothesis
8040         = (f o g) e + SIGMA (f o g) s          by o_THM
8041         = SIGMA (f o g) (e INSERT s)           by SUM_IMAGE_INSERT, e NOTIN s
8042*)
8043Theorem sum_image_by_composition_without_inj:
8044    !s. FINITE s ==> !f g. (!x y. x IN s /\ y IN s /\ (g x = g y) ==> (x = y) \/ (f (g x) = 0)) ==>
8045       (SIGMA f (IMAGE g s) = SIGMA (f o g) s)
8046Proof
8047  Induct_on `FINITE` >>
8048  rpt strip_tac >-
8049  rw[SUM_IMAGE_EMPTY] >>
8050  fs[] >>
8051  Cases_on `g e IN IMAGE g s` >| [
8052    `?x. x IN s /\ (g x = g e)` by metis_tac[IN_IMAGE] >>
8053    `x <> e /\ (f (g e) = 0)` by metis_tac[] >>
8054    `SIGMA f (g e INSERT IMAGE g s) = SIGMA f (IMAGE g s)` by metis_tac[ABSORPTION] >>
8055    `_ = SIGMA (f o g) s` by rw[] >>
8056    `_ = (f o g) e + SIGMA (f o g) s` by rw[] >>
8057    `_ = SIGMA (f o g) (e INSERT s)` by rw[SUM_IMAGE_INSERT] >>
8058    rw[],
8059    `SIGMA f (g e INSERT IMAGE g s) = f (g e) + SIGMA f (IMAGE g s)` by rw[SUM_IMAGE_INSERT] >>
8060    `_ = f (g e) + SIGMA (f o g) s` by rw[] >>
8061    `_ = (f o g) e + SIGMA (f o g) s` by rw[] >>
8062    `_ = SIGMA (f o g) (e INSERT s)` by rw[SUM_IMAGE_INSERT] >>
8063    rw[]
8064  ]
8065QED
8066
8067(* ------------------------------------------------------------------------- *)
8068(* Pre-image Theorems.                                                       *)
8069(* ------------------------------------------------------------------------- *)
8070
8071(* Define preimage *)
8072Definition preimage_def:   preimage f s y = { x | x IN s /\ (f x = y) }
8073End
8074
8075(* Theorem: x IN (preimage f s y) <=> x IN s /\ (f x = y) *)
8076(* Proof: by preimage_def *)
8077Theorem preimage_element:
8078    !f s x y. x IN (preimage f s y) <=> x IN s /\ (f x = y)
8079Proof
8080  rw[preimage_def]
8081QED
8082
8083(* Theorem: x IN preimage f s y <=> (x IN s /\ (f x = y)) *)
8084(* Proof: by preimage_def *)
8085Theorem in_preimage:
8086    !f s x y. x IN preimage f s y <=> (x IN s /\ (f x = y))
8087Proof
8088  rw[preimage_def]
8089QED
8090(* same as theorem above. *)
8091
8092Theorem preimage_alt :
8093    !f s y. preimage f s y = PREIMAGE f {y} INTER s
8094Proof
8095    rw [Once EXTENSION, in_preimage, IN_PREIMAGE, Once CONJ_SYM]
8096QED
8097
8098(* Theorem: (preimage f s y) SUBSET s *)
8099(* Proof:
8100       x IN preimage f s y
8101   <=> x IN s /\ f x = y           by in_preimage
8102   ==> x IN s
8103   Thus (preimage f s y) SUBSET s  by SUBSET_DEF
8104*)
8105Theorem preimage_subset:
8106  !f s y. (preimage f s y) SUBSET s
8107Proof
8108  simp[preimage_def, SUBSET_DEF]
8109QED
8110
8111(* Theorem: FINITE s ==> FINITE (preimage f s y) *)
8112(* Proof:
8113   Note (preimage f s y) SUBSET s  by preimage_subset
8114   Thus FINITE (preimage f s y)    by SUBSET_FINITE
8115*)
8116Theorem preimage_finite:
8117  !f s y. FINITE s ==> FINITE (preimage f s y)
8118Proof
8119  metis_tac[preimage_subset, SUBSET_FINITE]
8120QED
8121
8122(* Theorem: !x. x IN preimage f s y ==> f x = y *)
8123(* Proof: by definition. *)
8124Theorem preimage_property:
8125    !f s y. !x. x IN preimage f s y ==> (f x = y)
8126Proof
8127  rw[preimage_def]
8128QED
8129
8130(* This is bad: every pattern of f x = y (i.e. practically every equality!) will invoke the check: x IN preimage f s y! *)
8131(* val _ = export_rewrites ["preimage_property"]; *)
8132
8133(* Theorem: x IN s ==> x IN preimage f s (f x) *)
8134(* Proof: by IN_IMAGE. preimage_def. *)
8135Theorem preimage_of_image:
8136    !f s x. x IN s ==> x IN preimage f s (f x)
8137Proof
8138  rw[preimage_def]
8139QED
8140
8141(* Theorem: y IN (IMAGE f s) ==> CHOICE (preimage f s y) IN s /\ f (CHOICE (preimage f s y)) = y *)
8142(* Proof:
8143   (1) prove: y IN IMAGE f s ==> CHOICE (preimage f s y) IN s
8144   By IN_IMAGE, this is to show:
8145   x IN s ==> CHOICE (preimage f s (f x)) IN s
8146   Now, preimage f s (f x) <> {}   since x is a pre-image.
8147   hence CHOICE (preimage f s (f x)) IN preimage f s (f x) by CHOICE_DEF
8148   hence CHOICE (preimage f s (f x)) IN s                  by preimage_def
8149   (2) prove: y IN IMAGE f s /\ CHOICE (preimage f s y) IN s ==> f (CHOICE (preimage f s y)) = y
8150   By IN_IMAGE, this is to show: x IN s ==> f (CHOICE (preimage f s (f x))) = f x
8151   Now, x IN preimage f s (f x)   by preimage_of_image
8152   hence preimage f s (f x) <> {}  by MEMBER_NOT_EMPTY
8153   thus  CHOICE (preimage f s (f x)) IN (preimage f s (f x))  by CHOICE_DEF
8154   hence f (CHOICE (preimage f s (f x))) = f x  by preimage_def
8155*)
8156Theorem preimage_choice_property:
8157    !f s y. y IN (IMAGE f s) ==> CHOICE (preimage f s y) IN s /\ (f (CHOICE (preimage f s y)) = y)
8158Proof
8159  rpt gen_tac >>
8160  strip_tac >>
8161  conj_asm1_tac >| [
8162    full_simp_tac std_ss [IN_IMAGE] >>
8163    `CHOICE (preimage f s (f x)) IN preimage f s (f x)` suffices_by rw[preimage_def] >>
8164    metis_tac[CHOICE_DEF, preimage_of_image, MEMBER_NOT_EMPTY],
8165    full_simp_tac std_ss [IN_IMAGE] >>
8166    `x IN preimage f s (f x)` by rw_tac std_ss[preimage_of_image] >>
8167    `CHOICE (preimage f s (f x)) IN (preimage f s (f x))` by metis_tac[CHOICE_DEF, MEMBER_NOT_EMPTY] >>
8168    full_simp_tac std_ss [preimage_def, GSPECIFICATION]
8169  ]
8170QED
8171
8172(* Theorem: INJ f s univ(:'b) ==> !x. x IN s ==> (preimage f s (f x) = {x}) *)
8173(* Proof:
8174     preimage f s (f x)
8175   = {x' | x' IN s /\ (f x' = f x)}    by preimage_def
8176   = {x' | x' IN s /\ (x' = x)}        by INJ_DEF
8177   = {x}                               by EXTENSION
8178*)
8179Theorem preimage_inj:
8180    !f s. INJ f s univ(:'b) ==> !x. x IN s ==> (preimage f s (f x) = {x})
8181Proof
8182  rw[preimage_def, EXTENSION] >>
8183  metis_tac[INJ_DEF]
8184QED
8185
8186(* Theorem: INJ f s univ(:'b) ==> !x. x IN s ==> (CHOICE (preimage f s (f x)) = x) *)
8187(* Proof:
8188     CHOICE (preimage f s (f x))
8189   = CHOICE {x}                     by preimage_inj, INJ f s univ(:'b)
8190   = x                              by CHOICE_SING
8191*)
8192Theorem preimage_inj_choice:
8193    !f s. INJ f s univ(:'b) ==> !x. x IN s ==> (CHOICE (preimage f s (f x)) = x)
8194Proof
8195  rw[preimage_inj]
8196QED
8197
8198(* Theorem: INJ (preimage f s) (IMAGE f s) (POW s) *)
8199(* Proof:
8200   By INJ_DEF, this is to show:
8201   (1) x IN s ==> preimage f s (f x) IN POW s
8202       Let y = preimage f s (f x).
8203       Then y SUBSET s                         by preimage_subset
8204         so y IN (POW s)                       by IN_POW
8205   (2) x IN s /\ y IN s /\ preimage f s (f x) = preimage f s (f y) ==> f x = f y
8206       Note (f x) IN preimage f s (f x)        by in_preimage
8207         so (f y) IN preimage f s (f y)        by given
8208       Thus f x = f y                          by in_preimage
8209*)
8210Theorem preimage_image_inj:
8211  !f s. INJ (preimage f s) (IMAGE f s) (POW s)
8212Proof
8213  rw[INJ_DEF] >-
8214  simp[preimage_subset, IN_POW] >>
8215  metis_tac[in_preimage]
8216QED
8217
8218(* ------------------------------------------------------------------------- *)
8219(* Function Equivalence as Relation                                          *)
8220(* ------------------------------------------------------------------------- *)
8221
8222(* For function f on a domain D, x, y in D are "equal" if f x = f y. *)
8223Definition fequiv_def:
8224  fequiv x y f <=> (f x = f y)
8225End
8226Overload "==" = ``fequiv``
8227val _ = set_fixity "==" (Infix(NONASSOC, 450));
8228
8229(* Theorem: [Reflexive] (x == x) f *)
8230(* Proof: by definition,
8231   and f x = f x.
8232*)
8233Theorem fequiv_refl[simp]:  !f x. (x == x) f
8234Proof rw_tac std_ss[fequiv_def]
8235QED
8236
8237(* Theorem: [Symmetric] (x == y) f ==> (y == x) f *)
8238(* Proof: by defintion,
8239   and f x = f y means the same as f y = f x.
8240*)
8241Theorem fequiv_sym:
8242    !f x y. (x == y) f ==> (y == x) f
8243Proof
8244  rw_tac std_ss[fequiv_def]
8245QED
8246
8247(* no export of commutativity *)
8248
8249(* Theorem: [Transitive] (x == y) f /\ (y == z) f ==> (x == z) f *)
8250(* Proof: by defintion,
8251   and f x = f y
8252   and f y = f z
8253   implies f x = f z.
8254*)
8255Theorem fequiv_trans:
8256    !f x y z. (x == y) f /\ (y == z) f ==> (x == z) f
8257Proof
8258  rw_tac std_ss[fequiv_def]
8259QED
8260
8261(* Theorem: fequiv (==) is an equivalence relation on the domain. *)
8262(* Proof: by reflexive, symmetric and transitive. *)
8263Theorem fequiv_equiv_class:
8264    !f. (\x y. (x == y) f) equiv_on univ(:'a)
8265Proof
8266  rw_tac std_ss[equiv_on_def, fequiv_def, EQ_IMP_THM]
8267QED
8268
8269(* ------------------------------------------------------------------------- *)
8270(* Function-based Equivalence                                                *)
8271(* ------------------------------------------------------------------------- *)
8272
8273Overload feq = “flip (flip o fequiv)”
8274Overload feq_class[inferior] = “preimage”
8275
8276(* Theorem: x IN feq_class f s n <=> x IN s /\ (f x = n) *)
8277(* Proof: by feq_class_def *)
8278Theorem feq_class_element = in_preimage
8279
8280(* Note:
8281    y IN equiv_class (feq f) s x
8282<=> y IN s /\ (feq f x y)      by equiv_class_element
8283<=> y IN s /\ (f x = f y)      by feq_def
8284*)
8285
8286(* Theorem: feq_class f s (f x) = equiv_class (feq f) s x *)
8287(* Proof:
8288     feq_class f s (f x)
8289   = {y | y IN s /\ (f y = f x)}    by feq_class_def
8290   = {y | y IN s /\ (f x = f y)}
8291   = {y | y IN s /\ (feq f x y)}    by feq_def
8292   = equiv_class (feq f) s x        by notation
8293*)
8294Theorem feq_class_property:
8295    !f s x. feq_class f s (f x) = equiv_class (feq f) s x
8296Proof
8297  rw[in_preimage, EXTENSION, fequiv_def] >> metis_tac[]
8298QED
8299
8300(* Theorem: (feq_class f s) o f = equiv_class (feq f) s *)
8301(* Proof: by FUN_EQ_THM, feq_class_property *)
8302Theorem feq_class_fun:
8303    !f s. (feq_class f s) o f = equiv_class (feq f) s
8304Proof
8305  rw[FUN_EQ_THM, feq_class_property]
8306QED
8307
8308(* Theorem: feq f equiv_on s *)
8309(* Proof: by equiv_on_def, feq_def *)
8310Theorem feq_equiv:
8311    !s f. feq f equiv_on s
8312Proof
8313  rw[equiv_on_def, fequiv_def] >>
8314  metis_tac[]
8315QED
8316
8317(* Theorem: partition (feq f) s = IMAGE ((feq_class f s) o f) s *)
8318(* Proof:
8319   Use partition_def |> ISPEC ``feq f`` |> ISPEC ``(s:'a -> bool)``;
8320
8321    partition (feq f) s
8322  = {t | ?x. x IN s /\ (t = {y | y IN s /\ feq f x y})}     by partition_def
8323  = {t | ?x. x IN s /\ (t = {y | y IN s /\ (f x = f y)})}   by feq_def
8324  = {t | ?x. x IN s /\ (t = feq_class f s (f x))}           by feq_class_def
8325  = {feq_class f s (f x) | x | x IN s }                     by rewriting
8326  = IMAGE (feq_class f s) (IMAGE f s)                       by IN_IMAGE
8327  = IMAGE ((feq_class f s) o f) s                           by IMAGE_COMPOSE
8328*)
8329Theorem feq_partition:
8330    !s f. partition (feq f) s = IMAGE ((feq_class f s) o f) s
8331Proof
8332  rw[partition_def, fequiv_def, in_preimage, EXTENSION, EQ_IMP_THM] >>
8333  metis_tac[]
8334QED
8335
8336(* Theorem: t IN partition (feq f) s <=> ?z. z IN s /\ (!x. x IN t <=> x IN s /\ (f x = f z)) *)
8337(* Proof: by feq_partition, feq_class_def, EXTENSION *)
8338Theorem feq_partition_element:
8339  !s f t. t IN partition (feq f) s <=>
8340          ?z. z IN s /\ (!x. x IN t <=> x IN s /\ (f x = f z))
8341Proof
8342  rw[feq_partition, in_preimage, EXTENSION] >> metis_tac[]
8343QED
8344
8345(* Theorem: x IN s <=> ?e. e IN partition (feq f) s /\ x IN e *)
8346(* Proof:
8347   Note (feq f) equiv_on s         by feq_equiv
8348   This result follows             by partition_element_exists
8349*)
8350Theorem feq_partition_element_exists:
8351  !f s x. x IN s <=> ?e. e IN partition (feq f) s /\ x IN e
8352Proof
8353  simp[feq_equiv, partition_element_exists]
8354QED
8355
8356(* Theorem: e IN partition (feq f) s ==> e <> {} *)
8357(* Proof:
8358   Note (feq f) equiv_on s     by feq_equiv
8359     so e <> {}                by partition_element_not_empty
8360*)
8361Theorem feq_partition_element_not_empty:
8362  !f s e. e IN partition (feq f) s ==> e <> {}
8363Proof
8364  metis_tac[feq_equiv, partition_element_not_empty]
8365QED
8366
8367(* Theorem: partition (feq f) s = IMAGE (preimage f s o f) s *)
8368(* Proof:
8369       x IN partition (feq f) s
8370   <=> ?z. z IN s /\ !j. j IN x <=> j IN s /\ (f j = f z)      by feq_partition_element
8371   <=> ?z. z IN s /\ !j. j IN x <=> j IN (preimage f s (f z))  by preimage_element
8372   <=> ?z. z IN s /\ (x = preimage f s (f z))                  by EXTENSION
8373   <=> ?z. z IN s /\ (x = (preimage f s o f) z)                by composition (o_THM)
8374   <=> x IN IMAGE (preimage f s o f) s                         by IN_IMAGE
8375   Hence partition (feq f) s = IMAGE (preimage f s o f) s      by EXTENSION
8376
8377   or,
8378     partition (feq f) s
8379   = IMAGE (feq_class f s o f) s     by feq_partition
8380   = IMAGE (preiamge f s o f) s      by feq_class_eq_preimage
8381*)
8382val feq_partition_by_preimage = feq_partition
8383
8384(* Theorem: FINITE s ==> !f g. SIGMA g s = SIGMA (SIGMA g) (partition (feq f) s) *)
8385(* Proof:
8386   Since (feq f) equiv_on s   by feq_equiv
8387   Hence !g. SIGMA g s = SIGMA (SIGMA g) (partition (feq f) s)  by set_sigma_by_partition
8388*)
8389Theorem feq_sum_over_partition:
8390    !s. FINITE s ==> !f g. SIGMA g s = SIGMA (SIGMA g) (partition (feq f) s)
8391Proof
8392  rw[feq_equiv, set_sigma_by_partition]
8393QED
8394
8395(* Theorem: FINITE s ==> !f. CARD s = SIGMA CARD (partition (feq f) s) *)
8396(* Proof:
8397   Note feq equiv_on s   by feq_equiv
8398   The result follows    by partition_CARD
8399*)
8400Theorem finite_card_by_feq_partition:
8401    !s. FINITE s ==> !f. CARD s = SIGMA CARD (partition (feq f) s)
8402Proof
8403  rw[feq_equiv, partition_CARD]
8404QED
8405
8406(* Theorem: FINITE s ==> !f. CARD s = SIGMA CARD (IMAGE ((preimage f s) o f) s) *)
8407(* Proof:
8408   Note (feq f) equiv_on s                       by feq_equiv
8409        CARD s
8410      = SIGMA CARD (partition (feq f) s)         by partition_CARD
8411      = SIGMA CARD (IMAGE (preimage f s o f) s)  by feq_partition_by_preimage
8412*)
8413Theorem finite_card_by_image_preimage:
8414    !s. FINITE s ==> !f. CARD s = SIGMA CARD (IMAGE ((preimage f s) o f) s)
8415Proof
8416  rw[feq_equiv, partition_CARD, GSYM feq_partition]
8417QED
8418
8419(* Theorem: FINITE s /\ SURJ f s t ==>
8420            CARD s = SIGMA CARD (IMAGE (preimage f s) t) *)
8421(* Proof:
8422     CARD s
8423   = SIGMA CARD (IMAGE (preimage f s o f) s)           by finite_card_by_image_preimage
8424   = SIGMA CARD (IMAGE (preimage f s) (IMAGE f s))     by IMAGE_COMPOSE
8425   = SIGMA CARD (IMAGE (preimage f s) t)               by IMAGE_SURJ
8426*)
8427Theorem finite_card_surj_by_image_preimage:
8428  !f s t. FINITE s /\ SURJ f s t ==>
8429          CARD s = SIGMA CARD (IMAGE (preimage f s) t)
8430Proof
8431  rpt strip_tac >>
8432  `CARD s = SIGMA CARD (IMAGE (preimage f s o f) s)` by rw[finite_card_by_image_preimage] >>
8433  `_ = SIGMA CARD (IMAGE (preimage f s) (IMAGE f s))` by rw[IMAGE_COMPOSE] >>
8434  `_ = SIGMA CARD (IMAGE (preimage f s) t)` by fs[IMAGE_SURJ] >>
8435  simp[]
8436QED
8437
8438(* Theorem: BIJ (preimage f s) (IMAGE f s) (partition (feq f) s) *)
8439(* Proof:
8440   Let g = preimage f s, t = IMAGE f s.
8441   Note INJ g t (POW s)                        by preimage_image_inj
8442     so BIJ g t (IMAGE g t)                    by INJ_IMAGE_BIJ
8443    But IMAGE g t
8444      = IMAGE (preimage f s) (IMAGE f s)       by notation
8445      = IMAGE (preimage f s o f) s             by IMAGE_COMPOSE
8446      = partition (feq f) s                    by feq_partition_by_preimage
8447   Thus BIJ g t (partition (feq f) s)          by above
8448*)
8449Theorem preimage_image_bij:
8450  !f s. BIJ (preimage f s) (IMAGE f s) (partition (feq f) s)
8451Proof
8452  rpt strip_tac >>
8453  qabbrev_tac `g = preimage f s` >>
8454  qabbrev_tac `t = IMAGE f s` >>
8455  `BIJ g t (IMAGE g t)` by metis_tac[preimage_image_inj, INJ_IMAGE_BIJ] >>
8456  simp[IMAGE_COMPOSE, feq_partition, Abbr`g`, Abbr`t`]
8457QED
8458
8459(* ------------------------------------------------------------------------- *)
8460(* Condition for surjection to be a bijection.                               *)
8461(* ------------------------------------------------------------------------- *)
8462
8463(* Theorem: INJ f s (IMAGE f s) <=> !e. e IN (partition (feq f) s) ==> SING e *)
8464(* Proof:
8465   If part: e IN partition (feq f) s ==> SING e
8466          e IN partition (feq f) s
8467      <=> ?z. z IN s /\ !x. x IN e <=> x IN s /\ f x = f z
8468                                               by feq_partition_element
8469      Thus z IN e, so e <> {}                  by MEMBER_NOT_EMPTY
8470       and !x. x IN e ==> x = z                by INJ_DEF
8471        so SING e                              by SING_ONE_ELEMENT
8472   Only-if part: !e. e IN partition (feq f) s ==> SING e ==> INJ f s (IMAGE f s)
8473      By INJ_DEF, IN_IMAGE, this is to show:
8474         !x y. x IN s /\ y IN s /\ f x = f y ==> x = y
8475      Note ?e. e IN (partition (feq f) s) /\ x IN e
8476                                               by feq_partition_element_exists
8477       and y IN e                              by feq_partition_element
8478      then SING e                              by implication
8479        so x = y                               by IN_SING
8480*)
8481Theorem inj_iff_partition_element_sing:
8482  !f s. INJ f s (IMAGE f s) <=> !e. e IN (partition (feq f) s) ==> SING e
8483Proof
8484  rw[EQ_IMP_THM] >| [
8485    fs[feq_partition_element, INJ_DEF] >>
8486    `e <> {}` by metis_tac[MEMBER_NOT_EMPTY] >>
8487    simp[SING_ONE_ELEMENT],
8488    rw[INJ_DEF] >>
8489    `?e. e IN (partition (feq f) s) /\ x IN e` by fs[GSYM feq_partition_element_exists] >>
8490    `y IN e` by metis_tac[feq_partition_element] >>
8491    metis_tac[SING_DEF, IN_SING]
8492  ]
8493QED
8494
8495(* Theorem: FINITE s ==>
8496            (INJ f s (IMAGE f s) <=> !e. e IN (partition (feq f) s) ==> CARD e = 1) *)
8497(* Proof:
8498       INJ f s (IMAGE f s)
8499   <=> !e. e IN (partition (feq f) s) ==> SING e       by inj_iff_partition_element_sing
8500   <=> !e. e IN (partition (feq f) s) ==> CARD e = 1   by FINITE_partition, CARD_EQ_1
8501*)
8502Theorem inj_iff_partition_element_card_1:
8503  !f s. FINITE s ==>
8504        (INJ f s (IMAGE f s) <=> !e. e IN (partition (feq f) s) ==> CARD e = 1)
8505Proof
8506  metis_tac[inj_iff_partition_element_sing, FINITE_partition, CARD_EQ_1]
8507QED
8508
8509(* Idea: for a finite domain, with target same size, surjection means injection. *)
8510
8511(* Theorem: FINITE s /\ CARD s = CARD t /\ SURJ f s t ==> INJ f s t *)
8512(* Proof:
8513   Let p = partition (feq f) s.
8514   Note IMAGE f s = t              by IMAGE_SURJ
8515     so FINITE t                   by IMAGE_FINITE
8516    and CARD s = SIGMA CARD p      by finite_card_by_feq_partition
8517    and CARD t = CARD p            by preimage_image_bij, bij_eq_card
8518   Thus CARD p = SIGMA CARD p      by given CARD s = CARD t
8519    Now FINITE p                   by FINITE_partition
8520    and !e. e IN p ==> FINITE e    by FINITE_partition
8521    and !e. e IN p ==> e <> {}     by feq_partition_element_not_empty
8522     so !e. e IN p ==> CARD e <> 0 by CARD_EQ_0
8523   Thus !e. e IN p ==> CARD e = 1  by card_eq_sigma_card
8524     or INJ f s (IMAGE f s)        by inj_iff_partition_element_card_1
8525     so INJ f s t                  by IMAGE f s = t
8526*)
8527Theorem FINITE_SURJ_IS_INJ:
8528  !f s t. FINITE s /\ CARD s = CARD t /\ SURJ f s t ==> INJ f s t
8529Proof
8530  rpt strip_tac >>
8531  imp_res_tac finite_card_by_feq_partition >>
8532  first_x_assum (qspec_then `f` strip_assume_tac) >>
8533  qabbrev_tac `p = partition (feq f) s` >>
8534  `IMAGE f s = t` by fs[IMAGE_SURJ] >>
8535  `FINITE t` by rw[] >>
8536  `CARD t = CARD p` by metis_tac[preimage_image_bij, FINITE_BIJ_CARD] >>
8537  `FINITE p /\ !e. e IN p ==> FINITE e` by metis_tac[FINITE_partition] >>
8538  `!e. e IN p ==> CARD e <> 0` by metis_tac[feq_partition_element_not_empty, CARD_EQ_0] >>
8539  `!e. e IN p ==> CARD e = 1` by metis_tac[card_eq_sigma_card] >>
8540  metis_tac[inj_iff_partition_element_card_1]
8541QED
8542
8543(* ------------------------------------------------------------------------- *)
8544(* Function Iteration                                                        *)
8545(* ------------------------------------------------------------------------- *)
8546
8547(* Theorem: 0 < k /\ FUNPOW f k e = e  ==> !n. FUNPOW f (n*k) e = e *)
8548(* Proof:
8549   By induction on n:
8550   Base case: FUNPOW f (0 * k) e = e
8551     FUNPOW f (0 * k) e
8552   = FUNPOW f 0 e          by arithmetic
8553   = e                     by FUNPOW_0
8554   Step case: FUNPOW f (n * k) e = e ==> FUNPOW f (SUC n * k) e = e
8555     FUNPOW f (SUC n * k) e
8556   = FUNPOW f (k + n * k) e         by arithmetic
8557   = FUNPOW f k (FUNPOW (n * k) e)  by FUNPOW_ADD.
8558   = FUNPOW f k e                   by induction hypothesis
8559   = e                              by given
8560*)
8561Theorem FUNPOW_MULTIPLE:
8562    !f k e. 0 < k /\ (FUNPOW f k e = e)  ==> !n. FUNPOW f (n*k) e = e
8563Proof
8564  rpt strip_tac >>
8565  Induct_on `n` >-
8566  rw[] >>
8567  metis_tac[MULT_COMM, MULT_SUC, FUNPOW_ADD]
8568QED
8569
8570(* Theorem: 0 < k /\ FUNPOW f k e = e  ==> !n. FUNPOW f n e = FUNPOW f (n MOD k) e *)
8571(* Proof:
8572     FUNPOW f n e
8573   = FUNPOW f ((n DIV k) * k + (n MOD k)) e       by division algorithm
8574   = FUNPOW f ((n MOD k) + (n DIV k) * k) e       by arithmetic
8575   = FUNPOW f (n MOD k) (FUNPOW (n DIV k) * k e)  by FUNPOW_ADD
8576   = FUNPOW f (n MOD k) e                         by FUNPOW_MULTIPLE
8577*)
8578Theorem FUNPOW_MOD:
8579    !f k e. 0 < k /\ (FUNPOW f k e = e)  ==> !n. FUNPOW f n e = FUNPOW f (n MOD k) e
8580Proof
8581  rpt strip_tac >>
8582  `n = (n MOD k) + (n DIV k) * k` by metis_tac[DIVISION, ADD_COMM] >>
8583  metis_tac[FUNPOW_ADD, FUNPOW_MULTIPLE]
8584QED
8585
8586(* Overload a RISING function (temporalizaed by Chun Tian) *)
8587Overload RISING[local] = ``\f. !x:num. x <= f x``
8588
8589(* Overload a FALLING function (temporalizaed by Chun Tian) *)
8590Overload FALLING[local] = ``\f. !x:num. f x <= x``
8591
8592(* Theorem: RISING f /\ m <= n ==> !x. FUNPOW f m x <= FUNPOW f n x *)
8593(* Proof:
8594   By induction on n.
8595   Base: !m. m <= 0 ==> !x. FUNPOW f m x <= FUNPOW f 0 x
8596      Note m = 0, and FUNPOW f 0 x <= FUNPOW f 0 x.
8597   Step:  !m. RISING f /\ m <= n ==> !x. FUNPOW f m x <= FUNPOW f n x ==>
8598          !m. m <= SUC n ==> FUNPOW f m x <= FUNPOW f (SUC n) x
8599      Note m <= n or m = SUC n.
8600      If m = SUC n, this is trivial.
8601      If m <= n,
8602             FUNPOW f m x
8603          <= FUNPOW f n x            by induction hypothesis
8604          <= f (FUNPOW f n x)        by RISING f
8605           = FUNPOW f (SUC n) x      by FUNPOW_SUC
8606*)
8607Theorem FUNPOW_LE_RISING:
8608    !f m n. RISING f /\ m <= n ==> !x. FUNPOW f m x <= FUNPOW f n x
8609Proof
8610  strip_tac >>
8611  Induct_on `n` >-
8612  rw[] >>
8613  rpt strip_tac >>
8614  `(m <= n) \/ (m = SUC n)` by decide_tac >| [
8615    `FUNPOW f m x <= FUNPOW f n x` by rw[] >>
8616    `FUNPOW f n x <= f (FUNPOW f n x)` by rw[] >>
8617    `f (FUNPOW f n x) = FUNPOW f (SUC n) x` by rw[FUNPOW_SUC] >>
8618    decide_tac,
8619    rw[]
8620  ]
8621QED
8622
8623(* Theorem: FALLING f /\ m <= n ==> !x. FUNPOW f n x <= FUNPOW f m x *)
8624(* Proof:
8625   By induction on n.
8626   Base: !m. m <= 0 ==> !x. FUNPOW f 0 x <= FUNPOW f m x
8627      Note m = 0, and FUNPOW f 0 x <= FUNPOW f 0 x.
8628   Step:  !m. FALLING f /\ m <= n ==> !x. FUNPOW f n x <= FUNPOW f m x ==>
8629          !m. m <= SUC n ==> FUNPOW f (SUC n) x <= FUNPOW f m x
8630      Note m <= n or m = SUC n.
8631      If m = SUC n, this is trivial.
8632      If m <= n,
8633            FUNPOW f (SUC n) x
8634          = f (FUNPOW f n x)         by FUNPOW_SUC
8635         <= FUNPOW f n x             by FALLING f
8636         <= FUNPOW f m x             by induction hypothesis
8637*)
8638Theorem FUNPOW_LE_FALLING:
8639    !f m n. FALLING f /\ m <= n ==> !x. FUNPOW f n x <= FUNPOW f m x
8640Proof
8641  strip_tac >>
8642  Induct_on `n` >-
8643  rw[] >>
8644  rpt strip_tac >>
8645  `(m <= n) \/ (m = SUC n)` by decide_tac >| [
8646    `FUNPOW f (SUC n) x = f (FUNPOW f n x)` by rw[FUNPOW_SUC] >>
8647    `f (FUNPOW f n x) <= FUNPOW f n x` by rw[] >>
8648    `FUNPOW f n x <= FUNPOW f m x` by rw[] >>
8649    decide_tac,
8650    rw[]
8651  ]
8652QED
8653
8654(* Theorem: (!x. f x <= g x) /\ MONO g ==> !n x. FUNPOW f n x <= FUNPOW g n x *)
8655(* Proof:
8656   By induction on n.
8657   Base: FUNPOW f 0 x <= FUNPOW g 0 x
8658         FUNPOW f 0 x          by FUNPOW_0
8659       = x
8660       <= x = FUNPOW g 0 x     by FUNPOW_0
8661   Step: FUNPOW f n x <= FUNPOW g n x ==> FUNPOW f (SUC n) x <= FUNPOW g (SUC n) x
8662         FUNPOW f (SUC n) x
8663       = f (FUNPOW f n x)      by FUNPOW_SUC
8664      <= g (FUNPOW f n x)      by !x. f x <= g x
8665      <= g (FUNPOW g n x)      by induction hypothesis, MONO g
8666       = FUNPOW g (SUC n) x    by FUNPOW_SUC
8667*)
8668Theorem FUNPOW_LE_MONO:
8669    !f g. (!x. f x <= g x) /\ MONO g ==> !n x. FUNPOW f n x <= FUNPOW g n x
8670Proof
8671  rpt strip_tac >>
8672  Induct_on `n` >-
8673  rw[] >>
8674  rw[FUNPOW_SUC] >>
8675  `f (FUNPOW f n x) <= g (FUNPOW f n x)` by rw[] >>
8676  `g (FUNPOW f n x) <= g (FUNPOW g n x)` by rw[] >>
8677  decide_tac
8678QED
8679
8680(* Note:
8681There is no FUNPOW_LE_RMONO. FUNPOW_LE_MONO says:
8682|- !f g. (!x. f x <= g x) /\ MONO g ==> !n x. FUNPOW f n x <= FUNPOW g n x
8683To compare the terms in these two sequences:
8684     x, f x, f (f x), f (f (f x)), ......
8685     x, g x, g (g x), g (g (g x)), ......
8686For the first pair:       x <= x.
8687For the second pair:    f x <= g x,      as g is cover.
8688For the third pair: f (f x) <= g (f x)   by g is cover,
8689                            <= g (g x)   by MONO g, and will not work if RMONO g.
8690*)
8691
8692(* Theorem: (!x. f x <= g x) /\ MONO f ==> !n x. FUNPOW f n x <= FUNPOW g n x *)
8693(* Proof:
8694   By induction on n.
8695   Base: FUNPOW f 0 x <= FUNPOW g 0 x
8696         FUNPOW f 0 x          by FUNPOW_0
8697       = x
8698       <= x = FUNPOW g 0 x     by FUNPOW_0
8699   Step: FUNPOW f n x <= FUNPOW g n x ==> FUNPOW f (SUC n) x <= FUNPOW g (SUC n) x
8700         FUNPOW f (SUC n) x
8701       = f (FUNPOW f n x)      by FUNPOW_SUC
8702      <= f (FUNPOW g n x)      by induction hypothesis, MONO f
8703      <= g (FUNPOW g n x)      by !x. f x <= g x
8704       = FUNPOW g (SUC n) x    by FUNPOW_SUC
8705*)
8706Theorem FUNPOW_GE_MONO:
8707    !f g. (!x. f x <= g x) /\ MONO f ==> !n x. FUNPOW f n x <= FUNPOW g n x
8708Proof
8709  rpt strip_tac >>
8710  Induct_on `n` >-
8711  rw[] >>
8712  rw[FUNPOW_SUC] >>
8713  `f (FUNPOW f n x) <= f (FUNPOW g n x)` by rw[] >>
8714  `f (FUNPOW g n x) <= g (FUNPOW g n x)` by rw[] >>
8715  decide_tac
8716QED
8717
8718(* Note: the name FUNPOW_SUC is taken:
8719FUNPOW_SUC  |- !f n x. FUNPOW f (SUC n) x = f (FUNPOW f n x)
8720*)
8721
8722(* Theorem: FUNPOW SUC n m = m + n *)
8723(* Proof:
8724   By induction on n.
8725   Base: !m. FUNPOW SUC 0 m = m + 0
8726      LHS = FUNPOW SUC 0 m
8727          = m                  by FUNPOW_0
8728          = m + 0 = RHS        by ADD_0
8729   Step: !m. FUNPOW SUC n m = m + n ==>
8730         !m. FUNPOW SUC (SUC n) m = m + SUC n
8731       FUNPOW SUC (SUC n) m
8732     = FUNPOW SUC n (SUC m)    by FUNPOW
8733     = (SUC m) + n             by induction hypothesis
8734     = m + SUC n               by arithmetic
8735*)
8736Theorem FUNPOW_ADD1:
8737    !m n. FUNPOW SUC n m = m + n
8738Proof
8739  Induct_on `n` >>
8740  rw[FUNPOW]
8741QED
8742
8743(* Theorem: FUNPOW PRE n m = m - n *)
8744(* Proof:
8745   By induction on n.
8746   Base: !m. FUNPOW PRE 0 m = m - 0
8747      LHS = FUNPOW PRE 0 m
8748          = m                  by FUNPOW_0
8749          = m + 0 = RHS        by ADD_0
8750   Step: !m. FUNPOW PRE n m = m - n ==>
8751         !m. FUNPOW PRE (SUC n) m = m - SUC n
8752       FUNPOW PRE (SUC n) m
8753     = FUNPOW PRE n (PRE m)    by FUNPOW
8754     = (PRE m) - n             by induction hypothesis
8755     = m - PRE n               by arithmetic
8756*)
8757Theorem FUNPOW_SUB1:
8758    !m n. FUNPOW PRE n m = m - n
8759Proof
8760  Induct_on `n` >-
8761  rw[] >>
8762  rw[FUNPOW]
8763QED
8764
8765(* Theorem: FUNPOW ($* b) n m = m * b ** n *)
8766(* Proof:
8767   By induction on n.
8768   Base: !m. !m. FUNPOW ($* b) 0 m = m * b ** 0
8769      LHS = FUNPOW ($* b) 0 m
8770          = m                  by FUNPOW_0
8771          = m * 1              by MULT_RIGHT_1
8772          = m * b ** 0 = RHS   by EXP_0
8773   Step: !m. FUNPOW ($* b) n m = m * b ** n ==>
8774         !m. FUNPOW ($* b) (SUC n) m = m * b ** SUC n
8775       FUNPOW ($* b) (SUC n) m
8776     = FUNPOW ($* b) n (b * m)    by FUNPOW
8777     = b * m * b ** n             by induction hypothesis
8778     = m * (b * b ** n)           by arithmetic
8779     = m * b ** SUC n             by EXP
8780*)
8781Theorem FUNPOW_MUL:
8782    !b m n. FUNPOW ($* b) n m = m * b ** n
8783Proof
8784  strip_tac >>
8785  Induct_on `n` >-
8786  rw[] >>
8787  rw[FUNPOW, EXP]
8788QED
8789
8790(* Theorem: 0 < b ==> (FUNPOW (combin$C $DIV b) n m = m DIV (b ** n)) *)
8791(* Proof:
8792   By induction on n.
8793   Let f = combin$C $DIV b.
8794   Base: !m. FUNPOW f 0 m = m DIV b ** 0
8795      LHS = FUNPOW f 0 m
8796          = m                     by FUNPOW_0
8797          = m DIV 1               by DIV_1
8798          = m DIV (b ** 0) = RHS  by EXP_0
8799   Step: !m. FUNPOW f n m = m DIV b ** n ==>
8800         !m. FUNPOW f (SUC n) m = m DIV b ** SUC n
8801       FUNPOW f (SUC n) m
8802     = FUNPOW f n (f m)           by FUNPOW
8803     = FUNPOW f n (m DIV b)       by C_THM
8804     = (m DIV b) DIV (b ** n)     by induction hypothesis
8805     = m DIV (b * b ** n)         by DIV_DIV_DIV_MULT, 0 < b, 0 < b ** n
8806     = m DIV b ** SUC n           by EXP
8807*)
8808Theorem FUNPOW_DIV:
8809    !b m n. 0 < b ==> (FUNPOW (combin$C $DIV b) n m = m DIV (b ** n))
8810Proof
8811  strip_tac >>
8812  qabbrev_tac `f = combin$C $DIV b` >>
8813  Induct_on `n` >-
8814  rw[EXP_0] >>
8815  rpt strip_tac >>
8816  `FUNPOW f (SUC n) m = FUNPOW f n (m DIV b)` by rw[FUNPOW, Abbr`f`] >>
8817  `_ = (m DIV b) DIV (b ** n)` by rw[] >>
8818  `_ = m DIV (b * b ** n)` by rw[DIV_DIV_DIV_MULT] >>
8819  `_ = m DIV b ** SUC n` by rw[EXP] >>
8820  decide_tac
8821QED
8822
8823(* Theorem: FUNPOW SQ n m = m ** (2 ** n) *)
8824(* Proof:
8825   By induction on n.
8826   Base: !m. FUNPOW (\n. SQ n) 0 m = m ** 2 ** 0
8827        FUNPOW SQ 0 m
8828      = m               by FUNPOW_0
8829      = m ** 1          by EXP_1
8830      = m ** 2 ** 0     by EXP_0
8831   Step: !m. FUNPOW (\n. SQ n) n m = m ** 2 ** n ==>
8832         !m. FUNPOW (\n. SQ n) (SUC n) m = m ** 2 ** SUC n
8833        FUNPOW (\n. SQ n) (SUC n) m
8834      = SQ (FUNPOW (\n. SQ n) n m)    by FUNPOW_SUC
8835      = SQ (m ** 2 ** n)              by induction hypothesis
8836      = (m ** 2 ** n) ** 2            by EXP_2
8837      = m ** (2 * 2 ** n)             by EXP_EXP_MULT
8838      = m ** 2 ** SUC n               by EXP
8839*)
8840Theorem FUNPOW_SQ:
8841    !m n. FUNPOW SQ n m = m ** (2 ** n)
8842Proof
8843  Induct_on `n` >-
8844  rw[] >>
8845  rw[FUNPOW_SUC, GSYM EXP_EXP_MULT, EXP]
8846QED
8847
8848(* Theorem: 0 < m /\ 0 < n ==> (FUNPOW (\n. (n * n) MOD m) n k = (k ** 2 ** n) MOD m) *)
8849(* Proof:
8850   Lef f = (\n. SQ n MOD m).
8851   By induction on n.
8852   Base: !k. 0 < m /\ 0 < 0 ==> FUNPOW f 0 k = k ** 2 ** 0 MOD m
8853      True since 0 < 0 = F.
8854   Step: !k. 0 < m /\ 0 < n ==> FUNPOW f n k = k ** 2 ** n MOD m ==>
8855         !k. 0 < m /\ 0 < SUC n ==> FUNPOW f (SUC n) k = k ** 2 ** SUC n MOD m
8856     If n = 1,
8857       FUNPOW f (SUC 0) k
8858     = FUNPOW f 1 k             by ONE
8859     = f k                      by FUNPOW_1
8860     = SQ k MOD m               by notation
8861     = (k ** 2) MOD m           by EXP_2
8862     = (k ** (2 ** 1)) MOD m    by EXP_1
8863     If n <> 0,
8864       FUNPOW f (SUC n) k
8865     = f (FUNPOW f n k)         by FUNPOW_SUC
8866     = f (k ** 2 ** n MOD m)    by induction hypothesis
8867     = (k ** 2 ** n MOD m) * (k ** 2 ** n MOD m) MOD m     by notation
8868     = (k ** 2 ** n * k ** 2 ** n) MOD m                   by MOD_TIMES2
8869     = (k ** (2 ** n + 2 ** n)) MOD m          by EXP_BASE_MULT
8870     = (k ** (2 * 2 ** n)) MOD m               by arithmetic
8871     = (k ** 2 ** SUC n) MOD m                 by EXP
8872*)
8873Theorem FUNPOW_SQ_MOD:
8874    !m n k. 0 < m /\ 0 < n ==> (FUNPOW (\n. (n * n) MOD m) n k = (k ** 2 ** n) MOD m)
8875Proof
8876  strip_tac >>
8877  qabbrev_tac `f = \n. SQ n MOD m` >>
8878  Induct >>
8879  simp[] >>
8880  rpt strip_tac >>
8881  Cases_on `n = 0` >-
8882  simp[Abbr`f`] >>
8883  rw[FUNPOW_SUC, Abbr`f`] >>
8884  `(k ** 2 ** n) ** 2 = k ** (2 * 2 ** n)` by rw[GSYM EXP_EXP_MULT] >>
8885  `_ = k ** 2 ** SUC n` by rw[EXP] >>
8886  rw[]
8887QED
8888
8889(* Theorem: 0 < n ==> (FUNPOW (\x. MAX x m) n k = MAX k m) *)
8890(* Proof:
8891   By induction on n.
8892   Base: !m k. 0 < 0 ==> FUNPOW (\x. MAX x m) 0 k = MAX k m
8893      True by 0 < 0 = F.
8894   Step: !m k. 0 < n ==> FUNPOW (\x. MAX x m) n k = MAX k m ==>
8895         !m k. 0 < SUC n ==> FUNPOW (\x. MAX x m) (SUC n) k = MAX k m
8896      If n = 0,
8897           FUNPOW (\x. MAX x m) (SUC 0) k
8898         = FUNPOW (\x. MAX x m) 1 k          by ONE
8899         = (\x. MAX x m) k                   by FUNPOW_1
8900         = MAX k m                           by function application
8901      If n <> 0,
8902           FUNPOW (\x. MAX x m) (SUC n) k
8903         = f (FUNPOW (\x. MAX x m) n k)      by FUNPOW_SUC
8904         = (\x. MAX x m) (MAX k m)           by induction hypothesis
8905         = MAX (MAX k m) m                   by function application
8906         = MAX k m                           by MAX_IS_MAX, m <= MAX k m
8907*)
8908Theorem FUNPOW_MAX:
8909    !m n k. 0 < n ==> (FUNPOW (\x. MAX x m) n k = MAX k m)
8910Proof
8911  Induct_on `n` >-
8912  simp[] >>
8913  rpt strip_tac >>
8914  Cases_on `n = 0` >-
8915  rw[] >>
8916  rw[FUNPOW_SUC] >>
8917  `m <= MAX k m` by rw[] >>
8918  rw[MAX_DEF]
8919QED
8920
8921(* Theorem: 0 < n ==> (FUNPOW (\x. MIN x m) n k = MIN k m) *)
8922(* Proof:
8923   By induction on n.
8924   Base: !m k. 0 < 0 ==> FUNPOW (\x. MIN x m) 0 k = MIN k m
8925      True by 0 < 0 = F.
8926   Step: !m k. 0 < n ==> FUNPOW (\x. MIN x m) n k = MIN k m ==>
8927         !m k. 0 < SUC n ==> FUNPOW (\x. MIN x m) (SUC n) k = MIN k m
8928      If n = 0,
8929           FUNPOW (\x. MIN x m) (SUC 0) k
8930         = FUNPOW (\x. MIN x m) 1 k          by ONE
8931         = (\x. MIN x m) k                   by FUNPOW_1
8932         = MIN k m                           by function application
8933      If n <> 0,
8934           FUNPOW (\x. MIN x m) (SUC n) k
8935         = f (FUNPOW (\x. MIN x m) n k)      by FUNPOW_SUC
8936         = (\x. MIN x m) (MIN k m)           by induction hypothesis
8937         = MIN (MIN k m) m                   by function application
8938         = MIN k m                           by MIN_IS_MIN, MIN k m <= m
8939*)
8940Theorem FUNPOW_MIN:
8941    !m n k. 0 < n ==> (FUNPOW (\x. MIN x m) n k = MIN k m)
8942Proof
8943  Induct_on `n` >-
8944  simp[] >>
8945  rpt strip_tac >>
8946  Cases_on `n = 0` >-
8947  rw[] >>
8948  rw[FUNPOW_SUC] >>
8949  `MIN k m <= m` by rw[] >>
8950  rw[MIN_DEF]
8951QED
8952
8953(* Theorem: FUNPOW (\(x,y). (f x, g y)) n (x,y) = (FUNPOW f n x, FUNPOW g n y) *)
8954(* Proof:
8955   By induction on n.
8956   Base: FUNPOW (\(x,y). (f x,g y)) 0 (x,y) = (FUNPOW f 0 x,FUNPOW g 0 y)
8957          FUNPOW (\(x,y). (f x,g y)) 0 (x,y)
8958        = (x,y)                           by FUNPOW_0
8959        = (FUNPOW f 0 x, FUNPOW g 0 y)    by FUNPOW_0
8960   Step: FUNPOW (\(x,y). (f x,g y)) n (x,y) = (FUNPOW f n x,FUNPOW g n y) ==>
8961         FUNPOW (\(x,y). (f x,g y)) (SUC n) (x,y) = (FUNPOW f (SUC n) x,FUNPOW g (SUC n) y)
8962         FUNPOW (\(x,y). (f x,g y)) (SUC n) (x,y)
8963       = (\(x,y). (f x,g y)) (FUNPOW (\(x,y). (f x,g y)) n (x,y)) by FUNPOW_SUC
8964       = (\(x,y). (f x,g y)) (FUNPOW f n x,FUNPOW g n y)          by induction hypothesis
8965       = (f (FUNPOW f n x),g (FUNPOW g n y))                      by function application
8966       = (FUNPOW f (SUC n) x,FUNPOW g (SUC n) y)                  by FUNPOW_SUC
8967*)
8968Theorem FUNPOW_PAIR:
8969    !f g n x y. FUNPOW (\(x,y). (f x, g y)) n (x,y) = (FUNPOW f n x, FUNPOW g n y)
8970Proof
8971  rpt strip_tac >>
8972  Induct_on `n` >>
8973  rw[FUNPOW_SUC]
8974QED
8975
8976(* Theorem: FUNPOW (\(x,y,z). (f x, g y, h z)) n (x,y,z) = (FUNPOW f n x, FUNPOW g n y, FUNPOW h n z) *)
8977(* Proof:
8978   By induction on n.
8979   Base: FUNPOW (\(x,y,z). (f x,g y,h z)) 0 (x,y,z) = (FUNPOW f 0 x,FUNPOW g 0 y,FUNPOW h 0 z)
8980          FUNPOW (\(x,y,z). (f x,g y,h z)) 0 (x,y,z)
8981        = (x,y)                                         by FUNPOW_0
8982        = (FUNPOW f 0 x, FUNPOW g 0 y, FUNPOW h 0 z)    by FUNPOW_0
8983   Step: FUNPOW (\(x,y,z). (f x,g y,h z)) n (x,y,z) =
8984                (FUNPOW f n x,FUNPOW g n y,FUNPOW h n z) ==>
8985         FUNPOW (\(x,y,z). (f x,g y,h z)) (SUC n) (x,y,z) =
8986                (FUNPOW f (SUC n) x,FUNPOW g (SUC n) y,FUNPOW h (SUC n) z)
8987       Let fun = (\(x,y,z). (f x,g y,h z)).
8988         FUNPOW fun (SUC n) (x,y, z)
8989       = fun (FUNPOW fun n (x,y,z))                                   by FUNPOW_SUC
8990       = fun (FUNPOW f n x,FUNPOW g n y, FUNPOW h n z)                by induction hypothesis
8991       = (f (FUNPOW f n x),g (FUNPOW g n y), h (FUNPOW h n z))        by function application
8992       = (FUNPOW f (SUC n) x,FUNPOW g (SUC n) y, FUNPOW h (SUC n) z)  by FUNPOW_SUC
8993*)
8994Theorem FUNPOW_TRIPLE:
8995    !f g h n x y z. FUNPOW (\(x,y,z). (f x, g y, h z)) n (x,y,z) =
8996                  (FUNPOW f n x, FUNPOW g n y, FUNPOW h n z)
8997Proof
8998  rpt strip_tac >>
8999  Induct_on `n` >>
9000  rw[FUNPOW_SUC]
9001QED
9002
9003
9004(* Theorem: f PERMUTES s ==> (LINV f s) PERMUTES s *)
9005(* Proof: by BIJ_LINV_BIJ *)
9006Theorem LINV_permutes:
9007  !f s. f PERMUTES s ==> (LINV f s) PERMUTES s
9008Proof
9009  rw[BIJ_LINV_BIJ]
9010QED
9011
9012(* Theorem: f PERMUTES s ==> (FUNPOW f n) PERMUTES s *)
9013(* Proof:
9014   By induction on n.
9015   Base: FUNPOW f 0 PERMUTES s
9016      Note FUNPOW f 0 = I         by FUN_EQ_THM, FUNPOW_0
9017       and I PERMUTES s           by BIJ_I_SAME
9018      thus true.
9019   Step: f PERMUTES s /\ FUNPOW f n PERMUTES s ==>
9020         FUNPOW f (SUC n) PERMUTES s
9021      Note FUNPOW f (SUC n)
9022         = f o (FUNPOW f n)       by FUN_EQ_THM, FUNPOW_SUC
9023      Thus true                   by BIJ_COMPOSE
9024*)
9025Theorem FUNPOW_permutes:
9026  !f s n. f PERMUTES s ==> (FUNPOW f n) PERMUTES s
9027Proof
9028  rpt strip_tac >>
9029  Induct_on `n` >| [
9030    `FUNPOW f 0 = I` by rw[FUN_EQ_THM] >>
9031    simp[BIJ_I_SAME],
9032    `FUNPOW f (SUC n) = f o (FUNPOW f n)` by rw[FUN_EQ_THM, FUNPOW_SUC] >>
9033    metis_tac[BIJ_COMPOSE]
9034  ]
9035QED
9036
9037(* Theorem: f PERMUTES s /\ x IN s ==> FUNPOW f n x IN s *)
9038(* Proof:
9039   By induction on n.
9040   Base: FUNPOW f 0 x IN s
9041         Since FUNPOW f 0 x = x      by FUNPOW_0
9042         This is trivially true.
9043   Step: FUNPOW f n x IN s ==> FUNPOW f (SUC n) x IN s
9044           FUNPOW f (SUC n) x
9045         = f (FUNPOW f n x)          by FUNPOW_SUC
9046         But FUNPOW f n x IN s       by induction hypothesis
9047          so f (FUNPOW f n x) IN s   by BIJ_ELEMENT, f PERMUTES s
9048*)
9049Theorem FUNPOW_closure:
9050  !f s x n. f PERMUTES s /\ x IN s ==> FUNPOW f n x IN s
9051Proof
9052  rpt strip_tac >>
9053  Induct_on `n` >-
9054  rw[] >>
9055  metis_tac[FUNPOW_SUC, BIJ_ELEMENT]
9056QED
9057
9058(* Theorem: f PERMUTES s ==> FUNPOW (LINV f s) n PERMUTES s *)
9059(* Proof: by LINV_permutes, FUNPOW_permutes *)
9060Theorem FUNPOW_LINV_permutes:
9061  !f s n. f PERMUTES s ==> FUNPOW (LINV f s) n PERMUTES s
9062Proof
9063  simp[LINV_permutes, FUNPOW_permutes]
9064QED
9065
9066(* Theorem: f PERMUTES s /\ x IN s ==> FUNPOW f n x IN s *)
9067(* Proof:
9068   By induction on n.
9069   Base: FUNPOW (LINV f s) 0 x IN s
9070         Since FUNPOW (LINV f s) 0 x = x   by FUNPOW_0
9071         This is trivially true.
9072   Step: FUNPOW (LINV f s) n x IN s ==> FUNPOW (LINV f s) (SUC n) x IN s
9073           FUNPOW (LINV f s) (SUC n) x
9074         = (LINV f s) (FUNPOW (LINV f s) n x)   by FUNPOW_SUC
9075         But FUNPOW (LINV f s) n x IN s         by induction hypothesis
9076         and (LINV f s) PERMUTES s              by LINV_permutes
9077          so (LINV f s) (FUNPOW (LINV f s) n x) IN s
9078                                                by BIJ_ELEMENT
9079*)
9080Theorem FUNPOW_LINV_closure:
9081  !f s x n. f PERMUTES s /\ x IN s ==> FUNPOW (LINV f s) n x IN s
9082Proof
9083  rpt strip_tac >>
9084  Induct_on `n` >-
9085  rw[] >>
9086  `(LINV f s) PERMUTES s` by rw[LINV_permutes] >>
9087  prove_tac[FUNPOW_SUC, BIJ_ELEMENT]
9088QED
9089
9090(* Theorem: f PERMUTES s /\ x IN s ==> FUNPOW f n (FUNPOW (LINV f s) n x) = x *)
9091(* Proof:
9092   By induction on n.
9093   Base: FUNPOW f 0 (FUNPOW (LINV f s) 0 x) = x
9094           FUNPOW f 0 (FUNPOW (LINV f s) 0 x)
9095         = FUNPOW f 0 x              by FUNPOW_0
9096         = x                         by FUNPOW_0
9097   Step: FUNPOW f n (FUNPOW (LINV f s) n x) = x ==>
9098         FUNPOW f (SUC n) (FUNPOW (LINV f s) (SUC n) x) = x
9099         Note (FUNPOW (LINV f s) n x) IN s        by FUNPOW_LINV_closure
9100           FUNPOW f (SUC n) (FUNPOW (LINV f s) (SUC n) x)
9101         = FUNPOW f (SUC n) ((LINV f s) (FUNPOW (LINV f s) n x))  by FUNPOW_SUC
9102         = FUNPOW f n (f ((LINV f s) (FUNPOW (LINV f s) n x)))    by FUNPOW
9103         = FUNPOW f n (FUNPOW (LINV f s) n x)                     by BIJ_LINV_THM
9104         = x                                      by induction hypothesis
9105*)
9106Theorem FUNPOW_LINV_EQ:
9107  !f s x n. f PERMUTES s /\ x IN s ==> FUNPOW f n (FUNPOW (LINV f s) n x) = x
9108Proof
9109  rpt strip_tac >>
9110  Induct_on `n` >-
9111  rw[] >>
9112  `FUNPOW f (SUC n) (FUNPOW (LINV f s) (SUC n) x)
9113    = FUNPOW f (SUC n) ((LINV f s) (FUNPOW (LINV f s) n x))` by rw[FUNPOW_SUC] >>
9114  `_ = FUNPOW f n (f ((LINV f s) (FUNPOW (LINV f s) n x)))` by rw[FUNPOW] >>
9115  `_ = FUNPOW f n (FUNPOW (LINV f s) n x)` by metis_tac[BIJ_LINV_THM, FUNPOW_LINV_closure] >>
9116  simp[]
9117QED
9118
9119(* Theorem: f PERMUTES s /\ x IN s ==> FUNPOW (LINV f s) n (FUNPOW f n x) = x *)
9120(* Proof:
9121   By induction on n.
9122   Base: FUNPOW (LINV f s) 0 (FUNPOW f 0 x) = x
9123           FUNPOW (LINV f s) 0 (FUNPOW f 0 x)
9124         = FUNPOW (LINV f s) 0 x     by FUNPOW_0
9125         = x                         by FUNPOW_0
9126   Step: FUNPOW (LINV f s) n (FUNPOW f n x) = x ==>
9127         FUNPOW (LINV f s) (SUC n) (FUNPOW f (SUC n) x) = x
9128         Note (FUNPOW f n x) IN s                 by FUNPOW_closure
9129           FUNPOW (LINV f s) (SUC n) (FUNPOW f (SUC n) x)
9130         = FUNPOW (LINV f s) (SUC n) (f (FUNPOW f n x))           by FUNPOW_SUC
9131         = FUNPOW (LINV f s) n ((LINV f s) (f (FUNPOW f n x)))    by FUNPOW
9132         = FUNPOW (LINV f s) n (FUNPOW f n x)                     by BIJ_LINV_THM
9133         = x                                      by induction hypothesis
9134*)
9135Theorem FUNPOW_EQ_LINV:
9136  !f s x n. f PERMUTES s /\ x IN s ==> FUNPOW (LINV f s) n (FUNPOW f n x) = x
9137Proof
9138  rpt strip_tac >>
9139  Induct_on `n` >-
9140  rw[] >>
9141  `FUNPOW (LINV f s) (SUC n) (FUNPOW f (SUC n) x)
9142    = FUNPOW (LINV f s) (SUC n) (f (FUNPOW f n x))` by rw[FUNPOW_SUC] >>
9143  `_ = FUNPOW (LINV f s) n ((LINV f s) (f (FUNPOW f n x)))` by rw[FUNPOW] >>
9144  `_ = FUNPOW (LINV f s) n (FUNPOW f n x)` by metis_tac[BIJ_LINV_THM, FUNPOW_closure] >>
9145  simp[]
9146QED
9147
9148(* Theorem: f PERMUTES s /\ x IN s /\ m <= n ==>
9149            FUNPOW f (n - m) x = FUNPOW f n (FUNPOW (LINV f s) m x) *)
9150(* Proof:
9151     FUNPOW f n (FUNPOW (LINV f s) m x)
9152   = FUNPOW f (n - m + m) (FUNPOW (LINV f s) m x)   by SUB_ADD, m <= n
9153   = FUNPOW f (n - m) (FUNPOW f m (FUNPOW (LINV f s) m x))  by FUNPOW_ADD
9154   = FUNPOW f (n - m) x                             by FUNPOW_LINV_EQ
9155*)
9156Theorem FUNPOW_SUB_LINV1:
9157  !f s x m n. f PERMUTES s /\ x IN s /\ m <= n ==>
9158              FUNPOW f (n - m) x = FUNPOW f n (FUNPOW (LINV f s) m x)
9159Proof
9160  rpt strip_tac >>
9161  `FUNPOW f n (FUNPOW (LINV f s) m x)
9162  = FUNPOW f (n - m + m) (FUNPOW (LINV f s) m x)` by simp[] >>
9163  `_ = FUNPOW f (n - m) (FUNPOW f m (FUNPOW (LINV f s) m x))` by rw[FUNPOW_ADD] >>
9164  `_ = FUNPOW f (n - m) x` by rw[FUNPOW_LINV_EQ] >>
9165  simp[]
9166QED
9167
9168(* Theorem: f PERMUTES s /\ x IN s /\ m <= n ==>
9169            FUNPOW f (n - m) x = FUNPOW (LINV f s) m (FUNPOW f n x) *)
9170(* Proof:
9171   Note FUNPOW f (n - m) x IN s                      by FUNPOW_closure
9172     FUNPOW (LINV f s) m (FUNPOW f n x)
9173   = FUNPOW (LINV f s) m (FUNPOW f (n - m + m) x)    by SUB_ADD, m <= n
9174   = FUNPOW (LINV f s) m (FUNPOW f (m + (n - m)) x)  by ADD_COMM
9175   = FUNPOW (LINV f s) m (FUNPOW f m (FUNPOW f (n - m) x))  by FUNPOW_ADD
9176   = FUNPOW f (n - m) x                              by FUNPOW_EQ_LINV
9177*)
9178Theorem FUNPOW_SUB_LINV2:
9179  !f s x m n. f PERMUTES s /\ x IN s /\ m <= n ==>
9180              FUNPOW f (n - m) x = FUNPOW (LINV f s) m (FUNPOW f n x)
9181Proof
9182  rpt strip_tac >>
9183  `FUNPOW (LINV f s) m (FUNPOW f n x)
9184  = FUNPOW (LINV f s) m (FUNPOW f (n - m + m) x)` by simp[] >>
9185  `_ = FUNPOW (LINV f s) m (FUNPOW f (m + (n - m)) x)` by metis_tac[ADD_COMM] >>
9186  `_ = FUNPOW (LINV f s) m (FUNPOW f m (FUNPOW f (n - m) x))` by rw[FUNPOW_ADD] >>
9187  `_ = FUNPOW f (n - m) x` by rw[FUNPOW_EQ_LINV, FUNPOW_closure] >>
9188  simp[]
9189QED
9190
9191(* Theorem: f PERMUTES s /\ x IN s /\ m <= n ==>
9192            FUNPOW (LINV f s) (n - m) x = FUNPOW (LINV f s) n (FUNPOW f m x) *)
9193(* Proof:
9194     FUNPOW (LINV f s) n (FUNPOW f m x)
9195   = FUNPOW (LINV f s) (n - m + m) (FUNPOW f m x)    by SUB_ADD, m <= n
9196   = FUNPOW (LINV f s) (n - m) (FUNPOW (LINV f s) m (FUNPOW f m x))  by FUNPOW_ADD
9197   = FUNPOW (LINV f s) (n - m) x                     by FUNPOW_EQ_LINV
9198*)
9199Theorem FUNPOW_LINV_SUB1:
9200  !f s x m n. f PERMUTES s /\ x IN s /\ m <= n ==>
9201              FUNPOW (LINV f s) (n - m) x = FUNPOW (LINV f s) n (FUNPOW f m x)
9202Proof
9203  rpt strip_tac >>
9204  `FUNPOW (LINV f s) n (FUNPOW f m x)
9205  = FUNPOW (LINV f s) (n - m + m) (FUNPOW f m x)` by simp[] >>
9206  `_ = FUNPOW (LINV f s) (n - m) (FUNPOW (LINV f s) m (FUNPOW f m x))` by rw[FUNPOW_ADD] >>
9207  `_ = FUNPOW (LINV f s) (n - m) x` by rw[FUNPOW_EQ_LINV] >>
9208  simp[]
9209QED
9210
9211(* Theorem: f PERMUTES s /\ x IN s /\ m <= n ==>
9212            FUNPOW (LINV f s) (n - m) x = FUNPOW f m (FUNPOW (LINV f s) n x) *)
9213(* Proof:
9214   Note FUNPOW (LINV f s) (n - m) x IN s             by FUNPOW_LINV_closure
9215     FUNPOW f m (FUNPOW (LINV f s) n x)
9216   = FUNPOW f m (FUNPOW (LINV f s) (n - m + m) x)    by SUB_ADD, m <= n
9217   = FUNPOW f m (FUNPOW (LINV f s) (m + (n - m)) x)  by ADD_COMM
9218   = FUNPOW f m (FUNPOW (LINV f s) m (FUNPOW (LINV f s) (n - m) x))  by FUNPOW_ADD
9219   = FUNPOW (LINV f s) (n - m) x                     by FUNPOW_LINV_EQ
9220*)
9221Theorem FUNPOW_LINV_SUB2:
9222  !f s x m n. f PERMUTES s /\ x IN s /\ m <= n ==>
9223              FUNPOW (LINV f s) (n - m) x = FUNPOW f m (FUNPOW (LINV f s) n x)
9224Proof
9225  rpt strip_tac >>
9226  `FUNPOW f m (FUNPOW (LINV f s) n x)
9227  = FUNPOW f m (FUNPOW (LINV f s) (n - m + m) x)` by simp[] >>
9228  `_ = FUNPOW f m (FUNPOW (LINV f s) (m + (n - m)) x)` by metis_tac[ADD_COMM] >>
9229  `_ = FUNPOW f m (FUNPOW (LINV f s) m (FUNPOW (LINV f s) (n - m) x))` by rw[FUNPOW_ADD] >>
9230  `_ = FUNPOW (LINV f s) (n - m) x` by rw[FUNPOW_LINV_EQ, FUNPOW_LINV_closure] >>
9231  simp[]
9232QED
9233
9234(* Theorem: f PERMUTES s /\ x IN s /\ y IN s ==>
9235            (x = FUNPOW f n y <=> y = FUNPOW (LINV f s) n x) *)
9236(* Proof:
9237   If part: x = FUNPOW f n y ==> y = FUNPOW (LINV f s) n x)
9238        FUNPOW (LINV f s) n x)
9239      = FUNPOW (LINV f s) n (FUNPOW f n y))   by x = FUNPOW f n y
9240      = y                                     by FUNPOW_EQ_LINV
9241   Only-if part: y = FUNPOW (LINV f s) n x) ==> x = FUNPOW f n y
9242        FUNPOW f n y
9243      = FUNPOW f n (FUNPOW (LINV f s) n x))   by y = FUNPOW (LINV f s) n x)
9244      = x                                     by FUNPOW_LINV_EQ
9245*)
9246Theorem FUNPOW_LINV_INV:
9247  !f s x y n. f PERMUTES s /\ x IN s /\ y IN s ==>
9248              (x = FUNPOW f n y <=> y = FUNPOW (LINV f s) n x)
9249Proof
9250  rw[EQ_IMP_THM] >-
9251  rw[FUNPOW_EQ_LINV] >>
9252  rw[FUNPOW_LINV_EQ]
9253QED
9254
9255(* ------------------------------------------------------------------------- *)
9256(* Euler Set and Totient Function Documentation                              *)
9257(* ------------------------------------------------------------------------- *)
9258(* Overloading:
9259   natural n    = IMAGE SUC (count n)
9260   upto n       = count (SUC n)
9261*)
9262(* Definitions and Theorems (# are exported, ! in computeLib):
9263
9264   Residues:
9265   residue_def       |- !n. residue n = {i | 0 < i /\ i < n}
9266   residue_element   |- !n j. j IN residue n ==> 0 < j /\ j < n
9267   residue_0         |- residue 0 = {}
9268   residue_1         |- residue 1 = {}
9269   residue_nonempty  |- !n. 1 < n ==> residue n <> {}
9270   residue_no_zero   |- !n. 0 NOTIN residue n
9271   residue_no_self   |- !n. n NOTIN residue n
9272!  residue_thm       |- !n. residue n = count n DIFF {0}
9273   residue_insert    |- !n. 0 < n ==> (residue (SUC n) = n INSERT residue n)
9274   residue_delete    |- !n. 0 < n ==> (residue n DELETE n = residue n)
9275   residue_suc       |- !n. 0 < n ==> (residue (SUC n) = n INSERT residue n)
9276   residue_count     |- !n. 0 < n ==> (count n = 0 INSERT residue n)
9277   residue_finite    |- !n. FINITE (residue n)
9278   residue_card      |- !n. 0 < n ==> (CARD (residue n) = n - 1)
9279   residue_prime_neq |- !p a n. prime p /\ a IN residue p /\ n <= p ==>
9280                        !x. x IN residue n ==> (a * n) MOD p <> (a * x) MOD p
9281   prod_set_residue  |- !n. PROD_SET (residue n) = FACT (n - 1)
9282
9283   Naturals:
9284   natural_element  |- !n j. j IN natural n <=> 0 < j /\ j <= n
9285   natural_property |- !n. natural n = {j | 0 < j /\ j <= n}
9286   natural_finite   |- !n. FINITE (natural n)
9287   natural_card     |- !n. CARD (natural n) = n
9288   natural_not_0    |- !n. 0 NOTIN natural n
9289   natural_0        |- natural 0 = {}
9290   natural_1        |- natural 1 = {1}
9291   natural_has_1    |- !n. 0 < n ==> 1 IN natural n
9292   natural_has_last |- !n. 0 < n ==> n IN natural n
9293   natural_suc      |- !n. natural (SUC n) = SUC n INSERT natural n
9294   natural_thm      |- !n. natural n = set (GENLIST SUC n)
9295   natural_divisor_natural   |- !n a b. 0 < n /\ a IN natural n /\ b divides a ==> b IN natural n
9296   natural_cofactor_natural  |- !n a b. 0 < n /\ 0 < a /\ b IN natural n /\ a divides b ==>
9297                                        b DIV a IN natural n
9298   natural_cofactor_natural_reduced
9299                             |- !n a b. 0 < n /\ a divides n /\ b IN natural n /\ a divides b ==>
9300                                        b DIV a IN natural (n DIV a)
9301
9302   Uptos:
9303   upto_finite      |- !n. FINITE (upto n)
9304   upto_card        |- !n. CARD (upto n) = SUC n
9305   upto_has_last    |- !n. n IN upto n
9306   upto_delete      |- !n. upto n DELETE n = count n
9307   upto_split_first |- !n. upto n = {0} UNION natural n
9308   upto_split_last  |- !n. upto n = count n UNION {n}
9309   upto_by_count    |- !n. upto n = n INSERT count n
9310   upto_by_natural  |- !n. upto n = 0 INSERT natural n
9311   natural_by_upto  |- !n. natural n = upto n DELETE 0
9312
9313   Euler Set and Totient Function:
9314   Euler_def            |- !n. Euler n = {i | 0 < i /\ i < n /\ coprime n i}
9315   totient_def          |- !n. totient n = CARD (Euler n)
9316   Euler_element        |- !n x. x IN Euler n <=> 0 < x /\ x < n /\ coprime n x
9317!  Euler_thm            |- !n. Euler n = residue n INTER {j | coprime j n}
9318   Euler_finite         |- !n. FINITE (Euler n)
9319   Euler_0              |- Euler 0 = {}
9320   Euler_1              |- Euler 1 = {}
9321   Euler_has_1          |- !n. 1 < n ==> 1 IN Euler n
9322   Euler_nonempty       |- !n. 1 < n ==> Euler n <> {}
9323   Euler_empty          |- !n. (Euler n = {}) <=> (n = 0 \/ n = 1)
9324   Euler_card_upper_le  |- !n. totient n <= n
9325   Euler_card_upper_lt  |- !n. 1 < n ==> totient n < n
9326   Euler_card_bounds    |- !n. totient n <= n /\ (1 < n ==> 0 < totient n /\ totient n < n)
9327   Euler_prime          |- !p. prime p ==> (Euler p = residue p)
9328   Euler_card_prime     |- !p. prime p ==> (totient p = p - 1)
9329
9330   Summation of Geometric Sequence:
9331   sigma_geometric_natural_eqn   |- !p. 0 < p ==>
9332                                    !n. (p - 1) * SIGMA (\j. p ** j) (natural n) = p * (p ** n - 1)
9333   sigma_geometric_natural       |- !p. 1 < p ==>
9334                                    !n. SIGMA (\j. p ** j) (natural n) = p * (p ** n - 1) DIV (p - 1)
9335
9336   Chinese Remainder Theorem:
9337   mod_mod_prod_eq     |- !m n a b. 0 < m /\ 0 < n /\ a MOD (m * n) = b MOD (m * n) ==>
9338                                    a MOD m = b MOD m /\ a MOD n = b MOD n
9339   coprime_mod_mod_prod_eq
9340                       |- !m n a b. 0 < m /\ 0 < n /\ coprime m n /\
9341                                    a MOD m = b MOD m /\ a MOD n = b MOD n ==>
9342                                    a MOD (m * n) = b MOD (m * n)
9343   coprime_mod_mod_prod_eq_iff
9344                       |- !m n. 0 < m /\ 0 < n /\ coprime m n ==>
9345                          !a b. a MOD (m * n) = b MOD (m * n) <=>
9346                                a MOD m = b MOD m /\ a MOD n = b MOD n
9347   coprime_mod_mod_solve
9348                       |- !m n a b. 0 < m /\ 0 < n /\ coprime m n ==>
9349                               ?!x. x < m * n /\ x MOD m = a MOD m /\ x MOD n = b MOD n
9350
9351   Useful Theorems:
9352   PROD_SET_IMAGE_EXP_NONZERO    |- !n m. PROD_SET (IMAGE (\j. n ** j) (count m)) =
9353                                          PROD_SET (IMAGE (\j. n ** j) (residue m))
9354*)
9355
9356(* ------------------------------------------------------------------------- *)
9357(* Residues -- close-relative of COUNT                                       *)
9358(* ------------------------------------------------------------------------- *)
9359
9360(* Define the set of residues = nonzero remainders *)
9361Definition residue_def[nocompute]:   residue n = { i | (0 < i) /\ (i < n) }
9362End
9363(* use zDefine as this is not computationally effective. *)
9364
9365(* Theorem: j IN residue n ==> 0 < j /\ j < n *)
9366(* Proof: by residue_def. *)
9367Theorem residue_element:
9368    !n j. j IN residue n ==> 0 < j /\ j < n
9369Proof
9370  rw[residue_def]
9371QED
9372
9373(* Theorem: residue 0 = EMPTY *)
9374(* Proof: by residue_def *)
9375Theorem residue_0:
9376  residue 0 = {}
9377Proof
9378  simp[residue_def]
9379QED
9380
9381(* Theorem: residue 1 = EMPTY *)
9382(* Proof: by residue_def. *)
9383Theorem residue_1:
9384  residue 1 = {}
9385Proof
9386  simp[residue_def]
9387QED
9388
9389(* Theorem: 1 < n ==> residue n <> {} *)
9390(* Proof:
9391   By residue_def, this is to show: 1 < n ==> ?x. x <> 0 /\ x < n
9392   Take x = 1, this is true.
9393*)
9394Theorem residue_nonempty:
9395    !n. 1 < n ==> residue n <> {}
9396Proof
9397  rw[residue_def, EXTENSION] >>
9398  metis_tac[DECIDE``1 <> 0``]
9399QED
9400
9401(* Theorem: 0 NOTIN residue n *)
9402(* Proof: by residue_def *)
9403Theorem residue_no_zero:
9404  !n. 0 NOTIN residue n
9405Proof
9406  simp[residue_def]
9407QED
9408
9409(* Theorem: n NOTIN residue n *)
9410(* Proof: by residue_def *)
9411Theorem residue_no_self:
9412  !n. n NOTIN residue n
9413Proof
9414  simp[residue_def]
9415QED
9416
9417(* Theorem: residue n = (count n) DIFF {0} *)
9418(* Proof:
9419     residue n
9420   = {i | 0 < i /\ i < n}   by residue_def
9421   = {i | i < n /\ i <> 0}  by NOT_ZERO_LT_ZERO
9422   = {i | i < n} DIFF {0}   by IN_DIFF
9423   = (count n) DIFF {0}     by count_def
9424*)
9425Theorem residue_thm[compute]:
9426    !n. residue n = (count n) DIFF {0}
9427Proof
9428  rw[residue_def, EXTENSION]
9429QED
9430(* This is effective, put in computeLib. *)
9431
9432(*
9433> EVAL ``residue 10``;
9434val it = |- residue 10 = {9; 8; 7; 6; 5; 4; 3; 2; 1}: thm
9435*)
9436
9437(* Theorem: For n > 0, residue (SUC n) = n INSERT residue n *)
9438(* Proof:
9439     residue (SUC n)
9440   = {1, 2, ..., n}
9441   = n INSERT {1, 2, ..., (n-1) }
9442   = n INSERT residue n
9443*)
9444Theorem residue_insert:
9445    !n. 0 < n ==> (residue (SUC n) = n INSERT residue n)
9446Proof
9447  srw_tac[ARITH_ss][residue_def, EXTENSION]
9448QED
9449
9450(* Theorem: (residue n) DELETE n = residue n *)
9451(* Proof: Because n is not in (residue n). *)
9452Theorem residue_delete:
9453    !n. 0 < n ==> ((residue n) DELETE n = residue n)
9454Proof
9455  rpt strip_tac >>
9456  `n NOTIN (residue n)` by rw[residue_def] >>
9457  metis_tac[DELETE_NON_ELEMENT]
9458QED
9459
9460(* Theorem alias: rename *)
9461Theorem residue_suc = residue_insert;
9462(* val residue_suc = |- !n. 0 < n ==> (residue (SUC n) = n INSERT residue n): thm *)
9463
9464(* Theorem: count n = 0 INSERT (residue n) *)
9465(* Proof: by definition. *)
9466Theorem residue_count:
9467    !n. 0 < n ==> (count n = 0 INSERT (residue n))
9468Proof
9469  srw_tac[ARITH_ss][residue_def, EXTENSION]
9470QED
9471
9472(* Theorem: FINITE (residue n) *)
9473(* Proof: by FINITE_COUNT.
9474   If n = 0, residue 0 = {}, hence FINITE.
9475   If n > 0, count n = 0 INSERT (residue n)  by residue_count
9476   hence true by FINITE_COUNT and FINITE_INSERT.
9477*)
9478Theorem residue_finite:
9479    !n. FINITE (residue n)
9480Proof
9481  Cases >-
9482  rw[residue_def] >>
9483  metis_tac[residue_count, FINITE_INSERT, count_def, FINITE_COUNT, DECIDE ``0 < SUC n``]
9484QED
9485
9486(* Theorem: For n > 0, CARD (residue n) = n-1 *)
9487(* Proof:
9488   Since 0 INSERT (residue n) = count n by residue_count
9489   the result follows by CARD_COUNT.
9490*)
9491Theorem residue_card:
9492    !n. 0 < n ==> (CARD (residue n) = n-1)
9493Proof
9494  rpt strip_tac >>
9495  `0 NOTIN (residue n)` by rw[residue_def] >>
9496  `0 INSERT (residue n) = count n` by rw[residue_count] >>
9497  `SUC (CARD (residue n)) = n` by metis_tac[residue_finite, CARD_INSERT, CARD_COUNT] >>
9498  decide_tac
9499QED
9500
9501(* Theorem: For prime m, a in residue m, n <= m, a*n MOD m <> a*x MOD m  for all x in residue n *)
9502(* Proof:
9503   Assume the contrary, that a*n MOD m = a*x MOD m
9504   Since a in residue m and m is prime, MOD_MULT_LCANCEL gives: n MOD m = x MOD m
9505   If n = m, n MOD m = 0, but x MOD m <> 0, hence contradiction.
9506   If n < m, then since x < n <= m, n = x, contradicting x < n.
9507*)
9508Theorem residue_prime_neq:
9509    !p a n. prime p /\ a IN (residue p) /\ n <= p ==> !x. x IN (residue n) ==> (a*n) MOD p <> (a*x) MOD p
9510Proof
9511  rw[residue_def] >>
9512  spose_not_then strip_assume_tac >>
9513  `0 < p` by rw[PRIME_POS] >>
9514  `(a MOD p <> 0) /\ (x MOD p <> 0)` by rw_tac arith_ss[] >>
9515  `n MOD p = x MOD p` by metis_tac[MOD_MULT_LCANCEL] >>
9516  Cases_on `n = p` >-
9517  metis_tac [DIVMOD_ID] >>
9518  `n < p` by decide_tac >>
9519  `(n MOD p = n) /\ (x MOD p = x)` by rw_tac arith_ss[] >>
9520  decide_tac
9521QED
9522
9523(* Idea: the product of residues is a factorial. *)
9524
9525(* Theorem: PROD_SET (residue n) = FACT (n - 1) *)
9526(* Proof:
9527   By induction on n.
9528   Base: PROD_SET (residue 0) = FACT (0 - 1)
9529        PROD_SET (residue 0)
9530      = PROD_SET {}            by residue_0
9531      = 1                      by PROD_SET_EMPTY
9532      = FACT 0                 by FACT_0
9533      = FACT (0 - 1)           by arithmetic
9534   Step: PROD_SET (residue n) = FACT (n - 1) ==>
9535         PROD_SET (residue (SUC n)) = FACT (SUC n - 1)
9536      If n = 0,
9537        PROD_SET (residue (SUC 0))
9538      = PROD_SET (residue 1)   by ONE
9539      = PROD_SET {}            by residue_1
9540      = 1                      by PROD_SET_EMPTY
9541      = FACT 0                 by FACT_0
9542
9543      If n <> 0, then 0 < n.
9544      Note FINITE (residue n)                  by residue_finite
9545        PROD_SET (residue (SUC n))
9546      = PROD_SET (n INSERT residue n)          by residue_insert
9547      = n * PROD_SET ((residue n) DELETE n)    by PROD_SET_THM
9548      = n * PROD_SET (residue n)               by residue_delete
9549      = n * FACT (n - 1)                       by induction hypothesis
9550      = FACT (SUC (n - 1))                     by FACT
9551      = FACT (SUC n - 1)                       by arithmetic
9552*)
9553Theorem prod_set_residue:
9554  !n. PROD_SET (residue n) = FACT (n - 1)
9555Proof
9556  Induct >-
9557  simp[residue_0, PROD_SET_EMPTY, FACT_0] >>
9558  Cases_on `n = 0` >-
9559  simp[residue_1, PROD_SET_EMPTY, FACT_0] >>
9560  `FINITE (residue n)` by rw[residue_finite] >>
9561  `n = SUC (n - 1)` by decide_tac >>
9562  `SUC (n - 1) = SUC n - 1` by decide_tac >>
9563  `PROD_SET (residue (SUC n)) = PROD_SET (n INSERT residue n)` by rw[residue_insert] >>
9564  `_ = n * PROD_SET ((residue n) DELETE n)` by rw[PROD_SET_THM] >>
9565  `_ = n * PROD_SET (residue n)` by rw[residue_delete] >>
9566  `_ = n * FACT (n - 1)` by rw[] >>
9567  metis_tac[FACT]
9568QED
9569
9570(* Theorem: natural n = set (GENLIST SUC n) *)
9571(* Proof:
9572   By induction on n.
9573   Base: natural 0 = set (GENLIST SUC 0)
9574      LHS = natural 0 = {}         by natural_0
9575      RHS = set (GENLIST SUC 0)
9576          = set []                 by GENLIST_0
9577          = {}                     by LIST_TO_SET
9578   Step: natural n = set (GENLIST SUC n) ==>
9579         natural (SUC n) = set (GENLIST SUC (SUC n))
9580         natural (SUC n)
9581       = SUC n INSERT natural n                 by natural_suc
9582       = SUC n INSERT (set (GENLIST SUC n))     by induction hypothesis
9583       = set (SNOC (SUC n) (GENLIST SUC n))     by LIST_TO_SET_SNOC
9584       = set (GENLIST SUC (SUC n))              by GENLIST
9585*)
9586Theorem natural_thm:
9587    !n. natural n = set (GENLIST SUC n)
9588Proof
9589  Induct >-
9590  rw[] >>
9591  rw[natural_suc, LIST_TO_SET_SNOC, GENLIST]
9592QED
9593
9594(* ------------------------------------------------------------------------- *)
9595(* Uptos -- counting from 0 and inclusive.                                   *)
9596(* ------------------------------------------------------------------------- *)
9597
9598(* Overload on another count-related set *)
9599Overload upto = ``\n. count (SUC n)``
9600
9601(* Theorem: FINITE (upto n) *)
9602(* Proof: by FINITE_COUNT *)
9603Theorem upto_finite:
9604    !n. FINITE (upto n)
9605Proof
9606  rw[]
9607QED
9608
9609(* Theorem: CARD (upto n) = SUC n *)
9610(* Proof: by CARD_COUNT *)
9611Theorem upto_card:
9612    !n. CARD (upto n) = SUC n
9613Proof
9614  rw[]
9615QED
9616
9617(* Theorem: n IN (upto n) *)
9618(* Proof: byLESS_SUC_REFL *)
9619Theorem upto_has_last:
9620    !n. n IN (upto n)
9621Proof
9622  rw[]
9623QED
9624
9625(* Theorem: (upto n) DELETE n = count n *)
9626(* Proof:
9627     (upto n) DELETE n
9628   = (count (SUC n)) DELETE n      by notation
9629   = (n INSERT count n) DELETE n   by COUNT_SUC
9630   = count n DELETE n              by DELETE_INSERT
9631   = count n                       by DELETE_NON_ELEMENT, COUNT_NOT_SELF
9632*)
9633Theorem upto_delete:
9634  !n. (upto n) DELETE n = count n
9635Proof
9636  metis_tac[COUNT_SUC, COUNT_NOT_SELF, DELETE_INSERT, DELETE_NON_ELEMENT]
9637QED
9638
9639(* Theorem: upto n = {0} UNION (natural n) *)
9640(* Proof:
9641   By UNION_DEF, EXTENSION, this is to show:
9642   (1) x < SUC n ==> (x = 0) \/ ?x'. (x = SUC x') /\ x' < n
9643       If x = 0, trivially true.
9644       If x <> 0, x = SUC m.
9645          Take x' = m,
9646          then SUC m = x < SUC n ==> m < n   by LESS_MONO_EQ
9647   (2) (x = 0) \/ ?x'. (x = SUC x') /\ x' < n ==> x < SUC n
9648       If x = 0, 0 < SUC n                   by SUC_POS
9649       If ?x'. (x = SUC x') /\ x' < n,
9650          x' < n ==> SUC x' = x < SUC n      by LESS_MONO_EQ
9651*)
9652Theorem upto_split_first:
9653    !n. upto n = {0} UNION (natural n)
9654Proof
9655  rw[EXTENSION, EQ_IMP_THM] >>
9656  Cases_on `x` >-
9657  rw[] >>
9658  metis_tac[LESS_MONO_EQ]
9659QED
9660
9661(* Theorem: upto n = (count n) UNION {n} *)
9662(* Proof:
9663   By UNION_DEF, EXTENSION, this is to show:
9664   (1) x < SUC n ==> x < n \/ (x = n)
9665       True by LESS_THM.
9666   (2) x < n \/ (x = n) ==> x < SUC n
9667       True by LESS_THM.
9668*)
9669Theorem upto_split_last:
9670    !n. upto n = (count n) UNION {n}
9671Proof
9672  rw[EXTENSION, EQ_IMP_THM]
9673QED
9674
9675(* Theorem: upto n = n INSERT (count n) *)
9676(* Proof:
9677     upto n
9678   = count (SUC n)             by notation
9679   = {x | x < SUC n}           by count_def
9680   = {x | (x = n) \/ (x < n)}  by prim_recTheory.LESS_THM
9681   = x INSERT {x| x < n}       by INSERT_DEF
9682   = x INSERT (count n)        by count_def
9683*)
9684Theorem upto_by_count:
9685    !n. upto n = n INSERT (count n)
9686Proof
9687  rw[EXTENSION]
9688QED
9689
9690(* Theorem: upto n = 0 INSERT (natural n) *)
9691(* Proof:
9692     upto n
9693   = count (SUC n)             by notation
9694   = {x | x < SUC n}           by count_def
9695   = {x | ((x = 0) \/ (?m. x = SUC m)) /\ x < SUC n)}            by num_CASES
9696   = {x | (x = 0 /\ x < SUC n) \/ (?m. x = SUC m /\ x < SUC n)}  by SUC_POS
9697   = 0 INSERT {SUC m | SUC m < SUC n}   by INSERT_DEF
9698   = 0 INSERT {SUC m | m < n}           by LESS_MONO_EQ
9699   = 0 INSERT (IMAGE SUC (count n))     by IMAGE_DEF
9700   = 0 INSERT (natural n)               by notation
9701*)
9702Theorem upto_by_natural:
9703    !n. upto n = 0 INSERT (natural n)
9704Proof
9705  rw[EXTENSION] >>
9706  metis_tac[num_CASES, LESS_MONO_EQ, SUC_POS]
9707QED
9708
9709(* Theorem: natural n = count (SUC n) DELETE 0 *)
9710(* Proof:
9711     count (SUC n) DELETE 0
9712   = {x | x < SUC n} DELETE 0    by count_def
9713   = {x | x < SUC n} DIFF {0}    by DELETE_DEF
9714   = {x | x < SUC n /\ x <> 0}   by DIFF_DEF
9715   = {SUC m | SUC m < SUC n}     by num_CASES
9716   = {SUC m | m < n}             by LESS_MONO_EQ
9717   = IMAGE SUC (count n)         by IMAGE_DEF
9718   = natural n                   by notation
9719*)
9720Theorem natural_by_upto:
9721    !n. natural n = count (SUC n) DELETE 0
9722Proof
9723  (rw[EXTENSION, EQ_IMP_THM] >> metis_tac[num_CASES, LESS_MONO_EQ])
9724QED
9725
9726(* ------------------------------------------------------------------------- *)
9727(* Euler Set and Totient Function                                            *)
9728(* ------------------------------------------------------------------------- *)
9729
9730(* Euler's totient function *)
9731Definition Euler_def[nocompute]:
9732  Euler n = { i | 0 < i /\ i < n /\ (gcd n i = 1) }
9733End
9734(* that is, Euler n = { i | i in (residue n) /\ (gcd n i = 1) }; *)
9735(* use zDefine as this is not computationally effective. *)
9736
9737Definition totient_def:
9738  totient n = CARD (Euler n)
9739End
9740
9741(* Theorem: x IN (Euler n) <=> 0 < x /\ x < n /\ coprime n x *)
9742(* Proof: by Euler_def. *)
9743Theorem Euler_element:
9744    !n x. x IN (Euler n) <=> 0 < x /\ x < n /\ coprime n x
9745Proof
9746  rw[Euler_def]
9747QED
9748
9749(* Theorem: Euler n = (residue n) INTER {j | coprime j n} *)
9750(* Proof: by Euler_def, residue_def, EXTENSION, IN_INTER *)
9751Theorem Euler_thm[compute]:
9752    !n. Euler n = (residue n) INTER {j | coprime j n}
9753Proof
9754  rw[Euler_def, residue_def, GCD_SYM, EXTENSION]
9755QED
9756(* This is effective, put in computeLib. *)
9757
9758(*
9759> EVAL ``Euler 10``;
9760val it = |- Euler 10 = {9; 7; 3; 1}: thm
9761> EVAL ``totient 10``;
9762val it = |- totient 10 = 4: thm
9763*)
9764
9765(* Theorem: FINITE (Euler n) *)
9766(* Proof:
9767   Since (Euler n) SUBSET count n  by Euler_def, SUBSET_DEF
9768     and FINITE (count n)          by FINITE_COUNT
9769     ==> FINITE (Euler n)          by SUBSET_FINITE
9770*)
9771Theorem Euler_finite:
9772    !n. FINITE (Euler n)
9773Proof
9774  rpt strip_tac >>
9775  `(Euler n) SUBSET count n` by rw[Euler_def, SUBSET_DEF] >>
9776  metis_tac[FINITE_COUNT, SUBSET_FINITE]
9777QED
9778
9779(* Theorem: Euler 0 = {} *)
9780(* Proof: by Euler_def *)
9781Theorem Euler_0:
9782    Euler 0 = {}
9783Proof
9784  rw[Euler_def]
9785QED
9786
9787(* Theorem: Euler 1 = {} *)
9788(* Proof: by Euler_def *)
9789Theorem Euler_1:
9790    Euler 1 = {}
9791Proof
9792  rw[Euler_def]
9793QED
9794
9795(* Theorem: 1 < n ==> 1 IN (Euler n) *)
9796(* Proof: by Euler_def *)
9797Theorem Euler_has_1:
9798    !n. 1 < n ==> 1 IN (Euler n)
9799Proof
9800  rw[Euler_def]
9801QED
9802
9803(* Theorem: 1 < n ==> (Euler n) <> {} *)
9804(* Proof: by Euler_has_1, MEMBER_NOT_EMPTY *)
9805Theorem Euler_nonempty:
9806    !n. 1 < n ==> (Euler n) <> {}
9807Proof
9808  metis_tac[Euler_has_1, MEMBER_NOT_EMPTY]
9809QED
9810
9811(* Theorem: (Euler n = {}) <=> ((n = 0) \/ (n = 1)) *)
9812(* Proof:
9813   If part: Euler n = {} ==> n = 0 \/ n = 1
9814      By contradiction, suppose ~(n = 0 \/ n = 1).
9815      Then 1 < n, but Euler n <> {}   by Euler_nonempty
9816      This contradicts Euler n = {}.
9817   Only-if part: n = 0 \/ n = 1 ==> Euler n = {}
9818      Note Euler 0 = {}               by Euler_0
9819       and Euler 1 = {}               by Euler_1
9820*)
9821Theorem Euler_empty:
9822    !n. (Euler n = {}) <=> ((n = 0) \/ (n = 1))
9823Proof
9824  rw[EQ_IMP_THM] >| [
9825    spose_not_then strip_assume_tac >>
9826    `1 < n` by decide_tac >>
9827    metis_tac[Euler_nonempty],
9828    rw[Euler_0],
9829    rw[Euler_1]
9830  ]
9831QED
9832
9833(* Theorem: totient n <= n *)
9834(* Proof:
9835   Since (Euler n) SUBSET count n  by Euler_def, SUBSET_DEF
9836     and FINITE (count n)          by FINITE_COUNT
9837     and (CARD (count n) = n       by CARD_COUNT
9838   Hence CARD (Euler n) <= n       by CARD_SUBSET
9839      or totient n <= n            by totient_def
9840*)
9841Theorem Euler_card_upper_le:
9842    !n. totient n <= n
9843Proof
9844  rpt strip_tac >>
9845  `(Euler n) SUBSET count n` by rw[Euler_def, SUBSET_DEF] >>
9846  metis_tac[totient_def, CARD_SUBSET, FINITE_COUNT, CARD_COUNT]
9847QED
9848
9849(* Theorem: 1 < n ==> totient n < n *)
9850(* Proof:
9851   First, (Euler n) SUBSET count n     by Euler_def, SUBSET_DEF
9852     Now, ~(coprime 0 n)               by coprime_0L, n <> 1
9853      so  0 NOTIN (Euler n)            by Euler_def
9854     but  0 IN (count n)               by IN_COUNT, 0 < n
9855    Thus  (Euler n) <> (count n)       by EXTENSION
9856     and  (Euler n) PSUBSET (count n)  by PSUBSET_DEF
9857   Since  FINITE (count n)             by FINITE_COUNT
9858     and  (CARD (count n) = n          by CARD_COUNT
9859   Hence  CARD (Euler n) < n           by CARD_PSUBSET
9860      or  totient n < n                by totient_def
9861*)
9862Theorem Euler_card_upper_lt:
9863    !n. 1 < n ==> totient n < n
9864Proof
9865  rpt strip_tac >>
9866  `(Euler n) SUBSET count n` by rw[Euler_def, SUBSET_DEF] >>
9867  `0 < n /\ n <> 1` by decide_tac >>
9868  `~(coprime 0 n)` by metis_tac[coprime_0L] >>
9869  `0 NOTIN (Euler n)` by rw[Euler_def] >>
9870  `0 IN (count n)` by rw[] >>
9871  `(Euler n) <> (count n)` by metis_tac[EXTENSION] >>
9872  `(Euler n) PSUBSET (count n)` by rw[PSUBSET_DEF] >>
9873  metis_tac[totient_def, CARD_PSUBSET, FINITE_COUNT, CARD_COUNT]
9874QED
9875
9876(* Theorem: (totient n <= n) /\ (1 < n ==> 0 < totient n /\ totient n < n) *)
9877(* Proof:
9878   This is to show:
9879   (1) totient n <= n,
9880       True by Euler_card_upper_le.
9881   (2) 1 < n ==> 0 < totient n
9882       Since (Euler n) <> {}      by Euler_nonempty
9883        Also FINITE (Euler n)     by Euler_finite
9884       Hence CARD (Euler n) <> 0  by CARD_EQ_0
9885          or 0 < totient n        by totient_def
9886   (3) 1 < n ==> totient n < n
9887       True by Euler_card_upper_lt.
9888*)
9889Theorem Euler_card_bounds:
9890    !n. (totient n <= n) /\ (1 < n ==> 0 < totient n /\ totient n < n)
9891Proof
9892  rw[] >-
9893  rw[Euler_card_upper_le] >-
9894 (`(Euler n) <> {}` by rw[Euler_nonempty] >>
9895  `FINITE (Euler n)` by rw[Euler_finite] >>
9896  `totient n <> 0` by metis_tac[totient_def, CARD_EQ_0] >>
9897  decide_tac) >>
9898  rw[Euler_card_upper_lt]
9899QED
9900
9901(* Theorem: For prime p, (Euler p = residue p) *)
9902(* Proof:
9903   By Euler_def, residue_def, this is to show:
9904   For prime p, gcd p x = 1   for 0 < x < p.
9905   Since x < p, x does not divide p, result follows by PRIME_GCD.
9906   or, this is true by prime_coprime_all_lt
9907*)
9908Theorem Euler_prime:
9909    !p. prime p ==> (Euler p = residue p)
9910Proof
9911  rw[Euler_def, residue_def, EXTENSION, EQ_IMP_THM] >>
9912  rw[prime_coprime_all_lt]
9913QED
9914
9915(* Theorem: For prime p, totient p = p - 1 *)
9916(* Proof:
9917      totient p
9918    = CARD (Euler p)    by totient_def
9919    = CARD (residue p)  by Euler_prime
9920    = p - 1             by residue_card, and prime p > 0.
9921*)
9922Theorem Euler_card_prime:
9923    !p. prime p ==> (totient p = p - 1)
9924Proof
9925  rw[totient_def, Euler_prime, residue_card, PRIME_POS]
9926QED
9927
9928(* ------------------------------------------------------------------------- *)
9929(* Summation of Geometric Sequence                                           *)
9930(* ------------------------------------------------------------------------- *)
9931
9932(* Geometric Series:
9933   Let s = p + p ** 2 + p ** 3
9934   p * s = p ** 2 + p ** 3 + p ** 4
9935   p * s - s = p ** 4 - p
9936   (p - 1) * s = p * (p ** 3 - 1)
9937*)
9938
9939(* Theorem: 0 < p ==> !n. (p - 1) * SIGMA (\j. p ** j) (natural n) = p * (p ** n - 1) *)
9940(* Proof:
9941   By induction on n.
9942   Base: (p - 1) * SIGMA (\j. p ** j) (natural 0) = p * (p ** 0 - 1)
9943      LHS = (p - 1) * SIGMA (\j. p ** j) (natural 0)
9944          = (p - 1) * SIGMA (\j. p ** j) {}          by natural_0
9945          = (p - 1) * 0                              by SUM_IMAGE_EMPTY
9946          = 0                                        by MULT_0
9947      RHS = p * (p ** 0 - 1)
9948          = p * (1 - 1)                              by EXP
9949          = p * 0                                    by SUB_EQUAL_0
9950          = 0 = LHS                                  by MULT_0
9951   Step: (p - 1) * SIGMA (\j. p ** j) (natural n) = p * (p ** n - 1) ==>
9952         (p - 1) * SIGMA (\j. p ** j) (natural (SUC n)) = p * (p ** SUC n - 1)
9953      Note FINITE (natural n)                        by natural_finite
9954       and (SUC n) NOTIN (natural n)                 by natural_element
9955      Also p <= p ** (SUC n)                         by X_LE_X_EXP, SUC_POS
9956       and 1 <= p                                    by 0 < p
9957      thus p ** (SUC n) <> 0                         by EXP_POS, 0 < p
9958        so p ** (SUC n) <= p * p ** (SUC n)          by LE_MULT_LCANCEL, p ** (SUC n) <> 0
9959        (p - 1) * SIGMA (\j. p ** j) (natural (SUC n))
9960      = (p - 1) * SIGMA (\j. p ** j) ((SUC n) INSERT (natural n))                   by natural_suc
9961      = (p - 1) * ((p ** SUC n) + SIGMA (\j. p ** j) ((natural n) DELETE (SUC n)))  by SUM_IMAGE_THM
9962      = (p - 1) * ((p ** SUC n) + SIGMA (\j. p ** j) (natural n))                   by DELETE_NON_ELEMENT
9963      = (p - 1) * (p ** SUC n) + (p - 1) * SIGMA (\j. p ** j) (natural n)           by LEFT_ADD_DISTRIB
9964      = (p - 1) * (p ** SUC n) + p * (p ** n - 1)        by induction hypothesis
9965      = (p - 1) * (p ** SUC n) + (p * p ** n - p)        by LEFT_SUB_DISTRIB
9966      = (p - 1) * (p ** SUC n) + (p ** (SUC n) - p)      by EXP
9967      = (p * p ** SUC n - p ** SUC n) + (p ** SUC n - p) by RIGHT_SUB_DISTRIB
9968      = (p * p ** SUC n - p ** SUC n + p ** SUC n - p    by LESS_EQ_ADD_SUB, p <= p ** (SUC n)
9969      = p ** p ** SUC n - p                              by SUB_ADD, p ** (SUC n) <= p * p ** (SUC n)
9970      = p * (p ** SUC n - 1)                             by LEFT_SUB_DISTRIB
9971 *)
9972Theorem sigma_geometric_natural_eqn:
9973    !p. 0 < p ==> !n. (p - 1) * SIGMA (\j. p ** j) (natural n) = p * (p ** n - 1)
9974Proof
9975  rpt strip_tac >>
9976  Induct_on `n` >-
9977  rw_tac std_ss[natural_0, SUM_IMAGE_EMPTY, EXP, MULT_0] >>
9978  `FINITE (natural n)` by rw[natural_finite] >>
9979  `(SUC n) NOTIN (natural n)` by rw[natural_element] >>
9980  qabbrev_tac `q = p ** SUC n` >>
9981  `p <= q` by rw[X_LE_X_EXP, Abbr`q`] >>
9982  `1 <= p` by decide_tac >>
9983  `q <> 0` by rw[EXP_POS, Abbr`q`] >>
9984  `q <= p * q` by rw[LE_MULT_LCANCEL] >>
9985  `(p - 1) * SIGMA (\j. p ** j) (natural (SUC n))
9986  = (p - 1) * SIGMA (\j. p ** j) ((SUC n) INSERT (natural n))` by rw[natural_suc] >>
9987  `_ = (p - 1) * (q + SIGMA (\j. p ** j) ((natural n) DELETE (SUC n)))` by rw[SUM_IMAGE_THM, Abbr`q`] >>
9988  `_ = (p - 1) * (q + SIGMA (\j. p ** j) (natural n))` by metis_tac[DELETE_NON_ELEMENT] >>
9989  `_ = (p - 1) * q + (p - 1) * SIGMA (\j. p ** j) (natural n)` by rw[LEFT_ADD_DISTRIB] >>
9990  `_ = (p - 1) * q + p * (p ** n - 1)` by rw[] >>
9991  `_ = (p - 1) * q + (p * p ** n - p)` by rw[LEFT_SUB_DISTRIB] >>
9992  `_ = (p - 1) * q + (q - p)` by rw[EXP, Abbr`q`] >>
9993  `_ = (p * q - q) + (q - p)` by rw[RIGHT_SUB_DISTRIB] >>
9994  `_ = (p * q - q + q) - p` by rw[LESS_EQ_ADD_SUB] >>
9995  `_ = p * q - p` by rw[SUB_ADD] >>
9996  `_ = p * (q - 1)` by rw[LEFT_SUB_DISTRIB] >>
9997  rw[]
9998QED
9999
10000(* Theorem: 1 < p ==> !n. SIGMA (\j. p ** j) (natural n) = (p * (p ** n - 1)) DIV (p - 1) *)
10001(* Proof:
10002   Since 1 < p,
10003     ==> 0 < p - 1, and 0 < p                          by arithmetic
10004   Let t = SIGMA (\j. p ** j) (natural n)
10005    With 0 < p,
10006         (p - 1) * t = p * (p ** n - 1)                by sigma_geometric_natural_eqn, 0 < p
10007   Hence           t = (p * (p ** n - 1)) DIV (p - 1)  by DIV_SOLVE, 0 < (p - 1)
10008*)
10009Theorem sigma_geometric_natural:
10010    !p. 1 < p ==> !n. SIGMA (\j. p ** j) (natural n) = (p * (p ** n - 1)) DIV (p - 1)
10011Proof
10012  rpt strip_tac >>
10013  `0 < p - 1 /\ 0 < p` by decide_tac >>
10014  rw[sigma_geometric_natural_eqn, DIV_SOLVE]
10015QED
10016
10017(* ------------------------------------------------------------------------- *)
10018(* Chinese Remainder Theorem.                                                *)
10019(* ------------------------------------------------------------------------- *)
10020
10021(* Idea: when a MOD (m * n) = b MOD (m * n), break up modulus m * n. *)
10022
10023(* Theorem: 0 < m /\ 0 < n /\ a MOD (m * n) = b MOD (m * n) ==>
10024            a MOD m = b MOD m /\ a MOD n = b MOD n *)
10025(* Proof:
10026   Either b <= a, or a < b, which implies a <= b.
10027   The statement is symmetrical in a and b,
10028   so proceed by lemma with b <= a, without loss of generality.
10029   Note 0 < m * n                  by MULT_POS
10030     so ?c. a = b + c * (m * n)    by MOD_MOD_EQN, 0 < m * n
10031   Thus a = b + (c * m) * n        by arithmetic
10032    and a = b + (c * n) * m        by arithmetic
10033    ==> a MOD m = b MOD m          by MOD_MOD_EQN, 0 < m
10034    and a MOD n = b MOD n          by MOD_MOD_EQN, 0 < n
10035*)
10036Theorem mod_mod_prod_eq:
10037  !m n a b. 0 < m /\ 0 < n /\ a MOD (m * n) = b MOD (m * n) ==>
10038            a MOD m = b MOD m /\ a MOD n = b MOD n
10039Proof
10040  ntac 5 strip_tac >>
10041  `!a b. b <= a /\ a MOD (m * n) = b MOD (m * n) ==>
10042            a MOD m = b MOD m /\ a MOD n = b MOD n` by
10043  (ntac 3 strip_tac >>
10044  `0 < m * n` by fs[] >>
10045  `?c. a' = b' + c * (m * n)` by metis_tac[MOD_MOD_EQN] >>
10046  `a' = b' + (c * m) * n` by decide_tac >>
10047  `a' = b' + (c * n) * m` by decide_tac >>
10048  metis_tac[MOD_MOD_EQN]) >>
10049  (Cases_on `b <= a` >> simp[])
10050QED
10051
10052(* Idea: converse of mod_mod_prod_eq when coprime. *)
10053
10054(* Theorem: 0 < m /\ 0 < n /\ coprime m n /\
10055            a MOD m = b MOD m /\ a MOD n = b MOD n ==>
10056            a MOD (m * n) = b MOD (m * n) *)
10057(* Proof:
10058   Either b <= a, or a < b, which implies a <= b.
10059   The statement is symmetrical in a and b,
10060   so proceed by lemma with b <= a, without loss of generality.
10061   Note 0 < m * n                  by MULT_POS
10062    and ?h. a = b + h * m          by MOD_MOD_EQN, 0 < m
10063    and ?k. a = b + k * n          by MOD_MOD_EQN, 0 < n
10064    ==> h * m = k * n              by EQ_ADD_LCANCEL
10065   Thus n divides (h * m)          by divides_def
10066     or n divides h                by euclid_coprime, coprime m n
10067    ==> ?c. h = c * n              by divides_def
10068     so a = b + c * (m * n)        by above
10069   Thus a MOD (m * n) = b MOD (m * n)
10070                                   by MOD_MOD_EQN, 0 < m * n
10071*)
10072Theorem coprime_mod_mod_prod_eq:
10073  !m n a b. 0 < m /\ 0 < n /\ coprime m n /\
10074            a MOD m = b MOD m /\ a MOD n = b MOD n ==>
10075            a MOD (m * n) = b MOD (m * n)
10076Proof
10077  rpt strip_tac >>
10078  `!a b. b <= a /\ a MOD m = b MOD m /\ a MOD n = b MOD n ==>
10079             a MOD (m * n) = b MOD (m * n)` by
10080  (rpt strip_tac >>
10081  `0 < m * n` by fs[] >>
10082  `?h. a' = b' + h * m` by metis_tac[MOD_MOD_EQN] >>
10083  `?k. a' = b' + k * n` by metis_tac[MOD_MOD_EQN] >>
10084  `h * m = k * n` by decide_tac >>
10085  `n divides (h * m)` by metis_tac[divides_def] >>
10086  `n divides h` by metis_tac[euclid_coprime, MULT_COMM] >>
10087  `?c. h = c * n` by rw[GSYM divides_def] >>
10088  `a' = b' + c * (m * n)` by fs[] >>
10089  metis_tac[MOD_MOD_EQN]) >>
10090  (Cases_on `b <= a` >> simp[])
10091QED
10092
10093(* Idea: combine both parts for a MOD (m * n) = b MOD (m * n). *)
10094
10095(* Theorem: 0 < m /\ 0 < n /\ coprime m n ==>
10096            !a b. a MOD (m * n) = b MOD (m * n) <=> a MOD m = b MOD m /\ a MOD n = b MOD n *)
10097(* Proof:
10098   If part is true             by mod_mod_prod_eq
10099   Only-if part is true        by coprime_mod_mod_prod_eq
10100*)
10101Theorem coprime_mod_mod_prod_eq_iff:
10102  !m n. 0 < m /\ 0 < n /\ coprime m n ==>
10103        !a b. a MOD (m * n) = b MOD (m * n) <=> a MOD m = b MOD m /\ a MOD n = b MOD n
10104Proof
10105  metis_tac[mod_mod_prod_eq, coprime_mod_mod_prod_eq]
10106QED
10107
10108(* Idea: application, the Chinese Remainder Theorem for two coprime moduli. *)
10109
10110(* Theorem: 0 < m /\ 0 < n /\ coprime m n ==>
10111            ?!x. x < m * n /\ x MOD m = a MOD m /\ x MOD n = b MOD n *)
10112(* Proof:
10113   By EXISTS_UNIQUE_THM, this is to show:
10114   (1) Existence: ?x. x < m * n /\ x MOD m = a MOD m /\ x MOD n = b MOD n
10115   Note ?p q. (p * m + q * n) MOD (m * n) = 1 MOD (m * n)
10116                                               by coprime_linear_mod_prod
10117     so (p * m + q * n) MOD m = 1 MOD m
10118    and (p * m + q * n) MOD n = 1 MOD n        by mod_mod_prod_eq
10119     or (q * n) MOD m = 1 MOD m                by MOD_TIMES
10120    and (p * m) MOD n = 1 MOD n                by MOD_TIMES
10121   Let z = b * p * m + a * q * n.
10122           z MOD m
10123         = (b * p * m + a * q * n) MOD m
10124         = (a * q * n) MOD m                   by MOD_TIMES
10125         = ((a MOD m) * (q * n) MOD m) MOD m   by MOD_TIMES2
10126         = a MOD m                             by MOD_TIMES, above
10127   and     z MOD n
10128         = (b * p * m + a * q * n) MDO n
10129         = (b * p * m) MOD n                   by MOD_TIMES
10130         = ((b MOD n) * (p * m) MOD n) MOD n   by MOD_TIMES2
10131         = b MOD n                             by MOD_TIMES, above
10132   Take x = z MOD (m * n).
10133   Then x < m * n                              by MOD_LESS
10134    and x MOD m = z MOD m = a MOD m            by MOD_MULT_MOD
10135    and x MOD n = z MOD n = b MOD n            by MOD_MULT_MOD
10136   (2) Uniqueness:
10137       x < m * n /\ x MOD m = a MOD m /\ x MOD n = b MOD n /\
10138       y < m * n /\ y MOD m = a MOD m /\ y MOD n = b MOD n ==> x = y
10139   Note x MOD m = y MOD m                      by both equal to a MOD m
10140    and x MOD n = y MOD n                      by both equal to b MOD n
10141   Thus x MOD (m * n) = y MOD (m * n)          by coprime_mod_mod_prod_eq
10142     so             x = y                      by LESS_MOD, both < m * n
10143*)
10144Theorem coprime_mod_mod_solve:
10145  !m n a b. 0 < m /\ 0 < n /\ coprime m n ==>
10146            ?!x. x < m * n /\ x MOD m = a MOD m /\ x MOD n = b MOD n
10147Proof
10148  rw[EXISTS_UNIQUE_THM] >| [
10149    `?p q. (p * m + q * n) MOD (m * n) = 1 MOD (m * n)` by rw[coprime_linear_mod_prod] >>
10150    qabbrev_tac `u = p * m + q * n` >>
10151    `u MOD m = 1 MOD m /\ u MOD n = 1 MOD n` by metis_tac[mod_mod_prod_eq] >>
10152    `(q * n) MOD m = 1 MOD m /\ (p * m) MOD n = 1 MOD n` by rfs[MOD_TIMES, Abbr`u`] >>
10153    qabbrev_tac `z = b * p * m + a * q * n` >>
10154    qexists_tac `z MOD (m * n)` >>
10155    rw[] >| [
10156      `z MOD (m * n) MOD m = z MOD m` by rw[MOD_MULT_MOD] >>
10157      `_ = (a * q * n) MOD m` by rw[Abbr`z`] >>
10158      `_ = ((a MOD m) * ((q * n) MOD m)) MOD m` by rw[MOD_TIMES2] >>
10159      `_ = a MOD m` by fs[] >>
10160      decide_tac,
10161      `z MOD (m * n) MOD n = z MOD n` by metis_tac[MOD_MULT_MOD, MULT_COMM] >>
10162      `_ = (b * p * m) MOD n` by rw[Abbr`z`] >>
10163      `_ = ((b MOD n) * ((p * m) MOD n)) MOD n` by rw[MOD_TIMES2] >>
10164      `_ = b MOD n` by fs[] >>
10165      decide_tac
10166    ],
10167    metis_tac[coprime_mod_mod_prod_eq, LESS_MOD]
10168  ]
10169QED
10170
10171(* Yes! The Chinese Remainder Theorem with two modular equations. *)
10172
10173(*
10174For an algorithm:
10175* define bezout, input pair (m, n), output pair (p, q)
10176* define a dot-product:
10177        (p, q) dot (m, n) = p * m + q * n
10178  with  (p, q) dot (m, n) MOD (m * n) = (gcd m n) MOD (m * n)
10179* define a scale-product:
10180        (a, b) scale (p, q) = (a * p, b * q)
10181  with  z = ((a, b) scale (p, q)) dot (m, n)
10182   and  x = z MOD (m * n)
10183          = (((a, b) scale (p, q)) dot (m, n)) MOD (m * n)
10184          = (((a, b) scale (bezout (m, n))) dot (m, n)) MOD (m * n)
10185
10186Note that bezout (m, n) is the extended Euclidean algorithm.
10187
10188*)
10189
10190(* ------------------------------------------------------------------------- *)
10191(* Useful Theorems                                                           *)
10192(* ------------------------------------------------------------------------- *)
10193
10194(* Note:
10195   count m = {i | i < m}                  defined in pred_set
10196   residue m = {i | 0 < i /\ i < m}       defined in Euler
10197   The difference i = 0 gives n ** 0 = 1, which does not make a difference for PROD_SET.
10198*)
10199
10200(* Theorem: PROD_SET (IMAGE (\j. n ** j) (count m)) =
10201            PROD_SET (IMAGE (\j. n ** j) (residue m)) *)
10202(* Proof:
10203   Let f = \j. n ** j.
10204   When m = 0,
10205      Note count 0 = {}            by COUNT_0
10206       and residue 0 = {}          by residue_0
10207      Thus LHS = RHS.
10208   When m = 1,
10209      Note count 1 = {0}           by COUNT_1
10210       and residue 1 = {}          by residue_1
10211      Thus LHS = PROD_SET (IMAGE f {0})
10212               = PROD_SET {f 0}    by IMAGE_SING
10213               = f 0               by PROD_SET_SING
10214               = n ** 0 = 1        by EXP_0
10215           RHS = PROD_SET (IMAGE f {})
10216               = PROD_SET {}       by IMAGE_EMPTY
10217               = 1                 by PROD_SET_EMPTY
10218               = LHS
10219   For m <> 0, m <> 1,
10220   When n = 0,
10221      Note !j. f j = f j = 0 then 1 else 0     by ZERO_EXP
10222      Thus IMAGE f (count m) = {0; 1}          by count_def, EXTENSION, 1 < m
10223       and IMAGE f (residue m) = {0}           by residue_def, EXTENSION, 1 < m
10224      Thus LHS = PROD_SET {0; 1}
10225               = 0 * 1 = 0                     by PROD_SET_THM
10226           RHS = PROD_SET {0}
10227               = 0 = LHS                       by PROD_SET_SING
10228   When n = 1,
10229      Note f = K 1                             by EXP_1, FUN_EQ_THM
10230       and count m <> {}                       by COUNT_NOT_EMPTY, 0 < m
10231       and residue m <> {}                     by residue_nonempty, 1 < m
10232      Thus LHS = PROD_SET (IMAGE (K 1) (count m))
10233               = PROD_SET {1}                          by IMAGE_K
10234               = PROD_SET (IMAGE (K 1) (residue m))    by IMAGE_K
10235               = RHS
10236   For 1 < m, and 1 < n,
10237   Note 0 IN count m                                   by IN_COUNT, 0 < m
10238   also (IMAGE f (count m)) DELETE 1
10239       = IMAGE f (residue m)                           by IMAGE_DEF, EXP_EQ_1, EXP, 1 < n
10240     PROD_SET (IMAGE f (count m))
10241   = PROD_SET (IMAGE f (0 INSERT count m))             by ABSORPTION
10242   = PROD_SET (f 0 INSERT IMAGE f (count m))           by IMAGE_INSERT
10243   = n ** 0 * PROD_SET ((IMAGE f (count m)) DELETE n ** 0)  by PROD_SET_THM
10244   = PROD_SET ((IMAGE f (count m)) DELETE 1)           by EXP_0
10245   = PROD_SET ((IMAGE f (residue m)))                  by above
10246*)
10247Theorem PROD_SET_IMAGE_EXP_NONZERO:
10248  !n m. PROD_SET (IMAGE (\j. n ** j) (count m)) =
10249        PROD_SET (IMAGE (\j. n ** j) (residue m))
10250Proof
10251  rpt strip_tac >>
10252  qabbrev_tac `f = \j. n ** j` >>
10253  Cases_on `m = 0` >-
10254  simp[residue_0] >>
10255  Cases_on `m = 1` >-
10256  simp[residue_1, COUNT_1, Abbr`f`, PROD_SET_THM] >>
10257  `0 < m /\ 1 < m` by decide_tac >>
10258  Cases_on `n = 0` >| [
10259    `!j. f j = if j = 0 then 1 else 0` by rw[Abbr`f`] >>
10260    `IMAGE f (count m) = {0; 1}` by
10261  (rw[EXTENSION, EQ_IMP_THM] >-
10262    metis_tac[ONE_NOT_ZERO] >>
10263    metis_tac[]
10264    ) >>
10265    `IMAGE f (residue m) = {0}` by
10266    (rw[residue_def, EXTENSION, EQ_IMP_THM] >>
10267    `0 < 1` by decide_tac >>
10268    metis_tac[]) >>
10269    simp[PROD_SET_THM],
10270    Cases_on `n = 1` >| [
10271      `f = K 1` by rw[FUN_EQ_THM, Abbr`f`] >>
10272      `count m <> {}` by fs[COUNT_NOT_EMPTY] >>
10273      `residue m <> {}` by fs[residue_nonempty] >>
10274      simp[IMAGE_K],
10275      `0 < n /\ 1 < n` by decide_tac >>
10276      `0 IN count m` by rw[] >>
10277      `FINITE (IMAGE f (count m))` by rw[] >>
10278      `(IMAGE f (count m)) DELETE 1 = IMAGE f (residue m)` by
10279  (rw[residue_def, IMAGE_DEF, Abbr`f`, EXTENSION, EQ_IMP_THM] >-
10280      metis_tac[EXP, NOT_ZERO] >-
10281      metis_tac[] >>
10282      `j <> 0` by decide_tac >>
10283      metis_tac[EXP_EQ_1]
10284      ) >>
10285      `PROD_SET (IMAGE f (count m)) = PROD_SET (IMAGE f (0 INSERT count m))` by metis_tac[ABSORPTION] >>
10286      `_ = PROD_SET (f 0 INSERT IMAGE f (count m))` by rw[] >>
10287      `_ = n ** 0 * PROD_SET ((IMAGE f (count m)) DELETE n ** 0)` by rw[PROD_SET_THM, Abbr`f`] >>
10288      `_ = 1 * PROD_SET ((IMAGE f (count m)) DELETE 1)` by metis_tac[EXP_0] >>
10289      `_ = PROD_SET ((IMAGE f (residue m)))` by rw[] >>
10290      decide_tac
10291    ]
10292  ]
10293QED
10294
10295(* Overload sublist by infix operator *)
10296Overload "<="[local] = ``sublist``
10297
10298(* Theorem: m < n ==> [m; n] <= [m .. n] *)
10299(* Proof:
10300   By induction on n.
10301   Base: !m. m < 0 ==> [m; 0] <= [m .. 0], true       by m < 0 = F.
10302   Step: !m. m < n ==> [m; n] <= [m .. n] ==>
10303         !m. m < SUC n ==> [m; SUC n] <= [m .. SUC n]
10304        Note m < SUC n means m <= n.
10305        If m = n, LHS = [n; SUC n]
10306                  RHS = [n .. (n + 1)] = [n; SUC n]   by ADD1
10307                      = LHS, thus true                by sublist_refl
10308        If m < n,              [m; n] <= [m .. n]     by induction hypothesis
10309                  SNOC (SUC n) [m; n] <= SNOC (SUC n) [m .. n] by sublist_snoc
10310                        [m; n; SUC n] <= [m .. SUC n]          by SNOC, listRangeINC_SNOC
10311           But [m; SUC n] <= [m; n; SUC n]            by sublist_def
10312           Thus [m; SUC n] <= [m .. SUC n]            by sublist_trans
10313*)
10314Theorem listRangeINC_sublist:
10315    !m n. m < n ==> [m; n] <= [m .. n]
10316Proof
10317  Induct_on `n` >-
10318  rw[] >>
10319  rpt strip_tac >>
10320  `(m = n) \/ m < n` by decide_tac >| [
10321    rw[listRangeINC_def, ADD1] >>
10322    rw[sublist_refl],
10323    `[m; n] <= [m .. n]` by rw[] >>
10324    `SNOC (SUC n) [m; n] <= SNOC (SUC n) [m .. n]` by rw[sublist_snoc] >>
10325    `SNOC (SUC n) [m; n] = [m; n; SUC n]` by rw[] >>
10326    `SNOC (SUC n) [m .. n] = [m .. SUC n]` by rw[listRangeINC_SNOC, ADD1] >>
10327    `[m; SUC n] <= [m; n; SUC n]` by rw[sublist_def] >>
10328    metis_tac[sublist_trans]
10329  ]
10330QED
10331
10332(* Theorem: m + 1 < n ==> [m; (n - 1)] <= [m ..< n] *)
10333(* Proof:
10334   By induction on n.
10335   Base: !m. m + 1 < 0 ==> [m; 0 - 1] <= [m ..< 0], true  by m + 1 < 0 = F.
10336   Step: !m. m + 1 < n ==> [m; n - 1] <= [m ..< n] ==>
10337         !m. m + 1 < SUC n ==> [m; SUC n - 1] <= [m ..< SUC n]
10338        Note m + 1 < SUC n means m + 1 <= n.
10339        If m + 1 = n, LHS = [m; SUC n - 1] = [m; n]
10340                  RHS = [m ..< (n + 1)] = [m; n]          by ADD1
10341                      = LHS, thus true                    by sublist_refl
10342        If m + 1 < n,    [m; n - 1] <= [m ..< n]          by induction hypothesis
10343                  SNOC n [m; n - 1] <= SNOC n [m ..< n]   by sublist_snoc
10344                      [m; n - 1; n] <= [m ..< SUC n]      by SNOC, listRangeLHI_SNOC, ADD1
10345           But [m; SUC n - 1] <= [m; n] <= [m; n - 1; n]  by sublist_def
10346           Thus [m; SUC n - 1] <= [m ..< SUC n]           by sublist_trans
10347*)
10348Theorem listRangeLHI_sublist:
10349    !m n. m + 1 < n ==> [m; (n - 1)] <= [m ..< n]
10350Proof
10351  Induct_on `n` >-
10352  rw[] >>
10353  rpt strip_tac >>
10354  `SUC n - 1 = n` by decide_tac >>
10355  `(m + 1 = n) \/ m + 1 < n` by decide_tac >| [
10356    rw[listRangeLHI_def, ADD1] >>
10357    rw[sublist_refl],
10358    `[m; n - 1] <= [m ..< n]` by rw[] >>
10359    `SNOC n [m; n - 1] <= SNOC n [m ..< n]` by rw[sublist_snoc] >>
10360    `SNOC n [m; n - 1] = [m; n - 1; n]` by rw[] >>
10361    `SNOC n [m ..< n] = [m ..< SUC n]` by rw[listRangeLHI_SNOC, ADD1] >>
10362    `[m; SUC n - 1] <= [m; n - 1; n]` by rw[sublist_def] >>
10363    metis_tac[sublist_trans]
10364  ]
10365QED
10366
10367(* Theorem: sl <= ls /\ ALL_DISTINCT ls /\ j < h /\ h < LENGTH sl ==>
10368            findi (EL j sl) ls < findi (EL h sl) ls *)
10369(* Proof:
10370   Let x = EL j sl,
10371       y = EL h sl,
10372       p = findi x ls,
10373       q = findi y ls.
10374   Then MEM x sl /\ MEM y sl                   by EL_MEM
10375    and ALL_DISTINCT sl                        by sublist_ALL_DISTINCT
10376
10377   With MEM x sl,
10378   Note ?l1 l2 l3 l4. ls = l1 ++ [x] ++ l2 /\
10379                      sl = l3 ++ [x] ++ l4 /\
10380                      l3 <= l1 /\ l4 <= l2     by sublist_order, sl <= ls
10381   Thus j = LENGTH l3                          by ALL_DISTINCT_EL_APPEND, j < LENGTH sl
10382
10383   Claim: MEM y l4
10384   Proof: By contradiction, suppose ~MEM y l4.
10385          Note y <> x                          by ALL_DISTINCT_EL_IMP, j <> h
10386           ==> MEM y l3                        by MEM_APPEND
10387           ==> ?k. k < LENGTH l3 /\ y = EL k l3   by MEM_EL
10388           But LENGTH l3 < LENGTH sl           by LENGTH_APPEND
10389           and y = EL k sl                     by EL_APPEND1
10390          Thus k = h                           by ALL_DISTINCT_EL_IMP, k < LENGTH sl
10391            or h < j, contradicting j < h      by j = LENGTH l3
10392
10393   Thus ?l5 l6 l7 l8. l2 = l5 ++ [x] ++ l6 /\
10394                      l4 = l7 ++ [x] ++ l8 /\
10395                      l7 <= l5 /\ l8 <= l6     by sublist_order, l4 <= l2
10396
10397   Hence, ls = l1 ++ [x] ++ l5 ++ [y] ++ l6.
10398    Now p < LENGTH ls /\ q < LENGTH ls         by MEM_findi
10399     so x = EL p ls /\ y = EL q ls             by findi_EL_iff
10400    and p = LENGTH l1                          by ALL_DISTINCT_EL_APPEND
10401    and q = LENGTH (l1 ++ [x] ++ l5)           by ALL_DISTINCT_EL_APPEND
10402   Thus p < q                                  by LENGTH_APPEND
10403*)
10404Theorem sublist_element_order:
10405  !ls sl j h. sl <= ls /\ ALL_DISTINCT ls /\ j < h /\ h < LENGTH sl ==>
10406              findi (EL j sl) ls < findi (EL h sl) ls
10407Proof
10408  rpt strip_tac >>
10409  qabbrev_tac `x = EL j sl` >>
10410  qabbrev_tac `y = EL h sl` >>
10411  qabbrev_tac `p = findi x ls` >>
10412  qabbrev_tac `q = findi y ls` >>
10413  `MEM x sl /\ MEM y sl` by fs[EL_MEM, Abbr`x`, Abbr`y`] >>
10414  assume_tac sublist_order >>
10415  last_x_assum (qspecl_then [`ls`, `sl`, `x`] strip_assume_tac) >>
10416  rfs[] >>
10417  `ALL_DISTINCT sl` by metis_tac[sublist_ALL_DISTINCT] >>
10418  `j = LENGTH l3` by metis_tac[ALL_DISTINCT_EL_APPEND, LESS_TRANS] >>
10419  `MEM y l4` by
10420  (spose_not_then strip_assume_tac >>
10421  `y <> x` by fs[ALL_DISTINCT_EL_IMP, Abbr`x`, Abbr`y`] >>
10422  `MEM y l3` by fs[] >>
10423  `?k. k < LENGTH l3 /\ y = EL k l3` by simp[GSYM MEM_EL] >>
10424  `LENGTH l3 < LENGTH sl` by fs[] >>
10425  `y = EL k sl` by fs[EL_APPEND1] >>
10426  `k = h` by metis_tac[ALL_DISTINCT_EL_IMP, LESS_TRANS] >>
10427  decide_tac) >>
10428  assume_tac sublist_order >>
10429  last_x_assum (qspecl_then [`l2`, `l4`, `y`] strip_assume_tac) >>
10430  rfs[] >>
10431  rename1 `l2 = l5 ++ [y] ++ l6` >>
10432  `p < LENGTH ls /\ q < LENGTH ls` by fs[MEM_findi, Abbr`p`, Abbr`q`] >>
10433  `x = EL p ls /\ y = EL q ls` by fs[findi_EL_iff, Abbr`p`, Abbr`q`] >>
10434  `p = LENGTH l1` by metis_tac[ALL_DISTINCT_EL_APPEND] >>
10435  `ls = l1 ++ [x] ++ l5 ++ [y] ++ l6` by fs[] >>
10436  `q = LENGTH (l1 ++ [x] ++ l5)` by metis_tac[ALL_DISTINCT_EL_APPEND] >>
10437  fs[]
10438QED
10439
10440(* Theorem: let fs = FILTER P ls in ALL_DISTINCT ls /\ j < h /\ h < LENGTH fs ==>
10441            findi (EL j fs) ls < findi (EL h fs) l *)
10442(* Proof:
10443   Let fs = FILTER P ls.
10444   Then fs <= ls                   by FILTER_sublist
10445   Thus findi (EL j fs) ls
10446      < findi (EL h fs) ls         by sublist_element_order
10447*)
10448Theorem FILTER_element_order:
10449  !P ls j h. let fs = FILTER P ls in ALL_DISTINCT ls /\ j < h /\ h < LENGTH fs ==>
10450             findi (EL j fs) ls < findi (EL h fs) ls
10451Proof
10452  rw_tac std_ss[] >>
10453  `fs <= ls` by simp[FILTER_sublist, Abbr`fs`] >>
10454  fs[sublist_element_order]
10455QED
10456
10457(* ------------------------------------------------------------------------- *)