combinatoricsScript.sml
1(* ------------------------------------------------------------------------- *)
2(* Combinatorics Theory *)
3(* (Combined theory of Euler, Gauss, Mobius, triangle and binomial, etc., *)
4(* originally under "examples/algebra/lib") *)
5(* *)
6(* Author: (Joseph) Hing-Lun Chan (Australian National University, 2019) *)
7(* ------------------------------------------------------------------------- *)
8
9(* ------------------------------------------------------------------------- *)
10(* Necklace Theory - monocoloured and multicoloured. *)
11(* ------------------------------------------------------------------------- *)
12(*
13
14Necklace Theory
15===============
16
17Consider the set N of necklaces of length n (i.e. with number of beads = n)
18with a colors (i.e. the number of bead colors = a). A linear picture of such
19a necklace is:
20
21+--+--+--+--+--+--+--+
22|2 |4 |0 |3 |1 |2 |3 | p = 7, with (lots of) beads of a = 5 colors: 01234.
23+--+--+--+--+--+--+--+
24
25Since a bead can have any of the a colors, and there are n beads in total,
26
27Number of such necklaces = CARD N = a*a*...*a = a^n.
28
29There is only 1 necklace of pure color A, 1 necklace with pure color B, etc.
30
31Number of monocoloured necklaces = a = CARD S, where S = monocoloured necklaces.
32
33So, N = S UNION M, where M = multicoloured necklaces (i.e. more than one color).
34
35Since S and M are disjoint, CARD M = CARD N - CARD S = a^n - a.
36
37*)
38Theory combinatorics
39Ancestors
40 prim_rec arithmetic divides gcd gcdset logroot pred_set list
41 rich_list number listRange indexedLists relation
42
43
44Overload SQ[local] = ``\n. n * n``
45Overload HALF[local] = ``\n. n DIV 2``
46Overload TWICE[local] = ``\n. 2 * n``
47
48(* ------------------------------------------------------------------------- *)
49(* List Reversal. *)
50(* ------------------------------------------------------------------------- *)
51
52(* Overload for REVERSE [m .. n] *)
53Overload downto = ``\n m. REVERSE [m .. n]``
54val _ = set_fixity "downto" (Infix(NONASSOC, 450)); (* same as relation *)
55
56(* ------------------------------------------------------------------------- *)
57(* Extra List Theorems *)
58(* ------------------------------------------------------------------------- *)
59
60(* Theorem: EVERY (\c. c IN R) p ==> !k. k < LENGTH p ==> EL k p IN R *)
61(* Proof: by EVERY_EL. *)
62Theorem EVERY_ELEMENT_PROPERTY:
63 !p R. EVERY (\c. c IN R) p ==> !k. k < LENGTH p ==> EL k p IN R
64Proof
65 rw[EVERY_EL]
66QED
67
68(* Theorem: (!x. P x ==> (Q o f) x) /\ EVERY P l ==> EVERY Q (MAP f l) *)
69(* Proof:
70 Since !x. P x ==> (Q o f) x,
71 EVERY P l
72 ==> EVERY Q o f l by EVERY_MONOTONIC
73 ==> EVERY Q (MAP f l) by EVERY_MAP
74*)
75Theorem EVERY_MONOTONIC_MAP:
76 !l f P Q. (!x. P x ==> (Q o f) x) /\ EVERY P l ==> EVERY Q (MAP f l)
77Proof
78 metis_tac[EVERY_MONOTONIC, EVERY_MAP]
79QED
80
81(* Theorem: EVERY (\j. j < n) ls ==> EVERY (\j. j <= n) ls *)
82(* Proof: by EVERY_EL, arithmetic. *)
83Theorem EVERY_LT_IMP_EVERY_LE:
84 !ls n. EVERY (\j. j < n) ls ==> EVERY (\j. j <= n) ls
85Proof
86 simp[EVERY_EL, LESS_IMP_LESS_OR_EQ]
87QED
88
89(* Theorem: (LENGTH (h1::t1) = LENGTH (h2::t2)) /\
90 (!k. k < LENGTH (h1::t1) ==> P (EL k (h1::t1)) (EL k (h2::t2))) ==>
91 (P h1 h2) /\ (!k. k < LENGTH t1 ==> P (EL k t1) (EL k t2)) *)
92(* Proof:
93 Put k = 0,
94 Then LENGTH (h1::t1) = SUC (LENGTH t1) by LENGTH
95 > 0 by SUC_POS
96 and P (EL 0 (h1::t1)) (EL 0 (h2::t2)) by implication, 0 < LENGTH (h1::t1)
97 or P HD (h1::t1) HD (h2::t2) by EL
98 or P h1 h2 by HD
99 Note k < LENGTH t1
100 ==> k + 1 < SUC (LENGTH t1) by ADD1
101 = LENGTH (h1::t1) by LENGTH
102 Thus P (EL (k + 1) (h1::t1)) (EL (k + 1) (h2::t2)) by implication
103 or P (EL (PRE (k + 1) t1)) (EL (PRE (k + 1)) t2) by EL_CONS
104 or P (EL k t1) (EL k t2) by PRE, ADD1
105*)
106Theorem EL_ALL_PROPERTY:
107 !h1 t1 h2 t2 P. (LENGTH (h1::t1) = LENGTH (h2::t2)) /\
108 (!k. k < LENGTH (h1::t1) ==> P (EL k (h1::t1)) (EL k (h2::t2))) ==>
109 (P h1 h2) /\ (!k. k < LENGTH t1 ==> P (EL k t1) (EL k t2))
110Proof
111 rpt strip_tac >| [
112 `0 < LENGTH (h1::t1)` by metis_tac[LENGTH, SUC_POS] >>
113 metis_tac[EL, HD],
114 `k + 1 < SUC (LENGTH t1)` by decide_tac >>
115 `k + 1 < LENGTH (h1::t1)` by metis_tac[LENGTH] >>
116 `0 < k + 1 /\ (PRE (k + 1) = k)` by decide_tac >>
117 metis_tac[EL_CONS]
118 ]
119QED
120
121(*
122LUPDATE_SEM |- (!e n l. LENGTH (LUPDATE e n l) = LENGTH l) /\
123 !e n l p. p < LENGTH l ==> EL p (LUPDATE e n l) = if p = n then e else EL p l
124EL_LUPDATE |- !ys x i k. EL i (LUPDATE x k ys) = if i = k /\ k < LENGTH ys then x else EL i ys
125LENGTH_LUPDATE |- !x n ys. LENGTH (LUPDATE x n ys) = LENGTH ys
126*)
127
128(* Extract useful theorem from LUPDATE semantics *)
129Theorem LUPDATE_LEN = LUPDATE_SEM |> CONJUNCT1;
130(* val LUPDATE_LEN = |- !e n l. LENGTH (LUPDATE e n l) = LENGTH l: thm *)
131Theorem LUPDATE_EL = LUPDATE_SEM |> CONJUNCT2;
132(* val LUPDATE_EL = |- !e n l p. p < LENGTH l ==> EL p (LUPDATE e n l) = if p = n then e else EL p l: thm *)
133
134(* Theorem: LUPDATE q n (LUPDATE p n ls) = LUPDATE q n ls *)
135(* Proof:
136 Let l1 = LUPDATE q n (LUPDATE p n ls), l2 = LUPDATE q n ls.
137 By LIST_EQ, this is to show:
138 (1) LENGTH l1 = LENGTH l2
139 LENGTH l1
140 = LENGTH (LUPDATE q n (LUPDATE p n ls)) by notation
141 = LENGTH (LUPDATE p n ls) by LUPDATE_LEN
142 = ls by LUPDATE_LEN
143 = LENGTH (LUPDATE q n ls) by LUPDATE_LEN
144 = LENGTH l2 by notation
145 (2) !x. x < LENGTH l1 ==> EL x l1 = EL x l2
146 EL x l1
147 = EL x (LUPDATE q n (LUPDATE p n ls)) by notation
148 = if x = n then q else EL x (LUPDATE p n ls) by LUPDATE_EL
149 = if x = n then q else (if x = n then p else EL x ls) by LUPDATE_EL
150 = if x = n then q else EL x ls by simplification
151 = EL x (LUPDATE q n ls) by LUPDATE_EL
152 = EL x l2 by notation
153*)
154Theorem LUPDATE_SAME_SPOT:
155 !ls n p q. LUPDATE q n (LUPDATE p n ls) = LUPDATE q n ls
156Proof
157 rpt strip_tac >>
158 qabbrev_tac `l1 = LUPDATE q n (LUPDATE p n ls)` >>
159 qabbrev_tac `l2 = LUPDATE q n ls` >>
160 `LENGTH l1 = LENGTH l2` by rw[LUPDATE_LEN, Abbr`l1`, Abbr`l2`] >>
161 `!x. x < LENGTH l1 ==> (EL x l1 = EL x l2)` by fs[LUPDATE_EL, Abbr`l1`, Abbr`l2`] >>
162 rw[LIST_EQ]
163QED
164
165(* Theorem: m <> n ==>
166 (LUPDATE q n (LUPDATE p m ls) = LUPDATE p m (LUPDATE q n ls)) *)
167(* Proof:
168 Let l1 = LUPDATE q n (LUPDATE p m ls),
169 l2 = LUPDATE p m (LUPDATE q n ls).
170 LENGTH l1
171 = LENGTH (LUPDATE q n (LUPDATE p m ls)) by notation
172 = LENGTH (LUPDATE p m ls) by LUPDATE_LEN
173 = LENGTH ls by LUPDATE_LEN
174 = LENGTH (LUPDATE q n ls) by LUPDATE_LEN
175 = LENGTH (LUPDATE p m (LUPDATE q n ls)) by LUPDATE_LEN
176 = LENGTH l2 by notation
177 !x. x < LENGTH l1 ==>
178 EL x l1
179 = EL x ((LUPDATE q n (LUPDATE p m ls)) by notation
180 = EL x ls if x <> n, x <> m, or p if x = m, q if x = n
181 by LUPDATE_EL
182 EL x l2
183 = EL x ((LUPDATE p m (LUPDATE q n ls)) by notation
184 = EL x ls if x <> m, x <> n, or q if x = n, p if x = m
185 by LUPDATE_EL
186 = EL x l1
187 Hence l1 = l2 by LIST_EQ
188*)
189Theorem LUPDATE_DIFF_SPOT:
190 !ls m n p q. m <> n ==>
191 (LUPDATE q n (LUPDATE p m ls) = LUPDATE p m (LUPDATE q n ls))
192Proof
193 rpt strip_tac >>
194 qabbrev_tac `l1 = LUPDATE q n (LUPDATE p m ls)` >>
195 qabbrev_tac `l2 = LUPDATE p m (LUPDATE q n ls)` >>
196 irule LIST_EQ >>
197 rw[LUPDATE_EL, Abbr`l1`, Abbr`l2`]
198QED
199
200(* Theorem: LUPDATE a (LENGTH ls) (ls ++ (h::t)) = ls ++ (a::t) *)
201(* Proof:
202 LUPDATE a (LENGTH ls) (ls ++ h::t)
203 = ls ++ LUPDATE a (LENGTH ls - LENGTH ls) (h::t) by LUPDATE_APPEND2
204 = ls ++ LUPDATE a 0 (h::t) by arithmetic
205 = ls ++ (a::t) by LUPDATE_def
206*)
207Theorem LUPDATE_APPEND_0:
208 !ls a h t. LUPDATE a (LENGTH ls) (ls ++ (h::t)) = ls ++ (a::t)
209Proof
210 rw_tac std_ss[LUPDATE_APPEND2, LUPDATE_def]
211QED
212
213(* Theorem: LUPDATE b (LENGTH ls + 1) (ls ++ h::k::t) = ls ++ h::b::t *)
214(* Proof:
215 LUPDATE b (LENGTH ls + 1) (ls ++ h::k::t)
216 = ls ++ LUPDATE b (LENGTH ls + 1 - LENGTH ls) (h::k::t) by LUPDATE_APPEND2
217 = ls ++ LUPDATE b 1 (h::k::t) by arithmetic
218 = ls ++ (h::b::t) by LUPDATE_def
219*)
220Theorem LUPDATE_APPEND_1:
221 !ls b h k t. LUPDATE b (LENGTH ls + 1) (ls ++ h::k::t) = ls ++ h::b::t
222Proof
223 rpt strip_tac >>
224 `LUPDATE b 1 (h::k::t) = h::LUPDATE b 0 (k::t)` by rw[GSYM LUPDATE_def] >>
225 `_ = h::b::t` by rw[LUPDATE_def] >>
226 `LUPDATE b (LENGTH ls + 1) (ls ++ h::k::t) =
227 ls ++ LUPDATE b (LENGTH ls + 1 - LENGTH ls) (h::k::t)` by metis_tac[LUPDATE_APPEND2, DECIDE``n <= n + 1``] >>
228 fs[]
229QED
230
231(* Theorem: LUPDATE b (LENGTH ls + 1)
232 (LUPDATE a (LENGTH ls) (ls ++ h::k::t)) = ls ++ a::b::t *)
233(* Proof:
234 Let l1 = LUPDATE a (LENGTH ls) (ls ++ h::k::t)
235 = ls ++ a::k::t by LUPDATE_APPEND_0
236 LUPDATE b (LENGTH ls + 1) l1
237 = LUPDATE b (LENGTH ls + 1) (ls ++ a::k::t)
238 = ls ++ a::b::t by LUPDATE_APPEND2_1
239*)
240Theorem LUPDATE_APPEND_0_1:
241 !ls a b h k t.
242 LUPDATE b (LENGTH ls + 1)
243 (LUPDATE a (LENGTH ls) (ls ++ h::k::t)) = ls ++ a::b::t
244Proof
245 rw_tac std_ss[LUPDATE_APPEND_0, LUPDATE_APPEND_1]
246QED
247
248(* Theorem: let fs = FILTER P ls in
249 ALL_DISTINCT ls /\ ls = l1 ++ x::l2 ++ y::l3 /\ P x /\ P y ==>
250 (findi y fs = 1 + findi x fs <=> FILTER P l2 = []) *)
251(* Proof:
252 Let j = LENGTH (FILTER P l1).
253
254 Note fs = FILTER P l1 ++ x::FILTER P l2 ++
255 y::FILTER P l3 by FILTER_APPEND_DISTRIB
256 Thus LENGTH fs = j +
257 SUC (LENGTH (FILTER P l2)) +
258 SUC (LENGTH (FILTER P l3)) by LENGTH_APPEND
259 or j + 2 <= LENGTH fs by arithmetic
260 or j < LENGTH fs /\ j + 1 < LENGTH fs by j + 2 <= LENGTH fs
261
262 Let l4 = y::l3,
263 Then ls = l1 ++ x::l2 ++ l4
264 = l1 ++ x::(l2 ++ l4) by APPEND_ASSOC_CONS
265 ==> x = EL j fs by FILTER_EL_IMP
266
267 Note ALL_DISTINCT fs by FILTER_ALL_DISTINCT
268 and MEM x ls /\ MEM y ls by MEM_APPEND
269 so MEM x fs /\ MEM y fs by MEM_FILTER
270 and x = EL j fs <=> findi x fs = j by findi_EL_iff
271 and y = EL (j + 1) fs <=> findi y fs = j + 1 by findi_EL_iff
272
273 FILTER P l2 = []
274 <=> x = EL j fs /\ y = EL (j + 1) fs by FILTER_EL_NEXT_IFF
275 <=> findi y fs = 1 + findi x fs by above
276*)
277Theorem FILTER_EL_NEXT_IDX:
278 !P ls l1 l2 l3 x y. let fs = FILTER P ls in
279 ALL_DISTINCT ls /\ ls = l1 ++ x::l2 ++ y::l3 /\ P x /\ P y ==>
280 (findi y fs = 1 + findi x fs <=> FILTER P l2 = [])
281Proof
282 rw_tac std_ss[] >>
283 qabbrev_tac `ls = l1 ++ x::l2 ++ y::l3` >>
284 qabbrev_tac `j = LENGTH (FILTER P l1)` >>
285 `j + 2 <= LENGTH fs` by
286 (`fs = FILTER P l1 ++ x::FILTER P l2 ++ y::FILTER P l3` by simp[FILTER_APPEND_DISTRIB, Abbr`fs`, Abbr`ls`] >>
287 `LENGTH fs = j + SUC (LENGTH (FILTER P l2)) + SUC (LENGTH (FILTER P l3))` by fs[Abbr`j`] >>
288 decide_tac) >>
289 `j < LENGTH fs /\ j + 1 < LENGTH fs` by decide_tac >>
290 `x = EL j fs` by
291 (qabbrev_tac `l4 = y::l3` >>
292 `ls = l1 ++ x::(l2 ++ l4)` by simp[Abbr`ls`] >>
293 metis_tac[FILTER_EL_IMP]) >>
294 `MEM x ls /\ MEM y ls` by fs[Abbr`ls`] >>
295 `MEM x fs /\ MEM y fs` by fs[MEM_FILTER, Abbr`fs`] >>
296 `ALL_DISTINCT fs` by simp[FILTER_ALL_DISTINCT, Abbr`fs`] >>
297 `x = EL j fs <=> findi x fs = j` by fs[findi_EL_iff] >>
298 `y = EL (j + 1) fs <=> findi y fs = 1 + j` by fs[findi_EL_iff] >>
299 metis_tac[FILTER_EL_NEXT_IFF]
300QED
301
302(* ------------------------------------------------------------------------- *)
303(* List Rotation. *)
304(* ------------------------------------------------------------------------- *)
305
306(* Define rotation of a list *)
307Definition rotate_def:
308 rotate n l = DROP n l ++ TAKE n l
309End
310
311(* Theorem: Rotate shifts element
312 rotate n l = EL n l::(DROP (SUC n) l ++ TAKE n l) *)
313(* Proof:
314 h h t t t t t t --> t t t t t h h
315 k k
316 TAKE 2 x = h h
317 DROP 2 x = t t t t t t
318 k
319 DROP 2 x ++ TAKE 2 x has element k at front.
320
321 Proof: by induction on l.
322 Base case: !n. n < LENGTH [] ==> (DROP n [] = EL n []::DROP (SUC n) [])
323 Since n < LENGTH [] = 0 is F, this is true.
324 Step case: !h n. n < LENGTH (h::l) ==> (DROP n (h::l) = EL n (h::l)::DROP (SUC n) (h::l))
325 i.e. n <> 0 /\ n < SUC (LENGTH l) ==> DROP (n - 1) l = EL n (h::l)::DROP n l by DROP_def
326 n <> 0 means ?j. n = SUC j < SUC (LENGTH l), so j < LENGTH l.
327 LHS = DROP (SUC j - 1) l
328 = DROP j l by SUC j - 1 = j
329 = EL j l :: DROP (SUC j) l by induction hypothesis
330 RHS = EL (SUC j) (h::l) :: DROP (SUC (SUC j)) (h::l)
331 = EL j l :: DROP (SUC j) l by EL, DROP_def
332 = LHS
333*)
334Theorem rotate_shift_element:
335 !l n. n < LENGTH l ==> (rotate n l = EL n l::(DROP (SUC n) l ++ TAKE n l))
336Proof
337 rw[rotate_def] >>
338 pop_assum mp_tac >>
339 qid_spec_tac `n` >>
340 Induct_on `l` >- rw[] >>
341 rw[DROP_def] >> Cases_on `n` >> fs[]
342QED
343
344(* Theorem: rotate 0 l = l *)
345(* Proof:
346 rotate 0 l
347 = DROP 0 l ++ TAKE 0 l by rotate_def
348 = l ++ [] by DROP_def, TAKE_def
349 = l by APPEND
350*)
351Theorem rotate_0:
352 !l. rotate 0 l = l
353Proof
354 rw[rotate_def]
355QED
356
357(* Theorem: rotate n [] = [] *)
358(* Proof:
359 rotate n []
360 = DROP n [] ++ TAKE n [] by rotate_def
361 = [] ++ [] by DROP_def, TAKE_def
362 = [] by APPEND
363*)
364Theorem rotate_nil:
365 !n. rotate n [] = []
366Proof
367 rw[rotate_def]
368QED
369
370(* Theorem: rotate (LENGTH l) l = l *)
371(* Proof:
372 rotate (LENGTH l) l
373 = DROP (LENGTH l) l ++ TAKE (LENGTH l) l by rotate_def
374 = [] ++ TAKE (LENGTH l) l by DROP_LENGTH_NIL
375 = [] ++ l by TAKE_LENGTH_ID
376 = l
377*)
378Theorem rotate_full:
379 !l. rotate (LENGTH l) l = l
380Proof
381 rw[rotate_def, DROP_LENGTH_NIL]
382QED
383
384(* Theorem: n < LENGTH l ==> rotate (SUC n) l = rotate 1 (rotate n l) *)
385(* Proof:
386 Since n < LENGTH l, l <> [] by LENGTH_NIL.
387 Thus DROP n l <> [] by DROP_EQ_NIL (need n < LENGTH l)
388 Expand by rotate_def, this is to show:
389 DROP (SUC n) l ++ TAKE (SUC n) l = DROP 1 (DROP n l ++ TAKE n l) ++ TAKE 1 (DROP n l ++ TAKE n l)
390 LHS = DROP (SUC n) l ++ TAKE (SUC n) l
391 = DROP 1 (DROP n l) ++ (TAKE n l ++ TAKE 1 (DROP n l)) by DROP_SUC, TAKE_SUC
392 Since DROP n l <> [] from above,
393 RHS = DROP 1 (DROP n l ++ TAKE n l) ++ TAKE 1 (DROP n l ++ TAKE n l)
394 = DROP 1 (DROP n l) ++ (TAKE n l ++ TAKE 1 (DROP n l)) by DROP_1_APPEND, TAKE_1_APPEND
395 = LHS
396*)
397Theorem rotate_suc:
398 !l n. n < LENGTH l ==> (rotate (SUC n) l = rotate 1 (rotate n l))
399Proof
400 rpt strip_tac >>
401 `LENGTH l <> 0` by decide_tac >>
402 `l <> []` by metis_tac[LENGTH_NIL] >>
403 `DROP n l <> []` by simp[DROP_EQ_NIL] >>
404 rw[rotate_def, DROP_1_APPEND, TAKE_1_APPEND, DROP_SUC, TAKE_SUC]
405QED
406
407(* Theorem: Rotate keeps LENGTH (of necklace): LENGTH (rotate n l) = LENGTH l *)
408(* Proof:
409 LENGTH (rotate n l)
410 = LENGTH (DROP n l ++ TAKE n l) by rotate_def
411 = LENGTH (DROP n l) + LENGTH (TAKE n l) by LENGTH_APPEND
412 = LENGTH (TAKE n l) + LENGTH (DROP n l) by arithmetic
413 = LENGTH (TAKE n l ++ DROP n l) by LENGTH_APPEND
414 = LENGTH l by TAKE_DROP
415*)
416Theorem rotate_same_length:
417 !l n. LENGTH (rotate n l) = LENGTH l
418Proof
419 rpt strip_tac >>
420 `LENGTH (rotate n l) = LENGTH (DROP n l ++ TAKE n l)` by rw[rotate_def] >>
421 `_ = LENGTH (DROP n l) + LENGTH (TAKE n l)` by rw[] >>
422 `_ = LENGTH (TAKE n l) + LENGTH (DROP n l)` by rw[ADD_COMM] >>
423 `_ = LENGTH (TAKE n l ++ DROP n l)` by rw[] >>
424 rw_tac std_ss[TAKE_DROP]
425QED
426
427(* Theorem: Rotate keeps SET (of elements): set (rotate n l) = set l *)
428(* Proof:
429 set (rotate n l)
430 = set (DROP n l ++ TAKE n l) by rotate_def
431 = set (DROP n l) UNION set (TAKE n l) by LIST_TO_SET_APPEND
432 = set (TAKE n l) UNION set (DROP n l) by UNION_COMM
433 = set (TAKE n l ++ DROP n l) by LIST_TO_SET_APPEND
434 = set l by TAKE_DROP
435*)
436Theorem rotate_same_set:
437 !l n. set (rotate n l) = set l
438Proof
439 rpt strip_tac >>
440 `set (rotate n l) = set (DROP n l ++ TAKE n l)` by rw[rotate_def] >>
441 `_ = set (DROP n l) UNION set (TAKE n l)` by rw[] >>
442 `_ = set (TAKE n l) UNION set (DROP n l)` by rw[UNION_COMM] >>
443 `_ = set (TAKE n l ++ DROP n l)` by rw[] >>
444 rw_tac std_ss[TAKE_DROP]
445QED
446
447(* Theorem: n + m <= LENGTH l ==> rotate n (rotate m l) = rotate (n + m) l *)
448(* Proof:
449 By induction on n.
450 Base case: !m l. 0 + m <= LENGTH l ==> (rotate 0 (rotate m l) = rotate (0 + m) l)
451 rotate 0 (rotate m l)
452 = rotate m l by rotate_0
453 = rotate (0 + m) l by ADD
454 Step case: !m l. SUC n + m <= LENGTH l ==> (rotate (SUC n) (rotate m l) = rotate (SUC n + m) l)
455 rotate (SUC n) (rotate m l)
456 = rotate 1 (rotate n (rotate m l)) by rotate_suc
457 = rotate 1 (rotate (n + m) l) by induction hypothesis
458 = rotate (SUC (n + m)) l by rotate_suc
459 = rotate (SUC n + m) l by ADD_CLAUSES
460*)
461Theorem rotate_add:
462 !n m l. n + m <= LENGTH l ==> (rotate n (rotate m l) = rotate (n + m) l)
463Proof
464 Induct >-
465 rw[rotate_0] >>
466 rw[] >>
467 `LENGTH (rotate m l) = LENGTH l` by rw[rotate_same_length] >>
468 `LENGTH (rotate (n + m) l) = LENGTH l` by rw[rotate_same_length] >>
469 `n < LENGTH l /\ n + m < LENGTH l /\ n + m <= LENGTH l` by decide_tac >>
470 rw[rotate_suc, ADD_CLAUSES]
471QED
472
473(* Theorem: !k. k < LENGTH l ==> rotate (LENGTH l - k) (rotate k l) = l *)
474(* Proof:
475 Since k < LENGTH l
476 LENGTH 1 - k + k = LENGTH l <= LENGTH l by EQ_LESS_EQ
477 rotate (LENGTH l - k) (rotate k l)
478 = rotate (LENGTH l - k + k) l by rotate_add
479 = rotate (LENGTH l) l by arithmetic
480 = l by rotate_full
481*)
482Theorem rotate_lcancel:
483 !k l. k < LENGTH l ==> (rotate (LENGTH l - k) (rotate k l) = l)
484Proof
485 rpt strip_tac >>
486 `LENGTH l - k + k = LENGTH l` by decide_tac >>
487 `LENGTH l <= LENGTH l` by rw[] >>
488 rw[rotate_add, rotate_full]
489QED
490
491(* Theorem: !k. k < LENGTH l ==> rotate k (rotate (LENGTH l - k) l) = l *)
492(* Proof:
493 Since k < LENGTH l
494 k + (LENGTH 1 - k) = LENGTH l <= LENGTH l by EQ_LESS_EQ
495 rotate k (rotate (LENGTH l - k) l)
496 = rotate (k + (LENGTH l - k)) l by rotate_add
497 = rotate (LENGTH l) l by arithmetic
498 = l by rotate_full
499*)
500Theorem rotate_rcancel:
501 !k l. k < LENGTH l ==> (rotate k (rotate (LENGTH l - k) l) = l)
502Proof
503 rpt strip_tac >>
504 `k + (LENGTH l - k) = LENGTH l` by decide_tac >>
505 `LENGTH l <= LENGTH l` by rw[] >>
506 rw[rotate_add, rotate_full]
507QED
508
509(* ------------------------------------------------------------------------- *)
510(* List Turn *)
511(* ------------------------------------------------------------------------- *)
512
513(* Define a rotation turn of a list (like a turnstile) *)
514Definition turn_def:
515 turn l = if l = [] then [] else ((LAST l) :: (FRONT l))
516End
517
518(* Theorem: turn [] = [] *)
519(* Proof: by turn_def *)
520Theorem turn_nil:
521 turn [] = []
522Proof
523 rw[turn_def]
524QED
525
526(* Theorem: l <> [] ==> (turn l = (LAST l) :: (FRONT l)) *)
527(* Proof: by turn_def *)
528Theorem turn_not_nil:
529 !l. l <> [] ==> (turn l = (LAST l) :: (FRONT l))
530Proof
531 rw[turn_def]
532QED
533
534(* Theorem: LENGTH (turn l) = LENGTH l *)
535(* Proof:
536 If l = [],
537 LENGTH (turn []) = LENGTH [] by turn_def
538 If l <> [],
539 Then LENGTH l <> 0 by LENGTH_NIL
540 LENGTH (turn l)
541 = LENGTH ((LAST l) :: (FRONT l)) by turn_def
542 = SUC (LENGTH (FRONT l)) by LENGTH
543 = SUC (PRE (LENGTH l)) by LENGTH_FRONT
544 = LENGTH l by SUC_PRE, 0 < LENGTH l
545*)
546Theorem turn_length:
547 !l. LENGTH (turn l) = LENGTH l
548Proof
549 metis_tac[turn_def, list_CASES, LENGTH, LENGTH_FRONT_CONS, SUC_PRE, NOT_ZERO_LT_ZERO]
550QED
551
552(* Theorem: (turn p = []) <=> (p = []) *)
553(* Proof:
554 turn p = []
555 <=> LENGTH (turn p) = 0 by LENGTH_NIL
556 <=> LENGTH p = 0 by turn_length
557 <=> p = [] by LENGTH_NIL
558*)
559Theorem turn_eq_nil:
560 !p. (turn p = []) <=> (p = [])
561Proof
562 metis_tac[turn_length, LENGTH_NIL]
563QED
564
565(* Theorem: ls <> [] ==> (HD (turn ls) = LAST ls) *)
566(* Proof:
567 HD (turn ls)
568 = HD (LAST ls :: FRONT ls) by turn_def, ls <> []
569 = LAST ls by HD
570*)
571Theorem head_turn:
572 !ls. ls <> [] ==> (HD (turn ls) = LAST ls)
573Proof
574 rw[turn_def]
575QED
576
577(* Theorem: ls <> [] ==> (TL (turn ls) = FRONT ls) *)
578(* Proof:
579 TL (turn ls)
580 = TL (LAST ls :: FRONT ls) by turn_def, ls <> []
581 = FRONT ls by TL
582*)
583Theorem tail_turn:
584 !ls. ls <> [] ==> (TL (turn ls) = FRONT ls)
585Proof
586 rw[turn_def]
587QED
588
589(* Theorem: turn (SNOC x ls) = x :: ls *)
590(* Proof:
591 Note (SNOC x ls) <> [] by NOT_SNOC_NIL
592 turn (SNOC x ls)
593 = LAST (SNOC x ls) :: FRONT (SNOC x ls) by turn_def
594 = x :: FRONT (SNOC x ls) by LAST_SNOC
595 = x :: ls by FRONT_SNOC
596*)
597Theorem turn_snoc:
598 !ls x. turn (SNOC x ls) = x :: ls
599Proof
600 metis_tac[NOT_SNOC_NIL, turn_def, LAST_SNOC, FRONT_SNOC]
601QED
602
603(* Overload repeated turns *)
604Overload turn_exp = ``\l n. FUNPOW turn n l``
605
606(* Theorem: turn_exp l 0 = l *)
607(* Proof:
608 turn_exp l 0
609 = FUNPOW turn 0 l by notation
610 = l by FUNPOW
611*)
612Theorem turn_exp_0:
613 !l. turn_exp l 0 = l
614Proof
615 rw[]
616QED
617
618(* Theorem: turn_exp l 1 = turn l *)
619(* Proof:
620 turn_exp l 1
621 = FUNPOW turn 1 l by notation
622 = turn l by FUNPOW
623*)
624Theorem turn_exp_1:
625 !l. turn_exp l 1 = turn l
626Proof
627 rw[]
628QED
629
630(* Theorem: turn_exp l 2 = turn (turn l) *)
631(* Proof:
632 turn_exp l 2
633 = FUNPOW turn 2 l by notation
634 = turn (FUNPOW turn 1 l) by FUNPOW_SUC
635 = turn (turn_exp l 1) by notation
636 = turn (turn l) by turn_exp_1
637*)
638Theorem turn_exp_2:
639 !l. turn_exp l 2 = turn (turn l)
640Proof
641 metis_tac[FUNPOW_SUC, turn_exp_1, TWO]
642QED
643
644(* Theorem: turn_exp l (SUC n) = turn_exp (turn l) n *)
645(* Proof:
646 turn_exp l (SUC n)
647 = FUNPOW turn (SUC n) l by notation
648 = FUNPOW turn n (turn l) by FUNPOW
649 = turn_exp (turn l) n by notation
650*)
651Theorem turn_exp_SUC:
652 !l n. turn_exp l (SUC n) = turn_exp (turn l) n
653Proof
654 rw[FUNPOW]
655QED
656
657(* Theorem: turn_exp l (SUC n) = turn (turn_exp l n) *)
658(* Proof:
659 turn_exp l (SUC n)
660 = FUNPOW turn (SUC n) l by notation
661 = turn (FUNPOW turn n l) by FUNPOW_SUC
662 = turn (turn_exp l n) by notation
663*)
664Theorem turn_exp_suc:
665 !l n. turn_exp l (SUC n) = turn (turn_exp l n)
666Proof
667 rw[FUNPOW_SUC]
668QED
669
670(* Theorem: LENGTH (turn_exp l n) = LENGTH l *)
671(* Proof:
672 By induction on n.
673 Base: LENGTH (turn_exp l 0) = LENGTH l
674 True by turn_exp l 0 = l by turn_exp_0
675 Step: LENGTH (turn_exp l n) = LENGTH l ==> LENGTH (turn_exp l (SUC n)) = LENGTH l
676 LENGTH (turn_exp l (SUC n))
677 = LENGTH (turn (turn_exp l n)) by turn_exp_suc
678 = LENGTH (turn_exp l n) by turn_length
679 = LENGTH l by induction hypothesis
680*)
681Theorem turn_exp_length:
682 !l n. LENGTH (turn_exp l n) = LENGTH l
683Proof
684 strip_tac >>
685 Induct >-
686 rw[] >>
687 rw[turn_exp_suc, turn_length]
688QED
689
690(* Theorem: n < LENGTH ls ==>
691 (HD (turn_exp ls n) = EL (if n = 0 then 0 else LENGTH ls - n) ls) *)
692(* Proof:
693 By induction on n.
694 Base: !ls. 0 < LENGTH ls ==>
695 HD (turn_exp ls 0) = EL 0 ls
696 HD (turn_exp ls 0)
697 = HD ls by FUNPOW_0
698 = EL 0 ls by EL
699 Step: !ls. n < LENGTH ls ==> HD (turn_exp ls n) = EL (if n = 0 then 0 else (LENGTH ls - n)) ls ==>
700 !ls. SUC n < LENGTH ls ==> HD (turn_exp ls (SUC n)) = EL (LENGTH ls - SUC n) ls
701 Let k = LENGTH ls, then SUC n < k
702 Note LENGTH (FRONT ls) = PRE k by FRONT_LENGTH
703 and n < PRE k by SUC n < k
704 Also LENGTH (turn ls) = k by turn_length
705 so n < k by n < SUC n, SUC n < k
706 Note ls <> [] by k <> 0
707
708 HD (turn_exp ls (SUC n))
709 = HD (turn_exp (turn ls) n) by turn_exp_SUC
710 = EL (if n = 0 then 0 else (LENGTH (turn ls) - n)) (turn ls)
711 by induction hypothesis, apply to (turn ls)
712 = EL (if n = 0 then 0 else (k - n) (turn ls)) by above
713
714 If n = 0,
715 = EL 0 (turn ls)
716 = LAST ls by turn_def
717 = EL (PRE k) ls by LAST_EL
718 = EL (k - SUC 0) ls by ONE
719 If n <> 0
720 = EL (k - n) (turn ls)
721 = EL (k - n) (LAST ls :: FRONT ls) by turn_def
722 = EL (k - n - 1) (FRONT ls) by EL
723 = EL (k - n - 1) ls by FRONT_EL, k - n - 1 < PRE k, n <> 0
724 = EL (k - SUC n) ls by arithmetic
725*)
726Theorem head_turn_exp:
727 !ls n. n < LENGTH ls ==>
728 (HD (turn_exp ls n) = EL (if n = 0 then 0 else LENGTH ls - n) ls)
729Proof
730 (Induct_on `n` >> simp[]) >>
731 rpt strip_tac >>
732 qabbrev_tac `k = LENGTH ls` >>
733 `n < k` by rw[Abbr`k`] >>
734 `LENGTH (turn ls) = k` by rw[turn_length, Abbr`k`] >>
735 `HD (turn_exp ls (SUC n)) = HD (turn_exp (turn ls) n)` by rw[turn_exp_SUC] >>
736 `_ = EL (if n = 0 then 0 else (k - n)) (turn ls)` by rw[] >>
737 `k <> 0` by decide_tac >>
738 `ls <> []` by metis_tac[LENGTH_NIL] >>
739 (Cases_on `n = 0` >> fs[]) >| [
740 `PRE k = k - 1` by decide_tac >>
741 rw[head_turn, LAST_EL],
742 `k - n = SUC (k - SUC n)` by decide_tac >>
743 rw[turn_def, Abbr`k`] >>
744 `LENGTH (FRONT ls) = PRE (LENGTH ls)` by rw[FRONT_LENGTH] >>
745 `n < PRE (LENGTH ls)` by decide_tac >>
746 rw[FRONT_EL]
747 ]
748QED
749
750(* ------------------------------------------------------------------------- *)
751(* SUM Theorems *)
752(* ------------------------------------------------------------------------- *)
753
754(* Defined: SUM for summation of list = sequence *)
755
756(* Theorem: SUM [] = 0 *)
757(* Proof: by definition. *)
758Theorem SUM_NIL = SUM |> CONJUNCT1;
759(* > val SUM_NIL = |- SUM [] = 0 : thm *)
760
761(* Theorem: SUM h::t = h + SUM t *)
762(* Proof: by definition. *)
763Theorem SUM_CONS = SUM |> CONJUNCT2;
764(* val SUM_CONS = |- !h t. SUM (h::t) = h + SUM t: thm *)
765
766(* Theorem: SUM [n] = n *)
767(* Proof: by SUM *)
768Theorem SUM_SING:
769 !n. SUM [n] = n
770Proof
771 rw[]
772QED
773
774(* Theorem: SUM (s ++ t) = SUM s + SUM t *)
775(* Proof: by induction on s *)
776(*
777val SUM_APPEND = store_thm(
778 "SUM_APPEND",
779 ``!s t. SUM (s ++ t) = SUM s + SUM t``,
780 Induct_on `s` >-
781 rw[] >>
782 rw[ADD_ASSOC]);
783*)
784(* There is already a SUM_APPEND in up-to-date listTheory *)
785
786(* Theorem: constant multiplication: k * SUM s = SUM (k * s) *)
787(* Proof: by induction on s.
788 Base case: !k. k * SUM [] = SUM (MAP ($* k) [])
789 LHS = k * SUM [] = k * 0 = 0 by SUM_NIL, MULT_0
790 = SUM [] by SUM_NIL
791 = SUM (MAP ($* k) []) = RHS by MAP
792 Step case: !k. k * SUM s = SUM (MAP ($* k) s) ==>
793 !h k. k * SUM (h::s) = SUM (MAP ($* k) (h::s))
794 LHS = k * SUM (h::s)
795 = k * (h + SUM s) by SUM_CONS
796 = k * h + k * SUM s by LEFT_ADD_DISTRIB
797 = k * h + SUM (MAP ($* k) s) by induction hypothesis
798 = SUM (k * h :: (MAP ($* k) s)) by SUM_CONS
799 = SUM (MAP ($* k) (h::s)) by MAP
800 = RHS
801*)
802Theorem SUM_MULT:
803 !s k. k * SUM s = SUM (MAP ($* k) s)
804Proof
805 Induct_on `s` >-
806 metis_tac[SUM, MAP, MULT_0] >>
807 metis_tac[SUM, MAP, LEFT_ADD_DISTRIB]
808QED
809
810(* Theorem: (m + n) * SUM s = SUM (m * s) + SUM (n * s) *)
811(* Proof: generalization of
812- RIGHT_ADD_DISTRIB;
813> val it = |- !m n p. (m + n) * p = m * p + n * p : thm
814 (m + n) * SUM s
815 = m * SUM s + n * SUM s by RIGHT_ADD_DISTRIB
816 = SUM (MAP (\x. m * x) s) + SUM (MAP (\x. n * x) s) by SUM_MULT
817*)
818Theorem SUM_RIGHT_ADD_DISTRIB:
819 !s m n. (m + n) * SUM s = SUM (MAP ($* m) s) + SUM (MAP ($* n) s)
820Proof
821 metis_tac[RIGHT_ADD_DISTRIB, SUM_MULT]
822QED
823
824(* Theorem: (SUM s) * (m + n) = SUM (m * s) + SUM (n * s) *)
825(* Proof: generalization of
826- LEFT_ADD_DISTRIB;
827> val it = |- !m n p. p * (m + n) = p * m + p * n : thm
828 (SUM s) * (m + n)
829 = (m + n) * SUM s by MULT_COMM
830 = SUM (MAP ($* m) s) + SUM (MAP ($* n) s) by SUM_RIGHT_ADD_DISTRIB
831*)
832Theorem SUM_LEFT_ADD_DISTRIB:
833 !s m n. (SUM s) * (m + n) = SUM (MAP ($* m) s) + SUM (MAP ($* n) s)
834Proof
835 metis_tac[SUM_RIGHT_ADD_DISTRIB, MULT_COMM]
836QED
837
838
839(*
840- EVAL ``GENLIST I 4``;
841> val it = |- GENLIST I 4 = [0; 1; 2; 3] : thm
842- EVAL ``GENLIST SUC 4``;
843> val it = |- GENLIST SUC 4 = [1; 2; 3; 4] : thm
844- EVAL ``GENLIST (\k. binomial 4 k) 5``;
845> val it = |- GENLIST (\k. binomial 4 k) 5 = [1; 4; 6; 4; 1] : thm
846- EVAL ``GENLIST (\k. binomial 5 k) 6``;
847> val it = |- GENLIST (\k. binomial 5 k) 6 = [1; 5; 10; 10; 5; 1] : thm
848- EVAL ``GENLIST (\k. binomial 10 k) 11``;
849> val it = |- GENLIST (\k. binomial 10 k) 11 = [1; 10; 45; 120; 210; 252; 210; 120; 45; 10; 1] : thm
850*)
851
852(* Theorems on GENLIST:
853
854- GENLIST;
855> val it = |- (!f. GENLIST f 0 = []) /\
856 !f n. GENLIST f (SUC n) = SNOC (f n) (GENLIST f n) : thm
857- NULL_GENLIST;
858> val it = |- !n f. NULL (GENLIST f n) <=> (n = 0) : thm
859- GENLIST_CONS;
860> val it = |- GENLIST f (SUC n) = f 0::GENLIST (f o SUC) n : thm
861- EL_GENLIST;
862> val it = |- !f n x. x < n ==> (EL x (GENLIST f n) = f x) : thm
863- EXISTS_GENLIST;
864> val it = |- !n. EXISTS P (GENLIST f n) <=> ?i. i < n /\ P (f i) : thm
865- EVERY_GENLIST;
866> val it = |- !n. EVERY P (GENLIST f n) <=> !i. i < n ==> P (f i) : thm
867- MAP_GENLIST;
868> val it = |- !f g n. MAP f (GENLIST g n) = GENLIST (f o g) n : thm
869- GENLIST_APPEND;
870> val it = |- !f a b. GENLIST f (a + b) = GENLIST f b ++ GENLIST (\t. f (t + b)) a : thm
871- HD_GENLIST;
872> val it = |- HD (GENLIST f (SUC n)) = f 0 : thm
873- TL_GENLIST;
874> val it = |- !f n. TL (GENLIST f (SUC n)) = GENLIST (f o SUC) n : thm
875- HD_GENLIST_COR;
876> val it = |- !n f. 0 < n ==> (HD (GENLIST f n) = f 0) : thm
877- GENLIST_FUN_EQ;
878> val it = |- !n f g. (GENLIST f n = GENLIST g n) <=> !x. x < n ==> (f x = g x) : thm
879
880*)
881
882(* Theorem: SUM (GENLIST f n) = SIGMA f (count n) *)
883(* Proof:
884 By induction on n.
885 Base: SUM (GENLIST f 0) = SIGMA f (count 0)
886
887 SUM (GENLIST f 0)
888 = SUM [] by GENLIST_0
889 = 0 by SUM_NIL
890 = SIGMA f {} by SUM_IMAGE_THM
891 = SIGMA f (count 0) by COUNT_0
892
893 Step: SUM (GENLIST f n) = SIGMA f (count n) ==>
894 SUM (GENLIST f (SUC n)) = SIGMA f (count (SUC n))
895
896 SUM (GENLIST f (SUC n))
897 = SUM (SNOC (f n) (GENLIST f n)) by GENLIST
898 = f n + SUM (GENLIST f n) by SUM_SNOC
899 = f n + SIGMA f (count n) by induction hypothesis
900 = f n + SIGMA f (count n DELETE n) by IN_COUNT, DELETE_NON_ELEMENT
901 = SIGMA f (n INSERT count n) by SUM_IMAGE_THM, FINITE_COUNT
902 = SIGMA f (count (SUC n)) by COUNT_SUC
903*)
904Theorem SUM_GENLIST:
905 !f n. SUM (GENLIST f n) = SIGMA f (count n)
906Proof
907 strip_tac >>
908 Induct >-
909 rw[SUM_IMAGE_THM] >>
910 `SUM (GENLIST f (SUC n)) = SUM (SNOC (f n) (GENLIST f n))` by rw[GENLIST] >>
911 `_ = f n + SUM (GENLIST f n)` by rw[SUM_SNOC] >>
912 `_ = f n + SIGMA f (count n)` by rw[] >>
913 `_ = f n + SIGMA f (count n DELETE n)`
914 by metis_tac[IN_COUNT, prim_recTheory.LESS_REFL, DELETE_NON_ELEMENT] >>
915 `_ = SIGMA f (n INSERT count n)` by rw[SUM_IMAGE_THM] >>
916 `_ = SIGMA f (count (SUC n))` by rw[COUNT_SUC] >>
917 decide_tac
918QED
919
920(* Theorem: SUM (k=0..n) f(k) = f(0) + SUM (k=1..n) f(k) *)
921(* Proof:
922 SUM (GENLIST f (SUC n))
923 = SUM (f 0 :: GENLIST (f o SUC) n) by GENLIST_CONS
924 = f 0 + SUM (GENLIST (f o SUC) n) by SUM definition.
925*)
926Theorem SUM_DECOMPOSE_FIRST:
927 !f n. SUM (GENLIST f (SUC n)) = f 0 + SUM (GENLIST (f o SUC) n)
928Proof
929 metis_tac[GENLIST_CONS, SUM]
930QED
931
932(* Theorem: SUM (k=0..n) f(k) = SUM (k=0..(n-1)) f(k) + f n *)
933(* Proof:
934 SUM (GENLIST f (SUC n))
935 = SUM (SNOC (f n) (GENLIST f n)) by GENLIST definition
936 = SUM ((GENLIST f n) ++ [f n]) by SNOC_APPEND
937 = SUM (GENLIST f n) + SUM [f n] by SUM_APPEND
938 = SUM (GENLIST f n) + f n by SUM definition: SUM (h::t) = h + SUM t, and SUM [] = 0.
939*)
940Theorem SUM_DECOMPOSE_LAST:
941 !f n. SUM (GENLIST f (SUC n)) = SUM (GENLIST f n) + f n
942Proof
943 rpt strip_tac >>
944 `SUM (GENLIST f (SUC n)) = SUM (SNOC (f n) (GENLIST f n))` by metis_tac[GENLIST] >>
945 `_ = SUM ((GENLIST f n) ++ [f n])` by metis_tac[SNOC_APPEND] >>
946 `_ = SUM (GENLIST f n) + SUM [f n]` by metis_tac[SUM_APPEND] >>
947 rw[SUM]
948QED
949
950(* Theorem: SUM (GENLIST a n) + SUM (GENLIST b n) = SUM (GENLIST (\k. a k + b k) n) *)
951(* Proof: by induction on n.
952 Base case: !a b. SUM (GENLIST a 0) + SUM (GENLIST b 0) = SUM (GENLIST (\k. a k + b k) 0)
953 Since GENLIST f 0 = [] by GENLIST
954 and SUM [] = 0 by SUM_NIL
955 This is just 0 + 0 = 0, true by arithmetic.
956 Step case: !a b. SUM (GENLIST a n) + SUM (GENLIST b n) =
957 SUM (GENLIST (\k. a k + b k) n) ==>
958 !a b. SUM (GENLIST a (SUC n)) + SUM (GENLIST b (SUC n)) =
959 SUM (GENLIST (\k. a k + b k) (SUC n))
960 SUM (GENLIST a (SUC n)) + SUM (GENLIST b (SUC n)
961 = (SUM (GENLIST a n) + a n) + (SUM (GENLIST b n) + b n) by SUM_DECOMPOSE_LAST
962 = SUM (GENLIST a n) + SUM (GENLIST b n) + (a n + b n) by arithmetic
963 = SUM (GENLIST (\k. a k + b k) n) + (a n + b n) by induction hypothesis
964 = SUM (GENLIST (\k. a k + b k) (SUC n)) by SUM_DECOMPOSE_LAST
965*)
966Theorem SUM_ADD_GENLIST:
967 !a b n. SUM (GENLIST a n) + SUM (GENLIST b n) = SUM (GENLIST (\k. a k + b k) n)
968Proof
969 Induct_on `n` >-
970 rw[] >>
971 rw[SUM_DECOMPOSE_LAST]
972QED
973
974(* Theorem: SUM (GENLIST a n ++ GENLIST b n) = SUM (GENLIST (\k. a k + b k) n) *)
975(* Proof:
976 SUM (GENLIST a n ++ GENLIST b n)
977 = SUM (GENLIST a n) + SUM (GENLIST b n) by SUM_APPEND
978 = SUM (GENLIST (\k. a k + b k) n) by SUM_ADD_GENLIST
979*)
980Theorem SUM_GENLIST_APPEND:
981 !a b n. SUM (GENLIST a n ++ GENLIST b n) = SUM (GENLIST (\k. a k + b k) n)
982Proof
983 metis_tac[SUM_APPEND, SUM_ADD_GENLIST]
984QED
985
986(* Theorem: 0 < n ==> SUM (GENLIST f (SUC n)) = f 0 + SUM (GENLIST (f o SUC) (PRE n)) + f n *)
987(* Proof:
988 SUM (GENLIST f (SUC n))
989 = SUM (GENLIST f n) + f n by SUM_DECOMPOSE_LAST
990 = SUM (GENLIST f (SUC m)) + f n by n = SUC m, 0 < n
991 = f 0 + SUM (GENLIST (f o SUC) m) + f n by SUM_DECOMPOSE_FIRST
992 = f 0 + SUM (GENLIST (f o SUC) (PRE n)) + f n by PRE_SUC_EQ
993*)
994Theorem SUM_DECOMPOSE_FIRST_LAST:
995 !f n. 0 < n ==> (SUM (GENLIST f (SUC n)) = f 0 + SUM (GENLIST (f o SUC) (PRE n)) + f n)
996Proof
997 metis_tac[SUM_DECOMPOSE_LAST, SUM_DECOMPOSE_FIRST, SUC_EXISTS, PRE_SUC_EQ]
998QED
999
1000(* Theorem: (SUM l) MOD n = (SUM (MAP (\x. x MOD n) l)) MOD n *)
1001(* Proof: by list induction.
1002 Base case: SUM [] MOD n = SUM (MAP (\x. x MOD n) []) MOD n
1003 true by SUM [] = 0, MAP f [] = 0, and 0 MOD n = 0.
1004 Step case: SUM l MOD n = SUM (MAP (\x. x MOD n) l) MOD n ==>
1005 !h. SUM (h::l) MOD n = SUM (MAP (\x. x MOD n) (h::l)) MOD n
1006 SUM (h::l) MOD n
1007 = (h + SUM l) MOD n by SUM
1008 = (h MOD n + (SUM l) MOD n) MOD n by MOD_PLUS
1009 = (h MOD n + SUM (MAP (\x. x MOD n) l) MOD n) MOD n by induction hypothesis
1010 = ((h MOD n) MOD n + SUM (MAP (\x. x MOD n) l) MOD n) MOD n by MOD_MOD
1011 = ((h MOD n + SUM (MAP (\x. x MOD n) l)) MOD n) MOD n by MOD_PLUS
1012 = (h MOD n + SUM (MAP (\x. x MOD n) l)) MOD n by MOD_MOD
1013 = (SUM (h MOD n ::(MAP (\x. x MOD n) l))) MOD n by SUM
1014 = (SUM (MAP (\x. x MOD n) (h::l))) MOD n by MAP
1015*)
1016Theorem SUM_MOD:
1017 !n. 0 < n ==> !l. (SUM l) MOD n = (SUM (MAP (\x. x MOD n) l)) MOD n
1018Proof
1019 rpt strip_tac >>
1020 Induct_on `l` >-
1021 rw[] >>
1022 rpt strip_tac >>
1023 `SUM (h::l) MOD n = (h MOD n + (SUM l) MOD n) MOD n` by rw_tac std_ss[SUM, MOD_PLUS] >>
1024 `_ = ((h MOD n) MOD n + SUM (MAP (\x. x MOD n) l) MOD n) MOD n` by rw_tac std_ss[MOD_MOD] >>
1025 rw[MOD_PLUS]
1026QED
1027
1028(* Theorem: SUM l = 0 <=> l = EVERY (\x. x = 0) l *)
1029(* Proof: by induction on l.
1030 Base case: (SUM [] = 0) <=> EVERY (\x. x = 0) []
1031 true by SUM [] = 0 and GENLIST f 0 = [].
1032 Step case: (SUM l = 0) <=> EVERY (\x. x = 0) l ==>
1033 !h. (SUM (h::l) = 0) <=> EVERY (\x. x = 0) (h::l)
1034 SUM (h::l) = 0
1035 <=> h + SUM l = 0 by SUM
1036 <=> h = 0 /\ SUM l = 0 by ADD_EQ_0
1037 <=> h = 0 /\ EVERY (\x. x = 0) l by induction hypothesis
1038 <=> EVERY (\x. x = 0) (h::l) by EVERY_DEF
1039*)
1040Theorem SUM_EQ_0:
1041 !l. (SUM l = 0) <=> EVERY (\x. x = 0) l
1042Proof
1043 Induct >>
1044 rw[]
1045QED
1046
1047(* Theorem: SUM (GENLIST ((\k. f k) o SUC) (PRE n)) MOD n =
1048 SUM (GENLIST ((\k. f k MOD n) o SUC) (PRE n)) MOD n *)
1049(* Proof:
1050 SUM (GENLIST ((\k. f k) o SUC) (PRE n)) MOD n
1051 = SUM (MAP (\x. x MOD n) (GENLIST ((\k. f k) o SUC) (PRE n))) MOD n by SUM_MOD
1052 = SUM (GENLIST ((\x. x MOD n) o ((\k. f k) o SUC)) (PRE n)) MOD n by MAP_GENLIST
1053 = SUM (GENLIST ((\x. x MOD n) o (\k. f k) o SUC) (PRE n)) MOD n by composition associative
1054 = SUM (GENLIST ((\k. f k MOD n) o SUC) (PRE n)) MOD n by composition
1055*)
1056Theorem SUM_GENLIST_MOD:
1057 !n. 0 < n ==> !f. SUM (GENLIST ((\k. f k) o SUC) (PRE n)) MOD n = SUM (GENLIST ((\k. f k MOD n) o SUC) (PRE n)) MOD n
1058Proof
1059 rpt strip_tac >>
1060 `SUM (GENLIST ((\k. f k) o SUC) (PRE n)) MOD n =
1061 SUM (MAP (\x. x MOD n) (GENLIST ((\k. f k) o SUC) (PRE n))) MOD n` by metis_tac[SUM_MOD] >>
1062 rw_tac std_ss[MAP_GENLIST, combinTheory.o_ASSOC, combinTheory.o_ABS_L]
1063QED
1064
1065(* Theorem: SUM (GENLIST (\j. x) n) = n * x *)
1066(* Proof:
1067 By induction on n.
1068 Base case: !x. SUM (GENLIST (\j. x) 0) = 0 * x
1069 SUM (GENLIST (\j. x) 0)
1070 = SUM [] by GENLIST
1071 = 0 by SUM
1072 = 0 * x by MULT
1073 Step case: !x. SUM (GENLIST (\j. x) n) = n * x ==>
1074 !x. SUM (GENLIST (\j. x) (SUC n)) = SUC n * x
1075 SUM (GENLIST (\j. x) (SUC n))
1076 = SUM (SNOC x (GENLIST (\j. x) n)) by GENLIST
1077 = SUM (GENLIST (\j. x) n) + x by SUM_SNOC
1078 = n * x + x by induction hypothesis
1079 = SUC n * x by MULT
1080*)
1081Theorem SUM_CONSTANT:
1082 !n x. SUM (GENLIST (\j. x) n) = n * x
1083Proof
1084 Induct >-
1085 rw[] >>
1086 rw_tac std_ss[GENLIST, SUM_SNOC, MULT]
1087QED
1088
1089(* Theorem: SUM (GENLIST (K m) n) = m * n *)
1090(* Proof:
1091 By induction on n.
1092 Base: SUM (GENLIST (K m) 0) = m * 0
1093 SUM (GENLIST (K m) 0)
1094 = SUM [] by GENLIST
1095 = 0 by SUM
1096 = m * 0 by MULT_0
1097 Step: SUM (GENLIST (K m) n) = m * n ==> SUM (GENLIST (K m) (SUC n)) = m * SUC n
1098 SUM (GENLIST (K m) (SUC n))
1099 = SUM (SNOC m (GENLIST (K m) n)) by GENLIST
1100 = SUM (GENLIST (K m) n) + m by SUM_SNOC
1101 = m * n + m by induction hypothesis
1102 = m + m * n by ADD_COMM
1103 = m * SUC n by MULT_SUC
1104*)
1105Theorem SUM_GENLIST_K:
1106 !m n. SUM (GENLIST (K m) n) = m * n
1107Proof
1108 strip_tac >>
1109 Induct >-
1110 rw[] >>
1111 rw[GENLIST, SUM_SNOC, MULT_SUC]
1112QED
1113
1114(* Theorem: (LENGTH l1 = LENGTH l2) /\ (!k. k <= LENGTH l1 ==> EL k l1 <= EL k l2) ==> SUM l1 <= SUM l2 *)
1115(* Proof:
1116 By induction on l1.
1117 Base: LENGTH [] = LENGTH l2 ==> SUM [] <= SUM l2
1118 Note l2 = [] by LENGTH_EQ_0
1119 so SUM [] = SUM []
1120 or SUM [] <= SUM l2 by EQ_LESS_EQ
1121 Step: !l2. (LENGTH l1 = LENGTH l2) /\ ... ==> SUM l1 <= SUM l2 ==>
1122 (LENGTH (h::l1) = LENGTH l2) /\ ... ==> SUM h::l1 <= SUM l2
1123 Note l2 <> [] by LENGTH_EQ_0
1124 so ?h1 t2. l2 = h1::t1 by list_CASES
1125 and LENGTH l1 = LENGTH t1 by LENGTH
1126 SUM (h::l1)
1127 = h + SUM l1 by SUM_CONS
1128 <= h1 + SUM t1 by EL_ALL_PROPERTY, induction hypothesis
1129 = SUM l2 by SUM_CONS
1130*)
1131Theorem SUM_LE:
1132 !l1 l2. (LENGTH l1 = LENGTH l2) /\ (!k. k < LENGTH l1 ==> EL k l1 <= EL k l2) ==>
1133 SUM l1 <= SUM l2
1134Proof
1135 Induct >-
1136 metis_tac[LENGTH_EQ_0, EQ_LESS_EQ] >>
1137 rpt strip_tac >>
1138 `?h1 t1. l2 = h1::t1` by metis_tac[LENGTH_EQ_0, list_CASES] >>
1139 `LENGTH l1 = LENGTH t1` by metis_tac[LENGTH, SUC_EQ] >>
1140 `SUM (h::l1) = h + SUM l1` by rw[SUM_CONS] >>
1141 `SUM l2 = h1 + SUM t1` by rw[SUM_CONS] >>
1142 `(h <= h1) /\ SUM l1 <= SUM t1` by metis_tac[EL_ALL_PROPERTY] >>
1143 decide_tac
1144QED
1145
1146(* Theorem: MEM x l ==> x <= SUM l *)
1147(* Proof:
1148 By induction on l.
1149 Base: !x. MEM x [] ==> x <= SUM []
1150 True since MEM x [] = F by MEM
1151 Step: !x. MEM x l ==> x <= SUM l ==> !h x. MEM x (h::l) ==> x <= SUM (h::l)
1152 If x = h,
1153 Then h <= h + SUM l = SUM (h::l) by SUM
1154 If x <> h,
1155 Then MEM x l by MEM
1156 ==> x <= SUM l by induction hypothesis
1157 or x <= h + SUM l = SUM (h::l) by SUM
1158*)
1159Theorem SUM_LE_MEM:
1160 !l x. MEM x l ==> x <= SUM l
1161Proof
1162 Induct >-
1163 rw[] >>
1164 rw[] >-
1165 decide_tac >>
1166 `x <= SUM l` by rw[] >>
1167 decide_tac
1168QED
1169
1170(* Theorem: n < LENGTH l ==> (EL n l) <= SUM l *)
1171(* Proof: by SUM_LE_MEM, MEM_EL *)
1172Theorem SUM_LE_EL:
1173 !l n. n < LENGTH l ==> (EL n l) <= SUM l
1174Proof
1175 metis_tac[SUM_LE_MEM, MEM_EL]
1176QED
1177
1178(* Theorem: m < n /\ n < LENGTH l ==> (EL m l) + (EL n l) <= SUM l *)
1179(* Proof:
1180 By induction on l.
1181 Base: !m n. m < n /\ n < LENGTH [] ==> EL m [] + EL n [] <= SUM []
1182 True since n < LENGTH [] = F by LENGTH
1183 Step: !m n. m < LENGTH l /\ n < LENGTH l ==> EL m l + EL n l <= SUM l ==>
1184 !h m n. m < LENGTH (h::l) /\ n < LENGTH (h::l) ==> EL m (h::l) + EL n (h::l) <= SUM (h::l)
1185 Note 0 < n, or n <> 0 by m < n
1186 so ?k. n = SUC k by num_CASES
1187 and k < LENGTH l by SUC k < SUC (LENGTH l)
1188 and EL n (h::l) = EL k l by EL_restricted
1189 If m = 0,
1190 Then EL m (h::l) = h by EL_restricted
1191 and EL k l <= SUM l by SUM_LE_EL
1192 Thus EL m (h::l) + EL n (h::l)
1193 = h + SUM l
1194 = SUM (h::l) by SUM
1195 If m <> 0,
1196 Then ?j. m = SUC j by num_CASES
1197 and j < k by SUC j < SUC k
1198 and EL m (h::l) = EL j l by EL_restricted
1199 Thus EL m (h::l) + EL n (h::l)
1200 = EL j l + EL k l by above
1201 <= SUM l by induction hypothesis
1202 <= h + SUM l by arithmetic
1203 = SUM (h::l) by SUM
1204*)
1205Theorem SUM_LE_SUM_EL:
1206 !l m n. m < n /\ n < LENGTH l ==> (EL m l) + (EL n l) <= SUM l
1207Proof
1208 Induct >-
1209 rw[] >>
1210 rw[] >>
1211 `n <> 0` by decide_tac >>
1212 `?k. n = SUC k` by metis_tac[num_CASES] >>
1213 `k < LENGTH l` by decide_tac >>
1214 `EL n (h::l) = EL k l` by rw[] >>
1215 Cases_on `m = 0` >| [
1216 `EL m (h::l) = h` by rw[] >>
1217 `EL k l <= SUM l` by rw[SUM_LE_EL] >>
1218 decide_tac,
1219 `?j. m = SUC j` by metis_tac[num_CASES] >>
1220 `j < k` by decide_tac >>
1221 `EL m (h::l) = EL j l` by rw[] >>
1222 `EL j l + EL k l <= SUM l` by rw[] >>
1223 decide_tac
1224 ]
1225QED
1226
1227(* Theorem: SUM (GENLIST (\j. n * 2 ** j) m) = n * (2 ** m - 1) *)
1228(* Proof:
1229 The computation is:
1230 n + (n * 2) + (n * 4) + ... + (n * (2 ** (m - 1)))
1231 = n * (1 + 2 + 4 + ... + 2 ** (m - 1))
1232 = n * (2 ** m - 1)
1233
1234 By induction on m.
1235 Base: SUM (GENLIST (\j. n * 2 ** j) 0) = n * (2 ** 0 - 1)
1236 LHS = SUM (GENLIST (\j. n * 2 ** j) 0)
1237 = SUM [] by GENLIST_0
1238 = 0 by PROD
1239 RHS = n * (1 - 1) by EXP_0
1240 = n * 0 = 0 = LHS by MULT_0
1241 Step: SUM (GENLIST (\j. n * 2 ** j) m) = n * (2 ** m - 1) ==>
1242 SUM (GENLIST (\j. n * 2 ** j) (SUC m)) = n * (2 ** SUC m - 1)
1243 SUM (GENLIST (\j. n * 2 ** j) (SUC m))
1244 = SUM (SNOC (n * 2 ** m) (GENLIST (\j. n * 2 ** j) m)) by GENLIST
1245 = SUM (GENLIST (\j. n * 2 ** j) m) + (n * 2 ** m) by SUM_SNOC
1246 = n * (2 ** m - 1) + n * 2 ** m by induction hypothesis
1247 = n * (2 ** m - 1 + 2 ** m) by LEFT_ADD_DISTRIB
1248 = n * (2 * 2 ** m - 1) by arithmetic
1249 = n * (2 ** SUC m - 1) by EXP
1250*)
1251Theorem SUM_DOUBLING_LIST:
1252 !m n. SUM (GENLIST (\j. n * 2 ** j) m) = n * (2 ** m - 1)
1253Proof
1254 rpt strip_tac >>
1255 Induct_on `m` >-
1256 rw[] >>
1257 qabbrev_tac `f = \j. n * 2 ** j` >>
1258 `SUM (GENLIST f (SUC m)) = SUM (SNOC (n * 2 ** m) (GENLIST f m))` by rw[GENLIST, Abbr`f`] >>
1259 `_ = SUM (GENLIST f m) + (n * 2 ** m)` by rw[SUM_SNOC] >>
1260 `_ = n * (2 ** m - 1) + n * 2 ** m` by rw[] >>
1261 `_ = n * (2 ** m - 1 + 2 ** m)` by rw[LEFT_ADD_DISTRIB] >>
1262 rw[EXP]
1263QED
1264
1265
1266(* Idea: key theorem, almost like pigeonhole principle. *)
1267
1268(* List equivalent sum theorems. This is an example of digging out theorems. *)
1269
1270(* Theorem: EVERY (\x. 0 < x) ls ==> LENGTH ls <= SUM ls *)
1271(* Proof:
1272 Let P = (\x. 0 < x).
1273 By induction on list ls.
1274 Base: EVERY P [] ==> LENGTH [] <= SUM []
1275 Note EVERY P [] = T by EVERY_DEF
1276 and LENGTH [] = 0 by LENGTH
1277 and SUM [] = 0 by SUM
1278 Hence true.
1279 Step: EVERY P ls ==> LENGTH ls <= SUM ls ==>
1280 !h. EVERY P (h::ls) ==> LENGTH (h::ls) <= SUM (h::ls)
1281 Note 0 < h /\ EVERY P ls by EVERY_DEF
1282 LENGTH (h::ls)
1283 = 1 + LENGTH ls by LENGTH
1284 <= 1 + SUM ls by induction hypothesis
1285 <= h + SUM ls by 0 < h
1286 = SUM (h::ls) by SUM
1287*)
1288Theorem list_length_le_sum:
1289 !ls. EVERY (\x. 0 < x) ls ==> LENGTH ls <= SUM ls
1290Proof
1291 Induct >-
1292 rw[] >>
1293 rw[] >>
1294 `1 <= h` by decide_tac >>
1295 fs[]
1296QED
1297
1298(* Theorem: EVERY (\x. 0 < x) ls /\ LENGTH ls = SUM ls ==> EVERY (\x. x = 1) ls *)
1299(* Proof:
1300 Let P = (\x. 0 < x), Q = (\x. x = 1).
1301 By induction on list ls.
1302 Base: EVERY P [] /\ LENGTH [] = SUM [] ==> EVERY Q []
1303 Note EVERY Q [] = T by EVERY_DEF
1304 Hence true.
1305 Step: EVERY P ls /\ LENGTH ls = SUM ls ==> EVERY Q ls ==>
1306 !h. EVERY P (h::ls) /\ LENGTH (h::ls) = SUM (h::ls) ==> EVERY Q (h::ls)
1307 Note 0 < h /\ EVERY P ls by EVERY_DEF
1308 LHS = LENGTH (h::ls)
1309 = 1 + LENGTH ls by LENGTH
1310 <= 1 + SUM ls by list_length_le_sum
1311 RHS = SUM (h::ls)
1312 = h + SUM ls by SUM
1313 Thus h + SUM ls <= 1 + SUM ls
1314 or h <= 1 by arithmetic
1315 giving h = 1 by 0 < h
1316 Thus LENGTH ls = SUM ls by arithmetic
1317 and EVERY Q ls by induction hypothesis
1318 or EVERY Q (h::ls) by EVERY_DEF, h = 1
1319*)
1320Theorem list_length_eq_sum:
1321 !ls. EVERY (\x. 0 < x) ls /\ LENGTH ls = SUM ls ==> EVERY (\x. x = 1) ls
1322Proof
1323 Induct >-
1324 rw[] >>
1325 rpt strip_tac >>
1326 fs[] >>
1327 `LENGTH ls <= SUM ls` by rw[list_length_le_sum] >>
1328 `h + LENGTH ls <= SUC (LENGTH ls)` by fs[] >>
1329 `h = 1` by decide_tac >>
1330 `SUM ls = LENGTH ls` by fs[] >>
1331 simp[]
1332QED
1333
1334(* Theorem: (!x y. x <= y ==> f x <= f y) ==>
1335 !ls. ls <> [] ==> (MAX_LIST (MAP f ls) = f (MAX_LIST ls)) *)
1336(* Proof:
1337 By induction on ls.
1338 Base: [] <> [] ==> MAX_LIST (MAP f []) = f (MAX_LIST [])
1339 True by [] <> [] = F.
1340 Step: ls <> [] ==> MAX_LIST (MAP f ls) = f (MAX_LIST ls) ==>
1341 !h. h::ls <> [] ==> MAX_LIST (MAP f (h::ls)) = f (MAX_LIST (h::ls))
1342 If ls = [],
1343 MAX_LIST (MAP f [h])
1344 = MAX_LIST [f h] by MAP
1345 = f h by MAX_LIST_def
1346 = f (MAX_LIST [h]) by MAX_LIST_def
1347 If ls <> [],
1348 MAX_LIST (MAP f (h::ls))
1349 = MAX_LIST (f h::MAP f ls) by MAP
1350 = MAX (f h) MAX_LIST (MAP f ls) by MAX_LIST_def
1351 = MAX (f h) (f (MAX_LIST ls)) by induction hypothesis
1352 = f (MAX h (MAX_LIST ls)) by MAX_SWAP
1353 = f (MAX_LIST (h::ls)) by MAX_LIST_def
1354*)
1355Theorem MAX_LIST_MONO_MAP:
1356 !f. (!x y. x <= y ==> f x <= f y) ==>
1357 !ls. ls <> [] ==> (MAX_LIST (MAP f ls) = f (MAX_LIST ls))
1358Proof
1359 rpt strip_tac >>
1360 Induct_on `ls` >-
1361 rw[] >>
1362 rpt strip_tac >>
1363 Cases_on `ls = []` >-
1364 rw[] >>
1365 rw[MAX_SWAP]
1366QED
1367
1368(* Theorem: (!x y. x <= y ==> f x <= f y) ==>
1369 !ls. ls <> [] ==> (MIN_LIST (MAP f ls) = f (MIN_LIST ls)) *)
1370(* Proof:
1371 By induction on ls.
1372 Base: [] <> [] ==> MIN_LIST (MAP f []) = f (MIN_LIST [])
1373 True by [] <> [] = F.
1374 Step: ls <> [] ==> MIN_LIST (MAP f ls) = f (MIN_LIST ls) ==>
1375 !h. h::ls <> [] ==> MIN_LIST (MAP f (h::ls)) = f (MIN_LIST (h::ls))
1376 If ls = [],
1377 MIN_LIST (MAP f [h])
1378 = MIN_LIST [f h] by MAP
1379 = f h by MIN_LIST_def
1380 = f (MIN_LIST [h]) by MIN_LIST_def
1381 If ls <> [],
1382 MIN_LIST (MAP f (h::ls))
1383 = MIN_LIST (f h::MAP f ls) by MAP
1384 = MIN (f h) MIN_LIST (MAP f ls) by MIN_LIST_def
1385 = MIN (f h) (f (MIN_LIST ls)) by induction hypothesis
1386 = f (MIN h (MIN_LIST ls)) by MIN_SWAP
1387 = f (MIN_LIST (h::ls)) by MIN_LIST_def
1388*)
1389Theorem MIN_LIST_MONO_MAP:
1390 !f. (!x y. x <= y ==> f x <= f y) ==>
1391 !ls. ls <> [] ==> (MIN_LIST (MAP f ls) = f (MIN_LIST ls))
1392Proof
1393 rpt strip_tac >>
1394 Induct_on `ls` >-
1395 rw[] >>
1396 rpt strip_tac >>
1397 Cases_on `ls = []` >-
1398 rw[] >>
1399 rw[MIN_SWAP]
1400QED
1401
1402(* ------------------------------------------------------------------------- *)
1403(* List Nub and Set *)
1404(* ------------------------------------------------------------------------- *)
1405
1406(* Note:
1407> nub_def;
1408|- (nub [] = []) /\ !x l. nub (x::l) = if MEM x l then nub l else x::nub l
1409*)
1410
1411(* Theorem: nub [] = [] *)
1412(* Proof: by nub_def *)
1413Theorem nub_nil = nub_def |> CONJUNCT1;
1414(* val nub_nil = |- nub [] = []: thm *)
1415
1416(* Theorem: nub (x::l) = if MEM x l then nub l else x::nub l *)
1417(* Proof: by nub_def *)
1418Theorem nub_cons = nub_def |> CONJUNCT2;
1419(* val nub_cons = |- !x l. nub (x::l) = if MEM x l then nub l else x::nub l: thm *)
1420
1421(* Theorem: nub [x] = [x] *)
1422(* Proof:
1423 nub [x]
1424 = nub (x::[]) by notation
1425 = x :: nub [] by nub_cons, MEM x [] = F
1426 = x ::[] by nub_nil
1427 = [x] by notation
1428*)
1429Theorem nub_sing:
1430 !x. nub [x] = [x]
1431Proof
1432 rw[nub_def]
1433QED
1434
1435(* Theorem: ALL_DISTINCT (nub l) *)
1436(* Proof:
1437 By induction on l.
1438 Base: ALL_DISTINCT (nub [])
1439 ALL_DISTINCT (nub [])
1440 <=> ALL_DISTINCT [] by nub_nil
1441 <=> T by ALL_DISTINCT
1442 Step: ALL_DISTINCT (nub l) ==> !h. ALL_DISTINCT (nub (h::l))
1443 If MEM h l,
1444 Then nub (h::l) = nub l by nub_cons
1445 Thus ALL_DISTINCT (nub l) by induction hypothesis
1446 ==> ALL_DISTINCT (nub (h::l))
1447 If ~(MEM h l),
1448 Then nub (h::l) = h:nub l by nub_cons
1449 With ALL_DISTINCT (nub l) by induction hypothesis
1450 ==> ALL_DISTINCT (h::nub l) by ALL_DISTINCT, ~(MEM h l)
1451 or ALL_DISTINCT (nub (h::l))
1452*)
1453Theorem nub_all_distinct:
1454 !l. ALL_DISTINCT (nub l)
1455Proof
1456 Induct >-
1457 rw[nub_nil] >>
1458 rw[nub_cons]
1459QED
1460
1461(* Theorem: CARD (set l) = LENGTH (nub l) *)
1462(* Proof:
1463 Note set (nub l) = set l by nub_set
1464 and ALL_DISTINCT (nub l) by nub_all_distinct
1465 CARD (set l)
1466 = CARD (set (nub l)) by above
1467 = LENGTH (nub l) by ALL_DISTINCT_CARD_LIST_TO_SET, ALL_DISTINCT (nub l)
1468*)
1469Theorem CARD_LIST_TO_SET_EQ:
1470 !l. CARD (set l) = LENGTH (nub l)
1471Proof
1472 rpt strip_tac >>
1473 `set (nub l) = set l` by rw[nub_set] >>
1474 `ALL_DISTINCT (nub l)` by rw[nub_all_distinct] >>
1475 rw[GSYM ALL_DISTINCT_CARD_LIST_TO_SET]
1476QED
1477
1478(* Theorem: set [x] = {x} *)
1479(* Proof:
1480 set [x]
1481 = x INSERT set [] by LIST_TO_SET
1482 = x INSERT {} by LIST_TO_SET
1483 = {x} by INSERT_DEF
1484*)
1485Theorem MONO_LIST_TO_SET:
1486 !x. set [x] = {x}
1487Proof
1488 rw[]
1489QED
1490
1491(* Theorem: ~(MEM h l1) /\ (set (h::l1) = set l2) ==>
1492 ?p1 p2. ~(MEM h p1) /\ ~(MEM h p2) /\ (nub l2 = p1 ++ [h] ++ p2) /\ (set l1 = set (p1 ++ p2)) *)
1493(* Proof:
1494 Note MEM h (h::l1) by MEM
1495 or h IN set (h::l1) by notation
1496 so h IN set l2 by given
1497 or h IN set (nub l2) by nub_set
1498 so MEM h (nub l2) by notation
1499 or ?p1 p2. nub l2 = p1 ++ [h] ++ h2
1500 and ~(MEM h p1) /\ ~(MEM h p2) by MEM_SPLIT_APPEND_distinct
1501 Remaining goal: set l1 = set (p1 ++ p2)
1502
1503 Step 1: show set l1 SUBSET set (p1 ++ p2)
1504 Let x IN set l1.
1505 Then MEM x l1 ==> MEM x (h::l1) by MEM
1506 so x IN set (h::l1)
1507 or x IN set l2 by given
1508 or x IN set (nub l2) by nub_set
1509 or MEM x (nub l2) by notation
1510 But h <> x since MEM x l1 but ~MEM h l1
1511 so MEM x (p1 ++ p2) by MEM, MEM_APPEND
1512 or x IN set (p1 ++ p2) by notation
1513 Thus l1 SUBSET set (p1 ++ p2) by SUBSET_DEF
1514
1515 Step 2: show set (p1 ++ p2) SUBSET set l1
1516 Let x IN set (p1 ++ p2)
1517 or MEM x (p1 ++ p2) by notation
1518 so MEM x (nub l2) by MEM, MEM_APPEND
1519 or x IN set (nub l2) by notation
1520 ==> x IN set l2 by nub_set
1521 or x IN set (h::l1) by given
1522 or MEM x (h::l1) by notation
1523 But x <> h by MEM_APPEND, MEM x (p1 ++ p2) but ~(MEM h p1) /\ ~(MEM h p2)
1524 ==> MEM x l1 by MEM
1525 or x IN set l1 by notation
1526 Thus set (p1 ++ p2) SUBSET set l1 by SUBSET_DEF
1527
1528 Thus set l1 = set (p1 ++ p2) by SUBSET_ANTISYM
1529*)
1530Theorem LIST_TO_SET_REDUCTION:
1531 !l1 l2 h. ~(MEM h l1) /\ (set (h::l1) = set l2) ==>
1532 ?p1 p2. ~(MEM h p1) /\ ~(MEM h p2) /\ (nub l2 = p1 ++ [h] ++ p2) /\ (set l1 = set (p1 ++ p2))
1533Proof
1534 rpt strip_tac >>
1535 `MEM h (nub l2)` by metis_tac[MEM, nub_set] >>
1536 qabbrev_tac `l = nub l2` >>
1537 `?n. n < LENGTH l /\ (h = EL n l)` by rw[GSYM MEM_EL] >>
1538 `ALL_DISTINCT l` by rw[nub_all_distinct, Abbr`l`] >>
1539 `?p1 p2. (l = p1 ++ [h] ++ p2) /\ ~MEM h p1 /\ ~MEM h p2` by rw[GSYM MEM_SPLIT_APPEND_distinct] >>
1540 qexists_tac `p1` >>
1541 qexists_tac `p2` >>
1542 rpt strip_tac >-
1543 rw[] >>
1544 `set l1 SUBSET set (p1 ++ p2) /\ set (p1 ++ p2) SUBSET set l1` suffices_by metis_tac[SUBSET_ANTISYM] >>
1545 rewrite_tac[SUBSET_DEF] >>
1546 rpt strip_tac >-
1547 metis_tac[MEM_APPEND, MEM, nub_set] >>
1548 metis_tac[MEM_APPEND, MEM, nub_set]
1549QED
1550
1551(* ------------------------------------------------------------------------- *)
1552(* List Padding *)
1553(* ------------------------------------------------------------------------- *)
1554
1555(* Theorem: PAD_LEFT c n [] = GENLIST (K c) n *)
1556(* Proof: by PAD_LEFT *)
1557Theorem PAD_LEFT_NIL:
1558 !n c. PAD_LEFT c n [] = GENLIST (K c) n
1559Proof
1560 rw[PAD_LEFT]
1561QED
1562
1563(* Theorem: PAD_RIGHT c n [] = GENLIST (K c) n *)
1564(* Proof: by PAD_RIGHT *)
1565Theorem PAD_RIGHT_NIL:
1566 !n c. PAD_RIGHT c n [] = GENLIST (K c) n
1567Proof
1568 rw[PAD_RIGHT]
1569QED
1570
1571(* Theorem: LENGTH (PAD_LEFT c n s) = MAX n (LENGTH s) *)
1572(* Proof:
1573 LENGTH (PAD_LEFT c n s)
1574 = LENGTH (GENLIST (K c) (n - LENGTH s) ++ s) by PAD_LEFT
1575 = LENGTH (GENLIST (K c) (n - LENGTH s)) + LENGTH s by LENGTH_APPEND
1576 = n - LENGTH s + LENGTH s by LENGTH_GENLIST
1577 = MAX n (LENGTH s) by MAX_DEF
1578*)
1579Theorem PAD_LEFT_LENGTH:
1580 !n c s. LENGTH (PAD_LEFT c n s) = MAX n (LENGTH s)
1581Proof
1582 rw[PAD_LEFT, MAX_DEF]
1583QED
1584
1585(* Theorem: LENGTH (PAD_RIGHT c n s) = MAX n (LENGTH s) *)
1586(* Proof:
1587 LENGTH (PAD_LEFT c n s)
1588 = LENGTH (s ++ GENLIST (K c) (n - LENGTH s)) by PAD_RIGHT
1589 = LENGTH s + LENGTH (GENLIST (K c) (n - LENGTH s)) by LENGTH_APPEND
1590 = LENGTH s + (n - LENGTH s) by LENGTH_GENLIST
1591 = MAX n (LENGTH s) by MAX_DEF
1592*)
1593Theorem PAD_RIGHT_LENGTH:
1594 !n c s. LENGTH (PAD_RIGHT c n s) = MAX n (LENGTH s)
1595Proof
1596 rw[PAD_RIGHT, MAX_DEF]
1597QED
1598
1599(* Theorem: n <= LENGTH l ==> (PAD_LEFT c n l = l) *)
1600(* Proof:
1601 Note n - LENGTH l = 0 by n <= LENGTH l
1602 PAD_LEFT c (LENGTH l) l
1603 = GENLIST (K c) 0 ++ l by PAD_LEFT
1604 = [] ++ l by GENLIST
1605 = l by APPEND
1606*)
1607Theorem PAD_LEFT_ID:
1608 !l c n. n <= LENGTH l ==> (PAD_LEFT c n l = l)
1609Proof
1610 rpt strip_tac >>
1611 `n - LENGTH l = 0` by decide_tac >>
1612 rw[PAD_LEFT]
1613QED
1614
1615(* Theorem: n <= LENGTH l ==> (PAD_RIGHT c n l = l) *)
1616(* Proof:
1617 Note n - LENGTH l = 0 by n <= LENGTH l
1618 PAD_RIGHT c (LENGTH l) l
1619 = ll ++ GENLIST (K c) 0 by PAD_RIGHT
1620 = [] ++ l by GENLIST
1621 = l by APPEND_NIL
1622*)
1623Theorem PAD_RIGHT_ID:
1624 !l c n. n <= LENGTH l ==> (PAD_RIGHT c n l = l)
1625Proof
1626 rpt strip_tac >>
1627 `n - LENGTH l = 0` by decide_tac >>
1628 rw[PAD_RIGHT]
1629QED
1630
1631(* Theorem: PAD_LEFT c 0 l = l *)
1632(* Proof: by PAD_LEFT_ID *)
1633Theorem PAD_LEFT_0:
1634 !l c. PAD_LEFT c 0 l = l
1635Proof
1636 rw_tac std_ss[PAD_LEFT_ID]
1637QED
1638
1639(* Theorem: PAD_RIGHT c 0 l = l *)
1640(* Proof: by PAD_RIGHT_ID *)
1641Theorem PAD_RIGHT_0:
1642 !l c. PAD_RIGHT c 0 l = l
1643Proof
1644 rw_tac std_ss[PAD_RIGHT_ID]
1645QED
1646
1647(* Theorem: LENGTH l <= n ==> !c. PAD_LEFT c (SUC n) l = c:: PAD_LEFT c n l *)
1648(* Proof:
1649 PAD_LEFT c (SUC n) l
1650 = GENLIST (K c) (SUC n - LENGTH l) ++ l by PAD_LEFT
1651 = GENLIST (K c) (SUC (n - LENGTH l)) ++ l by LENGTH l <= n
1652 = SNOC c (GENLIST (K c) (n - LENGTH l)) ++ l by GENLIST
1653 = (GENLIST (K c) (n - LENGTH l)) ++ [c] ++ l by SNOC_APPEND
1654 = [c] ++ (GENLIST (K c) (n - LENGTH l)) ++ l by GENLIST_K_APPEND_K
1655 = [c] ++ ((GENLIST (K c) (n - LENGTH l)) ++ l) by APPEND_ASSOC
1656 = [c] ++ PAD_LEFT c n l by PAD_LEFT
1657 = c :: PAD_LEFT c n l by CONS_APPEND
1658*)
1659Theorem PAD_LEFT_CONS:
1660 !l n. LENGTH l <= n ==> !c. PAD_LEFT c (SUC n) l = c:: PAD_LEFT c n l
1661Proof
1662 rpt strip_tac >>
1663 qabbrev_tac `m = LENGTH l` >>
1664 `SUC n - m = SUC (n - m)` by decide_tac >>
1665 `PAD_LEFT c (SUC n) l = GENLIST (K c) (SUC n - m) ++ l` by rw[PAD_LEFT, Abbr`m`] >>
1666 `_ = SNOC c (GENLIST (K c) (n - m)) ++ l` by rw[GENLIST] >>
1667 `_ = (GENLIST (K c) (n - m)) ++ [c] ++ l` by rw[SNOC_APPEND] >>
1668 `_ = [c] ++ (GENLIST (K c) (n - m)) ++ l` by rw[GENLIST_K_APPEND_K] >>
1669 `_ = [c] ++ ((GENLIST (K c) (n - m)) ++ l)` by rw[APPEND_ASSOC] >>
1670 `_ = [c] ++ PAD_LEFT c n l` by rw[PAD_LEFT] >>
1671 `_ = c :: PAD_LEFT c n l` by rw[] >>
1672 rw[]
1673QED
1674
1675(* Theorem: LENGTH l <= n ==> !c. PAD_RIGHT c (SUC n) l = SNOC c (PAD_RIGHT c n l) *)
1676(* Proof:
1677 PAD_RIGHT c (SUC n) l
1678 = l ++ GENLIST (K c) (SUC n - LENGTH l) by PAD_RIGHT
1679 = l ++ GENLIST (K c) (SUC (n - LENGTH l)) by LENGTH l <= n
1680 = l ++ SNOC c (GENLIST (K c) (n - LENGTH l)) by GENLIST
1681 = SNOC c (l ++ (GENLIST (K c) (n - LENGTH l))) by APPEND_SNOC
1682 = SNOC c (PAD_RIGHT c n l) by PAD_RIGHT
1683*)
1684Theorem PAD_RIGHT_SNOC:
1685 !l n. LENGTH l <= n ==> !c. PAD_RIGHT c (SUC n) l = SNOC c (PAD_RIGHT c n l)
1686Proof
1687 rpt strip_tac >>
1688 qabbrev_tac `m = LENGTH l` >>
1689 `SUC n - m = SUC (n - m)` by decide_tac >>
1690 rw[PAD_RIGHT, GENLIST, APPEND_SNOC]
1691QED
1692
1693(* Theorem: h :: PAD_RIGHT c n t = PAD_RIGHT c (SUC n) (h::t) *)
1694(* Proof:
1695 h :: PAD_RIGHT c n t
1696 = h :: (t ++ GENLIST (K c) (n - LENGTH t)) by PAD_RIGHT
1697 = (h::t) ++ GENLIST (K c) (n - LENGTH t) by APPEND
1698 = (h::t) ++ GENLIST (K c) (SUC n - LENGTH (h::t)) by LENGTH
1699 = PAD_RIGHT c (SUC n) (h::t) by PAD_RIGHT
1700*)
1701Theorem PAD_RIGHT_CONS:
1702 !h t c n. h :: PAD_RIGHT c n t = PAD_RIGHT c (SUC n) (h::t)
1703Proof
1704 rw[PAD_RIGHT]
1705QED
1706
1707(* Theorem: l <> [] ==> (LAST (PAD_LEFT c n l) = LAST l) *)
1708(* Proof:
1709 Note ?h t. l = h::t by list_CASES
1710 LAST (PAD_LEFT c n l)
1711 = LAST (GENLIST (K c) (n - LENGTH (h::t)) ++ (h::t)) by PAD_LEFT
1712 = LAST (h::t) by LAST_APPEND_CONS
1713 = LAST l by notation
1714*)
1715Theorem PAD_LEFT_LAST:
1716 !l c n. l <> [] ==> (LAST (PAD_LEFT c n l) = LAST l)
1717Proof
1718 rpt strip_tac >>
1719 `?h t. l = h::t` by metis_tac[list_CASES] >>
1720 rw[PAD_LEFT, LAST_APPEND_CONS]
1721QED
1722
1723(* Theorem: (PAD_LEFT c n l = []) <=> ((l = []) /\ (n = 0)) *)
1724(* Proof:
1725 PAD_LEFT c n l = []
1726 <=> GENLIST (K c) (n - LENGTH l) ++ l = [] by PAD_LEFT
1727 <=> GENLIST (K c) (n - LENGTH l) = [] /\ l = [] by APPEND_eq_NIL
1728 <=> GENLIST (K c) n = [] /\ l = [] by LENGTH l = 0
1729 <=> n = 0 /\ l = [] by GENLIST_EQ_NIL
1730*)
1731Theorem PAD_LEFT_EQ_NIL:
1732 !l c n. (PAD_LEFT c n l = []) <=> ((l = []) /\ (n = 0))
1733Proof
1734 rw[PAD_LEFT, EQ_IMP_THM] >>
1735 fs[GENLIST_EQ_NIL]
1736QED
1737
1738(* Theorem: (PAD_RIGHT c n l = []) <=> ((l = []) /\ (n = 0)) *)
1739(* Proof:
1740 PAD_RIGHT c n l = []
1741 <=> l ++ GENLIST (K c) (n - LENGTH l) = [] by PAD_RIGHT
1742 <=> l = [] /\ GENLIST (K c) (n - LENGTH l) = [] by APPEND_eq_NIL
1743 <=> l = [] /\ GENLIST (K c) n = [] by LENGTH l = 0
1744 <=> l = [] /\ n = 0 by GENLIST_EQ_NIL
1745*)
1746Theorem PAD_RIGHT_EQ_NIL:
1747 !l c n. (PAD_RIGHT c n l = []) <=> ((l = []) /\ (n = 0))
1748Proof
1749 rw[PAD_RIGHT, EQ_IMP_THM] >>
1750 fs[GENLIST_EQ_NIL]
1751QED
1752
1753(* Theorem: 0 < n ==> (PAD_LEFT c n [] = PAD_LEFT c n [c]) *)
1754(* Proof:
1755 PAD_LEFT c n []
1756 = GENLIST (K c) n by PAD_LEFT, APPEND_NIL
1757 = GENLIST (K c) (SUC k) by n = SUC k, 0 < n
1758 = SNOC c (GENLIST (K c) k) by GENLIST, (K c) k = c
1759 = GENLIST (K c) k ++ [c] by SNOC_APPEND
1760 = PAD_LEFT c n [c] by PAD_LEFT
1761*)
1762Theorem PAD_LEFT_NIL_EQ:
1763 !n c. 0 < n ==> (PAD_LEFT c n [] = PAD_LEFT c n [c])
1764Proof
1765 rw[PAD_LEFT] >>
1766 `SUC (n - 1) = n` by decide_tac >>
1767 qabbrev_tac `f = (K c):num -> 'a` >>
1768 `f (n - 1) = c` by rw[Abbr`f`] >>
1769 metis_tac[SNOC_APPEND, GENLIST]
1770QED
1771
1772(* Theorem: 0 < n ==> (PAD_RIGHT c n [] = PAD_RIGHT c n [c]) *)
1773(* Proof:
1774 PAD_RIGHT c n []
1775 = GENLIST (K c) n by PAD_RIGHT
1776 = GENLIST (K c) (SUC (n - 1)) by 0 < n
1777 = c :: GENLIST (K c) (n - 1) by GENLIST_K_CONS
1778 = [c] ++ GENLIST (K c) (n - 1) by CONS_APPEND
1779 = PAD_RIGHT c (SUC (n - 1)) [c] by PAD_RIGHT
1780 = PAD_RIGHT c n [c] by 0 < n
1781*)
1782Theorem PAD_RIGHT_NIL_EQ:
1783 !n c. 0 < n ==> (PAD_RIGHT c n [] = PAD_RIGHT c n [c])
1784Proof
1785 rw[PAD_RIGHT] >>
1786 `SUC (n - 1) = n` by decide_tac >>
1787 metis_tac[GENLIST_K_CONS]
1788QED
1789
1790(* Theorem: PAD_RIGHT c n ls = ls ++ PAD_RIGHT c (n - LENGTH ls) [] *)
1791(* Proof:
1792 PAD_RIGHT c n ls
1793 = ls ++ GENLIST (K c) (n - LENGTH ls) by PAD_RIGHT
1794 = ls ++ ([] ++ GENLIST (K c) ((n - LENGTH ls) - 0) by APPEND_NIL, LENGTH
1795 = ls ++ PAD_RIGHT c (n - LENGTH ls) [] by PAD_RIGHT
1796*)
1797Theorem PAD_RIGHT_BY_RIGHT:
1798 !ls c n. PAD_RIGHT c n ls = ls ++ PAD_RIGHT c (n - LENGTH ls) []
1799Proof
1800 rw[PAD_RIGHT]
1801QED
1802
1803(* Theorem: PAD_RIGHT c n ls = ls ++ PAD_LEFT c (n - LENGTH ls) [] *)
1804(* Proof:
1805 PAD_RIGHT c n ls
1806 = ls ++ GENLIST (K c) (n - LENGTH ls) by PAD_RIGHT
1807 = ls ++ (GENLIST (K c) ((n - LENGTH ls) - 0) ++ []) by APPEND_NIL, LENGTH
1808 = ls ++ PAD_LEFT c (n - LENGTH ls) [] by PAD_LEFT
1809*)
1810Theorem PAD_RIGHT_BY_LEFT:
1811 !ls c n. PAD_RIGHT c n ls = ls ++ PAD_LEFT c (n - LENGTH ls) []
1812Proof
1813 rw[PAD_RIGHT, PAD_LEFT]
1814QED
1815
1816(* Theorem: PAD_LEFT c n ls = (PAD_RIGHT c (n - LENGTH ls) []) ++ ls *)
1817(* Proof:
1818 PAD_LEFT c n ls
1819 = GENLIST (K c) (n - LENGTH ls) ++ ls by PAD_LEFT
1820 = ([] ++ GENLIST (K c) ((n - LENGTH ls) - 0) ++ ls by APPEND_NIL, LENGTH
1821 = (PAD_RIGHT c (n - LENGTH ls) []) ++ ls by PAD_RIGHT
1822*)
1823Theorem PAD_LEFT_BY_RIGHT:
1824 !ls c n. PAD_LEFT c n ls = (PAD_RIGHT c (n - LENGTH ls) []) ++ ls
1825Proof
1826 rw[PAD_RIGHT, PAD_LEFT]
1827QED
1828
1829(* Theorem: PAD_LEFT c n ls = (PAD_LEFT c (n - LENGTH ls) []) ++ ls *)
1830(* Proof:
1831 PAD_LEFT c n ls
1832 = GENLIST (K c) (n - LENGTH ls) ++ ls by PAD_LEFT
1833 = ((GENLIST (K c) ((n - LENGTH ls) - 0) ++ []) ++ ls by APPEND_NIL, LENGTH
1834 = (PAD_LEFT c (n - LENGTH ls) []) ++ ls by PAD_LEFT
1835*)
1836Theorem PAD_LEFT_BY_LEFT:
1837 !ls c n. PAD_LEFT c n ls = (PAD_LEFT c (n - LENGTH ls) []) ++ ls
1838Proof
1839 rw[PAD_LEFT]
1840QED
1841
1842(* ------------------------------------------------------------------------- *)
1843(* PROD for List, similar to SUM for List *)
1844(* ------------------------------------------------------------------------- *)
1845
1846(* Overload a positive list *)
1847Overload POSITIVE = ``\l. !x. MEM x l ==> 0 < x``
1848Overload EVERY_POSITIVE = ``\l. EVERY (\k. 0 < k) l``
1849
1850(* Theorem: EVERY_POSITIVE ls <=> POSITIVE ls *)
1851(* Proof: by EVERY_MEM *)
1852Theorem POSITIVE_THM:
1853 !ls. EVERY_POSITIVE ls <=> POSITIVE ls
1854Proof
1855 rw[EVERY_MEM]
1856QED
1857
1858(* Note: For product of a number list, any zero element will make the product 0. *)
1859
1860(* Define PROD, similar to SUM *)
1861Definition PROD[simp,nocompute]:
1862 (PROD [] = 1) /\
1863 (PROD (h::t) = h * PROD t)
1864End
1865
1866(* Extract theorems from definition *)
1867Theorem PROD_NIL = PROD |> CONJUNCT1;
1868(* val PROD_NIL = |- PROD [] = 1: thm *)
1869
1870Theorem PROD_CONS = PROD |> CONJUNCT2;
1871(* val PROD_CONS = |- !h t. PROD (h::t) = h * PROD t: thm *)
1872
1873(* Theorem: PROD [n] = n *)
1874(* Proof: by PROD *)
1875Theorem PROD_SING:
1876 !n. PROD [n] = n
1877Proof
1878 rw[]
1879QED
1880
1881(* Theorem: PROD ls = if ls = [] then 1 else (HD ls) * PROD (TL ls) *)
1882(* Proof: by PROD *)
1883Theorem PROD_eval[compute]: (* put in computeLib *)
1884 !ls. PROD ls = if ls = [] then 1 else (HD ls) * PROD (TL ls)
1885Proof
1886 metis_tac[PROD, list_CASES, HD, TL]
1887QED
1888
1889(* enable PROD computation -- use [compute] above. *)
1890(* val _ = computeLib.add_persistent_funs ["PROD_eval"]; *)
1891
1892(* Theorem: (PROD ls = 1) = !x. MEM x ls ==> (x = 1) *)
1893(* Proof:
1894 By induction on ls.
1895 Base: (PROD [] = 1) <=> !x. MEM x [] ==> (x = 1)
1896 LHS: PROD [] = 1 is true by PROD
1897 RHS: is true since MEM x [] = F by MEM
1898 Step: (PROD ls = 1) <=> !x. MEM x ls ==> (x = 1) ==>
1899 !h. (PROD (h::ls) = 1) <=> !x. MEM x (h::ls) ==> (x = 1)
1900 Note 1 = PROD (h::ls) by given
1901 = h * PROD ls by PROD
1902 Thus h = 1 /\ PROD ls = 1 by MULT_EQ_1
1903 or h = 1 /\ !x. MEM x ls ==> (x = 1) by induction hypothesis
1904 or !x. MEM x (h::ls) ==> (x = 1) by MEM
1905*)
1906Theorem PROD_eq_1:
1907 !ls. (PROD ls = 1) = !x. MEM x ls ==> (x = 1)
1908Proof
1909 Induct >>
1910 rw[] >>
1911 metis_tac[]
1912QED
1913
1914(* Theorem: PROD (SNOC x l) = (PROD l) * x *)
1915(* Proof:
1916 By induction on l.
1917 Base: PROD (SNOC x []) = PROD [] * x
1918 PROD (SNOC x [])
1919 = PROD [x] by SNOC
1920 = x by PROD
1921 = 1 * x by MULT_LEFT_1
1922 = PROD [] * x by PROD
1923 Step: PROD (SNOC x l) = PROD l * x ==> !h. PROD (SNOC x (h::l)) = PROD (h::l) * x
1924 PROD (SNOC x (h::l))
1925 = PROD (h:: SNOC x l) by SNOC
1926 = h * PROD (SNOC x l) by PROD
1927 = h * (PROD l * x) by induction hypothesis
1928 = (h * PROD l) * x by MULT_ASSOC
1929 = PROD (h::l) * x by PROD
1930*)
1931Theorem PROD_SNOC:
1932 !x l. PROD (SNOC x l) = (PROD l) * x
1933Proof
1934 strip_tac >>
1935 Induct >>
1936 rw[]
1937QED
1938
1939(* Theorem: PROD (APPEND l1 l2) = PROD l1 * PROD l2 *)
1940(* Proof:
1941 By induction on l1.
1942 Base: PROD ([] ++ l2) = PROD [] * PROD l2
1943 PROD ([] ++ l2)
1944 = PROD l2 by APPEND
1945 = 1 * PROD l2 by MULT_LEFT_1
1946 = PROD [] * PROD l2 by PROD
1947 Step: !l2. PROD (l1 ++ l2) = PROD l1 * PROD l2 ==> !h l2. PROD (h::l1 ++ l2) = PROD (h::l1) * PROD l2
1948 PROD (h::l1 ++ l2)
1949 = PROD (h::(l1 ++ l2)) by APPEND
1950 = h * PROD (l1 ++ l2) by PROD
1951 = h * (PROD l1 * PROD l2) by induction hypothesis
1952 = (h * PROD l1) * PROD l2 by MULT_ASSOC
1953 = PROD (h::l1) * PROD l2 by PROD
1954*)
1955Theorem PROD_APPEND:
1956 !l1 l2. PROD (APPEND l1 l2) = PROD l1 * PROD l2
1957Proof
1958 Induct >> rw[]
1959QED
1960
1961(* Theorem: PROD (MAP f ls) = FOLDL (\a e. a * f e) 1 ls *)
1962(* Proof:
1963 By SNOC_INDUCT |- !P. P [] /\ (!l. P l ==> !x. P (SNOC x l)) ==> !l. P l
1964 Base: PROD (MAP f []) = FOLDL (\a e. a * f e) 1 []
1965 PROD (MAP f [])
1966 = PROD [] by MAP
1967 = 1 by PROD
1968 = FOLDL (\a e. a * f e) 1 [] by FOLDL
1969 Step: !f. PROD (MAP f ls) = FOLDL (\a e. a * f e) 1 ls ==>
1970 PROD (MAP f (SNOC x ls)) = FOLDL (\a e. a * f e) 1 (SNOC x ls)
1971 PROD (MAP f (SNOC x ls))
1972 = PROD (SNOC (f x) (MAP f ls)) by MAP_SNOC
1973 = PROD (MAP f ls) * (f x) by PROD_SNOC
1974 = (FOLDL (\a e. a * f e) 1 ls) * (f x) by induction hypothesis
1975 = (\a e. a * f e) (FOLDL (\a e. a * f e) 1 ls) x by function application
1976 = FOLDL (\a e. a * f e) 1 (SNOC x ls) by FOLDL_SNOC
1977*)
1978Theorem PROD_MAP_FOLDL:
1979 !ls f. PROD (MAP f ls) = FOLDL (\a e. a * f e) 1 ls
1980Proof
1981 HO_MATCH_MP_TAC SNOC_INDUCT >>
1982 rpt strip_tac >-
1983 rw[] >>
1984 rw[MAP_SNOC, PROD_SNOC, FOLDL_SNOC]
1985QED
1986
1987(* Theorem: FINITE s ==> !f. PI f s = PROD (MAP f (SET_TO_LIST s)) *)
1988(* Proof:
1989 PI f s
1990 = ITSET (\e acc. f e * acc) s 1 by PROD_IMAGE_DEF
1991 = FOLDL (combin$C (\e acc. f e * acc)) 1 (SET_TO_LIST s) by ITSET_eq_FOLDL_SET_TO_LIST, FINITE s
1992 = FOLDL (\a e. a * f e) 1 (SET_TO_LIST s) by FUN_EQ_THM
1993 = PROD (MAP f (SET_TO_LIST s)) by PROD_MAP_FOLDL
1994*)
1995Theorem PROD_IMAGE_eq_PROD_MAP_SET_TO_LIST:
1996 !s. FINITE s ==> !f. PI f s = PROD (MAP f (SET_TO_LIST s))
1997Proof
1998 rw[PROD_IMAGE_DEF] >>
1999 rw[ITSET_eq_FOLDL_SET_TO_LIST, PROD_MAP_FOLDL] >>
2000 rpt AP_THM_TAC >>
2001 AP_TERM_TAC >>
2002 rw[FUN_EQ_THM]
2003QED
2004
2005(* Define PROD using accumulator *)
2006Definition PROD_ACC_DEF:
2007 (PROD_ACC [] acc = acc) /\
2008 (PROD_ACC (h::t) acc = PROD_ACC t (h * acc))
2009End
2010
2011(* Theorem: PROD_ACC L n = PROD L * n *)
2012(* Proof:
2013 By induction on L.
2014 Base: !n. PROD_ACC [] n = PROD [] * n
2015 PROD_ACC [] n
2016 = n by PROD_ACC_DEF
2017 = 1 * n by MULT_LEFT_1
2018 = PROD [] * n by PROD
2019 Step: !n. PROD_ACC L n = PROD L * n ==> !h n. PROD_ACC (h::L) n = PROD (h::L) * n
2020 PROD_ACC (h::L) n
2021 = PROD_ACC L (h * n) by PROD_ACC_DEF
2022 = PROD L * (h * n) by induction hypothesis
2023 = (PROD L * h) * n by MULT_ASSOC
2024 = (h * PROD L) * n by MULT_COMM
2025 = PROD (h::L) * n by PROD
2026*)
2027Theorem PROD_ACC_PROD_LEM:
2028 !L n. PROD_ACC L n = PROD L * n
2029Proof
2030 Induct >>
2031 rw[PROD_ACC_DEF]
2032QED
2033(* proof SUM_ACC_SUM_LEM *)
2034Theorem PROD_ACC_SUM_LEM:
2035 !L n. PROD_ACC L n = PROD L * n
2036Proof
2037 Induct THEN RW_TAC arith_ss [PROD_ACC_DEF, PROD]
2038QED
2039
2040(* Theorem: PROD L = PROD_ACC L 1 *)
2041(* Proof: Put n = 1 in PROD_ACC_PROD_LEM *)
2042Theorem PROD_PROD_ACC[compute]:
2043 !L. PROD L = PROD_ACC L 1
2044Proof
2045 rw[PROD_ACC_PROD_LEM]
2046QED
2047
2048(* EVAL ``PROD [1; 2; 3; 4]``; --> 24 *)
2049
2050(* Theorem: PROD (GENLIST (K m) n) = m ** n *)
2051(* Proof:
2052 By induction on n.
2053 Base: PROD (GENLIST (K m) 0) = m ** 0
2054 PROD (GENLIST (K m) 0)
2055 = PROD [] by GENLIST
2056 = 1 by PROD
2057 = m ** 0 by EXP
2058 Step: PROD (GENLIST (K m) n) = m ** n ==> PROD (GENLIST (K m) (SUC n)) = m ** SUC n
2059 PROD (GENLIST (K m) (SUC n))
2060 = PROD (SNOC m (GENLIST (K m) n)) by GENLIST
2061 = PROD (GENLIST (K m) n) * m by PROD_SNOC
2062 = m ** n * m by induction hypothesis
2063 = m * m ** n by MULT_COMM
2064 = m * SUC n by EXP
2065*)
2066Theorem PROD_GENLIST_K:
2067 !m n. PROD (GENLIST (K m) n) = m ** n
2068Proof
2069 strip_tac >>
2070 Induct >-
2071 rw[] >>
2072 rw[GENLIST, PROD_SNOC, EXP]
2073QED
2074
2075(* Same as PROD_GENLIST_K, formulated slightly different. *)
2076
2077(* Theorem: PPROD (GENLIST (\j. x) n) = x ** n *)
2078(* Proof:
2079 Note (\j. x) = K x by FUN_EQ_THM
2080 PROD (GENLIST (\j. x) n)
2081 = PROD (GENLIST (K x) n) by GENLIST_FUN_EQ
2082 = x ** n by PROD_GENLIST_K
2083*)
2084Theorem PROD_CONSTANT:
2085 !n x. PROD (GENLIST (\j. x) n) = x ** n
2086Proof
2087 rpt strip_tac >>
2088 `(\j. x) = K x` by rw[FUN_EQ_THM] >>
2089 metis_tac[PROD_GENLIST_K, GENLIST_FUN_EQ]
2090QED
2091
2092(* Theorem: (PROD l = 0) <=> MEM 0 l *)
2093(* Proof:
2094 By induction on l.
2095 Base: (PROD [] = 0) <=> MEM 0 []
2096 LHS = F by PROD_NIL, 1 <> 0
2097 RHS = F by MEM
2098 Step: (PROD l = 0) <=> MEM 0 l ==> !h. (PROD (h::l) = 0) <=> MEM 0 (h::l)
2099 Note PROD (h::l) = h * PROD l by PROD_CONS
2100 Thus PROD (h::l) = 0
2101 ==> h = 0 \/ PROD l = 0 by MULT_EQ_0
2102 If h = 0, then MEM 0 (h::l) by MEM
2103 If PROD l = 0, then MEM 0 l by induction hypothesis
2104 or MEM 0 (h::l) by MEM
2105*)
2106Theorem PROD_EQ_0:
2107 !l. (PROD l = 0) <=> MEM 0 l
2108Proof
2109 Induct >-
2110 rw[] >>
2111 metis_tac[PROD_CONS, MULT_EQ_0, MEM]
2112QED
2113
2114(* Theorem: EVERY (\x. 0 < x) l ==> 0 < PROD l *)
2115(* Proof:
2116 By contradiction, suppose PROD l = 0.
2117 Then MEM 0 l by PROD_EQ_0
2118 or 0 < 0 = F by EVERY_MEM
2119*)
2120Theorem PROD_POS:
2121 !l. EVERY (\x. 0 < x) l ==> 0 < PROD l
2122Proof
2123 metis_tac[EVERY_MEM, PROD_EQ_0, NOT_ZERO_LT_ZERO]
2124QED
2125
2126(* Theorem: POSITIVE l ==> 0 < PROD l *)
2127(* Proof: PROD_POS, EVERY_MEM *)
2128Theorem PROD_POS_ALT:
2129 !l. POSITIVE l ==> 0 < PROD l
2130Proof
2131 rw[PROD_POS, EVERY_MEM]
2132QED
2133
2134(* Theorem: PROD (GENLIST (\j. n ** 2 ** j) m) = n ** (2 ** m - 1) *)
2135(* Proof:
2136 The computation is:
2137 n * (n ** 2) * (n ** 4) * ... * (n ** (2 ** (m - 1)))
2138 = n ** (1 + 2 + 4 + ... + 2 ** (m - 1))
2139 = n ** (2 ** m - 1)
2140
2141 By induction on m.
2142 Base: PROD (GENLIST (\j. n ** 2 ** j) 0) = n ** (2 ** 0 - 1)
2143 LHS = PROD (GENLIST (\j. n ** 2 ** j) 0)
2144 = PROD [] by GENLIST_0
2145 = 1 by PROD
2146 RHS = n ** (1 - 1) by EXP_0
2147 = n ** 0 = 1 = LHS by EXP_0
2148 Step: PROD (GENLIST (\j. n ** 2 ** j) m) = n ** (2 ** m - 1) ==>
2149 PROD (GENLIST (\j. n ** 2 ** j) (SUC m)) = n ** (2 ** SUC m - 1)
2150 PROD (GENLIST (\j. n ** 2 ** j) (SUC m))
2151 = PROD (SNOC (n ** 2 ** m) (GENLIST (\j. n ** 2 ** j) m)) by GENLIST
2152 = PROD (GENLIST (\j. n ** 2 ** j) m) * (n ** 2 ** m) by PROD_SNOC
2153 = n ** (2 ** m - 1) * n ** 2 ** m by induction hypothesis
2154 = n ** (2 ** m - 1 + 2 ** m) by EXP_ADD
2155 = n ** (2 * 2 ** m - 1) by arithmetic
2156 = n ** (2 ** SUC m - 1) by EXP
2157*)
2158Theorem PROD_SQUARING_LIST:
2159 !m n. PROD (GENLIST (\j. n ** 2 ** j) m) = n ** (2 ** m - 1)
2160Proof
2161 rpt strip_tac >>
2162 Induct_on `m` >-
2163 rw[] >>
2164 qabbrev_tac `f = \j. n ** 2 ** j` >>
2165 `PROD (GENLIST f (SUC m)) = PROD (SNOC (n ** 2 ** m) (GENLIST f m))` by rw[GENLIST, Abbr`f`] >>
2166 `_ = PROD (GENLIST f m) * (n ** 2 ** m)` by rw[PROD_SNOC] >>
2167 `_ = n ** (2 ** m - 1) * n ** 2 ** m` by rw[] >>
2168 `_ = n ** (2 ** m - 1 + 2 ** m)` by rw[EXP_ADD] >>
2169 rw[EXP]
2170QED
2171
2172(* ------------------------------------------------------------------------- *)
2173(* List Range *)
2174(* ------------------------------------------------------------------------- *)
2175
2176(* Theorem: 0 < m ==> 0 < PROD [m .. n] *)
2177(* Proof:
2178 Note MEM 0 [m .. n] = F by MEM_listRangeINC
2179 Thus PROD [m .. n] <> 0 by PROD_EQ_0
2180 The result follows.
2181 or
2182 Note EVERY_POSITIVE [m .. n] by listRangeINC_EVERY
2183 Thus 0 < PROD [m .. n] by PROD_POS
2184*)
2185Theorem listRangeINC_PROD_pos:
2186 !m n. 0 < m ==> 0 < PROD [m .. n]
2187Proof
2188 rw[PROD_POS, listRangeINC_EVERY]
2189QED
2190
2191(* Theorem: 0 < m /\ m <= n ==> (PROD [m .. n] = PROD [1 .. n] DIV PROD [1 .. (m - 1)]) *)
2192(* Proof:
2193 If m = 1,
2194 Then [1 .. (m-1)] = [1 .. 0] = [] by listRangeINC_EMPTY
2195 PROD [1 .. n]
2196 = PROD [1 .. n] DIV 1 by DIV_ONE
2197 = PROD [1 .. n] DIV PROD [] by PROD_NIL
2198 If m <> 1, then 1 <= m by m <> 0, m <> 1
2199 Note 1 <= m - 1 /\ m - 1 < n /\ (m - 1 + 1 = m) by arithmetic
2200 Thus [1 .. n] = [1 .. (m - 1)] ++ [m .. n] by listRangeINC_APPEND
2201 or PROD [1 .. n] = PROD [1 .. (m - 1)] * PROD [m .. n] by PROD_POS
2202 Now 0 < PROD [1 .. (m - 1)] by listRangeINC_PROD_pos
2203 The result follows by MULT_TO_DIV
2204*)
2205Theorem listRangeINC_PROD:
2206 !m n. 0 < m /\ m <= n ==> (PROD [m .. n] = PROD [1 .. n] DIV PROD [1 .. (m - 1)])
2207Proof
2208 rpt strip_tac >>
2209 Cases_on `m = 1` >-
2210 rw[listRangeINC_EMPTY] >>
2211 `1 <= m - 1 /\ m - 1 <= n /\ (m - 1 + 1 = m)` by decide_tac >>
2212 `[1 .. n] = [1 .. (m - 1)] ++ [m .. n]` by metis_tac[listRangeINC_APPEND] >>
2213 `PROD [1 .. n] = PROD [1 .. (m - 1)] * PROD [m .. n]` by rw[GSYM PROD_APPEND] >>
2214 `0 < PROD [1 .. (m - 1)]` by rw[listRangeINC_PROD_pos] >>
2215 metis_tac[MULT_TO_DIV]
2216QED
2217
2218(* Theorem: 0 < m ==> 0 < PROD [m ..< n] *)
2219(* Proof:
2220 Note MEM 0 [m ..< n] = F by MEM_listRangeLHI
2221 Thus PROD [m ..< n] <> 0 by PROD_EQ_0
2222 The result follows.
2223 or,
2224 Note EVERY_POSITIVE [m ..< n] by listRangeLHI_EVERY
2225 Thus 0 < PROD [m ..< n] by PROD_POS
2226*)
2227Theorem listRangeLHI_PROD_pos:
2228 !m n. 0 < m ==> 0 < PROD [m ..< n]
2229Proof
2230 rw[PROD_POS, listRangeLHI_EVERY]
2231QED
2232
2233(* Theorem: 0 < m /\ m <= n ==> (PROD [m ..< n] = PROD [1 ..< n] DIV PROD [1 ..< m]) *)
2234(* Proof:
2235 Note n <> 0 by 0 < m /\ m <= n
2236 Let m = m' + 1, n = n' + 1 by num_CASES, ADD1
2237 If m = n,
2238 Note 0 < PROD [1 ..< n] by listRangeLHI_PROD_pos
2239 LHS = PROD [n ..< n]
2240 = PROD [] = 1 by listRangeLHI_EMPTY
2241 RHS = PROD [1 ..< n] DIV PROD [1 ..< n]
2242 = 1 by DIVMOD_ID, 0 < PROD [1 ..< n]
2243 If m <> n,
2244 Then m < n, or m <= n' by arithmetic
2245 PROD [m ..< n]
2246 = PROD [m .. n'] by listRangeLHI_to_INC
2247 = PROD [1 .. n'] DIV PROD [1 .. m - 1] by listRangeINC_PROD, m <= n'
2248 = PROD [1 .. n'] DIV PROD [1 .. m'] by m' = m - 1
2249 = PROD [1 ..< n] DIV PROD [1 ..< m] by listRangeLHI_to_INC
2250*)
2251Theorem listRangeLHI_PROD:
2252 !m n. 0 < m /\ m <= n ==> (PROD [m ..< n] = PROD [1 ..< n] DIV PROD [1 ..< m])
2253Proof
2254 rpt strip_tac >>
2255 `m <> 0 /\ n <> 0` by decide_tac >>
2256 `?n' m'. (n = n' + 1) /\ (m = m' + 1)` by metis_tac[num_CASES, ADD1] >>
2257 Cases_on `m = n` >| [
2258 `0 < PROD [1 ..< n]` by rw[listRangeLHI_PROD_pos] >>
2259 rfs[listRangeLHI_EMPTY, DIVMOD_ID],
2260 `m <= n'` by decide_tac >>
2261 `PROD [m ..< n] = PROD [m .. n']` by rw[listRangeLHI_to_INC] >>
2262 `_ = PROD [1 .. n'] DIV PROD [1 .. m - 1]` by rw[GSYM listRangeINC_PROD] >>
2263 `_ = PROD [1 .. n'] DIV PROD [1 .. m']` by rw[] >>
2264 `_ = PROD [1 ..< n] DIV PROD [1 ..< m]` by rw[GSYM listRangeLHI_to_INC] >>
2265 rw[]
2266 ]
2267QED
2268
2269(* ------------------------------------------------------------------------- *)
2270(* List Summation and Product *)
2271(* ------------------------------------------------------------------------- *)
2272
2273(*
2274> numpairTheory.tri_def;
2275val it = |- tri 0 = 0 /\ !n. tri (SUC n) = SUC n + tri n: thm
2276*)
2277
2278(* Theorem: SUM [1 .. n] = tri n *)
2279(* Proof:
2280 By induction on n,
2281 Base: SUM [1 .. 0] = tri 0
2282 SUM [1 .. 0]
2283 = SUM [] by listRangeINC_EMPTY
2284 = 0 by SUM_NIL
2285 = tri 0 by tri_def
2286 Step: SUM [1 .. n] = tri n ==> SUM [1 .. SUC n] = tri (SUC n)
2287 SUM [1 .. SUC n]
2288 = SUM (SNOC (SUC n) [1 .. n]) by listRangeINC_SNOC, 1 < n
2289 = SUM [1 .. n] + (SUC n) by SUM_SNOC
2290 = tri n + (SUC n) by induction hypothesis
2291 = tri (SUC n) by tri_def
2292*)
2293Theorem sum_1_to_n_eq_tri_n:
2294 !n. SUM [1 .. n] = tri n
2295Proof
2296 Induct >-
2297 rw[listRangeINC_EMPTY, SUM_NIL, numpairTheory.tri_def] >>
2298 rw[listRangeINC_SNOC, ADD1, SUM_SNOC, numpairTheory.tri_def]
2299QED
2300
2301(* Theorem: SUM [1 .. n] = HALF (n * (n + 1)) *)
2302(* Proof:
2303 SUM [1 .. n]
2304 = tri n by sum_1_to_n_eq_tri_n
2305 = HALF (n * (n + 1)) by tri_formula
2306*)
2307Theorem sum_1_to_n_eqn:
2308 !n. SUM [1 .. n] = HALF (n * (n + 1))
2309Proof
2310 rw[sum_1_to_n_eq_tri_n, numpairTheory.tri_formula]
2311QED
2312
2313(* Theorem: 2 * SUM [1 .. n] = n * (n + 1) *)
2314(* Proof:
2315 Note EVEN (n * (n + 1)) by EVEN_PARTNERS
2316 or 2 divides (n * (n + 1)) by EVEN_ALT
2317 Thus n * (n + 1)
2318 = ((n * (n + 1)) DIV 2) * 2 by DIV_MULT_EQ
2319 = (SUM [1 .. n]) * 2 by sum_1_to_n_eqn
2320 = 2 * SUM [1 .. n] by MULT_COMM
2321*)
2322Theorem sum_1_to_n_double:
2323 !n. 2 * SUM [1 .. n] = n * (n + 1)
2324Proof
2325 rpt strip_tac >>
2326 `2 divides (n * (n + 1))` by rw[EVEN_PARTNERS, GSYM EVEN_ALT] >>
2327 metis_tac[sum_1_to_n_eqn, DIV_MULT_EQ, MULT_COMM, DECIDE``0 < 2``]
2328QED
2329
2330(* Theorem: PROD [1 .. n] = FACT n *)
2331(* Proof:
2332 By induction on n,
2333 Base: PROD [1 .. 0] = FACT 0
2334 PROD [1 .. 0]
2335 = PROD [] by listRangeINC_EMPTY
2336 = 1 by PROD_NIL
2337 = FACT 0 by FACT
2338 Step: PROD [1 .. n] = FACT n ==> PROD [1 .. SUC n] = FACT (SUC n)
2339 PROD [1 .. SUC n] = FACT (SUC n)
2340 = PROD (SNOC (SUC n) [1 .. n]) by listRangeINC_SNOC, 1 < n
2341 = PROD [1 .. n] * (SUC n) by PROD_SNOC
2342 = (FACT n) * (SUC n) by induction hypothesis
2343 = FACT (SUC n) by FACT
2344*)
2345Theorem prod_1_to_n_eq_fact_n:
2346 !n. PROD [1 .. n] = FACT n
2347Proof
2348 Induct >-
2349 rw[listRangeINC_EMPTY, PROD_NIL, FACT] >>
2350 rw[listRangeINC_SNOC, ADD1, PROD_SNOC, FACT]
2351QED
2352
2353(* This is numerical version of:
2354poly_cyclic_cofactor |- !r. Ring r /\ #1 <> #0 ==> !n. unity n = unity 1 * cyclic n
2355*)
2356(* Theorem: (t ** n - 1 = (t - 1) * SUM (MAP (\j. t ** j) [0 ..< n])) *)
2357(* Proof:
2358 Let f = (\j. t ** j).
2359 By induction on n.
2360 Base: t ** 0 - 1 = (t - 1) * SUM (MAP f [0 ..< 0])
2361 LHS = t ** 0 - 1 = 0 by EXP_0
2362 RHS = (t - 1) * SUM (MAP f [0 ..< 0])
2363 = (t - 1) * SUM [] by listRangeLHI_EMPTY
2364 = (t - 1) * 0 = 0 by SUM
2365 Step: t ** n - 1 = (t - 1) * SUM (MAP f [0 ..< n]) ==>
2366 t ** SUC n - 1 = (t - 1) * SUM (MAP f [0 ..< SUC n])
2367 If t = 0,
2368 LHS = 0 ** SUC n - 1 = 0 by EXP_0
2369 RHS = (0 - 1) * SUM (MAP f [0 ..< SUC n])
2370 = 0 * SUM (MAP f [0 ..< SUC n]) by integer subtraction
2371 = 0 = LHS
2372 If t <> 0,
2373 Then 0 < t ** n by EXP_POS
2374 or 1 <= t ** n by arithmetic
2375 so (t ** n - 1) + (t * t ** n - t ** n) = t * t ** n - 1
2376 (t - 1) * SUM (MAP (\j. t ** j) [0 ..< (SUC n)])
2377 = (t - 1) * SUM (MAP (\j. t ** j) [0 ..< n + 1]) by ADD1
2378 = (t - 1) * SUM (MAP (\j. t ** j) (SNOC n [0 ..< n])) by listRangeLHI_SNOC
2379 = (t - 1) * SUM (SNOC (t ** n) (MAP f [0 ..< n])) by MAP_SNOC
2380 = (t - 1) * (SUM (MAP f [0 ..< n]) + t ** n) by SUM_SNOC
2381 = (t - 1) * SUM (MAP f [0 ..< n]) + (t - 1) * t ** n by RIGHT_ADD_DISTRIB
2382 = (t ** n - 1) + (t - 1) * t ** n by induction hypothesis
2383 = t ** SUC n - 1 by EXP
2384*)
2385Theorem power_predecessor_eqn:
2386 !t n. t ** n - 1 = (t - 1) * SUM (MAP (\j. t ** j) [0 ..< n])
2387Proof
2388 rpt strip_tac >>
2389 qabbrev_tac `f = \j. t ** j` >>
2390 Induct_on `n` >-
2391 rw[EXP_0, Abbr`f`] >>
2392 Cases_on `t = 0` >-
2393 rw[ZERO_EXP, Abbr`f`] >>
2394 `(t ** n - 1) + (t * t ** n - t ** n) = t * t ** n - 1` by
2395 (`0 < t` by decide_tac >>
2396 `0 < t ** n` by rw[EXP_POS] >>
2397 `1 <= t ** n` by decide_tac >>
2398 `t ** n <= t * t ** n` by rw[] >>
2399 decide_tac) >>
2400 `(t - 1) * SUM (MAP f [0 ..< (SUC n)]) = (t - 1) * SUM (MAP f [0 ..< n + 1])` by rw[ADD1] >>
2401 `_ = (t - 1) * SUM (MAP f (SNOC n [0 ..< n]))` by rw[listRangeLHI_SNOC] >>
2402 `_ = (t - 1) * SUM (SNOC (t ** n) (MAP f [0 ..< n]))` by rw[MAP_SNOC, Abbr`f`] >>
2403 `_ = (t - 1) * (SUM (MAP f [0 ..< n]) + t ** n)` by rw[SUM_SNOC] >>
2404 `_ = (t - 1) * SUM (MAP f [0 ..< n]) + (t - 1) * t ** n` by rw[RIGHT_ADD_DISTRIB] >>
2405 `_ = (t ** n - 1) + (t - 1) * t ** n` by rw[] >>
2406 `_ = (t ** n - 1) + (t * t ** n - t ** n)` by rw[LEFT_SUB_DISTRIB] >>
2407 `_ = t * t ** n - 1` by rw[] >>
2408 `_ = t ** SUC n - 1 ` by rw[GSYM EXP] >>
2409 rw[]
2410QED
2411
2412(* Above is the formal proof of the following observation for any base:
2413 9 = 9 * 1
2414 99 = 9 * 11
2415 999 = 9 * 111
2416 9999 = 9 * 1111
2417 99999 = 8 * 11111
2418 etc.
2419
2420 This asserts:
2421 (t ** n - 1) = (t - 1) * (1 + t + t ** 2 + ... + t ** (n-1))
2422 or 1 + t + t ** 2 + ... + t ** (n - 1) = (t ** n - 1) DIV (t - 1),
2423 which is the sum of the geometric series.
2424*)
2425
2426(* Theorem: 1 < t ==> (SUM (MAP (\j. t ** j) [0 ..< n]) = (t ** n - 1) DIV (t - 1)) *)
2427(* Proof:
2428 Note 0 < t - 1 by 1 < t
2429 Let s = SUM (MAP (\j. t ** j) [0 ..< n]).
2430 Then (t ** n - 1) = (t - 1) * s by power_predecessor_eqn
2431 Thus s = (t ** n - 1) DIV (t - 1) by MULT_TO_DIV, 0 < t - 1
2432*)
2433Theorem geometric_sum_eqn:
2434 !t n. 1 < t ==> (SUM (MAP (\j. t ** j) [0 ..< n]) = (t ** n - 1) DIV (t - 1))
2435Proof
2436 rpt strip_tac >>
2437 `0 < t - 1` by decide_tac >>
2438 rw_tac std_ss[power_predecessor_eqn, MULT_TO_DIV]
2439QED
2440
2441(* Theorem: 1 < t ==> (SUM (MAP (\j. t ** j) [0 .. n]) = (t ** (n + 1) - 1) DIV (t - 1)) *)
2442(* Proof:
2443 SUM (MAP (\j. t ** j) [0 .. n])
2444 = SUM (MAP (\j. t ** j) [0 ..< n + 1]) by listRangeLHI_to_INC
2445 = (t ** (n + 1) - 1) DIV (t - 1) by geometric_sum_eqn
2446*)
2447Theorem geometric_sum_eqn_alt:
2448 !t n. 1 < t ==> (SUM (MAP (\j. t ** j) [0 .. n]) = (t ** (n + 1) - 1) DIV (t - 1))
2449Proof
2450 rw_tac std_ss[GSYM listRangeLHI_to_INC, geometric_sum_eqn]
2451QED
2452
2453(* Theorem: SUM [1 ..< n] = HALF (n * (n - 1)) *)
2454(* Proof:
2455 If n = 0,
2456 LHS = SUM [1 ..< 0]
2457 = SUM [] = 0 by listRangeLHI_EMPTY
2458 RHS = HALF (0 * (0 - 1))
2459 = 0 = LHS by arithmetic
2460 If n <> 0,
2461 Then n = (n - 1) + 1 by arithmetic, n <> 0
2462 SUM [1 ..< n]
2463 = SUM [1 .. n - 1] by listRangeLHI_to_INC
2464 = HALF ((n - 1) * (n - 1 + 1)) by sum_1_to_n_eqn
2465 = HALF (n * (n - 1)) by arithmetic
2466*)
2467Theorem arithmetic_sum_eqn:
2468 !n. SUM [1 ..< n] = HALF (n * (n - 1))
2469Proof
2470 rpt strip_tac >>
2471 Cases_on `n = 0` >-
2472 rw[listRangeLHI_EMPTY] >>
2473 `n = (n - 1) + 1` by decide_tac >>
2474 `SUM [1 ..< n] = SUM [1 .. n - 1]` by rw[GSYM listRangeLHI_to_INC] >>
2475 `_ = HALF ((n - 1) * (n - 1 + 1))` by rw[sum_1_to_n_eqn] >>
2476 `_ = HALF (n * (n - 1))` by rw[] >>
2477 rw[]
2478QED
2479
2480(* Theorem alias *)
2481Theorem arithmetic_sum_eqn_alt = sum_1_to_n_eqn;
2482(* val arithmetic_sum_eqn_alt = |- !n. SUM [1 .. n] = HALF (n * (n + 1)): thm *)
2483
2484(* Theorem: SUM (GENLIST (\j. f (n - j)) n) = SUM (MAP f [1 .. n]) *)
2485(* Proof:
2486 SUM (GENLIST (\j. f (n - j)) n)
2487 = SUM (REVERSE (GENLIST (\j. f (n - j)) n)) by SUM_REVERSE
2488 = SUM (GENLIST (\j. f (n - (PRE n - j))) n) by REVERSE_GENLIST
2489 = SUM (GENLIST (\j. f (1 + j)) n) by LIST_EQ, SUB_SUB
2490 = SUM (GENLIST (f o SUC) n) by FUN_EQ_THM
2491 = SUM (MAP f [1 .. n]) by listRangeINC_MAP
2492*)
2493Theorem SUM_GENLIST_REVERSE:
2494 !f n. SUM (GENLIST (\j. f (n - j)) n) = SUM (MAP f [1 .. n])
2495Proof
2496 rpt strip_tac >>
2497 `GENLIST (\j. f (n - (PRE n - j))) n = GENLIST (f o SUC) n` by
2498 (irule LIST_EQ >>
2499 rw[] >>
2500 `n + x - PRE n = SUC x` by decide_tac >>
2501 simp[]) >>
2502 qabbrev_tac `g = \j. f (n - j)` >>
2503 `SUM (GENLIST g n) = SUM (REVERSE (GENLIST g n))` by rw[SUM_REVERSE] >>
2504 `_ = SUM (GENLIST (\j. g (PRE n - j)) n)` by rw[REVERSE_GENLIST] >>
2505 `_ = SUM (GENLIST (f o SUC) n)` by rw[Abbr`g`] >>
2506 `_ = SUM (MAP f [1 .. n])` by rw[listRangeINC_MAP] >>
2507 decide_tac
2508QED
2509(* Note: locate here due to use of listRangeINC_MAP *)
2510
2511(* Theorem: SIGMA f (count n) = SUM (MAP f [0 ..< n]) *)
2512(* Proof:
2513 SIGMA f (count n)
2514 = SUM (GENLIST f n) by SUM_GENLIST
2515 = SUM (MAP f [0 ..< n]) by listRangeLHI_MAP
2516*)
2517Theorem SUM_IMAGE_count:
2518 !f n. SIGMA f (count n) = SUM (MAP f [0 ..< n])
2519Proof
2520 simp[SUM_GENLIST, listRangeLHI_MAP]
2521QED
2522(* Note: locate here due to use of listRangeINC_MAP *)
2523
2524(* Theorem: SIGMA f (count (SUC n)) = SUM (MAP f [0 .. n]) *)
2525(* Proof:
2526 SIGMA f (count (SUC n))
2527 = SUM (GENLIST f (SUC n)) by SUM_GENLIST
2528 = SUM (MAP f [0 ..< (SUC n)]) by SUM_IMAGE_count
2529 = SUM (MAP f [0 .. n]) by listRangeINC_to_LHI
2530*)
2531Theorem SUM_IMAGE_upto:
2532 !f n. SIGMA f (count (SUC n)) = SUM (MAP f [0 .. n])
2533Proof
2534 simp[SUM_GENLIST, SUM_IMAGE_count, listRangeINC_to_LHI]
2535QED
2536
2537(*
2538MEM_MAP |- !l f x. MEM x (MAP f l) <=> ?y. x = f y /\ MEM y l
2539*)
2540
2541(* Theorem: MEM x (MAP2 f l1 l2) ==> ?y1 y2. x = f y1 y2 /\ MEM y1 l1 /\ MEM y2 l2 *)
2542(* Proof:
2543 By induction on l1.
2544 Base: !l2. MEM x (MAP2 f [] l2) ==> ?y1 y2. x = f y1 y2 /\ MEM y1 [] /\ MEM y2 l2
2545 Note MAP2 f [] l2 = [] by MAP2_DEF
2546 and MEM x [] = F, hence true by MEM
2547 Step: !l2. MEM x (MAP2 f l1 l2) ==> ?y1 y2. x = f y1 y2 /\ MEM y1 l1 /\ MEM y2 l2 ==>
2548 !h l2. MEM x (MAP2 f (h::l1) l2) ==> ?y1 y2. x = f y1 y2 /\ MEM y1 (h::l1) /\ MEM y2 l2
2549 If l2 = [],
2550 Then MEM x (MAP2 f (h::l1) []) = F, hence true by MEM
2551 Otherwise, l2 = h'::t,
2552 to show: MEM x (MAP2 f (h::l1) (h'::t)) ==> ?y1 y2. x = f y1 y2 /\ MEM y1 (h::l1) /\ MEM y2 (h'::t)
2553 Note MAP2 f (h::l1) (h'::t)
2554 = (f h h')::MAP2 f l1 t by MAP2
2555 Thus x = f h h' or MEM x (MAP2 f l1 t) by MEM
2556 If x = f h h',
2557 Take y1 = h, y2 = h', and the result follows by MEM
2558 If MEM x (MAP2 f l1 t)
2559 Then ?y1 y2. x = f y1 y2 /\ MEM y1 l1 /\ MEM y2 t by induction hypothesis
2560 Take this y1 and y2, the result follows by MEM
2561*)
2562Theorem MEM_MAP2:
2563 !f x l1 l2. MEM x (MAP2 f l1 l2) ==> ?y1 y2. (x = f y1 y2) /\ MEM y1 l1 /\ MEM y2 l2
2564Proof
2565 ntac 2 strip_tac >>
2566 Induct_on `l1` >-
2567 rw[] >>
2568 rpt strip_tac >>
2569 Cases_on `l2` >-
2570 fs[] >>
2571 fs[] >-
2572 metis_tac[] >>
2573 metis_tac[MEM]
2574QED
2575
2576(* Theorem: MEM x (MAP3 f l1 l2 l3) ==> ?y1 y2 y3. (x = f y1 y2 y3) /\ MEM y1 l1 /\ MEM y2 l2 /\ MEM y3 l3 *)
2577(* Proof:
2578 By induction on l1.
2579 Base: !l2 l3. MEM x (MAP3 f [] l2 l3) ==> ...
2580 Note MAP3 f [] l2 l3 = [], and MEM x [] = F, hence true.
2581 Step: !l2 l3. MEM x (MAP3 f l1 l2 l3) ==>
2582 ?y1 y2 y3. x = f y1 y2 y3 /\ MEM y1 l1 /\ MEM y2 l2 /\ MEM y3 l3 ==>
2583 !h l2 l3. MEM x (MAP3 f (h::l1) l2 l3) ==>
2584 ?y1 y2 y3. x = f y1 y2 y3 /\ MEM y1 (h::l1) /\ MEM y2 l2 /\ MEM y3 l3
2585 If l2 = [],
2586 Then MEM x (MAP3 f (h::l1) [] l3) = MEM x [] = F, hence true by MAP3_DEF
2587 Otherwise, l2 = h'::t,
2588 to show: MEM x (MAP3 f (h::l1) (h'::t) l3) ==>
2589 ?y1 y2 y3. x = f y1 y2 y3 /\ MEM y1 (h::l1) /\ MEM y2 (h'::t) /\ MEM y3 l3
2590 If l3 = [],
2591 Then MEM x (MAP3 f (h::l1) l2 []) = MEM x [] = F, hence true by MAP3_DEF
2592 Otherwise, l3 = h''::t',
2593 to show: MEM x (MAP3 f (h::l1) (h'::t) (h''::t')) ==>
2594 ?y1 y2 y3. x = f y1 y2 y3 /\ MEM y1 (h::l1) /\ MEM y2 (h'::t) /\ MEM y3 (h''::t')
2595
2596 Note MAP3 f (h::l1) (h'::t) (h''::t')
2597 = (f h h' h'')::MAP3 f l1 t t' by MAP3
2598 Thus x = f h h' h'' or MEM x (MAP3 f l1 t t') by MEM
2599 If x = f h h' h'',
2600 Take y1 = h, y2 = h', y3 = h'' and the result follows by MEM
2601 If MEM x (MAP3 f l1 t t')
2602 Then ?y1 y2 y3. x = f y1 y2 y3 /\ MEM y1 t /\ MEM y2 l2 /\ MEM y3 t'
2603 by induction hypothesis
2604 Take this y1, y2 and y3, the result follows by MEM
2605*)
2606Theorem MEM_MAP3:
2607 !f x l1 l2 l3. MEM x (MAP3 f l1 l2 l3) ==>
2608 ?y1 y2 y3. (x = f y1 y2 y3) /\ MEM y1 l1 /\ MEM y2 l2 /\ MEM y3 l3
2609Proof
2610 ntac 2 strip_tac >>
2611 Induct_on `l1` >-
2612 rw[] >>
2613 rpt strip_tac >>
2614 Cases_on `l2` >-
2615 fs[] >>
2616 Cases_on `l3` >-
2617 fs[] >>
2618 fs[] >-
2619 metis_tac[] >>
2620 metis_tac[MEM]
2621QED
2622
2623(* Theorem: SUM (MAP (K c) ls) = c * LENGTH ls *)
2624(* Proof:
2625 By induction on ls.
2626 Base: !c. SUM (MAP (K c) []) = c * LENGTH []
2627 LHS = SUM (MAP (K c) [])
2628 = SUM [] = 0 by MAP, SUM
2629 RHS = c * LENGTH []
2630 = c * 0 = 0 = LHS by LENGTH
2631 Step: !c. SUM (MAP (K c) ls) = c * LENGTH ls ==>
2632 !h c. SUM (MAP (K c) (h::ls)) = c * LENGTH (h::ls)
2633 SUM (MAP (K c) (h::ls))
2634 = SUM (c :: MAP (K c) ls) by MAP
2635 = c + SUM (MAP (K c) ls) by SUM
2636 = c + c * LENGTH ls by induction hypothesis
2637 = c * (1 + LENGTH ls) by RIGHT_ADD_DISTRIB
2638 = c * (SUC (LENGTH ls)) by ADD1
2639 = c * LENGTH (h::ls) by LENGTH
2640*)
2641Theorem SUM_MAP_K:
2642 !ls c. SUM (MAP (K c) ls) = c * LENGTH ls
2643Proof
2644 Induct >-
2645 rw[] >>
2646 rw[ADD1]
2647QED
2648
2649(* Theorem: a <= b ==> SUM (MAP (K a) ls) <= SUM (MAP (K b) ls) *)
2650(* Proof:
2651 SUM (MAP (K a) ls)
2652 = a * LENGTH ls by SUM_MAP_K
2653 <= b * LENGTH ls by a <= b
2654 = SUM (MAP (K b) ls) by SUM_MAP_K
2655*)
2656Theorem SUM_MAP_K_LE:
2657 !ls a b. a <= b ==> SUM (MAP (K a) ls) <= SUM (MAP (K b) ls)
2658Proof
2659 rw[SUM_MAP_K]
2660QED
2661
2662(* Theorem: SUM (MAP2 (\x y. c) lx ly) = c * LENGTH (MAP2 (\x y. c) lx ly) *)
2663(* Proof:
2664 By induction on lx.
2665 Base: !ly c. SUM (MAP2 (\x y. c) [] ly) = c * LENGTH (MAP2 (\x y. c) [] ly)
2666 LHS = SUM (MAP2 (\x y. c) [] ly)
2667 = SUM [] = 0 by MAP2_DEF, SUM
2668 RHS = c * LENGTH (MAP2 (\x y. c) [] ly)
2669 = c * 0 = 0 = LHS by MAP2_DEF, LENGTH
2670 Step: !ly c. SUM (MAP2 (\x y. c) lx ly) = c * LENGTH (MAP2 (\x y. c) lx ly) ==>
2671 !h ly c. SUM (MAP2 (\x y. c) (h::lx) ly) = c * LENGTH (MAP2 (\x y. c) (h::lx) ly)
2672 If ly = [],
2673 to show: SUM (MAP2 (\x y. c) (h::lx) []) = c * LENGTH (MAP2 (\x y. c) (h::lx) [])
2674 LHS = SUM (MAP2 (\x y. c) (h::lx) [])
2675 = SUM [] = 0 by MAP2_DEF, SUM
2676 RHS = c * LENGTH (MAP2 (\x y. c) (h::lx) [])
2677 = c * 0 = 0 = LHS by MAP2_DEF, LENGTH
2678 Otherwise, ly = h'::t,
2679 to show: SUM (MAP2 (\x y. c) (h::lx) (h'::t)) = c * LENGTH (MAP2 (\x y. c) (h::lx) (h'::t))
2680
2681 SUM (MAP2 (\x y. c) (h::lx) (h'::t))
2682 = SUM (c :: MAP2 (\x y. c) lx t) by MAP2_DEF
2683 = c + SUM (MAP2 (\x y. c) lx t) by SUM
2684 = c + c * LENGTH (MAP2 (\x y. c) lx t) by induction hypothesis
2685 = c * (1 + LENGTH (MAP2 (\x y. c) lx t) by RIGHT_ADD_DISTRIB
2686 = c * (SUC (LENGTH (MAP2 (\x y. c) lx t)) by ADD1
2687 = c * LENGTH (MAP2 (\x y. c) (h::lx) (h'::t)) by LENGTH
2688*)
2689Theorem SUM_MAP2_K:
2690 !lx ly c. SUM (MAP2 (\x y. c) lx ly) = c * LENGTH (MAP2 (\x y. c) lx ly)
2691Proof
2692 Induct >-
2693 rw[] >>
2694 rpt strip_tac >>
2695 Cases_on `ly` >-
2696 rw[] >>
2697 rw[ADD1, MIN_DEF]
2698QED
2699
2700Theorem SUM_MAP3_K:
2701 !lx ly lz c.
2702 SUM (MAP3 (\x y z. c) lx ly lz) = c * LENGTH (MAP3 (\x y z. c) lx ly lz)
2703Proof
2704 Induct >- rw[] >>
2705 rpt strip_tac >>
2706 Cases_on `ly` >- rw[] >>
2707 Cases_on `lz` >- rw[] >>
2708 simp[] >> rw[MIN_DEF, ADD1]
2709QED
2710
2711(* ------------------------------------------------------------------------- *)
2712(* Bounds on Lists *)
2713(* ------------------------------------------------------------------------- *)
2714
2715(* Theorem: SUM ls <= (MAX_LIST ls) * LENGTH ls *)
2716(* Proof:
2717 By induction on ls.
2718 Base: SUM [] <= MAX_LIST [] * LENGTH []
2719 LHS = SUM [] = 0 by SUM
2720 RHS = MAX_LIST [] * LENGTH []
2721 = 0 * 0 = 0 by MAX_LIST, LENGTH
2722 Hence true.
2723 Step: SUM ls <= MAX_LIST ls * LENGTH ls ==>
2724 !h. SUM (h::ls) <= MAX_LIST (h::ls) * LENGTH (h::ls)
2725 SUM (h::ls)
2726 = h + SUM ls by SUM
2727 <= h + MAX_LIST ls * LENGTH ls by induction hypothesis
2728 <= MAX_LIST (h::ls) + MAX_LIST ls * LENGTH ls by MAX_LIST_PROPERTY
2729 <= MAX_LIST (h::ls) + MAX_LIST (h::ls) * LENGTH ls by MAX_LIST_LE
2730 = MAX_LIST (h::ls) * (1 + LENGTH ls) by LEFT_ADD_DISTRIB
2731 = MAX_LIST (h::ls) * LENGTH (h::ls) by LENGTH
2732*)
2733Theorem SUM_UPPER:
2734 !ls. SUM ls <= (MAX_LIST ls) * LENGTH ls
2735Proof
2736 Induct_on `ls` >- rw[] >>
2737 strip_tac >>
2738 `SUM (h::ls) <= h + MAX_LIST ls * LENGTH ls` by rw[] >>
2739 `h + MAX_LIST ls * LENGTH ls <= MAX_LIST (h::ls) + MAX_LIST ls * LENGTH ls`
2740 by rw[] >>
2741 `MAX_LIST (h::ls) + MAX_LIST ls * LENGTH ls ≤
2742 MAX_LIST (h::ls) + MAX_LIST (h::ls) * LENGTH ls` by rw[] >>
2743 `MAX_LIST (h::ls) + MAX_LIST (h::ls) * LENGTH ls =
2744 MAX_LIST (h::ls) * (1 + LENGTH ls)` by rw[] >>
2745 `_ = MAX_LIST (h::ls) * LENGTH (h::ls)` by rw[] >>
2746 decide_tac
2747QED
2748
2749(* Theorem: (MIN_LIST ls) * LENGTH ls <= SUM ls *)
2750(* Proof:
2751 By induction on ls.
2752 Base: MIN_LIST [] * LENGTH [] <= SUM []
2753 LHS = (MIN_LIST []) * LENGTH [] = 0 by LENGTH
2754 RHS = SUM [] = 0 by SUM
2755 Hence true.
2756 Step: MIN_LIST ls * LENGTH ls <= SUM ls ==>
2757 !h. MIN_LIST (h::ls) * LENGTH (h::ls) <= SUM (h::ls)
2758 If ls = [],
2759 LHS = (MIN_LIST [h]) * LENGTH [h]
2760 = h * 1 = h by MIN_LIST_def, LENGTH
2761 RHS = SUM [h] = h by SUM
2762 Hence true.
2763 If ls <> [],
2764 MIN_LIST (h::ls) * LENGTH (h::ls)
2765 = (MIN h (MIN_LIST ls)) * (1 + LENGTH ls) by MIN_LIST_def, LENGTH
2766 = (MIN h (MIN_LIST ls)) + (MIN h (MIN_LIST ls)) * LENGTH ls
2767 by RIGHT_ADD_DISTRIB
2768 <= h + (MIN_LIST ls) * LENGTH ls by MIN_IS_MIN
2769 <= h + SUM ls by induction hypothesis
2770 = SUM (h::ls) by SUM
2771*)
2772Theorem SUM_LOWER:
2773 !ls. (MIN_LIST ls) * LENGTH ls <= SUM ls
2774Proof
2775 Induct_on `ls` >-
2776 rw[] >>
2777 strip_tac >>
2778 Cases_on `ls = []` >-
2779 rw[] >>
2780 `MIN_LIST (h::ls) * LENGTH (h::ls) = (MIN h (MIN_LIST ls)) * (1 + LENGTH ls)` by rw[] >>
2781 `_ = (MIN h (MIN_LIST ls)) + (MIN h (MIN_LIST ls)) * LENGTH ls` by rw[] >>
2782 `(MIN h (MIN_LIST ls)) <= h` by rw[] >>
2783 `(MIN h (MIN_LIST ls)) * LENGTH ls <= (MIN_LIST ls) * LENGTH ls` by rw[] >>
2784 rw[]
2785QED
2786
2787(* Theorem: EVERY (\x. f x <= g x) ls ==> SUM (MAP f ls) <= SUM (MAP g ls) *)
2788(* Proof:
2789 By induction on ls.
2790 Base: EVERY (\x. f x <= g x) [] ==> SUM (MAP f []) <= SUM (MAP g [])
2791 EVERY (\x. f x <= g x) [] = T by EVERY_DEF
2792 SUM (MAP f [])
2793 = SUM [] by MAP
2794 = SUM (MAP g []) by MAP
2795 Step: EVERY (\x. f x <= g x) ls ==> SUM (MAP f ls) <= SUM (MAP g ls) ==>
2796 !h. EVERY (\x. f x <= g x) (h::ls) ==> SUM (MAP f (h::ls)) <= SUM (MAP g (h::ls))
2797 Note f h <= g h /\
2798 EVERY (\x. f x <= g x) ls by EVERY_DEF
2799 SUM (MAP f (h::ls))
2800 = SUM (f h :: MAP f ls) by MAP
2801 = f h + SUM (MAP f ls) by SUM
2802 <= g h + SUM (MAP g ls) by above, induction hypothesis
2803 = SUM (g h :: MAP g ls) by SUM
2804 = SUM (MAP g (h::ls)) by MAP
2805*)
2806Theorem SUM_MAP_LE:
2807 !f g ls. EVERY (\x. f x <= g x) ls ==> SUM (MAP f ls) <= SUM (MAP g ls)
2808Proof
2809 rpt strip_tac >>
2810 Induct_on `ls` >>
2811 rw[] >>
2812 rw[] >>
2813 fs[]
2814QED
2815
2816(* Theorem: EVERY (\x. f x < g x) ls /\ ls <> [] ==> SUM (MAP f ls) < SUM (MAP g ls) *)
2817(* Proof:
2818 By induction on ls.
2819 Base: EVERY (\x. f x <= g x) [] /\ [] <> [] ==> SUM (MAP f []) <= SUM (MAP g [])
2820 True since [] <> [] = F.
2821 Step: EVERY (\x. f x <= g x) ls ==> ls <> [] ==> SUM (MAP f ls) <= SUM (MAP g ls) ==>
2822 !h. EVERY (\x. f x <= g x) (h::ls) ==> h::ls <> [] ==> SUM (MAP f (h::ls)) <= SUM (MAP g (h::ls))
2823 Note f h < g h /\
2824 EVERY (\x. f x < g x) ls by EVERY_DEF
2825
2826 If ls = [],
2827 SUM (MAP f [h])
2828 = SUM (f h) by MAP
2829 = f h by SUM
2830 < g h by above
2831 = SUM (g h) by SUM
2832 = SUM (MAP g [h]) by MAP
2833
2834 If ls <> [],
2835 SUM (MAP f (h::ls))
2836 = SUM (f h :: MAP f ls) by MAP
2837 = f h + SUM (MAP f ls) by SUM
2838 < g h + SUM (MAP g ls) by induction hypothesis
2839 = SUM (g h :: MAP g ls) by SUM
2840 = SUM (MAP g (h::ls)) by MAP
2841*)
2842Theorem SUM_MAP_LT:
2843 !f g ls. EVERY (\x. f x < g x) ls /\ ls <> [] ==> SUM (MAP f ls) < SUM (MAP g ls)
2844Proof
2845 rpt strip_tac >>
2846 Induct_on `ls` >>
2847 rw[] >>
2848 rw[] >>
2849 (Cases_on `ls = []` >> fs[])
2850QED
2851
2852(*
2853MAX_LIST_PROPERTY |- !l x. MEM x l ==> x <= MAX_LIST l
2854MIN_LIST_PROPERTY |- !l. l <> [] ==> !x. MEM x l ==> MIN_LIST l <= x
2855*)
2856
2857(* Theorem: MONO f ==> !ls e. MEM e (MAP f ls) ==> e <= f (MAX_LIST ls) *)
2858(* Proof:
2859 Note ?y. (e = f y) /\ MEM y ls by MEM_MAP
2860 and y <= MAX_LIST ls by MAX_LIST_PROPERTY
2861 Thus f y <= f (MAX_LIST ls) by given
2862 or e <= f (MAX_LIST ls) by e = f y
2863*)
2864Theorem MEM_MAP_UPPER:
2865 !f. MONO f ==> !ls e. MEM e (MAP f ls) ==> e <= f (MAX_LIST ls)
2866Proof
2867 rpt strip_tac >>
2868 `?y. (e = f y) /\ MEM y ls` by rw[GSYM MEM_MAP] >>
2869 `y <= MAX_LIST ls` by rw[MAX_LIST_PROPERTY] >>
2870 rw[]
2871QED
2872
2873(* Theorem: MONO2 f ==> !lx ly e. MEM e (MAP2 f lx ly) ==> e <= f (MAX_LIST lx) (MAX_LIST ly) *)
2874(* Proof:
2875 Note ?ex ey. (e = f ex ey) /\
2876 MEM ex lx /\ MEM ey ly by MEM_MAP2
2877 and ex <= MAX_LIST lx by MAX_LIST_PROPERTY
2878 and ey <= MAX_LIST ly by MAX_LIST_PROPERTY
2879 The result follows by the non-decreasing condition on f.
2880*)
2881Theorem MEM_MAP2_UPPER:
2882 !f. MONO2 f ==> !lx ly e. MEM e (MAP2 f lx ly) ==> e <= f (MAX_LIST lx) (MAX_LIST ly)
2883Proof
2884 metis_tac[MEM_MAP2, MAX_LIST_PROPERTY]
2885QED
2886
2887(* Theorem: MONO3 f ==>
2888 !lx ly lz e. MEM e (MAP3 f lx ly lz) ==> e <= f (MAX_LIST lx) (MAX_LIST ly) (MAX_LIST lz) *)
2889(* Proof:
2890 Note ?ex ey ez. (e = f ex ey ez) /\
2891 MEM ex lx /\ MEM ey ly /\ MEM ez lz by MEM_MAP3
2892 and ex <= MAX_LIST lx by MAX_LIST_PROPERTY
2893 and ey <= MAX_LIST ly by MAX_LIST_PROPERTY
2894 and ez <= MAX_LIST lz by MAX_LIST_PROPERTY
2895 The result follows by the non-decreasing condition on f.
2896*)
2897Theorem MEM_MAP3_UPPER:
2898 !f. MONO3 f ==>
2899 !lx ly lz e. MEM e (MAP3 f lx ly lz) ==> e <= f (MAX_LIST lx) (MAX_LIST ly) (MAX_LIST lz)
2900Proof
2901 metis_tac[MEM_MAP3, MAX_LIST_PROPERTY]
2902QED
2903
2904(* Theorem: MONO f ==> !ls e. MEM e (MAP f ls) ==> f (MIN_LIST ls) <= e *)
2905(* Proof:
2906 Note ?y. (e = f y) /\ MEM y ls by MEM_MAP
2907 and ls <> [] by MEM, MEM y ls
2908 then MIN_LIST ls <= y by MIN_LIST_PROPERTY, ls <> []
2909 Thus f (MIN_LIST ls) <= f y by given
2910 or f (MIN_LIST ls) <= e by e = f y
2911*)
2912Theorem MEM_MAP_LOWER:
2913 !f. MONO f ==> !ls e. MEM e (MAP f ls) ==> f (MIN_LIST ls) <= e
2914Proof
2915 rpt strip_tac >>
2916 `?y. (e = f y) /\ MEM y ls` by rw[GSYM MEM_MAP] >>
2917 `ls <> []` by metis_tac[MEM] >>
2918 `MIN_LIST ls <= y` by rw[MIN_LIST_PROPERTY] >>
2919 rw[]
2920QED
2921
2922(* Theorem: MONO2 f ==>
2923 !lx ly e. MEM e (MAP2 f lx ly) ==> f (MIN_LIST lx) (MIN_LIST ly) <= e *)
2924(* Proof:
2925 Note ?ex ey. (e = f ex ey) /\
2926 MEM ex lx /\ MEM ey ly by MEM_MAP2
2927 and lx <> [] /\ ly <> [] by MEM
2928 and MIN_LIST lx <= ex by MIN_LIST_PROPERTY
2929 and MIN_LIST ly <= ey by MIN_LIST_PROPERTY
2930 The result follows by the non-decreasing condition on f.
2931*)
2932Theorem MEM_MAP2_LOWER:
2933 !f. MONO2 f ==>
2934 !lx ly e. MEM e (MAP2 f lx ly) ==> f (MIN_LIST lx) (MIN_LIST ly) <= e
2935Proof
2936 metis_tac[MEM_MAP2, MEM, MIN_LIST_PROPERTY]
2937QED
2938
2939(* Theorem: MONO3 f ==>
2940 !lx ly lz e. MEM e (MAP3 f lx ly lz) ==> f (MIN_LIST lx) (MIN_LIST ly) (MIN_LIST lz) <= e *)
2941(* Proof:
2942 Note ?ex ey ez. (e = f ex ey ez) /\
2943 MEM ex lx /\ MEM ey ly /\ MEM ez lz by MEM_MAP3
2944 and lx <> [] /\ ly <> [] /\ lz <> [] by MEM
2945 and MIN_LIST lx <= ex by MIN_LIST_PROPERTY
2946 and MIN_LIST ly <= ey by MIN_LIST_PROPERTY
2947 and MIN_LIST lz <= ez by MIN_LIST_PROPERTY
2948 The result follows by the non-decreasing condition on f.
2949*)
2950Theorem MEM_MAP3_LOWER:
2951 !f. MONO3 f ==>
2952 !lx ly lz e. MEM e (MAP3 f lx ly lz) ==> f (MIN_LIST lx) (MIN_LIST ly) (MIN_LIST lz) <= e
2953Proof
2954 rpt strip_tac >>
2955 `?ex ey ez. (e = f ex ey ez) /\ MEM ex lx /\ MEM ey ly /\ MEM ez lz` by rw[MEM_MAP3] >>
2956 `lx <> [] /\ ly <> [] /\ lz <> []` by metis_tac[MEM] >>
2957 rw[MIN_LIST_PROPERTY]
2958QED
2959
2960(* Theorem: (!x. f x <= g x) ==> !ls n. EL n (MAP f ls) <= EL n (MAP g ls) *)
2961(* Proof:
2962 By induction on ls.
2963 Base: !n. EL n (MAP f []) <= EL n (MAP g [])
2964 LHS = EL n [] = RHS by MAP
2965 Step: !n. EL n (MAP f ls) <= EL n (MAP g ls) ==>
2966 !h n. EL n (MAP f (h::ls)) <= EL n (MAP g (h::ls))
2967 If n = 0,
2968 EL 0 (MAP f (h::ls))
2969 = EL 0 (f h::MAP f ls) by MAP
2970 = f h by EL
2971 <= g h by given
2972 = EL 0 (g h::MAP g ls) by EL
2973 = EL 0 (MAP g (h::ls)) by MAP
2974 If n <> 0, then n = SUC k by num_CASES
2975 EL n (MAP f (h::ls))
2976 = EL (SUC k) (f h::MAP f ls) by MAP
2977 = EL k (MAP f ls) by EL
2978 <= EL k (MAP g ls) by induction hypothesis
2979 = EL (SUC k) (g h::MAP g ls) by EL
2980 = EL n (MAP g (h::ls)) by MAP
2981*)
2982Theorem MAP_LE:
2983 !(f:num -> num) g. (!x. f x <= g x) ==> !ls n. EL n (MAP f ls) <= EL n (MAP g ls)
2984Proof
2985 ntac 3 strip_tac >>
2986 Induct_on `ls` >-
2987 rw[] >>
2988 Cases_on `n` >-
2989 rw[] >>
2990 rw[]
2991QED
2992
2993(* Theorem: (!x y. f x y <= g x y) ==> !lx ly n. EL n (MAP2 f lx ly) <= EL n (MAP2 g lx ly) *)
2994(* Proof:
2995 By induction on lx.
2996 Base: !ly n. EL n (MAP2 f [] ly) <= EL n (MAP2 g [] ly)
2997 LHS = EL n [] = RHS by MAP2_DEF
2998 Step: !ly n. EL n (MAP2 f lx ly) <= EL n (MAP2 g lx ly) ==>
2999 !h ly n. EL n (MAP2 f (h::lx) ly) <= EL n (MAP2 g (h::lx) ly)
3000 If ly = [],
3001 to show: EL n (MAP2 f (h::lx) []) <= EL n (MAP2 g (h::lx) [])
3002 True since LHS = EL n [] = RHS by MAP2_DEF
3003 Otherwise, ly = h'::t.
3004 to show: EL n (MAP2 f (h::lx) (h'::t)) <= EL n (MAP2 g (h::lx) (h'::t))
3005 If n = 0,
3006 EL 0 (MAP2 f (h::lx) (h'::t))
3007 = EL 0 (f h h'::MAP2 f lx t) by MAP2
3008 = f h h' by EL
3009 <= g h h' by given
3010 = EL 0 (g h h'::MAP2 g lx t) by EL
3011 = EL 0 (MAP2 g (h::lx) (h'::t)) by MAP2
3012 If n <> 0, then n = SUC k by num_CASES
3013 EL n (MAP2 f (h::lx) (h'::t))
3014 = EL (SUC k) (f h h'::MAP2 f lx t) by MAP2
3015 = EL k (MAP2 f lx t) by EL
3016 <= EL k (MAP2 g lx t) by induction hypothesis
3017 = EL (SUC k) (g h h'::MAP2 g lx t) by EL
3018 = EL n (MAP2 g (h::lx) (h'::t)) by MAP2
3019*)
3020Theorem MAP2_LE:
3021 !(f:num -> num -> num) g. (!x y. f x y <= g x y) ==>
3022 !lx ly n. EL n (MAP2 f lx ly) <= EL n (MAP2 g lx ly)
3023Proof
3024 ntac 3 strip_tac >>
3025 Induct_on `lx` >-
3026 rw[] >>
3027 rpt strip_tac >>
3028 Cases_on `ly` >-
3029 rw[] >>
3030 Cases_on `n` >-
3031 rw[] >>
3032 rw[]
3033QED
3034
3035(* Theorem: (!x y z. f x y z <= g x y z) ==>
3036 !lx ly lz n. EL n (MAP3 f lx ly lz) <= EL n (MAP3 g lx ly lz) *)
3037(* Proof:
3038 By induction on lx.
3039 Base: !ly lz n. EL n (MAP3 f [] ly lz) <= EL n (MAP3 g [] ly lz)
3040 LHS = EL n [] = RHS by MAP3_DEF
3041 Step: !ly lz n. EL n (MAP3 f lx ly lz) <= EL n (MAP3 g lx ly lz) ==>
3042 !h ly lz n. EL n (MAP3 f (h::lx) ly lz) <= EL n (MAP3 g (h::lx) ly lz)
3043 If ly = [],
3044 to show: EL n (MAP3 f (h::lx) [] lz) <= EL n (MAP3 g (h::lx) [] lz)
3045 True since LHS = EL n [] = RHS by MAP3_DEF
3046 Otherwise, ly = h'::t.
3047 to show: EL n (MAP3 f (h::lx) (h'::t) lz) <= EL n (MAP3 g (h::lx) (h'::t) lz)
3048 If lz = [],
3049 to show: EL n (MAP3 f (h::lx) (h'::t) []) <= EL n (MAP3 g (h::lx) (h'::t) [])
3050 True since LHS = EL n [] = RHS by MAP3_DEF
3051 Otherwise, lz = h''::t'.
3052 to show: EL n (MAP3 f (h::lx) (h'::t) (h''::t')) <= EL n (MAP3 g (h::lx) (h'::t) (h''::t'))
3053 If n = 0,
3054 EL 0 (MAP3 f (h::lx) (h'::t) (h''::t'))
3055 = EL 0 (f h h' h''::MAP3 f lx t t') by MAP3
3056 = f h h' h'' by EL
3057 <= g h h' h'' by given
3058 = EL 0 (g h h' h''::MAP3 g lx t t') by EL
3059 = EL 0 (MAP3 g (h::lx) (h'::t) (h''::t')) by MAP3
3060 If n <> 0, then n = SUC k by num_CASES
3061 EL n (MAP3 f (h::lx) (h'::t) (h''::t'))
3062 = EL (SUC k) (f h h' h''::MAP3 f lx t t') by MAP3
3063 = EL k (MAP3 f lx t t') by EL
3064 <= EL k (MAP3 g lx t t') by induction hypothesis
3065 = EL (SUC k) (g h h' h''::MAP3 g lx t t') by EL
3066 = EL n (MAP3 g (h::lx) (h'::t) (h''::t')) by MAP3
3067*)
3068Theorem MAP3_LE:
3069 !(f:num -> num -> num -> num) g. (!x y z. f x y z <= g x y z) ==>
3070 !lx ly lz n. EL n (MAP3 f lx ly lz) <= EL n (MAP3 g lx ly lz)
3071Proof
3072 ntac 3 strip_tac >>
3073 Induct_on `lx` >-
3074 rw[] >>
3075 rpt strip_tac >>
3076 Cases_on `ly` >-
3077 rw[] >>
3078 Cases_on `lz` >-
3079 rw[] >>
3080 Cases_on `n` >-
3081 rw[] >>
3082 rw[]
3083QED
3084
3085(*
3086SUM_MAP_PLUS |- !f g ls. SUM (MAP (\x. f x + g x) ls) = SUM (MAP f ls) + SUM (MAP g ls)
3087SUM_MAP_PLUS_ZIP |- !ls1 ls2. LENGTH ls1 = LENGTH ls2 /\ (!x y. f (x,y) = g x + h y) ==>
3088 SUM (MAP f (ZIP (ls1,ls2))) = SUM (MAP g ls1) + SUM (MAP h ls2)
3089*)
3090
3091(* Theorem: (!x. f1 x <= f2 x) ==> !ls. SUM (MAP f1 ls) <= SUM (MAP f2 ls) *)
3092(* Proof:
3093 By SUM_LE, this is to show:
3094 (1) !k. k < LENGTH (MAP f1 ls) ==> EL k (MAP f1 ls) <= EL k (MAP f2 ls)
3095 This is true by EL_MAP
3096 (2) LENGTH (MAP f1 ls) = LENGTH (MAP f2 ls)
3097 This is true by LENGTH_MAP
3098*)
3099Theorem SUM_MONO_MAP:
3100 !f1 f2. (!x. f1 x <= f2 x) ==> !ls. SUM (MAP f1 ls) <= SUM (MAP f2 ls)
3101Proof
3102 rpt strip_tac >>
3103 irule SUM_LE >>
3104 rw[EL_MAP]
3105QED
3106
3107(* Theorem: (!x y. f1 x y <= f2 x y) ==> !lx ly. SUM (MAP2 f1 lx ly) <= SUM (MAP2 f2 lx ly) *)
3108(* Proof:
3109 By SUM_LE, this is to show:
3110 (1) !k. k < LENGTH (MAP2 f1 lx ly) ==> EL k (MAP2 f1 lx ly) <= EL k (MAP2 f2 lx ly)
3111 This is true by EL_MAP2, LENGTH_MAP2
3112 (2) LENGTH (MAP2 f1 lx ly) = LENGTH (MAP2 f2 lx ly)
3113 This is true by LENGTH_MAP2
3114*)
3115Theorem SUM_MONO_MAP2:
3116 !f1 f2. (!x y. f1 x y <= f2 x y) ==> !lx ly. SUM (MAP2 f1 lx ly) <= SUM (MAP2 f2 lx ly)
3117Proof
3118 rpt strip_tac >>
3119 irule SUM_LE >>
3120 rw[EL_MAP2]
3121QED
3122
3123(* Theorem: (!x y z. f1 x y z <= f2 x y z) ==> !lx ly lz. SUM (MAP3 f1 lx ly lz) <= SUM (MAP3 f2 lx ly lz) *)
3124(* Proof:
3125 By SUM_LE, this is to show:
3126 (1) !k. k < LENGTH (MAP3 f1 lx ly lz) ==> EL k (MAP3 f1 lx ly lz) <= EL k (MAP3 f2 lx ly lz)
3127 This is true by EL_MAP3, LENGTH_MAP3
3128 (2)LENGTH (MAP3 f1 lx ly lz) = LENGTH (MAP3 f2 lx ly lz)
3129 This is true by LENGTH_MAP3
3130*)
3131Theorem SUM_MONO_MAP3:
3132 !f1 f2. (!x y z. f1 x y z <= f2 x y z) ==>
3133 !lx ly lz. SUM (MAP3 f1 lx ly lz) <= SUM (MAP3 f2 lx ly lz)
3134Proof
3135 rpt strip_tac >>
3136 irule SUM_LE >>
3137 rw[EL_MAP3, LENGTH_MAP3]
3138QED
3139
3140(* Theorem: MONO f ==> !ls. SUM (MAP f ls) <= f (MAX_LIST ls) * LENGTH ls *)
3141(* Proof:
3142 Let c = f (MAX_LIST ls).
3143
3144 Claim: SUM (MAP f ls) <= SUM (MAP (K c) ls)
3145 Proof: By SUM_LE, this is to show:
3146 (1) LENGTH (MAP f ls) = LENGTH (MAP (K c) ls)
3147 This is true by LENGTH_MAP
3148 (2) !k. k < LENGTH (MAP f ls) ==> EL k (MAP f ls) <= EL k (MAP (K c) ls)
3149 Note EL k (MAP f ls) = f (EL k ls) by EL_MAP
3150 and EL k (MAP (K c) ls)
3151 = (K c) (EL k ls) by EL_MAP
3152 = c by K_THM
3153 Now MEM (EL k ls) ls by EL_MEM
3154 so EL k ls <= MAX_LIST ls by MAX_LIST_PROPERTY
3155 Thus f (EL k ls) <= c by property of f
3156
3157 Note SUM (MAP (K c) ls) = c * LENGTH ls by SUM_MAP_K
3158 Thus SUM (MAP f ls) <= c * LENGTH ls by Claim
3159*)
3160Theorem SUM_MAP_UPPER:
3161 !f. MONO f ==> !ls. SUM (MAP f ls) <= f (MAX_LIST ls) * LENGTH ls
3162Proof
3163 rpt strip_tac >>
3164 qabbrev_tac `c = f (MAX_LIST ls)` >>
3165 `SUM (MAP f ls) <= SUM (MAP (K c) ls)` by
3166 ((irule SUM_LE >> rw[]) >>
3167 rw[EL_MAP, EL_MEM, MAX_LIST_PROPERTY, Abbr`c`]) >>
3168 `SUM (MAP (K c) ls) = c * LENGTH ls` by rw[SUM_MAP_K] >>
3169 decide_tac
3170QED
3171
3172(* Theorem: MONO2 f ==>
3173 !lx ly. SUM (MAP2 f lx ly) <= (f (MAX_LIST lx) (MAX_LIST ly)) * LENGTH (MAP2 f lx ly) *)
3174(* Proof:
3175 Let c = f (MAX_LIST lx) (MAX_LIST ly).
3176
3177 Claim: SUM (MAP2 f lx ly) <= SUM (MAP2 (\x y. c) lx ly)
3178 Proof: By SUM_LE, this is to show:
3179 (1) LENGTH (MAP2 f lx ly) = LENGTH (MAP2 (\x y. c) lx ly)
3180 This is true by LENGTH_MAP2
3181 (2) !k. k < LENGTH (MAP2 f lx ly) ==> EL k (MAP2 f lx ly) <= EL k (MAP2 (\x y. c) lx ly)
3182 Note EL k (MAP2 f lx ly)
3183 = f (EL k lx) (EL k ly) by EL_MAP2
3184 and EL k (MAP2 (\x y. c) lx ly)
3185 = (\x y. c) (EL k lx) (EL k ly) by EL_MAP2
3186 = c by function application
3187 Note k < LENGTH lx, k < LENGTH ly by LENGTH_MAP2
3188 Now MEM (EL k lx) lx by EL_MEM
3189 and MEM (EL k ly) ly by EL_MEM
3190 so EL k lx <= MAX_LIST lx by MAX_LIST_PROPERTY
3191 and EL k ly <= MAX_LIST ly by MAX_LIST_PROPERTY
3192 Thus f (EL k lx) (EL k ly) <= c by property of f
3193
3194 Note SUM (MAP (\x y. c) lx ly) = c * LENGTH (MAP2 (\x y. c) lx ly) by SUM_MAP2_K
3195 and LENGTH (MAP2 (\x y. c) lx ly) = LENGTH (MAP2 f lx ly) by LENGTH_MAP2
3196 Thus SUM (MAP f lx ly) <= c * LENGTH (MAP2 f lx ly) by Claim
3197*)
3198Theorem SUM_MAP2_UPPER:
3199 !f. MONO2 f ==>
3200 !lx ly. SUM (MAP2 f lx ly) <= (f (MAX_LIST lx) (MAX_LIST ly)) * LENGTH (MAP2 f lx ly)
3201Proof
3202 rpt strip_tac >>
3203 qabbrev_tac `c = f (MAX_LIST lx) (MAX_LIST ly)` >>
3204 `SUM (MAP2 f lx ly) <= SUM (MAP2 (\x y. c) lx ly)` by
3205 ((irule SUM_LE >> rw[]) >>
3206 rw[EL_MAP2, EL_MEM, MAX_LIST_PROPERTY, Abbr`c`]) >>
3207 `SUM (MAP2 (\x y. c) lx ly) = c * LENGTH (MAP2 (\x y. c) lx ly)` by rw[SUM_MAP2_K, Abbr`c`] >>
3208 `c * LENGTH (MAP2 (\x y. c) lx ly) = c * LENGTH (MAP2 f lx ly)` by rw[] >>
3209 decide_tac
3210QED
3211
3212(* Theorem: MONO3 f ==>
3213 !lx ly lz. SUM (MAP3 f lx ly lz) <=
3214 f (MAX_LIST lx) (MAX_LIST ly) (MAX_LIST lz) * LENGTH (MAP3 f lx ly lz) *)
3215(* Proof:
3216 Let c = f (MAX_LIST lx) (MAX_LIST ly) (MAX_LIST lz).
3217
3218 Claim: SUM (MAP3 f lx ly lz) <= SUM (MAP3 (\x y z. c) lx ly lz)
3219 Proof: By SUM_LE, this is to show:
3220 (1) LENGTH (MAP3 f lx ly lz) = LENGTH (MAP3 (\x y z. c) lx ly lz)
3221 This is true by LENGTH_MAP3
3222 (2) !k. k < LENGTH (MAP3 f lx ly lz) ==> EL k (MAP3 f lx ly lz) <= EL k (MAP3 (\x y z. c) lx ly lz)
3223 Note EL k (MAP3 f lx ly lz)
3224 = f (EL k lx) (EL k ly) (EL k lz) by EL_MAP3
3225 and EL k (MAP3 (\x y z. c) lx ly lz)
3226 = (\x y z. c) (EL k lx) (EL k ly) (EL k lz) by EL_MAP3
3227 = c by function application
3228 Note k < LENGTH lx, k < LENGTH ly, k < LENGTH lz
3229 by LENGTH_MAP3
3230 Now MEM (EL k lx) lx by EL_MEM
3231 and MEM (EL k ly) ly by EL_MEM
3232 and MEM (EL k lz) lz by EL_MEM
3233 so EL k lx <= MAX_LIST lx by MAX_LIST_PROPERTY
3234 and EL k ly <= MAX_LIST ly by MAX_LIST_PROPERTY
3235 and EL k lz <= MAX_LIST lz by MAX_LIST_PROPERTY
3236 Thus f (EL k lx) (EL k ly) (EL k lz) <= c by property of f
3237
3238 Note SUM (MAP (\x y z. c) lx ly lz) = c * LENGTH (MAP3 (\x y z. c) lx ly lz) by SUM_MAP3_K
3239 and LENGTH (MAP3 (\x y z. c) lx ly lz) = LENGTH (MAP3 f lx ly lz) by LENGTH_MAP3
3240 Thus SUM (MAP f lx ly lz) <= c * LENGTH (MAP3 f lx ly lz) by Claim
3241*)
3242Theorem SUM_MAP3_UPPER:
3243 !f. MONO3 f ==>
3244 !lx ly lz. SUM (MAP3 f lx ly lz) <= f (MAX_LIST lx) (MAX_LIST ly) (MAX_LIST lz) * LENGTH (MAP3 f lx ly lz)
3245Proof
3246 rpt strip_tac >>
3247 qabbrev_tac `c = f (MAX_LIST lx) (MAX_LIST ly) (MAX_LIST lz)` >>
3248 `SUM (MAP3 f lx ly lz) <= SUM (MAP3 (\x y z. c) lx ly lz)` by
3249 (`LENGTH (MAP3 f lx ly lz) = LENGTH (MAP3 (\x y z. c) lx ly lz)` by rw[LENGTH_MAP3] >>
3250 (irule SUM_LE >> rw[]) >>
3251 fs[LENGTH_MAP3] >>
3252 rw[EL_MAP3, EL_MEM, MAX_LIST_PROPERTY, Abbr`c`]) >>
3253 `SUM (MAP3 (\x y z. c) lx ly lz) = c * LENGTH (MAP3 (\x y z. c) lx ly lz)` by rw[SUM_MAP3_K] >>
3254 `c * LENGTH (MAP3 (\x y z. c) lx ly lz) = c * LENGTH (MAP3 f lx ly lz)` by rw[LENGTH_MAP3] >>
3255 decide_tac
3256QED
3257
3258(* Theorem: MONO f ==> MONO_INC (GENLIST f n) *)
3259(* Proof:
3260 Let ls = GENLIST f n.
3261 Then LENGTH ls = n by LENGTH_GENLIST
3262 and !k. k < n ==> EL k ls = f k by EL_GENLIST
3263 Thus MONO_INC ls
3264*)
3265Theorem GENLIST_MONO_INC:
3266 !f:num -> num n. MONO f ==> MONO_INC (GENLIST f n)
3267Proof
3268 rw[]
3269QED
3270
3271(* Theorem: RMONO f ==> MONO_DEC (GENLIST f n) *)
3272(* Proof:
3273 Let ls = GENLIST f n.
3274 Then LENGTH ls = n by LENGTH_GENLIST
3275 and !k. k < n ==> EL k ls = f k by EL_GENLIST
3276 Thus MONO_DEC ls
3277*)
3278Theorem GENLIST_MONO_DEC:
3279 !f:num -> num n. RMONO f ==> MONO_DEC (GENLIST f n)
3280Proof
3281 rw[]
3282QED
3283
3284(* Theorem: MONO_INC [m .. n] *)
3285(* Proof:
3286 This is to show:
3287 !j k. j <= k /\ k < LENGTH [m .. n] ==> EL j [m .. n] <= EL k [m .. n]
3288 Note LENGTH [m .. n] = n + 1 - m by listRangeINC_LEN
3289 so m + j <= n by j < LENGTH [m .. n]
3290 ==> EL j [m .. n] = m + j by listRangeINC_EL
3291 also m + k <= n by k < LENGTH [m .. n]
3292 ==> EL k [m .. n] = m + k by listRangeINC_EL
3293 Thus EL j [m .. n] <= EL k [m .. n] by arithmetic
3294*)
3295Theorem listRangeINC_MONO_INC:
3296 !m n. MONO_INC [m .. n]
3297Proof
3298 simp[listRangeINC_EL, listRangeINC_LEN]
3299QED
3300
3301(* Theorem: MONO_INC [m ..< n] *)
3302(* Proof:
3303 This is to show:
3304 !j k. j <= k /\ k < LENGTH [m ..< n] ==> EL j [m ..< n] <= EL k [m ..< n]
3305 Note LENGTH [m ..< n] = n - m by listRangeLHI_LEN
3306 so m + j < n by j < LENGTH [m ..< n]
3307 ==> EL j [m ..< n] = m + j by listRangeLHI_EL
3308 also m + k < n by k < LENGTH [m ..< n]
3309 ==> EL k [m ..< n] = m + k by listRangeLHI_EL
3310 Thus EL j [m ..< n] <= EL k [m ..< n] by arithmetic
3311*)
3312Theorem listRangeLHI_MONO_INC:
3313 !m n. MONO_INC [m ..< n]
3314Proof
3315 simp[listRangeLHI_EL]
3316QED
3317
3318(* ------------------------------------------------------------------------- *)
3319(* List Dilation *)
3320(* ------------------------------------------------------------------------- *)
3321
3322(*
3323Use the concept of dilating a list.
3324
3325Let p = [1;2;3], that is, p = 1 + 2x + 3x^2.
3326Then q = peval p (x^3) is just q = 1 + 2(x^3) + 3(x^3)^2 = [1;0;0;2;0;0;3]
3327
3328DILATE 3 [] = []
3329DILATE 3 (h::t) = [h;0;0] ++ MDILATE 3 t
3330
3331val DILATE_3_DEF = Define`
3332 (DILATE_3 [] = []) /\
3333 (DILATE_3 (h::t) = [h;0;0] ++ (MDILATE_3 t))
3334`;
3335> EVAL ``DILATE_3 [1;2;3]``;
3336val it = |- MDILATE_3 [1; 2; 3] = [1; 0; 0; 2; 0; 0; 3; 0; 0]: thm
3337
3338val DILATE_3_DEF = Define`
3339 (DILATE_3 [] = []) /\
3340 (DILATE_3 [h] = [h]) /\
3341 (DILATE_3 (h::t) = [h;0;0] ++ (MDILATE_3 t))
3342`;
3343> EVAL ``DILATE_3 [1;2;3]``;
3344val it = |- MDILATE_3 [1; 2; 3] = [1; 0; 0; 2; 0; 0; 3]: thm
3345*)
3346
3347(* ------------------------------------------------------------------------- *)
3348(* List Dilation (Multiplicative) *)
3349(* ------------------------------------------------------------------------- *)
3350
3351(* Note:
3352 It would be better to define: MDILATE e n l = inserting n (e)'s,
3353 that is, using GENLIST (K e) n, so that only MDILATE e 0 l = l.
3354 However, the intention is to have later, for polynomials:
3355 peval p (X ** n) = pdilate n p
3356 and since X ** 1 = X, and peval p X = p,
3357 it is desirable to have MDILATE e 1 l = l, with the definition below.
3358
3359 However, the multiplicative feature at the end destroys such an application.
3360*)
3361
3362(* Dilate a list with an element e, for a factor n (n <> 0) *)
3363Definition MDILATE_def:
3364 (MDILATE e n [] = []) /\
3365 (MDILATE e n (h::t) = if t = [] then [h] else (h:: GENLIST (K e) (PRE n)) ++ (MDILATE e n t))
3366End
3367(*
3368> EVAL ``MDILATE 0 2 [1;2;3]``;
3369val it = |- MDILATE 0 2 [1; 2; 3] = [1; 0; 2; 0; 3]: thm
3370> EVAL ``MDILATE 0 3 [1;2;3]``;
3371val it = |- MDILATE 0 3 [1; 2; 3] = [1; 0; 0; 2; 0; 0; 3]: thm
3372> EVAL ``MDILATE #0 3 [a;b;#1]``;
3373val it = |- MDILATE #0 3 [a; b; #1] = [a; #0; #0; b; #0; #0; #1]: thm
3374*)
3375
3376(* Theorem: MDILATE e n [] = [] *)
3377(* Proof: by MDILATE_def *)
3378Theorem MDILATE_NIL[simp]:
3379 !e n. MDILATE e n [] = []
3380Proof
3381 rw[MDILATE_def]
3382QED
3383
3384
3385(* Theorem: MDILATE e n [x] = [x] *)
3386(* Proof: by MDILATE_def *)
3387Theorem MDILATE_SING[simp]:
3388 !e n x. MDILATE e n [x] = [x]
3389Proof
3390 rw[MDILATE_def]
3391QED
3392
3393
3394(* Theorem: MDILATE e n (h::t) =
3395 if t = [] then [h] else (h:: GENLIST (K e) (PRE n)) ++ (MDILATE e n t) *)
3396(* Proof: by MDILATE_def *)
3397Theorem MDILATE_CONS:
3398 !e n h t. MDILATE e n (h::t) =
3399 if t = [] then [h] else (h:: GENLIST (K e) (PRE n)) ++ (MDILATE e n t)
3400Proof
3401 rw[MDILATE_def]
3402QED
3403
3404(* Theorem: MDILATE e 1 l = l *)
3405(* Proof:
3406 By induction on l.
3407 Base: !e. MDILATE e 1 [] = [], true by MDILATE_NIL
3408 Step: !e. MDILATE e 1 l = l ==> !h e. MDILATE e 1 (h::l) = h::l
3409 If l = [],
3410 MDILATE e 1 [h]
3411 = [h] by MDILATE_SING
3412 If l <> [],
3413 MDILATE e 1 (h::l)
3414 = (h:: GENLIST (K e) (PRE 1)) ++ (MDILATE e n l) by MDILATE_CONS
3415 = (h:: GENLIST (K e) (PRE 1)) ++ l by induction hypothesis
3416 = (h:: GENLIST (K e) 0) ++ l by PRE
3417 = [h] ++ l by GENLIST_0
3418 = h::l by CONS_APPEND
3419*)
3420Theorem MDILATE_1:
3421 !l e. MDILATE e 1 l = l
3422Proof
3423 Induct_on `l` >>
3424 rw[MDILATE_def]
3425QED
3426
3427(* Theorem: MDILATE e 0 l = l *)
3428(* Proof:
3429 By induction on l, and note GENLIST (K e) (PRE 0) = GENLIST (K e) 0 = [].
3430*)
3431Theorem MDILATE_0:
3432 !l e. MDILATE e 0 l = l
3433Proof
3434 Induct_on `l` >> rw[MDILATE_def]
3435QED
3436
3437(* Theorem: LENGTH (MDILATE e n l) =
3438 if n = 0 then LENGTH l else if l = [] then 0 else SUC (n * PRE (LENGTH l)) *)
3439(* Proof:
3440 If n = 0,
3441 Then MDILATE e 0 l = l by MDILATE_0
3442 Hence true.
3443 If n <> 0,
3444 Then 0 < n by NOT_ZERO_LT_ZERO
3445 By induction on l.
3446 Base: LENGTH (MDILATE e n []) = if n = 0 then LENGTH [] else if [] = [] then 0 else SUC (n * PRE (LENGTH []))
3447 LENGTH (MDILATE e n [])
3448 = LENGTH [] by MDILATE_NIL
3449 = 0 by LENGTH_NIL
3450 Step: LENGTH (MDILATE e n l) = if n = 0 then LENGTH l else if l = [] then 0 else SUC (n * PRE (LENGTH l)) ==>
3451 !h. LENGTH (MDILATE e n (h::l)) = if n = 0 then LENGTH (h::l) else if h::l = [] then 0 else SUC (n * PRE (LENGTH (h::l)))
3452 Note h::l = [] <=> F by NOT_CONS_NIL
3453 If l = [],
3454 LENGTH (MDILATE e n [h])
3455 = LENGTH [h] by MDILATE_SING
3456 = 1 by LENGTH_EQ_1
3457 = SUC 0 by ONE
3458 = SUC (n * 0) by MULT_0
3459 = SUC (n * (PRE (LENGTH [h]))) by LENGTH_EQ_1, PRE_SUC_EQ
3460 If l <> [],
3461 Then LENGTH l <> 0 by LENGTH_NIL
3462 LENGTH (MDILATE e n (h::l))
3463 = LENGTH (h:: GENLIST (K e) (PRE n) ++ MDILATE e n l) by MDILATE_CONS
3464 = LENGTH (h:: GENLIST (K e) (PRE n)) + LENGTH (MDILATE e n l) by LENGTH_APPEND
3465 = n + LENGTH (MDILATE e n l) by LENGTH_GENLIST
3466 = n + SUC (n * PRE (LENGTH l)) by induction hypothesis
3467 = SUC (n + n * PRE (LENGTH l)) by ADD_SUC
3468 = SUC (n * SUC (PRE (LENGTH l))) by MULT_SUC
3469 = SUC (n * LENGTH l) by SUC_PRE, 0 < LENGTH l
3470 = SUC (n * PRE (LENGTH (h::l))) by LENGTH, PRE_SUC_EQ
3471*)
3472Theorem MDILATE_LENGTH:
3473 !l e n. LENGTH (MDILATE e n l) =
3474 if n = 0 then LENGTH l else if l = [] then 0 else SUC (n * PRE (LENGTH l))
3475Proof
3476 rpt strip_tac >>
3477 Cases_on `n = 0` >-
3478 rw[MDILATE_0] >>
3479 `0 < n` by decide_tac >>
3480 Induct_on `l` >-
3481 rw[] >>
3482 rw[MDILATE_def] >>
3483 `LENGTH l <> 0` by metis_tac[LENGTH_NIL] >>
3484 `0 < LENGTH l` by decide_tac >>
3485 `PRE n + SUC (n * PRE (LENGTH l)) = SUC (PRE n) + n * PRE (LENGTH l)` by rw[] >>
3486 `_ = n + n * PRE (LENGTH l)` by decide_tac >>
3487 `_ = n * SUC (PRE (LENGTH l))` by rw[MULT_SUC] >>
3488 `_ = n * LENGTH l` by metis_tac[SUC_PRE] >>
3489 decide_tac
3490QED
3491
3492(* Theorem: LENGTH l <= LENGTH (MDILATE e n l) *)
3493(* Proof:
3494 If n = 0,
3495 LENGTH (MDILATE e 0 l)
3496 = LENGTH l by MDILATE_LENGTH
3497 >= LENGTH l
3498 If l = [],
3499 LENGTH (MDILATE e n [])
3500 = LENGTH [] by MDILATE_NIL
3501 >= LENGTH []
3502 If l <> [],
3503 Then ?h t. l = h::t by list_CASES
3504 LENGTH (MDILATE e n (h::t))
3505 = SUC (n * PRE (LENGTH (h::t))) by MDILATE_LENGTH
3506 = SUC (n * PRE (SUC (LENGTH t))) by LENGTH
3507 = SUC (n * LENGTH t) by PRE
3508 = n * LENGTH t + 1 by ADD1
3509 >= LENGTH t + 1 by LE_MULT_CANCEL_LBARE, 0 < n
3510 = SUC (LENGTH t) by ADD1
3511 = LENGTH (h::t) by LENGTH
3512*)
3513Theorem MDILATE_LENGTH_LOWER:
3514 !l e n. LENGTH l <= LENGTH (MDILATE e n l)
3515Proof
3516 rw[MDILATE_LENGTH] >>
3517 `?h t. l = h::t` by metis_tac[list_CASES] >>
3518 rw[]
3519QED
3520
3521(* Theorem: 0 < n ==> LENGTH (MDILATE e n l) <= SUC (n * PRE (LENGTH l)) *)
3522(* Proof:
3523 Since n <> 0,
3524 If l = [],
3525 LENGTH (MDILATE e n [])
3526 = LENGTH [] by MDILATE_NIL
3527 = 0 by LENGTH_NIL
3528 SUC (n * PRE (LENGTH []))
3529 = SUC (n * PRE 0) by LENGTH_NIL
3530 = SUC 0 by PRE, MULT_0
3531 > 0 by LESS_SUC
3532 If l <> [],
3533 LENGTH (MDILATE e n l)
3534 = SUC (n * PRE (LENGTH l)) by MDILATE_LENGTH, n <> 0
3535*)
3536Theorem MDILATE_LENGTH_UPPER:
3537 !l e n. 0 < n ==> LENGTH (MDILATE e n l) <= SUC (n * PRE (LENGTH l))
3538Proof
3539 rw[MDILATE_LENGTH]
3540QED
3541
3542(* Theorem: k < LENGTH (MDILATE e n l) ==>
3543 (EL k (MDILATE e n l) = if n = 0 then EL k l else if k MOD n = 0 then EL (k DIV n) l else e) *)
3544(* Proof:
3545 If n = 0,
3546 Then MDILATE e 0 l = l by MDILATE_0
3547 Hence true trivially.
3548 If n <> 0,
3549 Then 0 < n by NOT_ZERO_LT_ZERO
3550 By induction on l.
3551 Base: !k. k < LENGTH (MDILATE e n []) ==>
3552 (EL k (MDILATE e n []) = if n = 0 then EL k [] else if k MOD n = 0 then EL (k DIV n) [] else e)
3553 Note LENGTH (MDILATE e n [])
3554 = LENGTH [] by MDILATE_NIL
3555 = 0 by LENGTH_NIL
3556 Thus k < 0 <=> F by NOT_ZERO_LT_ZERO
3557 Step: !k. k < LENGTH (MDILATE e n l) ==> (EL k (MDILATE e n l) = if n = 0 then EL k l else if k MOD n = 0 then EL (k DIV n) l else e) ==>
3558 !h k. k < LENGTH (MDILATE e n (h::l)) ==> (EL k (MDILATE e n (h::l)) = if n = 0 then EL k (h::l) else if k MOD n = 0 then EL (k DIV n) (h::l) else e)
3559 Note LENGTH (MDILATE e n [h]) = 1 by MDILATE_SING
3560 and LENGTH (MDILATE e n (h::l))
3561 = SUC (n * PRE (LENGTH (h::l))) by MDILATE_LENGTH, n <> 0
3562 = SUC (n * PRE (SUC (LENGTH l))) by LENGTH
3563 = SUC (n * LENGTH l) by PRE
3564
3565 If l = [],
3566 Then MDILATE e n [h] = [h] by MDILATE_SING
3567 and LENGTH (MDILATE e n [h]) = 1 by LENGTH
3568 so k < 1 means k = 0.
3569 and 0 DIV n = 0 by ZERO_DIV, 0 < n
3570 and 0 MOD n = 0 by ZERO_MOD, 0 < n
3571 Thus EL k [h] = EL (k DIV n) [h].
3572
3573 If l <> [],
3574 Let t = h::GENLIST (K e) (PRE n)
3575 Note LENGTH t = n by LENGTH_GENLIST
3576 If k < n,
3577 Then k MOD n = k by LESS_MOD, k < n
3578 EL k (MDILATE e n (h::l))
3579 = EL k (t ++ MDILATE e n l) by MDILATE_CONS
3580 = EL k t by EL_APPEND, k < LENGTH t
3581 If k = 0,
3582 EL 0 t
3583 = EL 0 (h:: GENLIST (K e) (PRE n)) by notation of t
3584 = h
3585 = EL (0 DIV n) (h::l) by EL, HD
3586 If k <> 0,
3587 EL k t
3588 = EL k (h:: GENLIST (K e) (PRE n)) by notation of t
3589 = EL (PRE k) (GENLIST (K e) (PRE n)) by EL_CONS
3590 = (K e) (PRE k) by EL_GENLIST, PRE k < PRE n
3591 = e by application of K
3592 If ~(k < n), n <= k.
3593 Given k < LENGTH (MDILATE e n (h::l))
3594 or k < SUC (n * LENGTH l) by above
3595 ==> k - n < SUC (n * LENGTH l) - n by n <= k
3596 = SUC (n * LENGTH l - n) by SUB
3597 = SUC (n * (LENGTH l - 1)) by LEFT_SUB_DISTRIB
3598 = SUC (n * PRE (LENGTH l)) by PRE_SUB1
3599 or k - n < LENGTH (MDILATE e n l) by MDILATE_LENGTH
3600 Thus (k - n) MOD n = k MOD n by SUB_MOD
3601 and (k - n) DIV n = k DIV n - 1 by SUB_DIV
3602 If k MOD n = 0,
3603 Note 0 < k DIV n by DIVIDES_MOD_0, DIV_POS
3604 EL k (t ++ MDILATE e n l)
3605 = EL (k - n) (MDILATE e n l) by EL_APPEND, n <= k
3606 = EL (k DIV n - 1) l by induction hypothesis, (k - n) MOD n = 0
3607 = EL (PRE (k DIV n)) l by PRE_SUB1
3608 = EL (k DIV n) (h::l) by EL_CONS, 0 < k DIV n
3609 If k MOD n <> 0,
3610 EL k (t ++ MDILATE e n l)
3611 = EL (k - n) (MDILATE e n l) by EL_APPEND, n <= k
3612 = e by induction hypothesis, (k - n) MOD n <> 0
3613*)
3614Theorem MDILATE_EL:
3615 !l e n k. k < LENGTH (MDILATE e n l) ==>
3616 (EL k (MDILATE e n l) = if n = 0 then EL k l else if k MOD n = 0 then EL (k DIV n) l else e)
3617Proof
3618 ntac 3 strip_tac >>
3619 Cases_on `n = 0` >-
3620 rw[MDILATE_0] >>
3621 `0 < n` by decide_tac >>
3622 Induct_on `l` >-
3623 rw[] >>
3624 rpt strip_tac >>
3625 `LENGTH (MDILATE e n [h]) = 1` by rw[MDILATE_SING] >>
3626 `LENGTH (MDILATE e n (h::l)) = SUC (n * LENGTH l)` by rw[MDILATE_LENGTH] >>
3627 qabbrev_tac `t = h:: GENLIST (K e) (PRE n)` >>
3628 `!k. k < 1 <=> (k = 0)` by decide_tac >>
3629 rw_tac std_ss[MDILATE_def] >-
3630 metis_tac[ZERO_DIV] >-
3631 metis_tac[ZERO_MOD] >-
3632 (rw_tac std_ss[EL_APPEND] >| [
3633 `LENGTH t = n` by rw[Abbr`t`] >>
3634 `k MOD n = k` by rw[LESS_MOD] >>
3635 `!x. EL 0 (h::x) = h` by rw[] >>
3636 metis_tac[ZERO_DIV],
3637 `LENGTH t = n` by rw[Abbr`t`] >>
3638 `k - n < LENGTH (MDILATE e n l)` by rw[MDILATE_LENGTH] >>
3639 `(k - n) MOD n = k MOD n` by rw[SUB_MOD] >>
3640 `(k - n) DIV n = k DIV n - 1` by rw[GSYM SUB_DIV] >>
3641 `0 < k DIV n` by rw[DIVIDES_MOD_0, DIV_POS] >>
3642 `EL (k - n) (MDILATE e n l) = EL (k DIV n - 1) l` by rw[] >>
3643 `_ = EL (PRE (k DIV n)) l` by rw[PRE_SUB1] >>
3644 `_ = EL (k DIV n) (h::l)` by rw[EL_CONS] >>
3645 rw[]
3646 ]) >>
3647 rw_tac std_ss[EL_APPEND] >| [
3648 `LENGTH t = n` by rw[Abbr`t`] >>
3649 `k MOD n = k` by rw[LESS_MOD] >>
3650 `0 < k /\ PRE k < PRE n` by decide_tac >>
3651 `EL k t = EL (PRE k) (GENLIST (K e) (PRE n))` by rw[EL_CONS, Abbr`t`] >>
3652 `_ = e` by rw[] >>
3653 rw[],
3654 `LENGTH t = n` by rw[Abbr`t`] >>
3655 `k - n < LENGTH (MDILATE e n l)` by rw[MDILATE_LENGTH] >>
3656 `n <= k` by decide_tac >>
3657 `(k - n) MOD n = k MOD n` by rw[SUB_MOD] >>
3658 `EL (k - n) (MDILATE e n l) = e` by rw[] >>
3659 rw[]
3660 ]
3661QED
3662
3663(* This is a milestone theorem. *)
3664
3665(* Theorem: (MDILATE e n l = []) <=> (l = []) *)
3666(* Proof:
3667 If part: MDILATE e n l = [] ==> l = []
3668 By contradiction, suppose l <> [].
3669 If n = 0,
3670 Then MDILATE e 0 l = l by MDILATE_0
3671 This contradicts MDILATE e 0 l = [].
3672 If n <> 0,
3673 Then LENGTH (MDILATE e n l)
3674 = SUC (n * PRE (LENGTH l)) by MDILATE_LENGTH
3675 <> 0 by SUC_NOT
3676 So (MDILATE e n l) <> [] by LENGTH_NIL
3677 This contradicts MDILATE e n l = []
3678 Only-if part: l = [] ==> MDILATE e n l = []
3679 True by MDILATE_NIL
3680*)
3681Theorem MDILATE_EQ_NIL:
3682 !l e n. (MDILATE e n l = []) <=> (l = [])
3683Proof
3684 rw[EQ_IMP_THM] >>
3685 spose_not_then strip_assume_tac >>
3686 Cases_on `n = 0` >| [
3687 `MDILATE e 0 l = l` by rw[GSYM MDILATE_0] >>
3688 metis_tac[],
3689 `LENGTH (MDILATE e n l) = SUC (n * PRE (LENGTH l))` by rw[MDILATE_LENGTH] >>
3690 `LENGTH (MDILATE e n l) <> 0` by decide_tac >>
3691 metis_tac[LENGTH_EQ_0]
3692 ]
3693QED
3694
3695(* Theorem: LAST (MDILATE e n l) = LAST l *)
3696(* Proof:
3697 If l = [],
3698 LAST (MDILATE e n [])
3699 = LAST [] by MDILATE_NIL
3700 If l <> [],
3701 If n = 0,
3702 LAST (MDILATE e 0 l)
3703 = LAST l by MDILATE_0
3704 If n <> 0, then 0 < m by LESS_0
3705 Then MDILATE e n l <> [] by MDILATE_EQ_NIL
3706 or LENGTH (MDILATE e n l) <> 0 by LENGTH_NIL
3707 Note PRE (LENGTH (MDILATE e n l))
3708 = PRE (SUC (n * PRE (LENGTH l))) by MDILATE_LENGTH
3709 = n * PRE (LENGTH l) by PRE
3710 Let k = PRE (LENGTH (MDILATE e n l)).
3711 Then k < LENGTH (MDILATE e n l) by PRE x < x
3712 and k MOD n = 0 by MOD_EQ_0, MULT_COMM, 0 < n
3713 and k DIV n = PRE (LENGTH l) by MULT_DIV, MULT_COMM
3714
3715 LAST (MDILATE e n l)
3716 = EL k (MDILATE e n l) by LAST_EL
3717 = EL (k DIV n) l by MDILATE_EL
3718 = EL (PRE (LENGTH l)) l by above
3719 = LAST l by LAST_EL
3720*)
3721Theorem MDILATE_LAST:
3722 !l e n. LAST (MDILATE e n l) = LAST l
3723Proof
3724 rpt strip_tac >>
3725 Cases_on `l = []` >-
3726 rw[] >>
3727 Cases_on `n = 0` >-
3728 rw[MDILATE_0] >>
3729 `0 < n` by decide_tac >>
3730 `MDILATE e n l <> []` by rw[MDILATE_EQ_NIL] >>
3731 `LENGTH (MDILATE e n l) <> 0` by metis_tac[LENGTH_NIL] >>
3732 qabbrev_tac `k = PRE (LENGTH (MDILATE e n l))` >>
3733 rw[LAST_EL] >>
3734 `k = n * PRE (LENGTH l)` by rw[MDILATE_LENGTH, Abbr`k`] >>
3735 `k MOD n = 0` by metis_tac[MOD_EQ_0, MULT_COMM] >>
3736 `k DIV n = PRE (LENGTH l)` by metis_tac[MULT_DIV, MULT_COMM] >>
3737 `k < LENGTH (MDILATE e n l)` by rw[Abbr`k`] >>
3738 rw[MDILATE_EL]
3739QED
3740
3741(*
3742Succesive dilation:
3743
3744> EVAL ``MDILATE #0 3 [a; b; c]``;
3745val it = |- MDILATE #0 3 [a; b; c] = [a; #0; #0; b; #0; #0; c]: thm
3746> EVAL ``MDILATE #0 4 [a; b; c]``;
3747val it = |- MDILATE #0 4 [a; b; c] = [a; #0; #0; #0; b; #0; #0; #0; c]: thm
3748> EVAL ``MDILATE #0 1 (MDILATE #0 3 [a; b; c])``;
3749val it = |- MDILATE #0 1 (MDILATE #0 3 [a; b; c]) = [a; #0; #0; b; #0; #0; c]: thm
3750> EVAL ``MDILATE #0 2 (MDILATE #0 3 [a; b; c])``;
3751val it = |- MDILATE #0 2 (MDILATE #0 3 [a; b; c]) = [a; #0; #0; #0; #0; #0; b; #0; #0; #0; #0; #0; c]: thm
3752> EVAL ``MDILATE #0 2 (MDILATE #0 2 [a; b; c])``;
3753val it = |- MDILATE #0 2 (MDILATE #0 2 [a; b; c]) = [a; #0; #0; #0; b; #0; #0; #0; c]: thm
3754> EVAL ``MDILATE #0 2 (MDILATE #0 2 [a; b; c]) = MDILATE #0 4 [a; b; c]``;
3755val it = |- (MDILATE #0 2 (MDILATE #0 2 [a; b; c]) = MDILATE #0 4 [a; b; c]) <=> T: thm
3756> EVAL ``MDILATE #0 2 (MDILATE #0 3 [a; b; c]) = MDILATE #0 5 [a; b; c]``;
3757val it = |- (MDILATE #0 2 (MDILATE #0 3 [a; b; c]) = MDILATE #0 5 [a; b; c]) <=> F: thm
3758> EVAL ``MDILATE #0 2 (MDILATE #0 3 [a; b; c]) = MDILATE #0 6 [a; b; c]``;
3759val it = |- (MDILATE #0 2 (MDILATE #0 3 [a; b; c]) = MDILATE #0 6 [a; b; c]) <=> T: thm
3760
3761So successive dilation is related to product, or factorisation, or primes:
3762MDILATE e m (MDILATE e n l) = MDILATE e (m * n) l, for 0 < m, 0 < n.
3763
3764*)
3765
3766(* ------------------------------------------------------------------------- *)
3767(* List Dilation (Additive) *)
3768(* ------------------------------------------------------------------------- *)
3769
3770(* Dilate by inserting m zeroes, at position n of tail *)
3771Definition DILATE_def:
3772 (DILATE e n m [] = []) /\
3773 (DILATE e n m [h] = [h]) /\
3774 (DILATE e n m (h::t) = h:: (TAKE n t ++ (GENLIST (K e) m) ++ DILATE e n m (DROP n t)))
3775Termination
3776 WF_REL_TAC `measure (λ(a,b,c,d). LENGTH d)` >>
3777 rw[LENGTH_DROP]
3778End
3779
3780(*
3781> EVAL ``DILATE 0 0 1 [1;2;3]``;
3782val it = |- DILATE 0 0 1 [1; 2; 3] = [1; 0; 2; 0; 3]: thm
3783> EVAL ``DILATE 0 0 2 [1;2;3]``;
3784val it = |- DILATE 0 0 2 [1; 2; 3] = [1; 0; 0; 2; 0; 0; 3]: thm
3785> EVAL ``DILATE 0 1 1 [1;2;3]``;
3786val it = |- DILATE 0 1 1 [1; 2; 3] = [1; 2; 0; 3]: thm
3787> EVAL ``DILATE 0 1 1 (DILATE 0 0 1 [1;2;3])``;
3788val it = |- DILATE 0 1 1 (DILATE 0 0 1 [1; 2; 3]) = [1; 0; 0; 2; 0; 0; 3]: thm
3789> EVAL ``DILATE 0 0 3 [1;2;3]``;
3790val it = |- DILATE 0 0 3 [1; 2; 3] = [1; 0; 0; 0; 2; 0; 0; 0; 3]: thm
3791> EVAL ``DILATE 0 1 1 (DILATE 0 0 2 [1;2;3])``;
3792val it = |- DILATE 0 1 1 (DILATE 0 0 2 [1; 2; 3]) = [1; 0; 0; 0; 2; 0; 0; 0; 0; 3]: thm
3793> EVAL ``DILATE 0 0 3 [1;2;3] = DILATE 0 2 1 (DILATE 0 0 2 [1;2;3])``;
3794val it = |- (DILATE 0 0 3 [1; 2; 3] = DILATE 0 2 1 (DILATE 0 0 2 [1; 2; 3])) <=> T: thm
3795
3796> EVAL ``DILATE 0 0 0 [1;2;3]``;
3797val it = |- DILATE 0 0 0 [1; 2; 3] = [1; 2; 3]: thm
3798> EVAL ``DILATE 1 0 0 [1;2;3]``;
3799val it = |- DILATE 1 0 0 [1; 2; 3] = [1; 2; 3]: thm
3800> EVAL ``DILATE 1 0 1 [1;2;3]``;
3801val it = |- DILATE 1 0 1 [1; 2; 3] = [1; 1; 2; 1; 3]: thm
3802> EVAL ``DILATE 1 1 1 [1;2;3]``;
3803val it = |- DILATE 1 1 1 [1; 2; 3] = [1; 2; 1; 3]: thm
3804> EVAL ``DILATE 1 1 2 [1;2;3]``;
3805val it = |- DILATE 1 1 2 [1; 2; 3] = [1; 2; 1; 1; 3]: thm
3806> EVAL ``DILATE 1 1 3 [1;2;3]``;
3807val it = |- DILATE 1 1 3 [1; 2; 3] = [1; 2; 1; 1; 1; 3]: thm
3808*)
3809
3810(* Theorem: DILATE e n m [] = [] *)
3811(* Proof: by DILATE_def *)
3812Theorem DILATE_NIL[simp] = DILATE_def |> CONJUNCT1;
3813(* val DILATE_NIL = |- !n m e. DILATE e n m [] = []: thm *)
3814
3815
3816(* Theorem: DILATE e n m [h] = [h] *)
3817(* Proof: by DILATE_def *)
3818Theorem DILATE_SING[simp] = DILATE_def |> CONJUNCT2 |> CONJUNCT1;
3819(* val DILATE_SING = |- !n m h e. DILATE e n m [h] = [h]: thm *)
3820
3821
3822(* Theorem: DILATE e n m (h::t) =
3823 if t = [] then [h] else h:: (TAKE n t ++ (GENLIST (K e) m) ++ DILATE e n m (DROP n t)) *)
3824(* Proof: by DILATE_def, list_CASES *)
3825Theorem DILATE_CONS:
3826 !n m h t e. DILATE e n m (h::t) =
3827 if t = [] then [h] else h:: (TAKE n t ++ (GENLIST (K e) m) ++ DILATE e n m (DROP n t))
3828Proof
3829 metis_tac[DILATE_def, list_CASES]
3830QED
3831
3832(* Theorem: DILATE e 0 n (h::t) = if t = [] then [h] else h::(GENLIST (K e) n ++ DILATE e 0 n t) *)
3833(* Proof:
3834 If t = [],
3835 DILATE e 0 n (h::t) = [h] by DILATE_CONS
3836 If t <> [],
3837 DILATE e 0 n (h::t)
3838 = h:: (TAKE 0 t ++ (GENLIST (K e) n) ++ DILATE e 0 n (DROP 0 t)) by DILATE_CONS
3839 = h:: ([] ++ (GENLIST (K e) n) ++ DILATE e 0 n t) by TAKE_0, DROP_0
3840 = h:: (GENLIST (K e) n ++ DILATE e 0 n t) by APPEND
3841*)
3842Theorem DILATE_0_CONS:
3843 !n h t e. DILATE e 0 n (h::t) = if t = [] then [h] else h::(GENLIST (K e) n ++ DILATE e 0 n t)
3844Proof
3845 rw[DILATE_CONS]
3846QED
3847
3848(* Theorem: DILATE e 0 0 l = l *)
3849(* Proof:
3850 By induction on l.
3851 Base: DILATE e 0 0 [] = [], true by DILATE_NIL
3852 Step: DILATE e 0 0 l = l ==> !h. DILATE e 0 0 (h::l) = h::l
3853 If l = [],
3854 DILATE e 0 0 [h] = [h] by DILATE_SING
3855 If l <> [],
3856 DILATE e 0 0 (h::l)
3857 = h::(GENLIST (K e) 0 ++ DILATE e 0 0 l) by DILATE_0_CONS
3858 = h::([] ++ DILATE e 0 0 l) by GENLIST_0
3859 = h:: DILATE e 0 0 l by APPEND
3860 = h::l by induction hypothesis
3861*)
3862Theorem DILATE_0_0:
3863 !l e. DILATE e 0 0 l = l
3864Proof
3865 Induct >>
3866 rw[DILATE_0_CONS]
3867QED
3868
3869(* Theorem: DILATE e 0 (SUC n) l = DILATE e n 1 (DILATE e 0 n l) *)
3870(* Proof:
3871 If n = 0,
3872 DILATE e 0 1 l = DILATE e 0 1 (DILATE e 0 0 l) by DILATE_0_0
3873 If n <> 0,
3874 GENLIST (K e) n <> [] by LENGTH_GENLIST, LENGTH_NIL
3875 By induction on l.
3876 Base: DILATE e 0 (SUC n) [] = DILATE e n 1 (DILATE e 0 n [])
3877 DILATE e 0 (SUC n) [] = [] by DILATE_NIL
3878 DILATE e n 1 (DILATE e 0 n [])
3879 = DILATE e n 1 [] = [] by DILATE_NIL
3880 Step: DILATE e 0 (SUC n) l = DILATE e n 1 (DILATE e 0 n l) ==>
3881 !h. DILATE e 0 (SUC n) (h::l) = DILATE e n 1 (DILATE e 0 n (h::l))
3882 If l = [],
3883 DILATE e 0 (SUC n) [h] = [h] by DILATE_SING
3884 DILATE e n 1 (DILATE e 0 n [h])
3885 = DILATE e n 1 [h] = [h] by DILATE_SING
3886 If l <> [],
3887 DILATE e 0 (SUC n) (h::l)
3888 = h::(GENLIST (K e) (SUC n) ++ DILATE e 0 (SUC n) l) by DILATE_0_CONS
3889 = h::(GENLIST (K e) (SUC n) ++ DILATE e n 1 (DILATE e 0 n l)) by induction hypothesis
3890
3891 Note LENGTH (GENLIST (K e) n) = n by LENGTH_GENLIST
3892 so (GENLIST (K e) n ++ DILATE e 0 n l) <> [] by APPEND_eq_NIL, LENGTH_NIL [1]
3893 and TAKE n (GENLIST (K e) n ++ DILATE e 0 n l) = GENLIST (K e) n by TAKE_LENGTH_APPEND [2]
3894 and DROP n (GENLIST (K e) n ++ DILATE e 0 n l) = DILATE e 0 n l by DROP_LENGTH_APPEND [3]
3895 and GENLIST (K e) (SUC n)
3896 = GENLIST (K e) (1 + n) by SUC_ONE_ADD
3897 = GENLIST (K e) n ++ GENLIST (K e) 1 by GENLIST_K_ADD [4]
3898
3899 DILATE e n 1 (DILATE e 0 n (h::l))
3900 = DILATE e n 1 (h::(GENLIST (K e) n ++ DILATE e 0 n l)) by DILATE_0_CONS
3901 = h::(TAKE n (GENLIST (K e) n ++ DILATE e 0 n l) ++ GENLIST (K e) 1 ++
3902 DILATE e n 1 (DROP n (GENLIST (K e) n ++ DILATE e 0 n l))) by DILATE_CONS, [1]
3903 = h::(GENLIST (K e) n ++ GENLIST (K e) 1 ++ DILATE e n 1 (DILATE e 0 n l)) by above [2], [3]
3904 = h::(GENLIST (K e) (SUC n) ++ DILATE e n 1 (DILATE e 0 n l)) by above [4]
3905*)
3906Theorem DILATE_0_SUC:
3907 !l e n. DILATE e 0 (SUC n) l = DILATE e n 1 (DILATE e 0 n l)
3908Proof
3909 rpt strip_tac >>
3910 Cases_on `n = 0` >-
3911 rw[DILATE_0_0] >>
3912 Induct_on `l` >-
3913 rw[] >>
3914 rpt strip_tac >>
3915 Cases_on `l = []` >-
3916 rw[DILATE_SING] >>
3917 qabbrev_tac `a = GENLIST (K e) n ++ DILATE e 0 n l` >>
3918 `LENGTH (GENLIST (K e) n) = n` by rw[] >>
3919 `a <> []` by metis_tac[APPEND_eq_NIL, LENGTH_NIL] >>
3920 `TAKE n a = GENLIST (K e) n` by metis_tac[TAKE_LENGTH_APPEND] >>
3921 `DROP n a = DILATE e 0 n l` by metis_tac[DROP_LENGTH_APPEND] >>
3922 `GENLIST (K e) (SUC n) = GENLIST (K e) n ++ GENLIST (K e) 1` by rw_tac std_ss[SUC_ONE_ADD, GENLIST_K_ADD] >>
3923 metis_tac[DILATE_0_CONS, DILATE_CONS]
3924QED
3925
3926(* Theorem: LENGTH (DILATE e 0 n l) = if l = [] then 0 else SUC (SUC n * PRE (LENGTH l)) *)
3927(* Proof:
3928 By induction on l.
3929 Base: LENGTH (DILATE e 0 n []) = 0
3930 LENGTH (DILATE e 0 n [])
3931 = LENGTH [] by DILATE_NIL
3932 = 0 by LENGTH_NIL
3933 Step: LENGTH (DILATE e 0 n l) = if l = [] then 0 else SUC (SUC n * PRE (LENGTH l)) ==>
3934 !h. LENGTH (DILATE e 0 n (h::l)) = SUC (SUC n * PRE (LENGTH (h::l)))
3935 If l = [],
3936 LENGTH (DILATE e 0 n [h])
3937 = LENGTH [h] by DILATE_SING
3938 = 1 by LENGTH
3939 SUC (SUC n * PRE (LENGTH [h])
3940 = SUC (SUC n * PRE 1) by LENGTH
3941 = SUC (SUC n * 0) by PRE_SUB1
3942 = SUC 0 by MULT_0
3943 = 1 by ONE
3944 If l <> [],
3945 Note LENGTH l <> 0 by LENGTH_NIL
3946 LENGTH (DILATE e 0 n (h::l))
3947 = LENGTH (h::(GENLIST (K e) n ++ DILATE e 0 n l)) by DILATE_0_CONS
3948 = SUC (LENGTH (GENLIST (K e) n ++ DILATE e 0 n l)) by LENGTH
3949 = SUC (LENGTH (GENLIST (K e) n) + LENGTH (DILATE e 0 n l)) by LENGTH_APPEND
3950 = SUC (n + LENGTH (DILATE e 0 n l)) by LENGTH_GENLIST
3951 = SUC (n + SUC (SUC n * PRE (LENGTH l))) by induction hypothesis
3952 = SUC (SUC (n + SUC n * PRE (LENGTH l))) by ADD_SUC
3953 = SUC (SUC n + SUC n * PRE (LENGTH l)) by ADD_COMM, ADD_SUC
3954 = SUC (SUC n * SUC (PRE (LENGTH l))) by MULT_SUC
3955 = SUC (SUC n * LENGTH l) by SUC_PRE, 0 < LENGTH l
3956 = SUC (SUC n * PRE (LENGTH (h::l))) by LENGTH, PRE_SUC_EQ
3957*)
3958Theorem DILATE_0_LENGTH:
3959 !l e n. LENGTH (DILATE e 0 n l) = if l = [] then 0 else SUC (SUC n * PRE (LENGTH l))
3960Proof
3961 Induct >-
3962 rw[] >>
3963 rw_tac std_ss[LENGTH] >>
3964 Cases_on `l = []` >-
3965 rw[] >>
3966 `0 < LENGTH l` by metis_tac[LENGTH_NIL, NOT_ZERO_LT_ZERO] >>
3967 `LENGTH (DILATE e 0 n (h::l)) = LENGTH (h::(GENLIST (K e) n ++ DILATE e 0 n l))` by rw[DILATE_0_CONS] >>
3968 `_ = SUC (LENGTH (GENLIST (K e) n ++ DILATE e 0 n l))` by rw[] >>
3969 `_ = SUC (n + LENGTH (DILATE e 0 n l))` by rw[] >>
3970 `_ = SUC (n + SUC (SUC n * PRE (LENGTH l)))` by rw[] >>
3971 `_ = SUC (SUC (n + SUC n * PRE (LENGTH l)))` by rw[] >>
3972 `_ = SUC (SUC n + SUC n * PRE (LENGTH l))` by rw[] >>
3973 `_ = SUC (SUC n * SUC (PRE (LENGTH l)))` by rw[MULT_SUC] >>
3974 `_ = SUC (SUC n * LENGTH l)` by rw[SUC_PRE] >>
3975 rw[]
3976QED
3977
3978(* Theorem: LENGTH l <= LENGTH (DILATE e 0 n l) *)
3979(* Proof:
3980 If l = [],
3981 LENGTH (DILATE e 0 n [])
3982 = LENGTH [] by DILATE_NIL
3983 >= LENGTH []
3984 If l <> [],
3985 Then ?h t. l = h::t by list_CASES
3986 LENGTH (DILATE e 0 n (h::t))
3987 = SUC (SUC n * PRE (LENGTH (h::t))) by DILATE_0_LENGTH
3988 = SUC (SUC n * PRE (SUC (LENGTH t))) by LENGTH
3989 = SUC (SUC n * LENGTH t) by PRE
3990 = SUC n * LENGTH t + 1 by ADD1
3991 >= LENGTH t + 1 by LE_MULT_CANCEL_LBARE, 0 < SUC n
3992 = SUC (LENGTH t) by ADD1
3993 = LENGTH (h::t) by LENGTH
3994*)
3995Theorem DILATE_0_LENGTH_LOWER:
3996 !l e n. LENGTH l <= LENGTH (DILATE e 0 n l)
3997Proof
3998 rw[DILATE_0_LENGTH] >>
3999 `?h t. l = h::t` by metis_tac[list_CASES] >>
4000 rw[]
4001QED
4002
4003(* Theorem: LENGTH (DILATE e 0 n l) <= SUC (SUC n * PRE (LENGTH l)) *)
4004(* Proof:
4005 If l = [],
4006 LENGTH (DILATE e 0 n [])
4007 = LENGTH [] by DILATE_NIL
4008 = 0 by LENGTH_NIL
4009 SUC (SUC n * PRE (LENGTH []))
4010 = SUC (SUC n * PRE 0) by LENGTH_NIL
4011 = SUC 0 by PRE, MULT_0
4012 > 0 by LESS_SUC
4013 If l <> [],
4014 LENGTH (DILATE e 0 n l)
4015 = SUC (SUC n * PRE (LENGTH l)) by DILATE_0_LENGTH
4016*)
4017Theorem DILATE_0_LENGTH_UPPER:
4018 !l e n. LENGTH (DILATE e 0 n l) <= SUC (SUC n * PRE (LENGTH l))
4019Proof
4020 rw[DILATE_0_LENGTH]
4021QED
4022
4023(* Theorem: k < LENGTH (DILATE e 0 n l) ==>
4024 (EL k (DILATE e 0 n l) = if k MOD (SUC n) = 0 then EL (k DIV (SUC n)) l else e) *)
4025(* Proof:
4026 Let m = SUC n, then 0 < m.
4027 By induction on l.
4028 Base: !k. k < LENGTH (DILATE e 0 n []) ==> (EL k (DILATE e 0 n []) = if k MOD m = 0 then EL (k DIV m) [] else e)
4029 Note LENGTH (DILATE e 0 n [])
4030 = LENGTH [] by DILATE_NIL
4031 = 0 by LENGTH_NIL
4032 Thus k < 0 <=> F by NOT_ZERO_LT_ZERO
4033 Step: !k. k < LENGTH (DILATE e 0 n l) ==> (EL k (DILATE e 0 n l) = if k MOD m = 0 then EL (k DIV m) l else e) ==>
4034 !h k. k < LENGTH (DILATE e 0 n (h::l)) ==> (EL k (DILATE e 0 n (h::l)) = if k MOD m = 0 then EL (k DIV m) (h::l) else e)
4035 Note LENGTH (DILATE e 0 n [h]) = 1 by DILATE_SING
4036 and LENGTH (DILATE e 0 n (h::l))
4037 = SUC (m * PRE (LENGTH (h::l))) by DILATE_0_LENGTH, n <> 0
4038 = SUC (m * PRE (SUC (LENGTH l))) by LENGTH
4039 = SUC (m * LENGTH l) by PRE
4040
4041 If l = [],
4042 Then DILATE e 0 n [h] = [h] by DILATE_SING
4043 and LENGTH (DILATE e 0 n [h]) = 1 by LENGTH
4044 so k < 1 means k = 0.
4045 and 0 DIV m = 0 by ZERO_DIV, 0 < m
4046 and 0 MOD m = 0 by ZERO_MOD, 0 < m
4047 Thus EL k [h] = EL (k DIV m) [h].
4048
4049 If l <> [],
4050 Let t = h:: GENLIST (K e) n.
4051 Note LENGTH t = SUC n = m by LENGTH_GENLIST
4052 If k < m,
4053 Then k MOD m = k by LESS_MOD, k < m
4054 EL k (DILATE e 0 n (h::l))
4055 = EL k (t ++ DILATE e 0 n l) by DILATE_0_CONS
4056 = EL k t by EL_APPEND, k < LENGTH t
4057 If k = 0, i.e. k MOD m = 0.
4058 EL 0 t
4059 = EL 0 (h:: GENLIST (K e) (PRE n)) by notation of t
4060 = h
4061 = EL (0 DIV m) (h::l) by EL, HD
4062 If k <> 0, i.e. k MOD m <> 0.
4063 EL k t
4064 = EL k (h:: GENLIST (K e) n) by notation of t
4065 = EL (PRE k) (GENLIST (K e) n) by EL_CONS
4066 = (K e) (PRE k) by EL_GENLIST, PRE k < PRE m = n
4067 = e by application of K
4068 If ~(k < m), then m <= k.
4069 Given k < LENGTH (DILATE e 0 n (h::l))
4070 or k < SUC (m * LENGTH l) by above
4071 ==> k - m < SUC (m * LENGTH l) - m by m <= k
4072 = SUC (m * LENGTH l - m) by SUB
4073 = SUC (m * (LENGTH l - 1)) by LEFT_SUB_DISTRIB
4074 = SUC (m * PRE (LENGTH l)) by PRE_SUB1
4075 or k - m < LENGTH (MDILATE e n l) by MDILATE_LENGTH
4076 Thus (k - m) MOD m = k MOD m by SUB_MOD
4077 and (k - m) DIV m = k DIV m - 1 by SUB_DIV
4078 If k MOD m = 0,
4079 Note 0 < k DIV m by DIVIDES_MOD_0, DIV_POS
4080 EL k (t ++ DILATE e 0 n l)
4081 = EL (k - m) (DILATE e 0 n l) by EL_APPEND, m <= k
4082 = EL (k DIV m - 1) l by induction hypothesis, (k - m) MOD m = 0
4083 = EL (PRE (k DIV m)) l by PRE_SUB1
4084 = EL (k DIV m) (h::l) by EL_CONS, 0 < k DIV m
4085 If k MOD m <> 0,
4086 EL k (t ++ DILATE e 0 n l)
4087 = EL (k - m) (DILATE e 0 n l) by EL_APPEND, n <= k
4088 = e by induction hypothesis, (k - m) MOD n <> 0
4089*)
4090Theorem DILATE_0_EL:
4091 !l e n k. k < LENGTH (DILATE e 0 n l) ==>
4092 (EL k (DILATE e 0 n l) = if k MOD (SUC n) = 0 then EL (k DIV (SUC n)) l else e)
4093Proof
4094 ntac 3 strip_tac >>
4095 `0 < SUC n` by decide_tac >>
4096 qabbrev_tac `m = SUC n` >>
4097 Induct_on `l` >-
4098 rw[] >>
4099 rpt strip_tac >>
4100 `LENGTH (DILATE e 0 n [h]) = 1` by rw[DILATE_SING] >>
4101 `LENGTH (DILATE e 0 n (h::l)) = SUC (m * LENGTH l)` by rw[DILATE_0_LENGTH, Abbr`m`] >>
4102 Cases_on `l = []` >| [
4103 `k = 0` by rw[] >>
4104 `k MOD m = 0` by rw[] >>
4105 `k DIV m = 0` by rw[ZERO_DIV] >>
4106 rw_tac std_ss[DILATE_SING],
4107 qabbrev_tac `t = h::GENLIST (K e) n` >>
4108 `DILATE e 0 n (h::l) = t ++ DILATE e 0 n l` by rw[DILATE_0_CONS, Abbr`t`] >>
4109 `m = LENGTH t` by rw[Abbr`t`] >>
4110 Cases_on `k < m` >| [
4111 `k MOD m = k` by rw[] >>
4112 `EL k (DILATE e 0 n (h::l)) = EL k t` by rw[EL_APPEND] >>
4113 Cases_on `k = 0` >| [
4114 `EL 0 t = h` by rw[Abbr`t`] >>
4115 rw[ZERO_DIV],
4116 `PRE m = n` by rw[Abbr`m`] >>
4117 `PRE k < n` by decide_tac >>
4118 `EL k t = EL (PRE k) (GENLIST (K e) n)` by rw[EL_CONS, Abbr`t`] >>
4119 `_ = (K e) (PRE k)` by rw[EL_GENLIST] >>
4120 rw[]
4121 ],
4122 `m <= k` by decide_tac >>
4123 `EL k (t ++ DILATE e 0 n l) = EL (k - m) (DILATE e 0 n l)` by simp[EL_APPEND] >>
4124 `k - m < LENGTH (DILATE e 0 n l)` by rw[DILATE_0_LENGTH] >>
4125 `(k - m) MOD m = k MOD m` by simp[SUB_MOD] >>
4126 `(k - m) DIV m = k DIV m - 1` by simp[SUB_DIV] >>
4127 Cases_on `k MOD m = 0` >| [
4128 `0 < k DIV m` by rw[DIVIDES_MOD_0, DIV_POS] >>
4129 `EL (k - m) (DILATE e 0 n l) = EL (k DIV m - 1) l` by rw[] >>
4130 `_ = EL (PRE (k DIV m)) l` by rw[PRE_SUB1] >>
4131 `_ = EL (k DIV m) (h::l)` by rw[EL_CONS] >>
4132 rw[],
4133 `EL (k - m) (DILATE e 0 n l) = e` by rw[] >>
4134 rw[]
4135 ]
4136 ]
4137 ]
4138QED
4139
4140(* This is a milestone theorem. *)
4141
4142(* Theorem: (DILATE e 0 n l = []) <=> (l = []) *)
4143(* Proof:
4144 If part: DILATE e 0 n l = [] ==> l = []
4145 By contradiction, suppose l <> [].
4146 If n = 0,
4147 Then DILATE e n 0 l = l by DILATE_0_0
4148 This contradicts DILATE e n 0 l = [].
4149 If n <> 0,
4150 Then LENGTH (DILATE e 0 n l)
4151 = SUC (SUC n * PRE (LENGTH l)) by DILATE_0_LENGTH
4152 <> 0 by SUC_NOT
4153 So (DILATE e 0 n l) <> [] by LENGTH_NIL
4154 This contradicts DILATE e 0 n l = []
4155 Only-if part: l = [] ==> DILATE e 0 n l = []
4156 True by DILATE_NIL
4157*)
4158Theorem DILATE_0_EQ_NIL:
4159 !l e n. (DILATE e 0 n l = []) <=> (l = [])
4160Proof
4161 rw[EQ_IMP_THM] >>
4162 spose_not_then strip_assume_tac >>
4163 Cases_on `n = 0` >| [
4164 `DILATE e 0 0 l = l` by rw[GSYM DILATE_0_0] >>
4165 metis_tac[],
4166 `LENGTH (DILATE e 0 n l) = SUC (SUC n * PRE (LENGTH l))` by rw[DILATE_0_LENGTH] >>
4167 `LENGTH (DILATE e 0 n l) <> 0` by decide_tac >>
4168 metis_tac[LENGTH_EQ_0]
4169 ]
4170QED
4171
4172(* Theorem: LAST (DILATE e 0 n l) = LAST l *)
4173(* Proof:
4174 If l = [],
4175 LAST (DILATE e 0 n [])
4176 = LAST [] by DILATE_NIL
4177 If l <> [],
4178 If n = 0,
4179 LAST (DILATE e 0 0 l)
4180 = LAST l by DILATE_0_0
4181 If n <> 0,
4182 Then DILATE e 0 n l <> [] by DILATE_0_EQ_NIL
4183 or LENGTH (DILATE e 0 n l) <> 0 by LENGTH_NIL
4184 Let m = SUC n, then 0 < m by LESS_0
4185 Note PRE (LENGTH (DILATE e 0 n l))
4186 = PRE (SUC (m * PRE (LENGTH l))) by DILATE_0_LENGTH
4187 = m * PRE (LENGTH l) by PRE
4188 Let k = PRE (LENGTH (DILATE e 0 n l)).
4189 Then k < LENGTH (DILATE e 0 n l) by PRE x < x
4190 and k MOD m = 0 by MOD_EQ_0, MULT_COMM, 0 < m
4191 and k DIV m = PRE (LENGTH l) by MULT_DIV, MULT_COMM
4192
4193 LAST (DILATE e 0 n l)
4194 = EL k (DILATE e 0 n l) by LAST_EL
4195 = EL (k DIV m) l by DILATE_0_EL
4196 = EL (PRE (LENGTH l)) l by above
4197 = LAST l by LAST_EL
4198*)
4199Theorem DILATE_0_LAST:
4200 !l e n. LAST (DILATE e 0 n l) = LAST l
4201Proof
4202 rpt strip_tac >>
4203 Cases_on `l = []` >-
4204 rw[] >>
4205 Cases_on `n = 0` >-
4206 rw[DILATE_0_0] >>
4207 `0 < n` by decide_tac >>
4208 `DILATE e 0 n l <> []` by rw[DILATE_0_EQ_NIL] >>
4209 `LENGTH (DILATE e 0 n l) <> 0` by metis_tac[LENGTH_NIL] >>
4210 qabbrev_tac `k = PRE (LENGTH (DILATE e 0 n l))` >>
4211 rw[LAST_EL] >>
4212 `0 < SUC n` by decide_tac >>
4213 qabbrev_tac `m = SUC n` >>
4214 `k = m * PRE (LENGTH l)` by rw[DILATE_0_LENGTH, Abbr`k`, Abbr`m`] >>
4215 `k MOD m = 0` by metis_tac[MOD_EQ_0, MULT_COMM] >>
4216 `k DIV m = PRE (LENGTH l)` by metis_tac[MULT_DIV, MULT_COMM] >>
4217 `k < LENGTH (DILATE e 0 n l)` by simp[Abbr`k`] >>
4218 Q.RM_ABBREV_TAC ‘k’ >>
4219 rw[DILATE_0_EL]
4220QED
4221
4222(* ------------------------------------------------------------------------- *)
4223(* FUNPOW with incremental cons. *)
4224(* ------------------------------------------------------------------------- *)
4225
4226(* Note from HelperList: m downto n = REVERSE [m .. n] *)
4227
4228(* Idea: when applying incremental cons (f head) to a list for n times,
4229 head of the result is f^n (head of list). *)
4230
4231(* Theorem: HD (FUNPOW (\ls. f (HD ls)::ls) n ls) = FUNPOW f n (HD ls) *)
4232(* Proof:
4233 Let h = (\ls. f (HD ls)::ls).
4234 By induction on n.
4235 Base: !ls. HD (FUNPOW h 0 ls) = FUNPOW f 0 (HD ls)
4236 HD (FUNPOW h 0 ls)
4237 = HD ls by FUNPOW_0
4238 = FUNPOW f 0 (HD ls) by FUNPOW_0
4239 Step: !ls. HD (FUNPOW h n ls) = FUNPOW f n (HD ls) ==>
4240 !ls. HD (FUNPOW h (SUC n) ls) = FUNPOW f (SUC n) (HD ls)
4241 HD (FUNPOW h (SUC n) ls)
4242 = HD (FUNPOW h n (h ls)) by FUNPOW
4243 = FUNPOW f n (HD (h ls)) by induction hypothesis
4244 = FUNPOW f n (f (HD ls)) by definition of h
4245 = FUNPOW f (SUC n) (HD ls) by FUNPOW
4246*)
4247Theorem FUNPOW_cons_head:
4248 !f n ls. HD (FUNPOW (\ls. f (HD ls)::ls) n ls) = FUNPOW f n (HD ls)
4249Proof
4250 strip_tac >>
4251 qabbrev_tac `h = \ls. f (HD ls)::ls` >>
4252 Induct >-
4253 simp[] >>
4254 rw[FUNPOW, Abbr`h`]
4255QED
4256
4257(* Idea: when applying incremental cons (f head) to a singleton [u] for n times,
4258 the result is the list [f^n(u), .... f(u), u]. *)
4259
4260(* Theorem: FUNPOW (\ls. f (HD ls)::ls) n [u] =
4261 MAP (\j. FUNPOW f j u) (n downto 0) *)
4262(* Proof:
4263 Let g = (\ls. f (HD ls)::ls),
4264 h = (\j. FUNPOW f j u).
4265 By induction on n.
4266 Base: FUNPOW g 0 [u] = MAP h (0 downto 0)
4267 FUNPOW g 0 [u]
4268 = [u] by FUNPOW_0
4269 = [FUNPOW f 0 u] by FUNPOW_0
4270 = MAP h [0] by MAP
4271 = MAP h (0 downto 0) by REVERSE
4272 Step: FUNPOW g n [u] = MAP h (n downto 0) ==>
4273 FUNPOW g (SUC n) [u] = MAP h (SUC n downto 0)
4274 FUNPOW g (SUC n) [u]
4275 = g (FUNPOW g n [u]) by FUNPOW_SUC
4276 = g (MAP h (n downto 0)) by induction hypothesis
4277 = f (HD (MAP h (n downto 0))) ::
4278 MAP h (n downto 0) by definition of g
4279 Now f (HD (MAP h (n downto 0)))
4280 = f (HD (MAP h (MAP (\x. n - x) [0 .. n]))) by listRangeINC_REVERSE
4281 = f (HD (MAP h o (\x. n - x) [0 .. n])) by MAP_COMPOSE
4282 = f ((h o (\x. n - x)) 0) by MAP
4283 = f (h n)
4284 = f (FUNPOW f n u) by definition of h
4285 = FUNPOW (n + 1) u by FUNPOW_SUC
4286 = h (n + 1) by definition of h
4287 so h (n + 1) :: MAP h (n downto 0)
4288 = MAP h ((n + 1) :: (n downto 0)) by MAP
4289 = MAP h (REVERSE (SNOC (n+1) [0 .. n])) by REVERSE_SNOC
4290 = MAP h (SUC n downto 0) by listRangeINC_SNOC
4291*)
4292Theorem FUNPOW_cons_eq_map_0:
4293 !f u n. FUNPOW (\ls. f (HD ls)::ls) n [u] =
4294 MAP (\j. FUNPOW f j u) (n downto 0)
4295Proof
4296 ntac 2 strip_tac >>
4297 Induct >-
4298 rw[] >>
4299 qabbrev_tac `g = \ls. f (HD ls)::ls` >>
4300 qabbrev_tac `h = \j. FUNPOW f j u` >>
4301 rw[] >>
4302 `f (HD (MAP h (n downto 0))) = h (n + 1)` by
4303 (`[0 .. n] = 0 :: [1 .. n]` by rw[listRangeINC_CONS] >>
4304 fs[listRangeINC_REVERSE, MAP_COMPOSE, GSYM FUNPOW_SUC, ADD1, Abbr`h`]) >>
4305 `FUNPOW g (SUC n) [u] = g (FUNPOW g n [u])` by rw[FUNPOW_SUC] >>
4306 `_ = g (MAP h (n downto 0))` by fs[] >>
4307 `_ = h (n + 1) :: MAP h (n downto 0)` by rw[Abbr`g`] >>
4308 `_ = MAP h ((n + 1) :: (n downto 0))` by rw[] >>
4309 `_ = MAP h (REVERSE (SNOC (n+1) [0 .. n]))` by rw[REVERSE_SNOC] >>
4310 rw[listRangeINC_SNOC, ADD1]
4311QED
4312
4313(* Idea: when applying incremental cons (f head) to a singleton [f(u)] for (n-1) times,
4314 the result is the list [f^n(u), .... f(u)]. *)
4315
4316(* Theorem: 0 < n ==> (FUNPOW (\ls. f (HD ls)::ls) (n - 1) [f u] =
4317 MAP (\j. FUNPOW f j u) (n downto 1)) *)
4318(* Proof:
4319 Let g = (\ls. f (HD ls)::ls),
4320 h = (\j. FUNPOW f j u).
4321 By induction on n.
4322 Base: FUNPOW g 0 [f u] = MAP h (REVERSE [1 .. 1])
4323 FUNPOW g 0 [f u]
4324 = [f u] by FUNPOW_0
4325 = [FUNPOW f 1 u] by FUNPOW_1
4326 = MAP h [1] by MAP
4327 = MAP h (REVERSE [1 .. 1]) by REVERSE
4328 Step: 0 < n ==> FUNPOW g (n-1) [f u] = MAP h (n downto 1) ==>
4329 FUNPOW g n [f u] = MAP h (REVERSE [1 .. SUC n])
4330 The case n = 0 is the base case. For n <> 0,
4331 FUNPOW g n [f u]
4332 = g (FUNPOW g (n-1) [f u]) by FUNPOW_SUC
4333 = g (MAP h (n downto 1)) by induction hypothesis
4334 = f (HD (MAP h (n downto 1))) ::
4335 MAP h (n downto 1) by definition of g
4336 Now f (HD (MAP h (n downto 1)))
4337 = f (HD (MAP h (MAP (\x. n + 1 - x) [1 .. n]))) by listRangeINC_REVERSE
4338 = f (HD (MAP h o (\x. n + 1 - x) [1 .. n])) by MAP_COMPOSE
4339 = f ((h o (\x. n + 1 - x)) 1) by MAP
4340 = f (h n)
4341 = f (FUNPOW f n u) by definition of h
4342 = FUNPOW (n + 1) u by FUNPOW_SUC
4343 = h (n + 1) by definition of h
4344 so h (n + 1) :: MAP h (n downto 1)
4345 = MAP h ((n + 1) :: (n downto 1)) by MAP
4346 = MAP h (REVERSE (SNOC (n+1) [1 .. n])) by REVERSE_SNOC
4347 = MAP h (REVERSE [1 .. SUC n]) by listRangeINC_SNOC
4348*)
4349Theorem FUNPOW_cons_eq_map_1:
4350 !f u n. 0 < n ==> (FUNPOW (\ls. f (HD ls)::ls) (n - 1) [f u] =
4351 MAP (\j. FUNPOW f j u) (n downto 1))
4352Proof
4353 ntac 2 strip_tac >>
4354 Induct >-
4355 simp[] >>
4356 rw[] >>
4357 qabbrev_tac `g = \ls. f (HD ls)::ls` >>
4358 qabbrev_tac `h = \j. FUNPOW f j u` >>
4359 Cases_on `n = 0` >-
4360 rw[Abbr`g`, Abbr`h`] >>
4361 `f (HD (MAP h (n downto 1))) = h (n + 1)` by
4362 (`[1 .. n] = 1 :: [2 .. n]` by rw[listRangeINC_CONS] >>
4363 fs[listRangeINC_REVERSE, MAP_COMPOSE, GSYM FUNPOW_SUC, ADD1, Abbr`h`]) >>
4364 `n = SUC (n-1)` by decide_tac >>
4365 `FUNPOW g n [f u] = g (FUNPOW g (n - 1) [f u])` by metis_tac[FUNPOW_SUC] >>
4366 `_ = g (MAP h (n downto 1))` by fs[] >>
4367 `_ = h (n + 1) :: MAP h (n downto 1)` by rw[Abbr`g`] >>
4368 `_ = MAP h ((n + 1) :: (n downto 1))` by rw[] >>
4369 `_ = MAP h (REVERSE (SNOC (n+1) [1 .. n]))` by rw[REVERSE_SNOC] >>
4370 rw[listRangeINC_SNOC, ADD1]
4371QED
4372
4373(* ------------------------------------------------------------------------- *)
4374(* Binomial Documentation *)
4375(* ------------------------------------------------------------------------- *)
4376(* Definitions and Theorems (# are exported):
4377
4378 Binomial Coefficients:
4379 binomial_def |- (binomial 0 0 = 1) /\ (!n. binomial (SUC n) 0 = 1) /\
4380 (!k. binomial 0 (SUC k) = 0) /\
4381 !n k. binomial (SUC n) (SUC k) = binomial n k + binomial n (SUC k)
4382 binomial_alt |- !n k. binomial n 0 = 1 /\ binomial 0 (k + 1) = 0 /\
4383 binomial (n + 1) (k + 1) = binomial n k + binomial n (k + 1)
4384 binomial_less_0 |- !n k. n < k ==> (binomial n k = 0)
4385 binomial_n_0 |- !n. binomial n 0 = 1
4386 binomial_n_n |- !n. binomial n n = 1
4387 binomial_0_n |- !n. binomial 0 n = if n = 0 then 1 else 0
4388 binomial_recurrence |- !n k. binomial (SUC n) (SUC k) = binomial n k + binomial n (SUC k)
4389 binomial_formula |- !n k. binomial (n + k) k * (FACT n * FACT k) = FACT (n + k)
4390 binomial_formula2 |- !n k. k <= n ==> (FACT n = binomial n k * (FACT (n - k) * FACT k))
4391 binomial_formula3 |- !n k. k <= n ==> (binomial n k = FACT n DIV (FACT k * FACT (n - k)))
4392 binomial_fact |- !n k. k <= n ==> (binomial n k = FACT n DIV (FACT k * FACT (n - k)))
4393 binomial_n_k |- !n k. k <= n ==> (binomial n k = FACT n DIV FACT k DIV FACT (n - k)
4394 binomial_n_1 |- !n. binomial n 1 = n
4395 binomial_sym |- !n k. k <= n ==> (binomial n k = binomial n (n - k))
4396 binomial_is_integer |- !n k. k <= n ==> (FACT k * FACT (n - k)) divides (FACT n)
4397 binomial_pos |- !n k. k <= n ==> 0 < binomial n k
4398 binomial_eq_0 |- !n k. (binomial n k = 0) <=> n < k
4399 binomial_1_n |- !n. binomial 1 n = if 1 < n then 0 else 1
4400 binomial_up_eqn |- !n. 0 < n ==> !k. n * binomial (n - 1) k = (n - k) * binomial n k
4401 binomial_up |- !n. 0 < n ==> !k. binomial (n - 1) k = (n - k) * binomial n k DIV n
4402 binomial_right_eqn |- !n. 0 < n ==> !k. (k + 1) * binomial n (k + 1) = (n - k) * binomial n k
4403 binomial_right |- !n. 0 < n ==> !k. binomial n (k + 1) = (n - k) * binomial n k DIV (k + 1)
4404 binomial_monotone |- !n k. k < HALF n ==> binomial n k < binomial n (k + 1)
4405 binomial_max |- !n k. binomial n k <= binomial n (HALF n)
4406 binomial_iff |- !f. f = binomial <=>
4407 !n k. f n 0 = 1 /\ f 0 (k + 1) = 0 /\
4408 f (n + 1) (k + 1) = f n k + f n (k + 1)
4409
4410 Primes and Binomial Coefficients:
4411 prime_divides_binomials |- !n. prime n ==> 1 < n /\ !k. 0 < k /\ k < n ==> n divides (binomial n k)
4412 prime_divides_binomials_alt |- !n k. prime n /\ 0 < k /\ k < n ==> n divides binomial n k
4413 prime_divisor_property |- !n p. 1 < n /\ p < n /\ prime p /\ p divides n ==> ~(p divides (FACT (n - 1) DIV FACT (n - p)))
4414 divides_binomials_imp_prime |- !n. 1 < n /\ (!k. 0 < k /\ k < n ==> n divides (binomial n k)) ==> prime n
4415 prime_iff_divides_binomials |- !n. prime n <=> 1 < n /\ !k. 0 < k /\ k < n ==> n divides (binomial n k)
4416 prime_iff_divides_binomials_alt
4417 |- !n. prime n <=> 1 < n /\ !k. 0 < k /\ k < n ==> binomial n k MOD n = 0
4418
4419 Binomial Theorem:
4420 GENLIST_binomial_index_shift |- !n x y. GENLIST ((\k. binomial n k * x ** SUC (n - k) * y ** k) o SUC) n =
4421 GENLIST (\k. binomial n (SUC k) * x ** (n - k) * y ** SUC k) n
4422 binomial_index_shift |- !n x y. (\k. binomial (SUC n) k * x ** (SUC n - k) * y ** k) o SUC =
4423 (\k. binomial (SUC n) (SUC k) * x ** (n - k) * y ** SUC k)
4424 binomial_term_merge_x |- !n x y. (\k. x * k) o (\k. binomial n k * x ** (n - k) * y ** k) =
4425 (\k. binomial n k * x ** SUC (n - k) * y ** k)
4426 binomial_term_merge_y |- !n x y. (\k. y * k) o (\k. binomial n k * x ** (n - k) * y ** k) =
4427 (\k. binomial n k * x ** (n - k) * y ** SUC k)
4428 binomial_thm |- !n x y. (x + y) ** n = SUM (GENLIST (\k. binomial n k * x ** (n - k) * y ** k) (SUC n))
4429 binomial_thm_alt |- !n x y. (x + y) ** n = SUM (GENLIST (\k. binomial n k * x ** (n - k) * y ** k) (n + 1))
4430 binomial_sum |- !n. SUM (GENLIST (binomial n) (SUC n)) = 2 ** n
4431 binomial_sum_alt |- !n. SUM (GENLIST (binomial n) (n + 1)) = 2 ** n
4432
4433 Binomial Horizontal List:
4434 binomial_horizontal_0 |- binomial_horizontal 0 = [1]
4435 binomial_horizontal_len |- !n. LENGTH (binomial_horizontal n) = n + 1
4436 binomial_horizontal_mem |- !n k. k < n + 1 ==> MEM (binomial n k) (binomial_horizontal n)
4437 binomial_horizontal_mem_iff |- !n k. MEM (binomial n k) (binomial_horizontal n) <=> k <= n
4438 binomial_horizontal_member |- !n x. MEM x (binomial_horizontal n) <=> ?k. k <= n /\ (x = binomial n k)
4439 binomial_horizontal_element |- !n k. k <= n ==> (EL k (binomial_horizontal n) = binomial n k)
4440 binomial_horizontal_pos |- !n. EVERY (\x. 0 < x) (binomial_horizontal n)
4441 binomial_horizontal_pos_alt |- !n x. MEM x (binomial_horizontal n) ==> 0 < x
4442 binomial_horizontal_sum |- !n. SUM (binomial_horizontal n) = 2 ** n
4443 binomial_horizontal_max |- !n. MAX_LIST (binomial_horizontal n) = binomial n (HALF n)
4444 binomial_row_max |- !n. MAX_SET (IMAGE (binomial n) (count (n + 1))) = binomial n (HALF n)
4445 binomial_product_identity |- !m n k. k <= m /\ m <= n ==>
4446 (binomial m k * binomial n m = binomial n k * binomial (n - k) (m - k))
4447 binomial_middle_upper_bound |- !n. binomial n (HALF n) <= 4 ** HALF n
4448
4449 Stirling's Approximation:
4450 Stirling = (!n. FACT n = (SQRT (2 * pi * n)) * (n DIV e) ** n) /\
4451 (!n. SQRT n = n ** h) /\ (2 * h = 1) /\ (0 < pi) /\ (0 < e) /\
4452 (!a b x y. (a * b) DIV (x * y) = (a DIV x) * (b DIV y)) /\
4453 (!a b c. (a DIV c) DIV (b DIV c) = a DIV b)
4454 binomial_middle_by_stirling |- Stirling ==>
4455 !n. 0 < n /\ EVEN n ==> (binomial n (HALF n) = 2 ** (n + 1) DIV SQRT (2 * pi * n))
4456
4457 Useful theorems for Binomial:
4458 binomial_range_shift |- !n . 0 < n ==> ((!k. 0 < k /\ k < n ==> ((binomial n k) MOD n = 0)) <=>
4459 (!h. h < PRE n ==> ((binomial n (SUC h)) MOD n = 0)))
4460 binomial_mod_zero |- !n. 0 < n ==> !k. (binomial n k MOD n = 0) <=>
4461 (!x y. (binomial n k * x ** (n-k) * y ** k) MOD n = 0)
4462 binomial_range_shift_alt |- !n . 0 < n ==> ((!k. 0 < k /\ k < n ==>
4463 (!x y. ((binomial n k * x ** (n - k) * y ** k) MOD n = 0))) <=>
4464 (!h. h < PRE n ==> (!x y. ((binomial n (SUC h) * x ** (n - (SUC h)) * y ** (SUC h)) MOD n = 0))))
4465 binomial_mod_zero_alt |- !n. 0 < n ==> ((!k. 0 < k /\ k < n ==> ((binomial n k) MOD n = 0)) <=>
4466 !x y. SUM (GENLIST ((\k. (binomial n k * x ** (n - k) * y ** k) MOD n) o SUC) (PRE n)) = 0)
4467
4468 Binomial Theorem with prime exponent:
4469 binomial_thm_prime |- !p. prime p ==> (!x y. (x + y) ** p MOD p = (x ** p + y ** p) MOD p)
4470*)
4471
4472(* ------------------------------------------------------------------------- *)
4473(* Binomial Coefficients *)
4474(* ------------------------------------------------------------------------- *)
4475
4476(* Define Binomials:
4477 C(n,0) = 1
4478 C(0,k) = 0 if k > 0
4479 C(n+1,k+1) = C(n,k) + C(n,k+1)
4480*)
4481Definition binomial_def:
4482 (binomial 0 0 = 1) /\
4483 (binomial (SUC n) 0 = 1) /\
4484 (binomial 0 (SUC k) = 0) /\
4485 (binomial (SUC n) (SUC k) = binomial n k + binomial n (SUC k))
4486End
4487
4488(* Theorem: alternative definition of C(n,k). *)
4489(* Proof: by binomial_def. *)
4490Theorem binomial_alt:
4491 !n k. (binomial n 0 = 1) /\
4492 (binomial 0 (k + 1) = 0) /\
4493 (binomial (n + 1) (k + 1) = binomial n k + binomial n (k + 1))
4494Proof
4495 rewrite_tac[binomial_def, GSYM ADD1] >>
4496 (Cases_on `n` >> simp[binomial_def])
4497QED
4498
4499(* Basic properties *)
4500
4501(* Theorem: C(n,k) = 0 if n < k *)
4502(* Proof:
4503 By induction on n.
4504 Base case: C(0,k) = 0 if 0 < k, by definition.
4505 Step case: assume C(n,k) = 0 if n < k.
4506 then for SUC n < k,
4507 C(SUC n, k)
4508 = C(SUC n, SUC h) where k = SUC h
4509 = C(n,h) + C(n,SUC h) h < SUC h = k
4510 = 0 + 0 by induction hypothesis
4511 = 0
4512*)
4513Theorem binomial_less_0:
4514 !n k. n < k ==> (binomial n k = 0)
4515Proof
4516 Induct_on `n` >-
4517 metis_tac[binomial_def, num_CASES, NOT_ZERO] >>
4518 rw[binomial_def] >>
4519 `?h. k = SUC h` by metis_tac[SUC_NOT, NOT_ZERO, SUC_EXISTS, LESS_TRANS] >>
4520 metis_tac[binomial_def, LESS_MONO_EQ, LESS_TRANS, LESS_SUC, ADD_0]
4521QED
4522
4523(* Theorem: C(n,0) = 1 *)
4524(* Proof:
4525 If n = 0, C(n, 0) = C(0, 0) = 1 by binomial_def
4526 If n <> 0, n = SUC m, and C(SUC m, 0) = 1 by binomial_def
4527*)
4528Theorem binomial_n_0:
4529 !n. binomial n 0 = 1
4530Proof
4531 metis_tac[binomial_def, num_CASES]
4532QED
4533
4534(* Theorem: C(n,n) = 1 *)
4535(* Proof:
4536 By induction on n.
4537 Base case: C(0,0) = 1, true by binomial_def.
4538 Step case: assume C(n,n) = 1
4539 C(SUC n, SUC n)
4540 = C(n,n) + C(n,SUC n)
4541 = 1 + C(n,SUC n) by induction hypothesis
4542 = 1 + 0 by binomial_less_0
4543 = 1
4544*)
4545Theorem binomial_n_n:
4546 !n. binomial n n = 1
4547Proof
4548 Induct_on `n` >-
4549 metis_tac[binomial_def] >>
4550 metis_tac[binomial_def, LESS_SUC, binomial_less_0, ADD_0]
4551QED
4552
4553(* Theorem: binomial 0 n = if n = 0 then 1 else 0 *)
4554(* Proof:
4555 If n = 0,
4556 binomial 0 0 = 1 by binomial_n_0
4557 If n <> 0, then 0 < n.
4558 binomial 0 n = 0 by binomial_less_0
4559*)
4560Theorem binomial_0_n:
4561 !n. binomial 0 n = if n = 0 then 1 else 0
4562Proof
4563 rw[binomial_n_0, binomial_less_0]
4564QED
4565
4566(* Theorem: C(n+1,k+1) = C(n,k) + C(n,k+1) *)
4567(* Proof: by definition. *)
4568Theorem binomial_recurrence:
4569 !n k. binomial (SUC n) (SUC k) = binomial n k + binomial n (SUC k)
4570Proof
4571 rw[binomial_def]
4572QED
4573
4574(* Theorem: C(n+k,k) = (n+k)!/n!k! *)
4575(* Proof:
4576 By induction on k.
4577 Base case: C(n,0) = n!n! = 1 by binomial_n_0
4578 Step case: assume C(n+k,k) = (n+k)!/n!k!
4579 To prove C(n+SUC k, SUC k) = (n+SUC k)!/n!(SUC k)!
4580 By induction on n.
4581 Base case: C(SUC k, SUC k) = (SUC k)!/(SUC k)! = 1 by binomial_n_n
4582 Step case: assume C(n+SUC k, SUC k) = (n +SUC k)!/n!(SUC k)!
4583 To prove C(SUC n + SUC k, SUC k) = (SUC n + SUC k)!/(SUC n)!(SUC k)!
4584 C(SUC n + SUC k, SUC k)
4585 = C(SUC SUC (n+k), SUC k)
4586 = C(SUC (n+k),k) + C(SUC (n+k), SUC k)
4587 = C(SUC n + k, k) + C(n + SUC k, SUC k)
4588 = (SUC n + k)!/(SUC n)!k! + (n + SUC k)!/n!(SUC k)! by two induction hypothesis
4589 = ((SUC n + k)!(SUC k) + (n + SUC k)(SUC n))/(SUC n)!(SUC k)!
4590 = (SUC n + SUC k)!/(SUC n)!(SUC k)!
4591*)
4592Theorem binomial_formula:
4593 !n k. binomial (n+k) k * (FACT n * FACT k) = FACT (n+k)
4594Proof
4595 Induct_on `k` >-
4596 metis_tac[binomial_n_0, FACT, MULT_CLAUSES, ADD_0] >>
4597 Induct_on `n` >-
4598 metis_tac[binomial_n_n, FACT, MULT_CLAUSES, ADD_CLAUSES] >>
4599 `SUC n + SUC k = SUC (SUC (n+k))` by decide_tac >>
4600 `SUC (n + k) = SUC n + k` by decide_tac >>
4601 `binomial (SUC n + SUC k) (SUC k) * (FACT (SUC n) * FACT (SUC k)) =
4602 (binomial (SUC (n + k)) k +
4603 binomial (SUC (n + k)) (SUC k)) * (FACT (SUC n) * FACT (SUC k))`
4604 by metis_tac[binomial_recurrence] >>
4605 `_ = binomial (SUC (n + k)) k * (FACT (SUC n) * FACT (SUC k)) +
4606 binomial (SUC (n + k)) (SUC k) * (FACT (SUC n) * FACT (SUC k))`
4607 by metis_tac[RIGHT_ADD_DISTRIB] >>
4608 `_ = binomial (SUC n + k) k * (FACT (SUC n) * ((SUC k) * FACT k)) +
4609 binomial (n + SUC k) (SUC k) * ((SUC n) * FACT n * FACT (SUC k))`
4610 by metis_tac[ADD_COMM, SUC_ADD_SYM, FACT] >>
4611 `_ = binomial (SUC n + k) k * FACT (SUC n) * FACT k * (SUC k) +
4612 binomial (n + SUC k) (SUC k) * FACT n * FACT (SUC k) * (SUC n)`
4613 by metis_tac[MULT_COMM, MULT_ASSOC] >>
4614 `_ = FACT (SUC n + k) * SUC k + FACT (n + SUC k) * SUC n`
4615 by metis_tac[MULT_COMM, MULT_ASSOC] >>
4616 `_ = FACT (SUC (n+k)) * SUC k + FACT (SUC (n+k)) * SUC n`
4617 by metis_tac[ADD_COMM, SUC_ADD_SYM] >>
4618 `_ = FACT (SUC (n+k)) * (SUC k + SUC n)` by metis_tac[LEFT_ADD_DISTRIB] >>
4619 `_ = (SUC n + SUC k) * FACT (SUC (n+k))` by metis_tac[MULT_COMM, ADD_COMM] >>
4620 metis_tac[FACT]
4621QED
4622
4623(* Theorem: C(n,k) = n!/k!(n-k)! for 0 <= k <= n *)
4624(* Proof:
4625 FACT n
4626 = FACT ((n-k)+k) by SUB_ADD, k <= n.
4627 = binomial ((n-k)+k) k * (FACT (n-k) * FACT k) by binomial_formula
4628 = binomial n k * (FACT (n-k) * FACT k)) by SUB_ADD, k <= n.
4629*)
4630Theorem binomial_formula2:
4631 !n k. k <= n ==> (FACT n = binomial n k * (FACT (n-k) * FACT k))
4632Proof
4633 metis_tac[binomial_formula, SUB_ADD]
4634QED
4635
4636(* Theorem: k <= n ==> binomial n k = (FACT n) DIV ((FACT k) * (FACT (n - k))) *)
4637(* Proof:
4638 binomial n k
4639 = (binomial n k * (FACT (n - k) * FACT k)) DIV ((FACT (n - k) * FACT k)) by MULT_DIV
4640 = (FACT n) DIV ((FACT (n - k) * FACT k)) by binomial_formula2
4641 = (FACT n) DIV ((FACT k * FACT (n - k))) by MULT_COMM
4642*)
4643Theorem binomial_formula3:
4644 !n k. k <= n ==> (binomial n k = (FACT n) DIV ((FACT k) * (FACT (n - k))))
4645Proof
4646 metis_tac[binomial_formula2, MULT_COMM, MULT_DIV, MULT_EQ_0, FACT_LESS, NOT_ZERO]
4647QED
4648
4649(* Theorem alias. *)
4650Theorem binomial_fact = binomial_formula3;
4651(* val binomial_fact = |- !n k. k <= n ==> (binomial n k = FACT n DIV (FACT k * FACT (n - k))): thm *)
4652
4653(* Theorem: k <= n ==> binomial n k = (FACT n) DIV (FACT k) DIV (FACT (n - k)) *)
4654(* Proof:
4655 binomial n k
4656 = (FACT n) DIV ((FACT k * FACT (n - k))) by binomial_formula3
4657 = (FACT n) DIV (FACT k) DIV (FACT (n - k)) by DIV_DIV_DIV_MULT
4658*)
4659Theorem binomial_n_k:
4660 !n k. k <= n ==> (binomial n k = (FACT n) DIV (FACT k) DIV (FACT (n - k)))
4661Proof
4662 metis_tac[DIV_DIV_DIV_MULT, binomial_formula3, MULT_EQ_0, FACT_LESS, NOT_ZERO]
4663QED
4664
4665(* Theorem: binomial n 1 = n *)
4666(* Proof:
4667 If n = 0,
4668 binomial 0 1
4669 = if 1 = 0 then 1 else 0 by binomial_0_n
4670 = 0 by 1 = 0 = F
4671 If n <> 0, then 0 < n.
4672 Thus 1 <= n, and n = SUC (n-1) by 0 < n
4673 binomial n 1
4674 = FACT n DIV FACT 1 DIV FACT (n - 1) by binomial_n_k, 1 <= n
4675 = FACT n DIV 1 DIV (FACT (n-1)) by FACT, ONE
4676 = FACT n DIV (FACT (n-1)) by DIV_1
4677 = (n * FACT (n-1)) DIV (FACT (n-1)) by FACT
4678 = n by MULT_DIV, FACT_LESS
4679*)
4680Theorem binomial_n_1:
4681 !n. binomial n 1 = n
4682Proof
4683 rpt strip_tac >>
4684 Cases_on `n = 0` >-
4685 rw[binomial_0_n] >>
4686 `1 <= n /\ (n = SUC (n-1))` by decide_tac >>
4687 `binomial n 1 = FACT n DIV FACT 1 DIV FACT (n - 1)` by rw[binomial_n_k] >>
4688 `_ = FACT n DIV 1 DIV (FACT (n-1))` by EVAL_TAC >>
4689 `_ = FACT n DIV (FACT (n-1))` by rw[] >>
4690 `_ = (n * FACT (n-1)) DIV (FACT (n-1))` by metis_tac[FACT] >>
4691 `_ = n` by rw[MULT_DIV, FACT_LESS] >>
4692 rw[]
4693QED
4694
4695(* Theorem: k <= n ==> (binomial n k = binomial n (n-k)) *)
4696(* Proof:
4697 Note (n-k) <= n always.
4698 binomial n k
4699 = (FACT n) DIV (FACT k * FACT (n - k)) by binomial_formula3, k <= n.
4700 = (FACT n) DIV (FACT (n - k) * FACT k) by MULT_COMM
4701 = (FACT n) DIV (FACT (n - k) * FACT (n-(n-k))) by n - (n-k) = k
4702 = binomial n (n-k) by binomial_formula3, (n-k) <= n.
4703*)
4704Theorem binomial_sym:
4705 !n k. k <= n ==> (binomial n k = binomial n (n-k))
4706Proof
4707 rpt strip_tac >>
4708 `n - (n-k) = k` by decide_tac >>
4709 `(n-k) <= n` by decide_tac >>
4710 rw[binomial_formula3, MULT_COMM]
4711QED
4712
4713(* Theorem: k <= n ==> (FACT k * FACT (n-k)) divides (FACT n) *)
4714(* Proof:
4715 Since FACT n = binomial n k * (FACT (n - k) * FACT k) by binomial_formula2
4716 = binomial n k * (FACT k * FACT (n - k)) by MULT_COMM
4717 Hence (FACT k * FACT (n-k)) divides (FACT n) by divides_def
4718*)
4719Theorem binomial_is_integer:
4720 !n k. k <= n ==> (FACT k * FACT (n-k)) divides (FACT n)
4721Proof
4722 metis_tac[binomial_formula2, MULT_COMM, divides_def]
4723QED
4724
4725(* Theorem: k <= n ==> 0 < binomial n k *)
4726(* Proof:
4727 Since FACT n = binomial n k * (FACT (n - k) * FACT k) by binomial_formula2
4728 and 0 < FACT n, 0 < FACT (n-k), 0 < FACT k by FACT_LESS
4729 Hence 0 < binomial n k by ZERO_LESS_MULT
4730*)
4731Theorem binomial_pos:
4732 !n k. k <= n ==> 0 < binomial n k
4733Proof
4734 metis_tac[binomial_formula2, FACT_LESS, ZERO_LESS_MULT]
4735QED
4736
4737(* Theorem: (binomial n k = 0) <=> n < k *)
4738(* Proof:
4739 If part: (binomial n k = 0) ==> n < k
4740 By contradiction, suppose k <= n.
4741 Then 0 < binomial n k by binomial_pos
4742 This contradicts binomial n k = 0 by NOT_ZERO
4743 Only-if part: n < k ==> (binomial n k = 0)
4744 This is true by binomial_less_0
4745*)
4746Theorem binomial_eq_0:
4747 !n k. (binomial n k = 0) <=> n < k
4748Proof
4749 rw[EQ_IMP_THM] >| [
4750 spose_not_then strip_assume_tac >>
4751 `k <= n` by decide_tac >>
4752 metis_tac[binomial_pos, NOT_ZERO],
4753 rw[binomial_less_0]
4754 ]
4755QED
4756
4757(* Theorem: binomial 1 n = if 1 < n then 0 else 1 *)
4758(* Proof:
4759 If n = 0, binomial 1 0 = 1 by binomial_n_0
4760 If n = 1, binomial 1 1 = 1 by binomial_n_1
4761 Otherwise, binomial 1 n = 0 by binomial_eq_0, 1 < n
4762*)
4763Theorem binomial_1_n:
4764 !n. binomial 1 n = if 1 < n then 0 else 1
4765Proof
4766 rw[binomial_eq_0] >>
4767 `n = 0 \/ n = 1` by decide_tac >-
4768 simp[binomial_n_0] >>
4769 simp[binomial_n_1]
4770QED
4771
4772(* Relating Binomial to its up-entry:
4773
4774 binomial n k = (n, k, n-k) = n! / k! (n-k)!
4775 binomial (n-1) k = (n-1, k, n-1-k) = (n-1)! / k! (n-1-k)!
4776 = (n!/n) / k! ((n-k)!/(n-k))
4777 = (n-k) * binomial n k / n
4778*)
4779
4780(* Theorem: 0 < n ==> !k. n * binomial (n-1) k = (n-k) * (binomial n k) *)
4781(* Proof:
4782 If n <= k, that is n-1 < k.
4783 So binomial (n-1) k = 0 by binomial_less_0
4784 and n - k = 0 by arithmetic
4785 Hence true by MULT_EQ_0
4786 Otherwise k < n,
4787 or k <= n, 1 <= n-k, k <= n-1
4788 Therefore,
4789 FACT n = binomial n k * (FACT (n - k) * FACT k) by binomial_formula2, k <= n.
4790 = binomial n k * ((n - k) * FACT (n-1-k) * FACT k) by FACT
4791 = binomial n k * (n - k) * (FACT (n-1-k) * FACT k) by MULT_ASSOC
4792 = (n - k) * binomial n k * (FACT (n-1-k) * FACT k) by MULT_COMM
4793 FACT n = n * FACT (n-1) by FACT
4794 = n * (binomial (n-1) k * (FACT (n-1-k) * FACT k)) by binomial_formula2, k <= n-1.
4795 = (n * binomial (n-1) k) * (FACT (n-1-k) * FACT k) by MULT_ASSOC
4796 Since 0 < FACT (n-1-k) * FACT k by FACT_LESS, MULT_EQ_0
4797 n * binomial (n-1) k = (n-k) * (binomial n k) by MULT_RIGHT_CANCEL
4798*)
4799Theorem binomial_up_eqn:
4800 !n. 0 < n ==> !k. n * binomial (n-1) k = (n-k) * (binomial n k)
4801Proof
4802 rpt strip_tac >>
4803 `!n. n <> 0 <=> 0 < n` by decide_tac >>
4804 Cases_on `n <= k` >| [
4805 `n-1 < k /\ (n - k = 0)` by decide_tac >>
4806 `binomial (n - 1) k = 0` by rw[binomial_less_0] >>
4807 metis_tac[MULT_EQ_0],
4808 `k < n /\ k <= n /\ 1 <= n-k /\ k <= n-1` by decide_tac >>
4809 `SUC (n-1) = n` by decide_tac >>
4810 `SUC (n-1-k) = n - k` by metis_tac[SUB_PLUS, ADD_COMM, ADD1, SUB_ADD] >>
4811 `FACT n = binomial n k * (FACT (n - k) * FACT k)` by rw[binomial_formula2] >>
4812 `_ = binomial n k * ((n - k) * FACT (n-1-k) * FACT k)` by metis_tac[FACT] >>
4813 `_ = binomial n k * (n - k) * (FACT (n-1-k) * FACT k)` by rw[MULT_ASSOC] >>
4814 `_ = (n - k) * binomial n k * (FACT (n-1-k) * FACT k)` by rw_tac std_ss[MULT_COMM] >>
4815 `FACT n = n * FACT (n-1)` by metis_tac[FACT] >>
4816 `_ = n * (binomial (n-1) k * (FACT (n-1-k) * FACT k))` by rw_tac std_ss[GSYM binomial_formula2] >>
4817 `_ = (n * binomial (n-1) k) * (FACT (n-1-k) * FACT k)` by rw[MULT_ASSOC] >>
4818 metis_tac[FACT_LESS, MULT_EQ_0, MULT_RIGHT_CANCEL]
4819 ]
4820QED
4821
4822(* Theorem: 0 < n ==> !k. binomial (n-1) k = ((n-k) * (binomial n k)) DIV n *)
4823(* Proof:
4824 Since n * binomial (n-1) k = (n-k) * (binomial n k) by binomial_up_eqn
4825 binomial (n-1) k = (n-k) * (binomial n k) DIV n by DIV_SOLVE, 0 < n.
4826*)
4827Theorem binomial_up:
4828 !n. 0 < n ==> !k. binomial (n-1) k = ((n-k) * (binomial n k)) DIV n
4829Proof
4830 rw[binomial_up_eqn, DIV_SOLVE]
4831QED
4832
4833(* Relating Binomial to its right-entry:
4834
4835 binomial n k = (n, k, n-k) = n! / k! (n-k)!
4836 binomial n (k+1) = (n, k+1, n-k-1) = n! / (k+1)! (n-k-1)!
4837 = n! / (k+1) * k! ((n-k)!/(n-k))
4838 = (n-k) * binomial n k / (k+1)
4839*)
4840
4841(* Theorem: 0 < n ==> !k. (k + 1) * binomial n (k+1) = (n - k) * binomial n k *)
4842(* Proof:
4843 If n <= k, that is n < k+1.
4844 So binomial n (k+1) = 0 by binomial_less_0
4845 and n - k = 0 by arithmetic
4846 Hence true by MULT_EQ_0
4847 Otherwise k < n,
4848 or k <= n, 1 <= n-k, k+1 <= n
4849 Therefore,
4850 FACT n = binomial n k * (FACT (n - k) * FACT k) by binomial_formula2, k <= n.
4851 = binomial n k * ((n - k) * FACT (n-1-k) * FACT k) by FACT
4852 = binomial n k * (n - k) * (FACT (n-1-k) * FACT k) by MULT_ASSOC
4853 = (n - k) * binomial n k * (FACT (n-1-k) * FACT k) by MULT_COMM
4854 FACT n = binomial n (k+1) * (FACT (n-(k+1)) * FACT (k+1)) by binomial_formula2, k+1 <= n.
4855 = binomial n (k+1) * (FACT (n-1-k) * FACT (k+1)) by SUB_PLUS, ADD_COMM
4856 = binomial n (k+1) * (FACT (n-1-k) * ((k+1) * FACT k)) by FACT
4857 = binomial n (k+1) * ((k+1) * (FACT (n-1-k) * FACT k)) by MULT_ASSOC, MULT_COMM
4858 = (k+1) * binomial n (k+1) * (FACT (n-1-k) * FACT k) by MULT_COMM, MULT_ASSOC
4859 Since 0 < FACT (n-1-k) * FACT k by FACT_LESS, MULT_EQ_0
4860 (k+1) * binomial n (k+1) = (n-k) * (binomial n k) by MULT_RIGHT_CANCEL
4861*)
4862Theorem binomial_right_eqn:
4863 !n. 0 < n ==> !k. (k + 1) * binomial n (k+1) = (n - k) * binomial n k
4864Proof
4865 rpt strip_tac >>
4866 `!n. n <> 0 <=> 0 < n` by decide_tac >>
4867 Cases_on `n <= k` >| [
4868 `n < k+1` by decide_tac >>
4869 `binomial n (k+1) = 0` by rw[binomial_less_0] >>
4870 `n - k = 0` by decide_tac >>
4871 metis_tac[MULT_EQ_0],
4872 `k < n /\ k <= n /\ 1 <= n-k /\ k+1 <= n` by decide_tac >>
4873 `SUC k = k + 1` by decide_tac >>
4874 `SUC (n-1-k) = n - k` by metis_tac[SUB_PLUS, ADD_COMM, ADD1, SUB_ADD] >>
4875 `FACT n = binomial n k * (FACT (n - k) * FACT k)` by rw[binomial_formula2] >>
4876 `_ = binomial n k * ((n - k) * FACT (n-1-k) * FACT k)` by metis_tac[FACT] >>
4877 `_ = binomial n k * (n - k) * (FACT (n-1-k) * FACT k)` by rw[MULT_ASSOC] >>
4878 `_ = (n - k) * binomial n k * (FACT (n-1-k) * FACT k)` by rw_tac std_ss[MULT_COMM] >>
4879 `FACT n = binomial n (k+1) * (FACT (n-(k+1)) * FACT (k+1))` by rw[binomial_formula2] >>
4880 `_ = binomial n (k+1) * (FACT (n-1-k) * FACT (k+1))` by metis_tac[SUB_PLUS, ADD_COMM] >>
4881 `_ = binomial n (k+1) * (FACT (n-1-k) * ((k+1) * FACT k))` by metis_tac[FACT] >>
4882 `_ = binomial n (k+1) * ((FACT (n-1-k) * (k+1)) * FACT k)` by rw[MULT_ASSOC] >>
4883 `_ = binomial n (k+1) * ((k+1) * (FACT (n-1-k)) * FACT k)` by rw_tac std_ss[MULT_COMM] >>
4884 `_ = (binomial n (k+1) * (k+1)) * (FACT (n-1-k) * FACT k)` by rw[MULT_ASSOC] >>
4885 `_ = (k+1) * binomial n (k+1) * (FACT (n-1-k) * FACT k)` by rw_tac std_ss[MULT_COMM] >>
4886 metis_tac[FACT_LESS, MULT_EQ_0, MULT_RIGHT_CANCEL]
4887 ]
4888QED
4889
4890(* Theorem: 0 < n ==> !k. binomial n (k+1) = (n - k) * binomial n k DIV (k+1) *)
4891(* Proof:
4892 Since (k + 1) * binomial n (k+1) = (n - k) * binomial n k by binomial_right_eqn
4893 binomial n (k+1) = (n - k) * binomial n k DIV (k+1) by DIV_SOLVE, 0 < k+1.
4894*)
4895Theorem binomial_right:
4896 !n. 0 < n ==> !k. binomial n (k+1) = (n - k) * binomial n k DIV (k+1)
4897Proof
4898 rw[binomial_right_eqn, DIV_SOLVE, DECIDE ``!k. 0 < k+1``]
4899QED
4900
4901(*
4902 k < HALF n <=> k + 1 <= n - k
4903n = 5, HALF n = 2, binomial 5 k: 1, 5, 10, 10, 5, 1
4904 k= 0, 1, 2, 3, 4, 5
4905 k < 2 <=> k + 1 <= 5 - k
4906 k = 0 1 <= 5 binomial 5 1 >= binomial 5 0
4907 k = 1 2 <= 4 binomial 5 2 >= binomial 5 1
4908n = 6, HALF n = 3, binomial 6 k: 1, 6, 15, 20, 15, 6, 1
4909 k= 0, 1, 2, 3, 4, 5, 6
4910 k < 3 <=> k + 1 <= 6 - k
4911 k = 0 1 <= 6 binomial 6 1 >= binomial 6 0
4912 k = 1 2 <= 5 binomial 6 2 >= binomial 6 1
4913 k = 2 3 <= 4 binomial 6 3 >= binomial 6 2
4914*)
4915
4916(* Theorem: k < HALF n ==> binomial n k < binomial n (k + 1) *)
4917(* Proof:
4918 Note k < HALF n ==> 0 < n by ZERO_DIV, 0 < 2
4919 also k < HALF n ==> k + 1 < n - k by LESS_HALF_IFF
4920 so 0 < k + 1 /\ 0 < n - k by arithmetic
4921 Now (k + 1) * binomial n (k + 1) = (n - k) * binomial n k by binomial_right_eqn, 0 < n
4922 Note HALF n <= n by DIV_LESS_EQ, 0 < 2
4923 so k < HALF n <= n by above
4924 Thus 0 < binomial n k by binomial_pos, k <= n
4925 and 0 < binomial n (k + 1) by MULT_0, MULT_EQ_0
4926 Hence binomial n k < binomial n (k + 1) by MULT_EQ_LESS_TO_MORE
4927*)
4928Theorem binomial_monotone:
4929 !n k. k < HALF n ==> binomial n k < binomial n (k + 1)
4930Proof
4931 rpt strip_tac >>
4932 `k + 1 < n - k` by rw[GSYM LESS_HALF_IFF] >>
4933 `0 < k + 1 /\ 0 < n - k` by decide_tac >>
4934 `(k + 1) * binomial n (k + 1) = (n - k) * binomial n k` by rw[binomial_right_eqn] >>
4935 `HALF n <= n` by rw[DIV_LESS_EQ] >>
4936 `0 < binomial n k` by rw[binomial_pos] >>
4937 `0 < binomial n (k + 1)` by metis_tac[MULT_0, MULT_EQ_0, NOT_ZERO] >>
4938 metis_tac[MULT_EQ_LESS_TO_MORE]
4939QED
4940
4941(* Theorem: binomial n k <= binomial n (HALF n) *)
4942(* Proof:
4943 Since (k + 1) * binomial n (k + 1) = (n - k) * binomial n k by binomial_right_eqn
4944 binomial n (k + 1) / binomial n k = (n - k) / (k + 1)
4945 As k varies from 0, 1, to (n-1), n
4946 the ratio varies from n/1, (n-1)/2, (n-2)/3, ...., 1/n, 0/(n+1).
4947 The ratio is greater than 1 when (n - k) / (k + 1) > 1
4948 or n - k > k + 1
4949 or n > 2 * k + 1
4950 or HALF n >= k + (HALF 1)
4951 or k <= HALF n
4952 Thus (binomial n (HALF n)) is greater than all preceding coefficients.
4953 For k > HALF n, note that (binomial n k = binomial n (n - k)) by binomial_sym
4954 Hence (binomial n (HALF n)) is greater than all succeeding coefficients, too.
4955
4956 If n = 0,
4957 binomial 0 k = 1 or 0 by binomial_0_n
4958 binomial 0 (HALF 0) = 1 by binomial_0_n, ZERO_DIV
4959 Hence true.
4960 If n <> 0,
4961 If k = HALF n, trivially true.
4962 If k < HALF n,
4963 Then binomial n k < binomial n (HALF n) by binomial_monotone, MONOTONE_MAX
4964 Hence true.
4965 If ~(k < HALF n), HALF n < k.
4966 Then n - k <= HALF n by MORE_HALF_IMP
4967 If k > n,
4968 Then binomial n k = 0, hence true by binomial_less_0
4969 If ~(k > n), then k <= n.
4970 Then binomial n k = binomial n (n - k) by binomial_sym, k <= n
4971 If n - k = HALF n, trivially true.
4972 Otherwise, n - k < HALF n,
4973 Thus binomial n (n - k) < binomial n (HALF n) by binomial_monotone, MONOTONE_MAX
4974 Hence true.
4975*)
4976Theorem binomial_max:
4977 !n k. binomial n k <= binomial n (HALF n)
4978Proof
4979 rpt strip_tac >>
4980 Cases_on `n = 0` >-
4981 rw[binomial_0_n] >>
4982 Cases_on `k = HALF n` >-
4983 rw[] >>
4984 Cases_on `k < HALF n` >| [
4985 `binomial n k < binomial n (HALF n)` by rw[binomial_monotone, MONOTONE_MAX] >>
4986 decide_tac,
4987 `HALF n < k` by decide_tac >>
4988 `n - k <= HALF n` by rw[MORE_HALF_IMP] >>
4989 Cases_on `k > n` >-
4990 rw[binomial_less_0] >>
4991 `k <= n` by decide_tac >>
4992 `binomial n k = binomial n (n - k)` by rw[GSYM binomial_sym] >>
4993 Cases_on `n - k = HALF n` >-
4994 rw[] >>
4995 `n - k < HALF n` by decide_tac >>
4996 `binomial n (n - k) < binomial n (HALF n)` by rw[binomial_monotone, MONOTONE_MAX] >>
4997 decide_tac
4998 ]
4999QED
5000
5001(* Idea: the recurrence relation for binomial defines itself. *)
5002
5003(* Theorem: f = binomial <=>
5004 !n k. f n 0 = 1 /\ f 0 (k + 1) = 0 /\
5005 f (n + 1) (k + 1) = f n k + f n (k + 1) *)
5006(* Proof:
5007 If part: f = binomial ==> recurrence, true by binomial_alt
5008 Only-if part: recurrence ==> f = binomial
5009 By FUN_EQ_THM, this is to show:
5010 !n k. f n k = binomial n k
5011 By double induction, first induct on k.
5012 Base: !n. f n 0 = binomial n 0, true by binomial_n_0
5013 Step: !n. f n k = binomial n k ==>
5014 !n. f n (SUC k) = binomial n (SUC k)
5015 By induction on n.
5016 Base: f 0 (SUC k) = binomial 0 (SUC k)
5017 This is true by binomial_0_n, ADD1
5018 Step: f n (SUC k) = binomial n (SUC k) ==>
5019 f (SUC n) (SUC k) = binomial (SUC n) (SUC k)
5020
5021 f (SUC n) (SUC k)
5022 = f (n + 1) (k + 1) by ADD1
5023 = f n k + f n (k + 1) by given
5024 = binomial n k + binomial n (k + 1) by induction hypothesis
5025 = binomial (n + 1) (k + 1) by binomial_alt
5026 = binomial (SUC n) (SUC k) by ADD1
5027*)
5028Theorem binomial_iff:
5029 !f. f = binomial <=>
5030 !n k. f n 0 = 1 /\ f 0 (k + 1) = 0 /\ f (n + 1) (k + 1) = f n k + f n (k + 1)
5031Proof
5032 rw[binomial_alt, EQ_IMP_THM] >>
5033 simp[FUN_EQ_THM] >>
5034 Induct_on `x'` >-
5035 simp[binomial_n_0] >>
5036 Induct_on `x` >-
5037 fs[binomial_0_n, ADD1] >>
5038 fs[binomial_alt, ADD1]
5039QED
5040
5041(* ------------------------------------------------------------------------- *)
5042(* Primes and Binomial Coefficients *)
5043(* ------------------------------------------------------------------------- *)
5044
5045(* Theorem: n is prime ==> n divides C(n,k) for all 0 < k < n *)
5046(* Proof:
5047 C(n,k) = n!/k!/(n-k)!
5048 or n! = C(n,k) k! (n-k)!
5049 n divides n!, so n divides the product C(n,k) k!(n-k)!
5050 For a prime n, n cannot divide k!(n-k)!, all factors less than prime n.
5051 By Euclid's lemma, a prime divides a product must divide a factor.
5052 So p divides C(n,k).
5053*)
5054Theorem prime_divides_binomials:
5055 !n. prime n ==> 1 < n /\ (!k. 0 < k /\ k < n ==> n divides (binomial n k))
5056Proof
5057 rpt strip_tac >-
5058 metis_tac[ONE_LT_PRIME] >>
5059 `(n = n-k + k) /\ (n-k) < n` by decide_tac >>
5060 `FACT n = (binomial n k) * (FACT (n-k) * FACT k)` by metis_tac[binomial_formula] >>
5061 `~(n divides (FACT k)) /\ ~(n divides (FACT (n-k)))` by metis_tac[PRIME_BIG_NOT_DIVIDES_FACT] >>
5062 `n divides (FACT n)` by metis_tac[DIVIDES_FACT, LESS_TRANS] >>
5063 metis_tac[P_EUCLIDES]
5064QED
5065
5066(* Theorem: n is prime ==> n divides C(n,k) for all 0 < k < n *)
5067(* Proof: by prime_divides_binomials *)
5068Theorem prime_divides_binomials_alt:
5069 !n k. prime n /\ 0 < k /\ k < n ==> n divides (binomial n k)
5070Proof
5071 rw[prime_divides_binomials]
5072QED
5073
5074(* Theorem: If prime p divides n, p does not divide (n-1)!/(n-p)! *)
5075(* Proof:
5076 By contradiction.
5077 (n-1)...(n-p+1)/p cannot be an integer
5078 as p cannot divide any of the numerator.
5079 Note: when p divides n, the nearest multiples for p are n+/-p.
5080*)
5081Theorem prime_divisor_property:
5082 !n p. 1 < n /\ p < n /\ prime p /\ p divides n ==>
5083 ~(p divides ((FACT (n-1)) DIV (FACT (n-p))))
5084Proof
5085 spose_not_then strip_assume_tac >>
5086 `1 < p` by metis_tac[ONE_LT_PRIME] >>
5087 `n-p < n-1` by decide_tac >>
5088 `(FACT (n-1)) DIV (FACT (n-p)) = PROD_SET (IMAGE SUC ((count (n-1)) DIFF (count (n-p))))`
5089 by metis_tac[FACT_REDUCTION, MULT_DIV, FACT_LESS] >>
5090 `(count (n-1)) DIFF (count (n-p)) = {x | (n-p) <= x /\ x < (n-1)}`
5091 by srw_tac[ARITH_ss][EXTENSION, EQ_IMP_THM] >>
5092 `IMAGE SUC {x | (n-p) <= x /\ x < (n-1)} = {x | (n-p) < x /\ x < n}` by
5093 (srw_tac[ARITH_ss][EXTENSION, EQ_IMP_THM] >>
5094 qexists_tac `x-1` >>
5095 decide_tac) >>
5096 `FINITE (count (n - 1) DIFF count (n - p))` by rw[] >>
5097 `?y. y IN {x| n - p < x /\ x < n} /\ p divides y` by metis_tac[PROD_SET_EUCLID, IMAGE_FINITE] >>
5098 `!m n y. y IN {x | m < x /\ x < n} ==> m < y /\ y < n` by rw[] >>
5099 `n-p < y /\ y < n` by metis_tac[] >>
5100 `y < n + p` by decide_tac >>
5101 `y = n` by metis_tac[MULTIPLE_INTERVAL] >>
5102 decide_tac
5103QED
5104
5105(* Theorem: n divides C(n,k) for all 0 < k < n ==> n is prime *)
5106(* Proof:
5107 By contradiction. Let p be a proper factor of n, 1 < p < n.
5108 Then C(n,p) = n(n-1)...(n-p+1)/p(p-1)..1
5109 is divisible by n/p, but not n, since
5110 C(n,p)/n = (n-1)...(n-p+1)/p(p-1)...1
5111 cannot be an integer as p cannot divide any of the numerator.
5112 Note: when p divides n, the nearest multiples for p are n+/-p.
5113*)
5114Theorem divides_binomials_imp_prime:
5115 !n. 1 < n /\ (!k. 0 < k /\ k < n ==> n divides (binomial n k)) ==> prime n
5116Proof
5117 (spose_not_then strip_assume_tac) >>
5118 `?p. prime p /\ p < n /\ p divides n` by metis_tac[PRIME_FACTOR_PROPER] >>
5119 `n divides (binomial n p)` by metis_tac[PRIME_POS] >>
5120 `0 < p` by metis_tac[PRIME_POS] >>
5121 `(n = n-p + p) /\ (n-p) < n` by decide_tac >>
5122 `FACT n = (binomial n p) * (FACT (n-p) * FACT p)` by metis_tac[binomial_formula] >>
5123 `(n = SUC (n-1)) /\ (p = SUC (p-1))` by decide_tac >>
5124 `(FACT n = n * FACT (n-1)) /\ (FACT p = p * FACT (p-1))` by metis_tac[FACT] >>
5125 `n * FACT (n-1) = (binomial n p) * (FACT (n-p) * (p * FACT (p-1)))` by metis_tac[] >>
5126 `0 < n` by decide_tac >>
5127 `?q. binomial n p = n * q` by metis_tac[divides_def, MULT_COMM] >>
5128 `0 <> n` by decide_tac >>
5129 `FACT (n-1) = q * (FACT (n-p) * (p * FACT (p-1)))`
5130 by metis_tac[EQ_MULT_LCANCEL, MULT_ASSOC] >>
5131 `_ = q * ((FACT (p-1) * p)* FACT (n-p))` by metis_tac[MULT_COMM] >>
5132 `_ = q * FACT (p-1) * p * FACT (n-p)` by metis_tac[MULT_ASSOC] >>
5133 `FACT (n-1) DIV FACT (n-p) = q * FACT (p-1) * p` by metis_tac[MULT_DIV, FACT_LESS] >>
5134 metis_tac[divides_def, prime_divisor_property]
5135QED
5136
5137(* Theorem: n is prime iff n divides C(n,k) for all 0 < k < n *)
5138(* Proof:
5139 By prime_divides_binomials and
5140 divides_binomials_imp_prime.
5141*)
5142Theorem prime_iff_divides_binomials:
5143 !n. prime n <=> 1 < n /\ (!k. 0 < k /\ k < n ==> n divides (binomial n k))
5144Proof
5145 metis_tac[prime_divides_binomials, divides_binomials_imp_prime]
5146QED
5147
5148(* Theorem: prime n <=> 1 < n /\ !k. 0 < k /\ k < n ==> ((binomial n k) MOD n = 0) *)
5149(* Proof: by prime_iff_divides_binomials *)
5150Theorem prime_iff_divides_binomials_alt:
5151 !n. prime n <=> 1 < n /\ !k. 0 < k /\ k < n ==> ((binomial n k) MOD n = 0)
5152Proof
5153 rw[prime_iff_divides_binomials, DIVIDES_MOD_0]
5154QED
5155
5156(* ------------------------------------------------------------------------- *)
5157(* Binomial Theorem *)
5158(* ------------------------------------------------------------------------- *)
5159
5160(* Theorem: Binomial Index Shifting, for
5161 SUM (k=1..n) C(n,k)x^(n+1-k)y^k
5162 = SUM (k=0..n-1) C(n,k+1)x^(n-k)y^(k+1)
5163 *)
5164(* Proof:
5165SUM (k=1..n) C(n,k)x^(n+1-k)y^k
5166= SUM (MAP (\k. (binomial n k)* x**(n+1-k) * y**k) (GENLIST SUC n))
5167= SUM (GENLIST (\k. (binomial n k)* x**(n+1-k) * y**k) o SUC n)
5168
5169SUM (k=0..n-1) C(n,k+1)x^(n-k)y^(k+1)
5170= SUM (MAP (\k. (binomial n (k+1)) * x**(n-k) * y**(k+1)) (GENLIST I n))
5171= SUM (GENLIST (\k. (binomial n (k+1)) * x**(n-k) * y**(k+1)) o I n)
5172= SUM (GENLIST (\k. (binomial n (k+1)) * x**(n-k) * y**(k+1)) n)
5173
5174i.e.
5175
5176(\k. (binomial n k)* x**(n-k+1) * y**k) o SUC
5177= (\k. (binomial n (k+1)) * x**(n-k) * y**(k+1))
5178*)
5179(* Theorem: Binomial index shift for GENLIST *)
5180Theorem GENLIST_binomial_index_shift:
5181 !n x y. GENLIST ((\k. binomial n k * x ** SUC(n - k) * y ** k) o SUC) n =
5182 GENLIST (\k. binomial n (SUC k) * x ** (n-k) * y**(SUC k)) n
5183Proof
5184 rw_tac std_ss[GENLIST_FUN_EQ] >>
5185 `SUC (n - SUC k) = n - k` by decide_tac >>
5186 rw_tac std_ss[]
5187QED
5188
5189(* This is closely related to above, with (SUC n) replacing (n),
5190 but does not require k < n. *)
5191(* Proof: by function equality. *)
5192Theorem binomial_index_shift:
5193 !n x y. (\k. binomial (SUC n) k * x ** ((SUC n) - k) * y ** k) o SUC =
5194 (\k. binomial (SUC n) (SUC k) * x ** (n-k) * y ** (SUC k))
5195Proof
5196 rw_tac std_ss[FUN_EQ_THM]
5197QED
5198
5199(* Pattern for binomial expansion:
5200
5201 (x+y)(x^3 + 3x^2y + 3xy^2 + y^3)
5202 = x(x^3) + 3x(x^2y) + 3x(xy^2) + x(y^3) +
5203 y(x^3) + 3y(x^2y) + 3y(xy^2) + y(y^3)
5204 = x^4 + (3+1)x^3y + (3+3)(x^2y^2) + (1+3)(xy^3) + y^4
5205 = x^4 + 4x^3y + 6x^2y^2 + 4xy^3 + y^4
5206
5207*)
5208
5209(* Theorem: multiply x into a binomial term *)
5210(* Proof: by function equality and EXP. *)
5211Theorem binomial_term_merge_x:
5212 !n x y. (\k. x * k) o (\k. binomial n k * x ** (n - k) * y ** k) =
5213 (\k. binomial n k * x ** (SUC(n - k)) * y ** k)
5214Proof
5215 rw_tac std_ss[FUN_EQ_THM] >>
5216 `x * (binomial n k * x ** (n - k) * y ** k) =
5217 binomial n k * (x * x ** (n - k)) * y ** k` by decide_tac >>
5218 metis_tac[EXP]
5219QED
5220
5221(* Theorem: multiply y into a binomial term *)
5222(* Proof: by functional equality and EXP. *)
5223Theorem binomial_term_merge_y:
5224 !n x y. (\k. y * k) o (\k. binomial n k * x ** (n - k) * y ** k) =
5225 (\k. binomial n k * x ** (n - k) * y ** (SUC k))
5226Proof
5227 rw_tac std_ss[FUN_EQ_THM] >>
5228 `y * (binomial n k * x ** (n - k) * y ** k) =
5229 binomial n k * x ** (n - k) * (y * y ** k)` by decide_tac >>
5230 metis_tac[EXP]
5231QED
5232
5233(* Theorem: [Binomial Theorem] (x + y)^n = SUM (k=0..n) C(n,k)x^(n-k)y^k *)
5234(* Proof:
5235 By induction on n.
5236 Base case: to prove (x + y)^0 = SUM (k=0..0) C(0,k)x^(0-k)y^k
5237 (x + y)^0 = 1 by EXP
5238 SUM (k=0..0) C(0,k)x^(n-k)y^k = C(0,0)x^(0-0)y^0 = C(0,0) = 1 by EXP, binomial_def
5239 Step case: assume (x + y)^n = SUM (k=0..n) C(n,k)x^(n-k)y^k
5240 to prove: (x + y)^SUC n = SUM (k=0..(SUC n)) C(SUC n,k)x^((SUC n)-k)y^k
5241 (x + y)^SUC n
5242 = (x + y)(x + y)^n by EXP
5243 = (x + y) SUM (k=0..n) C(n,k)x^(n-k)y^k by induction hypothesis
5244 = x (SUM (k=0..n) C(n,k)x^(n-k)y^k) +
5245 y (SUM (k=0..n) C(n,k)x^(n-k)y^k) by RIGHT_ADD_DISTRIB
5246 = SUM (k=0..n) C(n,k)x^(n+1-k)y^k +
5247 SUM (k=0..n) C(n,k)x^(n-k)y^(k+1) by moving factor into SUM
5248 = C(n,0)x^(n+1) + SUM (k=1..n) C(n,k)x^(n+1-k)y^k +
5249 SUM (k=0..n-1) C(n,k)x^(n-k)y^(k+1) + C(n,n)y^(n+1)
5250 by breaking sum
5251
5252 = C(n,0)x^(n+1) + SUM (k=0..n-1) C(n,k+1)x^(n-k)y^(k+1) +
5253 SUM (k=0..n-1) C(n,k)x^(n-k)y^(k+1) + C(n,n)y^(n+1)
5254 by index shifting
5255 = C(n,0)x^(n+1) +
5256 SUM (k=0..n-1) [C(n,k+1) + C(n,k)] x^(n-k)y^(k+1) +
5257 C(n,n)y^(n+1) by merging sums
5258 = C(n,0)x^(n+1) +
5259 SUM (k=0..n-1) C(n+1,k+1) x^(n-k)y^(k+1) +
5260 C(n,n)y^(n+1) by binomial recurrence
5261 = C(n,0)x^(n+1) +
5262 SUM (k=1..n) C(n+1,k) x^(n+1-k)y^k +
5263 C(n,n)y^(n+1) by index shifting again
5264 = C(n+1,0)x^(n+1) +
5265 SUM (k=1..n) C(n+1,k) x^(n+1-k)y^k +
5266 C(n+1,n+1)y^(n+1) by binomial identities
5267 = SUM (k=0..(SUC n))C(SUC n,k) x^((SUC n)-k)y^k
5268 by synthesis of sum
5269*)
5270Theorem binomial_thm:
5271 !n x y. (x + y) ** n = SUM (GENLIST (\k. (binomial n k) * x ** (n-k) * y ** k) (SUC n))
5272Proof
5273 Induct_on `n` >-
5274 rw[EXP, binomial_n_n] >>
5275 rw_tac std_ss[EXP] >>
5276 `(x + y) * SUM (GENLIST (\k. binomial n k * x ** (n - k) * y ** k) (SUC n)) =
5277 x * SUM (GENLIST (\k. binomial n k * x ** (n - k) * y ** k) (SUC n)) +
5278 y * SUM (GENLIST (\k. binomial n k * x ** (n - k) * y ** k) (SUC n))`
5279 by metis_tac[RIGHT_ADD_DISTRIB] >>
5280 `_ = SUM (GENLIST ((\k. x * k) o (\k. binomial n k * x ** (n - k) * y ** k)) (SUC n)) +
5281 SUM (GENLIST ((\k. y * k) o (\k. binomial n k * x ** (n - k) * y ** k)) (SUC n))`
5282 by metis_tac[SUM_MULT, MAP_GENLIST] >>
5283 `_ = SUM (GENLIST (\k. binomial n k * x ** SUC(n - k) * y ** k) (SUC n)) +
5284 SUM (GENLIST (\k. binomial n k * x ** (n - k) * y ** (SUC k)) (SUC n))`
5285 by rw[binomial_term_merge_x, binomial_term_merge_y] >>
5286 `_ = (\k. binomial n k * x ** SUC (n - k) * y ** k) 0 +
5287 SUM (GENLIST ((\k. binomial n k * x ** SUC (n - k) * y ** k) o SUC) n) +
5288 SUM (GENLIST (\k. binomial n k * x ** (n - k) * y ** (SUC k)) (SUC n))`
5289 by rw[SUM_DECOMPOSE_FIRST] >>
5290 `_ = (\k. binomial n k * x ** SUC (n - k) * y ** k) 0 +
5291 SUM (GENLIST ((\k. binomial n k * x ** SUC (n - k) * y ** k) o SUC) n) +
5292 (SUM (GENLIST (\k. binomial n k * x ** (n - k) * y ** (SUC k)) n) +
5293 (\k. binomial n k * x ** (n - k) * y ** (SUC k)) n )`
5294 by rw[SUM_DECOMPOSE_LAST] >>
5295 `_ = (\k. binomial n k * x ** SUC(n - k) * y ** k) 0 +
5296 SUM (GENLIST (\k. binomial n (SUC k) * x ** (n - k) * y ** (SUC k)) n) +
5297 (SUM (GENLIST (\k. binomial n k * x ** (n - k) * y ** (SUC k)) n) +
5298 (\k. binomial n k * x ** (n - k) * y ** (SUC k)) n )`
5299 by metis_tac[GENLIST_binomial_index_shift] >>
5300 `_ = (\k. binomial n k * x ** SUC(n - k) * y ** k) 0 +
5301 (SUM (GENLIST (\k. binomial n (SUC k) * x ** (n - k) * y ** (SUC k)) n) +
5302 SUM (GENLIST (\k. binomial n k * x ** (n - k) * y ** (SUC k)) n)) +
5303 (\k. binomial n k * x ** (n - k) * y ** (SUC k)) n`
5304 by decide_tac >>
5305 `_ = (\k. binomial n k * x ** SUC (n - k) * y ** k) 0 +
5306 SUM (GENLIST (\k. (binomial n (SUC k) * x ** (n - k) * y ** (SUC k) +
5307 binomial n k * x ** (n - k) * y ** (SUC k))) n) +
5308 (\k. binomial n k * x ** (n - k) * y ** (SUC k)) n`
5309 by metis_tac[SUM_ADD_GENLIST] >>
5310 `_ = (\k. binomial n k * x ** SUC(n - k) * y ** k) 0 +
5311 SUM (GENLIST (\k. (binomial n (SUC k) + binomial n k) * x ** (n - k) * y ** (SUC k)) n) +
5312 (\k. binomial n k * x ** (n - k) * y ** (SUC k)) n`
5313 by rw[RIGHT_ADD_DISTRIB, MULT_ASSOC] >>
5314 `_ = (\k. binomial n k * x ** SUC(n - k) * y ** k) 0 +
5315 SUM (GENLIST (\k. binomial (SUC n) (SUC k) * x ** (n - k) * y ** (SUC k)) n) +
5316 (\k. binomial n k * x ** (n - k) * y ** (SUC k)) n`
5317 by rw[binomial_recurrence, ADD_COMM] >>
5318 `_ = binomial (SUC n) 0 * x ** (SUC n) * y ** 0 +
5319 SUM (GENLIST (\k. binomial (SUC n) (SUC k) * x ** (n - k) * y ** (SUC k)) n) +
5320 binomial (SUC n) (SUC n) * x ** 0 * y ** (SUC n)`
5321 by rw[binomial_n_0, binomial_n_n] >>
5322 `_ = binomial (SUC n) 0 * x ** (SUC n) * y ** 0 +
5323 SUM (GENLIST ((\k. binomial (SUC n) k * x ** ((SUC n) - k) * y ** k) o SUC) n) +
5324 binomial (SUC n) (SUC n) * x ** 0 * y ** (SUC n)`
5325 by rw[binomial_index_shift] >>
5326 `_ = SUM (GENLIST (\k. binomial (SUC n) k * x ** (SUC n - k) * y ** k) (SUC n)) +
5327 (\k. binomial (SUC n) k * x ** (SUC n - k) * y ** k) (SUC n)`
5328 by rw[SUM_DECOMPOSE_FIRST] >>
5329 `_ = SUM (GENLIST (\k. binomial (SUC n) k * x ** (SUC n - k) * y ** k) (SUC (SUC n)))`
5330 by rw[SUM_DECOMPOSE_LAST] >>
5331 decide_tac
5332QED
5333
5334(* This is a milestone theorem. *)
5335
5336(* Derive an alternative form. *)
5337Theorem binomial_thm_alt =
5338 binomial_thm |> SIMP_RULE bool_ss [ADD1];
5339(* val binomial_thm_alt =
5340 |- !n x y. (x + y) ** n =
5341 SUM (GENLIST (\k. binomial n k * x ** (n - k) * y ** k) (n + 1)): thm *)
5342
5343(* Theorem: SUM (GENLIST (binomial n) (SUC n)) = 2 ** n *)
5344(* Proof: by binomial_sum_alt and function equality. *)
5345(* Proof:
5346 Put x = 1, y = 1 in binomial_thm,
5347 (1 + 1) ** n = SUM (GENLIST (\k. binomial n k * 1 ** (n - k) * 1 ** k) (SUC n))
5348 (1 + 1) ** n = SUM (GENLIST (\k. binomial n k) (SUC n)) by EXP_1
5349 or 2 ** n = SUM (GENLIST (binomial n) (SUC n)) by FUN_EQ_THM
5350*)
5351Theorem binomial_sum:
5352 !n. SUM (GENLIST (binomial n) (SUC n)) = 2 ** n
5353Proof
5354 rpt strip_tac >>
5355 `!n. (\k. binomial n k * 1 ** (n - k) * 1 ** k) = binomial n` by rw[FUN_EQ_THM] >>
5356 `SUM (GENLIST (binomial n) (SUC n)) =
5357 SUM (GENLIST (\k. binomial n k * 1 ** (n - k) * 1 ** k) (SUC n))` by fs[] >>
5358 `_ = (1 + 1) ** n` by rw[GSYM binomial_thm] >>
5359 simp[]
5360QED
5361
5362(* Derive an alternative form. *)
5363Theorem binomial_sum_alt =
5364 binomial_sum |> SIMP_RULE bool_ss [ADD1];
5365(* val binomial_sum_alt = |- !n. SUM (GENLIST (binomial n) (n + 1)) = 2 ** n: thm *)
5366
5367(* ------------------------------------------------------------------------- *)
5368(* Binomial Horizontal List *)
5369(* ------------------------------------------------------------------------- *)
5370
5371(* Define Horizontal List in Pascal Triangle *)
5372(*
5373val binomial_horizontal_def = Define `
5374 binomial_horizontal n = GENLIST (binomial n) (SUC n)
5375`;
5376*)
5377
5378(* Use overloading for binomial_horizontal n. *)
5379Overload binomial_horizontal = ``\n. GENLIST (binomial n) (n + 1)``
5380
5381(* Theorem: binomial_horizontal 0 = [1] *)
5382(* Proof:
5383 binomial_horizontal 0
5384 = GENLIST (binomial 0) (0 + 1) by notation
5385 = SNOC (binomial 0 0) [] by GENLIST, ONE
5386 = [binomial 0 0] by SNOC
5387 = [1] by binomial_n_0
5388*)
5389Theorem binomial_horizontal_0:
5390 binomial_horizontal 0 = [1]
5391Proof
5392 rw[binomial_n_0]
5393QED
5394
5395(* Theorem: LENGTH (binomial_horizontal n) = n + 1 *)
5396(* Proof:
5397 LENGTH (binomial_horizontal n)
5398 = LENGTH (GENLIST (binomial n) (n + 1)) by notation
5399 = n + 1 by LENGTH_GENLIST
5400*)
5401Theorem binomial_horizontal_len:
5402 !n. LENGTH (binomial_horizontal n) = n + 1
5403Proof
5404 rw[]
5405QED
5406
5407(* Theorem: k < n + 1 ==> MEM (binomial n k) (binomial_horizontal n) *)
5408(* Proof: by MEM_GENLIST *)
5409Theorem binomial_horizontal_mem:
5410 !n k. k < n + 1 ==> MEM (binomial n k) (binomial_horizontal n)
5411Proof
5412 metis_tac[MEM_GENLIST]
5413QED
5414
5415(* Theorem: MEM (binomial n k) (binomial_horizontal n) <=> k <= n *)
5416(* Proof:
5417 If part: MEM (binomial n k) (binomial_horizontal n) ==> k <= n
5418 By contradiction, suppose n < k.
5419 Then binomial n k = 0 by binomial_less_0, ~(k <= n)
5420 But ?m. m < n + 1 ==> 0 = binomial n m by MEM_GENLIST
5421 or m <= n ==> binomial n m = 0 by m < n + 1
5422 Yet binomial n m <> 0 by binomial_eq_0
5423 This is a contradiction.
5424 Only-if part: k <= n ==> MEM (binomial n k) (binomial_horizontal n)
5425 By MEM_GENLIST, this is to show:
5426 ?m. m < n + 1 /\ (binomial n k = binomial n m)
5427 Note k <= n ==> k < n + 1,
5428 Take m = k, the result follows.
5429*)
5430Theorem binomial_horizontal_mem_iff:
5431 !n k. MEM (binomial n k) (binomial_horizontal n) <=> k <= n
5432Proof
5433 rw[EQ_IMP_THM] >| [
5434 spose_not_then strip_assume_tac >>
5435 `binomial n k = 0` by rw[binomial_less_0] >>
5436 fs[MEM_GENLIST] >>
5437 `m <= n` by decide_tac >>
5438 fs[binomial_eq_0],
5439 rw[MEM_GENLIST] >>
5440 `k < n + 1` by decide_tac >>
5441 metis_tac[]
5442 ]
5443QED
5444
5445(* Theorem: MEM x (binomial_horizontal n) <=> ?k. k <= n /\ (x = binomial n k) *)
5446(* Proof:
5447 By MEM_GENLIST, this is to show:
5448 (?m. m < n + 1 /\ (x = binomial n m)) <=> ?k. k <= n /\ (x = binomial n k)
5449 Since m < n + 1 <=> m <= n by LE_LT1
5450 This is trivially true.
5451*)
5452Theorem binomial_horizontal_member:
5453 !n x. MEM x (binomial_horizontal n) <=> ?k. k <= n /\ (x = binomial n k)
5454Proof
5455 metis_tac[MEM_GENLIST, LE_LT1]
5456QED
5457
5458(* Theorem: k <= n ==> (EL k (binomial_horizontal n) = binomial n k) *)
5459(* Proof: by EL_GENLIST *)
5460Theorem binomial_horizontal_element:
5461 !n k. k <= n ==> (EL k (binomial_horizontal n) = binomial n k)
5462Proof
5463 rw[EL_GENLIST]
5464QED
5465
5466(* Theorem: EVERY (\x. 0 < x) (binomial_horizontal n) *)
5467(* Proof:
5468 EVERY (\x. 0 < x) (binomial_horizontal n)
5469 <=> EVERY (\x. 0 < x) (GENLIST (binomial n) (n + 1)) by notation
5470 <=> !k. k < n + 1 ==> 0 < binomial n k by EVERY_GENLIST
5471 <=> !k. k <= n ==> 0 < binomial n k by arithmetic
5472 <=> T by binomial_pos
5473*)
5474Theorem binomial_horizontal_pos:
5475 !n. EVERY (\x. 0 < x) (binomial_horizontal n)
5476Proof
5477 rpt strip_tac >>
5478 `!k n. k < n + 1 <=> k <= n` by decide_tac >>
5479 rw_tac std_ss[EVERY_GENLIST, LESS_EQ_IFF_LESS_SUC, binomial_pos]
5480QED
5481
5482(* Theorem: MEM x (binomial_horizontal n) ==> 0 < x *)
5483(* Proof: by binomial_horizontal_pos, EVERY_MEM *)
5484Theorem binomial_horizontal_pos_alt:
5485 !n x. MEM x (binomial_horizontal n) ==> 0 < x
5486Proof
5487 metis_tac[binomial_horizontal_pos, EVERY_MEM]
5488QED
5489
5490(* Theorem: SUM (binomial_horizontal n) = 2 ** n *)
5491(* Proof:
5492 SUM (binomial_horizontal n)
5493 = SUM (GENLIST (binomial n) (n + 1)) by notation
5494 = 2 ** n by binomial_sum, ADD1
5495*)
5496Theorem binomial_horizontal_sum:
5497 !n. SUM (binomial_horizontal n) = 2 ** n
5498Proof
5499 rw_tac std_ss[binomial_sum, GSYM ADD1]
5500QED
5501
5502(* Theorem: MAX_LIST (binomial_horizontal n) = binomial n (HALF n) *)
5503(* Proof:
5504 Let l = binomial_horizontal n, m = binomial n (HALF n).
5505 Then l <> [] by binomial_horizontal_len, LENGTH_NIL
5506 and HALF n <= n by DIV_LESS_EQ, 0 < 2
5507 or HALF n < n + 1 by arithmetic
5508 Also MEM m l by binomial_horizontal_mem
5509 and !x. MEM x l ==> x <= m by binomial_max, MEM_GENLIST
5510 Thus m = MAX_LIST l by MAX_LIST_TEST
5511*)
5512Theorem binomial_horizontal_max:
5513 !n. MAX_LIST (binomial_horizontal n) = binomial n (HALF n)
5514Proof
5515 rpt strip_tac >>
5516 qabbrev_tac `l = binomial_horizontal n` >>
5517 qabbrev_tac `m = binomial n (HALF n)` >>
5518 `l <> []` by metis_tac[binomial_horizontal_len, LENGTH_NIL, DECIDE``n + 1 <> 0``] >>
5519 `HALF n <= n` by rw[DIV_LESS_EQ] >>
5520 `HALF n < n + 1` by decide_tac >>
5521 `MEM m l` by rw[binomial_horizontal_mem, Abbr`l`, Abbr`m`] >>
5522 metis_tac[binomial_max, MEM_GENLIST, MAX_LIST_TEST]
5523QED
5524
5525(* Theorem: MAX_SET (IMAGE (binomial n) (count (n + 1))) = binomial n (HALF n) *)
5526(* Proof:
5527 Let f = binomial n, s = IMAGE f (count (n + 1)).
5528 Note FINITE (count (n + 1)) by FINITE_COUNT
5529 so FINITE s by IMAGE_FINITE
5530 Also count (n + 1) <> {} by COUNT_EQ_EMPTY, n + 1 <> 0
5531 so s <> {} by IMAGE_EQ_EMPTY
5532 Now !k. k IN (count (n + 1)) ==> f k <= f (HALF n) by binomial_max
5533 ==> !x. x IN s ==> x <= f (HALF n) by IN_IMAGE
5534 Also HALF n <= n by DIV_LESS_EQ, 0 < 2
5535 so HALF n IN (count (n + 1)) by IN_COUNT
5536 ==> f (HALF n) IN s by IN_IMAGE
5537 Thus MAX_SET s = f (HALF n) by MAX_SET_TEST
5538*)
5539Theorem binomial_row_max:
5540 !n. MAX_SET (IMAGE (binomial n) (count (n + 1))) = binomial n (HALF n)
5541Proof
5542 rpt strip_tac >>
5543 qabbrev_tac `f = binomial n` >>
5544 qabbrev_tac `s = IMAGE f (count (n + 1))` >>
5545 `FINITE s` by rw[Abbr`s`] >>
5546 `s <> {}` by rw[COUNT_EQ_EMPTY, Abbr`s`] >>
5547 `!k. k IN (count (n + 1)) ==> f k <= f (HALF n)` by rw[binomial_max, Abbr`f`] >>
5548 `!x. x IN s ==> x <= f (HALF n)` by metis_tac[IN_IMAGE] >>
5549 `HALF n <= n` by rw[DIV_LESS_EQ] >>
5550 `HALF n IN (count (n + 1))` by rw[] >>
5551 `f (HALF n) IN s` by metis_tac[IN_IMAGE] >>
5552 rw[MAX_SET_TEST]
5553QED
5554
5555(* Theorem: k <= m /\ m <= n ==>
5556 ((binomial m k) * (binomial n m) = (binomial n k) * (binomial (n - k) (m - k))) *)
5557(* Proof:
5558 Using binomial_formula2,
5559
5560 (binomial m k) * (binomial n m)
5561 n! m!
5562 = ----------- * ------------------ binomial formula
5563 m! (n - m)! k! (m - k)!
5564 n! m!
5565 = ----------- * ------------------ cancel m!
5566 k! m! (m - k)! (n - m)!
5567 n! (n - k)!
5568 = ----------- * ------------------ replace by (n - k)!
5569 k! (n - k)! (m - k)! (n - m)!
5570
5571 = (binomial n k) * (binomial (n - k) (m - k)) binomial formula
5572*)
5573Theorem binomial_product_identity:
5574 !m n k. k <= m /\ m <= n ==>
5575 ((binomial m k) * (binomial n m) = (binomial n k) * (binomial (n - k) (m - k)))
5576Proof
5577 rpt strip_tac >>
5578 `m - k <= n - k` by decide_tac >>
5579 `(n - k) - (m - k) = n - m` by decide_tac >>
5580 `FACT m = binomial m k * (FACT (m - k) * FACT k)` by rw[binomial_formula2] >>
5581 `FACT n = binomial n m * (FACT (n - m) * FACT m)` by rw[binomial_formula2] >>
5582 `FACT n = binomial n k * (FACT (n - k) * FACT k)` by rw[binomial_formula2] >>
5583 `FACT (n - k) = binomial (n - k) (m - k) * (FACT (n - m) * FACT (m - k))` by metis_tac[binomial_formula2] >>
5584 `FACT n = FACT (n - m) * (FACT k * (FACT (m - k) * ((binomial m k) * (binomial n m))))` by metis_tac[MULT_ASSOC, MULT_COMM] >>
5585 `FACT n = FACT (n - m) * (FACT k * (FACT (m - k) * ((binomial n k) * (binomial (n - k) (m - k)))))` by metis_tac[MULT_ASSOC, MULT_COMM] >>
5586 metis_tac[MULT_LEFT_CANCEL, FACT_LESS, NOT_ZERO]
5587QED
5588
5589(* Theorem: binomial n (HALF n) <= 4 ** (HALF n) *)
5590(* Proof:
5591 Let m = HALF n, l = binomial_horizontal n
5592 Note LENGTH l = n + 1 by binomial_horizontal_len
5593 If EVEN n,
5594 Then n = 2 * m by EVEN_HALF
5595 and m <= n by m <= 2 * m
5596 Note EL m l <= SUM l by SUM_LE_EL, m < n + 1
5597 Now EL m l = binomial n m by binomial_horizontal_element, m <= n
5598 and SUM l
5599 = 2 ** n by binomial_horizontal_sum
5600 = 4 ** m by EXP_EXP_MULT
5601 Hence binomial n m <= 4 ** m.
5602 If ~EVEN n,
5603 Then ODD n by EVEN_ODD
5604 and n = 2 * m + 1 by ODD_HALF
5605 so m + 1 <= n by m + 1 <= 2 * m + 1
5606 with m <= n by m + 1 <= n
5607 Note EL m l = binomial n m by binomial_horizontal_element, m <= n
5608 and EL (m + 1) l = binomial n (m + 1) by binomial_horizontal_element, m + 1 <= n
5609 Note binomial n (m + 1) = binomial n m by binomial_sym
5610 Thus 2 * binomial n m
5611 = binomial n m + binomial n (m + 1) by above
5612 = EL m l + EL (m + 1) l
5613 <= SUM l by SUM_LE_SUM_EL, m < m + 1, m + 1 < n + 1
5614 and SUM l
5615 = 2 ** n by binomial_horizontal_sum
5616 = 2 * 2 ** (2 * m) by EXP, ADD1
5617 = 2 * 4 ** m by EXP_EXP_MULT
5618 Hence binomial n m <= 4 ** m.
5619*)
5620Theorem binomial_middle_upper_bound:
5621 !n. binomial n (HALF n) <= 4 ** (HALF n)
5622Proof
5623 rpt strip_tac >>
5624 qabbrev_tac `m = HALF n` >>
5625 qabbrev_tac `l = binomial_horizontal n` >>
5626 `LENGTH l = n + 1` by rw[binomial_horizontal_len, Abbr`l`] >>
5627 Cases_on `EVEN n` >| [
5628 `n = 2 * m` by rw[EVEN_HALF, Abbr`m`] >>
5629 `m < n + 1` by decide_tac >>
5630 `EL m l <= SUM l` by rw[SUM_LE_EL] >>
5631 `EL m l = binomial n m` by rw[binomial_horizontal_element, Abbr`l`] >>
5632 `SUM l = 2 ** n` by rw[binomial_horizontal_sum, Abbr`l`] >>
5633 `_ = 4 ** m` by rw[EXP_EXP_MULT] >>
5634 decide_tac,
5635 `ODD n` by metis_tac[EVEN_ODD] >>
5636 `n = 2 * m + 1` by rw[ODD_HALF, Abbr`m`] >>
5637 `EL m l = binomial n m` by rw[binomial_horizontal_element, Abbr`l`] >>
5638 `EL (m + 1) l = binomial n (m + 1)` by rw[binomial_horizontal_element, Abbr`l`] >>
5639 `binomial n (m + 1) = binomial n m` by rw[Once binomial_sym] >>
5640 `EL m l + EL (m + 1) l <= SUM l` by rw[SUM_LE_SUM_EL] >>
5641 `SUM l = 2 ** n` by rw[binomial_horizontal_sum, Abbr`l`] >>
5642 `_ = 2 * 2 ** (2 * m)` by metis_tac[EXP, ADD1] >>
5643 `_ = 2 * 4 ** m` by rw[EXP_EXP_MULT] >>
5644 decide_tac
5645 ]
5646QED
5647
5648(* ------------------------------------------------------------------------- *)
5649(* Stirling's Approximation *)
5650(* ------------------------------------------------------------------------- *)
5651
5652(* Stirling's formula: n! ~ sqrt(2 pi n) (n/e)^n. *)
5653Overload Stirling =
5654 ``(!n. FACT n = (SQRT (2 * pi * n)) * (n DIV e) ** n) /\
5655 (!n. SQRT n = n ** h) /\ (2 * h = 1) /\ (0 < pi) /\ (0 < e) /\
5656 (!a b x y. (a * b) DIV (x * y) = (a DIV x) * (b DIV y)) /\
5657 (!a b c. (a DIV c) DIV (b DIV c) = a DIV b)``
5658
5659(* Theorem: Stirling ==>
5660 !n. 0 < n /\ EVEN n ==> (binomial n (HALF n) = (2 ** (n + 1)) DIV (SQRT (2 * pi * n))) *)
5661(* Proof:
5662 Note HALF n <= n by DIV_LESS_EQ, 0 < 2
5663 Let k = HALF n, then n = 2 * k by EVEN_HALF
5664 Note 0 < k by 0 < n = 2 * k
5665 so (k * 2) DIV k = 2 by MULT_TO_DIV, 0 < k
5666 or n DIV k = 2 by MULT_COMM
5667 Also 0 < pi * n by MULT_EQ_0, 0 < pi, 0 < n
5668 so 0 < 2 * pi * n by arithmetic
5669
5670 Some theorems on the fly:
5671 Claim: !a b j. (a ** j) DIV (b ** j) = (a DIV b) ** j [1]
5672 Proof: By induction on j.
5673 Base: (a ** 0) DIV (b ** 0) = (a DIV b) ** 0
5674 (a ** 0) DIV (b ** 0)
5675 = 1 DIV 1 = 1 by EXP, DIVMOD_ID, 0 < 1
5676 = (a DIV b) ** 0 by EXP
5677 Step: (a ** j) DIV (b ** j) = (a DIV b) ** j ==>
5678 (a ** (SUC j)) DIV (b ** (SUC j)) = (a DIV b) ** (SUC j)
5679 (a ** (SUC j)) DIV (b ** (SUC j))
5680 = (a * a ** j) DIV (b * b ** j) by EXP
5681 = (a DIV b) * ((a ** j) DIV (b ** j)) by assumption
5682 = (a DIV b) * (a DIV b) ** j by induction hypothesis
5683 = (a DIV b) ** (SUC j) by EXP
5684
5685 Claim: !a b c. (a DIV b) * c = (a * c) DIV b [2]
5686 Proof: (a DIV b) * c
5687 = (a DIV b) * (c DIV 1) by DIV_1
5688 = (a * c) DIV (b * 1) by assumption
5689 = (a * c) DIV b by MULT_RIGHT_1
5690
5691 Claim: !a b. a DIV b = 2 * (a DIV (2 * b)) [3]
5692 Proof: a DIV b
5693 = 1 * (a DIV b) by MULT_LEFT_1
5694 = (n DIV n) * (a DIV b) by DIVMOD_ID, 0 < n
5695 = (n * a) DIV (n * b) by assumption
5696 = (n * a) DIV (k * (2 * b)) by arithmetic, n = 2 * k
5697 = (n DIV k) * (a DIV (2 * b)) by assumption
5698 = 2 * (a DIV (2 * b)) by n DIV k = 2
5699
5700 Claim: !a b. 0 < b ==> (a * (b ** h DIV b) = a DIV (b ** h)) [4]
5701 Proof: Let c = b ** h.
5702 Then b = c * c by EXP_EXP_MULT
5703 so 0 < c by MULT_EQ_0, 0 < b
5704 a * (c DIV b)
5705 = (c DIV b) * a by MULT_COMM
5706 = (a * c) DIV b by [2]
5707 = (a * c) DIV (c * c) by b = c * c
5708 = (a DIV c) * (c DIV c) by assumption
5709 = a DIV c by DIVMOD_ID, c DIV c = 1, 0 < c
5710
5711 Note (FACT k) ** 2
5712 = (SQRT (2 * pi * k)) ** 2 * ((k DIV e) ** k) ** 2 by EXP_BASE_MULT
5713 = (SQRT (2 * pi * k)) ** 2 * (k DIV e) ** n by EXP_EXP_MULT, n = 2 * k
5714 = (SQRT (pi * n)) ** 2 * (k DIV e) ** n by MULT_ASSOC, 2 * k = n
5715 = ((pi * n) ** h) ** 2 * (k DIV e) ** n by assumption
5716 = (pi * n) * (k DIV e) ** n by EXP_EXP_MULT, h * 2 = 1
5717
5718 binomial n (HALF n)
5719 = binomial n k by k = HALF n
5720 = FACT n DIV (FACT k * FACT (n - k)) by binomial_formula3, k <= n
5721 = FACT n DIV (FACT k * FACT k) by arithmetic, n - k = 2 * k - k = k
5722 = FACT n DIV ((FACT k) ** 2) by EXP_2
5723 = FACT n DIV ((pi * n) * (k DIV e) ** n) by above
5724 = ((2 * pi * n) ** h * (n DIV e) ** n) DIV ((pi * n) * (k DIV e) ** n) by assumption
5725 = ((2 * pi * n) ** h DIV (pi * n)) * ((n DIV e) ** n DIV ((k DIV e) ** n)) by (a * b) DIV (x * y) = (a DIV x) * (b DIV y)
5726 = ((2 * pi * n) ** h DIV (pi * n)) * ((n DIV e) DIV (k DIV e)) ** n by (a ** n) DIV (b ** n) = (a DIV b) ** n)
5727 = 2 * ((2 * pi * n) ** h DIV (2 * pi * n)) * ((n DIV e) DIV (k DIV e)) ** n by MULT_ASSOC, a DIV b = 2 * a DIV (2 * b)
5728 = 2 * ((2 * pi * n) ** h DIV (2 * pi * n)) * (n DIV k) ** n by assumption, apply DIV_DIV_DIV_MULT
5729 = 2 DIV (2 * pi * n) ** h * (n DIV k) ** n by 2 * x ** h DIV x = 2 DIV (x ** h)
5730 = 2 DIV (2 * pi * n) ** h * 2 ** n by n DIV k = 2
5731 = 2 * 2 ** n DIV (2 * pi * n) ** h by (a DIV b) * c = a * c DIV b
5732 = 2 ** (SUC n) DIV (2 * pi * n) ** h by EXP
5733 = 2 ** (n + 1)) DIV (SQRT (2 * pi * n)) by ADD1, assumption
5734*)
5735Theorem binomial_middle_by_stirling:
5736 Stirling ==> !n. 0 < n /\ EVEN n ==> (binomial n (HALF n) = (2 ** (n + 1)) DIV (SQRT (2 * pi * n)))
5737Proof
5738 rpt strip_tac >>
5739 `HALF n <= n /\ (n = 2 * HALF n)` by rw[DIV_LESS_EQ, EVEN_HALF] >>
5740 qabbrev_tac `k = HALF n` >>
5741 `0 < k` by decide_tac >>
5742 `n DIV k = 2` by metis_tac[MULT_TO_DIV, MULT_COMM] >>
5743 `0 < pi * n` by metis_tac[MULT_EQ_0, NOT_ZERO] >>
5744 `0 < 2 * pi * n` by decide_tac >>
5745 `(FACT k) ** 2 = (SQRT (2 * pi * k)) ** 2 * ((k DIV e) ** k) ** 2` by rw[EXP_BASE_MULT] >>
5746 `_ = (SQRT (2 * pi * k)) ** 2 * (k DIV e) ** n` by rw[GSYM EXP_EXP_MULT] >>
5747 `_ = (pi * n) * (k DIV e) ** n` by rw[GSYM EXP_EXP_MULT] >>
5748 (`!a b j. (a ** j) DIV (b ** j) = (a DIV b) ** j` by (Induct_on `j` >> rw[EXP])) >>
5749 `!a b c. (a DIV b) * c = (a * c) DIV b` by metis_tac[DIV_1, MULT_RIGHT_1] >>
5750 `!a b. a DIV b = 2 * (a DIV (2 * b))` by metis_tac[DIVMOD_ID, MULT_LEFT_1] >>
5751 `!a b. 0 < b ==> (a * (b ** h DIV b) = a DIV (b ** h))` by
5752 (rpt strip_tac >>
5753 qabbrev_tac `c = b ** h` >>
5754 `b = c * c` by rw[GSYM EXP_EXP_MULT, Abbr`c`] >>
5755 `0 < c` by metis_tac[MULT_EQ_0, NOT_ZERO] >>
5756 `a * (c DIV b) = (a * c) DIV (c * c)` by metis_tac[MULT_COMM] >>
5757 `_ = (a DIV c) * (c DIV c)` by metis_tac[] >>
5758 metis_tac[DIVMOD_ID, MULT_RIGHT_1]) >>
5759 `binomial n k = (FACT n) DIV (FACT k * FACT (n - k))` by metis_tac[binomial_formula3] >>
5760 `_ = (FACT n) DIV (FACT k) ** 2` by metis_tac[EXP_2, DECIDE``2 * k - k = k``] >>
5761 `_ = ((2 * pi * n) ** h * (n DIV e) ** n) DIV ((pi * n) * (k DIV e) ** n)` by prove_tac[] >>
5762 `_ = ((2 * pi * n) ** h DIV (pi * n)) * ((n DIV e) ** n DIV ((k DIV e) ** n))` by metis_tac[] >>
5763 `_ = ((2 * pi * n) ** h DIV (pi * n)) * ((n DIV e) DIV (k DIV e)) ** n` by metis_tac[] >>
5764 `_ = 2 * ((2 * pi * n) ** h DIV (2 * pi * n)) * ((n DIV e) DIV (k DIV e)) ** n` by metis_tac[MULT_ASSOC] >>
5765 `_ = 2 * ((2 * pi * n) ** h DIV (2 * pi * n)) * (n DIV k) ** n` by metis_tac[] >>
5766 `_ = 2 DIV (2 * pi * n) ** h * (n DIV k) ** n` by metis_tac[] >>
5767 `_ = 2 DIV (2 * pi * n) ** h * 2 ** n` by metis_tac[] >>
5768 `_ = (2 * 2 ** n DIV (2 * pi * n) ** h)` by metis_tac[] >>
5769 metis_tac[EXP, ADD1]
5770QED
5771
5772(* ------------------------------------------------------------------------- *)
5773(* Useful theorems for Binomial *)
5774(* ------------------------------------------------------------------------- *)
5775
5776(* Theorem: !k. 0 < k /\ k < n ==> (binomial n k MOD n = 0) <=>
5777 !h. 0 <= h /\ h < PRE n ==> (binomial n (SUC h) MOD n = 0) *)
5778(* Proof: by h = PRE k, or k = SUC h.
5779 If part: put k = SUC h,
5780 then 0 < SUC h ==> 0 <= h,
5781 and SUC h < n ==> PRE (SUC h) = h < PRE n by prim_recTheory.PRE
5782 Only-if part: put h = PRE k,
5783 then 0 <= PRE k ==> 0 < k
5784 and PRE k < PRE n ==> k < n by INV_PRE_LESS
5785*)
5786Theorem binomial_range_shift:
5787 !n . 0 < n ==> ((!k. 0 < k /\ k < n ==> ((binomial n k) MOD n = 0)) <=>
5788 (!h. h < PRE n ==> ((binomial n (SUC h)) MOD n = 0)))
5789Proof
5790 rw_tac std_ss[EQ_IMP_THM] >| [
5791 `0 < SUC h /\ SUC h < n` by decide_tac >>
5792 rw_tac std_ss[],
5793 `k <> 0` by decide_tac >>
5794 `?h. k = SUC h` by metis_tac[num_CASES] >>
5795 `h < PRE n` by decide_tac >>
5796 rw_tac std_ss[]
5797 ]
5798QED
5799
5800(* Theorem: binomial n k MOD n = 0 <=> (binomial n k * x ** (n-k) * y ** k) MOD n = 0 *)
5801(* Proof:
5802 (binomial n k * x ** (n-k) * y ** k) MOD n = 0
5803 <=> (binomial n k * (x ** (n-k) * y ** k)) MOD n = 0 by MULT_ASSOC
5804 <=> (((binomial n k) MOD n) * ((x ** (n - k) * y ** k) MOD n)) MOD n = 0 by MOD_TIMES2
5805 If part, apply 0 * z = 0 by MULT.
5806 Only-if part, pick x = 1, y = 1, apply EXP_1.
5807*)
5808Theorem binomial_mod_zero:
5809 !n. 0 < n ==> !k. (binomial n k MOD n = 0) <=> (!x y. (binomial n k * x ** (n-k) * y ** k) MOD n = 0)
5810Proof
5811 rw_tac std_ss[EQ_IMP_THM] >-
5812 metis_tac[MOD_TIMES2, ZERO_MOD, MULT] >>
5813 metis_tac[EXP_1, MULT_RIGHT_1]
5814QED
5815
5816
5817(* Theorem: (!k. 0 < k /\ k < n ==> (!x y. ((binomial n k * x ** (n - k) * y ** k) MOD n = 0))) <=>
5818 (!h. h < PRE n ==> (!x y. ((binomial n (SUC h) * x ** (n - (SUC h)) * y ** (SUC h)) MOD n = 0))) *)
5819(* Proof: by h = PRE k, or k = SUC h. *)
5820Theorem binomial_range_shift_alt:
5821 !n . 0 < n ==> ((!k. 0 < k /\ k < n ==> (!x y. ((binomial n k * x ** (n - k) * y ** k) MOD n = 0))) <=>
5822 (!h. h < PRE n ==> (!x y. ((binomial n (SUC h) * x ** (n - (SUC h)) * y ** (SUC h)) MOD n = 0))))
5823Proof
5824 rw_tac std_ss[EQ_IMP_THM] >| [
5825 `0 < SUC h /\ SUC h < n` by decide_tac >>
5826 rw_tac std_ss[],
5827 `k <> 0` by decide_tac >>
5828 `?h. k = SUC h` by metis_tac[num_CASES] >>
5829 `h < PRE n` by decide_tac >>
5830 rw_tac std_ss[]
5831 ]
5832QED
5833
5834(* Theorem: !k. 0 < k /\ k < n ==> (binomial n k) MOD n = 0 <=>
5835 !x y. SUM (GENLIST ((\k. (binomial n k * x ** (n - k) * y ** k) MOD n) o SUC) (PRE n)) = 0 *)
5836(* Proof:
5837 !k. 0 < k /\ k < n ==> (binomial n k) MOD n = 0
5838 <=> !k. 0 < k /\ k < n ==> !x y. ((binomial n k * x ** (n - k) * y ** k) MOD n = 0) by binomial_mod_zero
5839 <=> !h. h < PRE n ==> !x y. ((binomial n (SUC h) * x ** (n - (SUC h)) * y ** (SUC h)) MOD n = 0) by binomial_range_shift_alt
5840 <=> !x y. EVERY (\z. z = 0) (GENLIST (\k. (binomial n (SUC k) * x ** (n - (SUC k)) * y ** (SUC k)) MOD n) (PRE n)) by EVERY_GENLIST
5841 <=> !x y. EVERY (\x. x = 0) (GENLIST ((\k. binomial n k * x ** (n - k) * y ** k) o SUC) (PRE n) by FUN_EQ_THM
5842 <=> !x y. SUM (GENLIST ((\k. (binomial n k * x ** (n - k) * y ** k) MOD n) o SUC) (PRE n)) = 0 by SUM_EQ_0
5843*)
5844Theorem binomial_mod_zero_alt:
5845 !n. 0 < n ==> ((!k. 0 < k /\ k < n ==> ((binomial n k) MOD n = 0)) <=>
5846 !x y. SUM (GENLIST ((\k. (binomial n k * x ** (n - k) * y ** k) MOD n) o SUC) (PRE n)) = 0)
5847Proof
5848 rpt strip_tac >>
5849 `!x y. (\k. (binomial n (SUC k) * x ** (n - SUC k) * y ** (SUC k)) MOD n) = (\k. (binomial n k * x ** (n - k) * y ** k) MOD n) o SUC` by rw_tac std_ss[FUN_EQ_THM] >>
5850 `(!k. 0 < k /\ k < n ==> ((binomial n k) MOD n = 0)) <=>
5851 (!k. 0 < k /\ k < n ==> (!x y. ((binomial n k * x ** (n - k) * y ** k) MOD n = 0)))` by rw_tac std_ss[binomial_mod_zero] >>
5852 `_ = (!h. h < PRE n ==> (!x y. ((binomial n (SUC h) * x ** (n - (SUC h)) * y ** (SUC h)) MOD n = 0)))` by rw_tac std_ss[binomial_range_shift_alt] >>
5853 `_ = !x y h. h < PRE n ==> (((binomial n (SUC h) * x ** (n - (SUC h)) * y ** (SUC h)) MOD n = 0))` by metis_tac[] >>
5854 rw_tac std_ss[EVERY_GENLIST, SUM_EQ_0]
5855QED
5856
5857(* ------------------------------------------------------------------------- *)
5858(* Binomial Theorem with prime exponent *)
5859(* ------------------------------------------------------------------------- *)
5860
5861(* Theorem: [Binomial Expansion for prime exponent] (x + y)^p = x^p + y^p (mod p) *)
5862(* Proof:
5863 (x+y)^p (mod p)
5864 = SUM (k=0..p) C(p,k)x^(p-k)y^k (mod p) by binomial theorem
5865 = (C(p,0)x^py^0 + SUM (k=1..(p-1)) C(p,k)x^(p-k)y^k + C(p,p)x^0y^p) (mod p) by breaking sum
5866 = (x^p + SUM (k=1..(p-1)) C(p,k)x^(p-k)y^k + y^k) (mod p) by binomial_n_0, binomial_n_n
5867 = ((x^p mod p) + (SUM (k=1..(p-1)) C(p,k)x^(p-k)y^k) (mod p) + (y^p mod p)) mod p by MOD_PLUS
5868 = ((x^p mod p) + (SUM (k=1..(p-1)) (C(p,k)x^(p-k)y^k) (mod p)) + (y^p mod p)) mod p
5869 = (x^p mod p + 0 + y^p mod p) mod p by prime_iff_divides_binomials
5870 = (x^p + y^p) (mod p) by MOD_PLUS
5871*)
5872Theorem binomial_thm_prime:
5873 !p. prime p ==> (!x y. (x + y) ** p MOD p = (x ** p + y ** p) MOD p)
5874Proof
5875 rpt strip_tac >>
5876 `0 < p` by rw_tac std_ss[PRIME_POS] >>
5877 `!k. 0 < k /\ k < p ==> ((binomial p k) MOD p = 0)` by metis_tac[prime_iff_divides_binomials, DIVIDES_MOD_0] >>
5878 `SUM (GENLIST ((\k. binomial p k * x ** (p - k) * y ** k) o SUC) (PRE p)) MOD p = 0` by metis_tac[SUM_GENLIST_MOD, binomial_mod_zero_alt, ZERO_MOD] >>
5879 `(x + y) ** p MOD p = (x ** p + SUM (GENLIST ((\k. binomial p k * x ** (p - k) * y ** k) o SUC) (PRE p)) + y ** p) MOD p` by rw_tac std_ss[binomial_thm, SUM_DECOMPOSE_FIRST_LAST, binomial_n_0, binomial_n_n, EXP] >>
5880 metis_tac[MOD_PLUS3, ADD_0, MOD_PLUS]
5881QED
5882
5883(* ------------------------------------------------------------------------- *)
5884(* Leibniz Harmonic Triangle Documentation *)
5885(* ------------------------------------------------------------------------- *)
5886(* Type: (# are temp)
5887 triple = <| a: num; b: num; c: num |>
5888# path = :num list
5889 Overloading:
5890 leibniz_vertical n = [1 .. (n+1)]
5891 leibniz_up n = REVERSE (leibniz_vertical n)
5892 leibniz_horizontal n = GENLIST (leibniz n) (n + 1)
5893 binomial_horizontal n = GENLIST (binomial n) (n + 1)
5894# ta = (triplet n k).a
5895# tb = (triplet n k).b
5896# tc = (triplet n k).c
5897 p1 zigzag p2 = leibniz_zigzag p1 p2
5898 p1 wriggle p2 = RTC leibniz_zigzag p1 p2
5899 leibniz_col_arm a b n = MAP (\x. leibniz (a - x) b) [0 ..< n]
5900 leibniz_seg_arm a b n = MAP (\x. leibniz a (b + x)) [0 ..< n]
5901
5902 leibniz_seg n k h = IMAGE (\j. leibniz n (k + j)) (count h)
5903 leibniz_row n h = IMAGE (leibniz n) (count h)
5904 leibniz_col h = IMAGE (\i. leibniz i 0) (count h)
5905 lcm_run n = list_lcm [1 .. n]
5906# beta n k = k * binomial n k
5907# beta_horizontal n = GENLIST (beta n o SUC) n
5908*)
5909(* Definitions and Theorems (# are exported):
5910
5911 Helper Theorems:
5912 RTC_TRANS |- R^* x y /\ R^* y z ==> R^* x z
5913
5914 Leibniz Triangle (Denominator form):
5915# leibniz_def |- !n k. leibniz n k = (n + 1) * binomial n k
5916 leibniz_0_n |- !n. leibniz 0 n = if n = 0 then 1 else 0
5917 leibniz_n_0 |- !n. leibniz n 0 = n + 1
5918 leibniz_n_n |- !n. leibniz n n = n + 1
5919 leibniz_less_0 |- !n k. n < k ==> (leibniz n k = 0)
5920 leibniz_sym |- !n k. k <= n ==> (leibniz n k = leibniz n (n - k))
5921 leibniz_monotone |- !n k. k < HALF n ==> leibniz n k < leibniz n (k + 1)
5922 leibniz_pos |- !n k. k <= n ==> 0 < leibniz n k
5923 leibniz_eq_0 |- !n k. (leibniz n k = 0) <=> n < k
5924 leibniz_alt |- !n. leibniz n = (\j. (n + 1) * j) o binomial n
5925 leibniz_def_alt |- !n k. leibniz n k = (\j. (n + 1) * j) (binomial n k)
5926 leibniz_up_eqn |- !n. 0 < n ==> !k. (n + 1) * leibniz (n - 1) k = (n - k) * leibniz n k
5927 leibniz_up |- !n. 0 < n ==> !k. leibniz (n - 1) k = (n - k) * leibniz n k DIV (n + 1)
5928 leibniz_up_alt |- !n. 0 < n ==> !k. leibniz (n - 1) k = (n - k) * binomial n k
5929 leibniz_right_eqn |- !n. 0 < n ==> !k. (k + 1) * leibniz n (k + 1) = (n - k) * leibniz n k
5930 leibniz_right |- !n. 0 < n ==> !k. leibniz n (k + 1) = (n - k) * leibniz n k DIV (k + 1)
5931 leibniz_property |- !n. 0 < n ==> !k. leibniz n k * leibniz (n - 1) k =
5932 leibniz n (k + 1) * (leibniz n k - leibniz (n - 1) k)
5933 leibniz_formula |- !n k. k <= n ==> (leibniz n k = (n + 1) * FACT n DIV (FACT k * FACT (n - k)))
5934 leibniz_recurrence |- !n. 0 < n ==> !k. k < n ==> (leibniz n (k + 1) = leibniz n k *
5935 leibniz (n - 1) k DIV (leibniz n k - leibniz (n - 1) k))
5936 leibniz_n_k |- !n k. 0 < k /\ k <= n ==> (leibniz n k =
5937 leibniz n (k - 1) * leibniz (n - 1) (k - 1)
5938 DIV (leibniz n (k - 1) - leibniz (n - 1) (k - 1)))
5939 leibniz_lcm_exchange |- !n. 0 < n ==> !k. lcm (leibniz n k) (leibniz (n - 1) k) =
5940 lcm (leibniz n k) (leibniz n (k + 1))
5941 leibniz_middle_lower |- !n. 4 ** n <= leibniz (TWICE n) n
5942
5943 LCM of a list of numbers:
5944# list_lcm_def |- (list_lcm [] = 1) /\ !h t. list_lcm (h::t) = lcm h (list_lcm t)
5945 list_lcm_nil |- list_lcm [] = 1
5946 list_lcm_cons |- !h t. list_lcm (h::t) = lcm h (list_lcm t)
5947 list_lcm_sing |- !x. list_lcm [x] = x
5948 list_lcm_snoc |- !x l. list_lcm (SNOC x l) = lcm x (list_lcm l)
5949 list_lcm_map_times |- !n l. list_lcm (MAP (\k. n * k) l) = if l = [] then 1 else n * list_lcm l
5950 list_lcm_pos |- !l. EVERY_POSITIVE l ==> 0 < list_lcm l
5951 list_lcm_pos_alt |- !l. POSITIVE l ==> 0 < list_lcm l
5952 list_lcm_lower_bound |- !l. EVERY_POSITIVE l ==> SUM l <= LENGTH l * list_lcm l
5953 list_lcm_lower_bound_alt |- !l. POSITIVE l ==> SUM l <= LENGTH l * list_lcm l
5954 list_lcm_is_common_multiple |- !x l. MEM x l ==> x divides (list_lcm l)
5955 list_lcm_is_least_common_multiple |- !l m. (!x. MEM x l ==> x divides m) ==> (list_lcm l) divides m
5956 list_lcm_append |- !l1 l2. list_lcm (l1 ++ l2) = lcm (list_lcm l1) (list_lcm l2)
5957 list_lcm_append_3 |- !l1 l2 l3. list_lcm (l1 ++ l2 ++ l3) = list_lcm [list_lcm l1; list_lcm l2; list_lcm l3]
5958 list_lcm_reverse |- !l. list_lcm (REVERSE l) = list_lcm l
5959 list_lcm_suc |- !n. list_lcm [1 .. n + 1] = lcm (n + 1) (list_lcm [1 .. n])
5960 list_lcm_nonempty_lower |- !l. l <> [] /\ EVERY_POSITIVE l ==> SUM l DIV LENGTH l <= list_lcm l
5961 list_lcm_nonempty_lower_alt |- !l. l <> [] /\ POSITIVE l ==> SUM l DIV LENGTH l <= list_lcm l
5962 list_lcm_divisor_lcm_pair |- !l x y. MEM x l /\ MEM y l ==> lcm x y divides list_lcm l
5963 list_lcm_lower_by_lcm_pair |- !l x y. POSITIVE l /\ MEM x l /\ MEM y l ==> lcm x y <= list_lcm l
5964 list_lcm_upper_by_common_multiple
5965 |- !l m. 0 < m /\ (!x. MEM x l ==> x divides m) ==> list_lcm l <= m
5966 list_lcm_by_FOLDR |- !ls. list_lcm ls = FOLDR lcm 1 ls
5967 list_lcm_by_FOLDL |- !ls. list_lcm ls = FOLDL lcm 1 ls
5968
5969 Lists in Leibniz Triangle:
5970
5971 Veritcal Lists in Leibniz Triangle
5972 leibniz_vertical_alt |- !n. leibniz_vertical n = GENLIST (\i. 1 + i) (n + 1)
5973 leibniz_vertical_0 |- leibniz_vertical 0 = [1]
5974 leibniz_vertical_len |- !n. LENGTH (leibniz_vertical n) = n + 1
5975 leibniz_vertical_not_nil |- !n. leibniz_vertical n <> []
5976 leibniz_vertical_pos |- !n. EVERY_POSITIVE (leibniz_vertical n)
5977 leibniz_vertical_pos_alt |- !n. POSITIVE (leibniz_vertical n)
5978 leibniz_vertical_mem |- !n x. 0 < x /\ x <= n + 1 <=> MEM x (leibniz_vertical n)
5979 leibniz_vertical_snoc |- !n. leibniz_vertical (n + 1) = SNOC (n + 2) (leibniz_vertical n)
5980
5981 leibniz_up_0 |- leibniz_up 0 = [1]
5982 leibniz_up_len |- !n. LENGTH (leibniz_up n) = n + 1
5983 leibniz_up_pos |- !n. EVERY_POSITIVE (leibniz_up n)
5984 leibniz_up_mem |- !n x. 0 < x /\ x <= n + 1 <=> MEM x (leibniz_up n)
5985 leibniz_up_cons |- !n. leibniz_up (n + 1) = n + 2::leibniz_up n
5986
5987 leibniz_horizontal_0 |- leibniz_horizontal 0 = [1]
5988 leibniz_horizontal_len |- !n. LENGTH (leibniz_horizontal n) = n + 1
5989 leibniz_horizontal_el |- !n k. k <= n ==> (EL k (leibniz_horizontal n) = leibniz n k)
5990 leibniz_horizontal_mem |- !n k. k <= n ==> MEM (leibniz n k) (leibniz_horizontal n)
5991 leibniz_horizontal_mem_iff |- !n k. MEM (leibniz n k) (leibniz_horizontal n) <=> k <= n
5992 leibniz_horizontal_member |- !n x. MEM x (leibniz_horizontal n) <=> ?k. k <= n /\ (x = leibniz n k)
5993 leibniz_horizontal_element |- !n k. k <= n ==> (EL k (leibniz_horizontal n) = leibniz n k)
5994 leibniz_horizontal_head |- !n. TAKE 1 (leibniz_horizontal (n + 1)) = [n + 2]
5995 leibniz_horizontal_divisor|- !n k. k <= n ==> leibniz n k divides list_lcm (leibniz_horizontal n)
5996 leibniz_horizontal_pos |- !n. EVERY_POSITIVE (leibniz_horizontal n)
5997 leibniz_horizontal_pos_alt|- !n. POSITIVE (leibniz_horizontal n)
5998 leibniz_horizontal_alt |- !n. leibniz_horizontal n = MAP (\j. (n + 1) * j) (binomial_horizontal n)
5999 leibniz_horizontal_lcm_alt|- !n. list_lcm (leibniz_horizontal n) = (n + 1) * list_lcm (binomial_horizontal n)
6000 leibniz_horizontal_sum |- !n. SUM (leibniz_horizontal n) = (n + 1) * SUM (binomial_horizontal n)
6001 leibniz_horizontal_sum_eqn |- !n. SUM (leibniz_horizontal n) = (n + 1) * 2 ** n:
6002 leibniz_horizontal_average |- !n. SUM (leibniz_horizontal n) DIV LENGTH (leibniz_horizontal n) =
6003 SUM (binomial_horizontal n)
6004 leibniz_horizontal_average_eqn |- !n. SUM (leibniz_horizontal n) DIV LENGTH (leibniz_horizontal n) = 2 ** n
6005
6006 Using Triplet and Paths:
6007 triplet_def |- !n k. triplet n k =
6008 <|a := leibniz n k;
6009 b := leibniz (n + 1) k;
6010 c := leibniz (n + 1) (k + 1)
6011 |>
6012 leibniz_triplet_member |- !n k. (ta = leibniz n k) /\
6013 (tb = leibniz (n + 1) k) /\ (tc = leibniz (n + 1) (k + 1))
6014 leibniz_right_entry |- !n k. (k + 1) * tc = (n + 1 - k) * tb
6015 leibniz_up_entry |- !n k. (n + 2) * ta = (n + 1 - k) * tb
6016 leibniz_triplet_property |- !n k. ta * tb = tc * (tb - ta)
6017 leibniz_triplet_lcm |- !n k. lcm tb ta = lcm tb tc
6018
6019 Zigzag Path in Leibniz Triangle:
6020 leibniz_zigzag_def |- !p1 p2. p1 zigzag p2 <=>
6021 ?n k x y. (p1 = x ++ [tb; ta] ++ y) /\ (p2 = x ++ [tb; tc] ++ y)
6022 list_lcm_zigzag |- !p1 p2. p1 zigzag p2 ==> (list_lcm p1 = list_lcm p2)
6023 leibniz_zigzag_tail |- !p1 p2. p1 zigzag p2 ==> !x. [x] ++ p1 zigzag [x] ++ p2
6024 leibniz_horizontal_zigzag |- !n k. k <= n ==>
6025 TAKE (k + 1) (leibniz_horizontal (n + 1)) ++ DROP k (leibniz_horizontal n) zigzag
6026 TAKE (k + 2) (leibniz_horizontal (n + 1)) ++ DROP (k + 1) (leibniz_horizontal n)
6027 leibniz_triplet_0 |- leibniz_up 1 zigzag leibniz_horizontal 1
6028
6029 Wriggle Paths in Leibniz Triangle:
6030 list_lcm_wriggle |- !p1 p2. p1 wriggle p2 ==> (list_lcm p1 = list_lcm p2)
6031 leibniz_zigzag_wriggle |- !p1 p2. p1 zigzag p2 ==> p1 wriggle p2
6032 leibniz_wriggle_tail |- !p1 p2. p1 wriggle p2 ==> !x. [x] ++ p1 wriggle [x] ++ p2
6033 leibniz_wriggle_refl |- !p1. p1 wriggle p1
6034 leibniz_wriggle_trans |- !p1 p2 p3. p1 wriggle p2 /\ p2 wriggle p3 ==> p1 wriggle p3
6035 leibniz_horizontal_wriggle_step |- !n k. k <= n + 1 ==>
6036 TAKE (k + 1) (leibniz_horizontal (n + 1)) ++ DROP k (leibniz_horizontal n) wriggle leibniz_horizontal (n + 1)
6037 leibniz_horizontal_wriggle |- !n. [leibniz (n + 1) 0] ++ leibniz_horizontal n wriggle leibniz_horizontal (n + 1)
6038
6039 Path Transform keeping LCM:
6040 leibniz_up_wriggle_horizontal |- !n. leibniz_up n wriggle leibniz_horizontal n
6041 leibniz_lcm_property |- !n. list_lcm (leibniz_vertical n) = list_lcm (leibniz_horizontal n)
6042 leibniz_vertical_divisor |- !n k. k <= n ==> leibniz n k divides list_lcm (leibniz_vertical n)
6043
6044 Lower Bound of Leibniz LCM:
6045 leibniz_horizontal_lcm_lower |- !n. 2 ** n <= list_lcm (leibniz_horizontal n)
6046 leibniz_vertical_lcm_lower |- !n. 2 ** n <= list_lcm (leibniz_vertical n)
6047 lcm_lower_bound |- !n. 2 ** n <= list_lcm [1 .. (n + 1)]
6048
6049 Leibniz LCM Invariance:
6050 leibniz_col_arm_0 |- !a b. leibniz_col_arm a b 0 = []
6051 leibniz_seg_arm_0 |- !a b. leibniz_seg_arm a b 0 = []
6052 leibniz_col_arm_1 |- !a b. leibniz_col_arm a b 1 = [leibniz a b]
6053 leibniz_seg_arm_1 |- !a b. leibniz_seg_arm a b 1 = [leibniz a b]
6054 leibniz_col_arm_len |- !a b n. LENGTH (leibniz_col_arm a b n) = n
6055 leibniz_seg_arm_len |- !a b n. LENGTH (leibniz_seg_arm a b n) = n
6056 leibniz_col_arm_el |- !n k. k < n ==> !a b. EL k (leibniz_col_arm a b n) = leibniz (a - k) b
6057 leibniz_seg_arm_el |- !n k. k < n ==> !a b. EL k (leibniz_seg_arm a b n) = leibniz a (b + k)
6058 leibniz_seg_arm_head |- !a b n. TAKE 1 (leibniz_seg_arm a b (n + 1)) = [leibniz a b]
6059 leibniz_col_arm_cons |- !a b n. leibniz_col_arm (a + 1) b (n + 1) = leibniz (a + 1) b::leibniz_col_arm a b n
6060
6061 leibniz_seg_arm_zigzag_step |- !n k. k < n ==> !a b.
6062 TAKE (k + 1) (leibniz_seg_arm (a + 1) b (n + 1)) ++ DROP k (leibniz_seg_arm a b n) zigzag
6063 TAKE (k + 2) (leibniz_seg_arm (a + 1) b (n + 1)) ++ DROP (k + 1) (leibniz_seg_arm a b n)
6064 leibniz_seg_arm_wriggle_step |- !n k. k < n + 1 ==> !a b.
6065 TAKE (k + 1) (leibniz_seg_arm (a + 1) b (n + 1)) ++ DROP k (leibniz_seg_arm a b n) wriggle
6066 leibniz_seg_arm (a + 1) b (n + 1)
6067 leibniz_seg_arm_wriggle_row_arm |- !a b n. [leibniz (a + 1) b] ++ leibniz_seg_arm a b n wriggle
6068 leibniz_seg_arm (a + 1) b (n + 1)
6069 leibniz_col_arm_wriggle_row_arm |- !a b n. b <= a /\ n <= a + 1 - b ==>
6070 leibniz_col_arm a b n wriggle leibniz_seg_arm a b n
6071 leibniz_lcm_invariance |- !a b n. b <= a /\ n <= a + 1 - b ==>
6072 (list_lcm (leibniz_col_arm a b n) = list_lcm (leibniz_seg_arm a b n))
6073 leibniz_col_arm_n_0 |- !n. leibniz_col_arm n 0 (n + 1) = leibniz_up n
6074 leibniz_seg_arm_n_0 |- !n. leibniz_seg_arm n 0 (n + 1) = leibniz_horizontal n
6075 leibniz_up_wriggle_horizontal_alt |- !n. leibniz_up n wriggle leibniz_horizontal n
6076 leibniz_up_lcm_eq_horizontal_lcm |- !n. list_lcm (leibniz_up n) = list_lcm (leibniz_horizontal n)
6077
6078 Set GCD as Big Operator:
6079 big_gcd_def |- !s. big_gcd s = ITSET gcd s 0
6080 big_gcd_empty |- big_gcd {} = 0
6081 big_gcd_sing |- !x. big_gcd {x} = x
6082 big_gcd_reduction |- !s x. FINITE s /\ x NOTIN s ==> (big_gcd (x INSERT s) = gcd x (big_gcd s))
6083 big_gcd_is_common_divisor |- !s. FINITE s ==> !x. x IN s ==> big_gcd s divides x
6084 big_gcd_is_greatest_common_divisor
6085 |- !s. FINITE s ==> !m. (!x. x IN s ==> m divides x) ==> m divides big_gcd s
6086 big_gcd_insert |- !s. FINITE s ==> !x. big_gcd (x INSERT s) = gcd x (big_gcd s)
6087 big_gcd_two |- !x y. big_gcd {x; y} = gcd x y
6088 big_gcd_positive |- !s. FINITE s /\ s <> {} /\ (!x. x IN s ==> 0 < x) ==> 0 < big_gcd s
6089 big_gcd_map_times |- !s. FINITE s /\ s <> {} ==> !k. big_gcd (IMAGE ($* k) s) = k * big_gcd s
6090
6091 Set LCM as Big Operator:
6092 big_lcm_def |- !s. big_lcm s = ITSET lcm s 1
6093 big_lcm_empty |- big_lcm {} = 1
6094 big_lcm_sing |- !x. big_lcm {x} = x
6095 big_lcm_reduction |- !s x. FINITE s /\ x NOTIN s ==> (big_lcm (x INSERT s) = lcm x (big_lcm s))
6096 big_lcm_is_common_multiple |- !s. FINITE s ==> !x. x IN s ==> x divides big_lcm s
6097 big_lcm_is_least_common_multiple
6098 |- !s. FINITE s ==> !m. (!x. x IN s ==> x divides m) ==> big_lcm s divides m
6099 big_lcm_insert |- !s. FINITE s ==> !x. big_lcm (x INSERT s) = lcm x (big_lcm s)
6100 big_lcm_two |- !x y. big_lcm {x; y} = lcm x y
6101 big_lcm_positive |- !s. FINITE s ==> (!x. x IN s ==> 0 < x) ==> 0 < big_lcm s
6102 big_lcm_map_times |- !s. FINITE s /\ s <> {} ==> !k. big_lcm (IMAGE ($* k) s) = k * big_lcm s
6103
6104 LCM Lower bound using big LCM:
6105 leibniz_seg_def |- !n k h. leibniz_seg n k h = {leibniz n (k + j) | j IN count h}
6106 leibniz_row_def |- !n h. leibniz_row n h = {leibniz n j | j IN count h}
6107 leibniz_col_def |- !h. leibniz_col h = {leibniz j 0 | j IN count h}
6108 leibniz_col_eq_natural |- !n. leibniz_col n = natural n
6109 big_lcm_seg_transform |- !n k h. lcm (leibniz (n + 1) k) (big_lcm (leibniz_seg n k h)) =
6110 big_lcm (leibniz_seg (n + 1) k (h + 1))
6111 big_lcm_row_transform |- !n h. lcm (leibniz (n + 1) 0) (big_lcm (leibniz_row n h)) =
6112 big_lcm (leibniz_row (n + 1) (h + 1))
6113 big_lcm_corner_transform |- !n. big_lcm (leibniz_col (n + 1)) = big_lcm (leibniz_row n (n + 1))
6114 big_lcm_count_lower_bound |- !f n. (!x. x IN count (n + 1) ==> 0 < f x) ==>
6115 SUM (GENLIST f (n + 1)) <= (n + 1) * big_lcm (IMAGE f (count (n + 1)))
6116 big_lcm_natural_eqn |- !n. big_lcm (natural (n + 1)) =
6117 (n + 1) * big_lcm (IMAGE (binomial n) (count (n + 1)))
6118 big_lcm_lower_bound |- !n. 2 ** n <= big_lcm (natural (n + 1))
6119 big_lcm_eq_list_lcm |- !l. big_lcm (set l) = list_lcm l
6120
6121 List LCM depends only on its set of elements:
6122 list_lcm_absorption |- !x l. MEM x l ==> (list_lcm (x::l) = list_lcm l)
6123 list_lcm_nub |- !l. list_lcm (nub l) = list_lcm l
6124 list_lcm_nub_eq_if_set_eq |- !l1 l2. (set l1 = set l2) ==> (list_lcm (nub l1) = list_lcm (nub l2))
6125 list_lcm_eq_if_set_eq |- !l1 l2. (set l1 = set l2) ==> (list_lcm l1 = list_lcm l2)
6126
6127 Set LCM by List LCM:
6128 set_lcm_def |- !s. set_lcm s = list_lcm (SET_TO_LIST s)
6129 set_lcm_empty |- set_lcm {} = 1
6130 set_lcm_nonempty |- !s. FINITE s /\ s <> {} ==> (set_lcm s = lcm (CHOICE s) (set_lcm (REST s)))
6131 set_lcm_sing |- !x. set_lcm {x} = x
6132 set_lcm_eq_list_lcm |- !l. set_lcm (set l) = list_lcm l
6133 set_lcm_eq_big_lcm |- !s. FINITE s ==> (set_lcm s = big_lcm s)
6134 set_lcm_insert |- !s. FINITE s ==> !x. set_lcm (x INSERT s) = lcm x (set_lcm s)
6135 set_lcm_is_common_multiple |- !x s. FINITE s /\ x IN s ==> x divides set_lcm s
6136 set_lcm_is_least_common_multiple |- !s m. FINITE s /\ (!x. x IN s ==> x divides m) ==> set_lcm s divides m
6137 pairwise_coprime_prod_set_eq_set_lcm
6138 |- !s. FINITE s /\ PAIRWISE_COPRIME s ==> (set_lcm s = PROD_SET s)
6139 pairwise_coprime_prod_set_divides
6140 |- !s m. FINITE s /\ PAIRWISE_COPRIME s /\
6141 (!x. x IN s ==> x divides m) ==> PROD_SET s divides m
6142
6143 Nair's Trick (direct):
6144 lcm_run_by_FOLDL |- !n. lcm_run n = FOLDL lcm 1 [1 .. n]
6145 lcm_run_by_FOLDR |- !n. lcm_run n = FOLDR lcm 1 [1 .. n]
6146 lcm_run_0 |- lcm_run 0 = 1
6147 lcm_run_1 |- lcm_run 1 = 1
6148 lcm_run_suc |- !n. lcm_run (n + 1) = lcm (n + 1) (lcm_run n)
6149 lcm_run_pos |- !n. 0 < lcm_run n
6150 lcm_run_small |- (lcm_run 2 = 2) /\ (lcm_run 3 = 6) /\ (lcm_run 4 = 12) /\
6151 (lcm_run 5 = 60) /\ (lcm_run 6 = 60) /\ (lcm_run 7 = 420) /\
6152 (lcm_run 8 = 840) /\ (lcm_run 9 = 2520)
6153 lcm_run_divisors |- !n. n + 1 divides lcm_run (n + 1) /\ lcm_run n divides lcm_run (n + 1)
6154 lcm_run_monotone |- !n. lcm_run n <= lcm_run (n + 1)
6155 lcm_run_lower |- !n. 2 ** n <= lcm_run (n + 1)
6156 lcm_run_leibniz_divisor |- !n k. k <= n ==> leibniz n k divides lcm_run (n + 1)
6157 lcm_run_lower_odd |- !n. n * 4 ** n <= lcm_run (TWICE n + 1)
6158 lcm_run_lower_even |- !n. n * 4 ** n <= lcm_run (TWICE (n + 1))
6159
6160 lcm_run_odd_lower |- !n. ODD n ==> HALF n * HALF (2 ** n) <= lcm_run n
6161 lcm_run_even_lower |- !n. EVEN n ==> HALF (n - 2) * HALF (HALF (2 ** n)) <= lcm_run n
6162 lcm_run_odd_lower_alt |- !n. ODD n /\ 5 <= n ==> 2 ** n <= lcm_run n
6163 lcm_run_even_lower_alt |- !n. EVEN n /\ 8 <= n ==> 2 ** n <= lcm_run n
6164 lcm_run_lower_better |- !n. 7 <= n ==> 2 ** n <= lcm_run n
6165
6166 Nair's Trick (rework):
6167 lcm_run_odd_factor |- !n. 0 < n ==> n * leibniz (TWICE n) n divides lcm_run (TWICE n + 1)
6168 lcm_run_lower_odd |- !n. n * 4 ** n <= lcm_run (TWICE n + 1)
6169 lcm_run_lower_odd_iff |- !n. ODD n ==> (2 ** n <= lcm_run n <=> 5 <= n)
6170 lcm_run_lower_even_iff |- !n. EVEN n ==> (2 ** n <= lcm_run n <=> (n = 0) \/ 8 <= n)
6171 lcm_run_lower_better_iff |- !n. 2 ** n <= lcm_run n <=> (n = 0) \/ (n = 5) \/ 7 <= n
6172
6173 Nair's Trick (consecutive):
6174 lcm_upto_def |- (lcm_upto 0 = 1) /\ !n. lcm_upto (SUC n) = lcm (SUC n) (lcm_upto n)
6175 lcm_upto_0 |- lcm_upto 0 = 1
6176 lcm_upto_SUC |- !n. lcm_upto (SUC n) = lcm (SUC n) (lcm_upto n)
6177 lcm_upto_alt |- (lcm_upto 0 = 1) /\ !n. lcm_upto (n + 1) = lcm (n + 1) (lcm_upto n)
6178 lcm_upto_1 |- lcm_upto 1 = 1
6179 lcm_upto_small |- (lcm_upto 2 = 2) /\ (lcm_upto 3 = 6) /\ (lcm_upto 4 = 12) /\
6180 (lcm_upto 5 = 60) /\ (lcm_upto 6 = 60) /\ (lcm_upto 7 = 420) /\
6181 (lcm_upto 8 = 840) /\ (lcm_upto 9 = 2520) /\ (lcm_upto 10 = 2520)
6182 lcm_upto_eq_list_lcm |- !n. lcm_upto n = list_lcm [1 .. n]
6183 lcm_upto_lower |- !n. 2 ** n <= lcm_upto (n + 1)
6184 lcm_upto_divisors |- !n. n + 1 divides lcm_upto (n + 1) /\ lcm_upto n divides lcm_upto (n + 1)
6185 lcm_upto_monotone |- !n. lcm_upto n <= lcm_upto (n + 1)
6186 lcm_upto_leibniz_divisor |- !n k. k <= n ==> leibniz n k divides lcm_upto (n + 1)
6187 lcm_upto_lower_odd |- !n. n * 4 ** n <= lcm_upto (TWICE n + 1)
6188 lcm_upto_lower_even |- !n. n * 4 ** n <= lcm_upto (TWICE (n + 1))
6189 lcm_upto_lower_better |- !n. 7 <= n ==> 2 ** n <= lcm_upto n
6190
6191 Simple LCM lower bounds:
6192 lcm_run_lower_simple |- !n. HALF (n + 1) <= lcm_run n
6193 lcm_run_alt |- !n. lcm_run n = lcm_run (n - 1 + 1)
6194 lcm_run_lower_good |- !n. 2 ** (n - 1) <= lcm_run n
6195
6196 Upper Bound by Leibniz Triangle:
6197 leibniz_eqn |- !n k. leibniz n k = (n + 1 - k) * binomial (n + 1) k
6198 leibniz_right_alt |- !n k. leibniz n (k + 1) = (n - k) * binomial (n + 1) (k + 1)
6199 leibniz_binomial_identity |- !m n k. k <= m /\ m <= n ==>
6200 (leibniz n k * binomial (n - k) (m - k) = leibniz m k * binomial (n + 1) (m + 1))
6201 leibniz_divides_leibniz_factor |- !m n k. k <= m /\ m <= n ==>
6202 leibniz n k divides leibniz m k * binomial (n + 1) (m + 1)
6203 leibniz_horizontal_member_divides |- !m n x. n <= TWICE m + 1 /\ m <= n /\
6204 MEM x (leibniz_horizontal n) ==>
6205 x divides list_lcm (leibniz_horizontal m) * binomial (n + 1) (m + 1)
6206 lcm_run_divides_property |- !m n. n <= TWICE m /\ m <= n ==>
6207 lcm_run n divides lcm_run m * binomial n m
6208 lcm_run_bound_recurrence |- !m n. n <= TWICE m /\ m <= n ==> lcm_run n <= lcm_run m * binomial n m
6209 lcm_run_upper_bound |- !n. lcm_run n <= 4 ** n
6210
6211 Beta Triangle:
6212 beta_0_n |- !n. beta 0 n = 0
6213 beta_n_0 |- !n. beta n 0 = 0
6214 beta_less_0 |- !n k. n < k ==> (beta n k = 0)
6215 beta_eqn |- !n k. beta (n + 1) (k + 1) = leibniz n k
6216 beta_alt |- !n k. 0 < n /\ 0 < k ==> (beta n k = leibniz (n - 1) (k - 1))
6217 beta_pos |- !n k. 0 < k /\ k <= n ==> 0 < beta n k
6218 beta_eq_0 |- !n k. (beta n k = 0) <=> (k = 0) \/ n < k
6219 beta_sym |- !n k. k <= n ==> (beta n k = beta n (n - k + 1))
6220
6221 Beta Horizontal List:
6222 beta_horizontal_0 |- beta_horizontal 0 = []
6223 beta_horizontal_len |- !n. LENGTH (beta_horizontal n) = n
6224 beta_horizontal_eqn |- !n. beta_horizontal (n + 1) = leibniz_horizontal n
6225 beta_horizontal_alt |- !n. 0 < n ==> (beta_horizontal n = leibniz_horizontal (n - 1))
6226 beta_horizontal_mem |- !n k. 0 < k /\ k <= n ==> MEM (beta n k) (beta_horizontal n)
6227 beta_horizontal_mem_iff |- !n k. MEM (beta n k) (beta_horizontal n) <=> 0 < k /\ k <= n
6228 beta_horizontal_member |- !n x. MEM x (beta_horizontal n) <=> ?k. 0 < k /\ k <= n /\ (x = beta n k)
6229 beta_horizontal_element |- !n k. k < n ==> (EL k (beta_horizontal n) = beta n (k + 1))
6230 lcm_run_by_beta_horizontal |- !n. 0 < n ==> (lcm_run n = list_lcm (beta_horizontal n))
6231 lcm_run_beta_divisor |- !n k. 0 < k /\ k <= n ==> beta n k divides lcm_run n
6232 beta_divides_beta_factor |- !m n k. k <= m /\ m <= n ==> beta n k divides beta m k * binomial n m
6233 lcm_run_divides_property_alt |- !m n. n <= TWICE m /\ m <= n ==> lcm_run n divides binomial n m * lcm_run m
6234 lcm_run_upper_bound |- !n. lcm_run n <= 4 ** n
6235
6236 LCM Lower Bound using Maximum:
6237 list_lcm_ge_max |- !l. POSITIVE l ==> MAX_LIST l <= list_lcm l
6238 lcm_lower_bound_by_list_lcm |- !n. (n + 1) * binomial n (HALF n) <= list_lcm [1 .. (n + 1)]
6239 big_lcm_ge_max |- !s. FINITE s /\ (!x. x IN s ==> 0 < x) ==> MAX_SET s <= big_lcm s
6240 lcm_lower_bound_by_big_lcm |- !n. (n + 1) * binomial n (HALF n) <= big_lcm (natural (n + 1))
6241
6242 Consecutive LCM function:
6243 lcm_lower_bound_by_list_lcm_stirling |- Stirling /\ (!n c. n DIV SQRT (c * (n - 1)) = SQRT (n DIV c)) ==>
6244 !n. ODD n ==> SQRT (n DIV (2 * pi)) * 2 ** n <= list_lcm [1 .. n]
6245 big_lcm_non_decreasing |- !n. big_lcm (natural n) <= big_lcm (natural (n + 1))
6246 lcm_lower_bound_by_big_lcm_stirling |- Stirling /\ (!n c. n DIV SQRT (c * (n - 1)) = SQRT (n DIV c)) ==>
6247 !n. ODD n ==> SQRT (n DIV (2 * pi)) * 2 ** n <= big_lcm (natural n)
6248
6249 Extra Theorems:
6250 gcd_prime_product_property |- !p m n. prime p /\ m divides n /\ ~(p * m divides n) ==> (gcd (p * m) n = m)
6251 lcm_prime_product_property |- !p m n. prime p /\ m divides n /\ ~(p * m divides n) ==> (lcm (p * m) n = p * n)
6252 list_lcm_prime_factor |- !p l. prime p /\ p divides list_lcm l ==> p divides PROD_SET (set l)
6253 list_lcm_prime_factor_member |- !p l. prime p /\ p divides list_lcm l ==> ?x. MEM x l /\ p divides x
6254
6255*)
6256
6257(* ------------------------------------------------------------------------- *)
6258(* Leibniz Harmonic Triangle *)
6259(* ------------------------------------------------------------------------- *)
6260
6261(*
6262
6263Leibniz Harmonic Triangle (fraction form)
6264
6265 c <= r
6266r = 1 1
6267r = 2 1/2 1/2
6268r = 3 1/3 1/6 1/3
6269r = 4 1/4 1/12 1/12 1/4
6270r = 5 1/5 1/10 1/20 1/10 1/5
6271
6272In general, L(r,1) = 1/r, L(r,c) = |L(r-1,c-1) - L(r,c-1)|
6273
6274Solving, L(r,c) = 1/(r C(r-1,c-1)) = 1/(c C(r,c))
6275where C(n,m) is the binomial coefficient of Pascal Triangle.
6276
6277c = 1 are the 1/(1 * natural numbers
6278c = 2 are the 1/(2 * triangular numbers)
6279c = 3 are the 1/(3 * tetrahedral numbers)
6280
6281Sum of denominators of n-th row = n 2**(n-1).
6282
6283Note that L(r,c) = Integral(0,1) x ** (c-1) * (1-x) ** (r-c) dx
6284
6285Another form: L(n,1) = 1/n, L(n,k) = L(n-1,k-1) - L(n,k-1)
6286Solving, L(n,k) = 1/ k C(n,k) = 1/ n C(n-1,k-1)
6287
6288Still another notation H(n,r) = 1/ (n+1)C(n,r) = (n-r)!r!/(n+1)! for 0 <= r <= n
6289
6290Harmonic Denominator Number Triangle (integer form)
6291g(d,n) = 1/H(d,n) where H(d,h) is the Leibniz Harmonic Triangle
6292g(d,n) = (n+d)C(d,n) where C(d,h) is the Pascal's Triangle.
6293g(d,n) = n(n+1)...(n+d)/d!
6294
6295(k+1)-th row of Pascal's triangle: x^4 + 4x^3 + 6x^2 + 4x + 1
6296Perform differentiation, d/dx -> 4x^3 + 12x^2 + 12x + 4
6297which is k-th row of Harmonic Denominator Number Triangle.
6298
6299(k+1)-th row of Pascal's triangle: (x+1)^(k+1)
6300k-th row of Harmonic Denominator Number Triangle: d/dx[(x+1)^(k+1)]
6301
6302 d/dx[(x+1)^(k+1)]
6303= d/dx[SUM C(k+1,j) x^j] j = 0...(k+1)
6304= SUM C(k+1,j) d/dx[x^j]
6305= SUM C(k+1,j) j x^(j-1) j = 1...(k+1)
6306= SUM C(k+1,j+1) (j+1) x^j j = 0...k
6307= SUM D(k,j) x^j with D(k,j) = (j+1) C(k+1,j+1) ???
6308
6309*)
6310
6311(* Another presentation of triangles:
6312
6313The harmonic triangle of Leibniz
6314 1/1 1/2 1/3 1/4 1/5 .... harmonic fractions
6315 1/2 1/6 1/12 1/20 .... successive difference
6316 1/3 1/12 1/30 ...
6317 1/4 1/20 ... ...
6318 1/5 ... ... ...
6319
6320Pascal's triangle
6321 1 1 1 1 1 1 1 .... units
6322 1 2 3 4 5 6 .... sum left and above
6323 1 3 6 10 15 21
6324 1 4 10 20 35
6325 1 5 15 35
6326 1 6 21
6327
6328
6329*)
6330
6331(* LCM Lemma
6332
6333(n+1) lcm (C(n,0) to C(n,n)) = lcm (1 to (n+1))
6334
6335m-th number in the n-th row of Leibniz triangle is: 1/ (n+1)C(n,m)
6336
6337LHS = (n+1) LCM (C(n,0), C(n,1), ..., C(n,n)) = lcd of fractions in n-th row of Leibniz triangle.
6338
6339Any such number is an integer linear combination of fractions on triangle’s sides
63401/1, 1/2, 1/3, ... 1/n, and vice versa.
6341
6342So LHS = lcd (1/1, 1/2, 1/3, ..., 1/n) = RHS = lcm (1,2,3, ..., (n+1)).
6343
63440-th row: 1
63451-st row: 1/2 1/2
63462-nd row: 1/3 1/6 1/3
63473-rd row: 1/4 1/12 1/12 1/4
63484-th row: 1/5 1/20 1/30 1/20 1/5
6349
63504-th row: 1/5 C(4,m), C(4,m) = 1 4 6 4 1, hence 1/5 1/20 1/30 1/20 1/5
6351 lcd (1/5 1/20 1/30 1/20 1/5)
6352= lcm (5, 20, 30, 20, 5)
6353= lcm (5 C(4,0), 5 C(4,1), 5 C(4,2), 5 C(4,3), 5 C(4,4))
6354= 5 lcm (C(4,0), C(4,1), C(4,2), C(4,3), C(4,4))
6355
6356But 1/5 = harmonic
6357 1/20 = 1/4 - 1/5 = combination of harmonic
6358 1/30 = 1/12 - 1/20 = (1/3 - 1/4) - (1/4 - 1/5) = combination of harmonic
6359
6360 lcd (1/5 1/20 1/30 1/20 1/5)
6361= lcd (combination of harmonic from 1/1 to 1/5)
6362= lcd (1/1 to 1/5)
6363= lcm (1 to 5)
6364
6365Theorem: lcd (1/x 1/y 1/z) = lcm (x y z)
6366Theorem: lcm (kx ky kz) = k lcm (x y z)
6367Theorem: lcd (combination of harmonic from 1/1 to 1/n) = lcd (1/1 to 1/n)
6368Then apply first theorem, lcd (1/1 to 1/n) = lcm (1 to n)
6369*)
6370
6371(* LCM Bound
6372 0 < n ==> 2^(n-1) < lcm (1 to n)
6373
6374 lcm (1 to n)
6375= n lcm (C(n-1,0) to C(n-1,n-1)) by LCM Lemma
6376>= n max (0 <= j <= n-1) C(n-1,j)
6377>= SUM (0 <= j <= n-1) C(n-1,j)
6378= 2^(n-1)
6379
6380 lcm (1 to 5)
6381= 5 lcm (C(4,0), C(4,1), C(4,2), C(4,3), C(4,4))
6382
6383
6384>= C(4,0) + C(4,1) + C(4,2) + C(4,3) + C(4,4)
6385= (1 + 1)^4
6386= 2^4
6387
6388 lcm (1 to 5) = 1x2x3x4x5/2 = 60
6389= 5 lcm (1 4 6 4 1) = 5 x 12
6390= lcm (1 4 6 4 1) --> unfold 5x to add 5 times
6391 + lcm (1 4 6 4 1)
6392 + lcm (1 4 6 4 1)
6393 + lcm (1 4 6 4 1)
6394 + lcm (1 4 6 4 1)
6395>= 1 + 4 + 6 + 4 + 1 --> pick one of each 5 C(n,m), i.e. diagonal
6396= (1 + 1)^4 --> fold back binomial
6397= 2^4 = 16
6398
6399Actually, can take 5 lcm (1 4 6 4 1) >= 5 x 6 = 30,
6400but this will need estimation of C(n, n/2), or C(2n,n), involving Stirling's formula.
6401
6402Theorem: lcm (x y z) >= x or lcm (x y z) >= y or lcm (x y z) >= z
6403
6404*)
6405
6406(*
6407
6408More generally, there is an identity for 0 <= k <= n:
6409
6410(n+1) lcm (C(n,0), C(n,1), ..., C(n,k)) = lcm (n+1, n, n-1, ..., n+1-k)
6411
6412This is simply that fact that any integer linear combination of
6413f(x), delta f(x), delta^2 f(x), ..., delta^k f(x)
6414is an integer linear combination of f(x), f(x-1), f(x-2), ..., f(x-k)
6415where delta is the difference operator, f(x) = 1/x, and x = n+1.
6416
6417BTW, Leibnitz harmonic triangle too gives this identity.
6418
6419That's correct, but the use of absolute values in the Leibniz triangle and
6420its specialized definition somewhat obscures the generic, linear nature of the identity.
6421
6422 f(x) = f(n+1) = 1/(n+1)
6423f(x-1) = f(n) = 1/n
6424f(x-2) = f(n-1) = 1/(n-1)
6425f(x-k) = f(n+1-k) = 1/(n+1-k)
6426
6427 f(x) = f(n+1) = 1/(n+1) = 1/(n+1)C(n,0)
6428 delta f(x) = f(x-1) - f(x) = 1/n - 1/(n+1) = 1/n(n+1) = 1/(n+1)C(n,1)
6429 = C(1,0) f(x-1) - C(1,1) f(x)
6430delta^2 f(x) = delta f(x-1) - delta f(x) = 1/(n-1)n - 1/n(n+1)
6431 = (n(n+1) - n(n-1))/(n)(n+1)(n)(n-1)
6432 = 2n/n(n+1)n(n-1) = 1/(n+1)(n(n-1)/2) = 1/(n+1)C(n,2)
6433delta^2 f(x) = delta f(x-1) - delta f(x)
6434 = (f(x-2) - f(x-1)) - (f(x-1) - f(x))
6435 = f(x-2) - 2 f(x-1) + f(x)
6436 = C(2,0) f(x-2) - C(2,1) f(x-1) + C(2,2) f(x)
6437delta^3 f(x) = delta^2 f(x-1) - delta^2 f(x)
6438 = (f(x-3) - 2 f(x-2) + f(x-1)) - (f(x-2) - 2 f(x-1) + f(x))
6439 = f(x-3) - 3 f(x-2) + 3 f(x-1) - f(x)
6440 = C(3,0) f(x-3) - C(3,1) f(x-2) + C(3,2) f(x-2) - C(3,3) f(x)
6441
6442delta^k f(x) = C(k,0) f(x-k) - C(k,1) f(x-k+1) + ... + (-1)^k C(k,k) f(x)
6443 = SUM(0 <= j <= k) (-1)^k C(k,j) f(x-k+j)
6444Also,
6445 f(x) = 1/(n+1)C(n,0)
6446 delta f(x) = 1/(n+1)C(n,1)
6447delta^2 f(x) = 1/(n+1)C(n,2)
6448delta^k f(x) = 1/(n+1)C(n,k)
6449
6450so lcd (f(x), df(x), d^2f(x), ..., d^kf(x))
6451 = lcm ((n+1)C(n,0),(n+1)C(n,1),...,(n+1)C(n,k)) by lcd-to-lcm
6452 = lcd (f(x), f(x-1), f(x-2), ..., f(x-k)) by linear combination
6453 = lcm ((n+1), n, (n-1), ..., (n+1-k)) by lcd-to-lcm
6454
6455How to formalize:
6456lcd (f(x), df(x), d^2f(x), ..., d^kf(x)) = lcd (f(x), f(x-1), f(x-2), ..., f(x-k))
6457
6458Simple case: lcd (f(x), df(x)) = lcd (f(x), f(x-1))
6459
6460 lcd (f(x), df(x))
6461= lcd (f(x), f(x-1) - f(x))
6462= lcd (f(x), f(x-1))
6463
6464Can we have
6465 LCD {f(x), df(x)}
6466= LCD {f(x), f(x-1) - f(x)} = LCD {1/x, 1/(x-1) - 1/x}
6467= LCD {f(x), f(x-1), f(x)} = lcm {x, x(x-1)}
6468= LCD {f(x), f(x-1)} = x(x-1) = lcm {x, x-1} = LCD {1/x, 1/(x-1)}
6469
6470*)
6471
6472(* Step 1: From Pascal's Triangle to Leibniz's Triangle
6473
6474Pascal's Triangle:
6475
6476row 0 1
6477row 1 1 1
6478row 2 1 2 1
6479row 3 1 3 3 1
6480row 4 1 4 6 4 1
6481row 5 1 5 10 10 5 1
6482
6483The rule is: boundary = 1, entry = up + left-up
6484 or: C(n,0) = 1, C(n,k) = C(n-1,k) + C(n-1,k-1)
6485
6486Multiple each row by successor of its index, i.e. row n -> (n + 1) (row n):
6487Multiples Triangle (or Modified Triangle):
6488
64891 * row 0 1
64902 * row 1 2 2
64913 * row 2 3 6 3
64924 * row 3 4 12 12 4
64935 * row 4 5 20 30 20 5
64946 * row 5 6 30 60 60 30 6
6495
6496The rule is: boundary = n, entry = left * left-up / (left - left-up)
6497 or: L(n,0) = n, L(n,k) = L(n,k-1) * L(n-1,k-1) / (L(n,k-1) - L(n-1,k-1))
6498
6499Then lcm(1, 2)
6500 = lcm(2)
6501 = lcm(2, 2)
6502
6503 lcm(1, 2, 3)
6504 = lcm(lcm(1,2), 3) using lcm(1,2,...,n,n+1) = lcm(lcm(1,2,...,n), n+1)
6505 = lcm(2, 3) using lcm(1,2)
6506 = lcm(2*3/1, 3) using lcm(L(n,k-1), L(n-1,k-1)) = lcm(L(n,k-1), L(n-1,k-1)/(L(n,k-1), L(n-1,k-1)), L(n-1,k-1))
6507 = lcm(6, 3)
6508 = lcm(3, 6, 3)
6509
6510 lcm(1, 2, 3, 4)
6511 = lcm(lcm(1,2,3), 4)
6512 = lcm(lcm(6,3), 4)
6513 = lcm(6, 3, 4)
6514 = lcm(6, 3*4/1, 4)
6515 = lcm(6, 12, 4)
6516 = lcm(6*12/6, 12, 4)
6517 = lcm(12, 12, 4)
6518 = lcm(4, 12, 12, 4)
6519
6520 lcm(1, 2, 3, 4, 5)
6521 = lcm(lcm(2,3,4), 5)
6522 = lcm(lcm(12,4), 5)
6523 = lcm(12, 4, 5)
6524 = lcm(12, 4*5/1, 5)
6525 = lcm(12, 20, 5)
6526 = lcm(12*20/8, 20, 5)
6527 = lcm(30, 20, 5)
6528 = lcm(5, 20, 30, 20, 5)
6529
6530 lcm(1, 2, 3, 4, 5, 6)
6531 = lcm(lcm(1, 2, 3, 4, 5), 6)
6532 = lcm(lcm(30,20,5), 6)
6533 = lcm(30, 20, 5, 6)
6534 = lcm(30, 20, 5*6/1, 6)
6535 = lcm(30, 20, 30, 6)
6536 = lcm(30, 20*30/10, 30, 6)
6537 = lcm(20, 60, 30, 6)
6538 = lcm(20*60/40, 60, 30, 6)
6539 = lcm(30, 60, 30, 6)
6540 = lcm(6, 30, 60, 30, 6)
6541
6542Invert each entry of Multiples Triangle into a unit fraction:
6543Leibniz's Triangle:
6544
65451/(1 * row 0) 1/1
65461/(2 * row 1) 1/2 1/2
65471/(3 * row 2) 1/3 1/6 1/3
65481/(4 * row 3) 1/4 1/12 1/12 1/4
65491/(5 * row 4) 1/5 1/20 1/30 1/20 1/5
65501/(6 * row 5) 1/6 1/30 1/60 1/60 1/30 1/6
6551
6552Theorem: In the Multiples Triangle, the vertical-lcm = horizontal-lcm.
6553i.e. lcm (1, 2, 3) = lcm (3, 6, 3) = 6
6554 lcm (1, 2, 3, 4) = lcm (4, 12, 12, 4) = 12
6555 lcm (1, 2, 3, 4, 5) = lcm (5, 20, 30, 20, 5) = 60
6556 lcm (1, 2, 3, 4, 5, 6) = lcm (6, 30, 60, 60, 30, 6) = 60
6557Proof: With reference to Leibniz's Triangle, note: term = left-up - left
6558 lcm (5, 20, 30, 20, 5)
6559= lcm (5, 20, 30) by reduce repetition
6560= lcm (5, d(1/20), d(1/30)) by denominator of fraction
6561= lcm (5, d(1/4 - 1/5), d(1/30)) by term = left-up - left
6562= lcm (5, lcm(4, 5), d(1/12 - 1/20)) by denominator of fraction subtraction
6563= lcm (5, 4, lcm(12, 20)) by lcm (a, lcm (a, b)) = lcm (a, b)
6564= lcm (5, 4, lcm(d(1/12), d(1/20))) to fraction again
6565= lcm (5, 4, lcm(d(1/3 - 1/4), d(1/4 - 1/5))) by Leibniz's Triangle
6566= lcm (5, 4, lcm(lcm(3,4), lcm(4,5))) by fraction subtraction denominator
6567= lcm (5, 4, lcm(3, 4, 5)) by lcm merge
6568= lcm (5, 4, 3) merge again
6569= lcm (5, 4, 3, 2) by lcm include factor (!!!)
6570= lcm (5, 4, 3, 2, 1) by lcm include 1
6571
6572Note: to make 30, need 12, 20
6573 to make 12, need 3, 4; to make 20, need 4, 5
6574 lcm (1, 2, 3, 4, 5)
6575= lcm (1, 2, lcm(3,4), lcm(4,5), 5)
6576= lcm (1, 2, d(1/3 - 1/4), d(1/4 - 1/5), 5)
6577= lcm (1, 2, d(1/12), d(1/20), 5)
6578= lcm (1, 2, 12, 20, 5)
6579= lcm (1, 2, lcm(12, 20), 20, 5)
6580= lcm (1, 2, d(1/12 - 1/20), 20, 5)
6581= lcm (1, 2, d(1/30), 20, 5)
6582= lcm (1, 2, 30, 20, 5)
6583= lcm (1, 30, 20, 5) can drop factor !!
6584= lcm (30, 20, 5) can drop 1
6585= lcm (5, 20, 30, 20, 5)
6586
6587 lcm (1, 2, 3, 4, 5, 6)
6588= lcm (lcm (1, 2, 3, 4, 5), lcm(5,6), 6)
6589= lcm (lcm (5, 20, 30, 20, 5), d(1/5 - 1/6), 6)
6590= lcm (lcm (5, 20, 30, 20, 5), d(1/30), 6)
6591= lcm (lcm (5, 20, 30, 20, 5), 30, 6)
6592= lcm (lcm (5, 20, 30, 20, 5), 30, 6)
6593= lcm (5, 30, 20, 6)
6594= lcm (30, 20, 6) can drop factor !!
6595= lcm (lcm(20, 30), 30, 6)
6596= lcm (d(1/20 - 1/30), 30, 6)
6597= lcm (d(1/60), 30, 6)
6598= lcm (60, 30, 6)
6599= lcm (6, 30, 60, 30, 6)
6600
6601 lcm (1, 2)
6602= lcm (lcm(1,2), 2)
6603= lcm (2, 2)
6604
6605 lcm (1, 2, 3)
6606= lcm (lcm(1, 2), 3)
6607= lcm (2, 3) --> lcm (2x3/(3-2), 3) = lcm (6, 3)
6608= lcm (lcm(2, 3), 3) --> lcm (6, 3) = lcm (3, 6, 3)
6609= lcm (d(1/2 - 1/3), 3)
6610= lcm (d(1/6), 3)
6611= lcm (6, 3) = lcm (3, 6, 3)
6612
6613 lcm (1, 2, 3, 4)
6614= lcm (lcm(1, 2, 3), 4)
6615= lcm (lcm(6, 3), 4)
6616= lcm (6, 3, 4)
6617= lcm (6, lcm(3, 4), 4) --> lcm (6, 12, 4) = lcm (6x12/(12-6), 12, 4)
6618= lcm (6, d(1/3 - 1/4), 4) = lcm (12, 12, 4) = lcm (4, 12, 12, 4)
6619= lcm (6, d(1/12), 4)
6620= lcm (6, 12, 4)
6621= lcm (lcm(6, 12), 4)
6622= lcm (d(1/6 - 1/12), 4)
6623= lcm (d(1/12), 4)
6624= lcm (12, 4) = lcm (4, 12, 12, 4)
6625
6626 lcm (1, 2, 3, 4, 5)
6627= lcm (lcm(1, 2, 3, 4), 5)
6628= lcm (lcm(12, 4), 5)
6629= lcm (12, 4, 5)
6630= lcm (12, lcm(4,5), 5) --> lcm (12, 20, 5) = lcm (12x20/(20-12), 20, 5)
6631= lcm (12, d(1/4 - 1/5), 5) = lcm (240/8, 20, 5) but lcm(12,20) != 30
6632= lcm (12, d(1/20), 5) = lcm (30, 20, 5) use lcm(a,b,c) = lcm(ab/(b-a), b, c)
6633= lcm (12, 20, 5)
6634= lcm (lcm(12,20), 20, 5)
6635= lcm (d(1/12 - 1/20), 20, 5)
6636= lcm (d(1/30), 20, 5)
6637= lcm (30, 20, 5) = lcm (5, 20, 30, 20, 5)
6638
6639 lcm (1, 2, 3, 4, 5, 6)
6640= lcm (lcm(1, 2, 3, 4, 5), 6)
6641= lcm (lcm(30, 20, 5), 6)
6642= lcm (30, 20, 5, 6)
6643= lcm (30, 20, lcm(5,6), 6) --> lcm (30, 20, 30, 6) = lcm (30, 20x30/(30-20), 30, 6)
6644= lcm (30, 20, d(1/5 - 1/6), 6) = lcm (30, 60, 30, 6)
6645= lcm (30, 20, d(1/30), 6) = lcm (30x60/(60-30), 60, 30, 6)
6646= lcm (30, 20, 30, 6) = lcm (60, 60, 30, 6)
6647= lcm (30, lcm(20,30), 30, 6)
6648= lcm (30, d(1/20 - 1/30), 30, 6)
6649= lcm (30, d(1/60), 30, 6)
6650= lcm (30, 60, 30, 6)
6651= lcm (lcm(30, 60), 60, 30, 6)
6652= lcm (d(1/30 - 1/60), 60, 30, 6)
6653= lcm (d(1/60), 60, 30, 6)
6654= lcm (60, 60, 30, 6)
6655= lcm (60, 30, 6) = lcm (6, 30, 60, 60, 30, 6)
6656
6657*)
6658
6659(* ------------------------------------------------------------------------- *)
6660(* Leibniz Triangle (Denominator form) *)
6661(* ------------------------------------------------------------------------- *)
6662
6663(* Define Leibniz Triangle *)
6664Definition leibniz_def[simp]:
6665 leibniz n k = (n + 1) * binomial n k
6666End
6667
6668
6669(* Theorem: leibniz 0 n = if n = 0 then 1 else 0 *)
6670(* Proof:
6671 leibniz 0 n
6672 = (0 + 1) * binomial 0 n by leibniz_def
6673 = if n = 0 then 1 else 0 by binomial_n_0
6674*)
6675Theorem leibniz_0_n:
6676 !n. leibniz 0 n = if n = 0 then 1 else 0
6677Proof
6678 rw[binomial_0_n]
6679QED
6680
6681(* Theorem: leibniz n 0 = n + 1 *)
6682(* Proof:
6683 leibniz n 0
6684 = (n + 1) * binomial n 0 by leibniz_def
6685 = (n + 1) * 1 by binomial_n_0
6686 = n + 1
6687*)
6688Theorem leibniz_n_0:
6689 !n. leibniz n 0 = n + 1
6690Proof
6691 rw[binomial_n_0]
6692QED
6693
6694(* Theorem: leibniz n n = n + 1 *)
6695(* Proof:
6696 leibniz n n
6697 = (n + 1) * binomial n n by leibniz_def
6698 = (n + 1) * 1 by binomial_n_n
6699 = n + 1
6700*)
6701Theorem leibniz_n_n:
6702 !n. leibniz n n = n + 1
6703Proof
6704 rw[binomial_n_n]
6705QED
6706
6707(* Theorem: n < k ==> leibniz n k = 0 *)
6708(* Proof:
6709 leibniz n k
6710 = (n + 1) * binomial n k by leibniz_def
6711 = (n + 1) * 0 by binomial_less_0
6712 = 0
6713*)
6714Theorem leibniz_less_0:
6715 !n k. n < k ==> (leibniz n k = 0)
6716Proof
6717 rw[binomial_less_0]
6718QED
6719
6720(* Theorem: k <= n ==> (leibniz n k = leibniz n (n-k)) *)
6721(* Proof:
6722 leibniz n k
6723 = (n + 1) * binomial n k by leibniz_def
6724 = (n + 1) * binomial n (n-k) by binomial_sym
6725 = leibniz n (n-k) by leibniz_def
6726*)
6727Theorem leibniz_sym:
6728 !n k. k <= n ==> (leibniz n k = leibniz n (n-k))
6729Proof
6730 rw[leibniz_def, GSYM binomial_sym]
6731QED
6732
6733(* Theorem: k < HALF n ==> leibniz n k < leibniz n (k + 1) *)
6734(* Proof:
6735 Assume k < HALF n, and note that 0 < (n + 1).
6736 leibniz n k < leibniz n (k + 1)
6737 <=> (n + 1) * binomial n k < (n + 1) * binomial n (k + 1) by leibniz_def
6738 <=> binomial n k < binomial n (k + 1) by LT_MULT_LCANCEL
6739 <=> T by binomial_monotone
6740*)
6741Theorem leibniz_monotone:
6742 !n k. k < HALF n ==> leibniz n k < leibniz n (k + 1)
6743Proof
6744 rw[leibniz_def, binomial_monotone]
6745QED
6746
6747(* Theorem: k <= n ==> 0 < leibniz n k *)
6748(* Proof:
6749 Since leibniz n k = (n + 1) * binomial n k by leibniz_def
6750 and 0 < n + 1, 0 < binomial n k by binomial_pos
6751 Hence 0 < leibniz n k by ZERO_LESS_MULT
6752*)
6753Theorem leibniz_pos:
6754 !n k. k <= n ==> 0 < leibniz n k
6755Proof
6756 rw[leibniz_def, binomial_pos, ZERO_LESS_MULT, DECIDE``!n. 0 < n + 1``]
6757QED
6758
6759(* Theorem: (leibniz n k = 0) <=> n < k *)
6760(* Proof:
6761 leibniz n k = 0
6762 <=> (n + 1) * (binomial n k = 0) by leibniz_def
6763 <=> binomial n k = 0 by MULT_EQ_0, n + 1 <> 0
6764 <=> n < k by binomial_eq_0
6765*)
6766Theorem leibniz_eq_0:
6767 !n k. (leibniz n k = 0) <=> n < k
6768Proof
6769 rw[leibniz_def, binomial_eq_0]
6770QED
6771
6772(* Theorem: leibniz n = (\j. (n + 1) * j) o (binomial n) *)
6773(* Proof: by leibniz_def and function equality. *)
6774Theorem leibniz_alt:
6775 !n. leibniz n = (\j. (n + 1) * j) o (binomial n)
6776Proof
6777 rw[leibniz_def, FUN_EQ_THM]
6778QED
6779
6780(* Theorem: leibniz n k = (\j. (n + 1) * j) (binomial n k) *)
6781(* Proof: by leibniz_def *)
6782Theorem leibniz_def_alt:
6783 !n k. leibniz n k = (\j. (n + 1) * j) (binomial n k)
6784Proof
6785 rw_tac std_ss[leibniz_def]
6786QED
6787
6788(*
6789Picture of Leibniz Triangle L-corner:
6790 b = L (n-1) k
6791 a = L n k c = L n (k+1)
6792
6793a = L n k = (n+1) * (n, k, n-k) = (n+1, k, n-k) = (n+1)! / k! (n-k)!
6794b = L (n-1) k = n * (n-1, k, n-1-k) = (n , k, n-k-1) = n! / k! (n-k-1)! = a * (n-k)/(n+1)
6795c = L n (k+1) = (n+1) * (n, k+1, n-(k+1)) = (n+1, k+1, n-k-1) = (n+1)! / (k+1)! (n-k-1)! = a * (n-k)/(k+1)
6796
6797a * b = a * a * (n-k)/(n+1)
6798a - b = a - a * (n-k)/(n+1) = a * (1 - (n-k)/(n+1)) = a * (n+1 - n+k)/(n+1) = a * (k+1)/(n+1)
6799Hence
6800 a * b /(a - b)
6801= [a * a * (n-k)/(n+1)] / [a * (k+1)/(n+1)]
6802= a * (n-k)/(k+1)
6803= c
6804or a * b = c * (a - b)
6805*)
6806
6807(* Theorem: 0 < n ==> !k. (n + 1) * leibniz (n - 1) k = (n - k) * leibniz n k *)
6808(* Proof:
6809 (n + 1) * leibniz (n - 1) k
6810 = (n + 1) * ((n-1 + 1) * binomial (n-1) k) by leibniz_def
6811 = (n + 1) * (n * binomial (n-1) k) by SUB_ADD, 1 <= n.
6812 = (n + 1) * ((n - k) * (binomial n k)) by binomial_up_eqn
6813 = ((n + 1) * (n - k)) * binomial n k by MULT_ASSOC
6814 = ((n - k) * (n + 1)) * binomial n k by MULT_COMM
6815 = (n - k) * ((n + 1) * binomial n k) by MULT_ASSOC
6816 = (n - k) * leibniz n k by leibniz_def
6817*)
6818Theorem leibniz_up_eqn:
6819 !n. 0 < n ==> !k. (n + 1) * leibniz (n - 1) k = (n - k) * leibniz n k
6820Proof
6821 rw[leibniz_def] >>
6822 `1 <= n` by decide_tac >>
6823 metis_tac[SUB_ADD, binomial_up_eqn, MULT_ASSOC, MULT_COMM]
6824QED
6825
6826(* Theorem: 0 < n ==> !k. leibniz (n - 1) k = (n - k) * leibniz n k DIV (n + 1) *)
6827(* Proof:
6828 Since (n + 1) * leibniz (n - 1) k = (n - k) * leibniz n k by leibniz_up_eqn
6829 leibniz (n - 1) k = (n - k) * leibniz n k DIV (n + 1) by DIV_SOLVE, 0 < n+1.
6830*)
6831Theorem leibniz_up:
6832 !n. 0 < n ==> !k. leibniz (n - 1) k = (n - k) * leibniz n k DIV (n + 1)
6833Proof
6834 rw[leibniz_up_eqn, DIV_SOLVE]
6835QED
6836
6837(* Theorem: 0 < n ==> !k. leibniz (n - 1) k = (n - k) * binomial n k *)
6838(* Proof:
6839 leibniz (n - 1) k
6840 = (n - k) * leibniz n k DIV (n + 1) by leibniz_up, 0 < n
6841 = (n - k) * ((n + 1) * binomial n k) DIV (n + 1) by leibniz_def
6842 = (n + 1) * ((n - k) * binomial n k) DIV (n + 1) by MULT_ASSOC, MULT_COMM
6843 = (n - k) * binomial n k by MULT_DIV, 0 < n + 1
6844*)
6845Theorem leibniz_up_alt:
6846 !n. 0 < n ==> !k. leibniz (n - 1) k = (n - k) * binomial n k
6847Proof
6848 metis_tac[leibniz_up, leibniz_def, MULT_DIV, MULT_ASSOC, MULT_COMM, DECIDE``0 < x + 1``]
6849QED
6850
6851(* Theorem: 0 < n ==> !k. (k + 1) * leibniz n (k+1) = (n - k) * leibniz n k *)
6852(* Proof:
6853 (k + 1) * leibniz n (k+1)
6854 = (k + 1) * ((n + 1) * binomial n (k+1)) by leibniz_def
6855 = (k + 1) * (n + 1) * binomial n (k+1) by MULT_ASSOC
6856 = (n + 1) * (k + 1) * binomial n (k+1) by MULT_COMM
6857 = (n + 1) * ((k + 1) * binomial n (k+1)) by MULT_ASSOC
6858 = (n + 1) * ((n - k) * (binomial n k)) by binomial_right_eqn
6859 = ((n + 1) * (n - k)) * binomial n k by MULT_ASSOC
6860 = ((n - k) * (n + 1)) * binomial n k by MULT_COMM
6861 = (n - k) * ((n + 1) * binomial n k) by MULT_ASSOC
6862 = (n - k) * leibniz n k by leibniz_def
6863*)
6864Theorem leibniz_right_eqn:
6865 !n. 0 < n ==> !k. (k + 1) * leibniz n (k+1) = (n - k) * leibniz n k
6866Proof
6867 metis_tac[leibniz_def, MULT_COMM, MULT_ASSOC, binomial_right_eqn]
6868QED
6869
6870(* Theorem: 0 < n ==> !k. leibniz n (k+1) = (n - k) * (leibniz n k) DIV (k + 1) *)
6871(* Proof:
6872 Since (k + 1) * leibniz n (k+1) = (n - k) * leibniz n k by leibniz_right_eqn
6873 leibniz n (k+1) = (n - k) * (leibniz n k) DIV (k+1) by DIV_SOLVE, 0 < k+1.
6874*)
6875Theorem leibniz_right:
6876 !n. 0 < n ==> !k. leibniz n (k+1) = (n - k) * (leibniz n k) DIV (k+1)
6877Proof
6878 rw[leibniz_right_eqn, DIV_SOLVE]
6879QED
6880
6881(* Note: Following is the property from Leibniz Harmonic Triangle:
6882 1 / leibniz n (k+1) = 1 / leibniz (n-1) k - 1 / leibniz n k
6883 = (leibniz n k - leibniz (n-1) k) / leibniz n k * leibniz (n-1) k
6884*)
6885
6886(* The Idea:
6887 b
6888Actually, lcm a b = lcm b c = lcm c a for a c in Leibniz Triangle.
6889The only relationship is: c = ab/(a - b), or ab = c(a - b).
6890
6891Is this a theorem: ab = c(a - b) ==> lcm a b = lcm b c = lcm c a
6892Or in fractions, 1/c = 1/b - 1/a ==> lcm a b = lcm b c = lcm c a ?
6893
6894lcm a b
6895= a b / (gcd a b)
6896= c(a - b) / (gcd a (a - b))
6897= ac(a - b) / gcd a (a-b) / a
6898= lcm (a (a-b)) c / a
6899= lcm (ca c(a-b)) / a
6900= lcm (ca ab) / a
6901= lcm (b c)
6902
6903lcm a b = a b / gcd a b = a b / gcd a (a-b) = a b c / gcd ca c(a-b)
6904= c (a-b) c / gcd ca c(a-b) = lcm ca c(a-b) / a = lcm ca ab / a = lcm b c
6905
6906 lcm b c
6907= b c / gcd b c
6908= a b c / gcd a*b a*c
6909= a b c / gcd c*(a-b) c*a
6910= a b / gcd (a-b) a
6911= a b / gcd b a
6912= lcm (a b)
6913= lcm a b
6914
6915 lcm a c
6916= a c / gcd a c
6917= a b c / gcd b*a b*c
6918= a b c / gcd c*(a-b) b*c
6919= a b / gcd (a-b) b
6920= a b / gcd a b
6921= lcm a b
6922
6923Yes!
6924
6925This is now in LCM_EXCHANGE:
6926val it = |- !a b c. (a * b = c * (a - b)) ==> (lcm a b = lcm a c): thm
6927*)
6928
6929(* Theorem: 0 < n ==>
6930 !k. leibniz n k * leibniz (n-1) k = leibniz n (k+1) * (leibniz n k - leibniz (n-1) k) *)
6931(* Proof:
6932 If n <= k,
6933 then n-1 < k, and n < k+1.
6934 so leibniz (n-1) k = 0 by leibniz_less_0, n-1 < k.
6935 and leibniz n (k+1) = 0 by leibniz_less_0, n < k+1.
6936 Hence true by MULT_EQ_0
6937 Otherwise, k < n, or k <= n.
6938 then (n+1) - (n-k) = k+1.
6939
6940 (k + 1) * (c * (a - b))
6941 = (k + 1) * c * (a - b) by MULT_ASSOC
6942 = ((n+1) - (n-k)) * c * (a - b) by above
6943 = (n - k) * a * (a - b) by leibniz_right_eqn
6944 = (n - k) * a * a - (n - k) * a * b by LEFT_SUB_DISTRIB
6945 = (n + 1) * b * a - (n - k) * a * b by leibniz_up_eqn
6946 = (n + 1) * (a * b) - (n - k) * (a * b) by MULT_ASSOC, MULT_COMM
6947 = ((n+1) - (n-k)) * (a * b) by RIGHT_SUB_DISTRIB
6948 = (k + 1) * (a * b) by above
6949
6950 Since (k+1) <> 0, the result follows by MULT_LEFT_CANCEL
6951*)
6952Theorem leibniz_property:
6953 !n. 0 < n ==>
6954 !k. leibniz n k * leibniz (n-1) k = leibniz n (k+1) * (leibniz n k - leibniz (n-1) k)
6955Proof
6956 rpt strip_tac >>
6957 Cases_on `n <= k` >-
6958 rw[leibniz_less_0] >>
6959 `(n+1) - (n-k) = k+1` by decide_tac >>
6960 `(k+1) <> 0` by decide_tac >>
6961 qabbrev_tac `a = leibniz n k` >>
6962 qabbrev_tac `b = leibniz (n - 1) k` >>
6963 qabbrev_tac `c = leibniz n (k + 1)` >>
6964 `(k + 1) * (c * (a - b)) = ((n+1) - (n-k)) * c * (a - b)` by rw_tac std_ss[MULT_ASSOC] >>
6965 `_ = (n - k) * a * (a - b)` by rw_tac std_ss[leibniz_right_eqn, Abbr`c`, Abbr`a`] >>
6966 `_ = (n - k) * a * a - (n - k) * a * b` by rw_tac std_ss[LEFT_SUB_DISTRIB] >>
6967 `_ = (n + 1) * b * a - (n - k) * a * b` by rw_tac std_ss[leibniz_up_eqn, Abbr`b`, Abbr`a`] >>
6968 `_ = (n + 1) * (a * b) - (n - k) * (a * b)` by metis_tac[MULT_ASSOC, MULT_COMM] >>
6969 `_ = ((n+1) - (n-k)) * (a * b)` by rw_tac std_ss[RIGHT_SUB_DISTRIB] >>
6970 `_ = (k + 1) * (a * b)` by rw_tac std_ss[] >>
6971 metis_tac[MULT_LEFT_CANCEL]
6972QED
6973
6974(* Theorem: k <= n ==> (leibniz n k = (n + 1) * FACT n DIV (FACT k * FACT (n - k))) *)
6975(* Proof:
6976 Note (FACT k * FACT (n - k)) divides (FACT n) by binomial_is_integer
6977 and 0 < FACT k * FACT (n - k) by FACT_LESS, ZERO_LESS_MULT
6978 leibniz n k
6979 = (n + 1) * binomial n k by leibniz_def
6980 = (n + 1) * (FACT n DIV (FACT k * FACT (n - k))) by binomial_formula3
6981 = (n + 1) * FACT n DIV (FACT k * FACT (n - k)) by MULTIPLY_DIV
6982*)
6983Theorem leibniz_formula:
6984 !n k. k <= n ==> (leibniz n k = (n + 1) * FACT n DIV (FACT k * FACT (n - k)))
6985Proof
6986 metis_tac[leibniz_def, binomial_formula3, binomial_is_integer, FACT_LESS, MULTIPLY_DIV, ZERO_LESS_MULT]
6987QED
6988
6989(* Theorem: 0 < n ==>
6990 !k. k < n ==> leibniz n (k+1) = leibniz n k * leibniz (n-1) k DIV (leibniz n k - leibniz (n-1) k) *)
6991(* Proof:
6992 By leibniz_property,
6993 leibniz n (k+1) * (leibniz n k - leibniz (n-1) k) = leibniz n k * leibniz (n-1) k
6994 Since 0 < leibniz n k and 0 < leibniz (n-1) k by leibniz_pos
6995 so 0 < (leibniz n k - leibniz (n-1) k) by MULT_EQ_0
6996 Hence by MULT_COMM, DIV_SOLVE, 0 < (leibniz n k - leibniz (n-1) k),
6997 leibniz n (k+1) = leibniz n k * leibniz (n-1) k DIV (leibniz n k - leibniz (n-1) k)
6998*)
6999Theorem leibniz_recurrence:
7000 !n. 0 < n ==>
7001 !k. k < n ==> (leibniz n (k+1) = leibniz n k * leibniz (n-1) k DIV (leibniz n k - leibniz (n-1) k))
7002Proof
7003 rpt strip_tac >>
7004 `k <= n /\ k <= (n-1)` by decide_tac >>
7005 `leibniz n (k+1) * (leibniz n k - leibniz (n-1) k) = leibniz n k * leibniz (n-1) k` by rw[leibniz_property] >>
7006 `0 < leibniz n k /\ 0 < leibniz (n-1) k` by rw[leibniz_pos] >>
7007 `0 < (leibniz n k - leibniz (n-1) k)` by metis_tac[MULT_EQ_0, NOT_ZERO_LT_ZERO] >>
7008 rw_tac std_ss[DIV_SOLVE, MULT_COMM]
7009QED
7010
7011(* Theorem: 0 < k /\ k <= n ==>
7012 (leibniz n k = leibniz n (k-1) * leibniz (n-1) (k-1) DIV (leibniz n (k-1) - leibniz (n-1) (k-1))) *)
7013(* Proof:
7014 Since 0 < k, k = SUC h for some h
7015 or k = h + 1 by ADD1
7016 and h = k - 1 by arithmetic
7017 Since 0 < k and k <= n,
7018 0 < n and h < n.
7019 Hence true by leibniz_recurrence.
7020*)
7021Theorem leibniz_n_k:
7022 !n k. 0 < k /\ k <= n ==>
7023 (leibniz n k = leibniz n (k-1) * leibniz (n-1) (k-1) DIV (leibniz n (k-1) - leibniz (n-1) (k-1)))
7024Proof
7025 rpt strip_tac >>
7026 `?h. k = h + 1` by metis_tac[num_CASES, NOT_ZERO_LT_ZERO, ADD1] >>
7027 `(h = k - 1) /\ h < n /\ 0 < n` by decide_tac >>
7028 metis_tac[leibniz_recurrence]
7029QED
7030
7031(* Theorem: 0 < n ==>
7032 !k. lcm (leibniz n k) (leibniz (n-1) k) = lcm (leibniz n k) (leibniz n (k+1)) *)
7033(* Proof:
7034 By leibniz_property,
7035 leibniz n k * leibniz (n - 1) k = leibniz n (k + 1) * (leibniz n k - leibniz (n - 1) k)
7036 Hence true by LCM_EXCHANGE.
7037*)
7038Theorem leibniz_lcm_exchange:
7039 !n. 0 < n ==> !k. lcm (leibniz n k) (leibniz (n-1) k) = lcm (leibniz n k) (leibniz n (k+1))
7040Proof
7041 rw[leibniz_property, LCM_EXCHANGE]
7042QED
7043
7044(* Theorem: 4 ** n <= leibniz (2 * n) n *)
7045(* Proof:
7046 Let m = 2 * n.
7047 Then n = HALF m by HALF_TWICE
7048 Let l1 = GENLIST (K (binomial m n)) (m + 1)
7049 and l2 = GENLIST (binomial m) (m + 1)
7050 Note LENGTH l1 = LENGTH l2 = m + 1 by LENGTH_GENLIST
7051
7052 Claim: !k. k < m + 1 ==> EL k l2 <= EL k l1
7053 Proof: Note EL k l1 = binomial m n by EL_GENLIST
7054 and EL k l2 = binomial m k by EL_GENLIST
7055 Apply binomial m k <= binomial m n by binomial_max
7056 The result follows
7057
7058 leibniz m n
7059 = (m + 1) * binomial m n by leibniz_def
7060 = SUM (GENLIST (K (binomial m n)) (m + 1)) by SUM_GENLIST_K
7061 >= SUM (GENLIST (\k. binomial m k) (m + 1)) by SUM_LE, above
7062 = SUM (GENLIST (binomial m) (SUC m)) by ADD1
7063 = 2 ** m by binomial_sum
7064 = 2 ** (2 * n) by notation
7065 = (2 ** 2) ** n by EXP_EXP_MULT
7066 = 4 ** n by arithmetic
7067*)
7068Theorem leibniz_middle_lower:
7069 !n. 4 ** n <= leibniz (2 * n) n
7070Proof
7071 rpt strip_tac >>
7072 qabbrev_tac `m = 2 * n` >>
7073 `n = HALF m` by rw[HALF_TWICE, Abbr`m`] >>
7074 qabbrev_tac `l1 = GENLIST (K (binomial m n)) (m + 1)` >>
7075 qabbrev_tac `l2 = GENLIST (binomial m) (m + 1)` >>
7076 `!k. k < m + 1 ==> EL k l2 <= EL k l1` by rw[binomial_max, EL_GENLIST, Abbr`l1`, Abbr`l2`] >>
7077 `leibniz m n = (m + 1) * binomial m n` by rw[leibniz_def] >>
7078 `_ = SUM l1` by rw[SUM_GENLIST_K, Abbr`l1`] >>
7079 `SUM l2 = SUM (GENLIST (binomial m) (SUC m))` by rw[ADD1, Abbr`l2`] >>
7080 `_ = 2 ** m` by rw[binomial_sum] >>
7081 `_ = 4 ** n` by rw[EXP_EXP_MULT, Abbr`m`] >>
7082 metis_tac[SUM_LE, LENGTH_GENLIST]
7083QED
7084
7085(* ------------------------------------------------------------------------- *)
7086(* Property of Leibniz Triangle *)
7087(* ------------------------------------------------------------------------- *)
7088
7089(*
7090binomial_recurrence |- !n k. binomial (SUC n) (SUC k) = binomial n k + binomial n (SUC k)
7091This means:
7092 B n k + B n k*
7093 v
7094 B n* k*
7095However, for the Leibniz Triangle, the recurrence is:
7096 L n k
7097 L n* k -> L n* k* = (L n* k)(L n k) / (L n* k - L n k)
7098That is, it takes a different style, and has the property:
7099 1 / L n* k* = 1 / L n k - 1 / L n* k
7100Why?
7101First, some verification.
7102Pascal: [1] 3 3
7103 [4] 6 = 3 + 3 = 6
7104Leibniz: 12 12
7105 [20] 30 = 20 * 12 / (20 - 12) = 20 * 12 / 8 = 30
7106Now, the 20 comes from 4 = 3 + 1.
7107Originally, 30 = 5 * 6 by definition based on multiple
7108 = 5 * (3 + 3) by Pascal
7109 = 4 * (3 + 3) + (3 + 3)
7110 = 12 + 12 + 6
7111In terms of factorials, 30 = 5 * 6 = 5 * B(4,2) = 5 * 4!/2!2!
7112 20 = 5 * 4 = 5 * B(4,1) = 5 * 4!/1!3!
7113 12 = 4 * 3 = 4 * B(3,1) = 4 * 3!/1!2!
7114So 1/30 = (2!2!)/(5 4!) 1 / n** B n* k* = k*! (n* - k* )! / n** n*! = (n - k)! k*! / n**!
7115 1/20 = (1!3!)/(5 4!) 1 / n** B n* k
7116 1/12 = (1!2!)/(4 3!) 1 / n* B n k
7117 1/12 - 1/20
7118 = (1!2!)/(4 3!) - (1!3!)/(5 4!)
7119 = (1!2!)/4! - (1!3!)/5!
7120 = 5(1!2!)/5! - (1!3!)/5!
7121 = (5(1!2!) - (1!3!))/5!
7122 = (5 1! - 3 1!) 2!/5!
7123 = (5 - 3)1! 2!/5!
7124 = 2! 2! / 5!
7125
7126 1 / n B n k - 1 / n** B n* k
7127 = k! (n-k)! / n* n! - k! (n* - k)! / n** n*!
7128 = k! (n-k)! / n*! - k!(n* - k)! / n** n*!
7129 = (n** (n-k)! - (n* - k)!) k! / n** n*!
7130 = (n** - (n* - k)) (n - k)! k! / n** n*!
7131 = (k+1) (n - k)! k! / n** n*!
7132 = (n* - k* )! k*! / n** n*!
7133 = 1 / n** B n* k*
7134
7135Direct without using unit fractions,
7136
7137L n k = n* B n k = n* n! / k! (n-k)! = n*! / k! (n-k)!
7138L n* k = n** B n* k = n** n*! / k! (n* - k)! = n**! / k! (n* - k)!
7139L n* k* = n** B n* k* = n** n*! / k*! (n* - k* )! = n**! / k*! (n-k)!
7140
7141(L n* k) * (L n k) = n**! n*! / k! (n* - k)! k! (n-k)!
7142(L n* k) - (L n k) = n**! / k! (n* - k)! - n*! / k! (n-k)!
7143 = n**! / k! (n-k)!( 1/(n* - k) - 1/ n** )
7144 = n**! / k! (n-k)! (n** - n* + k)/(n* - k)(n** )
7145 = n**! / k! (n-k)! k* / (n* - k) n**
7146 = n*! k* / k! (n* - k)!
7147(L n* k) * (L n k) / (L n* k) - (L n k)
7148= n**! /k! (n-k)! k*
7149= n**! /k*! (n-k)!
7150= L n* k*
7151So: L n k
7152 L n* k --> L n* k*
7153
7154Can the LCM be shown directly?
7155lcm (L n* k, L n k) = lcm (L n* k, L n* k* )
7156To prove this, need to show:
7157both have the same common multiples, and least is the same -- probably yes due to common L n* k.
7158
7159In general, what is the condition for lcm a b = lcm a c ?
7160Well, lcm a b = a b / gcd a b, lcm a c = a c / gcd a c
7161So it must be a b gcd a c = a c gcd a b, or b * gcd a c = c * gcd a b.
7162
7163It this true for Leibniz triangle?
7164Let a = 5, b = 4, c = 20. b * gcd a c = 4 * gcd 5 20 = 4 * 5 = 20
7165 c * gcd a b = 20 * gcd 5 4 = 20
7166Verify lcm a b = lcm 5 4 = 20 = 5 * 4 / gcd 5 4
7167 lcm a c = lcm 5 20 = 20 = 5 * 20 / gcd 5 20
7168 5 * 4 / gcd 5 4 = 5 * 20 / gcd 5 20
7169or 4 * gcd 5 20 = 20 * gcd 5 4
7170
7171(L n k) * gcd (L n* k, L n* k* ) = (L n* k* ) * gcd (L n* k, L n k)
7172
7173or n* B n k * gcd (n** B n* k, n** B n* k* ) = (n** B n* k* ) * gcd (n** B n* k, n* B n k)
7174By GCD_COMMON_FACTOR, !m n k. gcd (k * m) (k * n) = k * gcd m n
7175 n** n* B n k gcd (B n* k, B n* k* ) = (n** B n* k* ) * gcd (n** B n* k, n* B n k)
7176*)
7177
7178(* Special Property of Leibniz Triangle
7179For: L n k
7180 L n+ k --> L n+ k+
7181
7182L n k = n+! / k! (n-k)!
7183L n+ k = n++! / k! (n+ - k)! = n++ n+! / k! (n+ - k) k! = (n++ / n+ - k) L n k
7184L n+ k+ = n++! / k+! (n-k)! = (L n+ k) * (L n k) / (L n+ k - L n k) = (n++ / k+) L n k
7185Let g = gcd (L n+ k) (L n k), then L n+ k+ = lcm (L n+ k) (L n k) / (co n+ k - co n k)
7186where co n+ k = L n+ k / g, co n k = L n k / g.
7187
7188 L n+ k = (n++ / n+ - k) L n k,
7189and L n+ k+ = (n++ / k+) L n k
7190e.g. L 3 1 = 12
7191 L 4 1 = 20, or (3++ / 3+ - 1) L 3 1 = (5/3) 12 = 20.
7192 L 4 2 = 30, or (3++ / 1+) L 3 1 = (5/2) 12 = 30.
7193so lcm (L 4 1) (L 3 1) = lcm (5/3)*12 12 = 12 * 5 = 60 since 3 must divide 12.
7194 lcm (L 4 1) (L 4 2) = lcm (5/3)*12 (5/2)*12 = 12 * 5 = 60 since 3, 2 must divide 12.
7195
7196By LCM_COMMON_FACTOR |- !m n k. lcm (k * m) (k * n) = k * lcm m n
7197lcm a (a * b DIV c) = a * b
7198
7199So the picture is: (L n k)
7200 (L n k) * (n+2)/(n-k+1) (L n k) * (n+2)/(k+1)
7201
7202A better picture:
7203Pascal: (B n-1 k) = (n-1, k, n-k-1)
7204 (B n k) = (n, k, n-k) (B n k+1) = (n, k+1, n-k-1)
7205Leibniz: (L n-1 k) = (n, k, n-k-1) = (L n k) / (n+1) * (n-k-1)
7206 (L n k) = (n+1, k, n-k) (L n k+1) = (n+1, k+1, n-k-1) = (L n k) / (n-k-1) * (k+1)
7207And we want:
7208 LCM (L, (n-k-1) * L DIV (n+1)) = LCM (L, (k+1) * L DIV (n-k-1)).
7209
7210Theorem: lcm a ((a * b) DIV c) = (a * b) DIV (gcd b c)
7211Assume this theorem,
7212LHS = L * (n-k-1) DIV gcd (n-k-1, n+1)
7213RHS = L * (k+1) DIV gcd (k+1, n-k-1)
7214Still no hope to show LHS = RHS !
7215
7216LCM of fractions:
7217lcm (a/c, b/c) = lcm(a, b)/c
7218lcm (a/c, b/d) = ... = lcm(a, b)/gcd(c, d)
7219Hence lcm (a, a*b/c) = lcm(a*b/b, a*b/c) = a * b / gcd (b, c)
7220*)
7221
7222(* Special Property of Leibniz Triangle -- another go
7223Leibniz: L(5,1) = 30 = b
7224 L(6,1) = 42 = a L(6,2) = 105 = c, c = ab/(a - b), or ab = c(a - b)
7225Why is LCM 42 30 = LCM 42 105 = 210 = 2x3x5x7?
7226First, b = L(5,1) = 30 = (6,1,4) = 6!/1!4! = 7!/1!5! * (5/7) = a * (5/7) = 2x3x5
7227 a = L(6,1) = 42 = (7,1,5) = 7!/1!5! = 2x3x7 = b * (7/5) = c * (2/5)
7228 c = L(6,2) = 105 = (7,2,4) = 7!/2!4! = 7!/1!5! * (5/2) = a * (5/2) = 3x5x7
7229Any common multiple of a, b must have 5, 7 as factor, also with factor 2 (by common k = 1)
7230Any common multiple of a, c must have 5, 2 as factor, also with factor 7 (by common n = 6)
7231Also n = 5 implies a factor 6, k = 2 imples a factor 2.
7232LCM a b = a b / GCD a b
7233 = c (a - b) / GCD a b
7234 = (m c') (m a' - (m-1)b') / GCD (m a') (m-1 b')
7235LCM a c = a c / GCD a c
7236 = (m a') (m c') / GCD (m a') (m c') where c' = a' + b' from Pascal triangle
7237 = m a' (a' + b') / GCD a' (a' + b')
7238 = m a' (a' + b') / GCD a' b'
7239 = a' c / GCD a' b'
7240Can we prove: c(a - b) / GCD a b = c a' / GCD a' b'
7241or (a - b) GCD a' b' = a' GCD a b ?
7242or a GCD a' b' = a' GCD a b + b GCD a' b' ?
7243or ab GCD a' b' = c a' GCD a b?
7244or m (b GCD a' b') = c GCD a b?
7245or b GCD a' b' = c' GCD a b?
7246b = (a DIV 7) * 5
7247c = (a DIV 2) * 5
7248lcm (a, b) = lcm (a, (a DIV 7) * 5) = lcm (a, 5)
7249lcm (a, c) = lcm (a, (a DIV 2) * 5) = lcm (a, 5)
7250Is this a theorem: lcm (a, (a DIV p) * b) = lcm (a, b) if p | a ?
7251Let c = lcm (a, b). Then a | c, b | c.
7252Since a = (a DIV p) * p, (a DIV p) * p | c.
7253Hence ((a DIV p) * b) * p | b * c.
7254How to conclude ((a DIV p) * b) | c?
7255
7256A counter-example:
7257lcm (42, 9) = 126 = 2x3x3x7.
7258lcm (42, (42 DIV 3) * 9) = 126 = 2x3x3x7.
7259lcm (42, (42 DIV 6) * 9) = 126 = 2x3x3x7.
7260lcm (42, (42 DIV 2) * 9) = 378 = 2x3x3x3x7.
7261lcm (42, (42 DIV 7) * 9) = 378 = 2x3x3x3x7.
7262
7263LCM a c
7264= LCM a (ab/(a-b)) let g = GCD(a,b), a = gA, b=gB, coprime A,B.
7265= LCM gA gAB/(A-B)
7266= g LCM A AB/(A-B)
7267= (ab/LCM a b) LCM A AB/(A-B)
7268*)
7269
7270(* ------------------------------------------------------------------------- *)
7271(* LCM of a list of numbers *)
7272(* ------------------------------------------------------------------------- *)
7273
7274(* Define LCM of a list of numbers *)
7275Definition list_lcm_def[simp]:
7276 (list_lcm [] = 1) /\
7277 (list_lcm (h::t) = lcm h (list_lcm t))
7278End
7279
7280
7281(* Theorem: list_lcm [] = 1 *)
7282(* Proof: by list_lcm_def. *)
7283Theorem list_lcm_nil:
7284 list_lcm [] = 1
7285Proof
7286 rw[]
7287QED
7288
7289(* Theorem: list_lcm (h::t) = lcm h (list_lcm t) *)
7290(* Proof: by list_lcm_def. *)
7291Theorem list_lcm_cons:
7292 !h t. list_lcm (h::t) = lcm h (list_lcm t)
7293Proof
7294 rw[]
7295QED
7296
7297(* Theorem: list_lcm [x] = x *)
7298(* Proof:
7299 list_lcm [x]
7300 = lcm x (list_lcm []) by list_lcm_cons
7301 = lcm x 1 by list_lcm_nil
7302 = x by LCM_1
7303*)
7304Theorem list_lcm_sing:
7305 !x. list_lcm [x] = x
7306Proof
7307 rw[]
7308QED
7309
7310(* Theorem: list_lcm (SNOC x l) = list_lcm (x::l) *)
7311(* Proof:
7312 By induction on l.
7313 Base case: list_lcm (SNOC x []) = lcm x (list_lcm [])
7314 list_lcm (SNOC x [])
7315 = list_lcm [x] by SNOC
7316 = lcm x (list_lcm []) by list_lcm_def
7317 Step case: list_lcm (SNOC x l) = lcm x (list_lcm l) ==>
7318 !h. list_lcm (SNOC x (h::l)) = lcm x (list_lcm (h::l))
7319 list_lcm (SNOC x (h::l))
7320 = list_lcm (h::SNOC x l) by SNOC
7321 = lcm h (list_lcm (SNOC x l)) by list_lcm_def
7322 = lcm h (lcm x (list_lcm l)) by induction hypothesis
7323 = lcm x (lcm h (list_lcm l)) by LCM_ASSOC_COMM
7324 = lcm x (list_lcm h::l) by list_lcm_def
7325*)
7326Theorem list_lcm_snoc:
7327 !x l. list_lcm (SNOC x l) = lcm x (list_lcm l)
7328Proof
7329 strip_tac >>
7330 Induct >-
7331 rw[] >>
7332 rw[LCM_ASSOC_COMM]
7333QED
7334
7335(* Theorem: list_lcm (MAP (\k. n * k) l) = if l = [] then 1 else n * list_lcm l *)
7336(* Proof:
7337 By induction on l.
7338 Base case: !n. list_lcm (MAP (\k. n * k) []) = if [] = [] then 1 else n * list_lcm []
7339 list_lcm (MAP (\k. n * k) [])
7340 = list_lcm [] by MAP
7341 = 1 by list_lcm_nil
7342 Step case: !n. list_lcm (MAP (\k. n * k) l) = if l = [] then 1 else n * list_lcm l ==>
7343 !h n. list_lcm (MAP (\k. n * k) (h::l)) = if h::l = [] then 1 else n * list_lcm (h::l)
7344 Note h::l <> [] by NOT_NIL_CONS
7345 If l = [], h::l = [h]
7346 list_lcm (MAP (\k. n * k) [h])
7347 = list_lcm [n * h] by MAP
7348 = n * h by list_lcm_sing
7349 = n * list_lcm [h] by list_lcm_sing
7350 If l <> [],
7351 list_lcm (MAP (\k. n * k) (h::l))
7352 = list_lcm ((n * h) :: MAP (\k. n * k) l) by MAP
7353 = lcm (n * h) (list_lcm (MAP (\k. n * k) l)) by list_lcm_cons
7354 = lcm (n * h) (n * list_lcm l) by induction hypothesis
7355 = n * (lcm h (list_lcm l)) by LCM_COMMON_FACTOR
7356 = n * list_lcm (h::l) by list_lcm_cons
7357*)
7358Theorem list_lcm_map_times:
7359 !n l. list_lcm (MAP (\k. n * k) l) = if l = [] then 1 else n * list_lcm l
7360Proof
7361 Induct_on `l` >-
7362 rw[] >>
7363 rpt strip_tac >>
7364 Cases_on `l = []` >-
7365 rw[] >>
7366 rw_tac std_ss[LCM_COMMON_FACTOR, MAP, list_lcm_cons]
7367QED
7368
7369(* Theorem: EVERY_POSITIVE l ==> 0 < list_lcm l *)
7370(* Proof:
7371 By induction on l.
7372 Base case: EVERY_POSITIVE [] ==> 0 < list_lcm []
7373 Note EVERY_POSITIVE [] = T by EVERY_DEF
7374 Since list_lcm [] = 1 by list_lcm_nil
7375 Hence true since 0 < 1 by SUC_POS, ONE.
7376 Step case: EVERY_POSITIVE l ==> 0 < list_lcm l ==>
7377 !h. EVERY_POSITIVE (h::l) ==> 0 < list_lcm (h::l)
7378 Note EVERY_POSITIVE (h::l)
7379 ==> 0 < h and EVERY_POSITIVE l by EVERY_DEF
7380 Since list_lcm (h::l) = lcm h (list_lcm l) by list_lcm_cons
7381 and 0 < list_lcm l by induction hypothesis
7382 so h <= lcm h (list_lcm l) by LCM_LE, 0 < h.
7383 Hence 0 < list_lcm (h::l) by LESS_LESS_EQ_TRANS
7384*)
7385Theorem list_lcm_pos:
7386 !l. EVERY_POSITIVE l ==> 0 < list_lcm l
7387Proof
7388 Induct >-
7389 rw[] >>
7390 metis_tac[EVERY_DEF, list_lcm_cons, LCM_LE, LESS_LESS_EQ_TRANS]
7391QED
7392
7393(* Theorem: POSITIVE l ==> 0 < list_lcm l *)
7394(* Proof: by list_lcm_pos, EVERY_MEM *)
7395Theorem list_lcm_pos_alt:
7396 !l. POSITIVE l ==> 0 < list_lcm l
7397Proof
7398 rw[list_lcm_pos, EVERY_MEM]
7399QED
7400
7401(* Theorem: EVERY_POSITIVE l ==> SUM l <= (LENGTH l) * list_lcm l *)
7402(* Proof:
7403 By induction on l.
7404 Base case: EVERY_POSITIVE [] ==> SUM [] <= LENGTH [] * list_lcm []
7405 Note EVERY_POSITIVE [] = T by EVERY_DEF
7406 Since SUM [] = 0 by SUM
7407 and LENGTH [] = 0 by LENGTH_NIL
7408 Hence true by MULT, as 0 <= 0 by LESS_EQ_REFL
7409 Step case: EVERY_POSITIVE l ==> SUM l <= LENGTH l * list_lcm l ==>
7410 !h. EVERY_POSITIVE (h::l) ==> SUM (h::l) <= LENGTH (h::l) * list_lcm (h::l)
7411 Note EVERY_POSITIVE (h::l)
7412 ==> 0 < h and EVERY_POSITIVE l by EVERY_DEF
7413 ==> 0 < h and 0 < list_lcm l by list_lcm_pos
7414 If l = [], LENGTH l = 0.
7415 SUM (h::[]) = SUM [h] = h by SUM
7416 LENGTH (h::[]) * list_lcm (h::[])
7417 = 1 * list_lcm [h] by ONE
7418 = 1 * h by list_lcm_sing
7419 = h by MULT_LEFT_1
7420 If l <> [], LENGTH l <> 0 by LENGTH_NIL ... [1]
7421 SUM (h::l)
7422 = h + SUM l by SUM
7423 <= h + LENGTH l * list_lcm l by induction hypothesis
7424 <= lcm h (list_lcm l) + LENGTH l * list_lcm l by LCM_LE, 0 < h
7425 <= lcm h (list_lcm l) + LENGTH l * (lcm h (list_lcm l)) by LCM_LE, 0 < list_lcm l, [1]
7426 = (1 + LENGTH l) * (lcm h (list_lcm l)) by RIGHT_ADD_DISTRIB
7427 = SUC (LENGTH l) * (lcm h (list_lcm l)) by SUC_ONE_ADD
7428 = LENGTH (h::l) * (lcm h (list_lcm l)) by LENGTH
7429 = LENGTH (h::l) * list_lcm (h::l) by list_lcm_cons
7430*)
7431Theorem list_lcm_lower_bound:
7432 !l. EVERY_POSITIVE l ==> SUM l <= (LENGTH l) * list_lcm l
7433Proof
7434 Induct >>
7435 rw[] >>
7436 Cases_on `l = []` >-
7437 rw[] >>
7438 `lcm h (list_lcm l) + LENGTH l * (lcm h (list_lcm l)) = SUC (LENGTH l) * (lcm h (list_lcm l))` by rw[RIGHT_ADD_DISTRIB, SUC_ONE_ADD] >>
7439 `LENGTH l <> 0` by metis_tac[LENGTH_NIL] >>
7440 `0 < list_lcm l` by rw[list_lcm_pos] >>
7441 `h <= lcm h (list_lcm l) /\ list_lcm l <= lcm h (list_lcm l)` by rw[LCM_LE] >>
7442 `LENGTH l * list_lcm l <= LENGTH l * (lcm h (list_lcm l))` by rw[LE_MULT_LCANCEL] >>
7443 `h + SUM l <= h + LENGTH l * list_lcm l` by rw[] >>
7444 decide_tac
7445QED
7446
7447(* Another version to eliminate EVERY by MEM. *)
7448Theorem list_lcm_lower_bound_alt =
7449 list_lcm_lower_bound |> SIMP_RULE (srw_ss()) [EVERY_MEM];
7450(* > list_lcm_lower_bound_alt;
7451val it = |- !l. POSITIVE l ==> SUM l <= LENGTH l * list_lcm l: thm
7452*)
7453
7454(* Theorem: list_lcm l is a common multiple of its members.
7455 MEM x l ==> x divides (list_lcm l) *)
7456(* Proof:
7457 By induction on l.
7458 Base case: !x. MEM x [] ==> x divides (list_lcm [])
7459 True since MEM x [] = F by MEM
7460 Step case: !x. MEM x l ==> x divides (list_lcm l) ==>
7461 !h x. MEM x (h::l) ==> x divides (list_lcm (h::l))
7462 Note MEM x (h::l) <=> x = h, or MEM x l by MEM
7463 and list_lcm (h::l) = lcm h (list_lcm l) by list_lcm_cons
7464 If x = h,
7465 divides h (lcm h (list_lcm l)) is true by LCM_IS_LEAST_COMMON_MULTIPLE
7466 If MEM x l,
7467 x divides (list_lcm l) by induction hypothesis
7468 (list_lcm l) divides (lcm h (list_lcm l)) by LCM_IS_LEAST_COMMON_MULTIPLE
7469 Hence x divides (lcm h (list_lcm l)) by DIVIDES_TRANS
7470*)
7471Theorem list_lcm_is_common_multiple:
7472 !x l. MEM x l ==> x divides (list_lcm l)
7473Proof
7474 Induct_on `l` >>
7475 rw[] >>
7476 metis_tac[LCM_IS_LEAST_COMMON_MULTIPLE, DIVIDES_TRANS]
7477QED
7478
7479(* Theorem: If m is a common multiple of members of l, (list_lcm l) divides m.
7480 (!x. MEM x l ==> x divides m) ==> (list_lcm l) divides m *)
7481(* Proof:
7482 By induction on l.
7483 Base case: !m. (!x. MEM x [] ==> x divides m) ==> divides (list_lcm []) m
7484 Since list_lcm [] = 1 by list_lcm_nil
7485 and divides 1 m is true by ONE_DIVIDES_ALL
7486 Step case: !m. (!x. MEM x l ==> x divides m) ==> (list_lcm l) divides m ==>
7487 !h m. (!x. MEM x (h::l) ==> x divides m) ==> divides (list_lcm (h::l)) m
7488 Note MEM x (h::l) <=> x = h, or MEM x l by MEM
7489 and list_lcm (h::l) = lcm h (list_lcm l) by list_lcm_cons
7490 Put x = h, divides h m by MEM h (h::l) = T
7491 Put MEM x l, x divides m by MEM x (h::l) = T
7492 giving (list_lcm l) divides m by induction hypothesis
7493 Hence divides (lcm h (list_lcm l)) m by LCM_IS_LEAST_COMMON_MULTIPLE
7494*)
7495Theorem list_lcm_is_least_common_multiple:
7496 !l m. (!x. MEM x l ==> x divides m) ==> (list_lcm l) divides m
7497Proof
7498 Induct >-
7499 rw[] >>
7500 rw[LCM_IS_LEAST_COMMON_MULTIPLE]
7501QED
7502
7503(*
7504> EVAL ``list_lcm []``;
7505val it = |- list_lcm [] = 1: thm
7506> EVAL ``list_lcm [1; 2; 3]``;
7507val it = |- list_lcm [1; 2; 3] = 6: thm
7508> EVAL ``list_lcm [1; 2; 3; 4; 5]``;
7509val it = |- list_lcm [1; 2; 3; 4; 5] = 60: thm
7510> EVAL ``list_lcm (GENLIST SUC 5)``;
7511val it = |- list_lcm (GENLIST SUC 5) = 60: thm
7512> EVAL ``list_lcm (GENLIST SUC 4)``;
7513val it = |- list_lcm (GENLIST SUC 4) = 12: thm
7514> EVAL ``lcm 5 (list_lcm (GENLIST SUC 4))``;
7515val it = |- lcm 5 (list_lcm (GENLIST SUC 4)) = 60: thm
7516> EVAL ``SNOC 5 (GENLIST SUC 4)``;
7517val it = |- SNOC 5 (GENLIST SUC 4) = [1; 2; 3; 4; 5]: thm
7518> EVAL ``list_lcm (SNOC 5 (GENLIST SUC 4))``;
7519val it = |- list_lcm (SNOC 5 (GENLIST SUC 4)) = 60: thm
7520> EVAL ``GENLIST (\k. leibniz 5 k) (SUC 5)``;
7521val it = |- GENLIST (\k. leibniz 5 k) (SUC 5) = [6; 30; 60; 60; 30; 6]: thm
7522> EVAL ``list_lcm (GENLIST (\k. leibniz 5 k) (SUC 5))``;
7523val it = |- list_lcm (GENLIST (\k. leibniz 5 k) (SUC 5)) = 60: thm
7524> EVAL ``list_lcm (GENLIST SUC 5) = list_lcm (GENLIST (\k. leibniz 5 k) (SUC 5))``;
7525val it = |- (list_lcm (GENLIST SUC 5) = list_lcm (GENLIST (\k. leibniz 5 k) (SUC 5))) <=> T: thm
7526> EVAL ``list_lcm (GENLIST SUC 5) = list_lcm (GENLIST (leibniz 5) (SUC 5))``;
7527val it = |- (list_lcm (GENLIST SUC 5) = list_lcm (GENLIST (leibniz 5) (SUC 5))) <=> T: thm
7528*)
7529
7530(* Theorem: list_lcm (l1 ++ l2) = lcm (list_lcm l1) (list_lcm l2) *)
7531(* Proof:
7532 By induction on l1.
7533 Base: !l2. list_lcm ([] ++ l2) = lcm (list_lcm []) (list_lcm l2)
7534 LHS = list_lcm ([] ++ l2)
7535 = list_lcm l2 by APPEND
7536 = lcm 1 (list_lcm l2) by LCM_1
7537 = lcm (list_lcm []) (list_lcm l2) by list_lcm_nil
7538 = RHS
7539 Step: !l2. list_lcm (l1 ++ l2) = lcm (list_lcm l1) (list_lcm l2) ==>
7540 !h l2. list_lcm (h::l1 ++ l2) = lcm (list_lcm (h::l1)) (list_lcm l2)
7541 list_lcm (h::l1 ++ l2)
7542 = list_lcm (h::(l1 ++ l2)) by APPEND
7543 = lcm h (list_lcm (l1 ++ l2)) by list_lcm_cons
7544 = lcm h (lcm (list_lcm l1) (list_lcm l2)) by induction hypothesis
7545 = lcm (lcm h (list_lcm l1)) (list_lcm l2) by LCM_ASSOC
7546 = lcm (list_lcm (h::l1)) (list_lcm l2) by list_lcm_cons
7547*)
7548Theorem list_lcm_append:
7549 !l1 l2. list_lcm (l1 ++ l2) = lcm (list_lcm l1) (list_lcm l2)
7550Proof
7551 Induct >-
7552 rw[] >>
7553 rw[LCM_ASSOC]
7554QED
7555
7556(* Theorem: list_lcm (l1 ++ l2 ++ l3) = list_lcm [(list_lcm l1); (list_lcm l2); (list_lcm l3)] *)
7557(* Proof:
7558 list_lcm (l1 ++ l2 ++ l3)
7559 = lcm (list_lcm (l1 ++ l2)) (list_lcm l3) by list_lcm_append
7560 = lcm (lcm (list_lcm l1) (list_lcm l2)) (list_lcm l3) by list_lcm_append
7561 = lcm (list_lcm l1) (lcm (list_lcm l2) (list_lcm l3)) by LCM_ASSOC
7562 = lcm (list_lcm l1) (list_lcm [(list_lcm l2); list_lcm l3]) by list_lcm_cons
7563 = list_lcm [list_lcm l1; list_lcm l2; list_lcm l3] by list_lcm_cons
7564*)
7565Theorem list_lcm_append_3:
7566 !l1 l2 l3. list_lcm (l1 ++ l2 ++ l3) = list_lcm [(list_lcm l1); (list_lcm l2); (list_lcm l3)]
7567Proof
7568 rw[list_lcm_append, LCM_ASSOC, list_lcm_cons]
7569QED
7570
7571(* Theorem: list_lcm (REVERSE l) = list_lcm l *)
7572(* Proof:
7573 By induction on l.
7574 Base: list_lcm (REVERSE []) = list_lcm []
7575 True since REVERSE [] = [] by REVERSE_DEF
7576 Step: list_lcm (REVERSE l) = list_lcm l ==>
7577 !h. list_lcm (REVERSE (h::l)) = list_lcm (h::l)
7578 list_lcm (REVERSE (h::l))
7579 = list_lcm (REVERSE l ++ [h]) by REVERSE_DEF
7580 = lcm (list_lcm (REVERSE l)) (list_lcm [h]) by list_lcm_append
7581 = lcm (list_lcm l) (list_lcm [h]) by induction hypothesis
7582 = lcm (list_lcm [h]) (list_lcm l) by LCM_COMM
7583 = list_lcm ([h] ++ l) by list_lcm_append
7584 = list_lcm (h::l) by CONS_APPEND
7585*)
7586Theorem list_lcm_reverse:
7587 !l. list_lcm (REVERSE l) = list_lcm l
7588Proof
7589 Induct >-
7590 rw[] >>
7591 rpt strip_tac >>
7592 `list_lcm (REVERSE (h::l)) = list_lcm (REVERSE l ++ [h])` by rw[] >>
7593 `_ = lcm (list_lcm (REVERSE l)) (list_lcm [h])` by rw[list_lcm_append] >>
7594 `_ = lcm (list_lcm l) (list_lcm [h])` by rw[] >>
7595 `_ = lcm (list_lcm [h]) (list_lcm l)` by rw[LCM_COMM] >>
7596 `_ = list_lcm ([h] ++ l)` by rw[list_lcm_append] >>
7597 `_ = list_lcm (h::l)` by rw[] >>
7598 decide_tac
7599QED
7600
7601(* Theorem: list_lcm [1 .. (n + 1)] = lcm (n + 1) (list_lcm [1 .. n])) *)
7602(* Proof:
7603 list_lcm [1 .. (n + 1)]
7604 = list_lcm (SONC (n + 1) [1 .. n]) by listRangeINC_SNOC, 1 <= n + 1
7605 = lcm (n + 1) (list_lcm [1 .. n]) by list_lcm_snoc
7606*)
7607Theorem list_lcm_suc:
7608 !n. list_lcm [1 .. (n + 1)] = lcm (n + 1) (list_lcm [1 .. n])
7609Proof
7610 rw[listRangeINC_SNOC, list_lcm_snoc]
7611QED
7612
7613(* Theorem: l <> [] /\ EVERY_POSITIVE l ==> (SUM l) DIV (LENGTH l) <= list_lcm l *)
7614(* Proof:
7615 Note LENGTH l <> 0 by LENGTH_NIL
7616 and SUM l <= LENGTH l * list_lcm l by list_lcm_lower_bound
7617 so (SUM l) DIV (LENGTH l) <= list_lcm l by DIV_LE
7618*)
7619Theorem list_lcm_nonempty_lower:
7620 !l. l <> [] /\ EVERY_POSITIVE l ==> (SUM l) DIV (LENGTH l) <= list_lcm l
7621Proof
7622 metis_tac[list_lcm_lower_bound, DIV_LE, LENGTH_NIL, NOT_ZERO_LT_ZERO]
7623QED
7624
7625(* Theorem: l <> [] /\ POSITIVE l ==> (SUM l) DIV (LENGTH l) <= list_lcm l *)
7626(* Proof:
7627 Note LENGTH l <> 0 by LENGTH_NIL
7628 and SUM l <= LENGTH l * list_lcm l by list_lcm_lower_bound_alt
7629 so (SUM l) DIV (LENGTH l) <= list_lcm l by DIV_LE
7630*)
7631Theorem list_lcm_nonempty_lower_alt:
7632 !l. l <> [] /\ POSITIVE l ==> (SUM l) DIV (LENGTH l) <= list_lcm l
7633Proof
7634 metis_tac[list_lcm_lower_bound_alt, DIV_LE, LENGTH_NIL, NOT_ZERO_LT_ZERO]
7635QED
7636
7637(* Theorem: MEM x l /\ MEM y l ==> (lcm x y) <= list_lcm l *)
7638(* Proof:
7639 Note x divides (list_lcm l) by list_lcm_is_common_multiple
7640 and y divides (list_lcm l) by list_lcm_is_common_multiple
7641 ==> (lcm x y) divides (list_lcm l) by LCM_IS_LEAST_COMMON_MULTIPLE
7642*)
7643Theorem list_lcm_divisor_lcm_pair:
7644 !l x y. MEM x l /\ MEM y l ==> (lcm x y) divides list_lcm l
7645Proof
7646 rw[list_lcm_is_common_multiple, LCM_IS_LEAST_COMMON_MULTIPLE]
7647QED
7648
7649(* Theorem: POSITIVE l /\ MEM x l /\ MEM y l ==> (lcm x y) <= list_lcm l *)
7650(* Proof:
7651 Note (lcm x y) divides (list_lcm l) by list_lcm_divisor_lcm_pair
7652 Now 0 < list_lcm l by list_lcm_pos_alt
7653 Thus (lcm x y) <= list_lcm l by DIVIDES_LE
7654*)
7655Theorem list_lcm_lower_by_lcm_pair:
7656 !l x y. POSITIVE l /\ MEM x l /\ MEM y l ==> (lcm x y) <= list_lcm l
7657Proof
7658 rw[list_lcm_divisor_lcm_pair, list_lcm_pos_alt, DIVIDES_LE]
7659QED
7660
7661(* Theorem: 0 < m /\ (!x. MEM x l ==> x divides m) ==> list_lcm l <= m *)
7662(* Proof:
7663 Note list_lcm l divides m by list_lcm_is_least_common_multiple
7664 Thus list_lcm l <= m by DIVIDES_LE, 0 < m
7665*)
7666Theorem list_lcm_upper_by_common_multiple:
7667 !l m. 0 < m /\ (!x. MEM x l ==> x divides m) ==> list_lcm l <= m
7668Proof
7669 rw[list_lcm_is_least_common_multiple, DIVIDES_LE]
7670QED
7671
7672(* Theorem: list_lcm ls = FOLDR lcm 1 ls *)
7673(* Proof:
7674 By induction on ls.
7675 Base: list_lcm [] = FOLDR lcm 1 []
7676 list_lcm []
7677 = 1 by list_lcm_nil
7678 = FOLDR lcm 1 [] by FOLDR
7679 Step: list_lcm ls = FOLDR lcm 1 ls ==>
7680 !h. list_lcm (h::ls) = FOLDR lcm 1 (h::ls)
7681 list_lcm (h::ls)
7682 = lcm h (list_lcm ls) by list_lcm_def
7683 = lcm h (FOLDR lcm 1 ls) by induction hypothesis
7684 = FOLDR lcm 1 (h::ls) by FOLDR
7685*)
7686Theorem list_lcm_by_FOLDR:
7687 !ls. list_lcm ls = FOLDR lcm 1 ls
7688Proof
7689 Induct >> rw[]
7690QED
7691
7692(* Theorem: list_lcm ls = FOLDL lcm 1 ls *)
7693(* Proof:
7694 Note COMM lcm since !x y. lcm x y = lcm y x by LCM_COMM
7695 and ASSOC lcm since !x y z. lcm x (lcm y z) = lcm (lcm x y) z by LCM_ASSOC
7696 Now list_lcm ls
7697 = FOLDR lcm 1 ls by list_lcm_by FOLDR
7698 = FOLDL lcm 1 ls by FOLDL_EQ_FOLDR, COMM lcm, ASSOC lcm
7699*)
7700Theorem list_lcm_by_FOLDL:
7701 !ls. list_lcm ls = FOLDL lcm 1 ls
7702Proof
7703 simp[list_lcm_by_FOLDR] >>
7704 irule (GSYM FOLDL_EQ_FOLDR) >>
7705 rpt strip_tac >-
7706 rw[LCM_ASSOC, combinTheory.ASSOC_DEF] >>
7707 rw[LCM_COMM, combinTheory.COMM_DEF]
7708QED
7709
7710(* ------------------------------------------------------------------------- *)
7711(* Lists in Leibniz Triangle *)
7712(* ------------------------------------------------------------------------- *)
7713
7714(* ------------------------------------------------------------------------- *)
7715(* Vertical Lists in Leibniz Triangle *)
7716(* ------------------------------------------------------------------------- *)
7717
7718(* Define Vertical List in Leibniz Triangle *)
7719(*
7720val leibniz_vertical_def = Define `
7721 leibniz_vertical n = GENLIST SUC (SUC n)
7722`;
7723
7724(* Use overloading for leibniz_vertical n. *)
7725val _ = overload_on("leibniz_vertical", ``\n. GENLIST ((+) 1) (n + 1)``);
7726*)
7727
7728(* Define Vertical (downward list) in Leibniz Triangle *)
7729
7730(* Use overloading for leibniz_vertical n. *)
7731Overload leibniz_vertical = ``\n. [1 .. (n+1)]``
7732
7733(* Theorem: leibniz_vertical n = GENLIST (\i. 1 + i) (n + 1) *)
7734(* Proof:
7735 leibniz_vertical n
7736 = [1 .. (n+1)] by notation
7737 = GENLIST (\i. 1 + i) (n+1 + 1 - 1) by listRangeINC_def
7738 = GENLIST (\i. 1 + i) (n + 1) by arithmetic
7739*)
7740Theorem leibniz_vertical_alt:
7741 !n. leibniz_vertical n = GENLIST (\i. 1 + i) (n + 1)
7742Proof
7743 rw[listRangeINC_def]
7744QED
7745
7746(* Theorem: leibniz_vertical 0 = [1] *)
7747(* Proof:
7748 leibniz_vertical 0
7749 = [1 .. (0+1)] by notation
7750 = [1 .. 1] by arithmetic
7751 = [1] by listRangeINC_SING
7752*)
7753Theorem leibniz_vertical_0:
7754 leibniz_vertical 0 = [1]
7755Proof
7756 rw[]
7757QED
7758
7759(* Theorem: LENGTH (leibniz_vertical n) = n + 1 *)
7760(* Proof:
7761 LENGTH (leibniz_vertical n)
7762 = LENGTH [1 .. (n+1)] by notation
7763 = n + 1 + 1 - 1 by listRangeINC_LEN
7764 = n + 1 by arithmetic
7765*)
7766Theorem leibniz_vertical_len:
7767 !n. LENGTH (leibniz_vertical n) = n + 1
7768Proof
7769 rw[listRangeINC_LEN]
7770QED
7771
7772(* Theorem: leibniz_vertical n <> [] *)
7773(* Proof:
7774 LENGTH (leibniz_vertical n)
7775 = n + 1 by leibniz_vertical_len
7776 <> 0 by ADD1, SUC_NOT_ZERO
7777 Thus leibniz_vertical n <> [] by LENGTH_EQ_0
7778*)
7779Theorem leibniz_vertical_not_nil:
7780 !n. leibniz_vertical n <> []
7781Proof
7782 metis_tac[leibniz_vertical_len, LENGTH_EQ_0, DECIDE``!n. n + 1 <> 0``]
7783QED
7784
7785(* Theorem: EVERY_POSITIVE (leibniz_vertical n) *)
7786(* Proof:
7787 EVERY_POSITIVE (leibniz_vertical n)
7788 <=> EVERY_POSITIVE GENLIST (\i. 1 + i) (n+1) by leibniz_vertical_alt
7789 <=> !i. i < n + 1 ==> 0 < 1 + i by EVERY_GENLIST
7790 <=> !i. i < n + 1 ==> T by arithmetic
7791 <=> T
7792*)
7793Theorem leibniz_vertical_pos:
7794 !n. EVERY_POSITIVE (leibniz_vertical n)
7795Proof
7796 rw[leibniz_vertical_alt, EVERY_GENLIST]
7797QED
7798
7799(* Theorem: POSITIVE (leibniz_vertical n) *)
7800(* Proof: by leibniz_vertical_pos, EVERY_MEM *)
7801Theorem leibniz_vertical_pos_alt:
7802 !n. POSITIVE (leibniz_vertical n)
7803Proof
7804 rw[leibniz_vertical_pos, EVERY_MEM]
7805QED
7806
7807(* Theorem: 0 < x /\ x <= (n + 1) <=> MEM x (leibniz_vertical n) *)
7808(* Proof:
7809 Note: (leibniz_vertical n) has 1 to (n+1), inclusive:
7810 MEM x (leibniz_vertical n)
7811 <=> MEM x [1 .. (n+1)] by notation
7812 <=> 1 <= x /\ x <= n + 1 by listRangeINC_MEM
7813 <=> 0 < x /\ x <= n + 1 by num_CASES, LESS_EQ_MONO
7814*)
7815Theorem leibniz_vertical_mem:
7816 !n x. 0 < x /\ x <= (n + 1) <=> MEM x (leibniz_vertical n)
7817Proof
7818 rw[]
7819QED
7820
7821(* Theorem: leibniz_vertical (n + 1) = SNOC (n + 2) (leibniz_vertical n) *)
7822(* Proof:
7823 leibniz_vertical (n + 1)
7824 = [1 .. (n+1 +1)] by notation
7825 = SNOC (n+1 + 1) [1 .. (n+1)] by listRangeINC_SNOC
7826 = SNOC (n + 2) (leibniz_vertical n) by notation
7827*)
7828Theorem leibniz_vertical_snoc:
7829 !n. leibniz_vertical (n + 1) = SNOC (n + 2) (leibniz_vertical n)
7830Proof
7831 rw[listRangeINC_SNOC]
7832QED
7833
7834(* Use overloading for leibniz_up n. *)
7835Overload leibniz_up = ``\n. REVERSE (leibniz_vertical n)``
7836
7837(* Theorem: leibniz_up 0 = [1] *)
7838(* Proof:
7839 leibniz_up 0
7840 = REVERSE (leibniz_vertical 0) by notation
7841 = REVERSE [1] by leibniz_vertical_0
7842 = [1] by REVERSE_SING
7843*)
7844Theorem leibniz_up_0:
7845 leibniz_up 0 = [1]
7846Proof
7847 rw[]
7848QED
7849
7850(* Theorem: LENGTH (leibniz_up n) = n + 1 *)
7851(* Proof:
7852 LENGTH (leibniz_up n)
7853 = LENGTH (REVERSE (leibniz_vertical n)) by notation
7854 = LENGTH (leibniz_vertical n) by LENGTH_REVERSE
7855 = n + 1 by leibniz_vertical_len
7856*)
7857Theorem leibniz_up_len:
7858 !n. LENGTH (leibniz_up n) = n + 1
7859Proof
7860 rw[leibniz_vertical_len]
7861QED
7862
7863(* Theorem: EVERY_POSITIVE (leibniz_up n) *)
7864(* Proof:
7865 EVERY_POSITIVE (leibniz_up n)
7866 <=> EVERY_POSITIVE (REVERSE (leibniz_vertical n)) by notation
7867 <=> EVERY_POSITIVE (leibniz_vertical n) by EVERY_REVERSE
7868 <=> T by leibniz_vertical_pos
7869*)
7870Theorem leibniz_up_pos:
7871 !n. EVERY_POSITIVE (leibniz_up n)
7872Proof
7873 rw[leibniz_vertical_pos, EVERY_REVERSE]
7874QED
7875
7876(* Theorem: 0 < x /\ x <= (n + 1) <=> MEM x (leibniz_up n) *)
7877(* Proof:
7878 Note: (leibniz_up n) has (n+1) downto 1, inclusive:
7879 MEM x (leibniz_up n)
7880 <=> MEM x (REVERSE (leibniz_vertical n)) by notation
7881 <=> MEM x (leibniz_vertical n) by MEM_REVERSE
7882 <=> T by leibniz_vertical_mem
7883*)
7884Theorem leibniz_up_mem:
7885 !n x. 0 < x /\ x <= (n + 1) <=> MEM x (leibniz_up n)
7886Proof
7887 rw[]
7888QED
7889
7890(* Theorem: leibniz_up (n + 1) = (n + 2) :: (leibniz_up n) *)
7891(* Proof:
7892 leibniz_up (n + 1)
7893 = REVERSE (leibniz_vertical (n + 1)) by notation
7894 = REVERSE (SNOC (n + 2) (leibniz_vertical n)) by leibniz_vertical_snoc
7895 = (n + 2) :: (leibniz_up n) by REVERSE_SNOC
7896*)
7897Theorem leibniz_up_cons:
7898 !n. leibniz_up (n + 1) = (n + 2) :: (leibniz_up n)
7899Proof
7900 rw[leibniz_vertical_snoc, REVERSE_SNOC]
7901QED
7902
7903(* ------------------------------------------------------------------------- *)
7904(* Horizontal List in Leibniz Triangle *)
7905(* ------------------------------------------------------------------------- *)
7906
7907(* Define row (horizontal list) in Leibniz Triangle *)
7908(*
7909val leibniz_horizontal_def = Define `
7910 leibniz_horizontal n = GENLIST (leibniz n) (SUC n)
7911`;
7912
7913(* Use overloading for leibniz_horizontal n. *)
7914val _ = overload_on("leibniz_horizontal", ``\n. GENLIST (leibniz n) (n + 1)``);
7915*)
7916
7917(* Use overloading for leibniz_horizontal n. *)
7918Overload leibniz_horizontal = ``\n. GENLIST (leibniz n) (n + 1)``
7919
7920(*
7921> EVAL ``leibniz_horizontal 0``;
7922val it = |- leibniz_horizontal 0 = [1]: thm
7923> EVAL ``leibniz_horizontal 1``;
7924val it = |- leibniz_horizontal 1 = [2; 2]: thm
7925> EVAL ``leibniz_horizontal 2``;
7926val it = |- leibniz_horizontal 2 = [3; 6; 3]: thm
7927> EVAL ``leibniz_horizontal 3``;
7928val it = |- leibniz_horizontal 3 = [4; 12; 12; 4]: thm
7929> EVAL ``leibniz_horizontal 4``;
7930val it = |- leibniz_horizontal 4 = [5; 20; 30; 20; 5]: thm
7931> EVAL ``leibniz_horizontal 5``;
7932val it = |- leibniz_horizontal 5 = [6; 30; 60; 60; 30; 6]: thm
7933> EVAL ``leibniz_horizontal 6``;
7934val it = |- leibniz_horizontal 6 = [7; 42; 105; 140; 105; 42; 7]: thm
7935> EVAL ``leibniz_horizontal 7``;
7936val it = |- leibniz_horizontal 7 = [8; 56; 168; 280; 280; 168; 56; 8]: thm
7937> EVAL ``leibniz_horizontal 8``;
7938val it = |- leibniz_horizontal 8 = [9; 72; 252; 504; 630; 504; 252; 72; 9]: thm
7939*)
7940
7941(* Theorem: leibniz_horizontal 0 = [1] *)
7942(* Proof:
7943 leibniz_horizontal 0
7944 = GENLIST (leibniz 0) (0 + 1) by notation
7945 = GENLIST (leibniz 0) 1 by arithmetic
7946 = [leibniz 0 0] by GENLIST
7947 = [1] by leibniz_n_0
7948*)
7949Theorem leibniz_horizontal_0:
7950 leibniz_horizontal 0 = [1]
7951Proof
7952 rw_tac std_ss[GENLIST_1, leibniz_n_0]
7953QED
7954
7955(* Theorem: LENGTH (leibniz_horizontal n) = n + 1 *)
7956(* Proof:
7957 LENGTH (leibniz_horizontal n)
7958 = LENGTH (GENLIST (leibniz n) (n + 1)) by notation
7959 = n + 1 by LENGTH_GENLIST
7960*)
7961Theorem leibniz_horizontal_len:
7962 !n. LENGTH (leibniz_horizontal n) = n + 1
7963Proof
7964 rw[]
7965QED
7966
7967(* Theorem: k <= n ==> EL k (leibniz_horizontal n) = leibniz n k *)
7968(* Proof:
7969 Note k <= n means k < SUC n.
7970 EL k (leibniz_horizontal n)
7971 = EL k (GENLIST (leibniz n) (n + 1)) by notation
7972 = EL k (GENLIST (leibniz n) (SUC n)) by ADD1
7973 = leibniz n k by EL_GENLIST, k < SUC n.
7974*)
7975Theorem leibniz_horizontal_el:
7976 !n k. k <= n ==> (EL k (leibniz_horizontal n) = leibniz n k)
7977Proof
7978 rw[LESS_EQ_IMP_LESS_SUC]
7979QED
7980
7981(* Theorem: k <= n ==> MEM (leibniz n k) (leibniz_horizontal n) *)
7982(* Proof:
7983 Note k <= n ==> k < (n + 1)
7984 Thus MEM (leibniz n k) (GENLIST (leibniz n) (n + 1)) by MEM_GENLIST
7985 or MEM (leibniz n k) (leibniz_horizontal n) by notation
7986*)
7987Theorem leibniz_horizontal_mem:
7988 !n k. k <= n ==> MEM (leibniz n k) (leibniz_horizontal n)
7989Proof
7990 metis_tac[MEM_GENLIST, DECIDE``k <= n ==> k < n + 1``]
7991QED
7992
7993(* Theorem: MEM (leibniz n k) (leibniz_horizontal n) <=> k <= n *)
7994(* Proof:
7995 If part: (leibniz n k) (leibniz_horizontal n) ==> k <= n
7996 By contradiction, suppose n < k.
7997 Then leibniz n k = 0 by binomial_less_0, ~(k <= n)
7998 But ?m. m < n + 1 ==> 0 = leibniz n m by MEM_GENLIST
7999 or m <= n ==> leibniz n m = 0 by m < n + 1
8000 Yet leibniz n m <> 0 by leibniz_eq_0
8001 This is a contradiction.
8002 Only-if part: k <= n ==> (leibniz n k) (leibniz_horizontal n)
8003 By MEM_GENLIST, this is to show:
8004 ?m. m < n + 1 /\ (leibniz n k = leibniz n m)
8005 Note k <= n ==> k < n + 1,
8006 Take m = k, the result follows.
8007*)
8008Theorem leibniz_horizontal_mem_iff:
8009 !n k. MEM (leibniz n k) (leibniz_horizontal n) <=> k <= n
8010Proof
8011 rw_tac bool_ss[EQ_IMP_THM] >| [
8012 spose_not_then strip_assume_tac >>
8013 `leibniz n k = 0` by rw[leibniz_less_0] >>
8014 fs[MEM_GENLIST] >>
8015 `m <= n` by decide_tac >>
8016 fs[binomial_eq_0],
8017 rw[MEM_GENLIST] >>
8018 `k < n + 1` by decide_tac >>
8019 metis_tac[]
8020 ]
8021QED
8022
8023(* Theorem: MEM x (leibniz_horizontal n) <=> ?k. k <= n /\ (x = leibniz n k) *)
8024(* Proof:
8025 By MEM_GENLIST, this is to show:
8026 (?m. m < n + 1 /\ (x = (n + 1) * binomial n m)) <=> ?k. k <= n /\ (x = (n + 1) * binomial n k)
8027 Since m < n + 1 <=> m <= n by LE_LT1
8028 This is trivially true.
8029*)
8030Theorem leibniz_horizontal_member:
8031 !n x. MEM x (leibniz_horizontal n) <=> ?k. k <= n /\ (x = leibniz n k)
8032Proof
8033 metis_tac[MEM_GENLIST, LE_LT1]
8034QED
8035
8036(* Theorem: k <= n ==> (EL k (leibniz_horizontal n) = leibniz n k) *)
8037(* Proof: by EL_GENLIST *)
8038Theorem leibniz_horizontal_element:
8039 !n k. k <= n ==> (EL k (leibniz_horizontal n) = leibniz n k)
8040Proof
8041 rw[EL_GENLIST]
8042QED
8043
8044(* Theorem: TAKE 1 (leibniz_horizontal (n + 1)) = [n + 2] *)
8045(* Proof:
8046 TAKE 1 (leibniz_horizontal (n + 1))
8047 = TAKE 1 (GENLIST (leibniz (n + 1)) (n + 1 + 1)) by notation
8048 = TAKE 1 (GENLIST (leibniz (SUC n)) (SUC (SUC n))) by ADD1
8049 = TAKE 1 ((leibniz (SUC n) 0) :: GENLIST ((leibniz (SUC n)) o SUC) n) by GENLIST_CONS
8050 = (leibniz (SUC n) 0):: TAKE 0 (GENLIST ((leibniz (SUC n)) o SUC) n) by TAKE_def
8051 = [leibniz (SUC n) 0]:: [] by TAKE_0
8052 = [SUC n + 1] by leibniz_n_0
8053 = [n + 2] by ADD1
8054*)
8055Theorem leibniz_horizontal_head:
8056 !n. TAKE 1 (leibniz_horizontal (n + 1)) = [n + 2]
8057Proof
8058 rpt strip_tac >>
8059 `(!n. n + 1 = SUC n) /\ (!n. n + 2 = SUC (SUC n))` by decide_tac >>
8060 rw[GENLIST_CONS, leibniz_n_0]
8061QED
8062
8063(* Theorem: k <= n ==> (leibniz n k) divides list_lcm (leibniz_horizontal n) *)
8064(* Proof:
8065 Note MEM (leibniz n k) (leibniz_horizontal n) by leibniz_horizontal_mem
8066 so (leibniz n k) divides list_lcm (leibniz_horizontal n) by list_lcm_is_common_multiple
8067*)
8068Theorem leibniz_horizontal_divisor:
8069 !n k. k <= n ==> (leibniz n k) divides list_lcm (leibniz_horizontal n)
8070Proof
8071 rw[leibniz_horizontal_mem, list_lcm_is_common_multiple]
8072QED
8073
8074(* Theorem: EVERY_POSITIVE (leibniz_horizontal n) *)
8075(* Proof:
8076 Let l = leibniz_horizontal n
8077 Then LENGTH l = n + 1 by leibniz_horizontal_len
8078 EVERY_POSITIVE l
8079 <=> !k. k < LENGTH l ==> 0 < (EL k l) by EVERY_EL
8080 <=> !k. k < n + 1 ==> 0 < (EL k l) by above
8081 <=> !k. k <= n ==> 0 < EL k l by arithmetic
8082 <=> !k. k <= n ==> 0 < leibniz n k by leibniz_horizontal_el
8083 <=> T by leibniz_pos
8084*)
8085Theorem leibniz_horizontal_pos:
8086 !n. EVERY_POSITIVE (leibniz_horizontal n)
8087Proof
8088 simp[EVERY_EL, binomial_pos]
8089QED
8090
8091(* Theorem: POSITIVE (leibniz_horizontal n) *)
8092(* Proof: by leibniz_horizontal_pos, EVERY_MEM *)
8093Theorem leibniz_horizontal_pos_alt:
8094 !n. POSITIVE (leibniz_horizontal n)
8095Proof
8096 metis_tac[leibniz_horizontal_pos, EVERY_MEM]
8097QED
8098
8099(* Theorem: leibniz_horizontal n = MAP (\j. (n+1) * j) (binomial_horizontal n) *)
8100(* Proof:
8101 leibniz_horizontal n
8102 = GENLIST (leibniz n) (n + 1) by notation
8103 = GENLIST ((\j. (n + 1) * j) o (binomial n)) (n + 1) by leibniz_alt
8104 = MAP (\j. (n + 1) * j) (GENLIST (binomial n) (n + 1)) by MAP_GENLIST
8105 = MAP (\j. (n + 1) * j) (binomial_horizontal n) by notation
8106*)
8107Theorem leibniz_horizontal_alt:
8108 !n. leibniz_horizontal n = MAP (\j. (n+1) * j) (binomial_horizontal n)
8109Proof
8110 rw_tac std_ss[leibniz_alt, MAP_GENLIST]
8111QED
8112
8113(* Theorem: list_lcm (leibniz_horizontal n) = (n + 1) * list_lcm (binomial_horizontal n) *)
8114(* Proof:
8115 Since LENGTH (binomial_horizontal n) = n + 1 by binomial_horizontal_len
8116 binomial_horizontal n <> [] by LENGTH_NIL ... [1]
8117 list_lcm (leibniz_horizontal n)
8118 = list_lcm (MAP (\j (n+1) * j) (binomial_horizontal n)) by leibniz_horizontal_alt
8119 = (n + 1) * list_lcm (binomial_horizontal n) by list_lcm_map_times, [1]
8120*)
8121Theorem leibniz_horizontal_lcm_alt:
8122 !n. list_lcm (leibniz_horizontal n) = (n + 1) * list_lcm (binomial_horizontal n)
8123Proof
8124 rpt strip_tac >>
8125 `LENGTH (binomial_horizontal n) = n + 1` by rw[binomial_horizontal_len] >>
8126 `n + 1 <> 0` by decide_tac >>
8127 `binomial_horizontal n <> []` by metis_tac[LENGTH_NIL] >>
8128 rw_tac std_ss[leibniz_horizontal_alt, list_lcm_map_times]
8129QED
8130
8131(* Theorem: SUM (leibniz_horizontal n) = (n + 1) * SUM (binomial_horizontal n) *)
8132(* Proof:
8133 SUM (leibniz_horizontal n)
8134 = SUM (MAP (\j. (n + 1) * j) (binomial_horizontal n)) by leibniz_horizontal_alt
8135 = (n + 1) * SUM (binomial_horizontal n) by SUM_MULT
8136*)
8137Theorem leibniz_horizontal_sum:
8138 !n. SUM (leibniz_horizontal n) = (n + 1) * SUM (binomial_horizontal n)
8139Proof
8140 rw[leibniz_horizontal_alt, SUM_MULT] >>
8141 `(\j. j * (n + 1)) = $* (n + 1)` by rw[FUN_EQ_THM] >>
8142 rw[]
8143QED
8144
8145(* Theorem: SUM (leibniz_horizontal n) = (n + 1) * 2 ** n *)
8146(* Proof:
8147 SUM (leibniz_horizontal n)
8148 = (n + 1) * SUM (binomial_horizontal n) by leibniz_horizontal_sum
8149 = (n + 1) * 2 ** n by binomial_horizontal_sum
8150*)
8151Theorem leibniz_horizontal_sum_eqn:
8152 !n. SUM (leibniz_horizontal n) = (n + 1) * 2 ** n
8153Proof
8154 rw[leibniz_horizontal_sum, binomial_horizontal_sum]
8155QED
8156
8157(* Theorem: SUM (leibniz_horizontal n) DIV LENGTH (leibniz_horizontal n) = SUM (binomial_horizontal n) *)
8158(* Proof:
8159 Note LENGTH (leibniz_horizontal n) = n + 1 by leibniz_horizontal_len
8160 so 0 < LENGTH (leibniz_horizontal n) by 0 < n + 1
8161
8162 SUM (leibniz_horizontal n) DIV LENGTH (leibniz_horizontal n)
8163 = ((n + 1) * SUM (binomial_horizontal n)) DIV (n + 1) by leibniz_horizontal_sum
8164 = SUM (binomial_horizontal n) by MULT_TO_DIV, 0 < n + 1
8165*)
8166Theorem leibniz_horizontal_average:
8167 !n. SUM (leibniz_horizontal n) DIV LENGTH (leibniz_horizontal n) = SUM (binomial_horizontal n)
8168Proof
8169 metis_tac[leibniz_horizontal_sum, leibniz_horizontal_len, MULT_TO_DIV, DECIDE``0 < n + 1``]
8170QED
8171
8172(* Theorem: SUM (leibniz_horizontal n) DIV LENGTH (leibniz_horizontal n) = 2 ** n *)
8173(* Proof:
8174 SUM (leibniz_horizontal n) DIV LENGTH (leibniz_horizontal n)
8175 = SUM (binomial_horizontal n) by leibniz_horizontal_average
8176 = 2 ** n by binomial_horizontal_sum
8177*)
8178Theorem leibniz_horizontal_average_eqn:
8179 !n. SUM (leibniz_horizontal n) DIV LENGTH (leibniz_horizontal n) = 2 ** n
8180Proof
8181 rw[leibniz_horizontal_average, binomial_horizontal_sum]
8182QED
8183
8184(* ------------------------------------------------------------------------- *)
8185(* Transform from Vertical LCM to Horizontal LCM. *)
8186(* ------------------------------------------------------------------------- *)
8187
8188(* ------------------------------------------------------------------------- *)
8189(* Using Triplet and Paths *)
8190(* ------------------------------------------------------------------------- *)
8191
8192(* Define a triple type *)
8193Datatype:
8194 triple = <| a: num;
8195 b: num;
8196 c: num
8197 |>
8198End
8199
8200(* A triplet is a triple composed of Leibniz node and children. *)
8201Definition triplet_def:
8202 (triplet n k):triple =
8203 <| a := leibniz n k;
8204 b := leibniz (n + 1) k;
8205 c := leibniz (n + 1) (k + 1)
8206 |>
8207End
8208
8209(* can even do this after definition of triple type:
8210
8211val triple_def = Define`
8212 triple n k =
8213 <| a := leibniz n k;
8214 b := leibniz (n + 1) k;
8215 c := leibniz (n + 1) (k + 1)
8216 |>
8217`;
8218*)
8219
8220(* Overload elements of a triplet *)
8221(*
8222val _ = overload_on("tri_a", ``leibniz n k``);
8223val _ = overload_on("tri_b", ``leibniz (SUC n) k``);
8224val _ = overload_on("tri_c", ``leibniz (SUC n) (SUC k)``);
8225
8226val _ = overload_on("tri_a", ``(triple n k).a``);
8227val _ = overload_on("tri_b", ``(triple n k).b``);
8228val _ = overload_on("tri_c", ``(triple n k).c``);
8229*)
8230Overload ta[local] = ``(triplet n k).a``
8231Overload tb[local] = ``(triplet n k).b``
8232Overload tc[local] = ``(triplet n k).c``
8233
8234(* Theorem: (ta = leibniz n k) /\ (tb = leibniz (n + 1) k) /\ (tc = leibniz (n + 1) (k + 1)) *)
8235(* Proof: by triplet_def *)
8236Theorem leibniz_triplet_member:
8237 !n k. (ta = leibniz n k) /\ (tb = leibniz (n + 1) k) /\ (tc = leibniz (n + 1) (k + 1))
8238Proof
8239 rw[triplet_def]
8240QED
8241
8242(* Theorem: (k + 1) * tc = (n + 1 - k) * tb *)
8243(* Proof:
8244 Apply: > leibniz_right_eqn |> SPEC ``n+1``;
8245 val it = |- 0 < n + 1 ==> !k. (k + 1) * leibniz (n + 1) (k + 1) = (n + 1 - k) * leibniz (n + 1) k: thm
8246*)
8247Theorem leibniz_right_entry:
8248 !(n k):num. (k + 1) * tc = (n + 1 - k) * tb
8249Proof
8250 rw_tac arith_ss[triplet_def, leibniz_right_eqn]
8251QED
8252
8253(* Theorem: (n + 2) * ta = (n + 1 - k) * tb *)
8254(* Proof:
8255 Apply: > leibniz_up_eqn |> SPEC ``n+1``;
8256 val it = |- 0 < n + 1 ==> !k. (n + 1 + 1) * leibniz (n + 1 - 1) k = (n + 1 - k) * leibniz (n + 1) k: thm
8257*)
8258Theorem leibniz_up_entry:
8259 !(n k):num. (n + 2) * ta = (n + 1 - k) * tb
8260Proof
8261 rw_tac std_ss[triplet_def, leibniz_up_eqn |> SPEC ``n+1`` |> SIMP_RULE arith_ss[]]
8262QED
8263
8264(* Theorem: ta * tb = tc * (tb - ta) *)
8265(* Proof:
8266 Apply > leibniz_property |> SPEC ``n+1``;
8267 val it = |- 0 < n + 1 ==> !k. !k. leibniz (n + 1) k * leibniz (n + 1 - 1) k =
8268 leibniz (n + 1) (k + 1) * (leibniz (n + 1) k - leibniz (n + 1 - 1) k): thm
8269*)
8270Theorem leibniz_triplet_property:
8271 !(n k):num. ta * tb = tc * (tb - ta)
8272Proof
8273 rw_tac std_ss[triplet_def, MULT_COMM, leibniz_property |> SPEC ``n+1`` |> SIMP_RULE arith_ss[]]
8274QED
8275
8276(* Direct proof of same result, for the paper. *)
8277
8278(* Theorem: ta * tb = tc * (tb - ta) *)
8279(* Proof:
8280 If n < k,
8281 Note n < k ==> ta = 0 by triplet_def, leibniz_less_0
8282 also n + 1 < k + 1 ==> tc = 0 by triplet_def, leibniz_less_0
8283 Thus ta * tb = 0 = tc * (tb - ta) by MULT_EQ_0
8284 If ~(n < k),
8285 Then (n + 2) - (n + 1 - k) = k + 1 by arithmetic, k <= n.
8286
8287 (k + 1) * ta * tb
8288 = (n + 2 - (n + 1 - k)) * ta * tb
8289 = (n + 2) * ta * tb - (n + 1 - k) * ta * tb by RIGHT_SUB_DISTRIB
8290 = (n + 1 - k) * tb * tb - (n + 1 - k) * ta * tb by leibniz_up_entry
8291 = (n + 1 - k) * tb * tb - (n + 1 - k) * tb * ta by MULT_ASSOC, MULT_COMM
8292 = (n + 1 - k) * tb * (tb - ta) by LEFT_SUB_DISTRIB
8293 = (k + 1) * tc * (tb - ta) by leibniz_right_entry
8294
8295 Since k + 1 <> 0, the result follows by MULT_LEFT_CANCEL
8296*)
8297Theorem leibniz_triplet_property[allow_rebind]:
8298 !n k:num. ta * tb = tc * (tb - ta)
8299Proof
8300 rpt strip_tac >>
8301 Cases_on ‘n < k’ >-
8302 rw[triplet_def, leibniz_less_0] >>
8303 ‘(n + 2) - (n + 1 - k) = k + 1’ by decide_tac >>
8304 ‘(k + 1) * ta * tb = (n + 2 - (n + 1 - k)) * ta * tb’ by rw[] >>
8305 ‘_ = (n + 2) * ta * tb - (n + 1 - k) * ta * tb’ by rw_tac std_ss[RIGHT_SUB_DISTRIB] >>
8306 ‘_ = (n + 1 - k) * tb * tb - (n + 1 - k) * ta * tb’ by rw_tac std_ss[leibniz_up_entry] >>
8307 ‘_ = (n + 1 - k) * tb * tb - (n + 1 - k) * tb * ta’ by metis_tac[MULT_ASSOC, MULT_COMM] >>
8308 ‘_ = (n + 1 - k) * tb * (tb - ta)’ by rw_tac std_ss[LEFT_SUB_DISTRIB] >>
8309 ‘_ = (k + 1) * tc * (tb - ta)’ by rw_tac std_ss[leibniz_right_entry] >>
8310 ‘k + 1 <> 0’ by decide_tac >>
8311 metis_tac[MULT_LEFT_CANCEL, MULT_ASSOC]
8312QED
8313
8314(* Theorem: lcm tb ta = lcm tb tc *)
8315(* Proof:
8316 Apply: > leibniz_lcm_exchange |> SPEC ``n+1``;
8317 val it = |- 0 < n + 1 ==>
8318 !k. lcm (leibniz (n + 1) k) (leibniz (n + 1 - 1) k) =
8319 lcm (leibniz (n + 1) k) (leibniz (n + 1) (k + 1)): thm
8320*)
8321Theorem leibniz_triplet_lcm:
8322 !(n k):num. lcm tb ta = lcm tb tc
8323Proof
8324 rw_tac std_ss[triplet_def, leibniz_lcm_exchange |> SPEC ``n+1`` |> SIMP_RULE arith_ss[]]
8325QED
8326
8327(* ------------------------------------------------------------------------- *)
8328(* Zigzag Path in Leibniz Triangle *)
8329(* ------------------------------------------------------------------------- *)
8330
8331(* Define a path type *)
8332Type path[local] = “:num list”
8333
8334(* Define paths reachable by one zigzag *)
8335Definition leibniz_zigzag_def:
8336 leibniz_zigzag (p1: path) (p2: path) <=>
8337 ?(n k):num (x y):path. (p1 = x ++ [tb; ta] ++ y) /\ (p2 = x ++ [tb; tc] ++ y)
8338End
8339Overload zigzag = ``leibniz_zigzag``
8340val _ = set_fixity "zigzag" (Infix(NONASSOC, 450)); (* same as relation *)
8341
8342(* Theorem: p1 zigzag p2 ==> (list_lcm p1 = list_lcm p2) *)
8343(* Proof:
8344 Given p1 zigzag p2,
8345 ==> ?n k x y. (p1 = x ++ [tb; ta] ++ y) /\ (p2 = x ++ [tb; tc] ++ y) by leibniz_zigzag_def
8346
8347 list_lcm p1
8348 = list_lcm (x ++ [tb; ta] ++ y) by above
8349 = lcm (list_lcm (x ++ [tb; ta])) (list_lcm y) by list_lcm_append
8350 = lcm (list_lcm (x ++ ([tb; ta]))) (list_lcm y) by APPEND_ASSOC
8351 = lcm (lcm (list_lcm x) (list_lcm ([tb; ta]))) (list_lcm y) by list_lcm_append
8352 = lcm (lcm (list_lcm x) (lcm tb ta)) (list_lcm y) by list_lcm_append, list_lcm_sing
8353 = lcm (lcm (list_lcm x) (lcm tb tc)) (list_lcm y) by leibniz_triplet_lcm
8354 = lcm (lcm (list_lcm x) (list_lcm ([tb; tc]))) (list_lcm y) by list_lcm_append, list_lcm_sing
8355 = lcm (list_lcm (x ++ ([tb; tc]))) (list_lcm y) by list_lcm_append
8356 = lcm (list_lcm (x ++ [tb; tc])) (list_lcm y) by APPEND_ASSOC
8357 = list_lcm (x ++ [tb; tc] ++ y) by list_lcm_append
8358 = list_lcm p2 by above
8359*)
8360Theorem list_lcm_zigzag:
8361 !p1 p2. p1 zigzag p2 ==> (list_lcm p1 = list_lcm p2)
8362Proof
8363 rw_tac std_ss[leibniz_zigzag_def] >>
8364 `list_lcm (x ++ [tb; ta] ++ y) = lcm (list_lcm (x ++ [tb; ta])) (list_lcm y)` by rw[list_lcm_append] >>
8365 `_ = lcm (list_lcm (x ++ ([tb; ta]))) (list_lcm y)` by rw[] >>
8366 `_ = lcm (lcm (list_lcm x) (lcm tb ta)) (list_lcm y)` by rw[list_lcm_append] >>
8367 `_ = lcm (lcm (list_lcm x) (lcm tb tc)) (list_lcm y)` by rw[leibniz_triplet_lcm] >>
8368 `_ = lcm (list_lcm (x ++ ([tb; tc]))) (list_lcm y)` by rw[list_lcm_append] >>
8369 `_ = lcm (list_lcm (x ++ [tb; tc])) (list_lcm y)` by rw[] >>
8370 `_ = list_lcm (x ++ [tb; tc] ++ y)` by rw[list_lcm_append] >>
8371 rw[]
8372QED
8373
8374(* Theorem: p1 zigzag p2 ==> !x. ([x] ++ p1) zigzag ([x] ++ p2) *)
8375(* Proof:
8376 Since p1 zigzag p2
8377 ==> ?n k x y. (p1 = x ++ [tb; ta] ++ y) /\ (p2 = x ++ [tb; tc] ++ y) by leibniz_zigzag_def
8378
8379 [x] ++ p1
8380 = [x] ++ (x ++ [tb; ta] ++ y) by above
8381 = [x] ++ x ++ [tb; ta] ++ y by APPEND
8382 [x] ++ p2
8383 = [x] ++ (x ++ [tb; tc] ++ y) by above
8384 = [x] ++ x ++ [tb; tc] ++ y by APPEND
8385 Take new x = [x] ++ x, new y = y.
8386 Then ([x] ++ p1) zigzag ([x] ++ p2) by leibniz_zigzag_def
8387*)
8388Theorem leibniz_zigzag_tail:
8389 !p1 p2. p1 zigzag p2 ==> !x. ([x] ++ p1) zigzag ([x] ++ p2)
8390Proof
8391 metis_tac[leibniz_zigzag_def, APPEND]
8392QED
8393
8394(* Theorem: k <= n ==>
8395 TAKE (k + 1) (leibniz_horizontal (n + 1)) ++ DROP k (leibniz_horizontal n) zigzag
8396 TAKE (k + 2) (leibniz_horizontal (n + 1)) ++ DROP (k + 1) (leibniz_horizontal n) *)
8397(* Proof:
8398 Since k <= n, k < n + 1, and k + 1 < n + 2.
8399 Hence k < LENGTH (leibniz_horizontal (n + 1)),
8400
8401 Let x = TAKE k (leibniz_horizontal (n + 1))
8402 and y = DROP (k + 1) (leibniz_horizontal n)
8403 TAKE (k + 1) (leibniz_horizontal (n + 1))
8404 = TAKE (SUC k) (leibniz_horizontal (SUC n)) by ADD1
8405 = SNOC tb x by TAKE_SUC_BY_TAKE, k < LENGTH (leibniz_horizontal (n + 1))
8406 = x ++ [tb] by SNOC_APPEND
8407 TAKE (k + 2) (leibniz_horizontal (n + 1))
8408 = TAKE (SUC (SUC k)) (leibniz_horizontal (SUC n)) by ADD1
8409 = SNOC tc (SNOC tb x) by TAKE_SUC_BY_TAKE, k + 1 < LENGTH (leibniz_horizontal (n + 1))
8410 = x ++ [tb; tc] by SNOC_APPEND
8411 DROP k (leibniz_horizontal n)
8412 = ta :: y by DROP_BY_DROP_SUC, k < LENGTH (leibniz_horizontal n)
8413 = [ta] ++ y by CONS_APPEND
8414 Hence
8415 Let p1 = TAKE (k + 1) (leibniz_horizontal (n + 1)) ++ DROP k (leibniz_horizontal n)
8416 = x ++ [tb] ++ [ta] ++ y
8417 = x ++ [tb; ta] ++ y by APPEND
8418 Let p2 = TAKE (k + 2) (leibniz_horizontal (n + 1)) ++ DROP (k + 1) (leibniz_horizontal n)
8419 = x ++ [tb; tc] ++ y
8420 Therefore p1 zigzag p2 by leibniz_zigzag_def
8421*)
8422Theorem leibniz_horizontal_zigzag :
8423 !n k. k <= n ==>
8424 TAKE (k + 1) (leibniz_horizontal (n + 1)) ++
8425 DROP k (leibniz_horizontal n)
8426 zigzag
8427 TAKE (k + 2) (leibniz_horizontal (n + 1)) ++
8428 DROP (k + 1) (leibniz_horizontal n)
8429Proof
8430 rpt strip_tac >>
8431 qabbrev_tac `x = TAKE k (leibniz_horizontal (n + 1))` >>
8432 qabbrev_tac `y = DROP (k + 1) (leibniz_horizontal n)` >>
8433 `k <= n + 1` by decide_tac >>
8434 `EL k (leibniz_horizontal n) = ta`
8435 by rw_tac std_ss[triplet_def, leibniz_horizontal_el] >>
8436 `EL k (leibniz_horizontal (n + 1)) = tb`
8437 by rw_tac std_ss[triplet_def, leibniz_horizontal_el] >>
8438 `EL (k + 1) (leibniz_horizontal (n + 1)) = tc`
8439 by rw_tac std_ss[triplet_def, leibniz_horizontal_el] >>
8440 `k < n + 1` by decide_tac >>
8441 `k < LENGTH (leibniz_horizontal (n + 1))` by rw[leibniz_horizontal_len] >>
8442 `TAKE (k + 1) (leibniz_horizontal (n + 1)) =
8443 TAKE (SUC k) (leibniz_horizontal (n + 1))` by rw[ADD1] >>
8444 `_ = SNOC tb x` by rw[TAKE_SUC_BY_TAKE, Abbr`x`] >>
8445 `_ = x ++ [tb]` by rw[SNOC_APPEND] >>
8446 `SUC k < n + 2` by decide_tac >>
8447 `SUC k < LENGTH (leibniz_horizontal (n + 1))` by rw[leibniz_horizontal_len] >>
8448 `TAKE (k + 2) (leibniz_horizontal (n + 1)) =
8449 TAKE (SUC (SUC k)) (leibniz_horizontal (n + 1))` by rw[ADD1] >>
8450 `_ = SNOC tc (SNOC tb x)` by rw_tac std_ss[TAKE_SUC_BY_TAKE, ADD1, Abbr`x`] >>
8451 `_ = x ++ [tb; tc]` by rw[SNOC_APPEND] >>
8452 `DROP k (leibniz_horizontal n) = [ta] ++ y`
8453 by rw[DROP_BY_DROP_SUC, ADD1, Abbr`y`] >>
8454 qabbrev_tac `p1 = TAKE (k + 1) (leibniz_horizontal (n + 1)) ++
8455 DROP k (leibniz_horizontal n)` >>
8456 qabbrev_tac `p2 = TAKE (k + 2) (leibniz_horizontal (n + 1)) ++ y` >>
8457 `p1 = x ++ [tb; ta] ++ y` by rw[Abbr`p1`, Abbr`x`, Abbr`y`] >>
8458 `p2 = x ++ [tb; tc] ++ y` by rw[Abbr`p2`, Abbr`x`] >>
8459 metis_tac[leibniz_zigzag_def]
8460QED
8461
8462(* Theorem: (leibniz_up 1) zigzag (leibniz_horizontal 1) *)
8463(* Proof:
8464 Since leibniz_up 1
8465 = [2; 1] by EVAL_TAC
8466 = [] ++ [2; 1] ++ [] by EVAL_TAC
8467 and leibniz_horizontal 1
8468 = [2; 2] by EVAL_TAC
8469 = [] ++ [2; 2] ++ [] by EVAL_TAC
8470 Now the first Leibniz triplet is:
8471 (triplet 0 0).a = 1 by EVAL_TAC
8472 (triplet 0 0).b = 2 by EVAL_TAC
8473 (triplet 0 0).c = 2 by EVAL_TAC
8474 Hence (leibniz_up 1) zigzag (leibniz_horizontal 1) by leibniz_zigzag_def
8475*)
8476Theorem leibniz_triplet_0:
8477 (leibniz_up 1) zigzag (leibniz_horizontal 1)
8478Proof
8479 `leibniz_up 1 = [] ++ [2; 1] ++ []` by EVAL_TAC >>
8480 `leibniz_horizontal 1 = [] ++ [2; 2] ++ []` by EVAL_TAC >>
8481 `((triplet 0 0).a = 1) /\ ((triplet 0 0).b = 2) /\ ((triplet 0 0).c = 2)` by EVAL_TAC >>
8482 metis_tac[leibniz_zigzag_def]
8483QED
8484
8485(* ------------------------------------------------------------------------- *)
8486(* Wriggle Paths in Leibniz Triangle *)
8487(* ------------------------------------------------------------------------- *)
8488
8489(* Define paths reachable by many zigzags *)
8490(*
8491val leibniz_wriggle_def = Define`
8492 leibniz_wriggle (p1: path) (p2: path) <=>
8493 ?(m:num) (f:num -> path).
8494 (p1 = f 0) /\
8495 (p2 = f m) /\
8496 (!k. k < m ==> (f k) zigzag (f (SUC k)))
8497`;
8498*)
8499
8500(* Define paths reachable by many zigzags by closure *)
8501Overload wriggle = ``RTC leibniz_zigzag``(* RTC = reflexive transitive closure *)
8502val _ = set_fixity "wriggle" (Infix(NONASSOC, 450)); (* same as relation *)
8503
8504(* Theorem: p1 wriggle p2 ==> (list_lcm p1 = list_lcm p2) *)
8505(* Proof:
8506 By RTC_STRONG_INDUCT.
8507 Base: list_lcm p1 = list_lcm p1, trivially true.
8508 Step: p1 zigzag p1' /\ p1' wriggle p2 /\ list_lcm p1' = list_lcm p2 ==> list_lcm p1 = list_lcm p2
8509 list_lcm p1
8510 = list_lcm p1' by list_lcm_zigzag
8511 = list_lcm p2 by induction hypothesis
8512*)
8513Theorem list_lcm_wriggle:
8514 !p1 p2. p1 wriggle p2 ==> (list_lcm p1 = list_lcm p2)
8515Proof
8516 ho_match_mp_tac RTC_STRONG_INDUCT >>
8517 rpt strip_tac >-
8518 rw[] >>
8519 metis_tac[list_lcm_zigzag]
8520QED
8521
8522(* Theorem: p1 zigzag p2 ==> p1 wriggle p2 *)
8523(* Proof:
8524 p1 wriggle p2
8525 = p1 (RTC zigzag) p2 by notation
8526 = p1 zigzag p2 by RTC_SINGLE
8527*)
8528Theorem leibniz_zigzag_wriggle:
8529 !p1 p2. p1 zigzag p2 ==> p1 wriggle p2
8530Proof
8531 rw[]
8532QED
8533
8534(* Theorem: p1 wriggle p2 ==> !x. ([x] ++ p1) wriggle ([x] ++ p2) *)
8535(* Proof:
8536 By RTC_STRONG_INDUCT.
8537 Base: [x] ++ p1 wriggle [x] ++ p1
8538 True by RTC_REFL.
8539 Step: p1 zigzag p1' /\ p1' wriggle p2 /\ !x. [x] ++ p1' wriggle [x] ++ p2 ==>
8540 [x] ++ p1 wriggle [x] ++ p2
8541 Since p1 zigzag p1',
8542 so [x] ++ p1 zigzag [x] ++ p1' by leibniz_zigzag_tail
8543 or [x] ++ p1 wriggle [x] ++ p1' by leibniz_zigzag_wriggle
8544 With [x] ++ p1' wriggle [x] ++ p2 by induction hypothesis
8545 Hence [x] ++ p1 wriggle [x] ++ p2 by RTC_TRANS
8546*)
8547Theorem leibniz_wriggle_tail:
8548 !p1 p2. p1 wriggle p2 ==> !x. ([x] ++ p1) wriggle ([x] ++ p2)
8549Proof
8550 ho_match_mp_tac RTC_STRONG_INDUCT >>
8551 rpt strip_tac >-
8552 rw[] >>
8553 metis_tac[leibniz_zigzag_tail, leibniz_zigzag_wriggle, RTC_TRANS]
8554QED
8555
8556(* Theorem: p1 wriggle p1 *)
8557(* Proof: by RTC_REFL *)
8558Theorem leibniz_wriggle_refl:
8559 !p1. p1 wriggle p1
8560Proof
8561 metis_tac[RTC_REFL]
8562QED
8563
8564(* Theorem: p1 wriggle p2 /\ p2 wriggle p3 ==> p1 wriggle p3 *)
8565(* Proof: by RTC_TRANS *)
8566Theorem leibniz_wriggle_trans:
8567 !p1 p2 p3. p1 wriggle p2 /\ p2 wriggle p3 ==> p1 wriggle p3
8568Proof
8569 metis_tac[RTC_TRANS]
8570QED
8571
8572(* Theorem: k <= n + 1 ==>
8573 TAKE (k + 1) (leibniz_horizontal (n + 1)) ++ DROP k (leibniz_horizontal n) wriggle
8574 leibniz_horizontal (n + 1) *)
8575(* Proof:
8576 By induction on the difference: n + 1 - k.
8577 Base: k = n + 1 ==> TAKE (k + 1) (leibniz_horizontal (n + 1)) ++ DROP k (leibniz_horizontal n) wriggle
8578 leibniz_horizontal (n + 1)
8579 TAKE (k + 1) (leibniz_horizontal (n + 1)) ++ DROP k (leibniz_horizontal n)
8580 = TAKE (n + 2) (leibniz_horizontal (n + 1)) ++ DROP (n + 1) (leibniz_horizontal n) by k = n + 1
8581 = leibniz_horizontal (n + 1) ++ [] by TAKE_LENGTH_ID, DROP_LENGTH_NIL
8582 = leibniz_horizontal (n + 1) by APPEND_NIL
8583 Hence they wriggle to each other by RTC_REFL
8584 Step: k <= n + 1 ==> TAKE (k + 1) (leibniz_horizontal (n + 1)) ++ DROP k (leibniz_horizontal n) wriggle
8585 leibniz_horizontal (n + 1)
8586 Let p1 = leibniz_horizontal (n + 1)
8587 p2 = TAKE (k + 1) p1 ++ DROP k (leibniz_horizontal n)
8588 p3 = TAKE (k + 2) (leibniz_horizontal (n + 1)) ++ DROP (k + 1) (leibniz_horizontal n)
8589 Then p2 zigzag p3 by leibniz_horizontal_zigzag
8590 and p3 wriggle p1 by induction hypothesis
8591 Hence p2 wriggle p1 by RTC_RULES
8592*)
8593Theorem leibniz_horizontal_wriggle_step:
8594 !n k. k <= n + 1 ==> TAKE (k + 1) (leibniz_horizontal (n + 1)) ++ DROP k (leibniz_horizontal n) wriggle
8595 leibniz_horizontal (n + 1)
8596Proof
8597 Induct_on `n + 1 - k` >| [
8598 rpt strip_tac >>
8599 rw_tac arith_ss[] >>
8600 `n + 1 = k` by decide_tac >>
8601 rw[TAKE_LENGTH_ID_rwt, DROP_LENGTH_NIL_rwt],
8602 rpt strip_tac >>
8603 `v = n - k` by decide_tac >>
8604 `v = (n + 1) - (k + 1)` by decide_tac >>
8605 `k <= n` by decide_tac >>
8606 `k + 1 <= n + 1` by decide_tac >>
8607 `k + 1 + 1 = k + 2` by decide_tac >>
8608 qabbrev_tac `p1 = leibniz_horizontal (n + 1)` >>
8609 qabbrev_tac `p2 = TAKE (k + 1) p1 ++ DROP k (leibniz_horizontal n)` >>
8610 qabbrev_tac `p3 = TAKE (k + 2) (leibniz_horizontal (n + 1)) ++ DROP (k + 1) (leibniz_horizontal n)` >>
8611 `p2 zigzag p3` by rw[leibniz_horizontal_zigzag, Abbr`p1`, Abbr`p2`, Abbr`p3`] >>
8612 metis_tac[RTC_RULES]
8613 ]
8614QED
8615
8616(* Theorem: ([leibniz (n + 1) 0] ++ leibniz_horizontal n) wriggle leibniz_horizontal (n + 1) *)
8617(* Proof:
8618 Apply > leibniz_horizontal_wriggle_step |> SPEC ``n:num`` |> SPEC ``0`` |> SIMP_RULE std_ss[DROP_0];
8619 val it = |- TAKE 1 (leibniz_horizontal (n + 1)) ++ leibniz_horizontal n wriggle leibniz_horizontal (n + 1): thm
8620*)
8621Theorem leibniz_horizontal_wriggle:
8622 !n. ([leibniz (n + 1) 0] ++ leibniz_horizontal n) wriggle leibniz_horizontal (n + 1)
8623Proof
8624 rpt strip_tac >>
8625 `TAKE 1 (leibniz_horizontal (n + 1)) = [leibniz (n + 1) 0]` by rw[leibniz_horizontal_head, binomial_n_0] >>
8626 metis_tac[leibniz_horizontal_wriggle_step |> SPEC ``n:num`` |> SPEC ``0`` |> SIMP_RULE std_ss[DROP_0]]
8627QED
8628
8629(* ------------------------------------------------------------------------- *)
8630(* Path Transform keeping LCM *)
8631(* ------------------------------------------------------------------------- *)
8632
8633(* Theorem: (leibniz_up n) wriggle (leibniz_horizontal n) *)
8634(* Proof:
8635 By induction on n.
8636 Base: leibniz_up 0 wriggle leibniz_horizontal 0
8637 Since leibniz_up 0 = [1] by leibniz_up_0
8638 and leibniz_horizontal 0 = [1] by leibniz_horizontal_0
8639 Hence leibniz_up 0 wriggle leibniz_horizontal 0 by leibniz_wriggle_refl
8640 Step: leibniz_up n wriggle leibniz_horizontal n ==>
8641 leibniz_up (SUC n) wriggle leibniz_horizontal (SUC n)
8642 Let x = leibniz (n + 1) 0.
8643 Then x = n + 2 by leibniz_n_0
8644 Now leibniz_up (n + 1) = [x] ++ (leibniz_up n) by leibniz_up_cons
8645 Since leibniz_up n wriggle leibniz_horizontal n by induction hypothesis
8646 so ([x] ++ (leibniz_up n)) wriggle
8647 ([x] ++ (leibniz_horizontal n)) by leibniz_wriggle_tail
8648 and ([x] ++ (leibniz_horizontal n)) wriggle
8649 (leibniz_horizontal (n + 1)) by leibniz_horizontal_wriggle
8650 Hence leibniz_up (SUC n) wriggle
8651 leibniz_horizontal (SUC n) by leibniz_wriggle_trans, ADD1
8652*)
8653Theorem leibniz_up_wriggle_horizontal:
8654 !n. (leibniz_up n) wriggle (leibniz_horizontal n)
8655Proof
8656 Induct >-
8657 rw[leibniz_up_0, leibniz_horizontal_0] >>
8658 qabbrev_tac `x = leibniz (n + 1) 0` >>
8659 `x = n + 2` by rw[leibniz_n_0, Abbr`x`] >>
8660 `leibniz_up (n + 1) = [x] ++ (leibniz_up n)` by rw[leibniz_up_cons, Abbr`x`] >>
8661 `([x] ++ (leibniz_up n)) wriggle ([x] ++ (leibniz_horizontal n))` by rw[leibniz_wriggle_tail] >>
8662 `([x] ++ (leibniz_horizontal n)) wriggle (leibniz_horizontal (n + 1))` by rw[leibniz_horizontal_wriggle, Abbr`x`] >>
8663 metis_tac[leibniz_wriggle_trans, ADD1]
8664QED
8665
8666(* Theorem: list_lcm (leibniz_vertical n) = list_lcm (leibniz_horizontal n) *)
8667(* Proof:
8668 Since leibniz_up n = REVERSE (leibniz_vertical n) by notation
8669 and leibniz_up n wriggle leibniz_horizontal n by leibniz_up_wriggle_horizontal
8670 list_lcm (leibniz_vertical n)
8671 = list_lcm (leibniz_up n) by list_lcm_reverse
8672 = list_lcm (leibniz_horizontal n) by list_lcm_wriggle
8673*)
8674Theorem leibniz_lcm_property:
8675 !n. list_lcm (leibniz_vertical n) = list_lcm (leibniz_horizontal n)
8676Proof
8677 metis_tac[leibniz_up_wriggle_horizontal, list_lcm_wriggle, list_lcm_reverse]
8678QED
8679
8680(* This is a milestone theorem. *)
8681
8682(* Theorem: k <= n ==> (leibniz n k) divides list_lcm (leibniz_vertical n) *)
8683(* Proof:
8684 Note (leibniz n k) divides list_lcm (leibniz_horizontal n) by leibniz_horizontal_divisor
8685 ==> (leibniz n k) divides list_lcm (leibniz_vertical n) by leibniz_lcm_property
8686*)
8687Theorem leibniz_vertical_divisor:
8688 !n k. k <= n ==> (leibniz n k) divides list_lcm (leibniz_vertical n)
8689Proof
8690 metis_tac[leibniz_horizontal_divisor, leibniz_lcm_property]
8691QED
8692
8693(* ------------------------------------------------------------------------- *)
8694(* Lower Bound of Leibniz LCM *)
8695(* ------------------------------------------------------------------------- *)
8696
8697(* Theorem: 2 ** n <= list_lcm (leibniz_horizontal n) *)
8698(* Proof:
8699 Note LENGTH (binomail_horizontal n) = n + 1 by binomial_horizontal_len
8700 and EVERY_POSITIVE (binomial_horizontal n) by binomial_horizontal_pos .. [1]
8701 list_lcm (leibniz_horizontal n)
8702 = (n + 1) * list_lcm (binomial_horizontal n) by leibniz_horizontal_lcm_alt
8703 >= SUM (binomial_horizontal n) by list_lcm_lower_bound, [1]
8704 = 2 ** n by binomial_horizontal_sum
8705*)
8706Theorem leibniz_horizontal_lcm_lower:
8707 !n. 2 ** n <= list_lcm (leibniz_horizontal n)
8708Proof
8709 rpt strip_tac >>
8710 `LENGTH (binomial_horizontal n) = n + 1` by rw[binomial_horizontal_len] >>
8711 `EVERY_POSITIVE (binomial_horizontal n)` by rw[binomial_horizontal_pos] >>
8712 `list_lcm (leibniz_horizontal n) = (n + 1) * list_lcm (binomial_horizontal n)` by rw[leibniz_horizontal_lcm_alt] >>
8713 `SUM (binomial_horizontal n) = 2 ** n` by rw[binomial_horizontal_sum] >>
8714 metis_tac[list_lcm_lower_bound]
8715QED
8716
8717(* Theorem: 2 ** n <= list_lcm (leibniz_vertical n) *)
8718(* Proof:
8719 list_lcm (leibniz_vertical n)
8720 = list_lcm (leibniz_horizontal n) by leibniz_lcm_property
8721 >= 2 ** n by leibniz_horizontal_lcm_lower
8722*)
8723Theorem leibniz_vertical_lcm_lower:
8724 !n. 2 ** n <= list_lcm (leibniz_vertical n)
8725Proof
8726 rw_tac std_ss[leibniz_horizontal_lcm_lower, leibniz_lcm_property]
8727QED
8728
8729(* Theorem: 2 ** n <= list_lcm [1 .. (n + 1)] *)
8730(* Proof: by leibniz_vertical_lcm_lower. *)
8731Theorem lcm_lower_bound:
8732 !n. 2 ** n <= list_lcm [1 .. (n + 1)]
8733Proof
8734 rw[leibniz_vertical_lcm_lower]
8735QED
8736
8737(* ------------------------------------------------------------------------- *)
8738(* Leibniz LCM Invariance *)
8739(* ------------------------------------------------------------------------- *)
8740
8741(* Use overloading for leibniz_col_arm rooted at leibniz a b, of length n. *)
8742Overload leibniz_col_arm = ``\a b n. MAP (\x. leibniz (a - x) b) [0 ..< n]``
8743
8744(* Use overloading for leibniz_seg_arm rooted at leibniz a b, of length n. *)
8745Overload leibniz_seg_arm = ``\a b n. MAP (\x. leibniz a (b + x)) [0 ..< n]``
8746
8747(*
8748> EVAL ``leibniz_col_arm 5 1 4``;
8749val it = |- leibniz_col_arm 5 1 4 = [30; 20; 12; 6]: thm
8750> EVAL ``leibniz_seg_arm 5 1 4``;
8751val it = |- leibniz_seg_arm 5 1 4 = [30; 60; 60; 30]: thm
8752> EVAL ``list_lcm (leibniz_col_arm 5 1 4)``;
8753val it = |- list_lcm (leibniz_col_arm 5 1 4) = 60: thm
8754> EVAL ``list_lcm (leibniz_seg_arm 5 1 4)``;
8755val it = |- list_lcm (leibniz_seg_arm 5 1 4) = 60: thm
8756*)
8757
8758(* Theorem: leibniz_col_arm a b 0 = [] *)
8759(* Proof:
8760 leibniz_col_arm a b 0
8761 = MAP (\x. leibniz (a - x) b) [0 ..< 0] by notation
8762 = MAP (\x. leibniz (a - x) b) [] by listRangeLHI_def
8763 = [] by MAP
8764*)
8765Theorem leibniz_col_arm_0:
8766 !a b. leibniz_col_arm a b 0 = []
8767Proof
8768 rw[]
8769QED
8770
8771(* Theorem: leibniz_seg_arm a b 0 = [] *)
8772(* Proof:
8773 leibniz_seg_arm a b 0
8774 = MAP (\x. leibniz a (b + x)) [0 ..< 0] by notation
8775 = MAP (\x. leibniz a (b + x)) [] by listRangeLHI_def
8776 = [] by MAP
8777*)
8778Theorem leibniz_seg_arm_0:
8779 !a b. leibniz_seg_arm a b 0 = []
8780Proof
8781 rw[]
8782QED
8783
8784(* Theorem: leibniz_col_arm a b 1 = [leibniz a b] *)
8785(* Proof:
8786 leibniz_col_arm a b 1
8787 = MAP (\x. leibniz (a - x) b) [0 ..< 1] by notation
8788 = MAP (\x. leibniz (a - x) b) [0] by listRangeLHI_def
8789 = (\x. leibniz (a - x) b) 0 ::[] by MAP
8790 = [leibniz a b] by function application
8791*)
8792Theorem leibniz_col_arm_1:
8793 !a b. leibniz_col_arm a b 1 = [leibniz a b]
8794Proof
8795 rw[listRangeLHI_def]
8796QED
8797
8798(* Theorem: leibniz_seg_arm a b 1 = [leibniz a b] *)
8799(* Proof:
8800 leibniz_seg_arm a b 1
8801 = MAP (\x. leibniz a (b + x)) [0 ..< 1] by notation
8802 = MAP (\x. leibniz a (b + x)) [0] by listRangeLHI_def
8803 = (\x. leibniz a (b + x)) 0 :: [] by MAP
8804 = [leibniz a b] by function application
8805*)
8806Theorem leibniz_seg_arm_1:
8807 !a b. leibniz_seg_arm a b 1 = [leibniz a b]
8808Proof
8809 rw[listRangeLHI_def]
8810QED
8811
8812(* Theorem: LENGTH (leibniz_col_arm a b n) = n *)
8813(* Proof:
8814 LENGTH (leibniz_col_arm a b n)
8815 = LENGTH (MAP (\x. leibniz (a - x) b) [0 ..< n]) by notation
8816 = LENGTH [0 ..< n] by LENGTH_MAP
8817 = LENGTH (GENLIST (\i. i) n) by listRangeLHI_def
8818 = m by LENGTH_GENLIST
8819*)
8820Theorem leibniz_col_arm_len:
8821 !a b n. LENGTH (leibniz_col_arm a b n) = n
8822Proof
8823 rw[]
8824QED
8825
8826(* Theorem: LENGTH (leibniz_seg_arm a b n) = n *)
8827(* Proof:
8828 LENGTH (leibniz_seg_arm a b n)
8829 = LENGTH (MAP (\x. leibniz a (b + x)) [0 ..< n]) by notation
8830 = LENGTH [0 ..< n] by LENGTH_MAP
8831 = LENGTH (GENLIST (\i. i) n) by listRangeLHI_def
8832 = m by LENGTH_GENLIST
8833*)
8834Theorem leibniz_seg_arm_len:
8835 !a b n. LENGTH (leibniz_seg_arm a b n) = n
8836Proof
8837 rw[]
8838QED
8839
8840(* Theorem: k < n ==> !a b. EL k (leibniz_col_arm a b n) = leibniz (a - k) b *)
8841(* Proof:
8842 Note LENGTH [0 ..< n] = n by LENGTH_listRangeLHI
8843 EL k (leibniz_col_arm a b n)
8844 = EL k (MAP (\x. leibniz (a - x) b) [0 ..< n]) by notation
8845 = (\x. leibniz (a - x) b) (EL k [0 ..< n]) by EL_MAP
8846 = (\x. leibniz (a - x) b) k by EL_listRangeLHI
8847 = leibniz (a - k) b
8848*)
8849Theorem leibniz_col_arm_el:
8850 !n k. k < n ==> !a b. EL k (leibniz_col_arm a b n) = leibniz (a - k) b
8851Proof
8852 rw[EL_MAP, EL_listRangeLHI]
8853QED
8854
8855(* Theorem: k < n ==> !a b. EL k (leibniz_seg_arm a b n) = leibniz a (b + k) *)
8856(* Proof:
8857 Note LENGTH [0 ..< n] = n by LENGTH_listRangeLHI
8858 EL k (leibniz_seg_arm a b n)
8859 = EL k (MAP (\x. leibniz a (b + x)) [0 ..< n]) by notation
8860 = (\x. leibniz a (b + x)) (EL k [0 ..< n]) by EL_MAP
8861 = (\x. leibniz a (b + x)) k by EL_listRangeLHI
8862 = leibniz a (b + k)
8863*)
8864Theorem leibniz_seg_arm_el:
8865 !n k. k < n ==> !a b. EL k (leibniz_seg_arm a b n) = leibniz a (b + k)
8866Proof
8867 rw[EL_MAP, EL_listRangeLHI]
8868QED
8869
8870(* Theorem: TAKE 1 (leibniz_seg_arm a b (n + 1)) = [leibniz a b] *)
8871(* Proof:
8872 Note LENGTH (leibniz_seg_arm a b (n + 1)) = n + 1 by leibniz_seg_arm_len
8873 and 0 < n + 1 by ADD1, SUC_POS
8874 TAKE 1 (leibniz_seg_arm a b (n + 1))
8875 = TAKE (SUC 0) (leibniz_seg_arm a b (n + 1)) by ONE
8876 = SNOC (EL 0 (leibniz_seg_arm a b (n + 1))) [] by TAKE_SUC_BY_TAKE, TAKE_0
8877 = [EL 0 (leibniz_seg_arm a b (n + 1))] by SNOC_NIL
8878 = leibniz a b by leibniz_seg_arm_el
8879*)
8880Theorem leibniz_seg_arm_head:
8881 !a b n. TAKE 1 (leibniz_seg_arm a b (n + 1)) = [leibniz a b]
8882Proof
8883 metis_tac[leibniz_seg_arm_len, leibniz_seg_arm_el,
8884 ONE, TAKE_SUC_BY_TAKE, TAKE_0, SNOC_NIL, DECIDE``!n. 0 < n + 1 /\ (n + 0 = n)``]
8885QED
8886
8887(* Theorem: leibniz_col_arm (a + 1) b (n + 1) = leibniz (a + 1) b :: leibniz_col_arm a b n *)
8888(* Proof:
8889 Note (\x. leibniz (a + 1 - x) b) o SUC
8890 = (\x. leibniz (a + 1 - (x + 1)) b) by FUN_EQ_THM
8891 = (\x. leibniz (a - x) b) by arithmetic
8892
8893 leibniz_col_arm (a + 1) b (n + 1)
8894 = MAP (\x. leibniz (a + 1 - x) b) [0 ..< (n + 1)] by notation
8895 = MAP (\x. leibniz (a + 1 - x) b) (0::[1 ..< (n+1)]) by listRangeLHI_CONS, 0 < n + 1
8896 = (\x. leibniz (a + 1 - x) b) 0 :: MAP (\x. leibniz (a + 1 - x) b) [1 ..< (n+1)] by MAP
8897 = leibniz (a + 1) b :: MAP (\x. leibniz (a + 1 - x) b) [1 ..< (n+1)] by function application
8898 = leibniz (a + 1) b :: MAP ((\x. leibniz (a + 1 - x) b) o SUC) [0 ..< n] by listRangeLHI_MAP_SUC
8899 = leibniz (a + 1) b :: MAP (\x. leibniz (a - x) b) [0 ..< n] by above
8900 = leibniz (a + 1) b :: leibniz_col_arm a b n by notation
8901*)
8902Theorem leibniz_col_arm_cons:
8903 !a b n. leibniz_col_arm (a + 1) b (n + 1) = leibniz (a + 1) b :: leibniz_col_arm a b n
8904Proof
8905 rpt strip_tac >>
8906 `!a x. a + 1 - SUC x + 1 = a - x + 1` by decide_tac >>
8907 `!a x. a + 1 - SUC x = a - x` by decide_tac >>
8908 `(\x. leibniz (a + 1 - x) b) o SUC = (\x. leibniz (a + 1 - (x + 1)) b)` by rw[FUN_EQ_THM] >>
8909 `0 < n + 1` by decide_tac >>
8910 `leibniz_col_arm (a + 1) b (n + 1) = MAP (\x. leibniz (a + 1 - x) b) (0::[1 ..< (n+1)])` by rw[listRangeLHI_CONS] >>
8911 `_ = leibniz (a + 1) b :: MAP (\x. leibniz (a + 1 - x) b) [0+1 ..< (n+1)]` by rw[] >>
8912 `_ = leibniz (a + 1) b :: MAP ((\x. leibniz (a + 1 - x) b) o SUC) [0 ..< n]` by rw[listRangeLHI_MAP_SUC] >>
8913 `_ = leibniz (a + 1) b :: leibniz_col_arm a b n` by rw[] >>
8914 rw[]
8915QED
8916
8917(* Theorem: k < n ==> !a b.
8918 TAKE (k + 1) (leibniz_seg_arm (a + 1) b (n + 1)) ++ DROP k (leibniz_seg_arm a b n) zigzag
8919 TAKE (k + 2) (leibniz_seg_arm (a + 1) b (n + 1)) ++ DROP (k + 1) (leibniz_seg_arm a b n) *)
8920(* Proof:
8921 Since k <= n, k < n + 1, and k + 1 < n + 2.
8922 Hence k < LENGTH (leibniz_seg_arm a b (n + 1)),
8923
8924 Let x = TAKE k (leibniz_seg_arm a b (n + 1))
8925 and y = DROP (k + 1) (leibniz_seg_arm a b n)
8926 TAKE (k + 1) (leibniz_seg_arm (a + 1) b (n + 1))
8927 = TAKE (SUC k) (leibniz_seg_arm (a + 1) b (n + 1)) by ADD1
8928 = SNOC t.b x by TAKE_SUC_BY_TAKE, k < LENGTH (leibniz_seg_arm (a + 1) b (n + 1))
8929 = x ++ [t.b] by SNOC_APPEND
8930 TAKE (k + 2) (leibniz_seg_arm (a + 1) b (n + 1))
8931 = TAKE (SUC (SUC k)) (leibniz_seg_arm (a + 1) b (SUC n)) by ADD1
8932 = SNOC t.c (SNOC t.b x) by TAKE_SUC_BY_TAKE, SUC k < LENGTH (leibniz_seg_arm (a + 1) b (n + 1))
8933 = x ++ [t.b; t.c] by SNOC_APPEND
8934 DROP k (leibniz_seg_arm a b n)
8935 = t.a :: y by DROP_BY_DROP_SUC, k < LENGTH (leibniz_seg_arm a b n)
8936 = [t.a] ++ y by CONS_APPEND
8937 Hence
8938 Let p1 = TAKE (k + 1) (leibniz_seg_arm (a + 1) b (n + 1)) ++ DROP k (leibniz_seg_arm a b n)
8939 = x ++ [t.b] ++ [t.a] ++ y
8940 = x ++ [t.b; t.a] ++ y by APPEND
8941 Let p2 = TAKE (k + 2) (leibniz_seg_arm (a + 1) b (n + 1)) ++ DROP (k + 1) (leibniz_seg_arm a b n)
8942 = x ++ [t.b; t.c] ++ y
8943 Therefore p1 zigzag p2 by leibniz_zigzag_def
8944*)
8945Theorem leibniz_seg_arm_zigzag_step:
8946 !n k. k < n ==> !a b.
8947 TAKE (k + 1) (leibniz_seg_arm (a + 1) b (n + 1)) ++ DROP k (leibniz_seg_arm a b n) zigzag
8948 TAKE (k + 2) (leibniz_seg_arm (a + 1) b (n + 1)) ++ DROP (k + 1) (leibniz_seg_arm a b n)
8949Proof
8950 rpt strip_tac >>
8951 qabbrev_tac `x = TAKE k (leibniz_seg_arm (a + 1) b (n + 1))` >>
8952 qabbrev_tac `y = DROP (k + 1) (leibniz_seg_arm a b n)` >>
8953 qabbrev_tac `t = triplet a (b + k)` >>
8954 `k < n + 1 /\ k + 1 < n + 1` by decide_tac >>
8955 `EL k (leibniz_seg_arm a b n) = t.a` by rw[triplet_def, leibniz_seg_arm_el, Abbr`t`] >>
8956 `EL k (leibniz_seg_arm (a + 1) b (n + 1)) = t.b` by rw[triplet_def, leibniz_seg_arm_el, Abbr`t`] >>
8957 `EL (k + 1) (leibniz_seg_arm (a + 1) b (n + 1)) = t.c` by rw[triplet_def, leibniz_seg_arm_el, Abbr`t`] >>
8958 `k < LENGTH (leibniz_seg_arm a b (n + 1))` by rw[leibniz_seg_arm_len] >>
8959 `TAKE (k + 1) (leibniz_seg_arm (a + 1) b (n + 1)) = TAKE (SUC k) (leibniz_seg_arm (a + 1) b (n + 1))` by rw[ADD1] >>
8960 `_ = SNOC t.b x` by rw[TAKE_SUC_BY_TAKE, Abbr`x`] >>
8961 `_ = x ++ [t.b]` by rw[SNOC_APPEND] >>
8962 `SUC k < n + 1` by decide_tac >>
8963 `SUC k < LENGTH (leibniz_seg_arm (a + 1) b (n + 1))` by rw[leibniz_seg_arm_len] >>
8964 `k < LENGTH (leibniz_seg_arm (a + 1) b (n + 1))` by decide_tac >>
8965 `TAKE (k + 2) (leibniz_seg_arm (a + 1) b (n + 1)) = TAKE (SUC (SUC k)) (leibniz_seg_arm (a + 1) b (n + 1))` by rw[ADD1] >>
8966 `_ = SNOC t.c (SNOC t.b x)` by metis_tac[TAKE_SUC_BY_TAKE, ADD1] >>
8967 `_ = x ++ [t.b; t.c]` by rw[SNOC_APPEND] >>
8968 `DROP k (leibniz_seg_arm a b n) = [t.a] ++ y` by rw[DROP_BY_DROP_SUC, ADD1, Abbr`y`] >>
8969 qabbrev_tac `p1 = TAKE (k + 1) (leibniz_seg_arm (a + 1) b (n + 1)) ++ DROP k (leibniz_seg_arm a b n)` >>
8970 qabbrev_tac `p2 = TAKE (k + 2) (leibniz_seg_arm (a + 1) b (n + 1)) ++ y` >>
8971 `p1 = x ++ [t.b; t.a] ++ y` by rw[Abbr`p1`, Abbr`x`, Abbr`y`] >>
8972 `p2 = x ++ [t.b; t.c] ++ y` by rw[Abbr`p2`, Abbr`x`] >>
8973 metis_tac[leibniz_zigzag_def]
8974QED
8975
8976(* Theorem: k < n + 1 ==> !a b.
8977 TAKE (k + 1) (leibniz_seg_arm (a + 1) b (n + 1)) ++ DROP k (leibniz_seg_arm a b n) wriggle
8978 leibniz_seg_arm (a + 1) b (n + 1) *)
8979(* Proof:
8980 By induction on the difference: n - k.
8981 Base: k = n ==> TAKE (k + 1) (leibniz_seg_arm a b (n + 1)) ++ DROP k (leibniz_seg_arm a b n) wriggle
8982 leibniz_seg_arm a b (n + 1)
8983 Note LENGTH (leibniz_seg_arm (a + 1) b (n + 1)) = n + 1 by leibniz_seg_arm_len
8984 and LENGTH (leibniz_seg_arm a b n) = n by leibniz_seg_arm_len
8985 TAKE (k + 1) (leibniz_seg_arm a b (n + 1)) ++ DROP k (leibniz_seg_arm a b n)
8986 = TAKE (n + 1) (leibniz_seg_arm a b (n + 1)) ++ DROP n (leibniz_seg_arm a b n) by k = n
8987 = leibniz_seg_arm a b n ++ [] by TAKE_LENGTH_ID, DROP_LENGTH_NIL
8988 = leibniz_seg_arm a b n by APPEND_NIL
8989 Hence they wriggle to each other by RTC_REFL
8990 Step: k < n + 1 ==> TAKE (k + 1) (leibniz_seg_arm a b (n + 1)) ++ DROP k (leibniz_seg_arm a b n) wriggle
8991 leibniz_seg_arm a b (n + 1)
8992 Let p1 = leibniz_seg_arm (a + 1) b (n + 1)
8993 p2 = TAKE (k + 1) p1 ++ DROP k (leibniz_seg_arm a b n)
8994 p3 = TAKE (k + 2) (leibniz_seg_arm (a + 1) b (n + 1)) ++ DROP (k + 1) (leibniz_seg_arm a b n)
8995 Then p2 zigzag p3 by leibniz_seg_arm_zigzag_step
8996 and p3 wriggle p1 by induction hypothesis
8997 Hence p2 wriggle p1 by RTC_RULES
8998*)
8999Theorem leibniz_seg_arm_wriggle_step:
9000 !n k. k < n + 1 ==> !a b.
9001 TAKE (k + 1) (leibniz_seg_arm (a + 1) b (n + 1)) ++ DROP k (leibniz_seg_arm a b n) wriggle
9002 leibniz_seg_arm (a + 1) b (n + 1)
9003Proof
9004 Induct_on `n - k` >| [
9005 rpt strip_tac >>
9006 `k = n` by decide_tac >>
9007 metis_tac[leibniz_seg_arm_len, TAKE_LENGTH_ID, DROP_LENGTH_NIL, APPEND_NIL, RTC_REFL],
9008 rpt strip_tac >>
9009 qabbrev_tac `p1 = leibniz_seg_arm (a + 1) b (n + 1)` >>
9010 qabbrev_tac `p2 = TAKE (k + 1) p1 ++ DROP k (leibniz_seg_arm a b n)` >>
9011 qabbrev_tac `p3 = TAKE (k + 2) (leibniz_seg_arm (a + 1) b (n + 1)) ++ DROP (k + 1) (leibniz_seg_arm a b n)` >>
9012 `p2 zigzag p3` by rw[leibniz_seg_arm_zigzag_step, Abbr`p1`, Abbr`p2`, Abbr`p3`] >>
9013 `v = n - (k + 1)` by decide_tac >>
9014 `k + 1 < n + 1` by decide_tac >>
9015 `k + 1 + 1 = k + 2` by decide_tac >>
9016 metis_tac[RTC_RULES]
9017 ]
9018QED
9019
9020(* Theorem: ([leibniz (a + 1) b] ++ leibniz_seg_arm a b n) wriggle leibniz_seg_arm (a + 1) b (n + 1) *)
9021(* Proof:
9022 Apply > leibniz_seg_arm_wriggle_step |> SPEC ``n:num`` |> SPEC ``0`` |> SIMP_RULE std_ss[DROP_0];
9023 val it =
9024 |- 0 < n + 1 ==> !a b.
9025 TAKE 1 (leibniz_seg_arm (a + 1) b (n + 1)) ++ leibniz_seg_arm a b n wriggle
9026 leibniz_seg_arm (a + 1) b (n + 1):
9027 thm
9028
9029 Note 0 < n + 1 by ADD1, SUC_POS
9030 [leibniz (a + 1) b] ++ leibniz_seg_arm a b n
9031 = TAKE 1 (leibniz_seg_arm (a + 1) b (n + 1)) ++ leibniz_seg_arm a b n by leibniz_seg_arm_head
9032 = TAKE 1 (leibniz_seg_arm (a + 1) b (n + 1)) ++ DROP 0 (leibniz_seg_arm a b n) by DROP_0
9033 wriggle leibniz_seg_arm (a + 1) b (n + 1) by leibniz_seg_arm_wriggle_step, put k = 0
9034*)
9035Theorem leibniz_seg_arm_wriggle_row_arm:
9036 !a b n. ([leibniz (a + 1) b] ++ leibniz_seg_arm a b n) wriggle leibniz_seg_arm (a + 1) b (n + 1)
9037Proof
9038 rpt strip_tac >>
9039 `0 < n + 1 /\ (0 + 1 = 1)` by decide_tac >>
9040 metis_tac[leibniz_seg_arm_head, leibniz_seg_arm_wriggle_step, DROP_0]
9041QED
9042
9043(* Theorem: b <= a /\ n <= a + 1 - b ==> (leibniz_col_arm a b n) wriggle (leibniz_seg_arm a b n) *)
9044(* Proof:
9045 By induction on n.
9046 Base: leibniz_col_arm a b 0 wriggle leibniz_seg_arm a b 0
9047 Since leibniz_col_arm a b 0 = [] by leibniz_col_arm_0
9048 and leibniz_seg_arm a b 0 = [] by leibniz_seg_arm_0
9049 Hence leibniz_col_arm a b 0 wriggle leibniz_seg_arm a b 0 by leibniz_wriggle_refl
9050 Step: !a b. leibniz_col_arm a b n wriggle leibniz_seg_arm a b n ==>
9051 leibniz_col_arm a b (SUC n) wriggle leibniz_seg_arm a b (SUC n)
9052 Induct_on a.
9053 Base: b <= 0 /\ SUC n <= 0 + 1 - b ==> leibniz_col_arm 0 b (SUC n) wriggle leibniz_seg_arm 0 b (SUC n)
9054 Note SUC n <= 1 - b ==> n = 0, since 0 <= b.
9055 leibniz_col_arm 0 b (SUC 0)
9056 = leibniz_col_arm 0 b 1 by ONE
9057 = [leibniz 0 b] by leibniz_col_arm_1
9058 leibniz_seg_arm 0 b (SUC 0)
9059 = leibniz_seg_arm 0 b 1 by ONE
9060 = [leibniz 0 b] by leibniz_seg_arm_1
9061 Hence leibniz_col_arm 0 b 1 wriggle
9062 leibniz_seg_arm 0 b 1 by leibniz_wriggle_refl
9063 Step: b <= SUC a /\ SUC n <= SUC a + 1 - b ==> leibniz_col_arm (SUC a) b (SUC n) wriggle leibniz_seg_arm (SUC a) b (SUC n)
9064 Note n <= a + 1 - b
9065 If a + 1 = b,
9066 Then n = 0,
9067 leibniz_col_arm (SUC a) b (SUC 0)
9068 = leibniz_col_arm (SUC a) b 1 by ONE
9069 = [leibniz (SUC a) b] by leibniz_col_arm_1
9070 = leibniz_seg_arm (SUC a) b 1 by leibniz_seg_arm_1
9071 = leibniz_seg_arm (SUC a) b (SUC 0) by ONE
9072 Hence leibniz_col_arm (SUC a) b 1 wriggle
9073 leibniz_seg_arm (SUC a) b 1 by leibniz_wriggle_refl
9074 If a + 1 <> b,
9075 Then b <= a, and induction hypothesis applies.
9076 Let x = leibniz (a + 1) b.
9077 Then leibniz_col_arm (a + 1) b (n + 1)
9078 = [x] ++ (leibniz_col_arm a b n) by leibniz_col_arm_cons
9079 Since leibniz_col_arm a b n
9080 wriggle leibniz_seg_arm a b n by induction hypothesis
9081 so ([x] ++ (leibniz_col_arm a b n)) wriggle
9082 ([x] ++ (leibniz_seg_arm a b n)) by leibniz_wriggle_tail
9083 and ([x] ++ (leibniz_seg_arm a b n)) wriggle
9084 (leibniz_seg_arm (a + 1) b (n + 1)) by leibniz_seg_arm_wriggle_row_arm
9085 Hence leibniz_col_arm a b (SUC n) wriggle
9086 leibniz_seg_arm a b (SUC n) by leibniz_wriggle_trans, ADD1
9087*)
9088Theorem leibniz_col_arm_wriggle_row_arm:
9089 !a b n. b <= a /\ n <= a + 1 - b ==> (leibniz_col_arm a b n) wriggle (leibniz_seg_arm a b n)
9090Proof
9091 Induct_on `n` >-
9092 rw[leibniz_col_arm_0, leibniz_seg_arm_0] >>
9093 rpt strip_tac >>
9094 Induct_on `a` >| [
9095 rpt strip_tac >>
9096 `n = 0` by decide_tac >>
9097 metis_tac[leibniz_col_arm_1, leibniz_seg_arm_1, ONE, leibniz_wriggle_refl],
9098 rpt strip_tac >>
9099 `n <= a + 1 - b` by decide_tac >>
9100 Cases_on `a + 1 = b` >| [
9101 `n = 0` by decide_tac >>
9102 metis_tac[leibniz_col_arm_1, leibniz_seg_arm_1, ONE, leibniz_wriggle_refl],
9103 `b <= a` by decide_tac >>
9104 qabbrev_tac `x = leibniz (a + 1) b` >>
9105 `leibniz_col_arm (a + 1) b (n + 1) = [x] ++ (leibniz_col_arm a b n)` by rw[leibniz_col_arm_cons, Abbr`x`] >>
9106 `([x] ++ (leibniz_col_arm a b n)) wriggle ([x] ++ (leibniz_seg_arm a b n))` by rw[leibniz_wriggle_tail] >>
9107 `([x] ++ (leibniz_seg_arm a b n)) wriggle (leibniz_seg_arm (a + 1) b (n + 1))` by rw[leibniz_seg_arm_wriggle_row_arm, Abbr`x`] >>
9108 metis_tac[leibniz_wriggle_trans, ADD1]
9109 ]
9110 ]
9111QED
9112
9113(* Theorem: b <= a /\ n <= a + 1 - b ==> (list_lcm (leibniz_col_arm a b n) = list_lcm (leibniz_seg_arm a b n)) *)
9114(* Proof:
9115 Since (leibniz_col_arm a b n) wriggle (leibniz_seg_arm a b n) by leibniz_col_arm_wriggle_row_arm
9116 the result follows by list_lcm_wriggle
9117*)
9118Theorem leibniz_lcm_invariance:
9119 !a b n. b <= a /\ n <= a + 1 - b ==> (list_lcm (leibniz_col_arm a b n) = list_lcm (leibniz_seg_arm a b n))
9120Proof
9121 rw[leibniz_col_arm_wriggle_row_arm, list_lcm_wriggle]
9122QED
9123
9124(* This is a milestone theorem. *)
9125
9126(* This is used to give another proof of leibniz_up_wriggle_horizontal *)
9127
9128(* Theorem: leibniz_col_arm n 0 (n + 1) = leibniz_up n *)
9129(* Proof:
9130 leibniz_col_arm n 0 (n + 1)
9131 = MAP (\x. leibniz (n - x) 0) [0 ..< (n + 1)] by notation
9132 = MAP (\x. leibniz (n - x) 0) [0 .. n] by listRangeLHI_to_INC
9133 = MAP ((\x. leibniz x 0) o (\x. n - x)) [0 .. n] by function composition
9134 = REVERSE (MAP (\x. leibniz x 0) [0 .. n]) by listRangeINC_REVERSE_MAP
9135 = REVERSE (MAP (\x. x + 1) [0 .. n]) by leibniz_n_0
9136 = REVERSE (MAP SUC [0 .. n]) by ADD1
9137 = REVERSE (MAP (I o SUC) [0 .. n]) by I_THM
9138 = REVERSE [1 .. (n+1)] by listRangeINC_MAP_SUC
9139 = REVERSE (leibniz_vertical n) by notation
9140 = leibniz_up n by notation
9141*)
9142Theorem leibniz_col_arm_n_0:
9143 !n. leibniz_col_arm n 0 (n + 1) = leibniz_up n
9144Proof
9145 rpt strip_tac >>
9146 `(\x. x + 1) = SUC` by rw[FUN_EQ_THM] >>
9147 `(\x. leibniz x 0) o (\x. n - x + 0) = (\x. leibniz (n - x) 0)` by rw[FUN_EQ_THM] >>
9148 `leibniz_col_arm n 0 (n + 1) = MAP (\x. leibniz (n - x) 0) [0 .. n]` by rw[listRangeLHI_to_INC] >>
9149 `_ = MAP ((\x. leibniz x 0) o (\x. n - x + 0)) [0 .. n]` by rw[] >>
9150 `_ = REVERSE (MAP (\x. leibniz x 0) [0 .. n])` by rw[listRangeINC_REVERSE_MAP] >>
9151 `_ = REVERSE (MAP (\x. x + 1) [0 .. n])` by rw[leibniz_n_0] >>
9152 `_ = REVERSE (MAP SUC [0 .. n])` by rw[ADD1] >>
9153 `_ = REVERSE (MAP (I o SUC) [0 .. n])` by rw[] >>
9154 `_ = REVERSE [1 .. (n+1)]` by rw[GSYM listRangeINC_MAP_SUC] >>
9155 rw[]
9156QED
9157
9158(* Theorem: leibniz_seg_arm n 0 (n + 1) = leibniz_horizontal n *)
9159(* Proof:
9160 leibniz_seg_arm n 0 (n + 1)
9161 = MAP (\x. leibniz n x) [0 ..< (n + 1)] by notation
9162 = MAP (\x. leibniz n x) [0 .. n] by listRangeLHI_to_INC
9163 = MAP (leibniz n) [0 .. n] by FUN_EQ_THM
9164 = MAP (leibniz n) (GENLIST (\i. i) (n + 1)) by listRangeINC_def
9165 = GENLIST ((leibniz n) o I) (n + 1) by MAP_GENLIST
9166 = GENLIST (leibniz n) (n + 1) by I_THM
9167 = leibniz_horizontal n by notation
9168*)
9169Theorem leibniz_seg_arm_n_0:
9170 !n. leibniz_seg_arm n 0 (n + 1) = leibniz_horizontal n
9171Proof
9172 rpt strip_tac >>
9173 `(\x. x) = I` by rw[FUN_EQ_THM] >>
9174 `(\x. leibniz n x) = leibniz n` by rw[FUN_EQ_THM] >>
9175 `leibniz_seg_arm n 0 (n + 1) = MAP (leibniz n) [0 .. n]` by rw_tac std_ss[listRangeLHI_to_INC] >>
9176 `_ = MAP (leibniz n) (GENLIST (\i. i) (n + 1))` by rw[listRangeINC_def] >>
9177 `_ = MAP (leibniz n) (GENLIST I (n + 1))` by metis_tac[] >>
9178 `_ = GENLIST ((leibniz n) o I) (n + 1)` by rw[MAP_GENLIST] >>
9179 `_ = GENLIST (leibniz n) (n + 1)` by rw[] >>
9180 rw[]
9181QED
9182
9183(* Theorem: (leibniz_up n) wriggle (leibniz_horizontal n) *)
9184(* Proof:
9185 Note 0 <= n /\ n + 1 <= n + 1 - 0, so leibniz_col_arm_wriggle_row_arm applies.
9186 leibniz_up n
9187 = leibniz_col_arm n 0 (n + 1) by leibniz_col_arm_n_0
9188 wriggle leibniz_seg_arm n 0 (n + 1) by leibniz_col_arm_wriggle_row_arm
9189 = leibniz_horizontal n by leibniz_seg_arm_n_0
9190*)
9191Theorem leibniz_up_wriggle_horizontal_alt:
9192 !n. (leibniz_up n) wriggle (leibniz_horizontal n)
9193Proof
9194 rpt strip_tac >>
9195 `0 <= n /\ n + 1 <= n + 1 - 0` by decide_tac >>
9196 metis_tac[leibniz_col_arm_wriggle_row_arm, leibniz_col_arm_n_0, leibniz_seg_arm_n_0]
9197QED
9198
9199(* Theorem: list_lcm (leibniz_up n) = list_lcm (leibniz_horizontal n) *)
9200(* Proof: by leibniz_up_wriggle_horizontal_alt, list_lcm_wriggle *)
9201Theorem leibniz_up_lcm_eq_horizontal_lcm:
9202 !n. list_lcm (leibniz_up n) = list_lcm (leibniz_horizontal n)
9203Proof
9204 rw[leibniz_up_wriggle_horizontal_alt, list_lcm_wriggle]
9205QED
9206
9207(* This is another proof of the milestone theorem. *)
9208
9209(* ------------------------------------------------------------------------- *)
9210(* LCM Lower bound using big LCM *)
9211(* ------------------------------------------------------------------------- *)
9212
9213(* Laurent's leib.v and leib.html
9214
9215Lemma leibn_lcm_swap m n :
9216 lcmn 'L(m.+1, n) 'L(m, n) = lcmn 'L(m.+1, n) 'L(m.+1, n.+1).
9217Proof.
9218rewrite ![lcmn 'L(m.+1, n) _]lcmnC.
9219by apply/lcmn_swap/leibnS.
9220Qed.
9221
9222Notation "\lcm_ ( i < n ) F" :=
9223 (\big[lcmn/1%N]_(i < n ) F%N)
9224 (at level 41, F at level 41, i, n at level 50,
9225 format "'[' \lcm_ ( i < n ) '/ ' F ']'") : nat_scope.
9226
9227Canonical Structure lcmn_moid : Monoid.law 1 :=
9228 Monoid.Law lcmnA lcm1n lcmn1.
9229Canonical lcmn_comoid := Monoid.ComLaw lcmnC.
9230
9231Lemma lieb_line n i k : lcmn 'L(n.+1, i) (\lcm_(j < k) 'L(n, i + j)) =
9232 \lcm_(j < k.+1) 'L(n.+1, i + j).
9233Proof.
9234elim: k i => [i|k1 IH i].
9235 by rewrite big_ord_recr !big_ord0 /= lcmn1 lcm1n addn0.
9236rewrite big_ord_recl /= addn0.
9237rewrite lcmnA leibn_lcm_swap.
9238rewrite (eq_bigr (fun j : 'I_k1 => 'L(n, i.+1 + j))).
9239rewrite -lcmnA.
9240rewrite IH.
9241rewrite [RHS]big_ord_recl.
9242rewrite addn0; congr (lcmn _ _).
9243by apply: eq_bigr => j _; rewrite addnS.
9244move=> j _.
9245by rewrite addnS.
9246Qed.
9247
9248Lemma leib_corner n : \lcm_(i < n.+1) 'L(i, 0) = \lcm_(i < n.+1) 'L(n, i).
9249Proof.
9250elim: n => [|n IH]; first by rewrite !big_ord_recr !big_ord0 /=.
9251rewrite big_ord_recr /= IH lcmnC.
9252rewrite (eq_bigr (fun i : 'I_n.+1 => 'L(n, 0 + i))) //.
9253by rewrite lieb_line.
9254Qed.
9255
9256Lemma main_result n : 2^n.-1 <= \lcm_(i < n) i.+1.
9257Proof.
9258case: n => [|n /=]; first by rewrite big_ord0.
9259have <-: \lcm_(i < n.+1) 'L(i, 0) = \lcm_(i < n.+1) i.+1.
9260 by apply: eq_bigr => i _; rewrite leibn0.
9261rewrite leib_corner.
9262have -> : forall j, \lcm_(i < j.+1) 'L(n, i) = n.+1 * \lcm_(i < j.+1) 'C(n, i).
9263 elim=> [|j IH]; first by rewrite !big_ord_recr !big_ord0 /= !lcm1n.
9264 by rewrite big_ord_recr [in RHS]big_ord_recr /= IH muln_lcmr.
9265rewrite (expnDn 1 1) /= (eq_bigr (fun i : 'I_n.+1 => 'C(n, i))) =>
9266 [|i _]; last by rewrite !exp1n !muln1.
9267have <- : forall n m, \sum_(i < n) m = n * m.
9268 by move=> m1 n1; rewrite sum_nat_const card_ord.
9269apply: leq_sum => i _.
9270apply: dvdn_leq; last by rewrite (bigD1 i) //= dvdn_lcml.
9271apply big_ind => // [x y Hx Hy|x H]; first by rewrite lcmn_gt0 Hx.
9272by rewrite bin_gt0 -ltnS.
9273Qed.
9274
9275*)
9276
9277(*
9278Lemma lieb_line n i k : lcmn 'L(n.+1, i) (\lcm_(j < k) 'L(n, i + j)) = \lcm_(j < k.+1) 'L(n.+1, i + j).
9279
9280translates to:
9281 !n i k. lcm (leibniz (n + 1) i) (big_lcm {leibniz n (i + j) | j | j < k}) =
9282 big_lcm {leibniz (n+1) (i + j) | j | j < k + 1};
9283
9284The picture is:
9285
9286 n-th row: L n i L n (i+1) .... L n (i + (k-1))
9287(n+1)-th row: L (n+1) i
9288
9289(n+1)-th row: L (n+1) i L (n+1) (i+1) .... L (n+1) (i + (k-1)) L (n+1) (i + k)
9290
9291If k = 1, this is: L n i transform to:
9292 L (n+1) i L (n+1) i L (n+1) (i+1)
9293which is Leibniz triplet.
9294
9295In general, if true for k, then for the next (k+1)
9296
9297 n-th row: L n i L n (i+1) .... L n (i + (k-1)) L n (i + k)
9298(n+1)-th row: L (n+1) i
9299= L n (i + k)
9300(n+1)-th row: L (n+1) i L (n+1) (i+1) .... L (n+1) (i + (k-1)) L (n+1) (i + k)
9301by induction hypothesis
9302=
9303(n+1)-th row: L (n+1) i L (n+1) (i+1) .... L (n+1) (i + (k-1)) L (n+1) (i + k) L (n+1) (i + (k+1))
9304by Leibniz triplet.
9305
9306*)
9307
9308(* Introduce a segment, a partial horizontal row, in Leibniz Denominator Triangle *)
9309Overload leibniz_seg = ``\n k h. IMAGE (\j. leibniz n (k + j)) (count h)``
9310(* This is a segment starting at leibniz n k, of length h *)
9311
9312(* Introduce a horizontal row in Leibniz Denominator Triangle *)
9313Overload leibniz_row = ``\n h. IMAGE (leibniz n) (count h)``
9314(* This is a row starting at leibniz n 0, of length h *)
9315
9316(* Introduce a vertical column in Leibniz Denominator Triangle *)
9317Overload leibniz_col = ``\h. IMAGE (\i. leibniz i 0) (count h)``
9318(* This is a column starting at leibniz 0 0, descending for a length h *)
9319
9320(* Representations of paths based on indexed sets *)
9321
9322(* Theorem: leibniz_seg n k h = {leibniz n (k + j) | j | j IN (count h)} *)
9323(* Proof: by notation *)
9324Theorem leibniz_seg_def:
9325 !n k h. leibniz_seg n k h = {leibniz n (k + j) | j | j IN (count h)}
9326Proof
9327 rw[EXTENSION]
9328QED
9329
9330(* Theorem: leibniz_row n h = {leibniz n j | j | j IN (count h)} *)
9331(* Proof: by notation *)
9332Theorem leibniz_row_def:
9333 !n h. leibniz_row n h = {leibniz n j | j | j IN (count h)}
9334Proof
9335 rw[EXTENSION]
9336QED
9337
9338(* Theorem: leibniz_col h = {leibniz j 0 | j | j IN (count h)} *)
9339(* Proof: by notation *)
9340Theorem leibniz_col_def:
9341 !h. leibniz_col h = {leibniz j 0 | j | j IN (count h)}
9342Proof
9343 rw[EXTENSION]
9344QED
9345
9346(* Theorem: leibniz_col n = natural n *)
9347(* Proof:
9348 leibniz_col n
9349 = IMAGE (\i. leibniz i 0) (count n) by notation
9350 = IMAGE (\i. i + 1) (count n) by leibniz_n_0
9351 = IMAGE (\i. SUC i) (count n) by ADD1
9352 = IMAGE SUC (count n) by FUN_EQ_THM
9353 = natural n by notation
9354*)
9355Theorem leibniz_col_eq_natural:
9356 !n. leibniz_col n = natural n
9357Proof
9358 rw[leibniz_n_0, ADD1, FUN_EQ_THM]
9359QED
9360
9361(* The following can be taken as a generalisation of the Leibniz Triplet LCM exchange. *)
9362(* When length h = 1, the top row is a singleton, and the next row is a duplet, altogether a triplet. *)
9363
9364(* Theorem: lcm (leibniz (n + 1) k) (big_lcm (leibniz_seg n k h)) = big_lcm (leibniz_seg (n + 1) k (h + 1)) *)
9365(* Proof:
9366 Let p = (\j. leibniz n (k + j)), q = (\j. leibniz (n + 1) (k + j)).
9367 Note q 0 = (leibniz (n + 1) k) by function application [1]
9368 The goal is: lcm (leibniz (n + 1) k) (big_lcm (IMAGE p (count h))) = big_lcm (IMAGE q (count (h + 1)))
9369
9370 By induction on h, length of the row.
9371 Base case: lcm (leibniz (n + 1) k) (big_lcm (IMAGE p (count 0))) = big_lcm (IMAGE q (count (0 + 1)))
9372 lcm (leibniz (n + 1) k) (big_lcm (IMAGE p (count 0)))
9373 = lcm (q 0) (big_lcm (IMAGE p (count 0))) by [1]
9374 = lcm (q 0) (big_lcm (IMAGE p {})) by COUNT_ZERO
9375 = lcm (q 0) (big_lcm {}) by IMAGE_EMPTY
9376 = lcm (q 0) 1 by big_lcm_empty
9377 = q 0 by LCM_1
9378 = big_lcm {q 0} by big_lcm_sing
9379 = big_lcm (IMAEG q {0}) by IMAGE_SING
9380 = big_lcm (IMAGE q (count 1)) by count_def, EXTENSION
9381
9382 Step case: lcm (leibniz (n + 1) k) (big_lcm (IMAGE p (count h))) = big_lcm (IMAGE q (count (h + 1))) ==>
9383 lcm (leibniz (n + 1) k) (big_lcm (IMAGE p (upto h))) = big_lcm (IMAGE q (count (SUC h + 1)))
9384 Note !n. FINITE (count n) by FINITE_COUNT
9385 and !s. FINITE s ==> FINITE (IMAGE f s) by IMAGE_FINITE
9386 Also p h = (triplet n (k + h)).a by leibniz_triplet_member
9387 q h = (triplet n (k + h)).b by leibniz_triplet_member
9388 q (h + 1) = (triplet n (k + h)).c by leibniz_triplet_member
9389 Thus lcm (q h) (p h) = lcm (q h) (q (h + 1)) by leibniz_triplet_lcm
9390
9391 lcm (leibniz (n + 1) k) (big_lcm (IMAGE p (upto h)))
9392 = lcm (q 0) (big_lcm (IMAGE p (count (SUC h)))) by [1], notation
9393 = lcm (q 0) (big_lcm (IMAGE p (h INSERT count h))) by upto_by_count
9394 = lcm (q 0) (big_lcm ((p h) INSERT (IMAGE p (count h)))) by IMAGE_INSERT
9395 = lcm (q 0) (lcm (p h) (big_lcm (IMAGE p (count h)))) by big_lcm_insert
9396 = lcm (p h) (lcm (q 0) (big_lcm (IMAGE p (count h)))) by LCM_ASSOC_COMM
9397 = lcm (p h) (big_lcm (IMAGE q (count (h + 1)))) by induction hypothesis
9398 = lcm (p h) (big_lcm (IMAGE q (count (SUC h)))) by ADD1
9399 = lcm (p h) (big_lcm (IMAGE q (h INSERT (count h))) by upto_by_count
9400 = lcm (p h) (big_lcm ((q h) INSERT IMAGE q (count h))) by IMAGE_INSERT
9401 = lcm (p h) (lcm (q h) (big_lcm (IMAGE q (count h)))) by big_lcm_insert
9402 = lcm (lcm (p h) (q h)) (big_lcm (IMAGE q (count h))) by LCM_ASSOC
9403 = lcm (lcm (q h) (p h)) (big_lcm (IMAGE q (count h))) by LCM_COM
9404 = lcm (lcm (q h) (q (h + 1))) (big_lcm (IMAGE q (count h))) by leibniz_triplet_lcm
9405 = lcm (q (h + 1)) (lcm (q h) (big_lcm (IMAGE q (count h)))) by LCM_ASSOC, LCM_COMM
9406 = lcm (q (h + 1)) (big_lcm ((q h) INSERT IMAGE q (count h))) by big_lcm_insert
9407 = lcm (q (h + 1)) (big_lcm (IMAGE q (h INSERT count h)) by IMAGE_INSERT
9408 = lcm (q (h + 1)) (big_lcm (IMAGE q (count (h + 1)))) by upto_by_count, ADD1
9409 = big_lcm ((q (h + 1)) INSERT (IMAGE q (count (h + 1)))) by big_lcm_insert
9410 = big_lcm IMAGE q ((h + 1) INSERT (count (h + 1))) by IMAGE_INSERT
9411 = big_lcm (IMAGE q (count (SUC (h + 1)))) by upto_by_count
9412 = big_lcm (IMAGE q (count (SUC h + 1))) by ADD
9413*)
9414Theorem big_lcm_seg_transform:
9415 !n k h. lcm (leibniz (n + 1) k) (big_lcm (leibniz_seg n k h)) =
9416 big_lcm (leibniz_seg (n + 1) k (h + 1))
9417Proof
9418 rpt strip_tac >>
9419 qabbrev_tac `p = (\j. leibniz n (k + j))` >>
9420 qabbrev_tac `q = (\j. leibniz (n + 1) (k + j))` >>
9421 Induct_on `h` >| [
9422 `count 0 = {}` by rw[] >>
9423 `count 1 = {0}` by rw[COUNT_1] >>
9424 rw_tac std_ss[IMAGE_EMPTY, big_lcm_empty, IMAGE_SING, LCM_1, big_lcm_sing, Abbr`p`, Abbr`q`],
9425 `leibniz (n + 1) k = q 0` by rw[Abbr`q`] >>
9426 simp[] >>
9427 `lcm (q h) (p h) = lcm (q h) (q (h + 1))` by
9428 (`p h = (triplet n (k + h)).a` by rw[leibniz_triplet_member, Abbr`p`] >>
9429 `q h = (triplet n (k + h)).b` by rw[leibniz_triplet_member, Abbr`q`] >>
9430 `q (h + 1) = (triplet n (k + h)).c` by rw[leibniz_triplet_member, Abbr`q`] >>
9431 rw[leibniz_triplet_lcm]) >>
9432 `lcm (q 0) (big_lcm (IMAGE p (count (SUC h)))) = lcm (q 0) (lcm (p h) (big_lcm (IMAGE p (count h))))` by rw[upto_by_count, big_lcm_insert] >>
9433 `_ = lcm (p h) (lcm (q 0) (big_lcm (IMAGE p (count h))))` by rw[LCM_ASSOC_COMM] >>
9434 `_ = lcm (p h) (big_lcm (IMAGE q (count (SUC h))))` by metis_tac[ADD1] >>
9435 `_ = lcm (p h) (lcm (q h) (big_lcm (IMAGE q (count h))))` by rw[upto_by_count, big_lcm_insert] >>
9436 `_ = lcm (q (h + 1)) (lcm (q h) (big_lcm (IMAGE q (count h))))` by metis_tac[LCM_ASSOC, LCM_COMM] >>
9437 `_ = lcm (q (h + 1)) (big_lcm (IMAGE q (count (SUC h))))` by rw[upto_by_count, big_lcm_insert] >>
9438 `_ = lcm (q (h + 1)) (big_lcm (IMAGE q (count (h + 1))))` by rw[ADD1] >>
9439 `_ = big_lcm (IMAGE q (count (SUC (h + 1))))` by rw[upto_by_count, big_lcm_insert] >>
9440 metis_tac[ADD]
9441 ]
9442QED
9443
9444(* Theorem: lcm (leibniz (n + 1) 0) (big_lcm (leibniz_row n h)) = big_lcm (leibniz_row (n + 1) (h + 1)) *)
9445(* Proof:
9446 Note !n h. leibniz_row n h = leibniz_seg n 0 h by FUN_EQ_THM
9447 Take k = 0 in big_lcm_seg_transform, the result follows.
9448*)
9449Theorem big_lcm_row_transform:
9450 !n h. lcm (leibniz (n + 1) 0) (big_lcm (leibniz_row n h)) = big_lcm (leibniz_row (n + 1) (h + 1))
9451Proof
9452 rpt strip_tac >>
9453 `!n h. leibniz_row n h = leibniz_seg n 0 h` by rw[FUN_EQ_THM] >>
9454 metis_tac[big_lcm_seg_transform]
9455QED
9456
9457(* Theorem: big_lcm (leibniz_col (n + 1)) = big_lcm (leibniz_row n (n + 1)) *)
9458(* Proof:
9459 Let f = \i. leibniz i 0, then f 0 = leibniz 0 0.
9460 By induction on n.
9461 Base: big_lcm (leibniz_col (0 + 1)) = big_lcm (leibniz_row 0 (0 + 1))
9462 big_lcm (leibniz_col (0 + 1))
9463 = big_lcm (IMAGE f (count 1)) by notation
9464 = big_lcm (IMAGE f) {0}) by COUNT_1
9465 = big_lcm {f 0} by IMAGE_SING
9466 = big_lcm {leibniz 0 0} by f 0
9467 = big_lcm (IMAGE (leibniz 0) {0}) by IMAGE_SING
9468 = big_lcm (IMAGE (leibniz 0) (count 1)) by COUNT_1
9469
9470 Step: big_lcm (leibniz_col (n + 1)) = big_lcm (leibniz_row n (n + 1)) ==>
9471 big_lcm (leibniz_col (SUC n + 1)) = big_lcm (leibniz_row (SUC n) (SUC n + 1))
9472 big_lcm (leibniz_col (SUC n + 1))
9473 = big_lcm (IMAGE f (count (SUC n + 1))) by notation
9474 = big_lcm (IMAGE f (count (SUC (n + 1)))) by ADD
9475 = big_lcm (IMAGE f ((n + 1) INSERT (count (n + 1)))) by upto_by_count
9476 = big_lcm ((f (n + 1)) INSERT (IMAGE f (count (n + 1)))) by IMAGE_INSERT
9477 = lcm (f (n + 1)) (big_lcm (IMAGE f (count (n + 1)))) by big_lcm_insert
9478 = lcm (f (n + 1)) (big_lcm (IMAGE (leibniz n) (count (n + 1)))) by induction hypothesis
9479 = lcm (leibniz (n + 1) 0) (big_lcm (IMAGE (leibniz n) (count (n + 1)))) by f (n + 1)
9480 = big_lcm (IMAGE (leibniz (n + 1)) (count (n + 1 + 1))) by big_lcm_line_transform
9481 = big_lcm (IMAGE (leibniz (SUC n)) (count (SUC n + 1))) by ADD1
9482*)
9483Theorem big_lcm_corner_transform:
9484 !n. big_lcm (leibniz_col (n + 1)) = big_lcm (leibniz_row n (n + 1))
9485Proof
9486 Induct >-
9487 rw[COUNT_1, IMAGE_SING] >>
9488 qabbrev_tac `f = \i. leibniz i 0` >>
9489 `big_lcm (IMAGE f (count (SUC n + 1))) = big_lcm (IMAGE f (count (SUC (n + 1))))` by rw[ADD] >>
9490 `_ = lcm (f (n + 1)) (big_lcm (IMAGE f (count (n + 1))))` by rw[upto_by_count, big_lcm_insert] >>
9491 `_ = lcm (leibniz (n + 1) 0) (big_lcm (IMAGE (leibniz n) (count (n + 1))))` by rw[Abbr`f`] >>
9492 `_ = big_lcm (IMAGE (leibniz (n + 1)) (count (n + 1 + 1)))` by rw[big_lcm_row_transform] >>
9493 `_ = big_lcm (IMAGE (leibniz (SUC n)) (count (SUC n + 1)))` by rw[ADD1] >>
9494 rw[]
9495QED
9496
9497(* Theorem: (!x. x IN (count (n + 1)) ==> 0 < f x) ==>
9498 SUM (GENLIST f (n + 1)) <= (n + 1) * big_lcm (IMAGE f (count (n + 1))) *)
9499(* Proof:
9500 By induction on n.
9501 Base: SUM (GENLIST f (0 + 1)) <= (0 + 1) * big_lcm (IMAGE f (count (0 + 1)))
9502 LHS = SUM (GENLIST f 1)
9503 = SUM [f 0] by GENLIST_1
9504 = f 0 by SUM
9505 RHS = 1 * big_lcm (IMAGE f (count 1))
9506 = big_lcm (IMAGE f {0}) by COUNT_1
9507 = big_lcm (f 0) by IMAGE_SING
9508 = f 0 by big_lcm_sing
9509 Thus LHS <= RHS by arithmetic
9510 Step: SUM (GENLIST f (n + 1)) <= (n + 1) * big_lcm (IMAGE f (count (n + 1))) ==>
9511 SUM (GENLIST f (SUC n + 1)) <= (SUC n + 1) * big_lcm (IMAGE f (count (SUC n + 1)))
9512 Note 0 < f (n + 1) by (n + 1) IN count (SUC n + 1)
9513 and !y. y IN count (n + 1) ==> y IN count (SUC n + 1) by IN_COUNT
9514 and !x. x IN IMAGE f (count (n + 1)) ==> 0 < x by IN_IMAGE, above
9515 so 0 < big_lcm (IMAGE f (count (n + 1))) by big_lcm_positive
9516 and 0 < SUC n by SUC_POS
9517 Thus f (n + 1) <= lcm (f (n + 1)) (big_lcm (IMAGE f (count (n + 1)))) by LCM_LE
9518 and big_lcm (IMAGE f (count (n + 1))) <= lcm (f (n + 1)) (big_lcm (IMAGE f (count (n + 1)))) by LCM_LE
9519
9520 LHS = SUM (GENLIST f (SUC n + 1))
9521 = SUM (GENLIST f (SUC (n + 1))) by ADD
9522 = SUM (SNOC (f (n + 1)) (GENLIST f (n + 1))) by GENLIST
9523 = SUM (GENLIST f (n + 1)) + f (n + 1) by SUM_SNOC
9524 RHS = (SUC n + 1) * big_lcm (IMAGE f (count (SUC n + 1)))
9525 = (SUC n + 1) * big_lcm (IMAGE f (count (SUC (n + 1)))) by ADD
9526 = (SUC n + 1) * big_lcm (IMAGE f ((n + 1) INSERT (count (n + 1)))) by upto_by_count
9527 = (SUC n + 1) * big_lcm ((f (n + 1)) INSERT (IMAGE f (count (n + 1)))) by IMAGE_INSERT
9528 = (SUC n + 1) * lcm (f (n + 1)) (big_lcm (IMAGE f (count (n + 1)))) by big_lcm_insert
9529 = SUC n * lcm (f (n + 1)) (big_lcm (IMAGE f (count (n + 1))))
9530 + 1 * lcm (f (n + 1)) (big_lcm (IMAGE f (count (n + 1)))) by RIGHT_ADD_DISTRIB
9531 >= SUC n * (big_lcm (IMAGE f (count (n + 1)))) + f (n + 1) by LCM_LE
9532 = (n + 1) * (big_lcm (IMAGE f (count (n + 1)))) + f (n + 1) by ADD1
9533 >= SUM (GENLIST f (n + 1)) + f (n + 1) by induction hypothesis
9534 = LHS by above
9535*)
9536Theorem big_lcm_count_lower_bound:
9537 !f n. (!x. x IN (count (n + 1)) ==> 0 < f x) ==>
9538 SUM (GENLIST f (n + 1)) <= (n + 1) * big_lcm (IMAGE f (count (n + 1)))
9539Proof
9540 rpt strip_tac >>
9541 Induct_on `n` >| [
9542 rpt strip_tac >>
9543 `SUM (GENLIST f 1) = f 0` by rw[] >>
9544 `1 * big_lcm (IMAGE f (count 1)) = f 0` by rw[COUNT_1, big_lcm_sing] >>
9545 rw[],
9546 rpt strip_tac >>
9547 `big_lcm (IMAGE f (count (SUC n + 1))) = big_lcm (IMAGE f (count (SUC (n + 1))))` by rw[ADD] >>
9548 `_ = lcm (f (n + 1)) (big_lcm (IMAGE f (count (n + 1))))` by rw[upto_by_count, big_lcm_insert] >>
9549 `!x. (SUC n + 1) * x = SUC n * x + x` by rw[] >>
9550 `0 < f (n + 1)` by rw[] >>
9551 `!y. y IN count (n + 1) ==> y IN count (SUC n + 1)` by rw[] >>
9552 `!x. x IN IMAGE f (count (n + 1)) ==> 0 < x` by metis_tac[IN_IMAGE] >>
9553 `0 < big_lcm (IMAGE f (count (n + 1)))` by rw[big_lcm_positive] >>
9554 `0 < SUC n` by rw[] >>
9555 `f (n + 1) <= lcm (f (n + 1)) (big_lcm (IMAGE f (count (n + 1))))` by rw[LCM_LE] >>
9556 `big_lcm (IMAGE f (count (n + 1))) <= lcm (f (n + 1)) (big_lcm (IMAGE f (count (n + 1))))` by rw[LCM_LE] >>
9557 `!a b c x. 0 < a /\ 0 < b /\ 0 < c /\ a <= x /\ b <= x ==> c * a + b <= c * x + x` by
9558 (rpt strip_tac >>
9559 `c * a <= c * x` by rw[] >>
9560 decide_tac) >>
9561 `SUC n * (big_lcm (IMAGE f (count (n + 1)))) + f (n + 1) <= (SUC n + 1) * lcm (f (n + 1)) (big_lcm (IMAGE f (count (n + 1))))` by metis_tac[] >>
9562 `SUC n * (big_lcm (IMAGE f (count (n + 1)))) + f (n + 1) = (n + 1) * (big_lcm (IMAGE f (count (n + 1)))) + f (n + 1)` by rw[ADD1] >>
9563 `SUM (GENLIST f (SUC n + 1)) = SUM (GENLIST f (SUC (n + 1)))` by rw[ADD] >>
9564 `_ = SUM (GENLIST f (n + 1)) + f (n + 1)` by rw[GENLIST, SUM_SNOC] >>
9565 metis_tac[LESS_EQ_TRANS, DECIDE``!a x y. 0 < a /\ x <= y ==> x + a <= y + a``]
9566 ]
9567QED
9568
9569(* Theorem: big_lcm (natural (n + 1)) = (n + 1) * big_lcm (IMAGE (binomial n) (count (n + 1))) *)
9570(* Proof:
9571 Note SUC = \i. i + 1 by ADD1, FUN_EQ_THM
9572 = \i. leibniz i 0 by leibniz_n_0
9573 and leibniz n = \j. (n + 1) * binomial n j by leibniz_def, FUN_EQ_THM
9574 so !s. IMAGE SUC s = IMAGE (\i. leibniz i 0) s by IMAGE_CONG
9575 and !s. IMAGE (leibniz n) s = IMAGE (\j. (n + 1) * binomial n j) s by IMAGE_CONG
9576 also !s. IMAGE (binomial n) s = IMAGE (\j. binomial n j) s by FUN_EQ_THM, IMAGE_CONG
9577 and count (n + 1) <> {} by COUNT_EQ_EMPTY, n + 1 <> 0 [1]
9578
9579 big_lcm (IMAGE SUC (count (n + 1)))
9580 = big_lcm (IMAGE (\i. leibniz i 0) (count (n + 1))) by above
9581 = big_lcm (IMAGE (leibniz n) (count (n + 1))) by big_lcm_corner_transform
9582 = big_lcm (IMAGE (\j. (n + 1) * binomial n j) (count (n + 1))) by leibniz_def
9583 = big_lcm (IMAGE ($* (n + 1)) (IMAGE (binomial n) (count (n + 1)))) by IMAGE_COMPOSE, o_DEF
9584 = (n + 1) * big_lcm (IMAGE (binomial n) (count (n + 1))) by big_lcm_map_times, FINITE_COUNT, [1]
9585*)
9586Theorem big_lcm_natural_eqn:
9587 !n. big_lcm (natural (n + 1)) = (n + 1) * big_lcm (IMAGE (binomial n) (count (n + 1)))
9588Proof
9589 rpt strip_tac >>
9590 `SUC = \i. leibniz i 0` by rw[leibniz_n_0, FUN_EQ_THM] >>
9591 `leibniz n = \j. (n + 1) * binomial n j` by rw[leibniz_def, FUN_EQ_THM] >>
9592 `!s. IMAGE SUC s = IMAGE (\i. leibniz i 0) s` by rw[IMAGE_CONG] >>
9593 `!s. IMAGE (leibniz n) s = IMAGE (\j. (n + 1) * binomial n j) s` by rw[IMAGE_CONG] >>
9594 `!s. IMAGE (binomial n) s = IMAGE (\j. binomial n j) s` by rw[FUN_EQ_THM, IMAGE_CONG] >>
9595 `count (n + 1) <> {}` by rw[COUNT_EQ_EMPTY] >>
9596 `big_lcm (IMAGE SUC (count (n + 1))) = big_lcm (IMAGE (leibniz n) (count (n + 1)))` by rw[GSYM big_lcm_corner_transform] >>
9597 `_ = big_lcm (IMAGE (\j. (n + 1) * binomial n j) (count (n + 1)))` by rw[] >>
9598 `_ = big_lcm (IMAGE ($* (n + 1)) (IMAGE (binomial n) (count (n + 1))))` by rw[GSYM IMAGE_COMPOSE, combinTheory.o_DEF] >>
9599 `_ = (n + 1) * big_lcm (IMAGE (binomial n) (count (n + 1)))` by rw[big_lcm_map_times] >>
9600 rw[]
9601QED
9602
9603(* Theorem: 2 ** n <= big_lcm (natural (n + 1)) *)
9604(* Proof:
9605 Note !x. x IN (count (n + 1)) ==> 0 < (binomial n) x by binomial_pos, IN_COUNT [1]
9606 big_lcm (natural (n + 1))
9607 = (n + 1) * big_lcm (IMAGE (binomial n) (count (n + 1))) by big_lcm_natural_eqn
9608 >= SUM (GENLIST (binomial n) (n + 1)) by big_lcm_count_lower_bound, [1]
9609 = SUM (GENLIST (binomial n) (SUC n)) by ADD1
9610 = 2 ** n by binomial_sum
9611*)
9612Theorem big_lcm_lower_bound:
9613 !n. 2 ** n <= big_lcm (natural (n + 1))
9614Proof
9615 rpt strip_tac >>
9616 `!x. x IN (count (n + 1)) ==> 0 < (binomial n) x` by rw[binomial_pos] >>
9617 `big_lcm (IMAGE SUC (count (n + 1))) = (n + 1) * big_lcm (IMAGE (binomial n) (count (n + 1)))` by rw[big_lcm_natural_eqn] >>
9618 `SUM (GENLIST (binomial n) (n + 1)) = 2 ** n` by rw[GSYM binomial_sum, ADD1] >>
9619 metis_tac[big_lcm_count_lower_bound]
9620QED
9621
9622(* Another proof of the milestone theorem. *)
9623
9624(* Theorem: big_lcm (set l) = list_lcm l *)
9625(* Proof:
9626 By induction on l.
9627 Base: big_lcm (set []) = list_lcm []
9628 big_lcm (set [])
9629 = big_lcm {} by LIST_TO_SET
9630 = 1 by big_lcm_empty
9631 = list_lcm [] by list_lcm_nil
9632 Step: big_lcm (set l) = list_lcm l ==> !h. big_lcm (set (h::l)) = list_lcm (h::l)
9633 Note FINITE (set l) by FINITE_LIST_TO_SET
9634 big_lcm (set (h::l))
9635 = big_lcm (h INSERT set l) by LIST_TO_SET
9636 = lcm h (big_lcm (set l)) by big_lcm_insert, FINITE (set t)
9637 = lcm h (list_lcm l) by induction hypothesis
9638 = list_lcm (h::l) by list_lcm_cons
9639*)
9640Theorem big_lcm_eq_list_lcm:
9641 !l. big_lcm (set l) = list_lcm l
9642Proof
9643 Induct >-
9644 rw[big_lcm_empty] >>
9645 rw[big_lcm_insert]
9646QED
9647
9648(* ------------------------------------------------------------------------- *)
9649(* List LCM depends only on its set of elements *)
9650(* ------------------------------------------------------------------------- *)
9651
9652(* Theorem: MEM x l ==> (list_lcm (x::l) = list_lcm l) *)
9653(* Proof:
9654 By induction on l.
9655 Base: MEM x [] ==> (list_lcm [x] = list_lcm [])
9656 True by MEM x [] = F by MEM
9657 Step: MEM x l ==> (list_lcm (x::l) = list_lcm l) ==>
9658 !h. MEM x (h::l) ==> (list_lcm (x::h::l) = list_lcm (h::l))
9659 Note MEM x (h::l) ==> (x = h) \/ (MEM x l) by MEM
9660 If x = h,
9661 list_lcm (h::h::l)
9662 = lcm h (lcm h (list_lcm l)) by list_lcm_cons
9663 = lcm (lcm h h) (list_lcm l) by LCM_ASSOC
9664 = lcm h (list_lcm l) by LCM_REF
9665 = list_lcm (h::l) by list_lcm_cons
9666 If x <> h, MEM x l
9667 list_lcm (x::h::l)
9668 = lcm x (lcm h (list_lcm l)) by list_lcm_cons
9669 = lcm h (lcm x (list_lcm l)) by LCM_ASSOC_COMM
9670 = lcm h (list_lcm (x::l)) by list_lcm_cons
9671 = lcm h (list_lcm l) by induction hypothesis, MEM x l
9672 = list_lcm (h::l) by list_lcm_cons
9673*)
9674Theorem list_lcm_absorption:
9675 !x l. MEM x l ==> (list_lcm (x::l) = list_lcm l)
9676Proof
9677 rpt strip_tac >>
9678 Induct_on `l` >-
9679 metis_tac[MEM] >>
9680 rw[MEM] >| [
9681 `lcm h (lcm h (list_lcm l)) = lcm (lcm h h) (list_lcm l)` by rw[LCM_ASSOC] >>
9682 rw[LCM_REF],
9683 `lcm x (lcm h (list_lcm l)) = lcm h (lcm x (list_lcm l))` by rw[LCM_ASSOC_COMM] >>
9684 `_ = lcm h (list_lcm (x::l))` by metis_tac[list_lcm_cons] >>
9685 rw[]
9686 ]
9687QED
9688
9689(* Theorem: list_lcm (nub l) = list_lcm l *)
9690(* Proof:
9691 By induction on l.
9692 Base: list_lcm (nub []) = list_lcm []
9693 True since nub [] = [] by nub_nil
9694 Step: list_lcm (nub l) = list_lcm l ==> !h. list_lcm (nub (h::l)) = list_lcm (h::l)
9695 If MEM h l,
9696 list_lcm (nub (h::l))
9697 = list_lcm (nub l) by nub_cons, MEM h l
9698 = list_lcm l by induction hypothesis
9699 = list_lcm (h::l) by list_lcm_absorption, MEM h l
9700 If ~(MEM h l),
9701 list_lcm (nub (h::l))
9702 = list_lcm (h::nub l) by nub_cons, ~(MEM h l)
9703 = lcm h (list_lcm (nub l)) by list_lcm_cons
9704 = lcm h (list_lcm l) by induction hypothesis
9705 = list_lcm (h::l) by list_lcm_cons
9706*)
9707Theorem list_lcm_nub:
9708 !l. list_lcm (nub l) = list_lcm l
9709Proof
9710 Induct >-
9711 rw[nub_nil] >>
9712 metis_tac[nub_cons, list_lcm_cons, list_lcm_absorption]
9713QED
9714
9715(* Theorem: (set l1 = set l2) ==> (list_lcm (nub l1) = list_lcm (nub l2)) *)
9716(* Proof:
9717 By induction on l1.
9718 Base: !l2. (set [] = set l2) ==> (list_lcm (nub []) = list_lcm (nub l2))
9719 Note set [] = set l2 ==> l2 = [] by LIST_TO_SET_EQ_EMPTY
9720 Hence true.
9721 Step: !l2. (set l1 = set l2) ==> (list_lcm (nub l1) = list_lcm (nub l2)) ==>
9722 !h l2. (set (h::l1) = set l2) ==> (list_lcm (nub (h::l1)) = list_lcm (nub l2))
9723 If MEM h l1,
9724 Then h IN (set l1) by notation
9725 set (h::l1)
9726 = h INSERT set l1 by LIST_TO_SET
9727 = set l1 by ABSORPTION_RWT
9728 Thus set l1 = set l2,
9729 so list_lcm (nub (h::l1))
9730 = list_lcm (nub l1) by nub_cons, MEM h l1
9731 = list_lcm (nub l2) by induction hypothesis, set l1 = set l2
9732
9733 If ~(MEM h l1),
9734 Then set (h::l1) = set l2
9735 ==> ?p1 p2. nub l2 = p1 ++ [h] ++ p2
9736 and set l1 = set (p1 ++ p2) by LIST_TO_SET_REDUCTION
9737
9738 list_lcm (nub (h::l1))
9739 = list_lcm (h::nub l1) by nub_cons, ~(MEM h l1)
9740 = lcm h (list_lcm (nub l1)) by list_lcm_cons
9741 = lcm h (list_lcm (nub (p1 ++ p2))) by induction hypothesis
9742 = lcm h (list_lcm (p1 ++ p2)) by list_lcm_nub
9743 = lcm h (lcm (list_lcm p1) (list_lcm p2)) by list_lcm_append
9744 = lcm (list_lcm p1) (lcm h (list_lcm p2)) by LCM_ASSOC_COMM
9745 = lcm (list_lcm p1) (list_lcm (h::p2)) by list_lcm_append
9746 = lcm (list_lcm p1) (list_lcm ([h] ++ p2)) by CONS_APPEND
9747 = list_lcm (p1 ++ ([h] ++ p2)) by list_lcm_append
9748 = list_lcm (p1 ++ [h] ++ p2) by APPEND_ASSOC
9749 = list_lcm (nub l2) by above
9750*)
9751Theorem list_lcm_nub_eq_if_set_eq:
9752 !l1 l2. (set l1 = set l2) ==> (list_lcm (nub l1) = list_lcm (nub l2))
9753Proof
9754 Induct >-
9755 rw[LIST_TO_SET_EQ_EMPTY] >>
9756 rpt strip_tac >>
9757 Cases_on `MEM h l1` >-
9758 metis_tac[LIST_TO_SET, ABSORPTION_RWT, nub_cons] >>
9759 `?p1 p2. (nub l2 = p1 ++ [h] ++ p2) /\ (set l1 = set (p1 ++ p2))` by metis_tac[LIST_TO_SET_REDUCTION] >>
9760 `list_lcm (nub (h::l1)) = list_lcm (h::nub l1)` by rw[nub_cons] >>
9761 `_ = lcm h (list_lcm (nub l1))` by rw[list_lcm_cons] >>
9762 `_ = lcm h (list_lcm (nub (p1 ++ p2)))` by metis_tac[] >>
9763 `_ = lcm h (list_lcm (p1 ++ p2))` by rw[list_lcm_nub] >>
9764 `_ = lcm h (lcm (list_lcm p1) (list_lcm p2))` by rw[list_lcm_append] >>
9765 `_ = lcm (list_lcm p1) (lcm h (list_lcm p2))` by rw[LCM_ASSOC_COMM] >>
9766 `_ = lcm (list_lcm p1) (list_lcm ([h] ++ p2))` by rw[list_lcm_cons] >>
9767 metis_tac[list_lcm_append, APPEND_ASSOC]
9768QED
9769
9770(* Theorem: (set l1 = set l2) ==> (list_lcm l1 = list_lcm l2) *)
9771(* Proof:
9772 set l1 = set l2
9773 ==> list_lcm (nub l1) = list_lcm (nub l2) by list_lcm_nub_eq_if_set_eq
9774 ==> list_lcm l1 = list_lcm l2 by list_lcm_nub
9775*)
9776Theorem list_lcm_eq_if_set_eq:
9777 !l1 l2. (set l1 = set l2) ==> (list_lcm l1 = list_lcm l2)
9778Proof
9779 metis_tac[list_lcm_nub_eq_if_set_eq, list_lcm_nub]
9780QED
9781
9782(* ------------------------------------------------------------------------- *)
9783(* Set LCM by List LCM *)
9784(* ------------------------------------------------------------------------- *)
9785
9786(* Define LCM of a set *)
9787(* none works!
9788val set_lcm_def = Define`
9789 (set_lcm {} = 1) /\
9790 !s. FINITE s ==> !x. set_lcm (x INSERT s) = lcm x (set_lcm (s DELETE x))
9791`;
9792val set_lcm_def = Define`
9793 (set_lcm {} = 1) /\
9794 (!s. FINITE s ==> (set_lcm s = lcm (CHOICE s) (set_lcm (REST s))))
9795`;
9796val set_lcm_def = Define`
9797 set_lcm s = if s = {} then 1 else lcm (CHOICE s) (set_lcm (REST s))
9798`;
9799*)
9800Definition set_lcm_def:
9801 set_lcm s = list_lcm (SET_TO_LIST s)
9802End
9803
9804(* Theorem: set_lcm {} = 1 *)
9805(* Proof:
9806 set_lcm {}
9807 = lcm_list (SET_TO_LIST {}) by set_lcm_def
9808 = lcm_list [] by SET_TO_LIST_EMPTY
9809 = 1 by list_lcm_nil
9810*)
9811Theorem set_lcm_empty:
9812 set_lcm {} = 1
9813Proof
9814 rw[set_lcm_def]
9815QED
9816
9817(* Theorem: FINITE s /\ s <> {} ==> (set_lcm s = lcm (CHOICE s) (set_lcm (REST s))) *)
9818(* Proof:
9819 set_lcm s
9820 = list_lcm (SET_TO_LIST s) by set_lcm_def
9821 = list_lcm (CHOICE s::SET_TO_LIST (REST s)) by SET_TO_LIST_THM
9822 = lcm (CHOICE s) (list_lcm (SET_TO_LIST (REST s))) by list_lcm_cons
9823 = lcm (CHOICE s) (set_lcm (REST s)) by set_lcm_def
9824*)
9825Theorem set_lcm_nonempty:
9826 !s. FINITE s /\ s <> {} ==> (set_lcm s = lcm (CHOICE s) (set_lcm (REST s)))
9827Proof
9828 rw[set_lcm_def, SET_TO_LIST_THM, list_lcm_cons]
9829QED
9830
9831(* Theorem: set_lcm {x} = x *)
9832(* Proof:
9833 set_lcm {x}
9834 = list_lcm (SET_TO_LIST {x}) by set_lcm_def
9835 = list_lcm [x] by SET_TO_LIST_SING
9836 = x by list_lcm_sing
9837*)
9838Theorem set_lcm_sing:
9839 !x. set_lcm {x} = x
9840Proof
9841 rw_tac std_ss[set_lcm_def, SET_TO_LIST_SING, list_lcm_sing]
9842QED
9843
9844(* Theorem: set_lcm (set l) = list_lcm l *)
9845(* Proof:
9846 Let t = SET_TO_LIST (set l)
9847 Note FINITE (set l) by FINITE_LIST_TO_SET
9848 Then set t
9849 = set (SET_TO_LIST (set l)) by notation
9850 = set l by SET_TO_LIST_INV, FINITE (set l)
9851
9852 set_lcm (set l)
9853 = list_lcm (SET_TO_LIST (set l)) by set_lcm_def
9854 = list_lcm t by notation
9855 = list_lcm l by list_lcm_eq_if_set_eq, set t = set l
9856*)
9857Theorem set_lcm_eq_list_lcm:
9858 !l. set_lcm (set l) = list_lcm l
9859Proof
9860 rw[FINITE_LIST_TO_SET, SET_TO_LIST_INV, set_lcm_def, list_lcm_eq_if_set_eq]
9861QED
9862
9863(* Theorem: FINITE s ==> (set_lcm s = big_lcm s) *)
9864(* Proof:
9865 set_lcm s
9866 = list_lcm (SET_TO_LIST s) by set_lcm_def
9867 = big_lcm (set (SET_TO_LIST s)) by big_lcm_eq_list_lcm
9868 = big_lcm s by SET_TO_LIST_INV, FINITE s
9869*)
9870Theorem set_lcm_eq_big_lcm:
9871 !s. FINITE s ==> (big_lcm s = set_lcm s)
9872Proof
9873 metis_tac[set_lcm_def, big_lcm_eq_list_lcm, SET_TO_LIST_INV]
9874QED
9875
9876(* Theorem: FINITE s ==> !x. set_lcm (x INSERT s) = lcm x (set_lcm s) *)
9877(* Proof: by big_lcm_insert, set_lcm_eq_big_lcm *)
9878Theorem set_lcm_insert:
9879 !s. FINITE s ==> !x. set_lcm (x INSERT s) = lcm x (set_lcm s)
9880Proof
9881 rw[big_lcm_insert, GSYM set_lcm_eq_big_lcm]
9882QED
9883
9884(* Theorem: FINITE s /\ x IN s ==> x divides (set_lcm s) *)
9885(* Proof:
9886 Note FINITE s /\ x IN s
9887 ==> MEM x (SET_TO_LIST s) by MEM_SET_TO_LIST
9888 ==> x divides list_lcm (SET_TO_LIST s) by list_lcm_is_common_multiple
9889 or x divides (set_lcm s) by set_lcm_def
9890*)
9891Theorem set_lcm_is_common_multiple:
9892 !x s. FINITE s /\ x IN s ==> x divides (set_lcm s)
9893Proof
9894 rw[set_lcm_def] >>
9895 `MEM x (SET_TO_LIST s)` by rw[MEM_SET_TO_LIST] >>
9896 rw[list_lcm_is_common_multiple]
9897QED
9898
9899(* Theorem: FINITE s /\ (!x. x IN s ==> x divides m) ==> set_lcm s divides m *)
9900(* Proof:
9901 Note FINITE s
9902 ==> !x. x IN s <=> MEM x (SET_TO_LIST s) by MEM_SET_TO_LIST
9903 Thus list_lcm (SET_TO_LIST s) divides m by list_lcm_is_least_common_multiple
9904 or set_lcm s divides m by set_lcm_def
9905*)
9906Theorem set_lcm_is_least_common_multiple:
9907 !s m. FINITE s /\ (!x. x IN s ==> x divides m) ==> set_lcm s divides m
9908Proof
9909 metis_tac[set_lcm_def, MEM_SET_TO_LIST, list_lcm_is_least_common_multiple]
9910QED
9911
9912(* Theorem: FINITE s /\ PAIRWISE_COPRIME s ==> (set_lcm s = PROD_SET s) *)
9913(* Proof:
9914 By finite induction on s.
9915 Base: set_lcm {} = PROD_SET {}
9916 set_lcm {}
9917 = 1 by set_lcm_empty
9918 = PROD_SET {} by PROD_SET_EMPTY
9919 Step: PAIRWISE_COPRIME s ==> (set_lcm s = PROD_SET s) ==>
9920 e NOTIN s /\ PAIRWISE_COPRIME (e INSERT s) ==> set_lcm (e INSERT s) = PROD_SET (e INSERT s)
9921 Note !z. z IN s ==> coprime e z by IN_INSERT
9922 Thus coprime e (PROD_SET s) by every_coprime_prod_set_coprime
9923 set_lcm (e INSERT s)
9924 = lcm e (set_lcm s) by set_lcm_insert
9925 = lcm e (PROD_SET s) by induction hypothesis
9926 = e * (PROD_SET s) by LCM_COPRIME
9927 = PROD_SET (e INSERT s) by PROD_SET_INSERT, e NOTIN s
9928*)
9929Theorem pairwise_coprime_prod_set_eq_set_lcm:
9930 !s. FINITE s /\ PAIRWISE_COPRIME s ==> (set_lcm s = PROD_SET s)
9931Proof
9932 `!s. FINITE s ==> PAIRWISE_COPRIME s ==> (set_lcm s = PROD_SET s)` suffices_by rw[] >>
9933 Induct_on `FINITE` >>
9934 rpt strip_tac >-
9935 rw[set_lcm_empty, PROD_SET_EMPTY] >>
9936 fs[] >>
9937 `!z. z IN s ==> coprime e z` by metis_tac[] >>
9938 `coprime e (PROD_SET s)` by rw[every_coprime_prod_set_coprime] >>
9939 `set_lcm (e INSERT s) = lcm e (set_lcm s)` by rw[set_lcm_insert] >>
9940 `_ = lcm e (PROD_SET s)` by rw[] >>
9941 `_ = e * (PROD_SET s)` by rw[LCM_COPRIME] >>
9942 `_ = PROD_SET (e INSERT s)` by rw[PROD_SET_INSERT] >>
9943 rw[]
9944QED
9945
9946(* This is a generalisation of LCM_COPRIME |- !m n. coprime m n ==> (lcm m n = m * n) *)
9947
9948(* Theorem: FINITE s /\ PAIRWISE_COPRIME s /\ (!x. x IN s ==> x divides m) ==> (PROD_SET s) divides m *)
9949(* Proof:
9950 Note PROD_SET s = set_lcm s by pairwise_coprime_prod_set_eq_set_lcm
9951 and set_lcm s divides m by set_lcm_is_least_common_multiple
9952 ==> (PROD_SET s) divides m
9953*)
9954Theorem pairwise_coprime_prod_set_divides:
9955 !s m. FINITE s /\ PAIRWISE_COPRIME s /\ (!x. x IN s ==> x divides m) ==> (PROD_SET s) divides m
9956Proof
9957 rw[set_lcm_is_least_common_multiple, GSYM pairwise_coprime_prod_set_eq_set_lcm]
9958QED
9959
9960(* ------------------------------------------------------------------------- *)
9961(* Nair's Trick - using List LCM directly *)
9962(* ------------------------------------------------------------------------- *)
9963
9964(* Overload on consecutive LCM *)
9965Overload lcm_run = ``\n. list_lcm [1 .. n]``
9966
9967(* Theorem: lcm_run n = FOLDL lcm 1 [1 .. n] *)
9968(* Proof:
9969 lcm_run n
9970 = list_lcm [1 .. n] by notation
9971 = FOLDL lcm 1 [1 .. n] by list_lcm_by_FOLDL
9972*)
9973Theorem lcm_run_by_FOLDL:
9974 !n. lcm_run n = FOLDL lcm 1 [1 .. n]
9975Proof
9976 rw[list_lcm_by_FOLDL]
9977QED
9978
9979(* Theorem: lcm_run n = FOLDL lcm 1 [1 .. n] *)
9980(* Proof:
9981 lcm_run n
9982 = list_lcm [1 .. n] by notation
9983 = FOLDR lcm 1 [1 .. n] by list_lcm_by_FOLDR
9984*)
9985Theorem lcm_run_by_FOLDR:
9986 !n. lcm_run n = FOLDR lcm 1 [1 .. n]
9987Proof
9988 rw[list_lcm_by_FOLDR]
9989QED
9990
9991(* Theorem: lcm_run 0 = 1 *)
9992(* Proof:
9993 lcm_run 0
9994 = list_lcm [1 .. 0] by notation
9995 = list_lcm [] by listRangeINC_EMPTY, 0 < 1
9996 = 1 by list_lcm_nil
9997*)
9998Theorem lcm_run_0:
9999 lcm_run 0 = 1
10000Proof
10001 rw[listRangeINC_EMPTY]
10002QED
10003
10004(* Theorem: lcm_run 1 = 1 *)
10005(* Proof:
10006 lcm_run 1
10007 = list_lcm [1 .. 1] by notation
10008 = list_lcm [1] by leibniz_vertical_0
10009 = 1 by list_lcm_sing
10010*)
10011Theorem lcm_run_1:
10012 lcm_run 1 = 1
10013Proof
10014 rw[leibniz_vertical_0, list_lcm_sing]
10015QED
10016
10017(* Theorem alias *)
10018Theorem lcm_run_suc = list_lcm_suc;
10019(* val lcm_run_suc = |- !n. lcm_run (n + 1) = lcm (n + 1) (lcm_run n): thm *)
10020
10021(* Theorem: 0 < lcm_run n *)
10022(* Proof:
10023 Note EVERY_POSITIVE [1 .. n] by listRangeINC_EVERY
10024 so lcm_run n
10025 = list_lcm [1 .. n] by notation
10026 > 0 by list_lcm_pos
10027*)
10028Theorem lcm_run_pos:
10029 !n. 0 < lcm_run n
10030Proof
10031 rw[list_lcm_pos, listRangeINC_EVERY]
10032QED
10033
10034(* Theorem: (lcm_run 2 = 2) /\ (lcm_run 3 = 6) /\ (lcm_run 4 = 12) /\ (lcm_run 5 = 60) /\ ... *)
10035(* Proof: by evaluation *)
10036Theorem lcm_run_small:
10037 (lcm_run 2 = 2) /\ (lcm_run 3 = 6) /\ (lcm_run 4 = 12) /\ (lcm_run 5 = 60) /\
10038 (lcm_run 6 = 60) /\ (lcm_run 7 = 420) /\ (lcm_run 8 = 840) /\ (lcm_run 9 = 2520)
10039Proof
10040 EVAL_TAC
10041QED
10042
10043(* Theorem: (n + 1) divides lcm_run (n + 1) /\ (lcm_run n) divides lcm_run (n + 1) *)
10044(* Proof:
10045 If n = 0,
10046 Then 0 + 1 = 1 by arithmetic
10047 and lcm_run 0 = 1 by lcm_run_0
10048 Hence true by ONE_DIVIDES_ALL
10049 If n <> 0,
10050 Then n - 1 + 1 = n by arithmetic, 0 < n
10051 lcm_run (n + 1)
10052 = list_lcm [1 .. (n + 1)] by notation
10053 = list_lcm (SNOC (n + 1) [1 .. n]) by leibniz_vertical_snoc
10054 = lcm (n + 1) (list_lcm [1 .. n]) by list_lcm_snoc]
10055 = lcm (n + 1) (lcm_run n) by notation
10056 Hence true by LCM_DIVISORS
10057*)
10058Theorem lcm_run_divisors:
10059 !n. (n + 1) divides lcm_run (n + 1) /\ (lcm_run n) divides lcm_run (n + 1)
10060Proof
10061 strip_tac >>
10062 Cases_on `n = 0` >-
10063 rw[lcm_run_0] >>
10064 `(n - 1 + 1 = n) /\ (n - 1 + 2 = n + 1)` by decide_tac >>
10065 `lcm_run (n + 1) = list_lcm (SNOC (n + 1) [1 .. n])` by metis_tac[leibniz_vertical_snoc] >>
10066 `_ = lcm (n + 1) (lcm_run n)` by rw[list_lcm_snoc] >>
10067 rw[LCM_DIVISORS]
10068QED
10069
10070(* Theorem: lcm_run n <= lcm_run (n + 1) *)
10071(* Proof:
10072 Note lcm_run n divides lcm_run (n + 1) by lcm_run_divisors
10073 and 0 < lcm_run (n + 1) ] by lcm_run_pos
10074 so lcm_run n <= lcm_run (n + 1) by DIVIDES_LE
10075*)
10076Theorem lcm_run_monotone[allow_rebind]:
10077 !n. lcm_run n <= lcm_run (n + 1)
10078Proof rw[lcm_run_divisors, lcm_run_pos, DIVIDES_LE]
10079QED
10080
10081(* Theorem: 2 ** n <= lcm_run (n + 1) *)
10082(* Proof:
10083 lcm_run (n + 1)
10084 = list_lcm [1 .. (n + 1)] by notation
10085 >= 2 ** n by lcm_lower_bound
10086*)
10087Theorem lcm_run_lower = lcm_lower_bound;
10088(*
10089val lcm_run_lower = |- !n. 2 ** n <= lcm_run (n + 1): thm
10090*)
10091
10092(* Theorem: !n k. k <= n ==> leibniz n k divides lcm_run (n + 1) *)
10093(* Proof: by notation, leibniz_vertical_divisor *)
10094Theorem lcm_run_leibniz_divisor = leibniz_vertical_divisor;
10095(*
10096val lcm_run_leibniz_divisor = |- !n k. k <= n ==> leibniz n k divides lcm_run (n + 1): thm
10097*)
10098
10099(* Theorem: n * 4 ** n <= lcm_run (2 * n + 1) *)
10100(* Proof:
10101 If n = 0, LHS = 0, trivially true.
10102 If n <> 0, 0 < n.
10103 Let m = 2 * n.
10104
10105 Claim: (m + 1) * binomial m n divides lcm_run (m + 1) [1]
10106 Proof: Note n <= m by LESS_MONO_MULT, 1 <= 2
10107 ==> (leibniz m n) divides lcm_run (m + 1) by lcm_run_leibniz_divisor, n <= m
10108 or (m + 1) * binomial m n divides lcm_run (m + 1) by leibniz_def
10109
10110 Claim: n * binomial m n divides lcm_run (m + 1) [2]
10111 Proof: Note 0 < m /\ n <= m - 1 by 0 < n
10112 and m - 1 + 1 = m by 0 < m
10113 Thus (leibniz (m - 1) n) divides lcm_run m by lcm_run_leibniz_divisor, n <= m - 1
10114 Note (lcm_run m) divides lcm_run (m + 1) by lcm_run_divisors
10115 so (leibniz (m - 1) n) divides lcm_run (m + 1) by DIVIDES_TRANS
10116 and leibniz (m - 1) n
10117 = (m - n) * binomial m n by leibniz_up_alt
10118 = n * binomial m n by m - n = n
10119
10120 Note coprime n (m + 1) by GCD_EUCLID, GCD_1, 1 < n
10121 Thus lcm (n * binomial m n) ((m + 1) * binomial m n)
10122 = n * (m + 1) * binomial m n by LCM_COMMON_COPRIME
10123 = n * ((m + 1) * binomial m n) by MULT_ASSOC
10124 = n * leibniz m n by leibniz_def
10125 ==> n * leibniz m n divides lcm_run (m + 1) by LCM_DIVIDES, [1], [2]
10126 Note 0 < lcm_run (m + 1) by lcm_run_pos
10127 or n * leibniz m n <= lcm_run (m + 1) by DIVIDES_LE, 0 < lcm_run (m + 1)
10128 Now 4 ** n <= leibniz m n by leibniz_middle_lower
10129 so n * 4 ** n <= n * leibniz m n by LESS_MONO_MULT, MULT_COMM
10130 or n * 4 ** n <= lcm_run (m + 1) by LESS_EQ_TRANS
10131*)
10132Theorem lcm_run_lower_odd:
10133 !n. n * 4 ** n <= lcm_run (2 * n + 1)
10134Proof
10135 rpt strip_tac >>
10136 Cases_on `n = 0` >-
10137 rw[] >>
10138 `0 < n` by decide_tac >>
10139 qabbrev_tac `m = 2 * n` >>
10140 `(m + 1) * binomial m n divides lcm_run (m + 1)` by
10141 (`n <= m` by rw[Abbr`m`] >>
10142 metis_tac[lcm_run_leibniz_divisor, leibniz_def]) >>
10143 `n * binomial m n divides lcm_run (m + 1)` by
10144 (`0 < m /\ n <= m - 1` by rw[Abbr`m`] >>
10145 `m - 1 + 1 = m` by decide_tac >>
10146 `(leibniz (m - 1) n) divides lcm_run m` by metis_tac[lcm_run_leibniz_divisor] >>
10147 `(lcm_run m) divides lcm_run (m + 1)` by rw[lcm_run_divisors] >>
10148 `leibniz (m - 1) n = (m - n) * binomial m n` by rw[leibniz_up_alt] >>
10149 `_ = n * binomial m n` by rw[Abbr`m`] >>
10150 metis_tac[DIVIDES_TRANS]) >>
10151 `coprime n (m + 1)` by rw[GCD_EUCLID, Abbr`m`] >>
10152 `lcm (n * binomial m n) ((m + 1) * binomial m n) = n * (m + 1) * binomial m n` by rw[LCM_COMMON_COPRIME] >>
10153 `_ = n * leibniz m n` by rw[leibniz_def, MULT_ASSOC] >>
10154 `n * leibniz m n divides lcm_run (m + 1)` by metis_tac[LCM_DIVIDES] >>
10155 `n * leibniz m n <= lcm_run (m + 1)` by rw[DIVIDES_LE, lcm_run_pos] >>
10156 `4 ** n <= leibniz m n` by rw[leibniz_middle_lower, Abbr`m`] >>
10157 metis_tac[LESS_MONO_MULT, MULT_COMM, LESS_EQ_TRANS]
10158QED
10159
10160(* Theorem: n * 4 ** n <= lcm_run (2 * (n + 1)) *)
10161(* Proof:
10162 lcm_run (2 * (n + 1))
10163 = lcm_run (2 * n + 2) by arithmetic
10164 >= lcm_run (2 * n + 1) by lcm_run_monotone
10165 >= n * 4 ** n by lcm_run_lower_odd
10166*)
10167Theorem lcm_run_lower_even:
10168 !n. n * 4 ** n <= lcm_run (2 * (n + 1))
10169Proof
10170 rpt strip_tac >>
10171 `2 * (n + 1) = 2 * n + 1 + 1` by decide_tac >>
10172 metis_tac[lcm_run_monotone, lcm_run_lower_odd, LESS_EQ_TRANS]
10173QED
10174
10175(* Theorem: ODD n ==> (HALF n) * HALF (2 ** n) <= lcm_run n *)
10176(* Proof:
10177 Let k = HALF n.
10178 Then n = 2 * k + 1 by ODD_HALF
10179 and HALF (2 ** n)
10180 = HALF (2 ** (2 * k + 1)) by above
10181 = HALF (2 ** (SUC (2 * k))) by ADD1
10182 = HALF (2 * 2 ** (2 * k)) by EXP
10183 = 2 ** (2 * k) by HALF_TWICE
10184 = 4 ** k by EXP_EXP_MULT
10185 Since k * 4 ** k <= lcm_run (2 * k + 1) by lcm_run_lower_odd
10186 The result follows.
10187*)
10188Theorem lcm_run_odd_lower:
10189 !n. ODD n ==> (HALF n) * HALF (2 ** n) <= lcm_run n
10190Proof
10191 rpt strip_tac >>
10192 qabbrev_tac `k = HALF n` >>
10193 `n = 2 * k + 1` by rw[ODD_HALF, Abbr`k`] >>
10194 `HALF (2 ** n) = HALF (2 ** (SUC (2 * k)))` by rw[ADD1] >>
10195 `_ = HALF (2 * 2 ** (2 * k))` by rw[EXP] >>
10196 `_ = 2 ** (2 * k)` by rw[HALF_TWICE] >>
10197 `_ = 4 ** k` by rw[EXP_EXP_MULT] >>
10198 metis_tac[lcm_run_lower_odd]
10199QED
10200
10201Theorem HALF_MULT_EVEN'[local] = ONCE_REWRITE_RULE [MULT_COMM] HALF_MULT_EVEN
10202
10203(* Theorem: EVEN n ==> HALF (n - 2) * HALF (HALF (2 ** n)) <= lcm_run n *)
10204(* Proof:
10205 If n = 0, HALF (n - 2) = 0, so trivially true.
10206 If n <> 0,
10207 Let h = HALF n.
10208 Then n = 2 * h by EVEN_HALF
10209 Note h <> 0 by n <> 0
10210 so ?k. h = k + 1 by num_CASES, ADD1
10211 or n = 2 * k + 2 by n = 2 * (k + 1)
10212 and HALF (HALF (2 ** n))
10213 = HALF (HALF (2 ** (2 * k + 2))) by above
10214 = HALF (HALF (2 ** SUC (SUC (2 * k)))) by ADD1
10215 = HALF (HALF (2 * (2 * 2 ** (2 * k)))) by EXP
10216 = 2 ** (2 * k) by HALF_TWICE
10217 = 4 ** k by EXP_EXP_MULT
10218 Also n - 2 = 2 * k by 0 < n, n = 2 * k + 2
10219 so HALF (n - 2) = k by HALF_TWICE
10220 Since k * 4 ** k <= lcm_run (2 * (k + 1)) by lcm_run_lower_even
10221 The result follows.
10222*)
10223Theorem lcm_run_even_lower:
10224 !n. EVEN n ==> HALF (n - 2) * HALF (HALF (2 ** n)) <= lcm_run n
10225Proof
10226 rpt strip_tac >>
10227 Cases_on `n = 0` >- rw[] >>
10228 qabbrev_tac `h = HALF n` >>
10229 `n = 2 * h` by rw[EVEN_HALF, Abbr`h`] >>
10230 `h <> 0` by rw[Abbr`h`] >>
10231 `?k. h = k + 1` by metis_tac[num_CASES, ADD1] >>
10232 `HALF (HALF (2 ** n)) = HALF (HALF (2 ** SUC (SUC (2 * k))))` by simp[ADD1] >>
10233 `_ = HALF (HALF (2 * (2 * 2 ** (2 * k))))` by rw[EXP, HALF_MULT_EVEN'] >>
10234 `_ = 2 ** (2 * k)` by rw[HALF_TWICE] >>
10235 `_ = 4 ** k` by rw[EXP_EXP_MULT] >>
10236 `n - 2 = 2 * k` by decide_tac >>
10237 `HALF (n - 2) = k` by rw[HALF_TWICE] >>
10238 metis_tac[lcm_run_lower_even]
10239QED
10240
10241(* Theorem: ODD n /\ 5 <= n ==> 2 ** n <= lcm_run n *)
10242(* Proof:
10243 This follows by lcm_run_odd_lower
10244 if we can show: 2 ** n <= HALF n * HALF (2 ** n)
10245
10246 Note HALF 5 = 2 by arithmetic
10247 and HALF 5 <= HALF n by DIV_LE_MONOTONE, 0 < 2
10248 Also n <> 0 by 5 <= n
10249 so ?m. n = SUC m by num_CASES
10250 HALF n * HALF (2 ** n)
10251 = HALF n * HALF (2 * 2 ** m) by EXP
10252 = HALF n * 2 ** m by HALF_TWICE
10253 >= 2 * 2 ** m by LESS_MONO_MULT
10254 = 2 ** (SUC m) by EXP
10255 = 2 ** n by n = SUC m
10256*)
10257Theorem lcm_run_odd_lower_alt:
10258 !n. ODD n /\ 5 <= n ==> 2 ** n <= lcm_run n
10259Proof
10260 rpt strip_tac >>
10261 `2 ** n <= HALF n * HALF (2 ** n)` by
10262 (`HALF 5 = 2` by EVAL_TAC >>
10263 `HALF 5 <= HALF n` by rw[DIV_LE_MONOTONE] >>
10264 `n <> 0` by decide_tac >>
10265 `?m. n = SUC m` by metis_tac[num_CASES] >>
10266 `HALF n * HALF (2 ** n) = HALF n * HALF (2 * 2 ** m)` by rw[EXP] >>
10267 `_ = HALF n * 2 ** m` by rw[HALF_TWICE] >>
10268 `2 * 2 ** m <= HALF n * 2 ** m` by rw[LESS_MONO_MULT] >>
10269 rw[EXP]) >>
10270 metis_tac[lcm_run_odd_lower, LESS_EQ_TRANS]
10271QED
10272
10273(* Theorem: EVEN n /\ 8 <= n ==> 2 ** n <= lcm_run n *)
10274(* Proof:
10275 If n = 8,
10276 Then 2 ** 8 = 256 by arithmetic
10277 and lcm_run 8 = 840 by lcm_run_small
10278 Thus true.
10279 If n <> 8,
10280 Note ODD 9 by arithmetic
10281 so n <> 9 by ODD_EVEN
10282 or 10 <= n by 8 <= n, n <> 9
10283 This follows by lcm_run_even_lower
10284 if we can show: 2 ** n <= HALF (n - 2) * HALF (HALF (2 ** n))
10285
10286 Let m = n - 2.
10287 Then 8 <= m by arithmetic
10288 or HALF 8 <= HALF m by DIV_LE_MONOTONE, 0 < 2
10289 and HALF 8 = 4 = 2 * 2 by arithmetic
10290 Now n = SUC (SUC m) by arithmetic
10291 HALF m * HALF (HALF (2 ** n))
10292 = HALF m * HALF (HALF (2 ** (SUC (SUC m)))) by above
10293 = HALF m * HALF (HALF (2 * (2 * 2 ** m))) by EXP
10294 = HALF m * 2 ** m by HALF_TWICE
10295 >= 4 * 2 ** m by LESS_MONO_MULT
10296 = 2 * (2 * 2 ** m) by MULT_ASSOC
10297 = 2 ** (SUC (SUC m)) by EXP
10298 = 2 ** n by n = SUC (SUC m)
10299*)
10300Theorem lcm_run_even_lower_alt:
10301 !n. EVEN n /\ 8 <= n ==> 2 ** n <= lcm_run n
10302Proof
10303 rpt strip_tac >>
10304 Cases_on `n = 8` >- rw[lcm_run_small] >>
10305 `2 ** n <= HALF (n - 2) * HALF (HALF (2 ** n))`
10306 by (`ODD 9` by rw[] >>
10307 `n <> 9` by metis_tac[ODD_EVEN] >>
10308 `8 <= n - 2` by decide_tac >>
10309 qabbrev_tac `m = n - 2` >>
10310 `n = SUC (SUC m)` by rw[Abbr`m`] >>
10311 ‘HALF m * HALF (HALF (2 ** n)) =
10312 HALF m * HALF (HALF (2 * (2 * 2 ** m)))’ by rw[EXP, HALF_MULT_EVEN'] >>
10313 `_ = HALF m * 2 ** m` by rw[HALF_TWICE] >>
10314 `HALF 8 <= HALF m` by rw[DIV_LE_MONOTONE] >>
10315 `HALF 8 = 4` by EVAL_TAC >>
10316 `2 * (2 * 2 ** m) <= HALF m * 2 ** m` by rw[LESS_MONO_MULT] >>
10317 rw[EXP]) >>
10318 metis_tac[lcm_run_even_lower, LESS_EQ_TRANS]
10319QED
10320
10321(* Theorem: 7 <= n ==> 2 ** n <= lcm_run n *)
10322(* Proof:
10323 If EVEN n,
10324 Node ODD 7 by arithmetic
10325 so n <> 7 by EVEN_ODD
10326 or 8 <= n by arithmetic
10327 Hence true by lcm_run_even_lower_alt
10328 If ~EVEN n, then ODD n by EVEN_ODD
10329 Note 7 <= n ==> 5 <= n by arithmetic
10330 Hence true by lcm_run_odd_lower_alt
10331*)
10332Theorem lcm_run_lower_better:
10333 !n. 7 <= n ==> 2 ** n <= lcm_run n
10334Proof
10335 rpt strip_tac >>
10336 `EVEN n \/ ODD n` by rw[EVEN_OR_ODD] >| [
10337 `ODD 7` by rw[] >>
10338 `n <> 7` by metis_tac[ODD_EVEN] >>
10339 rw[lcm_run_even_lower_alt],
10340 rw[lcm_run_odd_lower_alt]
10341 ]
10342QED
10343
10344
10345(* ------------------------------------------------------------------------- *)
10346(* Nair's Trick -- rework *)
10347(* ------------------------------------------------------------------------- *)
10348
10349(*
10350Picture:
10351leibniz_lcm_property |- !n. lcm_run (n + 1) = list_lcm (leibniz_horizontal n)
10352leibniz_horizontal_mem |- !n k. k <= n ==> MEM (leibniz n k) (leibniz_horizontal n)
10353so:
10354lcm_run (2*n + 1) = list_lcm (leibniz_horizontal (2*n))
10355and leibniz_horizontal (2*n) has members: 0, 1, 2, ...., n, (n + 1), ....., (2*n)
10356note: n <= 2*n, always, (n+1) <= 2*n = (n+n) when 1 <= n.
10357thus:
10358Both B = (leibniz 2*n n) and C = (leibniz 2*n n+1) divides lcm_run (2*n + 1),
10359 or (lcm B C) divides lcm_run (2*n + 1).
10360But (lcm B C) = (lcm B A) where A = (leibniz 2*n-1 n).
10361By leibniz_def |- !n k. leibniz n k = (n + 1) * binomial n k
10362By leibniz_up_alt |- !n. 0 < n ==> !k. leibniz (n - 1) k = (n - k) * binomial n k
10363 so B = (2*n + 1) * binomial 2*n n
10364and A = (2*n - n) * binomial 2*n n = n * binomial 2*n n
10365and lcm B A = lcm ((2*n + 1) * binomial 2*n n) (n * binomial 2*n n)
10366 = (lcm (2*n + 1) n) * binomial 2*n n by LCM_COMMON_FACTOR
10367 = n * (2*n + 1) * binomial 2*n n by coprime (2*n+1) n
10368 = n * (leibniz 2*n n) by leibniz_def
10369*)
10370
10371(* Theorem: 0 < n ==> n * (leibniz (2 * n) n) divides lcm_run (2 * n + 1) *)
10372(* Proof:
10373 Note 1 <= n by 0 < n
10374 Let m = 2 * n,
10375 Then n <= 2 * n = m, and
10376 n + 1 <= n + n = m by arithmetic
10377 Also coprime n (m + 1) by GCD_EUCLID
10378
10379 Identify a triplet:
10380 Let t = triplet (m - 1) n
10381 Then t.a = leibniz (m - 1) n by triplet_def
10382 t.b = leibniz m n by triplet_def
10383 t.c = leibniz m (n + 1) by triplet_def
10384
10385 Note MEM t.b (leibniz_horizontal m) by leibniz_horizontal_mem, n <= m
10386 and MEM t.c (leibniz_horizontal m) by leibniz_horizontal_mem, n + 1 <= m
10387 ==> lcm t.b t.c divides list_lcm (leibniz_horizontal m) by list_lcm_divisor_lcm_pair
10388 = lcm_run (m + 1) by leibniz_lcm_property
10389
10390 Let k = binomial m n.
10391 lcm t.b t.c
10392 = lcm t.b t.a by leibniz_triplet_lcm
10393 = lcm ((m + 1) * k) t.a by leibniz_def
10394 = lcm ((m + 1) * k) ((m - n) * k) by leibniz_up_alt
10395 = lcm ((m + 1) * k) (n * k) by m = 2 * n
10396 = n * (m + 1) * k by LCM_COMMON_COPRIME, LCM_SYM, coprime n (m + 1)
10397 = n * leibniz m n by leibniz_def
10398 Thus (n * leibniz m n) divides lcm_run (m + 1)
10399*)
10400Theorem lcm_run_odd_factor:
10401 !n. 0 < n ==> n * (leibniz (2 * n) n) divides lcm_run (2 * n + 1)
10402Proof
10403 rpt strip_tac >>
10404 qabbrev_tac `m = 2 * n` >>
10405 `n <= m /\ n + 1 <= m` by rw[Abbr`m`] >>
10406 `coprime n (m + 1)` by rw[GCD_EUCLID, Abbr`m`] >>
10407 qabbrev_tac `t = triplet (m - 1) n` >>
10408 `t.a = leibniz (m - 1) n` by rw[triplet_def, Abbr`t`] >>
10409 `t.b = leibniz m n` by rw[triplet_def, Abbr`t`] >>
10410 `t.c = leibniz m (n + 1)` by rw[triplet_def, Abbr`t`] >>
10411 `t.b divides lcm_run (m + 1)` by metis_tac[lcm_run_leibniz_divisor] >>
10412 `t.c divides lcm_run (m + 1)` by metis_tac[lcm_run_leibniz_divisor] >>
10413 `lcm t.b t.c divides lcm_run (m + 1)` by rw[LCM_IS_LEAST_COMMON_MULTIPLE] >>
10414 qabbrev_tac `k = binomial m n` >>
10415 `lcm t.b t.c = lcm t.b t.a` by rw[leibniz_triplet_lcm, Abbr`t`] >>
10416 `_ = lcm ((m + 1) * k) ((m - n) * k)` by rw[leibniz_def, leibniz_up_alt, Abbr`k`] >>
10417 `_ = lcm ((m + 1) * k) (n * k)` by rw[Abbr`m`] >>
10418 `_ = n * (m + 1) * k` by rw[LCM_COMMON_COPRIME, LCM_SYM] >>
10419 `_ = n * leibniz m n` by rw[leibniz_def, Abbr`k`] >>
10420 metis_tac[]
10421QED
10422
10423(* Theorem: n * 4 ** n <= lcm_run (2 * n + 1) *)
10424(* Proof:
10425 If n = 0, LHS = 0, trivially true.
10426 If n <> 0, 0 < n.
10427 Note 4 ** n <= leibniz (2 * n) n by leibniz_middle_lower
10428 so n * 4 ** n <= n * leibniz (2 * n) n by LESS_MONO_MULT, MULT_COMM
10429 Let k = n * leibniz (2 * n) n.
10430 Then k divides lcm_run (2 * n + 1) by lcm_run_odd_factor
10431 Now 0 < lcm_run (2 * n + 1) by lcm_run_pos
10432 so k <= lcm_run (2 * n + 1) by DIVIDES_LE
10433 Overall n * 4 ** n <= lcm_run (2 * n + 1) by LESS_EQ_TRANS
10434*)
10435Theorem lcm_run_lower_odd[allow_rebind]:
10436 !n. n * 4 ** n <= lcm_run (2 * n + 1)
10437Proof
10438 rpt strip_tac >>
10439 Cases_on `n = 0` >-
10440 rw[] >>
10441 `0 < n` by decide_tac >>
10442 `4 ** n <= leibniz (2 * n) n` by rw[leibniz_middle_lower] >>
10443 `n * 4 ** n <= n * leibniz (2 * n) n` by rw[LESS_MONO_MULT, MULT_COMM] >>
10444 `n * leibniz (2 * n) n <= lcm_run (2 * n + 1)` by rw[lcm_run_odd_factor, lcm_run_pos, DIVIDES_LE] >>
10445 rw[LESS_EQ_TRANS]
10446QED
10447
10448(* Another direct proof of the same theorem *)
10449
10450(* Theorem: n * 4 ** n <= lcm_run (2 * n + 1) *)
10451(* Proof:
10452 If n = 0, LHS = 0, trivially true.
10453 If n <> 0, 0 < n, or 1 <= n by arithmetic
10454
10455 Let m = 2 * n,
10456 Then n <= 2 * n = m, and
10457 n + 1 <= n + n = m by arithmetic, 1 <= n
10458 Also coprime n (m + 1) by GCD_EUCLID
10459
10460 Identify a triplet:
10461 Let t = triplet (m - 1) n
10462 Then t.a = leibniz (m - 1) n by triplet_def
10463 t.b = leibniz m n by triplet_def
10464 t.c = leibniz m (n + 1) by triplet_def
10465
10466 Note MEM t.b (leibniz_horizontal m) by leibniz_horizontal_mem, n <= m
10467 and MEM t.c (leibniz_horizontal m) by leibniz_horizontal_mem, n + 1 <= m
10468 and POSITIVE (leibniz_horizontal m) by leibniz_horizontal_pos_alt
10469 ==> lcm t.b t.c <= list_lcm (leibniz_horizontal m) by list_lcm_lower_by_lcm_pair
10470 = lcm_run (m + 1) by leibniz_lcm_property
10471
10472 Let k = binomial m n.
10473 lcm t.b t.c
10474 = lcm t.b t.a by leibniz_triplet_lcm
10475 = lcm ((m + 1) * k) t.a by leibniz_def
10476 = lcm ((m + 1) * k) ((m - n) * k) by leibniz_up_alt
10477 = lcm ((m + 1) * k) (n * k) by m = 2 * n
10478 = n * (m + 1) * k by LCM_COMMON_COPRIME, LCM_SYM, coprime n (m + 1)
10479 = n * leibniz m n by leibniz_def
10480 Thus (n * leibniz m n) divides lcm_run (m + 1)
10481
10482 Note 4 ** n <= leibniz m n by leibniz_middle_lower
10483 so n * 4 ** n <= n * leibniz m n by LESS_MONO_MULT, MULT_COMM
10484 Overall n * 4 ** n <= lcm_run (2 * n + 1) by LESS_EQ_TRANS
10485*)
10486Theorem lcm_run_lower_odd[allow_rebind]:
10487 !n. n * 4 ** n <= lcm_run (2 * n + 1)
10488Proof
10489 rpt strip_tac >>
10490 Cases_on ‘n = 0’ >-
10491 rw[] >>
10492 qabbrev_tac ‘m = 2 * n’ >>
10493 ‘n <= m /\ n + 1 <= m’ by rw[Abbr‘m’] >>
10494 ‘coprime n (m + 1)’ by rw[GCD_EUCLID, Abbr‘m’] >>
10495 qabbrev_tac ‘t = triplet (m - 1) n’ >>
10496 ‘t.a = leibniz (m - 1) n’ by rw[triplet_def, Abbr‘t’] >>
10497 ‘t.b = leibniz m n’ by rw[triplet_def, Abbr‘t’] >>
10498 ‘t.c = leibniz m (n + 1)’ by rw[triplet_def, Abbr‘t’] >>
10499 ‘MEM t.b (leibniz_horizontal m)’ by metis_tac[leibniz_horizontal_mem] >>
10500 ‘MEM t.c (leibniz_horizontal m)’ by metis_tac[leibniz_horizontal_mem] >>
10501 ‘POSITIVE (leibniz_horizontal m)’ by metis_tac[leibniz_horizontal_pos_alt] >>
10502 ‘lcm t.b t.c <= lcm_run (m + 1)’ by metis_tac[leibniz_lcm_property, list_lcm_lower_by_lcm_pair] >>
10503 ‘lcm t.b t.c = n * leibniz m n’ by
10504 (qabbrev_tac ‘k = binomial m n’ >>
10505 ‘lcm t.b t.c = lcm t.b t.a’ by rw[leibniz_triplet_lcm, Abbr‘t’] >>
10506 ‘_ = lcm ((m + 1) * k) ((m - n) * k)’ by rw[leibniz_def, leibniz_up_alt, Abbr‘k’] >>
10507 ‘_ = lcm ((m + 1) * k) (n * k)’ by rw[Abbr‘m’] >>
10508 ‘_ = n * (m + 1) * k’ by rw[LCM_COMMON_COPRIME, LCM_SYM] >>
10509 ‘_ = n * leibniz m n’ by rw[leibniz_def, Abbr‘k’] >>
10510 rw[]) >>
10511 ‘4 ** n <= leibniz m n’ by rw[leibniz_middle_lower, Abbr‘m’] >>
10512 ‘n * 4 ** n <= n * leibniz m n’ by rw[LESS_MONO_MULT] >>
10513 metis_tac[LESS_EQ_TRANS]
10514QED
10515
10516(* Theorem: ODD n ==> (2 ** n <= lcm_run n <=> 5 <= n) *)
10517(* Proof:
10518 If part: 2 ** n <= lcm_run n ==> 5 <= n
10519 By contradiction, suppose n < 5.
10520 By ODD n, n = 1 or n = 3.
10521 If n = 1, LHS = 2 ** 1 = 2 by arithmetic
10522 RHS = lcm_run 1 = 1 by lcm_run_1
10523 Hence false.
10524 If n = 3, LHS = 2 ** 3 = 8 by arithmetic
10525 RHS = lcm_run 3 = 6 by lcm_run_small
10526 Hence false.
10527 Only-if part: 5 <= n ==> 2 ** n <= lcm_run n
10528 Let h = HALF n.
10529 Then n = 2 * h + 1 by ODD_HALF
10530 so 4 <= 2 * h by 5 - 1 = 4
10531 or 2 <= h by arithmetic
10532 ==> 2 * 4 ** h <= h * 4 ** h by LESS_MONO_MULT
10533 But 2 * 4 ** h
10534 = 2 * (2 ** 2) ** h by arithmetic
10535 = 2 * 2 ** (2 * h) by EXP_EXP_MULT
10536 = 2 ** SUC (2 * h) by EXP
10537 = 2 ** n by ADD1, n = 2 * h + 1
10538 With h * 4 ** h <= lcm_run n by lcm_run_lower_odd
10539 or 2 ** n <= lcm_run n by LESS_EQ_TRANS
10540*)
10541Theorem lcm_run_lower_odd_iff:
10542 !n. ODD n ==> (2 ** n <= lcm_run n <=> 5 <= n)
10543Proof
10544 rw[EQ_IMP_THM] >| [
10545 spose_not_then strip_assume_tac >>
10546 `n < 5` by decide_tac >>
10547 `EVEN 0 /\ EVEN 2 /\ EVEN 4` by rw[] >>
10548 `n <> 0 /\ n <> 2 /\ n <> 4` by metis_tac[EVEN_ODD] >>
10549 `(n = 1) \/ (n = 3)` by decide_tac >-
10550 fs[] >>
10551 fs[lcm_run_small],
10552 qabbrev_tac `h = HALF n` >>
10553 `n = 2 * h + 1` by rw[ODD_HALF, Abbr`h`] >>
10554 `2 * 4 ** h <= h * 4 ** h` by rw[] >>
10555 `2 * 4 ** h = 2 * 2 ** (2 * h)` by rw[EXP_EXP_MULT] >>
10556 `_ = 2 ** n` by rw[GSYM EXP] >>
10557 `h * 4 ** h <= lcm_run n` by rw[lcm_run_lower_odd] >>
10558 decide_tac
10559 ]
10560QED
10561
10562(* Theorem: EVEN n ==> (2 ** n <= lcm_run n <=> (n = 0) \/ 8 <= n) *)
10563(* Proof:
10564 If part: 2 ** n <= lcm_run n ==> (n = 0) \/ 8 <= n
10565 By contradiction, suppose n <> 0 /\ n < 8.
10566 By EVEN n, n = 2 or n = 4 or n = 6.
10567 If n = 2, LHS = 2 ** 2 = 4 by arithmetic
10568 RHS = lcm_run 2 = 2 by lcm_run_small
10569 Hence false.
10570 If n = 4, LHS = 2 ** 4 = 16 by arithmetic
10571 RHS = lcm_run 4 = 12 by lcm_run_small
10572 Hence false.
10573 If n = 6, LHS = 2 ** 6 = 64 by arithmetic
10574 RHS = lcm_run 6 = 60 by lcm_run_small
10575 Hence false.
10576 Only-if part: (n = 0) \/ 8 <= n ==> 2 ** n <= lcm_run n
10577 If n = 0, LHS = 2 ** 0 = 1 by arithmetic
10578 RHS = lcm_run 0 = 1 by lcm_run_0
10579 Hence true.
10580 If n = 8, LHS = 2 ** 8 = 256 by arithmetic
10581 RHS = lcm_run 8 = 840 by lcm_run_small
10582 Hence true.
10583 Otherwise, 10 <= n, since ODD 9.
10584 Let h = HALF n, k = h - 1.
10585 Then n = 2 * h by EVEN_HALF
10586 = 2 * (k + 1) by k = h - 1
10587 = 2 * k + 2 by arithmetic
10588 But lcm_run (2 * k + 1) <= lcm_run (2 * k + 2) by lcm_run_monotone
10589 and k * 4 ** k <= lcm_run (2 * k + 1) by lcm_run_lower_odd
10590
10591 Now 5 <= h by 10 <= h
10592 so 4 <= k by k = h - 1
10593 ==> 4 * 4 ** k <= k * 4 ** k by LESS_MONO_MULT
10594
10595 4 * 4 ** k
10596 = (2 ** 2) * (2 ** 2) ** k by arithmetic
10597 = (2 ** 2) * (2 ** (2 * k)) by EXP_EXP_MULT
10598 = 2 ** (2 * k + 2) by EXP_ADD
10599 = 2 ** n by n = 2 * k + 2
10600
10601 Overall 2 ** n <= lcm_run n by LESS_EQ_TRANS
10602*)
10603Theorem lcm_run_lower_even_iff:
10604 !n. EVEN n ==> (2 ** n <= lcm_run n <=> (n = 0) \/ 8 <= n)
10605Proof
10606 rw[EQ_IMP_THM] >| [
10607 spose_not_then strip_assume_tac >>
10608 `n < 8` by decide_tac >>
10609 `ODD 1 /\ ODD 3 /\ ODD 5 /\ ODD 7` by rw[] >>
10610 `n <> 1 /\ n <> 3 /\ n <> 5 /\ n <> 7` by metis_tac[EVEN_ODD] >>
10611 `(n = 2) \/ (n = 4) \/ (n = 6)` by decide_tac >-
10612 fs[lcm_run_small] >-
10613 fs[lcm_run_small] >>
10614 fs[lcm_run_small],
10615 fs[lcm_run_0],
10616 Cases_on `n = 8` >-
10617 rw[lcm_run_small] >>
10618 `ODD 9` by rw[] >>
10619 `n <> 9` by metis_tac[EVEN_ODD] >>
10620 `10 <= n` by decide_tac >>
10621 qabbrev_tac `h = HALF n` >>
10622 `n = 2 * h` by rw[EVEN_HALF, Abbr`h`] >>
10623 qabbrev_tac `k = h - 1` >>
10624 `lcm_run (2 * k + 1) <= lcm_run (2 * k + 1 + 1)` by rw[lcm_run_monotone] >>
10625 `2 * k + 1 + 1 = n` by rw[Abbr`k`] >>
10626 `k * 4 ** k <= lcm_run (2 * k + 1)` by rw[lcm_run_lower_odd] >>
10627 `4 * 4 ** k <= k * 4 ** k` by rw[Abbr`k`] >>
10628 `4 * 4 ** k = 2 ** 2 * 2 ** (2 * k)` by rw[EXP_EXP_MULT] >>
10629 `_ = 2 ** (2 * k + 2)` by rw[GSYM EXP_ADD] >>
10630 `_ = 2 ** n` by rw[] >>
10631 metis_tac[LESS_EQ_TRANS]
10632 ]
10633QED
10634
10635(* Theorem: 2 ** n <= lcm_run n <=> (n = 0) \/ (n = 5) \/ 7 <= n *)
10636(* Proof:
10637 If EVEN n,
10638 Then n <> 5, n <> 7, so 8 <= n by arithmetic
10639 Thus true by lcm_run_lower_even_iff
10640 If ~EVEN n, then ODD n by EVEN_ODD
10641 Then n <> 0, n <> 6, so 5 <= n by arithmetic
10642 Thus true by lcm_run_lower_odd_iff
10643*)
10644Theorem lcm_run_lower_better_iff:
10645 !n. 2 ** n <= lcm_run n <=> (n = 0) \/ (n = 5) \/ 7 <= n
10646Proof
10647 rpt strip_tac >>
10648 Cases_on `EVEN n` >| [
10649 `ODD 5 /\ ODD 7` by rw[] >>
10650 `n <> 5 /\ n <> 7` by metis_tac[EVEN_ODD] >>
10651 metis_tac[lcm_run_lower_even_iff, DECIDE``8 <= n <=> (7 <= n /\ n <> 7)``],
10652 `EVEN 0 /\ EVEN 6` by rw[] >>
10653 `ODD n /\ n <> 0 /\ n <> 6` by metis_tac[EVEN_ODD] >>
10654 metis_tac[lcm_run_lower_odd_iff, DECIDE``5 <= n <=> (n = 5) \/ (n = 6) \/ (7 <= n)``]
10655 ]
10656QED
10657
10658(* This is the ultimate goal! *)
10659
10660(* ------------------------------------------------------------------------- *)
10661(* Nair's Trick - using consecutive LCM *)
10662(* ------------------------------------------------------------------------- *)
10663
10664(* Define the consecutive LCM function *)
10665Definition lcm_upto_def:
10666 (lcm_upto 0 = 1) /\
10667 (lcm_upto (SUC n) = lcm (SUC n) (lcm_upto n))
10668End
10669
10670(* Extract theorems from definition *)
10671Theorem lcm_upto_0 = lcm_upto_def |> CONJUNCT1;
10672(* val lcm_upto_0 = |- lcm_upto 0 = 1: thm *)
10673
10674Theorem lcm_upto_SUC = lcm_upto_def |> CONJUNCT2;
10675(* val lcm_upto_SUC = |- !n. lcm_upto (SUC n) = lcm (SUC n) (lcm_upto n): thm *)
10676
10677(* Theorem: (lcm_upto 0 = 1) /\ (!n. lcm_upto (n+1) = lcm (n+1) (lcm_upto n)) *)
10678(* Proof: by lcm_upto_def *)
10679Theorem lcm_upto_alt:
10680 (lcm_upto 0 = 1) /\ (!n. lcm_upto (n+1) = lcm (n+1) (lcm_upto n))
10681Proof
10682 metis_tac[lcm_upto_def, ADD1]
10683QED
10684
10685(* Theorem: lcm_upto 1 = 1 *)
10686(* Proof:
10687 lcm_upto 1
10688 = lcm_upto (SUC 0) by ONE
10689 = lcm (SUC 0) (lcm_upto 0) by lcm_upto_SUC
10690 = lcm (SUC 0) 1 by lcm_upto_0
10691 = lcm 1 1 by ONE
10692 = 1 by LCM_REF
10693*)
10694Theorem lcm_upto_1:
10695 lcm_upto 1 = 1
10696Proof
10697 metis_tac[lcm_upto_def, LCM_REF, ONE]
10698QED
10699
10700(* Theorem: lcm_upto n for small n *)
10701(* Proof: by evaluation. *)
10702Theorem lcm_upto_small:
10703 (lcm_upto 2 = 2) /\ (lcm_upto 3 = 6) /\ (lcm_upto 4 = 12) /\
10704 (lcm_upto 5 = 60) /\ (lcm_upto 6 = 60) /\ (lcm_upto 7 = 420) /\
10705 (lcm_upto 8 = 840) /\ (lcm_upto 9 = 2520) /\ (lcm_upto 10 = 2520)
10706Proof
10707 EVAL_TAC
10708QED
10709
10710(* Theorem: lcm_upto n = list_lcm [1 .. n] *)
10711(* Proof:
10712 By induction on n.
10713 Base: lcm_upto 0 = list_lcm [1 .. 0]
10714 lcm_upto 0
10715 = 1 by lcm_upto_0
10716 = list_lcm [] by list_lcm_nil
10717 = list_lcm [1 .. 0] by listRangeINC_EMPTY
10718 Step: lcm_upto n = list_lcm [1 .. n] ==> lcm_upto (SUC n) = list_lcm [1 .. SUC n]
10719 lcm_upto (SUC n)
10720 = lcm (SUC n) (lcm_upto n) by lcm_upto_SUC
10721 = lcm (SUC n) (list_lcm [1 .. n]) by induction hypothesis
10722 = list_lcm (SNOC (SUC n) [1 .. n]) by list_lcm_snoc
10723 = list_lcm [1 .. (SUC n)] by listRangeINC_SNOC, ADD1, 1 <= n + 1
10724*)
10725Theorem lcm_upto_eq_list_lcm:
10726 !n. lcm_upto n = list_lcm [1 .. n]
10727Proof
10728 Induct >-
10729 rw[lcm_upto_0, list_lcm_nil, listRangeINC_EMPTY] >>
10730 rw[lcm_upto_SUC, list_lcm_snoc, listRangeINC_SNOC, ADD1]
10731QED
10732
10733(* Theorem: 2 ** n <= lcm_upto (n + 1) *)
10734(* Proof:
10735 lcm_upto (n + 1)
10736 = list_lcm [1 .. (n + 1)] by lcm_upto_eq_list_lcm
10737 >= 2 ** n by lcm_lower_bound
10738*)
10739Theorem lcm_upto_lower:
10740 !n. 2 ** n <= lcm_upto (n + 1)
10741Proof
10742 rw[lcm_upto_eq_list_lcm, lcm_lower_bound]
10743QED
10744
10745(* Theorem: 0 < lcm_upto (n + 1) *)
10746(* Proof:
10747 lcm_upto (n + 1)
10748 >= 2 ** n by lcm_upto_lower
10749 > 0 by EXP_POS, 0 < 2
10750*)
10751Theorem lcm_upto_pos:
10752 !n. 0 < lcm_upto (n + 1)
10753Proof
10754 metis_tac[lcm_upto_lower, EXP_POS, LESS_LESS_EQ_TRANS, DECIDE``0 < 2``]
10755QED
10756
10757(* Theorem: (n + 1) divides lcm_upto (n + 1) /\ (lcm_upto n) divides lcm_upto (n + 1) *)
10758(* Proof:
10759 Note lcm_upto (n + 1) = lcm (n + 1) (lcm_upto n) by lcm_upto_alt
10760 so (n + 1) divides lcm_upto (n + 1)
10761 and (lcm_upto n) divides lcm_upto (n + 1) by LCM_DIVISORS
10762*)
10763Theorem lcm_upto_divisors:
10764 !n. (n + 1) divides lcm_upto (n + 1) /\ (lcm_upto n) divides lcm_upto (n + 1)
10765Proof
10766 rw[lcm_upto_alt, LCM_DIVISORS]
10767QED
10768
10769(* Theorem: lcm_upto n <= lcm_upto (n + 1) *)
10770(* Proof:
10771 Note (lcm_upto n) divides lcm_upto (n + 1) by lcm_upto_divisors
10772 and 0 < lcm_upto (n + 1) by lcm_upto_pos
10773 so lcm_upto n <= lcm_upto (n + 1) by DIVIDES_LE
10774*)
10775Theorem lcm_upto_monotone:
10776 !n. lcm_upto n <= lcm_upto (n + 1)
10777Proof
10778 rw[lcm_upto_divisors, lcm_upto_pos, DIVIDES_LE]
10779QED
10780
10781(* Theorem: k <= n ==> (leibniz n k) divides lcm_upto (n + 1) *)
10782(* Proof:
10783 Note (leibniz n k) divides list_lcm (leibniz_vertical n) by leibniz_vertical_divisor
10784 ==> (leibniz n k) divides list_lcm [1 .. (n + 1)] by notation
10785 or (leibniz n k) divides lcm_upto (n + 1) by lcm_upto_eq_list_lcm
10786*)
10787Theorem lcm_upto_leibniz_divisor:
10788 !n k. k <= n ==> (leibniz n k) divides lcm_upto (n + 1)
10789Proof
10790 metis_tac[leibniz_vertical_divisor, lcm_upto_eq_list_lcm]
10791QED
10792
10793(* Theorem: n * 4 ** n <= lcm_upto (2 * n + 1) *)
10794(* Proof:
10795 If n = 0, LHS = 0, trivially true.
10796 If n <> 0, 0 < n.
10797 Let m = 2 * n.
10798
10799 Claim: (m + 1) * binomial m n divides lcm_upto (m + 1) [1]
10800 Proof: Note n <= m by LESS_MONO_MULT, 1 <= 2
10801 ==> (leibniz m n) divides lcm_upto (m + 1) by lcm_upto_leibniz_divisor, n <= m
10802 or (m + 1) * binomial m n divides lcm_upto (m + 1) by leibniz_def
10803
10804 Claim: n * binomial m n divides lcm_upto (m + 1) [2]
10805 Proof: Note (lcm_upto m) divides lcm_upto (m + 1) by lcm_upto_divisors
10806 Also 0 < m /\ n <= m - 1 by 0 < n
10807 and m - 1 + 1 = m by 0 < m
10808 Thus (leibniz (m - 1) n) divides lcm_upto m by lcm_upto_leibniz_divisor, n <= m - 1
10809 or (leibniz (m - 1) n) divides lcm_upto (m + 1) by DIVIDES_TRANS
10810 and leibniz (m - 1) n
10811 = (m - n) * binomial m n by leibniz_up_alt
10812 = n * binomial m n by m - n = n
10813
10814 Note coprime n (m + 1) by GCD_EUCLID, GCD_1, 1 < n
10815 Thus lcm (n * binomial m n) ((m + 1) * binomial m n)
10816 = n * (m + 1) * binomial m n by LCM_COMMON_COPRIME
10817 = n * ((m + 1) * binomial m n) by MULT_ASSOC
10818 = n * leibniz m n by leibniz_def
10819 ==> n * leibniz m n divides lcm_upto (m + 1) by LCM_DIVIDES, [1], [2]
10820 Note 0 < lcm_upto (m + 1) by lcm_upto_pos
10821 or n * leibniz m n <= lcm_upto (m + 1) by DIVIDES_LE, 0 < lcm_upto (m + 1)
10822 Now 4 ** n <= leibniz m n by leibniz_middle_lower
10823 so n * 4 ** n <= n * leibniz m n by LESS_MONO_MULT, MULT_COMM
10824 or n * 4 ** n <= lcm_upto (m + 1) by LESS_EQ_TRANS
10825*)
10826Theorem lcm_upto_lower_odd:
10827 !n. n * 4 ** n <= lcm_upto (2 * n + 1)
10828Proof
10829 rpt strip_tac >>
10830 Cases_on `n = 0` >-
10831 rw[] >>
10832 `0 < n` by decide_tac >>
10833 qabbrev_tac `m = 2 * n` >>
10834 `(m + 1) * binomial m n divides lcm_upto (m + 1)` by
10835 (`n <= m` by rw[Abbr`m`] >>
10836 metis_tac[lcm_upto_leibniz_divisor, leibniz_def]) >>
10837 `n * binomial m n divides lcm_upto (m + 1)` by
10838 (`(lcm_upto m) divides lcm_upto (m + 1)` by rw[lcm_upto_divisors] >>
10839 `0 < m /\ n <= m - 1` by rw[Abbr`m`] >>
10840 `m - 1 + 1 = m` by decide_tac >>
10841 `(leibniz (m - 1) n) divides lcm_upto m` by metis_tac[lcm_upto_leibniz_divisor] >>
10842 `(leibniz (m - 1) n) divides lcm_upto (m + 1)` by metis_tac[DIVIDES_TRANS] >>
10843 `leibniz (m - 1) n = (m - n) * binomial m n` by rw[leibniz_up_alt] >>
10844 `_ = n * binomial m n` by rw[Abbr`m`] >>
10845 metis_tac[]) >>
10846 `coprime n (m + 1)` by rw[GCD_EUCLID, Abbr`m`] >>
10847 `lcm (n * binomial m n) ((m + 1) * binomial m n) = n * (m + 1) * binomial m n` by rw[LCM_COMMON_COPRIME] >>
10848 `_ = n * leibniz m n` by rw[leibniz_def, MULT_ASSOC] >>
10849 `n * leibniz m n divides lcm_upto (m + 1)` by metis_tac[LCM_DIVIDES] >>
10850 `n * leibniz m n <= lcm_upto (m + 1)` by rw[DIVIDES_LE, lcm_upto_pos] >>
10851 `4 ** n <= leibniz m n` by rw[leibniz_middle_lower, Abbr`m`] >>
10852 metis_tac[LESS_MONO_MULT, MULT_COMM, LESS_EQ_TRANS]
10853QED
10854
10855(* Theorem: n * 4 ** n <= lcm_upto (2 * (n + 1)) *)
10856(* Proof:
10857 lcm_upto (2 * (n + 1))
10858 = lcm_upto (2 * n + 2) by arithmetic
10859 >= lcm_upto (2 * n + 1) by lcm_upto_monotone
10860 >= n * 4 ** n by lcm_upto_lower_odd
10861*)
10862Theorem lcm_upto_lower_even:
10863 !n. n * 4 ** n <= lcm_upto (2 * (n + 1))
10864Proof
10865 rpt strip_tac >>
10866 `2 * (n + 1) = 2 * n + 1 + 1` by decide_tac >>
10867 metis_tac[lcm_upto_monotone, lcm_upto_lower_odd, LESS_EQ_TRANS]
10868QED
10869
10870(* Theorem: 7 <= n ==> 2 ** n <= lcm_upto n *)
10871(* Proof:
10872 If ODD n, ?k. n = SUC (2 * k) by ODD_EXISTS,
10873 When 5 <= 7 <= n = 2 * k + 1 by ADD1
10874 2 <= k by arithmetic
10875 and lcm_upto n
10876 = lcm_upto (2 * k + 1) by notation
10877 >= k * 4 ** k by lcm_upto_lower_odd
10878 >= 2 * 4 ** k by k >= 2, LESS_MONO_MULT
10879 = 2 * 2 ** (2 * k) by EXP_EXP_MULT
10880 = 2 ** SUC (2 * k) by EXP
10881 = 2 ** n by n = SUC (2 * k)
10882 If EVEN n, ?m. n = 2 * m by EVEN_EXISTS
10883 Note ODD 7 /\ ODD 9 by arithmetic
10884 If n = 8,
10885 LHS = 2 ** 8 = 256,
10886 RHS = lcm_upto 8 = 840 by lcm_upto_small
10887 Hence true.
10888 Otherwise, 10 <= n by 7 <= n, n <> 7, n <> 8, n <> 9
10889 Since 0 < n, 0 < m by MULT_EQ_0
10890 so ?k. m = SUC k by num_CASES
10891 When 10 <= n = 2 * (k + 1) by ADD1
10892 4 <= k by arithmetic
10893 and lcm_upto n
10894 = lcm_upto (2 * (k + 1)) by notation
10895 >= k * 4 ** k by lcm_upto_lower_even
10896 >= 4 * 4 ** k by k >= 4, LESS_MONO_MULT
10897 = 4 ** SUC k by EXP
10898 = 4 ** m by notation
10899 = 2 ** (2 * m) by EXP_EXP_MULT
10900 = 2 ** n by n = 2 * m
10901*)
10902Theorem lcm_upto_lower_better:
10903 !n. 7 <= n ==> 2 ** n <= lcm_upto n
10904Proof
10905 rpt strip_tac >>
10906 Cases_on `ODD n` >| [
10907 `?k. n = SUC (2 * k)` by rw[GSYM ODD_EXISTS] >>
10908 `2 <= k` by decide_tac >>
10909 `2 * 4 ** k <= k * 4 ** k` by rw[LESS_MONO_MULT] >>
10910 `lcm_upto n = lcm_upto (2 * k + 1)` by rw[ADD1] >>
10911 `2 ** n = 2 * 2 ** (2 * k)` by rw[EXP] >>
10912 `_ = 2 * 4 ** k` by rw[EXP_EXP_MULT] >>
10913 metis_tac[lcm_upto_lower_odd, LESS_EQ_TRANS],
10914 `ODD 7 /\ ODD 9` by rw[] >>
10915 `EVEN n /\ n <> 7 /\ n <> 9` by metis_tac[ODD_EVEN] >>
10916 `?m. n = 2 * m` by rw[GSYM EVEN_EXISTS] >>
10917 `m <> 0` by decide_tac >>
10918 `?k. m = SUC k` by metis_tac[num_CASES] >>
10919 Cases_on `n = 8` >-
10920 rw[lcm_upto_small] >>
10921 `4 <= k` by decide_tac >>
10922 `4 * 4 ** k <= k * 4 ** k` by rw[LESS_MONO_MULT] >>
10923 `lcm_upto n = lcm_upto (2 * (k + 1))` by rw[ADD1] >>
10924 `2 ** n = 4 ** m` by rw[EXP_EXP_MULT] >>
10925 `_ = 4 * 4 ** k` by rw[EXP] >>
10926 metis_tac[lcm_upto_lower_even, LESS_EQ_TRANS]
10927 ]
10928QED
10929
10930(* This is a very significant result. *)
10931
10932(* ------------------------------------------------------------------------- *)
10933(* Simple LCM lower bounds -- rework *)
10934(* ------------------------------------------------------------------------- *)
10935
10936(* Theorem: HALF (n + 1) <= lcm_run n *)
10937(* Proof:
10938 If n = 0,
10939 LHS = HALF 1 = 0 by arithmetic
10940 RHS = lcm_run 0 = 1 by lcm_run_0
10941 Hence true.
10942 If n <> 0, 0 < n.
10943 Let l = [1 .. n].
10944 Then l <> [] by listRangeINC_NIL, n <> 0
10945 so EVERY_POSITIVE l by listRangeINC_EVERY
10946 lcm_run n
10947 = list_lcm l by notation
10948 >= (SUM l) DIV (LENGTH l) by list_lcm_nonempty_lower, l <> []
10949 = (SUM l) DIV n by listRangeINC_LEN
10950 = (HALF (n * (n + 1))) DIV n by sum_1_to_n_eqn
10951 = HALF ((n * (n + 1)) DIV n) by DIV_DIV_DIV_MULT, 0 < 2, 0 < n
10952 = HALF (n + 1) by MULT_TO_DIV
10953*)
10954Theorem lcm_run_lower_simple:
10955 !n. HALF (n + 1) <= lcm_run n
10956Proof
10957 rpt strip_tac >>
10958 Cases_on `n = 0` >-
10959 rw[lcm_run_0] >>
10960 qabbrev_tac `l = [1 .. n]` >>
10961 `l <> []` by rw[listRangeINC_NIL, Abbr`l`] >>
10962 `EVERY_POSITIVE l` by rw[listRangeINC_EVERY, Abbr`l`] >>
10963 `(SUM l) DIV (LENGTH l) = (SUM l) DIV n` by rw[listRangeINC_LEN, Abbr`l`] >>
10964 `_ = (HALF (n * (n + 1))) DIV n` by rw[sum_1_to_n_eqn, Abbr`l`] >>
10965 `_ = HALF ((n * (n + 1)) DIV n)` by rw[DIV_DIV_DIV_MULT] >>
10966 `_ = HALF (n + 1)` by rw[MULT_TO_DIV] >>
10967 metis_tac[list_lcm_nonempty_lower]
10968QED
10969
10970(* This is a simple result, good but not very useful. *)
10971
10972(* Theorem: lcm_run n = list_lcm (leibniz_vertical (n - 1)) *)
10973(* Proof:
10974 If n = 0,
10975 Then n - 1 + 1 = 0 - 1 + 1 = 1
10976 but lcm_run 0 = 1 = lcm_run 1, hence true.
10977 If n <> 0,
10978 Then n - 1 + 1 = n, hence true trivially.
10979*)
10980Theorem lcm_run_alt:
10981 !n. lcm_run n = list_lcm (leibniz_vertical (n - 1))
10982Proof
10983 rpt strip_tac >>
10984 Cases_on `n = 0` >-
10985 rw[lcm_run_0, lcm_run_1] >>
10986 rw[]
10987QED
10988
10989(* Theorem: 2 ** (n - 1) <= lcm_run n *)
10990(* Proof:
10991 If n = 0,
10992 LHS = HALF 1 = 0 by arithmetic
10993 RHS = lcm_run 0 = 1 by lcm_run_0
10994 Hence true.
10995 If n <> 0, 0 < n, or 1 <= n.
10996 Let l = leibniz_horizontal (n - 1).
10997 Then LENGTH l = n by leibniz_horizontal_len
10998 so l <> [] by LENGTH_NIL, n <> 0
10999 and EVERY_POSITIVE l by leibniz_horizontal_pos
11000 lcm_run n
11001 = list_lcm (leibniz_vertical (n - 1)) by lcm_run_alt
11002 = list_lcm l by leibniz_lcm_property
11003 >= (SUM l) DIV (LENGTH l) by list_lcm_nonempty_lower, l <> []
11004 = 2 ** (n - 1) by leibniz_horizontal_average_eqn
11005*)
11006Theorem lcm_run_lower_good:
11007 !n. 2 ** (n - 1) <= lcm_run n
11008Proof
11009 rpt strip_tac >>
11010 Cases_on `n = 0` >-
11011 rw[lcm_run_0] >>
11012 `0 < n /\ 1 <= n /\ (n - 1 + 1 = n)` by decide_tac >>
11013 qabbrev_tac `l = leibniz_horizontal (n - 1)` >>
11014 `lcm_run n = list_lcm l` by metis_tac[leibniz_lcm_property] >>
11015 `LENGTH l = n` by metis_tac[leibniz_horizontal_len] >>
11016 `l <> []` by metis_tac[LENGTH_NIL] >>
11017 `EVERY_POSITIVE l` by rw[leibniz_horizontal_pos, Abbr`l`] >>
11018 metis_tac[list_lcm_nonempty_lower, leibniz_horizontal_average_eqn]
11019QED
11020
11021(* ------------------------------------------------------------------------- *)
11022(* Upper Bound by Leibniz Triangle *)
11023(* ------------------------------------------------------------------------- *)
11024
11025(* Theorem: leibniz n k = (n + 1 - k) * binomial (n + 1) k *)
11026(* Proof: by leibniz_up_alt:
11027leibniz_up_alt |- !n. 0 < n ==> !k. leibniz (n - 1) k = (n - k) * binomial n k
11028*)
11029Theorem leibniz_eqn:
11030 !n k. leibniz n k = (n + 1 - k) * binomial (n + 1) k
11031Proof
11032 rw[GSYM leibniz_up_alt]
11033QED
11034
11035(* Theorem: leibniz n (k + 1) = (n - k) * binomial (n + 1) (k + 1) *)
11036(* Proof: by leibniz_up_alt:
11037leibniz_up_alt |- !n. 0 < n ==> !k. leibniz (n - 1) k = (n - k) * binomial n k
11038*)
11039Theorem leibniz_right_alt:
11040 !n k. leibniz n (k + 1) = (n - k) * binomial (n + 1) (k + 1)
11041Proof
11042 metis_tac[leibniz_up_alt, DECIDE``0 < n + 1 /\ (n + 1 - 1 = n) /\ (n + 1 - (k + 1) = n - k)``]
11043QED
11044
11045(* Leibniz Stack:
11046 \
11047 \
11048 \
11049 \
11050 (L k k) <-- boundary of Leibniz Triangle
11051 | \ |-- (m - k) = distance
11052 | k <= m <= n <-- m
11053 | \ (n - k) = height, or max distance
11054 | binomial (n+1) (m+1) is at south-east of binomial n m
11055 | \
11056 | \
11057 n-th row: ....... (L n k) .................
11058
11059leibniz_binomial_identity
11060|- !m n k. k <= m /\ m <= n ==> (leibniz n k * binomial (n - k) (m - k) = leibniz m k * binomial (n + 1) (m + 1))
11061This says: (leibniz n k) at bottom is related to a stack entry (leibniz m k).
11062leibniz_divides_leibniz_factor
11063|- !m n k. k <= m /\ m <= n ==> leibniz n k divides leibniz m k * binomial (n + 1) (m + 1)
11064This is just a corollary of leibniz_binomial_identity, by divides_def.
11065
11066leibniz_horizontal_member_divides
11067|- !m n x. n <= TWICE m + 1 /\ m <= n /\ MEM x (leibniz_horizontal n) ==>
11068 x divides list_lcm (leibniz_horizontal m) * binomial (n + 1) (m + 1)
11069This says: for the n-th row, q = list_lcm (leibniz_horizontal m) * binomial (n + 1) (m + 1)
11070 is a common multiple of all members of the n-th row when n <= TWICE m + 1 /\ m <= n
11071That means, for the n-th row, pick any m-th row for HALF (n - 1) <= m <= n
11072Compute its list_lcm (leibniz_horizontal m), then multiply by binomial (n + 1) (m + 1) as q.
11073This value q is a common multiple of all members in n-th row.
11074The proof goes through all members of n-th row, i.e. (L n k) for k <= n.
11075To apply leibniz_binomial_identity, the condition is k <= m, not k <= n.
11076Since m has been picked (between HALF n and n), divide k into two parts: k <= m, m < k <= n.
11077For the first part, apply leibniz_binomial_identity.
11078For the second part, use symmetry L n (n - k) = L n k, then apply leibniz_binomial_identity.
11079With k <= m, m <= n, we apply leibniz_binomial_identity:
11080(1) Each member x = leibniz n k divides p = leibniz m k * binomial (n + 1) (m + 1), stack member with a factor.
11081(2) But leibniz m k is a member of (leibniz_horizontal m)
11082(3) Thus leibniz m k divides list_lcm (leibniz_horizontal m), the stack member divides its row list_lcm
11083 ==> p divides q by multiplying both by binomial (n + 1) (m + 1)
11084(4) Hence x divides q.
11085With the other half by symmetry, all members x divides q.
11086Corollary 1:
11087lcm_run_divides_property
11088|- !m n. n <= TWICE m /\ m <= n ==> lcm_run n divides binomial n m * lcm_run m
11089This follows by list_lcm_is_least_common_multiple and leibniz_lcm_property.
11090Corollary 2:
11091lcm_run_bound_recurrence
11092|- !m n. n <= TWICE m /\ m <= n ==> lcm_run n <= lcm_run m * binomial n m
11093Then lcm_run_upper_bound |- !n. lcm_run n <= 4 ** n follows by complete induction on n.
11094*)
11095
11096(* Theorem: k <= m /\ m <= n ==>
11097 ((leibniz n k) * (binomial (n - k) (m - k)) = (leibniz m k) * (binomial (n + 1) (m + 1))) *)
11098(* Proof:
11099 leibniz n k * (binomial (n - k) (m - k))
11100 = (n + 1) * (binomial n k) * (binomial (n - k) (m - k)) by leibniz_def
11101 n! (n - k)!
11102 = (n + 1) * ------------- * ------------------ binomial formula
11103 k! (n - k)! (m - k)! (n - m)!
11104 n! 1
11105 = (n + 1) * -------------- * ------------------ cancel (n - k)!
11106 k! 1 (m - k)! (n - m)!
11107 n! (m + 1)!
11108 = (n + 1) * -------------- * ------------------ replace by (m + 1)!
11109 k! (m + 1)! (m - k)! (n - m)!
11110 (n + 1)! m!
11111 = (m + 1) * -------------- * ------------------ merge and split factorials
11112 k! (m + 1)! (m - k)! (n - m)!
11113 m! (n + 1)!
11114 = (m + 1) * -------------- * ------------------ binomial formula
11115 k! (m - k)! (m + 1)! (n - m)!
11116 = leibniz m k * binomial (n + 1) (m + 1) by leibniz_def
11117*)
11118Theorem leibniz_binomial_identity:
11119 !m n k. k <= m /\ m <= n ==>
11120 ((leibniz n k) * (binomial (n - k) (m - k)) = (leibniz m k) * (binomial (n + 1) (m + 1)))
11121Proof
11122 rw[leibniz_def] >>
11123 `m + 1 <= n + 1` by decide_tac >>
11124 `m - k <= n - k` by decide_tac >>
11125 `(n - k) - (m - k) = n - m` by decide_tac >>
11126 `(n + 1) - (m + 1) = n - m` by decide_tac >>
11127 `FACT m = binomial m k * (FACT (m - k) * FACT k)` by rw[binomial_formula2] >>
11128 `FACT (n + 1) = binomial (n + 1) (m + 1) * (FACT (n - m) * FACT (m + 1))` by metis_tac[binomial_formula2] >>
11129 `FACT n = binomial n k * (FACT (n - k) * FACT k)` by rw[binomial_formula2] >>
11130 `FACT (n - k) = binomial (n - k) (m - k) * (FACT (n - m) * FACT (m - k))` by metis_tac[binomial_formula2] >>
11131 `!n. FACT (n + 1) = (n + 1) * FACT n` by metis_tac[FACT, ADD1] >>
11132 `FACT (n + 1) = FACT (n - m) * (FACT k * (FACT (m - k) * ((m + 1) * (binomial m k) * (binomial (n + 1) (m + 1)))))` by metis_tac[MULT_ASSOC, MULT_COMM] >>
11133 `FACT (n + 1) = FACT (n - m) * (FACT k * (FACT (m - k) * ((n + 1) * (binomial n k) * (binomial (n - k) (m - k)))))` by metis_tac[MULT_ASSOC, MULT_COMM] >>
11134 metis_tac[MULT_LEFT_CANCEL, FACT_LESS, NOT_ZERO_LT_ZERO]
11135QED
11136
11137(* Theorem: k <= m /\ m <= n ==> leibniz n k divides leibniz m k * binomial (n + 1) (m + 1) *)
11138(* Proof:
11139 Note leibniz m k * binomial (n + 1) (m + 1)
11140 = leibniz n k * binomial (n - k) (m - k) by leibniz_binomial_identity
11141 Thus leibniz n k divides leibniz m k * binomial (n + 1) (m + 1)
11142 by divides_def, MULT_COMM
11143*)
11144Theorem leibniz_divides_leibniz_factor:
11145 !m n k. k <= m /\ m <= n ==> leibniz n k divides leibniz m k * binomial (n + 1) (m + 1)
11146Proof
11147 metis_tac[leibniz_binomial_identity, divides_def, MULT_COMM]
11148QED
11149
11150(* Theorem: n <= 2 * m + 1 /\ m <= n /\ MEM x (leibniz_horizontal n) ==>
11151 x divides list_lcm (leibniz_horizontal m) * binomial (n + 1) (m + 1) *)
11152(* Proof:
11153 Let q = list_lcm (leibniz_horizontal m) * binomial (n + 1) (m + 1).
11154 Note MEM x (leibniz_horizontal n)
11155 ==> ?k. k <= n /\ (x = leibniz n k) by leibniz_horizontal_member
11156 Here the picture is:
11157 HALF n ... m .... n
11158 0 ........ k .......... n
11159 We need k <= m to get x divides q, by applying leibniz_divides_leibniz_factor.
11160 For m < k <= n, we shall use symmetry to get x divides q.
11161 If k <= m,
11162 Let p = (leibniz m k) * binomial (n + 1) (m + 1).
11163 Then x divides p by leibniz_divides_leibniz_factor, k <= m, m <= n
11164 and MEM (leibniz m k) (leibniz_horizontal m) by leibniz_horizontal_member, k <= m
11165 ==> (leibniz m k) divides list_lcm (leibniz_horizontal m) by list_lcm_is_common_multiple
11166 so (leibniz m k) * binomial (n + 1) (m + 1)
11167 divides
11168 list_lcm (leibniz_horizontal m) * binomial (n + 1) (m + 1) by DIVIDES_CANCEL, binomial_pos
11169 or p divides q by notation
11170 Thus x divides q by DIVIDES_TRANS
11171 If ~(k <= m), then m < k.
11172 Note x = leibniz n (n - k) by leibniz_sym, k <= n
11173 Now n <= m + m + 1 by given n <= 2 * m + 1
11174 so n - k <= m + m + 1 - k by arithmetic
11175 and m + m + 1 - k <= m by m < k, so m + 1 <= k
11176 or n - k <= m by LESS_EQ_TRANS
11177 Let j = n - k, p = (leibniz m j) * binomial (n + 1) (m + 1).
11178 Then x divides p by leibniz_divides_leibniz_factor, j <= m, m <= n
11179 and MEM (leibniz m j) (leibniz_horizontal m) by leibniz_horizontal_member, j <= m
11180 ==> (leibniz m j) divides list_lcm (leibniz_horizontal m) by list_lcm_is_common_multiple
11181 so (leibniz m j) * binomial (n + 1) (m + 1)
11182 divides
11183 list_lcm (leibniz_horizontal m) * binomial (n + 1) (m + 1) by DIVIDES_CANCEL, binomial_pos
11184 or p divides q by notation
11185 Thus x divides q by DIVIDES_TRANS
11186*)
11187Theorem leibniz_horizontal_member_divides:
11188 !m n x. n <= 2 * m + 1 /\ m <= n /\ MEM x (leibniz_horizontal n) ==>
11189 x divides list_lcm (leibniz_horizontal m) * binomial (n + 1) (m + 1)
11190Proof
11191 rpt strip_tac >>
11192 qabbrev_tac `q = list_lcm (leibniz_horizontal m) * binomial (n + 1) (m + 1)` >>
11193 `?k. k <= n /\ (x = leibniz n k)` by rw[GSYM leibniz_horizontal_member] >>
11194 Cases_on `k <= m` >| [
11195 qabbrev_tac `p = (leibniz m k) * binomial (n + 1) (m + 1)` >>
11196 `x divides p` by rw[leibniz_divides_leibniz_factor, Abbr`p`] >>
11197 `MEM (leibniz m k) (leibniz_horizontal m)` by metis_tac[leibniz_horizontal_member] >>
11198 `(leibniz m k) divides list_lcm (leibniz_horizontal m)` by rw[list_lcm_is_common_multiple] >>
11199 `p divides q` by rw[GSYM DIVIDES_CANCEL, binomial_pos, Abbr`p`, Abbr`q`] >>
11200 metis_tac[DIVIDES_TRANS],
11201 `n - k <= m` by decide_tac >>
11202 qabbrev_tac `j = n - k` >>
11203 `x = leibniz n j` by rw[Once leibniz_sym, Abbr`j`] >>
11204 qabbrev_tac `p = (leibniz m j) * binomial (n + 1) (m + 1)` >>
11205 `x divides p` by rw[leibniz_divides_leibniz_factor, Abbr`p`] >>
11206 `MEM (leibniz m j) (leibniz_horizontal m)` by metis_tac[leibniz_horizontal_member] >>
11207 `(leibniz m j) divides list_lcm (leibniz_horizontal m)` by rw[list_lcm_is_common_multiple] >>
11208 `p divides q` by rw[GSYM DIVIDES_CANCEL, binomial_pos, Abbr`p`, Abbr`q`] >>
11209 metis_tac[DIVIDES_TRANS]
11210 ]
11211QED
11212
11213(* Theorem: n <= 2 * m /\ m <= n ==> (lcm_run n) divides (lcm_run m) * binomial n m *)
11214(* Proof:
11215 If n = 0,
11216 Then lcm_run 0 = 1 by lcm_run_0
11217 Hence true by ONE_DIVIDES_ALL
11218 If n <> 0,
11219 Then 0 < n, and 0 < m by n <= 2 * m
11220 Thus m - 1 <= n - 1 by m <= n
11221 and n - 1 <= 2 * m - 1 by n <= 2 * m
11222 = 2 * (m - 1) + 1
11223 Thus !x. MEM x (leibniz_horizontal (n - 1)) ==>
11224 x divides list_lcm (leibniz_horizontal (m - 1)) * binomial n m
11225 by leibniz_horizontal_member_divides
11226 ==> list_lcm (leibniz_horizontal (n - 1)) divides
11227 list_lcm (leibniz_horizontal (m - 1)) * binomial n m
11228 by list_lcm_is_least_common_multiple
11229 But lcm_run n = leibniz_horizontal (n - 1) by leibniz_lcm_property
11230 and lcm_run m = leibniz_horizontal (m - 1) by leibniz_lcm_property
11231 list_lcm (leibniz_horizontal h) divides q by list_lcm_is_least_common_multiple
11232 Thus (lcm_run n) divides (lcm_run m) * binomial n m by above
11233*)
11234Theorem lcm_run_divides_property:
11235 !m n. n <= 2 * m /\ m <= n ==> (lcm_run n) divides (lcm_run m) * binomial n m
11236Proof
11237 rpt strip_tac >>
11238 Cases_on `n = 0` >-
11239 rw[lcm_run_0] >>
11240 `0 < n` by decide_tac >>
11241 `0 < m` by decide_tac >>
11242 `m - 1 <= n - 1` by decide_tac >>
11243 `n - 1 <= 2 * (m - 1) + 1` by decide_tac >>
11244 `(n - 1 + 1 = n) /\ (m - 1 + 1 = m)` by decide_tac >>
11245 metis_tac[leibniz_horizontal_member_divides, list_lcm_is_least_common_multiple, leibniz_lcm_property]
11246QED
11247
11248(* Theorem: n <= 2 * m /\ m <= n ==> (lcm_run n) <= (lcm_run m) * binomial n m *)
11249(* Proof:
11250 Note 0 < lcm_run m by lcm_run_pos
11251 and 0 < binomial n m by binomial_pos
11252 so 0 < lcm_run m * binomial n m by MULT_EQ_0
11253 Now (lcm_run n) divides (lcm_run m) * binomial n m by lcm_run_divides_property
11254 Thus (lcm_run n) <= (lcm_run m) * binomial n m by DIVIDES_LE
11255*)
11256Theorem lcm_run_bound_recurrence:
11257 !m n. n <= 2 * m /\ m <= n ==> (lcm_run n) <= (lcm_run m) * binomial n m
11258Proof
11259 rpt strip_tac >>
11260 `0 < lcm_run m * binomial n m` by metis_tac[lcm_run_pos, binomial_pos, MULT_EQ_0, NOT_ZERO_LT_ZERO] >>
11261 rw[lcm_run_divides_property, DIVIDES_LE]
11262QED
11263
11264(* Theorem: lcm_run n <= 4 ** n *)
11265(* Proof:
11266 By complete induction on n.
11267 If EVEN n,
11268 Base: n = 0.
11269 LHS = lcm_run 0 = 1 by lcm_run_0
11270 RHS = 4 ** 0 = 1 by EXP
11271 Hence true.
11272 Step: n <> 0 /\ !m. m < n ==> lcm_run m <= 4 ** m ==> lcm_run n <= 4 ** n
11273 Let m = HALF n, c = lcm_run m * binomial n m.
11274 Then n = 2 * m by EVEN_HALF
11275 so m <= 2 * m = n by arithmetic
11276 ==> lcm_run n <= c by lcm_run_bound_recurrence, m <= n
11277 But m <> 0 by n <> 0
11278 so m < n by arithmetic
11279 Now c = lcm_run m * binomial n m by notation
11280 <= 4 ** m * binomial n m by induction hypothesis, m < n
11281 <= 4 ** m * 4 ** m by binomial_middle_upper_bound
11282 = 4 ** (m + m) by EXP_ADD
11283 = 4 ** n by TIMES2, n = 2 * m
11284 Hence lcm_run n <= 4 ** n.
11285 If ~EVEN n,
11286 Then ODD n by EVEN_ODD
11287 Base: n = 1.
11288 LHS = lcm_run 1 = 1 by lcm_run_1
11289 RHS = 4 ** 1 = 4 by EXP
11290 Hence true.
11291 Step: n <> 1 /\ !m. m < n ==> lcm_run m <= 4 ** m ==> lcm_run n <= 4 ** n
11292 Let m = HALF n, c = lcm_run (m + 1) * binomial n (m + 1).
11293 Then n = 2 * m + 1 by ODD_HALF
11294 and 0 < m by n <> 1
11295 and m + 1 <= 2 * m + 1 = n by arithmetic
11296 ==> (lcm_run n) <= c by lcm_run_bound_recurrence, m + 1 <= n
11297 But m + 1 <> n by m <> 0
11298 so m + 1 < n by m + 1 <> n
11299 Now c = lcm_run (m + 1) * binomial n (m + 1) by notation
11300 <= 4 ** (m + 1) * binomial n (m + 1) by induction hypothesis, m + 1 < n
11301 = 4 ** (m + 1) * binomial n m by binomial_sym, n - (m + 1) = m
11302 <= 4 ** (m + 1) * 4 ** m by binomial_middle_upper_bound
11303 = 4 ** m * 4 ** (m + 1) by arithmetic
11304 = 4 ** (m + (m + 1)) by EXP_ADD
11305 = 4 ** (2 * m + 1) by arithmetic
11306 = 4 ** n by n = 2 * m + 1
11307 Hence lcm_run n <= 4 ** n.
11308*)
11309Theorem lcm_run_upper_bound:
11310 !n. lcm_run n <= 4 ** n
11311Proof
11312 completeInduct_on `n` >>
11313 Cases_on `EVEN n` >| [
11314 Cases_on `n = 0` >-
11315 rw[lcm_run_0] >>
11316 qabbrev_tac `m = HALF n` >>
11317 `n = 2 * m` by rw[EVEN_HALF, Abbr`m`] >>
11318 qabbrev_tac `c = lcm_run m * binomial n m` >>
11319 `lcm_run n <= c` by rw[lcm_run_bound_recurrence, Abbr`c`] >>
11320 `lcm_run m <= 4 ** m` by rw[] >>
11321 `binomial n m <= 4 ** m` by metis_tac[binomial_middle_upper_bound] >>
11322 `c <= 4 ** m * 4 ** m` by rw[LESS_MONO_MULT2, Abbr`c`] >>
11323 `4 ** m * 4 ** m = 4 ** n` by metis_tac[EXP_ADD, TIMES2] >>
11324 decide_tac,
11325 `ODD n` by metis_tac[EVEN_ODD] >>
11326 Cases_on `n = 1` >-
11327 rw[lcm_run_1] >>
11328 qabbrev_tac `m = HALF n` >>
11329 `n = 2 * m + 1` by rw[ODD_HALF, Abbr`m`] >>
11330 qabbrev_tac `c = lcm_run (m + 1) * binomial n (m + 1)` >>
11331 `lcm_run n <= c` by rw[lcm_run_bound_recurrence, Abbr`c`] >>
11332 `lcm_run (m + 1) <= 4 ** (m + 1)` by rw[] >>
11333 `binomial n (m + 1) = binomial n m` by rw[Once binomial_sym] >>
11334 `binomial n m <= 4 ** m` by metis_tac[binomial_middle_upper_bound] >>
11335 `c <= 4 ** (m + 1) * 4 ** m` by rw[LESS_MONO_MULT2, Abbr`c`] >>
11336 `4 ** (m + 1) * 4 ** m = 4 ** n` by metis_tac[MULT_COMM, EXP_ADD, ADD_ASSOC, TIMES2] >>
11337 decide_tac
11338 ]
11339QED
11340
11341(* This is a milestone theorem. *)
11342
11343(* ------------------------------------------------------------------------- *)
11344(* Beta Triangle *)
11345(* ------------------------------------------------------------------------- *)
11346
11347(* Define beta triangle *)
11348(* Use temp_overload so that beta is invisibe outside:
11349val beta_def = Define`
11350 beta n k = k * (binomial n k)
11351`;
11352*)
11353Overload beta[local] = ``\n k. k * (binomial n k)``(* for temporary overloading *)
11354(* can use overload, but then hard to print and change the appearance of too many theorem? *)
11355
11356(*
11357
11358Pascal's Triangle (k <= n)
11359n = 0 1 = binomial 0 0
11360n = 1 1 1
11361n = 2 1 2 1
11362n = 3 1 3 3 1
11363n = 4 1 4 6 4 1
11364n = 5 1 5 10 10 5 1
11365n = 6 1 6 15 20 15 6 1
11366
11367Beta Triangle (0 < k <= n)
11368n = 1 1 = 1 * (1) = leibniz_horizontal 0
11369n = 2 2 2 = 2 * (1 1) = leibniz_horizontal 1
11370n = 3 3 6 3 = 3 * (1 2 1) = leibniz_horizontal 2
11371n = 4 4 12 12 4 = 4 * (1 3 3 1) = leibniz_horizontal 3
11372n = 5 5 20 30 20 5 = 5 * (1 4 6 4 1) = leibniz_horizontal 4
11373n = 6 6 30 60 60 30 6 = 6 * (1 5 10 10 5 1) = leibniz_horizontal 5
11374
11375> EVAL ``let n = 10 in let k = 6 in (beta (n+1) (k+1) = leibniz n k)``; --> T
11376> EVAL ``let n = 10 in let k = 4 in (beta (n+1) (k+1) = leibniz n k)``; --> T
11377> EVAL ``let n = 10 in let k = 3 in (beta (n+1) (k+1) = leibniz n k)``; --> T
11378
11379*)
11380
11381(* Theorem: beta 0 n = 0 *)
11382(* Proof:
11383 beta 0 n
11384 = n * (binomial 0 n) by notation
11385 = n * (if n = 0 then 1 else 0) by binomial_0_n
11386 = 0
11387*)
11388Theorem beta_0_n:
11389 !n. beta 0 n = 0
11390Proof
11391 rw[binomial_0_n]
11392QED
11393
11394(* Theorem: beta n 0 = 0 *)
11395(* Proof: by notation *)
11396Theorem beta_n_0:
11397 !n. beta n 0 = 0
11398Proof
11399 rw[]
11400QED
11401
11402(* Theorem: n < k ==> (beta n k = 0) *)
11403(* Proof: by notation, binomial_less_0 *)
11404Theorem beta_less_0:
11405 !n k. n < k ==> (beta n k = 0)
11406Proof
11407 rw[binomial_less_0]
11408QED
11409
11410(* Theorem: beta (n + 1) (k + 1) = leibniz n k *)
11411(* Proof:
11412 If k <= n, then k + 1 <= n + 1 by arithmetic
11413 beta (n + 1) (k + 1)
11414 = (k + 1) binomial (n + 1) (k + 1) by notation
11415 = (k + 1) (n + 1)! / (k + 1)! (n - k)! by binomial_formula2
11416 = (n + 1) n! / k! (n - k)! by factorial composing and decomposing
11417 = (n + 1) * binomial n k by binomial_formula2
11418 = leibniz_horizontal n k by leibniz_def
11419 If ~(k <= n), then n < k /\ n + 1 < k + 1 by arithmetic
11420 Then beta (n + 1) (k + 1) = 0 by beta_less_0
11421 and leibniz n k = 0 by leibniz_less_0
11422 Hence true.
11423*)
11424Theorem beta_eqn:
11425 !n k. beta (n + 1) (k + 1) = leibniz n k
11426Proof
11427 rpt strip_tac >>
11428 Cases_on `k <= n` >| [
11429 `(n + 1) - (k + 1) = n - k` by decide_tac >>
11430 `k + 1 <= n + 1` by decide_tac >>
11431 `FACT (n - k) * FACT k * beta (n + 1) (k + 1) = FACT (n - k) * FACT k * ((k + 1) * binomial (n + 1) (k + 1))` by rw[] >>
11432 `_ = FACT (n - k) * FACT (k + 1) * binomial (n + 1) (k + 1)` by metis_tac[FACT, ADD1, MULT_ASSOC, MULT_COMM] >>
11433 `_ = FACT (n + 1)` by metis_tac[binomial_formula2, MULT_ASSOC, MULT_COMM] >>
11434 `_ = (n + 1) * FACT n` by metis_tac[FACT, ADD1] >>
11435 `_ = FACT (n - k) * FACT k * ((n + 1) * binomial n k)` by metis_tac[binomial_formula2, MULT_ASSOC, MULT_COMM] >>
11436 `_ = FACT (n - k) * FACT k * (leibniz n k)` by rw[leibniz_def] >>
11437 `FACT k <> 0 /\ FACT (n - k) <> 0` by metis_tac[FACT_LESS, NOT_ZERO_LT_ZERO] >>
11438 metis_tac[EQ_MULT_LCANCEL, MULT_ASSOC],
11439 rw[beta_less_0, leibniz_less_0]
11440 ]
11441QED
11442
11443(* Theorem: 0 < n /\ 0 < k ==> (beta n k = leibniz (n - 1) (k - 1)) *)
11444(* Proof: by beta_eqn *)
11445Theorem beta_alt:
11446 !n k. 0 < n /\ 0 < k ==> (beta n k = leibniz (n - 1) (k - 1))
11447Proof
11448 rw[GSYM beta_eqn]
11449QED
11450
11451(* Theorem: 0 < k /\ k <= n ==> 0 < beta n k *)
11452(* Proof:
11453 0 < beta n k
11454 <=> beta n k <> 0 by NOT_ZERO_LT_ZERO
11455 <=> k * (binomial n k) <> 0 by notation
11456 <=> k <> 0 /\ binomial n k <> 0 by MULT_EQ_0
11457 <=> k <> 0 /\ k <= n by binomial_pos
11458 <=> 0 < k /\ k <= n by NOT_ZERO_LT_ZERO
11459*)
11460Theorem beta_pos:
11461 !n k. 0 < k /\ k <= n ==> 0 < beta n k
11462Proof
11463 metis_tac[MULT_EQ_0, binomial_pos, NOT_ZERO_LT_ZERO]
11464QED
11465
11466(* Theorem: (beta n k = 0) <=> (k = 0) \/ n < k *)
11467(* Proof:
11468 beta n k = 0
11469 <=> k * (binomial n k) = 0 by notation
11470 <=> (k = 0) \/ (binomial n k = 0) by MULT_EQ_0
11471 <=> (k = 0) \/ (n < k) by binomial_eq_0
11472*)
11473Theorem beta_eq_0:
11474 !n k. (beta n k = 0) <=> (k = 0) \/ n < k
11475Proof
11476 rw[binomial_eq_0]
11477QED
11478
11479(*
11480binomial_sym |- !n k. k <= n ==> (binomial n k = binomial n (n - k))
11481leibniz_sym |- !n k. k <= n ==> (leibniz n k = leibniz n (n - k))
11482*)
11483
11484(* Theorem: k <= n ==> (beta n k = beta n (n - k + 1)) *)
11485(* Proof:
11486 If k = 0,
11487 Then beta n 0 = 0 by beta_n_0
11488 and beta n (n + 1) = 0 by beta_less_0
11489 Hence true.
11490 If k <> 0, then 0 < k
11491 Thus 0 < n by k <= n
11492 beta n k
11493 = leibniz (n - 1) (k - 1) by beta_alt
11494 = leibniz (n - 1) (n - k) by leibniz_sym
11495 = leibniz (n - 1) (n - k + 1 - 1) by arithmetic
11496 = beta n (n - k + 1) by beta_alt
11497*)
11498Theorem beta_sym:
11499 !n k. k <= n ==> (beta n k = beta n (n - k + 1))
11500Proof
11501 rpt strip_tac >>
11502 Cases_on `k = 0` >-
11503 rw[beta_n_0, beta_less_0] >>
11504 rw[beta_alt, Once leibniz_sym]
11505QED
11506
11507(* ------------------------------------------------------------------------- *)
11508(* Beta Horizontal List *)
11509(* ------------------------------------------------------------------------- *)
11510
11511(*
11512> EVAL ``leibniz_horizontal 3``; --> [4; 12; 12; 4]
11513> EVAL ``GENLIST (beta 4) 5``; --> [0; 4; 12; 12; 4]
11514> EVAL ``TL (GENLIST (beta 4) 5)``; --> [4; 12; 12; 4]
11515*)
11516
11517(* Use overloading for a row of beta n k, k = 1 to n. *)
11518(* val _ = overload_on("beta_horizontal", ``\n. TL (GENLIST (beta n) (n + 1))``); *)
11519(* use a direct GENLIST rather than tail of a GENLIST *)
11520Overload beta_horizontal[local] = ``\n. GENLIST (beta n o SUC) n``(* for temporary overloading *)
11521
11522(*
11523> EVAL ``leibniz_horizontal 5``; --> [6; 30; 60; 60; 30; 6]
11524> EVAL ``beta_horizontal 6``; --> [6; 30; 60; 60; 30; 6]
11525*)
11526
11527(* Theorem: beta_horizontal 0 = [] *)
11528(* Proof:
11529 beta_horizontal 0
11530 = GENLIST (beta 0 o SUC) 0 by notation
11531 = [] by GENLIST
11532*)
11533Theorem beta_horizontal_0:
11534 beta_horizontal 0 = []
11535Proof
11536 rw[]
11537QED
11538
11539(* Theorem: LENGTH (beta_horizontal n) = n *)
11540(* Proof:
11541 LENGTH (beta_horizontal n)
11542 = LENGTH (GENLIST (beta n o SUC) n) by notation
11543 = n by LENGTH_GENLIST
11544*)
11545Theorem beta_horizontal_len:
11546 !n. LENGTH (beta_horizontal n) = n
11547Proof
11548 rw[]
11549QED
11550
11551(* Theorem: beta_horizontal (n + 1) = leibniz_horizontal n *)
11552(* Proof:
11553 Note beta_horizontal (n + 1) = GENLIST ((beta (n + 1) o SUC)) (n + 1) by notation
11554 and leibniz_horizontal n = GENLIST (leibniz n) (n + 1) by notation
11555 Now (beta (n + 1)) o SUC) k
11556 = beta (n + 1) (k + 1) by ADD1
11557 = leibniz n k by beta_eqn
11558 Thus beta_horizontal (n + 1) = leibniz_horizontal n by GENLIST_FUN_EQ
11559*)
11560Theorem beta_horizontal_eqn:
11561 !n. beta_horizontal (n + 1) = leibniz_horizontal n
11562Proof
11563 rw[GENLIST_FUN_EQ, beta_eqn, ADD1]
11564QED
11565
11566(* Theorem: 0 < n ==> (beta_horizontal n = leibniz_horizontal (n - 1)) *)
11567(* Proof: by beta_horizontal_eqn *)
11568Theorem beta_horizontal_alt:
11569 !n. 0 < n ==> (beta_horizontal n = leibniz_horizontal (n - 1))
11570Proof
11571 metis_tac[beta_horizontal_eqn, DECIDE``0 < n ==> (n - 1 + 1 = n)``]
11572QED
11573
11574(* Theorem: 0 < k /\ k <= n ==> MEM (beta n k) (beta_horizontal n) *)
11575(* Proof:
11576 By MEM_GENLIST, this is to show:
11577 ?m. m < n /\ (beta n k = beta n (SUC m))
11578 Since k <> 0, k = SUC m,
11579 and SUC m = k <= n ==> m < n by arithmetic
11580 So take this m, and the result follows.
11581*)
11582Theorem beta_horizontal_mem:
11583 !n k. 0 < k /\ k <= n ==> MEM (beta n k) (beta_horizontal n)
11584Proof
11585 rpt strip_tac >>
11586 rw[MEM_GENLIST] >>
11587 `?m. k = SUC m` by metis_tac[num_CASES, NOT_ZERO_LT_ZERO] >>
11588 `m < n` by decide_tac >>
11589 metis_tac[]
11590QED
11591
11592(* too weak:
11593binomial_horizontal_mem |- !n k. k < n + 1 ==> MEM (binomial n k) (binomial_horizontal n)
11594leibniz_horizontal_mem |- !n k. k <= n ==> MEM (leibniz n k) (leibniz_horizontal n)
11595*)
11596
11597(* Theorem: MEM (beta n k) (beta_horizontal n) <=> 0 < k /\ k <= n *)
11598(* Proof:
11599 By MEM_GENLIST, this is to show:
11600 (?m. m < n /\ (beta n k = beta n (SUC m))) <=> 0 < k /\ k <= n
11601 If part: (?m. m < n /\ (beta n k = beta n (SUC m))) ==> 0 < k /\ k <= n
11602 By contradiction, suppose k = 0 \/ n < k
11603 Note SUC m <> 0 /\ ~(n < SUC m) by m < n
11604 Thus beta n (SUC m) <> 0 by beta_eq_0
11605 or beta n k <> 0 by beta n k = beta n (SUC m)
11606 ==> (k <> 0) /\ ~(n < k) by beta_eq_0
11607 This contradicts k = 0 \/ n < k.
11608 Only-if part: 0 < k /\ k <= n ==> ?m. m < n /\ (beta n k = beta n (SUC m))
11609 Note k <> 0, so ?m. k = SUC m by num_CASES
11610 and SUC m <= n <=> m < n by LESS_EQ
11611 so Take this m, and the result follows.
11612*)
11613Theorem beta_horizontal_mem_iff:
11614 !n k. MEM (beta n k) (beta_horizontal n) <=> 0 < k /\ k <= n
11615Proof
11616 rw[MEM_GENLIST] >>
11617 rewrite_tac[EQ_IMP_THM] >>
11618 strip_tac >| [
11619 spose_not_then strip_assume_tac >>
11620 `SUC m <> 0 /\ ~(n < SUC m)` by decide_tac >>
11621 `(k <> 0) /\ ~(n < k)` by metis_tac[beta_eq_0] >>
11622 decide_tac,
11623 strip_tac >>
11624 `?m. k = SUC m` by metis_tac[num_CASES, NOT_ZERO_LT_ZERO] >>
11625 metis_tac[LESS_EQ]
11626 ]
11627QED
11628
11629(* Theorem: MEM x (beta_horizontal n) <=> ?k. 0 < k /\ k <= n /\ (x = beta n k) *)
11630(* Proof:
11631 By MEM_GENLIST, this is to show:
11632 (?m. m < n /\ (x = beta n (SUC m))) <=> ?k. 0 < k /\ k <= n /\ (x = beta n k)
11633 Since 0 < k /\ k <= n <=> ?m. (k = SUC m) /\ m < n by num_CASES, LESS_EQ
11634 This is trivially true.
11635*)
11636Theorem beta_horizontal_member:
11637 !n x. MEM x (beta_horizontal n) <=> ?k. 0 < k /\ k <= n /\ (x = beta n k)
11638Proof
11639 rw[MEM_GENLIST] >>
11640 metis_tac[num_CASES, NOT_ZERO_LT_ZERO, SUC_NOT_ZERO, LESS_EQ]
11641QED
11642
11643(* Theorem: k < n ==> (EL k (beta_horizontal n) = beta n (k + 1)) *)
11644(* Proof: by EL_GENLIST, ADD1 *)
11645Theorem beta_horizontal_element:
11646 !n k. k < n ==> (EL k (beta_horizontal n) = beta n (k + 1))
11647Proof
11648 rw[EL_GENLIST, ADD1]
11649QED
11650
11651(* Theorem: 0 < n ==> (lcm_run n = list_lcm (beta_horizontal n)) *)
11652(* Proof:
11653 Note n <> 0
11654 ==> n = SUC k for some k by num_CASES
11655 or n = k + 1 by ADD1
11656 lcm_run n
11657 = lcm_run (k + 1)
11658 = list_lcm (leibniz_horizontal k) by leibniz_lcm_property
11659 = list_lcm (beta_horizontal n) by beta_horizontal_eqn
11660*)
11661Theorem lcm_run_by_beta_horizontal:
11662 !n. 0 < n ==> (lcm_run n = list_lcm (beta_horizontal n))
11663Proof
11664 metis_tac[leibniz_lcm_property, beta_horizontal_eqn, num_CASES, ADD1, NOT_ZERO_LT_ZERO]
11665QED
11666
11667(* Theorem: 0 < k /\ k <= n ==> (beta n k) divides lcm_run n *)
11668(* Proof:
11669 Note 0 < n by 0 < k /\ k <= n
11670 and MEM (beta n k) (beta_horizontal n) by beta_horizontal_mem
11671 also lcm_run n = list_lcm (beta_horizontal n) by lcm_run_by_beta_horizontal, 0 < n
11672 Thus (beta n k) divides lcm_run n by list_lcm_is_common_multiple
11673*)
11674Theorem lcm_run_beta_divisor:
11675 !n k. 0 < k /\ k <= n ==> (beta n k) divides lcm_run n
11676Proof
11677 rw[beta_horizontal_mem, lcm_run_by_beta_horizontal, list_lcm_is_common_multiple]
11678QED
11679
11680(* Theorem: k <= m /\ m <= n ==> (beta n k) divides (beta m k) * (binomial n m) *)
11681(* Proof:
11682 Note (binomial m k) * (binomial n m)
11683 = (binomial n k) * (binomial (n - k) (m - k)) by binomial_product_identity
11684 Thus binomial n k divides binomial m k * binomial n m by divides_def, MULT_COMM
11685 ==> k * binomial n k divides k * (binomial m k * binomial n m) by DIVIDES_CANCEL_COMM
11686 = (k * binomial m k) * binomial n m by MULT_ASSOC
11687 or (beta n k) divides (beta m k) * (binomial n m) by notation
11688*)
11689Theorem beta_divides_beta_factor:
11690 !m n k. k <= m /\ m <= n ==> (beta n k) divides (beta m k) * (binomial n m)
11691Proof
11692 rw[] >>
11693 `binomial n k divides binomial m k * binomial n m` by metis_tac[binomial_product_identity, divides_def, MULT_COMM] >>
11694 metis_tac[DIVIDES_CANCEL_COMM, MULT_ASSOC]
11695QED
11696
11697(* Theorem: n <= 2 * m /\ m <= n ==> (lcm_run n) divides (binomial n m) * (lcm_run m) *)
11698(* Proof:
11699 If n = 0,
11700 Then lcm_run 0 = 1 by lcm_run_0
11701 Hence true by ONE_DIVIDES_ALL
11702 If n <> 0, then 0 < n.
11703 Let q = (binomial n m) * (lcm_run m)
11704
11705 Claim: !x. MEM x (beta_horizontal n) ==> x divides q
11706 Proof: Note MEM x (beta_horizontal n)
11707 ==> ?k. 0 < k /\ k <= n /\ (x = beta n k) by beta_horizontal_member
11708 Here the picture is:
11709 HALF n ... m .... n
11710 0 ........ k ........... n
11711 We need k <= m to get x divides q.
11712 For m < k <= n, we shall use symmetry to get x divides q.
11713 If k <= m,
11714 Let p = (beta m k) * (binomial n m).
11715 Then x divides p by beta_divides_beta_factor, k <= m, m <= n
11716 and (beta m k) divides lcm_run m by lcm_run_beta_divisor, 0 < k /\ k <= m
11717 so (beta m k) * (binomial n m)
11718 divides
11719 (lcm_run m) * (binomial n m) by DIVIDES_CANCEL, binomial_pos
11720 or p divides q by MULT_COMM
11721 Thus x divides q by DIVIDES_TRANS
11722 If ~(k <= m), then m < k.
11723 Note x = beta n (n - k + 1) by beta_sym, k <= n
11724 Now n <= m + m by given
11725 so n - k + 1 <= m + m + 1 - k by arithmetic
11726 and m + m + 1 - k <= m by m < k
11727 ==> n - k + 1 <= m by arithmetic
11728 Let h = n - k + 1, p = (beta m h) * (binomial n m).
11729 Then x divides p by beta_divides_beta_factor, h <= m, m <= n
11730 and (beta m h) divides lcm_run m by lcm_run_beta_divisor, 0 < h /\ h <= m
11731 so (beta m h) * (binomial n m)
11732 divides
11733 (lcm_run m) * (binomial n m) by DIVIDES_CANCEL, binomial_pos
11734 or p divides q by MULT_COMM
11735 Thus x divides q by DIVIDES_TRANS
11736
11737 Therefore,
11738 (list_lcm (beta_horizontal n)) divides q by list_lcm_is_least_common_multiple, Claim
11739 or (lcm_run n) divides q by lcm_run_by_beta_horizontal, 0 < n
11740*)
11741Theorem lcm_run_divides_property_alt:
11742 !m n. n <= 2 * m /\ m <= n ==> (lcm_run n) divides (binomial n m) * (lcm_run m)
11743Proof
11744 rpt strip_tac >>
11745 Cases_on `n = 0` >-
11746 rw[lcm_run_0] >>
11747 `0 < n` by decide_tac >>
11748 qabbrev_tac `q = (binomial n m) * (lcm_run m)` >>
11749 `!x. MEM x (beta_horizontal n) ==> x divides q` by
11750 (rpt strip_tac >>
11751 `?k. 0 < k /\ k <= n /\ (x = beta n k)` by rw[GSYM beta_horizontal_member] >>
11752 Cases_on `k <= m` >| [
11753 qabbrev_tac `p = (beta m k) * (binomial n m)` >>
11754 `x divides p` by rw[beta_divides_beta_factor, Abbr`p`] >>
11755 `(beta m k) divides lcm_run m` by rw[lcm_run_beta_divisor] >>
11756 `p divides q` by metis_tac[DIVIDES_CANCEL, MULT_COMM, binomial_pos] >>
11757 metis_tac[DIVIDES_TRANS],
11758 `x = beta n (n - k + 1)` by rw[Once beta_sym] >>
11759 `n - k + 1 <= m` by decide_tac >>
11760 qabbrev_tac `h = n - k + 1` >>
11761 qabbrev_tac `p = (beta m h) * (binomial n m)` >>
11762 `x divides p` by rw[beta_divides_beta_factor, Abbr`p`] >>
11763 `(beta m h) divides lcm_run m` by rw[lcm_run_beta_divisor, Abbr`h`] >>
11764 `p divides q` by metis_tac[DIVIDES_CANCEL, MULT_COMM, binomial_pos] >>
11765 metis_tac[DIVIDES_TRANS]
11766 ]) >>
11767 `(list_lcm (beta_horizontal n)) divides q` by metis_tac[list_lcm_is_least_common_multiple] >>
11768 metis_tac[lcm_run_by_beta_horizontal]
11769QED
11770
11771(* This is the original lcm_run_divides_property to give lcm_run_upper_bound. *)
11772
11773(* Theorem: lcm_run n <= 4 ** n *)
11774(* Proof:
11775 By complete induction on n.
11776 If EVEN n,
11777 Base: n = 0.
11778 LHS = lcm_run 0 = 1 by lcm_run_0
11779 RHS = 4 ** 0 = 1 by EXP
11780 Hence true.
11781 Step: n <> 0 /\ !m. m < n ==> lcm_run m <= 4 ** m ==> lcm_run n <= 4 ** n
11782 Let m = HALF n, c = binomial n m * lcm_run m.
11783 Then n = 2 * m by EVEN_HALF
11784 so m <= 2 * m = n by arithmetic
11785 Note 0 < binomial n m by binomial_pos, m <= n
11786 and 0 < lcm_run m by lcm_run_pos
11787 ==> 0 < c by MULT_EQ_0
11788 Thus (lcm_run n) divides c by lcm_run_divides_property, m <= n
11789 or lcm_run n
11790 <= c by DIVIDES_LE, 0 < c
11791 = (binomial n m) * lcm_run m by notation
11792 <= (binomial n m) * 4 ** m by induction hypothesis, m < n
11793 <= 4 ** m * 4 ** m by binomial_middle_upper_bound
11794 = 4 ** (m + m) by EXP_ADD
11795 = 4 ** n by TIMES2, n = 2 * m
11796 Hence lcm_run n <= 4 ** n.
11797 If ~EVEN n,
11798 Then ODD n by EVEN_ODD
11799 Base: n = 1.
11800 LHS = lcm_run 1 = 1 by lcm_run_1
11801 RHS = 4 ** 1 = 4 by EXP
11802 Hence true.
11803 Step: n <> 1 /\ !m. m < n ==> lcm_run m <= 4 ** m ==> lcm_run n <= 4 ** n
11804 Let m = HALF n, c = binomial n (m + 1) * lcm_run (m + 1).
11805 Then n = 2 * m + 1 by ODD_HALF
11806 and 0 < m by n <> 1
11807 and m + 1 <= 2 * m + 1 = n by arithmetic
11808 But m + 1 <> n by m <> 0
11809 so m + 1 < n by m + 1 <> n
11810 Note 0 < binomial n (m + 1) by binomial_pos, m + 1 <= n
11811 and 0 < lcm_run (m + 1) by lcm_run_pos
11812 ==> 0 < c by MULT_EQ_0
11813 Thus (lcm_run n) divides c by lcm_run_divides_property, 0 < m + 1, m + 1 <= n
11814 or lcm_run n
11815 <= c by DIVIDES_LE, 0 < c
11816 = (binomial n (m + 1)) * lcm_run (m + 1) by notation
11817 <= (binomial n (m + 1)) * 4 ** (m + 1) by induction hypothesis, m + 1 < n
11818 = (binomial n m) * 4 ** (m + 1) by binomial_sym, n - (m + 1) = m
11819 <= 4 ** m * 4 ** (m + 1) by binomial_middle_upper_bound
11820 = 4 ** (m + (m + 1)) by EXP_ADD
11821 = 4 ** (2 * m + 1) by arithmetic
11822 = 4 ** n by n = 2 * m + 1
11823 Hence lcm_run n <= 4 ** n.
11824*)
11825Theorem lcm_run_upper_bound[allow_rebind]:
11826 !n. lcm_run n <= 4 ** n
11827Proof
11828 completeInduct_on `n` >>
11829 Cases_on `EVEN n` >| [
11830 Cases_on `n = 0` >-
11831 rw[lcm_run_0] >>
11832 qabbrev_tac `m = HALF n` >>
11833 `n = 2 * m` by rw[EVEN_HALF, Abbr`m`] >>
11834 qabbrev_tac `c = binomial n m * lcm_run m` >>
11835 `m <= n` by decide_tac >>
11836 `0 < c` by metis_tac[binomial_pos, lcm_run_pos, MULT_EQ_0, NOT_ZERO_LT_ZERO] >>
11837 `lcm_run n <= c` by rw[lcm_run_divides_property, DIVIDES_LE, Abbr`c`] >>
11838 `lcm_run m <= 4 ** m` by rw[] >>
11839 `binomial n m <= 4 ** m` by metis_tac[binomial_middle_upper_bound] >>
11840 `c <= 4 ** m * 4 ** m` by rw[LESS_MONO_MULT2, Abbr`c`] >>
11841 `4 ** m * 4 ** m = 4 ** n` by metis_tac[EXP_ADD, TIMES2] >>
11842 decide_tac,
11843 `ODD n` by metis_tac[EVEN_ODD] >>
11844 Cases_on `n = 1` >-
11845 rw[lcm_run_1] >>
11846 qabbrev_tac `m = HALF n` >>
11847 `n = 2 * m + 1` by rw[ODD_HALF, Abbr`m`] >>
11848 `0 < m` by rw[] >>
11849 qabbrev_tac `c = binomial n (m + 1) * lcm_run (m + 1)` >>
11850 `m + 1 <= n` by decide_tac >>
11851 `0 < c` by metis_tac[binomial_pos, lcm_run_pos, MULT_EQ_0, NOT_ZERO_LT_ZERO] >>
11852 `lcm_run n <= c` by rw[lcm_run_divides_property, DIVIDES_LE, Abbr`c`] >>
11853 `lcm_run (m + 1) <= 4 ** (m + 1)` by rw[] >>
11854 `binomial n (m + 1) = binomial n m` by rw[Once binomial_sym] >>
11855 `binomial n m <= 4 ** m` by metis_tac[binomial_middle_upper_bound] >>
11856 `c <= 4 ** m * 4 ** (m + 1)` by rw[LESS_MONO_MULT2, Abbr`c`] >>
11857 `4 ** m * 4 ** (m + 1) = 4 ** n` by metis_tac[EXP_ADD, ADD_ASSOC, TIMES2] >>
11858 decide_tac
11859 ]
11860QED
11861
11862(* This is the original proof of the upper bound. *)
11863
11864(* ------------------------------------------------------------------------- *)
11865(* LCM Lower Bound using Maximum *)
11866(* ------------------------------------------------------------------------- *)
11867
11868(* Theorem: POSITIVE l ==> MAX_LIST l <= list_lcm l *)
11869(* Proof:
11870 If l = [],
11871 Note MAX_LIST [] = 0 by MAX_LIST_NIL
11872 and list_lcm [] = 1 by list_lcm_nil
11873 Hence true.
11874 If l <> [],
11875 Let x = MAX_LIST l.
11876 Then MEM x l by MAX_LIST_MEM
11877 and x divides (list_lcm l) by list_lcm_is_common_multiple
11878 Now 0 < list_lcm l by list_lcm_pos, EVERY_MEM
11879 so x <= list_lcm l by DIVIDES_LE, 0 < list_lcm l
11880*)
11881Theorem list_lcm_ge_max:
11882 !l. POSITIVE l ==> MAX_LIST l <= list_lcm l
11883Proof
11884 rpt strip_tac >>
11885 Cases_on `l = []` >-
11886 rw[MAX_LIST_NIL, list_lcm_nil] >>
11887 `MEM (MAX_LIST l) l` by rw[MAX_LIST_MEM] >>
11888 `0 < list_lcm l` by rw[list_lcm_pos, EVERY_MEM] >>
11889 rw[list_lcm_is_common_multiple, DIVIDES_LE]
11890QED
11891
11892(* Theorem: (n + 1) * binomial n (HALF n) <= list_lcm [1 .. (n + 1)] *)
11893(* Proof:
11894 Note !k. MEM k (binomial_horizontal n) ==> 0 < k by binomial_horizontal_pos_alt [1]
11895
11896 list_lcm [1 .. (n + 1)]
11897 = list_lcm (leibniz_vertical n) by notation
11898 = list_lcm (leibniz_horizontal n) by leibniz_lcm_property
11899 = (n + 1) * list_lcm (binomial_horizontal n) by leibniz_horizontal_lcm_alt
11900 >= (n + 1) * MAX_LIST (binomial_horizontal n) by list_lcm_ge_max, [1], LE_MULT_LCANCEL
11901 = (n + 1) * binomial n (HALF n) by binomial_horizontal_max
11902*)
11903Theorem lcm_lower_bound_by_list_lcm:
11904 !n. (n + 1) * binomial n (HALF n) <= list_lcm [1 .. (n + 1)]
11905Proof
11906 rpt strip_tac >>
11907 `MAX_LIST (binomial_horizontal n) <= list_lcm (binomial_horizontal n)` by
11908 (irule list_lcm_ge_max >>
11909 metis_tac[binomial_horizontal_pos_alt]) >>
11910 `list_lcm (leibniz_vertical n) = list_lcm (leibniz_horizontal n)` by rw[leibniz_lcm_property] >>
11911 `_ = (n + 1) * list_lcm (binomial_horizontal n)` by rw[leibniz_horizontal_lcm_alt] >>
11912 `n + 1 <> 0` by decide_tac >>
11913 metis_tac[LE_MULT_LCANCEL, binomial_horizontal_max]
11914QED
11915
11916(* Theorem: FINITE s /\ (!x. x IN s ==> 0 < x) ==> MAX_SET s <= big_lcm s *)
11917(* Proof:
11918 If s = {},
11919 Note MAX_SET {} = 0 by MAX_SET_EMPTY
11920 and big_lcm {} = 1 by big_lcm_empty
11921 Hence true.
11922 If s <> {},
11923 Let x = MAX_SET s.
11924 Then x IN s by MAX_SET_IN_SET
11925 and x divides (big_lcm s) by big_lcm_is_common_multiple
11926 Now 0 < big_lcm s by big_lcm_positive
11927 so x <= big_lcm s by DIVIDES_LE, 0 < big_lcm s
11928*)
11929Theorem big_lcm_ge_max:
11930 !s. FINITE s /\ (!x. x IN s ==> 0 < x) ==> MAX_SET s <= big_lcm s
11931Proof
11932 rpt strip_tac >>
11933 Cases_on `s = {}` >-
11934 rw[MAX_SET_EMPTY, big_lcm_empty] >>
11935 `(MAX_SET s) IN s` by rw[MAX_SET_IN_SET] >>
11936 `0 < big_lcm s` by rw[big_lcm_positive] >>
11937 rw[big_lcm_is_common_multiple, DIVIDES_LE]
11938QED
11939
11940(* Theorem: (n + 1) * binomial n (HALF n) <= big_lcm (natural (n + 1)) *)
11941(* Proof:
11942 Claim: MAX_SET (IMAGE (binomial n) (count (n + 1))) <= big_lcm (IMAGE (binomial n) count (n + 1))
11943 Proof: By big_lcm_ge_max, this is to show:
11944 (1) FINITE (IMAGE (binomial n) (count (n + 1)))
11945 This is true by FINITE_COUNT, IMAGE_FINITE
11946 (2) !x. x IN IMAGE (binomial n) (count (n + 1)) ==> 0 < x
11947 This is true by binomial_pos, IN_IMAGE, IN_COUNT
11948
11949 big_lcm (natural (n + 1))
11950 = (n + 1) * big_lcm (IMAGE (binomial n) (count (n + 1))) by big_lcm_natural_eqn
11951 >= (n + 1) * MAX_SET (IMAGE (binomial n) (count (n + 1))) by claim, LE_MULT_LCANCEL
11952 = (n + 1) * binomial n (HALF n) by binomial_row_max
11953*)
11954Theorem lcm_lower_bound_by_big_lcm:
11955 !n. (n + 1) * binomial n (HALF n) <= big_lcm (natural (n + 1))
11956Proof
11957 rpt strip_tac >>
11958 `MAX_SET (IMAGE (binomial n) (count (n + 1))) <=
11959 big_lcm (IMAGE (binomial n) (count (n + 1)))` by
11960 ((irule big_lcm_ge_max >> rpt conj_tac) >-
11961 metis_tac[binomial_pos, IN_IMAGE, IN_COUNT, DECIDE``x < n + 1 ==> x <= n``] >>
11962 rw[]
11963 ) >>
11964 metis_tac[big_lcm_natural_eqn, LE_MULT_LCANCEL, binomial_row_max, DECIDE``n + 1 <> 0``]
11965QED
11966
11967(* ------------------------------------------------------------------------- *)
11968(* Consecutive LCM function *)
11969(* ------------------------------------------------------------------------- *)
11970
11971(* Theorem: Stirling /\ (!n c. n DIV (SQRT (c * (n - 1))) = SQRT (n DIV c)) ==>
11972 !n. ODD n ==> (SQRT (n DIV (2 * pi))) * (2 ** n) <= list_lcm [1 .. n] *)
11973(* Proof:
11974 Note ODD n ==> n <> 0 by EVEN_0, EVEN_ODD
11975 If n = 1,
11976 Note 1 <= pi by 0 < pi
11977 so 2 <= 2 * pi by LE_MULT_LCANCEL, 2 <> 0
11978 or 1 < 2 * pi by arithmetic
11979 Thus 1 DIV (2 * pi) = 0 by ONE_DIV, 1 < 2 * pi
11980 and SQRT (1 DIV (2 * pi)) = 0 by ZERO_EXP, 0 ** h, h <> 0
11981 But list_lcm [1 .. 1] = 1 by list_lcm_sing
11982 so SQRT (1 DIV (2 * pi)) * 2 ** 1 <= list_lcm [1 .. 1] by MULT
11983 If n <> 1,
11984 Then 0 < n - 1.
11985 Let m = n - 1, then n = m + 1 by arithmetic
11986 and n * binomial m (HALF m) <= list_lcm [1 .. n] by lcm_lower_bound_by_list_lcm
11987 Now !a b c. (a DIV b) * c = (a * c) DIV b by DIV_1, MULT_RIGHT_1, c = c DIV 1, b * 1 = b
11988 Note ODD n ==> EVEN m by EVEN_ODD_SUC, ADD1
11989 n * binomial m (HALF m)
11990 = n * (2 ** n DIV SQRT (2 * pi * m)) by binomial_middle_by_stirling
11991 = (2 ** n DIV SQRT (2 * pi * m)) * n by MULT_COMM
11992 = (2 ** n * n) DIV (SQRT (2 * pi * m)) by above
11993 = (n * 2 ** n) DIV (SQRT (2 * pi * m)) by MULT_COMM
11994 = (n DIV SQRT (2 * pi * m)) * 2 ** n by above
11995 = (SQRT (n DIV (2 * pi)) * 2 ** n by assumption, m = n - 1
11996 Hence SQRT (n DIV (2 * pi))) * (2 ** n) <= list_lcm [1 .. n]
11997*)
11998Theorem lcm_lower_bound_by_list_lcm_stirling:
11999 Stirling /\ (!n c. n DIV (SQRT (c * (n - 1))) = SQRT (n DIV c)) ==>
12000 !n. ODD n ==> (SQRT (n DIV (2 * pi))) * (2 ** n) <= list_lcm [1 .. n]
12001Proof
12002 rpt strip_tac >>
12003 `!n. 0 < n /\ EVEN n ==> (binomial n (HALF n) = 2 ** (n + 1) DIV SQRT (2 * pi * n))` by prove_tac[binomial_middle_by_stirling] >>
12004 `n <> 0` by metis_tac[EVEN_0, EVEN_ODD] >>
12005 Cases_on `n = 1` >| [
12006 `1 <= pi` by decide_tac >>
12007 `1 < 2 * pi` by decide_tac >>
12008 `1 DIV (2 * pi) = 0` by rw[ONE_DIV] >>
12009 `SQRT (1 DIV (2 * pi)) * 2 ** 1 = 0` by rw[] >>
12010 rw[list_lcm_sing],
12011 `0 < n - 1 /\ (n = (n - 1) + 1)` by decide_tac >>
12012 qabbrev_tac `m = n - 1` >>
12013 `n * binomial m (HALF m) <= list_lcm [1 .. n]` by metis_tac[lcm_lower_bound_by_list_lcm] >>
12014 `EVEN m` by metis_tac[EVEN_ODD_SUC, ADD1] >>
12015 `!a b c. (a DIV b) * c = (a * c) DIV b` by metis_tac[DIV_1, MULT_RIGHT_1] >>
12016 `n * binomial m (HALF m) = n * (2 ** n DIV SQRT (2 * pi * m))` by rw[] >>
12017 `_ = (n DIV SQRT (2 * pi * m)) * 2 ** n` by metis_tac[MULT_COMM] >>
12018 metis_tac[]
12019 ]
12020QED
12021
12022(* Theorem: big_lcm (natural n) <= big_lcm (natural (n + 1)) *)
12023(* Proof:
12024 Note FINITE (natural n) by natural_finite
12025 and 0 < big_lcm (natural n) by big_lcm_positive, natural_element
12026 big_lcm (natural n)
12027 <= lcm (SUC n) (big_lcm (natural n)) by LCM_LE, 0 < SUC n, 0 < big_lcm (natural n)
12028 = big_lcm ((SUC n) INSERT (natural n)) by big_lcm_insert
12029 = big_lcm (natural (SUC n)) by natural_suc
12030 = big_lcm (natural (n + 1)) by ADD1
12031*)
12032Theorem big_lcm_non_decreasing:
12033 !n. big_lcm (natural n) <= big_lcm (natural (n + 1))
12034Proof
12035 rpt strip_tac >>
12036 `FINITE (natural n)` by rw[natural_finite] >>
12037 `0 < big_lcm (natural n)` by rw[big_lcm_positive, natural_element] >>
12038 `big_lcm (natural (n + 1)) = big_lcm (natural (SUC n))` by rw[ADD1] >>
12039 `_ = big_lcm ((SUC n) INSERT (natural n))` by rw[natural_suc] >>
12040 `_ = lcm (SUC n) (big_lcm (natural n))` by rw[big_lcm_insert] >>
12041 rw[LCM_LE]
12042QED
12043
12044(* Theorem: Stirling /\ (!n c. n DIV (SQRT (c * (n - 1))) = SQRT (n DIV c)) ==>
12045 !n. ODD n ==> (SQRT (n DIV (2 * pi))) * (2 ** n) <= big_lcm (natural n) *)
12046(* Proof:
12047 Note ODD n ==> n <> 0 by EVEN_0, EVEN_ODD
12048 If n = 1,
12049 Note 1 <= pi by 0 < pi
12050 so 2 <= 2 * pi by LE_MULT_LCANCEL, 2 <> 0
12051 or 1 < 2 * pi by arithmetic
12052 Thus 1 DIV (2 * pi) = 0 by ONE_DIV, 1 < 2 * pi
12053 and SQRT (1 DIV (2 * pi)) = 0 by ZERO_EXP, 0 ** h, h <> 0
12054 But big_lcm (natural 1) = 1 by list_lcm_sing, natural_1
12055 so SQRT (1 DIV (2 * pi)) * 2 ** 1 <= big_lcm (natural 1) by MULT
12056 If n <> 1,
12057 Then 0 < n - 1.
12058 Let m = n - 1, then n = m + 1 by arithmetic
12059 and n * binomial m (HALF m) <= big_lcm (natural n) by lcm_lower_bound_by_big_lcm
12060 Now !a b c. (a DIV b) * c = (a * c) DIV b by DIV_1, MULT_RIGHT_1, c = c DIV 1, b * 1 = b
12061 Note ODD n ==> EVEN m by EVEN_ODD_SUC, ADD1
12062 n * binomial m (HALF m)
12063 = n * (2 ** n DIV SQRT (2 * pi * m)) by binomial_middle_by_stirling
12064 = (2 ** n DIV SQRT (2 * pi * m)) * n by MULT_COMM
12065 = (2 ** n * n) DIV (SQRT (2 * pi * m)) by above
12066 = (n * 2 ** n) DIV (SQRT (2 * pi * m)) by MULT_COMM
12067 = (n DIV SQRT (2 * pi * m)) * 2 ** n by above
12068 = (SQRT (n DIV (2 * pi)) * 2 ** n by assumption, m = n - 1
12069 Hence SQRT (n DIV (2 * pi))) * (2 ** n) <= big_lcm (natural n)
12070*)
12071Theorem lcm_lower_bound_by_big_lcm_stirling:
12072 Stirling /\ (!n c. n DIV (SQRT (c * (n - 1))) = SQRT (n DIV c)) ==>
12073 !n. ODD n ==> (SQRT (n DIV (2 * pi))) * (2 ** n) <= big_lcm (natural n)
12074Proof
12075 rpt strip_tac >>
12076 `!n. 0 < n /\ EVEN n ==> (binomial n (HALF n) = 2 ** (n + 1) DIV SQRT (2 * pi * n))` by prove_tac[binomial_middle_by_stirling] >>
12077 `n <> 0` by metis_tac[EVEN_0, EVEN_ODD] >>
12078 Cases_on `n = 1` >| [
12079 `1 <= pi` by decide_tac >>
12080 `1 < 2 * pi` by decide_tac >>
12081 `1 DIV (2 * pi) = 0` by rw[ONE_DIV] >>
12082 `SQRT (1 DIV (2 * pi)) * 2 ** 1 = 0` by rw[] >>
12083 rw[big_lcm_sing],
12084 `0 < n - 1 /\ (n = (n - 1) + 1)` by decide_tac >>
12085 qabbrev_tac `m = n - 1` >>
12086 `n * binomial m (HALF m) <= big_lcm (natural n)` by metis_tac[lcm_lower_bound_by_big_lcm] >>
12087 `EVEN m` by metis_tac[EVEN_ODD_SUC, ADD1] >>
12088 `!a b c. (a DIV b) * c = (a * c) DIV b` by metis_tac[DIV_1, MULT_RIGHT_1] >>
12089 `n * binomial m (HALF m) = n * (2 ** n DIV SQRT (2 * pi * m))` by rw[] >>
12090 `_ = (n DIV SQRT (2 * pi * m)) * 2 ** n` by metis_tac[MULT_COMM] >>
12091 metis_tac[]
12092 ]
12093QED
12094
12095(* ------------------------------------------------------------------------- *)
12096(* Extra Theorems (not used) *)
12097(* ------------------------------------------------------------------------- *)
12098
12099(*
12100This is GCD_CANCEL_MULT by coprime p n, and coprime p n ==> coprime (p ** k) n by coprime_exp.
12101Note prime_not_divides_coprime.
12102*)
12103
12104(* Theorem: prime p /\ m divides n /\ ~((p * m) divides n) ==> (gcd (p * m) n = m) *)
12105(* Proof:
12106 Note m divides n ==> ?q. n = q * m by divides_def
12107
12108 Claim: coprime p q
12109 Proof: By contradiction, suppose gcd p q <> 1.
12110 Since (gcd p q) divides p by GCD_IS_GREATEST_COMMON_DIVISOR
12111 so gcd p q = p by prime_def, gcd p q <> 1.
12112 or p divides q by divides_iff_gcd_fix
12113 Now, m <> 0 because
12114 If m = 0, p * m = 0 by MULT_0
12115 Then m divides n and ~((p * m) divides n) are contradictory.
12116 Thus p * m divides q * m by DIVIDES_MULTIPLE_IFF, MULT_COMM, p divides q, m <> 0
12117 But q * m = n, contradicting ~((p * m) divides n).
12118
12119 gcd (p * m) n
12120 = gcd (p * m) (q * m) by n = q * m
12121 = m * gcd p q by GCD_COMMON_FACTOR, MULT_COMM
12122 = m * 1 by coprime p q, from Claim
12123 = m
12124*)
12125Theorem gcd_prime_product_property:
12126 !p m n. prime p /\ m divides n /\ ~((p * m) divides n) ==> (gcd (p * m) n = m)
12127Proof
12128 rpt strip_tac >>
12129 `?q. n = q * m` by rw[GSYM divides_def] >>
12130 `m <> 0` by metis_tac[MULT_0] >>
12131 `coprime p q` by
12132 (spose_not_then strip_assume_tac >>
12133 `(gcd p q) divides p` by rw[GCD_IS_GREATEST_COMMON_DIVISOR] >>
12134 `gcd p q = p` by metis_tac[prime_def] >>
12135 `p divides q` by rw[divides_iff_gcd_fix] >>
12136 metis_tac[DIVIDES_MULTIPLE_IFF, MULT_COMM]) >>
12137 metis_tac[GCD_COMMON_FACTOR, MULT_COMM, MULT_RIGHT_1]
12138QED
12139
12140(* Theorem: prime p /\ m divides n /\ ~((p * m) divides n) ==>(lcm (p * m) n = p * n) *)
12141(* Proof:
12142 Note m <> 0 by MULT_0, m divides n /\ ~((p * m) divides n)
12143 and m * lcm (p * m) n
12144 = gcd (p * m) n * lcm (p * m) n by gcd_prime_product_property
12145 = (p * m) * n by GCD_LCM
12146 = (m * p) * n by MULT_COMM
12147 = m * (p * n) by MULT_ASSOC
12148 Thus lcm (p * m) n = p * n by MULT_LEFT_CANCEL
12149*)
12150Theorem lcm_prime_product_property:
12151 !p m n. prime p /\ m divides n /\ ~((p * m) divides n) ==>(lcm (p * m) n = p * n)
12152Proof
12153 rpt strip_tac >>
12154 `m <> 0` by metis_tac[MULT_0] >>
12155 `m * lcm (p * m) n = gcd (p * m) n * lcm (p * m) n` by rw[gcd_prime_product_property] >>
12156 `_ = (p * m) * n` by rw[GCD_LCM] >>
12157 `_ = m * (p * n)` by metis_tac[MULT_COMM, MULT_ASSOC] >>
12158 metis_tac[MULT_LEFT_CANCEL]
12159QED
12160
12161(* Theorem: prime p /\ p divides list_lcm l ==> p divides PROD_SET (set l) *)
12162(* Proof:
12163 By induction on l.
12164 Base: prime p /\ p divides list_lcm [] ==> p divides PROD_SET (set [])
12165 Note list_lcm [] = 1 by list_lcm_nil
12166 and PROD_SET (set [])
12167 = PROD_SET {} by LIST_TO_SET
12168 = 1 by PROD_SET_EMPTY
12169 Hence conclusion is alredy in predicate, thus true.
12170 Step: prime p /\ p divides list_lcm l ==> p divides PROD_SET (set l) ==>
12171 prime p /\ p divides list_lcm (h::l) ==> p divides PROD_SET (set (h::l))
12172 Note PROD_SET (set (h::l))
12173 = PROD_SET (h INSERT set l) by LIST_TO_SET
12174 This is to show: p divides PROD_SET (h INSERT set l)
12175
12176 Let x = list_lcm l.
12177 Since p divides (lcm h x) by given
12178 so p divides (gcd h x) * (lcm h x) by DIVIDES_MULTIPLE
12179 or p divides h * x by GCD_LCM
12180 ==> p divides h or p divides x by P_EUCLIDES
12181 Case: p divides h.
12182 If h IN set l, or MEM h l,
12183 Then h divides x by list_lcm_is_common_multiple
12184 so p divides x by DIVIDES_TRANS
12185 Thus p divides PROD_SET (set l) by induction hypothesis
12186 or p divides PROD_SET (h INSERT set l) by ABSORPTION
12187 If ~(h IN set l),
12188 Then PROD_SET (h INSERT set l) = h * PROD_SET (set l) by PROD_SET_INSERT
12189 or p divides PROD_SET (h INSERT set l) by DIVIDES_MULTIPLE, MULT_COMM
12190 Case: p divides x.
12191 If h IN set l, or MEM h l,
12192 Then p divides PROD_SET (set l) by induction hypothesis
12193 or p divides PROD_SET (h INSERT set l) by ABSORPTION
12194 If ~(h IN set l),
12195 Then PROD_SET (h INSERT set l) = h * PROD_SET (set l) by PROD_SET_INSERT
12196 or p divides PROD_SET (h INSERT set l) by DIVIDES_MULTIPLE
12197*)
12198Theorem list_lcm_prime_factor:
12199 !p l. prime p /\ p divides list_lcm l ==> p divides PROD_SET (set l)
12200Proof
12201 strip_tac >>
12202 Induct >-
12203 rw[] >>
12204 rw[] >>
12205 qabbrev_tac `x = list_lcm l` >>
12206 `(gcd h x) * (lcm h x) = h * x` by rw[GCD_LCM] >>
12207 `p divides (h * x)` by metis_tac[DIVIDES_MULTIPLE] >>
12208 `p divides h \/ p divides x` by rw[P_EUCLIDES] >| [
12209 Cases_on `h IN set l` >| [
12210 `h divides x` by rw[list_lcm_is_common_multiple, Abbr`x`] >>
12211 `p divides x` by metis_tac[DIVIDES_TRANS] >>
12212 fs[ABSORPTION],
12213 rw[PROD_SET_INSERT] >>
12214 metis_tac[DIVIDES_MULTIPLE, MULT_COMM]
12215 ],
12216 Cases_on `h IN set l` >-
12217 fs[ABSORPTION] >>
12218 rw[PROD_SET_INSERT] >>
12219 metis_tac[DIVIDES_MULTIPLE]
12220 ]
12221QED
12222
12223(* Theorem: prime p /\ p divides PROD_SET (set l) ==> ?x. MEM x l /\ p divides x *)
12224(* Proof:
12225 By induction on l.
12226 Base: prime p /\ p divides PROD_SET (set []) ==> ?x. MEM x [] /\ p divides x
12227 p divides PROD_SET (set [])
12228 ==> p divides PROD_SET {} by LIST_TO_SET
12229 ==> p divides 1 by PROD_SET_EMPTY
12230 ==> p = 1 by DIVIDES_ONE
12231 This contradicts with 1 < p by ONE_LT_PRIME
12232 Step: prime p /\ p divides PROD_SET (set l) ==> ?x. MEM x l /\ p divides x ==>
12233 !h. prime p /\ p divides PROD_SET (set (h::l)) ==> ?x. MEM x (h::l) /\ p divides x
12234 Note PROD_SET (set (h::l))
12235 = PROD_SET (h INSERT set l) by LIST_TO_SET
12236 This is to show: ?x. ((x = h) \/ MEM x l) /\ p divides x by MEM
12237 If h IN set l, or MEM h l,
12238 Then h INSERT set l = set l by ABSORPTION
12239 Thus ?x. MEM x l /\ p divides x by induction hypothesis
12240 If ~(h IN set l),
12241 Then PROD_SET (h INSERT set l) = h * PROD_SET (set l) by PROD_SET_INSERT
12242 Thus p divides h \/ p divides (PROD_SET (set l)) by P_EUCLIDES
12243 Case p divides h.
12244 Take x = h, the result is true.
12245 Case p divides PROD_SET (set l).
12246 Then ?x. MEM x l /\ p divides x by induction hypothesis
12247*)
12248Theorem list_product_prime_factor:
12249 !p l. prime p /\ p divides PROD_SET (set l) ==> ?x. MEM x l /\ p divides x
12250Proof
12251 strip_tac >>
12252 Induct >| [
12253 rpt strip_tac >>
12254 `PROD_SET (set []) = 1` by rw[PROD_SET_EMPTY] >>
12255 `1 < p` by rw[ONE_LT_PRIME] >>
12256 `p <> 1` by decide_tac >>
12257 metis_tac[DIVIDES_ONE],
12258 rw[] >>
12259 Cases_on `h IN set l` >-
12260 metis_tac[ABSORPTION] >>
12261 fs[PROD_SET_INSERT] >>
12262 `p divides h \/ p divides (PROD_SET (set l))` by rw[P_EUCLIDES] >-
12263 metis_tac[] >>
12264 metis_tac[]
12265 ]
12266QED
12267
12268(* Theorem: prime p /\ p divides list_lcm l ==> ?x. MEM x l /\ p divides x *)
12269(* Proof: by list_lcm_prime_factor, list_product_prime_factor *)
12270Theorem list_lcm_prime_factor_member:
12271 !p l. prime p /\ p divides list_lcm l ==> ?x. MEM x l /\ p divides x
12272Proof
12273 rw[list_lcm_prime_factor, list_product_prime_factor]
12274QED
12275
12276(* ------------------------------------------------------------------------- *)
12277(* Count Helper Documentation *)
12278(* ------------------------------------------------------------------------- *)
12279(* Overloading (# is temporary):
12280 over f s t = !x. x IN s ==> f x IN t
12281 s bij_eq t = ?f. BIJ f s t
12282 s =b= t = ?f. BIJ f s t
12283*)
12284(* Definitions and Theorems (# are exported, ! are in compute):
12285
12286 Set Theorems:
12287 over_inj |- !f s t. INJ f s t ==> over f s t
12288 over_surj |- !f s t. SURJ f s t ==> over f s t
12289 over_bij |- !f s t. BIJ f s t ==> over f s t
12290 SURJ_CARD_IMAGE_EQ |- !f s t. FINITE t /\ over f s t ==>
12291 (SURJ f s t <=> CARD (IMAGE f s) = CARD t)
12292 FINITE_SURJ_IFF |- !f s t. FINITE t ==>
12293 (SURJ f s t <=> CARD (IMAGE f s) = CARD t /\ over f s t)
12294 INJ_IMAGE_BIJ_IFF |- !f s t. INJ f s t <=> BIJ f s (IMAGE f s) /\ over f s t
12295 INJ_IFF_BIJ_IMAGE |- !f s t. over f s t ==> (INJ f s t <=> BIJ f s (IMAGE f s))
12296 INJ_IMAGE_IFF |- !f s t. INJ f s t <=> INJ f s (IMAGE f s) /\ over f s t
12297 FUNSET_ALT |- !P Q. FUNSET P Q = {f | over f P Q}
12298
12299 Bijective Equivalence:
12300 bij_eq_empty |- !s t. s =b= t ==> (s = {} <=> t = {})
12301 bij_eq_refl |- !s. s =b= s
12302 bij_eq_sym |- !s t. s =b= t <=> t =b= s
12303 bij_eq_trans |- !s t u. s =b= t /\ t =b= u ==> s =b= u
12304 bij_eq_equiv_on |- !P. $=b= equiv_on P
12305 bij_eq_finite |- !s t. s =b= t ==> (FINITE s <=> FINITE t)
12306 bij_eq_count |- !s. FINITE s ==> s =b= count (CARD s)
12307 bij_eq_card |- !s t. s =b= t /\ (FINITE s \/ FINITE t) ==> CARD s = CARD t
12308 bij_eq_card_eq |- !s t. FINITE s /\ FINITE t ==> (s =b= t <=> CARD s = CARD t)
12309
12310 Alternate characterisation of maps:
12311 surj_preimage_not_empty
12312 |- !f s t. SURJ f s t <=>
12313 over f s t /\ !y. y IN t ==> preimage f s y <> {}
12314 inj_preimage_empty_or_sing
12315 |- !f s t. INJ f s t <=>
12316 over f s t /\ !y. y IN t ==> preimage f s y = {} \/
12317 SING (preimage f s y)
12318 bij_preimage_sing |- !f s t. BIJ f s t <=>
12319 over f s t /\ !y. y IN t ==> SING (preimage f s y)
12320 surj_iff_preimage_card_not_0
12321 |- !f s t. FINITE s /\ over f s t ==>
12322 (SURJ f s t <=>
12323 !y. y IN t ==> CARD (preimage f s y) <> 0)
12324 inj_iff_preimage_card_le_1
12325 |- !f s t. FINITE s /\ over f s t ==>
12326 (INJ f s t <=>
12327 !y. y IN t ==> CARD (preimage f s y) <= 1)
12328 bij_iff_preimage_card_eq_1
12329 |- !f s t. FINITE s /\ over f s t ==>
12330 (BIJ f s t <=>
12331 !y. y IN t ==> CARD (preimage f s y) = 1)
12332 finite_surj_inj_iff |- !f s t. FINITE s /\ SURJ f s t ==>
12333 (INJ f s t <=>
12334 !e. e IN IMAGE (preimage f s) t ==> CARD e = 1)
12335*)
12336
12337(* Overload a function from domain to range.
12338
12339 NOTE: this is FUNSET --Chun Tian
12340 *)
12341Overload over[local] = ``\f s t. !x. x IN s ==> f x IN t``
12342(* not easy to make this a good infix operator! *)
12343
12344(* Theorem: INJ f s t ==> over f s t *)
12345(* Proof: by INJ_DEF. *)
12346Theorem over_inj:
12347 !f s t. INJ f s t ==> over f s t
12348Proof
12349 simp[INJ_DEF]
12350QED
12351
12352(* Theorem: SURJ f s t ==> over f s t *)
12353(* Proof: by SURJ_DEF. *)
12354Theorem over_surj:
12355 !f s t. SURJ f s t ==> over f s t
12356Proof
12357 simp[SURJ_DEF]
12358QED
12359
12360(* Theorem: BIJ f s t ==> over f s t *)
12361(* Proof: by BIJ_DEF, INJ_DEF. *)
12362Theorem over_bij:
12363 !f s t. BIJ f s t ==> over f s t
12364Proof
12365 simp[BIJ_DEF, INJ_DEF]
12366QED
12367
12368(* Theorem: FINITE t /\ over f s t ==>
12369 (SURJ f s t <=> CARD (IMAGE f s) = CARD t) *)
12370(* Proof:
12371 If part: SURJ f s t ==> CARD (IMAGE f s) = CARD t
12372 Note IMAGE f s = t by IMAGE_SURJ
12373 Hence true.
12374 Only-if part: CARD (IMAGE f s) = CARD t ==> SURJ f s t
12375 By contradiction, suppose ~SURJ f s t.
12376 Then IMAGE f s <> t by IMAGE_SURJ
12377 but IMAGE f s SUBSET t by IMAGE_SUBSET_TARGET
12378 so IMAGE f s PSUBSET t by PSUBSET_DEF
12379 ==> CARD (IMAGE f s) < CARD t
12380 by CARD_PSUBSET
12381 This contradicts CARD (IMAGE f s) = CARD t.
12382*)
12383Theorem SURJ_CARD_IMAGE_EQ:
12384 !f s t. FINITE t /\ over f s t ==>
12385 (SURJ f s t <=> CARD (IMAGE f s) = CARD t)
12386Proof
12387 rw[EQ_IMP_THM] >-
12388 fs[IMAGE_SURJ] >>
12389 spose_not_then strip_assume_tac >>
12390 `IMAGE f s <> t` by rw[GSYM IMAGE_SURJ] >>
12391 `IMAGE f s PSUBSET t` by fs[IMAGE_SUBSET_TARGET, PSUBSET_DEF] >>
12392 imp_res_tac CARD_PSUBSET >>
12393 decide_tac
12394QED
12395
12396(* Theorem: FINITE t ==>
12397 (SURJ f s t <=> CARD (IMAGE f s) = CARD t /\ over f s t) *)
12398(* Proof:
12399 If part: true by SURJ_DEF, IMAGE_SURJ
12400 Only-if part: true by SURJ_CARD_IMAGE_EQ
12401*)
12402Theorem FINITE_SURJ_IFF:
12403 !f s t. FINITE t ==>
12404 (SURJ f s t <=> CARD (IMAGE f s) = CARD t /\ over f s t)
12405Proof
12406 metis_tac[SURJ_CARD_IMAGE_EQ, SURJ_DEF]
12407QED
12408
12409(* Note: this cannot be proved:
12410g `!f s t. FINITE t /\ over f s t ==>
12411 (INJ f s t <=> CARD (IMAGE f s) = CARD t)`;
12412Take f = I, s = count m, t = count n, with m <= n.
12413Then INJ I (count m) (count n)
12414and IMAGE I (count m) = (count m)
12415so CARD (IMAGE f s) = m, CARD t = n, may not equal.
12416*)
12417
12418(* INJ_IMAGE_BIJ |- !s f. (?t. INJ f s t) ==> BIJ f s (IMAGE f s) *)
12419
12420(* Theorem: INJ f s t <=> (BIJ f s (IMAGE f s) /\ over f s t) *)
12421(* Proof:
12422 If part: INJ f s t ==> BIJ f s (IMAGE f s) /\ over f s t
12423 Note BIJ f s (IMAGE f s) by INJ_IMAGE_BIJ
12424 and over f s t by INJ_DEF
12425 Only-if: BIJ f s (IMAGE f s) /\ over f s t ==> INJ f s t
12426 By INJ_DEF, this is to show:
12427 (1) x IN s ==> f x IN t, true by given
12428 (2) x IN s /\ y IN s /\ f x = f y ==> x = y
12429 Note f x IN (IMAGE f s) by IN_IMAGE
12430 and f y IN (IMAGE f s) by IN_IMAGE
12431 so f x = f y ==> x = y by BIJ_IS_INJ
12432*)
12433Theorem INJ_IMAGE_BIJ_IFF:
12434 !f s t. INJ f s t <=> (BIJ f s (IMAGE f s) /\ over f s t)
12435Proof
12436 rw[EQ_IMP_THM] >-
12437 metis_tac[INJ_IMAGE_BIJ] >-
12438 fs[INJ_DEF] >>
12439 rw[INJ_DEF] >>
12440 metis_tac[BIJ_IS_INJ, IN_IMAGE]
12441QED
12442
12443(* Theorem: over f s t ==> (INJ f s t <=> BIJ f s (IMAGE f s)) *)
12444(* Proof: by INJ_IMAGE_BIJ_IFF. *)
12445Theorem INJ_IFF_BIJ_IMAGE:
12446 !f s t. over f s t ==> (INJ f s t <=> BIJ f s (IMAGE f s))
12447Proof
12448 metis_tac[INJ_IMAGE_BIJ_IFF]
12449QED
12450
12451(*
12452INJ_IMAGE |- !f s t. INJ f s t ==> INJ f s (IMAGE f s)
12453*)
12454
12455(* Theorem: INJ f s t <=> INJ f s (IMAGE f s) /\ over f s t *)
12456(* Proof:
12457 Let P = over f s t.
12458 If part: INJ f s t ==> INJ f s (IMAGE f s) /\ P
12459 Note INJ f s (IMAGE f s) by INJ_IMAGE
12460 and P is true by INJ_DEF
12461 Only-if part: INJ f s (IMAGE f s) /\ P ==> INJ f s t
12462 Note s SUBSET s by SUBSET_REFL
12463 and (IMAGE f s) SUBSET t by IMAGE_SUBSET_TARGET
12464 Thus INJ f s t by INJ_SUBSET
12465*)
12466Theorem INJ_IMAGE_IFF:
12467 !f s t. INJ f s t <=> INJ f s (IMAGE f s) /\ over f s t
12468Proof
12469 rw[EQ_IMP_THM] >-
12470 metis_tac[INJ_IMAGE] >-
12471 fs[INJ_DEF] >>
12472 `s SUBSET s` by rw[] >>
12473 `(IMAGE f s) SUBSET t` by fs[IMAGE_SUBSET_TARGET] >>
12474 metis_tac[INJ_SUBSET]
12475QED
12476
12477(* pred_setTheory:
12478FUNSET |- !P Q. FUNSET P Q = (\f. over f P Q)
12479*)
12480
12481(* Theorem: FUNSET P Q = {f | over f P Q} *)
12482(* Proof: by FUNSET, EXTENSION *)
12483Theorem FUNSET_ALT:
12484 !P Q. FUNSET P Q = {f | over f P Q}
12485Proof
12486 rw[FUNSET, EXTENSION]
12487QED
12488
12489(* ------------------------------------------------------------------------- *)
12490(* Bijective Equivalence *)
12491(* ------------------------------------------------------------------------- *)
12492
12493(* Overload bijectively equal. *)
12494Overload bij_eq = ``\s t. ?f. BIJ f s t``
12495val _ = set_fixity "bij_eq" (Infix(NONASSOC, 450)); (* same as relation *)
12496
12497Overload "=b=" = ``$bij_eq``
12498val _ = set_fixity "=b=" (Infix(NONASSOC, 450));
12499
12500(*
12501> BIJ_SYM;
12502val it = |- !s t. s bij_eq t <=> t bij_eq s: thm
12503> BIJ_SYM;
12504val it = |- !s t. s =b= t <=> t =b= s: thm
12505> FINITE_BIJ_COUNT_CARD
12506val it = |- !s. FINITE s ==> count (CARD s) =b= s: thm
12507*)
12508
12509(* Theorem: s =b= t ==> (s = {} <=> t = {}) *)
12510(* Proof: by BIJ_EMPTY. *)
12511Theorem bij_eq_empty:
12512 !s t. s =b= t ==> (s = {} <=> t = {})
12513Proof
12514 metis_tac[BIJ_EMPTY]
12515QED
12516
12517(* Theorem: s =b= s *)
12518(* Proof: by BIJ_I_SAME *)
12519Theorem bij_eq_refl:
12520 !s. s =b= s
12521Proof
12522 metis_tac[BIJ_I_SAME]
12523QED
12524
12525(* Theorem alias *)
12526Theorem bij_eq_sym = BIJ_SYM;
12527(* val bij_eq_sym = |- !s t. s =b= t <=> t =b= s: thm *)
12528
12529Theorem bij_eq_trans = BIJ_TRANS;
12530(* val bij_eq_trans = |- !s t u. s =b= t /\ t =b= u ==> s =b= u: thm *)
12531
12532(* Idea: bij_eq is an equivalence relation on any set of sets. *)
12533
12534(* Theorem: $=b= equiv_on P *)
12535(* Proof:
12536 By equiv_on_def, this is to show:
12537 (1) s IN P ==> s =b= s, true by bij_eq_refl
12538 (2) s IN P /\ t IN P ==> (t =b= s <=> s =b= t)
12539 This is true by bij_eq_sym
12540 (3) s IN P /\ s' IN P /\ t IN P /\
12541 BIJ f s s' /\ BIJ f' s' t ==> s =b= t
12542 This is true by bij_eq_trans
12543*)
12544Theorem bij_eq_equiv_on:
12545 !P. $=b= equiv_on P
12546Proof
12547 rw[equiv_on_def] >-
12548 simp[bij_eq_refl] >-
12549 simp[Once bij_eq_sym] >>
12550 metis_tac[bij_eq_trans]
12551QED
12552
12553(* Theorem: s =b= t ==> (FINITE s <=> FINITE t) *)
12554(* Proof: by BIJ_FINITE_IFF *)
12555Theorem bij_eq_finite:
12556 !s t. s =b= t ==> (FINITE s <=> FINITE t)
12557Proof
12558 metis_tac[BIJ_FINITE_IFF]
12559QED
12560
12561(* This is the iff version of:
12562pred_setTheory.FINITE_BIJ_CARD;
12563|- !f s t. FINITE s /\ BIJ f s t ==> CARD s = CARD t
12564*)
12565
12566(* Theorem: FINITE s ==> s =b= (count (CARD s)) *)
12567(* Proof: by FINITE_BIJ_COUNT_CARD, BIJ_SYM *)
12568Theorem bij_eq_count:
12569 !s. FINITE s ==> s =b= (count (CARD s))
12570Proof
12571 metis_tac[FINITE_BIJ_COUNT_CARD, BIJ_SYM]
12572QED
12573
12574(* Theorem: s =b= t /\ (FINITE s \/ FINITE t) ==> CARD s = CARD t *)
12575(* Proof: by FINITE_BIJ_CARD, BIJ_SYM. *)
12576Theorem bij_eq_card:
12577 !s t. s =b= t /\ (FINITE s \/ FINITE t) ==> CARD s = CARD t
12578Proof
12579 metis_tac[FINITE_BIJ_CARD, BIJ_SYM]
12580QED
12581
12582(* Theorem: FINITE s /\ FINITE t ==> (s =b= t <=> CARD s = CARD t) *)
12583(* Proof:
12584 If part: s =b= t ==> CARD s = CARD t
12585 This is true by FINITE_BIJ_CARD
12586 Only-if part: CARD s = CARD t ==> s =b= t
12587 Let n = CARD s = CARD t.
12588 Note ?f. BIJ f s (count n) by bij_eq_count
12589 and ?g. BIJ g (count n) t by FINITE_BIJ_COUNT_CARD
12590 Thus s =b= t by bij_eq_trans
12591*)
12592Theorem bij_eq_card_eq:
12593 !s t. FINITE s /\ FINITE t ==> (s =b= t <=> CARD s = CARD t)
12594Proof
12595 rw[EQ_IMP_THM] >-
12596 metis_tac[FINITE_BIJ_CARD] >>
12597 `?f. BIJ f s (count (CARD s))` by rw[bij_eq_count] >>
12598 `?g. BIJ g (count (CARD t)) t` by rw[FINITE_BIJ_COUNT_CARD] >>
12599 metis_tac[bij_eq_trans]
12600QED
12601
12602(* ------------------------------------------------------------------------- *)
12603(* Alternate characterisation of maps. *)
12604(* ------------------------------------------------------------------------- *)
12605
12606(* Theorem: SURJ f s t <=>
12607 over f s t /\ (!y. y IN t ==> preimage f s y <> {}) *)
12608(* Proof:
12609 Let P = over f s t,
12610 Q = !y. y IN t ==> preimage f s y <> {}.
12611 If part: SURJ f s t ==> P /\ Q
12612 P is true by SURJ_DEF
12613 Q is true by preimage_def, SURJ_DEF
12614 Only-if part: P /\ Q ==> SURJ f s t
12615 This is true by preimage_def, SURJ_DEF
12616*)
12617Theorem surj_preimage_not_empty:
12618 !f s t. SURJ f s t <=>
12619 over f s t /\ (!y. y IN t ==> preimage f s y <> {})
12620Proof
12621 rw[SURJ_DEF, preimage_def, EXTENSION] >>
12622 metis_tac[]
12623QED
12624
12625(* Theorem: INJ f s t <=>
12626 over f s t /\
12627 (!y. y IN t ==> (preimage f s y = {} \/
12628 SING (preimage f s y))) *)
12629(* Proof:
12630 Let P = over f s t,
12631 Q = !y. y IN t ==> preimage f s y = {} \/ SING (preimage f s y).
12632 If part: INJ f s t ==> P /\ Q
12633 P is true by INJ_DEF
12634 For Q, if preimage f s y <> {},
12635 Then ?x. x IN preimage f s y by MEMBER_NOT_EMPTY
12636 or ?x. x IN s /\ f x = y by in_preimage
12637 Thus !z. z IN preimage f s y ==> z = x
12638 by in_preimage, INJ_DEF
12639 or SING (preimage f s y) by SING_DEF, EXTENSION
12640 Only-if part: P /\ Q ==> INJ f s t
12641 By INJ_DEF, this is to show:
12642 !x y. x IN s /\ y IN s /\ f x = f y ==> x = y
12643 Let z = f x, then z IN t by over f s t
12644 so x IN preimage f s z by in_preimage
12645 and y IN preimage f s z by in_preimage
12646 Thus preimage f s z <> {} by MEMBER_NOT_EMPTY
12647 so SING (preimage f s z) by implication
12648 ==> x = y by SING_ELEMENT
12649*)
12650Theorem inj_preimage_empty_or_sing:
12651 !f s t. INJ f s t <=>
12652 over f s t /\
12653 (!y. y IN t ==> (preimage f s y = {} \/
12654 SING (preimage f s y)))
12655Proof
12656 rw[EQ_IMP_THM] >-
12657 fs[INJ_DEF] >-
12658 ((Cases_on `preimage f s y = {}` >> simp[]) >>
12659 `?x. x IN s /\ f x = y` by metis_tac[in_preimage, MEMBER_NOT_EMPTY] >>
12660 simp[SING_DEF] >>
12661 qexists_tac `x` >>
12662 rw[preimage_def, EXTENSION] >>
12663 metis_tac[INJ_DEF]) >>
12664 rw[INJ_DEF] >>
12665 qabbrev_tac `z = f x` >>
12666 `z IN t` by fs[Abbr`z`] >>
12667 `x IN preimage f s z` by fs[preimage_def] >>
12668 `y IN preimage f s z` by fs[preimage_def] >>
12669 metis_tac[MEMBER_NOT_EMPTY, SING_ELEMENT]
12670QED
12671
12672(* Theorem: BIJ f s t <=>
12673 over f s t /\
12674 (!y. y IN t ==> SING (preimage f s y)) *)
12675(* Proof:
12676 Let P = over f s t,
12677 Q = !y. y IN t ==> SING (preimage f s y).
12678 If part: BIJ f s t ==> P /\ Q
12679 P is true by BIJ_DEF, INJ_DEF
12680 For Q,
12681 Note INJ f s t /\ SURJ f s t by BIJ_DEF
12682 so preimage f s y <> {} by surj_preimage_not_empty
12683 Thus SING (preimage f s y) by inj_preimage_empty_or_sing
12684 Only-if part: P /\ Q ==> BIJ f s t
12685 Note !y. y IN t ==> (preimage f s y) <> {}
12686 by SING_DEF, NOT_EMPTY_SING
12687 so SURJ f s t by surj_preimage_not_empty
12688 and INJ f s t by inj_preimage_empty_or_sing
12689 Thus BIJ f s t by BIJ_DEF
12690*)
12691Theorem bij_preimage_sing:
12692 !f s t. BIJ f s t <=>
12693 over f s t /\
12694 (!y. y IN t ==> SING (preimage f s y))
12695Proof
12696 rw[EQ_IMP_THM] >-
12697 fs[BIJ_DEF, INJ_DEF] >-
12698 metis_tac[BIJ_DEF, surj_preimage_not_empty, inj_preimage_empty_or_sing] >>
12699 `INJ f s t` by metis_tac[inj_preimage_empty_or_sing] >>
12700 `SURJ f s t` by metis_tac[SING_DEF, NOT_EMPTY_SING, surj_preimage_not_empty] >>
12701 simp[BIJ_DEF]
12702QED
12703
12704(* Theorem: FINITE s /\ over f s t ==>
12705 (SURJ f s t <=> !y. y IN t ==> CARD (preimage f s y) <> 0) *)
12706(* Proof:
12707 Note !y. FINITE (preimage f s y) by preimage_finite
12708 and !y. CARD (preimage f s y) = 0 <=> preimage f s y = {}
12709 by CARD_EQ_0
12710 The result follows by surj_preimage_not_empty
12711*)
12712Theorem surj_iff_preimage_card_not_0:
12713 !f s t. FINITE s /\ over f s t ==>
12714 (SURJ f s t <=> !y. y IN t ==> CARD (preimage f s y) <> 0)
12715Proof
12716 metis_tac[surj_preimage_not_empty, preimage_finite, CARD_EQ_0]
12717QED
12718
12719(* Theorem: FINITE s /\ over f s t ==>
12720 (INJ f s t <=> !y. y IN t ==> CARD (preimage f s y) <= 1) *)
12721(* Proof:
12722 Note !y. FINITE (preimage f s y) by preimage_finite
12723 and !y. CARD (preimage f s y) = 0 <=> preimage f s y = {}
12724 by CARD_EQ_0
12725 and !y. CARD (preimage f s y) = 1 <=> SING (preimage f s y)
12726 by CARD_EQ_1
12727 The result follows by inj_preimage_empty_or_sing, LE_ONE
12728*)
12729Theorem inj_iff_preimage_card_le_1:
12730 !f s t. FINITE s /\ over f s t ==>
12731 (INJ f s t <=> !y. y IN t ==> CARD (preimage f s y) <= 1)
12732Proof
12733 metis_tac[inj_preimage_empty_or_sing, preimage_finite, CARD_EQ_0, CARD_EQ_1, LE_ONE]
12734QED
12735
12736(* Theorem: FINITE s /\ over f s t ==>
12737 (BIJ f s t <=> !y. y IN t ==> CARD (preimage f s y) = 1) *)
12738(* Proof:
12739 Note !y. FINITE (preimage f s y) by preimage_finite
12740 and !y. CARD (preimage f s y) = 1 <=> SING (preimage f s y)
12741 by CARD_EQ_1
12742 The result follows by bij_preimage_sing
12743*)
12744Theorem bij_iff_preimage_card_eq_1:
12745 !f s t. FINITE s /\ over f s t ==>
12746 (BIJ f s t <=> !y. y IN t ==> CARD (preimage f s y) = 1)
12747Proof
12748 metis_tac[bij_preimage_sing, preimage_finite, CARD_EQ_1]
12749QED
12750
12751(* Theorem: FINITE s /\ SURJ f s t ==>
12752 (INJ f s t <=> !e. e IN IMAGE (preimage f s) t ==> CARD e = 1) *)
12753(* Proof:
12754 If part: INJ f s t /\ x IN t ==> CARD (preimage f s x) = 1
12755 Note BIJ f s t by BIJ_DEF
12756 and over f s t by BIJ_DEF, INJ_DEF
12757 so CARD (preimage f s x) = 1 by bij_iff_preimage_card_eq_1
12758 Only-if part: !e. (?x. e = preimage f s x /\ x IN t) ==> CARD e = 1 ==> INJ f s t
12759 Note over f s t by SURJ_DEF
12760 and !x. x IN t ==> ?y. y IN s /\ f y = x by SURJ_DEF
12761 Thus !y. y IN t ==> CARD (preimage f s y) = 1 by IN_IMAGE
12762 so INJ f s t by inj_iff_preimage_card_le_1
12763*)
12764Theorem finite_surj_inj_iff:
12765 !f s t. FINITE s /\ SURJ f s t ==>
12766 (INJ f s t <=> !e. e IN IMAGE (preimage f s) t ==> CARD e = 1)
12767Proof
12768 rw[EQ_IMP_THM] >-
12769 prove_tac[BIJ_DEF, INJ_DEF, bij_iff_preimage_card_eq_1] >>
12770 fs[SURJ_DEF] >>
12771 `!y. y IN t ==> CARD (preimage f s y) = 1` by metis_tac[] >>
12772 rw[inj_iff_preimage_card_le_1]
12773QED
12774
12775(* ------------------------------------------------------------------------- *)
12776(* Necklace Theory Documentation *)
12777(* ------------------------------------------------------------------------- *)
12778(* Overloading:
12779*)
12780(* Definitions and Theorems (# are exported, ! are in compute):
12781
12782 Necklace:
12783 necklace_def |- !n a. necklace n a =
12784 {ls | LENGTH ls = n /\ set ls SUBSET count a}
12785 necklace_element |- !n a ls. ls IN necklace n a <=>
12786 LENGTH ls = n /\ set ls SUBSET count a
12787 necklace_length |- !n a ls. ls IN necklace n a ==> LENGTH ls = n
12788 necklace_colors |- !n a ls. ls IN necklace n a ==> set ls SUBSET count a
12789 necklace_property |- !n a ls. ls IN necklace n a ==>
12790 LENGTH ls = n /\ set ls SUBSET count a
12791 necklace_0 |- !a. necklace 0 a = {[]}
12792 necklace_empty |- !n. 0 < n ==> (necklace n 0 = {})
12793 necklace_not_nil |- !n a ls. 0 < n /\ ls IN necklace n a ==> ls <> []
12794 necklace_suc |- !n a. necklace (SUC n) a =
12795 IMAGE (\(c,ls). c::ls) (count a CROSS necklace n a)
12796! necklace_eqn |- !n a. necklace n a =
12797 if n = 0 then {[]}
12798 else IMAGE (\(c,ls). c::ls) (count a CROSS necklace (n - 1) a)
12799 necklace_1 |- !a. necklace 1 a = {[e] | e IN count a}
12800 necklace_finite |- !n a. FINITE (necklace n a)
12801 necklace_card |- !n a. CARD (necklace n a) = a ** n
12802
12803 Mono-colored necklace:
12804 monocoloured_def |- !n a. monocoloured n a =
12805 {ls | ls IN necklace n a /\ (ls <> [] ==> SING (set ls))}
12806 monocoloured_element
12807 |- !n a ls. ls IN monocoloured n a <=>
12808 ls IN necklace n a /\ (ls <> [] ==> SING (set ls))
12809 monocoloured_necklace |- !n a ls. ls IN monocoloured n a ==> ls IN necklace n a
12810 monocoloured_subset |- !n a. monocoloured n a SUBSET necklace n a
12811 monocoloured_finite |- !n a. FINITE (monocoloured n a)
12812 monocoloured_0 |- !a. monocoloured 0 a = {[]}
12813 monocoloured_1 |- !a. monocoloured 1 a = necklace 1 a
12814 necklace_1_monocoloured
12815 |- !a. necklace 1 a = monocoloured 1 a
12816 monocoloured_empty|- !n. 0 < n ==> monocoloured n 0 = {}
12817 monocoloured_mono |- !n. monocoloured n 1 = necklace n 1
12818 monocoloured_suc |- !n a. 0 < n ==>
12819 monocoloured (SUC n) a = IMAGE (\ls. HD ls::ls) (monocoloured n a)
12820 monocoloured_0_card |- !a. CARD (monocoloured 0 a) = 1
12821 monocoloured_card |- !n a. 0 < n ==> CARD (monocoloured n a) = a
12822! monocoloured_eqn |- !n a. monocoloured n a =
12823 if n = 0 then {[]}
12824 else IMAGE (\c. GENLIST (K c) n) (count a)
12825 monocoloured_card_eqn |- !n a. CARD (monocoloured n a) = if n = 0 then 1 else a
12826
12827 Multi-colored necklace:
12828 multicoloured_def |- !n a. multicoloured n a = necklace n a DIFF monocoloured n a
12829 multicoloured_element |- !n a ls. ls IN multicoloured n a <=>
12830 ls IN necklace n a /\ ls <> [] /\ ~SING (set ls)
12831 multicoloured_necklace|- !n a ls. ls IN multicoloured n a ==> ls IN necklace n a
12832 multicoloured_subset |- !n a. multicoloured n a SUBSET necklace n a
12833 multicoloured_finite |- !n a. FINITE (multicoloured n a)
12834 multicoloured_0 |- !a. multicoloured 0 a = {}
12835 multicoloured_1 |- !a. multicoloured 1 a = {}
12836 multicoloured_n_0 |- !n. multicoloured n 0 = {}
12837 multicoloured_n_1 |- !n. multicoloured n 1 = {}
12838 multicoloured_empty |- !n. multicoloured n 0 = {} /\ multicoloured n 1 = {}
12839 multi_mono_disjoint |- !n a. DISJOINT (multicoloured n a) (monocoloured n a)
12840 multi_mono_exhaust |- !n a. necklace n a = multicoloured n a UNION monocoloured n a
12841 multicoloured_card |- !n a. 0 < n ==> (CARD (multicoloured n a) = a ** n - a)
12842 multicoloured_card_eqn|- !n a. CARD (multicoloured n a) = if n = 0 then 0 else a ** n - a
12843 multicoloured_nonempty|- !n a. 1 < n /\ 1 < a ==> multicoloured n a <> {}
12844 multicoloured_not_monocoloured
12845 |- !n a ls. ls IN multicoloured n a ==> ls NOTIN monocoloured n a
12846 multicoloured_not_monocoloured_iff
12847 |- !n a ls. ls IN necklace n a ==>
12848 (ls IN multicoloured n a <=> ls NOTIN monocoloured n a)
12849 multicoloured_or_monocoloured
12850 |- !n a ls. ls IN necklace n a ==>
12851 ls IN multicoloured n a \/ ls IN monocoloured n a
12852*)
12853
12854
12855(* ------------------------------------------------------------------------- *)
12856(* Helper Theorems. *)
12857(* ------------------------------------------------------------------------- *)
12858
12859(* ------------------------------------------------------------------------- *)
12860(* Necklace *)
12861(* ------------------------------------------------------------------------- *)
12862
12863(* Define necklaces as lists of length n, i.e. with n beads, in a colors. *)
12864Definition necklace_def[nocompute]:
12865 necklace n a = {ls | LENGTH ls = n /\ (set ls) SUBSET (count a) }
12866End
12867(* Note: use [nocompute] as this is not effective. *)
12868
12869(* Theorem: ls IN necklace n a <=> (LENGTH ls = n /\ (set ls) SUBSET (count a)) *)
12870(* Proof: by necklace_def *)
12871Theorem necklace_element:
12872 !n a ls. ls IN necklace n a <=> (LENGTH ls = n /\ (set ls) SUBSET (count a))
12873Proof
12874 simp[necklace_def]
12875QED
12876
12877(* Theorem: ls IN (necklace n a) ==> LENGTH ls = n *)
12878(* Proof: by necklace_def *)
12879Theorem necklace_length:
12880 !n a ls. ls IN (necklace n a) ==> LENGTH ls = n
12881Proof
12882 simp[necklace_def]
12883QED
12884
12885(* Theorem: ls IN (necklace n a) ==> set ls SUBSET count a *)
12886(* Proof: by necklace_def *)
12887Theorem necklace_colors:
12888 !n a ls. ls IN (necklace n a) ==> set ls SUBSET count a
12889Proof
12890 simp[necklace_def]
12891QED
12892
12893(* Idea: If ls in (necklace n a), LENGTH ls = n and colors in count a. *)
12894
12895(* Theorem: ls IN (necklace n a) ==> LENGTH ls = n /\ set ls SUBSET count a *)
12896(* Proof: by necklace_def *)
12897Theorem necklace_property:
12898 !n a ls. ls IN (necklace n a) ==> LENGTH ls = n /\ set ls SUBSET count a
12899Proof
12900 simp[necklace_def]
12901QED
12902
12903(* ------------------------------------------------------------------------- *)
12904(* Know the necklaces. *)
12905(* ------------------------------------------------------------------------- *)
12906
12907(* Idea: zero-length necklaces of whatever colors is the set of NIL. *)
12908
12909(* Theorem: necklace 0 a = {[]} *)
12910(* Proof:
12911 necklace 0 a
12912 = {ls | (LENGTH ls = 0) /\ (set ls) SUBSET (count a) } by necklace_def
12913 = {ls | ls = [] /\ (set []) SUBSET (count a) } by LENGTH_NIL
12914 = {ls | ls = [] /\ [] SUBSET (count a) } by LIST_TO_SET
12915 = {[]} by EMPTY_SUBSET
12916*)
12917Theorem necklace_0:
12918 !a. necklace 0 a = {[]}
12919Proof
12920 rw[necklace_def, EXTENSION] >>
12921 metis_tac[LIST_TO_SET, EMPTY_SUBSET]
12922QED
12923
12924(* Idea: necklaces with some length but 0 colors is EMPTY. *)
12925
12926(* Theorem: 0 < n ==> (necklace n 0 = {}) *)
12927(* Proof:
12928 necklace n 0
12929 = {ls | LENGTH ls = n /\ (set ls) SUBSET (count 0) } by necklace_def
12930 = {ls | LENGTH ls = n /\ (set ls) SUBSET {} by COUNT_0
12931 = {ls | LENGTH ls = n /\ (set ls = {}) } by SUBSET_EMPTY
12932 = {ls | LENGTH ls = n /\ (ls = []) } by LIST_TO_SET_EQ_EMPTY
12933 = {} by LENGTH_NIL, 0 < n
12934*)
12935Theorem necklace_empty:
12936 !n. 0 < n ==> (necklace n 0 = {})
12937Proof
12938 rw[necklace_def, EXTENSION]
12939QED
12940
12941(* Idea: A necklace of length n <> 0 is non-NIL. *)
12942
12943(* Theorem: 0 < n /\ ls IN (necklace n a) ==> ls <> [] *)
12944(* Proof:
12945 By contradiction, suppose ls = [].
12946 Then n = LENGTH ls by necklace_element
12947 = LENGTH [] = 0 by LENGTH_NIL
12948 This contradicts 0 < n.
12949*)
12950Theorem necklace_not_nil:
12951 !n a ls. 0 < n /\ ls IN (necklace n a) ==> ls <> []
12952Proof
12953 rw[necklace_def] >>
12954 metis_tac[LENGTH_NON_NIL]
12955QED
12956
12957(* ------------------------------------------------------------------------- *)
12958(* To show: (necklace n a) is FINITE. *)
12959(* ------------------------------------------------------------------------- *)
12960
12961(* Idea: Relate (necklace (n+1) a) to (necklace n a) for induction. *)
12962
12963(* Theorem: necklace (SUC n) a =
12964 IMAGE (\(c, ls). c :: ls) (count a CROSS necklace n a) *)
12965(* Proof:
12966 By necklace_def, EXTENSION, this is to show:
12967 (1) LENGTH x = SUC n /\ set x SUBSET count a ==>
12968 ?h t. (x = h::t) /\ h < a /\ (LENGTH t = n) /\ set t SUBSET count a
12969 Note SUC n <> 0 by SUC_NOT_ZERO
12970 so ?h t. x = h::t by list_CASES
12971 Take these h, t, true by LENGTH, MEM
12972 (2) h < a /\ set t SUBSET count a ==> x < a ==> LENGTH (h::t) = SUC (LENGTH t)
12973 This is true by LENGTH
12974 (3) h < a /\ set t SUBSET count a ==> set (h::t) SUBSET count a
12975 Note set (h::t) c <=>
12976 (c = h) \/ set t c by LIST_TO_SET_DEF
12977 If c = h, h < a
12978 ==> h IN count a by IN_COUNT
12979 If set t c, set t SUBSET count a
12980 ==> c IN count a by SUBSET_DEF
12981 Thus set (h::t) SUBSET count a by SUBSET_DEF
12982*)
12983Theorem necklace_suc:
12984 !n a. necklace (SUC n) a =
12985 IMAGE (\(c, ls). c :: ls) (count a CROSS necklace n a)
12986Proof
12987 rw[necklace_def, EXTENSION] >>
12988 rw[pairTheory.EXISTS_PROD, EQ_IMP_THM] >| [
12989 `SUC n <> 0` by decide_tac >>
12990 `?h t. x = h::t` by metis_tac[LENGTH_NIL, list_CASES] >>
12991 qexists_tac `h` >>
12992 qexists_tac `t` >>
12993 fs[],
12994 simp[],
12995 fs[]
12996 ]
12997QED
12998
12999(* Idea: display the necklaces. *)
13000
13001(* Theorem: necklace n a =
13002 if n = 0 then {[]}
13003 else IMAGE (\(c,ls). c::ls) (count a CROSS necklace (n - 1) a) *)
13004(* Proof: by necklace_0, necklace_suc. *)
13005Theorem necklace_eqn[compute]:
13006 !n a. necklace n a =
13007 if n = 0 then {[]}
13008 else IMAGE (\(c,ls). c::ls) (count a CROSS necklace (n - 1) a)
13009Proof
13010 rw[necklace_0] >>
13011 metis_tac[necklace_suc, num_CASES, SUC_SUB1]
13012QED
13013
13014(*
13015> EVAL ``necklace 3 2``;
13016= {[1; 1; 1]; [1; 1; 0]; [1; 0; 1]; [1; 0; 0]; [0; 1; 1]; [0; 1; 0]; [0; 0; 1]; [0; 0; 0]}
13017> EVAL ``necklace 2 3``;
13018= {[2; 2]; [2; 1]; [2; 0]; [1; 2]; [1; 1]; [1; 0]; [0; 2]; [0; 1]; [0; 0]}
13019*)
13020
13021(* Idea: Unit-length necklaces are singletons from (count a). *)
13022
13023(* Theorem: necklace 1 a = {[e] | e IN count a} *)
13024(* Proof:
13025 Let f = (\(c,ls). c::ls).
13026 necklace 1 a
13027 = necklace (SUC 0) a by ONE
13028 = IMAGE f ((count a) CROSS (necklace 0 a)) by necklace_suc
13029 = IMAGE f ((count a) CROSS {[]}) by necklace_0
13030 = {[e] | e IN count a} by EXTENSION
13031*)
13032Theorem necklace_1:
13033 !a. necklace 1 a = {[e] | e IN count a}
13034Proof
13035 rewrite_tac[ONE] >>
13036 rw[necklace_suc, necklace_0, pairTheory.EXISTS_PROD, EXTENSION]
13037QED
13038
13039(* Idea: The set of (necklace n a) is finite. *)
13040
13041(* Theorem: FINITE (necklace n a) *)
13042(* Proof:
13043 By induction on n.
13044 Base: FINITE (necklace 0 a)
13045 Note necklace 0 a = {[]} by necklace_0
13046 and FINITE {[]} by FINITE_SING
13047 Step: FINITE (necklace n a) ==> FINITE (necklace (SUC n) a)
13048 Let f = (\(c, ls). c :: ls), b = count a, c = necklace n a.
13049 Note necklace (SUC n) a
13050 = IMAGE f (b CROSS c) by necklace_suc
13051 and FINITE b by FINITE_COUNT
13052 and FINITE c by induction hypothesis
13053 so FINITE (b CROSS c) by FINITE_CROSS
13054 Thus FINITE (necklace (SUC n) a) by IMAGE_FINITE
13055*)
13056Theorem necklace_finite:
13057 !n a. FINITE (necklace n a)
13058Proof
13059 rpt strip_tac >>
13060 Induct_on `n` >-
13061 simp[necklace_0] >>
13062 simp[necklace_suc]
13063QED
13064
13065(* ------------------------------------------------------------------------- *)
13066(* To show: CARD (necklace n a) = a^n. *)
13067(* ------------------------------------------------------------------------- *)
13068
13069(* Idea: size of (necklace n a) = a^n. *)
13070
13071(* Theorem: CARD (necklace n a) = a ** n *)
13072(* Proof:
13073 By induction on n.
13074 Base: CARD (necklace 0 a) = a ** 0
13075 CARD (necklace 0 a)
13076 = CARD {[]} by necklace_0
13077 = 1 by CARD_SING
13078 = a ** 0 by EXP_0
13079 Step: CARD (necklace n a) = a ** n ==>
13080 CARD (necklace (SUC n) a) = a ** SUC n
13081 Let f = (\(c, ls). c :: ls), b = count a, c = necklace n a.
13082 Note FINITE b by FINITE_COUNT
13083 and FINITE c by necklace_finite
13084 and FINITE (b CROSS c) by FINITE_CROSS
13085 Also INJ f (b CROSS c) univ(:num list) by INJ_DEF, CONS_11
13086 CARD (necklace (SUC n) a)
13087 = CARD (IMAGE f (b CROSS c)) by necklace_suc
13088 = CARD (b CROSS c) by INJ_CARD_IMAGE_EQN
13089 = CARD b * CARD c by CARD_CROSS
13090 = a * CARD c by CARD_COUNT
13091 = a * a ** n by induction hypothesis
13092 = a ** SUC n by EXP
13093*)
13094Theorem necklace_card:
13095 !n a. CARD (necklace n a) = a ** n
13096Proof
13097 rpt strip_tac >>
13098 Induct_on `n` >-
13099 simp[necklace_0] >>
13100 qabbrev_tac `f = (\(c:num, ls:num list). c :: ls)` >>
13101 qabbrev_tac `b = count a` >>
13102 qabbrev_tac `c = necklace n a` >>
13103 `FINITE b` by rw[FINITE_COUNT, Abbr`b`] >>
13104 `FINITE c` by rw[necklace_finite, Abbr`c`] >>
13105 `necklace (SUC n) a = IMAGE f (b CROSS c)` by rw[necklace_suc, Abbr`f`, Abbr`b`, Abbr`c`] >>
13106 `INJ f (b CROSS c) univ(:num list)` by rw[INJ_DEF, pairTheory.FORALL_PROD, Abbr`f`] >>
13107 `FINITE (b CROSS c)` by rw[FINITE_CROSS] >>
13108 `CARD (necklace (SUC n) a) = CARD (b CROSS c)` by rw[INJ_CARD_IMAGE_EQN] >>
13109 `_ = CARD b * CARD c` by rw[CARD_CROSS] >>
13110 `_ = a * a ** n` by fs[Abbr`b`, Abbr`c`] >>
13111 simp[EXP]
13112QED
13113
13114(* ------------------------------------------------------------------------- *)
13115(* Mono-colored necklace - necklace with a single color. *)
13116(* ------------------------------------------------------------------------- *)
13117
13118(* Define mono-colored necklace *)
13119Definition monocoloured_def[nocompute]:
13120 monocoloured n a =
13121 {ls | ls IN necklace n a /\ (ls <> [] ==> SING (set ls)) }
13122End
13123(* Note: use [nocompute] as this is not effective. *)
13124
13125(* Theorem: ls IN monocoloured n a <=>
13126 ls IN necklace n a /\ (ls <> [] ==> SING (set ls)) *)
13127(* Proof: by monocoloured_def *)
13128Theorem monocoloured_element:
13129 !n a ls. ls IN monocoloured n a <=>
13130 ls IN necklace n a /\ (ls <> [] ==> SING (set ls))
13131Proof
13132 simp[monocoloured_def]
13133QED
13134
13135(* ------------------------------------------------------------------------- *)
13136(* Know the Mono-coloured necklaces. *)
13137(* ------------------------------------------------------------------------- *)
13138
13139(* Idea: A monocoloured necklace is indeed a necklace. *)
13140
13141(* Theorem: ls IN monocoloured n a ==> ls IN necklace n a *)
13142(* Proof: by monocoloured_def *)
13143Theorem monocoloured_necklace:
13144 !n a ls. ls IN monocoloured n a ==> ls IN necklace n a
13145Proof
13146 simp[monocoloured_def]
13147QED
13148
13149(* Idea: The monocoloured set is subset of necklace set. *)
13150
13151(* Theorem: (monocoloured n a) SUBSET (necklace n a) *)
13152(* Proof: by monocoloured_necklace, SUBSET_DEF *)
13153Theorem monocoloured_subset:
13154 !n a. (monocoloured n a) SUBSET (necklace n a)
13155Proof
13156 simp[monocoloured_necklace, SUBSET_DEF]
13157QED
13158
13159(* Idea: The monocoloured set is FINITE. *)
13160
13161(* Theorem: FINITE (monocoloured n a) *)
13162(* Proof:
13163 Note (monocoloured n a) SUBSET (necklace n a) by monocoloured_subset
13164 and FINITE (necklace n a) by necklace_finite
13165 so FINITE (monocoloured n a) by SUBSET_FINITE
13166*)
13167Theorem monocoloured_finite:
13168 !n a. FINITE (monocoloured n a)
13169Proof
13170 metis_tac[monocoloured_subset, necklace_finite, SUBSET_FINITE]
13171QED
13172
13173(* Idea: Zero-length monocoloured set is singleton NIL. *)
13174
13175(* Theorem: monocoloured 0 a = {[]} *)
13176(* Proof:
13177 monocoloured 0 a
13178 = {ls | ls IN necklace 0 a /\ (ls <> [] ==> SING (set ls)) } by monocoloured_def
13179 = {ls | ls IN {[]} /\ (ls <> [] ==> SING (set ls)) } by necklace_0
13180 = {[]} by IN_SING
13181*)
13182Theorem monocoloured_0:
13183 !a. monocoloured 0 a = {[]}
13184Proof
13185 rw[monocoloured_def, necklace_0, EXTENSION, EQ_IMP_THM]
13186QED
13187
13188(* Idea: Unit-length monocoloured set are necklaces of length 1. *)
13189
13190(* Theorem: monocoloured 1 a = necklace 1 a *)
13191(* Proof:
13192 By necklace_def, monocoloured_def, EXTENSION,
13193 this is to show:
13194 (LENGTH x = 1) /\ set x SUBSET count a /\ (x <> [] ==> SING (set x)) <=>
13195 (LENGTH x = 1) /\ set x SUBSET count a
13196 This is true by SING_LIST_TO_SET
13197*)
13198Theorem monocoloured_1:
13199 !a. monocoloured 1 a = necklace 1 a
13200Proof
13201 rw[necklace_def, monocoloured_def, EXTENSION] >>
13202 metis_tac[SING_LIST_TO_SET]
13203QED
13204
13205(* Idea: Unit-length necklaces are monocoloured. *)
13206
13207(* Theorem: necklace 1 a = monocoloured 1 a *)
13208(* Proof: by monocoloured_1 *)
13209Theorem necklace_1_monocoloured:
13210 !a. necklace 1 a = monocoloured 1 a
13211Proof
13212 simp[monocoloured_1]
13213QED
13214
13215(* Idea: Some non-NIL necklaces are monocoloured. *)
13216
13217(* Theorem: 0 < n ==> monocoloured n 0 = {} *)
13218(* Proof:
13219 Note (monocoloured n 0) SUBSET (necklace n 0) by monocoloured_subset
13220 but necklace n 0 = {} by necklace_empty
13221 so monocoloured n 0 = {} by SUBSET_EMPTY
13222*)
13223Theorem monocoloured_empty:
13224 !n. 0 < n ==> monocoloured n 0 = {}
13225Proof
13226 metis_tac[monocoloured_subset, necklace_empty, SUBSET_EMPTY]
13227QED
13228
13229(* Idea: One-colour necklaces are monocoloured. *)
13230
13231(* Theorem: monocoloured n 1 = necklace n 1 *)
13232(* Proof:
13233 By monocoloured_def, necklace_def, EXTENSION,
13234 this is to show:
13235 set x SUBSET count 1 /\ x <> [] ==> SING (set x)
13236 Note count 1 = {0} by COUNT_1
13237 and set x <> {} by LIST_TO_SET
13238 so set x = {0} by SUBSET_SING_IFF
13239 or SING (set x) by SING_DEF
13240*)
13241Theorem monocoloured_mono:
13242 !n. monocoloured n 1 = necklace n 1
13243Proof
13244 rw[monocoloured_def, necklace_def, EXTENSION, EQ_IMP_THM] >>
13245 fs[COUNT_1] >>
13246 `set x = {0}` by fs[SUBSET_SING_IFF] >>
13247 simp[]
13248QED
13249
13250(* ------------------------------------------------------------------------- *)
13251(* To show: CARD (monocoloured n a) = a. *)
13252(* ------------------------------------------------------------------------- *)
13253
13254(* Idea: Relate (monocoloured (SUC n) a) to (monocoloured n a) for induction. *)
13255
13256(* Theorem: 0 < n ==> (monocoloured (SUC n) a =
13257 IMAGE (\ls. HD ls :: ls) (monocoloured n a)) *)
13258(* Proof:
13259 By monocoloured_def, necklace_def, EXTENSION, this is to show:
13260 (1) 0 < n /\ LENGTH x = SUC n /\ set x SUBSET count a /\ x <> [] ==> SING (set x) ==>
13261 ?ls. (x = HD ls::ls) /\ (LENGTH ls = n /\ set ls SUBSET count a) /\
13262 (ls <> [] ==> SING (set ls))
13263 Note SUC n <> 0 by SUC_NOT_ZERO
13264 so x <> [] by LENGTH_NIL
13265 ==> ?h t. x = h::t by list_CASES
13266 and LENGTH t = n by LENGTH
13267 but t <> [] by LENGTH_NON_NIL, 0 < n
13268 so ?k p. t = k::p by list_CASES
13269 Thus x = h::k::p by above
13270 Now h IN set x by MEM
13271 and k IN set x by MEM, SUBSET_DEF
13272 so h = k by IN_SING, SING (set x)
13273 Let ls = t,
13274 then set ls SUBSET count a by MEM, SUBSET_DEF
13275 and SING (set ls) by LIST_TO_SET_DEF
13276 (2) 0 < LENGTH ls /\ set ls SUBSET count a /\ ls <> [] ==> SING (set ls) ==>
13277 LENGTH (HD ls::ls) = SUC (LENGTH ls)
13278 This is true by LENGTH
13279 (3) 0 < LENGTH ls /\ set ls SUBSET count a /\ ls <> [] ==> SING (set ls) ==>
13280 set (HD ls::ls) SUBSET count a
13281 Note ls <> [] by LENGTH_NON_NIL
13282 so ?h t. ls = h::t by list_CASES
13283 Also set (h::ls) x <=>
13284 (x = h) \/ set t x by LIST_TO_SET_DEF
13285 Thus set (h::ls) SUBSET count a by SUBSET_DEF
13286 (4) 0 < LENGTH ls /\ set ls SUBSET count a /\ ls <> [] ==> SING (set ls) ==>
13287 SING (set (HD ls::ls))
13288 Note ls <> [] by LENGTH_NON_NIL
13289 so ?h t. ls = h::t by list_CASES
13290 Also set (h::ls) x <=>
13291 (x = h) \/ set t x by LIST_TO_SET_DEF
13292 Thus SING (set (h::ls)) by SUBSET_DEF
13293*)
13294Theorem monocoloured_suc:
13295 !n a. 0 < n ==> (monocoloured (SUC n) a =
13296 IMAGE (\ls. HD ls :: ls) (monocoloured n a))
13297Proof
13298 rw[monocoloured_def, necklace_def, EXTENSION] >>
13299 rw[pairTheory.EXISTS_PROD, EQ_IMP_THM] >| [
13300 `SUC n <> 0` by decide_tac >>
13301 `x <> [] /\ ?h t. x = h::t` by metis_tac[LENGTH_NIL, list_CASES] >>
13302 `LENGTH t = n` by fs[] >>
13303 `t <> []` by metis_tac[LENGTH_NON_NIL] >>
13304 `h IN set x` by fs[] >>
13305 `?k p. t = k::p` by metis_tac[list_CASES] >>
13306 `HD t IN set x` by rfs[SUBSET_DEF] >>
13307 `HD t = h` by metis_tac[SING_DEF, IN_SING] >>
13308 qexists_tac `t` >>
13309 fs[],
13310 simp[],
13311 `ls <> [] /\ ?h t. ls = h::t` by metis_tac[LENGTH_NON_NIL, list_CASES] >>
13312 fs[],
13313 `ls <> [] /\ ?h t. ls = h::t` by metis_tac[LENGTH_NON_NIL, list_CASES] >>
13314 fs[]
13315 ]
13316QED
13317
13318(* Idea: size of (monocoloured 0 a) = 1. *)
13319
13320(* Theorem: CARD (monocoloured 0 a) = 1 *)
13321(* Proof:
13322 Note monocoloured 0 a = {[]} by monocoloured_0
13323 so CARD (monocoloured 0 a) = 1 by CARD_SING
13324*)
13325Theorem monocoloured_0_card:
13326 !a. CARD (monocoloured 0 a) = 1
13327Proof
13328 simp[monocoloured_0]
13329QED
13330
13331(* Idea: size of (monocoloured n a) = a. *)
13332
13333(* Theorem: 0 < n ==> CARD (monocoloured n a) = a *)
13334(* Proof:
13335 By induction on n.
13336 Base: 0 < 0 ==> (CARD (monocoloured 0 a) = a)
13337 True by 0 < 0 = F.
13338 Step: 0 < n ==> CARD (monocoloured n a) = a ==>
13339 0 < SUC n ==> (CARD (monocoloured (SUC n) a) = a)
13340 If n = 0,
13341 CARD (monocoloured (SUC 0) a)
13342 = CARD (monocoloured 1 a) by ONE
13343 = CARD (necklace 1 a) by monocoloured_1
13344 = a ** 1 by necklace_card
13345 = a by EXP_1
13346 If n <> 0, then 0 < n.
13347 Let f = (\ls. HD ls :: ls).
13348 Then INJ f (monocoloured n a)
13349 univ(:num list) by INJ_DEF, CONS_11
13350 and FINITE (monocoloured n a) by monocoloured_finite
13351 CARD (monocoloured (SUC n) a)
13352 = CARD (IMAGE f (monocoloured n a)) by monocoloured_suc
13353 = CARD (monocoloured n a) by INJ_CARD_IMAGE_EQN
13354 = a by induction hypothesis
13355*)
13356Theorem monocoloured_card:
13357 !n a. 0 < n ==> CARD (monocoloured n a) = a
13358Proof
13359 rpt strip_tac >>
13360 Induct_on `n` >-
13361 simp[] >>
13362 (Cases_on `n = 0` >> simp[]) >-
13363 simp[monocoloured_1, necklace_card] >>
13364 qabbrev_tac `f = \ls:num list. HD ls :: ls` >>
13365 `INJ f (monocoloured n a) univ(:num list)` by rw[INJ_DEF, Abbr`f`] >>
13366 `FINITE (monocoloured n a)` by rw[monocoloured_finite] >>
13367 `CARD (monocoloured (SUC n) a) =
13368 CARD (IMAGE f (monocoloured n a))` by rw[monocoloured_suc, Abbr`f`] >>
13369 `_ = CARD (monocoloured n a)` by rw[INJ_CARD_IMAGE_EQN] >>
13370 fs[]
13371QED
13372
13373(* Theorem: monocoloured n a =
13374 if n = 0 then {[]} else IMAGE (\c. GENLIST (K c) n) (count a) *)
13375(* Proof:
13376 If n = 0, true by monocoloured_0
13377 If n <> 0, then 0 < n.
13378 By monocoloured_def, necklace_def, EXTENSION, this is to show:
13379 (1) 0 < LENGTH x /\ set x SUBSET count a /\ x <> [] ==> SING (set x) ==>
13380 ?c. (x = GENLIST (K c) (LENGTH x)) /\ c < a
13381 Note x <> [] by LENGTH_NON_NIL
13382 so ?c. set x = {c} by SING_DEF
13383 Then c < a by SUBSET_DEF, IN_COUNT
13384 and x = GENLIST (K c) (LENGTH x) by LIST_TO_SET_SING_IFF
13385 (2) c < a ==> LENGTH (GENLIST (K c) n) = n,
13386 This is true by LENGTH_GENLIST
13387 (3) c < a ==> set (GENLIST (K c) n) SUBSET count a
13388 Note set (GENLIST (K c) n) = {c} by GENLIST_K_SET
13389 so c < a ==> {c} SUBSET (count a) by SUBSET_DEF
13390 (4) c < a /\ GENLIST (K c) n <> [] ==> SING (set (GENLIST (K c) n))
13391 Note set (GENLIST (K c) n) = {c} by GENLIST_K_SET
13392 so SING (set (GENLIST (K c) n)) by SING_DEF
13393*)
13394Theorem monocoloured_eqn[compute]:
13395 !n a. monocoloured n a =
13396 if n = 0 then {[]}
13397 else IMAGE (\c. GENLIST (K c) n) (count a)
13398Proof
13399 rw_tac bool_ss[] >-
13400 simp[monocoloured_0] >>
13401 `0 < n` by decide_tac >>
13402 rw[monocoloured_def, necklace_def, EXTENSION, EQ_IMP_THM] >| [
13403 `x <> []` by metis_tac[LENGTH_NON_NIL] >>
13404 `SING (set x) /\ ?c. set x = {c}` by rw[GSYM SING_DEF] >>
13405 `c < a` by fs[SUBSET_DEF] >>
13406 `?b. x = GENLIST (K b) (LENGTH x)` by metis_tac[LIST_TO_SET_SING_IFF] >>
13407 metis_tac[GENLIST_K_SET, IN_SING],
13408 simp[],
13409 rw[GENLIST_K_SET],
13410 rw[GENLIST_K_SET]
13411 ]
13412QED
13413
13414(*
13415> EVAL ``monocoloured 2 3``; = {[2; 2]; [1; 1]; [0; 0]}: thm
13416> EVAL ``monocoloured 3 2``; = {[1; 1; 1]; [0; 0; 0]}: thm
13417*)
13418
13419(* Slight improvement of a previous result. *)
13420
13421(* Theorem: CARD (monocoloured n a) = if n = 0 then 1 else a *)
13422(* Proof:
13423 If n = 0,
13424 CARD (monocoloured 0 a)
13425 = CARD {[]} by monocoloured_eqn
13426 = 1 by CARD_SING
13427 If n <> 0, then 0 < n.
13428 Let f = (\c:num. GENLIST (K c) n).
13429 Then INJ f (count a) univ(:num list)
13430 by INJ_DEF, GENLIST_K_SET, IN_SING
13431 and FINITE (count a) by FINITE_COUNT
13432 CARD (monocoloured n a)
13433 = CARD (IMAGE f (count a)) by monocoloured_eqn
13434 = CARD (count a) by INJ_CARD_IMAGE_EQN
13435 = a by CARD_COUNT
13436*)
13437Theorem monocoloured_card_eqn:
13438 !n a. CARD (monocoloured n a) = if n = 0 then 1 else a
13439Proof
13440 rw[monocoloured_eqn] >>
13441 qmatch_abbrev_tac `CARD (IMAGE f (count a)) = a` >>
13442 `INJ f (count a) univ(:num list)` by
13443 (rw[INJ_DEF, Abbr`f`] >>
13444 `0 < n` by decide_tac >>
13445 metis_tac[GENLIST_K_SET, IN_SING]) >>
13446 rw[INJ_CARD_IMAGE_EQN]
13447QED
13448
13449(* ------------------------------------------------------------------------- *)
13450(* Multi-colored necklace *)
13451(* ------------------------------------------------------------------------- *)
13452
13453(* Define multi-colored necklace *)
13454Definition multicoloured_def:
13455 multicoloured n a = (necklace n a) DIFF (monocoloured n a)
13456End
13457(* Note: EVAL can handle set DIFF. *)
13458
13459(*
13460> EVAL ``multicoloured 3 2``;
13461= {[1; 1; 0]; [1; 0; 1]; [1; 0; 0]; [0; 1; 1]; [0; 1; 0]; [0; 0; 1]}: thm
13462> EVAL ``multicoloured 2 3``;
13463= {[2; 1]; [2; 0]; [1; 2]; [1; 0]; [0; 2]; [0; 1]}: thm
13464*)
13465
13466(* Theorem: ls IN multicoloured n a <=>
13467 ls IN necklace n a /\ ls <> [] /\ ~SING (set ls) *)
13468(* Proof:
13469 ls IN multicoloured n a
13470 <=> ls IN (necklace n a) DIFF (monocoloured n a) by multicoloured_def
13471 <=> ls IN (necklace n a) /\ ls NOTIN (monocoloured n a) by IN_DIFF
13472 <=> ls IN (necklace n a) /\
13473 ~ls IN necklace n a /\ (ls <> [] ==> SING (set ls)) by monocoloured_def
13474 <=> ls IN (necklace n a) /\ ls <> [] /\ ~SING (set ls) by logical equivalence
13475
13476 t /\ ~(t /\ (p ==> q))
13477 = t /\ (~t \/ ~(p ==> q))
13478 = t /\ ~t \/ (t /\ ~(~p \/ q))
13479 = t /\ (p /\ ~q)
13480*)
13481Theorem multicoloured_element:
13482 !n a ls. ls IN multicoloured n a <=>
13483 ls IN necklace n a /\ ls <> [] /\ ~SING (set ls)
13484Proof
13485 (rw[multicoloured_def, monocoloured_def, EQ_IMP_THM] >> simp[])
13486QED
13487
13488(* ------------------------------------------------------------------------- *)
13489(* Know the Multi-coloured necklaces. *)
13490(* ------------------------------------------------------------------------- *)
13491
13492(* Idea: multicoloured is a necklace. *)
13493
13494(* Theorem: ls IN multicoloured n a ==> ls IN necklace n a *)
13495(* Proof: by multicoloured_def *)
13496Theorem multicoloured_necklace:
13497 !n a ls. ls IN multicoloured n a ==> ls IN necklace n a
13498Proof
13499 simp[multicoloured_def]
13500QED
13501
13502(* Idea: The multicoloured set is subset of necklace set. *)
13503
13504(* Theorem: (multicoloured n a) SUBSET (necklace n a) *)
13505(* Proof:
13506 Note multicoloured n a
13507 = (necklace n a) DIFF (monocoloured n a) by multicoloured_def
13508 so (multicoloured n a) SUBSET (necklace n a) by DIFF_SUBSET
13509*)
13510Theorem multicoloured_subset:
13511 !n a. (multicoloured n a) SUBSET (necklace n a)
13512Proof
13513 simp[multicoloured_def]
13514QED
13515
13516(* Idea: multicoloured set is FINITE. *)
13517
13518(* Theorem: FINITE (multicoloured n a) *)
13519(* Proof:
13520 Note multicoloured n a
13521 = (necklace n a) DIFF (monocoloured n a) by multicoloured_def
13522 and FINITE (necklace n a) by necklace_finite
13523 so FINITE (multicoloured n a) by FINITE_DIFF
13524*)
13525Theorem multicoloured_finite:
13526 !n a. FINITE (multicoloured n a)
13527Proof
13528 simp[multicoloured_def, necklace_finite, FINITE_DIFF]
13529QED
13530
13531(* Idea: (multicoloured 0 a) is EMPTY. *)
13532
13533(* Theorem: multicoloured 0 a = {} *)
13534(* Proof:
13535 multicoloured 0 a
13536 = (necklace 0 a) DIFF (monocoloured 0 a) by multicoloured_def
13537 = {[]} - {[]} by necklace_0, monocoloured_0
13538 = {} by DIFF_EQ_EMPTY
13539*)
13540Theorem multicoloured_0:
13541 !a. multicoloured 0 a = {}
13542Proof
13543 simp[multicoloured_def, necklace_0, monocoloured_0]
13544QED
13545
13546(* Idea: (mutlicoloured 1 a) is also EMPTY. *)
13547
13548(* Theorem: multicoloured 1 a = {} *)
13549(* Proof:
13550 multicoloured 1 a
13551 = (necklace 1 a) DIFF (monocoloured 1 a) by multicoloured_def
13552 = (necklace 1 a) DIFF (necklace 1 a) by monocoloured_1
13553 = {} by DIFF_EQ_EMPTY
13554*)
13555Theorem multicoloured_1:
13556 !a. multicoloured 1 a = {}
13557Proof
13558 simp[multicoloured_def, monocoloured_1]
13559QED
13560
13561(* Idea: (multicoloured n 0) without color is EMPTY. *)
13562
13563(* Theorem: multicoloured n 0 = {} *)
13564(* Proof:
13565 If n = 0,
13566 Then multicoloured 0 0 = {} by multicoloured_0
13567 If n <> 0, then 0 < n.
13568 multicoloured n 0
13569 = (necklace n 0) DIFF (monocoloured n 0) by multicoloured_def
13570 = {} DIFF (monocoloured n 0) by necklace_empty
13571 = {} by EMPTY_DIFF
13572*)
13573Theorem multicoloured_n_0:
13574 !n. multicoloured n 0 = {}
13575Proof
13576 rpt strip_tac >>
13577 Cases_on `n = 0` >-
13578 simp[multicoloured_0] >>
13579 simp[multicoloured_def, necklace_empty]
13580QED
13581
13582(* Idea: (multicoloured n 1) with one color is EMPTY. *)
13583
13584(* Theorem: multicoloured n 1 = {} *)
13585(* Proof:
13586 multicoloured n 1
13587 = (necklace n 1) DIFF (monocoloured n 1) by multicoloured_def
13588 = {necklace n 1} DIFF (necklace n 1) by monocoloured_mono
13589 = {} by DIFF_EQ_EMPTY
13590*)
13591Theorem multicoloured_n_1:
13592 !n. multicoloured n 1 = {}
13593Proof
13594 simp[multicoloured_def, monocoloured_mono]
13595QED
13596
13597(* Theorem: multicoloured n 0 = {} /\ multicoloured n 1 = {} *)
13598(* Proof: by multicoloured_n_0, multicoloured_n_1. *)
13599Theorem multicoloured_empty:
13600 !n. multicoloured n 0 = {} /\ multicoloured n 1 = {}
13601Proof
13602 simp[multicoloured_n_0, multicoloured_n_1]
13603QED
13604
13605(* ------------------------------------------------------------------------- *)
13606(* To show: CARD (multicoloured n a) = a^n - a. *)
13607(* ------------------------------------------------------------------------- *)
13608
13609(* Idea: a multicoloured necklace is not monocoloured. *)
13610
13611(* Theorem: DISJOINT (multicoloured n a) (monocoloured n a) *)
13612(* Proof:
13613 Let s = necklace n a, t = monocoloured n a.
13614 Then multicoloured n a = s DIFF t by multicoloured_def
13615 so DISJOINT (multicoloured n a) t by DISJOINT_DIFF
13616*)
13617Theorem multi_mono_disjoint:
13618 !n a. DISJOINT (multicoloured n a) (monocoloured n a)
13619Proof
13620 simp[multicoloured_def, DISJOINT_DIFF]
13621QED
13622
13623(* Idea: a necklace is either monocoloured or multicolored. *)
13624
13625(* Theorem: necklace n a = (multicoloured n a) UNION (monocoloured n a) *)
13626(* Proof:
13627 Let s = necklace n a, t = monocoloured n a.
13628 Then multicoloured n a = s DIFF t by multicoloured_def
13629 Now t SUBSET s by monocoloured_subset
13630 so necklace n a = s
13631 = (multicoloured n a) UNION t by UNION_DIFF
13632*)
13633Theorem multi_mono_exhaust:
13634 !n a. necklace n a = (multicoloured n a) UNION (monocoloured n a)
13635Proof
13636 simp[multicoloured_def, monocoloured_subset, UNION_DIFF]
13637QED
13638
13639(* Idea: size of (multicoloured n a) = a^n - a. *)
13640
13641(* Theorem: 0 < n ==> (CARD (multicoloured n a) = a ** n - a) *)
13642(* Proof:
13643 Let s = necklace n a,
13644 t = monocoloured n a.
13645 Note t SUBSET s by monocoloured_subset
13646 and FINITE s by necklace_finite
13647 CARD (multicoloured n a)
13648 = CARD (s DIFF t) by multicoloured_def
13649 = CARD s - CARD t by SUBSET_DIFF_CARD, t SUBSET s
13650 = a ** n - CARD t by necklace_card
13651 = a ** n - a by monocoloured_card, 0 < n
13652*)
13653Theorem multicoloured_card:
13654 !n a. 0 < n ==> (CARD (multicoloured n a) = a ** n - a)
13655Proof
13656 rpt strip_tac >>
13657 `(monocoloured n a) SUBSET (necklace n a)` by rw[monocoloured_subset] >>
13658 `FINITE (necklace n a)` by rw[necklace_finite] >>
13659 simp[multicoloured_def, SUBSET_DIFF_CARD, necklace_card, monocoloured_card]
13660QED
13661
13662(* Theorem: CARD (multicoloured n a) = if n = 0 then 0 else a ** n - a *)
13663(* Proof:
13664 If n = 0,
13665 CARD (multicoloured 0 a)
13666 = CARD {} by multicoloured_0
13667 = 0 by CARD_EMPTY
13668 If n <> 0, then 0 < n.
13669 CARD (multicoloured 0 a)
13670 = a ** n - a by multicoloured_card
13671*)
13672Theorem multicoloured_card_eqn:
13673 !n a. CARD (multicoloured n a) = if n = 0 then 0 else a ** n - a
13674Proof
13675 rpt strip_tac >>
13676 Cases_on `n = 0` >-
13677 simp[multicoloured_0] >>
13678 simp[multicoloured_card]
13679QED
13680
13681(* Idea: (multicoloured n a) NOT empty when 1 < n /\ 1 < a. *)
13682
13683(* Theorem: 1 < n /\ 1 < a ==> (multicoloured n a) <> {} *)
13684(* Proof:
13685 Let s = multicoloured n a.
13686 Then FINITE s by multicoloured_finite
13687 and CARD s = a ** n - a by multicoloured_card
13688 Note a < a ** n by EXP_LT, 1 < a, 1 < n
13689 Thus CARD s <> 0,
13690 or s <> {} by CARD_EMPTY
13691*)
13692Theorem multicoloured_nonempty:
13693 !n a. 1 < n /\ 1 < a ==> (multicoloured n a) <> {}
13694Proof
13695 rpt strip_tac >>
13696 qabbrev_tac `s = multicoloured n a` >>
13697 `FINITE s` by rw[multicoloured_finite, Abbr`s`] >>
13698 `CARD s = a ** n - a` by rw[multicoloured_card, Abbr`s`] >>
13699 `a < a ** n` by rw[EXP_LT] >>
13700 `CARD s <> 0` by decide_tac >>
13701 rfs[]
13702QED
13703
13704(* ------------------------------------------------------------------------- *)
13705
13706(* For revised necklace proof using GCD. *)
13707
13708(* Idea: multicoloured lists are not monocoloured. *)
13709
13710(* Theorem: ls IN multicoloured n a ==> ~(ls IN monocoloured n a) *)
13711(* Proof:
13712 Let s = necklace n a,
13713 t = monocoloured n a.
13714 Note multicoloured n a = s DIFF t by multicoloured_def
13715 so ls IN multicoloured n a
13716 ==> ls NOTIN t by IN_DIFF
13717*)
13718Theorem multicoloured_not_monocoloured:
13719 !n a ls. ls IN multicoloured n a ==> ~(ls IN monocoloured n a)
13720Proof
13721 simp[multicoloured_def]
13722QED
13723
13724(* Theorem: ls IN necklace n a ==>
13725 (ls IN multicoloured n a <=> ~(ls IN monocoloured n a)) *)
13726(* Proof:
13727 Let s = necklace n a,
13728 t = monocoloured n a.
13729 Note multicoloured n a = s DIFF t by multicoloured_def
13730 so ls IN multicoloured n a
13731 <=> ls IN s /\ ls NOTIN t by IN_DIFF
13732*)
13733Theorem multicoloured_not_monocoloured_iff:
13734 !n a ls. ls IN necklace n a ==>
13735 (ls IN multicoloured n a <=> ~(ls IN monocoloured n a))
13736Proof
13737 simp[multicoloured_def]
13738QED
13739
13740(* Theorem: ls IN necklace n a ==>
13741 ls IN multicoloured n a \/ ls IN monocoloured n a *)
13742(* Proof: by multicoloured_def. *)
13743Theorem multicoloured_or_monocoloured:
13744 !n a ls. ls IN necklace n a ==>
13745 ls IN multicoloured n a \/ ls IN monocoloured n a
13746Proof
13747 simp[multicoloured_def]
13748QED
13749
13750(* ------------------------------------------------------------------------- *)
13751(* Combinatorics Documentation *)
13752(* ------------------------------------------------------------------------- *)
13753(* Overloading (# is temporary):
13754*)
13755(* Definitions and Theorems (# are exported, ! are in compute):
13756
13757 Counting number of combinations:
13758 sub_count_def |- !n k. sub_count n k = {s | s SUBSET count n /\ CARD s = k}
13759 choose_def |- !n k. n choose k = CARD (sub_count n k)
13760 sub_count_element |- !n k s. s IN sub_count n k <=> s SUBSET count n /\ CARD s = k
13761 sub_count_subset |- !n k. sub_count n k SUBSET POW (count n)
13762 sub_count_finite |- !n k. FINITE (sub_count n k)
13763 sub_count_element_no_self
13764 |- !n k s. s IN sub_count n k ==> n NOTIN s
13765 sub_count_element_finite
13766 |- !n k s. s IN sub_count n k ==> FINITE s
13767 sub_count_n_0 |- !n. sub_count n 0 = {{}}
13768 sub_count_0_n |- !n. sub_count 0 n = if n = 0 then {{}} else {}
13769 sub_count_n_1 |- !n. sub_count n 1 = {{j} | j < n}
13770 sub_count_n_n |- !n. sub_count n n = {count n}
13771 sub_count_eq_empty |- !n k. sub_count n k = {} <=> n < k
13772 sub_count_union |- !n k. sub_count (n + 1) (k + 1) =
13773 IMAGE (\s. n INSERT s) (sub_count n k) UNION
13774 sub_count n (k + 1)
13775 sub_count_disjoint |- !n k. DISJOINT (IMAGE (\s. n INSERT s) (sub_count n k))
13776 (sub_count n (k + 1))
13777 sub_count_insert |- !n k s. s IN sub_count n k ==>
13778 n INSERT s IN sub_count (n + 1) (k + 1)
13779 sub_count_insert_card
13780 |- !n k. CARD (IMAGE (\s. n INSERT s) (sub_count n k)) =
13781 n choose k
13782 sub_count_alt |- !n k. sub_count n 0 = {{}} /\ sub_count 0 (k + 1) = {} /\
13783 sub_count (n + 1) (k + 1) =
13784 IMAGE (\s. n INSERT s) (sub_count n k) UNION
13785 sub_count n (k + 1)
13786! sub_count_eqn |- !n k. sub_count n k =
13787 if k = 0 then {{}}
13788 else if n = 0 then {}
13789 else IMAGE (\s. n - 1 INSERT s) (sub_count (n - 1) (k - 1)) UNION
13790 sub_count (n - 1) k
13791 choose_n_0 |- !n. n choose 0 = 1
13792 choose_n_1 |- !n. n choose 1 = n
13793 choose_eq_0 |- !n k. n choose k = 0 <=> n < k
13794 choose_0_n |- !n. 0 choose n = if n = 0 then 1 else 0
13795 choose_1_n |- !n. 1 choose n = if 1 < n then 0 else 1
13796 choose_n_n |- !n. n choose n = 1
13797 choose_recurrence |- !n k. (n + 1) choose (k + 1) = n choose k + n choose (k + 1)
13798 choose_alt |- !n k. n choose 0 = 1 /\ 0 choose (k + 1) = 0 /\
13799 (n + 1) choose (k + 1) = n choose k + n choose (k + 1)
13800! choose_eqn |- !n k. n choose k = binomial n k
13801
13802 Partition of the set of subsets by bijective equivalence:
13803 sub_sets_def |- !P k. sub_sets P k = {s | s SUBSET P /\ CARD s = k}
13804 sub_sets_sub_count |- !n k. sub_sets (count n) k = sub_count n k
13805 sub_sets_equiv_class|- !s t. FINITE t /\ s SUBSET t ==>
13806 sub_sets t (CARD s) = equiv_class $=b= (POW t) s
13807 sub_count_equiv_class
13808 |- !n k. k <= n ==>
13809 sub_count n k =
13810 equiv_class $=b= (POW (count n)) (count k)
13811 count_power_partition |- !n. partition $=b= (POW (count n)) =
13812 IMAGE (sub_count n) (upto n)
13813 sub_count_count_inj |- !n m. INJ (sub_count n) (upto n)
13814 univ(:(num -> bool) -> bool)
13815 choose_sum_over_count |- !n. SIGMA ($choose n) (upto n) = 2 ** n
13816 choose_sum_over_all |- !n. SUM (MAP ($choose n) [0 .. n]) = 2 ** n
13817
13818 Counting number of permutations:
13819 perm_count_def |- !n. perm_count n = {ls | ALL_DISTINCT ls /\ set ls = count n}
13820 perm_def |- !n. perm n = CARD (perm_count n)
13821 perm_count_element |- !ls n. ls IN perm_count n <=> ALL_DISTINCT ls /\ set ls = count n
13822 perm_count_element_no_self
13823 |- !ls n. ls IN perm_count n ==> ~MEM n ls
13824 perm_count_element_length
13825 |- !ls n. ls IN perm_count n ==> LENGTH ls = n
13826 perm_count_subset |- !n. perm_count n SUBSET necklace n n
13827 perm_count_finite |- !n. FINITE (perm_count n)
13828 perm_count_0 |- perm_count 0 = {[]}
13829 perm_count_1 |- perm_count 1 = {[0]}
13830 interleave_def |- !x ls. x interleave ls =
13831 IMAGE (\k. TAKE k ls ++ x::DROP k ls) (upto (LENGTH ls))
13832 interleave_alt |- !ls x. x interleave ls =
13833 {TAKE k ls ++ x::DROP k ls | k | k <= LENGTH ls}
13834 interleave_element |- !ls x y. y IN x interleave ls <=>
13835 ?k. k <= LENGTH ls /\ y = TAKE k ls ++ x::DROP k ls
13836 interleave_nil |- !x. x interleave [] = {[x]}
13837 interleave_length |- !ls x y. y IN x interleave ls ==> LENGTH y = 1 + LENGTH ls
13838 interleave_distinct |- !ls x y. ALL_DISTINCT (x::ls) /\ y IN x interleave ls ==>
13839 ALL_DISTINCT y
13840 interleave_distinct_alt
13841 |- !ls x y. ALL_DISTINCT ls /\ ~MEM x ls /\
13842 y IN x interleave ls ==> ALL_DISTINCT y
13843 interleave_set |- !ls x y. y IN x interleave ls ==> set y = set (x::ls)
13844 interleave_set_alt |- !ls x y. y IN x interleave ls ==> set y = x INSERT set ls
13845 interleave_has_cons |- !ls x. x::ls IN x interleave ls
13846 interleave_not_empty|- !ls x. x interleave ls <> {}
13847 interleave_eq |- !n x y. ~MEM n x /\ ~MEM n y ==>
13848 (n interleave x = n interleave y <=> x = y)
13849 interleave_disjoint |- !l1 l2 x. ~MEM x l1 /\ l1 <> l2 ==>
13850 DISJOINT (x interleave l1) (x interleave l2)
13851 interleave_finite |- !ls x. FINITE (x interleave ls)
13852 interleave_count_inj|- !ls x. ~MEM x ls ==>
13853 INJ (\k. TAKE k ls ++ x::DROP k ls)
13854 (upto (LENGTH ls)) univ(:'a list)
13855 interleave_card |- !ls x. ~MEM x ls ==> CARD (x interleave ls) = 1 + LENGTH ls
13856 interleave_revert |- !ls h. ALL_DISTINCT ls /\ MEM h ls ==>
13857 ?t. ALL_DISTINCT t /\ ls IN h interleave t /\
13858 set t = set ls DELETE h
13859 interleave_revert_count
13860 |- !ls n. ALL_DISTINCT ls /\ set ls = upto n ==>
13861 ?t. ALL_DISTINCT t /\ ls IN n interleave t /\
13862 set t = count n
13863 perm_count_suc |- !n. perm_count (SUC n) =
13864 BIGUNION (IMAGE ($interleave n) (perm_count n))
13865 perm_count_suc_alt |- !n. perm_count (n + 1) =
13866 BIGUNION (IMAGE ($interleave n) (perm_count n))
13867! perm_count_eqn |- !n. perm_count n =
13868 if n = 0 then {[]}
13869 else BIGUNION (IMAGE ($interleave (n - 1)) (perm_count (n - 1)))
13870 perm_0 |- perm 0 = 1
13871 perm_1 |- perm 1 = 1
13872 perm_count_interleave_finite
13873 |- !n e. e IN IMAGE ($interleave n) (perm_count n) ==> FINITE e
13874 perm_count_interleave_card
13875 |- !n e. e IN IMAGE ($interleave n) (perm_count n) ==> CARD e = n + 1
13876 perm_count_interleave_disjoint
13877 |- !n e s t. s IN IMAGE ($interleave n) (perm_count n) /\
13878 t IN IMAGE ($interleave n) (perm_count n) /\ s <> t ==>
13879 DISJOINT s t
13880 perm_count_interleave_inj
13881 |- !n. INJ ($interleave n) (perm_count n) univ(:num list -> bool)
13882 perm_suc |- !n. perm (SUC n) = SUC n * perm n
13883 perm_suc_alt |- !n. perm (n + 1) = (n + 1) * perm n
13884! perm_eq_fact |- !n. perm n = FACT n
13885
13886 Permutations of a set:
13887 perm_set_def |- !s. perm_set s = {ls | ALL_DISTINCT ls /\ set ls = s}
13888 perm_set_element |- !ls s. ls IN perm_set s <=> ALL_DISTINCT ls /\ set ls = s
13889 perm_set_perm_count |- !n. perm_set (count n) = perm_count n
13890 perm_set_empty |- perm_set {} = {[]}
13891 perm_set_sing |- !x. perm_set {x} = {[x]}
13892 perm_set_eq_empty_sing
13893 |- !s. perm_set s = {[]} <=> s = {}
13894 perm_set_has_self_list
13895 |- !s. FINITE s ==> SET_TO_LIST s IN perm_set s
13896 perm_set_not_empty |- !s. FINITE s ==> perm_set s <> {}
13897 perm_set_list_not_empty
13898 |- !ls. perm_set (set ls) <> {}
13899 perm_set_map_element|- !ls f s n. ls IN perm_set s /\ BIJ f s (count n) ==>
13900 MAP f ls IN perm_count n
13901 perm_set_map_inj |- !f s n. BIJ f s (count n) ==> INJ (MAP f) (perm_set s) (perm_count n)
13902 perm_set_map_surj |- !f s n. BIJ f s (count n) ==> SURJ (MAP f) (perm_set s) (perm_count n)
13903 perm_set_map_bij |- !f s n. BIJ f s (count n) ==> BIJ (MAP f) (perm_set s) (perm_count n)
13904 perm_set_bij_eq_perm_count
13905 |- !s. FINITE s ==> perm_set s =b= perm_count (CARD s)
13906 perm_set_finite |- !s. FINITE s ==> FINITE (perm_set s)
13907 perm_set_card |- !s. FINITE s ==> CARD (perm_set s) = perm (CARD s)
13908 perm_set_card_alt |- !s. FINITE s ==> CARD (perm_set s) = FACT (CARD s)
13909
13910 Counting number of arrangements:
13911 list_count_def |- !n k. list_count n k =
13912 {ls | ALL_DISTINCT ls /\
13913 set ls SUBSET count n /\ LENGTH ls = k}
13914 arrange_def |- !n k. n arrange k = CARD (list_count n k)
13915 list_count_alt |- !n k. list_count n k =
13916 {ls | ALL_DISTINCT ls /\
13917 set ls SUBSET count n /\ CARD (set ls) = k}
13918 list_count_element |- !ls n k. ls IN list_count n k <=>
13919 ALL_DISTINCT ls /\ set ls SUBSET count n /\ LENGTH ls = k
13920 list_count_element_alt
13921 |- !ls n k. ls IN list_count n k <=>
13922 ALL_DISTINCT ls /\ set ls SUBSET count n /\ CARD (set ls) = k
13923 list_count_element_set_card
13924 |- !ls n k. ls IN list_count n k ==> CARD (set ls) = k
13925 list_count_subset |- !n k. list_count n k SUBSET necklace k n
13926 list_count_finite |- !n k. FINITE (list_count n k)
13927 list_count_n_0 |- !n. list_count n 0 = {[]}
13928 list_count_0_n |- !n. 0 < n ==> list_count 0 n = {}
13929 list_count_n_n |- !n. list_count n n = perm_count n
13930 list_count_eq_empty |- !n k. list_count n k = {} <=> n < k
13931 list_count_by_image |- !n k. 0 < k ==>
13932 list_count n k =
13933 IMAGE (\ls. if ALL_DISTINCT ls then ls else [])
13934 (necklace k n) DELETE []
13935! list_count_eqn |- !n k. list_count n k =
13936 if k = 0 then {[]}
13937 else IMAGE (\ls. if ALL_DISTINCT ls then ls else [])
13938 (necklace k n) DELETE []
13939 feq_set_equiv |- !s. feq set equiv_on s
13940 list_count_set_eq_class
13941 |- !ls n k. ls IN list_count n k ==>
13942 equiv_class (feq set) (list_count n k) ls = perm_set (set ls)
13943 list_count_set_eq_class_card
13944 |- !ls n k. ls IN list_count n k ==>
13945 CARD (equiv_class (feq set) (list_count n k) ls) = perm k
13946 list_count_set_partititon_element_card
13947 |- !n k e. e IN partition (feq set) (list_count n k) ==> CARD e = perm k
13948 list_count_element_perm_set_not_empty
13949 |- !ls n k. ls IN list_count n k ==> perm_set (set ls) <> {}
13950 list_count_set_map_element
13951 |- !s n k. s IN partition (feq set) (list_count n k) ==>
13952 (set o CHOICE) s IN sub_count n k
13953 list_count_set_map_inj
13954 |- !n k. INJ (set o CHOICE)
13955 (partition (feq set) (list_count n k))
13956 (sub_count n k)
13957 list_count_set_map_surj
13958 |- !n k. SURJ (set o CHOICE)
13959 (partition (feq set) (list_count n k))
13960 (sub_count n k)
13961 list_count_set_map_bij
13962 |- !n k. BIJ (set o CHOICE)
13963 (partition (feq set) (list_count n k))
13964 (sub_count n k)
13965! arrange_eqn |- !n k. n arrange k = (n choose k) * perm k
13966 arrange_alt |- !n k. n arrange k = (n choose k) * FACT k
13967 arrange_formula |- !n k. n arrange k = binomial n k * FACT k
13968 arrange_formula2 |- !n k. k <= n ==> n arrange k = FACT n DIV FACT (n - k)
13969 arrange_n_0 |- !n. n arrange 0 = 1
13970 arrange_0_n |- !n. 0 < n ==> 0 arrange n = 0
13971 arrange_n_n |- !n. n arrange n = perm n
13972 arrange_n_n_alt |- !n. n arrange n = FACT n
13973 arrange_eq_0 |- !n k. n arrange k = 0 <=> n < k
13974*)
13975
13976(* ------------------------------------------------------------------------- *)
13977(* Counting number of combinations. *)
13978(* ------------------------------------------------------------------------- *)
13979
13980(* The strategy:
13981This is to show, ultimately, C(n,k) = binomial n k.
13982
13983Conceptually,
13984C(n,k) = number of ways to choose k elements from a set of n elements.
13985Each choice gives a k-subset.
13986
13987Define C(n,k) = number of k-subsets of an n-set.
13988Prove that C(n,k) = binomial n k:
13989(1) C(0,0) = 1
13990(2) C(0,1) = 0
13991(3) C(SUC n, SUC k) = C(n,k) + C(n,SUC k)
13992show that any such C's is just the binomial function.
13993
13994binomial_alt
13995|- !n k. binomial n 0 = 1 /\ binomial 0 (k + 1) = 0 /\
13996 binomial (n + 1) (k + 1) = binomial n k + binomial n (k + 1)
13997
13998Moreover, bij_eq is an equivalence relation, and partitions the power set
13999of (count n) into equivalence classes of k-subsets for k = 0 to n. Thus
14000
14001SUM (GENLIST (choose n) (SUC n)) = CARD (POW (count n)) = 2 ** n
14002
14003the counterpart of binomial_sum |- !n. SUM (GENLIST (binomial n) (SUC n)) = 2 ** n
14004*)
14005
14006(* Define the set of choices of k-subsets of (count n). *)
14007Definition sub_count_def[nocompute]:
14008 sub_count n k = { (s:num -> bool) | s SUBSET (count n) /\ CARD s = k}
14009End
14010(* use [nocompute] as this is not effective for evalutaion. *)
14011
14012(* Define the number of choices of k-subsets of (count n). *)
14013Definition choose_def[nocompute]:
14014 choose n k = CARD (sub_count n k)
14015End
14016(* use [nocompute] as this is not effective for evalutaion. *)
14017(* make this an infix operator *)
14018val _ = set_fixity "choose" (Infix(NONASSOC, 550)); (* higher than arithmetic op 500. *)
14019(* val choose_def = |- !n k. n choose k = CARD (sub_count n k): thm *)
14020
14021(* Theorem: s IN sub_count n k <=> s SUBSET count n /\ CARD s = k *)
14022(* Proof: by sub_count_def. *)
14023Theorem sub_count_element:
14024 !n k s. s IN sub_count n k <=> s SUBSET count n /\ CARD s = k
14025Proof
14026 simp[sub_count_def]
14027QED
14028
14029(* Theorem: (sub_count n k) SUBSET (POW (count n)) *)
14030(* Proof:
14031 s IN sub_count n k
14032 ==> s SUBSET (count n) by sub_count_def
14033 ==> s IN POW (count n) by POW_DEF
14034 Thus (sub_count n k) SUBSET (POW (count n)) by SUBSET_DEF
14035*)
14036Theorem sub_count_subset:
14037 !n k. (sub_count n k) SUBSET (POW (count n))
14038Proof
14039 simp[sub_count_def, POW_DEF, SUBSET_DEF]
14040QED
14041
14042(* Theorem: FINITE (sub_count n k) *)
14043(* Proof:
14044 Note (sub_count n k) SUBSET (POW (count n)) by sub_count_subset
14045 and FINITE (count n) by FINITE_COUNT
14046 so FINITE (POW (count n)) by FINITE_POW
14047 Thus FINITE (sub_count n k) by SUBSET_FINITE
14048*)
14049Theorem sub_count_finite:
14050 !n k. FINITE (sub_count n k)
14051Proof
14052 metis_tac[sub_count_subset, FINITE_COUNT, FINITE_POW, SUBSET_FINITE]
14053QED
14054
14055(* Theorem: s IN sub_count n k ==> n NOTIN s *)
14056(* Proof:
14057 Note s SUBSET (count n) by sub_count_element
14058 and n NOTIN (count n) by COUNT_NOT_SELF
14059 so n NOTIN s by SUBSET_DEF
14060*)
14061Theorem sub_count_element_no_self:
14062 !n k s. s IN sub_count n k ==> n NOTIN s
14063Proof
14064 metis_tac[sub_count_element, SUBSET_DEF, COUNT_NOT_SELF]
14065QED
14066
14067(* Theorem: s IN sub_count n k ==> FINITE s *)
14068(* Proof:
14069 Note s SUBSET (count n) by sub_count_element
14070 and FINITE (count n) by FINITE_COUNT
14071 so FINITE s by SUBSET_FINITE
14072*)
14073Theorem sub_count_element_finite:
14074 !n k s. s IN sub_count n k ==> FINITE s
14075Proof
14076 metis_tac[sub_count_element, FINITE_COUNT, SUBSET_FINITE]
14077QED
14078
14079(* Theorem: sub_count n 0 = { EMPTY } *)
14080(* Proof:
14081 By EXTENSION, IN_SING, this is to show:
14082 (1) x IN sub_count n 0 ==> x = {}
14083 x IN sub_count n 0
14084 <=> x SUBSET count n /\ CARD x = 0 by sub_count_def
14085 ==> FINITE x /\ CARD x = 0 by SUBSET_FINITE, FINITE_COUNT
14086 ==> x = {} by CARD_EQ_0
14087 (2) {} IN sub_count n 0
14088 {} IN sub_count n 0
14089 <=> {} SUBSET count n /\ CARD {} = 0 by sub_count_def
14090 <=> T /\ CARD {} = 0 by EMPTY_SUBSET
14091 <=> T /\ T by CARD_EMPTY
14092 <=> T
14093*)
14094Theorem sub_count_n_0:
14095 !n. sub_count n 0 = { EMPTY }
14096Proof
14097 rewrite_tac[EXTENSION, EQ_IMP_THM] >>
14098 rw[IN_SING] >| [
14099 fs[sub_count_def] >>
14100 metis_tac[CARD_EQ_0, SUBSET_FINITE, FINITE_COUNT],
14101 rw[sub_count_def]
14102 ]
14103QED
14104
14105(* Theorem: sub_count 0 n = if n = 0 then { EMPTY } else EMPTY *)
14106(* Proof:
14107 If n = 0,
14108 then sub_count 0 n = { EMPTY } by sub_count_n_0
14109 If n <> 0,
14110 s IN sub_count 0 n
14111 <=> s SUBSET count 0 /\ CARD s = n by sub_count_def
14112 <=> s SUBSET {} /\ CARD s = n by COUNT_0
14113 <=> CARD {} = n by SUBSET_EMPTY
14114 <=> 0 = n by CARD_EMPTY
14115 <=> F by n <> 0
14116 Thus sub_count 0 n = {} by MEMBER_NOT_EMPTY
14117*)
14118Theorem sub_count_0_n:
14119 !n. sub_count 0 n = if n = 0 then { EMPTY } else EMPTY
14120Proof
14121 rw[sub_count_n_0] >>
14122 rw[sub_count_def, EXTENSION] >>
14123 spose_not_then strip_assume_tac >>
14124 `x = {}` by metis_tac[MEMBER_NOT_EMPTY] >>
14125 fs[]
14126QED
14127
14128(* Theorem: sub_count n 1 = {{j} | j < n } *)
14129(* Proof:
14130 By sub_count_def, EXTENSION, this is to show:
14131 x SUBSET count n /\ CARD x = 1 <=>
14132 ?j. (!x'. x' IN x <=> x' = j) /\ j < n
14133 If part:
14134 Note FINITE x by SUBSET_FINITE, FINITE_COUNT
14135 so ?j. x = {j} by CARD_EQ_1, SING_DEF
14136 Take this j.
14137 Then !x'. x' IN x <=> x' = j
14138 by IN_SING
14139 and x SUBSET (count n) ==> j < n
14140 by SUBSET_DEF, IN_COUNT
14141 Only-if part:
14142 Note j IN x, so x <> {} by MEMBER_NOT_EMPTY
14143 The given shows x = {j} by ONE_ELEMENT_SING
14144 and j < n ==> x SUBSET (count n)
14145 by SUBSET_DEF, IN_COUNT
14146 and CARD x = 1 by CARD_SING
14147*)
14148Theorem sub_count_n_1:
14149 !n. sub_count n 1 = {{j} | j < n }
14150Proof
14151 rw[sub_count_def, EXTENSION] >>
14152 rw[EQ_IMP_THM] >| [
14153 `FINITE x` by metis_tac[SUBSET_FINITE, FINITE_COUNT] >>
14154 `?j. x = {j}` by metis_tac[CARD_EQ_1, SING_DEF] >>
14155 metis_tac[SUBSET_DEF, IN_SING, IN_COUNT],
14156 rw[SUBSET_DEF],
14157 metis_tac[ONE_ELEMENT_SING, MEMBER_NOT_EMPTY, CARD_SING]
14158 ]
14159QED
14160
14161(* Theorem: sub_count n n = {count n} *)
14162(* Proof:
14163 s IN sub_count n n
14164 <=> s SUBSET count n /\ CARD s = n by sub_count_def
14165 <=> s SUBSET count n /\ CARD s = CARD (count n)
14166 by CARD_COUNT
14167 <=> s SUBSET count n /\ s = count n by SUBSET_CARD_EQ
14168 <=> T /\ s = count n by SUBSET_REFL
14169 Thus sub_count n n = {count n} by EXTENSION
14170*)
14171Theorem sub_count_n_n:
14172 !n. sub_count n n = {count n}
14173Proof
14174 rw_tac bool_ss[EXTENSION] >>
14175 `FINITE (count n) /\ CARD (count n) = n` by rw[] >>
14176 metis_tac[sub_count_element, SUBSET_CARD_EQ, SUBSET_REFL, IN_SING]
14177QED
14178
14179(* Theorem: sub_count n k = EMPTY <=> n < k *)
14180(* Proof:
14181 If part: sub_count n k = {} ==> n < k
14182 By contradiction, suppose k <= n.
14183 Then (count k) SUBSET (count n) by COUNT_SUBSET, k <= n
14184 and CARD (count k) = k by CARD_COUNT
14185 so (count k) IN sub_count n k by sub_count_element
14186 Thus sub_count n k <> {} by MEMBER_NOT_EMPTY
14187 which is a contradiction.
14188 Only-if part: n < k ==> sub_count n k = {}
14189 By contradiction, suppose sub_count n k <> {}.
14190 Then ?s. s IN sub_count n k by MEMBER_NOT_EMPTY
14191 ==> s SUBSET count n /\ CARD s = k
14192 by sub_count_element
14193 Note FINITE (count n) by FINITE_COUNT
14194 so CARD s <= CARD (count n) by CARD_SUBSET
14195 ==> k <= n by CARD_COUNT
14196 This contradicts n < k.
14197*)
14198Theorem sub_count_eq_empty:
14199 !n k. sub_count n k = EMPTY <=> n < k
14200Proof
14201 rw[EQ_IMP_THM] >| [
14202 spose_not_then strip_assume_tac >>
14203 `(count k) SUBSET (count n)` by rw[COUNT_SUBSET] >>
14204 `CARD (count k) = k` by rw[] >>
14205 metis_tac[sub_count_element, MEMBER_NOT_EMPTY],
14206 spose_not_then strip_assume_tac >>
14207 `?s. s IN sub_count n k` by rw[MEMBER_NOT_EMPTY] >>
14208 fs[sub_count_element] >>
14209 `FINITE (count n)` by rw[] >>
14210 `CARD s <= n` by metis_tac[CARD_SUBSET, CARD_COUNT] >>
14211 decide_tac
14212 ]
14213QED
14214
14215(* Theorem: sub_count (n + 1) (k + 1) =
14216 IMAGE (\s. n INSERT s) (sub_count n k) UNION sub_count n (k + 1) *)
14217(* Proof:
14218 By sub_count_def, EXTENSION, this is to show:
14219 (1) x SUBSET count (n + 1) /\ CARD x = k + 1 ==>
14220 ?s. (!y. y IN x <=> y = n \/ y IN s) /\
14221 s SUBSET count n /\ CARD s = k) \/ x SUBSET count n
14222 Suppose ~(x SUBSET count n),
14223 Then n IN x by SUBSET_DEF
14224 Take s = x DELETE n.
14225 Then y IN x <=>
14226 y = n \/ y IN s by EXTENSION
14227 and s SUBSET x by DELETE_SUBSET
14228 so s SUBSET (count (n + 1) DELETE n)
14229 by SUBSET_DELETE_BOTH
14230 or s SUBSET (count n) by count_def
14231 Note FINITE x by SUBSET_FINITE, FINITE_COUNT
14232 so CARD s = k by CARD_DELETE, CARD_COUNT
14233 (2) s SUBSET count n /\ x = n INSERT s ==> x SUBSET count (n + 1)
14234 Note x SUBSET (n INSERT count n) by SUBSET_INSERT_BOTH
14235 so x INSERT count (n + 1) by count_def, or count_add1
14236 (3) s SUBSET count n /\ x = n INSERT s ==> CARD x = CARD s + 1
14237 Note n NOTIN s by SUBSET_DEF, COUNT_NOT_SELF
14238 and FINITE s by SUBSET_FINITE, FINITE_COUNT
14239 so CARD x
14240 = SUC (CARD s) by CARD_INSERT
14241 = CARD s + 1 by ADD1
14242 (4) x SUBSET count n ==> x SUBSET count (n + 1)
14243 Note (count n) SUBSET count (n + 1) by COUNT_SUBSET, n <= n + 1
14244 so x SUBSET count (n + 1) by SUBSET_TRANS
14245*)
14246Theorem sub_count_union:
14247 !n k. sub_count (n + 1) (k + 1) =
14248 IMAGE (\s. n INSERT s) (sub_count n k) UNION sub_count n (k + 1)
14249Proof
14250 rw[sub_count_def, EXTENSION, Once EQ_IMP_THM] >> simp[] >| [
14251 rename [‘x SUBSET count (n + 1)’, ‘CARD x = k + 1’] >>
14252 Cases_on `x SUBSET count n` >> simp[] >>
14253 `n IN x` by
14254 (fs[SUBSET_DEF] >> rename [‘m IN x’, ‘~(m < n)’] >>
14255 `m < n + 1` by simp[] >>
14256 `m = n` by decide_tac >>
14257 fs[]) >>
14258 qexists_tac `x DELETE n` >>
14259 `FINITE x` by metis_tac[SUBSET_FINITE, FINITE_COUNT] >>
14260 rw[] >- (rw[EQ_IMP_THM] >> simp[]) >>
14261 `x DELETE n SUBSET (count (n + 1)) DELETE n` by rw[SUBSET_DELETE_BOTH] >>
14262 `count (n + 1) DELETE n = count n` by rw[EXTENSION] >>
14263 fs[],
14264
14265 rename [‘s SUBSET count n’, ‘x SUBSET count (n + 1)’] >>
14266 `x = n INSERT s` by fs[EXTENSION] >>
14267 `x SUBSET (n INSERT count n)` by rw[SUBSET_INSERT_BOTH] >>
14268 rfs[count_add1],
14269
14270 rename [‘s SUBSET count n’, ‘CARD x = CARD s + 1’] >>
14271 `x = n INSERT s` by fs[EXTENSION] >>
14272 `n NOTIN s` by metis_tac[SUBSET_DEF, COUNT_NOT_SELF] >>
14273 `FINITE s` by metis_tac[SUBSET_FINITE, FINITE_COUNT] >>
14274 rw[],
14275
14276 metis_tac[COUNT_SUBSET, SUBSET_TRANS, DECIDE “n <= n + 1”]
14277 ]
14278QED
14279
14280(* Theorem: DISJOINT (IMAGE (\s. n INSERT s) (sub_count n k)) (sub_count n (k + 1)) *)
14281(* Proof:
14282 Let s = IMAGE (\s. n INSERT s) (sub_count n k),
14283 t = sub_count n (k + 1).
14284 By DISJOINT_DEF and contradiction, suppose s INTER t <> {}.
14285 Then ?x. x IN s /\ x IN t by IN_INTER, MEMBER_NOT_EMPTY
14286 Note n IN x by IN_IMAGE, IN_INSERT
14287 but n NOTIN x by sub_count_element_no_self
14288 This is a contradiction.
14289*)
14290Theorem sub_count_disjoint:
14291 !n k. DISJOINT (IMAGE (\s. n INSERT s) (sub_count n k)) (sub_count n (k + 1))
14292Proof
14293 rw[DISJOINT_DEF, EXTENSION] >>
14294 spose_not_then strip_assume_tac >>
14295 rename [‘s IN sub_count n k’, ‘x IN sub_count n (k + 1)’] >>
14296 `x = n INSERT s` by fs[EXTENSION] >>
14297 `n IN x` by fs[] >>
14298 metis_tac[sub_count_element_no_self]
14299QED
14300
14301(* Theorem: s IN sub_count n k ==> (n INSERT s) IN sub_count (n + 1) (k + 1) *)
14302(* Proof:
14303 Note s SUBSET count n /\ CARD s = k by sub_count_element
14304 and n NOTIN s by sub_count_element_no_self
14305 and FINITE s by sub_count_element_finite
14306 Now (n INSERT s) SUBSET (n INSERT count n)
14307 by SUBSET_INSERT_BOTH
14308 and n INSERT count n = count (n + 1) by count_add1
14309 and CARD (n INSERT s) = CARD s + 1 by CARD_INSERT
14310 = k + 1 by given
14311 Thus (n INSERT s) IN sub_count (n + 1) (k + 1)
14312 by sub_count_element
14313*)
14314Theorem sub_count_insert:
14315 !n k s. s IN sub_count n k ==> (n INSERT s) IN sub_count (n + 1) (k + 1)
14316Proof
14317 rw[sub_count_def] >| [
14318 `!x. x < n ==> x < n + 1` by decide_tac >>
14319 metis_tac[SUBSET_DEF, IN_COUNT],
14320 `n NOTIN s` by metis_tac[SUBSET_DEF, COUNT_NOT_SELF] >>
14321 `FINITE s` by metis_tac[SUBSET_FINITE, FINITE_COUNT] >>
14322 rw[]
14323 ]
14324QED
14325
14326(* Theorem: CARD (IMAGE (\s. n INSERT s) (sub_count n k)) = n choose k *)
14327(* Proof:
14328 Let f = \s. n INSERT s.
14329 By choose_def, INJ_CARD_IMAGE, this is to show:
14330 (1) FINITE (sub_count n k), true by sub_count_finite
14331 (2) ?t. INJ f (sub_count n k) t
14332 Let t = sub_count (n + 1) (k + 1).
14333 By INJ_DEF, this is to show:
14334 (1) s IN sub_count n k ==> n INSERT s IN sub_count (n + 1) (k + 1)
14335 This is true by sub_count_insert
14336 (2) s' IN sub_count n k /\ s IN sub_count n k /\
14337 n INSERT s' = n INSERT s ==> s' = s
14338 Note n NOTIN s by sub_count_element_no_self
14339 and n NOTIN s' by sub_count_element_no_self
14340 s'
14341 = s' DELETE n by DELETE_NON_ELEMENT
14342 = (n INSERT s') DELETE n by DELETE_INSERT
14343 = (n INSERT s) DELETE n by given
14344 = s DELETE n by DELETE_INSERT
14345 = s by DELETE_NON_ELEMENT
14346*)
14347Theorem sub_count_insert_card:
14348 !n k. CARD (IMAGE (\s. n INSERT s) (sub_count n k)) = n choose k
14349Proof
14350 rw[choose_def] >>
14351 qabbrev_tac `f = \s. n INSERT s` >>
14352 irule INJ_CARD_IMAGE >>
14353 rpt strip_tac >-
14354 rw[sub_count_finite] >>
14355 qexists_tac `sub_count (n + 1) (k + 1)` >>
14356 rw[INJ_DEF, Abbr`f`] >-
14357 rw[sub_count_insert] >>
14358 rename [‘n INSERT s1 = n INSERT s2’] >>
14359 `n NOTIN s1 /\ n NOTIN s2` by metis_tac[sub_count_element_no_self] >>
14360 metis_tac[DELETE_INSERT, DELETE_NON_ELEMENT]
14361QED
14362
14363(* Theorem: sub_count n 0 = { EMPTY } /\
14364 sub_count 0 (k + 1) = {} /\
14365 sub_count (n + 1) (k + 1) =
14366 IMAGE (\s. n INSERT s) (sub_count n k) UNION sub_count n (k + 1) *)
14367(* Proof: by sub_count_n_0, sub_count_0_n, sub_count_union. *)
14368Theorem sub_count_alt:
14369 !n k. sub_count n 0 = { EMPTY } /\
14370 sub_count 0 (k + 1) = {} /\
14371 sub_count (n + 1) (k + 1) =
14372 IMAGE (\s. n INSERT s) (sub_count n k) UNION sub_count n (k + 1)
14373Proof
14374 simp[sub_count_n_0, sub_count_0_n, sub_count_union]
14375QED
14376
14377(* Theorem: sub_count n k =
14378 if k = 0 then { EMPTY }
14379 else if n = 0 then {}
14380 else IMAGE (\s. (n - 1) INSERT s) (sub_count (n - 1) (k - 1)) UNION
14381 sub_count (n - 1) k *)
14382(* Proof: by sub_count_n_0, sub_count_0_n, sub_count_union. *)
14383Theorem sub_count_eqn[compute]:
14384 !n k. sub_count n k =
14385 if k = 0 then { EMPTY }
14386 else if n = 0 then {}
14387 else IMAGE (\s. (n - 1) INSERT s) (sub_count (n - 1) (k - 1)) UNION
14388 sub_count (n - 1) k
14389Proof
14390 rw[sub_count_n_0, sub_count_0_n] >>
14391 metis_tac[sub_count_union, num_CASES, SUC_SUB1, ADD1]
14392QED
14393
14394(*
14395> EVAL ``sub_count 3 2``;
14396val it = |- sub_count 3 2 = {{2; 1}; {2; 0}; {1; 0}}: thm
14397> EVAL ``sub_count 4 2``;
14398val it = |- sub_count 4 2 = {{3; 2}; {3; 1}; {3; 0}; {2; 1}; {2; 0}; {1; 0}}: thm
14399> EVAL ``sub_count 3 3``;
14400val it = |- sub_count 3 3 = {{2; 1; 0}}: thm
14401*)
14402
14403(* Theorem: n choose 0 = 1 *)
14404(* Proof:
14405 n choose 0
14406 = CARD (sub_count n 0) by choose_def
14407 = CARD {{}} by sub_count_n_0
14408 = 1 by CARD_SING
14409*)
14410Theorem choose_n_0:
14411 !n. n choose 0 = 1
14412Proof
14413 simp[choose_def, sub_count_n_0]
14414QED
14415
14416(* Theorem: n choose 1 = n *)
14417(* Proof:
14418 Let s = {{j} | j < n},
14419 f = \j. {j}.
14420 Then s = IMAGE f (count n) by EXTENSION
14421 Note FINITE (count n)
14422 and INJ f (count n) (POW (count n))
14423 Thus n choose 1
14424 = CARD (sub_count n 1) by choose_def
14425 = CARD s by sub_count_n_1
14426 = CARD (count n) by INJ_CARD_IMAGE
14427 = n by CARD_COUNT
14428*)
14429Theorem choose_n_1:
14430 !n. n choose 1 = n
14431Proof
14432 rw[choose_def, sub_count_n_1] >>
14433 qabbrev_tac `s = {{j} | j < n}` >>
14434 qabbrev_tac `f = \j:num. {j}` >>
14435 `s = IMAGE f (count n)` by fs[EXTENSION, Abbr`f`, Abbr`s`] >>
14436 `CARD (IMAGE f (count n)) = CARD (count n)` suffices_by fs[] >>
14437 irule INJ_CARD_IMAGE >>
14438 rw[] >>
14439 qexists_tac `POW (count n)` >>
14440 rw[INJ_DEF, Abbr`f`] >>
14441 rw[POW_DEF]
14442QED
14443
14444(* Theorem: n choose k = 0 <=> n < k *)
14445(* Proof:
14446 Note FINITE (sub_count n k) by sub_count_finite
14447 n choose k = 0
14448 <=> CARD (sub_count n k) = 0 by choose_def
14449 <=> sub_count n k = {} by CARD_EQ_0
14450 <=> n < k by sub_count_eq_empty
14451*)
14452Theorem choose_eq_0:
14453 !n k. n choose k = 0 <=> n < k
14454Proof
14455 metis_tac[choose_def, sub_count_eq_empty, sub_count_finite, CARD_EQ_0]
14456QED
14457
14458(* Theorem: 0 choose n = if n = 0 then 1 else 0 *)
14459(* Proof:
14460 0 choose n
14461 = CARD (sub_count 0 n) by choose_def
14462 = CARD (if n = 0 then {{}} else {})
14463 by sub_count_0_n
14464 = if n = 0 then 1 else 0 by CARD_SING, CARD_EMPTY
14465*)
14466Theorem choose_0_n:
14467 !n. 0 choose n = if n = 0 then 1 else 0
14468Proof
14469 rw[choose_def, sub_count_0_n]
14470QED
14471
14472(* Theorem: 1 choose n = if 1 < n then 0 else 1 *)
14473(* Proof:
14474 If n = 0, 1 choose 0 = 1 by choose_n_0
14475 If n = 1, 1 choose 1 = 1 by choose_n_1
14476 Otherwise, 1 choose n = 0 by choose_eq_0, 1 < n
14477*)
14478Theorem choose_1_n:
14479 !n. 1 choose n = if 1 < n then 0 else 1
14480Proof
14481 rw[choose_eq_0] >>
14482 `n = 0 \/ n = 1` by decide_tac >-
14483 simp[choose_n_0] >>
14484 simp[choose_n_1]
14485QED
14486
14487(* Theorem: n choose n = 1 *)
14488(* Proof:
14489 n choose n
14490 = CARD (sub_count n n) by choose_def
14491 = CARD {count n} by sub_count_n_n
14492 = 1 by CARD_SING
14493*)
14494Theorem choose_n_n:
14495 !n. n choose n = 1
14496Proof
14497 simp[choose_def, sub_count_n_n]
14498QED
14499
14500(* Theorem: (n + 1) choose (k + 1) = n choose k + n choose (k + 1) *)
14501(* Proof:
14502 Let s = sub_count (n + 1) (k + 1),
14503 u = sub_count n k,
14504 v = sub_count n (k + 1),
14505 t = IMAGE (\s. n INSERT s) u.
14506 Then s = t UNION v by sub_count_union
14507 and DISJOINT t v by sub_count_disjoint
14508 and FINITE u /\ FINITE v by sub_count_finite
14509 and FINITE t by IMAGE_FINITE
14510 Thus CARD s = CARD t + CARD v by CARD_UNION_DISJOINT
14511 = CARD u + CARD v by sub_count_insert_card, choose_def
14512*)
14513Theorem choose_recurrence:
14514 !n k. (n + 1) choose (k + 1) = n choose k + n choose (k + 1)
14515Proof
14516 rw[choose_def] >>
14517 qabbrev_tac `s = sub_count (n + 1) (k + 1)` >>
14518 qabbrev_tac `u = sub_count n k` >>
14519 qabbrev_tac `v = sub_count n (k + 1)` >>
14520 qabbrev_tac `t = IMAGE (\s. n INSERT s) u` >>
14521 `s = t UNION v` by rw[sub_count_union, Abbr`s`, Abbr`t`, Abbr`v`] >>
14522 `DISJOINT t v` by metis_tac[sub_count_disjoint] >>
14523 `FINITE u /\ FINITE v` by rw[sub_count_finite, Abbr`u`, Abbr`v`] >>
14524 `FINITE t` by rw[Abbr`t`] >>
14525 `CARD s = CARD t + CARD v` by rw[CARD_UNION_DISJOINT] >>
14526 metis_tac[sub_count_insert_card, choose_def]
14527QED
14528
14529(* This is Pascal's identity: C(n+1,k+1) = C(n,k) + C(n,k+1). *)
14530(* This corresponds to the 'sum of parents' rule of Pascal's triangle. *)
14531
14532(* Theorem: n choose 0 = 1 /\ 0 choose (k + 1) = 0 /\
14533 (n + 1) choose (k + 1) = n choose k + n choose (k + 1) *)
14534(* Proof: by choose_n_0, choose_0_n, choose_recurrence. *)
14535Theorem choose_alt:
14536 !n k. n choose 0 = 1 /\ 0 choose (k + 1) = 0 /\
14537 (n + 1) choose (k + 1) = n choose k + n choose (k + 1)
14538Proof
14539 simp[choose_n_0, choose_0_n, choose_recurrence]
14540QED
14541
14542(* Theorem: n choose k = binomial n k *)
14543(* Proof: by binomial_iff, choose_alt. *)
14544Theorem choose_eqn[compute]:
14545 !n k. n choose k = binomial n k
14546Proof
14547 prove_tac[binomial_iff, choose_alt]
14548QED
14549
14550(*
14551> EVAL ``5 choose 3``;
14552val it = |- 5 choose 3 = 10: thm
14553> EVAL ``MAP ($choose 5) [0 .. 5]``;
14554val it = |- MAP ($choose 5) [0 .. 5] = [1; 5; 10; 10; 5; 1]: thm
14555*)
14556
14557(* ------------------------------------------------------------------------- *)
14558(* Partition of the set of subsets by bijective equivalence. *)
14559(* ------------------------------------------------------------------------- *)
14560
14561(* Define the set of k-subsets of a set. *)
14562Definition sub_sets_def[nocompute]:
14563 sub_sets P k = { s | s SUBSET P /\ CARD s = k}
14564End
14565(* use [nocompute] as this is not effective for evalutaion. *)
14566
14567(* Theorem: s IN sub_sets P k <=> s SUBSET P /\ CARD s = k *)
14568(* Proof: by sub_sets_def. *)
14569Theorem sub_sets_element:
14570 !P k s. s IN sub_sets P k <=> s SUBSET P /\ CARD s = k
14571Proof
14572 simp[sub_sets_def]
14573QED
14574
14575(* Theorem: sub_sets (count n) k = sub_count n k *)
14576(* Proof:
14577 sub_sets (count n) k
14578 = {s | s SUBSET (count n) /\ CARD s = k} by sub_sets_def
14579 = sub_count n k by sub_count_def
14580*)
14581Theorem sub_sets_sub_count:
14582 !n k. sub_sets (count n) k = sub_count n k
14583Proof
14584 simp[sub_sets_def, sub_count_def]
14585QED
14586
14587(* Theorem: FINITE t /\ s SUBSET t ==>
14588 sub_sets t (CARD s) = equiv_class $=b= (POW t) s *)
14589(* Proof:
14590 x IN sub_sets t (CARD s)
14591 <=> x SUBSET t /\ CARD s = CARD x by sub_sets_element
14592 <=> x SUBSET t /\ s =b= x by bij_eq_card_eq, SUBSET_FINITE
14593 <=> x IN POW t /\ s =b= x by IN_POW
14594 <=> x IN equiv_class $=b= (POW t) s by equiv_class_element
14595*)
14596Theorem sub_sets_equiv_class:
14597 !s t. FINITE t /\ s SUBSET t ==>
14598 sub_sets t (CARD s) = equiv_class $=b= (POW t) s
14599Proof
14600 rw[sub_sets_def, IN_POW, EXTENSION] >>
14601 metis_tac[bij_eq_card_eq, SUBSET_FINITE]
14602QED
14603
14604(* Theorem: s SUBSET (count n) ==>
14605 sub_count n (CARD s) = equiv_class $=b= (POW (count n)) s *)
14606(* Proof:
14607 Note FINITE (count n) by FINITE_COUNT
14608 sub_count n (CARD s)
14609 = sub_sets (count n) (CARD s) by sub_sets_sub_count
14610 = equiv_class $=b= (POW t) s by sub_sets_equiv_class
14611*)
14612Theorem sub_count_equiv_class:
14613 !n s. s SUBSET (count n) ==>
14614 sub_count n (CARD s) = equiv_class $=b= (POW (count n)) s
14615Proof
14616 simp[sub_sets_equiv_class, GSYM sub_sets_sub_count]
14617QED
14618
14619(* Theorem: partition $=b= (POW (count n)) = IMAGE (sub_count n) (upto n) *)
14620(* Proof:
14621 Let R = $=b=, t = count n.
14622 Note CARD t = n by CARD_COUNT
14623 By EXTENSION and LESS_EQ_IFF_LESS_SUC, this is to show:
14624 (1) x IN partition R (POW t) ==> ?k. x = sub_count n k /\ k <= n
14625 Note ?s. s IN POW t /\
14626 x = equiv_class R (POW t) s by partition_element
14627 Note FINITE t by SUBSET_FINITE
14628 and s SUBSET t by IN_POW
14629 so CARD s <= CARD t = n by CARD_SUBSET
14630 Take k = CARD s.
14631 Then k <= n /\ x = sub_count n k by sub_count_equiv_class
14632 (2) k <= n ==> sub_count n k IN partition R (POW t)
14633 Let s = count k
14634 Then CARD s = k by CARD_COUNT
14635 and s SUBSET t by COUNT_SUBSET, k <= n
14636 so s IN POW t by IN_POW
14637 Now sub_count n k
14638 = equiv_class R (POW t) s by sub_count_equiv_class
14639 ==> sub_count n k IN partition R (POW t)
14640 by partition_element
14641*)
14642Theorem count_power_partition:
14643 !n. partition $=b= (POW (count n)) = IMAGE (sub_count n) (upto n)
14644Proof
14645 rpt strip_tac >>
14646 qabbrev_tac `R = \(s:num -> bool) (t:num -> bool). s =b= t` >>
14647 qabbrev_tac `t = count n` >>
14648 rw[Once EXTENSION, partition_element, GSYM LESS_EQ_IFF_LESS_SUC, EQ_IMP_THM] >| [
14649 `FINITE t` by rw[Abbr`t`] >>
14650 `x' SUBSET t` by fs[IN_POW] >>
14651 `CARD x' <= n` by metis_tac[CARD_SUBSET, CARD_COUNT] >>
14652 qexists_tac `CARD x'` >>
14653 simp[sub_count_equiv_class, Abbr`R`, Abbr`t`],
14654 qexists_tac `count x'` >>
14655 `(count x') SUBSET t /\ (count x') IN POW t` by metis_tac[COUNT_SUBSET, IN_POW] >>
14656 simp[] >>
14657 qabbrev_tac `s = count x'` >>
14658 `sub_count n (CARD s) = equiv_class R (POW t) s` suffices_by simp[Abbr`s`] >>
14659 simp[sub_count_equiv_class, Abbr`R`, Abbr`t`]
14660 ]
14661QED
14662
14663(* Theorem: INJ (sub_count n) (upto n) univ(:(num -> bool) -> bool) *)
14664(* Proof:
14665 By INJ_DEF, this is to show:
14666 !x y. x < SUC n /\ y < SUC n /\ sub_count n x = sub_count n y ==> x = y
14667 Let s = count x.
14668 Note x < SUC n <=> x <= n by arithmetic
14669 ==> s SUBSET (count n) by COUNT_SUBSET, x <= n
14670 and CARD s = x by CARD_COUNT
14671 so s IN sub_count n x by sub_count_element
14672 Thus s IN sub_count n y by given, sub_count n x = sub_count n y
14673 ==> CARD s = x = y
14674*)
14675Theorem sub_count_count_inj:
14676 !n m. INJ (sub_count n) (upto n) univ(:(num -> bool) -> bool)
14677Proof
14678 rw[sub_count_def, EXTENSION, INJ_DEF] >>
14679 `(count x) SUBSET (count n)` by rw[COUNT_SUBSET] >>
14680 metis_tac[CARD_COUNT]
14681QED
14682
14683(* Idea: the sum of sizes of equivalence classes gives size of power set. *)
14684
14685(* Theorem: SIGMA ($choose n) (upto n) = 2 ** n *)
14686(* Proof:
14687 Let R = $=b=, t = count n.
14688 Then R equiv_on (POW t) by bij_eq_equiv_on
14689 and FINITE t by FINITE_COUNT
14690 so FINITE (POW t) by FINITE_POW
14691 Thus CARD (POW t) = SIGMA CARD (partition R (POW t))
14692 by partition_CARD
14693 LHS = CARD (POW t)
14694 = 2 ** CARD t by CARD_POW
14695 = 2 ** n by CARD_COUNT
14696 Note INJ (sub_count n) (upto n) univ by sub_count_count_inj
14697 RHS = SIGMA CARD (partition R (POW t))
14698 = SIGMA CARD (IMAGE (sub_count n) (upto n)) by count_power_partition
14699 = SIGMA (CARD o sub_count n) (upto n) by SUM_IMAGE_INJ_o
14700 = SIGMA ($choose n) (upto n) by FUN_EQ_THM, choose_def
14701*)
14702Theorem choose_sum_over_count:
14703 !n. SIGMA ($choose n) (upto n) = 2 ** n
14704Proof
14705 rpt strip_tac >>
14706 qabbrev_tac `R = \(s:num -> bool) (t:num -> bool). s =b= t` >>
14707 qabbrev_tac `t = count n` >>
14708 `R equiv_on (POW t)` by rw[bij_eq_equiv_on, Abbr`R`] >>
14709 `FINITE (POW t)` by rw[FINITE_POW, Abbr`t`] >>
14710 imp_res_tac partition_CARD >>
14711 `FINITE (upto n)` by rw[] >>
14712 `SIGMA CARD (partition R (POW t)) = SIGMA CARD (IMAGE (sub_count n) (upto n))` by fs[count_power_partition, Abbr`R`, Abbr`t`] >>
14713 `_ = SIGMA (CARD o (sub_count n)) (upto n)` by rw[SUM_IMAGE_INJ_o, sub_count_count_inj] >>
14714 `_ = SIGMA ($choose n) (upto n)` by rw[choose_def, FUN_EQ_THM, SIGMA_CONG] >>
14715 fs[CARD_POW, Abbr`t`]
14716QED
14717
14718(* This corresponds to:
14719> binomial_sum;
14720val it = |- !n. SUM (GENLIST (binomial n) (SUC n)) = 2 ** n: thm
14721*)
14722
14723(* Theorem: SUM (MAP ($choose n) [0 .. n]) = 2 ** n *)
14724(* Proof:
14725 SUM (MAP ($choose n) [0 .. n])
14726 = SIGMA ($choose n) (upto n) by SUM_IMAGE_upto
14727 = 2 ** n by choose_sum_over_count
14728*)
14729Theorem choose_sum_over_all:
14730 !n. SUM (MAP ($choose n) [0 .. n]) = 2 ** n
14731Proof
14732 simp[GSYM SUM_IMAGE_upto, choose_sum_over_count]
14733QED
14734
14735(* A better representation of:
14736> binomial_sum;
14737val it = |- !n. SUM (GENLIST (binomial n) (SUC n)) = 2 ** n: thm
14738*)
14739
14740(* ------------------------------------------------------------------------- *)
14741(* Counting number of permutations. *)
14742(* ------------------------------------------------------------------------- *)
14743
14744(* Define the set of permutation tuples of (count n). *)
14745Definition perm_count_def[nocompute]:
14746 perm_count n = { ls | ALL_DISTINCT ls /\ set ls = count n}
14747End
14748(* use [nocompute] as this is not effective for evalutaion. *)
14749
14750(* Define the number of choices of k-tuples of (count n). *)
14751Definition perm_def[nocompute]:
14752 perm n = CARD (perm_count n)
14753End
14754(* use [nocompute] as this is not effective for evalutaion. *)
14755
14756(* Theorem: ls IN perm_count n <=> ALL_DISTINCT ls /\ set ls = count n *)
14757(* Proof: by perm_count_def. *)
14758Theorem perm_count_element:
14759 !ls n. ls IN perm_count n <=> ALL_DISTINCT ls /\ set ls = count n
14760Proof
14761 simp[perm_count_def]
14762QED
14763
14764(* Theorem: ls IN perm_count n ==> ~MEM n ls *)
14765(* Proof:
14766 ls IN perm_count n
14767 <=> ALL_DISTINCT ls /\ set ls = count n by perm_count_element
14768 ==> ~MEM n ls by COUNT_NOT_SELF
14769*)
14770Theorem perm_count_element_no_self:
14771 !ls n. ls IN perm_count n ==> ~MEM n ls
14772Proof
14773 simp[perm_count_element]
14774QED
14775
14776(* Theorem: ls IN perm_count n ==> LENGTH ls = n *)
14777(* Proof:
14778 ls IN perm_count n
14779 <=> ALL_DISTINCT ls /\ set ls = count n by perm_count_element
14780 LENGTH ls = CARD (set ls) by ALL_DISTINCT_CARD_LIST_TO_SET
14781 = CARD (count n) by set ls = count n
14782 = n by CARD_COUNT
14783*)
14784Theorem perm_count_element_length:
14785 !ls n. ls IN perm_count n ==> LENGTH ls = n
14786Proof
14787 metis_tac[perm_count_element, ALL_DISTINCT_CARD_LIST_TO_SET, CARD_COUNT]
14788QED
14789
14790(* Theorem: perm_count n SUBSET necklace n n *)
14791(* Proof:
14792 ls IN perm_count n
14793 <=> ALL_DISTINCT ls /\ set ls = count n by perm_count_element
14794 Thus set ls SUBSET (count n) by SUBSET_REFL
14795 and LENGTH ls = n by perm_count_element_length
14796 Therefore ls IN necklace n n by necklace_element
14797*)
14798Theorem perm_count_subset:
14799 !n. perm_count n SUBSET necklace n n
14800Proof
14801 rw[perm_count_def, necklace_def, perm_count_element_length, SUBSET_DEF]
14802QED
14803
14804(* Theorem: FINITE (perm_count n) *)
14805(* Proof:
14806 Note perm_count n SUBSET necklace n n by perm_count_subset
14807 and FINITE (necklace n n) by necklace_finite
14808 Thus FINITE (perm_count n) by SUBSET_FINITE
14809*)
14810Theorem perm_count_finite:
14811 !n. FINITE (perm_count n)
14812Proof
14813 metis_tac[perm_count_subset, necklace_finite, SUBSET_FINITE]
14814QED
14815
14816(* Theorem: perm_count 0 = {[]} *)
14817(* Proof:
14818 ls IN perm_count 0
14819 <=> ALL_DISTINCT ls /\ set ls = count 0 by perm_count_element
14820 <=> ALL_DISTINCT ls /\ set ls = {} by COUNT_0
14821 <=> ALL_DISTINCT ls /\ ls = [] by LIST_TO_SET_EQ_EMPTY
14822 <=> ls = [] by ALL_DISTINCT
14823 Thus perm_count 0 = {[]} by EXTENSION
14824*)
14825Theorem perm_count_0:
14826 perm_count 0 = {[]}
14827Proof
14828 rw[perm_count_def, EXTENSION, EQ_IMP_THM] >>
14829 metis_tac[MEM, list_CASES]
14830QED
14831
14832(* Theorem: perm_count 1 = {[0]} *)
14833(* Proof:
14834 ls IN perm_count 1
14835 <=> ALL_DISTINCT ls /\ set ls = count 1 by perm_count_element
14836 <=> ALL_DISTINCT ls /\ set ls = {0} by COUNT_1
14837 <=> ls = [0] by DISTINCT_LIST_TO_SET_EQ_SING
14838 Thus perm_count 1 = {[0]} by EXTENSION
14839*)
14840Theorem perm_count_1:
14841 perm_count 1 = {[0]}
14842Proof
14843 simp[perm_count_def, COUNT_1, DISTINCT_LIST_TO_SET_EQ_SING]
14844QED
14845
14846(* Define the interleave operation on a list. *)
14847Definition interleave_def:
14848 interleave x ls = IMAGE (\k. TAKE k ls ++ x::DROP k ls) (upto (LENGTH ls))
14849End
14850(* make this an infix operator *)
14851val _ = set_fixity "interleave" (Infix(NONASSOC, 550)); (* higher than arithmetic op 500. *)
14852(* interleave_def;
14853val it = |- !x ls. x interleave ls =
14854 IMAGE (\k. TAKE k ls ++ x::DROP k ls) (upto (LENGTH ls)): thm *)
14855
14856(*
14857> EVAL ``2 interleave [0; 1]``;
14858val it = |- 2 interleave [0; 1] = {[0; 1; 2]; [0; 2; 1]; [2; 0; 1]}: thm
14859*)
14860
14861(* Theorem: x interleave ls = {TAKE k ls ++ x::DROP k ls | k | k <= LENGTH ls} *)
14862(* Proof: by interleave_def, EXTENSION. *)
14863Theorem interleave_alt:
14864 !ls x. x interleave ls = {TAKE k ls ++ x::DROP k ls | k | k <= LENGTH ls}
14865Proof
14866 simp[interleave_def, EXTENSION] >>
14867 metis_tac[LESS_EQ_IFF_LESS_SUC]
14868QED
14869
14870(* Theorem: y IN x interleave ls <=>
14871 ?k. k <= LENGTH ls /\ y = TAKE k ls ++ x::DROP k ls *)
14872(* Proof: by interleave_alt, IN_IMAGE. *)
14873Theorem interleave_element:
14874 !ls x y. y IN x interleave ls <=>
14875 ?k. k <= LENGTH ls /\ y = TAKE k ls ++ x::DROP k ls
14876Proof
14877 simp[interleave_alt] >>
14878 metis_tac[]
14879QED
14880
14881(* Theorem: x interleave [] = {[x]} *)
14882(* Proof:
14883 x interleave []
14884 = IMAGE (\k. TAKE k [] ++ x::DROP k []) (upto (LENGTH []))
14885 by interleave_def
14886 = IMAGE (\k. [] ++ x::[]) (upto 0) by TAKE_nil, DROP_nil, LENGTH
14887 = IMAGE (\k. [x]) (count 1) by APPEND, notation of upto
14888 = IMAGE (\k. [x]) {0} by COUNT_1
14889 = [x] by IMAGE_DEF
14890*)
14891Theorem interleave_nil:
14892 !x. x interleave [] = {[x]}
14893Proof
14894 rw[interleave_def, EXTENSION] >>
14895 metis_tac[DECIDE``0 < 1``]
14896QED
14897
14898(* Theorem: y IN (x interleave ls) ==> LENGTH y = 1 + LENGTH ls *)
14899(* Proof:
14900 LENGTH y
14901 = LENGTH (TAKE k ls ++ x::DROP k ls) by interleave_element, for some k
14902 = LENGTH (TAKE k ls) + LENGTH (x::DROP k ls) by LENGTH_APPEND
14903 = k + LENGTH (x :: DROP k ls) by LENGTH_TAKE, k <= LENGTH ls
14904 = k + (1 + LENGTH (DROP k ls)) by LENGTH
14905 = k + (1 + (LENGTH ls - k)) by LENGTH_DROP
14906 = 1 + LENGTH ls by arithmetic, k <= LENGTH ls
14907*)
14908Theorem interleave_length:
14909 !ls x y. y IN (x interleave ls) ==> LENGTH y = 1 + LENGTH ls
14910Proof
14911 rw_tac bool_ss[interleave_element] >>
14912 simp[]
14913QED
14914
14915(* Theorem: ALL_DISTINCT (x::ls) /\ y IN (x interleave ls) ==> ALL_DISTINCT y *)
14916(* Proof:
14917 By interleave_def, IN_IMAGE, this is to show;
14918 ALL_DISTINCT (TAKE k ls ++ x::DROP k ls)
14919 To apply ALL_DISTINCT_APPEND, need to show:
14920 (1) ~MEM x ls /\ MEM e (TAKE k ls) /\ MEM e (x::DROP k ls) ==> F
14921 MEM e (x::DROP k ls)
14922 <=> e = x \/ MEM e (DROP k ls) by MEM
14923 MEM e (TAKE k ls)
14924 ==> MEM e ls by MEM_TAKE
14925 If e = x,
14926 this contradicts ~MEM x ls.
14927 If MEM e (DROP k ls),
14928 with MEM e (TAKE k ls)
14929 and ALL_DISTINCT ls gives F by ALL_DISTINCT_TAKE_DROP
14930 (2) ALL_DISTINCT (TAKE k ls), true by ALL_DISTINCT_TAKE
14931 (3) ~MEM x ls ==> ALL_DISTINCT (x::DROP k ls)
14932 ALL_DISTINCT (x::DROP k ls)
14933 <=> ~MEM x (DROP k ls) /\
14934 ALL_DISTINCT (DROP k ls) by ALL_DISTINCT
14935 <=> ~MEM x (DROP k ls) /\ T by ALL_DISTINCT_DROP
14936 ==> ~MEM x ls /\ T by MEM_DROP_IMP
14937 ==> T /\ T = T
14938*)
14939Theorem interleave_distinct:
14940 !ls x y. ALL_DISTINCT (x::ls) /\ y IN (x interleave ls) ==> ALL_DISTINCT y
14941Proof
14942 rw_tac bool_ss[interleave_def, IN_IMAGE] >>
14943 irule (ALL_DISTINCT_APPEND |> SPEC_ALL |> #2 o EQ_IMP_RULE) >>
14944 rpt strip_tac >| [
14945 fs[] >-
14946 metis_tac[MEM_TAKE] >>
14947 metis_tac[ALL_DISTINCT_TAKE_DROP],
14948 fs[ALL_DISTINCT_TAKE],
14949 fs[ALL_DISTINCT_DROP] >>
14950 metis_tac[MEM_DROP_IMP]
14951 ]
14952QED
14953
14954(* Theorem: ALL_DISTINCT ls /\ ~(MEM x ls) /\
14955 y IN (x interleave ls) ==> ALL_DISTINCT y *)
14956(* Proof: by interleave_distinct, ALL_DISTINCT. *)
14957Theorem interleave_distinct_alt:
14958 !ls x y. ALL_DISTINCT ls /\ ~(MEM x ls) /\
14959 y IN (x interleave ls) ==> ALL_DISTINCT y
14960Proof
14961 metis_tac[interleave_distinct, ALL_DISTINCT]
14962QED
14963
14964(* Theorem: y IN x interleave ls ==> set y = set (x::ls) *)
14965(* Proof:
14966 Note y = TAKE k ls ++ x::DROP k ls by interleave_element, for some k
14967 Let u = TAKE k ls, v = DROP k ls.
14968 set y
14969 = set (u ++ x::v) by above
14970 = set u UNION set (x::v) by LIST_TO_SET_APPEND
14971 = set u UNION (x INSERT set v) by LIST_TO_SET
14972 = (x INSERT set v) UNION set u by UNION_COMM
14973 = x INSERT (set v UNION set u) by INSERT_UNION_EQ
14974 = x INSERT (set u UNION set v) by UNION_COMM
14975 = x INSERT (set (u ++ v)) by LIST_TO_SET_APPEND
14976 = x INSERT set ls by TAKE_DROP
14977 = set (x::ls) by LIST_TO_SET
14978*)
14979Theorem interleave_set:
14980 !ls x y. y IN x interleave ls ==> set y = set (x::ls)
14981Proof
14982 rw_tac bool_ss[interleave_element] >>
14983 qabbrev_tac `u = TAKE k ls` >>
14984 qabbrev_tac `v = DROP k ls` >>
14985 `set (u ++ x::v) = set u UNION set (x::v)` by rw[] >>
14986 `_ = set u UNION (x INSERT set v)` by rw[] >>
14987 `_ = (x INSERT set v) UNION set u` by rw[UNION_COMM] >>
14988 `_ = x INSERT (set v UNION set u)` by rw[INSERT_UNION_EQ] >>
14989 `_ = x INSERT (set u UNION set v)` by rw[UNION_COMM] >>
14990 `_ = x INSERT (set (u ++ v))` by rw[] >>
14991 `_ = x INSERT set ls` by metis_tac[TAKE_DROP] >>
14992 simp[]
14993QED
14994
14995(* Theorem: y IN x interleave ls ==> set y = x INSERT set ls *)
14996(* Proof:
14997 Note set y = set (x::ls) by interleave_set
14998 = x INSERT set ls by LIST_TO_SET
14999*)
15000Theorem interleave_set_alt:
15001 !ls x y. y IN x interleave ls ==> set y = x INSERT set ls
15002Proof
15003 metis_tac[interleave_set, LIST_TO_SET]
15004QED
15005
15006(* Theorem: (x::ls) IN x interleave ls *)
15007(* Proof:
15008 (x::ls) IN x interleave ls
15009 <=> ?k. x::ls = TAKE k ls ++ [x] ++ DROP k ls /\ k < SUC (LENGTH ls)
15010 by interleave_def
15011 Take k = 0.
15012 Then 0 < SUC (LENGTH ls) by SUC_POS
15013 and TAKE 0 ls ++ [x] ++ DROP 0 ls
15014 = [] ++ [x] ++ ls by TAKE_0, DROP_0
15015 = x::ls by APPEND
15016*)
15017Theorem interleave_has_cons:
15018 !ls x. (x::ls) IN x interleave ls
15019Proof
15020 rw[interleave_def] >>
15021 qexists_tac `0` >>
15022 simp[]
15023QED
15024
15025(* Theorem: x interleave ls <> EMPTY *)
15026(* Proof:
15027 Note (x::ls) IN x interleave ls by interleave_has_cons
15028 Thus x interleave ls <> {} by MEMBER_NOT_EMPTY
15029*)
15030Theorem interleave_not_empty:
15031 !ls x. x interleave ls <> EMPTY
15032Proof
15033 metis_tac[interleave_has_cons, MEMBER_NOT_EMPTY]
15034QED
15035
15036(*
15037MEM_APPEND_lemma
15038|- !a b c d x. a ++ [x] ++ b = c ++ [x] ++ d /\ ~MEM x b /\ ~MEM x a ==>
15039 a = c /\ b = d
15040*)
15041
15042(* Theorem: ~MEM n x /\ ~MEM n y ==> (n interleave x = n interleave y <=> x = y) *)
15043(* Proof:
15044 Let f = (\k. TAKE k x ++ n::DROP k x),
15045 g = (\k. TAKE k y ++ n::DROP k y).
15046 By interleave_def, this is to show:
15047 IMAGE f (upto (LENGTH x)) = IMAGE g (upto (LENGTH y)) <=> x = y
15048 Only-part part is trivial.
15049 For the if part,
15050 Note 0 IN (upto (LENGTH x) by SUC_POS, IN_COUNT
15051 so f 0 IN IMAGE f (upto (LENGTH x))
15052 thus ?k. k < SUC (LENGTH y) /\ f 0 = g k by IN_IMAGE, IN_COUNT
15053 so n::x = TAKE k y ++ [n] ++ DROP k y by notation of f 0
15054 but n::x = TAKE 0 x ++ [n] ++ DROP 0 x by TAKE_0, DROP_0
15055 and ~MEM n (TAKE 0 x) /\ ~MEM n (DROP 0 x) by TAKE_0, DROP_0
15056 so TAKE 0 x = TAKE k y /\
15057 DROP 0 x = DROP k y by MEM_APPEND_lemma
15058 or x = y by TAKE_DROP
15059*)
15060Theorem interleave_eq:
15061 !n x y. ~MEM n x /\ ~MEM n y ==> (n interleave x = n interleave y <=> x = y)
15062Proof
15063 rw[interleave_def, EQ_IMP_THM] >>
15064 qabbrev_tac `f = \k. TAKE k x ++ n::DROP k x` >>
15065 qabbrev_tac `g = \k. TAKE k y ++ n::DROP k y` >>
15066 `f 0 IN IMAGE f (upto (LENGTH x))` by fs[] >>
15067 `?k. k < SUC (LENGTH y) /\ f 0 = g k` by metis_tac[IN_IMAGE, IN_COUNT] >>
15068 fs[Abbr`f`, Abbr`g`] >>
15069 `n::x = TAKE 0 x ++ [n] ++ DROP 0 x` by rw[] >>
15070 `~MEM n (TAKE 0 x) /\ ~MEM n (DROP 0 x)` by rw[] >>
15071 metis_tac[MEM_APPEND_lemma, TAKE_DROP]
15072QED
15073
15074(* Theorem: ~MEM x l1 /\ l1 <> l2 ==> DISJOINT (x interleave l1) (x interleave l2) *)
15075(* Proof:
15076 Use DISJOINT_DEF, by contradiction, suppose y is in both.
15077 Then ?k h. k <= LENGTH l1 and h <= LENGTH l2
15078 with y = TAKE k l1 ++ [x] ++ DROP k l1 by interleave_element
15079 and y = TAKE h l2 ++ [x] ++ DROP h l2 by interleave_element
15080 Now ~MEM x (TAKE k l1) by MEM_TAKE
15081 and ~MEM x (DROP k l1) by MEM_DROP_IMP
15082 Thus TAKE k l1 = TAKE h l2 /\
15083 DROP k l1 = DROP h l2 by MEM_APPEND_lemma
15084 or l1 = l2 by TAKE_DROP
15085 but this contradicts l1 <> l2.
15086*)
15087Theorem interleave_disjoint:
15088 !l1 l2 x. ~MEM x l1 /\ l1 <> l2 ==> DISJOINT (x interleave l1) (x interleave l2)
15089Proof
15090 rw[interleave_def, DISJOINT_DEF, EXTENSION] >>
15091 spose_not_then strip_assume_tac >>
15092 `~MEM x (TAKE k l1) /\ ~MEM x (DROP k l1)` by metis_tac[MEM_TAKE, MEM_DROP_IMP] >>
15093 metis_tac[MEM_APPEND_lemma, TAKE_DROP]
15094QED
15095
15096(* Theorem: FINITE (x interleave ls) *)
15097(* Proof:
15098 Let f = (\k. TAKE k ls ++ x::DROP k ls),
15099 n = LENGTH ls.
15100 FINITE (x interleave ls)
15101 <=> FINITE (IMAGE f (upto n)) by interleave_def
15102 <=> T by IMAGE_FINITE, FINITE_COUNT
15103*)
15104Theorem interleave_finite:
15105 !ls x. FINITE (x interleave ls)
15106Proof
15107 simp[interleave_def, IMAGE_FINITE]
15108QED
15109
15110(* Theorem: ~MEM x ls ==>
15111 INJ (\k. TAKE k ls ++ x::DROP k ls) (upto (LENGTH ls)) univ(:'a list) *)
15112(* Proof:
15113 Let n = LENGTH ls,
15114 s = upto n,
15115 f = (\k. TAKE k ls ++ x::DROP k ls).
15116 By INJ_DEF, this is to show:
15117 (1) k IN s ==> f k IN univ(:'a list), true by types.
15118 (2) k IN s /\ h IN s /\ f k = f h ==> k = h.
15119 Note k <= LENGTH ls by IN_COUNT, k IN s
15120 and h <= LENGTH ls by IN_COUNT, h IN s
15121 and ls = TAKE k ls ++ DROP k ls by TAKE_DROP
15122 so ~MEM x (TAKE k ls) /\
15123 ~MEM x (DROP k ls) by MEM_APPEND, ~MEM x ls
15124 Thus TAKE k ls = TAKE h ls by MEM_APPEND_lemma
15125 ==> k = h by LENGTH_TAKE
15126
15127MEM_APPEND_lemma
15128|- !a b c d x. a ++ [x] ++ b = c ++ [x] ++ d /\
15129 ~MEM x b /\ ~MEM x a ==> a = c /\ b = d
15130*)
15131Theorem interleave_count_inj:
15132 !ls x. ~MEM x ls ==>
15133 INJ (\k. TAKE k ls ++ x::DROP k ls) (upto (LENGTH ls)) univ(:'a list)
15134Proof
15135 rw[INJ_DEF] >>
15136 `k <= LENGTH ls /\ k' <= LENGTH ls` by fs[] >>
15137 `~MEM x (TAKE k ls) /\ ~MEM x (DROP k ls)` by metis_tac[TAKE_DROP, MEM_APPEND] >>
15138 metis_tac[MEM_APPEND_lemma, LENGTH_TAKE]
15139QED
15140
15141(* Theorem: ~MEM x ls ==> CARD (x interleave ls) = 1 + LENGTH ls *)
15142(* Proof:
15143 Let f = (\k. TAKE k ls ++ x::DROP k ls),
15144 n = LENGTH ls.
15145 Note FINITE (upto n) by FINITE_COUNT
15146 and INJ f (upto n) univ(:'a list)
15147 by interleave_count_inj, ~MEM x ls
15148 CARD (x interleave ls)
15149 = CARD (IMAGE f (upto n)) by interleave_def
15150 = CARD (upto n) by INJ_CARD_IMAGE
15151 = SUC n = 1 + n by CARD_COUNT, ADD1
15152*)
15153Theorem interleave_card:
15154 !ls x. ~MEM x ls ==> CARD (x interleave ls) = 1 + LENGTH ls
15155Proof
15156 rw[interleave_def] >>
15157 imp_res_tac interleave_count_inj >>
15158 qabbrev_tac `n = LENGTH ls` >>
15159 qabbrev_tac `s = upto n` >>
15160 qabbrev_tac `f = (\k. TAKE k ls ++ x::DROP k ls)` >>
15161 `FINITE s` by rw[Abbr`s`] >>
15162 metis_tac[INJ_CARD_IMAGE, CARD_COUNT, ADD1]
15163QED
15164
15165(* Note:
15166 interleave_distinct, interleave_length, and interleave_set
15167 are effects after interleave. Now we need a kind of inverse:
15168 deduce the effects before interleave.
15169*)
15170
15171(* Idea: a member h in a distinct list is the interleave of h with a smaller one. *)
15172
15173(* Theorem: ALL_DISTINCT ls /\ h IN set ls ==>
15174 ?t. ALL_DISTINCT t /\ ls IN h interleave t /\ set t = (set ls) DELETE h *)
15175(* Proof:
15176 By induction on ls.
15177 Base: ALL_DISTINCT [] /\ MEM h [] ==> ?t. ...
15178 Since MEM h [] = F, this is true by MEM
15179 Step: (ALL_DISTINCT ls /\ MEM h ls ==>
15180 ?t. ALL_DISTINCT t /\ ls IN h interleave t /\ set t = set ls DELETE h) ==>
15181 !h'. ALL_DISTINCT (h'::ls) /\ MEM h (h'::ls) ==>
15182 ?t. ALL_DISTINCT t /\ h'::ls IN h interleave t /\ set t = set (h'::ls) DELETE h
15183 If h' = h,
15184 Note ~MEM h ls /\ ALL_DISTINCT ls by ALL_DISTINCT
15185 Take this ls,
15186 Then set (h::ls) DELETE h
15187 = (h INSERT set ls) DELETE h by LIST_TO_SET
15188 = set ls by INSERT_DELETE_NON_ELEMENT
15189 and h::ls IN h interleave ls by interleave_element, take k = 0.
15190 If h' <> h,
15191 Note ~MEM h' ls /\ ALL_DISTINCT ls by ALL_DISTINCT
15192 and MEM h ls by MEM, h <> h'
15193 Thus ?t. ALL_DISTINCT t /\
15194 ls IN h interleave t /\
15195 set t = set ls DELETE h by induction hypothesis
15196 Note ~MEM h' t by set t = set ls DELETE h, ~MEM h' ls
15197 Take this (h'::t),
15198 Then ALL_DISTINCT (h'::t) by ALL_DISTINCT, ~MEM h' t
15199 and set (h'::ls) DELETE h
15200 = (h' INSERT set ls) DELETE h by LIST_TO_SET
15201 = h' INSERT (set ls DELETE h) by DELETE_INSERT, h' <> h
15202 = h' INSERT set t by above
15203 = set (h'::t)
15204 and h'::ls IN h interleave t by interleave_element,
15205 take k = SUC k from ls IN h interleave t
15206*)
15207Theorem interleave_revert:
15208 !ls h. ALL_DISTINCT ls /\ h IN set ls ==>
15209 ?t. ALL_DISTINCT t /\ ls IN h interleave t /\ set t = (set ls) DELETE h
15210Proof
15211 rpt strip_tac >>
15212 Induct_on `ls` >-
15213 simp[] >>
15214 rpt strip_tac >>
15215 Cases_on `h' = h` >| [
15216 fs[] >>
15217 qexists_tac `ls` >>
15218 simp[INSERT_DELETE_NON_ELEMENT] >>
15219 simp[interleave_element] >>
15220 qexists_tac `0` >>
15221 simp[],
15222 fs[] >>
15223 `~MEM h' t` by fs[] >>
15224 qexists_tac `h'::t` >>
15225 simp[DELETE_INSERT] >>
15226 fs[interleave_element] >>
15227 qexists_tac `SUC k` >>
15228 simp[]
15229 ]
15230QED
15231
15232(* A useful corollary for set s = count n. *)
15233
15234(* Theorem: ALL_DISTINCT ls /\ set ls = upto n ==>
15235 ?t. ALL_DISTINCT t /\ ls IN n interleave t /\ set t = count n *)
15236(* Proof:
15237 Note MEM n ls by set ls = upto n
15238 so ?t. ALL_DISTINCT t /\
15239 ls IN n interleave t /\
15240 set t = set ls DELETE n by interleave_revert
15241 = (upto n) DELETE n by given
15242 = count n by upto_delete
15243*)
15244Theorem interleave_revert_count:
15245 !ls n. ALL_DISTINCT ls /\ set ls = upto n ==>
15246 ?t. ALL_DISTINCT t /\ ls IN n interleave t /\ set t = count n
15247Proof
15248 rpt strip_tac >>
15249 `MEM n ls` by fs[] >>
15250 drule_then strip_assume_tac interleave_revert >>
15251 first_x_assum (qspec_then `n` strip_assume_tac) >>
15252 metis_tac[upto_delete]
15253QED
15254
15255(* Theorem: perm_count (SUC n) =
15256 BIGUNION (IMAGE ($interleave n) (perm_count n)) *)
15257(* Proof:
15258 By induction on n.
15259 Base: perm_count (SUC 0) =
15260 BIGUNION (IMAGE ($interleave 0) (perm_count 0))
15261 LHS = perm_count (SUC 0)
15262 = perm_count 1 by ONE
15263 = {[0]} by perm_count_1
15264 RHS = BIGUNION (IMAGE ($interleave 0) (perm_count 0))
15265 = BIGUNION (IMAGE ($interleave 0) {[]} by perm_count_0
15266 = BIGUNION {0 interleave []} by IMAGE_SING
15267 = BIGUNION {{[0]}} by interleave_nil
15268 = {[0]} = LHS by BIGUNION_SING
15269 Step: perm_count (SUC n) = BIGUNION (IMAGE ($interleave n) (perm_count n)) ==>
15270 perm_count (SUC (SUC n)) =
15271 BIGUNION (IMAGE ($interleave (SUC n)) (perm_count (SUC n)))
15272 Let f = $interleave (SUC n),
15273 s = perm_count n, t = perm_count (SUC n).
15274 y IN BIGUNION (IMAGE f t)
15275 <=> ?x. x IN t /\ y IN f x by IN_BIGUNION_IMAGE
15276 <=> ?x. (?z. z IN s /\ x IN n interleave z) /\ y IN (SUC n) interleave x
15277 by IN_BIGUNION_IMAGE, induction hypothesis
15278 <=> ?x z. ALL_DISTINCT z /\ set z = count n /\
15279 x IN n interleave z /\
15280 y IN (SUC n) interleave x by perm_count_element
15281 If part: y IN perm_count (SUC (SUC n)) ==> ?x and z.
15282 Note ALL_DISTINCT y /\
15283 set y = count (SUC (SUC n)) by perm_count_element
15284 Then ?x. ALL_DISTINCT x /\ y IN (SUC n) interleave x /\ set x = upto n
15285 by interleave_revert_count
15286 so ?z. ALL_DISTINCT z /\ x IN n interleave z /\ set z = count n
15287 by interleave_revert_count
15288 Take these x and z.
15289 Only-if part: ?x and z ==> y IN perm_count (SUC (SUC n))
15290 Note ~MEM n z by set z = count n, COUNT_NOT_SELF
15291 ==> ALL_DISTINCT x /\ by interleave_distinct_alt
15292 set x = upto n by interleave_set_alt, COUNT_SUC
15293 Note ~MEM (SUC n) x by set x = upto n, COUNT_NOT_SELF
15294 ==> ALL_DISTINCT y /\ by interleave_distinct_alt
15295 set y = count (SUC (SUC n)) by interleave_set_alt, COUNT_SUC
15296 ==> y IN perm_count (SUC (SUC n)) by perm_count_element
15297*)
15298Theorem perm_count_suc:
15299 !n. perm_count (SUC n) =
15300 BIGUNION (IMAGE ($interleave n) (perm_count n))
15301Proof
15302 Induct >| [
15303 rw[perm_count_0, perm_count_1] >>
15304 simp[interleave_nil],
15305 rw[IN_BIGUNION_IMAGE, EXTENSION, EQ_IMP_THM] >| [
15306 imp_res_tac perm_count_element >>
15307 `?y. ALL_DISTINCT y /\ x IN (SUC n) interleave y /\ set y = upto n` by rw[interleave_revert_count] >>
15308 `?t. ALL_DISTINCT t /\ y IN n interleave t /\ set t = count n` by rw[interleave_revert_count] >>
15309 (qexists_tac `y` >> simp[]) >>
15310 (qexists_tac `t` >> simp[]) >>
15311 simp[perm_count_element],
15312 fs[perm_count_element] >>
15313 `~MEM n x''` by fs[] >>
15314 `ALL_DISTINCT x' /\ set x' = upto n` by metis_tac[interleave_distinct_alt, interleave_set_alt, COUNT_SUC] >>
15315 `~MEM (SUC n) x'` by fs[] >>
15316 metis_tac[interleave_distinct_alt, interleave_set_alt, COUNT_SUC]
15317 ]
15318 ]
15319QED
15320
15321(* Theorem: perm_count (n + 1) =
15322 BIGUNION (IMAGE ($interleave n) (perm_count n)) *)
15323(* Proof: by perm_count_suc, GSYM ADD1. *)
15324Theorem perm_count_suc_alt:
15325 !n. perm_count (n + 1) =
15326 BIGUNION (IMAGE ($interleave n) (perm_count n))
15327Proof
15328 simp[perm_count_suc, GSYM ADD1]
15329QED
15330
15331(* Theorem: perm_count n =
15332 if n = 0 then {[]}
15333 else BIGUNION (IMAGE ($interleave (n - 1)) (perm_count (n - 1))) *)
15334(* Proof: by perm_count_0, perm_count_suc. *)
15335Theorem perm_count_eqn[compute]:
15336 !n. perm_count n =
15337 if n = 0 then {[]}
15338 else BIGUNION (IMAGE ($interleave (n - 1)) (perm_count (n - 1)))
15339Proof
15340 rw[perm_count_0] >>
15341 metis_tac[perm_count_suc, num_CASES, SUC_SUB1]
15342QED
15343
15344(*
15345> EVAL ``perm_count 3``;
15346val it = |- perm_count 3 =
15347{[0; 1; 2]; [0; 2; 1]; [2; 0; 1]; [1; 0; 2]; [1; 2; 0]; [2; 1; 0]}: thm
15348*)
15349
15350(* Historical note.
15351This use of interleave to list all permutations is called
15352the Steinhaus-Johnson-Trotter algorithm, due to re-discovery by various people.
15353Outside mathematics, this method was known already to 17th-century English change ringers.
15354Equivalently, this algorithm finds a Hamiltonian cycle in the permutohedron.
15355
15356Steinhaus-Johnson-Trotter algorithm
15357https://en.wikipedia.org/wiki/Steinhaus-Johnson-Trotter_algorithm
15358
153591677 A book by Fabian Stedman lists the solutions for up to six bells.
153601958 A book by Steinhaus describes a related puzzle of generating all permutations by a system of particles.
15361Selmer M. Johnson and Hale F. Trotter discovered the algorithm independently of each other in the early 1960s.
153621962 Hale F. Trotter, "Algorithm 115: Perm", August 1962.
153631963 Selmer M. Johnson, "Generation of permutations by adjacent transposition".
15364
15365*)
15366
15367(* Theorem: perm 0 = 1 *)
15368(* Proof:
15369 perm 0
15370 = CARD (perm_count 0) by perm_def
15371 = CARD {[]} by perm_count_0
15372 = 1 by CARD_SING
15373*)
15374Theorem perm_0:
15375 perm 0 = 1
15376Proof
15377 simp[perm_def, perm_count_0]
15378QED
15379
15380(* Theorem: perm 1 = 1 *)
15381(* Proof:
15382 perm 1
15383 = CARD (perm_count 1) by perm_def
15384 = CARD {[0]} by perm_count_1
15385 = 1 by CARD_SING
15386*)
15387Theorem perm_1:
15388 perm 1 = 1
15389Proof
15390 simp[perm_def, perm_count_1]
15391QED
15392
15393(* Theorem: e IN IMAGE ($interleave n) (perm_count n) ==> FINITE e *)
15394(* Proof:
15395 e IN IMAGE ($interleave n) (perm_count n)
15396 <=> ?ls. ls IN perm_count n /\
15397 e = n interleave ls by IN_IMAGE
15398 Thus FINITE e by interleave_finite
15399*)
15400Theorem perm_count_interleave_finite:
15401 !n e. e IN IMAGE ($interleave n) (perm_count n) ==> FINITE e
15402Proof
15403 rw[] >>
15404 simp[interleave_finite]
15405QED
15406
15407(* Theorem: e IN IMAGE ($interleave n) (perm_count n) ==> CARD e = n + 1 *)
15408(* Proof:
15409 e IN IMAGE ($interleave n) (perm_count n)
15410 <=> ?ls. ls IN perm_count n /\
15411 e = n interleave ls by IN_IMAGE
15412 Note ~MEM n ls by perm_count_element_no_self
15413 and LENGTH ls = n by perm_count_element_length
15414 Thus CARD e = n + 1 by interleave_card, ~MEM n ls
15415*)
15416Theorem perm_count_interleave_card:
15417 !n e. e IN IMAGE ($interleave n) (perm_count n) ==> CARD e = n + 1
15418Proof
15419 rw[] >>
15420 `~MEM n x` by rw[perm_count_element_no_self] >>
15421 `LENGTH x = n` by rw[perm_count_element_length] >>
15422 simp[interleave_card]
15423QED
15424
15425(* Theorem: PAIR_DISJOINT (IMAGE ($interleave n) (perm_count n)) *)
15426(* Proof:
15427 By IN_IMAGE, this is to show:
15428 x IN perm_count n /\ y IN perm_count n /\
15429 n interleave x <> n interleave y ==>
15430 DISJOINT (n interleave x) (n interleave y)
15431 By contradiction, suppose there is a list ls in both.
15432 Then x = y by interleave_disjoint
15433 This contradicts n interleave x <> n interleave y.
15434*)
15435Theorem perm_count_interleave_disjoint:
15436 !n e. PAIR_DISJOINT (IMAGE ($interleave n) (perm_count n))
15437Proof
15438 rw[perm_count_def] >>
15439 `~MEM n x` by fs[] >>
15440 metis_tac[interleave_disjoint]
15441QED
15442
15443(* Theorem: INJ ($interleave n) (perm_count n) univ(:(num list -> bool)) *)
15444(* Proof:
15445 By INJ_DEF, this is to show:
15446 (1) x IN perm_count n ==> n interleave x IN univ
15447 This is true by type.
15448 (2) x IN perm_count n /\ y IN perm_count n /\
15449 n interleave x = n interleave y ==> x = y
15450 Note ~MEM n x by perm_count_element_no_self
15451 and ~MEM n y by perm_count_element_no_self
15452 Thus x = y by interleave_eq
15453*)
15454Theorem perm_count_interleave_inj:
15455 !n. INJ ($interleave n) (perm_count n) univ(:(num list -> bool))
15456Proof
15457 rw[INJ_DEF, perm_count_def, interleave_eq]
15458QED
15459
15460(* Theorem: perm (SUC n) = (SUC n) * perm n *)
15461(* Proof:
15462 Let f = $interleave n,
15463 s = IMAGE f (perm_count n).
15464 Note FINITE (perm_count n) by perm_count_finite
15465 so FINITE s by IMAGE_FINITE
15466 and !e. e IN s ==>
15467 FINITE e /\ by perm_count_interleave_finite
15468 CARD e = n + 1 by perm_count_interleave_card
15469 and PAIR_DISJOINT s by perm_count_interleave_disjoint
15470 and INJ f (perm_count n) univ(:(num list -> bool))
15471 by perm_count_interleave_inj
15472 perm (SUC n)
15473 = CARD (perm_count (SUC n)) by perm_def
15474 = CARD (BIGUNION s) by perm_count_suc
15475 = CARD s * (n + 1) by CARD_BIGUNION_SAME_SIZED_SETS
15476 = CARD (perm_count n) * (n + 1) by INJ_CARD_IMAGE
15477 = perm n * (n + 1) by perm_def
15478 = (SUC n) * perm n by MULT_COMM, ADD1
15479*)
15480Theorem perm_suc:
15481 !n. perm (SUC n) = (SUC n) * perm n
15482Proof
15483 rpt strip_tac >>
15484 qabbrev_tac `f = $interleave n` >>
15485 qabbrev_tac `s = IMAGE f (perm_count n)` >>
15486 `FINITE (perm_count n)` by rw[perm_count_finite] >>
15487 `FINITE s` by rw[Abbr`s`] >>
15488 `!e. e IN s ==> FINITE e /\ CARD e = n + 1`
15489 by metis_tac[perm_count_interleave_finite, perm_count_interleave_card] >>
15490 `PAIR_DISJOINT s` by metis_tac[perm_count_interleave_disjoint] >>
15491 `INJ f (perm_count n) univ(:(num list -> bool))` by rw[perm_count_interleave_inj, Abbr`f`] >>
15492 simp[perm_def] >>
15493 `CARD (perm_count (SUC n)) = CARD (BIGUNION s)` by rw[perm_count_suc, Abbr`s`, Abbr`f`] >>
15494 `_ = CARD s * (n + 1)` by rw[CARD_BIGUNION_SAME_SIZED_SETS] >>
15495 `_ = CARD (perm_count n) * (n + 1)` by metis_tac[INJ_CARD_IMAGE] >>
15496 simp[ADD1]
15497QED
15498
15499(* Theorem: perm (n + 1) = (n + 1) * perm n *)
15500(* Proof: by perm_suc, ADD1 *)
15501Theorem perm_suc_alt:
15502 !n. perm (n + 1) = (n + 1) * perm n
15503Proof
15504 simp[perm_suc, GSYM ADD1]
15505QED
15506
15507(* Theorem: perm 0 = 1 /\ !n. perm (n + 1) = (n + 1) * perm n *)
15508(* Proof: by perm_0, perm_suc_alt *)
15509Theorem perm_alt:
15510 perm 0 = 1 /\ !n. perm (n + 1) = (n + 1) * perm n
15511Proof
15512 simp[perm_0, perm_suc_alt]
15513QED
15514
15515(* Theorem: perm n = FACT n *)
15516(* Proof: by FACT_iff, perm_alt. *)
15517Theorem perm_eq_fact[compute]:
15518 !n. perm n = FACT n
15519Proof
15520 metis_tac[FACT_iff, perm_alt, ADD1]
15521QED
15522
15523(* This is fantastic! *)
15524
15525(*
15526> EVAL ``perm 3``; = 6
15527> EVAL ``MAP perm [0 .. 10]``; =
15528[1; 1; 2; 6; 24; 120; 720; 5040; 40320; 362880; 3628800]
15529*)
15530
15531(* ------------------------------------------------------------------------- *)
15532(* Permutations of a set. *)
15533(* ------------------------------------------------------------------------- *)
15534
15535(* Note: SET_TO_LIST, using CHOICE and REST, is not effective for computations.
15536SET_TO_LIST_THM
15537|- FINITE s ==>
15538 SET_TO_LIST s = if s = {} then [] else CHOICE s::SET_TO_LIST (REST s)
15539*)
15540
15541(* Define the set of permutation lists of a set. *)
15542Definition perm_set_def[nocompute]:
15543 perm_set s = {ls | ALL_DISTINCT ls /\ set ls = s}
15544End
15545(* use [nocompute] as this is not effective for evalutaion. *)
15546(* Note: this cannot be made effective, unless sort s to list by some ordering. *)
15547
15548(* Theorem: ls IN perm_set s <=> ALL_DISTINCT ls /\ set ls = s *)
15549(* Proof: perm_set_def *)
15550Theorem perm_set_element:
15551 !ls s. ls IN perm_set s <=> ALL_DISTINCT ls /\ set ls = s
15552Proof
15553 simp[perm_set_def]
15554QED
15555
15556(* Theorem: perm_set (count n) = perm_count n *)
15557(* Proof: by perm_count_def, perm_set_def. *)
15558Theorem perm_set_perm_count:
15559 !n. perm_set (count n) = perm_count n
15560Proof
15561 simp[perm_count_def, perm_set_def]
15562QED
15563
15564(* Theorem: perm_set {} = {[]} *)
15565(* Proof:
15566 perm_set {}
15567 = {ls | ALL_DISTINCT ls /\ set ls = {}} by perm_set_def
15568 = {ls | ALL_DISTINCT ls /\ ls = []} by LIST_TO_SET_EQ_EMPTY
15569 = {[]} by ALL_DISTINCT
15570*)
15571Theorem perm_set_empty:
15572 perm_set {} = {[]}
15573Proof
15574 rw[perm_set_def, EXTENSION] >>
15575 metis_tac[ALL_DISTINCT]
15576QED
15577
15578(* Theorem: perm_set {x} = {[x]} *)
15579(* Proof:
15580 perm_set {x}
15581 = {ls | ALL_DISTINCT ls /\ set ls = {x}} by perm_set_def
15582 = {ls | ls = [x]} by DISTINCT_LIST_TO_SET_EQ_SING
15583 = {[x]} by notation
15584*)
15585Theorem perm_set_sing:
15586 !x. perm_set {x} = {[x]}
15587Proof
15588 simp[perm_set_def, DISTINCT_LIST_TO_SET_EQ_SING]
15589QED
15590
15591(* Theorem: perm_set s = {[]} <=> s = {} *)
15592(* Proof:
15593 If part: perm_set s = {[]} ==> s = {}
15594 By contradiction, suppose s <> {}.
15595 ls IN perm_set s
15596 <=> ALL_DISTINCT ls /\ set ls = s by perm_set_element
15597 ==> ls <> [] by LIST_TO_SET_EQ_EMPTY
15598 This contradicts perm_set s = {[]} by IN_SING
15599 Only-if part: s = {} ==> perm_set s = {[]}
15600 This is true by perm_set_empty
15601*)
15602Theorem perm_set_eq_empty_sing:
15603 !s. perm_set s = {[]} <=> s = {}
15604Proof
15605 rw[perm_set_empty, EQ_IMP_THM] >>
15606 `[] IN perm_set s` by fs[] >>
15607 fs[perm_set_element]
15608QED
15609
15610(* Theorem: FINITE s ==> (SET_TO_LIST s) IN perm_set s *)
15611(* Proof:
15612 Let ls = SET_TO_LIST s.
15613 Note ALL_DISTINCT ls by ALL_DISTINCT_SET_TO_LIST
15614 and set ls = s by SET_TO_LIST_INV
15615 Thus ls IN perm_set s by perm_set_element
15616*)
15617Theorem perm_set_has_self_list:
15618 !s. FINITE s ==> (SET_TO_LIST s) IN perm_set s
15619Proof
15620 simp[perm_set_element, ALL_DISTINCT_SET_TO_LIST, SET_TO_LIST_INV]
15621QED
15622
15623(* Theorem: FINITE s ==> perm_set s <> {} *)
15624(* Proof:
15625 Let ls = SET_TO_LIST s.
15626 Then ls IN perm_set s by perm_set_has_self_list
15627 Thus perm_set s <> {} by MEMBER_NOT_EMPTY
15628*)
15629Theorem perm_set_not_empty:
15630 !s. FINITE s ==> perm_set s <> {}
15631Proof
15632 metis_tac[perm_set_has_self_list, MEMBER_NOT_EMPTY]
15633QED
15634
15635(* Theorem: perm_set (set ls) <> {} *)
15636(* Proof:
15637 Note FINITE (set ls) by FINITE_LIST_TO_SET
15638 so perm_set (set ls) <> {} by perm_set_not_empty
15639*)
15640Theorem perm_set_list_not_empty:
15641 !ls. perm_set (set ls) <> {}
15642Proof
15643 simp[FINITE_LIST_TO_SET, perm_set_not_empty]
15644QED
15645
15646(* Theorem: ls IN perm_set s /\ BIJ f s (count n) ==> MAP f ls IN perm_count n *)
15647(* Proof:
15648 By perm_set_def, perm_count_def, this is to show:
15649 (1) ALL_DISTINCT ls /\ BIJ f (set ls) (count n) ==> ALL_DISTINCT (MAP f ls)
15650 Note INJ f (set ls) (count n) by BIJ_DEF
15651 so ALL_DISTINCT (MAP f ls) by ALL_DISTINCT_MAP_INJ, INJ_DEF
15652 (2) ALL_DISTINCT ls /\ BIJ f (set ls) (count n) ==> set (MAP f ls) = count n
15653 Note SURJ f (set ls) (count n) by BIJ_DEF
15654 so set (MAP f ls)
15655 = IMAGE f (set ls) by LIST_TO_SET_MAP
15656 = count n by IMAGE_SURJ
15657*)
15658Theorem perm_set_map_element:
15659 !ls f s n. ls IN perm_set s /\ BIJ f s (count n) ==> MAP f ls IN perm_count n
15660Proof
15661 rw[perm_set_def, perm_count_def] >-
15662 metis_tac[ALL_DISTINCT_MAP_INJ, BIJ_IS_INJ] >>
15663 simp[LIST_TO_SET_MAP] >>
15664 fs[IMAGE_SURJ, BIJ_DEF]
15665QED
15666
15667(* Theorem: BIJ f s (count n) ==>
15668 INJ (MAP f) (perm_set s) (perm_count n) *)
15669(* Proof:
15670 By INJ_DEF, this is to show:
15671 (1) x IN perm_set s ==> MAP f x IN perm_count n
15672 This is true by perm_set_map_element
15673 (2) x IN perm_set s /\ y IN perm_set s /\ MAP f x = MAP f y ==> x = y
15674 Note LENGTH x = LENGTH y by LENGTH_MAP
15675 By LIST_EQ, it remains to show:
15676 !j. j < LENGTH x ==> EL j x = EL j y
15677 Note EL j x IN s by perm_set_element, MEM_EL
15678 and EL j y IN s by perm_set_element, MEM_EL
15679 MAP f x = MAP f y
15680 ==> EL j (MAP f x) = EL j (MAP f y)
15681 ==> f (EL j x) = f (EL j y) by EL_MAP
15682 ==> EL j x = EL j y by BIJ_IS_INJ
15683*)
15684Theorem perm_set_map_inj:
15685 !f s n. BIJ f s (count n) ==>
15686 INJ (MAP f) (perm_set s) (perm_count n)
15687Proof
15688 rw[INJ_DEF] >-
15689 metis_tac[perm_set_map_element] >>
15690 irule LIST_EQ >>
15691 `LENGTH x = LENGTH y` by metis_tac[LENGTH_MAP] >>
15692 rw[] >>
15693 `EL x' x IN s` by metis_tac[perm_set_element, MEM_EL] >>
15694 `EL x' y IN s` by metis_tac[perm_set_element, MEM_EL] >>
15695 metis_tac[EL_MAP, BIJ_IS_INJ]
15696QED
15697
15698(* Theorem: BIJ f s (count n) ==>
15699 SURJ (MAP f) (perm_set s) (perm_count n) *)
15700(* Proof:
15701 By SURJ_DEF, this is to show:
15702 (1) x IN perm_set s ==> MAP f x IN perm_count n
15703 This is true by perm_set_map_element
15704 (2) x IN perm_count n ==> ?y. y IN perm_set s /\ MAP f y = x
15705 Let y = MAP (LINV f s) x. Then to show:
15706 (1) y IN perm_set s,
15707 Note BIJ (LINV f s) (count n) s by BIJ_LINV_BIJ
15708 By perm_set_element, perm_count_element, to show:
15709 (1) ALL_DISTINCT (MAP (LINV f s) x)
15710 Note INJ (LINV f s) (count n) s by BIJ_DEF
15711 so ALL_DISTINCT (MAP (LINV f s) x)
15712 by ALL_DISTINCT_MAP_INJ, INJ_DEF
15713 (2) set (MAP (LINV f s) x) = s
15714 Note SURJ (LINV f s) (count n) s by BIJ_DEF
15715 so set (MAP (LINV f s) x)
15716 = IMAGE (LINV f s) (set x) by LIST_TO_SET_MAP
15717 = IMAGE (LINV f s) (count n) by set x = count n
15718 = s by IMAGE_SURJ
15719 (2) x IN perm_count n ==> MAP f (MAP (LINV f s) x) = x
15720 Let g = f o LINV f s.
15721 The goal is: MAP g x = x by MAP_COMPOSE
15722 Note LENGTH (MAP g x) = LENGTH x by LENGTH_MAP
15723 To apply LIST_EQ, just need to show:
15724 !k. k < LENGTH x ==>
15725 EL k (MAP g x) = EL k x
15726 or to show: g (EL k x) = EL k x by EL_MAP
15727 Now set x = count n by perm_count_element
15728 so EL k x IN (count n) by MEM_EL
15729 Thus g (EL k x) = EL k x by BIJ_LINV_INV
15730*)
15731Theorem perm_set_map_surj:
15732 !f s n. BIJ f s (count n) ==>
15733 SURJ (MAP f) (perm_set s) (perm_count n)
15734Proof
15735 rw[SURJ_DEF] >-
15736 metis_tac[perm_set_map_element] >>
15737 qexists_tac `MAP (LINV f s) x` >>
15738 rpt strip_tac >| [
15739 `BIJ (LINV f s) (count n) s` by rw[BIJ_LINV_BIJ] >>
15740 fs[perm_set_element, perm_count_element] >>
15741 rpt strip_tac >-
15742 metis_tac[ALL_DISTINCT_MAP_INJ, BIJ_IS_INJ] >>
15743 simp[LIST_TO_SET_MAP] >>
15744 fs[IMAGE_SURJ, BIJ_DEF],
15745 simp[MAP_COMPOSE] >>
15746 qabbrev_tac `g = f o LINV f s` >>
15747 irule LIST_EQ >>
15748 `LENGTH (MAP g x) = LENGTH x` by rw[LENGTH_MAP] >>
15749 rw[] >>
15750 simp[EL_MAP] >>
15751 fs[perm_count_element, Abbr`g`] >>
15752 metis_tac[MEM_EL, BIJ_LINV_INV]
15753 ]
15754QED
15755
15756(* Theorem: BIJ f s (count n) ==>
15757 BIJ (MAP f) (perm_set s) (perm_count n) *)
15758(* Proof:
15759 Note INJ (MAP f) (perm_set s) (perm_count n) by perm_set_map_inj
15760 and SURJ (MAP f) (perm_set s) (perm_count n) by perm_set_map_surj
15761 Thus BIJ (MAP f) (perm_set s) (perm_count n) by BIJ_DEF
15762*)
15763Theorem perm_set_map_bij:
15764 !f s n. BIJ f s (count n) ==>
15765 BIJ (MAP f) (perm_set s) (perm_count n)
15766Proof
15767 simp[BIJ_DEF, perm_set_map_inj, perm_set_map_surj]
15768QED
15769
15770(* Theorem: FINITE s ==> perm_set s =b= perm_count (CARD s) *)
15771(* Proof:
15772 Note ?f. BIJ f s (count (CARD s)) by bij_eq_count, FINITE s
15773 Thus BIJ (MAP f) (perm_set s) (perm_count (CARD s))
15774 by perm_set_map_bij
15775 showing perm_set s =b= perm_count (CARD s) by notation
15776*)
15777Theorem perm_set_bij_eq_perm_count:
15778 !s. FINITE s ==> perm_set s =b= perm_count (CARD s)
15779Proof
15780 rpt strip_tac >>
15781 imp_res_tac bij_eq_count >>
15782 metis_tac[perm_set_map_bij]
15783QED
15784
15785(* Theorem: FINITE s ==> FINITE (perm_set s) *)
15786(* Proof:
15787 Note perm_set s =b= perm_count (CARD s) by perm_set_bij_eq_perm_count
15788 and FINITE (perm_count (CARD s)) by perm_count_finite
15789 so FINITE (perm_set s) by bij_eq_finite
15790*)
15791Theorem perm_set_finite:
15792 !s. FINITE s ==> FINITE (perm_set s)
15793Proof
15794 metis_tac[perm_set_bij_eq_perm_count, perm_count_finite, bij_eq_finite]
15795QED
15796
15797(* Theorem: FINITE s ==> CARD (perm_set s) = perm (CARD s) *)
15798(* Proof:
15799 Note perm_set s =b= perm_count (CARD s) by perm_set_bij_eq_perm_count
15800 and FINITE (perm_count (CARD s)) by perm_count_finite
15801 so CARD (perm_set s)
15802 = CARD (perm_count (CARD s)) by bij_eq_card
15803 = perm (CARD s) by perm_def
15804*)
15805Theorem perm_set_card:
15806 !s. FINITE s ==> CARD (perm_set s) = perm (CARD s)
15807Proof
15808 metis_tac[perm_set_bij_eq_perm_count, perm_count_finite, bij_eq_card, perm_def]
15809QED
15810
15811(* This is a major result! *)
15812
15813(* Theorem: FINITE s ==> CARD (perm_set s) = FACT (CARD s) *)
15814(* Proof: by perm_set_card, perm_eq_fact. *)
15815Theorem perm_set_card_alt:
15816 !s. FINITE s ==> CARD (perm_set s) = FACT (CARD s)
15817Proof
15818 simp[perm_set_card, perm_eq_fact]
15819QED
15820
15821(* ------------------------------------------------------------------------- *)
15822(* Counting number of arrangements. *)
15823(* ------------------------------------------------------------------------- *)
15824
15825(* Define the set of choices of k-tuples of (count n). *)
15826Definition list_count_def[nocompute]:
15827 list_count n k =
15828 { ls | ALL_DISTINCT ls /\ (set ls) SUBSET (count n) /\ LENGTH ls = k}
15829End
15830(* use [nocompute] as this is not effective for evalutaion. *)
15831(* Note: if defined as:
15832 list_count n k = { ls | (set ls) SUBSET (count n) /\ CARD (set ls) = k}
15833then non-distinct lists will be in the set, which is not desirable.
15834*)
15835
15836(* Define the number of choices of k-tuples of (count n). *)
15837Definition arrange_def[nocompute]:
15838 arrange n k = CARD (list_count n k)
15839End
15840(* use [nocompute] as this is not effective for evalutaion. *)
15841(* make this an infix operator *)
15842val _ = set_fixity "arrange" (Infix(NONASSOC, 550)); (* higher than arithmetic op 500. *)
15843(* arrange_def;
15844val it = |- !n k. n arrange k = CARD (list_count n k): thm *)
15845
15846(* Theorem: list_count n k =
15847 { ls | ALL_DISTINCT ls /\ (set ls) SUBSET (count n) /\ CARD (set ls) = k} *)
15848(* Proof:
15849 ls IN list_count n k
15850 <=> ALL_DISTINCT ls /\ (set ls) SUBSET (count n) /\ LENGTH ls = k
15851 by list_count_def
15852 <=> ALL_DISTINCT ls /\ (set ls) SUBSET (count n) /\ CARD (set ls) = k
15853 by ALL_DISTINCT_CARD_LIST_TO_SET
15854 Hence the sets are equal by EXTENSION.
15855*)
15856Theorem list_count_alt:
15857 !n k. list_count n k =
15858 { ls | ALL_DISTINCT ls /\ (set ls) SUBSET (count n) /\ CARD (set ls) = k}
15859Proof
15860 simp[list_count_def, EXTENSION] >>
15861 metis_tac[ALL_DISTINCT_CARD_LIST_TO_SET]
15862QED
15863
15864(* Theorem: ls IN list_count n k <=>
15865 ALL_DISTINCT ls /\ (set ls) SUBSET (count n) /\ LENGTH ls = k *)
15866(* Proof: by list_count_def. *)
15867Theorem list_count_element:
15868 !ls n k. ls IN list_count n k <=>
15869 ALL_DISTINCT ls /\ (set ls) SUBSET (count n) /\ LENGTH ls = k
15870Proof
15871 simp[list_count_def]
15872QED
15873
15874(* Theorem: ls IN list_count n k <=>
15875 ALL_DISTINCT ls /\ (set ls) SUBSET (count n) /\ CARD (set ls) = k *)
15876(* Proof: by list_count_alt. *)
15877Theorem list_count_element_alt:
15878 !ls n k. ls IN list_count n k <=>
15879 ALL_DISTINCT ls /\ (set ls) SUBSET (count n) /\ CARD (set ls) = k
15880Proof
15881 simp[list_count_alt]
15882QED
15883
15884(* Theorem: ls IN list_count n k ==> CARD (set ls) = k *)
15885(* Proof:
15886 ls IN list_count n k
15887 <=> ALL_DISTINCT ls /\ (set ls) SUBSET (count n) /\ LENGTH ls = k
15888 by list_count_element
15889 ==> CARD (set ls) = k by ALL_DISTINCT_CARD_LIST_TO_SET
15890*)
15891Theorem list_count_element_set_card:
15892 !ls n k. ls IN list_count n k ==> CARD (set ls) = k
15893Proof
15894 simp[list_count_def, ALL_DISTINCT_CARD_LIST_TO_SET]
15895QED
15896
15897(* Theorem: list_count n k SUBSET necklace k n *)
15898(* Proof:
15899 ls IN list_count n k
15900 <=> ALL_DISTINCT ls /\ (set ls) SUBSET (count n) /\ LENGTH ls = k
15901 by list_count_element
15902 ==> (set ls) SUBSET (count n) /\ LENGTH ls = k
15903 ==> ls IN necklace k n by necklace_def
15904 Thus list_count n k SUBSET necklace k n by SUBSET_DEF
15905*)
15906Theorem list_count_subset:
15907 !n k. list_count n k SUBSET necklace k n
15908Proof
15909 simp[list_count_def, necklace_def, SUBSET_DEF]
15910QED
15911
15912(* Theorem: FINITE (list_count n k) *)
15913(* Proof:
15914 Note list_count n k SUBSET necklace k n by list_count_subset
15915 and FINITE (necklace k n) by necklace_finite
15916 so FINITE (list_count n k) by SUBSET_FINITE
15917*)
15918Theorem list_count_finite:
15919 !n k. FINITE (list_count n k)
15920Proof
15921 metis_tac[list_count_subset, necklace_finite, SUBSET_FINITE]
15922QED
15923
15924(* Note:
15925list_count 4 2 has P(4,2) = 4 * 3 = 12 elements.
15926necklace 2 4 has 2 ** 4 = 16 elements.
15927
15928> EVAL ``necklace 2 4``;
15929val it = |- necklace 2 4 =
15930 {[3; 3]; [3; 2]; [3; 1]; [3; 0]; [2; 3]; [2; 2]; [2; 1]; [2; 0];
15931 [1; 3]; [1; 2]; [1; 1]; [1; 0]; [0; 3]; [0; 2]; [0; 1]; [0; 0]}: thm
15932> EVAL ``IMAGE set (necklace 2 4)``;
15933val it = |- IMAGE set (necklace 2 4) =
15934 {{3}; {2; 3}; {2}; {1; 3}; {1; 2}; {1}; {0; 3}; {0; 2}; {0; 1}; {0}}:
15935> EVAL ``IMAGE (\ls. if CARD (set ls) = 2 then ls else []) (necklace 2 4)``;
15936val it = |- IMAGE (\ls. if CARD (set ls) = 2 then ls else []) (necklace 2 4) =
15937 {[3; 2]; [3; 1]; [3; 0]; [2; 3]; [2; 1]; [2; 0]; [1; 3]; [1; 2];
15938 [1; 0]; [0; 3]; [0; 2]; [0; 1]; []}: thm
15939> EVAL ``let n = 4; k = 2 in (IMAGE (\ls. if CARD (set ls) = k then ls else []) (necklace k n)) DELETE []``;
15940val it = |- (let n = 4; k = 2 in
15941IMAGE (\ls. if CARD (set ls) = k then ls else []) (necklace k n) DELETE []) =
15942 {[3; 2]; [3; 1]; [3; 0]; [2; 3]; [2; 1]; [2; 0]; [1; 3]; [1; 2];
15943 [1; 0]; [0; 3]; [0; 2]; [0; 1]}: thm
15944> EVAL ``let n = 4; k = 2 in (IMAGE (\ls. if ALL_DISTINCT ls then ls else []) (necklace k n)) DELETE []``;
15945val it = |- (let n = 4; k = 2 in
15946 IMAGE (\ls. if ALL_DISTINCT ls then ls else []) (necklace k n) DELETE []) =
15947 {[3; 2]; [3; 1]; [3; 0]; [2; 3]; [2; 1]; [2; 0]; [1; 3]; [1; 2];
15948 [1; 0]; [0; 3]; [0; 2]; [0; 1]}: thm
15949*)
15950
15951(* Note:
15952P(n,k) = C(n,k) * k!
15953P(n,0) = C(n,0) * 0! = 1
15954P(0,k+1) = C(0,k+1) * (k+1)! = 0
15955*)
15956
15957(* Theorem: list_count n 0 = {[]} *)
15958(* Proof:
15959 ls IN list_count n 0
15960 <=> ALL_DISTINCT ls /\ (set ls) SUBSET (count n) /\ LENGTH ls = 0
15961 by list_count_element
15962 <=> ALL_DISTINCT ls /\ (set ls) SUBSET (count n) /\ ls = []
15963 by LENGTH_NIL
15964 <=> T /\ T /\ ls = [] by ALL_DISTINCT, LIST_TO_SET, EMPTY_SUBSET
15965 Thus list_count n 0 = {[]} by EXTENSION
15966*)
15967Theorem list_count_n_0:
15968 !n. list_count n 0 = {[]}
15969Proof
15970 rw[list_count_def, EXTENSION, EQ_IMP_THM]
15971QED
15972
15973(* Theorem: 0 < n ==> list_count 0 n = {} *)
15974(* Proof:
15975 Note (list_count 0 n) SUBSET (necklace n 0)
15976 by list_count_subset
15977 but (necklace n 0) = {} by necklace_empty, 0 < n
15978 Thus (list_count 0 n) = {} by SUBSET_EMPTY
15979*)
15980Theorem list_count_0_n:
15981 !n. 0 < n ==> list_count 0 n = {}
15982Proof
15983 metis_tac[list_count_subset, necklace_empty, SUBSET_EMPTY]
15984QED
15985
15986(* Theorem: list_count n n = perm_count n *)
15987(* Proof:
15988 ls IN list_count n n
15989 <=> ALL_DISTINCT ls /\ set ls SUBSET count n /\ CARD (set ls) = n
15990 by list_count_element_alt
15991 <=> ALL_DISTINCT ls /\ set ls SUBSET count n /\ CARD (set ls) = CARD (count n)
15992 by CARD_COUNT
15993 <=> ALL_DISTINCT ls /\ set ls SUBSET count n /\ set ls = count n
15994 by SUBSET_CARD_EQ
15995 <=> ALL_DISTINCT ls /\ set ls = count n by SUBSET_REFL
15996 <=> ls IN perm_count n by perm_count_element
15997*)
15998Theorem list_count_n_n:
15999 !n. list_count n n = perm_count n
16000Proof
16001 rw_tac bool_ss[list_count_element_alt, EXTENSION] >>
16002 `FINITE (count n) /\ CARD (count n) = n` by rw[] >>
16003 metis_tac[SUBSET_REFL, SUBSET_CARD_EQ, perm_count_element]
16004QED
16005
16006(* Theorem: list_count n k = {} <=> n < k *)
16007(* Proof:
16008 If part: list_count n k = {} ==> n < k
16009 By contradiction, suppose k <= n.
16010 Let ls = SET_TO_LIST (count k).
16011 Note FINITE (count k) by FINITE_COUNT
16012 Then ALL_DISTINCT ls by ALL_DISTINCT_SET_TO_LIST
16013 and set ls = count k by SET_TO_LIST_INV
16014 Now (count k) SUBSET (count n) by COUNT_SUBSET, k <= n
16015 and CARD (count k) = k by CARD_COUNT
16016 so ls IN list_count n k by list_count_element_alt
16017 Thus list_count n k <> {} by MEMBER_NOT_EMPTY
16018 which is a contradiction.
16019 Only-if part: n < k ==> list_count n k = {}
16020 By contradiction, suppose sub_count n k <> {}.
16021 Then ?ls. ls IN list_count n k by MEMBER_NOT_EMPTY
16022 ==> ALL_DISTINCT ls /\ set ls SUBSET count n /\ CARD (set ls) = k
16023 by sub_count_element_alt
16024 Note FINITE (count n) by FINITE_COUNT
16025 so CARD (set ls) <= CARD (count n)
16026 by CARD_SUBSET
16027 ==> k <= n by CARD_COUNT
16028 This contradicts n < k.
16029*)
16030Theorem list_count_eq_empty:
16031 !n k. list_count n k = {} <=> n < k
16032Proof
16033 rw[EQ_IMP_THM] >| [
16034 spose_not_then strip_assume_tac >>
16035 qabbrev_tac `ls = SET_TO_LIST (count k)` >>
16036 `FINITE (count k)` by rw[FINITE_COUNT] >>
16037 `ALL_DISTINCT ls` by rw[ALL_DISTINCT_SET_TO_LIST, Abbr`ls`] >>
16038 `set ls = count k` by rw[SET_TO_LIST_INV, Abbr`ls`] >>
16039 `(count k) SUBSET (count n)` by rw[COUNT_SUBSET] >>
16040 `CARD (count k) = k` by rw[] >>
16041 metis_tac[list_count_element_alt, MEMBER_NOT_EMPTY],
16042 spose_not_then strip_assume_tac >>
16043 `?ls. ls IN list_count n k` by rw[MEMBER_NOT_EMPTY] >>
16044 fs[list_count_element_alt] >>
16045 `FINITE (count n)` by rw[] >>
16046 `CARD (set ls) <= n` by metis_tac[CARD_SUBSET, CARD_COUNT] >>
16047 decide_tac
16048 ]
16049QED
16050
16051(* Theorem: 0 < k ==>
16052 list_count n k =
16053 IMAGE (\ls. if ALL_DISTINCT ls then ls else []) (necklace k n) DELETE [] *)
16054(* Proof:
16055 x IN IMAGE (\ls. if ALL_DISTINCT ls then ls else []) (necklace k n) DELETE []
16056 <=> ?ls. x = (if ALL_DISTINCT ls then ls else []) /\
16057 LENGTH ls = k /\ set ls SUBSET count n) /\ x <> [] by IN_IMAGE, IN_DELETE
16058 <=> ALL_DISTINCT x /\ LENGTH x = k /\ set x SUBSET count n by LENGTH_NIL, 0 < k, ls = x
16059 <=> x IN list_count n k by list_count_element
16060 Thus the two sets are equal by EXTENSION.
16061*)
16062Theorem list_count_by_image:
16063 !n k. 0 < k ==>
16064 list_count n k =
16065 IMAGE (\ls. if ALL_DISTINCT ls then ls else []) (necklace k n) DELETE []
16066Proof
16067 rw[list_count_def, necklace_def, EXTENSION] >>
16068 (rw[EQ_IMP_THM] >> metis_tac[LENGTH_NIL, NOT_ZERO])
16069QED
16070
16071(* Theorem: list_count n k =
16072 if k = 0 then {[]}
16073 else IMAGE (\ls. if ALL_DISTINCT ls then ls else []) (necklace k n) DELETE [] *)
16074(* Proof: by list_count_n_0, list_count_by_image *)
16075Theorem list_count_eqn[compute]:
16076 !n k. list_count n k =
16077 if k = 0 then {[]}
16078 else IMAGE (\ls. if ALL_DISTINCT ls then ls else []) (necklace k n) DELETE []
16079Proof
16080 rw[list_count_n_0, list_count_by_image]
16081QED
16082
16083(*
16084> EVAL ``list_count 3 2``;
16085val it = |- list_count 3 2 = {[2; 1]; [2; 0]; [1; 2]; [1; 0]; [0; 2]; [0; 1]}: thm
16086> EVAL ``list_count 4 2``;
16087val it = |- list_count 4 2 =
16088{[3; 2]; [3; 1]; [3; 0]; [2; 3]; [2; 1]; [2; 0]; [1; 3]; [1; 2]; [1; 0]; [0; 3]; [0; 2]; [0; 1]}: thm
16089*)
16090
16091(* Idea: define an equivalence relation feq set: set x = set y.
16092 There are k! elements in each equivalence class.
16093 Thus n arrange k = perm k * n choose k. *)
16094
16095(* Theorem: (feq set) equiv_on s *)
16096(* Proof: by feq_equiv. *)
16097Theorem feq_set_equiv:
16098 !s. (feq set) equiv_on s
16099Proof
16100 simp[feq_equiv]
16101QED
16102
16103(*
16104> EVAL ``list_count 3 2``;
16105val it = |- list_count 3 2 = {[2; 1]; [1; 2]; [2; 0]; [0; 2]; [1; 0]; [0; 1]}: thm
16106*)
16107
16108(* Theorem: ls IN list_count n k ==>
16109 equiv_class (feq set) (list_count n k) ls = perm_set (set ls) *)
16110(* Proof:
16111 Note ALL_DISTINCT ls /\ set ls SUBSET count n /\ LENGTH ls = k
16112 by list_count_element
16113 x IN equiv_class (feq set) (list_count n k) ls
16114 <=> x IN (list_count n k) /\ (feq set) ls x by equiv_class_element
16115 <=> x IN (list_count n k) /\ set ls = set x by feq_def
16116 <=> ALL_DISTINCT x /\ set x SUBSET count n /\ LENGTH x = k /\
16117 set x = set ls by list_count_element
16118 <=> ALL_DISTINCT x /\ LENGTH x = LENGTH ls /\ set x = set ls
16119 by given
16120 <=> ALL_DISTINCT x /\ set x = set ls by ALL_DISTINCT_CARD_LIST_TO_SET
16121 <=> x IN perm_set (set ls) by perm_set_element
16122*)
16123Theorem list_count_set_eq_class:
16124 !ls n k. ls IN list_count n k ==>
16125 equiv_class (feq set) (list_count n k) ls = perm_set (set ls)
16126Proof
16127 rw[list_count_def, perm_set_def, fequiv_def, Once EXTENSION] >>
16128 rw[EQ_IMP_THM] >>
16129 metis_tac[ALL_DISTINCT_CARD_LIST_TO_SET]
16130QED
16131
16132(* Theorem: ls IN list_count n k ==>
16133 CARD (equiv_class (feq set) (list_count n k) ls) = perm k *)
16134(* Proof:
16135 Note ALL_DISTINCT ls /\ set ls SUBSET count n /\ LENGTH ls = k
16136 by list_count_element
16137 CARD (equiv_class (feq set) (list_count n k) ls)
16138 = CARD (perm_set (set ls)) by list_count_set_eq_class
16139 = perm (CARD (set ls)) by perm_set_card
16140 = perm (LENGTH ls) by ALL_DISTINCT_CARD_LIST_TO_SET
16141 = perm k by LENGTH ls = k
16142*)
16143Theorem list_count_set_eq_class_card:
16144 !ls n k. ls IN list_count n k ==>
16145 CARD (equiv_class (feq set) (list_count n k) ls) = perm k
16146Proof
16147 rw[list_count_set_eq_class] >>
16148 fs[list_count_element] >>
16149 simp[perm_set_card, ALL_DISTINCT_CARD_LIST_TO_SET]
16150QED
16151
16152(* Theorem: e IN partition (feq set) (list_count n k) ==> CARD e = perm k *)
16153(* Proof:
16154 By partition_element, this is to show:
16155 ls IN list_count n k ==>
16156 CARD (equiv_class (feq set) (list_count n k) ls) = perm k
16157 This is true by list_count_set_eq_class_card.
16158*)
16159Theorem list_count_set_partititon_element_card:
16160 !n k e. e IN partition (feq set) (list_count n k) ==> CARD e = perm k
16161Proof
16162 rw_tac bool_ss [partition_element] >>
16163 simp[list_count_set_eq_class_card]
16164QED
16165
16166(* Theorem: ls IN list_count n k ==> perm_set (set ls) <> {} *)
16167(* Proof:
16168 Note (feq set) equiv_on (list_count n k) by feq_set_equiv
16169 and perm_set (set ls)
16170 = equiv_class (feq set) (list_count n k) ls by list_count_set_eq_class
16171 <> {} by equiv_class_not_empty
16172*)
16173Theorem list_count_element_perm_set_not_empty:
16174 !ls n k. ls IN list_count n k ==> perm_set (set ls) <> {}
16175Proof
16176 metis_tac[list_count_set_eq_class, feq_set_equiv, equiv_class_not_empty]
16177QED
16178
16179(* This is more restrictive than perm_set_list_not_empty, hence not useful. *)
16180
16181(* Theorem: s IN (partition (feq set) (list_count n k)) ==>
16182 (set o CHOICE) s IN (sub_count n k) *)
16183(* Proof:
16184 s IN (partition (feq set) (list_count n k))
16185 <=> ?z. z IN list_count n k /\
16186 !x. x IN s <=> x IN list_count n k /\ set x = set z
16187 by feq_partition_element
16188 ==> z IN s, so s <> {} by MEMBER_NOT_EMPTY
16189 Let ls = CHOICE s.
16190 Then ls IN s by CHOICE_DEF
16191 so ls IN list_count n k /\ set ls = set z
16192 by implication
16193 or ALL_DISTINCT ls /\ set ls SUBSET count n /\ LENGTH ls = k
16194 by list_count_element
16195 Note (set o CHOICE) s = set ls by o_THM
16196 and CARD (set ls) = LENGTH ls by ALL_DISTINCT_CARD_LIST_TO_SET
16197 so set ls IN (sub_count n k) by sub_count_element_alt
16198*)
16199Theorem list_count_set_map_element:
16200 !s n k. s IN (partition (feq set) (list_count n k)) ==>
16201 (set o CHOICE) s IN (sub_count n k)
16202Proof
16203 rw[feq_partition_element] >>
16204 `s <> {}` by metis_tac[MEMBER_NOT_EMPTY] >>
16205 `(CHOICE s) IN s` by fs[CHOICE_DEF] >>
16206 fs[list_count_element, sub_count_element] >>
16207 metis_tac[ALL_DISTINCT_CARD_LIST_TO_SET]
16208QED
16209
16210(* Theorem: INJ (set o CHOICE) (partition (feq set) (list_count n k)) (sub_count n k) *)
16211(* Proof:
16212 Let R = feq set,
16213 s = list_count n k,
16214 t = sub_count n k.
16215 By INJ_DEF, this is to show:
16216 (1) x IN partition R s ==> (set o CHOICE) x IN t
16217 This is true by list_count_set_map_element
16218 (2) x IN partition R s /\ y IN partition R s /\
16219 (set o CHOICE) x = (set o CHOICE) y ==> x = y
16220 Note ?u. u IN list_count n k
16221 !ls. ls IN x <=> ls IN list_count n k /\ set ls = set u
16222 by feq_partition_element
16223 and ?v. v IN list_count n k
16224 !ls. ls IN y <=> ls IN list_count n k /\ set ls = set v
16225 by feq_partition_element
16226 Thus u IN x, so x <> {} by MEMBER_NOT_EMPTY
16227 and v IN y, so y <> {} by MEMBER_NOT_EMPTY
16228 Let lx = CHOICE x IN x by CHOICE_DEF
16229 and ly = CHOICE y IN y by CHOICE_DEF
16230 With set lx = set ly by o_THM
16231 Thus set lx = set u by implication
16232 and set ly = set v by implication
16233 so set u = set v by above
16234 Thus x = y by EXTENSION
16235*)
16236Theorem list_count_set_map_inj:
16237 !n k. INJ (set o CHOICE) (partition (feq set) (list_count n k)) (sub_count n k)
16238Proof
16239 rw_tac bool_ss[INJ_DEF] >-
16240 simp[list_count_set_map_element] >>
16241 fs[feq_partition_element] >>
16242 `x <> {} /\ y <> {}` by metis_tac[MEMBER_NOT_EMPTY] >>
16243 `CHOICE x IN x /\ CHOICE y IN y` by fs[CHOICE_DEF] >>
16244 `set z = set z'` by rfs[] >>
16245 simp[EXTENSION]
16246QED
16247
16248(* Theorem: SURJ (set o CHOICE) (partition (feq set) (list_count n k)) (sub_count n k) *)
16249(* Proof:
16250 Let R = feq set,
16251 s = list_count n k,
16252 t = sub_count n k.
16253 By SURJ_DEF, this is to show:
16254 (1) x IN partition R s ==> (set o CHOICE) x IN t
16255 This is true by list_count_set_map_element
16256 (2) x IN t ==> ?y. y IN partition R s /\ (set o CHOICE) y = x
16257 Note x SUBSET count n /\ CARD x = k by sub_count_element
16258 Thus FINITE x by SUBSET_FINITE, FINITE_COUNT
16259 Let y = perm_set x.
16260 To show;
16261 (1) y IN partition R s
16262 Note y IN partition R s
16263 <=> ?ls. ls IN list_count n k /\
16264 !z. z IN perm_set x <=> z IN list_count n k /\ set z = set ls
16265 by feq_partition_element
16266 Let ls = SET_TO_LIST x.
16267 Then ALL_DISTINCT ls by ALL_DISTINCT_SET_TO_LIST, FINITE x
16268 and set ls = x by SET_TO_LIST_INV, FINITE x
16269 so set ls SUBSET (count n) by above, x SUBSET count n
16270 and LENGTH ls = k by SET_TO_LIST_CARD, FINITE x
16271 so ls IN list_count n k by list_count_element
16272 To show: !z. z IN perm_set x <=> z IN list_count n k /\ set z = set ls
16273 z IN perm_set x
16274 <=> ALL_DISTINCT z /\ set z = x by perm_set_element
16275 <=> ALL_DISTINCT z /\ set z SUBSET count n /\ set z = x
16276 by x SUBSET count n
16277 <=> ALL_DISTINCT z /\ set z SUBSET count n /\ LENGTH z = CARD x
16278 by ALL_DISTINCT_CARD_LIST_TO_SET
16279 <=> z IN list_count n k /\ set z = set ls
16280 by list_count_element, CARD x = k, set ls = x.
16281 (2) (set o CHOICE) y = x
16282 Note y <> {} by perm_set_not_empty, FINITE x
16283 Then CHOICE y IN y by CHOICE_DEF
16284 so (set o CHOICE) y
16285 = set (CHOICE y) by o_THM
16286 = x by perm_set_element, y = perm_set x
16287*)
16288Theorem list_count_set_map_surj:
16289 !n k. SURJ (set o CHOICE) (partition (feq set) (list_count n k)) (sub_count n k)
16290Proof
16291 rw_tac bool_ss[SURJ_DEF] >-
16292 simp[list_count_set_map_element] >>
16293 fs[sub_count_element] >>
16294 `FINITE x` by metis_tac[SUBSET_FINITE, FINITE_COUNT] >>
16295 qexists_tac `perm_set x` >>
16296 simp[feq_partition_element, list_count_element, perm_set_element] >>
16297 rpt strip_tac >| [
16298 qabbrev_tac `ls = SET_TO_LIST x` >>
16299 qexists_tac `ls` >>
16300 `ALL_DISTINCT ls` by rw[ALL_DISTINCT_SET_TO_LIST, Abbr`ls`] >>
16301 `set ls = x` by rw[SET_TO_LIST_INV, Abbr`ls`] >>
16302 `LENGTH ls = k` by rw[SET_TO_LIST_CARD, Abbr`ls`] >>
16303 rw[EQ_IMP_THM] >>
16304 metis_tac[ALL_DISTINCT_CARD_LIST_TO_SET],
16305 `perm_set x <> {}` by fs[perm_set_not_empty] >>
16306 qabbrev_tac `ls = CHOICE (perm_set x)` >>
16307 `ls IN perm_set x` by fs[CHOICE_DEF, Abbr`ls`] >>
16308 fs[perm_set_element]
16309 ]
16310QED
16311
16312(* Theorem: BIJ (set o CHOICE) (partition (feq set) (list_count n k)) (sub_count n k) *)
16313(* Proof:
16314 Let f = set o CHOICE,
16315 s = partition (feq set) (list_count n k),
16316 t = sub_count n k.
16317 Note INJ f s t by list_count_set_map_inj
16318 and SURJ f s t by list_count_set_map_surj
16319 so BIJ f s t by BIJ_DEF
16320*)
16321Theorem list_count_set_map_bij:
16322 !n k. BIJ (set o CHOICE) (partition (feq set) (list_count n k)) (sub_count n k)
16323Proof
16324 simp[BIJ_DEF, list_count_set_map_inj, list_count_set_map_surj]
16325QED
16326
16327(* Theorem: n arrange k = (n choose k) * perm k *)
16328(* Proof:
16329 Let R = feq set,
16330 s = list_count n k,
16331 t = sub_count n k.
16332 Then FINITE s by list_count_finite
16333 and R equiv_on s by feq_set_equiv
16334 and !e. e IN partition R s ==> CARD e = perm k
16335 by list_count_set_partititon_element_card
16336 Thus CARD s = perm k * CARD (partition R s)
16337 by equal_partition_card, [1]
16338 Note CARD s = n arrange k by arrange_def
16339 and BIJ (set o CHOICE) (partition R s) t
16340 by list_count_set_map_bij
16341 and FINITE t by sub_count_finite
16342 so CARD (partition R s)
16343 = CARD t by bij_eq_card
16344 = n choose k by choose_def
16345 Hence n arrange k = n choose k * perm k
16346 by MULT_COMM, [1], above.
16347*)
16348Theorem arrange_eqn[compute]:
16349 !n k. n arrange k = (n choose k) * perm k
16350Proof
16351 rpt strip_tac >>
16352 assume_tac list_count_set_map_bij >>
16353 last_x_assum (qspecl_then [`n`, `k`] strip_assume_tac) >>
16354 qabbrev_tac `R = feq (set :num list -> num -> bool)` >>
16355 qabbrev_tac `s = list_count n k` >>
16356 qabbrev_tac `t = sub_count n k` >>
16357 `FINITE s` by rw[list_count_finite, Abbr`s`] >>
16358 `R equiv_on s` by rw[feq_set_equiv, Abbr`R`] >>
16359 `!e. e IN partition R s ==> CARD e = perm k` by metis_tac[list_count_set_partititon_element_card] >>
16360 imp_res_tac equal_partition_card >>
16361 `FINITE t` by rw[sub_count_finite, Abbr`t`] >>
16362 `CARD (partition R s) = CARD t` by metis_tac[bij_eq_card] >>
16363 simp[arrange_def, choose_def, Abbr`s`, Abbr`t`]
16364QED
16365
16366(* This is P(n,k) = C(n,k) * k! *)
16367
16368(* Theorem: n arrange k = (n choose k) * FACT k *)
16369(* Proof:
16370 n arrange k
16371 = (n choose k) * perm k by arrange_eqn
16372 = (n choose k) * FACT k by perm_eq_fact
16373*)
16374Theorem arrange_alt:
16375 !n k. n arrange k = (n choose k) * FACT k
16376Proof
16377 simp[arrange_eqn, perm_eq_fact]
16378QED
16379
16380(*
16381> EVAL ``5 arrange 2``; = 20
16382> EVAL ``MAP ($arrange 5) [0 .. 5]``; = [1; 5; 20; 60; 120; 120]
16383*)
16384
16385(* Theorem: n arrange k = (binomial n k) * FACT k *)
16386(* Proof:
16387 n arrange k
16388 = (n choose k) * FACT k by arrange_alt
16389 = (binomial n k) * FACT k by choose_eqn
16390*)
16391Theorem arrange_formula:
16392 !n k. n arrange k = (binomial n k) * FACT k
16393Proof
16394 simp[arrange_alt, choose_eqn]
16395QED
16396
16397(* Theorem: k <= n ==> n arrange k = FACT n DIV FACT (n - k) *)
16398(* Proof:
16399 Note 0 < FACT (n - k) by FACT_LESS
16400 (n arrange k) * FACT (n - k)
16401 = (binomial n k) * FACT k * FACT (n - k) by arrange_formula
16402 = binomial n k * (FACT (n - k) * FACT k) by arithmetic
16403 = FACT n by binomial_formula2, k <= n
16404 Thus n arrange k = FACT n DIV FACT (n - k) by DIV_SOLVE
16405*)
16406Theorem arrange_formula2:
16407 !n k. k <= n ==> n arrange k = FACT n DIV FACT (n - k)
16408Proof
16409 rpt strip_tac >>
16410 `0 < FACT (n - k)` by rw[FACT_LESS] >>
16411 `(n arrange k) * FACT (n - k) = (binomial n k) * FACT k * FACT (n - k)` by rw[arrange_formula] >>
16412 `_ = binomial n k * (FACT (n - k) * FACT k)` by rw[] >>
16413 `_ = FACT n` by rw[binomial_formula2] >>
16414 simp[DIV_SOLVE]
16415QED
16416
16417(* Theorem: n arrange 0 = 1 *)
16418(* Proof:
16419 n arrange 0
16420 = CARD (list_count n 0) by arrange_def
16421 = CARD {[]} by list_count_n_0
16422 = 1 by CARD_SING
16423*)
16424Theorem arrange_n_0:
16425 !n. n arrange 0 = 1
16426Proof
16427 simp[arrange_def, perm_def, list_count_n_0]
16428QED
16429
16430(* Theorem: 0 < n ==> 0 arrange n = 0 *)
16431(* Proof:
16432 0 arrange n
16433 = CARD (list_count 0 n) by arrange_def
16434 = CARD {} by list_count_0_n, 0 < n
16435 = 0 by CARD_EMPTY
16436*)
16437Theorem arrange_0_n:
16438 !n. 0 < n ==> 0 arrange n = 0
16439Proof
16440 simp[arrange_def, perm_def, list_count_0_n]
16441QED
16442
16443(* Theorem: n arrange n = perm n *)
16444(* Proof:
16445 n arrange n
16446 = (binomial n n) * FACT n by arrange_formula
16447 = 1 * FACT n by binomial_n_n
16448 = perm n by perm_eq_fact
16449*)
16450Theorem arrange_n_n:
16451 !n. n arrange n = perm n
16452Proof
16453 simp[arrange_formula, binomial_n_n, perm_eq_fact]
16454QED
16455
16456(* Theorem: n arrange n = FACT n *)
16457(* Proof:
16458 n arrange n
16459 = (binomial n n) * FACT n by arrange_formula
16460 = 1 * FACT n by binomial_n_n
16461*)
16462Theorem arrange_n_n_alt:
16463 !n. n arrange n = FACT n
16464Proof
16465 simp[arrange_formula, binomial_n_n]
16466QED
16467
16468(* Theorem: n arrange k = 0 <=> n < k *)
16469(* Proof:
16470 Note FINITE (list_count n k) by list_count_finite
16471 n arrange k = 0
16472 <=> CARD (list_count n k) = 0 by arrange_def
16473 <=> list_count n k = {} by CARD_EQ_0
16474 <=> n < k by list_count_eq_empty
16475*)
16476Theorem arrange_eq_0:
16477 !n k. n arrange k = 0 <=> n < k
16478Proof
16479 metis_tac[arrange_def, list_count_eq_empty, list_count_finite, CARD_EQ_0]
16480QED
16481
16482(* Note:
16483
16484k-permutation recurrence?
16485
16486P(n,k) = C(n,k) * k!
16487P(n,0) = C(n,0) * 0! = 1
16488P(0,k+1) = C(0,k+1) * (k+1)! = 0
16489
16490C(n+1,k+1) = C(n,k) + C(n,k+1)
16491P(n+1,k+1)/(k+1)! = P(n,k)/k! + P(n,k+1)/(k+1)!
16492P(n+1,k+1) = (k+1) * P(n,k) + P(n,k+1)
16493P(n+1,k+1) = P(n,k) * (k + 1) + P(n,k+1)
16494
16495P(2,1) = 2: [0] [1]
16496P(2,2) = 2: [0,1] [1,0]
16497P(3,2) = 6: [0,1] [0,2] include 2: [0,2] [1,2] [2,0] [2,1]
16498 [1,0] [1,2] exclude 2: [0,1] [1,0]
16499 [2,0] [2,1]
16500P(3,2) = P(2,1) * 2 + P(2,2) = ([0][1],2 + 2,[0][1]) + to_lists {0,1}
16501P(4,3): include 3: P(3,2) * 3
16502 exclude 3: P(3,3)
16503
16504list_count (n+1) (k+1) = IMAGE (interleave k) (list_count n k) UNION list_count n (k + 1)
16505
16506closed?
16507https://math.stackexchange.com/questions/3060456/
16508using Pascal argument
16509
16510*)