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(* ------------------------------------------------------------------------- *)
2538(* MAP of function with 3 list arguments *)
2539(* ------------------------------------------------------------------------- *)
2540
2541(* Define MAP3 similar to MAP2 in listTheory. *)
2542Definition MAP3_DEF[simp]:
2543 (MAP3 f (h1::t1) (h2::t2) (h3::t3) = f h1 h2 h3::MAP3 f t1 t2 t3) /\
2544 (MAP3 f x y z = [])
2545End
2546Theorem MAP3:
2547 (!f. MAP3 f [] [] [] = []) /\
2548 (!f h1 t1 h2 t2 h3 t3. MAP3 f (h1::t1) (h2::t2) (h3::t3) = f h1 h2 h3::MAP3 f t1 t2 t3)
2549Proof
2550 METIS_TAC[MAP3_DEF]
2551QED
2552
2553(*
2554LENGTH_MAP |- !l f. LENGTH (MAP f l) = LENGTH l
2555LENGTH_MAP2 |- !xs ys. LENGTH (MAP2 f xs ys) = MIN (LENGTH xs) (LENGTH ys)
2556*)
2557
2558(* Theorem: LENGTH (MAP3 f lx ly lz) = MIN (MIN (LENGTH lx) (LENGTH ly)) (LENGTH lz) *)
2559(* Proof:
2560 By induction on lx.
2561 Base: !ly lz f. LENGTH (MAP3 f [] ly lz) = MIN (MIN (LENGTH []) (LENGTH ly)) (LENGTH lz)
2562 LHS = LENGTH [] = 0 by MAP3, LENGTH
2563 RHS = MIN (MIN 0 (LENGTH ly)) (LENGTH lz) by LENGTH
2564 = MIN 0 (LENGTH lz) = 0 = LHS by MIN_DEF
2565 Step: !ly lz f. LENGTH (MAP3 f lx ly lz) = MIN (MIN (LENGTH lx) (LENGTH ly)) (LENGTH lz) ==>
2566 !h ly lz f. LENGTH (MAP3 f (h::lx) ly lz) = MIN (MIN (LENGTH (h::lx)) (LENGTH ly)) (LENGTH lz)
2567 If ly = [],
2568 LHS = LENGTH (MAP3 f (h::lx) [] lz) = 0 by MAP3, LENGTH
2569 RHS = MIN (MIN (LENGTH (h::lx)) (LENGTH [])) (LENGTH lz)
2570 = MIN 0 (LENGTH lz) = 0 = LHS by MIN_DEF
2571 Otherwise, ly = h'::t.
2572 If lz = [],
2573 LHS = LENGTH (MAP3 f (h::lx) (h'::t) []) = 0 by MAP3, LENGTH
2574 RHS = MIN (MIN (LENGTH (h::lx)) (LENGTH (h'::t))) (LENGTH [])
2575 = 0 = LHS by MIN_DEF
2576 Otherwise, lz = h''::t'.
2577 LHS = LENGTH (MAP3 f (h::lx) (h'::t) (h''::t'))
2578 = LENGTH (f h' h''::MAP3 lx t t'') by MAP3
2579 = SUC (LENGTH MAP3 lx t t'') by LENGTH
2580 = SUC (MIN (MIN (LENGTH lx) (LENGTH t)) (LENGTH t'')) by induction hypothesis
2581 RHS = MIN (MIN (LENGTH (h::lx)) (LENGTH (h'::t))) (LENGTH (h''::t'))
2582 = MIN (MIN (SUC (LENGTH lx)) (SUC (LENGTH t))) (SUC (LENGTH t')) by LENGTH
2583 = MIN (SUC (MIN (LENGTH lx) (LENGTH t))) (SUC (LESS_TWICE t')) by MIN_DEF
2584 = SUC (MIN (MIN (LENGTH lx) (LENGTH t)) (LENGTH t'')) = LHS by MIN_DEF
2585*)
2586Theorem LENGTH_MAP3:
2587 !lx ly lz f. LENGTH (MAP3 f lx ly lz) = MIN (MIN (LENGTH lx) (LENGTH ly)) (LENGTH lz)
2588Proof
2589 Induct_on `lx` >-
2590 rw[] >>
2591 rpt strip_tac >>
2592 Cases_on `ly` >-
2593 rw[] >>
2594 Cases_on `lz` >-
2595 rw[] >>
2596 rw[MIN_DEF]
2597QED
2598
2599(*
2600EL_MAP |- !n l. n < LENGTH l ==> !f. EL n (MAP f l) = f (EL n l)
2601EL_MAP2 |- !ts tt n. n < MIN (LENGTH ts) (LENGTH tt) ==> (EL n (MAP2 f ts tt) = f (EL n ts) (EL n tt))
2602*)
2603
2604(* Theorem: n < MIN (MIN (LENGTH lx) (LENGTH ly)) (LENGTH lz) ==>
2605 !f. EL n (MAP3 f lx ly lz) = f (EL n lx) (EL n ly) (EL n lz) *)
2606(* Proof:
2607 By induction on n.
2608 Base: !lx ly lz. 0 < MIN (MIN (LENGTH lx) (LENGTH ly)) (LENGTH lz) ==>
2609 !f. EL 0 (MAP3 f lx ly lz) = f (EL 0 lx) (EL 0 ly) (EL 0 lz)
2610 Note ?x tx. lx = x::tx by LENGTH_EQ_0, list_CASES
2611 and ?y ty. ly = y::ty by LENGTH_EQ_0, list_CASES
2612 and ?z tz. lz = z::tz by LENGTH_EQ_0, list_CASES
2613 EL 0 (MAP3 f lx ly lz)
2614 = EL 0 (MAP3 f (x::lx) (y::ty) (z::tz))
2615 = EL 0 (f x y z::MAP3 f tx ty tz) by MAP3
2616 = f x y z by EL
2617 = f (EL 0 lx) (EL 0 ly) (EL 0 lz) by EL
2618 Step: !lx ly lz. n < MIN (MIN (LENGTH lx) (LENGTH ly)) (LENGTH lz) ==>
2619 !f. EL n (MAP3 f lx ly lz) = f (EL n lx) (EL n ly) (EL n lz) ==>
2620 !lx ly lz. SUC n < MIN (MIN (LENGTH lx) (LENGTH ly)) (LENGTH lz) ==>
2621 !f. EL (SUC n) (MAP3 f lx ly lz) = f (EL (SUC n) lx) (EL (SUC n) ly) (EL (SUC n) lz)
2622 Note ?x tx. lx = x::tx by LENGTH_EQ_0, list_CASES
2623 and ?y ty. ly = y::ty by LENGTH_EQ_0, list_CASES
2624 and ?z tz. lz = z::tz by LENGTH_EQ_0, list_CASES
2625 Also n < LENGTH tx /\ n < LENGTH ty /\ n < LENGTH tz by LENGTH
2626 Thus n < MIN (MIN (LENGTH tx) (LENGTH ty)) (LENGTH tz) by MIN_DEF
2627 EL (SUC n) (MAP3 f lx ly lz)
2628 = EL (SUC n) (MAP3 f (x::lx) (y::ty) (z::tz))
2629 = EL (SUC n) (f x y z::MAP3 f tx ty tz) by MAP3
2630 = EL n (MAP3 f tx ty tz) by EL
2631 = f (EL n tx) (EL n ty) (EL n tz) by induction hypothesis
2632 = f (EL (SUC n) lx) (EL (SUC n) ly) (EL (SUC n) lz)
2633 by EL
2634*)
2635Theorem EL_MAP3:
2636 !lx ly lz n. n < MIN (MIN (LENGTH lx) (LENGTH ly)) (LENGTH lz) ==>
2637 !f. EL n (MAP3 f lx ly lz) = f (EL n lx) (EL n ly) (EL n lz)
2638Proof
2639 Induct_on `n` >| [
2640 rw[] >>
2641 `?x tx. lx = x::tx` by metis_tac[LENGTH_EQ_0, list_CASES, NOT_ZERO_LT_ZERO] >>
2642 `?y ty. ly = y::ty` by metis_tac[LENGTH_EQ_0, list_CASES, NOT_ZERO_LT_ZERO] >>
2643 `?z tz. lz = z::tz` by metis_tac[LENGTH_EQ_0, list_CASES, NOT_ZERO_LT_ZERO] >>
2644 rw[],
2645 rw[] >>
2646 `!a. SUC n < a ==> a <> 0` by decide_tac >>
2647 `?x tx. lx = x::tx` by metis_tac[LENGTH_EQ_0, list_CASES] >>
2648 `?y ty. ly = y::ty` by metis_tac[LENGTH_EQ_0, list_CASES] >>
2649 `?z tz. lz = z::tz` by metis_tac[LENGTH_EQ_0, list_CASES] >>
2650 `n < LENGTH tx /\ n < LENGTH ty /\ n < LENGTH tz` by fs[] >>
2651 rw[]
2652 ]
2653QED
2654
2655(*
2656MEM_MAP |- !l f x. MEM x (MAP f l) <=> ?y. x = f y /\ MEM y l
2657*)
2658
2659(* Theorem: MEM x (MAP2 f l1 l2) ==> ?y1 y2. x = f y1 y2 /\ MEM y1 l1 /\ MEM y2 l2 *)
2660(* Proof:
2661 By induction on l1.
2662 Base: !l2. MEM x (MAP2 f [] l2) ==> ?y1 y2. x = f y1 y2 /\ MEM y1 [] /\ MEM y2 l2
2663 Note MAP2 f [] l2 = [] by MAP2_DEF
2664 and MEM x [] = F, hence true by MEM
2665 Step: !l2. MEM x (MAP2 f l1 l2) ==> ?y1 y2. x = f y1 y2 /\ MEM y1 l1 /\ MEM y2 l2 ==>
2666 !h l2. MEM x (MAP2 f (h::l1) l2) ==> ?y1 y2. x = f y1 y2 /\ MEM y1 (h::l1) /\ MEM y2 l2
2667 If l2 = [],
2668 Then MEM x (MAP2 f (h::l1) []) = F, hence true by MEM
2669 Otherwise, l2 = h'::t,
2670 to show: MEM x (MAP2 f (h::l1) (h'::t)) ==> ?y1 y2. x = f y1 y2 /\ MEM y1 (h::l1) /\ MEM y2 (h'::t)
2671 Note MAP2 f (h::l1) (h'::t)
2672 = (f h h')::MAP2 f l1 t by MAP2
2673 Thus x = f h h' or MEM x (MAP2 f l1 t) by MEM
2674 If x = f h h',
2675 Take y1 = h, y2 = h', and the result follows by MEM
2676 If MEM x (MAP2 f l1 t)
2677 Then ?y1 y2. x = f y1 y2 /\ MEM y1 l1 /\ MEM y2 t by induction hypothesis
2678 Take this y1 and y2, the result follows by MEM
2679*)
2680Theorem MEM_MAP2:
2681 !f x l1 l2. MEM x (MAP2 f l1 l2) ==> ?y1 y2. (x = f y1 y2) /\ MEM y1 l1 /\ MEM y2 l2
2682Proof
2683 ntac 2 strip_tac >>
2684 Induct_on `l1` >-
2685 rw[] >>
2686 rpt strip_tac >>
2687 Cases_on `l2` >-
2688 fs[] >>
2689 fs[] >-
2690 metis_tac[] >>
2691 metis_tac[MEM]
2692QED
2693
2694(* 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 *)
2695(* Proof:
2696 By induction on l1.
2697 Base: !l2 l3. MEM x (MAP3 f [] l2 l3) ==> ...
2698 Note MAP3 f [] l2 l3 = [], and MEM x [] = F, hence true.
2699 Step: !l2 l3. MEM x (MAP3 f l1 l2 l3) ==>
2700 ?y1 y2 y3. x = f y1 y2 y3 /\ MEM y1 l1 /\ MEM y2 l2 /\ MEM y3 l3 ==>
2701 !h l2 l3. MEM x (MAP3 f (h::l1) l2 l3) ==>
2702 ?y1 y2 y3. x = f y1 y2 y3 /\ MEM y1 (h::l1) /\ MEM y2 l2 /\ MEM y3 l3
2703 If l2 = [],
2704 Then MEM x (MAP3 f (h::l1) [] l3) = MEM x [] = F, hence true by MAP3_DEF
2705 Otherwise, l2 = h'::t,
2706 to show: MEM x (MAP3 f (h::l1) (h'::t) l3) ==>
2707 ?y1 y2 y3. x = f y1 y2 y3 /\ MEM y1 (h::l1) /\ MEM y2 (h'::t) /\ MEM y3 l3
2708 If l3 = [],
2709 Then MEM x (MAP3 f (h::l1) l2 []) = MEM x [] = F, hence true by MAP3_DEF
2710 Otherwise, l3 = h''::t',
2711 to show: MEM x (MAP3 f (h::l1) (h'::t) (h''::t')) ==>
2712 ?y1 y2 y3. x = f y1 y2 y3 /\ MEM y1 (h::l1) /\ MEM y2 (h'::t) /\ MEM y3 (h''::t')
2713
2714 Note MAP3 f (h::l1) (h'::t) (h''::t')
2715 = (f h h' h'')::MAP3 f l1 t t' by MAP3
2716 Thus x = f h h' h'' or MEM x (MAP3 f l1 t t') by MEM
2717 If x = f h h' h'',
2718 Take y1 = h, y2 = h', y3 = h'' and the result follows by MEM
2719 If MEM x (MAP3 f l1 t t')
2720 Then ?y1 y2 y3. x = f y1 y2 y3 /\ MEM y1 t /\ MEM y2 l2 /\ MEM y3 t'
2721 by induction hypothesis
2722 Take this y1, y2 and y3, the result follows by MEM
2723*)
2724Theorem MEM_MAP3:
2725 !f x l1 l2 l3. MEM x (MAP3 f l1 l2 l3) ==>
2726 ?y1 y2 y3. (x = f y1 y2 y3) /\ MEM y1 l1 /\ MEM y2 l2 /\ MEM y3 l3
2727Proof
2728 ntac 2 strip_tac >>
2729 Induct_on `l1` >-
2730 rw[] >>
2731 rpt strip_tac >>
2732 Cases_on `l2` >-
2733 fs[] >>
2734 Cases_on `l3` >-
2735 fs[] >>
2736 fs[] >-
2737 metis_tac[] >>
2738 metis_tac[MEM]
2739QED
2740
2741(* Theorem: SUM (MAP (K c) ls) = c * LENGTH ls *)
2742(* Proof:
2743 By induction on ls.
2744 Base: !c. SUM (MAP (K c) []) = c * LENGTH []
2745 LHS = SUM (MAP (K c) [])
2746 = SUM [] = 0 by MAP, SUM
2747 RHS = c * LENGTH []
2748 = c * 0 = 0 = LHS by LENGTH
2749 Step: !c. SUM (MAP (K c) ls) = c * LENGTH ls ==>
2750 !h c. SUM (MAP (K c) (h::ls)) = c * LENGTH (h::ls)
2751 SUM (MAP (K c) (h::ls))
2752 = SUM (c :: MAP (K c) ls) by MAP
2753 = c + SUM (MAP (K c) ls) by SUM
2754 = c + c * LENGTH ls by induction hypothesis
2755 = c * (1 + LENGTH ls) by RIGHT_ADD_DISTRIB
2756 = c * (SUC (LENGTH ls)) by ADD1
2757 = c * LENGTH (h::ls) by LENGTH
2758*)
2759Theorem SUM_MAP_K:
2760 !ls c. SUM (MAP (K c) ls) = c * LENGTH ls
2761Proof
2762 Induct >-
2763 rw[] >>
2764 rw[ADD1]
2765QED
2766
2767(* Theorem: a <= b ==> SUM (MAP (K a) ls) <= SUM (MAP (K b) ls) *)
2768(* Proof:
2769 SUM (MAP (K a) ls)
2770 = a * LENGTH ls by SUM_MAP_K
2771 <= b * LENGTH ls by a <= b
2772 = SUM (MAP (K b) ls) by SUM_MAP_K
2773*)
2774Theorem SUM_MAP_K_LE:
2775 !ls a b. a <= b ==> SUM (MAP (K a) ls) <= SUM (MAP (K b) ls)
2776Proof
2777 rw[SUM_MAP_K]
2778QED
2779
2780(* Theorem: SUM (MAP2 (\x y. c) lx ly) = c * LENGTH (MAP2 (\x y. c) lx ly) *)
2781(* Proof:
2782 By induction on lx.
2783 Base: !ly c. SUM (MAP2 (\x y. c) [] ly) = c * LENGTH (MAP2 (\x y. c) [] ly)
2784 LHS = SUM (MAP2 (\x y. c) [] ly)
2785 = SUM [] = 0 by MAP2_DEF, SUM
2786 RHS = c * LENGTH (MAP2 (\x y. c) [] ly)
2787 = c * 0 = 0 = LHS by MAP2_DEF, LENGTH
2788 Step: !ly c. SUM (MAP2 (\x y. c) lx ly) = c * LENGTH (MAP2 (\x y. c) lx ly) ==>
2789 !h ly c. SUM (MAP2 (\x y. c) (h::lx) ly) = c * LENGTH (MAP2 (\x y. c) (h::lx) ly)
2790 If ly = [],
2791 to show: SUM (MAP2 (\x y. c) (h::lx) []) = c * LENGTH (MAP2 (\x y. c) (h::lx) [])
2792 LHS = SUM (MAP2 (\x y. c) (h::lx) [])
2793 = SUM [] = 0 by MAP2_DEF, SUM
2794 RHS = c * LENGTH (MAP2 (\x y. c) (h::lx) [])
2795 = c * 0 = 0 = LHS by MAP2_DEF, LENGTH
2796 Otherwise, ly = h'::t,
2797 to show: SUM (MAP2 (\x y. c) (h::lx) (h'::t)) = c * LENGTH (MAP2 (\x y. c) (h::lx) (h'::t))
2798
2799 SUM (MAP2 (\x y. c) (h::lx) (h'::t))
2800 = SUM (c :: MAP2 (\x y. c) lx t) by MAP2_DEF
2801 = c + SUM (MAP2 (\x y. c) lx t) by SUM
2802 = c + c * LENGTH (MAP2 (\x y. c) lx t) by induction hypothesis
2803 = c * (1 + LENGTH (MAP2 (\x y. c) lx t) by RIGHT_ADD_DISTRIB
2804 = c * (SUC (LENGTH (MAP2 (\x y. c) lx t)) by ADD1
2805 = c * LENGTH (MAP2 (\x y. c) (h::lx) (h'::t)) by LENGTH
2806*)
2807Theorem SUM_MAP2_K:
2808 !lx ly c. SUM (MAP2 (\x y. c) lx ly) = c * LENGTH (MAP2 (\x y. c) lx ly)
2809Proof
2810 Induct >-
2811 rw[] >>
2812 rpt strip_tac >>
2813 Cases_on `ly` >-
2814 rw[] >>
2815 rw[ADD1, MIN_DEF]
2816QED
2817
2818(* Theorem: SUM (MAP3 (\x y z. c) lx ly lz) = c * LENGTH (MAP3 (\x y z. c) lx ly lz) *)
2819(* Proof:
2820 By induction on lx.
2821 Base: !ly lz c. SUM (MAP3 (\x y z. c) [] ly lz) = c * LENGTH (MAP3 (\x y z. c) [] ly lz)
2822 LHS = SUM (MAP3 (\x y z. c) [] ly lz)
2823 = SUM [] = 0 by MAP3_DEF, SUM
2824 RHS = c * LENGTH (MAP3 (\x y z. c) [] ly lz)
2825 = c * 0 = 0 = LHS by MAP3_DEF, LENGTH
2826 Step: !ly lz c. SUM (MAP3 (\x y z. c) lx ly lz) = c * LENGTH (MAP3 (\x y z. c) lx ly lz) ==>
2827 !h ly lz c. SUM (MAP3 (\x y z. c) (h::lx) ly lz) = c * LENGTH (MAP3 (\x y z. c) (h::lx) ly lz)
2828 If ly = [],
2829 to show: SUM (MAP3 (\x y z. c) (h::lx) [] lz) = c * LENGTH (MAP3 (\x y z. c) (h::lx) [] lz)
2830 LHS = SUM (MAP3 (\x y z. c) (h::lx) [] lz)
2831 = SUM [] = 0 by MAP3_DEF, SUM
2832 RHS = c * LENGTH (MAP3 (\x y z. c) (h::lx) [] lz)
2833 = c * 0 = 0 = LHS by MAP3_DEF, LENGTH
2834 Otherwise, ly = h'::t,
2835 to show: SUM (MAP3 (\x y z. c) (h::lx) (h'::t) lz) = c * LENGTH (MAP3 (\x y z. c) (h::lx) (h'::t) lz)
2836 If lz = [],
2837 to show: SUM (MAP3 (\x y z. c) (h::lx) (h'::t) []) = c * LENGTH (MAP3 (\x y z. c) (h::lx) (h'::t) [])
2838 LHS = SUM (MAP3 (\x y z. c) (h::lx) (h'::t) [])
2839 = SUM [] = 0 by MAP3_DEF, SUM
2840 RHS = c * LENGTH (MAP3 (\x y z. c) (h::lx) (h'::t) [])
2841 = c * 0 = 0 by MAP3_DEF, LENGTH
2842 Otherwise, lz = h''::t',
2843 to show: SUM (MAP3 (\x y z. c) (h::lx) (h'::t) (h''::t')) = c * LENGTH (MAP3 (\x y z. c) (h::lx) (h'::t) (h''::t'))
2844 SUM (MAP3 (\x y z. c) (h::lx) (h'::t) (h''::t'))
2845 = SUM (c :: MAP3 (\x y z. c) lx t t') by MAP3_DEF
2846 = c + SUM (MAP3 (\x y z. c) lx t t') by SUM
2847 = c + c * LENGTH (MAP3 (\x y z. c) lx t t') by induction hypothesis
2848 = c * (1 + LENGTH (MAP3 (\x y z. c) lx t t') by RIGHT_ADD_DISTRIB
2849 = c * (SUC (LENGTH (MAP3 (\x y z. c) lx t t')) by ADD1
2850 = c * LENGTH (MAP3 (\x y z. c) (h::lx) (h'::t) (h''::t')) by LENGTH
2851*)
2852Theorem SUM_MAP3_K:
2853 !lx ly lz c. SUM (MAP3 (\x y z. c) lx ly lz) = c * LENGTH (MAP3 (\x y z. c) lx ly lz)
2854Proof
2855 Induct >-
2856 rw[] >>
2857 rpt strip_tac >>
2858 Cases_on `ly` >-
2859 rw[] >>
2860 Cases_on `lz` >-
2861 rw[] >>
2862 rw[ADD1]
2863QED
2864
2865(* ------------------------------------------------------------------------- *)
2866(* Bounds on Lists *)
2867(* ------------------------------------------------------------------------- *)
2868
2869(* Theorem: SUM ls <= (MAX_LIST ls) * LENGTH ls *)
2870(* Proof:
2871 By induction on ls.
2872 Base: SUM [] <= MAX_LIST [] * LENGTH []
2873 LHS = SUM [] = 0 by SUM
2874 RHS = MAX_LIST [] * LENGTH []
2875 = 0 * 0 = 0 by MAX_LIST, LENGTH
2876 Hence true.
2877 Step: SUM ls <= MAX_LIST ls * LENGTH ls ==>
2878 !h. SUM (h::ls) <= MAX_LIST (h::ls) * LENGTH (h::ls)
2879 SUM (h::ls)
2880 = h + SUM ls by SUM
2881 <= h + MAX_LIST ls * LENGTH ls by induction hypothesis
2882 <= MAX_LIST (h::ls) + MAX_LIST ls * LENGTH ls by MAX_LIST_PROPERTY
2883 <= MAX_LIST (h::ls) + MAX_LIST (h::ls) * LENGTH ls by MAX_LIST_LE
2884 = MAX_LIST (h::ls) * (1 + LENGTH ls) by LEFT_ADD_DISTRIB
2885 = MAX_LIST (h::ls) * LENGTH (h::ls) by LENGTH
2886*)
2887Theorem SUM_UPPER:
2888 !ls. SUM ls <= (MAX_LIST ls) * LENGTH ls
2889Proof
2890 Induct_on `ls` >-
2891 rw[] >>
2892 strip_tac >>
2893 `SUM (h::ls) <= h + MAX_LIST ls * LENGTH ls` by rw[] >>
2894 `h + MAX_LIST ls * LENGTH ls <= MAX_LIST (h::ls) + MAX_LIST ls * LENGTH ls` by rw[] >>
2895 `MAX_LIST (h::ls) + MAX_LIST ls * LENGTH ls <= MAX_LIST (h::ls) + MAX_LIST (h::ls) * LENGTH ls` by rw[] >>
2896 `MAX_LIST (h::ls) + MAX_LIST (h::ls) * LENGTH ls = MAX_LIST (h::ls) * (1 + LENGTH ls)` by rw[] >>
2897 `_ = MAX_LIST (h::ls) * LENGTH (h::ls)` by rw[] >>
2898 decide_tac
2899QED
2900
2901(* Theorem: (MIN_LIST ls) * LENGTH ls <= SUM ls *)
2902(* Proof:
2903 By induction on ls.
2904 Base: MIN_LIST [] * LENGTH [] <= SUM []
2905 LHS = (MIN_LIST []) * LENGTH [] = 0 by LENGTH
2906 RHS = SUM [] = 0 by SUM
2907 Hence true.
2908 Step: MIN_LIST ls * LENGTH ls <= SUM ls ==>
2909 !h. MIN_LIST (h::ls) * LENGTH (h::ls) <= SUM (h::ls)
2910 If ls = [],
2911 LHS = (MIN_LIST [h]) * LENGTH [h]
2912 = h * 1 = h by MIN_LIST_def, LENGTH
2913 RHS = SUM [h] = h by SUM
2914 Hence true.
2915 If ls <> [],
2916 MIN_LIST (h::ls) * LENGTH (h::ls)
2917 = (MIN h (MIN_LIST ls)) * (1 + LENGTH ls) by MIN_LIST_def, LENGTH
2918 = (MIN h (MIN_LIST ls)) + (MIN h (MIN_LIST ls)) * LENGTH ls
2919 by RIGHT_ADD_DISTRIB
2920 <= h + (MIN_LIST ls) * LENGTH ls by MIN_IS_MIN
2921 <= h + SUM ls by induction hypothesis
2922 = SUM (h::ls) by SUM
2923*)
2924Theorem SUM_LOWER:
2925 !ls. (MIN_LIST ls) * LENGTH ls <= SUM ls
2926Proof
2927 Induct_on `ls` >-
2928 rw[] >>
2929 strip_tac >>
2930 Cases_on `ls = []` >-
2931 rw[] >>
2932 `MIN_LIST (h::ls) * LENGTH (h::ls) = (MIN h (MIN_LIST ls)) * (1 + LENGTH ls)` by rw[] >>
2933 `_ = (MIN h (MIN_LIST ls)) + (MIN h (MIN_LIST ls)) * LENGTH ls` by rw[] >>
2934 `(MIN h (MIN_LIST ls)) <= h` by rw[] >>
2935 `(MIN h (MIN_LIST ls)) * LENGTH ls <= (MIN_LIST ls) * LENGTH ls` by rw[] >>
2936 rw[]
2937QED
2938
2939(* Theorem: EVERY (\x. f x <= g x) ls ==> SUM (MAP f ls) <= SUM (MAP g ls) *)
2940(* Proof:
2941 By induction on ls.
2942 Base: EVERY (\x. f x <= g x) [] ==> SUM (MAP f []) <= SUM (MAP g [])
2943 EVERY (\x. f x <= g x) [] = T by EVERY_DEF
2944 SUM (MAP f [])
2945 = SUM [] by MAP
2946 = SUM (MAP g []) by MAP
2947 Step: EVERY (\x. f x <= g x) ls ==> SUM (MAP f ls) <= SUM (MAP g ls) ==>
2948 !h. EVERY (\x. f x <= g x) (h::ls) ==> SUM (MAP f (h::ls)) <= SUM (MAP g (h::ls))
2949 Note f h <= g h /\
2950 EVERY (\x. f x <= g x) ls by EVERY_DEF
2951 SUM (MAP f (h::ls))
2952 = SUM (f h :: MAP f ls) by MAP
2953 = f h + SUM (MAP f ls) by SUM
2954 <= g h + SUM (MAP g ls) by above, induction hypothesis
2955 = SUM (g h :: MAP g ls) by SUM
2956 = SUM (MAP g (h::ls)) by MAP
2957*)
2958Theorem SUM_MAP_LE:
2959 !f g ls. EVERY (\x. f x <= g x) ls ==> SUM (MAP f ls) <= SUM (MAP g ls)
2960Proof
2961 rpt strip_tac >>
2962 Induct_on `ls` >>
2963 rw[] >>
2964 rw[] >>
2965 fs[]
2966QED
2967
2968(* Theorem: EVERY (\x. f x < g x) ls /\ ls <> [] ==> SUM (MAP f ls) < SUM (MAP g ls) *)
2969(* Proof:
2970 By induction on ls.
2971 Base: EVERY (\x. f x <= g x) [] /\ [] <> [] ==> SUM (MAP f []) <= SUM (MAP g [])
2972 True since [] <> [] = F.
2973 Step: EVERY (\x. f x <= g x) ls ==> ls <> [] ==> SUM (MAP f ls) <= SUM (MAP g ls) ==>
2974 !h. EVERY (\x. f x <= g x) (h::ls) ==> h::ls <> [] ==> SUM (MAP f (h::ls)) <= SUM (MAP g (h::ls))
2975 Note f h < g h /\
2976 EVERY (\x. f x < g x) ls by EVERY_DEF
2977
2978 If ls = [],
2979 SUM (MAP f [h])
2980 = SUM (f h) by MAP
2981 = f h by SUM
2982 < g h by above
2983 = SUM (g h) by SUM
2984 = SUM (MAP g [h]) by MAP
2985
2986 If ls <> [],
2987 SUM (MAP f (h::ls))
2988 = SUM (f h :: MAP f ls) by MAP
2989 = f h + SUM (MAP f ls) by SUM
2990 < g h + SUM (MAP g ls) by induction hypothesis
2991 = SUM (g h :: MAP g ls) by SUM
2992 = SUM (MAP g (h::ls)) by MAP
2993*)
2994Theorem SUM_MAP_LT:
2995 !f g ls. EVERY (\x. f x < g x) ls /\ ls <> [] ==> SUM (MAP f ls) < SUM (MAP g ls)
2996Proof
2997 rpt strip_tac >>
2998 Induct_on `ls` >>
2999 rw[] >>
3000 rw[] >>
3001 (Cases_on `ls = []` >> fs[])
3002QED
3003
3004(*
3005MAX_LIST_PROPERTY |- !l x. MEM x l ==> x <= MAX_LIST l
3006MIN_LIST_PROPERTY |- !l. l <> [] ==> !x. MEM x l ==> MIN_LIST l <= x
3007*)
3008
3009(* Theorem: MONO f ==> !ls e. MEM e (MAP f ls) ==> e <= f (MAX_LIST ls) *)
3010(* Proof:
3011 Note ?y. (e = f y) /\ MEM y ls by MEM_MAP
3012 and y <= MAX_LIST ls by MAX_LIST_PROPERTY
3013 Thus f y <= f (MAX_LIST ls) by given
3014 or e <= f (MAX_LIST ls) by e = f y
3015*)
3016Theorem MEM_MAP_UPPER:
3017 !f. MONO f ==> !ls e. MEM e (MAP f ls) ==> e <= f (MAX_LIST ls)
3018Proof
3019 rpt strip_tac >>
3020 `?y. (e = f y) /\ MEM y ls` by rw[GSYM MEM_MAP] >>
3021 `y <= MAX_LIST ls` by rw[MAX_LIST_PROPERTY] >>
3022 rw[]
3023QED
3024
3025(* Theorem: MONO2 f ==> !lx ly e. MEM e (MAP2 f lx ly) ==> e <= f (MAX_LIST lx) (MAX_LIST ly) *)
3026(* Proof:
3027 Note ?ex ey. (e = f ex ey) /\
3028 MEM ex lx /\ MEM ey ly by MEM_MAP2
3029 and ex <= MAX_LIST lx by MAX_LIST_PROPERTY
3030 and ey <= MAX_LIST ly by MAX_LIST_PROPERTY
3031 The result follows by the non-decreasing condition on f.
3032*)
3033Theorem MEM_MAP2_UPPER:
3034 !f. MONO2 f ==> !lx ly e. MEM e (MAP2 f lx ly) ==> e <= f (MAX_LIST lx) (MAX_LIST ly)
3035Proof
3036 metis_tac[MEM_MAP2, MAX_LIST_PROPERTY]
3037QED
3038
3039(* Theorem: MONO3 f ==>
3040 !lx ly lz e. MEM e (MAP3 f lx ly lz) ==> e <= f (MAX_LIST lx) (MAX_LIST ly) (MAX_LIST lz) *)
3041(* Proof:
3042 Note ?ex ey ez. (e = f ex ey ez) /\
3043 MEM ex lx /\ MEM ey ly /\ MEM ez lz by MEM_MAP3
3044 and ex <= MAX_LIST lx by MAX_LIST_PROPERTY
3045 and ey <= MAX_LIST ly by MAX_LIST_PROPERTY
3046 and ez <= MAX_LIST lz by MAX_LIST_PROPERTY
3047 The result follows by the non-decreasing condition on f.
3048*)
3049Theorem MEM_MAP3_UPPER:
3050 !f. MONO3 f ==>
3051 !lx ly lz e. MEM e (MAP3 f lx ly lz) ==> e <= f (MAX_LIST lx) (MAX_LIST ly) (MAX_LIST lz)
3052Proof
3053 metis_tac[MEM_MAP3, MAX_LIST_PROPERTY]
3054QED
3055
3056(* Theorem: MONO f ==> !ls e. MEM e (MAP f ls) ==> f (MIN_LIST ls) <= e *)
3057(* Proof:
3058 Note ?y. (e = f y) /\ MEM y ls by MEM_MAP
3059 and ls <> [] by MEM, MEM y ls
3060 then MIN_LIST ls <= y by MIN_LIST_PROPERTY, ls <> []
3061 Thus f (MIN_LIST ls) <= f y by given
3062 or f (MIN_LIST ls) <= e by e = f y
3063*)
3064Theorem MEM_MAP_LOWER:
3065 !f. MONO f ==> !ls e. MEM e (MAP f ls) ==> f (MIN_LIST ls) <= e
3066Proof
3067 rpt strip_tac >>
3068 `?y. (e = f y) /\ MEM y ls` by rw[GSYM MEM_MAP] >>
3069 `ls <> []` by metis_tac[MEM] >>
3070 `MIN_LIST ls <= y` by rw[MIN_LIST_PROPERTY] >>
3071 rw[]
3072QED
3073
3074(* Theorem: MONO2 f ==>
3075 !lx ly e. MEM e (MAP2 f lx ly) ==> f (MIN_LIST lx) (MIN_LIST ly) <= e *)
3076(* Proof:
3077 Note ?ex ey. (e = f ex ey) /\
3078 MEM ex lx /\ MEM ey ly by MEM_MAP2
3079 and lx <> [] /\ ly <> [] by MEM
3080 and MIN_LIST lx <= ex by MIN_LIST_PROPERTY
3081 and MIN_LIST ly <= ey by MIN_LIST_PROPERTY
3082 The result follows by the non-decreasing condition on f.
3083*)
3084Theorem MEM_MAP2_LOWER:
3085 !f. MONO2 f ==>
3086 !lx ly e. MEM e (MAP2 f lx ly) ==> f (MIN_LIST lx) (MIN_LIST ly) <= e
3087Proof
3088 metis_tac[MEM_MAP2, MEM, MIN_LIST_PROPERTY]
3089QED
3090
3091(* Theorem: MONO3 f ==>
3092 !lx ly lz e. MEM e (MAP3 f lx ly lz) ==> f (MIN_LIST lx) (MIN_LIST ly) (MIN_LIST lz) <= e *)
3093(* Proof:
3094 Note ?ex ey ez. (e = f ex ey ez) /\
3095 MEM ex lx /\ MEM ey ly /\ MEM ez lz by MEM_MAP3
3096 and lx <> [] /\ ly <> [] /\ lz <> [] by MEM
3097 and MIN_LIST lx <= ex by MIN_LIST_PROPERTY
3098 and MIN_LIST ly <= ey by MIN_LIST_PROPERTY
3099 and MIN_LIST lz <= ez by MIN_LIST_PROPERTY
3100 The result follows by the non-decreasing condition on f.
3101*)
3102Theorem MEM_MAP3_LOWER:
3103 !f. MONO3 f ==>
3104 !lx ly lz e. MEM e (MAP3 f lx ly lz) ==> f (MIN_LIST lx) (MIN_LIST ly) (MIN_LIST lz) <= e
3105Proof
3106 rpt strip_tac >>
3107 `?ex ey ez. (e = f ex ey ez) /\ MEM ex lx /\ MEM ey ly /\ MEM ez lz` by rw[MEM_MAP3] >>
3108 `lx <> [] /\ ly <> [] /\ lz <> []` by metis_tac[MEM] >>
3109 rw[MIN_LIST_PROPERTY]
3110QED
3111
3112(* Theorem: (!x. f x <= g x) ==> !ls n. EL n (MAP f ls) <= EL n (MAP g ls) *)
3113(* Proof:
3114 By induction on ls.
3115 Base: !n. EL n (MAP f []) <= EL n (MAP g [])
3116 LHS = EL n [] = RHS by MAP
3117 Step: !n. EL n (MAP f ls) <= EL n (MAP g ls) ==>
3118 !h n. EL n (MAP f (h::ls)) <= EL n (MAP g (h::ls))
3119 If n = 0,
3120 EL 0 (MAP f (h::ls))
3121 = EL 0 (f h::MAP f ls) by MAP
3122 = f h by EL
3123 <= g h by given
3124 = EL 0 (g h::MAP g ls) by EL
3125 = EL 0 (MAP g (h::ls)) by MAP
3126 If n <> 0, then n = SUC k by num_CASES
3127 EL n (MAP f (h::ls))
3128 = EL (SUC k) (f h::MAP f ls) by MAP
3129 = EL k (MAP f ls) by EL
3130 <= EL k (MAP g ls) by induction hypothesis
3131 = EL (SUC k) (g h::MAP g ls) by EL
3132 = EL n (MAP g (h::ls)) by MAP
3133*)
3134Theorem MAP_LE:
3135 !(f:num -> num) g. (!x. f x <= g x) ==> !ls n. EL n (MAP f ls) <= EL n (MAP g ls)
3136Proof
3137 ntac 3 strip_tac >>
3138 Induct_on `ls` >-
3139 rw[] >>
3140 Cases_on `n` >-
3141 rw[] >>
3142 rw[]
3143QED
3144
3145(* Theorem: (!x y. f x y <= g x y) ==> !lx ly n. EL n (MAP2 f lx ly) <= EL n (MAP2 g lx ly) *)
3146(* Proof:
3147 By induction on lx.
3148 Base: !ly n. EL n (MAP2 f [] ly) <= EL n (MAP2 g [] ly)
3149 LHS = EL n [] = RHS by MAP2_DEF
3150 Step: !ly n. EL n (MAP2 f lx ly) <= EL n (MAP2 g lx ly) ==>
3151 !h ly n. EL n (MAP2 f (h::lx) ly) <= EL n (MAP2 g (h::lx) ly)
3152 If ly = [],
3153 to show: EL n (MAP2 f (h::lx) []) <= EL n (MAP2 g (h::lx) [])
3154 True since LHS = EL n [] = RHS by MAP2_DEF
3155 Otherwise, ly = h'::t.
3156 to show: EL n (MAP2 f (h::lx) (h'::t)) <= EL n (MAP2 g (h::lx) (h'::t))
3157 If n = 0,
3158 EL 0 (MAP2 f (h::lx) (h'::t))
3159 = EL 0 (f h h'::MAP2 f lx t) by MAP2
3160 = f h h' by EL
3161 <= g h h' by given
3162 = EL 0 (g h h'::MAP2 g lx t) by EL
3163 = EL 0 (MAP2 g (h::lx) (h'::t)) by MAP2
3164 If n <> 0, then n = SUC k by num_CASES
3165 EL n (MAP2 f (h::lx) (h'::t))
3166 = EL (SUC k) (f h h'::MAP2 f lx t) by MAP2
3167 = EL k (MAP2 f lx t) by EL
3168 <= EL k (MAP2 g lx t) by induction hypothesis
3169 = EL (SUC k) (g h h'::MAP2 g lx t) by EL
3170 = EL n (MAP2 g (h::lx) (h'::t)) by MAP2
3171*)
3172Theorem MAP2_LE:
3173 !(f:num -> num -> num) g. (!x y. f x y <= g x y) ==>
3174 !lx ly n. EL n (MAP2 f lx ly) <= EL n (MAP2 g lx ly)
3175Proof
3176 ntac 3 strip_tac >>
3177 Induct_on `lx` >-
3178 rw[] >>
3179 rpt strip_tac >>
3180 Cases_on `ly` >-
3181 rw[] >>
3182 Cases_on `n` >-
3183 rw[] >>
3184 rw[]
3185QED
3186
3187(* Theorem: (!x y z. f x y z <= g x y z) ==>
3188 !lx ly lz n. EL n (MAP3 f lx ly lz) <= EL n (MAP3 g lx ly lz) *)
3189(* Proof:
3190 By induction on lx.
3191 Base: !ly lz n. EL n (MAP3 f [] ly lz) <= EL n (MAP3 g [] ly lz)
3192 LHS = EL n [] = RHS by MAP3_DEF
3193 Step: !ly lz n. EL n (MAP3 f lx ly lz) <= EL n (MAP3 g lx ly lz) ==>
3194 !h ly lz n. EL n (MAP3 f (h::lx) ly lz) <= EL n (MAP3 g (h::lx) ly lz)
3195 If ly = [],
3196 to show: EL n (MAP3 f (h::lx) [] lz) <= EL n (MAP3 g (h::lx) [] lz)
3197 True since LHS = EL n [] = RHS by MAP3_DEF
3198 Otherwise, ly = h'::t.
3199 to show: EL n (MAP3 f (h::lx) (h'::t) lz) <= EL n (MAP3 g (h::lx) (h'::t) lz)
3200 If lz = [],
3201 to show: EL n (MAP3 f (h::lx) (h'::t) []) <= EL n (MAP3 g (h::lx) (h'::t) [])
3202 True since LHS = EL n [] = RHS by MAP3_DEF
3203 Otherwise, lz = h''::t'.
3204 to show: EL n (MAP3 f (h::lx) (h'::t) (h''::t')) <= EL n (MAP3 g (h::lx) (h'::t) (h''::t'))
3205 If n = 0,
3206 EL 0 (MAP3 f (h::lx) (h'::t) (h''::t'))
3207 = EL 0 (f h h' h''::MAP3 f lx t t') by MAP3
3208 = f h h' h'' by EL
3209 <= g h h' h'' by given
3210 = EL 0 (g h h' h''::MAP3 g lx t t') by EL
3211 = EL 0 (MAP3 g (h::lx) (h'::t) (h''::t')) by MAP3
3212 If n <> 0, then n = SUC k by num_CASES
3213 EL n (MAP3 f (h::lx) (h'::t) (h''::t'))
3214 = EL (SUC k) (f h h' h''::MAP3 f lx t t') by MAP3
3215 = EL k (MAP3 f lx t t') by EL
3216 <= EL k (MAP3 g lx t t') by induction hypothesis
3217 = EL (SUC k) (g h h' h''::MAP3 g lx t t') by EL
3218 = EL n (MAP3 g (h::lx) (h'::t) (h''::t')) by MAP3
3219*)
3220Theorem MAP3_LE:
3221 !(f:num -> num -> num -> num) g. (!x y z. f x y z <= g x y z) ==>
3222 !lx ly lz n. EL n (MAP3 f lx ly lz) <= EL n (MAP3 g lx ly lz)
3223Proof
3224 ntac 3 strip_tac >>
3225 Induct_on `lx` >-
3226 rw[] >>
3227 rpt strip_tac >>
3228 Cases_on `ly` >-
3229 rw[] >>
3230 Cases_on `lz` >-
3231 rw[] >>
3232 Cases_on `n` >-
3233 rw[] >>
3234 rw[]
3235QED
3236
3237(*
3238SUM_MAP_PLUS |- !f g ls. SUM (MAP (\x. f x + g x) ls) = SUM (MAP f ls) + SUM (MAP g ls)
3239SUM_MAP_PLUS_ZIP |- !ls1 ls2. LENGTH ls1 = LENGTH ls2 /\ (!x y. f (x,y) = g x + h y) ==>
3240 SUM (MAP f (ZIP (ls1,ls2))) = SUM (MAP g ls1) + SUM (MAP h ls2)
3241*)
3242
3243(* Theorem: (!x. f1 x <= f2 x) ==> !ls. SUM (MAP f1 ls) <= SUM (MAP f2 ls) *)
3244(* Proof:
3245 By SUM_LE, this is to show:
3246 (1) !k. k < LENGTH (MAP f1 ls) ==> EL k (MAP f1 ls) <= EL k (MAP f2 ls)
3247 This is true by EL_MAP
3248 (2) LENGTH (MAP f1 ls) = LENGTH (MAP f2 ls)
3249 This is true by LENGTH_MAP
3250*)
3251Theorem SUM_MONO_MAP:
3252 !f1 f2. (!x. f1 x <= f2 x) ==> !ls. SUM (MAP f1 ls) <= SUM (MAP f2 ls)
3253Proof
3254 rpt strip_tac >>
3255 irule SUM_LE >>
3256 rw[EL_MAP]
3257QED
3258
3259(* Theorem: (!x y. f1 x y <= f2 x y) ==> !lx ly. SUM (MAP2 f1 lx ly) <= SUM (MAP2 f2 lx ly) *)
3260(* Proof:
3261 By SUM_LE, this is to show:
3262 (1) !k. k < LENGTH (MAP2 f1 lx ly) ==> EL k (MAP2 f1 lx ly) <= EL k (MAP2 f2 lx ly)
3263 This is true by EL_MAP2, LENGTH_MAP2
3264 (2) LENGTH (MAP2 f1 lx ly) = LENGTH (MAP2 f2 lx ly)
3265 This is true by LENGTH_MAP2
3266*)
3267Theorem SUM_MONO_MAP2:
3268 !f1 f2. (!x y. f1 x y <= f2 x y) ==> !lx ly. SUM (MAP2 f1 lx ly) <= SUM (MAP2 f2 lx ly)
3269Proof
3270 rpt strip_tac >>
3271 irule SUM_LE >>
3272 rw[EL_MAP2]
3273QED
3274
3275(* 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) *)
3276(* Proof:
3277 By SUM_LE, this is to show:
3278 (1) !k. k < LENGTH (MAP3 f1 lx ly lz) ==> EL k (MAP3 f1 lx ly lz) <= EL k (MAP3 f2 lx ly lz)
3279 This is true by EL_MAP3, LENGTH_MAP3
3280 (2)LENGTH (MAP3 f1 lx ly lz) = LENGTH (MAP3 f2 lx ly lz)
3281 This is true by LENGTH_MAP3
3282*)
3283Theorem SUM_MONO_MAP3:
3284 !f1 f2. (!x y z. f1 x y z <= f2 x y z) ==>
3285 !lx ly lz. SUM (MAP3 f1 lx ly lz) <= SUM (MAP3 f2 lx ly lz)
3286Proof
3287 rpt strip_tac >>
3288 irule SUM_LE >>
3289 rw[EL_MAP3, LENGTH_MAP3]
3290QED
3291
3292(* Theorem: MONO f ==> !ls. SUM (MAP f ls) <= f (MAX_LIST ls) * LENGTH ls *)
3293(* Proof:
3294 Let c = f (MAX_LIST ls).
3295
3296 Claim: SUM (MAP f ls) <= SUM (MAP (K c) ls)
3297 Proof: By SUM_LE, this is to show:
3298 (1) LENGTH (MAP f ls) = LENGTH (MAP (K c) ls)
3299 This is true by LENGTH_MAP
3300 (2) !k. k < LENGTH (MAP f ls) ==> EL k (MAP f ls) <= EL k (MAP (K c) ls)
3301 Note EL k (MAP f ls) = f (EL k ls) by EL_MAP
3302 and EL k (MAP (K c) ls)
3303 = (K c) (EL k ls) by EL_MAP
3304 = c by K_THM
3305 Now MEM (EL k ls) ls by EL_MEM
3306 so EL k ls <= MAX_LIST ls by MAX_LIST_PROPERTY
3307 Thus f (EL k ls) <= c by property of f
3308
3309 Note SUM (MAP (K c) ls) = c * LENGTH ls by SUM_MAP_K
3310 Thus SUM (MAP f ls) <= c * LENGTH ls by Claim
3311*)
3312Theorem SUM_MAP_UPPER:
3313 !f. MONO f ==> !ls. SUM (MAP f ls) <= f (MAX_LIST ls) * LENGTH ls
3314Proof
3315 rpt strip_tac >>
3316 qabbrev_tac `c = f (MAX_LIST ls)` >>
3317 `SUM (MAP f ls) <= SUM (MAP (K c) ls)` by
3318 ((irule SUM_LE >> rw[]) >>
3319 rw[EL_MAP, EL_MEM, MAX_LIST_PROPERTY, Abbr`c`]) >>
3320 `SUM (MAP (K c) ls) = c * LENGTH ls` by rw[SUM_MAP_K] >>
3321 decide_tac
3322QED
3323
3324(* Theorem: MONO2 f ==>
3325 !lx ly. SUM (MAP2 f lx ly) <= (f (MAX_LIST lx) (MAX_LIST ly)) * LENGTH (MAP2 f lx ly) *)
3326(* Proof:
3327 Let c = f (MAX_LIST lx) (MAX_LIST ly).
3328
3329 Claim: SUM (MAP2 f lx ly) <= SUM (MAP2 (\x y. c) lx ly)
3330 Proof: By SUM_LE, this is to show:
3331 (1) LENGTH (MAP2 f lx ly) = LENGTH (MAP2 (\x y. c) lx ly)
3332 This is true by LENGTH_MAP2
3333 (2) !k. k < LENGTH (MAP2 f lx ly) ==> EL k (MAP2 f lx ly) <= EL k (MAP2 (\x y. c) lx ly)
3334 Note EL k (MAP2 f lx ly)
3335 = f (EL k lx) (EL k ly) by EL_MAP2
3336 and EL k (MAP2 (\x y. c) lx ly)
3337 = (\x y. c) (EL k lx) (EL k ly) by EL_MAP2
3338 = c by function application
3339 Note k < LENGTH lx, k < LENGTH ly by LENGTH_MAP2
3340 Now MEM (EL k lx) lx by EL_MEM
3341 and MEM (EL k ly) ly by EL_MEM
3342 so EL k lx <= MAX_LIST lx by MAX_LIST_PROPERTY
3343 and EL k ly <= MAX_LIST ly by MAX_LIST_PROPERTY
3344 Thus f (EL k lx) (EL k ly) <= c by property of f
3345
3346 Note SUM (MAP (\x y. c) lx ly) = c * LENGTH (MAP2 (\x y. c) lx ly) by SUM_MAP2_K
3347 and LENGTH (MAP2 (\x y. c) lx ly) = LENGTH (MAP2 f lx ly) by LENGTH_MAP2
3348 Thus SUM (MAP f lx ly) <= c * LENGTH (MAP2 f lx ly) by Claim
3349*)
3350Theorem SUM_MAP2_UPPER:
3351 !f. MONO2 f ==>
3352 !lx ly. SUM (MAP2 f lx ly) <= (f (MAX_LIST lx) (MAX_LIST ly)) * LENGTH (MAP2 f lx ly)
3353Proof
3354 rpt strip_tac >>
3355 qabbrev_tac `c = f (MAX_LIST lx) (MAX_LIST ly)` >>
3356 `SUM (MAP2 f lx ly) <= SUM (MAP2 (\x y. c) lx ly)` by
3357 ((irule SUM_LE >> rw[]) >>
3358 rw[EL_MAP2, EL_MEM, MAX_LIST_PROPERTY, Abbr`c`]) >>
3359 `SUM (MAP2 (\x y. c) lx ly) = c * LENGTH (MAP2 (\x y. c) lx ly)` by rw[SUM_MAP2_K, Abbr`c`] >>
3360 `c * LENGTH (MAP2 (\x y. c) lx ly) = c * LENGTH (MAP2 f lx ly)` by rw[] >>
3361 decide_tac
3362QED
3363
3364(* Theorem: MONO3 f ==>
3365 !lx ly lz. SUM (MAP3 f lx ly lz) <=
3366 f (MAX_LIST lx) (MAX_LIST ly) (MAX_LIST lz) * LENGTH (MAP3 f lx ly lz) *)
3367(* Proof:
3368 Let c = f (MAX_LIST lx) (MAX_LIST ly) (MAX_LIST lz).
3369
3370 Claim: SUM (MAP3 f lx ly lz) <= SUM (MAP3 (\x y z. c) lx ly lz)
3371 Proof: By SUM_LE, this is to show:
3372 (1) LENGTH (MAP3 f lx ly lz) = LENGTH (MAP3 (\x y z. c) lx ly lz)
3373 This is true by LENGTH_MAP3
3374 (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)
3375 Note EL k (MAP3 f lx ly lz)
3376 = f (EL k lx) (EL k ly) (EL k lz) by EL_MAP3
3377 and EL k (MAP3 (\x y z. c) lx ly lz)
3378 = (\x y z. c) (EL k lx) (EL k ly) (EL k lz) by EL_MAP3
3379 = c by function application
3380 Note k < LENGTH lx, k < LENGTH ly, k < LENGTH lz
3381 by LENGTH_MAP3
3382 Now MEM (EL k lx) lx by EL_MEM
3383 and MEM (EL k ly) ly by EL_MEM
3384 and MEM (EL k lz) lz by EL_MEM
3385 so EL k lx <= MAX_LIST lx by MAX_LIST_PROPERTY
3386 and EL k ly <= MAX_LIST ly by MAX_LIST_PROPERTY
3387 and EL k lz <= MAX_LIST lz by MAX_LIST_PROPERTY
3388 Thus f (EL k lx) (EL k ly) (EL k lz) <= c by property of f
3389
3390 Note SUM (MAP (\x y z. c) lx ly lz) = c * LENGTH (MAP3 (\x y z. c) lx ly lz) by SUM_MAP3_K
3391 and LENGTH (MAP3 (\x y z. c) lx ly lz) = LENGTH (MAP3 f lx ly lz) by LENGTH_MAP3
3392 Thus SUM (MAP f lx ly lz) <= c * LENGTH (MAP3 f lx ly lz) by Claim
3393*)
3394Theorem SUM_MAP3_UPPER:
3395 !f. MONO3 f ==>
3396 !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)
3397Proof
3398 rpt strip_tac >>
3399 qabbrev_tac `c = f (MAX_LIST lx) (MAX_LIST ly) (MAX_LIST lz)` >>
3400 `SUM (MAP3 f lx ly lz) <= SUM (MAP3 (\x y z. c) lx ly lz)` by
3401 (`LENGTH (MAP3 f lx ly lz) = LENGTH (MAP3 (\x y z. c) lx ly lz)` by rw[LENGTH_MAP3] >>
3402 (irule SUM_LE >> rw[]) >>
3403 fs[LENGTH_MAP3] >>
3404 rw[EL_MAP3, EL_MEM, MAX_LIST_PROPERTY, Abbr`c`]) >>
3405 `SUM (MAP3 (\x y z. c) lx ly lz) = c * LENGTH (MAP3 (\x y z. c) lx ly lz)` by rw[SUM_MAP3_K] >>
3406 `c * LENGTH (MAP3 (\x y z. c) lx ly lz) = c * LENGTH (MAP3 f lx ly lz)` by rw[LENGTH_MAP3] >>
3407 decide_tac
3408QED
3409
3410(* Theorem: MONO f ==> MONO_INC (GENLIST f n) *)
3411(* Proof:
3412 Let ls = GENLIST f n.
3413 Then LENGTH ls = n by LENGTH_GENLIST
3414 and !k. k < n ==> EL k ls = f k by EL_GENLIST
3415 Thus MONO_INC ls
3416*)
3417Theorem GENLIST_MONO_INC:
3418 !f:num -> num n. MONO f ==> MONO_INC (GENLIST f n)
3419Proof
3420 rw[]
3421QED
3422
3423(* Theorem: RMONO f ==> MONO_DEC (GENLIST f n) *)
3424(* Proof:
3425 Let ls = GENLIST f n.
3426 Then LENGTH ls = n by LENGTH_GENLIST
3427 and !k. k < n ==> EL k ls = f k by EL_GENLIST
3428 Thus MONO_DEC ls
3429*)
3430Theorem GENLIST_MONO_DEC:
3431 !f:num -> num n. RMONO f ==> MONO_DEC (GENLIST f n)
3432Proof
3433 rw[]
3434QED
3435
3436(* Theorem: MONO_INC [m .. n] *)
3437(* Proof:
3438 This is to show:
3439 !j k. j <= k /\ k < LENGTH [m .. n] ==> EL j [m .. n] <= EL k [m .. n]
3440 Note LENGTH [m .. n] = n + 1 - m by listRangeINC_LEN
3441 so m + j <= n by j < LENGTH [m .. n]
3442 ==> EL j [m .. n] = m + j by listRangeINC_EL
3443 also m + k <= n by k < LENGTH [m .. n]
3444 ==> EL k [m .. n] = m + k by listRangeINC_EL
3445 Thus EL j [m .. n] <= EL k [m .. n] by arithmetic
3446*)
3447Theorem listRangeINC_MONO_INC:
3448 !m n. MONO_INC [m .. n]
3449Proof
3450 simp[listRangeINC_EL, listRangeINC_LEN]
3451QED
3452
3453(* Theorem: MONO_INC [m ..< n] *)
3454(* Proof:
3455 This is to show:
3456 !j k. j <= k /\ k < LENGTH [m ..< n] ==> EL j [m ..< n] <= EL k [m ..< n]
3457 Note LENGTH [m ..< n] = n - m by listRangeLHI_LEN
3458 so m + j < n by j < LENGTH [m ..< n]
3459 ==> EL j [m ..< n] = m + j by listRangeLHI_EL
3460 also m + k < n by k < LENGTH [m ..< n]
3461 ==> EL k [m ..< n] = m + k by listRangeLHI_EL
3462 Thus EL j [m ..< n] <= EL k [m ..< n] by arithmetic
3463*)
3464Theorem listRangeLHI_MONO_INC:
3465 !m n. MONO_INC [m ..< n]
3466Proof
3467 simp[listRangeLHI_EL]
3468QED
3469
3470(* ------------------------------------------------------------------------- *)
3471(* List Dilation *)
3472(* ------------------------------------------------------------------------- *)
3473
3474(*
3475Use the concept of dilating a list.
3476
3477Let p = [1;2;3], that is, p = 1 + 2x + 3x^2.
3478Then q = peval p (x^3) is just q = 1 + 2(x^3) + 3(x^3)^2 = [1;0;0;2;0;0;3]
3479
3480DILATE 3 [] = []
3481DILATE 3 (h::t) = [h;0;0] ++ MDILATE 3 t
3482
3483val DILATE_3_DEF = Define`
3484 (DILATE_3 [] = []) /\
3485 (DILATE_3 (h::t) = [h;0;0] ++ (MDILATE_3 t))
3486`;
3487> EVAL ``DILATE_3 [1;2;3]``;
3488val it = |- MDILATE_3 [1; 2; 3] = [1; 0; 0; 2; 0; 0; 3; 0; 0]: thm
3489
3490val DILATE_3_DEF = Define`
3491 (DILATE_3 [] = []) /\
3492 (DILATE_3 [h] = [h]) /\
3493 (DILATE_3 (h::t) = [h;0;0] ++ (MDILATE_3 t))
3494`;
3495> EVAL ``DILATE_3 [1;2;3]``;
3496val it = |- MDILATE_3 [1; 2; 3] = [1; 0; 0; 2; 0; 0; 3]: thm
3497*)
3498
3499(* ------------------------------------------------------------------------- *)
3500(* List Dilation (Multiplicative) *)
3501(* ------------------------------------------------------------------------- *)
3502
3503(* Note:
3504 It would be better to define: MDILATE e n l = inserting n (e)'s,
3505 that is, using GENLIST (K e) n, so that only MDILATE e 0 l = l.
3506 However, the intention is to have later, for polynomials:
3507 peval p (X ** n) = pdilate n p
3508 and since X ** 1 = X, and peval p X = p,
3509 it is desirable to have MDILATE e 1 l = l, with the definition below.
3510
3511 However, the multiplicative feature at the end destroys such an application.
3512*)
3513
3514(* Dilate a list with an element e, for a factor n (n <> 0) *)
3515Definition MDILATE_def:
3516 (MDILATE e n [] = []) /\
3517 (MDILATE e n (h::t) = if t = [] then [h] else (h:: GENLIST (K e) (PRE n)) ++ (MDILATE e n t))
3518End
3519(*
3520> EVAL ``MDILATE 0 2 [1;2;3]``;
3521val it = |- MDILATE 0 2 [1; 2; 3] = [1; 0; 2; 0; 3]: thm
3522> EVAL ``MDILATE 0 3 [1;2;3]``;
3523val it = |- MDILATE 0 3 [1; 2; 3] = [1; 0; 0; 2; 0; 0; 3]: thm
3524> EVAL ``MDILATE #0 3 [a;b;#1]``;
3525val it = |- MDILATE #0 3 [a; b; #1] = [a; #0; #0; b; #0; #0; #1]: thm
3526*)
3527
3528(* Theorem: MDILATE e n [] = [] *)
3529(* Proof: by MDILATE_def *)
3530Theorem MDILATE_NIL[simp]:
3531 !e n. MDILATE e n [] = []
3532Proof
3533 rw[MDILATE_def]
3534QED
3535
3536
3537(* Theorem: MDILATE e n [x] = [x] *)
3538(* Proof: by MDILATE_def *)
3539Theorem MDILATE_SING[simp]:
3540 !e n x. MDILATE e n [x] = [x]
3541Proof
3542 rw[MDILATE_def]
3543QED
3544
3545
3546(* Theorem: MDILATE e n (h::t) =
3547 if t = [] then [h] else (h:: GENLIST (K e) (PRE n)) ++ (MDILATE e n t) *)
3548(* Proof: by MDILATE_def *)
3549Theorem MDILATE_CONS:
3550 !e n h t. MDILATE e n (h::t) =
3551 if t = [] then [h] else (h:: GENLIST (K e) (PRE n)) ++ (MDILATE e n t)
3552Proof
3553 rw[MDILATE_def]
3554QED
3555
3556(* Theorem: MDILATE e 1 l = l *)
3557(* Proof:
3558 By induction on l.
3559 Base: !e. MDILATE e 1 [] = [], true by MDILATE_NIL
3560 Step: !e. MDILATE e 1 l = l ==> !h e. MDILATE e 1 (h::l) = h::l
3561 If l = [],
3562 MDILATE e 1 [h]
3563 = [h] by MDILATE_SING
3564 If l <> [],
3565 MDILATE e 1 (h::l)
3566 = (h:: GENLIST (K e) (PRE 1)) ++ (MDILATE e n l) by MDILATE_CONS
3567 = (h:: GENLIST (K e) (PRE 1)) ++ l by induction hypothesis
3568 = (h:: GENLIST (K e) 0) ++ l by PRE
3569 = [h] ++ l by GENLIST_0
3570 = h::l by CONS_APPEND
3571*)
3572Theorem MDILATE_1:
3573 !l e. MDILATE e 1 l = l
3574Proof
3575 Induct_on `l` >>
3576 rw[MDILATE_def]
3577QED
3578
3579(* Theorem: MDILATE e 0 l = l *)
3580(* Proof:
3581 By induction on l, and note GENLIST (K e) (PRE 0) = GENLIST (K e) 0 = [].
3582*)
3583Theorem MDILATE_0:
3584 !l e. MDILATE e 0 l = l
3585Proof
3586 Induct_on `l` >> rw[MDILATE_def]
3587QED
3588
3589(* Theorem: LENGTH (MDILATE e n l) =
3590 if n = 0 then LENGTH l else if l = [] then 0 else SUC (n * PRE (LENGTH l)) *)
3591(* Proof:
3592 If n = 0,
3593 Then MDILATE e 0 l = l by MDILATE_0
3594 Hence true.
3595 If n <> 0,
3596 Then 0 < n by NOT_ZERO_LT_ZERO
3597 By induction on l.
3598 Base: LENGTH (MDILATE e n []) = if n = 0 then LENGTH [] else if [] = [] then 0 else SUC (n * PRE (LENGTH []))
3599 LENGTH (MDILATE e n [])
3600 = LENGTH [] by MDILATE_NIL
3601 = 0 by LENGTH_NIL
3602 Step: LENGTH (MDILATE e n l) = if n = 0 then LENGTH l else if l = [] then 0 else SUC (n * PRE (LENGTH l)) ==>
3603 !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)))
3604 Note h::l = [] <=> F by NOT_CONS_NIL
3605 If l = [],
3606 LENGTH (MDILATE e n [h])
3607 = LENGTH [h] by MDILATE_SING
3608 = 1 by LENGTH_EQ_1
3609 = SUC 0 by ONE
3610 = SUC (n * 0) by MULT_0
3611 = SUC (n * (PRE (LENGTH [h]))) by LENGTH_EQ_1, PRE_SUC_EQ
3612 If l <> [],
3613 Then LENGTH l <> 0 by LENGTH_NIL
3614 LENGTH (MDILATE e n (h::l))
3615 = LENGTH (h:: GENLIST (K e) (PRE n) ++ MDILATE e n l) by MDILATE_CONS
3616 = LENGTH (h:: GENLIST (K e) (PRE n)) + LENGTH (MDILATE e n l) by LENGTH_APPEND
3617 = n + LENGTH (MDILATE e n l) by LENGTH_GENLIST
3618 = n + SUC (n * PRE (LENGTH l)) by induction hypothesis
3619 = SUC (n + n * PRE (LENGTH l)) by ADD_SUC
3620 = SUC (n * SUC (PRE (LENGTH l))) by MULT_SUC
3621 = SUC (n * LENGTH l) by SUC_PRE, 0 < LENGTH l
3622 = SUC (n * PRE (LENGTH (h::l))) by LENGTH, PRE_SUC_EQ
3623*)
3624Theorem MDILATE_LENGTH:
3625 !l e n. LENGTH (MDILATE e n l) =
3626 if n = 0 then LENGTH l else if l = [] then 0 else SUC (n * PRE (LENGTH l))
3627Proof
3628 rpt strip_tac >>
3629 Cases_on `n = 0` >-
3630 rw[MDILATE_0] >>
3631 `0 < n` by decide_tac >>
3632 Induct_on `l` >-
3633 rw[] >>
3634 rw[MDILATE_def] >>
3635 `LENGTH l <> 0` by metis_tac[LENGTH_NIL] >>
3636 `0 < LENGTH l` by decide_tac >>
3637 `PRE n + SUC (n * PRE (LENGTH l)) = SUC (PRE n) + n * PRE (LENGTH l)` by rw[] >>
3638 `_ = n + n * PRE (LENGTH l)` by decide_tac >>
3639 `_ = n * SUC (PRE (LENGTH l))` by rw[MULT_SUC] >>
3640 `_ = n * LENGTH l` by metis_tac[SUC_PRE] >>
3641 decide_tac
3642QED
3643
3644(* Theorem: LENGTH l <= LENGTH (MDILATE e n l) *)
3645(* Proof:
3646 If n = 0,
3647 LENGTH (MDILATE e 0 l)
3648 = LENGTH l by MDILATE_LENGTH
3649 >= LENGTH l
3650 If l = [],
3651 LENGTH (MDILATE e n [])
3652 = LENGTH [] by MDILATE_NIL
3653 >= LENGTH []
3654 If l <> [],
3655 Then ?h t. l = h::t by list_CASES
3656 LENGTH (MDILATE e n (h::t))
3657 = SUC (n * PRE (LENGTH (h::t))) by MDILATE_LENGTH
3658 = SUC (n * PRE (SUC (LENGTH t))) by LENGTH
3659 = SUC (n * LENGTH t) by PRE
3660 = n * LENGTH t + 1 by ADD1
3661 >= LENGTH t + 1 by LE_MULT_CANCEL_LBARE, 0 < n
3662 = SUC (LENGTH t) by ADD1
3663 = LENGTH (h::t) by LENGTH
3664*)
3665Theorem MDILATE_LENGTH_LOWER:
3666 !l e n. LENGTH l <= LENGTH (MDILATE e n l)
3667Proof
3668 rw[MDILATE_LENGTH] >>
3669 `?h t. l = h::t` by metis_tac[list_CASES] >>
3670 rw[]
3671QED
3672
3673(* Theorem: 0 < n ==> LENGTH (MDILATE e n l) <= SUC (n * PRE (LENGTH l)) *)
3674(* Proof:
3675 Since n <> 0,
3676 If l = [],
3677 LENGTH (MDILATE e n [])
3678 = LENGTH [] by MDILATE_NIL
3679 = 0 by LENGTH_NIL
3680 SUC (n * PRE (LENGTH []))
3681 = SUC (n * PRE 0) by LENGTH_NIL
3682 = SUC 0 by PRE, MULT_0
3683 > 0 by LESS_SUC
3684 If l <> [],
3685 LENGTH (MDILATE e n l)
3686 = SUC (n * PRE (LENGTH l)) by MDILATE_LENGTH, n <> 0
3687*)
3688Theorem MDILATE_LENGTH_UPPER:
3689 !l e n. 0 < n ==> LENGTH (MDILATE e n l) <= SUC (n * PRE (LENGTH l))
3690Proof
3691 rw[MDILATE_LENGTH]
3692QED
3693
3694(* Theorem: k < LENGTH (MDILATE e n l) ==>
3695 (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) *)
3696(* Proof:
3697 If n = 0,
3698 Then MDILATE e 0 l = l by MDILATE_0
3699 Hence true trivially.
3700 If n <> 0,
3701 Then 0 < n by NOT_ZERO_LT_ZERO
3702 By induction on l.
3703 Base: !k. k < LENGTH (MDILATE e n []) ==>
3704 (EL k (MDILATE e n []) = if n = 0 then EL k [] else if k MOD n = 0 then EL (k DIV n) [] else e)
3705 Note LENGTH (MDILATE e n [])
3706 = LENGTH [] by MDILATE_NIL
3707 = 0 by LENGTH_NIL
3708 Thus k < 0 <=> F by NOT_ZERO_LT_ZERO
3709 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) ==>
3710 !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)
3711 Note LENGTH (MDILATE e n [h]) = 1 by MDILATE_SING
3712 and LENGTH (MDILATE e n (h::l))
3713 = SUC (n * PRE (LENGTH (h::l))) by MDILATE_LENGTH, n <> 0
3714 = SUC (n * PRE (SUC (LENGTH l))) by LENGTH
3715 = SUC (n * LENGTH l) by PRE
3716
3717 If l = [],
3718 Then MDILATE e n [h] = [h] by MDILATE_SING
3719 and LENGTH (MDILATE e n [h]) = 1 by LENGTH
3720 so k < 1 means k = 0.
3721 and 0 DIV n = 0 by ZERO_DIV, 0 < n
3722 and 0 MOD n = 0 by ZERO_MOD, 0 < n
3723 Thus EL k [h] = EL (k DIV n) [h].
3724
3725 If l <> [],
3726 Let t = h::GENLIST (K e) (PRE n)
3727 Note LENGTH t = n by LENGTH_GENLIST
3728 If k < n,
3729 Then k MOD n = k by LESS_MOD, k < n
3730 EL k (MDILATE e n (h::l))
3731 = EL k (t ++ MDILATE e n l) by MDILATE_CONS
3732 = EL k t by EL_APPEND, k < LENGTH t
3733 If k = 0,
3734 EL 0 t
3735 = EL 0 (h:: GENLIST (K e) (PRE n)) by notation of t
3736 = h
3737 = EL (0 DIV n) (h::l) by EL, HD
3738 If k <> 0,
3739 EL k t
3740 = EL k (h:: GENLIST (K e) (PRE n)) by notation of t
3741 = EL (PRE k) (GENLIST (K e) (PRE n)) by EL_CONS
3742 = (K e) (PRE k) by EL_GENLIST, PRE k < PRE n
3743 = e by application of K
3744 If ~(k < n), n <= k.
3745 Given k < LENGTH (MDILATE e n (h::l))
3746 or k < SUC (n * LENGTH l) by above
3747 ==> k - n < SUC (n * LENGTH l) - n by n <= k
3748 = SUC (n * LENGTH l - n) by SUB
3749 = SUC (n * (LENGTH l - 1)) by LEFT_SUB_DISTRIB
3750 = SUC (n * PRE (LENGTH l)) by PRE_SUB1
3751 or k - n < LENGTH (MDILATE e n l) by MDILATE_LENGTH
3752 Thus (k - n) MOD n = k MOD n by SUB_MOD
3753 and (k - n) DIV n = k DIV n - 1 by SUB_DIV
3754 If k MOD n = 0,
3755 Note 0 < k DIV n by DIVIDES_MOD_0, DIV_POS
3756 EL k (t ++ MDILATE e n l)
3757 = EL (k - n) (MDILATE e n l) by EL_APPEND, n <= k
3758 = EL (k DIV n - 1) l by induction hypothesis, (k - n) MOD n = 0
3759 = EL (PRE (k DIV n)) l by PRE_SUB1
3760 = EL (k DIV n) (h::l) by EL_CONS, 0 < k DIV n
3761 If k MOD n <> 0,
3762 EL k (t ++ MDILATE e n l)
3763 = EL (k - n) (MDILATE e n l) by EL_APPEND, n <= k
3764 = e by induction hypothesis, (k - n) MOD n <> 0
3765*)
3766Theorem MDILATE_EL:
3767 !l e n k. k < LENGTH (MDILATE e n l) ==>
3768 (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)
3769Proof
3770 ntac 3 strip_tac >>
3771 Cases_on `n = 0` >-
3772 rw[MDILATE_0] >>
3773 `0 < n` by decide_tac >>
3774 Induct_on `l` >-
3775 rw[] >>
3776 rpt strip_tac >>
3777 `LENGTH (MDILATE e n [h]) = 1` by rw[MDILATE_SING] >>
3778 `LENGTH (MDILATE e n (h::l)) = SUC (n * LENGTH l)` by rw[MDILATE_LENGTH] >>
3779 qabbrev_tac `t = h:: GENLIST (K e) (PRE n)` >>
3780 `!k. k < 1 <=> (k = 0)` by decide_tac >>
3781 rw_tac std_ss[MDILATE_def] >-
3782 metis_tac[ZERO_DIV] >-
3783 metis_tac[ZERO_MOD] >-
3784 (rw_tac std_ss[EL_APPEND] >| [
3785 `LENGTH t = n` by rw[Abbr`t`] >>
3786 `k MOD n = k` by rw[LESS_MOD] >>
3787 `!x. EL 0 (h::x) = h` by rw[] >>
3788 metis_tac[ZERO_DIV],
3789 `LENGTH t = n` by rw[Abbr`t`] >>
3790 `k - n < LENGTH (MDILATE e n l)` by rw[MDILATE_LENGTH] >>
3791 `(k - n) MOD n = k MOD n` by rw[SUB_MOD] >>
3792 `(k - n) DIV n = k DIV n - 1` by rw[GSYM SUB_DIV] >>
3793 `0 < k DIV n` by rw[DIVIDES_MOD_0, DIV_POS] >>
3794 `EL (k - n) (MDILATE e n l) = EL (k DIV n - 1) l` by rw[] >>
3795 `_ = EL (PRE (k DIV n)) l` by rw[PRE_SUB1] >>
3796 `_ = EL (k DIV n) (h::l)` by rw[EL_CONS] >>
3797 rw[]
3798 ]) >>
3799 rw_tac std_ss[EL_APPEND] >| [
3800 `LENGTH t = n` by rw[Abbr`t`] >>
3801 `k MOD n = k` by rw[LESS_MOD] >>
3802 `0 < k /\ PRE k < PRE n` by decide_tac >>
3803 `EL k t = EL (PRE k) (GENLIST (K e) (PRE n))` by rw[EL_CONS, Abbr`t`] >>
3804 `_ = e` by rw[] >>
3805 rw[],
3806 `LENGTH t = n` by rw[Abbr`t`] >>
3807 `k - n < LENGTH (MDILATE e n l)` by rw[MDILATE_LENGTH] >>
3808 `n <= k` by decide_tac >>
3809 `(k - n) MOD n = k MOD n` by rw[SUB_MOD] >>
3810 `EL (k - n) (MDILATE e n l) = e` by rw[] >>
3811 rw[]
3812 ]
3813QED
3814
3815(* This is a milestone theorem. *)
3816
3817(* Theorem: (MDILATE e n l = []) <=> (l = []) *)
3818(* Proof:
3819 If part: MDILATE e n l = [] ==> l = []
3820 By contradiction, suppose l <> [].
3821 If n = 0,
3822 Then MDILATE e 0 l = l by MDILATE_0
3823 This contradicts MDILATE e 0 l = [].
3824 If n <> 0,
3825 Then LENGTH (MDILATE e n l)
3826 = SUC (n * PRE (LENGTH l)) by MDILATE_LENGTH
3827 <> 0 by SUC_NOT
3828 So (MDILATE e n l) <> [] by LENGTH_NIL
3829 This contradicts MDILATE e n l = []
3830 Only-if part: l = [] ==> MDILATE e n l = []
3831 True by MDILATE_NIL
3832*)
3833Theorem MDILATE_EQ_NIL:
3834 !l e n. (MDILATE e n l = []) <=> (l = [])
3835Proof
3836 rw[EQ_IMP_THM] >>
3837 spose_not_then strip_assume_tac >>
3838 Cases_on `n = 0` >| [
3839 `MDILATE e 0 l = l` by rw[GSYM MDILATE_0] >>
3840 metis_tac[],
3841 `LENGTH (MDILATE e n l) = SUC (n * PRE (LENGTH l))` by rw[MDILATE_LENGTH] >>
3842 `LENGTH (MDILATE e n l) <> 0` by decide_tac >>
3843 metis_tac[LENGTH_EQ_0]
3844 ]
3845QED
3846
3847(* Theorem: LAST (MDILATE e n l) = LAST l *)
3848(* Proof:
3849 If l = [],
3850 LAST (MDILATE e n [])
3851 = LAST [] by MDILATE_NIL
3852 If l <> [],
3853 If n = 0,
3854 LAST (MDILATE e 0 l)
3855 = LAST l by MDILATE_0
3856 If n <> 0, then 0 < m by LESS_0
3857 Then MDILATE e n l <> [] by MDILATE_EQ_NIL
3858 or LENGTH (MDILATE e n l) <> 0 by LENGTH_NIL
3859 Note PRE (LENGTH (MDILATE e n l))
3860 = PRE (SUC (n * PRE (LENGTH l))) by MDILATE_LENGTH
3861 = n * PRE (LENGTH l) by PRE
3862 Let k = PRE (LENGTH (MDILATE e n l)).
3863 Then k < LENGTH (MDILATE e n l) by PRE x < x
3864 and k MOD n = 0 by MOD_EQ_0, MULT_COMM, 0 < n
3865 and k DIV n = PRE (LENGTH l) by MULT_DIV, MULT_COMM
3866
3867 LAST (MDILATE e n l)
3868 = EL k (MDILATE e n l) by LAST_EL
3869 = EL (k DIV n) l by MDILATE_EL
3870 = EL (PRE (LENGTH l)) l by above
3871 = LAST l by LAST_EL
3872*)
3873Theorem MDILATE_LAST:
3874 !l e n. LAST (MDILATE e n l) = LAST l
3875Proof
3876 rpt strip_tac >>
3877 Cases_on `l = []` >-
3878 rw[] >>
3879 Cases_on `n = 0` >-
3880 rw[MDILATE_0] >>
3881 `0 < n` by decide_tac >>
3882 `MDILATE e n l <> []` by rw[MDILATE_EQ_NIL] >>
3883 `LENGTH (MDILATE e n l) <> 0` by metis_tac[LENGTH_NIL] >>
3884 qabbrev_tac `k = PRE (LENGTH (MDILATE e n l))` >>
3885 rw[LAST_EL] >>
3886 `k = n * PRE (LENGTH l)` by rw[MDILATE_LENGTH, Abbr`k`] >>
3887 `k MOD n = 0` by metis_tac[MOD_EQ_0, MULT_COMM] >>
3888 `k DIV n = PRE (LENGTH l)` by metis_tac[MULT_DIV, MULT_COMM] >>
3889 `k < LENGTH (MDILATE e n l)` by rw[Abbr`k`] >>
3890 rw[MDILATE_EL]
3891QED
3892
3893(*
3894Succesive dilation:
3895
3896> EVAL ``MDILATE #0 3 [a; b; c]``;
3897val it = |- MDILATE #0 3 [a; b; c] = [a; #0; #0; b; #0; #0; c]: thm
3898> EVAL ``MDILATE #0 4 [a; b; c]``;
3899val it = |- MDILATE #0 4 [a; b; c] = [a; #0; #0; #0; b; #0; #0; #0; c]: thm
3900> EVAL ``MDILATE #0 1 (MDILATE #0 3 [a; b; c])``;
3901val it = |- MDILATE #0 1 (MDILATE #0 3 [a; b; c]) = [a; #0; #0; b; #0; #0; c]: thm
3902> EVAL ``MDILATE #0 2 (MDILATE #0 3 [a; b; c])``;
3903val it = |- MDILATE #0 2 (MDILATE #0 3 [a; b; c]) = [a; #0; #0; #0; #0; #0; b; #0; #0; #0; #0; #0; c]: thm
3904> EVAL ``MDILATE #0 2 (MDILATE #0 2 [a; b; c])``;
3905val it = |- MDILATE #0 2 (MDILATE #0 2 [a; b; c]) = [a; #0; #0; #0; b; #0; #0; #0; c]: thm
3906> EVAL ``MDILATE #0 2 (MDILATE #0 2 [a; b; c]) = MDILATE #0 4 [a; b; c]``;
3907val it = |- (MDILATE #0 2 (MDILATE #0 2 [a; b; c]) = MDILATE #0 4 [a; b; c]) <=> T: thm
3908> EVAL ``MDILATE #0 2 (MDILATE #0 3 [a; b; c]) = MDILATE #0 5 [a; b; c]``;
3909val it = |- (MDILATE #0 2 (MDILATE #0 3 [a; b; c]) = MDILATE #0 5 [a; b; c]) <=> F: thm
3910> EVAL ``MDILATE #0 2 (MDILATE #0 3 [a; b; c]) = MDILATE #0 6 [a; b; c]``;
3911val it = |- (MDILATE #0 2 (MDILATE #0 3 [a; b; c]) = MDILATE #0 6 [a; b; c]) <=> T: thm
3912
3913So successive dilation is related to product, or factorisation, or primes:
3914MDILATE e m (MDILATE e n l) = MDILATE e (m * n) l, for 0 < m, 0 < n.
3915
3916*)
3917
3918(* ------------------------------------------------------------------------- *)
3919(* List Dilation (Additive) *)
3920(* ------------------------------------------------------------------------- *)
3921
3922(* Dilate by inserting m zeroes, at position n of tail *)
3923Definition DILATE_def:
3924 (DILATE e n m [] = []) /\
3925 (DILATE e n m [h] = [h]) /\
3926 (DILATE e n m (h::t) = h:: (TAKE n t ++ (GENLIST (K e) m) ++ DILATE e n m (DROP n t)))
3927Termination
3928 WF_REL_TAC `measure (λ(a,b,c,d). LENGTH d)` >>
3929 rw[LENGTH_DROP]
3930End
3931
3932(*
3933> EVAL ``DILATE 0 0 1 [1;2;3]``;
3934val it = |- DILATE 0 0 1 [1; 2; 3] = [1; 0; 2; 0; 3]: thm
3935> EVAL ``DILATE 0 0 2 [1;2;3]``;
3936val it = |- DILATE 0 0 2 [1; 2; 3] = [1; 0; 0; 2; 0; 0; 3]: thm
3937> EVAL ``DILATE 0 1 1 [1;2;3]``;
3938val it = |- DILATE 0 1 1 [1; 2; 3] = [1; 2; 0; 3]: thm
3939> EVAL ``DILATE 0 1 1 (DILATE 0 0 1 [1;2;3])``;
3940val it = |- DILATE 0 1 1 (DILATE 0 0 1 [1; 2; 3]) = [1; 0; 0; 2; 0; 0; 3]: thm
3941> EVAL ``DILATE 0 0 3 [1;2;3]``;
3942val it = |- DILATE 0 0 3 [1; 2; 3] = [1; 0; 0; 0; 2; 0; 0; 0; 3]: thm
3943> EVAL ``DILATE 0 1 1 (DILATE 0 0 2 [1;2;3])``;
3944val it = |- DILATE 0 1 1 (DILATE 0 0 2 [1; 2; 3]) = [1; 0; 0; 0; 2; 0; 0; 0; 0; 3]: thm
3945> EVAL ``DILATE 0 0 3 [1;2;3] = DILATE 0 2 1 (DILATE 0 0 2 [1;2;3])``;
3946val it = |- (DILATE 0 0 3 [1; 2; 3] = DILATE 0 2 1 (DILATE 0 0 2 [1; 2; 3])) <=> T: thm
3947
3948> EVAL ``DILATE 0 0 0 [1;2;3]``;
3949val it = |- DILATE 0 0 0 [1; 2; 3] = [1; 2; 3]: thm
3950> EVAL ``DILATE 1 0 0 [1;2;3]``;
3951val it = |- DILATE 1 0 0 [1; 2; 3] = [1; 2; 3]: thm
3952> EVAL ``DILATE 1 0 1 [1;2;3]``;
3953val it = |- DILATE 1 0 1 [1; 2; 3] = [1; 1; 2; 1; 3]: thm
3954> EVAL ``DILATE 1 1 1 [1;2;3]``;
3955val it = |- DILATE 1 1 1 [1; 2; 3] = [1; 2; 1; 3]: thm
3956> EVAL ``DILATE 1 1 2 [1;2;3]``;
3957val it = |- DILATE 1 1 2 [1; 2; 3] = [1; 2; 1; 1; 3]: thm
3958> EVAL ``DILATE 1 1 3 [1;2;3]``;
3959val it = |- DILATE 1 1 3 [1; 2; 3] = [1; 2; 1; 1; 1; 3]: thm
3960*)
3961
3962(* Theorem: DILATE e n m [] = [] *)
3963(* Proof: by DILATE_def *)
3964Theorem DILATE_NIL[simp] = DILATE_def |> CONJUNCT1;
3965(* val DILATE_NIL = |- !n m e. DILATE e n m [] = []: thm *)
3966
3967
3968(* Theorem: DILATE e n m [h] = [h] *)
3969(* Proof: by DILATE_def *)
3970Theorem DILATE_SING[simp] = DILATE_def |> CONJUNCT2 |> CONJUNCT1;
3971(* val DILATE_SING = |- !n m h e. DILATE e n m [h] = [h]: thm *)
3972
3973
3974(* Theorem: DILATE e n m (h::t) =
3975 if t = [] then [h] else h:: (TAKE n t ++ (GENLIST (K e) m) ++ DILATE e n m (DROP n t)) *)
3976(* Proof: by DILATE_def, list_CASES *)
3977Theorem DILATE_CONS:
3978 !n m h t e. DILATE e n m (h::t) =
3979 if t = [] then [h] else h:: (TAKE n t ++ (GENLIST (K e) m) ++ DILATE e n m (DROP n t))
3980Proof
3981 metis_tac[DILATE_def, list_CASES]
3982QED
3983
3984(* Theorem: DILATE e 0 n (h::t) = if t = [] then [h] else h::(GENLIST (K e) n ++ DILATE e 0 n t) *)
3985(* Proof:
3986 If t = [],
3987 DILATE e 0 n (h::t) = [h] by DILATE_CONS
3988 If t <> [],
3989 DILATE e 0 n (h::t)
3990 = h:: (TAKE 0 t ++ (GENLIST (K e) n) ++ DILATE e 0 n (DROP 0 t)) by DILATE_CONS
3991 = h:: ([] ++ (GENLIST (K e) n) ++ DILATE e 0 n t) by TAKE_0, DROP_0
3992 = h:: (GENLIST (K e) n ++ DILATE e 0 n t) by APPEND
3993*)
3994Theorem DILATE_0_CONS:
3995 !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)
3996Proof
3997 rw[DILATE_CONS]
3998QED
3999
4000(* Theorem: DILATE e 0 0 l = l *)
4001(* Proof:
4002 By induction on l.
4003 Base: DILATE e 0 0 [] = [], true by DILATE_NIL
4004 Step: DILATE e 0 0 l = l ==> !h. DILATE e 0 0 (h::l) = h::l
4005 If l = [],
4006 DILATE e 0 0 [h] = [h] by DILATE_SING
4007 If l <> [],
4008 DILATE e 0 0 (h::l)
4009 = h::(GENLIST (K e) 0 ++ DILATE e 0 0 l) by DILATE_0_CONS
4010 = h::([] ++ DILATE e 0 0 l) by GENLIST_0
4011 = h:: DILATE e 0 0 l by APPEND
4012 = h::l by induction hypothesis
4013*)
4014Theorem DILATE_0_0:
4015 !l e. DILATE e 0 0 l = l
4016Proof
4017 Induct >>
4018 rw[DILATE_0_CONS]
4019QED
4020
4021(* Theorem: DILATE e 0 (SUC n) l = DILATE e n 1 (DILATE e 0 n l) *)
4022(* Proof:
4023 If n = 0,
4024 DILATE e 0 1 l = DILATE e 0 1 (DILATE e 0 0 l) by DILATE_0_0
4025 If n <> 0,
4026 GENLIST (K e) n <> [] by LENGTH_GENLIST, LENGTH_NIL
4027 By induction on l.
4028 Base: DILATE e 0 (SUC n) [] = DILATE e n 1 (DILATE e 0 n [])
4029 DILATE e 0 (SUC n) [] = [] by DILATE_NIL
4030 DILATE e n 1 (DILATE e 0 n [])
4031 = DILATE e n 1 [] = [] by DILATE_NIL
4032 Step: DILATE e 0 (SUC n) l = DILATE e n 1 (DILATE e 0 n l) ==>
4033 !h. DILATE e 0 (SUC n) (h::l) = DILATE e n 1 (DILATE e 0 n (h::l))
4034 If l = [],
4035 DILATE e 0 (SUC n) [h] = [h] by DILATE_SING
4036 DILATE e n 1 (DILATE e 0 n [h])
4037 = DILATE e n 1 [h] = [h] by DILATE_SING
4038 If l <> [],
4039 DILATE e 0 (SUC n) (h::l)
4040 = h::(GENLIST (K e) (SUC n) ++ DILATE e 0 (SUC n) l) by DILATE_0_CONS
4041 = h::(GENLIST (K e) (SUC n) ++ DILATE e n 1 (DILATE e 0 n l)) by induction hypothesis
4042
4043 Note LENGTH (GENLIST (K e) n) = n by LENGTH_GENLIST
4044 so (GENLIST (K e) n ++ DILATE e 0 n l) <> [] by APPEND_eq_NIL, LENGTH_NIL [1]
4045 and TAKE n (GENLIST (K e) n ++ DILATE e 0 n l) = GENLIST (K e) n by TAKE_LENGTH_APPEND [2]
4046 and DROP n (GENLIST (K e) n ++ DILATE e 0 n l) = DILATE e 0 n l by DROP_LENGTH_APPEND [3]
4047 and GENLIST (K e) (SUC n)
4048 = GENLIST (K e) (1 + n) by SUC_ONE_ADD
4049 = GENLIST (K e) n ++ GENLIST (K e) 1 by GENLIST_K_ADD [4]
4050
4051 DILATE e n 1 (DILATE e 0 n (h::l))
4052 = DILATE e n 1 (h::(GENLIST (K e) n ++ DILATE e 0 n l)) by DILATE_0_CONS
4053 = h::(TAKE n (GENLIST (K e) n ++ DILATE e 0 n l) ++ GENLIST (K e) 1 ++
4054 DILATE e n 1 (DROP n (GENLIST (K e) n ++ DILATE e 0 n l))) by DILATE_CONS, [1]
4055 = h::(GENLIST (K e) n ++ GENLIST (K e) 1 ++ DILATE e n 1 (DILATE e 0 n l)) by above [2], [3]
4056 = h::(GENLIST (K e) (SUC n) ++ DILATE e n 1 (DILATE e 0 n l)) by above [4]
4057*)
4058Theorem DILATE_0_SUC:
4059 !l e n. DILATE e 0 (SUC n) l = DILATE e n 1 (DILATE e 0 n l)
4060Proof
4061 rpt strip_tac >>
4062 Cases_on `n = 0` >-
4063 rw[DILATE_0_0] >>
4064 Induct_on `l` >-
4065 rw[] >>
4066 rpt strip_tac >>
4067 Cases_on `l = []` >-
4068 rw[DILATE_SING] >>
4069 qabbrev_tac `a = GENLIST (K e) n ++ DILATE e 0 n l` >>
4070 `LENGTH (GENLIST (K e) n) = n` by rw[] >>
4071 `a <> []` by metis_tac[APPEND_eq_NIL, LENGTH_NIL] >>
4072 `TAKE n a = GENLIST (K e) n` by metis_tac[TAKE_LENGTH_APPEND] >>
4073 `DROP n a = DILATE e 0 n l` by metis_tac[DROP_LENGTH_APPEND] >>
4074 `GENLIST (K e) (SUC n) = GENLIST (K e) n ++ GENLIST (K e) 1` by rw_tac std_ss[SUC_ONE_ADD, GENLIST_K_ADD] >>
4075 metis_tac[DILATE_0_CONS, DILATE_CONS]
4076QED
4077
4078(* Theorem: LENGTH (DILATE e 0 n l) = if l = [] then 0 else SUC (SUC n * PRE (LENGTH l)) *)
4079(* Proof:
4080 By induction on l.
4081 Base: LENGTH (DILATE e 0 n []) = 0
4082 LENGTH (DILATE e 0 n [])
4083 = LENGTH [] by DILATE_NIL
4084 = 0 by LENGTH_NIL
4085 Step: LENGTH (DILATE e 0 n l) = if l = [] then 0 else SUC (SUC n * PRE (LENGTH l)) ==>
4086 !h. LENGTH (DILATE e 0 n (h::l)) = SUC (SUC n * PRE (LENGTH (h::l)))
4087 If l = [],
4088 LENGTH (DILATE e 0 n [h])
4089 = LENGTH [h] by DILATE_SING
4090 = 1 by LENGTH
4091 SUC (SUC n * PRE (LENGTH [h])
4092 = SUC (SUC n * PRE 1) by LENGTH
4093 = SUC (SUC n * 0) by PRE_SUB1
4094 = SUC 0 by MULT_0
4095 = 1 by ONE
4096 If l <> [],
4097 Note LENGTH l <> 0 by LENGTH_NIL
4098 LENGTH (DILATE e 0 n (h::l))
4099 = LENGTH (h::(GENLIST (K e) n ++ DILATE e 0 n l)) by DILATE_0_CONS
4100 = SUC (LENGTH (GENLIST (K e) n ++ DILATE e 0 n l)) by LENGTH
4101 = SUC (LENGTH (GENLIST (K e) n) + LENGTH (DILATE e 0 n l)) by LENGTH_APPEND
4102 = SUC (n + LENGTH (DILATE e 0 n l)) by LENGTH_GENLIST
4103 = SUC (n + SUC (SUC n * PRE (LENGTH l))) by induction hypothesis
4104 = SUC (SUC (n + SUC n * PRE (LENGTH l))) by ADD_SUC
4105 = SUC (SUC n + SUC n * PRE (LENGTH l)) by ADD_COMM, ADD_SUC
4106 = SUC (SUC n * SUC (PRE (LENGTH l))) by MULT_SUC
4107 = SUC (SUC n * LENGTH l) by SUC_PRE, 0 < LENGTH l
4108 = SUC (SUC n * PRE (LENGTH (h::l))) by LENGTH, PRE_SUC_EQ
4109*)
4110Theorem DILATE_0_LENGTH:
4111 !l e n. LENGTH (DILATE e 0 n l) = if l = [] then 0 else SUC (SUC n * PRE (LENGTH l))
4112Proof
4113 Induct >-
4114 rw[] >>
4115 rw_tac std_ss[LENGTH] >>
4116 Cases_on `l = []` >-
4117 rw[] >>
4118 `0 < LENGTH l` by metis_tac[LENGTH_NIL, NOT_ZERO_LT_ZERO] >>
4119 `LENGTH (DILATE e 0 n (h::l)) = LENGTH (h::(GENLIST (K e) n ++ DILATE e 0 n l))` by rw[DILATE_0_CONS] >>
4120 `_ = SUC (LENGTH (GENLIST (K e) n ++ DILATE e 0 n l))` by rw[] >>
4121 `_ = SUC (n + LENGTH (DILATE e 0 n l))` by rw[] >>
4122 `_ = SUC (n + SUC (SUC n * PRE (LENGTH l)))` by rw[] >>
4123 `_ = SUC (SUC (n + SUC n * PRE (LENGTH l)))` by rw[] >>
4124 `_ = SUC (SUC n + SUC n * PRE (LENGTH l))` by rw[] >>
4125 `_ = SUC (SUC n * SUC (PRE (LENGTH l)))` by rw[MULT_SUC] >>
4126 `_ = SUC (SUC n * LENGTH l)` by rw[SUC_PRE] >>
4127 rw[]
4128QED
4129
4130(* Theorem: LENGTH l <= LENGTH (DILATE e 0 n l) *)
4131(* Proof:
4132 If l = [],
4133 LENGTH (DILATE e 0 n [])
4134 = LENGTH [] by DILATE_NIL
4135 >= LENGTH []
4136 If l <> [],
4137 Then ?h t. l = h::t by list_CASES
4138 LENGTH (DILATE e 0 n (h::t))
4139 = SUC (SUC n * PRE (LENGTH (h::t))) by DILATE_0_LENGTH
4140 = SUC (SUC n * PRE (SUC (LENGTH t))) by LENGTH
4141 = SUC (SUC n * LENGTH t) by PRE
4142 = SUC n * LENGTH t + 1 by ADD1
4143 >= LENGTH t + 1 by LE_MULT_CANCEL_LBARE, 0 < SUC n
4144 = SUC (LENGTH t) by ADD1
4145 = LENGTH (h::t) by LENGTH
4146*)
4147Theorem DILATE_0_LENGTH_LOWER:
4148 !l e n. LENGTH l <= LENGTH (DILATE e 0 n l)
4149Proof
4150 rw[DILATE_0_LENGTH] >>
4151 `?h t. l = h::t` by metis_tac[list_CASES] >>
4152 rw[]
4153QED
4154
4155(* Theorem: LENGTH (DILATE e 0 n l) <= SUC (SUC n * PRE (LENGTH l)) *)
4156(* Proof:
4157 If l = [],
4158 LENGTH (DILATE e 0 n [])
4159 = LENGTH [] by DILATE_NIL
4160 = 0 by LENGTH_NIL
4161 SUC (SUC n * PRE (LENGTH []))
4162 = SUC (SUC n * PRE 0) by LENGTH_NIL
4163 = SUC 0 by PRE, MULT_0
4164 > 0 by LESS_SUC
4165 If l <> [],
4166 LENGTH (DILATE e 0 n l)
4167 = SUC (SUC n * PRE (LENGTH l)) by DILATE_0_LENGTH
4168*)
4169Theorem DILATE_0_LENGTH_UPPER:
4170 !l e n. LENGTH (DILATE e 0 n l) <= SUC (SUC n * PRE (LENGTH l))
4171Proof
4172 rw[DILATE_0_LENGTH]
4173QED
4174
4175(* Theorem: k < LENGTH (DILATE e 0 n l) ==>
4176 (EL k (DILATE e 0 n l) = if k MOD (SUC n) = 0 then EL (k DIV (SUC n)) l else e) *)
4177(* Proof:
4178 Let m = SUC n, then 0 < m.
4179 By induction on l.
4180 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)
4181 Note LENGTH (DILATE e 0 n [])
4182 = LENGTH [] by DILATE_NIL
4183 = 0 by LENGTH_NIL
4184 Thus k < 0 <=> F by NOT_ZERO_LT_ZERO
4185 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) ==>
4186 !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)
4187 Note LENGTH (DILATE e 0 n [h]) = 1 by DILATE_SING
4188 and LENGTH (DILATE e 0 n (h::l))
4189 = SUC (m * PRE (LENGTH (h::l))) by DILATE_0_LENGTH, n <> 0
4190 = SUC (m * PRE (SUC (LENGTH l))) by LENGTH
4191 = SUC (m * LENGTH l) by PRE
4192
4193 If l = [],
4194 Then DILATE e 0 n [h] = [h] by DILATE_SING
4195 and LENGTH (DILATE e 0 n [h]) = 1 by LENGTH
4196 so k < 1 means k = 0.
4197 and 0 DIV m = 0 by ZERO_DIV, 0 < m
4198 and 0 MOD m = 0 by ZERO_MOD, 0 < m
4199 Thus EL k [h] = EL (k DIV m) [h].
4200
4201 If l <> [],
4202 Let t = h:: GENLIST (K e) n.
4203 Note LENGTH t = SUC n = m by LENGTH_GENLIST
4204 If k < m,
4205 Then k MOD m = k by LESS_MOD, k < m
4206 EL k (DILATE e 0 n (h::l))
4207 = EL k (t ++ DILATE e 0 n l) by DILATE_0_CONS
4208 = EL k t by EL_APPEND, k < LENGTH t
4209 If k = 0, i.e. k MOD m = 0.
4210 EL 0 t
4211 = EL 0 (h:: GENLIST (K e) (PRE n)) by notation of t
4212 = h
4213 = EL (0 DIV m) (h::l) by EL, HD
4214 If k <> 0, i.e. k MOD m <> 0.
4215 EL k t
4216 = EL k (h:: GENLIST (K e) n) by notation of t
4217 = EL (PRE k) (GENLIST (K e) n) by EL_CONS
4218 = (K e) (PRE k) by EL_GENLIST, PRE k < PRE m = n
4219 = e by application of K
4220 If ~(k < m), then m <= k.
4221 Given k < LENGTH (DILATE e 0 n (h::l))
4222 or k < SUC (m * LENGTH l) by above
4223 ==> k - m < SUC (m * LENGTH l) - m by m <= k
4224 = SUC (m * LENGTH l - m) by SUB
4225 = SUC (m * (LENGTH l - 1)) by LEFT_SUB_DISTRIB
4226 = SUC (m * PRE (LENGTH l)) by PRE_SUB1
4227 or k - m < LENGTH (MDILATE e n l) by MDILATE_LENGTH
4228 Thus (k - m) MOD m = k MOD m by SUB_MOD
4229 and (k - m) DIV m = k DIV m - 1 by SUB_DIV
4230 If k MOD m = 0,
4231 Note 0 < k DIV m by DIVIDES_MOD_0, DIV_POS
4232 EL k (t ++ DILATE e 0 n l)
4233 = EL (k - m) (DILATE e 0 n l) by EL_APPEND, m <= k
4234 = EL (k DIV m - 1) l by induction hypothesis, (k - m) MOD m = 0
4235 = EL (PRE (k DIV m)) l by PRE_SUB1
4236 = EL (k DIV m) (h::l) by EL_CONS, 0 < k DIV m
4237 If k MOD m <> 0,
4238 EL k (t ++ DILATE e 0 n l)
4239 = EL (k - m) (DILATE e 0 n l) by EL_APPEND, n <= k
4240 = e by induction hypothesis, (k - m) MOD n <> 0
4241*)
4242Theorem DILATE_0_EL:
4243 !l e n k. k < LENGTH (DILATE e 0 n l) ==>
4244 (EL k (DILATE e 0 n l) = if k MOD (SUC n) = 0 then EL (k DIV (SUC n)) l else e)
4245Proof
4246 ntac 3 strip_tac >>
4247 `0 < SUC n` by decide_tac >>
4248 qabbrev_tac `m = SUC n` >>
4249 Induct_on `l` >-
4250 rw[] >>
4251 rpt strip_tac >>
4252 `LENGTH (DILATE e 0 n [h]) = 1` by rw[DILATE_SING] >>
4253 `LENGTH (DILATE e 0 n (h::l)) = SUC (m * LENGTH l)` by rw[DILATE_0_LENGTH, Abbr`m`] >>
4254 Cases_on `l = []` >| [
4255 `k = 0` by rw[] >>
4256 `k MOD m = 0` by rw[] >>
4257 `k DIV m = 0` by rw[ZERO_DIV] >>
4258 rw_tac std_ss[DILATE_SING],
4259 qabbrev_tac `t = h::GENLIST (K e) n` >>
4260 `DILATE e 0 n (h::l) = t ++ DILATE e 0 n l` by rw[DILATE_0_CONS, Abbr`t`] >>
4261 `m = LENGTH t` by rw[Abbr`t`] >>
4262 Cases_on `k < m` >| [
4263 `k MOD m = k` by rw[] >>
4264 `EL k (DILATE e 0 n (h::l)) = EL k t` by rw[EL_APPEND] >>
4265 Cases_on `k = 0` >| [
4266 `EL 0 t = h` by rw[Abbr`t`] >>
4267 rw[ZERO_DIV],
4268 `PRE m = n` by rw[Abbr`m`] >>
4269 `PRE k < n` by decide_tac >>
4270 `EL k t = EL (PRE k) (GENLIST (K e) n)` by rw[EL_CONS, Abbr`t`] >>
4271 `_ = (K e) (PRE k)` by rw[EL_GENLIST] >>
4272 rw[]
4273 ],
4274 `m <= k` by decide_tac >>
4275 `EL k (t ++ DILATE e 0 n l) = EL (k - m) (DILATE e 0 n l)` by simp[EL_APPEND] >>
4276 `k - m < LENGTH (DILATE e 0 n l)` by rw[DILATE_0_LENGTH] >>
4277 `(k - m) MOD m = k MOD m` by simp[SUB_MOD] >>
4278 `(k - m) DIV m = k DIV m - 1` by simp[SUB_DIV] >>
4279 Cases_on `k MOD m = 0` >| [
4280 `0 < k DIV m` by rw[DIVIDES_MOD_0, DIV_POS] >>
4281 `EL (k - m) (DILATE e 0 n l) = EL (k DIV m - 1) l` by rw[] >>
4282 `_ = EL (PRE (k DIV m)) l` by rw[PRE_SUB1] >>
4283 `_ = EL (k DIV m) (h::l)` by rw[EL_CONS] >>
4284 rw[],
4285 `EL (k - m) (DILATE e 0 n l) = e` by rw[] >>
4286 rw[]
4287 ]
4288 ]
4289 ]
4290QED
4291
4292(* This is a milestone theorem. *)
4293
4294(* Theorem: (DILATE e 0 n l = []) <=> (l = []) *)
4295(* Proof:
4296 If part: DILATE e 0 n l = [] ==> l = []
4297 By contradiction, suppose l <> [].
4298 If n = 0,
4299 Then DILATE e n 0 l = l by DILATE_0_0
4300 This contradicts DILATE e n 0 l = [].
4301 If n <> 0,
4302 Then LENGTH (DILATE e 0 n l)
4303 = SUC (SUC n * PRE (LENGTH l)) by DILATE_0_LENGTH
4304 <> 0 by SUC_NOT
4305 So (DILATE e 0 n l) <> [] by LENGTH_NIL
4306 This contradicts DILATE e 0 n l = []
4307 Only-if part: l = [] ==> DILATE e 0 n l = []
4308 True by DILATE_NIL
4309*)
4310Theorem DILATE_0_EQ_NIL:
4311 !l e n. (DILATE e 0 n l = []) <=> (l = [])
4312Proof
4313 rw[EQ_IMP_THM] >>
4314 spose_not_then strip_assume_tac >>
4315 Cases_on `n = 0` >| [
4316 `DILATE e 0 0 l = l` by rw[GSYM DILATE_0_0] >>
4317 metis_tac[],
4318 `LENGTH (DILATE e 0 n l) = SUC (SUC n * PRE (LENGTH l))` by rw[DILATE_0_LENGTH] >>
4319 `LENGTH (DILATE e 0 n l) <> 0` by decide_tac >>
4320 metis_tac[LENGTH_EQ_0]
4321 ]
4322QED
4323
4324(* Theorem: LAST (DILATE e 0 n l) = LAST l *)
4325(* Proof:
4326 If l = [],
4327 LAST (DILATE e 0 n [])
4328 = LAST [] by DILATE_NIL
4329 If l <> [],
4330 If n = 0,
4331 LAST (DILATE e 0 0 l)
4332 = LAST l by DILATE_0_0
4333 If n <> 0,
4334 Then DILATE e 0 n l <> [] by DILATE_0_EQ_NIL
4335 or LENGTH (DILATE e 0 n l) <> 0 by LENGTH_NIL
4336 Let m = SUC n, then 0 < m by LESS_0
4337 Note PRE (LENGTH (DILATE e 0 n l))
4338 = PRE (SUC (m * PRE (LENGTH l))) by DILATE_0_LENGTH
4339 = m * PRE (LENGTH l) by PRE
4340 Let k = PRE (LENGTH (DILATE e 0 n l)).
4341 Then k < LENGTH (DILATE e 0 n l) by PRE x < x
4342 and k MOD m = 0 by MOD_EQ_0, MULT_COMM, 0 < m
4343 and k DIV m = PRE (LENGTH l) by MULT_DIV, MULT_COMM
4344
4345 LAST (DILATE e 0 n l)
4346 = EL k (DILATE e 0 n l) by LAST_EL
4347 = EL (k DIV m) l by DILATE_0_EL
4348 = EL (PRE (LENGTH l)) l by above
4349 = LAST l by LAST_EL
4350*)
4351Theorem DILATE_0_LAST:
4352 !l e n. LAST (DILATE e 0 n l) = LAST l
4353Proof
4354 rpt strip_tac >>
4355 Cases_on `l = []` >-
4356 rw[] >>
4357 Cases_on `n = 0` >-
4358 rw[DILATE_0_0] >>
4359 `0 < n` by decide_tac >>
4360 `DILATE e 0 n l <> []` by rw[DILATE_0_EQ_NIL] >>
4361 `LENGTH (DILATE e 0 n l) <> 0` by metis_tac[LENGTH_NIL] >>
4362 qabbrev_tac `k = PRE (LENGTH (DILATE e 0 n l))` >>
4363 rw[LAST_EL] >>
4364 `0 < SUC n` by decide_tac >>
4365 qabbrev_tac `m = SUC n` >>
4366 `k = m * PRE (LENGTH l)` by rw[DILATE_0_LENGTH, Abbr`k`, Abbr`m`] >>
4367 `k MOD m = 0` by metis_tac[MOD_EQ_0, MULT_COMM] >>
4368 `k DIV m = PRE (LENGTH l)` by metis_tac[MULT_DIV, MULT_COMM] >>
4369 `k < LENGTH (DILATE e 0 n l)` by simp[Abbr`k`] >>
4370 Q.RM_ABBREV_TAC ‘k’ >>
4371 rw[DILATE_0_EL]
4372QED
4373
4374(* ------------------------------------------------------------------------- *)
4375(* FUNPOW with incremental cons. *)
4376(* ------------------------------------------------------------------------- *)
4377
4378(* Note from HelperList: m downto n = REVERSE [m .. n] *)
4379
4380(* Idea: when applying incremental cons (f head) to a list for n times,
4381 head of the result is f^n (head of list). *)
4382
4383(* Theorem: HD (FUNPOW (\ls. f (HD ls)::ls) n ls) = FUNPOW f n (HD ls) *)
4384(* Proof:
4385 Let h = (\ls. f (HD ls)::ls).
4386 By induction on n.
4387 Base: !ls. HD (FUNPOW h 0 ls) = FUNPOW f 0 (HD ls)
4388 HD (FUNPOW h 0 ls)
4389 = HD ls by FUNPOW_0
4390 = FUNPOW f 0 (HD ls) by FUNPOW_0
4391 Step: !ls. HD (FUNPOW h n ls) = FUNPOW f n (HD ls) ==>
4392 !ls. HD (FUNPOW h (SUC n) ls) = FUNPOW f (SUC n) (HD ls)
4393 HD (FUNPOW h (SUC n) ls)
4394 = HD (FUNPOW h n (h ls)) by FUNPOW
4395 = FUNPOW f n (HD (h ls)) by induction hypothesis
4396 = FUNPOW f n (f (HD ls)) by definition of h
4397 = FUNPOW f (SUC n) (HD ls) by FUNPOW
4398*)
4399Theorem FUNPOW_cons_head:
4400 !f n ls. HD (FUNPOW (\ls. f (HD ls)::ls) n ls) = FUNPOW f n (HD ls)
4401Proof
4402 strip_tac >>
4403 qabbrev_tac `h = \ls. f (HD ls)::ls` >>
4404 Induct >-
4405 simp[] >>
4406 rw[FUNPOW, Abbr`h`]
4407QED
4408
4409(* Idea: when applying incremental cons (f head) to a singleton [u] for n times,
4410 the result is the list [f^n(u), .... f(u), u]. *)
4411
4412(* Theorem: FUNPOW (\ls. f (HD ls)::ls) n [u] =
4413 MAP (\j. FUNPOW f j u) (n downto 0) *)
4414(* Proof:
4415 Let g = (\ls. f (HD ls)::ls),
4416 h = (\j. FUNPOW f j u).
4417 By induction on n.
4418 Base: FUNPOW g 0 [u] = MAP h (0 downto 0)
4419 FUNPOW g 0 [u]
4420 = [u] by FUNPOW_0
4421 = [FUNPOW f 0 u] by FUNPOW_0
4422 = MAP h [0] by MAP
4423 = MAP h (0 downto 0) by REVERSE
4424 Step: FUNPOW g n [u] = MAP h (n downto 0) ==>
4425 FUNPOW g (SUC n) [u] = MAP h (SUC n downto 0)
4426 FUNPOW g (SUC n) [u]
4427 = g (FUNPOW g n [u]) by FUNPOW_SUC
4428 = g (MAP h (n downto 0)) by induction hypothesis
4429 = f (HD (MAP h (n downto 0))) ::
4430 MAP h (n downto 0) by definition of g
4431 Now f (HD (MAP h (n downto 0)))
4432 = f (HD (MAP h (MAP (\x. n - x) [0 .. n]))) by listRangeINC_REVERSE
4433 = f (HD (MAP h o (\x. n - x) [0 .. n])) by MAP_COMPOSE
4434 = f ((h o (\x. n - x)) 0) by MAP
4435 = f (h n)
4436 = f (FUNPOW f n u) by definition of h
4437 = FUNPOW (n + 1) u by FUNPOW_SUC
4438 = h (n + 1) by definition of h
4439 so h (n + 1) :: MAP h (n downto 0)
4440 = MAP h ((n + 1) :: (n downto 0)) by MAP
4441 = MAP h (REVERSE (SNOC (n+1) [0 .. n])) by REVERSE_SNOC
4442 = MAP h (SUC n downto 0) by listRangeINC_SNOC
4443*)
4444Theorem FUNPOW_cons_eq_map_0:
4445 !f u n. FUNPOW (\ls. f (HD ls)::ls) n [u] =
4446 MAP (\j. FUNPOW f j u) (n downto 0)
4447Proof
4448 ntac 2 strip_tac >>
4449 Induct >-
4450 rw[] >>
4451 qabbrev_tac `g = \ls. f (HD ls)::ls` >>
4452 qabbrev_tac `h = \j. FUNPOW f j u` >>
4453 rw[] >>
4454 `f (HD (MAP h (n downto 0))) = h (n + 1)` by
4455 (`[0 .. n] = 0 :: [1 .. n]` by rw[listRangeINC_CONS] >>
4456 fs[listRangeINC_REVERSE, MAP_COMPOSE, GSYM FUNPOW_SUC, ADD1, Abbr`h`]) >>
4457 `FUNPOW g (SUC n) [u] = g (FUNPOW g n [u])` by rw[FUNPOW_SUC] >>
4458 `_ = g (MAP h (n downto 0))` by fs[] >>
4459 `_ = h (n + 1) :: MAP h (n downto 0)` by rw[Abbr`g`] >>
4460 `_ = MAP h ((n + 1) :: (n downto 0))` by rw[] >>
4461 `_ = MAP h (REVERSE (SNOC (n+1) [0 .. n]))` by rw[REVERSE_SNOC] >>
4462 rw[listRangeINC_SNOC, ADD1]
4463QED
4464
4465(* Idea: when applying incremental cons (f head) to a singleton [f(u)] for (n-1) times,
4466 the result is the list [f^n(u), .... f(u)]. *)
4467
4468(* Theorem: 0 < n ==> (FUNPOW (\ls. f (HD ls)::ls) (n - 1) [f u] =
4469 MAP (\j. FUNPOW f j u) (n downto 1)) *)
4470(* Proof:
4471 Let g = (\ls. f (HD ls)::ls),
4472 h = (\j. FUNPOW f j u).
4473 By induction on n.
4474 Base: FUNPOW g 0 [f u] = MAP h (REVERSE [1 .. 1])
4475 FUNPOW g 0 [f u]
4476 = [f u] by FUNPOW_0
4477 = [FUNPOW f 1 u] by FUNPOW_1
4478 = MAP h [1] by MAP
4479 = MAP h (REVERSE [1 .. 1]) by REVERSE
4480 Step: 0 < n ==> FUNPOW g (n-1) [f u] = MAP h (n downto 1) ==>
4481 FUNPOW g n [f u] = MAP h (REVERSE [1 .. SUC n])
4482 The case n = 0 is the base case. For n <> 0,
4483 FUNPOW g n [f u]
4484 = g (FUNPOW g (n-1) [f u]) by FUNPOW_SUC
4485 = g (MAP h (n downto 1)) by induction hypothesis
4486 = f (HD (MAP h (n downto 1))) ::
4487 MAP h (n downto 1) by definition of g
4488 Now f (HD (MAP h (n downto 1)))
4489 = f (HD (MAP h (MAP (\x. n + 1 - x) [1 .. n]))) by listRangeINC_REVERSE
4490 = f (HD (MAP h o (\x. n + 1 - x) [1 .. n])) by MAP_COMPOSE
4491 = f ((h o (\x. n + 1 - x)) 1) by MAP
4492 = f (h n)
4493 = f (FUNPOW f n u) by definition of h
4494 = FUNPOW (n + 1) u by FUNPOW_SUC
4495 = h (n + 1) by definition of h
4496 so h (n + 1) :: MAP h (n downto 1)
4497 = MAP h ((n + 1) :: (n downto 1)) by MAP
4498 = MAP h (REVERSE (SNOC (n+1) [1 .. n])) by REVERSE_SNOC
4499 = MAP h (REVERSE [1 .. SUC n]) by listRangeINC_SNOC
4500*)
4501Theorem FUNPOW_cons_eq_map_1:
4502 !f u n. 0 < n ==> (FUNPOW (\ls. f (HD ls)::ls) (n - 1) [f u] =
4503 MAP (\j. FUNPOW f j u) (n downto 1))
4504Proof
4505 ntac 2 strip_tac >>
4506 Induct >-
4507 simp[] >>
4508 rw[] >>
4509 qabbrev_tac `g = \ls. f (HD ls)::ls` >>
4510 qabbrev_tac `h = \j. FUNPOW f j u` >>
4511 Cases_on `n = 0` >-
4512 rw[Abbr`g`, Abbr`h`] >>
4513 `f (HD (MAP h (n downto 1))) = h (n + 1)` by
4514 (`[1 .. n] = 1 :: [2 .. n]` by rw[listRangeINC_CONS] >>
4515 fs[listRangeINC_REVERSE, MAP_COMPOSE, GSYM FUNPOW_SUC, ADD1, Abbr`h`]) >>
4516 `n = SUC (n-1)` by decide_tac >>
4517 `FUNPOW g n [f u] = g (FUNPOW g (n - 1) [f u])` by metis_tac[FUNPOW_SUC] >>
4518 `_ = g (MAP h (n downto 1))` by fs[] >>
4519 `_ = h (n + 1) :: MAP h (n downto 1)` by rw[Abbr`g`] >>
4520 `_ = MAP h ((n + 1) :: (n downto 1))` by rw[] >>
4521 `_ = MAP h (REVERSE (SNOC (n+1) [1 .. n]))` by rw[REVERSE_SNOC] >>
4522 rw[listRangeINC_SNOC, ADD1]
4523QED
4524
4525(* ------------------------------------------------------------------------- *)
4526(* Binomial Documentation *)
4527(* ------------------------------------------------------------------------- *)
4528(* Definitions and Theorems (# are exported):
4529
4530 Binomial Coefficients:
4531 binomial_def |- (binomial 0 0 = 1) /\ (!n. binomial (SUC n) 0 = 1) /\
4532 (!k. binomial 0 (SUC k) = 0) /\
4533 !n k. binomial (SUC n) (SUC k) = binomial n k + binomial n (SUC k)
4534 binomial_alt |- !n k. binomial n 0 = 1 /\ binomial 0 (k + 1) = 0 /\
4535 binomial (n + 1) (k + 1) = binomial n k + binomial n (k + 1)
4536 binomial_less_0 |- !n k. n < k ==> (binomial n k = 0)
4537 binomial_n_0 |- !n. binomial n 0 = 1
4538 binomial_n_n |- !n. binomial n n = 1
4539 binomial_0_n |- !n. binomial 0 n = if n = 0 then 1 else 0
4540 binomial_recurrence |- !n k. binomial (SUC n) (SUC k) = binomial n k + binomial n (SUC k)
4541 binomial_formula |- !n k. binomial (n + k) k * (FACT n * FACT k) = FACT (n + k)
4542 binomial_formula2 |- !n k. k <= n ==> (FACT n = binomial n k * (FACT (n - k) * FACT k))
4543 binomial_formula3 |- !n k. k <= n ==> (binomial n k = FACT n DIV (FACT k * FACT (n - k)))
4544 binomial_fact |- !n k. k <= n ==> (binomial n k = FACT n DIV (FACT k * FACT (n - k)))
4545 binomial_n_k |- !n k. k <= n ==> (binomial n k = FACT n DIV FACT k DIV FACT (n - k)
4546 binomial_n_1 |- !n. binomial n 1 = n
4547 binomial_sym |- !n k. k <= n ==> (binomial n k = binomial n (n - k))
4548 binomial_is_integer |- !n k. k <= n ==> (FACT k * FACT (n - k)) divides (FACT n)
4549 binomial_pos |- !n k. k <= n ==> 0 < binomial n k
4550 binomial_eq_0 |- !n k. (binomial n k = 0) <=> n < k
4551 binomial_1_n |- !n. binomial 1 n = if 1 < n then 0 else 1
4552 binomial_up_eqn |- !n. 0 < n ==> !k. n * binomial (n - 1) k = (n - k) * binomial n k
4553 binomial_up |- !n. 0 < n ==> !k. binomial (n - 1) k = (n - k) * binomial n k DIV n
4554 binomial_right_eqn |- !n. 0 < n ==> !k. (k + 1) * binomial n (k + 1) = (n - k) * binomial n k
4555 binomial_right |- !n. 0 < n ==> !k. binomial n (k + 1) = (n - k) * binomial n k DIV (k + 1)
4556 binomial_monotone |- !n k. k < HALF n ==> binomial n k < binomial n (k + 1)
4557 binomial_max |- !n k. binomial n k <= binomial n (HALF n)
4558 binomial_iff |- !f. f = binomial <=>
4559 !n k. f n 0 = 1 /\ f 0 (k + 1) = 0 /\
4560 f (n + 1) (k + 1) = f n k + f n (k + 1)
4561
4562 Primes and Binomial Coefficients:
4563 prime_divides_binomials |- !n. prime n ==> 1 < n /\ !k. 0 < k /\ k < n ==> n divides (binomial n k)
4564 prime_divides_binomials_alt |- !n k. prime n /\ 0 < k /\ k < n ==> n divides binomial n k
4565 prime_divisor_property |- !n p. 1 < n /\ p < n /\ prime p /\ p divides n ==> ~(p divides (FACT (n - 1) DIV FACT (n - p)))
4566 divides_binomials_imp_prime |- !n. 1 < n /\ (!k. 0 < k /\ k < n ==> n divides (binomial n k)) ==> prime n
4567 prime_iff_divides_binomials |- !n. prime n <=> 1 < n /\ !k. 0 < k /\ k < n ==> n divides (binomial n k)
4568 prime_iff_divides_binomials_alt
4569 |- !n. prime n <=> 1 < n /\ !k. 0 < k /\ k < n ==> binomial n k MOD n = 0
4570
4571 Binomial Theorem:
4572 GENLIST_binomial_index_shift |- !n x y. GENLIST ((\k. binomial n k * x ** SUC (n - k) * y ** k) o SUC) n =
4573 GENLIST (\k. binomial n (SUC k) * x ** (n - k) * y ** SUC k) n
4574 binomial_index_shift |- !n x y. (\k. binomial (SUC n) k * x ** (SUC n - k) * y ** k) o SUC =
4575 (\k. binomial (SUC n) (SUC k) * x ** (n - k) * y ** SUC k)
4576 binomial_term_merge_x |- !n x y. (\k. x * k) o (\k. binomial n k * x ** (n - k) * y ** k) =
4577 (\k. binomial n k * x ** SUC (n - k) * y ** k)
4578 binomial_term_merge_y |- !n x y. (\k. y * k) o (\k. binomial n k * x ** (n - k) * y ** k) =
4579 (\k. binomial n k * x ** (n - k) * y ** SUC k)
4580 binomial_thm |- !n x y. (x + y) ** n = SUM (GENLIST (\k. binomial n k * x ** (n - k) * y ** k) (SUC n))
4581 binomial_thm_alt |- !n x y. (x + y) ** n = SUM (GENLIST (\k. binomial n k * x ** (n - k) * y ** k) (n + 1))
4582 binomial_sum |- !n. SUM (GENLIST (binomial n) (SUC n)) = 2 ** n
4583 binomial_sum_alt |- !n. SUM (GENLIST (binomial n) (n + 1)) = 2 ** n
4584
4585 Binomial Horizontal List:
4586 binomial_horizontal_0 |- binomial_horizontal 0 = [1]
4587 binomial_horizontal_len |- !n. LENGTH (binomial_horizontal n) = n + 1
4588 binomial_horizontal_mem |- !n k. k < n + 1 ==> MEM (binomial n k) (binomial_horizontal n)
4589 binomial_horizontal_mem_iff |- !n k. MEM (binomial n k) (binomial_horizontal n) <=> k <= n
4590 binomial_horizontal_member |- !n x. MEM x (binomial_horizontal n) <=> ?k. k <= n /\ (x = binomial n k)
4591 binomial_horizontal_element |- !n k. k <= n ==> (EL k (binomial_horizontal n) = binomial n k)
4592 binomial_horizontal_pos |- !n. EVERY (\x. 0 < x) (binomial_horizontal n)
4593 binomial_horizontal_pos_alt |- !n x. MEM x (binomial_horizontal n) ==> 0 < x
4594 binomial_horizontal_sum |- !n. SUM (binomial_horizontal n) = 2 ** n
4595 binomial_horizontal_max |- !n. MAX_LIST (binomial_horizontal n) = binomial n (HALF n)
4596 binomial_row_max |- !n. MAX_SET (IMAGE (binomial n) (count (n + 1))) = binomial n (HALF n)
4597 binomial_product_identity |- !m n k. k <= m /\ m <= n ==>
4598 (binomial m k * binomial n m = binomial n k * binomial (n - k) (m - k))
4599 binomial_middle_upper_bound |- !n. binomial n (HALF n) <= 4 ** HALF n
4600
4601 Stirling's Approximation:
4602 Stirling = (!n. FACT n = (SQRT (2 * pi * n)) * (n DIV e) ** n) /\
4603 (!n. SQRT n = n ** h) /\ (2 * h = 1) /\ (0 < pi) /\ (0 < e) /\
4604 (!a b x y. (a * b) DIV (x * y) = (a DIV x) * (b DIV y)) /\
4605 (!a b c. (a DIV c) DIV (b DIV c) = a DIV b)
4606 binomial_middle_by_stirling |- Stirling ==>
4607 !n. 0 < n /\ EVEN n ==> (binomial n (HALF n) = 2 ** (n + 1) DIV SQRT (2 * pi * n))
4608
4609 Useful theorems for Binomial:
4610 binomial_range_shift |- !n . 0 < n ==> ((!k. 0 < k /\ k < n ==> ((binomial n k) MOD n = 0)) <=>
4611 (!h. h < PRE n ==> ((binomial n (SUC h)) MOD n = 0)))
4612 binomial_mod_zero |- !n. 0 < n ==> !k. (binomial n k MOD n = 0) <=>
4613 (!x y. (binomial n k * x ** (n-k) * y ** k) MOD n = 0)
4614 binomial_range_shift_alt |- !n . 0 < n ==> ((!k. 0 < k /\ k < n ==>
4615 (!x y. ((binomial n k * x ** (n - k) * y ** k) MOD n = 0))) <=>
4616 (!h. h < PRE n ==> (!x y. ((binomial n (SUC h) * x ** (n - (SUC h)) * y ** (SUC h)) MOD n = 0))))
4617 binomial_mod_zero_alt |- !n. 0 < n ==> ((!k. 0 < k /\ k < n ==> ((binomial n k) MOD n = 0)) <=>
4618 !x y. SUM (GENLIST ((\k. (binomial n k * x ** (n - k) * y ** k) MOD n) o SUC) (PRE n)) = 0)
4619
4620 Binomial Theorem with prime exponent:
4621 binomial_thm_prime |- !p. prime p ==> (!x y. (x + y) ** p MOD p = (x ** p + y ** p) MOD p)
4622*)
4623
4624(* ------------------------------------------------------------------------- *)
4625(* Binomial Coefficients *)
4626(* ------------------------------------------------------------------------- *)
4627
4628(* Define Binomials:
4629 C(n,0) = 1
4630 C(0,k) = 0 if k > 0
4631 C(n+1,k+1) = C(n,k) + C(n,k+1)
4632*)
4633Definition binomial_def:
4634 (binomial 0 0 = 1) /\
4635 (binomial (SUC n) 0 = 1) /\
4636 (binomial 0 (SUC k) = 0) /\
4637 (binomial (SUC n) (SUC k) = binomial n k + binomial n (SUC k))
4638End
4639
4640(* Theorem: alternative definition of C(n,k). *)
4641(* Proof: by binomial_def. *)
4642Theorem binomial_alt:
4643 !n k. (binomial n 0 = 1) /\
4644 (binomial 0 (k + 1) = 0) /\
4645 (binomial (n + 1) (k + 1) = binomial n k + binomial n (k + 1))
4646Proof
4647 rewrite_tac[binomial_def, GSYM ADD1] >>
4648 (Cases_on `n` >> simp[binomial_def])
4649QED
4650
4651(* Basic properties *)
4652
4653(* Theorem: C(n,k) = 0 if n < k *)
4654(* Proof:
4655 By induction on n.
4656 Base case: C(0,k) = 0 if 0 < k, by definition.
4657 Step case: assume C(n,k) = 0 if n < k.
4658 then for SUC n < k,
4659 C(SUC n, k)
4660 = C(SUC n, SUC h) where k = SUC h
4661 = C(n,h) + C(n,SUC h) h < SUC h = k
4662 = 0 + 0 by induction hypothesis
4663 = 0
4664*)
4665Theorem binomial_less_0:
4666 !n k. n < k ==> (binomial n k = 0)
4667Proof
4668 Induct_on `n` >-
4669 metis_tac[binomial_def, num_CASES, NOT_ZERO] >>
4670 rw[binomial_def] >>
4671 `?h. k = SUC h` by metis_tac[SUC_NOT, NOT_ZERO, SUC_EXISTS, LESS_TRANS] >>
4672 metis_tac[binomial_def, LESS_MONO_EQ, LESS_TRANS, LESS_SUC, ADD_0]
4673QED
4674
4675(* Theorem: C(n,0) = 1 *)
4676(* Proof:
4677 If n = 0, C(n, 0) = C(0, 0) = 1 by binomial_def
4678 If n <> 0, n = SUC m, and C(SUC m, 0) = 1 by binomial_def
4679*)
4680Theorem binomial_n_0:
4681 !n. binomial n 0 = 1
4682Proof
4683 metis_tac[binomial_def, num_CASES]
4684QED
4685
4686(* Theorem: C(n,n) = 1 *)
4687(* Proof:
4688 By induction on n.
4689 Base case: C(0,0) = 1, true by binomial_def.
4690 Step case: assume C(n,n) = 1
4691 C(SUC n, SUC n)
4692 = C(n,n) + C(n,SUC n)
4693 = 1 + C(n,SUC n) by induction hypothesis
4694 = 1 + 0 by binomial_less_0
4695 = 1
4696*)
4697Theorem binomial_n_n:
4698 !n. binomial n n = 1
4699Proof
4700 Induct_on `n` >-
4701 metis_tac[binomial_def] >>
4702 metis_tac[binomial_def, LESS_SUC, binomial_less_0, ADD_0]
4703QED
4704
4705(* Theorem: binomial 0 n = if n = 0 then 1 else 0 *)
4706(* Proof:
4707 If n = 0,
4708 binomial 0 0 = 1 by binomial_n_0
4709 If n <> 0, then 0 < n.
4710 binomial 0 n = 0 by binomial_less_0
4711*)
4712Theorem binomial_0_n:
4713 !n. binomial 0 n = if n = 0 then 1 else 0
4714Proof
4715 rw[binomial_n_0, binomial_less_0]
4716QED
4717
4718(* Theorem: C(n+1,k+1) = C(n,k) + C(n,k+1) *)
4719(* Proof: by definition. *)
4720Theorem binomial_recurrence:
4721 !n k. binomial (SUC n) (SUC k) = binomial n k + binomial n (SUC k)
4722Proof
4723 rw[binomial_def]
4724QED
4725
4726(* Theorem: C(n+k,k) = (n+k)!/n!k! *)
4727(* Proof:
4728 By induction on k.
4729 Base case: C(n,0) = n!n! = 1 by binomial_n_0
4730 Step case: assume C(n+k,k) = (n+k)!/n!k!
4731 To prove C(n+SUC k, SUC k) = (n+SUC k)!/n!(SUC k)!
4732 By induction on n.
4733 Base case: C(SUC k, SUC k) = (SUC k)!/(SUC k)! = 1 by binomial_n_n
4734 Step case: assume C(n+SUC k, SUC k) = (n +SUC k)!/n!(SUC k)!
4735 To prove C(SUC n + SUC k, SUC k) = (SUC n + SUC k)!/(SUC n)!(SUC k)!
4736 C(SUC n + SUC k, SUC k)
4737 = C(SUC SUC (n+k), SUC k)
4738 = C(SUC (n+k),k) + C(SUC (n+k), SUC k)
4739 = C(SUC n + k, k) + C(n + SUC k, SUC k)
4740 = (SUC n + k)!/(SUC n)!k! + (n + SUC k)!/n!(SUC k)! by two induction hypothesis
4741 = ((SUC n + k)!(SUC k) + (n + SUC k)(SUC n))/(SUC n)!(SUC k)!
4742 = (SUC n + SUC k)!/(SUC n)!(SUC k)!
4743*)
4744Theorem binomial_formula:
4745 !n k. binomial (n+k) k * (FACT n * FACT k) = FACT (n+k)
4746Proof
4747 Induct_on `k` >-
4748 metis_tac[binomial_n_0, FACT, MULT_CLAUSES, ADD_0] >>
4749 Induct_on `n` >-
4750 metis_tac[binomial_n_n, FACT, MULT_CLAUSES, ADD_CLAUSES] >>
4751 `SUC n + SUC k = SUC (SUC (n+k))` by decide_tac >>
4752 `SUC (n + k) = SUC n + k` by decide_tac >>
4753 `binomial (SUC n + SUC k) (SUC k) * (FACT (SUC n) * FACT (SUC k)) =
4754 (binomial (SUC (n + k)) k +
4755 binomial (SUC (n + k)) (SUC k)) * (FACT (SUC n) * FACT (SUC k))`
4756 by metis_tac[binomial_recurrence] >>
4757 `_ = binomial (SUC (n + k)) k * (FACT (SUC n) * FACT (SUC k)) +
4758 binomial (SUC (n + k)) (SUC k) * (FACT (SUC n) * FACT (SUC k))`
4759 by metis_tac[RIGHT_ADD_DISTRIB] >>
4760 `_ = binomial (SUC n + k) k * (FACT (SUC n) * ((SUC k) * FACT k)) +
4761 binomial (n + SUC k) (SUC k) * ((SUC n) * FACT n * FACT (SUC k))`
4762 by metis_tac[ADD_COMM, SUC_ADD_SYM, FACT] >>
4763 `_ = binomial (SUC n + k) k * FACT (SUC n) * FACT k * (SUC k) +
4764 binomial (n + SUC k) (SUC k) * FACT n * FACT (SUC k) * (SUC n)`
4765 by metis_tac[MULT_COMM, MULT_ASSOC] >>
4766 `_ = FACT (SUC n + k) * SUC k + FACT (n + SUC k) * SUC n`
4767 by metis_tac[MULT_COMM, MULT_ASSOC] >>
4768 `_ = FACT (SUC (n+k)) * SUC k + FACT (SUC (n+k)) * SUC n`
4769 by metis_tac[ADD_COMM, SUC_ADD_SYM] >>
4770 `_ = FACT (SUC (n+k)) * (SUC k + SUC n)` by metis_tac[LEFT_ADD_DISTRIB] >>
4771 `_ = (SUC n + SUC k) * FACT (SUC (n+k))` by metis_tac[MULT_COMM, ADD_COMM] >>
4772 metis_tac[FACT]
4773QED
4774
4775(* Theorem: C(n,k) = n!/k!(n-k)! for 0 <= k <= n *)
4776(* Proof:
4777 FACT n
4778 = FACT ((n-k)+k) by SUB_ADD, k <= n.
4779 = binomial ((n-k)+k) k * (FACT (n-k) * FACT k) by binomial_formula
4780 = binomial n k * (FACT (n-k) * FACT k)) by SUB_ADD, k <= n.
4781*)
4782Theorem binomial_formula2:
4783 !n k. k <= n ==> (FACT n = binomial n k * (FACT (n-k) * FACT k))
4784Proof
4785 metis_tac[binomial_formula, SUB_ADD]
4786QED
4787
4788(* Theorem: k <= n ==> binomial n k = (FACT n) DIV ((FACT k) * (FACT (n - k))) *)
4789(* Proof:
4790 binomial n k
4791 = (binomial n k * (FACT (n - k) * FACT k)) DIV ((FACT (n - k) * FACT k)) by MULT_DIV
4792 = (FACT n) DIV ((FACT (n - k) * FACT k)) by binomial_formula2
4793 = (FACT n) DIV ((FACT k * FACT (n - k))) by MULT_COMM
4794*)
4795Theorem binomial_formula3:
4796 !n k. k <= n ==> (binomial n k = (FACT n) DIV ((FACT k) * (FACT (n - k))))
4797Proof
4798 metis_tac[binomial_formula2, MULT_COMM, MULT_DIV, MULT_EQ_0, FACT_LESS, NOT_ZERO]
4799QED
4800
4801(* Theorem alias. *)
4802Theorem binomial_fact = binomial_formula3;
4803(* val binomial_fact = |- !n k. k <= n ==> (binomial n k = FACT n DIV (FACT k * FACT (n - k))): thm *)
4804
4805(* Theorem: k <= n ==> binomial n k = (FACT n) DIV (FACT k) DIV (FACT (n - k)) *)
4806(* Proof:
4807 binomial n k
4808 = (FACT n) DIV ((FACT k * FACT (n - k))) by binomial_formula3
4809 = (FACT n) DIV (FACT k) DIV (FACT (n - k)) by DIV_DIV_DIV_MULT
4810*)
4811Theorem binomial_n_k:
4812 !n k. k <= n ==> (binomial n k = (FACT n) DIV (FACT k) DIV (FACT (n - k)))
4813Proof
4814 metis_tac[DIV_DIV_DIV_MULT, binomial_formula3, MULT_EQ_0, FACT_LESS, NOT_ZERO]
4815QED
4816
4817(* Theorem: binomial n 1 = n *)
4818(* Proof:
4819 If n = 0,
4820 binomial 0 1
4821 = if 1 = 0 then 1 else 0 by binomial_0_n
4822 = 0 by 1 = 0 = F
4823 If n <> 0, then 0 < n.
4824 Thus 1 <= n, and n = SUC (n-1) by 0 < n
4825 binomial n 1
4826 = FACT n DIV FACT 1 DIV FACT (n - 1) by binomial_n_k, 1 <= n
4827 = FACT n DIV 1 DIV (FACT (n-1)) by FACT, ONE
4828 = FACT n DIV (FACT (n-1)) by DIV_1
4829 = (n * FACT (n-1)) DIV (FACT (n-1)) by FACT
4830 = n by MULT_DIV, FACT_LESS
4831*)
4832Theorem binomial_n_1:
4833 !n. binomial n 1 = n
4834Proof
4835 rpt strip_tac >>
4836 Cases_on `n = 0` >-
4837 rw[binomial_0_n] >>
4838 `1 <= n /\ (n = SUC (n-1))` by decide_tac >>
4839 `binomial n 1 = FACT n DIV FACT 1 DIV FACT (n - 1)` by rw[binomial_n_k] >>
4840 `_ = FACT n DIV 1 DIV (FACT (n-1))` by EVAL_TAC >>
4841 `_ = FACT n DIV (FACT (n-1))` by rw[] >>
4842 `_ = (n * FACT (n-1)) DIV (FACT (n-1))` by metis_tac[FACT] >>
4843 `_ = n` by rw[MULT_DIV, FACT_LESS] >>
4844 rw[]
4845QED
4846
4847(* Theorem: k <= n ==> (binomial n k = binomial n (n-k)) *)
4848(* Proof:
4849 Note (n-k) <= n always.
4850 binomial n k
4851 = (FACT n) DIV (FACT k * FACT (n - k)) by binomial_formula3, k <= n.
4852 = (FACT n) DIV (FACT (n - k) * FACT k) by MULT_COMM
4853 = (FACT n) DIV (FACT (n - k) * FACT (n-(n-k))) by n - (n-k) = k
4854 = binomial n (n-k) by binomial_formula3, (n-k) <= n.
4855*)
4856Theorem binomial_sym:
4857 !n k. k <= n ==> (binomial n k = binomial n (n-k))
4858Proof
4859 rpt strip_tac >>
4860 `n - (n-k) = k` by decide_tac >>
4861 `(n-k) <= n` by decide_tac >>
4862 rw[binomial_formula3, MULT_COMM]
4863QED
4864
4865(* Theorem: k <= n ==> (FACT k * FACT (n-k)) divides (FACT n) *)
4866(* Proof:
4867 Since FACT n = binomial n k * (FACT (n - k) * FACT k) by binomial_formula2
4868 = binomial n k * (FACT k * FACT (n - k)) by MULT_COMM
4869 Hence (FACT k * FACT (n-k)) divides (FACT n) by divides_def
4870*)
4871Theorem binomial_is_integer:
4872 !n k. k <= n ==> (FACT k * FACT (n-k)) divides (FACT n)
4873Proof
4874 metis_tac[binomial_formula2, MULT_COMM, divides_def]
4875QED
4876
4877(* Theorem: k <= n ==> 0 < binomial n k *)
4878(* Proof:
4879 Since FACT n = binomial n k * (FACT (n - k) * FACT k) by binomial_formula2
4880 and 0 < FACT n, 0 < FACT (n-k), 0 < FACT k by FACT_LESS
4881 Hence 0 < binomial n k by ZERO_LESS_MULT
4882*)
4883Theorem binomial_pos:
4884 !n k. k <= n ==> 0 < binomial n k
4885Proof
4886 metis_tac[binomial_formula2, FACT_LESS, ZERO_LESS_MULT]
4887QED
4888
4889(* Theorem: (binomial n k = 0) <=> n < k *)
4890(* Proof:
4891 If part: (binomial n k = 0) ==> n < k
4892 By contradiction, suppose k <= n.
4893 Then 0 < binomial n k by binomial_pos
4894 This contradicts binomial n k = 0 by NOT_ZERO
4895 Only-if part: n < k ==> (binomial n k = 0)
4896 This is true by binomial_less_0
4897*)
4898Theorem binomial_eq_0:
4899 !n k. (binomial n k = 0) <=> n < k
4900Proof
4901 rw[EQ_IMP_THM] >| [
4902 spose_not_then strip_assume_tac >>
4903 `k <= n` by decide_tac >>
4904 metis_tac[binomial_pos, NOT_ZERO],
4905 rw[binomial_less_0]
4906 ]
4907QED
4908
4909(* Theorem: binomial 1 n = if 1 < n then 0 else 1 *)
4910(* Proof:
4911 If n = 0, binomial 1 0 = 1 by binomial_n_0
4912 If n = 1, binomial 1 1 = 1 by binomial_n_1
4913 Otherwise, binomial 1 n = 0 by binomial_eq_0, 1 < n
4914*)
4915Theorem binomial_1_n:
4916 !n. binomial 1 n = if 1 < n then 0 else 1
4917Proof
4918 rw[binomial_eq_0] >>
4919 `n = 0 \/ n = 1` by decide_tac >-
4920 simp[binomial_n_0] >>
4921 simp[binomial_n_1]
4922QED
4923
4924(* Relating Binomial to its up-entry:
4925
4926 binomial n k = (n, k, n-k) = n! / k! (n-k)!
4927 binomial (n-1) k = (n-1, k, n-1-k) = (n-1)! / k! (n-1-k)!
4928 = (n!/n) / k! ((n-k)!/(n-k))
4929 = (n-k) * binomial n k / n
4930*)
4931
4932(* Theorem: 0 < n ==> !k. n * binomial (n-1) k = (n-k) * (binomial n k) *)
4933(* Proof:
4934 If n <= k, that is n-1 < k.
4935 So binomial (n-1) k = 0 by binomial_less_0
4936 and n - k = 0 by arithmetic
4937 Hence true by MULT_EQ_0
4938 Otherwise k < n,
4939 or k <= n, 1 <= n-k, k <= n-1
4940 Therefore,
4941 FACT n = binomial n k * (FACT (n - k) * FACT k) by binomial_formula2, k <= n.
4942 = binomial n k * ((n - k) * FACT (n-1-k) * FACT k) by FACT
4943 = binomial n k * (n - k) * (FACT (n-1-k) * FACT k) by MULT_ASSOC
4944 = (n - k) * binomial n k * (FACT (n-1-k) * FACT k) by MULT_COMM
4945 FACT n = n * FACT (n-1) by FACT
4946 = n * (binomial (n-1) k * (FACT (n-1-k) * FACT k)) by binomial_formula2, k <= n-1.
4947 = (n * binomial (n-1) k) * (FACT (n-1-k) * FACT k) by MULT_ASSOC
4948 Since 0 < FACT (n-1-k) * FACT k by FACT_LESS, MULT_EQ_0
4949 n * binomial (n-1) k = (n-k) * (binomial n k) by MULT_RIGHT_CANCEL
4950*)
4951Theorem binomial_up_eqn:
4952 !n. 0 < n ==> !k. n * binomial (n-1) k = (n-k) * (binomial n k)
4953Proof
4954 rpt strip_tac >>
4955 `!n. n <> 0 <=> 0 < n` by decide_tac >>
4956 Cases_on `n <= k` >| [
4957 `n-1 < k /\ (n - k = 0)` by decide_tac >>
4958 `binomial (n - 1) k = 0` by rw[binomial_less_0] >>
4959 metis_tac[MULT_EQ_0],
4960 `k < n /\ k <= n /\ 1 <= n-k /\ k <= n-1` by decide_tac >>
4961 `SUC (n-1) = n` by decide_tac >>
4962 `SUC (n-1-k) = n - k` by metis_tac[SUB_PLUS, ADD_COMM, ADD1, SUB_ADD] >>
4963 `FACT n = binomial n k * (FACT (n - k) * FACT k)` by rw[binomial_formula2] >>
4964 `_ = binomial n k * ((n - k) * FACT (n-1-k) * FACT k)` by metis_tac[FACT] >>
4965 `_ = binomial n k * (n - k) * (FACT (n-1-k) * FACT k)` by rw[MULT_ASSOC] >>
4966 `_ = (n - k) * binomial n k * (FACT (n-1-k) * FACT k)` by rw_tac std_ss[MULT_COMM] >>
4967 `FACT n = n * FACT (n-1)` by metis_tac[FACT] >>
4968 `_ = n * (binomial (n-1) k * (FACT (n-1-k) * FACT k))` by rw_tac std_ss[GSYM binomial_formula2] >>
4969 `_ = (n * binomial (n-1) k) * (FACT (n-1-k) * FACT k)` by rw[MULT_ASSOC] >>
4970 metis_tac[FACT_LESS, MULT_EQ_0, MULT_RIGHT_CANCEL]
4971 ]
4972QED
4973
4974(* Theorem: 0 < n ==> !k. binomial (n-1) k = ((n-k) * (binomial n k)) DIV n *)
4975(* Proof:
4976 Since n * binomial (n-1) k = (n-k) * (binomial n k) by binomial_up_eqn
4977 binomial (n-1) k = (n-k) * (binomial n k) DIV n by DIV_SOLVE, 0 < n.
4978*)
4979Theorem binomial_up:
4980 !n. 0 < n ==> !k. binomial (n-1) k = ((n-k) * (binomial n k)) DIV n
4981Proof
4982 rw[binomial_up_eqn, DIV_SOLVE]
4983QED
4984
4985(* Relating Binomial to its right-entry:
4986
4987 binomial n k = (n, k, n-k) = n! / k! (n-k)!
4988 binomial n (k+1) = (n, k+1, n-k-1) = n! / (k+1)! (n-k-1)!
4989 = n! / (k+1) * k! ((n-k)!/(n-k))
4990 = (n-k) * binomial n k / (k+1)
4991*)
4992
4993(* Theorem: 0 < n ==> !k. (k + 1) * binomial n (k+1) = (n - k) * binomial n k *)
4994(* Proof:
4995 If n <= k, that is n < k+1.
4996 So binomial n (k+1) = 0 by binomial_less_0
4997 and n - k = 0 by arithmetic
4998 Hence true by MULT_EQ_0
4999 Otherwise k < n,
5000 or k <= n, 1 <= n-k, k+1 <= n
5001 Therefore,
5002 FACT n = binomial n k * (FACT (n - k) * FACT k) by binomial_formula2, k <= n.
5003 = binomial n k * ((n - k) * FACT (n-1-k) * FACT k) by FACT
5004 = binomial n k * (n - k) * (FACT (n-1-k) * FACT k) by MULT_ASSOC
5005 = (n - k) * binomial n k * (FACT (n-1-k) * FACT k) by MULT_COMM
5006 FACT n = binomial n (k+1) * (FACT (n-(k+1)) * FACT (k+1)) by binomial_formula2, k+1 <= n.
5007 = binomial n (k+1) * (FACT (n-1-k) * FACT (k+1)) by SUB_PLUS, ADD_COMM
5008 = binomial n (k+1) * (FACT (n-1-k) * ((k+1) * FACT k)) by FACT
5009 = binomial n (k+1) * ((k+1) * (FACT (n-1-k) * FACT k)) by MULT_ASSOC, MULT_COMM
5010 = (k+1) * binomial n (k+1) * (FACT (n-1-k) * FACT k) by MULT_COMM, MULT_ASSOC
5011 Since 0 < FACT (n-1-k) * FACT k by FACT_LESS, MULT_EQ_0
5012 (k+1) * binomial n (k+1) = (n-k) * (binomial n k) by MULT_RIGHT_CANCEL
5013*)
5014Theorem binomial_right_eqn:
5015 !n. 0 < n ==> !k. (k + 1) * binomial n (k+1) = (n - k) * binomial n k
5016Proof
5017 rpt strip_tac >>
5018 `!n. n <> 0 <=> 0 < n` by decide_tac >>
5019 Cases_on `n <= k` >| [
5020 `n < k+1` by decide_tac >>
5021 `binomial n (k+1) = 0` by rw[binomial_less_0] >>
5022 `n - k = 0` by decide_tac >>
5023 metis_tac[MULT_EQ_0],
5024 `k < n /\ k <= n /\ 1 <= n-k /\ k+1 <= n` by decide_tac >>
5025 `SUC k = k + 1` by decide_tac >>
5026 `SUC (n-1-k) = n - k` by metis_tac[SUB_PLUS, ADD_COMM, ADD1, SUB_ADD] >>
5027 `FACT n = binomial n k * (FACT (n - k) * FACT k)` by rw[binomial_formula2] >>
5028 `_ = binomial n k * ((n - k) * FACT (n-1-k) * FACT k)` by metis_tac[FACT] >>
5029 `_ = binomial n k * (n - k) * (FACT (n-1-k) * FACT k)` by rw[MULT_ASSOC] >>
5030 `_ = (n - k) * binomial n k * (FACT (n-1-k) * FACT k)` by rw_tac std_ss[MULT_COMM] >>
5031 `FACT n = binomial n (k+1) * (FACT (n-(k+1)) * FACT (k+1))` by rw[binomial_formula2] >>
5032 `_ = binomial n (k+1) * (FACT (n-1-k) * FACT (k+1))` by metis_tac[SUB_PLUS, ADD_COMM] >>
5033 `_ = binomial n (k+1) * (FACT (n-1-k) * ((k+1) * FACT k))` by metis_tac[FACT] >>
5034 `_ = binomial n (k+1) * ((FACT (n-1-k) * (k+1)) * FACT k)` by rw[MULT_ASSOC] >>
5035 `_ = binomial n (k+1) * ((k+1) * (FACT (n-1-k)) * FACT k)` by rw_tac std_ss[MULT_COMM] >>
5036 `_ = (binomial n (k+1) * (k+1)) * (FACT (n-1-k) * FACT k)` by rw[MULT_ASSOC] >>
5037 `_ = (k+1) * binomial n (k+1) * (FACT (n-1-k) * FACT k)` by rw_tac std_ss[MULT_COMM] >>
5038 metis_tac[FACT_LESS, MULT_EQ_0, MULT_RIGHT_CANCEL]
5039 ]
5040QED
5041
5042(* Theorem: 0 < n ==> !k. binomial n (k+1) = (n - k) * binomial n k DIV (k+1) *)
5043(* Proof:
5044 Since (k + 1) * binomial n (k+1) = (n - k) * binomial n k by binomial_right_eqn
5045 binomial n (k+1) = (n - k) * binomial n k DIV (k+1) by DIV_SOLVE, 0 < k+1.
5046*)
5047Theorem binomial_right:
5048 !n. 0 < n ==> !k. binomial n (k+1) = (n - k) * binomial n k DIV (k+1)
5049Proof
5050 rw[binomial_right_eqn, DIV_SOLVE, DECIDE ``!k. 0 < k+1``]
5051QED
5052
5053(*
5054 k < HALF n <=> k + 1 <= n - k
5055n = 5, HALF n = 2, binomial 5 k: 1, 5, 10, 10, 5, 1
5056 k= 0, 1, 2, 3, 4, 5
5057 k < 2 <=> k + 1 <= 5 - k
5058 k = 0 1 <= 5 binomial 5 1 >= binomial 5 0
5059 k = 1 2 <= 4 binomial 5 2 >= binomial 5 1
5060n = 6, HALF n = 3, binomial 6 k: 1, 6, 15, 20, 15, 6, 1
5061 k= 0, 1, 2, 3, 4, 5, 6
5062 k < 3 <=> k + 1 <= 6 - k
5063 k = 0 1 <= 6 binomial 6 1 >= binomial 6 0
5064 k = 1 2 <= 5 binomial 6 2 >= binomial 6 1
5065 k = 2 3 <= 4 binomial 6 3 >= binomial 6 2
5066*)
5067
5068(* Theorem: k < HALF n ==> binomial n k < binomial n (k + 1) *)
5069(* Proof:
5070 Note k < HALF n ==> 0 < n by ZERO_DIV, 0 < 2
5071 also k < HALF n ==> k + 1 < n - k by LESS_HALF_IFF
5072 so 0 < k + 1 /\ 0 < n - k by arithmetic
5073 Now (k + 1) * binomial n (k + 1) = (n - k) * binomial n k by binomial_right_eqn, 0 < n
5074 Note HALF n <= n by DIV_LESS_EQ, 0 < 2
5075 so k < HALF n <= n by above
5076 Thus 0 < binomial n k by binomial_pos, k <= n
5077 and 0 < binomial n (k + 1) by MULT_0, MULT_EQ_0
5078 Hence binomial n k < binomial n (k + 1) by MULT_EQ_LESS_TO_MORE
5079*)
5080Theorem binomial_monotone:
5081 !n k. k < HALF n ==> binomial n k < binomial n (k + 1)
5082Proof
5083 rpt strip_tac >>
5084 `k + 1 < n - k` by rw[GSYM LESS_HALF_IFF] >>
5085 `0 < k + 1 /\ 0 < n - k` by decide_tac >>
5086 `(k + 1) * binomial n (k + 1) = (n - k) * binomial n k` by rw[binomial_right_eqn] >>
5087 `HALF n <= n` by rw[DIV_LESS_EQ] >>
5088 `0 < binomial n k` by rw[binomial_pos] >>
5089 `0 < binomial n (k + 1)` by metis_tac[MULT_0, MULT_EQ_0, NOT_ZERO] >>
5090 metis_tac[MULT_EQ_LESS_TO_MORE]
5091QED
5092
5093(* Theorem: binomial n k <= binomial n (HALF n) *)
5094(* Proof:
5095 Since (k + 1) * binomial n (k + 1) = (n - k) * binomial n k by binomial_right_eqn
5096 binomial n (k + 1) / binomial n k = (n - k) / (k + 1)
5097 As k varies from 0, 1, to (n-1), n
5098 the ratio varies from n/1, (n-1)/2, (n-2)/3, ...., 1/n, 0/(n+1).
5099 The ratio is greater than 1 when (n - k) / (k + 1) > 1
5100 or n - k > k + 1
5101 or n > 2 * k + 1
5102 or HALF n >= k + (HALF 1)
5103 or k <= HALF n
5104 Thus (binomial n (HALF n)) is greater than all preceding coefficients.
5105 For k > HALF n, note that (binomial n k = binomial n (n - k)) by binomial_sym
5106 Hence (binomial n (HALF n)) is greater than all succeeding coefficients, too.
5107
5108 If n = 0,
5109 binomial 0 k = 1 or 0 by binomial_0_n
5110 binomial 0 (HALF 0) = 1 by binomial_0_n, ZERO_DIV
5111 Hence true.
5112 If n <> 0,
5113 If k = HALF n, trivially true.
5114 If k < HALF n,
5115 Then binomial n k < binomial n (HALF n) by binomial_monotone, MONOTONE_MAX
5116 Hence true.
5117 If ~(k < HALF n), HALF n < k.
5118 Then n - k <= HALF n by MORE_HALF_IMP
5119 If k > n,
5120 Then binomial n k = 0, hence true by binomial_less_0
5121 If ~(k > n), then k <= n.
5122 Then binomial n k = binomial n (n - k) by binomial_sym, k <= n
5123 If n - k = HALF n, trivially true.
5124 Otherwise, n - k < HALF n,
5125 Thus binomial n (n - k) < binomial n (HALF n) by binomial_monotone, MONOTONE_MAX
5126 Hence true.
5127*)
5128Theorem binomial_max:
5129 !n k. binomial n k <= binomial n (HALF n)
5130Proof
5131 rpt strip_tac >>
5132 Cases_on `n = 0` >-
5133 rw[binomial_0_n] >>
5134 Cases_on `k = HALF n` >-
5135 rw[] >>
5136 Cases_on `k < HALF n` >| [
5137 `binomial n k < binomial n (HALF n)` by rw[binomial_monotone, MONOTONE_MAX] >>
5138 decide_tac,
5139 `HALF n < k` by decide_tac >>
5140 `n - k <= HALF n` by rw[MORE_HALF_IMP] >>
5141 Cases_on `k > n` >-
5142 rw[binomial_less_0] >>
5143 `k <= n` by decide_tac >>
5144 `binomial n k = binomial n (n - k)` by rw[GSYM binomial_sym] >>
5145 Cases_on `n - k = HALF n` >-
5146 rw[] >>
5147 `n - k < HALF n` by decide_tac >>
5148 `binomial n (n - k) < binomial n (HALF n)` by rw[binomial_monotone, MONOTONE_MAX] >>
5149 decide_tac
5150 ]
5151QED
5152
5153(* Idea: the recurrence relation for binomial defines itself. *)
5154
5155(* Theorem: f = binomial <=>
5156 !n k. f n 0 = 1 /\ f 0 (k + 1) = 0 /\
5157 f (n + 1) (k + 1) = f n k + f n (k + 1) *)
5158(* Proof:
5159 If part: f = binomial ==> recurrence, true by binomial_alt
5160 Only-if part: recurrence ==> f = binomial
5161 By FUN_EQ_THM, this is to show:
5162 !n k. f n k = binomial n k
5163 By double induction, first induct on k.
5164 Base: !n. f n 0 = binomial n 0, true by binomial_n_0
5165 Step: !n. f n k = binomial n k ==>
5166 !n. f n (SUC k) = binomial n (SUC k)
5167 By induction on n.
5168 Base: f 0 (SUC k) = binomial 0 (SUC k)
5169 This is true by binomial_0_n, ADD1
5170 Step: f n (SUC k) = binomial n (SUC k) ==>
5171 f (SUC n) (SUC k) = binomial (SUC n) (SUC k)
5172
5173 f (SUC n) (SUC k)
5174 = f (n + 1) (k + 1) by ADD1
5175 = f n k + f n (k + 1) by given
5176 = binomial n k + binomial n (k + 1) by induction hypothesis
5177 = binomial (n + 1) (k + 1) by binomial_alt
5178 = binomial (SUC n) (SUC k) by ADD1
5179*)
5180Theorem binomial_iff:
5181 !f. f = binomial <=>
5182 !n k. f n 0 = 1 /\ f 0 (k + 1) = 0 /\ f (n + 1) (k + 1) = f n k + f n (k + 1)
5183Proof
5184 rw[binomial_alt, EQ_IMP_THM] >>
5185 simp[FUN_EQ_THM] >>
5186 Induct_on `x'` >-
5187 simp[binomial_n_0] >>
5188 Induct_on `x` >-
5189 fs[binomial_0_n, ADD1] >>
5190 fs[binomial_alt, ADD1]
5191QED
5192
5193(* ------------------------------------------------------------------------- *)
5194(* Primes and Binomial Coefficients *)
5195(* ------------------------------------------------------------------------- *)
5196
5197(* Theorem: n is prime ==> n divides C(n,k) for all 0 < k < n *)
5198(* Proof:
5199 C(n,k) = n!/k!/(n-k)!
5200 or n! = C(n,k) k! (n-k)!
5201 n divides n!, so n divides the product C(n,k) k!(n-k)!
5202 For a prime n, n cannot divide k!(n-k)!, all factors less than prime n.
5203 By Euclid's lemma, a prime divides a product must divide a factor.
5204 So p divides C(n,k).
5205*)
5206Theorem prime_divides_binomials:
5207 !n. prime n ==> 1 < n /\ (!k. 0 < k /\ k < n ==> n divides (binomial n k))
5208Proof
5209 rpt strip_tac >-
5210 metis_tac[ONE_LT_PRIME] >>
5211 `(n = n-k + k) /\ (n-k) < n` by decide_tac >>
5212 `FACT n = (binomial n k) * (FACT (n-k) * FACT k)` by metis_tac[binomial_formula] >>
5213 `~(n divides (FACT k)) /\ ~(n divides (FACT (n-k)))` by metis_tac[PRIME_BIG_NOT_DIVIDES_FACT] >>
5214 `n divides (FACT n)` by metis_tac[DIVIDES_FACT, LESS_TRANS] >>
5215 metis_tac[P_EUCLIDES]
5216QED
5217
5218(* Theorem: n is prime ==> n divides C(n,k) for all 0 < k < n *)
5219(* Proof: by prime_divides_binomials *)
5220Theorem prime_divides_binomials_alt:
5221 !n k. prime n /\ 0 < k /\ k < n ==> n divides (binomial n k)
5222Proof
5223 rw[prime_divides_binomials]
5224QED
5225
5226(* Theorem: If prime p divides n, p does not divide (n-1)!/(n-p)! *)
5227(* Proof:
5228 By contradiction.
5229 (n-1)...(n-p+1)/p cannot be an integer
5230 as p cannot divide any of the numerator.
5231 Note: when p divides n, the nearest multiples for p are n+/-p.
5232*)
5233Theorem prime_divisor_property:
5234 !n p. 1 < n /\ p < n /\ prime p /\ p divides n ==>
5235 ~(p divides ((FACT (n-1)) DIV (FACT (n-p))))
5236Proof
5237 spose_not_then strip_assume_tac >>
5238 `1 < p` by metis_tac[ONE_LT_PRIME] >>
5239 `n-p < n-1` by decide_tac >>
5240 `(FACT (n-1)) DIV (FACT (n-p)) = PROD_SET (IMAGE SUC ((count (n-1)) DIFF (count (n-p))))`
5241 by metis_tac[FACT_REDUCTION, MULT_DIV, FACT_LESS] >>
5242 `(count (n-1)) DIFF (count (n-p)) = {x | (n-p) <= x /\ x < (n-1)}`
5243 by srw_tac[ARITH_ss][EXTENSION, EQ_IMP_THM] >>
5244 `IMAGE SUC {x | (n-p) <= x /\ x < (n-1)} = {x | (n-p) < x /\ x < n}` by
5245 (srw_tac[ARITH_ss][EXTENSION, EQ_IMP_THM] >>
5246 qexists_tac `x-1` >>
5247 decide_tac) >>
5248 `FINITE (count (n - 1) DIFF count (n - p))` by rw[] >>
5249 `?y. y IN {x| n - p < x /\ x < n} /\ p divides y` by metis_tac[PROD_SET_EUCLID, IMAGE_FINITE] >>
5250 `!m n y. y IN {x | m < x /\ x < n} ==> m < y /\ y < n` by rw[] >>
5251 `n-p < y /\ y < n` by metis_tac[] >>
5252 `y < n + p` by decide_tac >>
5253 `y = n` by metis_tac[MULTIPLE_INTERVAL] >>
5254 decide_tac
5255QED
5256
5257(* Theorem: n divides C(n,k) for all 0 < k < n ==> n is prime *)
5258(* Proof:
5259 By contradiction. Let p be a proper factor of n, 1 < p < n.
5260 Then C(n,p) = n(n-1)...(n-p+1)/p(p-1)..1
5261 is divisible by n/p, but not n, since
5262 C(n,p)/n = (n-1)...(n-p+1)/p(p-1)...1
5263 cannot be an integer as p cannot divide any of the numerator.
5264 Note: when p divides n, the nearest multiples for p are n+/-p.
5265*)
5266Theorem divides_binomials_imp_prime:
5267 !n. 1 < n /\ (!k. 0 < k /\ k < n ==> n divides (binomial n k)) ==> prime n
5268Proof
5269 (spose_not_then strip_assume_tac) >>
5270 `?p. prime p /\ p < n /\ p divides n` by metis_tac[PRIME_FACTOR_PROPER] >>
5271 `n divides (binomial n p)` by metis_tac[PRIME_POS] >>
5272 `0 < p` by metis_tac[PRIME_POS] >>
5273 `(n = n-p + p) /\ (n-p) < n` by decide_tac >>
5274 `FACT n = (binomial n p) * (FACT (n-p) * FACT p)` by metis_tac[binomial_formula] >>
5275 `(n = SUC (n-1)) /\ (p = SUC (p-1))` by decide_tac >>
5276 `(FACT n = n * FACT (n-1)) /\ (FACT p = p * FACT (p-1))` by metis_tac[FACT] >>
5277 `n * FACT (n-1) = (binomial n p) * (FACT (n-p) * (p * FACT (p-1)))` by metis_tac[] >>
5278 `0 < n` by decide_tac >>
5279 `?q. binomial n p = n * q` by metis_tac[divides_def, MULT_COMM] >>
5280 `0 <> n` by decide_tac >>
5281 `FACT (n-1) = q * (FACT (n-p) * (p * FACT (p-1)))`
5282 by metis_tac[EQ_MULT_LCANCEL, MULT_ASSOC] >>
5283 `_ = q * ((FACT (p-1) * p)* FACT (n-p))` by metis_tac[MULT_COMM] >>
5284 `_ = q * FACT (p-1) * p * FACT (n-p)` by metis_tac[MULT_ASSOC] >>
5285 `FACT (n-1) DIV FACT (n-p) = q * FACT (p-1) * p` by metis_tac[MULT_DIV, FACT_LESS] >>
5286 metis_tac[divides_def, prime_divisor_property]
5287QED
5288
5289(* Theorem: n is prime iff n divides C(n,k) for all 0 < k < n *)
5290(* Proof:
5291 By prime_divides_binomials and
5292 divides_binomials_imp_prime.
5293*)
5294Theorem prime_iff_divides_binomials:
5295 !n. prime n <=> 1 < n /\ (!k. 0 < k /\ k < n ==> n divides (binomial n k))
5296Proof
5297 metis_tac[prime_divides_binomials, divides_binomials_imp_prime]
5298QED
5299
5300(* Theorem: prime n <=> 1 < n /\ !k. 0 < k /\ k < n ==> ((binomial n k) MOD n = 0) *)
5301(* Proof: by prime_iff_divides_binomials *)
5302Theorem prime_iff_divides_binomials_alt:
5303 !n. prime n <=> 1 < n /\ !k. 0 < k /\ k < n ==> ((binomial n k) MOD n = 0)
5304Proof
5305 rw[prime_iff_divides_binomials, DIVIDES_MOD_0]
5306QED
5307
5308(* ------------------------------------------------------------------------- *)
5309(* Binomial Theorem *)
5310(* ------------------------------------------------------------------------- *)
5311
5312(* Theorem: Binomial Index Shifting, for
5313 SUM (k=1..n) C(n,k)x^(n+1-k)y^k
5314 = SUM (k=0..n-1) C(n,k+1)x^(n-k)y^(k+1)
5315 *)
5316(* Proof:
5317SUM (k=1..n) C(n,k)x^(n+1-k)y^k
5318= SUM (MAP (\k. (binomial n k)* x**(n+1-k) * y**k) (GENLIST SUC n))
5319= SUM (GENLIST (\k. (binomial n k)* x**(n+1-k) * y**k) o SUC n)
5320
5321SUM (k=0..n-1) C(n,k+1)x^(n-k)y^(k+1)
5322= SUM (MAP (\k. (binomial n (k+1)) * x**(n-k) * y**(k+1)) (GENLIST I n))
5323= SUM (GENLIST (\k. (binomial n (k+1)) * x**(n-k) * y**(k+1)) o I n)
5324= SUM (GENLIST (\k. (binomial n (k+1)) * x**(n-k) * y**(k+1)) n)
5325
5326i.e.
5327
5328(\k. (binomial n k)* x**(n-k+1) * y**k) o SUC
5329= (\k. (binomial n (k+1)) * x**(n-k) * y**(k+1))
5330*)
5331(* Theorem: Binomial index shift for GENLIST *)
5332Theorem GENLIST_binomial_index_shift:
5333 !n x y. GENLIST ((\k. binomial n k * x ** SUC(n - k) * y ** k) o SUC) n =
5334 GENLIST (\k. binomial n (SUC k) * x ** (n-k) * y**(SUC k)) n
5335Proof
5336 rw_tac std_ss[GENLIST_FUN_EQ] >>
5337 `SUC (n - SUC k) = n - k` by decide_tac >>
5338 rw_tac std_ss[]
5339QED
5340
5341(* This is closely related to above, with (SUC n) replacing (n),
5342 but does not require k < n. *)
5343(* Proof: by function equality. *)
5344Theorem binomial_index_shift:
5345 !n x y. (\k. binomial (SUC n) k * x ** ((SUC n) - k) * y ** k) o SUC =
5346 (\k. binomial (SUC n) (SUC k) * x ** (n-k) * y ** (SUC k))
5347Proof
5348 rw_tac std_ss[FUN_EQ_THM]
5349QED
5350
5351(* Pattern for binomial expansion:
5352
5353 (x+y)(x^3 + 3x^2y + 3xy^2 + y^3)
5354 = x(x^3) + 3x(x^2y) + 3x(xy^2) + x(y^3) +
5355 y(x^3) + 3y(x^2y) + 3y(xy^2) + y(y^3)
5356 = x^4 + (3+1)x^3y + (3+3)(x^2y^2) + (1+3)(xy^3) + y^4
5357 = x^4 + 4x^3y + 6x^2y^2 + 4xy^3 + y^4
5358
5359*)
5360
5361(* Theorem: multiply x into a binomial term *)
5362(* Proof: by function equality and EXP. *)
5363Theorem binomial_term_merge_x:
5364 !n x y. (\k. x * k) o (\k. binomial n k * x ** (n - k) * y ** k) =
5365 (\k. binomial n k * x ** (SUC(n - k)) * y ** k)
5366Proof
5367 rw_tac std_ss[FUN_EQ_THM] >>
5368 `x * (binomial n k * x ** (n - k) * y ** k) =
5369 binomial n k * (x * x ** (n - k)) * y ** k` by decide_tac >>
5370 metis_tac[EXP]
5371QED
5372
5373(* Theorem: multiply y into a binomial term *)
5374(* Proof: by functional equality and EXP. *)
5375Theorem binomial_term_merge_y:
5376 !n x y. (\k. y * k) o (\k. binomial n k * x ** (n - k) * y ** k) =
5377 (\k. binomial n k * x ** (n - k) * y ** (SUC k))
5378Proof
5379 rw_tac std_ss[FUN_EQ_THM] >>
5380 `y * (binomial n k * x ** (n - k) * y ** k) =
5381 binomial n k * x ** (n - k) * (y * y ** k)` by decide_tac >>
5382 metis_tac[EXP]
5383QED
5384
5385(* Theorem: [Binomial Theorem] (x + y)^n = SUM (k=0..n) C(n,k)x^(n-k)y^k *)
5386(* Proof:
5387 By induction on n.
5388 Base case: to prove (x + y)^0 = SUM (k=0..0) C(0,k)x^(0-k)y^k
5389 (x + y)^0 = 1 by EXP
5390 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
5391 Step case: assume (x + y)^n = SUM (k=0..n) C(n,k)x^(n-k)y^k
5392 to prove: (x + y)^SUC n = SUM (k=0..(SUC n)) C(SUC n,k)x^((SUC n)-k)y^k
5393 (x + y)^SUC n
5394 = (x + y)(x + y)^n by EXP
5395 = (x + y) SUM (k=0..n) C(n,k)x^(n-k)y^k by induction hypothesis
5396 = x (SUM (k=0..n) C(n,k)x^(n-k)y^k) +
5397 y (SUM (k=0..n) C(n,k)x^(n-k)y^k) by RIGHT_ADD_DISTRIB
5398 = SUM (k=0..n) C(n,k)x^(n+1-k)y^k +
5399 SUM (k=0..n) C(n,k)x^(n-k)y^(k+1) by moving factor into SUM
5400 = C(n,0)x^(n+1) + SUM (k=1..n) C(n,k)x^(n+1-k)y^k +
5401 SUM (k=0..n-1) C(n,k)x^(n-k)y^(k+1) + C(n,n)y^(n+1)
5402 by breaking sum
5403
5404 = C(n,0)x^(n+1) + SUM (k=0..n-1) C(n,k+1)x^(n-k)y^(k+1) +
5405 SUM (k=0..n-1) C(n,k)x^(n-k)y^(k+1) + C(n,n)y^(n+1)
5406 by index shifting
5407 = C(n,0)x^(n+1) +
5408 SUM (k=0..n-1) [C(n,k+1) + C(n,k)] x^(n-k)y^(k+1) +
5409 C(n,n)y^(n+1) by merging sums
5410 = C(n,0)x^(n+1) +
5411 SUM (k=0..n-1) C(n+1,k+1) x^(n-k)y^(k+1) +
5412 C(n,n)y^(n+1) by binomial recurrence
5413 = C(n,0)x^(n+1) +
5414 SUM (k=1..n) C(n+1,k) x^(n+1-k)y^k +
5415 C(n,n)y^(n+1) by index shifting again
5416 = C(n+1,0)x^(n+1) +
5417 SUM (k=1..n) C(n+1,k) x^(n+1-k)y^k +
5418 C(n+1,n+1)y^(n+1) by binomial identities
5419 = SUM (k=0..(SUC n))C(SUC n,k) x^((SUC n)-k)y^k
5420 by synthesis of sum
5421*)
5422Theorem binomial_thm:
5423 !n x y. (x + y) ** n = SUM (GENLIST (\k. (binomial n k) * x ** (n-k) * y ** k) (SUC n))
5424Proof
5425 Induct_on `n` >-
5426 rw[EXP, binomial_n_n] >>
5427 rw_tac std_ss[EXP] >>
5428 `(x + y) * SUM (GENLIST (\k. binomial n k * x ** (n - k) * y ** k) (SUC n)) =
5429 x * SUM (GENLIST (\k. binomial n k * x ** (n - k) * y ** k) (SUC n)) +
5430 y * SUM (GENLIST (\k. binomial n k * x ** (n - k) * y ** k) (SUC n))`
5431 by metis_tac[RIGHT_ADD_DISTRIB] >>
5432 `_ = SUM (GENLIST ((\k. x * k) o (\k. binomial n k * x ** (n - k) * y ** k)) (SUC n)) +
5433 SUM (GENLIST ((\k. y * k) o (\k. binomial n k * x ** (n - k) * y ** k)) (SUC n))`
5434 by metis_tac[SUM_MULT, MAP_GENLIST] >>
5435 `_ = SUM (GENLIST (\k. binomial n k * x ** SUC(n - k) * y ** k) (SUC n)) +
5436 SUM (GENLIST (\k. binomial n k * x ** (n - k) * y ** (SUC k)) (SUC n))`
5437 by rw[binomial_term_merge_x, binomial_term_merge_y] >>
5438 `_ = (\k. binomial n k * x ** SUC (n - k) * y ** k) 0 +
5439 SUM (GENLIST ((\k. binomial n k * x ** SUC (n - k) * y ** k) o SUC) n) +
5440 SUM (GENLIST (\k. binomial n k * x ** (n - k) * y ** (SUC k)) (SUC n))`
5441 by rw[SUM_DECOMPOSE_FIRST] >>
5442 `_ = (\k. binomial n k * x ** SUC (n - k) * y ** k) 0 +
5443 SUM (GENLIST ((\k. binomial n k * x ** SUC (n - k) * y ** k) o SUC) n) +
5444 (SUM (GENLIST (\k. binomial n k * x ** (n - k) * y ** (SUC k)) n) +
5445 (\k. binomial n k * x ** (n - k) * y ** (SUC k)) n )`
5446 by rw[SUM_DECOMPOSE_LAST] >>
5447 `_ = (\k. binomial n k * x ** SUC(n - k) * y ** k) 0 +
5448 SUM (GENLIST (\k. binomial n (SUC k) * x ** (n - k) * y ** (SUC k)) n) +
5449 (SUM (GENLIST (\k. binomial n k * x ** (n - k) * y ** (SUC k)) n) +
5450 (\k. binomial n k * x ** (n - k) * y ** (SUC k)) n )`
5451 by metis_tac[GENLIST_binomial_index_shift] >>
5452 `_ = (\k. binomial n k * x ** SUC(n - k) * y ** k) 0 +
5453 (SUM (GENLIST (\k. binomial n (SUC k) * x ** (n - k) * y ** (SUC k)) n) +
5454 SUM (GENLIST (\k. binomial n k * x ** (n - k) * y ** (SUC k)) n)) +
5455 (\k. binomial n k * x ** (n - k) * y ** (SUC k)) n`
5456 by decide_tac >>
5457 `_ = (\k. binomial n k * x ** SUC (n - k) * y ** k) 0 +
5458 SUM (GENLIST (\k. (binomial n (SUC k) * x ** (n - k) * y ** (SUC k) +
5459 binomial n k * x ** (n - k) * y ** (SUC k))) n) +
5460 (\k. binomial n k * x ** (n - k) * y ** (SUC k)) n`
5461 by metis_tac[SUM_ADD_GENLIST] >>
5462 `_ = (\k. binomial n k * x ** SUC(n - k) * y ** k) 0 +
5463 SUM (GENLIST (\k. (binomial n (SUC k) + binomial n k) * x ** (n - k) * y ** (SUC k)) n) +
5464 (\k. binomial n k * x ** (n - k) * y ** (SUC k)) n`
5465 by rw[RIGHT_ADD_DISTRIB, MULT_ASSOC] >>
5466 `_ = (\k. binomial n k * x ** SUC(n - k) * y ** k) 0 +
5467 SUM (GENLIST (\k. binomial (SUC n) (SUC k) * x ** (n - k) * y ** (SUC k)) n) +
5468 (\k. binomial n k * x ** (n - k) * y ** (SUC k)) n`
5469 by rw[binomial_recurrence, ADD_COMM] >>
5470 `_ = binomial (SUC n) 0 * x ** (SUC n) * y ** 0 +
5471 SUM (GENLIST (\k. binomial (SUC n) (SUC k) * x ** (n - k) * y ** (SUC k)) n) +
5472 binomial (SUC n) (SUC n) * x ** 0 * y ** (SUC n)`
5473 by rw[binomial_n_0, binomial_n_n] >>
5474 `_ = binomial (SUC n) 0 * x ** (SUC n) * y ** 0 +
5475 SUM (GENLIST ((\k. binomial (SUC n) k * x ** ((SUC n) - k) * y ** k) o SUC) n) +
5476 binomial (SUC n) (SUC n) * x ** 0 * y ** (SUC n)`
5477 by rw[binomial_index_shift] >>
5478 `_ = SUM (GENLIST (\k. binomial (SUC n) k * x ** (SUC n - k) * y ** k) (SUC n)) +
5479 (\k. binomial (SUC n) k * x ** (SUC n - k) * y ** k) (SUC n)`
5480 by rw[SUM_DECOMPOSE_FIRST] >>
5481 `_ = SUM (GENLIST (\k. binomial (SUC n) k * x ** (SUC n - k) * y ** k) (SUC (SUC n)))`
5482 by rw[SUM_DECOMPOSE_LAST] >>
5483 decide_tac
5484QED
5485
5486(* This is a milestone theorem. *)
5487
5488(* Derive an alternative form. *)
5489Theorem binomial_thm_alt =
5490 binomial_thm |> SIMP_RULE bool_ss [ADD1];
5491(* val binomial_thm_alt =
5492 |- !n x y. (x + y) ** n =
5493 SUM (GENLIST (\k. binomial n k * x ** (n - k) * y ** k) (n + 1)): thm *)
5494
5495(* Theorem: SUM (GENLIST (binomial n) (SUC n)) = 2 ** n *)
5496(* Proof: by binomial_sum_alt and function equality. *)
5497(* Proof:
5498 Put x = 1, y = 1 in binomial_thm,
5499 (1 + 1) ** n = SUM (GENLIST (\k. binomial n k * 1 ** (n - k) * 1 ** k) (SUC n))
5500 (1 + 1) ** n = SUM (GENLIST (\k. binomial n k) (SUC n)) by EXP_1
5501 or 2 ** n = SUM (GENLIST (binomial n) (SUC n)) by FUN_EQ_THM
5502*)
5503Theorem binomial_sum:
5504 !n. SUM (GENLIST (binomial n) (SUC n)) = 2 ** n
5505Proof
5506 rpt strip_tac >>
5507 `!n. (\k. binomial n k * 1 ** (n - k) * 1 ** k) = binomial n` by rw[FUN_EQ_THM] >>
5508 `SUM (GENLIST (binomial n) (SUC n)) =
5509 SUM (GENLIST (\k. binomial n k * 1 ** (n - k) * 1 ** k) (SUC n))` by fs[] >>
5510 `_ = (1 + 1) ** n` by rw[GSYM binomial_thm] >>
5511 simp[]
5512QED
5513
5514(* Derive an alternative form. *)
5515Theorem binomial_sum_alt =
5516 binomial_sum |> SIMP_RULE bool_ss [ADD1];
5517(* val binomial_sum_alt = |- !n. SUM (GENLIST (binomial n) (n + 1)) = 2 ** n: thm *)
5518
5519(* ------------------------------------------------------------------------- *)
5520(* Binomial Horizontal List *)
5521(* ------------------------------------------------------------------------- *)
5522
5523(* Define Horizontal List in Pascal Triangle *)
5524(*
5525val binomial_horizontal_def = Define `
5526 binomial_horizontal n = GENLIST (binomial n) (SUC n)
5527`;
5528*)
5529
5530(* Use overloading for binomial_horizontal n. *)
5531Overload binomial_horizontal = ``\n. GENLIST (binomial n) (n + 1)``
5532
5533(* Theorem: binomial_horizontal 0 = [1] *)
5534(* Proof:
5535 binomial_horizontal 0
5536 = GENLIST (binomial 0) (0 + 1) by notation
5537 = SNOC (binomial 0 0) [] by GENLIST, ONE
5538 = [binomial 0 0] by SNOC
5539 = [1] by binomial_n_0
5540*)
5541Theorem binomial_horizontal_0:
5542 binomial_horizontal 0 = [1]
5543Proof
5544 rw[binomial_n_0]
5545QED
5546
5547(* Theorem: LENGTH (binomial_horizontal n) = n + 1 *)
5548(* Proof:
5549 LENGTH (binomial_horizontal n)
5550 = LENGTH (GENLIST (binomial n) (n + 1)) by notation
5551 = n + 1 by LENGTH_GENLIST
5552*)
5553Theorem binomial_horizontal_len:
5554 !n. LENGTH (binomial_horizontal n) = n + 1
5555Proof
5556 rw[]
5557QED
5558
5559(* Theorem: k < n + 1 ==> MEM (binomial n k) (binomial_horizontal n) *)
5560(* Proof: by MEM_GENLIST *)
5561Theorem binomial_horizontal_mem:
5562 !n k. k < n + 1 ==> MEM (binomial n k) (binomial_horizontal n)
5563Proof
5564 metis_tac[MEM_GENLIST]
5565QED
5566
5567(* Theorem: MEM (binomial n k) (binomial_horizontal n) <=> k <= n *)
5568(* Proof:
5569 If part: MEM (binomial n k) (binomial_horizontal n) ==> k <= n
5570 By contradiction, suppose n < k.
5571 Then binomial n k = 0 by binomial_less_0, ~(k <= n)
5572 But ?m. m < n + 1 ==> 0 = binomial n m by MEM_GENLIST
5573 or m <= n ==> binomial n m = 0 by m < n + 1
5574 Yet binomial n m <> 0 by binomial_eq_0
5575 This is a contradiction.
5576 Only-if part: k <= n ==> MEM (binomial n k) (binomial_horizontal n)
5577 By MEM_GENLIST, this is to show:
5578 ?m. m < n + 1 /\ (binomial n k = binomial n m)
5579 Note k <= n ==> k < n + 1,
5580 Take m = k, the result follows.
5581*)
5582Theorem binomial_horizontal_mem_iff:
5583 !n k. MEM (binomial n k) (binomial_horizontal n) <=> k <= n
5584Proof
5585 rw[EQ_IMP_THM] >| [
5586 spose_not_then strip_assume_tac >>
5587 `binomial n k = 0` by rw[binomial_less_0] >>
5588 fs[MEM_GENLIST] >>
5589 `m <= n` by decide_tac >>
5590 fs[binomial_eq_0],
5591 rw[MEM_GENLIST] >>
5592 `k < n + 1` by decide_tac >>
5593 metis_tac[]
5594 ]
5595QED
5596
5597(* Theorem: MEM x (binomial_horizontal n) <=> ?k. k <= n /\ (x = binomial n k) *)
5598(* Proof:
5599 By MEM_GENLIST, this is to show:
5600 (?m. m < n + 1 /\ (x = binomial n m)) <=> ?k. k <= n /\ (x = binomial n k)
5601 Since m < n + 1 <=> m <= n by LE_LT1
5602 This is trivially true.
5603*)
5604Theorem binomial_horizontal_member:
5605 !n x. MEM x (binomial_horizontal n) <=> ?k. k <= n /\ (x = binomial n k)
5606Proof
5607 metis_tac[MEM_GENLIST, LE_LT1]
5608QED
5609
5610(* Theorem: k <= n ==> (EL k (binomial_horizontal n) = binomial n k) *)
5611(* Proof: by EL_GENLIST *)
5612Theorem binomial_horizontal_element:
5613 !n k. k <= n ==> (EL k (binomial_horizontal n) = binomial n k)
5614Proof
5615 rw[EL_GENLIST]
5616QED
5617
5618(* Theorem: EVERY (\x. 0 < x) (binomial_horizontal n) *)
5619(* Proof:
5620 EVERY (\x. 0 < x) (binomial_horizontal n)
5621 <=> EVERY (\x. 0 < x) (GENLIST (binomial n) (n + 1)) by notation
5622 <=> !k. k < n + 1 ==> 0 < binomial n k by EVERY_GENLIST
5623 <=> !k. k <= n ==> 0 < binomial n k by arithmetic
5624 <=> T by binomial_pos
5625*)
5626Theorem binomial_horizontal_pos:
5627 !n. EVERY (\x. 0 < x) (binomial_horizontal n)
5628Proof
5629 rpt strip_tac >>
5630 `!k n. k < n + 1 <=> k <= n` by decide_tac >>
5631 rw_tac std_ss[EVERY_GENLIST, LESS_EQ_IFF_LESS_SUC, binomial_pos]
5632QED
5633
5634(* Theorem: MEM x (binomial_horizontal n) ==> 0 < x *)
5635(* Proof: by binomial_horizontal_pos, EVERY_MEM *)
5636Theorem binomial_horizontal_pos_alt:
5637 !n x. MEM x (binomial_horizontal n) ==> 0 < x
5638Proof
5639 metis_tac[binomial_horizontal_pos, EVERY_MEM]
5640QED
5641
5642(* Theorem: SUM (binomial_horizontal n) = 2 ** n *)
5643(* Proof:
5644 SUM (binomial_horizontal n)
5645 = SUM (GENLIST (binomial n) (n + 1)) by notation
5646 = 2 ** n by binomial_sum, ADD1
5647*)
5648Theorem binomial_horizontal_sum:
5649 !n. SUM (binomial_horizontal n) = 2 ** n
5650Proof
5651 rw_tac std_ss[binomial_sum, GSYM ADD1]
5652QED
5653
5654(* Theorem: MAX_LIST (binomial_horizontal n) = binomial n (HALF n) *)
5655(* Proof:
5656 Let l = binomial_horizontal n, m = binomial n (HALF n).
5657 Then l <> [] by binomial_horizontal_len, LENGTH_NIL
5658 and HALF n <= n by DIV_LESS_EQ, 0 < 2
5659 or HALF n < n + 1 by arithmetic
5660 Also MEM m l by binomial_horizontal_mem
5661 and !x. MEM x l ==> x <= m by binomial_max, MEM_GENLIST
5662 Thus m = MAX_LIST l by MAX_LIST_TEST
5663*)
5664Theorem binomial_horizontal_max:
5665 !n. MAX_LIST (binomial_horizontal n) = binomial n (HALF n)
5666Proof
5667 rpt strip_tac >>
5668 qabbrev_tac `l = binomial_horizontal n` >>
5669 qabbrev_tac `m = binomial n (HALF n)` >>
5670 `l <> []` by metis_tac[binomial_horizontal_len, LENGTH_NIL, DECIDE``n + 1 <> 0``] >>
5671 `HALF n <= n` by rw[DIV_LESS_EQ] >>
5672 `HALF n < n + 1` by decide_tac >>
5673 `MEM m l` by rw[binomial_horizontal_mem, Abbr`l`, Abbr`m`] >>
5674 metis_tac[binomial_max, MEM_GENLIST, MAX_LIST_TEST]
5675QED
5676
5677(* Theorem: MAX_SET (IMAGE (binomial n) (count (n + 1))) = binomial n (HALF n) *)
5678(* Proof:
5679 Let f = binomial n, s = IMAGE f (count (n + 1)).
5680 Note FINITE (count (n + 1)) by FINITE_COUNT
5681 so FINITE s by IMAGE_FINITE
5682 Also count (n + 1) <> {} by COUNT_EQ_EMPTY, n + 1 <> 0
5683 so s <> {} by IMAGE_EQ_EMPTY
5684 Now !k. k IN (count (n + 1)) ==> f k <= f (HALF n) by binomial_max
5685 ==> !x. x IN s ==> x <= f (HALF n) by IN_IMAGE
5686 Also HALF n <= n by DIV_LESS_EQ, 0 < 2
5687 so HALF n IN (count (n + 1)) by IN_COUNT
5688 ==> f (HALF n) IN s by IN_IMAGE
5689 Thus MAX_SET s = f (HALF n) by MAX_SET_TEST
5690*)
5691Theorem binomial_row_max:
5692 !n. MAX_SET (IMAGE (binomial n) (count (n + 1))) = binomial n (HALF n)
5693Proof
5694 rpt strip_tac >>
5695 qabbrev_tac `f = binomial n` >>
5696 qabbrev_tac `s = IMAGE f (count (n + 1))` >>
5697 `FINITE s` by rw[Abbr`s`] >>
5698 `s <> {}` by rw[COUNT_EQ_EMPTY, Abbr`s`] >>
5699 `!k. k IN (count (n + 1)) ==> f k <= f (HALF n)` by rw[binomial_max, Abbr`f`] >>
5700 `!x. x IN s ==> x <= f (HALF n)` by metis_tac[IN_IMAGE] >>
5701 `HALF n <= n` by rw[DIV_LESS_EQ] >>
5702 `HALF n IN (count (n + 1))` by rw[] >>
5703 `f (HALF n) IN s` by metis_tac[IN_IMAGE] >>
5704 rw[MAX_SET_TEST]
5705QED
5706
5707(* Theorem: k <= m /\ m <= n ==>
5708 ((binomial m k) * (binomial n m) = (binomial n k) * (binomial (n - k) (m - k))) *)
5709(* Proof:
5710 Using binomial_formula2,
5711
5712 (binomial m k) * (binomial n m)
5713 n! m!
5714 = ----------- * ------------------ binomial formula
5715 m! (n - m)! k! (m - k)!
5716 n! m!
5717 = ----------- * ------------------ cancel m!
5718 k! m! (m - k)! (n - m)!
5719 n! (n - k)!
5720 = ----------- * ------------------ replace by (n - k)!
5721 k! (n - k)! (m - k)! (n - m)!
5722
5723 = (binomial n k) * (binomial (n - k) (m - k)) binomial formula
5724*)
5725Theorem binomial_product_identity:
5726 !m n k. k <= m /\ m <= n ==>
5727 ((binomial m k) * (binomial n m) = (binomial n k) * (binomial (n - k) (m - k)))
5728Proof
5729 rpt strip_tac >>
5730 `m - k <= n - k` by decide_tac >>
5731 `(n - k) - (m - k) = n - m` by decide_tac >>
5732 `FACT m = binomial m k * (FACT (m - k) * FACT k)` by rw[binomial_formula2] >>
5733 `FACT n = binomial n m * (FACT (n - m) * FACT m)` by rw[binomial_formula2] >>
5734 `FACT n = binomial n k * (FACT (n - k) * FACT k)` by rw[binomial_formula2] >>
5735 `FACT (n - k) = binomial (n - k) (m - k) * (FACT (n - m) * FACT (m - k))` by metis_tac[binomial_formula2] >>
5736 `FACT n = FACT (n - m) * (FACT k * (FACT (m - k) * ((binomial m k) * (binomial n m))))` by metis_tac[MULT_ASSOC, MULT_COMM] >>
5737 `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] >>
5738 metis_tac[MULT_LEFT_CANCEL, FACT_LESS, NOT_ZERO]
5739QED
5740
5741(* Theorem: binomial n (HALF n) <= 4 ** (HALF n) *)
5742(* Proof:
5743 Let m = HALF n, l = binomial_horizontal n
5744 Note LENGTH l = n + 1 by binomial_horizontal_len
5745 If EVEN n,
5746 Then n = 2 * m by EVEN_HALF
5747 and m <= n by m <= 2 * m
5748 Note EL m l <= SUM l by SUM_LE_EL, m < n + 1
5749 Now EL m l = binomial n m by binomial_horizontal_element, m <= n
5750 and SUM l
5751 = 2 ** n by binomial_horizontal_sum
5752 = 4 ** m by EXP_EXP_MULT
5753 Hence binomial n m <= 4 ** m.
5754 If ~EVEN n,
5755 Then ODD n by EVEN_ODD
5756 and n = 2 * m + 1 by ODD_HALF
5757 so m + 1 <= n by m + 1 <= 2 * m + 1
5758 with m <= n by m + 1 <= n
5759 Note EL m l = binomial n m by binomial_horizontal_element, m <= n
5760 and EL (m + 1) l = binomial n (m + 1) by binomial_horizontal_element, m + 1 <= n
5761 Note binomial n (m + 1) = binomial n m by binomial_sym
5762 Thus 2 * binomial n m
5763 = binomial n m + binomial n (m + 1) by above
5764 = EL m l + EL (m + 1) l
5765 <= SUM l by SUM_LE_SUM_EL, m < m + 1, m + 1 < n + 1
5766 and SUM l
5767 = 2 ** n by binomial_horizontal_sum
5768 = 2 * 2 ** (2 * m) by EXP, ADD1
5769 = 2 * 4 ** m by EXP_EXP_MULT
5770 Hence binomial n m <= 4 ** m.
5771*)
5772Theorem binomial_middle_upper_bound:
5773 !n. binomial n (HALF n) <= 4 ** (HALF n)
5774Proof
5775 rpt strip_tac >>
5776 qabbrev_tac `m = HALF n` >>
5777 qabbrev_tac `l = binomial_horizontal n` >>
5778 `LENGTH l = n + 1` by rw[binomial_horizontal_len, Abbr`l`] >>
5779 Cases_on `EVEN n` >| [
5780 `n = 2 * m` by rw[EVEN_HALF, Abbr`m`] >>
5781 `m < n + 1` by decide_tac >>
5782 `EL m l <= SUM l` by rw[SUM_LE_EL] >>
5783 `EL m l = binomial n m` by rw[binomial_horizontal_element, Abbr`l`] >>
5784 `SUM l = 2 ** n` by rw[binomial_horizontal_sum, Abbr`l`] >>
5785 `_ = 4 ** m` by rw[EXP_EXP_MULT] >>
5786 decide_tac,
5787 `ODD n` by metis_tac[EVEN_ODD] >>
5788 `n = 2 * m + 1` by rw[ODD_HALF, Abbr`m`] >>
5789 `EL m l = binomial n m` by rw[binomial_horizontal_element, Abbr`l`] >>
5790 `EL (m + 1) l = binomial n (m + 1)` by rw[binomial_horizontal_element, Abbr`l`] >>
5791 `binomial n (m + 1) = binomial n m` by rw[Once binomial_sym] >>
5792 `EL m l + EL (m + 1) l <= SUM l` by rw[SUM_LE_SUM_EL] >>
5793 `SUM l = 2 ** n` by rw[binomial_horizontal_sum, Abbr`l`] >>
5794 `_ = 2 * 2 ** (2 * m)` by metis_tac[EXP, ADD1] >>
5795 `_ = 2 * 4 ** m` by rw[EXP_EXP_MULT] >>
5796 decide_tac
5797 ]
5798QED
5799
5800(* ------------------------------------------------------------------------- *)
5801(* Stirling's Approximation *)
5802(* ------------------------------------------------------------------------- *)
5803
5804(* Stirling's formula: n! ~ sqrt(2 pi n) (n/e)^n. *)
5805Overload Stirling =
5806 ``(!n. FACT n = (SQRT (2 * pi * n)) * (n DIV e) ** n) /\
5807 (!n. SQRT n = n ** h) /\ (2 * h = 1) /\ (0 < pi) /\ (0 < e) /\
5808 (!a b x y. (a * b) DIV (x * y) = (a DIV x) * (b DIV y)) /\
5809 (!a b c. (a DIV c) DIV (b DIV c) = a DIV b)``
5810
5811(* Theorem: Stirling ==>
5812 !n. 0 < n /\ EVEN n ==> (binomial n (HALF n) = (2 ** (n + 1)) DIV (SQRT (2 * pi * n))) *)
5813(* Proof:
5814 Note HALF n <= n by DIV_LESS_EQ, 0 < 2
5815 Let k = HALF n, then n = 2 * k by EVEN_HALF
5816 Note 0 < k by 0 < n = 2 * k
5817 so (k * 2) DIV k = 2 by MULT_TO_DIV, 0 < k
5818 or n DIV k = 2 by MULT_COMM
5819 Also 0 < pi * n by MULT_EQ_0, 0 < pi, 0 < n
5820 so 0 < 2 * pi * n by arithmetic
5821
5822 Some theorems on the fly:
5823 Claim: !a b j. (a ** j) DIV (b ** j) = (a DIV b) ** j [1]
5824 Proof: By induction on j.
5825 Base: (a ** 0) DIV (b ** 0) = (a DIV b) ** 0
5826 (a ** 0) DIV (b ** 0)
5827 = 1 DIV 1 = 1 by EXP, DIVMOD_ID, 0 < 1
5828 = (a DIV b) ** 0 by EXP
5829 Step: (a ** j) DIV (b ** j) = (a DIV b) ** j ==>
5830 (a ** (SUC j)) DIV (b ** (SUC j)) = (a DIV b) ** (SUC j)
5831 (a ** (SUC j)) DIV (b ** (SUC j))
5832 = (a * a ** j) DIV (b * b ** j) by EXP
5833 = (a DIV b) * ((a ** j) DIV (b ** j)) by assumption
5834 = (a DIV b) * (a DIV b) ** j by induction hypothesis
5835 = (a DIV b) ** (SUC j) by EXP
5836
5837 Claim: !a b c. (a DIV b) * c = (a * c) DIV b [2]
5838 Proof: (a DIV b) * c
5839 = (a DIV b) * (c DIV 1) by DIV_1
5840 = (a * c) DIV (b * 1) by assumption
5841 = (a * c) DIV b by MULT_RIGHT_1
5842
5843 Claim: !a b. a DIV b = 2 * (a DIV (2 * b)) [3]
5844 Proof: a DIV b
5845 = 1 * (a DIV b) by MULT_LEFT_1
5846 = (n DIV n) * (a DIV b) by DIVMOD_ID, 0 < n
5847 = (n * a) DIV (n * b) by assumption
5848 = (n * a) DIV (k * (2 * b)) by arithmetic, n = 2 * k
5849 = (n DIV k) * (a DIV (2 * b)) by assumption
5850 = 2 * (a DIV (2 * b)) by n DIV k = 2
5851
5852 Claim: !a b. 0 < b ==> (a * (b ** h DIV b) = a DIV (b ** h)) [4]
5853 Proof: Let c = b ** h.
5854 Then b = c * c by EXP_EXP_MULT
5855 so 0 < c by MULT_EQ_0, 0 < b
5856 a * (c DIV b)
5857 = (c DIV b) * a by MULT_COMM
5858 = (a * c) DIV b by [2]
5859 = (a * c) DIV (c * c) by b = c * c
5860 = (a DIV c) * (c DIV c) by assumption
5861 = a DIV c by DIVMOD_ID, c DIV c = 1, 0 < c
5862
5863 Note (FACT k) ** 2
5864 = (SQRT (2 * pi * k)) ** 2 * ((k DIV e) ** k) ** 2 by EXP_BASE_MULT
5865 = (SQRT (2 * pi * k)) ** 2 * (k DIV e) ** n by EXP_EXP_MULT, n = 2 * k
5866 = (SQRT (pi * n)) ** 2 * (k DIV e) ** n by MULT_ASSOC, 2 * k = n
5867 = ((pi * n) ** h) ** 2 * (k DIV e) ** n by assumption
5868 = (pi * n) * (k DIV e) ** n by EXP_EXP_MULT, h * 2 = 1
5869
5870 binomial n (HALF n)
5871 = binomial n k by k = HALF n
5872 = FACT n DIV (FACT k * FACT (n - k)) by binomial_formula3, k <= n
5873 = FACT n DIV (FACT k * FACT k) by arithmetic, n - k = 2 * k - k = k
5874 = FACT n DIV ((FACT k) ** 2) by EXP_2
5875 = FACT n DIV ((pi * n) * (k DIV e) ** n) by above
5876 = ((2 * pi * n) ** h * (n DIV e) ** n) DIV ((pi * n) * (k DIV e) ** n) by assumption
5877 = ((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)
5878 = ((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)
5879 = 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)
5880 = 2 * ((2 * pi * n) ** h DIV (2 * pi * n)) * (n DIV k) ** n by assumption, apply DIV_DIV_DIV_MULT
5881 = 2 DIV (2 * pi * n) ** h * (n DIV k) ** n by 2 * x ** h DIV x = 2 DIV (x ** h)
5882 = 2 DIV (2 * pi * n) ** h * 2 ** n by n DIV k = 2
5883 = 2 * 2 ** n DIV (2 * pi * n) ** h by (a DIV b) * c = a * c DIV b
5884 = 2 ** (SUC n) DIV (2 * pi * n) ** h by EXP
5885 = 2 ** (n + 1)) DIV (SQRT (2 * pi * n)) by ADD1, assumption
5886*)
5887Theorem binomial_middle_by_stirling:
5888 Stirling ==> !n. 0 < n /\ EVEN n ==> (binomial n (HALF n) = (2 ** (n + 1)) DIV (SQRT (2 * pi * n)))
5889Proof
5890 rpt strip_tac >>
5891 `HALF n <= n /\ (n = 2 * HALF n)` by rw[DIV_LESS_EQ, EVEN_HALF] >>
5892 qabbrev_tac `k = HALF n` >>
5893 `0 < k` by decide_tac >>
5894 `n DIV k = 2` by metis_tac[MULT_TO_DIV, MULT_COMM] >>
5895 `0 < pi * n` by metis_tac[MULT_EQ_0, NOT_ZERO] >>
5896 `0 < 2 * pi * n` by decide_tac >>
5897 `(FACT k) ** 2 = (SQRT (2 * pi * k)) ** 2 * ((k DIV e) ** k) ** 2` by rw[EXP_BASE_MULT] >>
5898 `_ = (SQRT (2 * pi * k)) ** 2 * (k DIV e) ** n` by rw[GSYM EXP_EXP_MULT] >>
5899 `_ = (pi * n) * (k DIV e) ** n` by rw[GSYM EXP_EXP_MULT] >>
5900 (`!a b j. (a ** j) DIV (b ** j) = (a DIV b) ** j` by (Induct_on `j` >> rw[EXP])) >>
5901 `!a b c. (a DIV b) * c = (a * c) DIV b` by metis_tac[DIV_1, MULT_RIGHT_1] >>
5902 `!a b. a DIV b = 2 * (a DIV (2 * b))` by metis_tac[DIVMOD_ID, MULT_LEFT_1] >>
5903 `!a b. 0 < b ==> (a * (b ** h DIV b) = a DIV (b ** h))` by
5904 (rpt strip_tac >>
5905 qabbrev_tac `c = b ** h` >>
5906 `b = c * c` by rw[GSYM EXP_EXP_MULT, Abbr`c`] >>
5907 `0 < c` by metis_tac[MULT_EQ_0, NOT_ZERO] >>
5908 `a * (c DIV b) = (a * c) DIV (c * c)` by metis_tac[MULT_COMM] >>
5909 `_ = (a DIV c) * (c DIV c)` by metis_tac[] >>
5910 metis_tac[DIVMOD_ID, MULT_RIGHT_1]) >>
5911 `binomial n k = (FACT n) DIV (FACT k * FACT (n - k))` by metis_tac[binomial_formula3] >>
5912 `_ = (FACT n) DIV (FACT k) ** 2` by metis_tac[EXP_2, DECIDE``2 * k - k = k``] >>
5913 `_ = ((2 * pi * n) ** h * (n DIV e) ** n) DIV ((pi * n) * (k DIV e) ** n)` by prove_tac[] >>
5914 `_ = ((2 * pi * n) ** h DIV (pi * n)) * ((n DIV e) ** n DIV ((k DIV e) ** n))` by metis_tac[] >>
5915 `_ = ((2 * pi * n) ** h DIV (pi * n)) * ((n DIV e) DIV (k DIV e)) ** n` by metis_tac[] >>
5916 `_ = 2 * ((2 * pi * n) ** h DIV (2 * pi * n)) * ((n DIV e) DIV (k DIV e)) ** n` by metis_tac[MULT_ASSOC] >>
5917 `_ = 2 * ((2 * pi * n) ** h DIV (2 * pi * n)) * (n DIV k) ** n` by metis_tac[] >>
5918 `_ = 2 DIV (2 * pi * n) ** h * (n DIV k) ** n` by metis_tac[] >>
5919 `_ = 2 DIV (2 * pi * n) ** h * 2 ** n` by metis_tac[] >>
5920 `_ = (2 * 2 ** n DIV (2 * pi * n) ** h)` by metis_tac[] >>
5921 metis_tac[EXP, ADD1]
5922QED
5923
5924(* ------------------------------------------------------------------------- *)
5925(* Useful theorems for Binomial *)
5926(* ------------------------------------------------------------------------- *)
5927
5928(* Theorem: !k. 0 < k /\ k < n ==> (binomial n k MOD n = 0) <=>
5929 !h. 0 <= h /\ h < PRE n ==> (binomial n (SUC h) MOD n = 0) *)
5930(* Proof: by h = PRE k, or k = SUC h.
5931 If part: put k = SUC h,
5932 then 0 < SUC h ==> 0 <= h,
5933 and SUC h < n ==> PRE (SUC h) = h < PRE n by prim_recTheory.PRE
5934 Only-if part: put h = PRE k,
5935 then 0 <= PRE k ==> 0 < k
5936 and PRE k < PRE n ==> k < n by INV_PRE_LESS
5937*)
5938Theorem binomial_range_shift:
5939 !n . 0 < n ==> ((!k. 0 < k /\ k < n ==> ((binomial n k) MOD n = 0)) <=>
5940 (!h. h < PRE n ==> ((binomial n (SUC h)) MOD n = 0)))
5941Proof
5942 rw_tac std_ss[EQ_IMP_THM] >| [
5943 `0 < SUC h /\ SUC h < n` by decide_tac >>
5944 rw_tac std_ss[],
5945 `k <> 0` by decide_tac >>
5946 `?h. k = SUC h` by metis_tac[num_CASES] >>
5947 `h < PRE n` by decide_tac >>
5948 rw_tac std_ss[]
5949 ]
5950QED
5951
5952(* Theorem: binomial n k MOD n = 0 <=> (binomial n k * x ** (n-k) * y ** k) MOD n = 0 *)
5953(* Proof:
5954 (binomial n k * x ** (n-k) * y ** k) MOD n = 0
5955 <=> (binomial n k * (x ** (n-k) * y ** k)) MOD n = 0 by MULT_ASSOC
5956 <=> (((binomial n k) MOD n) * ((x ** (n - k) * y ** k) MOD n)) MOD n = 0 by MOD_TIMES2
5957 If part, apply 0 * z = 0 by MULT.
5958 Only-if part, pick x = 1, y = 1, apply EXP_1.
5959*)
5960Theorem binomial_mod_zero:
5961 !n. 0 < n ==> !k. (binomial n k MOD n = 0) <=> (!x y. (binomial n k * x ** (n-k) * y ** k) MOD n = 0)
5962Proof
5963 rw_tac std_ss[EQ_IMP_THM] >-
5964 metis_tac[MOD_TIMES2, ZERO_MOD, MULT] >>
5965 metis_tac[EXP_1, MULT_RIGHT_1]
5966QED
5967
5968
5969(* Theorem: (!k. 0 < k /\ k < n ==> (!x y. ((binomial n k * x ** (n - k) * y ** k) MOD n = 0))) <=>
5970 (!h. h < PRE n ==> (!x y. ((binomial n (SUC h) * x ** (n - (SUC h)) * y ** (SUC h)) MOD n = 0))) *)
5971(* Proof: by h = PRE k, or k = SUC h. *)
5972Theorem binomial_range_shift_alt:
5973 !n . 0 < n ==> ((!k. 0 < k /\ k < n ==> (!x y. ((binomial n k * x ** (n - k) * y ** k) MOD n = 0))) <=>
5974 (!h. h < PRE n ==> (!x y. ((binomial n (SUC h) * x ** (n - (SUC h)) * y ** (SUC h)) MOD n = 0))))
5975Proof
5976 rw_tac std_ss[EQ_IMP_THM] >| [
5977 `0 < SUC h /\ SUC h < n` by decide_tac >>
5978 rw_tac std_ss[],
5979 `k <> 0` by decide_tac >>
5980 `?h. k = SUC h` by metis_tac[num_CASES] >>
5981 `h < PRE n` by decide_tac >>
5982 rw_tac std_ss[]
5983 ]
5984QED
5985
5986(* Theorem: !k. 0 < k /\ k < n ==> (binomial n k) MOD n = 0 <=>
5987 !x y. SUM (GENLIST ((\k. (binomial n k * x ** (n - k) * y ** k) MOD n) o SUC) (PRE n)) = 0 *)
5988(* Proof:
5989 !k. 0 < k /\ k < n ==> (binomial n k) MOD n = 0
5990 <=> !k. 0 < k /\ k < n ==> !x y. ((binomial n k * x ** (n - k) * y ** k) MOD n = 0) by binomial_mod_zero
5991 <=> !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
5992 <=> !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
5993 <=> !x y. EVERY (\x. x = 0) (GENLIST ((\k. binomial n k * x ** (n - k) * y ** k) o SUC) (PRE n) by FUN_EQ_THM
5994 <=> !x y. SUM (GENLIST ((\k. (binomial n k * x ** (n - k) * y ** k) MOD n) o SUC) (PRE n)) = 0 by SUM_EQ_0
5995*)
5996Theorem binomial_mod_zero_alt:
5997 !n. 0 < n ==> ((!k. 0 < k /\ k < n ==> ((binomial n k) MOD n = 0)) <=>
5998 !x y. SUM (GENLIST ((\k. (binomial n k * x ** (n - k) * y ** k) MOD n) o SUC) (PRE n)) = 0)
5999Proof
6000 rpt strip_tac >>
6001 `!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] >>
6002 `(!k. 0 < k /\ k < n ==> ((binomial n k) MOD n = 0)) <=>
6003 (!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] >>
6004 `_ = (!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] >>
6005 `_ = !x y h. h < PRE n ==> (((binomial n (SUC h) * x ** (n - (SUC h)) * y ** (SUC h)) MOD n = 0))` by metis_tac[] >>
6006 rw_tac std_ss[EVERY_GENLIST, SUM_EQ_0]
6007QED
6008
6009(* ------------------------------------------------------------------------- *)
6010(* Binomial Theorem with prime exponent *)
6011(* ------------------------------------------------------------------------- *)
6012
6013(* Theorem: [Binomial Expansion for prime exponent] (x + y)^p = x^p + y^p (mod p) *)
6014(* Proof:
6015 (x+y)^p (mod p)
6016 = SUM (k=0..p) C(p,k)x^(p-k)y^k (mod p) by binomial theorem
6017 = (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
6018 = (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
6019 = ((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
6020 = ((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
6021 = (x^p mod p + 0 + y^p mod p) mod p by prime_iff_divides_binomials
6022 = (x^p + y^p) (mod p) by MOD_PLUS
6023*)
6024Theorem binomial_thm_prime:
6025 !p. prime p ==> (!x y. (x + y) ** p MOD p = (x ** p + y ** p) MOD p)
6026Proof
6027 rpt strip_tac >>
6028 `0 < p` by rw_tac std_ss[PRIME_POS] >>
6029 `!k. 0 < k /\ k < p ==> ((binomial p k) MOD p = 0)` by metis_tac[prime_iff_divides_binomials, DIVIDES_MOD_0] >>
6030 `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] >>
6031 `(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] >>
6032 metis_tac[MOD_PLUS3, ADD_0, MOD_PLUS]
6033QED
6034
6035(* ------------------------------------------------------------------------- *)
6036(* Leibniz Harmonic Triangle Documentation *)
6037(* ------------------------------------------------------------------------- *)
6038(* Type: (# are temp)
6039 triple = <| a: num; b: num; c: num |>
6040# path = :num list
6041 Overloading:
6042 leibniz_vertical n = [1 .. (n+1)]
6043 leibniz_up n = REVERSE (leibniz_vertical n)
6044 leibniz_horizontal n = GENLIST (leibniz n) (n + 1)
6045 binomial_horizontal n = GENLIST (binomial n) (n + 1)
6046# ta = (triplet n k).a
6047# tb = (triplet n k).b
6048# tc = (triplet n k).c
6049 p1 zigzag p2 = leibniz_zigzag p1 p2
6050 p1 wriggle p2 = RTC leibniz_zigzag p1 p2
6051 leibniz_col_arm a b n = MAP (\x. leibniz (a - x) b) [0 ..< n]
6052 leibniz_seg_arm a b n = MAP (\x. leibniz a (b + x)) [0 ..< n]
6053
6054 leibniz_seg n k h = IMAGE (\j. leibniz n (k + j)) (count h)
6055 leibniz_row n h = IMAGE (leibniz n) (count h)
6056 leibniz_col h = IMAGE (\i. leibniz i 0) (count h)
6057 lcm_run n = list_lcm [1 .. n]
6058# beta n k = k * binomial n k
6059# beta_horizontal n = GENLIST (beta n o SUC) n
6060*)
6061(* Definitions and Theorems (# are exported):
6062
6063 Helper Theorems:
6064 RTC_TRANS |- R^* x y /\ R^* y z ==> R^* x z
6065
6066 Leibniz Triangle (Denominator form):
6067# leibniz_def |- !n k. leibniz n k = (n + 1) * binomial n k
6068 leibniz_0_n |- !n. leibniz 0 n = if n = 0 then 1 else 0
6069 leibniz_n_0 |- !n. leibniz n 0 = n + 1
6070 leibniz_n_n |- !n. leibniz n n = n + 1
6071 leibniz_less_0 |- !n k. n < k ==> (leibniz n k = 0)
6072 leibniz_sym |- !n k. k <= n ==> (leibniz n k = leibniz n (n - k))
6073 leibniz_monotone |- !n k. k < HALF n ==> leibniz n k < leibniz n (k + 1)
6074 leibniz_pos |- !n k. k <= n ==> 0 < leibniz n k
6075 leibniz_eq_0 |- !n k. (leibniz n k = 0) <=> n < k
6076 leibniz_alt |- !n. leibniz n = (\j. (n + 1) * j) o binomial n
6077 leibniz_def_alt |- !n k. leibniz n k = (\j. (n + 1) * j) (binomial n k)
6078 leibniz_up_eqn |- !n. 0 < n ==> !k. (n + 1) * leibniz (n - 1) k = (n - k) * leibniz n k
6079 leibniz_up |- !n. 0 < n ==> !k. leibniz (n - 1) k = (n - k) * leibniz n k DIV (n + 1)
6080 leibniz_up_alt |- !n. 0 < n ==> !k. leibniz (n - 1) k = (n - k) * binomial n k
6081 leibniz_right_eqn |- !n. 0 < n ==> !k. (k + 1) * leibniz n (k + 1) = (n - k) * leibniz n k
6082 leibniz_right |- !n. 0 < n ==> !k. leibniz n (k + 1) = (n - k) * leibniz n k DIV (k + 1)
6083 leibniz_property |- !n. 0 < n ==> !k. leibniz n k * leibniz (n - 1) k =
6084 leibniz n (k + 1) * (leibniz n k - leibniz (n - 1) k)
6085 leibniz_formula |- !n k. k <= n ==> (leibniz n k = (n + 1) * FACT n DIV (FACT k * FACT (n - k)))
6086 leibniz_recurrence |- !n. 0 < n ==> !k. k < n ==> (leibniz n (k + 1) = leibniz n k *
6087 leibniz (n - 1) k DIV (leibniz n k - leibniz (n - 1) k))
6088 leibniz_n_k |- !n k. 0 < k /\ k <= n ==> (leibniz n k =
6089 leibniz n (k - 1) * leibniz (n - 1) (k - 1)
6090 DIV (leibniz n (k - 1) - leibniz (n - 1) (k - 1)))
6091 leibniz_lcm_exchange |- !n. 0 < n ==> !k. lcm (leibniz n k) (leibniz (n - 1) k) =
6092 lcm (leibniz n k) (leibniz n (k + 1))
6093 leibniz_middle_lower |- !n. 4 ** n <= leibniz (TWICE n) n
6094
6095 LCM of a list of numbers:
6096# list_lcm_def |- (list_lcm [] = 1) /\ !h t. list_lcm (h::t) = lcm h (list_lcm t)
6097 list_lcm_nil |- list_lcm [] = 1
6098 list_lcm_cons |- !h t. list_lcm (h::t) = lcm h (list_lcm t)
6099 list_lcm_sing |- !x. list_lcm [x] = x
6100 list_lcm_snoc |- !x l. list_lcm (SNOC x l) = lcm x (list_lcm l)
6101 list_lcm_map_times |- !n l. list_lcm (MAP (\k. n * k) l) = if l = [] then 1 else n * list_lcm l
6102 list_lcm_pos |- !l. EVERY_POSITIVE l ==> 0 < list_lcm l
6103 list_lcm_pos_alt |- !l. POSITIVE l ==> 0 < list_lcm l
6104 list_lcm_lower_bound |- !l. EVERY_POSITIVE l ==> SUM l <= LENGTH l * list_lcm l
6105 list_lcm_lower_bound_alt |- !l. POSITIVE l ==> SUM l <= LENGTH l * list_lcm l
6106 list_lcm_is_common_multiple |- !x l. MEM x l ==> x divides (list_lcm l)
6107 list_lcm_is_least_common_multiple |- !l m. (!x. MEM x l ==> x divides m) ==> (list_lcm l) divides m
6108 list_lcm_append |- !l1 l2. list_lcm (l1 ++ l2) = lcm (list_lcm l1) (list_lcm l2)
6109 list_lcm_append_3 |- !l1 l2 l3. list_lcm (l1 ++ l2 ++ l3) = list_lcm [list_lcm l1; list_lcm l2; list_lcm l3]
6110 list_lcm_reverse |- !l. list_lcm (REVERSE l) = list_lcm l
6111 list_lcm_suc |- !n. list_lcm [1 .. n + 1] = lcm (n + 1) (list_lcm [1 .. n])
6112 list_lcm_nonempty_lower |- !l. l <> [] /\ EVERY_POSITIVE l ==> SUM l DIV LENGTH l <= list_lcm l
6113 list_lcm_nonempty_lower_alt |- !l. l <> [] /\ POSITIVE l ==> SUM l DIV LENGTH l <= list_lcm l
6114 list_lcm_divisor_lcm_pair |- !l x y. MEM x l /\ MEM y l ==> lcm x y divides list_lcm l
6115 list_lcm_lower_by_lcm_pair |- !l x y. POSITIVE l /\ MEM x l /\ MEM y l ==> lcm x y <= list_lcm l
6116 list_lcm_upper_by_common_multiple
6117 |- !l m. 0 < m /\ (!x. MEM x l ==> x divides m) ==> list_lcm l <= m
6118 list_lcm_by_FOLDR |- !ls. list_lcm ls = FOLDR lcm 1 ls
6119 list_lcm_by_FOLDL |- !ls. list_lcm ls = FOLDL lcm 1 ls
6120
6121 Lists in Leibniz Triangle:
6122
6123 Veritcal Lists in Leibniz Triangle
6124 leibniz_vertical_alt |- !n. leibniz_vertical n = GENLIST (\i. 1 + i) (n + 1)
6125 leibniz_vertical_0 |- leibniz_vertical 0 = [1]
6126 leibniz_vertical_len |- !n. LENGTH (leibniz_vertical n) = n + 1
6127 leibniz_vertical_not_nil |- !n. leibniz_vertical n <> []
6128 leibniz_vertical_pos |- !n. EVERY_POSITIVE (leibniz_vertical n)
6129 leibniz_vertical_pos_alt |- !n. POSITIVE (leibniz_vertical n)
6130 leibniz_vertical_mem |- !n x. 0 < x /\ x <= n + 1 <=> MEM x (leibniz_vertical n)
6131 leibniz_vertical_snoc |- !n. leibniz_vertical (n + 1) = SNOC (n + 2) (leibniz_vertical n)
6132
6133 leibniz_up_0 |- leibniz_up 0 = [1]
6134 leibniz_up_len |- !n. LENGTH (leibniz_up n) = n + 1
6135 leibniz_up_pos |- !n. EVERY_POSITIVE (leibniz_up n)
6136 leibniz_up_mem |- !n x. 0 < x /\ x <= n + 1 <=> MEM x (leibniz_up n)
6137 leibniz_up_cons |- !n. leibniz_up (n + 1) = n + 2::leibniz_up n
6138
6139 leibniz_horizontal_0 |- leibniz_horizontal 0 = [1]
6140 leibniz_horizontal_len |- !n. LENGTH (leibniz_horizontal n) = n + 1
6141 leibniz_horizontal_el |- !n k. k <= n ==> (EL k (leibniz_horizontal n) = leibniz n k)
6142 leibniz_horizontal_mem |- !n k. k <= n ==> MEM (leibniz n k) (leibniz_horizontal n)
6143 leibniz_horizontal_mem_iff |- !n k. MEM (leibniz n k) (leibniz_horizontal n) <=> k <= n
6144 leibniz_horizontal_member |- !n x. MEM x (leibniz_horizontal n) <=> ?k. k <= n /\ (x = leibniz n k)
6145 leibniz_horizontal_element |- !n k. k <= n ==> (EL k (leibniz_horizontal n) = leibniz n k)
6146 leibniz_horizontal_head |- !n. TAKE 1 (leibniz_horizontal (n + 1)) = [n + 2]
6147 leibniz_horizontal_divisor|- !n k. k <= n ==> leibniz n k divides list_lcm (leibniz_horizontal n)
6148 leibniz_horizontal_pos |- !n. EVERY_POSITIVE (leibniz_horizontal n)
6149 leibniz_horizontal_pos_alt|- !n. POSITIVE (leibniz_horizontal n)
6150 leibniz_horizontal_alt |- !n. leibniz_horizontal n = MAP (\j. (n + 1) * j) (binomial_horizontal n)
6151 leibniz_horizontal_lcm_alt|- !n. list_lcm (leibniz_horizontal n) = (n + 1) * list_lcm (binomial_horizontal n)
6152 leibniz_horizontal_sum |- !n. SUM (leibniz_horizontal n) = (n + 1) * SUM (binomial_horizontal n)
6153 leibniz_horizontal_sum_eqn |- !n. SUM (leibniz_horizontal n) = (n + 1) * 2 ** n:
6154 leibniz_horizontal_average |- !n. SUM (leibniz_horizontal n) DIV LENGTH (leibniz_horizontal n) =
6155 SUM (binomial_horizontal n)
6156 leibniz_horizontal_average_eqn |- !n. SUM (leibniz_horizontal n) DIV LENGTH (leibniz_horizontal n) = 2 ** n
6157
6158 Using Triplet and Paths:
6159 triplet_def |- !n k. triplet n k =
6160 <|a := leibniz n k;
6161 b := leibniz (n + 1) k;
6162 c := leibniz (n + 1) (k + 1)
6163 |>
6164 leibniz_triplet_member |- !n k. (ta = leibniz n k) /\
6165 (tb = leibniz (n + 1) k) /\ (tc = leibniz (n + 1) (k + 1))
6166 leibniz_right_entry |- !n k. (k + 1) * tc = (n + 1 - k) * tb
6167 leibniz_up_entry |- !n k. (n + 2) * ta = (n + 1 - k) * tb
6168 leibniz_triplet_property |- !n k. ta * tb = tc * (tb - ta)
6169 leibniz_triplet_lcm |- !n k. lcm tb ta = lcm tb tc
6170
6171 Zigzag Path in Leibniz Triangle:
6172 leibniz_zigzag_def |- !p1 p2. p1 zigzag p2 <=>
6173 ?n k x y. (p1 = x ++ [tb; ta] ++ y) /\ (p2 = x ++ [tb; tc] ++ y)
6174 list_lcm_zigzag |- !p1 p2. p1 zigzag p2 ==> (list_lcm p1 = list_lcm p2)
6175 leibniz_zigzag_tail |- !p1 p2. p1 zigzag p2 ==> !x. [x] ++ p1 zigzag [x] ++ p2
6176 leibniz_horizontal_zigzag |- !n k. k <= n ==>
6177 TAKE (k + 1) (leibniz_horizontal (n + 1)) ++ DROP k (leibniz_horizontal n) zigzag
6178 TAKE (k + 2) (leibniz_horizontal (n + 1)) ++ DROP (k + 1) (leibniz_horizontal n)
6179 leibniz_triplet_0 |- leibniz_up 1 zigzag leibniz_horizontal 1
6180
6181 Wriggle Paths in Leibniz Triangle:
6182 list_lcm_wriggle |- !p1 p2. p1 wriggle p2 ==> (list_lcm p1 = list_lcm p2)
6183 leibniz_zigzag_wriggle |- !p1 p2. p1 zigzag p2 ==> p1 wriggle p2
6184 leibniz_wriggle_tail |- !p1 p2. p1 wriggle p2 ==> !x. [x] ++ p1 wriggle [x] ++ p2
6185 leibniz_wriggle_refl |- !p1. p1 wriggle p1
6186 leibniz_wriggle_trans |- !p1 p2 p3. p1 wriggle p2 /\ p2 wriggle p3 ==> p1 wriggle p3
6187 leibniz_horizontal_wriggle_step |- !n k. k <= n + 1 ==>
6188 TAKE (k + 1) (leibniz_horizontal (n + 1)) ++ DROP k (leibniz_horizontal n) wriggle leibniz_horizontal (n + 1)
6189 leibniz_horizontal_wriggle |- !n. [leibniz (n + 1) 0] ++ leibniz_horizontal n wriggle leibniz_horizontal (n + 1)
6190
6191 Path Transform keeping LCM:
6192 leibniz_up_wriggle_horizontal |- !n. leibniz_up n wriggle leibniz_horizontal n
6193 leibniz_lcm_property |- !n. list_lcm (leibniz_vertical n) = list_lcm (leibniz_horizontal n)
6194 leibniz_vertical_divisor |- !n k. k <= n ==> leibniz n k divides list_lcm (leibniz_vertical n)
6195
6196 Lower Bound of Leibniz LCM:
6197 leibniz_horizontal_lcm_lower |- !n. 2 ** n <= list_lcm (leibniz_horizontal n)
6198 leibniz_vertical_lcm_lower |- !n. 2 ** n <= list_lcm (leibniz_vertical n)
6199 lcm_lower_bound |- !n. 2 ** n <= list_lcm [1 .. (n + 1)]
6200
6201 Leibniz LCM Invariance:
6202 leibniz_col_arm_0 |- !a b. leibniz_col_arm a b 0 = []
6203 leibniz_seg_arm_0 |- !a b. leibniz_seg_arm a b 0 = []
6204 leibniz_col_arm_1 |- !a b. leibniz_col_arm a b 1 = [leibniz a b]
6205 leibniz_seg_arm_1 |- !a b. leibniz_seg_arm a b 1 = [leibniz a b]
6206 leibniz_col_arm_len |- !a b n. LENGTH (leibniz_col_arm a b n) = n
6207 leibniz_seg_arm_len |- !a b n. LENGTH (leibniz_seg_arm a b n) = n
6208 leibniz_col_arm_el |- !n k. k < n ==> !a b. EL k (leibniz_col_arm a b n) = leibniz (a - k) b
6209 leibniz_seg_arm_el |- !n k. k < n ==> !a b. EL k (leibniz_seg_arm a b n) = leibniz a (b + k)
6210 leibniz_seg_arm_head |- !a b n. TAKE 1 (leibniz_seg_arm a b (n + 1)) = [leibniz a b]
6211 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
6212
6213 leibniz_seg_arm_zigzag_step |- !n k. k < n ==> !a b.
6214 TAKE (k + 1) (leibniz_seg_arm (a + 1) b (n + 1)) ++ DROP k (leibniz_seg_arm a b n) zigzag
6215 TAKE (k + 2) (leibniz_seg_arm (a + 1) b (n + 1)) ++ DROP (k + 1) (leibniz_seg_arm a b n)
6216 leibniz_seg_arm_wriggle_step |- !n k. k < n + 1 ==> !a b.
6217 TAKE (k + 1) (leibniz_seg_arm (a + 1) b (n + 1)) ++ DROP k (leibniz_seg_arm a b n) wriggle
6218 leibniz_seg_arm (a + 1) b (n + 1)
6219 leibniz_seg_arm_wriggle_row_arm |- !a b n. [leibniz (a + 1) b] ++ leibniz_seg_arm a b n wriggle
6220 leibniz_seg_arm (a + 1) b (n + 1)
6221 leibniz_col_arm_wriggle_row_arm |- !a b n. b <= a /\ n <= a + 1 - b ==>
6222 leibniz_col_arm a b n wriggle leibniz_seg_arm a b n
6223 leibniz_lcm_invariance |- !a b n. b <= a /\ n <= a + 1 - b ==>
6224 (list_lcm (leibniz_col_arm a b n) = list_lcm (leibniz_seg_arm a b n))
6225 leibniz_col_arm_n_0 |- !n. leibniz_col_arm n 0 (n + 1) = leibniz_up n
6226 leibniz_seg_arm_n_0 |- !n. leibniz_seg_arm n 0 (n + 1) = leibniz_horizontal n
6227 leibniz_up_wriggle_horizontal_alt |- !n. leibniz_up n wriggle leibniz_horizontal n
6228 leibniz_up_lcm_eq_horizontal_lcm |- !n. list_lcm (leibniz_up n) = list_lcm (leibniz_horizontal n)
6229
6230 Set GCD as Big Operator:
6231 big_gcd_def |- !s. big_gcd s = ITSET gcd s 0
6232 big_gcd_empty |- big_gcd {} = 0
6233 big_gcd_sing |- !x. big_gcd {x} = x
6234 big_gcd_reduction |- !s x. FINITE s /\ x NOTIN s ==> (big_gcd (x INSERT s) = gcd x (big_gcd s))
6235 big_gcd_is_common_divisor |- !s. FINITE s ==> !x. x IN s ==> big_gcd s divides x
6236 big_gcd_is_greatest_common_divisor
6237 |- !s. FINITE s ==> !m. (!x. x IN s ==> m divides x) ==> m divides big_gcd s
6238 big_gcd_insert |- !s. FINITE s ==> !x. big_gcd (x INSERT s) = gcd x (big_gcd s)
6239 big_gcd_two |- !x y. big_gcd {x; y} = gcd x y
6240 big_gcd_positive |- !s. FINITE s /\ s <> {} /\ (!x. x IN s ==> 0 < x) ==> 0 < big_gcd s
6241 big_gcd_map_times |- !s. FINITE s /\ s <> {} ==> !k. big_gcd (IMAGE ($* k) s) = k * big_gcd s
6242
6243 Set LCM as Big Operator:
6244 big_lcm_def |- !s. big_lcm s = ITSET lcm s 1
6245 big_lcm_empty |- big_lcm {} = 1
6246 big_lcm_sing |- !x. big_lcm {x} = x
6247 big_lcm_reduction |- !s x. FINITE s /\ x NOTIN s ==> (big_lcm (x INSERT s) = lcm x (big_lcm s))
6248 big_lcm_is_common_multiple |- !s. FINITE s ==> !x. x IN s ==> x divides big_lcm s
6249 big_lcm_is_least_common_multiple
6250 |- !s. FINITE s ==> !m. (!x. x IN s ==> x divides m) ==> big_lcm s divides m
6251 big_lcm_insert |- !s. FINITE s ==> !x. big_lcm (x INSERT s) = lcm x (big_lcm s)
6252 big_lcm_two |- !x y. big_lcm {x; y} = lcm x y
6253 big_lcm_positive |- !s. FINITE s ==> (!x. x IN s ==> 0 < x) ==> 0 < big_lcm s
6254 big_lcm_map_times |- !s. FINITE s /\ s <> {} ==> !k. big_lcm (IMAGE ($* k) s) = k * big_lcm s
6255
6256 LCM Lower bound using big LCM:
6257 leibniz_seg_def |- !n k h. leibniz_seg n k h = {leibniz n (k + j) | j IN count h}
6258 leibniz_row_def |- !n h. leibniz_row n h = {leibniz n j | j IN count h}
6259 leibniz_col_def |- !h. leibniz_col h = {leibniz j 0 | j IN count h}
6260 leibniz_col_eq_natural |- !n. leibniz_col n = natural n
6261 big_lcm_seg_transform |- !n k h. lcm (leibniz (n + 1) k) (big_lcm (leibniz_seg n k h)) =
6262 big_lcm (leibniz_seg (n + 1) k (h + 1))
6263 big_lcm_row_transform |- !n h. lcm (leibniz (n + 1) 0) (big_lcm (leibniz_row n h)) =
6264 big_lcm (leibniz_row (n + 1) (h + 1))
6265 big_lcm_corner_transform |- !n. big_lcm (leibniz_col (n + 1)) = big_lcm (leibniz_row n (n + 1))
6266 big_lcm_count_lower_bound |- !f n. (!x. x IN count (n + 1) ==> 0 < f x) ==>
6267 SUM (GENLIST f (n + 1)) <= (n + 1) * big_lcm (IMAGE f (count (n + 1)))
6268 big_lcm_natural_eqn |- !n. big_lcm (natural (n + 1)) =
6269 (n + 1) * big_lcm (IMAGE (binomial n) (count (n + 1)))
6270 big_lcm_lower_bound |- !n. 2 ** n <= big_lcm (natural (n + 1))
6271 big_lcm_eq_list_lcm |- !l. big_lcm (set l) = list_lcm l
6272
6273 List LCM depends only on its set of elements:
6274 list_lcm_absorption |- !x l. MEM x l ==> (list_lcm (x::l) = list_lcm l)
6275 list_lcm_nub |- !l. list_lcm (nub l) = list_lcm l
6276 list_lcm_nub_eq_if_set_eq |- !l1 l2. (set l1 = set l2) ==> (list_lcm (nub l1) = list_lcm (nub l2))
6277 list_lcm_eq_if_set_eq |- !l1 l2. (set l1 = set l2) ==> (list_lcm l1 = list_lcm l2)
6278
6279 Set LCM by List LCM:
6280 set_lcm_def |- !s. set_lcm s = list_lcm (SET_TO_LIST s)
6281 set_lcm_empty |- set_lcm {} = 1
6282 set_lcm_nonempty |- !s. FINITE s /\ s <> {} ==> (set_lcm s = lcm (CHOICE s) (set_lcm (REST s)))
6283 set_lcm_sing |- !x. set_lcm {x} = x
6284 set_lcm_eq_list_lcm |- !l. set_lcm (set l) = list_lcm l
6285 set_lcm_eq_big_lcm |- !s. FINITE s ==> (set_lcm s = big_lcm s)
6286 set_lcm_insert |- !s. FINITE s ==> !x. set_lcm (x INSERT s) = lcm x (set_lcm s)
6287 set_lcm_is_common_multiple |- !x s. FINITE s /\ x IN s ==> x divides set_lcm s
6288 set_lcm_is_least_common_multiple |- !s m. FINITE s /\ (!x. x IN s ==> x divides m) ==> set_lcm s divides m
6289 pairwise_coprime_prod_set_eq_set_lcm
6290 |- !s. FINITE s /\ PAIRWISE_COPRIME s ==> (set_lcm s = PROD_SET s)
6291 pairwise_coprime_prod_set_divides
6292 |- !s m. FINITE s /\ PAIRWISE_COPRIME s /\
6293 (!x. x IN s ==> x divides m) ==> PROD_SET s divides m
6294
6295 Nair's Trick (direct):
6296 lcm_run_by_FOLDL |- !n. lcm_run n = FOLDL lcm 1 [1 .. n]
6297 lcm_run_by_FOLDR |- !n. lcm_run n = FOLDR lcm 1 [1 .. n]
6298 lcm_run_0 |- lcm_run 0 = 1
6299 lcm_run_1 |- lcm_run 1 = 1
6300 lcm_run_suc |- !n. lcm_run (n + 1) = lcm (n + 1) (lcm_run n)
6301 lcm_run_pos |- !n. 0 < lcm_run n
6302 lcm_run_small |- (lcm_run 2 = 2) /\ (lcm_run 3 = 6) /\ (lcm_run 4 = 12) /\
6303 (lcm_run 5 = 60) /\ (lcm_run 6 = 60) /\ (lcm_run 7 = 420) /\
6304 (lcm_run 8 = 840) /\ (lcm_run 9 = 2520)
6305 lcm_run_divisors |- !n. n + 1 divides lcm_run (n + 1) /\ lcm_run n divides lcm_run (n + 1)
6306 lcm_run_monotone |- !n. lcm_run n <= lcm_run (n + 1)
6307 lcm_run_lower |- !n. 2 ** n <= lcm_run (n + 1)
6308 lcm_run_leibniz_divisor |- !n k. k <= n ==> leibniz n k divides lcm_run (n + 1)
6309 lcm_run_lower_odd |- !n. n * 4 ** n <= lcm_run (TWICE n + 1)
6310 lcm_run_lower_even |- !n. n * 4 ** n <= lcm_run (TWICE (n + 1))
6311
6312 lcm_run_odd_lower |- !n. ODD n ==> HALF n * HALF (2 ** n) <= lcm_run n
6313 lcm_run_even_lower |- !n. EVEN n ==> HALF (n - 2) * HALF (HALF (2 ** n)) <= lcm_run n
6314 lcm_run_odd_lower_alt |- !n. ODD n /\ 5 <= n ==> 2 ** n <= lcm_run n
6315 lcm_run_even_lower_alt |- !n. EVEN n /\ 8 <= n ==> 2 ** n <= lcm_run n
6316 lcm_run_lower_better |- !n. 7 <= n ==> 2 ** n <= lcm_run n
6317
6318 Nair's Trick (rework):
6319 lcm_run_odd_factor |- !n. 0 < n ==> n * leibniz (TWICE n) n divides lcm_run (TWICE n + 1)
6320 lcm_run_lower_odd |- !n. n * 4 ** n <= lcm_run (TWICE n + 1)
6321 lcm_run_lower_odd_iff |- !n. ODD n ==> (2 ** n <= lcm_run n <=> 5 <= n)
6322 lcm_run_lower_even_iff |- !n. EVEN n ==> (2 ** n <= lcm_run n <=> (n = 0) \/ 8 <= n)
6323 lcm_run_lower_better_iff |- !n. 2 ** n <= lcm_run n <=> (n = 0) \/ (n = 5) \/ 7 <= n
6324
6325 Nair's Trick (consecutive):
6326 lcm_upto_def |- (lcm_upto 0 = 1) /\ !n. lcm_upto (SUC n) = lcm (SUC n) (lcm_upto n)
6327 lcm_upto_0 |- lcm_upto 0 = 1
6328 lcm_upto_SUC |- !n. lcm_upto (SUC n) = lcm (SUC n) (lcm_upto n)
6329 lcm_upto_alt |- (lcm_upto 0 = 1) /\ !n. lcm_upto (n + 1) = lcm (n + 1) (lcm_upto n)
6330 lcm_upto_1 |- lcm_upto 1 = 1
6331 lcm_upto_small |- (lcm_upto 2 = 2) /\ (lcm_upto 3 = 6) /\ (lcm_upto 4 = 12) /\
6332 (lcm_upto 5 = 60) /\ (lcm_upto 6 = 60) /\ (lcm_upto 7 = 420) /\
6333 (lcm_upto 8 = 840) /\ (lcm_upto 9 = 2520) /\ (lcm_upto 10 = 2520)
6334 lcm_upto_eq_list_lcm |- !n. lcm_upto n = list_lcm [1 .. n]
6335 lcm_upto_lower |- !n. 2 ** n <= lcm_upto (n + 1)
6336 lcm_upto_divisors |- !n. n + 1 divides lcm_upto (n + 1) /\ lcm_upto n divides lcm_upto (n + 1)
6337 lcm_upto_monotone |- !n. lcm_upto n <= lcm_upto (n + 1)
6338 lcm_upto_leibniz_divisor |- !n k. k <= n ==> leibniz n k divides lcm_upto (n + 1)
6339 lcm_upto_lower_odd |- !n. n * 4 ** n <= lcm_upto (TWICE n + 1)
6340 lcm_upto_lower_even |- !n. n * 4 ** n <= lcm_upto (TWICE (n + 1))
6341 lcm_upto_lower_better |- !n. 7 <= n ==> 2 ** n <= lcm_upto n
6342
6343 Simple LCM lower bounds:
6344 lcm_run_lower_simple |- !n. HALF (n + 1) <= lcm_run n
6345 lcm_run_alt |- !n. lcm_run n = lcm_run (n - 1 + 1)
6346 lcm_run_lower_good |- !n. 2 ** (n - 1) <= lcm_run n
6347
6348 Upper Bound by Leibniz Triangle:
6349 leibniz_eqn |- !n k. leibniz n k = (n + 1 - k) * binomial (n + 1) k
6350 leibniz_right_alt |- !n k. leibniz n (k + 1) = (n - k) * binomial (n + 1) (k + 1)
6351 leibniz_binomial_identity |- !m n k. k <= m /\ m <= n ==>
6352 (leibniz n k * binomial (n - k) (m - k) = leibniz m k * binomial (n + 1) (m + 1))
6353 leibniz_divides_leibniz_factor |- !m n k. k <= m /\ m <= n ==>
6354 leibniz n k divides leibniz m k * binomial (n + 1) (m + 1)
6355 leibniz_horizontal_member_divides |- !m n x. n <= TWICE m + 1 /\ m <= n /\
6356 MEM x (leibniz_horizontal n) ==>
6357 x divides list_lcm (leibniz_horizontal m) * binomial (n + 1) (m + 1)
6358 lcm_run_divides_property |- !m n. n <= TWICE m /\ m <= n ==>
6359 lcm_run n divides lcm_run m * binomial n m
6360 lcm_run_bound_recurrence |- !m n. n <= TWICE m /\ m <= n ==> lcm_run n <= lcm_run m * binomial n m
6361 lcm_run_upper_bound |- !n. lcm_run n <= 4 ** n
6362
6363 Beta Triangle:
6364 beta_0_n |- !n. beta 0 n = 0
6365 beta_n_0 |- !n. beta n 0 = 0
6366 beta_less_0 |- !n k. n < k ==> (beta n k = 0)
6367 beta_eqn |- !n k. beta (n + 1) (k + 1) = leibniz n k
6368 beta_alt |- !n k. 0 < n /\ 0 < k ==> (beta n k = leibniz (n - 1) (k - 1))
6369 beta_pos |- !n k. 0 < k /\ k <= n ==> 0 < beta n k
6370 beta_eq_0 |- !n k. (beta n k = 0) <=> (k = 0) \/ n < k
6371 beta_sym |- !n k. k <= n ==> (beta n k = beta n (n - k + 1))
6372
6373 Beta Horizontal List:
6374 beta_horizontal_0 |- beta_horizontal 0 = []
6375 beta_horizontal_len |- !n. LENGTH (beta_horizontal n) = n
6376 beta_horizontal_eqn |- !n. beta_horizontal (n + 1) = leibniz_horizontal n
6377 beta_horizontal_alt |- !n. 0 < n ==> (beta_horizontal n = leibniz_horizontal (n - 1))
6378 beta_horizontal_mem |- !n k. 0 < k /\ k <= n ==> MEM (beta n k) (beta_horizontal n)
6379 beta_horizontal_mem_iff |- !n k. MEM (beta n k) (beta_horizontal n) <=> 0 < k /\ k <= n
6380 beta_horizontal_member |- !n x. MEM x (beta_horizontal n) <=> ?k. 0 < k /\ k <= n /\ (x = beta n k)
6381 beta_horizontal_element |- !n k. k < n ==> (EL k (beta_horizontal n) = beta n (k + 1))
6382 lcm_run_by_beta_horizontal |- !n. 0 < n ==> (lcm_run n = list_lcm (beta_horizontal n))
6383 lcm_run_beta_divisor |- !n k. 0 < k /\ k <= n ==> beta n k divides lcm_run n
6384 beta_divides_beta_factor |- !m n k. k <= m /\ m <= n ==> beta n k divides beta m k * binomial n m
6385 lcm_run_divides_property_alt |- !m n. n <= TWICE m /\ m <= n ==> lcm_run n divides binomial n m * lcm_run m
6386 lcm_run_upper_bound |- !n. lcm_run n <= 4 ** n
6387
6388 LCM Lower Bound using Maximum:
6389 list_lcm_ge_max |- !l. POSITIVE l ==> MAX_LIST l <= list_lcm l
6390 lcm_lower_bound_by_list_lcm |- !n. (n + 1) * binomial n (HALF n) <= list_lcm [1 .. (n + 1)]
6391 big_lcm_ge_max |- !s. FINITE s /\ (!x. x IN s ==> 0 < x) ==> MAX_SET s <= big_lcm s
6392 lcm_lower_bound_by_big_lcm |- !n. (n + 1) * binomial n (HALF n) <= big_lcm (natural (n + 1))
6393
6394 Consecutive LCM function:
6395 lcm_lower_bound_by_list_lcm_stirling |- Stirling /\ (!n c. n DIV SQRT (c * (n - 1)) = SQRT (n DIV c)) ==>
6396 !n. ODD n ==> SQRT (n DIV (2 * pi)) * 2 ** n <= list_lcm [1 .. n]
6397 big_lcm_non_decreasing |- !n. big_lcm (natural n) <= big_lcm (natural (n + 1))
6398 lcm_lower_bound_by_big_lcm_stirling |- Stirling /\ (!n c. n DIV SQRT (c * (n - 1)) = SQRT (n DIV c)) ==>
6399 !n. ODD n ==> SQRT (n DIV (2 * pi)) * 2 ** n <= big_lcm (natural n)
6400
6401 Extra Theorems:
6402 gcd_prime_product_property |- !p m n. prime p /\ m divides n /\ ~(p * m divides n) ==> (gcd (p * m) n = m)
6403 lcm_prime_product_property |- !p m n. prime p /\ m divides n /\ ~(p * m divides n) ==> (lcm (p * m) n = p * n)
6404 list_lcm_prime_factor |- !p l. prime p /\ p divides list_lcm l ==> p divides PROD_SET (set l)
6405 list_lcm_prime_factor_member |- !p l. prime p /\ p divides list_lcm l ==> ?x. MEM x l /\ p divides x
6406
6407*)
6408
6409(* ------------------------------------------------------------------------- *)
6410(* Leibniz Harmonic Triangle *)
6411(* ------------------------------------------------------------------------- *)
6412
6413(*
6414
6415Leibniz Harmonic Triangle (fraction form)
6416
6417 c <= r
6418r = 1 1
6419r = 2 1/2 1/2
6420r = 3 1/3 1/6 1/3
6421r = 4 1/4 1/12 1/12 1/4
6422r = 5 1/5 1/10 1/20 1/10 1/5
6423
6424In general, L(r,1) = 1/r, L(r,c) = |L(r-1,c-1) - L(r,c-1)|
6425
6426Solving, L(r,c) = 1/(r C(r-1,c-1)) = 1/(c C(r,c))
6427where C(n,m) is the binomial coefficient of Pascal Triangle.
6428
6429c = 1 are the 1/(1 * natural numbers
6430c = 2 are the 1/(2 * triangular numbers)
6431c = 3 are the 1/(3 * tetrahedral numbers)
6432
6433Sum of denominators of n-th row = n 2**(n-1).
6434
6435Note that L(r,c) = Integral(0,1) x ** (c-1) * (1-x) ** (r-c) dx
6436
6437Another form: L(n,1) = 1/n, L(n,k) = L(n-1,k-1) - L(n,k-1)
6438Solving, L(n,k) = 1/ k C(n,k) = 1/ n C(n-1,k-1)
6439
6440Still another notation H(n,r) = 1/ (n+1)C(n,r) = (n-r)!r!/(n+1)! for 0 <= r <= n
6441
6442Harmonic Denominator Number Triangle (integer form)
6443g(d,n) = 1/H(d,n) where H(d,h) is the Leibniz Harmonic Triangle
6444g(d,n) = (n+d)C(d,n) where C(d,h) is the Pascal's Triangle.
6445g(d,n) = n(n+1)...(n+d)/d!
6446
6447(k+1)-th row of Pascal's triangle: x^4 + 4x^3 + 6x^2 + 4x + 1
6448Perform differentiation, d/dx -> 4x^3 + 12x^2 + 12x + 4
6449which is k-th row of Harmonic Denominator Number Triangle.
6450
6451(k+1)-th row of Pascal's triangle: (x+1)^(k+1)
6452k-th row of Harmonic Denominator Number Triangle: d/dx[(x+1)^(k+1)]
6453
6454 d/dx[(x+1)^(k+1)]
6455= d/dx[SUM C(k+1,j) x^j] j = 0...(k+1)
6456= SUM C(k+1,j) d/dx[x^j]
6457= SUM C(k+1,j) j x^(j-1) j = 1...(k+1)
6458= SUM C(k+1,j+1) (j+1) x^j j = 0...k
6459= SUM D(k,j) x^j with D(k,j) = (j+1) C(k+1,j+1) ???
6460
6461*)
6462
6463(* Another presentation of triangles:
6464
6465The harmonic triangle of Leibniz
6466 1/1 1/2 1/3 1/4 1/5 .... harmonic fractions
6467 1/2 1/6 1/12 1/20 .... successive difference
6468 1/3 1/12 1/30 ...
6469 1/4 1/20 ... ...
6470 1/5 ... ... ...
6471
6472Pascal's triangle
6473 1 1 1 1 1 1 1 .... units
6474 1 2 3 4 5 6 .... sum left and above
6475 1 3 6 10 15 21
6476 1 4 10 20 35
6477 1 5 15 35
6478 1 6 21
6479
6480
6481*)
6482
6483(* LCM Lemma
6484
6485(n+1) lcm (C(n,0) to C(n,n)) = lcm (1 to (n+1))
6486
6487m-th number in the n-th row of Leibniz triangle is: 1/ (n+1)C(n,m)
6488
6489LHS = (n+1) LCM (C(n,0), C(n,1), ..., C(n,n)) = lcd of fractions in n-th row of Leibniz triangle.
6490
6491Any such number is an integer linear combination of fractions on triangle’s sides
64921/1, 1/2, 1/3, ... 1/n, and vice versa.
6493
6494So LHS = lcd (1/1, 1/2, 1/3, ..., 1/n) = RHS = lcm (1,2,3, ..., (n+1)).
6495
64960-th row: 1
64971-st row: 1/2 1/2
64982-nd row: 1/3 1/6 1/3
64993-rd row: 1/4 1/12 1/12 1/4
65004-th row: 1/5 1/20 1/30 1/20 1/5
6501
65024-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
6503 lcd (1/5 1/20 1/30 1/20 1/5)
6504= lcm (5, 20, 30, 20, 5)
6505= lcm (5 C(4,0), 5 C(4,1), 5 C(4,2), 5 C(4,3), 5 C(4,4))
6506= 5 lcm (C(4,0), C(4,1), C(4,2), C(4,3), C(4,4))
6507
6508But 1/5 = harmonic
6509 1/20 = 1/4 - 1/5 = combination of harmonic
6510 1/30 = 1/12 - 1/20 = (1/3 - 1/4) - (1/4 - 1/5) = combination of harmonic
6511
6512 lcd (1/5 1/20 1/30 1/20 1/5)
6513= lcd (combination of harmonic from 1/1 to 1/5)
6514= lcd (1/1 to 1/5)
6515= lcm (1 to 5)
6516
6517Theorem: lcd (1/x 1/y 1/z) = lcm (x y z)
6518Theorem: lcm (kx ky kz) = k lcm (x y z)
6519Theorem: lcd (combination of harmonic from 1/1 to 1/n) = lcd (1/1 to 1/n)
6520Then apply first theorem, lcd (1/1 to 1/n) = lcm (1 to n)
6521*)
6522
6523(* LCM Bound
6524 0 < n ==> 2^(n-1) < lcm (1 to n)
6525
6526 lcm (1 to n)
6527= n lcm (C(n-1,0) to C(n-1,n-1)) by LCM Lemma
6528>= n max (0 <= j <= n-1) C(n-1,j)
6529>= SUM (0 <= j <= n-1) C(n-1,j)
6530= 2^(n-1)
6531
6532 lcm (1 to 5)
6533= 5 lcm (C(4,0), C(4,1), C(4,2), C(4,3), C(4,4))
6534
6535
6536>= C(4,0) + C(4,1) + C(4,2) + C(4,3) + C(4,4)
6537= (1 + 1)^4
6538= 2^4
6539
6540 lcm (1 to 5) = 1x2x3x4x5/2 = 60
6541= 5 lcm (1 4 6 4 1) = 5 x 12
6542= lcm (1 4 6 4 1) --> unfold 5x to add 5 times
6543 + lcm (1 4 6 4 1)
6544 + lcm (1 4 6 4 1)
6545 + lcm (1 4 6 4 1)
6546 + lcm (1 4 6 4 1)
6547>= 1 + 4 + 6 + 4 + 1 --> pick one of each 5 C(n,m), i.e. diagonal
6548= (1 + 1)^4 --> fold back binomial
6549= 2^4 = 16
6550
6551Actually, can take 5 lcm (1 4 6 4 1) >= 5 x 6 = 30,
6552but this will need estimation of C(n, n/2), or C(2n,n), involving Stirling's formula.
6553
6554Theorem: lcm (x y z) >= x or lcm (x y z) >= y or lcm (x y z) >= z
6555
6556*)
6557
6558(*
6559
6560More generally, there is an identity for 0 <= k <= n:
6561
6562(n+1) lcm (C(n,0), C(n,1), ..., C(n,k)) = lcm (n+1, n, n-1, ..., n+1-k)
6563
6564This is simply that fact that any integer linear combination of
6565f(x), delta f(x), delta^2 f(x), ..., delta^k f(x)
6566is an integer linear combination of f(x), f(x-1), f(x-2), ..., f(x-k)
6567where delta is the difference operator, f(x) = 1/x, and x = n+1.
6568
6569BTW, Leibnitz harmonic triangle too gives this identity.
6570
6571That's correct, but the use of absolute values in the Leibniz triangle and
6572its specialized definition somewhat obscures the generic, linear nature of the identity.
6573
6574 f(x) = f(n+1) = 1/(n+1)
6575f(x-1) = f(n) = 1/n
6576f(x-2) = f(n-1) = 1/(n-1)
6577f(x-k) = f(n+1-k) = 1/(n+1-k)
6578
6579 f(x) = f(n+1) = 1/(n+1) = 1/(n+1)C(n,0)
6580 delta f(x) = f(x-1) - f(x) = 1/n - 1/(n+1) = 1/n(n+1) = 1/(n+1)C(n,1)
6581 = C(1,0) f(x-1) - C(1,1) f(x)
6582delta^2 f(x) = delta f(x-1) - delta f(x) = 1/(n-1)n - 1/n(n+1)
6583 = (n(n+1) - n(n-1))/(n)(n+1)(n)(n-1)
6584 = 2n/n(n+1)n(n-1) = 1/(n+1)(n(n-1)/2) = 1/(n+1)C(n,2)
6585delta^2 f(x) = delta f(x-1) - delta f(x)
6586 = (f(x-2) - f(x-1)) - (f(x-1) - f(x))
6587 = f(x-2) - 2 f(x-1) + f(x)
6588 = C(2,0) f(x-2) - C(2,1) f(x-1) + C(2,2) f(x)
6589delta^3 f(x) = delta^2 f(x-1) - delta^2 f(x)
6590 = (f(x-3) - 2 f(x-2) + f(x-1)) - (f(x-2) - 2 f(x-1) + f(x))
6591 = f(x-3) - 3 f(x-2) + 3 f(x-1) - f(x)
6592 = C(3,0) f(x-3) - C(3,1) f(x-2) + C(3,2) f(x-2) - C(3,3) f(x)
6593
6594delta^k f(x) = C(k,0) f(x-k) - C(k,1) f(x-k+1) + ... + (-1)^k C(k,k) f(x)
6595 = SUM(0 <= j <= k) (-1)^k C(k,j) f(x-k+j)
6596Also,
6597 f(x) = 1/(n+1)C(n,0)
6598 delta f(x) = 1/(n+1)C(n,1)
6599delta^2 f(x) = 1/(n+1)C(n,2)
6600delta^k f(x) = 1/(n+1)C(n,k)
6601
6602so lcd (f(x), df(x), d^2f(x), ..., d^kf(x))
6603 = lcm ((n+1)C(n,0),(n+1)C(n,1),...,(n+1)C(n,k)) by lcd-to-lcm
6604 = lcd (f(x), f(x-1), f(x-2), ..., f(x-k)) by linear combination
6605 = lcm ((n+1), n, (n-1), ..., (n+1-k)) by lcd-to-lcm
6606
6607How to formalize:
6608lcd (f(x), df(x), d^2f(x), ..., d^kf(x)) = lcd (f(x), f(x-1), f(x-2), ..., f(x-k))
6609
6610Simple case: lcd (f(x), df(x)) = lcd (f(x), f(x-1))
6611
6612 lcd (f(x), df(x))
6613= lcd (f(x), f(x-1) - f(x))
6614= lcd (f(x), f(x-1))
6615
6616Can we have
6617 LCD {f(x), df(x)}
6618= LCD {f(x), f(x-1) - f(x)} = LCD {1/x, 1/(x-1) - 1/x}
6619= LCD {f(x), f(x-1), f(x)} = lcm {x, x(x-1)}
6620= LCD {f(x), f(x-1)} = x(x-1) = lcm {x, x-1} = LCD {1/x, 1/(x-1)}
6621
6622*)
6623
6624(* Step 1: From Pascal's Triangle to Leibniz's Triangle
6625
6626Pascal's Triangle:
6627
6628row 0 1
6629row 1 1 1
6630row 2 1 2 1
6631row 3 1 3 3 1
6632row 4 1 4 6 4 1
6633row 5 1 5 10 10 5 1
6634
6635The rule is: boundary = 1, entry = up + left-up
6636 or: C(n,0) = 1, C(n,k) = C(n-1,k) + C(n-1,k-1)
6637
6638Multiple each row by successor of its index, i.e. row n -> (n + 1) (row n):
6639Multiples Triangle (or Modified Triangle):
6640
66411 * row 0 1
66422 * row 1 2 2
66433 * row 2 3 6 3
66444 * row 3 4 12 12 4
66455 * row 4 5 20 30 20 5
66466 * row 5 6 30 60 60 30 6
6647
6648The rule is: boundary = n, entry = left * left-up / (left - left-up)
6649 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))
6650
6651Then lcm(1, 2)
6652 = lcm(2)
6653 = lcm(2, 2)
6654
6655 lcm(1, 2, 3)
6656 = lcm(lcm(1,2), 3) using lcm(1,2,...,n,n+1) = lcm(lcm(1,2,...,n), n+1)
6657 = lcm(2, 3) using lcm(1,2)
6658 = 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))
6659 = lcm(6, 3)
6660 = lcm(3, 6, 3)
6661
6662 lcm(1, 2, 3, 4)
6663 = lcm(lcm(1,2,3), 4)
6664 = lcm(lcm(6,3), 4)
6665 = lcm(6, 3, 4)
6666 = lcm(6, 3*4/1, 4)
6667 = lcm(6, 12, 4)
6668 = lcm(6*12/6, 12, 4)
6669 = lcm(12, 12, 4)
6670 = lcm(4, 12, 12, 4)
6671
6672 lcm(1, 2, 3, 4, 5)
6673 = lcm(lcm(2,3,4), 5)
6674 = lcm(lcm(12,4), 5)
6675 = lcm(12, 4, 5)
6676 = lcm(12, 4*5/1, 5)
6677 = lcm(12, 20, 5)
6678 = lcm(12*20/8, 20, 5)
6679 = lcm(30, 20, 5)
6680 = lcm(5, 20, 30, 20, 5)
6681
6682 lcm(1, 2, 3, 4, 5, 6)
6683 = lcm(lcm(1, 2, 3, 4, 5), 6)
6684 = lcm(lcm(30,20,5), 6)
6685 = lcm(30, 20, 5, 6)
6686 = lcm(30, 20, 5*6/1, 6)
6687 = lcm(30, 20, 30, 6)
6688 = lcm(30, 20*30/10, 30, 6)
6689 = lcm(20, 60, 30, 6)
6690 = lcm(20*60/40, 60, 30, 6)
6691 = lcm(30, 60, 30, 6)
6692 = lcm(6, 30, 60, 30, 6)
6693
6694Invert each entry of Multiples Triangle into a unit fraction:
6695Leibniz's Triangle:
6696
66971/(1 * row 0) 1/1
66981/(2 * row 1) 1/2 1/2
66991/(3 * row 2) 1/3 1/6 1/3
67001/(4 * row 3) 1/4 1/12 1/12 1/4
67011/(5 * row 4) 1/5 1/20 1/30 1/20 1/5
67021/(6 * row 5) 1/6 1/30 1/60 1/60 1/30 1/6
6703
6704Theorem: In the Multiples Triangle, the vertical-lcm = horizontal-lcm.
6705i.e. lcm (1, 2, 3) = lcm (3, 6, 3) = 6
6706 lcm (1, 2, 3, 4) = lcm (4, 12, 12, 4) = 12
6707 lcm (1, 2, 3, 4, 5) = lcm (5, 20, 30, 20, 5) = 60
6708 lcm (1, 2, 3, 4, 5, 6) = lcm (6, 30, 60, 60, 30, 6) = 60
6709Proof: With reference to Leibniz's Triangle, note: term = left-up - left
6710 lcm (5, 20, 30, 20, 5)
6711= lcm (5, 20, 30) by reduce repetition
6712= lcm (5, d(1/20), d(1/30)) by denominator of fraction
6713= lcm (5, d(1/4 - 1/5), d(1/30)) by term = left-up - left
6714= lcm (5, lcm(4, 5), d(1/12 - 1/20)) by denominator of fraction subtraction
6715= lcm (5, 4, lcm(12, 20)) by lcm (a, lcm (a, b)) = lcm (a, b)
6716= lcm (5, 4, lcm(d(1/12), d(1/20))) to fraction again
6717= lcm (5, 4, lcm(d(1/3 - 1/4), d(1/4 - 1/5))) by Leibniz's Triangle
6718= lcm (5, 4, lcm(lcm(3,4), lcm(4,5))) by fraction subtraction denominator
6719= lcm (5, 4, lcm(3, 4, 5)) by lcm merge
6720= lcm (5, 4, 3) merge again
6721= lcm (5, 4, 3, 2) by lcm include factor (!!!)
6722= lcm (5, 4, 3, 2, 1) by lcm include 1
6723
6724Note: to make 30, need 12, 20
6725 to make 12, need 3, 4; to make 20, need 4, 5
6726 lcm (1, 2, 3, 4, 5)
6727= lcm (1, 2, lcm(3,4), lcm(4,5), 5)
6728= lcm (1, 2, d(1/3 - 1/4), d(1/4 - 1/5), 5)
6729= lcm (1, 2, d(1/12), d(1/20), 5)
6730= lcm (1, 2, 12, 20, 5)
6731= lcm (1, 2, lcm(12, 20), 20, 5)
6732= lcm (1, 2, d(1/12 - 1/20), 20, 5)
6733= lcm (1, 2, d(1/30), 20, 5)
6734= lcm (1, 2, 30, 20, 5)
6735= lcm (1, 30, 20, 5) can drop factor !!
6736= lcm (30, 20, 5) can drop 1
6737= lcm (5, 20, 30, 20, 5)
6738
6739 lcm (1, 2, 3, 4, 5, 6)
6740= lcm (lcm (1, 2, 3, 4, 5), lcm(5,6), 6)
6741= lcm (lcm (5, 20, 30, 20, 5), d(1/5 - 1/6), 6)
6742= lcm (lcm (5, 20, 30, 20, 5), d(1/30), 6)
6743= lcm (lcm (5, 20, 30, 20, 5), 30, 6)
6744= lcm (lcm (5, 20, 30, 20, 5), 30, 6)
6745= lcm (5, 30, 20, 6)
6746= lcm (30, 20, 6) can drop factor !!
6747= lcm (lcm(20, 30), 30, 6)
6748= lcm (d(1/20 - 1/30), 30, 6)
6749= lcm (d(1/60), 30, 6)
6750= lcm (60, 30, 6)
6751= lcm (6, 30, 60, 30, 6)
6752
6753 lcm (1, 2)
6754= lcm (lcm(1,2), 2)
6755= lcm (2, 2)
6756
6757 lcm (1, 2, 3)
6758= lcm (lcm(1, 2), 3)
6759= lcm (2, 3) --> lcm (2x3/(3-2), 3) = lcm (6, 3)
6760= lcm (lcm(2, 3), 3) --> lcm (6, 3) = lcm (3, 6, 3)
6761= lcm (d(1/2 - 1/3), 3)
6762= lcm (d(1/6), 3)
6763= lcm (6, 3) = lcm (3, 6, 3)
6764
6765 lcm (1, 2, 3, 4)
6766= lcm (lcm(1, 2, 3), 4)
6767= lcm (lcm(6, 3), 4)
6768= lcm (6, 3, 4)
6769= lcm (6, lcm(3, 4), 4) --> lcm (6, 12, 4) = lcm (6x12/(12-6), 12, 4)
6770= lcm (6, d(1/3 - 1/4), 4) = lcm (12, 12, 4) = lcm (4, 12, 12, 4)
6771= lcm (6, d(1/12), 4)
6772= lcm (6, 12, 4)
6773= lcm (lcm(6, 12), 4)
6774= lcm (d(1/6 - 1/12), 4)
6775= lcm (d(1/12), 4)
6776= lcm (12, 4) = lcm (4, 12, 12, 4)
6777
6778 lcm (1, 2, 3, 4, 5)
6779= lcm (lcm(1, 2, 3, 4), 5)
6780= lcm (lcm(12, 4), 5)
6781= lcm (12, 4, 5)
6782= lcm (12, lcm(4,5), 5) --> lcm (12, 20, 5) = lcm (12x20/(20-12), 20, 5)
6783= lcm (12, d(1/4 - 1/5), 5) = lcm (240/8, 20, 5) but lcm(12,20) != 30
6784= lcm (12, d(1/20), 5) = lcm (30, 20, 5) use lcm(a,b,c) = lcm(ab/(b-a), b, c)
6785= lcm (12, 20, 5)
6786= lcm (lcm(12,20), 20, 5)
6787= lcm (d(1/12 - 1/20), 20, 5)
6788= lcm (d(1/30), 20, 5)
6789= lcm (30, 20, 5) = lcm (5, 20, 30, 20, 5)
6790
6791 lcm (1, 2, 3, 4, 5, 6)
6792= lcm (lcm(1, 2, 3, 4, 5), 6)
6793= lcm (lcm(30, 20, 5), 6)
6794= lcm (30, 20, 5, 6)
6795= lcm (30, 20, lcm(5,6), 6) --> lcm (30, 20, 30, 6) = lcm (30, 20x30/(30-20), 30, 6)
6796= lcm (30, 20, d(1/5 - 1/6), 6) = lcm (30, 60, 30, 6)
6797= lcm (30, 20, d(1/30), 6) = lcm (30x60/(60-30), 60, 30, 6)
6798= lcm (30, 20, 30, 6) = lcm (60, 60, 30, 6)
6799= lcm (30, lcm(20,30), 30, 6)
6800= lcm (30, d(1/20 - 1/30), 30, 6)
6801= lcm (30, d(1/60), 30, 6)
6802= lcm (30, 60, 30, 6)
6803= lcm (lcm(30, 60), 60, 30, 6)
6804= lcm (d(1/30 - 1/60), 60, 30, 6)
6805= lcm (d(1/60), 60, 30, 6)
6806= lcm (60, 60, 30, 6)
6807= lcm (60, 30, 6) = lcm (6, 30, 60, 60, 30, 6)
6808
6809*)
6810
6811(* ------------------------------------------------------------------------- *)
6812(* Leibniz Triangle (Denominator form) *)
6813(* ------------------------------------------------------------------------- *)
6814
6815(* Define Leibniz Triangle *)
6816Definition leibniz_def[simp]:
6817 leibniz n k = (n + 1) * binomial n k
6818End
6819
6820
6821(* Theorem: leibniz 0 n = if n = 0 then 1 else 0 *)
6822(* Proof:
6823 leibniz 0 n
6824 = (0 + 1) * binomial 0 n by leibniz_def
6825 = if n = 0 then 1 else 0 by binomial_n_0
6826*)
6827Theorem leibniz_0_n:
6828 !n. leibniz 0 n = if n = 0 then 1 else 0
6829Proof
6830 rw[binomial_0_n]
6831QED
6832
6833(* Theorem: leibniz n 0 = n + 1 *)
6834(* Proof:
6835 leibniz n 0
6836 = (n + 1) * binomial n 0 by leibniz_def
6837 = (n + 1) * 1 by binomial_n_0
6838 = n + 1
6839*)
6840Theorem leibniz_n_0:
6841 !n. leibniz n 0 = n + 1
6842Proof
6843 rw[binomial_n_0]
6844QED
6845
6846(* Theorem: leibniz n n = n + 1 *)
6847(* Proof:
6848 leibniz n n
6849 = (n + 1) * binomial n n by leibniz_def
6850 = (n + 1) * 1 by binomial_n_n
6851 = n + 1
6852*)
6853Theorem leibniz_n_n:
6854 !n. leibniz n n = n + 1
6855Proof
6856 rw[binomial_n_n]
6857QED
6858
6859(* Theorem: n < k ==> leibniz n k = 0 *)
6860(* Proof:
6861 leibniz n k
6862 = (n + 1) * binomial n k by leibniz_def
6863 = (n + 1) * 0 by binomial_less_0
6864 = 0
6865*)
6866Theorem leibniz_less_0:
6867 !n k. n < k ==> (leibniz n k = 0)
6868Proof
6869 rw[binomial_less_0]
6870QED
6871
6872(* Theorem: k <= n ==> (leibniz n k = leibniz n (n-k)) *)
6873(* Proof:
6874 leibniz n k
6875 = (n + 1) * binomial n k by leibniz_def
6876 = (n + 1) * binomial n (n-k) by binomial_sym
6877 = leibniz n (n-k) by leibniz_def
6878*)
6879Theorem leibniz_sym:
6880 !n k. k <= n ==> (leibniz n k = leibniz n (n-k))
6881Proof
6882 rw[leibniz_def, GSYM binomial_sym]
6883QED
6884
6885(* Theorem: k < HALF n ==> leibniz n k < leibniz n (k + 1) *)
6886(* Proof:
6887 Assume k < HALF n, and note that 0 < (n + 1).
6888 leibniz n k < leibniz n (k + 1)
6889 <=> (n + 1) * binomial n k < (n + 1) * binomial n (k + 1) by leibniz_def
6890 <=> binomial n k < binomial n (k + 1) by LT_MULT_LCANCEL
6891 <=> T by binomial_monotone
6892*)
6893Theorem leibniz_monotone:
6894 !n k. k < HALF n ==> leibniz n k < leibniz n (k + 1)
6895Proof
6896 rw[leibniz_def, binomial_monotone]
6897QED
6898
6899(* Theorem: k <= n ==> 0 < leibniz n k *)
6900(* Proof:
6901 Since leibniz n k = (n + 1) * binomial n k by leibniz_def
6902 and 0 < n + 1, 0 < binomial n k by binomial_pos
6903 Hence 0 < leibniz n k by ZERO_LESS_MULT
6904*)
6905Theorem leibniz_pos:
6906 !n k. k <= n ==> 0 < leibniz n k
6907Proof
6908 rw[leibniz_def, binomial_pos, ZERO_LESS_MULT, DECIDE``!n. 0 < n + 1``]
6909QED
6910
6911(* Theorem: (leibniz n k = 0) <=> n < k *)
6912(* Proof:
6913 leibniz n k = 0
6914 <=> (n + 1) * (binomial n k = 0) by leibniz_def
6915 <=> binomial n k = 0 by MULT_EQ_0, n + 1 <> 0
6916 <=> n < k by binomial_eq_0
6917*)
6918Theorem leibniz_eq_0:
6919 !n k. (leibniz n k = 0) <=> n < k
6920Proof
6921 rw[leibniz_def, binomial_eq_0]
6922QED
6923
6924(* Theorem: leibniz n = (\j. (n + 1) * j) o (binomial n) *)
6925(* Proof: by leibniz_def and function equality. *)
6926Theorem leibniz_alt:
6927 !n. leibniz n = (\j. (n + 1) * j) o (binomial n)
6928Proof
6929 rw[leibniz_def, FUN_EQ_THM]
6930QED
6931
6932(* Theorem: leibniz n k = (\j. (n + 1) * j) (binomial n k) *)
6933(* Proof: by leibniz_def *)
6934Theorem leibniz_def_alt:
6935 !n k. leibniz n k = (\j. (n + 1) * j) (binomial n k)
6936Proof
6937 rw_tac std_ss[leibniz_def]
6938QED
6939
6940(*
6941Picture of Leibniz Triangle L-corner:
6942 b = L (n-1) k
6943 a = L n k c = L n (k+1)
6944
6945a = L n k = (n+1) * (n, k, n-k) = (n+1, k, n-k) = (n+1)! / k! (n-k)!
6946b = 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)
6947c = 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)
6948
6949a * b = a * a * (n-k)/(n+1)
6950a - 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)
6951Hence
6952 a * b /(a - b)
6953= [a * a * (n-k)/(n+1)] / [a * (k+1)/(n+1)]
6954= a * (n-k)/(k+1)
6955= c
6956or a * b = c * (a - b)
6957*)
6958
6959(* Theorem: 0 < n ==> !k. (n + 1) * leibniz (n - 1) k = (n - k) * leibniz n k *)
6960(* Proof:
6961 (n + 1) * leibniz (n - 1) k
6962 = (n + 1) * ((n-1 + 1) * binomial (n-1) k) by leibniz_def
6963 = (n + 1) * (n * binomial (n-1) k) by SUB_ADD, 1 <= n.
6964 = (n + 1) * ((n - k) * (binomial n k)) by binomial_up_eqn
6965 = ((n + 1) * (n - k)) * binomial n k by MULT_ASSOC
6966 = ((n - k) * (n + 1)) * binomial n k by MULT_COMM
6967 = (n - k) * ((n + 1) * binomial n k) by MULT_ASSOC
6968 = (n - k) * leibniz n k by leibniz_def
6969*)
6970Theorem leibniz_up_eqn:
6971 !n. 0 < n ==> !k. (n + 1) * leibniz (n - 1) k = (n - k) * leibniz n k
6972Proof
6973 rw[leibniz_def] >>
6974 `1 <= n` by decide_tac >>
6975 metis_tac[SUB_ADD, binomial_up_eqn, MULT_ASSOC, MULT_COMM]
6976QED
6977
6978(* Theorem: 0 < n ==> !k. leibniz (n - 1) k = (n - k) * leibniz n k DIV (n + 1) *)
6979(* Proof:
6980 Since (n + 1) * leibniz (n - 1) k = (n - k) * leibniz n k by leibniz_up_eqn
6981 leibniz (n - 1) k = (n - k) * leibniz n k DIV (n + 1) by DIV_SOLVE, 0 < n+1.
6982*)
6983Theorem leibniz_up:
6984 !n. 0 < n ==> !k. leibniz (n - 1) k = (n - k) * leibniz n k DIV (n + 1)
6985Proof
6986 rw[leibniz_up_eqn, DIV_SOLVE]
6987QED
6988
6989(* Theorem: 0 < n ==> !k. leibniz (n - 1) k = (n - k) * binomial n k *)
6990(* Proof:
6991 leibniz (n - 1) k
6992 = (n - k) * leibniz n k DIV (n + 1) by leibniz_up, 0 < n
6993 = (n - k) * ((n + 1) * binomial n k) DIV (n + 1) by leibniz_def
6994 = (n + 1) * ((n - k) * binomial n k) DIV (n + 1) by MULT_ASSOC, MULT_COMM
6995 = (n - k) * binomial n k by MULT_DIV, 0 < n + 1
6996*)
6997Theorem leibniz_up_alt:
6998 !n. 0 < n ==> !k. leibniz (n - 1) k = (n - k) * binomial n k
6999Proof
7000 metis_tac[leibniz_up, leibniz_def, MULT_DIV, MULT_ASSOC, MULT_COMM, DECIDE``0 < x + 1``]
7001QED
7002
7003(* Theorem: 0 < n ==> !k. (k + 1) * leibniz n (k+1) = (n - k) * leibniz n k *)
7004(* Proof:
7005 (k + 1) * leibniz n (k+1)
7006 = (k + 1) * ((n + 1) * binomial n (k+1)) by leibniz_def
7007 = (k + 1) * (n + 1) * binomial n (k+1) by MULT_ASSOC
7008 = (n + 1) * (k + 1) * binomial n (k+1) by MULT_COMM
7009 = (n + 1) * ((k + 1) * binomial n (k+1)) by MULT_ASSOC
7010 = (n + 1) * ((n - k) * (binomial n k)) by binomial_right_eqn
7011 = ((n + 1) * (n - k)) * binomial n k by MULT_ASSOC
7012 = ((n - k) * (n + 1)) * binomial n k by MULT_COMM
7013 = (n - k) * ((n + 1) * binomial n k) by MULT_ASSOC
7014 = (n - k) * leibniz n k by leibniz_def
7015*)
7016Theorem leibniz_right_eqn:
7017 !n. 0 < n ==> !k. (k + 1) * leibniz n (k+1) = (n - k) * leibniz n k
7018Proof
7019 metis_tac[leibniz_def, MULT_COMM, MULT_ASSOC, binomial_right_eqn]
7020QED
7021
7022(* Theorem: 0 < n ==> !k. leibniz n (k+1) = (n - k) * (leibniz n k) DIV (k + 1) *)
7023(* Proof:
7024 Since (k + 1) * leibniz n (k+1) = (n - k) * leibniz n k by leibniz_right_eqn
7025 leibniz n (k+1) = (n - k) * (leibniz n k) DIV (k+1) by DIV_SOLVE, 0 < k+1.
7026*)
7027Theorem leibniz_right:
7028 !n. 0 < n ==> !k. leibniz n (k+1) = (n - k) * (leibniz n k) DIV (k+1)
7029Proof
7030 rw[leibniz_right_eqn, DIV_SOLVE]
7031QED
7032
7033(* Note: Following is the property from Leibniz Harmonic Triangle:
7034 1 / leibniz n (k+1) = 1 / leibniz (n-1) k - 1 / leibniz n k
7035 = (leibniz n k - leibniz (n-1) k) / leibniz n k * leibniz (n-1) k
7036*)
7037
7038(* The Idea:
7039 b
7040Actually, lcm a b = lcm b c = lcm c a for a c in Leibniz Triangle.
7041The only relationship is: c = ab/(a - b), or ab = c(a - b).
7042
7043Is this a theorem: ab = c(a - b) ==> lcm a b = lcm b c = lcm c a
7044Or in fractions, 1/c = 1/b - 1/a ==> lcm a b = lcm b c = lcm c a ?
7045
7046lcm a b
7047= a b / (gcd a b)
7048= c(a - b) / (gcd a (a - b))
7049= ac(a - b) / gcd a (a-b) / a
7050= lcm (a (a-b)) c / a
7051= lcm (ca c(a-b)) / a
7052= lcm (ca ab) / a
7053= lcm (b c)
7054
7055lcm a b = a b / gcd a b = a b / gcd a (a-b) = a b c / gcd ca c(a-b)
7056= c (a-b) c / gcd ca c(a-b) = lcm ca c(a-b) / a = lcm ca ab / a = lcm b c
7057
7058 lcm b c
7059= b c / gcd b c
7060= a b c / gcd a*b a*c
7061= a b c / gcd c*(a-b) c*a
7062= a b / gcd (a-b) a
7063= a b / gcd b a
7064= lcm (a b)
7065= lcm a b
7066
7067 lcm a c
7068= a c / gcd a c
7069= a b c / gcd b*a b*c
7070= a b c / gcd c*(a-b) b*c
7071= a b / gcd (a-b) b
7072= a b / gcd a b
7073= lcm a b
7074
7075Yes!
7076
7077This is now in LCM_EXCHANGE:
7078val it = |- !a b c. (a * b = c * (a - b)) ==> (lcm a b = lcm a c): thm
7079*)
7080
7081(* Theorem: 0 < n ==>
7082 !k. leibniz n k * leibniz (n-1) k = leibniz n (k+1) * (leibniz n k - leibniz (n-1) k) *)
7083(* Proof:
7084 If n <= k,
7085 then n-1 < k, and n < k+1.
7086 so leibniz (n-1) k = 0 by leibniz_less_0, n-1 < k.
7087 and leibniz n (k+1) = 0 by leibniz_less_0, n < k+1.
7088 Hence true by MULT_EQ_0
7089 Otherwise, k < n, or k <= n.
7090 then (n+1) - (n-k) = k+1.
7091
7092 (k + 1) * (c * (a - b))
7093 = (k + 1) * c * (a - b) by MULT_ASSOC
7094 = ((n+1) - (n-k)) * c * (a - b) by above
7095 = (n - k) * a * (a - b) by leibniz_right_eqn
7096 = (n - k) * a * a - (n - k) * a * b by LEFT_SUB_DISTRIB
7097 = (n + 1) * b * a - (n - k) * a * b by leibniz_up_eqn
7098 = (n + 1) * (a * b) - (n - k) * (a * b) by MULT_ASSOC, MULT_COMM
7099 = ((n+1) - (n-k)) * (a * b) by RIGHT_SUB_DISTRIB
7100 = (k + 1) * (a * b) by above
7101
7102 Since (k+1) <> 0, the result follows by MULT_LEFT_CANCEL
7103*)
7104Theorem leibniz_property:
7105 !n. 0 < n ==>
7106 !k. leibniz n k * leibniz (n-1) k = leibniz n (k+1) * (leibniz n k - leibniz (n-1) k)
7107Proof
7108 rpt strip_tac >>
7109 Cases_on `n <= k` >-
7110 rw[leibniz_less_0] >>
7111 `(n+1) - (n-k) = k+1` by decide_tac >>
7112 `(k+1) <> 0` by decide_tac >>
7113 qabbrev_tac `a = leibniz n k` >>
7114 qabbrev_tac `b = leibniz (n - 1) k` >>
7115 qabbrev_tac `c = leibniz n (k + 1)` >>
7116 `(k + 1) * (c * (a - b)) = ((n+1) - (n-k)) * c * (a - b)` by rw_tac std_ss[MULT_ASSOC] >>
7117 `_ = (n - k) * a * (a - b)` by rw_tac std_ss[leibniz_right_eqn, Abbr`c`, Abbr`a`] >>
7118 `_ = (n - k) * a * a - (n - k) * a * b` by rw_tac std_ss[LEFT_SUB_DISTRIB] >>
7119 `_ = (n + 1) * b * a - (n - k) * a * b` by rw_tac std_ss[leibniz_up_eqn, Abbr`b`, Abbr`a`] >>
7120 `_ = (n + 1) * (a * b) - (n - k) * (a * b)` by metis_tac[MULT_ASSOC, MULT_COMM] >>
7121 `_ = ((n+1) - (n-k)) * (a * b)` by rw_tac std_ss[RIGHT_SUB_DISTRIB] >>
7122 `_ = (k + 1) * (a * b)` by rw_tac std_ss[] >>
7123 metis_tac[MULT_LEFT_CANCEL]
7124QED
7125
7126(* Theorem: k <= n ==> (leibniz n k = (n + 1) * FACT n DIV (FACT k * FACT (n - k))) *)
7127(* Proof:
7128 Note (FACT k * FACT (n - k)) divides (FACT n) by binomial_is_integer
7129 and 0 < FACT k * FACT (n - k) by FACT_LESS, ZERO_LESS_MULT
7130 leibniz n k
7131 = (n + 1) * binomial n k by leibniz_def
7132 = (n + 1) * (FACT n DIV (FACT k * FACT (n - k))) by binomial_formula3
7133 = (n + 1) * FACT n DIV (FACT k * FACT (n - k)) by MULTIPLY_DIV
7134*)
7135Theorem leibniz_formula:
7136 !n k. k <= n ==> (leibniz n k = (n + 1) * FACT n DIV (FACT k * FACT (n - k)))
7137Proof
7138 metis_tac[leibniz_def, binomial_formula3, binomial_is_integer, FACT_LESS, MULTIPLY_DIV, ZERO_LESS_MULT]
7139QED
7140
7141(* Theorem: 0 < n ==>
7142 !k. k < n ==> leibniz n (k+1) = leibniz n k * leibniz (n-1) k DIV (leibniz n k - leibniz (n-1) k) *)
7143(* Proof:
7144 By leibniz_property,
7145 leibniz n (k+1) * (leibniz n k - leibniz (n-1) k) = leibniz n k * leibniz (n-1) k
7146 Since 0 < leibniz n k and 0 < leibniz (n-1) k by leibniz_pos
7147 so 0 < (leibniz n k - leibniz (n-1) k) by MULT_EQ_0
7148 Hence by MULT_COMM, DIV_SOLVE, 0 < (leibniz n k - leibniz (n-1) k),
7149 leibniz n (k+1) = leibniz n k * leibniz (n-1) k DIV (leibniz n k - leibniz (n-1) k)
7150*)
7151Theorem leibniz_recurrence:
7152 !n. 0 < n ==>
7153 !k. k < n ==> (leibniz n (k+1) = leibniz n k * leibniz (n-1) k DIV (leibniz n k - leibniz (n-1) k))
7154Proof
7155 rpt strip_tac >>
7156 `k <= n /\ k <= (n-1)` by decide_tac >>
7157 `leibniz n (k+1) * (leibniz n k - leibniz (n-1) k) = leibniz n k * leibniz (n-1) k` by rw[leibniz_property] >>
7158 `0 < leibniz n k /\ 0 < leibniz (n-1) k` by rw[leibniz_pos] >>
7159 `0 < (leibniz n k - leibniz (n-1) k)` by metis_tac[MULT_EQ_0, NOT_ZERO_LT_ZERO] >>
7160 rw_tac std_ss[DIV_SOLVE, MULT_COMM]
7161QED
7162
7163(* Theorem: 0 < k /\ k <= n ==>
7164 (leibniz n k = leibniz n (k-1) * leibniz (n-1) (k-1) DIV (leibniz n (k-1) - leibniz (n-1) (k-1))) *)
7165(* Proof:
7166 Since 0 < k, k = SUC h for some h
7167 or k = h + 1 by ADD1
7168 and h = k - 1 by arithmetic
7169 Since 0 < k and k <= n,
7170 0 < n and h < n.
7171 Hence true by leibniz_recurrence.
7172*)
7173Theorem leibniz_n_k:
7174 !n k. 0 < k /\ k <= n ==>
7175 (leibniz n k = leibniz n (k-1) * leibniz (n-1) (k-1) DIV (leibniz n (k-1) - leibniz (n-1) (k-1)))
7176Proof
7177 rpt strip_tac >>
7178 `?h. k = h + 1` by metis_tac[num_CASES, NOT_ZERO_LT_ZERO, ADD1] >>
7179 `(h = k - 1) /\ h < n /\ 0 < n` by decide_tac >>
7180 metis_tac[leibniz_recurrence]
7181QED
7182
7183(* Theorem: 0 < n ==>
7184 !k. lcm (leibniz n k) (leibniz (n-1) k) = lcm (leibniz n k) (leibniz n (k+1)) *)
7185(* Proof:
7186 By leibniz_property,
7187 leibniz n k * leibniz (n - 1) k = leibniz n (k + 1) * (leibniz n k - leibniz (n - 1) k)
7188 Hence true by LCM_EXCHANGE.
7189*)
7190Theorem leibniz_lcm_exchange:
7191 !n. 0 < n ==> !k. lcm (leibniz n k) (leibniz (n-1) k) = lcm (leibniz n k) (leibniz n (k+1))
7192Proof
7193 rw[leibniz_property, LCM_EXCHANGE]
7194QED
7195
7196(* Theorem: 4 ** n <= leibniz (2 * n) n *)
7197(* Proof:
7198 Let m = 2 * n.
7199 Then n = HALF m by HALF_TWICE
7200 Let l1 = GENLIST (K (binomial m n)) (m + 1)
7201 and l2 = GENLIST (binomial m) (m + 1)
7202 Note LENGTH l1 = LENGTH l2 = m + 1 by LENGTH_GENLIST
7203
7204 Claim: !k. k < m + 1 ==> EL k l2 <= EL k l1
7205 Proof: Note EL k l1 = binomial m n by EL_GENLIST
7206 and EL k l2 = binomial m k by EL_GENLIST
7207 Apply binomial m k <= binomial m n by binomial_max
7208 The result follows
7209
7210 leibniz m n
7211 = (m + 1) * binomial m n by leibniz_def
7212 = SUM (GENLIST (K (binomial m n)) (m + 1)) by SUM_GENLIST_K
7213 >= SUM (GENLIST (\k. binomial m k) (m + 1)) by SUM_LE, above
7214 = SUM (GENLIST (binomial m) (SUC m)) by ADD1
7215 = 2 ** m by binomial_sum
7216 = 2 ** (2 * n) by notation
7217 = (2 ** 2) ** n by EXP_EXP_MULT
7218 = 4 ** n by arithmetic
7219*)
7220Theorem leibniz_middle_lower:
7221 !n. 4 ** n <= leibniz (2 * n) n
7222Proof
7223 rpt strip_tac >>
7224 qabbrev_tac `m = 2 * n` >>
7225 `n = HALF m` by rw[HALF_TWICE, Abbr`m`] >>
7226 qabbrev_tac `l1 = GENLIST (K (binomial m n)) (m + 1)` >>
7227 qabbrev_tac `l2 = GENLIST (binomial m) (m + 1)` >>
7228 `!k. k < m + 1 ==> EL k l2 <= EL k l1` by rw[binomial_max, EL_GENLIST, Abbr`l1`, Abbr`l2`] >>
7229 `leibniz m n = (m + 1) * binomial m n` by rw[leibniz_def] >>
7230 `_ = SUM l1` by rw[SUM_GENLIST_K, Abbr`l1`] >>
7231 `SUM l2 = SUM (GENLIST (binomial m) (SUC m))` by rw[ADD1, Abbr`l2`] >>
7232 `_ = 2 ** m` by rw[binomial_sum] >>
7233 `_ = 4 ** n` by rw[EXP_EXP_MULT, Abbr`m`] >>
7234 metis_tac[SUM_LE, LENGTH_GENLIST]
7235QED
7236
7237(* ------------------------------------------------------------------------- *)
7238(* Property of Leibniz Triangle *)
7239(* ------------------------------------------------------------------------- *)
7240
7241(*
7242binomial_recurrence |- !n k. binomial (SUC n) (SUC k) = binomial n k + binomial n (SUC k)
7243This means:
7244 B n k + B n k*
7245 v
7246 B n* k*
7247However, for the Leibniz Triangle, the recurrence is:
7248 L n k
7249 L n* k -> L n* k* = (L n* k)(L n k) / (L n* k - L n k)
7250That is, it takes a different style, and has the property:
7251 1 / L n* k* = 1 / L n k - 1 / L n* k
7252Why?
7253First, some verification.
7254Pascal: [1] 3 3
7255 [4] 6 = 3 + 3 = 6
7256Leibniz: 12 12
7257 [20] 30 = 20 * 12 / (20 - 12) = 20 * 12 / 8 = 30
7258Now, the 20 comes from 4 = 3 + 1.
7259Originally, 30 = 5 * 6 by definition based on multiple
7260 = 5 * (3 + 3) by Pascal
7261 = 4 * (3 + 3) + (3 + 3)
7262 = 12 + 12 + 6
7263In terms of factorials, 30 = 5 * 6 = 5 * B(4,2) = 5 * 4!/2!2!
7264 20 = 5 * 4 = 5 * B(4,1) = 5 * 4!/1!3!
7265 12 = 4 * 3 = 4 * B(3,1) = 4 * 3!/1!2!
7266So 1/30 = (2!2!)/(5 4!) 1 / n** B n* k* = k*! (n* - k* )! / n** n*! = (n - k)! k*! / n**!
7267 1/20 = (1!3!)/(5 4!) 1 / n** B n* k
7268 1/12 = (1!2!)/(4 3!) 1 / n* B n k
7269 1/12 - 1/20
7270 = (1!2!)/(4 3!) - (1!3!)/(5 4!)
7271 = (1!2!)/4! - (1!3!)/5!
7272 = 5(1!2!)/5! - (1!3!)/5!
7273 = (5(1!2!) - (1!3!))/5!
7274 = (5 1! - 3 1!) 2!/5!
7275 = (5 - 3)1! 2!/5!
7276 = 2! 2! / 5!
7277
7278 1 / n B n k - 1 / n** B n* k
7279 = k! (n-k)! / n* n! - k! (n* - k)! / n** n*!
7280 = k! (n-k)! / n*! - k!(n* - k)! / n** n*!
7281 = (n** (n-k)! - (n* - k)!) k! / n** n*!
7282 = (n** - (n* - k)) (n - k)! k! / n** n*!
7283 = (k+1) (n - k)! k! / n** n*!
7284 = (n* - k* )! k*! / n** n*!
7285 = 1 / n** B n* k*
7286
7287Direct without using unit fractions,
7288
7289L n k = n* B n k = n* n! / k! (n-k)! = n*! / k! (n-k)!
7290L n* k = n** B n* k = n** n*! / k! (n* - k)! = n**! / k! (n* - k)!
7291L n* k* = n** B n* k* = n** n*! / k*! (n* - k* )! = n**! / k*! (n-k)!
7292
7293(L n* k) * (L n k) = n**! n*! / k! (n* - k)! k! (n-k)!
7294(L n* k) - (L n k) = n**! / k! (n* - k)! - n*! / k! (n-k)!
7295 = n**! / k! (n-k)!( 1/(n* - k) - 1/ n** )
7296 = n**! / k! (n-k)! (n** - n* + k)/(n* - k)(n** )
7297 = n**! / k! (n-k)! k* / (n* - k) n**
7298 = n*! k* / k! (n* - k)!
7299(L n* k) * (L n k) / (L n* k) - (L n k)
7300= n**! /k! (n-k)! k*
7301= n**! /k*! (n-k)!
7302= L n* k*
7303So: L n k
7304 L n* k --> L n* k*
7305
7306Can the LCM be shown directly?
7307lcm (L n* k, L n k) = lcm (L n* k, L n* k* )
7308To prove this, need to show:
7309both have the same common multiples, and least is the same -- probably yes due to common L n* k.
7310
7311In general, what is the condition for lcm a b = lcm a c ?
7312Well, lcm a b = a b / gcd a b, lcm a c = a c / gcd a c
7313So it must be a b gcd a c = a c gcd a b, or b * gcd a c = c * gcd a b.
7314
7315It this true for Leibniz triangle?
7316Let a = 5, b = 4, c = 20. b * gcd a c = 4 * gcd 5 20 = 4 * 5 = 20
7317 c * gcd a b = 20 * gcd 5 4 = 20
7318Verify lcm a b = lcm 5 4 = 20 = 5 * 4 / gcd 5 4
7319 lcm a c = lcm 5 20 = 20 = 5 * 20 / gcd 5 20
7320 5 * 4 / gcd 5 4 = 5 * 20 / gcd 5 20
7321or 4 * gcd 5 20 = 20 * gcd 5 4
7322
7323(L n k) * gcd (L n* k, L n* k* ) = (L n* k* ) * gcd (L n* k, L n k)
7324
7325or 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)
7326By GCD_COMMON_FACTOR, !m n k. gcd (k * m) (k * n) = k * gcd m n
7327 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)
7328*)
7329
7330(* Special Property of Leibniz Triangle
7331For: L n k
7332 L n+ k --> L n+ k+
7333
7334L n k = n+! / k! (n-k)!
7335L n+ k = n++! / k! (n+ - k)! = n++ n+! / k! (n+ - k) k! = (n++ / n+ - k) L n k
7336L n+ k+ = n++! / k+! (n-k)! = (L n+ k) * (L n k) / (L n+ k - L n k) = (n++ / k+) L n k
7337Let 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)
7338where co n+ k = L n+ k / g, co n k = L n k / g.
7339
7340 L n+ k = (n++ / n+ - k) L n k,
7341and L n+ k+ = (n++ / k+) L n k
7342e.g. L 3 1 = 12
7343 L 4 1 = 20, or (3++ / 3+ - 1) L 3 1 = (5/3) 12 = 20.
7344 L 4 2 = 30, or (3++ / 1+) L 3 1 = (5/2) 12 = 30.
7345so lcm (L 4 1) (L 3 1) = lcm (5/3)*12 12 = 12 * 5 = 60 since 3 must divide 12.
7346 lcm (L 4 1) (L 4 2) = lcm (5/3)*12 (5/2)*12 = 12 * 5 = 60 since 3, 2 must divide 12.
7347
7348By LCM_COMMON_FACTOR |- !m n k. lcm (k * m) (k * n) = k * lcm m n
7349lcm a (a * b DIV c) = a * b
7350
7351So the picture is: (L n k)
7352 (L n k) * (n+2)/(n-k+1) (L n k) * (n+2)/(k+1)
7353
7354A better picture:
7355Pascal: (B n-1 k) = (n-1, k, n-k-1)
7356 (B n k) = (n, k, n-k) (B n k+1) = (n, k+1, n-k-1)
7357Leibniz: (L n-1 k) = (n, k, n-k-1) = (L n k) / (n+1) * (n-k-1)
7358 (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)
7359And we want:
7360 LCM (L, (n-k-1) * L DIV (n+1)) = LCM (L, (k+1) * L DIV (n-k-1)).
7361
7362Theorem: lcm a ((a * b) DIV c) = (a * b) DIV (gcd b c)
7363Assume this theorem,
7364LHS = L * (n-k-1) DIV gcd (n-k-1, n+1)
7365RHS = L * (k+1) DIV gcd (k+1, n-k-1)
7366Still no hope to show LHS = RHS !
7367
7368LCM of fractions:
7369lcm (a/c, b/c) = lcm(a, b)/c
7370lcm (a/c, b/d) = ... = lcm(a, b)/gcd(c, d)
7371Hence lcm (a, a*b/c) = lcm(a*b/b, a*b/c) = a * b / gcd (b, c)
7372*)
7373
7374(* Special Property of Leibniz Triangle -- another go
7375Leibniz: L(5,1) = 30 = b
7376 L(6,1) = 42 = a L(6,2) = 105 = c, c = ab/(a - b), or ab = c(a - b)
7377Why is LCM 42 30 = LCM 42 105 = 210 = 2x3x5x7?
7378First, b = L(5,1) = 30 = (6,1,4) = 6!/1!4! = 7!/1!5! * (5/7) = a * (5/7) = 2x3x5
7379 a = L(6,1) = 42 = (7,1,5) = 7!/1!5! = 2x3x7 = b * (7/5) = c * (2/5)
7380 c = L(6,2) = 105 = (7,2,4) = 7!/2!4! = 7!/1!5! * (5/2) = a * (5/2) = 3x5x7
7381Any common multiple of a, b must have 5, 7 as factor, also with factor 2 (by common k = 1)
7382Any common multiple of a, c must have 5, 2 as factor, also with factor 7 (by common n = 6)
7383Also n = 5 implies a factor 6, k = 2 imples a factor 2.
7384LCM a b = a b / GCD a b
7385 = c (a - b) / GCD a b
7386 = (m c') (m a' - (m-1)b') / GCD (m a') (m-1 b')
7387LCM a c = a c / GCD a c
7388 = (m a') (m c') / GCD (m a') (m c') where c' = a' + b' from Pascal triangle
7389 = m a' (a' + b') / GCD a' (a' + b')
7390 = m a' (a' + b') / GCD a' b'
7391 = a' c / GCD a' b'
7392Can we prove: c(a - b) / GCD a b = c a' / GCD a' b'
7393or (a - b) GCD a' b' = a' GCD a b ?
7394or a GCD a' b' = a' GCD a b + b GCD a' b' ?
7395or ab GCD a' b' = c a' GCD a b?
7396or m (b GCD a' b') = c GCD a b?
7397or b GCD a' b' = c' GCD a b?
7398b = (a DIV 7) * 5
7399c = (a DIV 2) * 5
7400lcm (a, b) = lcm (a, (a DIV 7) * 5) = lcm (a, 5)
7401lcm (a, c) = lcm (a, (a DIV 2) * 5) = lcm (a, 5)
7402Is this a theorem: lcm (a, (a DIV p) * b) = lcm (a, b) if p | a ?
7403Let c = lcm (a, b). Then a | c, b | c.
7404Since a = (a DIV p) * p, (a DIV p) * p | c.
7405Hence ((a DIV p) * b) * p | b * c.
7406How to conclude ((a DIV p) * b) | c?
7407
7408A counter-example:
7409lcm (42, 9) = 126 = 2x3x3x7.
7410lcm (42, (42 DIV 3) * 9) = 126 = 2x3x3x7.
7411lcm (42, (42 DIV 6) * 9) = 126 = 2x3x3x7.
7412lcm (42, (42 DIV 2) * 9) = 378 = 2x3x3x3x7.
7413lcm (42, (42 DIV 7) * 9) = 378 = 2x3x3x3x7.
7414
7415LCM a c
7416= LCM a (ab/(a-b)) let g = GCD(a,b), a = gA, b=gB, coprime A,B.
7417= LCM gA gAB/(A-B)
7418= g LCM A AB/(A-B)
7419= (ab/LCM a b) LCM A AB/(A-B)
7420*)
7421
7422(* ------------------------------------------------------------------------- *)
7423(* LCM of a list of numbers *)
7424(* ------------------------------------------------------------------------- *)
7425
7426(* Define LCM of a list of numbers *)
7427Definition list_lcm_def[simp]:
7428 (list_lcm [] = 1) /\
7429 (list_lcm (h::t) = lcm h (list_lcm t))
7430End
7431
7432
7433(* Theorem: list_lcm [] = 1 *)
7434(* Proof: by list_lcm_def. *)
7435Theorem list_lcm_nil:
7436 list_lcm [] = 1
7437Proof
7438 rw[]
7439QED
7440
7441(* Theorem: list_lcm (h::t) = lcm h (list_lcm t) *)
7442(* Proof: by list_lcm_def. *)
7443Theorem list_lcm_cons:
7444 !h t. list_lcm (h::t) = lcm h (list_lcm t)
7445Proof
7446 rw[]
7447QED
7448
7449(* Theorem: list_lcm [x] = x *)
7450(* Proof:
7451 list_lcm [x]
7452 = lcm x (list_lcm []) by list_lcm_cons
7453 = lcm x 1 by list_lcm_nil
7454 = x by LCM_1
7455*)
7456Theorem list_lcm_sing:
7457 !x. list_lcm [x] = x
7458Proof
7459 rw[]
7460QED
7461
7462(* Theorem: list_lcm (SNOC x l) = list_lcm (x::l) *)
7463(* Proof:
7464 By induction on l.
7465 Base case: list_lcm (SNOC x []) = lcm x (list_lcm [])
7466 list_lcm (SNOC x [])
7467 = list_lcm [x] by SNOC
7468 = lcm x (list_lcm []) by list_lcm_def
7469 Step case: list_lcm (SNOC x l) = lcm x (list_lcm l) ==>
7470 !h. list_lcm (SNOC x (h::l)) = lcm x (list_lcm (h::l))
7471 list_lcm (SNOC x (h::l))
7472 = list_lcm (h::SNOC x l) by SNOC
7473 = lcm h (list_lcm (SNOC x l)) by list_lcm_def
7474 = lcm h (lcm x (list_lcm l)) by induction hypothesis
7475 = lcm x (lcm h (list_lcm l)) by LCM_ASSOC_COMM
7476 = lcm x (list_lcm h::l) by list_lcm_def
7477*)
7478Theorem list_lcm_snoc:
7479 !x l. list_lcm (SNOC x l) = lcm x (list_lcm l)
7480Proof
7481 strip_tac >>
7482 Induct >-
7483 rw[] >>
7484 rw[LCM_ASSOC_COMM]
7485QED
7486
7487(* Theorem: list_lcm (MAP (\k. n * k) l) = if l = [] then 1 else n * list_lcm l *)
7488(* Proof:
7489 By induction on l.
7490 Base case: !n. list_lcm (MAP (\k. n * k) []) = if [] = [] then 1 else n * list_lcm []
7491 list_lcm (MAP (\k. n * k) [])
7492 = list_lcm [] by MAP
7493 = 1 by list_lcm_nil
7494 Step case: !n. list_lcm (MAP (\k. n * k) l) = if l = [] then 1 else n * list_lcm l ==>
7495 !h n. list_lcm (MAP (\k. n * k) (h::l)) = if h::l = [] then 1 else n * list_lcm (h::l)
7496 Note h::l <> [] by NOT_NIL_CONS
7497 If l = [], h::l = [h]
7498 list_lcm (MAP (\k. n * k) [h])
7499 = list_lcm [n * h] by MAP
7500 = n * h by list_lcm_sing
7501 = n * list_lcm [h] by list_lcm_sing
7502 If l <> [],
7503 list_lcm (MAP (\k. n * k) (h::l))
7504 = list_lcm ((n * h) :: MAP (\k. n * k) l) by MAP
7505 = lcm (n * h) (list_lcm (MAP (\k. n * k) l)) by list_lcm_cons
7506 = lcm (n * h) (n * list_lcm l) by induction hypothesis
7507 = n * (lcm h (list_lcm l)) by LCM_COMMON_FACTOR
7508 = n * list_lcm (h::l) by list_lcm_cons
7509*)
7510Theorem list_lcm_map_times:
7511 !n l. list_lcm (MAP (\k. n * k) l) = if l = [] then 1 else n * list_lcm l
7512Proof
7513 Induct_on `l` >-
7514 rw[] >>
7515 rpt strip_tac >>
7516 Cases_on `l = []` >-
7517 rw[] >>
7518 rw_tac std_ss[LCM_COMMON_FACTOR, MAP, list_lcm_cons]
7519QED
7520
7521(* Theorem: EVERY_POSITIVE l ==> 0 < list_lcm l *)
7522(* Proof:
7523 By induction on l.
7524 Base case: EVERY_POSITIVE [] ==> 0 < list_lcm []
7525 Note EVERY_POSITIVE [] = T by EVERY_DEF
7526 Since list_lcm [] = 1 by list_lcm_nil
7527 Hence true since 0 < 1 by SUC_POS, ONE.
7528 Step case: EVERY_POSITIVE l ==> 0 < list_lcm l ==>
7529 !h. EVERY_POSITIVE (h::l) ==> 0 < list_lcm (h::l)
7530 Note EVERY_POSITIVE (h::l)
7531 ==> 0 < h and EVERY_POSITIVE l by EVERY_DEF
7532 Since list_lcm (h::l) = lcm h (list_lcm l) by list_lcm_cons
7533 and 0 < list_lcm l by induction hypothesis
7534 so h <= lcm h (list_lcm l) by LCM_LE, 0 < h.
7535 Hence 0 < list_lcm (h::l) by LESS_LESS_EQ_TRANS
7536*)
7537Theorem list_lcm_pos:
7538 !l. EVERY_POSITIVE l ==> 0 < list_lcm l
7539Proof
7540 Induct >-
7541 rw[] >>
7542 metis_tac[EVERY_DEF, list_lcm_cons, LCM_LE, LESS_LESS_EQ_TRANS]
7543QED
7544
7545(* Theorem: POSITIVE l ==> 0 < list_lcm l *)
7546(* Proof: by list_lcm_pos, EVERY_MEM *)
7547Theorem list_lcm_pos_alt:
7548 !l. POSITIVE l ==> 0 < list_lcm l
7549Proof
7550 rw[list_lcm_pos, EVERY_MEM]
7551QED
7552
7553(* Theorem: EVERY_POSITIVE l ==> SUM l <= (LENGTH l) * list_lcm l *)
7554(* Proof:
7555 By induction on l.
7556 Base case: EVERY_POSITIVE [] ==> SUM [] <= LENGTH [] * list_lcm []
7557 Note EVERY_POSITIVE [] = T by EVERY_DEF
7558 Since SUM [] = 0 by SUM
7559 and LENGTH [] = 0 by LENGTH_NIL
7560 Hence true by MULT, as 0 <= 0 by LESS_EQ_REFL
7561 Step case: EVERY_POSITIVE l ==> SUM l <= LENGTH l * list_lcm l ==>
7562 !h. EVERY_POSITIVE (h::l) ==> SUM (h::l) <= LENGTH (h::l) * list_lcm (h::l)
7563 Note EVERY_POSITIVE (h::l)
7564 ==> 0 < h and EVERY_POSITIVE l by EVERY_DEF
7565 ==> 0 < h and 0 < list_lcm l by list_lcm_pos
7566 If l = [], LENGTH l = 0.
7567 SUM (h::[]) = SUM [h] = h by SUM
7568 LENGTH (h::[]) * list_lcm (h::[])
7569 = 1 * list_lcm [h] by ONE
7570 = 1 * h by list_lcm_sing
7571 = h by MULT_LEFT_1
7572 If l <> [], LENGTH l <> 0 by LENGTH_NIL ... [1]
7573 SUM (h::l)
7574 = h + SUM l by SUM
7575 <= h + LENGTH l * list_lcm l by induction hypothesis
7576 <= lcm h (list_lcm l) + LENGTH l * list_lcm l by LCM_LE, 0 < h
7577 <= lcm h (list_lcm l) + LENGTH l * (lcm h (list_lcm l)) by LCM_LE, 0 < list_lcm l, [1]
7578 = (1 + LENGTH l) * (lcm h (list_lcm l)) by RIGHT_ADD_DISTRIB
7579 = SUC (LENGTH l) * (lcm h (list_lcm l)) by SUC_ONE_ADD
7580 = LENGTH (h::l) * (lcm h (list_lcm l)) by LENGTH
7581 = LENGTH (h::l) * list_lcm (h::l) by list_lcm_cons
7582*)
7583Theorem list_lcm_lower_bound:
7584 !l. EVERY_POSITIVE l ==> SUM l <= (LENGTH l) * list_lcm l
7585Proof
7586 Induct >>
7587 rw[] >>
7588 Cases_on `l = []` >-
7589 rw[] >>
7590 `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] >>
7591 `LENGTH l <> 0` by metis_tac[LENGTH_NIL] >>
7592 `0 < list_lcm l` by rw[list_lcm_pos] >>
7593 `h <= lcm h (list_lcm l) /\ list_lcm l <= lcm h (list_lcm l)` by rw[LCM_LE] >>
7594 `LENGTH l * list_lcm l <= LENGTH l * (lcm h (list_lcm l))` by rw[LE_MULT_LCANCEL] >>
7595 `h + SUM l <= h + LENGTH l * list_lcm l` by rw[] >>
7596 decide_tac
7597QED
7598
7599(* Another version to eliminate EVERY by MEM. *)
7600Theorem list_lcm_lower_bound_alt =
7601 list_lcm_lower_bound |> SIMP_RULE (srw_ss()) [EVERY_MEM];
7602(* > list_lcm_lower_bound_alt;
7603val it = |- !l. POSITIVE l ==> SUM l <= LENGTH l * list_lcm l: thm
7604*)
7605
7606(* Theorem: list_lcm l is a common multiple of its members.
7607 MEM x l ==> x divides (list_lcm l) *)
7608(* Proof:
7609 By induction on l.
7610 Base case: !x. MEM x [] ==> x divides (list_lcm [])
7611 True since MEM x [] = F by MEM
7612 Step case: !x. MEM x l ==> x divides (list_lcm l) ==>
7613 !h x. MEM x (h::l) ==> x divides (list_lcm (h::l))
7614 Note MEM x (h::l) <=> x = h, or MEM x l by MEM
7615 and list_lcm (h::l) = lcm h (list_lcm l) by list_lcm_cons
7616 If x = h,
7617 divides h (lcm h (list_lcm l)) is true by LCM_IS_LEAST_COMMON_MULTIPLE
7618 If MEM x l,
7619 x divides (list_lcm l) by induction hypothesis
7620 (list_lcm l) divides (lcm h (list_lcm l)) by LCM_IS_LEAST_COMMON_MULTIPLE
7621 Hence x divides (lcm h (list_lcm l)) by DIVIDES_TRANS
7622*)
7623Theorem list_lcm_is_common_multiple:
7624 !x l. MEM x l ==> x divides (list_lcm l)
7625Proof
7626 Induct_on `l` >>
7627 rw[] >>
7628 metis_tac[LCM_IS_LEAST_COMMON_MULTIPLE, DIVIDES_TRANS]
7629QED
7630
7631(* Theorem: If m is a common multiple of members of l, (list_lcm l) divides m.
7632 (!x. MEM x l ==> x divides m) ==> (list_lcm l) divides m *)
7633(* Proof:
7634 By induction on l.
7635 Base case: !m. (!x. MEM x [] ==> x divides m) ==> divides (list_lcm []) m
7636 Since list_lcm [] = 1 by list_lcm_nil
7637 and divides 1 m is true by ONE_DIVIDES_ALL
7638 Step case: !m. (!x. MEM x l ==> x divides m) ==> (list_lcm l) divides m ==>
7639 !h m. (!x. MEM x (h::l) ==> x divides m) ==> divides (list_lcm (h::l)) m
7640 Note MEM x (h::l) <=> x = h, or MEM x l by MEM
7641 and list_lcm (h::l) = lcm h (list_lcm l) by list_lcm_cons
7642 Put x = h, divides h m by MEM h (h::l) = T
7643 Put MEM x l, x divides m by MEM x (h::l) = T
7644 giving (list_lcm l) divides m by induction hypothesis
7645 Hence divides (lcm h (list_lcm l)) m by LCM_IS_LEAST_COMMON_MULTIPLE
7646*)
7647Theorem list_lcm_is_least_common_multiple:
7648 !l m. (!x. MEM x l ==> x divides m) ==> (list_lcm l) divides m
7649Proof
7650 Induct >-
7651 rw[] >>
7652 rw[LCM_IS_LEAST_COMMON_MULTIPLE]
7653QED
7654
7655(*
7656> EVAL ``list_lcm []``;
7657val it = |- list_lcm [] = 1: thm
7658> EVAL ``list_lcm [1; 2; 3]``;
7659val it = |- list_lcm [1; 2; 3] = 6: thm
7660> EVAL ``list_lcm [1; 2; 3; 4; 5]``;
7661val it = |- list_lcm [1; 2; 3; 4; 5] = 60: thm
7662> EVAL ``list_lcm (GENLIST SUC 5)``;
7663val it = |- list_lcm (GENLIST SUC 5) = 60: thm
7664> EVAL ``list_lcm (GENLIST SUC 4)``;
7665val it = |- list_lcm (GENLIST SUC 4) = 12: thm
7666> EVAL ``lcm 5 (list_lcm (GENLIST SUC 4))``;
7667val it = |- lcm 5 (list_lcm (GENLIST SUC 4)) = 60: thm
7668> EVAL ``SNOC 5 (GENLIST SUC 4)``;
7669val it = |- SNOC 5 (GENLIST SUC 4) = [1; 2; 3; 4; 5]: thm
7670> EVAL ``list_lcm (SNOC 5 (GENLIST SUC 4))``;
7671val it = |- list_lcm (SNOC 5 (GENLIST SUC 4)) = 60: thm
7672> EVAL ``GENLIST (\k. leibniz 5 k) (SUC 5)``;
7673val it = |- GENLIST (\k. leibniz 5 k) (SUC 5) = [6; 30; 60; 60; 30; 6]: thm
7674> EVAL ``list_lcm (GENLIST (\k. leibniz 5 k) (SUC 5))``;
7675val it = |- list_lcm (GENLIST (\k. leibniz 5 k) (SUC 5)) = 60: thm
7676> EVAL ``list_lcm (GENLIST SUC 5) = list_lcm (GENLIST (\k. leibniz 5 k) (SUC 5))``;
7677val it = |- (list_lcm (GENLIST SUC 5) = list_lcm (GENLIST (\k. leibniz 5 k) (SUC 5))) <=> T: thm
7678> EVAL ``list_lcm (GENLIST SUC 5) = list_lcm (GENLIST (leibniz 5) (SUC 5))``;
7679val it = |- (list_lcm (GENLIST SUC 5) = list_lcm (GENLIST (leibniz 5) (SUC 5))) <=> T: thm
7680*)
7681
7682(* Theorem: list_lcm (l1 ++ l2) = lcm (list_lcm l1) (list_lcm l2) *)
7683(* Proof:
7684 By induction on l1.
7685 Base: !l2. list_lcm ([] ++ l2) = lcm (list_lcm []) (list_lcm l2)
7686 LHS = list_lcm ([] ++ l2)
7687 = list_lcm l2 by APPEND
7688 = lcm 1 (list_lcm l2) by LCM_1
7689 = lcm (list_lcm []) (list_lcm l2) by list_lcm_nil
7690 = RHS
7691 Step: !l2. list_lcm (l1 ++ l2) = lcm (list_lcm l1) (list_lcm l2) ==>
7692 !h l2. list_lcm (h::l1 ++ l2) = lcm (list_lcm (h::l1)) (list_lcm l2)
7693 list_lcm (h::l1 ++ l2)
7694 = list_lcm (h::(l1 ++ l2)) by APPEND
7695 = lcm h (list_lcm (l1 ++ l2)) by list_lcm_cons
7696 = lcm h (lcm (list_lcm l1) (list_lcm l2)) by induction hypothesis
7697 = lcm (lcm h (list_lcm l1)) (list_lcm l2) by LCM_ASSOC
7698 = lcm (list_lcm (h::l1)) (list_lcm l2) by list_lcm_cons
7699*)
7700Theorem list_lcm_append:
7701 !l1 l2. list_lcm (l1 ++ l2) = lcm (list_lcm l1) (list_lcm l2)
7702Proof
7703 Induct >-
7704 rw[] >>
7705 rw[LCM_ASSOC]
7706QED
7707
7708(* Theorem: list_lcm (l1 ++ l2 ++ l3) = list_lcm [(list_lcm l1); (list_lcm l2); (list_lcm l3)] *)
7709(* Proof:
7710 list_lcm (l1 ++ l2 ++ l3)
7711 = lcm (list_lcm (l1 ++ l2)) (list_lcm l3) by list_lcm_append
7712 = lcm (lcm (list_lcm l1) (list_lcm l2)) (list_lcm l3) by list_lcm_append
7713 = lcm (list_lcm l1) (lcm (list_lcm l2) (list_lcm l3)) by LCM_ASSOC
7714 = lcm (list_lcm l1) (list_lcm [(list_lcm l2); list_lcm l3]) by list_lcm_cons
7715 = list_lcm [list_lcm l1; list_lcm l2; list_lcm l3] by list_lcm_cons
7716*)
7717Theorem list_lcm_append_3:
7718 !l1 l2 l3. list_lcm (l1 ++ l2 ++ l3) = list_lcm [(list_lcm l1); (list_lcm l2); (list_lcm l3)]
7719Proof
7720 rw[list_lcm_append, LCM_ASSOC, list_lcm_cons]
7721QED
7722
7723(* Theorem: list_lcm (REVERSE l) = list_lcm l *)
7724(* Proof:
7725 By induction on l.
7726 Base: list_lcm (REVERSE []) = list_lcm []
7727 True since REVERSE [] = [] by REVERSE_DEF
7728 Step: list_lcm (REVERSE l) = list_lcm l ==>
7729 !h. list_lcm (REVERSE (h::l)) = list_lcm (h::l)
7730 list_lcm (REVERSE (h::l))
7731 = list_lcm (REVERSE l ++ [h]) by REVERSE_DEF
7732 = lcm (list_lcm (REVERSE l)) (list_lcm [h]) by list_lcm_append
7733 = lcm (list_lcm l) (list_lcm [h]) by induction hypothesis
7734 = lcm (list_lcm [h]) (list_lcm l) by LCM_COMM
7735 = list_lcm ([h] ++ l) by list_lcm_append
7736 = list_lcm (h::l) by CONS_APPEND
7737*)
7738Theorem list_lcm_reverse:
7739 !l. list_lcm (REVERSE l) = list_lcm l
7740Proof
7741 Induct >-
7742 rw[] >>
7743 rpt strip_tac >>
7744 `list_lcm (REVERSE (h::l)) = list_lcm (REVERSE l ++ [h])` by rw[] >>
7745 `_ = lcm (list_lcm (REVERSE l)) (list_lcm [h])` by rw[list_lcm_append] >>
7746 `_ = lcm (list_lcm l) (list_lcm [h])` by rw[] >>
7747 `_ = lcm (list_lcm [h]) (list_lcm l)` by rw[LCM_COMM] >>
7748 `_ = list_lcm ([h] ++ l)` by rw[list_lcm_append] >>
7749 `_ = list_lcm (h::l)` by rw[] >>
7750 decide_tac
7751QED
7752
7753(* Theorem: list_lcm [1 .. (n + 1)] = lcm (n + 1) (list_lcm [1 .. n])) *)
7754(* Proof:
7755 list_lcm [1 .. (n + 1)]
7756 = list_lcm (SONC (n + 1) [1 .. n]) by listRangeINC_SNOC, 1 <= n + 1
7757 = lcm (n + 1) (list_lcm [1 .. n]) by list_lcm_snoc
7758*)
7759Theorem list_lcm_suc:
7760 !n. list_lcm [1 .. (n + 1)] = lcm (n + 1) (list_lcm [1 .. n])
7761Proof
7762 rw[listRangeINC_SNOC, list_lcm_snoc]
7763QED
7764
7765(* Theorem: l <> [] /\ EVERY_POSITIVE l ==> (SUM l) DIV (LENGTH l) <= list_lcm l *)
7766(* Proof:
7767 Note LENGTH l <> 0 by LENGTH_NIL
7768 and SUM l <= LENGTH l * list_lcm l by list_lcm_lower_bound
7769 so (SUM l) DIV (LENGTH l) <= list_lcm l by DIV_LE
7770*)
7771Theorem list_lcm_nonempty_lower:
7772 !l. l <> [] /\ EVERY_POSITIVE l ==> (SUM l) DIV (LENGTH l) <= list_lcm l
7773Proof
7774 metis_tac[list_lcm_lower_bound, DIV_LE, LENGTH_NIL, NOT_ZERO_LT_ZERO]
7775QED
7776
7777(* Theorem: l <> [] /\ POSITIVE l ==> (SUM l) DIV (LENGTH l) <= list_lcm l *)
7778(* Proof:
7779 Note LENGTH l <> 0 by LENGTH_NIL
7780 and SUM l <= LENGTH l * list_lcm l by list_lcm_lower_bound_alt
7781 so (SUM l) DIV (LENGTH l) <= list_lcm l by DIV_LE
7782*)
7783Theorem list_lcm_nonempty_lower_alt:
7784 !l. l <> [] /\ POSITIVE l ==> (SUM l) DIV (LENGTH l) <= list_lcm l
7785Proof
7786 metis_tac[list_lcm_lower_bound_alt, DIV_LE, LENGTH_NIL, NOT_ZERO_LT_ZERO]
7787QED
7788
7789(* Theorem: MEM x l /\ MEM y l ==> (lcm x y) <= list_lcm l *)
7790(* Proof:
7791 Note x divides (list_lcm l) by list_lcm_is_common_multiple
7792 and y divides (list_lcm l) by list_lcm_is_common_multiple
7793 ==> (lcm x y) divides (list_lcm l) by LCM_IS_LEAST_COMMON_MULTIPLE
7794*)
7795Theorem list_lcm_divisor_lcm_pair:
7796 !l x y. MEM x l /\ MEM y l ==> (lcm x y) divides list_lcm l
7797Proof
7798 rw[list_lcm_is_common_multiple, LCM_IS_LEAST_COMMON_MULTIPLE]
7799QED
7800
7801(* Theorem: POSITIVE l /\ MEM x l /\ MEM y l ==> (lcm x y) <= list_lcm l *)
7802(* Proof:
7803 Note (lcm x y) divides (list_lcm l) by list_lcm_divisor_lcm_pair
7804 Now 0 < list_lcm l by list_lcm_pos_alt
7805 Thus (lcm x y) <= list_lcm l by DIVIDES_LE
7806*)
7807Theorem list_lcm_lower_by_lcm_pair:
7808 !l x y. POSITIVE l /\ MEM x l /\ MEM y l ==> (lcm x y) <= list_lcm l
7809Proof
7810 rw[list_lcm_divisor_lcm_pair, list_lcm_pos_alt, DIVIDES_LE]
7811QED
7812
7813(* Theorem: 0 < m /\ (!x. MEM x l ==> x divides m) ==> list_lcm l <= m *)
7814(* Proof:
7815 Note list_lcm l divides m by list_lcm_is_least_common_multiple
7816 Thus list_lcm l <= m by DIVIDES_LE, 0 < m
7817*)
7818Theorem list_lcm_upper_by_common_multiple:
7819 !l m. 0 < m /\ (!x. MEM x l ==> x divides m) ==> list_lcm l <= m
7820Proof
7821 rw[list_lcm_is_least_common_multiple, DIVIDES_LE]
7822QED
7823
7824(* Theorem: list_lcm ls = FOLDR lcm 1 ls *)
7825(* Proof:
7826 By induction on ls.
7827 Base: list_lcm [] = FOLDR lcm 1 []
7828 list_lcm []
7829 = 1 by list_lcm_nil
7830 = FOLDR lcm 1 [] by FOLDR
7831 Step: list_lcm ls = FOLDR lcm 1 ls ==>
7832 !h. list_lcm (h::ls) = FOLDR lcm 1 (h::ls)
7833 list_lcm (h::ls)
7834 = lcm h (list_lcm ls) by list_lcm_def
7835 = lcm h (FOLDR lcm 1 ls) by induction hypothesis
7836 = FOLDR lcm 1 (h::ls) by FOLDR
7837*)
7838Theorem list_lcm_by_FOLDR:
7839 !ls. list_lcm ls = FOLDR lcm 1 ls
7840Proof
7841 Induct >> rw[]
7842QED
7843
7844(* Theorem: list_lcm ls = FOLDL lcm 1 ls *)
7845(* Proof:
7846 Note COMM lcm since !x y. lcm x y = lcm y x by LCM_COMM
7847 and ASSOC lcm since !x y z. lcm x (lcm y z) = lcm (lcm x y) z by LCM_ASSOC
7848 Now list_lcm ls
7849 = FOLDR lcm 1 ls by list_lcm_by FOLDR
7850 = FOLDL lcm 1 ls by FOLDL_EQ_FOLDR, COMM lcm, ASSOC lcm
7851*)
7852Theorem list_lcm_by_FOLDL:
7853 !ls. list_lcm ls = FOLDL lcm 1 ls
7854Proof
7855 simp[list_lcm_by_FOLDR] >>
7856 irule (GSYM FOLDL_EQ_FOLDR) >>
7857 rpt strip_tac >-
7858 rw[LCM_ASSOC, combinTheory.ASSOC_DEF] >>
7859 rw[LCM_COMM, combinTheory.COMM_DEF]
7860QED
7861
7862(* ------------------------------------------------------------------------- *)
7863(* Lists in Leibniz Triangle *)
7864(* ------------------------------------------------------------------------- *)
7865
7866(* ------------------------------------------------------------------------- *)
7867(* Vertical Lists in Leibniz Triangle *)
7868(* ------------------------------------------------------------------------- *)
7869
7870(* Define Vertical List in Leibniz Triangle *)
7871(*
7872val leibniz_vertical_def = Define `
7873 leibniz_vertical n = GENLIST SUC (SUC n)
7874`;
7875
7876(* Use overloading for leibniz_vertical n. *)
7877val _ = overload_on("leibniz_vertical", ``\n. GENLIST ((+) 1) (n + 1)``);
7878*)
7879
7880(* Define Vertical (downward list) in Leibniz Triangle *)
7881
7882(* Use overloading for leibniz_vertical n. *)
7883Overload leibniz_vertical = ``\n. [1 .. (n+1)]``
7884
7885(* Theorem: leibniz_vertical n = GENLIST (\i. 1 + i) (n + 1) *)
7886(* Proof:
7887 leibniz_vertical n
7888 = [1 .. (n+1)] by notation
7889 = GENLIST (\i. 1 + i) (n+1 + 1 - 1) by listRangeINC_def
7890 = GENLIST (\i. 1 + i) (n + 1) by arithmetic
7891*)
7892Theorem leibniz_vertical_alt:
7893 !n. leibniz_vertical n = GENLIST (\i. 1 + i) (n + 1)
7894Proof
7895 rw[listRangeINC_def]
7896QED
7897
7898(* Theorem: leibniz_vertical 0 = [1] *)
7899(* Proof:
7900 leibniz_vertical 0
7901 = [1 .. (0+1)] by notation
7902 = [1 .. 1] by arithmetic
7903 = [1] by listRangeINC_SING
7904*)
7905Theorem leibniz_vertical_0:
7906 leibniz_vertical 0 = [1]
7907Proof
7908 rw[]
7909QED
7910
7911(* Theorem: LENGTH (leibniz_vertical n) = n + 1 *)
7912(* Proof:
7913 LENGTH (leibniz_vertical n)
7914 = LENGTH [1 .. (n+1)] by notation
7915 = n + 1 + 1 - 1 by listRangeINC_LEN
7916 = n + 1 by arithmetic
7917*)
7918Theorem leibniz_vertical_len:
7919 !n. LENGTH (leibniz_vertical n) = n + 1
7920Proof
7921 rw[listRangeINC_LEN]
7922QED
7923
7924(* Theorem: leibniz_vertical n <> [] *)
7925(* Proof:
7926 LENGTH (leibniz_vertical n)
7927 = n + 1 by leibniz_vertical_len
7928 <> 0 by ADD1, SUC_NOT_ZERO
7929 Thus leibniz_vertical n <> [] by LENGTH_EQ_0
7930*)
7931Theorem leibniz_vertical_not_nil:
7932 !n. leibniz_vertical n <> []
7933Proof
7934 metis_tac[leibniz_vertical_len, LENGTH_EQ_0, DECIDE``!n. n + 1 <> 0``]
7935QED
7936
7937(* Theorem: EVERY_POSITIVE (leibniz_vertical n) *)
7938(* Proof:
7939 EVERY_POSITIVE (leibniz_vertical n)
7940 <=> EVERY_POSITIVE GENLIST (\i. 1 + i) (n+1) by leibniz_vertical_alt
7941 <=> !i. i < n + 1 ==> 0 < 1 + i by EVERY_GENLIST
7942 <=> !i. i < n + 1 ==> T by arithmetic
7943 <=> T
7944*)
7945Theorem leibniz_vertical_pos:
7946 !n. EVERY_POSITIVE (leibniz_vertical n)
7947Proof
7948 rw[leibniz_vertical_alt, EVERY_GENLIST]
7949QED
7950
7951(* Theorem: POSITIVE (leibniz_vertical n) *)
7952(* Proof: by leibniz_vertical_pos, EVERY_MEM *)
7953Theorem leibniz_vertical_pos_alt:
7954 !n. POSITIVE (leibniz_vertical n)
7955Proof
7956 rw[leibniz_vertical_pos, EVERY_MEM]
7957QED
7958
7959(* Theorem: 0 < x /\ x <= (n + 1) <=> MEM x (leibniz_vertical n) *)
7960(* Proof:
7961 Note: (leibniz_vertical n) has 1 to (n+1), inclusive:
7962 MEM x (leibniz_vertical n)
7963 <=> MEM x [1 .. (n+1)] by notation
7964 <=> 1 <= x /\ x <= n + 1 by listRangeINC_MEM
7965 <=> 0 < x /\ x <= n + 1 by num_CASES, LESS_EQ_MONO
7966*)
7967Theorem leibniz_vertical_mem:
7968 !n x. 0 < x /\ x <= (n + 1) <=> MEM x (leibniz_vertical n)
7969Proof
7970 rw[]
7971QED
7972
7973(* Theorem: leibniz_vertical (n + 1) = SNOC (n + 2) (leibniz_vertical n) *)
7974(* Proof:
7975 leibniz_vertical (n + 1)
7976 = [1 .. (n+1 +1)] by notation
7977 = SNOC (n+1 + 1) [1 .. (n+1)] by listRangeINC_SNOC
7978 = SNOC (n + 2) (leibniz_vertical n) by notation
7979*)
7980Theorem leibniz_vertical_snoc:
7981 !n. leibniz_vertical (n + 1) = SNOC (n + 2) (leibniz_vertical n)
7982Proof
7983 rw[listRangeINC_SNOC]
7984QED
7985
7986(* Use overloading for leibniz_up n. *)
7987Overload leibniz_up = ``\n. REVERSE (leibniz_vertical n)``
7988
7989(* Theorem: leibniz_up 0 = [1] *)
7990(* Proof:
7991 leibniz_up 0
7992 = REVERSE (leibniz_vertical 0) by notation
7993 = REVERSE [1] by leibniz_vertical_0
7994 = [1] by REVERSE_SING
7995*)
7996Theorem leibniz_up_0:
7997 leibniz_up 0 = [1]
7998Proof
7999 rw[]
8000QED
8001
8002(* Theorem: LENGTH (leibniz_up n) = n + 1 *)
8003(* Proof:
8004 LENGTH (leibniz_up n)
8005 = LENGTH (REVERSE (leibniz_vertical n)) by notation
8006 = LENGTH (leibniz_vertical n) by LENGTH_REVERSE
8007 = n + 1 by leibniz_vertical_len
8008*)
8009Theorem leibniz_up_len:
8010 !n. LENGTH (leibniz_up n) = n + 1
8011Proof
8012 rw[leibniz_vertical_len]
8013QED
8014
8015(* Theorem: EVERY_POSITIVE (leibniz_up n) *)
8016(* Proof:
8017 EVERY_POSITIVE (leibniz_up n)
8018 <=> EVERY_POSITIVE (REVERSE (leibniz_vertical n)) by notation
8019 <=> EVERY_POSITIVE (leibniz_vertical n) by EVERY_REVERSE
8020 <=> T by leibniz_vertical_pos
8021*)
8022Theorem leibniz_up_pos:
8023 !n. EVERY_POSITIVE (leibniz_up n)
8024Proof
8025 rw[leibniz_vertical_pos, EVERY_REVERSE]
8026QED
8027
8028(* Theorem: 0 < x /\ x <= (n + 1) <=> MEM x (leibniz_up n) *)
8029(* Proof:
8030 Note: (leibniz_up n) has (n+1) downto 1, inclusive:
8031 MEM x (leibniz_up n)
8032 <=> MEM x (REVERSE (leibniz_vertical n)) by notation
8033 <=> MEM x (leibniz_vertical n) by MEM_REVERSE
8034 <=> T by leibniz_vertical_mem
8035*)
8036Theorem leibniz_up_mem:
8037 !n x. 0 < x /\ x <= (n + 1) <=> MEM x (leibniz_up n)
8038Proof
8039 rw[]
8040QED
8041
8042(* Theorem: leibniz_up (n + 1) = (n + 2) :: (leibniz_up n) *)
8043(* Proof:
8044 leibniz_up (n + 1)
8045 = REVERSE (leibniz_vertical (n + 1)) by notation
8046 = REVERSE (SNOC (n + 2) (leibniz_vertical n)) by leibniz_vertical_snoc
8047 = (n + 2) :: (leibniz_up n) by REVERSE_SNOC
8048*)
8049Theorem leibniz_up_cons:
8050 !n. leibniz_up (n + 1) = (n + 2) :: (leibniz_up n)
8051Proof
8052 rw[leibniz_vertical_snoc, REVERSE_SNOC]
8053QED
8054
8055(* ------------------------------------------------------------------------- *)
8056(* Horizontal List in Leibniz Triangle *)
8057(* ------------------------------------------------------------------------- *)
8058
8059(* Define row (horizontal list) in Leibniz Triangle *)
8060(*
8061val leibniz_horizontal_def = Define `
8062 leibniz_horizontal n = GENLIST (leibniz n) (SUC n)
8063`;
8064
8065(* Use overloading for leibniz_horizontal n. *)
8066val _ = overload_on("leibniz_horizontal", ``\n. GENLIST (leibniz n) (n + 1)``);
8067*)
8068
8069(* Use overloading for leibniz_horizontal n. *)
8070Overload leibniz_horizontal = ``\n. GENLIST (leibniz n) (n + 1)``
8071
8072(*
8073> EVAL ``leibniz_horizontal 0``;
8074val it = |- leibniz_horizontal 0 = [1]: thm
8075> EVAL ``leibniz_horizontal 1``;
8076val it = |- leibniz_horizontal 1 = [2; 2]: thm
8077> EVAL ``leibniz_horizontal 2``;
8078val it = |- leibniz_horizontal 2 = [3; 6; 3]: thm
8079> EVAL ``leibniz_horizontal 3``;
8080val it = |- leibniz_horizontal 3 = [4; 12; 12; 4]: thm
8081> EVAL ``leibniz_horizontal 4``;
8082val it = |- leibniz_horizontal 4 = [5; 20; 30; 20; 5]: thm
8083> EVAL ``leibniz_horizontal 5``;
8084val it = |- leibniz_horizontal 5 = [6; 30; 60; 60; 30; 6]: thm
8085> EVAL ``leibniz_horizontal 6``;
8086val it = |- leibniz_horizontal 6 = [7; 42; 105; 140; 105; 42; 7]: thm
8087> EVAL ``leibniz_horizontal 7``;
8088val it = |- leibniz_horizontal 7 = [8; 56; 168; 280; 280; 168; 56; 8]: thm
8089> EVAL ``leibniz_horizontal 8``;
8090val it = |- leibniz_horizontal 8 = [9; 72; 252; 504; 630; 504; 252; 72; 9]: thm
8091*)
8092
8093(* Theorem: leibniz_horizontal 0 = [1] *)
8094(* Proof:
8095 leibniz_horizontal 0
8096 = GENLIST (leibniz 0) (0 + 1) by notation
8097 = GENLIST (leibniz 0) 1 by arithmetic
8098 = [leibniz 0 0] by GENLIST
8099 = [1] by leibniz_n_0
8100*)
8101Theorem leibniz_horizontal_0:
8102 leibniz_horizontal 0 = [1]
8103Proof
8104 rw_tac std_ss[GENLIST_1, leibniz_n_0]
8105QED
8106
8107(* Theorem: LENGTH (leibniz_horizontal n) = n + 1 *)
8108(* Proof:
8109 LENGTH (leibniz_horizontal n)
8110 = LENGTH (GENLIST (leibniz n) (n + 1)) by notation
8111 = n + 1 by LENGTH_GENLIST
8112*)
8113Theorem leibniz_horizontal_len:
8114 !n. LENGTH (leibniz_horizontal n) = n + 1
8115Proof
8116 rw[]
8117QED
8118
8119(* Theorem: k <= n ==> EL k (leibniz_horizontal n) = leibniz n k *)
8120(* Proof:
8121 Note k <= n means k < SUC n.
8122 EL k (leibniz_horizontal n)
8123 = EL k (GENLIST (leibniz n) (n + 1)) by notation
8124 = EL k (GENLIST (leibniz n) (SUC n)) by ADD1
8125 = leibniz n k by EL_GENLIST, k < SUC n.
8126*)
8127Theorem leibniz_horizontal_el:
8128 !n k. k <= n ==> (EL k (leibniz_horizontal n) = leibniz n k)
8129Proof
8130 rw[LESS_EQ_IMP_LESS_SUC]
8131QED
8132
8133(* Theorem: k <= n ==> MEM (leibniz n k) (leibniz_horizontal n) *)
8134(* Proof:
8135 Note k <= n ==> k < (n + 1)
8136 Thus MEM (leibniz n k) (GENLIST (leibniz n) (n + 1)) by MEM_GENLIST
8137 or MEM (leibniz n k) (leibniz_horizontal n) by notation
8138*)
8139Theorem leibniz_horizontal_mem:
8140 !n k. k <= n ==> MEM (leibniz n k) (leibniz_horizontal n)
8141Proof
8142 metis_tac[MEM_GENLIST, DECIDE``k <= n ==> k < n + 1``]
8143QED
8144
8145(* Theorem: MEM (leibniz n k) (leibniz_horizontal n) <=> k <= n *)
8146(* Proof:
8147 If part: (leibniz n k) (leibniz_horizontal n) ==> k <= n
8148 By contradiction, suppose n < k.
8149 Then leibniz n k = 0 by binomial_less_0, ~(k <= n)
8150 But ?m. m < n + 1 ==> 0 = leibniz n m by MEM_GENLIST
8151 or m <= n ==> leibniz n m = 0 by m < n + 1
8152 Yet leibniz n m <> 0 by leibniz_eq_0
8153 This is a contradiction.
8154 Only-if part: k <= n ==> (leibniz n k) (leibniz_horizontal n)
8155 By MEM_GENLIST, this is to show:
8156 ?m. m < n + 1 /\ (leibniz n k = leibniz n m)
8157 Note k <= n ==> k < n + 1,
8158 Take m = k, the result follows.
8159*)
8160Theorem leibniz_horizontal_mem_iff:
8161 !n k. MEM (leibniz n k) (leibniz_horizontal n) <=> k <= n
8162Proof
8163 rw_tac bool_ss[EQ_IMP_THM] >| [
8164 spose_not_then strip_assume_tac >>
8165 `leibniz n k = 0` by rw[leibniz_less_0] >>
8166 fs[MEM_GENLIST] >>
8167 `m <= n` by decide_tac >>
8168 fs[binomial_eq_0],
8169 rw[MEM_GENLIST] >>
8170 `k < n + 1` by decide_tac >>
8171 metis_tac[]
8172 ]
8173QED
8174
8175(* Theorem: MEM x (leibniz_horizontal n) <=> ?k. k <= n /\ (x = leibniz n k) *)
8176(* Proof:
8177 By MEM_GENLIST, this is to show:
8178 (?m. m < n + 1 /\ (x = (n + 1) * binomial n m)) <=> ?k. k <= n /\ (x = (n + 1) * binomial n k)
8179 Since m < n + 1 <=> m <= n by LE_LT1
8180 This is trivially true.
8181*)
8182Theorem leibniz_horizontal_member:
8183 !n x. MEM x (leibniz_horizontal n) <=> ?k. k <= n /\ (x = leibniz n k)
8184Proof
8185 metis_tac[MEM_GENLIST, LE_LT1]
8186QED
8187
8188(* Theorem: k <= n ==> (EL k (leibniz_horizontal n) = leibniz n k) *)
8189(* Proof: by EL_GENLIST *)
8190Theorem leibniz_horizontal_element:
8191 !n k. k <= n ==> (EL k (leibniz_horizontal n) = leibniz n k)
8192Proof
8193 rw[EL_GENLIST]
8194QED
8195
8196(* Theorem: TAKE 1 (leibniz_horizontal (n + 1)) = [n + 2] *)
8197(* Proof:
8198 TAKE 1 (leibniz_horizontal (n + 1))
8199 = TAKE 1 (GENLIST (leibniz (n + 1)) (n + 1 + 1)) by notation
8200 = TAKE 1 (GENLIST (leibniz (SUC n)) (SUC (SUC n))) by ADD1
8201 = TAKE 1 ((leibniz (SUC n) 0) :: GENLIST ((leibniz (SUC n)) o SUC) n) by GENLIST_CONS
8202 = (leibniz (SUC n) 0):: TAKE 0 (GENLIST ((leibniz (SUC n)) o SUC) n) by TAKE_def
8203 = [leibniz (SUC n) 0]:: [] by TAKE_0
8204 = [SUC n + 1] by leibniz_n_0
8205 = [n + 2] by ADD1
8206*)
8207Theorem leibniz_horizontal_head:
8208 !n. TAKE 1 (leibniz_horizontal (n + 1)) = [n + 2]
8209Proof
8210 rpt strip_tac >>
8211 `(!n. n + 1 = SUC n) /\ (!n. n + 2 = SUC (SUC n))` by decide_tac >>
8212 rw[GENLIST_CONS, leibniz_n_0]
8213QED
8214
8215(* Theorem: k <= n ==> (leibniz n k) divides list_lcm (leibniz_horizontal n) *)
8216(* Proof:
8217 Note MEM (leibniz n k) (leibniz_horizontal n) by leibniz_horizontal_mem
8218 so (leibniz n k) divides list_lcm (leibniz_horizontal n) by list_lcm_is_common_multiple
8219*)
8220Theorem leibniz_horizontal_divisor:
8221 !n k. k <= n ==> (leibniz n k) divides list_lcm (leibniz_horizontal n)
8222Proof
8223 rw[leibniz_horizontal_mem, list_lcm_is_common_multiple]
8224QED
8225
8226(* Theorem: EVERY_POSITIVE (leibniz_horizontal n) *)
8227(* Proof:
8228 Let l = leibniz_horizontal n
8229 Then LENGTH l = n + 1 by leibniz_horizontal_len
8230 EVERY_POSITIVE l
8231 <=> !k. k < LENGTH l ==> 0 < (EL k l) by EVERY_EL
8232 <=> !k. k < n + 1 ==> 0 < (EL k l) by above
8233 <=> !k. k <= n ==> 0 < EL k l by arithmetic
8234 <=> !k. k <= n ==> 0 < leibniz n k by leibniz_horizontal_el
8235 <=> T by leibniz_pos
8236*)
8237Theorem leibniz_horizontal_pos:
8238 !n. EVERY_POSITIVE (leibniz_horizontal n)
8239Proof
8240 simp[EVERY_EL, binomial_pos]
8241QED
8242
8243(* Theorem: POSITIVE (leibniz_horizontal n) *)
8244(* Proof: by leibniz_horizontal_pos, EVERY_MEM *)
8245Theorem leibniz_horizontal_pos_alt:
8246 !n. POSITIVE (leibniz_horizontal n)
8247Proof
8248 metis_tac[leibniz_horizontal_pos, EVERY_MEM]
8249QED
8250
8251(* Theorem: leibniz_horizontal n = MAP (\j. (n+1) * j) (binomial_horizontal n) *)
8252(* Proof:
8253 leibniz_horizontal n
8254 = GENLIST (leibniz n) (n + 1) by notation
8255 = GENLIST ((\j. (n + 1) * j) o (binomial n)) (n + 1) by leibniz_alt
8256 = MAP (\j. (n + 1) * j) (GENLIST (binomial n) (n + 1)) by MAP_GENLIST
8257 = MAP (\j. (n + 1) * j) (binomial_horizontal n) by notation
8258*)
8259Theorem leibniz_horizontal_alt:
8260 !n. leibniz_horizontal n = MAP (\j. (n+1) * j) (binomial_horizontal n)
8261Proof
8262 rw_tac std_ss[leibniz_alt, MAP_GENLIST]
8263QED
8264
8265(* Theorem: list_lcm (leibniz_horizontal n) = (n + 1) * list_lcm (binomial_horizontal n) *)
8266(* Proof:
8267 Since LENGTH (binomial_horizontal n) = n + 1 by binomial_horizontal_len
8268 binomial_horizontal n <> [] by LENGTH_NIL ... [1]
8269 list_lcm (leibniz_horizontal n)
8270 = list_lcm (MAP (\j (n+1) * j) (binomial_horizontal n)) by leibniz_horizontal_alt
8271 = (n + 1) * list_lcm (binomial_horizontal n) by list_lcm_map_times, [1]
8272*)
8273Theorem leibniz_horizontal_lcm_alt:
8274 !n. list_lcm (leibniz_horizontal n) = (n + 1) * list_lcm (binomial_horizontal n)
8275Proof
8276 rpt strip_tac >>
8277 `LENGTH (binomial_horizontal n) = n + 1` by rw[binomial_horizontal_len] >>
8278 `n + 1 <> 0` by decide_tac >>
8279 `binomial_horizontal n <> []` by metis_tac[LENGTH_NIL] >>
8280 rw_tac std_ss[leibniz_horizontal_alt, list_lcm_map_times]
8281QED
8282
8283(* Theorem: SUM (leibniz_horizontal n) = (n + 1) * SUM (binomial_horizontal n) *)
8284(* Proof:
8285 SUM (leibniz_horizontal n)
8286 = SUM (MAP (\j. (n + 1) * j) (binomial_horizontal n)) by leibniz_horizontal_alt
8287 = (n + 1) * SUM (binomial_horizontal n) by SUM_MULT
8288*)
8289Theorem leibniz_horizontal_sum:
8290 !n. SUM (leibniz_horizontal n) = (n + 1) * SUM (binomial_horizontal n)
8291Proof
8292 rw[leibniz_horizontal_alt, SUM_MULT] >>
8293 `(\j. j * (n + 1)) = $* (n + 1)` by rw[FUN_EQ_THM] >>
8294 rw[]
8295QED
8296
8297(* Theorem: SUM (leibniz_horizontal n) = (n + 1) * 2 ** n *)
8298(* Proof:
8299 SUM (leibniz_horizontal n)
8300 = (n + 1) * SUM (binomial_horizontal n) by leibniz_horizontal_sum
8301 = (n + 1) * 2 ** n by binomial_horizontal_sum
8302*)
8303Theorem leibniz_horizontal_sum_eqn:
8304 !n. SUM (leibniz_horizontal n) = (n + 1) * 2 ** n
8305Proof
8306 rw[leibniz_horizontal_sum, binomial_horizontal_sum]
8307QED
8308
8309(* Theorem: SUM (leibniz_horizontal n) DIV LENGTH (leibniz_horizontal n) = SUM (binomial_horizontal n) *)
8310(* Proof:
8311 Note LENGTH (leibniz_horizontal n) = n + 1 by leibniz_horizontal_len
8312 so 0 < LENGTH (leibniz_horizontal n) by 0 < n + 1
8313
8314 SUM (leibniz_horizontal n) DIV LENGTH (leibniz_horizontal n)
8315 = ((n + 1) * SUM (binomial_horizontal n)) DIV (n + 1) by leibniz_horizontal_sum
8316 = SUM (binomial_horizontal n) by MULT_TO_DIV, 0 < n + 1
8317*)
8318Theorem leibniz_horizontal_average:
8319 !n. SUM (leibniz_horizontal n) DIV LENGTH (leibniz_horizontal n) = SUM (binomial_horizontal n)
8320Proof
8321 metis_tac[leibniz_horizontal_sum, leibniz_horizontal_len, MULT_TO_DIV, DECIDE``0 < n + 1``]
8322QED
8323
8324(* Theorem: SUM (leibniz_horizontal n) DIV LENGTH (leibniz_horizontal n) = 2 ** n *)
8325(* Proof:
8326 SUM (leibniz_horizontal n) DIV LENGTH (leibniz_horizontal n)
8327 = SUM (binomial_horizontal n) by leibniz_horizontal_average
8328 = 2 ** n by binomial_horizontal_sum
8329*)
8330Theorem leibniz_horizontal_average_eqn:
8331 !n. SUM (leibniz_horizontal n) DIV LENGTH (leibniz_horizontal n) = 2 ** n
8332Proof
8333 rw[leibniz_horizontal_average, binomial_horizontal_sum]
8334QED
8335
8336(* ------------------------------------------------------------------------- *)
8337(* Transform from Vertical LCM to Horizontal LCM. *)
8338(* ------------------------------------------------------------------------- *)
8339
8340(* ------------------------------------------------------------------------- *)
8341(* Using Triplet and Paths *)
8342(* ------------------------------------------------------------------------- *)
8343
8344(* Define a triple type *)
8345Datatype:
8346 triple = <| a: num;
8347 b: num;
8348 c: num
8349 |>
8350End
8351
8352(* A triplet is a triple composed of Leibniz node and children. *)
8353Definition triplet_def:
8354 (triplet n k):triple =
8355 <| a := leibniz n k;
8356 b := leibniz (n + 1) k;
8357 c := leibniz (n + 1) (k + 1)
8358 |>
8359End
8360
8361(* can even do this after definition of triple type:
8362
8363val triple_def = Define`
8364 triple n k =
8365 <| a := leibniz n k;
8366 b := leibniz (n + 1) k;
8367 c := leibniz (n + 1) (k + 1)
8368 |>
8369`;
8370*)
8371
8372(* Overload elements of a triplet *)
8373(*
8374val _ = overload_on("tri_a", ``leibniz n k``);
8375val _ = overload_on("tri_b", ``leibniz (SUC n) k``);
8376val _ = overload_on("tri_c", ``leibniz (SUC n) (SUC k)``);
8377
8378val _ = overload_on("tri_a", ``(triple n k).a``);
8379val _ = overload_on("tri_b", ``(triple n k).b``);
8380val _ = overload_on("tri_c", ``(triple n k).c``);
8381*)
8382Overload ta[local] = ``(triplet n k).a``
8383Overload tb[local] = ``(triplet n k).b``
8384Overload tc[local] = ``(triplet n k).c``
8385
8386(* Theorem: (ta = leibniz n k) /\ (tb = leibniz (n + 1) k) /\ (tc = leibniz (n + 1) (k + 1)) *)
8387(* Proof: by triplet_def *)
8388Theorem leibniz_triplet_member:
8389 !n k. (ta = leibniz n k) /\ (tb = leibniz (n + 1) k) /\ (tc = leibniz (n + 1) (k + 1))
8390Proof
8391 rw[triplet_def]
8392QED
8393
8394(* Theorem: (k + 1) * tc = (n + 1 - k) * tb *)
8395(* Proof:
8396 Apply: > leibniz_right_eqn |> SPEC ``n+1``;
8397 val it = |- 0 < n + 1 ==> !k. (k + 1) * leibniz (n + 1) (k + 1) = (n + 1 - k) * leibniz (n + 1) k: thm
8398*)
8399Theorem leibniz_right_entry:
8400 !(n k):num. (k + 1) * tc = (n + 1 - k) * tb
8401Proof
8402 rw_tac arith_ss[triplet_def, leibniz_right_eqn]
8403QED
8404
8405(* Theorem: (n + 2) * ta = (n + 1 - k) * tb *)
8406(* Proof:
8407 Apply: > leibniz_up_eqn |> SPEC ``n+1``;
8408 val it = |- 0 < n + 1 ==> !k. (n + 1 + 1) * leibniz (n + 1 - 1) k = (n + 1 - k) * leibniz (n + 1) k: thm
8409*)
8410Theorem leibniz_up_entry:
8411 !(n k):num. (n + 2) * ta = (n + 1 - k) * tb
8412Proof
8413 rw_tac std_ss[triplet_def, leibniz_up_eqn |> SPEC ``n+1`` |> SIMP_RULE arith_ss[]]
8414QED
8415
8416(* Theorem: ta * tb = tc * (tb - ta) *)
8417(* Proof:
8418 Apply > leibniz_property |> SPEC ``n+1``;
8419 val it = |- 0 < n + 1 ==> !k. !k. leibniz (n + 1) k * leibniz (n + 1 - 1) k =
8420 leibniz (n + 1) (k + 1) * (leibniz (n + 1) k - leibniz (n + 1 - 1) k): thm
8421*)
8422Theorem leibniz_triplet_property:
8423 !(n k):num. ta * tb = tc * (tb - ta)
8424Proof
8425 rw_tac std_ss[triplet_def, MULT_COMM, leibniz_property |> SPEC ``n+1`` |> SIMP_RULE arith_ss[]]
8426QED
8427
8428(* Direct proof of same result, for the paper. *)
8429
8430(* Theorem: ta * tb = tc * (tb - ta) *)
8431(* Proof:
8432 If n < k,
8433 Note n < k ==> ta = 0 by triplet_def, leibniz_less_0
8434 also n + 1 < k + 1 ==> tc = 0 by triplet_def, leibniz_less_0
8435 Thus ta * tb = 0 = tc * (tb - ta) by MULT_EQ_0
8436 If ~(n < k),
8437 Then (n + 2) - (n + 1 - k) = k + 1 by arithmetic, k <= n.
8438
8439 (k + 1) * ta * tb
8440 = (n + 2 - (n + 1 - k)) * ta * tb
8441 = (n + 2) * ta * tb - (n + 1 - k) * ta * tb by RIGHT_SUB_DISTRIB
8442 = (n + 1 - k) * tb * tb - (n + 1 - k) * ta * tb by leibniz_up_entry
8443 = (n + 1 - k) * tb * tb - (n + 1 - k) * tb * ta by MULT_ASSOC, MULT_COMM
8444 = (n + 1 - k) * tb * (tb - ta) by LEFT_SUB_DISTRIB
8445 = (k + 1) * tc * (tb - ta) by leibniz_right_entry
8446
8447 Since k + 1 <> 0, the result follows by MULT_LEFT_CANCEL
8448*)
8449Theorem leibniz_triplet_property[allow_rebind]:
8450 !n k:num. ta * tb = tc * (tb - ta)
8451Proof
8452 rpt strip_tac >>
8453 Cases_on ‘n < k’ >-
8454 rw[triplet_def, leibniz_less_0] >>
8455 ‘(n + 2) - (n + 1 - k) = k + 1’ by decide_tac >>
8456 ‘(k + 1) * ta * tb = (n + 2 - (n + 1 - k)) * ta * tb’ by rw[] >>
8457 ‘_ = (n + 2) * ta * tb - (n + 1 - k) * ta * tb’ by rw_tac std_ss[RIGHT_SUB_DISTRIB] >>
8458 ‘_ = (n + 1 - k) * tb * tb - (n + 1 - k) * ta * tb’ by rw_tac std_ss[leibniz_up_entry] >>
8459 ‘_ = (n + 1 - k) * tb * tb - (n + 1 - k) * tb * ta’ by metis_tac[MULT_ASSOC, MULT_COMM] >>
8460 ‘_ = (n + 1 - k) * tb * (tb - ta)’ by rw_tac std_ss[LEFT_SUB_DISTRIB] >>
8461 ‘_ = (k + 1) * tc * (tb - ta)’ by rw_tac std_ss[leibniz_right_entry] >>
8462 ‘k + 1 <> 0’ by decide_tac >>
8463 metis_tac[MULT_LEFT_CANCEL, MULT_ASSOC]
8464QED
8465
8466(* Theorem: lcm tb ta = lcm tb tc *)
8467(* Proof:
8468 Apply: > leibniz_lcm_exchange |> SPEC ``n+1``;
8469 val it = |- 0 < n + 1 ==>
8470 !k. lcm (leibniz (n + 1) k) (leibniz (n + 1 - 1) k) =
8471 lcm (leibniz (n + 1) k) (leibniz (n + 1) (k + 1)): thm
8472*)
8473Theorem leibniz_triplet_lcm:
8474 !(n k):num. lcm tb ta = lcm tb tc
8475Proof
8476 rw_tac std_ss[triplet_def, leibniz_lcm_exchange |> SPEC ``n+1`` |> SIMP_RULE arith_ss[]]
8477QED
8478
8479(* ------------------------------------------------------------------------- *)
8480(* Zigzag Path in Leibniz Triangle *)
8481(* ------------------------------------------------------------------------- *)
8482
8483(* Define a path type *)
8484Type path[local] = “:num list”
8485
8486(* Define paths reachable by one zigzag *)
8487Definition leibniz_zigzag_def:
8488 leibniz_zigzag (p1: path) (p2: path) <=>
8489 ?(n k):num (x y):path. (p1 = x ++ [tb; ta] ++ y) /\ (p2 = x ++ [tb; tc] ++ y)
8490End
8491Overload zigzag = ``leibniz_zigzag``
8492val _ = set_fixity "zigzag" (Infix(NONASSOC, 450)); (* same as relation *)
8493
8494(* Theorem: p1 zigzag p2 ==> (list_lcm p1 = list_lcm p2) *)
8495(* Proof:
8496 Given p1 zigzag p2,
8497 ==> ?n k x y. (p1 = x ++ [tb; ta] ++ y) /\ (p2 = x ++ [tb; tc] ++ y) by leibniz_zigzag_def
8498
8499 list_lcm p1
8500 = list_lcm (x ++ [tb; ta] ++ y) by above
8501 = lcm (list_lcm (x ++ [tb; ta])) (list_lcm y) by list_lcm_append
8502 = lcm (list_lcm (x ++ ([tb; ta]))) (list_lcm y) by APPEND_ASSOC
8503 = lcm (lcm (list_lcm x) (list_lcm ([tb; ta]))) (list_lcm y) by list_lcm_append
8504 = lcm (lcm (list_lcm x) (lcm tb ta)) (list_lcm y) by list_lcm_append, list_lcm_sing
8505 = lcm (lcm (list_lcm x) (lcm tb tc)) (list_lcm y) by leibniz_triplet_lcm
8506 = lcm (lcm (list_lcm x) (list_lcm ([tb; tc]))) (list_lcm y) by list_lcm_append, list_lcm_sing
8507 = lcm (list_lcm (x ++ ([tb; tc]))) (list_lcm y) by list_lcm_append
8508 = lcm (list_lcm (x ++ [tb; tc])) (list_lcm y) by APPEND_ASSOC
8509 = list_lcm (x ++ [tb; tc] ++ y) by list_lcm_append
8510 = list_lcm p2 by above
8511*)
8512Theorem list_lcm_zigzag:
8513 !p1 p2. p1 zigzag p2 ==> (list_lcm p1 = list_lcm p2)
8514Proof
8515 rw_tac std_ss[leibniz_zigzag_def] >>
8516 `list_lcm (x ++ [tb; ta] ++ y) = lcm (list_lcm (x ++ [tb; ta])) (list_lcm y)` by rw[list_lcm_append] >>
8517 `_ = lcm (list_lcm (x ++ ([tb; ta]))) (list_lcm y)` by rw[] >>
8518 `_ = lcm (lcm (list_lcm x) (lcm tb ta)) (list_lcm y)` by rw[list_lcm_append] >>
8519 `_ = lcm (lcm (list_lcm x) (lcm tb tc)) (list_lcm y)` by rw[leibniz_triplet_lcm] >>
8520 `_ = lcm (list_lcm (x ++ ([tb; tc]))) (list_lcm y)` by rw[list_lcm_append] >>
8521 `_ = lcm (list_lcm (x ++ [tb; tc])) (list_lcm y)` by rw[] >>
8522 `_ = list_lcm (x ++ [tb; tc] ++ y)` by rw[list_lcm_append] >>
8523 rw[]
8524QED
8525
8526(* Theorem: p1 zigzag p2 ==> !x. ([x] ++ p1) zigzag ([x] ++ p2) *)
8527(* Proof:
8528 Since p1 zigzag p2
8529 ==> ?n k x y. (p1 = x ++ [tb; ta] ++ y) /\ (p2 = x ++ [tb; tc] ++ y) by leibniz_zigzag_def
8530
8531 [x] ++ p1
8532 = [x] ++ (x ++ [tb; ta] ++ y) by above
8533 = [x] ++ x ++ [tb; ta] ++ y by APPEND
8534 [x] ++ p2
8535 = [x] ++ (x ++ [tb; tc] ++ y) by above
8536 = [x] ++ x ++ [tb; tc] ++ y by APPEND
8537 Take new x = [x] ++ x, new y = y.
8538 Then ([x] ++ p1) zigzag ([x] ++ p2) by leibniz_zigzag_def
8539*)
8540Theorem leibniz_zigzag_tail:
8541 !p1 p2. p1 zigzag p2 ==> !x. ([x] ++ p1) zigzag ([x] ++ p2)
8542Proof
8543 metis_tac[leibniz_zigzag_def, APPEND]
8544QED
8545
8546(* Theorem: k <= n ==>
8547 TAKE (k + 1) (leibniz_horizontal (n + 1)) ++ DROP k (leibniz_horizontal n) zigzag
8548 TAKE (k + 2) (leibniz_horizontal (n + 1)) ++ DROP (k + 1) (leibniz_horizontal n) *)
8549(* Proof:
8550 Since k <= n, k < n + 1, and k + 1 < n + 2.
8551 Hence k < LENGTH (leibniz_horizontal (n + 1)),
8552
8553 Let x = TAKE k (leibniz_horizontal (n + 1))
8554 and y = DROP (k + 1) (leibniz_horizontal n)
8555 TAKE (k + 1) (leibniz_horizontal (n + 1))
8556 = TAKE (SUC k) (leibniz_horizontal (SUC n)) by ADD1
8557 = SNOC tb x by TAKE_SUC_BY_TAKE, k < LENGTH (leibniz_horizontal (n + 1))
8558 = x ++ [tb] by SNOC_APPEND
8559 TAKE (k + 2) (leibniz_horizontal (n + 1))
8560 = TAKE (SUC (SUC k)) (leibniz_horizontal (SUC n)) by ADD1
8561 = SNOC tc (SNOC tb x) by TAKE_SUC_BY_TAKE, k + 1 < LENGTH (leibniz_horizontal (n + 1))
8562 = x ++ [tb; tc] by SNOC_APPEND
8563 DROP k (leibniz_horizontal n)
8564 = ta :: y by DROP_BY_DROP_SUC, k < LENGTH (leibniz_horizontal n)
8565 = [ta] ++ y by CONS_APPEND
8566 Hence
8567 Let p1 = TAKE (k + 1) (leibniz_horizontal (n + 1)) ++ DROP k (leibniz_horizontal n)
8568 = x ++ [tb] ++ [ta] ++ y
8569 = x ++ [tb; ta] ++ y by APPEND
8570 Let p2 = TAKE (k + 2) (leibniz_horizontal (n + 1)) ++ DROP (k + 1) (leibniz_horizontal n)
8571 = x ++ [tb; tc] ++ y
8572 Therefore p1 zigzag p2 by leibniz_zigzag_def
8573*)
8574Theorem leibniz_horizontal_zigzag :
8575 !n k. k <= n ==>
8576 TAKE (k + 1) (leibniz_horizontal (n + 1)) ++
8577 DROP k (leibniz_horizontal n)
8578 zigzag
8579 TAKE (k + 2) (leibniz_horizontal (n + 1)) ++
8580 DROP (k + 1) (leibniz_horizontal n)
8581Proof
8582 rpt strip_tac >>
8583 qabbrev_tac `x = TAKE k (leibniz_horizontal (n + 1))` >>
8584 qabbrev_tac `y = DROP (k + 1) (leibniz_horizontal n)` >>
8585 `k <= n + 1` by decide_tac >>
8586 `EL k (leibniz_horizontal n) = ta`
8587 by rw_tac std_ss[triplet_def, leibniz_horizontal_el] >>
8588 `EL k (leibniz_horizontal (n + 1)) = tb`
8589 by rw_tac std_ss[triplet_def, leibniz_horizontal_el] >>
8590 `EL (k + 1) (leibniz_horizontal (n + 1)) = tc`
8591 by rw_tac std_ss[triplet_def, leibniz_horizontal_el] >>
8592 `k < n + 1` by decide_tac >>
8593 `k < LENGTH (leibniz_horizontal (n + 1))` by rw[leibniz_horizontal_len] >>
8594 `TAKE (k + 1) (leibniz_horizontal (n + 1)) =
8595 TAKE (SUC k) (leibniz_horizontal (n + 1))` by rw[ADD1] >>
8596 `_ = SNOC tb x` by rw[TAKE_SUC_BY_TAKE, Abbr`x`] >>
8597 `_ = x ++ [tb]` by rw[SNOC_APPEND] >>
8598 `SUC k < n + 2` by decide_tac >>
8599 `SUC k < LENGTH (leibniz_horizontal (n + 1))` by rw[leibniz_horizontal_len] >>
8600 `TAKE (k + 2) (leibniz_horizontal (n + 1)) =
8601 TAKE (SUC (SUC k)) (leibniz_horizontal (n + 1))` by rw[ADD1] >>
8602 `_ = SNOC tc (SNOC tb x)` by rw_tac std_ss[TAKE_SUC_BY_TAKE, ADD1, Abbr`x`] >>
8603 `_ = x ++ [tb; tc]` by rw[SNOC_APPEND] >>
8604 `DROP k (leibniz_horizontal n) = [ta] ++ y`
8605 by rw[DROP_BY_DROP_SUC, ADD1, Abbr`y`] >>
8606 qabbrev_tac `p1 = TAKE (k + 1) (leibniz_horizontal (n + 1)) ++
8607 DROP k (leibniz_horizontal n)` >>
8608 qabbrev_tac `p2 = TAKE (k + 2) (leibniz_horizontal (n + 1)) ++ y` >>
8609 `p1 = x ++ [tb; ta] ++ y` by rw[Abbr`p1`, Abbr`x`, Abbr`y`] >>
8610 `p2 = x ++ [tb; tc] ++ y` by rw[Abbr`p2`, Abbr`x`] >>
8611 metis_tac[leibniz_zigzag_def]
8612QED
8613
8614(* Theorem: (leibniz_up 1) zigzag (leibniz_horizontal 1) *)
8615(* Proof:
8616 Since leibniz_up 1
8617 = [2; 1] by EVAL_TAC
8618 = [] ++ [2; 1] ++ [] by EVAL_TAC
8619 and leibniz_horizontal 1
8620 = [2; 2] by EVAL_TAC
8621 = [] ++ [2; 2] ++ [] by EVAL_TAC
8622 Now the first Leibniz triplet is:
8623 (triplet 0 0).a = 1 by EVAL_TAC
8624 (triplet 0 0).b = 2 by EVAL_TAC
8625 (triplet 0 0).c = 2 by EVAL_TAC
8626 Hence (leibniz_up 1) zigzag (leibniz_horizontal 1) by leibniz_zigzag_def
8627*)
8628Theorem leibniz_triplet_0:
8629 (leibniz_up 1) zigzag (leibniz_horizontal 1)
8630Proof
8631 `leibniz_up 1 = [] ++ [2; 1] ++ []` by EVAL_TAC >>
8632 `leibniz_horizontal 1 = [] ++ [2; 2] ++ []` by EVAL_TAC >>
8633 `((triplet 0 0).a = 1) /\ ((triplet 0 0).b = 2) /\ ((triplet 0 0).c = 2)` by EVAL_TAC >>
8634 metis_tac[leibniz_zigzag_def]
8635QED
8636
8637(* ------------------------------------------------------------------------- *)
8638(* Wriggle Paths in Leibniz Triangle *)
8639(* ------------------------------------------------------------------------- *)
8640
8641(* Define paths reachable by many zigzags *)
8642(*
8643val leibniz_wriggle_def = Define`
8644 leibniz_wriggle (p1: path) (p2: path) <=>
8645 ?(m:num) (f:num -> path).
8646 (p1 = f 0) /\
8647 (p2 = f m) /\
8648 (!k. k < m ==> (f k) zigzag (f (SUC k)))
8649`;
8650*)
8651
8652(* Define paths reachable by many zigzags by closure *)
8653Overload wriggle = ``RTC leibniz_zigzag``(* RTC = reflexive transitive closure *)
8654val _ = set_fixity "wriggle" (Infix(NONASSOC, 450)); (* same as relation *)
8655
8656(* Theorem: p1 wriggle p2 ==> (list_lcm p1 = list_lcm p2) *)
8657(* Proof:
8658 By RTC_STRONG_INDUCT.
8659 Base: list_lcm p1 = list_lcm p1, trivially true.
8660 Step: p1 zigzag p1' /\ p1' wriggle p2 /\ list_lcm p1' = list_lcm p2 ==> list_lcm p1 = list_lcm p2
8661 list_lcm p1
8662 = list_lcm p1' by list_lcm_zigzag
8663 = list_lcm p2 by induction hypothesis
8664*)
8665Theorem list_lcm_wriggle:
8666 !p1 p2. p1 wriggle p2 ==> (list_lcm p1 = list_lcm p2)
8667Proof
8668 ho_match_mp_tac RTC_STRONG_INDUCT >>
8669 rpt strip_tac >-
8670 rw[] >>
8671 metis_tac[list_lcm_zigzag]
8672QED
8673
8674(* Theorem: p1 zigzag p2 ==> p1 wriggle p2 *)
8675(* Proof:
8676 p1 wriggle p2
8677 = p1 (RTC zigzag) p2 by notation
8678 = p1 zigzag p2 by RTC_SINGLE
8679*)
8680Theorem leibniz_zigzag_wriggle:
8681 !p1 p2. p1 zigzag p2 ==> p1 wriggle p2
8682Proof
8683 rw[]
8684QED
8685
8686(* Theorem: p1 wriggle p2 ==> !x. ([x] ++ p1) wriggle ([x] ++ p2) *)
8687(* Proof:
8688 By RTC_STRONG_INDUCT.
8689 Base: [x] ++ p1 wriggle [x] ++ p1
8690 True by RTC_REFL.
8691 Step: p1 zigzag p1' /\ p1' wriggle p2 /\ !x. [x] ++ p1' wriggle [x] ++ p2 ==>
8692 [x] ++ p1 wriggle [x] ++ p2
8693 Since p1 zigzag p1',
8694 so [x] ++ p1 zigzag [x] ++ p1' by leibniz_zigzag_tail
8695 or [x] ++ p1 wriggle [x] ++ p1' by leibniz_zigzag_wriggle
8696 With [x] ++ p1' wriggle [x] ++ p2 by induction hypothesis
8697 Hence [x] ++ p1 wriggle [x] ++ p2 by RTC_TRANS
8698*)
8699Theorem leibniz_wriggle_tail:
8700 !p1 p2. p1 wriggle p2 ==> !x. ([x] ++ p1) wriggle ([x] ++ p2)
8701Proof
8702 ho_match_mp_tac RTC_STRONG_INDUCT >>
8703 rpt strip_tac >-
8704 rw[] >>
8705 metis_tac[leibniz_zigzag_tail, leibniz_zigzag_wriggle, RTC_TRANS]
8706QED
8707
8708(* Theorem: p1 wriggle p1 *)
8709(* Proof: by RTC_REFL *)
8710Theorem leibniz_wriggle_refl:
8711 !p1. p1 wriggle p1
8712Proof
8713 metis_tac[RTC_REFL]
8714QED
8715
8716(* Theorem: p1 wriggle p2 /\ p2 wriggle p3 ==> p1 wriggle p3 *)
8717(* Proof: by RTC_TRANS *)
8718Theorem leibniz_wriggle_trans:
8719 !p1 p2 p3. p1 wriggle p2 /\ p2 wriggle p3 ==> p1 wriggle p3
8720Proof
8721 metis_tac[RTC_TRANS]
8722QED
8723
8724(* Theorem: k <= n + 1 ==>
8725 TAKE (k + 1) (leibniz_horizontal (n + 1)) ++ DROP k (leibniz_horizontal n) wriggle
8726 leibniz_horizontal (n + 1) *)
8727(* Proof:
8728 By induction on the difference: n + 1 - k.
8729 Base: k = n + 1 ==> TAKE (k + 1) (leibniz_horizontal (n + 1)) ++ DROP k (leibniz_horizontal n) wriggle
8730 leibniz_horizontal (n + 1)
8731 TAKE (k + 1) (leibniz_horizontal (n + 1)) ++ DROP k (leibniz_horizontal n)
8732 = TAKE (n + 2) (leibniz_horizontal (n + 1)) ++ DROP (n + 1) (leibniz_horizontal n) by k = n + 1
8733 = leibniz_horizontal (n + 1) ++ [] by TAKE_LENGTH_ID, DROP_LENGTH_NIL
8734 = leibniz_horizontal (n + 1) by APPEND_NIL
8735 Hence they wriggle to each other by RTC_REFL
8736 Step: k <= n + 1 ==> TAKE (k + 1) (leibniz_horizontal (n + 1)) ++ DROP k (leibniz_horizontal n) wriggle
8737 leibniz_horizontal (n + 1)
8738 Let p1 = leibniz_horizontal (n + 1)
8739 p2 = TAKE (k + 1) p1 ++ DROP k (leibniz_horizontal n)
8740 p3 = TAKE (k + 2) (leibniz_horizontal (n + 1)) ++ DROP (k + 1) (leibniz_horizontal n)
8741 Then p2 zigzag p3 by leibniz_horizontal_zigzag
8742 and p3 wriggle p1 by induction hypothesis
8743 Hence p2 wriggle p1 by RTC_RULES
8744*)
8745Theorem leibniz_horizontal_wriggle_step:
8746 !n k. k <= n + 1 ==> TAKE (k + 1) (leibniz_horizontal (n + 1)) ++ DROP k (leibniz_horizontal n) wriggle
8747 leibniz_horizontal (n + 1)
8748Proof
8749 Induct_on `n + 1 - k` >| [
8750 rpt strip_tac >>
8751 rw_tac arith_ss[] >>
8752 `n + 1 = k` by decide_tac >>
8753 rw[TAKE_LENGTH_ID_rwt, DROP_LENGTH_NIL_rwt],
8754 rpt strip_tac >>
8755 `v = n - k` by decide_tac >>
8756 `v = (n + 1) - (k + 1)` by decide_tac >>
8757 `k <= n` by decide_tac >>
8758 `k + 1 <= n + 1` by decide_tac >>
8759 `k + 1 + 1 = k + 2` by decide_tac >>
8760 qabbrev_tac `p1 = leibniz_horizontal (n + 1)` >>
8761 qabbrev_tac `p2 = TAKE (k + 1) p1 ++ DROP k (leibniz_horizontal n)` >>
8762 qabbrev_tac `p3 = TAKE (k + 2) (leibniz_horizontal (n + 1)) ++ DROP (k + 1) (leibniz_horizontal n)` >>
8763 `p2 zigzag p3` by rw[leibniz_horizontal_zigzag, Abbr`p1`, Abbr`p2`, Abbr`p3`] >>
8764 metis_tac[RTC_RULES]
8765 ]
8766QED
8767
8768(* Theorem: ([leibniz (n + 1) 0] ++ leibniz_horizontal n) wriggle leibniz_horizontal (n + 1) *)
8769(* Proof:
8770 Apply > leibniz_horizontal_wriggle_step |> SPEC ``n:num`` |> SPEC ``0`` |> SIMP_RULE std_ss[DROP_0];
8771 val it = |- TAKE 1 (leibniz_horizontal (n + 1)) ++ leibniz_horizontal n wriggle leibniz_horizontal (n + 1): thm
8772*)
8773Theorem leibniz_horizontal_wriggle:
8774 !n. ([leibniz (n + 1) 0] ++ leibniz_horizontal n) wriggle leibniz_horizontal (n + 1)
8775Proof
8776 rpt strip_tac >>
8777 `TAKE 1 (leibniz_horizontal (n + 1)) = [leibniz (n + 1) 0]` by rw[leibniz_horizontal_head, binomial_n_0] >>
8778 metis_tac[leibniz_horizontal_wriggle_step |> SPEC ``n:num`` |> SPEC ``0`` |> SIMP_RULE std_ss[DROP_0]]
8779QED
8780
8781(* ------------------------------------------------------------------------- *)
8782(* Path Transform keeping LCM *)
8783(* ------------------------------------------------------------------------- *)
8784
8785(* Theorem: (leibniz_up n) wriggle (leibniz_horizontal n) *)
8786(* Proof:
8787 By induction on n.
8788 Base: leibniz_up 0 wriggle leibniz_horizontal 0
8789 Since leibniz_up 0 = [1] by leibniz_up_0
8790 and leibniz_horizontal 0 = [1] by leibniz_horizontal_0
8791 Hence leibniz_up 0 wriggle leibniz_horizontal 0 by leibniz_wriggle_refl
8792 Step: leibniz_up n wriggle leibniz_horizontal n ==>
8793 leibniz_up (SUC n) wriggle leibniz_horizontal (SUC n)
8794 Let x = leibniz (n + 1) 0.
8795 Then x = n + 2 by leibniz_n_0
8796 Now leibniz_up (n + 1) = [x] ++ (leibniz_up n) by leibniz_up_cons
8797 Since leibniz_up n wriggle leibniz_horizontal n by induction hypothesis
8798 so ([x] ++ (leibniz_up n)) wriggle
8799 ([x] ++ (leibniz_horizontal n)) by leibniz_wriggle_tail
8800 and ([x] ++ (leibniz_horizontal n)) wriggle
8801 (leibniz_horizontal (n + 1)) by leibniz_horizontal_wriggle
8802 Hence leibniz_up (SUC n) wriggle
8803 leibniz_horizontal (SUC n) by leibniz_wriggle_trans, ADD1
8804*)
8805Theorem leibniz_up_wriggle_horizontal:
8806 !n. (leibniz_up n) wriggle (leibniz_horizontal n)
8807Proof
8808 Induct >-
8809 rw[leibniz_up_0, leibniz_horizontal_0] >>
8810 qabbrev_tac `x = leibniz (n + 1) 0` >>
8811 `x = n + 2` by rw[leibniz_n_0, Abbr`x`] >>
8812 `leibniz_up (n + 1) = [x] ++ (leibniz_up n)` by rw[leibniz_up_cons, Abbr`x`] >>
8813 `([x] ++ (leibniz_up n)) wriggle ([x] ++ (leibniz_horizontal n))` by rw[leibniz_wriggle_tail] >>
8814 `([x] ++ (leibniz_horizontal n)) wriggle (leibniz_horizontal (n + 1))` by rw[leibniz_horizontal_wriggle, Abbr`x`] >>
8815 metis_tac[leibniz_wriggle_trans, ADD1]
8816QED
8817
8818(* Theorem: list_lcm (leibniz_vertical n) = list_lcm (leibniz_horizontal n) *)
8819(* Proof:
8820 Since leibniz_up n = REVERSE (leibniz_vertical n) by notation
8821 and leibniz_up n wriggle leibniz_horizontal n by leibniz_up_wriggle_horizontal
8822 list_lcm (leibniz_vertical n)
8823 = list_lcm (leibniz_up n) by list_lcm_reverse
8824 = list_lcm (leibniz_horizontal n) by list_lcm_wriggle
8825*)
8826Theorem leibniz_lcm_property:
8827 !n. list_lcm (leibniz_vertical n) = list_lcm (leibniz_horizontal n)
8828Proof
8829 metis_tac[leibniz_up_wriggle_horizontal, list_lcm_wriggle, list_lcm_reverse]
8830QED
8831
8832(* This is a milestone theorem. *)
8833
8834(* Theorem: k <= n ==> (leibniz n k) divides list_lcm (leibniz_vertical n) *)
8835(* Proof:
8836 Note (leibniz n k) divides list_lcm (leibniz_horizontal n) by leibniz_horizontal_divisor
8837 ==> (leibniz n k) divides list_lcm (leibniz_vertical n) by leibniz_lcm_property
8838*)
8839Theorem leibniz_vertical_divisor:
8840 !n k. k <= n ==> (leibniz n k) divides list_lcm (leibniz_vertical n)
8841Proof
8842 metis_tac[leibniz_horizontal_divisor, leibniz_lcm_property]
8843QED
8844
8845(* ------------------------------------------------------------------------- *)
8846(* Lower Bound of Leibniz LCM *)
8847(* ------------------------------------------------------------------------- *)
8848
8849(* Theorem: 2 ** n <= list_lcm (leibniz_horizontal n) *)
8850(* Proof:
8851 Note LENGTH (binomail_horizontal n) = n + 1 by binomial_horizontal_len
8852 and EVERY_POSITIVE (binomial_horizontal n) by binomial_horizontal_pos .. [1]
8853 list_lcm (leibniz_horizontal n)
8854 = (n + 1) * list_lcm (binomial_horizontal n) by leibniz_horizontal_lcm_alt
8855 >= SUM (binomial_horizontal n) by list_lcm_lower_bound, [1]
8856 = 2 ** n by binomial_horizontal_sum
8857*)
8858Theorem leibniz_horizontal_lcm_lower:
8859 !n. 2 ** n <= list_lcm (leibniz_horizontal n)
8860Proof
8861 rpt strip_tac >>
8862 `LENGTH (binomial_horizontal n) = n + 1` by rw[binomial_horizontal_len] >>
8863 `EVERY_POSITIVE (binomial_horizontal n)` by rw[binomial_horizontal_pos] >>
8864 `list_lcm (leibniz_horizontal n) = (n + 1) * list_lcm (binomial_horizontal n)` by rw[leibniz_horizontal_lcm_alt] >>
8865 `SUM (binomial_horizontal n) = 2 ** n` by rw[binomial_horizontal_sum] >>
8866 metis_tac[list_lcm_lower_bound]
8867QED
8868
8869(* Theorem: 2 ** n <= list_lcm (leibniz_vertical n) *)
8870(* Proof:
8871 list_lcm (leibniz_vertical n)
8872 = list_lcm (leibniz_horizontal n) by leibniz_lcm_property
8873 >= 2 ** n by leibniz_horizontal_lcm_lower
8874*)
8875Theorem leibniz_vertical_lcm_lower:
8876 !n. 2 ** n <= list_lcm (leibniz_vertical n)
8877Proof
8878 rw_tac std_ss[leibniz_horizontal_lcm_lower, leibniz_lcm_property]
8879QED
8880
8881(* Theorem: 2 ** n <= list_lcm [1 .. (n + 1)] *)
8882(* Proof: by leibniz_vertical_lcm_lower. *)
8883Theorem lcm_lower_bound:
8884 !n. 2 ** n <= list_lcm [1 .. (n + 1)]
8885Proof
8886 rw[leibniz_vertical_lcm_lower]
8887QED
8888
8889(* ------------------------------------------------------------------------- *)
8890(* Leibniz LCM Invariance *)
8891(* ------------------------------------------------------------------------- *)
8892
8893(* Use overloading for leibniz_col_arm rooted at leibniz a b, of length n. *)
8894Overload leibniz_col_arm = ``\a b n. MAP (\x. leibniz (a - x) b) [0 ..< n]``
8895
8896(* Use overloading for leibniz_seg_arm rooted at leibniz a b, of length n. *)
8897Overload leibniz_seg_arm = ``\a b n. MAP (\x. leibniz a (b + x)) [0 ..< n]``
8898
8899(*
8900> EVAL ``leibniz_col_arm 5 1 4``;
8901val it = |- leibniz_col_arm 5 1 4 = [30; 20; 12; 6]: thm
8902> EVAL ``leibniz_seg_arm 5 1 4``;
8903val it = |- leibniz_seg_arm 5 1 4 = [30; 60; 60; 30]: thm
8904> EVAL ``list_lcm (leibniz_col_arm 5 1 4)``;
8905val it = |- list_lcm (leibniz_col_arm 5 1 4) = 60: thm
8906> EVAL ``list_lcm (leibniz_seg_arm 5 1 4)``;
8907val it = |- list_lcm (leibniz_seg_arm 5 1 4) = 60: thm
8908*)
8909
8910(* Theorem: leibniz_col_arm a b 0 = [] *)
8911(* Proof:
8912 leibniz_col_arm a b 0
8913 = MAP (\x. leibniz (a - x) b) [0 ..< 0] by notation
8914 = MAP (\x. leibniz (a - x) b) [] by listRangeLHI_def
8915 = [] by MAP
8916*)
8917Theorem leibniz_col_arm_0:
8918 !a b. leibniz_col_arm a b 0 = []
8919Proof
8920 rw[]
8921QED
8922
8923(* Theorem: leibniz_seg_arm a b 0 = [] *)
8924(* Proof:
8925 leibniz_seg_arm a b 0
8926 = MAP (\x. leibniz a (b + x)) [0 ..< 0] by notation
8927 = MAP (\x. leibniz a (b + x)) [] by listRangeLHI_def
8928 = [] by MAP
8929*)
8930Theorem leibniz_seg_arm_0:
8931 !a b. leibniz_seg_arm a b 0 = []
8932Proof
8933 rw[]
8934QED
8935
8936(* Theorem: leibniz_col_arm a b 1 = [leibniz a b] *)
8937(* Proof:
8938 leibniz_col_arm a b 1
8939 = MAP (\x. leibniz (a - x) b) [0 ..< 1] by notation
8940 = MAP (\x. leibniz (a - x) b) [0] by listRangeLHI_def
8941 = (\x. leibniz (a - x) b) 0 ::[] by MAP
8942 = [leibniz a b] by function application
8943*)
8944Theorem leibniz_col_arm_1:
8945 !a b. leibniz_col_arm a b 1 = [leibniz a b]
8946Proof
8947 rw[listRangeLHI_def]
8948QED
8949
8950(* Theorem: leibniz_seg_arm a b 1 = [leibniz a b] *)
8951(* Proof:
8952 leibniz_seg_arm a b 1
8953 = MAP (\x. leibniz a (b + x)) [0 ..< 1] by notation
8954 = MAP (\x. leibniz a (b + x)) [0] by listRangeLHI_def
8955 = (\x. leibniz a (b + x)) 0 :: [] by MAP
8956 = [leibniz a b] by function application
8957*)
8958Theorem leibniz_seg_arm_1:
8959 !a b. leibniz_seg_arm a b 1 = [leibniz a b]
8960Proof
8961 rw[listRangeLHI_def]
8962QED
8963
8964(* Theorem: LENGTH (leibniz_col_arm a b n) = n *)
8965(* Proof:
8966 LENGTH (leibniz_col_arm a b n)
8967 = LENGTH (MAP (\x. leibniz (a - x) b) [0 ..< n]) by notation
8968 = LENGTH [0 ..< n] by LENGTH_MAP
8969 = LENGTH (GENLIST (\i. i) n) by listRangeLHI_def
8970 = m by LENGTH_GENLIST
8971*)
8972Theorem leibniz_col_arm_len:
8973 !a b n. LENGTH (leibniz_col_arm a b n) = n
8974Proof
8975 rw[]
8976QED
8977
8978(* Theorem: LENGTH (leibniz_seg_arm a b n) = n *)
8979(* Proof:
8980 LENGTH (leibniz_seg_arm a b n)
8981 = LENGTH (MAP (\x. leibniz a (b + x)) [0 ..< n]) by notation
8982 = LENGTH [0 ..< n] by LENGTH_MAP
8983 = LENGTH (GENLIST (\i. i) n) by listRangeLHI_def
8984 = m by LENGTH_GENLIST
8985*)
8986Theorem leibniz_seg_arm_len:
8987 !a b n. LENGTH (leibniz_seg_arm a b n) = n
8988Proof
8989 rw[]
8990QED
8991
8992(* Theorem: k < n ==> !a b. EL k (leibniz_col_arm a b n) = leibniz (a - k) b *)
8993(* Proof:
8994 Note LENGTH [0 ..< n] = n by LENGTH_listRangeLHI
8995 EL k (leibniz_col_arm a b n)
8996 = EL k (MAP (\x. leibniz (a - x) b) [0 ..< n]) by notation
8997 = (\x. leibniz (a - x) b) (EL k [0 ..< n]) by EL_MAP
8998 = (\x. leibniz (a - x) b) k by EL_listRangeLHI
8999 = leibniz (a - k) b
9000*)
9001Theorem leibniz_col_arm_el:
9002 !n k. k < n ==> !a b. EL k (leibniz_col_arm a b n) = leibniz (a - k) b
9003Proof
9004 rw[EL_MAP, EL_listRangeLHI]
9005QED
9006
9007(* Theorem: k < n ==> !a b. EL k (leibniz_seg_arm a b n) = leibniz a (b + k) *)
9008(* Proof:
9009 Note LENGTH [0 ..< n] = n by LENGTH_listRangeLHI
9010 EL k (leibniz_seg_arm a b n)
9011 = EL k (MAP (\x. leibniz a (b + x)) [0 ..< n]) by notation
9012 = (\x. leibniz a (b + x)) (EL k [0 ..< n]) by EL_MAP
9013 = (\x. leibniz a (b + x)) k by EL_listRangeLHI
9014 = leibniz a (b + k)
9015*)
9016Theorem leibniz_seg_arm_el:
9017 !n k. k < n ==> !a b. EL k (leibniz_seg_arm a b n) = leibniz a (b + k)
9018Proof
9019 rw[EL_MAP, EL_listRangeLHI]
9020QED
9021
9022(* Theorem: TAKE 1 (leibniz_seg_arm a b (n + 1)) = [leibniz a b] *)
9023(* Proof:
9024 Note LENGTH (leibniz_seg_arm a b (n + 1)) = n + 1 by leibniz_seg_arm_len
9025 and 0 < n + 1 by ADD1, SUC_POS
9026 TAKE 1 (leibniz_seg_arm a b (n + 1))
9027 = TAKE (SUC 0) (leibniz_seg_arm a b (n + 1)) by ONE
9028 = SNOC (EL 0 (leibniz_seg_arm a b (n + 1))) [] by TAKE_SUC_BY_TAKE, TAKE_0
9029 = [EL 0 (leibniz_seg_arm a b (n + 1))] by SNOC_NIL
9030 = leibniz a b by leibniz_seg_arm_el
9031*)
9032Theorem leibniz_seg_arm_head:
9033 !a b n. TAKE 1 (leibniz_seg_arm a b (n + 1)) = [leibniz a b]
9034Proof
9035 metis_tac[leibniz_seg_arm_len, leibniz_seg_arm_el,
9036 ONE, TAKE_SUC_BY_TAKE, TAKE_0, SNOC_NIL, DECIDE``!n. 0 < n + 1 /\ (n + 0 = n)``]
9037QED
9038
9039(* Theorem: leibniz_col_arm (a + 1) b (n + 1) = leibniz (a + 1) b :: leibniz_col_arm a b n *)
9040(* Proof:
9041 Note (\x. leibniz (a + 1 - x) b) o SUC
9042 = (\x. leibniz (a + 1 - (x + 1)) b) by FUN_EQ_THM
9043 = (\x. leibniz (a - x) b) by arithmetic
9044
9045 leibniz_col_arm (a + 1) b (n + 1)
9046 = MAP (\x. leibniz (a + 1 - x) b) [0 ..< (n + 1)] by notation
9047 = MAP (\x. leibniz (a + 1 - x) b) (0::[1 ..< (n+1)]) by listRangeLHI_CONS, 0 < n + 1
9048 = (\x. leibniz (a + 1 - x) b) 0 :: MAP (\x. leibniz (a + 1 - x) b) [1 ..< (n+1)] by MAP
9049 = leibniz (a + 1) b :: MAP (\x. leibniz (a + 1 - x) b) [1 ..< (n+1)] by function application
9050 = leibniz (a + 1) b :: MAP ((\x. leibniz (a + 1 - x) b) o SUC) [0 ..< n] by listRangeLHI_MAP_SUC
9051 = leibniz (a + 1) b :: MAP (\x. leibniz (a - x) b) [0 ..< n] by above
9052 = leibniz (a + 1) b :: leibniz_col_arm a b n by notation
9053*)
9054Theorem leibniz_col_arm_cons:
9055 !a b n. leibniz_col_arm (a + 1) b (n + 1) = leibniz (a + 1) b :: leibniz_col_arm a b n
9056Proof
9057 rpt strip_tac >>
9058 `!a x. a + 1 - SUC x + 1 = a - x + 1` by decide_tac >>
9059 `!a x. a + 1 - SUC x = a - x` by decide_tac >>
9060 `(\x. leibniz (a + 1 - x) b) o SUC = (\x. leibniz (a + 1 - (x + 1)) b)` by rw[FUN_EQ_THM] >>
9061 `0 < n + 1` by decide_tac >>
9062 `leibniz_col_arm (a + 1) b (n + 1) = MAP (\x. leibniz (a + 1 - x) b) (0::[1 ..< (n+1)])` by rw[listRangeLHI_CONS] >>
9063 `_ = leibniz (a + 1) b :: MAP (\x. leibniz (a + 1 - x) b) [0+1 ..< (n+1)]` by rw[] >>
9064 `_ = leibniz (a + 1) b :: MAP ((\x. leibniz (a + 1 - x) b) o SUC) [0 ..< n]` by rw[listRangeLHI_MAP_SUC] >>
9065 `_ = leibniz (a + 1) b :: leibniz_col_arm a b n` by rw[] >>
9066 rw[]
9067QED
9068
9069(* Theorem: k < n ==> !a b.
9070 TAKE (k + 1) (leibniz_seg_arm (a + 1) b (n + 1)) ++ DROP k (leibniz_seg_arm a b n) zigzag
9071 TAKE (k + 2) (leibniz_seg_arm (a + 1) b (n + 1)) ++ DROP (k + 1) (leibniz_seg_arm a b n) *)
9072(* Proof:
9073 Since k <= n, k < n + 1, and k + 1 < n + 2.
9074 Hence k < LENGTH (leibniz_seg_arm a b (n + 1)),
9075
9076 Let x = TAKE k (leibniz_seg_arm a b (n + 1))
9077 and y = DROP (k + 1) (leibniz_seg_arm a b n)
9078 TAKE (k + 1) (leibniz_seg_arm (a + 1) b (n + 1))
9079 = TAKE (SUC k) (leibniz_seg_arm (a + 1) b (n + 1)) by ADD1
9080 = SNOC t.b x by TAKE_SUC_BY_TAKE, k < LENGTH (leibniz_seg_arm (a + 1) b (n + 1))
9081 = x ++ [t.b] by SNOC_APPEND
9082 TAKE (k + 2) (leibniz_seg_arm (a + 1) b (n + 1))
9083 = TAKE (SUC (SUC k)) (leibniz_seg_arm (a + 1) b (SUC n)) by ADD1
9084 = SNOC t.c (SNOC t.b x) by TAKE_SUC_BY_TAKE, SUC k < LENGTH (leibniz_seg_arm (a + 1) b (n + 1))
9085 = x ++ [t.b; t.c] by SNOC_APPEND
9086 DROP k (leibniz_seg_arm a b n)
9087 = t.a :: y by DROP_BY_DROP_SUC, k < LENGTH (leibniz_seg_arm a b n)
9088 = [t.a] ++ y by CONS_APPEND
9089 Hence
9090 Let p1 = TAKE (k + 1) (leibniz_seg_arm (a + 1) b (n + 1)) ++ DROP k (leibniz_seg_arm a b n)
9091 = x ++ [t.b] ++ [t.a] ++ y
9092 = x ++ [t.b; t.a] ++ y by APPEND
9093 Let p2 = TAKE (k + 2) (leibniz_seg_arm (a + 1) b (n + 1)) ++ DROP (k + 1) (leibniz_seg_arm a b n)
9094 = x ++ [t.b; t.c] ++ y
9095 Therefore p1 zigzag p2 by leibniz_zigzag_def
9096*)
9097Theorem leibniz_seg_arm_zigzag_step:
9098 !n k. k < n ==> !a b.
9099 TAKE (k + 1) (leibniz_seg_arm (a + 1) b (n + 1)) ++ DROP k (leibniz_seg_arm a b n) zigzag
9100 TAKE (k + 2) (leibniz_seg_arm (a + 1) b (n + 1)) ++ DROP (k + 1) (leibniz_seg_arm a b n)
9101Proof
9102 rpt strip_tac >>
9103 qabbrev_tac `x = TAKE k (leibniz_seg_arm (a + 1) b (n + 1))` >>
9104 qabbrev_tac `y = DROP (k + 1) (leibniz_seg_arm a b n)` >>
9105 qabbrev_tac `t = triplet a (b + k)` >>
9106 `k < n + 1 /\ k + 1 < n + 1` by decide_tac >>
9107 `EL k (leibniz_seg_arm a b n) = t.a` by rw[triplet_def, leibniz_seg_arm_el, Abbr`t`] >>
9108 `EL k (leibniz_seg_arm (a + 1) b (n + 1)) = t.b` by rw[triplet_def, leibniz_seg_arm_el, Abbr`t`] >>
9109 `EL (k + 1) (leibniz_seg_arm (a + 1) b (n + 1)) = t.c` by rw[triplet_def, leibniz_seg_arm_el, Abbr`t`] >>
9110 `k < LENGTH (leibniz_seg_arm a b (n + 1))` by rw[leibniz_seg_arm_len] >>
9111 `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] >>
9112 `_ = SNOC t.b x` by rw[TAKE_SUC_BY_TAKE, Abbr`x`] >>
9113 `_ = x ++ [t.b]` by rw[SNOC_APPEND] >>
9114 `SUC k < n + 1` by decide_tac >>
9115 `SUC k < LENGTH (leibniz_seg_arm (a + 1) b (n + 1))` by rw[leibniz_seg_arm_len] >>
9116 `k < LENGTH (leibniz_seg_arm (a + 1) b (n + 1))` by decide_tac >>
9117 `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] >>
9118 `_ = SNOC t.c (SNOC t.b x)` by metis_tac[TAKE_SUC_BY_TAKE, ADD1] >>
9119 `_ = x ++ [t.b; t.c]` by rw[SNOC_APPEND] >>
9120 `DROP k (leibniz_seg_arm a b n) = [t.a] ++ y` by rw[DROP_BY_DROP_SUC, ADD1, Abbr`y`] >>
9121 qabbrev_tac `p1 = TAKE (k + 1) (leibniz_seg_arm (a + 1) b (n + 1)) ++ DROP k (leibniz_seg_arm a b n)` >>
9122 qabbrev_tac `p2 = TAKE (k + 2) (leibniz_seg_arm (a + 1) b (n + 1)) ++ y` >>
9123 `p1 = x ++ [t.b; t.a] ++ y` by rw[Abbr`p1`, Abbr`x`, Abbr`y`] >>
9124 `p2 = x ++ [t.b; t.c] ++ y` by rw[Abbr`p2`, Abbr`x`] >>
9125 metis_tac[leibniz_zigzag_def]
9126QED
9127
9128(* Theorem: k < n + 1 ==> !a b.
9129 TAKE (k + 1) (leibniz_seg_arm (a + 1) b (n + 1)) ++ DROP k (leibniz_seg_arm a b n) wriggle
9130 leibniz_seg_arm (a + 1) b (n + 1) *)
9131(* Proof:
9132 By induction on the difference: n - k.
9133 Base: k = n ==> TAKE (k + 1) (leibniz_seg_arm a b (n + 1)) ++ DROP k (leibniz_seg_arm a b n) wriggle
9134 leibniz_seg_arm a b (n + 1)
9135 Note LENGTH (leibniz_seg_arm (a + 1) b (n + 1)) = n + 1 by leibniz_seg_arm_len
9136 and LENGTH (leibniz_seg_arm a b n) = n by leibniz_seg_arm_len
9137 TAKE (k + 1) (leibniz_seg_arm a b (n + 1)) ++ DROP k (leibniz_seg_arm a b n)
9138 = TAKE (n + 1) (leibniz_seg_arm a b (n + 1)) ++ DROP n (leibniz_seg_arm a b n) by k = n
9139 = leibniz_seg_arm a b n ++ [] by TAKE_LENGTH_ID, DROP_LENGTH_NIL
9140 = leibniz_seg_arm a b n by APPEND_NIL
9141 Hence they wriggle to each other by RTC_REFL
9142 Step: k < n + 1 ==> TAKE (k + 1) (leibniz_seg_arm a b (n + 1)) ++ DROP k (leibniz_seg_arm a b n) wriggle
9143 leibniz_seg_arm a b (n + 1)
9144 Let p1 = leibniz_seg_arm (a + 1) b (n + 1)
9145 p2 = TAKE (k + 1) p1 ++ DROP k (leibniz_seg_arm a b n)
9146 p3 = TAKE (k + 2) (leibniz_seg_arm (a + 1) b (n + 1)) ++ DROP (k + 1) (leibniz_seg_arm a b n)
9147 Then p2 zigzag p3 by leibniz_seg_arm_zigzag_step
9148 and p3 wriggle p1 by induction hypothesis
9149 Hence p2 wriggle p1 by RTC_RULES
9150*)
9151Theorem leibniz_seg_arm_wriggle_step:
9152 !n k. k < n + 1 ==> !a b.
9153 TAKE (k + 1) (leibniz_seg_arm (a + 1) b (n + 1)) ++ DROP k (leibniz_seg_arm a b n) wriggle
9154 leibniz_seg_arm (a + 1) b (n + 1)
9155Proof
9156 Induct_on `n - k` >| [
9157 rpt strip_tac >>
9158 `k = n` by decide_tac >>
9159 metis_tac[leibniz_seg_arm_len, TAKE_LENGTH_ID, DROP_LENGTH_NIL, APPEND_NIL, RTC_REFL],
9160 rpt strip_tac >>
9161 qabbrev_tac `p1 = leibniz_seg_arm (a + 1) b (n + 1)` >>
9162 qabbrev_tac `p2 = TAKE (k + 1) p1 ++ DROP k (leibniz_seg_arm a b n)` >>
9163 qabbrev_tac `p3 = TAKE (k + 2) (leibniz_seg_arm (a + 1) b (n + 1)) ++ DROP (k + 1) (leibniz_seg_arm a b n)` >>
9164 `p2 zigzag p3` by rw[leibniz_seg_arm_zigzag_step, Abbr`p1`, Abbr`p2`, Abbr`p3`] >>
9165 `v = n - (k + 1)` by decide_tac >>
9166 `k + 1 < n + 1` by decide_tac >>
9167 `k + 1 + 1 = k + 2` by decide_tac >>
9168 metis_tac[RTC_RULES]
9169 ]
9170QED
9171
9172(* Theorem: ([leibniz (a + 1) b] ++ leibniz_seg_arm a b n) wriggle leibniz_seg_arm (a + 1) b (n + 1) *)
9173(* Proof:
9174 Apply > leibniz_seg_arm_wriggle_step |> SPEC ``n:num`` |> SPEC ``0`` |> SIMP_RULE std_ss[DROP_0];
9175 val it =
9176 |- 0 < n + 1 ==> !a b.
9177 TAKE 1 (leibniz_seg_arm (a + 1) b (n + 1)) ++ leibniz_seg_arm a b n wriggle
9178 leibniz_seg_arm (a + 1) b (n + 1):
9179 thm
9180
9181 Note 0 < n + 1 by ADD1, SUC_POS
9182 [leibniz (a + 1) b] ++ leibniz_seg_arm a b n
9183 = TAKE 1 (leibniz_seg_arm (a + 1) b (n + 1)) ++ leibniz_seg_arm a b n by leibniz_seg_arm_head
9184 = TAKE 1 (leibniz_seg_arm (a + 1) b (n + 1)) ++ DROP 0 (leibniz_seg_arm a b n) by DROP_0
9185 wriggle leibniz_seg_arm (a + 1) b (n + 1) by leibniz_seg_arm_wriggle_step, put k = 0
9186*)
9187Theorem leibniz_seg_arm_wriggle_row_arm:
9188 !a b n. ([leibniz (a + 1) b] ++ leibniz_seg_arm a b n) wriggle leibniz_seg_arm (a + 1) b (n + 1)
9189Proof
9190 rpt strip_tac >>
9191 `0 < n + 1 /\ (0 + 1 = 1)` by decide_tac >>
9192 metis_tac[leibniz_seg_arm_head, leibniz_seg_arm_wriggle_step, DROP_0]
9193QED
9194
9195(* Theorem: b <= a /\ n <= a + 1 - b ==> (leibniz_col_arm a b n) wriggle (leibniz_seg_arm a b n) *)
9196(* Proof:
9197 By induction on n.
9198 Base: leibniz_col_arm a b 0 wriggle leibniz_seg_arm a b 0
9199 Since leibniz_col_arm a b 0 = [] by leibniz_col_arm_0
9200 and leibniz_seg_arm a b 0 = [] by leibniz_seg_arm_0
9201 Hence leibniz_col_arm a b 0 wriggle leibniz_seg_arm a b 0 by leibniz_wriggle_refl
9202 Step: !a b. leibniz_col_arm a b n wriggle leibniz_seg_arm a b n ==>
9203 leibniz_col_arm a b (SUC n) wriggle leibniz_seg_arm a b (SUC n)
9204 Induct_on a.
9205 Base: b <= 0 /\ SUC n <= 0 + 1 - b ==> leibniz_col_arm 0 b (SUC n) wriggle leibniz_seg_arm 0 b (SUC n)
9206 Note SUC n <= 1 - b ==> n = 0, since 0 <= b.
9207 leibniz_col_arm 0 b (SUC 0)
9208 = leibniz_col_arm 0 b 1 by ONE
9209 = [leibniz 0 b] by leibniz_col_arm_1
9210 leibniz_seg_arm 0 b (SUC 0)
9211 = leibniz_seg_arm 0 b 1 by ONE
9212 = [leibniz 0 b] by leibniz_seg_arm_1
9213 Hence leibniz_col_arm 0 b 1 wriggle
9214 leibniz_seg_arm 0 b 1 by leibniz_wriggle_refl
9215 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)
9216 Note n <= a + 1 - b
9217 If a + 1 = b,
9218 Then n = 0,
9219 leibniz_col_arm (SUC a) b (SUC 0)
9220 = leibniz_col_arm (SUC a) b 1 by ONE
9221 = [leibniz (SUC a) b] by leibniz_col_arm_1
9222 = leibniz_seg_arm (SUC a) b 1 by leibniz_seg_arm_1
9223 = leibniz_seg_arm (SUC a) b (SUC 0) by ONE
9224 Hence leibniz_col_arm (SUC a) b 1 wriggle
9225 leibniz_seg_arm (SUC a) b 1 by leibniz_wriggle_refl
9226 If a + 1 <> b,
9227 Then b <= a, and induction hypothesis applies.
9228 Let x = leibniz (a + 1) b.
9229 Then leibniz_col_arm (a + 1) b (n + 1)
9230 = [x] ++ (leibniz_col_arm a b n) by leibniz_col_arm_cons
9231 Since leibniz_col_arm a b n
9232 wriggle leibniz_seg_arm a b n by induction hypothesis
9233 so ([x] ++ (leibniz_col_arm a b n)) wriggle
9234 ([x] ++ (leibniz_seg_arm a b n)) by leibniz_wriggle_tail
9235 and ([x] ++ (leibniz_seg_arm a b n)) wriggle
9236 (leibniz_seg_arm (a + 1) b (n + 1)) by leibniz_seg_arm_wriggle_row_arm
9237 Hence leibniz_col_arm a b (SUC n) wriggle
9238 leibniz_seg_arm a b (SUC n) by leibniz_wriggle_trans, ADD1
9239*)
9240Theorem leibniz_col_arm_wriggle_row_arm:
9241 !a b n. b <= a /\ n <= a + 1 - b ==> (leibniz_col_arm a b n) wriggle (leibniz_seg_arm a b n)
9242Proof
9243 Induct_on `n` >-
9244 rw[leibniz_col_arm_0, leibniz_seg_arm_0] >>
9245 rpt strip_tac >>
9246 Induct_on `a` >| [
9247 rpt strip_tac >>
9248 `n = 0` by decide_tac >>
9249 metis_tac[leibniz_col_arm_1, leibniz_seg_arm_1, ONE, leibniz_wriggle_refl],
9250 rpt strip_tac >>
9251 `n <= a + 1 - b` by decide_tac >>
9252 Cases_on `a + 1 = b` >| [
9253 `n = 0` by decide_tac >>
9254 metis_tac[leibniz_col_arm_1, leibniz_seg_arm_1, ONE, leibniz_wriggle_refl],
9255 `b <= a` by decide_tac >>
9256 qabbrev_tac `x = leibniz (a + 1) b` >>
9257 `leibniz_col_arm (a + 1) b (n + 1) = [x] ++ (leibniz_col_arm a b n)` by rw[leibniz_col_arm_cons, Abbr`x`] >>
9258 `([x] ++ (leibniz_col_arm a b n)) wriggle ([x] ++ (leibniz_seg_arm a b n))` by rw[leibniz_wriggle_tail] >>
9259 `([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`] >>
9260 metis_tac[leibniz_wriggle_trans, ADD1]
9261 ]
9262 ]
9263QED
9264
9265(* Theorem: b <= a /\ n <= a + 1 - b ==> (list_lcm (leibniz_col_arm a b n) = list_lcm (leibniz_seg_arm a b n)) *)
9266(* Proof:
9267 Since (leibniz_col_arm a b n) wriggle (leibniz_seg_arm a b n) by leibniz_col_arm_wriggle_row_arm
9268 the result follows by list_lcm_wriggle
9269*)
9270Theorem leibniz_lcm_invariance:
9271 !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))
9272Proof
9273 rw[leibniz_col_arm_wriggle_row_arm, list_lcm_wriggle]
9274QED
9275
9276(* This is a milestone theorem. *)
9277
9278(* This is used to give another proof of leibniz_up_wriggle_horizontal *)
9279
9280(* Theorem: leibniz_col_arm n 0 (n + 1) = leibniz_up n *)
9281(* Proof:
9282 leibniz_col_arm n 0 (n + 1)
9283 = MAP (\x. leibniz (n - x) 0) [0 ..< (n + 1)] by notation
9284 = MAP (\x. leibniz (n - x) 0) [0 .. n] by listRangeLHI_to_INC
9285 = MAP ((\x. leibniz x 0) o (\x. n - x)) [0 .. n] by function composition
9286 = REVERSE (MAP (\x. leibniz x 0) [0 .. n]) by listRangeINC_REVERSE_MAP
9287 = REVERSE (MAP (\x. x + 1) [0 .. n]) by leibniz_n_0
9288 = REVERSE (MAP SUC [0 .. n]) by ADD1
9289 = REVERSE (MAP (I o SUC) [0 .. n]) by I_THM
9290 = REVERSE [1 .. (n+1)] by listRangeINC_MAP_SUC
9291 = REVERSE (leibniz_vertical n) by notation
9292 = leibniz_up n by notation
9293*)
9294Theorem leibniz_col_arm_n_0:
9295 !n. leibniz_col_arm n 0 (n + 1) = leibniz_up n
9296Proof
9297 rpt strip_tac >>
9298 `(\x. x + 1) = SUC` by rw[FUN_EQ_THM] >>
9299 `(\x. leibniz x 0) o (\x. n - x + 0) = (\x. leibniz (n - x) 0)` by rw[FUN_EQ_THM] >>
9300 `leibniz_col_arm n 0 (n + 1) = MAP (\x. leibniz (n - x) 0) [0 .. n]` by rw[listRangeLHI_to_INC] >>
9301 `_ = MAP ((\x. leibniz x 0) o (\x. n - x + 0)) [0 .. n]` by rw[] >>
9302 `_ = REVERSE (MAP (\x. leibniz x 0) [0 .. n])` by rw[listRangeINC_REVERSE_MAP] >>
9303 `_ = REVERSE (MAP (\x. x + 1) [0 .. n])` by rw[leibniz_n_0] >>
9304 `_ = REVERSE (MAP SUC [0 .. n])` by rw[ADD1] >>
9305 `_ = REVERSE (MAP (I o SUC) [0 .. n])` by rw[] >>
9306 `_ = REVERSE [1 .. (n+1)]` by rw[GSYM listRangeINC_MAP_SUC] >>
9307 rw[]
9308QED
9309
9310(* Theorem: leibniz_seg_arm n 0 (n + 1) = leibniz_horizontal n *)
9311(* Proof:
9312 leibniz_seg_arm n 0 (n + 1)
9313 = MAP (\x. leibniz n x) [0 ..< (n + 1)] by notation
9314 = MAP (\x. leibniz n x) [0 .. n] by listRangeLHI_to_INC
9315 = MAP (leibniz n) [0 .. n] by FUN_EQ_THM
9316 = MAP (leibniz n) (GENLIST (\i. i) (n + 1)) by listRangeINC_def
9317 = GENLIST ((leibniz n) o I) (n + 1) by MAP_GENLIST
9318 = GENLIST (leibniz n) (n + 1) by I_THM
9319 = leibniz_horizontal n by notation
9320*)
9321Theorem leibniz_seg_arm_n_0:
9322 !n. leibniz_seg_arm n 0 (n + 1) = leibniz_horizontal n
9323Proof
9324 rpt strip_tac >>
9325 `(\x. x) = I` by rw[FUN_EQ_THM] >>
9326 `(\x. leibniz n x) = leibniz n` by rw[FUN_EQ_THM] >>
9327 `leibniz_seg_arm n 0 (n + 1) = MAP (leibniz n) [0 .. n]` by rw_tac std_ss[listRangeLHI_to_INC] >>
9328 `_ = MAP (leibniz n) (GENLIST (\i. i) (n + 1))` by rw[listRangeINC_def] >>
9329 `_ = MAP (leibniz n) (GENLIST I (n + 1))` by metis_tac[] >>
9330 `_ = GENLIST ((leibniz n) o I) (n + 1)` by rw[MAP_GENLIST] >>
9331 `_ = GENLIST (leibniz n) (n + 1)` by rw[] >>
9332 rw[]
9333QED
9334
9335(* Theorem: (leibniz_up n) wriggle (leibniz_horizontal n) *)
9336(* Proof:
9337 Note 0 <= n /\ n + 1 <= n + 1 - 0, so leibniz_col_arm_wriggle_row_arm applies.
9338 leibniz_up n
9339 = leibniz_col_arm n 0 (n + 1) by leibniz_col_arm_n_0
9340 wriggle leibniz_seg_arm n 0 (n + 1) by leibniz_col_arm_wriggle_row_arm
9341 = leibniz_horizontal n by leibniz_seg_arm_n_0
9342*)
9343Theorem leibniz_up_wriggle_horizontal_alt:
9344 !n. (leibniz_up n) wriggle (leibniz_horizontal n)
9345Proof
9346 rpt strip_tac >>
9347 `0 <= n /\ n + 1 <= n + 1 - 0` by decide_tac >>
9348 metis_tac[leibniz_col_arm_wriggle_row_arm, leibniz_col_arm_n_0, leibniz_seg_arm_n_0]
9349QED
9350
9351(* Theorem: list_lcm (leibniz_up n) = list_lcm (leibniz_horizontal n) *)
9352(* Proof: by leibniz_up_wriggle_horizontal_alt, list_lcm_wriggle *)
9353Theorem leibniz_up_lcm_eq_horizontal_lcm:
9354 !n. list_lcm (leibniz_up n) = list_lcm (leibniz_horizontal n)
9355Proof
9356 rw[leibniz_up_wriggle_horizontal_alt, list_lcm_wriggle]
9357QED
9358
9359(* This is another proof of the milestone theorem. *)
9360
9361(* ------------------------------------------------------------------------- *)
9362(* LCM Lower bound using big LCM *)
9363(* ------------------------------------------------------------------------- *)
9364
9365(* Laurent's leib.v and leib.html
9366
9367Lemma leibn_lcm_swap m n :
9368 lcmn 'L(m.+1, n) 'L(m, n) = lcmn 'L(m.+1, n) 'L(m.+1, n.+1).
9369Proof.
9370rewrite ![lcmn 'L(m.+1, n) _]lcmnC.
9371by apply/lcmn_swap/leibnS.
9372Qed.
9373
9374Notation "\lcm_ ( i < n ) F" :=
9375 (\big[lcmn/1%N]_(i < n ) F%N)
9376 (at level 41, F at level 41, i, n at level 50,
9377 format "'[' \lcm_ ( i < n ) '/ ' F ']'") : nat_scope.
9378
9379Canonical Structure lcmn_moid : Monoid.law 1 :=
9380 Monoid.Law lcmnA lcm1n lcmn1.
9381Canonical lcmn_comoid := Monoid.ComLaw lcmnC.
9382
9383Lemma lieb_line n i k : lcmn 'L(n.+1, i) (\lcm_(j < k) 'L(n, i + j)) =
9384 \lcm_(j < k.+1) 'L(n.+1, i + j).
9385Proof.
9386elim: k i => [i|k1 IH i].
9387 by rewrite big_ord_recr !big_ord0 /= lcmn1 lcm1n addn0.
9388rewrite big_ord_recl /= addn0.
9389rewrite lcmnA leibn_lcm_swap.
9390rewrite (eq_bigr (fun j : 'I_k1 => 'L(n, i.+1 + j))).
9391rewrite -lcmnA.
9392rewrite IH.
9393rewrite [RHS]big_ord_recl.
9394rewrite addn0; congr (lcmn _ _).
9395by apply: eq_bigr => j _; rewrite addnS.
9396move=> j _.
9397by rewrite addnS.
9398Qed.
9399
9400Lemma leib_corner n : \lcm_(i < n.+1) 'L(i, 0) = \lcm_(i < n.+1) 'L(n, i).
9401Proof.
9402elim: n => [|n IH]; first by rewrite !big_ord_recr !big_ord0 /=.
9403rewrite big_ord_recr /= IH lcmnC.
9404rewrite (eq_bigr (fun i : 'I_n.+1 => 'L(n, 0 + i))) //.
9405by rewrite lieb_line.
9406Qed.
9407
9408Lemma main_result n : 2^n.-1 <= \lcm_(i < n) i.+1.
9409Proof.
9410case: n => [|n /=]; first by rewrite big_ord0.
9411have <-: \lcm_(i < n.+1) 'L(i, 0) = \lcm_(i < n.+1) i.+1.
9412 by apply: eq_bigr => i _; rewrite leibn0.
9413rewrite leib_corner.
9414have -> : forall j, \lcm_(i < j.+1) 'L(n, i) = n.+1 * \lcm_(i < j.+1) 'C(n, i).
9415 elim=> [|j IH]; first by rewrite !big_ord_recr !big_ord0 /= !lcm1n.
9416 by rewrite big_ord_recr [in RHS]big_ord_recr /= IH muln_lcmr.
9417rewrite (expnDn 1 1) /= (eq_bigr (fun i : 'I_n.+1 => 'C(n, i))) =>
9418 [|i _]; last by rewrite !exp1n !muln1.
9419have <- : forall n m, \sum_(i < n) m = n * m.
9420 by move=> m1 n1; rewrite sum_nat_const card_ord.
9421apply: leq_sum => i _.
9422apply: dvdn_leq; last by rewrite (bigD1 i) //= dvdn_lcml.
9423apply big_ind => // [x y Hx Hy|x H]; first by rewrite lcmn_gt0 Hx.
9424by rewrite bin_gt0 -ltnS.
9425Qed.
9426
9427*)
9428
9429(*
9430Lemma 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).
9431
9432translates to:
9433 !n i k. lcm (leibniz (n + 1) i) (big_lcm {leibniz n (i + j) | j | j < k}) =
9434 big_lcm {leibniz (n+1) (i + j) | j | j < k + 1};
9435
9436The picture is:
9437
9438 n-th row: L n i L n (i+1) .... L n (i + (k-1))
9439(n+1)-th row: L (n+1) i
9440
9441(n+1)-th row: L (n+1) i L (n+1) (i+1) .... L (n+1) (i + (k-1)) L (n+1) (i + k)
9442
9443If k = 1, this is: L n i transform to:
9444 L (n+1) i L (n+1) i L (n+1) (i+1)
9445which is Leibniz triplet.
9446
9447In general, if true for k, then for the next (k+1)
9448
9449 n-th row: L n i L n (i+1) .... L n (i + (k-1)) L n (i + k)
9450(n+1)-th row: L (n+1) i
9451= L n (i + k)
9452(n+1)-th row: L (n+1) i L (n+1) (i+1) .... L (n+1) (i + (k-1)) L (n+1) (i + k)
9453by induction hypothesis
9454=
9455(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))
9456by Leibniz triplet.
9457
9458*)
9459
9460(* Introduce a segment, a partial horizontal row, in Leibniz Denominator Triangle *)
9461Overload leibniz_seg = ``\n k h. IMAGE (\j. leibniz n (k + j)) (count h)``
9462(* This is a segment starting at leibniz n k, of length h *)
9463
9464(* Introduce a horizontal row in Leibniz Denominator Triangle *)
9465Overload leibniz_row = ``\n h. IMAGE (leibniz n) (count h)``
9466(* This is a row starting at leibniz n 0, of length h *)
9467
9468(* Introduce a vertical column in Leibniz Denominator Triangle *)
9469Overload leibniz_col = ``\h. IMAGE (\i. leibniz i 0) (count h)``
9470(* This is a column starting at leibniz 0 0, descending for a length h *)
9471
9472(* Representations of paths based on indexed sets *)
9473
9474(* Theorem: leibniz_seg n k h = {leibniz n (k + j) | j | j IN (count h)} *)
9475(* Proof: by notation *)
9476Theorem leibniz_seg_def:
9477 !n k h. leibniz_seg n k h = {leibniz n (k + j) | j | j IN (count h)}
9478Proof
9479 rw[EXTENSION]
9480QED
9481
9482(* Theorem: leibniz_row n h = {leibniz n j | j | j IN (count h)} *)
9483(* Proof: by notation *)
9484Theorem leibniz_row_def:
9485 !n h. leibniz_row n h = {leibniz n j | j | j IN (count h)}
9486Proof
9487 rw[EXTENSION]
9488QED
9489
9490(* Theorem: leibniz_col h = {leibniz j 0 | j | j IN (count h)} *)
9491(* Proof: by notation *)
9492Theorem leibniz_col_def:
9493 !h. leibniz_col h = {leibniz j 0 | j | j IN (count h)}
9494Proof
9495 rw[EXTENSION]
9496QED
9497
9498(* Theorem: leibniz_col n = natural n *)
9499(* Proof:
9500 leibniz_col n
9501 = IMAGE (\i. leibniz i 0) (count n) by notation
9502 = IMAGE (\i. i + 1) (count n) by leibniz_n_0
9503 = IMAGE (\i. SUC i) (count n) by ADD1
9504 = IMAGE SUC (count n) by FUN_EQ_THM
9505 = natural n by notation
9506*)
9507Theorem leibniz_col_eq_natural:
9508 !n. leibniz_col n = natural n
9509Proof
9510 rw[leibniz_n_0, ADD1, FUN_EQ_THM]
9511QED
9512
9513(* The following can be taken as a generalisation of the Leibniz Triplet LCM exchange. *)
9514(* When length h = 1, the top row is a singleton, and the next row is a duplet, altogether a triplet. *)
9515
9516(* Theorem: lcm (leibniz (n + 1) k) (big_lcm (leibniz_seg n k h)) = big_lcm (leibniz_seg (n + 1) k (h + 1)) *)
9517(* Proof:
9518 Let p = (\j. leibniz n (k + j)), q = (\j. leibniz (n + 1) (k + j)).
9519 Note q 0 = (leibniz (n + 1) k) by function application [1]
9520 The goal is: lcm (leibniz (n + 1) k) (big_lcm (IMAGE p (count h))) = big_lcm (IMAGE q (count (h + 1)))
9521
9522 By induction on h, length of the row.
9523 Base case: lcm (leibniz (n + 1) k) (big_lcm (IMAGE p (count 0))) = big_lcm (IMAGE q (count (0 + 1)))
9524 lcm (leibniz (n + 1) k) (big_lcm (IMAGE p (count 0)))
9525 = lcm (q 0) (big_lcm (IMAGE p (count 0))) by [1]
9526 = lcm (q 0) (big_lcm (IMAGE p {})) by COUNT_ZERO
9527 = lcm (q 0) (big_lcm {}) by IMAGE_EMPTY
9528 = lcm (q 0) 1 by big_lcm_empty
9529 = q 0 by LCM_1
9530 = big_lcm {q 0} by big_lcm_sing
9531 = big_lcm (IMAEG q {0}) by IMAGE_SING
9532 = big_lcm (IMAGE q (count 1)) by count_def, EXTENSION
9533
9534 Step case: lcm (leibniz (n + 1) k) (big_lcm (IMAGE p (count h))) = big_lcm (IMAGE q (count (h + 1))) ==>
9535 lcm (leibniz (n + 1) k) (big_lcm (IMAGE p (upto h))) = big_lcm (IMAGE q (count (SUC h + 1)))
9536 Note !n. FINITE (count n) by FINITE_COUNT
9537 and !s. FINITE s ==> FINITE (IMAGE f s) by IMAGE_FINITE
9538 Also p h = (triplet n (k + h)).a by leibniz_triplet_member
9539 q h = (triplet n (k + h)).b by leibniz_triplet_member
9540 q (h + 1) = (triplet n (k + h)).c by leibniz_triplet_member
9541 Thus lcm (q h) (p h) = lcm (q h) (q (h + 1)) by leibniz_triplet_lcm
9542
9543 lcm (leibniz (n + 1) k) (big_lcm (IMAGE p (upto h)))
9544 = lcm (q 0) (big_lcm (IMAGE p (count (SUC h)))) by [1], notation
9545 = lcm (q 0) (big_lcm (IMAGE p (h INSERT count h))) by upto_by_count
9546 = lcm (q 0) (big_lcm ((p h) INSERT (IMAGE p (count h)))) by IMAGE_INSERT
9547 = lcm (q 0) (lcm (p h) (big_lcm (IMAGE p (count h)))) by big_lcm_insert
9548 = lcm (p h) (lcm (q 0) (big_lcm (IMAGE p (count h)))) by LCM_ASSOC_COMM
9549 = lcm (p h) (big_lcm (IMAGE q (count (h + 1)))) by induction hypothesis
9550 = lcm (p h) (big_lcm (IMAGE q (count (SUC h)))) by ADD1
9551 = lcm (p h) (big_lcm (IMAGE q (h INSERT (count h))) by upto_by_count
9552 = lcm (p h) (big_lcm ((q h) INSERT IMAGE q (count h))) by IMAGE_INSERT
9553 = lcm (p h) (lcm (q h) (big_lcm (IMAGE q (count h)))) by big_lcm_insert
9554 = lcm (lcm (p h) (q h)) (big_lcm (IMAGE q (count h))) by LCM_ASSOC
9555 = lcm (lcm (q h) (p h)) (big_lcm (IMAGE q (count h))) by LCM_COM
9556 = lcm (lcm (q h) (q (h + 1))) (big_lcm (IMAGE q (count h))) by leibniz_triplet_lcm
9557 = lcm (q (h + 1)) (lcm (q h) (big_lcm (IMAGE q (count h)))) by LCM_ASSOC, LCM_COMM
9558 = lcm (q (h + 1)) (big_lcm ((q h) INSERT IMAGE q (count h))) by big_lcm_insert
9559 = lcm (q (h + 1)) (big_lcm (IMAGE q (h INSERT count h)) by IMAGE_INSERT
9560 = lcm (q (h + 1)) (big_lcm (IMAGE q (count (h + 1)))) by upto_by_count, ADD1
9561 = big_lcm ((q (h + 1)) INSERT (IMAGE q (count (h + 1)))) by big_lcm_insert
9562 = big_lcm IMAGE q ((h + 1) INSERT (count (h + 1))) by IMAGE_INSERT
9563 = big_lcm (IMAGE q (count (SUC (h + 1)))) by upto_by_count
9564 = big_lcm (IMAGE q (count (SUC h + 1))) by ADD
9565*)
9566Theorem big_lcm_seg_transform:
9567 !n k h. lcm (leibniz (n + 1) k) (big_lcm (leibniz_seg n k h)) =
9568 big_lcm (leibniz_seg (n + 1) k (h + 1))
9569Proof
9570 rpt strip_tac >>
9571 qabbrev_tac `p = (\j. leibniz n (k + j))` >>
9572 qabbrev_tac `q = (\j. leibniz (n + 1) (k + j))` >>
9573 Induct_on `h` >| [
9574 `count 0 = {}` by rw[] >>
9575 `count 1 = {0}` by rw[COUNT_1] >>
9576 rw_tac std_ss[IMAGE_EMPTY, big_lcm_empty, IMAGE_SING, LCM_1, big_lcm_sing, Abbr`p`, Abbr`q`],
9577 `leibniz (n + 1) k = q 0` by rw[Abbr`q`] >>
9578 simp[] >>
9579 `lcm (q h) (p h) = lcm (q h) (q (h + 1))` by
9580 (`p h = (triplet n (k + h)).a` by rw[leibniz_triplet_member, Abbr`p`] >>
9581 `q h = (triplet n (k + h)).b` by rw[leibniz_triplet_member, Abbr`q`] >>
9582 `q (h + 1) = (triplet n (k + h)).c` by rw[leibniz_triplet_member, Abbr`q`] >>
9583 rw[leibniz_triplet_lcm]) >>
9584 `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] >>
9585 `_ = lcm (p h) (lcm (q 0) (big_lcm (IMAGE p (count h))))` by rw[LCM_ASSOC_COMM] >>
9586 `_ = lcm (p h) (big_lcm (IMAGE q (count (SUC h))))` by metis_tac[ADD1] >>
9587 `_ = lcm (p h) (lcm (q h) (big_lcm (IMAGE q (count h))))` by rw[upto_by_count, big_lcm_insert] >>
9588 `_ = lcm (q (h + 1)) (lcm (q h) (big_lcm (IMAGE q (count h))))` by metis_tac[LCM_ASSOC, LCM_COMM] >>
9589 `_ = lcm (q (h + 1)) (big_lcm (IMAGE q (count (SUC h))))` by rw[upto_by_count, big_lcm_insert] >>
9590 `_ = lcm (q (h + 1)) (big_lcm (IMAGE q (count (h + 1))))` by rw[ADD1] >>
9591 `_ = big_lcm (IMAGE q (count (SUC (h + 1))))` by rw[upto_by_count, big_lcm_insert] >>
9592 metis_tac[ADD]
9593 ]
9594QED
9595
9596(* Theorem: lcm (leibniz (n + 1) 0) (big_lcm (leibniz_row n h)) = big_lcm (leibniz_row (n + 1) (h + 1)) *)
9597(* Proof:
9598 Note !n h. leibniz_row n h = leibniz_seg n 0 h by FUN_EQ_THM
9599 Take k = 0 in big_lcm_seg_transform, the result follows.
9600*)
9601Theorem big_lcm_row_transform:
9602 !n h. lcm (leibniz (n + 1) 0) (big_lcm (leibniz_row n h)) = big_lcm (leibniz_row (n + 1) (h + 1))
9603Proof
9604 rpt strip_tac >>
9605 `!n h. leibniz_row n h = leibniz_seg n 0 h` by rw[FUN_EQ_THM] >>
9606 metis_tac[big_lcm_seg_transform]
9607QED
9608
9609(* Theorem: big_lcm (leibniz_col (n + 1)) = big_lcm (leibniz_row n (n + 1)) *)
9610(* Proof:
9611 Let f = \i. leibniz i 0, then f 0 = leibniz 0 0.
9612 By induction on n.
9613 Base: big_lcm (leibniz_col (0 + 1)) = big_lcm (leibniz_row 0 (0 + 1))
9614 big_lcm (leibniz_col (0 + 1))
9615 = big_lcm (IMAGE f (count 1)) by notation
9616 = big_lcm (IMAGE f) {0}) by COUNT_1
9617 = big_lcm {f 0} by IMAGE_SING
9618 = big_lcm {leibniz 0 0} by f 0
9619 = big_lcm (IMAGE (leibniz 0) {0}) by IMAGE_SING
9620 = big_lcm (IMAGE (leibniz 0) (count 1)) by COUNT_1
9621
9622 Step: big_lcm (leibniz_col (n + 1)) = big_lcm (leibniz_row n (n + 1)) ==>
9623 big_lcm (leibniz_col (SUC n + 1)) = big_lcm (leibniz_row (SUC n) (SUC n + 1))
9624 big_lcm (leibniz_col (SUC n + 1))
9625 = big_lcm (IMAGE f (count (SUC n + 1))) by notation
9626 = big_lcm (IMAGE f (count (SUC (n + 1)))) by ADD
9627 = big_lcm (IMAGE f ((n + 1) INSERT (count (n + 1)))) by upto_by_count
9628 = big_lcm ((f (n + 1)) INSERT (IMAGE f (count (n + 1)))) by IMAGE_INSERT
9629 = lcm (f (n + 1)) (big_lcm (IMAGE f (count (n + 1)))) by big_lcm_insert
9630 = lcm (f (n + 1)) (big_lcm (IMAGE (leibniz n) (count (n + 1)))) by induction hypothesis
9631 = lcm (leibniz (n + 1) 0) (big_lcm (IMAGE (leibniz n) (count (n + 1)))) by f (n + 1)
9632 = big_lcm (IMAGE (leibniz (n + 1)) (count (n + 1 + 1))) by big_lcm_line_transform
9633 = big_lcm (IMAGE (leibniz (SUC n)) (count (SUC n + 1))) by ADD1
9634*)
9635Theorem big_lcm_corner_transform:
9636 !n. big_lcm (leibniz_col (n + 1)) = big_lcm (leibniz_row n (n + 1))
9637Proof
9638 Induct >-
9639 rw[COUNT_1, IMAGE_SING] >>
9640 qabbrev_tac `f = \i. leibniz i 0` >>
9641 `big_lcm (IMAGE f (count (SUC n + 1))) = big_lcm (IMAGE f (count (SUC (n + 1))))` by rw[ADD] >>
9642 `_ = lcm (f (n + 1)) (big_lcm (IMAGE f (count (n + 1))))` by rw[upto_by_count, big_lcm_insert] >>
9643 `_ = lcm (leibniz (n + 1) 0) (big_lcm (IMAGE (leibniz n) (count (n + 1))))` by rw[Abbr`f`] >>
9644 `_ = big_lcm (IMAGE (leibniz (n + 1)) (count (n + 1 + 1)))` by rw[big_lcm_row_transform] >>
9645 `_ = big_lcm (IMAGE (leibniz (SUC n)) (count (SUC n + 1)))` by rw[ADD1] >>
9646 rw[]
9647QED
9648
9649(* Theorem: (!x. x IN (count (n + 1)) ==> 0 < f x) ==>
9650 SUM (GENLIST f (n + 1)) <= (n + 1) * big_lcm (IMAGE f (count (n + 1))) *)
9651(* Proof:
9652 By induction on n.
9653 Base: SUM (GENLIST f (0 + 1)) <= (0 + 1) * big_lcm (IMAGE f (count (0 + 1)))
9654 LHS = SUM (GENLIST f 1)
9655 = SUM [f 0] by GENLIST_1
9656 = f 0 by SUM
9657 RHS = 1 * big_lcm (IMAGE f (count 1))
9658 = big_lcm (IMAGE f {0}) by COUNT_1
9659 = big_lcm (f 0) by IMAGE_SING
9660 = f 0 by big_lcm_sing
9661 Thus LHS <= RHS by arithmetic
9662 Step: SUM (GENLIST f (n + 1)) <= (n + 1) * big_lcm (IMAGE f (count (n + 1))) ==>
9663 SUM (GENLIST f (SUC n + 1)) <= (SUC n + 1) * big_lcm (IMAGE f (count (SUC n + 1)))
9664 Note 0 < f (n + 1) by (n + 1) IN count (SUC n + 1)
9665 and !y. y IN count (n + 1) ==> y IN count (SUC n + 1) by IN_COUNT
9666 and !x. x IN IMAGE f (count (n + 1)) ==> 0 < x by IN_IMAGE, above
9667 so 0 < big_lcm (IMAGE f (count (n + 1))) by big_lcm_positive
9668 and 0 < SUC n by SUC_POS
9669 Thus f (n + 1) <= lcm (f (n + 1)) (big_lcm (IMAGE f (count (n + 1)))) by LCM_LE
9670 and big_lcm (IMAGE f (count (n + 1))) <= lcm (f (n + 1)) (big_lcm (IMAGE f (count (n + 1)))) by LCM_LE
9671
9672 LHS = SUM (GENLIST f (SUC n + 1))
9673 = SUM (GENLIST f (SUC (n + 1))) by ADD
9674 = SUM (SNOC (f (n + 1)) (GENLIST f (n + 1))) by GENLIST
9675 = SUM (GENLIST f (n + 1)) + f (n + 1) by SUM_SNOC
9676 RHS = (SUC n + 1) * big_lcm (IMAGE f (count (SUC n + 1)))
9677 = (SUC n + 1) * big_lcm (IMAGE f (count (SUC (n + 1)))) by ADD
9678 = (SUC n + 1) * big_lcm (IMAGE f ((n + 1) INSERT (count (n + 1)))) by upto_by_count
9679 = (SUC n + 1) * big_lcm ((f (n + 1)) INSERT (IMAGE f (count (n + 1)))) by IMAGE_INSERT
9680 = (SUC n + 1) * lcm (f (n + 1)) (big_lcm (IMAGE f (count (n + 1)))) by big_lcm_insert
9681 = SUC n * lcm (f (n + 1)) (big_lcm (IMAGE f (count (n + 1))))
9682 + 1 * lcm (f (n + 1)) (big_lcm (IMAGE f (count (n + 1)))) by RIGHT_ADD_DISTRIB
9683 >= SUC n * (big_lcm (IMAGE f (count (n + 1)))) + f (n + 1) by LCM_LE
9684 = (n + 1) * (big_lcm (IMAGE f (count (n + 1)))) + f (n + 1) by ADD1
9685 >= SUM (GENLIST f (n + 1)) + f (n + 1) by induction hypothesis
9686 = LHS by above
9687*)
9688Theorem big_lcm_count_lower_bound:
9689 !f n. (!x. x IN (count (n + 1)) ==> 0 < f x) ==>
9690 SUM (GENLIST f (n + 1)) <= (n + 1) * big_lcm (IMAGE f (count (n + 1)))
9691Proof
9692 rpt strip_tac >>
9693 Induct_on `n` >| [
9694 rpt strip_tac >>
9695 `SUM (GENLIST f 1) = f 0` by rw[] >>
9696 `1 * big_lcm (IMAGE f (count 1)) = f 0` by rw[COUNT_1, big_lcm_sing] >>
9697 rw[],
9698 rpt strip_tac >>
9699 `big_lcm (IMAGE f (count (SUC n + 1))) = big_lcm (IMAGE f (count (SUC (n + 1))))` by rw[ADD] >>
9700 `_ = lcm (f (n + 1)) (big_lcm (IMAGE f (count (n + 1))))` by rw[upto_by_count, big_lcm_insert] >>
9701 `!x. (SUC n + 1) * x = SUC n * x + x` by rw[] >>
9702 `0 < f (n + 1)` by rw[] >>
9703 `!y. y IN count (n + 1) ==> y IN count (SUC n + 1)` by rw[] >>
9704 `!x. x IN IMAGE f (count (n + 1)) ==> 0 < x` by metis_tac[IN_IMAGE] >>
9705 `0 < big_lcm (IMAGE f (count (n + 1)))` by rw[big_lcm_positive] >>
9706 `0 < SUC n` by rw[] >>
9707 `f (n + 1) <= lcm (f (n + 1)) (big_lcm (IMAGE f (count (n + 1))))` by rw[LCM_LE] >>
9708 `big_lcm (IMAGE f (count (n + 1))) <= lcm (f (n + 1)) (big_lcm (IMAGE f (count (n + 1))))` by rw[LCM_LE] >>
9709 `!a b c x. 0 < a /\ 0 < b /\ 0 < c /\ a <= x /\ b <= x ==> c * a + b <= c * x + x` by
9710 (rpt strip_tac >>
9711 `c * a <= c * x` by rw[] >>
9712 decide_tac) >>
9713 `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[] >>
9714 `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] >>
9715 `SUM (GENLIST f (SUC n + 1)) = SUM (GENLIST f (SUC (n + 1)))` by rw[ADD] >>
9716 `_ = SUM (GENLIST f (n + 1)) + f (n + 1)` by rw[GENLIST, SUM_SNOC] >>
9717 metis_tac[LESS_EQ_TRANS, DECIDE``!a x y. 0 < a /\ x <= y ==> x + a <= y + a``]
9718 ]
9719QED
9720
9721(* Theorem: big_lcm (natural (n + 1)) = (n + 1) * big_lcm (IMAGE (binomial n) (count (n + 1))) *)
9722(* Proof:
9723 Note SUC = \i. i + 1 by ADD1, FUN_EQ_THM
9724 = \i. leibniz i 0 by leibniz_n_0
9725 and leibniz n = \j. (n + 1) * binomial n j by leibniz_def, FUN_EQ_THM
9726 so !s. IMAGE SUC s = IMAGE (\i. leibniz i 0) s by IMAGE_CONG
9727 and !s. IMAGE (leibniz n) s = IMAGE (\j. (n + 1) * binomial n j) s by IMAGE_CONG
9728 also !s. IMAGE (binomial n) s = IMAGE (\j. binomial n j) s by FUN_EQ_THM, IMAGE_CONG
9729 and count (n + 1) <> {} by COUNT_EQ_EMPTY, n + 1 <> 0 [1]
9730
9731 big_lcm (IMAGE SUC (count (n + 1)))
9732 = big_lcm (IMAGE (\i. leibniz i 0) (count (n + 1))) by above
9733 = big_lcm (IMAGE (leibniz n) (count (n + 1))) by big_lcm_corner_transform
9734 = big_lcm (IMAGE (\j. (n + 1) * binomial n j) (count (n + 1))) by leibniz_def
9735 = big_lcm (IMAGE ($* (n + 1)) (IMAGE (binomial n) (count (n + 1)))) by IMAGE_COMPOSE, o_DEF
9736 = (n + 1) * big_lcm (IMAGE (binomial n) (count (n + 1))) by big_lcm_map_times, FINITE_COUNT, [1]
9737*)
9738Theorem big_lcm_natural_eqn:
9739 !n. big_lcm (natural (n + 1)) = (n + 1) * big_lcm (IMAGE (binomial n) (count (n + 1)))
9740Proof
9741 rpt strip_tac >>
9742 `SUC = \i. leibniz i 0` by rw[leibniz_n_0, FUN_EQ_THM] >>
9743 `leibniz n = \j. (n + 1) * binomial n j` by rw[leibniz_def, FUN_EQ_THM] >>
9744 `!s. IMAGE SUC s = IMAGE (\i. leibniz i 0) s` by rw[IMAGE_CONG] >>
9745 `!s. IMAGE (leibniz n) s = IMAGE (\j. (n + 1) * binomial n j) s` by rw[IMAGE_CONG] >>
9746 `!s. IMAGE (binomial n) s = IMAGE (\j. binomial n j) s` by rw[FUN_EQ_THM, IMAGE_CONG] >>
9747 `count (n + 1) <> {}` by rw[COUNT_EQ_EMPTY] >>
9748 `big_lcm (IMAGE SUC (count (n + 1))) = big_lcm (IMAGE (leibniz n) (count (n + 1)))` by rw[GSYM big_lcm_corner_transform] >>
9749 `_ = big_lcm (IMAGE (\j. (n + 1) * binomial n j) (count (n + 1)))` by rw[] >>
9750 `_ = big_lcm (IMAGE ($* (n + 1)) (IMAGE (binomial n) (count (n + 1))))` by rw[GSYM IMAGE_COMPOSE, combinTheory.o_DEF] >>
9751 `_ = (n + 1) * big_lcm (IMAGE (binomial n) (count (n + 1)))` by rw[big_lcm_map_times] >>
9752 rw[]
9753QED
9754
9755(* Theorem: 2 ** n <= big_lcm (natural (n + 1)) *)
9756(* Proof:
9757 Note !x. x IN (count (n + 1)) ==> 0 < (binomial n) x by binomial_pos, IN_COUNT [1]
9758 big_lcm (natural (n + 1))
9759 = (n + 1) * big_lcm (IMAGE (binomial n) (count (n + 1))) by big_lcm_natural_eqn
9760 >= SUM (GENLIST (binomial n) (n + 1)) by big_lcm_count_lower_bound, [1]
9761 = SUM (GENLIST (binomial n) (SUC n)) by ADD1
9762 = 2 ** n by binomial_sum
9763*)
9764Theorem big_lcm_lower_bound:
9765 !n. 2 ** n <= big_lcm (natural (n + 1))
9766Proof
9767 rpt strip_tac >>
9768 `!x. x IN (count (n + 1)) ==> 0 < (binomial n) x` by rw[binomial_pos] >>
9769 `big_lcm (IMAGE SUC (count (n + 1))) = (n + 1) * big_lcm (IMAGE (binomial n) (count (n + 1)))` by rw[big_lcm_natural_eqn] >>
9770 `SUM (GENLIST (binomial n) (n + 1)) = 2 ** n` by rw[GSYM binomial_sum, ADD1] >>
9771 metis_tac[big_lcm_count_lower_bound]
9772QED
9773
9774(* Another proof of the milestone theorem. *)
9775
9776(* Theorem: big_lcm (set l) = list_lcm l *)
9777(* Proof:
9778 By induction on l.
9779 Base: big_lcm (set []) = list_lcm []
9780 big_lcm (set [])
9781 = big_lcm {} by LIST_TO_SET
9782 = 1 by big_lcm_empty
9783 = list_lcm [] by list_lcm_nil
9784 Step: big_lcm (set l) = list_lcm l ==> !h. big_lcm (set (h::l)) = list_lcm (h::l)
9785 Note FINITE (set l) by FINITE_LIST_TO_SET
9786 big_lcm (set (h::l))
9787 = big_lcm (h INSERT set l) by LIST_TO_SET
9788 = lcm h (big_lcm (set l)) by big_lcm_insert, FINITE (set t)
9789 = lcm h (list_lcm l) by induction hypothesis
9790 = list_lcm (h::l) by list_lcm_cons
9791*)
9792Theorem big_lcm_eq_list_lcm:
9793 !l. big_lcm (set l) = list_lcm l
9794Proof
9795 Induct >-
9796 rw[big_lcm_empty] >>
9797 rw[big_lcm_insert]
9798QED
9799
9800(* ------------------------------------------------------------------------- *)
9801(* List LCM depends only on its set of elements *)
9802(* ------------------------------------------------------------------------- *)
9803
9804(* Theorem: MEM x l ==> (list_lcm (x::l) = list_lcm l) *)
9805(* Proof:
9806 By induction on l.
9807 Base: MEM x [] ==> (list_lcm [x] = list_lcm [])
9808 True by MEM x [] = F by MEM
9809 Step: MEM x l ==> (list_lcm (x::l) = list_lcm l) ==>
9810 !h. MEM x (h::l) ==> (list_lcm (x::h::l) = list_lcm (h::l))
9811 Note MEM x (h::l) ==> (x = h) \/ (MEM x l) by MEM
9812 If x = h,
9813 list_lcm (h::h::l)
9814 = lcm h (lcm h (list_lcm l)) by list_lcm_cons
9815 = lcm (lcm h h) (list_lcm l) by LCM_ASSOC
9816 = lcm h (list_lcm l) by LCM_REF
9817 = list_lcm (h::l) by list_lcm_cons
9818 If x <> h, MEM x l
9819 list_lcm (x::h::l)
9820 = lcm x (lcm h (list_lcm l)) by list_lcm_cons
9821 = lcm h (lcm x (list_lcm l)) by LCM_ASSOC_COMM
9822 = lcm h (list_lcm (x::l)) by list_lcm_cons
9823 = lcm h (list_lcm l) by induction hypothesis, MEM x l
9824 = list_lcm (h::l) by list_lcm_cons
9825*)
9826Theorem list_lcm_absorption:
9827 !x l. MEM x l ==> (list_lcm (x::l) = list_lcm l)
9828Proof
9829 rpt strip_tac >>
9830 Induct_on `l` >-
9831 metis_tac[MEM] >>
9832 rw[MEM] >| [
9833 `lcm h (lcm h (list_lcm l)) = lcm (lcm h h) (list_lcm l)` by rw[LCM_ASSOC] >>
9834 rw[LCM_REF],
9835 `lcm x (lcm h (list_lcm l)) = lcm h (lcm x (list_lcm l))` by rw[LCM_ASSOC_COMM] >>
9836 `_ = lcm h (list_lcm (x::l))` by metis_tac[list_lcm_cons] >>
9837 rw[]
9838 ]
9839QED
9840
9841(* Theorem: list_lcm (nub l) = list_lcm l *)
9842(* Proof:
9843 By induction on l.
9844 Base: list_lcm (nub []) = list_lcm []
9845 True since nub [] = [] by nub_nil
9846 Step: list_lcm (nub l) = list_lcm l ==> !h. list_lcm (nub (h::l)) = list_lcm (h::l)
9847 If MEM h l,
9848 list_lcm (nub (h::l))
9849 = list_lcm (nub l) by nub_cons, MEM h l
9850 = list_lcm l by induction hypothesis
9851 = list_lcm (h::l) by list_lcm_absorption, MEM h l
9852 If ~(MEM h l),
9853 list_lcm (nub (h::l))
9854 = list_lcm (h::nub l) by nub_cons, ~(MEM h l)
9855 = lcm h (list_lcm (nub l)) by list_lcm_cons
9856 = lcm h (list_lcm l) by induction hypothesis
9857 = list_lcm (h::l) by list_lcm_cons
9858*)
9859Theorem list_lcm_nub:
9860 !l. list_lcm (nub l) = list_lcm l
9861Proof
9862 Induct >-
9863 rw[nub_nil] >>
9864 metis_tac[nub_cons, list_lcm_cons, list_lcm_absorption]
9865QED
9866
9867(* Theorem: (set l1 = set l2) ==> (list_lcm (nub l1) = list_lcm (nub l2)) *)
9868(* Proof:
9869 By induction on l1.
9870 Base: !l2. (set [] = set l2) ==> (list_lcm (nub []) = list_lcm (nub l2))
9871 Note set [] = set l2 ==> l2 = [] by LIST_TO_SET_EQ_EMPTY
9872 Hence true.
9873 Step: !l2. (set l1 = set l2) ==> (list_lcm (nub l1) = list_lcm (nub l2)) ==>
9874 !h l2. (set (h::l1) = set l2) ==> (list_lcm (nub (h::l1)) = list_lcm (nub l2))
9875 If MEM h l1,
9876 Then h IN (set l1) by notation
9877 set (h::l1)
9878 = h INSERT set l1 by LIST_TO_SET
9879 = set l1 by ABSORPTION_RWT
9880 Thus set l1 = set l2,
9881 so list_lcm (nub (h::l1))
9882 = list_lcm (nub l1) by nub_cons, MEM h l1
9883 = list_lcm (nub l2) by induction hypothesis, set l1 = set l2
9884
9885 If ~(MEM h l1),
9886 Then set (h::l1) = set l2
9887 ==> ?p1 p2. nub l2 = p1 ++ [h] ++ p2
9888 and set l1 = set (p1 ++ p2) by LIST_TO_SET_REDUCTION
9889
9890 list_lcm (nub (h::l1))
9891 = list_lcm (h::nub l1) by nub_cons, ~(MEM h l1)
9892 = lcm h (list_lcm (nub l1)) by list_lcm_cons
9893 = lcm h (list_lcm (nub (p1 ++ p2))) by induction hypothesis
9894 = lcm h (list_lcm (p1 ++ p2)) by list_lcm_nub
9895 = lcm h (lcm (list_lcm p1) (list_lcm p2)) by list_lcm_append
9896 = lcm (list_lcm p1) (lcm h (list_lcm p2)) by LCM_ASSOC_COMM
9897 = lcm (list_lcm p1) (list_lcm (h::p2)) by list_lcm_append
9898 = lcm (list_lcm p1) (list_lcm ([h] ++ p2)) by CONS_APPEND
9899 = list_lcm (p1 ++ ([h] ++ p2)) by list_lcm_append
9900 = list_lcm (p1 ++ [h] ++ p2) by APPEND_ASSOC
9901 = list_lcm (nub l2) by above
9902*)
9903Theorem list_lcm_nub_eq_if_set_eq:
9904 !l1 l2. (set l1 = set l2) ==> (list_lcm (nub l1) = list_lcm (nub l2))
9905Proof
9906 Induct >-
9907 rw[LIST_TO_SET_EQ_EMPTY] >>
9908 rpt strip_tac >>
9909 Cases_on `MEM h l1` >-
9910 metis_tac[LIST_TO_SET, ABSORPTION_RWT, nub_cons] >>
9911 `?p1 p2. (nub l2 = p1 ++ [h] ++ p2) /\ (set l1 = set (p1 ++ p2))` by metis_tac[LIST_TO_SET_REDUCTION] >>
9912 `list_lcm (nub (h::l1)) = list_lcm (h::nub l1)` by rw[nub_cons] >>
9913 `_ = lcm h (list_lcm (nub l1))` by rw[list_lcm_cons] >>
9914 `_ = lcm h (list_lcm (nub (p1 ++ p2)))` by metis_tac[] >>
9915 `_ = lcm h (list_lcm (p1 ++ p2))` by rw[list_lcm_nub] >>
9916 `_ = lcm h (lcm (list_lcm p1) (list_lcm p2))` by rw[list_lcm_append] >>
9917 `_ = lcm (list_lcm p1) (lcm h (list_lcm p2))` by rw[LCM_ASSOC_COMM] >>
9918 `_ = lcm (list_lcm p1) (list_lcm ([h] ++ p2))` by rw[list_lcm_cons] >>
9919 metis_tac[list_lcm_append, APPEND_ASSOC]
9920QED
9921
9922(* Theorem: (set l1 = set l2) ==> (list_lcm l1 = list_lcm l2) *)
9923(* Proof:
9924 set l1 = set l2
9925 ==> list_lcm (nub l1) = list_lcm (nub l2) by list_lcm_nub_eq_if_set_eq
9926 ==> list_lcm l1 = list_lcm l2 by list_lcm_nub
9927*)
9928Theorem list_lcm_eq_if_set_eq:
9929 !l1 l2. (set l1 = set l2) ==> (list_lcm l1 = list_lcm l2)
9930Proof
9931 metis_tac[list_lcm_nub_eq_if_set_eq, list_lcm_nub]
9932QED
9933
9934(* ------------------------------------------------------------------------- *)
9935(* Set LCM by List LCM *)
9936(* ------------------------------------------------------------------------- *)
9937
9938(* Define LCM of a set *)
9939(* none works!
9940val set_lcm_def = Define`
9941 (set_lcm {} = 1) /\
9942 !s. FINITE s ==> !x. set_lcm (x INSERT s) = lcm x (set_lcm (s DELETE x))
9943`;
9944val set_lcm_def = Define`
9945 (set_lcm {} = 1) /\
9946 (!s. FINITE s ==> (set_lcm s = lcm (CHOICE s) (set_lcm (REST s))))
9947`;
9948val set_lcm_def = Define`
9949 set_lcm s = if s = {} then 1 else lcm (CHOICE s) (set_lcm (REST s))
9950`;
9951*)
9952Definition set_lcm_def:
9953 set_lcm s = list_lcm (SET_TO_LIST s)
9954End
9955
9956(* Theorem: set_lcm {} = 1 *)
9957(* Proof:
9958 set_lcm {}
9959 = lcm_list (SET_TO_LIST {}) by set_lcm_def
9960 = lcm_list [] by SET_TO_LIST_EMPTY
9961 = 1 by list_lcm_nil
9962*)
9963Theorem set_lcm_empty:
9964 set_lcm {} = 1
9965Proof
9966 rw[set_lcm_def]
9967QED
9968
9969(* Theorem: FINITE s /\ s <> {} ==> (set_lcm s = lcm (CHOICE s) (set_lcm (REST s))) *)
9970(* Proof:
9971 set_lcm s
9972 = list_lcm (SET_TO_LIST s) by set_lcm_def
9973 = list_lcm (CHOICE s::SET_TO_LIST (REST s)) by SET_TO_LIST_THM
9974 = lcm (CHOICE s) (list_lcm (SET_TO_LIST (REST s))) by list_lcm_cons
9975 = lcm (CHOICE s) (set_lcm (REST s)) by set_lcm_def
9976*)
9977Theorem set_lcm_nonempty:
9978 !s. FINITE s /\ s <> {} ==> (set_lcm s = lcm (CHOICE s) (set_lcm (REST s)))
9979Proof
9980 rw[set_lcm_def, SET_TO_LIST_THM, list_lcm_cons]
9981QED
9982
9983(* Theorem: set_lcm {x} = x *)
9984(* Proof:
9985 set_lcm {x}
9986 = list_lcm (SET_TO_LIST {x}) by set_lcm_def
9987 = list_lcm [x] by SET_TO_LIST_SING
9988 = x by list_lcm_sing
9989*)
9990Theorem set_lcm_sing:
9991 !x. set_lcm {x} = x
9992Proof
9993 rw_tac std_ss[set_lcm_def, SET_TO_LIST_SING, list_lcm_sing]
9994QED
9995
9996(* Theorem: set_lcm (set l) = list_lcm l *)
9997(* Proof:
9998 Let t = SET_TO_LIST (set l)
9999 Note FINITE (set l) by FINITE_LIST_TO_SET
10000 Then set t
10001 = set (SET_TO_LIST (set l)) by notation
10002 = set l by SET_TO_LIST_INV, FINITE (set l)
10003
10004 set_lcm (set l)
10005 = list_lcm (SET_TO_LIST (set l)) by set_lcm_def
10006 = list_lcm t by notation
10007 = list_lcm l by list_lcm_eq_if_set_eq, set t = set l
10008*)
10009Theorem set_lcm_eq_list_lcm:
10010 !l. set_lcm (set l) = list_lcm l
10011Proof
10012 rw[FINITE_LIST_TO_SET, SET_TO_LIST_INV, set_lcm_def, list_lcm_eq_if_set_eq]
10013QED
10014
10015(* Theorem: FINITE s ==> (set_lcm s = big_lcm s) *)
10016(* Proof:
10017 set_lcm s
10018 = list_lcm (SET_TO_LIST s) by set_lcm_def
10019 = big_lcm (set (SET_TO_LIST s)) by big_lcm_eq_list_lcm
10020 = big_lcm s by SET_TO_LIST_INV, FINITE s
10021*)
10022Theorem set_lcm_eq_big_lcm:
10023 !s. FINITE s ==> (big_lcm s = set_lcm s)
10024Proof
10025 metis_tac[set_lcm_def, big_lcm_eq_list_lcm, SET_TO_LIST_INV]
10026QED
10027
10028(* Theorem: FINITE s ==> !x. set_lcm (x INSERT s) = lcm x (set_lcm s) *)
10029(* Proof: by big_lcm_insert, set_lcm_eq_big_lcm *)
10030Theorem set_lcm_insert:
10031 !s. FINITE s ==> !x. set_lcm (x INSERT s) = lcm x (set_lcm s)
10032Proof
10033 rw[big_lcm_insert, GSYM set_lcm_eq_big_lcm]
10034QED
10035
10036(* Theorem: FINITE s /\ x IN s ==> x divides (set_lcm s) *)
10037(* Proof:
10038 Note FINITE s /\ x IN s
10039 ==> MEM x (SET_TO_LIST s) by MEM_SET_TO_LIST
10040 ==> x divides list_lcm (SET_TO_LIST s) by list_lcm_is_common_multiple
10041 or x divides (set_lcm s) by set_lcm_def
10042*)
10043Theorem set_lcm_is_common_multiple:
10044 !x s. FINITE s /\ x IN s ==> x divides (set_lcm s)
10045Proof
10046 rw[set_lcm_def] >>
10047 `MEM x (SET_TO_LIST s)` by rw[MEM_SET_TO_LIST] >>
10048 rw[list_lcm_is_common_multiple]
10049QED
10050
10051(* Theorem: FINITE s /\ (!x. x IN s ==> x divides m) ==> set_lcm s divides m *)
10052(* Proof:
10053 Note FINITE s
10054 ==> !x. x IN s <=> MEM x (SET_TO_LIST s) by MEM_SET_TO_LIST
10055 Thus list_lcm (SET_TO_LIST s) divides m by list_lcm_is_least_common_multiple
10056 or set_lcm s divides m by set_lcm_def
10057*)
10058Theorem set_lcm_is_least_common_multiple:
10059 !s m. FINITE s /\ (!x. x IN s ==> x divides m) ==> set_lcm s divides m
10060Proof
10061 metis_tac[set_lcm_def, MEM_SET_TO_LIST, list_lcm_is_least_common_multiple]
10062QED
10063
10064(* Theorem: FINITE s /\ PAIRWISE_COPRIME s ==> (set_lcm s = PROD_SET s) *)
10065(* Proof:
10066 By finite induction on s.
10067 Base: set_lcm {} = PROD_SET {}
10068 set_lcm {}
10069 = 1 by set_lcm_empty
10070 = PROD_SET {} by PROD_SET_EMPTY
10071 Step: PAIRWISE_COPRIME s ==> (set_lcm s = PROD_SET s) ==>
10072 e NOTIN s /\ PAIRWISE_COPRIME (e INSERT s) ==> set_lcm (e INSERT s) = PROD_SET (e INSERT s)
10073 Note !z. z IN s ==> coprime e z by IN_INSERT
10074 Thus coprime e (PROD_SET s) by every_coprime_prod_set_coprime
10075 set_lcm (e INSERT s)
10076 = lcm e (set_lcm s) by set_lcm_insert
10077 = lcm e (PROD_SET s) by induction hypothesis
10078 = e * (PROD_SET s) by LCM_COPRIME
10079 = PROD_SET (e INSERT s) by PROD_SET_INSERT, e NOTIN s
10080*)
10081Theorem pairwise_coprime_prod_set_eq_set_lcm:
10082 !s. FINITE s /\ PAIRWISE_COPRIME s ==> (set_lcm s = PROD_SET s)
10083Proof
10084 `!s. FINITE s ==> PAIRWISE_COPRIME s ==> (set_lcm s = PROD_SET s)` suffices_by rw[] >>
10085 Induct_on `FINITE` >>
10086 rpt strip_tac >-
10087 rw[set_lcm_empty, PROD_SET_EMPTY] >>
10088 fs[] >>
10089 `!z. z IN s ==> coprime e z` by metis_tac[] >>
10090 `coprime e (PROD_SET s)` by rw[every_coprime_prod_set_coprime] >>
10091 `set_lcm (e INSERT s) = lcm e (set_lcm s)` by rw[set_lcm_insert] >>
10092 `_ = lcm e (PROD_SET s)` by rw[] >>
10093 `_ = e * (PROD_SET s)` by rw[LCM_COPRIME] >>
10094 `_ = PROD_SET (e INSERT s)` by rw[PROD_SET_INSERT] >>
10095 rw[]
10096QED
10097
10098(* This is a generalisation of LCM_COPRIME |- !m n. coprime m n ==> (lcm m n = m * n) *)
10099
10100(* Theorem: FINITE s /\ PAIRWISE_COPRIME s /\ (!x. x IN s ==> x divides m) ==> (PROD_SET s) divides m *)
10101(* Proof:
10102 Note PROD_SET s = set_lcm s by pairwise_coprime_prod_set_eq_set_lcm
10103 and set_lcm s divides m by set_lcm_is_least_common_multiple
10104 ==> (PROD_SET s) divides m
10105*)
10106Theorem pairwise_coprime_prod_set_divides:
10107 !s m. FINITE s /\ PAIRWISE_COPRIME s /\ (!x. x IN s ==> x divides m) ==> (PROD_SET s) divides m
10108Proof
10109 rw[set_lcm_is_least_common_multiple, GSYM pairwise_coprime_prod_set_eq_set_lcm]
10110QED
10111
10112(* ------------------------------------------------------------------------- *)
10113(* Nair's Trick - using List LCM directly *)
10114(* ------------------------------------------------------------------------- *)
10115
10116(* Overload on consecutive LCM *)
10117Overload lcm_run = ``\n. list_lcm [1 .. n]``
10118
10119(* Theorem: lcm_run n = FOLDL lcm 1 [1 .. n] *)
10120(* Proof:
10121 lcm_run n
10122 = list_lcm [1 .. n] by notation
10123 = FOLDL lcm 1 [1 .. n] by list_lcm_by_FOLDL
10124*)
10125Theorem lcm_run_by_FOLDL:
10126 !n. lcm_run n = FOLDL lcm 1 [1 .. n]
10127Proof
10128 rw[list_lcm_by_FOLDL]
10129QED
10130
10131(* Theorem: lcm_run n = FOLDL lcm 1 [1 .. n] *)
10132(* Proof:
10133 lcm_run n
10134 = list_lcm [1 .. n] by notation
10135 = FOLDR lcm 1 [1 .. n] by list_lcm_by_FOLDR
10136*)
10137Theorem lcm_run_by_FOLDR:
10138 !n. lcm_run n = FOLDR lcm 1 [1 .. n]
10139Proof
10140 rw[list_lcm_by_FOLDR]
10141QED
10142
10143(* Theorem: lcm_run 0 = 1 *)
10144(* Proof:
10145 lcm_run 0
10146 = list_lcm [1 .. 0] by notation
10147 = list_lcm [] by listRangeINC_EMPTY, 0 < 1
10148 = 1 by list_lcm_nil
10149*)
10150Theorem lcm_run_0:
10151 lcm_run 0 = 1
10152Proof
10153 rw[listRangeINC_EMPTY]
10154QED
10155
10156(* Theorem: lcm_run 1 = 1 *)
10157(* Proof:
10158 lcm_run 1
10159 = list_lcm [1 .. 1] by notation
10160 = list_lcm [1] by leibniz_vertical_0
10161 = 1 by list_lcm_sing
10162*)
10163Theorem lcm_run_1:
10164 lcm_run 1 = 1
10165Proof
10166 rw[leibniz_vertical_0, list_lcm_sing]
10167QED
10168
10169(* Theorem alias *)
10170Theorem lcm_run_suc = list_lcm_suc;
10171(* val lcm_run_suc = |- !n. lcm_run (n + 1) = lcm (n + 1) (lcm_run n): thm *)
10172
10173(* Theorem: 0 < lcm_run n *)
10174(* Proof:
10175 Note EVERY_POSITIVE [1 .. n] by listRangeINC_EVERY
10176 so lcm_run n
10177 = list_lcm [1 .. n] by notation
10178 > 0 by list_lcm_pos
10179*)
10180Theorem lcm_run_pos:
10181 !n. 0 < lcm_run n
10182Proof
10183 rw[list_lcm_pos, listRangeINC_EVERY]
10184QED
10185
10186(* Theorem: (lcm_run 2 = 2) /\ (lcm_run 3 = 6) /\ (lcm_run 4 = 12) /\ (lcm_run 5 = 60) /\ ... *)
10187(* Proof: by evaluation *)
10188Theorem lcm_run_small:
10189 (lcm_run 2 = 2) /\ (lcm_run 3 = 6) /\ (lcm_run 4 = 12) /\ (lcm_run 5 = 60) /\
10190 (lcm_run 6 = 60) /\ (lcm_run 7 = 420) /\ (lcm_run 8 = 840) /\ (lcm_run 9 = 2520)
10191Proof
10192 EVAL_TAC
10193QED
10194
10195(* Theorem: (n + 1) divides lcm_run (n + 1) /\ (lcm_run n) divides lcm_run (n + 1) *)
10196(* Proof:
10197 If n = 0,
10198 Then 0 + 1 = 1 by arithmetic
10199 and lcm_run 0 = 1 by lcm_run_0
10200 Hence true by ONE_DIVIDES_ALL
10201 If n <> 0,
10202 Then n - 1 + 1 = n by arithmetic, 0 < n
10203 lcm_run (n + 1)
10204 = list_lcm [1 .. (n + 1)] by notation
10205 = list_lcm (SNOC (n + 1) [1 .. n]) by leibniz_vertical_snoc
10206 = lcm (n + 1) (list_lcm [1 .. n]) by list_lcm_snoc]
10207 = lcm (n + 1) (lcm_run n) by notation
10208 Hence true by LCM_DIVISORS
10209*)
10210Theorem lcm_run_divisors:
10211 !n. (n + 1) divides lcm_run (n + 1) /\ (lcm_run n) divides lcm_run (n + 1)
10212Proof
10213 strip_tac >>
10214 Cases_on `n = 0` >-
10215 rw[lcm_run_0] >>
10216 `(n - 1 + 1 = n) /\ (n - 1 + 2 = n + 1)` by decide_tac >>
10217 `lcm_run (n + 1) = list_lcm (SNOC (n + 1) [1 .. n])` by metis_tac[leibniz_vertical_snoc] >>
10218 `_ = lcm (n + 1) (lcm_run n)` by rw[list_lcm_snoc] >>
10219 rw[LCM_DIVISORS]
10220QED
10221
10222(* Theorem: lcm_run n <= lcm_run (n + 1) *)
10223(* Proof:
10224 Note lcm_run n divides lcm_run (n + 1) by lcm_run_divisors
10225 and 0 < lcm_run (n + 1) ] by lcm_run_pos
10226 so lcm_run n <= lcm_run (n + 1) by DIVIDES_LE
10227*)
10228Theorem lcm_run_monotone[allow_rebind]:
10229 !n. lcm_run n <= lcm_run (n + 1)
10230Proof rw[lcm_run_divisors, lcm_run_pos, DIVIDES_LE]
10231QED
10232
10233(* Theorem: 2 ** n <= lcm_run (n + 1) *)
10234(* Proof:
10235 lcm_run (n + 1)
10236 = list_lcm [1 .. (n + 1)] by notation
10237 >= 2 ** n by lcm_lower_bound
10238*)
10239Theorem lcm_run_lower = lcm_lower_bound;
10240(*
10241val lcm_run_lower = |- !n. 2 ** n <= lcm_run (n + 1): thm
10242*)
10243
10244(* Theorem: !n k. k <= n ==> leibniz n k divides lcm_run (n + 1) *)
10245(* Proof: by notation, leibniz_vertical_divisor *)
10246Theorem lcm_run_leibniz_divisor = leibniz_vertical_divisor;
10247(*
10248val lcm_run_leibniz_divisor = |- !n k. k <= n ==> leibniz n k divides lcm_run (n + 1): thm
10249*)
10250
10251(* Theorem: n * 4 ** n <= lcm_run (2 * n + 1) *)
10252(* Proof:
10253 If n = 0, LHS = 0, trivially true.
10254 If n <> 0, 0 < n.
10255 Let m = 2 * n.
10256
10257 Claim: (m + 1) * binomial m n divides lcm_run (m + 1) [1]
10258 Proof: Note n <= m by LESS_MONO_MULT, 1 <= 2
10259 ==> (leibniz m n) divides lcm_run (m + 1) by lcm_run_leibniz_divisor, n <= m
10260 or (m + 1) * binomial m n divides lcm_run (m + 1) by leibniz_def
10261
10262 Claim: n * binomial m n divides lcm_run (m + 1) [2]
10263 Proof: Note 0 < m /\ n <= m - 1 by 0 < n
10264 and m - 1 + 1 = m by 0 < m
10265 Thus (leibniz (m - 1) n) divides lcm_run m by lcm_run_leibniz_divisor, n <= m - 1
10266 Note (lcm_run m) divides lcm_run (m + 1) by lcm_run_divisors
10267 so (leibniz (m - 1) n) divides lcm_run (m + 1) by DIVIDES_TRANS
10268 and leibniz (m - 1) n
10269 = (m - n) * binomial m n by leibniz_up_alt
10270 = n * binomial m n by m - n = n
10271
10272 Note coprime n (m + 1) by GCD_EUCLID, GCD_1, 1 < n
10273 Thus lcm (n * binomial m n) ((m + 1) * binomial m n)
10274 = n * (m + 1) * binomial m n by LCM_COMMON_COPRIME
10275 = n * ((m + 1) * binomial m n) by MULT_ASSOC
10276 = n * leibniz m n by leibniz_def
10277 ==> n * leibniz m n divides lcm_run (m + 1) by LCM_DIVIDES, [1], [2]
10278 Note 0 < lcm_run (m + 1) by lcm_run_pos
10279 or n * leibniz m n <= lcm_run (m + 1) by DIVIDES_LE, 0 < lcm_run (m + 1)
10280 Now 4 ** n <= leibniz m n by leibniz_middle_lower
10281 so n * 4 ** n <= n * leibniz m n by LESS_MONO_MULT, MULT_COMM
10282 or n * 4 ** n <= lcm_run (m + 1) by LESS_EQ_TRANS
10283*)
10284Theorem lcm_run_lower_odd:
10285 !n. n * 4 ** n <= lcm_run (2 * n + 1)
10286Proof
10287 rpt strip_tac >>
10288 Cases_on `n = 0` >-
10289 rw[] >>
10290 `0 < n` by decide_tac >>
10291 qabbrev_tac `m = 2 * n` >>
10292 `(m + 1) * binomial m n divides lcm_run (m + 1)` by
10293 (`n <= m` by rw[Abbr`m`] >>
10294 metis_tac[lcm_run_leibniz_divisor, leibniz_def]) >>
10295 `n * binomial m n divides lcm_run (m + 1)` by
10296 (`0 < m /\ n <= m - 1` by rw[Abbr`m`] >>
10297 `m - 1 + 1 = m` by decide_tac >>
10298 `(leibniz (m - 1) n) divides lcm_run m` by metis_tac[lcm_run_leibniz_divisor] >>
10299 `(lcm_run m) divides lcm_run (m + 1)` by rw[lcm_run_divisors] >>
10300 `leibniz (m - 1) n = (m - n) * binomial m n` by rw[leibniz_up_alt] >>
10301 `_ = n * binomial m n` by rw[Abbr`m`] >>
10302 metis_tac[DIVIDES_TRANS]) >>
10303 `coprime n (m + 1)` by rw[GCD_EUCLID, Abbr`m`] >>
10304 `lcm (n * binomial m n) ((m + 1) * binomial m n) = n * (m + 1) * binomial m n` by rw[LCM_COMMON_COPRIME] >>
10305 `_ = n * leibniz m n` by rw[leibniz_def, MULT_ASSOC] >>
10306 `n * leibniz m n divides lcm_run (m + 1)` by metis_tac[LCM_DIVIDES] >>
10307 `n * leibniz m n <= lcm_run (m + 1)` by rw[DIVIDES_LE, lcm_run_pos] >>
10308 `4 ** n <= leibniz m n` by rw[leibniz_middle_lower, Abbr`m`] >>
10309 metis_tac[LESS_MONO_MULT, MULT_COMM, LESS_EQ_TRANS]
10310QED
10311
10312(* Theorem: n * 4 ** n <= lcm_run (2 * (n + 1)) *)
10313(* Proof:
10314 lcm_run (2 * (n + 1))
10315 = lcm_run (2 * n + 2) by arithmetic
10316 >= lcm_run (2 * n + 1) by lcm_run_monotone
10317 >= n * 4 ** n by lcm_run_lower_odd
10318*)
10319Theorem lcm_run_lower_even:
10320 !n. n * 4 ** n <= lcm_run (2 * (n + 1))
10321Proof
10322 rpt strip_tac >>
10323 `2 * (n + 1) = 2 * n + 1 + 1` by decide_tac >>
10324 metis_tac[lcm_run_monotone, lcm_run_lower_odd, LESS_EQ_TRANS]
10325QED
10326
10327(* Theorem: ODD n ==> (HALF n) * HALF (2 ** n) <= lcm_run n *)
10328(* Proof:
10329 Let k = HALF n.
10330 Then n = 2 * k + 1 by ODD_HALF
10331 and HALF (2 ** n)
10332 = HALF (2 ** (2 * k + 1)) by above
10333 = HALF (2 ** (SUC (2 * k))) by ADD1
10334 = HALF (2 * 2 ** (2 * k)) by EXP
10335 = 2 ** (2 * k) by HALF_TWICE
10336 = 4 ** k by EXP_EXP_MULT
10337 Since k * 4 ** k <= lcm_run (2 * k + 1) by lcm_run_lower_odd
10338 The result follows.
10339*)
10340Theorem lcm_run_odd_lower:
10341 !n. ODD n ==> (HALF n) * HALF (2 ** n) <= lcm_run n
10342Proof
10343 rpt strip_tac >>
10344 qabbrev_tac `k = HALF n` >>
10345 `n = 2 * k + 1` by rw[ODD_HALF, Abbr`k`] >>
10346 `HALF (2 ** n) = HALF (2 ** (SUC (2 * k)))` by rw[ADD1] >>
10347 `_ = HALF (2 * 2 ** (2 * k))` by rw[EXP] >>
10348 `_ = 2 ** (2 * k)` by rw[HALF_TWICE] >>
10349 `_ = 4 ** k` by rw[EXP_EXP_MULT] >>
10350 metis_tac[lcm_run_lower_odd]
10351QED
10352
10353Theorem HALF_MULT_EVEN'[local] = ONCE_REWRITE_RULE [MULT_COMM] HALF_MULT_EVEN
10354
10355(* Theorem: EVEN n ==> HALF (n - 2) * HALF (HALF (2 ** n)) <= lcm_run n *)
10356(* Proof:
10357 If n = 0, HALF (n - 2) = 0, so trivially true.
10358 If n <> 0,
10359 Let h = HALF n.
10360 Then n = 2 * h by EVEN_HALF
10361 Note h <> 0 by n <> 0
10362 so ?k. h = k + 1 by num_CASES, ADD1
10363 or n = 2 * k + 2 by n = 2 * (k + 1)
10364 and HALF (HALF (2 ** n))
10365 = HALF (HALF (2 ** (2 * k + 2))) by above
10366 = HALF (HALF (2 ** SUC (SUC (2 * k)))) by ADD1
10367 = HALF (HALF (2 * (2 * 2 ** (2 * k)))) by EXP
10368 = 2 ** (2 * k) by HALF_TWICE
10369 = 4 ** k by EXP_EXP_MULT
10370 Also n - 2 = 2 * k by 0 < n, n = 2 * k + 2
10371 so HALF (n - 2) = k by HALF_TWICE
10372 Since k * 4 ** k <= lcm_run (2 * (k + 1)) by lcm_run_lower_even
10373 The result follows.
10374*)
10375Theorem lcm_run_even_lower:
10376 !n. EVEN n ==> HALF (n - 2) * HALF (HALF (2 ** n)) <= lcm_run n
10377Proof
10378 rpt strip_tac >>
10379 Cases_on `n = 0` >- rw[] >>
10380 qabbrev_tac `h = HALF n` >>
10381 `n = 2 * h` by rw[EVEN_HALF, Abbr`h`] >>
10382 `h <> 0` by rw[Abbr`h`] >>
10383 `?k. h = k + 1` by metis_tac[num_CASES, ADD1] >>
10384 `HALF (HALF (2 ** n)) = HALF (HALF (2 ** SUC (SUC (2 * k))))` by simp[ADD1] >>
10385 `_ = HALF (HALF (2 * (2 * 2 ** (2 * k))))` by rw[EXP, HALF_MULT_EVEN'] >>
10386 `_ = 2 ** (2 * k)` by rw[HALF_TWICE] >>
10387 `_ = 4 ** k` by rw[EXP_EXP_MULT] >>
10388 `n - 2 = 2 * k` by decide_tac >>
10389 `HALF (n - 2) = k` by rw[HALF_TWICE] >>
10390 metis_tac[lcm_run_lower_even]
10391QED
10392
10393(* Theorem: ODD n /\ 5 <= n ==> 2 ** n <= lcm_run n *)
10394(* Proof:
10395 This follows by lcm_run_odd_lower
10396 if we can show: 2 ** n <= HALF n * HALF (2 ** n)
10397
10398 Note HALF 5 = 2 by arithmetic
10399 and HALF 5 <= HALF n by DIV_LE_MONOTONE, 0 < 2
10400 Also n <> 0 by 5 <= n
10401 so ?m. n = SUC m by num_CASES
10402 HALF n * HALF (2 ** n)
10403 = HALF n * HALF (2 * 2 ** m) by EXP
10404 = HALF n * 2 ** m by HALF_TWICE
10405 >= 2 * 2 ** m by LESS_MONO_MULT
10406 = 2 ** (SUC m) by EXP
10407 = 2 ** n by n = SUC m
10408*)
10409Theorem lcm_run_odd_lower_alt:
10410 !n. ODD n /\ 5 <= n ==> 2 ** n <= lcm_run n
10411Proof
10412 rpt strip_tac >>
10413 `2 ** n <= HALF n * HALF (2 ** n)` by
10414 (`HALF 5 = 2` by EVAL_TAC >>
10415 `HALF 5 <= HALF n` by rw[DIV_LE_MONOTONE] >>
10416 `n <> 0` by decide_tac >>
10417 `?m. n = SUC m` by metis_tac[num_CASES] >>
10418 `HALF n * HALF (2 ** n) = HALF n * HALF (2 * 2 ** m)` by rw[EXP] >>
10419 `_ = HALF n * 2 ** m` by rw[HALF_TWICE] >>
10420 `2 * 2 ** m <= HALF n * 2 ** m` by rw[LESS_MONO_MULT] >>
10421 rw[EXP]) >>
10422 metis_tac[lcm_run_odd_lower, LESS_EQ_TRANS]
10423QED
10424
10425(* Theorem: EVEN n /\ 8 <= n ==> 2 ** n <= lcm_run n *)
10426(* Proof:
10427 If n = 8,
10428 Then 2 ** 8 = 256 by arithmetic
10429 and lcm_run 8 = 840 by lcm_run_small
10430 Thus true.
10431 If n <> 8,
10432 Note ODD 9 by arithmetic
10433 so n <> 9 by ODD_EVEN
10434 or 10 <= n by 8 <= n, n <> 9
10435 This follows by lcm_run_even_lower
10436 if we can show: 2 ** n <= HALF (n - 2) * HALF (HALF (2 ** n))
10437
10438 Let m = n - 2.
10439 Then 8 <= m by arithmetic
10440 or HALF 8 <= HALF m by DIV_LE_MONOTONE, 0 < 2
10441 and HALF 8 = 4 = 2 * 2 by arithmetic
10442 Now n = SUC (SUC m) by arithmetic
10443 HALF m * HALF (HALF (2 ** n))
10444 = HALF m * HALF (HALF (2 ** (SUC (SUC m)))) by above
10445 = HALF m * HALF (HALF (2 * (2 * 2 ** m))) by EXP
10446 = HALF m * 2 ** m by HALF_TWICE
10447 >= 4 * 2 ** m by LESS_MONO_MULT
10448 = 2 * (2 * 2 ** m) by MULT_ASSOC
10449 = 2 ** (SUC (SUC m)) by EXP
10450 = 2 ** n by n = SUC (SUC m)
10451*)
10452Theorem lcm_run_even_lower_alt:
10453 !n. EVEN n /\ 8 <= n ==> 2 ** n <= lcm_run n
10454Proof
10455 rpt strip_tac >>
10456 Cases_on `n = 8` >- rw[lcm_run_small] >>
10457 `2 ** n <= HALF (n - 2) * HALF (HALF (2 ** n))`
10458 by (`ODD 9` by rw[] >>
10459 `n <> 9` by metis_tac[ODD_EVEN] >>
10460 `8 <= n - 2` by decide_tac >>
10461 qabbrev_tac `m = n - 2` >>
10462 `n = SUC (SUC m)` by rw[Abbr`m`] >>
10463 ‘HALF m * HALF (HALF (2 ** n)) =
10464 HALF m * HALF (HALF (2 * (2 * 2 ** m)))’ by rw[EXP, HALF_MULT_EVEN'] >>
10465 `_ = HALF m * 2 ** m` by rw[HALF_TWICE] >>
10466 `HALF 8 <= HALF m` by rw[DIV_LE_MONOTONE] >>
10467 `HALF 8 = 4` by EVAL_TAC >>
10468 `2 * (2 * 2 ** m) <= HALF m * 2 ** m` by rw[LESS_MONO_MULT] >>
10469 rw[EXP]) >>
10470 metis_tac[lcm_run_even_lower, LESS_EQ_TRANS]
10471QED
10472
10473(* Theorem: 7 <= n ==> 2 ** n <= lcm_run n *)
10474(* Proof:
10475 If EVEN n,
10476 Node ODD 7 by arithmetic
10477 so n <> 7 by EVEN_ODD
10478 or 8 <= n by arithmetic
10479 Hence true by lcm_run_even_lower_alt
10480 If ~EVEN n, then ODD n by EVEN_ODD
10481 Note 7 <= n ==> 5 <= n by arithmetic
10482 Hence true by lcm_run_odd_lower_alt
10483*)
10484Theorem lcm_run_lower_better:
10485 !n. 7 <= n ==> 2 ** n <= lcm_run n
10486Proof
10487 rpt strip_tac >>
10488 `EVEN n \/ ODD n` by rw[EVEN_OR_ODD] >| [
10489 `ODD 7` by rw[] >>
10490 `n <> 7` by metis_tac[ODD_EVEN] >>
10491 rw[lcm_run_even_lower_alt],
10492 rw[lcm_run_odd_lower_alt]
10493 ]
10494QED
10495
10496
10497(* ------------------------------------------------------------------------- *)
10498(* Nair's Trick -- rework *)
10499(* ------------------------------------------------------------------------- *)
10500
10501(*
10502Picture:
10503leibniz_lcm_property |- !n. lcm_run (n + 1) = list_lcm (leibniz_horizontal n)
10504leibniz_horizontal_mem |- !n k. k <= n ==> MEM (leibniz n k) (leibniz_horizontal n)
10505so:
10506lcm_run (2*n + 1) = list_lcm (leibniz_horizontal (2*n))
10507and leibniz_horizontal (2*n) has members: 0, 1, 2, ...., n, (n + 1), ....., (2*n)
10508note: n <= 2*n, always, (n+1) <= 2*n = (n+n) when 1 <= n.
10509thus:
10510Both B = (leibniz 2*n n) and C = (leibniz 2*n n+1) divides lcm_run (2*n + 1),
10511 or (lcm B C) divides lcm_run (2*n + 1).
10512But (lcm B C) = (lcm B A) where A = (leibniz 2*n-1 n).
10513By leibniz_def |- !n k. leibniz n k = (n + 1) * binomial n k
10514By leibniz_up_alt |- !n. 0 < n ==> !k. leibniz (n - 1) k = (n - k) * binomial n k
10515 so B = (2*n + 1) * binomial 2*n n
10516and A = (2*n - n) * binomial 2*n n = n * binomial 2*n n
10517and lcm B A = lcm ((2*n + 1) * binomial 2*n n) (n * binomial 2*n n)
10518 = (lcm (2*n + 1) n) * binomial 2*n n by LCM_COMMON_FACTOR
10519 = n * (2*n + 1) * binomial 2*n n by coprime (2*n+1) n
10520 = n * (leibniz 2*n n) by leibniz_def
10521*)
10522
10523(* Theorem: 0 < n ==> n * (leibniz (2 * n) n) divides lcm_run (2 * n + 1) *)
10524(* Proof:
10525 Note 1 <= n by 0 < n
10526 Let m = 2 * n,
10527 Then n <= 2 * n = m, and
10528 n + 1 <= n + n = m by arithmetic
10529 Also coprime n (m + 1) by GCD_EUCLID
10530
10531 Identify a triplet:
10532 Let t = triplet (m - 1) n
10533 Then t.a = leibniz (m - 1) n by triplet_def
10534 t.b = leibniz m n by triplet_def
10535 t.c = leibniz m (n + 1) by triplet_def
10536
10537 Note MEM t.b (leibniz_horizontal m) by leibniz_horizontal_mem, n <= m
10538 and MEM t.c (leibniz_horizontal m) by leibniz_horizontal_mem, n + 1 <= m
10539 ==> lcm t.b t.c divides list_lcm (leibniz_horizontal m) by list_lcm_divisor_lcm_pair
10540 = lcm_run (m + 1) by leibniz_lcm_property
10541
10542 Let k = binomial m n.
10543 lcm t.b t.c
10544 = lcm t.b t.a by leibniz_triplet_lcm
10545 = lcm ((m + 1) * k) t.a by leibniz_def
10546 = lcm ((m + 1) * k) ((m - n) * k) by leibniz_up_alt
10547 = lcm ((m + 1) * k) (n * k) by m = 2 * n
10548 = n * (m + 1) * k by LCM_COMMON_COPRIME, LCM_SYM, coprime n (m + 1)
10549 = n * leibniz m n by leibniz_def
10550 Thus (n * leibniz m n) divides lcm_run (m + 1)
10551*)
10552Theorem lcm_run_odd_factor:
10553 !n. 0 < n ==> n * (leibniz (2 * n) n) divides lcm_run (2 * n + 1)
10554Proof
10555 rpt strip_tac >>
10556 qabbrev_tac `m = 2 * n` >>
10557 `n <= m /\ n + 1 <= m` by rw[Abbr`m`] >>
10558 `coprime n (m + 1)` by rw[GCD_EUCLID, Abbr`m`] >>
10559 qabbrev_tac `t = triplet (m - 1) n` >>
10560 `t.a = leibniz (m - 1) n` by rw[triplet_def, Abbr`t`] >>
10561 `t.b = leibniz m n` by rw[triplet_def, Abbr`t`] >>
10562 `t.c = leibniz m (n + 1)` by rw[triplet_def, Abbr`t`] >>
10563 `t.b divides lcm_run (m + 1)` by metis_tac[lcm_run_leibniz_divisor] >>
10564 `t.c divides lcm_run (m + 1)` by metis_tac[lcm_run_leibniz_divisor] >>
10565 `lcm t.b t.c divides lcm_run (m + 1)` by rw[LCM_IS_LEAST_COMMON_MULTIPLE] >>
10566 qabbrev_tac `k = binomial m n` >>
10567 `lcm t.b t.c = lcm t.b t.a` by rw[leibniz_triplet_lcm, Abbr`t`] >>
10568 `_ = lcm ((m + 1) * k) ((m - n) * k)` by rw[leibniz_def, leibniz_up_alt, Abbr`k`] >>
10569 `_ = lcm ((m + 1) * k) (n * k)` by rw[Abbr`m`] >>
10570 `_ = n * (m + 1) * k` by rw[LCM_COMMON_COPRIME, LCM_SYM] >>
10571 `_ = n * leibniz m n` by rw[leibniz_def, Abbr`k`] >>
10572 metis_tac[]
10573QED
10574
10575(* Theorem: n * 4 ** n <= lcm_run (2 * n + 1) *)
10576(* Proof:
10577 If n = 0, LHS = 0, trivially true.
10578 If n <> 0, 0 < n.
10579 Note 4 ** n <= leibniz (2 * n) n by leibniz_middle_lower
10580 so n * 4 ** n <= n * leibniz (2 * n) n by LESS_MONO_MULT, MULT_COMM
10581 Let k = n * leibniz (2 * n) n.
10582 Then k divides lcm_run (2 * n + 1) by lcm_run_odd_factor
10583 Now 0 < lcm_run (2 * n + 1) by lcm_run_pos
10584 so k <= lcm_run (2 * n + 1) by DIVIDES_LE
10585 Overall n * 4 ** n <= lcm_run (2 * n + 1) by LESS_EQ_TRANS
10586*)
10587Theorem lcm_run_lower_odd[allow_rebind]:
10588 !n. n * 4 ** n <= lcm_run (2 * n + 1)
10589Proof
10590 rpt strip_tac >>
10591 Cases_on `n = 0` >-
10592 rw[] >>
10593 `0 < n` by decide_tac >>
10594 `4 ** n <= leibniz (2 * n) n` by rw[leibniz_middle_lower] >>
10595 `n * 4 ** n <= n * leibniz (2 * n) n` by rw[LESS_MONO_MULT, MULT_COMM] >>
10596 `n * leibniz (2 * n) n <= lcm_run (2 * n + 1)` by rw[lcm_run_odd_factor, lcm_run_pos, DIVIDES_LE] >>
10597 rw[LESS_EQ_TRANS]
10598QED
10599
10600(* Another direct proof of the same theorem *)
10601
10602(* Theorem: n * 4 ** n <= lcm_run (2 * n + 1) *)
10603(* Proof:
10604 If n = 0, LHS = 0, trivially true.
10605 If n <> 0, 0 < n, or 1 <= n by arithmetic
10606
10607 Let m = 2 * n,
10608 Then n <= 2 * n = m, and
10609 n + 1 <= n + n = m by arithmetic, 1 <= n
10610 Also coprime n (m + 1) by GCD_EUCLID
10611
10612 Identify a triplet:
10613 Let t = triplet (m - 1) n
10614 Then t.a = leibniz (m - 1) n by triplet_def
10615 t.b = leibniz m n by triplet_def
10616 t.c = leibniz m (n + 1) by triplet_def
10617
10618 Note MEM t.b (leibniz_horizontal m) by leibniz_horizontal_mem, n <= m
10619 and MEM t.c (leibniz_horizontal m) by leibniz_horizontal_mem, n + 1 <= m
10620 and POSITIVE (leibniz_horizontal m) by leibniz_horizontal_pos_alt
10621 ==> lcm t.b t.c <= list_lcm (leibniz_horizontal m) by list_lcm_lower_by_lcm_pair
10622 = lcm_run (m + 1) by leibniz_lcm_property
10623
10624 Let k = binomial m n.
10625 lcm t.b t.c
10626 = lcm t.b t.a by leibniz_triplet_lcm
10627 = lcm ((m + 1) * k) t.a by leibniz_def
10628 = lcm ((m + 1) * k) ((m - n) * k) by leibniz_up_alt
10629 = lcm ((m + 1) * k) (n * k) by m = 2 * n
10630 = n * (m + 1) * k by LCM_COMMON_COPRIME, LCM_SYM, coprime n (m + 1)
10631 = n * leibniz m n by leibniz_def
10632 Thus (n * leibniz m n) divides lcm_run (m + 1)
10633
10634 Note 4 ** n <= leibniz m n by leibniz_middle_lower
10635 so n * 4 ** n <= n * leibniz m n by LESS_MONO_MULT, MULT_COMM
10636 Overall n * 4 ** n <= lcm_run (2 * n + 1) by LESS_EQ_TRANS
10637*)
10638Theorem lcm_run_lower_odd[allow_rebind]:
10639 !n. n * 4 ** n <= lcm_run (2 * n + 1)
10640Proof
10641 rpt strip_tac >>
10642 Cases_on ‘n = 0’ >-
10643 rw[] >>
10644 qabbrev_tac ‘m = 2 * n’ >>
10645 ‘n <= m /\ n + 1 <= m’ by rw[Abbr‘m’] >>
10646 ‘coprime n (m + 1)’ by rw[GCD_EUCLID, Abbr‘m’] >>
10647 qabbrev_tac ‘t = triplet (m - 1) n’ >>
10648 ‘t.a = leibniz (m - 1) n’ by rw[triplet_def, Abbr‘t’] >>
10649 ‘t.b = leibniz m n’ by rw[triplet_def, Abbr‘t’] >>
10650 ‘t.c = leibniz m (n + 1)’ by rw[triplet_def, Abbr‘t’] >>
10651 ‘MEM t.b (leibniz_horizontal m)’ by metis_tac[leibniz_horizontal_mem] >>
10652 ‘MEM t.c (leibniz_horizontal m)’ by metis_tac[leibniz_horizontal_mem] >>
10653 ‘POSITIVE (leibniz_horizontal m)’ by metis_tac[leibniz_horizontal_pos_alt] >>
10654 ‘lcm t.b t.c <= lcm_run (m + 1)’ by metis_tac[leibniz_lcm_property, list_lcm_lower_by_lcm_pair] >>
10655 ‘lcm t.b t.c = n * leibniz m n’ by
10656 (qabbrev_tac ‘k = binomial m n’ >>
10657 ‘lcm t.b t.c = lcm t.b t.a’ by rw[leibniz_triplet_lcm, Abbr‘t’] >>
10658 ‘_ = lcm ((m + 1) * k) ((m - n) * k)’ by rw[leibniz_def, leibniz_up_alt, Abbr‘k’] >>
10659 ‘_ = lcm ((m + 1) * k) (n * k)’ by rw[Abbr‘m’] >>
10660 ‘_ = n * (m + 1) * k’ by rw[LCM_COMMON_COPRIME, LCM_SYM] >>
10661 ‘_ = n * leibniz m n’ by rw[leibniz_def, Abbr‘k’] >>
10662 rw[]) >>
10663 ‘4 ** n <= leibniz m n’ by rw[leibniz_middle_lower, Abbr‘m’] >>
10664 ‘n * 4 ** n <= n * leibniz m n’ by rw[LESS_MONO_MULT] >>
10665 metis_tac[LESS_EQ_TRANS]
10666QED
10667
10668(* Theorem: ODD n ==> (2 ** n <= lcm_run n <=> 5 <= n) *)
10669(* Proof:
10670 If part: 2 ** n <= lcm_run n ==> 5 <= n
10671 By contradiction, suppose n < 5.
10672 By ODD n, n = 1 or n = 3.
10673 If n = 1, LHS = 2 ** 1 = 2 by arithmetic
10674 RHS = lcm_run 1 = 1 by lcm_run_1
10675 Hence false.
10676 If n = 3, LHS = 2 ** 3 = 8 by arithmetic
10677 RHS = lcm_run 3 = 6 by lcm_run_small
10678 Hence false.
10679 Only-if part: 5 <= n ==> 2 ** n <= lcm_run n
10680 Let h = HALF n.
10681 Then n = 2 * h + 1 by ODD_HALF
10682 so 4 <= 2 * h by 5 - 1 = 4
10683 or 2 <= h by arithmetic
10684 ==> 2 * 4 ** h <= h * 4 ** h by LESS_MONO_MULT
10685 But 2 * 4 ** h
10686 = 2 * (2 ** 2) ** h by arithmetic
10687 = 2 * 2 ** (2 * h) by EXP_EXP_MULT
10688 = 2 ** SUC (2 * h) by EXP
10689 = 2 ** n by ADD1, n = 2 * h + 1
10690 With h * 4 ** h <= lcm_run n by lcm_run_lower_odd
10691 or 2 ** n <= lcm_run n by LESS_EQ_TRANS
10692*)
10693Theorem lcm_run_lower_odd_iff:
10694 !n. ODD n ==> (2 ** n <= lcm_run n <=> 5 <= n)
10695Proof
10696 rw[EQ_IMP_THM] >| [
10697 spose_not_then strip_assume_tac >>
10698 `n < 5` by decide_tac >>
10699 `EVEN 0 /\ EVEN 2 /\ EVEN 4` by rw[] >>
10700 `n <> 0 /\ n <> 2 /\ n <> 4` by metis_tac[EVEN_ODD] >>
10701 `(n = 1) \/ (n = 3)` by decide_tac >-
10702 fs[] >>
10703 fs[lcm_run_small],
10704 qabbrev_tac `h = HALF n` >>
10705 `n = 2 * h + 1` by rw[ODD_HALF, Abbr`h`] >>
10706 `2 * 4 ** h <= h * 4 ** h` by rw[] >>
10707 `2 * 4 ** h = 2 * 2 ** (2 * h)` by rw[EXP_EXP_MULT] >>
10708 `_ = 2 ** n` by rw[GSYM EXP] >>
10709 `h * 4 ** h <= lcm_run n` by rw[lcm_run_lower_odd] >>
10710 decide_tac
10711 ]
10712QED
10713
10714(* Theorem: EVEN n ==> (2 ** n <= lcm_run n <=> (n = 0) \/ 8 <= n) *)
10715(* Proof:
10716 If part: 2 ** n <= lcm_run n ==> (n = 0) \/ 8 <= n
10717 By contradiction, suppose n <> 0 /\ n < 8.
10718 By EVEN n, n = 2 or n = 4 or n = 6.
10719 If n = 2, LHS = 2 ** 2 = 4 by arithmetic
10720 RHS = lcm_run 2 = 2 by lcm_run_small
10721 Hence false.
10722 If n = 4, LHS = 2 ** 4 = 16 by arithmetic
10723 RHS = lcm_run 4 = 12 by lcm_run_small
10724 Hence false.
10725 If n = 6, LHS = 2 ** 6 = 64 by arithmetic
10726 RHS = lcm_run 6 = 60 by lcm_run_small
10727 Hence false.
10728 Only-if part: (n = 0) \/ 8 <= n ==> 2 ** n <= lcm_run n
10729 If n = 0, LHS = 2 ** 0 = 1 by arithmetic
10730 RHS = lcm_run 0 = 1 by lcm_run_0
10731 Hence true.
10732 If n = 8, LHS = 2 ** 8 = 256 by arithmetic
10733 RHS = lcm_run 8 = 840 by lcm_run_small
10734 Hence true.
10735 Otherwise, 10 <= n, since ODD 9.
10736 Let h = HALF n, k = h - 1.
10737 Then n = 2 * h by EVEN_HALF
10738 = 2 * (k + 1) by k = h - 1
10739 = 2 * k + 2 by arithmetic
10740 But lcm_run (2 * k + 1) <= lcm_run (2 * k + 2) by lcm_run_monotone
10741 and k * 4 ** k <= lcm_run (2 * k + 1) by lcm_run_lower_odd
10742
10743 Now 5 <= h by 10 <= h
10744 so 4 <= k by k = h - 1
10745 ==> 4 * 4 ** k <= k * 4 ** k by LESS_MONO_MULT
10746
10747 4 * 4 ** k
10748 = (2 ** 2) * (2 ** 2) ** k by arithmetic
10749 = (2 ** 2) * (2 ** (2 * k)) by EXP_EXP_MULT
10750 = 2 ** (2 * k + 2) by EXP_ADD
10751 = 2 ** n by n = 2 * k + 2
10752
10753 Overall 2 ** n <= lcm_run n by LESS_EQ_TRANS
10754*)
10755Theorem lcm_run_lower_even_iff:
10756 !n. EVEN n ==> (2 ** n <= lcm_run n <=> (n = 0) \/ 8 <= n)
10757Proof
10758 rw[EQ_IMP_THM] >| [
10759 spose_not_then strip_assume_tac >>
10760 `n < 8` by decide_tac >>
10761 `ODD 1 /\ ODD 3 /\ ODD 5 /\ ODD 7` by rw[] >>
10762 `n <> 1 /\ n <> 3 /\ n <> 5 /\ n <> 7` by metis_tac[EVEN_ODD] >>
10763 `(n = 2) \/ (n = 4) \/ (n = 6)` by decide_tac >-
10764 fs[lcm_run_small] >-
10765 fs[lcm_run_small] >>
10766 fs[lcm_run_small],
10767 fs[lcm_run_0],
10768 Cases_on `n = 8` >-
10769 rw[lcm_run_small] >>
10770 `ODD 9` by rw[] >>
10771 `n <> 9` by metis_tac[EVEN_ODD] >>
10772 `10 <= n` by decide_tac >>
10773 qabbrev_tac `h = HALF n` >>
10774 `n = 2 * h` by rw[EVEN_HALF, Abbr`h`] >>
10775 qabbrev_tac `k = h - 1` >>
10776 `lcm_run (2 * k + 1) <= lcm_run (2 * k + 1 + 1)` by rw[lcm_run_monotone] >>
10777 `2 * k + 1 + 1 = n` by rw[Abbr`k`] >>
10778 `k * 4 ** k <= lcm_run (2 * k + 1)` by rw[lcm_run_lower_odd] >>
10779 `4 * 4 ** k <= k * 4 ** k` by rw[Abbr`k`] >>
10780 `4 * 4 ** k = 2 ** 2 * 2 ** (2 * k)` by rw[EXP_EXP_MULT] >>
10781 `_ = 2 ** (2 * k + 2)` by rw[GSYM EXP_ADD] >>
10782 `_ = 2 ** n` by rw[] >>
10783 metis_tac[LESS_EQ_TRANS]
10784 ]
10785QED
10786
10787(* Theorem: 2 ** n <= lcm_run n <=> (n = 0) \/ (n = 5) \/ 7 <= n *)
10788(* Proof:
10789 If EVEN n,
10790 Then n <> 5, n <> 7, so 8 <= n by arithmetic
10791 Thus true by lcm_run_lower_even_iff
10792 If ~EVEN n, then ODD n by EVEN_ODD
10793 Then n <> 0, n <> 6, so 5 <= n by arithmetic
10794 Thus true by lcm_run_lower_odd_iff
10795*)
10796Theorem lcm_run_lower_better_iff:
10797 !n. 2 ** n <= lcm_run n <=> (n = 0) \/ (n = 5) \/ 7 <= n
10798Proof
10799 rpt strip_tac >>
10800 Cases_on `EVEN n` >| [
10801 `ODD 5 /\ ODD 7` by rw[] >>
10802 `n <> 5 /\ n <> 7` by metis_tac[EVEN_ODD] >>
10803 metis_tac[lcm_run_lower_even_iff, DECIDE``8 <= n <=> (7 <= n /\ n <> 7)``],
10804 `EVEN 0 /\ EVEN 6` by rw[] >>
10805 `ODD n /\ n <> 0 /\ n <> 6` by metis_tac[EVEN_ODD] >>
10806 metis_tac[lcm_run_lower_odd_iff, DECIDE``5 <= n <=> (n = 5) \/ (n = 6) \/ (7 <= n)``]
10807 ]
10808QED
10809
10810(* This is the ultimate goal! *)
10811
10812(* ------------------------------------------------------------------------- *)
10813(* Nair's Trick - using consecutive LCM *)
10814(* ------------------------------------------------------------------------- *)
10815
10816(* Define the consecutive LCM function *)
10817Definition lcm_upto_def:
10818 (lcm_upto 0 = 1) /\
10819 (lcm_upto (SUC n) = lcm (SUC n) (lcm_upto n))
10820End
10821
10822(* Extract theorems from definition *)
10823Theorem lcm_upto_0 = lcm_upto_def |> CONJUNCT1;
10824(* val lcm_upto_0 = |- lcm_upto 0 = 1: thm *)
10825
10826Theorem lcm_upto_SUC = lcm_upto_def |> CONJUNCT2;
10827(* val lcm_upto_SUC = |- !n. lcm_upto (SUC n) = lcm (SUC n) (lcm_upto n): thm *)
10828
10829(* Theorem: (lcm_upto 0 = 1) /\ (!n. lcm_upto (n+1) = lcm (n+1) (lcm_upto n)) *)
10830(* Proof: by lcm_upto_def *)
10831Theorem lcm_upto_alt:
10832 (lcm_upto 0 = 1) /\ (!n. lcm_upto (n+1) = lcm (n+1) (lcm_upto n))
10833Proof
10834 metis_tac[lcm_upto_def, ADD1]
10835QED
10836
10837(* Theorem: lcm_upto 1 = 1 *)
10838(* Proof:
10839 lcm_upto 1
10840 = lcm_upto (SUC 0) by ONE
10841 = lcm (SUC 0) (lcm_upto 0) by lcm_upto_SUC
10842 = lcm (SUC 0) 1 by lcm_upto_0
10843 = lcm 1 1 by ONE
10844 = 1 by LCM_REF
10845*)
10846Theorem lcm_upto_1:
10847 lcm_upto 1 = 1
10848Proof
10849 metis_tac[lcm_upto_def, LCM_REF, ONE]
10850QED
10851
10852(* Theorem: lcm_upto n for small n *)
10853(* Proof: by evaluation. *)
10854Theorem lcm_upto_small:
10855 (lcm_upto 2 = 2) /\ (lcm_upto 3 = 6) /\ (lcm_upto 4 = 12) /\
10856 (lcm_upto 5 = 60) /\ (lcm_upto 6 = 60) /\ (lcm_upto 7 = 420) /\
10857 (lcm_upto 8 = 840) /\ (lcm_upto 9 = 2520) /\ (lcm_upto 10 = 2520)
10858Proof
10859 EVAL_TAC
10860QED
10861
10862(* Theorem: lcm_upto n = list_lcm [1 .. n] *)
10863(* Proof:
10864 By induction on n.
10865 Base: lcm_upto 0 = list_lcm [1 .. 0]
10866 lcm_upto 0
10867 = 1 by lcm_upto_0
10868 = list_lcm [] by list_lcm_nil
10869 = list_lcm [1 .. 0] by listRangeINC_EMPTY
10870 Step: lcm_upto n = list_lcm [1 .. n] ==> lcm_upto (SUC n) = list_lcm [1 .. SUC n]
10871 lcm_upto (SUC n)
10872 = lcm (SUC n) (lcm_upto n) by lcm_upto_SUC
10873 = lcm (SUC n) (list_lcm [1 .. n]) by induction hypothesis
10874 = list_lcm (SNOC (SUC n) [1 .. n]) by list_lcm_snoc
10875 = list_lcm [1 .. (SUC n)] by listRangeINC_SNOC, ADD1, 1 <= n + 1
10876*)
10877Theorem lcm_upto_eq_list_lcm:
10878 !n. lcm_upto n = list_lcm [1 .. n]
10879Proof
10880 Induct >-
10881 rw[lcm_upto_0, list_lcm_nil, listRangeINC_EMPTY] >>
10882 rw[lcm_upto_SUC, list_lcm_snoc, listRangeINC_SNOC, ADD1]
10883QED
10884
10885(* Theorem: 2 ** n <= lcm_upto (n + 1) *)
10886(* Proof:
10887 lcm_upto (n + 1)
10888 = list_lcm [1 .. (n + 1)] by lcm_upto_eq_list_lcm
10889 >= 2 ** n by lcm_lower_bound
10890*)
10891Theorem lcm_upto_lower:
10892 !n. 2 ** n <= lcm_upto (n + 1)
10893Proof
10894 rw[lcm_upto_eq_list_lcm, lcm_lower_bound]
10895QED
10896
10897(* Theorem: 0 < lcm_upto (n + 1) *)
10898(* Proof:
10899 lcm_upto (n + 1)
10900 >= 2 ** n by lcm_upto_lower
10901 > 0 by EXP_POS, 0 < 2
10902*)
10903Theorem lcm_upto_pos:
10904 !n. 0 < lcm_upto (n + 1)
10905Proof
10906 metis_tac[lcm_upto_lower, EXP_POS, LESS_LESS_EQ_TRANS, DECIDE``0 < 2``]
10907QED
10908
10909(* Theorem: (n + 1) divides lcm_upto (n + 1) /\ (lcm_upto n) divides lcm_upto (n + 1) *)
10910(* Proof:
10911 Note lcm_upto (n + 1) = lcm (n + 1) (lcm_upto n) by lcm_upto_alt
10912 so (n + 1) divides lcm_upto (n + 1)
10913 and (lcm_upto n) divides lcm_upto (n + 1) by LCM_DIVISORS
10914*)
10915Theorem lcm_upto_divisors:
10916 !n. (n + 1) divides lcm_upto (n + 1) /\ (lcm_upto n) divides lcm_upto (n + 1)
10917Proof
10918 rw[lcm_upto_alt, LCM_DIVISORS]
10919QED
10920
10921(* Theorem: lcm_upto n <= lcm_upto (n + 1) *)
10922(* Proof:
10923 Note (lcm_upto n) divides lcm_upto (n + 1) by lcm_upto_divisors
10924 and 0 < lcm_upto (n + 1) by lcm_upto_pos
10925 so lcm_upto n <= lcm_upto (n + 1) by DIVIDES_LE
10926*)
10927Theorem lcm_upto_monotone:
10928 !n. lcm_upto n <= lcm_upto (n + 1)
10929Proof
10930 rw[lcm_upto_divisors, lcm_upto_pos, DIVIDES_LE]
10931QED
10932
10933(* Theorem: k <= n ==> (leibniz n k) divides lcm_upto (n + 1) *)
10934(* Proof:
10935 Note (leibniz n k) divides list_lcm (leibniz_vertical n) by leibniz_vertical_divisor
10936 ==> (leibniz n k) divides list_lcm [1 .. (n + 1)] by notation
10937 or (leibniz n k) divides lcm_upto (n + 1) by lcm_upto_eq_list_lcm
10938*)
10939Theorem lcm_upto_leibniz_divisor:
10940 !n k. k <= n ==> (leibniz n k) divides lcm_upto (n + 1)
10941Proof
10942 metis_tac[leibniz_vertical_divisor, lcm_upto_eq_list_lcm]
10943QED
10944
10945(* Theorem: n * 4 ** n <= lcm_upto (2 * n + 1) *)
10946(* Proof:
10947 If n = 0, LHS = 0, trivially true.
10948 If n <> 0, 0 < n.
10949 Let m = 2 * n.
10950
10951 Claim: (m + 1) * binomial m n divides lcm_upto (m + 1) [1]
10952 Proof: Note n <= m by LESS_MONO_MULT, 1 <= 2
10953 ==> (leibniz m n) divides lcm_upto (m + 1) by lcm_upto_leibniz_divisor, n <= m
10954 or (m + 1) * binomial m n divides lcm_upto (m + 1) by leibniz_def
10955
10956 Claim: n * binomial m n divides lcm_upto (m + 1) [2]
10957 Proof: Note (lcm_upto m) divides lcm_upto (m + 1) by lcm_upto_divisors
10958 Also 0 < m /\ n <= m - 1 by 0 < n
10959 and m - 1 + 1 = m by 0 < m
10960 Thus (leibniz (m - 1) n) divides lcm_upto m by lcm_upto_leibniz_divisor, n <= m - 1
10961 or (leibniz (m - 1) n) divides lcm_upto (m + 1) by DIVIDES_TRANS
10962 and leibniz (m - 1) n
10963 = (m - n) * binomial m n by leibniz_up_alt
10964 = n * binomial m n by m - n = n
10965
10966 Note coprime n (m + 1) by GCD_EUCLID, GCD_1, 1 < n
10967 Thus lcm (n * binomial m n) ((m + 1) * binomial m n)
10968 = n * (m + 1) * binomial m n by LCM_COMMON_COPRIME
10969 = n * ((m + 1) * binomial m n) by MULT_ASSOC
10970 = n * leibniz m n by leibniz_def
10971 ==> n * leibniz m n divides lcm_upto (m + 1) by LCM_DIVIDES, [1], [2]
10972 Note 0 < lcm_upto (m + 1) by lcm_upto_pos
10973 or n * leibniz m n <= lcm_upto (m + 1) by DIVIDES_LE, 0 < lcm_upto (m + 1)
10974 Now 4 ** n <= leibniz m n by leibniz_middle_lower
10975 so n * 4 ** n <= n * leibniz m n by LESS_MONO_MULT, MULT_COMM
10976 or n * 4 ** n <= lcm_upto (m + 1) by LESS_EQ_TRANS
10977*)
10978Theorem lcm_upto_lower_odd:
10979 !n. n * 4 ** n <= lcm_upto (2 * n + 1)
10980Proof
10981 rpt strip_tac >>
10982 Cases_on `n = 0` >-
10983 rw[] >>
10984 `0 < n` by decide_tac >>
10985 qabbrev_tac `m = 2 * n` >>
10986 `(m + 1) * binomial m n divides lcm_upto (m + 1)` by
10987 (`n <= m` by rw[Abbr`m`] >>
10988 metis_tac[lcm_upto_leibniz_divisor, leibniz_def]) >>
10989 `n * binomial m n divides lcm_upto (m + 1)` by
10990 (`(lcm_upto m) divides lcm_upto (m + 1)` by rw[lcm_upto_divisors] >>
10991 `0 < m /\ n <= m - 1` by rw[Abbr`m`] >>
10992 `m - 1 + 1 = m` by decide_tac >>
10993 `(leibniz (m - 1) n) divides lcm_upto m` by metis_tac[lcm_upto_leibniz_divisor] >>
10994 `(leibniz (m - 1) n) divides lcm_upto (m + 1)` by metis_tac[DIVIDES_TRANS] >>
10995 `leibniz (m - 1) n = (m - n) * binomial m n` by rw[leibniz_up_alt] >>
10996 `_ = n * binomial m n` by rw[Abbr`m`] >>
10997 metis_tac[]) >>
10998 `coprime n (m + 1)` by rw[GCD_EUCLID, Abbr`m`] >>
10999 `lcm (n * binomial m n) ((m + 1) * binomial m n) = n * (m + 1) * binomial m n` by rw[LCM_COMMON_COPRIME] >>
11000 `_ = n * leibniz m n` by rw[leibniz_def, MULT_ASSOC] >>
11001 `n * leibniz m n divides lcm_upto (m + 1)` by metis_tac[LCM_DIVIDES] >>
11002 `n * leibniz m n <= lcm_upto (m + 1)` by rw[DIVIDES_LE, lcm_upto_pos] >>
11003 `4 ** n <= leibniz m n` by rw[leibniz_middle_lower, Abbr`m`] >>
11004 metis_tac[LESS_MONO_MULT, MULT_COMM, LESS_EQ_TRANS]
11005QED
11006
11007(* Theorem: n * 4 ** n <= lcm_upto (2 * (n + 1)) *)
11008(* Proof:
11009 lcm_upto (2 * (n + 1))
11010 = lcm_upto (2 * n + 2) by arithmetic
11011 >= lcm_upto (2 * n + 1) by lcm_upto_monotone
11012 >= n * 4 ** n by lcm_upto_lower_odd
11013*)
11014Theorem lcm_upto_lower_even:
11015 !n. n * 4 ** n <= lcm_upto (2 * (n + 1))
11016Proof
11017 rpt strip_tac >>
11018 `2 * (n + 1) = 2 * n + 1 + 1` by decide_tac >>
11019 metis_tac[lcm_upto_monotone, lcm_upto_lower_odd, LESS_EQ_TRANS]
11020QED
11021
11022(* Theorem: 7 <= n ==> 2 ** n <= lcm_upto n *)
11023(* Proof:
11024 If ODD n, ?k. n = SUC (2 * k) by ODD_EXISTS,
11025 When 5 <= 7 <= n = 2 * k + 1 by ADD1
11026 2 <= k by arithmetic
11027 and lcm_upto n
11028 = lcm_upto (2 * k + 1) by notation
11029 >= k * 4 ** k by lcm_upto_lower_odd
11030 >= 2 * 4 ** k by k >= 2, LESS_MONO_MULT
11031 = 2 * 2 ** (2 * k) by EXP_EXP_MULT
11032 = 2 ** SUC (2 * k) by EXP
11033 = 2 ** n by n = SUC (2 * k)
11034 If EVEN n, ?m. n = 2 * m by EVEN_EXISTS
11035 Note ODD 7 /\ ODD 9 by arithmetic
11036 If n = 8,
11037 LHS = 2 ** 8 = 256,
11038 RHS = lcm_upto 8 = 840 by lcm_upto_small
11039 Hence true.
11040 Otherwise, 10 <= n by 7 <= n, n <> 7, n <> 8, n <> 9
11041 Since 0 < n, 0 < m by MULT_EQ_0
11042 so ?k. m = SUC k by num_CASES
11043 When 10 <= n = 2 * (k + 1) by ADD1
11044 4 <= k by arithmetic
11045 and lcm_upto n
11046 = lcm_upto (2 * (k + 1)) by notation
11047 >= k * 4 ** k by lcm_upto_lower_even
11048 >= 4 * 4 ** k by k >= 4, LESS_MONO_MULT
11049 = 4 ** SUC k by EXP
11050 = 4 ** m by notation
11051 = 2 ** (2 * m) by EXP_EXP_MULT
11052 = 2 ** n by n = 2 * m
11053*)
11054Theorem lcm_upto_lower_better:
11055 !n. 7 <= n ==> 2 ** n <= lcm_upto n
11056Proof
11057 rpt strip_tac >>
11058 Cases_on `ODD n` >| [
11059 `?k. n = SUC (2 * k)` by rw[GSYM ODD_EXISTS] >>
11060 `2 <= k` by decide_tac >>
11061 `2 * 4 ** k <= k * 4 ** k` by rw[LESS_MONO_MULT] >>
11062 `lcm_upto n = lcm_upto (2 * k + 1)` by rw[ADD1] >>
11063 `2 ** n = 2 * 2 ** (2 * k)` by rw[EXP] >>
11064 `_ = 2 * 4 ** k` by rw[EXP_EXP_MULT] >>
11065 metis_tac[lcm_upto_lower_odd, LESS_EQ_TRANS],
11066 `ODD 7 /\ ODD 9` by rw[] >>
11067 `EVEN n /\ n <> 7 /\ n <> 9` by metis_tac[ODD_EVEN] >>
11068 `?m. n = 2 * m` by rw[GSYM EVEN_EXISTS] >>
11069 `m <> 0` by decide_tac >>
11070 `?k. m = SUC k` by metis_tac[num_CASES] >>
11071 Cases_on `n = 8` >-
11072 rw[lcm_upto_small] >>
11073 `4 <= k` by decide_tac >>
11074 `4 * 4 ** k <= k * 4 ** k` by rw[LESS_MONO_MULT] >>
11075 `lcm_upto n = lcm_upto (2 * (k + 1))` by rw[ADD1] >>
11076 `2 ** n = 4 ** m` by rw[EXP_EXP_MULT] >>
11077 `_ = 4 * 4 ** k` by rw[EXP] >>
11078 metis_tac[lcm_upto_lower_even, LESS_EQ_TRANS]
11079 ]
11080QED
11081
11082(* This is a very significant result. *)
11083
11084(* ------------------------------------------------------------------------- *)
11085(* Simple LCM lower bounds -- rework *)
11086(* ------------------------------------------------------------------------- *)
11087
11088(* Theorem: HALF (n + 1) <= lcm_run n *)
11089(* Proof:
11090 If n = 0,
11091 LHS = HALF 1 = 0 by arithmetic
11092 RHS = lcm_run 0 = 1 by lcm_run_0
11093 Hence true.
11094 If n <> 0, 0 < n.
11095 Let l = [1 .. n].
11096 Then l <> [] by listRangeINC_NIL, n <> 0
11097 so EVERY_POSITIVE l by listRangeINC_EVERY
11098 lcm_run n
11099 = list_lcm l by notation
11100 >= (SUM l) DIV (LENGTH l) by list_lcm_nonempty_lower, l <> []
11101 = (SUM l) DIV n by listRangeINC_LEN
11102 = (HALF (n * (n + 1))) DIV n by sum_1_to_n_eqn
11103 = HALF ((n * (n + 1)) DIV n) by DIV_DIV_DIV_MULT, 0 < 2, 0 < n
11104 = HALF (n + 1) by MULT_TO_DIV
11105*)
11106Theorem lcm_run_lower_simple:
11107 !n. HALF (n + 1) <= lcm_run n
11108Proof
11109 rpt strip_tac >>
11110 Cases_on `n = 0` >-
11111 rw[lcm_run_0] >>
11112 qabbrev_tac `l = [1 .. n]` >>
11113 `l <> []` by rw[listRangeINC_NIL, Abbr`l`] >>
11114 `EVERY_POSITIVE l` by rw[listRangeINC_EVERY, Abbr`l`] >>
11115 `(SUM l) DIV (LENGTH l) = (SUM l) DIV n` by rw[listRangeINC_LEN, Abbr`l`] >>
11116 `_ = (HALF (n * (n + 1))) DIV n` by rw[sum_1_to_n_eqn, Abbr`l`] >>
11117 `_ = HALF ((n * (n + 1)) DIV n)` by rw[DIV_DIV_DIV_MULT] >>
11118 `_ = HALF (n + 1)` by rw[MULT_TO_DIV] >>
11119 metis_tac[list_lcm_nonempty_lower]
11120QED
11121
11122(* This is a simple result, good but not very useful. *)
11123
11124(* Theorem: lcm_run n = list_lcm (leibniz_vertical (n - 1)) *)
11125(* Proof:
11126 If n = 0,
11127 Then n - 1 + 1 = 0 - 1 + 1 = 1
11128 but lcm_run 0 = 1 = lcm_run 1, hence true.
11129 If n <> 0,
11130 Then n - 1 + 1 = n, hence true trivially.
11131*)
11132Theorem lcm_run_alt:
11133 !n. lcm_run n = list_lcm (leibniz_vertical (n - 1))
11134Proof
11135 rpt strip_tac >>
11136 Cases_on `n = 0` >-
11137 rw[lcm_run_0, lcm_run_1] >>
11138 rw[]
11139QED
11140
11141(* Theorem: 2 ** (n - 1) <= lcm_run n *)
11142(* Proof:
11143 If n = 0,
11144 LHS = HALF 1 = 0 by arithmetic
11145 RHS = lcm_run 0 = 1 by lcm_run_0
11146 Hence true.
11147 If n <> 0, 0 < n, or 1 <= n.
11148 Let l = leibniz_horizontal (n - 1).
11149 Then LENGTH l = n by leibniz_horizontal_len
11150 so l <> [] by LENGTH_NIL, n <> 0
11151 and EVERY_POSITIVE l by leibniz_horizontal_pos
11152 lcm_run n
11153 = list_lcm (leibniz_vertical (n - 1)) by lcm_run_alt
11154 = list_lcm l by leibniz_lcm_property
11155 >= (SUM l) DIV (LENGTH l) by list_lcm_nonempty_lower, l <> []
11156 = 2 ** (n - 1) by leibniz_horizontal_average_eqn
11157*)
11158Theorem lcm_run_lower_good:
11159 !n. 2 ** (n - 1) <= lcm_run n
11160Proof
11161 rpt strip_tac >>
11162 Cases_on `n = 0` >-
11163 rw[lcm_run_0] >>
11164 `0 < n /\ 1 <= n /\ (n - 1 + 1 = n)` by decide_tac >>
11165 qabbrev_tac `l = leibniz_horizontal (n - 1)` >>
11166 `lcm_run n = list_lcm l` by metis_tac[leibniz_lcm_property] >>
11167 `LENGTH l = n` by metis_tac[leibniz_horizontal_len] >>
11168 `l <> []` by metis_tac[LENGTH_NIL] >>
11169 `EVERY_POSITIVE l` by rw[leibniz_horizontal_pos, Abbr`l`] >>
11170 metis_tac[list_lcm_nonempty_lower, leibniz_horizontal_average_eqn]
11171QED
11172
11173(* ------------------------------------------------------------------------- *)
11174(* Upper Bound by Leibniz Triangle *)
11175(* ------------------------------------------------------------------------- *)
11176
11177(* Theorem: leibniz n k = (n + 1 - k) * binomial (n + 1) k *)
11178(* Proof: by leibniz_up_alt:
11179leibniz_up_alt |- !n. 0 < n ==> !k. leibniz (n - 1) k = (n - k) * binomial n k
11180*)
11181Theorem leibniz_eqn:
11182 !n k. leibniz n k = (n + 1 - k) * binomial (n + 1) k
11183Proof
11184 rw[GSYM leibniz_up_alt]
11185QED
11186
11187(* Theorem: leibniz n (k + 1) = (n - k) * binomial (n + 1) (k + 1) *)
11188(* Proof: by leibniz_up_alt:
11189leibniz_up_alt |- !n. 0 < n ==> !k. leibniz (n - 1) k = (n - k) * binomial n k
11190*)
11191Theorem leibniz_right_alt:
11192 !n k. leibniz n (k + 1) = (n - k) * binomial (n + 1) (k + 1)
11193Proof
11194 metis_tac[leibniz_up_alt, DECIDE``0 < n + 1 /\ (n + 1 - 1 = n) /\ (n + 1 - (k + 1) = n - k)``]
11195QED
11196
11197(* Leibniz Stack:
11198 \
11199 \
11200 \
11201 \
11202 (L k k) <-- boundary of Leibniz Triangle
11203 | \ |-- (m - k) = distance
11204 | k <= m <= n <-- m
11205 | \ (n - k) = height, or max distance
11206 | binomial (n+1) (m+1) is at south-east of binomial n m
11207 | \
11208 | \
11209 n-th row: ....... (L n k) .................
11210
11211leibniz_binomial_identity
11212|- !m n k. k <= m /\ m <= n ==> (leibniz n k * binomial (n - k) (m - k) = leibniz m k * binomial (n + 1) (m + 1))
11213This says: (leibniz n k) at bottom is related to a stack entry (leibniz m k).
11214leibniz_divides_leibniz_factor
11215|- !m n k. k <= m /\ m <= n ==> leibniz n k divides leibniz m k * binomial (n + 1) (m + 1)
11216This is just a corollary of leibniz_binomial_identity, by divides_def.
11217
11218leibniz_horizontal_member_divides
11219|- !m n x. n <= TWICE m + 1 /\ m <= n /\ MEM x (leibniz_horizontal n) ==>
11220 x divides list_lcm (leibniz_horizontal m) * binomial (n + 1) (m + 1)
11221This says: for the n-th row, q = list_lcm (leibniz_horizontal m) * binomial (n + 1) (m + 1)
11222 is a common multiple of all members of the n-th row when n <= TWICE m + 1 /\ m <= n
11223That means, for the n-th row, pick any m-th row for HALF (n - 1) <= m <= n
11224Compute its list_lcm (leibniz_horizontal m), then multiply by binomial (n + 1) (m + 1) as q.
11225This value q is a common multiple of all members in n-th row.
11226The proof goes through all members of n-th row, i.e. (L n k) for k <= n.
11227To apply leibniz_binomial_identity, the condition is k <= m, not k <= n.
11228Since m has been picked (between HALF n and n), divide k into two parts: k <= m, m < k <= n.
11229For the first part, apply leibniz_binomial_identity.
11230For the second part, use symmetry L n (n - k) = L n k, then apply leibniz_binomial_identity.
11231With k <= m, m <= n, we apply leibniz_binomial_identity:
11232(1) Each member x = leibniz n k divides p = leibniz m k * binomial (n + 1) (m + 1), stack member with a factor.
11233(2) But leibniz m k is a member of (leibniz_horizontal m)
11234(3) Thus leibniz m k divides list_lcm (leibniz_horizontal m), the stack member divides its row list_lcm
11235 ==> p divides q by multiplying both by binomial (n + 1) (m + 1)
11236(4) Hence x divides q.
11237With the other half by symmetry, all members x divides q.
11238Corollary 1:
11239lcm_run_divides_property
11240|- !m n. n <= TWICE m /\ m <= n ==> lcm_run n divides binomial n m * lcm_run m
11241This follows by list_lcm_is_least_common_multiple and leibniz_lcm_property.
11242Corollary 2:
11243lcm_run_bound_recurrence
11244|- !m n. n <= TWICE m /\ m <= n ==> lcm_run n <= lcm_run m * binomial n m
11245Then lcm_run_upper_bound |- !n. lcm_run n <= 4 ** n follows by complete induction on n.
11246*)
11247
11248(* Theorem: k <= m /\ m <= n ==>
11249 ((leibniz n k) * (binomial (n - k) (m - k)) = (leibniz m k) * (binomial (n + 1) (m + 1))) *)
11250(* Proof:
11251 leibniz n k * (binomial (n - k) (m - k))
11252 = (n + 1) * (binomial n k) * (binomial (n - k) (m - k)) by leibniz_def
11253 n! (n - k)!
11254 = (n + 1) * ------------- * ------------------ binomial formula
11255 k! (n - k)! (m - k)! (n - m)!
11256 n! 1
11257 = (n + 1) * -------------- * ------------------ cancel (n - k)!
11258 k! 1 (m - k)! (n - m)!
11259 n! (m + 1)!
11260 = (n + 1) * -------------- * ------------------ replace by (m + 1)!
11261 k! (m + 1)! (m - k)! (n - m)!
11262 (n + 1)! m!
11263 = (m + 1) * -------------- * ------------------ merge and split factorials
11264 k! (m + 1)! (m - k)! (n - m)!
11265 m! (n + 1)!
11266 = (m + 1) * -------------- * ------------------ binomial formula
11267 k! (m - k)! (m + 1)! (n - m)!
11268 = leibniz m k * binomial (n + 1) (m + 1) by leibniz_def
11269*)
11270Theorem leibniz_binomial_identity:
11271 !m n k. k <= m /\ m <= n ==>
11272 ((leibniz n k) * (binomial (n - k) (m - k)) = (leibniz m k) * (binomial (n + 1) (m + 1)))
11273Proof
11274 rw[leibniz_def] >>
11275 `m + 1 <= n + 1` by decide_tac >>
11276 `m - k <= n - k` by decide_tac >>
11277 `(n - k) - (m - k) = n - m` by decide_tac >>
11278 `(n + 1) - (m + 1) = n - m` by decide_tac >>
11279 `FACT m = binomial m k * (FACT (m - k) * FACT k)` by rw[binomial_formula2] >>
11280 `FACT (n + 1) = binomial (n + 1) (m + 1) * (FACT (n - m) * FACT (m + 1))` by metis_tac[binomial_formula2] >>
11281 `FACT n = binomial n k * (FACT (n - k) * FACT k)` by rw[binomial_formula2] >>
11282 `FACT (n - k) = binomial (n - k) (m - k) * (FACT (n - m) * FACT (m - k))` by metis_tac[binomial_formula2] >>
11283 `!n. FACT (n + 1) = (n + 1) * FACT n` by metis_tac[FACT, ADD1] >>
11284 `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] >>
11285 `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] >>
11286 metis_tac[MULT_LEFT_CANCEL, FACT_LESS, NOT_ZERO_LT_ZERO]
11287QED
11288
11289(* Theorem: k <= m /\ m <= n ==> leibniz n k divides leibniz m k * binomial (n + 1) (m + 1) *)
11290(* Proof:
11291 Note leibniz m k * binomial (n + 1) (m + 1)
11292 = leibniz n k * binomial (n - k) (m - k) by leibniz_binomial_identity
11293 Thus leibniz n k divides leibniz m k * binomial (n + 1) (m + 1)
11294 by divides_def, MULT_COMM
11295*)
11296Theorem leibniz_divides_leibniz_factor:
11297 !m n k. k <= m /\ m <= n ==> leibniz n k divides leibniz m k * binomial (n + 1) (m + 1)
11298Proof
11299 metis_tac[leibniz_binomial_identity, divides_def, MULT_COMM]
11300QED
11301
11302(* Theorem: n <= 2 * m + 1 /\ m <= n /\ MEM x (leibniz_horizontal n) ==>
11303 x divides list_lcm (leibniz_horizontal m) * binomial (n + 1) (m + 1) *)
11304(* Proof:
11305 Let q = list_lcm (leibniz_horizontal m) * binomial (n + 1) (m + 1).
11306 Note MEM x (leibniz_horizontal n)
11307 ==> ?k. k <= n /\ (x = leibniz n k) by leibniz_horizontal_member
11308 Here the picture is:
11309 HALF n ... m .... n
11310 0 ........ k .......... n
11311 We need k <= m to get x divides q, by applying leibniz_divides_leibniz_factor.
11312 For m < k <= n, we shall use symmetry to get x divides q.
11313 If k <= m,
11314 Let p = (leibniz m k) * binomial (n + 1) (m + 1).
11315 Then x divides p by leibniz_divides_leibniz_factor, k <= m, m <= n
11316 and MEM (leibniz m k) (leibniz_horizontal m) by leibniz_horizontal_member, k <= m
11317 ==> (leibniz m k) divides list_lcm (leibniz_horizontal m) by list_lcm_is_common_multiple
11318 so (leibniz m k) * binomial (n + 1) (m + 1)
11319 divides
11320 list_lcm (leibniz_horizontal m) * binomial (n + 1) (m + 1) by DIVIDES_CANCEL, binomial_pos
11321 or p divides q by notation
11322 Thus x divides q by DIVIDES_TRANS
11323 If ~(k <= m), then m < k.
11324 Note x = leibniz n (n - k) by leibniz_sym, k <= n
11325 Now n <= m + m + 1 by given n <= 2 * m + 1
11326 so n - k <= m + m + 1 - k by arithmetic
11327 and m + m + 1 - k <= m by m < k, so m + 1 <= k
11328 or n - k <= m by LESS_EQ_TRANS
11329 Let j = n - k, p = (leibniz m j) * binomial (n + 1) (m + 1).
11330 Then x divides p by leibniz_divides_leibniz_factor, j <= m, m <= n
11331 and MEM (leibniz m j) (leibniz_horizontal m) by leibniz_horizontal_member, j <= m
11332 ==> (leibniz m j) divides list_lcm (leibniz_horizontal m) by list_lcm_is_common_multiple
11333 so (leibniz m j) * binomial (n + 1) (m + 1)
11334 divides
11335 list_lcm (leibniz_horizontal m) * binomial (n + 1) (m + 1) by DIVIDES_CANCEL, binomial_pos
11336 or p divides q by notation
11337 Thus x divides q by DIVIDES_TRANS
11338*)
11339Theorem leibniz_horizontal_member_divides:
11340 !m n x. n <= 2 * m + 1 /\ m <= n /\ MEM x (leibniz_horizontal n) ==>
11341 x divides list_lcm (leibniz_horizontal m) * binomial (n + 1) (m + 1)
11342Proof
11343 rpt strip_tac >>
11344 qabbrev_tac `q = list_lcm (leibniz_horizontal m) * binomial (n + 1) (m + 1)` >>
11345 `?k. k <= n /\ (x = leibniz n k)` by rw[GSYM leibniz_horizontal_member] >>
11346 Cases_on `k <= m` >| [
11347 qabbrev_tac `p = (leibniz m k) * binomial (n + 1) (m + 1)` >>
11348 `x divides p` by rw[leibniz_divides_leibniz_factor, Abbr`p`] >>
11349 `MEM (leibniz m k) (leibniz_horizontal m)` by metis_tac[leibniz_horizontal_member] >>
11350 `(leibniz m k) divides list_lcm (leibniz_horizontal m)` by rw[list_lcm_is_common_multiple] >>
11351 `p divides q` by rw[GSYM DIVIDES_CANCEL, binomial_pos, Abbr`p`, Abbr`q`] >>
11352 metis_tac[DIVIDES_TRANS],
11353 `n - k <= m` by decide_tac >>
11354 qabbrev_tac `j = n - k` >>
11355 `x = leibniz n j` by rw[Once leibniz_sym, Abbr`j`] >>
11356 qabbrev_tac `p = (leibniz m j) * binomial (n + 1) (m + 1)` >>
11357 `x divides p` by rw[leibniz_divides_leibniz_factor, Abbr`p`] >>
11358 `MEM (leibniz m j) (leibniz_horizontal m)` by metis_tac[leibniz_horizontal_member] >>
11359 `(leibniz m j) divides list_lcm (leibniz_horizontal m)` by rw[list_lcm_is_common_multiple] >>
11360 `p divides q` by rw[GSYM DIVIDES_CANCEL, binomial_pos, Abbr`p`, Abbr`q`] >>
11361 metis_tac[DIVIDES_TRANS]
11362 ]
11363QED
11364
11365(* Theorem: n <= 2 * m /\ m <= n ==> (lcm_run n) divides (lcm_run m) * binomial n m *)
11366(* Proof:
11367 If n = 0,
11368 Then lcm_run 0 = 1 by lcm_run_0
11369 Hence true by ONE_DIVIDES_ALL
11370 If n <> 0,
11371 Then 0 < n, and 0 < m by n <= 2 * m
11372 Thus m - 1 <= n - 1 by m <= n
11373 and n - 1 <= 2 * m - 1 by n <= 2 * m
11374 = 2 * (m - 1) + 1
11375 Thus !x. MEM x (leibniz_horizontal (n - 1)) ==>
11376 x divides list_lcm (leibniz_horizontal (m - 1)) * binomial n m
11377 by leibniz_horizontal_member_divides
11378 ==> list_lcm (leibniz_horizontal (n - 1)) divides
11379 list_lcm (leibniz_horizontal (m - 1)) * binomial n m
11380 by list_lcm_is_least_common_multiple
11381 But lcm_run n = leibniz_horizontal (n - 1) by leibniz_lcm_property
11382 and lcm_run m = leibniz_horizontal (m - 1) by leibniz_lcm_property
11383 list_lcm (leibniz_horizontal h) divides q by list_lcm_is_least_common_multiple
11384 Thus (lcm_run n) divides (lcm_run m) * binomial n m by above
11385*)
11386Theorem lcm_run_divides_property:
11387 !m n. n <= 2 * m /\ m <= n ==> (lcm_run n) divides (lcm_run m) * binomial n m
11388Proof
11389 rpt strip_tac >>
11390 Cases_on `n = 0` >-
11391 rw[lcm_run_0] >>
11392 `0 < n` by decide_tac >>
11393 `0 < m` by decide_tac >>
11394 `m - 1 <= n - 1` by decide_tac >>
11395 `n - 1 <= 2 * (m - 1) + 1` by decide_tac >>
11396 `(n - 1 + 1 = n) /\ (m - 1 + 1 = m)` by decide_tac >>
11397 metis_tac[leibniz_horizontal_member_divides, list_lcm_is_least_common_multiple, leibniz_lcm_property]
11398QED
11399
11400(* Theorem: n <= 2 * m /\ m <= n ==> (lcm_run n) <= (lcm_run m) * binomial n m *)
11401(* Proof:
11402 Note 0 < lcm_run m by lcm_run_pos
11403 and 0 < binomial n m by binomial_pos
11404 so 0 < lcm_run m * binomial n m by MULT_EQ_0
11405 Now (lcm_run n) divides (lcm_run m) * binomial n m by lcm_run_divides_property
11406 Thus (lcm_run n) <= (lcm_run m) * binomial n m by DIVIDES_LE
11407*)
11408Theorem lcm_run_bound_recurrence:
11409 !m n. n <= 2 * m /\ m <= n ==> (lcm_run n) <= (lcm_run m) * binomial n m
11410Proof
11411 rpt strip_tac >>
11412 `0 < lcm_run m * binomial n m` by metis_tac[lcm_run_pos, binomial_pos, MULT_EQ_0, NOT_ZERO_LT_ZERO] >>
11413 rw[lcm_run_divides_property, DIVIDES_LE]
11414QED
11415
11416(* Theorem: lcm_run n <= 4 ** n *)
11417(* Proof:
11418 By complete induction on n.
11419 If EVEN n,
11420 Base: n = 0.
11421 LHS = lcm_run 0 = 1 by lcm_run_0
11422 RHS = 4 ** 0 = 1 by EXP
11423 Hence true.
11424 Step: n <> 0 /\ !m. m < n ==> lcm_run m <= 4 ** m ==> lcm_run n <= 4 ** n
11425 Let m = HALF n, c = lcm_run m * binomial n m.
11426 Then n = 2 * m by EVEN_HALF
11427 so m <= 2 * m = n by arithmetic
11428 ==> lcm_run n <= c by lcm_run_bound_recurrence, m <= n
11429 But m <> 0 by n <> 0
11430 so m < n by arithmetic
11431 Now c = lcm_run m * binomial n m by notation
11432 <= 4 ** m * binomial n m by induction hypothesis, m < n
11433 <= 4 ** m * 4 ** m by binomial_middle_upper_bound
11434 = 4 ** (m + m) by EXP_ADD
11435 = 4 ** n by TIMES2, n = 2 * m
11436 Hence lcm_run n <= 4 ** n.
11437 If ~EVEN n,
11438 Then ODD n by EVEN_ODD
11439 Base: n = 1.
11440 LHS = lcm_run 1 = 1 by lcm_run_1
11441 RHS = 4 ** 1 = 4 by EXP
11442 Hence true.
11443 Step: n <> 1 /\ !m. m < n ==> lcm_run m <= 4 ** m ==> lcm_run n <= 4 ** n
11444 Let m = HALF n, c = lcm_run (m + 1) * binomial n (m + 1).
11445 Then n = 2 * m + 1 by ODD_HALF
11446 and 0 < m by n <> 1
11447 and m + 1 <= 2 * m + 1 = n by arithmetic
11448 ==> (lcm_run n) <= c by lcm_run_bound_recurrence, m + 1 <= n
11449 But m + 1 <> n by m <> 0
11450 so m + 1 < n by m + 1 <> n
11451 Now c = lcm_run (m + 1) * binomial n (m + 1) by notation
11452 <= 4 ** (m + 1) * binomial n (m + 1) by induction hypothesis, m + 1 < n
11453 = 4 ** (m + 1) * binomial n m by binomial_sym, n - (m + 1) = m
11454 <= 4 ** (m + 1) * 4 ** m by binomial_middle_upper_bound
11455 = 4 ** m * 4 ** (m + 1) by arithmetic
11456 = 4 ** (m + (m + 1)) by EXP_ADD
11457 = 4 ** (2 * m + 1) by arithmetic
11458 = 4 ** n by n = 2 * m + 1
11459 Hence lcm_run n <= 4 ** n.
11460*)
11461Theorem lcm_run_upper_bound:
11462 !n. lcm_run n <= 4 ** n
11463Proof
11464 completeInduct_on `n` >>
11465 Cases_on `EVEN n` >| [
11466 Cases_on `n = 0` >-
11467 rw[lcm_run_0] >>
11468 qabbrev_tac `m = HALF n` >>
11469 `n = 2 * m` by rw[EVEN_HALF, Abbr`m`] >>
11470 qabbrev_tac `c = lcm_run m * binomial n m` >>
11471 `lcm_run n <= c` by rw[lcm_run_bound_recurrence, Abbr`c`] >>
11472 `lcm_run m <= 4 ** m` by rw[] >>
11473 `binomial n m <= 4 ** m` by metis_tac[binomial_middle_upper_bound] >>
11474 `c <= 4 ** m * 4 ** m` by rw[LESS_MONO_MULT2, Abbr`c`] >>
11475 `4 ** m * 4 ** m = 4 ** n` by metis_tac[EXP_ADD, TIMES2] >>
11476 decide_tac,
11477 `ODD n` by metis_tac[EVEN_ODD] >>
11478 Cases_on `n = 1` >-
11479 rw[lcm_run_1] >>
11480 qabbrev_tac `m = HALF n` >>
11481 `n = 2 * m + 1` by rw[ODD_HALF, Abbr`m`] >>
11482 qabbrev_tac `c = lcm_run (m + 1) * binomial n (m + 1)` >>
11483 `lcm_run n <= c` by rw[lcm_run_bound_recurrence, Abbr`c`] >>
11484 `lcm_run (m + 1) <= 4 ** (m + 1)` by rw[] >>
11485 `binomial n (m + 1) = binomial n m` by rw[Once binomial_sym] >>
11486 `binomial n m <= 4 ** m` by metis_tac[binomial_middle_upper_bound] >>
11487 `c <= 4 ** (m + 1) * 4 ** m` by rw[LESS_MONO_MULT2, Abbr`c`] >>
11488 `4 ** (m + 1) * 4 ** m = 4 ** n` by metis_tac[MULT_COMM, EXP_ADD, ADD_ASSOC, TIMES2] >>
11489 decide_tac
11490 ]
11491QED
11492
11493(* This is a milestone theorem. *)
11494
11495(* ------------------------------------------------------------------------- *)
11496(* Beta Triangle *)
11497(* ------------------------------------------------------------------------- *)
11498
11499(* Define beta triangle *)
11500(* Use temp_overload so that beta is invisibe outside:
11501val beta_def = Define`
11502 beta n k = k * (binomial n k)
11503`;
11504*)
11505Overload beta[local] = ``\n k. k * (binomial n k)``(* for temporary overloading *)
11506(* can use overload, but then hard to print and change the appearance of too many theorem? *)
11507
11508(*
11509
11510Pascal's Triangle (k <= n)
11511n = 0 1 = binomial 0 0
11512n = 1 1 1
11513n = 2 1 2 1
11514n = 3 1 3 3 1
11515n = 4 1 4 6 4 1
11516n = 5 1 5 10 10 5 1
11517n = 6 1 6 15 20 15 6 1
11518
11519Beta Triangle (0 < k <= n)
11520n = 1 1 = 1 * (1) = leibniz_horizontal 0
11521n = 2 2 2 = 2 * (1 1) = leibniz_horizontal 1
11522n = 3 3 6 3 = 3 * (1 2 1) = leibniz_horizontal 2
11523n = 4 4 12 12 4 = 4 * (1 3 3 1) = leibniz_horizontal 3
11524n = 5 5 20 30 20 5 = 5 * (1 4 6 4 1) = leibniz_horizontal 4
11525n = 6 6 30 60 60 30 6 = 6 * (1 5 10 10 5 1) = leibniz_horizontal 5
11526
11527> EVAL ``let n = 10 in let k = 6 in (beta (n+1) (k+1) = leibniz n k)``; --> T
11528> EVAL ``let n = 10 in let k = 4 in (beta (n+1) (k+1) = leibniz n k)``; --> T
11529> EVAL ``let n = 10 in let k = 3 in (beta (n+1) (k+1) = leibniz n k)``; --> T
11530
11531*)
11532
11533(* Theorem: beta 0 n = 0 *)
11534(* Proof:
11535 beta 0 n
11536 = n * (binomial 0 n) by notation
11537 = n * (if n = 0 then 1 else 0) by binomial_0_n
11538 = 0
11539*)
11540Theorem beta_0_n:
11541 !n. beta 0 n = 0
11542Proof
11543 rw[binomial_0_n]
11544QED
11545
11546(* Theorem: beta n 0 = 0 *)
11547(* Proof: by notation *)
11548Theorem beta_n_0:
11549 !n. beta n 0 = 0
11550Proof
11551 rw[]
11552QED
11553
11554(* Theorem: n < k ==> (beta n k = 0) *)
11555(* Proof: by notation, binomial_less_0 *)
11556Theorem beta_less_0:
11557 !n k. n < k ==> (beta n k = 0)
11558Proof
11559 rw[binomial_less_0]
11560QED
11561
11562(* Theorem: beta (n + 1) (k + 1) = leibniz n k *)
11563(* Proof:
11564 If k <= n, then k + 1 <= n + 1 by arithmetic
11565 beta (n + 1) (k + 1)
11566 = (k + 1) binomial (n + 1) (k + 1) by notation
11567 = (k + 1) (n + 1)! / (k + 1)! (n - k)! by binomial_formula2
11568 = (n + 1) n! / k! (n - k)! by factorial composing and decomposing
11569 = (n + 1) * binomial n k by binomial_formula2
11570 = leibniz_horizontal n k by leibniz_def
11571 If ~(k <= n), then n < k /\ n + 1 < k + 1 by arithmetic
11572 Then beta (n + 1) (k + 1) = 0 by beta_less_0
11573 and leibniz n k = 0 by leibniz_less_0
11574 Hence true.
11575*)
11576Theorem beta_eqn:
11577 !n k. beta (n + 1) (k + 1) = leibniz n k
11578Proof
11579 rpt strip_tac >>
11580 Cases_on `k <= n` >| [
11581 `(n + 1) - (k + 1) = n - k` by decide_tac >>
11582 `k + 1 <= n + 1` by decide_tac >>
11583 `FACT (n - k) * FACT k * beta (n + 1) (k + 1) = FACT (n - k) * FACT k * ((k + 1) * binomial (n + 1) (k + 1))` by rw[] >>
11584 `_ = FACT (n - k) * FACT (k + 1) * binomial (n + 1) (k + 1)` by metis_tac[FACT, ADD1, MULT_ASSOC, MULT_COMM] >>
11585 `_ = FACT (n + 1)` by metis_tac[binomial_formula2, MULT_ASSOC, MULT_COMM] >>
11586 `_ = (n + 1) * FACT n` by metis_tac[FACT, ADD1] >>
11587 `_ = FACT (n - k) * FACT k * ((n + 1) * binomial n k)` by metis_tac[binomial_formula2, MULT_ASSOC, MULT_COMM] >>
11588 `_ = FACT (n - k) * FACT k * (leibniz n k)` by rw[leibniz_def] >>
11589 `FACT k <> 0 /\ FACT (n - k) <> 0` by metis_tac[FACT_LESS, NOT_ZERO_LT_ZERO] >>
11590 metis_tac[EQ_MULT_LCANCEL, MULT_ASSOC],
11591 rw[beta_less_0, leibniz_less_0]
11592 ]
11593QED
11594
11595(* Theorem: 0 < n /\ 0 < k ==> (beta n k = leibniz (n - 1) (k - 1)) *)
11596(* Proof: by beta_eqn *)
11597Theorem beta_alt:
11598 !n k. 0 < n /\ 0 < k ==> (beta n k = leibniz (n - 1) (k - 1))
11599Proof
11600 rw[GSYM beta_eqn]
11601QED
11602
11603(* Theorem: 0 < k /\ k <= n ==> 0 < beta n k *)
11604(* Proof:
11605 0 < beta n k
11606 <=> beta n k <> 0 by NOT_ZERO_LT_ZERO
11607 <=> k * (binomial n k) <> 0 by notation
11608 <=> k <> 0 /\ binomial n k <> 0 by MULT_EQ_0
11609 <=> k <> 0 /\ k <= n by binomial_pos
11610 <=> 0 < k /\ k <= n by NOT_ZERO_LT_ZERO
11611*)
11612Theorem beta_pos:
11613 !n k. 0 < k /\ k <= n ==> 0 < beta n k
11614Proof
11615 metis_tac[MULT_EQ_0, binomial_pos, NOT_ZERO_LT_ZERO]
11616QED
11617
11618(* Theorem: (beta n k = 0) <=> (k = 0) \/ n < k *)
11619(* Proof:
11620 beta n k = 0
11621 <=> k * (binomial n k) = 0 by notation
11622 <=> (k = 0) \/ (binomial n k = 0) by MULT_EQ_0
11623 <=> (k = 0) \/ (n < k) by binomial_eq_0
11624*)
11625Theorem beta_eq_0:
11626 !n k. (beta n k = 0) <=> (k = 0) \/ n < k
11627Proof
11628 rw[binomial_eq_0]
11629QED
11630
11631(*
11632binomial_sym |- !n k. k <= n ==> (binomial n k = binomial n (n - k))
11633leibniz_sym |- !n k. k <= n ==> (leibniz n k = leibniz n (n - k))
11634*)
11635
11636(* Theorem: k <= n ==> (beta n k = beta n (n - k + 1)) *)
11637(* Proof:
11638 If k = 0,
11639 Then beta n 0 = 0 by beta_n_0
11640 and beta n (n + 1) = 0 by beta_less_0
11641 Hence true.
11642 If k <> 0, then 0 < k
11643 Thus 0 < n by k <= n
11644 beta n k
11645 = leibniz (n - 1) (k - 1) by beta_alt
11646 = leibniz (n - 1) (n - k) by leibniz_sym
11647 = leibniz (n - 1) (n - k + 1 - 1) by arithmetic
11648 = beta n (n - k + 1) by beta_alt
11649*)
11650Theorem beta_sym:
11651 !n k. k <= n ==> (beta n k = beta n (n - k + 1))
11652Proof
11653 rpt strip_tac >>
11654 Cases_on `k = 0` >-
11655 rw[beta_n_0, beta_less_0] >>
11656 rw[beta_alt, Once leibniz_sym]
11657QED
11658
11659(* ------------------------------------------------------------------------- *)
11660(* Beta Horizontal List *)
11661(* ------------------------------------------------------------------------- *)
11662
11663(*
11664> EVAL ``leibniz_horizontal 3``; --> [4; 12; 12; 4]
11665> EVAL ``GENLIST (beta 4) 5``; --> [0; 4; 12; 12; 4]
11666> EVAL ``TL (GENLIST (beta 4) 5)``; --> [4; 12; 12; 4]
11667*)
11668
11669(* Use overloading for a row of beta n k, k = 1 to n. *)
11670(* val _ = overload_on("beta_horizontal", ``\n. TL (GENLIST (beta n) (n + 1))``); *)
11671(* use a direct GENLIST rather than tail of a GENLIST *)
11672Overload beta_horizontal[local] = ``\n. GENLIST (beta n o SUC) n``(* for temporary overloading *)
11673
11674(*
11675> EVAL ``leibniz_horizontal 5``; --> [6; 30; 60; 60; 30; 6]
11676> EVAL ``beta_horizontal 6``; --> [6; 30; 60; 60; 30; 6]
11677*)
11678
11679(* Theorem: beta_horizontal 0 = [] *)
11680(* Proof:
11681 beta_horizontal 0
11682 = GENLIST (beta 0 o SUC) 0 by notation
11683 = [] by GENLIST
11684*)
11685Theorem beta_horizontal_0:
11686 beta_horizontal 0 = []
11687Proof
11688 rw[]
11689QED
11690
11691(* Theorem: LENGTH (beta_horizontal n) = n *)
11692(* Proof:
11693 LENGTH (beta_horizontal n)
11694 = LENGTH (GENLIST (beta n o SUC) n) by notation
11695 = n by LENGTH_GENLIST
11696*)
11697Theorem beta_horizontal_len:
11698 !n. LENGTH (beta_horizontal n) = n
11699Proof
11700 rw[]
11701QED
11702
11703(* Theorem: beta_horizontal (n + 1) = leibniz_horizontal n *)
11704(* Proof:
11705 Note beta_horizontal (n + 1) = GENLIST ((beta (n + 1) o SUC)) (n + 1) by notation
11706 and leibniz_horizontal n = GENLIST (leibniz n) (n + 1) by notation
11707 Now (beta (n + 1)) o SUC) k
11708 = beta (n + 1) (k + 1) by ADD1
11709 = leibniz n k by beta_eqn
11710 Thus beta_horizontal (n + 1) = leibniz_horizontal n by GENLIST_FUN_EQ
11711*)
11712Theorem beta_horizontal_eqn:
11713 !n. beta_horizontal (n + 1) = leibniz_horizontal n
11714Proof
11715 rw[GENLIST_FUN_EQ, beta_eqn, ADD1]
11716QED
11717
11718(* Theorem: 0 < n ==> (beta_horizontal n = leibniz_horizontal (n - 1)) *)
11719(* Proof: by beta_horizontal_eqn *)
11720Theorem beta_horizontal_alt:
11721 !n. 0 < n ==> (beta_horizontal n = leibniz_horizontal (n - 1))
11722Proof
11723 metis_tac[beta_horizontal_eqn, DECIDE``0 < n ==> (n - 1 + 1 = n)``]
11724QED
11725
11726(* Theorem: 0 < k /\ k <= n ==> MEM (beta n k) (beta_horizontal n) *)
11727(* Proof:
11728 By MEM_GENLIST, this is to show:
11729 ?m. m < n /\ (beta n k = beta n (SUC m))
11730 Since k <> 0, k = SUC m,
11731 and SUC m = k <= n ==> m < n by arithmetic
11732 So take this m, and the result follows.
11733*)
11734Theorem beta_horizontal_mem:
11735 !n k. 0 < k /\ k <= n ==> MEM (beta n k) (beta_horizontal n)
11736Proof
11737 rpt strip_tac >>
11738 rw[MEM_GENLIST] >>
11739 `?m. k = SUC m` by metis_tac[num_CASES, NOT_ZERO_LT_ZERO] >>
11740 `m < n` by decide_tac >>
11741 metis_tac[]
11742QED
11743
11744(* too weak:
11745binomial_horizontal_mem |- !n k. k < n + 1 ==> MEM (binomial n k) (binomial_horizontal n)
11746leibniz_horizontal_mem |- !n k. k <= n ==> MEM (leibniz n k) (leibniz_horizontal n)
11747*)
11748
11749(* Theorem: MEM (beta n k) (beta_horizontal n) <=> 0 < k /\ k <= n *)
11750(* Proof:
11751 By MEM_GENLIST, this is to show:
11752 (?m. m < n /\ (beta n k = beta n (SUC m))) <=> 0 < k /\ k <= n
11753 If part: (?m. m < n /\ (beta n k = beta n (SUC m))) ==> 0 < k /\ k <= n
11754 By contradiction, suppose k = 0 \/ n < k
11755 Note SUC m <> 0 /\ ~(n < SUC m) by m < n
11756 Thus beta n (SUC m) <> 0 by beta_eq_0
11757 or beta n k <> 0 by beta n k = beta n (SUC m)
11758 ==> (k <> 0) /\ ~(n < k) by beta_eq_0
11759 This contradicts k = 0 \/ n < k.
11760 Only-if part: 0 < k /\ k <= n ==> ?m. m < n /\ (beta n k = beta n (SUC m))
11761 Note k <> 0, so ?m. k = SUC m by num_CASES
11762 and SUC m <= n <=> m < n by LESS_EQ
11763 so Take this m, and the result follows.
11764*)
11765Theorem beta_horizontal_mem_iff:
11766 !n k. MEM (beta n k) (beta_horizontal n) <=> 0 < k /\ k <= n
11767Proof
11768 rw[MEM_GENLIST] >>
11769 rewrite_tac[EQ_IMP_THM] >>
11770 strip_tac >| [
11771 spose_not_then strip_assume_tac >>
11772 `SUC m <> 0 /\ ~(n < SUC m)` by decide_tac >>
11773 `(k <> 0) /\ ~(n < k)` by metis_tac[beta_eq_0] >>
11774 decide_tac,
11775 strip_tac >>
11776 `?m. k = SUC m` by metis_tac[num_CASES, NOT_ZERO_LT_ZERO] >>
11777 metis_tac[LESS_EQ]
11778 ]
11779QED
11780
11781(* Theorem: MEM x (beta_horizontal n) <=> ?k. 0 < k /\ k <= n /\ (x = beta n k) *)
11782(* Proof:
11783 By MEM_GENLIST, this is to show:
11784 (?m. m < n /\ (x = beta n (SUC m))) <=> ?k. 0 < k /\ k <= n /\ (x = beta n k)
11785 Since 0 < k /\ k <= n <=> ?m. (k = SUC m) /\ m < n by num_CASES, LESS_EQ
11786 This is trivially true.
11787*)
11788Theorem beta_horizontal_member:
11789 !n x. MEM x (beta_horizontal n) <=> ?k. 0 < k /\ k <= n /\ (x = beta n k)
11790Proof
11791 rw[MEM_GENLIST] >>
11792 metis_tac[num_CASES, NOT_ZERO_LT_ZERO, SUC_NOT_ZERO, LESS_EQ]
11793QED
11794
11795(* Theorem: k < n ==> (EL k (beta_horizontal n) = beta n (k + 1)) *)
11796(* Proof: by EL_GENLIST, ADD1 *)
11797Theorem beta_horizontal_element:
11798 !n k. k < n ==> (EL k (beta_horizontal n) = beta n (k + 1))
11799Proof
11800 rw[EL_GENLIST, ADD1]
11801QED
11802
11803(* Theorem: 0 < n ==> (lcm_run n = list_lcm (beta_horizontal n)) *)
11804(* Proof:
11805 Note n <> 0
11806 ==> n = SUC k for some k by num_CASES
11807 or n = k + 1 by ADD1
11808 lcm_run n
11809 = lcm_run (k + 1)
11810 = list_lcm (leibniz_horizontal k) by leibniz_lcm_property
11811 = list_lcm (beta_horizontal n) by beta_horizontal_eqn
11812*)
11813Theorem lcm_run_by_beta_horizontal:
11814 !n. 0 < n ==> (lcm_run n = list_lcm (beta_horizontal n))
11815Proof
11816 metis_tac[leibniz_lcm_property, beta_horizontal_eqn, num_CASES, ADD1, NOT_ZERO_LT_ZERO]
11817QED
11818
11819(* Theorem: 0 < k /\ k <= n ==> (beta n k) divides lcm_run n *)
11820(* Proof:
11821 Note 0 < n by 0 < k /\ k <= n
11822 and MEM (beta n k) (beta_horizontal n) by beta_horizontal_mem
11823 also lcm_run n = list_lcm (beta_horizontal n) by lcm_run_by_beta_horizontal, 0 < n
11824 Thus (beta n k) divides lcm_run n by list_lcm_is_common_multiple
11825*)
11826Theorem lcm_run_beta_divisor:
11827 !n k. 0 < k /\ k <= n ==> (beta n k) divides lcm_run n
11828Proof
11829 rw[beta_horizontal_mem, lcm_run_by_beta_horizontal, list_lcm_is_common_multiple]
11830QED
11831
11832(* Theorem: k <= m /\ m <= n ==> (beta n k) divides (beta m k) * (binomial n m) *)
11833(* Proof:
11834 Note (binomial m k) * (binomial n m)
11835 = (binomial n k) * (binomial (n - k) (m - k)) by binomial_product_identity
11836 Thus binomial n k divides binomial m k * binomial n m by divides_def, MULT_COMM
11837 ==> k * binomial n k divides k * (binomial m k * binomial n m) by DIVIDES_CANCEL_COMM
11838 = (k * binomial m k) * binomial n m by MULT_ASSOC
11839 or (beta n k) divides (beta m k) * (binomial n m) by notation
11840*)
11841Theorem beta_divides_beta_factor:
11842 !m n k. k <= m /\ m <= n ==> (beta n k) divides (beta m k) * (binomial n m)
11843Proof
11844 rw[] >>
11845 `binomial n k divides binomial m k * binomial n m` by metis_tac[binomial_product_identity, divides_def, MULT_COMM] >>
11846 metis_tac[DIVIDES_CANCEL_COMM, MULT_ASSOC]
11847QED
11848
11849(* Theorem: n <= 2 * m /\ m <= n ==> (lcm_run n) divides (binomial n m) * (lcm_run m) *)
11850(* Proof:
11851 If n = 0,
11852 Then lcm_run 0 = 1 by lcm_run_0
11853 Hence true by ONE_DIVIDES_ALL
11854 If n <> 0, then 0 < n.
11855 Let q = (binomial n m) * (lcm_run m)
11856
11857 Claim: !x. MEM x (beta_horizontal n) ==> x divides q
11858 Proof: Note MEM x (beta_horizontal n)
11859 ==> ?k. 0 < k /\ k <= n /\ (x = beta n k) by beta_horizontal_member
11860 Here the picture is:
11861 HALF n ... m .... n
11862 0 ........ k ........... n
11863 We need k <= m to get x divides q.
11864 For m < k <= n, we shall use symmetry to get x divides q.
11865 If k <= m,
11866 Let p = (beta m k) * (binomial n m).
11867 Then x divides p by beta_divides_beta_factor, k <= m, m <= n
11868 and (beta m k) divides lcm_run m by lcm_run_beta_divisor, 0 < k /\ k <= m
11869 so (beta m k) * (binomial n m)
11870 divides
11871 (lcm_run m) * (binomial n m) by DIVIDES_CANCEL, binomial_pos
11872 or p divides q by MULT_COMM
11873 Thus x divides q by DIVIDES_TRANS
11874 If ~(k <= m), then m < k.
11875 Note x = beta n (n - k + 1) by beta_sym, k <= n
11876 Now n <= m + m by given
11877 so n - k + 1 <= m + m + 1 - k by arithmetic
11878 and m + m + 1 - k <= m by m < k
11879 ==> n - k + 1 <= m by arithmetic
11880 Let h = n - k + 1, p = (beta m h) * (binomial n m).
11881 Then x divides p by beta_divides_beta_factor, h <= m, m <= n
11882 and (beta m h) divides lcm_run m by lcm_run_beta_divisor, 0 < h /\ h <= m
11883 so (beta m h) * (binomial n m)
11884 divides
11885 (lcm_run m) * (binomial n m) by DIVIDES_CANCEL, binomial_pos
11886 or p divides q by MULT_COMM
11887 Thus x divides q by DIVIDES_TRANS
11888
11889 Therefore,
11890 (list_lcm (beta_horizontal n)) divides q by list_lcm_is_least_common_multiple, Claim
11891 or (lcm_run n) divides q by lcm_run_by_beta_horizontal, 0 < n
11892*)
11893Theorem lcm_run_divides_property_alt:
11894 !m n. n <= 2 * m /\ m <= n ==> (lcm_run n) divides (binomial n m) * (lcm_run m)
11895Proof
11896 rpt strip_tac >>
11897 Cases_on `n = 0` >-
11898 rw[lcm_run_0] >>
11899 `0 < n` by decide_tac >>
11900 qabbrev_tac `q = (binomial n m) * (lcm_run m)` >>
11901 `!x. MEM x (beta_horizontal n) ==> x divides q` by
11902 (rpt strip_tac >>
11903 `?k. 0 < k /\ k <= n /\ (x = beta n k)` by rw[GSYM beta_horizontal_member] >>
11904 Cases_on `k <= m` >| [
11905 qabbrev_tac `p = (beta m k) * (binomial n m)` >>
11906 `x divides p` by rw[beta_divides_beta_factor, Abbr`p`] >>
11907 `(beta m k) divides lcm_run m` by rw[lcm_run_beta_divisor] >>
11908 `p divides q` by metis_tac[DIVIDES_CANCEL, MULT_COMM, binomial_pos] >>
11909 metis_tac[DIVIDES_TRANS],
11910 `x = beta n (n - k + 1)` by rw[Once beta_sym] >>
11911 `n - k + 1 <= m` by decide_tac >>
11912 qabbrev_tac `h = n - k + 1` >>
11913 qabbrev_tac `p = (beta m h) * (binomial n m)` >>
11914 `x divides p` by rw[beta_divides_beta_factor, Abbr`p`] >>
11915 `(beta m h) divides lcm_run m` by rw[lcm_run_beta_divisor, Abbr`h`] >>
11916 `p divides q` by metis_tac[DIVIDES_CANCEL, MULT_COMM, binomial_pos] >>
11917 metis_tac[DIVIDES_TRANS]
11918 ]) >>
11919 `(list_lcm (beta_horizontal n)) divides q` by metis_tac[list_lcm_is_least_common_multiple] >>
11920 metis_tac[lcm_run_by_beta_horizontal]
11921QED
11922
11923(* This is the original lcm_run_divides_property to give lcm_run_upper_bound. *)
11924
11925(* Theorem: lcm_run n <= 4 ** n *)
11926(* Proof:
11927 By complete induction on n.
11928 If EVEN n,
11929 Base: n = 0.
11930 LHS = lcm_run 0 = 1 by lcm_run_0
11931 RHS = 4 ** 0 = 1 by EXP
11932 Hence true.
11933 Step: n <> 0 /\ !m. m < n ==> lcm_run m <= 4 ** m ==> lcm_run n <= 4 ** n
11934 Let m = HALF n, c = binomial n m * lcm_run m.
11935 Then n = 2 * m by EVEN_HALF
11936 so m <= 2 * m = n by arithmetic
11937 Note 0 < binomial n m by binomial_pos, m <= n
11938 and 0 < lcm_run m by lcm_run_pos
11939 ==> 0 < c by MULT_EQ_0
11940 Thus (lcm_run n) divides c by lcm_run_divides_property, m <= n
11941 or lcm_run n
11942 <= c by DIVIDES_LE, 0 < c
11943 = (binomial n m) * lcm_run m by notation
11944 <= (binomial n m) * 4 ** m by induction hypothesis, m < n
11945 <= 4 ** m * 4 ** m by binomial_middle_upper_bound
11946 = 4 ** (m + m) by EXP_ADD
11947 = 4 ** n by TIMES2, n = 2 * m
11948 Hence lcm_run n <= 4 ** n.
11949 If ~EVEN n,
11950 Then ODD n by EVEN_ODD
11951 Base: n = 1.
11952 LHS = lcm_run 1 = 1 by lcm_run_1
11953 RHS = 4 ** 1 = 4 by EXP
11954 Hence true.
11955 Step: n <> 1 /\ !m. m < n ==> lcm_run m <= 4 ** m ==> lcm_run n <= 4 ** n
11956 Let m = HALF n, c = binomial n (m + 1) * lcm_run (m + 1).
11957 Then n = 2 * m + 1 by ODD_HALF
11958 and 0 < m by n <> 1
11959 and m + 1 <= 2 * m + 1 = n by arithmetic
11960 But m + 1 <> n by m <> 0
11961 so m + 1 < n by m + 1 <> n
11962 Note 0 < binomial n (m + 1) by binomial_pos, m + 1 <= n
11963 and 0 < lcm_run (m + 1) by lcm_run_pos
11964 ==> 0 < c by MULT_EQ_0
11965 Thus (lcm_run n) divides c by lcm_run_divides_property, 0 < m + 1, m + 1 <= n
11966 or lcm_run n
11967 <= c by DIVIDES_LE, 0 < c
11968 = (binomial n (m + 1)) * lcm_run (m + 1) by notation
11969 <= (binomial n (m + 1)) * 4 ** (m + 1) by induction hypothesis, m + 1 < n
11970 = (binomial n m) * 4 ** (m + 1) by binomial_sym, n - (m + 1) = m
11971 <= 4 ** m * 4 ** (m + 1) by binomial_middle_upper_bound
11972 = 4 ** (m + (m + 1)) by EXP_ADD
11973 = 4 ** (2 * m + 1) by arithmetic
11974 = 4 ** n by n = 2 * m + 1
11975 Hence lcm_run n <= 4 ** n.
11976*)
11977Theorem lcm_run_upper_bound[allow_rebind]:
11978 !n. lcm_run n <= 4 ** n
11979Proof
11980 completeInduct_on `n` >>
11981 Cases_on `EVEN n` >| [
11982 Cases_on `n = 0` >-
11983 rw[lcm_run_0] >>
11984 qabbrev_tac `m = HALF n` >>
11985 `n = 2 * m` by rw[EVEN_HALF, Abbr`m`] >>
11986 qabbrev_tac `c = binomial n m * lcm_run m` >>
11987 `m <= n` by decide_tac >>
11988 `0 < c` by metis_tac[binomial_pos, lcm_run_pos, MULT_EQ_0, NOT_ZERO_LT_ZERO] >>
11989 `lcm_run n <= c` by rw[lcm_run_divides_property, DIVIDES_LE, Abbr`c`] >>
11990 `lcm_run m <= 4 ** m` by rw[] >>
11991 `binomial n m <= 4 ** m` by metis_tac[binomial_middle_upper_bound] >>
11992 `c <= 4 ** m * 4 ** m` by rw[LESS_MONO_MULT2, Abbr`c`] >>
11993 `4 ** m * 4 ** m = 4 ** n` by metis_tac[EXP_ADD, TIMES2] >>
11994 decide_tac,
11995 `ODD n` by metis_tac[EVEN_ODD] >>
11996 Cases_on `n = 1` >-
11997 rw[lcm_run_1] >>
11998 qabbrev_tac `m = HALF n` >>
11999 `n = 2 * m + 1` by rw[ODD_HALF, Abbr`m`] >>
12000 `0 < m` by rw[] >>
12001 qabbrev_tac `c = binomial n (m + 1) * lcm_run (m + 1)` >>
12002 `m + 1 <= n` by decide_tac >>
12003 `0 < c` by metis_tac[binomial_pos, lcm_run_pos, MULT_EQ_0, NOT_ZERO_LT_ZERO] >>
12004 `lcm_run n <= c` by rw[lcm_run_divides_property, DIVIDES_LE, Abbr`c`] >>
12005 `lcm_run (m + 1) <= 4 ** (m + 1)` by rw[] >>
12006 `binomial n (m + 1) = binomial n m` by rw[Once binomial_sym] >>
12007 `binomial n m <= 4 ** m` by metis_tac[binomial_middle_upper_bound] >>
12008 `c <= 4 ** m * 4 ** (m + 1)` by rw[LESS_MONO_MULT2, Abbr`c`] >>
12009 `4 ** m * 4 ** (m + 1) = 4 ** n` by metis_tac[EXP_ADD, ADD_ASSOC, TIMES2] >>
12010 decide_tac
12011 ]
12012QED
12013
12014(* This is the original proof of the upper bound. *)
12015
12016(* ------------------------------------------------------------------------- *)
12017(* LCM Lower Bound using Maximum *)
12018(* ------------------------------------------------------------------------- *)
12019
12020(* Theorem: POSITIVE l ==> MAX_LIST l <= list_lcm l *)
12021(* Proof:
12022 If l = [],
12023 Note MAX_LIST [] = 0 by MAX_LIST_NIL
12024 and list_lcm [] = 1 by list_lcm_nil
12025 Hence true.
12026 If l <> [],
12027 Let x = MAX_LIST l.
12028 Then MEM x l by MAX_LIST_MEM
12029 and x divides (list_lcm l) by list_lcm_is_common_multiple
12030 Now 0 < list_lcm l by list_lcm_pos, EVERY_MEM
12031 so x <= list_lcm l by DIVIDES_LE, 0 < list_lcm l
12032*)
12033Theorem list_lcm_ge_max:
12034 !l. POSITIVE l ==> MAX_LIST l <= list_lcm l
12035Proof
12036 rpt strip_tac >>
12037 Cases_on `l = []` >-
12038 rw[MAX_LIST_NIL, list_lcm_nil] >>
12039 `MEM (MAX_LIST l) l` by rw[MAX_LIST_MEM] >>
12040 `0 < list_lcm l` by rw[list_lcm_pos, EVERY_MEM] >>
12041 rw[list_lcm_is_common_multiple, DIVIDES_LE]
12042QED
12043
12044(* Theorem: (n + 1) * binomial n (HALF n) <= list_lcm [1 .. (n + 1)] *)
12045(* Proof:
12046 Note !k. MEM k (binomial_horizontal n) ==> 0 < k by binomial_horizontal_pos_alt [1]
12047
12048 list_lcm [1 .. (n + 1)]
12049 = list_lcm (leibniz_vertical n) by notation
12050 = list_lcm (leibniz_horizontal n) by leibniz_lcm_property
12051 = (n + 1) * list_lcm (binomial_horizontal n) by leibniz_horizontal_lcm_alt
12052 >= (n + 1) * MAX_LIST (binomial_horizontal n) by list_lcm_ge_max, [1], LE_MULT_LCANCEL
12053 = (n + 1) * binomial n (HALF n) by binomial_horizontal_max
12054*)
12055Theorem lcm_lower_bound_by_list_lcm:
12056 !n. (n + 1) * binomial n (HALF n) <= list_lcm [1 .. (n + 1)]
12057Proof
12058 rpt strip_tac >>
12059 `MAX_LIST (binomial_horizontal n) <= list_lcm (binomial_horizontal n)` by
12060 (irule list_lcm_ge_max >>
12061 metis_tac[binomial_horizontal_pos_alt]) >>
12062 `list_lcm (leibniz_vertical n) = list_lcm (leibniz_horizontal n)` by rw[leibniz_lcm_property] >>
12063 `_ = (n + 1) * list_lcm (binomial_horizontal n)` by rw[leibniz_horizontal_lcm_alt] >>
12064 `n + 1 <> 0` by decide_tac >>
12065 metis_tac[LE_MULT_LCANCEL, binomial_horizontal_max]
12066QED
12067
12068(* Theorem: FINITE s /\ (!x. x IN s ==> 0 < x) ==> MAX_SET s <= big_lcm s *)
12069(* Proof:
12070 If s = {},
12071 Note MAX_SET {} = 0 by MAX_SET_EMPTY
12072 and big_lcm {} = 1 by big_lcm_empty
12073 Hence true.
12074 If s <> {},
12075 Let x = MAX_SET s.
12076 Then x IN s by MAX_SET_IN_SET
12077 and x divides (big_lcm s) by big_lcm_is_common_multiple
12078 Now 0 < big_lcm s by big_lcm_positive
12079 so x <= big_lcm s by DIVIDES_LE, 0 < big_lcm s
12080*)
12081Theorem big_lcm_ge_max:
12082 !s. FINITE s /\ (!x. x IN s ==> 0 < x) ==> MAX_SET s <= big_lcm s
12083Proof
12084 rpt strip_tac >>
12085 Cases_on `s = {}` >-
12086 rw[MAX_SET_EMPTY, big_lcm_empty] >>
12087 `(MAX_SET s) IN s` by rw[MAX_SET_IN_SET] >>
12088 `0 < big_lcm s` by rw[big_lcm_positive] >>
12089 rw[big_lcm_is_common_multiple, DIVIDES_LE]
12090QED
12091
12092(* Theorem: (n + 1) * binomial n (HALF n) <= big_lcm (natural (n + 1)) *)
12093(* Proof:
12094 Claim: MAX_SET (IMAGE (binomial n) (count (n + 1))) <= big_lcm (IMAGE (binomial n) count (n + 1))
12095 Proof: By big_lcm_ge_max, this is to show:
12096 (1) FINITE (IMAGE (binomial n) (count (n + 1)))
12097 This is true by FINITE_COUNT, IMAGE_FINITE
12098 (2) !x. x IN IMAGE (binomial n) (count (n + 1)) ==> 0 < x
12099 This is true by binomial_pos, IN_IMAGE, IN_COUNT
12100
12101 big_lcm (natural (n + 1))
12102 = (n + 1) * big_lcm (IMAGE (binomial n) (count (n + 1))) by big_lcm_natural_eqn
12103 >= (n + 1) * MAX_SET (IMAGE (binomial n) (count (n + 1))) by claim, LE_MULT_LCANCEL
12104 = (n + 1) * binomial n (HALF n) by binomial_row_max
12105*)
12106Theorem lcm_lower_bound_by_big_lcm:
12107 !n. (n + 1) * binomial n (HALF n) <= big_lcm (natural (n + 1))
12108Proof
12109 rpt strip_tac >>
12110 `MAX_SET (IMAGE (binomial n) (count (n + 1))) <=
12111 big_lcm (IMAGE (binomial n) (count (n + 1)))` by
12112 ((irule big_lcm_ge_max >> rpt conj_tac) >-
12113 metis_tac[binomial_pos, IN_IMAGE, IN_COUNT, DECIDE``x < n + 1 ==> x <= n``] >>
12114 rw[]
12115 ) >>
12116 metis_tac[big_lcm_natural_eqn, LE_MULT_LCANCEL, binomial_row_max, DECIDE``n + 1 <> 0``]
12117QED
12118
12119(* ------------------------------------------------------------------------- *)
12120(* Consecutive LCM function *)
12121(* ------------------------------------------------------------------------- *)
12122
12123(* Theorem: Stirling /\ (!n c. n DIV (SQRT (c * (n - 1))) = SQRT (n DIV c)) ==>
12124 !n. ODD n ==> (SQRT (n DIV (2 * pi))) * (2 ** n) <= list_lcm [1 .. n] *)
12125(* Proof:
12126 Note ODD n ==> n <> 0 by EVEN_0, EVEN_ODD
12127 If n = 1,
12128 Note 1 <= pi by 0 < pi
12129 so 2 <= 2 * pi by LE_MULT_LCANCEL, 2 <> 0
12130 or 1 < 2 * pi by arithmetic
12131 Thus 1 DIV (2 * pi) = 0 by ONE_DIV, 1 < 2 * pi
12132 and SQRT (1 DIV (2 * pi)) = 0 by ZERO_EXP, 0 ** h, h <> 0
12133 But list_lcm [1 .. 1] = 1 by list_lcm_sing
12134 so SQRT (1 DIV (2 * pi)) * 2 ** 1 <= list_lcm [1 .. 1] by MULT
12135 If n <> 1,
12136 Then 0 < n - 1.
12137 Let m = n - 1, then n = m + 1 by arithmetic
12138 and n * binomial m (HALF m) <= list_lcm [1 .. n] by lcm_lower_bound_by_list_lcm
12139 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
12140 Note ODD n ==> EVEN m by EVEN_ODD_SUC, ADD1
12141 n * binomial m (HALF m)
12142 = n * (2 ** n DIV SQRT (2 * pi * m)) by binomial_middle_by_stirling
12143 = (2 ** n DIV SQRT (2 * pi * m)) * n by MULT_COMM
12144 = (2 ** n * n) DIV (SQRT (2 * pi * m)) by above
12145 = (n * 2 ** n) DIV (SQRT (2 * pi * m)) by MULT_COMM
12146 = (n DIV SQRT (2 * pi * m)) * 2 ** n by above
12147 = (SQRT (n DIV (2 * pi)) * 2 ** n by assumption, m = n - 1
12148 Hence SQRT (n DIV (2 * pi))) * (2 ** n) <= list_lcm [1 .. n]
12149*)
12150Theorem lcm_lower_bound_by_list_lcm_stirling:
12151 Stirling /\ (!n c. n DIV (SQRT (c * (n - 1))) = SQRT (n DIV c)) ==>
12152 !n. ODD n ==> (SQRT (n DIV (2 * pi))) * (2 ** n) <= list_lcm [1 .. n]
12153Proof
12154 rpt strip_tac >>
12155 `!n. 0 < n /\ EVEN n ==> (binomial n (HALF n) = 2 ** (n + 1) DIV SQRT (2 * pi * n))` by prove_tac[binomial_middle_by_stirling] >>
12156 `n <> 0` by metis_tac[EVEN_0, EVEN_ODD] >>
12157 Cases_on `n = 1` >| [
12158 `1 <= pi` by decide_tac >>
12159 `1 < 2 * pi` by decide_tac >>
12160 `1 DIV (2 * pi) = 0` by rw[ONE_DIV] >>
12161 `SQRT (1 DIV (2 * pi)) * 2 ** 1 = 0` by rw[] >>
12162 rw[list_lcm_sing],
12163 `0 < n - 1 /\ (n = (n - 1) + 1)` by decide_tac >>
12164 qabbrev_tac `m = n - 1` >>
12165 `n * binomial m (HALF m) <= list_lcm [1 .. n]` by metis_tac[lcm_lower_bound_by_list_lcm] >>
12166 `EVEN m` by metis_tac[EVEN_ODD_SUC, ADD1] >>
12167 `!a b c. (a DIV b) * c = (a * c) DIV b` by metis_tac[DIV_1, MULT_RIGHT_1] >>
12168 `n * binomial m (HALF m) = n * (2 ** n DIV SQRT (2 * pi * m))` by rw[] >>
12169 `_ = (n DIV SQRT (2 * pi * m)) * 2 ** n` by metis_tac[MULT_COMM] >>
12170 metis_tac[]
12171 ]
12172QED
12173
12174(* Theorem: big_lcm (natural n) <= big_lcm (natural (n + 1)) *)
12175(* Proof:
12176 Note FINITE (natural n) by natural_finite
12177 and 0 < big_lcm (natural n) by big_lcm_positive, natural_element
12178 big_lcm (natural n)
12179 <= lcm (SUC n) (big_lcm (natural n)) by LCM_LE, 0 < SUC n, 0 < big_lcm (natural n)
12180 = big_lcm ((SUC n) INSERT (natural n)) by big_lcm_insert
12181 = big_lcm (natural (SUC n)) by natural_suc
12182 = big_lcm (natural (n + 1)) by ADD1
12183*)
12184Theorem big_lcm_non_decreasing:
12185 !n. big_lcm (natural n) <= big_lcm (natural (n + 1))
12186Proof
12187 rpt strip_tac >>
12188 `FINITE (natural n)` by rw[natural_finite] >>
12189 `0 < big_lcm (natural n)` by rw[big_lcm_positive, natural_element] >>
12190 `big_lcm (natural (n + 1)) = big_lcm (natural (SUC n))` by rw[ADD1] >>
12191 `_ = big_lcm ((SUC n) INSERT (natural n))` by rw[natural_suc] >>
12192 `_ = lcm (SUC n) (big_lcm (natural n))` by rw[big_lcm_insert] >>
12193 rw[LCM_LE]
12194QED
12195
12196(* Theorem: Stirling /\ (!n c. n DIV (SQRT (c * (n - 1))) = SQRT (n DIV c)) ==>
12197 !n. ODD n ==> (SQRT (n DIV (2 * pi))) * (2 ** n) <= big_lcm (natural n) *)
12198(* Proof:
12199 Note ODD n ==> n <> 0 by EVEN_0, EVEN_ODD
12200 If n = 1,
12201 Note 1 <= pi by 0 < pi
12202 so 2 <= 2 * pi by LE_MULT_LCANCEL, 2 <> 0
12203 or 1 < 2 * pi by arithmetic
12204 Thus 1 DIV (2 * pi) = 0 by ONE_DIV, 1 < 2 * pi
12205 and SQRT (1 DIV (2 * pi)) = 0 by ZERO_EXP, 0 ** h, h <> 0
12206 But big_lcm (natural 1) = 1 by list_lcm_sing, natural_1
12207 so SQRT (1 DIV (2 * pi)) * 2 ** 1 <= big_lcm (natural 1) by MULT
12208 If n <> 1,
12209 Then 0 < n - 1.
12210 Let m = n - 1, then n = m + 1 by arithmetic
12211 and n * binomial m (HALF m) <= big_lcm (natural n) by lcm_lower_bound_by_big_lcm
12212 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
12213 Note ODD n ==> EVEN m by EVEN_ODD_SUC, ADD1
12214 n * binomial m (HALF m)
12215 = n * (2 ** n DIV SQRT (2 * pi * m)) by binomial_middle_by_stirling
12216 = (2 ** n DIV SQRT (2 * pi * m)) * n by MULT_COMM
12217 = (2 ** n * n) DIV (SQRT (2 * pi * m)) by above
12218 = (n * 2 ** n) DIV (SQRT (2 * pi * m)) by MULT_COMM
12219 = (n DIV SQRT (2 * pi * m)) * 2 ** n by above
12220 = (SQRT (n DIV (2 * pi)) * 2 ** n by assumption, m = n - 1
12221 Hence SQRT (n DIV (2 * pi))) * (2 ** n) <= big_lcm (natural n)
12222*)
12223Theorem lcm_lower_bound_by_big_lcm_stirling:
12224 Stirling /\ (!n c. n DIV (SQRT (c * (n - 1))) = SQRT (n DIV c)) ==>
12225 !n. ODD n ==> (SQRT (n DIV (2 * pi))) * (2 ** n) <= big_lcm (natural n)
12226Proof
12227 rpt strip_tac >>
12228 `!n. 0 < n /\ EVEN n ==> (binomial n (HALF n) = 2 ** (n + 1) DIV SQRT (2 * pi * n))` by prove_tac[binomial_middle_by_stirling] >>
12229 `n <> 0` by metis_tac[EVEN_0, EVEN_ODD] >>
12230 Cases_on `n = 1` >| [
12231 `1 <= pi` by decide_tac >>
12232 `1 < 2 * pi` by decide_tac >>
12233 `1 DIV (2 * pi) = 0` by rw[ONE_DIV] >>
12234 `SQRT (1 DIV (2 * pi)) * 2 ** 1 = 0` by rw[] >>
12235 rw[big_lcm_sing],
12236 `0 < n - 1 /\ (n = (n - 1) + 1)` by decide_tac >>
12237 qabbrev_tac `m = n - 1` >>
12238 `n * binomial m (HALF m) <= big_lcm (natural n)` by metis_tac[lcm_lower_bound_by_big_lcm] >>
12239 `EVEN m` by metis_tac[EVEN_ODD_SUC, ADD1] >>
12240 `!a b c. (a DIV b) * c = (a * c) DIV b` by metis_tac[DIV_1, MULT_RIGHT_1] >>
12241 `n * binomial m (HALF m) = n * (2 ** n DIV SQRT (2 * pi * m))` by rw[] >>
12242 `_ = (n DIV SQRT (2 * pi * m)) * 2 ** n` by metis_tac[MULT_COMM] >>
12243 metis_tac[]
12244 ]
12245QED
12246
12247(* ------------------------------------------------------------------------- *)
12248(* Extra Theorems (not used) *)
12249(* ------------------------------------------------------------------------- *)
12250
12251(*
12252This is GCD_CANCEL_MULT by coprime p n, and coprime p n ==> coprime (p ** k) n by coprime_exp.
12253Note prime_not_divides_coprime.
12254*)
12255
12256(* Theorem: prime p /\ m divides n /\ ~((p * m) divides n) ==> (gcd (p * m) n = m) *)
12257(* Proof:
12258 Note m divides n ==> ?q. n = q * m by divides_def
12259
12260 Claim: coprime p q
12261 Proof: By contradiction, suppose gcd p q <> 1.
12262 Since (gcd p q) divides p by GCD_IS_GREATEST_COMMON_DIVISOR
12263 so gcd p q = p by prime_def, gcd p q <> 1.
12264 or p divides q by divides_iff_gcd_fix
12265 Now, m <> 0 because
12266 If m = 0, p * m = 0 by MULT_0
12267 Then m divides n and ~((p * m) divides n) are contradictory.
12268 Thus p * m divides q * m by DIVIDES_MULTIPLE_IFF, MULT_COMM, p divides q, m <> 0
12269 But q * m = n, contradicting ~((p * m) divides n).
12270
12271 gcd (p * m) n
12272 = gcd (p * m) (q * m) by n = q * m
12273 = m * gcd p q by GCD_COMMON_FACTOR, MULT_COMM
12274 = m * 1 by coprime p q, from Claim
12275 = m
12276*)
12277Theorem gcd_prime_product_property:
12278 !p m n. prime p /\ m divides n /\ ~((p * m) divides n) ==> (gcd (p * m) n = m)
12279Proof
12280 rpt strip_tac >>
12281 `?q. n = q * m` by rw[GSYM divides_def] >>
12282 `m <> 0` by metis_tac[MULT_0] >>
12283 `coprime p q` by
12284 (spose_not_then strip_assume_tac >>
12285 `(gcd p q) divides p` by rw[GCD_IS_GREATEST_COMMON_DIVISOR] >>
12286 `gcd p q = p` by metis_tac[prime_def] >>
12287 `p divides q` by rw[divides_iff_gcd_fix] >>
12288 metis_tac[DIVIDES_MULTIPLE_IFF, MULT_COMM]) >>
12289 metis_tac[GCD_COMMON_FACTOR, MULT_COMM, MULT_RIGHT_1]
12290QED
12291
12292(* Theorem: prime p /\ m divides n /\ ~((p * m) divides n) ==>(lcm (p * m) n = p * n) *)
12293(* Proof:
12294 Note m <> 0 by MULT_0, m divides n /\ ~((p * m) divides n)
12295 and m * lcm (p * m) n
12296 = gcd (p * m) n * lcm (p * m) n by gcd_prime_product_property
12297 = (p * m) * n by GCD_LCM
12298 = (m * p) * n by MULT_COMM
12299 = m * (p * n) by MULT_ASSOC
12300 Thus lcm (p * m) n = p * n by MULT_LEFT_CANCEL
12301*)
12302Theorem lcm_prime_product_property:
12303 !p m n. prime p /\ m divides n /\ ~((p * m) divides n) ==>(lcm (p * m) n = p * n)
12304Proof
12305 rpt strip_tac >>
12306 `m <> 0` by metis_tac[MULT_0] >>
12307 `m * lcm (p * m) n = gcd (p * m) n * lcm (p * m) n` by rw[gcd_prime_product_property] >>
12308 `_ = (p * m) * n` by rw[GCD_LCM] >>
12309 `_ = m * (p * n)` by metis_tac[MULT_COMM, MULT_ASSOC] >>
12310 metis_tac[MULT_LEFT_CANCEL]
12311QED
12312
12313(* Theorem: prime p /\ p divides list_lcm l ==> p divides PROD_SET (set l) *)
12314(* Proof:
12315 By induction on l.
12316 Base: prime p /\ p divides list_lcm [] ==> p divides PROD_SET (set [])
12317 Note list_lcm [] = 1 by list_lcm_nil
12318 and PROD_SET (set [])
12319 = PROD_SET {} by LIST_TO_SET
12320 = 1 by PROD_SET_EMPTY
12321 Hence conclusion is alredy in predicate, thus true.
12322 Step: prime p /\ p divides list_lcm l ==> p divides PROD_SET (set l) ==>
12323 prime p /\ p divides list_lcm (h::l) ==> p divides PROD_SET (set (h::l))
12324 Note PROD_SET (set (h::l))
12325 = PROD_SET (h INSERT set l) by LIST_TO_SET
12326 This is to show: p divides PROD_SET (h INSERT set l)
12327
12328 Let x = list_lcm l.
12329 Since p divides (lcm h x) by given
12330 so p divides (gcd h x) * (lcm h x) by DIVIDES_MULTIPLE
12331 or p divides h * x by GCD_LCM
12332 ==> p divides h or p divides x by P_EUCLIDES
12333 Case: p divides h.
12334 If h IN set l, or MEM h l,
12335 Then h divides x by list_lcm_is_common_multiple
12336 so p divides x by DIVIDES_TRANS
12337 Thus p divides PROD_SET (set l) by induction hypothesis
12338 or p divides PROD_SET (h INSERT set l) by ABSORPTION
12339 If ~(h IN set l),
12340 Then PROD_SET (h INSERT set l) = h * PROD_SET (set l) by PROD_SET_INSERT
12341 or p divides PROD_SET (h INSERT set l) by DIVIDES_MULTIPLE, MULT_COMM
12342 Case: p divides x.
12343 If h IN set l, or MEM h l,
12344 Then p divides PROD_SET (set l) by induction hypothesis
12345 or p divides PROD_SET (h INSERT set l) by ABSORPTION
12346 If ~(h IN set l),
12347 Then PROD_SET (h INSERT set l) = h * PROD_SET (set l) by PROD_SET_INSERT
12348 or p divides PROD_SET (h INSERT set l) by DIVIDES_MULTIPLE
12349*)
12350Theorem list_lcm_prime_factor:
12351 !p l. prime p /\ p divides list_lcm l ==> p divides PROD_SET (set l)
12352Proof
12353 strip_tac >>
12354 Induct >-
12355 rw[] >>
12356 rw[] >>
12357 qabbrev_tac `x = list_lcm l` >>
12358 `(gcd h x) * (lcm h x) = h * x` by rw[GCD_LCM] >>
12359 `p divides (h * x)` by metis_tac[DIVIDES_MULTIPLE] >>
12360 `p divides h \/ p divides x` by rw[P_EUCLIDES] >| [
12361 Cases_on `h IN set l` >| [
12362 `h divides x` by rw[list_lcm_is_common_multiple, Abbr`x`] >>
12363 `p divides x` by metis_tac[DIVIDES_TRANS] >>
12364 fs[ABSORPTION],
12365 rw[PROD_SET_INSERT] >>
12366 metis_tac[DIVIDES_MULTIPLE, MULT_COMM]
12367 ],
12368 Cases_on `h IN set l` >-
12369 fs[ABSORPTION] >>
12370 rw[PROD_SET_INSERT] >>
12371 metis_tac[DIVIDES_MULTIPLE]
12372 ]
12373QED
12374
12375(* Theorem: prime p /\ p divides PROD_SET (set l) ==> ?x. MEM x l /\ p divides x *)
12376(* Proof:
12377 By induction on l.
12378 Base: prime p /\ p divides PROD_SET (set []) ==> ?x. MEM x [] /\ p divides x
12379 p divides PROD_SET (set [])
12380 ==> p divides PROD_SET {} by LIST_TO_SET
12381 ==> p divides 1 by PROD_SET_EMPTY
12382 ==> p = 1 by DIVIDES_ONE
12383 This contradicts with 1 < p by ONE_LT_PRIME
12384 Step: prime p /\ p divides PROD_SET (set l) ==> ?x. MEM x l /\ p divides x ==>
12385 !h. prime p /\ p divides PROD_SET (set (h::l)) ==> ?x. MEM x (h::l) /\ p divides x
12386 Note PROD_SET (set (h::l))
12387 = PROD_SET (h INSERT set l) by LIST_TO_SET
12388 This is to show: ?x. ((x = h) \/ MEM x l) /\ p divides x by MEM
12389 If h IN set l, or MEM h l,
12390 Then h INSERT set l = set l by ABSORPTION
12391 Thus ?x. MEM x l /\ p divides x by induction hypothesis
12392 If ~(h IN set l),
12393 Then PROD_SET (h INSERT set l) = h * PROD_SET (set l) by PROD_SET_INSERT
12394 Thus p divides h \/ p divides (PROD_SET (set l)) by P_EUCLIDES
12395 Case p divides h.
12396 Take x = h, the result is true.
12397 Case p divides PROD_SET (set l).
12398 Then ?x. MEM x l /\ p divides x by induction hypothesis
12399*)
12400Theorem list_product_prime_factor:
12401 !p l. prime p /\ p divides PROD_SET (set l) ==> ?x. MEM x l /\ p divides x
12402Proof
12403 strip_tac >>
12404 Induct >| [
12405 rpt strip_tac >>
12406 `PROD_SET (set []) = 1` by rw[PROD_SET_EMPTY] >>
12407 `1 < p` by rw[ONE_LT_PRIME] >>
12408 `p <> 1` by decide_tac >>
12409 metis_tac[DIVIDES_ONE],
12410 rw[] >>
12411 Cases_on `h IN set l` >-
12412 metis_tac[ABSORPTION] >>
12413 fs[PROD_SET_INSERT] >>
12414 `p divides h \/ p divides (PROD_SET (set l))` by rw[P_EUCLIDES] >-
12415 metis_tac[] >>
12416 metis_tac[]
12417 ]
12418QED
12419
12420(* Theorem: prime p /\ p divides list_lcm l ==> ?x. MEM x l /\ p divides x *)
12421(* Proof: by list_lcm_prime_factor, list_product_prime_factor *)
12422Theorem list_lcm_prime_factor_member:
12423 !p l. prime p /\ p divides list_lcm l ==> ?x. MEM x l /\ p divides x
12424Proof
12425 rw[list_lcm_prime_factor, list_product_prime_factor]
12426QED
12427
12428(* ------------------------------------------------------------------------- *)
12429(* Count Helper Documentation *)
12430(* ------------------------------------------------------------------------- *)
12431(* Overloading (# is temporary):
12432 over f s t = !x. x IN s ==> f x IN t
12433 s bij_eq t = ?f. BIJ f s t
12434 s =b= t = ?f. BIJ f s t
12435*)
12436(* Definitions and Theorems (# are exported, ! are in compute):
12437
12438 Set Theorems:
12439 over_inj |- !f s t. INJ f s t ==> over f s t
12440 over_surj |- !f s t. SURJ f s t ==> over f s t
12441 over_bij |- !f s t. BIJ f s t ==> over f s t
12442 SURJ_CARD_IMAGE_EQ |- !f s t. FINITE t /\ over f s t ==>
12443 (SURJ f s t <=> CARD (IMAGE f s) = CARD t)
12444 FINITE_SURJ_IFF |- !f s t. FINITE t ==>
12445 (SURJ f s t <=> CARD (IMAGE f s) = CARD t /\ over f s t)
12446 INJ_IMAGE_BIJ_IFF |- !f s t. INJ f s t <=> BIJ f s (IMAGE f s) /\ over f s t
12447 INJ_IFF_BIJ_IMAGE |- !f s t. over f s t ==> (INJ f s t <=> BIJ f s (IMAGE f s))
12448 INJ_IMAGE_IFF |- !f s t. INJ f s t <=> INJ f s (IMAGE f s) /\ over f s t
12449 FUNSET_ALT |- !P Q. FUNSET P Q = {f | over f P Q}
12450
12451 Bijective Equivalence:
12452 bij_eq_empty |- !s t. s =b= t ==> (s = {} <=> t = {})
12453 bij_eq_refl |- !s. s =b= s
12454 bij_eq_sym |- !s t. s =b= t <=> t =b= s
12455 bij_eq_trans |- !s t u. s =b= t /\ t =b= u ==> s =b= u
12456 bij_eq_equiv_on |- !P. $=b= equiv_on P
12457 bij_eq_finite |- !s t. s =b= t ==> (FINITE s <=> FINITE t)
12458 bij_eq_count |- !s. FINITE s ==> s =b= count (CARD s)
12459 bij_eq_card |- !s t. s =b= t /\ (FINITE s \/ FINITE t) ==> CARD s = CARD t
12460 bij_eq_card_eq |- !s t. FINITE s /\ FINITE t ==> (s =b= t <=> CARD s = CARD t)
12461
12462 Alternate characterisation of maps:
12463 surj_preimage_not_empty
12464 |- !f s t. SURJ f s t <=>
12465 over f s t /\ !y. y IN t ==> preimage f s y <> {}
12466 inj_preimage_empty_or_sing
12467 |- !f s t. INJ f s t <=>
12468 over f s t /\ !y. y IN t ==> preimage f s y = {} \/
12469 SING (preimage f s y)
12470 bij_preimage_sing |- !f s t. BIJ f s t <=>
12471 over f s t /\ !y. y IN t ==> SING (preimage f s y)
12472 surj_iff_preimage_card_not_0
12473 |- !f s t. FINITE s /\ over f s t ==>
12474 (SURJ f s t <=>
12475 !y. y IN t ==> CARD (preimage f s y) <> 0)
12476 inj_iff_preimage_card_le_1
12477 |- !f s t. FINITE s /\ over f s t ==>
12478 (INJ f s t <=>
12479 !y. y IN t ==> CARD (preimage f s y) <= 1)
12480 bij_iff_preimage_card_eq_1
12481 |- !f s t. FINITE s /\ over f s t ==>
12482 (BIJ f s t <=>
12483 !y. y IN t ==> CARD (preimage f s y) = 1)
12484 finite_surj_inj_iff |- !f s t. FINITE s /\ SURJ f s t ==>
12485 (INJ f s t <=>
12486 !e. e IN IMAGE (preimage f s) t ==> CARD e = 1)
12487*)
12488
12489(* Overload a function from domain to range.
12490
12491 NOTE: this is FUNSET --Chun Tian
12492 *)
12493Overload over[local] = ``\f s t. !x. x IN s ==> f x IN t``
12494(* not easy to make this a good infix operator! *)
12495
12496(* Theorem: INJ f s t ==> over f s t *)
12497(* Proof: by INJ_DEF. *)
12498Theorem over_inj:
12499 !f s t. INJ f s t ==> over f s t
12500Proof
12501 simp[INJ_DEF]
12502QED
12503
12504(* Theorem: SURJ f s t ==> over f s t *)
12505(* Proof: by SURJ_DEF. *)
12506Theorem over_surj:
12507 !f s t. SURJ f s t ==> over f s t
12508Proof
12509 simp[SURJ_DEF]
12510QED
12511
12512(* Theorem: BIJ f s t ==> over f s t *)
12513(* Proof: by BIJ_DEF, INJ_DEF. *)
12514Theorem over_bij:
12515 !f s t. BIJ f s t ==> over f s t
12516Proof
12517 simp[BIJ_DEF, INJ_DEF]
12518QED
12519
12520(* Theorem: FINITE t /\ over f s t ==>
12521 (SURJ f s t <=> CARD (IMAGE f s) = CARD t) *)
12522(* Proof:
12523 If part: SURJ f s t ==> CARD (IMAGE f s) = CARD t
12524 Note IMAGE f s = t by IMAGE_SURJ
12525 Hence true.
12526 Only-if part: CARD (IMAGE f s) = CARD t ==> SURJ f s t
12527 By contradiction, suppose ~SURJ f s t.
12528 Then IMAGE f s <> t by IMAGE_SURJ
12529 but IMAGE f s SUBSET t by IMAGE_SUBSET_TARGET
12530 so IMAGE f s PSUBSET t by PSUBSET_DEF
12531 ==> CARD (IMAGE f s) < CARD t
12532 by CARD_PSUBSET
12533 This contradicts CARD (IMAGE f s) = CARD t.
12534*)
12535Theorem SURJ_CARD_IMAGE_EQ:
12536 !f s t. FINITE t /\ over f s t ==>
12537 (SURJ f s t <=> CARD (IMAGE f s) = CARD t)
12538Proof
12539 rw[EQ_IMP_THM] >-
12540 fs[IMAGE_SURJ] >>
12541 spose_not_then strip_assume_tac >>
12542 `IMAGE f s <> t` by rw[GSYM IMAGE_SURJ] >>
12543 `IMAGE f s PSUBSET t` by fs[IMAGE_SUBSET_TARGET, PSUBSET_DEF] >>
12544 imp_res_tac CARD_PSUBSET >>
12545 decide_tac
12546QED
12547
12548(* Theorem: FINITE t ==>
12549 (SURJ f s t <=> CARD (IMAGE f s) = CARD t /\ over f s t) *)
12550(* Proof:
12551 If part: true by SURJ_DEF, IMAGE_SURJ
12552 Only-if part: true by SURJ_CARD_IMAGE_EQ
12553*)
12554Theorem FINITE_SURJ_IFF:
12555 !f s t. FINITE t ==>
12556 (SURJ f s t <=> CARD (IMAGE f s) = CARD t /\ over f s t)
12557Proof
12558 metis_tac[SURJ_CARD_IMAGE_EQ, SURJ_DEF]
12559QED
12560
12561(* Note: this cannot be proved:
12562g `!f s t. FINITE t /\ over f s t ==>
12563 (INJ f s t <=> CARD (IMAGE f s) = CARD t)`;
12564Take f = I, s = count m, t = count n, with m <= n.
12565Then INJ I (count m) (count n)
12566and IMAGE I (count m) = (count m)
12567so CARD (IMAGE f s) = m, CARD t = n, may not equal.
12568*)
12569
12570(* INJ_IMAGE_BIJ |- !s f. (?t. INJ f s t) ==> BIJ f s (IMAGE f s) *)
12571
12572(* Theorem: INJ f s t <=> (BIJ f s (IMAGE f s) /\ over f s t) *)
12573(* Proof:
12574 If part: INJ f s t ==> BIJ f s (IMAGE f s) /\ over f s t
12575 Note BIJ f s (IMAGE f s) by INJ_IMAGE_BIJ
12576 and over f s t by INJ_DEF
12577 Only-if: BIJ f s (IMAGE f s) /\ over f s t ==> INJ f s t
12578 By INJ_DEF, this is to show:
12579 (1) x IN s ==> f x IN t, true by given
12580 (2) x IN s /\ y IN s /\ f x = f y ==> x = y
12581 Note f x IN (IMAGE f s) by IN_IMAGE
12582 and f y IN (IMAGE f s) by IN_IMAGE
12583 so f x = f y ==> x = y by BIJ_IS_INJ
12584*)
12585Theorem INJ_IMAGE_BIJ_IFF:
12586 !f s t. INJ f s t <=> (BIJ f s (IMAGE f s) /\ over f s t)
12587Proof
12588 rw[EQ_IMP_THM] >-
12589 metis_tac[INJ_IMAGE_BIJ] >-
12590 fs[INJ_DEF] >>
12591 rw[INJ_DEF] >>
12592 metis_tac[BIJ_IS_INJ, IN_IMAGE]
12593QED
12594
12595(* Theorem: over f s t ==> (INJ f s t <=> BIJ f s (IMAGE f s)) *)
12596(* Proof: by INJ_IMAGE_BIJ_IFF. *)
12597Theorem INJ_IFF_BIJ_IMAGE:
12598 !f s t. over f s t ==> (INJ f s t <=> BIJ f s (IMAGE f s))
12599Proof
12600 metis_tac[INJ_IMAGE_BIJ_IFF]
12601QED
12602
12603(*
12604INJ_IMAGE |- !f s t. INJ f s t ==> INJ f s (IMAGE f s)
12605*)
12606
12607(* Theorem: INJ f s t <=> INJ f s (IMAGE f s) /\ over f s t *)
12608(* Proof:
12609 Let P = over f s t.
12610 If part: INJ f s t ==> INJ f s (IMAGE f s) /\ P
12611 Note INJ f s (IMAGE f s) by INJ_IMAGE
12612 and P is true by INJ_DEF
12613 Only-if part: INJ f s (IMAGE f s) /\ P ==> INJ f s t
12614 Note s SUBSET s by SUBSET_REFL
12615 and (IMAGE f s) SUBSET t by IMAGE_SUBSET_TARGET
12616 Thus INJ f s t by INJ_SUBSET
12617*)
12618Theorem INJ_IMAGE_IFF:
12619 !f s t. INJ f s t <=> INJ f s (IMAGE f s) /\ over f s t
12620Proof
12621 rw[EQ_IMP_THM] >-
12622 metis_tac[INJ_IMAGE] >-
12623 fs[INJ_DEF] >>
12624 `s SUBSET s` by rw[] >>
12625 `(IMAGE f s) SUBSET t` by fs[IMAGE_SUBSET_TARGET] >>
12626 metis_tac[INJ_SUBSET]
12627QED
12628
12629(* pred_setTheory:
12630FUNSET |- !P Q. FUNSET P Q = (\f. over f P Q)
12631*)
12632
12633(* Theorem: FUNSET P Q = {f | over f P Q} *)
12634(* Proof: by FUNSET, EXTENSION *)
12635Theorem FUNSET_ALT:
12636 !P Q. FUNSET P Q = {f | over f P Q}
12637Proof
12638 rw[FUNSET, EXTENSION]
12639QED
12640
12641(* ------------------------------------------------------------------------- *)
12642(* Bijective Equivalence *)
12643(* ------------------------------------------------------------------------- *)
12644
12645(* Overload bijectively equal. *)
12646Overload bij_eq = ``\s t. ?f. BIJ f s t``
12647val _ = set_fixity "bij_eq" (Infix(NONASSOC, 450)); (* same as relation *)
12648
12649Overload "=b=" = ``$bij_eq``
12650val _ = set_fixity "=b=" (Infix(NONASSOC, 450));
12651
12652(*
12653> BIJ_SYM;
12654val it = |- !s t. s bij_eq t <=> t bij_eq s: thm
12655> BIJ_SYM;
12656val it = |- !s t. s =b= t <=> t =b= s: thm
12657> FINITE_BIJ_COUNT_CARD
12658val it = |- !s. FINITE s ==> count (CARD s) =b= s: thm
12659*)
12660
12661(* Theorem: s =b= t ==> (s = {} <=> t = {}) *)
12662(* Proof: by BIJ_EMPTY. *)
12663Theorem bij_eq_empty:
12664 !s t. s =b= t ==> (s = {} <=> t = {})
12665Proof
12666 metis_tac[BIJ_EMPTY]
12667QED
12668
12669(* Theorem: s =b= s *)
12670(* Proof: by BIJ_I_SAME *)
12671Theorem bij_eq_refl:
12672 !s. s =b= s
12673Proof
12674 metis_tac[BIJ_I_SAME]
12675QED
12676
12677(* Theorem alias *)
12678Theorem bij_eq_sym = BIJ_SYM;
12679(* val bij_eq_sym = |- !s t. s =b= t <=> t =b= s: thm *)
12680
12681Theorem bij_eq_trans = BIJ_TRANS;
12682(* val bij_eq_trans = |- !s t u. s =b= t /\ t =b= u ==> s =b= u: thm *)
12683
12684(* Idea: bij_eq is an equivalence relation on any set of sets. *)
12685
12686(* Theorem: $=b= equiv_on P *)
12687(* Proof:
12688 By equiv_on_def, this is to show:
12689 (1) s IN P ==> s =b= s, true by bij_eq_refl
12690 (2) s IN P /\ t IN P ==> (t =b= s <=> s =b= t)
12691 This is true by bij_eq_sym
12692 (3) s IN P /\ s' IN P /\ t IN P /\
12693 BIJ f s s' /\ BIJ f' s' t ==> s =b= t
12694 This is true by bij_eq_trans
12695*)
12696Theorem bij_eq_equiv_on:
12697 !P. $=b= equiv_on P
12698Proof
12699 rw[equiv_on_def] >-
12700 simp[bij_eq_refl] >-
12701 simp[Once bij_eq_sym] >>
12702 metis_tac[bij_eq_trans]
12703QED
12704
12705(* Theorem: s =b= t ==> (FINITE s <=> FINITE t) *)
12706(* Proof: by BIJ_FINITE_IFF *)
12707Theorem bij_eq_finite:
12708 !s t. s =b= t ==> (FINITE s <=> FINITE t)
12709Proof
12710 metis_tac[BIJ_FINITE_IFF]
12711QED
12712
12713(* This is the iff version of:
12714pred_setTheory.FINITE_BIJ_CARD;
12715|- !f s t. FINITE s /\ BIJ f s t ==> CARD s = CARD t
12716*)
12717
12718(* Theorem: FINITE s ==> s =b= (count (CARD s)) *)
12719(* Proof: by FINITE_BIJ_COUNT_CARD, BIJ_SYM *)
12720Theorem bij_eq_count:
12721 !s. FINITE s ==> s =b= (count (CARD s))
12722Proof
12723 metis_tac[FINITE_BIJ_COUNT_CARD, BIJ_SYM]
12724QED
12725
12726(* Theorem: s =b= t /\ (FINITE s \/ FINITE t) ==> CARD s = CARD t *)
12727(* Proof: by FINITE_BIJ_CARD, BIJ_SYM. *)
12728Theorem bij_eq_card:
12729 !s t. s =b= t /\ (FINITE s \/ FINITE t) ==> CARD s = CARD t
12730Proof
12731 metis_tac[FINITE_BIJ_CARD, BIJ_SYM]
12732QED
12733
12734(* Theorem: FINITE s /\ FINITE t ==> (s =b= t <=> CARD s = CARD t) *)
12735(* Proof:
12736 If part: s =b= t ==> CARD s = CARD t
12737 This is true by FINITE_BIJ_CARD
12738 Only-if part: CARD s = CARD t ==> s =b= t
12739 Let n = CARD s = CARD t.
12740 Note ?f. BIJ f s (count n) by bij_eq_count
12741 and ?g. BIJ g (count n) t by FINITE_BIJ_COUNT_CARD
12742 Thus s =b= t by bij_eq_trans
12743*)
12744Theorem bij_eq_card_eq:
12745 !s t. FINITE s /\ FINITE t ==> (s =b= t <=> CARD s = CARD t)
12746Proof
12747 rw[EQ_IMP_THM] >-
12748 metis_tac[FINITE_BIJ_CARD] >>
12749 `?f. BIJ f s (count (CARD s))` by rw[bij_eq_count] >>
12750 `?g. BIJ g (count (CARD t)) t` by rw[FINITE_BIJ_COUNT_CARD] >>
12751 metis_tac[bij_eq_trans]
12752QED
12753
12754(* ------------------------------------------------------------------------- *)
12755(* Alternate characterisation of maps. *)
12756(* ------------------------------------------------------------------------- *)
12757
12758(* Theorem: SURJ f s t <=>
12759 over f s t /\ (!y. y IN t ==> preimage f s y <> {}) *)
12760(* Proof:
12761 Let P = over f s t,
12762 Q = !y. y IN t ==> preimage f s y <> {}.
12763 If part: SURJ f s t ==> P /\ Q
12764 P is true by SURJ_DEF
12765 Q is true by preimage_def, SURJ_DEF
12766 Only-if part: P /\ Q ==> SURJ f s t
12767 This is true by preimage_def, SURJ_DEF
12768*)
12769Theorem surj_preimage_not_empty:
12770 !f s t. SURJ f s t <=>
12771 over f s t /\ (!y. y IN t ==> preimage f s y <> {})
12772Proof
12773 rw[SURJ_DEF, preimage_def, EXTENSION] >>
12774 metis_tac[]
12775QED
12776
12777(* Theorem: INJ f s t <=>
12778 over f s t /\
12779 (!y. y IN t ==> (preimage f s y = {} \/
12780 SING (preimage f s y))) *)
12781(* Proof:
12782 Let P = over f s t,
12783 Q = !y. y IN t ==> preimage f s y = {} \/ SING (preimage f s y).
12784 If part: INJ f s t ==> P /\ Q
12785 P is true by INJ_DEF
12786 For Q, if preimage f s y <> {},
12787 Then ?x. x IN preimage f s y by MEMBER_NOT_EMPTY
12788 or ?x. x IN s /\ f x = y by in_preimage
12789 Thus !z. z IN preimage f s y ==> z = x
12790 by in_preimage, INJ_DEF
12791 or SING (preimage f s y) by SING_DEF, EXTENSION
12792 Only-if part: P /\ Q ==> INJ f s t
12793 By INJ_DEF, this is to show:
12794 !x y. x IN s /\ y IN s /\ f x = f y ==> x = y
12795 Let z = f x, then z IN t by over f s t
12796 so x IN preimage f s z by in_preimage
12797 and y IN preimage f s z by in_preimage
12798 Thus preimage f s z <> {} by MEMBER_NOT_EMPTY
12799 so SING (preimage f s z) by implication
12800 ==> x = y by SING_ELEMENT
12801*)
12802Theorem inj_preimage_empty_or_sing:
12803 !f s t. INJ f s t <=>
12804 over f s t /\
12805 (!y. y IN t ==> (preimage f s y = {} \/
12806 SING (preimage f s y)))
12807Proof
12808 rw[EQ_IMP_THM] >-
12809 fs[INJ_DEF] >-
12810 ((Cases_on `preimage f s y = {}` >> simp[]) >>
12811 `?x. x IN s /\ f x = y` by metis_tac[in_preimage, MEMBER_NOT_EMPTY] >>
12812 simp[SING_DEF] >>
12813 qexists_tac `x` >>
12814 rw[preimage_def, EXTENSION] >>
12815 metis_tac[INJ_DEF]) >>
12816 rw[INJ_DEF] >>
12817 qabbrev_tac `z = f x` >>
12818 `z IN t` by fs[Abbr`z`] >>
12819 `x IN preimage f s z` by fs[preimage_def] >>
12820 `y IN preimage f s z` by fs[preimage_def] >>
12821 metis_tac[MEMBER_NOT_EMPTY, SING_ELEMENT]
12822QED
12823
12824(* Theorem: BIJ f s t <=>
12825 over f s t /\
12826 (!y. y IN t ==> SING (preimage f s y)) *)
12827(* Proof:
12828 Let P = over f s t,
12829 Q = !y. y IN t ==> SING (preimage f s y).
12830 If part: BIJ f s t ==> P /\ Q
12831 P is true by BIJ_DEF, INJ_DEF
12832 For Q,
12833 Note INJ f s t /\ SURJ f s t by BIJ_DEF
12834 so preimage f s y <> {} by surj_preimage_not_empty
12835 Thus SING (preimage f s y) by inj_preimage_empty_or_sing
12836 Only-if part: P /\ Q ==> BIJ f s t
12837 Note !y. y IN t ==> (preimage f s y) <> {}
12838 by SING_DEF, NOT_EMPTY_SING
12839 so SURJ f s t by surj_preimage_not_empty
12840 and INJ f s t by inj_preimage_empty_or_sing
12841 Thus BIJ f s t by BIJ_DEF
12842*)
12843Theorem bij_preimage_sing:
12844 !f s t. BIJ f s t <=>
12845 over f s t /\
12846 (!y. y IN t ==> SING (preimage f s y))
12847Proof
12848 rw[EQ_IMP_THM] >-
12849 fs[BIJ_DEF, INJ_DEF] >-
12850 metis_tac[BIJ_DEF, surj_preimage_not_empty, inj_preimage_empty_or_sing] >>
12851 `INJ f s t` by metis_tac[inj_preimage_empty_or_sing] >>
12852 `SURJ f s t` by metis_tac[SING_DEF, NOT_EMPTY_SING, surj_preimage_not_empty] >>
12853 simp[BIJ_DEF]
12854QED
12855
12856(* Theorem: FINITE s /\ over f s t ==>
12857 (SURJ f s t <=> !y. y IN t ==> CARD (preimage f s y) <> 0) *)
12858(* Proof:
12859 Note !y. FINITE (preimage f s y) by preimage_finite
12860 and !y. CARD (preimage f s y) = 0 <=> preimage f s y = {}
12861 by CARD_EQ_0
12862 The result follows by surj_preimage_not_empty
12863*)
12864Theorem surj_iff_preimage_card_not_0:
12865 !f s t. FINITE s /\ over f s t ==>
12866 (SURJ f s t <=> !y. y IN t ==> CARD (preimage f s y) <> 0)
12867Proof
12868 metis_tac[surj_preimage_not_empty, preimage_finite, CARD_EQ_0]
12869QED
12870
12871(* Theorem: FINITE s /\ over f s t ==>
12872 (INJ f s t <=> !y. y IN t ==> CARD (preimage f s y) <= 1) *)
12873(* Proof:
12874 Note !y. FINITE (preimage f s y) by preimage_finite
12875 and !y. CARD (preimage f s y) = 0 <=> preimage f s y = {}
12876 by CARD_EQ_0
12877 and !y. CARD (preimage f s y) = 1 <=> SING (preimage f s y)
12878 by CARD_EQ_1
12879 The result follows by inj_preimage_empty_or_sing, LE_ONE
12880*)
12881Theorem inj_iff_preimage_card_le_1:
12882 !f s t. FINITE s /\ over f s t ==>
12883 (INJ f s t <=> !y. y IN t ==> CARD (preimage f s y) <= 1)
12884Proof
12885 metis_tac[inj_preimage_empty_or_sing, preimage_finite, CARD_EQ_0, CARD_EQ_1, LE_ONE]
12886QED
12887
12888(* Theorem: FINITE s /\ over f s t ==>
12889 (BIJ f s t <=> !y. y IN t ==> CARD (preimage f s y) = 1) *)
12890(* Proof:
12891 Note !y. FINITE (preimage f s y) by preimage_finite
12892 and !y. CARD (preimage f s y) = 1 <=> SING (preimage f s y)
12893 by CARD_EQ_1
12894 The result follows by bij_preimage_sing
12895*)
12896Theorem bij_iff_preimage_card_eq_1:
12897 !f s t. FINITE s /\ over f s t ==>
12898 (BIJ f s t <=> !y. y IN t ==> CARD (preimage f s y) = 1)
12899Proof
12900 metis_tac[bij_preimage_sing, preimage_finite, CARD_EQ_1]
12901QED
12902
12903(* Theorem: FINITE s /\ SURJ f s t ==>
12904 (INJ f s t <=> !e. e IN IMAGE (preimage f s) t ==> CARD e = 1) *)
12905(* Proof:
12906 If part: INJ f s t /\ x IN t ==> CARD (preimage f s x) = 1
12907 Note BIJ f s t by BIJ_DEF
12908 and over f s t by BIJ_DEF, INJ_DEF
12909 so CARD (preimage f s x) = 1 by bij_iff_preimage_card_eq_1
12910 Only-if part: !e. (?x. e = preimage f s x /\ x IN t) ==> CARD e = 1 ==> INJ f s t
12911 Note over f s t by SURJ_DEF
12912 and !x. x IN t ==> ?y. y IN s /\ f y = x by SURJ_DEF
12913 Thus !y. y IN t ==> CARD (preimage f s y) = 1 by IN_IMAGE
12914 so INJ f s t by inj_iff_preimage_card_le_1
12915*)
12916Theorem finite_surj_inj_iff:
12917 !f s t. FINITE s /\ SURJ f s t ==>
12918 (INJ f s t <=> !e. e IN IMAGE (preimage f s) t ==> CARD e = 1)
12919Proof
12920 rw[EQ_IMP_THM] >-
12921 prove_tac[BIJ_DEF, INJ_DEF, bij_iff_preimage_card_eq_1] >>
12922 fs[SURJ_DEF] >>
12923 `!y. y IN t ==> CARD (preimage f s y) = 1` by metis_tac[] >>
12924 rw[inj_iff_preimage_card_le_1]
12925QED
12926
12927(* ------------------------------------------------------------------------- *)
12928(* Necklace Theory Documentation *)
12929(* ------------------------------------------------------------------------- *)
12930(* Overloading:
12931*)
12932(* Definitions and Theorems (# are exported, ! are in compute):
12933
12934 Necklace:
12935 necklace_def |- !n a. necklace n a =
12936 {ls | LENGTH ls = n /\ set ls SUBSET count a}
12937 necklace_element |- !n a ls. ls IN necklace n a <=>
12938 LENGTH ls = n /\ set ls SUBSET count a
12939 necklace_length |- !n a ls. ls IN necklace n a ==> LENGTH ls = n
12940 necklace_colors |- !n a ls. ls IN necklace n a ==> set ls SUBSET count a
12941 necklace_property |- !n a ls. ls IN necklace n a ==>
12942 LENGTH ls = n /\ set ls SUBSET count a
12943 necklace_0 |- !a. necklace 0 a = {[]}
12944 necklace_empty |- !n. 0 < n ==> (necklace n 0 = {})
12945 necklace_not_nil |- !n a ls. 0 < n /\ ls IN necklace n a ==> ls <> []
12946 necklace_suc |- !n a. necklace (SUC n) a =
12947 IMAGE (\(c,ls). c::ls) (count a CROSS necklace n a)
12948! necklace_eqn |- !n a. necklace n a =
12949 if n = 0 then {[]}
12950 else IMAGE (\(c,ls). c::ls) (count a CROSS necklace (n - 1) a)
12951 necklace_1 |- !a. necklace 1 a = {[e] | e IN count a}
12952 necklace_finite |- !n a. FINITE (necklace n a)
12953 necklace_card |- !n a. CARD (necklace n a) = a ** n
12954
12955 Mono-colored necklace:
12956 monocoloured_def |- !n a. monocoloured n a =
12957 {ls | ls IN necklace n a /\ (ls <> [] ==> SING (set ls))}
12958 monocoloured_element
12959 |- !n a ls. ls IN monocoloured n a <=>
12960 ls IN necklace n a /\ (ls <> [] ==> SING (set ls))
12961 monocoloured_necklace |- !n a ls. ls IN monocoloured n a ==> ls IN necklace n a
12962 monocoloured_subset |- !n a. monocoloured n a SUBSET necklace n a
12963 monocoloured_finite |- !n a. FINITE (monocoloured n a)
12964 monocoloured_0 |- !a. monocoloured 0 a = {[]}
12965 monocoloured_1 |- !a. monocoloured 1 a = necklace 1 a
12966 necklace_1_monocoloured
12967 |- !a. necklace 1 a = monocoloured 1 a
12968 monocoloured_empty|- !n. 0 < n ==> monocoloured n 0 = {}
12969 monocoloured_mono |- !n. monocoloured n 1 = necklace n 1
12970 monocoloured_suc |- !n a. 0 < n ==>
12971 monocoloured (SUC n) a = IMAGE (\ls. HD ls::ls) (monocoloured n a)
12972 monocoloured_0_card |- !a. CARD (monocoloured 0 a) = 1
12973 monocoloured_card |- !n a. 0 < n ==> CARD (monocoloured n a) = a
12974! monocoloured_eqn |- !n a. monocoloured n a =
12975 if n = 0 then {[]}
12976 else IMAGE (\c. GENLIST (K c) n) (count a)
12977 monocoloured_card_eqn |- !n a. CARD (monocoloured n a) = if n = 0 then 1 else a
12978
12979 Multi-colored necklace:
12980 multicoloured_def |- !n a. multicoloured n a = necklace n a DIFF monocoloured n a
12981 multicoloured_element |- !n a ls. ls IN multicoloured n a <=>
12982 ls IN necklace n a /\ ls <> [] /\ ~SING (set ls)
12983 multicoloured_necklace|- !n a ls. ls IN multicoloured n a ==> ls IN necklace n a
12984 multicoloured_subset |- !n a. multicoloured n a SUBSET necklace n a
12985 multicoloured_finite |- !n a. FINITE (multicoloured n a)
12986 multicoloured_0 |- !a. multicoloured 0 a = {}
12987 multicoloured_1 |- !a. multicoloured 1 a = {}
12988 multicoloured_n_0 |- !n. multicoloured n 0 = {}
12989 multicoloured_n_1 |- !n. multicoloured n 1 = {}
12990 multicoloured_empty |- !n. multicoloured n 0 = {} /\ multicoloured n 1 = {}
12991 multi_mono_disjoint |- !n a. DISJOINT (multicoloured n a) (monocoloured n a)
12992 multi_mono_exhaust |- !n a. necklace n a = multicoloured n a UNION monocoloured n a
12993 multicoloured_card |- !n a. 0 < n ==> (CARD (multicoloured n a) = a ** n - a)
12994 multicoloured_card_eqn|- !n a. CARD (multicoloured n a) = if n = 0 then 0 else a ** n - a
12995 multicoloured_nonempty|- !n a. 1 < n /\ 1 < a ==> multicoloured n a <> {}
12996 multicoloured_not_monocoloured
12997 |- !n a ls. ls IN multicoloured n a ==> ls NOTIN monocoloured n a
12998 multicoloured_not_monocoloured_iff
12999 |- !n a ls. ls IN necklace n a ==>
13000 (ls IN multicoloured n a <=> ls NOTIN monocoloured n a)
13001 multicoloured_or_monocoloured
13002 |- !n a ls. ls IN necklace n a ==>
13003 ls IN multicoloured n a \/ ls IN monocoloured n a
13004*)
13005
13006
13007(* ------------------------------------------------------------------------- *)
13008(* Helper Theorems. *)
13009(* ------------------------------------------------------------------------- *)
13010
13011(* ------------------------------------------------------------------------- *)
13012(* Necklace *)
13013(* ------------------------------------------------------------------------- *)
13014
13015(* Define necklaces as lists of length n, i.e. with n beads, in a colors. *)
13016Definition necklace_def[nocompute]:
13017 necklace n a = {ls | LENGTH ls = n /\ (set ls) SUBSET (count a) }
13018End
13019(* Note: use [nocompute] as this is not effective. *)
13020
13021(* Theorem: ls IN necklace n a <=> (LENGTH ls = n /\ (set ls) SUBSET (count a)) *)
13022(* Proof: by necklace_def *)
13023Theorem necklace_element:
13024 !n a ls. ls IN necklace n a <=> (LENGTH ls = n /\ (set ls) SUBSET (count a))
13025Proof
13026 simp[necklace_def]
13027QED
13028
13029(* Theorem: ls IN (necklace n a) ==> LENGTH ls = n *)
13030(* Proof: by necklace_def *)
13031Theorem necklace_length:
13032 !n a ls. ls IN (necklace n a) ==> LENGTH ls = n
13033Proof
13034 simp[necklace_def]
13035QED
13036
13037(* Theorem: ls IN (necklace n a) ==> set ls SUBSET count a *)
13038(* Proof: by necklace_def *)
13039Theorem necklace_colors:
13040 !n a ls. ls IN (necklace n a) ==> set ls SUBSET count a
13041Proof
13042 simp[necklace_def]
13043QED
13044
13045(* Idea: If ls in (necklace n a), LENGTH ls = n and colors in count a. *)
13046
13047(* Theorem: ls IN (necklace n a) ==> LENGTH ls = n /\ set ls SUBSET count a *)
13048(* Proof: by necklace_def *)
13049Theorem necklace_property:
13050 !n a ls. ls IN (necklace n a) ==> LENGTH ls = n /\ set ls SUBSET count a
13051Proof
13052 simp[necklace_def]
13053QED
13054
13055(* ------------------------------------------------------------------------- *)
13056(* Know the necklaces. *)
13057(* ------------------------------------------------------------------------- *)
13058
13059(* Idea: zero-length necklaces of whatever colors is the set of NIL. *)
13060
13061(* Theorem: necklace 0 a = {[]} *)
13062(* Proof:
13063 necklace 0 a
13064 = {ls | (LENGTH ls = 0) /\ (set ls) SUBSET (count a) } by necklace_def
13065 = {ls | ls = [] /\ (set []) SUBSET (count a) } by LENGTH_NIL
13066 = {ls | ls = [] /\ [] SUBSET (count a) } by LIST_TO_SET
13067 = {[]} by EMPTY_SUBSET
13068*)
13069Theorem necklace_0:
13070 !a. necklace 0 a = {[]}
13071Proof
13072 rw[necklace_def, EXTENSION] >>
13073 metis_tac[LIST_TO_SET, EMPTY_SUBSET]
13074QED
13075
13076(* Idea: necklaces with some length but 0 colors is EMPTY. *)
13077
13078(* Theorem: 0 < n ==> (necklace n 0 = {}) *)
13079(* Proof:
13080 necklace n 0
13081 = {ls | LENGTH ls = n /\ (set ls) SUBSET (count 0) } by necklace_def
13082 = {ls | LENGTH ls = n /\ (set ls) SUBSET {} by COUNT_0
13083 = {ls | LENGTH ls = n /\ (set ls = {}) } by SUBSET_EMPTY
13084 = {ls | LENGTH ls = n /\ (ls = []) } by LIST_TO_SET_EQ_EMPTY
13085 = {} by LENGTH_NIL, 0 < n
13086*)
13087Theorem necklace_empty:
13088 !n. 0 < n ==> (necklace n 0 = {})
13089Proof
13090 rw[necklace_def, EXTENSION]
13091QED
13092
13093(* Idea: A necklace of length n <> 0 is non-NIL. *)
13094
13095(* Theorem: 0 < n /\ ls IN (necklace n a) ==> ls <> [] *)
13096(* Proof:
13097 By contradiction, suppose ls = [].
13098 Then n = LENGTH ls by necklace_element
13099 = LENGTH [] = 0 by LENGTH_NIL
13100 This contradicts 0 < n.
13101*)
13102Theorem necklace_not_nil:
13103 !n a ls. 0 < n /\ ls IN (necklace n a) ==> ls <> []
13104Proof
13105 rw[necklace_def] >>
13106 metis_tac[LENGTH_NON_NIL]
13107QED
13108
13109(* ------------------------------------------------------------------------- *)
13110(* To show: (necklace n a) is FINITE. *)
13111(* ------------------------------------------------------------------------- *)
13112
13113(* Idea: Relate (necklace (n+1) a) to (necklace n a) for induction. *)
13114
13115(* Theorem: necklace (SUC n) a =
13116 IMAGE (\(c, ls). c :: ls) (count a CROSS necklace n a) *)
13117(* Proof:
13118 By necklace_def, EXTENSION, this is to show:
13119 (1) LENGTH x = SUC n /\ set x SUBSET count a ==>
13120 ?h t. (x = h::t) /\ h < a /\ (LENGTH t = n) /\ set t SUBSET count a
13121 Note SUC n <> 0 by SUC_NOT_ZERO
13122 so ?h t. x = h::t by list_CASES
13123 Take these h, t, true by LENGTH, MEM
13124 (2) h < a /\ set t SUBSET count a ==> x < a ==> LENGTH (h::t) = SUC (LENGTH t)
13125 This is true by LENGTH
13126 (3) h < a /\ set t SUBSET count a ==> set (h::t) SUBSET count a
13127 Note set (h::t) c <=>
13128 (c = h) \/ set t c by LIST_TO_SET_DEF
13129 If c = h, h < a
13130 ==> h IN count a by IN_COUNT
13131 If set t c, set t SUBSET count a
13132 ==> c IN count a by SUBSET_DEF
13133 Thus set (h::t) SUBSET count a by SUBSET_DEF
13134*)
13135Theorem necklace_suc:
13136 !n a. necklace (SUC n) a =
13137 IMAGE (\(c, ls). c :: ls) (count a CROSS necklace n a)
13138Proof
13139 rw[necklace_def, EXTENSION] >>
13140 rw[pairTheory.EXISTS_PROD, EQ_IMP_THM] >| [
13141 `SUC n <> 0` by decide_tac >>
13142 `?h t. x = h::t` by metis_tac[LENGTH_NIL, list_CASES] >>
13143 qexists_tac `h` >>
13144 qexists_tac `t` >>
13145 fs[],
13146 simp[],
13147 fs[]
13148 ]
13149QED
13150
13151(* Idea: display the necklaces. *)
13152
13153(* Theorem: necklace n a =
13154 if n = 0 then {[]}
13155 else IMAGE (\(c,ls). c::ls) (count a CROSS necklace (n - 1) a) *)
13156(* Proof: by necklace_0, necklace_suc. *)
13157Theorem necklace_eqn[compute]:
13158 !n a. necklace n a =
13159 if n = 0 then {[]}
13160 else IMAGE (\(c,ls). c::ls) (count a CROSS necklace (n - 1) a)
13161Proof
13162 rw[necklace_0] >>
13163 metis_tac[necklace_suc, num_CASES, SUC_SUB1]
13164QED
13165
13166(*
13167> EVAL ``necklace 3 2``;
13168= {[1; 1; 1]; [1; 1; 0]; [1; 0; 1]; [1; 0; 0]; [0; 1; 1]; [0; 1; 0]; [0; 0; 1]; [0; 0; 0]}
13169> EVAL ``necklace 2 3``;
13170= {[2; 2]; [2; 1]; [2; 0]; [1; 2]; [1; 1]; [1; 0]; [0; 2]; [0; 1]; [0; 0]}
13171*)
13172
13173(* Idea: Unit-length necklaces are singletons from (count a). *)
13174
13175(* Theorem: necklace 1 a = {[e] | e IN count a} *)
13176(* Proof:
13177 Let f = (\(c,ls). c::ls).
13178 necklace 1 a
13179 = necklace (SUC 0) a by ONE
13180 = IMAGE f ((count a) CROSS (necklace 0 a)) by necklace_suc
13181 = IMAGE f ((count a) CROSS {[]}) by necklace_0
13182 = {[e] | e IN count a} by EXTENSION
13183*)
13184Theorem necklace_1:
13185 !a. necklace 1 a = {[e] | e IN count a}
13186Proof
13187 rewrite_tac[ONE] >>
13188 rw[necklace_suc, necklace_0, pairTheory.EXISTS_PROD, EXTENSION]
13189QED
13190
13191(* Idea: The set of (necklace n a) is finite. *)
13192
13193(* Theorem: FINITE (necklace n a) *)
13194(* Proof:
13195 By induction on n.
13196 Base: FINITE (necklace 0 a)
13197 Note necklace 0 a = {[]} by necklace_0
13198 and FINITE {[]} by FINITE_SING
13199 Step: FINITE (necklace n a) ==> FINITE (necklace (SUC n) a)
13200 Let f = (\(c, ls). c :: ls), b = count a, c = necklace n a.
13201 Note necklace (SUC n) a
13202 = IMAGE f (b CROSS c) by necklace_suc
13203 and FINITE b by FINITE_COUNT
13204 and FINITE c by induction hypothesis
13205 so FINITE (b CROSS c) by FINITE_CROSS
13206 Thus FINITE (necklace (SUC n) a) by IMAGE_FINITE
13207*)
13208Theorem necklace_finite:
13209 !n a. FINITE (necklace n a)
13210Proof
13211 rpt strip_tac >>
13212 Induct_on `n` >-
13213 simp[necklace_0] >>
13214 simp[necklace_suc]
13215QED
13216
13217(* ------------------------------------------------------------------------- *)
13218(* To show: CARD (necklace n a) = a^n. *)
13219(* ------------------------------------------------------------------------- *)
13220
13221(* Idea: size of (necklace n a) = a^n. *)
13222
13223(* Theorem: CARD (necklace n a) = a ** n *)
13224(* Proof:
13225 By induction on n.
13226 Base: CARD (necklace 0 a) = a ** 0
13227 CARD (necklace 0 a)
13228 = CARD {[]} by necklace_0
13229 = 1 by CARD_SING
13230 = a ** 0 by EXP_0
13231 Step: CARD (necklace n a) = a ** n ==>
13232 CARD (necklace (SUC n) a) = a ** SUC n
13233 Let f = (\(c, ls). c :: ls), b = count a, c = necklace n a.
13234 Note FINITE b by FINITE_COUNT
13235 and FINITE c by necklace_finite
13236 and FINITE (b CROSS c) by FINITE_CROSS
13237 Also INJ f (b CROSS c) univ(:num list) by INJ_DEF, CONS_11
13238 CARD (necklace (SUC n) a)
13239 = CARD (IMAGE f (b CROSS c)) by necklace_suc
13240 = CARD (b CROSS c) by INJ_CARD_IMAGE_EQN
13241 = CARD b * CARD c by CARD_CROSS
13242 = a * CARD c by CARD_COUNT
13243 = a * a ** n by induction hypothesis
13244 = a ** SUC n by EXP
13245*)
13246Theorem necklace_card:
13247 !n a. CARD (necklace n a) = a ** n
13248Proof
13249 rpt strip_tac >>
13250 Induct_on `n` >-
13251 simp[necklace_0] >>
13252 qabbrev_tac `f = (\(c:num, ls:num list). c :: ls)` >>
13253 qabbrev_tac `b = count a` >>
13254 qabbrev_tac `c = necklace n a` >>
13255 `FINITE b` by rw[FINITE_COUNT, Abbr`b`] >>
13256 `FINITE c` by rw[necklace_finite, Abbr`c`] >>
13257 `necklace (SUC n) a = IMAGE f (b CROSS c)` by rw[necklace_suc, Abbr`f`, Abbr`b`, Abbr`c`] >>
13258 `INJ f (b CROSS c) univ(:num list)` by rw[INJ_DEF, pairTheory.FORALL_PROD, Abbr`f`] >>
13259 `FINITE (b CROSS c)` by rw[FINITE_CROSS] >>
13260 `CARD (necklace (SUC n) a) = CARD (b CROSS c)` by rw[INJ_CARD_IMAGE_EQN] >>
13261 `_ = CARD b * CARD c` by rw[CARD_CROSS] >>
13262 `_ = a * a ** n` by fs[Abbr`b`, Abbr`c`] >>
13263 simp[EXP]
13264QED
13265
13266(* ------------------------------------------------------------------------- *)
13267(* Mono-colored necklace - necklace with a single color. *)
13268(* ------------------------------------------------------------------------- *)
13269
13270(* Define mono-colored necklace *)
13271Definition monocoloured_def[nocompute]:
13272 monocoloured n a =
13273 {ls | ls IN necklace n a /\ (ls <> [] ==> SING (set ls)) }
13274End
13275(* Note: use [nocompute] as this is not effective. *)
13276
13277(* Theorem: ls IN monocoloured n a <=>
13278 ls IN necklace n a /\ (ls <> [] ==> SING (set ls)) *)
13279(* Proof: by monocoloured_def *)
13280Theorem monocoloured_element:
13281 !n a ls. ls IN monocoloured n a <=>
13282 ls IN necklace n a /\ (ls <> [] ==> SING (set ls))
13283Proof
13284 simp[monocoloured_def]
13285QED
13286
13287(* ------------------------------------------------------------------------- *)
13288(* Know the Mono-coloured necklaces. *)
13289(* ------------------------------------------------------------------------- *)
13290
13291(* Idea: A monocoloured necklace is indeed a necklace. *)
13292
13293(* Theorem: ls IN monocoloured n a ==> ls IN necklace n a *)
13294(* Proof: by monocoloured_def *)
13295Theorem monocoloured_necklace:
13296 !n a ls. ls IN monocoloured n a ==> ls IN necklace n a
13297Proof
13298 simp[monocoloured_def]
13299QED
13300
13301(* Idea: The monocoloured set is subset of necklace set. *)
13302
13303(* Theorem: (monocoloured n a) SUBSET (necklace n a) *)
13304(* Proof: by monocoloured_necklace, SUBSET_DEF *)
13305Theorem monocoloured_subset:
13306 !n a. (monocoloured n a) SUBSET (necklace n a)
13307Proof
13308 simp[monocoloured_necklace, SUBSET_DEF]
13309QED
13310
13311(* Idea: The monocoloured set is FINITE. *)
13312
13313(* Theorem: FINITE (monocoloured n a) *)
13314(* Proof:
13315 Note (monocoloured n a) SUBSET (necklace n a) by monocoloured_subset
13316 and FINITE (necklace n a) by necklace_finite
13317 so FINITE (monocoloured n a) by SUBSET_FINITE
13318*)
13319Theorem monocoloured_finite:
13320 !n a. FINITE (monocoloured n a)
13321Proof
13322 metis_tac[monocoloured_subset, necklace_finite, SUBSET_FINITE]
13323QED
13324
13325(* Idea: Zero-length monocoloured set is singleton NIL. *)
13326
13327(* Theorem: monocoloured 0 a = {[]} *)
13328(* Proof:
13329 monocoloured 0 a
13330 = {ls | ls IN necklace 0 a /\ (ls <> [] ==> SING (set ls)) } by monocoloured_def
13331 = {ls | ls IN {[]} /\ (ls <> [] ==> SING (set ls)) } by necklace_0
13332 = {[]} by IN_SING
13333*)
13334Theorem monocoloured_0:
13335 !a. monocoloured 0 a = {[]}
13336Proof
13337 rw[monocoloured_def, necklace_0, EXTENSION, EQ_IMP_THM]
13338QED
13339
13340(* Idea: Unit-length monocoloured set are necklaces of length 1. *)
13341
13342(* Theorem: monocoloured 1 a = necklace 1 a *)
13343(* Proof:
13344 By necklace_def, monocoloured_def, EXTENSION,
13345 this is to show:
13346 (LENGTH x = 1) /\ set x SUBSET count a /\ (x <> [] ==> SING (set x)) <=>
13347 (LENGTH x = 1) /\ set x SUBSET count a
13348 This is true by SING_LIST_TO_SET
13349*)
13350Theorem monocoloured_1:
13351 !a. monocoloured 1 a = necklace 1 a
13352Proof
13353 rw[necklace_def, monocoloured_def, EXTENSION] >>
13354 metis_tac[SING_LIST_TO_SET]
13355QED
13356
13357(* Idea: Unit-length necklaces are monocoloured. *)
13358
13359(* Theorem: necklace 1 a = monocoloured 1 a *)
13360(* Proof: by monocoloured_1 *)
13361Theorem necklace_1_monocoloured:
13362 !a. necklace 1 a = monocoloured 1 a
13363Proof
13364 simp[monocoloured_1]
13365QED
13366
13367(* Idea: Some non-NIL necklaces are monocoloured. *)
13368
13369(* Theorem: 0 < n ==> monocoloured n 0 = {} *)
13370(* Proof:
13371 Note (monocoloured n 0) SUBSET (necklace n 0) by monocoloured_subset
13372 but necklace n 0 = {} by necklace_empty
13373 so monocoloured n 0 = {} by SUBSET_EMPTY
13374*)
13375Theorem monocoloured_empty:
13376 !n. 0 < n ==> monocoloured n 0 = {}
13377Proof
13378 metis_tac[monocoloured_subset, necklace_empty, SUBSET_EMPTY]
13379QED
13380
13381(* Idea: One-colour necklaces are monocoloured. *)
13382
13383(* Theorem: monocoloured n 1 = necklace n 1 *)
13384(* Proof:
13385 By monocoloured_def, necklace_def, EXTENSION,
13386 this is to show:
13387 set x SUBSET count 1 /\ x <> [] ==> SING (set x)
13388 Note count 1 = {0} by COUNT_1
13389 and set x <> {} by LIST_TO_SET
13390 so set x = {0} by SUBSET_SING_IFF
13391 or SING (set x) by SING_DEF
13392*)
13393Theorem monocoloured_mono:
13394 !n. monocoloured n 1 = necklace n 1
13395Proof
13396 rw[monocoloured_def, necklace_def, EXTENSION, EQ_IMP_THM] >>
13397 fs[COUNT_1] >>
13398 `set x = {0}` by fs[SUBSET_SING_IFF] >>
13399 simp[]
13400QED
13401
13402(* ------------------------------------------------------------------------- *)
13403(* To show: CARD (monocoloured n a) = a. *)
13404(* ------------------------------------------------------------------------- *)
13405
13406(* Idea: Relate (monocoloured (SUC n) a) to (monocoloured n a) for induction. *)
13407
13408(* Theorem: 0 < n ==> (monocoloured (SUC n) a =
13409 IMAGE (\ls. HD ls :: ls) (monocoloured n a)) *)
13410(* Proof:
13411 By monocoloured_def, necklace_def, EXTENSION, this is to show:
13412 (1) 0 < n /\ LENGTH x = SUC n /\ set x SUBSET count a /\ x <> [] ==> SING (set x) ==>
13413 ?ls. (x = HD ls::ls) /\ (LENGTH ls = n /\ set ls SUBSET count a) /\
13414 (ls <> [] ==> SING (set ls))
13415 Note SUC n <> 0 by SUC_NOT_ZERO
13416 so x <> [] by LENGTH_NIL
13417 ==> ?h t. x = h::t by list_CASES
13418 and LENGTH t = n by LENGTH
13419 but t <> [] by LENGTH_NON_NIL, 0 < n
13420 so ?k p. t = k::p by list_CASES
13421 Thus x = h::k::p by above
13422 Now h IN set x by MEM
13423 and k IN set x by MEM, SUBSET_DEF
13424 so h = k by IN_SING, SING (set x)
13425 Let ls = t,
13426 then set ls SUBSET count a by MEM, SUBSET_DEF
13427 and SING (set ls) by LIST_TO_SET_DEF
13428 (2) 0 < LENGTH ls /\ set ls SUBSET count a /\ ls <> [] ==> SING (set ls) ==>
13429 LENGTH (HD ls::ls) = SUC (LENGTH ls)
13430 This is true by LENGTH
13431 (3) 0 < LENGTH ls /\ set ls SUBSET count a /\ ls <> [] ==> SING (set ls) ==>
13432 set (HD ls::ls) SUBSET count a
13433 Note ls <> [] by LENGTH_NON_NIL
13434 so ?h t. ls = h::t by list_CASES
13435 Also set (h::ls) x <=>
13436 (x = h) \/ set t x by LIST_TO_SET_DEF
13437 Thus set (h::ls) SUBSET count a by SUBSET_DEF
13438 (4) 0 < LENGTH ls /\ set ls SUBSET count a /\ ls <> [] ==> SING (set ls) ==>
13439 SING (set (HD ls::ls))
13440 Note ls <> [] by LENGTH_NON_NIL
13441 so ?h t. ls = h::t by list_CASES
13442 Also set (h::ls) x <=>
13443 (x = h) \/ set t x by LIST_TO_SET_DEF
13444 Thus SING (set (h::ls)) by SUBSET_DEF
13445*)
13446Theorem monocoloured_suc:
13447 !n a. 0 < n ==> (monocoloured (SUC n) a =
13448 IMAGE (\ls. HD ls :: ls) (monocoloured n a))
13449Proof
13450 rw[monocoloured_def, necklace_def, EXTENSION] >>
13451 rw[pairTheory.EXISTS_PROD, EQ_IMP_THM] >| [
13452 `SUC n <> 0` by decide_tac >>
13453 `x <> [] /\ ?h t. x = h::t` by metis_tac[LENGTH_NIL, list_CASES] >>
13454 `LENGTH t = n` by fs[] >>
13455 `t <> []` by metis_tac[LENGTH_NON_NIL] >>
13456 `h IN set x` by fs[] >>
13457 `?k p. t = k::p` by metis_tac[list_CASES] >>
13458 `HD t IN set x` by rfs[SUBSET_DEF] >>
13459 `HD t = h` by metis_tac[SING_DEF, IN_SING] >>
13460 qexists_tac `t` >>
13461 fs[],
13462 simp[],
13463 `ls <> [] /\ ?h t. ls = h::t` by metis_tac[LENGTH_NON_NIL, list_CASES] >>
13464 fs[],
13465 `ls <> [] /\ ?h t. ls = h::t` by metis_tac[LENGTH_NON_NIL, list_CASES] >>
13466 fs[]
13467 ]
13468QED
13469
13470(* Idea: size of (monocoloured 0 a) = 1. *)
13471
13472(* Theorem: CARD (monocoloured 0 a) = 1 *)
13473(* Proof:
13474 Note monocoloured 0 a = {[]} by monocoloured_0
13475 so CARD (monocoloured 0 a) = 1 by CARD_SING
13476*)
13477Theorem monocoloured_0_card:
13478 !a. CARD (monocoloured 0 a) = 1
13479Proof
13480 simp[monocoloured_0]
13481QED
13482
13483(* Idea: size of (monocoloured n a) = a. *)
13484
13485(* Theorem: 0 < n ==> CARD (monocoloured n a) = a *)
13486(* Proof:
13487 By induction on n.
13488 Base: 0 < 0 ==> (CARD (monocoloured 0 a) = a)
13489 True by 0 < 0 = F.
13490 Step: 0 < n ==> CARD (monocoloured n a) = a ==>
13491 0 < SUC n ==> (CARD (monocoloured (SUC n) a) = a)
13492 If n = 0,
13493 CARD (monocoloured (SUC 0) a)
13494 = CARD (monocoloured 1 a) by ONE
13495 = CARD (necklace 1 a) by monocoloured_1
13496 = a ** 1 by necklace_card
13497 = a by EXP_1
13498 If n <> 0, then 0 < n.
13499 Let f = (\ls. HD ls :: ls).
13500 Then INJ f (monocoloured n a)
13501 univ(:num list) by INJ_DEF, CONS_11
13502 and FINITE (monocoloured n a) by monocoloured_finite
13503 CARD (monocoloured (SUC n) a)
13504 = CARD (IMAGE f (monocoloured n a)) by monocoloured_suc
13505 = CARD (monocoloured n a) by INJ_CARD_IMAGE_EQN
13506 = a by induction hypothesis
13507*)
13508Theorem monocoloured_card:
13509 !n a. 0 < n ==> CARD (monocoloured n a) = a
13510Proof
13511 rpt strip_tac >>
13512 Induct_on `n` >-
13513 simp[] >>
13514 (Cases_on `n = 0` >> simp[]) >-
13515 simp[monocoloured_1, necklace_card] >>
13516 qabbrev_tac `f = \ls:num list. HD ls :: ls` >>
13517 `INJ f (monocoloured n a) univ(:num list)` by rw[INJ_DEF, Abbr`f`] >>
13518 `FINITE (monocoloured n a)` by rw[monocoloured_finite] >>
13519 `CARD (monocoloured (SUC n) a) =
13520 CARD (IMAGE f (monocoloured n a))` by rw[monocoloured_suc, Abbr`f`] >>
13521 `_ = CARD (monocoloured n a)` by rw[INJ_CARD_IMAGE_EQN] >>
13522 fs[]
13523QED
13524
13525(* Theorem: monocoloured n a =
13526 if n = 0 then {[]} else IMAGE (\c. GENLIST (K c) n) (count a) *)
13527(* Proof:
13528 If n = 0, true by monocoloured_0
13529 If n <> 0, then 0 < n.
13530 By monocoloured_def, necklace_def, EXTENSION, this is to show:
13531 (1) 0 < LENGTH x /\ set x SUBSET count a /\ x <> [] ==> SING (set x) ==>
13532 ?c. (x = GENLIST (K c) (LENGTH x)) /\ c < a
13533 Note x <> [] by LENGTH_NON_NIL
13534 so ?c. set x = {c} by SING_DEF
13535 Then c < a by SUBSET_DEF, IN_COUNT
13536 and x = GENLIST (K c) (LENGTH x) by LIST_TO_SET_SING_IFF
13537 (2) c < a ==> LENGTH (GENLIST (K c) n) = n,
13538 This is true by LENGTH_GENLIST
13539 (3) c < a ==> set (GENLIST (K c) n) SUBSET count a
13540 Note set (GENLIST (K c) n) = {c} by GENLIST_K_SET
13541 so c < a ==> {c} SUBSET (count a) by SUBSET_DEF
13542 (4) c < a /\ GENLIST (K c) n <> [] ==> SING (set (GENLIST (K c) n))
13543 Note set (GENLIST (K c) n) = {c} by GENLIST_K_SET
13544 so SING (set (GENLIST (K c) n)) by SING_DEF
13545*)
13546Theorem monocoloured_eqn[compute]:
13547 !n a. monocoloured n a =
13548 if n = 0 then {[]}
13549 else IMAGE (\c. GENLIST (K c) n) (count a)
13550Proof
13551 rw_tac bool_ss[] >-
13552 simp[monocoloured_0] >>
13553 `0 < n` by decide_tac >>
13554 rw[monocoloured_def, necklace_def, EXTENSION, EQ_IMP_THM] >| [
13555 `x <> []` by metis_tac[LENGTH_NON_NIL] >>
13556 `SING (set x) /\ ?c. set x = {c}` by rw[GSYM SING_DEF] >>
13557 `c < a` by fs[SUBSET_DEF] >>
13558 `?b. x = GENLIST (K b) (LENGTH x)` by metis_tac[LIST_TO_SET_SING_IFF] >>
13559 metis_tac[GENLIST_K_SET, IN_SING],
13560 simp[],
13561 rw[GENLIST_K_SET],
13562 rw[GENLIST_K_SET]
13563 ]
13564QED
13565
13566(*
13567> EVAL ``monocoloured 2 3``; = {[2; 2]; [1; 1]; [0; 0]}: thm
13568> EVAL ``monocoloured 3 2``; = {[1; 1; 1]; [0; 0; 0]}: thm
13569*)
13570
13571(* Slight improvement of a previous result. *)
13572
13573(* Theorem: CARD (monocoloured n a) = if n = 0 then 1 else a *)
13574(* Proof:
13575 If n = 0,
13576 CARD (monocoloured 0 a)
13577 = CARD {[]} by monocoloured_eqn
13578 = 1 by CARD_SING
13579 If n <> 0, then 0 < n.
13580 Let f = (\c:num. GENLIST (K c) n).
13581 Then INJ f (count a) univ(:num list)
13582 by INJ_DEF, GENLIST_K_SET, IN_SING
13583 and FINITE (count a) by FINITE_COUNT
13584 CARD (monocoloured n a)
13585 = CARD (IMAGE f (count a)) by monocoloured_eqn
13586 = CARD (count a) by INJ_CARD_IMAGE_EQN
13587 = a by CARD_COUNT
13588*)
13589Theorem monocoloured_card_eqn:
13590 !n a. CARD (monocoloured n a) = if n = 0 then 1 else a
13591Proof
13592 rw[monocoloured_eqn] >>
13593 qmatch_abbrev_tac `CARD (IMAGE f (count a)) = a` >>
13594 `INJ f (count a) univ(:num list)` by
13595 (rw[INJ_DEF, Abbr`f`] >>
13596 `0 < n` by decide_tac >>
13597 metis_tac[GENLIST_K_SET, IN_SING]) >>
13598 rw[INJ_CARD_IMAGE_EQN]
13599QED
13600
13601(* ------------------------------------------------------------------------- *)
13602(* Multi-colored necklace *)
13603(* ------------------------------------------------------------------------- *)
13604
13605(* Define multi-colored necklace *)
13606Definition multicoloured_def:
13607 multicoloured n a = (necklace n a) DIFF (monocoloured n a)
13608End
13609(* Note: EVAL can handle set DIFF. *)
13610
13611(*
13612> EVAL ``multicoloured 3 2``;
13613= {[1; 1; 0]; [1; 0; 1]; [1; 0; 0]; [0; 1; 1]; [0; 1; 0]; [0; 0; 1]}: thm
13614> EVAL ``multicoloured 2 3``;
13615= {[2; 1]; [2; 0]; [1; 2]; [1; 0]; [0; 2]; [0; 1]}: thm
13616*)
13617
13618(* Theorem: ls IN multicoloured n a <=>
13619 ls IN necklace n a /\ ls <> [] /\ ~SING (set ls) *)
13620(* Proof:
13621 ls IN multicoloured n a
13622 <=> ls IN (necklace n a) DIFF (monocoloured n a) by multicoloured_def
13623 <=> ls IN (necklace n a) /\ ls NOTIN (monocoloured n a) by IN_DIFF
13624 <=> ls IN (necklace n a) /\
13625 ~ls IN necklace n a /\ (ls <> [] ==> SING (set ls)) by monocoloured_def
13626 <=> ls IN (necklace n a) /\ ls <> [] /\ ~SING (set ls) by logical equivalence
13627
13628 t /\ ~(t /\ (p ==> q))
13629 = t /\ (~t \/ ~(p ==> q))
13630 = t /\ ~t \/ (t /\ ~(~p \/ q))
13631 = t /\ (p /\ ~q)
13632*)
13633Theorem multicoloured_element:
13634 !n a ls. ls IN multicoloured n a <=>
13635 ls IN necklace n a /\ ls <> [] /\ ~SING (set ls)
13636Proof
13637 (rw[multicoloured_def, monocoloured_def, EQ_IMP_THM] >> simp[])
13638QED
13639
13640(* ------------------------------------------------------------------------- *)
13641(* Know the Multi-coloured necklaces. *)
13642(* ------------------------------------------------------------------------- *)
13643
13644(* Idea: multicoloured is a necklace. *)
13645
13646(* Theorem: ls IN multicoloured n a ==> ls IN necklace n a *)
13647(* Proof: by multicoloured_def *)
13648Theorem multicoloured_necklace:
13649 !n a ls. ls IN multicoloured n a ==> ls IN necklace n a
13650Proof
13651 simp[multicoloured_def]
13652QED
13653
13654(* Idea: The multicoloured set is subset of necklace set. *)
13655
13656(* Theorem: (multicoloured n a) SUBSET (necklace n a) *)
13657(* Proof:
13658 Note multicoloured n a
13659 = (necklace n a) DIFF (monocoloured n a) by multicoloured_def
13660 so (multicoloured n a) SUBSET (necklace n a) by DIFF_SUBSET
13661*)
13662Theorem multicoloured_subset:
13663 !n a. (multicoloured n a) SUBSET (necklace n a)
13664Proof
13665 simp[multicoloured_def]
13666QED
13667
13668(* Idea: multicoloured set is FINITE. *)
13669
13670(* Theorem: FINITE (multicoloured n a) *)
13671(* Proof:
13672 Note multicoloured n a
13673 = (necklace n a) DIFF (monocoloured n a) by multicoloured_def
13674 and FINITE (necklace n a) by necklace_finite
13675 so FINITE (multicoloured n a) by FINITE_DIFF
13676*)
13677Theorem multicoloured_finite:
13678 !n a. FINITE (multicoloured n a)
13679Proof
13680 simp[multicoloured_def, necklace_finite, FINITE_DIFF]
13681QED
13682
13683(* Idea: (multicoloured 0 a) is EMPTY. *)
13684
13685(* Theorem: multicoloured 0 a = {} *)
13686(* Proof:
13687 multicoloured 0 a
13688 = (necklace 0 a) DIFF (monocoloured 0 a) by multicoloured_def
13689 = {[]} - {[]} by necklace_0, monocoloured_0
13690 = {} by DIFF_EQ_EMPTY
13691*)
13692Theorem multicoloured_0:
13693 !a. multicoloured 0 a = {}
13694Proof
13695 simp[multicoloured_def, necklace_0, monocoloured_0]
13696QED
13697
13698(* Idea: (mutlicoloured 1 a) is also EMPTY. *)
13699
13700(* Theorem: multicoloured 1 a = {} *)
13701(* Proof:
13702 multicoloured 1 a
13703 = (necklace 1 a) DIFF (monocoloured 1 a) by multicoloured_def
13704 = (necklace 1 a) DIFF (necklace 1 a) by monocoloured_1
13705 = {} by DIFF_EQ_EMPTY
13706*)
13707Theorem multicoloured_1:
13708 !a. multicoloured 1 a = {}
13709Proof
13710 simp[multicoloured_def, monocoloured_1]
13711QED
13712
13713(* Idea: (multicoloured n 0) without color is EMPTY. *)
13714
13715(* Theorem: multicoloured n 0 = {} *)
13716(* Proof:
13717 If n = 0,
13718 Then multicoloured 0 0 = {} by multicoloured_0
13719 If n <> 0, then 0 < n.
13720 multicoloured n 0
13721 = (necklace n 0) DIFF (monocoloured n 0) by multicoloured_def
13722 = {} DIFF (monocoloured n 0) by necklace_empty
13723 = {} by EMPTY_DIFF
13724*)
13725Theorem multicoloured_n_0:
13726 !n. multicoloured n 0 = {}
13727Proof
13728 rpt strip_tac >>
13729 Cases_on `n = 0` >-
13730 simp[multicoloured_0] >>
13731 simp[multicoloured_def, necklace_empty]
13732QED
13733
13734(* Idea: (multicoloured n 1) with one color is EMPTY. *)
13735
13736(* Theorem: multicoloured n 1 = {} *)
13737(* Proof:
13738 multicoloured n 1
13739 = (necklace n 1) DIFF (monocoloured n 1) by multicoloured_def
13740 = {necklace n 1} DIFF (necklace n 1) by monocoloured_mono
13741 = {} by DIFF_EQ_EMPTY
13742*)
13743Theorem multicoloured_n_1:
13744 !n. multicoloured n 1 = {}
13745Proof
13746 simp[multicoloured_def, monocoloured_mono]
13747QED
13748
13749(* Theorem: multicoloured n 0 = {} /\ multicoloured n 1 = {} *)
13750(* Proof: by multicoloured_n_0, multicoloured_n_1. *)
13751Theorem multicoloured_empty:
13752 !n. multicoloured n 0 = {} /\ multicoloured n 1 = {}
13753Proof
13754 simp[multicoloured_n_0, multicoloured_n_1]
13755QED
13756
13757(* ------------------------------------------------------------------------- *)
13758(* To show: CARD (multicoloured n a) = a^n - a. *)
13759(* ------------------------------------------------------------------------- *)
13760
13761(* Idea: a multicoloured necklace is not monocoloured. *)
13762
13763(* Theorem: DISJOINT (multicoloured n a) (monocoloured n a) *)
13764(* Proof:
13765 Let s = necklace n a, t = monocoloured n a.
13766 Then multicoloured n a = s DIFF t by multicoloured_def
13767 so DISJOINT (multicoloured n a) t by DISJOINT_DIFF
13768*)
13769Theorem multi_mono_disjoint:
13770 !n a. DISJOINT (multicoloured n a) (monocoloured n a)
13771Proof
13772 simp[multicoloured_def, DISJOINT_DIFF]
13773QED
13774
13775(* Idea: a necklace is either monocoloured or multicolored. *)
13776
13777(* Theorem: necklace n a = (multicoloured n a) UNION (monocoloured n a) *)
13778(* Proof:
13779 Let s = necklace n a, t = monocoloured n a.
13780 Then multicoloured n a = s DIFF t by multicoloured_def
13781 Now t SUBSET s by monocoloured_subset
13782 so necklace n a = s
13783 = (multicoloured n a) UNION t by UNION_DIFF
13784*)
13785Theorem multi_mono_exhaust:
13786 !n a. necklace n a = (multicoloured n a) UNION (monocoloured n a)
13787Proof
13788 simp[multicoloured_def, monocoloured_subset, UNION_DIFF]
13789QED
13790
13791(* Idea: size of (multicoloured n a) = a^n - a. *)
13792
13793(* Theorem: 0 < n ==> (CARD (multicoloured n a) = a ** n - a) *)
13794(* Proof:
13795 Let s = necklace n a,
13796 t = monocoloured n a.
13797 Note t SUBSET s by monocoloured_subset
13798 and FINITE s by necklace_finite
13799 CARD (multicoloured n a)
13800 = CARD (s DIFF t) by multicoloured_def
13801 = CARD s - CARD t by SUBSET_DIFF_CARD, t SUBSET s
13802 = a ** n - CARD t by necklace_card
13803 = a ** n - a by monocoloured_card, 0 < n
13804*)
13805Theorem multicoloured_card:
13806 !n a. 0 < n ==> (CARD (multicoloured n a) = a ** n - a)
13807Proof
13808 rpt strip_tac >>
13809 `(monocoloured n a) SUBSET (necklace n a)` by rw[monocoloured_subset] >>
13810 `FINITE (necklace n a)` by rw[necklace_finite] >>
13811 simp[multicoloured_def, SUBSET_DIFF_CARD, necklace_card, monocoloured_card]
13812QED
13813
13814(* Theorem: CARD (multicoloured n a) = if n = 0 then 0 else a ** n - a *)
13815(* Proof:
13816 If n = 0,
13817 CARD (multicoloured 0 a)
13818 = CARD {} by multicoloured_0
13819 = 0 by CARD_EMPTY
13820 If n <> 0, then 0 < n.
13821 CARD (multicoloured 0 a)
13822 = a ** n - a by multicoloured_card
13823*)
13824Theorem multicoloured_card_eqn:
13825 !n a. CARD (multicoloured n a) = if n = 0 then 0 else a ** n - a
13826Proof
13827 rpt strip_tac >>
13828 Cases_on `n = 0` >-
13829 simp[multicoloured_0] >>
13830 simp[multicoloured_card]
13831QED
13832
13833(* Idea: (multicoloured n a) NOT empty when 1 < n /\ 1 < a. *)
13834
13835(* Theorem: 1 < n /\ 1 < a ==> (multicoloured n a) <> {} *)
13836(* Proof:
13837 Let s = multicoloured n a.
13838 Then FINITE s by multicoloured_finite
13839 and CARD s = a ** n - a by multicoloured_card
13840 Note a < a ** n by EXP_LT, 1 < a, 1 < n
13841 Thus CARD s <> 0,
13842 or s <> {} by CARD_EMPTY
13843*)
13844Theorem multicoloured_nonempty:
13845 !n a. 1 < n /\ 1 < a ==> (multicoloured n a) <> {}
13846Proof
13847 rpt strip_tac >>
13848 qabbrev_tac `s = multicoloured n a` >>
13849 `FINITE s` by rw[multicoloured_finite, Abbr`s`] >>
13850 `CARD s = a ** n - a` by rw[multicoloured_card, Abbr`s`] >>
13851 `a < a ** n` by rw[EXP_LT] >>
13852 `CARD s <> 0` by decide_tac >>
13853 rfs[]
13854QED
13855
13856(* ------------------------------------------------------------------------- *)
13857
13858(* For revised necklace proof using GCD. *)
13859
13860(* Idea: multicoloured lists are not monocoloured. *)
13861
13862(* Theorem: ls IN multicoloured n a ==> ~(ls IN monocoloured n a) *)
13863(* Proof:
13864 Let s = necklace n a,
13865 t = monocoloured n a.
13866 Note multicoloured n a = s DIFF t by multicoloured_def
13867 so ls IN multicoloured n a
13868 ==> ls NOTIN t by IN_DIFF
13869*)
13870Theorem multicoloured_not_monocoloured:
13871 !n a ls. ls IN multicoloured n a ==> ~(ls IN monocoloured n a)
13872Proof
13873 simp[multicoloured_def]
13874QED
13875
13876(* Theorem: ls IN necklace n a ==>
13877 (ls IN multicoloured n a <=> ~(ls IN monocoloured n a)) *)
13878(* Proof:
13879 Let s = necklace n a,
13880 t = monocoloured n a.
13881 Note multicoloured n a = s DIFF t by multicoloured_def
13882 so ls IN multicoloured n a
13883 <=> ls IN s /\ ls NOTIN t by IN_DIFF
13884*)
13885Theorem multicoloured_not_monocoloured_iff:
13886 !n a ls. ls IN necklace n a ==>
13887 (ls IN multicoloured n a <=> ~(ls IN monocoloured n a))
13888Proof
13889 simp[multicoloured_def]
13890QED
13891
13892(* Theorem: ls IN necklace n a ==>
13893 ls IN multicoloured n a \/ ls IN monocoloured n a *)
13894(* Proof: by multicoloured_def. *)
13895Theorem multicoloured_or_monocoloured:
13896 !n a ls. ls IN necklace n a ==>
13897 ls IN multicoloured n a \/ ls IN monocoloured n a
13898Proof
13899 simp[multicoloured_def]
13900QED
13901
13902(* ------------------------------------------------------------------------- *)
13903(* Combinatorics Documentation *)
13904(* ------------------------------------------------------------------------- *)
13905(* Overloading (# is temporary):
13906*)
13907(* Definitions and Theorems (# are exported, ! are in compute):
13908
13909 Counting number of combinations:
13910 sub_count_def |- !n k. sub_count n k = {s | s SUBSET count n /\ CARD s = k}
13911 choose_def |- !n k. n choose k = CARD (sub_count n k)
13912 sub_count_element |- !n k s. s IN sub_count n k <=> s SUBSET count n /\ CARD s = k
13913 sub_count_subset |- !n k. sub_count n k SUBSET POW (count n)
13914 sub_count_finite |- !n k. FINITE (sub_count n k)
13915 sub_count_element_no_self
13916 |- !n k s. s IN sub_count n k ==> n NOTIN s
13917 sub_count_element_finite
13918 |- !n k s. s IN sub_count n k ==> FINITE s
13919 sub_count_n_0 |- !n. sub_count n 0 = {{}}
13920 sub_count_0_n |- !n. sub_count 0 n = if n = 0 then {{}} else {}
13921 sub_count_n_1 |- !n. sub_count n 1 = {{j} | j < n}
13922 sub_count_n_n |- !n. sub_count n n = {count n}
13923 sub_count_eq_empty |- !n k. sub_count n k = {} <=> n < k
13924 sub_count_union |- !n k. sub_count (n + 1) (k + 1) =
13925 IMAGE (\s. n INSERT s) (sub_count n k) UNION
13926 sub_count n (k + 1)
13927 sub_count_disjoint |- !n k. DISJOINT (IMAGE (\s. n INSERT s) (sub_count n k))
13928 (sub_count n (k + 1))
13929 sub_count_insert |- !n k s. s IN sub_count n k ==>
13930 n INSERT s IN sub_count (n + 1) (k + 1)
13931 sub_count_insert_card
13932 |- !n k. CARD (IMAGE (\s. n INSERT s) (sub_count n k)) =
13933 n choose k
13934 sub_count_alt |- !n k. sub_count n 0 = {{}} /\ sub_count 0 (k + 1) = {} /\
13935 sub_count (n + 1) (k + 1) =
13936 IMAGE (\s. n INSERT s) (sub_count n k) UNION
13937 sub_count n (k + 1)
13938! sub_count_eqn |- !n k. sub_count n k =
13939 if k = 0 then {{}}
13940 else if n = 0 then {}
13941 else IMAGE (\s. n - 1 INSERT s) (sub_count (n - 1) (k - 1)) UNION
13942 sub_count (n - 1) k
13943 choose_n_0 |- !n. n choose 0 = 1
13944 choose_n_1 |- !n. n choose 1 = n
13945 choose_eq_0 |- !n k. n choose k = 0 <=> n < k
13946 choose_0_n |- !n. 0 choose n = if n = 0 then 1 else 0
13947 choose_1_n |- !n. 1 choose n = if 1 < n then 0 else 1
13948 choose_n_n |- !n. n choose n = 1
13949 choose_recurrence |- !n k. (n + 1) choose (k + 1) = n choose k + n choose (k + 1)
13950 choose_alt |- !n k. n choose 0 = 1 /\ 0 choose (k + 1) = 0 /\
13951 (n + 1) choose (k + 1) = n choose k + n choose (k + 1)
13952! choose_eqn |- !n k. n choose k = binomial n k
13953
13954 Partition of the set of subsets by bijective equivalence:
13955 sub_sets_def |- !P k. sub_sets P k = {s | s SUBSET P /\ CARD s = k}
13956 sub_sets_sub_count |- !n k. sub_sets (count n) k = sub_count n k
13957 sub_sets_equiv_class|- !s t. FINITE t /\ s SUBSET t ==>
13958 sub_sets t (CARD s) = equiv_class $=b= (POW t) s
13959 sub_count_equiv_class
13960 |- !n k. k <= n ==>
13961 sub_count n k =
13962 equiv_class $=b= (POW (count n)) (count k)
13963 count_power_partition |- !n. partition $=b= (POW (count n)) =
13964 IMAGE (sub_count n) (upto n)
13965 sub_count_count_inj |- !n m. INJ (sub_count n) (upto n)
13966 univ(:(num -> bool) -> bool)
13967 choose_sum_over_count |- !n. SIGMA ($choose n) (upto n) = 2 ** n
13968 choose_sum_over_all |- !n. SUM (MAP ($choose n) [0 .. n]) = 2 ** n
13969
13970 Counting number of permutations:
13971 perm_count_def |- !n. perm_count n = {ls | ALL_DISTINCT ls /\ set ls = count n}
13972 perm_def |- !n. perm n = CARD (perm_count n)
13973 perm_count_element |- !ls n. ls IN perm_count n <=> ALL_DISTINCT ls /\ set ls = count n
13974 perm_count_element_no_self
13975 |- !ls n. ls IN perm_count n ==> ~MEM n ls
13976 perm_count_element_length
13977 |- !ls n. ls IN perm_count n ==> LENGTH ls = n
13978 perm_count_subset |- !n. perm_count n SUBSET necklace n n
13979 perm_count_finite |- !n. FINITE (perm_count n)
13980 perm_count_0 |- perm_count 0 = {[]}
13981 perm_count_1 |- perm_count 1 = {[0]}
13982 interleave_def |- !x ls. x interleave ls =
13983 IMAGE (\k. TAKE k ls ++ x::DROP k ls) (upto (LENGTH ls))
13984 interleave_alt |- !ls x. x interleave ls =
13985 {TAKE k ls ++ x::DROP k ls | k | k <= LENGTH ls}
13986 interleave_element |- !ls x y. y IN x interleave ls <=>
13987 ?k. k <= LENGTH ls /\ y = TAKE k ls ++ x::DROP k ls
13988 interleave_nil |- !x. x interleave [] = {[x]}
13989 interleave_length |- !ls x y. y IN x interleave ls ==> LENGTH y = 1 + LENGTH ls
13990 interleave_distinct |- !ls x y. ALL_DISTINCT (x::ls) /\ y IN x interleave ls ==>
13991 ALL_DISTINCT y
13992 interleave_distinct_alt
13993 |- !ls x y. ALL_DISTINCT ls /\ ~MEM x ls /\
13994 y IN x interleave ls ==> ALL_DISTINCT y
13995 interleave_set |- !ls x y. y IN x interleave ls ==> set y = set (x::ls)
13996 interleave_set_alt |- !ls x y. y IN x interleave ls ==> set y = x INSERT set ls
13997 interleave_has_cons |- !ls x. x::ls IN x interleave ls
13998 interleave_not_empty|- !ls x. x interleave ls <> {}
13999 interleave_eq |- !n x y. ~MEM n x /\ ~MEM n y ==>
14000 (n interleave x = n interleave y <=> x = y)
14001 interleave_disjoint |- !l1 l2 x. ~MEM x l1 /\ l1 <> l2 ==>
14002 DISJOINT (x interleave l1) (x interleave l2)
14003 interleave_finite |- !ls x. FINITE (x interleave ls)
14004 interleave_count_inj|- !ls x. ~MEM x ls ==>
14005 INJ (\k. TAKE k ls ++ x::DROP k ls)
14006 (upto (LENGTH ls)) univ(:'a list)
14007 interleave_card |- !ls x. ~MEM x ls ==> CARD (x interleave ls) = 1 + LENGTH ls
14008 interleave_revert |- !ls h. ALL_DISTINCT ls /\ MEM h ls ==>
14009 ?t. ALL_DISTINCT t /\ ls IN h interleave t /\
14010 set t = set ls DELETE h
14011 interleave_revert_count
14012 |- !ls n. ALL_DISTINCT ls /\ set ls = upto n ==>
14013 ?t. ALL_DISTINCT t /\ ls IN n interleave t /\
14014 set t = count n
14015 perm_count_suc |- !n. perm_count (SUC n) =
14016 BIGUNION (IMAGE ($interleave n) (perm_count n))
14017 perm_count_suc_alt |- !n. perm_count (n + 1) =
14018 BIGUNION (IMAGE ($interleave n) (perm_count n))
14019! perm_count_eqn |- !n. perm_count n =
14020 if n = 0 then {[]}
14021 else BIGUNION (IMAGE ($interleave (n - 1)) (perm_count (n - 1)))
14022 perm_0 |- perm 0 = 1
14023 perm_1 |- perm 1 = 1
14024 perm_count_interleave_finite
14025 |- !n e. e IN IMAGE ($interleave n) (perm_count n) ==> FINITE e
14026 perm_count_interleave_card
14027 |- !n e. e IN IMAGE ($interleave n) (perm_count n) ==> CARD e = n + 1
14028 perm_count_interleave_disjoint
14029 |- !n e s t. s IN IMAGE ($interleave n) (perm_count n) /\
14030 t IN IMAGE ($interleave n) (perm_count n) /\ s <> t ==>
14031 DISJOINT s t
14032 perm_count_interleave_inj
14033 |- !n. INJ ($interleave n) (perm_count n) univ(:num list -> bool)
14034 perm_suc |- !n. perm (SUC n) = SUC n * perm n
14035 perm_suc_alt |- !n. perm (n + 1) = (n + 1) * perm n
14036! perm_eq_fact |- !n. perm n = FACT n
14037
14038 Permutations of a set:
14039 perm_set_def |- !s. perm_set s = {ls | ALL_DISTINCT ls /\ set ls = s}
14040 perm_set_element |- !ls s. ls IN perm_set s <=> ALL_DISTINCT ls /\ set ls = s
14041 perm_set_perm_count |- !n. perm_set (count n) = perm_count n
14042 perm_set_empty |- perm_set {} = {[]}
14043 perm_set_sing |- !x. perm_set {x} = {[x]}
14044 perm_set_eq_empty_sing
14045 |- !s. perm_set s = {[]} <=> s = {}
14046 perm_set_has_self_list
14047 |- !s. FINITE s ==> SET_TO_LIST s IN perm_set s
14048 perm_set_not_empty |- !s. FINITE s ==> perm_set s <> {}
14049 perm_set_list_not_empty
14050 |- !ls. perm_set (set ls) <> {}
14051 perm_set_map_element|- !ls f s n. ls IN perm_set s /\ BIJ f s (count n) ==>
14052 MAP f ls IN perm_count n
14053 perm_set_map_inj |- !f s n. BIJ f s (count n) ==> INJ (MAP f) (perm_set s) (perm_count n)
14054 perm_set_map_surj |- !f s n. BIJ f s (count n) ==> SURJ (MAP f) (perm_set s) (perm_count n)
14055 perm_set_map_bij |- !f s n. BIJ f s (count n) ==> BIJ (MAP f) (perm_set s) (perm_count n)
14056 perm_set_bij_eq_perm_count
14057 |- !s. FINITE s ==> perm_set s =b= perm_count (CARD s)
14058 perm_set_finite |- !s. FINITE s ==> FINITE (perm_set s)
14059 perm_set_card |- !s. FINITE s ==> CARD (perm_set s) = perm (CARD s)
14060 perm_set_card_alt |- !s. FINITE s ==> CARD (perm_set s) = FACT (CARD s)
14061
14062 Counting number of arrangements:
14063 list_count_def |- !n k. list_count n k =
14064 {ls | ALL_DISTINCT ls /\
14065 set ls SUBSET count n /\ LENGTH ls = k}
14066 arrange_def |- !n k. n arrange k = CARD (list_count n k)
14067 list_count_alt |- !n k. list_count n k =
14068 {ls | ALL_DISTINCT ls /\
14069 set ls SUBSET count n /\ CARD (set ls) = k}
14070 list_count_element |- !ls n k. ls IN list_count n k <=>
14071 ALL_DISTINCT ls /\ set ls SUBSET count n /\ LENGTH ls = k
14072 list_count_element_alt
14073 |- !ls n k. ls IN list_count n k <=>
14074 ALL_DISTINCT ls /\ set ls SUBSET count n /\ CARD (set ls) = k
14075 list_count_element_set_card
14076 |- !ls n k. ls IN list_count n k ==> CARD (set ls) = k
14077 list_count_subset |- !n k. list_count n k SUBSET necklace k n
14078 list_count_finite |- !n k. FINITE (list_count n k)
14079 list_count_n_0 |- !n. list_count n 0 = {[]}
14080 list_count_0_n |- !n. 0 < n ==> list_count 0 n = {}
14081 list_count_n_n |- !n. list_count n n = perm_count n
14082 list_count_eq_empty |- !n k. list_count n k = {} <=> n < k
14083 list_count_by_image |- !n k. 0 < k ==>
14084 list_count n k =
14085 IMAGE (\ls. if ALL_DISTINCT ls then ls else [])
14086 (necklace k n) DELETE []
14087! list_count_eqn |- !n k. list_count n k =
14088 if k = 0 then {[]}
14089 else IMAGE (\ls. if ALL_DISTINCT ls then ls else [])
14090 (necklace k n) DELETE []
14091 feq_set_equiv |- !s. feq set equiv_on s
14092 list_count_set_eq_class
14093 |- !ls n k. ls IN list_count n k ==>
14094 equiv_class (feq set) (list_count n k) ls = perm_set (set ls)
14095 list_count_set_eq_class_card
14096 |- !ls n k. ls IN list_count n k ==>
14097 CARD (equiv_class (feq set) (list_count n k) ls) = perm k
14098 list_count_set_partititon_element_card
14099 |- !n k e. e IN partition (feq set) (list_count n k) ==> CARD e = perm k
14100 list_count_element_perm_set_not_empty
14101 |- !ls n k. ls IN list_count n k ==> perm_set (set ls) <> {}
14102 list_count_set_map_element
14103 |- !s n k. s IN partition (feq set) (list_count n k) ==>
14104 (set o CHOICE) s IN sub_count n k
14105 list_count_set_map_inj
14106 |- !n k. INJ (set o CHOICE)
14107 (partition (feq set) (list_count n k))
14108 (sub_count n k)
14109 list_count_set_map_surj
14110 |- !n k. SURJ (set o CHOICE)
14111 (partition (feq set) (list_count n k))
14112 (sub_count n k)
14113 list_count_set_map_bij
14114 |- !n k. BIJ (set o CHOICE)
14115 (partition (feq set) (list_count n k))
14116 (sub_count n k)
14117! arrange_eqn |- !n k. n arrange k = (n choose k) * perm k
14118 arrange_alt |- !n k. n arrange k = (n choose k) * FACT k
14119 arrange_formula |- !n k. n arrange k = binomial n k * FACT k
14120 arrange_formula2 |- !n k. k <= n ==> n arrange k = FACT n DIV FACT (n - k)
14121 arrange_n_0 |- !n. n arrange 0 = 1
14122 arrange_0_n |- !n. 0 < n ==> 0 arrange n = 0
14123 arrange_n_n |- !n. n arrange n = perm n
14124 arrange_n_n_alt |- !n. n arrange n = FACT n
14125 arrange_eq_0 |- !n k. n arrange k = 0 <=> n < k
14126*)
14127
14128(* ------------------------------------------------------------------------- *)
14129(* Counting number of combinations. *)
14130(* ------------------------------------------------------------------------- *)
14131
14132(* The strategy:
14133This is to show, ultimately, C(n,k) = binomial n k.
14134
14135Conceptually,
14136C(n,k) = number of ways to choose k elements from a set of n elements.
14137Each choice gives a k-subset.
14138
14139Define C(n,k) = number of k-subsets of an n-set.
14140Prove that C(n,k) = binomial n k:
14141(1) C(0,0) = 1
14142(2) C(0,1) = 0
14143(3) C(SUC n, SUC k) = C(n,k) + C(n,SUC k)
14144show that any such C's is just the binomial function.
14145
14146binomial_alt
14147|- !n k. binomial n 0 = 1 /\ binomial 0 (k + 1) = 0 /\
14148 binomial (n + 1) (k + 1) = binomial n k + binomial n (k + 1)
14149
14150Moreover, bij_eq is an equivalence relation, and partitions the power set
14151of (count n) into equivalence classes of k-subsets for k = 0 to n. Thus
14152
14153SUM (GENLIST (choose n) (SUC n)) = CARD (POW (count n)) = 2 ** n
14154
14155the counterpart of binomial_sum |- !n. SUM (GENLIST (binomial n) (SUC n)) = 2 ** n
14156*)
14157
14158(* Define the set of choices of k-subsets of (count n). *)
14159Definition sub_count_def[nocompute]:
14160 sub_count n k = { (s:num -> bool) | s SUBSET (count n) /\ CARD s = k}
14161End
14162(* use [nocompute] as this is not effective for evalutaion. *)
14163
14164(* Define the number of choices of k-subsets of (count n). *)
14165Definition choose_def[nocompute]:
14166 choose n k = CARD (sub_count n k)
14167End
14168(* use [nocompute] as this is not effective for evalutaion. *)
14169(* make this an infix operator *)
14170val _ = set_fixity "choose" (Infix(NONASSOC, 550)); (* higher than arithmetic op 500. *)
14171(* val choose_def = |- !n k. n choose k = CARD (sub_count n k): thm *)
14172
14173(* Theorem: s IN sub_count n k <=> s SUBSET count n /\ CARD s = k *)
14174(* Proof: by sub_count_def. *)
14175Theorem sub_count_element:
14176 !n k s. s IN sub_count n k <=> s SUBSET count n /\ CARD s = k
14177Proof
14178 simp[sub_count_def]
14179QED
14180
14181(* Theorem: (sub_count n k) SUBSET (POW (count n)) *)
14182(* Proof:
14183 s IN sub_count n k
14184 ==> s SUBSET (count n) by sub_count_def
14185 ==> s IN POW (count n) by POW_DEF
14186 Thus (sub_count n k) SUBSET (POW (count n)) by SUBSET_DEF
14187*)
14188Theorem sub_count_subset:
14189 !n k. (sub_count n k) SUBSET (POW (count n))
14190Proof
14191 simp[sub_count_def, POW_DEF, SUBSET_DEF]
14192QED
14193
14194(* Theorem: FINITE (sub_count n k) *)
14195(* Proof:
14196 Note (sub_count n k) SUBSET (POW (count n)) by sub_count_subset
14197 and FINITE (count n) by FINITE_COUNT
14198 so FINITE (POW (count n)) by FINITE_POW
14199 Thus FINITE (sub_count n k) by SUBSET_FINITE
14200*)
14201Theorem sub_count_finite:
14202 !n k. FINITE (sub_count n k)
14203Proof
14204 metis_tac[sub_count_subset, FINITE_COUNT, FINITE_POW, SUBSET_FINITE]
14205QED
14206
14207(* Theorem: s IN sub_count n k ==> n NOTIN s *)
14208(* Proof:
14209 Note s SUBSET (count n) by sub_count_element
14210 and n NOTIN (count n) by COUNT_NOT_SELF
14211 so n NOTIN s by SUBSET_DEF
14212*)
14213Theorem sub_count_element_no_self:
14214 !n k s. s IN sub_count n k ==> n NOTIN s
14215Proof
14216 metis_tac[sub_count_element, SUBSET_DEF, COUNT_NOT_SELF]
14217QED
14218
14219(* Theorem: s IN sub_count n k ==> FINITE s *)
14220(* Proof:
14221 Note s SUBSET (count n) by sub_count_element
14222 and FINITE (count n) by FINITE_COUNT
14223 so FINITE s by SUBSET_FINITE
14224*)
14225Theorem sub_count_element_finite:
14226 !n k s. s IN sub_count n k ==> FINITE s
14227Proof
14228 metis_tac[sub_count_element, FINITE_COUNT, SUBSET_FINITE]
14229QED
14230
14231(* Theorem: sub_count n 0 = { EMPTY } *)
14232(* Proof:
14233 By EXTENSION, IN_SING, this is to show:
14234 (1) x IN sub_count n 0 ==> x = {}
14235 x IN sub_count n 0
14236 <=> x SUBSET count n /\ CARD x = 0 by sub_count_def
14237 ==> FINITE x /\ CARD x = 0 by SUBSET_FINITE, FINITE_COUNT
14238 ==> x = {} by CARD_EQ_0
14239 (2) {} IN sub_count n 0
14240 {} IN sub_count n 0
14241 <=> {} SUBSET count n /\ CARD {} = 0 by sub_count_def
14242 <=> T /\ CARD {} = 0 by EMPTY_SUBSET
14243 <=> T /\ T by CARD_EMPTY
14244 <=> T
14245*)
14246Theorem sub_count_n_0:
14247 !n. sub_count n 0 = { EMPTY }
14248Proof
14249 rewrite_tac[EXTENSION, EQ_IMP_THM] >>
14250 rw[IN_SING] >| [
14251 fs[sub_count_def] >>
14252 metis_tac[CARD_EQ_0, SUBSET_FINITE, FINITE_COUNT],
14253 rw[sub_count_def]
14254 ]
14255QED
14256
14257(* Theorem: sub_count 0 n = if n = 0 then { EMPTY } else EMPTY *)
14258(* Proof:
14259 If n = 0,
14260 then sub_count 0 n = { EMPTY } by sub_count_n_0
14261 If n <> 0,
14262 s IN sub_count 0 n
14263 <=> s SUBSET count 0 /\ CARD s = n by sub_count_def
14264 <=> s SUBSET {} /\ CARD s = n by COUNT_0
14265 <=> CARD {} = n by SUBSET_EMPTY
14266 <=> 0 = n by CARD_EMPTY
14267 <=> F by n <> 0
14268 Thus sub_count 0 n = {} by MEMBER_NOT_EMPTY
14269*)
14270Theorem sub_count_0_n:
14271 !n. sub_count 0 n = if n = 0 then { EMPTY } else EMPTY
14272Proof
14273 rw[sub_count_n_0] >>
14274 rw[sub_count_def, EXTENSION] >>
14275 spose_not_then strip_assume_tac >>
14276 `x = {}` by metis_tac[MEMBER_NOT_EMPTY] >>
14277 fs[]
14278QED
14279
14280(* Theorem: sub_count n 1 = {{j} | j < n } *)
14281(* Proof:
14282 By sub_count_def, EXTENSION, this is to show:
14283 x SUBSET count n /\ CARD x = 1 <=>
14284 ?j. (!x'. x' IN x <=> x' = j) /\ j < n
14285 If part:
14286 Note FINITE x by SUBSET_FINITE, FINITE_COUNT
14287 so ?j. x = {j} by CARD_EQ_1, SING_DEF
14288 Take this j.
14289 Then !x'. x' IN x <=> x' = j
14290 by IN_SING
14291 and x SUBSET (count n) ==> j < n
14292 by SUBSET_DEF, IN_COUNT
14293 Only-if part:
14294 Note j IN x, so x <> {} by MEMBER_NOT_EMPTY
14295 The given shows x = {j} by ONE_ELEMENT_SING
14296 and j < n ==> x SUBSET (count n)
14297 by SUBSET_DEF, IN_COUNT
14298 and CARD x = 1 by CARD_SING
14299*)
14300Theorem sub_count_n_1:
14301 !n. sub_count n 1 = {{j} | j < n }
14302Proof
14303 rw[sub_count_def, EXTENSION] >>
14304 rw[EQ_IMP_THM] >| [
14305 `FINITE x` by metis_tac[SUBSET_FINITE, FINITE_COUNT] >>
14306 `?j. x = {j}` by metis_tac[CARD_EQ_1, SING_DEF] >>
14307 metis_tac[SUBSET_DEF, IN_SING, IN_COUNT],
14308 rw[SUBSET_DEF],
14309 metis_tac[ONE_ELEMENT_SING, MEMBER_NOT_EMPTY, CARD_SING]
14310 ]
14311QED
14312
14313(* Theorem: sub_count n n = {count n} *)
14314(* Proof:
14315 s IN sub_count n n
14316 <=> s SUBSET count n /\ CARD s = n by sub_count_def
14317 <=> s SUBSET count n /\ CARD s = CARD (count n)
14318 by CARD_COUNT
14319 <=> s SUBSET count n /\ s = count n by SUBSET_CARD_EQ
14320 <=> T /\ s = count n by SUBSET_REFL
14321 Thus sub_count n n = {count n} by EXTENSION
14322*)
14323Theorem sub_count_n_n:
14324 !n. sub_count n n = {count n}
14325Proof
14326 rw_tac bool_ss[EXTENSION] >>
14327 `FINITE (count n) /\ CARD (count n) = n` by rw[] >>
14328 metis_tac[sub_count_element, SUBSET_CARD_EQ, SUBSET_REFL, IN_SING]
14329QED
14330
14331(* Theorem: sub_count n k = EMPTY <=> n < k *)
14332(* Proof:
14333 If part: sub_count n k = {} ==> n < k
14334 By contradiction, suppose k <= n.
14335 Then (count k) SUBSET (count n) by COUNT_SUBSET, k <= n
14336 and CARD (count k) = k by CARD_COUNT
14337 so (count k) IN sub_count n k by sub_count_element
14338 Thus sub_count n k <> {} by MEMBER_NOT_EMPTY
14339 which is a contradiction.
14340 Only-if part: n < k ==> sub_count n k = {}
14341 By contradiction, suppose sub_count n k <> {}.
14342 Then ?s. s IN sub_count n k by MEMBER_NOT_EMPTY
14343 ==> s SUBSET count n /\ CARD s = k
14344 by sub_count_element
14345 Note FINITE (count n) by FINITE_COUNT
14346 so CARD s <= CARD (count n) by CARD_SUBSET
14347 ==> k <= n by CARD_COUNT
14348 This contradicts n < k.
14349*)
14350Theorem sub_count_eq_empty:
14351 !n k. sub_count n k = EMPTY <=> n < k
14352Proof
14353 rw[EQ_IMP_THM] >| [
14354 spose_not_then strip_assume_tac >>
14355 `(count k) SUBSET (count n)` by rw[COUNT_SUBSET] >>
14356 `CARD (count k) = k` by rw[] >>
14357 metis_tac[sub_count_element, MEMBER_NOT_EMPTY],
14358 spose_not_then strip_assume_tac >>
14359 `?s. s IN sub_count n k` by rw[MEMBER_NOT_EMPTY] >>
14360 fs[sub_count_element] >>
14361 `FINITE (count n)` by rw[] >>
14362 `CARD s <= n` by metis_tac[CARD_SUBSET, CARD_COUNT] >>
14363 decide_tac
14364 ]
14365QED
14366
14367(* Theorem: sub_count (n + 1) (k + 1) =
14368 IMAGE (\s. n INSERT s) (sub_count n k) UNION sub_count n (k + 1) *)
14369(* Proof:
14370 By sub_count_def, EXTENSION, this is to show:
14371 (1) x SUBSET count (n + 1) /\ CARD x = k + 1 ==>
14372 ?s. (!y. y IN x <=> y = n \/ y IN s) /\
14373 s SUBSET count n /\ CARD s = k) \/ x SUBSET count n
14374 Suppose ~(x SUBSET count n),
14375 Then n IN x by SUBSET_DEF
14376 Take s = x DELETE n.
14377 Then y IN x <=>
14378 y = n \/ y IN s by EXTENSION
14379 and s SUBSET x by DELETE_SUBSET
14380 so s SUBSET (count (n + 1) DELETE n)
14381 by SUBSET_DELETE_BOTH
14382 or s SUBSET (count n) by count_def
14383 Note FINITE x by SUBSET_FINITE, FINITE_COUNT
14384 so CARD s = k by CARD_DELETE, CARD_COUNT
14385 (2) s SUBSET count n /\ x = n INSERT s ==> x SUBSET count (n + 1)
14386 Note x SUBSET (n INSERT count n) by SUBSET_INSERT_BOTH
14387 so x INSERT count (n + 1) by count_def, or count_add1
14388 (3) s SUBSET count n /\ x = n INSERT s ==> CARD x = CARD s + 1
14389 Note n NOTIN s by SUBSET_DEF, COUNT_NOT_SELF
14390 and FINITE s by SUBSET_FINITE, FINITE_COUNT
14391 so CARD x
14392 = SUC (CARD s) by CARD_INSERT
14393 = CARD s + 1 by ADD1
14394 (4) x SUBSET count n ==> x SUBSET count (n + 1)
14395 Note (count n) SUBSET count (n + 1) by COUNT_SUBSET, n <= n + 1
14396 so x SUBSET count (n + 1) by SUBSET_TRANS
14397*)
14398Theorem sub_count_union:
14399 !n k. sub_count (n + 1) (k + 1) =
14400 IMAGE (\s. n INSERT s) (sub_count n k) UNION sub_count n (k + 1)
14401Proof
14402 rw[sub_count_def, EXTENSION, Once EQ_IMP_THM] >> simp[] >| [
14403 rename [‘x SUBSET count (n + 1)’, ‘CARD x = k + 1’] >>
14404 Cases_on `x SUBSET count n` >> simp[] >>
14405 `n IN x` by
14406 (fs[SUBSET_DEF] >> rename [‘m IN x’, ‘~(m < n)’] >>
14407 `m < n + 1` by simp[] >>
14408 `m = n` by decide_tac >>
14409 fs[]) >>
14410 qexists_tac `x DELETE n` >>
14411 `FINITE x` by metis_tac[SUBSET_FINITE, FINITE_COUNT] >>
14412 rw[] >- (rw[EQ_IMP_THM] >> simp[]) >>
14413 `x DELETE n SUBSET (count (n + 1)) DELETE n` by rw[SUBSET_DELETE_BOTH] >>
14414 `count (n + 1) DELETE n = count n` by rw[EXTENSION] >>
14415 fs[],
14416
14417 rename [‘s SUBSET count n’, ‘x SUBSET count (n + 1)’] >>
14418 `x = n INSERT s` by fs[EXTENSION] >>
14419 `x SUBSET (n INSERT count n)` by rw[SUBSET_INSERT_BOTH] >>
14420 rfs[count_add1],
14421
14422 rename [‘s SUBSET count n’, ‘CARD x = CARD s + 1’] >>
14423 `x = n INSERT s` by fs[EXTENSION] >>
14424 `n NOTIN s` by metis_tac[SUBSET_DEF, COUNT_NOT_SELF] >>
14425 `FINITE s` by metis_tac[SUBSET_FINITE, FINITE_COUNT] >>
14426 rw[],
14427
14428 metis_tac[COUNT_SUBSET, SUBSET_TRANS, DECIDE “n <= n + 1”]
14429 ]
14430QED
14431
14432(* Theorem: DISJOINT (IMAGE (\s. n INSERT s) (sub_count n k)) (sub_count n (k + 1)) *)
14433(* Proof:
14434 Let s = IMAGE (\s. n INSERT s) (sub_count n k),
14435 t = sub_count n (k + 1).
14436 By DISJOINT_DEF and contradiction, suppose s INTER t <> {}.
14437 Then ?x. x IN s /\ x IN t by IN_INTER, MEMBER_NOT_EMPTY
14438 Note n IN x by IN_IMAGE, IN_INSERT
14439 but n NOTIN x by sub_count_element_no_self
14440 This is a contradiction.
14441*)
14442Theorem sub_count_disjoint:
14443 !n k. DISJOINT (IMAGE (\s. n INSERT s) (sub_count n k)) (sub_count n (k + 1))
14444Proof
14445 rw[DISJOINT_DEF, EXTENSION] >>
14446 spose_not_then strip_assume_tac >>
14447 rename [‘s IN sub_count n k’, ‘x IN sub_count n (k + 1)’] >>
14448 `x = n INSERT s` by fs[EXTENSION] >>
14449 `n IN x` by fs[] >>
14450 metis_tac[sub_count_element_no_self]
14451QED
14452
14453(* Theorem: s IN sub_count n k ==> (n INSERT s) IN sub_count (n + 1) (k + 1) *)
14454(* Proof:
14455 Note s SUBSET count n /\ CARD s = k by sub_count_element
14456 and n NOTIN s by sub_count_element_no_self
14457 and FINITE s by sub_count_element_finite
14458 Now (n INSERT s) SUBSET (n INSERT count n)
14459 by SUBSET_INSERT_BOTH
14460 and n INSERT count n = count (n + 1) by count_add1
14461 and CARD (n INSERT s) = CARD s + 1 by CARD_INSERT
14462 = k + 1 by given
14463 Thus (n INSERT s) IN sub_count (n + 1) (k + 1)
14464 by sub_count_element
14465*)
14466Theorem sub_count_insert:
14467 !n k s. s IN sub_count n k ==> (n INSERT s) IN sub_count (n + 1) (k + 1)
14468Proof
14469 rw[sub_count_def] >| [
14470 `!x. x < n ==> x < n + 1` by decide_tac >>
14471 metis_tac[SUBSET_DEF, IN_COUNT],
14472 `n NOTIN s` by metis_tac[SUBSET_DEF, COUNT_NOT_SELF] >>
14473 `FINITE s` by metis_tac[SUBSET_FINITE, FINITE_COUNT] >>
14474 rw[]
14475 ]
14476QED
14477
14478(* Theorem: CARD (IMAGE (\s. n INSERT s) (sub_count n k)) = n choose k *)
14479(* Proof:
14480 Let f = \s. n INSERT s.
14481 By choose_def, INJ_CARD_IMAGE, this is to show:
14482 (1) FINITE (sub_count n k), true by sub_count_finite
14483 (2) ?t. INJ f (sub_count n k) t
14484 Let t = sub_count (n + 1) (k + 1).
14485 By INJ_DEF, this is to show:
14486 (1) s IN sub_count n k ==> n INSERT s IN sub_count (n + 1) (k + 1)
14487 This is true by sub_count_insert
14488 (2) s' IN sub_count n k /\ s IN sub_count n k /\
14489 n INSERT s' = n INSERT s ==> s' = s
14490 Note n NOTIN s by sub_count_element_no_self
14491 and n NOTIN s' by sub_count_element_no_self
14492 s'
14493 = s' DELETE n by DELETE_NON_ELEMENT
14494 = (n INSERT s') DELETE n by DELETE_INSERT
14495 = (n INSERT s) DELETE n by given
14496 = s DELETE n by DELETE_INSERT
14497 = s by DELETE_NON_ELEMENT
14498*)
14499Theorem sub_count_insert_card:
14500 !n k. CARD (IMAGE (\s. n INSERT s) (sub_count n k)) = n choose k
14501Proof
14502 rw[choose_def] >>
14503 qabbrev_tac `f = \s. n INSERT s` >>
14504 irule INJ_CARD_IMAGE >>
14505 rpt strip_tac >-
14506 rw[sub_count_finite] >>
14507 qexists_tac `sub_count (n + 1) (k + 1)` >>
14508 rw[INJ_DEF, Abbr`f`] >-
14509 rw[sub_count_insert] >>
14510 rename [‘n INSERT s1 = n INSERT s2’] >>
14511 `n NOTIN s1 /\ n NOTIN s2` by metis_tac[sub_count_element_no_self] >>
14512 metis_tac[DELETE_INSERT, DELETE_NON_ELEMENT]
14513QED
14514
14515(* Theorem: sub_count n 0 = { EMPTY } /\
14516 sub_count 0 (k + 1) = {} /\
14517 sub_count (n + 1) (k + 1) =
14518 IMAGE (\s. n INSERT s) (sub_count n k) UNION sub_count n (k + 1) *)
14519(* Proof: by sub_count_n_0, sub_count_0_n, sub_count_union. *)
14520Theorem sub_count_alt:
14521 !n k. sub_count n 0 = { EMPTY } /\
14522 sub_count 0 (k + 1) = {} /\
14523 sub_count (n + 1) (k + 1) =
14524 IMAGE (\s. n INSERT s) (sub_count n k) UNION sub_count n (k + 1)
14525Proof
14526 simp[sub_count_n_0, sub_count_0_n, sub_count_union]
14527QED
14528
14529(* Theorem: sub_count n k =
14530 if k = 0 then { EMPTY }
14531 else if n = 0 then {}
14532 else IMAGE (\s. (n - 1) INSERT s) (sub_count (n - 1) (k - 1)) UNION
14533 sub_count (n - 1) k *)
14534(* Proof: by sub_count_n_0, sub_count_0_n, sub_count_union. *)
14535Theorem sub_count_eqn[compute]:
14536 !n k. sub_count n k =
14537 if k = 0 then { EMPTY }
14538 else if n = 0 then {}
14539 else IMAGE (\s. (n - 1) INSERT s) (sub_count (n - 1) (k - 1)) UNION
14540 sub_count (n - 1) k
14541Proof
14542 rw[sub_count_n_0, sub_count_0_n] >>
14543 metis_tac[sub_count_union, num_CASES, SUC_SUB1, ADD1]
14544QED
14545
14546(*
14547> EVAL ``sub_count 3 2``;
14548val it = |- sub_count 3 2 = {{2; 1}; {2; 0}; {1; 0}}: thm
14549> EVAL ``sub_count 4 2``;
14550val it = |- sub_count 4 2 = {{3; 2}; {3; 1}; {3; 0}; {2; 1}; {2; 0}; {1; 0}}: thm
14551> EVAL ``sub_count 3 3``;
14552val it = |- sub_count 3 3 = {{2; 1; 0}}: thm
14553*)
14554
14555(* Theorem: n choose 0 = 1 *)
14556(* Proof:
14557 n choose 0
14558 = CARD (sub_count n 0) by choose_def
14559 = CARD {{}} by sub_count_n_0
14560 = 1 by CARD_SING
14561*)
14562Theorem choose_n_0:
14563 !n. n choose 0 = 1
14564Proof
14565 simp[choose_def, sub_count_n_0]
14566QED
14567
14568(* Theorem: n choose 1 = n *)
14569(* Proof:
14570 Let s = {{j} | j < n},
14571 f = \j. {j}.
14572 Then s = IMAGE f (count n) by EXTENSION
14573 Note FINITE (count n)
14574 and INJ f (count n) (POW (count n))
14575 Thus n choose 1
14576 = CARD (sub_count n 1) by choose_def
14577 = CARD s by sub_count_n_1
14578 = CARD (count n) by INJ_CARD_IMAGE
14579 = n by CARD_COUNT
14580*)
14581Theorem choose_n_1:
14582 !n. n choose 1 = n
14583Proof
14584 rw[choose_def, sub_count_n_1] >>
14585 qabbrev_tac `s = {{j} | j < n}` >>
14586 qabbrev_tac `f = \j:num. {j}` >>
14587 `s = IMAGE f (count n)` by fs[EXTENSION, Abbr`f`, Abbr`s`] >>
14588 `CARD (IMAGE f (count n)) = CARD (count n)` suffices_by fs[] >>
14589 irule INJ_CARD_IMAGE >>
14590 rw[] >>
14591 qexists_tac `POW (count n)` >>
14592 rw[INJ_DEF, Abbr`f`] >>
14593 rw[POW_DEF]
14594QED
14595
14596(* Theorem: n choose k = 0 <=> n < k *)
14597(* Proof:
14598 Note FINITE (sub_count n k) by sub_count_finite
14599 n choose k = 0
14600 <=> CARD (sub_count n k) = 0 by choose_def
14601 <=> sub_count n k = {} by CARD_EQ_0
14602 <=> n < k by sub_count_eq_empty
14603*)
14604Theorem choose_eq_0:
14605 !n k. n choose k = 0 <=> n < k
14606Proof
14607 metis_tac[choose_def, sub_count_eq_empty, sub_count_finite, CARD_EQ_0]
14608QED
14609
14610(* Theorem: 0 choose n = if n = 0 then 1 else 0 *)
14611(* Proof:
14612 0 choose n
14613 = CARD (sub_count 0 n) by choose_def
14614 = CARD (if n = 0 then {{}} else {})
14615 by sub_count_0_n
14616 = if n = 0 then 1 else 0 by CARD_SING, CARD_EMPTY
14617*)
14618Theorem choose_0_n:
14619 !n. 0 choose n = if n = 0 then 1 else 0
14620Proof
14621 rw[choose_def, sub_count_0_n]
14622QED
14623
14624(* Theorem: 1 choose n = if 1 < n then 0 else 1 *)
14625(* Proof:
14626 If n = 0, 1 choose 0 = 1 by choose_n_0
14627 If n = 1, 1 choose 1 = 1 by choose_n_1
14628 Otherwise, 1 choose n = 0 by choose_eq_0, 1 < n
14629*)
14630Theorem choose_1_n:
14631 !n. 1 choose n = if 1 < n then 0 else 1
14632Proof
14633 rw[choose_eq_0] >>
14634 `n = 0 \/ n = 1` by decide_tac >-
14635 simp[choose_n_0] >>
14636 simp[choose_n_1]
14637QED
14638
14639(* Theorem: n choose n = 1 *)
14640(* Proof:
14641 n choose n
14642 = CARD (sub_count n n) by choose_def
14643 = CARD {count n} by sub_count_n_n
14644 = 1 by CARD_SING
14645*)
14646Theorem choose_n_n:
14647 !n. n choose n = 1
14648Proof
14649 simp[choose_def, sub_count_n_n]
14650QED
14651
14652(* Theorem: (n + 1) choose (k + 1) = n choose k + n choose (k + 1) *)
14653(* Proof:
14654 Let s = sub_count (n + 1) (k + 1),
14655 u = sub_count n k,
14656 v = sub_count n (k + 1),
14657 t = IMAGE (\s. n INSERT s) u.
14658 Then s = t UNION v by sub_count_union
14659 and DISJOINT t v by sub_count_disjoint
14660 and FINITE u /\ FINITE v by sub_count_finite
14661 and FINITE t by IMAGE_FINITE
14662 Thus CARD s = CARD t + CARD v by CARD_UNION_DISJOINT
14663 = CARD u + CARD v by sub_count_insert_card, choose_def
14664*)
14665Theorem choose_recurrence:
14666 !n k. (n + 1) choose (k + 1) = n choose k + n choose (k + 1)
14667Proof
14668 rw[choose_def] >>
14669 qabbrev_tac `s = sub_count (n + 1) (k + 1)` >>
14670 qabbrev_tac `u = sub_count n k` >>
14671 qabbrev_tac `v = sub_count n (k + 1)` >>
14672 qabbrev_tac `t = IMAGE (\s. n INSERT s) u` >>
14673 `s = t UNION v` by rw[sub_count_union, Abbr`s`, Abbr`t`, Abbr`v`] >>
14674 `DISJOINT t v` by metis_tac[sub_count_disjoint] >>
14675 `FINITE u /\ FINITE v` by rw[sub_count_finite, Abbr`u`, Abbr`v`] >>
14676 `FINITE t` by rw[Abbr`t`] >>
14677 `CARD s = CARD t + CARD v` by rw[CARD_UNION_DISJOINT] >>
14678 metis_tac[sub_count_insert_card, choose_def]
14679QED
14680
14681(* This is Pascal's identity: C(n+1,k+1) = C(n,k) + C(n,k+1). *)
14682(* This corresponds to the 'sum of parents' rule of Pascal's triangle. *)
14683
14684(* Theorem: n choose 0 = 1 /\ 0 choose (k + 1) = 0 /\
14685 (n + 1) choose (k + 1) = n choose k + n choose (k + 1) *)
14686(* Proof: by choose_n_0, choose_0_n, choose_recurrence. *)
14687Theorem choose_alt:
14688 !n k. n choose 0 = 1 /\ 0 choose (k + 1) = 0 /\
14689 (n + 1) choose (k + 1) = n choose k + n choose (k + 1)
14690Proof
14691 simp[choose_n_0, choose_0_n, choose_recurrence]
14692QED
14693
14694(* Theorem: n choose k = binomial n k *)
14695(* Proof: by binomial_iff, choose_alt. *)
14696Theorem choose_eqn[compute]:
14697 !n k. n choose k = binomial n k
14698Proof
14699 prove_tac[binomial_iff, choose_alt]
14700QED
14701
14702(*
14703> EVAL ``5 choose 3``;
14704val it = |- 5 choose 3 = 10: thm
14705> EVAL ``MAP ($choose 5) [0 .. 5]``;
14706val it = |- MAP ($choose 5) [0 .. 5] = [1; 5; 10; 10; 5; 1]: thm
14707*)
14708
14709(* ------------------------------------------------------------------------- *)
14710(* Partition of the set of subsets by bijective equivalence. *)
14711(* ------------------------------------------------------------------------- *)
14712
14713(* Define the set of k-subsets of a set. *)
14714Definition sub_sets_def[nocompute]:
14715 sub_sets P k = { s | s SUBSET P /\ CARD s = k}
14716End
14717(* use [nocompute] as this is not effective for evalutaion. *)
14718
14719(* Theorem: s IN sub_sets P k <=> s SUBSET P /\ CARD s = k *)
14720(* Proof: by sub_sets_def. *)
14721Theorem sub_sets_element:
14722 !P k s. s IN sub_sets P k <=> s SUBSET P /\ CARD s = k
14723Proof
14724 simp[sub_sets_def]
14725QED
14726
14727(* Theorem: sub_sets (count n) k = sub_count n k *)
14728(* Proof:
14729 sub_sets (count n) k
14730 = {s | s SUBSET (count n) /\ CARD s = k} by sub_sets_def
14731 = sub_count n k by sub_count_def
14732*)
14733Theorem sub_sets_sub_count:
14734 !n k. sub_sets (count n) k = sub_count n k
14735Proof
14736 simp[sub_sets_def, sub_count_def]
14737QED
14738
14739(* Theorem: FINITE t /\ s SUBSET t ==>
14740 sub_sets t (CARD s) = equiv_class $=b= (POW t) s *)
14741(* Proof:
14742 x IN sub_sets t (CARD s)
14743 <=> x SUBSET t /\ CARD s = CARD x by sub_sets_element
14744 <=> x SUBSET t /\ s =b= x by bij_eq_card_eq, SUBSET_FINITE
14745 <=> x IN POW t /\ s =b= x by IN_POW
14746 <=> x IN equiv_class $=b= (POW t) s by equiv_class_element
14747*)
14748Theorem sub_sets_equiv_class:
14749 !s t. FINITE t /\ s SUBSET t ==>
14750 sub_sets t (CARD s) = equiv_class $=b= (POW t) s
14751Proof
14752 rw[sub_sets_def, IN_POW, EXTENSION] >>
14753 metis_tac[bij_eq_card_eq, SUBSET_FINITE]
14754QED
14755
14756(* Theorem: s SUBSET (count n) ==>
14757 sub_count n (CARD s) = equiv_class $=b= (POW (count n)) s *)
14758(* Proof:
14759 Note FINITE (count n) by FINITE_COUNT
14760 sub_count n (CARD s)
14761 = sub_sets (count n) (CARD s) by sub_sets_sub_count
14762 = equiv_class $=b= (POW t) s by sub_sets_equiv_class
14763*)
14764Theorem sub_count_equiv_class:
14765 !n s. s SUBSET (count n) ==>
14766 sub_count n (CARD s) = equiv_class $=b= (POW (count n)) s
14767Proof
14768 simp[sub_sets_equiv_class, GSYM sub_sets_sub_count]
14769QED
14770
14771(* Theorem: partition $=b= (POW (count n)) = IMAGE (sub_count n) (upto n) *)
14772(* Proof:
14773 Let R = $=b=, t = count n.
14774 Note CARD t = n by CARD_COUNT
14775 By EXTENSION and LESS_EQ_IFF_LESS_SUC, this is to show:
14776 (1) x IN partition R (POW t) ==> ?k. x = sub_count n k /\ k <= n
14777 Note ?s. s IN POW t /\
14778 x = equiv_class R (POW t) s by partition_element
14779 Note FINITE t by SUBSET_FINITE
14780 and s SUBSET t by IN_POW
14781 so CARD s <= CARD t = n by CARD_SUBSET
14782 Take k = CARD s.
14783 Then k <= n /\ x = sub_count n k by sub_count_equiv_class
14784 (2) k <= n ==> sub_count n k IN partition R (POW t)
14785 Let s = count k
14786 Then CARD s = k by CARD_COUNT
14787 and s SUBSET t by COUNT_SUBSET, k <= n
14788 so s IN POW t by IN_POW
14789 Now sub_count n k
14790 = equiv_class R (POW t) s by sub_count_equiv_class
14791 ==> sub_count n k IN partition R (POW t)
14792 by partition_element
14793*)
14794Theorem count_power_partition:
14795 !n. partition $=b= (POW (count n)) = IMAGE (sub_count n) (upto n)
14796Proof
14797 rpt strip_tac >>
14798 qabbrev_tac `R = \(s:num -> bool) (t:num -> bool). s =b= t` >>
14799 qabbrev_tac `t = count n` >>
14800 rw[Once EXTENSION, partition_element, GSYM LESS_EQ_IFF_LESS_SUC, EQ_IMP_THM] >| [
14801 `FINITE t` by rw[Abbr`t`] >>
14802 `x' SUBSET t` by fs[IN_POW] >>
14803 `CARD x' <= n` by metis_tac[CARD_SUBSET, CARD_COUNT] >>
14804 qexists_tac `CARD x'` >>
14805 simp[sub_count_equiv_class, Abbr`R`, Abbr`t`],
14806 qexists_tac `count x'` >>
14807 `(count x') SUBSET t /\ (count x') IN POW t` by metis_tac[COUNT_SUBSET, IN_POW] >>
14808 simp[] >>
14809 qabbrev_tac `s = count x'` >>
14810 `sub_count n (CARD s) = equiv_class R (POW t) s` suffices_by simp[Abbr`s`] >>
14811 simp[sub_count_equiv_class, Abbr`R`, Abbr`t`]
14812 ]
14813QED
14814
14815(* Theorem: INJ (sub_count n) (upto n) univ(:(num -> bool) -> bool) *)
14816(* Proof:
14817 By INJ_DEF, this is to show:
14818 !x y. x < SUC n /\ y < SUC n /\ sub_count n x = sub_count n y ==> x = y
14819 Let s = count x.
14820 Note x < SUC n <=> x <= n by arithmetic
14821 ==> s SUBSET (count n) by COUNT_SUBSET, x <= n
14822 and CARD s = x by CARD_COUNT
14823 so s IN sub_count n x by sub_count_element
14824 Thus s IN sub_count n y by given, sub_count n x = sub_count n y
14825 ==> CARD s = x = y
14826*)
14827Theorem sub_count_count_inj:
14828 !n m. INJ (sub_count n) (upto n) univ(:(num -> bool) -> bool)
14829Proof
14830 rw[sub_count_def, EXTENSION, INJ_DEF] >>
14831 `(count x) SUBSET (count n)` by rw[COUNT_SUBSET] >>
14832 metis_tac[CARD_COUNT]
14833QED
14834
14835(* Idea: the sum of sizes of equivalence classes gives size of power set. *)
14836
14837(* Theorem: SIGMA ($choose n) (upto n) = 2 ** n *)
14838(* Proof:
14839 Let R = $=b=, t = count n.
14840 Then R equiv_on (POW t) by bij_eq_equiv_on
14841 and FINITE t by FINITE_COUNT
14842 so FINITE (POW t) by FINITE_POW
14843 Thus CARD (POW t) = SIGMA CARD (partition R (POW t))
14844 by partition_CARD
14845 LHS = CARD (POW t)
14846 = 2 ** CARD t by CARD_POW
14847 = 2 ** n by CARD_COUNT
14848 Note INJ (sub_count n) (upto n) univ by sub_count_count_inj
14849 RHS = SIGMA CARD (partition R (POW t))
14850 = SIGMA CARD (IMAGE (sub_count n) (upto n)) by count_power_partition
14851 = SIGMA (CARD o sub_count n) (upto n) by SUM_IMAGE_INJ_o
14852 = SIGMA ($choose n) (upto n) by FUN_EQ_THM, choose_def
14853*)
14854Theorem choose_sum_over_count:
14855 !n. SIGMA ($choose n) (upto n) = 2 ** n
14856Proof
14857 rpt strip_tac >>
14858 qabbrev_tac `R = \(s:num -> bool) (t:num -> bool). s =b= t` >>
14859 qabbrev_tac `t = count n` >>
14860 `R equiv_on (POW t)` by rw[bij_eq_equiv_on, Abbr`R`] >>
14861 `FINITE (POW t)` by rw[FINITE_POW, Abbr`t`] >>
14862 imp_res_tac partition_CARD >>
14863 `FINITE (upto n)` by rw[] >>
14864 `SIGMA CARD (partition R (POW t)) = SIGMA CARD (IMAGE (sub_count n) (upto n))` by fs[count_power_partition, Abbr`R`, Abbr`t`] >>
14865 `_ = SIGMA (CARD o (sub_count n)) (upto n)` by rw[SUM_IMAGE_INJ_o, sub_count_count_inj] >>
14866 `_ = SIGMA ($choose n) (upto n)` by rw[choose_def, FUN_EQ_THM, SIGMA_CONG] >>
14867 fs[CARD_POW, Abbr`t`]
14868QED
14869
14870(* This corresponds to:
14871> binomial_sum;
14872val it = |- !n. SUM (GENLIST (binomial n) (SUC n)) = 2 ** n: thm
14873*)
14874
14875(* Theorem: SUM (MAP ($choose n) [0 .. n]) = 2 ** n *)
14876(* Proof:
14877 SUM (MAP ($choose n) [0 .. n])
14878 = SIGMA ($choose n) (upto n) by SUM_IMAGE_upto
14879 = 2 ** n by choose_sum_over_count
14880*)
14881Theorem choose_sum_over_all:
14882 !n. SUM (MAP ($choose n) [0 .. n]) = 2 ** n
14883Proof
14884 simp[GSYM SUM_IMAGE_upto, choose_sum_over_count]
14885QED
14886
14887(* A better representation of:
14888> binomial_sum;
14889val it = |- !n. SUM (GENLIST (binomial n) (SUC n)) = 2 ** n: thm
14890*)
14891
14892(* ------------------------------------------------------------------------- *)
14893(* Counting number of permutations. *)
14894(* ------------------------------------------------------------------------- *)
14895
14896(* Define the set of permutation tuples of (count n). *)
14897Definition perm_count_def[nocompute]:
14898 perm_count n = { ls | ALL_DISTINCT ls /\ set ls = count n}
14899End
14900(* use [nocompute] as this is not effective for evalutaion. *)
14901
14902(* Define the number of choices of k-tuples of (count n). *)
14903Definition perm_def[nocompute]:
14904 perm n = CARD (perm_count n)
14905End
14906(* use [nocompute] as this is not effective for evalutaion. *)
14907
14908(* Theorem: ls IN perm_count n <=> ALL_DISTINCT ls /\ set ls = count n *)
14909(* Proof: by perm_count_def. *)
14910Theorem perm_count_element:
14911 !ls n. ls IN perm_count n <=> ALL_DISTINCT ls /\ set ls = count n
14912Proof
14913 simp[perm_count_def]
14914QED
14915
14916(* Theorem: ls IN perm_count n ==> ~MEM n ls *)
14917(* Proof:
14918 ls IN perm_count n
14919 <=> ALL_DISTINCT ls /\ set ls = count n by perm_count_element
14920 ==> ~MEM n ls by COUNT_NOT_SELF
14921*)
14922Theorem perm_count_element_no_self:
14923 !ls n. ls IN perm_count n ==> ~MEM n ls
14924Proof
14925 simp[perm_count_element]
14926QED
14927
14928(* Theorem: ls IN perm_count n ==> LENGTH ls = n *)
14929(* Proof:
14930 ls IN perm_count n
14931 <=> ALL_DISTINCT ls /\ set ls = count n by perm_count_element
14932 LENGTH ls = CARD (set ls) by ALL_DISTINCT_CARD_LIST_TO_SET
14933 = CARD (count n) by set ls = count n
14934 = n by CARD_COUNT
14935*)
14936Theorem perm_count_element_length:
14937 !ls n. ls IN perm_count n ==> LENGTH ls = n
14938Proof
14939 metis_tac[perm_count_element, ALL_DISTINCT_CARD_LIST_TO_SET, CARD_COUNT]
14940QED
14941
14942(* Theorem: perm_count n SUBSET necklace n n *)
14943(* Proof:
14944 ls IN perm_count n
14945 <=> ALL_DISTINCT ls /\ set ls = count n by perm_count_element
14946 Thus set ls SUBSET (count n) by SUBSET_REFL
14947 and LENGTH ls = n by perm_count_element_length
14948 Therefore ls IN necklace n n by necklace_element
14949*)
14950Theorem perm_count_subset:
14951 !n. perm_count n SUBSET necklace n n
14952Proof
14953 rw[perm_count_def, necklace_def, perm_count_element_length, SUBSET_DEF]
14954QED
14955
14956(* Theorem: FINITE (perm_count n) *)
14957(* Proof:
14958 Note perm_count n SUBSET necklace n n by perm_count_subset
14959 and FINITE (necklace n n) by necklace_finite
14960 Thus FINITE (perm_count n) by SUBSET_FINITE
14961*)
14962Theorem perm_count_finite:
14963 !n. FINITE (perm_count n)
14964Proof
14965 metis_tac[perm_count_subset, necklace_finite, SUBSET_FINITE]
14966QED
14967
14968(* Theorem: perm_count 0 = {[]} *)
14969(* Proof:
14970 ls IN perm_count 0
14971 <=> ALL_DISTINCT ls /\ set ls = count 0 by perm_count_element
14972 <=> ALL_DISTINCT ls /\ set ls = {} by COUNT_0
14973 <=> ALL_DISTINCT ls /\ ls = [] by LIST_TO_SET_EQ_EMPTY
14974 <=> ls = [] by ALL_DISTINCT
14975 Thus perm_count 0 = {[]} by EXTENSION
14976*)
14977Theorem perm_count_0:
14978 perm_count 0 = {[]}
14979Proof
14980 rw[perm_count_def, EXTENSION, EQ_IMP_THM] >>
14981 metis_tac[MEM, list_CASES]
14982QED
14983
14984(* Theorem: perm_count 1 = {[0]} *)
14985(* Proof:
14986 ls IN perm_count 1
14987 <=> ALL_DISTINCT ls /\ set ls = count 1 by perm_count_element
14988 <=> ALL_DISTINCT ls /\ set ls = {0} by COUNT_1
14989 <=> ls = [0] by DISTINCT_LIST_TO_SET_EQ_SING
14990 Thus perm_count 1 = {[0]} by EXTENSION
14991*)
14992Theorem perm_count_1:
14993 perm_count 1 = {[0]}
14994Proof
14995 simp[perm_count_def, COUNT_1, DISTINCT_LIST_TO_SET_EQ_SING]
14996QED
14997
14998(* Define the interleave operation on a list. *)
14999Definition interleave_def:
15000 interleave x ls = IMAGE (\k. TAKE k ls ++ x::DROP k ls) (upto (LENGTH ls))
15001End
15002(* make this an infix operator *)
15003val _ = set_fixity "interleave" (Infix(NONASSOC, 550)); (* higher than arithmetic op 500. *)
15004(* interleave_def;
15005val it = |- !x ls. x interleave ls =
15006 IMAGE (\k. TAKE k ls ++ x::DROP k ls) (upto (LENGTH ls)): thm *)
15007
15008(*
15009> EVAL ``2 interleave [0; 1]``;
15010val it = |- 2 interleave [0; 1] = {[0; 1; 2]; [0; 2; 1]; [2; 0; 1]}: thm
15011*)
15012
15013(* Theorem: x interleave ls = {TAKE k ls ++ x::DROP k ls | k | k <= LENGTH ls} *)
15014(* Proof: by interleave_def, EXTENSION. *)
15015Theorem interleave_alt:
15016 !ls x. x interleave ls = {TAKE k ls ++ x::DROP k ls | k | k <= LENGTH ls}
15017Proof
15018 simp[interleave_def, EXTENSION] >>
15019 metis_tac[LESS_EQ_IFF_LESS_SUC]
15020QED
15021
15022(* Theorem: y IN x interleave ls <=>
15023 ?k. k <= LENGTH ls /\ y = TAKE k ls ++ x::DROP k ls *)
15024(* Proof: by interleave_alt, IN_IMAGE. *)
15025Theorem interleave_element:
15026 !ls x y. y IN x interleave ls <=>
15027 ?k. k <= LENGTH ls /\ y = TAKE k ls ++ x::DROP k ls
15028Proof
15029 simp[interleave_alt] >>
15030 metis_tac[]
15031QED
15032
15033(* Theorem: x interleave [] = {[x]} *)
15034(* Proof:
15035 x interleave []
15036 = IMAGE (\k. TAKE k [] ++ x::DROP k []) (upto (LENGTH []))
15037 by interleave_def
15038 = IMAGE (\k. [] ++ x::[]) (upto 0) by TAKE_nil, DROP_nil, LENGTH
15039 = IMAGE (\k. [x]) (count 1) by APPEND, notation of upto
15040 = IMAGE (\k. [x]) {0} by COUNT_1
15041 = [x] by IMAGE_DEF
15042*)
15043Theorem interleave_nil:
15044 !x. x interleave [] = {[x]}
15045Proof
15046 rw[interleave_def, EXTENSION] >>
15047 metis_tac[DECIDE``0 < 1``]
15048QED
15049
15050(* Theorem: y IN (x interleave ls) ==> LENGTH y = 1 + LENGTH ls *)
15051(* Proof:
15052 LENGTH y
15053 = LENGTH (TAKE k ls ++ x::DROP k ls) by interleave_element, for some k
15054 = LENGTH (TAKE k ls) + LENGTH (x::DROP k ls) by LENGTH_APPEND
15055 = k + LENGTH (x :: DROP k ls) by LENGTH_TAKE, k <= LENGTH ls
15056 = k + (1 + LENGTH (DROP k ls)) by LENGTH
15057 = k + (1 + (LENGTH ls - k)) by LENGTH_DROP
15058 = 1 + LENGTH ls by arithmetic, k <= LENGTH ls
15059*)
15060Theorem interleave_length:
15061 !ls x y. y IN (x interleave ls) ==> LENGTH y = 1 + LENGTH ls
15062Proof
15063 rw_tac bool_ss[interleave_element] >>
15064 simp[]
15065QED
15066
15067(* Theorem: ALL_DISTINCT (x::ls) /\ y IN (x interleave ls) ==> ALL_DISTINCT y *)
15068(* Proof:
15069 By interleave_def, IN_IMAGE, this is to show;
15070 ALL_DISTINCT (TAKE k ls ++ x::DROP k ls)
15071 To apply ALL_DISTINCT_APPEND, need to show:
15072 (1) ~MEM x ls /\ MEM e (TAKE k ls) /\ MEM e (x::DROP k ls) ==> F
15073 MEM e (x::DROP k ls)
15074 <=> e = x \/ MEM e (DROP k ls) by MEM
15075 MEM e (TAKE k ls)
15076 ==> MEM e ls by MEM_TAKE
15077 If e = x,
15078 this contradicts ~MEM x ls.
15079 If MEM e (DROP k ls),
15080 with MEM e (TAKE k ls)
15081 and ALL_DISTINCT ls gives F by ALL_DISTINCT_TAKE_DROP
15082 (2) ALL_DISTINCT (TAKE k ls), true by ALL_DISTINCT_TAKE
15083 (3) ~MEM x ls ==> ALL_DISTINCT (x::DROP k ls)
15084 ALL_DISTINCT (x::DROP k ls)
15085 <=> ~MEM x (DROP k ls) /\
15086 ALL_DISTINCT (DROP k ls) by ALL_DISTINCT
15087 <=> ~MEM x (DROP k ls) /\ T by ALL_DISTINCT_DROP
15088 ==> ~MEM x ls /\ T by MEM_DROP_IMP
15089 ==> T /\ T = T
15090*)
15091Theorem interleave_distinct:
15092 !ls x y. ALL_DISTINCT (x::ls) /\ y IN (x interleave ls) ==> ALL_DISTINCT y
15093Proof
15094 rw_tac bool_ss[interleave_def, IN_IMAGE] >>
15095 irule (ALL_DISTINCT_APPEND |> SPEC_ALL |> #2 o EQ_IMP_RULE) >>
15096 rpt strip_tac >| [
15097 fs[] >-
15098 metis_tac[MEM_TAKE] >>
15099 metis_tac[ALL_DISTINCT_TAKE_DROP],
15100 fs[ALL_DISTINCT_TAKE],
15101 fs[ALL_DISTINCT_DROP] >>
15102 metis_tac[MEM_DROP_IMP]
15103 ]
15104QED
15105
15106(* Theorem: ALL_DISTINCT ls /\ ~(MEM x ls) /\
15107 y IN (x interleave ls) ==> ALL_DISTINCT y *)
15108(* Proof: by interleave_distinct, ALL_DISTINCT. *)
15109Theorem interleave_distinct_alt:
15110 !ls x y. ALL_DISTINCT ls /\ ~(MEM x ls) /\
15111 y IN (x interleave ls) ==> ALL_DISTINCT y
15112Proof
15113 metis_tac[interleave_distinct, ALL_DISTINCT]
15114QED
15115
15116(* Theorem: y IN x interleave ls ==> set y = set (x::ls) *)
15117(* Proof:
15118 Note y = TAKE k ls ++ x::DROP k ls by interleave_element, for some k
15119 Let u = TAKE k ls, v = DROP k ls.
15120 set y
15121 = set (u ++ x::v) by above
15122 = set u UNION set (x::v) by LIST_TO_SET_APPEND
15123 = set u UNION (x INSERT set v) by LIST_TO_SET
15124 = (x INSERT set v) UNION set u by UNION_COMM
15125 = x INSERT (set v UNION set u) by INSERT_UNION_EQ
15126 = x INSERT (set u UNION set v) by UNION_COMM
15127 = x INSERT (set (u ++ v)) by LIST_TO_SET_APPEND
15128 = x INSERT set ls by TAKE_DROP
15129 = set (x::ls) by LIST_TO_SET
15130*)
15131Theorem interleave_set:
15132 !ls x y. y IN x interleave ls ==> set y = set (x::ls)
15133Proof
15134 rw_tac bool_ss[interleave_element] >>
15135 qabbrev_tac `u = TAKE k ls` >>
15136 qabbrev_tac `v = DROP k ls` >>
15137 `set (u ++ x::v) = set u UNION set (x::v)` by rw[] >>
15138 `_ = set u UNION (x INSERT set v)` by rw[] >>
15139 `_ = (x INSERT set v) UNION set u` by rw[UNION_COMM] >>
15140 `_ = x INSERT (set v UNION set u)` by rw[INSERT_UNION_EQ] >>
15141 `_ = x INSERT (set u UNION set v)` by rw[UNION_COMM] >>
15142 `_ = x INSERT (set (u ++ v))` by rw[] >>
15143 `_ = x INSERT set ls` by metis_tac[TAKE_DROP] >>
15144 simp[]
15145QED
15146
15147(* Theorem: y IN x interleave ls ==> set y = x INSERT set ls *)
15148(* Proof:
15149 Note set y = set (x::ls) by interleave_set
15150 = x INSERT set ls by LIST_TO_SET
15151*)
15152Theorem interleave_set_alt:
15153 !ls x y. y IN x interleave ls ==> set y = x INSERT set ls
15154Proof
15155 metis_tac[interleave_set, LIST_TO_SET]
15156QED
15157
15158(* Theorem: (x::ls) IN x interleave ls *)
15159(* Proof:
15160 (x::ls) IN x interleave ls
15161 <=> ?k. x::ls = TAKE k ls ++ [x] ++ DROP k ls /\ k < SUC (LENGTH ls)
15162 by interleave_def
15163 Take k = 0.
15164 Then 0 < SUC (LENGTH ls) by SUC_POS
15165 and TAKE 0 ls ++ [x] ++ DROP 0 ls
15166 = [] ++ [x] ++ ls by TAKE_0, DROP_0
15167 = x::ls by APPEND
15168*)
15169Theorem interleave_has_cons:
15170 !ls x. (x::ls) IN x interleave ls
15171Proof
15172 rw[interleave_def] >>
15173 qexists_tac `0` >>
15174 simp[]
15175QED
15176
15177(* Theorem: x interleave ls <> EMPTY *)
15178(* Proof:
15179 Note (x::ls) IN x interleave ls by interleave_has_cons
15180 Thus x interleave ls <> {} by MEMBER_NOT_EMPTY
15181*)
15182Theorem interleave_not_empty:
15183 !ls x. x interleave ls <> EMPTY
15184Proof
15185 metis_tac[interleave_has_cons, MEMBER_NOT_EMPTY]
15186QED
15187
15188(*
15189MEM_APPEND_lemma
15190|- !a b c d x. a ++ [x] ++ b = c ++ [x] ++ d /\ ~MEM x b /\ ~MEM x a ==>
15191 a = c /\ b = d
15192*)
15193
15194(* Theorem: ~MEM n x /\ ~MEM n y ==> (n interleave x = n interleave y <=> x = y) *)
15195(* Proof:
15196 Let f = (\k. TAKE k x ++ n::DROP k x),
15197 g = (\k. TAKE k y ++ n::DROP k y).
15198 By interleave_def, this is to show:
15199 IMAGE f (upto (LENGTH x)) = IMAGE g (upto (LENGTH y)) <=> x = y
15200 Only-part part is trivial.
15201 For the if part,
15202 Note 0 IN (upto (LENGTH x) by SUC_POS, IN_COUNT
15203 so f 0 IN IMAGE f (upto (LENGTH x))
15204 thus ?k. k < SUC (LENGTH y) /\ f 0 = g k by IN_IMAGE, IN_COUNT
15205 so n::x = TAKE k y ++ [n] ++ DROP k y by notation of f 0
15206 but n::x = TAKE 0 x ++ [n] ++ DROP 0 x by TAKE_0, DROP_0
15207 and ~MEM n (TAKE 0 x) /\ ~MEM n (DROP 0 x) by TAKE_0, DROP_0
15208 so TAKE 0 x = TAKE k y /\
15209 DROP 0 x = DROP k y by MEM_APPEND_lemma
15210 or x = y by TAKE_DROP
15211*)
15212Theorem interleave_eq:
15213 !n x y. ~MEM n x /\ ~MEM n y ==> (n interleave x = n interleave y <=> x = y)
15214Proof
15215 rw[interleave_def, EQ_IMP_THM] >>
15216 qabbrev_tac `f = \k. TAKE k x ++ n::DROP k x` >>
15217 qabbrev_tac `g = \k. TAKE k y ++ n::DROP k y` >>
15218 `f 0 IN IMAGE f (upto (LENGTH x))` by fs[] >>
15219 `?k. k < SUC (LENGTH y) /\ f 0 = g k` by metis_tac[IN_IMAGE, IN_COUNT] >>
15220 fs[Abbr`f`, Abbr`g`] >>
15221 `n::x = TAKE 0 x ++ [n] ++ DROP 0 x` by rw[] >>
15222 `~MEM n (TAKE 0 x) /\ ~MEM n (DROP 0 x)` by rw[] >>
15223 metis_tac[MEM_APPEND_lemma, TAKE_DROP]
15224QED
15225
15226(* Theorem: ~MEM x l1 /\ l1 <> l2 ==> DISJOINT (x interleave l1) (x interleave l2) *)
15227(* Proof:
15228 Use DISJOINT_DEF, by contradiction, suppose y is in both.
15229 Then ?k h. k <= LENGTH l1 and h <= LENGTH l2
15230 with y = TAKE k l1 ++ [x] ++ DROP k l1 by interleave_element
15231 and y = TAKE h l2 ++ [x] ++ DROP h l2 by interleave_element
15232 Now ~MEM x (TAKE k l1) by MEM_TAKE
15233 and ~MEM x (DROP k l1) by MEM_DROP_IMP
15234 Thus TAKE k l1 = TAKE h l2 /\
15235 DROP k l1 = DROP h l2 by MEM_APPEND_lemma
15236 or l1 = l2 by TAKE_DROP
15237 but this contradicts l1 <> l2.
15238*)
15239Theorem interleave_disjoint:
15240 !l1 l2 x. ~MEM x l1 /\ l1 <> l2 ==> DISJOINT (x interleave l1) (x interleave l2)
15241Proof
15242 rw[interleave_def, DISJOINT_DEF, EXTENSION] >>
15243 spose_not_then strip_assume_tac >>
15244 `~MEM x (TAKE k l1) /\ ~MEM x (DROP k l1)` by metis_tac[MEM_TAKE, MEM_DROP_IMP] >>
15245 metis_tac[MEM_APPEND_lemma, TAKE_DROP]
15246QED
15247
15248(* Theorem: FINITE (x interleave ls) *)
15249(* Proof:
15250 Let f = (\k. TAKE k ls ++ x::DROP k ls),
15251 n = LENGTH ls.
15252 FINITE (x interleave ls)
15253 <=> FINITE (IMAGE f (upto n)) by interleave_def
15254 <=> T by IMAGE_FINITE, FINITE_COUNT
15255*)
15256Theorem interleave_finite:
15257 !ls x. FINITE (x interleave ls)
15258Proof
15259 simp[interleave_def, IMAGE_FINITE]
15260QED
15261
15262(* Theorem: ~MEM x ls ==>
15263 INJ (\k. TAKE k ls ++ x::DROP k ls) (upto (LENGTH ls)) univ(:'a list) *)
15264(* Proof:
15265 Let n = LENGTH ls,
15266 s = upto n,
15267 f = (\k. TAKE k ls ++ x::DROP k ls).
15268 By INJ_DEF, this is to show:
15269 (1) k IN s ==> f k IN univ(:'a list), true by types.
15270 (2) k IN s /\ h IN s /\ f k = f h ==> k = h.
15271 Note k <= LENGTH ls by IN_COUNT, k IN s
15272 and h <= LENGTH ls by IN_COUNT, h IN s
15273 and ls = TAKE k ls ++ DROP k ls by TAKE_DROP
15274 so ~MEM x (TAKE k ls) /\
15275 ~MEM x (DROP k ls) by MEM_APPEND, ~MEM x ls
15276 Thus TAKE k ls = TAKE h ls by MEM_APPEND_lemma
15277 ==> k = h by LENGTH_TAKE
15278
15279MEM_APPEND_lemma
15280|- !a b c d x. a ++ [x] ++ b = c ++ [x] ++ d /\
15281 ~MEM x b /\ ~MEM x a ==> a = c /\ b = d
15282*)
15283Theorem interleave_count_inj:
15284 !ls x. ~MEM x ls ==>
15285 INJ (\k. TAKE k ls ++ x::DROP k ls) (upto (LENGTH ls)) univ(:'a list)
15286Proof
15287 rw[INJ_DEF] >>
15288 `k <= LENGTH ls /\ k' <= LENGTH ls` by fs[] >>
15289 `~MEM x (TAKE k ls) /\ ~MEM x (DROP k ls)` by metis_tac[TAKE_DROP, MEM_APPEND] >>
15290 metis_tac[MEM_APPEND_lemma, LENGTH_TAKE]
15291QED
15292
15293(* Theorem: ~MEM x ls ==> CARD (x interleave ls) = 1 + LENGTH ls *)
15294(* Proof:
15295 Let f = (\k. TAKE k ls ++ x::DROP k ls),
15296 n = LENGTH ls.
15297 Note FINITE (upto n) by FINITE_COUNT
15298 and INJ f (upto n) univ(:'a list)
15299 by interleave_count_inj, ~MEM x ls
15300 CARD (x interleave ls)
15301 = CARD (IMAGE f (upto n)) by interleave_def
15302 = CARD (upto n) by INJ_CARD_IMAGE
15303 = SUC n = 1 + n by CARD_COUNT, ADD1
15304*)
15305Theorem interleave_card:
15306 !ls x. ~MEM x ls ==> CARD (x interleave ls) = 1 + LENGTH ls
15307Proof
15308 rw[interleave_def] >>
15309 imp_res_tac interleave_count_inj >>
15310 qabbrev_tac `n = LENGTH ls` >>
15311 qabbrev_tac `s = upto n` >>
15312 qabbrev_tac `f = (\k. TAKE k ls ++ x::DROP k ls)` >>
15313 `FINITE s` by rw[Abbr`s`] >>
15314 metis_tac[INJ_CARD_IMAGE, CARD_COUNT, ADD1]
15315QED
15316
15317(* Note:
15318 interleave_distinct, interleave_length, and interleave_set
15319 are effects after interleave. Now we need a kind of inverse:
15320 deduce the effects before interleave.
15321*)
15322
15323(* Idea: a member h in a distinct list is the interleave of h with a smaller one. *)
15324
15325(* Theorem: ALL_DISTINCT ls /\ h IN set ls ==>
15326 ?t. ALL_DISTINCT t /\ ls IN h interleave t /\ set t = (set ls) DELETE h *)
15327(* Proof:
15328 By induction on ls.
15329 Base: ALL_DISTINCT [] /\ MEM h [] ==> ?t. ...
15330 Since MEM h [] = F, this is true by MEM
15331 Step: (ALL_DISTINCT ls /\ MEM h ls ==>
15332 ?t. ALL_DISTINCT t /\ ls IN h interleave t /\ set t = set ls DELETE h) ==>
15333 !h'. ALL_DISTINCT (h'::ls) /\ MEM h (h'::ls) ==>
15334 ?t. ALL_DISTINCT t /\ h'::ls IN h interleave t /\ set t = set (h'::ls) DELETE h
15335 If h' = h,
15336 Note ~MEM h ls /\ ALL_DISTINCT ls by ALL_DISTINCT
15337 Take this ls,
15338 Then set (h::ls) DELETE h
15339 = (h INSERT set ls) DELETE h by LIST_TO_SET
15340 = set ls by INSERT_DELETE_NON_ELEMENT
15341 and h::ls IN h interleave ls by interleave_element, take k = 0.
15342 If h' <> h,
15343 Note ~MEM h' ls /\ ALL_DISTINCT ls by ALL_DISTINCT
15344 and MEM h ls by MEM, h <> h'
15345 Thus ?t. ALL_DISTINCT t /\
15346 ls IN h interleave t /\
15347 set t = set ls DELETE h by induction hypothesis
15348 Note ~MEM h' t by set t = set ls DELETE h, ~MEM h' ls
15349 Take this (h'::t),
15350 Then ALL_DISTINCT (h'::t) by ALL_DISTINCT, ~MEM h' t
15351 and set (h'::ls) DELETE h
15352 = (h' INSERT set ls) DELETE h by LIST_TO_SET
15353 = h' INSERT (set ls DELETE h) by DELETE_INSERT, h' <> h
15354 = h' INSERT set t by above
15355 = set (h'::t)
15356 and h'::ls IN h interleave t by interleave_element,
15357 take k = SUC k from ls IN h interleave t
15358*)
15359Theorem interleave_revert:
15360 !ls h. ALL_DISTINCT ls /\ h IN set ls ==>
15361 ?t. ALL_DISTINCT t /\ ls IN h interleave t /\ set t = (set ls) DELETE h
15362Proof
15363 rpt strip_tac >>
15364 Induct_on `ls` >-
15365 simp[] >>
15366 rpt strip_tac >>
15367 Cases_on `h' = h` >| [
15368 fs[] >>
15369 qexists_tac `ls` >>
15370 simp[INSERT_DELETE_NON_ELEMENT] >>
15371 simp[interleave_element] >>
15372 qexists_tac `0` >>
15373 simp[],
15374 fs[] >>
15375 `~MEM h' t` by fs[] >>
15376 qexists_tac `h'::t` >>
15377 simp[DELETE_INSERT] >>
15378 fs[interleave_element] >>
15379 qexists_tac `SUC k` >>
15380 simp[]
15381 ]
15382QED
15383
15384(* A useful corollary for set s = count n. *)
15385
15386(* Theorem: ALL_DISTINCT ls /\ set ls = upto n ==>
15387 ?t. ALL_DISTINCT t /\ ls IN n interleave t /\ set t = count n *)
15388(* Proof:
15389 Note MEM n ls by set ls = upto n
15390 so ?t. ALL_DISTINCT t /\
15391 ls IN n interleave t /\
15392 set t = set ls DELETE n by interleave_revert
15393 = (upto n) DELETE n by given
15394 = count n by upto_delete
15395*)
15396Theorem interleave_revert_count:
15397 !ls n. ALL_DISTINCT ls /\ set ls = upto n ==>
15398 ?t. ALL_DISTINCT t /\ ls IN n interleave t /\ set t = count n
15399Proof
15400 rpt strip_tac >>
15401 `MEM n ls` by fs[] >>
15402 drule_then strip_assume_tac interleave_revert >>
15403 first_x_assum (qspec_then `n` strip_assume_tac) >>
15404 metis_tac[upto_delete]
15405QED
15406
15407(* Theorem: perm_count (SUC n) =
15408 BIGUNION (IMAGE ($interleave n) (perm_count n)) *)
15409(* Proof:
15410 By induction on n.
15411 Base: perm_count (SUC 0) =
15412 BIGUNION (IMAGE ($interleave 0) (perm_count 0))
15413 LHS = perm_count (SUC 0)
15414 = perm_count 1 by ONE
15415 = {[0]} by perm_count_1
15416 RHS = BIGUNION (IMAGE ($interleave 0) (perm_count 0))
15417 = BIGUNION (IMAGE ($interleave 0) {[]} by perm_count_0
15418 = BIGUNION {0 interleave []} by IMAGE_SING
15419 = BIGUNION {{[0]}} by interleave_nil
15420 = {[0]} = LHS by BIGUNION_SING
15421 Step: perm_count (SUC n) = BIGUNION (IMAGE ($interleave n) (perm_count n)) ==>
15422 perm_count (SUC (SUC n)) =
15423 BIGUNION (IMAGE ($interleave (SUC n)) (perm_count (SUC n)))
15424 Let f = $interleave (SUC n),
15425 s = perm_count n, t = perm_count (SUC n).
15426 y IN BIGUNION (IMAGE f t)
15427 <=> ?x. x IN t /\ y IN f x by IN_BIGUNION_IMAGE
15428 <=> ?x. (?z. z IN s /\ x IN n interleave z) /\ y IN (SUC n) interleave x
15429 by IN_BIGUNION_IMAGE, induction hypothesis
15430 <=> ?x z. ALL_DISTINCT z /\ set z = count n /\
15431 x IN n interleave z /\
15432 y IN (SUC n) interleave x by perm_count_element
15433 If part: y IN perm_count (SUC (SUC n)) ==> ?x and z.
15434 Note ALL_DISTINCT y /\
15435 set y = count (SUC (SUC n)) by perm_count_element
15436 Then ?x. ALL_DISTINCT x /\ y IN (SUC n) interleave x /\ set x = upto n
15437 by interleave_revert_count
15438 so ?z. ALL_DISTINCT z /\ x IN n interleave z /\ set z = count n
15439 by interleave_revert_count
15440 Take these x and z.
15441 Only-if part: ?x and z ==> y IN perm_count (SUC (SUC n))
15442 Note ~MEM n z by set z = count n, COUNT_NOT_SELF
15443 ==> ALL_DISTINCT x /\ by interleave_distinct_alt
15444 set x = upto n by interleave_set_alt, COUNT_SUC
15445 Note ~MEM (SUC n) x by set x = upto n, COUNT_NOT_SELF
15446 ==> ALL_DISTINCT y /\ by interleave_distinct_alt
15447 set y = count (SUC (SUC n)) by interleave_set_alt, COUNT_SUC
15448 ==> y IN perm_count (SUC (SUC n)) by perm_count_element
15449*)
15450Theorem perm_count_suc:
15451 !n. perm_count (SUC n) =
15452 BIGUNION (IMAGE ($interleave n) (perm_count n))
15453Proof
15454 Induct >| [
15455 rw[perm_count_0, perm_count_1] >>
15456 simp[interleave_nil],
15457 rw[IN_BIGUNION_IMAGE, EXTENSION, EQ_IMP_THM] >| [
15458 imp_res_tac perm_count_element >>
15459 `?y. ALL_DISTINCT y /\ x IN (SUC n) interleave y /\ set y = upto n` by rw[interleave_revert_count] >>
15460 `?t. ALL_DISTINCT t /\ y IN n interleave t /\ set t = count n` by rw[interleave_revert_count] >>
15461 (qexists_tac `y` >> simp[]) >>
15462 (qexists_tac `t` >> simp[]) >>
15463 simp[perm_count_element],
15464 fs[perm_count_element] >>
15465 `~MEM n x''` by fs[] >>
15466 `ALL_DISTINCT x' /\ set x' = upto n` by metis_tac[interleave_distinct_alt, interleave_set_alt, COUNT_SUC] >>
15467 `~MEM (SUC n) x'` by fs[] >>
15468 metis_tac[interleave_distinct_alt, interleave_set_alt, COUNT_SUC]
15469 ]
15470 ]
15471QED
15472
15473(* Theorem: perm_count (n + 1) =
15474 BIGUNION (IMAGE ($interleave n) (perm_count n)) *)
15475(* Proof: by perm_count_suc, GSYM ADD1. *)
15476Theorem perm_count_suc_alt:
15477 !n. perm_count (n + 1) =
15478 BIGUNION (IMAGE ($interleave n) (perm_count n))
15479Proof
15480 simp[perm_count_suc, GSYM ADD1]
15481QED
15482
15483(* Theorem: perm_count n =
15484 if n = 0 then {[]}
15485 else BIGUNION (IMAGE ($interleave (n - 1)) (perm_count (n - 1))) *)
15486(* Proof: by perm_count_0, perm_count_suc. *)
15487Theorem perm_count_eqn[compute]:
15488 !n. perm_count n =
15489 if n = 0 then {[]}
15490 else BIGUNION (IMAGE ($interleave (n - 1)) (perm_count (n - 1)))
15491Proof
15492 rw[perm_count_0] >>
15493 metis_tac[perm_count_suc, num_CASES, SUC_SUB1]
15494QED
15495
15496(*
15497> EVAL ``perm_count 3``;
15498val it = |- perm_count 3 =
15499{[0; 1; 2]; [0; 2; 1]; [2; 0; 1]; [1; 0; 2]; [1; 2; 0]; [2; 1; 0]}: thm
15500*)
15501
15502(* Historical note.
15503This use of interleave to list all permutations is called
15504the Steinhaus-Johnson-Trotter algorithm, due to re-discovery by various people.
15505Outside mathematics, this method was known already to 17th-century English change ringers.
15506Equivalently, this algorithm finds a Hamiltonian cycle in the permutohedron.
15507
15508Steinhaus-Johnson-Trotter algorithm
15509https://en.wikipedia.org/wiki/Steinhaus-Johnson-Trotter_algorithm
15510
155111677 A book by Fabian Stedman lists the solutions for up to six bells.
155121958 A book by Steinhaus describes a related puzzle of generating all permutations by a system of particles.
15513Selmer M. Johnson and Hale F. Trotter discovered the algorithm independently of each other in the early 1960s.
155141962 Hale F. Trotter, "Algorithm 115: Perm", August 1962.
155151963 Selmer M. Johnson, "Generation of permutations by adjacent transposition".
15516
15517*)
15518
15519(* Theorem: perm 0 = 1 *)
15520(* Proof:
15521 perm 0
15522 = CARD (perm_count 0) by perm_def
15523 = CARD {[]} by perm_count_0
15524 = 1 by CARD_SING
15525*)
15526Theorem perm_0:
15527 perm 0 = 1
15528Proof
15529 simp[perm_def, perm_count_0]
15530QED
15531
15532(* Theorem: perm 1 = 1 *)
15533(* Proof:
15534 perm 1
15535 = CARD (perm_count 1) by perm_def
15536 = CARD {[0]} by perm_count_1
15537 = 1 by CARD_SING
15538*)
15539Theorem perm_1:
15540 perm 1 = 1
15541Proof
15542 simp[perm_def, perm_count_1]
15543QED
15544
15545(* Theorem: e IN IMAGE ($interleave n) (perm_count n) ==> FINITE e *)
15546(* Proof:
15547 e IN IMAGE ($interleave n) (perm_count n)
15548 <=> ?ls. ls IN perm_count n /\
15549 e = n interleave ls by IN_IMAGE
15550 Thus FINITE e by interleave_finite
15551*)
15552Theorem perm_count_interleave_finite:
15553 !n e. e IN IMAGE ($interleave n) (perm_count n) ==> FINITE e
15554Proof
15555 rw[] >>
15556 simp[interleave_finite]
15557QED
15558
15559(* Theorem: e IN IMAGE ($interleave n) (perm_count n) ==> CARD e = n + 1 *)
15560(* Proof:
15561 e IN IMAGE ($interleave n) (perm_count n)
15562 <=> ?ls. ls IN perm_count n /\
15563 e = n interleave ls by IN_IMAGE
15564 Note ~MEM n ls by perm_count_element_no_self
15565 and LENGTH ls = n by perm_count_element_length
15566 Thus CARD e = n + 1 by interleave_card, ~MEM n ls
15567*)
15568Theorem perm_count_interleave_card:
15569 !n e. e IN IMAGE ($interleave n) (perm_count n) ==> CARD e = n + 1
15570Proof
15571 rw[] >>
15572 `~MEM n x` by rw[perm_count_element_no_self] >>
15573 `LENGTH x = n` by rw[perm_count_element_length] >>
15574 simp[interleave_card]
15575QED
15576
15577(* Theorem: PAIR_DISJOINT (IMAGE ($interleave n) (perm_count n)) *)
15578(* Proof:
15579 By IN_IMAGE, this is to show:
15580 x IN perm_count n /\ y IN perm_count n /\
15581 n interleave x <> n interleave y ==>
15582 DISJOINT (n interleave x) (n interleave y)
15583 By contradiction, suppose there is a list ls in both.
15584 Then x = y by interleave_disjoint
15585 This contradicts n interleave x <> n interleave y.
15586*)
15587Theorem perm_count_interleave_disjoint:
15588 !n e. PAIR_DISJOINT (IMAGE ($interleave n) (perm_count n))
15589Proof
15590 rw[perm_count_def] >>
15591 `~MEM n x` by fs[] >>
15592 metis_tac[interleave_disjoint]
15593QED
15594
15595(* Theorem: INJ ($interleave n) (perm_count n) univ(:(num list -> bool)) *)
15596(* Proof:
15597 By INJ_DEF, this is to show:
15598 (1) x IN perm_count n ==> n interleave x IN univ
15599 This is true by type.
15600 (2) x IN perm_count n /\ y IN perm_count n /\
15601 n interleave x = n interleave y ==> x = y
15602 Note ~MEM n x by perm_count_element_no_self
15603 and ~MEM n y by perm_count_element_no_self
15604 Thus x = y by interleave_eq
15605*)
15606Theorem perm_count_interleave_inj:
15607 !n. INJ ($interleave n) (perm_count n) univ(:(num list -> bool))
15608Proof
15609 rw[INJ_DEF, perm_count_def, interleave_eq]
15610QED
15611
15612(* Theorem: perm (SUC n) = (SUC n) * perm n *)
15613(* Proof:
15614 Let f = $interleave n,
15615 s = IMAGE f (perm_count n).
15616 Note FINITE (perm_count n) by perm_count_finite
15617 so FINITE s by IMAGE_FINITE
15618 and !e. e IN s ==>
15619 FINITE e /\ by perm_count_interleave_finite
15620 CARD e = n + 1 by perm_count_interleave_card
15621 and PAIR_DISJOINT s by perm_count_interleave_disjoint
15622 and INJ f (perm_count n) univ(:(num list -> bool))
15623 by perm_count_interleave_inj
15624 perm (SUC n)
15625 = CARD (perm_count (SUC n)) by perm_def
15626 = CARD (BIGUNION s) by perm_count_suc
15627 = CARD s * (n + 1) by CARD_BIGUNION_SAME_SIZED_SETS
15628 = CARD (perm_count n) * (n + 1) by INJ_CARD_IMAGE
15629 = perm n * (n + 1) by perm_def
15630 = (SUC n) * perm n by MULT_COMM, ADD1
15631*)
15632Theorem perm_suc:
15633 !n. perm (SUC n) = (SUC n) * perm n
15634Proof
15635 rpt strip_tac >>
15636 qabbrev_tac `f = $interleave n` >>
15637 qabbrev_tac `s = IMAGE f (perm_count n)` >>
15638 `FINITE (perm_count n)` by rw[perm_count_finite] >>
15639 `FINITE s` by rw[Abbr`s`] >>
15640 `!e. e IN s ==> FINITE e /\ CARD e = n + 1`
15641 by metis_tac[perm_count_interleave_finite, perm_count_interleave_card] >>
15642 `PAIR_DISJOINT s` by metis_tac[perm_count_interleave_disjoint] >>
15643 `INJ f (perm_count n) univ(:(num list -> bool))` by rw[perm_count_interleave_inj, Abbr`f`] >>
15644 simp[perm_def] >>
15645 `CARD (perm_count (SUC n)) = CARD (BIGUNION s)` by rw[perm_count_suc, Abbr`s`, Abbr`f`] >>
15646 `_ = CARD s * (n + 1)` by rw[CARD_BIGUNION_SAME_SIZED_SETS] >>
15647 `_ = CARD (perm_count n) * (n + 1)` by metis_tac[INJ_CARD_IMAGE] >>
15648 simp[ADD1]
15649QED
15650
15651(* Theorem: perm (n + 1) = (n + 1) * perm n *)
15652(* Proof: by perm_suc, ADD1 *)
15653Theorem perm_suc_alt:
15654 !n. perm (n + 1) = (n + 1) * perm n
15655Proof
15656 simp[perm_suc, GSYM ADD1]
15657QED
15658
15659(* Theorem: perm 0 = 1 /\ !n. perm (n + 1) = (n + 1) * perm n *)
15660(* Proof: by perm_0, perm_suc_alt *)
15661Theorem perm_alt:
15662 perm 0 = 1 /\ !n. perm (n + 1) = (n + 1) * perm n
15663Proof
15664 simp[perm_0, perm_suc_alt]
15665QED
15666
15667(* Theorem: perm n = FACT n *)
15668(* Proof: by FACT_iff, perm_alt. *)
15669Theorem perm_eq_fact[compute]:
15670 !n. perm n = FACT n
15671Proof
15672 metis_tac[FACT_iff, perm_alt, ADD1]
15673QED
15674
15675(* This is fantastic! *)
15676
15677(*
15678> EVAL ``perm 3``; = 6
15679> EVAL ``MAP perm [0 .. 10]``; =
15680[1; 1; 2; 6; 24; 120; 720; 5040; 40320; 362880; 3628800]
15681*)
15682
15683(* ------------------------------------------------------------------------- *)
15684(* Permutations of a set. *)
15685(* ------------------------------------------------------------------------- *)
15686
15687(* Note: SET_TO_LIST, using CHOICE and REST, is not effective for computations.
15688SET_TO_LIST_THM
15689|- FINITE s ==>
15690 SET_TO_LIST s = if s = {} then [] else CHOICE s::SET_TO_LIST (REST s)
15691*)
15692
15693(* Define the set of permutation lists of a set. *)
15694Definition perm_set_def[nocompute]:
15695 perm_set s = {ls | ALL_DISTINCT ls /\ set ls = s}
15696End
15697(* use [nocompute] as this is not effective for evalutaion. *)
15698(* Note: this cannot be made effective, unless sort s to list by some ordering. *)
15699
15700(* Theorem: ls IN perm_set s <=> ALL_DISTINCT ls /\ set ls = s *)
15701(* Proof: perm_set_def *)
15702Theorem perm_set_element:
15703 !ls s. ls IN perm_set s <=> ALL_DISTINCT ls /\ set ls = s
15704Proof
15705 simp[perm_set_def]
15706QED
15707
15708(* Theorem: perm_set (count n) = perm_count n *)
15709(* Proof: by perm_count_def, perm_set_def. *)
15710Theorem perm_set_perm_count:
15711 !n. perm_set (count n) = perm_count n
15712Proof
15713 simp[perm_count_def, perm_set_def]
15714QED
15715
15716(* Theorem: perm_set {} = {[]} *)
15717(* Proof:
15718 perm_set {}
15719 = {ls | ALL_DISTINCT ls /\ set ls = {}} by perm_set_def
15720 = {ls | ALL_DISTINCT ls /\ ls = []} by LIST_TO_SET_EQ_EMPTY
15721 = {[]} by ALL_DISTINCT
15722*)
15723Theorem perm_set_empty:
15724 perm_set {} = {[]}
15725Proof
15726 rw[perm_set_def, EXTENSION] >>
15727 metis_tac[ALL_DISTINCT]
15728QED
15729
15730(* Theorem: perm_set {x} = {[x]} *)
15731(* Proof:
15732 perm_set {x}
15733 = {ls | ALL_DISTINCT ls /\ set ls = {x}} by perm_set_def
15734 = {ls | ls = [x]} by DISTINCT_LIST_TO_SET_EQ_SING
15735 = {[x]} by notation
15736*)
15737Theorem perm_set_sing:
15738 !x. perm_set {x} = {[x]}
15739Proof
15740 simp[perm_set_def, DISTINCT_LIST_TO_SET_EQ_SING]
15741QED
15742
15743(* Theorem: perm_set s = {[]} <=> s = {} *)
15744(* Proof:
15745 If part: perm_set s = {[]} ==> s = {}
15746 By contradiction, suppose s <> {}.
15747 ls IN perm_set s
15748 <=> ALL_DISTINCT ls /\ set ls = s by perm_set_element
15749 ==> ls <> [] by LIST_TO_SET_EQ_EMPTY
15750 This contradicts perm_set s = {[]} by IN_SING
15751 Only-if part: s = {} ==> perm_set s = {[]}
15752 This is true by perm_set_empty
15753*)
15754Theorem perm_set_eq_empty_sing:
15755 !s. perm_set s = {[]} <=> s = {}
15756Proof
15757 rw[perm_set_empty, EQ_IMP_THM] >>
15758 `[] IN perm_set s` by fs[] >>
15759 fs[perm_set_element]
15760QED
15761
15762(* Theorem: FINITE s ==> (SET_TO_LIST s) IN perm_set s *)
15763(* Proof:
15764 Let ls = SET_TO_LIST s.
15765 Note ALL_DISTINCT ls by ALL_DISTINCT_SET_TO_LIST
15766 and set ls = s by SET_TO_LIST_INV
15767 Thus ls IN perm_set s by perm_set_element
15768*)
15769Theorem perm_set_has_self_list:
15770 !s. FINITE s ==> (SET_TO_LIST s) IN perm_set s
15771Proof
15772 simp[perm_set_element, ALL_DISTINCT_SET_TO_LIST, SET_TO_LIST_INV]
15773QED
15774
15775(* Theorem: FINITE s ==> perm_set s <> {} *)
15776(* Proof:
15777 Let ls = SET_TO_LIST s.
15778 Then ls IN perm_set s by perm_set_has_self_list
15779 Thus perm_set s <> {} by MEMBER_NOT_EMPTY
15780*)
15781Theorem perm_set_not_empty:
15782 !s. FINITE s ==> perm_set s <> {}
15783Proof
15784 metis_tac[perm_set_has_self_list, MEMBER_NOT_EMPTY]
15785QED
15786
15787(* Theorem: perm_set (set ls) <> {} *)
15788(* Proof:
15789 Note FINITE (set ls) by FINITE_LIST_TO_SET
15790 so perm_set (set ls) <> {} by perm_set_not_empty
15791*)
15792Theorem perm_set_list_not_empty:
15793 !ls. perm_set (set ls) <> {}
15794Proof
15795 simp[FINITE_LIST_TO_SET, perm_set_not_empty]
15796QED
15797
15798(* Theorem: ls IN perm_set s /\ BIJ f s (count n) ==> MAP f ls IN perm_count n *)
15799(* Proof:
15800 By perm_set_def, perm_count_def, this is to show:
15801 (1) ALL_DISTINCT ls /\ BIJ f (set ls) (count n) ==> ALL_DISTINCT (MAP f ls)
15802 Note INJ f (set ls) (count n) by BIJ_DEF
15803 so ALL_DISTINCT (MAP f ls) by ALL_DISTINCT_MAP_INJ, INJ_DEF
15804 (2) ALL_DISTINCT ls /\ BIJ f (set ls) (count n) ==> set (MAP f ls) = count n
15805 Note SURJ f (set ls) (count n) by BIJ_DEF
15806 so set (MAP f ls)
15807 = IMAGE f (set ls) by LIST_TO_SET_MAP
15808 = count n by IMAGE_SURJ
15809*)
15810Theorem perm_set_map_element:
15811 !ls f s n. ls IN perm_set s /\ BIJ f s (count n) ==> MAP f ls IN perm_count n
15812Proof
15813 rw[perm_set_def, perm_count_def] >-
15814 metis_tac[ALL_DISTINCT_MAP_INJ, BIJ_IS_INJ] >>
15815 simp[LIST_TO_SET_MAP] >>
15816 fs[IMAGE_SURJ, BIJ_DEF]
15817QED
15818
15819(* Theorem: BIJ f s (count n) ==>
15820 INJ (MAP f) (perm_set s) (perm_count n) *)
15821(* Proof:
15822 By INJ_DEF, this is to show:
15823 (1) x IN perm_set s ==> MAP f x IN perm_count n
15824 This is true by perm_set_map_element
15825 (2) x IN perm_set s /\ y IN perm_set s /\ MAP f x = MAP f y ==> x = y
15826 Note LENGTH x = LENGTH y by LENGTH_MAP
15827 By LIST_EQ, it remains to show:
15828 !j. j < LENGTH x ==> EL j x = EL j y
15829 Note EL j x IN s by perm_set_element, MEM_EL
15830 and EL j y IN s by perm_set_element, MEM_EL
15831 MAP f x = MAP f y
15832 ==> EL j (MAP f x) = EL j (MAP f y)
15833 ==> f (EL j x) = f (EL j y) by EL_MAP
15834 ==> EL j x = EL j y by BIJ_IS_INJ
15835*)
15836Theorem perm_set_map_inj:
15837 !f s n. BIJ f s (count n) ==>
15838 INJ (MAP f) (perm_set s) (perm_count n)
15839Proof
15840 rw[INJ_DEF] >-
15841 metis_tac[perm_set_map_element] >>
15842 irule LIST_EQ >>
15843 `LENGTH x = LENGTH y` by metis_tac[LENGTH_MAP] >>
15844 rw[] >>
15845 `EL x' x IN s` by metis_tac[perm_set_element, MEM_EL] >>
15846 `EL x' y IN s` by metis_tac[perm_set_element, MEM_EL] >>
15847 metis_tac[EL_MAP, BIJ_IS_INJ]
15848QED
15849
15850(* Theorem: BIJ f s (count n) ==>
15851 SURJ (MAP f) (perm_set s) (perm_count n) *)
15852(* Proof:
15853 By SURJ_DEF, this is to show:
15854 (1) x IN perm_set s ==> MAP f x IN perm_count n
15855 This is true by perm_set_map_element
15856 (2) x IN perm_count n ==> ?y. y IN perm_set s /\ MAP f y = x
15857 Let y = MAP (LINV f s) x. Then to show:
15858 (1) y IN perm_set s,
15859 Note BIJ (LINV f s) (count n) s by BIJ_LINV_BIJ
15860 By perm_set_element, perm_count_element, to show:
15861 (1) ALL_DISTINCT (MAP (LINV f s) x)
15862 Note INJ (LINV f s) (count n) s by BIJ_DEF
15863 so ALL_DISTINCT (MAP (LINV f s) x)
15864 by ALL_DISTINCT_MAP_INJ, INJ_DEF
15865 (2) set (MAP (LINV f s) x) = s
15866 Note SURJ (LINV f s) (count n) s by BIJ_DEF
15867 so set (MAP (LINV f s) x)
15868 = IMAGE (LINV f s) (set x) by LIST_TO_SET_MAP
15869 = IMAGE (LINV f s) (count n) by set x = count n
15870 = s by IMAGE_SURJ
15871 (2) x IN perm_count n ==> MAP f (MAP (LINV f s) x) = x
15872 Let g = f o LINV f s.
15873 The goal is: MAP g x = x by MAP_COMPOSE
15874 Note LENGTH (MAP g x) = LENGTH x by LENGTH_MAP
15875 To apply LIST_EQ, just need to show:
15876 !k. k < LENGTH x ==>
15877 EL k (MAP g x) = EL k x
15878 or to show: g (EL k x) = EL k x by EL_MAP
15879 Now set x = count n by perm_count_element
15880 so EL k x IN (count n) by MEM_EL
15881 Thus g (EL k x) = EL k x by BIJ_LINV_INV
15882*)
15883Theorem perm_set_map_surj:
15884 !f s n. BIJ f s (count n) ==>
15885 SURJ (MAP f) (perm_set s) (perm_count n)
15886Proof
15887 rw[SURJ_DEF] >-
15888 metis_tac[perm_set_map_element] >>
15889 qexists_tac `MAP (LINV f s) x` >>
15890 rpt strip_tac >| [
15891 `BIJ (LINV f s) (count n) s` by rw[BIJ_LINV_BIJ] >>
15892 fs[perm_set_element, perm_count_element] >>
15893 rpt strip_tac >-
15894 metis_tac[ALL_DISTINCT_MAP_INJ, BIJ_IS_INJ] >>
15895 simp[LIST_TO_SET_MAP] >>
15896 fs[IMAGE_SURJ, BIJ_DEF],
15897 simp[MAP_COMPOSE] >>
15898 qabbrev_tac `g = f o LINV f s` >>
15899 irule LIST_EQ >>
15900 `LENGTH (MAP g x) = LENGTH x` by rw[LENGTH_MAP] >>
15901 rw[] >>
15902 simp[EL_MAP] >>
15903 fs[perm_count_element, Abbr`g`] >>
15904 metis_tac[MEM_EL, BIJ_LINV_INV]
15905 ]
15906QED
15907
15908(* Theorem: BIJ f s (count n) ==>
15909 BIJ (MAP f) (perm_set s) (perm_count n) *)
15910(* Proof:
15911 Note INJ (MAP f) (perm_set s) (perm_count n) by perm_set_map_inj
15912 and SURJ (MAP f) (perm_set s) (perm_count n) by perm_set_map_surj
15913 Thus BIJ (MAP f) (perm_set s) (perm_count n) by BIJ_DEF
15914*)
15915Theorem perm_set_map_bij:
15916 !f s n. BIJ f s (count n) ==>
15917 BIJ (MAP f) (perm_set s) (perm_count n)
15918Proof
15919 simp[BIJ_DEF, perm_set_map_inj, perm_set_map_surj]
15920QED
15921
15922(* Theorem: FINITE s ==> perm_set s =b= perm_count (CARD s) *)
15923(* Proof:
15924 Note ?f. BIJ f s (count (CARD s)) by bij_eq_count, FINITE s
15925 Thus BIJ (MAP f) (perm_set s) (perm_count (CARD s))
15926 by perm_set_map_bij
15927 showing perm_set s =b= perm_count (CARD s) by notation
15928*)
15929Theorem perm_set_bij_eq_perm_count:
15930 !s. FINITE s ==> perm_set s =b= perm_count (CARD s)
15931Proof
15932 rpt strip_tac >>
15933 imp_res_tac bij_eq_count >>
15934 metis_tac[perm_set_map_bij]
15935QED
15936
15937(* Theorem: FINITE s ==> FINITE (perm_set s) *)
15938(* Proof:
15939 Note perm_set s =b= perm_count (CARD s) by perm_set_bij_eq_perm_count
15940 and FINITE (perm_count (CARD s)) by perm_count_finite
15941 so FINITE (perm_set s) by bij_eq_finite
15942*)
15943Theorem perm_set_finite:
15944 !s. FINITE s ==> FINITE (perm_set s)
15945Proof
15946 metis_tac[perm_set_bij_eq_perm_count, perm_count_finite, bij_eq_finite]
15947QED
15948
15949(* Theorem: FINITE s ==> CARD (perm_set s) = perm (CARD s) *)
15950(* Proof:
15951 Note perm_set s =b= perm_count (CARD s) by perm_set_bij_eq_perm_count
15952 and FINITE (perm_count (CARD s)) by perm_count_finite
15953 so CARD (perm_set s)
15954 = CARD (perm_count (CARD s)) by bij_eq_card
15955 = perm (CARD s) by perm_def
15956*)
15957Theorem perm_set_card:
15958 !s. FINITE s ==> CARD (perm_set s) = perm (CARD s)
15959Proof
15960 metis_tac[perm_set_bij_eq_perm_count, perm_count_finite, bij_eq_card, perm_def]
15961QED
15962
15963(* This is a major result! *)
15964
15965(* Theorem: FINITE s ==> CARD (perm_set s) = FACT (CARD s) *)
15966(* Proof: by perm_set_card, perm_eq_fact. *)
15967Theorem perm_set_card_alt:
15968 !s. FINITE s ==> CARD (perm_set s) = FACT (CARD s)
15969Proof
15970 simp[perm_set_card, perm_eq_fact]
15971QED
15972
15973(* ------------------------------------------------------------------------- *)
15974(* Counting number of arrangements. *)
15975(* ------------------------------------------------------------------------- *)
15976
15977(* Define the set of choices of k-tuples of (count n). *)
15978Definition list_count_def[nocompute]:
15979 list_count n k =
15980 { ls | ALL_DISTINCT ls /\ (set ls) SUBSET (count n) /\ LENGTH ls = k}
15981End
15982(* use [nocompute] as this is not effective for evalutaion. *)
15983(* Note: if defined as:
15984 list_count n k = { ls | (set ls) SUBSET (count n) /\ CARD (set ls) = k}
15985then non-distinct lists will be in the set, which is not desirable.
15986*)
15987
15988(* Define the number of choices of k-tuples of (count n). *)
15989Definition arrange_def[nocompute]:
15990 arrange n k = CARD (list_count n k)
15991End
15992(* use [nocompute] as this is not effective for evalutaion. *)
15993(* make this an infix operator *)
15994val _ = set_fixity "arrange" (Infix(NONASSOC, 550)); (* higher than arithmetic op 500. *)
15995(* arrange_def;
15996val it = |- !n k. n arrange k = CARD (list_count n k): thm *)
15997
15998(* Theorem: list_count n k =
15999 { ls | ALL_DISTINCT ls /\ (set ls) SUBSET (count n) /\ CARD (set ls) = k} *)
16000(* Proof:
16001 ls IN list_count n k
16002 <=> ALL_DISTINCT ls /\ (set ls) SUBSET (count n) /\ LENGTH ls = k
16003 by list_count_def
16004 <=> ALL_DISTINCT ls /\ (set ls) SUBSET (count n) /\ CARD (set ls) = k
16005 by ALL_DISTINCT_CARD_LIST_TO_SET
16006 Hence the sets are equal by EXTENSION.
16007*)
16008Theorem list_count_alt:
16009 !n k. list_count n k =
16010 { ls | ALL_DISTINCT ls /\ (set ls) SUBSET (count n) /\ CARD (set ls) = k}
16011Proof
16012 simp[list_count_def, EXTENSION] >>
16013 metis_tac[ALL_DISTINCT_CARD_LIST_TO_SET]
16014QED
16015
16016(* Theorem: ls IN list_count n k <=>
16017 ALL_DISTINCT ls /\ (set ls) SUBSET (count n) /\ LENGTH ls = k *)
16018(* Proof: by list_count_def. *)
16019Theorem list_count_element:
16020 !ls n k. ls IN list_count n k <=>
16021 ALL_DISTINCT ls /\ (set ls) SUBSET (count n) /\ LENGTH ls = k
16022Proof
16023 simp[list_count_def]
16024QED
16025
16026(* Theorem: ls IN list_count n k <=>
16027 ALL_DISTINCT ls /\ (set ls) SUBSET (count n) /\ CARD (set ls) = k *)
16028(* Proof: by list_count_alt. *)
16029Theorem list_count_element_alt:
16030 !ls n k. ls IN list_count n k <=>
16031 ALL_DISTINCT ls /\ (set ls) SUBSET (count n) /\ CARD (set ls) = k
16032Proof
16033 simp[list_count_alt]
16034QED
16035
16036(* Theorem: ls IN list_count n k ==> CARD (set ls) = k *)
16037(* Proof:
16038 ls IN list_count n k
16039 <=> ALL_DISTINCT ls /\ (set ls) SUBSET (count n) /\ LENGTH ls = k
16040 by list_count_element
16041 ==> CARD (set ls) = k by ALL_DISTINCT_CARD_LIST_TO_SET
16042*)
16043Theorem list_count_element_set_card:
16044 !ls n k. ls IN list_count n k ==> CARD (set ls) = k
16045Proof
16046 simp[list_count_def, ALL_DISTINCT_CARD_LIST_TO_SET]
16047QED
16048
16049(* Theorem: list_count n k SUBSET necklace k n *)
16050(* Proof:
16051 ls IN list_count n k
16052 <=> ALL_DISTINCT ls /\ (set ls) SUBSET (count n) /\ LENGTH ls = k
16053 by list_count_element
16054 ==> (set ls) SUBSET (count n) /\ LENGTH ls = k
16055 ==> ls IN necklace k n by necklace_def
16056 Thus list_count n k SUBSET necklace k n by SUBSET_DEF
16057*)
16058Theorem list_count_subset:
16059 !n k. list_count n k SUBSET necklace k n
16060Proof
16061 simp[list_count_def, necklace_def, SUBSET_DEF]
16062QED
16063
16064(* Theorem: FINITE (list_count n k) *)
16065(* Proof:
16066 Note list_count n k SUBSET necklace k n by list_count_subset
16067 and FINITE (necklace k n) by necklace_finite
16068 so FINITE (list_count n k) by SUBSET_FINITE
16069*)
16070Theorem list_count_finite:
16071 !n k. FINITE (list_count n k)
16072Proof
16073 metis_tac[list_count_subset, necklace_finite, SUBSET_FINITE]
16074QED
16075
16076(* Note:
16077list_count 4 2 has P(4,2) = 4 * 3 = 12 elements.
16078necklace 2 4 has 2 ** 4 = 16 elements.
16079
16080> EVAL ``necklace 2 4``;
16081val it = |- necklace 2 4 =
16082 {[3; 3]; [3; 2]; [3; 1]; [3; 0]; [2; 3]; [2; 2]; [2; 1]; [2; 0];
16083 [1; 3]; [1; 2]; [1; 1]; [1; 0]; [0; 3]; [0; 2]; [0; 1]; [0; 0]}: thm
16084> EVAL ``IMAGE set (necklace 2 4)``;
16085val it = |- IMAGE set (necklace 2 4) =
16086 {{3}; {2; 3}; {2}; {1; 3}; {1; 2}; {1}; {0; 3}; {0; 2}; {0; 1}; {0}}:
16087> EVAL ``IMAGE (\ls. if CARD (set ls) = 2 then ls else []) (necklace 2 4)``;
16088val it = |- IMAGE (\ls. if CARD (set ls) = 2 then ls else []) (necklace 2 4) =
16089 {[3; 2]; [3; 1]; [3; 0]; [2; 3]; [2; 1]; [2; 0]; [1; 3]; [1; 2];
16090 [1; 0]; [0; 3]; [0; 2]; [0; 1]; []}: thm
16091> EVAL ``let n = 4; k = 2 in (IMAGE (\ls. if CARD (set ls) = k then ls else []) (necklace k n)) DELETE []``;
16092val it = |- (let n = 4; k = 2 in
16093IMAGE (\ls. if CARD (set ls) = k then ls else []) (necklace k n) DELETE []) =
16094 {[3; 2]; [3; 1]; [3; 0]; [2; 3]; [2; 1]; [2; 0]; [1; 3]; [1; 2];
16095 [1; 0]; [0; 3]; [0; 2]; [0; 1]}: thm
16096> EVAL ``let n = 4; k = 2 in (IMAGE (\ls. if ALL_DISTINCT ls then ls else []) (necklace k n)) DELETE []``;
16097val it = |- (let n = 4; k = 2 in
16098 IMAGE (\ls. if ALL_DISTINCT ls then ls else []) (necklace k n) DELETE []) =
16099 {[3; 2]; [3; 1]; [3; 0]; [2; 3]; [2; 1]; [2; 0]; [1; 3]; [1; 2];
16100 [1; 0]; [0; 3]; [0; 2]; [0; 1]}: thm
16101*)
16102
16103(* Note:
16104P(n,k) = C(n,k) * k!
16105P(n,0) = C(n,0) * 0! = 1
16106P(0,k+1) = C(0,k+1) * (k+1)! = 0
16107*)
16108
16109(* Theorem: list_count n 0 = {[]} *)
16110(* Proof:
16111 ls IN list_count n 0
16112 <=> ALL_DISTINCT ls /\ (set ls) SUBSET (count n) /\ LENGTH ls = 0
16113 by list_count_element
16114 <=> ALL_DISTINCT ls /\ (set ls) SUBSET (count n) /\ ls = []
16115 by LENGTH_NIL
16116 <=> T /\ T /\ ls = [] by ALL_DISTINCT, LIST_TO_SET, EMPTY_SUBSET
16117 Thus list_count n 0 = {[]} by EXTENSION
16118*)
16119Theorem list_count_n_0:
16120 !n. list_count n 0 = {[]}
16121Proof
16122 rw[list_count_def, EXTENSION, EQ_IMP_THM]
16123QED
16124
16125(* Theorem: 0 < n ==> list_count 0 n = {} *)
16126(* Proof:
16127 Note (list_count 0 n) SUBSET (necklace n 0)
16128 by list_count_subset
16129 but (necklace n 0) = {} by necklace_empty, 0 < n
16130 Thus (list_count 0 n) = {} by SUBSET_EMPTY
16131*)
16132Theorem list_count_0_n:
16133 !n. 0 < n ==> list_count 0 n = {}
16134Proof
16135 metis_tac[list_count_subset, necklace_empty, SUBSET_EMPTY]
16136QED
16137
16138(* Theorem: list_count n n = perm_count n *)
16139(* Proof:
16140 ls IN list_count n n
16141 <=> ALL_DISTINCT ls /\ set ls SUBSET count n /\ CARD (set ls) = n
16142 by list_count_element_alt
16143 <=> ALL_DISTINCT ls /\ set ls SUBSET count n /\ CARD (set ls) = CARD (count n)
16144 by CARD_COUNT
16145 <=> ALL_DISTINCT ls /\ set ls SUBSET count n /\ set ls = count n
16146 by SUBSET_CARD_EQ
16147 <=> ALL_DISTINCT ls /\ set ls = count n by SUBSET_REFL
16148 <=> ls IN perm_count n by perm_count_element
16149*)
16150Theorem list_count_n_n:
16151 !n. list_count n n = perm_count n
16152Proof
16153 rw_tac bool_ss[list_count_element_alt, EXTENSION] >>
16154 `FINITE (count n) /\ CARD (count n) = n` by rw[] >>
16155 metis_tac[SUBSET_REFL, SUBSET_CARD_EQ, perm_count_element]
16156QED
16157
16158(* Theorem: list_count n k = {} <=> n < k *)
16159(* Proof:
16160 If part: list_count n k = {} ==> n < k
16161 By contradiction, suppose k <= n.
16162 Let ls = SET_TO_LIST (count k).
16163 Note FINITE (count k) by FINITE_COUNT
16164 Then ALL_DISTINCT ls by ALL_DISTINCT_SET_TO_LIST
16165 and set ls = count k by SET_TO_LIST_INV
16166 Now (count k) SUBSET (count n) by COUNT_SUBSET, k <= n
16167 and CARD (count k) = k by CARD_COUNT
16168 so ls IN list_count n k by list_count_element_alt
16169 Thus list_count n k <> {} by MEMBER_NOT_EMPTY
16170 which is a contradiction.
16171 Only-if part: n < k ==> list_count n k = {}
16172 By contradiction, suppose sub_count n k <> {}.
16173 Then ?ls. ls IN list_count n k by MEMBER_NOT_EMPTY
16174 ==> ALL_DISTINCT ls /\ set ls SUBSET count n /\ CARD (set ls) = k
16175 by sub_count_element_alt
16176 Note FINITE (count n) by FINITE_COUNT
16177 so CARD (set ls) <= CARD (count n)
16178 by CARD_SUBSET
16179 ==> k <= n by CARD_COUNT
16180 This contradicts n < k.
16181*)
16182Theorem list_count_eq_empty:
16183 !n k. list_count n k = {} <=> n < k
16184Proof
16185 rw[EQ_IMP_THM] >| [
16186 spose_not_then strip_assume_tac >>
16187 qabbrev_tac `ls = SET_TO_LIST (count k)` >>
16188 `FINITE (count k)` by rw[FINITE_COUNT] >>
16189 `ALL_DISTINCT ls` by rw[ALL_DISTINCT_SET_TO_LIST, Abbr`ls`] >>
16190 `set ls = count k` by rw[SET_TO_LIST_INV, Abbr`ls`] >>
16191 `(count k) SUBSET (count n)` by rw[COUNT_SUBSET] >>
16192 `CARD (count k) = k` by rw[] >>
16193 metis_tac[list_count_element_alt, MEMBER_NOT_EMPTY],
16194 spose_not_then strip_assume_tac >>
16195 `?ls. ls IN list_count n k` by rw[MEMBER_NOT_EMPTY] >>
16196 fs[list_count_element_alt] >>
16197 `FINITE (count n)` by rw[] >>
16198 `CARD (set ls) <= n` by metis_tac[CARD_SUBSET, CARD_COUNT] >>
16199 decide_tac
16200 ]
16201QED
16202
16203(* Theorem: 0 < k ==>
16204 list_count n k =
16205 IMAGE (\ls. if ALL_DISTINCT ls then ls else []) (necklace k n) DELETE [] *)
16206(* Proof:
16207 x IN IMAGE (\ls. if ALL_DISTINCT ls then ls else []) (necklace k n) DELETE []
16208 <=> ?ls. x = (if ALL_DISTINCT ls then ls else []) /\
16209 LENGTH ls = k /\ set ls SUBSET count n) /\ x <> [] by IN_IMAGE, IN_DELETE
16210 <=> ALL_DISTINCT x /\ LENGTH x = k /\ set x SUBSET count n by LENGTH_NIL, 0 < k, ls = x
16211 <=> x IN list_count n k by list_count_element
16212 Thus the two sets are equal by EXTENSION.
16213*)
16214Theorem list_count_by_image:
16215 !n k. 0 < k ==>
16216 list_count n k =
16217 IMAGE (\ls. if ALL_DISTINCT ls then ls else []) (necklace k n) DELETE []
16218Proof
16219 rw[list_count_def, necklace_def, EXTENSION] >>
16220 (rw[EQ_IMP_THM] >> metis_tac[LENGTH_NIL, NOT_ZERO])
16221QED
16222
16223(* Theorem: list_count n k =
16224 if k = 0 then {[]}
16225 else IMAGE (\ls. if ALL_DISTINCT ls then ls else []) (necklace k n) DELETE [] *)
16226(* Proof: by list_count_n_0, list_count_by_image *)
16227Theorem list_count_eqn[compute]:
16228 !n k. list_count n k =
16229 if k = 0 then {[]}
16230 else IMAGE (\ls. if ALL_DISTINCT ls then ls else []) (necklace k n) DELETE []
16231Proof
16232 rw[list_count_n_0, list_count_by_image]
16233QED
16234
16235(*
16236> EVAL ``list_count 3 2``;
16237val it = |- list_count 3 2 = {[2; 1]; [2; 0]; [1; 2]; [1; 0]; [0; 2]; [0; 1]}: thm
16238> EVAL ``list_count 4 2``;
16239val it = |- list_count 4 2 =
16240{[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
16241*)
16242
16243(* Idea: define an equivalence relation feq set: set x = set y.
16244 There are k! elements in each equivalence class.
16245 Thus n arrange k = perm k * n choose k. *)
16246
16247(* Theorem: (feq set) equiv_on s *)
16248(* Proof: by feq_equiv. *)
16249Theorem feq_set_equiv:
16250 !s. (feq set) equiv_on s
16251Proof
16252 simp[feq_equiv]
16253QED
16254
16255(*
16256> EVAL ``list_count 3 2``;
16257val it = |- list_count 3 2 = {[2; 1]; [1; 2]; [2; 0]; [0; 2]; [1; 0]; [0; 1]}: thm
16258*)
16259
16260(* Theorem: ls IN list_count n k ==>
16261 equiv_class (feq set) (list_count n k) ls = perm_set (set ls) *)
16262(* Proof:
16263 Note ALL_DISTINCT ls /\ set ls SUBSET count n /\ LENGTH ls = k
16264 by list_count_element
16265 x IN equiv_class (feq set) (list_count n k) ls
16266 <=> x IN (list_count n k) /\ (feq set) ls x by equiv_class_element
16267 <=> x IN (list_count n k) /\ set ls = set x by feq_def
16268 <=> ALL_DISTINCT x /\ set x SUBSET count n /\ LENGTH x = k /\
16269 set x = set ls by list_count_element
16270 <=> ALL_DISTINCT x /\ LENGTH x = LENGTH ls /\ set x = set ls
16271 by given
16272 <=> ALL_DISTINCT x /\ set x = set ls by ALL_DISTINCT_CARD_LIST_TO_SET
16273 <=> x IN perm_set (set ls) by perm_set_element
16274*)
16275Theorem list_count_set_eq_class:
16276 !ls n k. ls IN list_count n k ==>
16277 equiv_class (feq set) (list_count n k) ls = perm_set (set ls)
16278Proof
16279 rw[list_count_def, perm_set_def, fequiv_def, Once EXTENSION] >>
16280 rw[EQ_IMP_THM] >>
16281 metis_tac[ALL_DISTINCT_CARD_LIST_TO_SET]
16282QED
16283
16284(* Theorem: ls IN list_count n k ==>
16285 CARD (equiv_class (feq set) (list_count n k) ls) = perm k *)
16286(* Proof:
16287 Note ALL_DISTINCT ls /\ set ls SUBSET count n /\ LENGTH ls = k
16288 by list_count_element
16289 CARD (equiv_class (feq set) (list_count n k) ls)
16290 = CARD (perm_set (set ls)) by list_count_set_eq_class
16291 = perm (CARD (set ls)) by perm_set_card
16292 = perm (LENGTH ls) by ALL_DISTINCT_CARD_LIST_TO_SET
16293 = perm k by LENGTH ls = k
16294*)
16295Theorem list_count_set_eq_class_card:
16296 !ls n k. ls IN list_count n k ==>
16297 CARD (equiv_class (feq set) (list_count n k) ls) = perm k
16298Proof
16299 rw[list_count_set_eq_class] >>
16300 fs[list_count_element] >>
16301 simp[perm_set_card, ALL_DISTINCT_CARD_LIST_TO_SET]
16302QED
16303
16304(* Theorem: e IN partition (feq set) (list_count n k) ==> CARD e = perm k *)
16305(* Proof:
16306 By partition_element, this is to show:
16307 ls IN list_count n k ==>
16308 CARD (equiv_class (feq set) (list_count n k) ls) = perm k
16309 This is true by list_count_set_eq_class_card.
16310*)
16311Theorem list_count_set_partititon_element_card:
16312 !n k e. e IN partition (feq set) (list_count n k) ==> CARD e = perm k
16313Proof
16314 rw_tac bool_ss [partition_element] >>
16315 simp[list_count_set_eq_class_card]
16316QED
16317
16318(* Theorem: ls IN list_count n k ==> perm_set (set ls) <> {} *)
16319(* Proof:
16320 Note (feq set) equiv_on (list_count n k) by feq_set_equiv
16321 and perm_set (set ls)
16322 = equiv_class (feq set) (list_count n k) ls by list_count_set_eq_class
16323 <> {} by equiv_class_not_empty
16324*)
16325Theorem list_count_element_perm_set_not_empty:
16326 !ls n k. ls IN list_count n k ==> perm_set (set ls) <> {}
16327Proof
16328 metis_tac[list_count_set_eq_class, feq_set_equiv, equiv_class_not_empty]
16329QED
16330
16331(* This is more restrictive than perm_set_list_not_empty, hence not useful. *)
16332
16333(* Theorem: s IN (partition (feq set) (list_count n k)) ==>
16334 (set o CHOICE) s IN (sub_count n k) *)
16335(* Proof:
16336 s IN (partition (feq set) (list_count n k))
16337 <=> ?z. z IN list_count n k /\
16338 !x. x IN s <=> x IN list_count n k /\ set x = set z
16339 by feq_partition_element
16340 ==> z IN s, so s <> {} by MEMBER_NOT_EMPTY
16341 Let ls = CHOICE s.
16342 Then ls IN s by CHOICE_DEF
16343 so ls IN list_count n k /\ set ls = set z
16344 by implication
16345 or ALL_DISTINCT ls /\ set ls SUBSET count n /\ LENGTH ls = k
16346 by list_count_element
16347 Note (set o CHOICE) s = set ls by o_THM
16348 and CARD (set ls) = LENGTH ls by ALL_DISTINCT_CARD_LIST_TO_SET
16349 so set ls IN (sub_count n k) by sub_count_element_alt
16350*)
16351Theorem list_count_set_map_element:
16352 !s n k. s IN (partition (feq set) (list_count n k)) ==>
16353 (set o CHOICE) s IN (sub_count n k)
16354Proof
16355 rw[feq_partition_element] >>
16356 `s <> {}` by metis_tac[MEMBER_NOT_EMPTY] >>
16357 `(CHOICE s) IN s` by fs[CHOICE_DEF] >>
16358 fs[list_count_element, sub_count_element] >>
16359 metis_tac[ALL_DISTINCT_CARD_LIST_TO_SET]
16360QED
16361
16362(* Theorem: INJ (set o CHOICE) (partition (feq set) (list_count n k)) (sub_count n k) *)
16363(* Proof:
16364 Let R = feq set,
16365 s = list_count n k,
16366 t = sub_count n k.
16367 By INJ_DEF, this is to show:
16368 (1) x IN partition R s ==> (set o CHOICE) x IN t
16369 This is true by list_count_set_map_element
16370 (2) x IN partition R s /\ y IN partition R s /\
16371 (set o CHOICE) x = (set o CHOICE) y ==> x = y
16372 Note ?u. u IN list_count n k
16373 !ls. ls IN x <=> ls IN list_count n k /\ set ls = set u
16374 by feq_partition_element
16375 and ?v. v IN list_count n k
16376 !ls. ls IN y <=> ls IN list_count n k /\ set ls = set v
16377 by feq_partition_element
16378 Thus u IN x, so x <> {} by MEMBER_NOT_EMPTY
16379 and v IN y, so y <> {} by MEMBER_NOT_EMPTY
16380 Let lx = CHOICE x IN x by CHOICE_DEF
16381 and ly = CHOICE y IN y by CHOICE_DEF
16382 With set lx = set ly by o_THM
16383 Thus set lx = set u by implication
16384 and set ly = set v by implication
16385 so set u = set v by above
16386 Thus x = y by EXTENSION
16387*)
16388Theorem list_count_set_map_inj:
16389 !n k. INJ (set o CHOICE) (partition (feq set) (list_count n k)) (sub_count n k)
16390Proof
16391 rw_tac bool_ss[INJ_DEF] >-
16392 simp[list_count_set_map_element] >>
16393 fs[feq_partition_element] >>
16394 `x <> {} /\ y <> {}` by metis_tac[MEMBER_NOT_EMPTY] >>
16395 `CHOICE x IN x /\ CHOICE y IN y` by fs[CHOICE_DEF] >>
16396 `set z = set z'` by rfs[] >>
16397 simp[EXTENSION]
16398QED
16399
16400(* Theorem: SURJ (set o CHOICE) (partition (feq set) (list_count n k)) (sub_count n k) *)
16401(* Proof:
16402 Let R = feq set,
16403 s = list_count n k,
16404 t = sub_count n k.
16405 By SURJ_DEF, this is to show:
16406 (1) x IN partition R s ==> (set o CHOICE) x IN t
16407 This is true by list_count_set_map_element
16408 (2) x IN t ==> ?y. y IN partition R s /\ (set o CHOICE) y = x
16409 Note x SUBSET count n /\ CARD x = k by sub_count_element
16410 Thus FINITE x by SUBSET_FINITE, FINITE_COUNT
16411 Let y = perm_set x.
16412 To show;
16413 (1) y IN partition R s
16414 Note y IN partition R s
16415 <=> ?ls. ls IN list_count n k /\
16416 !z. z IN perm_set x <=> z IN list_count n k /\ set z = set ls
16417 by feq_partition_element
16418 Let ls = SET_TO_LIST x.
16419 Then ALL_DISTINCT ls by ALL_DISTINCT_SET_TO_LIST, FINITE x
16420 and set ls = x by SET_TO_LIST_INV, FINITE x
16421 so set ls SUBSET (count n) by above, x SUBSET count n
16422 and LENGTH ls = k by SET_TO_LIST_CARD, FINITE x
16423 so ls IN list_count n k by list_count_element
16424 To show: !z. z IN perm_set x <=> z IN list_count n k /\ set z = set ls
16425 z IN perm_set x
16426 <=> ALL_DISTINCT z /\ set z = x by perm_set_element
16427 <=> ALL_DISTINCT z /\ set z SUBSET count n /\ set z = x
16428 by x SUBSET count n
16429 <=> ALL_DISTINCT z /\ set z SUBSET count n /\ LENGTH z = CARD x
16430 by ALL_DISTINCT_CARD_LIST_TO_SET
16431 <=> z IN list_count n k /\ set z = set ls
16432 by list_count_element, CARD x = k, set ls = x.
16433 (2) (set o CHOICE) y = x
16434 Note y <> {} by perm_set_not_empty, FINITE x
16435 Then CHOICE y IN y by CHOICE_DEF
16436 so (set o CHOICE) y
16437 = set (CHOICE y) by o_THM
16438 = x by perm_set_element, y = perm_set x
16439*)
16440Theorem list_count_set_map_surj:
16441 !n k. SURJ (set o CHOICE) (partition (feq set) (list_count n k)) (sub_count n k)
16442Proof
16443 rw_tac bool_ss[SURJ_DEF] >-
16444 simp[list_count_set_map_element] >>
16445 fs[sub_count_element] >>
16446 `FINITE x` by metis_tac[SUBSET_FINITE, FINITE_COUNT] >>
16447 qexists_tac `perm_set x` >>
16448 simp[feq_partition_element, list_count_element, perm_set_element] >>
16449 rpt strip_tac >| [
16450 qabbrev_tac `ls = SET_TO_LIST x` >>
16451 qexists_tac `ls` >>
16452 `ALL_DISTINCT ls` by rw[ALL_DISTINCT_SET_TO_LIST, Abbr`ls`] >>
16453 `set ls = x` by rw[SET_TO_LIST_INV, Abbr`ls`] >>
16454 `LENGTH ls = k` by rw[SET_TO_LIST_CARD, Abbr`ls`] >>
16455 rw[EQ_IMP_THM] >>
16456 metis_tac[ALL_DISTINCT_CARD_LIST_TO_SET],
16457 `perm_set x <> {}` by fs[perm_set_not_empty] >>
16458 qabbrev_tac `ls = CHOICE (perm_set x)` >>
16459 `ls IN perm_set x` by fs[CHOICE_DEF, Abbr`ls`] >>
16460 fs[perm_set_element]
16461 ]
16462QED
16463
16464(* Theorem: BIJ (set o CHOICE) (partition (feq set) (list_count n k)) (sub_count n k) *)
16465(* Proof:
16466 Let f = set o CHOICE,
16467 s = partition (feq set) (list_count n k),
16468 t = sub_count n k.
16469 Note INJ f s t by list_count_set_map_inj
16470 and SURJ f s t by list_count_set_map_surj
16471 so BIJ f s t by BIJ_DEF
16472*)
16473Theorem list_count_set_map_bij:
16474 !n k. BIJ (set o CHOICE) (partition (feq set) (list_count n k)) (sub_count n k)
16475Proof
16476 simp[BIJ_DEF, list_count_set_map_inj, list_count_set_map_surj]
16477QED
16478
16479(* Theorem: n arrange k = (n choose k) * perm k *)
16480(* Proof:
16481 Let R = feq set,
16482 s = list_count n k,
16483 t = sub_count n k.
16484 Then FINITE s by list_count_finite
16485 and R equiv_on s by feq_set_equiv
16486 and !e. e IN partition R s ==> CARD e = perm k
16487 by list_count_set_partititon_element_card
16488 Thus CARD s = perm k * CARD (partition R s)
16489 by equal_partition_card, [1]
16490 Note CARD s = n arrange k by arrange_def
16491 and BIJ (set o CHOICE) (partition R s) t
16492 by list_count_set_map_bij
16493 and FINITE t by sub_count_finite
16494 so CARD (partition R s)
16495 = CARD t by bij_eq_card
16496 = n choose k by choose_def
16497 Hence n arrange k = n choose k * perm k
16498 by MULT_COMM, [1], above.
16499*)
16500Theorem arrange_eqn[compute]:
16501 !n k. n arrange k = (n choose k) * perm k
16502Proof
16503 rpt strip_tac >>
16504 assume_tac list_count_set_map_bij >>
16505 last_x_assum (qspecl_then [`n`, `k`] strip_assume_tac) >>
16506 qabbrev_tac `R = feq (set :num list -> num -> bool)` >>
16507 qabbrev_tac `s = list_count n k` >>
16508 qabbrev_tac `t = sub_count n k` >>
16509 `FINITE s` by rw[list_count_finite, Abbr`s`] >>
16510 `R equiv_on s` by rw[feq_set_equiv, Abbr`R`] >>
16511 `!e. e IN partition R s ==> CARD e = perm k` by metis_tac[list_count_set_partititon_element_card] >>
16512 imp_res_tac equal_partition_card >>
16513 `FINITE t` by rw[sub_count_finite, Abbr`t`] >>
16514 `CARD (partition R s) = CARD t` by metis_tac[bij_eq_card] >>
16515 simp[arrange_def, choose_def, Abbr`s`, Abbr`t`]
16516QED
16517
16518(* This is P(n,k) = C(n,k) * k! *)
16519
16520(* Theorem: n arrange k = (n choose k) * FACT k *)
16521(* Proof:
16522 n arrange k
16523 = (n choose k) * perm k by arrange_eqn
16524 = (n choose k) * FACT k by perm_eq_fact
16525*)
16526Theorem arrange_alt:
16527 !n k. n arrange k = (n choose k) * FACT k
16528Proof
16529 simp[arrange_eqn, perm_eq_fact]
16530QED
16531
16532(*
16533> EVAL ``5 arrange 2``; = 20
16534> EVAL ``MAP ($arrange 5) [0 .. 5]``; = [1; 5; 20; 60; 120; 120]
16535*)
16536
16537(* Theorem: n arrange k = (binomial n k) * FACT k *)
16538(* Proof:
16539 n arrange k
16540 = (n choose k) * FACT k by arrange_alt
16541 = (binomial n k) * FACT k by choose_eqn
16542*)
16543Theorem arrange_formula:
16544 !n k. n arrange k = (binomial n k) * FACT k
16545Proof
16546 simp[arrange_alt, choose_eqn]
16547QED
16548
16549(* Theorem: k <= n ==> n arrange k = FACT n DIV FACT (n - k) *)
16550(* Proof:
16551 Note 0 < FACT (n - k) by FACT_LESS
16552 (n arrange k) * FACT (n - k)
16553 = (binomial n k) * FACT k * FACT (n - k) by arrange_formula
16554 = binomial n k * (FACT (n - k) * FACT k) by arithmetic
16555 = FACT n by binomial_formula2, k <= n
16556 Thus n arrange k = FACT n DIV FACT (n - k) by DIV_SOLVE
16557*)
16558Theorem arrange_formula2:
16559 !n k. k <= n ==> n arrange k = FACT n DIV FACT (n - k)
16560Proof
16561 rpt strip_tac >>
16562 `0 < FACT (n - k)` by rw[FACT_LESS] >>
16563 `(n arrange k) * FACT (n - k) = (binomial n k) * FACT k * FACT (n - k)` by rw[arrange_formula] >>
16564 `_ = binomial n k * (FACT (n - k) * FACT k)` by rw[] >>
16565 `_ = FACT n` by rw[binomial_formula2] >>
16566 simp[DIV_SOLVE]
16567QED
16568
16569(* Theorem: n arrange 0 = 1 *)
16570(* Proof:
16571 n arrange 0
16572 = CARD (list_count n 0) by arrange_def
16573 = CARD {[]} by list_count_n_0
16574 = 1 by CARD_SING
16575*)
16576Theorem arrange_n_0:
16577 !n. n arrange 0 = 1
16578Proof
16579 simp[arrange_def, perm_def, list_count_n_0]
16580QED
16581
16582(* Theorem: 0 < n ==> 0 arrange n = 0 *)
16583(* Proof:
16584 0 arrange n
16585 = CARD (list_count 0 n) by arrange_def
16586 = CARD {} by list_count_0_n, 0 < n
16587 = 0 by CARD_EMPTY
16588*)
16589Theorem arrange_0_n:
16590 !n. 0 < n ==> 0 arrange n = 0
16591Proof
16592 simp[arrange_def, perm_def, list_count_0_n]
16593QED
16594
16595(* Theorem: n arrange n = perm n *)
16596(* Proof:
16597 n arrange n
16598 = (binomial n n) * FACT n by arrange_formula
16599 = 1 * FACT n by binomial_n_n
16600 = perm n by perm_eq_fact
16601*)
16602Theorem arrange_n_n:
16603 !n. n arrange n = perm n
16604Proof
16605 simp[arrange_formula, binomial_n_n, perm_eq_fact]
16606QED
16607
16608(* Theorem: n arrange n = FACT n *)
16609(* Proof:
16610 n arrange n
16611 = (binomial n n) * FACT n by arrange_formula
16612 = 1 * FACT n by binomial_n_n
16613*)
16614Theorem arrange_n_n_alt:
16615 !n. n arrange n = FACT n
16616Proof
16617 simp[arrange_formula, binomial_n_n]
16618QED
16619
16620(* Theorem: n arrange k = 0 <=> n < k *)
16621(* Proof:
16622 Note FINITE (list_count n k) by list_count_finite
16623 n arrange k = 0
16624 <=> CARD (list_count n k) = 0 by arrange_def
16625 <=> list_count n k = {} by CARD_EQ_0
16626 <=> n < k by list_count_eq_empty
16627*)
16628Theorem arrange_eq_0:
16629 !n k. n arrange k = 0 <=> n < k
16630Proof
16631 metis_tac[arrange_def, list_count_eq_empty, list_count_finite, CARD_EQ_0]
16632QED
16633
16634(* Note:
16635
16636k-permutation recurrence?
16637
16638P(n,k) = C(n,k) * k!
16639P(n,0) = C(n,0) * 0! = 1
16640P(0,k+1) = C(0,k+1) * (k+1)! = 0
16641
16642C(n+1,k+1) = C(n,k) + C(n,k+1)
16643P(n+1,k+1)/(k+1)! = P(n,k)/k! + P(n,k+1)/(k+1)!
16644P(n+1,k+1) = (k+1) * P(n,k) + P(n,k+1)
16645P(n+1,k+1) = P(n,k) * (k + 1) + P(n,k+1)
16646
16647P(2,1) = 2: [0] [1]
16648P(2,2) = 2: [0,1] [1,0]
16649P(3,2) = 6: [0,1] [0,2] include 2: [0,2] [1,2] [2,0] [2,1]
16650 [1,0] [1,2] exclude 2: [0,1] [1,0]
16651 [2,0] [2,1]
16652P(3,2) = P(2,1) * 2 + P(2,2) = ([0][1],2 + 2,[0][1]) + to_lists {0,1}
16653P(4,3): include 3: P(3,2) * 3
16654 exclude 3: P(3,3)
16655
16656list_count (n+1) (k+1) = IMAGE (interleave k) (list_count n k) UNION list_count n (k + 1)
16657
16658closed?
16659https://math.stackexchange.com/questions/3060456/
16660using Pascal argument
16661
16662*)