rich_listScript.sml
1(* ===================================================================== *)
2(* FILE : rich_listScript.sml *)
3(* DESCRIPTION : Enriched Theory of Lists *)
4(* ===================================================================== *)
5Theory rich_list[bare]
6Ancestors
7 combin arithmetic prim_rec pred_set list pair
8Libs
9 HolKernel Parse boolLib BasicProvers numLib metisLib simpLib
10 markerLib TotalDefn listSimps[qualified]
11 pred_setSimps[qualified] dep_rewrite[qualified]
12
13(* conflict with boolTheory.EXISTS_DEF *)
14val EXISTS_DEF = listTheory.EXISTS_DEF
15
16val FILTER_APPEND = FILTER_APPEND_DISTRIB
17val REVERSE = REVERSE_SNOC_DEF
18val decide_tac = numLib.DECIDE_TAC;
19
20(* ------------------------------------------------------------------------ *)
21
22val list_ss = arith_ss ++ listSimps.LIST_ss ++ pred_setSimps.PRED_SET_ss
23val metis_tac = METIS_TAC
24val rw = SRW_TAC[numSimps.ARITH_ss]
25fun simp thl g ctxt =
26 ASM_SIMP_TAC (srw_ss_of ctxt ++ numSimps.ARITH_ss) thl g ctxt
27fun fs thl g ctxt =
28 FULL_SIMP_TAC (srw_ss_of ctxt ++ numSimps.ARITH_ss) thl g ctxt
29fun rfs thl g ctxt =
30 REV_FULL_SIMP_TAC (srw_ss_of ctxt ++ numSimps.ARITH_ss) thl g ctxt;
31val qabbrev_tac = Q.ABBREV_TAC;
32val qexists_tac = Q.EXISTS_TAC;
33val qspecl_then = Q.SPECL_THEN;
34val qid_spec_tac = Q.ID_SPEC_TAC;
35
36Theorem list_INDUCT[local]:
37 !P. P [] /\ (!l. P l ==> !x. P (CONS x l)) ==> !l. P l
38Proof
39 REWRITE_TAC [list_INDUCT]
40QED
41
42val LIST_INDUCT_TAC = INDUCT_THEN list_INDUCT ASSUME_TAC;
43val SNOC_INDUCT_TAC = Prim_rec.INDUCT_THEN SNOC_INDUCT ASSUME_TAC;
44
45fun wrap a = [a];
46val Rewr' = DISCH_THEN (ONCE_REWRITE_TAC o wrap);
47val Know = Q_TAC KNOW_TAC;
48val Suff = Q_TAC SUFF_TAC;
49
50(* ------------------------------------------------------------------------ *)
51
52Definition ELL:
53 (ELL 0 l = LAST l) /\
54 (ELL (SUC n) l = ELL n (FRONT l))
55End
56
57Definition REPLICATE[simp]:
58 (REPLICATE 0 x = []) /\
59 (REPLICATE (SUC n) x = CONS x (REPLICATE n x))
60End
61
62Definition SCANL:
63 (SCANL f (e: 'b) [] = [e]) /\
64 (SCANL f e (CONS x l) = CONS e (SCANL f (f e x) l))
65End
66
67Definition SCANR:
68 (SCANR f (e: 'b) [] = [e]) /\
69 (SCANR f e (CONS x l) = CONS (f x (HD (SCANR f e l))) (SCANR f e l))
70End
71
72Definition SPLITP[nocompute]:
73 (SPLITP P [] = ([],[])) /\
74 (SPLITP P (CONS x l) =
75 if P x then
76 ([], CONS x l)
77 else
78 (CONS x (FST (SPLITP P l)), SND (SPLITP P l)))
79End
80
81Theorem SPLITP_splitAtPki:
82 SPLITP P = splitAtPki (K P) $,
83Proof
84 simp[FUN_EQ_THM] >> Induct >> simp[SPLITP,splitAtPki_def] >>
85 rw[o_DEF] >> Q.HO_MATCH_ABBREV_TAC`f (splitAtPki (K P) $, x) = _` >>
86 CONV_TAC(LAND_CONV(REWRITE_CONV[splitAtPki_RAND])) >>
87 simp[Abbr‘f’, o_DEF]
88QED
89
90Theorem SPLITP_JOIN:
91 !ls l r.
92 (SPLITP P ls = (l, r)) ==> (ls = l ++ r)
93Proof
94 Induct >> rw[SPLITP] >> Cases_on `SPLITP P ls` >> rw[]
95QED
96
97Theorem SPLITP_IMP:
98 !P ls l r.
99 (SPLITP P ls = (l,r)) ==>
100 EVERY ($~ o P) l /\ (~NULL r ==> P (HD r))
101Proof
102 Induct_on`ls` >> rw[SPLITP] >> rw[] >> fs[] >>
103 Cases_on`SPLITP P ls` >> fs[]
104QED
105
106Theorem SPLITP_LENGTH:
107 !l. LENGTH (FST (SPLITP P l)) + LENGTH (SND (SPLITP P l))
108 = LENGTH l
109Proof Induct \\ rw[SPLITP, LENGTH]
110QED
111
112Theorem SPLITP_APPEND:
113 !l1 l2.
114 SPLITP P (l1 ++ l2) =
115 if EXISTS P l1 then
116 (FST (SPLITP P l1), SND (SPLITP P l1) ++ l2)
117 else
118 (l1 ++ FST(SPLITP P l2), SND (SPLITP P l2))
119Proof
120 Induct \\ rw[SPLITP] \\ fs[]
121QED
122
123Theorem SPLITP_NIL_SND_EVERY:
124 !ls r. (SPLITP P ls = (r, [])) <=> (r = ls) /\ (EVERY ($~ o P) ls)
125Proof
126 rw[] >> EQ_TAC
127 >- (rw[] >> imp_res_tac SPLITP_IMP >> imp_res_tac SPLITP_JOIN >> fs[]) >>
128 rw[] >> Induct_on `ls` >> rw[SPLITP]
129QED
130
131Theorem SPLITP_NIL_FST_IMP:
132 !ls r. (SPLITP P ls = ([],r)) ==> (r = ls)
133Proof Induct \\ rw[SPLITP]
134QED
135
136Definition SPLITL_def: SPLITL P = SPLITP ((~) o P)
137End
138
139Definition SPLITR_def:
140 SPLITR P l =
141 let (a, b) = SPLITP ((~) o P) (REVERSE l) in (REVERSE b, REVERSE a)
142End
143
144Definition PREFIX_DEF: PREFIX P l = FST (SPLITP ($~ o P) l)
145End
146
147Definition SUFFIX_DEF:
148 SUFFIX P l = FOLDL (\l' x. if P x then SNOC x l' else []) [] l
149End
150
151Definition AND_EL_DEF: AND_EL = EVERY I
152End
153Definition OR_EL_DEF: OR_EL = EXISTS I
154End
155
156Definition UNZIP_FST_DEF: UNZIP_FST l = FST (UNZIP l)
157End
158Definition UNZIP_SND_DEF: UNZIP_SND l = SND (UNZIP l)
159End
160
161Definition LIST_ELEM_COUNT_DEF:
162 LIST_ELEM_COUNT e l = LENGTH (FILTER (\x. x = e) l)
163End
164
165Definition COUNT_LIST_def[nocompute]:
166 (COUNT_LIST 0 = []) /\
167 (COUNT_LIST (SUC n) = 0::MAP SUC (COUNT_LIST n))
168End
169
170Definition COUNT_LIST_AUX_def:
171 (COUNT_LIST_AUX 0 l = l) /\
172 (COUNT_LIST_AUX (SUC n) l = COUNT_LIST_AUX n (n::l))
173End
174
175(* ------------------------------------------------------------------------ *)
176
177Theorem TAKE:
178 (!l:'a list. TAKE 0 l = []) /\
179 (!n x l:'a list. TAKE (SUC n) (CONS x l) = CONS x (TAKE n l))
180Proof
181 SRW_TAC [] []
182QED
183
184Theorem DROP:
185 (!l:'a list. DROP 0 l = l) /\
186 (!n x l:'a list. DROP (SUC n) (CONS x l) = DROP n l)
187Proof
188 SRW_TAC [] []
189QED
190
191Theorem FUNPOW_TL_NIL[simp]:
192 FUNPOW TL n [] = []
193Proof
194 Induct_on ‘n’ >> simp[FUNPOW_SUC]
195QED
196
197Theorem DROP_FUNPOW_TL:
198 !n l. DROP n l = FUNPOW TL n l
199Proof
200 Induct THEN1 SIMP_TAC list_ss [DROP, FUNPOW]
201 THEN Cases_on `l` THEN1 simp[DROP_def]
202 THEN simp[DROP, FUNPOW]
203QED
204
205Theorem NOT_NULL_SNOC[simp]:
206 !x l. ~NULL (SNOC x l)
207Proof
208 BasicProvers.Induct_on `l`
209 THEN REWRITE_TAC[SNOC, NULL_DEF]
210QED
211
212(* cf. CONS_ACYCLIC *)
213Theorem SNOC_ACYCLIC[simp] :
214 l <> SNOC x l /\ SNOC x l <> l
215Proof
216 SRW_TAC [] [SNOC_APPEND]
217QED
218
219(* ------------------------------------------------------------------------ *)
220
221Definition LASTN_def[nocompute]:
222 LASTN n xs = REVERSE (TAKE n (REVERSE xs))
223End
224
225Theorem LASTN:
226 (!l. LASTN 0 l = []) /\
227 (!n x l. LASTN (SUC n) (SNOC x l) = SNOC x (LASTN n l))
228Proof
229 FULL_SIMP_TAC std_ss [LASTN_def,REVERSE_SNOC,
230 TAKE,REVERSE_DEF]
231 THEN FULL_SIMP_TAC std_ss [SNOC_APPEND]
232QED
233
234Theorem SNOC_LASTN :
235 !l x n. LASTN (SUC n) (SNOC x l) = SNOC x (LASTN n l)
236Proof
237 SNOC_INDUCT_TAC >> REWRITE_TAC [LASTN]
238QED
239
240Definition BUTLASTN_def[nocompute]:
241 BUTLASTN n xs = REVERSE (DROP n (REVERSE xs))
242End
243
244Theorem BUTLASTN:
245 (!l. BUTLASTN 0 l = l) /\
246 (!n x l. BUTLASTN (SUC n) (SNOC x l) = BUTLASTN n l)
247Proof
248 FULL_SIMP_TAC std_ss [BUTLASTN_def,DROP,
249 REVERSE_REVERSE,REVERSE_SNOC]
250QED
251
252local
253 val is_sublist_thm = Prim_rec.prove_rec_fn_exists list_Axiom
254 ``(is_sublist [] (l: 'a list) = (if NULL l then T else F)) /\
255 (is_sublist (CONS x t) l =
256 if NULL l then T
257 else (x = HD l) /\ isPREFIX (TL l) t \/ is_sublist t l)``
258 val tac = ASM_REWRITE_TAC [HD, TL, NULL_DEF]
259 val is_sublist_exists = Q.prove(
260 `?is_sublist.
261 (!l:'a list. is_sublist l [] <=> T) /\
262 (!x: 'a l. is_sublist [] (CONS x l) <=> F) /\
263 (!x1 l1 x2 l2.
264 is_sublist (CONS x1 l1) (CONS x2 l2) <=>
265 (x1 = x2) /\ isPREFIX l2 l1 \/ is_sublist l1 (CONS x2 l2))`,
266 STRIP_ASSUME_TAC is_sublist_thm
267 THEN Q.EXISTS_TAC `is_sublist`
268 THEN tac THEN BasicProvers.Induct THEN tac)
269in
270 val IS_SUBLIST = Definition.new_specification
271 ("IS_SUBLIST", ["IS_SUBLIST"], is_sublist_exists)
272end;
273
274local
275 val seg_exists = Q.prove(
276 `?SEG.
277 (!k (l:'a list). SEG 0 k l = []) /\
278 (!m x l. SEG (SUC m) 0 (CONS x l) = CONS x (SEG m 0 l)) /\
279 (!m k x l. SEG (SUC m) (SUC k) (CONS x l) = SEG (SUC m) k l)`,
280 Q.EXISTS_TAC
281 `\m k (l: 'a list). (TAKE: num -> 'a list -> 'a list) m
282 ((DROP: num -> 'a list -> 'a list) k l)`
283 THEN SIMP_TAC bool_ss [TAKE, DROP])
284in
285 val SEG = Definition.new_specification ("SEG", ["SEG"], seg_exists)
286end;
287
288local
289 val is_suffix_thm = Prim_rec.prove_rec_fn_exists SNOC_Axiom
290 ``(is_suffix l [] = T) /\
291 (is_suffix l (SNOC x t) =
292 if NULL l then F else (LAST l = x) /\ is_suffix (FRONT l) t)``
293 val is_suffix_exists = Q.prove(
294 `?is_suffix.
295 (!l. is_suffix l [] <=> T) /\
296 (!(x:'a) l. is_suffix [] (SNOC x l) <=> F) /\
297 (!(x1:'a) l1 (x2:'a) l2.
298 is_suffix (SNOC x1 l1) (SNOC x2 l2) <=>
299 (x1 = x2) /\ is_suffix l1 l2)`,
300 METIS_TAC [is_suffix_thm, FRONT_SNOC, LAST_SNOC,
301 NULL_DEF, NOT_NULL_SNOC])
302in
303 val IS_SUFFIX = Definition.new_specification
304 ("IS_SUFFIX", ["IS_SUFFIX"], is_suffix_exists)
305end;
306
307Overload IS_PREFIX = ``\x y. isPREFIX y x``
308val _ = remove_ovl_mapping "<<=" {Name = "isPREFIX", Thy = "list"}
309Overload "<<=" = ``\x y. isPREFIX x y``
310(* second call makes the infix the preferred printing form *)
311
312(* ======================================================================== *)
313
314Theorem LENGTH_NOT_NULL:
315 !l. 0 < LENGTH l <=> ~NULL l
316Proof
317 BasicProvers.Induct THEN REWRITE_TAC [LENGTH, NULL, NOT_LESS_0, LESS_0]
318QED
319
320(* |- !(x:'a) l. ~([] = SNOC x l) *)
321Theorem NOT_NIL_SNOC[simp] =
322 valOf (hd (Prim_rec.prove_constructors_distinct SNOC_Axiom))
323
324Theorem NOT_SNOC_NIL[simp] = GSYM NOT_NIL_SNOC
325
326Theorem SNOC_EQ_LENGTH_EQ:
327 !x1 l1 x2 l2. (SNOC x1 l1 = SNOC x2 l2) ==> (LENGTH l1 = LENGTH l2)
328Proof
329 REPEAT STRIP_TAC
330 THEN RULE_ASSUM_TAC (AP_TERM ``LENGTH``)
331 THEN RULE_ASSUM_TAC
332 (REWRITE_RULE [LENGTH_SNOC, LENGTH, EQ_MONO_ADD_EQ, ADD1])
333 THEN FIRST_ASSUM ACCEPT_TAC
334QED
335
336(* |- !x l. SNOC x l = REVERSE (x::REVERSE l) *)
337Theorem SNOC_REVERSE_CONS =
338 GEN_ALL (REWRITE_RULE [REVERSE_REVERSE]
339 (AP_TERM ``REVERSE`` (SPEC_ALL REVERSE_SNOC)));
340
341Theorem FOLDR_SNOC:
342 !f e x l. FOLDR f e (SNOC x l) = FOLDR f (f x e) l
343Proof
344 REPEAT (FILTER_GEN_TAC ``l: 'a list``)
345 THEN BasicProvers.Induct
346 THEN REWRITE_TAC [SNOC, FOLDR]
347 THEN REPEAT GEN_TAC
348 THEN ASM_REWRITE_TAC []
349QED
350
351Theorem FOLDR_FOLDL:
352 !f e. MONOID f e ==> !l. FOLDR f e l = FOLDL f e l
353Proof
354 REPEAT GEN_TAC
355 THEN REWRITE_TAC [MONOID_DEF, ASSOC_DEF, LEFT_ID_DEF, RIGHT_ID_DEF]
356 THEN STRIP_TAC
357 THEN BasicProvers.Induct
358 THEN REWRITE_TAC [FOLDL, FOLDR]
359 THEN FIRST_ASSUM SUBST1_TAC
360 THEN GEN_TAC
361 THEN SPEC_TAC (``l:'a list``, ``l:'a list``)
362 THEN SNOC_INDUCT_TAC
363 THEN1 ASM_REWRITE_TAC [FOLDL]
364 THEN PURE_ONCE_REWRITE_TAC [FOLDL_SNOC]
365 THEN GEN_TAC
366 THEN ASM_REWRITE_TAC []
367QED
368
369Theorem LENGTH_FOLDR:
370 !l. LENGTH l = FOLDR (\x l'. SUC l') 0 l
371Proof
372 BasicProvers.Induct
373 THEN REWRITE_TAC [LENGTH, FOLDR]
374 THEN CONV_TAC (ONCE_DEPTH_CONV BETA_CONV)
375 THEN ASM_REWRITE_TAC []
376QED
377
378Theorem LENGTH_FOLDL:
379 !l. LENGTH l = FOLDL (\l' x. SUC l') 0 l
380Proof
381 SNOC_INDUCT_TAC
382 THEN REWRITE_TAC [LENGTH_SNOC, FOLDL_SNOC]
383 THEN1 REWRITE_TAC [LENGTH, FOLDL]
384 THEN CONV_TAC (ONCE_DEPTH_CONV BETA_CONV)
385 THEN CONV_TAC (ONCE_DEPTH_CONV BETA_CONV)
386 THEN ASM_REWRITE_TAC []
387QED
388
389Theorem MAP_FOLDR:
390 !f l. MAP f l = FOLDR (\x l'. CONS (f x) l') [] l
391Proof
392 BasicProvers.Induct_on `l`
393 THEN REWRITE_TAC [MAP, FOLDR]
394 THEN GEN_TAC
395 THEN CONV_TAC (DEPTH_CONV BETA_CONV)
396 THEN ASM_REWRITE_TAC []
397QED
398
399Theorem MAP_FOLDL:
400 !f l. MAP f l = FOLDL (\l' x. SNOC (f x) l') [] l
401Proof
402 GEN_TAC
403 THEN SNOC_INDUCT_TAC
404 THEN REWRITE_TAC [MAP_SNOC, FOLDL_SNOC]
405 THEN1 REWRITE_TAC [FOLDL, MAP]
406 THEN FIRST_ASSUM (SUBST1_TAC o SYM)
407 THEN CONV_TAC (DEPTH_CONV BETA_CONV)
408 THEN GEN_TAC
409 THEN REFL_TAC
410QED
411
412Theorem FOLDL_CONG_invariant:
413 !P f1 f2 l e.
414 P e /\
415 (!x a. MEM x l /\ P a ==> f1 a x = f2 a x /\ P (f2 a x))
416 ==>
417 FOLDL f1 e l = FOLDL f2 e l /\ P (FOLDL f2 e l)
418Proof
419 ntac 3 gen_tac \\ Induct \\ rw[]
420QED
421
422Theorem FILTER_FOLDR:
423 !P l. FILTER P l = FOLDR (\x l'. if P x then CONS x l' else l') [] l
424Proof
425 BasicProvers.Induct_on `l`
426 THEN REWRITE_TAC [FILTER, FOLDR]
427 THEN CONV_TAC (DEPTH_CONV BETA_CONV)
428 THEN ASM_REWRITE_TAC []
429QED
430
431Theorem FILTER_SNOC:
432 !P x l.
433 FILTER P (SNOC x l) = if P x then SNOC x (FILTER P l) else FILTER P l
434Proof
435 BasicProvers.Induct_on `l`
436 THEN REWRITE_TAC [FILTER, SNOC]
437 THEN REPEAT GEN_TAC
438 THEN REPEAT COND_CASES_TAC
439 THEN ASM_REWRITE_TAC [SNOC]
440QED
441
442Theorem FILTER_FOLDL:
443 !P l. FILTER P l = FOLDL (\l' x. if P x then SNOC x l' else l') [] l
444Proof
445 GEN_TAC
446 THEN SNOC_INDUCT_TAC
447 THEN1 REWRITE_TAC [FILTER, FOLDL]
448 THEN REWRITE_TAC [FILTER_SNOC, FOLDL_SNOC]
449 THEN CONV_TAC (DEPTH_CONV BETA_CONV)
450 THEN ASM_REWRITE_TAC []
451QED
452
453Theorem FILTER_COMM:
454 !f1 f2 l. FILTER f1 (FILTER f2 l) = FILTER f2 (FILTER f1 l)
455Proof
456 NTAC 2 GEN_TAC
457 THEN BasicProvers.Induct
458 THEN REWRITE_TAC [FILTER]
459 THEN GEN_TAC
460 THEN REPEAT COND_CASES_TAC
461 THEN ASM_REWRITE_TAC [FILTER]
462QED
463
464Theorem FILTER_IDEM:
465 !f l. FILTER f (FILTER f l) = FILTER f l
466Proof
467 BasicProvers.Induct_on `l`
468 THEN REWRITE_TAC [FILTER]
469 THEN REPEAT GEN_TAC
470 THEN COND_CASES_TAC
471 THEN ASM_REWRITE_TAC [FILTER]
472QED
473
474Theorem FILTER_MAP:
475 !f1 f2 l. FILTER f1 (MAP f2 l) = MAP f2 (FILTER (f1 o f2) l)
476Proof
477 BasicProvers.Induct_on `l`
478 THEN REWRITE_TAC [FILTER, MAP]
479 THEN REPEAT GEN_TAC
480 THEN PURE_ONCE_REWRITE_TAC [combinTheory.o_THM]
481 THEN COND_CASES_TAC
482 THEN ASM_REWRITE_TAC [FILTER, MAP]
483QED
484
485Theorem LENGTH_FILTER_LEQ:
486 !P l. LENGTH (FILTER P l) <= LENGTH l
487Proof
488 BasicProvers.Induct_on `l`
489 THEN SRW_TAC [] [numLib.DECIDE ``!a b. a <= b ==> a <= SUC b``]
490QED
491
492Theorem EL_FILTER[local]:
493 !i l P. i < LENGTH (FILTER P l) ==> P (EL i (FILTER P l))
494Proof
495 BasicProvers.Induct_on `l`
496 THEN SRW_TAC [] []
497 THEN Cases_on `i`
498 THEN SRW_TAC [numSimps.ARITH_ss] []
499QED
500
501Theorem FILTER_EQ_lem[local]:
502 !l l2 P h. ~P h ==> (FILTER P l <> h :: l2)
503Proof
504 SRW_TAC [] [LIST_EQ_REWRITE]
505 THEN Q.EXISTS_TAC `0`
506 THEN SRW_TAC [numSimps.ARITH_ss] []
507 THEN `0 < LENGTH (FILTER P l)` by numLib.DECIDE_TAC
508 THEN IMP_RES_TAC EL_FILTER
509 THEN FULL_SIMP_TAC (srw_ss()) []
510 THEN metisLib.METIS_TAC []
511QED
512
513Theorem FILTER_EQ:
514 !P1 P2 l. (FILTER P1 l = FILTER P2 l) = (!x. MEM x l ==> (P1 x = P2 x))
515Proof
516 Induct_on `l`
517 THEN SRW_TAC [] []
518 THEN metisLib.METIS_TAC [FILTER_EQ_lem]
519QED
520
521Theorem LENGTH_SEG:
522 !n k l. n + k <= LENGTH l ==> (LENGTH (SEG n k l) = n)
523Proof
524 NTAC 2 BasicProvers.Induct
525 THEN REWRITE_TAC [SEG, LENGTH]
526 THEN BasicProvers.Induct
527 THENL [
528 REWRITE_TAC [LENGTH, ADD_0, LESS_OR_EQ, numTheory.NOT_SUC, NOT_LESS_0],
529 REWRITE_TAC [SEG, LENGTH, ADD, LESS_EQ_MONO, INV_SUC_EQ]
530 THEN FIRST_ASSUM (MATCH_ACCEPT_TAC o (SPEC ``0n``)),
531 REWRITE_TAC [LENGTH, ADD, LESS_OR_EQ, numTheory.NOT_SUC, NOT_LESS_0],
532 REWRITE_TAC [LENGTH, SEG, GSYM ADD_SUC, LESS_EQ_MONO]
533 THEN FIRST_ASSUM MATCH_ACCEPT_TAC]
534QED
535
536Theorem APPEND_NIL:
537 (!l. APPEND l [] = l) /\ (!l. APPEND [] l = l)
538Proof
539 CONJ_TAC THENL [BasicProvers.Induct, ALL_TAC] THEN ASM_REWRITE_TAC [APPEND]
540QED
541
542Theorem APPEND_FOLDR:
543 !l1 l2. APPEND l1 l2 = FOLDR CONS l2 l1
544Proof
545 BasicProvers.Induct THEN ASM_REWRITE_TAC [APPEND, FOLDR]
546QED
547
548Theorem APPEND_FOLDL:
549 !l1 l2. APPEND l1 l2 = FOLDL (\l' x. SNOC x l') l1 l2
550Proof
551 GEN_TAC
552 THEN SNOC_INDUCT_TAC
553 THEN1 REWRITE_TAC [APPEND_NIL, FOLDL]
554 THEN ASM_REWRITE_TAC [APPEND_SNOC, FOLDL_SNOC]
555 THEN GEN_TAC
556 THEN CONV_TAC (DEPTH_CONV BETA_CONV)
557 THEN REFL_TAC
558QED
559
560Theorem FOLDR_APPEND:
561 !f e l1 l2. FOLDR f e (APPEND l1 l2) = FOLDR f (FOLDR f e l2) l1
562Proof
563 REPEAT GEN_TAC
564 THEN MAP_EVERY Q.SPEC_TAC
565 [(`l1`, `l1`), (`e`, `e`), (`f`, `f`), (`l2`, `l2`)]
566 THEN SNOC_INDUCT_TAC
567 THEN1 REWRITE_TAC [APPEND_NIL, FOLDR]
568 THEN REWRITE_TAC [APPEND_SNOC, FOLDR_SNOC]
569 THEN REPEAT GEN_TAC
570 THEN FIRST_ASSUM MATCH_ACCEPT_TAC
571QED
572
573Theorem FOLDL_APPEND:
574 !f e l1 l2. FOLDL f e (APPEND l1 l2) = FOLDL f (FOLDL f e l1) l2
575Proof
576 BasicProvers.Induct_on `l1`
577 THEN REWRITE_TAC [APPEND, FOLDL]
578 THEN REPEAT GEN_TAC
579 THEN FIRST_ASSUM MATCH_ACCEPT_TAC
580QED
581
582Theorem CONS_APPEND:
583 !x l. CONS x l = APPEND [x] l
584Proof
585 GEN_TAC
586 THEN SNOC_INDUCT_TAC
587 THEN1 REWRITE_TAC [APPEND_NIL]
588 THEN ASM_REWRITE_TAC [APPEND_SNOC, GSYM (CONJUNCT2 SNOC)]
589QED
590
591Theorem ASSOC_APPEND:
592 ASSOC APPEND
593Proof
594 REWRITE_TAC [ASSOC_DEF, APPEND_ASSOC]
595QED
596
597Theorem RIGHT_ID_APPEND_NIL[local]:
598 RIGHT_ID APPEND []
599Proof
600 REWRITE_TAC [RIGHT_ID_DEF, APPEND, APPEND_NIL]
601QED
602
603Theorem LEFT_ID_APPEND_NIL[local]:
604 LEFT_ID APPEND []
605Proof
606 REWRITE_TAC [LEFT_ID_DEF, APPEND, APPEND_NIL]
607QED
608
609Theorem MONOID_APPEND_NIL:
610 MONOID APPEND []
611Proof
612 REWRITE_TAC [MONOID_DEF, APPEND, APPEND_NIL, APPEND_ASSOC, LEFT_ID_DEF,
613 ASSOC_DEF, RIGHT_ID_DEF]
614QED
615
616Theorem FLAT_SNOC:
617 !x l. FLAT (SNOC x l) = APPEND (FLAT l) x
618Proof
619 BasicProvers.Induct_on `l`
620 THEN ASM_REWRITE_TAC [FLAT, SNOC, APPEND, APPEND_NIL, APPEND_ASSOC]
621QED
622
623Theorem FLAT_FOLDR:
624 !l. FLAT l = FOLDR APPEND [] l
625Proof
626 BasicProvers.Induct THEN ASM_REWRITE_TAC [FLAT, FOLDR]
627QED
628
629Theorem FLAT_FOLDL:
630 !l. FLAT l = FOLDL APPEND [] l
631Proof
632 SNOC_INDUCT_TAC
633 THEN1 REWRITE_TAC [FLAT, FOLDL]
634 THEN ASM_REWRITE_TAC [FLAT_SNOC, FOLDL_SNOC]
635QED
636
637Theorem LENGTH_FLAT:
638 !l. LENGTH (FLAT l) = SUM (MAP LENGTH l)
639Proof
640 BasicProvers.Induct
641 THEN REWRITE_TAC [FLAT]
642 THEN1 REWRITE_TAC [LENGTH, MAP, SUM]
643 THEN ASM_REWRITE_TAC [LENGTH_APPEND, MAP, SUM]
644QED
645
646Theorem REVERSE_FOLDR:
647 !l. REVERSE l = FOLDR SNOC [] l
648Proof
649 BasicProvers.Induct THEN ASM_REWRITE_TAC [REVERSE, FOLDR]
650QED
651
652Theorem REVERSE_FOLDL:
653 !l. REVERSE l = FOLDL (\l' x. CONS x l') [] l
654Proof
655 SNOC_INDUCT_TAC
656 THEN1 REWRITE_TAC [REVERSE, FOLDL]
657 THEN REWRITE_TAC [REVERSE_SNOC, FOLDL_SNOC]
658 THEN CONV_TAC (DEPTH_CONV BETA_CONV)
659 THEN ASM_REWRITE_TAC []
660QED
661
662Theorem ALL_EL_MAP:
663 !P f l. EVERY P (MAP f l) = EVERY (P o f) l
664Proof
665 BasicProvers.Induct_on `l`
666 THEN REWRITE_TAC [EVERY_DEF, MAP]
667 THEN ASM_REWRITE_TAC [combinTheory.o_DEF]
668 THEN BETA_TAC
669 THEN REWRITE_TAC []
670QED
671
672Theorem MEM_EXISTS:
673 !x:'a l. MEM x l = EXISTS ($= x) l
674Proof
675 Induct_on `l` THEN ASM_REWRITE_TAC [EXISTS_DEF, MEM]
676QED
677
678Theorem SUM_FOLDR:
679 !l. SUM l = FOLDR $+ 0 l
680Proof
681 BasicProvers.Induct
682 THEN REWRITE_TAC [SUM, FOLDR, ADD]
683 THEN GEN_TAC
684 THEN CONV_TAC (DEPTH_CONV BETA_CONV)
685 THEN FIRST_ASSUM SUBST1_TAC
686 THEN REFL_TAC
687QED
688
689Theorem SUM_FOLDL:
690 !l. SUM l = FOLDL $+ 0 l
691Proof
692 SNOC_INDUCT_TAC
693 THEN1 REWRITE_TAC [SUM, FOLDL]
694 THEN REWRITE_TAC [SUM_SNOC, FOLDL_SNOC]
695 THEN GEN_TAC
696 THEN CONV_TAC (DEPTH_CONV BETA_CONV)
697 THEN FIRST_ASSUM SUBST1_TAC
698 THEN REFL_TAC
699QED
700
701(*
702 |- (!l. [] <<= l <=> T) /\ (!x l. x::l <<= [] <=> F) /\
703 !x1 l1 x2 l2. x2::l2 <<= x1::l1 <=> (x1 = x2) /\ l2 <<= l1``
704*)
705Theorem IS_PREFIX = (
706 let
707 val [c1, c2, c3] = CONJUNCTS isPREFIX_THM
708 in
709 LIST_CONJ [GEN ``l:'a list`` c1,
710 (CONV_RULE (RENAME_VARS_CONV ["x", "l"]) o
711 GENL [``h:'a``, ``t:'a list``]) c2,
712 (CONV_RULE (RENAME_VARS_CONV ["x1", "l1", "x2", "l2"]) o
713 GENL [``h2:'a``, ``t2:'a list``, ``h1:'a``, ``t1:'a list``] o
714 CONV_RULE (RAND_CONV (ONCE_REWRITE_CONV [EQ_SYM_EQ])))
715 c3]
716 end)
717
718Theorem IS_PREFIX_APPEND:
719 !l1 l2. isPREFIX l2 l1 = ?l. l1 = APPEND l2 l
720Proof
721 BasicProvers.Induct
722 THENL [
723 BasicProvers.Induct
724 THENL [
725 REWRITE_TAC [IS_PREFIX, APPEND]
726 THEN Q.EXISTS_TAC `[]`
727 THEN REFL_TAC,
728 REWRITE_TAC [IS_PREFIX, APPEND, GSYM NOT_CONS_NIL]],
729 BasicProvers.Induct_on `l2`
730 THENL [
731 REWRITE_TAC [IS_PREFIX, APPEND]
732 THEN GEN_TAC
733 (* **list_Axiom** variable dependancy *)
734 THEN Q.EXISTS_TAC `CONS h l1`
735 THEN REFL_TAC,
736 ASM_REWRITE_TAC [IS_PREFIX, APPEND, CONS_11]
737 THEN REPEAT GEN_TAC
738 THEN CONV_TAC (RAND_CONV EXISTS_AND_CONV)
739 THEN REFL_TAC]]
740QED
741
742Theorem IS_SUFFIX_APPEND:
743 !l1 l2. IS_SUFFIX l1 l2 = ?l. l1 = APPEND l l2
744Proof
745 SNOC_INDUCT_TAC THENL [
746 SNOC_INDUCT_TAC THENL [
747 REWRITE_TAC [IS_SUFFIX, APPEND_NIL]
748 THEN EXISTS_TAC ``[]:'a list`` THEN REFL_TAC,
749 REWRITE_TAC [IS_SUFFIX, APPEND_SNOC]
750 THEN CONV_TAC (ONCE_DEPTH_CONV SYM_CONV)
751 THEN REWRITE_TAC [GSYM NULL_EQ, NOT_NULL_SNOC]],
752 GEN_TAC THEN SNOC_INDUCT_TAC THENL [
753 REWRITE_TAC [IS_SUFFIX, APPEND_NIL]
754 THEN EXISTS_TAC ``SNOC (x:'a) l1`` THEN REFL_TAC,
755 ASM_REWRITE_TAC [IS_SUFFIX, APPEND_SNOC, SNOC_11]
756 THEN GEN_TAC
757 THEN CONV_TAC (RAND_CONV EXISTS_AND_CONV) THEN REFL_TAC]]
758QED
759
760Theorem NOT_NIL_APPEND_CONS2[local]:
761 !l1 l2 x. ~([] = APPEND l1 (CONS x l2))
762Proof
763 BasicProvers.Induct THEN REWRITE_TAC [APPEND] THEN REPEAT GEN_TAC
764 THEN MATCH_ACCEPT_TAC (GSYM NOT_CONS_NIL)
765QED
766
767Theorem IS_SUBLIST_APPEND:
768 !l1 l2. IS_SUBLIST l1 l2 = ?l l'. l1 = APPEND l (APPEND l2 l')
769Proof
770 BasicProvers.Induct THEN REPEAT (FILTER_GEN_TAC ``l2:'a list``)
771 THEN BasicProvers.Induct THENL [
772 REWRITE_TAC [IS_SUBLIST, APPEND]
773 THEN MAP_EVERY EXISTS_TAC [``[]:'a list``, ``[]:'a list``]
774 THEN REWRITE_TAC [APPEND],
775 GEN_TAC THEN REWRITE_TAC [IS_SUBLIST, APPEND, NOT_NIL_APPEND_CONS2],
776 REWRITE_TAC [IS_SUBLIST, APPEND]
777 (* **list_Axiom** variable dependancy *)
778 THEN MAP_EVERY EXISTS_TAC [``[h]:'a list``, ``l1:'a list``]
779 THEN MATCH_ACCEPT_TAC CONS_APPEND,
780 GEN_TAC THEN REWRITE_TAC [IS_SUBLIST] THEN EQ_TAC
781 THEN ONCE_ASM_REWRITE_TAC [IS_PREFIX_APPEND] THENL [
782 STRIP_TAC THENL [
783 MAP_EVERY EXISTS_TAC [``[]:'a list``, ``l:'a list``]
784 THEN ASM_REWRITE_TAC [APPEND],
785 (* **list_Axiom** variable dependancy *)
786 MAP_EVERY EXISTS_TAC [``(CONS h l):'a list``, ``l':'a list``]
787 THEN ONCE_ASM_REWRITE_TAC [APPEND] THEN REFL_TAC],
788 CONV_TAC LEFT_IMP_EXISTS_CONV THEN BasicProvers.Induct THENL [
789 REWRITE_TAC [APPEND, CONS_11]
790 THEN STRIP_TAC THEN DISJ1_TAC
791 THEN ASM_REWRITE_TAC [IS_PREFIX_APPEND]
792 THEN EXISTS_TAC ``l':'a list`` THEN REFL_TAC,
793 GEN_TAC THEN REWRITE_TAC [APPEND, CONS_11]
794 THEN STRIP_TAC THEN DISJ2_TAC
795 THEN MAP_EVERY EXISTS_TAC [``l:'a list``, ``l':'a list``]
796 THEN FIRST_ASSUM ACCEPT_TAC]]]
797QED
798
799Theorem IS_PREFIX_IS_SUBLIST:
800 !l1 l2. IS_PREFIX l1 l2 ==> IS_SUBLIST l1 l2
801Proof
802 LIST_INDUCT_TAC
803 THEN TRY (FILTER_GEN_TAC ``l2:'a list``)
804 THEN LIST_INDUCT_TAC
805 THEN REWRITE_TAC [IS_PREFIX, IS_SUBLIST]
806 THEN REPEAT STRIP_TAC
807 THEN ASM_REWRITE_TAC []
808QED
809
810Theorem IS_SUFFIX_IS_SUBLIST:
811 !l1 l2. IS_SUFFIX l1 l2 ==> IS_SUBLIST l1 l2
812Proof
813 REPEAT GEN_TAC
814 THEN REWRITE_TAC [IS_SUFFIX_APPEND, IS_SUBLIST_APPEND]
815 THEN DISCH_THEN (CHOOSE_THEN SUBST1_TAC)
816 THEN MAP_EVERY EXISTS_TAC [``l:'a list``, ``[]:'a list``]
817 THEN REWRITE_TAC [APPEND_NIL]
818QED
819
820Theorem IS_SUFFIX_CONS:
821 !l1 l2 a. IS_SUFFIX l1 l2 ==> IS_SUFFIX (a::l1) l2
822Proof
823 srw_tac[][IS_SUFFIX_APPEND] >> Q.EXISTS_TAC ‘a::l’ >> srw_tac[][]
824QED
825
826Theorem IS_SUFFIX_APPEND1:
827 !l1 l2 l. IS_SUFFIX l2 l ==> IS_SUFFIX (l1 ++ l2) l
828Proof
829 Induct >> fs[IS_SUFFIX_CONS]
830QED
831
832Theorem IS_SUFFIX_TRANS:
833 !l1 l2 l3. IS_SUFFIX l1 l2 /\ IS_SUFFIX l2 l3 ==> IS_SUFFIX l1 l3
834Proof
835 rw[IS_SUFFIX_APPEND] \\ metis_tac[APPEND_ASSOC]
836QED
837
838Theorem NOT_NIL_APPEND_SNOC2[local]:
839 !l1 l2 x. ~([] = (APPEND l1 (SNOC x l2)))
840Proof
841 LIST_INDUCT_TAC
842 THEN REWRITE_TAC [APPEND_SNOC]
843 THEN REPEAT GEN_TAC
844 THEN MATCH_ACCEPT_TAC NOT_NIL_SNOC
845QED
846
847Theorem IS_PREFIX_REVERSE:
848 !l1 l2. IS_PREFIX (REVERSE l1) (REVERSE l2) = IS_SUFFIX l1 l2
849Proof
850 SNOC_INDUCT_TAC
851 THEN REPEAT (FILTER_GEN_TAC ``l2:'a list``)
852 THEN SNOC_INDUCT_TAC
853 THENL [
854 REWRITE_TAC [IS_SUFFIX_APPEND, REVERSE, IS_PREFIX]
855 THEN EXISTS_TAC ``[]:'a list``
856 THEN REWRITE_TAC [APPEND],
857 GEN_TAC
858 THEN REWRITE_TAC [IS_SUFFIX_APPEND, REVERSE, REVERSE_SNOC, IS_PREFIX]
859 THEN CONV_TAC NOT_EXISTS_CONV
860 THEN GEN_TAC
861 THEN REWRITE_TAC [APPEND, NOT_NIL_APPEND_SNOC2],
862 REWRITE_TAC [IS_SUFFIX_APPEND, REVERSE, APPEND_NIL, IS_PREFIX]
863 THEN EXISTS_TAC ``SNOC (x:'a) l1``
864 THEN REFL_TAC,
865 GEN_TAC
866 THEN REWRITE_TAC [IS_SUFFIX_APPEND, REVERSE_SNOC, IS_PREFIX]
867 THEN PURE_ONCE_ASM_REWRITE_TAC []
868 THEN REWRITE_TAC [IS_SUFFIX_APPEND, APPEND_SNOC, SNOC_11]
869 THEN CONV_TAC (ONCE_DEPTH_CONV EXISTS_AND_CONV)
870 THEN REFL_TAC]
871QED
872
873(* |- !l1 l2. IS_SUFFIX (REVERSE l1) (REVERSE l2) = IS_PREFIX l1 l2 *)
874Theorem IS_SUFFIX_REVERSE =
875 IS_PREFIX_REVERSE
876 |> SPECL [``REVERSE (l1:'a list)``, ``REVERSE (l2:'a list)``]
877 |> REWRITE_RULE [REVERSE_REVERSE]
878 |> SYM |> GEN_ALL;
879
880Theorem IS_SUFFIX_CONS2_E:
881 !s h t. IS_SUFFIX s (h::t) ==> IS_SUFFIX s t
882Proof
883 SRW_TAC [] [IS_SUFFIX_APPEND]
884 THEN metisLib.METIS_TAC [APPEND, APPEND_ASSOC]
885QED
886
887Theorem IS_SUFFIX_REFL[simp]:
888 !l. IS_SUFFIX l l
889Proof
890 SRW_TAC [][IS_SUFFIX_APPEND] THEN metisLib.METIS_TAC [APPEND]
891QED
892
893Theorem IS_SUBLIST_REVERSE:
894 !l1 l2. IS_SUBLIST (REVERSE l1) (REVERSE l2) = IS_SUBLIST l1 l2
895Proof
896 REPEAT GEN_TAC
897 THEN REWRITE_TAC [IS_SUBLIST_APPEND]
898 THEN EQ_TAC
899 THEN STRIP_TAC
900 THENL [
901 MAP_EVERY EXISTS_TAC [``REVERSE(l':'a list)``, ``REVERSE(l:'a list)``]
902 THEN FIRST_ASSUM (SUBST1_TAC o
903 (REWRITE_RULE [REVERSE_REVERSE, REVERSE_APPEND]) o
904 (AP_TERM ``REVERSE:'a list -> 'a list``))
905 THEN REWRITE_TAC [APPEND_ASSOC],
906 FIRST_ASSUM SUBST1_TAC
907 THEN REWRITE_TAC [REVERSE_APPEND, APPEND_ASSOC]
908 THEN MAP_EVERY EXISTS_TAC
909 [``REVERSE(l':'a list)``, ``REVERSE(l:'a list)``]
910 THEN REFL_TAC]
911QED
912
913Theorem PREFIX_FOLDR:
914 !P l. PREFIX P l = FOLDR (\x l'. if P x then CONS x l' else []) [] l
915Proof
916 GEN_TAC
917 THEN REWRITE_TAC [PREFIX_DEF]
918 THEN LIST_INDUCT_TAC
919 THEN REWRITE_TAC [FOLDR, SPLITP]
920 THEN GEN_TAC
921 THEN REWRITE_TAC [combinTheory.o_THM]
922 THEN BETA_TAC
923 (* **list_Axiom** variable dependancy *)
924 THEN ASM_CASES_TAC ``(P:'a->bool) x``
925 THEN ASM_REWRITE_TAC []
926QED
927
928Theorem PREFIX:
929 (!P. PREFIX P [] = []) /\
930 (!P x l. PREFIX P (CONS x l) = if P x then CONS x (PREFIX P l) else [])
931Proof
932 REWRITE_TAC [PREFIX_FOLDR, FOLDR]
933 THEN REPEAT GEN_TAC
934 THEN BETA_TAC
935 THEN REFL_TAC
936QED
937
938Theorem IS_PREFIX_PREFIX:
939 !P l. IS_PREFIX l (PREFIX P l)
940Proof
941 BasicProvers.Induct_on `l`
942 THEN REWRITE_TAC [IS_PREFIX, PREFIX]
943 THEN REPEAT GEN_TAC
944 THEN COND_CASES_TAC
945 THEN ASM_REWRITE_TAC [IS_PREFIX]
946QED
947
948Theorem LENGTH_SCANL:
949 !f e l. LENGTH (SCANL f e l) = SUC (LENGTH l)
950Proof
951 BasicProvers.Induct_on `l`
952 THEN REWRITE_TAC [SCANL, LENGTH]
953 THEN REPEAT GEN_TAC
954 THEN ASM_REWRITE_TAC []
955QED
956
957Theorem LENGTH_SCANR:
958 !f e l. LENGTH (SCANR f e l) = SUC (LENGTH l)
959Proof
960 BasicProvers.Induct_on `l`
961 THEN REWRITE_TAC [SCANR]
962 THEN CONV_TAC (ONCE_DEPTH_CONV pairLib.let_CONV)
963 THEN REPEAT GEN_TAC
964 THEN ASM_REWRITE_TAC [LENGTH]
965QED
966
967Theorem COMM_MONOID_FOLDL:
968 !f. COMM f ==> !e'. MONOID f e' ==> !e l. FOLDL f e l = f e (FOLDL f e' l)
969Proof
970 REWRITE_TAC [MONOID_DEF, ASSOC_DEF, LEFT_ID_DEF, COMM_DEF]
971 THEN REPEAT STRIP_TAC
972 THEN SPEC_TAC (``e:'a``,``e:'a``)
973 THEN SPEC_TAC (``l:'a list``,``l:'a list``)
974 THEN LIST_INDUCT_TAC
975 THEN PURE_ONCE_REWRITE_TAC [FOLDL]
976 THENL [
977 GEN_TAC THEN PURE_ONCE_ASM_REWRITE_TAC []
978 THEN FIRST_ASSUM (MATCH_ACCEPT_TAC o GSYM),
979 REPEAT GEN_TAC THEN POP_ASSUM (fn t => PURE_ONCE_REWRITE_TAC [t])
980 THEN POP_ASSUM (fn t => PURE_ONCE_REWRITE_TAC [t])
981 THEN FIRST_ASSUM (MATCH_ACCEPT_TAC o GSYM)]
982QED
983
984Theorem COMM_MONOID_FOLDR:
985 !f. COMM f ==> !e'. MONOID f e' ==> !e l. FOLDR f e l = f e (FOLDR f e' l)
986Proof
987 REWRITE_TAC [MONOID_DEF, ASSOC_DEF, LEFT_ID_DEF, COMM_DEF]
988 THEN GEN_TAC
989 THEN DISCH_THEN
990 (fn th_sym => GEN_TAC THEN DISCH_THEN
991 (fn th_assoc_etc =>
992 let
993 val th_assoc = CONJUNCT1 th_assoc_etc
994 val th_ident = CONJUNCT2(CONJUNCT2 th_assoc_etc)
995 in
996 GEN_TAC
997 THEN LIST_INDUCT_TAC
998 THEN PURE_ONCE_REWRITE_TAC [FOLDR] THENL [
999 PURE_ONCE_REWRITE_TAC [th_sym]
1000 THEN MATCH_ACCEPT_TAC (GSYM th_ident),
1001 REPEAT GEN_TAC THEN PURE_ONCE_ASM_REWRITE_TAC []
1002 THEN PURE_ONCE_REWRITE_TAC [th_ident]
1003 THEN PURE_ONCE_REWRITE_TAC [th_assoc]
1004 THEN AP_THM_TAC THEN AP_TERM_TAC
1005 THEN MATCH_ACCEPT_TAC (GSYM th_sym)]
1006 end))
1007QED
1008
1009Theorem FCOMM_FOLDR_APPEND:
1010 !g f.
1011 FCOMM g f ==>
1012 !e. LEFT_ID g e ==>
1013 !l1 l2. FOLDR f e (APPEND l1 l2) = g (FOLDR f e l1) (FOLDR f e l2)
1014Proof
1015 REWRITE_TAC [FCOMM_DEF, LEFT_ID_DEF]
1016 THEN REPEAT GEN_TAC
1017 THEN REPEAT DISCH_TAC
1018 THEN GEN_TAC
1019 THEN DISCH_TAC
1020 THEN LIST_INDUCT_TAC
1021 THEN ASM_REWRITE_TAC [APPEND, FOLDR]
1022QED
1023
1024Theorem FCOMM_FOLDL_APPEND:
1025 !f g.
1026 FCOMM f g ==>
1027 !e. RIGHT_ID g e ==>
1028 !l1 l2. FOLDL f e (APPEND l1 l2) = g (FOLDL f e l1) (FOLDL f e l2)
1029Proof
1030 REWRITE_TAC [FCOMM_DEF, RIGHT_ID_DEF]
1031 THEN REPEAT GEN_TAC
1032 THEN DISCH_THEN (ASSUME_TAC o GSYM)
1033 THEN GEN_TAC
1034 THEN DISCH_TAC
1035 THEN GEN_TAC
1036 THEN SNOC_INDUCT_TAC
1037 THEN ASM_REWRITE_TAC [APPEND_NIL, APPEND_SNOC, FOLDL_SNOC, FOLDL]
1038QED
1039
1040(* ??
1041
1042val MONOID_FOLDR_APPEND_FOLDR = Q.prove(
1043 `!(f:'a->'a->'a) e. MONOID f e ==>
1044 (!l1 l2. FOLDR f e (APPEND l1 l2) = f (FOLDR f e l1) (FOLDR f e l2))`,
1045 REWRITE_TAC [MONOID_DEF, GSYM FCOMM_ASSOC] THEN REPEAT STRIP_TAC
1046 THEN IMP_RES_TAC FCOMM_FOLDR_APPEND THEN ASM_REWRITE_TAC []);
1047
1048val MONOID_FOLDL_APPEND_FOLDL = Q.prove(
1049 `!(f:'a->'a->'a) e. MONOID f e ==>
1050 (!l1 l2. FOLDL f e (APPEND l1 l2) = f (FOLDL f e l1) (FOLDL f e l2))`,
1051 REWRITE_TAC [MONOID_DEF, GSYM FCOMM_ASSOC] THEN REPEAT STRIP_TAC
1052 THEN IMP_RES_TAC FCOMM_FOLDL_APPEND THEN ASM_REWRITE_TAC []);
1053
1054?? *)
1055
1056Theorem FOLDL_SINGLE:
1057 !f e x. FOLDL f e [x] = f e x
1058Proof
1059 REWRITE_TAC [FOLDL]
1060QED
1061
1062Theorem FOLDR_SINGLE:
1063 !f e x. FOLDR f e [x] = f x e
1064Proof
1065 REWRITE_TAC [FOLDR]
1066QED
1067
1068Theorem FOLDR_CONS_NIL:
1069 !l. FOLDR CONS [] l = l
1070Proof
1071 LIST_INDUCT_TAC THEN ASM_REWRITE_TAC [FOLDR]
1072QED
1073
1074Theorem FOLDL_SNOC_NIL:
1075 !l. FOLDL (\xs x. SNOC x xs) [] l = l
1076Proof
1077 SNOC_INDUCT_TAC
1078 THEN ASM_REWRITE_TAC [FOLDL, FOLDL_SNOC]
1079 THEN BETA_TAC
1080 THEN REWRITE_TAC []
1081QED
1082
1083Theorem FOLDR_FOLDL_REVERSE:
1084 !f e l. FOLDR f e l = FOLDL (\x y. f y x) e (REVERSE l)
1085Proof
1086 BasicProvers.Induct_on `l`
1087 THEN ASM_REWRITE_TAC [FOLDR, FOLDL, REVERSE, FOLDL_SNOC]
1088 THEN BETA_TAC
1089 THEN REWRITE_TAC []
1090QED
1091
1092Theorem FOLDL_FOLDR_REVERSE:
1093 !f e l. FOLDL f e l = FOLDR (\x y. f y x) e (REVERSE l)
1094Proof
1095 GEN_TAC
1096 THEN GEN_TAC
1097 THEN SNOC_INDUCT_TAC
1098 THEN ASM_REWRITE_TAC [REVERSE, FOLDR, FOLDL, REVERSE_SNOC, FOLDR_SNOC]
1099 THEN BETA_TAC
1100 THEN ASM_REWRITE_TAC [FOLDL_SNOC]
1101QED
1102
1103Theorem FOLDR_REVERSE:
1104 !f e l. FOLDR f e (REVERSE l) = FOLDL (\x y. f y x) e l
1105Proof
1106 REWRITE_TAC [FOLDR_FOLDL_REVERSE, REVERSE_REVERSE]
1107QED
1108
1109Theorem FOLDL_REVERSE:
1110 !f e l. FOLDL f e (REVERSE l) = FOLDR (\x y. f y x) e l
1111Proof
1112 REWRITE_TAC [FOLDL_FOLDR_REVERSE, REVERSE_REVERSE]
1113QED
1114
1115Theorem FOLDR_MAP:
1116 !f e g l. FOLDR f e (MAP g l) = FOLDR (\x y. f (g x) y) e l
1117Proof
1118 BasicProvers.Induct_on `l`
1119 THEN ASM_REWRITE_TAC [FOLDL, MAP, FOLDR] THEN BETA_TAC
1120 THEN REWRITE_TAC []
1121QED
1122
1123Theorem FOLDL_MAP:
1124 !f e g l. FOLDL f e (MAP g l) = FOLDL (\x y. f x (g y)) e l
1125Proof
1126 NTAC 3 GEN_TAC
1127 THEN SNOC_INDUCT_TAC
1128 THEN ASM_REWRITE_TAC [MAP, FOLDL, FOLDL_SNOC, MAP_SNOC, FOLDR]
1129 THEN BETA_TAC
1130 THEN REWRITE_TAC []
1131QED
1132
1133Theorem EVERY_FOLDR:
1134 !P l. EVERY P l = FOLDR (\x l'. P x /\ l') T l
1135Proof
1136 BasicProvers.Induct_on `l`
1137 THEN ASM_REWRITE_TAC [EVERY_DEF, FOLDR, MAP]
1138 THEN BETA_TAC
1139 THEN REWRITE_TAC []
1140QED
1141
1142Theorem EVERY_FOLDL:
1143 !P l. EVERY P l = FOLDL (\l' x. l' /\ P x) T l
1144Proof
1145 GEN_TAC
1146 THEN SNOC_INDUCT_TAC
1147 THENL [
1148 REWRITE_TAC [EVERY_DEF, FOLDL, MAP],
1149 ASM_REWRITE_TAC [EVERY_SNOC, FOLDL_SNOC, MAP_SNOC]]
1150 THEN BETA_TAC
1151 THEN REWRITE_TAC []
1152QED
1153
1154Theorem EXISTS_FOLDR:
1155 !P l. EXISTS P l = FOLDR (\x l'. P x \/ l') F l
1156Proof
1157 BasicProvers.Induct_on `l`
1158 THEN ASM_REWRITE_TAC [EXISTS_DEF, MAP, FOLDR]
1159 THEN BETA_TAC
1160 THEN REWRITE_TAC []
1161QED
1162
1163Theorem EXISTS_FOLDL:
1164 !P l. EXISTS P l = FOLDL (\l' x. l' \/ P x) F l
1165Proof
1166 GEN_TAC THEN SNOC_INDUCT_TAC
1167 THEN1 REWRITE_TAC [EXISTS_DEF, MAP, FOLDL]
1168 THEN REWRITE_TAC [EXISTS_SNOC, MAP_SNOC, FOLDL_SNOC]
1169 THEN BETA_TAC
1170 THEN GEN_TAC
1171 THEN FIRST_ASSUM SUBST1_TAC
1172 THEN MATCH_ACCEPT_TAC DISJ_SYM
1173QED
1174
1175Theorem EVERY_FOLDR_MAP:
1176 !P l. EVERY P l = FOLDR $/\ T (MAP P l)
1177Proof
1178 REWRITE_TAC [EVERY_FOLDR, FOLDR_MAP]
1179QED
1180
1181Theorem EVERY_FOLDL_MAP:
1182 !P l. EVERY P l = FOLDL $/\ T (MAP P l)
1183Proof
1184 REWRITE_TAC [EVERY_FOLDL, FOLDL_MAP]
1185QED
1186
1187Theorem EXISTS_FOLDR_MAP:
1188 !P l. EXISTS P l = FOLDR $\/ F (MAP P l)
1189Proof
1190 REWRITE_TAC [EXISTS_FOLDR, FOLDR_MAP]
1191QED
1192
1193Theorem EXISTS_FOLDL_MAP:
1194 !P l. EXISTS P l = FOLDL $\/ F (MAP P l)
1195Proof
1196 REWRITE_TAC [EXISTS_FOLDL, FOLDL_MAP]
1197QED
1198
1199Theorem FOLDR_FILTER:
1200 !f e P l.
1201 FOLDR f e (FILTER P l) = FOLDR (\x y. if P x then f x y else y) e l
1202Proof
1203 BasicProvers.Induct_on `l`
1204 THEN ASM_REWRITE_TAC [FOLDL, FILTER, FOLDR]
1205 THEN BETA_TAC
1206 THEN REPEAT GEN_TAC
1207 THEN COND_CASES_TAC
1208 THEN ASM_REWRITE_TAC [FOLDR]
1209QED
1210
1211Theorem FOLDL_FILTER:
1212 !f e P l.
1213 FOLDL f e (FILTER P l) = FOLDL (\x y. if P y then f x y else x) e l
1214Proof
1215 GEN_TAC
1216 THEN GEN_TAC
1217 THEN GEN_TAC
1218 THEN SNOC_INDUCT_TAC
1219 THEN ASM_REWRITE_TAC
1220 [FOLDL, FOLDR_SNOC, FOLDL_SNOC, FILTER, FOLDR, FILTER_SNOC]
1221 THEN BETA_TAC
1222 THEN GEN_TAC
1223 THEN COND_CASES_TAC
1224 THEN ASM_REWRITE_TAC [FOLDL_SNOC]
1225QED
1226
1227Theorem ASSOC_FOLDR_FLAT:
1228 !f. ASSOC f ==>
1229 !e. LEFT_ID f e ==>
1230 !l. FOLDR f e (FLAT l) = FOLDR f e (MAP (FOLDR f e) l)
1231Proof
1232 GEN_TAC
1233 THEN DISCH_TAC
1234 THEN GEN_TAC
1235 THEN DISCH_TAC
1236 THEN LIST_INDUCT_TAC
1237 THEN ASM_REWRITE_TAC [FLAT, MAP, FOLDR]
1238 THEN IMP_RES_TAC (GSYM FCOMM_ASSOC)
1239 THEN IMP_RES_TAC FCOMM_FOLDR_APPEND
1240 THEN ASM_REWRITE_TAC []
1241QED
1242
1243Theorem ASSOC_FOLDL_FLAT:
1244 !f. ASSOC f ==>
1245 !e. RIGHT_ID f e ==>
1246 !l. FOLDL f e (FLAT l) = FOLDL f e (MAP (FOLDL f e) l)
1247Proof
1248 GEN_TAC
1249 THEN DISCH_TAC
1250 THEN GEN_TAC
1251 THEN DISCH_TAC
1252 THEN SNOC_INDUCT_TAC
1253 THEN ASM_REWRITE_TAC [FLAT_SNOC, MAP_SNOC, MAP, FLAT, FOLDL_SNOC]
1254 THEN IMP_RES_TAC (GSYM FCOMM_ASSOC)
1255 THEN IMP_RES_TAC FCOMM_FOLDL_APPEND
1256 THEN ASM_REWRITE_TAC []
1257QED
1258
1259Theorem MAP_FLAT:
1260 !f l. MAP f (FLAT l) = FLAT (MAP (MAP f) l)
1261Proof
1262 BasicProvers.Induct_on `l` THEN ASM_REWRITE_TAC [FLAT, MAP, MAP_APPEND]
1263QED
1264
1265Theorem FILTER_FLAT:
1266 !P l. FILTER P (FLAT l) = FLAT (MAP (FILTER P) l)
1267Proof
1268 BasicProvers.Induct_on `l`
1269 THEN ASM_REWRITE_TAC [FLAT, MAP, FILTER, FILTER_APPEND]
1270QED
1271
1272Theorem EXISTS_DISJ:
1273 !P Q l. EXISTS (\x. P x \/ Q x) l = EXISTS P l \/ EXISTS Q l
1274Proof
1275 BasicProvers.Induct_on `l`
1276 THEN REWRITE_TAC [EXISTS_DEF]
1277 THEN metisLib.METIS_TAC []
1278QED
1279
1280Theorem MEM_FOLDR:
1281 !(y:'a) l. MEM y l = FOLDR (\x l'. (y = x) \/ l') F l
1282Proof
1283 REWRITE_TAC [MEM_EXISTS, EXISTS_FOLDR, FOLDR_MAP]
1284 THEN BETA_TAC
1285 THEN REWRITE_TAC []
1286QED
1287
1288Theorem MEM_FOLDL:
1289 !y l. MEM y l = FOLDL (\l' x. l' \/ (y = x)) F l
1290Proof
1291 REWRITE_TAC [MEM_EXISTS, EXISTS_FOLDL, FOLDL_MAP]
1292 THEN BETA_TAC
1293 THEN REWRITE_TAC []
1294QED
1295
1296Theorem NULL_FOLDR:
1297 !l. NULL l = FOLDR (\x l'. F) T l
1298Proof
1299 LIST_INDUCT_TAC THEN REWRITE_TAC [NULL_DEF, FOLDR]
1300QED
1301
1302Theorem NULL_FOLDL:
1303 !l. NULL l = FOLDL (\x l'. F) T l
1304Proof
1305 SNOC_INDUCT_TAC
1306 THEN REWRITE_TAC [NULL_DEF, FOLDL_SNOC, NULL_EQ, FOLDL,
1307 GSYM NOT_NIL_SNOC]
1308QED
1309
1310Theorem MAP_REVERSE = MAP_REVERSE;
1311
1312Theorem SEG_LENGTH_ID:
1313 !l. SEG (LENGTH l) 0 l = l
1314Proof
1315 BasicProvers.Induct THEN ASM_REWRITE_TAC [LENGTH, SEG]
1316QED
1317
1318Theorem SEG_SUC_CONS:
1319 !m n l x. SEG m (SUC n) (CONS x l) = SEG m n l
1320Proof
1321 BasicProvers.Induct THEN REWRITE_TAC [SEG]
1322QED
1323
1324Theorem SEG_0_SNOC:
1325 !m l x. m <= LENGTH l ==> (SEG m 0 (SNOC x l) = SEG m 0 l)
1326Proof
1327 INDUCT_TAC
1328 THEN1 REWRITE_TAC [SEG]
1329 THEN LIST_INDUCT_TAC
1330 THEN REWRITE_TAC [LENGTH]
1331 THEN1 REWRITE_TAC [LESS_OR_EQ, numTheory.NOT_SUC, NOT_LESS_0]
1332 THEN REWRITE_TAC [SNOC, SEG, LESS_EQ_MONO]
1333 THEN REPEAT STRIP_TAC
1334 THEN RES_TAC
1335 THEN ASM_REWRITE_TAC []
1336QED
1337
1338Theorem BUTLASTN_SEG:
1339 !n l. n <= LENGTH l ==> (BUTLASTN n l = SEG (LENGTH l - n) 0 l)
1340Proof
1341 INDUCT_TAC
1342 THEN REWRITE_TAC [BUTLASTN, SUB_0, SEG_LENGTH_ID]
1343 THEN SNOC_INDUCT_TAC
1344 THEN REWRITE_TAC [LENGTH, LENGTH_SNOC, BUTLASTN]
1345 THEN1 REWRITE_TAC [LESS_OR_EQ, NOT_LESS_0, numTheory.NOT_SUC]
1346 THEN REWRITE_TAC [LESS_EQ_MONO, SUB_MONO_EQ]
1347 THEN REPEAT STRIP_TAC
1348 THEN RES_THEN SUBST1_TAC
1349 THEN MATCH_MP_TAC (GSYM SEG_0_SNOC)
1350 THEN MATCH_ACCEPT_TAC SUB_LESS_EQ
1351QED
1352
1353Theorem LASTN_CONS:
1354 !n l. n <= LENGTH l ==> !x. LASTN n (CONS x l) = LASTN n l
1355Proof
1356 BasicProvers.Induct
1357 THEN REWRITE_TAC [LASTN]
1358 THEN SNOC_INDUCT_TAC
1359 THEN1 REWRITE_TAC [LENGTH, LESS_OR_EQ, NOT_LESS_0, numTheory.NOT_SUC]
1360 THEN REWRITE_TAC [LENGTH_SNOC, GSYM (CONJUNCT2 SNOC), LESS_EQ_MONO]
1361 THEN REPEAT STRIP_TAC
1362 THEN RES_TAC
1363 THEN ASM_REWRITE_TAC [LASTN]
1364QED
1365
1366Theorem LENGTH_LASTN:
1367 !n l. n <= LENGTH l ==> (LENGTH (LASTN n l) = n)
1368Proof
1369 INDUCT_TAC
1370 THEN REWRITE_TAC [LASTN, LENGTH]
1371 THEN SNOC_INDUCT_TAC
1372 THEN1 REWRITE_TAC [LENGTH, LESS_OR_EQ, NOT_LESS_0, numTheory.NOT_SUC]
1373 THEN REWRITE_TAC [LENGTH_SNOC, LASTN, LESS_EQ_MONO]
1374 THEN DISCH_TAC
1375 THEN RES_THEN SUBST1_TAC
1376 THEN REFL_TAC
1377QED
1378
1379Theorem LASTN_LENGTH_ID:
1380 !l. LASTN (LENGTH l) l = l
1381Proof
1382 SNOC_INDUCT_TAC
1383 THEN REWRITE_TAC [LENGTH, LENGTH_SNOC, LASTN]
1384 THEN GEN_TAC
1385 THEN POP_ASSUM SUBST1_TAC
1386 THEN REFL_TAC
1387QED
1388
1389Theorem LASTN_LASTN:
1390 !l n m. m <= LENGTH l ==> n <= m ==> (LASTN n (LASTN m l) = LASTN n l)
1391Proof
1392 SNOC_INDUCT_TAC
1393 THENL [
1394 REWRITE_TAC [LENGTH, LESS_OR_EQ, NOT_LESS_0]
1395 THEN REPEAT GEN_TAC
1396 THEN DISCH_THEN SUBST1_TAC
1397 THEN REWRITE_TAC [NOT_LESS_0, LASTN],
1398 GEN_TAC
1399 THEN REPEAT INDUCT_TAC
1400 THEN REWRITE_TAC [LENGTH_SNOC, LASTN, LESS_EQ_MONO, ZERO_LESS_EQ]
1401 THEN1 REWRITE_TAC [LESS_OR_EQ, NOT_LESS_0, numTheory.NOT_SUC]
1402 THEN REPEAT DISCH_TAC
1403 THEN RES_TAC
1404 THEN ASM_REWRITE_TAC []]
1405QED
1406
1407Theorem TAKE_SNOC:
1408 !n l. n <= LENGTH l ==> !x. TAKE n (SNOC x l) = TAKE n l
1409Proof
1410 INDUCT_TAC
1411 THEN LIST_INDUCT_TAC
1412 THEN REWRITE_TAC [TAKE, LENGTH]
1413 THEN1 REWRITE_TAC [LESS_OR_EQ, NOT_LESS_0, numTheory.NOT_SUC]
1414 THEN REWRITE_TAC [LESS_EQ_MONO, SNOC, TAKE]
1415 THEN REPEAT STRIP_TAC
1416 THEN RES_TAC
1417 THEN ASM_REWRITE_TAC []
1418QED
1419
1420Theorem TAKE_FRONT :
1421 !l n. l <> [] /\ n < LENGTH l ==> TAKE n (FRONT l) = TAKE n l
1422Proof
1423 HO_MATCH_MP_TAC SNOC_INDUCT
1424 >> CONJ_TAC >- SRW_TAC [][]
1425 >> RW_TAC arith_ss [FRONT_SNOC, LENGTH_SNOC]
1426 >> ONCE_REWRITE_TAC [EQ_SYM_EQ]
1427 >> MATCH_MP_TAC TAKE_SNOC
1428 >> RW_TAC arith_ss []
1429QED
1430
1431Theorem SNOC_EL_TAKE:
1432 !n l. n < LENGTH l ==> (SNOC (EL n l) (TAKE n l) = TAKE (SUC n) l)
1433Proof
1434 Induct_on `n` THEN Cases_on `l` THEN ASM_SIMP_TAC list_ss [SNOC, TAKE]
1435QED
1436
1437Theorem BUTLASTN_LENGTH_NIL:
1438 !l. BUTLASTN (LENGTH l) l = []
1439Proof
1440 SNOC_INDUCT_TAC THEN ASM_REWRITE_TAC [LENGTH, LENGTH_SNOC, BUTLASTN]
1441QED
1442
1443Theorem BUTLASTN_SUC_FRONT:
1444 !n l. n < LENGTH l ==> (BUTLASTN (SUC n) l = BUTLASTN n (FRONT l))
1445Proof
1446 INDUCT_TAC
1447 THEN SNOC_INDUCT_TAC
1448 THEN REWRITE_TAC [LENGTH, NOT_LESS_0, BUTLASTN, FRONT_SNOC]
1449QED
1450
1451Theorem BUTLASTN_FRONT:
1452 !n l. n < LENGTH l ==> (BUTLASTN n (FRONT l) = FRONT (BUTLASTN n l))
1453Proof
1454 INDUCT_TAC
1455 THEN REWRITE_TAC [BUTLASTN]
1456 THEN SNOC_INDUCT_TAC
1457 THEN REWRITE_TAC
1458 [LENGTH, LENGTH_SNOC, NOT_LESS_0, LESS_MONO_EQ, BUTLASTN, FRONT_SNOC]
1459 THEN DISCH_TAC
1460 THEN IMP_RES_THEN SUBST1_TAC BUTLASTN_SUC_FRONT
1461 THEN RES_TAC
1462QED
1463
1464Theorem LENGTH_BUTLASTN:
1465 !n l. n <= LENGTH l ==> (LENGTH (BUTLASTN n l) = LENGTH l - n)
1466Proof
1467 INDUCT_TAC
1468 THEN SNOC_INDUCT_TAC
1469 THEN REWRITE_TAC [BUTLASTN, SUB_0]
1470 THEN1 REWRITE_TAC [LENGTH, LESS_OR_EQ, NOT_LESS_0, numTheory.NOT_SUC]
1471 THEN REWRITE_TAC [LENGTH_SNOC, LESS_EQ_MONO, SUB_MONO_EQ]
1472 THEN FIRST_ASSUM MATCH_ACCEPT_TAC
1473QED
1474
1475val ADD_SUC_lem = numLib.DECIDE ``!n m. m + SUC n = SUC m + n``
1476
1477Theorem BUTLASTN_BUTLASTN:
1478 !m n l.
1479 n + m <= LENGTH l ==>
1480 (BUTLASTN n (BUTLASTN m l) = BUTLASTN (n + m) l)
1481Proof
1482 REPEAT INDUCT_TAC
1483 THEN SNOC_INDUCT_TAC
1484 THEN REWRITE_TAC [LENGTH, ADD, ADD_0, BUTLASTN]
1485 THEN1 REWRITE_TAC [LESS_OR_EQ, NOT_LESS_0, numTheory.NOT_SUC]
1486 THEN REWRITE_TAC [LENGTH_SNOC, LESS_EQ_MONO, ADD_SUC_lem]
1487 THEN FIRST_ASSUM MATCH_ACCEPT_TAC
1488QED
1489
1490Theorem APPEND_BUTLASTN_LASTN:
1491 !n l. n <= LENGTH l ==> (APPEND (BUTLASTN n l) (LASTN n l) = l)
1492Proof
1493 INDUCT_TAC
1494 THEN SNOC_INDUCT_TAC
1495 THEN REWRITE_TAC [BUTLASTN, LASTN, APPEND, APPEND_NIL]
1496 THEN1 REWRITE_TAC [LENGTH, LESS_OR_EQ, NOT_LESS_0, numTheory.NOT_SUC]
1497 THEN REWRITE_TAC [LENGTH_SNOC, LESS_EQ_MONO, APPEND_SNOC]
1498 THEN GEN_TAC
1499 THEN DISCH_TAC
1500 THEN RES_THEN SUBST1_TAC
1501 THEN REFL_TAC
1502QED
1503
1504Theorem APPEND_TAKE_LASTN:
1505 !m n l. (m + n = LENGTH l) ==> (APPEND (TAKE n l) (LASTN m l) = l)
1506Proof
1507 REPEAT INDUCT_TAC
1508 THEN SNOC_INDUCT_TAC
1509 THEN REWRITE_TAC [LENGTH, LENGTH_SNOC, ADD, ADD_0, TAKE, LASTN,
1510 APPEND, APPEND_NIL, SUC_NOT, numTheory.NOT_SUC]
1511 THENL [
1512 GEN_TAC
1513 THEN DISCH_THEN SUBST1_TAC
1514 THEN SUBST1_TAC (SYM (SPEC_ALL LENGTH_SNOC))
1515 THEN MATCH_ACCEPT_TAC TAKE_LENGTH_ID,
1516 PURE_ONCE_REWRITE_TAC [INV_SUC_EQ]
1517 THEN GEN_TAC
1518 THEN DISCH_THEN SUBST1_TAC
1519 THEN REWRITE_TAC [LASTN_LENGTH_ID],
1520 PURE_ONCE_REWRITE_TAC [INV_SUC_EQ, ADD_SUC_lem, APPEND_SNOC]
1521 THEN REPEAT STRIP_TAC
1522 THEN IMP_RES_TAC (numLib.DECIDE ``!m n p. (n + m = p) ==> m <= p``)
1523 THEN IMP_RES_TAC TAKE_SNOC
1524 THEN RES_TAC
1525 THEN ASM_REWRITE_TAC []]
1526QED
1527
1528Theorem BUTLASTN_APPEND2:
1529 !n l1 l2.
1530 n <= LENGTH l2 ==>
1531 (BUTLASTN n (APPEND l1 l2) = APPEND l1 (BUTLASTN n l2))
1532Proof
1533 INDUCT_TAC
1534 THEN GEN_TAC
1535 THEN SNOC_INDUCT_TAC
1536 THEN REWRITE_TAC [LENGTH, BUTLASTN, NOT_SUC_LESS_EQ_0, APPEND_SNOC]
1537 THEN ASM_REWRITE_TAC [LENGTH_SNOC, LESS_EQ_MONO]
1538QED
1539
1540(* |- !l2 l1. BUTLASTN (LENGTH l2) (APPEND l1 l2) = l1 *)
1541Theorem BUTLASTN_LENGTH_APPEND =
1542 GENL[``l2:'a list``,``l1:'a list``]
1543 (REWRITE_RULE [LESS_EQ_REFL, BUTLASTN_LENGTH_NIL, APPEND_NIL]
1544 (SPECL [``LENGTH (l2:'a list)``,``l1:'a list``,``l2:'a list``]
1545 BUTLASTN_APPEND2));
1546
1547Theorem LASTN_LENGTH_APPEND:
1548 !l2 l1. LASTN (LENGTH l2) (APPEND l1 l2) = l2
1549Proof
1550 SNOC_INDUCT_TAC
1551 THEN REWRITE_TAC [LENGTH, LENGTH_SNOC, APPEND, APPEND_SNOC, LASTN]
1552 THEN ASM_REWRITE_TAC [FRONT_SNOC, LAST_SNOC, SNOC_APPEND]
1553QED
1554
1555Theorem BUTLASTN_CONS:
1556 !n l. n <= LENGTH l ==> !x. BUTLASTN n (CONS x l) = CONS x (BUTLASTN n l)
1557Proof
1558 BasicProvers.Induct
1559 THEN SNOC_INDUCT_TAC
1560 THEN REWRITE_TAC [LENGTH, NOT_SUC_LESS_EQ_0, BUTLASTN, GSYM (CONJUNCT2 SNOC)]
1561 THEN ASM_REWRITE_TAC [LENGTH_SNOC, LESS_EQ_MONO]
1562QED
1563
1564(* |- !l x. BUTLASTN (LENGTH l) (CONS x l) = [x] *)
1565Theorem BUTLASTN_LENGTH_CONS = (
1566 let
1567 val thm1 = SPECL [``LENGTH (l:'a list)``,``l:'a list``] BUTLASTN_CONS
1568 in
1569 GEN_ALL (REWRITE_RULE [LESS_EQ_REFL, BUTLASTN_LENGTH_NIL] thm1)
1570 end)
1571
1572Theorem LAST_LASTN_LAST:
1573 !n l. n <= LENGTH l ==> 0 < n ==> (LAST (LASTN n l) = LAST l)
1574Proof
1575 INDUCT_TAC
1576 THEN SNOC_INDUCT_TAC
1577 THEN REWRITE_TAC [LENGTH, NOT_LESS_0, NOT_SUC_LESS_EQ_0]
1578 THEN REWRITE_TAC [LASTN, LAST_SNOC]
1579QED
1580
1581Theorem BUTLASTN_LASTN_NIL:
1582 !n l. n <= LENGTH l ==> (BUTLASTN n (LASTN n l) = [])
1583Proof
1584 REPEAT STRIP_TAC
1585 THEN IMP_RES_THEN (fn t => SUBST_OCCS_TAC [([1], SYM t)]) LENGTH_LASTN
1586 THEN MATCH_ACCEPT_TAC BUTLASTN_LENGTH_NIL
1587QED
1588
1589Theorem LASTN_BUTLASTN:
1590 !n m l.
1591 n + m <= LENGTH l ==>
1592 (LASTN n (BUTLASTN m l) = BUTLASTN m (LASTN (n + m) l))
1593Proof
1594 REPEAT INDUCT_TAC
1595 THEN SNOC_INDUCT_TAC
1596 THEN REWRITE_TAC [LENGTH, NOT_SUC_LESS_EQ_0, ADD, ADD_0, LASTN, BUTLASTN]
1597 THEN REWRITE_TAC [LENGTH_SNOC, LESS_EQ_MONO]
1598 THENL [
1599 DISCH_TAC THEN CONV_TAC SYM_CONV THEN IMP_RES_TAC BUTLASTN_LASTN_NIL,
1600 PURE_ONCE_REWRITE_TAC [numLib.DECIDE ``!n m. m + SUC n = SUC m + n``]
1601 THEN DISCH_TAC
1602 THEN RES_TAC]
1603QED
1604
1605Theorem BUTLASTN_LASTN:
1606 !m n l.
1607 m <= n /\ n <= LENGTH l ==>
1608 (BUTLASTN m (LASTN n l) = LASTN (n - m) (BUTLASTN m l))
1609Proof
1610 REPEAT INDUCT_TAC
1611 THEN SNOC_INDUCT_TAC
1612 THEN REWRITE_TAC
1613 [LENGTH, NOT_LESS_0, NOT_SUC_LESS_EQ_0, SUB_0, BUTLASTN, LASTN]
1614 THEN ASM_REWRITE_TAC [LENGTH_SNOC, LESS_EQ_MONO, SUB_MONO_EQ]
1615QED
1616
1617Theorem LASTN_1:
1618 !l. ~(l = []) ==> (LASTN 1 l = [LAST l])
1619Proof
1620 SNOC_INDUCT_TAC
1621 THEN REWRITE_TAC []
1622 THEN REPEAT STRIP_TAC
1623 THEN CONV_TAC (ONCE_DEPTH_CONV num_CONV)
1624 THEN REWRITE_TAC [LASTN, APPEND_NIL, SNOC, LAST_SNOC]
1625QED
1626
1627Theorem BUTLASTN_1:
1628 !l. BUTLASTN 1 l = FRONT l
1629Proof
1630 SNOC_INDUCT_TAC
1631 >- simp[BUTLASTN_def]
1632 >> CONV_TAC (ONCE_DEPTH_CONV num_CONV)
1633 >> REWRITE_TAC [FRONT_SNOC, BUTLASTN]
1634QED
1635
1636Theorem BUTLASTN_APPEND1:
1637 !l2 n.
1638 LENGTH l2 <= n ==>
1639 !l1. BUTLASTN n (APPEND l1 l2) = BUTLASTN (n - (LENGTH l2)) l1
1640Proof
1641 SNOC_INDUCT_TAC
1642 THEN REWRITE_TAC
1643 [LENGTH, LENGTH_SNOC, APPEND, APPEND_SNOC, APPEND_NIL, SUB_0]
1644 THEN GEN_TAC
1645 THEN INDUCT_TAC
1646 THEN REWRITE_TAC [NOT_SUC_LESS_EQ_0, LESS_EQ_MONO, BUTLASTN, SUB_MONO_EQ]
1647 THEN FIRST_ASSUM MATCH_ACCEPT_TAC
1648QED
1649
1650Theorem LASTN_APPEND2:
1651 !n l2. n <= LENGTH l2 ==> !l1. LASTN n (APPEND l1 l2) = LASTN n l2
1652Proof
1653 INDUCT_TAC
1654 THEN SNOC_INDUCT_TAC
1655 THEN REWRITE_TAC [LENGTH, LENGTH_SNOC, LASTN, NOT_SUC_LESS_EQ_0]
1656 THEN REWRITE_TAC [LESS_EQ_MONO, LASTN, APPEND_SNOC]
1657 THEN REPEAT STRIP_TAC
1658 THEN RES_TAC
1659 THEN ASM_REWRITE_TAC []
1660QED
1661
1662Theorem LASTN_APPEND1:
1663 !l2 n.
1664 LENGTH l2 <= n ==>
1665 !l1. LASTN n (APPEND l1 l2) = APPEND (LASTN (n - (LENGTH l2)) l1) l2
1666Proof
1667 SNOC_INDUCT_TAC
1668 THEN REWRITE_TAC
1669 [LENGTH, LENGTH_SNOC, APPEND, APPEND_SNOC, APPEND_NIL, LASTN, SUB_0]
1670 THEN GEN_TAC
1671 THEN INDUCT_TAC
1672 THEN REWRITE_TAC [NOT_SUC_LESS_EQ_0, LASTN, LESS_EQ_MONO, SUB_MONO_EQ]
1673 THEN DISCH_TAC
1674 THEN RES_TAC
1675 THEN ASM_REWRITE_TAC []
1676QED
1677
1678Theorem LASTN_MAP:
1679 !n l. n <= LENGTH l ==> !f. LASTN n (MAP f l) = MAP f (LASTN n l)
1680Proof
1681 INDUCT_TAC
1682 THEN SNOC_INDUCT_TAC
1683 THEN REWRITE_TAC [LENGTH, LASTN, MAP, NOT_SUC_LESS_EQ_0]
1684 THEN REWRITE_TAC [LENGTH_SNOC, LASTN, MAP_SNOC, LESS_EQ_MONO]
1685 THEN REPEAT STRIP_TAC
1686 THEN RES_TAC
1687 THEN ASM_REWRITE_TAC []
1688QED
1689
1690Theorem BUTLASTN_MAP:
1691 !n l. n <= LENGTH l ==> !f. BUTLASTN n (MAP f l) = MAP f (BUTLASTN n l)
1692Proof
1693 INDUCT_TAC
1694 THEN SNOC_INDUCT_TAC
1695 THEN REWRITE_TAC [LENGTH, BUTLASTN, MAP, NOT_SUC_LESS_EQ_0]
1696 THEN REWRITE_TAC [LENGTH_SNOC, BUTLASTN, MAP_SNOC, LESS_EQ_MONO]
1697 THEN REPEAT STRIP_TAC
1698 THEN RES_TAC
1699 THEN ASM_REWRITE_TAC []
1700QED
1701
1702Theorem TAKE_TAKE_T:
1703 !m l n. n <= m ==> (TAKE n (TAKE m l) = TAKE n l)
1704Proof
1705 Induct THEN1 SIMP_TAC list_ss [TAKE, TAKE_def]
1706 THEN Cases THEN1 SIMP_TAC list_ss [TAKE, TAKE_def]
1707 THEN Cases THEN1 SIMP_TAC list_ss [TAKE, TAKE_def]
1708 THEN ASM_SIMP_TAC list_ss [TAKE, TAKE_def]
1709QED
1710
1711Theorem TAKE_TAKE:
1712 !m l. m <= LENGTH l ==> !n. n <= m ==> (TAKE n (TAKE m l) = TAKE n l)
1713Proof
1714 SIMP_TAC bool_ss [TAKE_TAKE_T]
1715QED
1716
1717Theorem DROP_LENGTH_NIL = listTheory.DROP_LENGTH_NIL
1718Theorem DROP_APPEND = listTheory.DROP_APPEND
1719Theorem DROP_APPEND1 = listTheory.DROP_APPEND1
1720Theorem DROP_APPEND2 = listTheory.DROP_APPEND2
1721
1722Theorem DROP_DROP_T:
1723 !n m l. DROP n (DROP m l) = DROP (n + m) l
1724Proof
1725 SIMP_TAC list_ss [DROP_FUNPOW_TL, GSYM FUNPOW_ADD]
1726QED
1727
1728Theorem DROP_DROP:
1729 !n m l. n + m <= LENGTH l ==> (DROP n (DROP m l) = DROP (n + m) l)
1730Proof
1731 SIMP_TAC list_ss [DROP_DROP_T]
1732QED
1733
1734Theorem LASTN_SEG:
1735 !n l. n <= LENGTH l ==> (LASTN n l = SEG n (LENGTH l - n) l)
1736Proof
1737 BasicProvers.Induct
1738 THEN REWRITE_TAC [LASTN, SUB_0, SEG]
1739 THEN BasicProvers.Induct
1740 THEN REWRITE_TAC [LENGTH, LASTN, NOT_SUC_LESS_EQ_0]
1741 THEN REWRITE_TAC [LESS_EQ_MONO, SUB_MONO_EQ]
1742 THEN GEN_TAC
1743 THEN DISCH_TAC
1744 THEN IMP_RES_TAC LESS_OR_EQ
1745 THENL [
1746 IMP_RES_THEN SUBST1_TAC
1747 (numLib.DECIDE ``!k m. m < k ==> (k - m = SUC (k - SUC m))``)
1748 THEN PURE_ONCE_REWRITE_TAC [SEG]
1749 THEN IMP_RES_TAC LESS_EQ
1750 THEN RES_THEN (SUBST1_TAC o SYM)
1751 THEN MATCH_MP_TAC LASTN_CONS
1752 THEN FIRST_ASSUM ACCEPT_TAC,
1753 FIRST_ASSUM SUBST1_TAC
1754 THEN REWRITE_TAC [SUB_EQUAL_0]
1755 (* **list_Axiom** variable dependancy *)
1756 THEN SUBST1_TAC (SYM (Q.SPECL [`h`, `l`] (CONJUNCT2 LENGTH)))
1757 THEN REWRITE_TAC [SEG_LENGTH_ID, LASTN_LENGTH_ID]]
1758QED
1759
1760Theorem TAKE_SEG:
1761 !n l. n <= LENGTH l ==> (TAKE n l = SEG n 0 l)
1762Proof
1763 NTAC 2 BasicProvers.Induct
1764 THEN REWRITE_TAC [LENGTH, TAKE, SEG, NOT_SUC_LESS_EQ_0, LESS_EQ_MONO]
1765 THEN REPEAT STRIP_TAC
1766 THEN RES_TAC
1767 THEN ASM_REWRITE_TAC []
1768QED
1769
1770Theorem DROP_SEG:
1771 !n l. n <= LENGTH l ==> (DROP n l = SEG (LENGTH l - n) n l)
1772Proof
1773 NTAC 2 BasicProvers.Induct
1774 THEN REWRITE_TAC [LENGTH, DROP, SEG, NOT_SUC_LESS_EQ_0,
1775 LESS_EQ_MONO, SUB_0, SEG_LENGTH_ID]
1776 THEN REPEAT STRIP_TAC
1777 THEN RES_TAC
1778 THEN ASM_REWRITE_TAC [SUB_MONO_EQ, SEG_SUC_CONS]
1779QED
1780
1781Theorem DROP_SNOC:
1782 !n l. n <= LENGTH l ==> !x. DROP n (SNOC x l) = SNOC x (DROP n l)
1783Proof
1784 NTAC 2 BasicProvers.Induct
1785 THEN REWRITE_TAC [LENGTH, DROP, SNOC, NOT_SUC_LESS_EQ_0, LESS_EQ_MONO]
1786 THEN FIRST_ASSUM MATCH_ACCEPT_TAC
1787QED
1788
1789Theorem APPEND_BUTLASTN_DROP:
1790 !m n l. (m + n = LENGTH l) ==> (APPEND (BUTLASTN m l) (DROP n l) = l)
1791Proof
1792 REPEAT BasicProvers.Induct
1793 THEN REWRITE_TAC
1794 [LENGTH, APPEND, ADD, ADD_0, numTheory.NOT_SUC, SUC_NOT,
1795 SNOC, NOT_SUC_LESS_EQ_0, LESS_EQ_MONO, INV_SUC_EQ]
1796 THENL [
1797 REWRITE_TAC [BUTLASTN, DROP, APPEND],
1798 GEN_TAC
1799 THEN DISCH_THEN SUBST1_TAC
1800 (* **list_Axiom** variable dependancy *)
1801 THEN SUBST1_TAC (SYM (Q.SPECL [`h`, `l`] (CONJUNCT2 LENGTH)))
1802 THEN REWRITE_TAC [DROP_LENGTH_NIL, BUTLASTN, APPEND_NIL],
1803 GEN_TAC
1804 THEN DISCH_THEN SUBST1_TAC
1805 (* **list_Axiom** variable dependancy *)
1806 THEN SUBST1_TAC (SYM (Q.SPECL [`h`, `l`] (CONJUNCT2 LENGTH)))
1807 THEN REWRITE_TAC [BUTLASTN_LENGTH_NIL, DROP, APPEND],
1808 GEN_TAC
1809 THEN DISCH_TAC
1810 THEN PURE_ONCE_REWRITE_TAC [DROP]
1811 THEN RULE_ASSUM_TAC (REWRITE_RULE [ADD_SUC_lem])
1812 THEN IMP_RES_TAC (numLib.DECIDE ``!m n p. (m + n = p) ==> (m <= p)``)
1813 THEN IMP_RES_TAC BUTLASTN_CONS
1814 THEN ASM_REWRITE_TAC [APPEND, CONS_11]
1815 THEN RES_TAC]
1816QED
1817
1818Theorem SEG_SEG:
1819 !n1 m1 n2 m2 l.
1820 n1 + m1 <= LENGTH l /\ n2 + m2 <= n1 ==>
1821 (SEG n2 m2 (SEG n1 m1 l) = SEG n2 (m1 + m2) l)
1822Proof
1823 REPEAT INDUCT_TAC
1824 THEN LIST_INDUCT_TAC
1825 THEN REWRITE_TAC [LENGTH, SEG, NOT_LESS_0, NOT_SUC_LESS_EQ_0, ADD, ADD_0]
1826 THENL [
1827 (* 1 *)
1828 GEN_TAC THEN REWRITE_TAC [LESS_EQ_MONO, CONS_11]
1829 THEN STRIP_TAC THEN SUBST_OCCS_TAC [([3], SYM(SPEC``0``ADD_0))]
1830 THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC [ADD_0],
1831 (* 2 *)
1832 REWRITE_TAC [LESS_EQ_MONO, ADD_SUC_lem] THEN STRIP_TAC
1833 THEN SUBST_OCCS_TAC [([2], SYM(SPEC``m2:num``(CONJUNCT1 ADD)))]
1834 THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC [ADD_0],
1835 (* 3 *)
1836 REWRITE_TAC [LESS_EQ_MONO, ADD_SUC_lem] THEN STRIP_TAC
1837 THEN SUBST_OCCS_TAC [([2], SYM(SPEC``m1:num``ADD_0))]
1838 THEN FIRST_ASSUM MATCH_MP_TAC
1839 THEN ASM_REWRITE_TAC [LESS_EQ_MONO, ADD_0],
1840 (* 4 *)
1841 PURE_ONCE_REWRITE_TAC [LESS_EQ_MONO] THEN STRIP_TAC
1842 THEN FIRST_ASSUM MATCH_MP_TAC THEN CONJ_TAC THENL [
1843 PURE_ONCE_REWRITE_TAC [GSYM ADD_SUC_lem]
1844 THEN FIRST_ASSUM ACCEPT_TAC,
1845 ASM_REWRITE_TAC [ADD, LESS_EQ_MONO]]]
1846QED
1847
1848Theorem SEG_APPEND1:
1849 !n m l1. n + m <= LENGTH l1 ==> !l2. SEG n m (APPEND l1 l2) = SEG n m l1
1850Proof
1851 REPEAT INDUCT_TAC
1852 THEN LIST_INDUCT_TAC
1853 THEN REWRITE_TAC [LENGTH, SEG, NOT_LESS_0, NOT_SUC_LESS_EQ_0, ADD, ADD_0]
1854 THEN GEN_TAC
1855 THEN REWRITE_TAC [LESS_EQ_MONO, APPEND, SEG, CONS_11]
1856 THENL [
1857 DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC
1858 THEN ASM_REWRITE_TAC [ADD_0],
1859 PURE_ONCE_REWRITE_TAC [ADD_SUC_lem]
1860 THEN FIRST_ASSUM MATCH_ACCEPT_TAC]
1861QED
1862
1863Theorem SEG_APPEND2:
1864 !l1 m n l2.
1865 LENGTH l1 <= m /\ n <= LENGTH l2 ==>
1866 (SEG n m (APPEND l1 l2) = SEG n (m - (LENGTH l1)) l2)
1867Proof
1868 LIST_INDUCT_TAC
1869 THEN REPEAT (FILTER_GEN_TAC ``m:num``)
1870 THEN REPEAT INDUCT_TAC
1871 THEN LIST_INDUCT_TAC
1872 THEN REWRITE_TAC [LENGTH, SEG, NOT_LESS_0, NOT_SUC_LESS_EQ_0, ADD, ADD_0]
1873 THEN REPEAT GEN_TAC
1874 THEN REWRITE_TAC [SUB_0, APPEND, SEG]
1875 THEN REWRITE_TAC [LESS_EQ_MONO, SUB_MONO_EQ]
1876 THEN STRIP_TAC
1877 THEN FIRST_ASSUM MATCH_MP_TAC
1878 THEN ASM_REWRITE_TAC [LENGTH, LESS_EQ_MONO]
1879QED
1880
1881Theorem SEG_TAKE_DROP:
1882 !n m l. n + m <= LENGTH l ==> (SEG n m l = TAKE n (DROP m l))
1883Proof
1884 REPEAT INDUCT_TAC
1885 THEN LIST_INDUCT_TAC
1886 THEN REWRITE_TAC [LENGTH, NOT_SUC_LESS_EQ_0, ADD, ADD_0,
1887 SEG, TAKE, DROP, LESS_EQ_MONO, CONS_11]
1888 THEN1 MATCH_ACCEPT_TAC (GSYM TAKE_SEG)
1889 THEN PURE_ONCE_REWRITE_TAC [ADD_SUC_lem]
1890 THEN FIRST_ASSUM MATCH_ACCEPT_TAC
1891QED
1892
1893Theorem SEG_APPEND:
1894 !m l1 n l2.
1895 m < LENGTH l1 /\ LENGTH l1 <= n + m /\ n + m <= LENGTH l1 + LENGTH l2 ==>
1896 (SEG n m (APPEND l1 l2) =
1897 APPEND (SEG (LENGTH l1 - m) m l1) (SEG (n + m - LENGTH l1) 0 l2))
1898Proof
1899 INDUCT_TAC
1900 THEN LIST_INDUCT_TAC
1901 THEN REPEAT (FILTER_GEN_TAC ``n:num``)
1902 THEN INDUCT_TAC
1903 THEN LIST_INDUCT_TAC
1904 THEN REPEAT GEN_TAC
1905 THEN REWRITE_TAC
1906 [LENGTH, SEG, NOT_LESS_0, NOT_SUC_LESS_EQ_0, ADD, ADD_0, SUB_0]
1907 THEN REWRITE_TAC
1908 [LESS_EQ_MONO, SUB_0, SUB_MONO_EQ, APPEND, SEG, NOT_SUC_LESS_EQ_0,
1909 CONS_11]
1910 THEN RULE_ASSUM_TAC (REWRITE_RULE [ADD_0, SUB_0])
1911 THENL [
1912 DISCH_THEN (CONJUNCTS_THEN ASSUME_TAC)
1913 THEN POP_ASSUM (SUBST1_TAC o (MATCH_MP LESS_EQUAL_ANTISYM))
1914 THEN REWRITE_TAC [SEG, APPEND_NIL, SUB_EQUAL_0],
1915 STRIP_TAC THEN DISJ_CASES_TAC (SPEC ``LENGTH (l1:'a list)``LESS_0_CASES)
1916 THENL [
1917 POP_ASSUM (ASSUME_TAC o SYM) THEN IMP_RES_TAC LENGTH_NIL
1918 THEN ASM_REWRITE_TAC [APPEND, SEG, SUB_0],
1919 FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC [LENGTH]],
1920 DISCH_THEN (CONJUNCTS_THEN ASSUME_TAC)
1921 THEN POP_ASSUM (SUBST1_TAC o (MATCH_MP LESS_EQUAL_ANTISYM))
1922 THEN REWRITE_TAC [SEG, APPEND_NIL, SUB_EQUAL_0],
1923 REWRITE_TAC [LESS_MONO_EQ, GSYM NOT_LESS] THEN STRIP_TAC THEN RES_TAC,
1924 DISCH_THEN (CONJUNCTS_THEN ASSUME_TAC)
1925 THEN POP_ASSUM (SUBST1_TAC o (MATCH_MP LESS_EQUAL_ANTISYM))
1926 THEN REWRITE_TAC [SEG, APPEND_NIL, SUB_EQUAL_0]
1927 THEN REWRITE_TAC [ADD_SUC_lem, ADD_SUB, SEG],
1928 REWRITE_TAC [LESS_MONO_EQ, SEG_SUC_CONS] THEN STRIP_TAC
1929 THEN PURE_ONCE_REWRITE_TAC [ADD_SUC_lem]
1930 THEN FIRST_ASSUM MATCH_MP_TAC
1931 THEN ASM_REWRITE_TAC [GSYM ADD_SUC_lem, LENGTH]]
1932QED
1933
1934Theorem SEG_LENGTH_SNOC:
1935 !l x. SEG 1 (LENGTH l) (SNOC x l) = [x]
1936Proof
1937 CONV_TAC (ONCE_DEPTH_CONV num_CONV)
1938 THEN LIST_INDUCT_TAC
1939 THEN ASM_REWRITE_TAC [LENGTH, SNOC, SEG]
1940QED
1941
1942Theorem SEG_SNOC:
1943 !n m l. n + m <= LENGTH l ==> !x. SEG n m (SNOC x l) = SEG n m l
1944Proof
1945 REPEAT INDUCT_TAC
1946 THEN LIST_INDUCT_TAC
1947 THEN REWRITE_TAC [LENGTH, NOT_SUC_LESS_EQ_0, ADD, ADD_0, SNOC, SEG]
1948 THENL [
1949 REWRITE_TAC [CONS_11, LESS_EQ_MONO]
1950 THEN REPEAT STRIP_TAC
1951 THEN FIRST_ASSUM MATCH_MP_TAC
1952 THEN ASM_REWRITE_TAC [ADD_0],
1953 REWRITE_TAC [LESS_EQ_MONO, ADD_SUC_lem]
1954 THEN DISCH_TAC
1955 THEN FIRST_ASSUM MATCH_MP_TAC
1956 THEN FIRST_ASSUM ACCEPT_TAC]
1957QED
1958
1959Theorem ELL_SEG:
1960 !n l. n < LENGTH l ==> (ELL n l = HD (SEG 1 (PRE (LENGTH l - n)) l))
1961Proof
1962 INDUCT_TAC
1963 THEN SNOC_INDUCT_TAC
1964 THEN REWRITE_TAC [LENGTH, LENGTH_SNOC, NOT_LESS_0]
1965 THEN1 REWRITE_TAC [PRE, SUB_0, ELL, LAST_SNOC, SEG_LENGTH_SNOC, HD]
1966 THEN REWRITE_TAC [LESS_MONO_EQ, ELL, FRONT_SNOC, SUB_MONO_EQ]
1967 THEN REPEAT STRIP_TAC
1968 THEN RES_THEN SUBST1_TAC
1969 THEN CONV_TAC SYM_CONV
1970 THEN AP_TERM_TAC
1971 THEN MATCH_MP_TAC SEG_SNOC
1972 THEN PURE_ONCE_REWRITE_TAC [ADD_SYM]
1973 THEN PURE_ONCE_REWRITE_TAC [GSYM ADD1]
1974 THEN IMP_RES_TAC SUB_LESS_0
1975 THEN IMP_RES_THEN SUBST1_TAC SUC_PRE
1976 THEN MATCH_ACCEPT_TAC SUB_LESS_EQ
1977QED
1978
1979Theorem SNOC_FOLDR:
1980 !x l. SNOC x l = FOLDR CONS [x] l
1981Proof
1982 GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC [FOLDR, SNOC]
1983QED
1984
1985Theorem MEM_FOLDR_MAP:
1986 !x l. MEM x l = FOLDR $\/ F (MAP ($= x) l)
1987Proof
1988 REWRITE_TAC [MEM_FOLDR, FOLDR_MAP]
1989QED
1990
1991Theorem MEM_FOLDL_MAP:
1992 !x l. MEM x l = FOLDL $\/ F (MAP ($= x) l)
1993Proof
1994 REWRITE_TAC [MEM_FOLDL, FOLDL_MAP]
1995QED
1996
1997Theorem FILTER_FILTER:
1998 !P Q l. FILTER P (FILTER Q l) = FILTER (\x. P x /\ Q x) l
1999Proof
2000 BasicProvers.Induct_on `l`
2001 THEN REWRITE_TAC [FILTER]
2002 THEN BETA_TAC
2003 THEN REPEAT GEN_TAC
2004 THEN COND_CASES_TAC
2005 THEN ASM_REWRITE_TAC [FILTER]
2006QED
2007
2008Theorem FCOMM_FOLDR_FLAT:
2009 !g f.
2010 FCOMM g f ==>
2011 !e. LEFT_ID g e ==>
2012 !l. FOLDR f e (FLAT l) = FOLDR g e (MAP (FOLDR f e) l)
2013Proof
2014 GEN_TAC
2015 THEN GEN_TAC
2016 THEN DISCH_TAC
2017 THEN GEN_TAC
2018 THEN DISCH_TAC
2019 THEN LIST_INDUCT_TAC
2020 THEN ASM_REWRITE_TAC [FLAT, MAP, FOLDR]
2021 THEN IMP_RES_TAC FCOMM_FOLDR_APPEND
2022 THEN ASM_REWRITE_TAC []
2023QED
2024
2025Theorem FCOMM_FOLDL_FLAT:
2026 !f g. FCOMM f g ==>
2027 !e. RIGHT_ID g e ==>
2028 !l. FOLDL f e (FLAT l) = FOLDL g e (MAP (FOLDL f e) l)
2029Proof
2030 GEN_TAC
2031 THEN GEN_TAC
2032 THEN DISCH_TAC
2033 THEN GEN_TAC
2034 THEN DISCH_TAC
2035 THEN SNOC_INDUCT_TAC
2036 THEN ASM_REWRITE_TAC [FLAT_SNOC, MAP_SNOC, MAP, FLAT, FOLDL_SNOC, FOLDL]
2037 THEN IMP_RES_TAC FCOMM_FOLDL_APPEND
2038 THEN ASM_REWRITE_TAC []
2039QED
2040
2041Theorem FOLDR1[local]:
2042 !(f:'a->'a->'a).
2043 (!a b c. f a (f b c) = f b (f a c)) ==>
2044 (!e l. (FOLDR f (f x e) l = f x (FOLDR f e l)))
2045Proof
2046 GEN_TAC
2047 THEN DISCH_TAC
2048 THEN GEN_TAC
2049 THEN LIST_INDUCT_TAC
2050 THEN REWRITE_TAC [REVERSE, FOLDR]
2051 THEN ONCE_REWRITE_TAC
2052 [ASSUME ``!a b c. (f:'a->'a->'a) a (f b c) = f b (f a c)``]
2053 THEN REWRITE_TAC
2054 [ASSUME ``FOLDR (f:'a->'a->'a)(f x e) l = f x (FOLDR f e l)``]
2055QED
2056
2057Theorem FOLDL1[local]:
2058 !(f:'a->'a->'a).
2059 (!a b c. f (f a b) c = f (f a c) b) ==>
2060 (!e l. (FOLDL f (f e x) l = f (FOLDL f e l) x))
2061Proof
2062 GEN_TAC
2063 THEN DISCH_TAC
2064 THEN GEN_TAC
2065 THEN SNOC_INDUCT_TAC
2066 THEN REWRITE_TAC [REVERSE, FOLDL, FOLDL_SNOC]
2067 THEN ONCE_REWRITE_TAC
2068 [ASSUME ``!a b c. (f:'a->'a->'a) (f a b) c = f (f a c) b``]
2069 THEN REWRITE_TAC
2070 [ASSUME``FOLDL(f:'a->'a->'a)(f e x) l = f (FOLDL f e l) x``]
2071QED
2072
2073Theorem FOLDR_REVERSE2[local]:
2074 !(f:'a->'a->'a).
2075 (!a b c. f a (f b c) = f b (f a c)) ==>
2076 (!e l. FOLDR f e (REVERSE l) = FOLDR f e l)
2077Proof
2078 GEN_TAC
2079 THEN DISCH_TAC
2080 THEN GEN_TAC
2081 THEN LIST_INDUCT_TAC
2082 THEN ASM_REWRITE_TAC [REVERSE, FOLDR, FOLDR_SNOC]
2083 THEN IMP_RES_TAC FOLDR1
2084 THEN ASM_REWRITE_TAC []
2085QED
2086
2087Theorem FOLDR_MAP_REVERSE:
2088 !f:'a -> 'a -> 'a.
2089 (!a b c. f a (f b c) = f b (f a c)) ==>
2090 !e g l. FOLDR f e (MAP g (REVERSE l)) = FOLDR f e (MAP g l)
2091Proof
2092 GEN_TAC
2093 THEN DISCH_TAC
2094 THEN GEN_TAC
2095 THEN GEN_TAC
2096 THEN LIST_INDUCT_TAC
2097 THEN ASM_REWRITE_TAC [REVERSE, FOLDR, FOLDR_SNOC, MAP, MAP_SNOC]
2098 THEN IMP_RES_TAC FOLDR1
2099 THEN ASM_REWRITE_TAC []
2100QED
2101
2102Theorem FOLDR_FILTER_REVERSE:
2103 !f:'a -> 'a -> 'a.
2104 (!a b c. f a (f b c) = f b (f a c)) ==>
2105 !e P l. FOLDR f e (FILTER P (REVERSE l)) = FOLDR f e (FILTER P l)
2106Proof
2107 GEN_TAC
2108 THEN DISCH_TAC
2109 THEN GEN_TAC
2110 THEN GEN_TAC
2111 THEN LIST_INDUCT_TAC
2112 THEN ASM_REWRITE_TAC [REVERSE, FOLDR, FOLDR_SNOC, FILTER, FILTER_SNOC]
2113 THEN IMP_RES_TAC FOLDR1
2114 THEN GEN_TAC
2115 THEN COND_CASES_TAC
2116 THENL [
2117 ASM_REWRITE_TAC [FOLDR, FOLDR_SNOC, FILTER, FILTER_SNOC]
2118 THEN ASM_REWRITE_TAC [GSYM FILTER_REVERSE],
2119 ASM_REWRITE_TAC [FOLDR, FOLDR_SNOC, FILTER, FILTER_SNOC]]
2120QED
2121
2122Theorem FOLDL_REVERSE2[local]:
2123 !(f:'a->'a->'a).
2124 (!a b c. f (f a b) c = f (f a c) b) ==>
2125 (!e l. FOLDL f e (REVERSE l) = FOLDL f e l)
2126Proof
2127 GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN SNOC_INDUCT_TAC
2128 THEN ASM_REWRITE_TAC [REVERSE, REVERSE_SNOC, FOLDL, FOLDL_SNOC]
2129 THEN IMP_RES_TAC FOLDL1 THEN ASM_REWRITE_TAC []
2130QED
2131
2132Theorem COMM_ASSOC_LEM1[local]:
2133 !(f:'a->'a->'a). COMM f ==> (ASSOC f ==>
2134 (!a b c. f a (f b c) = f b (f a c)))
2135Proof
2136 REWRITE_TAC [ASSOC_DEF] THEN REPEAT STRIP_TAC
2137 THEN ASM_REWRITE_TAC [] THEN SUBST1_TAC(SPECL [``a:'a``,``b:'a``]
2138 (REWRITE_RULE [COMM_DEF] (ASSUME ``COMM (f:'a->'a->'a)``)))
2139 THEN REWRITE_TAC []
2140QED
2141
2142Theorem COMM_ASSOC_LEM2[local]:
2143 !(f:'a->'a->'a). COMM f ==> (ASSOC f ==>
2144 (!a b c. f (f a b) c = f (f a c) b))
2145Proof
2146 REPEAT STRIP_TAC THEN ASM_REWRITE_TAC
2147 [GSYM (REWRITE_RULE [ASSOC_DEF] (ASSUME ``ASSOC (f:'a->'a->'a)``))]
2148 THEN SUBST1_TAC(SPECL [``b:'a``,``c:'a``]
2149 (REWRITE_RULE [COMM_DEF] (ASSUME ``COMM (f:'a->'a->'a)``)))
2150 THEN REWRITE_TAC []
2151QED
2152
2153Theorem COMM_ASSOC_FOLDR_REVERSE:
2154 !f:'a -> 'a -> 'a.
2155 COMM f ==> ASSOC f ==> !e l. FOLDR f e (REVERSE l) = FOLDR f e l
2156Proof
2157 REPEAT STRIP_TAC
2158 THEN MATCH_MP_TAC FOLDR_REVERSE2
2159 THEN REPEAT GEN_TAC
2160 THEN IMP_RES_TAC COMM_ASSOC_LEM1
2161 THEN FIRST_ASSUM MATCH_ACCEPT_TAC
2162QED
2163
2164Theorem COMM_ASSOC_FOLDL_REVERSE:
2165 !f:'a -> 'a -> 'a.
2166 COMM f ==> ASSOC f ==> !e l. FOLDL f e (REVERSE l) = FOLDL f e l
2167Proof
2168 REPEAT STRIP_TAC
2169 THEN MATCH_MP_TAC FOLDL_REVERSE2
2170 THEN IMP_RES_TAC COMM_ASSOC_LEM2
2171 THEN REPEAT GEN_TAC
2172 THEN FIRST_ASSUM MATCH_ACCEPT_TAC
2173QED
2174
2175Theorem ELL_LAST:
2176 !l. ~NULL l ==> (ELL 0 l = LAST l)
2177Proof
2178 SNOC_INDUCT_TAC
2179 THEN1 REWRITE_TAC [NULL]
2180 THEN REPEAT STRIP_TAC
2181 THEN REWRITE_TAC [ELL]
2182QED
2183
2184Theorem ELL_0_SNOC:
2185 !l x. ELL 0 (SNOC x l) = x
2186Proof
2187 REPEAT GEN_TAC THEN REWRITE_TAC [ELL, LAST_SNOC]
2188QED
2189
2190Theorem ELL_SNOC:
2191 !n. 0 < n ==> !x l. ELL n (SNOC x l) = ELL (PRE n) l
2192Proof
2193 INDUCT_TAC THEN REWRITE_TAC [NOT_LESS_0, ELL, FRONT_SNOC, PRE, LESS_0]
2194QED
2195
2196(* |- !n x l. ELL (SUC n) (SNOC x l) = ELL n l *)
2197Theorem ELL_SUC_SNOC =
2198 GEN_ALL (PURE_ONCE_REWRITE_RULE [PRE]
2199 (MP (SPEC ``SUC n`` ELL_SNOC) (SPEC_ALL LESS_0)));
2200
2201Theorem ELL_CONS:
2202 !n l. n < LENGTH l ==> !x. ELL n (CONS x l) = ELL n l
2203Proof
2204 let
2205 val SNOC_lem = GSYM (CONJUNCT2 SNOC)
2206 in
2207 INDUCT_TAC
2208 THEN SNOC_INDUCT_TAC
2209 THEN REWRITE_TAC [NOT_LESS_0, LENGTH]
2210 THENL [
2211 REPEAT STRIP_TAC THEN REWRITE_TAC [SNOC_lem, ELL_0_SNOC],
2212 GEN_TAC
2213 THEN REWRITE_TAC [LENGTH_SNOC, LESS_MONO_EQ, ELL_SUC_SNOC, SNOC_lem]
2214 THEN FIRST_ASSUM MATCH_ACCEPT_TAC]
2215 end
2216QED
2217
2218Theorem ELL_LENGTH_CONS:
2219 !l x. ELL (LENGTH l) (CONS x l) = x
2220Proof
2221 SNOC_INDUCT_TAC
2222 THEN1 REWRITE_TAC [ELL, LENGTH, LAST_CONS]
2223 THEN REWRITE_TAC [ELL, LENGTH_SNOC, FRONT_SNOC, GSYM (CONJUNCT2 SNOC)]
2224 THEN POP_ASSUM ACCEPT_TAC
2225QED
2226
2227Theorem ELL_LENGTH_SNOC:
2228 !l x. ELL (LENGTH l) (SNOC x l) = if NULL l then x else HD l
2229Proof
2230 LIST_INDUCT_TAC
2231 THEN1 REWRITE_TAC [ELL_0_SNOC, LENGTH, NULL]
2232 THEN REWRITE_TAC [ELL_SUC_SNOC, LENGTH, HD, NULL, ELL_LENGTH_CONS]
2233QED
2234
2235Theorem ELL_APPEND2:
2236 !n l2. n < LENGTH l2 ==> !l1. ELL n (APPEND l1 l2) = ELL n l2
2237Proof
2238 INDUCT_TAC
2239 THEN SNOC_INDUCT_TAC
2240 THEN REWRITE_TAC [LENGTH, NOT_LESS_0]
2241 THEN REWRITE_TAC
2242 [APPEND_SNOC, ELL_0_SNOC, ELL_SUC_SNOC, LENGTH_SNOC, LESS_MONO_EQ]
2243 THEN FIRST_ASSUM MATCH_ACCEPT_TAC
2244QED
2245
2246Theorem ELL_APPEND1:
2247 !l2 n.
2248 LENGTH l2 <= n ==> !l1. ELL n (APPEND l1 l2) = ELL (n - LENGTH l2) l1
2249Proof
2250 SNOC_INDUCT_TAC
2251 THEN REPEAT (FILTER_GEN_TAC ``n:num``)
2252 THEN INDUCT_TAC
2253 THEN REWRITE_TAC [LENGTH, LENGTH_SNOC, SUB_0, APPEND_NIL, NOT_SUC_LESS_EQ_0]
2254 THEN REWRITE_TAC [LESS_EQ_MONO, ELL_SUC_SNOC, SUB_MONO_EQ, APPEND_SNOC]
2255 THEN FIRST_ASSUM MATCH_ACCEPT_TAC
2256QED
2257
2258Theorem ELL_PRE_LENGTH:
2259 !l. ~(l = []) ==> (ELL (PRE (LENGTH l)) l = HD l)
2260Proof
2261 LIST_INDUCT_TAC
2262 THEN REWRITE_TAC [LENGTH, PRE]
2263 THEN REPEAT STRIP_TAC
2264 THEN REWRITE_TAC [ELL_LENGTH_CONS, HD]
2265QED
2266
2267Theorem EL_PRE_LENGTH:
2268 !l. ~(l = []) ==> (EL (PRE (LENGTH l)) l = LAST l)
2269Proof
2270 SNOC_INDUCT_TAC
2271 THEN REWRITE_TAC [LENGTH_SNOC, PRE, LAST_SNOC, EL_LENGTH_SNOC]
2272QED
2273
2274Theorem EL_ELL:
2275 !n l. n < LENGTH l ==> (EL n l = ELL (PRE (LENGTH l - n)) l)
2276Proof
2277 INDUCT_TAC
2278 THEN LIST_INDUCT_TAC
2279 THEN REWRITE_TAC [LENGTH, NOT_LESS_0]
2280 THEN1 REWRITE_TAC [PRE, EL, ELL_LENGTH_CONS, HD, SUB_0]
2281 THEN REWRITE_TAC [EL, TL, LESS_MONO_EQ, SUB_MONO_EQ]
2282 THEN GEN_TAC
2283 THEN DISCH_TAC
2284 THEN MAP_EVERY IMP_RES_TAC
2285 [numLib.DECIDE ``!n m. m < n ==> PRE (n - m) < n``, ELL_CONS]
2286 THEN RES_TAC
2287 THEN ASM_REWRITE_TAC []
2288QED
2289
2290Theorem EL_LENGTH_APPEND:
2291 !l2 l1. ~NULL l2 ==> (EL (LENGTH l1) (APPEND l1 l2) = HD l2)
2292Proof
2293 GEN_TAC
2294 THEN LIST_INDUCT_TAC
2295 THEN REWRITE_TAC [LENGTH, APPEND, EL, TL, NULL]
2296 THEN REPEAT STRIP_TAC
2297 THEN RES_TAC
2298QED
2299
2300Theorem ELL_EL:
2301 !n l. n < LENGTH l ==> (ELL n l = EL (PRE((LENGTH l) - n)) l)
2302Proof
2303 INDUCT_TAC THEN SNOC_INDUCT_TAC THEN REWRITE_TAC [LENGTH, NOT_LESS_0]
2304 THEN1 REWRITE_TAC
2305 [SUB_0, ELL_0_SNOC, LENGTH_SNOC, PRE, EL_LENGTH_SNOC]
2306 THEN REWRITE_TAC [LENGTH_SNOC, ELL_SUC_SNOC, SUB_MONO_EQ, LESS_MONO_EQ]
2307 THEN REPEAT STRIP_TAC
2308 THEN RES_THEN SUBST1_TAC
2309 THEN MATCH_MP_TAC (GSYM EL_SNOC)
2310 THEN IMP_RES_TAC (Q.prove (
2311 `!n m. n < m ==> ?k. (m - n = SUC k) /\ k < m`,
2312 REPEAT STRIP_TAC THEN Q.EXISTS_TAC `PRE (m - n)`
2313 THEN numLib.DECIDE_TAC))
2314 THEN ASM_REWRITE_TAC [PRE]
2315QED
2316
2317Theorem ELL_MAP:
2318 !n l f. n < LENGTH l ==> (ELL n (MAP f l) = f (ELL n l))
2319Proof
2320 INDUCT_TAC
2321 THEN SNOC_INDUCT_TAC
2322 THEN REWRITE_TAC [LENGTH, NOT_LESS_0]
2323 THEN1 REWRITE_TAC [ELL_0_SNOC, MAP_SNOC]
2324 THEN REWRITE_TAC [LENGTH_SNOC, ELL_SUC_SNOC, MAP_SNOC, LESS_MONO_EQ]
2325 THEN FIRST_ASSUM MATCH_ACCEPT_TAC
2326QED
2327
2328Theorem LENGTH_FRONT:
2329 !l. ~(l = []) ==> (LENGTH (FRONT l) = PRE (LENGTH l))
2330Proof
2331 SNOC_INDUCT_TAC THEN REWRITE_TAC [LENGTH_SNOC, FRONT_SNOC, PRE]
2332QED
2333
2334Theorem DROP_LENGTH_APPEND:
2335 !l1 l2. DROP (LENGTH l1) (APPEND l1 l2) = l2
2336Proof
2337 LIST_INDUCT_TAC THEN ASM_REWRITE_TAC [LENGTH, DROP, APPEND]
2338QED
2339
2340Theorem TAKE_APPEND:
2341 !n l1 l2. TAKE n (APPEND l1 l2) = TAKE n l1 ++ TAKE (n - LENGTH l1) l2
2342Proof
2343 Induct THEN1 SIMP_TAC list_ss [TAKE, TAKE_def]
2344 THEN Cases THEN1 SIMP_TAC list_ss [TAKE, TAKE_def]
2345 THEN ASM_SIMP_TAC list_ss [TAKE, TAKE_def]
2346QED
2347
2348Theorem TAKE_APPEND1:
2349 !n l1. n <= LENGTH l1 ==> !l2. TAKE n (APPEND l1 l2) = TAKE n l1
2350Proof
2351 INDUCT_TAC
2352 THEN LIST_INDUCT_TAC
2353 THEN REWRITE_TAC
2354 [LENGTH, NOT_SUC_LESS_EQ_0, TAKE, APPEND, CONS_11, LESS_EQ_MONO]
2355 THEN FIRST_ASSUM MATCH_ACCEPT_TAC
2356QED
2357
2358Theorem TAKE_APPEND2:
2359 !l1 n.
2360 LENGTH l1 <= n ==>
2361 !l2. TAKE n (APPEND l1 l2) = APPEND l1 (TAKE (n - LENGTH l1) l2)
2362Proof
2363 LIST_INDUCT_TAC
2364 THEN REWRITE_TAC [LENGTH, APPEND, SUB_0]
2365 THEN GEN_TAC
2366 THEN INDUCT_TAC
2367 THEN REWRITE_TAC
2368 [NOT_SUC_LESS_EQ_0, LESS_EQ_MONO, SUB_MONO_EQ, TAKE, CONS_11]
2369 THEN FIRST_ASSUM MATCH_ACCEPT_TAC
2370QED
2371
2372Theorem TAKE_LENGTH_APPEND:
2373 !l1 l2. TAKE (LENGTH l1) (APPEND l1 l2) = l1
2374Proof
2375 LIST_INDUCT_TAC THEN ASM_REWRITE_TAC [LENGTH, TAKE, APPEND]
2376QED
2377
2378Theorem REVERSE_FLAT:
2379 !l. REVERSE (FLAT l) = FLAT (REVERSE (MAP REVERSE l))
2380Proof
2381 LIST_INDUCT_TAC
2382 THEN REWRITE_TAC [REVERSE, FLAT, MAP]
2383 THEN ASM_REWRITE_TAC [REVERSE_APPEND, FLAT_SNOC]
2384QED
2385
2386Theorem MAP_COND[local]:
2387 !(f:'a-> 'b) c l1 l2.
2388 (MAP f (if c then l1 else l2)) = (if c then (MAP f l1) else (MAP f l2))
2389Proof
2390 REPEAT GEN_TAC THEN BOOL_CASES_TAC ``c:bool`` THEN ASM_REWRITE_TAC []
2391QED
2392
2393Theorem MAP_FILTER:
2394 !f P l. (!x. P (f x) = P x) ==> (MAP f (FILTER P l) = FILTER P (MAP f l))
2395Proof
2396 GEN_TAC
2397 THEN GEN_TAC
2398 THEN LIST_INDUCT_TAC
2399 THEN REWRITE_TAC [MAP, FILTER]
2400 THEN GEN_TAC
2401 THEN DISCH_TAC
2402 THEN ASM_REWRITE_TAC [MAP_COND, MAP]
2403 THEN RES_THEN SUBST1_TAC
2404 THEN REFL_TAC
2405QED
2406
2407Theorem FLAT_REVERSE:
2408 !l. FLAT (REVERSE l) = REVERSE (FLAT (MAP REVERSE l))
2409Proof
2410 LIST_INDUCT_TAC
2411 THEN REWRITE_TAC [FLAT, REVERSE, MAP]
2412 THEN ASM_REWRITE_TAC [FLAT_SNOC, REVERSE_APPEND, REVERSE_REVERSE]
2413QED
2414
2415Theorem FLAT_FLAT:
2416 !l. FLAT (FLAT l) = FLAT (MAP FLAT l)
2417Proof
2418 LIST_INDUCT_TAC THEN ASM_REWRITE_TAC [FLAT, FLAT_APPEND, MAP]
2419QED
2420
2421Theorem EXISTS_REVERSE:
2422 !P l. EXISTS P (REVERSE l) = EXISTS P l
2423Proof
2424 GEN_TAC
2425 THEN LIST_INDUCT_TAC
2426 THEN ASM_REWRITE_TAC [EXISTS_DEF, REVERSE, EXISTS_SNOC]
2427 THEN GEN_TAC
2428 THEN MATCH_ACCEPT_TAC DISJ_SYM
2429QED
2430
2431Theorem EXISTS_SEG:
2432 !m k (l:'a list). (m + k) <= (LENGTH l) ==>
2433 !P. EXISTS P (SEG m k l) ==> EXISTS P l
2434Proof
2435 REPEAT INDUCT_TAC
2436 THEN LIST_INDUCT_TAC
2437 THEN REWRITE_TAC [EXISTS_DEF, SEG, LENGTH, ADD, ADD_0, NOT_SUC_LESS_EQ_0]
2438 THEN GEN_TAC
2439 THEN REWRITE_TAC [LESS_EQ_MONO]
2440 THENL [
2441 FIRST_ASSUM (ASSUME_TAC o (REWRITE_RULE [ADD_0]) o (SPEC``0``))
2442 THEN REPEAT STRIP_TAC
2443 THENL [
2444 DISJ1_TAC THEN FIRST_ASSUM ACCEPT_TAC,
2445 DISJ2_TAC THEN RES_TAC],
2446 SUBST1_TAC (numLib.DECIDE ``m + SUC k = SUC m + k``)
2447 THEN REPEAT STRIP_TAC THEN DISJ2_TAC THEN RES_TAC]
2448QED
2449
2450Theorem EXISTS_TAKE:
2451 !l m P. EXISTS P (TAKE m l) ==> EXISTS P l
2452Proof
2453 Induct \\ rw [TAKE_def] \\ simp [] \\ first_x_assum drule \\ simp []
2454QED
2455
2456Theorem EXISTS_DROP:
2457 !l m P. EXISTS P (DROP m l) ==> EXISTS P l
2458Proof
2459 Induct \\ rw [DROP_def] \\ first_x_assum drule \\ simp []
2460QED
2461
2462Theorem EXISTS_LASTN:
2463 !l m P. EXISTS P (LASTN m l) ==> EXISTS P l
2464Proof
2465 rw [LASTN_def, EXISTS_REVERSE] \\ drule EXISTS_TAKE \\ simp [EXISTS_REVERSE]
2466QED
2467
2468Theorem EXISTS_BUTLASTN:
2469 !l m P. EXISTS P (BUTLASTN m l) ==> EXISTS P l
2470Proof
2471 rw[BUTLASTN_def, EXISTS_REVERSE] \\ drule EXISTS_DROP \\ simp[EXISTS_REVERSE]
2472QED
2473
2474Theorem MEM_SEG:
2475 !n m l. n + m <= LENGTH l ==> !x. MEM x (SEG n m l) ==> MEM x l
2476Proof
2477 REPEAT INDUCT_TAC
2478 THEN LIST_INDUCT_TAC
2479 THEN REWRITE_TAC
2480 [ADD, ADD_0, NOT_SUC_LESS_EQ_0, LENGTH, MEM, SEG, LESS_EQ_MONO]
2481 THEN GEN_TAC
2482 THENL [
2483 DISCH_TAC
2484 THEN FIRST_ASSUM (IMP_RES_TAC o REWRITE_RULE [ADD_0] o SPEC ``0``)
2485 THEN GEN_TAC
2486 THEN DISCH_THEN (DISJ_CASES_THEN2
2487 (fn t => DISJ1_TAC THEN ACCEPT_TAC t)
2488 (fn t => DISJ2_TAC THEN ASSUME_TAC t THEN RES_TAC)),
2489 PURE_ONCE_REWRITE_TAC [numLib.DECIDE ``!n m. m + SUC n = SUC m + n``]
2490 THEN REPEAT STRIP_TAC
2491 THEN DISJ2_TAC
2492 THEN RES_TAC]
2493QED
2494
2495Theorem MEM_TAKE:
2496 !l m x. MEM x (TAKE m l) ==> MEM x l
2497Proof
2498 rw [MEM_EXISTS] \\ drule EXISTS_TAKE \\ simp []
2499QED
2500
2501Theorem MEM_DROP_IMP:
2502 !l m x. MEM x (DROP m l) ==> MEM x l
2503Proof
2504 rw [MEM_EXISTS] \\ drule EXISTS_DROP \\ simp []
2505QED
2506
2507Theorem MEM_BUTLASTN:
2508 !l m x. MEM x (BUTLASTN m l) ==> MEM x l
2509Proof
2510 rw [MEM_EXISTS] \\ drule EXISTS_BUTLASTN \\ simp []
2511QED
2512
2513Theorem MEM_LASTN:
2514 !m l x. MEM x (LASTN m l) ==> MEM x l
2515Proof
2516 rw [MEM_EXISTS] \\ drule EXISTS_LASTN \\ simp []
2517QED
2518
2519Theorem EVERY_SEG:
2520 !P l. EVERY P l ==> !m k. m + k <= LENGTH l ==> EVERY P (SEG m k l)
2521Proof
2522 GEN_TAC
2523 THEN LIST_INDUCT_TAC
2524 THEN REWRITE_TAC [EVERY_DEF, SEG, LENGTH]
2525 THENL [
2526 REPEAT INDUCT_TAC
2527 THEN REWRITE_TAC [ADD, ADD_0, NOT_SUC_LESS_EQ_0, SEG, EVERY_DEF],
2528 GEN_TAC
2529 THEN STRIP_TAC
2530 THEN REPEAT INDUCT_TAC
2531 THEN REWRITE_TAC
2532 [ADD, ADD_0, NOT_SUC_LESS_EQ_0, LESS_EQ_MONO, SEG, EVERY_DEF]
2533 THEN1 mesonLib.ASM_MESON_TAC [ADD_CLAUSES]
2534 THEN SUBST1_TAC (numLib.DECIDE ``m + SUC k = SUC m + k``)
2535 THEN DISCH_TAC
2536 THEN RES_TAC]
2537QED
2538
2539Theorem EVERY_TAKE:
2540 !P l m. EVERY P l ==> EVERY P (TAKE m l)
2541Proof
2542 metis_tac [EVERY_MEM, MEM_TAKE]
2543QED
2544
2545Theorem EVERY_DROP:
2546 !P l m. EVERY P l ==> EVERY P (DROP m l)
2547Proof
2548 metis_tac [EVERY_MEM, MEM_DROP_IMP]
2549QED
2550
2551Theorem EVERY_REVERSE[simp]:
2552 !P l. EVERY P (REVERSE l) = EVERY P l
2553Proof
2554 GEN_TAC
2555 THEN LIST_INDUCT_TAC
2556 THEN ASM_REWRITE_TAC [EVERY_DEF, REVERSE, EVERY_SNOC]
2557 THEN GEN_TAC
2558 THEN MATCH_ACCEPT_TAC CONJ_SYM
2559QED
2560
2561Theorem EVERY_LASTN:
2562 !P l m. EVERY P l ==> EVERY P (LASTN m l)
2563Proof
2564 simp [LASTN_def, EVERY_REVERSE, EVERY_TAKE]
2565QED
2566
2567Theorem EVERY_BUTLASTN:
2568 !P l m. EVERY P l ==> EVERY P (BUTLASTN m l)
2569Proof
2570 simp [BUTLASTN_def, EVERY_REVERSE, EVERY_DROP]
2571QED
2572
2573Theorem ZIP_SNOC:
2574 !l1 l2.
2575 (LENGTH l1 = LENGTH l2) ==>
2576 !x1 x2. ZIP (SNOC x1 l1, SNOC x2 l2) = SNOC (x1, x2) (ZIP (l1, l2))
2577Proof
2578 LIST_INDUCT_TAC
2579 THEN REPEAT (FILTER_GEN_TAC ``l2:'b list``)
2580 THEN LIST_INDUCT_TAC
2581 THEN REWRITE_TAC [SNOC, ZIP, LENGTH, numTheory.NOT_SUC, SUC_NOT]
2582 THEN REWRITE_TAC [INV_SUC_EQ, CONS_11]
2583 THEN REPEAT STRIP_TAC
2584 THEN RES_THEN MATCH_ACCEPT_TAC
2585QED
2586
2587Theorem UNZIP_SNOC:
2588 !x l. UNZIP (SNOC x l) =
2589 (SNOC (FST x) (FST (UNZIP l)), SNOC (SND x) (SND (UNZIP l)))
2590Proof
2591 GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC [SNOC, UNZIP]
2592QED
2593
2594Theorem LENGTH_UNZIP_FST:
2595 !l. LENGTH (UNZIP_FST l) = LENGTH l
2596Proof
2597 PURE_ONCE_REWRITE_TAC [UNZIP_FST_DEF]
2598 THEN LIST_INDUCT_TAC
2599 THEN ASM_REWRITE_TAC [UNZIP, LENGTH]
2600QED
2601
2602Theorem LENGTH_UNZIP_SND:
2603 !l. LENGTH (UNZIP_SND l) = LENGTH l
2604Proof
2605 PURE_ONCE_REWRITE_TAC [UNZIP_SND_DEF]
2606 THEN LIST_INDUCT_TAC
2607 THEN ASM_REWRITE_TAC [UNZIP, LENGTH]
2608QED
2609
2610Theorem SUM_REVERSE:
2611 !l. SUM (REVERSE l) = SUM l
2612Proof
2613 LIST_INDUCT_TAC
2614 THEN ASM_REWRITE_TAC [SUM, REVERSE, SUM_SNOC]
2615 THEN MATCH_ACCEPT_TAC ADD_SYM
2616QED
2617
2618Theorem SUM_FLAT:
2619 !l. SUM (FLAT l) = SUM (MAP SUM l)
2620Proof
2621 LIST_INDUCT_TAC
2622 THEN ASM_REWRITE_TAC [SUM, FLAT, MAP, SUM_APPEND]
2623QED
2624
2625Theorem EL_APPEND1:
2626 !n l1 l2. n < LENGTH l1 ==> (EL n (APPEND l1 l2) = EL n l1)
2627Proof
2628 simp_tac(srw_ss()) [EL_APPEND_EQN]
2629QED
2630
2631Theorem EL_APPEND2:
2632 !l1 n.
2633 LENGTH l1 <= n ==> !l2. EL n (APPEND l1 l2) = EL (n - (LENGTH l1)) l2
2634Proof
2635 simp_tac (srw_ss() ++ numSimps.ARITH_ss) [EL_APPEND_EQN]
2636QED
2637
2638local
2639 val op >> = op THEN
2640 val rw = SRW_TAC[]
2641 (* `val', so the simpset is the one in force here rather than a
2642 proof's: these are read once, and widening them to the
2643 proof's context stops rich_listTheory terminating. *)
2644 val simp = ASM_SIMP_TAC (srw_ss()++boolSimps.LET_ss++numSimps.ARITH_ss)
2645 val fs = FULL_SIMP_TAC(srw_ss())
2646in
2647Theorem LUPDATE_APPEND2:
2648 !l1 l2 n x.
2649 LENGTH l1 <= n ==>
2650 (LUPDATE x n (l1 ++ l2) = l1 ++ (LUPDATE x (n-LENGTH l1) l2))
2651Proof
2652 Induct_on ‘l1’ THENL [
2653 SRW_TAC [] [],
2654 Cases_on ‘n’ THENL [
2655 SRW_TAC [] [],
2656 FULL_SIMP_TAC (srw_ss ()) [] THEN METIS_TAC [LUPDATE_def]
2657 ]
2658 ]
2659QED
2660
2661Theorem LUPDATE_APPEND1:
2662 !l1 l2 n x.
2663 n < LENGTH l1 ==> (LUPDATE x n (l1 ++ l2) = (LUPDATE x n l1) ++ l2)
2664Proof
2665 rw[]
2666 >> simp[LIST_EQ_REWRITE]
2667 >> Q.X_GEN_TAC`z`
2668 >> simp[EL_LUPDATE]
2669 >> rw[]
2670 >> simp[EL_APPEND2,EL_LUPDATE]
2671 >> fs[]
2672 >> Cases_on`z < LENGTH l1`
2673 >> fs[]
2674 >> simp[EL_APPEND1,EL_APPEND2,EL_LUPDATE]
2675QED
2676
2677Theorem is_prefix_el:
2678 !n l1 l2.
2679 isPREFIX l1 l2 /\ n < LENGTH l1 /\ n < LENGTH l2
2680 ==>
2681 (EL n l1 = EL n l2)
2682Proof
2683 Induct_on `n` >> rw [] >>
2684 Cases_on `l1` >>
2685 Cases_on `l2` >>
2686 rw [] >> fs []
2687QED
2688
2689end
2690
2691Theorem EL_CONS:
2692 !n. 0 < n ==> !x l. EL n (CONS x l) = EL (PRE n) l
2693Proof
2694 INDUCT_TAC THEN ASM_REWRITE_TAC [NOT_LESS_0, EL, HD, TL, PRE]
2695QED
2696
2697Theorem SEG1:
2698 !n l. n < LENGTH l ==> (SEG 1 n l = [EL n l])
2699Proof
2700 Induct >- (Cases_on ‘l’ >> REWRITE_TAC [SEG, ONE] >> SIMP_TAC (srw_ss())[]) >>
2701 Cases_on ‘l’ >> REWRITE_TAC [SEG, ONE] >>
2702 ASM_SIMP_TAC (srw_ss()) []
2703QED
2704
2705Theorem EL_SEG:
2706 !n l. n < LENGTH l ==> (EL n l = HD (SEG 1 n l))
2707Proof
2708 METIS_TAC [SEG1, HD]
2709QED
2710
2711Theorem SEG_CONS:
2712 !j n h t. 0 < j /\ n+j <= LENGTH t + 1 ==> (SEG n j (h::t) = SEG n (j-1) t)
2713Proof
2714 Induct_on ‘j’ >> SIMP_TAC (srw_ss()) [] >> Cases_on ‘n’ >>
2715 SIMP_TAC (srw_ss()) [SEG]
2716QED
2717
2718Theorem SEG_SUC_EL:
2719 !n i l.
2720 i + n < LENGTH l ==> (SEG (SUC n) i l = EL i l :: SEG n (i+1) l)
2721Proof
2722 Induct_on `l` >> SIMP_TAC (srw_ss()) [] >> Cases_on ‘i’ >>
2723 ASM_SIMP_TAC(srw_ss() ++ numSimps.ARITH_ss) [SEG, SEG_CONS, ADD_CLAUSES] >>
2724 SIMP_TAC (srw_ss()) [ADD1]
2725QED
2726
2727Theorem TAKE_SEG_DROP:
2728 !n i l. i + n <= LENGTH l ==> (TAKE i l ++ SEG n i l ++ DROP (i + n) l = l)
2729Proof
2730 Induct_on `l` >> SIMP_TAC (srw_ss()) [SEG] >> Cases_on `n`
2731 >- SIMP_TAC (srw_ss()) [SEG] >>
2732 Cases_on `i` >> ASM_SIMP_TAC (srw_ss()) [SEG] >> strip_tac
2733 >- (Q.RENAME_TAC [‘SEG n 0 s ++ DROP n s’] >>
2734 first_x_assum (Q.SPECL_THEN [‘n’, ‘0’] mp_tac) >>
2735 ASM_SIMP_TAC (srw_ss()) []) >>
2736 Q.RENAME_TAC [‘TAKE m s ++ SEG (SUC n) m s ++ _’] >>
2737 first_x_assum (Q.SPECL_THEN [‘SUC n’, ‘m’] mp_tac) >>
2738 SIMP_TAC (srw_ss() ++ numSimps.ARITH_ss) [ADD1]
2739QED
2740
2741Theorem EL_MEM = listTheory.EL_MEM
2742
2743Theorem TL_SNOC:
2744 !x l. TL (SNOC x l) = if NULL l then [] else SNOC x (TL l)
2745Proof
2746 GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC [SNOC, TL, NULL]
2747QED
2748
2749Theorem EL_REVERSE_ELL:
2750 !n l. n < LENGTH l ==> (EL n (REVERSE l) = ELL n l)
2751Proof
2752 INDUCT_TAC
2753 THEN SNOC_INDUCT_TAC
2754 THEN ASM_REWRITE_TAC
2755 [LENGTH, LENGTH_SNOC, REVERSE_SNOC, EL, ELL, HD, TL, LAST_SNOC,
2756 FRONT_SNOC, NOT_LESS_0, LESS_MONO_EQ, SUB_0]
2757QED
2758
2759Theorem ELL_LENGTH_APPEND:
2760 !l1 l2. ~NULL l1 ==> (ELL (LENGTH l2) (APPEND l1 l2) = LAST l1)
2761Proof
2762 GEN_TAC
2763 THEN SNOC_INDUCT_TAC
2764 THEN ASM_REWRITE_TAC
2765 [LENGTH, LENGTH_SNOC, APPEND_SNOC, APPEND_NIL, ELL, TL, FRONT_SNOC]
2766QED
2767
2768Theorem ELL_MEM:
2769 !n l. n < LENGTH l ==> MEM (ELL n l) l
2770Proof
2771 INDUCT_TAC
2772 THEN SNOC_INDUCT_TAC
2773 THEN ASM_REWRITE_TAC [NOT_LESS_0, LESS_MONO_EQ, LENGTH_SNOC, ELL_0_SNOC,
2774 MEM_SNOC, ELL_SUC_SNOC, LENGTH]
2775 THEN REPEAT STRIP_TAC
2776 THEN DISJ2_TAC
2777 THEN RES_TAC
2778QED
2779
2780Theorem ELL_REVERSE:
2781 !n l. n < LENGTH l ==> (ELL n (REVERSE l) = ELL (PRE (LENGTH l - n)) l)
2782Proof
2783 INDUCT_TAC
2784 THEN LIST_INDUCT_TAC
2785 THEN ASM_REWRITE_TAC
2786 [LENGTH, LENGTH_SNOC, REVERSE, SUB_0, ELL, LAST_SNOC, FRONT_SNOC,
2787 NOT_LESS_0, LESS_MONO_EQ, PRE, ELL_LENGTH_CONS, SUB_MONO_EQ]
2788 THEN REPEAT STRIP_TAC
2789 THEN RES_THEN SUBST1_TAC
2790 THEN MATCH_MP_TAC (GSYM ELL_CONS)
2791 THEN REWRITE_TAC (PRE_SUB1 :: (map GSYM [SUB_PLUS, ADD1]))
2792 THEN IMP_RES_TAC (numLib.DECIDE ``!m n. n < m ==> m - SUC n < m``)
2793QED
2794
2795Theorem ELL_REVERSE_EL:
2796 !n l. n < LENGTH l ==> (ELL n (REVERSE l) = EL n l)
2797Proof
2798 INDUCT_TAC
2799 THEN LIST_INDUCT_TAC
2800 THEN ASM_REWRITE_TAC
2801 [LENGTH, LENGTH_SNOC, REVERSE, REVERSE_SNOC, EL, ELL, HD, TL,
2802 LAST_SNOC, FRONT_SNOC, NOT_LESS_0, LESS_MONO_EQ, SUB_0]
2803QED
2804
2805val LESS_EQ_SPLIT = numLib.DECIDE ``!p n m. m + n <= p ==> n <= p /\ m <= p``
2806
2807val SUB_LESS_EQ_ADD =
2808 numLib.DECIDE ``!p n m. n <= p ==> (m <= p - n <=> m + n <= p)``
2809
2810Theorem BUTLASTN_TAKE_UNCOND:
2811 !n l. BUTLASTN n l = TAKE (LENGTH l - n) l
2812Proof
2813 simp[BUTLASTN_def] >> Induct >> simp[] >>
2814 Cases using SNOC_CASES >> simp[TAKE_APPEND, SNOC_APPEND] >>
2815 simp[ARITH_PROVE “1 - SUC x = 0”, ARITH_PROVE “x + 1 - SUC y = x - y”]
2816QED
2817
2818Theorem BUTLASTN_TAKE:
2819 !n l. n <= LENGTH l ==> (BUTLASTN n l = TAKE (LENGTH l - n) l)
2820Proof
2821 simp[BUTLASTN_TAKE_UNCOND]
2822QED
2823
2824Theorem TAKE_BUTLASTN:
2825 !n l. n <= LENGTH l ==> TAKE n l = BUTLASTN (LENGTH l - n) l
2826Proof
2827 simp[BUTLASTN_TAKE]
2828QED
2829
2830Theorem LASTN_DROP_UNCOND:
2831 !n l. LASTN n l = DROP (LENGTH l - n) l
2832Proof
2833 simp[LASTN_def] >> Induct >> simp[] >>
2834 Cases using SNOC_CASES >> simp[DROP_APPEND, SNOC_APPEND, ADD1] >>
2835 simp[ARITH_PROVE “a - (b :num) - a = 0”]
2836QED
2837
2838Theorem LASTN_DROP:
2839 !n l. n <= LENGTH l ==> LASTN n l = DROP (LENGTH l - n) l
2840Proof
2841 simp[LASTN_DROP_UNCOND]
2842QED
2843
2844Theorem DROP_LASTN:
2845 !n l. n <= LENGTH l ==> DROP n l = LASTN (LENGTH l - n) l
2846Proof
2847 simp[LASTN_DROP_UNCOND]
2848QED
2849
2850(* from examples/lambda/basics/appFOLDLScript.sml *)
2851Theorem DROP_PREn_LAST_CONS :
2852 !l n. 0 < n /\ n <= LENGTH l ==>
2853 (DROP (n - 1) l = LAST (TAKE n l) :: DROP n l)
2854Proof
2855 Induct THEN SRW_TAC [numSimps.ARITH_ss][TAKE_def, DROP_def] THENL [
2856 `n = 1` by numLib.DECIDE_TAC THEN SRW_TAC [][],
2857 `n = 1` by numLib.DECIDE_TAC THEN SRW_TAC [][],
2858 `(l = []) \/ ?h t0. l = h :: t0` by METIS_TAC [list_CASES] THEN
2859 FULL_SIMP_TAC (srw_ss() ++ numSimps.ARITH_ss) [] ]
2860QED
2861
2862Theorem LAST_TAKE_EL :
2863 !l n. 0 < n /\ n <= LENGTH l ==> LAST (TAKE n l) = EL (PRE n) l
2864Proof
2865 simp [PRE_SUB1]
2866 >> Induct_on ‘l’ >> rw []
2867 >> simp [LAST_DEF]
2868 >> Cases_on ‘l = []’ >> fs []
2869 >- (‘n = 1’ by simp [] >> simp [])
2870 >> Cases_on ‘n <= 1’
2871 >- (‘n = 1’ by simp [] >> simp [])
2872 >> simp [EL_CONS]
2873 >> ‘PRE (n - 1) = n - 2’ by simp []
2874 >> simp []
2875QED
2876
2877val SUB_ADD_lem =
2878 numLib.DECIDE ``!l n m. n + m <= l ==> ((l - (n + m)) + n = l - m)``
2879
2880Theorem SEG_LASTN_BUTLASTN:
2881 !n m l.
2882 n + m <= LENGTH l ==>
2883 (SEG n m l = LASTN n (BUTLASTN (LENGTH l - (n + m)) l))
2884Proof
2885 let
2886 val th2 = SUBS [(REWRITE_RULE [SUB_LESS_EQ]
2887 (SPECL [``LENGTH (l:'a list) - m``, ``l:'a list``]
2888 LENGTH_LASTN))]
2889 (SPECL [``n:num``, ``LASTN (LENGTH l - m) (l:'a list)``]
2890 TAKE_BUTLASTN)
2891 val th3 = UNDISCH_ALL (SUBS [UNDISCH_ALL
2892 (SPECL [``LENGTH (l:'a list)``,``m:num``,``n:num``]
2893 SUB_LESS_EQ_ADD)] th2)
2894 val th4 = PURE_ONCE_REWRITE_RULE [ADD_SYM] (REWRITE_RULE
2895 [UNDISCH_ALL
2896 (SPECL [``LENGTH (l:'a list)``,``n:num``,``m:num``]
2897 SUB_ADD_lem), SUB_LESS_EQ]
2898 (PURE_ONCE_REWRITE_RULE [ADD_SYM]
2899 (SPECL [``n:num``,``LENGTH (l:'a list) - (n + m)``,
2900 ``l:'a list``] LASTN_BUTLASTN)))
2901 in
2902 REPEAT GEN_TAC
2903 THEN DISCH_TAC
2904 THEN IMP_RES_THEN SUBST1_TAC SEG_TAKE_DROP
2905 THEN IMP_RES_TAC LESS_EQ_SPLIT
2906 THEN SUBST1_TAC (UNDISCH_ALL (SPECL [``m:num``,``l:'a list``] DROP_LASTN))
2907 THEN SUBST1_TAC th3
2908 THEN REWRITE_TAC [GSYM SUB_PLUS]
2909 THEN SUBST_OCCS_TAC [([1], (SPEC_ALL ADD_SYM))]
2910 THEN CONV_TAC SYM_CONV
2911 THEN ACCEPT_TAC th4
2912 end
2913QED
2914
2915Theorem DROP_REVERSE:
2916 !n l. n <= LENGTH l ==> (DROP n (REVERSE l) = REVERSE (BUTLASTN n l))
2917Proof
2918 INDUCT_TAC
2919 THEN SNOC_INDUCT_TAC
2920 THEN ASM_REWRITE_TAC [NOT_SUC_LESS_EQ_0, LENGTH, LENGTH_SNOC, DROP,
2921 BUTLASTN, LESS_EQ_MONO, REVERSE_SNOC]
2922QED
2923
2924Theorem BUTLASTN_REVERSE:
2925 !n l. n <= LENGTH l ==> (BUTLASTN n (REVERSE l) = REVERSE (DROP n l))
2926Proof
2927 INDUCT_TAC
2928 THEN LIST_INDUCT_TAC
2929 THEN ASM_REWRITE_TAC
2930 [NOT_SUC_LESS_EQ_0, LENGTH, DROP, BUTLASTN, LESS_EQ_MONO, REVERSE]
2931QED
2932
2933Theorem LASTN_REVERSE:
2934 !n l. n <= LENGTH l ==> (LASTN n (REVERSE l) = REVERSE (TAKE n l))
2935Proof
2936 INDUCT_TAC
2937 THEN LIST_INDUCT_TAC
2938 THEN ASM_REWRITE_TAC [NOT_SUC_LESS_EQ_0, LENGTH, TAKE, LASTN, LESS_EQ_MONO,
2939 REVERSE, SNOC_11]
2940QED
2941
2942Theorem TAKE_REVERSE:
2943 !n l. n <= LENGTH l ==> (TAKE n (REVERSE l) = REVERSE (LASTN n l))
2944Proof
2945 INDUCT_TAC
2946 THEN SNOC_INDUCT_TAC
2947 THEN ASM_REWRITE_TAC [NOT_SUC_LESS_EQ_0, LENGTH, LENGTH_SNOC, TAKE, LASTN,
2948 LESS_EQ_MONO, REVERSE, REVERSE_SNOC, CONS_11]
2949QED
2950
2951Theorem SEG_REVERSE:
2952 !n m l.
2953 n + m <= LENGTH l ==>
2954 (SEG n m (REVERSE l) = REVERSE (SEG n (LENGTH l - (n + m)) l))
2955Proof
2956 let
2957 val SUB_LE_ADD =
2958 SPECL [``LENGTH (l:'a list)``, ``m:num``, ``n:num``] SUB_LESS_EQ_ADD
2959 val SEG_lem =
2960 REWRITE_RULE [SUB_LESS_EQ] (PURE_ONCE_REWRITE_RULE [ADD_SYM]
2961 (SUBS[UNDISCH_ALL(SPEC_ALL(SPEC``LENGTH(l:'a list)`` SUB_ADD_lem))]
2962 (PURE_ONCE_REWRITE_RULE [ADD_SYM]
2963 (SPECL[``n:num``,``LENGTH(l:'a list) -(n+m)``,``l:'a list``]
2964 SEG_LASTN_BUTLASTN))))
2965 val lem =
2966 PURE_ONCE_REWRITE_RULE [ADD_SUB](PURE_ONCE_REWRITE_RULE [ADD_SYM]
2967 (SPEC ``LENGTH(l:'a list)``
2968 (UNDISCH_ALL(SPECL[``LENGTH(l:'a list)``,``m:num``]SUB_SUB))))
2969 in
2970 REPEAT GEN_TAC THEN DISCH_TAC
2971 THEN FIRST_ASSUM (SUBST1_TAC o (MATCH_MP SEG_TAKE_DROP)
2972 o (SUBS[SYM (SPEC``l:'a list`` LENGTH_REVERSE)]))
2973 THEN IMP_RES_TAC LESS_EQ_SPLIT
2974 THEN IMP_RES_THEN SUBST1_TAC (SPECL[``m:num``,``l:'a list``] DROP_REVERSE)
2975 THEN FIRST_ASSUM
2976 (ASSUME_TAC o (MP(SPECL[``m:num``,``(l:'a list)``]LENGTH_BUTLASTN)))
2977 THEN FIRST_ASSUM (fn t => ASSUME_TAC (SUBS[t]
2978 (SPECL[``n:num``,``BUTLASTN m (l:'a list)``] TAKE_REVERSE)))
2979 THEN FIRST_ASSUM (SUBST_ALL_TAC o (MP SUB_LE_ADD))
2980 THEN RES_THEN SUBST1_TAC THEN AP_TERM_TAC
2981 THEN SUBST1_TAC SEG_lem THEN SUBST1_TAC lem THEN REFL_TAC
2982 end
2983QED
2984
2985Theorem LENGTH_REPLICATE[simp]:
2986 !n x. LENGTH (REPLICATE n x) = n
2987Proof INDUCT_TAC THEN ASM_REWRITE_TAC [REPLICATE, LENGTH]
2988QED
2989
2990Theorem MEM_REPLICATE[simp]:
2991 !n x y. MEM y (REPLICATE n x) <=> x = y /\ 0 < n
2992Proof INDUCT_TAC THEN simp [NOT_LESS_0, MEM, EQ_IMP_THM, DISJ_IMP_THM]
2993QED
2994
2995(* |- !l. AND_EL l <=> FOLDL $/\ T l *)
2996Theorem AND_EL_FOLDL =
2997 GEN_ALL (CONV_RULE (DEPTH_CONV ETA_CONV)
2998 (REWRITE_RULE [EVERY_FOLDL, combinTheory.I_THM]
2999 (AP_THM AND_EL_DEF ``l:bool list``)));
3000
3001(* |- !l. AND_EL l <=> FOLDR $/\ T l *)
3002Theorem AND_EL_FOLDR =
3003 GEN_ALL (CONV_RULE (DEPTH_CONV ETA_CONV)
3004 (REWRITE_RULE [EVERY_FOLDR, combinTheory.I_THM]
3005 (AP_THM AND_EL_DEF ``l:bool list``)));
3006
3007(* |- !l. OR_EL l <=> FOLDL $\/ F l *)
3008Theorem OR_EL_FOLDL =
3009 GEN_ALL (CONV_RULE (DEPTH_CONV ETA_CONV)
3010 (REWRITE_RULE [EXISTS_FOLDL, combinTheory.I_THM]
3011 (AP_THM OR_EL_DEF ``l:bool list``)));
3012
3013(* |- !l. OR_EL l <=> FOLDR $\/ F l *)
3014Theorem OR_EL_FOLDR =
3015 GEN_ALL (CONV_RULE (DEPTH_CONV ETA_CONV)
3016 (REWRITE_RULE [EXISTS_FOLDR, combinTheory.I_THM]
3017 (AP_THM OR_EL_DEF ``l:bool list``)));
3018
3019Theorem ITSET_TO_FOLDR:
3020 !f s b. FINITE s ==> ITSET f s b = FOLDR f b (REVERSE (SET_TO_LIST s))
3021Proof
3022 rw[listTheory.ITSET_eq_FOLDL_SET_TO_LIST,FOLDR_REVERSE,combinTheory.C_DEF]
3023QED
3024
3025(*---------------------------------------------------------------------------
3026 A bunch of properties relating to the use of IS_PREFIX as a partial order
3027 ---------------------------------------------------------------------------*)
3028
3029(* |- !x. [] <<= x /\ (x <<= [] <=> x = []) *)
3030Theorem IS_PREFIX_NIL = isPREFIX_NIL
3031
3032(* |- !x. x <<= x *)
3033Theorem IS_PREFIX_REFL[simp] = isPREFIX_REFL
3034
3035(* |- !x y. x <<= y /\ y <<= x ==> x = y *)
3036Theorem IS_PREFIX_ANTISYM = isPREFIX_ANTISYM
3037
3038(* |- !x y z. y <<= x /\ z <<= y ==> z <<= x *)
3039Theorem IS_PREFIX_TRANS :
3040 !x y z. IS_PREFIX x y /\ IS_PREFIX y z ==> IS_PREFIX x z
3041Proof
3042 rpt STRIP_TAC
3043 >> MATCH_MP_TAC isPREFIX_TRANS
3044 >> Q.EXISTS_TAC ‘y’ >> rw []
3045QED
3046
3047Theorem IS_PREFIX_BUTLAST:
3048 !x y. IS_PREFIX (x::y) (FRONT (x::y))
3049Proof
3050 REPEAT GEN_TAC
3051 THEN Q.SPEC_TAC (`x`, `x`)
3052 THEN Q.SPEC_TAC (`y`, `y`)
3053 THEN INDUCT_THEN list_INDUCT ASSUME_TAC
3054 THEN ASM_SIMP_TAC boolSimps.bool_ss [FRONT_CONS, IS_PREFIX]
3055QED
3056
3057Theorem IS_PREFIX_BUTLAST' :
3058 !l. l <> [] ==> IS_PREFIX l (FRONT l)
3059Proof
3060 Q.X_GEN_TAC ‘l’
3061 >> Cases_on ‘l’ >- SRW_TAC[][]
3062 >> SRW_TAC[][IS_PREFIX_BUTLAST]
3063QED
3064
3065Theorem IS_PREFIX_LENGTH:
3066 !x y. IS_PREFIX y x ==> LENGTH x <= LENGTH y
3067Proof
3068 INDUCT_THEN list_INDUCT ASSUME_TAC
3069 THEN ASM_SIMP_TAC boolSimps.bool_ss [LENGTH, ZERO_LESS_EQ]
3070 THEN REPEAT GEN_TAC
3071 THEN MP_TAC (Q.SPEC `y` list_CASES)
3072 THEN STRIP_TAC
3073 THEN ASM_SIMP_TAC boolSimps.bool_ss [IS_PREFIX, LENGTH, LESS_EQ_MONO]
3074QED
3075
3076Theorem IS_PREFIX_LENGTH_ANTI:
3077 !x y. IS_PREFIX y x /\ (LENGTH x = LENGTH y) <=> (x = y)
3078Proof
3079 INDUCT_THEN list_INDUCT ASSUME_TAC
3080 THEN1 PROVE_TAC [LENGTH_NIL, IS_PREFIX_REFL]
3081 THEN REPEAT GEN_TAC
3082 THEN MP_TAC (Q.SPEC `y` list_CASES)
3083 THEN STRIP_TAC
3084 THENL [ASM_SIMP_TAC boolSimps.bool_ss [IS_PREFIX, LENGTH, LESS_EQ_MONO]
3085 THEN PROVE_TAC [NOT_CONS_NIL],
3086 ASM_SIMP_TAC boolSimps.bool_ss [IS_PREFIX, LENGTH, CONS_11]
3087 THEN PROVE_TAC [numTheory.INV_SUC, IS_PREFIX_REFL]]
3088QED
3089
3090(* |- !x y z. z <<= SNOC x y <=> z <<= y \/ z = SNOC x y *)
3091Theorem IS_PREFIX_SNOC = isPREFIX_SNOC
3092
3093Theorem IS_PREFIX_APPEND1:
3094 !a b c. IS_PREFIX c (APPEND a b) ==> IS_PREFIX c a
3095Proof
3096 INDUCT_THEN list_INDUCT ASSUME_TAC
3097 THEN ASM_SIMP_TAC boolSimps.bool_ss [IS_PREFIX, APPEND]
3098 THEN REPEAT GEN_TAC
3099 THEN MP_TAC (Q.SPEC `c` list_CASES)
3100 THEN STRIP_TAC
3101 THEN ASM_SIMP_TAC boolSimps.bool_ss [IS_PREFIX]
3102 THEN PROVE_TAC []
3103QED
3104
3105Theorem IS_PREFIX_APPEND2:
3106 !a b c. IS_PREFIX (APPEND b c) a ==> IS_PREFIX b a \/ IS_PREFIX a b
3107Proof
3108 INDUCT_THEN list_INDUCT ASSUME_TAC
3109 THEN ASM_SIMP_TAC boolSimps.bool_ss [IS_PREFIX]
3110 THEN REPEAT GEN_TAC
3111 THEN MP_TAC (Q.SPEC `b` list_CASES)
3112 THEN STRIP_TAC
3113 THEN ASM_SIMP_TAC boolSimps.bool_ss [IS_PREFIX, APPEND]
3114 THEN PROVE_TAC []
3115QED
3116
3117Theorem IS_PREFIX_APPENDS[simp]:
3118 !a b c. IS_PREFIX (APPEND a c) (APPEND a b) <=> IS_PREFIX c b
3119Proof
3120 INDUCT_THEN list_INDUCT ASSUME_TAC
3121 THEN ASM_SIMP_TAC boolSimps.bool_ss [APPEND, IS_PREFIX]
3122QED
3123
3124(* |- !a c. a <<= a ++ c *)
3125Theorem IS_PREFIX_APPEND3[simp] =
3126 IS_PREFIX_APPENDS |> SPEC_ALL |> Q.INST [`b` |-> `[]`]
3127 |> REWRITE_RULE [IS_PREFIX, APPEND_NIL]
3128 |> Q.GENL [`c`, `a`]
3129
3130Theorem prefixes_is_prefix_total:
3131 !l l1 l2.
3132 IS_PREFIX l l1 /\ IS_PREFIX l l2 ==> IS_PREFIX l2 l1 \/ IS_PREFIX l1 l2
3133Proof
3134 Induct THEN SIMP_TAC(srw_ss())[IS_PREFIX_NIL] THEN
3135 GEN_TAC THEN Cases THEN SIMP_TAC(srw_ss())[] THEN
3136 Cases THEN SRW_TAC[][]
3137QED
3138
3139(* NOTE: By using LENGTH_TAKE, this ‘n’ is actually ’LENGTH l1’ *)
3140Theorem IS_PREFIX_EQ_TAKE :
3141 !l l1. l1 <<= l <=> ?n. n <= LENGTH l /\ l1 = TAKE n l
3142Proof
3143 rpt GEN_TAC
3144 >> reverse EQ_TAC
3145 >- (STRIP_TAC \\
3146 GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) empty_rewrites
3147 [SYM (Q.SPECL [‘n’, ‘l’] TAKE_DROP)] \\
3148 POP_ASSUM (fn th => ONCE_REWRITE_TAC [th]) \\
3149 PROVE_TAC [IS_PREFIX_APPEND])
3150 (* stage work *)
3151 >> Induct_on ‘l1’ using SNOC_INDUCT
3152 >- (rw [] >> Q.EXISTS_TAC ‘0’ >> rw [])
3153 >> rw [SNOC_APPEND]
3154 >> Q.PAT_X_ASSUM ‘l1 <<= l ==> P’ MP_TAC
3155 >> ‘l1 <<= l’ by PROVE_TAC [IS_PREFIX_APPEND1]
3156 >> RW_TAC std_ss []
3157 >> Q.PAT_X_ASSUM ‘TAKE n l ++ [x] <<= l’ MP_TAC
3158 >> rw [IS_PREFIX_APPEND]
3159 >> Q.EXISTS_TAC ‘SUC n’
3160 >> CONJ_ASM1_TAC
3161 >- (POP_ASSUM (fn th => ONCE_REWRITE_TAC [th]) >> rw [])
3162 (* applying SNOC_EL_TAKE *)
3163 >> Know ‘TAKE (SUC n) l = SNOC (EL n l) (TAKE n l)’
3164 >- (ONCE_REWRITE_TAC [EQ_SYM_EQ] \\
3165 MATCH_MP_TAC SNOC_EL_TAKE >> rw [])
3166 >> DISCH_THEN (fn th => ONCE_REWRITE_TAC [th])
3167 >> Suff ‘EL n l = x’ >- rw [SNOC_APPEND]
3168 >> Q.PAT_X_ASSUM ‘l = _’ (fn th => ONCE_REWRITE_TAC [th])
3169 (* applying el_append3, fortunately *)
3170 >> Q.ABBREV_TAC ‘l1 = TAKE n l’
3171 >> ‘n = LENGTH l1’ by rw [Abbr ‘l1’, LENGTH_TAKE]
3172 >> POP_ASSUM (fn th => ONCE_REWRITE_TAC [th])
3173 >> rw [el_append3]
3174QED
3175
3176(* ‘n <= LENGTH l’ can be removed from RHS *)
3177Theorem IS_PREFIX_EQ_TAKE' :
3178 !l l1. l1 <<= l <=> ?n. l1 = TAKE n l
3179Proof
3180 rpt GEN_TAC
3181 >> EQ_TAC
3182 >- (rw [IS_PREFIX_EQ_TAKE] \\
3183 Q.EXISTS_TAC ‘n’ >> REWRITE_TAC [])
3184 >> STRIP_TAC
3185 >> Cases_on ‘n <= LENGTH l’
3186 >- (rw [IS_PREFIX_EQ_TAKE] \\
3187 Q.EXISTS_TAC ‘n’ >> ASM_REWRITE_TAC [])
3188 >> ‘LENGTH l <= n’ by rw []
3189 >> rw [TAKE_LENGTH_TOO_LONG]
3190QED
3191
3192Theorem IS_PREFIX_IMP_TAKE :
3193 !l l1. l1 <<= l ==> l1 = TAKE (LENGTH l1) l
3194Proof
3195 rw [IS_PREFIX_EQ_TAKE]
3196 >> rw [LENGTH_TAKE]
3197QED
3198
3199Theorem IS_PREFIX_MEM :
3200 !l l1 e. l1 <<= l /\ MEM e l1 ==> MEM e l
3201Proof
3202 RW_TAC std_ss [IS_PREFIX_EQ_TAKE']
3203 >> MATCH_MP_TAC MEM_TAKE
3204 >> Q.EXISTS_TAC ‘n’ >> ASM_REWRITE_TAC []
3205QED
3206
3207(* NOTE: This theorem can also be proved by IS_PREFIX_LENGTH_ANTI and
3208 prefixes_is_prefix_total, but IS_PREFIX_EQ_TAKE is more natural.
3209 *)
3210Theorem IS_PREFIX_EQ_REWRITE :
3211 !l1 l2 l. l1 <<= l /\ l2 <<= l ==> (l1 = l2 <=> LENGTH l1 = LENGTH l2)
3212Proof
3213 rw [IS_PREFIX_EQ_TAKE]
3214 >> rw [LENGTH_TAKE, TAKE_EQ_REWRITE]
3215QED
3216
3217Theorem IS_PREFIX_ALL_DISTINCT :
3218 !l l1. l1 <<= l /\ ALL_DISTINCT l ==> ALL_DISTINCT l1
3219Proof
3220 rw [IS_PREFIX_EQ_TAKE']
3221 >> MATCH_MP_TAC ALL_DISTINCT_TAKE >> rw []
3222QED
3223
3224Theorem IS_PREFIX_FRONT_MONO :
3225 !l1 l2. l1 <> [] /\ l2 <> [] /\ l1 <<= l2 ==> FRONT l1 <<= FRONT l2
3226Proof
3227 rw [IS_PREFIX_EQ_TAKE]
3228 >> Cases_on ‘n = 0’ >> fs []
3229 >> ‘0 < LENGTH l2’ by rw []
3230 >> rw [LENGTH_FRONT, FRONT_TAKE]
3231 >> Q.EXISTS_TAC ‘n - 1’ >> rw []
3232 >> ONCE_REWRITE_TAC [EQ_SYM_EQ]
3233 >> MATCH_MP_TAC TAKE_FRONT >> simp []
3234QED
3235
3236Theorem IS_PREFIX_FRONT_CASES :
3237 !l l1. l <> [] ==> (l1 <<= l <=> l = l1 \/ l1 <<= FRONT l)
3238Proof
3239 rpt GEN_TAC
3240 >> STRIP_TAC
3241 >> reverse EQ_TAC
3242 >- (STRIP_TAC >- rw [IS_PREFIX_REFL] \\
3243 MATCH_MP_TAC IS_PREFIX_TRANS \\
3244 Q.EXISTS_TAC ‘FRONT l’ >> rw [] \\
3245 MATCH_MP_TAC IS_PREFIX_BUTLAST' >> rw [])
3246 >> rw [IS_PREFIX_EQ_TAKE, LENGTH_FRONT]
3247 >> ‘n = LENGTH l \/ n < LENGTH l’ by rw []
3248 >- (DISJ1_TAC >> ONCE_REWRITE_TAC [EQ_SYM_EQ] \\
3249 rw [TAKE_LENGTH_ID_rwt2])
3250 >> DISJ2_TAC
3251 >> Q.EXISTS_TAC ‘n’
3252 >> rw [TAKE_FRONT]
3253QED
3254
3255(* |- !f m n. GENLIST f m <<= GENLIST f n <=> m <= n *)
3256Theorem IS_PREFIX_GENLIST = isPREFIX_GENLIST
3257
3258(* ----------------------------------------------------------------------
3259 longest_prefix
3260
3261 longest string that is a prefix of all elements of a set. If the set
3262 is empty, return []
3263 ---------------------------------------------------------------------- *)
3264
3265Definition common_prefixes_def[nocompute]:
3266 common_prefixes s = { p | !m. m IN s ==> p <<= m}
3267End
3268
3269Theorem common_prefixes_BIGINTER:
3270 common_prefixes s = BIGINTER (IMAGE (\l. { p | p <<= l }) s)
3271Proof
3272 simp[EXTENSION, common_prefixes_def] >> gen_tac >> eq_tac >> rw[]
3273 >- metis_tac[] >>
3274 first_x_assum (Q.SPEC_THEN ‘{ y | y <<= m }’ mp_tac) >> simp[] >>
3275 disch_then irule >> Q.EXISTS_TAC ‘m’ >> simp[]
3276QED
3277
3278Theorem FINITE_prefix:
3279 FINITE { a | a <<= b }
3280Proof
3281 Induct_on ‘b’ >> simp[isPREFIX_CONSR] >> Q.X_GEN_TAC ‘a’ >>
3282 Q.MATCH_ABBREV_TAC ‘FINITE s’ >>
3283 ‘s = {[]} UNION IMAGE (CONS a) { xs | xs <<= b }’ suffices_by simp[] >>
3284 simp[Abbr‘s’, EXTENSION]
3285QED
3286
3287Theorem FINITE_common_prefixes[simp]:
3288 s <> {} ==> FINITE (common_prefixes s)
3289Proof
3290 strip_tac >> simp[common_prefixes_BIGINTER] >> irule FINITE_BIGINTER >>
3291 simp[PULL_EXISTS,FINITE_prefix] >> metis_tac[IN_INSERT,SET_CASES]
3292QED
3293
3294Theorem common_prefixes_NONEMPTY[simp]:
3295 common_prefixes s <> {}
3296Proof
3297 ‘[] IN common_prefixes s’ by simp[common_prefixes_def] >> strip_tac >> fs[]
3298QED
3299
3300Definition longest_prefix_def[nocompute]:
3301 longest_prefix s =
3302 if s = {} then []
3303 else @x. is_measure_maximal LENGTH (common_prefixes s) x
3304End
3305
3306Theorem two_common_prefixes:
3307 s <> {} /\ p1 IN common_prefixes s /\ p2 IN common_prefixes s ==>
3308 p1 <<= p2 \/ p2 <<= p1
3309Proof
3310 rw[common_prefixes_def] >> Cases_on ‘s’ >> fs[] >>
3311 metis_tac[prefixes_is_prefix_total]
3312QED
3313
3314Theorem longest_prefix_UNIQUE:
3315 s <> {} /\ is_measure_maximal LENGTH (common_prefixes s) x /\
3316 is_measure_maximal LENGTH (common_prefixes s) y ==> (x = y)
3317Proof
3318 rw[is_measure_maximal_def] >>
3319 ‘LENGTH x = LENGTH y’ by metis_tac[arithmeticTheory.LESS_EQUAL_ANTISYM] >>
3320 dxrule_all_then strip_assume_tac two_common_prefixes >>
3321 metis_tac[IS_PREFIX_LENGTH_ANTI]
3322QED
3323
3324Theorem common_prefixes_NIL:
3325 [] IN s ==> (common_prefixes s = {[]})
3326Proof
3327 simp[common_prefixes_def, EXTENSION] >> rpt strip_tac >> eq_tac >> strip_tac
3328 >- (first_x_assum drule >> simp[]) >> simp[]
3329QED
3330
3331Theorem longest_prefix_NIL:
3332 [] IN s ==> (longest_prefix s = [])
3333Proof
3334 rw[longest_prefix_def, common_prefixes_NIL] >> SELECT_ELIM_TAC >>
3335 simp[is_measure_maximal_def]
3336QED
3337
3338Theorem NIL_IN_common_prefixes[simp]:
3339 [] IN common_prefixes s
3340Proof
3341 simp[common_prefixes_def]
3342QED
3343
3344Theorem longest_prefix_EMPTY[simp]:
3345 longest_prefix {} = []
3346Proof
3347 simp[longest_prefix_def]
3348QED
3349
3350Theorem longest_prefix_SING[simp]:
3351 longest_prefix {s} = s
3352Proof
3353 simp[longest_prefix_def] >> SELECT_ELIM_TAC >> conj_tac
3354 >- (irule FINITE_is_measure_maximal >> simp[]) >>
3355 simp[is_measure_maximal_def, common_prefixes_def] >> rw[] >>
3356 metis_tac[IS_PREFIX_LENGTH_ANTI, LESS_EQUAL_ANTISYM, IS_PREFIX_LENGTH]
3357QED
3358
3359Theorem common_prefixes_PAIR[simp]:
3360 (common_prefixes {[]; x} = {[]}) /\ (common_prefixes {x; []} = {[]}) /\
3361 (common_prefixes {a::xs; b::ys} =
3362 [] INSERT (if a = b then IMAGE (CONS a) (common_prefixes {xs; ys})
3363 else {}))
3364Proof
3365 simp[common_prefixes_NIL] >> rw[common_prefixes_def] >>
3366 simp[EXTENSION, DISJ_IMP_THM, FORALL_AND_THM, isPREFIX_CONSR] >>
3367 rw[EQ_IMP_THM]
3368QED
3369
3370Theorem longest_prefix_PAIR:
3371 (longest_prefix {[]; ys} = []) /\ (longest_prefix {xs; []} = []) /\
3372 (longest_prefix {x::xs; y::ys} =
3373 if x = y then x :: longest_prefix {xs; ys} else [])
3374Proof
3375 simp[longest_prefix_NIL] >> reverse (rw[])
3376 >- simp[longest_prefix_def] >>
3377 simp[longest_prefix_def] >>
3378 SELECT_ELIM_TAC >> conj_tac
3379 >- (irule FINITE_is_measure_maximal >> simp[]) >>
3380 Q.X_GEN_TAC ‘m’ >>
3381 Q.ABBREV_TAC ‘cset = IMAGE (CONS x) (common_prefixes {xs;ys})’ >>
3382 ‘?c. c IN cset /\ LENGTH ([]:'a list) < LENGTH c’
3383 by (simp[Abbr‘cset’, PULL_EXISTS] >> Q.EXISTS_TAC ‘[]’ >> simp[]) >>
3384 drule_all_then assume_tac is_measure_maximal_INSERT >>
3385 simp[] >> SELECT_ELIM_TAC >> conj_tac
3386 >- (irule FINITE_is_measure_maximal >> simp[]) >>
3387 rw[is_measure_maximal_def, Abbr‘cset’] >> fs[PULL_EXISTS] >>
3388 Q.RENAME_TAC [‘a = b’, ‘a IN common_prefixes {xs;ys}’,
3389 ‘b IN common_prefixes {xs;ys}’] >>
3390 ‘LENGTH a = LENGTH b’ by metis_tac[DECIDE “a <= b /\ b <= a ==> (a = b)”] >>
3391 ‘{xs;ys} <> {}’ by simp[] >>
3392 ‘a <<= b \/ b <<= a’ by metis_tac[two_common_prefixes] >>
3393 metis_tac[IS_PREFIX_LENGTH_ANTI]
3394QED
3395
3396(* lcp2: binary longest common prefix *)
3397Definition lcp2_def:
3398 lcp2 x y = longest_prefix {x;y}
3399End
3400
3401Theorem lcp2_thm:
3402 lcp2 xs ys =
3403 case xs of
3404 | x::xs => (case ys of
3405 | y::ys => if x = y then x :: lcp2 xs ys else []
3406 | _ => [])
3407 | _ => []
3408Proof
3409 Cases_on `xs` >> Cases_on `ys` >> rw[lcp2_def, longest_prefix_PAIR]
3410QED
3411
3412(* lcp: longest common prefix of a list of lists *)
3413Definition lcp_def:
3414 lcp ls = longest_prefix (set ls)
3415End
3416
3417Theorem lcp_nil[simp]:
3418 lcp [] = []
3419Proof
3420 simp[lcp_def]
3421QED
3422
3423Theorem lcp_sing[simp]:
3424 lcp [x] = x
3425Proof
3426 simp[lcp_def]
3427QED
3428
3429(* lcp2 is a prefix of both arguments *)
3430Theorem lcp2_prefix:
3431 lcp2 x y <<= x /\ lcp2 x y <<= y
3432Proof
3433 simp[lcp2_def] >>
3434 MAP_EVERY qid_spec_tac [`y`,`x`] >>
3435 Induct >> simp[longest_prefix_PAIR] >>
3436 gen_tac >> Cases >> simp[longest_prefix_PAIR] >> rw[]
3437QED
3438
3439(* any common prefix of x and y is a prefix of lcp2 x y *)
3440Theorem lcp2_maximal:
3441 p <<= x /\ p <<= y ==> p <<= lcp2 x y
3442Proof
3443 simp[lcp2_def] >>
3444 MAP_EVERY qid_spec_tac [`y`,`x`,`p`] >>
3445 Induct >- simp[] >>
3446 rpt strip_tac >>
3447 Cases_on `x` >> fs[] >>
3448 Cases_on `y` >> fs[longest_prefix_PAIR] >> rw[]
3449QED
3450
3451(* Key lemma: replacing {x;y} with {lcp2 x y} preserves common_prefixes *)
3452Theorem common_prefixes_INSERT2:
3453 common_prefixes ({x; y} UNION rest) =
3454 common_prefixes ({lcp2 x y} UNION rest)
3455Proof
3456 simp[lcp2_def, common_prefixes_def, EXTENSION] >>
3457 gen_tac >> eq_tac >> rw[] >>
3458 metis_tac[lcp2_def, lcp2_maximal, lcp2_prefix, IS_PREFIX_TRANS]
3459QED
3460
3461(* Key lemma: replacing {x;y} with {lcp2 x y} preserves longest_prefix *)
3462Theorem longest_prefix_INSERT2:
3463 longest_prefix ({x; y} UNION rest) = longest_prefix ({lcp2 x y} UNION rest)
3464Proof
3465 `{x; y} UNION rest <> {} /\ {lcp2 x y} UNION rest <> {}`
3466 by simp[] >>
3467 simp[longest_prefix_def, lcp2_def, common_prefixes_INSERT2]
3468QED
3469
3470Theorem lcp_cons2:
3471 lcp (x::y::xs) = lcp (lcp2 x y :: xs)
3472Proof
3473 simp[lcp_def, lcp2_def] >>
3474 metis_tac[lcp2_def, longest_prefix_INSERT2, INSERT_UNION_EQ, UNION_EMPTY, INSERT_SING_UNION]
3475QED
3476
3477Theorem lcp_thm:
3478 !ls. (!x. MEM x ls ==> lcp ls <<= x) /\
3479 (ls <> [] ==> !p. (!x. MEM x ls ==> p <<= x) ==> p <<= lcp ls)
3480Proof
3481 simp[lcp_def] >> rw[]
3482 >- (`set ls <> {}` by (Cases_on `ls` >> fs[]) >>
3483 simp[longest_prefix_def] >> SELECT_ELIM_TAC >> conj_tac
3484 >- (irule FINITE_is_measure_maximal >> simp[]) >>
3485 simp[is_measure_maximal_def, common_prefixes_def])
3486 >- (`p IN common_prefixes (set ls)` by simp[common_prefixes_def] >>
3487 `set ls <> {}` by (Cases_on `ls` >> fs[]) >>
3488 simp[longest_prefix_def] >> SELECT_ELIM_TAC >> conj_tac
3489 >- (irule FINITE_is_measure_maximal >> simp[]) >>
3490 simp[is_measure_maximal_def] >> rw[] >>
3491 `x IN common_prefixes (set ls)` by simp[] >>
3492 `p <<= x \/ x <<= p` by metis_tac[two_common_prefixes] >>
3493 metis_tac[IS_PREFIX_LENGTH, IS_PREFIX_LENGTH_ANTI, LESS_EQUAL_ANTISYM])
3494QED
3495
3496Theorem lcp2_assoc:
3497 lcp2 (lcp2 x y) z = lcp2 x (lcp2 y z)
3498Proof
3499 simp[lcp2_def] >>
3500 MAP_EVERY qid_spec_tac [`z`,`y`,`x`] >>
3501 Induct >> rw[longest_prefix_PAIR] >>
3502 Cases_on `y` >> rw[longest_prefix_PAIR] >>
3503 Cases_on `z` >> rw[longest_prefix_PAIR] >>
3504 rw[] >> fs[longest_prefix_PAIR]
3505QED
3506
3507Theorem lcp_oneline:
3508 lcp ls =
3509 case ls of
3510 | [] => []
3511 | [x] => x
3512 | x::y::xs => lcp (lcp2 x y :: xs)
3513Proof
3514 Cases_on `ls` >> rw[lcp_nil, lcp_sing] >>
3515 Cases_on `t` >> rw[lcp_sing, lcp_cons2]
3516QED
3517
3518Theorem lcp_CONS:
3519 lcp (x::xs) = if NULL xs then x else lcp2 x (lcp xs)
3520Proof
3521 qid_spec_tac `x` >>
3522 Induct_on `xs` >> rw[lcp_sing, lcp_cons2] >>
3523 simp[lcp2_def, lcp2_assoc]
3524QED
3525
3526Theorem lcp2_is_nil:
3527 lcp2 x y = [] <=> (x = [] \/ y = [] \/ HD x <> HD y)
3528Proof
3529 rw[lcp2_def, EQ_IMP_THM]
3530 >> Cases_on `x` >> Cases_on `y` >> fs[longest_prefix_PAIR]
3531QED
3532
3533Theorem lcp_is_nil:
3534 !ls. lcp ls = [] <=>
3535 (ls = [] \/ ?x y. MEM x ls /\ MEM y ls /\ lcp2 x y = [])
3536Proof
3537 Induct_on `ls` >> rw[]
3538 >> rw[lcp_CONS]
3539 >> fs[NULL_EQ, lcp2_is_nil]
3540 >> Cases_on `lcp ls` >> fs[]
3541 >- metis_tac[]
3542 >> Cases_on `h` >> fs[]
3543 >- metis_tac[]
3544 >> Q.MATCH_GOALSUB_RENAME_TAC `h1 = h2 ==> _`
3545 >> Q.SPEC_THEN `ls` mp_tac lcp_thm
3546 >> rw[NULL_EQ]
3547 >> Cases_on `h1 <> h2` >> fs[]
3548 >- (Cases_on `ls` >> fs[]
3549 >> Q.MATCH_GOALSUB_RENAME_TAC `h1::t1`
3550 >> MAP_EVERY Q.EXISTS_TAC [`h1::t1`, `h`]
3551 >> simp[]
3552 >> Cases_on `h` >> fs[]
3553 >> full_simp_tac (srw_ss() ++ boolSimps.DNF_ss) [] >> rw[])
3554 >> rw[EQ_IMP_THM]
3555 >- metis_tac[]
3556 >> TRY (first_x_assum drule >> CASE_TAC >> rw[] >> NO_TAC)
3557 >> metis_tac[]
3558QED
3559
3560(*---------------------------------------------------------------------------
3561 A list of numbers
3562 ---------------------------------------------------------------------------*)
3563
3564Theorem COUNT_LIST_GENLIST:
3565 !n. COUNT_LIST n = GENLIST I n
3566Proof
3567 Induct_on `n`
3568 THEN1 SIMP_TAC std_ss [GENLIST, COUNT_LIST_def]
3569 THEN ASM_SIMP_TAC std_ss
3570 [COUNT_LIST_def, GENLIST_CONS, MAP_GENLIST]
3571QED
3572
3573Theorem LENGTH_COUNT_LIST:
3574 !n. LENGTH (COUNT_LIST n) = n
3575Proof
3576 SIMP_TAC std_ss [COUNT_LIST_GENLIST, LENGTH_GENLIST]
3577QED
3578
3579Theorem EL_COUNT_LIST:
3580 !m n. m < n ==> (EL m (COUNT_LIST n) = m)
3581Proof
3582 SIMP_TAC std_ss [COUNT_LIST_GENLIST, EL_GENLIST]
3583QED
3584
3585Theorem MEM_COUNT_LIST:
3586 !m n. MEM m (COUNT_LIST n) <=> m < n
3587Proof
3588 SIMP_TAC (std_ss++boolSimps.CONJ_ss)
3589 [MEM_EL, EL_COUNT_LIST, LENGTH_COUNT_LIST, EL_COUNT_LIST]
3590QED
3591
3592Theorem COUNT_LIST_SNOC:
3593 (COUNT_LIST 0 = []) /\
3594 (!n. COUNT_LIST (SUC n) = SNOC n (COUNT_LIST n))
3595Proof
3596 SIMP_TAC std_ss [COUNT_LIST_GENLIST, GENLIST]
3597QED
3598
3599Theorem COUNT_LIST_COUNT:
3600 !n. LIST_TO_SET (COUNT_LIST n) = count n
3601Proof
3602 Induct_on `n`
3603 THEN1 SIMP_TAC std_ss
3604 [pred_setTheory.COUNT_ZERO, COUNT_LIST_def,
3605 LIST_TO_SET_THM]
3606 THEN ASM_SIMP_TAC std_ss
3607 [COUNT_LIST_SNOC, pred_setTheory.COUNT_SUC,
3608 LIST_TO_SET_APPEND, SNOC_APPEND,
3609 LIST_TO_SET_THM]
3610 THEN SIMP_TAC std_ss
3611 [pred_setTheory.IN_UNION, pred_setTheory.IN_SING,
3612 pred_setTheory.EXTENSION, pred_setTheory.IN_INSERT]
3613 THEN PROVE_TAC []
3614QED
3615
3616Theorem COUNT_LIST_ADD:
3617 !n m. COUNT_LIST (n + m) =
3618 COUNT_LIST n ++ MAP (\n'. n' + n) (COUNT_LIST m)
3619Proof
3620 Induct_on `n`
3621 THEN1 SIMP_TAC std_ss [COUNT_LIST_def, APPEND, MAP_ID]
3622 THEN GEN_TAC
3623 THEN REWRITE_TAC [COUNT_LIST_SNOC]
3624 THEN `SUC n + m = n + SUC m` by DECIDE_TAC
3625 THEN ASM_SIMP_TAC std_ss
3626 [COUNT_LIST_def, MAP, MAP_MAP_o, combinTheory.o_DEF,
3627 SNOC_APPEND, GSYM APPEND_ASSOC, APPEND]
3628 THEN SIMP_TAC std_ss [arithmeticTheory.ADD_CLAUSES]
3629QED
3630
3631Theorem MAP_COUNT_LIST:
3632 MAP f (COUNT_LIST n) = GENLIST f n
3633Proof rw[COUNT_LIST_GENLIST,MAP_GENLIST]
3634QED
3635
3636Theorem SUM_IMAGE_count_SUM_GENLIST:
3637 SIGMA f (count n) = SUM (GENLIST f n)
3638Proof
3639 Induct_on ‘n’ >>
3640 simp[SUM_IMAGE_THM, COUNT_SUC, GENLIST, SUM_SNOC]
3641QED
3642
3643Theorem SUM_IMAGE_count_MULT:
3644 (!m. m < n ==> (g m = SIGMA (\x. f (x + k * m)) (count k))) ==>
3645 (SIGMA f (count (k * n)) = SIGMA g (count n))
3646Proof
3647 simp[SUM_IMAGE_count_SUM_GENLIST] >>
3648 Induct_on ‘n’ >- simp[] >>
3649 simp[MULT_SUC, GENLIST_APPEND, GENLIST,
3650 SUM_APPEND,
3651 SUM_SNOC]
3652QED
3653
3654Theorem sum_of_sums:
3655 SIGMA (\m. SIGMA (f m) (count a)) (count b) =
3656 SIGMA (\m. f (m DIV a) (m MOD a)) (count (a * b))
3657Proof
3658Cases_on ‘a=0’ THEN SRW_TAC [][SUM_IMAGE_THM,SUM_IMAGE_ZERO] THEN
3659Cases_on ‘b=0’ THEN SRW_TAC [][SUM_IMAGE_THM,SUM_IMAGE_ZERO] THEN
3660MATCH_MP_TAC EQ_SYM THEN
3661MATCH_MP_TAC SUM_IMAGE_count_MULT THEN
3662SRW_TAC [][] THEN
3663MATCH_MP_TAC SUM_IMAGE_CONG THEN
3664SRW_TAC [][] THEN
3665METIS_TAC [ADD_SYM,MULT_SYM,DIV_MULT,MOD_MULT]
3666QED
3667
3668(*---------------------------------------------------------------------------
3669 General theorems about lists. From Anthony Fox's and Thomas Tuerk's theories.
3670 Added by Thomas Tuerk
3671 ---------------------------------------------------------------------------*)
3672
3673Theorem ZIP_TAKE_LEQ:
3674 !n a b.
3675 n <= LENGTH a /\ LENGTH a <= LENGTH b ==>
3676 (ZIP (TAKE n a, TAKE n b) = TAKE n (ZIP (a, TAKE (LENGTH a) b)))
3677Proof
3678 Induct_on `n`
3679 THEN ASM_SIMP_TAC list_ss [TAKE]
3680 THEN Cases_on `a`
3681 THEN Cases_on `b`
3682 THEN ASM_SIMP_TAC list_ss [TAKE, ZIP]
3683QED
3684
3685Theorem ZIP_TAKE:
3686 !n a b.
3687 n <= LENGTH a /\ (LENGTH a = LENGTH b) ==>
3688 (ZIP (TAKE n a, TAKE n b) = TAKE n (ZIP (a, b)))
3689Proof
3690 SIMP_TAC arith_ss [ZIP_TAKE_LEQ, TAKE_LENGTH_ID]
3691QED
3692
3693Theorem ZIP_APPEND:
3694 !a b c d.
3695 (LENGTH a = LENGTH b) /\ (LENGTH c = LENGTH d) ==>
3696 (ZIP (a, b) ++ ZIP (c, d) = ZIP (a ++ c, b ++ d))
3697Proof
3698 Induct_on `b` THEN1 SIMP_TAC list_ss [LENGTH_NIL]
3699 THEN Induct_on `d` THEN1 SIMP_TAC list_ss [LENGTH_NIL]
3700 THEN Induct_on `a` THEN1 SIMP_TAC list_ss [LENGTH_NIL]
3701 THEN Induct_on `c` THEN1 SIMP_TAC list_ss [LENGTH_NIL]
3702 THEN MAP_EVERY Q.X_GEN_TAC [`h1`,`h2`,`h3`,`h4`]
3703 THEN RW_TAC list_ss []
3704 THEN `LENGTH (h1::c) = LENGTH (h3::d)` by ASM_SIMP_TAC list_ss []
3705 THEN `ZIP (a, b) ++ ZIP (h1::c, h3::d) = ZIP (a ++ h1::c, b ++ h3::d)`
3706 by ASM_SIMP_TAC list_ss []
3707 THEN FULL_SIMP_TAC list_ss []
3708QED
3709
3710Theorem APPEND_ASSOC_CONS:
3711 !l1 h l2 l3. (l1 ++ (h::l2) ++ l3 = l1 ++ h::(l2 ++ l3))
3712Proof
3713 REWRITE_TAC [GSYM APPEND_ASSOC, APPEND]
3714QED
3715
3716Theorem APPEND_SNOC1:
3717 !l1 x l2. SNOC x l1 ++ l2 = l1 ++ x::l2
3718Proof
3719 PROVE_TAC [SNOC_APPEND, CONS_APPEND, APPEND_ASSOC]
3720QED
3721
3722Theorem FOLDL_MAP2:
3723 !f e g l. FOLDL f e (MAP g l) = FOLDL (\x y. f x (g y)) e l
3724Proof
3725 GEN_TAC
3726 THEN GEN_TAC
3727 THEN GEN_TAC
3728 THEN SNOC_INDUCT_TAC
3729 THEN ASM_REWRITE_TAC [MAP, FOLDL, FOLDL_SNOC, MAP_SNOC, FOLDR]
3730 THEN BETA_TAC
3731 THEN REWRITE_TAC []
3732QED
3733
3734Theorem SPLITP_EVERY:
3735 !P l. EVERY (\x. ~P x) l ==> (SPLITP P l = (l, []))
3736Proof
3737 Induct_on `l` THEN SRW_TAC [] [SPLITP]
3738QED
3739
3740Theorem MEM_FRONT:
3741 !l e y. MEM y (FRONT (e::l)) ==> MEM y (e::l)
3742Proof
3743 Induct_on `l` THEN FULL_SIMP_TAC list_ss [DISJ_IMP_THM, MEM]
3744QED
3745
3746Theorem MEM_FRONT_NOT_NIL :
3747 !l y. l <> [] /\ MEM y (FRONT l) ==> MEM y l
3748Proof
3749 rpt STRIP_TAC
3750 >> Cases_on ‘l’ >> FULL_SIMP_TAC std_ss []
3751 >> MATCH_MP_TAC MEM_FRONT >> ASM_REWRITE_TAC []
3752QED
3753
3754Theorem FRONT_APPEND:
3755 !l1 l2 e. FRONT (l1 ++ e::l2) = l1 ++ FRONT (e::l2)
3756Proof
3757 Induct_on `l1` THEN ASM_SIMP_TAC list_ss [FRONT_DEF]
3758QED
3759
3760Theorem FRONT_APPEND_NOT_NIL :
3761 !l1 l2. l2 <> [] ==> FRONT (l1 ++ l2) = l1 ++ FRONT l2
3762Proof
3763 rpt STRIP_TAC
3764 >> Cases_on ‘l2’
3765 >> FULL_SIMP_TAC std_ss [FRONT_APPEND]
3766QED
3767
3768Theorem LAST_APPEND_NOT_NIL :
3769 !l1 l2. l2 <> [] ==> LAST (l1 ++ l2) = LAST l2
3770Proof
3771 rpt STRIP_TAC
3772 >> Cases_on ‘l2’
3773 >> FULL_SIMP_TAC std_ss [LAST_APPEND_CONS]
3774QED
3775
3776Theorem EL_FRONT:
3777 !l n. n < LENGTH (FRONT l) /\ ~NULL l ==> (EL n (FRONT l) = EL n l)
3778Proof
3779 Induct_on `l`
3780 THEN REWRITE_TAC [NULL]
3781 THEN Cases_on `l`
3782 THEN FULL_SIMP_TAC list_ss [NULL, LENGTH_FRONT]
3783 THEN Cases_on `n`
3784 THEN ASM_SIMP_TAC list_ss []
3785QED
3786
3787Theorem MEM_LAST:
3788 !e l. MEM (LAST (e::l)) (e::l)
3789Proof
3790 Induct_on `l` THEN ASM_SIMP_TAC arith_ss [LAST_CONS, Once MEM]
3791QED
3792
3793Theorem MEM_LAST_NOT_NIL :
3794 !e l. l <> [] ==> MEM (LAST l) l
3795Proof
3796 rpt STRIP_TAC
3797 >> Cases_on ‘l’ >> FULL_SIMP_TAC std_ss [MEM_LAST]
3798QED
3799
3800Theorem DROP_CONS_EL:
3801 !n l. n < LENGTH l ==> (DROP n l = EL n l :: DROP (SUC n) l)
3802Proof
3803 Induct_on `l`
3804 THEN1 SIMP_TAC list_ss []
3805 THEN Cases_on `n`
3806 THEN ASM_SIMP_TAC list_ss []
3807QED
3808
3809Theorem MEM_LAST_FRONT:
3810 !e l h. MEM e l /\ ~(e = LAST (h::l)) ==> MEM e (FRONT (h::l))
3811Proof
3812 Induct_on `l`
3813 THEN FULL_SIMP_TAC list_ss
3814 [COND_RATOR, COND_RAND, FRONT_DEF, LAST_DEF]
3815 THEN PROVE_TAC []
3816QED
3817
3818(*---------------------------------------------------------------------------
3819 LIST_ELEM_COUNT
3820 Added by Thomas Tuerk
3821 ---------------------------------------------------------------------------*)
3822
3823Theorem LIST_ELEM_COUNT_THM:
3824 (!e. LIST_ELEM_COUNT e [] = 0) /\
3825 (!e l1 l2.
3826 LIST_ELEM_COUNT e (l1++l2) =
3827 LIST_ELEM_COUNT e l1 + LIST_ELEM_COUNT e l2) /\
3828 (!e h l.
3829 (h = e) ==> (LIST_ELEM_COUNT e (h::l) = SUC (LIST_ELEM_COUNT e l))) /\
3830 (!e h l. ~(h = e) ==> (LIST_ELEM_COUNT e (h::l) = LIST_ELEM_COUNT e l))
3831Proof
3832 SIMP_TAC list_ss [LIST_ELEM_COUNT_DEF, FILTER_APPEND]
3833QED
3834
3835Theorem LIST_ELEM_COUNT_MEM:
3836 !e l. (LIST_ELEM_COUNT e l > 0) = (MEM e l)
3837Proof
3838 Induct_on `l`
3839 THEN FULL_SIMP_TAC list_ss [LIST_ELEM_COUNT_DEF, COND_RAND, COND_RATOR]
3840 THEN PROVE_TAC []
3841QED
3842
3843(*---------------------------------------------------------------------------
3844 chunks: split a list into equal-sized lists
3845 ---------------------------------------------------------------------------*)
3846
3847Definition chunks_def:
3848 chunks n ls =
3849 if LENGTH ls <= n \/ n = 0
3850 then [ls]
3851 else CONS (TAKE n ls) (chunks n (DROP n ls))
3852Termination
3853 Q.EXISTS_TAC`measure (LENGTH o SND)` \\ rw[LENGTH_DROP]
3854End
3855
3856val chunks_ind = theorem"chunks_ind";
3857
3858Theorem chunks_NIL[simp]:
3859 chunks n [] = [[]]
3860Proof
3861 rw[Once chunks_def]
3862QED
3863
3864Theorem chunks_0[simp]:
3865 chunks 0 ls = [ls]
3866Proof
3867 rw[Once chunks_def]
3868QED
3869
3870Theorem FLAT_chunks[simp]:
3871 FLAT (chunks n ls) = ls
3872Proof
3873 completeInduct_on`LENGTH ls` \\ rw[]
3874 \\ rw[Once chunks_def]
3875QED
3876
3877Theorem divides_EVERY_LENGTH_chunks:
3878 !n ls. ls <> [] /\ divides n (LENGTH ls) ==>
3879 EVERY ($= n o LENGTH) (chunks n ls)
3880Proof
3881 ho_match_mp_tac chunks_ind
3882 \\ rw[]
3883 \\ rw[Once chunks_def] \\ fs[]
3884 \\ fs[dividesTheory.divides_def]
3885 \\ REV_FULL_SIMP_TAC(srw_ss())[]
3886 >- ( Cases_on`q = 0` \\ fs[] )
3887 \\ first_x_assum irule
3888 \\ Q.EXISTS_TAC`PRE q`
3889 \\ Cases_on`q` \\ fs[ADD1]
3890QED
3891
3892Theorem chunks_append_divides:
3893 !n l1 l2.
3894 0 < n /\ divides n (LENGTH l1) /\ ~NULL l1 /\ ~NULL l2 ==>
3895 chunks n (l1 ++ l2) = chunks n l1 ++ chunks n l2
3896Proof
3897 HO_MATCH_MP_TAC chunks_ind
3898 \\ rw[dividesTheory.divides_def, PULL_EXISTS]
3899 \\ simp[Once chunks_def]
3900 \\ Cases_on`q=0` \\ fs[] \\ rfs[]
3901 \\ IF_CASES_TAC
3902 >- ( Cases_on`q` \\ fs[ADD1, LEFT_ADD_DISTRIB] \\ fs[LESS_OR_EQ] )
3903 \\ simp[DROP_APPEND, TAKE_APPEND]
3904 \\ Q.MATCH_GOALSUB_ABBREV_TAC`lhs = _`
3905 \\ simp[Once chunks_def]
3906 \\ Cases_on`q = 1` \\ fs[]
3907 >- (
3908 simp[Abbr`lhs`]
3909 \\ fs[NOT_LESS_EQUAL]
3910 \\ simp[DROP_LENGTH_TOO_LONG])
3911 \\ simp[Abbr`lhs`]
3912 \\ `n - n * q = 0` by simp[]
3913 \\ simp[]
3914 \\ first_x_assum irule
3915 \\ simp[NULL_EQ]
3916 \\ qexists_tac`q - 1`
3917 \\ simp[]
3918QED
3919
3920Theorem chunks_length[simp]:
3921 chunks (LENGTH ls) ls = [ls]
3922Proof
3923 rw[Once chunks_def]
3924QED
3925
3926Theorem chunks_not_nil[simp]:
3927 !n ls. chunks n ls <> []
3928Proof
3929 HO_MATCH_MP_TAC chunks_ind
3930 \\ rw[]
3931 \\ rw[Once chunks_def]
3932QED
3933
3934Theorem LENGTH_chunks:
3935 !n ls. 0 < n /\ ~NULL ls ==>
3936 LENGTH (chunks n ls) =
3937 LENGTH ls DIV n + (bool_to_bit $ ~divides n (LENGTH ls))
3938Proof
3939 HO_MATCH_MP_TAC chunks_ind
3940 \\ rw[]
3941 \\ rw[Once chunks_def, dividesTheory.DIV_EQUAL_0, bool_to_bit_def,
3942 dividesTheory.divides_def]
3943 \\ fs[LESS_OR_EQ, ADD1, NULL_EQ, bool_to_bit_def] \\ rfs[]
3944 \\ rw[]
3945 \\ fs[dividesTheory.divides_def, dividesTheory.SUB_DIV]
3946 \\ rfs[]
3947 >- (
3948 Cases_on`LENGTH ls DIV n = 0` >- rfs[dividesTheory.DIV_EQUAL_0]
3949 \\ simp[] )
3950 >- (
3951 Cases_on`q` \\ fs[MULT_SUC]
3952 \\ Q.MATCH_ASMSUB_RENAME_TAC`n + n * p`
3953 \\ first_x_assum(Q.SPEC_THEN`2 + p`mp_tac)
3954 \\ simp[LEFT_ADD_DISTRIB] )
3955 >- (
3956 first_x_assum(Q.SPEC_THEN`PRE q`mp_tac)
3957 \\ Cases_on`q` \\ fs[MULT_SUC] )
3958 \\ Cases_on`q` \\ fs[MULT_SUC]
3959 \\ simp[ADD_DIV_RWT]
3960QED
3961
3962Theorem EL_chunks:
3963 !k ls n.
3964 n < LENGTH (chunks k ls) /\ 0 < k /\ ~NULL ls ==>
3965 EL n (chunks k ls) = TAKE k (DROP (n * k) ls)
3966Proof
3967 HO_MATCH_MP_TAC chunks_ind \\ rw[NULL_EQ]
3968 \\ Q.PAT_X_ASSUM`_ < LENGTH _ `mp_tac
3969 \\ rw[Once chunks_def] \\ fs[]
3970 \\ rw[Once chunks_def]
3971 \\ Q.MATCH_GOALSUB_RENAME_TAC`EL m _`
3972 \\ Cases_on`m` \\ fs[]
3973 \\ pop_assum mp_tac
3974 \\ dep_rewrite.DEP_REWRITE_TAC[LENGTH_chunks]
3975 \\ simp[NULL_EQ]
3976 \\ strip_tac
3977 \\ dep_rewrite.DEP_REWRITE_TAC[DROP_DROP]
3978 \\ simp[MULT_SUC]
3979 \\ Q.MATCH_GOALSUB_RENAME_TAC`k + k * m <= _`
3980 \\ `k * m <= LENGTH ls - k` suffices_by simp[]
3981 \\ `m <= (LENGTH ls - k) DIV k` suffices_by simp[X_LE_DIV]
3982 \\ fs[bool_to_bit_def]
3983 \\ pop_assum mp_tac \\ rw[]
3984QED
3985
3986Theorem chunks_MAP:
3987 !n ls. chunks n (MAP f ls) = MAP (MAP f) (chunks n ls)
3988Proof
3989 HO_MATCH_MP_TAC chunks_ind \\ rw[]
3990 \\ rw[Once chunks_def]
3991 >- rw[Once chunks_def]
3992 >- rw[Once chunks_def]
3993 \\ fs[]
3994 \\ simp[GSYM MAP_DROP]
3995 \\ CONV_TAC(RAND_CONV(SIMP_CONV(srw_ss())[Once chunks_def]))
3996 \\ simp[MAP_TAKE]
3997QED
3998
3999Theorem chunks_ZIP:
4000 !n ls l2. LENGTH ls = LENGTH l2 ==>
4001 chunks n (ZIP (ls, l2)) = MAP ZIP (ZIP (chunks n ls, chunks n l2))
4002Proof
4003 HO_MATCH_MP_TAC chunks_ind \\ rw[]
4004 \\ rw[Once chunks_def]
4005 >- ( rw[Once chunks_def] \\ rw[Once chunks_def] )
4006 >- rw[Once chunks_def]
4007 \\ fs[]
4008 \\ simp[GSYM ZIP_DROP]
4009 \\ CONV_TAC(RAND_CONV(SIMP_CONV(srw_ss())[Once chunks_def]))
4010 \\ CONV_TAC(PATH_CONV"rrrr"(SIMP_CONV(srw_ss())[Once chunks_def]))
4011 \\ simp[ZIP_TAKE]
4012QED
4013
4014Theorem chunks_TAKE:
4015 !n ls m. divides n m /\ 0 < m ==>
4016 chunks n (TAKE m ls) = TAKE (m DIV n) (chunks n ls)
4017Proof
4018 HO_MATCH_MP_TAC chunks_ind \\ rw[]
4019 \\ CONV_TAC(RAND_CONV(SIMP_CONV(srw_ss())[Once chunks_def]))
4020 \\ rw[]
4021 >- (
4022 rw[Once chunks_def] \\ fs[LENGTH_TAKE_EQ]
4023 \\ fs[dividesTheory.divides_def]
4024 \\ BasicProvers.VAR_EQ_TAC
4025 \\ Q.MATCH_GOALSUB_RENAME_TAC`n * m`
4026 \\ fs[ZERO_LESS_MULT]
4027 \\ `n <= n * m` by simp[LE_MULT_CANCEL_LBARE]
4028 \\ dep_rewrite.DEP_REWRITE_TAC[TAKE_LENGTH_TOO_LONG]
4029 \\ simp[MULT_DIV] )
4030 >- fs[dividesTheory.divides_def]
4031 \\ fs[]
4032 \\ simp[Once chunks_def, LENGTH_TAKE_EQ]
4033 \\ `n <= m` by (
4034 rfs[dividesTheory.divides_def] \\ rw[]
4035 \\ fs[ZERO_LESS_MULT] )
4036 \\ IF_CASES_TAC
4037 >- (
4038 pop_assum mp_tac \\ rw[]
4039 \\ `m = n` by fs[] \\ rw[] )
4040 \\ fs[TAKE_TAKE, DROP_TAKE]
4041 \\ first_x_assum(Q.SPEC_THEN`m - n`mp_tac)
4042 \\ simp[]
4043 \\ impl_keep_tac >- (
4044 fs[dividesTheory.divides_def]
4045 \\ qexists_tac`q - 1`
4046 \\ simp[LEFT_SUB_DISTRIB] )
4047 \\ rw[]
4048 \\ `m DIV n <> 0` by fs[dividesTheory.DIV_EQUAL_0]
4049 \\ Cases_on`m DIV n` \\ fs[TAKE_TAKE_MIN]
4050 \\ `MIN n m = n` by fs[MIN_DEF] \\ rw[]
4051 \\ simp[dividesTheory.SUB_DIV]
4052QED
4053
4054Definition chunks_tr_aux_def:
4055 chunks_tr_aux n ls acc =
4056 if LENGTH ls <= SUC n then REVERSE $ ls :: acc
4057 else chunks_tr_aux n (DROP (SUC n) ls) (TAKE (SUC n) ls :: acc)
4058Termination
4059 WF_REL_TAC`measure $ LENGTH o FST o SND`
4060 \\ rw[LENGTH_DROP]
4061End
4062
4063Definition chunks_tr_def:
4064 chunks_tr n ls = if n = 0 then [ls] else chunks_tr_aux (n - 1) ls []
4065End
4066
4067Theorem chunks_tr_aux_thm:
4068 !n ls acc.
4069 chunks_tr_aux n ls acc =
4070 REVERSE acc ++ chunks (SUC n) ls
4071Proof
4072 HO_MATCH_MP_TAC chunks_tr_aux_ind
4073 \\ rw[]
4074 \\ rw[Once chunks_tr_aux_def]
4075 >- rw[Once chunks_def]
4076 \\ CONV_TAC(RAND_CONV(SIMP_CONV(srw_ss())[Once chunks_def]))
4077 \\ rw[]
4078QED
4079
4080Theorem chunks_tr_thm:
4081 chunks_tr = chunks
4082Proof
4083 simp[FUN_EQ_THM, chunks_tr_def]
4084 \\ Cases \\ rw[chunks_tr_aux_thm]
4085QED
4086
4087(*---------------------------------------------------------------------------*)
4088(* Various lemmas from the CakeML project https://cakeml.org *)
4089(*---------------------------------------------------------------------------*)
4090
4091local
4092 val rw = SRW_TAC []
4093 val metis_tac = METIS_TAC
4094 (* `val', so the simpset is the one in force here rather than a
4095 proof's: these are read once, and widening them to the
4096 proof's context stops rich_listTheory terminating. *)
4097 val fs = FULL_SIMP_TAC (srw_ss())
4098 val rfs = REV_FULL_SIMP_TAC (srw_ss())
4099 fun simpss() = srw_ss()++boolSimps.LET_ss++numSimps.ARITH_ss
4100 fun simp ths = asm_simp_tac (simpss()) ths
4101 fun dsimp ths = asm_simp_tac (simpss() ++ boolSimps.DNF_ss) ths
4102 val decide_tac = numLib.DECIDE_TAC
4103in
4104
4105Theorem LIST_TO_SET_EQ_SING:
4106 !x ls. (set ls = {x}) <=> ls <> [] /\ EVERY ($= x) ls
4107Proof
4108 GEN_TAC
4109 >> Induct
4110 >> simp[]
4111 >> simp[Once EXTENSION,EVERY_MEM]
4112 >> metis_tac[]
4113QED
4114
4115Theorem REPLICATE_GENLIST:
4116 !n x. REPLICATE n x = GENLIST (K x) n
4117Proof
4118 Induct THEN SRW_TAC[][REPLICATE,GENLIST_CONS]
4119QED
4120
4121Theorem EL_REPLICATE:
4122 !n1 n2 x. n1 < n2 ==> (EL n1 (REPLICATE n2 x) = x)
4123Proof
4124 Induct_on `n2`
4125 >> rw []
4126 >> Cases_on `n1 = n2`
4127 >> fs [REPLICATE, EL]
4128 >> Cases_on `n1`
4129 >> rw []
4130 >> fs [REPLICATE, EL]
4131QED
4132
4133Theorem EVERY_REPLICATE[simp]:
4134 !f n x. EVERY f (REPLICATE n x) <=> (n = 0) \/ f x
4135Proof Induct_on `n` >> rw [] >> metis_tac []
4136QED
4137
4138(* ALL_DISTINCT_{DROP,TAKE} are already in listTheory; keep this binding
4139 here for backwards compatibility *)
4140Theorem ALL_DISTINCT_TAKE = listTheory.ALL_DISTINCT_TAKE
4141
4142Theorem ALL_DISTINCT_FRONT :
4143 !l. l <> [] /\ ALL_DISTINCT l ==> ALL_DISTINCT (FRONT l)
4144Proof
4145 rpt STRIP_TAC
4146 >> ‘ALL_DISTINCT l = ALL_DISTINCT (SNOC (LAST l) (FRONT l))’
4147 by rw [SNOC_LAST_FRONT]
4148 >> FULL_SIMP_TAC std_ss [ALL_DISTINCT_SNOC]
4149QED
4150
4151Theorem MAP_SND_FILTER_NEQ:
4152 MAP SND (FILTER (\(x,y). y <> z) ls) = FILTER ($<> z) (MAP SND ls)
4153Proof
4154 Q.ISPECL_THEN [`$<> z`, `SND:('b#'a)->'a`, `ls`] MP_TAC FILTER_MAP
4155 >> rw[]
4156 >> AP_TERM_TAC
4157 >> AP_THM_TAC
4158 >> AP_TERM_TAC
4159 >> simp[FUN_EQ_THM,FORALL_PROD,EQ_IMP_THM]
4160QED
4161
4162Theorem MEM_SING_APPEND:
4163 (!a c. d <> a ++ [b] ++ c) <=> ~MEM b d
4164Proof
4165 rw[EQ_IMP_THM]
4166 >> SPOSE_NOT_THEN STRIP_ASSUME_TAC
4167 >> fs[]
4168 >> fs[MEM_EL]
4169 >> FIRST_X_ASSUM(Q.SPECL_THEN[`TAKE n d`,`DROP (n+1) d`]MP_TAC)
4170 >> rw[LIST_EQ_REWRITE]
4171 >> Cases_on`x<n`
4172 >> simp[EL_APPEND1,EL_TAKE]
4173 >> Cases_on`x=n`
4174 >> simp[EL_APPEND1,EL_APPEND2,EL_TAKE]
4175 >> simp[EL_DROP]
4176QED
4177
4178Theorem EL_LENGTH_APPEND_rwt:
4179 ~NULL l2 /\ (n = LENGTH l1) ==> (EL n (l1++l2) = HD l2)
4180Proof
4181 metis_tac[EL_LENGTH_APPEND]
4182QED
4183
4184Theorem MAP_FST_funs:
4185 MAP (\(x,y,z). x) funs = MAP FST funs
4186Proof
4187 rw[MAP_EQ_f,FORALL_PROD]
4188QED
4189
4190Theorem TAKE_PRE_LENGTH:
4191 !ls. ls <> [] ==> (TAKE (PRE (LENGTH ls)) ls = FRONT ls)
4192Proof
4193 Induct
4194 THEN SRW_TAC[][LENGTH_NIL,TAKE_def]
4195 THEN FULL_SIMP_TAC(srw_ss())[FRONT_DEF,PRE_SUB1]
4196QED
4197
4198Theorem DROP_LENGTH_NIL_rwt:
4199 !l m. (m = LENGTH l) ==> (DROP m l = [])
4200Proof
4201 rw[DROP_LENGTH_NIL]
4202QED
4203
4204Theorem DROP_EL_CONS:
4205 !ls n. n < LENGTH ls ==> (DROP n ls = EL n ls :: DROP (n + 1) ls)
4206Proof
4207 Induct
4208 >> rw[EL_CONS,PRE_SUB1,DROP_def]
4209 >> FULL_SIMP_TAC arith_ss []
4210 >> `0 < n` by RW_TAC arith_ss []
4211 >> rw [EL_CONS, PRE_SUB1]
4212QED
4213
4214Theorem TAKE_EL_SNOC:
4215 !ls n. n < LENGTH ls ==> (TAKE (n + 1) ls = SNOC (EL n ls) (TAKE n ls))
4216Proof
4217 HO_MATCH_MP_TAC SNOC_INDUCT
4218 THEN CONJ_TAC
4219 THEN1 SRW_TAC[][]
4220 THEN REPEAT STRIP_TAC
4221 THEN Cases_on`n = LENGTH ls`
4222 THEN1 (rw[EL_LENGTH_SNOC,TAKE_SNOC,TAKE_APPEND1,EL_APPEND1,EL_APPEND2,
4223 TAKE_APPEND2]
4224 THEN FULL_SIMP_TAC arith_ss [])
4225 THEN `n < LENGTH ls` by FULL_SIMP_TAC arith_ss [ADD1, LENGTH_SNOC]
4226 THEN rw[TAKE_SNOC,TAKE_APPEND1,EL_APPEND1,SNOC_APPEND]
4227 THEN FULL_SIMP_TAC arith_ss [ADD1, LENGTH_SNOC, TAKE_APPEND1, SNOC_APPEND]
4228QED
4229
4230Theorem REVERSE_DROP:
4231 !ls n. n <= LENGTH ls ==>
4232 (REVERSE (DROP n ls) = REVERSE (LASTN (LENGTH ls - n) ls))
4233Proof
4234 HO_MATCH_MP_TAC SNOC_INDUCT
4235 THEN SRW_TAC[][LASTN]
4236 THEN Cases_on`n = SUC (LENGTH ls)`
4237 THEN1 (rw[DROP_LENGTH_NIL_rwt,ADD1,LASTN])
4238 THEN `n <= LENGTH ls` by RW_TAC arith_ss []
4239 THEN rw[DROP_APPEND1,LASTN_APPEND1,SNOC_APPEND,ADD1]
4240 THEN `LENGTH [x] <= LENGTH ls + 1 - n` by RW_TAC arith_ss [LENGTH]
4241 THEN RW_TAC arith_ss [LASTN_APPEND1, LENGTH]
4242QED
4243
4244Theorem LENGTH_FILTER_LESS:
4245 !P ls. EXISTS ($~ o P) ls ==> LENGTH (FILTER P ls) < LENGTH ls
4246Proof
4247 GEN_TAC
4248 THEN Induct
4249 THEN SRW_TAC[][]
4250 THEN MATCH_MP_TAC LESS_EQ_IMP_LESS_SUC
4251 THEN MATCH_ACCEPT_TAC LENGTH_FILTER_LEQ
4252QED
4253
4254Theorem EVERY2_APPEND = LIST_REL_APPEND
4255
4256Theorem EVERY2_APPEND_suff = LIST_REL_APPEND_suff
4257
4258Theorem EVERY2_DROP:
4259 !R l1 l2 n.
4260 EVERY2 R l1 l2 ==> EVERY2 R (DROP n l1) (DROP n l2)
4261Proof
4262 Induct_on ‘n’ >> simp[] >> Induct_on ‘l1’ >> dsimp[]
4263QED
4264
4265Theorem LIST_REL_DROP = EVERY2_DROP
4266
4267Theorem EVERY2_TAKE:
4268 !P xs ys n. EVERY2 P xs ys ==> EVERY2 P (TAKE n xs) (TAKE n ys)
4269Proof
4270 Induct_on ‘n’ >> simp[] >> Induct_on ‘xs’ >>
4271 asm_simp_tac (srw_ss() ++ boolSimps.DNF_ss) []
4272QED
4273
4274Theorem LIST_REL_TAKE = EVERY2_TAKE
4275
4276Theorem LIST_REL_APPEND_SING[simp]:
4277 LIST_REL R (l1 ++ [x1]) (l2 ++ [x2]) <=> LIST_REL R l1 l2 /\ R x1 x2
4278Proof
4279 simp_tac (srw_ss() ++ boolSimps.DNF_ss ++ boolSimps.CONJ_ss)
4280 [LIST_REL_EL_EQN, EL_APPEND1, EL_APPEND2,
4281 ARITH_PROVE “x < y + 1 <=> x = y \/ x < y”,
4282 AC CONJ_COMM CONJ_ASSOC]
4283QED
4284
4285Theorem LIST_REL_GENLIST:
4286 EVERY2 P (GENLIST f l) (GENLIST g l) <=>
4287 !i. i < l ==> P (f i) (g i)
4288Proof
4289 Induct_on `l`
4290 >> fs [GENLIST,LIST_REL_APPEND_SING,SNOC_APPEND]
4291 >> fs [DECIDE ``i < SUC n <=> i < n \/ (i = n)``] >> METIS_TAC []
4292QED
4293
4294Theorem ALL_DISTINCT_MEM_ZIP_MAP:
4295 !f x ls.
4296 ALL_DISTINCT ls ==>
4297 (MEM x (ZIP (ls, MAP f ls)) <=> MEM (FST x) ls /\ (SND x = f (FST x)))
4298Proof
4299 GEN_TAC
4300 THEN Cases
4301 THEN SRW_TAC[][MEM_ZIP,FORALL_PROD]
4302 THEN SRW_TAC[][EQ_IMP_THM]
4303 THEN SRW_TAC[][EL_MAP,MEM_EL]
4304 THEN FULL_SIMP_TAC (srw_ss()) [EL_ALL_DISTINCT_EL_EQ,MEM_EL]
4305 THEN METIS_TAC[EL_MAP]
4306QED
4307
4308Theorem REVERSE_ZIP:
4309 !l1 l2. (LENGTH l1 = LENGTH l2) ==>
4310 (REVERSE (ZIP (l1,l2)) = ZIP (REVERSE l1, REVERSE l2))
4311Proof
4312 Induct
4313 THEN SRW_TAC[][LENGTH_NIL_SYM]
4314 THEN Cases_on `l2`
4315 THEN FULL_SIMP_TAC(srw_ss())[]
4316 THEN SRW_TAC[][GSYM ZIP_APPEND]
4317QED
4318
4319Theorem EVERY2_REVERSE1:
4320 !l1 l2. EVERY2 R l1 (REVERSE l2) <=> EVERY2 R (REVERSE l1) l2
4321Proof
4322 REPEAT GEN_TAC
4323 >> EQ_TAC
4324 >> simp[EVERY2_EVERY]
4325 >> REPEAT STRIP_TAC
4326 >> drule (iffRL EVERY_REVERSE)
4327 >> simp[REVERSE_ZIP, Excl "EVERY_REVERSE"]
4328QED
4329
4330Theorem LIST_REL_REVERSE1 = EVERY2_REVERSE1
4331
4332Theorem LIST_REL_REVERSE_EQ[simp]:
4333 LIST_REL R (REVERSE l1) (REVERSE l2) <=> LIST_REL R l1 l2
4334Proof
4335 simp[EVERY2_REVERSE1]
4336QED
4337
4338Theorem every_count_list:
4339 !P n. EVERY P (COUNT_LIST n) = (!m. m < n ==> P m)
4340Proof
4341 Induct_on `n`
4342 >> rw [COUNT_LIST_def, EVERY_MAP]
4343 >> EQ_TAC
4344 >> rw []
4345 >> Cases_on `m`
4346 >> rw []
4347 >> `n' < n` by RW_TAC arith_ss []
4348 >> metis_tac []
4349QED
4350
4351Theorem count_list_sub1:
4352 !n. n <> 0 ==> (COUNT_LIST n = 0::MAP SUC (COUNT_LIST (n - 1)))
4353Proof
4354 Induct_on `n` >> ONCE_REWRITE_TAC [COUNT_LIST_def] >> fs []
4355QED
4356
4357Theorem el_map_count:
4358 !n f m. n < m ==> (EL n (MAP f (COUNT_LIST m)) = f n)
4359Proof
4360 Induct_on `n`
4361 >> rw []
4362 >> Cases_on `m`
4363 >> fs [COUNT_LIST_def]
4364 >> `n < SUC n'` by RW_TAC arith_ss []
4365 >> RES_TAC
4366 >> fs [COUNT_LIST_def]
4367 >> POP_ASSUM (fn _ => ALL_TAC)
4368 >> POP_ASSUM (MP_TAC o GSYM o Q.SPEC `f o SUC`)
4369 >> rw [MAP_MAP_o]
4370QED
4371
4372Theorem ZIP_COUNT_LIST:
4373 (n = LENGTH l1) ==>
4374 (ZIP (l1,COUNT_LIST n) = GENLIST (\n. (EL n l1, n)) (LENGTH l1))
4375Proof
4376 simp[LIST_EQ_REWRITE,LENGTH_COUNT_LIST,EL_ZIP,EL_COUNT_LIST]
4377QED
4378
4379Theorem map_replicate[simp]:
4380 !f n x. MAP f (REPLICATE n x) = REPLICATE n (f x)
4381Proof Induct_on `n` >> rw [REPLICATE]
4382QED
4383
4384Theorem REPLICATE_NIL[simp]: REPLICATE x y = [] <=> x = 0
4385Proof Cases_on`x` >> rw[]
4386QED
4387
4388Theorem REPLICATE_EQ_CONS:
4389 REPLICATE n x = y :: r <=> y = x /\ ?m. n = SUC m /\ r = REPLICATE m x
4390Proof
4391 Cases_on`n` \\ rw[REPLICATE, EQ_IMP_THM]
4392QED
4393
4394Theorem REPLICATE_APPEND:
4395 REPLICATE n a ++ REPLICATE m a = REPLICATE (n+m) a
4396Proof
4397 simp[LIST_EQ_REWRITE,LENGTH_REPLICATE] >> rw[] >>
4398 Cases_on`x < n` >> simp[EL_APPEND1,LENGTH_REPLICATE,EL_REPLICATE,EL_APPEND2]
4399QED
4400
4401Theorem DROP_REPLICATE[simp]:
4402 DROP n (REPLICATE m a) = REPLICATE (m-n) a
4403Proof simp[LIST_EQ_REWRITE,LENGTH_REPLICATE,EL_REPLICATE,EL_DROP]
4404QED
4405
4406Theorem LIST_REL_REPLICATE_same:
4407 LIST_REL P (REPLICATE n x) (REPLICATE n y) <=> (0 < n ==> P x y)
4408Proof
4409 Induct_on ‘n’>> asm_simp_tac (srw_ss() ++ boolSimps.CONJ_ss)[]
4410QED
4411
4412Theorem SNOC_REPLICATE[simp]:
4413 !n x. SNOC x (REPLICATE n x) = REPLICATE (SUC n) x
4414Proof Induct \\ fs [REPLICATE]
4415QED
4416
4417Theorem REVERSE_REPLICATE[simp]:
4418 !n x. REVERSE (REPLICATE n x) = REPLICATE n x
4419Proof
4420 Induct \\ fs [REPLICATE] \\
4421 fs [GSYM REPLICATE, GSYM SNOC_REPLICATE, SNOC_APPEND]
4422QED
4423
4424Theorem SUM_REPLICATE[simp]:
4425 !n k. SUM (REPLICATE n k) = n * k
4426Proof
4427 Induct >>
4428 full_simp_tac(srw_ss())[REPLICATE,MULT_CLAUSES,AC ADD_COMM ADD_ASSOC]
4429QED
4430
4431Theorem LENGTH_FLAT_REPLICATE[simp]:
4432 !n. LENGTH (FLAT (REPLICATE n ls)) = n * LENGTH ls
4433Proof Induct >> simp[REPLICATE,MULT]
4434QED
4435
4436Theorem take_drop_partition:
4437 !n m l. m <= n ==> (TAKE m l ++ TAKE (n - m) (DROP m l) = TAKE n l)
4438Proof
4439 Induct_on `m`
4440 >> rw []
4441 >> Cases_on `l`
4442 >> rw [TAKE_def]
4443 THEN1 RW_TAC arith_ss []
4444 >> FIRST_X_ASSUM (MP_TAC o Q.SPECL [`n - 1`, `t`])
4445 >> rw []
4446 >> FULL_SIMP_TAC arith_ss [ADD1]
4447QED
4448
4449Theorem all_distinct_count_list:
4450 !n. ALL_DISTINCT (COUNT_LIST n)
4451Proof
4452 Induct_on `n`
4453 >> rw [COUNT_LIST_def, MEM_MAP]
4454 >> MATCH_MP_TAC ALL_DISTINCT_MAP_INJ
4455 >> rw []
4456QED
4457
4458Theorem list_rel_lastn:
4459 !f l1 l2 n.
4460 n <= LENGTH l1 /\ LIST_REL f l1 l2 ==>
4461 LIST_REL f (LASTN n l1) (LASTN n l2)
4462Proof
4463 simp[LASTN_DROP_UNCOND] >> rpt strip_tac >>
4464 drule LIST_REL_LENGTH >> simp[EVERY2_DROP]
4465QED
4466
4467Theorem list_rel_butlastn:
4468 !f l1 l2 n.
4469 n <= LENGTH l1 /\ LIST_REL f l1 l2 ==>
4470 LIST_REL f (BUTLASTN n l1) (BUTLASTN n l2)
4471Proof
4472 rpt strip_tac >> drule_then assume_tac LIST_REL_LENGTH >>
4473 simp[BUTLASTN_TAKE, EVERY2_TAKE]
4474QED
4475
4476end
4477(* end CakeML lemmas *)
4478
4479(* BEGIN more lemmas of IS_SUFFIX *)
4480Theorem IS_SUFFIX_EQ_DROP :
4481 !l l1. IS_SUFFIX l l1 <=> ?n. n <= LENGTH l /\ l1 = DROP n l
4482Proof
4483 rw [GSYM IS_PREFIX_REVERSE, IS_PREFIX_EQ_TAKE]
4484 >> EQ_TAC >> rpt STRIP_TAC
4485 >| [ (* goal 1 (of 2) *)
4486 Q.EXISTS_TAC ‘LENGTH l - n’ >> simp [] \\
4487 ONCE_REWRITE_TAC [GSYM REVERSE_11] \\
4488 POP_ASSUM (fn th => REWRITE_TAC [th]) \\
4489 simp [TAKE_REVERSE, REVERSE_DROP],
4490 (* goal 2 (of 2) *)
4491 Q.EXISTS_TAC ‘LENGTH l - n’ >> simp [] \\
4492 simp [TAKE_REVERSE, REVERSE_DROP] ]
4493QED
4494
4495Theorem IS_SUFFIX_EQ_DROP' :
4496 !l l1. IS_SUFFIX l l1 <=> ?n. l1 = DROP n l
4497Proof
4498 rpt GEN_TAC
4499 >> EQ_TAC
4500 >- (rw [IS_SUFFIX_EQ_DROP] \\
4501 Q.EXISTS_TAC ‘n’ >> REWRITE_TAC [])
4502 >> STRIP_TAC
4503 >> Cases_on ‘n <= LENGTH l’
4504 >- (rw [IS_SUFFIX_EQ_DROP] \\
4505 Q.EXISTS_TAC ‘n’ >> ASM_REWRITE_TAC [])
4506 >> ‘LENGTH l <= n’ by rw []
4507 >> ‘l1 = []’ by rw [DROP_EQ_NIL]
4508 >> simp [IS_SUFFIX]
4509QED
4510
4511Theorem IS_SUFFIX_IMP_DROP :
4512 !l l1. IS_SUFFIX l l1 ==> l1 = DROP (LENGTH l - LENGTH l1) l
4513Proof
4514 rw [IS_SUFFIX_EQ_DROP]
4515 >> rw [LENGTH_DROP]
4516QED
4517
4518Theorem IS_SUFFIX_IMP_LASTN :
4519 !l l1. IS_SUFFIX l l1 ==> l1 = LASTN (LENGTH l1) l
4520Proof
4521 rw [IS_SUFFIX_EQ_DROP]
4522 >> rw [DROP_LASTN]
4523QED
4524
4525Theorem LIST_TO_SET_PREFIX :
4526 !l l1. l1 <<= l ==> set l1 SUBSET set l
4527Proof
4528 rw [IS_PREFIX_EQ_TAKE']
4529 >> rw [LIST_TO_SET_TAKE]
4530QED
4531
4532Theorem LIST_TO_SET_SUFFIX :
4533 !l l1. IS_SUFFIX l l1 ==> set l1 SUBSET set l
4534Proof
4535 rw [IS_SUFFIX_EQ_DROP']
4536 >> rw [LIST_TO_SET_DROP]
4537QED
4538
4539Theorem IS_SUFFIX_ALL_DISTINCT :
4540 !l l1. IS_SUFFIX l l1 /\ ALL_DISTINCT l ==> ALL_DISTINCT l1
4541Proof
4542 rw [IS_SUFFIX_EQ_DROP']
4543 >> MATCH_MP_TAC ALL_DISTINCT_DROP >> rw []
4544QED
4545(* END more lemmas of IS_SUFFIX *)
4546
4547Theorem IS_SUFFIX_dropWhile:
4548 IS_SUFFIX ls (dropWhile P ls)
4549Proof
4550 Induct_on`ls`
4551 \\ rw[IS_SUFFIX_CONS]
4552QED
4553
4554Theorem LENGTH_dropWhile_id:
4555 (LENGTH (dropWhile P ls) = LENGTH ls) <=> (dropWhile P ls = ls)
4556Proof
4557 rw[EQ_IMP_THM]
4558 \\ rw[dropWhile_id]
4559 \\ Cases_on`ls` \\ fs[]
4560 \\ strip_tac \\ fs[]
4561 \\ `IS_SUFFIX t (dropWhile P t)` by simp[IS_SUFFIX_dropWhile]
4562 \\ fs[IS_SUFFIX_APPEND]
4563 \\ `LENGTH t = LENGTH l + LENGTH (dropWhile P t)` by metis_tac[LENGTH_APPEND]
4564 \\ fs[]
4565QED
4566
4567Theorem nub_GENLIST:
4568 nub (GENLIST f n) =
4569 MAP f (FILTER (\i. !j. (i < j) /\ (j < n) ==> f i <> f j) (COUNT_LIST n))
4570Proof
4571 simp[COUNT_LIST_GENLIST]
4572 \\ Q.ID_SPEC_TAC`f`
4573 \\ Induct_on`n` \\ simp[]
4574 \\ simp[GENLIST_CONS]
4575 \\ simp[nub_def]
4576 \\ gen_tac
4577 \\ simp[MEM_GENLIST]
4578 \\ Q.MATCH_GOALSUB_ABBREV_TAC`COND b1`
4579 \\ Q.MATCH_GOALSUB_ABBREV_TAC`MAP f (COND b2 _ _)`
4580 \\ Q.MATCH_GOALSUB_ABBREV_TAC`f 0 :: r1`
4581 \\ Q.MATCH_GOALSUB_ABBREV_TAC`0 :: r2`
4582 \\ `b2 = ~b1`
4583 by (
4584 rw[Abbr`b1`, Abbr`b2`, EQ_IMP_THM]
4585 >- (
4586 CCONTR_TAC \\ fs[]
4587 \\ first_x_assum(Q.SPEC_THEN`SUC m`mp_tac)
4588 \\ simp[] )
4589 \\ first_x_assum(Q.SPEC_THEN`PRE j`mp_tac)
4590 \\ simp[]
4591 \\ metis_tac[SUC_PRE] )
4592 \\ `r1 = MAP f r2`
4593 by (
4594 simp[Abbr`r1`, Abbr`r2`]
4595 \\ Q.MATCH_GOALSUB_ABBREV_TAC`FILTER f2`
4596 \\ `f2 = (\i. !j. i <= j /\ (j < n) ==> f i <> f (SUC j)) o SUC`
4597 by (
4598 simp[Abbr`f2`, FUN_EQ_THM]
4599 \\ simp[LESS_EQ] )
4600 \\ simp[GSYM MAP_MAP_o, GSYM FILTER_MAP]
4601 \\ simp[MAP_GENLIST]
4602 \\ rpt (AP_TERM_TAC ORELSE AP_THM_TAC)
4603 \\ simp[FUN_EQ_THM]
4604 \\ gen_tac
4605 \\ CONV_TAC(RAND_CONV(Ho_Rewrite.ONCE_REWRITE_CONV[FORALL_NUM]))
4606 \\ simp[LESS_EQ] )
4607 \\ rw[]
4608QED
4609
4610(* alternative definition of UNIQUE *)
4611Theorem UNIQUE_LIST_ELEM_COUNT: !e L. UNIQUE e L = (LIST_ELEM_COUNT e L = 1)
4612Proof
4613 rpt GEN_TAC
4614 >> REWRITE_TAC [LIST_ELEM_COUNT_DEF]
4615 >> Q_TAC KNOW_TAC `(\x. x = e) = ($= e)`
4616 >- ( REWRITE_TAC [FUN_EQ_THM] >> GEN_TAC >> BETA_TAC \\
4617 METIS_TAC [] )
4618 >> DISCH_TAC >> ASM_REWRITE_TAC []
4619 >> RW_TAC std_ss [UNIQUE_LENGTH_FILTER]
4620QED
4621
4622Theorem LIST_ELEM_COUNT_CARD_EL:
4623 !ls. LIST_ELEM_COUNT x ls = CARD { n | n < LENGTH ls /\ (EL n ls = x) }
4624Proof
4625 Induct
4626 \\ rw[LIST_ELEM_COUNT_THM]
4627 \\ Q.MATCH_ABBREV_TAC`_ = CARD B`
4628 \\ Q.MATCH_ASSUM_ABBREV_TAC`_ = CARD A`
4629 \\ `A SUBSET count (LENGTH ls)` by simp[Abbr`A`, SUBSET_DEF]
4630 \\ `B SUBSET count (SUC (LENGTH ls))` by simp[Abbr`B`, SUBSET_DEF]
4631 \\ `FINITE A /\ FINITE B` by metis_tac[SUBSET_FINITE, FINITE_COUNT]
4632 \\ `B = IMAGE SUC A UNION (if x = h then {0} else {})`
4633 by ( simp[Abbr`A`, Abbr`B`, EXTENSION] \\ Cases \\ rw[] )
4634 \\ Cases_on`x = h`
4635 \\ simp[LIST_ELEM_COUNT_THM, CARD_UNION_EQN, ADD1, CARD_INJ_IMAGE]
4636 \\ `IMAGE SUC A INTER {0} = {}` by rw[EXTENSION]
4637 \\ simp[]
4638QED
4639
4640(*---------------------------------------------------------------------------*)
4641(* Add evaluation theorems to computeLib.the_compset *)
4642(*---------------------------------------------------------------------------*)
4643
4644Theorem COUNT_LIST_AUX[local]:
4645 !n l1 l2. COUNT_LIST_AUX n l1 ++ l2 = COUNT_LIST_AUX n (l1 ++ l2)
4646Proof
4647 Induct THEN SRW_TAC [] [COUNT_LIST_AUX_def]
4648QED
4649
4650Theorem COUNT_LIST_compute:
4651 !n. COUNT_LIST n = COUNT_LIST_AUX n []
4652Proof
4653 Induct
4654 THEN SRW_TAC [] [COUNT_LIST_GENLIST, GENLIST, COUNT_LIST_AUX_def, SNOC_APPEND]
4655 THEN FULL_SIMP_TAC (srw_ss()) [COUNT_LIST_GENLIST, COUNT_LIST_AUX]
4656QED
4657
4658Definition SPLITP_TAILREC_def:
4659 SPLITP_TAILREC acc P [] = (REVERSE acc,[]) /\
4660 SPLITP_TAILREC acc P (h::t) =
4661 (if P h then
4662 (REVERSE acc, h::t)
4663 else
4664 SPLITP_TAILREC (h::acc) P t)
4665End
4666
4667Theorem SPLITP_TAILREC_LEM[local]:
4668 ∀list l1 l2 acc.
4669 SPLITP_TAILREC acc P list
4670 =
4671 let (l1,l2) = SPLITP P list
4672 in (REVERSE acc ++ l1, l2)
4673Proof
4674 Induct >> rw[SPLITP, SPLITP_TAILREC_def]
4675QED
4676
4677Theorem SPLITP_compute:
4678 SPLITP = SPLITP_TAILREC []
4679Proof
4680 simp[FUN_EQ_THM, SPLITP_TAILREC_LEM, LET_THM] >>
4681 CONV_TAC (DEPTH_CONV PairRules.PBETA_CONV) >> simp[]
4682QED
4683
4684Theorem IS_SUFFIX_compute = GSYM IS_PREFIX_REVERSE;
4685
4686Theorem SEG_compute = numLib.SUC_RULE SEG;
4687
4688Theorem BUTLASTN_compute:
4689 !n l.
4690 BUTLASTN n l =
4691 let m = LENGTH l in
4692 if n <= m then TAKE (m - n) l
4693 else FAIL BUTLASTN ^(mk_var ("longer than list", bool)) n l
4694Proof
4695 SRW_TAC [boolSimps.LET_ss] [combinTheory.FAIL_THM, BUTLASTN_TAKE]
4696QED
4697
4698Theorem LASTN_compute:
4699 !n l.
4700 LASTN n l =
4701 let m = LENGTH l in
4702 if n <= m then DROP (m - n) l
4703 else FAIL LASTN ^(mk_var ("longer than list", bool)) n l
4704Proof
4705 SRW_TAC [boolSimps.LET_ss] [combinTheory.FAIL_THM, LASTN_DROP]
4706QED
4707
4708(* ======================================================================== *)
4709
4710local
4711 fun alias (s1, s2) =
4712 let
4713 val tm = Term.prim_mk_const {Thy = "list", Name = s2}
4714 in
4715 Parse.overload_on (s1, tm); Parse.overload_on (s2, tm)
4716 end
4717 val mem_t = ``\x:'a l:'a list. x IN LIST_TO_SET l``
4718in
4719 val () = List.app alias
4720 [("ALL_EL", "EVERY"),
4721 ("SOME_EL", "EXISTS"),
4722 ("FIRSTN", "TAKE"),
4723 ("BUTFIRSTN", "DROP"),
4724 ("BUTLAST", "FRONT")]
4725 val _ = overload_on("IS_EL", mem_t)
4726 val _ = overload_on("MEM", mem_t)
4727end
4728
4729(* moved here from examples/CCS/CCSScript.sml, originally by Chun Tian *)
4730Definition DELETE_ELEMENT :
4731 (DELETE_ELEMENT e [] = []) /\
4732 (DELETE_ELEMENT e (x :: l) = if (e = x) then DELETE_ELEMENT e l
4733 else x :: DELETE_ELEMENT e l)
4734End
4735
4736Theorem NOT_IN_DELETE_ELEMENT :
4737 !e L. ~MEM e (DELETE_ELEMENT e L)
4738Proof
4739 GEN_TAC >> Induct_on `L`
4740 >- REWRITE_TAC [DELETE_ELEMENT, MEM]
4741 >> GEN_TAC >> REWRITE_TAC [DELETE_ELEMENT]
4742 >> Cases_on `e = h` >> fs []
4743QED
4744
4745Theorem DELETE_ELEMENT_FILTER :
4746 !e L. DELETE_ELEMENT e L = FILTER ((<>) e) L
4747Proof
4748 GEN_TAC >> Induct_on `L`
4749 >- REWRITE_TAC [DELETE_ELEMENT, FILTER]
4750 >> GEN_TAC >> REWRITE_TAC [DELETE_ELEMENT, FILTER]
4751 >> Cases_on `e = h` >> fs []
4752QED
4753
4754Theorem LENGTH_DELETE_ELEMENT_LEQ :
4755 !e L. LENGTH (DELETE_ELEMENT e L) <= LENGTH L
4756Proof
4757 rpt GEN_TAC
4758 >> REWRITE_TAC [DELETE_ELEMENT_FILTER]
4759 >> MP_TAC (Q.SPECL [`\y. e <> y`, `\y. T`] LENGTH_FILTER_LEQ_MONO)
4760 >> BETA_TAC >> simp []
4761QED
4762
4763fun K_TAC _ = ALL_TAC;
4764val KILL_TAC = POP_ASSUM_LIST K_TAC;
4765
4766Theorem LENGTH_DELETE_ELEMENT_LE :
4767 !e L. MEM e L ==> LENGTH (DELETE_ELEMENT e L) < LENGTH L
4768Proof
4769 rpt GEN_TAC >> Induct_on `L`
4770 >- REWRITE_TAC [MEM]
4771 >> GEN_TAC >> REWRITE_TAC [MEM, DELETE_ELEMENT]
4772 >> Cases_on `e = h` >> fs []
4773 >> MP_TAC (Q.SPECL [`h`, `L`] LENGTH_DELETE_ELEMENT_LEQ)
4774 >> KILL_TAC >> RW_TAC arith_ss []
4775QED
4776
4777Theorem EVERY_DELETE_ELEMENT :
4778 !e L P. P e /\ EVERY P (DELETE_ELEMENT e L) ==> EVERY P L
4779Proof
4780 GEN_TAC >> Induct_on `L`
4781 >- RW_TAC std_ss [DELETE_ELEMENT]
4782 >> rpt GEN_TAC >> REWRITE_TAC [DELETE_ELEMENT]
4783 >> Cases_on `e = h` >> fs []
4784QED
4785
4786Theorem DELETE_ELEMENT_APPEND :
4787 !a L L'. DELETE_ELEMENT a (L ++ L') =
4788 DELETE_ELEMENT a L ++ DELETE_ELEMENT a L'
4789Proof
4790 REWRITE_TAC [DELETE_ELEMENT_FILTER]
4791 >> REWRITE_TAC [GSYM FILTER_APPEND_DISTRIB]
4792QED
4793
4794(* ------------------------------------------------------------------------- *)
4795(* More List Theorems from examples/algebra *)
4796(* ------------------------------------------------------------------------- *)
4797
4798(* Theorem: l <> [] ==> (l = SNOC (LAST l) (FRONT l)) *)
4799(* Proof:
4800 l
4801 = FRONT l ++ [LAST l] by APPEND_FRONT_LAST, l <> []
4802 = SNOC (LAST l) (FRONT l) by SNOC_APPEND
4803 *)
4804Theorem SNOC_LAST_FRONT':
4805 !l. l <> [] ==> (l = SNOC (LAST l) (FRONT l))
4806Proof
4807 rw[APPEND_FRONT_LAST, SNOC_APPEND]
4808QED
4809
4810(* Theorem: REVERSE [x] = [x] *)
4811(* Proof:
4812 REVERSE [x]
4813 = [] ++ [x] by REVERSE_DEF
4814 = [x] by APPEND
4815*)
4816Theorem REVERSE_SING:
4817 !x. REVERSE [x] = [x]
4818Proof
4819 rw[]
4820QED
4821
4822(* Theorem: ls <> [] ==> (HD (REVERSE ls) = LAST ls) *)
4823(* Proof:
4824 HD (REVERSE ls)
4825 = HD (REVERSE (SNOC (LAST ls) (FRONT ls))) by SNOC_LAST_FRONT
4826 = HD (LAST ls :: (REVERSE (FRONT ls)) by REVERSE_SNOC
4827 = LAST ls by HD
4828*)
4829Theorem REVERSE_HD:
4830 !ls. ls <> [] ==> (HD (REVERSE ls) = LAST ls)
4831Proof
4832 metis_tac[SNOC_LAST_FRONT, REVERSE_SNOC, HD]
4833QED
4834
4835(* Theorem: ls <> [] ==> (TL (REVERSE ls) = REVERSE (FRONT ls)) *)
4836(* Proof:
4837 TL (REVERSE ls)
4838 = TL (REVERSE (SNOC (LAST ls) (FRONT ls))) by SNOC_LAST_FRONT
4839 = TL (LAST ls :: (REVERSE (FRONT ls)) by REVERSE_SNOC
4840 = REVERSE (FRONT ls) by TL
4841*)
4842Theorem REVERSE_TL:
4843 !ls. ls <> [] ==> (TL (REVERSE ls) = REVERSE (FRONT ls))
4844Proof
4845 metis_tac[SNOC_LAST_FRONT, REVERSE_SNOC, TL]
4846QED
4847
4848(* Theorem: EL (LENGTH ls) (ls ++ h::t) = h *)
4849(* Proof:
4850 Let l2 = h::t.
4851 Note ~NULL l2 by NULL
4852 so EL (LENGTH ls) (ls ++ h::t)
4853 = EL (LENGTH ls) (ls ++ l2) by notation
4854 = HD l2 by EL_LENGTH_APPEND
4855 = HD (h::t) = h by notation
4856*)
4857Theorem EL_LENGTH_APPEND_0:
4858 !ls h t. EL (LENGTH ls) (ls ++ h::t) = h
4859Proof
4860 rw[EL_LENGTH_APPEND]
4861QED
4862
4863(* Theorem: EL (LENGTH ls + 1) (ls ++ h::k::t) = k *)
4864(* Proof:
4865 Let l1 = ls ++ [h].
4866 Then LENGTH l1 = LENGTH ls + 1 by LENGTH
4867 Note ls ++ h::k::t = l1 ++ k::t by APPEND
4868 EL (LENGTH ls + 1) (ls ++ h::k::t)
4869 = EL (LENGTH l1) (l1 ++ k::t) by above
4870 = k by EL_LENGTH_APPEND_0
4871*)
4872Theorem EL_LENGTH_APPEND_1:
4873 !ls h k t. EL (LENGTH ls + 1) (ls ++ h::k::t) = k
4874Proof
4875 rpt strip_tac >>
4876 qabbrev_tac `l1 = ls ++ [h]` >>
4877 `LENGTH l1 = LENGTH ls + 1` by rw[Abbr`l1`] >>
4878 `ls ++ h::k::t = l1 ++ k::t` by rw[Abbr`l1`] >>
4879 metis_tac[EL_LENGTH_APPEND_0]
4880QED
4881
4882(* Theorem: 0 < LENGTH ls <=> (ls = HD ls::TL ls) *)
4883(* Proof:
4884 If part: 0 < LENGTH ls ==> (ls = HD ls::TL ls)
4885 Note LENGTH ls <> 0 by arithmetic
4886 so ~(NULL l) by NULL_LENGTH
4887 or ls = HD ls :: TL ls by CONS
4888 Only-if part: (ls = HD ls::TL ls) ==> 0 < LENGTH ls
4889 Note LENGTH ls = SUC (LENGTH (TL ls)) by LENGTH
4890 but 0 < SUC (LENGTH (TL ls)) by SUC_POS
4891*)
4892Theorem LIST_HEAD_TAIL:
4893 !ls. 0 < LENGTH ls <=> (ls = HD ls::TL ls)
4894Proof
4895 metis_tac[LIST_NOT_NIL, NOT_NIL_EQ_LENGTH_NOT_0]
4896QED
4897
4898(* Theorem: p <> [] /\ q <> [] ==> ((p = q) <=> ((HD p = HD q) /\ (TL p = TL q))) *)
4899(* Proof: by cases on p and cases on q, CONS_11 *)
4900Theorem LIST_EQ_HEAD_TAIL:
4901 !p q. p <> [] /\ q <> [] ==>
4902 ((p = q) <=> ((HD p = HD q) /\ (TL p = TL q)))
4903Proof
4904 (Cases_on `p` >> Cases_on `q` >> fs[])
4905QED
4906
4907(* Theorem: [x] = [y] <=> x = y *)
4908(* Proof: by EQ_LIST and notation. *)
4909Theorem LIST_SING_EQ:
4910 !x y. ([x] = [y]) <=> (x = y)
4911Proof
4912 rw_tac bool_ss[]
4913QED
4914
4915(* Theorem: LENGTH [x] = 1 *)
4916(* Proof: by LENGTH, ONE. *)
4917Theorem LENGTH_SING:
4918 !x. LENGTH [x] = 1
4919Proof
4920 rw_tac bool_ss[LENGTH, ONE]
4921QED
4922
4923(* Theorem: ls <> [] ==> LENGTH (TL ls) < LENGTH ls *)
4924(* Proof: by LENGTH_TL, LENGTH_EQ_0 *)
4925Theorem LENGTH_TL_LT:
4926 !ls. ls <> [] ==> LENGTH (TL ls) < LENGTH ls
4927Proof
4928 metis_tac[LENGTH_TL, LENGTH_EQ_0, NOT_ZERO_LT_ZERO, DECIDE``n <> 0 ==> n - 1 < n``]
4929QED
4930
4931(* Theorem: MAP f [x] = [f x] *)
4932(* Proof: by MAP *)
4933Theorem MAP_SING:
4934 !f x. MAP f [x] = [f x]
4935Proof
4936 rw[]
4937QED
4938
4939(* listTheory.MAP_TL |- !l f. MAP f (TL l) = TL (MAP f l) *)
4940
4941(* Theorem: ls <> [] ==> HD (MAP f ls) = f (HD ls) *)
4942(* Proof:
4943 Note 0 < LENGTH ls by LENGTH_NON_NIL
4944 HD (MAP f ls)
4945 = EL 0 (MAP f ls) by EL
4946 = f (EL 0 ls) by EL_MAP, 0 < LENGTH ls
4947 = f (HD ls) by EL
4948*)
4949Theorem MAP_HD:
4950 !ls f. ls <> [] ==> HD (MAP f ls) = f (HD ls)
4951Proof
4952 metis_tac[EL_MAP, EL, LENGTH_NON_NIL]
4953QED
4954
4955(*
4956LAST_EL |- !ls. ls <> [] ==> LAST ls = EL (PRE (LENGTH ls)) ls
4957*)
4958
4959(* Theorem: t <> [] ==> (LAST t = EL (LENGTH t) (h::t)) *)
4960(* Proof:
4961 Note LENGTH t <> 0 by LENGTH_EQ_0
4962 or 0 < LENGTH t
4963 LAST t
4964 = EL (PRE (LENGTH t)) t by LAST_EL
4965 = EL (SUC (PRE (LENGTH t))) (h::t) by EL
4966 = EL (LENGTH t) (h::t) bu SUC_PRE, 0 < LENGTH t
4967*)
4968Theorem LAST_EL_CONS:
4969 !h t. t <> [] ==> (LAST t = EL (LENGTH t) (h::t))
4970Proof
4971 rpt strip_tac >>
4972 `0 < LENGTH t` by metis_tac[LENGTH_EQ_0, NOT_ZERO_LT_ZERO] >>
4973 `LAST t = EL (PRE (LENGTH t)) t` by rw[LAST_EL] >>
4974 `_ = EL (SUC (PRE (LENGTH t))) (h::t)` by rw[] >>
4975 metis_tac[SUC_PRE]
4976QED
4977
4978(* Theorem alias *)
4979Theorem FRONT_LENGTH = LENGTH_FRONT;
4980(* val FRONT_LENGTH = |- !l. l <> [] ==> (LENGTH (FRONT l) = PRE (LENGTH l)): thm *)
4981
4982(* Theorem: l <> [] /\ n < LENGTH (FRONT l) ==> (EL n (FRONT l) = EL n l) *)
4983(* Proof: by EL_FRONT, NULL *)
4984Theorem FRONT_EL:
4985 !l n. l <> [] /\ n < LENGTH (FRONT l) ==> (EL n (FRONT l) = EL n l)
4986Proof
4987 metis_tac[EL_FRONT, NULL, list_CASES]
4988QED
4989
4990(* Theorem: (LENGTH l = 1) ==> (FRONT l = []) *)
4991(* Proof:
4992 Note ?x. l = [x] by LENGTH_EQ_1
4993 FRONT l
4994 = FRONT [x] by above
4995 = [] by FRONT_DEF
4996*)
4997Theorem FRONT_EQ_NIL:
4998 !l. (LENGTH l = 1) ==> (FRONT l = [])
4999Proof
5000 rw[LENGTH_EQ_1] >>
5001 rw[FRONT_DEF]
5002QED
5003
5004(* Theorem: 1 < LENGTH l ==> FRONT l <> [] *)
5005(* Proof:
5006 Note LENGTH l <> 0 by 1 < LENGTH l
5007 Thus ?h s. l = h::s by list_CASES
5008 or 1 < 1 + LENGTH s
5009 so 0 < LENGTH s by arithmetic
5010 Thus ?k t. s = k::t by list_CASES
5011 FRONT l
5012 = FRONT (h::k::t)
5013 = h::FRONT (k::t) by FRONT_CONS
5014 <> [] by list_CASES
5015*)
5016Theorem FRONT_NON_NIL:
5017 !l. 1 < LENGTH l ==> FRONT l <> []
5018Proof
5019 rpt strip_tac >>
5020 `LENGTH l <> 0` by decide_tac >>
5021 `?h s. l = h::s` by metis_tac[list_CASES, LENGTH_EQ_0] >>
5022 `LENGTH l = 1 + LENGTH s` by rw[] >>
5023 `LENGTH s <> 0` by decide_tac >>
5024 `?k t. s = k::t` by metis_tac[list_CASES, LENGTH_EQ_0] >>
5025 `FRONT l = h::FRONT (k::t)` by fs[FRONT_CONS] >>
5026 fs[]
5027QED
5028
5029(* Theorem: ls <> [] ==> MEM (HD ls) ls *)
5030(* Proof:
5031 Note ls = h::t by list_CASES
5032 MEM (HD (h::t)) (h::t)
5033 <=> MEM h (h::t) by HD
5034 <=> T by MEM
5035*)
5036Theorem HEAD_MEM:
5037 !ls. ls <> [] ==> MEM (HD ls) ls
5038Proof
5039 (Cases_on `ls` >> simp[])
5040QED
5041
5042(* Theorem: ls <> [] ==> MEM (LAST ls) ls *)
5043(* Proof:
5044 By induction on ls.
5045 Base: [] <> [] ==> MEM (LAST []) []
5046 True by [] <> [] = F.
5047 Step: ls <> [] ==> MEM (LAST ls) ls ==>
5048 !h. h::ls <> [] ==> MEM (LAST (h::ls)) (h::ls)
5049 If ls = [],
5050 MEM (LAST [h]) [h]
5051 <=> MEM h [h] by LAST_DEF
5052 <=> T by MEM
5053 If ls <> [],
5054 MEM (LAST [h::ls]) (h::ls)
5055 <=> MEM (LAST ls) (h::ls) by LAST_DEF
5056 <=> LAST ls = h \/ MEM (LAST ls) ls by MEM
5057 <=> LAST ls = h \/ T by induction hypothesis
5058 <=> T by logical or
5059*)
5060Theorem LAST_MEM:
5061 !ls. ls <> [] ==> MEM (LAST ls) ls
5062Proof
5063 Induct >-
5064 decide_tac >>
5065 (Cases_on `ls = []` >> rw[LAST_DEF])
5066QED
5067
5068(* Idea: the last equals the head when there is no tail. *)
5069
5070(* Theorem: ~MEM h t /\ LAST (h::t) = h <=> t = [] *)
5071(* Proof:
5072 If part: ~MEM h t /\ LAST (h::t) = h ==> t = []
5073 By contradiction, suppose t <> [].
5074 Then h = LAST (h::t) = LAST t by LAST_CONS_cond, t <> []
5075 so MEM h t by LAST_MEM
5076 This contradicts ~MEM h t.
5077 Only-if part: t = [] ==> ~MEM h t /\ LAST (h::t) = h
5078 Note MEM h [] = F, so ~MEM h [] = T by MEM
5079 and LAST [h] = h by LAST_CONS
5080*)
5081Theorem LAST_EQ_HD:
5082 !h t. ~MEM h t /\ LAST (h::t) = h <=> t = []
5083Proof
5084 rw[EQ_IMP_THM] >>
5085 spose_not_then strip_assume_tac >>
5086 metis_tac[LAST_CONS_cond, LAST_MEM]
5087QED
5088
5089(* Theorem: ls <> [] /\ ALL_DISTINCT ls ==> ~MEM (LAST ls) (FRONT ls) *)
5090(* Proof:
5091 Let k = LENGTH ls.
5092 Then 0 < k by LENGTH_EQ_0, NOT_ZERO
5093 and LENGTH (FRONT ls) = PRE k by LENGTH_FRONT, ls <> []
5094 so ?n. n < PRE k /\
5095 LAST ls = EL n (FRONT ls) by MEM_EL
5096 = EL n ls by FRONT_EL, ls <> []
5097 but LAST ls = EL (PRE k) ls by LAST_EL, ls <> []
5098 Thus n = PRE k by ALL_DISTINCT_EL_IMP
5099 This contradicts n < PRE k by arithmetic
5100*)
5101Theorem MEM_FRONT_NOT_LAST:
5102 !ls. ls <> [] /\ ALL_DISTINCT ls ==> ~MEM (LAST ls) (FRONT ls)
5103Proof
5104 rpt strip_tac >>
5105 qabbrev_tac `k = LENGTH ls` >>
5106 `0 < k` by metis_tac[LENGTH_EQ_0, NOT_ZERO] >>
5107 `LENGTH (FRONT ls) = PRE k` by fs[LENGTH_FRONT, Abbr`k`] >>
5108 fs[MEM_EL] >>
5109 `LAST ls = EL n ls` by fs[FRONT_EL] >>
5110 `LAST ls = EL (PRE k) ls` by rfs[LAST_EL, Abbr`k`] >>
5111 `n < k /\ PRE k < k` by decide_tac >>
5112 `n = PRE k` by metis_tac[ALL_DISTINCT_EL_IMP] >>
5113 decide_tac
5114QED
5115
5116(* Theorem: ls = [] <=> !x. ~MEM x ls *)
5117(* Proof:
5118 If part: !x. ~MEM x [], true by MEM
5119 Only-if part: !x. ~MEM x ls ==> ls = []
5120 By contradiction, suppose ls <> [].
5121 Then ?h t. ls = h::t by list_CASES
5122 and MEM h ls by MEM
5123 which contradicts !x. ~MEM x ls.
5124*)
5125Theorem NIL_NO_MEM:
5126 !ls. ls = [] <=> !x. ~MEM x ls
5127Proof
5128 rw[EQ_IMP_THM] >>
5129 spose_not_then strip_assume_tac >>
5130 metis_tac[list_CASES, MEM]
5131QED
5132
5133(*
5134el_append3
5135|- !l1 x l2. EL (LENGTH l1) (l1 ++ [x] ++ l2) = x
5136*)
5137
5138(* Theorem: MEM h (l1 ++ [x] ++ l2) <=> MEM h (x::(l1 ++ l2)) *)
5139(* Proof:
5140 MEM h (l1 ++ [x] ++ l2)
5141 <=> MEM h l1 \/ h = x \/ MEM h l2 by MEM, MEM_APPEND
5142 <=> h = x \/ MEM h l1 \/ MEM h l2
5143 <=> h = x \/ MEM h (l1 ++ l2) by MEM_APPEND
5144 <=> MEM h (x::(l1 + l2)) by MEM
5145*)
5146Theorem MEM_APPEND_3:
5147 !l1 x l2 h. MEM h (l1 ++ [x] ++ l2) <=> MEM h (x::(l1 ++ l2))
5148Proof
5149 rw[] >>
5150 metis_tac[]
5151QED
5152
5153(* Theorem: DROP 1 (h::t) = t *)
5154(* Proof: DROP_def *)
5155Theorem DROP_1:
5156 !h t. DROP 1 (h::t) = t
5157Proof
5158 rw[]
5159QED
5160
5161(* Theorem: FRONT [x] = [] *)
5162(* Proof: FRONT_def *)
5163Theorem FRONT_SING:
5164 !x. FRONT [x] = []
5165Proof
5166 rw[]
5167QED
5168
5169(* Theorem: ls <> [] ==> (TL ls = DROP 1 ls) *)
5170(* Proof:
5171 Note ls = h::t by list_CASES
5172 so TL (h::t)
5173 = t by TL
5174 = DROP 1 (h::t) by DROP_def
5175*)
5176Theorem TAIL_BY_DROP:
5177 !ls. ls <> [] ==> (TL ls = DROP 1 ls)
5178Proof
5179 Cases_on `ls` >-
5180 decide_tac >>
5181 rw[]
5182QED
5183
5184(* Theorem: ls <> [] ==> (FRONT ls = TAKE (LENGTH ls - 1) ls) *)
5185(* Proof:
5186 By induction on ls.
5187 Base: [] <> [] ==> FRONT [] = TAKE (LENGTH [] - 1) []
5188 True by [] <> [] = F.
5189 Step: ls <> [] ==> FRONT ls = TAKE (LENGTH ls - 1) ls ==>
5190 !h. h::ls <> [] ==> FRONT (h::ls) = TAKE (LENGTH (h::ls) - 1) (h::ls)
5191 If ls = [],
5192 FRONT [h]
5193 = [] by FRONT_SING
5194 = TAKE 0 [h] by TAKE_0
5195 = TAKE (LENGTH [h] - 1) [h] by LENGTH_SING
5196 If ls <> [],
5197 FRONT (h::ls)
5198 = h::FRONT ls by FRONT_DEF
5199 = h::TAKE (LENGTH ls - 1) ls by induction hypothesis
5200 = TAKE (LENGTH (h::ls) - 1) (h::ls) by TAKE_def
5201*)
5202Theorem FRONT_BY_TAKE:
5203 !ls. ls <> [] ==> (FRONT ls = TAKE (LENGTH ls - 1) ls)
5204Proof
5205 Induct >-
5206 decide_tac >>
5207 rpt strip_tac >>
5208 Cases_on `ls = []` >-
5209 rw[] >>
5210 `LENGTH ls <> 0` by rw[] >>
5211 rw[FRONT_DEF]
5212QED
5213
5214(* Theorem: HD (h::t ++ ls) = h *)
5215(* Proof:
5216 HD (h::t ++ ls)
5217 = HD (h::(t ++ ls)) by APPEND
5218 = h by HD
5219*)
5220Theorem HD_APPEND:
5221 !h t ls. HD (h::t ++ ls) = h
5222Proof
5223 simp[]
5224QED
5225
5226Theorem HD_APPEND_NOT_NIL :
5227 !l1 l2. l1 <> [] ==> HD (l1 ++ l2) = HD l1
5228Proof
5229 rpt GEN_TAC
5230 >> Cases_on ‘l1’ >> rw [HD_APPEND]
5231QED
5232
5233(* Theorem: 0 <> n ==> (EL (n-1) t = EL n (h::t)) *)
5234(* Proof:
5235 Note n = SUC k for some k by num_CASES
5236 so EL k t = EL (SUC k) (h::t) by EL_restricted
5237*)
5238Theorem EL_TAIL:
5239 !h t n. 0 <> n ==> (EL (n-1) t = EL n (h::t))
5240Proof
5241 rpt strip_tac >>
5242 `n = SUC (n - 1)` by decide_tac >>
5243 metis_tac[EL_restricted]
5244QED
5245
5246(* Idea: If all elements are the same, the set is SING. *)
5247
5248(* Theorem: ls <> [] /\ EVERY ($= c) ls ==> SING (set ls) *)
5249(* Proof:
5250 Note set ls = {c} by LIST_TO_SET_EQ_SING
5251 thus SING (set ls) by SING_DEF
5252*)
5253Theorem MONOLIST_SET_SING:
5254 !c ls. ls <> [] /\ EVERY ($= c) ls ==> SING (set ls)
5255Proof
5256 metis_tac[LIST_TO_SET_EQ_SING, SING_DEF]
5257QED
5258
5259(*
5260> EVAL ``set [3;3;3]``;
5261val it = |- set [3; 3; 3] = set [3; 3; 3]: thm
5262*)
5263
5264(* Put LIST_TO_SET into compute
5265(* Near: put to helperList *)
5266Theorem LIST_TO_SET_EVAL[compute] = LIST_TO_SET |> GEN_ALL;
5267(* val LIST_TO_SET_EVAL = |- !t h. set [] = {} /\ set (h::t) = h INSERT set t: thm *)
5268(* cannot add to computeLib directly LIST_TO_SET, which is not in current theory. *)
5269 *)
5270
5271(*
5272> EVAL ``set [3;3;3]``;
5273val it = |- set [3; 3; 3] = {3}: thm
5274*)
5275
5276(* Theorem: set ls = count n ==> !j. j < LENGTH ls ==> EL j ls < n *)
5277(* Proof:
5278 Note MEM (EL j ls) ls by EL_MEM
5279 so EL j ls IN (count n) by set ls = count n
5280 or EL j ls < n by IN_COUNT
5281*)
5282Theorem set_list_eq_count:
5283 !ls n. set ls = count n ==> !j. j < LENGTH ls ==> EL j ls < n
5284Proof
5285 metis_tac[EL_MEM, IN_COUNT]
5286QED
5287
5288(* Theorem: set ls = IMAGE (\j. EL j ls) (count (LENGTH ls)) *)
5289(* Proof:
5290 Let f = \j. EL j ls, n = LENGTH ls.
5291 x IN IMAGE f (count n)
5292 <=> ?j. x = f j /\ j IN (count n) by IN_IMAGE
5293 <=> ?j. x = EL j ls /\ j < n by notation, IN_COUNT
5294 <=> MEM x ls by MEM_EL
5295 <=> x IN set ls by notation
5296 Thus set ls = IMAGE f (count n) by EXTENSION
5297*)
5298Theorem list_to_set_eq_el_image:
5299 !ls. set ls = IMAGE (\j. EL j ls) (count (LENGTH ls))
5300Proof
5301 rw[EXTENSION] >>
5302 metis_tac[MEM_EL]
5303QED
5304
5305(* Theorem: ALL_DISTINCT ls ==> INJ (\j. EL j ls) (count (LENGTH ls)) univ(:num) *)
5306(* Proof:
5307 By INJ_DEF this is to show:
5308 (1) EL j ls IN univ(:'a), true by IN_UNIV, function type
5309 (2) !x y. x < LENGTH ls /\ y < LENGTH ls /\ EL x ls = EL y ls ==> x = y
5310 This is true by ALL_DISTINCT_EL_IMP, ALL_DISTINCT ls
5311*)
5312Theorem all_distinct_list_el_inj:
5313 !ls. ALL_DISTINCT ls ==> INJ (\j. EL j ls) (count (LENGTH ls)) univ(:'a)
5314Proof
5315 rw[INJ_DEF, ALL_DISTINCT_EL_IMP]
5316QED
5317
5318(* MAP_ZIP_SAME |- !ls f. MAP f (ZIP (ls,ls)) = MAP (\x. f (x,x)) ls *)
5319
5320(* Theorem: ZIP ((MAP f ls), (MAP g ls)) = MAP (\x. (f x, g x)) ls *)
5321(* Proof:
5322 ZIP ((MAP f ls), (MAP g ls))
5323 = MAP (\(x, y). (f x, y)) (ZIP (ls, (MAP g ls))) by ZIP_MAP
5324 = MAP (\(x, y). (f x, y)) (MAP (\(x, y). (x, g y)) (ZIP (ls, ls))) by ZIP_MAP
5325 = MAP (\(x, y). (f x, y)) (MAP (\j. (\(x, y). (x, g y)) (j,j)) ls) by MAP_ZIP_SAME
5326 = MAP (\(x, y). (f x, y)) o (\j. (\(x, y). (x, g y)) (j,j)) ls by MAP_COMPOSE
5327 = MAP (\x. (f x, g x)) ls by FUN_EQ_THM
5328*)
5329Theorem ZIP_MAP_MAP:
5330 !ls f g. ZIP ((MAP f ls), (MAP g ls)) = MAP (\x. (f x, g x)) ls
5331Proof
5332 rw[ZIP_MAP, MAP_COMPOSE] >>
5333 qabbrev_tac `f1 = \p. (f (FST p),SND p)` >>
5334 qabbrev_tac `f2 = \x. (x,g x)` >>
5335 qabbrev_tac `f3 = \x. (f x,g x)` >>
5336 `f1 o f2 = f3` by rw[FUN_EQ_THM, Abbr`f1`, Abbr`f2`, Abbr`f3`] >>
5337 rw[]
5338QED
5339
5340(* Theorem: MAP2 f (MAP g1 ls) (MAP g2 ls) = MAP (\x. f (g1 x) (g2 x)) ls *)
5341(* Proof:
5342 Let k = LENGTH ls.
5343 Note LENGTH (MAP g1 ls) = k by LENGTH_MAP
5344 and LENGTH (MAP g2 ls) = k by LENGTH_MAP
5345 MAP2 f (MAP g1 ls) (MAP g2 ls)
5346 = MAP (UNCURRY f) (ZIP ((MAP g1 ls), (MAP g2 ls))) by MAP2_MAP
5347 = MAP (UNCURRY f) (MAP (\x. (g1 x, g2 x)) ls) by ZIP_MAP_MAP
5348 = MAP ((UNCURRY f) o (\x. (g1 x, g2 x))) ls by MAP_COMPOSE
5349 = MAP (\x. f (g1 x) (g2 y)) ls by FUN_EQ_THM
5350*)
5351Theorem MAP2_MAP_MAP:
5352 !ls f g1 g2. MAP2 f (MAP g1 ls) (MAP g2 ls) = MAP (\x. f (g1 x) (g2 x)) ls
5353Proof
5354 rw[MAP2_MAP, ZIP_MAP_MAP, MAP_COMPOSE] >>
5355 qabbrev_tac `f1 = UNCURRY f o (\x. (g1 x,g2 x))` >>
5356 qabbrev_tac `f2 = \x. f (g1 x) (g2 x)` >>
5357 `f1 = f2` by rw[FUN_EQ_THM, Abbr`f1`, Abbr`f2`] >>
5358 rw[]
5359QED
5360
5361(* Theorem: EL n (l1 ++ l2) = if n < LENGTH l1 then EL n l1 else EL (n - LENGTH l1) l2 *)
5362(* Proof: by EL_APPEND1, EL_APPEND2 *)
5363Theorem EL_APPEND:
5364 !n l1 l2. EL n (l1 ++ l2) = if n < LENGTH l1 then EL n l1 else EL (n - LENGTH l1) l2
5365Proof
5366 rw[EL_APPEND1, EL_APPEND2]
5367QED
5368
5369(* Theorem: j < LENGTH ls ==> ?l1 l2. ls = l1 ++ (EL j ls)::l2 *)
5370(* Proof:
5371 Let x = EL j ls.
5372 Then MEM x ls by EL_MEM, j < LENGTH ls
5373 so ?l1 l2. l = l1 ++ x::l2 by MEM_SPLIT
5374 Pick these l1 and l2.
5375*)
5376Theorem EL_SPLIT:
5377 !ls j. j < LENGTH ls ==> ?l1 l2. ls = l1 ++ (EL j ls)::l2
5378Proof
5379 metis_tac[EL_MEM, MEM_SPLIT]
5380QED
5381
5382(* Theorem: j < k /\ k < LENGTH ls ==>
5383 ?l1 l2 l3. ls = l1 ++ (EL j ls)::l2 ++ (EL k ls)::l3 *)
5384(* Proof:
5385 Let a = EL j ls,
5386 b = EL k ls.
5387 Note j < LENGTH ls by j < k, k < LENGTH ls
5388 so MEM a ls /\ MEM b ls by MEM_EL
5389
5390 Now ls
5391 = TAKE k ls ++ DROP k ls by TAKE_DROP
5392 = TAKE k ls ++ b::(DROP (k+1) ls) by DROP_EL_CONS
5393 Let lt = TAKE k ls.
5394 Then LENGTH lt = k by LENGTH_TAKE
5395 and a = EL j lt by EL_TAKE
5396 and lt
5397 = TAKE j lt ++ DROP j lt by TAKE_DROP
5398 = TAKE j lt ++ a::(DROP (j+1) lt) by DROP_EL_CONS
5399 Pick l1 = TAKE j lt, l2 = DROP (j+1) lt, l3 = DROP (k+1) ls.
5400*)
5401Theorem EL_SPLIT_2:
5402 !ls j k. j < k /\ k < LENGTH ls ==>
5403 ?l1 l2 l3. ls = l1 ++ (EL j ls)::l2 ++ (EL k ls)::l3
5404Proof
5405 rpt strip_tac >>
5406 qabbrev_tac `a = EL j ls` >>
5407 qabbrev_tac `b = EL k ls` >>
5408 `j < LENGTH ls` by decide_tac >>
5409 `MEM a ls /\ MEM b ls` by metis_tac[MEM_EL] >>
5410 `ls = TAKE k ls ++ b::(DROP (k+1) ls)` by metis_tac[TAKE_DROP, DROP_EL_CONS] >>
5411 qabbrev_tac `lt = TAKE k ls` >>
5412 `LENGTH lt = k` by simp[Abbr`lt`] >>
5413 `a = EL j lt` by simp[EL_TAKE, Abbr`a`, Abbr`lt`] >>
5414 `lt = TAKE j lt ++ a::(DROP (j+1) lt)` by metis_tac[TAKE_DROP, DROP_EL_CONS] >>
5415 metis_tac[]
5416QED
5417
5418(* Theorem: (l1 ++ l2 = m1 ++ m2) /\ (LENGTH l1 = LENGTH m1) <=> (l1 = m1) /\ (l2 = m2) *)
5419(* Proof:
5420 By APPEND_EQ_APPEND,
5421 ?l. (l1 = m1 ++ l) /\ (m2 = l ++ l2) \/ ?l. (m1 = l1 ++ l) /\ (l2 = l ++ m2).
5422 Thus this is to show:
5423 (1) LENGTH (m1 ++ l) = LENGTH m1 ==> m1 ++ l = m1, true since l = [] by LENGTH_APPEND, LENGTH_NIL
5424 (2) LENGTH (m1 ++ l) = LENGTH m1 ==> l2 = l ++ l2, true since l = [] by LENGTH_APPEND, LENGTH_NIL
5425 (3) LENGTH l1 = LENGTH (l1 ++ l) ==> l1 = l1 ++ l, true since l = [] by LENGTH_APPEND, LENGTH_NIL
5426 (4) LENGTH l1 = LENGTH (l1 ++ l) ==> l ++ m2 = m2, true since l = [] by LENGTH_APPEND, LENGTH_NIL
5427*)
5428Theorem APPEND_EQ_APPEND_EQ:
5429 !l1 l2 m1 m2. (l1 ++ l2 = m1 ++ m2) /\ (LENGTH l1 = LENGTH m1) <=> (l1 = m1) /\ (l2 = m2)
5430Proof
5431 rw[APPEND_EQ_APPEND] >>
5432 rw[EQ_IMP_THM] >-
5433 fs[] >-
5434 fs[] >-
5435 (fs[] >>
5436 `LENGTH l = 0` by decide_tac >>
5437 fs[]) >>
5438 fs[] >>
5439 `LENGTH l = 0` by decide_tac >>
5440 fs[]
5441QED
5442
5443(* ------------------------------------------------------------------------- *)
5444(* More about DROP and TAKE *)
5445(* ------------------------------------------------------------------------- *)
5446
5447(* listTheory.HD_DROP |- !n l. n < LENGTH l ==> HD (DROP n l) = EL n l *)
5448
5449(* Theorem: n < LENGTH ls ==> TL (DROP n ls) = DROP n (TL ls) *)
5450(* Proof:
5451 Note 0 < LENGTH ls, so ls <> [] by LENGTH_NON_NIL
5452 so ?h t. ls = h::t by NOT_NIL_CONS
5453 TL (DROP n ls)
5454 = TL (EL n ls::DROP (SUC n) ls) by DROP_CONS_EL
5455 = DROP (SUC n) ls by TL
5456 = DROP (SUC n) (h::t) by above
5457 = DROP n t by DROP
5458 = DROP n (TL ls) by TL
5459*)
5460Theorem TL_DROP:
5461 !ls n. n < LENGTH ls ==> TL (DROP n ls) = DROP n (TL ls)
5462Proof
5463 rpt strip_tac >>
5464 `0 < LENGTH ls` by decide_tac >>
5465 `TL (DROP n ls) = TL (EL n ls::DROP (SUC n) ls)` by simp[DROP_CONS_EL] >>
5466 `_ = DROP (SUC n) ls` by simp[] >>
5467 `_ = DROP (SUC n) (HD ls::TL ls)` by metis_tac[LIST_HEAD_TAIL] >>
5468 simp[]
5469QED
5470
5471(* Theorem: x <> [] ==> (TAKE 1 (x ++ y) = TAKE 1 x) *)
5472(* Proof:
5473 x <> [] means ?h t. x = h::t by list_CASES
5474 TAKE 1 (x ++ y)
5475 = TAKE 1 ((h::t) ++ y)
5476 = TAKE 1 (h:: t ++ y) by APPEND
5477 = h::TAKE 0 (t ++ y) by TAKE_def
5478 = h::TAKE 0 t by TAKE_0
5479 = TAKE 1 (h::t) by TAKE_def
5480*)
5481Theorem TAKE_1_APPEND:
5482 !x y. x <> [] ==> (TAKE 1 (x ++ y) = TAKE 1 x)
5483Proof
5484 Cases_on `x`>> rw[]
5485QED
5486
5487(* Theorem: x <> [] ==> (DROP 1 (x ++ y) = (DROP 1 x) ++ y) *)
5488(* Proof:
5489 x <> [] means ?h t. x = h::t by list_CASES
5490 DROP 1 (x ++ y)
5491 = DROP 1 ((h::t) ++ y)
5492 = DROP 1 (h:: t ++ y) by APPEND
5493 = DROP 0 (t ++ y) by DROP_def
5494 = t ++ y by DROP_0
5495 = (DROP 1 (h::t)) ++ y by DROP_def
5496*)
5497Theorem DROP_1_APPEND:
5498 !x y. x <> [] ==> (DROP 1 (x ++ y) = (DROP 1 x) ++ y)
5499Proof
5500 Cases_on `x` >> rw[]
5501QED
5502
5503(* Theorem: DROP (SUC n) x = DROP 1 (DROP n x) *)
5504(* Proof:
5505 By induction on x.
5506 Base case: !n. DROP (SUC n) [] = DROP 1 (DROP n [])
5507 LHS = DROP (SUC n) [] = [] by DROP_def
5508 RHS = DROP 1 (DROP n [])
5509 = DROP 1 [] by DROP_def
5510 = [] = LHS by DROP_def
5511 Step case: !n. DROP (SUC n) x = DROP 1 (DROP n x) ==>
5512 !h n. DROP (SUC n) (h::x) = DROP 1 (DROP n (h::x))
5513 If n = 0,
5514 LHS = DROP (SUC 0) (h::x)
5515 = DROP 1 (h::x) by ONE
5516 RHS = DROP 1 (DROP 0 (h::x))
5517 = DROP 1 (h::x) = LHS by DROP_0
5518 If n <> 0,
5519 LHS = DROP (SUC n) (h::x)
5520 = DROP n x by DROP_def
5521 RHS = DROP 1 (DROP n (h::x)
5522 = DROP 1 (DROP (n-1) x) by DROP_def
5523 = DROP (SUC (n-1)) x by induction hypothesis
5524 = DROP n x = LHS by SUC (n-1) = n, n <> 0.
5525*)
5526Theorem DROP_SUC:
5527 !n x. DROP (SUC n) x = DROP 1 (DROP n x)
5528Proof
5529 Induct_on `x` >>
5530 rw[DROP_def] >>
5531 `n = SUC (n-1)` by decide_tac >>
5532 metis_tac[]
5533QED
5534
5535(* Theorem: TAKE (SUC n) x = (TAKE n x) ++ (TAKE 1 (DROP n x)) *)
5536(* Proof:
5537 By induction on x.
5538 Base case: !n. TAKE (SUC n) [] = TAKE n [] ++ TAKE 1 (DROP n [])
5539 LHS = TAKE (SUC n) [] = [] by TAKE_def
5540 RHS = TAKE n [] ++ TAKE 1 (DROP n [])
5541 = [] ++ TAKE 1 [] by TAKE_def, DROP_def
5542 = TAKE 1 [] by APPEND
5543 = [] = LHS by TAKE_def
5544 Step case: !n. TAKE (SUC n) x = TAKE n x ++ TAKE 1 (DROP n x) ==>
5545 !h n. TAKE (SUC n) (h::x) = TAKE n (h::x) ++ TAKE 1 (DROP n (h::x))
5546 If n = 0,
5547 LHS = TAKE (SUC 0) (h::x)
5548 = TAKE 1 (h::x) by ONE
5549 RHS = TAKE 0 (h::x) ++ TAKE 1 (DROP 0 (h::x))
5550 = [] ++ TAKE 1 (h::x) by TAKE_def, DROP_def
5551 = TAKE 1 (h::x) = LHS by APPEND
5552 If n <> 0,
5553 LHS = TAKE (SUC n) (h::x)
5554 = h :: TAKE n x by TAKE_def
5555 RHS = TAKE n (h::x) ++ TAKE 1 (DROP n (h::x))
5556 = (h:: TAKE (n-1) x) ++ TAKE 1 (DROP (n-1) x) by TAKE_def, DROP_def, n <> 0.
5557 = h :: (TAKE (n-1) x ++ TAKE 1 (DROP (n-1) x)) by APPEND
5558 = h :: TAKE (SUC (n-1)) x by induction hypothesis
5559 = h :: TAKE n x by SUC (n-1) = n, n <> 0.
5560*)
5561Theorem TAKE_SUC:
5562 !n x. TAKE (SUC n) x = (TAKE n x) ++ (TAKE 1 (DROP n x))
5563Proof
5564 Induct_on `x` >>
5565 rw[TAKE_def, DROP_def] >>
5566 `n = SUC (n-1)` by decide_tac >>
5567 metis_tac[]
5568QED
5569
5570(* Theorem: k < LENGTH x ==> (TAKE (SUC k) x = SNOC (EL k x) (TAKE k x)) *)
5571(* Proof:
5572 By induction on k.
5573 Base case: !x. 0 < LENGTH x ==> (TAKE (SUC 0) x = SNOC (EL 0 x) (TAKE 0 x))
5574 0 < LENGTH x
5575 ==> ?h t. x = h::t by LENGTH_NIL, list_CASES
5576 LHS = TAKE (SUC 0) x
5577 = TAKE 1 (h::t) by ONE
5578 = h::TAKE 0 t by TAKE_def
5579 = h::[] by TAKE_0
5580 = [h]
5581 = SNOC h [] by SNOC
5582 = SNOC h (TAKE 0 (h::t)) by TAKE_0
5583 = SNOC (EL 0 (h::t)) (TAKE 0 (h::t)) by EL
5584 = RHS
5585 Step case: !x. k < LENGTH x ==> (TAKE (SUC k) x = SNOC (EL k x) (TAKE k x)) ==>
5586 !x. SUC k < LENGTH x ==> (TAKE (SUC (SUC k)) x = SNOC (EL (SUC k) x) (TAKE (SUC k) x))
5587 Since 0 < SUC k by prim_recTheory.LESS_0
5588 0 < LENGTH x by LESS_TRANS
5589 ==> ?h t. x = h::t by LENGTH_NIL, list_CASES
5590 and LENGTH (h::t) = SUC (LENGTH t) by LENGTH
5591 hence k < LENGTH t by LESS_MONO_EQ
5592 LHS = TAKE (SUC (SUC k)) (h::t)
5593 = h :: TAKE (SUC k) t by TAKE_def
5594 = h :: SNOC (EL k t) (TAKE k t) by induction hypothesis, k < LENGTH t.
5595 = SNOC (EL k t) (h :: TAKE k t) by SNOC
5596 = SNOC (EL (SUC k) (h::t)) (h :: TAKE k t) by EL_restricted
5597 = SNOC (EL (SUC k) (h::t)) (TAKE (SUC k) (h::t)) by TAKE_def
5598 = RHS
5599*)
5600Theorem TAKE_SUC_BY_TAKE:
5601 !k x. k < LENGTH x ==> (TAKE (SUC k) x = SNOC (EL k x) (TAKE k x))
5602Proof
5603 Induct_on `k` >| [
5604 rpt strip_tac >>
5605 `LENGTH x <> 0` by decide_tac >>
5606 `?h t. x = h::t` by metis_tac[LENGTH_NIL, list_CASES] >>
5607 rw[],
5608 rpt strip_tac >>
5609 `LENGTH x <> 0` by decide_tac >>
5610 `?h t. x = h::t` by metis_tac[LENGTH_NIL, list_CASES] >>
5611 `k < LENGTH t` by metis_tac[LENGTH, LESS_MONO_EQ] >>
5612 rw_tac std_ss[TAKE_def, SNOC, EL_restricted]
5613 ]
5614QED
5615
5616(* Theorem: k < LENGTH x ==> (DROP k x = (EL k x) :: (DROP (SUC k) x)) *)
5617(* Proof:
5618 By induction on k.
5619 Base case: !x. 0 < LENGTH x ==> (DROP 0 x = EL 0 x::DROP (SUC 0) x)
5620 0 < LENGTH x
5621 ==> ?h t. x = h::t by LENGTH_NIL, list_CASES
5622 LHS = DROP 0 (h::t)
5623 = h::t by DROP_0
5624 = (EL 0 (h::t))::t by EL
5625 = (EL 0 (h::t))::(DROP 1 (h::t)) by DROP_def
5626 = EL 0 x::DROP (SUC 0) x by ONE
5627 = RHS
5628 Step case: !x. k < LENGTH x ==> (DROP k x = EL k x::DROP (SUC k) x) ==>
5629 !x. SUC k < LENGTH x ==> (DROP (SUC k) x = EL (SUC k) x::DROP (SUC (SUC k)) x)
5630 Since 0 < SUC k by prim_recTheory.LESS_0
5631 0 < LENGTH x by LESS_TRANS
5632 ==> ?h t. x = h::t by LENGTH_NIL, list_CASES
5633 and LENGTH (h::t) = SUC (LENGTH t) by LENGTH
5634 hence k < LENGTH t by LESS_MONO_EQ
5635 LHS = DROP (SUC k) (h::t)
5636 = DROP k t by DROP_def
5637 = EL k x::DROP (SUC k) x by induction hypothesis
5638 = EL k t :: DROP (SUC (SUC k)) (h::t) by DROP_def
5639 = EL (SUC k) (h::t)::DROP (SUC (SUC k)) (h::t) by EL
5640 = RHS
5641*)
5642Theorem DROP_BY_DROP_SUC:
5643 !k x. k < LENGTH x ==> (DROP k x = (EL k x) :: (DROP (SUC k) x))
5644Proof
5645 Induct_on `k` >| [
5646 rpt strip_tac >>
5647 `LENGTH x <> 0` by decide_tac >>
5648 `?h t. x = h::t` by metis_tac[LENGTH_NIL, list_CASES] >>
5649 rw[],
5650 rpt strip_tac >>
5651 `LENGTH x <> 0` by decide_tac >>
5652 `?h t. x = h::t` by metis_tac[LENGTH_NIL, list_CASES] >>
5653 `k < LENGTH t` by metis_tac[LENGTH, LESS_MONO_EQ] >>
5654 rw[]
5655 ]
5656QED
5657
5658(* Theorem: n < LENGTH ls ==> ?u. DROP n ls = [EL n ls] ++ u *)
5659(* Proof:
5660 By induction on n.
5661 Base: !ls. 0 < LENGTH ls ==> ?u. DROP 0 ls = [EL 0 ls] ++ u
5662 Note LENGTH ls <> 0 by 0 < LENGTH ls
5663 ==> ls <> [] by LENGTH_NIL
5664 ==> ?h t. ls = h::t by list_CASES
5665 DROP 0 ls
5666 = ls by DROP_0
5667 = [h] ++ t by ls = h::t, CONS_APPEND
5668 = [EL 0 ls] ++ t by EL
5669 Take u = t.
5670 Step: !ls. n < LENGTH ls ==> ?u. DROP n ls = [EL n ls] ++ u ==>
5671 !ls. SUC n < LENGTH ls ==> ?u. DROP (SUC n) ls = [EL (SUC n) ls] ++ u
5672 Note LENGTH ls <> 0 by SUC n < LENGTH ls
5673 ==> ?h t. ls = h::t by list_CASES, LENGTH_NIL
5674 Now LENGTH ls = SUC (LENGTH t) by LENGTH
5675 ==> n < LENGTH t by SUC n < SUC (LENGTH t)
5676 Thus ?u. DROP n t = [EL n t] ++ u by induction hypothesis
5677
5678 DROP (SUC n) ls
5679 = DROP (SUC n) (h::t) by ls = h::t
5680 = DROP n t by DROP_def
5681 = [EL n t] ++ u by above
5682 = [EL (SUC n) (h::t)] ++ u by EL_restricted
5683 Take this u.
5684*)
5685Theorem DROP_HEAD_ELEMENT:
5686 !ls n. n < LENGTH ls ==> ?u. DROP n ls = [EL n ls] ++ u
5687Proof
5688 Induct_on `n` >| [
5689 rpt strip_tac >>
5690 `LENGTH ls <> 0` by decide_tac >>
5691 `?h t. ls = h::t` by metis_tac[list_CASES, LENGTH_NIL] >>
5692 rw[],
5693 rw[] >>
5694 `LENGTH ls <> 0` by decide_tac >>
5695 `?h t. ls = h::t` by metis_tac[list_CASES, LENGTH_NIL] >>
5696 `LENGTH ls = SUC (LENGTH t)` by rw[] >>
5697 `n < LENGTH t` by decide_tac >>
5698 `?u. DROP n t = [EL n t] ++ u` by rw[] >>
5699 rw[]
5700 ]
5701QED
5702
5703(* Theorem: DROP n (TAKE n ls) = [] *)
5704(* Proof:
5705 If n <= LENGTH ls,
5706 Then LENGTH (TAKE n ls) = n by LENGTH_TAKE_EQ
5707 Thus DROP n (TAKE n ls) = [] by DROP_LENGTH_TOO_LONG
5708 If LENGTH ls < n
5709 Then LENGTH (TAKE n ls) = LENGTH ls by LENGTH_TAKE_EQ
5710 Thus DROP n (TAKE n ls) = [] by DROP_LENGTH_TOO_LONG
5711*)
5712Theorem DROP_TAKE_EQ_NIL:
5713 !ls n. DROP n (TAKE n ls) = []
5714Proof
5715 rw[LENGTH_TAKE_EQ, DROP_LENGTH_TOO_LONG]
5716QED
5717
5718(* Theorem: TAKE m (DROP n ls) = DROP n (TAKE (n + m) ls) *)
5719(* Proof:
5720 If n <= LENGTH ls,
5721 Then LENGTH (TAKE n ls) = n by LENGTH_TAKE_EQ, n <= LENGTH ls
5722 DROP n (TAKE (n + m) ls)
5723 = DROP n (TAKE n ls ++ TAKE m (DROP n ls)) by TAKE_SUM
5724 = DROP n (TAKE n ls) ++ DROP (n - LENGTH (TAKE n ls)) (TAKE m (DROP n ls)) by DROP_APPEND
5725 = [] ++ DROP (n - LENGTH (TAKE n ls)) (TAKE m (DROP n ls)) by DROP_TAKE_EQ_NIL
5726 = DROP (n - LENGTH (TAKE n ls)) (TAKE m (DROP n ls)) by APPEND
5727 = DROP 0 (TAKE m (DROP n ls)) by above
5728 = TAKE m (DROP n ls) by DROP_0
5729 If LENGTH ls < n,
5730 Then DROP n ls = [] by DROP_LENGTH_TOO_LONG
5731 and TAKE (n + m) ls = ls by TAKE_LENGTH_TOO_LONG
5732 DROP n (TAKE (n + m) ls)
5733 = DROP n ls by TAKE_LENGTH_TOO_LONG
5734 = [] by DROP_LENGTH_TOO_LONG
5735 = TAKE m [] by TAKE_nil
5736 = TAKE m (DROP n ls) by DROP_LENGTH_TOO_LONG
5737*)
5738Theorem TAKE_DROP_SWAP:
5739 !ls m n. TAKE m (DROP n ls) = DROP n (TAKE (n + m) ls)
5740Proof
5741 rpt strip_tac >>
5742 Cases_on `n <= LENGTH ls` >| [
5743 qabbrev_tac `x = TAKE m (DROP n ls)` >>
5744 `DROP n (TAKE (n + m) ls) = DROP n (TAKE n ls ++ x)` by rw[TAKE_SUM, Abbr`x`] >>
5745 `_ = DROP n (TAKE n ls) ++ DROP (n - LENGTH (TAKE n ls)) x` by rw[DROP_APPEND] >>
5746 `_ = DROP (n - LENGTH (TAKE n ls)) x` by rw[DROP_TAKE_EQ_NIL] >>
5747 `_ = DROP 0 x` by rw[LENGTH_TAKE_EQ] >>
5748 rw[],
5749 `DROP n ls = []` by rw[DROP_LENGTH_TOO_LONG] >>
5750 `TAKE (n + m) ls = ls` by rw[TAKE_LENGTH_TOO_LONG] >>
5751 rw[]
5752 ]
5753QED
5754
5755(* cf. TAKE_DROP |- !n l. TAKE n l ++ DROP n l = l *)
5756Theorem TAKE_DROP_SUC :
5757 !n l. n < LENGTH l ==> TAKE n l ++ [EL n l] ++ DROP (SUC n) l = l
5758Proof
5759 rpt STRIP_TAC
5760 >> REWRITE_TAC [GSYM APPEND_ASSOC, Once EQ_SYM_EQ]
5761 >> ‘l = TAKE n l ++ DROP n l’ by rw [TAKE_DROP]
5762 >> POP_ASSUM
5763 (GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) empty_rewrites o wrap)
5764 >> RW_TAC bool_ss [DROP_BY_DROP_SUC, GSYM CONS_APPEND]
5765QED
5766
5767(* Theorem: TAKE (LENGTH l1) (LUPDATE x (LENGTH l1 + k) (l1 ++ l2)) = l1 *)
5768(* Proof:
5769 TAKE (LENGTH l1) (LUPDATE x (LENGTH l1 + k) (l1 ++ l2))
5770 = TAKE (LENGTH l1) (l1 ++ LUPDATE x k l2) by LUPDATE_APPEND2
5771 = l1 by TAKE_LENGTH_APPEND
5772*)
5773Theorem TAKE_LENGTH_APPEND2:
5774 !l1 l2 x k. TAKE (LENGTH l1) (LUPDATE x (LENGTH l1 + k) (l1 ++ l2)) = l1
5775Proof
5776 rw_tac std_ss[LUPDATE_APPEND2, TAKE_LENGTH_APPEND]
5777QED
5778
5779(* Theorem: LENGTH (TAKE n l) <= LENGTH l *)
5780(* Proof: by LENGTH_TAKE_EQ *)
5781Theorem LENGTH_TAKE_LE:
5782 !n l. LENGTH (TAKE n l) <= LENGTH l
5783Proof
5784 rw[LENGTH_TAKE_EQ]
5785QED
5786
5787(* Theorem: ALL_DISTINCT ls ==>
5788 !k e. MEM e (TAKE k ls) /\ MEM e (DROP k ls) ==> F *)
5789(* Proof:
5790 By induction on ls.
5791 Base: ALL_DISTINCT [] ==> !k e. MEM e (TAKE k []) /\ MEM e (DROP k []) ==> F
5792 MEM e (TAKE k []) = MEM e [] = F by TAKE_nil, MEM
5793 MEM e (DROP k []) = MEM e [] = F by DROP_nil, MEM
5794 Step: ALL_DISTINCT ls ==>
5795 !k e. MEM e (TAKE k ls) /\ MEM e (DROP k ls) ==> F ==>
5796 !h. ALL_DISTINCT (h::ls) ==>
5797 !k e. MEM e (TAKE k (h::ls)) /\ MEM e (DROP k (h::ls)) ==> F
5798 Note ~MEM h ls /\ ALL_DISTINCT ls by ALL_DISTINCT
5799 If k = 0,
5800 MEM e (TAKE 0 (h::ls))
5801 <=> MEM e [] = F by TAKE_0, MEM
5802 hence true.
5803 If k <> 0,
5804 MEM e (TAKE k (h::ls))
5805 <=> MEM e (h::TAKE (k - 1) ls) by TAKE_def, k <> 0
5806 <=> e = h \/ MEM e (TAKE (k - 1) ls) by MEM
5807 MEM e (DROP k (h::ls))
5808 <=> MEM e (DROP (k - 1) ls) by DROP_def, k <> 0
5809 ==> MEM e ls by MEM_DROP_IMP
5810 If e = h,
5811 this contradicts ~MEM h ls.
5812 If MEM e (TAKE (k - 1) ls)
5813 this contradicts the induction hypothesis.
5814*)
5815Theorem ALL_DISTINCT_TAKE_DROP:
5816 !ls. ALL_DISTINCT ls ==>
5817 !k e. MEM e (TAKE k ls) /\ MEM e (DROP k ls) ==> F
5818Proof
5819 Induct >-
5820 simp[] >>
5821 rw[] >>
5822 Cases_on `k = 0` >-
5823 fs[] >>
5824 spose_not_then strip_assume_tac >>
5825 rfs[] >-
5826 metis_tac[MEM_DROP_IMP] >>
5827 metis_tac[]
5828QED
5829
5830(* Theorem: ALL_DISTINCT (x::y::ls) <=> ALL_DISTINCT (y::x::ls) *)
5831(* Proof:
5832 If x = y, this is trivial.
5833 If x <> y,
5834 ALL_DISTINCT (x::y::ls)
5835 <=> (x <> y /\ ~MEM x ls) /\ ~MEM y ls /\ ALL_DISTINCT ls by ALL_DISTINCT
5836 <=> (y <> x /\ ~MEM y ls) /\ ~MEM x ls /\ ALL_DISTINCT ls
5837 <=> ALL_DISTINCT (y::x::ls) by ALL_DISTINCT
5838*)
5839Theorem ALL_DISTINCT_SWAP:
5840 !ls x y. ALL_DISTINCT (x::y::ls) <=> ALL_DISTINCT (y::x::ls)
5841Proof
5842 rw[] >>
5843 metis_tac[]
5844QED
5845
5846(* Theorem: ALL_DISTINCT ls /\ ls <> [] /\ j < LENGTH ls ==> (EL j ls = LAST ls <=> j + 1 = LENGTH ls) *)
5847(* Proof:
5848 Note 0 < LENGTH ls by LENGTH_EQ_0
5849 EL j ls = LAST ls
5850 <=> EL j ls = EL (PRE (LENGTH ls)) ls by LAST_EL
5851 <=> j = PRE (LENGTH ls) by ALL_DISTINCT_EL_IMP, j < LENGTH ls
5852 <=> j + 1 = LENGTH ls by SUC_PRE, ADD1, 0 < LENGTH ls
5853*)
5854Theorem ALL_DISTINCT_LAST_EL_IFF:
5855 !ls j. ALL_DISTINCT ls /\ ls <> [] /\ j < LENGTH ls ==> (EL j ls = LAST ls <=> j + 1 = LENGTH ls)
5856Proof
5857 rw[LAST_EL] >>
5858 `0 < LENGTH ls` by metis_tac[LENGTH_EQ_0, NOT_ZERO] >>
5859 `PRE (LENGTH ls) + 1 = LENGTH ls` by decide_tac >>
5860 `EL j ls = EL (PRE (LENGTH ls)) ls <=> j = PRE (LENGTH ls)` by fs[ALL_DISTINCT_EL_IMP] >>
5861 simp[]
5862QED
5863
5864(* Theorem: ALL_DISTINCT ls /\ j < LENGTH ls /\ ls = l1 ++ [EL j ls] ++ l2 ==> j = LENGTH l1 *)
5865(* Proof:
5866 Note EL j ls = EL (LENGTH l1) ls by el_append3
5867 and LENGTH l1 < LENGTH ls by LENGTH_APPEND
5868 so j = LENGTH l1 by ALL_DISTINCT_EL_IMP
5869*)
5870Theorem ALL_DISTINCT_EL_APPEND:
5871 !ls l1 l2 j. ALL_DISTINCT ls /\ j < LENGTH ls /\ ls = l1 ++ [EL j ls] ++ l2 ==> j = LENGTH l1
5872Proof
5873 rpt strip_tac >>
5874 `EL j ls = EL (LENGTH l1) ls` by metis_tac[el_append3] >>
5875 `LENGTH ls = LENGTH l1 + 1 + LENGTH l2` by metis_tac[LENGTH_APPEND, LENGTH_SING] >>
5876 `LENGTH l1 < LENGTH ls` by decide_tac >>
5877 metis_tac[ALL_DISTINCT_EL_IMP]
5878QED
5879
5880(* Theorem: ALL_DISTINCT (l1 ++ [x] ++ l2) <=> ALL_DISTINCT (x::(l1 ++ l2)) *)
5881(* Proof:
5882 By induction on l1.
5883 Base: ALL_DISTINCT ([] ++ [x] ++ l2) <=> ALL_DISTINCT (x::([] ++ l2))
5884 ALL_DISTINCT ([] ++ [x] ++ l2)
5885 <=> ALL_DISTINCT (x::l2) by APPEND_NIL
5886 <=> ALL_DISTINCT (x::([] ++ l2)) by APPEND_NIL
5887 Step: ALL_DISTINCT (l1 ++ [x] ++ l2) <=> ALL_DISTINCT (x::(l1 ++ l2)) ==>
5888 !h. ALL_DISTINCT (h::l1 ++ [x] ++ l2) <=> ALL_DISTINCT (x::(h::l1 ++ l2))
5889
5890 ALL_DISTINCT (h::l1 ++ [x] ++ l2)
5891 <=> ALL_DISTINCT (h::(l1 ++ [x] ++ l2)) by APPEND
5892 <=> ~MEM h (l1 ++ [x] ++ l2) /\
5893 ALL_DISTINCT (l1 ++ [x] ++ l2) by ALL_DISTINCT
5894 <=> ~MEM h (l1 ++ [x] ++ l2) /\
5895 ALL_DISTINCT (x::(l1 ++ l2)) by induction hypothesis
5896 <=> ~MEM h (x::(l1 ++ l2)) /\
5897 ALL_DISTINCT (x::(l1 ++ l2)) by MEM_APPEND_3
5898 <=> ALL_DISTINCT (h::x::(l1 ++ l2)) by ALL_DISTINCT
5899 <=> ALL_DISTINCT (x::h::(l1 ++ l2)) by ALL_DISTINCT_SWAP
5900 <=> ALL_DISTINCT (x::(h::l1 ++ l2)) by APPEND
5901*)
5902Theorem ALL_DISTINCT_APPEND_3:
5903 !l1 x l2. ALL_DISTINCT (l1 ++ [x] ++ l2) <=> ALL_DISTINCT (x::(l1 ++ l2))
5904Proof
5905 rpt strip_tac >>
5906 Induct_on `l1` >-
5907 simp[] >>
5908 rpt strip_tac >>
5909 `ALL_DISTINCT (h::l1 ++ [x] ++ l2) <=> ALL_DISTINCT (h::(l1 ++ [x] ++ l2))` by rw[] >>
5910 `_ = (~MEM h (l1 ++ [x] ++ l2) /\ ALL_DISTINCT (l1 ++ [x] ++ l2))` by rw[] >>
5911 `_ = (~MEM h (l1 ++ [x] ++ l2) /\ ALL_DISTINCT (x::(l1 ++ l2)))` by rw[] >>
5912 `_ = (~MEM h (x::(l1 ++ l2)) /\ ALL_DISTINCT (x::(l1 ++ l2)))` by rw[MEM_APPEND_3] >>
5913 `_ = ALL_DISTINCT (h::x::(l1 ++ l2))` by rw[] >>
5914 `_ = ALL_DISTINCT (x::h::(l1 ++ l2))` by rw[ALL_DISTINCT_SWAP] >>
5915 `_ = ALL_DISTINCT (x::(h::l1 ++ l2))` by metis_tac[APPEND] >>
5916 simp[]
5917QED
5918
5919(* Theorem: ALL_DISTINCT l ==> !x. MEM x l <=> ?p1 p2. (l = p1 ++ [x] ++ p2) /\ ~MEM x p1 /\ ~MEM x p2 *)
5920(* Proof:
5921 If part: MEM x l ==> ?p1 p2. (l = p1 ++ [x] ++ p2) /\ ~MEM x p1 /\ ~MEM x p2
5922 Note ?p1 p2. (l = p1 ++ [x] ++ p2) /\ ~MEM x p2 by MEM_SPLIT_APPEND_last
5923 Now ALL_DISTINCT (p1 ++ [x]) by ALL_DISTINCT_APPEND, ALL_DISTINCT l
5924 But MEM x [x] by MEM
5925 so ~MEM x p1 by ALL_DISTINCT_APPEND
5926
5927 Only-if part: MEM x (p1 ++ [x] ++ p2), true by MEM_APPEND
5928*)
5929Theorem MEM_SPLIT_APPEND_distinct:
5930 !l. ALL_DISTINCT l ==> !x. MEM x l <=> ?p1 p2. (l = p1 ++ [x] ++ p2) /\ ~MEM x p1 /\ ~MEM x p2
5931Proof
5932 rw[EQ_IMP_THM] >-
5933 metis_tac[MEM_SPLIT_APPEND_last, ALL_DISTINCT_APPEND, MEM] >>
5934 rw[]
5935QED
5936
5937(* Theorem: MEM x ls <=>
5938 ?k. k < LENGTH ls /\ x = EL k ls /\
5939 ls = TAKE k ls ++ x::DROP (k+1) ls /\ ~MEM x (TAKE k ls) *)
5940(* Proof:
5941 If part: MEM x ls ==> ?k. k < LENGTH ls /\ x = EL k ls /\
5942 ls = TAKE k ls ++ x::DROP (k+1) ls /\ ~MEM x (TAKE k ls)
5943 Note ?pfx sfx. ls = pfx ++ [x] ++ sfx /\ ~MEM x pfx
5944 by MEM_SPLIT_APPEND_first
5945 Take k = LENGTH pfx.
5946 Then k < LENGTH ls by LENGTH_APPEND
5947 and EL k ls
5948 = EL k (pfx ++ [x] ++ sfx)
5949 = x by el_append3
5950 and TAKE k ls ++ x::DROP (k+1) ls
5951 = TAKE k (pfx ++ [x] ++ sfx) ++
5952 [x] ++
5953 DROP (k+1) ((pfx ++ [x] ++ sfx))
5954 = pfx ++ [x] ++ by TAKE_APPEND1
5955 (DROP (k+1)(pfx + [x])
5956 ++ sfx by DROP_APPEND1
5957 = pfx ++ [x] ++ sfx by DROP_LENGTH_NIL
5958 = ls
5959 and TAKE k ls = pfx by TAKE_APPEND1
5960 Only-if part: k < LENGTH ls /\ ls = TAKE k ls ++ [EL k ls] ++ DROP (k + 1) ls /\
5961 ~MEM (EL k ls) (TAKE k ls) ==> MEM (EL k ls) ls
5962 This is true by EL_MEM, just need k < LENGTH ls
5963*)
5964Theorem MEM_SPLIT_TAKE_DROP_first:
5965 !ls x. MEM x ls <=>
5966 ?k. k < LENGTH ls /\ x = EL k ls /\
5967 ls = TAKE k ls ++ x::DROP (k+1) ls /\ ~MEM x (TAKE k ls)
5968Proof
5969 rw[EQ_IMP_THM] >| [
5970 imp_res_tac MEM_SPLIT_APPEND_first >>
5971 qexists_tac `LENGTH pfx` >>
5972 rpt strip_tac >-
5973 fs[] >-
5974 fs[el_append3] >-
5975 fs[TAKE_APPEND1, DROP_APPEND1] >>
5976 `TAKE (LENGTH pfx) ls = pfx` by rw[TAKE_APPEND1] >>
5977 fs[],
5978 fs[EL_MEM]
5979 ]
5980QED
5981
5982(* Theorem: MEM x ls <=>
5983 ?k. k < LENGTH ls /\ x = EL k ls /\
5984 ls = TAKE k ls ++ x::DROP (k+1) ls /\ ~MEM x (DROP (k+1) ls) *)
5985(* Proof:
5986 If part: MEM x ls ==> ?k. k < LENGTH ls /\ x = EL k ls /\
5987 ls = TAKE k ls ++ x::DROP (k+1) ls /\ ~MEM x (DROP (k+1) ls)
5988 Note ?pfx sfx. ls = pfx ++ [x] ++ sfx /\ ~MEM x sfx
5989 by MEM_SPLIT_APPEND_last
5990 Take k = LENGTH pfx.
5991 Then k < LENGTH ls by LENGTH_APPEND
5992 and EL k ls
5993 = EL k (pfx ++ [x] ++ sfx)
5994 = x by el_append3
5995 and TAKE k ls ++ x::DROP (k+1) ls
5996 = TAKE k (pfx ++ [x] ++ sfx) ++
5997 [x] ++
5998 DROP (k+1) ((pfx ++ [x] ++ sfx))
5999 = pfx ++ [x] ++ by TAKE_APPEND1
6000 (DROP (k+1)(pfx + [x])
6001 ++ sfx by DROP_APPEND1
6002 = pfx ++ [x] ++ sfx by DROP_LENGTH_NIL
6003 = ls
6004 and DROP (k + 1) ls) = sfx by DROP_APPEND1, DROP_LENGTH_NIL
6005 Only-if part: k < LENGTH ls /\ ls = TAKE k ls ++ [EL k ls] ++ DROP (k + 1) ls /\
6006 ~MEM (EL k ls) (DROP (k+1) ls)) ==> MEM (EL k ls) ls
6007 This is true by EL_MEM, just need k < LENGTH ls
6008*)
6009Theorem MEM_SPLIT_TAKE_DROP_last:
6010 !ls x. MEM x ls <=>
6011 ?k. k < LENGTH ls /\ x = EL k ls /\
6012 ls = TAKE k ls ++ x::DROP (k+1) ls /\ ~MEM x (DROP (k+1) ls)
6013Proof
6014 rw[EQ_IMP_THM] >| [
6015 imp_res_tac MEM_SPLIT_APPEND_last >>
6016 qexists_tac `LENGTH pfx` >>
6017 rpt strip_tac >-
6018 fs[] >-
6019 fs[el_append3] >-
6020 fs[TAKE_APPEND1, DROP_APPEND1] >>
6021 `DROP (LENGTH pfx + 1) ls = sfx` by rw[DROP_APPEND1] >>
6022 fs[],
6023 fs[EL_MEM]
6024 ]
6025QED
6026
6027(* Theorem: ALL_DISTINCT ls ==>
6028 !x. MEM x ls <=>
6029 ?k. k < LENGTH ls /\ x = EL k ls /\
6030 ls = TAKE k ls ++ x::DROP (k+1) ls /\
6031 ~MEM x (TAKE k ls) /\ ~MEM x (DROP (k+1) ls) *)
6032(* Proof:
6033 If part: MEM x ls ==> ?k. k < LENGTH ls /\ x = EL k ls /\
6034 ls = TAKE k ls ++ x::DROP (k+1) ls /\
6035 ~MEM x (TAKE k ls) /\ ~MEM x (DROP (k+1) ls)
6036 Note ?p1 p2. ls = p1 ++ [x] ++ p2 /\ ~MEM x p1 /\ ~MEM x p2
6037 by MEM_SPLIT_APPEND_distinct
6038 Take k = LENGTH p1.
6039 Then k < LENGTH ls by LENGTH_APPEND
6040 and EL k ls
6041 = EL k (p1 ++ [x] ++ p2)
6042 = x by el_append3
6043 and TAKE k ls ++ x::DROP (k+1) ls
6044 = TAKE k (p1 ++ [x] ++ p2) ++
6045 [x] ++
6046 DROP (k+1) ((p1 ++ [x] ++ p2))
6047 = p1 ++ [x] ++ by TAKE_APPEND1
6048 (DROP (k+1)(p1 + [x])
6049 ++ p2 by DROP_APPEND1
6050 = p1 ++ [x] ++ p2 by DROP_LENGTH_NIL
6051 = ls
6052 and TAKE k ls = p1 by TAKE_APPEND1
6053 and DROP (k + 1) ls) = p2 by DROP_APPEND1, DROP_LENGTH_NIL
6054 Only-if part: k < LENGTH ls /\ ls = TAKE k ls ++ [EL k ls] ++ DROP (k + 1) ls /\
6055 ~MEM (EL k ls) (TAKE k ls) /\ ~MEM (EL k ls) (DROP (k+1) ls)) ==> MEM (EL k ls) ls
6056 This is true by EL_MEM, just need k < LENGTH ls
6057*)
6058Theorem MEM_SPLIT_TAKE_DROP_distinct:
6059 !ls. ALL_DISTINCT ls ==>
6060 !x. MEM x ls <=>
6061 ?k. k < LENGTH ls /\ x = EL k ls /\
6062 ls = TAKE k ls ++ x::DROP (k+1) ls /\
6063 ~MEM x (TAKE k ls) /\ ~MEM x (DROP (k+1) ls)
6064Proof
6065 rw[EQ_IMP_THM] >| [
6066 `?p1 p2. ls = p1 ++ [x] ++ p2 /\ ~MEM x p1 /\ ~MEM x p2` by rw[GSYM MEM_SPLIT_APPEND_distinct] >>
6067 qexists_tac `LENGTH p1` >>
6068 rpt strip_tac >-
6069 fs[] >-
6070 fs[el_append3] >-
6071 fs[TAKE_APPEND1, DROP_APPEND1] >-
6072 rfs[TAKE_APPEND1] >>
6073 `DROP (LENGTH p1 + 1) ls = p2` by rw[DROP_APPEND1] >>
6074 fs[],
6075 fs[EL_MEM]
6076 ]
6077QED
6078
6079(* ------------------------------------------------------------------------- *)
6080(* More about List Filter. *)
6081(* ------------------------------------------------------------------------- *)
6082
6083(* Idea: the j-th element of FILTER must have j elements filtered beforehand. *)
6084
6085(* Theorem: let fs = FILTER P ls in ls = l1 ++ x::l2 /\ P x ==>
6086 x = EL (LENGTH (FILTER P l1)) fs *)
6087(* Proof:
6088 Let l3 = x::l2, then ls = l1 ++ l3.
6089 Let j = LENGTH (FILTER P l1).
6090 EL j fs
6091 = EL j (FILTER P ls) by given
6092 = EL j (FILTER P l1 ++ FILTER P l3) by FILTER_APPEND_DISTRIB
6093 = EL 0 (FILTER P l3) by EL_APPEND, j = LENGTH (FILTER P l1)
6094 = EL 0 (FILTER P (x::l2)) by notation
6095 = EL 0 (x::FILTER P l2) by FILTER, P x
6096 = x by HD
6097*)
6098Theorem FILTER_EL_IMP:
6099 !P ls l1 l2 x. let fs = FILTER P ls in ls = l1 ++ x::l2 /\ P x ==>
6100 x = EL (LENGTH (FILTER P l1)) fs
6101Proof
6102 rw_tac std_ss[] >>
6103 qabbrev_tac `l3 = x::l2` >>
6104 qabbrev_tac `j = LENGTH (FILTER P l1)` >>
6105 `EL j fs = EL j (FILTER P l1 ++ FILTER P l3)` by simp[FILTER_APPEND_DISTRIB, Abbr`fs`] >>
6106 `_ = EL 0 (FILTER P (x::l2))` by simp[EL_APPEND, Abbr`j`, Abbr`l3`] >>
6107 fs[]
6108QED
6109
6110(* Theorem: let fs = FILTER P ls in ALL_DISTINCT ls /\ ls = l1 ++ x::l2 /\ j < LENGTH fs ==>
6111 (x = EL j fs <=> P x /\ j = LENGTH (FILTER P l1)) *)
6112(* Proof:
6113 Let k = LENGTH (FILTER P l1).
6114 If part: j < LENGTH fs /\ x = EL j fs ==> P x /\ j = k
6115 Note j < LENGTH fs /\ x = EL j fs by given
6116 ==> MEM x fs by MEM_EL
6117 ==> P x by MEM_FILTER
6118 Thus x = EL k fs by FILTER_EL_IMP
6119 Let l3 = x::l2, then ls = l1 ++ l3.
6120 Then FILTER P l3 = x :: FILTER P l2 by FILTER
6121 or FILTER P l3 <> [] by NOT_NIL_CONS
6122 or LENGTH (FILTER P l3) <> 0 by LENGTH_EQ_0, [1]
6123
6124 LENGTH fs
6125 = LENGTH (FILTER P ls) by notation
6126 = LENGTH (FILTER P l1 ++ FILTER P l3) by FILTER_APPEND_DISTRIB
6127 = k + LENGTH (FILTER P l3) by LENGTH_APPEND
6128 Thus k < LENGTH fs by [1]
6129
6130 Note ALL_DISTINCT ls
6131 ==> ALL_DISTINCT fs by FILTER_ALL_DISTINCT
6132 With x = EL j fs = EL k fs by above
6133 and j < LENGTH fs /\ k < LENGTH fs by above
6134 ==> j = k by ALL_DISTINCT_EL_IMP
6135
6136 Only-if part: j < LENGTH fs /\ P x /\ j = k ==> x = EL j fs
6137 This is true by FILTER_EL_IMP
6138*)
6139Theorem FILTER_EL_IFF:
6140 !P ls l1 l2 x j. let fs = FILTER P ls in ALL_DISTINCT ls /\ ls = l1 ++ x::l2 /\ j < LENGTH fs ==>
6141 (x = EL j fs <=> P x /\ j = LENGTH (FILTER P l1))
6142Proof
6143 rw_tac std_ss[] >>
6144 qabbrev_tac `k = LENGTH (FILTER P l1)` >>
6145 simp[EQ_IMP_THM] >>
6146 ntac 2 strip_tac >| [
6147 `MEM x fs` by metis_tac[MEM_EL] >>
6148 `P x` by fs[MEM_FILTER, Abbr`fs`] >>
6149 qabbrev_tac `ls = l1 ++ x::l2` >>
6150 `EL j fs = EL k fs` by metis_tac[FILTER_EL_IMP] >>
6151 qabbrev_tac `l3 = x::l2` >>
6152 `FILTER P l3 = x :: FILTER P l2` by simp[Abbr`l3`] >>
6153 `LENGTH (FILTER P l3) <> 0` by fs[] >>
6154 `fs = FILTER P l1 ++ FILTER P l3` by fs[FILTER_APPEND_DISTRIB, Abbr`fs`, Abbr`ls`] >>
6155 `LENGTH fs = k + LENGTH (FILTER P l3)` by fs[Abbr`k`] >>
6156 `k < LENGTH fs` by decide_tac >>
6157 `ALL_DISTINCT fs` by simp[FILTER_ALL_DISTINCT, Abbr`fs`] >>
6158 metis_tac[ALL_DISTINCT_EL_IMP],
6159 metis_tac[FILTER_EL_IMP]
6160 ]
6161QED
6162
6163(* Derive theorems for head = (EL 0 fs) *)
6164
6165(* Theorem: ls = l1 ++ x::l2 /\ P x /\ FILTER P l1 = [] ==> x = HD (FILTER P ls) *)
6166(* Proof:
6167 Note FILTER P l1 = [] by given
6168 ==> LENGTH (FILTER P l1) = 0 by LENGTH
6169 Thus x = EL 0 (FILTER P ls) by FILTER_EL_IMP
6170 = HD (FILTER P ls) by EL
6171*)
6172Theorem FILTER_HD:
6173 !P ls l1 l2 x. ls = l1 ++ x::l2 /\ P x /\ FILTER P l1 = [] ==> x = HD (FILTER P ls)
6174Proof
6175 metis_tac[LENGTH, FILTER_EL_IMP, EL]
6176QED
6177
6178(* Theorem: ALL_DISTINCT ls /\ ls = l1 ++ x::l2 /\ P x ==>
6179 (x = HD (FILTER P ls) <=> FILTER P l1 = []) *)
6180(* Proof:
6181 Let fs = FILTER P ls.
6182 Note MEM x ls by MEM_APPEND, MEM
6183 and P x ==> fs <> [] by MEM_FILTER, NIL_NO_MEM
6184 so 0 < LENGTH fs by LENGTH_EQ_0
6185 Thus x = HD fs
6186 = EL 0 fs by EL
6187 <=> LENGTH (FILTER P l1) = 0 by FILTER_EL_IFF
6188 <=> FILTER P l1 = [] by LENGTH_EQ_0
6189*)
6190Theorem FILTER_HD_IFF:
6191 !P ls l1 l2 x. ALL_DISTINCT ls /\ ls = l1 ++ x::l2 /\ P x ==>
6192 (x = HD (FILTER P ls) <=> FILTER P l1 = [])
6193Proof
6194 rpt strip_tac >>
6195 qabbrev_tac `fs = FILTER P ls` >>
6196 `MEM x ls` by metis_tac[MEM_APPEND, MEM] >>
6197 `MEM x fs` by fs[MEM_FILTER, Abbr`fs`] >>
6198 `0 < LENGTH fs` by metis_tac[NIL_NO_MEM, LENGTH_EQ_0, NOT_ZERO] >>
6199 metis_tac[FILTER_EL_IFF, EL, LENGTH_EQ_0]
6200QED
6201
6202(* Derive theorems for last = (EL (LENGTH fs - 1) fs) *)
6203
6204(* Theorem: ls = l1 ++ x::l2 /\ P x /\ FILTER P l2 = [] ==>
6205 x = LAST (FILTER P ls) *)
6206(* Proof:
6207 Let fs = FILTER P ls,
6208 k = LENGTH fs.
6209 Note MEM x ls by MEM_APPEND, MEM
6210 and P x ==> fs <> [] by MEM_FILTER, NIL_NO_MEM
6211 so 0 < LENGTH fs = k by LENGTH_EQ_0
6212
6213 Note FILTER P l2 = [] by given
6214 ==> LENGTH (FILTER P l2) = 0 by LENGTH
6215 k = LENGTH fs
6216 = LENGTH (FILTER P ls) by notation
6217 = LENGTH (FILTER P l1) + 1 by FILTER_APPEND_DISTRIB, ONE
6218 or LENGTH (FILTER P l1) = PRE k
6219 Thus x = EL (PRE k) fs by FILTER_EL_IMP
6220 = LAST fs by LAST_EL, fs <> []
6221*)
6222Theorem FILTER_LAST:
6223 !P ls l1 l2 x. ls = l1 ++ x::l2 /\ P x /\ FILTER P l2 = [] ==>
6224 x = LAST (FILTER P ls)
6225Proof
6226 rpt strip_tac >>
6227 qabbrev_tac `fs = FILTER P ls` >>
6228 qabbrev_tac `k = LENGTH fs` >>
6229 `MEM x ls` by metis_tac[MEM_APPEND, MEM] >>
6230 `MEM x fs` by fs[MEM_FILTER, Abbr`fs`] >>
6231 `fs <> [] /\ 0 < k` by metis_tac[NIL_NO_MEM, LENGTH_EQ_0, NOT_ZERO] >>
6232 `k = LENGTH (FILTER P l1) + 1` by fs[FILTER_APPEND_DISTRIB, Abbr`k`, Abbr`fs`] >>
6233 `LENGTH (FILTER P l1) = PRE k` by decide_tac >>
6234 metis_tac[FILTER_EL_IMP, LAST_EL]
6235QED
6236
6237(* Theorem: ALL_DISTINCT ls /\ ls = l1 ++ x::l2 /\ P x ==>
6238 (x = LAST (FILTER P ls) <=> FILTER P l2 = []) *)
6239(* Proof:
6240 Let fs = FILTER P ls,
6241 k = LENGTH fs,
6242 j = LENGTH (FILTER P l1).
6243 Note MEM x ls by MEM_APPEND, MEM
6244 and P x ==> fs <> [] by MEM_FILTER, NIL_NO_MEM
6245 so 0 < LENGTH fs = k by LENGTH_EQ_0
6246 and PRE k < k by arithmetic
6247
6248 k = LENGTH fs
6249 = LENGTH (FILTER P ls) by notation
6250 = j + 1 + LENGTH (FILTER P l2) by FILTER_APPEND_DISTRIB, ONE
6251 so j = PRE k <=> LENGTH (FILTER P l2) = 0 by arithmetic
6252
6253 Thus x = LAST fs
6254 = EL (PRE k) fs by LAST_EL
6255 <=> PRE k = j by FILTER_EL_IFF
6256 <=> LENGTH (FILTER P l2) = 0 by above
6257 <=> FILTER P l2 = [] by LENGTH_EQ_0
6258*)
6259Theorem FILTER_LAST_IFF:
6260 !P ls l1 l2 x. ALL_DISTINCT ls /\ ls = l1 ++ x::l2 /\ P x ==>
6261 (x = LAST (FILTER P ls) <=> FILTER P l2 = [])
6262Proof
6263 rpt strip_tac >>
6264 qabbrev_tac `fs = FILTER P ls` >>
6265 qabbrev_tac `k = LENGTH fs` >>
6266 qabbrev_tac `j = LENGTH (FILTER P l1)` >>
6267 `MEM x ls` by metis_tac[MEM_APPEND, MEM] >>
6268 `MEM x fs` by fs[MEM_FILTER, Abbr`fs`] >>
6269 `fs <> [] /\ 0 < k` by metis_tac[NIL_NO_MEM, LENGTH_EQ_0, NOT_ZERO] >>
6270 `k = j + 1 + LENGTH (FILTER P l2)` by fs[FILTER_APPEND_DISTRIB, Abbr`fs`, Abbr`k`, Abbr`j`] >>
6271 `PRE k < k /\ (j = PRE k <=> LENGTH (FILTER P l2) = 0)` by decide_tac >>
6272 metis_tac[FILTER_EL_IFF, LAST_EL, LENGTH_EQ_0]
6273QED
6274
6275(* Idea: for FILTER over a range, the range between successive filter elements is filtered. *)
6276
6277(* Theorem: let fs = FILTER P ls; j = LENGTH (FILTER P l1) in
6278 ls = l1 ++ x::l2 ++ y::l3 /\ P x /\ P y /\ FILTER P l2 = [] ==>
6279 x = EL j fs /\ y = EL (j + 1) fs *)
6280(* Proof:
6281 Let l4 = y::l3, then
6282 ls = l1 ++ x::l2 ++ l4
6283 = l1 ++ x::(l2 ++ l4) by APPEND_ASSOC_CONS
6284 Thus x = EL j fs by FILTER_EL_IMP
6285
6286 Now let l5 = l1 ++ x::l2,
6287 k = LENGTH (FILTER P l5).
6288 Then ls = l5 ++ y::l3 by APPEND_ASSOC
6289 and y = EL k fs by FILTER_EL_IMP
6290
6291 Note FILTER P l5
6292 = FILTER P l1 ++ FILTER P (x::l2) by FILTER_APPEND_DISTRIB
6293 = FILTER P l1 ++ x :: FILTER P l2 by FILTER
6294 = FILTER P l1 ++ [x] by FILTER P l2 = []
6295 and k = LENGTH (FILTER P l5)
6296 = LENGTH (FILTER P l1 ++ [x]) by above
6297 = j + 1 by LENGTH_APPEND
6298*)
6299Theorem FILTER_EL_NEXT:
6300 !P ls l1 l2 l3 x y. let fs = FILTER P ls; j = LENGTH (FILTER P l1) in
6301 ls = l1 ++ x::l2 ++ y::l3 /\ P x /\ P y /\ FILTER P l2 = [] ==>
6302 x = EL j fs /\ y = EL (j + 1) fs
6303Proof
6304 rw_tac std_ss[] >| [
6305 qabbrev_tac `l4 = y::l3` >>
6306 qabbrev_tac `ls = l1 ++ x::l2 ++ l4` >>
6307 `ls = l1 ++ x::(l2 ++ l4)` by simp[Abbr`ls`] >>
6308 metis_tac[FILTER_EL_IMP],
6309 qabbrev_tac `l5 = l1 ++ x::l2` >>
6310 qabbrev_tac `ls = l5 ++ y::l3` >>
6311 `FILTER P l5 = FILTER P l1 ++ [x]` by fs[FILTER_APPEND_DISTRIB, Abbr`l5`] >>
6312 `LENGTH (FILTER P l5) = j + 1` by fs[Abbr`j`] >>
6313 metis_tac[FILTER_EL_IMP]
6314 ]
6315QED
6316
6317(* Theorem: let fs = FILTER P ls; j = LENGTH (FILTER P l1) in
6318 ALL_DISTINCT ls /\ ls = l1 ++ x::l2 ++ y::l3 /\ P x /\ P y ==>
6319 (x = EL j fs /\ y = EL (j + 1) fs <=> FILTER P l2 = []) *)
6320(* Proof:
6321 Note fs = FILTER P ls
6322 = FILTER P (l1 ++ x::l2 ++ y::l3) by given
6323 = FILTER P l1 ++
6324 x :: FILTER P l2 ++
6325 y :: FILTER P l3 by FILTER_APPEND_DISTRIB, FILTER
6326 Thus LENGTH fs
6327 = j + SUC (LENGTH (FILTER P l2))
6328 + SUC (LENGTH (FILTER P l3)) by LENGTH_APPEND
6329 or j + 2 <= LENGTH fs by arithmetic
6330 or j < LENGTH fs, j + 1 < LENGTH fs by inequality
6331
6332 Let l4 = y::l3, then
6333 ls = l1 ++ x::l2 ++ l4
6334 = l1 ++ x::(l2 ++ l4) by APPEND_ASSOC_CONS
6335 Thus x = EL j fs by FILTER_EL_IFF, j < LENGTH fs
6336
6337 Now let l5 = l1 ++ x::l2,
6338 k = LENGTH (FILTER P l5).
6339 Then ls = l5 ++ y::l3 by APPEND_ASSOC
6340 and fs = FILTER P l5 ++
6341 y :: FILTER P l3 by FILTER_APPEND_DISTRIB, FILTER
6342 so LENGTH fs = k + SUC (LENGTH P l3) by LENGTH_APPEND
6343 Thus k < LENGTH fs
6344 and y = EL k fs by FILTER_EL_IFF
6345
6346 Also FILTER P l5 = FILTER P l1 ++
6347 x :: FILTER P l2 by FILTER_APPEND_DISTRIB, FILTER
6348 so k = j + SUC (LENGTH (FILTER P l2)) by LENGTH_APPEND
6349 Thus k = j + 1
6350 <=> LENGTH (FILTER P l2) = 0 by arithmetic
6351
6352 Note ALL_DISTINCT fs by FILTER_ALL_DISTINCT
6353 so EL k fs = EL (j + 1) fs
6354 <=> k = j + 1
6355 <=> LENGTH (FILTER P l2) = 0 by above
6356 <=> FILTER P l2 = [] by LENGTH_EQ_0
6357*)
6358Theorem FILTER_EL_NEXT_IFF:
6359 !P ls l1 l2 l3 x y. let fs = FILTER P ls; j = LENGTH (FILTER P l1) in
6360 ALL_DISTINCT ls /\ ls = l1 ++ x::l2 ++ y::l3 /\ P x /\ P y ==>
6361 (x = EL j fs /\ y = EL (j + 1) fs <=> FILTER P l2 = [])
6362Proof
6363 rw_tac std_ss[] >>
6364 qabbrev_tac `ls = l1 ++ x::l2 ++ y::l3` >>
6365 `j + 2 <= LENGTH fs` by
6366 (`fs = FILTER P l1 ++ x::FILTER P l2 ++ y::FILTER P l3` by simp[FILTER_APPEND_DISTRIB, Abbr`fs`, Abbr`ls`] >>
6367 `LENGTH fs = j + SUC (LENGTH (FILTER P l2)) + SUC (LENGTH (FILTER P l3))` by fs[Abbr`j`] >>
6368 decide_tac) >>
6369 `j < LENGTH fs` by decide_tac >>
6370 qabbrev_tac `l4 = y::l3` >>
6371 `ls = l1 ++ x::(l2 ++ l4)` by simp[Abbr`ls`] >>
6372 `x = EL j fs` by metis_tac[FILTER_EL_IFF] >>
6373 qabbrev_tac `l5 = l1 ++ x::l2` >>
6374 qabbrev_tac `k = LENGTH (FILTER P l5)` >>
6375 `ls = l5 ++ y::l3` by simp[Abbr`l5`, Abbr`ls`] >>
6376 `k < LENGTH fs /\ (k = j + 1 <=> FILTER P l2 = [])` by
6377 (`fs = FILTER P l5 ++ y::FILTER P l3` by
6378 rfs[FILTER_APPEND_DISTRIB, Abbr`fs`, Abbr`l4`, Abbr`l5`] >>
6379 `LENGTH fs = k + SUC (LENGTH (FILTER P l3))` by fs[Abbr`k`] >>
6380 `FILTER P l5 = FILTER P l1 ++ x :: FILTER P l2` by rfs[FILTER_APPEND_DISTRIB, Abbr`l5`] >>
6381 `k = j + SUC (LENGTH (FILTER P l2))` by fs[Abbr`k`, Abbr`j`] >>
6382 simp[]) >>
6383 `y = EL k fs` by metis_tac[FILTER_EL_IFF] >>
6384 `j + 1 < LENGTH fs` by decide_tac >>
6385 `ALL_DISTINCT fs` by simp[FILTER_ALL_DISTINCT, Abbr`fs`] >>
6386 metis_tac[ALL_DISTINCT_EL_IMP]
6387QED
6388
6389(* ------------------------------------------------------------------------- *)
6390(* Unit-List and Mono-List *)
6391(* ------------------------------------------------------------------------- *)
6392
6393(* Theorem: (LENGTH l = 1) ==> SING (set l) *)
6394(* Proof:
6395 Since ?x. l = [x] by LENGTH_EQ_1
6396 set l = {x} by LIST_TO_SET_DEF
6397 or SING (set l) by SING_DEF
6398*)
6399Theorem SING_LIST_TO_SET:
6400 !l. (LENGTH l = 1) ==> SING (set l)
6401Proof
6402 rw[LENGTH_EQ_1, SING_DEF] >>
6403 `set [x] = {x}` by rw[] >>
6404 metis_tac[]
6405QED
6406
6407(* Mono-list Theory: a mono-list is a list l with SING (set l) *)
6408
6409(* Theorem: Two mono-lists are equal if their lengths and sets are equal.
6410 SING (set l1) /\ SING (set l2) ==>
6411 ((l1 = l2) <=> (LENGTH l1 = LENGTH l2) /\ (set l1 = set l2)) *)
6412(* Proof:
6413 By induction on l1.
6414 Base case: !l2. SING (set []) /\ SING (set l2) ==>
6415 (([] = l2) <=> (LENGTH [] = LENGTH l2) /\ (set [] = set l2))
6416 True by SING (set []) is False, by SING_EMPTY.
6417 Step case: !l2. SING (set l1) /\ SING (set l2) ==>
6418 ((l1 = l2) <=> (LENGTH l1 = LENGTH l2) /\ (set l1 = set l2)) ==>
6419 !h l2. SING (set (h::l1)) /\ SING (set l2) ==>
6420 ((h::l1 = l2) <=> (LENGTH (h::l1) = LENGTH l2) /\ (set (h::l1) = set l2))
6421 This is to show:
6422 (1) 1 = LENGTH l2 /\ {h} = set l2 ==>
6423 ([h] = l2) <=> (SUC (LENGTH []) = LENGTH l2) /\ (h INSERT set [] = set l2)
6424 If-part, l2 = [h],
6425 LENGTH l2 = 1 = SUC 0 = SUC (LENGTH []) by LENGTH, ONE
6426 and set l2 = set [h] = {h} = h INSERT set [] by LIST_TO_SET
6427 Only-if part, LENGTH l2 = SUC 0 = 1 by ONE
6428 Then ?x. l2 = [x] by LENGTH_EQ_1
6429 so set l2 = {x} = {h} by LIST_TO_SET
6430 or x = h, hence l2 = [h] by EQUAL_SING
6431 (2) set l1 = {h} /\ SING (set l2) ==>
6432 (h::l1 = l2) <=> (SUC (LENGTH l1) = LENGTH l2) /\ (h INSERT set l1 = set l2)
6433 If part, h::l1 = l2.
6434 Then LENGTH l2 = LENGTH (h::l1) = SUC (LENGTH l1) by LENGTH
6435 and set l2 = set (h::l1) = h INSERT set l1 by LIST_TO_SET
6436 Only-if part, SUC (LENGTH l1) = LENGTH l2.
6437 Since 0 < SUC (LENGTH l1) by prim_recTheory.LESS_0
6438 0 < LENGTH l2 by LESS_TRANS
6439 so ?k t. l2 = k::t by LENGTH_NON_NIL, list_CASES
6440 Since LENGTH l2 = SUC (LENGTH t) by LENGTH
6441 LENGTH l1 = LENGTH t by prim_recTheory.INV_SUC_EQ
6442 and set l2 = k INSERT set t by LIST_TO_SET
6443 Given SING (set l2),
6444 either (set t = {}), or (set t = {k}) by SING_INSERT
6445 If set t = {},
6446 then t = [] by LIST_TO_SET_EQ_EMPTY
6447 and l1 = [] by LENGTH_NIL, LENGTH l1 = LENGTH t.
6448 so set l1 = {} by LIST_TO_SET_EQ_EMPTY
6449 contradicting set l1 = {h} by NOT_SING_EMPTY
6450 If set t = {k},
6451 then set l2 = set t by ABSORPTION, set l2 = k INSERT set {k}.
6452 or k = h by IN_SING
6453 so l1 = t by induction hypothesis
6454 giving l2 = h::l1
6455*)
6456Theorem MONOLIST_EQ:
6457 !l1 l2. SING (set l1) /\ SING (set l2) ==>
6458 ((l1 = l2) <=> (LENGTH l1 = LENGTH l2) /\ (set l1 = set l2))
6459Proof
6460 Induct >> rw[NOT_SING_EMPTY, SING_INSERT] >| [
6461 Cases_on `l2` >> rw[] >>
6462 full_simp_tac (srw_ss()) [SING_INSERT, EQUAL_SING] >>
6463 rw[LENGTH_NIL, NOT_SING_EMPTY, EQUAL_SING] >> metis_tac[],
6464 Cases_on `l2` >> rw[] >>
6465 full_simp_tac (srw_ss()) [SING_INSERT, LENGTH_NIL, NOT_SING_EMPTY,
6466 EQUAL_SING] >>
6467 metis_tac[]
6468 ]
6469QED
6470
6471(* Theorem: A non-mono-list has at least one element in tail that is distinct from its head.
6472 ~SING (set (h::t)) ==> ?h'. h' IN set t /\ h' <> h *)
6473(* Proof:
6474 By SING_INSERT, this is to show:
6475 t <> [] /\ set t <> {h} ==> ?h'. MEM h' t /\ h' <> h
6476 Now, t <> [] ==> set t <> {} by LIST_TO_SET_EQ_EMPTY
6477 so ?e. e IN set t by MEMBER_NOT_EMPTY
6478 hence MEM e t,
6479 and MEM x t <=/=> (x = h) by EXTENSION
6480 Therefore, e <> h, so take h' = e.
6481*)
6482Theorem NON_MONO_TAIL_PROPERTY:
6483 !l. ~SING (set (h::t)) ==> ?h'. h' IN set t /\ h' <> h
6484Proof
6485 rw[SING_INSERT] >>
6486 `set t <> {}` by metis_tac[LIST_TO_SET_EQ_EMPTY] >>
6487 `?e. e IN set t` by metis_tac[MEMBER_NOT_EMPTY] >>
6488 full_simp_tac (srw_ss())[EXTENSION] >>
6489 metis_tac[]
6490QED
6491
6492(* ------------------------------------------------------------------------- *)
6493(* GENLIST Theorems *)
6494(* ------------------------------------------------------------------------- *)
6495
6496(* Theorem: GENLIST (K e) (SUC n) = e :: GENLIST (K e) n *)
6497(* Proof:
6498 GENLIST (K e) (SUC n)
6499 = (K e) 0::GENLIST ((K e) o SUC) n by GENLIST_CONS
6500 = e :: GENLIST ((K e) o SUC) n by K_THM
6501 = e :: GENLIST (K e) n by K_o_THM
6502*)
6503Theorem GENLIST_K_CONS =
6504 SIMP_CONV (srw_ss()) [GENLIST_CONS]
6505 ``GENLIST (K e) (SUC n)`` |> GEN ``n:num`` |> GEN ``e``;
6506(* val GENLIST_K_CONS = |- !e n. GENLIST (K e) (SUC n) = e::GENLIST (K e) n: thm *)
6507
6508(* Theorem: GENLIST (K e) (n + m) = GENLIST (K e) m ++ GENLIST (K e) n *)
6509(* Proof:
6510 Note (\t. e) = K e by FUN_EQ_THM
6511 GENLIST (K e) (n + m)
6512 = GENLIST (K e) m ++ GENLIST (\t. (K e) (t + m)) n by GENLIST_APPEND
6513 = GENLIST (K e) m ++ GENLIST (\t. e) n by K_THM
6514 = GENLIST (K e) m ++ GENLIST (K e) n by above
6515*)
6516Theorem GENLIST_K_ADD:
6517 !e n m. GENLIST (K e) (n + m) = GENLIST (K e) m ++ GENLIST (K e) n
6518Proof
6519 rpt strip_tac >>
6520 `(\t. e) = K e` by rw[FUN_EQ_THM] >>
6521 rw[GENLIST_APPEND] >>
6522 metis_tac[]
6523QED
6524
6525(* Theorem: (!k. k < n ==> (f k = e)) ==> (GENLIST f n = GENLIST (K e) n) *)
6526(* Proof:
6527 By induction on n.
6528 Base: GENLIST f 0 = GENLIST (K e) 0
6529 GENLIST f 0
6530 = [] by GENLIST_0
6531 = GENLIST (K e) 0 by GENLIST_0
6532 Step: GENLIST f n = GENLIST (K e) n ==>
6533 GENLIST f (SUC n) = GENLIST (K e) (SUC n)
6534 GENLIST f (SUC n)
6535 = SNOC (f n) (GENLIST f n) by GENLIST
6536 = SNOC e (GENLIST f n) by applying f to n
6537 = SNOC e (GENLIST (K e) n) by induction hypothesis
6538 = GENLIST (K e) (SUC n) by GENLIST
6539*)
6540Theorem GENLIST_K_LESS:
6541 !f e n. (!k. k < n ==> (f k = e)) ==> (GENLIST f n = GENLIST (K e) n)
6542Proof
6543 rpt strip_tac >>
6544 Induct_on `n` >>
6545 rw[GENLIST]
6546QED
6547
6548(* Theorem: (!k. 0 < k /\ k <= n ==> (f k = e)) ==> (GENLIST (f o SUC) n = GENLIST (K e) n) *)
6549(* Proof:
6550 Base: GENLIST (f o SUC) 0 = GENLIST (K e) 0
6551 GENLIST (f o SUC) 0
6552 = [] by GENLIST_0
6553 = GENLIST (K e) 0 by GENLIST_0
6554 Step: GENLIST (f o SUC) n = GENLIST (K e) n ==>
6555 GENLIST (f o SUC) (SUC n) = GENLIST (K e) (SUC n)
6556 GENLIST (f o SUC) (SUC n)
6557 = SNOC (f n) (GENLIST (f o SUC) n) by GENLIST
6558 = SNOC e (GENLIST (f o SUC) n) by applying f to n
6559 = SNOC e GENLIST (K e) n by induction hypothesis
6560 = GENLIST (K e) (SUC n) by GENLIST
6561*)
6562Theorem GENLIST_K_RANGE:
6563 !f e n. (!k. 0 < k /\ k <= n ==> (f k = e)) ==> (GENLIST (f o SUC) n = GENLIST (K e) n)
6564Proof
6565 rpt strip_tac >>
6566 Induct_on `n` >>
6567 rw[GENLIST]
6568QED
6569
6570(* Theorem: GENLIST (K c) a ++ GENLIST (K c) b = GENLIST (K c) (a + b) *)
6571(* Proof:
6572 Note (\t. c) = K c by FUN_EQ_THM
6573 GENLIST (K c) (a + b)
6574 = GENLIST (K c) (b + a) by ADD_COMM
6575 = GENLIST (K c) a ++ GENLIST (\t. (K c) (t + a)) b by GENLIST_APPEND
6576 = GENLIST (K c) a ++ GENLIST (\t. c) b by applying constant function
6577 = GENLIST (K c) a ++ GENLIST (K c) b by GENLIST_FUN_EQ
6578*)
6579Theorem GENLIST_K_APPEND:
6580 !a b c. GENLIST (K c) a ++ GENLIST (K c) b = GENLIST (K c) (a + b)
6581Proof
6582 rpt strip_tac >>
6583 `(\t. c) = K c` by rw[FUN_EQ_THM] >>
6584 `GENLIST (K c) (a + b) = GENLIST (K c) (b + a)` by rw[] >>
6585 `_ = GENLIST (K c) a ++ GENLIST (\t. (K c) (t + a)) b` by rw[GENLIST_APPEND] >>
6586 rw[GENLIST_FUN_EQ]
6587QED
6588
6589(* Theorem: GENLIST (K c) n ++ [c] = [c] ++ GENLIST (K c) n *)
6590(* Proof:
6591 GENLIST (K c) n ++ [c]
6592 = GENLIST (K c) n ++ GENLIST (K c) 1 by GENLIST_1
6593 = GENLIST (K c) (n + 1) by GENLIST_K_APPEND
6594 = GENLIST (K c) (1 + n) by ADD_COMM
6595 = GENLIST (K c) 1 ++ GENLIST (K c) n by GENLIST_K_APPEND
6596 = [c] ++ GENLIST (K c) n by GENLIST_1
6597*)
6598Theorem GENLIST_K_APPEND_K:
6599 !c n. GENLIST (K c) n ++ [c] = [c] ++ GENLIST (K c) n
6600Proof
6601 metis_tac[GENLIST_K_APPEND, GENLIST_1, ADD_COMM, combinTheory.K_THM]
6602QED
6603
6604(* Theorem: 0 < n ==> (MEM x (GENLIST (K c) n) <=> (x = c)) *)
6605(* Proof:
6606 MEM x (GENLIST (K c) n
6607 <=> ?m. m < n /\ (x = (K c) m) by MEM_GENLIST
6608 <=> ?m. m < n /\ (x = c) by K_THM
6609 <=> (x = c) by taking m = 0, 0 < n
6610*)
6611Theorem GENLIST_K_MEM:
6612 !x c n. 0 < n ==> (MEM x (GENLIST (K c) n) <=> (x = c))
6613Proof
6614 metis_tac[MEM_GENLIST, combinTheory.K_THM]
6615QED
6616
6617(* Theorem: 0 < n ==> (set (GENLIST (K c) n) = {c}) *)
6618(* Proof:
6619 By induction on n.
6620 Base: 0 < 0 ==> (set (GENLIST (K c) 0) = {c})
6621 Since 0 < 0 = F, hence true.
6622 Step: 0 < n ==> (set (GENLIST (K c) n) = {c}) ==>
6623 0 < SUC n ==> (set (GENLIST (K c) (SUC n)) = {c})
6624 If n = 0,
6625 set (GENLIST (K c) (SUC 0)
6626 = set (GENLIST (K c) 1 by ONE
6627 = set [(K c) 0] by GENLIST_1
6628 = set [c] by K_THM
6629 = {c} by LIST_TO_SET
6630 If n <> 0, 0 < n.
6631 set (GENLIST (K c) (SUC n)
6632 = set (SNOC ((K c) n) (GENLIST (K c) n)) by GENLIST
6633 = set (SNOC c (GENLIST (K c) n) by K_THM
6634 = c INSERT set (GENLIST (K c) n) by LIST_TO_SET_SNOC
6635 = c INSERT {c} by induction hypothesis
6636 = {c} by IN_INSERT
6637 *)
6638Theorem GENLIST_K_SET:
6639 !c n. 0 < n ==> (set (GENLIST (K c) n) = {c})
6640Proof
6641 rpt strip_tac >>
6642 Induct_on `n` >-
6643 simp[] >>
6644 (Cases_on `n = 0` >> simp[]) >>
6645 `0 < n` by decide_tac >>
6646 simp[GENLIST, LIST_TO_SET_SNOC]
6647QED
6648
6649(* Theorem: ls <> [] ==> (SING (set ls) <=> ?c. ls = GENLIST (K c) (LENGTH ls)) *)
6650(* Proof:
6651 By induction on ls.
6652 Base: [] <> [] ==> (SING (set []) <=> ?c. [] = GENLIST (K c) (LENGTH []))
6653 Since [] <> [] = F, hence true.
6654 Step: ls <> [] ==> (SING (set ls) <=> ?c. ls = GENLIST (K c) (LENGTH ls)) ==>
6655 !h. h::ls <> [] ==>
6656 (SING (set (h::ls)) <=> ?c. h::ls = GENLIST (K c) (LENGTH (h::ls)))
6657 Note h::ls <> [] = T.
6658 If part: SING (set (h::ls)) ==> ?c. h::ls = GENLIST (K c) (LENGTH (h::ls))
6659 Note SING (set (h::ls)) means
6660 set ls = {h} by LIST_TO_SET_DEF, IN_SING
6661 Let n = LENGTH ls, 0 < n by LENGTH_NON_NIL
6662 Note ls <> [] by LIST_TO_SET, IN_SING, MEMBER_NOT_EMPTY
6663 and SING (set ls) by SING_DEF
6664 ==> ?c. ls = GENLIST (K c) n by induction hypothesis
6665 so set ls = {c} by GENLIST_K_SET, 0 < n
6666 ==> h = c by IN_SING
6667 GENLIST (K c) (LENGTH (h::ls)
6668 = (K c) h :: ls by GENLIST_K_CONS
6669 = c :: ls by K_THM
6670 = h::ls by h = c
6671 Only-if part: ?c. h::ls = GENLIST (K c) (LENGTH (h::ls)) ==> SING (set (h::ls))
6672 set (h::ls)
6673 = set (GENLIST (K c) (LENGTH (h::ls))) by given
6674 = set ((K c) h :: GENLIST (K c) (LENGTH ls)) by GENLIST_K_CONS
6675 = set (c :: GENLIST (K c) (LENGTH ls)) by K_THM
6676 = c INSERT set (GENLIST (K c) (LENGTH ls)) by LIST_TO_SET
6677 = c INSERT {c} by GENLIST_K_SET
6678 = {c} by IN_INSERT
6679 Hence SING (set (h::ls)) by SING_DEF
6680*)
6681Theorem LIST_TO_SET_SING_IFF:
6682 !ls. ls <> [] ==> (SING (set ls) <=> ?c. ls = GENLIST (K c) (LENGTH ls))
6683Proof
6684 Induct >-
6685 simp[] >>
6686 (rw[EQ_IMP_THM] >> simp[]) >| [
6687 qexists_tac `h` >>
6688 qabbrev_tac `n = LENGTH ls` >>
6689 `ls <> []` by metis_tac[LIST_TO_SET, IN_SING, MEMBER_NOT_EMPTY] >>
6690 `SING (set ls)` by fs[SING_DEF] >>
6691 fs[] >>
6692 `0 < n` by metis_tac[LENGTH_NON_NIL] >>
6693 `h = c` by metis_tac[GENLIST_K_SET, IN_SING] >>
6694 simp[GENLIST_K_CONS],
6695 spose_not_then strip_assume_tac >>
6696 fs[GENLIST_K_CONS] >>
6697 `0 < LENGTH ls` by metis_tac[LENGTH_NON_NIL] >>
6698 metis_tac[GENLIST_K_SET]
6699 ]
6700QED
6701
6702(* Theorem: ALL_DISTINCT l /\ (set l = {x}) <=> (l = [x]) *)
6703(* Proof:
6704 If part: ALL_DISTINCT l /\ set l = {x} ==> l = [x]
6705 Note set l = {x}
6706 ==> l <> [] /\ EVERY ($= x) l by LIST_TO_SET_EQ_SING
6707 Let P = (S= x).
6708 Note l <> [] ==> ?h t. l = h::t by list_CASES
6709 so h = x /\ EVERY P t by EVERY_DEF
6710 and ~(MEM h t) /\ ALL_DISTINCT t by ALL_DISTINCT
6711 By contradiction, suppose l <> [x].
6712 Then t <> [] ==> ?u v. t = u::v by list_CASES
6713 and MEM u t by MEM
6714 but u = h by EVERY_DEF
6715 ==> MEM h t, which contradicts ~(MEM h t).
6716
6717 Only-if part: l = [x] ==> ALL_DISTINCT l /\ set l = {x}
6718 Note ALL_DISTINCT [x] = T by ALL_DISTINCT_SING
6719 and set [x] = {x} by MONO_LIST_TO_SET
6720*)
6721Theorem DISTINCT_LIST_TO_SET_EQ_SING:
6722 !l x. ALL_DISTINCT l /\ (set l = {x}) <=> (l = [x])
6723Proof
6724 rw[EQ_IMP_THM] >>
6725 qabbrev_tac `P = ($= x)` >>
6726 `!y. P y ==> (y = x)` by rw[Abbr`P`] >>
6727 `l <> [] /\ EVERY P l` by metis_tac[LIST_TO_SET_EQ_SING, Abbr`P`] >>
6728 `?h t. l = h::t` by metis_tac[list_CASES] >>
6729 `(h = x) /\ (EVERY P t)` by metis_tac[EVERY_DEF] >>
6730 `~(MEM h t) /\ ALL_DISTINCT t` by metis_tac[ALL_DISTINCT] >>
6731 spose_not_then strip_assume_tac >>
6732 `t <> []` by rw[] >>
6733 `?u v. t = u::v` by metis_tac[list_CASES] >>
6734 `MEM u t` by rw[] >>
6735 metis_tac[EVERY_DEF]
6736QED
6737
6738(* ------------------------------------------------------------------------- *)
6739(* Maximum of a List *)
6740(* ------------------------------------------------------------------------- *)
6741
6742(* Define MAX of a list *)
6743Definition MAX_LIST_def:
6744 (MAX_LIST [] = 0) /\
6745 (MAX_LIST (h::t) = MAX h (MAX_LIST t))
6746End
6747
6748(* export simple recursive definition *)
6749(* val _ = export_rewrites["MAX_LIST_def"]; *)
6750
6751(* Theorem: MAX_LIST [] = 0 *)
6752(* Proof: by MAX_LIST_def *)
6753Theorem MAX_LIST_NIL[simp] = MAX_LIST_def |> CONJUNCT1;
6754(* val MAX_LIST_NIL = |- MAX_LIST [] = 0: thm *)
6755
6756(* Theorem: MAX_LIST (h::t) = MAX h (MAX_LIST t) *)
6757(* Proof: by MAX_LIST_def *)
6758Theorem MAX_LIST_CONS[simp] = MAX_LIST_def |> CONJUNCT2;
6759(* val MAX_LIST_CONS = |- !h t. MAX_LIST (h::t) = MAX h (MAX_LIST t): thm *)
6760
6761(* Theorem: MAX_LIST [x] = x *)
6762(* Proof:
6763 MAX_LIST [x]
6764 = MAX x (MAX_LIST []) by MAX_LIST_CONS
6765 = MAX x 0 by MAX_LIST_NIL
6766 = x by MAX_0
6767*)
6768Theorem MAX_LIST_SING:
6769 !x. MAX_LIST [x] = x
6770Proof
6771 rw[]
6772QED
6773
6774(* Theorem: (MAX_LIST l = 0) <=> EVERY (\x. x = 0) l *)
6775(* Proof:
6776 By induction on l.
6777 Base: (MAX_LIST [] = 0) <=> EVERY (\x. x = 0) []
6778 LHS: MAX_LIST [] = 0, true by MAX_LIST_NIL
6779 RHS: EVERY (\x. x = 0) [], true by EVERY_DEF
6780 Step: (MAX_LIST l = 0) <=> EVERY (\x. x = 0) l ==>
6781 !h. (MAX_LIST (h::l) = 0) <=> EVERY (\x. x = 0) (h::l)
6782 MAX_LIST (h::l) = 0
6783 <=> MAX h (MAX_LIST l) = 0 by MAX_LIST_CONS
6784 <=> (h = 0) /\ (MAX_LIST l = 0) by MAX_EQ_0
6785 <=> (h = 0) /\ EVERY (\x. x = 0) l by induction hypothesis
6786 <=> EVERY (\x. x = 0) (h::l) by EVERY_DEF
6787*)
6788Theorem MAX_LIST_EQ_0:
6789 !l. (MAX_LIST l = 0) <=> EVERY (\x. x = 0) l
6790Proof
6791 Induct >>
6792 rw[MAX_EQ_0]
6793QED
6794
6795(* Theorem: l <> [] ==> MEM (MAX_LIST l) l *)
6796(* Proof:
6797 By induction on l.
6798 Base: [] <> [] ==> MEM (MAX_LIST []) []
6799 Trivially true by [] <> [] = F.
6800 Step: l <> [] ==> MEM (MAX_LIST l) l ==>
6801 !h. h::l <> [] ==> MEM (MAX_LIST (h::l)) (h::l)
6802 If l = [],
6803 Note MAX_LIST [h] = h by MAX_LIST_SING
6804 and MEM h [h] by MEM
6805 Hence true.
6806 If l <> [],
6807 Let x = MAX_LIST (h::l)
6808 = MAX h (MAX_LIST l) by MAX_LIST_CONS
6809 ==> x = h \/ x = MAX_LIST l by MAX_CASES
6810 If x = h, MEM x (h::l) by MEM
6811 If x = MAX_LIST l, MEM x l by induction hypothesis
6812*)
6813Theorem MAX_LIST_MEM:
6814 !l. l <> [] ==> MEM (MAX_LIST l) l
6815Proof
6816 Induct >-
6817 rw[] >>
6818 rpt strip_tac >>
6819 Cases_on `l = []` >-
6820 rw[] >>
6821 rw[] >>
6822 metis_tac[MAX_CASES]
6823QED
6824
6825(* Theorem: MEM x l ==> x <= MAX_LIST l *)
6826(* Proof:
6827 By induction on l.
6828 Base: !x. MEM x [] ==> x <= MAX_LIST []
6829 Trivially true since MEM x [] = F by MEM
6830 Step: !x. MEM x l ==> x <= MAX_LIST l ==> !h x. MEM x (h::l) ==> x <= MAX_LIST (h::l)
6831 Note MEM x (h::l) means (x = h) \/ MEM x l by MEM
6832 and MAX_LIST (h::l) = MAX h (MAX_LIST l) by MAX_LIST_CONS
6833 If x = h, x <= MAX h (MAX_LIST l) by MAX_LE
6834 If MEM x l, x <= MAX_LIST l by induction hypothesis
6835 or x <= MAX h (MAX_LIST l) by MAX_LE, LESS_EQ_TRANS
6836*)
6837Theorem MAX_LIST_PROPERTY:
6838 !l x. MEM x l ==> x <= MAX_LIST l
6839Proof
6840 Induct >-
6841 rw[] >>
6842 rw[MAX_LIST_CONS] >-
6843 decide_tac >>
6844 rw[]
6845QED
6846
6847(* Theorem: l <> [] ==> !x. MEM x l /\ (!y. MEM y l ==> y <= x) ==> (x = MAX_LIST l) *)
6848(* Proof:
6849 Let m = MAX_LIST l.
6850 Since MEM x l /\ x <= m by MAX_LIST_PROPERTY
6851 and MEM m l ==> m <= x by MAX_LIST_MEM, implication, l <> []
6852 Hence x = m by EQ_LESS_EQ
6853*)
6854Theorem MAX_LIST_TEST:
6855 !l. l <> [] ==> !x. MEM x l /\ (!y. MEM y l ==> y <= x) ==> (x = MAX_LIST l)
6856Proof
6857 metis_tac[MAX_LIST_MEM, MAX_LIST_PROPERTY, EQ_LESS_EQ]
6858QED
6859
6860(* Theorem: MAX_LIST t <= MAX_LIST (h::t) *)
6861(* Proof:
6862 Note MAX_LIST (h::t) = MAX h (MAX_LIST t) by MAX_LIST_def
6863 and MAX_LIST t <= MAX h (MAX_LIST t) by MAX_IS_MAX
6864 Thus MAX_LIST t <= MAX_LIST (h::t)
6865*)
6866Theorem MAX_LIST_LE:
6867 !h t. MAX_LIST t <= MAX_LIST (h::t)
6868Proof
6869 rw_tac std_ss[MAX_LIST_def]
6870QED
6871
6872Theorem MAX_LIST_APPEND :
6873 !l1 l2. MAX_LIST (l1 ++ l2) = MAX (MAX_LIST l1) (MAX_LIST l2)
6874Proof
6875 Induct_on ‘l1’ >> rw [MAX_ASSOC]
6876QED
6877
6878Theorem MAX_LIST_APPEND_COMM :
6879 !l1 l2. MAX_LIST (l1 ++ l2) = MAX_LIST (l2 ++ l1)
6880Proof
6881 rw [MAX_LIST_APPEND, Once MAX_COMM]
6882QED
6883
6884Theorem MAX_LIST_LE_PREFIX :
6885 !l1 l2. l1 <<= l2 ==> MAX_LIST l1 <= MAX_LIST l2
6886Proof
6887 rw [IS_PREFIX_APPEND]
6888 >> ONCE_REWRITE_TAC [MAX_LIST_APPEND_COMM]
6889 >> qid_spec_tac ‘l’
6890 >> Induct_on ‘l’ >- simp []
6891 >> Q.X_GEN_TAC ‘h’
6892 >> Q_TAC (TRANS_TAC LESS_EQ_TRANS) ‘MAX_LIST (l ++ l1)’
6893 >> simp [APPEND, MAX_LIST_LE]
6894QED
6895
6896(* Theorem: (!x. f x <= g x) ==> !ls. MAX_LIST (MAP f ls) <= MAX_LIST (MAP g ls) *)
6897(* Proof:
6898 By induction on ls.
6899 Base: MAX_LIST (MAP f []) <= MAX_LIST (MAP g [])
6900 LHS = MAX_LIST (MAP f []) = MAX_LIST [] by MAP
6901 RHS = MAX_LIST (MAP g []) = MAX_LIST [] by MAP
6902 Hence true.
6903 Step: MAX_LIST (MAP f ls) <= MAX_LIST (MAP g ls) ==>
6904 !h. MAX_LIST (MAP f (h::ls)) <= MAX_LIST (MAP g (h::ls))
6905 MAX_LIST (MAP f (h::ls))
6906 = MAX_LIST (f h::MAP f ls) by MAP
6907 = MAX (f h) (MAX_LIST (MAP f ls)) by MAX_LIST_def
6908 <= MAX (f h) (MAX_LIST (MAP g ls)) by induction hypothesis
6909 <= MAX (g h) (MAX_LIST (MAP g ls)) by properties of f, g
6910 = MAX_LIST (g h::MAP g ls) by MAX_LIST_def
6911 = MAX_LIST (MAP g (h::ls)) by MAP
6912*)
6913Theorem MAX_LIST_MAP_LE:
6914 !f g. (!x. f x <= g x) ==> !ls. MAX_LIST (MAP f ls) <= MAX_LIST (MAP g ls)
6915Proof
6916 rpt strip_tac >>
6917 Induct_on `ls` >-
6918 rw[] >>
6919 rw[]
6920QED
6921
6922(* ------------------------------------------------------------------------- *)
6923(* Minimum of a List *)
6924(* ------------------------------------------------------------------------- *)
6925
6926(* Define MIN of a list *)
6927Definition MIN_LIST_def:
6928 MIN_LIST (h::t) = if t = [] then h else MIN h (MIN_LIST t)
6929End
6930
6931(* Theorem: MIN_LIST [x] = x *)
6932(* Proof: by MIN_LIST_def *)
6933Theorem MIN_LIST_SING[simp]:
6934 !x. MIN_LIST [x] = x
6935Proof
6936 rw[MIN_LIST_def]
6937QED
6938
6939(* Theorem: t <> [] ==> (MIN_LIST (h::t) = MIN h (MIN_LIST t)) *)
6940(* Proof: by MIN_LIST_def *)
6941Theorem MIN_LIST_CONS[simp]:
6942 !h t. t <> [] ==> (MIN_LIST (h::t) = MIN h (MIN_LIST t))
6943Proof
6944 rw[MIN_LIST_def]
6945QED
6946
6947(* Theorem: l <> [] ==> MEM (MIN_LIST l) l *)
6948(* Proof:
6949 By induction on l.
6950 Base: [] <> [] ==> MEM (MIN_LIST []) []
6951 Trivially true by [] <> [] = F.
6952 Step: l <> [] ==> MEM (MIN_LIST l) l ==>
6953 !h. h::l <> [] ==> MEM (MIN_LIST (h::l)) (h::l)
6954 If l = [],
6955 Note MIN_LIST [h] = h by MIN_LIST_SING
6956 and MEM h [h] by MEM
6957 Hence true.
6958 If l <> [],
6959 Let x = MIN_LIST (h::l)
6960 = MIN h (MIN_LIST l) by MIN_LIST_CONS
6961 ==> x = h \/ x = MIN_LIST l by MIN_CASES
6962 If x = h, MEM x (h::l) by MEM
6963 If x = MIN_LIST l, MEM x l by induction hypothesis
6964*)
6965Theorem MIN_LIST_MEM:
6966 !l. l <> [] ==> MEM (MIN_LIST l) l
6967Proof
6968 Induct >-
6969 rw[] >>
6970 rpt strip_tac >>
6971 Cases_on `l = []` >-
6972 rw[] >>
6973 rw[] >>
6974 metis_tac[MIN_CASES]
6975QED
6976
6977(* Theorem: l <> [] ==> !x. MEM x l ==> (MIN_LIST l) <= x *)
6978(* Proof:
6979 By induction on l.
6980 Base: [] <> [] ==> ...
6981 Trivially true since [] <> [] = F
6982 Step: l <> [] ==> !x. MEM x l ==> MIN_LIST l <= x ==>
6983 !h. h::l <> [] ==> !x. MEM x (h::l) ==> MIN_LIST (h::l) <= x
6984 Note MEM x (h::l) means (x = h) \/ MEM x l by MEM
6985 If l = [],
6986 MEM x [h] means x = h by MEM
6987 and MIN_LIST [h] = h, hence true by MIN_LIST_SING
6988 If l <> [],
6989 MIN_LIST (h::l) = MIN h (MIN_LIST l) by MIN_LIST_CONS
6990 If x = h, MIN h (MIN_LIST l) <= x by MIN_LE
6991 If MEM x l, MIN_LIST l <= x by induction hypothesis
6992 or MIN h (MIN_LIST l) <= x by MIN_LE, LESS_EQ_TRANS
6993*)
6994Theorem MIN_LIST_PROPERTY:
6995 !l. l <> [] ==> !x. MEM x l ==> (MIN_LIST l) <= x
6996Proof
6997 Induct >-
6998 rw[] >>
6999 rpt strip_tac >>
7000 Cases_on `l = []` >-
7001 fs[MIN_LIST_SING, MEM] >>
7002 fs[MIN_LIST_CONS, MEM]
7003QED
7004
7005(* Theorem: l <> [] ==> !x. MEM x l /\ (!y. MEM y l ==> x <= y) ==> (x = MIN_LIST l) *)
7006(* Proof:
7007 Let m = MIN_LIST l.
7008 Since MEM x l /\ m <= x by MIN_LIST_PROPERTY
7009 and MEM m l ==> x <= m by MIN_LIST_MEM, implication, l <> []
7010 Hence x = m by EQ_LESS_EQ
7011*)
7012Theorem MIN_LIST_TEST:
7013 !l. l <> [] ==> !x. MEM x l /\ (!y. MEM y l ==> x <= y) ==> (x = MIN_LIST l)
7014Proof
7015 metis_tac[MIN_LIST_MEM, MIN_LIST_PROPERTY, EQ_LESS_EQ]
7016QED
7017
7018(* Theorem: l <> [] ==> MIN_LIST l <= MAX_LIST l *)
7019(* Proof:
7020 Since MEM (MIN_LIST l) l by MIN_LIST_MEM
7021 so MIN_LIST l <= MAX_LIST l by MAX_LIST_PROPERTY
7022*)
7023Theorem MIN_LIST_LE_MAX_LIST:
7024 !l. l <> [] ==> MIN_LIST l <= MAX_LIST l
7025Proof
7026 rw[MIN_LIST_MEM, MAX_LIST_PROPERTY]
7027QED
7028
7029(* Theorem: t <> [] ==> MIN_LIST (h::t) <= MIN_LIST t *)
7030(* Proof:
7031 Note MIN_LIST (h::t) = MIN h (MIN_LIST t) by MIN_LIST_def, t <> []
7032 and MIN h (MIN_LIST t) <= MIN_LIST t by MIN_IS_MIN
7033 Thus MIN_LIST (h::t) <= MIN_LIST t
7034*)
7035Theorem MIN_LIST_LE:
7036 !h t. t <> [] ==> MIN_LIST (h::t) <= MIN_LIST t
7037Proof
7038 rw_tac std_ss[MIN_LIST_def]
7039QED
7040
7041(* Theorem: a <= b /\ c <= d ==> MIN a c <= MIN b d *)
7042(* Proof: by MIN_DEF *)
7043Theorem MIN_LE_PAIR[local]:
7044 !a b c d. a <= b /\ c <= d ==> MIN a c <= MIN b d
7045Proof
7046 rw[]
7047QED
7048
7049(* Theorem: (!x. f x <= g x) ==> !ls. MIN_LIST (MAP f ls) <= MIN_LIST (MAP g ls) *)
7050(* Proof:
7051 By induction on ls.
7052 Base: MIN_LIST (MAP f []) <= MIN_LIST (MAP g [])
7053 LHS = MIN_LIST (MAP f []) = MIN_LIST [] by MAP
7054 RHS = MIN_LIST (MAP g []) = MIN_LIST [] by MAP
7055 Hence true.
7056 Step: MIN_LIST (MAP f ls) <= MIN_LIST (MAP g ls) ==>
7057 !h. MIN_LIST (MAP f (h::ls)) <= MIN_LIST (MAP g (h::ls))
7058 If ls = [],
7059 MIN_LIST (MAP f [h])
7060 = MIN_LIST [f h] by MAP
7061 = f h by MIN_LIST_def
7062 <= g h by properties of f, g
7063 = MIN_LIST [g h] by MIN_LIST_def
7064 = MIN_LIST (MAP g [h]) by MAP
7065 Otherwise ls <> [],
7066 MIN_LIST (MAP f (h::ls))
7067 = MIN_LIST (f h::MAP f ls) by MAP
7068 = MIN (f h) (MIN_LIST (MAP f ls)) by MIN_LIST_def
7069 <= MIN (g h) (MIN_LIST (MAP g ls)) by MIN_LE_PAIR, induction hypothesis
7070 = MIN_LIST (g h::MAP g ls) by MIN_LIST_def
7071 = MIN_LIST (MAP g (h::ls)) by MAP
7072*)
7073Theorem MIN_LIST_MAP_LE:
7074 !f g. (!x. f x <= g x) ==> !ls. MIN_LIST (MAP f ls) <= MIN_LIST (MAP g ls)
7075Proof
7076 rpt strip_tac >>
7077 Induct_on `ls` >-
7078 rw[] >>
7079 rpt strip_tac >>
7080 Cases_on `ls = []` >-
7081 rw[MIN_LIST_def] >>
7082 rw[MIN_LIST_def, MIN_LE_PAIR]
7083QED
7084
7085(* ------------------------------------------------------------------------- *)
7086(* Increasing and decreasing list bounds *)
7087(* ------------------------------------------------------------------------- *)
7088
7089(* Overload increasing list and decreasing list *)
7090Overload MONO_INC =
7091 ``\ls:num list. !m n. m <= n /\ n < LENGTH ls ==> EL m ls <= EL n ls``
7092Overload MONO_DEC =
7093 ``\ls:num list. !m n. m <= n /\ n < LENGTH ls ==> EL n ls <= EL m ls``
7094
7095(* Theorem: MONO_INC []*)
7096(* Proof: no member to falsify. *)
7097Theorem MONO_INC_NIL:
7098 MONO_INC []
7099Proof
7100 simp[]
7101QED
7102
7103(* Theorem: MONO_INC (h::t) ==> MONO_INC t *)
7104(* Proof:
7105 This is to show: m <= n /\ n < LENGTH t ==> EL m t <= EL n t
7106 Note m <= n <=> SUC m <= SUC n by arithmetic
7107 and n < LENGTH t <=> SUC n < LENGTH (h::t) by LENGTH
7108 Thus EL (SUC m) (h::t) <= EL (SUC n) (h::t) by MONO_INC (h::t)
7109 or EL m t <= EL n t by EL
7110*)
7111Theorem MONO_INC_CONS:
7112 !h t. MONO_INC (h::t) ==> MONO_INC t
7113Proof
7114 rw[] >>
7115 first_x_assum (qspecl_then [`SUC m`, `SUC n`] strip_assume_tac) >>
7116 rfs[]
7117QED
7118
7119(* Theorem: MONO_INC (h::t) /\ MEM x t ==> h <= x *)
7120(* Proof:
7121 Note MEM x t
7122 ==> ?n. n < LENGTH t /\ x = EL n t by MEM_EL
7123 or SUC n < SUC (LENGTH t) by inequality
7124 Now 0 < SUC n, or 0 <= SUC n,
7125 and SUC n < SUC (LENGTH t) = LENGTH (h::t) by LENGTH
7126 so EL 0 (h::t) <= EL (SUC n) (h::t) by MONO_INC (h::t)
7127 or h <= EL n t = x by EL
7128*)
7129Theorem MONO_INC_HD:
7130 !h t x. MONO_INC (h::t) /\ MEM x t ==> h <= x
7131Proof
7132 rpt strip_tac >>
7133 fs[MEM_EL] >>
7134 last_x_assum (qspecl_then [`0`,`SUC n`] strip_assume_tac) >>
7135 rfs[]
7136QED
7137
7138(* Theorem: MONO_DEC []*)
7139(* Proof: no member to falsify. *)
7140Theorem MONO_DEC_NIL:
7141 MONO_DEC []
7142Proof
7143 simp[]
7144QED
7145
7146(* Theorem: MONO_DEC (h::t) ==> MONO_DEC t *)
7147(* Proof:
7148 This is to show: m <= n /\ n < LENGTH t ==> EL n t <= EL m t
7149 Note m <= n <=> SUC m <= SUC n by arithmetic
7150 and n < LENGTH t <=> SUC n < LENGTH (h::t) by LENGTH
7151 Thus EL (SUC n) (h::t) <= EL (SUC m) (h::t) by MONO_DEC (h::t)
7152 or EL n t <= EL m t by EL
7153*)
7154Theorem MONO_DEC_CONS:
7155 !h t. MONO_DEC (h::t) ==> MONO_DEC t
7156Proof
7157 rw[] >>
7158 first_x_assum (qspecl_then [`SUC m`, `SUC n`] strip_assume_tac) >>
7159 rfs[]
7160QED
7161
7162(* Theorem: MONO_DEC (h::t) /\ MEM x t ==> x <= h *)
7163(* Proof:
7164 Note MEM x t
7165 ==> ?n. n < LENGTH t /\ x = EL n t by MEM_EL
7166 or SUC n < SUC (LENGTH t) by inequality
7167 Now 0 < SUC n, or 0 <= SUC n,
7168 and SUC n < SUC (LENGTH t) = LENGTH (h::t) by LENGTH
7169 so EL (SUC n) (h::t) <= EL 0 (h::t) by MONO_DEC (h::t)
7170 or x = EL n t <= h by EL
7171*)
7172Theorem MONO_DEC_HD:
7173 !h t x. MONO_DEC (h::t) /\ MEM x t ==> x <= h
7174Proof
7175 rpt strip_tac >>
7176 fs[MEM_EL] >>
7177 last_x_assum (qspecl_then [`0`,`SUC n`] strip_assume_tac) >>
7178 rfs[]
7179QED
7180
7181(* Theorem: ls <> [] /\ (!m n. m <= n ==> EL m ls <= EL n ls) ==> (MAX_LIST ls = LAST ls) *)
7182(* Proof:
7183 By induction on ls.
7184 Base: [] <> [] /\ MONO_INC [] ==> MAX_LIST [] = LAST []
7185 Note [] <> [] = F, hence true.
7186 Step: ls <> [] /\ MONO_INC ls ==> MAX_LIST ls = LAST ls ==>
7187 !h. h::ls <> [] /\ MONO_INC (h::ls) ==> MAX_LIST (h::ls) = LAST (h::ls)
7188 If ls = [],
7189 LHS = MAX_LIST [h] = h by MAX_LIST_def
7190 RHS = LAST [h] = h = LHS by LAST_DEF
7191 If ls <> [],
7192 Note h <= LAST ls by LAST_EL_CONS, increasing property
7193 and MONO_INC ls by EL, m <= n ==> SUC m <= SUC n
7194 MAX_LIST (h::ls)
7195 = MAX h (MAX_LIST ls) by MAX_LIST_def
7196 = MAX h (LAST ls) by induction hypothesis
7197 = LAST ls by MAX_DEF, h <= LAST ls
7198 = LAST (h::ls) by LAST_DEF
7199*)
7200Theorem MAX_LIST_MONO_INC:
7201 !ls. ls <> [] /\ MONO_INC ls ==> (MAX_LIST ls = LAST ls)
7202Proof
7203 Induct >-
7204 rw[] >>
7205 rpt strip_tac >>
7206 Cases_on `ls = []` >-
7207 rw[] >>
7208 `h <= LAST ls` by
7209 (`LAST ls = EL (LENGTH ls) (h::ls)` by rw[LAST_EL_CONS] >>
7210 `h = EL 0 (h::ls)` by rw[] >>
7211 `LENGTH ls < LENGTH (h::ls)` by rw[] >>
7212 metis_tac[DECIDE``0 <= n``]) >>
7213 `MONO_INC ls` by
7214 (rpt strip_tac >>
7215 `SUC m <= SUC n` by decide_tac >>
7216 `EL (SUC m) (h::ls) <= EL (SUC n) (h::ls)` by rw[] >>
7217 fs[]) >>
7218 rw[MAX_DEF, LAST_DEF]
7219QED
7220
7221(* Theorem: ls <> [] /\ MONO_DEC ls ==> (MAX_LIST ls = HD ls) *)
7222(* Proof:
7223 By induction on ls.
7224 Base: [] <> [] /\ MONO_DEC [] ==> MAX_LIST [] = HD []
7225 Note [] <> [] = F, hence true.
7226 Step: ls <> [] /\ MONO_DEC ls ==> MAX_LIST ls = HD ls ==>
7227 !h. h::ls <> [] /\ MONO_DEC (h::ls) ==> MAX_LIST (h::ls) = HD (h::ls)
7228 If ls = [],
7229 LHS = MAX_LIST [h] = h by MAX_LIST_def
7230 RHS = HD [h] = h = LHS by HD
7231 If ls <> [],
7232 Note HD ls <= h by HD, decreasing property
7233 and MONO_DEC ls by EL, m <= n ==> SUC m <= SUC n
7234 MAX_LIST (h::ls)
7235 = MAX h (MAX_LIST ls) by MAX_LIST_def
7236 = MAX h (HD ls) by induction hypothesis
7237 = h by MAX_DEF, HD ls <= h
7238 = HD (h::ls) by HD
7239*)
7240Theorem MAX_LIST_MONO_DEC:
7241 !ls. ls <> [] /\ MONO_DEC ls ==> (MAX_LIST ls = HD ls)
7242Proof
7243 Induct >-
7244 rw[] >>
7245 rpt strip_tac >>
7246 Cases_on `ls = []` >-
7247 rw[] >>
7248 `HD ls <= h` by
7249 (`HD ls = EL 1 (h::ls)` by rw[] >>
7250 `h = EL 0 (h::ls)` by rw[] >>
7251 `0 < LENGTH ls` by metis_tac[LENGTH_EQ_0, NOT_ZERO_LT_ZERO] >>
7252 `1 < LENGTH (h::ls)` by rw[] >>
7253 metis_tac[DECIDE``0 <= 1``]) >>
7254 `MONO_DEC ls` by
7255 (rpt strip_tac >>
7256 `SUC m <= SUC n` by decide_tac >>
7257 `EL (SUC n) (h::ls) <= EL (SUC m) (h::ls)` by rw[] >>
7258 fs[]) >>
7259 rw[MAX_DEF]
7260QED
7261
7262(* Theorem: ls <> [] /\ MONO_INC ls ==> (MIN_LIST ls = HD ls) *)
7263(* Proof:
7264 By induction on ls.
7265 Base: [] <> [] /\ MONO_INC [] ==> MIN_LIST [] = HD []
7266 Note [] <> [] = F, hence true.
7267 Step: ls <> [] /\ MONO_INC ls ==> MIN_LIST ls = HD ls ==>
7268 !h. h::ls <> [] /\ MONO_INC (h::ls) ==> MIN_LIST (h::ls) = HD (h::ls)
7269 If ls = [],
7270 LHS = MIN_LIST [h] = h by MIN_LIST_def
7271 RHS = HD [h] = h = LHS by HD
7272 If ls <> [],
7273 Note h <= HD ls by HD, increasing property
7274 and MONO_INC ls by EL, m <= n ==> SUC m <= SUC n
7275 MIN_LIST (h::ls)
7276 = MIN h (MIN_LIST ls) by MIN_LIST_def
7277 = MIN h (HD ls) by induction hypothesis
7278 = h by MIN_DEF, h <= HD ls
7279 = HD (h::ls) by HD
7280*)
7281Theorem MIN_LIST_MONO_INC:
7282 !ls. ls <> [] /\ MONO_INC ls ==> (MIN_LIST ls = HD ls)
7283Proof
7284 Induct >-
7285 rw[] >>
7286 rpt strip_tac >>
7287 Cases_on `ls = []` >-
7288 rw[] >>
7289 `h <= HD ls` by
7290 (`HD ls = EL 1 (h::ls)` by rw[] >>
7291 `h = EL 0 (h::ls)` by rw[] >>
7292 `0 < LENGTH ls` by metis_tac[LENGTH_EQ_0, NOT_ZERO_LT_ZERO] >>
7293 `1 < LENGTH (h::ls)` by rw[] >>
7294 metis_tac[DECIDE``0 <= 1``]) >>
7295 `MONO_INC ls` by
7296 (rpt strip_tac >>
7297 `SUC m <= SUC n` by decide_tac >>
7298 `EL (SUC m) (h::ls) <= EL (SUC n) (h::ls)` by rw[] >>
7299 fs[]) >>
7300 rw[MIN_DEF]
7301QED
7302
7303(* Theorem: ls <> [] /\ MONO_DEC ls ==> (MIN_LIST ls = LAST ls) *)
7304(* Proof:
7305 By induction on ls.
7306 Base: [] <> [] /\ MONO_DEC [] ==> MIN_LIST [] = LAST []
7307 Note [] <> [] = F, hence true.
7308 Step: ls <> [] /\ MONO_DEC ls ==> MIN_LIST ls = LAST ls ==>
7309 !h. h::ls <> [] /\ MONO_DEC (h::ls) ==> MAX_LIST (h::ls) = LAST (h::ls)
7310 If ls = [],
7311 LHS = MIN_LIST [h] = h by MIN_LIST_def
7312 RHS = LAST [h] = h = LHS by LAST_DEF
7313 If ls <> [],
7314 Note LAST ls <= h by LAST_EL_CONS, decreasing property
7315 and MONO_DEC ls by EL, m <= n ==> SUC m <= SUC n
7316 MIN_LIST (h::ls)
7317 = MIN h (MIN_LIST ls) by MIN_LIST_def
7318 = MIN h (LAST ls) by induction hypothesis
7319 = LAST ls by MIN_DEF, LAST ls <= h
7320 = LAST (h::ls) by LAST_DEF
7321*)
7322Theorem MIN_LIST_MONO_DEC:
7323 !ls. ls <> [] /\ MONO_DEC ls ==> (MIN_LIST ls = LAST ls)
7324Proof
7325 Induct >-
7326 rw[] >>
7327 rpt strip_tac >>
7328 Cases_on `ls = []` >-
7329 rw[] >>
7330 `LAST ls <= h` by
7331 (`LAST ls = EL (LENGTH ls) (h::ls)` by rw[LAST_EL_CONS] >>
7332 `h = EL 0 (h::ls)` by rw[] >>
7333 `LENGTH ls < LENGTH (h::ls)` by rw[] >>
7334 metis_tac[DECIDE``0 <= n``]) >>
7335 `MONO_DEC ls` by
7336 (rpt strip_tac >>
7337 `SUC m <= SUC n` by decide_tac >>
7338 `EL (SUC n) (h::ls) <= EL (SUC m) (h::ls)` by rw[] >>
7339 fs[]) >>
7340 rw[MIN_DEF, LAST_DEF]
7341QED
7342
7343(* ------------------------------------------------------------------------- *)
7344(* Sublist: an order-preserving portion of a list *)
7345(* ------------------------------------------------------------------------- *)
7346
7347(* Definition of sublist *)
7348Definition sublist_def:
7349 (sublist [] x = T) /\
7350 (sublist (h1::t1) [] = F) /\
7351 (sublist (h1::t1) (h2::t2) <=>
7352 ((h1 = h2) /\ sublist t1 t2 \/ ~(h1 = h2) /\ sublist (h1::t1) t2))
7353End
7354
7355(* Overload sublist by infix operator *)
7356Overload "<="[local] = ``sublist``
7357(*
7358> sublist_def;
7359val it = |- (!x. [] <= x <=> T) /\ (!t1 h1. h1::t1 <= [] <=> F) /\
7360 !t2 t1 h2 h1. h1::t1 <= h2::t2 <=>
7361 (h1 = h2) /\ t1 <= t2 \/ h1 <> h2 /\ h1::t1 <= t2: thm
7362*)
7363
7364(* Theorem: [] <= p *)
7365(* Proof: by sublist_def *)
7366Theorem sublist_nil:
7367 !p. [] <= p
7368Proof
7369 rw[sublist_def]
7370QED
7371
7372(* Theorem: p <= q <=> h::p <= h::q *)
7373(* Proof: by sublist_def *)
7374Theorem sublist_cons:
7375 !h p q. p <= q <=> h::p <= h::q
7376Proof
7377 rw[sublist_def]
7378QED
7379
7380(* Theorem: p <= [] <=> (p = []) *)
7381(* Proof:
7382 If p = [], then [] <= [] by sublist_nil
7383 If p = h::t, then h::t <= [] = F by sublist_def
7384*)
7385Theorem sublist_of_nil:
7386 !p. p <= [] <=> (p = [])
7387Proof
7388 (Cases_on `p` >> rw[sublist_def])
7389QED
7390
7391(* Theorem: (!p q. (h::p) <= q ==> p <= q) = (!p q. p <= q ==> p <= (h::q)) *)
7392(* Proof:
7393 If part: (!p q. (h::p) <= q ==> p <= q) ==> (!p q. p <= q ==> p <= (h::q))
7394 p <= q
7395 ==> h::p <= h::q by sublist_cons
7396 ==> p <= h::q by implication
7397 Only-if part: (!p q. p <= q ==> p <= (h::q)) ==> (!p q. (h::p) <= q ==> p <= q)
7398 (h::p) <= q
7399 ==> (h::p) <= (h::q) by implication
7400 ==> p <= q by sublist_cons
7401*)
7402Theorem sublist_cons_eq:
7403 !h. (!p q. (h::p) <= q ==> p <= q) = (!p q. p <= q ==> p <= (h::q))
7404Proof
7405 rw[EQ_IMP_THM] >>
7406 metis_tac[sublist_cons]
7407QED
7408
7409(* Theorem: h::p <= q ==> p <= q *)
7410(* Proof:
7411 By induction on q.
7412 Base: !h p. h::p <= [] ==> p <= []
7413 True since h::p <= [] = F by sublist_def
7414
7415 Step: !h p. h::p <= q ==> p <= q ==>
7416 !h h' p. h'::p <= h::q ==> p <= h::q
7417 If p = [], true by sublist_nil
7418 If p = h''::t,
7419 p <= h::q
7420 <=> (h'' = h) /\ t <= q \/ h'' <> h /\ h''::t <= q by sublist_def
7421 If h'' = h, then t <= q by sublist_def, induction hypothesis
7422 If h'' <> h, then h''::t <= q by sublist_def, induction hypothesis
7423*)
7424Theorem sublist_cons_remove:
7425 !h p q. h::p <= q ==> p <= q
7426Proof
7427 Induct_on `q` >-
7428 rw[sublist_def] >>
7429 rpt strip_tac >>
7430 (Cases_on `p` >> simp[sublist_def]) >>
7431 (Cases_on `h'' = h` >> metis_tac[sublist_def])
7432QED
7433
7434(* Theorem: p <= q ==> p <= h::q *)
7435(* Proof: by sublist_cons_eq, sublist_cons_remove *)
7436Theorem sublist_cons_include:
7437 !h p q. p <= q ==> p <= h::q
7438Proof
7439 metis_tac[sublist_cons_eq, sublist_cons_remove]
7440QED
7441
7442(* Theorem: p <= q ==> LENGTH p <= LENGTH q *)
7443(* Proof:
7444 By induction on q.
7445 Base: !p. p <= [] ==> LENGTH p <= LENGTH []
7446 Note p = [] by sublist_of_nil
7447 Thus true by arithemtic
7448 Step: !p. p <= q ==> LENGTH p <= LENGTH q ==>
7449 !h p. p <= h::q ==> LENGTH p <= LENGTH (h::q)
7450 If p = [], LENGTH p = 0 by LENGTH
7451 and 0 <= LENGTH (h::q).
7452 If p = h'::t,
7453 If h = h',
7454 (h::t) <= (h::q)
7455 <=> t <= q by sublist_def, same heads
7456 ==> LENGTH t <= LENGTH q by inductive hypothesis
7457 ==> SUC(LENGTH t) <= SUC(LENGTH q)
7458 = LENGTH (h::t) <= LENGTH (h::q)
7459 If ~(h = h'),
7460 (h'::t) <= (h::q)
7461 <=> (h'::t) <= q by sublist_def, different heads
7462 ==> LENGTH (h'::t) <= LENGTH q by inductive hypothesis
7463 ==> LENGTH (h'::t) <= SUC(LENGTH q) by arithemtic
7464 = LENGTH (h'::t) <= LENGTH (h::q)
7465*)
7466Theorem sublist_length:
7467 !p q. p <= q ==> LENGTH p <= LENGTH q
7468Proof
7469 Induct_on `q` >-
7470 rw[sublist_of_nil] >>
7471 rpt strip_tac >>
7472 (Cases_on `p` >> simp[]) >>
7473 (Cases_on `h = h'` >> fs[sublist_def]) >>
7474 `LENGTH (h'::t) <= LENGTH q` by rw[] >>
7475 `LENGTH t < LENGTH (h'::t)` by rw[LENGTH_TL_LT] >>
7476 decide_tac
7477QED
7478
7479(* Theorem: [Reflexive] p <= p *)
7480(* Proof:
7481 By induction on p.
7482 Base: [] <= [], true by sublist_nil
7483 Step: p <= p ==> !h. h::p <= h::p, true by sublist_cons
7484*)
7485Theorem sublist_refl:
7486 !p:'a list. p <= p
7487Proof
7488 Induct >> rw[sublist_def]
7489QED
7490
7491(* Theorem: [Anti-symmetric] !p q. (p <= q) /\ (q <= p) ==> (p = q) *)
7492(* Proof:
7493 By induction on q.
7494 Base: !p. p <= [] /\ [] <= p ==> (p = [])
7495 Note p <= [] already gives p = [] by sublist_of_nil
7496 Step: !p. p <= q /\ q <= p ==> (p = q) ==>
7497 !h p. p <= h::q /\ h::q <= p ==> (p = h::q)
7498 If p = [], h::q <= [] = F by sublist_def
7499 If p = (h'::t),
7500 If h = h',
7501 ((h::t) <= (h::q)) /\ ((h::q) <= (h::t))
7502 <=> (t <= q) and (q <= t) by sublist_def, same heads
7503 ==> t = q by inductive hypothesis
7504 <=> (h::t) = (h::q) by list equality
7505 If ~(h = h'),
7506 ((h'::t) <= (h::q)) /\ ((h::q) <= (h'::t))
7507 <=> ((h'::t) <= q) /\ ((h::q) <= t) by sublist_def, different heads
7508 ==> (LENGTH (h'::t) <= LENGTH q) /\
7509 (LENGTH (h::q) <= LENGTH t) by sublist_length
7510 ==> (LENGTh t < LENGTH q) /\
7511 (LENGTH q < LENGTH t) by LENGTH_TL_LT
7512 = F by arithmetic
7513 Hence the implication is T.
7514*)
7515Theorem sublist_antisym:
7516 !p q:'a list. p <= q /\ q <= p ==> (p = q)
7517Proof
7518 Induct_on `q` >-
7519 rw[sublist_of_nil] >>
7520 rpt strip_tac >>
7521 Cases_on `p` >-
7522 fs[sublist_def] >>
7523 (Cases_on `h' = h` >> fs[sublist_def]) >>
7524 `LENGTH (h'::t) <= LENGTH q /\ LENGTH (h::q) <= LENGTH t` by rw[sublist_length] >>
7525 fs[LENGTH_TL_LT]
7526QED
7527
7528(* Theorem [Transitive]: for all lists p, q, r; (p <= q) /\ (q <= r) ==> (p <= r) *)
7529(* Proof:
7530 By induction on list r and taking note of cases.
7531 By induction on r.
7532 Base: !p q. p <= q /\ q <= [] ==> p <= []
7533 Note q = [] by sublist_of_nil
7534 so p = [] by sublist_of_nil
7535 Step: !p q. p <= q /\ q <= r ==> p <= r ==>
7536 !h p q. p <= q /\ q <= h::r ==> p <= h::r
7537 If p = [], true by sublist_nil
7538 If p = h'::t, to show:
7539 h'::t <= q /\ q <= h::r ==>
7540 (h' = h) /\ t <= r \/
7541 h' <> h /\ h'::t <= r by sublist_def
7542 If q = [], [] <= h::r = F by sublist_def
7543 If q = h''::t', this reduces to:
7544 (1) h' = h'' /\ t <= t' /\ h'' = h /\ t' <= r ==> t <= r
7545 Note t <= t' /\ t' <= r ==> t <= r by induction hypothesis
7546 (2) h' = h'' /\ t <= t' /\ h'' <> h /\ h''::t' <= r ==> h''::t <= r
7547 Note t <= t' ==> h''::t <= h''::t' by sublist_cons
7548 With h''::t' <= r ==> h''::t <= r by induction hypothesis
7549 (3) h' <> h'' /\ h'::t <= t' /\ h'' = h /\ t' <= r ==>
7550 (h' = h) /\ t <= r \/ h' <> h /\ h'::t <= r
7551 Note h'::t <= t' ==> t <= t' by sublist_cons_remove
7552 With t' <= r ==> t <= r by induction hypothesis
7553 Or simply h'::t <= t' /\ t' <= r
7554 ==> h'::t <= r by induction hypothesis
7555 Hence this is true.
7556 (4) h' <> h'' /\ h'::t <= t' /\ h'' <> h /\ h''::t' <= r ==>
7557 (h' = h) /\ t <= r \/ h' <> h /\ h'::t <= r
7558 Same reasoning as (3).
7559*)
7560Theorem sublist_trans:
7561 !p q r:'a list. p <= q /\ q <= r ==> p <= r
7562Proof
7563 Induct_on `r` >-
7564 fs[sublist_of_nil] >>
7565 rpt strip_tac >>
7566 (Cases_on `p` >> fs[sublist_def]) >>
7567 (Cases_on `q` >> fs[sublist_def]) >-
7568 metis_tac[] >-
7569 metis_tac[sublist_cons] >-
7570 metis_tac[sublist_cons_remove] >>
7571 metis_tac[sublist_cons_remove]
7572QED
7573
7574(* The above theorems show that sublist is a partial ordering. *)
7575
7576(* Theorem: p <= q ==> SNOC h p <= SNOC h q *)
7577(* Proof:
7578 By induction on q.
7579 Base: !h p. p <= [] ==> SNOC h p <= SNOC h []
7580 Note p = [] by sublist_of_nil
7581 Thus SNOC h [] <= SNOC h [] by sublist_refl
7582 Step: !h p. p <= q ==> SNOC h p <= SNOC h q ==>
7583 !h h' p. p <= h::q ==> SNOC h' p <= SNOC h' (h::q)
7584 If p = [],
7585 Note [] <= q by sublist_nil
7586 Thus SNOC h' []
7587 <= SNOC h' q by induction hypothesis
7588 <= h::SNOC h' q by sublist_cons_include
7589 = SNOC h' (h::q) by SNOC
7590 If p = h''::t,
7591 If h = h'',
7592 Then t <= q by sublist_def, same heads
7593 ==> SNOC h' t <= SNOC h' q by induction hypothesis
7594 ==> h::SNOC h' t <= h::SNOC h' q by rw[sublist_cons
7595 or SNOC h' (h::t) <= SNOC h' (h::q) by SNOC
7596 or SNOC h' p <= SNOC h' (h::q) by p = h::t
7597 If h <> h'',
7598 Then p <= q by sublist_def, different heads
7599 ==> SNOC h' p <= SNOC h' q by induction hypothesis
7600 ==> SNOC h' p <= h::SNOC h' q by sublist_cons_include
7601*)
7602Theorem sublist_snoc:
7603 !h p q. p <= q ==> SNOC h p <= SNOC h q
7604Proof
7605 Induct_on `q` >-
7606 rw[sublist_of_nil, sublist_refl] >>
7607 rw[sublist_def] >>
7608 Cases_on `p` >-
7609 rw[sublist_nil, sublist_cons_include] >>
7610 metis_tac[sublist_def, sublist_cons, SNOC]
7611QED
7612
7613(* Theorem: MEM x ls ==> [x] <= ls *)
7614(* Proof:
7615 By induction on ls.
7616 Base: !x. MEM x [] ==> [x] <= []
7617 True since MEM x [] = F.
7618 Step: !x. MEM x ls ==> [x] <= ls ==>
7619 !h x. MEM x (h::ls) ==> [x] <= h::ls
7620 If x = h,
7621 Then [h] <= h::ls by sublist_nil, sublist_cons
7622 If x <> h,
7623 Then MEM h ls by MEM x (h::ls)
7624 ==> [x] <= ls by induction hypothesis
7625 ==> [x] <= h::ls by sublist_cons_include
7626*)
7627Theorem sublist_member_sing:
7628 !ls x. MEM x ls ==> [x] <= ls
7629Proof
7630 Induct >-
7631 rw[] >>
7632 rw[] >-
7633 rw[sublist_nil, GSYM sublist_cons] >>
7634 rw[sublist_cons_include]
7635QED
7636
7637(* Theorem: TAKE n ls <= ls *)
7638(* Proof:
7639 By induction on ls.
7640 Base: !n. TAKE n [] <= []
7641 LHS = TAKE n [] = [] by TAKE_def
7642 <= [] = RHS by sublist_nil
7643 Step: !n. TAKE n ls <= ls ==> !h n. TAKE n (h::ls) <= h::ls
7644 If n = 0,
7645 TAKE 0 (h::ls)
7646 = [] by TAKE_def
7647 <= h::ls by sublist_nil
7648 If n <> 0,
7649 TAKE n (h::ls)
7650 = h::TAKE (n - 1) ls by TAKE_def
7651 Now TAKE (n - 1) ls <= ls by induction hypothesis
7652 Thus h::TAKE (n - 1) ls <= h::ls by sublist_cons
7653*)
7654Theorem sublist_take:
7655 !ls n. TAKE n ls <= ls
7656Proof
7657 Induct >-
7658 rw[sublist_nil] >>
7659 rpt strip_tac >>
7660 Cases_on `n = 0` >-
7661 rw[sublist_nil] >>
7662 rw[GSYM sublist_cons]
7663QED
7664
7665(* Theorem: DROP n ls <= ls *)
7666(* Proof:
7667 By induction on ls.
7668 Base: !n. DROP n [] <= []
7669 LHS = DROP n [] = [] by DROP_def
7670 <= [] = RHS by sublist_nil
7671 Step: !n. DROP n ls <= ls ==> !h n. DROP n (h::ls) <= h::ls
7672 If n = 0,
7673 DROP 0 (h::ls)
7674 = h::ls by DROP_def
7675 <= h::ls by sublist_refl
7676 If n <> 0,
7677 DROP n (h::ls)
7678 = DROP n ls by DROP_def
7679 <= ls by induction hypothesis
7680 <= h::ls by sublist_cons_include
7681*)
7682Theorem sublist_drop:
7683 !ls n. DROP n ls <= ls
7684Proof
7685 Induct >-
7686 rw[sublist_nil] >>
7687 rpt strip_tac >>
7688 Cases_on `n = 0` >-
7689 rw[sublist_refl] >>
7690 rw[sublist_cons_include]
7691QED
7692
7693(* Theorem: ls <> [] ==> TL ls <= ls *)
7694(* Proof:
7695 Note TL ls = DROP 1 ls by TAIL_BY_DROP, ls <> []
7696 Thus TL ls <= ls by sublist_drop
7697*)
7698Theorem sublist_tail:
7699 !ls. ls <> [] ==> TL ls <= ls
7700Proof
7701 rw[TAIL_BY_DROP, sublist_drop]
7702QED
7703
7704(* Theorem: ls <> [] ==> FRONT ls <= ls *)
7705(* Proof:
7706 Note FRONT ls = TAKE (LENGTH ls - 1) ls by FRONT_BY_TAKE
7707 so FRONT ls <= ls by sublist_take
7708*)
7709Theorem sublist_front:
7710 !ls. ls <> [] ==> FRONT ls <= ls
7711Proof
7712 rw[FRONT_BY_TAKE, sublist_take]
7713QED
7714
7715(* Theorem: ls <> [] ==> [HD ls] <= ls *)
7716(* Proof: HEAD_MEM, sublist_member_sing *)
7717Theorem sublist_head_sing:
7718 !ls. ls <> [] ==> [HD ls] <= ls
7719Proof
7720 rw[HEAD_MEM, sublist_member_sing]
7721QED
7722
7723(* Theorem: ls <> [] ==> [LAST ls] <= ls *)
7724(* Proof: LAST_MEM, sublist_member_sing *)
7725Theorem sublist_last_sing:
7726 !ls. ls <> [] ==> [LAST ls] <= ls
7727Proof
7728 rw[LAST_MEM, sublist_member_sing]
7729QED
7730
7731(* Theorem: l <= ls ==> !P. EVERY P ls ==> EVERY P l *)
7732(* Proof:
7733 By induction on ls.
7734 Base: !l. l <= [] ==> !P. EVERY P [] ==> EVERY P l
7735 Note l <= [] ==> l = [] by sublist_of_nil
7736 and EVERY P [] = T by implication, or EVERY_DEF
7737 Step: !l. l <= ls ==> !P. EVERY P ls ==> EVERY P l ==>
7738 !h l. l <= h::ls ==> !P. EVERY P (h::ls) ==> EVERY P l
7739 l <= h::ls
7740 If l = [], then EVERY P [] = T by EVERY_DEF
7741 Otherwise, let l = k::t by list_CASES
7742 Note EVERY P (h::ls)
7743 ==> P h /\ EVERY P ls by EVERY_DEF
7744 Then k::t <= h::ls
7745 ==> k = h /\ t <= ls
7746 or k <> h /\ k::t <= ls by sublist_def
7747 For the first case, h = k,
7748 P k /\ EVERY P t by induction hypothesis
7749 ==> EVERY P (k::t) = EVERY P l by EVERY_DEF
7750 For the second case, h <> k,
7751 EVERY P (k::t) = EVERY P l by induction hypothesis
7752*)
7753Theorem sublist_every:
7754 !l ls. l <= ls ==> !P. EVERY P ls ==> EVERY P l
7755Proof
7756 Induct_on `ls` >-
7757 rw[sublist_of_nil] >>
7758 (Cases_on `l` >> simp[]) >>
7759 metis_tac[sublist_def, EVERY_DEF]
7760QED
7761
7762(* ------------------------------------------------------------------------- *)
7763(* More sublists, applying partial order properties *)
7764(* ------------------------------------------------------------------------- *)
7765
7766(* Observation:
7767When doing induction proofs on sublists about p <= q,
7768Always induct on q, then take cases on p.
7769*)
7770
7771(* The following induction theorem is already present during definition:
7772> theorem "sublist_ind";
7773val it = |- !P. (!x. P [] x) /\ (!h1 t1. P (h1::t1) []) /\
7774 (!h1 t1 h2 t2. P t1 t2 /\ P (h1::t1) t2 ==> P (h1::t1) (h2::t2)) ==>
7775 !v v1. P v v1: thm
7776
7777Just prove it as an exercise.
7778*)
7779
7780(* Theorem: [Induction] For any property P satisfying,
7781 (a) !y. P [] y = T
7782 (b) !h x y. P x y /\ sublist x y ==> P (h::x) (h::y)
7783 (c) !h x y. P x y /\ sublist x y ==> P x (h::y)
7784 then !x y. sublist x y ==> P x y.
7785*)
7786(* Proof:
7787 By induction on y.
7788 Base: !x. x <= [] ==> P x []
7789 Note x = [] by sublist_of_nil
7790 and P [] [] = T by given
7791 Step: !x. x <= y ==> P x y ==>
7792 !h x. x <= h::y ==> P x (h::y)
7793 If x = [], then [] <= h::y = F by sublist_def
7794 If x = h'::t,
7795 If h' = h, t <= y by sublist_def, same heads
7796 Thus P t y by induction hypothesis
7797 and P t y /\ t <= y ==> P (h::t) (h::y) = P x (h::y)
7798 If h' <> h, x <= y by sublist_def, different heads
7799 Thus P x y by induction hypothesis
7800 and P x y /\ x <= y ==> P x (h::y).
7801*)
7802Theorem sublist_induct:
7803 !P. (!y. P [] y) /\
7804 (!h x y. P x y /\ x <= y ==> P (h::x) (h::y)) /\
7805 (!h x y. P x y /\ x <= y ==> P x (h::y)) ==>
7806 !x y. x <= y ==> P x y
7807Proof
7808 ntac 2 strip_tac >>
7809 Induct_on `y` >-
7810 rw[sublist_of_nil] >>
7811 rpt strip_tac >>
7812 (Cases_on `x` >> fs[sublist_def])
7813QED
7814
7815(*
7816Note that from definition:
7817sublist_ind
7818|- !P. (!x. P [] x) /\ (!h1 t1. P (h1::t1) []) /\
7819 (!h1 t1 h2 t2. P t1 t2 /\ P (h1::t1) t2 ==> P (h1::t1) (h2::t2)) ==>
7820 !v v1. P v v1
7821
7822sublist_induct
7823|- !P. (!y. P [] y) /\ (!h x y. P x y /\ x <= y ==> P (h::x) (h::y)) /\
7824 (!h x y. P x y /\ x <= y ==> P x (h::y)) ==>
7825 !x y. x <= y ==> P x y
7826
7827The second is better.
7828*)
7829
7830(* Theorem: p <= q /\ MEM x p ==> MEM x q *)
7831(* Proof:
7832 By sublist_induct, this is to show:
7833 (1) MEM x [] ==> MEM x q
7834 Note MEM x [] = F by MEM
7835 Hence true.
7836 (2) MEM x p ==> MEM x q /\ p <= q /\ MEM x (h::p) ==> MEM x (h::q)
7837 If x = h, then MEM h (h::q) = T by MEM
7838 If x <> h, MEM x (h::p)
7839 ==> MEM x p by MEM, x <> h
7840 ==> MEM x q by induction hypothesis
7841 ==> MEM x (h::q) by MEM, x <> h
7842 (3) MEM x p ==> MEM x q /\ p <= q /\ MEM x p ==> MEM x (h::q)
7843 If x = h, then MEM h (h::q) = T by MEM
7844 If x <> h, MEM x p
7845 ==> MEM x q by induction hypothesis
7846 ==> MEM x (h::q) by MEM, x <> h
7847*)
7848Theorem sublist_mem:
7849 !p q x. p <= q /\ MEM x p ==> MEM x q
7850Proof
7851 rpt strip_tac >>
7852 pop_assum mp_tac >>
7853 pop_assum mp_tac >>
7854 qid_spec_tac `q` >>
7855 qid_spec_tac `p` >>
7856 ho_match_mp_tac sublist_induct >>
7857 rpt strip_tac >-
7858 fs[] >-
7859 (Cases_on `x = h` >> fs[]) >>
7860 (Cases_on `x = h` >> fs[])
7861QED
7862
7863(* Theorem: sl <= ls ==> set sl SUBSET set ls *)
7864(* Proof:
7865 set sl SUBSET set ls
7866 <=> !x. x IN set (sl) ==> x IN set ls by SUBSET_DEF
7867 <=> !x. MEM x sl ==> MEM x ls by notation
7868 ==> T by sublist_mem
7869*)
7870Theorem sublist_subset:
7871 !ls sl. sl <= ls ==> set sl SUBSET set ls
7872Proof
7873 metis_tac[SUBSET_DEF, sublist_mem]
7874QED
7875
7876(* Theorem: p <= q /\ ALL_DISTINCT q ==> ALL_DISTINCT p *)
7877(* Proof:
7878 By sublist_induct, this is to show:
7879 (1) ALL_DISTINCT q ==> ALL_DISTINCT []
7880 Note ALL_DISTINCT [] = T by ALL_DISTINCT
7881 (2) ALL_DISTINCT q ==> ALL_DISTINCT p /\ p <= q /\ ALL_DISTINCT (h::q) ==> ALL_DISTINCT (h::p)
7882 ALL_DISTINCT (h::q)
7883 <=> ~MEM h q /\ ALL_DISTINCT q by ALL_DISTINCT
7884 ==> ~MEM h q /\ ALL_DISTINCT p by induction hypothesis
7885 ==> ~MEM h p /\ ALL_DISTINCT p by sublist_mem
7886 <=> ALL_DISTINCT (h::p) by ALL_DISTINCT
7887 (3) ALL_DISTINCT q ==> ALL_DISTINCT p /\ p <= q /\ ALL_DISTINCT (h::q) ==> ALL_DISTINCT p
7888 ALL_DISTINCT (h::q)
7889 ==> ALL_DISTINCT q by ALL_DISTINCT
7890 ==> ALL_DISTINCT p by induction hypothesis
7891*)
7892Theorem sublist_ALL_DISTINCT:
7893 !p q. p <= q /\ ALL_DISTINCT q ==> ALL_DISTINCT p
7894Proof
7895 rpt strip_tac >>
7896 pop_assum mp_tac >>
7897 pop_assum mp_tac >>
7898 qid_spec_tac `q` >>
7899 qid_spec_tac `p` >>
7900 ho_match_mp_tac sublist_induct >>
7901 rpt strip_tac >-
7902 simp[] >-
7903 (fs[] >> metis_tac[sublist_mem]) >>
7904 fs[]
7905QED
7906
7907(* Theorem: [Eliminate append from left]: (x ++ p) <= q ==> sublist p <= q *)
7908(* Proof:
7909 By induction on the extra list x.
7910 The induction step follows from sublist_cons_remove.
7911
7912 By induction on x.
7913 Base: !p q. [] ++ p <= q ==> p <= q
7914 True since [] ++ p = p by APPEND
7915 Step: !p q. x ++ p <= q ==> p <= q ==>
7916 !h p q. h::x ++ p <= q ==> p <= q
7917 h::x ++ p <= q
7918 = h::(x ++ p) <= q by APPEND
7919 ==> (x ++ p) <= q by sublist_cons_remove
7920 ==> p <= q by induction hypothesis
7921*)
7922Theorem sublist_append_remove:
7923 !p q x. x ++ p <= q ==> p <= q
7924Proof
7925 Induct_on `x` >> metis_tac[sublist_cons_remove, APPEND]
7926QED
7927
7928(* Theorem: [Include append to right] p <= q ==> p <= (x ++ q) *)
7929(* Proof:
7930 By induction on list x.
7931 The induction step follows by sublist_cons_include.
7932
7933 By induction on x.
7934 Base: !p q. p <= q ==> p <= [] ++ q
7935 True since [] ++ q = q by APPEND
7936 Step: !p q. p <= q ==> p <= x ++ q ==>
7937 !h p q. p <= q ==> p <= h::x ++ q
7938 p <= q
7939 ==> p <= x ++ q by induction hypothesis
7940 ==> p <= h::(x ++ q) by sublist_cons_include
7941 = p <= h::x ++ q by APPEND
7942*)
7943Theorem sublist_append_include:
7944 !p q x. p <= q ==> p <= x ++ q
7945Proof
7946 Induct_on `x` >> metis_tac[sublist_cons_include, APPEND]
7947QED
7948
7949(* Theorem: [append after] p <= (p ++ q) *)
7950(* Proof:
7951 By induction on list p, and note that p and (p ++ q) have the same head.
7952 Base: !q. [] <= [] ++ q, true by sublist_nil
7953 Step: !q. p <= p ++ q ==> !h q. h::p <= h::p ++ q
7954 p <= p ++ q by induction hypothesis
7955 ==> h::p <= h::(p ++ q) by sublist_cons
7956 ==> h::p <= h::p ++ q by APPEND
7957*)
7958Theorem sublist_append_suffix:
7959 !p q. p <= p ++ q
7960Proof
7961 Induct_on `p` >> rw[sublist_def]
7962QED
7963
7964(* Theorem: [append before] p <= (q ++ p) *)
7965(* Proof:
7966 By induction on q.
7967 Base: !p. p <= [] ++ p
7968 Note [] ++ p = p by APPEND
7969 and p <= p by sublist_refl
7970 Step: !p. p <= q ++ p ==> !h p. p <= h::q ++ p
7971 p <= q ++ p by induction hypothesis
7972 ==> p <= h::(q ++ p) by sublist_cons_include
7973 = p <= h::q ++ p by APPEND
7974*)
7975Theorem sublist_append_prefix:
7976 !p q. p <= q ++ p
7977Proof
7978 Induct_on `q` >-
7979 rw[sublist_refl] >>
7980 rw[sublist_cons_include]
7981QED
7982
7983(* Theorem: [prefix append] p <= q <=> (x ++ p) <= (x ++ q) *)
7984(* Proof:
7985 By induction on x.
7986 Base: !p q. p <= q <=> [] ++ p <= [] ++ q
7987 Since [] ++ p = p /\ [] ++ q = q by APPEND
7988 This is trivially true.
7989 Step: !p q. p <= q <=> x ++ p <= x ++ q ==>
7990 !h p q. p <= q <=> h::x ++ p <= h::x ++ q
7991 p <= q <=> x ++ p <= x ++ q by induction hypothesis
7992 <=> h::(x ++ p) <= h::(x ++ q) by sublist_cons
7993 <=> h::x ++ p <= h::x ++ q by APPEND
7994*)
7995Theorem sublist_prefix:
7996 !x p q. p <= q <=> (x ++ p) <= (x ++ q)
7997Proof
7998 Induct_on `x` >> metis_tac[sublist_cons, APPEND]
7999QED
8000
8001(* Theorem: [no append to left] !p q. (p ++ q) <= q ==> p = [] *)
8002(* Proof:
8003 By induction on q.
8004 Base: !p. p ++ [] <= [] ==> (p = [])
8005 Note p ++ [] = p by APPEND
8006 and p <= [] ==> p = [] by sublist_of_nil
8007 Step: !p. p ++ q <= q ==> (p = []) ==>
8008 !h p. p ++ h::q <= h::q ==> (p = [])
8009 If p = [], true trivially.
8010 If p = h'::t,
8011 (h'::t) ++ (h::q) <= h::q
8012 = h'::(t ++ h::q) <= h::q by APPEND
8013 If h' = h,
8014 Then t ++ h::q <= q by sublist_def, same heads
8015 or (t ++ [h]) ++ q <= q by APPEND
8016 ==> t ++ [h] = [] by induction hypothesis
8017 which is F, hence h' <> h.
8018 If h' <> h,
8019 Then p ++ h::q <= q by sublist_def, different heads
8020 or (p ++ [h]) ++ q <= q by APPEND
8021 ==> (p ++ [h]) = [] by induction hypothesis
8022 which is F, hence neither h' <> h.
8023 All these shows that p = h'::t is impossible.
8024*)
8025Theorem sublist_prefix_nil:
8026 !p q. (p ++ q) <= q ==> (p = [])
8027Proof
8028 Induct_on `q` >-
8029 rw[sublist_of_nil] >>
8030 rpt strip_tac >>
8031 (Cases_on `p` >> fs[sublist_def]) >| [
8032 `t ++ h::q = (t ++ [h])++ q` by rw[] >>
8033 `t ++ [h] <> []` by rw[] >>
8034 metis_tac[],
8035 `(t ++ h::q) <= q` by metis_tac[sublist_cons_remove] >>
8036 `t ++ h::q = (t ++ [h])++ q` by rw[] >>
8037 `t ++ [h] <> []` by rw[] >>
8038 metis_tac[]
8039 ]
8040QED
8041
8042(* Theorem: [tail append - if] p <= q ==> (p ++ [h]) <= (q ++ [h]) *)
8043(* Proof:
8044 p <= q
8045 ==> SNOC h p <= SNOC h q by sublist_snoc
8046 ==> (p ++ [h]) <= (q ++ [h]) by SNOC_APPEND
8047*)
8048Theorem sublist_append_if:
8049 !p q h. p <= q ==> (p ++ [h]) <= (q ++ [h])
8050Proof
8051 rw[sublist_snoc, GSYM SNOC_APPEND]
8052QED
8053
8054(* Theorem: [tail append - only if] p ++ [h] <= q ++ [h] ==> p <= q *)
8055(* Proof:
8056 By induction on q.
8057 Base: !p h. p ++ [h] <= [] ++ [h] ==> p <= []
8058 Note [] ++ [h] = [h] by APPEND
8059 and p ++ [h] <= [h] ==> p = [] by sublist_prefix_nil
8060 and [] <= [] by sublist_nil
8061 Step: !p h. p ++ [h] <= q ++ [h] ==> p <= q ==>
8062 !h p h'. p ++ [h'] <= h::q ++ [h'] ==> p <= h::q
8063 If p = [], [h'] <= h::q ++ [h'] = F by sublist_def
8064 If p = h''::t,
8065 h''::t ++ [h'] = h''::(t ++ [h']) by APPEND
8066 If h'' = h',
8067 Then t ++ [h'] <= q ++ [h'] by sublist_def, same heads
8068 ==> t <= q by induction hypothesis
8069 If h'' <> h',
8070 Then h''::t ++ [h'] <= q ++ [h'] by sublist_def, different heads
8071 ==> h''::t <= q by induction hypothesis
8072*)
8073Theorem sublist_append_only_if:
8074 !p q h. (p ++ [h]) <= (q ++ [h]) ==> p <= q
8075Proof
8076 Induct_on `q` >-
8077 metis_tac[sublist_prefix_nil, sublist_nil, APPEND] >>
8078 rpt strip_tac >>
8079 (Cases_on `p` >> fs[sublist_def]) >-
8080 metis_tac[] >>
8081 `h''::(t ++ [h']) = (h''::t) ++ [h']` by rw[] >>
8082 metis_tac[]
8083QED
8084
8085(* Theorem: [tail append] p <= q <=> p ++ [h] <= q ++ [h] *)
8086(* Proof: by sublist_append_if, sublist_append_only_if *)
8087Theorem sublist_append_iff:
8088 !p q h. p <= q <=> (p ++ [h]) <= (q ++ [h])
8089Proof
8090 metis_tac[sublist_append_if, sublist_append_only_if]
8091QED
8092
8093(* Theorem: [suffix append] sublist p q ==> sublist (p ++ x) (q ++ x) *)
8094(* Proof:
8095 By induction on x.
8096 Base: !p q. p <= q <=> p ++ [] <= q ++ []
8097 True by p ++ [] = p, q ++ [] = q by APPEND
8098 Step: !p q. p <= q <=> p ++ x <= q ++ x ==>
8099 !h p q. p <= q <=> p ++ h::x <= q ++ h::x
8100 p <= q
8101 <=> (p ++ [h]) <= (q ++ [h]) by sublist_append_iff
8102 <=> (p ++ [h]) ++ x <= (q ++ [h]) ++ x by induction hypothesis
8103 <=> p ++ (h::x) <= q ++ (h::x) by APPEND
8104*)
8105Theorem sublist_suffix:
8106 !x p q. p <= q <=> (p ++ x) <= (q ++ x)
8107Proof
8108 Induct >-
8109 rw[] >>
8110 rpt strip_tac >>
8111 `!z. z ++ h::x = (z ++ [h]) ++ x` by rw[] >>
8112 metis_tac[sublist_append_iff]
8113QED
8114
8115(* Theorem : (a <= b) /\ (c <= d) ==> (a ++ c) <= (b ++ d) *)
8116(* Proof:
8117 Note a ++ c <= a ++ d by sublist_prefix
8118 and a ++ d <= b ++ d by sublist_suffix
8119 ==> a ++ c <= b ++ d by sublist_trans
8120*)
8121Theorem sublist_append_pair:
8122 !a b c d. (a <= b) /\ (c <= d) ==> (a ++ c) <= (b ++ d)
8123Proof
8124 metis_tac[sublist_prefix, sublist_suffix, sublist_trans]
8125QED
8126
8127(* Theorem: [Extended Append, or Decomposition] (h::t) <= q <=> ?x y. (q = x ++ (h::y)) /\ (t <= y) *)
8128(* Proof:
8129 By induction on list q.
8130 Base case is to prove:
8131 sublist (h::t) [] <=> ?x y. ([] = x ++ (h::y)) /\ (sublist t y)
8132 Hypothesis sublist (h::t) [] is F by SUBLIST_NIL.
8133 In the conclusion, [] cannot be decomposed, hence implication is valid.
8134 Step case is to prove:
8135 (sublist (h::t) q <=> ?x y. (q = x ++ (h::y)) /\ (sublist t y)) ==>
8136 (sublist (h::t) (h'::q) <=> ?x y. (h'::q = x ++ (h::y)) /\ (sublist t y))
8137 Applying SUBLIST definition and split the if-and-only-if parts, there are 4 cases:
8138 When h = h', if part:
8139 sublist (h::t) (h::q) ==> ?x y. (h::q = x ++ (h::y)) /\ (sublist t y)
8140 For this case, choose x=[], y=q, and sublist (h::t) (h::q) = sublist t q, by SUBLIST same head.
8141 When h = h', only-if part:
8142 ?x y. (h::q = x ++ (h::y)) /\ (sublist t y) ==> sublist (h::t) (h::q)
8143 Take cases on x.
8144 When x = [],
8145 h::q = h::y ==> q = y,
8146 hence sublist t y = sublist t q ==> sublist (h::t) (h::q) by SUBLIST same head.
8147 When x = h''::t',
8148 h::q = (h''::t') ++ (h::y) = h''::(t' ++ (h::y)) ==>
8149 q = t' ++ (h::y),
8150 hence sublist t y ==> sublist t q (by SUBLIST_APPENDR_I) ==> sublist (h::t) (h::q).
8151 When ~(h=h'), if part:
8152 sublist (h::t) (h'::q) ==> ?x y. (h'::q = x ++ (h::y)) /\ (sublist t y)
8153 From hypothesis,
8154 sublist (h::t) (h'::q)
8155 = sublist (h::t) q when ~(h=h'), by SUBLIST definition
8156 ==> ?x1 y1. (q = x1 ++ (h::y1)) /\ (sublist t y1)) by inductive hypothesis
8157 Now (h'::q) = (h'::(x1 ++ (h::y1)) = (h'::x1) ++ (h::y1) by APPEND associativity
8158 So taking x = h'::x1, y = y1, this gives the conclusion.
8159 When ~(h=h'), only-if part:
8160 ?x y. (h'::q = x ++ (h::y)) /\ (sublist t y) ==> sublist (h::t) (h'::q)
8161 The case x = [] is impossible by list equality, since ~(h=h').
8162 Hence x = h'::t', giving:
8163 q = t'++(h::y) /\ (sublist t y)
8164 = sublist (h::t) q by inductive hypothesis (only-if)
8165 ==> sublist (h::t) (h'::q) by SUBLIST, different head.
8166*)
8167Theorem sublist_append_extend:
8168 !h t q. h::t <= q <=> ?x y. (q = x ++ (h::y)) /\ (t <= y)
8169Proof
8170 ntac 2 strip_tac >>
8171 Induct >-
8172 rw[sublist_of_nil] >>
8173 rpt strip_tac >>
8174 (Cases_on `h = h'` >> rw[EQ_IMP_THM]) >| [
8175 (* x is empty and y is the tail: what is left is the assumption
8176 with its head taken off, which sublist_cons says *)
8177 Q.EXISTS_TAC `[]` >> Q.EXISTS_TAC `q` >> fs[GSYM sublist_cons],
8178 `h::t <= h::y` by rw[GSYM sublist_cons] >>
8179 `x ++ [h] ++ y = x ++ (h::y)` by rw[] >>
8180 metis_tac[sublist_append_include],
8181 `h::t <= q` by metis_tac[sublist_def] >>
8182 metis_tac[APPEND, APPEND_ASSOC],
8183 `h::t <= h::y` by rw[GSYM sublist_cons] >>
8184 `x ++ [h] ++ y = x ++ (h::y)` by rw[] >>
8185 metis_tac[sublist_append_include]
8186 ]
8187QED
8188
8189(* ------------------------------------------------------------------------- *)
8190(* Applications of sublist. *)
8191(* ------------------------------------------------------------------------- *)
8192
8193(* Theorem: p <= q ==> (MAP f p) <= (MAP f q) *)
8194(* Proof:
8195 By induction on q.
8196 Base: !p. p <= [] ==> MAP f p <= MAP f []
8197 Note p = [] by sublist_of_nil
8198 and MAP f [] by MAP
8199 so [] <= [] by sublist_nil
8200 Step: !p. p <= q ==> MAP f p <= MAP f q ==>
8201 !h p. p <= h::q ==> MAP f p <= MAP f (h::q)
8202 If p = [], [] <= h::q = F by sublist_def
8203 If p = h'::t,
8204 If h' = h,
8205 Then t <= q by sublist_def, same heads
8206 ==> MAP f t <= MAP f q by induction hypothesis
8207 ==> h::MAP f t <= h::MAP f q by sublist_cons
8208 ==> MAP f (h::t) <= MAP f (h::q) by MAP
8209 or MAP f p <= MAP f (h::q) by p = h::t
8210 If h' <> h,
8211 Then p <= q by sublist_def, different heads
8212 ==> MAP f p <= MAP f q by induction hypothesis
8213 ==> MAP f p <= h::MAP f q by sublist_cons_include
8214 or MAP f p <= MAP f (h::q) by MAP
8215*)
8216Theorem MAP_SUBLIST:
8217 !f p q. p <= q ==> (MAP f p) <= (MAP f q)
8218Proof
8219 strip_tac >>
8220 Induct_on `q` >-
8221 rw[sublist_of_nil, sublist_nil] >>
8222 rpt strip_tac >>
8223 (Cases_on `p` >> simp[sublist_def]) >>
8224 metis_tac[sublist_def, sublist_cons_include, MAP]
8225QED
8226
8227(* Theorem: l1 <= l2 ==> SUM l1 <= SUM l2 *)
8228(* Proof:
8229 By induction on q.
8230 Base: !p. p <= [] ==> SUM p <= SUM []
8231 Note p = [] by sublist_of_nil
8232 and SUM [] = 0 by SUM
8233 Hence true.
8234 Step: !p. p <= q ==> SUM p <= SUM q ==>
8235 !h p. p <= h::q ==> SUM p <= SUM (h::q)
8236 If p = [], [] <= h::q = F by sublist_def
8237 If p = h'::t,
8238 If h' = h,
8239 Then t <= q by sublist_def, same heads
8240 ==> SUM t <= SUM q by induction hypothesis
8241 ==> h + SUM t <= h + SUM q by arithmetic
8242 ==> SUM (h::t) <= SUM (h::q) by SUM
8243 or SUM p <= SUM (h::q) by p = h::t
8244 If h' <> h,
8245 Then p <= q by sublist_def, different heads
8246 ==> SUM p <= SUM q by induction hypothesis
8247 ==> SUM p <= h + SUM q by arithmetic
8248 ==> SUM p <= SUM (h::q) by SUM
8249*)
8250Theorem SUM_SUBLIST:
8251 !p q. p <= q ==> SUM p <= SUM q
8252Proof
8253 Induct_on `q` >-
8254 rw[sublist_of_nil] >>
8255 rpt strip_tac >>
8256 (Cases_on `p` >> fs[sublist_def]) >>
8257 `h' + SUM t <= SUM q` by metis_tac[SUM] >>
8258 decide_tac
8259QED
8260
8261(* Idea: express order-preserving in sublist *)
8262
8263(* Note:
8264A simple statement of order-preserving:
8265
8266g `p <= q /\ MEM x p /\ MEM y p /\ findi x p <= findi y p ==> findi x q <= findi y q`;
8267
8268This simple statement has a counter-example:
8269q = [1;2;3;4;3;5;1]
8270p = [2;4;1]
8271MEM 4 p /\ MEM 1 p /\ findi 4 p = 1 <= findi 1 p = 2, but findi 4 q = 3, yet findi 1 q = 0.
8272This is because findi gives the first appearance of the member.
8273This can be fixed by ALL_DISTINCT, but the idea of order-preserving should not depend on ALL_DISTINCT.
8274*)
8275
8276(* Theorem: sl <= ls /\ MEM x sl ==>
8277 ?l1 l2 l3 l4. ls = l1 ++ [x] ++ l2 /\ sl = l3 ++ [x] ++ l4 /\ l3 <= l1 /\ l4 <= l2 *)
8278(* Proof:
8279 By sublist_induct, this is to show:
8280 (1) MEM x [] ==> ?l1 l2 l3 l4...
8281 Note MEM x [] = F by MEM
8282 hence true.
8283 (2) MEM x sl ==> ?l1 l2 l3 l4... /\ sl <= ls /\ MEM x (h::sl) ==>
8284 ?l1 l2 l3 l4. h::ls = l1 ++ [x] ++ l2 /\ h::sl = l3 ++ [x] ++ l4 /\ l3 <= l1 /\ l4 <= l2
8285 Note MEM x (h::sl)
8286 ==> x = h \/ MEM x sl by MEM
8287 If x = h,
8288 Then h::ls = [h] ++ ls by CONS_APPEND
8289 and h::sl = [h] ++ sl by CONS_APPEND
8290 Pick l1 = [], l2 = ls, l3 = [], l4 = sl.
8291 Then l3 <= l1 since by sublist_nil
8292 and l4 <= l2 since sl <= ls by induction hypothesis
8293 Otherwise, MEM x sl,
8294 Note ?l1 l2 l3 l4.
8295 ls = l1 ++ [x] ++ l2 /\ sl = l3 ++ [x] ++ l4 /\ l3 <= l1 /\ l4 <= l2
8296 by induction hypothesis
8297 Then h::ls = h::(l1 ++ [x] ++ l2)
8298 = h::l1 ++ [x] ++ l2 by APPEND
8299 and h::sl = h::(l3 ++ [x] ++ l4)
8300 = h::l3 ++ [x] ++ l4 by APPEND
8301 Pick new l1 = h::l1, l2 = l2, l3 = h::l3, l4 = l4.
8302 Then l3 <= l1 ==> h::l3 <= h::l1 by sublist_cons
8303 (3) MEM x sl ==> ?l1 l2 l3 l4... /\ sl <= ls /\ MEM x sl ==>
8304 ?l1 l2 l3 l4. h::ls = l1 ++ [x] ++ l2 /\ sl = l3 ++ [x] ++ l4 /\ l3 <= l1 /\ l4 <= l2
8305 Note ?l1 l2 l3 l4.
8306 ls = l1 ++ [x] ++ l2 /\ sl = l3 ++ [x] ++ l4 /\ l3 <= l1 /\ l4 <= l2
8307 by induction hypothesis
8308 Then h::ls = h::(l1 ++ [x] ++ l2)
8309 = h::l1 ++ [x] ++ l2 by APPEND
8310 Pick new l1 = h::l1, l2 = l2, l3 = l3, l4 = l4.
8311 Then l3 <= l1 ==> l3 <= h::l1 by sublist_cons_include
8312*)
8313Theorem sublist_order:
8314 !ls sl x. sl <= ls /\ MEM x sl ==>
8315 ?l1 l2 l3 l4. ls = l1 ++ [x] ++ l2 /\ sl = l3 ++ [x] ++ l4 /\ l3 <= l1 /\ l4 <= l2
8316Proof
8317 rpt strip_tac >>
8318 pop_assum mp_tac >>
8319 pop_assum mp_tac >>
8320 qid_spec_tac `ls` >>
8321 qid_spec_tac `sl` >>
8322 ho_match_mp_tac sublist_induct >>
8323 rpt strip_tac >-
8324 fs[] >-
8325 (fs[] >| [
8326 map_every qexists_tac [`[]`, `ls`, `[]`, `sl`] >>
8327 simp[sublist_nil],
8328 fs[] >>
8329 map_every qexists_tac [`h::l1`, `l2`, `h::l3`, `l4`] >>
8330 simp[GSYM sublist_cons]
8331 ]) >>
8332 fs[] >>
8333 map_every qexists_tac [`h::l1`, `l2`, `l3`, `l4`] >>
8334 simp[sublist_cons_include]
8335QED
8336
8337(* Theorem: sl <= ls /\ MONO_INC ls ==> MONO_INC sl *)
8338(* Proof:
8339 By sublist induction, this is to show:
8340 (1) n < LENGTH [] /\ m <= n ==> EL m [] <= EL n []
8341 Note LENGTH [] = 0 by LENGTH
8342 so assumption is F, hence T.
8343 (2) MONO_INC ls ==> MONO_INC sl /\ sl <= ls /\
8344 MONO_INC (h::ls) /\ m <= n /\ n < LENGTH (h::sl) ==> EL m (h::sl) <= EL n (h::sl)
8345 Note MONO_INC (h::ls) ==> MONO_INC ls by MONO_INC_CONS
8346 If m = 0,
8347 If n = 0,
8348 Then EL 0 (h::sl) = h, hence T.
8349 If 0 < n,
8350 Then 0 <= PRE n,
8351 so EL n (h::sl) = EL (PRE n) sl
8352 Let x = EL 0 sl.
8353 Then x <= EL (PRE n) sl by MONO_INC sl
8354 But MEM x sl by EL_MEM
8355 ==> MEM x ls by sublist_mem
8356 so h <= x by MONO_INC (h::ls)
8357 Thus h <= EL n (h::sl) by inequality
8358 If 0 < m,
8359 Then m <= n means 0 < n.
8360 Thus PRE m <= PRE n
8361 EL m (h::sl)
8362 = EL (PRE m) sl by EL_CONS, 0 < m
8363 <= EL (PRE n) sl by induction hypothesis
8364 = EL n (h::sl) by EL_CONS, 0 < n
8365
8366 (3) MONO_INC ls ==> MONO_INC sl /\ sl <= ls /\
8367 MONO_INC (h::ls) /\ m <= n /\ n < LENGTH sl ==> EL m sl <= EL n sl
8368 Note MONO_INC (h::ls) ==> MONO_INC ls by MONO_INC_CONS
8369 Thus MONO_INC sl by induction hypothesis
8370 so m <= n ==> EL m sl <= EL n sl by MONO_INC sl
8371*)
8372Theorem sublist_MONO_INC:
8373 !ls sl. sl <= ls /\ MONO_INC ls ==> MONO_INC sl
8374Proof
8375 ntac 3 strip_tac >>
8376 pop_assum mp_tac >>
8377 pop_assum mp_tac >>
8378 qid_spec_tac `ls` >>
8379 qid_spec_tac `sl` >>
8380 ho_match_mp_tac sublist_induct >>
8381 rpt strip_tac >-
8382 fs[] >-
8383 (`MONO_INC ls` by metis_tac[MONO_INC_CONS] >>
8384 `m = 0 \/ 0 < m` by decide_tac >| [
8385 `n = 0 \/ 0 < n` by decide_tac >-
8386 simp[] >>
8387 `0 <= PRE n` by decide_tac >>
8388 qabbrev_tac `x = EL 0 sl` >>
8389 `x <= EL (PRE n) sl` by fs[Abbr`x`] >>
8390 `MEM x sl` by fs[EL_MEM, Abbr`x`] >>
8391 `h <= x` by metis_tac[MONO_INC_HD, sublist_mem] >>
8392 simp[EL_CONS],
8393 `0 < n /\ PRE m <= PRE n` by decide_tac >>
8394 `EL (PRE m) sl <= EL (PRE n) sl` by fs[] >>
8395 simp[EL_CONS]
8396 ]) >>
8397 `MONO_INC ls` by metis_tac[MONO_INC_CONS] >>
8398 fs[]
8399QED
8400
8401(* Theorem: sl <= ls /\ MONO_DEC ls ==> MONO_DEC sl *)
8402(* Proof:
8403 By sublist induction, this is to show:
8404 (1) n < LENGTH [] /\ m <= n ==> EL n [] <= EL m []
8405 Note LENGTH [] = 0 by LENGTH
8406 so assumption is F, hence T.
8407 (2) MONO_DEC ls ==> MONO_DEC sl /\ sl <= ls /\
8408 MONO_DEC (h::ls) /\ m <= n /\ n < LENGTH (h::sl) ==> EL n (h::sl) <= EL m (h::sl)
8409 Note MONO_DEC (h::ls) ==> MONO_DEC ls by MONO_DEC_CONS
8410 If m = 0,
8411 If n = 0,
8412 Then EL 0 (h::sl) = h, hence T.
8413 If 0 < n,
8414 Then 0 <= PRE n,
8415 so EL n (h::sl) = EL (PRE n) sl
8416 Let x = EL 0 sl.
8417 Then EL (PRE n) sl <= x by MONO_DEC sl
8418 But MEM x sl by EL_MEM
8419 ==> MEM x ls by sublist_mem
8420 so x <= h by MONO_DEC (h::ls)
8421 Thus EL n (h::sl) <= h by inequality
8422 If 0 < m,
8423 Then m <= n means 0 < n.
8424 Thus PRE m <= PRE n
8425 EL n (h::sl)
8426 = EL (PRE n) sl by EL_CONS, 0 < n
8427 <= EL (PRE m) sl by induction hypothesis
8428 = EL m (h::sl) by EL_CONS, 0 < m
8429
8430 (3) MONO_DEC ls ==> MONO_DEC sl /\ sl <= ls /\
8431 MONO_DEC (h::ls) /\ m <= n /\ n < LENGTH sl ==> EL n sl <= EL m sl
8432 Note MONO_DEC (h::ls) ==> MONO_DEC ls by MONO_DEC_CONS
8433 Thus MONO_DEC sl by induction hypothesis
8434 so m <= n ==> EL n sl <= EL m sl by MONO_DEC sl
8435*)
8436Theorem sublist_MONO_DEC:
8437 !ls sl. sl <= ls /\ MONO_DEC ls ==> MONO_DEC sl
8438Proof
8439 ntac 3 strip_tac >>
8440 pop_assum mp_tac >>
8441 pop_assum mp_tac >>
8442 qid_spec_tac `ls` >>
8443 qid_spec_tac `sl` >>
8444 ho_match_mp_tac sublist_induct >>
8445 rpt strip_tac >-
8446 fs[] >-
8447 (`MONO_DEC ls` by metis_tac[MONO_DEC_CONS] >>
8448 `m = 0 \/ 0 < m` by decide_tac >| [
8449 `n = 0 \/ 0 < n` by decide_tac >-
8450 simp[] >>
8451 `0 <= PRE n` by decide_tac >>
8452 qabbrev_tac `x = EL 0 sl` >>
8453 `EL (PRE n) sl <= x` by fs[Abbr`x`] >>
8454 `MEM x sl` by fs[EL_MEM, Abbr`x`] >>
8455 `x <= h` by metis_tac[MONO_DEC_HD, sublist_mem] >>
8456 simp[EL_CONS],
8457 `0 < n /\ PRE m <= PRE n` by decide_tac >>
8458 `EL (PRE n) sl <= EL (PRE m) sl` by fs[] >>
8459 simp[EL_CONS]
8460 ]) >>
8461 `MONO_DEC ls` by metis_tac[MONO_DEC_CONS] >>
8462 fs[]
8463QED
8464
8465(* Yes, finally! *)
8466
8467(* ------------------------------------------------------------------------- *)
8468(* FILTER as sublist. *)
8469(* ------------------------------------------------------------------------- *)
8470
8471(* Theorem: FILTER P ls <= ls *)
8472(* Proof:
8473 By induction on ls.
8474 Base: FILTER P [] <= [],
8475 Note FILTER P [] = [] by FILTER
8476 and [] <= [] by sublist_refl
8477 Step: FILTER P ls <= ls ==>
8478 !h. FILTER P (h::ls) <= h::ls
8479 If P h,
8480 FILTER P ls <= ls by induction hypothesis
8481 ==> h::FILTER P ls <= h::ls by sublist_cons
8482 ==> FILTER P (h::ls) <= h::ls by FILTER, P h.
8483
8484 If ~P h,
8485 FILTER P ls <= ls by induction hypothesis
8486 ==> FILTER P ls <= h::ls by sublist_cons_include
8487 ==> FILTER P (h::ls) <= h::ls by FILTER, ~P h.
8488*)
8489Theorem FILTER_sublist:
8490 !P ls. FILTER P ls <= ls
8491Proof
8492 strip_tac >>
8493 Induct >-
8494 simp[sublist_refl] >>
8495 rpt strip_tac >>
8496 Cases_on `P h` >-
8497 metis_tac[FILTER, sublist_cons] >>
8498 metis_tac[FILTER, sublist_cons_include]
8499QED
8500
8501(* Theorem: MONO_INC ls ==> MONO_INC (FILTER P ls) *)
8502(* Proof:
8503 Note (FILTER P ls) <= ls by FILTER_sublist
8504 With MONO_INC ls
8505 ==> MONO_INC (FILTER P ls) by sublist_MONO_INC
8506*)
8507Theorem FILTER_MONO_INC:
8508 !P ls. MONO_INC ls ==> MONO_INC (FILTER P ls)
8509Proof
8510 metis_tac[FILTER_sublist, sublist_MONO_INC]
8511QED
8512
8513(* Theorem: MONO_DEC ls ==> MONO_DEC (FILTER P ls) *)
8514(* Proof:
8515 Note (FILTER P ls) <= ls by FILTER_sublist
8516 With MONO_DEC ls
8517 ==> MONO_DEC (FILTER P ls) by sublist_MONO_DEC
8518*)
8519Theorem FILTER_MONO_DEC:
8520 !P ls. MONO_DEC ls ==> MONO_DEC (FILTER P ls)
8521Proof
8522 metis_tac[FILTER_sublist, sublist_MONO_DEC]
8523QED
8524
8525(* ------------------------------------------------------------------------ *)
8526
8527(* Aliases for legacy theorem names *)
8528 val alias =
8529 [
8530 ("ALL_EL_BUTFIRSTN", "EVERY_DROP"),
8531 ("ALL_EL_BUTLASTN", "EVERY_BUTLASTN"),
8532 ("ALL_EL_FIRSTN", "EVERY_TAKE"),
8533 ("ALL_EL_FOLDL", "EVERY_FOLDL"),
8534 ("ALL_EL_FOLDL_MAP", "EVERY_FOLDL_MAP"),
8535 ("ALL_EL_FOLDR", "EVERY_FOLDR"),
8536 ("ALL_EL_FOLDR_MAP", "EVERY_FOLDR_MAP"),
8537 ("ALL_EL_LASTN", "EVERY_LASTN"),
8538 ("ALL_EL_REPLICATE", "EVERY_REPLICATE"),
8539 ("ALL_EL_REVERSE", "EVERY_REVERSE"),
8540 ("ALL_EL_SEG", "EVERY_SEG"),
8541 ("APPEND_BUTLASTN_BUTFIRSTN", "APPEND_BUTLASTN_DROP"),
8542 ("APPEND_FIRSTN_LASTN", "APPEND_TAKE_LASTN"),
8543 ("BUTFIRSTN", "DROP"),
8544 ("BUTFIRSTN_APPEND1", "DROP_APPEND1"),
8545 ("BUTFIRSTN_APPEND2", "DROP_APPEND2"),
8546 ("BUTFIRSTN_BUTFIRSTN", "DROP_DROP"),
8547 ("BUTFIRSTN_CONS_EL", "DROP_CONS_EL"),
8548 ("BUTFIRSTN_LASTN", "DROP_LASTN"),
8549 ("BUTFIRSTN_LENGTH_APPEND", "DROP_LENGTH_APPEND"),
8550 ("BUTFIRSTN_LENGTH_NIL", "DROP_LENGTH_NIL"),
8551 ("BUTFIRSTN_REVERSE", "DROP_REVERSE"),
8552 ("BUTFIRSTN_SEG", "DROP_SEG"),
8553 ("BUTFIRSTN_SNOC", "DROP_SNOC"),
8554 ("BUTLASTN_BUTLAST", "BUTLASTN_FRONT"),
8555 ("BUTLASTN_FIRSTN", "BUTLASTN_TAKE"),
8556 ("BUTLASTN_SUC_BUTLAST", "BUTLASTN_SUC_FRONT"),
8557 ("ELL_IS_EL", "ELL_MEM"),
8558 ("EL_BUTFIRSTN", "EL_DROP"),
8559 ("EL_FIRSTN", "EL_TAKE"),
8560 ("EL_IS_EL", "EL_MEM"),
8561 ("FIRSTN", "TAKE"),
8562 ("FIRSTN_APPEND1", "TAKE_APPEND1"),
8563 ("FIRSTN_APPEND2", "TAKE_APPEND2"),
8564 ("FIRSTN_BUTLASTN", "TAKE_BUTLASTN"),
8565 ("FIRSTN_FIRSTN", "TAKE_TAKE"),
8566 ("FIRSTN_LENGTH_APPEND", "TAKE_LENGTH_APPEND"),
8567 ("FIRSTN_REVERSE", "TAKE_REVERSE"),
8568 ("FIRSTN_SEG", "TAKE_SEG"),
8569 ("FIRSTN_SNOC", "TAKE_SNOC"),
8570 ("IS_EL_BUTFIRSTN", "MEM_DROP_IMP"),
8571 ("IS_EL_BUTLASTN", "MEM_BUTLASTN"),
8572 ("IS_EL_DEF", "MEM_EXISTS"),
8573 ("IS_EL_FIRSTN", "MEM_TAKE"),
8574 ("IS_EL_FOLDL", "MEM_FOLDL"),
8575 ("IS_EL_FOLDL_MAP", "MEM_FOLDL_MAP"),
8576 ("IS_EL_FOLDR", "MEM_FOLDR"),
8577 ("IS_EL_FOLDR_MAP", "MEM_FOLDR_MAP"),
8578 ("IS_EL_LASTN", "MEM_LASTN"),
8579 ("IS_EL_REPLICATE", "MEM_REPLICATE"),
8580 ("IS_EL_SEG", "MEM_SEG"),
8581 ("IS_EL_SOME_EL", "MEM_EXISTS"),
8582 ("LASTN_BUTFIRSTN", "LASTN_DROP"),
8583 ("LENGTH_BUTLAST", "LENGTH_FRONT"),
8584 ("SNOC_EL_FIRSTN", "SNOC_EL_TAKE"),
8585 ("SOME_EL_BUTFIRSTN", "EXISTS_DROP"),
8586 ("SOME_EL_BUTLASTN", "EXISTS_BUTLASTN"),
8587 ("SOME_EL_DISJ", "EXISTS_DISJ"),
8588 ("SOME_EL_FIRSTN", "EXISTS_TAKE"),
8589 ("SOME_EL_FOLDL", "EXISTS_FOLDL"),
8590 ("SOME_EL_FOLDL_MAP", "EXISTS_FOLDL_MAP"),
8591 ("SOME_EL_FOLDR", "EXISTS_FOLDR"),
8592 ("SOME_EL_FOLDR_MAP", "EXISTS_FOLDR_MAP"),
8593 ("SOME_EL_LASTN", "EXISTS_LASTN"),
8594 ("SOME_EL_REVERSE", "EXISTS_REVERSE"),
8595 ("SOME_EL_SEG", "EXISTS_SEG"),
8596 ("ZIP_FIRSTN", "ZIP_TAKE"),
8597 ("ZIP_FIRSTN_LEQ", "ZIP_TAKE_LEQ")
8598 ]
8599
8600 val moved =
8601 [
8602 ("ALL_DISTINCT_SNOC", "ALL_DISTINCT_SNOC"),
8603 ("ALL_EL", "EVERY_DEF"),
8604 ("ALL_EL_APPEND", "EVERY_APPEND"),
8605 ("ALL_EL_CONJ", "EVERY_CONJ"),
8606 ("ALL_EL_SNOC", "EVERY_SNOC"),
8607 ("APPEND", "APPEND"),
8608 ("APPEND_11_LENGTH", "APPEND_11_LENGTH"),
8609 ("APPEND_ASSOC", "APPEND_ASSOC"),
8610 ("APPEND_BUTLAST_LAST", "APPEND_FRONT_LAST"),
8611 ("APPEND_FIRSTN_BUTFIRSTN", "TAKE_DROP"),
8612 ("APPEND_LENGTH_EQ", "APPEND_LENGTH_EQ"),
8613 ("APPEND_SNOC", "APPEND_SNOC"),
8614 ("BUTLAST", "FRONT_SNOC"),
8615 ("BUTLAST_CONS", "FRONT_CONS"),
8616 ("CONS", "CONS"),
8617 ("CONS_11", "CONS_11"),
8618 ("EL", "EL"),
8619 ("EL_DROP", "EL_DROP"),
8620 ("EL_GENLIST", "EL_GENLIST"),
8621 ("EL_LENGTH_SNOC", "EL_LENGTH_SNOC"),
8622 ("EL_MAP", "EL_MAP"),
8623 ("EL_REVERSE", "EL_REVERSE"),
8624 ("EL_SNOC", "EL_SNOC"),
8625 ("EL_TAKE", "EL_TAKE"),
8626 ("EQ_LIST", "EQ_LIST"),
8627 ("EVERY_GENLIST", "EVERY_GENLIST"),
8628 ("EXISTS_GENLIST", "EXISTS_GENLIST"),
8629 ("FILTER", "FILTER"),
8630 ("FILTER_APPEND", "FILTER_APPEND_DISTRIB"),
8631 ("FILTER_REVERSE", "FILTER_REVERSE"),
8632 ("FIRSTN_LENGTH_ID", "TAKE_LENGTH_ID"),
8633 ("FLAT", "FLAT"),
8634 ("FLAT_APPEND", "FLAT_APPEND"),
8635 ("FOLDL", "FOLDL"),
8636 ("FOLDL_SNOC", "FOLDL_SNOC"),
8637 ("FOLDR", "FOLDR"),
8638 ("GENLIST", "GENLIST"),
8639 ("GENLIST_APPEND", "GENLIST_APPEND"),
8640 ("GENLIST_CONS", "GENLIST_CONS"),
8641 ("GENLIST_FUN_EQ", "GENLIST_FUN_EQ"),
8642 ("HD", "HD"),
8643 ("HD_GENLIST", "HD_GENLIST"),
8644 ("IS_EL", "MEM"),
8645 ("IS_EL_APPEND", "MEM_APPEND"),
8646 ("IS_EL_FILTER", "MEM_FILTER"),
8647 ("IS_EL_REVERSE", "MEM_REVERSE"),
8648 ("IS_EL_SNOC", "MEM_SNOC"),
8649 ("LAST", "LAST_SNOC"),
8650 ("LAST_APPEND", "LAST_APPEND_CONS"),
8651 ("LAST_CONS", "LAST_CONS"),
8652 ("LENGTH", "LENGTH"),
8653 ("LENGTH_APPEND", "LENGTH_APPEND"),
8654 ("LENGTH_BUTFIRSTN", "LENGTH_DROP"),
8655 ("LENGTH_CONS", "LENGTH_CONS"),
8656 ("LENGTH_EQ_NIL", "LENGTH_EQ_NIL"),
8657 ("LENGTH_FIRSTN", "LENGTH_TAKE"),
8658 ("LENGTH_GENLIST", "LENGTH_GENLIST"),
8659 ("LENGTH_MAP", "LENGTH_MAP"),
8660 ("LENGTH_NIL", "LENGTH_NIL"),
8661 ("LENGTH_REVERSE", "LENGTH_REVERSE"),
8662 ("LENGTH_SNOC", "LENGTH_SNOC"),
8663 ("LENGTH_ZIP", "LENGTH_ZIP"),
8664 ("LIST_NOT_EQ", "LIST_NOT_EQ"),
8665 ("MAP", "MAP"),
8666 ("MAP2", "MAP2"),
8667 ("MAP2_ZIP", "MAP2_ZIP"),
8668 ("MAP_APPEND", "MAP_APPEND"),
8669 ("MAP_EQ_f", "MAP_EQ_f"),
8670 ("MAP_GENLIST", "MAP_GENLIST"),
8671 ("MAP_MAP_o", "MAP_MAP_o"),
8672 ("MAP_SNOC", "MAP_SNOC"),
8673 ("MAP_o", "MAP_o"),
8674 ("NOT_ALL_EL_SOME_EL", "NOT_EVERY"),
8675 ("NOT_CONS_NIL", "NOT_CONS_NIL"),
8676 ("NOT_EQ_LIST", "NOT_EQ_LIST"),
8677 ("NOT_NIL_CONS", "NOT_NIL_CONS"),
8678 ("NOT_SOME_EL_ALL_EL", "NOT_EXISTS"),
8679 ("NULL", "NULL"),
8680 ("NULL_DEF", "NULL_DEF"),
8681 ("NULL_EQ_NIL", "NULL_EQ"),
8682 (* removed due to conflicts with Tactical.REVERSE:
8683 ("REVERSE", "REVERSE_SNOC_DEF"),
8684 *)
8685 ("REVERSE_APPEND", "REVERSE_APPEND"),
8686 ("REVERSE_EQ_NIL", "REVERSE_EQ_NIL"),
8687 ("REVERSE_REVERSE", "REVERSE_REVERSE"),
8688 ("REVERSE_SNOC", "REVERSE_SNOC"),
8689 ("SNOC", "SNOC"),
8690 ("SNOC_11", "SNOC_11"),
8691 ("SNOC_APPEND", "SNOC_APPEND"),
8692 ("SNOC_Axiom", "SNOC_Axiom"),
8693 ("SNOC_CASES", "SNOC_CASES"),
8694 ("SNOC_INDUCT", "SNOC_INDUCT"),
8695 ("SOME_EL", "EXISTS_DEF"),
8696 ("SOME_EL_APPEND", "EXISTS_APPEND"),
8697 ("SOME_EL_MAP", "EXISTS_MAP"),
8698 ("SOME_EL_SNOC", "EXISTS_SNOC"),
8699 ("SUM", "SUM"),
8700 ("SUM_APPEND", "SUM_APPEND"),
8701 ("SUM_SNOC", "SUM_SNOC"),
8702 ("TL", "TL"),
8703 ("TL_GENLIST", "TL_GENLIST"),
8704 ("UNZIP", "UNZIP"),
8705 ("UNZIP_ZIP", "UNZIP_ZIP"),
8706 ("ZIP", "ZIP"),
8707 ("ZIP_GENLIST", "ZIP_GENLIST"),
8708 ("ZIP_UNZIP", "ZIP_UNZIP")
8709 ]
8710
8711val () = List.app
8712 (fn (s1, s2) => ignore (save_thm(s1, fetch "list" s2)))
8713 moved;
8714
8715val () = List.app
8716 (fn (s1, s2) => ignore (save_thm(s1, theorem s2)))
8717 alias;
8718
8719(* ------------------------------------------------------------------------ *)
8720
8721val () = computeLib.add_persistent_funs
8722 [
8723 "BUTLASTN_compute",
8724 "COUNT_LIST_compute",
8725 "IS_SUBLIST",
8726 "IS_SUFFIX_compute",
8727 "LASTN_compute",
8728 "SEG_compute",
8729 "SPLITP_compute"
8730 ]
8731
8732(*
8733
8734val conv = EVAL
8735
8736 conv ``AND_EL [T;T;T]``;
8737 conv ``BUTLASTN 3 [1n;2;3;4;5]``;
8738 conv ``COUNT_LIST 4``;
8739 conv ``ELL 4 [1n;2;3;4;5;6]``;
8740 conv ``IS_SUBLIST [1n;2;3;4;5] [2;3]``;
8741 conv ``IS_SUFFIX [1n;2;3;4;5] [4;5]``;
8742 conv ``LASTN 3 [1n;2;3;4;5]``;
8743 conv ``LIST_ELEM_COUNT 2 [1n;2;2;3]``;
8744 conv ``OR_EL [T;F;T]``;
8745 conv ``PREFIX (\x. x < 4) [1n;2;3;4;5;6]``;
8746 conv ``REPLICATE 4 [1n;2;3;4;5;6]``;
8747 conv ``SCANL (+) 1 [1n;2;3;4;5;6]``;
8748 conv ``SCANR (+) 1 [1n;2;3;4;5;6]``;
8749 conv ``SEG 2 3 [1n;2;3;4;5]``;
8750 conv ``SPLITL (\x. x > 4) [1n;2;3;4;5;6]``;
8751 conv ``SPLITP (\x. x > 4) [1n;2;3;4;5;6]``;
8752 conv ``SPLITR (\x. x > 4) [1n;2;3;4;5;6]``;
8753 conv ``SUFFIX (\x. x < 4) [1n;2;3]`` (* ??? *);
8754 conv ``TL_T ([]: 'a list)``;
8755 conv ``UNZIP_FST [(1n, 2n); (3, 4)]``;
8756 conv ``UNZIP_SND [(1n, 2n); (3, 4)]``;
8757
8758*)