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