primeScript.sml

1(* ------------------------------------------------------------------------- *)
2(* Integer Functions Computation (logPower)                                  *)
3(* Prime Power (primePower)                                                  *)
4(* Primality Tests (primes)                                                  *)
5(* Gauss' Little Theorem                                                     *)
6(* Mobius Function and Inversion.                                            *)
7(* ------------------------------------------------------------------------- *)
8(* Author: (Joseph) Hing-Lun Chan (Australian National University, 2019)     *)
9(* ------------------------------------------------------------------------- *)
10Theory prime
11Ancestors
12  arithmetic pred_set divides gcd logroot list rich_list
13  listRange gcdset option number combinatorics prim_rec
14
15
16Overload SQ[local] = ``\n. n * n``
17Overload HALF[local] = ``\n. n DIV 2``
18Overload TWICE[local] = ``\n. 2 * n``
19
20(* ------------------------------------------------------------------------- *)
21(* Integer Functions Computation Documentation                               *)
22(* ------------------------------------------------------------------------- *)
23(* Square predicate:
24   square_def       |- !n. square n <=> ?k. n = k * k
25   square_alt       |- !n. square n <=> ?k. n = k ** 2
26!  square_eqn       |- !n. square n <=> SQRT n ** 2 = n
27   square_0         |- square 0
28   square_1         |- square 1
29   prime_non_square |- !p. prime p ==> ~square p
30   SQ_SQRT_LT       |- !n. ~square n ==> SQRT n * SQRT n < n
31   SQ_SQRT_LT_alt   |- !n. ~square n ==> SQRT n ** 2 < n
32   odd_square_lt    |- !n m. ~square n ==> ((2 * m + 1) ** 2 < n <=> m < HALF (1 + SQRT n))
33
34   LOG2 Computation:
35   halves_def          |- !n. halves n = if n = 0 then 0 else SUC (halves (HALF n))
36   halves_alt          |- !n. halves n = if n = 0 then 0 else 1 + halves (HALF n)
37#  halves_0            |- halves 0 = 0
38#  halves_1            |- halves 1 = 1
39#  halves_2            |- halves 2 = 2
40#  halves_pos          |- !n. 0 < n ==> 0 < halves n
41   halves_by_LOG2      |- !n. 0 < n ==> (halves n = 1 + LOG2 n)
42   LOG2_compute        |- !n. LOG2 n = if n = 0 then LOG2 0 else halves n - 1
43   halves_le           |- !m n. m <= n ==> halves m <= halves n
44   halves_eq_0         |- !n. (halves n = 0) <=> (n = 0)
45   halves_eq_1         |- !n. (halves n = 1) <=> (n = 1)
46
47   Perfect Power and Power Free:
48   perfect_power_def        |- !n m. perfect_power n m <=> ?e. n = m ** e
49   perfect_power_self       |- !n. perfect_power n n
50   perfect_power_0_m        |- !m. perfect_power 0 m <=> (m = 0)
51   perfect_power_1_m        |- !m. perfect_power 1 m
52   perfect_power_n_0        |- !n. perfect_power n 0 <=> (n = 0) \/ (n = 1)
53   perfect_power_n_1        |- !n. perfect_power n 1 <=> (n = 1)
54   perfect_power_mod_eq_0   |- !n m. 0 < m /\ 1 < n /\ n MOD m = 0 ==>
55                                     (perfect_power n m <=> perfect_power (n DIV m) m)
56   perfect_power_mod_ne_0   |- !n m. 0 < m /\ 1 < n /\ n MOD m <> 0 ==> ~perfect_power n m
57   perfect_power_test       |- !n m. perfect_power n m <=>
58                                     if n = 0 then m = 0
59                                     else if n = 1 then T
60                                     else if m = 0 then n <= 1
61                                     else if m = 1 then n = 1
62                                     else if n MOD m = 0 then perfect_power (n DIV m) m
63                                     else F
64   perfect_power_suc        |- !m n. 1 < m /\ perfect_power n m /\ perfect_power (SUC n) m ==>
65                                     (m = 2) /\ (n = 1)
66   perfect_power_not_suc    |- !m n. 1 < m /\ 1 < n /\ perfect_power n m ==> ~perfect_power (SUC n) m
67   LOG_SUC                  |- !b n. 1 < b /\ 0 < n ==>
68                                     LOG b (SUC n) = LOG b n +
69                                         if perfect_power (SUC n) b then 1 else 0
70   perfect_power_bound_LOG2 |- !n. 0 < n ==> !m. perfect_power n m <=> ?k. k <= LOG2 n /\ (n = m ** k)
71   perfect_power_condition  |- !p q. prime p /\ (?x y. 0 < x /\ (p ** x = q ** y)) ==> perfect_power q p
72   perfect_power_cofactor   |- !n p. 0 < p /\ p divides n ==> (perfect_power n p <=> perfect_power (n DIV p) p)
73   perfect_power_cofactor_alt
74                            |- !n p. 0 < n /\ p divides n ==> (perfect_power n p <=> perfect_power (n DIV p) p)
75   perfect_power_2_odd      |- !n. perfect_power n 2 ==> (ODD n <=> (n = 1))
76
77   Power Free:
78   power_free_def           |- !n. power_free n <=> !m e. (n = m ** e) ==> (m = n) /\ (e = 1)
79   power_free_0             |- power_free 0 <=> F
80   power_free_1             |- power_free 1 <=> F
81   power_free_gt_1          |- !n. power_free n ==> 1 < n
82   power_free_alt           |- !n. power_free n <=> 1 < n /\ !m. perfect_power n m ==> (n = m)
83   prime_is_power_free      |- !n. prime n ==> power_free n
84   power_free_perfect_power |- !m n. power_free n /\ perfect_power n m ==> (n = m)
85   power_free_property      |- !n. power_free n ==> !j. 1 < j ==> ROOT j n ** j <> n
86   power_free_check_all     |- !n. power_free n <=> 1 < n /\ !j. 1 < j ==> ROOT j n ** j <> n
87
88   Upper Logarithm:
89   count_up_def   |- !n m k. count_up n m k = if m = 0 then 0
90                                else if n <= m then k
91                                else count_up n (2 * m) (SUC k)
92   ulog_def       |- !n. ulog n = count_up n 1 0
93#  ulog_0         |- ulog 0 = 0
94#  ulog_1         |- ulog 1 = 0
95#  ulog_2         |- ulog 2 = 1
96
97   count_up_exit       |- !m n. m <> 0 /\ n <= m ==> !k. count_up n m k = k
98   count_up_suc        |- !m n. m <> 0 /\ m < n ==> !k. count_up n m k = count_up n (2 * m) (SUC k)
99   count_up_suc_eqn    |- !m. m <> 0 ==> !n t. 2 ** t * m < n ==>
100                          !k. count_up n m k = count_up n (2 ** SUC t * m) (SUC k + t)
101   count_up_exit_eqn   |- !m. m <> 0 ==> !n t. 2 ** t * m < 2 * n /\ n <= 2 ** t * m ==>
102                          !k. count_up n m k = k + t
103   ulog_unique         |- !m n. 2 ** m < 2 * n /\ n <= 2 ** m ==> (ulog n = m)
104   ulog_eqn            |- !n. ulog n = if 1 < n then SUC (LOG2 (n - 1)) else 0
105   ulog_suc            |- !n. 0 < n ==> (ulog (SUC n) = SUC (LOG2 n))
106   ulog_property       |- !n. 0 < n ==> 2 ** ulog n < 2 * n /\ n <= 2 ** ulog n
107   ulog_thm            |- !n. 0 < n ==> !m. (ulog n = m) <=> 2 ** m < 2 * n /\ n <= 2 ** m
108   ulog_def_alt        |- (ulog 0 = 0) /\
109                          !n. 0 < n ==> !m. (ulog n = m) <=> n <= 2 ** m /\ 2 ** m < TWICE n
110   ulog_eq_0           |- !n. (ulog n = 0) <=> (n = 0) \/ (n = 1)
111   ulog_eq_1           |- !n. (ulog n = 1) <=> (n = 2)
112   ulog_le_1           |- !n. ulog n <= 1 <=> n <= 2
113   ulog_le             |- !m n. n <= m ==> ulog n <= ulog m
114   ulog_lt             |- !m n. n < m ==> ulog n <= ulog m
115   ulog_2_exp          |- !n. ulog (2 ** n) = n
116   ulog_le_self        |- !n. ulog n <= n
117   ulog_eq_self        |- !n. (ulog n = n) <=> (n = 0)
118   ulog_lt_self        |- !n. 0 < n ==> ulog n < n
119   ulog_exp_exact      |- !n. (2 ** ulog n = n) <=> perfect_power n 2
120   ulog_exp_not_exact  |- !n. ~perfect_power n 2 ==> 2 ** ulog n <> n
121   ulog_property_not_exact   |- !n. 0 < n /\ ~perfect_power n 2 ==> n < 2 ** ulog n
122   ulog_property_odd         |- !n. 1 < n /\ ODD n ==> n < 2 ** ulog n
123   exp_to_ulog         |- !m n. n <= 2 ** m ==> ulog n <= m
124#  ulog_pos            |- !n. 1 < n ==> 0 < ulog n
125   ulog_ge_1           |- !n. 1 < n ==> 1 <= ulog n
126   ulog_sq_gt_1        |- !n. 2 < n ==> 1 < ulog n ** 2
127   ulog_twice_sq       |- !n. 1 < n ==> 4 <= TWICE (ulog n) ** 2
128   ulog_alt            |- !n. ulog n = if n = 0 then 0
129                              else if perfect_power n 2 then LOG2 n else SUC (LOG2 n)
130   ulog_LOG2           |- !n. 0 < n ==> LOG2 n <= ulog n /\ ulog n <= 1 + LOG2 n
131   perfect_power_bound_ulog
132                       |- !n. 0 < n ==> !m. perfect_power n m <=> ?k. k <= ulog n /\ (n = m ** k)
133
134   Upper Log Theorems:
135   ulog_mult      |- !m n. ulog (m * n) <= ulog m + ulog n
136   ulog_exp       |- !m n. ulog (m ** n) <= n * ulog m
137   ulog_even      |- !n. 0 < n /\ EVEN n ==> (ulog n = 1 + ulog (HALF n))
138   ulog_odd       |- !n. 1 < n /\ ODD n ==> ulog (HALF n) + 1 <= ulog n
139   ulog_half      |- !n. 1 < n ==> ulog (HALF n) + 1 <= ulog n
140   sqrt_upper     |- !n. SQRT n <= 2 ** ulog n
141
142   Power Free up to a limit:
143   power_free_upto_def |- !n k. n power_free_upto k <=> !j. 1 < j /\ j <= k ==> ROOT j n ** j <> n
144   power_free_upto_0   |- !n. n power_free_upto 0 <=> T
145   power_free_upto_1   |- !n. n power_free_upto 1 <=> T
146   power_free_upto_suc |- !n k. 0 < k /\ n power_free_upto k ==>
147                               (n power_free_upto k + 1 <=> ROOT (k + 1) n ** (k + 1) <> n)
148   power_free_check_upto       |- !n b. LOG2 n <= b ==> (power_free n <=> 1 < n /\ n power_free_upto b)
149   power_free_check_upto_LOG2  |- !n. power_free n <=> 1 < n /\ n power_free_upto LOG2 n
150   power_free_check_upto_ulog  |- !n. power_free n <=> 1 < n /\ n power_free_upto ulog n
151   power_free_2        |- power_free 2
152   power_free_3        |- power_free 3
153   power_free_test_def |- !n. power_free_test n <=> 1 < n /\ n power_free_upto ulog n
154   power_free_test_eqn |- !n. power_free_test n <=> power_free n
155   power_free_test_upto_LOG2   |- !n. power_free n <=>
156                                      1 < n /\ !j. 1 < j /\ j <= LOG2 n ==> ROOT j n ** j <> n
157   power_free_test_upto_ulog   |- !n. power_free n <=>
158                                      1 < n /\ !j. 1 < j /\ j <= ulog n ==> ROOT j n ** j <> n
159
160   Another Characterisation of Power Free:
161   power_index_def      |- !n k. power_index n k =
162                                      if k <= 1 then 1
163                                 else if ROOT k n ** k = n then k
164                                 else power_index n (k - 1)
165   power_index_0        |- !n. power_index n 0 = 1
166   power_index_1        |- !n. power_index n 1 = 1
167   power_index_eqn      |- !n k. ROOT (power_index n k) n ** power_index n k = n
168   power_index_root     |- !n k. perfect_power n (ROOT (power_index n k) n)
169   power_index_of_1     |- !k. power_index 1 k = if k = 0 then 1 else k
170   power_index_exact_root      |- !n k. 0 < k /\ (ROOT k n ** k = n) ==> (power_index n k = k)
171   power_index_not_exact_root  |- !n k. ROOT k n ** k <> n ==> (power_index n k = power_index n (k - 1))
172   power_index_no_exact_roots  |- !m n k. k <= m /\ (!j. k < j /\ j <= m ==> ROOT j n ** j <> n) ==>
173                                          (power_index n m = power_index n k)
174   power_index_lower    |- !m n k. k <= m /\ (ROOT k n ** k = n) ==> k <= power_index n m
175   power_index_pos      |- !n k. 0 < power_index n k
176   power_index_upper    |- !n k. 0 < k ==> power_index n k <= k
177   power_index_equal    |- !m n k. 0 < k /\ k <= m ==>
178                           ((power_index n m = power_index n k) <=> !j. k < j /\ j <= m ==> ROOT j n ** j <> n)
179   power_index_property |- !m n k. (power_index n m = k) ==> !j. k < j /\ j <= m ==> ROOT j n ** j <> n
180
181   power_free_by_power_index_LOG2
182                        |- !n. power_free n <=> 1 < n /\ (power_index n (LOG2 n) = 1)
183   power_free_by_power_index_ulog
184                        |- !n. power_free n <=> 1 < n /\ (power_index n (ulog n) = 1)
185
186*)
187
188(* Rework proof of ROOT_COMPUTE in logroot theory. *)
189(* ./num/extra_theories/logrootScript.sml *)
190
191(* ROOT r n = r-th root of n.
192
193Make use of indentity:
194n ^ (1/r) = 2 (n/ 2^r) ^(1/r)
195
196if n = 0 then 0
197else (* precompute *) let x = 2 * r-th root of (n DIV (2 ** r))
198     (* apply *) in if n < (SUC x) ** r then x else (SUC x)
199*)
200
201(* Theorem: 0 < r ==> (ROOT r n =
202            let m = 2 * ROOT r (n DIV 2 ** r) in m + if (m + 1) ** r <= n then 1 else 0) *)
203(* Proof:
204     ROOT k n
205   = if n < SUC m ** k then m else SUC m               by ROOT_COMPUTE
206   = if SUC m ** k <= n then SUC m else m              by logic
207   = if (m + 1) ** k <= n then (m + 1) else m          by ADD1
208   = m + if (m + 1) ** k <= n then 1 else 0            by arithmetic
209*)
210Theorem ROOT_EQN:
211    !r n. 0 < r ==> (ROOT r n =
212         let m = 2 * ROOT r (n DIV 2 ** r) in m + if (m + 1) ** r <= n then 1 else 0)
213Proof
214  rw_tac std_ss[] >>
215  Cases_on `(m + 1) ** r <= n` >-
216  rw[ROOT_COMPUTE, ADD1] >>
217  rw[ROOT_COMPUTE, ADD1]
218QED
219
220(* ------------------------------------------------------------------------- *)
221(* Square Root                                                               *)
222(* ------------------------------------------------------------------------- *)
223
224(*
225> EVAL ``SQRT 4``;
226val it = |- SQRT 4 = 2: thm
227> EVAL ``(SQRT 4) ** 2``;
228val it = |- SQRT 4 ** 2 = 4: thm
229> EVAL ``(SQRT 5) ** 2``;
230val it = |- SQRT 5 ** 2 = 4: thm
231> EVAL ``(SQRT 8) ** 2``;
232val it = |- SQRT 8 ** 2 = 4: thm
233> EVAL ``(SQRT 9) ** 2``;
234val it = |- SQRT 9 ** 2 = 9: thm
235
236> EVAL ``LOG2 4``;
237val it = |- LOG2 4 = 2: thm
238> EVAL ``2 ** (LOG2 4)``;
239val it = |- 2 ** LOG2 4 = 4: thm
240> EVAL ``2 ** (LOG2 5)``;
241val it = |- 2 ** LOG2 5 = 4: thm
242> EVAL ``2 ** (LOG2 6)``;
243val it = |- 2 ** LOG2 6 = 4: thm
244> EVAL ``2 ** (LOG2 7)``;
245val it = |- 2 ** LOG2 7 = 4: thm
246> EVAL ``2 ** (LOG2 8)``;
247val it = |- 2 ** LOG2 8 = 8: thm
248
249> EVAL ``SQRT 9``;
250val it = |- SQRT 9 = 3: thm
251> EVAL ``SQRT 8``;
252val it = |- SQRT 8 = 2: thm
253> EVAL ``SQRT 7``;
254val it = |- SQRT 7 = 2: thm
255> EVAL ``SQRT 6``;
256val it = |- SQRT 6 = 2: thm
257> EVAL ``SQRT 5``;
258val it = |- SQRT 5 = 2: thm
259> EVAL ``SQRT 4``;
260val it = |- SQRT 4 = 2: thm
261> EVAL ``SQRT 3``;
262val it = |- SQRT 3 = 1: thm
263*)
264
265(*
266EXP_BASE_LT_MONO |- !b. 1 < b ==> !n m. b ** m < b ** n <=> m < n
267LT_EXP_ISO       |- !e a b. 1 < e ==> (a < b <=> e ** a < e ** b)
268
269ROOT_exists      |- !r n. 0 < r ==> ?rt. rt ** r <= n /\ n < SUC rt ** r
270ROOT_UNIQUE      |- !r n p. p ** r <= n /\ n < SUC p ** r ==> (ROOT r n = p)
271ROOT_LE_MONO     |- !r x y. 0 < r ==> x <= y ==> ROOT r x <= ROOT r y
272
273LOG_exists       |- ?f. !a n. 1 < a /\ 0 < n ==> a ** f a n <= n /\ n < a ** SUC (f a n)
274LOG_UNIQUE       |- !a n p. a ** p <= n /\ n < a ** SUC p ==> (LOG a n = p)
275LOG_LE_MONO      |- !a x y. 1 < a /\ 0 < x ==> x <= y ==> LOG a x <= LOG a y
276
277LOG_EXP    |- !n a b. 1 < a /\ 0 < b ==> (LOG a (a ** n * b) = n + LOG a b)
278LOG        |- !a n. 1 < a /\ 0 < n ==> a ** LOG a n <= n /\ n < a ** SUC (LOG a n)
279*)
280
281(* Theorem: SQ (SQRT n) <= n *)
282(* Proof: by SQRT_PROPERTY, EXP_2 *)
283Theorem SQ_SQRT_LE:
284    !n. SQ (SQRT n) <= n
285Proof
286  metis_tac[SQRT_PROPERTY, EXP_2]
287QED
288
289(* Extract theorem *)
290Theorem SQ_SQRT_LE_alt = SQRT_PROPERTY |> SPEC_ALL |> CONJUNCT1 |> GEN_ALL;
291(* val SQ_SQRT_LE_alt = |- !n. SQRT n ** 2 <= n: thm *)
292
293(* Theorem: SQRT (SQ n) = n *)
294(* Proof:
295     SQRT (SQ n)
296   = SQRT (n ** 2)     by EXP_2
297   = n                 by SQRT_EXP_2
298*)
299Theorem SQRT_SQ:
300    !n. SQRT (SQ n) = n
301Proof
302  metis_tac[SQRT_EXP_2, EXP_2]
303QED
304
305(* Theorem: SQRT n <= n *)
306(* Proof:
307   Note      n <= n ** 2          by SELF_LE_SQ
308   Thus SQRT n <= SQRT (n ** 2)   by SQRT_LE
309     or SQRT n <= n               by SQRT_EXP_2
310*)
311Theorem SQRT_LE_SELF:
312    !n. SQRT n <= n
313Proof
314  metis_tac[SELF_LE_SQ, SQRT_LE, SQRT_EXP_2]
315QED
316
317(* Theorem: SQRT n <= m ==> n <= 3 * (m ** 2) *)
318(* Proof:
319   Note n < (SUC (SQRT n)) ** 2                by SQRT_PROPERTY
320          = SUC ((SQRT n) ** 2) + 2 * SQRT n   by SUC_SQ
321   Thus n <= m ** 2 + 2 * m                    by SQRT n <= m
322          <= m ** 2 + 2 * m ** 2               by arithmetic
323           = 3 * m ** 2
324*)
325Theorem SQRT_LE_IMP:
326    !n m. SQRT n <= m ==> n <= 3 * (m ** 2)
327Proof
328  rpt strip_tac >>
329  `n < (SUC (SQRT n)) ** 2` by rw[SQRT_PROPERTY] >>
330  `SUC (SQRT n) ** 2 = SUC ((SQRT n) ** 2) + 2 * SQRT n` by rw[SUC_SQ] >>
331  `SQRT n ** 2 <= m ** 2` by rw[] >>
332  `2 * SQRT n <= 2 * m` by rw[] >>
333  `2 * m <= 2 * m * m` by rw[] >>
334  `2 * m * m = 2 * m ** 2` by rw[] >>
335  decide_tac
336QED
337
338(* Theorem: (SQRT n) * (SQRT m) <= SQRT (n * m) *)
339(* Proof:
340   Note (SQRT n) ** 2 <= n                         by SQRT_PROPERTY
341    and (SQRT m) ** 2 <= m                         by SQRT_PROPERTY
342     so (SQRT n) ** 2 * (SQRT m) ** 2 <= n * m     by LE_MONO_MULT2
343     or    ((SQRT n) * (SQRT m)) ** 2 <= n * m     by EXP_BASE_MULT
344    ==>     (SQRT n) * (SQRT m) <= SQRT (n * m)    by SQRT_LE, SQRT_OF_SQ
345*)
346Theorem SQRT_MULT_LE:
347  !n m. (SQRT n) * (SQRT m) <= SQRT (n * m)
348Proof
349  rpt strip_tac >>
350  qabbrev_tac `h = SQRT n` >>
351  qabbrev_tac `k = SQRT m` >>
352  `h ** 2 <= n` by simp[SQRT_PROPERTY, Abbr`h`] >>
353  `k ** 2 <= m` by simp[SQRT_PROPERTY, Abbr`k`] >>
354  `(h * k) ** 2 <= n * m` by metis_tac[LE_MONO_MULT2, EXP_BASE_MULT] >>
355  metis_tac[SQRT_LE, SQRT_OF_SQ]
356QED
357
358(* ------------------------------------------------------------------------- *)
359(* Square predicate                                                          *)
360(* ------------------------------------------------------------------------- *)
361
362(* Define square predicate. *)
363
364Definition square_def[nocompute]:
365    square (n:num) = ?k. n = k * k
366End
367(* use [nocompute] as this is not effective. *)
368
369(* Theorem: square n = ?k. n = k ** 2 *)
370(* Proof: by square_def. *)
371Theorem square_alt:
372  !n. square n = ?k. n = k ** 2
373Proof
374  simp[square_def]
375QED
376
377(* Theorem: square n <=> (SQRT n) ** 2 = n *)
378(* Proof:
379   If part: square n ==> (SQRT n) ** 2 = n
380      This is true         by SQRT_SQ, EXP_2
381   Only-if part: (SQRT n) ** 2 = n ==> square n
382      Take k = SQRT n for n = k ** 2.
383*)
384Theorem square_eqn[compute]:
385  !n. square n <=> (SQRT n) ** 2 = n
386Proof
387  metis_tac[square_def, SQRT_SQ, EXP_2]
388QED
389
390(*
391EVAL ``square 10``; F
392EVAL ``square 16``; T
393*)
394
395(* Theorem: square 0 *)
396(* Proof: by 0 = 0 * 0. *)
397Theorem square_0:
398  square 0
399Proof
400  simp[square_def]
401QED
402
403(* Theorem: square 1 *)
404(* Proof: by 1 = 1 * 1. *)
405Theorem square_1:
406  square 1
407Proof
408  simp[square_def]
409QED
410
411(* Theorem: prime p ==> ~square p *)
412(* Proof:
413   By contradiction, suppose (square p).
414   Then    p = k * k                 by square_def
415   thus    k divides p               by divides_def
416   so      k = 1  or  k = p          by prime_def
417   If k = 1,
418      then p = 1 * 1 = 1             by arithmetic
419       but p <> 1                    by NOT_PRIME_1
420   If k = p,
421      then p * 1 = p * p             by arithmetic
422        or     1 = p                 by EQ_MULT_LCANCEL, NOT_PRIME_0
423       but     p <> 1                by NOT_PRIME_1
424*)
425Theorem prime_non_square:
426  !p. prime p ==> ~square p
427Proof
428  rpt strip_tac >>
429  `?k. p = k * k` by rw[GSYM square_def] >>
430  `k divides p` by metis_tac[divides_def] >>
431  `(k = 1) \/ (k = p)` by metis_tac[prime_def] >-
432  fs[NOT_PRIME_1] >>
433  `p * 1 = p * p` by metis_tac[MULT_RIGHT_1] >>
434  `1 = p` by metis_tac[EQ_MULT_LCANCEL, NOT_PRIME_0] >>
435  metis_tac[NOT_PRIME_1]
436QED
437
438(* Theorem: ~square n ==> (SQRT n) * (SQRT n) < n *)
439(* Proof:
440   Note (SQRT n) * (SQRT n) <= n   by SQ_SQRT_LE
441    but (SQRT n) * (SQRT n) <> n   by square_def
442     so (SQRT n) * (SQRT n)  < n   by inequality
443*)
444Theorem SQ_SQRT_LT:
445  !n. ~square n ==> (SQRT n) * (SQRT n) < n
446Proof
447  rpt strip_tac >>
448  `(SQRT n) * (SQRT n) <= n` by simp[SQ_SQRT_LE] >>
449  `(SQRT n) * (SQRT n) <> n` by metis_tac[square_def] >>
450  decide_tac
451QED
452
453(* Theorem: ~square n ==> SQRT n ** 2 < n *)
454(* Proof: by SQ_SQRT_LT, EXP_2. *)
455Theorem SQ_SQRT_LT_alt:
456  !n. ~square n ==> SQRT n ** 2 < n
457Proof
458  metis_tac[SQ_SQRT_LT, EXP_2]
459QED
460
461(* Theorem: ~square n ==> ((2 * m + 1) ** 2 < n <=> m < HALF (1 + SQRT n)) *)
462(* Proof:
463   If part: (2 * m + 1) ** 2 < n ==> m < HALF (1 + SQRT n)
464          (2 * m + 1) ** 2 < n
465      ==> 2 * m + 1 <= SQRT n                  by SQRT_LT, SQRT_OF_SQ
466      ==> 2 * (m + 1) <= 1 + SQRT n            by arithmetic
467      ==>           m < HALF (1 + SQRT n)      by X_LT_DIV
468   Only-if part: m < HALF (1 + SQRT n) ==> (2 * m + 1) ** 2 < n
469        m < HALF (1 + SQRT n)
470    <=> 2 * (m + 1) <= 1 + SQRT n              by X_LT_DIV
471    <=>   2 * m + 1 <= SQRT n                  by arithmetic
472    <=>  (2 * m + 1) ** 2 <= (SQRT n) ** 2     by EXP_EXP_LE_MONO
473    ==>  (2 * m + 1) ** 2 <= n                 by SQ_SQRT_LE_alt
474    But  n <> (2 * m + 1) ** 2                 by ~square n
475     so  (2 * m + 1) ** 2 < n
476*)
477Theorem odd_square_lt:
478  !n m. ~square n ==> ((2 * m + 1) ** 2 < n <=> m < HALF (1 + SQRT n))
479Proof
480  rw[EQ_IMP_THM] >| [
481    `2 * m + 1 <= SQRT n` by metis_tac[SQRT_LT, SQRT_OF_SQ] >>
482    `2 * (m + 1) <= 1 + SQRT n` by decide_tac >>
483    fs[X_LT_DIV],
484    `2 * (m + 1) <= 1 + SQRT n` by fs[X_LT_DIV] >>
485    `2 * m + 1 <= SQRT n` by decide_tac >>
486    `(2 * m + 1) ** 2 <= (SQRT n) ** 2` by simp[] >>
487    `(SQRT n) ** 2 <= n` by fs[SQ_SQRT_LE_alt] >>
488    `n <> (2 * m + 1) ** 2` by metis_tac[square_alt] >>
489    decide_tac
490  ]
491QED
492
493(* Theorem: 1 < m ==> 0 < SUC (LOG2 n) * (m ** 2 DIV 2) *)
494(* Proof:
495   Since 1 < m ==> 1 < m ** 2 DIV 2             by ONE_LT_HALF_SQ
496   Hence           0 < m ** 2 DIV 2
497     and           0 < 0 < SUC (LOG2 n)         by prim_recTheory.LESS_0
498   Therefore 0 < SUC (LOG2 n) * (m ** 2 DIV 2)  by ZERO_LESS_MULT
499*)
500Theorem LOG2_SUC_TIMES_SQ_DIV_2_POS:
501    !n m. 1 < m ==> 0 < SUC (LOG2 n) * (m ** 2 DIV 2)
502Proof
503  rpt strip_tac >>
504  `1 < m ** 2 DIV 2` by rw[ONE_LT_HALF_SQ] >>
505  `0 < m ** 2 DIV 2 /\ 0 < SUC (LOG2 n)` by decide_tac >>
506  rw[ZERO_LESS_MULT]
507QED
508
509(* Theorem: 1 < n ==> LOG2 (HALF n) = (LOG2 n) - 1 *)
510(* Proof:
511   Note: > LOG_DIV |> SPEC ``2`` |> SPEC ``n:num``;
512   val it = |- 1 < 2 /\ 2 <= n ==> LOG2 n = 1 + LOG2 (HALF n): thm
513   Hence the result.
514*)
515Theorem LOG2_HALF:
516    !n. 1 < n ==> (LOG2 (HALF n) = (LOG2 n) - 1)
517Proof
518  rpt strip_tac >>
519  `LOG2 n = 1 + LOG2 (HALF n)` by rw[LOG_DIV] >>
520  decide_tac
521QED
522
523(* Theorem: 1 < n ==> (LOG2 n = 1 + LOG2 (HALF n)) *)
524(* Proof: by LOG_DIV:
525> LOG_DIV |> SPEC ``2``;
526val it = |- !x. 1 < 2 /\ 2 <= x ==> (LOG2 x = 1 + LOG2 (HALF x)): thm
527*)
528Theorem LOG2_BY_HALF:
529    !n. 1 < n ==> (LOG2 n = 1 + LOG2 (HALF n))
530Proof
531  rw[LOG_DIV]
532QED
533
534(* Theorem: 2 ** m < n ==> LOG2 (n DIV 2 ** m) = (LOG2 n) - m *)
535(* Proof:
536   By induction on m.
537   Base: !n. 2 ** 0 < n ==> LOG2 (n DIV 2 ** 0) = LOG2 n - 0
538         LOG2 (n DIV 2 ** 0)
539       = LOG2 (n DIV 1)                by EXP_0
540       = LOG2 n                        by DIV_1
541       = LOG2 n - 0                    by SUB_0
542   Step: !n. 2 ** m < n ==> LOG2 (n DIV 2 ** m) = LOG2 n - m ==>
543         !n. 2 ** SUC m < n ==> LOG2 (n DIV 2 ** SUC m) = LOG2 n - SUC m
544       Note 2 ** SUC m = 2 * 2 ** m       by EXP, [1]
545       Thus HALF (2 * 2 ** m) <= HALF n   by DIV_LE_MONOTONE
546         or            2 ** m <= HALF n   by HALF_TWICE
547       If 2 ** m < HALF n,
548            LOG2 (n DIV 2 ** SUC m)
549          = LOG2 (n DIV (2 * 2 ** m))     by [1]
550          = LOG2 ((HALF n) DIV 2 ** m)    by DIV_DIV_DIV_MULT
551          = LOG2 (HALF n) - m             by induction hypothesis, 2 ** m < HALF n
552          = (LOG2 n - 1) - m              by LOG2_HALF, 1 < n
553          = LOG2 n - (1 + m)              by arithmetic
554          = LOG2 n - SUC m                by ADD1
555       Otherwise 2 ** m = HALF n,
556            LOG2 (n DIV 2 ** SUC m)
557          = LOG2 (n DIV (2 * 2 ** m))     by [1]
558          = LOG2 ((HALF n) DIV 2 ** m)    by DIV_DIV_DIV_MULT
559          = LOG2 ((HALF n) DIV (HALF n))  by 2 ** m = HALF n
560          = LOG2 1                        by DIVMOD_ID, 0 < HALF n
561          = 0                             by LOG2_1
562            LOG2 n
563          = 1 + LOG2 (HALF n)             by LOG_DIV
564          = 1 + LOG2 (2 ** m)             by 2 ** m = HALF n
565          = 1 + m                         by LOG2_2_EXP
566          = SUC m                         by SUC_ONE_ADD
567       Thus RHS = LOG2 n - SUC m = 0 = LHS.
568*)
569
570Theorem LOG2_DIV_EXP:
571  !n m. 2 ** m < n ==> LOG2 (n DIV 2 ** m) = LOG2 n - m
572Proof
573  Induct_on ‘m’ >- rw[] >>
574  rpt strip_tac >>
575  ‘1 < 2 ** SUC m’ by rw[ONE_LT_EXP] >>
576  ‘1 < n’ by decide_tac >>
577  fs[EXP] >>
578  ‘2 ** m <= HALF n’
579    by metis_tac[DIV_LE_MONOTONE, HALF_TWICE, LESS_IMP_LESS_OR_EQ,
580                 DECIDE “0 < 2”] >>
581  ‘LOG2 (n DIV (TWICE (2 ** m))) = LOG2 ((HALF n) DIV 2 ** m)’
582    by rw[DIV_DIV_DIV_MULT] >>
583  fs[LESS_OR_EQ] >- rw[LOG2_HALF] >>
584  ‘LOG2 n = 1 + LOG2 (HALF n)’  by rw[LOG_DIV] >>
585  ‘_ = 1 + m’ by metis_tac[LOG2_2_EXP] >>
586  ‘_ = SUC m’ by rw[] >>
587  ‘0 < HALF n’ suffices_by rw[] >>
588  metis_tac[DECIDE “0 < 2”, ZERO_LT_EXP]
589QED
590
591(* ------------------------------------------------------------------------- *)
592(* LOG2 Computation                                                          *)
593(* ------------------------------------------------------------------------- *)
594
595(* Define halves n = count of HALFs of n to 0, recursively. *)
596Definition halves_def:
597    halves n = if n = 0 then 0 else SUC (halves (HALF n))
598End
599
600(* Theorem: halves n = if n = 0 then 0 else 1 + (halves (HALF n)) *)
601(* Proof: by halves_def, ADD1 *)
602Theorem halves_alt:
603    !n. halves n = if n = 0 then 0 else 1 + (halves (HALF n))
604Proof
605  rw[Once halves_def, ADD1]
606QED
607
608(* Extract theorems from definition *)
609Theorem halves_0[simp] = halves_def |> SPEC ``0`` |> SIMP_RULE arith_ss[];
610(* val halves_0 = |- halves 0 = 0: thm *)
611Theorem halves_1[simp] = halves_def |> SPEC ``1`` |> SIMP_RULE arith_ss[];
612(* val halves_1 = |- halves 1 = 1: thm *)
613Theorem halves_2[simp] = halves_def |> SPEC ``2`` |> SIMP_RULE arith_ss[halves_1];
614(* val halves_2 = |- halves 2 = 2: thm *)
615
616(* Theorem: 0 < n ==> 0 < halves n *)
617(* Proof: by halves_def *)
618Theorem halves_pos[simp]:
619    !n. 0 < n ==> 0 < halves n
620Proof
621  rw[Once halves_def]
622QED
623
624(* Theorem: 0 < n ==> (halves n = 1 + LOG2 n) *)
625(* Proof:
626   By complete induction on n.
627    Assume: !m. m < n ==> 0 < m ==> (halves m = 1 + LOG2 m)
628   To show: 0 < n ==> (halves n = 1 + LOG2 n)
629   Note HALF n < n            by HALF_LT, 0 < n
630   Need 0 < HALF n to apply induction hypothesis.
631   If HALF n = 0,
632      Then n = 1              by HALF_EQ_0
633           halves 1
634         = SUC (halves 0)     by halves_def
635         = 1                  by halves_def
636         = 1 + LOG2 1         by LOG2_1
637   If HALF n <> 0,
638      Then n <> 1                  by HALF_EQ_0
639        so 1 < n                   by n <> 0, n <> 1.
640           halves n
641         = SUC (halves (HALF n))   by halves_def
642         = SUC (1 + LOG2 (HALF n)) by induction hypothesis
643         = SUC (LOG2 n)            by LOG2_BY_HALF
644         = 1 + LOG2 n              by ADD1
645*)
646Theorem halves_by_LOG2:
647    !n. 0 < n ==> (halves n = 1 + LOG2 n)
648Proof
649  completeInduct_on `n` >>
650  strip_tac >>
651  rw[Once halves_def] >>
652  Cases_on `n = 1` >-
653  simp[Once halves_def] >>
654  `HALF n < n` by rw[HALF_LT] >>
655  `HALF n <> 0` by fs[HALF_EQ_0] >>
656  simp[LOG2_BY_HALF]
657QED
658
659(* Theorem: LOG2 n = if n = 0 then LOG2 0 else (halves n - 1) *)
660(* Proof:
661   If 0 < n,
662      Note 0 < halves n            by halves_pos
663       and halves n = 1 + LOG2 n   by halves_by_LOG2
664        or LOG2 n = halves - 1.
665   If n = 0, make it an infinite loop.
666*)
667Theorem LOG2_compute[compute]:
668    !n. LOG2 n = if n = 0 then LOG2 0 else (halves n - 1)
669Proof
670  rpt strip_tac >>
671  (Cases_on `n = 0` >> simp[]) >>
672  `0 < halves n` by rw[] >>
673  `halves n = 1 + LOG2 n` by rw[halves_by_LOG2] >>
674  decide_tac
675QED
676
677(* Put this to computeLib *)
678(* val _ = computeLib.add_persistent_funs ["LOG2_compute"]; *)
679
680(*
681EVAL ``LOG2 16``; --> 4
682EVAL ``LOG2 17``; --> 4
683EVAL ``LOG2 32``; --> 5
684EVAL ``LOG2 1024``; --> 10
685EVAL ``LOG2 1023``; --> 9
686*)
687
688(* Michael's method *)
689(*
690Define `count_divs n = if 2 <= n then 1 + count_divs (n DIV 2) else 0`;
691
692g `0 < n ==> (LOG2 n = count_divs n)`;
693e (completeInduct_on `n`);
694e strip_tac;
695e (ONCE_REWRITE_TAC [theorm "count_divs_def"]);
696e (Cases_on `2 <= n`);
697e (mp_tac (Q.SPECL [`2`, `n`] LOG_DIV));
698e (simp[]);
699(* prove on-the-fly *)
700e (`0 < n DIV 2` suffices_by simp[]);
701(* DB.match [] ``x < k DIV n``; *)
702e (simp[arithmeticTheory.X_LT_DIV]);
703e (`n = 1` by simp[]);
704LOG_1;
705e (simp[it]);
706val foo = top_thm();
707
708g `!n. LOG2 n = if 0 < n then count_divs n else LOG2 n`;
709
710e (rw[]);
711e (simp[foo]);
712e (lfs[]); ???
713
714val bar = top_thm();
715var bar = save_thm("bar", bar);
716computeLib.add_persistent_funs ["bar"];
717EVAL ``LOG2 16``;
718EVAL ``LOG2 17``;
719EVAL ``LOG2 32``;
720EVAL ``LOG2 1024``;
721EVAL ``LOG2 1023``;
722EVAL ``LOG2 0``; -- loops!
723
724So for n = 97,
725EVAL ``LOG2 97``; --> 6
726EVAL ``4 * LOG2 97 * LOG2 97``; --> 4 * 6 * 6 = 4 * 36 = 144
727
728Need ord_r (97) > 144, r < 97, not possible ???
729
730val count_divs_def = Define `count_divs n = if 1 < n then 1 + count_divs (n DIV 2) else 0`;
731
732val LOG2_by_count_divs = store_thm(
733  "LOG2_by_count_divs",
734  ``!n. 0 < n ==> (LOG2 n = count_divs n)``,
735  completeInduct_on `n` >>
736  strip_tac >>
737  ONCE_REWRITE_TAC[count_divs_def] >>
738  rw[] >| [
739    mp_tac (Q.SPECL [`2`, `n`] LOG_DIV) >>
740    `2 <= n` by decide_tac >>
741    `0 < n DIV 2` by rw[X_LT_DIV] >>
742    simp[],
743    `n = 1` by decide_tac >>
744    simp[LOG_1]
745  ]);
746
747val LOG2_compute = store_thm(
748  "LOG2_compute[compute]",
749  ``!n. LOG2 n = if 0 < n then count_divs n else LOG2 n``,
750  rw_tac std_ss[LOG2_by_count_divs]);
751
752*)
753
754(* Theorem: m <= n ==> halves m <= halves n *)
755(* Proof:
756   If m = 0,
757      Then halves m = 0            by halves_0
758      Thus halves m <= halves n    by 0 <= halves n
759   If m <> 0,
760      Then 0 < m and 0 < n   by m <= n
761        so halves m = 1 + LOG2 m   by halves_by_LOG2
762       and halves n = 1 + LOG2 n   by halves_by_LOG2
763       and LOG2 m <= LOG2 n        by LOG2_LE
764       ==> halves m <= halves n    by arithmetic
765*)
766Theorem halves_le:
767    !m n. m <= n ==> halves m <= halves n
768Proof
769  rpt strip_tac >>
770  Cases_on `m = 0` >-
771  rw[] >>
772  `0 < m /\ 0 < n` by decide_tac >>
773  `LOG2 m <= LOG2 n` by rw[LOG2_LE] >>
774  rw[halves_by_LOG2]
775QED
776
777(* Theorem: (halves n = 0) <=> (n = 0) *)
778(* Proof: by halves_pos, halves_0 *)
779Theorem halves_eq_0:
780    !n. (halves n = 0) <=> (n = 0)
781Proof
782  metis_tac[halves_pos, halves_0, NOT_ZERO_LT_ZERO]
783QED
784
785(* Theorem: (halves n = 1) <=> (n = 1) *)
786(* Proof:
787   If part: halves n = 1 ==> n = 1
788      By contradiction, assume n <> 1.
789      Note n <> 0                   by halves_eq_0
790        so 2 <= n                   by n <> 0, n <> 1
791        or halves 2 <= halves n     by halves_le
792       But halves 2 = 2             by halves_2
793      This gives 2 <= 1, a contradiction.
794   Only-if part: halves 1 = 1, true by halves_1
795*)
796Theorem halves_eq_1:
797    !n. (halves n = 1) <=> (n = 1)
798Proof
799  rw[EQ_IMP_THM] >>
800  spose_not_then strip_assume_tac >>
801  `n <> 0` by metis_tac[halves_eq_0, DECIDE``1 <> 0``] >>
802  `2 <= n` by decide_tac >>
803  `halves 2 <= halves n` by rw[halves_le] >>
804  fs[]
805QED
806
807(* ------------------------------------------------------------------------- *)
808(* Perfect Power                                                             *)
809(* ------------------------------------------------------------------------- *)
810
811(* Define a PerfectPower number *)
812Definition perfect_power_def:
813  perfect_power (n:num) (m:num) <=> ?e. (n = m ** e)
814End
815
816(* Overload perfect_power *)
817Overload power_of = ``perfect_power``
818val _ = set_fixity "power_of" (Infix(NONASSOC, 450)); (* same as relation *)
819(* from pretty-printing, a good idea. *)
820
821(* Theorem: perfect_power n n *)
822(* Proof:
823   True since n = n ** 1   by EXP_1
824*)
825Theorem perfect_power_self:
826    !n. perfect_power n n
827Proof
828  metis_tac[perfect_power_def, EXP_1]
829QED
830
831(* Theorem: perfect_power 0 m <=> (m = 0) *)
832(* Proof: by perfect_power_def, EXP_EQ_0 *)
833Theorem perfect_power_0_m:
834    !m. perfect_power 0 m <=> (m = 0)
835Proof
836  rw[perfect_power_def, EQ_IMP_THM]
837QED
838
839(* Theorem: perfect_power 1 m *)
840(* Proof: by perfect_power_def, take e = 0 *)
841Theorem perfect_power_1_m:
842    !m. perfect_power 1 m
843Proof
844  rw[perfect_power_def] >>
845  metis_tac[]
846QED
847
848(* Theorem: perfect_power n 0 <=> ((n = 0) \/ (n = 1)) *)
849(* Proof: by perfect_power_def, ZERO_EXP. *)
850Theorem perfect_power_n_0:
851    !n. perfect_power n 0 <=> ((n = 0) \/ (n = 1))
852Proof
853  rw[perfect_power_def] >>
854  metis_tac[ZERO_EXP]
855QED
856
857(* Theorem: perfect_power n 1 <=> (n = 1) *)
858(* Proof: by perfect_power_def, EXP_1 *)
859Theorem perfect_power_n_1:
860    !n. perfect_power n 1 <=> (n = 1)
861Proof
862  rw[perfect_power_def]
863QED
864
865(* Theorem: 0 < m /\ 1 < n /\ (n MOD m = 0) ==>
866            (perfect_power n m) <=> (perfect_power (n DIV m) m) *)
867(* Proof:
868   If part: perfect_power n m ==> perfect_power (n DIV m) m
869      Note ?e. n = m ** e              by perfect_power_def
870       and e <> 0                      by EXP_0, n <> 1
871        so ?k. e = SUC k               by num_CASES
872        or n = m ** SUC k
873       ==> n DIV m = m ** k            by EXP_SUC_DIV
874      Thus perfect_power (n DIV m) m   by perfect_power_def
875   Only-if part: perfect_power (n DIV m) m ==> perfect_power n m
876      Note ?e. n DIV m = m ** e        by perfect_power_def
877       Now m divides n                 by DIVIDES_MOD_0, n MOD m = 0, 0 < m
878       ==> n = m * (n DIV m)           by DIVIDES_EQN_COMM, 0 < m
879             = m * m ** e              by above
880             = m ** (SUC e)            by EXP
881      Thus perfect_power n m           by perfect_power_def
882*)
883Theorem perfect_power_mod_eq_0:
884    !n m. 0 < m /\ 1 < n /\ (n MOD m = 0) ==>
885     ((perfect_power n m) <=> (perfect_power (n DIV m) m))
886Proof
887  rw[perfect_power_def] >>
888  rw[EQ_IMP_THM] >| [
889    `m ** e <> 1` by decide_tac >>
890    `e <> 0` by metis_tac[EXP_0] >>
891    `?k. e = SUC k` by metis_tac[num_CASES] >>
892    qexists_tac `k` >>
893    rw[EXP_SUC_DIV],
894    `m divides n` by rw[DIVIDES_MOD_0] >>
895    `n = m * (n DIV m)` by rw[GSYM DIVIDES_EQN_COMM] >>
896    metis_tac[EXP]
897  ]
898QED
899
900(* Theorem: 0 < m /\ 1 < n /\ (n MOD m <> 0) ==> ~(perfect_power n m) *)
901(* Proof:
902   By contradiction, assume perfect_power n m.
903   Then ?e. n = m ** e      by perfect_power_def
904    Now e <> 0              by EXP_0, n <> 1
905     so ?k. e = SUC k       by num_CASES
906        n = m ** SUC k
907          = m * (m ** k)    by EXP
908          = (m ** k) * m    by MULT_COMM
909   Thus m divides n         by divides_def
910    ==> n MOD m = 0         by DIVIDES_MOD_0
911   This contradicts n MOD m <> 0.
912*)
913Theorem perfect_power_mod_ne_0:
914    !n m. 0 < m /\ 1 < n /\ (n MOD m <> 0) ==> ~(perfect_power n m)
915Proof
916  rpt strip_tac >>
917  fs[perfect_power_def] >>
918  `n <> 1` by decide_tac >>
919  `e <> 0` by metis_tac[EXP_0] >>
920  `?k. e = SUC k` by metis_tac[num_CASES] >>
921  `n = m * m ** k` by fs[EXP] >>
922  `m divides n` by metis_tac[divides_def, MULT_COMM] >>
923  metis_tac[DIVIDES_MOD_0]
924QED
925
926(* Theorem: perfect_power n m =
927         if n = 0 then (m = 0)
928         else if n = 1 then T
929         else if m = 0 then (n <= 1)
930         else if m = 1 then (n = 1)
931         else if n MOD m = 0 then perfect_power (n DIV m) m else F *)
932(* Proof:
933   If n = 0, to show:
934      perfect_power 0 m <=> (m = 0), true   by perfect_power_0_m
935   If n = 1, to show:
936      perfect_power 1 m = T, true           by perfect_power_1_m
937   If m = 0, to show:
938      perfect_power n 0 <=> (n <= 1), true  by perfect_power_n_0
939   If m = 1, to show:
940      perfect_power n 1 <=> (n = 1), true   by perfect_power_n_1
941   Otherwise,
942      If n MOD m = 0, to show:
943      perfect_power (n DIV m) m <=> perfect_power n m, true
944                                            by perfect_power_mod_eq_0
945      If n MOD m <> 0, to show:
946      ~perfect_power n m, true              by perfect_power_mod_ne_0
947*)
948Theorem perfect_power_test:
949    !n m. perfect_power n m =
950         if n = 0 then (m = 0)
951         else if n = 1 then T
952         else if m = 0 then (n <= 1)
953         else if m = 1 then (n = 1)
954         else if n MOD m = 0 then perfect_power (n DIV m) m else F
955Proof
956  rpt strip_tac >>
957  (Cases_on `n = 0` >> simp[perfect_power_0_m]) >>
958  (Cases_on `n = 1` >> simp[perfect_power_1_m]) >>
959  `1 < n` by decide_tac >>
960  (Cases_on `m = 0` >> simp[perfect_power_n_0]) >>
961  `0 < m` by decide_tac >>
962  (Cases_on `m = 1` >> simp[perfect_power_n_1]) >>
963  (Cases_on `n MOD m = 0` >> simp[]) >-
964  rw[perfect_power_mod_eq_0] >>
965  rw[perfect_power_mod_ne_0]
966QED
967
968(* Theorem: 1 < m /\ perfect_power n m /\ perfect_power (SUC n) m ==> (m = 2) /\ (n = 1) *)
969(* Proof:
970   Note ?x. n = m ** x                by perfect_power_def
971    and ?y. SUC n = m ** y            by perfect_power_def
972   Since n < SUC n                    by LESS_SUC
973    ==>  x < y                        by EXP_BASE_LT_MONO
974   Let d = y - x.
975   Then 0 < d /\ (y = x + d).
976   Let v = m ** d
977   Note 1 < v                         by ONE_LT_EXP, 1 < m
978    and m ** y = n * v                by EXP_ADD
979   Let z = v - 1.
980   Then 0 < z /\ (v = z + 1).
981    and SUC n = n * v
982              = n * (z + 1)
983              = n * z + n * 1         by LEFT_ADD_DISTRIB
984              = n * z + n
985    ==> n * z = 1                     by ADD1
986    ==> n = 1 /\ z = 1                by MULT_EQ_1
987     so v = 2                         by v = z + 1
988
989   To show: m = 2.
990   By contradiction, suppose m <> 2.
991   Then      2 < m                    by 1 < m, m <> 2
992    ==> 2 ** y < m ** y               by EXP_EXP_LT_MONO
993               = n * v = 2 = 2 ** 1   by EXP_1
994    ==>      y < 1                    by EXP_BASE_LT_MONO
995   Thus y = 0, but y <> 0 by x < y,
996   leading to a contradiction.
997*)
998
999Theorem perfect_power_suc:
1000  !m n. 1 < m /\ perfect_power n m /\ perfect_power (SUC n) m ==>
1001        m = 2 /\ n = 1
1002Proof
1003  ntac 3 strip_tac >>
1004  `?x. n = m ** x` by fs[perfect_power_def] >>
1005  `?y. SUC n = m ** y` by fs[GSYM perfect_power_def] >>
1006  `n < SUC n` by decide_tac >>
1007  `x < y` by metis_tac[EXP_BASE_LT_MONO] >>
1008  qabbrev_tac `d = y - x` >>
1009  `0 < d /\ (y = x + d)` by fs[Abbr`d`] >>
1010  qabbrev_tac `v = m ** d` >>
1011  `m ** y = n * v` by fs[EXP_ADD, Abbr`v`] >>
1012  `1 < v` by rw[ONE_LT_EXP, Abbr`v`] >>
1013  qabbrev_tac `z = v - 1` >>
1014  `0 < z /\ (v = z + 1)` by fs[Abbr`z`] >>
1015  `n * v = n * z + n * 1` by rw[] >>
1016  `n * z = 1` by decide_tac >>
1017  `n = 1 /\ z = 1` by metis_tac[MULT_EQ_1] >>
1018  `v = 2` by decide_tac >>
1019  simp[] >>
1020  spose_not_then strip_assume_tac >>
1021  `2 < m` by decide_tac >>
1022  `2 ** y < m ** y` by simp[EXP_EXP_LT_MONO] >>
1023  `m ** y = 2` by decide_tac >>
1024  `2 ** y < 2 ** 1` by metis_tac[EXP_1] >>
1025  `y < 1` by fs[EXP_BASE_LT_MONO] >>
1026  decide_tac
1027QED
1028
1029(* Theorem: 1 < m /\ 1 < n /\ perfect_power n m ==> ~perfect_power (SUC n) m *)
1030(* Proof:
1031   By contradiction, suppose perfect_power (SUC n) m.
1032   Then n = 1        by perfect_power_suc
1033   This contradicts 1 < n.
1034*)
1035Theorem perfect_power_not_suc:
1036    !m n. 1 < m /\ 1 < n /\ perfect_power n m ==> ~perfect_power (SUC n) m
1037Proof
1038  spose_not_then strip_assume_tac >>
1039  `n = 1` by metis_tac[perfect_power_suc] >>
1040  decide_tac
1041QED
1042
1043(* Theorem: 1 < b /\ 0 < n ==>
1044           (LOG b (SUC n) = LOG b n + if perfect_power (SUC n) b then 1 else 0) *)
1045(* Proof:
1046   Let x = LOG b n, y = LOG b (SUC n).  x <= y
1047   Note SUC n <= b ** SUC x /\ b ** SUC x <= b * n            by LOG_TEST
1048    and SUC (SUC n) <= b ** SUC y /\ b ** SUC y <= b * SUC n  by LOG_TEST, 0 < SUC n
1049
1050   If SUC n = b ** SUC x,
1051      Then perfect_power (SUC n) b       by perfect_power_def
1052       and y = LOG b (SUC n)
1053             = LOG b (b ** SUC x)
1054             = SUC x                     by LOG_EXACT_EXP
1055             = x + 1                     by ADD1
1056      hence true.
1057   Otherwise, SUC n < b ** SUC x,
1058      Then SUC (SUC n) <= b ** SUC x     by SUC n < b ** SUC x
1059       and b * n < b * SUC n             by LT_MULT_LCANCEL, n < SUC n
1060      Thus b ** SUC x <= b * n < b * SUC n
1061        or y = x                         by LOG_TEST
1062      Claim: ~perfect_power (SUC n) b
1063      Proof: By contradiction, suppose perfect_power (SUC n) b.
1064             Then ?e. SUC n = b ** e.
1065             Thus y = LOG b (SUC n)
1066                    = LOG b (b ** e)     by LOG_EXACT_EXP
1067                    = e
1068              ==> b * n < b * SUC n
1069                        = b * b ** e     by SUC n = b ** e
1070                        = b ** SUC e     by EXP
1071                        = b ** SUC x     by e = y = x
1072              This contradicts b ** SUC x <= b * n
1073      With ~perfect_power (SUC n) b, hence true.
1074*)
1075
1076Theorem LOG_SUC:
1077  !b n. 1 < b /\ 0 < n ==>
1078    (LOG b (SUC n) = LOG b n + if perfect_power (SUC n) b then 1 else 0)
1079Proof
1080  rpt strip_tac >>
1081  qabbrev_tac ‘x = LOG b n’ >>
1082  qabbrev_tac ‘y = LOG b (SUC n)’ >>
1083  ‘0 < SUC n’ by decide_tac >>
1084  ‘SUC n <= b ** SUC x /\ b ** SUC x <= b * n’ by metis_tac[LOG_TEST] >>
1085  ‘SUC (SUC n) <= b ** SUC y /\ b ** SUC y <= b * SUC n’
1086    by metis_tac[LOG_TEST] >>
1087  ‘(SUC n = b ** SUC x) \/ (SUC n < b ** SUC x)’ by decide_tac >| [
1088    ‘perfect_power (SUC n) b’ by metis_tac[perfect_power_def] >>
1089    ‘y = SUC x’ by rw[LOG_EXACT_EXP, Abbr‘y’] >>
1090    simp[],
1091    ‘SUC (SUC n) <= b ** SUC x’ by decide_tac >>
1092    ‘b * n < b * SUC n’ by rw[] >>
1093    ‘b ** SUC x <= b * SUC n’ by decide_tac >>
1094    ‘y = x’ by metis_tac[LOG_TEST] >>
1095    ‘~perfect_power (SUC n) b’
1096      by (spose_not_then strip_assume_tac >>
1097          `?e. SUC n = b ** e` by fs[perfect_power_def] >>
1098          `y = e` by (simp[Abbr`y`] >> fs[] >> rfs[LOG_EXACT_EXP]) >>
1099          `b * n < b ** SUC x` by metis_tac[EXP] >>
1100          decide_tac) >>
1101    simp[]
1102  ]
1103QED
1104
1105(*
1106LOG_SUC;
1107|- !b n. 1 < b /\ 0 < n ==> LOG b (SUC n) = LOG b n + if perfect_power (SUC n) b then 1 else 0
1108Let v = LOG b n.
1109
1110   v       v+1.      v+2.     v+3.
1111   -----------------------------------------------
1112   b       b ** 2        b ** 3             b ** 4
1113
1114> EVAL ``MAP (LOG 2) [1 .. 20]``;
1115val it = |- MAP (LOG 2) [1 .. 20] =
1116      [0; 1; 1; 2; 2; 2; 2; 3; 3; 3; 3; 3; 3; 3; 3; 4; 4; 4; 4; 4]: thm
1117       1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20
1118*)
1119
1120(* Theorem: 0 < n ==> !m. perfect_power n m <=> ?k. k <= LOG2 n /\ (n = m ** k) *)
1121(* Proof:
1122   If part: perfect_power n m ==> ?k. k <= LOG2 n /\ (n = m ** k)
1123      Given perfect_power n m, ?e. (n = m ** e)    by perfect_power_def
1124      If n = 1,
1125         Then LOG2 1 = 0                           by LOG2_1
1126         Take k = 0, then 1 = m ** 0               by EXP_0
1127      If n <> 1, so e <> 0                         by EXP
1128                and m <> 1                         by EXP_1
1129       also n <> 0, so m <> 0                      by ZERO_EXP
1130      Therefore 2 <= m
1131            ==> 2 ** e <= m ** e                   by EXP_BASE_LE_MONO, 1 < 2
1132            But n < 2 ** (SUC (LOG2 n))            by LOG2_PROPERTY, 0 < n
1133        or 2 ** e < 2 ** (SUC (LOG2 n))
1134        hence   e < SUC (LOG2 n)                   by EXP_BASE_LT_MONO, 1 < 2
1135        i.e.    e <= LOG2 n
1136   Only-if part: ?k. k <= LOG2 n /\ (n = m ** k) ==> perfect_power n m
1137      True by perfect_power_def.
1138*)
1139Theorem perfect_power_bound_LOG2:
1140    !n. 0 < n ==> !m. perfect_power n m <=> ?k. k <= LOG2 n /\ (n = m ** k)
1141Proof
1142  rw[EQ_IMP_THM] >| [
1143    Cases_on `n = 1` >-
1144    simp[] >>
1145    `?e. (n = m ** e)` by rw[GSYM perfect_power_def] >>
1146    `n <> 0 /\ 1 < n /\ 1 < 2` by decide_tac >>
1147    `e <> 0` by metis_tac[EXP] >>
1148    `m <> 1` by metis_tac[EXP_1] >>
1149    `m <> 0` by metis_tac[ZERO_EXP] >>
1150    `2 <= m` by decide_tac >>
1151    `2 ** e <= n` by rw[EXP_BASE_LE_MONO] >>
1152    `n < 2 ** (SUC (LOG2 n))` by rw[LOG2_PROPERTY] >>
1153    `e < SUC (LOG2 n)` by metis_tac[EXP_BASE_LT_MONO, LESS_EQ_LESS_TRANS] >>
1154    `e <= LOG2 n` by decide_tac >>
1155    metis_tac[],
1156    metis_tac[perfect_power_def]
1157  ]
1158QED
1159
1160(* Theorem: prime p /\ (?x y. 0 < x /\ (p ** x = q ** y)) ==> perfect_power q p *)
1161(* Proof:
1162   Note ?k. (q = p ** k)     by power_eq_prime_power, prime p, 0 < x
1163   Thus perfect_power q p    by perfect_power_def
1164*)
1165Theorem perfect_power_condition:
1166    !p q. prime p /\ (?x y. 0 < x /\ (p ** x = q ** y)) ==> perfect_power q p
1167Proof
1168  metis_tac[power_eq_prime_power, perfect_power_def]
1169QED
1170
1171(* Theorem: 0 < p /\ p divides n ==> (perfect_power n p <=> perfect_power (n DIV p) p) *)
1172(* Proof:
1173   Let q = n DIV p.
1174   Then n = p * q                   by DIVIDES_EQN_COMM, 0 < p
1175   If part: perfect_power n p ==> perfect_power q p
1176      Note ?k. n = p ** k           by perfect_power_def
1177      If k = 0,
1178         Then p * q = p ** 0 = 1    by EXP
1179          ==> p = 1 and q = 1       by MULT_EQ_1
1180           so perfect_power q p     by perfect_power_self
1181      If k <> 0, k = SUC h for some h.
1182         Then p * q = p ** SUC h
1183                    = p * p ** h    by EXP
1184           or     q = p ** h        by MULT_LEFT_CANCEL, p <> 0
1185           so perfect_power q p     by perfect_power_self
1186
1187   Only-if part: perfect_power q p ==> perfect_power n p
1188      Note ?k. q = p ** k           by perfect_power_def
1189         so n = p * q = p ** SUC k  by EXP
1190       thus perfect_power n p       by perfect_power_def
1191*)
1192Theorem perfect_power_cofactor:
1193    !n p. 0 < p /\ p divides n ==> (perfect_power n p <=> perfect_power (n DIV p) p)
1194Proof
1195  rpt strip_tac >>
1196  qabbrev_tac `q = n DIV p` >>
1197  `n = p * q` by rw[GSYM DIVIDES_EQN_COMM, Abbr`q`] >>
1198  simp[EQ_IMP_THM] >>
1199  rpt strip_tac >| [
1200    `?k. p * q = p ** k` by rw[GSYM perfect_power_def] >>
1201    Cases_on `k` >| [
1202      `(p = 1) /\ (q = 1)` by metis_tac[MULT_EQ_1, EXP] >>
1203      metis_tac[perfect_power_self],
1204      `q = p ** n'` by metis_tac[EXP, MULT_LEFT_CANCEL, NOT_ZERO_LT_ZERO] >>
1205      metis_tac[perfect_power_def]
1206    ],
1207    `?k. q = p ** k` by rw[GSYM perfect_power_def] >>
1208    `p * q = p ** SUC k` by rw[EXP] >>
1209    metis_tac[perfect_power_def]
1210  ]
1211QED
1212
1213(* Theorem: 0 < n /\ p divides n ==> (perfect_power n p <=> perfect_power (n DIV p) p) *)
1214(* Proof:
1215   Note 0 < p           by ZERO_DIVIDES, 0 < n
1216   The result follows   by perfect_power_cofactor
1217*)
1218Theorem perfect_power_cofactor_alt:
1219    !n p. 0 < n /\ p divides n ==> (perfect_power n p <=> perfect_power (n DIV p) p)
1220Proof
1221  rpt strip_tac >>
1222  `0 < p` by metis_tac[ZERO_DIVIDES, NOT_ZERO] >>
1223  qabbrev_tac `q = n DIV p` >>
1224  rw[perfect_power_cofactor]
1225QED
1226
1227(* Theorem: perfect_power n 2 ==> (ODD n <=> (n = 1)) *)
1228(* Proof:
1229   If part: perfect_power n 2 /\ ODD n ==> n = 1
1230      By contradiction, suppose n <> 1.
1231      Note ?k. n = 2 ** k     by perfect_power_def
1232      Thus k <> 0             by EXP
1233        so ?h. k = SUC h      by num_CASES
1234           n = 2 ** (SUC h)   by above
1235             = 2 * 2 ** h     by EXP
1236       ==> EVEN n             by EVEN_DOUBLE
1237      This contradicts ODD n  by EVEN_ODD
1238   Only-if part: perfect_power n 2 /\ n = 1 ==> ODD n
1239      This is true              by ODD_1
1240*)
1241Theorem perfect_power_2_odd:
1242    !n. perfect_power n 2 ==> (ODD n <=> (n = 1))
1243Proof
1244  rw[EQ_IMP_THM] >>
1245  spose_not_then strip_assume_tac >>
1246  `?k. n = 2 ** k` by rw[GSYM perfect_power_def] >>
1247  `k <> 0` by metis_tac[EXP] >>
1248  `?h. k = SUC h` by metis_tac[num_CASES] >>
1249  `n = 2 * 2 ** h` by rw[EXP] >>
1250  metis_tac[EVEN_DOUBLE, EVEN_ODD]
1251QED
1252
1253(* ------------------------------------------------------------------------- *)
1254(* Power Free                                                                *)
1255(* ------------------------------------------------------------------------- *)
1256
1257(* Define a PowerFree number: a trivial perfect power *)
1258Definition power_free_def[nocompute]:
1259   power_free (n:num) <=> !m e. (n = m ** e) ==> (m = n) /\ (e = 1)
1260End
1261(* Use zDefine as this is not computationally effective. *)
1262
1263(* Theorem: power_free 0 = F *)
1264(* Proof:
1265   Note 0 ** 2 = 0         by ZERO_EXP
1266   Thus power_free 0 = F   by power_free_def
1267*)
1268Theorem power_free_0:
1269    power_free 0 = F
1270Proof
1271  rw[power_free_def]
1272QED
1273
1274(* Theorem: power_free 1 = F *)
1275(* Proof:
1276   Note 0 ** 0 = 1         by ZERO_EXP
1277   Thus power_free 1 = F   by power_free_def
1278*)
1279Theorem power_free_1:
1280    power_free 1 = F
1281Proof
1282  rw[power_free_def]
1283QED
1284
1285(* Theorem: power_free n ==> 1 < n *)
1286(* Proof:
1287   By contradiction, suppose n = 0 or n = 1.
1288   Then power_free 0 = F     by power_free_0
1289    and power_free 1 = F     by power_free_1
1290*)
1291Theorem power_free_gt_1:
1292    !n. power_free n ==> 1 < n
1293Proof
1294  metis_tac[power_free_0, power_free_1, DECIDE``1 < n <=> (n <> 0 /\ n <> 1)``]
1295QED
1296
1297(* Theorem: power_free n <=> 1 < n /\ (!m. perfect_power n m ==> (n = m)) *)
1298(* Proof:
1299   If part: power_free n ==> 1 < n /\ (!m. perfect_power n m ==> (n = m))
1300      Note power_free n
1301       ==> 1 < n                by power_free_gt_1
1302       Now ?e. n = m ** e       by perfect_power_def
1303       ==> n = m                by power_free_def
1304
1305   Only-if part: 1 < n /\ (!m. perfect_power n m ==> (n = m)) ==> power_free n
1306      By power_free_def, this is to show:
1307         (n = m ** e) ==> (m = n) /\ (e = 1)
1308      Note perfect_power n m    by perfect_power_def, ?e.
1309       ==> m = n                by implication
1310        so n = n ** e           by given, m = n
1311       ==> e = 1                by POWER_EQ_SELF
1312*)
1313Theorem power_free_alt:
1314  power_free n <=> 1 < n /\ !m. perfect_power n m ==> n = m
1315Proof
1316  rw[EQ_IMP_THM]
1317  >- rw[power_free_gt_1]
1318  >- fs[power_free_def, perfect_power_def] >>
1319  fs[power_free_def, perfect_power_def, PULL_EXISTS] >>
1320  rpt strip_tac >>
1321  first_x_assum $ drule_then strip_assume_tac >> gs[]
1322QED
1323
1324(* Theorem: prime n ==> power_free n *)
1325(* Proof:
1326   Let n = m ** e. To show that n is power_free,
1327   (1) show m = n, by squeezing m as a factor of prime n.
1328   (2) show e = 1, by applying prime_powers_eq
1329   This is a typical detective-style proof.
1330
1331   Note prime n ==> n <> 1               by NOT_PRIME_1
1332
1333   Claim: !m e. n = m ** e ==> m = n
1334   Proof: Note m <> 1                    by EXP_1, n <> 1
1335           and e <> 0                    by EXP, n <> 1
1336          Thus e = SUC k for some k      by num_CASES
1337               n = m ** SUC k
1338                 = m * (m ** k)          by EXP
1339                 = (m ** k) * m          by MULT_COMM
1340          Thus m divides n,              by divides_def
1341           But m <> 1, so m = n          by prime_def
1342
1343   The claim satisfies half of the power_free_def.
1344   With m = n, prime m,
1345    and e <> 0                           by EXP, n <> 1
1346   Thus n = n ** 1 = m ** e              by EXP_1
1347    ==> e = 1                            by prime_powers_eq, 0 < e.
1348*)
1349Theorem prime_is_power_free:
1350    !n. prime n ==> power_free n
1351Proof
1352  rpt strip_tac >>
1353  `n <> 1` by metis_tac[NOT_PRIME_1] >>
1354  `!m e. (n = m ** e) ==> (m = n)` by
1355  (rpt strip_tac >>
1356  `m <> 1` by metis_tac[EXP_1] >>
1357  metis_tac[EXP, num_CASES, MULT_COMM, divides_def, prime_def]) >>
1358  `!m e. (n = m ** e) ==> (e = 1)` by metis_tac[EXP, EXP_1, prime_powers_eq, NOT_ZERO_LT_ZERO] >>
1359  metis_tac[power_free_def]
1360QED
1361
1362(* Theorem: power_free n /\ perfect_power n m ==> (n = m) *)
1363(* Proof:
1364   Note ?e. n = m ** e        by perfect_power_def
1365    ==> n = m                 by power_free_def
1366*)
1367Theorem power_free_perfect_power:
1368    !m n. power_free n /\ perfect_power n m ==> (n = m)
1369Proof
1370  metis_tac[perfect_power_def, power_free_def]
1371QED
1372
1373(* Theorem: power_free n ==> (!j. 1 < j ==> (ROOT j n) ** j <> n) *)
1374(* Proof:
1375   By contradiction, suppose (ROOT j n) ** j = n.
1376   Then j = 1                 by power_free_def
1377   This contradicts 1 < j.
1378*)
1379Theorem power_free_property:
1380    !n. power_free n ==> (!j. 1 < j ==> (ROOT j n) ** j <> n)
1381Proof
1382  spose_not_then strip_assume_tac >>
1383  `j = 1` by metis_tac[power_free_def] >>
1384  decide_tac
1385QED
1386
1387(* We have:
1388power_free_0   |- power_free 0 <=> F
1389power_free_1   |- power_free 1 <=> F
1390So, given 1 < n, how to check power_free n ?
1391*)
1392
1393(* Theorem: power_free n <=> 1 < n /\ (!j. 1 < j ==> (ROOT j n) ** j <> n) *)
1394(* Proof:
1395   If part: power_free n ==> 1 < n /\ (!j. 1 < j ==> (ROOT j n) ** j <> n)
1396      Note 1 < n                       by power_free_gt_1
1397      The rest is true                 by power_free_property.
1398   Only-if part: 1 < n /\ (!j. 1 < j ==> (ROOT j n) ** j <> n) ==> power_free n
1399      By contradiction, assume ~(power_free n).
1400      That is, ?m e. n = m ** e /\ (m = m ** e ==> e <> 1)   by power_free_def
1401      Note 1 < m /\ 0 < e             by ONE_LT_EXP, 1 < n
1402      Thus ROOT e n = m               by ROOT_POWER, 1 < m, 0 < e
1403      By the implication, ~(1 < e), or e <= 1.
1404      Since 0 < e, this shows e = 1.
1405      Then m = m ** e                 by EXP_1
1406      This gives e <> 1, a contradiction.
1407*)
1408Theorem power_free_check_all:
1409    !n. power_free n <=> 1 < n /\ (!j. 1 < j ==> (ROOT j n) ** j <> n)
1410Proof
1411  rw[EQ_IMP_THM] >-
1412  rw[power_free_gt_1] >-
1413  rw[power_free_property] >>
1414  simp[power_free_def] >>
1415  spose_not_then strip_assume_tac >>
1416  `1 < m /\ 0 < e` by metis_tac[ONE_LT_EXP] >>
1417  `ROOT e n = m` by rw[ROOT_POWER] >>
1418  `~(1 < e)` by metis_tac[] >>
1419  `e = 1` by decide_tac >>
1420  rw[]
1421QED
1422
1423(* However, there is no need to check all the exponents:
1424  just up to (LOG2 n) or (ulog n) is sufficient.
1425  See earlier part with power_free_upto_def. *)
1426
1427(* ------------------------------------------------------------------------- *)
1428(* Upper Logarithm                                                           *)
1429(* ------------------------------------------------------------------------- *)
1430
1431(* Find the power of 2 more or equal to n *)
1432Definition count_up_def:
1433  count_up n m k =
1434       if m = 0 then 0 (* just to provide m <> 0 for the next one *)
1435  else if n <= m then k else count_up n (2 * m) (SUC k)
1436Termination WF_REL_TAC `measure (λ(n, m, k). n - m)`
1437End
1438
1439(* Define upper LOG2 n by count_up *)
1440Definition ulog_def:
1441    ulog n = count_up n 1 0
1442End
1443
1444(*
1445> EVAL ``ulog 1``; --> 0
1446> EVAL ``ulog 2``; --> 1
1447> EVAL ``ulog 3``; --> 2
1448> EVAL ``ulog 4``; --> 2
1449> EVAL ``ulog 5``; --> 3
1450> EVAL ``ulog 6``; --> 3
1451> EVAL ``ulog 7``; --> 3
1452> EVAL ``ulog 8``; --> 3
1453> EVAL ``ulog 9``; --> 4
1454*)
1455
1456(* Theorem: ulog 0 = 0 *)
1457(* Proof:
1458     ulog 0
1459   = count_up 0 1 0    by ulog_def
1460   = 0                 by count_up_def, 0 <= 1
1461*)
1462Theorem ulog_0[simp]:
1463    ulog 0 = 0
1464Proof
1465  rw[ulog_def, Once count_up_def]
1466QED
1467
1468(* Theorem: ulog 1 = 0 *)
1469(* Proof:
1470     ulog 1
1471   = count_up 1 1 0    by ulog_def
1472   = 0                 by count_up_def, 1 <= 1
1473*)
1474Theorem ulog_1[simp]:
1475    ulog 1 = 0
1476Proof
1477  rw[ulog_def, Once count_up_def]
1478QED
1479
1480(* Theorem: ulog 2 = 1 *)
1481(* Proof:
1482     ulog 2
1483   = count_up 2 1 0    by ulog_def
1484   = count_up 2 2 1    by count_up_def, ~(1 < 2)
1485   = 1                 by count_up_def, 2 <= 2
1486*)
1487Theorem ulog_2[simp]:
1488    ulog 2 = 1
1489Proof
1490  rw[ulog_def, Once count_up_def] >>
1491  rw[Once count_up_def]
1492QED
1493
1494(* Theorem: m <> 0 /\ n <= m ==> !k. count_up n m k = k *)
1495(* Proof: by count_up_def *)
1496Theorem count_up_exit:
1497    !m n. m <> 0 /\ n <= m ==> !k. count_up n m k = k
1498Proof
1499  rw[Once count_up_def]
1500QED
1501
1502(* Theorem: m <> 0 /\ m < n ==> !k. count_up n m k = count_up n (2 * m) (SUC k) *)
1503(* Proof: by count_up_def *)
1504Theorem count_up_suc:
1505    !m n. m <> 0 /\ m < n ==> !k. count_up n m k = count_up n (2 * m) (SUC k)
1506Proof
1507  rw[Once count_up_def]
1508QED
1509
1510(* Theorem: m <> 0 ==>
1511            !t. 2 ** t * m < n ==> !k. count_up n m k = count_up n (2 ** (SUC t) * m) ((SUC k) + t) *)
1512(* Proof:
1513   By induction on t.
1514   Base: 2 ** 0 * m < n ==> !k. count_up n m k = count_up n (2 ** SUC 0 * m) (SUC k + 0)
1515      Simplifying, this is to show:
1516          m < n ==> !k. count_up n m k = count_up n (2 * m) (SUC k)
1517      which is true by count_up_suc.
1518   Step: 2 ** t * m < n ==> !k. count_up n m k = count_up n (2 ** SUC t * m) (SUC k + t) ==>
1519         2 ** SUC t * m < n ==> !k. count_up n m k = count_up n (2 ** SUC (SUC t) * m) (SUC k + SUC t)
1520      Note 2 ** SUC t <> 0        by EXP_EQ_0, 2 <> 0
1521        so 2 ** SUC t * m <> 0    by MULT_EQ_0, m <> 0
1522       and 2 ** SUC t * m
1523         = 2 * 2 ** t * m         by EXP
1524         = 2 * (2 ** t * m)       by MULT_ASSOC
1525      Thus (2 ** t * m) < n       by MULT_LT_IMP_LT, 0 < 2
1526         count_up n m k
1527       = count_up n (2 ** SUC t * m) (SUC k + t)             by induction hypothesis
1528       = count_up n (2 * (2 ** SUC t * m)) (SUC (SUC k + t)) by count_up_suc
1529       = count_up n (2 ** SUC (SUC t) * m) (SUC k + SUC t)   by EXP, ADD1
1530*)
1531Theorem count_up_suc_eqn:
1532    !m. m <> 0 ==>
1533   !n t. 2 ** t * m < n ==> !k. count_up n m k = count_up n (2 ** (SUC t) * m) ((SUC k) + t)
1534Proof
1535  ntac 3 strip_tac >>
1536  Induct >-
1537  rw[count_up_suc] >>
1538  rpt strip_tac >>
1539  qabbrev_tac `q = 2 ** t * m` >>
1540  `2 ** SUC t <> 0` by metis_tac[EXP_EQ_0, DECIDE``2 <> 0``] >>
1541  `2 ** SUC t * m <> 0` by metis_tac[MULT_EQ_0] >>
1542  `2 ** SUC t * m = 2 * q` by rw_tac std_ss[EXP, MULT_ASSOC, Abbr`q`] >>
1543  `q < n` by rw[MULT_LT_IMP_LT] >>
1544  rw[count_up_suc, EXP, ADD1]
1545QED
1546
1547(* Theorem: m <> 0 ==> !n t. 2 ** t * m < 2 * n /\ n <= 2 ** t * m ==> !k. count_up n m k = k + t *)
1548(* Proof:
1549   If t = 0,
1550      Then n <= m           by EXP
1551        so count_up n m k
1552         = k                by count_up_exit
1553         = k + 0            by ADD_0
1554   If t <> 0,
1555      Then ?s. t = SUC s            by num_CASES
1556      Note 2 ** t * m
1557         = 2 ** SUC s * m           by above
1558         = 2 * 2 ** s * m           by EXP
1559         = 2 * (2 ** s * m)         by MULT_ASSOC
1560      Note 2 ** SUC s * m < 2 * n   by given
1561        so   (2 ** s * m) < n       by LT_MULT_RCANCEL, 2 <> 0
1562
1563        count_up n m k
1564      = count_up n (2 ** t * m) ((SUC k) + t)   by count_up_suc_eqn
1565      = (SUC k) + t                             by count_up_exit
1566*)
1567Theorem count_up_exit_eqn:
1568    !m. m <> 0 ==> !n t. 2 ** t * m < 2 * n /\ n <= 2 ** t * m ==> !k. count_up n m k = k + t
1569Proof
1570  rpt strip_tac >>
1571  Cases_on `t` >-
1572  fs[count_up_exit] >>
1573  qabbrev_tac `q = 2 ** n' * m` >>
1574  `2 ** SUC n' * m = 2 * q` by rw_tac std_ss[EXP, MULT_ASSOC, Abbr`q`] >>
1575  `q < n` by decide_tac >>
1576  `count_up n m k = count_up n (2 ** (SUC n') * m) ((SUC k) + n')` by rw[count_up_suc_eqn, Abbr`q`] >>
1577  `_ = (SUC k) + n'` by rw[count_up_exit] >>
1578  rw[]
1579QED
1580
1581(* Theorem: 2 ** m < 2 * n /\ n <= 2 ** m ==> (ulog n = m) *)
1582(* Proof:
1583   Put m = 1 in count_up_exit_eqn:
1584       2 ** t * 1 < 2 * n /\ n <= 2 ** t * 1 ==> !k. count_up n 1 k = k + t
1585   Put k = 0, and apply MULT_RIGHT_1, ADD:
1586       2 ** t * 1 < 2 * n /\ n <= 2 ** t * 1 ==> count_up n 1 0 = t
1587   Then apply ulog_def to get the result, and rename t by m.
1588*)
1589Theorem ulog_unique:
1590    !m n. 2 ** m < 2 * n /\ n <= 2 ** m ==> (ulog n = m)
1591Proof
1592  metis_tac[ulog_def, count_up_exit_eqn, MULT_RIGHT_1, ADD, DECIDE``1 <> 0``]
1593QED
1594
1595(* Theorem: ulog n = if 1 < n then SUC (LOG2 (n - 1)) else 0 *)
1596(* Proof:
1597   If 1 < n,
1598      Then 0 < n - 1      by 1 < n
1599       ==> 2 ** LOG2 (n - 1) <= (n - 1) /\
1600           (n - 1) < 2 ** SUC (LOG2 (n - 1))      by LOG2_PROPERTY
1601        or 2 ** LOG2 (n - 1) < n /\
1602           n <= 2 ** SUC (LOG2 (n - 1))           by shifting inequalities
1603       Let t = SUC (LOG2 (n - 1)).
1604       Then 2 ** t = 2 * 2 ** (LOG2 (n - 1))      by EXP
1605                   < 2 * n                        by LT_MULT_LCANCEL, 2 ** LOG2 (n - 1) < n
1606       Thus ulog n = t                            by ulog_unique.
1607   If ~(1 < n),
1608      Then n <= 1, or n = 0 or n = 1.
1609      If n = 0, ulog n = 0                        by ulog_0
1610      If n = 1, ulog n = 0                        by ulog_1
1611*)
1612Theorem ulog_eqn:
1613    !n. ulog n = if 1 < n then SUC (LOG2 (n - 1)) else 0
1614Proof
1615  rw[] >| [
1616    `0 < n - 1` by decide_tac >>
1617    `2 ** LOG2 (n - 1) <= (n - 1) /\ (n - 1) < 2 ** SUC (LOG2 (n - 1))` by metis_tac[LOG2_PROPERTY] >>
1618    `2 * 2 ** LOG2 (n - 1) < 2 * n /\ n <= 2 ** SUC (LOG2 (n - 1))` by decide_tac >>
1619    rw[EXP, ulog_unique],
1620    metis_tac[ulog_0, ulog_1, DECIDE``~(1 < n) <=> (n = 0) \/ (n = 1)``]
1621  ]
1622QED
1623
1624(* Theorem: 0 < n ==> (ulog (SUC n) = SUC (LOG2 n)) *)
1625(* Proof:
1626   Note 0 < n ==> 1 < SUC n      by LT_ADD_RCANCEL, ADD1
1627   Thus ulog (SUC n)
1628      = SUC (LOG2 (SUC n - 1))   by ulog_eqn
1629      = SUC (LOG2 n)             by SUC_SUB1
1630*)
1631Theorem ulog_suc:
1632    !n. 0 < n ==> (ulog (SUC n) = SUC (LOG2 n))
1633Proof
1634  rpt strip_tac >>
1635  `1 < SUC n` by decide_tac >>
1636  rw[ulog_eqn]
1637QED
1638
1639(* Theorem: 0 < n ==> 2 ** (ulog n) < 2 * n /\ n <= 2 ** (ulog n) *)
1640(* Proof:
1641   Apply ulog_eqn, this is to show:
1642   (1) 1 < n ==> 2 ** SUC (LOG2 (n - 1)) < 2 * n
1643       Let m = n - 1.
1644       Note 0 < m                   by 1 < n
1645        ==> 2 ** LOG2 m <= m        by TWO_EXP_LOG2_LE, 0 < m
1646         or             <= n - 1    by notation
1647       Thus 2 ** LOG2 m < n         by inequality [1]
1648        and 2 ** SUC (LOG2 m)
1649          = 2 * 2 ** (LOG2 m)       by EXP
1650          < 2 * n                   by LT_MULT_LCANCEL, [1]
1651   (2) 1 < n ==> n <= 2 ** SUC (LOG2 (n - 1))
1652       Let m = n - 1.
1653       Note 0 < m                          by 1 < n
1654        ==> m < 2 ** SUC (LOG2 m)          by LOG2_PROPERTY, 0 < m
1655        n - 1 < 2 ** SUC (LOG2 m)          by notation
1656            n <= 2 ** SUC (LOG2 m)         by inequality [2]
1657         or n <= 2 ** SUC (LOG2 (n - 1))   by notation
1658*)
1659Theorem ulog_property:
1660    !n. 0 < n ==> 2 ** (ulog n) < 2 * n /\ n <= 2 ** (ulog n)
1661Proof
1662  rw[ulog_eqn] >| [
1663    `0 < n - 1` by decide_tac >>
1664    qabbrev_tac `m = n - 1` >>
1665    `2 ** SUC (LOG2 m) = 2 * 2 ** (LOG2 m)` by rw[EXP] >>
1666    `2 ** LOG2 m <= n - 1` by rw[TWO_EXP_LOG2_LE, Abbr`m`] >>
1667    decide_tac,
1668    `0 < n - 1` by decide_tac >>
1669    qabbrev_tac `m = n - 1` >>
1670    `2 ** SUC (LOG2 m) = 2 * 2 ** (LOG2 m)` by rw[EXP] >>
1671    `n - 1 < 2 ** SUC (LOG2 m)` by metis_tac[LOG2_PROPERTY] >>
1672    decide_tac
1673  ]
1674QED
1675
1676(* Theorem: 0 < n ==> !m. (ulog n = m) <=> 2 ** m < 2 * n /\ n <= 2 ** m *)
1677(* Proof:
1678   If part: 0 < n ==> 2 ** (ulog n) < 2 * n /\ n <= 2 ** (ulog n)
1679      True by ulog_property, 0 < n
1680   Only-if part: 2 ** m < 2 * n /\ n <= 2 ** m ==> ulog n = m
1681      True by ulog_unique
1682*)
1683Theorem ulog_thm:
1684    !n. 0 < n ==> !m. (ulog n = m) <=> (2 ** m < 2 * n /\ n <= 2 ** m)
1685Proof
1686  metis_tac[ulog_property, ulog_unique]
1687QED
1688
1689(* Theorem: (ulog 0 = 0) /\ !n. 0 < n ==> !m. (ulog n = m) <=> (n <= 2 ** m /\ 2 ** m < 2 * n) *)
1690(* Proof: by ulog_0 ulog_thm *)
1691Theorem ulog_def_alt:
1692  (ulog 0 = 0) /\
1693  !n. 0 < n ==> !m. (ulog n = m) <=> (n <= 2 ** m /\ 2 ** m < 2 * n)
1694Proof rw[ulog_0, ulog_thm]
1695QED
1696
1697(* Theorem: (ulog n = 0) <=> ((n = 0) \/ (n = 1)) *)
1698(* Proof:
1699   Note !n. SUC n <> 0                   by NOT_SUC
1700     so if 1 < n, ulog n <> 0            by ulog_eqn
1701   Thus ulog n = 0 <=> ~(1 < n)          by above
1702     or            <=> n <= 1            by negation
1703     or            <=> n = 0 or n = 1    by range
1704*)
1705Theorem ulog_eq_0:
1706    !n. (ulog n = 0) <=> ((n = 0) \/ (n = 1))
1707Proof
1708  rw[ulog_eqn]
1709QED
1710
1711(* Theorem: (ulog n = 1) <=> (n = 2) *)
1712(* Proof:
1713   If part: ulog n = 1 ==> n = 2
1714      Note n <> 0 and n <> 1             by ulog_eq_0
1715      Thus 1 < n, or 0 < n - 1           by arithmetic
1716       ==> SUC (LOG2 (n - 1)) = 1        by ulog_eqn, 1 < n
1717        or      LOG2 (n - 1) = 0         by SUC_EQ, ONE
1718       ==>            n - 1 < 2          by LOG_EQ_0, 0 < n - 1
1719        or                n <= 2         by inequality
1720      Combine with 1 < n, n = 2.
1721   Only-if part: ulog 2 = 1
1722         ulog 2
1723       = ulog (SUC 1)                    by TWO
1724       = SUC (LOG2 1)                    by ulog_suc
1725       = SUC 0                           by LOG_1, 0 < 2
1726       = 1                               by ONE
1727*)
1728Theorem ulog_eq_1:
1729    !n. (ulog n = 1) <=> (n = 2)
1730Proof
1731  rw[EQ_IMP_THM] >>
1732  `n <> 0 /\ n <> 1` by metis_tac[ulog_eq_0, DECIDE``1 <> 0``] >>
1733  `1 < n /\ 0 < n - 1` by decide_tac >>
1734  `SUC (LOG2 (n - 1)) = 1` by metis_tac[ulog_eqn] >>
1735  `LOG2 (n - 1) = 0` by decide_tac >>
1736  `n - 1 < 2` by metis_tac[LOG_EQ_0, DECIDE``1 < 2``] >>
1737  decide_tac
1738QED
1739
1740(* Theorem: ulog n <= 1 <=> n <= 2 *)
1741(* Proof:
1742       ulog n <= 1
1743   <=> ulog n = 0 \/ ulog n = 1   by arithmetic
1744   <=> n = 0 \/ n = 1 \/ n = 2    by ulog_eq_0, ulog_eq_1
1745   <=> n <= 2                     by arithmetic
1746
1747*)
1748Theorem ulog_le_1:
1749    !n. ulog n <= 1 <=> n <= 2
1750Proof
1751  rpt strip_tac >>
1752  `ulog n <= 1 <=> ((ulog n = 0) \/ (ulog n = 1))` by decide_tac >>
1753  rw[ulog_eq_0, ulog_eq_1]
1754QED
1755
1756(* Theorem: n <= m ==> ulog n <= ulog m *)
1757(* Proof:
1758   If n = 0,
1759      Note ulog 0 = 0      by ulog_0
1760      and 0 <= ulog m      for anything
1761   If n = 1,
1762      Note ulog 1 = 0      by ulog_1
1763      Thus 0 <= ulog m     by arithmetic
1764   If n <> 1, then 1 < n
1765      Note n <= m, so 1 < m
1766      Thus 0 < n - 1       by arithmetic
1767       and n - 1 <= m - 1  by arithmetic
1768       ==> LOG2 (n - 1) <= LOG2 (m - 1)              by LOG2_LE
1769       ==> SUC (LOG2 (n - 1)) <= SUC (LOG2 (m - 1))  by LESS_EQ_MONO
1770        or          ulog n <= ulog m                 by ulog_eqn, 1 < n, 1 < m
1771*)
1772Theorem ulog_le:
1773    !m n. n <= m ==> ulog n <= ulog m
1774Proof
1775  rpt strip_tac >>
1776  Cases_on `n = 0` >-
1777  rw[] >>
1778  Cases_on `n = 1` >-
1779  rw[] >>
1780  rw[ulog_eqn, LOG2_LE]
1781QED
1782
1783(* Theorem: n < m ==> ulog n <= ulog m *)
1784(* Proof: by ulog_le *)
1785Theorem ulog_lt:
1786    !m n. n < m ==> ulog n <= ulog m
1787Proof
1788  rw[ulog_le]
1789QED
1790
1791(* Theorem: ulog (2 ** n) = n *)
1792(* Proof:
1793   Note 0 < 2 ** n             by EXP_POS, 0 < 2
1794   From 1 < 2                  by arithmetic
1795    ==> 2 ** n < 2 * 2 ** n    by LT_MULT_RCANCEL, 0 < 2 ** n
1796    Now 2 ** n <= 2 ** n       by LESS_EQ_REFL
1797   Thus ulog (2 ** n) = n      by ulog_unique
1798*)
1799Theorem ulog_2_exp:
1800    !n. ulog (2 ** n) = n
1801Proof
1802  rpt strip_tac >>
1803  `0 < 2 ** n` by rw[EXP_POS] >>
1804  `2 ** n < 2 * 2 ** n` by decide_tac >>
1805  `2 ** n <= 2 ** n` by decide_tac >>
1806  rw[ulog_unique]
1807QED
1808
1809(* Theorem: ulog n <= n *)
1810(* Proof:
1811   Note      n < 2 ** n          by X_LT_EXP_X
1812   Thus ulog n <= ulog (2 ** n)  by ulog_lt
1813     or ulog n <= n              by ulog_2_exp
1814*)
1815Theorem ulog_le_self:
1816    !n. ulog n <= n
1817Proof
1818  metis_tac[X_LT_EXP_X, ulog_lt, ulog_2_exp, DECIDE``1 < 2n``]
1819QED
1820
1821(* Theorem: ulog n = n <=> n = 0 *)
1822(* Proof:
1823   If part: ulog n = n ==> n = 0
1824      By contradiction, assume n <> 0
1825      Then ?k. n = SUC k            by num_CASES, n < 0
1826        so  2 ** SUC k < 2 * SUC k  by ulog_property
1827        or  2 * 2 ** k < 2 * SUC k  by EXP
1828       ==>      2 ** k < SUC k      by arithmetic
1829        or      2 ** k <= k         by arithmetic
1830      This contradicts k < 2 ** k   by X_LT_EXP_X, 0 < 2
1831   Only-if part: ulog 0 = 0
1832      This is true                  by ulog_0
1833*)
1834Theorem ulog_eq_self:
1835    !n. (ulog n = n) <=> (n = 0)
1836Proof
1837  rw[EQ_IMP_THM] >>
1838  spose_not_then strip_assume_tac >>
1839  `?k. n = SUC k` by metis_tac[num_CASES] >>
1840  `2 * (2 ** k) = 2 ** SUC k` by rw[EXP] >>
1841  `0 < n` by decide_tac >>
1842  `2 ** SUC k < 2 * SUC k` by metis_tac[ulog_property] >>
1843  `2 ** k <= k` by decide_tac >>
1844  `k < 2 ** k` by rw[X_LT_EXP_X] >>
1845  decide_tac
1846QED
1847
1848(* Theorem: 0 < n ==> ulog n < n *)
1849(* Proof:
1850   By contradiction, assume ~(ulog n < n).
1851   Then n <= ulog n      by ~(ulog n < n)
1852    But ulog n <= n      by ulog_le_self
1853    ==> ulog n = n       by arithmetic
1854     so n = 0            by ulog_eq_self
1855   This contradicts 0 < n.
1856*)
1857Theorem ulog_lt_self:
1858    !n. 0 < n ==> ulog n < n
1859Proof
1860  rpt strip_tac >>
1861  spose_not_then strip_assume_tac >>
1862  `ulog n <= n` by rw[ulog_le_self] >>
1863  `ulog n = n` by decide_tac >>
1864  `n = 0` by rw[GSYM ulog_eq_self] >>
1865  decide_tac
1866QED
1867
1868(* Theorem: (2 ** (ulog n) = n) <=> perfect_power n 2 *)
1869(* Proof:
1870   Using perfect_power_def,
1871   If part: 2 ** (ulog n) = n ==> ?e. n = 2 ** e
1872      True by taking e = ulog n.
1873   Only-if part: 2 ** ulog (2 ** e) = 2 ** e
1874      This is true by ulog_2_exp
1875*)
1876Theorem ulog_exp_exact:
1877    !n. (2 ** (ulog n) = n) <=> perfect_power n 2
1878Proof
1879  rw[perfect_power_def, EQ_IMP_THM] >-
1880  metis_tac[] >>
1881  rw[ulog_2_exp]
1882QED
1883
1884(* Theorem: ~(perfect_power n 2) ==> 2 ** ulog n <> n *)
1885(* Proof: by ulog_exp_exact. *)
1886Theorem ulog_exp_not_exact:
1887    !n. ~(perfect_power n 2) ==> 2 ** ulog n <> n
1888Proof
1889  rw[ulog_exp_exact]
1890QED
1891
1892(* Theorem: 0 < n /\ ~(perfect_power n 2) ==> n < 2 ** ulog n *)
1893(* Proof:
1894   Note n <= 2 ** ulog n    by ulog_property, 0 < n
1895    But n <> 2 ** ulog n    by ulog_exp_not_exact, ~(perfect_power n 2)
1896   Thus  n < 2 ** ulog n    by LESS_OR_EQ
1897*)
1898Theorem ulog_property_not_exact:
1899    !n. 0 < n /\ ~(perfect_power n 2) ==> n < 2 ** ulog n
1900Proof
1901  metis_tac[ulog_property, ulog_exp_not_exact, LESS_OR_EQ]
1902QED
1903
1904(* Theorem: 1 < n /\ ODD n ==> n < 2 ** ulog n *)
1905(* Proof:
1906   Note 0 < n /\ n <> 1        by 1 < n
1907   Thus n <= 2 ** ulog n       by ulog_property, 0 < n
1908    But ~(perfect_power n 2)   by perfect_power_2_odd, n <> 1
1909    ==> n <> 2 ** ulog n       by ulog_exp_not_exact, ~(perfect_power n 2)
1910   Thus n < 2 ** ulog n        by LESS_OR_EQ
1911*)
1912Theorem ulog_property_odd:
1913    !n. 1 < n /\ ODD n ==> n < 2 ** ulog n
1914Proof
1915  rpt strip_tac >>
1916  `0 < n /\ n <> 1` by decide_tac >>
1917  `n <= 2 ** ulog n` by metis_tac[ulog_property] >>
1918  `~(perfect_power n 2)` by metis_tac[perfect_power_2_odd] >>
1919  `2 ** ulog n <> n` by rw[ulog_exp_not_exact] >>
1920  decide_tac
1921QED
1922
1923(* Theorem: n <= 2 ** m ==> ulog n <= m *)
1924(* Proof:
1925      n <= 2 ** m
1926   ==> ulog n <= ulog (2 ** m)    by ulog_le
1927   ==> ulog n <= m                by ulog_2_exp
1928*)
1929Theorem exp_to_ulog:
1930    !m n. n <= 2 ** m ==> ulog n <= m
1931Proof
1932  metis_tac[ulog_le, ulog_2_exp]
1933QED
1934
1935(* Theorem: 1 < n ==> 0 < ulog n *)
1936(* Proof:
1937   Note 1 < n ==> n <> 0 /\ n <> 1     by arithmetic
1938     so ulog n <> 0                    by ulog_eq_0
1939     or 0 < ulog n                     by NOT_ZERO_LT_ZERO
1940*)
1941Theorem ulog_pos[simp]:
1942    !n. 1 < n ==> 0 < ulog n
1943Proof
1944  metis_tac[ulog_eq_0, NOT_ZERO, DECIDE``1 < n <=> n <> 0 /\ n <> 1``]
1945QED
1946
1947(* Theorem: 1 < n ==> 1 <= ulog n *)
1948(* Proof:
1949   Note  0 < ulog n      by ulog_pos
1950   Thus  1 <= ulog n     by arithmetic
1951*)
1952Theorem ulog_ge_1:
1953    !n. 1 < n ==> 1 <= ulog n
1954Proof
1955  metis_tac[ulog_pos, DECIDE``0 < n ==> 1 <= n``]
1956QED
1957
1958(* Theorem: 2 < n ==> 1 < (ulog n) ** 2 *)
1959(* Proof:
1960   Note 1 < n /\ n <> 2      by 2 < n
1961     so 0 < ulog n           by ulog_pos, 1 < n
1962    and ulog n <> 1          by ulog_eq_1, n <> 2
1963   Thus 1 < ulog n           by ulog n <> 0, ulog n <> 1
1964     so 1 < (ulog n) ** 2    by ONE_LT_EXP, 0 < 2
1965*)
1966Theorem ulog_sq_gt_1:
1967    !n. 2 < n ==> 1 < (ulog n) ** 2
1968Proof
1969  rpt strip_tac >>
1970  `1 < n /\ n <> 2` by decide_tac >>
1971  `0 < ulog n` by rw[] >>
1972  `ulog n <> 1` by rw[ulog_eq_1] >>
1973  `1 < ulog n` by decide_tac >>
1974  rw[ONE_LT_EXP]
1975QED
1976
1977(* Theorem: 1 < n ==> 4 <= (2 * ulog n) ** 2 *)
1978(* Proof:
1979   Note  0 < ulog n               by ulog_pos, 1 < n
1980   Thus  2 <= 2 * ulog n          by arithmetic
1981     or  4 <= (2 * ulog n) ** 2   by EXP_BASE_LE_MONO
1982*)
1983Theorem ulog_twice_sq:
1984    !n. 1 < n ==> 4 <= (2 * ulog n) ** 2
1985Proof
1986  rpt strip_tac >>
1987  `0 < ulog n` by rw[ulog_pos] >>
1988  `2 <= 2 * ulog n` by decide_tac >>
1989  `2 ** 2 <= (2 * ulog n) ** 2` by rw[EXP_BASE_LE_MONO] >>
1990  `2 ** 2 = 4` by rw[] >>
1991  decide_tac
1992QED
1993
1994(* Theorem: ulog n = if n = 0 then 0
1995                else if (perfect_power n 2) then (LOG2 n) else SUC (LOG2 n) *)
1996(* Proof:
1997   This is to show:
1998   (1) ulog 0 = 0, true            by ulog_0
1999   (2) perfect_power n 2 ==> ulog n = LOG2 n
2000       Note ?k. n = 2 ** k         by perfect_power_def
2001       Thus ulog n = k             by ulog_exp_exact
2002        and LOG2 n = k             by LOG_EXACT_EXP, 1 < 2
2003   (3) ~(perfect_power n 2) ==> ulog n = SUC (LOG2 n)
2004       Let m = SUC (LOG2 n).
2005       Then 2 ** m
2006          = 2 * 2 ** (LOG2 n)      by EXP
2007          <= 2 * n                 by TWO_EXP_LOG2_LE
2008       But n <> LOG2 n             by LOG2_EXACT_EXP, ~(perfect_power n 2)
2009       Thus 2 ** m < 2 * n         [1]
2010
2011       Also n < 2 ** m             by LOG2_PROPERTY
2012       Thus n <= 2 ** m,           [2]
2013       giving ulog n = m           by ulog_unique, [1] [2]
2014*)
2015Theorem ulog_alt:
2016    !n. ulog n = if n = 0 then 0
2017                else if (perfect_power n 2) then (LOG2 n) else SUC (LOG2 n)
2018Proof
2019  rw[] >-
2020  metis_tac[perfect_power_def, ulog_exp_exact, LOG_EXACT_EXP, DECIDE``1 < 2``] >>
2021  qabbrev_tac `m = SUC (LOG2 n)` >>
2022  (irule ulog_unique >> rpt conj_tac) >| [
2023    `2 ** m = 2 * 2 ** (LOG2 n)` by rw[EXP, Abbr`m`] >>
2024    `2 ** (LOG2 n) <= n` by rw[TWO_EXP_LOG2_LE] >>
2025    `2 ** (LOG2 n) <> n` by rw[LOG2_EXACT_EXP, GSYM perfect_power_def] >>
2026    decide_tac,
2027    `n < 2 ** m` by rw[LOG2_PROPERTY, Abbr`m`] >>
2028    decide_tac
2029  ]
2030QED
2031
2032(*
2033Thus, for 0 < n, (ulog n) and SUC (LOG2 n) differ only for (perfect_power n 2).
2034This means that replacing AKS bounds of SUC (LOG2 n) by (ulog n)
2035only affect calculations involving (perfect_power n 2),
2036which are irrelevant for primality testing !
2037However, in display, (ulog n) is better, while SUC (LOG2 n) is a bit ugly.
2038*)
2039
2040(* Theorem: 0 < n ==> (LOG2 n <= ulog n /\ ulog n <= 1 + LOG2 n) *)
2041(* Proof: by ulog_alt *)
2042Theorem ulog_LOG2:
2043    !n. 0 < n ==> (LOG2 n <= ulog n /\ ulog n <= 1 + LOG2 n)
2044Proof
2045  rw[ulog_alt]
2046QED
2047
2048(* Theorem: 0 < n ==> !m. perfect_power n m <=> ?k. k <= ulog n /\ (n = m ** k) *)
2049(* Proof: by perfect_power_bound_LOG2, ulog_LOG2 *)
2050Theorem perfect_power_bound_ulog:
2051    !n. 0 < n ==> !m. perfect_power n m <=> ?k. k <= ulog n /\ (n = m ** k)
2052Proof
2053  rw[EQ_IMP_THM] >| [
2054    `LOG2 n <= ulog n` by rw[ulog_LOG2] >>
2055    metis_tac[perfect_power_bound_LOG2, LESS_EQ_TRANS],
2056    metis_tac[perfect_power_def]
2057  ]
2058QED
2059
2060(* ------------------------------------------------------------------------- *)
2061(* Upper Log Theorems                                                        *)
2062(* ------------------------------------------------------------------------- *)
2063
2064(* Theorem: ulog (m * n) <= ulog m + ulog n *)
2065(* Proof:
2066   Let x = ulog (m * n), y = ulog m + ulog n.
2067   Note    m * n <= 2 ** x      < 2 * m * n      by ulog_thm
2068    and        m <= 2 ** ulog m < 2 * m          by ulog_thm
2069    and        n <= 2 ** ulog n < 2 * n          by ulog_thm
2070   Note that 2 ** ulog m * 2 ** ulog n = 2 ** y  by EXP_ADD
2071   Multiplying inequalities,
2072           m * n <= 2 ** y                 by LE_MONO_MULT2
2073                    2 ** y < 4 * m * n     by LT_MONO_MULT2
2074    The picture is:
2075           m * n  ....... 2 * m * n ....... 4 * m * n
2076                   2 ** x somewhere
2077                          2 ** y somewhere
2078    If 2 ** y < 2 * m * n,
2079       Then x = y                          by ulog_unique
2080    Otherwise,
2081       2 ** y is in the second range.
2082    Then    2 ** x < 2 ** y                since 2 ** x in the first
2083      or         x < y                     by EXP_BASE_LT_MONO
2084    Combining these two cases: x <= y.
2085*)
2086Theorem ulog_mult:
2087    !m n. ulog (m * n) <= ulog m + ulog n
2088Proof
2089  rpt strip_tac >>
2090  Cases_on `(m = 0) \/ (n = 0)` >-
2091  fs[] >>
2092  `m * n <> 0` by rw[] >>
2093  `0 < m /\ 0 < n /\ 0 < m * n` by decide_tac >>
2094  qabbrev_tac `x = ulog (m * n)` >>
2095  qabbrev_tac `y = ulog m + ulog n` >>
2096  `m * n <= 2 ** x /\ 2 ** x < TWICE (m * n)` by metis_tac[ulog_thm] >>
2097  `m * n <= 2 ** y /\ 2 ** y < (TWICE m) * (TWICE n)` by metis_tac[ulog_thm, LE_MONO_MULT2, LT_MONO_MULT2, EXP_ADD] >>
2098  Cases_on `2 ** y < TWICE (m * n)` >| [
2099    `y = x` by metis_tac[ulog_unique] >>
2100    decide_tac,
2101    `2 ** x < 2 ** y /\ 1 < 2` by decide_tac >>
2102    `x < y` by metis_tac[EXP_BASE_LT_MONO] >>
2103    decide_tac
2104  ]
2105QED
2106
2107(* Theorem: ulog (m ** n) <= n * ulog m *)
2108(* Proof:
2109   By induction on n.
2110   Base: ulog (m ** 0) <= 0 * ulog m
2111      LHS = ulog (m ** 0)
2112          = ulog 1            by EXP_0
2113          = 0                 by ulog_1
2114          <= 0 * ulog m       by MULT
2115          = RHS
2116   Step: ulog (m ** n) <= n * ulog m ==> ulog (m ** SUC n) <= SUC n * ulog m
2117      LHS = ulog (m ** SUC n)
2118          = ulog (m * m ** n)          by EXP
2119          <= ulog m + ulog (m ** n)    by ulog_mult
2120          <= ulog m + n * ulog m       by induction hypothesis
2121           = (1 + n) * ulog m          by RIGHT_ADD_DISTRIB
2122           = SUC n * ulog m            by ADD1, ADD_COMM
2123           = RHS
2124*)
2125Theorem ulog_exp:
2126    !m n. ulog (m ** n) <= n * ulog m
2127Proof
2128  rpt strip_tac >>
2129  Induct_on `n` >>
2130  rw[EXP_0] >>
2131  `ulog (m ** SUC n) <= ulog m + ulog (m ** n)` by rw[EXP, ulog_mult] >>
2132  `ulog m + ulog (m ** n) <= ulog m + n * ulog m` by rw[] >>
2133  `ulog m + n * ulog m = SUC n * ulog m` by rw[ADD1] >>
2134  decide_tac
2135QED
2136
2137(* Theorem: 0 < n /\ EVEN n ==> (ulog n = 1 + ulog (HALF n)) *)
2138(* Proof:
2139   Let k = HALF n.
2140   Then 0 < k                                      by HALF_EQ_0, EVEN n
2141    and EVEN n ==> n = TWICE k                     by EVEN_HALF
2142   Note        n <= 2 ** ulog n < 2 * n            by ulog_thm, by 0 < n
2143    and        k <= 2 ** ulog k < 2 * k            by ulog_thm, by 0 < k
2144    so     2 * k <= 2 * 2 ** ulog k < 2 * 2 * k    by multiplying 2
2145    or         n <= 2 ** (1 + ulog k) < 2 * n      by EXP
2146  Thus     ulog n = 1 + ulog k                     by ulog_unique
2147*)
2148Theorem ulog_even:
2149    !n. 0 < n /\ EVEN n ==> (ulog n = 1 + ulog (HALF n))
2150Proof
2151  rpt strip_tac >>
2152  qabbrev_tac `k = HALF n` >>
2153  `n = TWICE k` by rw[EVEN_HALF, Abbr`k`] >>
2154  `0 < k` by rw[Abbr`k`] >>
2155  `n <= 2 ** ulog n /\ 2 ** ulog n < 2 * n` by metis_tac[ulog_thm] >>
2156  `k <= 2 ** ulog k /\ 2 ** ulog k < 2 * k` by metis_tac[ulog_thm] >>
2157  `2 <> 0` by decide_tac >>
2158  `n <= 2 * 2 ** ulog k` by rw[LE_MULT_LCANCEL] >>
2159  `2 * 2 ** ulog k < 2 * n` by rw[LT_MULT_LCANCEL] >>
2160  `2 * 2 ** ulog k = 2 ** (1 + ulog k)` by metis_tac[EXP, ADD1, ADD_COMM] >>
2161  metis_tac[ulog_unique]
2162QED
2163
2164(* Theorem: 1 < n /\ ODD n ==> ulog (HALF n) + 1 <= ulog n *)
2165(* Proof:
2166   Let k = HALF n.
2167   Then 0 < k                                      by HALF_EQ_0, 1 < n
2168    and ODD n ==> n = TWICE k + 1                  by ODD_HALF
2169   Note        n <= 2 ** ulog n < 2 * n            by ulog_thm, by 0 < n
2170    and        k <= 2 ** ulog k < 2 * k            by ulog_thm, by 0 < k
2171    so     2 * k <= 2 * 2 ** ulog k < 2 * 2 * k    by multiplying 2
2172    or     (2 * k) <= 2 ** (1 + ulog k) < 2 * (2 * k)  by EXP
2173  Since    2 * k < n, so 2 * (2 * k) < 2 * n,
2174  the picture is:
2175           2 * k ... n ...... 2 * (2 * k) ... 2 * n
2176                       <---  2 ** ulog n ---->
2177                 <--- 2 ** (1 + ulog k) -->
2178  If n <= 2 ** (1 + ulog k), then ulog n = 1 + ulog k    by ulog_unique
2179  Otherwise, 2 ** (1 + ulog k) < 2 ** ulog n
2180         so         1 + ulog k < ulog n            by EXP_BASE_LT_MONO, 1 < 2
2181  Combining, 1 + ulog k <= ulog n.
2182*)
2183Theorem ulog_odd:
2184    !n. 1 < n /\ ODD n ==> ulog (HALF n) + 1 <= ulog n
2185Proof
2186  rpt strip_tac >>
2187  qabbrev_tac `k = HALF n` >>
2188  `(n <> 0) /\ (n <> 1)` by decide_tac >>
2189  `0 < n /\ 0 < k` by metis_tac[HALF_EQ_0, NOT_ZERO_LT_ZERO] >>
2190  `n = TWICE k + 1` by rw[ODD_HALF, Abbr`k`] >>
2191  `n <= 2 ** ulog n /\ 2 ** ulog n < 2 * n` by metis_tac[ulog_thm] >>
2192  `k <= 2 ** ulog k /\ 2 ** ulog k < 2 * k` by metis_tac[ulog_thm] >>
2193  `2 <> 0 /\ 1 < 2` by decide_tac >>
2194  `2 * k <= 2 * 2 ** ulog k` by rw[LE_MULT_LCANCEL] >>
2195  `2 * 2 ** ulog k < 2 * (2 * k)` by rw[LT_MULT_LCANCEL] >>
2196  `2 * 2 ** ulog k = 2 ** (1 + ulog k)` by metis_tac[EXP, ADD1, ADD_COMM] >>
2197  Cases_on `n <= 2 ** (1 + ulog k)` >| [
2198    `2 * k < n` by decide_tac >>
2199    `2 * (2 * k) < 2 * n` by rw[LT_MULT_LCANCEL] >>
2200    `2 ** (1 + ulog k) < TWICE n` by decide_tac >>
2201    `1 + ulog k = ulog n` by metis_tac[ulog_unique] >>
2202    decide_tac,
2203    `2 ** (1 + ulog k) < 2 ** ulog n` by decide_tac >>
2204    `1 + ulog k < ulog n` by metis_tac[EXP_BASE_LT_MONO] >>
2205    decide_tac
2206  ]
2207QED
2208
2209(*
2210EVAL ``let n = 13 in [ulog (HALF n) + 1; ulog n]``;
2211|- (let n = 13 in [ulog (HALF n) + 1; ulog n]) = [4; 4]:
2212|- (let n = 17 in [ulog (HALF n) + 1; ulog n]) = [4; 5]:
2213*)
2214
2215(* Theorem: 1 < n ==> ulog (HALF n) + 1 <= ulog n *)
2216(* Proof:
2217   Note 1 < n ==> 0 < n   by arithmetic
2218   If EVEN n, true        by ulog_even, 0 < n
2219   If ODD n, true         by ulog_odd, 1 < n, ODD_EVEN.
2220*)
2221Theorem ulog_half:
2222    !n. 1 < n ==> ulog (HALF n) + 1 <= ulog n
2223Proof
2224  rpt strip_tac >>
2225  Cases_on `EVEN n` >-
2226  rw[ulog_even] >>
2227  rw[ODD_EVEN, ulog_odd]
2228QED
2229
2230(* Theorem: SQRT n <= 2 ** (ulog n) *)
2231(* Proof:
2232   Note      n <= 2 ** ulog n     by ulog_property
2233    and SQRT n <= n               by SQRT_LE_SELF
2234   Thus SQRT n <= 2 ** ulog n     by LESS_EQ_TRANS
2235     or SQRT n <=
2236*)
2237Theorem sqrt_upper:
2238    !n. SQRT n <= 2 ** (ulog n)
2239Proof
2240  rpt strip_tac >>
2241  Cases_on `n = 0` >-
2242  rw[] >>
2243  `n <= 2 ** ulog n` by rw[ulog_property] >>
2244  `SQRT n <= n` by rw[SQRT_LE_SELF] >>
2245  decide_tac
2246QED
2247
2248(* ------------------------------------------------------------------------- *)
2249(* Power Free up to a limit                                                  *)
2250(* ------------------------------------------------------------------------- *)
2251
2252(* Define a power free property of a number *)
2253Definition power_free_upto_def:
2254    power_free_upto n k <=> !j. 1 < j /\ j <= k ==> (ROOT j n) ** j <> n
2255End
2256(* make this an infix relation. *)
2257val _ = set_fixity "power_free_upto" (Infix(NONASSOC, 450)); (* same as relation *)
2258
2259(* Theorem: (n power_free_upto 0) = T *)
2260(* Proof: by power_free_upto_def, no counter-example. *)
2261Theorem power_free_upto_0:
2262    !n. (n power_free_upto 0) = T
2263Proof
2264  rw[power_free_upto_def]
2265QED
2266
2267(* Theorem: (n power_free_upto 1) = T *)
2268(* Proof: by power_free_upto_def, no counter-example. *)
2269Theorem power_free_upto_1:
2270    !n. (n power_free_upto 1) = T
2271Proof
2272  rw[power_free_upto_def]
2273QED
2274
2275(* Theorem: 0 < k /\ (n power_free_upto k) ==>
2276            ((n power_free_upto (k + 1)) <=> ROOT (k + 1) n ** (k + 1) <> n) *)
2277(* Proof: by power_free_upto_def *)
2278Theorem power_free_upto_suc:
2279    !n k. 0 < k /\ (n power_free_upto k) ==>
2280         ((n power_free_upto (k + 1)) <=> ROOT (k + 1) n ** (k + 1) <> n)
2281Proof
2282  rw[power_free_upto_def] >>
2283  rw[EQ_IMP_THM] >>
2284  metis_tac[LESS_OR_EQ, DECIDE``k < n + 1 ==> k <= n``]
2285QED
2286
2287(* Theorem: LOG2 n <= b ==> (power_free n <=> (1 < n /\ n power_free_upto b)) *)
2288(* Proof:
2289   If part: LOG2 n <= b /\ power_free n ==> 1 < n /\ n power_free_upto b
2290      (1) 1 < n,
2291          By contradiction, suppose n <= 1.
2292          Then n = 0, but power_free 0 = F      by power_free_0
2293            or n = 1, but power_free 1 = F      by power_free_1
2294      (2) n power_free_upto b,
2295          By power_free_upto_def, this is to show:
2296             1 < j /\ j <= b ==> ROOT j n ** j <> n
2297          By contradiction, suppose ROOT j n ** j = n.
2298          Then n = m ** j   where m = ROOT j n, with j <> 1.
2299          This contradicts power_free n         by power_free_def
2300
2301   Only-if part: 1 < n /\ LOG2 n <= b /\ n power_free_upto b ==> power_free n
2302      By contradiction, suppose ~(power_free n).
2303      Then ?e. n = m ** e  with n = m ==> e <> 1   by power_free_def
2304       ==> perfect_power n m                    by perfect_power_def
2305      Thus ?k. k <= LOG2 n /\ (n = m ** k)      by perfect_power_bound_LOG2, 0 < n
2306       Now k <> 0                               by EXP_0, n <> 1
2307        so m = ROOT k n                         by ROOT_FROM_POWER, k <> 0
2308
2309      Claim: k <> 1
2310      Proof: Note m <> 0                        by ROOT_EQ_0, n <> 0
2311              and m <> 1                        by EXP_1, k <> 0, n <> 1
2312              ==> 1 < m                         by m <> 0, m <> 1
2313             Thus n = m ** e = m ** k ==> k = e by EXP_BASE_INJECTIVE
2314              But e <> 1
2315                  since e = 1 ==> n <> m,       by n = m ==> e <> 1
2316                    yet n = m ** 1 ==> n = m    by EXP_1
2317             Since k = e, k <> 1.
2318
2319      Therefore 1 < k                           by k <> 0, k <> 1
2320      and k <= LOG2 n /\ LOG2 n <= b ==> k <= b by arithmetic
2321      With 1 < k /\ k <= b /\ m = ROOT k n /\ m ** k = n,
2322      These will give a contradiction           by power_free_upto_def
2323*)
2324Theorem power_free_check_upto:
2325    !n b. LOG2 n <= b ==> (power_free n <=> (1 < n /\ n power_free_upto b))
2326Proof
2327  rw[EQ_IMP_THM] >| [
2328    spose_not_then strip_assume_tac >>
2329    `(n = 0) \/ (n = 1)` by decide_tac >-
2330    fs[power_free_0] >>
2331    fs[power_free_1],
2332    rw[power_free_upto_def] >>
2333    spose_not_then strip_assume_tac >>
2334    `j <> 1` by decide_tac >>
2335    metis_tac[power_free_def],
2336    simp[power_free_def] >>
2337    spose_not_then strip_assume_tac >>
2338    `perfect_power n m` by metis_tac[perfect_power_def] >>
2339    `0 < n /\ n <> 1` by decide_tac >>
2340    `?k. k <= LOG2 n /\ (n = m ** k)` by rw[GSYM perfect_power_bound_LOG2] >>
2341    `k <> 0` by metis_tac[EXP_0] >>
2342    `m = ROOT k n` by rw[ROOT_FROM_POWER] >>
2343    `k <> 1` by
2344  (`m <> 0` by rw[ROOT_EQ_0] >>
2345    `m <> 1 /\ e <> 1` by metis_tac[EXP_1] >>
2346    `1 < m` by decide_tac >>
2347    metis_tac[EXP_BASE_INJECTIVE]) >>
2348    `1 < k` by decide_tac >>
2349    `k <= b` by decide_tac >>
2350    metis_tac[power_free_upto_def]
2351  ]
2352QED
2353
2354(* Theorem: power_free n <=> (1 < n /\ n power_free_upto LOG2 n) *)
2355(* Proof: by power_free_check_upto, LOG2 n <= LOG2 n *)
2356Theorem power_free_check_upto_LOG2:
2357    !n. power_free n <=> (1 < n /\ n power_free_upto LOG2 n)
2358Proof
2359  rw[power_free_check_upto]
2360QED
2361
2362(* Theorem: power_free n <=> (1 < n /\ n power_free_upto ulog n) *)
2363(* Proof:
2364   If n = 0,
2365      LHS = power_free 0 = F        by power_free_0
2366          = RHS, as 1 < 0 = F
2367   If n <> 0,
2368      Then LOG2 n <= ulog n         by ulog_LOG2, 0 < n
2369      The result follows            by power_free_check_upto
2370*)
2371Theorem power_free_check_upto_ulog:
2372    !n. power_free n <=> (1 < n /\ n power_free_upto ulog n)
2373Proof
2374  rpt strip_tac >>
2375  Cases_on `n = 0` >-
2376  rw[power_free_0] >>
2377  rw[power_free_check_upto, ulog_LOG2]
2378QED
2379
2380(* Theorem: power_free 2 *)
2381(* Proof:
2382       power_free 2
2383   <=> 2 power_free_upto (LOG2 2)   by power_free_check_upto_LOG2
2384   <=> 2 power_free_upto 1          by LOG2_2
2385   <=> T                            by power_free_upto_1
2386*)
2387Theorem power_free_2:
2388    power_free 2
2389Proof
2390  rw[power_free_check_upto_LOG2, power_free_upto_1]
2391QED
2392
2393(* Theorem: power_free 3 *)
2394(* Proof:
2395   Note 3 power_free_upto 1         by power_free_upto_1
2396       power_free 3
2397   <=> 3 power_free_upto (ulog 3)   by power_free_check_upto_ulog
2398   <=> 3 power_free_upto 2          by evaluation
2399   <=> ROOT 2 3 ** 2 <> 3           by power_free_upto_suc, 0 < 1
2400   <=> T                            by evaluation
2401*)
2402Theorem power_free_3:
2403    power_free 3
2404Proof
2405  `3 power_free_upto 1` by rw[power_free_upto_1] >>
2406  `ulog 3 = 2` by EVAL_TAC >>
2407  `ROOT 2 3 ** 2 <> 3` by EVAL_TAC >>
2408  `power_free 3 <=> 3 power_free_upto 2` by rw[power_free_check_upto_ulog] >>
2409  metis_tac[power_free_upto_suc, DECIDE``0 < 1 /\ (1 + 1 = 2)``]
2410QED
2411
2412(* Define a power free test, based on (ulog n), for computation. *)
2413Definition power_free_test_def:
2414    power_free_test n <=>(1 < n /\ n power_free_upto (ulog n))
2415End
2416
2417(* Theorem: power_free_test n = power_free n *)
2418(* Proof: by power_free_test_def, power_free_check_upto_ulog *)
2419Theorem power_free_test_eqn:
2420    !n. power_free_test n = power_free n
2421Proof
2422  rw[power_free_test_def, power_free_check_upto_ulog]
2423QED
2424
2425(* Theorem: power_free n <=>
2426       (1 < n /\ !j. 1 < j /\ j <= (LOG2 n) ==> ROOT j n ** j <> n) *)
2427(* Proof: by power_free_check_upto_ulog, power_free_upto_def *)
2428Theorem power_free_test_upto_LOG2:
2429    !n. power_free n <=>
2430       (1 < n /\ !j. 1 < j /\ j <= (LOG2 n) ==> ROOT j n ** j <> n)
2431Proof
2432  rw[power_free_check_upto_LOG2, power_free_upto_def]
2433QED
2434
2435(* Theorem: power_free n <=>
2436       (1 < n /\ !j. 1 < j /\ j <= (ulog n) ==> ROOT j n ** j <> n) *)
2437(* Proof: by power_free_check_upto_ulog, power_free_upto_def *)
2438Theorem power_free_test_upto_ulog:
2439    !n. power_free n <=>
2440       (1 < n /\ !j. 1 < j /\ j <= (ulog n) ==> ROOT j n ** j <> n)
2441Proof
2442  rw[power_free_check_upto_ulog, power_free_upto_def]
2443QED
2444
2445(* ------------------------------------------------------------------------- *)
2446(* Another Characterisation of Power Free                                    *)
2447(* ------------------------------------------------------------------------- *)
2448
2449(* Define power index of n, the highest index of n in power form by descending from k *)
2450Definition power_index_def:
2451    power_index n k <=>
2452        if k <= 1 then 1
2453        else if (ROOT k n) ** k = n then k
2454        else power_index n (k - 1)
2455End
2456
2457(* Theorem: power_index n 0 = 1 *)
2458(* Proof: by power_index_def *)
2459Theorem power_index_0:
2460    !n. power_index n 0 = 1
2461Proof
2462  rw[Once power_index_def]
2463QED
2464
2465(* Theorem: power_index n 1 = 1 *)
2466(* Proof: by power_index_def *)
2467Theorem power_index_1:
2468    !n. power_index n 1 = 1
2469Proof
2470  rw[Once power_index_def]
2471QED
2472
2473(* Theorem: (ROOT (power_index n k) n) ** (power_index n k) = n *)
2474(* Proof:
2475   By induction on k.
2476   Base: ROOT (power_index n 0) n ** power_index n 0 = n
2477        ROOT (power_index n 0) n ** power_index n 0
2478      = (ROOT 1 n) ** 1          by power_index_0
2479      = n ** 1                   by ROOT_1
2480      = n                        by EXP_1
2481   Step: ROOT (power_index n k) n ** power_index n k = n ==>
2482         ROOT (power_index n (SUC k)) n ** power_index n (SUC k) = n
2483      If k = 0,
2484        ROOT (power_index n (SUC 0)) n ** power_index n (SUC 0)
2485      = ROOT (power_index n 1) n ** power_index n 1     by ONE
2486      = (ROOT 1 n) ** 1                                 by power_index_1
2487      = n ** 1                                          by ROOT_1
2488      = n                                               by EXP_1
2489      If k <> 0,
2490         Then ~(SUC k <= 1)                                     by 0 < k
2491         If ROOT (SUC k) n ** SUC k = n,
2492            Then power_index n (SUC k) = SUC k                  by power_index_def
2493              so ROOT (power_index n (SUC k)) n ** power_index n (SUC k)
2494               = ROOT (SUC k) n ** SUC k                        by above
2495               = n                                              by condition
2496         If ROOT (SUC k) n ** SUC k <> n,
2497            Then power_index n (SUC k) = power_index n k        by power_index_def
2498              so ROOT (power_index n (SUC k)) n ** power_index n (SUC k)
2499               = ROOT (power_index n k) n ** power_index n k    by above
2500               = n                                              by induction hypothesis
2501*)
2502Theorem power_index_eqn:
2503    !n k. (ROOT (power_index n k) n) ** (power_index n k) = n
2504Proof
2505  rpt strip_tac >>
2506  Induct_on `k` >-
2507  rw[power_index_0] >>
2508  Cases_on `k = 0` >-
2509  rw[power_index_1] >>
2510  `~(SUC k <= 1)` by decide_tac >>
2511  rw_tac std_ss[Once power_index_def] >-
2512  rw[Once power_index_def] >>
2513  `power_index n (SUC k) = power_index n k` by rw[Once power_index_def] >>
2514  rw[]
2515QED
2516
2517(* Theorem: perfect_power n (ROOT (power_index n k) n) *)
2518(* Proof:
2519   Let m = ROOT (power_index n k) n.
2520   By perfect_power_def, this is to show:
2521      ?e. n = m ** e
2522   Take e = power_index n k.
2523     m ** e
2524   = (ROOT (power_index n k) n) ** (power_index n k)     by root_compute_eqn
2525   = n                                                   by power_index_eqn
2526*)
2527Theorem power_index_root:
2528    !n k. perfect_power n (ROOT (power_index n k) n)
2529Proof
2530  metis_tac[perfect_power_def, power_index_eqn]
2531QED
2532
2533(* Theorem: power_index 1 k = if k = 0 then 1 else k *)
2534(* Proof:
2535   If k = 0,
2536      power_index 1 0 = 1               by power_index_0
2537   If k <> 0, then 0 < k.
2538      If k = 1,
2539         Then power_index 1 1 = 1 = k   by power_index_1
2540      If k <> 1, 1 < k.
2541         Note ROOT k 1 = 1              by ROOT_OF_1, 0 < k.
2542           so power_index 1 k = k       by power_index_def
2543*)
2544Theorem power_index_of_1:
2545    !k. power_index 1 k = if k = 0 then 1 else k
2546Proof
2547  rw[Once power_index_def]
2548QED
2549
2550(* Theorem: 0 < k /\ ((ROOT k n) ** k = n) ==> (power_index n k = k) *)
2551(* Proof:
2552   If k = 1,
2553      True since power_index n 1 = 1      by power_index_1
2554   If k <> 1, then 1 < k                  by 0 < k
2555      True                                by power_index_def
2556*)
2557Theorem power_index_exact_root:
2558    !n k. 0 < k /\ ((ROOT k n) ** k = n) ==> (power_index n k = k)
2559Proof
2560  rpt strip_tac >>
2561  Cases_on `k = 1` >-
2562  rw[power_index_1] >>
2563  `1 < k` by decide_tac >>
2564  rw[Once power_index_def]
2565QED
2566
2567(* Theorem: (ROOT k n) ** k <> n ==> (power_index n k = power_index n (k - 1)) *)
2568(* Proof:
2569   If k = 0,
2570      Then k = k - 1                  by k = 0
2571      Thus true trivially.
2572   If k = 1,
2573      Note power_index n 1 = 1        by power_index_1
2574       and power_index n 0 = 1        by power_index_0
2575      Thus true.
2576   If k <> 0 /\ k <> 1, then 1 < k    by arithmetic
2577      True                            by power_index_def
2578*)
2579Theorem power_index_not_exact_root:
2580    !n k. (ROOT k n) ** k <> n ==> (power_index n k = power_index n (k - 1))
2581Proof
2582  rpt strip_tac >>
2583  Cases_on `k = 0` >| [
2584    `k = k - 1` by decide_tac >>
2585    rw[],
2586    Cases_on `k = 1` >-
2587    rw[power_index_0, power_index_1] >>
2588    `1 < k` by decide_tac >>
2589    rw[Once power_index_def]
2590  ]
2591QED
2592
2593(* Theorem: k <= m /\ (!j. k < j /\ j <= m ==> (ROOT j n) ** j <> n) ==> (power_index n m = power_index n k) *)
2594(* Proof:
2595   By induction on (m - k).
2596   Base: k <= m /\ 0 = m - k ==> power_index n m = power_index n k
2597      Note m <= k            by 0 = m - k
2598        so m = k             by k <= m
2599      Thus true trivially.
2600   Step: !m'. v = m' - k /\ k <= m' /\ ... ==> power_index n m' = power_index n k ==>
2601         SUC v = m - k ==> power_index n m = power_index n k
2602      If m = k, true trivially.
2603      If m <> k, then k < m.
2604         Thus k <= (m - 1), and v = (m - 1) - k.
2605         Note ROOT m n ** m <> n          by j = m in implication
2606         Thus power_index n m
2607            = power_index n (m - 1)       by power_index_not_exact_root
2608            = power_index n k             by induction hypothesis, m' = m - 1.
2609*)
2610Theorem power_index_no_exact_roots:
2611    !m n k. k <= m /\ (!j. k < j /\ j <= m ==> (ROOT j n) ** j <> n) ==> (power_index n m = power_index n k)
2612Proof
2613  rpt strip_tac >>
2614  Induct_on `m - k` >| [
2615    rpt strip_tac >>
2616    `m = k` by decide_tac >>
2617    rw[],
2618    rpt strip_tac >>
2619    Cases_on `m = k` >-
2620    rw[] >>
2621    `ROOT m n ** m <> n` by rw[] >>
2622    `k <= m - 1` by decide_tac >>
2623    `power_index n (m - 1) = power_index n k` by rw[] >>
2624    rw[power_index_not_exact_root]
2625  ]
2626QED
2627
2628(* The theorem power_index_equal requires a detective-style proof, based on these lemma. *)
2629
2630(* Theorem: k <= m /\ ((ROOT k n) ** k = n) ==> k <= power_index n m *)
2631(* Proof:
2632   If k = 0,
2633      Then n = 1                          by EXP
2634      If m = 0,
2635         Then power_index 1 0 = 1         by power_index_of_1
2636          But k <= 0, so k = 0            by arithmetic
2637         Hence k <= power_index n m
2638      If m <> 0,
2639         Then power_index 1 m = m         by power_index_of_1
2640         Hence k <= power_index 1 m = m   by given
2641
2642   If k <> 0, then 0 < k.
2643      Let s = {j | j <= m /\ ((ROOT j n) ** j = n)}
2644      Then s SUBSET (count (SUC m))       by SUBSET_DEF
2645       ==> FINITE s                       by SUBSET_FINITE, FINITE_COUNT
2646      Note k IN s                         by given
2647       ==> s <> {}                        by MEMBER_NOT_EMPTY
2648      Let t = MAX_SET s.
2649
2650      Claim: !x. t < x /\ x <= m ==> (ROOT x n) ** x <> n
2651      Proof: By contradiction, suppose (ROOT x n) ** x = n
2652             Then x IN s, so x <= t       by MAX_SET_PROPERTY
2653             This contradicts t < x.
2654
2655      Note t IN s                              by MAX_SET_IN_SET
2656        so t <= m /\ (ROOT t n) ** t = n       by above
2657      Thus power_index n m = power_index n t   by power_index_no_exact_roots, t <= m
2658       and power_index n t = t                 by power_index_exact_root, (ROOT t n) ** t = n
2659       But k <= t                              by MAX_SET_PROPERTY
2660      Thus k <= t = power_index n m
2661*)
2662Theorem power_index_lower:
2663    !m n k. k <= m /\ ((ROOT k n) ** k = n) ==> k <= power_index n m
2664Proof
2665  rpt strip_tac >>
2666  Cases_on `k = 0` >| [
2667    `n = 1` by fs[EXP] >>
2668    rw[power_index_of_1],
2669    `0 < k` by decide_tac >>
2670    qabbrev_tac `s = {j | j <= m /\ ((ROOT j n) ** j = n)}` >>
2671    `!j. j IN s <=> j <= m /\ ((ROOT j n) ** j = n)` by rw[Abbr`s`] >>
2672    `s SUBSET (count (SUC m))` by rw[SUBSET_DEF] >>
2673    `FINITE s` by metis_tac[SUBSET_FINITE, FINITE_COUNT] >>
2674    `k IN s` by rw[] >>
2675    `s <> {}` by metis_tac[MEMBER_NOT_EMPTY] >>
2676    qabbrev_tac `t = MAX_SET s` >>
2677    `!x. t < x /\ x <= m ==> (ROOT x n) ** x <> n` by
2678  (spose_not_then strip_assume_tac >>
2679    `x IN s` by rw[] >>
2680    `x <= t` by rw[MAX_SET_PROPERTY, Abbr`t`] >>
2681    decide_tac) >>
2682    `t IN s` by rw[MAX_SET_IN_SET, Abbr`t`] >>
2683    `power_index n m = power_index n t` by metis_tac[power_index_no_exact_roots] >>
2684    `k <= t` by rw[MAX_SET_PROPERTY, Abbr`t`] >>
2685    `(ROOT t n) ** t = n` by metis_tac[] >>
2686    `power_index n t = t` by rw[power_index_exact_root] >>
2687    decide_tac
2688  ]
2689QED
2690
2691(* Theorem: 0 < power_index n k *)
2692(* Proof:
2693   If k = 0,
2694      True since power_index n 0 = 1         by power_index_0
2695   If k <> 0,
2696      Then 1 <= k.
2697      Note (ROOT 1 n) ** 1 = n ** 1 = n      by ROOT_1, EXP_1
2698      Thus 1 <= power_index n k              by power_index_lower
2699        or 0 < power_index n k
2700*)
2701Theorem power_index_pos:
2702    !n k. 0 < power_index n k
2703Proof
2704  rpt strip_tac >>
2705  Cases_on `k = 0` >-
2706  rw[power_index_0] >>
2707  `1 <= power_index n k` by rw[power_index_lower, EXP_1] >>
2708  decide_tac
2709QED
2710
2711(* Theorem: 0 < k ==> power_index n k <= k *)
2712(* Proof:
2713   By induction on k.
2714   Base: 0 < 0 ==> power_index n 0 <= 0
2715      True by 0 < 0 = F.
2716   Step: 0 < k ==> power_index n k <= k ==>
2717         0 < SUC k ==> power_index n (SUC k) <= SUC k
2718      If k = 0,
2719         Then SUC k = 1                   by ONE
2720         True since power_index n 1 = 1   by power_index_1
2721      If k <> 0,
2722         Let m = SUC k, or k = m - 1.
2723         Then 1 < m                       by arithmetic
2724         If (ROOT m n) ** m = n,
2725            Then power_index n m
2726               = m <= m                   by power_index_exact_root
2727         If (ROOT m n) ** m <> n,
2728            Then power_index n m
2729               = power_index n (m - 1)    by power_index_not_exact_root
2730               = power_index n k          by m - 1 = k
2731               <= k                       by induction hypothesis
2732             But k < SUC k = m            by LESS_SUC
2733            Thus power_index n m < m      by LESS_EQ_LESS_TRANS
2734              or power_index n m <= m     by LESS_IMP_LESS_OR_EQ
2735*)
2736Theorem power_index_upper:
2737    !n k. 0 < k ==> power_index n k <= k
2738Proof
2739  strip_tac >>
2740  Induct >-
2741  rw[] >>
2742  rpt strip_tac >>
2743  Cases_on `k = 0` >-
2744  rw[power_index_1] >>
2745  `1 < SUC k` by decide_tac >>
2746  qabbrev_tac `m = SUC k` >>
2747  Cases_on `(ROOT m n) ** m = n` >-
2748  rw[power_index_exact_root] >>
2749  rw[power_index_not_exact_root, Abbr`m`]
2750QED
2751
2752(* Theorem: 0 < k /\ k <= m ==>
2753            ((power_index n m = power_index n k) <=> (!j. k < j /\ j <= m ==> (ROOT j n) ** j <> n)) *)
2754(* Proof:
2755   If part: 0 < k /\ k <= m /\ power_index n m = power_index n k /\ k < j /\ j <= m ==> ROOT j n ** j <> n
2756      By contradiction, suppose ROOT j n ** j = n.
2757      Then j <= power_index n m      by power_index_lower
2758      But       power_index n k <= k by power_index_upper, 0 < k
2759      Thus j <= k                    by LESS_EQ_TRANS
2760      This contradicts k < j.
2761   Only-if part: 0 < k /\ k <= m /\ !j. k < j /\ j <= m ==> ROOT j n ** j <> n ==>
2762                 power_index n m = power_index n k
2763      True by power_index_no_exact_roots
2764*)
2765Theorem power_index_equal:
2766    !m n k. 0 < k /\ k <= m ==>
2767    ((power_index n m = power_index n k) <=> (!j. k < j /\ j <= m ==> (ROOT j n) ** j <> n))
2768Proof
2769  rpt strip_tac >>
2770  rw[EQ_IMP_THM] >| [
2771    spose_not_then strip_assume_tac >>
2772    `j <= power_index n m` by rw[power_index_lower] >>
2773    `power_index n k <= k` by rw[power_index_upper] >>
2774    decide_tac,
2775    rw[power_index_no_exact_roots]
2776  ]
2777QED
2778
2779(* Theorem: (power_index n m = k) ==> !j. k < j /\ j <= m ==> (ROOT j n) ** j <> n *)
2780(* Proof:
2781   By contradiction, suppose k < j /\ j <= m /\ (ROOT j n) ** j = n.
2782   Then j <= power_index n m                   by power_index_lower
2783   This contradicts power_index n m = k < j    by given
2784*)
2785Theorem power_index_property:
2786    !m n k. (power_index n m = k) ==> !j. k < j /\ j <= m ==> (ROOT j n) ** j <> n
2787Proof
2788  spose_not_then strip_assume_tac >>
2789  `j <= power_index n m` by rw[power_index_lower] >>
2790  decide_tac
2791QED
2792
2793(* Theorem: power_free n <=> (1 < n) /\ (power_index n (LOG2 n) = 1) *)
2794(* Proof:
2795   By power_free_check_upto_LOG2, power_free_upto_def, this is to show:
2796      1 < n /\ (!j. 1 < j /\ j <= LOG2 n ==> ROOT j n ** j <> n) <=>
2797      1 < n /\ (power_index n (LOG2 n) = 1)
2798   If part:
2799      Note 0 < LOG2 n              by LOG2_POS, 1 < n
2800           power_index n (LOG2 n)
2801         = power_index n 1         by power_index_no_exact_roots, 1 <= LOG2 n
2802         = 1                       by power_index_1
2803   Only-if part, true              by power_index_property
2804*)
2805Theorem power_free_by_power_index_LOG2:
2806    !n. power_free n <=> (1 < n) /\ (power_index n (LOG2 n) = 1)
2807Proof
2808  rw[power_free_check_upto_LOG2, power_free_upto_def] >>
2809  rw[EQ_IMP_THM] >| [
2810    `0 < LOG2 n` by rw[] >>
2811    `1 <= LOG2 n` by decide_tac >>
2812    `power_index n (LOG2 n) = power_index n 1` by rw[power_index_no_exact_roots] >>
2813    rw[power_index_1],
2814    metis_tac[power_index_property]
2815  ]
2816QED
2817
2818(* Theorem: power_free n <=> (1 < n) /\ (power_index n (ulog n) = 1) *)
2819(* Proof:
2820   By power_free_check_upto_ulog, power_free_upto_def, this is to show:
2821      1 < n /\ (!j. 1 < j /\ j <= ulog n ==> ROOT j n ** j <> n) <=>
2822      1 < n /\ (power_index n (ulog n) = 1)
2823   If part:
2824      Note 0 < ulog n              by ulog_POS, 1 < n
2825           power_index n (ulog n)
2826         = power_index n 1         by power_index_no_exact_roots, 1 <= ulog n
2827         = 1                       by power_index_1
2828   Only-if part, true              by power_index_property
2829*)
2830Theorem power_free_by_power_index_ulog:
2831    !n. power_free n <=> (1 < n) /\ (power_index n (ulog n) = 1)
2832Proof
2833  rw[power_free_check_upto_ulog, power_free_upto_def] >>
2834  rw[EQ_IMP_THM] >| [
2835    `0 < ulog n` by rw[] >>
2836    `1 <= ulog n` by decide_tac >>
2837    `power_index n (ulog n) = power_index n 1` by rw[power_index_no_exact_roots] >>
2838    rw[power_index_1],
2839    metis_tac[power_index_property]
2840  ]
2841QED
2842
2843(* ------------------------------------------------------------------------- *)
2844(* Prime Power Documentation                                                 *)
2845(* ------------------------------------------------------------------------- *)
2846(* Overloading:
2847   ppidx n                     = prime_power_index p n
2848   common_prime_divisors m n   = (prime_divisors m) INTER (prime_divisors n)
2849   total_prime_divisors m n    = (prime_divisors m) UNION (prime_divisors n)
2850   park_on m n                 = {p | p IN common_prime_divisors m n /\ ppidx m <= ppidx n}
2851   park_off m n                = {p | p IN common_prime_divisors m n /\ ppidx n < ppidx m}
2852   park m n                    = PROD_SET (IMAGE (\p. p ** ppidx m) (park_on m n))
2853*)
2854(* Definitions and Theorems (# are exported):
2855
2856   Helper Theorem:
2857   self_to_log_index_member       |- !n x. MEM x [1 .. n] ==> MEM (x ** LOG x n) [1 .. n]
2858
2859   Prime Power or Coprime Factors:
2860   prime_power_or_coprime_factors    |- !n. 1 < n ==> (?p k. 0 < k /\ prime p /\ (n = p ** k)) \/
2861                                        ?a b. (n = a * b) /\ coprime a b /\ 1 < a /\ 1 < b /\ a < n /\ b < n
2862   non_prime_power_coprime_factors   |- !n. 1 < n /\ ~(?p k. 0 < k /\ prime p /\ (n = p ** k)) ==>
2863                                        ?a b. (n = a * b) /\ coprime a b /\ 1 < a /\ a < n /\ 1 < b /\ b < n
2864   pairwise_coprime_for_prime_powers |- !s f. s SUBSET prime ==> PAIRWISE_COPRIME (IMAGE (\p. p ** f p) s)
2865
2866   Prime Power Index:
2867   prime_power_index_exists       |- !n p. 0 < n /\ prime p ==> ?m. p ** m divides n /\ coprime p (n DIV p ** m)
2868   prime_power_index_def          |- !p n. 0 < n /\ prime p ==>
2869                                           p ** ppidx n divides n /\ coprime p (n DIV p ** ppidx n)
2870   prime_power_factor_divides     |- !n p. prime p ==> p ** ppidx n divides n
2871   prime_power_cofactor_coprime   |- !n p. 0 < n /\ prime p ==> coprime p (n DIV p ** ppidx n)
2872   prime_power_eqn                |- !n p. 0 < n /\ prime p ==> (n = p ** ppidx n * (n DIV p ** ppidx n))
2873   prime_power_divisibility       |- !n p. 0 < n /\ prime p ==> !k. p ** k divides n <=> k <= ppidx n
2874   prime_power_index_maximal      |- !n p. 0 < n /\ prime p ==> !k. k > ppidx n ==> ~(p ** k divides n)
2875   prime_power_index_of_divisor   |- !m n. 0 < n /\ m divides n ==> !p. prime p ==> ppidx m <= ppidx n
2876   prime_power_index_test         |- !n p. 0 < n /\ prime p ==>
2877                                     !k. (k = ppidx n) <=> ?q. (n = p ** k * q) /\ coprime p q:
2878   prime_power_index_1            |- !p. prime p ==> (ppidx 1 = 0)
2879   prime_power_index_eq_0         |- !n p. 0 < n /\ prime p /\ ~(p divides n) ==> (ppidx n = 0)
2880   prime_power_index_prime_power  |- !p. prime p ==> !k. ppidx (p ** k) = k
2881   prime_power_index_prime        |- !p. prime p ==> (ppidx p = 1)
2882   prime_power_index_eqn          |- !n p. 0 < n /\ prime p ==> (let q = n DIV p ** ppidx n in
2883                                                         (n = p ** ppidx n * q) /\ coprime p q)
2884   prime_power_index_pos          |- !n p. 0 < n /\ prime p /\ p divides n ==> 0 < ppidx n
2885
2886   Prime Power and GCD, LCM:
2887   gcd_prime_power_factor       |- !a b p. 0 < a /\ 0 < b /\ prime p ==>
2888                        (gcd a b = p ** MIN (ppidx a) (ppidx b) * gcd (a DIV p ** ppidx a) (b DIV p ** ppidx b))
2889   gcd_prime_power_factor_divides_gcd
2890                                |- !a b p. 0 < a /\ 0 < b /\ prime p ==>
2891                                           p ** MIN (ppidx a) (ppidx b) divides gcd a b
2892   gcd_prime_power_cofactor_coprime
2893                                |- !a b p. 0 < a /\ 0 < b /\ prime p ==>
2894                                           coprime p (gcd (a DIV p ** ppidx a) (b DIV p ** ppidx b))
2895   gcd_prime_power_index        |- !a b p. 0 < a /\ 0 < b /\ prime p ==>
2896                                           (ppidx (gcd a b) = MIN (ppidx a) (ppidx b))
2897   gcd_prime_power_divisibility |- !a b p. 0 < a /\ 0 < b /\ prime p ==>
2898                                   !k. p ** k divides gcd a b ==> k <= MIN (ppidx a) (ppidx b)
2899
2900   lcm_prime_power_factor       |- !a b p. 0 < a /\ 0 < b /\ prime p ==>
2901       (lcm a b = p ** MAX (ppidx a) (ppidx b) * lcm (a DIV p ** ppidx a) (b DIV p ** ppidx b))
2902   lcm_prime_power_factor_divides_lcm
2903                                |- !a b p. 0 < a /\ 0 < b /\ prime p ==>
2904                                           p ** MAX (ppidx a) (ppidx b) divides lcm a b
2905   lcm_prime_power_cofactor_coprime
2906                                |- !a b p. 0 < a /\ 0 < b /\ prime p ==>
2907                                           coprime p (lcm (a DIV p ** ppidx a) (b DIV p ** ppidx b))
2908   lcm_prime_power_index        |- !a b p. 0 < a /\ 0 < b /\ prime p ==>
2909                                           (ppidx (lcm a b) = MAX (ppidx a) (ppidx b))
2910   lcm_prime_power_divisibility |- !a b p. 0 < a /\ 0 < b /\ prime p ==>
2911                                   !k. p ** k divides lcm a b ==> k <= MAX (ppidx a) (ppidx b)
2912
2913   Prime Powers and List LCM:
2914   list_lcm_prime_power_factor_divides   |- !l p. prime p ==> p ** MAX_LIST (MAP ppidx l) divides list_lcm l
2915   list_lcm_prime_power_index            |- !l p. prime p /\ POSITIVE l ==>
2916                                                  (ppidx (list_lcm l) = MAX_LIST (MAP ppidx l))
2917   list_lcm_prime_power_divisibility     |- !l p. prime p /\ POSITIVE l ==>
2918                                            !k. p ** k divides list_lcm l ==> k <= MAX_LIST (MAP ppidx l)
2919   list_lcm_prime_power_factor_member    |- !l p. prime p /\ l <> [] /\ POSITIVE l ==>
2920                                            !k. p ** k divides list_lcm l ==> ?x. MEM x l /\ p ** k divides x
2921   lcm_special_for_prime_power       |- !p. prime p ==> !m n. (n = p ** SUC (ppidx m)) ==> (lcm n m = p * m)
2922   lcm_special_for_coprime_factors   |- !n a b. (n = a * b) /\ coprime a b ==>
2923                                        !m. a divides m /\ b divides m ==> (lcm n m = m)
2924
2925   Prime Divisors:
2926   prime_divisors_def            |- !n. prime_divisors n = {p | prime p /\ p divides n}
2927   prime_divisors_element        |- !n p. p IN prime_divisors n <=> prime p /\ p divides n
2928   prime_divisors_subset_natural |- !n. 0 < n ==> prime_divisors n SUBSET natural n
2929   prime_divisors_finite         |- !n. 0 < n ==> FINITE (prime_divisors n)
2930   prime_divisors_0              |- prime_divisors 0 = prime
2931   prime_divisors_1              |- prime_divisors 1 = {}
2932   prime_divisors_subset_prime   |- !n. prime_divisors n SUBSET prime
2933   prime_divisors_nonempty       |- !n. 1 < n ==> prime_divisors n <> {}
2934   prime_divisors_empty_iff      |- !n. (prime_divisors n = {}) <=> (n = 1)
2935   prime_divisors_0_not_sing     |- ~SING (prime_divisors 0)
2936   prime_divisors_prime          |- !n. prime n ==> (prime_divisors n = {n})
2937   prime_divisors_prime_power    |- !n. prime n ==> !k. 0 < k ==> (prime_divisors (n ** k) = {n})
2938   prime_divisors_sing           |- !n. SING (prime_divisors n) <=> ?p k. prime p /\ 0 < k /\ (n = p ** k)
2939   prime_divisors_sing_alt       |- !n p. (prime_divisors n = {p}) <=> ?k. prime p /\ 0 < k /\ (n = p ** k)
2940   prime_divisors_sing_property  |- !n. SING (prime_divisors n) ==> (let p = CHOICE (prime_divisors n) in
2941                                        prime p /\ (n = p ** ppidx n))
2942   prime_divisors_divisor_subset     |- !m n. m divides n ==> prime_divisors m SUBSET prime_divisors n
2943   prime_divisors_common_divisor     |- !n m x. x divides m /\ x divides n ==>
2944                                         prime_divisors x SUBSET prime_divisors m INTER prime_divisors n
2945   prime_divisors_common_multiple    |- !n m x. m divides x /\ n divides x ==>
2946                                         prime_divisors m UNION prime_divisors n SUBSET prime_divisors x
2947   prime_power_index_common_divisor  |- !n m x. 0 < m /\ 0 < n /\ x divides m /\ x divides n ==>
2948                                        !p. prime p ==> ppidx x <= MIN (ppidx m) (ppidx n)
2949   prime_power_index_common_multiple |- !n m x. 0 < x /\ m divides x /\ n divides x ==>
2950                                        !p. prime p ==> MAX (ppidx m) (ppidx n) <= ppidx x
2951   prime_power_index_le_log_index    |- !n p. 0 < n /\ prime p ==> ppidx n <= LOG p n
2952
2953   Prime-related Sets:
2954   primes_upto_def                |- !n. primes_upto n = {p | prime p /\ p <= n}
2955   prime_powers_upto_def          |- !n. prime_powers_upto n = IMAGE (\p. p ** LOG p n) (primes_upto n)
2956   prime_power_divisors_def       |- !n. prime_power_divisors n = IMAGE (\p. p ** ppidx n) (prime_divisors n)
2957
2958   primes_upto_element            |- !n p. p IN primes_upto n <=> prime p /\ p <= n
2959   primes_upto_subset_natural     |- !n. primes_upto n SUBSET natural n
2960   primes_upto_finite             |- !n. FINITE (primes_upto n)
2961   primes_upto_pairwise_coprime   |- !n. PAIRWISE_COPRIME (primes_upto n)
2962   primes_upto_0                  |- primes_upto 0 = {}
2963   primes_count_0                 |- primes_count 0 = 0
2964   primes_upto_1                  |- primes_upto 1 = {}
2965   primes_count_1                 |- primes_count 1 = 0
2966
2967   prime_powers_upto_element      |- !n x. x IN prime_powers_upto n <=>
2968                                           ?p. (x = p ** LOG p n) /\ prime p /\ p <= n
2969   prime_powers_upto_element_alt  |- !p n. prime p /\ p <= n ==> p ** LOG p n IN prime_powers_upto n
2970   prime_powers_upto_finite       |- !n. FINITE (prime_powers_upto n)
2971   prime_powers_upto_pairwise_coprime  |- !n. PAIRWISE_COPRIME (prime_powers_upto n)
2972   prime_powers_upto_0            |- prime_powers_upto 0 = {}
2973   prime_powers_upto_1            |- prime_powers_upto 1 = {}
2974
2975   prime_power_divisors_element   |- !n x. x IN prime_power_divisors n <=>
2976                                           ?p. (x = p ** ppidx n) /\ prime p /\ p divides n
2977   prime_power_divisors_element_alt |- !p n. prime p /\ p divides n ==>
2978                                             p ** ppidx n IN prime_power_divisors n
2979   prime_power_divisors_finite      |- !n. 0 < n ==> FINITE (prime_power_divisors n)
2980   prime_power_divisors_pairwise_coprime  |- !n. PAIRWISE_COPRIME (prime_power_divisors n)
2981   prime_power_divisors_1         |- prime_power_divisors 1 = {}
2982
2983   Factorisations:
2984   prime_factorisation          |- !n. 0 < n ==> (n = PROD_SET (prime_power_divisors n))
2985   basic_prime_factorisation    |- !n. 0 < n ==>
2986                                       (n = PROD_SET (IMAGE (\p. p ** ppidx n) (prime_divisors n)))
2987   divisor_prime_factorisation  |- !m n. 0 < n /\ m divides n ==>
2988                                         (m = PROD_SET (IMAGE (\p. p ** ppidx m) (prime_divisors n)))
2989   gcd_prime_factorisation      |- !m n. 0 < m /\ 0 < n ==>
2990                                         (gcd m n = PROD_SET (IMAGE (\p. p ** MIN (ppidx m) (ppidx n))
2991                                                           (prime_divisors m INTER prime_divisors n)))
2992   lcm_prime_factorisation      |- !m n. 0 < m /\ 0 < n ==>
2993                                         (lcm m n = PROD_SET (IMAGE (\p. p ** MAX (ppidx m) (ppidx n))
2994                                                           (prime_divisors m UNION prime_divisors n)))
2995
2996   GCD and LCM special coprime decompositions:
2997   common_prime_divisors_element     |- !m n p. p IN common_prime_divisors m n <=>
2998                                                p IN prime_divisors m /\ p IN prime_divisors n
2999   common_prime_divisors_finite      |- !m n. 0 < m /\ 0 < n ==> FINITE (common_prime_divisors m n)
3000   common_prime_divisors_pairwise_coprime     |- !m n. PAIRWISE_COPRIME (common_prime_divisors m n)
3001   common_prime_divisors_min_image_pairwise_coprime
3002   |- !m n. PAIRWISE_COPRIME (IMAGE (\p. p ** MIN (ppidx m) (ppidx n)) (common_prime_divisors m n))
3003   total_prime_divisors_element      |- !m n p. p IN total_prime_divisors m n <=>
3004                                                p IN prime_divisors m \/ p IN prime_divisors n
3005   total_prime_divisors_finite       |- !m n. 0 < m /\ 0 < n ==> FINITE (total_prime_divisors m n)
3006   total_prime_divisors_pairwise_coprime      |- !m n. PAIRWISE_COPRIME (total_prime_divisors m n)
3007   total_prime_divisors_max_image_pairwise_coprime
3008   |- !m n. PAIRWISE_COPRIME (IMAGE (\p. p ** MAX (ppidx m) (ppidx n)) (total_prime_divisors m n))
3009
3010   park_on_element   |- !m n p. p IN park_on m n <=>
3011                                p IN prime_divisors m /\ p IN prime_divisors n /\ ppidx m <= ppidx n
3012   park_off_element  |- !m n p. p IN park_off m n <=>
3013                                p IN prime_divisors m /\ p IN prime_divisors n /\ ppidx n < ppidx m
3014   park_off_alt      |- !m n. park_off m n = common_prime_divisors m n DIFF park_on m n
3015   park_on_subset_common    |- !m n. park_on m n SUBSET common_prime_divisors m n
3016   park_off_subset_common   |- !m n. park_off m n SUBSET common_prime_divisors m n
3017   park_on_subset_total     |- !m n. park_on m n SUBSET total_prime_divisors m n
3018   park_off_subset_total    |- !m n. park_off m n SUBSET total_prime_divisors m n
3019   park_on_off_partition    |- !m n. common_prime_divisors m n =|= park_on m n # park_off m n
3020   park_off_image_has_not_1 |- !m n. 1 NOTIN IMAGE (\p. p ** ppidx m) (park_off m n)
3021
3022   park_on_off_common_image_partition
3023         |- !m n. (let s = IMAGE (\p. p ** MIN (ppidx m) (ppidx n)) (common_prime_divisors m n) in
3024                   let u = IMAGE (\p. p ** ppidx m) (park_on m n) in
3025                   let v = IMAGE (\p. p ** ppidx n) (park_off m n) in
3026                   0 < m ==> s =|= u # v)
3027   gcd_park_decomposition  |- !m n. 0 < m /\ 0 < n ==>
3028                                    (let a = mypark m n in let b = gcd m n DIV a in
3029                                     (b = PROD_SET (IMAGE (\p. p ** ppidx n) (park_off m n))) /\
3030                                     (gcd m n = a * b) /\ coprime a b)
3031   gcd_park_decompose      |- !m n. 0 < m /\ 0 < n ==>
3032                                    (let a = mypark m n in let b = gcd m n DIV a in
3033                                     (gcd m n = a * b) /\ coprime a b)
3034
3035   park_on_off_total_image_partition
3036         |- !m n. (let s = IMAGE (\p. p ** MAX (ppidx m) (ppidx n)) (total_prime_divisors m n) in
3037                   let u = IMAGE (\p. p ** ppidx m) (prime_divisors m DIFF park_on m n) in
3038                   let v = IMAGE (\p. p ** ppidx n) (prime_divisors n DIFF park_off m n) in
3039                   0 < m /\ 0 < n ==> s =|= u # v)
3040   lcm_park_decomposition  |- !m n. 0 < m /\ 0 < n ==>
3041                               (let a = park m n in let b = gcd m n DIV a in
3042                                let p = m DIV a in let q = a * n DIV gcd m n in
3043                                (b = PROD_SET (IMAGE (\p. p ** ppidx n) (park_off m n))) /\
3044           (p = PROD_SET (IMAGE (\p. p ** ppidx m) (prime_divisors m DIFF park_on m n))) /\
3045           (q = PROD_SET (IMAGE (\p. p ** ppidx n) (prime_divisors n DIFF park_off m n))) /\
3046            (lcm m n = p * q) /\ coprime p q /\ (gcd m n = a * b) /\ (m = a * p) /\ (n = b * q))
3047   lcm_park_decompose      |- !m n. 0 < m /\ 0 < n ==>
3048                              (let a = park m n in let p = m DIV a in let q = a * n DIV gcd m n in
3049                               (lcm m n = p * q) /\ coprime p q)
3050   lcm_gcd_park_decompose  |- !m n. 0 < m /\ 0 < n ==>
3051                               (let a = park m n in let b = gcd m n DIV a in
3052                                let p = m DIV a in let q = a * n DIV gcd m n in
3053                                (lcm m n = p * q) /\ coprime p q /\
3054                                (gcd m n = a * b) /\ (m = a * p) /\ (n = b * q))
3055
3056   Consecutive LCM Recurrence:
3057   lcm_fun_def        |- (lcm_fun 0 = 1) /\
3058                          !n. lcm_fun (SUC n) = if n = 0 then 1 else
3059                              case some p. ?k. 0 < k /\ prime p /\ (SUC n = p ** k) of
3060                                NONE => lcm_fun n
3061                              | SOME p => p * lcm_fun n
3062   lcm_fun_0          |- lcm_fun 0 = 1
3063   lcm_fun_SUC        |- !n. lcm_fun (SUC n) = if n = 0 then 1 else
3064                             case some p. ?k. 0 < k /\ prime p /\ (SUC n = p ** k) of
3065                               NONE => lcm_fun n
3066                             | SOME p => p * lcm_fun n
3067   lcm_fun_1          |- lcm_fun 1 = 1
3068   lcm_fun_2          |- lcm_fun 2 = 2
3069   lcm_fun_suc_some   |- !n p. prime p /\ (?k. 0 < k /\ (SUC n = p ** k)) ==> (lcm_fun (SUC n) = p * lcm_fun n)
3070   lcm_fun_suc_none   |- !n. ~(?p k. 0 < k /\ prime p /\ (SUC n = p ** k)) ==> (lcm_fun (SUC n) = lcm_fun n)
3071   list_lcm_prime_power_index_lower   |- !l p. prime p /\ l <> [] /\ POSITIVE l ==>
3072                                         !x. MEM x l ==> ppidx x <= ppidx (list_lcm l)
3073   list_lcm_with_last_prime_power     |- !n p k. prime p /\ (n + 2 = p ** k) ==>
3074                                          (list_lcm [1 .. n + 2] = p * list_lcm (leibniz_vertical n))
3075   list_lcm_with_last_non_prime_power |- !n. (!p k. (k = 0) \/ ~prime p \/ n + 2 <> p ** k) ==>
3076                                          (list_lcm [1 .. n + 2] = list_lcm (leibniz_vertical n))
3077   list_lcm_eq_lcm_fun                |- !n. list_lcm (leibniz_vertical n) = lcm_fun (n + 1)
3078   lcm_fun_lower_bound                |- !n. 2 ** n <= lcm_fun (n + 1)
3079   lcm_fun_lower_bound_alt            |- !n. 0 < n ==> 2 ** (n - 1) <= lcm_fun n
3080   prime_power_index_suc_special      |- !n p. 0 < n /\ prime p /\ (SUC n = p ** ppidx (SUC n)) ==>
3081                                               (ppidx (SUC n) = SUC (ppidx (list_lcm [1 .. n])))
3082   prime_power_index_suc_property     |- !n p. 0 < n /\ prime p /\ (n + 1 = p ** ppidx (n + 1)) ==>
3083                                               (ppidx (n + 1) = 1 + ppidx (list_lcm [1 .. n]))
3084
3085   Consecutive LCM Recurrence - Rework:
3086   list_lcm_by_last_prime_power      |- !n. SING (prime_divisors (n + 1)) ==>
3087                         (list_lcm [1 .. (n + 1)] = CHOICE (prime_divisors (n + 1)) * list_lcm [1 .. n])
3088   list_lcm_by_last_non_prime_power  |- !n. ~SING (prime_divisors (n + 1)) ==>
3089                         (list_lcm (leibniz_vertical n) = list_lcm [1 .. n])
3090   list_lcm_recurrence               |- !n. list_lcm (leibniz_vertical n) = (let s = prime_divisors (n + 1) in
3091                                            if SING s then CHOICE s * list_lcm [1 .. n] else list_lcm [1 .. n])
3092   list_lcm_option_last_prime_power     |- !n p. (prime_divisors (n + 1) = {p}) ==>
3093                                                 (list_lcm (leibniz_vertical n) = p * list_lcm [1 .. n])
3094   list_lcm_option_last_non_prime_power |- !n. (!p. prime_divisors (n + 1) <> {p}) ==>
3095                                               (list_lcm (leibniz_vertical n) = list_lcm [1 .. n])
3096   list_lcm_option_recurrence           |- !n. list_lcm (leibniz_vertical n) =
3097                                               case some p. prime_divisors (n + 1) = {p} of
3098                                                 NONE => list_lcm [1 .. n]
3099                                               | SOME p => p * list_lcm [1 .. n]
3100
3101   Relating Consecutive LCM to Prime Functions:
3102   Theorems on Prime-related Sets:
3103   prime_powers_upto_list_mem     |- !n x. MEM x (SET_TO_LIST (prime_powers_upto n)) <=>
3104                                           ?p. (x = p ** LOG p n) /\ prime p /\ p <= n
3105   prime_powers_upto_lcm_prime_to_log_divisor
3106                                  |- !n p. prime p /\ p <= n ==>
3107                                           p ** LOG p n divides set_lcm (prime_powers_upto n)
3108   prime_powers_upto_lcm_prime_divisor
3109                                  |- !n p. prime p /\ p <= n ==> p divides set_lcm (prime_powers_upto n)
3110   prime_powers_upto_lcm_prime_to_power_divisor
3111                                  |- !n p. prime p /\ p <= n ==>
3112                                           p ** ppidx n divides set_lcm (prime_powers_upto n)
3113   prime_powers_upto_lcm_divisor  |- !n x. 0 < x /\ x <= n ==> x divides set_lcm (prime_powers_upto n)
3114
3115   Consecutive LCM and Prime-related Sets:
3116   lcm_run_eq_set_lcm_prime_powers   |- !n. lcm_run n = set_lcm (prime_powers_upto n)
3117   set_lcm_prime_powers_upto_eqn     |- !n. set_lcm (prime_powers_upto n) = PROD_SET (prime_powers_upto n)
3118   lcm_run_eq_prod_set_prime_powers  |- !n. lcm_run n = PROD_SET (prime_powers_upto n)
3119   prime_powers_upto_prod_set_le     |- !n. PROD_SET (prime_powers_upto n) <= n ** primes_count n
3120   lcm_run_upper_by_primes_count     |- !n. lcm_run n <= n ** primes_count n
3121   prime_powers_upto_prod_set_ge     |- !n. PROD_SET (primes_upto n) <= PROD_SET (prime_powers_upto n)
3122   lcm_run_lower_by_primes_product   |- !n. PROD_SET (primes_upto n) <= lcm_run n
3123   prime_powers_upto_prod_set_mix_ge |- !n. n ** primes_count n <=
3124                                            PROD_SET (primes_upto n) * PROD_SET (prime_powers_upto n)
3125   primes_count_upper_by_product     |- !n. n ** primes_count n <= PROD_SET (primes_upto n) * lcm_run n
3126   primes_count_upper_by_lcm_run     |- !n. n ** primes_count n <= lcm_run n ** 2
3127   lcm_run_lower_by_primes_count     |- !n. SQRT (n ** primes_count n) <= lcm_run n
3128*)
3129
3130(* ------------------------------------------------------------------------- *)
3131(* Helper Theorems                                                           *)
3132(* ------------------------------------------------------------------------- *)
3133
3134(* Theorem: MEM x [1 .. n] ==> MEM (x ** LOG x n) [1 .. n] *)
3135(* Proof:
3136   By listRangeINC_MEM, this is to show:
3137   (1) 1 <= x /\ x <= n ==> 1 <= x ** LOG x n
3138       Note 0 < x               by 1 <= x
3139         so 0 < x ** LOG x n    by EXP_POS, 0 < x
3140         or 1 <= x ** LOG x n   by arithmetic
3141   (2) 1 <= x /\ x <= n ==> x ** LOG x n <= n
3142       Note 1 <= n /\ 0 < n     by arithmetic
3143       If x = 1,
3144          Then true             by EXP_1
3145       If x <> 1,
3146          Then 1 < x, so true   by LOG
3147*)
3148Theorem self_to_log_index_member:
3149  !n x. MEM x [1 .. n] ==> MEM (x ** LOG x n) [1 .. n]
3150Proof
3151  rw[listRangeINC_MEM] >>
3152  ‘0 < n /\ 1 <= n’ by decide_tac >>
3153  Cases_on ‘x = 1’ >-
3154  rw[EXP_1] >> rw[LOG]
3155QED
3156
3157(* ------------------------------------------------------------------------- *)
3158(* Prime Power or Coprime Factors                                            *)
3159(* ------------------------------------------------------------------------- *)
3160
3161(*
3162The concept of a prime number goes like this:
3163* Given a number n > 1, it has factors n = a * b.
3164  Either there are several possibilities, or there is just the trivial: 1 * n and n * 1.
3165  A number with only trivial factors is a prime, otherwise it is a composite.
3166The concept of a prime power number goes like this:
3167* Given a number n > 1, it has factors n = a * b.
3168  Either a and b can be chosen to be coprime, or this choice is impossible.
3169  A number that cannot have coprime factors is a prime power, otherwise a coprime product.
3170*)
3171
3172(* Theorem: 1 < n ==> (?p k. 0 < k /\ prime p /\ (n = p ** k)) \/
3173                      (?a b. (n = a * b) /\ coprime a b /\ 1 < a /\ 1 < b /\ a < n /\ b < n) *)
3174(* Proof:
3175   Note 1 < n ==> 0 < n /\ n <> 0 /\ n <> 1        by arithmetic
3176    Now ?p. prime p /\ p divides n                 by PRIME_FACTOR, n <> 1
3177     so ?k. 0 < k /\ p ** k divides n /\
3178            coprime p (n DIV p ** k)               by FACTOR_OUT_PRIME, EXP_1, 0 < n
3179   Note 0 < p                by PRIME_POS
3180     so 0 < p ** k           by EXP_POS
3181    Let b = n DIV p ** k.
3182   Then n = (p ** k) * b     by DIVIDES_EQN_COMM, 0 < p ** m
3183
3184   If b = 1,
3185      Then n = p ** k        by MULT_RIGHT_1
3186      Take k for the first assertion.
3187   If b <> 1,
3188      Let a = p ** k.
3189       Then coprime a b      by coprime_exp, coprime p b
3190      Since p <> 1           by NOT_PRIME_1
3191         so a <> 1           by EXP_EQ_1
3192        and b <> 0           by MULT_0
3193        Now a divides n /\ b divides n        by divides_def, MULT_COMM
3194         so a <= n /\ b <= n                  by DIVIDES_LE, 0 < n
3195        but a <> n /\ b <> n                  by MULT_LEFT_ID, MULT_RIGHT_ID
3196       Thus 1 < a /\ 1 < b /\ a < n /\ b < n  by arithmetic
3197      Take a, b for the second assertion.
3198*)
3199Theorem prime_power_or_coprime_factors:
3200    !n. 1 < n ==> (?p k. 0 < k /\ prime p /\ (n = p ** k)) \/
3201                 (?a b. (n = a * b) /\ coprime a b /\ 1 < a /\ 1 < b /\ a < n /\ b < n)
3202Proof
3203  rpt strip_tac >>
3204  `0 < n /\ n <> 0 /\ n <> 1` by decide_tac >>
3205  `?p. prime p /\ p divides n` by rw[PRIME_FACTOR] >>
3206  `?k. 0 < k /\ p ** k divides n /\ coprime p (n DIV p ** k)` by metis_tac[FACTOR_OUT_PRIME, EXP_1] >>
3207  `0 < p ** k` by rw[PRIME_POS, EXP_POS] >>
3208  qabbrev_tac `b = n DIV p ** k` >>
3209  `n = (p ** k) * b` by rw[GSYM DIVIDES_EQN_COMM, Abbr`b`] >>
3210  Cases_on `b = 1` >-
3211  metis_tac[MULT_RIGHT_1] >>
3212  qabbrev_tac `a = p ** k` >>
3213  `coprime a b` by rw[coprime_exp, Abbr`a`] >>
3214  `a <> 1` by metis_tac[EXP_EQ_1, NOT_PRIME_1, NOT_ZERO_LT_ZERO] >>
3215  `b <> 0` by metis_tac[MULT_0] >>
3216  `a divides n /\ b divides n` by metis_tac[divides_def, MULT_COMM] >>
3217  `a <= n /\ b <= n` by rw[DIVIDES_LE] >>
3218  `a <> n /\ b <> n` by metis_tac[MULT_LEFT_ID, MULT_RIGHT_ID] >>
3219  `1 < a /\ 1 < b /\ a < n /\ b < n` by decide_tac >>
3220  metis_tac[]
3221QED
3222
3223(* The following is the more powerful version of this:
3224   Simple theorem: If n is not a prime, then ?a b. (n = a * b) /\ 1 < a /\ a < n /\ 1 < b /\ b < n
3225   Powerful theorem: If n is not a prime power, then ?a b. (n = a * b) /\ 1 < a /\ a < n /\ 1 < b /\ b < n
3226*)
3227
3228(* Theorem: 1 < n /\ ~(?p k. 0 < k /\ prime p /\ (n = p ** k)) ==>
3229            ?a b. (n = a * b) /\ coprime a b /\ 1 < a /\ a < n /\ 1 < b /\ b < n *)
3230(* Proof:
3231   Since 1 < n, n <> 1 and 0 < n                by arithmetic
3232    Note ?p. prime p /\ p divides n             by PRIME_FACTOR, n <> 1
3233     and ?m. 0 < m /\ p ** m divides n /\
3234         !k. coprime (p ** k) (n DIV p ** m)    by FACTOR_OUT_PRIME, 0 < n
3235
3236   Let a = p ** m, b = n DIV a.
3237   Since 0 < p                                  by PRIME_POS
3238      so 0 < a                                  by EXP_POS, 0 < p
3239    Thus n = a * b                              by DIVIDES_EQN_COMM, 0 < a
3240
3241    Also 1 < p                                  by ONE_LT_PRIME
3242      so 1 < a                                  by ONE_LT_EXP, 1 < p, 0 < m
3243     and b < n                                  by DIV_LESS, Abbr, 0 < n
3244     Now b <> 1                                 by MULT_RIGHT_1, n not perfect power of any prime
3245     and b <> 0                                 by MULT_0, n = a * b, 0 < n
3246     ==> 1 < b                                  by b <> 0 /\ b <> 1
3247    Also a <= n                                 by DIVIDES_LE
3248     and a <> n                                 by MULT_RIGHT_1
3249     ==> a < n                                  by arithmetic
3250    Take these a and b, the result follows.
3251*)
3252Theorem non_prime_power_coprime_factors:
3253    !n. 1 < n /\ ~(?p k. 0 < k /\ prime p /\ (n = p ** k)) ==>
3254   ?a b. (n = a * b) /\ coprime a b /\ 1 < a /\ a < n /\ 1 < b /\ b < n
3255Proof
3256  rpt strip_tac >>
3257  `0 < n` by decide_tac >>
3258  `?p. prime p /\ p divides n` by rw[PRIME_FACTOR] >>
3259  `?m. 0 < m /\ p ** m divides n /\ !k. coprime (p ** k) (n DIV p ** m)` by rw[FACTOR_OUT_PRIME] >>
3260  qabbrev_tac `a = p ** m` >>
3261  qabbrev_tac `b = n DIV a` >>
3262  `0 < a` by rw[PRIME_POS, EXP_POS, Abbr`a`] >>
3263  `n = a * b` by metis_tac[DIVIDES_EQN_COMM] >>
3264  `1 < a` by rw[ONE_LT_EXP, ONE_LT_PRIME, Abbr`a`] >>
3265  `b < n` by rw[DIV_LESS, Abbr`b`] >>
3266  `b <> 1` by metis_tac[MULT_RIGHT_1] >>
3267  `b <> 0` by metis_tac[MULT_0, NOT_ZERO_LT_ZERO] >>
3268  `1 < b` by decide_tac >>
3269  `a <= n` by rw[DIVIDES_LE] >>
3270  `a <> n` by metis_tac[MULT_RIGHT_1] >>
3271  `a < n` by decide_tac >>
3272  metis_tac[]
3273QED
3274
3275(* Theorem: s SUBSET prime ==> PAIRWISE_COPRIME (IMAGE (\p. p ** f p) s) *)
3276(* Proof:
3277   By SUBSET_DEF, this is to show:
3278      (!x. x IN s ==> prime x) /\ p IN s /\ p' IN s /\ p ** f <> p' ** f ==> coprime (p ** f) (p' ** f)
3279   Note prime p /\ prime p'          by in_prime
3280    and p <> p'                      by p ** f <> p' ** f
3281   Thus coprime (p ** f) (p' ** f)   by prime_powers_coprime
3282*)
3283Theorem pairwise_coprime_for_prime_powers:
3284    !s f. s SUBSET prime ==> PAIRWISE_COPRIME (IMAGE (\p. p ** f p) s)
3285Proof
3286  rw[SUBSET_DEF] >>
3287  `prime p /\ prime p' /\ p <> p'` by metis_tac[in_prime] >>
3288  rw[prime_powers_coprime]
3289QED
3290
3291(* ------------------------------------------------------------------------- *)
3292(* Prime Power Index                                                         *)
3293(* ------------------------------------------------------------------------- *)
3294
3295(* Theorem: 0 < n /\ prime p ==> ?m. (p ** m) divides n /\ coprime p (n DIV (p ** m)) *)
3296(* Proof:
3297   Note ?q m. (n = (p ** m) * q) /\ coprime p q     by prime_power_factor
3298   Let t = p ** m.
3299   Then t divides n                                 by divides_def, MULT_COMM
3300    Now 0 < p                                       by PRIME_POS
3301     so 0 < t                                       by EXP_POS
3302    ==> n = t * (n DIV t)                           by DIVIDES_EQN_COMM
3303   Thus q = n DIV t                                 by MULT_LEFT_CANCEL
3304   Take this m, and the result follows.
3305*)
3306Theorem prime_power_index_exists:
3307    !n p. 0 < n /\ prime p ==> ?m. (p ** m) divides n /\ coprime p (n DIV (p ** m))
3308Proof
3309  rpt strip_tac >>
3310  `?q m. (n = (p ** m) * q) /\ coprime p q` by rw[prime_power_factor] >>
3311  qabbrev_tac `t = p ** m` >>
3312  `t divides n` by metis_tac[divides_def, MULT_COMM] >>
3313  `0 < t` by rw[PRIME_POS, EXP_POS, Abbr`t`] >>
3314  metis_tac[DIVIDES_EQN_COMM, MULT_LEFT_CANCEL, NOT_ZERO_LT_ZERO]
3315QED
3316
3317(* Apply Skolemization *)
3318Theorem lemma[local]:
3319    !p n. ?m. 0 < n /\ prime p ==> (p ** m) divides n /\ coprime p (n DIV (p ** m))
3320Proof
3321  metis_tac[prime_power_index_exists]
3322QED
3323(* Note !p n, for first parameter p, second parameter n. *)
3324(*
3325- SKOLEM_THM;
3326> val it = |- !P. (!x. ?y. P x y) <=> ?f. !x. P x (f x) : thm
3327*)
3328(* Define prime power index *)
3329(*
3330- SIMP_RULE bool_ss [SKOLEM_THM] lemma;
3331> val it = |- ?f. !p n. 0 < n /\ prime p ==> p ** f p n divides n /\ coprime p (n DIV p ** f p n): thm
3332*)
3333val prime_power_index_def = new_specification(
3334    "prime_power_index_def",
3335    ["prime_power_index"],
3336    SIMP_RULE bool_ss [SKOLEM_THM] lemma);
3337(*
3338> val prime_power_index_def = |- !p n. 0 < n /\ prime p ==>
3339  p ** prime_power_index p n divides n /\ coprime p (n DIV p ** prime_power_index p n): thm
3340*)
3341
3342(* Overload on prime_power_index of prime p *)
3343Overload ppidx = ``prime_power_index p``
3344
3345(*
3346> prime_power_index_def;
3347val it = |- !p n. 0 < n /\ prime p ==> p ** ppidx n divides n /\ coprime p (n DIV p ** ppidx n): thm
3348*)
3349
3350(* Theorem: prime p ==> (p ** (ppidx n)) divides n *)
3351(* Proof: by prime_power_index_def, and ALL_DIVIDES_0 *)
3352Theorem prime_power_factor_divides:
3353    !n p. prime p ==> (p ** (ppidx n)) divides n
3354Proof
3355  rpt strip_tac >>
3356  Cases_on `n = 0` >-
3357  rw[] >>
3358  rw[prime_power_index_def]
3359QED
3360
3361(* Theorem: 0 < n /\ prime p ==> coprime p (n DIV p ** ppidx n) *)
3362(* Proof: by prime_power_index_def *)
3363Theorem prime_power_cofactor_coprime:
3364    !n p. 0 < n /\ prime p ==> coprime p (n DIV p ** ppidx n)
3365Proof
3366  rw[prime_power_index_def]
3367QED
3368
3369(* Theorem: 0 < n /\ prime p ==> (n = p ** (ppidx n) * (n DIV p ** (ppidx n))) *)
3370(* Proof:
3371   Let q = p ** (ppidx n).
3372   Then q divides n             by prime_power_factor_divides
3373    But 0 < n ==> n <> 0,
3374     so q <> 0, or 0 < q        by ZERO_DIVIDES
3375   Thus n = q * (n DIV q)       by DIVIDES_EQN_COMM, 0 < q
3376*)
3377Theorem prime_power_eqn:
3378    !n p. 0 < n /\ prime p ==> (n = p ** (ppidx n) * (n DIV p ** (ppidx n)))
3379Proof
3380  rpt strip_tac >>
3381  qabbrev_tac `q = p ** (ppidx n)` >>
3382  `q divides n` by rw[prime_power_factor_divides, Abbr`q`] >>
3383  `0 < q` by metis_tac[ZERO_DIVIDES, NOT_ZERO_LT_ZERO] >>
3384  rw[GSYM DIVIDES_EQN_COMM]
3385QED
3386
3387(* Theorem: 0 < n /\ prime p ==> !k. (p ** k) divides n <=> k <= (ppidx n) *)
3388(* Proof:
3389   Let m = ppidx n.
3390   Then p ** m divides n                      by prime_power_factor_divides
3391   If part: p ** k divides n ==> k <= m
3392      By contradiction, suppose m < k.
3393      Let q = n DIV p ** m.
3394      Then n = p ** m * q                     by prime_power_eqn
3395       ==> ?t. n = p ** k * t                 by divides_def, MULT_COMM
3396      Let d = k - m.
3397      Then 0 < d                              by m < k
3398       ==> p ** k = p ** m * p ** d           by EXP_BY_ADD_SUB_LT
3399       But 0 < p ** m                         by PRIME_POS, EXP_POS
3400        so p ** m <> 0                        by arithmetic
3401      Thus q = p ** d * t                     by MULT_LEFT_CANCEL, MULT_ASSOC
3402     Since p divides p ** d                   by prime_divides_self_power, 0 < d
3403        so p divides q                        by DIVIDES_MULT
3404        or gcd p q = p                        by divides_iff_gcd_fix
3405       But coprime p q                        by prime_power_cofactor_coprime
3406      This is a contradiction since p <> 1    by NOT_PRIME_1
3407
3408   Only-if part: k <= m ==> p ** k divides n
3409     Note p ** m = p ** d * p ** k            by EXP_BY_ADD_SUB_LE, MULT_COMM
3410     Thus p ** k divides p ** m               by divides_def
3411      ==> p ** k divides n                    by DIVIDES_TRANS
3412*)
3413
3414Theorem prime_power_divisibility:
3415  !n p. 0 < n /\ prime p ==> !k. (p ** k) divides n <=> k <= (ppidx n)
3416Proof
3417  rpt strip_tac >>
3418  qabbrev_tac `m = ppidx n` >>
3419  `p ** m divides n` by rw[prime_power_factor_divides, Abbr`m`] >>
3420  rw[EQ_IMP_THM] >| [
3421    spose_not_then strip_assume_tac >>
3422    `m < k` by decide_tac >>
3423    qabbrev_tac `q = n DIV p ** m` >>
3424    `n = p ** m * q` by rw[prime_power_eqn, Abbr`m`, Abbr`q`] >>
3425    `?t. n = p ** k * t` by metis_tac[divides_def, MULT_COMM] >>
3426    `p ** k = p ** m * p ** (k - m)` by rw[EXP_BY_ADD_SUB_LT] >>
3427    `0 < k - m` by decide_tac >>
3428    qabbrev_tac `d = k - m` >>
3429    `0 < p ** m` by rw[PRIME_POS, EXP_POS] >>
3430    `p ** m <> 0` by decide_tac >>
3431    `q = p ** d * t` by metis_tac[MULT_LEFT_CANCEL, MULT_ASSOC] >>
3432    `p divides p ** d` by rw[prime_divides_self_power] >>
3433    `p divides q` by simp[DIVIDES_MULTIPLE] >>
3434    `gcd p q = p` by rw[GSYM divides_iff_gcd_fix] >>
3435    `coprime p q` by rw[GSYM prime_power_cofactor_coprime, Abbr`m`, Abbr`q`] >>
3436    metis_tac[NOT_PRIME_1],
3437    `p ** m = p ** (m - k) * p ** k` by rw[EXP_BY_ADD_SUB_LE, MULT_COMM] >>
3438    `p ** k divides p ** m` by metis_tac[divides_def] >>
3439    metis_tac[DIVIDES_TRANS]
3440  ]
3441QED
3442
3443(* Theorem: 0 < n /\ prime p ==> !k. k > ppidx n ==> ~(p ** k divides n) *)
3444(* Proof: by prime_power_divisibility *)
3445Theorem prime_power_index_maximal:
3446    !n p. 0 < n /\ prime p ==> !k. k > ppidx n ==> ~(p ** k divides n)
3447Proof
3448  rw[prime_power_divisibility]
3449QED
3450
3451(* Theorem: 0 < n /\ m divides n ==> !p. prime p ==> ppidx m <= ppidx n *)
3452(* Proof:
3453   Note 0 < m                      by ZERO_DIVIDES, 0 < n
3454   Thus p ** ppidx m divides m     by prime_power_factor_divides, 0 < m
3455    ==> p ** ppidx m divides n     by DIVIDES_TRANS
3456     or ppidx m <= ppidx n         by prime_power_divisibility, 0 < n
3457*)
3458Theorem prime_power_index_of_divisor:
3459    !m n. 0 < n /\ m divides n ==> !p. prime p ==> ppidx m <= ppidx n
3460Proof
3461  rpt strip_tac >>
3462  `0 < m` by metis_tac[ZERO_DIVIDES, NOT_ZERO_LT_ZERO] >>
3463  `p ** ppidx m divides m` by rw[prime_power_factor_divides] >>
3464  `p ** ppidx m divides n` by metis_tac[DIVIDES_TRANS] >>
3465  rw[GSYM prime_power_divisibility]
3466QED
3467
3468(* Theorem: 0 < n /\ prime p ==> !k. (k = ppidx n) <=> (?q. (n = p ** k * q) /\ coprime p q) *)
3469(* Proof:
3470   If part: k = ppidx n ==> ?q. (n = p ** k * q) /\ coprime p q
3471      Let q = n DIV p ** k, where k = ppidx n.
3472      Then n = p ** k * q           by prime_power_eqn
3473       and coprime p q              by prime_power_cofactor_coprime
3474   Only-if part: n = p ** k * q /\ coprime p q ==> k = ppidx n
3475      Note n = p ** (ppidx n) * q   by prime_power_eqn
3476
3477      Thus p ** k divides n         by divides_def, MULT_COMM
3478       ==> k <= ppidx n             by prime_power_divisibility
3479
3480      Claim: ppidx n <= k
3481      Proof: By contradiction, suppose k < ppidx n.
3482             Let d = ppidx n - k, then 0 < d.
3483             Let nq = n DIV p ** (ppidx n).
3484             Then n = p ** (ppidx n) * nq              by prime_power_eqn
3485             Note p ** ppidx n = p ** k * p ** d       by EXP_BY_ADD_SUB_LT
3486              Now 0 < p ** k                           by PRIME_POS, EXP_POS
3487               so q = p ** d * nq                      by MULT_LEFT_CANCEL, MULT_ASSOC, p ** k <> 0
3488              But p divides p ** d                     by prime_divides_self_power, 0 < d
3489              and p ** d divides q                     by divides_def, MULT_COMM
3490              ==> p divides q                          by DIVIDES_TRANS
3491               or gcd p q = p                          by divides_iff_gcd_fix
3492              This contradicts coprime p q as p <> 1   by NOT_PRIME_1
3493
3494      With k <= ppidx n and ppidx n <= k, k = ppidx n  by LESS_EQUAL_ANTISYM
3495*)
3496Theorem prime_power_index_test:
3497    !n p. 0 < n /\ prime p ==> !k. (k = ppidx n) <=> (?q. (n = p ** k * q) /\ coprime p q)
3498Proof
3499  rw_tac std_ss[EQ_IMP_THM] >-
3500  metis_tac[prime_power_eqn, prime_power_cofactor_coprime] >>
3501  qabbrev_tac `n = p ** k * q` >>
3502  `p ** k divides n` by metis_tac[divides_def, MULT_COMM] >>
3503  `k <= ppidx n` by rw[GSYM prime_power_divisibility] >>
3504  `ppidx n <= k` by
3505  (spose_not_then strip_assume_tac >>
3506  `k < ppidx n /\ 0 < ppidx n - k` by decide_tac >>
3507  `p ** ppidx n = p ** k * p ** (ppidx n - k)` by rw[EXP_BY_ADD_SUB_LT] >>
3508  qabbrev_tac `d = ppidx n - k` >>
3509  qabbrev_tac `nq = n DIV p ** (ppidx n)` >>
3510  `n = p ** (ppidx n) * nq` by rw[prime_power_eqn, Abbr`nq`] >>
3511  `0 < p ** k` by rw[PRIME_POS, EXP_POS] >>
3512  `q = p ** d * nq` by metis_tac[MULT_LEFT_CANCEL, MULT_ASSOC, NOT_ZERO_LT_ZERO] >>
3513  `p divides p ** d` by rw[prime_divides_self_power] >>
3514  `p ** d divides q` by metis_tac[divides_def, MULT_COMM] >>
3515  `p divides q` by metis_tac[DIVIDES_TRANS] >>
3516  `gcd p q = p` by rw[GSYM divides_iff_gcd_fix] >>
3517  metis_tac[NOT_PRIME_1]) >>
3518  decide_tac
3519QED
3520
3521(* Theorem: prime p ==> (ppidx 1 = 0) *)
3522(* Proof:
3523   Note 1 = p ** 0 * 1      by EXP, MULT_RIGHT_1
3524    and coprime p 1         by GCD_1
3525     so ppidx 1 = 0         by prime_power_index_test, 0 < 1
3526*)
3527Theorem prime_power_index_1:
3528    !p. prime p ==> (ppidx 1 = 0)
3529Proof
3530  rpt strip_tac >>
3531  `1 = p ** 0 * 1` by rw[] >>
3532  `coprime p 1` by rw[GCD_1] >>
3533  metis_tac[prime_power_index_test, DECIDE``0 < 1``]
3534QED
3535
3536(* Theorem: 0 < n /\ prime p /\ ~(p divides n) ==> (ppidx n = 0) *)
3537(* Proof:
3538   By contradiction, suppose ppidx n <> 0.
3539   Then 0 < ppidx n              by NOT_ZERO_LT_ZERO
3540   Note p ** ppidx n divides n   by prime_power_index_def, 0 < n
3541    and 1 < p                    by ONE_LT_PRIME
3542     so p divides p ** ppidx n   by divides_self_power, 0 < n, 1 < p
3543    ==> p divides n              by DIVIDES_TRANS
3544   This contradicts ~(p divides n).
3545*)
3546Theorem prime_power_index_eq_0:
3547    !n p. 0 < n /\ prime p /\ ~(p divides n) ==> (ppidx n = 0)
3548Proof
3549  spose_not_then strip_assume_tac >>
3550  `p ** ppidx n divides n` by rw[prime_power_index_def] >>
3551  `p divides p ** ppidx n` by rw[divides_self_power, ONE_LT_PRIME] >>
3552  metis_tac[DIVIDES_TRANS]
3553QED
3554
3555(* Theorem: prime p ==> (ppidx (p ** k) = k) *)
3556(* Proof:
3557   Note p ** k = p ** k * 1   by EXP, MULT_RIGHT_1
3558    and coprime p 1           by GCD_1
3559    Now 0 < p ** k            by PRIME_POS, EXP_POS
3560     so ppidx (p ** k) = k    by prime_power_index_test, 0 < p ** k
3561*)
3562Theorem prime_power_index_prime_power:
3563    !p. prime p ==> !k. ppidx (p ** k) = k
3564Proof
3565  rpt strip_tac >>
3566  `p ** k = p ** k * 1` by rw[] >>
3567  `coprime p 1` by rw[GCD_1] >>
3568  `0 < p ** k` by rw[PRIME_POS, EXP_POS] >>
3569  metis_tac[prime_power_index_test]
3570QED
3571
3572(* Theorem: prime p ==> (ppidx p = 1) *)
3573(* Proof:
3574   Note 0 < p             by PRIME_POS
3575    and p = p ** 1 * 1    by EXP_1, MULT_RIGHT_1
3576    and coprime p 1       by GCD_1
3577     so ppidx p = 1       by prime_power_index_test
3578*)
3579Theorem prime_power_index_prime:
3580    !p. prime p ==> (ppidx p = 1)
3581Proof
3582  rpt strip_tac >>
3583  `0 < p` by rw[PRIME_POS] >>
3584  `p = p ** 1 * 1` by rw[] >>
3585  metis_tac[prime_power_index_test, GCD_1]
3586QED
3587
3588(* Theorem: 0 < n /\ prime p ==> let q = n DIV (p ** ppidx n) in (n = p ** ppidx n * q) /\ (coprime p q) *)
3589(* Proof:
3590   This is to show:
3591   (1) n = p ** ppidx n * q
3592       Note p ** ppidx n divides n      by prime_power_index_def
3593        Now 0 < p                       by PRIME_POS
3594         so 0 < p ** ppidx n            by EXP_POS
3595        ==> n = p ** ppidx n * q        by DIVIDES_EQN_COMM, 0 < p ** ppidx n
3596   (2) coprime p q, true                by prime_power_index_def
3597*)
3598Theorem prime_power_index_eqn:
3599    !n p. 0 < n /\ prime p ==> let q = n DIV (p ** ppidx n) in (n = p ** ppidx n * q) /\ (coprime p q)
3600Proof
3601  metis_tac[prime_power_index_def, PRIME_POS, EXP_POS, DIVIDES_EQN_COMM]
3602QED
3603
3604(* Theorem: 0 < n /\ prime p /\ p divides n ==> 0 < ppidx n *)
3605(* Proof:
3606   By contradiction, suppose ~(0 < ppidx n).
3607   Then ppidx n = 0                       by NOT_ZERO_LT_ZERO
3608   Note ?q. coprime p q /\
3609            n = p ** ppidx n * q          by prime_power_index_eqn
3610              = p ** 0 * q                by ppidx n = 0
3611              = 1 * q                     by EXP_0
3612              = q                         by MULT_LEFT_1
3613    But 1 < p                             by ONE_LT_PRIME
3614    and coprime p q ==> ~(p divides q)    by coprime_not_divides
3615    This contradicts p divides q          by p divides n, n = q
3616*)
3617Theorem prime_power_index_pos:
3618    !n p. 0 < n /\ prime p /\ p divides n ==> 0 < ppidx n
3619Proof
3620  spose_not_then strip_assume_tac >>
3621  `ppidx n = 0` by decide_tac >>
3622  `?q. coprime p q /\ (n = p ** ppidx n * q)` by metis_tac[prime_power_index_eqn] >>
3623  `_ = q` by rw[] >>
3624  metis_tac[coprime_not_divides, ONE_LT_PRIME]
3625QED
3626
3627(* ------------------------------------------------------------------------- *)
3628(* Prime Power and GCD, LCM                                                  *)
3629(* ------------------------------------------------------------------------- *)
3630
3631(* Theorem: 0 < a /\ 0 < b /\ prime p ==>
3632            (gcd a b = p ** MIN (ppidx a) (ppidx b) * gcd (a DIV p ** (ppidx a)) (b DIV p ** (ppidx b))) *)
3633(* Proof:
3634   Let ma = ppidx a, qa = a DIV p ** ma.
3635   Let mb = ppidx b, qb = b DIV p ** mb.
3636   Then coprime p qa                       by prime_power_cofactor_coprime
3637    and coprime p qb                       by prime_power_cofactor_coprime
3638   Also a = p ** ma * qa                   by prime_power_eqn
3639    and b = p ** mb * qb                   by prime_power_eqn
3640
3641   If ma < mb, let d = mb - ma.
3642      Then p ** mb = p ** ma * p ** d      by EXP_BY_ADD_SUB_LT
3643       and coprime (p ** d) qa             by coprime_exp
3644           gcd a b
3645         = p ** ma * gcd qa (p ** d * qb)  by GCD_COMMON_FACTOR, MULT_ASSOC
3646         = p ** ma * gcd qa qb             by gcd_coprime_cancel, GCD_SYM, coprime (p ** d) qa
3647         = p ** (MIN ma mb) * gcd qa qb    by MIN_DEF
3648
3649   If ~(ma < mb), let d = ma - mb.
3650      Then p ** ma = p ** mb * p ** d      by EXP_BY_ADD_SUB_LE
3651       and coprime (p ** d) qb             by coprime_exp
3652           gcd a b
3653         = p ** mb * gcd (p ** d * qa) qb  by GCD_COMMON_FACTOR, MULT_ASSOC
3654         = p ** mb * gcd qa qb             by gcd_coprime_cancel, coprime (p ** d) qb
3655         = p ** (MIN ma mb) * gcd qa qb    by MIN_DEF
3656*)
3657Theorem gcd_prime_power_factor:
3658    !a b p. 0 < a /\ 0 < b /\ prime p ==>
3659    (gcd a b = p ** MIN (ppidx a) (ppidx b) * gcd (a DIV p ** (ppidx a)) (b DIV p ** (ppidx b)))
3660Proof
3661  rpt strip_tac >>
3662  qabbrev_tac `ma = ppidx a` >>
3663  qabbrev_tac `qa = a DIV p ** ma` >>
3664  qabbrev_tac `mb = ppidx b` >>
3665  qabbrev_tac `qb = b DIV p ** mb` >>
3666  `coprime p qa` by rw[prime_power_cofactor_coprime, Abbr`ma`, Abbr`qa`] >>
3667  `coprime p qb` by rw[prime_power_cofactor_coprime, Abbr`mb`, Abbr`qb`] >>
3668  `a = p ** ma * qa` by rw[prime_power_eqn, Abbr`ma`, Abbr`qa`] >>
3669  `b = p ** mb * qb` by rw[prime_power_eqn, Abbr`mb`, Abbr`qb`] >>
3670  Cases_on `ma < mb` >| [
3671    `p ** mb = p ** ma * p ** (mb - ma)` by rw[EXP_BY_ADD_SUB_LT] >>
3672    qabbrev_tac `d = mb - ma` >>
3673    `coprime (p ** d) qa` by rw[coprime_exp] >>
3674    `gcd a b = p ** ma * gcd qa (p ** d * qb)` by metis_tac[GCD_COMMON_FACTOR, MULT_ASSOC] >>
3675    `_ = p ** ma * gcd qa qb` by metis_tac[gcd_coprime_cancel, GCD_SYM] >>
3676    rw[MIN_DEF],
3677    `p ** ma = p ** mb * p ** (ma - mb)` by rw[EXP_BY_ADD_SUB_LE] >>
3678    qabbrev_tac `d = ma - mb` >>
3679    `coprime (p ** d) qb` by rw[coprime_exp] >>
3680    `gcd a b = p ** mb * gcd (p ** d * qa) qb` by metis_tac[GCD_COMMON_FACTOR, MULT_ASSOC] >>
3681    `_ = p ** mb * gcd qa qb` by rw[gcd_coprime_cancel] >>
3682    rw[MIN_DEF]
3683  ]
3684QED
3685
3686(* Theorem: 0 < a /\ 0 < b /\ prime p ==> (p ** MIN (ppidx a) (ppidx b)) divides (gcd a b) *)
3687(* Proof: by gcd_prime_power_factor, divides_def *)
3688Theorem gcd_prime_power_factor_divides_gcd:
3689    !a b p. 0 < a /\ 0 < b /\ prime p ==> (p ** MIN (ppidx a) (ppidx b)) divides (gcd a b)
3690Proof
3691  prove_tac[gcd_prime_power_factor, divides_def, MULT_COMM]
3692QED
3693
3694(* Theorem: 0 < a /\ 0 < b /\ prime p ==> coprime p (gcd (a DIV p ** (ppidx a)) (b DIV p ** (ppidx b))) *)
3695(* Proof:
3696   Let ma = ppidx a, qa = a DIV p ** ma.
3697   Let mb = ppidx b, qb = b DIV p ** mb.
3698   Then coprime p qa             by prime_power_cofactor_coprime
3699       gcd p (gcd qa qb)
3700     = gcd (gcd p qa) qb         by GCD_ASSOC
3701     = gcd 1 qb                  by coprime p qa
3702     = 1                         by GCD_1
3703*)
3704Theorem gcd_prime_power_cofactor_coprime:
3705    !a b p. 0 < a /\ 0 < b /\ prime p ==> coprime p (gcd (a DIV p ** (ppidx a)) (b DIV p ** (ppidx b)))
3706Proof
3707  rw[prime_power_cofactor_coprime, GCD_ASSOC, GCD_1]
3708QED
3709
3710(* Theorem: 0 < a /\ 0 < b /\ prime p ==> (ppidx (gcd a b) = MIN (ppidx a) (ppidx b)) *)
3711(* Proof:
3712   Let ma = ppidx a, qa = a DIV p ** ma.
3713   Let mb = ppidx b, qb = b DIV p ** mb.
3714   Let m = MIN ma mb.
3715   Then gcd a b = p ** m * (gcd qa qb)     by gcd_prime_power_factor
3716   Note 0 < gcd a b                        by GCD_POS
3717    and coprime p (gcd qa qb)              by gcd_prime_power_cofactor_coprime
3718   Thus ppidx (gcd a b) = m                by prime_power_index_test
3719*)
3720Theorem gcd_prime_power_index:
3721    !a b p. 0 < a /\ 0 < b /\ prime p ==> (ppidx (gcd a b) = MIN (ppidx a) (ppidx b))
3722Proof
3723  metis_tac[gcd_prime_power_factor, GCD_POS, prime_power_index_test, gcd_prime_power_cofactor_coprime]
3724QED
3725
3726(* Theorem: 0 < a /\ 0 < b /\ prime p ==> !k. p ** k divides gcd a b ==> k <= MIN (ppidx a) (ppidx b) *)
3727(* Proof:
3728   Note 0 < gcd a b                     by GCD_POS
3729   Thus k <= ppidx (gcd a b)            by prime_power_divisibility
3730     or k <= MIN (ppidx a) (ppidx b)    by gcd_prime_power_index
3731*)
3732Theorem gcd_prime_power_divisibility:
3733    !a b p. 0 < a /\ 0 < b /\ prime p ==> !k. p ** k divides gcd a b ==> k <= MIN (ppidx a) (ppidx b)
3734Proof
3735  metis_tac[GCD_POS, prime_power_divisibility, gcd_prime_power_index]
3736QED
3737
3738(* Theorem: 0 < a /\ 0 < b /\ prime p ==>
3739            (lcm a b = p ** MAX (ppidx a) (ppidx b) * lcm (a DIV p ** (ppidx a)) (b DIV p ** (ppidx b))) *)
3740(* Proof:
3741   Let ma = ppidx a, qa = a DIV p ** ma.
3742   Let mb = ppidx b, qb = b DIV p ** mb.
3743   Then coprime p qa                       by prime_power_cofactor_coprime
3744    and coprime p qb                       by prime_power_cofactor_coprime
3745   Also a = p ** ma * qa                   by prime_power_eqn
3746    and b = p ** mb * qb                   by prime_power_eqn
3747   Note (gcd a b) * (lcm a b) = a * b      by GCD_LCM
3748    and gcd qa qb <> 0                     by GCD_EQ_0, MULT_0, 0 < a, 0 < b.
3749
3750   If ma < mb,
3751      Then gcd a b = p ** ma * gcd qa qb              by gcd_prime_power_factor, MIN_DEF
3752       and a * b = (p ** ma * qa) * (p ** mb * qb)    by above
3753      Note p ** ma <> 0                               by MULT, 0 < a = p ** ma * qa
3754           gcd qa qb * lcm a b
3755         = qa * (p ** mb * qb)                        by MULT_LEFT_CANCEL, MULT_ASSOC
3756         = qa * qb * (p ** mb)                        by MULT_ASSOC_COMM
3757         = gcd qa qb * lcm qa qb * (p ** mb)          by GCD_LCM
3758      Thus lcm a b = lcm qa qb * p ** mb              by MULT_LEFT_CANCEL, MULT_ASSOC
3759                   = p ** mb * lcm qa qb              by MULT_COMM
3760                   = p ** (MAX ma mb) * lcm qa qb     by MAX_DEF
3761
3762   If ~(ma < mb),
3763      Then gcd a b = p ** mb * gcd qa qb              by gcd_prime_power_factor, MIN_DEF
3764       and a * b = (p ** mb * qb) * (p ** ma * qa)    by MULT_COMM
3765      Note p ** mb <> 0                               by MULT, 0 < b = p ** mb * qb
3766           gcd qa qb * lcm a b
3767         = qb * (p ** ma * qa)                        by MULT_LEFT_CANCEL, MULT_ASSOC
3768         = qa * qb * (p ** ma)                        by MULT_ASSOC_COMM, MULT_COMM
3769         = gcd qa qb * lcm qa qb * (p ** ma)          by GCD_LCM
3770      Thus lcm a b = lcm qa qb * p ** ma              by MULT_LEFT_CANCEL, MULT_ASSOC
3771                   = p ** ma * lcm qa qb              by MULT_COMM
3772                   = p ** (MAX ma mb) * lcm qa qb     by MAX_DEF
3773*)
3774Theorem lcm_prime_power_factor:
3775    !a b p. 0 < a /\ 0 < b /\ prime p ==>
3776    (lcm a b = p ** MAX (ppidx a) (ppidx b) * lcm (a DIV p ** (ppidx a)) (b DIV p ** (ppidx b)))
3777Proof
3778  rpt strip_tac >>
3779  qabbrev_tac `ma = ppidx a` >>
3780  qabbrev_tac `qa = a DIV p ** ma` >>
3781  qabbrev_tac `mb = ppidx b` >>
3782  qabbrev_tac `qb = b DIV p ** mb` >>
3783  `coprime p qa` by rw[prime_power_cofactor_coprime, Abbr`ma`, Abbr`qa`] >>
3784  `coprime p qb` by rw[prime_power_cofactor_coprime, Abbr`mb`, Abbr`qb`] >>
3785  `a = p ** ma * qa` by rw[prime_power_eqn, Abbr`ma`, Abbr`qa`] >>
3786  `b = p ** mb * qb` by rw[prime_power_eqn, Abbr`mb`, Abbr`qb`] >>
3787  `(gcd a b) * (lcm a b) = a * b` by rw[GCD_LCM] >>
3788  `gcd qa qb <> 0` by metis_tac[GCD_EQ_0, MULT_0, NOT_ZERO_LT_ZERO] >>
3789  Cases_on `ma < mb` >| [
3790    `gcd a b = p ** ma * gcd qa qb` by metis_tac[gcd_prime_power_factor, MIN_DEF] >>
3791    `a * b = (p ** ma * qa) * (p ** mb * qb)` by rw[] >>
3792    `p ** ma <> 0` by metis_tac[MULT, NOT_ZERO_LT_ZERO] >>
3793    `gcd qa qb * lcm a b = qa * (p ** mb * qb)` by metis_tac[MULT_LEFT_CANCEL, MULT_ASSOC] >>
3794    `_ = qa * qb * (p ** mb)` by rw[MULT_ASSOC_COMM] >>
3795    `_ = gcd qa qb * lcm qa qb * (p ** mb)` by metis_tac[GCD_LCM] >>
3796    `lcm a b = lcm qa qb * p ** mb` by metis_tac[MULT_LEFT_CANCEL, MULT_ASSOC] >>
3797    rw[MAX_DEF, Once MULT_COMM],
3798    `gcd a b = p ** mb * gcd qa qb` by metis_tac[gcd_prime_power_factor, MIN_DEF] >>
3799    `a * b = (p ** mb * qb) * (p ** ma * qa)` by rw[Once MULT_COMM] >>
3800    `p ** mb <> 0` by metis_tac[MULT, NOT_ZERO_LT_ZERO] >>
3801    `gcd qa qb * lcm a b = qb * (p ** ma * qa)` by metis_tac[MULT_LEFT_CANCEL, MULT_ASSOC] >>
3802    `_ = qa * qb * (p ** ma)` by rw[MULT_ASSOC_COMM, Once MULT_COMM] >>
3803    `_ = gcd qa qb * lcm qa qb * (p ** ma)` by metis_tac[GCD_LCM] >>
3804    `lcm a b = lcm qa qb * p ** ma` by metis_tac[MULT_LEFT_CANCEL, MULT_ASSOC] >>
3805    rw[MAX_DEF, Once MULT_COMM]
3806  ]
3807QED
3808
3809(* The following is the two-number version of prime_power_factor_divides *)
3810
3811(* Theorem: 0 < a /\ 0 < b /\ prime p ==> (p ** MAX (ppidx a) (ppidx b)) divides (lcm a b) *)
3812(* Proof: by lcm_prime_power_factor, divides_def *)
3813Theorem lcm_prime_power_factor_divides_lcm:
3814    !a b p. 0 < a /\ 0 < b /\ prime p ==> (p ** MAX (ppidx a) (ppidx b)) divides (lcm a b)
3815Proof
3816  prove_tac[lcm_prime_power_factor, divides_def, MULT_COMM]
3817QED
3818
3819(* Theorem: 0 < a /\ 0 < b /\ prime p ==> coprime p (lcm (a DIV p ** ppidx a) (b DIV p ** ppidx b)) *)
3820(* Proof:
3821   Let ma = ppidx a, qa = a DIV p ** ma.
3822   Let mb = ppidx b, qb = b DIV p ** mb.
3823   Then coprime p qa                   by prime_power_cofactor_coprime
3824    and coprime p qb                   by prime_power_cofactor_coprime
3825
3826   Simple if we have: gcd_over_lcm: gcd x (lcm y z) = lcm (gcd x y) (gcd x z)
3827   But we don't, so use another approach.
3828
3829   Note 1 < p                          by ONE_LT_PRIME
3830   Let d = gcd p (lcm qa qb).
3831   By contradiction, assume d <> 1.
3832   Note d divides p                    by GCD_IS_GREATEST_COMMON_DIVISOR
3833     so d = p                          by prime_def, d <> 1
3834     or p divides lcm qa qb            by divides_iff_gcd_fix, gcd p (lcm qa qb) = d = p
3835    But (lcm qa qb) divides (qa * qb)  by GCD_LCM, divides_def
3836     so p divides qa * qb              by DIVIDES_TRANS
3837    ==> p divides qa or p divides qb   by P_EUCLIDES
3838    This contradicts coprime p qa
3839                 and coprime p qb      by coprime_not_divides, 1 < p
3840*)
3841Theorem lcm_prime_power_cofactor_coprime:
3842    !a b p. 0 < a /\ 0 < b /\ prime p ==> coprime p (lcm (a DIV p ** ppidx a) (b DIV p ** ppidx b))
3843Proof
3844  rpt strip_tac >>
3845  qabbrev_tac `ma = ppidx a` >>
3846  qabbrev_tac `mb = ppidx b` >>
3847  qabbrev_tac `qa = a DIV p ** ma` >>
3848  qabbrev_tac `qb = b DIV p ** mb` >>
3849  `coprime p qa` by rw[prime_power_cofactor_coprime, Abbr`ma`, Abbr`qa`] >>
3850  `coprime p qb` by rw[prime_power_cofactor_coprime, Abbr`mb`, Abbr`qb`] >>
3851  spose_not_then strip_assume_tac >>
3852  qabbrev_tac `d = gcd p (lcm qa qb)` >>
3853  `d divides p` by rw[GCD_IS_GREATEST_COMMON_DIVISOR, Abbr`d`] >>
3854  `d = p` by metis_tac[prime_def] >>
3855  `p divides lcm qa qb` by rw[divides_iff_gcd_fix, Abbr`d`] >>
3856  `(lcm qa qb) divides (qa * qb)` by metis_tac[GCD_LCM, divides_def] >>
3857  `p divides qa * qb` by metis_tac[DIVIDES_TRANS] >>
3858  `1 < p` by rw[ONE_LT_PRIME] >>
3859  metis_tac[P_EUCLIDES, coprime_not_divides]
3860QED
3861
3862(* Theorem: 0 < a /\ 0 < b /\ prime p ==> (ppidx (lcm a b) = MAX (ppidx a) (ppidx b)) *)
3863(* Proof:
3864   Let ma = ppidx a, qa = a DIV p ** ma.
3865   Let mb = ppidx b, qb = b DIV p ** mb.
3866   Let m = MAX ma mb.
3867   Then lcm a b = p ** m * (lcm qa qb)     by lcm_prime_power_factor
3868   Note 0 < lcm a b                        by LCM_POS
3869    and coprime p (lcm qa qb)              by lcm_prime_power_cofactor_coprime
3870     so ppidx (lcm a b) = m                by prime_power_index_test
3871*)
3872Theorem lcm_prime_power_index:
3873    !a b p. 0 < a /\ 0 < b /\ prime p ==> (ppidx (lcm a b) = MAX (ppidx a) (ppidx b))
3874Proof
3875  metis_tac[lcm_prime_power_factor, LCM_POS, lcm_prime_power_cofactor_coprime, prime_power_index_test]
3876QED
3877
3878(* Theorem: 0 < a /\ 0 < b /\ prime p ==> !k. p ** k divides lcm a b ==> k <= MAX (ppidx a) (ppidx b) *)
3879(* Proof:
3880   Note 0 < lcm a b                     by LCM_POS
3881     so k <= ppidx (lcm a b)            by prime_power_divisibility
3882     or k <= MAX (ppidx a) (ppidx b)    by lcm_prime_power_index
3883*)
3884Theorem lcm_prime_power_divisibility:
3885    !a b p. 0 < a /\ 0 < b /\ prime p ==> !k. p ** k divides lcm a b ==> k <= MAX (ppidx a) (ppidx b)
3886Proof
3887  metis_tac[LCM_POS, prime_power_divisibility, lcm_prime_power_index]
3888QED
3889
3890(* ------------------------------------------------------------------------- *)
3891(* Prime Powers and List LCM                                                 *)
3892(* ------------------------------------------------------------------------- *)
3893
3894(*
3895If a prime-power divides a list_lcm, the prime-power must divides some element in the list for list_lcm.
3896Note: this is not true for non-prime-power.
3897*)
3898
3899(* Theorem: prime p ==> p ** (MAX_LIST (MAP (ppidx) l)) divides list_lcm l *)
3900(* Proof:
3901   If l = [],
3902         p ** MAX_LIST (MAP ppidx [])
3903       = p ** MAX_LIST []              by MAP
3904       = p ** 0                        by MAX_LIST_NIL
3905       = 1
3906       Hence true                      by ONE_DIVIDES_ALL
3907       In fact, list_lcm [] = 1        by list_lcm_nil
3908   If l <> [],
3909      Let ml = MAP ppidx l.
3910      Then ml <> []                                 by MAP_EQ_NIL
3911       ==> MEM (MAX_LIST ml) ml                     by MAX_LIST_MEM, ml <> []
3912        so ?x. (MAX_LIST ml = ppidx x) /\ MEM x l   by MEM_MAP
3913      Thus p ** ppidx x divides x                   by prime_power_factor_divides
3914       Now x divides list_lcm l                     by list_lcm_is_common_multiple
3915        so p ** (ppidx x)
3916         = p ** (MAX_LIST ml) divides list_lcm l    by DIVIDES_TRANS
3917*)
3918Theorem list_lcm_prime_power_factor_divides:
3919    !l p. prime p ==> p ** (MAX_LIST (MAP (ppidx) l)) divides list_lcm l
3920Proof
3921  rpt strip_tac >>
3922  Cases_on `l = []` >-
3923  rw[MAX_LIST_NIL] >>
3924  qabbrev_tac `ml = MAP ppidx l` >>
3925  `ml <> []` by rw[Abbr`ml`] >>
3926  `MEM (MAX_LIST ml) ml` by rw[MAX_LIST_MEM] >>
3927  `?x. (MAX_LIST ml = ppidx x) /\ MEM x l` by metis_tac[MEM_MAP] >>
3928  `p ** ppidx x divides x` by rw[prime_power_factor_divides] >>
3929  `x divides list_lcm l` by rw[list_lcm_is_common_multiple] >>
3930  metis_tac[DIVIDES_TRANS]
3931QED
3932
3933(* Theorem: prime p /\ POSITIVE l ==> (ppidx (list_lcm l) = MAX_LIST (MAP ppidx l)) *)
3934(* Proof:
3935   By induction on l.
3936   Base: ppidx (list_lcm []) = MAX_LIST (MAP ppidx [])
3937         ppidx (list_lcm [])
3938       = ppidx 1                      by list_lcm_nil
3939       = 0                            by prime_power_index_1
3940       = MAX_LIST []                  by MAX_LIST_NIL
3941       = MAX_LIST (MAP ppidx [])      by MAP
3942
3943   Step: ppidx (list_lcm l) = MAX_LIST (MAP ppidx l) ==>
3944         ppidx (list_lcm (h::l)) = MAX_LIST (MAP ppidx (h::l))
3945       Note 0 < list_lcm l                           by list_lcm_pos, EVERY_MEM
3946         ppidx (list_lcm (h::l))
3947       = ppidx (lcm h (list_lcm l))                  by list_lcm_cons
3948       = MAX (ppidx h) (ppidx (list_lcm l))          by lcm_prime_power_index, 0 < list_lcm l
3949       = MAX (ppidx h) (MAX_LIST (MAP ppidx l))      by induction hypothesis
3950       = MAX_LIST (ppidx h :: MAP ppidx l)           by MAX_LIST_CONS
3951       = MAX_LIST (MAP ppidx (h::l))                 by MAP
3952*)
3953Theorem list_lcm_prime_power_index:
3954    !l p. prime p /\ POSITIVE l ==> (ppidx (list_lcm l) = MAX_LIST (MAP ppidx l))
3955Proof
3956  Induct >-
3957  rw[prime_power_index_1] >>
3958  rpt strip_tac >>
3959  `0 < list_lcm l` by rw[list_lcm_pos, EVERY_MEM] >>
3960  `ppidx (list_lcm (h::l)) = ppidx (lcm h (list_lcm l))` by rw[list_lcm_cons] >>
3961  `_ = MAX (ppidx h) (ppidx (list_lcm l))` by rw[lcm_prime_power_index] >>
3962  `_ = MAX (ppidx h) (MAX_LIST (MAP ppidx l))` by rw[] >>
3963  `_ = MAX_LIST (ppidx h :: MAP ppidx l)` by rw[MAX_LIST_CONS] >>
3964  `_ = MAX_LIST (MAP ppidx (h::l))` by rw[] >>
3965  rw[]
3966QED
3967
3968(* Theorem: prime p /\ POSITIVE l ==>
3969            !k. p ** k divides list_lcm l ==> k <= MAX_LIST (MAP ppidx l) *)
3970(* Proof:
3971   Note 0 < list_lcm l                by list_lcm_pos, EVERY_MEM
3972     so k <= ppidx (list_lcm l)       by prime_power_divisibility
3973     or k <= MAX_LIST (MAP ppidx l)   by list_lcm_prime_power_index
3974*)
3975Theorem list_lcm_prime_power_divisibility:
3976    !l p. prime p /\ POSITIVE l ==>
3977   !k. p ** k divides list_lcm l ==> k <= MAX_LIST (MAP ppidx l)
3978Proof
3979  rpt strip_tac >>
3980  `0 < list_lcm l` by rw[list_lcm_pos, EVERY_MEM] >>
3981  metis_tac[prime_power_divisibility, list_lcm_prime_power_index]
3982QED
3983
3984(* Theorem: prime p /\ l <> [] /\ POSITIVE l ==>
3985            !k. p ** k divides list_lcm l ==> ?x. MEM x l /\ p ** k divides x *)
3986(* Proof:
3987   Let ml = MAP ppidx l.
3988
3989   Step 1: Get member x that attains ppidx x = MAX_LIST ml
3990   Note ml <> []                                  by MAP_EQ_NIL
3991   Then MEM (MAX_LIST ml) ml                      by MAX_LIST_MEM, ml <> []
3992    ==> ?x. (MAX_LIST ml = ppidx x) /\ MEM x l    by MEM_MAP
3993
3994   Step 2: Show that this is a suitable x
3995   Note p ** k divides list_lcm l                 by given
3996    ==> k <= MAX_LIST ml                          by list_lcm_prime_power_divisibility
3997    Now 1 < p                                     by ONE_LT_PRIME
3998     so p ** k divides p ** (MAX_LIST ml)         by power_divides_iff, 1 < p
3999    and p ** (ppidx x) divides x                  by prime_power_factor_divides
4000   Thus p ** k divides x                          by DIVIDES_TRANS
4001
4002   Take this x, and the result follows.
4003*)
4004Theorem list_lcm_prime_power_factor_member:
4005    !l p. prime p /\ l <> [] /\ POSITIVE l ==>
4006   !k. p ** k divides list_lcm l ==> ?x. MEM x l /\ p ** k divides x
4007Proof
4008  rpt strip_tac >>
4009  qabbrev_tac `ml = MAP ppidx l` >>
4010  `ml <> []` by rw[Abbr`ml`] >>
4011  `MEM (MAX_LIST ml) ml` by rw[MAX_LIST_MEM] >>
4012  `?x. (MAX_LIST ml = ppidx x) /\ MEM x l` by metis_tac[MEM_MAP] >>
4013  `k <= MAX_LIST ml` by rw[list_lcm_prime_power_divisibility, Abbr`ml`] >>
4014  `1 < p` by rw[ONE_LT_PRIME] >>
4015  `p ** k divides p ** (MAX_LIST ml)` by rw[power_divides_iff] >>
4016  `p ** (ppidx x) divides x` by rw[prime_power_factor_divides] >>
4017  metis_tac[DIVIDES_TRANS]
4018QED
4019
4020(* Theorem: prime p ==> !m n. (n = p ** SUC (ppidx m)) ==> (lcm n m = p * m) *)
4021(* Proof:
4022   If m = 0,
4023      lcm n 0 = 0           by LCM_0
4024              = p * 0       by MULT_0
4025   If m <> 0, then 0 < m.
4026      Note 0 < n            by PRIME_POS, EXP_POS
4027      Let nq = n DIV p ** (ppidx n), mq = m DIV p ** (ppidx m).
4028      Let k = ppidx m.
4029      Note ppidx n = SUC k  by prime_power_index_prime_power
4030       and nq = 1           by DIVMOD_ID
4031       Now MAX (ppidx n) (ppidx m)
4032         = MAX (SUC k) k              by above
4033         = SUC k                      by MAX_DEF
4034
4035           lcm n m
4036         = p ** MAX (ppidx n) (ppidx m) * (lcm nq mq)    by lcm_prime_power_factor
4037         = p ** (SUC k) * (lcm 1 mq)                     by above
4038         = p ** (SUC k) * mq                             by LCM_1
4039         = p * p ** k * mq                               by EXP
4040         = p * (p ** k * mq)                             by MULT_ASSOC
4041         = p * m                                         by prime_power_eqn
4042*)
4043Theorem lcm_special_for_prime_power:
4044    !p. prime p ==> !m n. (n = p ** SUC (ppidx m)) ==> (lcm n m = p * m)
4045Proof
4046  rpt strip_tac >>
4047  Cases_on `m = 0` >-
4048  rw[] >>
4049  `0 < m` by decide_tac >>
4050  `0 < n` by rw[PRIME_POS, EXP_POS] >>
4051  qabbrev_tac `k = ppidx m` >>
4052  `ppidx n = SUC k` by rw[prime_power_index_prime_power] >>
4053  `MAX (SUC k) k = SUC k` by rw[MAX_DEF] >>
4054  qabbrev_tac `mq = m DIV p ** (ppidx m)` >>
4055  qabbrev_tac `nq = n DIV p ** (ppidx n)` >>
4056  `nq = 1` by rw[DIVMOD_ID, Abbr`nq`] >>
4057  `lcm n m = p ** (SUC k) * (lcm nq mq)` by metis_tac[lcm_prime_power_factor] >>
4058  metis_tac[LCM_1, EXP, MULT_ASSOC, prime_power_eqn]
4059QED
4060
4061(* Theorem: (n = a * b) /\ coprime a b ==> !m. a divides m /\ b divides m ==> (lcm n m = m) *)
4062(* Proof:
4063   If n = 0,
4064      Then a * b = 0 ==> a = 0 or b = 0           by MULT_EQ_0
4065        so a divides m /\ b divides m ==> m = 0   by ZERO_DIVIDES
4066      Since lcm 0 m = 0                           by LCM_0
4067         so lcm n m = m                           by above
4068   If n <> 0,
4069      Note (a * b) divides m                      by coprime_product_divides
4070        or       n divides m                      by n = a * b
4071        so    lcm n m = m                         by divides_iff_lcm_fix
4072*)
4073Theorem lcm_special_for_coprime_factors:
4074  !n a b. n = a * b /\ coprime a b ==>
4075          !m. a divides m /\ b divides m ==> lcm n m = m
4076Proof
4077  rpt strip_tac >> Cases_on `n = 0` >| [
4078    `m = 0` by metis_tac[MULT_EQ_0, ZERO_DIVIDES] >>
4079    simp[LCM_0],
4080    `n divides m` by rw[coprime_product_divides] >>
4081    rw[GSYM divides_iff_lcm_fix]
4082  ]
4083QED
4084
4085(* ------------------------------------------------------------------------- *)
4086(* Prime Divisors                                                            *)
4087(* ------------------------------------------------------------------------- *)
4088
4089(* Define the prime divisors of a number *)
4090Definition prime_divisors_def[nocompute]:
4091    prime_divisors n = {p | prime p /\ p divides n}
4092End
4093(* use zDefine as this is not effective. *)
4094
4095(* Theorem: p IN prime_divisors n <=> prime p /\ p divides n *)
4096(* Proof: by prime_divisors_def *)
4097Theorem prime_divisors_element:
4098    !n p. p IN prime_divisors n <=> prime p /\ p divides n
4099Proof
4100  rw[prime_divisors_def]
4101QED
4102
4103(* Theorem: 0 < n ==> (prime_divisors n) SUBSET (natural n) *)
4104(* Proof:
4105   By prime_divisors_element, SUBSET_DEF,
4106   this is to show: ?x'. (x = SUC x') /\ x' < n
4107   Note prime x /\ x divides n
4108    ==> 0 < x /\ x <= n            by PRIME_POS, DIVIDES_LE, 0 < n
4109    ==> 0 < x /\ PRE x < n         by arithmetic
4110   Take x' = PRE x,
4111   Then SUC x' = SUC (PRE x) = x   by SUC_PRE, 0 < x
4112*)
4113Theorem prime_divisors_subset_natural:
4114    !n. 0 < n ==> (prime_divisors n) SUBSET (natural n)
4115Proof
4116  rw[prime_divisors_element, SUBSET_DEF] >>
4117  `x <= n` by rw[DIVIDES_LE] >>
4118  `PRE x < n` by decide_tac >>
4119  `0 < x` by rw[PRIME_POS] >>
4120  metis_tac[SUC_PRE]
4121QED
4122
4123(* Theorem: 0 < n ==> FINITE (prime_divisors n) *)
4124(* Proof:
4125   Note (prime_divisors n) SUBSET (natural n)  by prime_divisors_subset_natural, 0 < n
4126    and FINITE (natural n)                     by natural_finite
4127     so FINITE (prime_divisors n)              by SUBSET_FINITE
4128*)
4129Theorem prime_divisors_finite:
4130    !n. 0 < n ==> FINITE (prime_divisors n)
4131Proof
4132  metis_tac[prime_divisors_subset_natural, natural_finite, SUBSET_FINITE]
4133QED
4134
4135(* Theorem: prime_divisors 0 = {p | prime p} *)
4136(* Proof: by prime_divisors_def, ALL_DIVIDES_0 *)
4137Theorem prime_divisors_0: prime_divisors 0 = {p | prime p}
4138Proof rw[prime_divisors_def]
4139QED
4140
4141(* Note: prime: num -> bool is also a set, so prime = {p | prime p} *)
4142
4143(* Theorem: prime_divisors n = {} *)
4144(* Proof: by prime_divisors_def, DIVIDES_ONE, NOT_PRIME_1 *)
4145Theorem prime_divisors_1:
4146    prime_divisors 1 = {}
4147Proof
4148  rw[prime_divisors_def, EXTENSION]
4149QED
4150
4151(* Theorem: (prime_divisors n) SUBSET prime *)
4152(* Proof: by prime_divisors_element, SUBSET_DEF, IN_DEF *)
4153Theorem prime_divisors_subset_prime:
4154    !n. (prime_divisors n) SUBSET prime
4155Proof
4156  rw[prime_divisors_element, SUBSET_DEF, IN_DEF]
4157QED
4158
4159(* Theorem: 1 < n ==> prime_divisors n <> {} *)
4160(* Proof:
4161   Note n <> 1                       by 1 < n
4162     so ?p. prime p /\ p divides n   by PRIME_FACTOR
4163     or p IN prime_divisors n        by prime_divisors_element
4164    ==> prime_divisors n <> {}       by MEMBER_NOT_EMPTY
4165*)
4166Theorem prime_divisors_nonempty:
4167    !n. 1 < n ==> prime_divisors n <> {}
4168Proof
4169  metis_tac[PRIME_FACTOR, prime_divisors_element, MEMBER_NOT_EMPTY, DECIDE``1 < n ==> n <> 1``]
4170QED
4171
4172(* Theorem: (prime_divisors n = {}) <=> (n = 1) *)
4173(* Proof: by prime_divisors_def, DIVIDES_ONE, NOT_PRIME_1, PRIME_FACTOR *)
4174Theorem prime_divisors_empty_iff:
4175    !n. (prime_divisors n = {}) <=> (n = 1)
4176Proof
4177  rw[prime_divisors_def, EXTENSION] >>
4178  metis_tac[DIVIDES_ONE, NOT_PRIME_1, PRIME_FACTOR]
4179QED
4180
4181(* Theorem: ~ SING (prime_divisors 0) *)
4182(* Proof:
4183   Let s = prime_divisors 0.
4184   By contradiction, suppose SING s.
4185   Note prime 2                  by PRIME_2
4186    and prime 3                  by PRIME_3
4187     so 2 IN s /\ 3 IN s         by prime_divisors_0
4188   This contradicts SING s       by SING_ELEMENT
4189*)
4190Theorem prime_divisors_0_not_sing:
4191    ~ SING (prime_divisors 0)
4192Proof
4193  rpt strip_tac >>
4194  qabbrev_tac `s = prime_divisors 0` >>
4195  `2 IN s /\ 3 IN s` by rw[PRIME_2, PRIME_3, prime_divisors_0, Abbr`s`] >>
4196  metis_tac[SING_ELEMENT, DECIDE``2 <> 3``]
4197QED
4198
4199(* Theorem: prime n ==> (prime_divisors n = {n}) *)
4200(* Proof:
4201   By prime_divisors_def, EXTENSION, this is to show:
4202      prime x /\ x divides n <=> (x = n)
4203   This is true                      by prime_divides_prime
4204*)
4205Theorem prime_divisors_prime:
4206    !n. prime n ==> (prime_divisors n = {n})
4207Proof
4208  rw[prime_divisors_def, EXTENSION] >>
4209  metis_tac[prime_divides_prime]
4210QED
4211
4212(* Theorem: prime n ==> (prime_divisors n = {n}) *)
4213(* Proof:
4214   By prime_divisors_def, EXTENSION, this is to show:
4215     prime x /\ x divides n ** k <=> (x = n)
4216   If part: prime x /\ x divides n ** k ==> (x = n)
4217      This is true                   by prime_divides_prime_power
4218   Only-if part: prime n /\ 0 < k ==> n divides n ** k
4219      This is true                   by prime_divides_power, DIVIDES_REFL
4220*)
4221Theorem prime_divisors_prime_power:
4222    !n. prime n ==> !k. 0 < k ==> (prime_divisors (n ** k) = {n})
4223Proof
4224  rw[prime_divisors_def, EXTENSION] >>
4225  rw[EQ_IMP_THM] >-
4226  metis_tac[prime_divides_prime_power] >>
4227  metis_tac[prime_divides_power, DIVIDES_REFL]
4228QED
4229
4230(* Theorem: SING (prime_divisors n) <=> ?p k. prime p /\ 0 < k /\ (n = p ** k) *)
4231(* Proof:
4232   If part: SING (prime_divisors n) ==> ?p k. prime p /\ 0 < k /\ (n = p ** k)
4233      Note n <> 0                                       by prime_divisors_0_not_sing
4234      Claim: n <> 1
4235      Proof: By contradiction, suppose n = 1.
4236             Then prime_divisors 1 = {}                 by prime_divisors_1
4237              but SING {} = F                           by SING_EMPTY
4238
4239        Thus 1 < n                                      by n <> 0, n <> 1
4240         ==> ?p. prime p /\ p divides n                 by PRIME_FACTOR
4241        also ?q m. (n = p ** m * q) /\ (coprime p q)    by prime_power_factor, 0 < n
4242        Note q <> 0                                     by MULT_EQ_0
4243      Claim: q = 1
4244      Proof: By contradiction, suppose q <> 1.
4245             Then 1 < q                                 by q <> 0, q <> 1
4246              ==> ?z. prime z /\ z divides q            by PRIME_FACTOR
4247              Now 1 < p                                 by ONE_LT_PRIME
4248               so ~(p divides q)                        by coprime_not_divides, 1 < p, coprime p q
4249               or p <> z                                by z divides q, but ~(p divides q)
4250              But q divides n                           by divides_def, n = p ** m * q
4251             Thus z divides n                           by DIVIDES_TRANS
4252               so p IN (prime_divisors n)               by prime_divisors_element
4253              and z IN (prime_divisors n)               by prime_divisors_element
4254             This contradicts SING (prime_divisors n)   by SING_ELEMENT
4255
4256      Thus q = 1,
4257       ==> n = p ** m                                   by MULT_RIGHT_1
4258       and m <> 0                                       by EXP_0, n <> 1
4259      Thus take this prime p, and exponent m, and 0 < m by NOT_ZERO_LT_ZERO
4260
4261   Only-if part: ?p k. prime p /\ 0 < k /\ (n = p ** k) ==> SING (prime_divisors n)
4262      Note (prime_divisors p ** k) = {p}                by prime_divisors_prime_power
4263        so SING (prime_divisors n)                      by SING_DEF
4264*)
4265Theorem prime_divisors_sing:
4266    !n. SING (prime_divisors n) <=> ?p k. prime p /\ 0 < k /\ (n = p ** k)
4267Proof
4268  rw[EQ_IMP_THM] >| [
4269    `n <> 0` by metis_tac[prime_divisors_0_not_sing] >>
4270    `n <> 1` by metis_tac[prime_divisors_1, SING_EMPTY] >>
4271    `0 < n /\ 1 < n` by decide_tac >>
4272    `?p. prime p /\ p divides n` by rw[PRIME_FACTOR] >>
4273    `?q m. (n = p ** m * q) /\ (coprime p q)` by rw[prime_power_factor] >>
4274    `q <> 0` by metis_tac[MULT_EQ_0] >>
4275    Cases_on `q = 1` >-
4276    metis_tac[MULT_RIGHT_1, EXP_0, NOT_ZERO_LT_ZERO] >>
4277    `?z. prime z /\ z divides q` by rw[PRIME_FACTOR] >>
4278    `1 < p` by rw[ONE_LT_PRIME] >>
4279    `p <> z` by metis_tac[coprime_not_divides] >>
4280    `z divides n` by metis_tac[divides_def, DIVIDES_TRANS] >>
4281    metis_tac[prime_divisors_element, SING_ELEMENT],
4282    metis_tac[prime_divisors_prime_power, SING_DEF]
4283  ]
4284QED
4285
4286(* Theorem: (prime_divisors n = {p}) <=> ?k. prime p /\ 0 < k /\ (n = p ** k) *)
4287(* Proof:
4288   If part: prime_divisors n = {p} ==> ?k. prime p /\ 0 < k /\ (n = p ** k)
4289      Note prime p                                     by prime_divisors_element, IN_SING
4290       and SING (prime_divisors n)                     by SING_DEF
4291       ==> ?q k. prime q /\ 0 < k /\ (n = q ** k)      by prime_divisors_sing
4292      Take this k, then q = p                          by prime_divisors_prime_power, IN_SING
4293   Only-if part: prime p ==> prime_divisors (p ** k) = {p}
4294      This is true                                     by prime_divisors_prime_power
4295*)
4296Theorem prime_divisors_sing_alt:
4297    !n p. (prime_divisors n = {p}) <=> ?k. prime p /\ 0 < k /\ (n = p ** k)
4298Proof
4299  metis_tac[prime_divisors_sing, SING_DEF, IN_SING, prime_divisors_element, prime_divisors_prime_power]
4300QED
4301
4302(* Theorem: SING (prime_divisors n) ==>
4303            let p = CHOICE (prime_divisors n) in prime p /\ (n = p ** ppidx n) *)
4304(* Proof:
4305   Let s = prime_divisors n.
4306   Note n <> 0                    by prime_divisors_0_not_sing
4307    and n <> 1                    by prime_divisors_1, SING_EMPTY
4308    ==> s <> {}                   by prime_divisors_empty_iff, n <> 1
4309   Note p = CHOICE s IN s         by CHOICE_DEF
4310     so prime p /\ p divides n    by prime_divisors_element
4311   Thus need only to show: n = p ** ppidx n
4312   Note ?q. (n = p ** ppidx n * q) /\
4313            coprime p q           by prime_power_factor, prime_power_index_test, 0 < n
4314   Claim: q = 1
4315   Proof: By contradiction, suppose q <> 1.
4316          Note 1 < p                        by ONE_LT_PRIME, prime p
4317           and q <> 0                       by MULT_EQ_0
4318           ==> ?z. prime z /\ z divides q   by PRIME_FACTOR, 1 < q
4319          Note ~(p divides q)               by coprime_not_divides, 1 < p
4320           ==> z <> p                       by z divides q
4321          Also q divides n                  by divides_def, n = p ** ppidx n * q
4322           ==> z divides n                  by DIVIDES_TRANS
4323          Thus p IN s /\ z IN s             by prime_divisors_element
4324            or p = z, contradicts z <> p    by SING_ELEMENT
4325
4326   Thus q = 1, and n = p ** ppidx n         by MULT_RIGHT_1
4327*)
4328Theorem prime_divisors_sing_property:
4329    !n. SING (prime_divisors n) ==>
4330       let p = CHOICE (prime_divisors n) in prime p /\ (n = p ** ppidx n)
4331Proof
4332  ntac 2 strip_tac >>
4333  qabbrev_tac `s = prime_divisors n` >>
4334  `n <> 0` by metis_tac[prime_divisors_0_not_sing] >>
4335  `n <> 1` by metis_tac[prime_divisors_1, SING_EMPTY] >>
4336  `s <> {}` by rw[prime_divisors_empty_iff, Abbr`s`] >>
4337  `prime (CHOICE s) /\ (CHOICE s) divides n` by metis_tac[CHOICE_DEF, prime_divisors_element] >>
4338  rw_tac std_ss[] >>
4339  rw[] >>
4340  `0 < n` by decide_tac >>
4341  `?q. (n = p ** ppidx n * q) /\ coprime p q` by metis_tac[prime_power_factor, prime_power_index_test] >>
4342  reverse (Cases_on `q = 1`) >| [
4343    `q <> 0` by metis_tac[MULT_EQ_0] >>
4344    `?z. prime z /\ z divides q` by rw[PRIME_FACTOR] >>
4345    `z <> p` by metis_tac[coprime_not_divides, ONE_LT_PRIME] >>
4346    `z divides n` by metis_tac[divides_def, DIVIDES_TRANS] >>
4347    metis_tac[prime_divisors_element, SING_ELEMENT],
4348    rw[]
4349  ]
4350QED
4351
4352(* Theorem: m divides n ==> (prime_divisors m) SUBSET (prime_divisors n) *)
4353(* Proof:
4354   Note !x. x IN prime_divisors m
4355    ==>     prime x /\ x divides m    by prime_divisors_element
4356    ==>     primx x /\ x divides n    by DIVIDES_TRANS
4357    ==>     x IN prime_divisors n     by prime_divisors_element
4358     or (prime_divisors m) SUBSET (prime_divisors n)   by SUBSET_DEF
4359*)
4360Theorem prime_divisors_divisor_subset:
4361    !m n. m divides n ==> (prime_divisors m) SUBSET (prime_divisors n)
4362Proof
4363  rw[prime_divisors_element, SUBSET_DEF] >>
4364  metis_tac[DIVIDES_TRANS]
4365QED
4366
4367(* Theorem: x divides m /\ x divides n ==>
4368            (prime_divisors x SUBSET (prime_divisors m) INTER (prime_divisors n)) *)
4369(* Proof:
4370   By prime_divisors_element, SUBSET_DEF, this is to show:
4371   (1) x' divides x /\ x divides m ==> x' divides m, true   by DIVIDES_TRANS
4372   (2) x' divides x /\ x divides n ==> x' divides n, true   by DIVIDES_TRANS
4373*)
4374Theorem prime_divisors_common_divisor:
4375    !n m x. x divides m /\ x divides n ==>
4376           (prime_divisors x SUBSET (prime_divisors m) INTER (prime_divisors n))
4377Proof
4378  rw[prime_divisors_element, SUBSET_DEF] >>
4379  metis_tac[DIVIDES_TRANS]
4380QED
4381
4382(* Theorem: m divides x /\ n divides x ==>
4383            (prime_divisors m UNION prime_divisors n) SUBSET prime_divisors x *)
4384(* Proof:
4385   By prime_divisors_element, SUBSET_DEF, this is to show:
4386   (1) x' divides m /\ m divides x ==> x' divides x, true   by DIVIDES_TRANS
4387   (2) x' divides n /\ n divides x ==> x' divides x, true   by DIVIDES_TRANS
4388*)
4389Theorem prime_divisors_common_multiple:
4390    !n m x. m divides x /\ n divides x ==>
4391           (prime_divisors m UNION prime_divisors n) SUBSET prime_divisors x
4392Proof
4393  rw[prime_divisors_element, SUBSET_DEF] >>
4394  metis_tac[DIVIDES_TRANS]
4395QED
4396
4397(* Theorem: 0 < m /\ 0 < n /\ x divides m /\ x divides n ==>
4398            !p. prime p ==> ppidx x <= MIN (ppidx m) (ppidx n) *)
4399(* Proof:
4400   Note ppidx x <= ppidx m                    by prime_power_index_of_divisor, 0 < m
4401    and ppidx x <= ppidx n                    by prime_power_index_of_divisor, 0 < n
4402    ==> ppidx x <= MIN (ppidx m) (ppidx n)    by MIN_LE
4403*)
4404Theorem prime_power_index_common_divisor:
4405    !n m x. 0 < m /\ 0 < n /\ x divides m /\ x divides n ==>
4406   !p. prime p ==> ppidx x <= MIN (ppidx m) (ppidx n)
4407Proof
4408  rw[MIN_LE, prime_power_index_of_divisor]
4409QED
4410
4411(* Theorem: 0 < x /\ m divides x /\ n divides x ==>
4412            !p. prime p ==> MAX (ppidx m) (ppidx n) <= ppidx x *)
4413(* Proof:
4414   Note ppidx m <= ppidx x                    by prime_power_index_of_divisor, 0 < x
4415    and ppidx n <= ppidx x                    by prime_power_index_of_divisor, 0 < x
4416    ==> MAX (ppidx m) (ppidx n) <= ppidx x    by MAX_LE
4417*)
4418Theorem prime_power_index_common_multiple:
4419    !n m x. 0 < x /\ m divides x /\ n divides x ==>
4420   !p. prime p ==> MAX (ppidx m) (ppidx n) <= ppidx x
4421Proof
4422  rw[MAX_LE, prime_power_index_of_divisor]
4423QED
4424
4425(*
4426prime p = 2,    n = 10,   LOG 2 10 = 3, but ppidx 10 = 1, since 4 cannot divide 10.
442710 = 2^1 * 5^1
4428*)
4429
4430(* Theorem: 0 < n /\ prime p ==> ppidx n <= LOG p n *)
4431(* Proof:
4432   By contradiction, suppose LOG p n < ppidx n.
4433   Then SUC (LOG p n) <= ppidx n                    by arithmetic
4434   Note 1 < p                                       by ONE_LT_PRIME
4435     so p ** (SUC (LOG p n)) divides p ** ppidx n   by power_divides_iff, 1 < p
4436    But p ** ppidx n divides n                      by prime_power_index_def
4437    ==> p ** SUC (LOG p n) divides n                by DIVIDES_TRANS
4438     or p ** SUC (LOG p n) <= n                     by DIVIDES_LE, 0 < n
4439   This contradicts n < p ** SUC (LOG p n)          by LOG, 0 < n, 1 < p
4440*)
4441Theorem prime_power_index_le_log_index:
4442    !n p. 0 < n /\ prime p ==> ppidx n <= LOG p n
4443Proof
4444  spose_not_then strip_assume_tac >>
4445  `SUC (LOG p n) <= ppidx n` by decide_tac >>
4446  `1 < p` by rw[ONE_LT_PRIME] >>
4447  `p ** (SUC (LOG p n)) divides p ** ppidx n` by rw[power_divides_iff] >>
4448  `p ** ppidx n divides n` by rw[prime_power_index_def] >>
4449  `p ** SUC (LOG p n) divides n` by metis_tac[DIVIDES_TRANS] >>
4450  `p ** SUC (LOG p n) <= n` by rw[DIVIDES_LE] >>
4451  `n < p ** SUC (LOG p n)` by rw[LOG] >>
4452  decide_tac
4453QED
4454
4455(* ------------------------------------------------------------------------- *)
4456(* Prime-related Sets                                                        *)
4457(* ------------------------------------------------------------------------- *)
4458
4459(*
4460Example: Take n = 10.
4461primes_upto 10 = {2; 3; 5; 7}
4462prime_powers_upto 10 = {8; 9; 5; 7}
4463SET_TO_LIST (prime_powers_upto 10) = [8; 9; 5; 7]
4464set_lcm (prime_powers_upto 10) = 2520
4465lcm_run 10 = 2520
4466
4467Given n,
4468First get (primes_upto n) = {p | prime p /\ p <= n}
4469For each prime p, map to p ** LOG p n.
4470
4471logroot.LOG  |- !a n. 1 < a /\ 0 < n ==> a ** LOG a n <= n /\ n < a ** SUC (LOG a n)
4472*)
4473
4474(* val _ = clear_overloads_on "pd"; in Mobius theory *)
4475(* open primePowerTheory; *)
4476
4477(*
4478> prime_power_index_def;
4479val it = |- !p n. 0 < n /\ prime p ==> p ** ppidx n divides n /\ coprime p (n DIV p ** ppidx n): thm
4480*)
4481
4482(* Define the set of primes up to n *)
4483Definition primes_upto_def:
4484    primes_upto n = {p | prime p /\ p <= n}
4485End
4486
4487(* Overload the counts of primes up to n *)
4488Overload primes_count = ``\n. CARD (primes_upto n)``
4489
4490(* Define the prime powers up to n *)
4491Definition prime_powers_upto_def:
4492    prime_powers_upto n = IMAGE (\p. p ** LOG p n) (primes_upto n)
4493End
4494
4495(* Define the prime power divisors of n *)
4496Definition prime_power_divisors_def:
4497    prime_power_divisors n = IMAGE (\p. p ** ppidx n) (prime_divisors n)
4498End
4499
4500(* Theorem: p IN primes_upto n <=> prime p /\ p <= n *)
4501(* Proof: by primes_upto_def *)
4502Theorem primes_upto_element:
4503    !n p. p IN primes_upto n <=> prime p /\ p <= n
4504Proof
4505  rw[primes_upto_def]
4506QED
4507
4508(* Theorem: (primes_upto n) SUBSET (natural n) *)
4509(* Proof:
4510   By primes_upto_def, SUBSET_DEF,
4511   this is to show: prime x /\ x <= n ==> ?x'. (x = SUC x') /\ x' < n
4512   Note 0 < x            by PRIME_POS, prime x
4513     so PRE x < n        by x <= n
4514    and SUC (PRE x) = x  by SUC_PRE, 0 < x
4515   Take x' = PRE x, and the result follows.
4516*)
4517Theorem primes_upto_subset_natural:
4518    !n. (primes_upto n) SUBSET (natural n)
4519Proof
4520  rw[primes_upto_def, SUBSET_DEF] >>
4521  `0 < x` by rw[PRIME_POS] >>
4522  `PRE x < n` by decide_tac >>
4523  metis_tac[SUC_PRE]
4524QED
4525
4526(* Theorem: FINITE (primes_upto n) *)
4527(* Proof:
4528   Note (primes_upto n) SUBSET (natural n)   by primes_upto_subset_natural
4529    and FINITE (natural n)                   by natural_finite
4530    ==> FINITE (primes_upto n)               by SUBSET_FINITE
4531*)
4532Theorem primes_upto_finite:
4533    !n. FINITE (primes_upto n)
4534Proof
4535  metis_tac[primes_upto_subset_natural, natural_finite, SUBSET_FINITE]
4536QED
4537
4538(* Theorem: PAIRWISE_COPRIME (primes_upto n) *)
4539(* Proof:
4540   Let s = prime_power_divisors n
4541   This is to show: prime x /\ prime y /\ x <> y ==> coprime x y
4542   This is true                by primes_coprime
4543*)
4544Theorem primes_upto_pairwise_coprime:
4545    !n. PAIRWISE_COPRIME (primes_upto n)
4546Proof
4547  metis_tac[primes_upto_element, primes_coprime]
4548QED
4549
4550(* Theorem: primes_upto 0 = {} *)
4551(* Proof:
4552       p IN primes_upto 0
4553   <=> prime p /\ p <= 0     by primes_upto_element
4554   <=> prime 0               by p <= 0
4555   <=> F                     by NOT_PRIME_0
4556*)
4557Theorem primes_upto_0:
4558    primes_upto 0 = {}
4559Proof
4560  rw[primes_upto_element, EXTENSION]
4561QED
4562
4563(* Theorem: primes_count 0 = 0 *)
4564(* Proof:
4565     primes_count 0
4566   = CARD (primes_upto 0)     by notation
4567   = CARD {}                  by primes_upto_0
4568   = 0                        by CARD_EMPTY
4569*)
4570Theorem primes_count_0:
4571    primes_count 0 = 0
4572Proof
4573  rw[primes_upto_0]
4574QED
4575
4576(* Theorem: primes_upto 1 = {} *)
4577(* Proof:
4578       p IN primes_upto 1
4579   <=> prime p /\ p <= 1     by primes_upto_element
4580   <=> prime 0 or prime 1    by p <= 1
4581   <=> F                     by NOT_PRIME_0, NOT_PRIME_1
4582*)
4583Theorem primes_upto_1:
4584    primes_upto 1 = {}
4585Proof
4586  rw[primes_upto_element, EXTENSION, DECIDE``x <= 1 <=> (x = 0) \/ (x = 1)``] >>
4587  metis_tac[NOT_PRIME_0, NOT_PRIME_1]
4588QED
4589
4590(* Theorem: primes_count 1 = 0 *)
4591(* Proof:
4592     primes_count 1
4593   = CARD (primes_upto 1)     by notation
4594   = CARD {}                  by primes_upto_1
4595   = 0                        by CARD_EMPTY
4596*)
4597Theorem primes_count_1:
4598    primes_count 1 = 0
4599Proof
4600  rw[primes_upto_1]
4601QED
4602
4603(* Theorem: x IN prime_powers_upto n <=> ?p. (x = p ** LOG p n) /\ prime p /\ p <= n *)
4604(* Proof: by prime_powers_upto_def, primes_upto_element *)
4605Theorem prime_powers_upto_element:
4606    !n x. x IN prime_powers_upto n <=> ?p. (x = p ** LOG p n) /\ prime p /\ p <= n
4607Proof
4608  rw[prime_powers_upto_def, primes_upto_element]
4609QED
4610
4611(* Theorem: prime p /\ p <= n ==> (p ** LOG p n) IN (prime_powers_upto n) *)
4612(* Proof: by prime_powers_upto_element *)
4613Theorem prime_powers_upto_element_alt:
4614    !p n. prime p /\ p <= n ==> (p ** LOG p n) IN (prime_powers_upto n)
4615Proof
4616  metis_tac[prime_powers_upto_element]
4617QED
4618
4619(* Theorem: FINITE (prime_powers_upto n) *)
4620(* Proof:
4621   Note prime_powers_upto n =
4622        IMAGE (\p. p ** LOG p n) (primes_upto n)   by prime_powers_upto_def
4623    and FINITE (primes_upto n)                     by primes_upto_finite
4624    ==> FINITE (prime_powers_upto n)               by IMAGE_FINITE
4625*)
4626Theorem prime_powers_upto_finite:
4627    !n. FINITE (prime_powers_upto n)
4628Proof
4629  rw[prime_powers_upto_def, primes_upto_finite]
4630QED
4631
4632(* Theorem: PAIRWISE_COPRIME (prime_powers_upto n) *)
4633(* Proof:
4634   Let s = prime_power_divisors n
4635   This is to show: x IN s /\ y IN s /\ x <> y ==> coprime x y
4636   Note ?p1. prime p1 /\ (x = p1 ** LOG p1 n) /\ p1 <= n   by prime_powers_upto_element
4637    and ?p2. prime p2 /\ (y = p2 ** LOG p2 n) /\ p2 <= n   by prime_powers_upto_element
4638    and p1 <> p2                                           by prime_powers_eq
4639   Thus coprime x y                                        by prime_powers_coprime
4640*)
4641Theorem prime_powers_upto_pairwise_coprime:
4642    !n. PAIRWISE_COPRIME (prime_powers_upto n)
4643Proof
4644  metis_tac[prime_powers_upto_element, prime_powers_eq, prime_powers_coprime]
4645QED
4646
4647(* Theorem: prime_powers_upto 0 = {} *)
4648(* Proof:
4649       x IN prime_powers_upto 0
4650   <=> ?p. (x = p ** LOG p n) /\ prime p /\ p <= 0     by prime_powers_upto_element
4651   <=> ?p. (x = p ** LOG p n) /\ prime 0               by p <= 0
4652   <=> F                                               by NOT_PRIME_0
4653*)
4654Theorem prime_powers_upto_0:
4655    prime_powers_upto 0 = {}
4656Proof
4657  rw[prime_powers_upto_element, EXTENSION]
4658QED
4659
4660(* Theorem: prime_powers_upto 1 = {} *)
4661(* Proof:
4662       x IN prime_powers_upto 1
4663   <=> ?p. (x = p ** LOG p n) /\ prime p /\ p <= 1     by prime_powers_upto_element
4664   <=> ?p. (x = p ** LOG p n) /\ prime 0 or prime 1    by p <= 0
4665   <=> F                                               by NOT_PRIME_0, NOT_PRIME_1
4666*)
4667Theorem prime_powers_upto_1:
4668    prime_powers_upto 1 = {}
4669Proof
4670  rw[prime_powers_upto_element, EXTENSION, DECIDE``x <= 1 <=> (x = 0) \/ (x = 1)``] >>
4671  metis_tac[NOT_PRIME_0, NOT_PRIME_1]
4672QED
4673
4674(* Theorem: x IN prime_power_divisors n <=> ?p. (x = p ** ppidx n) /\ prime p /\ p divides n *)
4675(* Proof: by prime_power_divisors_def, prime_divisors_element *)
4676Theorem prime_power_divisors_element:
4677    !n x. x IN prime_power_divisors n <=> ?p. (x = p ** ppidx n) /\ prime p /\ p divides n
4678Proof
4679  rw[prime_power_divisors_def, prime_divisors_element]
4680QED
4681
4682(* Theorem: prime p /\ p divides n ==> (p ** ppidx n) IN (prime_power_divisors n) *)
4683(* Proof: by prime_power_divisors_element *)
4684Theorem prime_power_divisors_element_alt:
4685    !p n. prime p /\ p divides n ==> (p ** ppidx n) IN (prime_power_divisors n)
4686Proof
4687  metis_tac[prime_power_divisors_element]
4688QED
4689
4690(* Theorem: 0 < n ==> FINITE (prime_power_divisors n) *)
4691(* Proof:
4692   Note prime_power_divisors n =
4693        IMAGE (\p. p ** ppidx n) (prime_divisors n)   by prime_power_divisors_def
4694    and FINITE (prime_divisors n)                     by prime_divisors_finite, 0 < n
4695    ==> FINITE (prime_power_divisors n)               by IMAGE_FINITE
4696*)
4697Theorem prime_power_divisors_finite:
4698    !n. 0 < n ==> FINITE (prime_power_divisors n)
4699Proof
4700  rw[prime_power_divisors_def, prime_divisors_finite]
4701QED
4702
4703(* Theorem: PAIRWISE_COPRIME (prime_power_divisors n) *)
4704(* Proof:
4705   Let s = prime_power_divisors n
4706   This is to show: x IN s /\ y IN s /\ x <> y ==> coprime x y
4707   Note ?p1. prime p1 /\
4708             (x = p1 ** prime_power_index p1 n) /\ p1 divides n   by prime_power_divisors_element
4709    and ?p2. prime p2 /\
4710             (y = p2 ** prime_power_index p2 n) /\ p2 divides n   by prime_power_divisors_element
4711    and p1 <> p2                                                  by prime_powers_eq
4712   Thus coprime x y                                               by prime_powers_coprime
4713*)
4714Theorem prime_power_divisors_pairwise_coprime:
4715    !n. PAIRWISE_COPRIME (prime_power_divisors n)
4716Proof
4717  metis_tac[prime_power_divisors_element, prime_powers_eq, prime_powers_coprime]
4718QED
4719
4720(* Theorem: prime_power_divisors 1 = {} *)
4721(* Proof:
4722       x IN prime_power_divisors 1
4723   <=> ?p. (x = p ** ppidx n) /\ prime p /\ p divides 1     by prime_power_divisors_element
4724   <=> ?p. (x = p ** ppidx n) /\ prime 1                    by DIVIDES_ONE
4725   <=> F                                                    by NOT_PRIME_1
4726*)
4727Theorem prime_power_divisors_1:
4728    prime_power_divisors 1 = {}
4729Proof
4730  rw[prime_power_divisors_element, EXTENSION]
4731QED
4732
4733(* ------------------------------------------------------------------------- *)
4734(* Factorisations                                                            *)
4735(* ------------------------------------------------------------------------- *)
4736
4737(* Theorem: 0 < n ==> (n = PROD_SET (prime_power_divisors n)) *)
4738(* Proof:
4739   Let s = prime_power_divisors n.
4740   The goal becomes: n = PROD_SET s
4741   Note FINITE s                       by prime_power_divisors_finite
4742
4743   Claim: (PROD_SET s) divides n
4744   Proof: Note !z. z IN s <=>
4745               ?p. (z = p ** ppidx n) /\ prime p /\ p divides n     by prime_power_divisors_element
4746           ==> !z. z IN s ==> z divides n       by prime_power_index_def
4747
4748          Note PAIRWISE_COPRIME s               by prime_power_divisors_pairwise_coprime
4749          Thus set_lcm s = PROD_SET s           by pairwise_coprime_prod_set_eq_set_lcm
4750           But (set_lcm s) divides n            by set_lcm_is_least_common_multiple
4751           ==> PROD_SET s divides n             by above
4752
4753   Therefore, ?q. n = q * PROD_SET s            by divides_def, Claim.
4754   Claim: q = 1
4755   Proof: By contradiction, suppose q <> 1.
4756          Then ?p. prime p /\ p divides q       by PRIME_FACTOR
4757          Let u = p ** ppidx n, v = n DIV u.
4758          Then u divides n /\ coprime p v       by prime_power_index_def, 0 < n, prime p
4759          Note 0 < p                            by PRIME_POS
4760           ==> 0 < u                            by EXP_POS, 0 < p
4761          Thus n = v * u                        by DIVIDES_EQN, 0 < u
4762
4763          Claim: u divides (PROD_SET s)
4764          Proof: Note q divides n               by divides_def, MULT_COMM
4765                  ==> p divides n               by DIVIDES_TRANS
4766                  ==> p IN (prime_divisors n)   by prime_divisors_element
4767                  ==> u IN s                    by prime_power_divisors_element_alt
4768                 Thus u divides (PROD_SET s)    by PROD_SET_ELEMENT_DIVIDES, FINITE s
4769
4770          Hence ?t. PROD_SET s = t * u          by divides_def, u divides (PROD_SET s)
4771             or v * u = n = q * (t * u)         by above
4772                          = (q * t) * u         by MULT_ASSOC
4773           ==> v = q * t                        by MULT_RIGHT_CANCEL, NOT_ZERO_LT_ZERO
4774           But p divideq q                      by above
4775           ==> p divides v                      by DIVIDES_MULT
4776          Note 1 < p                            by ONE_LT_PRIME
4777           ==> ~(coprime p v)                   by coprime_not_divides
4778          This contradicts coprime p v.
4779
4780   Thus n = q * PROD_SET s, and q = 1           by Claim
4781     or n = PROD_SET s                          by MULT_LEFT_1
4782*)
4783Theorem prime_factorisation:
4784    !n. 0 < n ==> (n = PROD_SET (prime_power_divisors n))
4785Proof
4786  rpt strip_tac >>
4787  qabbrev_tac `s = prime_power_divisors n` >>
4788  `FINITE s` by rw[prime_power_divisors_finite, Abbr`s`] >>
4789  `(PROD_SET s) divides n` by
4790  (`!z. z IN s ==> z divides n` by metis_tac[prime_power_divisors_element, prime_power_index_def] >>
4791  `PAIRWISE_COPRIME s` by metis_tac[prime_power_divisors_pairwise_coprime, Abbr`s`] >>
4792  metis_tac[pairwise_coprime_prod_set_eq_set_lcm, set_lcm_is_least_common_multiple]) >>
4793  `?q. n = q * PROD_SET s` by rw[GSYM divides_def] >>
4794  `q = 1` by
4795    (spose_not_then strip_assume_tac >>
4796  `?p. prime p /\ p divides q` by rw[PRIME_FACTOR] >>
4797  qabbrev_tac `u = p ** ppidx n` >>
4798  qabbrev_tac `v = n DIV u` >>
4799  `u divides n /\ coprime p v` by rw[prime_power_index_def, Abbr`u`, Abbr`v`] >>
4800  `0 < u` by rw[EXP_POS, PRIME_POS, Abbr`u`] >>
4801  `n = v * u` by rw[GSYM DIVIDES_EQN, Abbr`v`] >>
4802  `u divides (PROD_SET s)` by
4803      (`p divides n` by metis_tac[divides_def, MULT_COMM, DIVIDES_TRANS] >>
4804  `p IN (prime_divisors n)` by rw[prime_divisors_element] >>
4805  `u IN s` by metis_tac[prime_power_divisors_element_alt] >>
4806  rw[PROD_SET_ELEMENT_DIVIDES]) >>
4807  `?t. PROD_SET s = t * u` by rw[GSYM divides_def] >>
4808  `v = q * t` by metis_tac[MULT_RIGHT_CANCEL, MULT_ASSOC, NOT_ZERO_LT_ZERO] >>
4809  `p divides v` by rw[DIVIDES_MULT] >>
4810  `1 < p` by rw[ONE_LT_PRIME] >>
4811  metis_tac[coprime_not_divides]) >>
4812  rw[]
4813QED
4814
4815(* This is a little milestone theorem. *)
4816
4817(* Theorem: 0 < n ==> (n = PROD_SET (IMAGE (\p. p ** ppidx n) (prime_divisors n))) *)
4818(* Proof: by prime_factorisation, prime_power_divisors_def *)
4819Theorem basic_prime_factorisation:
4820    !n. 0 < n ==> (n = PROD_SET (IMAGE (\p. p ** ppidx n) (prime_divisors n)))
4821Proof
4822  rw[prime_factorisation, GSYM prime_power_divisors_def]
4823QED
4824
4825(* Theorem: 0 < n /\ m divides n ==> (m = PROD_SET (IMAGE (\p. p ** ppidx m) (prime_divisors n))) *)
4826(* Proof:
4827   Note 0 < m                 by ZERO_DIVIDES, 0 < n
4828   Let s = prime_divisors n, t = IMAGE (\p. p ** ppidx m) s.
4829   The goal is: m = PROD_SET t
4830
4831   Note FINITE s              by prime_divisors_finite
4832    ==> FINITE t              by IMAGE_FINITE
4833    and PAIRWISE_COPRIME t    by prime_divisors_element, prime_powers_coprime
4834
4835   By DIVIDES_ANTISYM, this is to show:
4836   (1) m divides PROD_SET t
4837       Let r = prime_divisors m
4838       Then m = PROD_SET (IMAGE (\p. p ** ppidx m) r)  by basic_prime_factorisation
4839        and r SUBSET s                                 by prime_divisors_divisor_subset
4840        ==> (IMAGE (\p. p ** ppidx m) r) SUBSET t      by IMAGE_SUBSET
4841        ==> m divides PROD_SET t                       by pairwise_coprime_prod_set_subset_divides
4842   (2) PROD_SET t divides m
4843       Claim: !x. x IN t ==> x divides m
4844       Proof: Note ?p. p IN s /\ (x = p ** (ppidx m))  by IN_IMAGE
4845               and prime p                             by prime_divisors_element
4846                so 1 < p                               by ONE_LT_PRIME
4847               Now p ** ppidx m divides m              by prime_power_factor_divides
4848                or x divides m                         by above
4849       Hence PROD_SET t divides m                      by pairwise_coprime_prod_set_divides
4850*)
4851Theorem divisor_prime_factorisation:
4852    !m n. 0 < n /\ m divides n ==> (m = PROD_SET (IMAGE (\p. p ** ppidx m) (prime_divisors n)))
4853Proof
4854  rpt strip_tac >>
4855  `0 < m` by metis_tac[ZERO_DIVIDES, NOT_ZERO_LT_ZERO] >>
4856  qabbrev_tac `s = prime_divisors n` >>
4857  qabbrev_tac `t = IMAGE (\p. p ** ppidx m) s` >>
4858  `FINITE s` by rw[prime_divisors_finite, Abbr`s`] >>
4859  `FINITE t` by rw[Abbr`t`] >>
4860  `PAIRWISE_COPRIME t` by
4861  (rw[Abbr`t`] >>
4862  `prime p /\ prime p' /\ p <> p'` by metis_tac[prime_divisors_element] >>
4863  rw[prime_powers_coprime]) >>
4864  (irule DIVIDES_ANTISYM >> rpt conj_tac) >| [
4865    qabbrev_tac `r = prime_divisors m` >>
4866    `m = PROD_SET (IMAGE (\p. p ** ppidx m) r)` by rw[basic_prime_factorisation, Abbr`r`] >>
4867    `r SUBSET s` by rw[prime_divisors_divisor_subset, Abbr`r`, Abbr`s`] >>
4868    metis_tac[pairwise_coprime_prod_set_subset_divides, IMAGE_SUBSET],
4869    `!x. x IN t ==> x divides m` by
4870  (rpt strip_tac >>
4871    qabbrev_tac `f = \p:num. p ** (ppidx m)` >>
4872    `?p. p IN s /\ (x = p ** (ppidx m))` by metis_tac[IN_IMAGE] >>
4873    `prime p` by metis_tac[prime_divisors_element] >>
4874    rw[prime_power_factor_divides]) >>
4875    rw[pairwise_coprime_prod_set_divides]
4876  ]
4877QED
4878
4879(* Theorem: 0 < m /\ 0 < n ==>
4880           (gcd m n = PROD_SET (IMAGE (\p. p ** (MIN (ppidx m) (ppidx n)))
4881                               ((prime_divisors m) INTER (prime_divisors n)))) *)
4882(* Proof:
4883   Let sm = prime_divisors m, sn = prime_divisors n, s = sm INTER sn.
4884   Let tm = IMAGE (\p. p ** ppidx m) sm, tn = IMAGE (\p. p ** ppidx m) sn,
4885        t = IMAGE (\p. p ** MIN (ppidx m) (ppidx n)) s.
4886   The goal is: gcd m n = PROD_SET t
4887
4888   By GCD_PROPERTY, this is to show:
4889   (1) PROD_SET t divides m /\ PROD_SET t divides n
4890       Note FINITE sm /\ FINITE sn              by prime_divisors_finite
4891        ==> FINITE s                            by FINITE_INTER
4892        and FINITE tm /\ FINITE tn /\ FINITE t  by IMAGE_FINITE
4893       Also PAIRWISE_COPRIME t                  by IN_INTER, prime_divisors_element, prime_powers_coprime
4894
4895       Claim: !x. x IN t ==> x divides m /\ x divides n
4896       Prood: Note x IN t
4897               ==> ?p. p IN s /\ x = p ** MIN (ppidx m) (ppidx n)   by IN_IMAGE
4898               ==> p IN sm /\ p IN sn                               by IN_INTER
4899              Note prime p                      by prime_divisors_element
4900               ==> p ** ppidx m divides m       by prime_power_factor_divides
4901               and p ** ppidx n divides n       by prime_power_factor_divides
4902              Note MIN (ppidx m) (ppidx n) <= ppidx m   by MIN_DEF
4903               and MIN (ppidx m) (ppidx n) <= ppidx n   by MIN_DEF
4904               ==> x divides p ** ppidx m       by prime_power_divides_iff
4905               and x divides p ** ppidx n       by prime_power_divides_iff
4906                or x divides m /\ x divides n   by DIVIDES_TRANS
4907
4908      Therefore, PROD_SET t divides m           by pairwise_coprime_prod_set_divides, Claim
4909             and PROD_SET t divides n           by pairwise_coprime_prod_set_divides, Claim
4910
4911   (2) !x. x divides m /\ x divides n ==> x divides PROD_SET t
4912       Let k = PROD_SET t, sx = prime_divisors x, tx = IMAGE (\p. p ** ppidx x) sx.
4913       Note 0 < x                    by ZERO_DIVIDES, 0 < m
4914        and x = PROD_SET tx          by basic_prime_factorisation, 0 < x
4915       The aim is to show: PROD_SET tx divides k
4916
4917       Note FINITE sx                by prime_divisors_finite
4918        ==> FINITE tx                by IMAGE_FINITE
4919        and PAIRWISE_COPRIME tx      by prime_divisors_element, prime_powers_coprime
4920
4921       Claim: !z. z IN tx ==> z divides k
4922       Proof: Note z IN tx
4923               ==> ?p. p IN sx /\ (z = p ** ppidx x)       by IN_IMAGE
4924              Note prime p                                 by prime_divisors_element
4925               and sx SUBSET sm /\ sx SUBSET sn            by prime_divisors_divisor_subset, x | m, x | n
4926               ==> p IN sm /\ p IN sn                      by SUBSET_DEF
4927                or p IN s                                  by IN_INTER
4928              Also ppidx x <= MIN (ppidx m) (ppidx n)      by prime_power_index_common_divisor
4929               ==> z divides p ** MIN (ppidx m) (ppidx n)  by prime_power_divides_iff
4930               But p ** MIN (ppidx m) (ppidx n) IN t       by IN_IMAGE
4931               ==> p ** MIN (ppidx m) (ppidx n) divides k  by PROD_SET_ELEMENT_DIVIDES
4932                or z divides k                             by DIVIDES_TRANS
4933
4934       Therefore, PROD_SET tx divides k                    by pairwise_coprime_prod_set_divides
4935*)
4936Theorem gcd_prime_factorisation:
4937    !m n. 0 < m /\ 0 < n ==>
4938         (gcd m n = PROD_SET (IMAGE (\p. p ** (MIN (ppidx m) (ppidx n)))
4939                             ((prime_divisors m) INTER (prime_divisors n))))
4940Proof
4941  rpt strip_tac >>
4942  qabbrev_tac `sm = prime_divisors m` >>
4943  qabbrev_tac `sn = prime_divisors n` >>
4944  qabbrev_tac `s = sm INTER sn` >>
4945  qabbrev_tac `tm = IMAGE (\p. p ** ppidx m) sm` >>
4946  qabbrev_tac `tn = IMAGE (\p. p ** ppidx m) sn` >>
4947  qabbrev_tac `t = IMAGE (\p. p ** MIN (ppidx m) (ppidx n)) s` >>
4948  `FINITE sm /\ FINITE sn /\ FINITE s` by rw[prime_divisors_finite, Abbr`sm`, Abbr`sn`, Abbr`s`] >>
4949  `FINITE tm /\ FINITE tn /\ FINITE t` by rw[Abbr`tm`, Abbr`tn`, Abbr`t`] >>
4950  `PAIRWISE_COPRIME t` by
4951  (rw[Abbr`t`] >>
4952  `prime p /\ prime p' /\ p <> p'` by metis_tac[prime_divisors_element, IN_INTER] >>
4953  rw[prime_powers_coprime]) >>
4954  `!x. x IN t ==> x divides m /\ x divides n` by
4955    (ntac 2 strip_tac >>
4956  qabbrev_tac `f = \p:num. p ** MIN (ppidx m) (ppidx n)` >>
4957  `?p. p IN s /\ p IN sm /\ p IN sn /\ (x = p ** MIN (ppidx m) (ppidx n))` by metis_tac[IN_IMAGE, IN_INTER] >>
4958  `prime p` by metis_tac[prime_divisors_element] >>
4959  `p ** ppidx m divides m /\ p ** ppidx n divides n` by rw[prime_power_factor_divides] >>
4960  `MIN (ppidx m) (ppidx n) <= ppidx m /\ MIN (ppidx m) (ppidx n) <= ppidx n` by rw[] >>
4961  metis_tac[prime_power_divides_iff, DIVIDES_TRANS]) >>
4962  rw[GCD_PROPERTY] >-
4963  rw[pairwise_coprime_prod_set_divides] >-
4964  rw[pairwise_coprime_prod_set_divides] >>
4965  qabbrev_tac `k = PROD_SET t` >>
4966  qabbrev_tac `sx = prime_divisors x` >>
4967  qabbrev_tac `tx = IMAGE (\p. p ** ppidx x) sx` >>
4968  `0 < x` by metis_tac[ZERO_DIVIDES, NOT_ZERO_LT_ZERO] >>
4969  `x = PROD_SET tx` by rw[basic_prime_factorisation, Abbr`tx`, Abbr`sx`] >>
4970  `FINITE sx` by rw[prime_divisors_finite, Abbr`sx`] >>
4971  `FINITE tx` by rw[Abbr`tx`] >>
4972  `PAIRWISE_COPRIME tx` by
4973  (rw[Abbr`tx`] >>
4974  `prime p /\ prime p' /\ p <> p'` by metis_tac[prime_divisors_element] >>
4975  rw[prime_powers_coprime]) >>
4976  `!z. z IN tx ==> z divides k` by
4977    (rw[Abbr`tx`] >>
4978  `prime p` by metis_tac[prime_divisors_element] >>
4979  `p IN sm /\ p IN sn` by metis_tac[prime_divisors_divisor_subset, SUBSET_DEF] >>
4980  `p IN s` by metis_tac[IN_INTER] >>
4981  `ppidx x <= MIN (ppidx m) (ppidx n)` by rw[prime_power_index_common_divisor] >>
4982  `(p ** ppidx x) divides p ** MIN (ppidx m) (ppidx n)` by rw[prime_power_divides_iff] >>
4983  qabbrev_tac `f = \p:num. p ** MIN (ppidx m) (ppidx n)` >>
4984  `p ** MIN (ppidx m) (ppidx n) IN t` by metis_tac[IN_IMAGE] >>
4985  metis_tac[PROD_SET_ELEMENT_DIVIDES, DIVIDES_TRANS]) >>
4986  rw[pairwise_coprime_prod_set_divides]
4987QED
4988
4989(* This is a major milestone theorem. *)
4990
4991(* Theorem: 0 < m /\ 0 < n ==>
4992           (lcm m n = PROD_SET (IMAGE (\p. p ** (MAX (ppidx m) (ppidx n)))
4993                               ((prime_divisors m) UNION (prime_divisors n)))) *)
4994(* Proof:
4995   Let sm = prime_divisors m, sn = prime_divisors n, s = sm UNION sn.
4996   Let tm = IMAGE (\p. p ** ppidx m) sm, tn = IMAGE (\p. p ** ppidx m) sn,
4997        t = IMAGE (\p. p ** MAX (ppidx m) (ppidx n)) s.
4998   The goal is: lcm m n = PROD_SET t
4999
5000   By LCM_PROPERTY, this is to show:
5001   (1) m divides PROD_SET t /\ n divides PROD_SET t
5002       Let k = PROD_SET t.
5003       Note m = PROD_SET tm      by basic_prime_factorisation, 0 < m
5004        and n = PROD_SET tn      by basic_prime_factorisation, 0 < n
5005      Also PAIRWISE_COPRIME tm   by prime_divisors_element, prime_powers_coprime
5006       and PAIRWISE_COPRIME tn   by prime_divisors_element, prime_powers_coprime
5007
5008      Claim: !z. z IN tm ==> z divides k
5009      Proof: Note z IN tm
5010              ==> ?p. p IN sm /\ (z = p ** ppidx m)       by IN_IMAGE
5011              ==> p IN s                                  by IN_UNION
5012              and prime p                                 by prime_divisors_element
5013             Note ppidx m <= MAX (ppidx m) (ppidx n)      by MAX_DEF
5014              ==> z divides p ** MAX (ppidx m) (ppidx n)  by prime_power_divides_iff
5015              But p ** MAX (ppidx m) (ppidx n) IN t       by IN_IMAGE
5016              and p ** MAX (ppidx m) (ppidx n) divides k  by PROD_SET_ELEMENT_DIVIDES
5017             Thus z divides k                             by DIVIDES_TRANS
5018
5019      Similarly, !z. z IN tn ==> z divides k
5020      Hence (PROD_SET tm) divides k /\ (PROD_SET tn) divides k    by pairwise_coprime_prod_set_divides
5021         or             m divides k /\ n divides k                by above
5022
5023   (2) m divides x /\ n divides x ==> PROD_SET t divides x
5024       If x = 0, trivially true      by ALL_DIVIDES_ZERO
5025       If x <> 0, then 0 < x.
5026       Note PAIRWISE_COPRIME t       by prime_divisors_element, prime_powers_coprimem IN_UNION
5027
5028       Claim: !z. z IN t ==> z divides x
5029       Proof: Note z IN t
5030               ==> ?p. p IN s /\ (z = p ** MAX (ppidx m) (ppidx n))   by IN_IMAGE
5031                or prime p                               by prime_divisors_element, IN_UNION
5032              Note MAX (ppidx m) (ppidx n) <= ppidx x    by prime_power_index_common_multiple, 0 < x
5033                so z divides p ** ppidx x                by prime_power_divides_iff
5034               But p ** ppidx x divides x                by prime_power_factor_divides
5035              Thus z divides x                           by DIVIDES_TRANS
5036       Hence PROD_SET t divides x                        by pairwise_coprime_prod_set_divides
5037*)
5038Theorem lcm_prime_factorisation:
5039    !m n. 0 < m /\ 0 < n ==>
5040         (lcm m n = PROD_SET (IMAGE (\p. p ** (MAX (ppidx m) (ppidx n)))
5041                             ((prime_divisors m) UNION (prime_divisors n))))
5042Proof
5043  rpt strip_tac >>
5044  qabbrev_tac `sm = prime_divisors m` >>
5045  qabbrev_tac `sn = prime_divisors n` >>
5046  qabbrev_tac `s = sm UNION sn` >>
5047  qabbrev_tac `tm = IMAGE (\p. p ** ppidx m) sm` >>
5048  qabbrev_tac `tn = IMAGE (\p. p ** ppidx n) sn` >>
5049  qabbrev_tac `t = IMAGE (\p. p ** MAX (ppidx m) (ppidx n)) s` >>
5050  `FINITE sm /\ FINITE sn /\ FINITE s` by rw[prime_divisors_finite, Abbr`sm`, Abbr`sn`, Abbr`s`] >>
5051  `FINITE tm /\ FINITE tn /\ FINITE t` by rw[Abbr`tm`, Abbr`tn`, Abbr`t`] >>
5052  rw[LCM_PROPERTY] >| [
5053    qabbrev_tac `k = PROD_SET t` >>
5054    `m = PROD_SET tm` by rw[basic_prime_factorisation, Abbr`tm`, Abbr`sm`] >>
5055    `PAIRWISE_COPRIME tm` by
5056  (rw[Abbr`tm`] >>
5057    `prime p /\ prime p' /\ p <> p'` by metis_tac[prime_divisors_element] >>
5058    rw[prime_powers_coprime]) >>
5059    `!z. z IN tm ==> z divides k` by
5060    (rw[Abbr`tm`] >>
5061    `prime p` by metis_tac[prime_divisors_element] >>
5062    `p IN s` by metis_tac[IN_UNION] >>
5063    `ppidx m <= MAX (ppidx m) (ppidx n)` by rw[] >>
5064    `(p ** ppidx m) divides p ** MAX (ppidx m) (ppidx n)` by rw[prime_power_divides_iff] >>
5065    qabbrev_tac `f = \p:num. p ** MAX (ppidx m) (ppidx n)` >>
5066    `p ** MAX (ppidx m) (ppidx n) IN t` by metis_tac[IN_IMAGE] >>
5067    metis_tac[PROD_SET_ELEMENT_DIVIDES, DIVIDES_TRANS]) >>
5068    rw[pairwise_coprime_prod_set_divides],
5069    qabbrev_tac `k = PROD_SET t` >>
5070    `n = PROD_SET tn` by rw[basic_prime_factorisation, Abbr`tn`, Abbr`sn`] >>
5071    `PAIRWISE_COPRIME tn` by
5072  (rw[Abbr`tn`] >>
5073    `prime p /\ prime p' /\ p <> p'` by metis_tac[prime_divisors_element] >>
5074    rw[prime_powers_coprime]) >>
5075    `!z. z IN tn ==> z divides k` by
5076    (rw[Abbr`tn`] >>
5077    `prime p` by metis_tac[prime_divisors_element] >>
5078    `p IN s` by metis_tac[IN_UNION] >>
5079    `ppidx n <= MAX (ppidx m) (ppidx n)` by rw[] >>
5080    `(p ** ppidx n) divides p ** MAX (ppidx m) (ppidx n)` by rw[prime_power_divides_iff] >>
5081    qabbrev_tac `f = \p:num. p ** MAX (ppidx m) (ppidx n)` >>
5082    `p ** MAX (ppidx m) (ppidx n) IN t` by metis_tac[IN_IMAGE] >>
5083    metis_tac[PROD_SET_ELEMENT_DIVIDES, DIVIDES_TRANS]) >>
5084    rw[pairwise_coprime_prod_set_divides],
5085    Cases_on `x = 0` >-
5086    rw[] >>
5087    `0 < x` by decide_tac >>
5088    `PAIRWISE_COPRIME t` by
5089  (rw[Abbr`t`] >>
5090    `prime p /\ prime p' /\ p <> p'` by metis_tac[prime_divisors_element, IN_UNION] >>
5091    rw[prime_powers_coprime]) >>
5092    `!z. z IN t ==> z divides x` by
5093    (rw[Abbr`t`] >>
5094    `prime p` by metis_tac[prime_divisors_element, IN_UNION] >>
5095    `MAX (ppidx m) (ppidx n) <= ppidx x` by rw[prime_power_index_common_multiple] >>
5096    `p ** MAX (ppidx m) (ppidx n) divides p ** ppidx x` by rw[prime_power_divides_iff] >>
5097    `p ** ppidx x divides x` by rw[prime_power_factor_divides] >>
5098    metis_tac[DIVIDES_TRANS]) >>
5099    rw[pairwise_coprime_prod_set_divides]
5100  ]
5101QED
5102
5103(* Another major milestone theorem. *)
5104
5105(* ------------------------------------------------------------------------- *)
5106(* GCD and LCM special coprime decompositions                                *)
5107(* ------------------------------------------------------------------------- *)
5108
5109(*
5110Notes
5111=|===
5112Given two numbers m and n, with d = gcd m n, and cofactors a = m/d, b = n/d.
5113Is it true that gcd a n = 1 ?
5114
5115Take m = 2^3 * 3^2 = 8 * 9 = 72,  n = 2^2 * 3^3 = 4 * 27 = 108
5116Then gcd m n = d = 2^2 * 3^2 = 4 * 9 = 36, with cofactors a = 2, b = 3.
5117In this case, gcd a n = gcd 2 108 <> 1.
5118But lcm m n = 2^3 * 3^3 = 8 * 27 = 216
5119
5120Ryan Vinroot's method:
5121Take m = 2^7 * 3^5 * 5^4 * 7^4    n = 2^6 * 3*7 * 5^4 * 11^4
5122Then m = a b c d = (7^4) (5^4) (2^7) (3^5)
5123 and n = x y z t = (11^4) (5^4) (3^7) (2^6)
5124Note b = y always, and lcm m n = a b c x z, gcd m n = d y z
5125Define P = a b c, Q = x z, then coprime P Q, and lcm P Q = a b c x z = lcm m n = P * Q
5126
5127a = PROD (all prime factors of m which are not prime factors of n) = 7^4
5128b = PROD (all prime factors of m common with m and equal powers in both) = 5^4
5129c = PROD (all prime factors of m common with m but more powers in m) = 2^7
5130d = PROD (all prime factors of m common with m but more powers in n) = 3^5
5131
5132x = PROD (all prime factors of n which are not prime factors of m) = 11^4
5133y = PROD (all prime factors of n common with n and equal powers in both) = 5^4
5134z = PROD (all prime factors of n common with n but more powers in n) = 3^7
5135t = PROD (all prime factors of n common with n but more powers in m) = 2^6
5136
5137Let d = gcd m n. If d <> 1, then it consists of prime powers, e.g. 2^3 * 3^2 * 5
5138Since d is to take the minimal of prime powers common to both m n,
5139each prime power in d must occur fully in either m or n.
5140e.g. it may be the case that:   m = 2^3 * 3 * 5 * a,   n = 2 * 3^2 * 5 * b
5141where a, b don't have prime factors 2, 3, 5, and coprime a b.
5142and lcm m n = a * b * 2^3 * 3^2 * 5, taking the maximal of prime powers common to both.
5143            = (a * 2^3) * (b * 3^2 * 5) = P * Q with coprime P Q.
5144
5145Ryan Vinroot's method (again):
5146Take m = 2^7 * 3^5 * 5^4 * 7^4    n = 2^6 * 3*7 * 5^4 * 11^4
5147Then gcd m n = 2^6 * 3^5 * 5^4, lcm m n = 2^7 * 3^7 * 5^4 * 7^4 * 11^4
5148Take d = 3^5 * 5^4  (compare m to gcd n m, take the full factors of gcd in m )
5149     e = gcd n m / d = 2^6        (take what is left over)
5150Then P = m / d = 2^7 * 7^4
5151     Q = n / e = 3^7 * 5^4 * 11^4
5152 so P | m, there is ord p = P.
5153and Q | n, there is ord q = Q.
5154and coprime P Q, so ord (p * q) = P * Q = lcm m n.
5155
5156d = PROD {p ** ppidx m | p | prime p /\ p | (gcd m n) /\ (ppidx (gcd n m) = ppidx m)}
5157e = gcd n m / d
5158
5159prime_factorisation  |- !n. 0 < n ==> (n = PROD_SET (prime_power_divisors n)
5160
5161This is because:   m = 2^7 * 3^5 * 5^4 * 7^4 * 11^0
5162                   n = 2^6 * 3^7 * 5^4 * 7^0 * 11^4
5163we know that gcd m n = 2^6 * 3^5 * 5^4 * 7^0 * 11^0   taking minimum
5164             lcm m n = 2^7 * 3^7 * 5^4 * 7^4 * 11^4   taking maximum
5165Thus, using gcd m n as a guide,
5166pick               d = 2^0 * 3^5 * 5^4 , taking common minimum,
5167Then   P = m / d  will remove these common minimum from m,
5168but    Q = n / e = n / (gcd m n / d) = n * d / gcd m n   will include their common maximum
5169This separation of prime factors keep coprime P Q, but P * Q = lcm m n.
5170
5171*)
5172
5173(* Overload the park sets *)
5174Overload common_prime_divisors =
5175        ``\m n. (prime_divisors m) INTER (prime_divisors n)``
5176Overload total_prime_divisors =
5177        ``\m n. (prime_divisors m) UNION (prime_divisors n)``
5178Overload park_on =
5179        ``\m n. {p | p IN common_prime_divisors m n /\ ppidx m <= ppidx n}``
5180Overload park_off =
5181        ``\m n. {p | p IN common_prime_divisors m n /\ ppidx n < ppidx m}``
5182(* Overload the parking divisor of GCD *)
5183Overload park = ``\m n. PROD_SET (IMAGE (\p. p ** ppidx m) (park_on m n))``
5184
5185(* Note:
5186The basic one is park_on m n, defined only for 0 < m and 0 < n.
5187*)
5188
5189(* Theorem: p IN common_prime_divisors m n <=> p IN prime_divisors m /\ p IN prime_divisors n *)
5190(* Proof: by IN_INTER *)
5191Theorem common_prime_divisors_element:
5192    !m n p. p IN common_prime_divisors m n <=> p IN prime_divisors m /\ p IN prime_divisors n
5193Proof
5194  rw[]
5195QED
5196
5197(* Theorem: 0 < m /\ 0 < n ==> FINITE (common_prime_divisors m n) *)
5198(* Proof: by prime_divisors_finite, FINITE_INTER *)
5199Theorem common_prime_divisors_finite:
5200    !m n. 0 < m /\ 0 < n ==> FINITE (common_prime_divisors m n)
5201Proof
5202  rw[prime_divisors_finite]
5203QED
5204
5205(* Theorem: PAIRWISE_COPRIME (common_prime_divisors m n) *)
5206(* Proof:
5207   Note x IN prime_divisors m ==> prime x    by prime_divisors_element
5208    and y IN prime_divisors n ==> prime y    by prime_divisors_element
5209    and x <> y ==> coprime x y               by primes_coprime
5210*)
5211Theorem common_prime_divisors_pairwise_coprime:
5212    !m n. PAIRWISE_COPRIME (common_prime_divisors m n)
5213Proof
5214  metis_tac[prime_divisors_element, primes_coprime, IN_INTER]
5215QED
5216
5217(* Theorem: PAIRWISE_COPRIME (IMAGE (\p. p ** MIN (ppidx m) (ppidx n)) (common_prime_divisors m n)) *)
5218(* Proof:
5219   Note (prime_divisors m) SUBSET prime            by prime_divisors_subset_prime
5220     so (common_prime_divisors m n) SUBSET prime   by SUBSET_INTER_SUBSET
5221   Thus true                                       by pairwise_coprime_for_prime_powers
5222*)
5223Theorem common_prime_divisors_min_image_pairwise_coprime:
5224    !m n. PAIRWISE_COPRIME (IMAGE (\p. p ** MIN (ppidx m) (ppidx n)) (common_prime_divisors m n))
5225Proof
5226  metis_tac[prime_divisors_subset_prime, SUBSET_INTER_SUBSET, pairwise_coprime_for_prime_powers]
5227QED
5228
5229(* Theorem: p IN total_prime_divisors m n <=> p IN prime_divisors m \/ p IN prime_divisors n *)
5230(* Proof: by IN_UNION *)
5231Theorem total_prime_divisors_element:
5232    !m n p. p IN total_prime_divisors m n <=> p IN prime_divisors m \/ p IN prime_divisors n
5233Proof
5234  rw[]
5235QED
5236
5237(* Theorem: 0 < m /\ 0 < n ==> FINITE (total_prime_divisors m n) *)
5238(* Proof: by prime_divisors_finite, FINITE_UNION *)
5239Theorem total_prime_divisors_finite:
5240    !m n. 0 < m /\ 0 < n ==> FINITE (total_prime_divisors m n)
5241Proof
5242  rw[prime_divisors_finite]
5243QED
5244
5245(* Theorem: PAIRWISE_COPRIME (total_prime_divisors m n) *)
5246(* Proof:
5247   Note x IN prime_divisors m ==> prime x    by prime_divisors_element
5248    and y IN prime_divisors n ==> prime y    by prime_divisors_element
5249    and x <> y ==> coprime x y               by primes_coprime
5250*)
5251Theorem total_prime_divisors_pairwise_coprime:
5252    !m n. PAIRWISE_COPRIME (total_prime_divisors m n)
5253Proof
5254  metis_tac[prime_divisors_element, primes_coprime, IN_UNION]
5255QED
5256
5257(* Theorem: PAIRWISE_COPRIME (IMAGE (\p. p ** MAX (ppidx m) (ppidx n)) (total_prime_divisors m n)) *)
5258(* Proof:
5259   Note prime_divisors m SUBSET prime      by prime_divisors_subset_prime
5260    and prime_divisors n SUBSET prime      by prime_divisors_subset_prime
5261     so (total_prime_divisors m n) SUBSET prime    by UNION_SUBSET
5262   Thus true                                       by pairwise_coprime_for_prime_powers
5263*)
5264Theorem total_prime_divisors_max_image_pairwise_coprime:
5265    !m n. PAIRWISE_COPRIME (IMAGE (\p. p ** MAX (ppidx m) (ppidx n)) (total_prime_divisors m n))
5266Proof
5267  metis_tac[prime_divisors_subset_prime, UNION_SUBSET, pairwise_coprime_for_prime_powers]
5268QED
5269
5270(* Theorem: p IN park_on m n <=> p IN prime_divisors m /\ p IN prime_divisors n /\ ppidx m <= ppidx n *)
5271(* Proof: by IN_INTER *)
5272Theorem park_on_element:
5273    !m n p. p IN park_on m n <=> p IN prime_divisors m /\ p IN prime_divisors n /\ ppidx m <= ppidx n
5274Proof
5275  rw[] >>
5276  metis_tac[]
5277QED
5278
5279(* Theorem: p IN park_off m n <=> p IN prime_divisors m /\ p IN prime_divisors n /\ ppidx n < ppidx m *)
5280(* Proof: by IN_INTER *)
5281Theorem park_off_element:
5282    !m n p. p IN park_off m n <=> p IN prime_divisors m /\ p IN prime_divisors n /\ ppidx n < ppidx m
5283Proof
5284  rw[] >>
5285  metis_tac[]
5286QED
5287
5288(* Theorem: park_off m n = (common_prime_divisors m n) DIFF (park_on m n) *)
5289(* Proof: by EXTENSION, NOT_LESS_EQUAL *)
5290Theorem park_off_alt:
5291    !m n. park_off m n = (common_prime_divisors m n) DIFF (park_on m n)
5292Proof
5293  rw[EXTENSION] >>
5294  metis_tac[NOT_LESS_EQUAL]
5295QED
5296
5297(* Theorem: park_on m n SUBSET common_prime_divisors m n *)
5298(* Proof: by SUBSET_DEF *)
5299Theorem park_on_subset_common:
5300    !m n. park_on m n SUBSET common_prime_divisors m n
5301Proof
5302  rw[SUBSET_DEF]
5303QED
5304
5305(* Theorem: park_off m n SUBSET common_prime_divisors m n *)
5306(* Proof: by SUBSET_DEF *)
5307Theorem park_off_subset_common:
5308    !m n. park_off m n SUBSET common_prime_divisors m n
5309Proof
5310  rw[SUBSET_DEF]
5311QED
5312
5313(* Theorem: park_on m n SUBSET total_prime_divisors m n *)
5314(* Proof: by SUBSET_DEF *)
5315Theorem park_on_subset_total:
5316    !m n. park_on m n SUBSET total_prime_divisors m n
5317Proof
5318  rw[SUBSET_DEF]
5319QED
5320
5321(* Theorem: park_off m n SUBSET total_prime_divisors m n *)
5322(* Proof: by SUBSET_DEF *)
5323Theorem park_off_subset_total:
5324    !m n. park_off m n SUBSET total_prime_divisors m n
5325Proof
5326  rw[SUBSET_DEF]
5327QED
5328
5329(* Theorem: common_prime_divisors m n =|= park_on m n # park_off m n *)
5330(* Proof:
5331   Let s = common_prime_divisors m n.
5332   Note park_on m n SUBSET s                     by park_on_subset_common
5333    and park_off m n = s DIFF (park_on m n)      by park_off_alt
5334     so s = park_on m n UNION park_off m n /\
5335        DISJOINT (park_on m n) (park_off m n)    by partition_by_subset
5336*)
5337Theorem park_on_off_partition:
5338    !m n. common_prime_divisors m n =|= park_on m n # park_off m n
5339Proof
5340  metis_tac[partition_by_subset, park_on_subset_common, park_off_alt]
5341QED
5342
5343(* Theorem: 1 NOTIN (IMAGE (\p. p ** ppidx m) (park_off m n)) *)
5344(* Proof:
5345   By contradiction, suppse 1 IN (IMAGE (\p. p ** ppidx m) (park_off m n)).
5346   Then ?p. p IN park_off m n /\ (1 = p ** ppidx m)   by IN_IMAGE
5347     or p IN prime_divisors m /\
5348        p IN prime_divisors n /\ ppidx n < ppidx m    by park_off_element
5349    But prime p                     by prime_divisors_element
5350    and p <> 1                      by NOT_PRIME_1
5351   Thus ppidx m = 0                 by EXP_EQ_1
5352     or ppidx n < 0, which is F     by NOT_LESS_0
5353*)
5354Theorem park_off_image_has_not_1:
5355    !m n. 1 NOTIN (IMAGE (\p. p ** ppidx m) (park_off m n))
5356Proof
5357  rw[] >>
5358  spose_not_then strip_assume_tac >>
5359  `prime p` by metis_tac[prime_divisors_element] >>
5360  `p <> 1` by metis_tac[NOT_PRIME_1] >>
5361  decide_tac
5362QED
5363
5364(*
5365For the example,
5366This is because:   m = 2^7 * 3^5 * 5^4 * 7^4 * 11^0
5367                   n = 2^6 * 3^7 * 5^4 * 7^0 * 11^4
5368we know that gcd m n = 2^6 * 3^5 * 5^4 * 7^0 * 11^0   taking minimum
5369             lcm m n = 2^7 * 3^7 * 5^4 * 7^4 * 11^4   taking maximum
5370Thus, using gcd m n as a guide,
5371pick               d = 2^0 * 3^5 * 5^4 , taking common minimum,
5372Then   P = m / d  will remove these common minimum from m,
5373but    Q = n / e = n / (gcd m n / d) = n * d / gcd m n   will include their common maximum
5374This separation of prime factors keep coprime P Q, but P * Q = lcm m n.
5375common_prime_divisors m n = {2; 3; 5}  s = {2^6; 3^5; 5^4} with MIN
5376park_on m n = {3; 5}  u = IMAGE (\p. p ** ppidx m) (park_on m n) = {3^5; 5^4}
5377park_off m n = {2}    v = IMAGE (\p. p ** ppidx n) (park_off m n) = {2^6}
5378Note                      IMAGE (\p. p ** ppidx m) (park_off m n) = {2^7}
5379and                       IMAGE (\p. p ** ppidx n) (park_on m n) = {3^7; 5^4}
5380
5381total_prime_divisors m n = {2; 3; 5; 7; 11}  s = {2^7; 3^7; 5^4; 7^4; 11^4} with MAX
5382sm = (prime_divisors m) DIFF (park_on m n) = {2; 7}, u = IMAGE (\p. p ** ppidx m) sm = {2^7; 7^4}
5383sn = (prime_divisors n) DIFF (park_off m n) = {3; 5; 11}, v = IMAGE (\p. p ** ppidx n) sn = {3^7; 5^4; 11^4}
5384
5385park_on_element
5386|- !m n p. p IN park_on m n <=> p IN prime_divisors m /\ p IN prime_divisors n /\ ppidx m <= ppidx n
5387park_off_element
5388|- !m n p. p IN park_off m n <=> p IN prime_divisors m /\ p IN prime_divisors n /\ ppidx n < ppidx m
5389*)
5390
5391(* Theorem: let s = IMAGE (\p. p ** MIN (ppidx m) (ppidx n)) (common_prime_divisors m n) in
5392            let u = IMAGE (\p. p ** ppidx m) (park_on m n) in
5393            let v = IMAGE (\p. p ** ppidx n) (park_off m n) in
5394            0 < m ==> s =|= u # v *)
5395(* Proof:
5396   This is to show:
5397   (1) s = u UNION v
5398       By EXTENSION, this is to show:
5399       (a) !x. x IN s ==> x IN u \/ x IN v            by IN_UNION
5400           Note x IN s
5401            ==> ?p. (x = p ** MIN (ppidx m) (ppidx n)) /\
5402                 p IN common_prime_divisors m n       by IN_IMAGE
5403          If ppidx m <= ppidx n
5404             Then MIN (ppidx m) (ppidx n) = ppidx m   by MIN_DEF
5405              and p IN park_on m n                    by common_prime_divisors_element, park_on_element
5406              ==> x IN u                              by IN_IMAGE
5407          If ~(ppidx m <= ppidx n),
5408            so ppidx n < ppidx m                      by NOT_LESS_EQUAL
5409             Then MIN (ppidx m) (ppidx n) = ppidx n   by MIN_DEF
5410              and p IN park_off m n                   by common_prime_divisors_element, park_off_element
5411              ==> x IN v                              by IN_IMAGE
5412       (b) x IN u ==> x IN s
5413           Note x IN u
5414            ==> ?p. (x = p ** ppidx m) /\
5415                    p IN park_on m n                  by IN_IMAGE
5416            ==> ppidx m <= ppidx n                    by park_on_element
5417           Thus MIN (ppidx m) (ppidx n) = ppidx m     by MIN_DEF
5418             so p IN common_prime_divisors m n        by park_on_subset_common, SUBSET_DEF
5419            ==> x IN s                                by IN_IMAGE
5420       (c) x IN v ==> x IN s
5421           Note x IN v
5422            ==> ?p. (x = p ** ppidx n) /\
5423                    p IN park_off m n                 by IN_IMAGE
5424            ==> ppidx n < ppidx m                     by park_off_element
5425           Thus MIN (ppidx m) (ppidx n) = ppidx n     by MIN_DEF
5426             so p IN common_prime_divisors m n        by park_off_subset_common, SUBSET_DEF
5427            ==> x IN s                                by IN_IMAGE
5428   (2) DISJOINT u v
5429       This is to show: u INTER v = {}                by DISJOINT_DEF
5430       By contradiction, suppse u INTER v <> {}.
5431       Then ?x. x IN u /\ x IN v                      by MEMBER_NOT_EMPTY, IN_INTER
5432       Thus ?p. p IN park_on m n /\ (x = p ** ppidx m)                  by IN_IMAGE
5433        and ?q. q IN park_off m n /\ (x = q ** prime_power_index q n)   by IN_IMAGE
5434        ==> prime p /\ prime q /\ p divides m         by park_on_element, park_off_element
5435                                                         prime_divisors_element
5436       Also 0 < ppidx m                               by prime_power_index_pos, p divides m, 0 < m
5437        ==> p = q                                     by prime_powers_eq
5438       Thus p IN (park_on m n) INTER (park_off m n)   by IN_INTER
5439        But DISJOINT (park_on m n) (park_off m n)     by park_on_off_partition
5440         so there is a contradiction                  by IN_DISJOINT
5441*)
5442Theorem park_on_off_common_image_partition:
5443    !m n. let s = IMAGE (\p. p ** MIN (ppidx m) (ppidx n)) (common_prime_divisors m n) in
5444         let u = IMAGE (\p. p ** ppidx m) (park_on m n) in
5445         let v = IMAGE (\p. p ** ppidx n) (park_off m n) in
5446         0 < m ==> s =|= u # v
5447Proof
5448  rpt strip_tac >>
5449  qabbrev_tac `f = \p:num. p ** MIN (ppidx m) (ppidx n)` >>
5450  qabbrev_tac `f1 = \p:num. p ** ppidx m` >>
5451  qabbrev_tac `f2 = \p:num. p ** ppidx n` >>
5452  rw_tac std_ss[] >| [
5453    rw[EXTENSION, EQ_IMP_THM] >| [
5454      `?p. (x = p ** MIN (ppidx m) (ppidx n)) /\ p IN common_prime_divisors m n` by metis_tac[IN_IMAGE] >>
5455      Cases_on `ppidx m <= ppidx n` >| [
5456        `MIN (ppidx m) (ppidx n) = ppidx m` by rw[MIN_DEF] >>
5457        `p IN park_on m n` by metis_tac[common_prime_divisors_element, park_on_element] >>
5458        metis_tac[IN_IMAGE],
5459        `MIN (ppidx m) (ppidx n) = ppidx n` by rw[MIN_DEF] >>
5460        `p IN park_off m n` by metis_tac[common_prime_divisors_element, park_off_element, NOT_LESS_EQUAL] >>
5461        metis_tac[IN_IMAGE]
5462      ],
5463      `?p. (x = p ** ppidx m) /\ p IN park_on m n` by metis_tac[IN_IMAGE] >>
5464      `ppidx m <= ppidx n` by metis_tac[park_on_element] >>
5465      `MIN (ppidx m) (ppidx n) = ppidx m` by rw[MIN_DEF] >>
5466      `p IN common_prime_divisors m n` by metis_tac[park_on_subset_common, SUBSET_DEF] >>
5467      metis_tac[IN_IMAGE],
5468      `?p. (x = p ** ppidx n) /\ p IN park_off m n` by metis_tac[IN_IMAGE] >>
5469      `ppidx n < ppidx m` by metis_tac[park_off_element] >>
5470      `MIN (ppidx m) (ppidx n) = ppidx n` by rw[MIN_DEF] >>
5471      `p IN common_prime_divisors m n` by metis_tac[park_off_subset_common, SUBSET_DEF] >>
5472      metis_tac[IN_IMAGE]
5473    ],
5474    rw[DISJOINT_DEF] >>
5475    spose_not_then strip_assume_tac >>
5476    `?x. x IN u /\ x IN v` by metis_tac[MEMBER_NOT_EMPTY, IN_INTER] >>
5477    `?p. p IN park_on m n /\ (x = p ** ppidx m)` by prove_tac[IN_IMAGE] >>
5478    `?q. q IN park_off m n /\ (x = q ** prime_power_index q n)` by prove_tac[IN_IMAGE] >>
5479    `prime p /\ prime q /\ p divides m` by metis_tac[park_on_element, park_off_element, prime_divisors_element] >>
5480    `0 < ppidx m` by rw[prime_power_index_pos] >>
5481    `p = q` by metis_tac[prime_powers_eq] >>
5482    metis_tac[park_on_off_partition, IN_DISJOINT]
5483  ]
5484QED
5485
5486(* Theorem: 0 < m /\ 0 < n ==> let a = park m n in let b = gcd m n DIV a in
5487           (b = PROD_SET (IMAGE (\p. p ** ppidx n) (park_off m n))) /\ (gcd m n = a * b) /\ coprime a b *)
5488(* Proof:
5489   Let s = IMAGE (\p. p ** MIN (ppidx m) (ppidx n)) (common_prime_divisors m n),
5490       u = IMAGE (\p. p ** ppidx m) (park_on m n),
5491       v = IMAGE (\p. p ** ppidx n) (park_off m n).
5492   Then s =|= u # v                         by park_on_off_common_image_partition
5493   Let a = PROD_SET u, b = PROD_SET v, c = PROD_SET s.
5494   Then FINITE s                            by common_prime_divisors_finite, IMAGE_FINITE, 0 < m, 0 < n
5495    and PAIRWISE_COPRIME s                  by common_prime_divisors_min_image_pairwise_coprime
5496    ==> (c = a * b) /\ coprime a b          by pairwise_coprime_prod_set_partition
5497   Note c = gcd m n                         by gcd_prime_factorisation
5498    and a = park m n                        by notation
5499   Note c <> 0                              by GCD_EQ_0, 0 < m, 0 < n
5500   Thus a <> 0, or 0 < a                    by MULT_EQ_0
5501     so b = c DIV a                         by DIV_SOLVE_COMM, 0 < a
5502   Therefore,
5503        b = PROD_SET (IMAGE (\p. p ** ppidx n) (park_off m n)) /\
5504        gcd m n = a * b /\ coprime a b      by above
5505*)
5506
5507Theorem gcd_park_decomposition:
5508  !m n. 0 < m /\ 0 < n ==> let a = park m n in let b = gcd m n DIV a in
5509        b = PROD_SET (IMAGE (\p. p ** ppidx n) (park_off m n)) /\
5510        gcd m n = a * b /\ coprime a b
5511Proof
5512  rpt strip_tac >>
5513  qabbrev_tac `s = IMAGE (\p. p ** MIN (ppidx m) (ppidx n)) (common_prime_divisors m n)` >>
5514  qabbrev_tac `u = IMAGE (\p. p ** ppidx m) (park_on m n)` >>
5515  qabbrev_tac `v = IMAGE (\p. p ** ppidx n) (park_off m n)` >>
5516  `s =|= u # v` by metis_tac[park_on_off_common_image_partition] >>
5517  qabbrev_tac `a = PROD_SET u` >>
5518  qabbrev_tac `b = PROD_SET v` >>
5519  qabbrev_tac `c = PROD_SET s` >>
5520  `FINITE s` by rw[common_prime_divisors_finite, Abbr`s`] >>
5521  `PAIRWISE_COPRIME s` by metis_tac[common_prime_divisors_min_image_pairwise_coprime] >>
5522  `(c = a * b) /\ coprime a b`
5523    by (simp[Abbr`a`, Abbr`b`, Abbr`c`] >>
5524        metis_tac[pairwise_coprime_prod_set_partition]) >>
5525  metis_tac[gcd_prime_factorisation, GCD_EQ_0, MULT_EQ_0, DIV_SOLVE_COMM,
5526            NOT_ZERO_LT_ZERO]
5527QED
5528
5529(* Theorem: 0 < m /\ 0 < n ==> let a = park m n in let b = gcd m n DIV a in
5530            (gcd m n = a * b) /\ coprime a b *)
5531(* Proof: by gcd_park_decomposition *)
5532Theorem gcd_park_decompose:
5533    !m n. 0 < m /\ 0 < n ==> let a = park m n in let b = gcd m n DIV a in
5534         (gcd m n = a * b) /\ coprime a b
5535Proof
5536  metis_tac[gcd_park_decomposition]
5537QED
5538
5539(*
5540For the example:
5541total_prime_divisors m n = {2; 3; 5; 7; 11}  s = {2^7; 3^7; 5^4; 7^4; 11^4} with MAX
5542sm = (prime_divisors m) DIFF (park_on m n) = {2; 7}, u = IMAGE (\p. p ** ppidx m) sm = {2^7; 7^4}
5543sn = (prime_divisors n) DIFF (park_off m n) = {3; 5; 11}, v = IMAGE (\p. p ** ppidx n) sn = {3^7; 5^4; 11^4}
5544*)
5545
5546(* Theorem: let s = IMAGE (\p. p ** MAX (ppidx m) (ppidx n)) (total_prime_divisors m n) in
5547            let u = IMAGE (\p. p ** ppidx m) ((prime_divisors m) DIFF (park_on m n)) in
5548            let v = IMAGE (\p. p ** ppidx n) ((prime_divisors n) DIFF (park_off m n)) in
5549            0 < m /\ 0 < n ==> s =|= u # v *)
5550(* Proof:
5551   This is to show:
5552   (1) s = u UNION v
5553       By EXTENSION, this is to show:
5554       (a) x IN s ==> x IN u \/ x IN v
5555           Note x IN s
5556            ==> ?p. p IN total_prime_divisors m n /\
5557                    (x = p ** MAX (ppidx m) (ppidx n))         by IN_IMAGE
5558           By total_prime_divisors_element,
5559
5560           If p IN prime_divisors m,
5561              Then prime p /\ p divides m                      by prime_divisors_element
5562              If p IN park_on m n,
5563                 Then p IN prime_divisors n /\
5564                      ppidx m <= ppidx n                       by park_on_element
5565                  ==> MAX (ppidx m) (ppidx n) = ppidx n        by MAX_DEF
5566                 Note DISJOINT (park_on m n) (park_off m n)    by park_on_off_partition
5567                 Thus p NOTIN park_off m n                     by IN_DISJOINT
5568                  ==> p IN prime_divisors n DIFF park_off m n  by IN_DIFF
5569                 Therefore x IN v                              by IN_IMAGE
5570              If p NOTIN park_on m n,
5571                 Then p IN prime_divisors m DIFF park_on m n   by IN_DIFF
5572                 By park_on_element, either [1] or [2]:
5573                 [1] p NOTIN prime_divisors n
5574                     Then ppidx n = 0   by prime_divisors_element, prime_power_index_eq_0, 0 < n
5575                      ==> MAX (ppidx m) (ppidx n) = ppidx m    by MAX_DEF
5576                     Therefore x IN u                          by IN_IMAGE
5577                 [2] ~(ppidx m <= ppidx n)
5578                     Then MAX (ppidx m) (ppidx n) = ppidx m    by MAX_DEF
5579                     Therefore x IN u                          by IN_IMAGE
5580
5581           If p IN prime_divisors n,
5582              Then prime p /\ p divides n                      by prime_divisors_element
5583              If p IN park_off m n,
5584                 Then p IN prime_divisors m /\
5585                      ppidx n < ppidx m                        by park_off_element
5586                  ==> MAX (ppidx m) (ppidx n) = ppidx m        by MAX_DEF
5587                 Note DISJOINT (park_on m n) (park_off m n)    by park_on_off_partition
5588                 Thus p NOTIN park_on m n                      by IN_DISJOINT
5589                  ==> p IN prime_divisors m DIFF park_on m n   by IN_DIFF
5590                 Therefore x IN u                              by IN_IMAGE
5591              If p NOTIN park_off m n,
5592                 Then p IN prime_divisors n DIFF park_off m n  by IN_DIFF
5593                 By park_off_element, either [1] or [2]:
5594                 [1] p NOTIN prime_divisors m
5595                     Then ppidx m = 0   by prime_divisors_element, prime_power_index_eq_0, 0 < m
5596                      ==> MAX (ppidx m) (ppidx n) = ppidx n    by MAX_DEF
5597                     Therefore x IN v                          by IN_IMAGE
5598                 [2] ~(ppidx n < ppidx m)
5599                     Then MAX (ppidx m) (ppidx n) = ppidx n    by MAX_DEF
5600                     Therefore x IN v                          by IN_IMAGE
5601
5602       (b) x IN u ==> x IN s
5603           Note x IN u
5604            ==> ?p. p IN prime_divisors m DIFF park_on m n /\
5605                    (x = p ** ppidx m)                        by IN_IMAGE
5606           Thus p IN prime_divisors m /\ p NOTIN park_on m n  by IN_DIFF
5607           Note p IN total_prime_divisors m n                 by total_prime_divisors_element
5608           By park_on_element, either [1] or [2]:
5609           [1] p NOTIN prime_divisors n
5610               Then ppidx n = 0  by prime_divisors_element, prime_power_index_eq_0, 0 < n
5611                ==> MAX (ppidx m) (ppidx n) = ppidx m         by MAX_DEF
5612               Therefore x IN u                               by IN_IMAGE
5613           [2] ~(ppidx m <= ppidx n)
5614               Then MAX (ppidx m) (ppidx n) = ppidx m         by MAX_DEF
5615               Therefore x IN u                               by IN_IMAGE
5616
5617       (c) x IN v ==> x IN s
5618           Note x IN v
5619            ==> ?p. p IN prime_divisors n DIFF park_off m n /\
5620                    (x = p ** ppidx n)                        by IN_IMAGE
5621           Thus p IN prime_divisors n /\ p NOTIN park_off m n by IN_DIFF
5622           Note p IN total_prime_divisors m n                 by total_prime_divisors_element
5623           By park_off_element, either [1] or [2]:
5624           [1] p NOTIN prime_divisors m
5625               Then ppidx m = 0  by prime_divisors_element, prime_power_index_eq_0, 0 < m
5626                ==> MAX (ppidx m) (ppidx n) = ppidx n         by MAX_DEF
5627               Therefore x IN v                               by IN_IMAGE
5628           [2] ~(ppidx n < ppidx m)
5629               Then MAX (ppidx m) (ppidx n) = ppidx n         by MAX_DEF
5630               Therefore x IN v                               by IN_IMAGE
5631
5632   (2) DISJOINT u v
5633       This is to show: u INTER v = {}          by DISJOINT_DEF
5634       By contradiction, suppse u INTER v <> {}.
5635       Then ?x. x IN u /\ x IN v                by MEMBER_NOT_EMPTY, IN_INTER
5636       Note x IN u
5637        ==> ?p. p IN prime_divisors m DIFF park_on m n /\
5638                (x = p ** ppidx m)              by IN_IMAGE
5639        and x IN v
5640        ==> ?q. q IN prime_divisors n DIFF park_off m n /\
5641               (x = q ** prime_power_index q n)   by IN_IMAGE
5642       Thus p IN prime_divisors m /\ p NOTIN park_on m n   by IN_DIFF
5643        and q IN prime_divisors n /\ q NOTIN park_off m n  by IN_DIFF [1]
5644        Now prime p /\ prime q /\ p divides m     by prime_divisors_element
5645        and 0 < ppidx m                           by prime_power_index_pos, p divides m, 0 < m
5646        ==> p = q                                 by prime_powers_eq
5647       Thus p IN common_prime_divisors m n        by common_prime_divisors_element, [1]
5648        ==> p IN park_on m n \/ p IN park_off m n by park_on_off_partition, IN_UNION
5649       This is a contradiction with [1].
5650*)
5651Theorem park_on_off_total_image_partition:
5652    !m n. let s = IMAGE (\p. p ** MAX (ppidx m) (ppidx n)) (total_prime_divisors m n) in
5653         let u = IMAGE (\p. p ** ppidx m) ((prime_divisors m) DIFF (park_on m n)) in
5654         let v = IMAGE (\p. p ** ppidx n) ((prime_divisors n) DIFF (park_off m n)) in
5655         0 < m /\ 0 < n ==> s =|= u # v
5656Proof
5657  rpt strip_tac >>
5658  qabbrev_tac `f = \p:num. p ** MAX (ppidx m) (ppidx n)` >>
5659  qabbrev_tac `f1 = \p:num. p ** ppidx m` >>
5660  qabbrev_tac `f2 = \p:num. p ** ppidx n` >>
5661  rw_tac std_ss[] >| [
5662    rw[EXTENSION, EQ_IMP_THM] >| [
5663      `?p. p IN total_prime_divisors m n /\ (x = p ** MAX (ppidx m) (ppidx n))` by metis_tac[IN_IMAGE] >>
5664      `p IN prime_divisors m \/ p IN prime_divisors n` by rw[GSYM total_prime_divisors_element] >| [
5665        `prime p /\ p divides m` by metis_tac[prime_divisors_element] >>
5666        Cases_on `p IN park_on m n` >| [
5667          `p IN prime_divisors n /\ ppidx m <= ppidx n` by metis_tac[park_on_element] >>
5668          `MAX (ppidx m) (ppidx n) = ppidx n` by rw[MAX_DEF] >>
5669          `p NOTIN park_off m n` by metis_tac[park_on_off_partition, IN_DISJOINT] >>
5670          `p IN prime_divisors n DIFF park_off m n` by rw[] >>
5671          metis_tac[IN_IMAGE],
5672          `p IN prime_divisors m DIFF park_on m n` by rw[] >>
5673          `p NOTIN prime_divisors n \/ ~(ppidx m <= ppidx n)` by metis_tac[park_on_element] >| [
5674            `ppidx n = 0` by metis_tac[prime_divisors_element, prime_power_index_eq_0] >>
5675            `MAX (ppidx m) (ppidx n) = ppidx m` by rw[MAX_DEF] >>
5676            metis_tac[IN_IMAGE],
5677            `MAX (ppidx m) (ppidx n) = ppidx m` by rw[MAX_DEF] >>
5678            metis_tac[IN_IMAGE]
5679          ]
5680        ],
5681        `prime p /\ p divides n` by metis_tac[prime_divisors_element] >>
5682        Cases_on `p IN park_off m n` >| [
5683          `p IN prime_divisors m /\ ppidx n < ppidx m` by metis_tac[park_off_element] >>
5684          `MAX (ppidx m) (ppidx n) = ppidx m` by rw[MAX_DEF] >>
5685          `p NOTIN park_on m n` by metis_tac[park_on_off_partition, IN_DISJOINT] >>
5686          `p IN prime_divisors m DIFF park_on m n` by rw[] >>
5687          metis_tac[IN_IMAGE],
5688          `p IN prime_divisors n DIFF park_off m n` by rw[] >>
5689          `p NOTIN prime_divisors m \/ ~(ppidx n < ppidx m)` by metis_tac[park_off_element] >| [
5690            `ppidx m = 0` by metis_tac[prime_divisors_element, prime_power_index_eq_0] >>
5691            `MAX (ppidx m) (ppidx n) = ppidx n` by rw[MAX_DEF] >>
5692            metis_tac[IN_IMAGE],
5693            `MAX (ppidx m) (ppidx n) = ppidx n` by rw[MAX_DEF] >>
5694            metis_tac[IN_IMAGE]
5695          ]
5696        ]
5697      ],
5698      `?p. p IN prime_divisors m DIFF park_on m n /\ (x = p ** ppidx m)` by prove_tac[IN_IMAGE] >>
5699      `p IN prime_divisors m /\ p NOTIN park_on m n` by metis_tac[IN_DIFF] >>
5700      `p IN total_prime_divisors m n` by rw[total_prime_divisors_element] >>
5701      `p NOTIN prime_divisors n \/ ~(ppidx m <= ppidx n)` by metis_tac[park_on_element] >| [
5702        `ppidx n = 0` by metis_tac[prime_divisors_element, prime_power_index_eq_0] >>
5703        `MAX (ppidx m) (ppidx n) = ppidx m` by rw[MAX_DEF] >>
5704        metis_tac[IN_IMAGE],
5705        `MAX (ppidx m) (ppidx n) = ppidx m` by rw[MAX_DEF] >>
5706        metis_tac[IN_IMAGE]
5707      ],
5708      `?p. p IN prime_divisors n DIFF park_off m n /\ (x = p ** ppidx n)` by prove_tac[IN_IMAGE] >>
5709      `p IN prime_divisors n /\ p NOTIN park_off m n` by metis_tac[IN_DIFF] >>
5710      `p IN total_prime_divisors m n` by rw[total_prime_divisors_element] >>
5711      `p NOTIN prime_divisors m \/ ~(ppidx n < ppidx m)` by metis_tac[park_off_element] >| [
5712        `ppidx m = 0` by metis_tac[prime_divisors_element, prime_power_index_eq_0] >>
5713        `MAX (ppidx m) (ppidx n) = ppidx n` by rw[MAX_DEF] >>
5714        metis_tac[IN_IMAGE],
5715        `MAX (ppidx m) (ppidx n) = ppidx n` by rw[MAX_DEF] >>
5716        metis_tac[IN_IMAGE]
5717      ]
5718    ],
5719    rw[DISJOINT_DEF] >>
5720    spose_not_then strip_assume_tac >>
5721    `?x. x IN u /\ x IN v` by metis_tac[MEMBER_NOT_EMPTY, IN_INTER] >>
5722    `?p. p IN prime_divisors m DIFF park_on m n /\ (x = p ** ppidx m)` by prove_tac[IN_IMAGE] >>
5723    `?q. q IN prime_divisors n DIFF park_off m n /\ (x = q ** prime_power_index q n)` by prove_tac[IN_IMAGE] >>
5724    `p IN prime_divisors m /\ p NOTIN park_on m n` by metis_tac[IN_DIFF] >>
5725    `q IN prime_divisors n /\ q NOTIN park_off m n` by metis_tac[IN_DIFF] >>
5726    `prime p /\ prime q /\ p divides m` by metis_tac[prime_divisors_element] >>
5727    `0 < ppidx m` by rw[prime_power_index_pos] >>
5728    `p = q` by metis_tac[prime_powers_eq] >>
5729    `p IN common_prime_divisors m n` by rw[common_prime_divisors_element] >>
5730    metis_tac[park_on_off_partition, IN_UNION]
5731  ]
5732QED
5733
5734(* Theorem: 0 < m /\ 0 < n ==>
5735           let a = park m n in let b = gcd m n DIV a in
5736           let p = m DIV a in let q = (a * n) DIV (gcd m n) in
5737           (b = PROD_SET (IMAGE (\p. p ** ppidx n) (park_off m n))) /\
5738           (p = PROD_SET (IMAGE (\p. p ** ppidx m) ((prime_divisors m) DIFF (park_on m n)))) /\
5739           (q = PROD_SET (IMAGE (\p. p ** ppidx n) ((prime_divisors n) DIFF (park_off m n)))) /\
5740           (lcm m n = p * q) /\ coprime p q /\ (gcd m n = a * b) /\ (m = a * p) /\ (n = b * q) *)
5741(* Proof:
5742   Let s = IMAGE (\p. p ** MAX (ppidx m) (ppidx n)) (total_prime_divisors m n),
5743       u = IMAGE (\p. p ** ppidx m) (park_on m n),
5744       v = IMAGE (\p. p ** ppidx n) (park_off m n),
5745       h = IMAGE (\p. p ** ppidx m) ((prime_divisors m) DIFF (park_on m n)),
5746       k = IMAGE (\p. p ** ppidx n) ((prime_divisors n) DIFF (park_off m n)),
5747       a = PROD_SET u, b = PROD_SET v, c = PROD_SET s, p = PROD_SET h, q = PROD_SET k
5748       x = IMAGE (\p. p ** ppidx m) (prime_divisors m),
5749       y = IMAGE (\p. p ** ppidx n) (prime_divisors n),
5750   Let g = gcd m n.
5751
5752   Step 1: GCD
5753   Note a = park m n                       by notation
5754    and g = a * b                          by gcd_park_decomposition
5755
5756   Step 2: LCM
5757   Note c = lcm m n                        by lcm_prime_factorisation
5758   Note s =|= h # k                        by park_on_off_total_image_partition
5759    and FINITE (total_prime_divisors m n)  by total_prime_divisors_finite, 0 < m, 0 < n
5760    ==> FINITE s                           by IMAGE_FINITE
5761   also PAIRWISE_COPRIME s                 by total_prime_divisors_max_image_pairwise_coprime
5762   Thus (c = p * q) /\ coprime p q         by pairwise_coprime_prod_set_partition
5763
5764   Step 3: Identities
5765   Note m = PROD_SET x                     by basic_prime_factorisation
5766        n = PROD_SET y                     by basic_prime_factorisation
5767
5768   For the identity:  m = a * p
5769   We need:  PROD_SET x = PROD_SET u * PROD_SET h
5770   This requires:     x = u UNION h /\ DISJOINT u h, i.e. x =|= u # h
5771   or partition: (prime_divisors m) --> (park_on m n) and (prime_divisors m) DIFF (park_on m n)
5772
5773   Claim: m = a * p
5774   Proof: Claim: h = x DIFF u
5775          Proof: Let pk = park_on m n, pm = prime_divisors m, f = \p. p ** ppidx m.
5776                 Note pk SUBSET pm                by park_on_element, prime_divisors_element, SUBSET_DEF
5777                  ==> INJ f pm UNIV               by INJ_DEF, prime_divisors_element,
5778                                                     prime_power_index_pos, prime_powers_eq
5779                   x DIFF u
5780                 = (IMAGE f pm) DIFF (IMAGE f pk) by notation
5781                 = IMAGE f (pm DIFF pk)           by IMAGE_DIFF
5782                 = h                              by notation
5783          Note FINITE x                           by prime_divisors_finite, IMAGE_FINITE
5784           and u SUBSET x                         by SUBSET_DEF, IMAGE_SUBSET
5785          Thus x =|= u # h                        by partition_by_subset
5786           ==> m = a * p                          by PROD_SET_PRODUCT_BY_PARTITION
5787
5788   For the identity:  n = b * q
5789   We need:  PROD_SET y = PROD_SET v * PROD_SET k
5790   This requires:     y = v UNION k /\ DISJOINT v k, i.e y =|= v # k
5791   or partition: (prime_divisors n) --> (park_off m n) and (prime_divisors n) DIFF (park_off m n)
5792
5793   Claim: n = b * q
5794   Proof: Claim: k = y DIFF v
5795          Proof: Let pk = park_off m n, pn = prime_divisors n, f = \p. p ** ppidx n.
5796                 Note pk SUBSET pn                by park_off_element, prime_divisors_element, SUBSET_DEF
5797                  ==> INJ f pn UNIV               by INJ_DEF, prime_divisors_element,
5798                                                     prime_power_index_pos, prime_powers_eq
5799                   y DIFF v
5800                 = (IMAGE f pn) DIFF (IMAGE f pk) by notation
5801                 = IMAGE f (pn DIFF pk)           by IMAGE_DIFF
5802                 = k                              by notation
5803          Note FINITE y                           by prime_divisors_finite, IMAGE_FINITE
5804           and v SUBSET y                         by SUBSET_DEF, IMAGE_SUBSET
5805          Thus y =|= v # k                        by partition_by_subset
5806           ==> n = b * q                          by PROD_SET_PRODUCT_BY_PARTITION
5807
5808   Proof better:
5809         Note m * n = g * c                       by GCD_LCM
5810                    = (a * b) * (p * q)           by above
5811                    = (a * p) * (b * q)           by MULT_COMM, MULT_ASSOC
5812                    = m * (b * q)                 by m = a * p
5813         Thus     n = b * q                       by MULT_LEFT_CANCEL, 0 < m
5814
5815   Thus g <> 0 /\ c <> 0     by GCD_EQ_0, LCM_EQ_0, m <> 0, n <> 0
5816    ==> p <> 0 /\ a <> 0     by MULT_EQ_0
5817    ==> b = g DIV a          by DIV_SOLVE_COMM, 0 < a
5818    ==> p = m DIV a          by DIV_SOLVE_COMM, 0 < a
5819    and q = c DIV p          by DIV_SOLVE_COMM, 0 < p
5820   Note g divides n          by GCD_IS_GREATEST_COMMON_DIVISOR
5821     so g divides a * n      by DIVIDES_MULTIPLE
5822     or a * n = a * (b * q)  by n = b * q from Claim 2
5823              = (a * b) * q  by MULT_ASSOC
5824              = g * q        by g = a * b
5825              = q * g        by MULT_COMM
5826     so g divides a * n      by divides_def
5827   Thus q = c DIV p                      by above
5828          = ((m * n) DIV g) DIV p        by lcm_def, m <> 0, n <> 0
5829          = (m * n) DIV (g * p)          by DIV_DIV_DIV_MULT, 0 < g, 0 < p
5830          = ((a * p) * n) DIV (g * p)    by m = a * p, Claim 1
5831          = (p * (a * n)) DIV (p * g)    by MULT_COMM, MULT_ASSOC
5832          = (a * n) DIV g                by DIV_COMMON_FACTOR, 0 < p, g divides a * n
5833
5834   This gives all the assertions:
5835        (lcm m n = p * q) /\ coprime p q /\ (gcd m n = a * b) /\
5836        (m = a * p) /\ (n = b * q)       by MULT_COMM
5837*)
5838
5839Theorem lcm_park_decomposition:
5840  !m n.
5841    0 < m /\ 0 < n ==>
5842    let a = park m n ; b = gcd m n DIV a ;
5843        p = m DIV a  ; q = (a * n) DIV (gcd m n)
5844    in
5845        b = PROD_SET (IMAGE (\p. p ** ppidx n) (park_off m n)) /\
5846        p = PROD_SET (IMAGE (\p. p ** ppidx m)
5847                      ((prime_divisors m) DIFF (park_on m n))) /\
5848        q = PROD_SET (IMAGE (\p. p ** ppidx n)
5849                      ((prime_divisors n) DIFF (park_off m n))) /\
5850        lcm m n = p * q /\ coprime p q /\ gcd m n = a * b /\ m = a * p /\
5851        n = b * q
5852Proof
5853  rpt strip_tac >>
5854  qabbrev_tac ‘s = IMAGE (\p. p ** MAX (ppidx m) (ppidx n)) (total_prime_divisors m n)’ >>
5855  qabbrev_tac ‘u = IMAGE (\p. p ** ppidx m) (park_on m n)’ >>
5856  qabbrev_tac ‘v = IMAGE (\p. p ** ppidx n) (park_off m n)’ >>
5857  qabbrev_tac ‘h = IMAGE (\p. p ** ppidx m) ((prime_divisors m) DIFF (park_on m n))’ >>
5858  qabbrev_tac ‘k = IMAGE (\p. p ** ppidx n) ((prime_divisors n) DIFF (park_off m n))’ >>
5859  qabbrev_tac ‘a = PROD_SET u’ >>
5860  qabbrev_tac ‘b = PROD_SET v’ >>
5861  qabbrev_tac ‘c = PROD_SET s’ >>
5862  qabbrev_tac ‘p = PROD_SET h’ >>
5863  qabbrev_tac ‘q = PROD_SET k’ >>
5864  qabbrev_tac ‘x = IMAGE (\p. p ** ppidx m) (prime_divisors m)’ >>
5865  qabbrev_tac ‘y = IMAGE (\p. p ** ppidx n) (prime_divisors n)’ >>
5866  qabbrev_tac ‘g = gcd m n’ >>
5867  ‘a = park m n’ by rw[Abbr‘a’] >>
5868  ‘g = a * b’ by metis_tac[gcd_park_decomposition] >>
5869  ‘c = lcm m n’ by rw[lcm_prime_factorisation, Abbr‘c’, Abbr‘s’] >>
5870  ‘s =|= h # k’ by metis_tac[park_on_off_total_image_partition] >>
5871  ‘FINITE s’ by rw[total_prime_divisors_finite, Abbr‘s’] >>
5872  ‘PAIRWISE_COPRIME s’
5873    by metis_tac[total_prime_divisors_max_image_pairwise_coprime] >>
5874  ‘(c = p * q) /\ coprime p q’
5875    by (simp[Abbr‘p’, Abbr‘q’, Abbr‘c’] >>
5876        metis_tac[pairwise_coprime_prod_set_partition]) >>
5877  ‘m = PROD_SET x’ by rw[basic_prime_factorisation, Abbr‘x’] >>
5878  ‘n = PROD_SET y’ by rw[basic_prime_factorisation, Abbr‘y’] >>
5879  ‘m = a * p’
5880    by (‘h = x DIFF u’
5881         by (‘park_on m n SUBSET prime_divisors m’
5882              by metis_tac[park_on_element,prime_divisors_element,SUBSET_DEF] >>
5883             ‘INJ (\p. p ** ppidx m) (prime_divisors m) UNIV’
5884               by (rw[INJ_DEF] >>
5885                   metis_tac[prime_divisors_element, prime_power_index_pos,
5886                             prime_powers_eq]) >>
5887             metis_tac[IMAGE_DIFF]) >>
5888        ‘FINITE x’ by rw[prime_divisors_finite, Abbr‘x’] >>
5889        ‘u SUBSET x’ by rw[SUBSET_DEF, Abbr‘u’, Abbr‘x’] >>
5890        ‘x =|= u # h’ by metis_tac[partition_by_subset] >>
5891        metis_tac[PROD_SET_PRODUCT_BY_PARTITION]) >>
5892  ‘n = b * q’
5893    by (‘m * n = g * c’ by metis_tac[GCD_LCM] >>
5894        ‘_ = (a * p) * (b * q)’ by rw[] >>
5895        ‘_ = m * (b * q)’ by rw[] >>
5896        metis_tac[MULT_LEFT_CANCEL, NOT_ZERO_LT_ZERO]) >>
5897  ‘m <> 0 /\ n <> 0’ by decide_tac >>
5898  ‘g <> 0 /\ c <> 0’ by metis_tac[GCD_EQ_0, LCM_EQ_0] >>
5899  ‘p <> 0 /\ a <> 0’ by metis_tac[MULT_EQ_0] >>
5900  ‘b = g DIV a’ by metis_tac[DIV_SOLVE_COMM, NOT_ZERO_LT_ZERO] >>
5901  ‘p = m DIV a’ by metis_tac[DIV_SOLVE_COMM, NOT_ZERO_LT_ZERO] >>
5902  ‘q = c DIV p’ by metis_tac[DIV_SOLVE_COMM, NOT_ZERO_LT_ZERO] >>
5903  ‘g divides a * n’ by metis_tac[divides_def, MULT_ASSOC, MULT_COMM] >>
5904  ‘c = (m * n) DIV g’ by metis_tac[lcm_def] >>
5905  ‘q = (m * n) DIV (g * p)’ by metis_tac[DIV_DIV_DIV_MULT, NOT_ZERO_LT_ZERO] >>
5906  ‘_ = (p * (a * n)) DIV (p * g)’ by metis_tac[MULT_COMM, MULT_ASSOC] >>
5907  ‘_ = (a * n) DIV g’ by metis_tac[DIV_COMMON_FACTOR, NOT_ZERO_LT_ZERO] >>
5908  metis_tac[]
5909QED
5910
5911(* Theorem: 0 < m /\ 0 < n ==> let a = park m n in let p = m DIV a in let q = (a * n) DIV (gcd m n) in
5912            (lcm m n = p * q) /\ coprime p q *)
5913(* Proof: by lcm_park_decomposition *)
5914Theorem lcm_park_decompose:
5915    !m n. 0 < m /\ 0 < n ==> let a = park m n in let p = m DIV a in let q = (a * n) DIV (gcd m n) in
5916         (lcm m n = p * q) /\ coprime p q
5917Proof
5918  metis_tac[lcm_park_decomposition]
5919QED
5920
5921(* Theorem: 0 < m /\ 0 < n ==>
5922            let a = park m n in let b = gcd m n DIV a in
5923            let p = m DIV a in let q = (a * n) DIV (gcd m n) in
5924            (lcm m n = p * q) /\ coprime p q /\ (gcd m n = a * b) /\ (m = a * p) /\ (n = b * q) *)
5925(* Proof: by lcm_park_decomposition *)
5926Theorem lcm_gcd_park_decompose:
5927    !m n. 0 < m /\ 0 < n ==>
5928        let a = park m n in let b = gcd m n DIV a in
5929        let p = m DIV a in let q = (a * n) DIV (gcd m n) in
5930         (lcm m n = p * q) /\ coprime p q /\ (gcd m n = a * b) /\ (m = a * p) /\ (n = b * q)
5931Proof
5932  metis_tac[lcm_park_decomposition]
5933QED
5934
5935(* ------------------------------------------------------------------------- *)
5936(* Consecutive LCM Recurrence                                                *)
5937(* ------------------------------------------------------------------------- *)
5938
5939(*
5940> optionTheory.some_def;
5941val it = |- !P. $some P = if ?x. P x then SOME (@x. P x) else NONE: thm
5942*)
5943
5944(*
5945Cannot do this: Definition is schematic in the following variables: p
5946
5947val lcm_fun_def = Define`
5948  lcm_fun n = if n = 0 then 1
5949      else if n = 1 then 1
5950    else if ?p k. 0 < k /\ prime p /\ (n = p ** k) then p * lcm_fun (n - 1)
5951  else lcm_fun (n - 1)
5952`;
5953*)
5954
5955(* NOT this:
5956val lcm_fun_def = Define`
5957  (lcm_fun 1 = 1) /\
5958  (lcm_fun (SUC n) = case some p. ?k. (SUC n = p ** k) of
5959                    SOME p => p * (lcm_fun n)
5960                  | NONE   => lcm_fun n)
5961`;
5962*)
5963
5964(*
5965Question: don't know how to prove termination
5966(* Define the B(n) function *)
5967val lcm_fun_def = Define`
5968  (lcm_fun 1 = 1) /\
5969  (lcm_fun n = case some p. ?k. 0 < k /\ prime p /\ (n = p ** k) of
5970                    SOME p => p * (lcm_fun (n - 1))
5971                  | NONE   => lcm_fun (n - 1))
5972`;
5973
5974(* use a measure that is decreasing *)
5975e (WF_REL_TAC `measure (\n k. k * n)`);
5976e (rpt strip_tac);
5977*)
5978
5979(* Define the Consecutive LCM Function *)
5980Definition lcm_fun_def:
5981  (lcm_fun 0 = 1) /\
5982  (lcm_fun (SUC n) = if n = 0 then 1 else
5983      case some p. ?k. 0 < k /\ prime p /\ (SUC n = p ** k) of
5984        SOME p => p * (lcm_fun n)
5985      | NONE   => lcm_fun n)
5986End
5987
5988(* Another possible definition -- but need to work with pairs:
5989
5990val lcm_fun_def = Define`
5991  (lcm_fun 0 = 1) /\
5992  (lcm_fun (SUC n) = if n = 0 then 1 else
5993      case some (p, k). 0 < k /\ prime p /\ (SUC n = p ** k) of
5994        SOME (p, k) => p * (lcm_fun n)
5995      | NONE        => lcm_fun n)
5996`;
5997
5998By prime_powers_eq, when SOME, such (p, k) exists uniquely, or NONE.
5999*)
6000
6001(* Get components of definition *)
6002Theorem lcm_fun_0 = lcm_fun_def |> CONJUNCT1;
6003(* val lcm_fun_0 = |- lcm_fun 0 = 1: thm *)
6004Theorem lcm_fun_SUC = lcm_fun_def |> CONJUNCT2;
6005(* val lcm_fun_SUC = |- !n. lcm_fun (SUC n) = if n = 0 then 1 else
6006                            case some p. ?k. SUC n = p ** k of
6007                            NONE => lcm_fun n | SOME p => p * lcm_fun n: thm *)
6008
6009(* Theorem: lcm_fun 1 = 1 *)
6010(* Proof:
6011     lcm_fun 1
6012   = lcm_fun (SUC 0)   by ONE
6013   = 1                 by lcm_fun_def
6014*)
6015Theorem lcm_fun_1:
6016    lcm_fun 1 = 1
6017Proof
6018  rw_tac bool_ss[lcm_fun_def, ONE]
6019QED
6020
6021(* Theorem: lcm_fun 2 = 2 *)
6022(* Proof:
6023   Note 2 = 2 ** 1                by EXP_1
6024    and prime 2                   by PRIME_2
6025    and 0 < k /\ prime p /\ (2 ** 1 = p ** k)
6026    ==> (p = 2) /\ (k = 1)        by prime_powers_eq
6027
6028     lcm_fun 2
6029   = lcm_fun (SUC 1)              by TWO
6030   = case some p. ?k. 0 < k /\ prime p /\ (SUC 1 = p ** k) of
6031       SOME p => p * (lcm_fun 1)
6032     | NONE   => lcm_fun 1)       by lcm_fun_def
6033   = SOME 2                       by some_intro, above
6034   = 2 * (lcm_fun 1)              by definition
6035   = 2 * 1                        by lcm_fun_1
6036   = 2                            by arithmetic
6037*)
6038Theorem lcm_fun_2:
6039  lcm_fun 2 = 2
6040Proof
6041  simp_tac bool_ss[lcm_fun_def, lcm_fun_1, TWO] >>
6042  `prime 2 /\ (2 = 2 ** 1)` by rw[PRIME_2] >>
6043  DEEP_INTRO_TAC some_intro >>
6044  rw_tac std_ss[]
6045  >- metis_tac[prime_powers_eq] >>
6046  metis_tac[DECIDE``0 <> 1``]
6047QED
6048
6049(* Theorem: prime p /\ (?k. 0 < k /\ (SUC n = p ** k)) ==> (lcm_fun (SUC n) = p * lcm_fun n) *)
6050(* Proof: by lcm_fun_def, prime_powers_eq *)
6051Theorem lcm_fun_suc_some:
6052  !n p. prime p /\ (?k. 0 < k /\ (SUC n = p ** k)) ==>
6053        lcm_fun (SUC n) = p * lcm_fun n
6054Proof
6055  rw[lcm_fun_def] >>
6056  DEEP_INTRO_TAC some_intro >>
6057  rw_tac std_ss[] >>
6058  metis_tac[prime_powers_eq, DECIDE “~(0 < 0)”]
6059QED
6060
6061(* Theorem: ~(?p k. 0 < k /\ prime p /\ (SUC n = p ** k)) ==> (lcm_fun (SUC n) = lcm_fun n) *)
6062(* Proof: by lcm_fun_def *)
6063Theorem lcm_fun_suc_none:
6064    !n. ~(?p k. 0 < k /\ prime p /\ (SUC n = p ** k)) ==> (lcm_fun (SUC n) = lcm_fun n)
6065Proof
6066  rw[lcm_fun_def] >>
6067  DEEP_INTRO_TAC some_intro >>
6068  rw_tac std_ss[] >>
6069  `k <> 0` by decide_tac >>
6070  metis_tac[]
6071QED
6072
6073(* Theorem: prime p /\ l <> [] /\ POSITIVE l ==> !x. MEM x l ==> ppidx x <= ppidx (list_lcm l) *)
6074(* Proof:
6075   Note ppidx (list_lcm l) = MAX_LIST (MAP ppidx l)   by list_lcm_prime_power_index
6076    and MEM (ppidx x) (MAP ppidx l)                   by MEM_MAP, MEM x l
6077   Thus ppidx x <= ppidx (list_lcm l)                 by MAX_LIST_PROPERTY
6078*)
6079Theorem list_lcm_prime_power_index_lower:
6080    !l p. prime p /\ l <> [] /\ POSITIVE l ==> !x. MEM x l ==> ppidx x <= ppidx (list_lcm l)
6081Proof
6082  rpt strip_tac >>
6083  `ppidx (list_lcm l) = MAX_LIST (MAP ppidx l)` by rw[list_lcm_prime_power_index] >>
6084  `MEM (ppidx x) (MAP ppidx l)` by metis_tac[MEM_MAP] >>
6085  rw[MAX_LIST_PROPERTY]
6086QED
6087
6088(*
6089The keys to show list_lcm_eq_lcm_fun are:
6090(1) Given a number n and a prime p that divides n, you can extract all the p's in n,
6091    giving n = (p ** k) * q for some k, and coprime p q. This is FACTOR_OUT_PRIME, or FACTOR_OUT_POWER.
6092(2) To figure out the LCM, use the GCD_LCM identity, i.e. figure out first the GCD.
6093
6094Therefore, let m = consecutive LCM.
6095Consider given two number m, n; and a prime p with p divides n.
6096By (1), n = (p ** k) * q, with coprime p q.
6097If q > 1, then n = a * b where a, b are both less than n, and coprime a b: take a = p ** k, b = q.
6098          Now, if a divides m, and b divides m --- which is the case when m = consecutive LCM,
6099          By coprime a b, (a * b) divides m, or n divides m,
6100          or gcd m n = n       by divides_iff_gcd_fix
6101          or lcm m n = (m * n) DIV (gcd m n) = (m * n) DIV n = m (or directly by divides_iff_lcm_fix)
6102If q = 1, then n is a pure prime p power: n = p ** k, with k > 0.
6103          Now, m = (p ** j) * t  with coprime p t, although it may be that j = 0.
6104          For list LCM, j <= k, since the numbers are consecutive. In fact, j = k - 1
6105          Thus n = (p ** j) * p, and gcd m n = (p ** j) gcd p t = (p ** j)  by GCD_COMMON_FACTOR
6106          or lcm m n = (m * n) DIV (gcd m n)
6107                     = m * (n DIV (p ** j))
6108                     = m * ((p ** j) * p) DIV (p ** j)
6109                     = m * p = p * m
6110*)
6111
6112(* Theorem: prime p /\ (n + 2 = p ** k) ==> (list_lcm [1 .. (n + 2)] = p * list_lcm [1 .. (n + 1)]) *)
6113(* Proof:
6114   Note n + 2 = SUC (SUC n) <> 1         by ADD1, TWO
6115   Thus p ** k <> 1, or k <> 0           by EXP_EQ_1
6116    ==> ?h. k = SUC h                    by num_CASES
6117    and n + 2 = x ** SUC h               by above
6118
6119    Let l = [1 .. (n + 1)], m = list_lcm l.
6120    Note POSITIVE l                      by leibniz_vertical_pos, EVERY_MEM
6121     Now h < SUC h = k                   by LESS_SUC
6122      so p ** h < p ** k = n + 2         by EXP_BASE_LT_MONO, 1 < p
6123     ==> MEM (p ** h) l                  by leibniz_vertical_mem
6124    Note l <> []                         by leibniz_vertical_not_nil
6125      so ppidx (p ** h) <= ppidx m       by list_lcm_prime_power_index_lower
6126      or              h <= ppidx m       by prime_power_index_prime_power
6127
6128    Claim: ppidx m <= h
6129    Proof: By contradiction, suppose h < ppidx m.
6130           Then k <= ppidx m                       by k = SUC h
6131            and p ** k divides p ** (ppidx m)      by power_divides_iff
6132            But p ** (ppidx m) divides m           by prime_power_factor_divides
6133             so p ** k divides m                   by DIVIDES_TRANS
6134            ==> ?z. MEM z l /\ (n + 2) divides z   by list_lcm_prime_power_factor_member
6135             or (n + 2) <= z                       by DIVIDES_LE, 0 < z, all members are positive
6136            Now z <= n + 1                         by leibniz_vertical_mem
6137           This leads to a contradiction: n + 2 <= n + 1.
6138
6139    Therefore ppidx m = h                          by h <= ppidx m /\ ppidx m <= h, by Claim.
6140
6141       list_lcm [1 .. (n + 2)]
6142     = list_lcm (SNOC (n + 2) l)                   by leibniz_vertical_snoc, n + 2 = SUC (n + 1)
6143     = lcm (n + 2) m                               by list_lcm_snoc
6144     = p * m                                       by lcm_special_for_prime_power
6145*)
6146Theorem list_lcm_with_last_prime_power:
6147    !n p k. prime p /\ (n + 2 = p ** k) ==> (list_lcm [1 .. (n + 2)] = p * list_lcm [1 .. (n + 1)])
6148Proof
6149  rpt strip_tac >>
6150  `n + 2 <> 1` by decide_tac >>
6151  `0 <> k` by metis_tac[EXP_EQ_1] >>
6152  `?h. k = SUC h` by metis_tac[num_CASES] >>
6153  qabbrev_tac `l = leibniz_vertical n` >>
6154  qabbrev_tac `m = list_lcm l` >>
6155  `POSITIVE l` by rw[leibniz_vertical_pos, EVERY_MEM, Abbr`l`] >>
6156  `h < k` by rw[] >>
6157  `1 < p` by rw[ONE_LT_PRIME] >>
6158  `p ** h < p ** k` by rw[EXP_BASE_LT_MONO] >>
6159  `0 < p ** h` by rw[PRIME_POS, EXP_POS] >>
6160  `p ** h <= n + 1` by decide_tac >>
6161  `MEM (p ** h) l` by rw[leibniz_vertical_mem, Abbr`l`] >>
6162  `ppidx (p ** h) = h` by rw[prime_power_index_prime_power] >>
6163  `l <> []` by rw[leibniz_vertical_not_nil, Abbr`l`] >>
6164  `h <= ppidx m` by metis_tac[list_lcm_prime_power_index_lower] >>
6165  `ppidx m <= h` by
6166  (spose_not_then strip_assume_tac >>
6167  `k <= ppidx m` by decide_tac >>
6168  `p ** k divides p ** (ppidx m)` by rw[power_divides_iff] >>
6169  `p ** (ppidx m) divides m` by rw[prime_power_factor_divides] >>
6170  `p ** k divides m` by metis_tac[DIVIDES_TRANS] >>
6171  `?z. MEM z l /\ (n + 2) divides z` by metis_tac[list_lcm_prime_power_factor_member] >>
6172  `(n + 2) <= z` by rw[DIVIDES_LE] >>
6173  `z <= n + 1` by metis_tac[leibniz_vertical_mem, Abbr`l`] >>
6174  decide_tac) >>
6175  `h = ppidx m` by decide_tac >>
6176  `list_lcm [1 .. (n + 2)] = list_lcm (SNOC (n + 2) l)` by rw[GSYM leibniz_vertical_snoc, Abbr`l`] >>
6177  `_ = lcm (n + 2) m` by rw[list_lcm_snoc, Abbr`m`] >>
6178  `_ = p * m` by rw[lcm_special_for_prime_power] >>
6179  rw[]
6180QED
6181
6182(* Theorem: (!p k. (k = 0) \/ ~prime p \/ n + 2 <> p ** k) ==>
6183            (list_lcm [1 .. (n + 2)] = list_lcm [1 .. (n + 1)]) *)
6184(* Proof:
6185   Note 1 < n + 2,
6186    ==> ?a b. (n + 2 = a * b) /\ coprime a b /\
6187              1 < a /\ 1 < b /\ a < n + 2 /\ b < n + 2    by prime_power_or_coprime_factors
6188     or 0 < a /\ 0 < b /\ a <= n + 1 /\ b <= n + 1        by arithmetic
6189    Let l = leibniz_vertical n, m = list_lcm l.
6190    Then MEM a l and MEM b l                              by leibniz_vertical_mem
6191     and a divides m /\ b divides m                       by list_lcm_is_common_multiple
6192     ==> (n + 2) divides m                                by coprime_product_divides, coprime a b
6193
6194      list_lcm (leibniz_vertical (n + 1))
6195    = list_lcm (SNOC (n + 2) l)                           by leibniz_vertical_snoc
6196    = lcm (n + 2) m                                       by list_lcm_snoc
6197    = m                                                   by divides_iff_lcm_fix
6198*)
6199Theorem list_lcm_with_last_non_prime_power:
6200    !n. (!p k. (k = 0) \/ ~prime p \/ n + 2 <> p ** k) ==>
6201       (list_lcm [1 .. (n + 2)] = list_lcm [1 .. (n + 1)])
6202Proof
6203  rpt strip_tac >>
6204  `1 < n + 2` by decide_tac >>
6205  `!k. ~(0 < k) = (k = 0)` by decide_tac >>
6206  `?a b. (n + 2 = a * b) /\ coprime a b /\ 1 < a /\ 1 < b /\ a < n + 2 /\ b < n + 2` by metis_tac[prime_power_or_coprime_factors] >>
6207  `0 < a /\ 0 < b /\ a <= n + 1 /\ b <= n + 1` by decide_tac >>
6208  qabbrev_tac `l = leibniz_vertical n` >>
6209  qabbrev_tac `m = list_lcm l` >>
6210  `MEM a l /\ MEM b l` by rw[leibniz_vertical_mem, Abbr`l`] >>
6211  `a divides m /\ b divides m` by rw[list_lcm_is_common_multiple, Abbr`m`] >>
6212  `(n + 2) divides m` by rw[coprime_product_divides] >>
6213  `list_lcm [1 .. (n + 2)] = list_lcm (SNOC (n + 2) l)` by rw[GSYM leibniz_vertical_snoc, Abbr`l`] >>
6214  `_ = lcm (n + 2) m` by rw[list_lcm_snoc, Abbr`m`] >>
6215  `_ = m` by rw[GSYM divides_iff_lcm_fix] >>
6216  rw[]
6217QED
6218
6219(* Theorem: list_lcm [1 .. (n + 1)] = lcm_fun (n + 1) *)
6220(* Proof:
6221   By induction on n.
6222   Base: list_lcm [1 .. 0 + 1] = lcm_fun (0 + 1)
6223      LHS = list_lcm [1 .. 0 + 1]
6224          = list_lcm [1]                by leibniz_vertical_0
6225          = 1                           by list_lcm_sing
6226      RHS = lcm_fun (0 + 1)
6227          = lcm_fun 1                   by ADD
6228          = 1 = LHS                     by lcm_fun_1
6229   Step: list_lcm [1 .. n + 1] = lcm_fun (n + 1) ==>
6230         list_lcm [1 .. SUC n + 1] = lcm_fun (SUC n + 1)
6231      Note (SUC n) <> 0                 by SUC_NOT_ZERO
6232       and n + 2 = SUC (SUC n)          by ADD1, TWO
6233      By lcm_fun_def, this is to show:
6234         list_lcm [1 .. SUC n + 1] = case some p. ?k. 0 < k /\ prime p /\ (SUC (SUC n) = p ** k) of
6235                                       NONE => lcm_fun (SUC n)
6236                                     | SOME p => p * lcm_fun (SUC n)
6237
6238      If SOME,
6239         Then 0 < k /\ prime p /\ SUC (SUC n) = p ** k
6240         This is the case of perfect prime power.
6241            list_lcm (leibniz_vertical (SUC n))
6242          = list_lcm (leibniz_vertical (n + 1))    by ADD1
6243          = p * list_lcm (leibniz_vertical n)      by list_lcm_with_last_prime_power
6244          = p * lcm_fun (SUC n)                    by induction hypothesis
6245      If NONE,
6246         Then !x k. ~(0 < k) \/ ~prime x \/ SUC (SUC n) <> x ** k
6247         This is the case of non-perfect prime power.
6248             list_lcm (leibniz_vertical (SUC n))
6249           = list_lcm (leibniz_vertical (n + 1))   by ADD1
6250           = list_lcm (leibniz_vertical n)         by list_lcm_with_last_non_prime_power
6251           = lcm_fun (SUC n)                       by induction hypothesis
6252*)
6253Theorem list_lcm_eq_lcm_fun:
6254    !n. list_lcm [1 .. (n + 1)] = lcm_fun (n + 1)
6255Proof
6256  Induct >-
6257  rw[leibniz_vertical_0, list_lcm_sing, lcm_fun_1] >>
6258  `(SUC n) + 1 = SUC (SUC n)` by rw[] >>
6259  `list_lcm [1 .. SUC n + 1] = case some p. ?k. 0 < k /\ prime p /\ ((SUC n) + 1 = p ** k) of
6260                                       NONE => lcm_fun (SUC n)
6261                                     | SOME p => p * lcm_fun (SUC n)` suffices_by rw[lcm_fun_def] >>
6262  `n + 2 = (SUC n) + 1` by rw[] >>
6263  DEEP_INTRO_TAC some_intro >>
6264  rw[] >-
6265  metis_tac[list_lcm_with_last_prime_power, ADD1] >>
6266  metis_tac[list_lcm_with_last_non_prime_power, ADD1]
6267QED
6268
6269(* This is a major milestone theorem! *)
6270
6271(* Theorem: 2 ** n <= lcm_fun (SUC n) *)
6272(* Proof:
6273   Note 2 ** n <= list_lcm (leibniz_vertical n)          by lcm_lower_bound
6274    and list_lcm (leibniz_vertical n) = lcm_fun (SUC n)  by list_lcm_eq_lcm_fun\
6275     so 2 ** n <= lcm_fun (SUC n)
6276*)
6277Theorem lcm_fun_lower_bound:
6278    !n. 2 ** n <= lcm_fun (n + 1)
6279Proof
6280  rw[GSYM list_lcm_eq_lcm_fun, lcm_lower_bound]
6281QED
6282
6283(* Theorem: 0 < n ==> 2 ** (n - 1) <= lcm_fun n *)
6284(* Proof:
6285   Note 0 < n ==> ?m. n = SUC m      by num_CASES
6286     or m = n - 1                    by SUC_SUB1
6287   Apply lcm_fun_lower_bound,
6288     put n = SUC m, and the result follows.
6289*)
6290Theorem lcm_fun_lower_bound_alt:
6291    !n. 0 < n ==> 2 ** (n - 1) <= lcm_fun n
6292Proof
6293  rpt strip_tac >>
6294  `n <> 0` by decide_tac >>
6295  `?m. n = SUC m` by metis_tac[num_CASES] >>
6296  `(n - 1 = m) /\ (n = m + 1)` by decide_tac >>
6297  metis_tac[lcm_fun_lower_bound]
6298QED
6299
6300(* Theorem: 0 < n /\ prime p /\ (SUC n = p ** ppidx (SUC n)) ==>
6301            (ppidx (SUC n) = SUC (ppidx (list_lcm [1 .. n]))) *)
6302(* Proof:
6303   Let z = SUC n,
6304   Then z = p ** ppidx z              by given
6305   Note n <> 0 /\ z <> 1              by 0 < n
6306    ==> ppidx z <> 0                  by EXP_EQ_1, z <> 1
6307    ==> ?h. ppidx z = SUC h           by num_CASES
6308
6309   Let l = [1 .. n], m = list_lcm l, j = ppidx m.
6310   Current goal is to show: SUC h = SUC j
6311   which only need to show:     h = j    by INV_SUC_EQ
6312   Note l <> []                          by listRangeINC_NIL
6313    and POSITIVE l                       by listRangeINC_MEM, [1]
6314   Also 1 < p                            by ONE_LT_PRIME
6315
6316   Claim: h <= j
6317   Proof: Note h < SUC h                 by LESS_SUC
6318          Thus p ** h < z = p ** SUC h   by EXP_BASE_LT_MONO, 1 < p
6319           ==> p ** h <= n               by z = SUC n
6320          Also 0 < p ** h                by EXP_POS, 0 < p
6321           ==> MEM (p ** h) l            by listRangeINC_MEM, 0 < p ** h /\ p ** h <= n
6322          Note ppidx (p ** h) = h        by prime_power_index_prime_power
6323          Thus h <= j = ppidx m          by list_lcm_prime_power_index_lower, l <> []
6324
6325   Claim: j <= h
6326   Proof: By contradiction, suppose h < j.
6327          Then SUC h <= j                by arithmetic
6328           ==> z divides p ** j          by power_divides_iff, 1 < p, z = p ** SUC h, SUC h <= j
6329           But p ** j divides m          by prime_power_factor_divides
6330           ==> z divides m               by DIVIDES_TRANS
6331          Thus ?y. MEM y l /\ z divides y    by list_lcm_prime_power_factor_member, l <> []
6332          Note 0 < y                     by all members of l, [1]
6333            so z <= y                    by DIVIDES_LE, 0 < y
6334            or SUC n <= y                by z = SUC n
6335           But ?u. n = u + 1             by num_CASES, ADD1, n <> 0
6336            so y <= n                    by listRangeINC_MEM, MEM y l
6337          This leads to SUC n <= n, a contradiction.
6338
6339   By these two claims, h = j.
6340*)
6341Theorem prime_power_index_suc_special:
6342    !n p. 0 < n /\ prime p /\ (SUC n = p ** ppidx (SUC n)) ==>
6343         (ppidx (SUC n) = SUC (ppidx (list_lcm [1 .. n])))
6344Proof
6345  rpt strip_tac >>
6346  qabbrev_tac `z = SUC n` >>
6347  `n <> 0 /\ z <> 1` by rw[Abbr`z`] >>
6348  `?h. ppidx z = SUC h` by metis_tac[EXP_EQ_1, num_CASES] >>
6349  qabbrev_tac `l = [1 .. n]` >>
6350  qabbrev_tac `m = list_lcm l` >>
6351  qabbrev_tac `j = ppidx m` >>
6352  `h <= j /\ j <= h` suffices_by rw[] >>
6353  `l <> []` by rw[listRangeINC_NIL, Abbr`l`] >>
6354  `POSITIVE l` by rw[Abbr`l`] >>
6355  `1 < p` by rw[ONE_LT_PRIME] >>
6356  rpt strip_tac >| [
6357    `h < SUC h` by rw[] >>
6358    `p ** h < z` by metis_tac[EXP_BASE_LT_MONO] >>
6359    `p ** h <= n` by rw[Abbr`z`] >>
6360    `0 < p ** h` by rw[EXP_POS] >>
6361    `MEM (p ** h) l` by rw[Abbr`l`] >>
6362    metis_tac[prime_power_index_prime_power, list_lcm_prime_power_index_lower],
6363    spose_not_then strip_assume_tac >>
6364    `SUC h <= j` by decide_tac >>
6365    `z divides p ** j` by metis_tac[power_divides_iff] >>
6366    `p ** j divides m` by rw[prime_power_factor_divides, Abbr`j`] >>
6367    `z divides m` by metis_tac[DIVIDES_TRANS] >>
6368    `?y. MEM y l /\ z divides y` by metis_tac[list_lcm_prime_power_factor_member] >>
6369    `SUC n <= y` by rw[DIVIDES_LE, Abbr`z`] >>
6370    `y <= n` by metis_tac[listRangeINC_MEM] >>
6371    decide_tac
6372  ]
6373QED
6374
6375(* Theorem: 0 < n /\ prime p /\ (n + 1 = p ** ppidx (n + 1)) ==>
6376            (ppidx (n + 1) = 1 + (ppidx (list_lcm [1 .. n]))) *)
6377(* Proof: by prime_power_index_suc_special, ADD1, ADD_COMM *)
6378Theorem prime_power_index_suc_property:
6379    !n p. 0 < n /\ prime p /\ (n + 1 = p ** ppidx (n + 1)) ==>
6380         (ppidx (n + 1) = 1 + (ppidx (list_lcm [1 .. n])))
6381Proof
6382  metis_tac[prime_power_index_suc_special, ADD1, ADD_COMM]
6383QED
6384
6385(* ------------------------------------------------------------------------- *)
6386(* Consecutive LCM Recurrence - Rework                                        *)
6387(* ------------------------------------------------------------------------- *)
6388
6389(* Theorem: SING (prime_divisors (n + 1)) ==>
6390            (list_lcm [1 .. (n + 1)] = CHOICE (prime_divisors (n + 1)) * list_lcm [1 .. n]) *)
6391(* Proof:
6392   Let z = n + 1.
6393   Then ?p. prime_divisors z = {p}      by SING_DEF
6394   By CHOICE_SING, this is to show: list_lcm [1 .. z] = p * list_lcm [1 .. n]
6395
6396   Note prime p /\ (z = p ** ppidx z)   by prime_divisors_sing_property, CHOICE_SING
6397    and z <> 1 /\ n <> 0                by prime_divisors_1, NOT_SING_EMPTY, ADD
6398   Note ppidx z <> 0                    by EXP_EQ_1, z <> 1
6399    ==> ?h. ppidx z = SUC h             by num_CASES, EXP
6400   Thus z = p ** SUC h = p ** h * p     by EXP, MULT_COMM
6401
6402   Let m = list_lcm [1 .. n], j = ppidx m.
6403   Note EVERY_POSITIVE l                by listRangeINC_MEM, EVERY_MEM
6404     so 0 < m                           by list_lcm_pos
6405    ==> ?q. (m = p ** j * q) /\
6406            coprime p q                 by prime_power_index_eqn
6407   Note 0 < n                           by n <> 0
6408   Thus SUC h = SUC j                   by prime_power_index_suc_special, ADD1, 0 < n
6409     or     h = j                       by INV_SUC_EQ
6410
6411        list_lcm [1 .. z]
6412      = lcm z m                         by list_lcm_suc
6413      = p * m                           by lcm_special_for_prime_power
6414*)
6415Theorem list_lcm_by_last_prime_power:
6416  !n.
6417    SING (prime_divisors (n + 1)) ==>
6418    list_lcm [1 .. (n + 1)] =
6419    CHOICE (prime_divisors (n + 1)) * list_lcm [1 .. n]
6420Proof
6421  rpt strip_tac >>
6422  qabbrev_tac ‘z = n + 1’ >>
6423  ‘?p. prime_divisors z = {p}’ by rw[GSYM SING_DEF] >>
6424  rw[] >>
6425  ‘prime p /\ (z = p ** ppidx z)’ by metis_tac[prime_divisors_sing_property, CHOICE_SING] >>
6426  ‘z <> 1 /\ n <> 0’ by metis_tac[prime_divisors_1, NOT_SING_EMPTY, ADD] >>
6427  ‘?h. ppidx z = SUC h’ by metis_tac[EXP_EQ_1, num_CASES] >>
6428  qabbrev_tac ‘m = list_lcm [1 .. n]’ >>
6429  qabbrev_tac ‘j = ppidx m’ >>
6430  ‘0 < m’ by rw[list_lcm_pos, EVERY_MEM, Abbr‘m’] >>
6431  ‘?q. (m = p ** j * q) /\ coprime p q’ by metis_tac[prime_power_index_eqn] >>
6432  ‘0 < n’ by decide_tac >>
6433  ‘SUC h = SUC j’ by metis_tac[prime_power_index_suc_special, ADD1] >>
6434  ‘h = j’ by decide_tac >>
6435  ‘list_lcm [1 .. z] = lcm z m’ by rw[list_lcm_suc, Abbr‘z’, Abbr‘m’] >>
6436  ‘_ = p * m’ by metis_tac[lcm_special_for_prime_power] >>
6437  rw[]
6438QED
6439
6440(* Theorem: ~ SING (prime_divisors (n + 1)) ==> (list_lcm [1 .. (n + 1)] = list_lcm [1 .. n]) *)
6441(* Proof:
6442   Let z = n + 1, l = [1 .. n], m = list_lcm l.
6443   The goal is to show: list_lcm [1 .. z] = m.
6444
6445   If z = 1,
6446      Then n = 0               by 1 = n + 1
6447      LHS = list_lcm [1 .. z]
6448          = list_lcm [1 .. 1]    by z = 1
6449          = list_lcm [1]         by listRangeINC_SING
6450          = 1                    by list_lcm_sing
6451      RHS = list_lcm [1 .. n]
6452          = list_lcm [1 .. 0]    by n = 0
6453          = list_lcm []          by listRangeINC_EMPTY
6454          = 1 = LHS              by list_lcm_nil
6455   If z <> 1,
6456      Note z <> 0, or 0 < z      by z = n + 1
6457       ==> ?p. prime p /\ p divides z       by PRIME_FACTOR, z <> 1
6458       and 0 < ppidx z                      by prime_power_index_pos, 0 < z
6459       Let t = p ** ppidx z.
6460      Then ?q. (z = t * q) /\ coprime p q   by prime_power_index_eqn, 0 < z
6461       ==> coprime t q                      by coprime_exp
6462      Thus t <> 0 /\ q <> 0                 by MULT_EQ_0, z <> 0
6463       and q <> 1                           by prime_divisors_sing, MULT_RIGHT_1, ~SING (prime_divisors z)
6464      Note p <> 1                           by NOT_PRIME_1
6465       and t <> 1                           by EXP_EQ_1, ppidx z <> 0
6466      Thus 0 < q /\ q < n + 1               by z = t * q = n + 1
6467       and 0 < t /\ t < n + 1               by z = t * q = n + 1
6468
6469      Then MEM q l                          by listRangeINC_MEM, 1 <= q <= n
6470       and MEM t l                          by listRangeINC_MEM, 1 <= t <= n
6471       ==> q divides m /\ t divides m       by list_lcm_is_common_multiple
6472       ==> q * t = z divides m              by coprime_product_divides, coprime t q
6473
6474         list_lcm [1 .. z]
6475       = lcm z m                 by list_lcm_suc
6476       = m                       by divides_iff_lcm_fix
6477*)
6478
6479Theorem list_lcm_by_last_non_prime_power:
6480  !n. ~ SING (prime_divisors (n + 1)) ==>
6481      list_lcm [1 .. (n + 1)] = list_lcm [1 .. n]
6482Proof
6483  rpt strip_tac >>
6484  qabbrev_tac `z = n + 1` >>
6485  Cases_on `z = 1` >| [
6486    `n = 0` by rw[Abbr`z`] >>
6487    `([1 .. z] = [1]) /\ ([1 .. n] = [])` by rw[listRangeINC_EMPTY] >>
6488    rw[list_lcm_sing, list_lcm_nil],
6489    `z <> 0 /\ 0 < z` by rw[Abbr`z`] >>
6490    `?p. prime p /\ p divides z` by rw[PRIME_FACTOR] >>
6491    `0 < ppidx z` by rw[prime_power_index_pos] >>
6492    qabbrev_tac `t = p ** ppidx z` >>
6493    `?q. (z = t * q) /\ coprime p q /\ coprime t q`
6494      by metis_tac[prime_power_index_eqn, coprime_exp] >>
6495    `t <> 0 /\ q <> 0` by metis_tac[MULT_EQ_0] >>
6496    `q <> 1` by metis_tac[prime_divisors_sing, MULT_RIGHT_1] >>
6497    `t <> 1` by metis_tac[EXP_EQ_1, NOT_PRIME_1, NOT_ZERO_LT_ZERO] >>
6498    `0 < q /\ q < n + 1` by rw[Abbr`z`] >>
6499    `0 < t /\ t < n + 1` by rw[Abbr`z`] >>
6500    qabbrev_tac `l = [1 .. n]` >>
6501    qabbrev_tac `m = list_lcm l` >>
6502    `MEM q l /\ MEM t l` by rw[Abbr`l`] >>
6503    `q divides m /\ t divides m`
6504      by simp[list_lcm_is_common_multiple, Abbr`m`] >>
6505    `z divides m`
6506      by (simp[] >> metis_tac[coprime_sym, coprime_product_divides]) >>
6507    `list_lcm [1 .. z] = lcm z m` by rw[list_lcm_suc, Abbr`z`, Abbr`m`] >>
6508    `_ = m` by rw[GSYM divides_iff_lcm_fix] >>
6509    rw[]
6510  ]
6511QED
6512
6513(* Theorem: list_lcm [1 .. (n + 1)] = let s = prime_divisors (n + 1) in
6514            if SING s then CHOICE s * list_lcm [1 .. n] else list_lcm [1 .. n] *)
6515(* Proof: by list_lcm_with_last_prime_power, list_lcm_with_last_non_prime_power *)
6516Theorem list_lcm_recurrence:
6517    !n. list_lcm [1 .. (n + 1)] = let s = prime_divisors (n + 1) in
6518       if SING s then CHOICE s * list_lcm [1 .. n] else list_lcm [1 .. n]
6519Proof
6520  rw[list_lcm_by_last_prime_power, list_lcm_by_last_non_prime_power]
6521QED
6522
6523(* Theorem: (prime_divisors (n + 1) = {p}) ==> (list_lcm [1 .. (n + 1)] = p * list_lcm [1 .. n]) *)
6524(* Proof: by list_lcm_by_last_prime_power, SING_DEF *)
6525Theorem list_lcm_option_last_prime_power:
6526    !n p. (prime_divisors (n + 1) = {p}) ==> (list_lcm [1 .. (n + 1)] = p * list_lcm [1 .. n])
6527Proof
6528  rw[list_lcm_by_last_prime_power, SING_DEF]
6529QED
6530
6531(* Theorem:  (!p. prime_divisors (n + 1) <> {p}) ==> (list_lcm [1 .. (n + 1)] = list_lcm [1 .. n]) *)
6532(* Proof: by ist_lcm_by_last_non_prime_power, SING_DEF *)
6533Theorem list_lcm_option_last_non_prime_power:
6534    !n. (!p. prime_divisors (n + 1) <> {p}) ==> (list_lcm [1 .. (n + 1)] = list_lcm [1 .. n])
6535Proof
6536  rw[list_lcm_by_last_non_prime_power, SING_DEF]
6537QED
6538
6539(* Theorem: list_lcm [1 .. (n + 1)] = case some p. (prime_divisors (n + 1)) = {p} of
6540              NONE => list_lcm [1 .. n]
6541            | SOME p => p * list_lcm [1 .. n] *)
6542(* Proof:
6543   For SOME p, true by list_lcm_option_last_prime_power
6544   For NONE, true   by list_lcm_option_last_non_prime_power
6545*)
6546Theorem list_lcm_option_recurrence:
6547    !n. list_lcm [1 .. (n + 1)] = case some p. (prime_divisors (n + 1)) = {p} of
6548              NONE => list_lcm [1 .. n]
6549            | SOME p => p * list_lcm [1 .. n]
6550Proof
6551  rpt strip_tac >>
6552  DEEP_INTRO_TAC optionTheory.some_intro >>
6553  rw[list_lcm_option_last_prime_power, list_lcm_option_last_non_prime_power]
6554QED
6555
6556(* ------------------------------------------------------------------------- *)
6557(* Relating Consecutive LCM to Prime Functions                               *)
6558(* ------------------------------------------------------------------------- *)
6559
6560(* Theorem: MEM x (SET_TO_LIST (prime_powers_upto n)) <=> ?p. (x = p ** LOG p n) /\ prime p /\ p <= n *)
6561(* Proof:
6562   Let s = prime_powers_upto n.
6563   Then FINITE s                             by prime_powers_upto_finite
6564    and !x. x IN s <=> MEM x (SET_TO_LIST s) by MEM_SET_TO_LIST
6565    The result follows                       by prime_powers_upto_element
6566*)
6567Theorem prime_powers_upto_list_mem:
6568    !n x. MEM x (SET_TO_LIST (prime_powers_upto n)) <=> ?p. (x = p ** LOG p n) /\ prime p /\ p <= n
6569Proof
6570  rw[MEM_SET_TO_LIST, prime_powers_upto_element, prime_powers_upto_finite]
6571QED
6572
6573(*
6574LOG_EQ_0  |- !a b. 1 < a /\ 0 < b ==> ((LOG a b = 0) <=> b < a)
6575*)
6576
6577(* Theorem: prime p /\ p <= n ==> p ** LOG p n divides set_lcm (prime_powers_upto n) *)
6578(* Proof:
6579   Let s = prime_powers_upto n.
6580   Note FINITE s                        by prime_powers_upto_finite
6581    and p ** LOG p n IN s               by prime_powers_upto_element_alt
6582    ==> p ** LOG p n divides set_lcm s  by set_lcm_is_common_multiple
6583*)
6584Theorem prime_powers_upto_lcm_prime_to_log_divisor:
6585    !n p. prime p /\ p <= n ==> p ** LOG p n divides set_lcm (prime_powers_upto n)
6586Proof
6587  rpt strip_tac >>
6588  `FINITE (prime_powers_upto n)` by rw[prime_powers_upto_finite] >>
6589  `p ** LOG p n IN prime_powers_upto n` by rw[prime_powers_upto_element_alt] >>
6590  rw[set_lcm_is_common_multiple]
6591QED
6592
6593(* Theorem: prime p /\ p <= n ==> p divides set_lcm (prime_powers_upto n) *)
6594(* Proof:
6595   Note 1 < p                           by ONE_LT_PRIME
6596     so LOG p n <> 0                    by LOG_EQ_0, 1 < p
6597    ==> p divides p ** LOG p n          by divides_self_power, 1 < p
6598
6599   Note p ** LOG p n divides set_lcm s  by prime_powers_upto_lcm_prime_to_log_divisor
6600   Thus p divides set_lcm s             by DIVIDES_TRANS
6601*)
6602Theorem prime_powers_upto_lcm_prime_divisor:
6603    !n p. prime p /\ p <= n ==> p divides set_lcm (prime_powers_upto n)
6604Proof
6605  rpt strip_tac >>
6606  `1 < p` by rw[ONE_LT_PRIME] >>
6607  `LOG p n <> 0` by rw[LOG_EQ_0] >>
6608  `p divides p ** LOG p n` by rw[divides_self_power] >>
6609  `p ** LOG p n divides set_lcm (prime_powers_upto n)` by rw[prime_powers_upto_lcm_prime_to_log_divisor] >>
6610  metis_tac[DIVIDES_TRANS]
6611QED
6612
6613(* Theorem: prime p /\ p <= n ==> p ** ppidx n divides set_lcm (prime_powers_upto n) *)
6614(* Proof:
6615   Note 1 < p                by ONE_LT_PRIME
6616    and 0 < n                by p <= n
6617    ==> ppidx n <= LOG p n   by prime_power_index_le_log_index, 0 < n
6618   Thus p ** ppidx n divides p ** LOG p n                   by power_divides_iff, 1 < p
6619    and p ** LOG p n divides set_lcm (prime_powers_upto n)  by prime_powers_upto_lcm_prime_to_log_divisor
6620     or p ** ppidx n divides set_lcm (prime_powers_upto n)  by DIVIDES_TRANS
6621*)
6622Theorem prime_powers_upto_lcm_prime_to_power_divisor:
6623    !n p. prime p /\ p <= n ==> p ** ppidx n divides set_lcm (prime_powers_upto n)
6624Proof
6625  rpt strip_tac >>
6626  `1 < p` by rw[ONE_LT_PRIME] >>
6627  `0 < n` by decide_tac >>
6628  `ppidx n <= LOG p n` by rw[prime_power_index_le_log_index] >>
6629  `p ** ppidx n divides p ** LOG p n` by rw[power_divides_iff] >>
6630  `p ** LOG p n divides set_lcm (prime_powers_upto n)` by rw[prime_powers_upto_lcm_prime_to_log_divisor] >>
6631  metis_tac[DIVIDES_TRANS]
6632QED
6633
6634(* The next theorem is based on this example:
6635Take n = 10,
6636prime_powers_upto 10 = {2^3; 3^2; 5^1; 7^1} = {8; 9; 5; 7}
6637set_lcm (prime_powers_upto 10) = 2520
6638For any 1 <= x <= 10, e.g. x = 6.
66396 <= 10, 6 divides set_lcm (prime_powers_upto 10).
6640
6641The reason is that:
66426 = PROD_SET (IMAGE (\p. p ** ppidx 6) (prime_divisors 6))   by prime_factorisation
6643prime_divisors 6 = {2; 3}
6644Because 2, 3 <= 6, 6 <= 10, the divisors 2,3 <= 10           by DIVIDES_LE
6645Thus 2^(LOG 2 10) = 2^3, 3^(LOG 3 10) = 3^2 IN prime_powers_upto 10)    by prime_powers_upto_element_alt
6646But  2^(ppidx 6) = 2^1 = 2 divides 6, 3^(ppidx 6) = 3^1 = 3 divides 6   by prime_power_index_def
6647 so  2^(ppidx 6) <= 10   and 3^(ppidx 6) <= 10.
6648
6649In this example, 2^1 < 2^3    3^1 < 3^2  how to compare (ppidx x) with (LOG p n) in general? ##
6650Due to this,  2^(ppidx 6) divides 2^(LOG 2 10),    by prime_powers_divide
6651       and    3^(ppidx 6) divides 3^(LOG 3 10),
6652And 2^(LOG 2 10) divides set_lcm (prime_powers_upto 10)    by prime_powers_upto_lcm_prime_to_log_divisor
6653and 3^(LOG 3 10) divides set_lcm (prime_powers_upto 10)    by prime_powers_upto_lcm_prime_to_log_divisor
6654or !z. z IN (IMAGE (\p. p ** ppidx 6) (prime_divisors 6))
6655   ==> z divides set_lcm (prime_powers_upto 10)            by verification
6656Hence set_lcm (IMAGE (\p. p ** ppidx 6) (prime_divisors 6))  divides set_lcm (prime_powers_upto 10)
6657                                                           by set_lcm_is_least_common_multiple
6658But PAIRWISE_COPRIME (IMAGE (\p. p ** ppidx 6) (prime_divisors 6)),
6659Thus set_lcm (IMAGE (\p. p ** ppidx 6) (prime_divisors 6))
6660   = PROD_SET (IMAGE (\p. p ** ppidx 6) (prime_divisors 6))    by pairwise_coprime_prod_set_eq_set_lcm
6661   = 6                                                         by above
6662Hence x divides set_lcm (prime_powers_upto 10)
6663
6664## maybe:
6665   ppidx x <= LOG p x       by prime_power_index_le_log_index
6666   LOG p x <= LOG p n       by LOG_LE_MONO
6667*)
6668
6669(* Theorem: 0 < x /\ x <= n ==> x divides set_lcm (prime_powers_upto n) *)
6670(* Proof:
6671   Note 0 < n                  by 0 < x /\ x <= n
6672   Let m = set_lcm (prime_powers_upto n).
6673   The goal becomes: x divides m.
6674
6675   Let s = prime_power_divisors x.
6676   Then x = PROD_SET s         by prime_factorisation, 0 < x
6677
6678   Claim: !z. z IN s ==> z divides m
6679   Proof: By prime_power_divisors_element, this is to show:
6680             prime p /\ p divides x ==> p ** ppidx x divides m
6681          Note p <= x                     by DIVIDES_LE, 0 < x
6682          Thus p <= n                     by p <= x, x <= n
6683           ==> p ** LOG p n IN prime_powers_upto n   by prime_powers_upto_element_alt, b <= n
6684           ==> p ** LOG p n divides m     by prime_powers_upto_lcm_prime_to_log_divisor
6685          Note 1 < p                      by ONE_LT_PRIME
6686           and ppidx x <= LOG p x         by prime_power_index_le_log_index, 0 < n
6687          also LOG p x <= LOG p n         by LOG_LE_MONO, 1 < p
6688           ==> ppidx x <= LOG p n         by arithmetic
6689           ==> p ** ppidx x divides p ** LOG p n   by power_divides_iff, 1 < p
6690          Thus p ** ppidx x divides m     by DIVIDES_TRANS
6691
6692   Note FINITE s                by prime_power_divisors_finite
6693    and set_lcm s divides m     by set_lcm_is_least_common_multiple, FINITE s
6694   Also PAIRWISE_COPRIME s      by prime_power_divisors_pairwise_coprime
6695    ==> PROD_SET s = set_lcm s  by pairwise_coprime_prod_set_eq_set_lcm
6696   Thus x divides m             by set_lcm s divides m
6697*)
6698Theorem prime_powers_upto_lcm_divisor:
6699    !n x. 0 < x /\ x <= n ==> x divides set_lcm (prime_powers_upto n)
6700Proof
6701  rpt strip_tac >>
6702  `0 < n` by decide_tac >>
6703  qabbrev_tac `m = set_lcm (prime_powers_upto n)` >>
6704  qabbrev_tac `s = prime_power_divisors x` >>
6705  `x = PROD_SET s` by rw[prime_factorisation, Abbr`s`] >>
6706  `!z. z IN s ==> z divides m` by
6707  (rw[prime_power_divisors_element, Abbr`s`] >>
6708  `p <= x` by rw[DIVIDES_LE] >>
6709  `p <= n` by decide_tac >>
6710  `p ** LOG p n IN prime_powers_upto n` by rw[prime_powers_upto_element_alt] >>
6711  `p ** LOG p n divides m` by rw[prime_powers_upto_lcm_prime_to_log_divisor, Abbr`m`] >>
6712  `1 < p` by rw[ONE_LT_PRIME] >>
6713  `ppidx x <= LOG p x` by rw[prime_power_index_le_log_index] >>
6714  `LOG p x <= LOG p n` by rw[LOG_LE_MONO] >>
6715  `ppidx x <= LOG p n` by decide_tac >>
6716  `p ** ppidx x divides p ** LOG p n` by rw[power_divides_iff] >>
6717  metis_tac[DIVIDES_TRANS]) >>
6718  `FINITE s` by rw[prime_power_divisors_finite, Abbr`s`] >>
6719  `set_lcm s divides m` by rw[set_lcm_is_least_common_multiple] >>
6720  metis_tac[prime_power_divisors_pairwise_coprime, pairwise_coprime_prod_set_eq_set_lcm]
6721QED
6722
6723(* This is a key result. *)
6724
6725(* ------------------------------------------------------------------------- *)
6726(* Consecutive LCM and Prime-related Sets                                    *)
6727(* ------------------------------------------------------------------------- *)
6728
6729(*
6730Useful:
6731list_lcm_is_common_multiple  |- !x l. MEM x l ==> x divides list_lcm l
6732list_lcm_prime_factor        |- !p l. prime p /\ p divides list_lcm l ==> p divides PROD_SET (set l)
6733list_lcm_prime_factor_member |- !p l. prime p /\ p divides list_lcm l ==> ?x. MEM x l /\ p divides x
6734prime_power_index_pos        |- !n p. 0 < n /\ prime p /\ p divides n ==> 0 < ppidx n
6735*)
6736
6737(* Theorem: lcm_run n = set_lcm (prime_powers_upto n) *)
6738(* Proof:
6739   By DIVIDES_ANTISYM, this is to show:
6740   (1) lcm_run n divides set_lcm (prime_powers_upto n)
6741       Let m = set_lcm (prime_powers_upto n)
6742       Note !x. MEM x [1 .. n] <=> 0 < x /\ x <= n   by listRangeINC_MEM
6743        and !x. 0 < x /\ x <= n ==> x divides m      by prime_powers_upto_lcm_divisor
6744       Thus lcm_run n divides m                      by list_lcm_is_least_common_multiple
6745   (2) set_lcm (prime_powers_upto n) divides lcm_run n
6746       Let s = prime_powers_upto n, m = lcm_run n
6747       Claim: !z. z IN s ==> z divides m
6748       Proof: Note ?p. (z = p ** LOG p n) /\
6749                       prime p /\ p <= n             by prime_powers_upto_element
6750               Now 0 < p                             by PRIME_POS
6751                so MEM p [1 .. n]                    by listRangeINC_MEM
6752               ==> MEM z [1 .. n]                    by self_to_log_index_member
6753              Thus z divides m                       by list_lcm_is_common_multiple
6754
6755       Note FINITE s                   by prime_powers_upto_finite
6756       Thus set_lcm s divides m        by set_lcm_is_least_common_multiple, Claim
6757*)
6758Theorem lcm_run_eq_set_lcm_prime_powers:
6759    !n. lcm_run n = set_lcm (prime_powers_upto n)
6760Proof
6761  rpt strip_tac >>
6762  (irule DIVIDES_ANTISYM >> rpt conj_tac) >| [
6763    `!x. MEM x [1 .. n] <=> 0 < x /\ x <= n` by rw[listRangeINC_MEM] >>
6764    `!x. 0 < x /\ x <= n ==> x divides set_lcm (prime_powers_upto n)` by rw[prime_powers_upto_lcm_divisor] >>
6765    rw[list_lcm_is_least_common_multiple],
6766    qabbrev_tac `s = prime_powers_upto n` >>
6767    qabbrev_tac `m = lcm_run n` >>
6768    `!z. z IN s ==> z divides m` by
6769  (rw[prime_powers_upto_element, Abbr`s`] >>
6770    `0 < p` by rw[PRIME_POS] >>
6771    `MEM p [1 .. n]` by rw[listRangeINC_MEM] >>
6772    `MEM (p ** LOG p n) [1 .. n]` by rw[self_to_log_index_member] >>
6773    rw[list_lcm_is_common_multiple, Abbr`m`]) >>
6774    `FINITE s` by rw[prime_powers_upto_finite, Abbr`s`] >>
6775    rw[set_lcm_is_least_common_multiple]
6776  ]
6777QED
6778
6779(* Theorem: set_lcm (prime_powers_upto n) = PROD_SET (prime_powers_upto n) *)
6780(* Proof:
6781   Let s = prime_powers_upto n.
6782   Note FINITE s                  by prime_powers_upto_finite
6783    and PAIRWISE_COPRIME s        by prime_powers_upto_pairwise_coprime
6784   Thus set_lcm s = PROD_SET s    by pairwise_coprime_prod_set_eq_set_lcm
6785*)
6786Theorem set_lcm_prime_powers_upto_eqn:
6787    !n. set_lcm (prime_powers_upto n) = PROD_SET (prime_powers_upto n)
6788Proof
6789  metis_tac[prime_powers_upto_finite, prime_powers_upto_pairwise_coprime, pairwise_coprime_prod_set_eq_set_lcm]
6790QED
6791
6792(* Theorem: lcm_run n = PROD_SET (prime_powers_upto n) *)
6793(* Proof:
6794     lcm_run n
6795   = set_lcm (prime_powers_upto n)
6796   = PROD_SET (prime_powers_upto n)
6797*)
6798Theorem lcm_run_eq_prod_set_prime_powers:
6799    !n. lcm_run n = PROD_SET (prime_powers_upto n)
6800Proof
6801  rw[lcm_run_eq_set_lcm_prime_powers, set_lcm_prime_powers_upto_eqn]
6802QED
6803
6804(* Theorem: PROD_SET (prime_powers_upto n) <= n ** (primes_count n) *)
6805(* Proof:
6806   Let s = (primes_upto n), f = \p. p ** LOG p n, t = prime_powers_upto n.
6807   Then IMAGE f s = t              by prime_powers_upto_def
6808    and FINITE s                   by primes_upto_finite
6809    and FINITE t                   by IMAGE_FINITE
6810
6811   Claim: !x. x IN t ==> x <= n
6812   Proof: Note x IN t ==>
6813               ?p. (x = p ** LOG p n) /\ prime p /\ p <= n   by prime_powers_upto_element
6814           Now 1 < p               by ONE_LT_PRIME
6815            so 0 < n               by 1 < p, p <= n
6816           and p ** LOG p n <= n   by LOG
6817            or x <= n
6818
6819   Thus PROD_SET t <= n ** CARD t  by PROD_SET_LE_CONSTANT, Claim
6820
6821   Claim: INJ f s t
6822   Proof: By prime_powers_upto_element_alt, primes_upto_element, INJ_DEF,
6823          This is to show: prime p /\ prime p' /\ p ** LOG p n = p' ** LOG p' n ==> p = p'
6824          Note 1 < p               by ONE_LT_PRIME
6825            so 0 < n               by 1 < p, p <= n
6826           and LOG p n <> 0        by LOG_EQ_0, p <= n
6827            or 0 < LOG p n         by NOT_ZERO_LT_ZERO
6828           ==> p = p'              by prime_powers_eq
6829
6830   Thus CARD (IMAGE f s) = CARD s  by INJ_CARD_IMAGE, Claim
6831     or PROD_SET t <= n ** CARD s  by above
6832*)
6833
6834Theorem prime_powers_upto_prod_set_le:
6835  !n. PROD_SET (prime_powers_upto n) <= n ** (primes_count n)
6836Proof
6837  rpt strip_tac >>
6838  qabbrev_tac ‘s = (primes_upto n)’ >>
6839  qabbrev_tac ‘f = \p. p ** LOG p n’ >>
6840  qabbrev_tac ‘t = prime_powers_upto n’ >>
6841  ‘IMAGE f s = t’ by simp[prime_powers_upto_def, Abbr‘f’, Abbr‘s’, Abbr‘t’] >>
6842  ‘FINITE s’ by rw[primes_upto_finite, Abbr‘s’] >>
6843  ‘FINITE t’ by metis_tac[IMAGE_FINITE] >>
6844  ‘!x. x IN t ==> x <= n’
6845    by (rw[prime_powers_upto_element, Abbr‘t’, Abbr‘f’] >>
6846        ‘1 < p’ by rw[ONE_LT_PRIME] >>
6847        rw[LOG]) >>
6848  ‘PROD_SET t <= n ** CARD t’ by rw[PROD_SET_LE_CONSTANT] >>
6849  ‘INJ f s t’
6850    by (rw[prime_powers_upto_element_alt, primes_upto_element, INJ_DEF, Abbr‘f’,
6851           Abbr‘s’, Abbr‘t’] >>
6852        ‘1 < p’ by rw[ONE_LT_PRIME] >>
6853        ‘0 < n’ by decide_tac >>
6854        ‘LOG p n <> 0’ by rw[LOG_EQ_0] >>
6855        metis_tac[prime_powers_eq, NOT_ZERO_LT_ZERO]) >>
6856  metis_tac[INJ_CARD_IMAGE]
6857QED
6858
6859(* Theorem: lcm_run n <= n ** (primes_count n) *)
6860(* Proof:
6861      lcm_run n
6862    = PROD_SET (prime_powers_upto n)   by lcm_run_eq_prod_set_prime_powers
6863   <= n ** (primes_count n)            by prime_powers_upto_prod_set_le
6864*)
6865Theorem lcm_run_upper_by_primes_count:
6866    !n. lcm_run n <= n ** (primes_count n)
6867Proof
6868  rw[lcm_run_eq_prod_set_prime_powers, prime_powers_upto_prod_set_le]
6869QED
6870
6871(* This is a significant result. *)
6872
6873(* Theorem: PROD_SET (primes_upto n) <= PROD_SET (prime_powers_upto n) *)
6874(* Proof:
6875   Let s = primes_upto n, f = \p. p ** LOG p n, t = prime_powers_upto n.
6876   The goal becomes: PROD_SET s <= PROD_SET t
6877   Note IMAGE f s = t           by prime_powers_upto_def
6878    and FINITE s                by primes_upto_finite
6879
6880   Claim: INJ f s univ(:num)
6881   Proof: By primes_upto_element, INJ_DEF,
6882          This is to show: prime p /\ prime p' /\ p ** LOG p n = p' ** LOG p' n ==> p = p'
6883          Note 1 < p            by ONE_LT_PRIME
6884            so 0 < n            by 1 < p, p <= n
6885          Thus LOG p n <> 0     by LOG_EQ_0, p <= n
6886            or 0 < LOG p n      by NOT_ZERO_LT_ZERO
6887           ==> p = p'           by prime_powers_eq
6888
6889   Also INJ I s univ(:num)      by primes_upto_element, INJ_DEF
6890    and IMAGE I s = s           by IMAGE_I
6891
6892   Claim: !x. x IN s ==> I x <= f x
6893   Proof: By primes_upto_element,
6894          This is to show: prime x /\ x <= n ==> x <= x ** LOG x n
6895          Note 1 < x            by ONE_LT_PRIME
6896            so 0 < n            by 1 < x, x <= n
6897          Thus LOG x n <> 0     by LOG_EQ_0
6898            or 1 <= LOG x n     by LOG x n <> 0
6899           ==> x ** 1 <= x ** LOG x n   by EXP_BASE_LE_MONO
6900            or      x <= x ** LOG x n   by EXP_1
6901
6902   Hence PROD_SET s <= PROD_SET t       by PROD_SET_LESS_EQ
6903*)
6904Theorem prime_powers_upto_prod_set_ge:
6905    !n. PROD_SET (primes_upto n) <= PROD_SET (prime_powers_upto n)
6906Proof
6907  rpt strip_tac >>
6908  qabbrev_tac `s = primes_upto n` >>
6909  qabbrev_tac `f = \p. p ** LOG p n` >>
6910  qabbrev_tac `t = prime_powers_upto n` >>
6911  `IMAGE f s = t` by rw[prime_powers_upto_def, Abbr`f`, Abbr`s`, Abbr`t`] >>
6912  `FINITE s` by rw[primes_upto_finite, Abbr`s`] >>
6913  `INJ f s univ(:num)` by
6914  (rw[primes_upto_element, INJ_DEF, Abbr`f`, Abbr`s`] >>
6915  `1 < p` by rw[ONE_LT_PRIME] >>
6916  `LOG p n <> 0` by rw[LOG_EQ_0] >>
6917  metis_tac[prime_powers_eq, NOT_ZERO_LT_ZERO]) >>
6918  `INJ I s univ(:num)` by rw[primes_upto_element, INJ_DEF, Abbr`s`] >>
6919  `IMAGE I s = s` by rw[] >>
6920  `!x. x IN s ==> I x <= f x` by
6921    (rw[primes_upto_element, Abbr`f`, Abbr`s`] >>
6922  `1 < x` by rw[ONE_LT_PRIME] >>
6923  `LOG x n <> 0` by rw[LOG_EQ_0] >>
6924  `1 <= LOG x n` by decide_tac >>
6925  metis_tac[EXP_BASE_LE_MONO, EXP_1]) >>
6926  metis_tac[PROD_SET_LESS_EQ]
6927QED
6928
6929(* Theorem: PROD_SET (primes_upto n) <= lcm_run n *)
6930(* Proof:
6931      lcm_run n
6932    = set_lcm (prime_powers_upto n)    by lcm_run_eq_set_lcm_prime_powers
6933    = PROD_SET (prime_powers_upto n)   by set_lcm_prime_powers_upto_eqn
6934   >= PROD_SET (primes_upto n)         by prime_powers_upto_prod_set_ge
6935*)
6936Theorem lcm_run_lower_by_primes_product:
6937    !n. PROD_SET (primes_upto n) <= lcm_run n
6938Proof
6939  rpt strip_tac >>
6940  `lcm_run n = set_lcm (prime_powers_upto n)` by rw[lcm_run_eq_set_lcm_prime_powers] >>
6941  `_ = PROD_SET (prime_powers_upto n)` by rw[set_lcm_prime_powers_upto_eqn] >>
6942  rw[prime_powers_upto_prod_set_ge]
6943QED
6944
6945(* This is another significant result. *)
6946
6947(* These are essentially Chebyshev functions. *)
6948
6949(* Theorem: n ** primes_count n <= PROD_SET (primes_upto n) * (PROD_SET (prime_powers_upto n)) *)
6950(* Proof:
6951   Let s = (primes_upto n), f = \p. p ** LOG p n, t = prime_powers_upto n.
6952   The goal becomes: n ** CARD s <= PROD_SET s * PROD_SET t
6953
6954   Note IMAGE f s = t                 by prime_powers_upto_def
6955    and FINITE s                      by primes_upto_finite
6956    and FINITE t                      by IMAGE_FINITE
6957
6958   Claim: !p. p IN s ==> n <= I p * f p
6959   Proof: By primes_upto_element,
6960          This is to show: prime p /\ p <= n ==> n < p * p ** LOG p n
6961          Note 1 < p                  by ONE_LT_PRIME
6962            so 0 < n                  by 1 < p, p <= n
6963           ==> n < p ** (SUC (LOG p n))   by LOG
6964                 = p * p ** (LOG p n)     by EXP
6965            or n <= p * p ** (LOG p n)    by LESS_IMP_LESS_OR_EQ
6966
6967   Note INJ I s univ(:num)            by primes_upto_element, INJ_DEF,
6968    and IMAGE I s = s                 by IMAGE_I
6969
6970   Claim: INJ f s univ(:num)
6971   Proof: By primes_upto_element, INJ_DEF,
6972          This is to show: prime p /\ prime p' /\ p ** LOG p n = p' ** LOG p' n ==> p = p'
6973          Note 1 < p                  by ONE_LT_PRIME
6974            so 0 < n                  by 1 < p, p <= n
6975           ==> LOG p n <> 0           by LOG_EQ_0
6976            or 0 < LOG p n            by NOT_ZERO_LT_ZERO
6977          Thus p = p'                 by prime_powers_eq
6978
6979   Therefore,
6980          n ** CARD s <= PROD_SET (IMAGE I s) * PROD_SET (IMAGE f s)
6981                                                     by PROD_SET_PRODUCT_GE_CONSTANT
6982      or  n ** CARD s <= PROD_SET s * PROD_SET t     by above
6983*)
6984
6985Theorem prime_powers_upto_prod_set_mix_ge:
6986  !n. n ** primes_count n <=
6987        PROD_SET (primes_upto n) * (PROD_SET (prime_powers_upto n))
6988Proof
6989  rpt strip_tac >>
6990  qabbrev_tac ‘s = (primes_upto n)’ >>
6991  qabbrev_tac ‘f = \p. p ** LOG p n’ >>
6992  qabbrev_tac ‘t = prime_powers_upto n’ >>
6993  ‘IMAGE f s = t’ by rw[prime_powers_upto_def, Abbr‘f’, Abbr‘s’, Abbr‘t’] >>
6994  ‘FINITE s’ by rw[primes_upto_finite, Abbr‘s’] >>
6995  ‘FINITE t’ by rw[] >>
6996  ‘!p. p IN s ==> n <= I p * f p’ by
6997  (rw[primes_upto_element, Abbr‘s’, Abbr‘f’] >>
6998  ‘1 < p’ by rw[ONE_LT_PRIME] >>
6999  rw[LOG, GSYM EXP, LESS_IMP_LESS_OR_EQ]) >>
7000  ‘INJ I s univ(:num)’ by rw[primes_upto_element, INJ_DEF, Abbr‘s’] >>
7001  ‘IMAGE I s = s’ by rw[] >>
7002  ‘INJ f s univ(:num)’ by
7003    (rw[primes_upto_element, INJ_DEF, Abbr‘f’, Abbr‘s’] >>
7004  ‘1 < p’ by rw[ONE_LT_PRIME] >>
7005  ‘LOG p n <> 0’ by rw[LOG_EQ_0] >>
7006  metis_tac[prime_powers_eq, NOT_ZERO_LT_ZERO]) >>
7007  metis_tac[PROD_SET_PRODUCT_GE_CONSTANT]
7008QED
7009
7010(* Another significant result. *)
7011
7012(* Theorem: n ** primes_count n <= PROD_SET (primes_upto n) * lcm_run n *)
7013(* Proof:
7014      n ** primes_count n
7015   <= PROD_SET (primes_upto n) * (PROD_SET (prime_powers_upto n))  by prime_powers_upto_prod_set_mix_ge
7016    = PROD_SET (primes_upto n) * lcm_run n                         by lcm_run_eq_prod_set_prime_powers
7017*)
7018Theorem primes_count_upper_by_product:
7019    !n. n ** primes_count n <= PROD_SET (primes_upto n) * lcm_run n
7020Proof
7021  metis_tac[prime_powers_upto_prod_set_mix_ge, lcm_run_eq_prod_set_prime_powers]
7022QED
7023
7024(* Theorem: n ** primes_count n <= (lcm_run n) ** 2 *)
7025(* Proof:
7026      n ** primes_count n
7027   <= PROD_SET (primes_upto n) * lcm_run n     by primes_count_upper_by_product
7028   <= lcm_run n * lcm_run n                    by lcm_run_lower_by_primes_product
7029    = (lcm_run n) ** 2                         by EXP_2
7030*)
7031Theorem primes_count_upper_by_lcm_run:
7032    !n. n ** primes_count n <= (lcm_run n) ** 2
7033Proof
7034  rpt strip_tac >>
7035  `n ** primes_count n <= PROD_SET (primes_upto n) * lcm_run n` by rw[primes_count_upper_by_product] >>
7036  `PROD_SET (primes_upto n) <= lcm_run n` by rw[lcm_run_lower_by_primes_product] >>
7037  metis_tac[LESS_MONO_MULT, LESS_EQ_TRANS, EXP_2]
7038QED
7039
7040(* Theorem: SQRT (n ** (primes_count n)) <= lcm_run n *)
7041(* Proof:
7042   Note          n ** primes_count n <= (lcm_run n) ** 2         by primes_count_upper_by_lcm_run
7043    ==>   SQRT (n ** primes_count n) <= SQRT ((lcm_run n) ** 2)  by ROOT_LE_MONO, 0 < 2
7044    But   SQRT ((lcm_run n) ** 2) = lcm_run n                    by ROOT_UNIQUE
7045   Thus SQRT (n ** (primes_count n)) <= lcm_run n
7046*)
7047Theorem lcm_run_lower_by_primes_count:
7048    !n. SQRT (n ** (primes_count n)) <= lcm_run n
7049Proof
7050  rpt strip_tac >>
7051  `n ** primes_count n <= (lcm_run n) ** 2` by rw[primes_count_upper_by_lcm_run] >>
7052  `SQRT (n ** primes_count n) <= SQRT ((lcm_run n) ** 2)` by rw[ROOT_LE_MONO] >>
7053  `SQRT ((lcm_run n) ** 2) = lcm_run n` by rw[ROOT_UNIQUE] >>
7054  decide_tac
7055QED
7056
7057(* Therefore:
7058   L(n) <= n ** pi(n)            by lcm_run_upper_by_primes_count
7059   PI(n) <= L(n)                 by lcm_run_lower_by_primes_product
7060   n ** pi(n) <= PI(n) * L(n)    by primes_count_upper_by_product
7061
7062   giving:               L(n) <= n ** pi(n) <= L(n) ** 2      by primes_count_upper_by_lcm_run
7063      and:  SQRT (n ** pi(n)) <=       L(n) <= (n ** pi(n))   by lcm_run_lower_by_primes_count
7064*)
7065
7066(* ------------------------------------------------------------------------- *)
7067(* Primality Tests Documentation                                             *)
7068(* ------------------------------------------------------------------------- *)
7069(* Overloading:
7070*)
7071(*
7072
7073   Two Factors Properties:
7074   two_factors_property_1  |- !n a b. (n = a * b) /\ a < SQRT n ==> SQRT n <= b
7075   two_factors_property_2  |- !n a b. (n = a * b) /\ SQRT n < a ==> b <= SQRT n
7076   two_factors_property    |- !n a b. (n = a * b) ==> a <= SQRT n \/ b <= SQRT n
7077
7078   Primality or Compositeness based on SQRT:
7079   prime_by_sqrt_factors  |- !p. prime p <=>
7080                                 1 < p /\ !q. 1 < q /\ q <= SQRT p ==> ~(q divides p)
7081   prime_factor_estimate  |- !n. 1 < n ==>
7082                                 (~prime n <=> ?p. prime p /\ p divides n /\ p <= SQRT n)
7083
7084   Primality Testing Algorithm:
7085   factor_seek_def     |- !q n c. factor_seek n c q =
7086                                  if c <= q then n
7087                                  else if 1 < q /\ (n MOD q = 0) then q
7088                                  else factor_seek n c (q + 1)
7089   prime_test_def      |- !n. prime_test n <=>
7090                              if n <= 1 then F else factor_seek n (1 + SQRT n) 2 = n
7091   factor_seek_bound   |- !n c q. 0 < n ==> factor_seek n c q <= n
7092   factor_seek_thm     |- !n c q. 1 < q /\ q <= c /\ c <= n ==>
7093                          (factor_seek n c q = n <=> !p. q <= p /\ p < c ==> ~(p divides n))
7094   prime_test_thm      |- !n. prime n <=> prime_test n
7095
7096*)
7097
7098(* ------------------------------------------------------------------------- *)
7099(* Helper Theorems                                                           *)
7100(* ------------------------------------------------------------------------- *)
7101
7102(* ------------------------------------------------------------------------- *)
7103(* Two Factors Properties                                                    *)
7104(* ------------------------------------------------------------------------- *)
7105
7106(* Theorem: (n = a * b) /\ a < SQRT n ==> SQRT n <= b *)
7107(* Proof:
7108   If n = 0, then a = 0 or b = 0          by MULT_EQ_0
7109   But SQRT 0 = 0                         by SQRT_0
7110   so a <> 0, making b = 0, and SQRT n <= b true.
7111   If n <> 0, a <> 0 and b <> 0           by MULT_EQ_0
7112   By contradiction, suppose b < SQRT n.
7113   Then  n = a * b < a * SQRT n           by LT_MULT_LCANCEL, 0 < a.
7114    and a * SQRT n < SQRT n * SQRT n      by LT_MULT_RCANCEL, 0 < SQRT n.
7115   making  n < (SQRT n) ** 2              by LESS_TRANS, EXP_2
7116   This contradicts (SQRT n) ** 2 <= n    by SQRT_PROPERTY
7117*)
7118Theorem two_factors_property_1:
7119    !n a b. (n = a * b) /\ a < SQRT n ==> SQRT n <= b
7120Proof
7121  rpt strip_tac >>
7122  Cases_on `n = 0` >| [
7123    `a <> 0 /\ (b = 0) /\ (SQRT n = 0)` by metis_tac[MULT_EQ_0, SQRT_0, DECIDE``~(0 < 0)``] >>
7124    decide_tac,
7125    `a <> 0 /\ b <> 0` by metis_tac[MULT_EQ_0] >>
7126    spose_not_then strip_assume_tac >>
7127    `b < SQRT n` by decide_tac >>
7128    `0 < a /\ 0 < b /\ 0 < SQRT n` by decide_tac >>
7129    `n < a * SQRT n` by rw[] >>
7130    `a * SQRT n < SQRT n * SQRT n` by rw[] >>
7131    `n < (SQRT n) ** 2` by metis_tac[LESS_TRANS, EXP_2] >>
7132    `(SQRT n) ** 2 <= n` by rw[SQRT_PROPERTY] >>
7133    decide_tac
7134  ]
7135QED
7136
7137(* Theorem: (n = a * b) /\ SQRT n < a ==> b <= SQRT n *)
7138(* Proof:
7139   If n = 0, then a = 0 or b = 0             by MULT_EQ_0
7140   But SQRT 0 = 0                            by SQRT_0
7141   so a <> 0, making b = 0, and b <= SQRT n true.
7142   If n <> 0, a <> 0 and b <> 0              by MULT_EQ_0
7143   By contradiction, suppose SQRT n < b.
7144   Then SUC (SQRT n) ** 2
7145      = SUC (SQRT n) * SUC (SQRT n)          by EXP_2
7146      <= a * SUC (SQRT n)                    by LT_MULT_RCANCEL, 0 < SUC (SQRT n).
7147      <= a * b = n                           by LT_MULT_LCANCEL, 0 < a.
7148   Giving (SUC (SQRT n)) ** 2 <= n           by LESS_EQ_TRANS
7149   or SQRT ((SUC (SQRT n)) ** 2) <= SQRT n   by SQRT_LE
7150   or       SUC (SQRT n) <= SQRT n           by SQRT_OF_SQ
7151   which is a contradiction to !m. SUC m > m by LESS_SUC_REFL
7152 *)
7153Theorem two_factors_property_2:
7154    !n a b. (n = a * b) /\ SQRT n < a ==> b <= SQRT n
7155Proof
7156  rpt strip_tac >>
7157  Cases_on `n = 0` >| [
7158    `a <> 0 /\ (b = 0) /\ (SQRT 0 = 0)` by metis_tac[MULT_EQ_0, SQRT_0, DECIDE``~(0 < 0)``] >>
7159    decide_tac,
7160    `a <> 0 /\ b <> 0` by metis_tac[MULT_EQ_0] >>
7161    spose_not_then strip_assume_tac >>
7162    `SQRT n < b` by decide_tac >>
7163    `SUC (SQRT n) <= a /\ SUC (SQRT n) <= b` by decide_tac >>
7164    `SUC (SQRT n) * SUC (SQRT n) <= a * SUC (SQRT n)` by rw[] >>
7165    `a * SUC (SQRT n) <= n` by rw[] >>
7166    `SUC (SQRT n) ** 2  <= n` by metis_tac[LESS_EQ_TRANS, EXP_2] >>
7167    `SUC (SQRT n) <= SQRT n` by metis_tac[SQRT_LE, SQRT_OF_SQ] >>
7168    decide_tac
7169  ]
7170QED
7171
7172(* Theorem: (n = a * b) ==> a <= SQRT n \/ b <= SQRT n *)
7173(* Proof:
7174   By contradiction, suppose SQRT n < a /\ SQRT n < b.
7175   Then (n = a * b) /\ SQRT n < a ==> b <= SQRT n  by two_factors_property_2
7176   which contradicts SQRT n < b.
7177 *)
7178Theorem two_factors_property:
7179    !n a b. (n = a * b) ==> a <= SQRT n \/ b <= SQRT n
7180Proof
7181  rpt strip_tac >>
7182  spose_not_then strip_assume_tac >>
7183  `SQRT n < a` by decide_tac >>
7184  metis_tac[two_factors_property_2]
7185QED
7186
7187(* ------------------------------------------------------------------------- *)
7188(* Primality or Compositeness based on SQRT                                  *)
7189(* ------------------------------------------------------------------------- *)
7190
7191(* Theorem: prime p <=> 1 < p /\ !q. 1 < q /\ q <= SQRT p ==> ~(q divides p) *)
7192(* Proof:
7193   If part: prime p ==> 1 < p /\ !q. 1 < q /\ q <= SQRT p ==> ~(q divides p)
7194     First one: prime p ==> 1 < p  is true    by ONE_LT_PRIME
7195     Second one: by contradiction, suppose q divides p.
7196     But prime p /\ q divides p ==> (q = p) or (q = 1)  by prime_def
7197     Given 1 < q, q <> 1, hence q = p.
7198     This means p <= SQRT p, giving p = 0 or p = 1      by SQRT_GE_SELF
7199     which contradicts p <> 0 and p <> 1                by PRIME_POS, prime_def
7200   Only-if part: 1 < p /\ !q. 1 < q /\ q <= SQRT p ==> ~(q divides p) ==> prime p
7201     By prime_def, this is to show:
7202     (1) p <> 1, true since 1 < p.
7203     (2) b divides p ==> (b = p) \/ (b = 1)
7204         By contradiction, suppose b <> p /\ b <> 1.
7205         b divides p ==> ?a. p = a * b     by divides_def
7206         which means a <= SQRT p \/ b <= SQRT p   by two_factors_property
7207         If a <= SQRT p,
7208         1 < p ==> p <> 0, so a <> 0  by MULT
7209         also b <> p ==> a <> 1       by MULT_LEFT_1
7210         so 1 < a, and a divides p    by prime_def, MULT_COMM
7211         The implication gives ~(a divides p), a contradiction.
7212         If b <= SQRT p,
7213         1 < p ==> p <> 0, so b <> 0  by MULT_0
7214         also b <> 1, so 1 < b, and b divides p.
7215         The implication gives ~(b divides p), a contradiction.
7216 *)
7217Theorem prime_by_sqrt_factors:
7218    !p. prime p <=> 1 < p /\ !q. 1 < q /\ q <= SQRT p ==> ~(q divides p)
7219Proof
7220  rw[EQ_IMP_THM] >-
7221  rw[ONE_LT_PRIME] >-
7222 (spose_not_then strip_assume_tac >>
7223  `0 < p` by rw[PRIME_POS] >>
7224  `p <> 0 /\ q <> 1` by decide_tac >>
7225  `(q = p) /\ p <> 1` by metis_tac[prime_def] >>
7226  metis_tac[SQRT_GE_SELF]) >>
7227  rw[prime_def] >>
7228  spose_not_then strip_assume_tac >>
7229  `?a. p = a * b` by rw[GSYM divides_def] >>
7230  `a <= SQRT p \/ b <= SQRT p` by rw[two_factors_property] >| [
7231    `a <> 1` by metis_tac[MULT_LEFT_1] >>
7232    `p <> 0` by decide_tac >>
7233    `a <> 0` by metis_tac[MULT] >>
7234    `1 < a` by decide_tac >>
7235    metis_tac[divides_def, MULT_COMM],
7236    `p <> 0` by decide_tac >>
7237    `b <> 0` by metis_tac[MULT_0] >>
7238    `1 < b` by decide_tac >>
7239    metis_tac[]
7240  ]
7241QED
7242
7243(* Theorem: 1 < n ==> (~prime n <=> ?p. prime p /\ p divides n /\ p <= SQRT n) *)
7244(* Proof:
7245   If part ~prime n ==> ?p. prime p /\ p divides n /\ p <= SQRT n
7246   Given n <> 1, ?p. prime p /\ p divides n  by PRIME_FACTOR
7247   If p <= SQRT n, take this p.
7248   If ~(p <= SQRT n), SQRT n < p.
7249      Since p divides n, ?q. n = p * q       by divides_def, MULT_COMM
7250      Hence q <= SQRT n                      by two_factors_property_2
7251      Since prime p but ~prime n, q <> 1     by MULT_RIGHT_1
7252         so ?t. prime t /\ t divides q       by PRIME_FACTOR
7253      Since 1 < n, n <> 0, so q <> 0         by MULT_0
7254         so t divides q ==> t <= q           by DIVIDES_LE, 0 < q.
7255      Take t, then t divides n               by DIVIDES_TRANS
7256               and t <= SQRT n               by LESS_EQ_TRANS
7257    Only-if part: ?p. prime p /\ p divides n /\ p <= SQRT n ==> ~prime n
7258      By contradiction, assume prime n.
7259      Then p divides n ==> p = 1 or p = n    by prime_def
7260      But prime p ==> p <> 1, so p = n       by ONE_LT_PRIME
7261      Giving p <= SQRT p,
7262      thus forcing p = 0 or p = 1            by SQRT_GE_SELF
7263      Both are impossible for prime p.
7264*)
7265Theorem prime_factor_estimate:
7266    !n. 1 < n ==> (~prime n <=> ?p. prime p /\ p divides n /\ p <= SQRT n)
7267Proof
7268  rpt strip_tac >>
7269  `n <> 1` by decide_tac >>
7270  rw[EQ_IMP_THM] >| [
7271    `?p. prime p /\ p divides n` by rw[PRIME_FACTOR] >>
7272    Cases_on `p <= SQRT n` >-
7273    metis_tac[] >>
7274    `SQRT n < p` by decide_tac >>
7275    `?q. n = q * p` by rw[GSYM divides_def] >>
7276    `_ = p * q` by rw[MULT_COMM] >>
7277    `q <= SQRT n` by metis_tac[two_factors_property_2] >>
7278    `q <> 1` by metis_tac[MULT_RIGHT_1] >>
7279    `?t. prime t /\ t divides q` by rw[PRIME_FACTOR] >>
7280    `n <> 0` by decide_tac >>
7281    `q <> 0` by metis_tac[MULT_0] >>
7282    `0 < q ` by decide_tac >>
7283    `t <= q` by rw[DIVIDES_LE] >>
7284    `q divides n` by metis_tac[divides_def] >>
7285    metis_tac[DIVIDES_TRANS, LESS_EQ_TRANS],
7286    spose_not_then strip_assume_tac >>
7287    `1 < p` by rw[ONE_LT_PRIME] >>
7288    `p <> 1 /\ p <> 0` by decide_tac >>
7289    `p = n` by metis_tac[prime_def] >>
7290    metis_tac[SQRT_GE_SELF]
7291  ]
7292QED
7293
7294(* ------------------------------------------------------------------------- *)
7295(* Primality Testing Algorithm                                               *)
7296(* ------------------------------------------------------------------------- *)
7297
7298(* Seek the prime factor of number n, starting with q, up to cutoff c. *)
7299Definition factor_seek_def:
7300  factor_seek n c q =
7301    if c <= q then n
7302    else if 1 < q /\ (n MOD q = 0) then q
7303    else factor_seek n c (q + 1)
7304Termination
7305  WF_REL_TAC ‘measure (λ(n,c,q). c - q)’ >> simp[]
7306End
7307(* Use 1 < q so that, for prime n, it gives a result n for any initial q, including q = 1. *)
7308
7309(* Primality test by seeking a factor exceeding (SQRT n). *)
7310Definition prime_test_def:
7311    prime_test n =
7312       if n <= 1 then F
7313       else factor_seek n (1 + SQRT n) 2 = n
7314End
7315
7316(*
7317EVAL ``MAP prime_test [1 .. 15]``; = [F; T; T; F; T; F; T; F; F; F; T; F; T; F; F]: thm
7318*)
7319
7320(* Theorem: 0 < n ==> factor_seek n c q <= n *)
7321(* Proof:
7322   By induction from factor_seek_def.
7323   If c <= q,
7324      Then factor_seek n c q = n, hence true    by factor_seek_def
7325   If q = 0,
7326      Then factor_seek n c 0 = 0, hence true    by factor_seek_def
7327   If n MOD q = 0,
7328      Then factor_seek n c q = q                by factor_seek_def
7329      Thus q divides n                          by DIVIDES_MOD_0, q <> 0
7330      hence q <= n                              by DIVIDES_LE, 0 < n
7331   Otherwise,
7332         factor_seek n c q
7333       = factor_seek n c (q + 1)                by factor_seek_def
7334      <= n                                      by induction hypothesis
7335*)
7336Theorem factor_seek_bound:
7337    !n c q. 0 < n ==> factor_seek n c q <= n
7338Proof
7339  ho_match_mp_tac (theorem "factor_seek_ind") >>
7340  rw[] >>
7341  rw[Once factor_seek_def] >>
7342  `q divides n` by rw[DIVIDES_MOD_0] >>
7343  rw[DIVIDES_LE]
7344QED
7345
7346(* Theorem: 1 < q /\ q <= c /\ c <= n ==>
7347   ((factor_seek n c q = n) <=> (!p. q <= p /\ p < c ==> ~(p divides n))) *)
7348(* Proof:
7349   By induction from factor_seek_def, this is to show:
7350   (1) n MOD q = 0 ==> ?p. (q <= p /\ p < c) /\ p divides n
7351       Take p = q, then n MOD q = 0 ==> q divides n       by DIVIDES_MOD_0, 0 < q
7352   (2) n MOD q <> 0 ==> factor_seek n c (q + 1) = n <=>
7353                        !p. q <= p /\ p < c ==> ~(p divides n)
7354            factor_seek n c (q + 1) = n
7355        <=> !p. q + 1 <= p /\ p < c ==> ~(p divides n))   by induction hypothesis
7356         or !p.      q < p /\ p < c ==> ~(p divides n))
7357        But n MOD q <> 0 gives ~(q divides n)             by DIVIDES_MOD_0, 0 < q
7358       Thus !p.     q <= p /\ p < c ==> ~(p divides n))
7359*)
7360Theorem factor_seek_thm:
7361    !n c q. 1 < q /\ q <= c /\ c <= n ==>
7362   ((factor_seek n c q = n) <=> (!p. q <= p /\ p < c ==> ~(p divides n)))
7363Proof
7364  ho_match_mp_tac (theorem "factor_seek_ind") >>
7365  rw[] >>
7366  rw[Once factor_seek_def] >| [
7367    qexists_tac `q` >>
7368    rw[DIVIDES_MOD_0],
7369    rw[EQ_IMP_THM] >>
7370    spose_not_then strip_assume_tac >>
7371    `0 < q` by decide_tac >>
7372    `p <> q` by metis_tac[DIVIDES_MOD_0] >>
7373    `q + 1 <= p` by decide_tac >>
7374    metis_tac[]
7375  ]
7376QED
7377
7378(* Theorem: prime n = prime_test n *)
7379(* Proof:
7380       prime n
7381   <=> 1 < n /\ !q. 1 < q /\ n <= SQRT n ==> ~(n divides p)     by prime_by_sqrt_factors
7382   <=> 1 < n /\ !q. 2 <= q /\ n < c ==> ~(n divides p)          where c = 1 + SQRT n
7383   Under 1 < n,
7384   Note SQRT n <> 0         by SQRT_EQ_0, n <> 0
7385     so 1 < 1 + SQRT n = c, or 2 <= c.
7386   Also SQRT n <= n         by SQRT_LE_SELF
7387    but SQRT n <> n         by SQRT_EQ_SELF, 1 < n
7388     so SQRT n < n, or c <= n.
7389   Thus 1 < n /\ !q. 2 <= q /\ n < c ==> ~(n divides p)
7390    <=> factor_seek n c q = n                              by factor_seek_thm
7391    <=> prime_test n                                       by prime_test_def
7392*)
7393Theorem prime_test_thm:
7394    !n. prime n = prime_test n
7395Proof
7396  rw[prime_test_def, prime_by_sqrt_factors] >>
7397  rw[EQ_IMP_THM] >| [
7398    qabbrev_tac `c = SQRT n + 1` >>
7399    `0 < 2` by decide_tac >>
7400    `SQRT n <> 0` by rw[SQRT_EQ_0] >>
7401    `2 <= c` by rw[Abbr`c`] >>
7402    `SQRT n <= n` by rw[SQRT_LE_SELF] >>
7403    `SQRT n <> n` by rw[SQRT_EQ_SELF] >>
7404    `c <= n` by rw[Abbr`c`] >>
7405    `!q. 2 <= q /\ q < c ==> ~(q divides n)` by fs[Abbr`c`] >>
7406    rw[factor_seek_thm],
7407    qabbrev_tac `c = SQRT n + 1` >>
7408    `0 < 2` by decide_tac >>
7409    `SQRT n <> 0` by rw[SQRT_EQ_0] >>
7410    `2 <= c` by rw[Abbr`c`] >>
7411    `SQRT n <= n` by rw[SQRT_LE_SELF] >>
7412    `SQRT n <> n` by rw[SQRT_EQ_SELF] >>
7413    `c <= n` by rw[Abbr`c`] >>
7414    fs[factor_seek_thm] >>
7415    `!p. 1 < p /\ p <= SQRT n ==> ~(p divides n)` by fs[Abbr`c`] >>
7416    rw[]
7417  ]
7418QED
7419
7420(* ------------------------------------------------------------------------- *)
7421(* Gauss' Little Theorem                                                     *)
7422(* ------------------------------------------------------------------------- *)
7423(* Overloading:
7424*)
7425(* Definitions and Theorems (# are exported, ! in computeLib):
7426
7427   GCD Equivalence Class:
7428   gcd_matches_def       |- !n d. gcd_matches n d = {j | j IN natural n /\ (gcd j n = d)}
7429!  gcd_matches_alt       |- !n d. gcd_matches n d = natural n INTER {j | gcd j n = d}
7430   gcd_matches_element   |- !n d j. j IN gcd_matches n d <=> 0 < j /\ j <= n /\ (gcd j n = d)
7431   gcd_matches_subset    |- !n d. gcd_matches n d SUBSET natural n
7432   gcd_matches_finite    |- !n d. FINITE (gcd_matches n d)
7433   gcd_matches_0         |- !d. gcd_matches 0 d = {}
7434   gcd_matches_with_0    |- !n. gcd_matches n 0 = {}
7435   gcd_matches_1         |- !d. gcd_matches 1 d = if d = 1 then {1} else {}
7436   gcd_matches_has_divisor     |- !n d. 0 < n /\ d divides n ==> d IN gcd_matches n d
7437   gcd_matches_element_divides |- !n d j. j IN gcd_matches n d ==> d divides j /\ d divides n
7438   gcd_matches_eq_empty        |- !n d. 0 < n ==> ((gcd_matches n d = {}) <=> ~(d divides n))
7439
7440   Phi Function:
7441   phi_def           |- !n. phi n = CARD (coprimes n)
7442   phi_thm           |- !n. phi n = LENGTH (FILTER (\j. coprime j n) (GENLIST SUC n))
7443   phi_fun           |- phi = CARD o coprimes
7444   phi_pos           |- !n. 0 < n ==> 0 < phi n
7445   phi_0             |- phi 0 = 0
7446   phi_eq_0          |- !n. (phi n = 0) <=> (n = 0)
7447   phi_1             |- phi 1 = 1
7448   phi_eq_totient    |- !n. 1 < n ==> (phi n = totient n)
7449   phi_prime         |- !n. prime n ==> (phi n = n - 1)
7450   phi_2             |- phi 2 = 1
7451   phi_gt_1          |- !n. 2 < n ==> 1 < phi n
7452   phi_le            |- !n. phi n <= n
7453   phi_lt            |- !n. 1 < n ==> phi n < n
7454
7455   Divisors:
7456   divisors_def            |- !n. divisors n = {d | 0 < d /\ d <= n /\ d divides n}
7457   divisors_element        |- !n d. d IN divisors n <=> 0 < d /\ d <= n /\ d divides n
7458   divisors_element_alt    |- !n. 0 < n ==> !d. d IN divisors n <=> d divides n
7459   divisors_has_element    |- !n d. d IN divisors n ==> 0 < n
7460   divisors_has_1          |- !n. 0 < n ==> 1 IN divisors n
7461   divisors_has_last       |- !n. 0 < n ==> n IN divisors n
7462   divisors_not_empty      |- !n. 0 < n ==> divisors n <> {}
7463   divisors_0              |- divisors 0 = {}
7464   divisors_1              |- divisors 1 = {1}
7465   divisors_eq_empty       |- !n. divisors n = {} <=> n = 0
7466!  divisors_eqn            |- !n. divisors n =
7467                                  IMAGE (\j. if j + 1 divides n then j + 1 else 1) (count n)
7468   divisors_has_factor     |- !n p q. 0 < n /\ n = p * q ==> p IN divisors n /\ q IN divisors n
7469   divisors_has_cofactor   |- !n d. d IN divisors n ==> n DIV d IN divisors n
7470   divisors_delete_last    |- !n. divisors n DELETE n = {m | 0 < m /\ m < n /\ m divides n}
7471   divisors_nonzero        |- !n d. d IN divisors n ==> 0 < d
7472   divisors_subset_natural |- !n. divisors n SUBSET natural n
7473   divisors_finite         |- !n. FINITE (divisors n)
7474   divisors_divisors_bij   |- !n. (\d. n DIV d) PERMUTES divisors n
7475
7476   An upper bound for divisors:
7477   divisor_le_cofactor_ge  |- !n p. 0 < p /\ p divides n /\ p <= SQRT n ==> SQRT n <= n DIV p
7478   divisor_gt_cofactor_le  |- !n p. 0 < p /\ p divides n /\ SQRT n < p ==> n DIV p <= SQRT n
7479   divisors_cofactor_inj   |- !n. INJ (\j. n DIV j) (divisors n) univ(:num)
7480   divisors_card_upper     |- !n. CARD (divisors n) <= TWICE (SQRT n)
7481
7482   Gauss' Little Theorem:
7483   gcd_matches_divisor_element  |- !n d. d divides n ==>
7484                                   !j. j IN gcd_matches n d ==> j DIV d IN coprimes_by n d
7485   gcd_matches_bij_coprimes_by  |- !n d. d divides n ==>
7486                                   BIJ (\j. j DIV d) (gcd_matches n d) (coprimes_by n d)
7487   gcd_matches_bij_coprimes     |- !n d. 0 < n /\ d divides n ==>
7488                                   BIJ (\j. j DIV d) (gcd_matches n d) (coprimes (n DIV d))
7489   divisors_eq_gcd_image        |- !n. divisors n = IMAGE (gcd n) (natural n)
7490   gcd_eq_equiv_class           |- !n d. feq_class (gcd n) (natural n) d = gcd_matches n d
7491   gcd_eq_equiv_class_fun       |- !n. feq_class (gcd n) (natural n) = gcd_matches n
7492   gcd_eq_partition_by_divisors |- !n. partition (feq (gcd n)) (natural n) =
7493                                       IMAGE (gcd_matches n) (divisors n)
7494   gcd_eq_equiv_on_natural      |- !n. feq (gcd n) equiv_on natural n
7495   sum_over_natural_by_gcd_partition
7496                                |- !f n. SIGMA f (natural n) =
7497                                         SIGMA (SIGMA f) (partition (feq (gcd n)) (natural n))
7498   sum_over_natural_by_divisors |- !f n. SIGMA f (natural n) =
7499                                         SIGMA (SIGMA f) (IMAGE (gcd_matches n) (divisors n))
7500   gcd_matches_from_divisors_inj         |- !n. INJ (gcd_matches n) (divisors n) univ(:num -> bool)
7501   gcd_matches_and_coprimes_by_same_size |- !n. CARD o gcd_matches n = CARD o coprimes_by n
7502   coprimes_by_with_card      |- !n. 0 < n ==> CARD o coprimes_by n =
7503                                               (\d. phi (if d IN divisors n then n DIV d else 0))
7504   coprimes_by_divisors_card  |- !n x. x IN divisors n ==>
7505                                       (CARD o coprimes_by n) x = (\d. phi (n DIV d)) x
7506   Gauss_little_thm           |- !n. SIGMA phi (divisors n) = n
7507
7508   Euler phi function is multiplicative for coprimes:
7509   coprimes_mult_by_image
7510                       |- !m n. coprime m n ==>
7511                                coprimes (m * n) =
7512                                IMAGE (\(x,y). if m * n = 1 then 1 else (x * n + y * m) MOD (m * n))
7513                                      (coprimes m CROSS coprimes n)
7514   coprimes_map_cross_inj
7515                       |- !m n. coprime m n ==>
7516                                INJ (\(x,y). if m * n = 1 then 1 else (x * n + y * m) MOD (m * n))
7517                                    (coprimes m CROSS coprimes n) univ(:num)
7518   phi_mult            |- !m n. coprime m n ==> phi (m * n) = phi m * phi n
7519   phi_primes_distinct |- !p q. prime p /\ prime q /\ p <> q ==> phi (p * q) = (p - 1) * (q - 1)
7520
7521   Euler phi function for prime powers:
7522   multiples_upto_def  |- !m n. m multiples_upto n = {x | m divides x /\ 0 < x /\ x <= n}
7523   multiples_upto_element
7524                       |- !m n x. x IN m multiples_upto n <=> m divides x /\ 0 < x /\ x <= n
7525   multiples_upto_alt  |- !m n. m multiples_upto n = {x | ?k. x = k * m /\ 0 < x /\ x <= n}
7526   multiples_upto_element_alt
7527                       |- !m n x. x IN m multiples_upto n <=> ?k. x = k * m /\ 0 < x /\ x <= n
7528   multiples_upto_eqn  |- !m n. m multiples_upto n = {x | m divides x /\ x IN natural n}
7529   multiples_upto_0_n  |- !n. 0 multiples_upto n = {}
7530   multiples_upto_1_n  |- !n. 1 multiples_upto n = natural n
7531   multiples_upto_m_0  |- !m. m multiples_upto 0 = {}
7532   multiples_upto_m_1  |- !m. m multiples_upto 1 = if m = 1 then {1} else {}
7533   multiples_upto_thm  |- !m n. m multiples_upto n =
7534                                if m = 0 then {} else IMAGE ($* m) (natural (n DIV m))
7535   multiples_upto_subset
7536                       |- !m n. m multiples_upto n SUBSET natural n
7537   multiples_upto_finite
7538                       |- !m n. FINITE (m multiples_upto n)
7539   multiples_upto_card |- !m n. CARD (m multiples_upto n) = if m = 0 then 0 else n DIV m
7540   coprimes_prime_power|- !p n. prime p ==>
7541                                coprimes (p ** n) = natural (p ** n) DIFF p multiples_upto p ** n
7542   phi_prime_power     |- !p n. prime p ==> phi (p ** SUC n) = (p - 1) * p ** n
7543   phi_prime_sq        |- !p. prime p ==> phi (p * p) = p * (p - 1)
7544   phi_primes          |- !p q. prime p /\ prime q ==>
7545                                phi (p * q) = if p = q then p * (p - 1) else (p - 1) * (q - 1)
7546
7547   Recursive definition of phi:
7548   rec_phi_def      |- !n. rec_phi n = if n = 0 then 0
7549                                  else if n = 1 then 1
7550                                  else n - SIGMA (\a. rec_phi a) {m | m < n /\ m divides n}
7551   rec_phi_0        |- rec_phi 0 = 0
7552   rec_phi_1        |- rec_phi 1 = 1
7553   rec_phi_eq_phi   |- !n. rec_phi n = phi n
7554
7555   Useful Theorems:
7556   coprimes_from_not_1_inj     |- INJ coprimes (univ(:num) DIFF {1}) univ(:num -> bool)
7557   divisors_eq_image_gcd_upto  |- !n. 0 < n ==> divisors n = IMAGE (gcd n) (upto n)
7558   gcd_eq_equiv_on_upto        |- !n. feq (gcd n) equiv_on upto n
7559   gcd_eq_upto_partition_by_divisors
7560                               |- !n. 0 < n ==>
7561                                      partition (feq (gcd n)) (upto n) =
7562                                      IMAGE (preimage (gcd n) (upto n)) (divisors n)
7563   sum_over_upto_by_gcd_partition
7564                               |- !f n. SIGMA f (upto n) =
7565                                        SIGMA (SIGMA f) (partition (feq (gcd n)) (upto n))
7566   sum_over_upto_by_divisors   |- !f n. 0 < n ==>
7567                                        SIGMA f (upto n) =
7568                                        SIGMA (SIGMA f) (IMAGE (preimage (gcd n) (upto n)) (divisors n))
7569
7570   divisors_eq_image_gcd_count |- !n. divisors n = IMAGE (gcd n) (count n)
7571   gcd_eq_equiv_on_count       |- !n. feq (gcd n) equiv_on count n
7572   gcd_eq_count_partition_by_divisors
7573                               |- !n. partition (feq (gcd n)) (count n) =
7574                                      IMAGE (preimage (gcd n) (count n)) (divisors n)
7575   sum_over_count_by_gcd_partition
7576                               |- !f n. SIGMA f (count n) =
7577                                        SIGMA (SIGMA f) (partition (feq (gcd n)) (count n))
7578   sum_over_count_by_divisors  |- !f n. SIGMA f (count n) =
7579                                        SIGMA (SIGMA f) (IMAGE (preimage (gcd n) (count n)) (divisors n))
7580
7581   divisors_eq_image_gcd_natural
7582                               |- !n. divisors n = IMAGE (gcd n) (natural n)
7583   gcd_eq_natural_partition_by_divisors
7584                               |- !n. partition (feq (gcd n)) (natural n) =
7585                                      IMAGE (preimage (gcd n) (natural n)) (divisors n)
7586   sum_over_natural_by_preimage_divisors
7587                               |- !f n. SIGMA f (natural n) =
7588                                        SIGMA (SIGMA f) (IMAGE (preimage (gcd n) (natural n)) (divisors n))
7589   sum_image_divisors_cong     |- !f g. f 0 = g 0 /\ (!n. SIGMA f (divisors n) = SIGMA g (divisors n)) ==> f = g
7590*)
7591
7592(* Theory:
7593
7594Given the set natural 6 = {1, 2, 3, 4, 5, 6}
7595Every element has a gcd with 6: IMAGE (gcd 6) (natural 6) = {1, 2, 3, 2, 1, 6} = {1, 2, 3, 6}.
7596Thus the original set is partitioned by gcd: {{1, 5}, {2, 4}, {3}, {6}}
7597Since (gcd 6) j is a divisor of 6, and they run through all possible divisors of 6,
7598  SIGMA f (natural 6)
7599= f 1 + f 2 + f 3 + f 4 + f 5 + f 6
7600= (f 1 + f 5) + (f 2 + f 4) + f 3 + f 6
7601= (SIGMA f {1, 5}) + (SIGMA f {2, 4}) + (SIGMA f {3}) + (SIGMA f {6})
7602= SIGMA (SIGMA f) {{1, 5}, {2, 4}, {3}, {6}}
7603= SIGMA (SIGMA f) (partition (feq (natural 6) (gcd 6)) (natural 6))
7604
7605SIGMA:('a -> num) -> ('a -> bool) -> num
7606SIGMA (f:num -> num):(num -> bool) -> num
7607SIGMA (SIGMA (f:num -> num)) (s:(num -> bool) -> bool):num
7608
7609How to relate this to (divisors n) ?
7610First, observe   IMAGE (gcd 6) (natural 6) = divisors 6
7611and partition {{1, 5}, {2, 4}, {3}, {6}} = IMAGE (preimage (gcd 6) (natural 6)) (divisors 6)
7612
7613  SIGMA f (natural 6)
7614= SIGMA (SIGMA f) (partition (feq (natural 6) (gcd 6)) (natural 6))
7615= SIGMA (SIGMA f) (IMAGE (preimage (gcd 6) (natural 6)) (divisors 6))
7616
7617divisors n:num -> bool
7618preimage (gcd n):(num -> bool) -> num -> num -> bool
7619preimage (gcd n) (natural n):num -> num -> bool
7620IMAGE (preimage (gcd n) (natural n)) (divisors n):(num -> bool) -> bool
7621
7622How to relate this to (coprimes d), where d divides n ?
7623Note {1, 5} with (gcd 6) j = 1, equals to (coprimes (6 DIV 1)) = coprimes 6
7624     {2, 4} with (gcd 6) j = 2, BIJ to {2/2, 4/2} with gcd (6/2) (j/2) = 1, i.e {1, 2} = coprimes 3
7625     {3} with (gcd 6) j = 3, BIJ to {3/3} with gcd (6/3) (j/3) = 1, i.e. {1} = coprimes 2
7626     {6} with (gcd 6) j = 6, BIJ to {6/6} with gcd (6/6) (j/6) = 1, i.e. {1} = coprimes 1
7627Hence CARD {{1, 5}, {2, 4}, {3}, {6}} = CARD (partition)
7628    = CARD {{1, 5}/1, {2,4}/2, {3}/3, {6}/6} = CARD (reduced-partition)
7629    = CARD {(coprimes 6/1) (coprimes 6/2) (coprimes 6/3) (coprimes 6/6)}
7630    = CARD {(coprimes 6) (coprimes 3) (coprimes 2) (coprimes 1)}
7631    = SIGMA (CARD (coprimes d)), over d divides 6)
7632    = SIGMA (phi d), over d divides 6.
7633*)
7634
7635(* Theorem: coprimes n = set (FILTER (\j. coprime j n) (GENLIST SUC n)) *)
7636(* Proof:
7637     coprimes n
7638   = (natural n) INTER {j | coprime j n}             by coprimes_alt
7639   = (set (GENLIST SUC n)) INTER {j | coprime j n}   by natural_thm
7640   = {j | coprime j n} INTER (set (GENLIST SUC n))   by INTER_COMM
7641   = set (FILTER (\j. coprime j n) (GENLIST SUC n))  by LIST_TO_SET_FILTER
7642*)
7643Theorem coprimes_thm:
7644    !n. coprimes n = set (FILTER (\j. coprime j n) (GENLIST SUC n))
7645Proof
7646  rw[coprimes_alt, natural_thm, INTER_COMM, LIST_TO_SET_FILTER]
7647QED
7648
7649(* Relate coprimes to Euler totient *)
7650
7651(* Theorem: 1 < n ==> (coprimes n = Euler n) *)
7652(* Proof:
7653   By Euler_def, this is to show:
7654   (1) x IN coprimes n ==> 0 < x, true by coprimes_element
7655   (2) x IN coprimes n ==> x < n, true by coprimes_element_less
7656   (3) x IN coprimes n ==> coprime n x, true by coprimes_element, GCD_SYM
7657   (4) 0 < x /\ x < n /\ coprime n x ==> x IN coprimes n
7658       That is, to show: 0 < x /\ x <= n /\ coprime x n.
7659       Since x < n ==> x <= n   by LESS_IMP_LESS_OR_EQ
7660       Hence true by GCD_SYM
7661*)
7662Theorem coprimes_eq_Euler:
7663    !n. 1 < n ==> (coprimes n = Euler n)
7664Proof
7665  rw[Euler_def, EXTENSION, EQ_IMP_THM] >-
7666  metis_tac[coprimes_element] >-
7667  rw[coprimes_element_less] >-
7668  metis_tac[coprimes_element, GCD_SYM] >>
7669  metis_tac[coprimes_element, GCD_SYM, LESS_IMP_LESS_OR_EQ]
7670QED
7671
7672(* Theorem: prime n ==> (coprimes n = residue n) *)
7673(* Proof:
7674   Since prime n ==> 1 < n     by ONE_LT_PRIME
7675   Hence   coprimes n
7676         = Euler n             by coprimes_eq_Euler
7677         = residue n           by Euler_prime
7678*)
7679Theorem coprimes_prime:
7680    !n. prime n ==> (coprimes n = residue n)
7681Proof
7682  rw[ONE_LT_PRIME, coprimes_eq_Euler, Euler_prime]
7683QED
7684
7685(* ------------------------------------------------------------------------- *)
7686(* Coprimes by a divisor                                                     *)
7687(* ------------------------------------------------------------------------- *)
7688
7689(* Define the set of coprimes by a divisor of n *)
7690Definition coprimes_by_def:
7691    coprimes_by n d = if (0 < n /\ d divides n) then coprimes (n DIV d) else {}
7692End
7693
7694(*
7695EVAL ``coprimes_by 10 2``; = {4; 3; 2; 1}
7696EVAL ``coprimes_by 10 5``; = {1}
7697*)
7698
7699(* Theorem: j IN (coprimes_by n d) <=> (0 < n /\ d divides n /\ j IN coprimes (n DIV d)) *)
7700(* Proof: by coprimes_by_def, MEMBER_NOT_EMPTY *)
7701Theorem coprimes_by_element:
7702    !n d j. j IN (coprimes_by n d) <=> (0 < n /\ d divides n /\ j IN coprimes (n DIV d))
7703Proof
7704  metis_tac[coprimes_by_def, MEMBER_NOT_EMPTY]
7705QED
7706
7707(* Theorem: FINITE (coprimes_by n d) *)
7708(* Proof:
7709   From coprimes_by_def, this follows by:
7710   (1) !k. FINITE (coprimes k)  by coprimes_finite
7711   (2) FINITE {}                by FINITE_EMPTY
7712*)
7713Theorem coprimes_by_finite:
7714    !n d. FINITE (coprimes_by n d)
7715Proof
7716  rw[coprimes_by_def, coprimes_finite]
7717QED
7718
7719(* Theorem: coprimes_by 0 d = {} *)
7720(* Proof: by coprimes_by_def *)
7721Theorem coprimes_by_0:
7722    !d. coprimes_by 0 d = {}
7723Proof
7724  rw[coprimes_by_def]
7725QED
7726
7727(* Theorem: coprimes_by n 0 = {} *)
7728(* Proof:
7729     coprimes_by n 0
7730   = if 0 < n /\ 0 divides n then coprimes (n DIV 0) else {}
7731   = 0 < 0 then coprimes (n DIV 0) else {}    by ZERO_DIVIDES
7732   = {}                                       by prim_recTheory.LESS_REFL
7733*)
7734Theorem coprimes_by_by_0:
7735    !n. coprimes_by n 0 = {}
7736Proof
7737  rw[coprimes_by_def]
7738QED
7739
7740(* Theorem: 0 < n ==> (coprimes_by n 1 = coprimes n) *)
7741(* Proof:
7742   Since 1 divides n       by ONE_DIVIDES_ALL
7743       coprimes_by n 1
7744     = coprimes (n DIV 1)  by coprimes_by_def
7745     = coprimes n          by DIV_ONE, ONE
7746*)
7747Theorem coprimes_by_by_1:
7748    !n. 0 < n ==> (coprimes_by n 1 = coprimes n)
7749Proof
7750  rw[coprimes_by_def]
7751QED
7752
7753(* Theorem: 0 < n ==> (coprimes_by n n = {1}) *)
7754(* Proof:
7755   Since n divides n       by DIVIDES_REFL
7756       coprimes_by n n
7757     = coprimes (n DIV n)  by coprimes_by_def
7758     = coprimes 1          by DIVMOD_ID, 0 < n
7759     = {1}                 by coprimes_1
7760*)
7761Theorem coprimes_by_by_last:
7762    !n. 0 < n ==> (coprimes_by n n = {1})
7763Proof
7764  rw[coprimes_by_def, coprimes_1]
7765QED
7766
7767(* Theorem: 0 < n /\ d divides n ==> (coprimes_by n d = coprimes (n DIV d)) *)
7768(* Proof: by coprimes_by_def *)
7769Theorem coprimes_by_by_divisor:
7770    !n d. 0 < n /\ d divides n ==> (coprimes_by n d = coprimes (n DIV d))
7771Proof
7772  rw[coprimes_by_def]
7773QED
7774
7775(* Theorem: 0 < n ==> ((coprimes_by n d = {}) <=> ~(d divides n)) *)
7776(* Proof:
7777   If part: 0 < n /\ coprimes_by n d = {} ==> ~(d divides n)
7778      By contradiction. Suppose d divides n.
7779      Then d divides n and 0 < n means
7780           0 < d /\ d <= n                           by divides_pos, 0 < n
7781      Also coprimes_by n d = coprimes (n DIV d)      by coprimes_by_def
7782        so coprimes (n DIV d) = {} <=> n DIV d = 0   by coprimes_eq_empty
7783      Thus n < d                                     by DIV_EQUAL_0
7784      which contradicts d <= n.
7785   Only-if part: 0 < n /\ ~(d divides n) ==> coprimes n d = {}
7786      This follows by coprimes_by_def
7787*)
7788Theorem coprimes_by_eq_empty:
7789    !n d. 0 < n ==> ((coprimes_by n d = {}) <=> ~(d divides n))
7790Proof
7791  rw[EQ_IMP_THM] >| [
7792    spose_not_then strip_assume_tac >>
7793    `0 < d /\ d <= n` by metis_tac[divides_pos] >>
7794    `n DIV d = 0` by metis_tac[coprimes_by_def, coprimes_eq_empty] >>
7795    `n < d` by rw[GSYM DIV_EQUAL_0] >>
7796    decide_tac,
7797    rw[coprimes_by_def]
7798  ]
7799QED
7800
7801(* ------------------------------------------------------------------------- *)
7802(* GCD Equivalence Class                                                     *)
7803(* ------------------------------------------------------------------------- *)
7804
7805(* Define the set of values with the same gcd *)
7806Definition gcd_matches_def[nocompute]:
7807    gcd_matches n d = {j| j IN (natural n) /\ (gcd j n = d)}
7808End
7809(* use zDefine as this is not computationally effective. *)
7810
7811(* Theorem: gcd_matches n d = (natural n) INTER {j | gcd j n = d} *)
7812(* Proof: by gcd_matches_def *)
7813Theorem gcd_matches_alt[compute]:
7814  !n d. gcd_matches n d = (natural n) INTER {j | gcd j n = d}
7815Proof
7816  simp[gcd_matches_def, EXTENSION]
7817QED
7818
7819(*
7820EVAL ``gcd_matches 10 2``; = {8; 6; 4; 2}
7821EVAL ``gcd_matches 10 5``; = {5}
7822*)
7823
7824(* Theorem: j IN gcd_matches n d <=> 0 < j /\ j <= n /\ (gcd j n = d) *)
7825(* Proof: by gcd_matches_def *)
7826Theorem gcd_matches_element:
7827    !n d j. j IN gcd_matches n d <=> 0 < j /\ j <= n /\ (gcd j n = d)
7828Proof
7829  rw[gcd_matches_def, natural_element]
7830QED
7831
7832(* Theorem: (gcd_matches n d) SUBSET (natural n) *)
7833(* Proof: by gcd_matches_def, SUBSET_DEF *)
7834Theorem gcd_matches_subset:
7835    !n d. (gcd_matches n d) SUBSET (natural n)
7836Proof
7837  rw[gcd_matches_def, SUBSET_DEF]
7838QED
7839
7840(* Theorem: FINITE (gcd_matches n d) *)
7841(* Proof:
7842   Since (gcd_matches n d) SUBSET (natural n)   by coprimes_subset
7843     and !n. FINITE (natural n)                 by natural_finite
7844      so FINITE (gcd_matches n d)               by SUBSET_FINITE
7845*)
7846Theorem gcd_matches_finite:
7847    !n d. FINITE (gcd_matches n d)
7848Proof
7849  metis_tac[gcd_matches_subset, natural_finite, SUBSET_FINITE]
7850QED
7851
7852(* Theorem: gcd_matches 0 d = {} *)
7853(* Proof:
7854       j IN gcd_matches 0 d
7855   <=> 0 < j /\ j <= 0 /\ (gcd j 0 = d)   by gcd_matches_element
7856   Since no j can satisfy this, the set is empty.
7857*)
7858Theorem gcd_matches_0:
7859    !d. gcd_matches 0 d = {}
7860Proof
7861  rw[gcd_matches_element, EXTENSION]
7862QED
7863
7864(* Theorem: gcd_matches n 0 = {} *)
7865(* Proof:
7866       x IN gcd_matches n 0
7867   <=> 0 < x /\ x <= n /\ (gcd x n = 0)        by gcd_matches_element
7868   <=> 0 < x /\ x <= n /\ (x = 0) /\ (n = 0)   by GCD_EQ_0
7869   <=> F                                       by 0 < x, x = 0
7870   Hence gcd_matches n 0 = {}                  by EXTENSION
7871*)
7872Theorem gcd_matches_with_0:
7873    !n. gcd_matches n 0 = {}
7874Proof
7875  rw[EXTENSION, gcd_matches_element]
7876QED
7877
7878(* Theorem: gcd_matches 1 d = if d = 1 then {1} else {} *)
7879(* Proof:
7880       j IN gcd_matches 1 d
7881   <=> 0 < j /\ j <= 1 /\ (gcd j 1 = d)   by gcd_matches_element
7882   Only j to satisfy this is j = 1.
7883   and d = gcd 1 1 = 1                    by GCD_REF
7884   If d = 1, j = 1 is the only element.
7885   If d <> 1, the only element is taken out, set is empty.
7886*)
7887Theorem gcd_matches_1:
7888    !d. gcd_matches 1 d = if d = 1 then {1} else {}
7889Proof
7890  rw[gcd_matches_element, EXTENSION]
7891QED
7892
7893(* Theorem: 0 < n /\ d divides n ==> d IN (gcd_matches n d) *)
7894(* Proof:
7895   Note  0 < n /\ d divides n
7896     ==> 0 < d, and d <= n           by divides_pos
7897     and gcd d n = d                 by divides_iff_gcd_fix
7898   Hence d IN (gcd_matches n d)      by gcd_matches_element
7899*)
7900Theorem gcd_matches_has_divisor:
7901    !n d. 0 < n /\ d divides n ==> d IN (gcd_matches n d)
7902Proof
7903  rw[gcd_matches_element] >-
7904  metis_tac[divisor_pos] >-
7905  rw[DIVIDES_LE] >>
7906  rw[GSYM divides_iff_gcd_fix]
7907QED
7908
7909(* Theorem: j IN (gcd_matches n d) ==> d divides j /\ d divides n *)
7910(* Proof:
7911   If j IN (gcd_matches n d), gcd j n = d    by gcd_matches_element
7912   This means d divides j /\ d divides n     by GCD_IS_GREATEST_COMMON_DIVISOR
7913*)
7914Theorem gcd_matches_element_divides:
7915    !n d j. j IN (gcd_matches n d) ==> d divides j /\ d divides n
7916Proof
7917  metis_tac[gcd_matches_element, GCD_IS_GREATEST_COMMON_DIVISOR]
7918QED
7919
7920(* Theorem: 0 < n ==> ((gcd_matches n d = {}) <=> ~(d divides n)) *)
7921(* Proof:
7922   If part: 0 < n /\ (gcd_matches n d = {}) ==> ~(d divides n)
7923      By contradiction, suppose d divides n.
7924      Then d IN gcd_matches n d               by gcd_matches_has_divisor
7925      This contradicts gcd_matches n d = {}   by MEMBER_NOT_EMPTY
7926   Only-if part: 0 < n /\ ~(d divides n) ==> (gcd_matches n d = {})
7927      By contradiction, suppose gcd_matches n d <> {}.
7928      Then ?j. j IN (gcd_matches n d)         by MEMBER_NOT_EMPTY
7929      Giving d divides j /\ d divides n       by gcd_matches_element_divides
7930      This contradicts ~(d divides n).
7931*)
7932Theorem gcd_matches_eq_empty:
7933    !n d. 0 < n ==> ((gcd_matches n d = {}) <=> ~(d divides n))
7934Proof
7935  rw[EQ_IMP_THM] >-
7936  metis_tac[gcd_matches_has_divisor, MEMBER_NOT_EMPTY] >>
7937  metis_tac[gcd_matches_element_divides, MEMBER_NOT_EMPTY]
7938QED
7939
7940(* ------------------------------------------------------------------------- *)
7941(* Phi Function                                                              *)
7942(* ------------------------------------------------------------------------- *)
7943
7944(* Define the Euler phi function from coprime set *)
7945Definition phi_def:
7946   phi n = CARD (coprimes n)
7947End
7948(* Since (coprimes n) is computable, phi n is now computable *)
7949
7950(*
7951> EVAL ``phi 10``;
7952val it = |- phi 10 = 4: thm
7953*)
7954
7955(* Theorem: phi n = LENGTH (FILTER (\j. coprime j n) (GENLIST SUC n)) *)
7956(* Proof:
7957   Let ls = FILTER (\j. coprime j n) (GENLIST SUC n).
7958   Note ALL_DISTINCT (GENLIST SUC n)       by ALL_DISTINCT_GENLIST, SUC_EQ
7959   Thus ALL_DISTINCT ls                    by FILTER_ALL_DISTINCT
7960     phi n = CARD (coprimes n)             by phi_def
7961           = CARD (set ls)                 by coprimes_thm
7962           = LENGTH ls                     by ALL_DISTINCT_CARD_LIST_TO_SET
7963*)
7964Theorem phi_thm:
7965    !n. phi n = LENGTH (FILTER (\j. coprime j n) (GENLIST SUC n))
7966Proof
7967  rpt strip_tac >>
7968  qabbrev_tac `ls = FILTER (\j. coprime j n) (GENLIST SUC n)` >>
7969  `ALL_DISTINCT ls` by rw[ALL_DISTINCT_GENLIST, FILTER_ALL_DISTINCT, Abbr`ls`] >>
7970  `phi n = CARD (coprimes n)` by rw[phi_def] >>
7971  `_ = CARD (set ls)` by rw[coprimes_thm, Abbr`ls`] >>
7972  `_ = LENGTH ls` by rw[ALL_DISTINCT_CARD_LIST_TO_SET] >>
7973  decide_tac
7974QED
7975
7976(* Theorem: phi = CARD o coprimes *)
7977(* Proof: by phi_def, FUN_EQ_THM *)
7978Theorem phi_fun:
7979    phi = CARD o coprimes
7980Proof
7981  rw[phi_def, FUN_EQ_THM]
7982QED
7983
7984(* Theorem: 0 < n ==> 0 < phi n *)
7985(* Proof:
7986   Since 1 IN coprimes n       by coprimes_has_1
7987      so coprimes n <> {}      by MEMBER_NOT_EMPTY
7988     and FINITE (coprimes n)   by coprimes_finite
7989   hence phi n <> 0            by CARD_EQ_0
7990      or 0 < phi n
7991*)
7992Theorem phi_pos:
7993    !n. 0 < n ==> 0 < phi n
7994Proof
7995  rpt strip_tac >>
7996  `coprimes n <> {}` by metis_tac[coprimes_has_1, MEMBER_NOT_EMPTY] >>
7997  `FINITE (coprimes n)` by rw[coprimes_finite] >>
7998  `phi n <> 0` by rw[phi_def, CARD_EQ_0] >>
7999  decide_tac
8000QED
8001
8002(* Theorem: phi 0 = 0 *)
8003(* Proof:
8004     phi 0
8005   = CARD (coprimes 0)   by phi_def
8006   = CARD {}             by coprimes_0
8007   = 0                   by CARD_EMPTY
8008*)
8009Theorem phi_0:
8010    phi 0 = 0
8011Proof
8012  rw[phi_def, coprimes_0]
8013QED
8014
8015(* Theorem: (phi n = 0) <=> (n = 0) *)
8016(* Proof:
8017   If part: (phi n = 0) ==> (n = 0)    by phi_pos, NOT_ZERO_LT_ZERO
8018   Only-if part: phi 0 = 0             by phi_0
8019*)
8020Theorem phi_eq_0:
8021    !n. (phi n = 0) <=> (n = 0)
8022Proof
8023  metis_tac[phi_0, phi_pos, NOT_ZERO_LT_ZERO]
8024QED
8025
8026(* Theorem: phi 1 = 1 *)
8027(* Proof:
8028     phi 1
8029   = CARD (coprimes 1)    by phi_def
8030   = CARD {1}             by coprimes_1
8031   = 1                    by CARD_SING
8032*)
8033Theorem phi_1:
8034    phi 1 = 1
8035Proof
8036  rw[phi_def, coprimes_1]
8037QED
8038
8039(* Theorem: 1 < n ==> (phi n = totient n) *)
8040(* Proof:
8041      phi n
8042    = CARD (coprimes n)     by phi_def
8043    = CARD (Euler n )       by coprimes_eq_Euler
8044    = totient n             by totient_def
8045*)
8046Theorem phi_eq_totient:
8047    !n. 1 < n ==> (phi n = totient n)
8048Proof
8049  rw[phi_def, totient_def, coprimes_eq_Euler]
8050QED
8051
8052(* Theorem: prime n ==> (phi n = n - 1) *)
8053(* Proof:
8054   Since prime n ==> 1 < n   by ONE_LT_PRIME
8055   Hence   phi n
8056         = totient n         by phi_eq_totient
8057         = n - 1             by Euler_card_prime
8058*)
8059Theorem phi_prime:
8060    !n. prime n ==> (phi n = n - 1)
8061Proof
8062  rw[ONE_LT_PRIME, phi_eq_totient, Euler_card_prime]
8063QED
8064
8065(* Theorem: phi 2 = 1 *)
8066(* Proof:
8067   Since prime 2               by PRIME_2
8068      so phi 2 = 2 - 1 = 1     by phi_prime
8069*)
8070Theorem phi_2:
8071    phi 2 = 1
8072Proof
8073  rw[phi_prime, PRIME_2]
8074QED
8075
8076(* Theorem: 2 < n ==> 1 < phi n *)
8077(* Proof:
8078   Note 1 IN (coprimes n)        by coprimes_has_1, 0 < n
8079    and (n - 1) IN (coprimes n)  by coprimes_has_last_but_1, 1 < n
8080    and n - 1 <> 1               by 2 < n
8081    Now FINITE (coprimes n)      by coprimes_finite]
8082    and {1; (n-1)} SUBSET (coprimes n)   by SUBSET_DEF, above
8083   Note CARD {1; (n-1)} = 2      by CARD_INSERT, CARD_EMPTY, TWO
8084   thus 2 <= CARD (coprimes n)   by CARD_SUBSET
8085     or 1 < phi n                by phi_def
8086*)
8087Theorem phi_gt_1:
8088    !n. 2 < n ==> 1 < phi n
8089Proof
8090  rw[phi_def] >>
8091  `0 < n /\ 1 < n /\ n - 1 <> 1` by decide_tac >>
8092  `1 IN (coprimes n)` by rw[coprimes_has_1] >>
8093  `(n - 1) IN (coprimes n)` by rw[coprimes_has_last_but_1] >>
8094  `FINITE (coprimes n)` by rw[coprimes_finite] >>
8095  `{1; (n-1)} SUBSET (coprimes n)` by rw[SUBSET_DEF] >>
8096  `CARD {1; (n-1)} = 2` by rw[] >>
8097  `2 <= CARD (coprimes n)` by metis_tac[CARD_SUBSET] >>
8098  decide_tac
8099QED
8100
8101(* Theorem: phi n <= n *)
8102(* Proof:
8103   Note phi n = CARD (coprimes n)    by phi_def
8104    and coprimes n SUBSET natural n  by coprimes_subset
8105    Now FINITE (natural n)           by natural_finite
8106    and CARD (natural n) = n         by natural_card
8107     so CARD (coprimes n) <= n       by CARD_SUBSET
8108*)
8109Theorem phi_le:
8110    !n. phi n <= n
8111Proof
8112  metis_tac[phi_def, coprimes_subset, natural_finite, natural_card, CARD_SUBSET]
8113QED
8114
8115(* Theorem: 1 < n ==> phi n < n *)
8116(* Proof:
8117   Note phi n = CARD (coprimes n)    by phi_def
8118    and 1 < n ==> !j. j IN coprimes n ==> j < n     by coprimes_element_less
8119    but 0 NOTIN coprimes n           by coprimes_no_0
8120     or coprimes n SUBSET (count n) DIFF {0}  by SUBSET_DEF, IN_DIFF
8121    Let s = (count n) DIFF {0}.
8122   Note {0} SUBSET count n           by SUBSET_DEF]);
8123     so count n INTER {0} = {0}      by SUBSET_INTER_ABSORPTION
8124    Now FINITE s                     by FINITE_COUNT, FINITE_DIFF
8125    and CARD s = n - 1               by CARD_COUNT, CARD_DIFF, CARD_SING
8126     so CARD (coprimes n) <= n - 1   by CARD_SUBSET
8127     or phi n < n                    by arithmetic
8128*)
8129Theorem phi_lt:
8130    !n. 1 < n ==> phi n < n
8131Proof
8132  rw[phi_def] >>
8133  `!j. j IN coprimes n ==> j < n` by rw[coprimes_element_less] >>
8134  `!j. j IN coprimes n ==> j <> 0` by metis_tac[coprimes_no_0] >>
8135  qabbrev_tac `s = (count n) DIFF {0}` >>
8136  `coprimes n SUBSET s` by rw[SUBSET_DEF, Abbr`s`] >>
8137  `{0} SUBSET count n` by rw[SUBSET_DEF] >>
8138  `count n INTER {0} = {0}` by metis_tac[SUBSET_INTER_ABSORPTION, INTER_COMM] >>
8139  `FINITE s` by rw[Abbr`s`] >>
8140  `CARD s = n - 1` by rw[Abbr`s`] >>
8141  `CARD (coprimes n) <= n - 1` by metis_tac[CARD_SUBSET] >>
8142  decide_tac
8143QED
8144
8145(* ------------------------------------------------------------------------- *)
8146(* Divisors                                                                  *)
8147(* ------------------------------------------------------------------------- *)
8148
8149(* Define the set of divisors of a number. *)
8150Definition divisors_def[nocompute]:
8151   divisors n = {d | 0 < d /\ d <= n /\ d divides n}
8152End
8153(* use [nocompute] as this is not computationally effective. *)
8154(* Note: use of 0 < d to have positive divisors, as only 0 divides 0. *)
8155(* Note: use of d <= n to give divisors_0 = {}, since ALL_DIVIDES_0. *)
8156(* Note: for 0 < n, d <= n is redundant, as DIVIDES_LE implies it. *)
8157
8158(* Theorem: d IN divisors n <=> 0 < d /\ d <= n /\ d divides n *)
8159(* Proof: by divisors_def *)
8160Theorem divisors_element:
8161  !n d. d IN divisors n <=> 0 < d /\ d <= n /\ d divides n
8162Proof
8163  rw[divisors_def]
8164QED
8165
8166(* Theorem: 0 < n ==> !d. d IN divisors n <=> d divides n *)
8167(* Proof:
8168   If part: d IN divisors n ==> d divides n
8169      This is true                 by divisors_element
8170   Only-if part: 0 < n /\ d divides n ==> d IN divisors n
8171      Since 0 < n /\ d divides n
8172        ==> 0 < d /\ d <= n        by divides_pos
8173      Hence d IN divisors n        by divisors_element
8174*)
8175Theorem divisors_element_alt:
8176  !n. 0 < n ==> !d. d IN divisors n <=> d divides n
8177Proof
8178  metis_tac[divisors_element, divides_pos]
8179QED
8180
8181(* Theorem: d IN divisors n ==> 0 < n *)
8182(* Proof:
8183   Note 0 < d /\ d <= n /\ d divides n         by divisors_def
8184     so 0 < n                                  by inequality
8185*)
8186Theorem divisors_has_element:
8187  !n d. d IN divisors n ==> 0 < n
8188Proof
8189  simp[divisors_def]
8190QED
8191
8192(* Theorem: 0 < n ==> 1 IN (divisors n) *)
8193(* Proof:
8194    Note 1 divides n         by ONE_DIVIDES_ALL
8195   Hence 1 IN (divisors n)   by divisors_element_alt
8196*)
8197Theorem divisors_has_1:
8198  !n. 0 < n ==> 1 IN (divisors n)
8199Proof
8200  simp[divisors_element_alt]
8201QED
8202
8203(* Theorem: 0 < n ==> n IN (divisors n) *)
8204(* Proof:
8205    Note n divides n         by DIVIDES_REFL
8206   Hence n IN (divisors n)   by divisors_element_alt
8207*)
8208Theorem divisors_has_last:
8209  !n. 0 < n ==> n IN (divisors n)
8210Proof
8211  simp[divisors_element_alt]
8212QED
8213
8214(* Theorem: 0 < n ==> divisors n <> {} *)
8215(* Proof: by divisors_has_last, MEMBER_NOT_EMPTY *)
8216Theorem divisors_not_empty:
8217  !n. 0 < n ==> divisors n <> {}
8218Proof
8219  metis_tac[divisors_has_last, MEMBER_NOT_EMPTY]
8220QED
8221
8222(* Theorem: divisors 0 = {} *)
8223(* Proof: by divisors_def, 0 < d /\ d <= 0 is impossible. *)
8224Theorem divisors_0:
8225  divisors 0 = {}
8226Proof
8227  simp[divisors_def]
8228QED
8229
8230(* Theorem: divisors 1 = {1} *)
8231(* Proof: by divisors_def, 0 < d /\ d <= 1 ==> d = 1. *)
8232Theorem divisors_1:
8233  divisors 1 = {1}
8234Proof
8235  rw[divisors_def, EXTENSION]
8236QED
8237
8238(* Theorem: divisors n = {} <=> n = 0 *)
8239(* Proof:
8240   By EXTENSION, this is to show:
8241   (1) divisors n = {} ==> n = 0
8242       By contradiction, suppose n <> 0.
8243       Then 1 IN (divisors n)                  by divisors_has_1
8244       This contradicts divisors n = {}        by MEMBER_NOT_EMPTY
8245   (2) n = 0 ==> divisors n = {}
8246       This is true                            by divisors_0
8247*)
8248Theorem divisors_eq_empty:
8249  !n. divisors n = {} <=> n = 0
8250Proof
8251  rw[EQ_IMP_THM] >-
8252  metis_tac[divisors_has_1, MEMBER_NOT_EMPTY, NOT_ZERO] >>
8253  simp[divisors_0]
8254QED
8255
8256(* Idea: a method to evaluate divisors. *)
8257
8258(* Theorem: divisors n = IMAGE (\j. if (j + 1) divides n then j + 1 else 1) (count n) *)
8259(* Proof:
8260   Let f = \j. if (j + 1) divides n then j + 1 else 1.
8261   If n = 0,
8262        divisors 0
8263      = {d | 0 < d /\ d <= 0 /\ d divides 0}   by divisors_def
8264      = {}                                     by 0 < d /\ d <= 0
8265      = IMAGE f {}                             by IMAGE_EMPTY
8266      = IMAGE f (count 0)                      by COUNT_0
8267   If n <> 0,
8268        divisors n
8269      = {d | 0 < d /\ d <= n /\ d divides n}   by divisors_def
8270      = {d | d <> 0 /\ d <= n /\ d divides n}  by 0 < d
8271      = {k + 1 | (k + 1) <= n /\ (k + 1) divides n}
8272                                               by num_CASES, d <> 0
8273      = {k + 1 | k < n /\ (k + 1) divides n}   by arithmetic
8274      = IMAGE f {k | k < n}                    by IMAGE_DEF
8275      = IMAGE f (count n)                      by count_def
8276*)
8277Theorem divisors_eqn[compute]:
8278  !n. divisors n = IMAGE (\j. if (j + 1) divides n then j + 1 else 1) (count n)
8279Proof
8280  (rw[divisors_def, EXTENSION, EQ_IMP_THM] >> rw[]) >>
8281  `?k. x = SUC k` by metis_tac[num_CASES, NOT_ZERO] >>
8282  qexists_tac `k` >>
8283  fs[ADD1]
8284QED
8285
8286(*
8287> EVAL ``divisors 3``; = {3; 1}: thm
8288> EVAL ``divisors 4``; = {4; 2; 1}: thm
8289> EVAL ``divisors 5``; = {5; 1}: thm
8290> EVAL ``divisors 6``; = {6; 3; 2; 1}: thm
8291> EVAL ``divisors 7``; = {7; 1}: thm
8292> EVAL ``divisors 8``; = {8; 4; 2; 1}: thm
8293> EVAL ``divisors 9``; = {9; 3; 1}: thm
8294*)
8295
8296(* Idea: each factor of a product divides the product. *)
8297
8298(* Theorem: 0 < n /\ n = p * q ==> p IN divisors n /\ q IN divisors n *)
8299(* Proof:
8300   Note 0 < p /\ 0 < q             by MULT_EQ_0
8301     so p <= n /\ q <= n           by arithmetic
8302    and p divides n                by divides_def
8303    and q divides n                by divides_def, MULT_COMM
8304    ==> p IN divisors n /\
8305        q IN divisors n            by divisors_element_alt, 0 < n
8306*)
8307Theorem divisors_has_factor:
8308  !n p q. 0 < n /\ n = p * q ==> p IN divisors n /\ q IN divisors n
8309Proof
8310  (rw[divisors_element_alt] >> metis_tac[MULT_EQ_0, NOT_ZERO])
8311QED
8312
8313(* Idea: when factor divides, its cofactor also divides. *)
8314
8315(* Theorem: d IN divisors n ==> (n DIV d) IN divisors n *)
8316(* Proof:
8317   Note 0 < d /\ d <= n /\ d divides n         by divisors_def
8318    and 0 < n                                  by 0 < d /\ d <= n
8319     so 0 < n DIV d                            by DIV_POS, 0 < n
8320    and n DIV d <= n                           by DIV_LESS_EQ, 0 < d
8321    and n DIV d divides n                      by DIVIDES_COFACTOR, 0 < d
8322     so (n DIV d) IN divisors n                by divisors_def
8323*)
8324Theorem divisors_has_cofactor:
8325  !n d. d IN divisors n ==> (n DIV d) IN divisors n
8326Proof
8327  simp [divisors_def] >>
8328  ntac 3 strip_tac >>
8329  `0 < n` by decide_tac >>
8330  rw[DIV_POS, DIV_LESS_EQ, DIVIDES_COFACTOR]
8331QED
8332
8333(* Theorem: (divisors n) DELETE n = {m | 0 < m /\ m < n /\ m divides n} *)
8334(* Proof:
8335     (divisors n) DELETE n
8336   = {m | 0 < m /\ m <= n /\ m divides n} DELETE n     by divisors_def
8337   = {m | 0 < m /\ m <= n /\ m divides n} DIFF {n}     by DELETE_DEF
8338   = {m | 0 < m /\ m <> n /\ m <= n /\ m divides n}    by IN_DIFF
8339   = {m | 0 < m /\ m < n /\ m divides n}               by LESS_OR_EQ
8340*)
8341Theorem divisors_delete_last:
8342  !n. (divisors n) DELETE n = {m | 0 < m /\ m < n /\ m divides n}
8343Proof
8344  rw[divisors_def, EXTENSION, EQ_IMP_THM]
8345QED
8346
8347(* Theorem: d IN (divisors n) ==> 0 < d *)
8348(* Proof: by divisors_def. *)
8349Theorem divisors_nonzero:
8350  !n d. d IN (divisors n) ==> 0 < d
8351Proof
8352  simp[divisors_def]
8353QED
8354
8355(* Theorem: (divisors n) SUBSET (natural n) *)
8356(* Proof:
8357   By SUBSET_DEF, this is to show:
8358       x IN (divisors n) ==> x IN (natural n)
8359       x IN (divisors n)
8360   ==> 0 < x /\ x <= n /\ x divides n          by divisors_element
8361   ==> 0 < x /\ x <= n
8362   ==> x IN (natural n)                        by natural_element
8363*)
8364Theorem divisors_subset_natural:
8365  !n. (divisors n) SUBSET (natural n)
8366Proof
8367  rw[divisors_element, natural_element, SUBSET_DEF]
8368QED
8369
8370(* Theorem: FINITE (divisors n) *)
8371(* Proof:
8372   Since (divisors n) SUBSET (natural n)       by divisors_subset_natural
8373     and FINITE (naturnal n)                   by natural_finite
8374      so FINITE (divisors n)                   by SUBSET_FINITE
8375*)
8376Theorem divisors_finite:
8377  !n. FINITE (divisors n)
8378Proof
8379  metis_tac[divisors_subset_natural, natural_finite, SUBSET_FINITE]
8380QED
8381
8382(* Theorem: BIJ (\d. n DIV d) (divisors n) (divisors n) *)
8383(* Proof:
8384   By BIJ_DEF, INJ_DEF, SURJ_DEF, this is to show:
8385   (1) d IN divisors n ==> n DIV d IN divisors n
8386       This is true                                       by divisors_has_cofactor
8387   (2) d IN divisors n /\ d' IN divisors n /\ n DIV d = n DIV d' ==> d = d'
8388       d IN divisors n ==> d divides n /\ 0 < d           by divisors_element
8389       d' IN divisors n ==> d' divides n /\ 0 < d'        by divisors_element
8390       Also d IN divisors n ==> 0 < n                     by divisors_has_element
8391       Hence n = (n DIV d) * d  and n = (n DIV d') * d'   by DIVIDES_EQN
8392       giving   (n DIV d) * d = (n DIV d') * d'
8393       Now (n DIV d) <> 0, otherwise contradicts n <> 0   by MULT
8394       Hence                d = d'                        by EQ_MULT_LCANCEL
8395   (3) same as (1), true                                  by divisors_has_cofactor
8396   (4) x IN divisors n ==> ?d. d IN divisors n /\ (n DIV d = x)
8397       Note x IN divisors n ==> x divides n               by divisors_element
8398        and 0 < n                                         by divisors_has_element
8399       Let d = n DIV x.
8400       Then d IN divisors n                               by divisors_has_cofactor
8401       and  n DIV d = n DIV (n DIV x) = x                 by divide_by_cofactor, 0 < n
8402*)
8403Theorem divisors_divisors_bij:
8404  !n. (\d. n DIV d) PERMUTES divisors n
8405Proof
8406  rw[BIJ_DEF, INJ_DEF, SURJ_DEF] >-
8407  rw[divisors_has_cofactor] >-
8408 (`n = (n DIV d) * d` by metis_tac[DIVIDES_EQN, divisors_element] >>
8409  `n = (n DIV d') * d'` by metis_tac[DIVIDES_EQN, divisors_element] >>
8410  `0 < n` by metis_tac[divisors_has_element] >>
8411  `n DIV d <> 0` by metis_tac[MULT, NOT_ZERO] >>
8412  metis_tac[EQ_MULT_LCANCEL]) >-
8413  rw[divisors_has_cofactor] >>
8414  `0 < n` by metis_tac[divisors_has_element] >>
8415  metis_tac[divisors_element, divisors_has_cofactor, divide_by_cofactor]
8416QED
8417
8418(* ------------------------------------------------------------------------- *)
8419(* An upper bound for divisors.                                              *)
8420(* ------------------------------------------------------------------------- *)
8421
8422(* Idea: if a divisor of n is less or equal to (SQRT n), its cofactor is more or equal to (SQRT n) *)
8423
8424(* Theorem: 0 < p /\ p divides n /\ p <= SQRT n ==> SQRT n <= (n DIV p) *)
8425(* Proof:
8426   Let m = SQRT n, then p <= m.
8427   By contradiction, suppose (n DIV p) < m.
8428   Then  n = (n DIV p) * p         by DIVIDES_EQN, 0 < p
8429          <= (n DIV p) * m         by p <= m
8430           < m * m                 by (n DIV p) < m
8431          <= n                     by SQ_SQRT_LE
8432   giving n < n, which is a contradiction.
8433*)
8434Theorem divisor_le_cofactor_ge:
8435  !n p. 0 < p /\ p divides n /\ p <= SQRT n ==> SQRT n <= (n DIV p)
8436Proof
8437  rpt strip_tac >>
8438  qabbrev_tac `m = SQRT n` >>
8439  spose_not_then strip_assume_tac >>
8440  `n = (n DIV p) * p` by rfs[DIVIDES_EQN] >>
8441  `(n DIV p) * p <= (n DIV p) * m` by fs[] >>
8442  `(n DIV p) * m < m * m` by fs[] >>
8443  `m * m <= n` by simp[SQ_SQRT_LE, Abbr`m`] >>
8444  decide_tac
8445QED
8446
8447(* Idea: if a divisor of n is greater than (SQRT n), its cofactor is less or equal to (SQRT n) *)
8448
8449(* Theorem: 0 < p /\ p divides n /\ SQRT n < p ==> (n DIV p) <= SQRT n *)
8450(* Proof:
8451   Let m = SQRT n, then m < p.
8452   By contradiction, suppose m < (n DIV p).
8453   Let q = (n DIV p).
8454   Then SUC m <= p, SUC m <= q     by m < p, m < q
8455   and   n = q * p                 by DIVIDES_EQN, 0 < p
8456          >= (SUC m) * (SUC m)     by LESS_MONO_MULT2
8457           = (SUC m) ** 2          by EXP_2
8458           > n                     by SQRT_PROPERTY
8459   which is a contradiction.
8460*)
8461Theorem divisor_gt_cofactor_le:
8462  !n p. 0 < p /\ p divides n /\ SQRT n < p ==> (n DIV p) <= SQRT n
8463Proof
8464  rpt strip_tac >>
8465  qabbrev_tac `m = SQRT n` >>
8466  spose_not_then strip_assume_tac >>
8467  `n = (n DIV p) * p` by rfs[DIVIDES_EQN] >>
8468  qabbrev_tac `q = n DIV p` >>
8469  `SUC m <= p /\ SUC m <= q` by decide_tac >>
8470  `(SUC m) * (SUC m) <= q * p` by simp[LESS_MONO_MULT2] >>
8471  `n < (SUC m) * (SUC m)` by metis_tac[SQRT_PROPERTY, EXP_2] >>
8472  decide_tac
8473QED
8474
8475(* Idea: for (divisors n), the map (\j. n DIV j) is injective. *)
8476
8477(* Theorem: INJ (\j. n DIV j) (divisors n) univ(:num) *)
8478(* Proof:
8479   By INJ_DEF, this is to show:
8480   (1) !x. x IN (divisors n) ==> (\j. n DIV j) x IN univ(:num)
8481       True by types, n DIV j is a number, with type :num.
8482   (2) !x y. x IN (divisors n) /\ y IN (divisors n) /\ n DIV x = n DIV y ==> x = y
8483       Note x divides n /\ 0 < x /\ x <= n     by divisors_def
8484        and y divides n /\ 0 < y /\ x <= n     by divisors_def
8485        Let p = n DIV x, q = n DIV y.
8486       Note 0 < n                              by divisors_has_element
8487       then 0 < p, 0 < q                       by DIV_POS, 0 < n
8488       Then  n = p * x = q * y                 by DIVIDES_EQN, 0 < x, 0 < y
8489        But          p = q                     by given
8490         so          x = y                     by EQ_MULT_LCANCEL
8491*)
8492Theorem divisors_cofactor_inj:
8493  !n. INJ (\j. n DIV j) (divisors n) univ(:num)
8494Proof
8495  rw[INJ_DEF, divisors_def] >>
8496  `n = n DIV j * j` by fs[GSYM DIVIDES_EQN] >>
8497  `n = n DIV j' * j'` by fs[GSYM DIVIDES_EQN] >>
8498  `0 < n` by fs[GSYM divisors_has_element] >>
8499  metis_tac[EQ_MULT_LCANCEL, DIV_POS, NOT_ZERO]
8500QED
8501
8502(* Idea: an upper bound for CARD (divisors n).
8503
8504To prove: 0 < n ==> CARD (divisors n) <= 2 * SQRT n
8505Idea of proof:
8506   Consider the two sets,
8507      s = {x | x IN divisors n /\ x <= SQRT n}
8508      t = {x | x IN divisors n /\ SQRT n <= x}
8509   Note s SUBSET (natural (SQRT n)), so CARD s <= SQRT n.
8510   Also t SUBSET (natural (SQRT n)), so CARD t <= SQRT n.
8511   There is a bijection between the two parts:
8512      BIJ (\j. n DIV j) s t
8513   Now divisors n = s UNION t
8514      CARD (divisors n)
8515    = CARD s + CARD t - CARD (s INTER t)
8516   <= CARD s + CARD t
8517   <= SQRT n + SQRT n
8518    = 2 * SQRT n
8519
8520   The BIJ part will be quite difficult.
8521   So the actual proof is a bit different.
8522*)
8523
8524(* Theorem: CARD (divisors n) <= 2 * SQRT n *)
8525(* Proof:
8526   Let m = SQRT n,
8527       d = divisors n,
8528       s = {x | x IN d /\ x <= m},
8529       f = \j. n DIV j,
8530       t = IMAGE f s.
8531
8532   Claim: s SUBSET natural m
8533   Proof: By SUBSET_DEF, this is to show:
8534             x IN d /\ x <= m ==> ?y. x = SUC y /\ y < m
8535          Note 0 < x               by divisors_nonzero
8536          Let y = PRE x.
8537          Then x = SUC (PRE x)     by SUC_PRE
8538           and PRE x < x           by PRE_LESS
8539            so PRE x < m           by inequality, x <= m
8540
8541   Claim: BIJ f s t
8542   Proof: Note s SUBSET d          by SUBSET_DEF
8543           and INJ f d univ(:num)  by divisors_cofactor_inj
8544            so INJ f s univ(:num)  by INJ_SUBSET, SUBSET_REFL
8545           ==> BIJ f s t           by INJ_IMAGE_BIJ_ALT
8546
8547   Claim: d = s UNION t
8548   Proof: By EXTENSION, EQ_IMP_THM, this is to show:
8549          (1) x IN divisors n ==> x <= m \/ ?j. x = n DIV j /\ j IN divisors n /\ j <= m
8550              If x <= m, this is trivial.
8551              Otherwise, m < x.
8552              Let j = n DIV x.
8553              Then x = n DIV (n DIV x)         by divide_by_cofactor
8554               and (n DIV j) IN divisors n     by divisors_has_cofactor
8555               and (n DIV j) <= m              by divisor_gt_cofactor_le
8556          (2) j IN divisors n ==> n DIV j IN divisors n
8557              This is true                     by divisors_has_cofactor
8558
8559    Now FINITE (natural m)         by natural_finite
8560     so FINITE s                   by SUBSET_FINITE
8561    and FINITE t                   by IMAGE_FINITE
8562     so CARD s <= m                by CARD_SUBSET, natural_card
8563   Also CARD t = CARD s            by FINITE_BIJ_CARD
8564
8565        CARD d <= CARD s + CARD t  by CARD_UNION_LE, d = s UNION t
8566               <= m + m            by above
8567                = 2 * m            by arithmetic
8568*)
8569Theorem divisors_card_upper:
8570  !n. CARD (divisors n) <= 2 * SQRT n
8571Proof
8572  rpt strip_tac >>
8573  qabbrev_tac `m = SQRT n` >>
8574  qabbrev_tac `d = divisors n` >>
8575  qabbrev_tac `s = {x | x IN d /\ x <= m}` >>
8576  qabbrev_tac `f = \j. n DIV j` >>
8577  qabbrev_tac `t = (IMAGE f s)` >>
8578  `s SUBSET (natural m)` by
8579  (rw[SUBSET_DEF, Abbr`s`] >>
8580  `0 < x` by metis_tac[divisors_nonzero] >>
8581  qexists_tac `PRE x` >>
8582  simp[]) >>
8583  `BIJ f s t` by
8584    (simp[Abbr`t`] >>
8585  irule INJ_IMAGE_BIJ_ALT >>
8586  `s SUBSET d` by rw[SUBSET_DEF, Abbr`s`] >>
8587  `INJ f d univ(:num)` by metis_tac[divisors_cofactor_inj] >>
8588  metis_tac[INJ_SUBSET, SUBSET_REFL]) >>
8589  `d = s UNION t` by
8590      (rw[EXTENSION, Abbr`d`, Abbr`s`, Abbr`t`, Abbr`f`, EQ_IMP_THM] >| [
8591    (Cases_on `x <= m` >> simp[]) >>
8592    qexists_tac `n DIV x` >>
8593    `0 < x /\ x <= n /\ x divides n` by fs[divisors_element] >>
8594    simp[divide_by_cofactor, divisors_has_cofactor] >>
8595    `m < x` by decide_tac >>
8596    simp[divisor_gt_cofactor_le, Abbr`m`],
8597    simp[divisors_has_cofactor]
8598  ]) >>
8599  `FINITE (natural m)` by simp[natural_finite] >>
8600  `FINITE s /\ FINITE t` by metis_tac[SUBSET_FINITE, IMAGE_FINITE] >>
8601  `CARD s <= m` by metis_tac[CARD_SUBSET, natural_card] >>
8602  `CARD t = CARD s` by metis_tac[FINITE_BIJ_CARD] >>
8603  `CARD d <= CARD s + CARD t` by metis_tac[CARD_UNION_LE] >>
8604  decide_tac
8605QED
8606
8607(* This is a remarkable result! *)
8608
8609
8610(* ------------------------------------------------------------------------- *)
8611(* Gauss' Little Theorem                                                     *)
8612(* ------------------------------------------------------------------------- *)
8613(* ------------------------------------------------------------------------- *)
8614(* Gauss' Little Theorem: sum of phi over divisors                           *)
8615(* ------------------------------------------------------------------------- *)
8616(* ------------------------------------------------------------------------- *)
8617(* Gauss' Little Theorem: A general theory on sum over divisors              *)
8618(* ------------------------------------------------------------------------- *)
8619
8620(*
8621Let n = 6. (divisors 6) = {1, 2, 3, 6}
8622  IMAGE coprimes (divisors 6)
8623= {coprimes 1, coprimes 2, coprimes 3, coprimes 6}
8624= {{1}, {1}, {1, 2}, {1, 5}}   <-- will collapse
8625  IMAGE (preimage (gcd 6) (count 6)) (divisors 6)
8626= {{preimage in count 6 of those gcd 6 j = 1},
8627   {preimage in count 6 of those gcd 6 j = 2},
8628   {preimage in count 6 of those gcd 6 j = 3},
8629   {preimage in count 6 of those gcd 6 j = 6}}
8630= {{1, 5}, {2, 4}, {3}, {6}}
8631= {1x{1, 5}, 2x{1, 2}, 3x{1}, 6x{1}}
8632!s. s IN (IMAGE (preimage (gcd n) (count n)) (divisors n))
8633==> ?d. d divides n /\ d < n /\ s = preimage (gcd n) (count n) d
8634==> ?d. d divides n /\ d < n /\ s = IMAGE (TIMES d) (coprimes ((gcd n d) DIV d))
8635
8636  IMAGE (feq_class (count 6) (gcd 6)) (divisors 6)
8637= {{feq_class in count 6 of those gcd 6 j = 1},
8638   {feq_class in count 6 of those gcd 6 j = 2},
8639   {feq_class in count 6 of those gcd 6 j = 3},
8640   {feq_class in count 6 of those gcd 6 j = 6}}
8641= {{1, 5}, {2, 4}, {3}, {6}}
8642= {1x{1, 5}, 2x{1, 2}, 3x{1}, 6x{1}}
8643That is:  CARD {1, 5} = CARD (coprime 6) = CARD (coprime (6 DIV 1))
8644          CARD {2, 4} = CARD (coprime 3) = CARD (coprime (6 DIV 2))
8645          CARD {3} = CARD (coprime 2) = CARD (coprime (6 DIV 3)))
8646          CARD {6} = CARD (coprime 1) = CARD (coprime (6 DIV 6)))
8647
8648*)
8649(* Note:
8650   In general, what is the condition for:  SIGMA f s = SIGMA g t ?
8651   Conceptually,
8652       SIGMA f s = f s1 + f s2 + f s3 + ... + f sn
8653   and SIGMA g t = g t1 + g t2 + g t3 + ... + g tm
8654
8655SUM_IMAGE_eq_SUM_MAP_SET_TO_LIST
8656
8657Use disjoint_bigunion_card
8658|- !P. FINITE P /\ EVERY_FINITE P /\ PAIR_DISJOINT P ==> (CARD (BIGUNION P) = SIGMA CARD P)
8659If a partition P = {s | condition on s} the element s = IMAGE g t
8660e.g.  P = {{1, 5} {2, 4} {3} {6}}
8661        = {IMAGE (TIMES 1) (coprimes 6/1),
8662           IMAGE (TIMES 2) (coprimes 6/2),
8663           IMAGE (TIMES 3) (coprimes 6/3),
8664           IMAGE (TIMES 6) (coprimes 6/6)}
8665        =  IMAGE (\d. TIMES d o coprimes (6/d)) {1, 2, 3, 6}
8666
8667*)
8668
8669(* Theorem: d divides n ==> !j. j IN gcd_matches n d ==> j DIV d IN coprimes_by n d *)
8670(* Proof:
8671   When n = 0, gcd_matches 0 d = {}       by gcd_matches_0, hence trivially true.
8672   Otherwise,
8673   By coprimes_by_def, this is to show:
8674      0 < n /\ d divides n ==> !j. j IN gcd_matches n d ==> j DIV d IN coprimes (n DIV d)
8675   Note j IN gcd_matches n d
8676    ==> d divides j               by gcd_matches_element_divides
8677   Also d IN gcd_matches n d      by gcd_matches_has_divisor
8678     so 0 < d /\ (d = gcd j n)    by gcd_matches_element
8679     or d <> 0 /\ (d = gcd n j)   by GCD_SYM
8680   With the given d divides n,
8681        j = d * (j DIV d)         by DIVIDES_EQN, MULT_COMM, 0 < d
8682        n = d * (n DIV d)         by DIVIDES_EQN, MULT_COMM, 0 < d
8683  Hence d = d * gcd (n DIV d) (j DIV d)        by GCD_COMMON_FACTOR
8684     or d * 1 = d * gcd (n DIV d) (j DIV d)    by MULT_RIGHT_1
8685  giving    1 = gcd (n DIV d) (j DIV d)        by EQ_MULT_LCANCEL, d <> 0
8686      or    coprime (j DIV d) (n DIV d)        by GCD_SYM
8687   Also j IN natural n            by gcd_matches_subset, SUBSET_DEF
8688  Hence 0 < j DIV d /\ j DIV d <= n DIV d      by natural_cofactor_natural_reduced
8689     or j DIV d IN coprimes (n DIV d)          by coprimes_element
8690*)
8691Theorem gcd_matches_divisor_element:
8692    !n d. d divides n ==> !j. j IN gcd_matches n d ==> j DIV d IN coprimes_by n d
8693Proof
8694  rpt strip_tac >>
8695  Cases_on `n = 0` >-
8696  metis_tac[gcd_matches_0, NOT_IN_EMPTY] >>
8697  `0 < n` by decide_tac >>
8698  rw[coprimes_by_def] >>
8699  `d divides j` by metis_tac[gcd_matches_element_divides] >>
8700  `0 < d /\ 0 < j /\ j <= n /\ (d = gcd n j)` by metis_tac[gcd_matches_has_divisor, gcd_matches_element, GCD_SYM] >>
8701  `d <> 0` by decide_tac >>
8702  `(j = d * (j DIV d)) /\ (n = d * (n DIV d))` by metis_tac[DIVIDES_EQN, MULT_COMM] >>
8703  `coprime (n DIV d) (j DIV d)` by metis_tac[GCD_COMMON_FACTOR, MULT_RIGHT_1, EQ_MULT_LCANCEL] >>
8704  `0 < j DIV d /\ j DIV d <= n DIV d` by metis_tac[natural_cofactor_natural_reduced, natural_element] >>
8705  metis_tac[coprimes_element, GCD_SYM]
8706QED
8707
8708(* Theorem: d divides n ==> BIJ (\j. j DIV d) (gcd_matches n d) (coprimes_by n d) *)
8709(* Proof:
8710   When n = 0, gcd_matches 0 d = {}       by gcd_matches_0
8711           and coprimes_by 0 d = {}       by coprimes_by_0, hence trivially true.
8712   Otherwise,
8713   By definitions, this is to show:
8714   (1) j IN gcd_matches n d ==> j DIV d IN coprimes_by n d
8715       True by gcd_matches_divisor_element.
8716   (2) j IN gcd_matches n d /\ j' IN gcd_matches n d /\ j DIV d = j' DIV d ==> j = j'
8717      Note j IN gcd_matches n d /\ j' IN gcd_matches n d
8718       ==> d divides j /\ d divides j'             by gcd_matches_element_divides
8719      Also d IN (gcd_matches n d)                  by gcd_matches_has_divisor
8720        so 0 < d                                   by gcd_matches_element
8721      Thus j = (j DIV d) * d                       by DIVIDES_EQN, 0 < d
8722       and j' = (j' DIV d) * d                     by DIVIDES_EQN, 0 < d
8723      Since j DIV d = j' DIV d, j = j'.
8724   (3) same as (1), true by gcd_matches_divisor_element,
8725   (4) d divides n /\ x IN coprimes_by n d ==> ?j. j IN gcd_matches n d /\ (j DIV d = x)
8726       Note x IN coprimes (n DIV d)                by coprimes_by_def
8727        ==> 0 < x /\ x <= n DIV d /\ (coprime x (n DIV d))  by coprimes_element
8728        And d divides n /\ 0 < n
8729        ==> 0 < d /\ d <> 0                        by ZERO_DIVIDES, 0 < n
8730       Giving (x * d) DIV d = x                    by MULT_DIV, 0 < d
8731        Let j = x * d. so j DIV d = x              by above
8732       Then d divides j                            by divides_def
8733        ==> j = (j DIV d) * d                      by DIVIDES_EQN, 0 < d
8734       Note d divides n
8735        ==> n = (n DIV d) * d                      by DIVIDES_EQN, 0 < d
8736      Hence gcd j n
8737          = gcd (d * (j DIV d)) (d * (n DIV d))    by MULT_COMM
8738          = d * gcd (j DIV d) (n DIV d)            by GCD_COMMON_FACTOR
8739          = d * gcd x (n DIV d)                    by x = j DIV d
8740          = d * 1                                  by coprime x (n DIV d)
8741          = d                                      by MULT_RIGHT_1
8742      Since j = x * d, 0 < j                       by MULT_EQ_0, 0 < x, 0 < d
8743       Also x <= n DIV d
8744       means j DIV d <= n DIV d                    by x = j DIV d
8745          so (j DIV d) * d <= (n DIV d) * d        by LE_MULT_RCANCEL, d <> 0
8746          or             j <= n                    by above
8747      Hence j IN gcd_matches n d                   by gcd_matches_element
8748*)
8749Theorem gcd_matches_bij_coprimes_by:
8750    !n d. d divides n ==> BIJ (\j. j DIV d) (gcd_matches n d) (coprimes_by n d)
8751Proof
8752  rpt strip_tac >>
8753  Cases_on `n = 0` >| [
8754    `gcd_matches n d = {}` by rw[gcd_matches_0] >>
8755    `coprimes_by n d = {}` by rw[coprimes_by_0] >>
8756    rw[],
8757    `0 < n` by decide_tac >>
8758    rw[BIJ_DEF, INJ_DEF, SURJ_DEF, EQ_IMP_THM] >-
8759    rw[GSYM gcd_matches_divisor_element] >-
8760    metis_tac[gcd_matches_element_divides, gcd_matches_has_divisor, gcd_matches_element, DIVIDES_EQN] >-
8761    rw[GSYM gcd_matches_divisor_element] >>
8762    `0 < x /\ x <= n DIV d /\ (coprime x (n DIV d))` by metis_tac[coprimes_by_def, coprimes_element] >>
8763    `0 < d /\ d <> 0` by metis_tac[ZERO_DIVIDES, NOT_ZERO] >>
8764    `(x * d) DIV d = x` by rw[MULT_DIV] >>
8765    qabbrev_tac `j = x * d` >>
8766    `d divides j` by metis_tac[divides_def] >>
8767    `(n = (n DIV d) * d) /\ (j = (j DIV d) * d)` by rw[GSYM DIVIDES_EQN] >>
8768    `gcd j n = d` by metis_tac[GCD_COMMON_FACTOR, MULT_COMM, MULT_RIGHT_1] >>
8769    `0 < j` by metis_tac[MULT_EQ_0, NOT_ZERO] >>
8770    `j <= n` by metis_tac[LE_MULT_RCANCEL] >>
8771    metis_tac[gcd_matches_element]
8772  ]
8773QED
8774
8775(* Theorem: 0 < n /\ d divides n ==> BIJ (\j. j DIV d) (gcd_matches n d) (coprimes (n DIV d)) *)
8776(* Proof: by gcd_matches_bij_coprimes_by, coprimes_by_by_divisor *)
8777Theorem gcd_matches_bij_coprimes:
8778    !n d. 0 < n /\ d divides n ==> BIJ (\j. j DIV d) (gcd_matches n d) (coprimes (n DIV d))
8779Proof
8780  metis_tac[gcd_matches_bij_coprimes_by, coprimes_by_by_divisor]
8781QED
8782
8783(* Note: it is not useful to show:
8784         CARD o (gcd_matches n) = CARD o coprimes,
8785   as FUN_EQ_THM will demand:  CARD (gcd_matches n x) = CARD (coprimes x),
8786   which is not possible.
8787*)
8788
8789(* Theorem: divisors n = IMAGE (gcd n) (natural n) *)
8790(* Proof:
8791     divisors n
8792   = {d | 0 < d /\ d <= n /\ d divides n}       by divisors_def
8793   = {d | d IN (natural n) /\ d divides n}      by natural_element
8794   = {d | d IN (natural n) /\ (gcd d n = d)}    by divides_iff_gcd_fix
8795   = {d | d IN (natural n) /\ (gcd n d = d)}    by GCD_SYM
8796   = {gcd n d | d | d IN (natural n)}           by replacemnt
8797   = IMAGE (gcd n) (natural n)                  by IMAGE_DEF
8798   The replacemnt requires:
8799       d IN (natural n) ==> gcd n d IN (natural n)
8800       d IN (natural n) ==> gcd n (gcd n d) = gcd n d
8801   which are given below.
8802
8803   Or, by divisors_def, natuarl_elemnt, IN_IMAGE, this is to show:
8804   (1) 0 < x /\ x <= n /\ x divides n ==> ?y. (x = gcd n y) /\ 0 < y /\ y <= n
8805       Note x divides n ==> gcd x n = x         by divides_iff_gcd_fix
8806         or                 gcd n x = x         by GCD_SYM
8807       Take this x, and the result follows.
8808   (2) 0 < y /\ y <= n ==> 0 < gcd n y /\ gcd n y <= n /\ gcd n y divides n
8809       Note 0 < n                               by arithmetic
8810        and gcd n y divides n                   by GCD_IS_GREATEST_COMMON_DIVISOR, 0 < n
8811        and 0 < gcd n y                         by GCD_EQ_0, n <> 0
8812        and gcd n y <= n                        by DIVIDES_LE, 0 < n
8813*)
8814Theorem divisors_eq_gcd_image:
8815  !n. divisors n = IMAGE (gcd n) (natural n)
8816Proof
8817  rw_tac std_ss[divisors_def, GSPECIFICATION, EXTENSION, IN_IMAGE, natural_element, EQ_IMP_THM] >| [
8818    `0 < n` by decide_tac >>
8819    metis_tac[divides_iff_gcd_fix, GCD_SYM],
8820    metis_tac[GCD_EQ_0, NOT_ZERO],
8821    `0 < n` by decide_tac >>
8822    metis_tac[GCD_IS_GREATEST_COMMON_DIVISOR, DIVIDES_LE],
8823    metis_tac[GCD_IS_GREATEST_COMMON_DIVISOR]
8824  ]
8825QED
8826
8827(* Theorem: feq_class (gcd n) (natural n) d = gcd_matches n d *)
8828(* Proof:
8829     feq_class (gcd n) (natural n) d
8830   = {x | x IN natural n /\ (gcd n x = d)}   by feq_class_def
8831   = {j | j IN natural n /\ (gcd j n = d)}   by GCD_SYM
8832   = gcd_matches n d                         by gcd_matches_def
8833*)
8834Theorem gcd_eq_equiv_class:
8835    !n d. feq_class (gcd n) (natural n) d = gcd_matches n d
8836Proof
8837  rewrite_tac[gcd_matches_def] >>
8838  rw[EXTENSION, GCD_SYM, in_preimage]
8839QED
8840
8841(* Theorem: feq_class (gcd n) (natural n) = gcd_matches n *)
8842(* Proof: by FUN_EQ_THM, gcd_eq_equiv_class *)
8843Theorem gcd_eq_equiv_class_fun:
8844    !n. feq_class (gcd n) (natural n) = gcd_matches n
8845Proof
8846  rw[FUN_EQ_THM, gcd_eq_equiv_class]
8847QED
8848
8849(* Theorem: partition (feq (gcd n)) (natural n) = IMAGE (gcd_matches n) (divisors n) *)
8850(* Proof:
8851     partition (feq (gcd n)) (natural n)
8852   = IMAGE (equiv_class (feq (gcd n)) (natural n)) (natural n)      by partition_elements
8853   = IMAGE ((feq_class (gcd n) (natural n)) o (gcd n)) (natural n)  by feq_class_fun
8854   = IMAGE ((gcd_matches n) o (gcd n)) (natural n)       by gcd_eq_equiv_class_fun
8855   = IMAGE (gcd_matches n) (IMAGE (gcd n) (natural n))   by IMAGE_COMPOSE
8856   = IMAGE (gcd_matches n) (divisors n)                  by divisors_eq_gcd_image, 0 < n
8857*)
8858Theorem gcd_eq_partition_by_divisors:
8859  !n. partition (feq (gcd n)) (natural n) = IMAGE (gcd_matches n) (divisors n)
8860Proof
8861  rpt strip_tac >>
8862  qabbrev_tac `f = gcd n` >>
8863  qabbrev_tac `s = natural n` >>
8864  `partition (feq f) s = IMAGE (equiv_class (feq f) s) s` by rw[partition_elements] >>
8865  `_ = IMAGE ((feq_class f s) o f) s` by rw[feq_class_fun] >>
8866  `_ = IMAGE ((gcd_matches n) o f) s` by rw[gcd_eq_equiv_class_fun, Abbr`f`, Abbr`s`] >>
8867  `_ = IMAGE (gcd_matches n) (IMAGE f s)` by rw[IMAGE_COMPOSE] >>
8868  `_ = IMAGE (gcd_matches n) (divisors n)` by rw[divisors_eq_gcd_image, Abbr`f`, Abbr`s`] >>
8869  simp[]
8870QED
8871
8872(* Theorem: (feq (gcd n)) equiv_on (natural n) *)
8873(* Proof:
8874   By feq_equiv |- !s f. feq f equiv_on s
8875   Taking s = upto n, f = natural n.
8876*)
8877Theorem gcd_eq_equiv_on_natural:
8878    !n. (feq (gcd n)) equiv_on (natural n)
8879Proof
8880  rw[feq_equiv]
8881QED
8882
8883(* Theorem: SIGMA f (natural n) = SIGMA (SIGMA f) (partition (feq (gcd n)) (natural n)) *)
8884(* Proof:
8885   Let g = gcd n, s = natural n.
8886   Since FINITE s               by natural_finite
8887     and (feq g) equiv_on s     by feq_equiv
8888   The result follows           by set_sigma_by_partition
8889*)
8890Theorem sum_over_natural_by_gcd_partition:
8891    !f n. SIGMA f (natural n) = SIGMA (SIGMA f) (partition (feq (gcd n)) (natural n))
8892Proof
8893  rw[feq_equiv, natural_finite, set_sigma_by_partition]
8894QED
8895
8896(* Theorem: SIGMA f (natural n) = SIGMA (SIGMA f) (IMAGE (gcd_matches n) (divisors n)) *)
8897(* Proof:
8898     SIGMA f (natural n)
8899   = SIGMA (SIGMA f) (partition (feq (gcd n)) (natural n)) by sum_over_natural_by_gcd_partition
8900   = SIGMA (SIGMA f) (IMAGE (gcd_matches n) (divisors n))  by gcd_eq_partition_by_divisors
8901*)
8902Theorem sum_over_natural_by_divisors:
8903  !f n. SIGMA f (natural n) = SIGMA (SIGMA f) (IMAGE (gcd_matches n) (divisors n))
8904Proof
8905  simp[sum_over_natural_by_gcd_partition, gcd_eq_partition_by_divisors]
8906QED
8907
8908(* Theorem: INJ (gcd_matches n) (divisors n) univ(num) *)
8909(* Proof:
8910   By INJ_DEF, this is to show:
8911      x IN divisors n /\ y IN divisors n /\ gcd_matches n x = gcd_matches n y ==> x = y
8912    Note 0 < x /\ x <= n /\ x divides n        by divisors_def
8913    also 0 < y /\ y <= n /\ y divides n        by divisors_def
8914   Hence (gcd x n = x) /\ (gcd y n = y)        by divides_iff_gcd_fix
8915     ==> x IN gcd_matches n x                  by gcd_matches_element
8916      so x IN gcd_matches n y                  by gcd_matches n x = gcd_matches n y
8917    with gcd x n = y                           by gcd_matches_element
8918    Therefore y = gcd x n = x.
8919*)
8920Theorem gcd_matches_from_divisors_inj:
8921  !n. INJ (gcd_matches n) (divisors n) univ(:num -> bool)
8922Proof
8923  rw[INJ_DEF] >>
8924  fs[divisors_def] >>
8925  `(gcd x n = x) /\ (gcd y n = y)` by rw[GSYM divides_iff_gcd_fix] >>
8926  metis_tac[gcd_matches_element]
8927QED
8928
8929(* Theorem: CARD o (gcd_matches n) = CARD o (coprimes_by n) *)
8930(* Proof:
8931   By composition and FUN_EQ_THM, this is to show:
8932      !x. CARD (gcd_matches n x) = CARD (coprimes_by n x)
8933   If x divides n,
8934      Then BIJ (\j. j DIV x) (gcd_matches n x) (coprimes_by n x)  by gcd_matches_bij_coprimes_by
8935      Also FINITE (gcd_matches n x)                               by gcd_matches_finite
8936       and FINITE (coprimes_by n x)                               by coprimes_by_finite
8937      Hence CARD (gcd_matches n x) = CARD (coprimes_by n x)       by FINITE_BIJ_CARD_EQ
8938   If ~(x divides n),
8939      If n = 0,
8940         then gcd_matches 0 x = {}      by gcd_matches_0
8941          and coprimes_by 0 x = {}      by coprimes_by_0
8942         Hence true.
8943      If n <> 0,
8944         then gcd_matches n x = {}      by gcd_matches_eq_empty, 0 < n
8945          and coprimes_by n x = {}      by coprimes_by_eq_empty, 0 < n
8946         Hence CARD {} = CARD {}.
8947*)
8948Theorem gcd_matches_and_coprimes_by_same_size:
8949    !n. CARD o (gcd_matches n) = CARD o (coprimes_by n)
8950Proof
8951  rw[FUN_EQ_THM] >>
8952  Cases_on `x divides n` >| [
8953    `BIJ (\j. j DIV x) (gcd_matches n x) (coprimes_by n x)` by rw[gcd_matches_bij_coprimes_by] >>
8954    `FINITE (gcd_matches n x)` by rw[gcd_matches_finite] >>
8955    `FINITE (coprimes_by n x)` by rw[coprimes_by_finite] >>
8956    metis_tac[FINITE_BIJ_CARD_EQ],
8957    Cases_on `n = 0` >-
8958    rw[gcd_matches_0, coprimes_by_0] >>
8959    `gcd_matches n x = {}` by rw[gcd_matches_eq_empty] >>
8960    `coprimes_by n x = {}` by rw[coprimes_by_eq_empty] >>
8961    rw[]
8962  ]
8963QED
8964
8965(* Theorem: 0 < n ==> (CARD o (coprimes_by n) = \d. phi (if d IN (divisors n) then n DIV d else 0)) *)
8966(* Proof:
8967   By FUN_EQ_THM,
8968      CARD o (coprimes_by n) x
8969    = CARD (coprimes_by n x)       by composition, combinTheory.o_THM
8970    = CARD (if x divides n then coprimes (n DIV x) else {})    by coprimes_by_def, 0 < n
8971    If x divides n,
8972       then x <= n                 by DIVIDES_LE
8973        and 0 < x                  by divisor_pos, 0 < n
8974         so x IN (divisors n)      by divisors_element
8975       CARD o (coprimes_by n) x
8976     = CARD (coprimes (n DIV x))
8977     = phi (n DIV x)               by phi_def
8978    If ~(x divides n),
8979       x NOTIN (divisors n)        by divisors_element
8980       CARD o (coprimes_by n) x
8981     = CARD {}
8982     = 0                           by CARD_EMPTY
8983     = phi 0                       by phi_0
8984    Hence the same function as:
8985    \d. phi (if d IN (divisors n) then n DIV d else 0)
8986*)
8987Theorem coprimes_by_with_card:
8988  !n. 0 < n ==> (CARD o (coprimes_by n) = \d. phi (if d IN (divisors n) then n DIV d else 0))
8989Proof
8990  rw[coprimes_by_def, phi_def, divisors_def, FUN_EQ_THM] >>
8991  metis_tac[DIVIDES_LE, divisor_pos, coprimes_0]
8992QED
8993
8994(* Theorem: x IN (divisors n) ==> (CARD o (coprimes_by n)) x = (\d. phi (n DIV d)) x *)
8995(* Proof:
8996   Since x IN (divisors n) ==> x divides n     by divisors_element
8997       CARD o (coprimes_by n) x
8998     = CARD (coprimes (n DIV x))               by coprimes_by_def
8999     = phi (n DIV x)                           by phi_def
9000*)
9001Theorem coprimes_by_divisors_card:
9002  !n x. x IN (divisors n) ==> (CARD o (coprimes_by n)) x = (\d. phi (n DIV d)) x
9003Proof
9004  rw[coprimes_by_def, phi_def, divisors_def]
9005QED
9006
9007(*
9008SUM_IMAGE_CONG |- (s1 = s2) /\ (!x. x IN s2 ==> (f1 x = f2 x)) ==> (SIGMA f1 s1 = SIGMA f2 s2)
9009*)
9010
9011(* Theorem: SIGMA phi (divisors n) = n *)
9012(* Proof:
9013   Note INJ (gcd_matches n) (divisors n) univ(:num -> bool)  by gcd_matches_from_divisors_inj
9014    and (\d. n DIV d) PERMUTES (divisors n)              by divisors_divisors_bij
9015   n = CARD (natural n)                                  by natural_card
9016     = SIGMA CARD (partition (feq (gcd n)) (natural n))  by partition_CARD
9017     = SIGMA CARD (IMAGE (gcd_matches n) (divisors n))   by gcd_eq_partition_by_divisors
9018     = SIGMA (CARD o (gcd_matches n)) (divisors n)       by sum_image_by_composition
9019     = SIGMA (CARD o (coprimes_by n)) (divisors n)       by gcd_matches_and_coprimes_by_same_size
9020     = SIGMA (\d. phi (n DIV d)) (divisors n)            by SUM_IMAGE_CONG, coprimes_by_divisors_card
9021     = SIGMA phi (divisors n)                            by sum_image_by_permutation
9022*)
9023Theorem Gauss_little_thm:
9024  !n. SIGMA phi (divisors n) = n
9025Proof
9026  rpt strip_tac >>
9027  `FINITE (natural n)` by rw[natural_finite] >>
9028  `(feq (gcd n)) equiv_on (natural n)` by rw[gcd_eq_equiv_on_natural] >>
9029  `INJ (gcd_matches n) (divisors n) univ(:num -> bool)` by rw[gcd_matches_from_divisors_inj] >>
9030  `(\d. n DIV d) PERMUTES (divisors n)` by rw[divisors_divisors_bij] >>
9031  `FINITE (divisors n)` by rw[divisors_finite] >>
9032  `n = CARD (natural n)` by rw[natural_card] >>
9033  `_ = SIGMA CARD (partition (feq (gcd n)) (natural n))` by rw[partition_CARD] >>
9034  `_ = SIGMA CARD (IMAGE (gcd_matches n) (divisors n))` by rw[gcd_eq_partition_by_divisors] >>
9035  `_ = SIGMA (CARD o (gcd_matches n)) (divisors n)` by prove_tac[sum_image_by_composition] >>
9036  `_ = SIGMA (CARD o (coprimes_by n)) (divisors n)` by rw[gcd_matches_and_coprimes_by_same_size] >>
9037  `_ = SIGMA (\d. phi (n DIV d)) (divisors n)` by rw[SUM_IMAGE_CONG, coprimes_by_divisors_card] >>
9038  `_ = SIGMA phi (divisors n)` by metis_tac[sum_image_by_permutation] >>
9039  decide_tac
9040QED
9041
9042(* This is a milestone theorem. *)
9043
9044(* ------------------------------------------------------------------------- *)
9045(* Euler phi function is multiplicative for coprimes.                        *)
9046(* ------------------------------------------------------------------------- *)
9047
9048(*
9049EVAL ``coprimes 2``; = {1}
9050EVAL ``coprimes 3``; = {2; 1}
9051EVAL ``coprimes 6``; = {5; 1}
9052
9053Let phi(n) = the set of remainders coprime to n and not exceeding n.
9054Then phi(2) = {1}, phi(3) = {1,2}
9055We shall show phi(6) = {z = (3 * x + 2 * y) mod 6 | x IN phi(2), y IN phi(3)}.
9056(1,1) corresponds to z = (3 * 1 + 2 * 1) mod 6 = 5, right!
9057(1,2) corresponds to z = (3 * 1 + 2 * 2) mod 6 = 1, right!
9058*)
9059
9060(* Idea: give an expression for coprimes (m * n). *)
9061
9062(* Theorem: coprime m n ==>
9063            coprimes (m * n) =
9064            IMAGE (\(x,y). if (m * n = 1) then 1 else (x * n + y * m) MOD (m * n))
9065                  ((coprimes m) CROSS (coprimes n)) *)
9066(* Proof:
9067   Let f = \(x,y). if (m * n = 1) then 1 else (x * n + y * m) MOD (m * n).
9068   If m = 0 or n = 0,
9069      When m = 0, to show:
9070           coprimes 0 = IMAGE f ((coprimes 0) CROSS (coprimes n))
9071           RHS
9072         = IMAGE f ({} CROSS (coprimes n))     by coprimes_0
9073         = IMAGE f {}                          by CROSS_EMPTY
9074         = {}                                  by IMAGE_EMPTY
9075         = LHS                                 by coprimes_0
9076      When n = 0, to show:
9077           coprimes 0 = IMAGE f ((coprimes m) CROSS (coprimes 0))
9078           RHS
9079         = IMAGE f ((coprimes n) CROSS {})     by coprimes_0
9080         = IMAGE f {}                          by CROSS_EMPTY
9081         = {}                                  by IMAGE_EMPTY
9082         = LHS                                 by coprimes_0
9083
9084   If m = 1, or n = 1,
9085      When m = 1, to show:
9086           coprimes n = IMAGE f ((coprimes 1) CROSS (coprimes n))
9087           RHS
9088         = IMAGE f ({1} CROSS (coprimes n))    by coprimes_1
9089         = IMAGE f {(1,y) | y IN coprimes n}   by IN_CROSS
9090         = {if n = 1 then 1 else (n + y) MOD n | y IN coprimes n}
9091                                               by IN_IMAGE
9092         = {1} if n = 1, or {y MOD n | y IN coprimes n} if 1 < n
9093         = {1} if n = 1, or {y | y IN coprimes n} if 1 < n
9094                                               by coprimes_element_alt, LESS_MOD, y < n
9095         = LHS                                 by coprimes_1
9096      When n = 1, to show:
9097           coprimes m = IMAGE f ((coprimes m) CROSS (coprimes 1))
9098           RHS
9099         = IMAGE f ((coprimes m) CROSS {1})    by coprimes_1
9100         = IMAGE f {(x,1) | x IN coprimes m}   by IN_CROSS
9101         = {if m = 1 then 1 else (x + m) MOD m | x IN coprimes m}
9102                                               by IN_IMAGE
9103         = {1} if m = 1, or {x MOD m | x IN coprimes m} if 1 < m
9104         = {1} if m = 1, or {x | x IN coprimes m} if 1 < m
9105                                               by coprimes_element_alt, LESS_MOD, x < m
9106         = LHS                                 by coprimes_1
9107
9108   Now, 1 < m, 1 < n, and 0 < m, 0 < n.
9109   Therefore 1 < m * n, and 0 < m * n.         by MULT_EQ_1, MULT_EQ_0
9110   and function f = \(x,y). (x * n + y * m) MOD (m * n).
9111   If part: z IN coprimes (m * n) ==>
9112            ?x y. z = (x * n + y * m) MOD (m * n) /\ x IN coprimes m /\ y IN coprimes n
9113      Note z < m * n /\ coprime z (m * n)      by coprimes_element_alt, 1 < m * n
9114       for x < m /\ coprime x m, and y < n /\ coprime y n
9115                                               by coprimes_element_alt, 1 < m, 1 < n
9116       Now ?p q. (p * m + q * n) MOD (m * n)
9117               = z MOD (m * n)                 by coprime_multiple_linear_mod_prod
9118               = z                             by LESS_MOD, z < m * n
9119      Note ?h x. p = h * n + x /\ x < n        by DA, 0 < n
9120       and ?k y. q = k * m + y /\ y < m        by DA, 0 < m
9121           z
9122         = (p * m + q * n) MOD (m * n)         by above
9123         = (h * n * m + x * m + k * m * n + y * n) MOD (m * n)
9124         = ((x * m + y * n) + (h + k) * (m * n)) MOD (m * n)
9125         = (x * m + y * n) MOD (m * n)         by MOD_PLUS2, MOD_EQ_0
9126      Take these x and y, but need to show:
9127      (1) coprime x n
9128          Let g = gcd x n,
9129          Then g divides x /\ g divides n      by GCD_PROPERTY
9130            so g divides (m * n)               by DIVIDES_MULTIPLE
9131            so g divides z                     by divides_linear, mod_divides_divides
9132           ==> g = 1, or coprime x n           by coprime_common_factor
9133      (2) coprime y m
9134          Let g = gcd y m,
9135          Then g divides y /\ g divides m      by GCD_PROPERTY
9136            so g divides (m * n)               by DIVIDES_MULTIPLE
9137            so g divides z                     by divides_linear, mod_divides_divides
9138           ==> g = 1, or coprime y m           by coprime_common_factor
9139
9140   Only-if part: coprime m n /\ x IN coprimes m /\ y IN coprimes n ==>
9141                 (x * n + y * m) MOD (m * n) IN coprimes (m * n)
9142       Note x < m /\ coprime x m               by coprimes_element_alt, 1 < m
9143        and y < n /\ coprime y n               by coprimes_element_alt, 1 < n
9144       Let z = x * m + y * n.
9145       Then coprime z (m * n)                  by coprime_linear_mult
9146         so coprime (z MOD (m * n)) (m * n)    by GCD_MOD_COMM
9147        and z MOD (m * n) < m * n              by MOD_LESS, 0 < m * n
9148*)
9149Theorem coprimes_mult_by_image:
9150  !m n. coprime m n ==>
9151        coprimes (m * n) =
9152        IMAGE (\(x,y). if (m * n = 1) then 1 else (x * n + y * m) MOD (m * n))
9153              ((coprimes m) CROSS (coprimes n))
9154Proof
9155  rpt strip_tac >>
9156  Cases_on `m = 0 \/ n = 0` >-
9157  fs[coprimes_0] >>
9158  Cases_on `m = 1 \/ n = 1` >| [
9159    fs[coprimes_1] >| [
9160      rw[EXTENSION, pairTheory.EXISTS_PROD] >>
9161      Cases_on `n = 1` >-
9162      simp[coprimes_1] >>
9163      fs[coprimes_element_alt] >>
9164      metis_tac[LESS_MOD],
9165      rw[EXTENSION, pairTheory.EXISTS_PROD] >>
9166      Cases_on `m = 1` >-
9167      simp[coprimes_1] >>
9168      fs[coprimes_element_alt] >>
9169      metis_tac[LESS_MOD]
9170    ],
9171    `m * n <> 0 /\ m * n <> 1` by rw[] >>
9172    `1 < m /\ 1 < n /\ 1 < m * n` by decide_tac >>
9173    rw[EXTENSION, pairTheory.EXISTS_PROD] >>
9174    rw[EQ_IMP_THM] >| [
9175      rfs[coprimes_element_alt] >>
9176      `1 < m /\ 1 < n /\ 0 < m /\ 0 < n /\ 0 < m * n` by decide_tac >>
9177      `?p q. (p * m + q * n) MOD (m * n) = x MOD (m * n)` by rw[coprime_multiple_linear_mod_prod] >>
9178      `?h u. p = h * n + u /\ u < n` by metis_tac[DA] >>
9179      `?k v. q = k * m + v /\ v < m` by metis_tac[DA] >>
9180      `p * m + q * n = h * n * m + u * m + k * m * n + v * n` by simp[] >>
9181      `_ = (u * m + v * n) + (h + k) * (m * n)` by simp[] >>
9182      `(u * m + v * n) MOD (m * n) = x MOD (m * n)` by metis_tac[MOD_PLUS2, MOD_EQ_0, ADD_0] >>
9183      `_ = x` by rw[] >>
9184      `coprime u n` by
9185  (qabbrev_tac `g = gcd u n` >>
9186      `0 < g` by rw[GCD_POS, Abbr`g`] >>
9187      `g divides u /\ g divides n` by metis_tac[GCD_PROPERTY] >>
9188      `g divides (m * n)` by rw[DIVIDES_MULTIPLE] >>
9189      `g divides x` by metis_tac[divides_linear, MULT_COMM, mod_divides_divides] >>
9190      metis_tac[coprime_common_factor]) >>
9191      `coprime v m` by
9192    (qabbrev_tac `g = gcd v m` >>
9193      `0 < g` by rw[GCD_POS, Abbr`g`] >>
9194      `g divides v /\ g divides m` by metis_tac[GCD_PROPERTY] >>
9195      `g divides (m * n)` by metis_tac[DIVIDES_MULTIPLE, MULT_COMM] >>
9196      `g divides x` by metis_tac[divides_linear, MULT_COMM, mod_divides_divides] >>
9197      metis_tac[coprime_common_factor]) >>
9198      metis_tac[MULT_COMM],
9199      rfs[coprimes_element_alt] >>
9200      `0 < m * n` by decide_tac >>
9201      `coprime (m * p_2 + n * p_1) (m * n)` by metis_tac[coprime_linear_mult, MULT_COMM] >>
9202      metis_tac[GCD_MOD_COMM]
9203    ]
9204  ]
9205QED
9206
9207(* Yes! a milestone theorem. *)
9208
9209(* Idea: in coprimes (m * n), the image map is injective. *)
9210
9211(* Theorem: coprime m n ==>
9212            INJ (\(x,y). if (m * n = 1) then 1 else (x * n + y * m) MOD (m * n))
9213                ((coprimes m) CROSS (coprimes n)) univ(:num) *)
9214(* Proof:
9215   Let f = \(x,y). if m * n = 1 then 1 else (x * n + y * m) MOD (m * n).
9216   To show: coprime m n ==> INJ f ((coprimes m) CROSS (coprimes n)) univ(:num)
9217   If m = 0, or n = 0,
9218      When m = 0,
9219           INJ f ((coprimes 0) CROSS (coprimes n)) univ(:num)
9220       <=> INJ f ({} CROSS (coprimes n)) univ(:num)      by coprimes_0
9221       <=> INJ f {} univ(:num)                           by CROSS_EMPTY
9222       <=> T                                             by INJ_EMPTY
9223      When n = 0,
9224           INJ f ((coprimes m) CROSS (coprimes 0)) univ(:num)
9225       <=> INJ f ((coprimes m) CROSS {}) univ(:num)      by coprimes_0
9226       <=> INJ f {} univ(:num)                           by CROSS_EMPTY
9227       <=> T                                             by INJ_EMPTY
9228
9229   If m = 1, or n = 1,
9230      When m = 1,
9231           INJ f ((coprimes 1) CROSS (coprimes n)) univ(:num)
9232       <=> INJ f ({1} CROSS (coprimes n)) univ(:num)     by coprimes_1
9233       If n = 1, this is
9234           INJ f ({1} CROSS {1}) univ(:num)              by coprimes_1
9235       <=> INJ f {(1,1)} univ(:num)                      by CROSS_SINGS
9236       <=> T                                             by INJ_DEF
9237       If n <> 1, this is by INJ_DEF:
9238       to show: !p q. p IN coprimes n /\ q IN coprimes n ==> p MOD n = q MOD n ==> p = q
9239       Now p < n /\ q < n                                by coprimes_element_alt, 1 < n
9240       With p MOD n = q MOD n, so p = q                  by LESS_MOD
9241      When n = 1,
9242           INJ f ((coprimes m) CROSS (coprimes 1)) univ(:num)
9243       <=> INJ f ((coprimes m) CROSS {1}) univ(:num)     by coprimes_1
9244       If m = 1, this is
9245           INJ f ({1} CROSS {1}) univ(:num)              by coprimes_1
9246       <=> INJ f {(1,1)} univ(:num)                      by CROSS_SINGS
9247       <=> T                                             by INJ_DEF
9248       If m <> 1, this is by INJ_DEF:
9249       to show: !p q. p IN coprimes m /\ q IN coprimes m ==> p MOD m = q MOD m ==> p = q
9250       Now p < m /\ q < m                                by coprimes_element_alt, 1 < m
9251       With p MOD m = q MOD m, so p = q                  by LESS_MOD
9252
9253   Now 1 < m and 1 < n, so 1 < m * n           by MULT_EQ_1, MULT_EQ_0
9254   By INJ_DEF, coprimes_element_alt, this is to show:
9255      !x y u v. x < m /\ coprime x m /\ y < n /\ coprime y n /\
9256                u < m /\ coprime u m /\ v < n /\ coprime v n /\
9257                (x * n + y * m) MOD (m * n) = (u * n + v * m) MOD (m * n)
9258            ==> x = u /\ y = v
9259   Note x * n < n * m                          by LT_MULT_RCANCEL, 0 < n, x < m
9260    and v * m < n * m                          by LT_MULT_RCANCEL, 0 < m, v < n
9261   Thus (y * m + (n * m - v * m)) MOD (n * m)
9262      = (u * n + (n * m - x * n)) MOD (n * m)      by mod_add_eq_sub
9263    Now y * m + (n * m - v * m) = m * (n + y - v)  by arithmetic
9264    and u * n + (n * m - x * n) = n * (m + u - x)  by arithmetic
9265    and 0 < n + y - v /\ n + y - v < 2 * n         by y < n, v < n
9266    and 0 < m + u - x /\ m + u - x < 2 * m         by x < m, u < m
9267    ==> n + y - v = n /\ m + u - x = m             by mod_mult_eq_mult
9268    ==> n + y = n + v /\ m + u = m + x             by arithmetic
9269    ==> y = v /\ x = u                             by EQ_ADD_LCANCEL
9270*)
9271Theorem coprimes_map_cross_inj:
9272  !m n. coprime m n ==>
9273        INJ (\(x,y). if (m * n = 1) then 1 else (x * n + y * m) MOD (m * n))
9274            ((coprimes m) CROSS (coprimes n)) univ(:num)
9275Proof
9276  rpt strip_tac >>
9277  qabbrev_tac `f = \(x,y). if m * n = 1 then 1 else (x * n + y * m) MOD (m * n)` >>
9278  Cases_on `m = 0 \/ n = 0` >-
9279  fs[coprimes_0] >>
9280  Cases_on `m = 1 \/ n = 1` >| [
9281    fs[coprimes_1, INJ_DEF, pairTheory.FORALL_PROD, Abbr`f`] >| [
9282      (Cases_on `n = 1` >> simp[coprimes_1]) >>
9283      fs[coprimes_element_alt],
9284      (Cases_on `m = 1` >> simp[coprimes_1]) >>
9285      fs[coprimes_element_alt]
9286    ],
9287    `m * n <> 0 /\ m * n <> 1` by rw[] >>
9288    `1 < m /\ 1 < n /\ 1 < m * n` by decide_tac >>
9289    simp[INJ_DEF, pairTheory.FORALL_PROD] >>
9290    ntac 6 strip_tac >>
9291    rfs[coprimes_element_alt, Abbr`f`] >>
9292    `0 < m /\ 0 < n /\ 0 < m * n` by decide_tac >>
9293    `n * p_1 < n * m /\ m * p_2' < n * m` by simp[] >>
9294    `(m * p_2 + (n * m - m * p_2')) MOD (n * m) =
9295    (n * p_1' + (n * m - n * p_1)) MOD (n * m)` by simp[GSYM mod_add_eq_sub] >>
9296    `m * p_2 + (n * m - m * p_2') = m * (n + p_2 - p_2')` by decide_tac >>
9297    `n * p_1' + (n * m - n * p_1) = n * (m + p_1' - p_1)` by decide_tac >>
9298    `0 < n + p_2 - p_2' /\ n + p_2 - p_2' < 2 * n` by decide_tac >>
9299    `0 < m + p_1' - p_1 /\ m + p_1' - p_1 < 2 * m` by decide_tac >>
9300    `n + p_2 - p_2' = n /\ m + p_1' - p_1 = m` by metis_tac[mod_mult_eq_mult, MULT_COMM] >>
9301    simp[]
9302  ]
9303QED
9304
9305(* Another milestone theorem! *)
9306
9307(* Idea: Euler phi function is multiplicative for coprimes. *)
9308
9309(* Theorem: coprime m n ==> phi (m * n) = phi m * phi n *)
9310(* Proof:
9311   Let f = \(x,y). if m * n = 1 then 1 else (x * n + y * m) MOD (m * n),
9312       u = coprimes m,
9313       v = coprimes n.
9314   Then coprimes (m * n) = IMAGE f (u CROSS v) by coprimes_mult_by_image
9315    and INJ f (u CROSS v) univ(:num)           by coprimes_map_cross_inj
9316   Note FINITE u /\ FINITE v                   by coprimes_finite
9317     so FINITE (u CROSS v)                     by FINITE_CROSS
9318        phi (m * n)
9319      = CARD (coprimes (m * n))                by phi_def
9320      = CARD (IMAGE f (u CROSS v))             by above
9321      = CARD (u CROSS v)                       by INJ_CARD_IMAGE
9322      = (CARD u) * (CARD v)                    by CARD_CROSS
9323      = phi m * phi n                          by phi_def
9324*)
9325Theorem phi_mult:
9326  !m n. coprime m n ==> phi (m * n) = phi m * phi n
9327Proof
9328  rw[phi_def] >>
9329  imp_res_tac coprimes_mult_by_image >>
9330  imp_res_tac coprimes_map_cross_inj >>
9331  qabbrev_tac `f = \(x,y). if m * n = 1 then 1 else (x * n + y * m) MOD (m * n)` >>
9332  qabbrev_tac `u = coprimes m` >>
9333  qabbrev_tac `v = coprimes n` >>
9334  `FINITE u /\ FINITE v` by rw[coprimes_finite, Abbr`u`, Abbr`v`] >>
9335  `FINITE (u CROSS v)` by rw[] >>
9336  metis_tac[INJ_CARD_IMAGE, CARD_CROSS]
9337QED
9338
9339(* This is the ultimate goal! *)
9340
9341(* Idea: an expression for phi (p * q) with distinct primes p and q. *)
9342
9343(* Theorem: prime p /\ prime q /\ p <> q ==> phi (p * q) = (p - 1) * (q - 1) *)
9344(* Proof:
9345   Note coprime p q        by primes_coprime
9346        phi (p * q)
9347      = phi p * phi q      by phi_mult
9348      = (p - 1) * (q - 1)  by phi_prime
9349*)
9350Theorem phi_primes_distinct:
9351  !p q. prime p /\ prime q /\ p <> q ==> phi (p * q) = (p - 1) * (q - 1)
9352Proof
9353  simp[primes_coprime, phi_mult, phi_prime]
9354QED
9355
9356(* ------------------------------------------------------------------------- *)
9357(* Euler phi function for prime powers.                                      *)
9358(* ------------------------------------------------------------------------- *)
9359
9360(*
9361EVAL ``coprimes 9``; = {8; 7; 5; 4; 2; 1}
9362EVAL ``divisors 9``; = {9; 3; 1}
9363EVAL ``IMAGE (\x. 3 * x) (natural 3)``; = {9; 6; 3}
9364EVAL ``IMAGE (\x. 3 * x) (natural 9)``; = {27; 24; 21; 18; 15; 12; 9; 6; 3}
9365
9366> EVAL ``IMAGE ($* 3) (natural (8 DIV 3))``; = {6; 3}
9367> EVAL ``IMAGE ($* 3) (natural (9 DIV 3))``; = {9; 6; 3}
9368> EVAL ``IMAGE ($* 3) (natural (10 DIV 3))``; = {9; 6; 3}
9369> EVAL ``IMAGE ($* 3) (natural (12 DIV 3))``; = {12; 9; 6; 3}
9370*)
9371
9372(* Idea: develop a special set in anticipation for counting. *)
9373
9374(* Define the set of positive multiples of m, up to n *)
9375Definition multiples_upto_def[nocompute]:
9376    multiples_upto m n = {x | m divides x /\ 0 < x /\ x <= n}
9377End
9378(* use zDefine as this is not effective for evalutaion. *)
9379(* make this an infix operator *)
9380val _ = set_fixity "multiples_upto" (Infix(NONASSOC, 550)); (* higher than arithmetic op 500. *)
9381
9382(*
9383> multiples_upto_def;
9384val it = |- !m n. m multiples_upto n = {x | m divides x /\ 0 < x /\ x <= n}: thm
9385*)
9386
9387(* Theorem: x IN m multiples_upto n <=> m divides x /\ 0 < x /\ x <= n *)
9388(* Proof: by multiples_upto_def. *)
9389Theorem multiples_upto_element:
9390  !m n x. x IN m multiples_upto n <=> m divides x /\ 0 < x /\ x <= n
9391Proof
9392  simp[multiples_upto_def]
9393QED
9394
9395(* Theorem: m multiples_upto n = {x | ?k. x = k * m /\ 0 < x /\ x <= n} *)
9396(* Proof:
9397     m multiples_upto n
9398   = {x | m divides x /\ 0 < x /\ x <= n}      by multiples_upto_def
9399   = {x | ?k. x = k * m /\ 0 < x /\ x <= n}    by divides_def
9400*)
9401Theorem multiples_upto_alt:
9402  !m n. m multiples_upto n = {x | ?k. x = k * m /\ 0 < x /\ x <= n}
9403Proof
9404  rw[multiples_upto_def, EXTENSION] >>
9405  metis_tac[divides_def]
9406QED
9407
9408(* Theorem: x IN m multiples_upto n <=> ?k. x = k * m /\ 0 < x /\ x <= n *)
9409(* Proof: by multiples_upto_alt. *)
9410Theorem multiples_upto_element_alt:
9411  !m n x. x IN m multiples_upto n <=> ?k. x = k * m /\ 0 < x /\ x <= n
9412Proof
9413  simp[multiples_upto_alt]
9414QED
9415
9416(* Theorem: m multiples_upto n = {x | m divides x /\ x IN natural n} *)
9417(* Proof:
9418     m multiples_upto n
9419   = {x | m divides x /\ 0 < x /\ x <= n}      by multiples_upto_def
9420   = {x | m divides x /\ x IN natural n}       by natural_element
9421*)
9422Theorem multiples_upto_eqn:
9423  !m n. m multiples_upto n = {x | m divides x /\ x IN natural n}
9424Proof
9425  simp[multiples_upto_def, natural_element, EXTENSION]
9426QED
9427
9428(* Theorem: 0 multiples_upto n = {} *)
9429(* Proof:
9430     0 multiples_upto n
9431   = {x | 0 divides x /\ 0 < x /\ x <= n}      by multiples_upto_def
9432   = {x | x = 0 /\ 0 < x /\ x <= n}            by ZERO_DIVIDES
9433   = {}                                        by contradiction
9434*)
9435Theorem multiples_upto_0_n:
9436  !n. 0 multiples_upto n = {}
9437Proof
9438  simp[multiples_upto_def, EXTENSION]
9439QED
9440
9441(* Theorem: 1 multiples_upto n = natural n *)
9442(* Proof:
9443     1 multiples_upto n
9444   = {x | 1 divides x /\ x IN natural n}       by multiples_upto_eqn
9445   = {x | T /\ x IN natural n}                 by ONE_DIVIDES_ALL
9446   = natural n                                 by EXTENSION
9447*)
9448Theorem multiples_upto_1_n:
9449  !n. 1 multiples_upto n = natural n
9450Proof
9451  simp[multiples_upto_eqn, EXTENSION]
9452QED
9453
9454(* Theorem: m multiples_upto 0 = {} *)
9455(* Proof:
9456     m multiples_upto 0
9457   = {x | m divides x /\ 0 < x /\ x <= 0}      by multiples_upto_def
9458   = {x | m divides x /\ F}                    by arithmetic
9459   = {}                                        by contradiction
9460*)
9461Theorem multiples_upto_m_0:
9462  !m. m multiples_upto 0 = {}
9463Proof
9464  simp[multiples_upto_def, EXTENSION]
9465QED
9466
9467(* Theorem: m multiples_upto 1 = if m = 1 then {1} else {} *)
9468(* Proof:
9469     m multiples_upto 1
9470   = {x | m divides x /\ 0 < x /\ x <= 1}      by multiples_upto_def
9471   = {x | m divides x /\ x = 1}                by arithmetic
9472   = {1} if m = 1, {} otherwise                by DIVIDES_ONE
9473*)
9474Theorem multiples_upto_m_1:
9475  !m. m multiples_upto 1 = if m = 1 then {1} else {}
9476Proof
9477  rw[multiples_upto_def, EXTENSION] >>
9478  spose_not_then strip_assume_tac >>
9479  `x = 1` by decide_tac >>
9480  fs[]
9481QED
9482
9483(* Idea: an expression for (m multiples_upto n), for direct evaluation. *)
9484
9485(* Theorem: m multiples_upto n =
9486            if m = 0 then {}
9487            else IMAGE ($* m) (natural (n DIV m)) *)
9488(* Proof:
9489   If m = 0,
9490      Then 0 multiples_upto n = {} by multiples_upto_0_n
9491   If m <> 0.
9492      By multiples_upto_alt, EXTENSION, this is to show:
9493      (1) 0 < k * m /\ k * m <= n ==>
9494          ?y. k * m = m * y /\ ?x. y = SUC x /\ x < n DIV m
9495          Note k <> 0              by MULT_EQ_0
9496           and k <= n DIV m        by X_LE_DIV, 0 < m
9497            so k - 1 < n DIV m     by arithmetic
9498          Let y = k, x = k - 1.
9499          Note SUC x = SUC (k - 1) = k = y.
9500      (2) x < n DIV m ==> ?k. m * SUC x = k * m /\ 0 < m * SUC x /\ m * SUC x <= n
9501          Note SUC x <= n DIV m    by arithmetic
9502            so m * SUC x <= n      by X_LE_DIV, 0 < m
9503           and 0 < m * SUC x       by MULT_EQ_0
9504          Take k = SUC x, true     by MULT_COMM
9505*)
9506Theorem multiples_upto_thm[compute]:
9507  !m n. m multiples_upto n =
9508        if m = 0 then {}
9509        else IMAGE ($* m) (natural (n DIV m))
9510Proof
9511  rpt strip_tac >>
9512  Cases_on `m = 0` >-
9513  fs[multiples_upto_0_n] >>
9514  fs[multiples_upto_alt, EXTENSION] >>
9515  rw[EQ_IMP_THM] >| [
9516    qexists_tac `k` >>
9517    simp[] >>
9518    `0 < k /\ 0 < m` by metis_tac[MULT_EQ_0, NOT_ZERO] >>
9519    `k <= n DIV m` by rw[X_LE_DIV] >>
9520    `k - 1 < n DIV m` by decide_tac >>
9521    qexists_tac `k - 1` >>
9522    simp[],
9523    `SUC x'' <= n DIV m` by decide_tac >>
9524    `m * SUC x'' <= n` by rfs[X_LE_DIV] >>
9525    simp[] >>
9526    metis_tac[MULT_COMM]
9527  ]
9528QED
9529
9530(*
9531EVAL ``3 multiples_upto 9``; = {9; 6; 3}
9532EVAL ``3 multiples_upto 11``; = {9; 6; 3}
9533EVAL ``3 multiples_upto 12``; = {12; 9; 6; 3}
9534EVAL ``3 multiples_upto 13``; = {12; 9; 6; 3}
9535*)
9536
9537(* Theorem: m multiples_upto n SUBSET natural n *)
9538(* Proof: by multiples_upto_eqn, SUBSET_DEF. *)
9539Theorem multiples_upto_subset:
9540  !m n. m multiples_upto n SUBSET natural n
9541Proof
9542  simp[multiples_upto_eqn, SUBSET_DEF]
9543QED
9544
9545(* Theorem: FINITE (m multiples_upto n) *)
9546(* Proof:
9547   Let s = m multiples_upto n
9548   Note s SUBSET natural n     by multiples_upto_subset
9549    and FINITE natural n       by natural_finite
9550     so FINITE s               by SUBSET_FINITE
9551*)
9552Theorem multiples_upto_finite:
9553  !m n. FINITE (m multiples_upto n)
9554Proof
9555  metis_tac[multiples_upto_subset, natural_finite, SUBSET_FINITE]
9556QED
9557
9558(* Theorem: CARD (m multiples_upto n) = if m = 0 then 0 else n DIV m *)
9559(* Proof:
9560   If m = 0,
9561        CARD (0 multiples_upto n)
9562      = CARD {}                    by multiples_upto_0_n
9563      = 0                          by CARD_EMPTY
9564   If m <> 0,
9565      Claim: INJ ($* m) (natural (n DIV m)) univ(:num)
9566      Proof: By INJ_DEF, this is to show:
9567             !x. x IN (natural (n DIV m)) /\
9568                 m * x = m * y ==> x = y, true     by EQ_MULT_LCANCEL, m <> 0
9569      Note FINITE (natural (n DIV m))              by natural_finite
9570        CARD (m multiples_upto n)
9571      = CARD (IMAGE ($* m) (natural (n DIV m)))    by multiples_upto_thm, m <> 0
9572      = CARD (natural (n DIV m))                   by INJ_CARD_IMAGE
9573      = n DIV m                                    by natural_card
9574*)
9575Theorem multiples_upto_card:
9576  !m n. CARD (m multiples_upto n) = if m = 0 then 0 else n DIV m
9577Proof
9578  rpt strip_tac >>
9579  Cases_on `m = 0` >-
9580  simp[multiples_upto_0_n] >>
9581  simp[multiples_upto_thm] >>
9582  `INJ ($* m) (natural (n DIV m)) univ(:num)` by rw[INJ_DEF] >>
9583  metis_tac[INJ_CARD_IMAGE, natural_finite, natural_card]
9584QED
9585
9586(* Idea: an expression for the set of coprimes of a prime power. *)
9587
9588(* Theorem: prime p ==>
9589            coprimes (p ** n) = natural (p ** n) DIFF p multiples_upto (p ** n) *)
9590(* Proof:
9591   If n = 0,
9592      LHS = coprimes (p ** 0)
9593          = coprimes 1             by EXP_0
9594          = {1}                    by coprimes_1
9595      RHS = natural (p ** 0) DIFF p multiples_upto (p ** 0)
9596          = natural 1 DIFF p multiples_upto 1
9597          = natural 1 DIFF {}      by multiples_upto_m_1, NOT_PRIME_1
9598          = {1} DIFF {}            by natural_1
9599          = {1} = LHS              by DIFF_EMPTY
9600   If n <> 0,
9601      By coprimes_def, multiples_upto_def, EXTENSION, this is to show:
9602         coprime (SUC x) (p ** n) <=> ~(p divides SUC x)
9603      This is true                 by coprime_prime_power
9604*)
9605Theorem coprimes_prime_power:
9606  !p n. prime p ==>
9607        coprimes (p ** n) = natural (p ** n) DIFF p multiples_upto (p ** n)
9608Proof
9609  rpt strip_tac >>
9610  Cases_on `n = 0` >| [
9611    `p <> 1` by metis_tac[NOT_PRIME_1] >>
9612    simp[coprimes_1, multiples_upto_m_1, natural_1, EXP_0],
9613    rw[coprimes_def, multiples_upto_def, EXTENSION] >>
9614    (rw[EQ_IMP_THM] >> rfs[coprime_prime_power])
9615  ]
9616QED
9617
9618(* Idea: an expression for phi of a prime power. *)
9619
9620(* Theorem: prime p ==> phi (p ** SUC n) = (p - 1) * p ** n *)
9621(* Proof:
9622   Let m = SUC n,
9623       u = natural (p ** m),
9624       v = p multiples_upto (p ** m).
9625   Note 0 < p                      by PRIME_POS
9626    and FINITE u                   by natural_finite
9627    and v SUBSET u                 by multiples_upto_subset
9628
9629     phi (p ** m)
9630   = CARD (coprimes (p ** m))      by phi_def
9631   = CARD (u DIFF v)               by coprimes_prime_power
9632   = CARD u - CARD v               by SUBSET_DIFF_CARD
9633   = p ** m - CARD v               by natural_card
9634   = p ** m - (p ** m DIV p)       by multiples_upto_card, p <> 0
9635   = p ** m - p ** n               by EXP_SUC_DIV, 0 < p
9636   = p * p ** n - p ** n           by EXP
9637   = (p - 1) * p ** n              by RIGHT_SUB_DISTRIB
9638*)
9639Theorem phi_prime_power:
9640  !p n. prime p ==> phi (p ** SUC n) = (p - 1) * p ** n
9641Proof
9642  rpt strip_tac >>
9643  qabbrev_tac `m = SUC n` >>
9644  qabbrev_tac `u = natural (p ** m)` >>
9645  qabbrev_tac `v = p multiples_upto (p ** m)` >>
9646  `0 < p` by rw[PRIME_POS] >>
9647  `FINITE u` by rw[natural_finite, Abbr`u`] >>
9648  `v SUBSET u` by rw[multiples_upto_subset, Abbr`v`, Abbr`u`] >>
9649  `phi (p ** m) = CARD (coprimes (p ** m))` by rw[phi_def] >>
9650  `_ = CARD (u DIFF v)` by rw[coprimes_prime_power, Abbr`u`, Abbr`v`] >>
9651  `_ = CARD u - CARD v` by rw[SUBSET_DIFF_CARD] >>
9652  `_ = p ** m - (p ** m DIV p)` by rw[natural_card, multiples_upto_card, Abbr`u`, Abbr`v`] >>
9653  `_ = p ** m - p ** n` by rw[EXP_SUC_DIV, Abbr`m`] >>
9654  `_ = p * p ** n - p ** n` by rw[GSYM EXP] >>
9655  `_ = (p - 1) * p ** n` by decide_tac >>
9656  simp[]
9657QED
9658
9659(* Yes, a spectacular theorem! *)
9660
9661(* Idea: specialise phi_prime_power for prime squared. *)
9662
9663(* Theorem: prime p ==> phi (p * p) = p * (p - 1) *)
9664(* Proof:
9665     phi (p * p)
9666   = phi (p ** 2)          by EXP_2
9667   = phi (p ** SUC 1)      by TWO
9668   = (p - 1) * p ** 1      by phi_prime_power
9669   = p * (p - 1)           by EXP_1
9670*)
9671Theorem phi_prime_sq:
9672  !p. prime p ==> phi (p * p) = p * (p - 1)
9673Proof
9674  rpt strip_tac >>
9675  `phi (p * p) = phi (p ** SUC 1)` by rw[] >>
9676  simp[phi_prime_power]
9677QED
9678
9679(* Idea: Euler phi function for a product of primes. *)
9680
9681(* Theorem: prime p /\ prime q ==>
9682            phi (p * q) = if p = q then p * (p - 1) else (p - 1) * (q - 1) *)
9683(* Proof:
9684   If p = q, phi (p * p) = p * (p - 1)         by phi_prime_sq
9685   If p <> q, phi (p * q) = (p - 1) * (q - 1)  by phi_primes_distinct
9686*)
9687Theorem phi_primes:
9688  !p q. prime p /\ prime q ==>
9689        phi (p * q) = if p = q then p * (p - 1) else (p - 1) * (q - 1)
9690Proof
9691  metis_tac[phi_prime_sq, phi_primes_distinct]
9692QED
9693
9694(* Finally, another nice result. *)
9695
9696(* ------------------------------------------------------------------------- *)
9697(* Recursive definition of phi                                               *)
9698(* ------------------------------------------------------------------------- *)
9699
9700(* Define phi by recursion *)
9701Definition rec_phi_def:
9702  rec_phi n = if n = 0 then 0
9703         else if n = 1 then 1
9704         else n - SIGMA rec_phi { m | m < n /\ m divides n}
9705Termination
9706  WF_REL_TAC `$< : num -> num -> bool` >> srw_tac[][]
9707End
9708(* This is the recursive form of Gauss' Little Theorem:  n = SUM phi m, m divides n *)
9709
9710(* Just using Define without any condition will trigger:
9711
9712Initial goal:
9713
9714?R. WF R /\ !n a. n <> 0 /\ n <> 1 /\ a IN {m | m < n /\ m divides n} ==> R a n
9715
9716Unable to prove termination!
9717
9718Try using "TotalDefn.tDefine <name> <quotation> <tac>".
9719
9720The termination goal has been set up using Defn.tgoal <defn>.
9721
9722So one can set up:
9723g `?R. WF R /\ !n a. n <> 0 /\ n <> 1 /\ a IN {m | m < n /\ m divides n} ==> R a n`;
9724e (WF_REL_TAC `$< : num -> num -> bool`);
9725e (srw[][]);
9726
9727which gives the tDefine solution.
9728*)
9729
9730(* Theorem: rec_phi 0 = 0 *)
9731(* Proof: by rec_phi_def *)
9732Theorem rec_phi_0:
9733    rec_phi 0 = 0
9734Proof
9735  rw[rec_phi_def]
9736QED
9737
9738(* Theorem: rec_phi 1 = 1 *)
9739(* Proof: by rec_phi_def *)
9740Theorem rec_phi_1:
9741    rec_phi 1 = 1
9742Proof
9743  rw[Once rec_phi_def]
9744QED
9745
9746(* Theorem: rec_phi n = phi n *)
9747(* Proof:
9748   By complete induction on n.
9749   If n = 0,
9750      rec_phi 0 = 0      by rec_phi_0
9751                = phi 0  by phi_0
9752   If n = 1,
9753      rec_phi 1 = 1      by rec_phi_1
9754                = phi 1  by phi_1
9755   Othewise, 0 < n, 1 < n.
9756      Let s = {m | m < n /\ m divides n}.
9757      Note s SUBSET (count n)       by SUBSET_DEF
9758      thus FINITE s                 by SUBSET_FINITE, FINITE_COUNT
9759     Hence !m. m IN s
9760       ==> (rec_phi m = phi m)      by induction hypothesis
9761      Also n NOTIN s                by EXTENSION
9762       and n INSERT s
9763         = {m | m <= n /\ m divides n}
9764         = {m | 0 < m /\ m <= n /\ m divides n}      by divisor_pos, 0 < n
9765         = divisors n               by divisors_def, EXTENSION, LESS_OR_EQ
9766
9767        rec_phi n
9768      = n - (SIGMA rec_phi s)       by rec_phi_def
9769      = n - (SIGMA phi s)           by SUM_IMAGE_CONG, rec_phi m = phi m
9770      = (SIGMA phi (divisors n)) - (SIGMA phi s)           by Gauss' Little Theorem
9771      = (SIGMA phi (n INSERT s)) - (SIGMA phi s)           by divisors n = n INSERT s
9772      = (phi n + SIGMA phi (s DELETE n)) - (SIGMA phi s)   by SUM_IMAGE_THM
9773      = (phi n + SIGMA phi s) - (SIGMA phi s)              by DELETE_NON_ELEMENT
9774      = phi n                                              by ADD_SUB
9775*)
9776Theorem rec_phi_eq_phi:
9777  !n. rec_phi n = phi n
9778Proof
9779  completeInduct_on `n` >>
9780  Cases_on `n = 0` >-
9781  rw[rec_phi_0, phi_0] >>
9782  Cases_on `n = 1` >-
9783  rw[rec_phi_1, phi_1] >>
9784  `0 < n /\ 1 < n` by decide_tac >>
9785  qabbrev_tac `s = {m | m < n /\ m divides n}` >>
9786  qabbrev_tac `t = SIGMA rec_phi s` >>
9787  `!m. m IN s <=> m < n /\ m divides n` by rw[Abbr`s`] >>
9788  `!m. m IN s ==> (rec_phi m = phi m)` by rw[] >>
9789  `t = SIGMA phi s` by rw[SUM_IMAGE_CONG, Abbr`t`] >>
9790  `s SUBSET (count n)` by rw[SUBSET_DEF] >>
9791  `FINITE s` by metis_tac[SUBSET_FINITE, FINITE_COUNT] >>
9792  `n NOTIN s` by rw[] >>
9793  (`n INSERT s = divisors n` by (rw[divisors_def, EXTENSION] >> metis_tac[divisor_pos, LESS_OR_EQ, DIVIDES_REFL])) >>
9794  `n = SIGMA phi (divisors n)` by rw[Gauss_little_thm] >>
9795  `_ = phi n + SIGMA phi (s DELETE n)` by rw[GSYM SUM_IMAGE_THM] >>
9796  `_ = phi n + t` by metis_tac[DELETE_NON_ELEMENT] >>
9797  `rec_phi n = n - t` by metis_tac[rec_phi_def] >>
9798  decide_tac
9799QED
9800
9801
9802(* ------------------------------------------------------------------------- *)
9803(* Useful Theorems (not used).                                               *)
9804(* ------------------------------------------------------------------------- *)
9805
9806(* Theorem: INJ (coprimes) (univ(:num) DIFF {1}) univ(:num -> bool) *)
9807(* Proof:
9808   By INJ_DEF, this is to show:
9809      x <> 1 /\ y <> 1 /\ coprimes x = coprimes y ==> x = y
9810   If x = 0, then y = 0              by coprimes_eq_empty
9811   If y = 0, then x = 0              by coprimes_eq_empty
9812   If x <> 0 and y <> 0,
9813      with x <> 1 and y <> 1         by given
9814      then 1 < x and 1 < y.
9815      Since MAX_SET (coprimes x) = x - 1    by coprimes_max, 1 < x
9816        and MAX_SET (coprimes y) = y - 1    by coprimes_max, 1 < y
9817         If coprimes x = coprimes y,
9818                 x - 1 = y - 1       by above
9819      Hence          x = y           by CANCEL_SUB
9820*)
9821Theorem coprimes_from_not_1_inj:
9822    INJ (coprimes) (univ(:num) DIFF {1}) univ(:num -> bool)
9823Proof
9824  rw[INJ_DEF] >>
9825  Cases_on `x = 0` >-
9826  metis_tac[coprimes_eq_empty] >>
9827  Cases_on `y = 0` >-
9828  metis_tac[coprimes_eq_empty] >>
9829  `1 < x /\ 1 < y` by decide_tac >>
9830  `x - 1 = y - 1` by metis_tac[coprimes_max] >>
9831  decide_tac
9832QED
9833(* Not very useful. *)
9834
9835(* Here is group of related theorems for (divisors n):
9836   divisors_eq_image_gcd_upto
9837   divisors_eq_image_gcd_count
9838   divisors_eq_image_gcd_natural
9839
9840   This first one is proved independently, then the second and third are derived.
9841   Of course, the best is the third one, which is now divisors_eq_gcd_image (above)
9842   Here, I rework all proofs of these three from divisors_eq_gcd_image,
9843   so divisors_eq_image_gcd_natural = divisors_eq_gcd_image.
9844*)
9845
9846(* Theorem: 0 < n ==> divisors n = IMAGE (gcd n) (upto n) *)
9847(* Proof:
9848   Note gcd n 0 = n                                by GCD_0
9849    and n IN divisors n                            by divisors_has_last, 0 < n
9850     divisors n
9851   = (gcd n 0) INSERT (divisors n)                 by ABSORPTION
9852   = (gcd n 0) INSERT (IMAGE (gcd n) (natural n))  by divisors_eq_gcd_image
9853   = IMAGE (gcd n) (0 INSERT (natural n))          by IMAGE_INSERT
9854   = IMAGE (gcd n) (upto n)                        by upto_by_natural
9855*)
9856Theorem divisors_eq_image_gcd_upto:
9857  !n. 0 < n ==> divisors n = IMAGE (gcd n) (upto n)
9858Proof
9859  rpt strip_tac >>
9860  `IMAGE (gcd n) (upto n) = IMAGE (gcd n) (0 INSERT natural n)` by simp[upto_by_natural] >>
9861  `_ = (gcd n 0) INSERT (IMAGE (gcd n) (natural n))` by fs[] >>
9862  `_ = n INSERT (divisors n)` by fs[divisors_eq_gcd_image] >>
9863  metis_tac[divisors_has_last, ABSORPTION]
9864QED
9865
9866(* Theorem: (feq (gcd n)) equiv_on (upto n) *)
9867(* Proof:
9868   By feq_equiv |- !s f. feq f equiv_on s
9869   Taking s = upto n, f = gcd n.
9870*)
9871Theorem gcd_eq_equiv_on_upto:
9872    !n. (feq (gcd n)) equiv_on (upto n)
9873Proof
9874  rw[feq_equiv]
9875QED
9876
9877(* Theorem: 0 < n ==> partition (feq (gcd n)) (upto n) = IMAGE (preimage (gcd n) (upto n)) (divisors n) *)
9878(* Proof:
9879   Let f = gcd n, s = upto n.
9880     partition (feq f) s
9881   = IMAGE (preimage f s o f) s                      by feq_partition
9882   = IMAGE (preimage f s) (IMAGE f s)                by IMAGE_COMPOSE
9883   = IMAGE (preimage f s) (IMAGE (gcd n) (upto n))   by expansion
9884   = IMAGE (preimage f s) (divisors n)               by divisors_eq_image_gcd_upto, 0 < n
9885*)
9886Theorem gcd_eq_upto_partition_by_divisors:
9887    !n. 0 < n ==> partition (feq (gcd n)) (upto n) = IMAGE (preimage (gcd n) (upto n)) (divisors n)
9888Proof
9889  rpt strip_tac >>
9890  qabbrev_tac `f = gcd n` >>
9891  qabbrev_tac `s = upto n` >>
9892  `partition (feq f) s = IMAGE (preimage f s o f) s` by rw[feq_partition] >>
9893  `_ = IMAGE (preimage f s) (IMAGE f s)` by rw[IMAGE_COMPOSE] >>
9894  rw[divisors_eq_image_gcd_upto, Abbr`f`, Abbr`s`]
9895QED
9896
9897(* Theorem: SIGMA f (upto n) = SIGMA (SIGMA f) (partition (feq (gcd n)) (upto n)) *)
9898(* Proof:
9899   Let g = gcd n, s = upto n.
9900   Since FINITE s               by upto_finite
9901     and (feq g) equiv_on s     by feq_equiv
9902   The result follows           by set_sigma_by_partition
9903*)
9904Theorem sum_over_upto_by_gcd_partition:
9905    !f n. SIGMA f (upto n) = SIGMA (SIGMA f) (partition (feq (gcd n)) (upto n))
9906Proof
9907  rw[feq_equiv, set_sigma_by_partition]
9908QED
9909
9910(* Theorem: 0 < n ==> SIGMA f (upto n) = SIGMA (SIGMA f) (IMAGE (preimage (gcd n) (upto n)) (divisors n)) *)
9911(* Proof:
9912     SIGMA f (upto n)
9913   = SIGMA (SIGMA f) (partition (feq (gcd n)) (upto n))                by sum_over_upto_by_gcd_partition
9914   = SIGMA (SIGMA f) (IMAGE (preimage (gcd n) (upto n)) (divisors n))  by gcd_eq_upto_partition_by_divisors, 0 < n
9915*)
9916Theorem sum_over_upto_by_divisors:
9917    !f n. 0 < n ==> SIGMA f (upto n) = SIGMA (SIGMA f) (IMAGE (preimage (gcd n) (upto n)) (divisors n))
9918Proof
9919  rw[sum_over_upto_by_gcd_partition, gcd_eq_upto_partition_by_divisors]
9920QED
9921
9922(* Similar results based on count *)
9923
9924(* Theorem: divisors n = IMAGE (gcd n) (count n) *)
9925(* Proof:
9926   If n = 0,
9927      LHS = divisors 0 = {}                      by divisors_0
9928      RHS = IMAGE (gcd 0) (count 0)
9929          = IMAGE (gcd 0) {}                     by COUNT_0
9930          = {} = LHS                             by IMAGE_EMPTY
9931  If n <> 0, 0 < n.
9932     divisors n
9933   = IMAGE (gcd n) (upto n)                      by divisors_eq_image_gcd_upto, 0 < n
9934   = IMAGE (gcd n) (n INSERT (count n))          by upto_by_count
9935   = (gcd n n) INSERT (IMAGE (gcd n) (count n))  by IMAGE_INSERT
9936   = n INSERT (IMAGE (gcd n) (count n))          by GCD_REF
9937   = (gcd n 0) INSERT (IMAGE (gcd n) (count n))  by GCD_0R
9938   = IMAGE (gcd n) (0 INSERT (count n))          by IMAGE_INSERT
9939   = IMAGE (gcd n) (count n)                     by IN_COUNT, ABSORPTION, 0 < n.
9940*)
9941Theorem divisors_eq_image_gcd_count:
9942  !n. divisors n = IMAGE (gcd n) (count n)
9943Proof
9944  rpt strip_tac >>
9945  Cases_on `n = 0` >-
9946  simp[divisors_0] >>
9947  `0 < n` by decide_tac >>
9948  `divisors n = IMAGE (gcd n) (upto n)` by rw[divisors_eq_image_gcd_upto] >>
9949  `_ = IMAGE (gcd n) (n INSERT (count n))` by rw[upto_by_count] >>
9950  `_ = n INSERT (IMAGE (gcd n) (count n))` by rw[GCD_REF] >>
9951  `_ = (gcd n 0) INSERT (IMAGE (gcd n) (count n))` by rw[GCD_0R] >>
9952  `_ = IMAGE (gcd n) (0 INSERT (count n))` by rw[] >>
9953  metis_tac[IN_COUNT, ABSORPTION]
9954QED
9955
9956(* Theorem: (feq (gcd n)) equiv_on (count n) *)
9957(* Proof:
9958   By feq_equiv |- !s f. feq f equiv_on s
9959   Taking s = upto n, f = count n.
9960*)
9961Theorem gcd_eq_equiv_on_count:
9962    !n. (feq (gcd n)) equiv_on (count n)
9963Proof
9964  rw[feq_equiv]
9965QED
9966
9967(* Theorem: partition (feq (gcd n)) (count n) = IMAGE (preimage (gcd n) (count n)) (divisors n) *)
9968(* Proof:
9969   Let f = gcd n, s = count n.
9970     partition (feq f) s
9971   = IMAGE (preimage f s o f) s                      by feq_partition
9972   = IMAGE (preimage f s) (IMAGE f s)                by IMAGE_COMPOSE
9973   = IMAGE (preimage f s) (IMAGE (gcd n) (count n))  by expansion
9974   = IMAGE (preimage f s) (divisors n)               by divisors_eq_image_gcd_count
9975*)
9976Theorem gcd_eq_count_partition_by_divisors:
9977  !n. partition (feq (gcd n)) (count n) = IMAGE (preimage (gcd n) (count n)) (divisors n)
9978Proof
9979  rpt strip_tac >>
9980  qabbrev_tac `f = gcd n` >>
9981  qabbrev_tac `s = count n` >>
9982  `partition (feq f) s = IMAGE (preimage f s o f) s` by rw[feq_partition] >>
9983  `_ = IMAGE (preimage f s) (IMAGE f s)` by rw[IMAGE_COMPOSE] >>
9984  rw[divisors_eq_image_gcd_count, Abbr`f`, Abbr`s`]
9985QED
9986
9987(* Theorem: SIGMA f (count n) = SIGMA (SIGMA f) (partition (feq (gcd n)) (count n)) *)
9988(* Proof:
9989   Let g = gcd n, s = count n.
9990   Since FINITE s               by FINITE_COUNT
9991     and (feq g) equiv_on s     by feq_equiv
9992   The result follows           by set_sigma_by_partition
9993*)
9994Theorem sum_over_count_by_gcd_partition:
9995    !f n. SIGMA f (count n) = SIGMA (SIGMA f) (partition (feq (gcd n)) (count n))
9996Proof
9997  rw[feq_equiv, set_sigma_by_partition]
9998QED
9999
10000(* Theorem: SIGMA f (count n) = SIGMA (SIGMA f) (IMAGE (preimage (gcd n) (count n)) (divisors n)) *)
10001(* Proof:
10002     SIGMA f (count n)
10003   = SIGMA (SIGMA f) (partition (feq (gcd n)) (count n))                by sum_over_count_by_gcd_partition
10004   = SIGMA (SIGMA f) (IMAGE (preimage (gcd n) (count n)) (divisors n))  by gcd_eq_count_partition_by_divisors
10005*)
10006Theorem sum_over_count_by_divisors:
10007  !f n. SIGMA f (count n) = SIGMA (SIGMA f) (IMAGE (preimage (gcd n) (count n)) (divisors n))
10008Proof
10009  rw[sum_over_count_by_gcd_partition, gcd_eq_count_partition_by_divisors]
10010QED
10011
10012(* Similar results based on natural *)
10013
10014(* Theorem: divisors n = IMAGE (gcd n) (natural n) *)
10015(* Proof:
10016   If n = 0,
10017      LHS = divisors 0 = {}                      by divisors_0
10018      RHS = IMAGE (gcd 0) (natural 0)
10019          = IMAGE (gcd 0) {}                     by natural_0
10020          = {} = LHS                             by IMAGE_EMPTY
10021  If n <> 0, 0 < n.
10022     divisors n
10023   = IMAGE (gcd n) (upto n)                        by divisors_eq_image_gcd_upto, 0 < n
10024   = IMAGE (gcd n) (0 INSERT natural n)            by upto_by_natural
10025   = (gcd 0 n) INSERT (IMAGE (gcd n) (natural n))  by IMAGE_INSERT
10026   = n INSERT (IMAGE (gcd n) (natural n))          by GCD_0L
10027   = (gcd n n) INSERT (IMAGE (gcd n) (natural n))  by GCD_REF
10028   = IMAGE (gcd n) (n INSERT (natural n))          by IMAGE_INSERT
10029   = IMAGE (gcd n) (natural n)                     by natural_has_last, ABSORPTION, 0 < n.
10030*)
10031Theorem divisors_eq_image_gcd_natural:
10032  !n. divisors n = IMAGE (gcd n) (natural n)
10033Proof
10034  rpt strip_tac >>
10035  Cases_on `n = 0` >-
10036  simp[divisors_0, natural_0] >>
10037  `0 < n` by decide_tac >>
10038  `divisors n = IMAGE (gcd n) (upto n)` by rw[divisors_eq_image_gcd_upto] >>
10039  `_ = IMAGE (gcd n) (0 INSERT (natural n))` by rw[upto_by_natural] >>
10040  `_ = n INSERT (IMAGE (gcd n) (natural n))` by rw[GCD_0L] >>
10041  `_ = (gcd n n) INSERT (IMAGE (gcd n) (natural n))` by rw[GCD_REF] >>
10042  `_ = IMAGE (gcd n) (n INSERT (natural n))` by rw[] >>
10043  metis_tac[natural_has_last, ABSORPTION]
10044QED
10045(* This is the same as divisors_eq_gcd_image *)
10046
10047(* Theorem: partition (feq (gcd n)) (natural n) = IMAGE (preimage (gcd n) (natural n)) (divisors n) *)
10048(* Proof:
10049   Let f = gcd n, s = natural n.
10050     partition (feq f) s
10051   = IMAGE (preimage f s o f) s                        by feq_partition
10052   = IMAGE (preimage f s) (IMAGE f s)                  by IMAGE_COMPOSE
10053   = IMAGE (preimage f s) (IMAGE (gcd n) (natural n))  by expansion
10054   = IMAGE (preimage f s) (divisors n)                 by divisors_eq_image_gcd_natural
10055*)
10056Theorem gcd_eq_natural_partition_by_divisors:
10057  !n. partition (feq (gcd n)) (natural n) = IMAGE (preimage (gcd n) (natural n)) (divisors n)
10058Proof
10059  rpt strip_tac >>
10060  qabbrev_tac `f = gcd n` >>
10061  qabbrev_tac `s = natural n` >>
10062  `partition (feq f) s = IMAGE (preimage f s o f) s` by rw[feq_partition] >>
10063  `_ = IMAGE (preimage f s) (IMAGE f s)` by rw[IMAGE_COMPOSE] >>
10064  rw[divisors_eq_image_gcd_natural, Abbr`f`, Abbr`s`]
10065QED
10066
10067(* Theorem: SIGMA f (natural n) = SIGMA (SIGMA f) (IMAGE (preimage (gcd n) (natural n)) (divisors n)) *)
10068(* Proof:
10069     SIGMA f (natural n)
10070   = SIGMA (SIGMA f) (partition (feq (gcd n)) (natural n))                by sum_over_natural_by_gcd_partition
10071   = SIGMA (SIGMA f) (IMAGE (preimage (gcd n) (natural n)) (divisors n))  by gcd_eq_natural_partition_by_divisors
10072*)
10073Theorem sum_over_natural_by_preimage_divisors:
10074  !f n. SIGMA f (natural n) = SIGMA (SIGMA f) (IMAGE (preimage (gcd n) (natural n)) (divisors n))
10075Proof
10076  rw[sum_over_natural_by_gcd_partition, gcd_eq_natural_partition_by_divisors]
10077QED
10078
10079(* Theorem: (f 0 = g 0) /\ (!n. SIGMA f (divisors n) = SIGMA g (divisors n)) ==> (f = g) *)
10080(* Proof:
10081   By FUN_EQ_THM, this is to show: !x. f x = g x.
10082   By complete induction on x.
10083   Let s = divisors x, t = s DELETE x.
10084   If x = 0, f 0 = g 0 is true            by given
10085   Otherwise x <> 0.
10086   Then x IN s                            by divisors_has_last, 0 < x
10087    and s = x INSERT t /\ x NOTIN t       by INSERT_DELETE, IN_DELETE
10088   Note FINITE s                          by divisors_finite
10089     so FINITE t                          by FINITE_DELETE
10090
10091   Claim: SIGMA f t = SIGMA g t
10092   Proof: By SUM_IMAGE_CONG, this is to show:
10093             !z. z IN t ==> (f z = g z)
10094          But z IN s <=> 0 < z /\ z <= x /\ z divides x     by divisors_element
10095           so z IN t <=> 0 < z /\ z < x /\ z divides x      by IN_DELETE
10096          ==> f z = g z                                     by induction hypothesis, [1]
10097
10098   Now      SIGMA f s = SIGMA g s         by implication
10099   or f x + SIGMA f t = g x + SIGMA g t   by SUM_IMAGE_INSERT
10100   or             f x = g x               by [1], SIGMA f t = SIGMA g t
10101*)
10102Theorem sum_image_divisors_cong:
10103  !f g. (f 0 = g 0) /\ (!n. SIGMA f (divisors n) = SIGMA g (divisors n)) ==> (f = g)
10104Proof
10105  rw[FUN_EQ_THM] >>
10106  completeInduct_on `x` >>
10107  qabbrev_tac `s = divisors x` >>
10108  qabbrev_tac `t = s DELETE x` >>
10109  (Cases_on `x = 0` >> simp[]) >>
10110  `x IN s` by rw[divisors_has_last, Abbr`s`] >>
10111  `s = x INSERT t /\ x NOTIN t` by rw[Abbr`t`] >>
10112  `SIGMA f t = SIGMA g t` by
10113  ((irule SUM_IMAGE_CONG >> simp[]) >>
10114  rw[divisors_element, Abbr`t`, Abbr`s`]) >>
10115  `FINITE t` by rw[divisors_finite, Abbr`t`, Abbr`s`] >>
10116  `SIGMA f s = f x + SIGMA f t` by rw[SUM_IMAGE_INSERT] >>
10117  `SIGMA g s = g x + SIGMA g t` by rw[SUM_IMAGE_INSERT] >>
10118  `SIGMA f s = SIGMA g s` by metis_tac[] >>
10119  decide_tac
10120QED
10121(* But this is not very useful! *)
10122
10123(* ------------------------------------------------------------------------- *)
10124(* Mobius Function and Inversion Documentation                               *)
10125(* ------------------------------------------------------------------------- *)
10126(* Overloading:
10127   sq_free s          = {n | n IN s /\ square_free n}
10128   non_sq_free s      = {n | n IN s /\ ~(square_free n)}
10129   even_sq_free s     = {n | n IN (sq_free s) /\ EVEN (CARD (prime_factors n))}
10130   odd_sq_free s      = {n | n IN (sq_free s) /\ ODD (CARD (prime_factors n))}
10131   less_divisors n    = {x | x IN (divisors n) /\ x <> n}
10132   proper_divisors n  = {x | x IN (divisors n) /\ x <> 1 /\ x <> n}
10133*)
10134(* Definitions and Theorems (# are exported):
10135
10136   Helper Theorems:
10137
10138   Square-free Number and Square-free Sets:
10139   square_free_def     |- !n. square_free n <=> !p. prime p /\ p divides n ==> ~(p * p divides n)
10140   square_free_1       |- square_free 1
10141   square_free_prime   |- !n. prime n ==> square_free n
10142
10143   sq_free_element     |- !s n. n IN sq_free s <=> n IN s /\ square_free n
10144   sq_free_subset      |- !s. sq_free s SUBSET s
10145   sq_free_finite      |- !s. FINITE s ==> FINITE (sq_free s)
10146   non_sq_free_element |- !s n. n IN non_sq_free s <=> n IN s /\ ~square_free n
10147   non_sq_free_subset  |- !s. non_sq_free s SUBSET s
10148   non_sq_free_finite  |- !s. FINITE s ==> FINITE (non_sq_free s)
10149   sq_free_split       |- !s. (s = sq_free s UNION non_sq_free s) /\
10150                              (sq_free s INTER non_sq_free s = {})
10151   sq_free_union       |- !s. s = sq_free s UNION non_sq_free s
10152   sq_free_inter       |- !s. sq_free s INTER non_sq_free s = {}
10153   sq_free_disjoint    |- !s. DISJOINT (sq_free s) (non_sq_free s)
10154
10155   Prime Divisors of a Number and Partitions of Square-free Set:
10156   prime_factors_def      |- !n. prime_factors n = {p | prime p /\ p IN divisors n}
10157   prime_factors_element  |- !n p. p IN prime_factors n <=> prime p /\ p <= n /\ p divides n
10158   prime_factors_subset   |- !n. prime_factors n SUBSET divisors n
10159   prime_factors_finite   |- !n. FINITE (prime_factors n)
10160
10161   even_sq_free_element    |- !s n. n IN even_sq_free s <=> n IN s /\ square_free n /\ EVEN (CARD (prime_factors n))
10162   even_sq_free_subset     |- !s. even_sq_free s SUBSET s
10163   even_sq_free_finite     |- !s. FINITE s ==> FINITE (even_sq_free s)
10164   odd_sq_free_element     |- !s n. n IN odd_sq_free s <=> n IN s /\ square_free n /\ ODD (CARD (prime_factors n))
10165   odd_sq_free_subset      |- !s. odd_sq_free s SUBSET s
10166   odd_sq_free_finite      |- !s. FINITE s ==> FINITE (odd_sq_free s)
10167   sq_free_split_even_odd  |- !s. (sq_free s = even_sq_free s UNION odd_sq_free s) /\
10168                                  (even_sq_free s INTER odd_sq_free s = {})
10169   sq_free_union_even_odd  |- !s. sq_free s = even_sq_free s UNION odd_sq_free s
10170   sq_free_inter_even_odd  |- !s. even_sq_free s INTER odd_sq_free s = {}
10171   sq_free_disjoint_even_odd  |- !s. DISJOINT (even_sq_free s) (odd_sq_free s)
10172
10173   Less Divisors of a number:
10174   less_divisors_element       |- !n x. x IN less_divisors n <=> 0 < x /\ x < n /\ x divides n
10175   less_divisors_0             |- less_divisors 0 = {}
10176   less_divisors_1             |- less_divisors 1 = {}
10177   less_divisors_subset_divisors
10178                               |- !n. less_divisors n SUBSET divisors n
10179   less_divisors_finite        |- !n. FINITE (less_divisors n)
10180   less_divisors_prime         |- !n. prime n ==> (less_divisors n = {1})
10181   less_divisors_has_1         |- !n. 1 < n ==> 1 IN less_divisors n
10182   less_divisors_nonzero       |- !n x. x IN less_divisors n ==> 0 < x
10183   less_divisors_has_cofactor  |- !n d. 1 < d /\ d IN less_divisors n ==> n DIV d IN less_divisors n
10184
10185   Proper Divisors of a number:
10186   proper_divisors_element     |- !n x. x IN proper_divisors n <=> 1 < x /\ x < n /\ x divides n
10187   proper_divisors_0           |- proper_divisors 0 = {}
10188   proper_divisors_1           |- proper_divisors 1 = {}
10189   proper_divisors_subset      |- !n. proper_divisors n SUBSET less_divisors n
10190   proper_divisors_finite      |- !n. FINITE (proper_divisors n)
10191   proper_divisors_not_1       |- !n. 1 NOTIN proper_divisors n
10192   proper_divisors_by_less_divisors
10193                               |- !n. proper_divisors n = less_divisors n DELETE 1
10194   proper_divisors_prime       |- !n. prime n ==> (proper_divisors n = {})
10195   proper_divisors_has_cofactor|- !n d. d IN proper_divisors n ==> n DIV d IN proper_divisors n
10196   proper_divisors_min_gt_1    |- !n. proper_divisors n <> {} ==> 1 < MIN_SET (proper_divisors n)
10197   proper_divisors_max_min     |- !n. proper_divisors n <> {} ==>
10198                                      (MAX_SET (proper_divisors n) = n DIV MIN_SET (proper_divisors n)) /\
10199                                      (MIN_SET (proper_divisors n) = n DIV MAX_SET (proper_divisors n))
10200
10201   Useful Properties of Less Divisors:
10202   less_divisors_min             |- !n. 1 < n ==> (MIN_SET (less_divisors n) = 1)
10203   less_divisors_max             |- !n. MAX_SET (less_divisors n) <= n DIV 2
10204   less_divisors_subset_natural  |- !n. less_divisors n SUBSET natural (n DIV 2)
10205
10206   Properties of Summation equals Perfect Power:
10207   perfect_power_special_inequality  |- !p. 1 < p ==> !n. p * (p ** n - 1) < (p - 1) * (2 * p ** n)
10208   perfect_power_half_inequality_1   |- !p n. 1 < p /\ 0 < n ==> 2 * p ** (n DIV 2) <= p ** n
10209   perfect_power_half_inequality_2   |- !p n. 1 < p /\ 0 < n ==>
10210                                        (p ** (n DIV 2) - 2) * p ** (n DIV 2) <= p ** n - 2 * p ** (n DIV 2)
10211   sigma_eq_perfect_power_bounds_1   |- !p. 1 < p ==>
10212                          !f. (!n. 0 < n ==> (p ** n = SIGMA (\d. d * f d) (divisors n))) ==>
10213                              (!n. 0 < n ==> n * f n <= p ** n) /\
10214                               !n. 0 < n ==> p ** n - 2 * p ** (n DIV 2) < n * f n
10215   sigma_eq_perfect_power_bounds_2   |- !p. 1 < p ==>
10216                          !f. (!n. 0 < n ==> (p ** n = SIGMA (\d. d * f d) (divisors n))) ==>
10217                              (!n. 0 < n ==> n * f n <= p ** n) /\
10218                               !n. 0 < n ==> (p ** (n DIV 2) - 2) * p ** (n DIV 2) < n * f n
10219
10220*)
10221
10222(* ------------------------------------------------------------------------- *)
10223(* Helper Theorems                                                           *)
10224(* ------------------------------------------------------------------------- *)
10225
10226(* ------------------------------------------------------------------------- *)
10227(* Mobius Function and Inversion                                             *)
10228(* ------------------------------------------------------------------------- *)
10229
10230
10231(* ------------------------------------------------------------------------- *)
10232(* Square-free Number and Square-free Sets                                   *)
10233(* ------------------------------------------------------------------------- *)
10234
10235(* Define square-free number *)
10236Definition square_free_def:
10237    square_free n = !p. prime p /\ p divides n ==> ~(p * p divides n)
10238End
10239
10240(* Theorem: square_free 1 *)
10241(* Proof:
10242       square_free 1
10243   <=> !p. prime p /\ p divides 1 ==> ~(p * p divides 1)    by square_free_def
10244   <=> prime 1 ==> ~(1 * 1 divides 1)                       by DIVIDES_ONE
10245   <=> F ==> ~(1 * 1 divides 1)                             by NOT_PRIME_1
10246   <=> T                                                    by false assumption
10247*)
10248Theorem square_free_1:
10249    square_free 1
10250Proof
10251  rw[square_free_def]
10252QED
10253
10254(* Theorem: prime n ==> square_free n *)
10255(* Proof:
10256       square_free n
10257   <=> !p. prime p /\ p divides n ==> ~(p * p divides n)   by square_free_def
10258   By contradiction, suppose (p * p divides n).
10259   Since p divides n ==> (p = n) \/ (p = 1)                by prime_def
10260     and p * p divides  ==> (p * p = n) \/ (p * p = 1)     by prime_def
10261     but p <> 1                                            by prime_def
10262      so p * p <> 1              by MULT_EQ_1
10263    Thus p * p = n = p,
10264      or p = 0 \/ p = 1          by SQ_EQ_SELF
10265     But p <> 0                  by NOT_PRIME_0
10266     and p <> 1                  by NOT_PRIME_1
10267    Thus there is a contradiction.
10268*)
10269Theorem square_free_prime:
10270    !n. prime n ==> square_free n
10271Proof
10272  rw_tac std_ss[square_free_def] >>
10273  spose_not_then strip_assume_tac >>
10274  `p * p = p` by metis_tac[prime_def, MULT_EQ_1] >>
10275  metis_tac[SQ_EQ_SELF, NOT_PRIME_0, NOT_PRIME_1]
10276QED
10277
10278(* Overload square-free filter of a set *)
10279Overload sq_free = ``\s. {n | n IN s /\ square_free n}``
10280
10281(* Overload non-square-free filter of a set *)
10282Overload non_sq_free = ``\s. {n | n IN s /\ ~(square_free n)}``
10283
10284(* Theorem: n IN sq_free s <=> n IN s /\ square_free n *)
10285(* Proof: by notation. *)
10286Theorem sq_free_element:
10287    !s n. n IN sq_free s <=> n IN s /\ square_free n
10288Proof
10289  rw[]
10290QED
10291
10292(* Theorem: sq_free s SUBSET s *)
10293(* Proof: by SUBSET_DEF *)
10294Theorem sq_free_subset:
10295    !s. sq_free s SUBSET s
10296Proof
10297  rw[SUBSET_DEF]
10298QED
10299
10300(* Theorem: FINITE s ==> FINITE (sq_free s) *)
10301(* Proof: by sq_free_subset, SUBSET_FINITE *)
10302Theorem sq_free_finite:
10303    !s. FINITE s ==> FINITE (sq_free s)
10304Proof
10305  metis_tac[sq_free_subset, SUBSET_FINITE]
10306QED
10307
10308(* Theorem: n IN non_sq_free s <=> n IN s /\ ~(square_free n) *)
10309(* Proof: by notation. *)
10310Theorem non_sq_free_element:
10311    !s n. n IN non_sq_free s <=> n IN s /\ ~(square_free n)
10312Proof
10313  rw[]
10314QED
10315
10316(* Theorem: non_sq_free s SUBSET s *)
10317(* Proof: by SUBSET_DEF *)
10318Theorem non_sq_free_subset:
10319    !s. non_sq_free s SUBSET s
10320Proof
10321  rw[SUBSET_DEF]
10322QED
10323
10324(* Theorem: FINITE s ==> FINITE (non_sq_free s) *)
10325(* Proof: by non_sq_free_subset, SUBSET_FINITE *)
10326Theorem non_sq_free_finite:
10327    !s. FINITE s ==> FINITE (non_sq_free s)
10328Proof
10329  metis_tac[non_sq_free_subset, SUBSET_FINITE]
10330QED
10331
10332(* Theorem: (s = (sq_free s) UNION (non_sq_free s)) /\ ((sq_free s) INTER (non_sq_free s) = {}) *)
10333(* Proof:
10334   This is to show:
10335   (1) s = (sq_free s) UNION (non_sq_free s)
10336       True by EXTENSION, IN_UNION.
10337   (2) (sq_free s) INTER (non_sq_free s) = {}
10338       True by EXTENSION, IN_INTER
10339*)
10340Theorem sq_free_split:
10341    !s. (s = (sq_free s) UNION (non_sq_free s)) /\ ((sq_free s) INTER (non_sq_free s) = {})
10342Proof
10343  (rw[EXTENSION] >> metis_tac[])
10344QED
10345
10346(* Theorem: s = (sq_free s) UNION (non_sq_free s) *)
10347(* Proof: extract from sq_free_split. *)
10348Theorem sq_free_union = sq_free_split |> SPEC_ALL |> CONJUNCT1 |> GEN_ALL;
10349(* val sq_free_union = |- !s. s = sq_free s UNION non_sq_free s: thm *)
10350
10351(* Theorem: (sq_free s) INTER (non_sq_free s) = {} *)
10352(* Proof: extract from sq_free_split. *)
10353Theorem sq_free_inter = sq_free_split |> SPEC_ALL |> CONJUNCT2 |> GEN_ALL;
10354(* val sq_free_inter = |- !s. sq_free s INTER non_sq_free s = {}: thm *)
10355
10356(* Theorem: DISJOINT (sq_free s) (non_sq_free s) *)
10357(* Proof: by DISJOINT_DEF, sq_free_inter. *)
10358Theorem sq_free_disjoint:
10359    !s. DISJOINT (sq_free s) (non_sq_free s)
10360Proof
10361  rw_tac std_ss[DISJOINT_DEF, sq_free_inter]
10362QED
10363
10364(* ------------------------------------------------------------------------- *)
10365(* Prime Divisors of a Number and Partitions of Square-free Set              *)
10366(* ------------------------------------------------------------------------- *)
10367
10368(* Define the prime divisors of a number *)
10369Definition prime_factors_def[nocompute]:
10370    prime_factors n = {p | prime p /\ p IN (divisors n)}
10371End
10372(* use zDefine as this cannot be computed. *)
10373(* prime_divisors is used in triangle.hol *)
10374
10375(* Theorem: p IN prime_factors n <=> prime p /\ p <= n /\ p divides n *)
10376(* Proof:
10377       p IN prime_factors n
10378   <=> prime p /\ p IN (divisors n)                by prime_factors_def
10379   <=> prime p /\ 0 < p /\ p <= n /\ p divides n   by divisors_def
10380   <=> prime p /\ p <= n /\ p divides n            by PRIME_POS
10381*)
10382Theorem prime_factors_element:
10383  !n p. p IN prime_factors n <=> prime p /\ p <= n /\ p divides n
10384Proof
10385  rw[prime_factors_def, divisors_def] >>
10386  metis_tac[PRIME_POS]
10387QED
10388
10389(* Theorem: (prime_factors n) SUBSET (divisors n) *)
10390(* Proof:
10391       p IN (prime_factors n)
10392   ==> p IN (divisors n)                         by prime_factors_def
10393   Hence (prime_factors n) SUBSET (divisors n)   by SUBSET_DEF
10394*)
10395Theorem prime_factors_subset:
10396    !n. (prime_factors n) SUBSET (divisors n)
10397Proof
10398  rw[prime_factors_def, SUBSET_DEF]
10399QED
10400
10401(* Theorem: FINITE (prime_factors n) *)
10402(* Proof:
10403   Since (prime_factors n) SUBSET (divisors n)   by prime_factors_subset
10404     and FINITE (divisors n)                     by divisors_finite
10405    Thus FINITE (prime_factors n)                by SUBSET_FINITE
10406*)
10407Theorem prime_factors_finite:
10408    !n. FINITE (prime_factors n)
10409Proof
10410  metis_tac[prime_factors_subset, divisors_finite, SUBSET_FINITE]
10411QED
10412
10413(* Overload even square-free filter of a set *)
10414Overload even_sq_free = ``\s. {n | n IN (sq_free s) /\ EVEN (CARD (prime_factors n))}``
10415
10416(* Overload odd square-free filter of a set *)
10417Overload odd_sq_free = ``\s. {n | n IN (sq_free s) /\ ODD (CARD (prime_factors n))}``
10418
10419(* Theorem: n IN even_sq_free s <=> n IN s /\ square_free n /\ EVEN (CARD (prime_factors n)) *)
10420(* Proof: by notation. *)
10421Theorem even_sq_free_element:
10422    !s n. n IN even_sq_free s <=> n IN s /\ square_free n /\ EVEN (CARD (prime_factors n))
10423Proof
10424  (rw[] >> metis_tac[])
10425QED
10426
10427(* Theorem: even_sq_free s SUBSET s *)
10428(* Proof: by SUBSET_DEF *)
10429Theorem even_sq_free_subset:
10430    !s. even_sq_free s SUBSET s
10431Proof
10432  rw[SUBSET_DEF]
10433QED
10434
10435(* Theorem: FINITE s ==> FINITE (even_sq_free s) *)
10436(* Proof: by even_sq_free_subset, SUBSET_FINITE *)
10437Theorem even_sq_free_finite:
10438    !s. FINITE s ==> FINITE (even_sq_free s)
10439Proof
10440  metis_tac[even_sq_free_subset, SUBSET_FINITE]
10441QED
10442
10443(* Theorem: n IN odd_sq_free s <=> n IN s /\ square_free n /\ ODD (CARD (prime_factors n)) *)
10444(* Proof: by notation. *)
10445Theorem odd_sq_free_element:
10446    !s n. n IN odd_sq_free s <=> n IN s /\ square_free n /\ ODD (CARD (prime_factors n))
10447Proof
10448  (rw[] >> metis_tac[])
10449QED
10450
10451(* Theorem: odd_sq_free s SUBSET s *)
10452(* Proof: by SUBSET_DEF *)
10453Theorem odd_sq_free_subset:
10454    !s. odd_sq_free s SUBSET s
10455Proof
10456  rw[SUBSET_DEF]
10457QED
10458
10459(* Theorem: FINITE s ==> FINITE (odd_sq_free s) *)
10460(* Proof: by odd_sq_free_subset, SUBSET_FINITE *)
10461Theorem odd_sq_free_finite:
10462    !s. FINITE s ==> FINITE (odd_sq_free s)
10463Proof
10464  metis_tac[odd_sq_free_subset, SUBSET_FINITE]
10465QED
10466
10467(* Theorem: (sq_free s = (even_sq_free s) UNION (odd_sq_free s)) /\
10468            ((even_sq_free s) INTER (odd_sq_free s) = {}) *)
10469(* Proof:
10470   This is to show:
10471   (1) sq_free s = even_sq_free s UNION odd_sq_free s
10472       True by EXTENSION, IN_UNION, EVEN_ODD.
10473   (2) even_sq_free s INTER odd_sq_free s = {}
10474       True by EXTENSION, IN_INTER, EVEN_ODD.
10475*)
10476Theorem sq_free_split_even_odd:
10477    !s. (sq_free s = (even_sq_free s) UNION (odd_sq_free s)) /\
10478       ((even_sq_free s) INTER (odd_sq_free s) = {})
10479Proof
10480  (rw[EXTENSION] >> metis_tac[EVEN_ODD])
10481QED
10482
10483(* Theorem: sq_free s = (even_sq_free s) UNION (odd_sq_free s) *)
10484(* Proof: extract from sq_free_split_even_odd. *)
10485Theorem sq_free_union_even_odd = sq_free_split_even_odd |> SPEC_ALL |> CONJUNCT1 |> GEN_ALL;
10486(* val sq_free_union_even_odd =
10487   |- !s. sq_free s = even_sq_free s UNION odd_sq_free s: thm *)
10488
10489(* Theorem: (even_sq_free s) INTER (odd_sq_free s) = {} *)
10490(* Proof: extract from sq_free_split_even_odd. *)
10491Theorem sq_free_inter_even_odd = sq_free_split_even_odd |> SPEC_ALL |> CONJUNCT2 |> GEN_ALL;
10492(* val sq_free_inter_even_odd =
10493   |- !s. even_sq_free s INTER odd_sq_free s = {}: thm *)
10494
10495(* Theorem: DISJOINT (even_sq_free s) (odd_sq_free s) *)
10496(* Proof: by DISJOINT_DEF, sq_free_inter_even_odd. *)
10497Theorem sq_free_disjoint_even_odd:
10498    !s. DISJOINT (even_sq_free s) (odd_sq_free s)
10499Proof
10500  rw_tac std_ss[DISJOINT_DEF, sq_free_inter_even_odd]
10501QED
10502
10503(* ------------------------------------------------------------------------- *)
10504(* Less Divisors of a number.                                                *)
10505(* ------------------------------------------------------------------------- *)
10506
10507(* Overload the set of divisors less than n *)
10508Overload less_divisors = ``\n. {x | x IN (divisors n) /\ x <> n}``
10509
10510(* Theorem: x IN (less_divisors n) <=> (0 < x /\ x < n /\ x divides n) *)
10511(* Proof: by divisors_element. *)
10512Theorem less_divisors_element:
10513    !n x. x IN (less_divisors n) <=> (0 < x /\ x < n /\ x divides n)
10514Proof
10515  rw[divisors_element, EQ_IMP_THM]
10516QED
10517
10518(* Theorem: less_divisors 0 = {} *)
10519(* Proof: by divisors_element. *)
10520Theorem less_divisors_0:
10521    less_divisors 0 = {}
10522Proof
10523  rw[divisors_element]
10524QED
10525
10526(* Theorem: less_divisors 1 = {} *)
10527(* Proof: by divisors_element. *)
10528Theorem less_divisors_1:
10529    less_divisors 1 = {}
10530Proof
10531  rw[divisors_element]
10532QED
10533
10534(* Theorem: (less_divisors n) SUBSET (divisors n) *)
10535(* Proof: by SUBSET_DEF *)
10536Theorem less_divisors_subset_divisors:
10537    !n. (less_divisors n) SUBSET (divisors n)
10538Proof
10539  rw[SUBSET_DEF]
10540QED
10541
10542(* Theorem: FINITE (less_divisors n) *)
10543(* Proof:
10544   Since (less_divisors n) SUBSET (divisors n)   by less_divisors_subset_divisors
10545     and FINITE (divisors n)                     by divisors_finite
10546      so FINITE (proper_divisors n)              by SUBSET_FINITE
10547*)
10548Theorem less_divisors_finite:
10549    !n. FINITE (less_divisors n)
10550Proof
10551  metis_tac[divisors_finite, less_divisors_subset_divisors, SUBSET_FINITE]
10552QED
10553
10554(* Theorem: prime n ==> (less_divisors n = {1}) *)
10555(* Proof:
10556   Since prime n
10557     ==> !b. b divides n ==> (b = n) \/ (b = 1)   by prime_def
10558   But (less_divisors n) excludes n               by less_divisors_element
10559   and 1 < n                                      by ONE_LT_PRIME
10560   Hence less_divisors n = {1}
10561*)
10562Theorem less_divisors_prime:
10563    !n. prime n ==> (less_divisors n = {1})
10564Proof
10565  rpt strip_tac >>
10566  `!b. b divides n ==> (b = n) \/ (b = 1)` by metis_tac[prime_def] >>
10567  rw[less_divisors_element, EXTENSION, EQ_IMP_THM] >| [
10568    `x <> n` by decide_tac >>
10569    metis_tac[],
10570    rw[ONE_LT_PRIME]
10571  ]
10572QED
10573
10574(* Theorem: 1 < n ==> 1 IN (less_divisors n) *)
10575(* Proof:
10576       1 IN (less_divisors n)
10577   <=> 1 < n /\ 1 divides n     by less_divisors_element
10578   <=> T                        by ONE_DIVIDES_ALL
10579*)
10580Theorem less_divisors_has_1:
10581    !n. 1 < n ==> 1 IN (less_divisors n)
10582Proof
10583  rw[less_divisors_element]
10584QED
10585
10586(* Theorem: x IN (less_divisors n) ==> 0 < x *)
10587(* Proof: by less_divisors_element. *)
10588Theorem less_divisors_nonzero:
10589    !n x. x IN (less_divisors n) ==> 0 < x
10590Proof
10591  rw[less_divisors_element]
10592QED
10593
10594(* Theorem: 1 < d /\ d IN (less_divisors n) ==> (n DIV d) IN (less_divisors n) *)
10595(* Proof:
10596      d IN (less_divisors n)
10597  ==> d IN (divisors n)                   by less_divisors_subset_divisors
10598  ==> (n DIV d) IN (divisors n)           by divisors_has_cofactor
10599   Note 0 < d /\ d <= n ==> 0 < n         by divisors_element
10600   Also n DIV d < n                       by DIV_LESS, 0 < n /\ 1 < d
10601   thus n DIV d <> n                      by LESS_NOT_EQ
10602  Hence (n DIV d) IN (less_divisors n)    by notation
10603*)
10604Theorem less_divisors_has_cofactor:
10605    !n d. 1 < d /\ d IN (less_divisors n) ==> (n DIV d) IN (less_divisors n)
10606Proof
10607  rw[divisors_has_cofactor, divisors_element, DIV_LESS, LESS_NOT_EQ]
10608QED
10609
10610(* ------------------------------------------------------------------------- *)
10611(* Proper Divisors of a number.                                              *)
10612(* ------------------------------------------------------------------------- *)
10613
10614(* Overload the set of proper divisors of n *)
10615Overload proper_divisors = ``\n. {x | x IN (divisors n) /\ x <> 1 /\ x <> n}``
10616
10617(* Theorem: x IN (proper_divisors n) <=> (1 < x /\ x < n /\ x divides n) *)
10618(* Proof:
10619   Since x IN (divisors n)
10620     ==> 0 < x /\ x <= n /\ x divides n  by divisors_element
10621   Since x <= n but x <> n, x < n.
10622   With x <> 0 /\ x <> 1 ==> 1 < x.
10623*)
10624Theorem proper_divisors_element:
10625    !n x. x IN (proper_divisors n) <=> (1 < x /\ x < n /\ x divides n)
10626Proof
10627  rw[divisors_element, EQ_IMP_THM]
10628QED
10629
10630(* Theorem: proper_divisors 0 = {} *)
10631(* Proof: by proper_divisors_element. *)
10632Theorem proper_divisors_0:
10633    proper_divisors 0 = {}
10634Proof
10635  rw[proper_divisors_element, EXTENSION]
10636QED
10637
10638(* Theorem: proper_divisors 1 = {} *)
10639(* Proof: by proper_divisors_element. *)
10640Theorem proper_divisors_1:
10641    proper_divisors 1 = {}
10642Proof
10643  rw[proper_divisors_element, EXTENSION]
10644QED
10645
10646(* Theorem: (proper_divisors n) SUBSET (less_divisors n) *)
10647(* Proof: by SUBSET_DEF *)
10648Theorem proper_divisors_subset:
10649    !n. (proper_divisors n) SUBSET (less_divisors n)
10650Proof
10651  rw[SUBSET_DEF]
10652QED
10653
10654(* Theorem: FINITE (proper_divisors n) *)
10655(* Proof:
10656   Since (proper_divisors n) SUBSET (less_divisors n) by proper_divisors_subset
10657     and FINITE (less_divisors n)                     by less_divisors_finite
10658      so FINITE (proper_divisors n)                   by SUBSET_FINITE
10659*)
10660Theorem proper_divisors_finite:
10661    !n. FINITE (proper_divisors n)
10662Proof
10663  metis_tac[less_divisors_finite, proper_divisors_subset, SUBSET_FINITE]
10664QED
10665
10666(* Theorem: 1 NOTIN (proper_divisors n) *)
10667(* Proof: proper_divisors_element *)
10668Theorem proper_divisors_not_1:
10669    !n. 1 NOTIN (proper_divisors n)
10670Proof
10671  rw[proper_divisors_element]
10672QED
10673
10674(* Theorem: proper_divisors n = (less_divisors n) DELETE 1 *)
10675(* Proof:
10676      proper_divisors n
10677    = {x | x IN (divisors n) /\ x <> 1 /\ x <> n}   by notation
10678    = {x | x IN (divisors n) /\ x <> n} DELETE 1    by IN_DELETE
10679    = (less_divisors n) DELETE 1
10680*)
10681Theorem proper_divisors_by_less_divisors:
10682    !n. proper_divisors n = (less_divisors n) DELETE 1
10683Proof
10684  rw[divisors_element, EXTENSION, EQ_IMP_THM]
10685QED
10686
10687(* Theorem: prime n ==> (proper_divisors n = {}) *)
10688(* Proof:
10689      proper_divisors n
10690    = (less_divisors n) DELETE 1  by proper_divisors_by_less_divisors
10691    = {1} DELETE 1                by less_divisors_prime, prime n
10692    = {}                          by SING_DELETE
10693*)
10694Theorem proper_divisors_prime:
10695    !n. prime n ==> (proper_divisors n = {})
10696Proof
10697  rw[proper_divisors_by_less_divisors, less_divisors_prime]
10698QED
10699
10700(* Theorem: d IN (proper_divisors n) ==> (n DIV d) IN (proper_divisors n) *)
10701(* Proof:
10702   Let e = n DIV d.
10703   Since d IN (proper_divisors n)
10704     ==> 1 < d /\ d < n                   by proper_divisors_element
10705     and d IN (less_divisors n)           by proper_divisors_subset
10706      so e IN (less_divisors n)           by less_divisors_has_cofactor
10707     and 0 < e                            by less_divisors_nonzero
10708   Since d divides n                      by less_divisors_element
10709      so n = e * d                        by DIV_MULT_EQ, 0 < d
10710    thus e <> 1 since n <> d              by MULT_LEFT_1
10711    With 0 < e /\ e <> 1
10712     ==> e IN (proper_divisors n)         by proper_divisors_by_less_divisors, IN_DELETE
10713*)
10714Theorem proper_divisors_has_cofactor:
10715    !n d. d IN (proper_divisors n) ==> (n DIV d) IN (proper_divisors n)
10716Proof
10717  rpt strip_tac >>
10718  qabbrev_tac `e = n DIV d` >>
10719  `1 < d /\ d < n` by metis_tac[proper_divisors_element] >>
10720  `d IN (less_divisors n)` by metis_tac[proper_divisors_subset, SUBSET_DEF] >>
10721  `e IN (less_divisors n)` by rw[less_divisors_has_cofactor, Abbr`e`] >>
10722  `0 < e` by metis_tac[less_divisors_nonzero] >>
10723  `0 < d /\ n <> d` by decide_tac >>
10724  `e <> 1` by metis_tac[less_divisors_element, DIV_MULT_EQ, MULT_LEFT_1] >>
10725  metis_tac[proper_divisors_by_less_divisors, IN_DELETE]
10726QED
10727
10728(* Theorem: (proper_divisors n) <> {} ==> 1 < MIN_SET (proper_divisors n) *)
10729(* Proof:
10730   Let s = proper_divisors n.
10731   Since !x. x IN s ==> 1 < x        by proper_divisors_element
10732     But MIN_SET s IN s              by MIN_SET_IN_SET
10733   Hence 1 < MIN_SET s               by above
10734*)
10735Theorem proper_divisors_min_gt_1:
10736    !n. (proper_divisors n) <> {} ==> 1 < MIN_SET (proper_divisors n)
10737Proof
10738  metis_tac[MIN_SET_IN_SET, proper_divisors_element]
10739QED
10740
10741(* Theorem: (proper_divisors n) <> {} ==>
10742            (MAX_SET (proper_divisors n) = n DIV (MIN_SET (proper_divisors n))) /\
10743            (MIN_SET (proper_divisors n) = n DIV (MAX_SET (proper_divisors n)))     *)
10744(* Proof:
10745   Let s = proper_divisors n, b = MIN_SET s.
10746   By MAX_SET_ELIM, this is to show:
10747   (1) FINITE s, true                     by proper_divisors_finite
10748   (2) s <> {} /\ x IN s /\ !y. y IN s ==> y <= x ==> x = n DIV b /\ b = n DIV x
10749       Note s <> {} ==> n <> 0            by proper_divisors_0
10750        Let m = n DIV b.
10751       Note n DIV x IN s                  by proper_divisors_has_cofactor, 0 < n, 1 < b.
10752       Also b IN s /\ b <= x              by MIN_SET_IN_SET, s <> {}
10753       thus 1 < b                         by proper_divisors_min_gt_1
10754         so m IN s                        by proper_divisors_has_cofactor, 0 < n, 1 < x.
10755         or 1 < m                         by proper_divisors_nonzero
10756        and m <= x                        by implication, x = MAX_SET s.
10757       Thus n DIV x <= n DIV m            by DIV_LE_MONOTONE_REVERSE [1], 0 < x, 0 < m.
10758        But n DIV m
10759          = n DIV (n DIV b) = b           by divide_by_cofactor, b divides n.
10760         so n DIV x <= b                  by [1]
10761      Since b <= n DIV x                  by MIN_SET_PROPERTY, b = MIN_SET s, n DIV x IN s.
10762         so n DIV x = b                   by LESS_EQUAL_ANTISYM (gives second subgoal)
10763      Hence m = n DIV b
10764              = n DIV (n DIV x) = x       by divide_by_cofactor, x divides n (gives first subgoal)
10765*)
10766Theorem proper_divisors_max_min:
10767    !n. (proper_divisors n) <> {} ==>
10768       (MAX_SET (proper_divisors n) = n DIV (MIN_SET (proper_divisors n))) /\
10769       (MIN_SET (proper_divisors n) = n DIV (MAX_SET (proper_divisors n)))
10770Proof
10771  ntac 2 strip_tac >>
10772  qabbrev_tac `s = proper_divisors n` >>
10773  qabbrev_tac `b = MIN_SET s` >>
10774  DEEP_INTRO_TAC MAX_SET_ELIM >>
10775  strip_tac >-
10776  rw[proper_divisors_finite, Abbr`s`] >>
10777  ntac 3 strip_tac >>
10778  `n <> 0` by metis_tac[proper_divisors_0] >>
10779  `b IN s /\ b <= x` by rw[MIN_SET_IN_SET, Abbr`b`] >>
10780  `1 < b` by rw[proper_divisors_min_gt_1, Abbr`s`, Abbr`b`] >>
10781  `0 < n /\ 1 < x` by decide_tac >>
10782  qabbrev_tac `m = n DIV b` >>
10783  `m IN s /\ (n DIV x) IN s` by rw[proper_divisors_has_cofactor, Abbr`m`, Abbr`s`] >>
10784  `1 < m` by metis_tac[proper_divisors_element] >>
10785  `0 < x /\ 0 < m` by decide_tac >>
10786  `n DIV x <= n DIV m` by rw[DIV_LE_MONOTONE_REVERSE] >>
10787  `b divides n /\ x divides n` by metis_tac[proper_divisors_element] >>
10788  `n DIV m = b` by rw[divide_by_cofactor, Abbr`m`] >>
10789  `b <= n DIV x` by rw[MIN_SET_PROPERTY, Abbr`b`] >>
10790  `b = n DIV x` by rw[LESS_EQUAL_ANTISYM] >>
10791  `m = x` by rw[divide_by_cofactor, Abbr`m`] >>
10792  decide_tac
10793QED
10794
10795(* This is a milestone theorem. *)
10796
10797(* ------------------------------------------------------------------------- *)
10798(* Useful Properties of Less Divisors                                        *)
10799(* ------------------------------------------------------------------------- *)
10800
10801(* Theorem: 1 < n ==> (MIN_SET (less_divisors n) = 1) *)
10802(* Proof:
10803   Let s = less_divisors n.
10804   Since 1 < n ==> 1 IN s         by less_divisors_has_1
10805      so s <> {}                  by MEMBER_NOT_EMPTY
10806     and !y. y IN s ==> 0 < y     by less_divisors_nonzero
10807      or !y. y IN s ==> 1 <= y    by LESS_EQ
10808   Hence 1 = MIN_SET s            by MIN_SET_TEST
10809*)
10810Theorem less_divisors_min:
10811    !n. 1 < n ==> (MIN_SET (less_divisors n) = 1)
10812Proof
10813  metis_tac[less_divisors_has_1, MEMBER_NOT_EMPTY,
10814             MIN_SET_TEST, less_divisors_nonzero, LESS_EQ, ONE]
10815QED
10816
10817(* Theorem: MAX_SET (less_divisors n) <= n DIV 2 *)
10818(* Proof:
10819   Let s = less_divisors n, m = MAX_SET s.
10820   If s = {},
10821      Then m = MAX_SET {} = 0          by MAX_SET_EMPTY
10822       and 0 <= n DIV 2 is trivial.
10823   If s <> {},
10824      Then n <> 0 /\ n <> 1            by less_divisors_0, less_divisors_1
10825   Note 1 IN s                         by less_divisors_has_1
10826   Consider t = s DELETE 1.
10827   Then t = proper_divisors n          by proper_divisors_by_less_divisors
10828   If t = {},
10829      Then s = {1}                     by DELETE_EQ_SING
10830       and m = 1                       by SING_DEF, IN_SING (same as MAX_SET_SING)
10831     Since 2 <= n                      by 1 < n
10832      thus n DIV n <= n DIV 2          by DIV_LE_MONOTONE_REVERSE
10833        or n DIV n = 1 = m <= n DIV 2  by DIVMOD_ID, 0 < n
10834   If t <> {},
10835      Let b = MIN_SET t
10836      Then MAX_SET t = n DIV b         by proper_divisors_max_min, t <> {}
10837     Since MIN_SET s = 1               by less_divisors_min, 1 < n
10838       and FINITE s                    by less_divisors_finite
10839       and s <> {1}                    by DELETE_EQ_SING
10840      thus m = MAX_SET t               by MAX_SET_DELETE, s <> {1}
10841
10842       Now 1 < b                       by proper_divisors_min_gt_1
10843        so 2 <= b                      by LESS_EQ, 1 < b
10844     Hence n DIV b <= n DIV 2          by DIV_LE_MONOTONE_REVERSE
10845       or        m <= n DIV 2          by m = MAX_SET t = n DIV b
10846*)
10847
10848Theorem less_divisors_max:
10849  !n. MAX_SET (less_divisors n) <= n DIV 2
10850Proof
10851  rpt strip_tac >>
10852  qabbrev_tac `s = less_divisors n` >>
10853  qabbrev_tac `m = MAX_SET s` >>
10854  Cases_on `s = {}` >- rw[MAX_SET_EMPTY, Abbr`m`] >>
10855  `n <> 0 /\ n <> 1` by metis_tac[less_divisors_0, less_divisors_1] >>
10856  `1 < n` by decide_tac >>
10857  `1 IN s` by rw[less_divisors_has_1, Abbr`s`] >>
10858  qabbrev_tac `t = proper_divisors n` >>
10859  `t = s DELETE 1`  by rw[proper_divisors_by_less_divisors, Abbr`t`, Abbr`s`] >>
10860  Cases_on `t = {}` >| [
10861    `s = {1}` by rfs[] >>
10862    `m = 1` by rw[MAX_SET_SING, Abbr`m`] >>
10863    `(2 <= n) /\ (0 < 2) /\ (0 < n) /\ (n DIV n = 1)` by rw[] >>
10864    metis_tac[DIV_LE_MONOTONE_REVERSE],
10865    qabbrev_tac `b = MIN_SET t` >>
10866    `MAX_SET t = n DIV b` by metis_tac[proper_divisors_max_min] >>
10867    `MIN_SET s = 1` by rw[less_divisors_min, Abbr`s`] >>
10868    `FINITE s` by rw[less_divisors_finite, Abbr`s`] >>
10869    `s <> {1}` by metis_tac[DELETE_EQ_SING] >>
10870    `m = MAX_SET t` by metis_tac[MAX_SET_DELETE] >>
10871    `1 < b` by rw[proper_divisors_min_gt_1, Abbr`b`, Abbr`t`] >>
10872    `2 <= b /\ (0 < b) /\ (0 < 2)` by decide_tac >>
10873    `n DIV b <= n DIV 2` by rw[DIV_LE_MONOTONE_REVERSE] >>
10874    decide_tac
10875  ]
10876QED
10877
10878(* Theorem: (less_divisors n) SUBSET (natural (n DIV 2)) *)
10879(* Proof:
10880   Let s = less_divisors n
10881   If n = 0 or n - 1,
10882   Then s = {}                        by less_divisors_0, less_divisors_1
10883    and {} SUBSET t, for any t.       by EMPTY_SUBSET
10884   If n <> 0 and n <> 1, 1 < n.
10885   Note FINITE s                      by less_divisors_finite
10886    and x IN s ==> x <= MAX_SET s     by MAX_SET_PROPERTY, FINITE s
10887    But MAX_SET s <= n DIV 2          by less_divisors_max
10888   Thus x IN s ==> x <= n DIV 2       by LESS_EQ_TRANS
10889   Note s <> {}                       by MEMBER_NOT_EMPTY, x IN s
10890    and x IN s ==> MIN_SET s <= x     by MIN_SET_PROPERTY, s <> {}
10891  Since 1 = MIN_SET s, 1 <= x         by less_divisors_min, 1 < n
10892   Thus 0 < x <= n DIV 2              by LESS_EQ
10893     or x IN (natural (n DIV 2))      by natural_element
10894*)
10895Theorem less_divisors_subset_natural:
10896    !n. (less_divisors n) SUBSET (natural (n DIV 2))
10897Proof
10898  rpt strip_tac >>
10899  qabbrev_tac `s = less_divisors n` >>
10900  qabbrev_tac `m = n DIV 2` >>
10901  Cases_on `(n = 0) \/ (n = 1)` >-
10902  metis_tac[less_divisors_0, less_divisors_1, EMPTY_SUBSET] >>
10903  `1 < n` by decide_tac >>
10904  rw_tac std_ss[SUBSET_DEF] >>
10905  `s <> {}` by metis_tac[MEMBER_NOT_EMPTY] >>
10906  `FINITE s` by rw[less_divisors_finite, Abbr`s`] >>
10907  `x <= MAX_SET s` by rw[MAX_SET_PROPERTY] >>
10908  `MIN_SET s <= x` by rw[MIN_SET_PROPERTY] >>
10909  `MAX_SET s <= m` by rw[less_divisors_max, Abbr`s`, Abbr`m`] >>
10910  `MIN_SET s = 1` by rw[less_divisors_min, Abbr`s`] >>
10911  `0 < x /\ x <= m` by decide_tac >>
10912  rw[natural_element]
10913QED
10914
10915(* ------------------------------------------------------------------------- *)
10916(* Properties of Summation equals Perfect Power                              *)
10917(* ------------------------------------------------------------------------- *)
10918
10919(* Idea for the theorem below (for m = n DIV 2 when applied in bounds):
10920      p * (p ** m - 1) / (p - 1)
10921   <  p * p ** m / (p - 1)        discard subtraction
10922   <= p * p ** m / (p / 2)        replace by smaller denominator
10923    = 2 * p ** m                  double division and cancel p
10924   or p * (p ** m - 1) < (p - 1) * 2 * p ** m
10925*)
10926
10927(* Theorem: 1 < p ==> !n. p * (p ** n - 1) < (p - 1) * (2 * p ** n) *)
10928(* Proof:
10929   Let q = p ** n
10930   Then 1 <= q                       by ONE_LE_EXP, 0 < p
10931     so p <= p * q                   by LE_MULT_LCANCEL, p <> 0
10932   Also 1 < p ==> 2 <= p             by LESS_EQ
10933     so 2 * q <= p * q               by LE_MULT_RCANCEL, q <> 0
10934   Thus   LHS
10935        = p * (q - 1)
10936        = p * q - p                  by LEFT_SUB_DISTRIB
10937    And   RHS
10938        = (p - 1) * (2 * q)
10939        = p * (2 * q) - 2 * q        by RIGHT_SUB_DISTRIB
10940        = 2 * (p * q) - 2 * q        by MULT_ASSOC, MULT_COMM
10941        = (p * q + p * q) - 2 * q    by TIMES2
10942        = (p * q - p + p + p * q) - 2 * q  by SUB_ADD, p <= p * q
10943        = LHS + p + p * q - 2 * q    by above
10944        = LHS + p + (p * q - 2 * q)  by LESS_EQ_ADD_SUB, 2 * q <= p * q
10945        = LHS + p + (p - 2) * q      by RIGHT_SUB_DISTRIB
10946
10947    Since 0 < p                      by 1 < p
10948      and 0 <= (p - 2) * q           by 2 <= p
10949    Hence LHS < RHS                  by discarding positive terms
10950*)
10951Theorem perfect_power_special_inequality:
10952    !p. 1 < p ==> !n. p * (p ** n - 1) < (p - 1) * (2 * p ** n)
10953Proof
10954  rpt strip_tac >>
10955  qabbrev_tac `q = p ** n` >>
10956  `p <> 0 /\ 2 <= p` by decide_tac >>
10957  `1 <= q` by rw[ONE_LE_EXP, Abbr`q`] >>
10958  `p <= p * q` by rw[] >>
10959  `2 * q <= p * q` by rw[] >>
10960  qabbrev_tac `l = p * (q - 1)` >>
10961  qabbrev_tac `r = (p - 1) * (2 * q)` >>
10962  `l = p * q - p` by rw[Abbr`l`] >>
10963  `r = p * (2 * q) - 2 * q` by rw[Abbr`r`] >>
10964  `_ = 2 * (p * q) - 2 * q` by rw[] >>
10965  `_ = (p * q + p * q) - 2 * q` by rw[] >>
10966  `_ = (p * q - p + p + p * q) - 2 * q` by rw[] >>
10967  `_ = l + p + p * q - 2 * q` by rw[] >>
10968  `_ = l + p + (p * q - 2 * q)` by rw[] >>
10969  `_ = l + p + (p - 2) * q` by rw[] >>
10970  decide_tac
10971QED
10972
10973(* Theorem: 1 < p /\ 1 < n ==>
10974            p ** (n DIV 2) * p ** (n DIV 2) <= p ** n /\
10975            2 * p ** (n DIV 2) <= p ** (n DIV 2) * p ** (n DIV 2) *)
10976(* Proof:
10977   Let m = n DIV 2, q = p ** m.
10978   The goal becomes: q * q <= p ** n /\ 2 * q <= q * q.
10979      Note 1 < p ==> 0 < p.
10980   First goal: q * q <= p ** n
10981      Then 0 < q                    by EXP_POS, 0 < p
10982       and 2 * m <= n               by DIV_MULT_LE, 0 < 2.
10983      thus p ** (2 * m) <= p ** n   by EXP_BASE_LE_MONO, 1 < p.
10984     Since p ** (2 * m)
10985         = p ** (m + m)             by TIMES2
10986         = q * q                    by EXP_ADD
10987      Thus q * q <= p ** n          by above
10988
10989   Second goal: 2 * q <= q * q
10990     Since 1 < n, so 2 <= n         by LESS_EQ
10991        so 2 DIV 2 <= n DIV 2       by DIV_LE_MONOTONE, 0 < 2.
10992        or 1 <= m, i.e. 0 < m       by DIVMOD_ID, 0 < 2.
10993      Thus 1 < q                    by ONE_LT_EXP, 1 < p, 0 < m.
10994        so 2 <= q                   by LESS_EQ
10995       and 2 * q <= q * q           by MULT_RIGHT_CANCEL, q <> 0.
10996     Hence 2 * q <= p ** n          by LESS_EQ_TRANS
10997*)
10998Theorem perfect_power_half_inequality_lemma[local]:
10999    !p n. 1 < p /\ 1 < n ==>
11000         p ** (n DIV 2) * p ** (n DIV 2) <= p ** n /\
11001         2 * p ** (n DIV 2) <= p ** (n DIV 2) * p ** (n DIV 2)
11002Proof
11003  ntac 3 strip_tac >>
11004  qabbrev_tac `m = n DIV 2` >>
11005  qabbrev_tac `q = p ** m` >>
11006  strip_tac >| [
11007    `0 < p /\ 0 < 2` by decide_tac >>
11008    `0 < q /\ q <> 0` by rw[EXP_POS, Abbr`q`] >>
11009    `2 * m <= n` by metis_tac[DIV_MULT_LE, MULT_COMM] >>
11010    `p ** (2 * m) <= p ** n` by rw[EXP_BASE_LE_MONO] >>
11011    `p ** (2 * m) = p ** (m + m)` by rw[] >>
11012    `_ = q * q` by rw[EXP_ADD, Abbr`q`] >>
11013    decide_tac,
11014    `2 <= n /\ 0 < 2` by decide_tac >>
11015    `1 <= m` by metis_tac[DIV_LE_MONOTONE, DIVMOD_ID] >>
11016    `0 < m` by decide_tac >>
11017    `1 < q` by rw[ONE_LT_EXP, Abbr`q`] >>
11018    rw[]
11019  ]
11020QED
11021
11022(* Theorem: 1 < p /\ 0 < n ==> 2 * p ** (n DIV 2) <= p ** n *)
11023(* Proof:
11024   Let m = n DIV 2, q = p ** m.
11025   The goal becomes: 2 * q <= p ** n
11026   If n = 1,
11027      Then m = 0                    by ONE_DIV, 0 < 2.
11028       and q = 1                    by EXP
11029       and p ** n = p               by EXP_1
11030     Since 1 < p ==> 2 <= p         by LESS_EQ
11031     Hence 2 * q <= p = p ** n      by MULT_RIGHT_1
11032   If n <> 1, 1 < n.
11033      Then q * q <= p ** n /\
11034           2 * q <= q * q           by perfect_power_half_inequality_lemma
11035     Hence 2 * q <= p ** n          by LESS_EQ_TRANS
11036*)
11037Theorem perfect_power_half_inequality_1:
11038    !p n. 1 < p /\ 0 < n ==> 2 * p ** (n DIV 2) <= p ** n
11039Proof
11040  rpt strip_tac >>
11041  qabbrev_tac `m = n DIV 2` >>
11042  qabbrev_tac `q = p ** m` >>
11043  Cases_on `n = 1` >| [
11044    `m = 0` by rw[Abbr`m`] >>
11045    `(q = 1) /\ (p ** n = p)` by rw[Abbr`q`] >>
11046    `2 <= p` by decide_tac >>
11047    rw[],
11048    `1 < n` by decide_tac >>
11049    `q * q <= p ** n /\ 2 * q <= q * q` by rw[perfect_power_half_inequality_lemma, Abbr`q`, Abbr`m`] >>
11050    decide_tac
11051  ]
11052QED
11053
11054(* Theorem: 1 < p /\ 0 < n ==> (p ** (n DIV 2) - 2) * p ** (n DIV 2) <= p ** n - 2 * p ** (n DIV 2) *)
11055(* Proof:
11056   Let m = n DIV 2, q = p ** m.
11057   The goal becomes: (q - 2) * q <= p ** n - 2 * q
11058   If n = 1,
11059      Then m = 0                    by ONE_DIV, 0 < 2.
11060       and q = 1                    by EXP
11061       and p ** n = p               by EXP_1
11062     Since 1 < p ==> 2 <= p         by LESS_EQ
11063        or 0 <= p - 2               by SUB_LEFT_LESS_EQ
11064     Hence (q - 2) * q = 0 <= p - 2
11065   If n <> 1, 1 < n.
11066      Then q * q <= p ** n /\ 2 * q <= q * q   by perfect_power_half_inequality_lemma
11067      Thus q * q - 2 * q <= p ** n - 2 * q     by LE_SUB_RCANCEL, 2 * q <= q * q
11068        or   (q - 2) * q <= p ** n - 2 * q     by RIGHT_SUB_DISTRIB
11069*)
11070Theorem perfect_power_half_inequality_2:
11071    !p n. 1 < p /\ 0 < n ==> (p ** (n DIV 2) - 2) * p ** (n DIV 2) <= p ** n - 2 * p ** (n DIV 2)
11072Proof
11073  rpt strip_tac >>
11074  qabbrev_tac `m = n DIV 2` >>
11075  qabbrev_tac `q = p ** m` >>
11076  Cases_on `n = 1` >| [
11077    `m = 0` by rw[Abbr`m`] >>
11078    `(q = 1) /\ (p ** n = p)` by rw[Abbr`q`] >>
11079    `0 <= p - 2 /\ (1 - 2 = 0)` by decide_tac >>
11080    rw[],
11081    `1 < n` by decide_tac >>
11082    `q * q <= p ** n /\ 2 * q <= q * q` by rw[perfect_power_half_inequality_lemma, Abbr`q`, Abbr`m`] >>
11083    decide_tac
11084  ]
11085QED
11086
11087(* Already in pred_setTheory:
11088SUM_IMAGE_SUBSET_LE;
11089!f s t. FINITE s /\ t SUBSET s ==> SIGMA f t <= SIGMA f s: thm
11090SUM_IMAGE_MONO_LESS_EQ;
11091|- !s. FINITE s ==> (!x. x IN s ==> f x <= g x) ==> SIGMA f s <= SIGMA g s: thm
11092*)
11093
11094(* Theorem: 1 < p ==> !f. (!n. 0 < n ==> (p ** n = SIGMA (\d. d * f d) (divisors n))) ==>
11095            (!n. 0 < n ==> n * (f n) <= p ** n) /\
11096            (!n. 0 < n ==> p ** n - 2 * p ** (n DIV 2) < n * (f n)) *)
11097(* Proof:
11098   Step 1: prove a specific lemma for sum decomposition
11099   Claim: !n. 0 < n ==> (divisors n DIFF {n}) SUBSET (natural (n DIV 2)) /\
11100          (p ** n = SIGMA (\d. d * f d) (divisors n)) ==>
11101          (p ** n = n * f n + SIGMA (\d. d * f d) (divisors n DIFF {n}))
11102   Proof: Let s = divisors n, a = {n}, b = s DIFF a, m = n DIV 2.
11103          Then b = less_divisors n        by EXTENSION,IN_DIFF
11104           and b SUBSET (natural m)       by less_divisors_subset_natural
11105          This gives the first part.
11106          For the second part:
11107          Note a SUBSET s                 by divisors_has_last, SUBSET_DEF
11108           and b SUBSET s                 by DIFF_SUBSET
11109          Thus s = b UNION a              by UNION_DIFF, a SUBSET s
11110           and DISJOINT b a               by DISJOINT_DEF, EXTENSION
11111           Now FINITE s                   by divisors_finite
11112            so FINITE a /\ FINITE b       by SUBSET_FINITE, by a SUBSEt s /\ b SUBSET s
11113
11114               p ** n
11115             = SIGMA (\d. d * f d) s              by implication
11116             = SIGMA (\d. d * f d) (b UNION a)    by above, s = b UNION a
11117             = SIGMA (\d. d * f d) b + SIGMA (\d. d * f d) a   by SUM_IMAGE_DISJOINT, FINITE a /\ FINITE b
11118             = SIGMA (\d. d * f d) b + n * f n    by SUM_IMAGE_SING
11119             = n * f n + SIGMA (\d. d * f d) b    by ADD_COMM
11120          This gives the second part.
11121
11122   Step 2: Upper bound, to show: !n. 0 < n ==> n * f n <= p ** n
11123           Let b = divisors n DIFF {n}
11124           Since n * f n + SIGMA (\d. d * f d) b = p ** n    by lemma
11125           Hence n * f n <= p ** n                           by 0 <= SIGMA (\d. d * f d) b
11126
11127   Step 3: Lower bound, to show: !n. 0 < n ==> p ** n - p ** (n DIV 2) <= n * f n
11128           Let s = divisors n, a = {n}, b = s DIFF a, m = n DIV 2.
11129            Note b SUBSET (natural m) /\
11130                 (p ** n = n * f n + SIGMA (\d. d * f d) b)  by lemma
11131           Since FINITE (natural m)                          by natural_finite
11132            thus SIGMA (\d. d * f d) b
11133              <= SIGMA (\d. d * f d) (natural m)             by SUM_IMAGE_SUBSET_LE [1]
11134            Also !d. d IN (natural m) ==> 0 < d              by natural_element
11135             and !d. 0 < d ==> d * f d <= p ** d             by upper bound (Step 2)
11136            thus !d. d IN (natural m) ==> d * f d <= p ** d  by implication
11137           Hence SIGMA (\d. d * f d) (natural m)
11138              <= SIGMA (\d. p ** d) (natural m)              by SUM_IMAGE_MONO_LESS_EQ [2]
11139             Now 1 < p ==> 0 < p /\ (p - 1) <> 0             by arithmetic
11140
11141             (p - 1) * SIGMA (\d. d * f d) b
11142          <= (p - 1) * SIGMA (\d. d * f d) (natural m)       by LE_MULT_LCANCEL, [1]
11143          <= (p - 1) * SIGMA (\d. p ** d) (natural m)        by LE_MULT_LCANCEL, [2]
11144           = p * (p ** m - 1)                                by sigma_geometric_natural_eqn
11145           < (p - 1) * (2 * p ** m)                          by perfect_power_special_inequality
11146
11147             (p - 1) * SIGMA (\d. d * f d) b < (p - 1) * (2 * p ** m)   by LESS_EQ_LESS_TRANS
11148             or        SIGMA (\d. d * f d) b < 2 * p ** m               by LT_MULT_LCANCEL, (p - 1) <> 0
11149
11150            But 2 * p ** m <= p ** n                         by perfect_power_half_inequality_1, 1 < p, 0 < n
11151           Thus p ** n = p ** n - 2 * p ** m + 2 * p ** m    by SUB_ADD, 2 * p ** m <= p ** n
11152       Combinig with lemma,
11153           p ** n - 2 * p ** m + 2 * p ** m < n * f n + 2 * p ** m
11154             or         p ** n - 2 * p ** m < n * f n        by LESS_MONO_ADD_EQ, no condition
11155*)
11156Theorem sigma_eq_perfect_power_bounds_1:
11157  !p.
11158    1 < p ==>
11159    !f. (!n. 0 < n ==> (p ** n = SIGMA (\d. d * f d) (divisors n))) ==>
11160        (!n. 0 < n ==> n * (f n) <= p ** n) /\
11161        (!n. 0 < n ==> p ** n - 2 * p ** (n DIV 2) < n * (f n))
11162Proof
11163  ntac 4 strip_tac >>
11164  ‘!n. 0 < n ==>
11165       (divisors n DIFF {n}) SUBSET (natural (n DIV 2)) /\
11166       (p ** n = SIGMA (\d. d * f d) (divisors n) ==>
11167        p ** n = n * f n + SIGMA (\d. d * f d) (divisors n DIFF {n}))’
11168    by (ntac 2 strip_tac >>
11169        qabbrev_tac `s = divisors n` >>
11170        qabbrev_tac `a = {n}` >>
11171        qabbrev_tac `b = s DIFF a` >>
11172        qabbrev_tac `m = n DIV 2` >>
11173        `b = less_divisors n` by rw[EXTENSION, Abbr`b`, Abbr`a`, Abbr`s`] >>
11174        `b SUBSET (natural m)` by metis_tac[less_divisors_subset_natural] >>
11175        strip_tac >- rw[] >>
11176        `a SUBSET s` by rw[divisors_has_last, SUBSET_DEF, Abbr`s`, Abbr`a`] >>
11177        `b SUBSET s` by rw[Abbr`b`] >>
11178        `s = b UNION a` by rw[UNION_DIFF, Abbr`b`] >>
11179        `DISJOINT b a`
11180          by (rw[DISJOINT_DEF, Abbr`b`, EXTENSION] >> metis_tac[]) >>
11181        `FINITE s` by rw[divisors_finite, Abbr`s`] >>
11182        `FINITE a /\ FINITE b` by metis_tac[SUBSET_FINITE] >>
11183        strip_tac >>
11184        `_ = SIGMA (\d. d * f d) (b UNION a)` by metis_tac[Abbr`s`] >>
11185        `_ = SIGMA (\d. d * f d) b + SIGMA (\d. d * f d) a`
11186          by rw[SUM_IMAGE_DISJOINT] >>
11187        `_ = SIGMA (\d. d * f d) b + n * f n` by rw[SUM_IMAGE_SING, Abbr`a`] >>
11188        rw[]) >>
11189  conj_asm1_tac >| [
11190    rpt strip_tac >>
11191    `p ** n = n * f n + SIGMA (\d. d * f d) (divisors n DIFF {n})` by rw[] >>
11192    decide_tac,
11193    rpt strip_tac >>
11194    qabbrev_tac `s = divisors n` >>
11195    qabbrev_tac `a = {n}` >>
11196    qabbrev_tac `b = s DIFF a` >>
11197    qabbrev_tac `m = n DIV 2` >>
11198    `b SUBSET (natural m) /\ (p ** n = n * f n + SIGMA (\d. d * f d) b)`
11199      by rw[Abbr`s`, Abbr`a`, Abbr`b`, Abbr`m`] >>
11200    `FINITE (natural m)` by rw[natural_finite] >>
11201    `SIGMA (\d. d * f d) b <= SIGMA (\d. d * f d) (natural m)`
11202      by rw[SUM_IMAGE_SUBSET_LE] >>
11203    `!d. d IN (natural m) ==> 0 < d` by rw[natural_element] >>
11204    `SIGMA (\d. d * f d) (natural m) <= SIGMA (\d. p ** d) (natural m)`
11205      by rw[SUM_IMAGE_MONO_LESS_EQ] >>
11206    `0 < p /\ (p - 1) <> 0` by decide_tac >>
11207    `(p - 1) * SIGMA (\d. p ** d) (natural m) = p * (p ** m - 1)`
11208      by rw[sigma_geometric_natural_eqn] >>
11209    `p * (p ** m - 1) < (p - 1) * (2 * p ** m)`
11210      by rw[perfect_power_special_inequality] >>
11211    `SIGMA (\d. d * f d) b < 2 * p ** m`
11212      by metis_tac[LE_MULT_LCANCEL, LESS_EQ_TRANS, LESS_EQ_LESS_TRANS,
11213                   LT_MULT_LCANCEL] >>
11214    `p ** n < n * f n + 2 * p ** m` by decide_tac >>
11215    `2 * p ** m <= p ** n` by rw[perfect_power_half_inequality_1, Abbr`m`] >>
11216    decide_tac
11217  ]
11218QED
11219
11220(* Theorem: 1 < p ==> !f. (!n. 0 < n ==> (p ** n = SIGMA (\d. d * f d) (divisors n))) ==>
11221            (!n. 0 < n ==> n * (f n) <= p ** n) /\
11222            (!n. 0 < n ==> (p ** (n DIV 2) - 2) * p ** (n DIV 2) < n * (f n)) *)
11223(* Proof:
11224   For the first goal: (!n. 0 < n ==> n * (f n) <= p ** n)
11225       True by sigma_eq_perfect_power_bounds_1.
11226   For the second goal: (!n. 0 < n ==> (p ** (n DIV 2) - 2) * p ** (n DIV 2) < n * (f n))
11227       Let m = n DIV 2.
11228       Then p ** n - 2 * p ** m < n * (f n)                     by sigma_eq_perfect_power_bounds_1
11229        and (p ** m - 2) * p ** m <= p ** n - 2 * p ** m        by perfect_power_half_inequality_2
11230      Hence (p ** (n DIV 2) - 2) * p ** (n DIV 2) < n * (f n)   by LESS_EQ_LESS_TRANS
11231*)
11232Theorem sigma_eq_perfect_power_bounds_2:
11233    !p. 1 < p ==> !f. (!n. 0 < n ==> (p ** n = SIGMA (\d. d * f d) (divisors n))) ==>
11234   (!n. 0 < n ==> n * (f n) <= p ** n) /\
11235   (!n. 0 < n ==> (p ** (n DIV 2) - 2) * p ** (n DIV 2) < n * (f n))
11236Proof
11237  rpt strip_tac >-
11238  rw[sigma_eq_perfect_power_bounds_1] >>
11239  qabbrev_tac `m = n DIV 2` >>
11240  `p ** n - 2 * p ** m < n * (f n)` by rw[sigma_eq_perfect_power_bounds_1, Abbr`m`] >>
11241  `(p ** m - 2) * p ** m <= p ** n - 2 * p ** m` by rw[perfect_power_half_inequality_2, Abbr`m`] >>
11242  decide_tac
11243QED
11244
11245(* This is a milestone theorem. *)
11246
11247(* ------------------------------------------------------------------------- *)