pred_setScript.sml
1(* =====================================================================*)
2(* LIBRARY: pred_set *)
3(* FILE: mk_pred_set.sml *)
4(* DESCRIPTION: a simple theory of predicates-as-sets *)
5(* *)
6(* AUTHOR: T. Kalker *)
7(* DATE: 8 June 1989 *)
8(* *)
9(* REVISED: Tom Melham (extensively revised and extended) *)
10(* DATE: January 1992 *)
11(* =====================================================================*)
12
13Theory pred_set[bare]
14Ancestors
15 numpair pair num prim_rec arithmetic While divides combin
16 relation option
17Libs
18 HolKernel Parse boolLib BasicProvers Prim_rec pairLib numLib
19 hurdUtils tautLib pureSimps metisLib mesonLib simpLib boolSimps
20 TotalDefn pred_setpp[qualified]
21
22open Unicode
23
24val AP = numLib.ARITH_PROVE
25val ARITH_ss = numSimps.ARITH_ss
26val arith_ss = bool_ss ++ ARITH_ss
27val DECIDE = numLib.ARITH_PROVE
28
29val decide_tac = DECIDE_TAC;
30val metis_tac = METIS_TAC;
31val qabbrev_tac = Q.ABBREV_TAC;
32val qid_spec_tac = Q.ID_SPEC_TAC;
33val qexists_tac = Q.EXISTS_TAC;
34val rename1 = Q.RENAME1_TAC;
35
36(* don't eta-contract these; that will force tactics to use one fixed version
37 of srw_ss() *)
38fun fs thl = FULL_SIMP_TAC (srw_ss() ++ ARITH_ss) thl
39fun simp thl = ASM_SIMP_TAC (srw_ss() ++ ARITH_ss) thl
40fun rw thl = SRW_TAC[ARITH_ss]thl
41
42val DISC_RW_KILL = DISCH_TAC >> ONCE_ASM_REWRITE_TAC [] \\
43 POP_ASSUM K_TAC;
44
45(* Automatically generates simplification rules for theorems of the form
46
47 Theorem IN_foo:
48 (_ IN _) = _
49 ...
50
51 See IN_UNION for a concrete example. *)
52local
53 fun add_applied (TheoryDelta.NewBinding (n, (th, {loc, ...}))) = (
54 if not (String.isPrefix "IN_" n) then ()
55 (* {APP,ABS}_applied would be just ⊢ T, so not particularly useful. *)
56 else if List.exists (fn x => x = n) ["IN_APP", "IN_ABS"] then ()
57 else let
58 val stem = String.extract(n,3,NONE)
59 in
60 if isSome (CharVector.find (equal #"_") stem) then ()
61 else
62 case Lib.total (#1 o strip_comb o lhs o #2 o strip_forall o concl) th of
63 NONE => ()
64 | SOME t =>
65 if not (same_const t IN_tm) then ()
66 else let
67 val applied_thm = SIMP_RULE bool_ss [SimpLHS, IN_DEF] th
68 val applied_name = stem ^ "_applied[simp]"
69 val loc' = DB_dtype.inexactify_locn loc
70 in boolLib.save_thm_at loc' (applied_name, applied_thm); () end
71 end)
72 | add_applied _ = ()
73in val _ = Theory.register_hook ("pred_set.add_applied", add_applied) end
74
75Type set = “:'a -> bool”;
76
77local open OpenTheoryMap
78 val ns = ["Set"]
79in
80 fun ot0 x y = OpenTheory_const_name{const={Thy="pred_set",Name=x},name=(ns,y)}
81 fun ot x = ot0 x x
82end
83
84(* =====================================================================*)
85(* Membership. *)
86(* =====================================================================*)
87
88(* ---------------------------------------------------------------------*)
89(* The axiom of specification: x IN {y | P y} iff P x *)
90(* ---------------------------------------------------------------------*)
91
92Theorem SPECIFICATION:
93 !P x. $IN (x:'a) (P:'a set) = P x
94Proof
95 REWRITE_TAC [IN_DEF] THEN BETA_TAC THEN REWRITE_TAC []
96QED
97
98Theorem IN_APP:
99 !x P. (x IN P) = P x
100Proof
101 SIMP_TAC bool_ss [IN_DEF]
102QED
103
104Theorem IN_ABS[simp]:
105 !x P. (x IN \x. P x) = P x
106Proof
107 SIMP_TAC bool_ss [IN_DEF]
108QED
109
110(* ---------------------------------------------------------------------*)
111(* Axiom of extension: (s = t) iff !x. x IN s = x IN t *)
112(* ---------------------------------------------------------------------*)
113
114Theorem EXTENSION:
115 !s t. (s=t) <=> (!x:'a. x IN s <=> x IN t)
116Proof
117 REPEAT GEN_TAC THEN
118 REWRITE_TAC [SPECIFICATION,SYM (FUN_EQ_CONV (“f:'a->'b = g”))]
119QED
120
121Theorem NOT_EQUAL_SETS:
122 !s:'a set. !t. s <> t <=> ?x. x IN t <=> x NOTIN s
123Proof
124 PURE_ONCE_REWRITE_TAC [EXTENSION] THEN
125 CONV_TAC (ONCE_DEPTH_CONV NOT_FORALL_CONV) THEN
126 REPEAT STRIP_TAC THEN EQ_TAC THENL
127 [DISCH_THEN (STRIP_THM_THEN MP_TAC) THEN
128 ASM_CASES_TAC (“(x:'a) IN s”) THEN ASM_REWRITE_TAC [] THEN
129 REPEAT STRIP_TAC THEN EXISTS_TAC (“x:'a”) THEN ASM_REWRITE_TAC[],
130 STRIP_TAC THEN EXISTS_TAC (“x:'a”) THEN
131 ASM_CASES_TAC (“(x:'a) IN s”) THEN ASM_REWRITE_TAC []]
132QED
133
134(* --------------------------------------------------------------------- *)
135(* A theorem from homeier@org.aero.uniblab (Peter Homeier) *)
136(* --------------------------------------------------------------------- *)
137
138Theorem NUM_SET_WOP:
139 !s. (?n. n IN s) = ?n. n IN s /\ (!m. m IN s ==> n <= m)
140Proof
141 REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL
142 [let val th = BETA_RULE (ISPEC (“\n:num. n IN s”) WOP)
143 in IMP_RES_THEN (X_CHOOSE_THEN (“N:num”) STRIP_ASSUME_TAC) th
144 end THEN EXISTS_TAC (“N:num”) THEN CONJ_TAC THENL
145 [FIRST_ASSUM ACCEPT_TAC,
146 GEN_TAC THEN CONV_TAC CONTRAPOS_CONV THEN
147 ASM_REWRITE_TAC [GSYM NOT_LESS]],
148 EXISTS_TAC (“n:num”) THEN FIRST_ASSUM ACCEPT_TAC]
149QED
150
151(* ===================================================================== *)
152(* Generalized set specification. *)
153(* ===================================================================== *)
154Theorem GSPEC_DEF_LEMMA[local]:
155 ?g:('b->('a#bool))-> 'a set.
156 !f. !v:'a. v IN (g f) <=> ?x:'b. (v,T) = f x
157Proof
158 EXISTS_TAC (“\f. \y:'a. ?x:'b. (y,T) = f x”) THEN
159 REPEAT GEN_TAC THEN
160 PURE_ONCE_REWRITE_TAC [SPECIFICATION] THEN
161 CONV_TAC (DEPTH_CONV BETA_CONV) THEN
162 REFL_TAC
163QED
164
165(* --------------------------------------------------------------------- *)
166(* generalized axiom of specification: *)
167(* *)
168(* GSPECIFICATION = |- !f v. v IN (GSPEC f) = (?x. v,T = f x) *)
169(* --------------------------------------------------------------------- *)
170
171val GSPECIFICATION = new_specification
172 ("GSPECIFICATION", ["GSPEC"], GSPEC_DEF_LEMMA);
173
174val _ = TeX_notation {hol = "|", TeX = ("\\HOLTokenBar{}", 1)}
175val _ = ot0 "GSPEC" "specification"
176
177val _ = add_user_printer ("pred_set.GSPEC", ``GSPEC f``)
178
179
180Theorem GSPECIFICATION_applied[simp] =
181 REWRITE_RULE [SPECIFICATION] GSPECIFICATION;
182
183(* --------------------------------------------------------------------- *)
184(* load generalized specification code. *)
185(* --------------------------------------------------------------------- *)
186
187val SET_SPEC_CONV = PGspec.SET_SPEC_CONV GSPECIFICATION;
188
189val SET_SPEC_ss = SSFRAG
190 {name=SOME"SET_SPEC",
191 ac=[], congs=[], dprocs=[], filter=NONE, rewrs=[],
192 convs = [{conv = K (K SET_SPEC_CONV),
193 key = SOME([], ``x IN GSPEC f``),
194 name = "SET_SPEC_CONV", trace = 2}]}
195
196val _ = augment_srw_ss [SET_SPEC_ss]
197
198(* --------------------------------------------------------------------- *)
199(* activate generalized specification parser/pretty-printer. *)
200(* --------------------------------------------------------------------- *)
201(* define_set_abstraction_syntax "GSPEC"; *)
202(* set_flag("print_set",true); *)
203
204val _ = add_rule{term_name = "gspec special", fixity = Closefix,
205 pp_elements = [TOK "{", TM, HardSpace 1, TOK "|",
206 BreakSpace(1,0),TM, TOK "}"],
207 paren_style = OnlyIfNecessary,
208 block_style = (AroundEachPhrase, (PP.CONSISTENT, 0))};
209
210val _ = add_rule{term_name = "gspec2 special", fixity = Closefix,
211 pp_elements = [TOK "{",TM, TOK "|", TM, TOK "|", TM, TOK "}"],
212 paren_style = OnlyIfNecessary,
213 block_style = (AroundEachPhrase, (PP.CONSISTENT, 0))}
214
215Theorem GSPEC_ETA:
216 {x | P x} = P
217Proof
218 SRW_TAC [] [EXTENSION, SPECIFICATION]
219QED
220
221Theorem GSPEC_PAIR_ETA:
222 {(x,y) | P x y} = UNCURRY P
223Proof
224 SRW_TAC [] [EXTENSION, SPECIFICATION] THEN EQ_TAC THEN STRIP_TAC
225 THENL [ ASM_REWRITE_TAC [UNCURRY_DEF],
226 Q.EXISTS_TAC `FST x` THEN
227 Q.EXISTS_TAC `SND x` THEN
228 FULL_SIMP_TAC std_ss [UNCURRY] ]
229QED
230
231Theorem IN_GSPEC_IFF:
232 y IN {x | P x} <=> P y
233Proof
234 REWRITE_TAC [GSPEC_ETA, SPECIFICATION]
235QED
236
237
238Theorem PAIR_IN_GSPEC_IFF:
239 (x,y) IN {(x,y) | P x y} <=> P x y
240Proof
241 REWRITE_TAC [GSPEC_PAIR_ETA, UNCURRY_DEF, SPECIFICATION]
242QED
243
244Theorem IN_GSPEC:
245 !y x P. P y /\ (x = f y) ==> x IN {f x | P x}
246Proof
247 REWRITE_TAC [GSPECIFICATION] THEN REPEAT STRIP_TAC THEN
248 Q.EXISTS_TAC `y` THEN ASM_SIMP_TAC std_ss []
249QED
250
251Theorem PAIR_IN_GSPEC_1:
252 (a,b) IN {(y,x) | y | P y} <=> P a /\ (b = x)
253Proof
254 SIMP_TAC bool_ss [GSPECIFICATION,
255 o_THM, FST, SND, PAIR_EQ] THEN
256 MATCH_ACCEPT_TAC CONJ_COMM
257QED
258
259Theorem PAIR_IN_GSPEC_2:
260 (a,b) IN {(x,y) | y | P y} <=> P b /\ (a = x)
261Proof
262 SIMP_TAC bool_ss [GSPECIFICATION,
263 o_THM, FST, SND, PAIR_EQ] THEN
264 MATCH_ACCEPT_TAC CONJ_COMM
265QED
266
267Theorem PAIR_IN_GSPEC_same:
268 (a,b) IN {(x,x) | P x} <=> P a /\ (a = b)
269Proof
270 SIMP_TAC bool_ss [GSPECIFICATION,
271 o_THM, FST, SND, PAIR_EQ] THEN
272 EQ_TAC THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC []
273QED
274
275(* the phrase "gspec special" is dealt with in the translation from
276 pre-pre-terms to terms *)
277
278(* --------------------------------------------------------------------- *)
279(* A theorem from homeier@org.aero.uniblab (Peter Homeier) *)
280(* --------------------------------------------------------------------- *)
281
282val lemma =
283 TAC_PROOF
284 (([], (“!s x. x IN s ==> !f:'a->'b. (f x) IN {f x | x IN s}”)),
285 REPEAT STRIP_TAC THEN CONV_TAC SET_SPEC_CONV THEN
286 EXISTS_TAC (“x:'a”) THEN ASM_REWRITE_TAC[]);
287
288Theorem SET_MINIMUM:
289 !s:'a -> bool. !M.
290 (?x. x IN s) <=> ?x. x IN s /\ !y. y IN s ==> M x <= M y
291Proof
292 REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL
293 [IMP_RES_THEN (ASSUME_TAC o ISPEC (“M:'a->num”)) lemma THEN
294 let val th = SET_SPEC_CONV (“(n:num) IN {M x | (x:'a) IN s}”)
295 in IMP_RES_THEN (STRIP_ASSUME_TAC o REWRITE_RULE [th]) NUM_SET_WOP
296 end THEN EXISTS_TAC (“x':'a”) THEN CONJ_TAC THENL
297 [FIRST_ASSUM ACCEPT_TAC,
298 FIRST_ASSUM (SUBST_ALL_TAC o SYM) THEN
299 REPEAT STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN
300 EXISTS_TAC (“y:'a”) THEN CONJ_TAC THENL
301 [REFL_TAC, FIRST_ASSUM ACCEPT_TAC]],
302 EXISTS_TAC (“x:'a”) THEN FIRST_ASSUM ACCEPT_TAC]
303QED
304
305
306(* ===================================================================== *)
307(* The empty set *)
308(* ===================================================================== *)
309
310val EMPTY_DEF = new_definition
311 ("EMPTY_DEF", (“EMPTY = (\x:'a.F)”));
312val _ = overload_on (UChar.emptyset, ``pred_set$EMPTY``)
313val _ = TeX_notation {hol = UChar.emptyset, TeX = ("\\HOLTokenEmpty{}", 1)}
314val _ = ot0 "EMPTY" "{}"
315
316Theorem NOT_IN_EMPTY[simp]:
317 !x:'a. ~(x IN EMPTY)
318Proof
319 PURE_REWRITE_TAC [EMPTY_DEF,SPECIFICATION] THEN
320 CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) THEN
321 REPEAT STRIP_TAC
322QED
323
324Theorem MEMBER_NOT_EMPTY:
325 !s:'a set. (?x. x IN s) = ~(s = EMPTY)
326Proof
327 REWRITE_TAC [EXTENSION,NOT_IN_EMPTY] THEN
328 CONV_TAC (ONCE_DEPTH_CONV NOT_FORALL_CONV) THEN
329 REWRITE_TAC [NOT_CLAUSES]
330QED
331
332Theorem EMPTY_applied[simp]:
333 EMPTY x <=> F
334Proof
335 REWRITE_TAC [EMPTY_DEF]
336QED
337
338(* ===================================================================== *)
339(* The set of everything *)
340(* ===================================================================== *)
341
342val UNIV_DEF = new_definition
343 ("UNIV_DEF",(“UNIV = (\x:'a.T)”));
344
345val _ = ot0 "UNIV" "universe"
346
347Theorem IN_UNIV[simp]:
348 !x:'a. x IN UNIV
349Proof
350 GEN_TAC THEN PURE_REWRITE_TAC [UNIV_DEF,SPECIFICATION] THEN
351 CONV_TAC BETA_CONV THEN ACCEPT_TAC TRUTH
352QED
353(* as the above is not an equation, the "magic" at head of file doesn't
354 fire, and we have to manually add: *)
355Theorem UNIV_applied[simp] =
356 REWRITE_RULE[SPECIFICATION] IN_UNIV
357
358Theorem UNIV_NOT_EMPTY[simp]:
359 ~(UNIV:'a set = EMPTY)
360Proof REWRITE_TAC [EXTENSION,IN_UNIV,NOT_IN_EMPTY]
361QED
362
363Theorem EMPTY_NOT_UNIV:
364 ~(EMPTY = (UNIV:'a set))
365Proof
366 REWRITE_TAC [EXTENSION,IN_UNIV,NOT_IN_EMPTY]
367QED
368
369Theorem EQ_UNIV:
370 (!x:'a. x IN s) = (s = UNIV)
371Proof
372 REWRITE_TAC [EXTENSION,IN_UNIV]
373QED
374
375Theorem IN_EQ_UNIV_IMP:
376 !s. (s = UNIV) ==> !v. (v : 'a) IN s
377Proof
378 RW_TAC std_ss [IN_UNIV]
379QED
380
381Overload univ = ``\x:'a itself. UNIV : 'a set``
382val _ = set_fixity "univ" (Prefix 2200)
383
384val _ = overload_on (UnicodeChars.universal_set, ``\x:'a itself. UNIV: 'a set``)
385val _ = set_fixity UnicodeChars.universal_set (Prefix 2200)
386(* the overloads above are only for parsing; printing for this is handled
387 with a user-printer. (Otherwise the fact that the x is not bound in the
388 abstraction produces ARB terms.) To turn printing off, we overload the
389 same pattern to "" *)
390Overload "" = “\x:'a itself. UNIV : 'a set”
391
392val _ = add_ML_dependency "pred_setpp"
393val _ = add_user_printer ("pred_set.UNIV", ``UNIV:'a set``)
394
395val _ = TeX_notation {hol = "univ", TeX = ("\\ensuremath{{\\cal{U}}}", 1)}
396val _ = TeX_notation {hol = UnicodeChars.universal_set,
397 TeX = ("\\ensuremath{{\\cal{U}}}", 1)}
398
399
400(* ===================================================================== *)
401(* Set inclusion. *)
402(* ===================================================================== *)
403
404Definition SUBSET_DEF[nocompute]:
405 $SUBSET s t = !x:'a. x IN s ==> x IN t
406End
407val _ = set_fixity "SUBSET" (Infix(NONASSOC, 450))
408val _ = unicode_version { u = UChar.subset, tmnm = "SUBSET"};
409val _ = TeX_notation {hol = "SUBSET", TeX = ("\\HOLTokenSubset{}", 1)}
410val _ = TeX_notation {hol = UChar.subset, TeX = ("\\HOLTokenSubset{}", 1)}
411val _ = ot0 "SUBSET" "subset"
412
413Theorem SUBSET_THM:
414 !(P : 'a -> bool) Q. P SUBSET Q ==> (!x. x IN P ==> x IN Q)
415Proof
416 RW_TAC std_ss [SUBSET_DEF]
417QED
418
419Theorem SUBSET_applied = SIMP_RULE bool_ss [IN_DEF] SUBSET_DEF;
420
421Theorem SUBSET_TRANS:
422 !(s:'a set) t u. s SUBSET t /\ t SUBSET u ==> s SUBSET u
423Proof
424 REWRITE_TAC [SUBSET_DEF] THEN
425 REPEAT STRIP_TAC THEN
426 REPEAT (FIRST_ASSUM MATCH_MP_TAC) THEN
427 FIRST_ASSUM ACCEPT_TAC
428QED
429
430Theorem SUBSET_transitive[simp]:
431 transitive (SUBSET)
432Proof
433 METIS_TAC[transitive_def, SUBSET_TRANS]
434QED
435
436Theorem SUBSET_REFL[simp]:
437 !(s:'a set). s SUBSET s
438Proof REWRITE_TAC[SUBSET_DEF]
439QED
440
441Theorem SUBSET_reflexive[simp]:
442 reflexive (SUBSET)
443Proof SRW_TAC[][reflexive_def]
444QED
445
446(* would prefer to avoid the _THM suffix but the names without are already
447 claimed by relationTheory for thms of the form R x y ==> OP R x y *)
448Theorem RC_SUBSET_THM[simp]:
449 RC(SUBSET) = (SUBSET)
450Proof
451 simp[reflexive_RC_identity]
452QED
453
454Theorem TC_SUBSET_THM[simp]:
455 TC(SUBSET) = (SUBSET)
456Proof
457 SRW_TAC[][transitive_TC_identity]
458QED
459
460Theorem RTC_SUBSET_THM[simp]:
461 RTC (SUBSET) = (SUBSET)
462Proof
463 simp[GSYM TC_RC_EQNS]
464QED
465
466Theorem SUBSET_ANTISYM:
467 !(s:'a set) t. (s SUBSET t) /\ (t SUBSET s) ==> (s = t)
468Proof
469 REWRITE_TAC [SUBSET_DEF, EXTENSION] THEN
470 REPEAT STRIP_TAC THEN
471 EQ_TAC THEN
472 FIRST_ASSUM MATCH_ACCEPT_TAC
473QED
474
475Theorem EMPTY_SUBSET[simp]:
476 !s:'a set. EMPTY SUBSET s
477Proof REWRITE_TAC [SUBSET_DEF,NOT_IN_EMPTY]
478QED
479
480Theorem SUBSET_EMPTY[simp]:
481 !s:'a set. s SUBSET EMPTY <=> (s = EMPTY)
482Proof
483 PURE_REWRITE_TAC [SUBSET_DEF,NOT_IN_EMPTY] THEN
484 REWRITE_TAC [EXTENSION,NOT_IN_EMPTY]
485QED
486
487Theorem SUBSET_UNIV[simp]:
488 !s:'a set. s SUBSET UNIV
489Proof
490 REWRITE_TAC [SUBSET_DEF,IN_UNIV]
491QED
492
493Theorem UNIV_SUBSET[simp]:
494 !s:'a set. UNIV SUBSET s <=> (s = UNIV)
495Proof REWRITE_TAC [SUBSET_DEF,IN_UNIV,EXTENSION]
496QED
497
498Theorem EQ_SUBSET_SUBSET:
499 !(s :'a -> bool) t. (s = t) ==> s SUBSET t /\ t SUBSET s
500Proof
501 RW_TAC std_ss [SUBSET_DEF, EXTENSION]
502QED
503
504Theorem SUBSET_ANTISYM_EQ : (* from HOL Light *)
505 !(s:'a set) t. (s SUBSET t) /\ (t SUBSET s) <=> (s = t)
506Proof
507 REPEAT GEN_TAC THEN EQ_TAC THENL
508 [REWRITE_TAC [SUBSET_ANTISYM],
509 REWRITE_TAC [EQ_SUBSET_SUBSET]]
510QED
511
512Theorem SET_EQ_SUBSET = GSYM SUBSET_ANTISYM_EQ;
513
514Theorem SUBSET_ADD:
515 !f n d.
516 (!n. f n SUBSET f (SUC n)) ==>
517 f n SUBSET f (n + d)
518Proof
519 RW_TAC std_ss []
520 >> Induct_on `d` >- RW_TAC arith_ss [SUBSET_REFL]
521 >> RW_TAC std_ss [ADD_CLAUSES]
522 >> MATCH_MP_TAC SUBSET_TRANS
523 >> Q.EXISTS_TAC `f (n + d)`
524 >> RW_TAC std_ss []
525QED
526
527Theorem K_SUBSET:
528 !x y. K x SUBSET y <=> ~x \/ (UNIV SUBSET y)
529Proof
530 RW_TAC std_ss [K_DEF, SUBSET_DEF, IN_UNIV]
531 >> RW_TAC std_ss [SPECIFICATION]
532 >> PROVE_TAC []
533QED
534
535Theorem SUBSET_K:
536 !x y. x SUBSET K y <=> (x SUBSET EMPTY) \/ y
537Proof
538 RW_TAC std_ss [K_DEF, SUBSET_DEF, NOT_IN_EMPTY]
539 >> RW_TAC std_ss [SPECIFICATION]
540 >> PROVE_TAC []
541QED
542
543(* ===================================================================== *)
544(* Proper subset. *)
545(* ===================================================================== *)
546
547Definition PSUBSET_DEF[nocompute]:
548 PSUBSET (s:'a set) t <=> s SUBSET t /\ ~(s = t)
549End
550val _ = set_fixity "PSUBSET" (Infix(NONASSOC, 450))
551val _ = unicode_version { u = UTF8.chr 0x2282, tmnm = "PSUBSET"}
552val _ = TeX_notation {hol = "PSUBSET", TeX = ("\\HOLTokenPSubset", 1)}
553val _ = TeX_notation {hol = UTF8.chr 0x2282, TeX = ("\\HOLTokenPSubset", 1)}
554val _ = ot0 "PSUBSET" "properSubset"
555
556Theorem PSUBSET_TRANS:
557 !s:'a set. !t u. (s PSUBSET t /\ t PSUBSET u) ==> (s PSUBSET u)
558Proof
559 PURE_ONCE_REWRITE_TAC [PSUBSET_DEF] THEN
560 REPEAT GEN_TAC THEN STRIP_TAC THEN CONJ_TAC THENL [
561 IMP_RES_TAC SUBSET_TRANS,
562 DISCH_THEN SUBST_ALL_TAC THEN
563 IMP_RES_TAC SUBSET_ANTISYM THEN
564 RES_TAC
565 ]
566QED
567
568Theorem transitive_PSUBSET[simp]:
569 transitive (PSUBSET)
570Proof
571 METIS_TAC[transitive_def, PSUBSET_TRANS]
572QED
573
574Theorem PSUBSET_IRREFL[simp]:
575 !s:'a set. ~(s PSUBSET s)
576Proof
577 REWRITE_TAC [PSUBSET_DEF,SUBSET_REFL]
578QED
579
580Theorem RC_PSUBSET[simp]:
581 RC (PSUBSET) = (SUBSET)
582Proof
583 simp[PSUBSET_DEF, Ntimes FUN_EQ_THM 2, RC_DEF, EQ_IMP_THM,
584 DISJ_IMP_THM]
585QED
586
587Theorem TC_PSUBSET[simp]:
588 TC (PSUBSET) = (PSUBSET)
589Proof
590 simp[transitive_TC_identity]
591QED
592
593Theorem RTC_PSUBSET[simp]:
594 RTC (PSUBSET) = (SUBSET)
595Proof
596 simp[GSYM TC_RC_EQNS]
597QED
598
599Theorem NOT_PSUBSET_EMPTY[simp]:
600 !s:'a set. ~(s PSUBSET EMPTY)
601Proof
602 REWRITE_TAC [PSUBSET_DEF,SUBSET_EMPTY,NOT_AND]
603QED
604
605Theorem NOT_UNIV_PSUBSET[simp]:
606 !s:'a set. ~(UNIV PSUBSET s)
607Proof
608 REWRITE_TAC [PSUBSET_DEF,UNIV_SUBSET,DE_MORGAN_THM] THEN
609 METIS_TAC[]
610QED
611
612Theorem PSUBSET_UNIV:
613 !s:'a set. (s PSUBSET UNIV) = ?x:'a. ~(x IN s)
614Proof
615 REWRITE_TAC [PSUBSET_DEF,SUBSET_UNIV,EXTENSION,IN_UNIV] THEN
616 CONV_TAC (ONCE_DEPTH_CONV NOT_FORALL_CONV) THEN GEN_TAC THEN REFL_TAC
617QED
618
619(* ===================================================================== *)
620(* Union *)
621(* ===================================================================== *)
622
623val UNION_DEF = new_infixl_definition
624 ("UNION_DEF", (“UNION s t = {x:'a | x IN s \/ x IN t}”),500);
625val _ = unicode_version{ u = UChar.union, tmnm = "UNION"}
626val _ = TeX_notation {hol = "UNION", TeX = ("\\HOLTokenUnion{}", 1)}
627val _ = TeX_notation {hol = UChar.union, TeX = ("\\HOLTokenUnion{}", 1)}
628val _ = ot0 "UNION" "union"
629
630(* The hook at the top of the file generates the theorem
631 [UNION_applied] ⊢ ∀s t x. (s ∪ t) x ⇔ x ∈ s ∨ x ∈ t
632 and adds it to the simpset, since IN_UNION matches the shape described above. *)
633Theorem IN_UNION[simp]:
634 !s t (x:'a). x IN (s UNION t) <=> x IN s \/ x IN t
635Proof
636 PURE_ONCE_REWRITE_TAC [UNION_DEF] THEN
637 CONV_TAC (ONCE_DEPTH_CONV SET_SPEC_CONV) THEN
638 REPEAT GEN_TAC THEN REFL_TAC
639QED
640
641Theorem UNION_ASSOC:
642 !(s:'a set) t u. s UNION (t UNION u) = (s UNION t) UNION u
643Proof
644 REWRITE_TAC [EXTENSION, IN_UNION] THEN
645 REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN
646 ASM_REWRITE_TAC[]
647QED
648
649Theorem UNION_IDEMPOT:
650 !(s:'a set). s UNION s = s
651Proof
652 REWRITE_TAC[EXTENSION, IN_UNION]
653QED
654
655Theorem UNION_COMM:
656 !(s:'a set) t. s UNION t = t UNION s
657Proof
658 REWRITE_TAC[EXTENSION, IN_UNION] THEN
659 REPEAT GEN_TAC THEN MATCH_ACCEPT_TAC DISJ_SYM
660QED
661
662Theorem SUBSET_UNION:
663 (!s:'a set. !t. s SUBSET (s UNION t)) /\
664 (!s:'a set. !t. s SUBSET (t UNION s))
665Proof
666 PURE_REWRITE_TAC [SUBSET_DEF,IN_UNION] THEN
667 REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]
668QED
669
670Theorem UNION_SUBSET:
671 !s t u. (s UNION t) SUBSET u <=> s SUBSET u /\ t SUBSET u
672Proof PROVE_TAC [IN_UNION, SUBSET_DEF]
673QED
674
675Theorem SUBSET_UNION_ABSORPTION:
676 !s:'a set. !t. s SUBSET t <=> (s UNION t = t)
677Proof
678 REWRITE_TAC [SUBSET_DEF,EXTENSION,IN_UNION] THEN
679 REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL
680 [RES_TAC,ASM_REWRITE_TAC[],RES_TAC]
681QED
682
683Theorem UNION_EMPTY[simp]:
684 (!s:'a set. EMPTY UNION s = s) /\
685 (!s:'a set. s UNION EMPTY = s)
686Proof
687 REWRITE_TAC [IN_UNION,EXTENSION,NOT_IN_EMPTY]
688QED
689
690
691Theorem UNION_UNIV[simp]:
692 (!s:'a set. UNIV UNION s = UNIV) /\
693 (!s:'a set. s UNION UNIV = UNIV)
694Proof
695 REWRITE_TAC [IN_UNION,EXTENSION,IN_UNIV]
696QED
697
698
699Theorem EMPTY_UNION[simp]:
700 !s:'a set. !t. (s UNION t = EMPTY) = ((s = EMPTY) /\ (t = EMPTY))
701Proof
702 REWRITE_TAC [EXTENSION,NOT_IN_EMPTY,IN_UNION,DE_MORGAN_THM] THEN
703 REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN RES_TAC
704QED
705
706(* from probability/iterateTheory *)
707Theorem FORALL_IN_UNION:
708 !P s t:'a->bool. (!x. x IN s UNION t ==> P x) <=>
709 (!x. x IN s ==> P x) /\ (!x. x IN t ==> P x)
710Proof
711 REWRITE_TAC [IN_UNION] THEN PROVE_TAC []
712QED
713
714(* ===================================================================== *)
715(* Intersection *)
716(* ===================================================================== *)
717
718val INTER_DEF = new_infixl_definition
719 ("INTER_DEF",
720 (“INTER s t = {x:'a | x IN s /\ x IN t}”), 600);
721val _ = unicode_version{ u = UChar.inter, tmnm = "INTER"};
722val _ = TeX_notation {hol = "INTER", TeX = ("\\HOLTokenInter{}", 1)}
723val _ = TeX_notation {hol = UChar.inter, TeX = ("\\HOLTokenInter{}", 1)}
724val _ = ot0 "INTER" "intersect"
725
726Theorem IN_INTER[simp]:
727 !s t (x:'a). x IN (s INTER t) <=> x IN s /\ x IN t
728Proof
729 PURE_ONCE_REWRITE_TAC [INTER_DEF] THEN
730 CONV_TAC (ONCE_DEPTH_CONV SET_SPEC_CONV) THEN
731 REPEAT GEN_TAC THEN REFL_TAC
732QED
733
734Theorem INTER_ASSOC:
735 !(s:'a set) t u. s INTER (t INTER u) = (s INTER t) INTER u
736Proof
737 REWRITE_TAC [EXTENSION, IN_INTER, CONJ_ASSOC]
738QED
739
740Theorem INTER_IDEMPOT:
741 !(s:'a set). s INTER s = s
742Proof
743 REWRITE_TAC[EXTENSION, IN_INTER]
744QED
745
746Theorem INTER_COMM:
747 !(s:'a set) t. s INTER t = t INTER s
748Proof
749 REWRITE_TAC[EXTENSION, IN_INTER] THEN
750 REPEAT GEN_TAC THEN
751 MATCH_ACCEPT_TAC CONJ_SYM
752QED
753
754Theorem INTER_SUBSET:
755 (!s:'a set. !t. (s INTER t) SUBSET s) /\
756 (!s:'a set. !t. (t INTER s) SUBSET s)
757Proof
758 PURE_REWRITE_TAC [SUBSET_DEF,IN_INTER] THEN
759 REPEAT STRIP_TAC
760QED
761
762Theorem SUBSET_INTER:
763 !s t u. s SUBSET (t INTER u) <=> s SUBSET t /\ s SUBSET u
764Proof PROVE_TAC [IN_INTER, SUBSET_DEF]
765QED
766
767Theorem SUBSET_INTER_ABSORPTION:
768 !s:'a set. !t. s SUBSET t <=> (s INTER t = s)
769Proof
770 REWRITE_TAC [SUBSET_DEF,EXTENSION,IN_INTER] THEN
771 REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL
772 [FIRST_ASSUM ACCEPT_TAC, RES_TAC, RES_TAC]
773QED
774
775Theorem SUBSET_INTER1:
776 !s t. s SUBSET t ==> (s INTER t = s)
777Proof
778 RW_TAC std_ss [EXTENSION,GSPECIFICATION,SUBSET_DEF, IN_INTER]
779 >> PROVE_TAC []
780QED
781
782Theorem SUBSET_INTER2:
783 !s t. s SUBSET t ==> (t INTER s = s)
784Proof
785 RW_TAC std_ss [EXTENSION,GSPECIFICATION,SUBSET_DEF, IN_INTER]
786 >> PROVE_TAC []
787QED
788
789Theorem INTER_EMPTY[simp]:
790 (!s:'a set. EMPTY INTER s = EMPTY) /\
791 (!s:'a set. s INTER EMPTY = EMPTY)
792Proof
793 REWRITE_TAC [IN_INTER,EXTENSION,NOT_IN_EMPTY]
794QED
795
796
797Theorem INTER_UNIV:
798 (!s:'a set. UNIV INTER s = s) /\
799 (!s:'a set. s INTER UNIV = s)
800Proof
801 REWRITE_TAC [IN_INTER,EXTENSION,IN_UNIV]
802QED
803
804(* ===================================================================== *)
805(* Distributivity *)
806(* ===================================================================== *)
807
808Theorem UNION_OVER_INTER:
809 !s:'a set. !t u.
810 s INTER (t UNION u) = (s INTER t) UNION (s INTER u)
811Proof
812 REWRITE_TAC [EXTENSION,IN_INTER,IN_UNION] THEN
813 REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN
814 ASM_REWRITE_TAC[]
815QED
816
817Theorem INTER_OVER_UNION:
818 !s:'a set. !t u.
819 s UNION (t INTER u) = (s UNION t) INTER (s UNION u)
820Proof
821 REWRITE_TAC [EXTENSION,IN_INTER,IN_UNION] THEN
822 REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN
823 ASM_REWRITE_TAC[]
824QED
825
826(* ===================================================================== *)
827(* Disjoint sets. *)
828(* ===================================================================== *)
829
830val DISJOINT_DEF = new_definition ("DISJOINT_DEF",
831(“DISJOINT (s:'a set) t = ((s INTER t) = EMPTY)”));
832
833Theorem IN_DISJOINT:
834 !s:'a set. !t. DISJOINT s t = ~(?x. x IN s /\ x IN t)
835Proof
836 REWRITE_TAC [DISJOINT_DEF,EXTENSION,IN_INTER,NOT_IN_EMPTY] THEN
837 CONV_TAC (ONCE_DEPTH_CONV NOT_EXISTS_CONV) THEN
838 REPEAT GEN_TAC THEN REFL_TAC
839QED
840
841Theorem DISJOINT_SYM:
842 !s:'a set. !t. DISJOINT s t = DISJOINT t s
843Proof
844 PURE_ONCE_REWRITE_TAC [DISJOINT_DEF] THEN REPEAT GEN_TAC THEN
845 SUBST1_TAC (SPECL [“s:'a set”, “t:'a set”] INTER_COMM) THEN
846 REFL_TAC
847QED
848
849Theorem DISJOINT_ALT:
850 !s t. DISJOINT s t = !x. x IN s ==> ~(x IN t)
851Proof
852 RW_TAC std_ss [IN_DISJOINT]
853 >> PROVE_TAC []
854QED
855
856Theorem DISJOINT_ALT' :
857 !s t. DISJOINT s t <=> !x. x IN t ==> x NOTIN s
858Proof
859 ONCE_REWRITE_TAC [DISJOINT_SYM]
860 >> RW_TAC std_ss [IN_DISJOINT]
861 >> PROVE_TAC []
862QED
863
864(* --------------------------------------------------------------------- *)
865(* A theorem from homeier@org.aero.uniblab (Peter Homeier) *)
866(* --------------------------------------------------------------------- *)
867Theorem DISJOINT_EMPTY:
868 !s:'a set. DISJOINT EMPTY s /\ DISJOINT s EMPTY
869Proof
870 REWRITE_TAC [DISJOINT_DEF,INTER_EMPTY]
871QED
872
873Theorem DISJOINT_EMPTY_REFL:
874 !s:'a set. (s = EMPTY) = (DISJOINT s s)
875Proof
876 REWRITE_TAC [DISJOINT_DEF,INTER_IDEMPOT]
877QED
878Theorem DISJOINT_EMPTY_REFL_RWT =
879 ONCE_REWRITE_RULE [EQ_SYM_EQ] DISJOINT_EMPTY_REFL
880
881(* --------------------------------------------------------------------- *)
882(* A theorem from homeier@org.aero.uniblab (Peter Homeier) *)
883(* --------------------------------------------------------------------- *)
884Theorem DISJOINT_UNION:
885 !(s:'a set) t u. DISJOINT (s UNION t) u <=> DISJOINT s u /\ DISJOINT t u
886Proof
887 REWRITE_TAC [IN_DISJOINT,IN_UNION] THEN
888 CONV_TAC (ONCE_DEPTH_CONV NOT_EXISTS_CONV) THEN
889 CONV_TAC (ONCE_DEPTH_CONV AND_FORALL_CONV) THEN
890 REWRITE_TAC [DE_MORGAN_THM,RIGHT_AND_OVER_OR] THEN
891 REPEAT GEN_TAC THEN EQ_TAC THEN
892 DISCH_THEN(fn th => GEN_TAC THEN
893 STRIP_ASSUME_TAC (SPEC (“x:'a”) th)) THEN
894 ASM_REWRITE_TAC []
895QED
896
897Theorem DISJOINT_UNION' :
898 !s t u. DISJOINT u (s UNION t) <=> DISJOINT u s /\ DISJOINT u t
899Proof
900 ONCE_REWRITE_TAC [DISJOINT_SYM]
901 >> REWRITE_TAC [DISJOINT_UNION]
902QED
903
904Theorem DISJOINT_UNION_BOTH:
905 !s t u:'a set.
906 (DISJOINT (s UNION t) u <=> DISJOINT s u /\ DISJOINT t u) /\
907 (DISJOINT u (s UNION t) <=> DISJOINT s u /\ DISJOINT t u)
908Proof PROVE_TAC [DISJOINT_UNION, DISJOINT_SYM]
909QED
910
911Theorem DISJOINT_SUBSET :
912 !s t u. DISJOINT s t /\ u SUBSET t ==> DISJOINT s u
913Proof
914 REWRITE_TAC [DISJOINT_DEF, SUBSET_DEF, IN_INTER, NOT_IN_EMPTY,
915 EXTENSION] THEN
916 PROVE_TAC []
917QED
918
919Theorem SUBSET_DISJOINT :
920 !s t u v. DISJOINT s t /\ u SUBSET s /\ v SUBSET t ==> DISJOINT u v
921Proof
922 RW_TAC std_ss [DISJOINT_ALT]
923 >> `x IN s` by PROVE_TAC [SUBSET_DEF]
924 >> CCONTR_TAC >> fs []
925 >> `x IN t` by PROVE_TAC [SUBSET_DEF]
926 >> RES_TAC
927QED
928
929Theorem DISJOINT_SUBSET' :
930 !s t u. DISJOINT s t /\ u SUBSET s ==> DISJOINT u t
931Proof
932 rpt STRIP_TAC
933 >> MATCH_MP_TAC SUBSET_DISJOINT
934 >> Q.EXISTS_TAC ‘s’
935 >> Q.EXISTS_TAC ‘t’
936 >> ASM_REWRITE_TAC [SUBSET_REFL]
937QED
938
939(* ===================================================================== *)
940(* Set difference *)
941(* ===================================================================== *)
942
943val DIFF_DEF = new_infixl_definition
944 ("DIFF_DEF",
945 (“DIFF s t = {x:'a | x IN s /\ ~ (x IN t)}”),500);
946val _ = ot0 "DIFF" "difference"
947
948Theorem IN_DIFF[simp]:
949 !(s:'a set) t x. x IN (s DIFF t) <=> x IN s /\ x NOTIN t
950Proof
951 REPEAT GEN_TAC THEN
952 PURE_ONCE_REWRITE_TAC [DIFF_DEF] THEN
953 CONV_TAC (ONCE_DEPTH_CONV SET_SPEC_CONV) THEN
954 REFL_TAC
955QED
956
957Theorem DIFF_EMPTY:
958 !s:'a set. s DIFF EMPTY = s
959Proof
960 GEN_TAC THEN
961 REWRITE_TAC [NOT_IN_EMPTY,IN_DIFF,EXTENSION]
962QED
963
964Theorem EMPTY_DIFF[simp]:
965 !s:'a set. EMPTY DIFF s = EMPTY
966Proof
967 GEN_TAC THEN
968 REWRITE_TAC [NOT_IN_EMPTY,IN_DIFF,EXTENSION]
969QED
970
971Theorem DIFF_UNIV:
972 !s:'a set. s DIFF UNIV = EMPTY
973Proof
974 GEN_TAC THEN
975 REWRITE_TAC [NOT_IN_EMPTY,IN_DIFF,IN_UNIV,EXTENSION]
976QED
977
978Theorem DIFF_DIFF:
979 !s:'a set. !t. (s DIFF t) DIFF t = s DIFF t
980Proof
981 REWRITE_TAC [EXTENSION,IN_DIFF,SYM(SPEC_ALL CONJ_ASSOC)]
982QED
983
984Theorem DIFF_EQ_EMPTY:
985 !s:'a set. s DIFF s = EMPTY
986Proof
987 REWRITE_TAC [EXTENSION,IN_DIFF,NOT_IN_EMPTY,DE_MORGAN_THM] THEN
988 PURE_ONCE_REWRITE_TAC [DISJ_SYM] THEN
989 REWRITE_TAC [EXCLUDED_MIDDLE]
990QED
991
992Theorem DIFF_SUBSET:
993 !s t. (s DIFF t) SUBSET s
994Proof
995 REWRITE_TAC [SUBSET_DEF, IN_DIFF] THEN PROVE_TAC []
996QED
997
998Theorem UNION_DIFF:
999 s SUBSET t ==> (s UNION (t DIFF s) = t) /\ ((t DIFF s) UNION s = t)
1000Proof
1001 SRW_TAC [][EXTENSION, SUBSET_DEF] THEN PROVE_TAC []
1002QED
1003
1004Theorem DIFF_DIFF_SUBSET: !s t. (t SUBSET s) ==> (s DIFF (s DIFF t) = t)
1005Proof
1006 RW_TAC std_ss [DIFF_DEF,IN_INTER,EXTENSION,GSPECIFICATION,SUBSET_DEF]
1007 >> EQ_TAC >- RW_TAC std_ss []
1008 >> RW_TAC std_ss []
1009QED
1010
1011Theorem DIFF_UNION:
1012 !x y z. x DIFF (y UNION z) = x DIFF y DIFF z
1013Proof
1014SRW_TAC[][EXTENSION] THEN METIS_TAC[]
1015QED
1016
1017Theorem UNION_DIFF_EQ[simp]:
1018 (!s t. ((s:'a -> bool) UNION (t DIFF s)) = (s UNION t))
1019 /\ !s t. ((t DIFF s) UNION (s:'a -> bool)) = (t UNION s)
1020Proof
1021 rw[EXTENSION,EQ_IMP_THM,DIFF_DEF]
1022 >> fs[]
1023QED
1024
1025Theorem DIFF_COMM:
1026 !x y z. x DIFF y DIFF z = x DIFF z DIFF y
1027Proof
1028SRW_TAC[][EXTENSION] THEN METIS_TAC[]
1029QED
1030
1031Theorem DIFF_SAME_UNION:
1032 !x y. ((x UNION y) DIFF x = y DIFF x) /\ ((x UNION y) DIFF y = x DIFF y)
1033Proof
1034SRW_TAC[][EXTENSION,EQ_IMP_THM]
1035QED
1036
1037Theorem DIFF_INTER: !s t g. (s DIFF t) INTER g = s INTER g DIFF t
1038Proof
1039 RW_TAC std_ss [DIFF_DEF,INTER_DEF,EXTENSION]
1040 >> RW_TAC std_ss [GSPECIFICATION]
1041 >> EQ_TAC >- RW_TAC std_ss [] >> RW_TAC std_ss []
1042QED
1043
1044Theorem DIFF_INTER2: !s t. s DIFF (t INTER s) = s DIFF t
1045Proof
1046 RW_TAC std_ss [DIFF_DEF,INTER_DEF,EXTENSION]
1047 >> RW_TAC std_ss [GSPECIFICATION,LEFT_AND_OVER_OR]
1048QED
1049
1050Theorem DISJOINT_DIFF: !s t. DISJOINT t (s DIFF t) /\ DISJOINT (s DIFF t) t
1051Proof
1052 RW_TAC std_ss [EXTENSION, DISJOINT_DEF, IN_INTER, NOT_IN_EMPTY, IN_DIFF]
1053 >> METIS_TAC []
1054QED
1055
1056Theorem DISJOINT_DIFFS:
1057 !f g m n.
1058 (!n. f n SUBSET f (SUC n)) /\
1059 (!n. g n = f (SUC n) DIFF f n) /\ ~(m = n) ==>
1060 DISJOINT (g m) (g n)
1061Proof
1062 RW_TAC std_ss []
1063 >> Know `SUC m <= n \/ SUC n <= m` >- DECIDE_TAC
1064 >> REWRITE_TAC [LESS_EQ_EXISTS]
1065 >> STRIP_TAC >|
1066 [Know `f (SUC m) SUBSET f n` >- PROVE_TAC [SUBSET_ADD]
1067 >> RW_TAC std_ss [DISJOINT_DEF, EXTENSION, IN_INTER,
1068 NOT_IN_EMPTY, IN_DIFF, SUBSET_DEF]
1069 >> PROVE_TAC [],
1070 Know `f (SUC n) SUBSET f m` >- PROVE_TAC [SUBSET_ADD]
1071 >> RW_TAC std_ss [DISJOINT_DEF, EXTENSION, IN_INTER,
1072 NOT_IN_EMPTY, IN_DIFF, SUBSET_DEF]
1073 >> PROVE_TAC []]
1074QED
1075
1076(* ===================================================================== *)
1077(* The insertion function. *)
1078(* ===================================================================== *)
1079
1080val INSERT_DEF =
1081 new_infixr_definition
1082 ("INSERT_DEF", (“INSERT (x:'a) s = {y | (y = x) \/ y IN s}”),490);
1083val _ = ot0 "INSERT" "insert"
1084
1085(* --------------------------------------------------------------------- *)
1086(* set up sets as a list-form the {x1;...;xn} notation *)
1087(* --------------------------------------------------------------------- *)
1088
1089val _ = add_listform {leftdelim = [TOK "{"], rightdelim = [TOK "}"],
1090 separator = [TOK ";", BreakSpace(1,0)],
1091 cons = "INSERT", nilstr = "EMPTY",
1092 block_info = (PP.INCONSISTENT, 1)};
1093
1094(* --------------------------------------------------------------------- *)
1095(* Theorems about INSERT. *)
1096(* --------------------------------------------------------------------- *)
1097
1098Theorem IN_INSERT[simp]:
1099 !x:'a. !y s. x IN (y INSERT s) <=> x=y \/ x IN s
1100Proof
1101 PURE_ONCE_REWRITE_TAC [INSERT_DEF] THEN
1102 CONV_TAC (ONCE_DEPTH_CONV SET_SPEC_CONV) THEN
1103 REPEAT GEN_TAC THEN REFL_TAC
1104QED
1105
1106Theorem COMPONENT: !x:'a. !s. x IN (x INSERT s)
1107Proof REWRITE_TAC [IN_INSERT]
1108QED
1109
1110Theorem SET_CASES:
1111 !s:'a set.
1112 (s = EMPTY) \/
1113 ?x:'a. ?t. ((s = x INSERT t) /\ ~(x IN t))
1114Proof
1115 REWRITE_TAC [EXTENSION,NOT_IN_EMPTY] THEN GEN_TAC THEN
1116 DISJ_CASES_THEN MP_TAC (SPEC (“?x:'a. x IN s”) EXCLUDED_MIDDLE) THENL
1117 [STRIP_TAC THEN DISJ2_TAC THEN
1118 MAP_EVERY EXISTS_TAC [“x:'a”, “{y:'a | y IN s /\ ~(y = x)}”] THEN
1119 REWRITE_TAC [IN_INSERT] THEN
1120 CONV_TAC (ONCE_DEPTH_CONV SET_SPEC_CONV) THEN
1121 ASM_REWRITE_TAC [] THEN
1122 REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN
1123 ASM_REWRITE_TAC[EXCLUDED_MIDDLE],
1124 CONV_TAC (ONCE_DEPTH_CONV NOT_EXISTS_CONV) THEN
1125 STRIP_TAC THEN DISJ1_TAC THEN FIRST_ASSUM ACCEPT_TAC]
1126QED
1127
1128Theorem DECOMPOSITION:
1129 !s:'a set. !x. x IN s <=> ?t. s = x INSERT t /\ x NOTIN t
1130Proof
1131 REPEAT GEN_TAC THEN EQ_TAC THENL
1132 [DISCH_TAC THEN EXISTS_TAC (“{y:'a | y IN s /\ ~(y = x)}”) THEN
1133 ASM_REWRITE_TAC [EXTENSION,IN_INSERT] THEN
1134 CONV_TAC (ONCE_DEPTH_CONV SET_SPEC_CONV) THEN
1135 REWRITE_TAC [] THEN
1136 REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN
1137 ASM_REWRITE_TAC [EXCLUDED_MIDDLE],
1138 STRIP_TAC THEN ASM_REWRITE_TAC [IN_INSERT]]
1139QED
1140
1141Theorem ABSORPTION:
1142 !x:'a. !s. (x IN s) <=> (x INSERT s = s)
1143Proof
1144 REWRITE_TAC [EXTENSION,IN_INSERT] THEN
1145 REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN
1146 ASM_REWRITE_TAC [] THEN
1147 FIRST_ASSUM (fn th => fn g => PURE_ONCE_REWRITE_TAC [SYM(SPEC_ALL th)] g)
1148 THEN DISJ1_TAC THEN REFL_TAC
1149QED
1150
1151Theorem ABSORPTION_RWT:
1152 !x:'a s. x IN s ==> (x INSERT s = s)
1153Proof
1154 METIS_TAC [ABSORPTION]
1155QED
1156
1157Theorem INSERT_INSERT:
1158 !x:'a. !s. x INSERT (x INSERT s) = x INSERT s
1159Proof
1160 REWRITE_TAC [IN_INSERT,EXTENSION] THEN
1161 REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN
1162 ASM_REWRITE_TAC[]
1163QED
1164
1165Theorem INSERT_COMM:
1166 !x:'a. !y s. x INSERT (y INSERT s) = y INSERT (x INSERT s)
1167Proof
1168 REWRITE_TAC [IN_INSERT,EXTENSION] THEN
1169 REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN
1170 ASM_REWRITE_TAC[]
1171QED
1172
1173Theorem INSERT_UNIV:
1174 !x:'a. x INSERT UNIV = UNIV
1175Proof
1176 REWRITE_TAC [EXTENSION,IN_INSERT,IN_UNIV]
1177QED
1178
1179(* [simp]: don't need both because simplifier's rewrite creator
1180 automatically gives both senses to inequalities *)
1181Theorem NOT_INSERT_EMPTY[simp]:
1182 !x:'a. !s. ~(x INSERT s = EMPTY)
1183Proof
1184 REWRITE_TAC [EXTENSION,IN_INSERT,NOT_IN_EMPTY,IN_UNION] THEN
1185 CONV_TAC (ONCE_DEPTH_CONV NOT_FORALL_CONV) THEN
1186 REPEAT GEN_TAC THEN EXISTS_TAC (“x:'a”) THEN
1187 REWRITE_TAC []
1188QED
1189
1190Theorem NOT_EMPTY_INSERT:
1191 !x:'a. !s. ~(EMPTY = x INSERT s)
1192Proof
1193 REWRITE_TAC [EXTENSION,IN_INSERT,NOT_IN_EMPTY,IN_UNION] THEN
1194 CONV_TAC (ONCE_DEPTH_CONV NOT_FORALL_CONV) THEN
1195 REPEAT GEN_TAC THEN EXISTS_TAC (“x:'a”) THEN
1196 REWRITE_TAC []
1197QED
1198
1199Theorem INSERT_UNION:
1200 !(x:'a) s t.
1201 (x INSERT s) UNION t =
1202 (if x IN t then s UNION t else x INSERT (s UNION t))
1203Proof
1204 REPEAT GEN_TAC THEN COND_CASES_TAC THEN
1205 ASM_REWRITE_TAC [EXTENSION,IN_UNION,IN_INSERT] THEN
1206 REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN ASM_REWRITE_TAC []
1207QED
1208
1209Theorem INSERT_UNION_EQ:
1210 !x:'a. !s t. (x INSERT s) UNION t = x INSERT (s UNION t)
1211Proof
1212 REPEAT GEN_TAC THEN
1213 REWRITE_TAC [EXTENSION,IN_UNION,IN_INSERT,DISJ_ASSOC]
1214QED
1215
1216Theorem INSERT_INTER:
1217 !x:'a. !s t.
1218 (x INSERT s) INTER t =
1219 (if x IN t then x INSERT (s INTER t) else s INTER t)
1220Proof
1221 REPEAT GEN_TAC THEN COND_CASES_TAC THEN
1222 ASM_REWRITE_TAC [EXTENSION,IN_INTER,IN_INSERT] THEN
1223 GEN_TAC THEN EQ_TAC THENL
1224 [STRIP_TAC THEN ASM_REWRITE_TAC [],
1225 STRIP_TAC THEN ASM_REWRITE_TAC [],
1226 PURE_ONCE_REWRITE_TAC [CONJ_SYM] THEN
1227 DISCH_THEN (CONJUNCTS_THEN MP_TAC) THEN
1228 STRIP_TAC THEN ASM_REWRITE_TAC [],
1229 STRIP_TAC THEN ASM_REWRITE_TAC []]
1230QED
1231
1232Theorem DISJOINT_INSERT[simp]:
1233 !(x:'a) s t. DISJOINT (x INSERT s) t <=> DISJOINT s t /\ x NOTIN t
1234Proof
1235 REWRITE_TAC [IN_DISJOINT,IN_INSERT] THEN
1236 CONV_TAC (ONCE_DEPTH_CONV NOT_EXISTS_CONV) THEN
1237 REWRITE_TAC [DE_MORGAN_THM] THEN
1238 REPEAT GEN_TAC THEN EQ_TAC THENL
1239 [let val v = genvar (==`:'a`==)
1240 val GTAC = X_GEN_TAC v
1241 in DISCH_THEN (fn th => CONJ_TAC THENL [GTAC,ALL_TAC] THEN MP_TAC th)
1242 THENL [DISCH_THEN (STRIP_ASSUME_TAC o SPEC v) THEN ASM_REWRITE_TAC [],
1243 DISCH_THEN (MP_TAC o SPEC (“x:'a”)) THEN REWRITE_TAC[]]
1244 end,
1245 REPEAT STRIP_TAC THEN ASM_CASES_TAC (“x':'a = x”) THENL
1246 [ASM_REWRITE_TAC[], ASM_REWRITE_TAC[]]]
1247QED
1248
1249Theorem DISJOINT_INSERT'[simp] =
1250 ONCE_REWRITE_RULE [DISJOINT_SYM] DISJOINT_INSERT
1251
1252Theorem INSERT_SUBSET:
1253 !x:'a. !s t. (x INSERT s) SUBSET t <=> x IN t /\ s SUBSET t
1254Proof
1255 REWRITE_TAC [IN_INSERT,SUBSET_DEF] THEN
1256 REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL
1257 [FIRST_ASSUM MATCH_MP_TAC THEN DISJ1_TAC THEN REFL_TAC,
1258 FIRST_ASSUM MATCH_MP_TAC THEN DISJ2_TAC THEN FIRST_ASSUM ACCEPT_TAC,
1259 ASM_REWRITE_TAC [],
1260 RES_TAC]
1261QED
1262
1263Theorem SUBSET_INSERT:
1264 !x:'a. !s. x NOTIN s ==> !t. s SUBSET (x INSERT t) <=> s SUBSET t
1265Proof
1266 PURE_REWRITE_TAC [SUBSET_DEF,IN_INSERT] THEN
1267 REPEAT STRIP_TAC THEN EQ_TAC THENL
1268 [REPEAT STRIP_TAC THEN
1269 let fun tac th g = SUBST_ALL_TAC th g
1270 handle _ => STRIP_ASSUME_TAC th g
1271 in RES_THEN (STRIP_THM_THEN tac) THEN RES_TAC
1272 end,
1273 REPEAT STRIP_TAC THEN DISJ2_TAC THEN
1274 FIRST_ASSUM MATCH_MP_TAC THEN
1275 FIRST_ASSUM ACCEPT_TAC]
1276QED
1277
1278Theorem INSERT_DIFF:
1279 !s t. !x:'a. (x INSERT s) DIFF t =
1280 (if x IN t then s DIFF t else (x INSERT (s DIFF t)))
1281Proof
1282 REPEAT GEN_TAC THEN COND_CASES_TAC THENL
1283 [ASM_REWRITE_TAC [EXTENSION,IN_DIFF,IN_INSERT] THEN
1284 GEN_TAC THEN EQ_TAC THENL
1285 [STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
1286 FIRST_ASSUM (fn th => fn g => SUBST_ALL_TAC th g) THEN RES_TAC,
1287 STRIP_TAC THEN ASM_REWRITE_TAC[]],
1288 ASM_REWRITE_TAC [EXTENSION,IN_DIFF,IN_INSERT] THEN
1289 REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN ASM_REWRITE_TAC [] THEN
1290 FIRST_ASSUM (fn th => fn g => SUBST_ALL_TAC th g) THEN RES_TAC]
1291QED
1292
1293(* with INSERT to hand, it's easy to talk about concrete sets *)
1294Theorem SUBSET_SING:
1295 x SUBSET {a} <=> x = {} \/ x = {a}
1296Proof
1297 simp[EQ_IMP_THM, DISJ_IMP_THM, SUBSET_DEF] >> strip_tac >>
1298 Cases_on ‘x = {}’ >> simp[] >>
1299 rw[EQ_IMP_THM, EXTENSION] >> METIS_TAC[MEMBER_NOT_EMPTY]
1300QED
1301
1302Theorem UNIV_BOOL[simp]:
1303 univ(:bool) = {T; F}
1304Proof
1305 SRW_TAC [][EXTENSION]
1306QED
1307
1308(* from probability/iterateTheory *)
1309Theorem FORALL_IN_INSERT:
1310 !P a s. (!x. x IN (a INSERT s) ==> P x) <=> P a /\ (!x. x IN s ==> P x)
1311Proof
1312 REWRITE_TAC [IN_INSERT] THEN PROVE_TAC []
1313QED
1314
1315Theorem EXISTS_IN_INSERT:
1316 !P a s. (?x. x IN (a INSERT s) /\ P x) <=> P a \/ ?x. x IN s /\ P x
1317Proof
1318 REWRITE_TAC [IN_INSERT] THEN PROVE_TAC []
1319QED
1320
1321(* ===================================================================== *)
1322(* Removal of an element *)
1323(* ===================================================================== *)
1324
1325val DELETE_DEF =
1326 new_infixl_definition
1327 ("DELETE_DEF", (“DELETE s (x:'a) = s DIFF {x}”),500);
1328
1329Theorem IN_DELETE[simp]:
1330 !s. !x:'a. !y. x IN (s DELETE y) <=> x IN s /\ x <> y
1331Proof
1332 PURE_ONCE_REWRITE_TAC [DELETE_DEF] THEN
1333 REWRITE_TAC [IN_DIFF,IN_INSERT,NOT_IN_EMPTY]
1334QED
1335
1336Theorem DELETE_NON_ELEMENT:
1337 !x:'a. !s. x NOTIN s <=> (s DELETE x = s)
1338Proof
1339 PURE_REWRITE_TAC [EXTENSION,IN_DELETE] THEN
1340 REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL
1341 [FIRST_ASSUM ACCEPT_TAC,
1342 FIRST_ASSUM (fn th => fn g => SUBST_ALL_TAC th g handle _ => NO_TAC g)
1343 THEN RES_TAC,
1344 RES_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN REFL_TAC]
1345QED
1346
1347Theorem DELETE_NON_ELEMENT_RWT =
1348 DELETE_NON_ELEMENT |> SPEC_ALL |> EQ_IMP_RULE |> #1
1349 |> Q.GENL [`s`, `x`]
1350
1351Theorem IN_DELETE_EQ:
1352 !s x. !x':'a.
1353 (x IN s <=> x' IN s) <=> (x IN (s DELETE x') <=> x' IN (s DELETE x))
1354Proof
1355 REPEAT GEN_TAC THEN ASM_CASES_TAC (“x:'a = x'”) THENL
1356 [ASM_REWRITE_TAC [],
1357 FIRST_ASSUM (ASSUME_TAC o NOT_EQ_SYM) THEN
1358 ASM_REWRITE_TAC [IN_DELETE]]
1359QED
1360
1361Theorem EMPTY_DELETE[simp]:
1362 !x:'a. EMPTY DELETE x = EMPTY
1363Proof
1364 REWRITE_TAC [EXTENSION,NOT_IN_EMPTY,IN_DELETE]
1365QED
1366
1367Theorem ELT_IN_DELETE:
1368 !x s. ~(x IN (s DELETE x))
1369Proof
1370 RW_TAC std_ss [IN_DELETE]
1371QED
1372
1373Theorem DELETE_DELETE:
1374 !x:'a. !s. (s DELETE x) DELETE x = s DELETE x
1375Proof
1376 REWRITE_TAC [EXTENSION,IN_DELETE,SYM(SPEC_ALL CONJ_ASSOC)]
1377QED
1378
1379Theorem DELETE_COMM:
1380 !x:'a. !y. !s. (s DELETE x) DELETE y = (s DELETE y) DELETE x
1381Proof
1382 PURE_REWRITE_TAC [EXTENSION,IN_DELETE,CONJ_ASSOC] THEN
1383 REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN
1384 REPEAT CONJ_TAC THEN FIRST_ASSUM ACCEPT_TAC
1385QED
1386
1387Theorem DELETE_SUBSET:
1388 !x:'a. !s. (s DELETE x) SUBSET s
1389Proof
1390 PURE_REWRITE_TAC [SUBSET_DEF,IN_DELETE] THEN
1391 REPEAT STRIP_TAC
1392QED
1393
1394Theorem SUBSET_DELETE:
1395 !x:'a. !s t. s SUBSET (t DELETE x) <=> x NOTIN s /\ s SUBSET t
1396Proof
1397 REWRITE_TAC [SUBSET_DEF,IN_DELETE,EXTENSION] THEN
1398 REPEAT GEN_TAC THEN EQ_TAC THENL
1399 [REPEAT STRIP_TAC THENL
1400 [ASSUME_TAC (REFL (“x:'a”)) THEN RES_TAC, RES_TAC],
1401 REPEAT STRIP_TAC THENL
1402 [RES_TAC, FIRST_ASSUM (fn th => fn g => SUBST_ALL_TAC th g) THEN
1403 RES_TAC]]
1404QED
1405
1406Theorem SUBSET_INSERT_DELETE:
1407 !x:'a. !s t. s SUBSET (x INSERT t) <=> ((s DELETE x) SUBSET t)
1408Proof
1409 REPEAT GEN_TAC THEN
1410 REWRITE_TAC [SUBSET_DEF,IN_INSERT,IN_DELETE] THEN
1411 EQ_TAC THEN REPEAT STRIP_TAC THENL
1412 [RES_TAC THEN RES_TAC,
1413 ASM_CASES_TAC (“x':'a = x”) THEN
1414 ASM_REWRITE_TAC[] THEN RES_TAC]
1415QED
1416
1417Theorem SUBSET_OF_INSERT =
1418 REWRITE_RULE [GSYM SUBSET_INSERT_DELETE] DELETE_SUBSET ;
1419
1420Theorem DIFF_INSERT:
1421 !s t. !x:'a. s DIFF (x INSERT t) = (s DELETE x) DIFF t
1422Proof
1423 PURE_REWRITE_TAC [EXTENSION,IN_DIFF,IN_INSERT,IN_DELETE] THEN
1424 REWRITE_TAC [DE_MORGAN_THM,CONJ_ASSOC]
1425QED
1426
1427Theorem PSUBSET_INSERT_SUBSET:
1428 !s t. s PSUBSET t <=> ?x:'a. x NOTIN s /\ (x INSERT s) SUBSET t
1429Proof
1430 PURE_REWRITE_TAC [PSUBSET_DEF,NOT_EQUAL_SETS] THEN
1431 REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL
1432 [ASM_CASES_TAC (“(x:'a) IN s”) THENL
1433 [ASM_CASES_TAC (“(x:'a) IN t”) THENL
1434 [RES_TAC, IMP_RES_TAC SUBSET_DEF THEN RES_TAC],
1435 EXISTS_TAC (“x:'a”) THEN RES_TAC THEN
1436 ASM_REWRITE_TAC [INSERT_SUBSET]],
1437 IMP_RES_TAC INSERT_SUBSET,
1438 IMP_RES_TAC INSERT_SUBSET THEN
1439 EXISTS_TAC (“x:'a”) THEN ASM_REWRITE_TAC[]]
1440QED
1441
1442val lemma =
1443 TAC_PROOF(([], (“~(a:bool = b) = (b = ~a)”)),
1444 BOOL_CASES_TAC (“b:bool”) THEN REWRITE_TAC[]);
1445
1446Theorem PSUBSET_MEMBER:
1447 !s:'a set. !t. s PSUBSET t <=> s SUBSET t /\ ?y. y IN t /\ y NOTIN s
1448Proof
1449 REPEAT GEN_TAC THEN PURE_ONCE_REWRITE_TAC [PSUBSET_DEF] THEN
1450 PURE_ONCE_REWRITE_TAC [EXTENSION,SUBSET_DEF] THEN
1451 CONV_TAC (ONCE_DEPTH_CONV NOT_FORALL_CONV) THEN
1452 PURE_ONCE_REWRITE_TAC [lemma] THEN
1453 REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL
1454 [RES_TAC,
1455 EXISTS_TAC (“x:'a”) THEN ASM_REWRITE_TAC [] THEN
1456 ASM_CASES_TAC (“(x:'a) IN s”) THENL
1457 [RES_TAC THEN RES_TAC,FIRST_ASSUM ACCEPT_TAC],
1458 RES_TAC,
1459 EXISTS_TAC (“y:'a”) THEN ASM_REWRITE_TAC[]]
1460QED
1461
1462Theorem DELETE_INSERT:
1463 !(x:'a) y s.
1464 (x INSERT s) DELETE y = (if (x=y) then s DELETE y
1465 else x INSERT (s DELETE y))
1466Proof
1467 REWRITE_TAC [EXTENSION,IN_DELETE,IN_INSERT] THEN
1468 REPEAT GEN_TAC THEN EQ_TAC THENL
1469 [DISCH_THEN (STRIP_THM_THEN MP_TAC) THEN DISCH_TAC THEN
1470 let fun tac th g = SUBST_ALL_TAC th g handle _ => ASSUME_TAC th g
1471 in DISCH_THEN (STRIP_THM_THEN tac) THENL
1472 [ASM_REWRITE_TAC [IN_INSERT],
1473 COND_CASES_TAC THEN ASM_REWRITE_TAC [IN_DELETE,IN_INSERT]]
1474 end,
1475 COND_CASES_TAC THEN ASM_REWRITE_TAC [IN_DELETE,IN_INSERT] THENL
1476 [STRIP_TAC THEN ASM_REWRITE_TAC [],
1477 STRIP_TAC THEN ASM_REWRITE_TAC []]]
1478QED
1479
1480Theorem INSERT_DELETE:
1481 !x:'a. !s. x IN s ==> (x INSERT (s DELETE x) = s)
1482Proof
1483 PURE_REWRITE_TAC [EXTENSION,IN_INSERT,IN_DELETE] THEN
1484 REPEAT GEN_TAC THEN DISCH_THEN (fn th => GEN_TAC THEN MP_TAC th) THEN
1485 ASM_CASES_TAC (“x':'a = x”) THEN ASM_REWRITE_TAC[]
1486QED
1487
1488(* --------------------------------------------------------------------- *)
1489(* A theorem from homeier@org.aero.uniblab (Peter Homeier) *)
1490(* --------------------------------------------------------------------- *)
1491Theorem DELETE_INTER:
1492 !s t. !x:'a. (s DELETE x) INTER t = (s INTER t) DELETE x
1493Proof
1494 PURE_ONCE_REWRITE_TAC [EXTENSION] THEN REPEAT GEN_TAC THEN
1495 REWRITE_TAC [IN_INTER,IN_DELETE] THEN
1496 EQ_TAC THEN REPEAT STRIP_TAC THEN
1497 FIRST [FIRST_ASSUM ACCEPT_TAC,RES_TAC]
1498QED
1499
1500
1501(* --------------------------------------------------------------------- *)
1502(* A theorem from homeier@org.aero.uniblab (Peter Homeier) *)
1503(* --------------------------------------------------------------------- *)
1504Theorem DISJOINT_DELETE_SYM:
1505 !s t. !x:'a. DISJOINT (s DELETE x) t = DISJOINT (t DELETE x) s
1506Proof
1507 REWRITE_TAC [DISJOINT_DEF,EXTENSION,NOT_IN_EMPTY] THEN
1508 REWRITE_TAC [IN_INTER,IN_DELETE,DE_MORGAN_THM] THEN
1509 REPEAT GEN_TAC THEN EQ_TAC THEN
1510 let val X = (“X:'a”)
1511 in DISCH_THEN (fn th => X_GEN_TAC X THEN STRIP_ASSUME_TAC (SPEC X th))
1512 THEN ASM_REWRITE_TAC []
1513 end
1514QED
1515
1516(* ===================================================================== *)
1517(* Choice *)
1518(* ===================================================================== *)
1519
1520val CHOICE_EXISTS =
1521 TAC_PROOF
1522 (([], (“?CHOICE. !s:'a set. ~(s = EMPTY) ==> (CHOICE s) IN s”)),
1523 REWRITE_TAC [EXTENSION,NOT_IN_EMPTY] THEN
1524 EXISTS_TAC (“\s. @x:'a. x IN s”) THEN
1525 CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) THEN
1526 CONV_TAC (ONCE_DEPTH_CONV SELECT_CONV) THEN
1527 CONV_TAC (ONCE_DEPTH_CONV NOT_FORALL_CONV) THEN
1528 REWRITE_TAC []);
1529
1530val CHOICE_DEF = new_specification("CHOICE_DEF",["CHOICE"],CHOICE_EXISTS);
1531val _ = ot0 "CHOICE" "choice"
1532
1533Theorem CHOICE_INTRO:
1534 (?x. x IN s) /\ (!x. x IN s ==> P x) ==> P (CHOICE s)
1535Proof
1536 rpt strip_tac >> first_x_assum irule >>
1537 METIS_TAC[CHOICE_DEF, MEMBER_NOT_EMPTY]
1538QED
1539
1540(* ===================================================================== *)
1541(* The REST of a set after removing a chosen element. *)
1542(* ===================================================================== *)
1543
1544val REST_DEF =
1545 new_definition
1546 ("REST_DEF", (“REST (s:'a set) = s DELETE (CHOICE s)”));
1547
1548Theorem IN_REST:
1549 !x:'a. !s. x IN (REST s) <=> x IN s /\ ~(x = CHOICE s)
1550Proof REWRITE_TAC [REST_DEF, IN_DELETE]
1551QED
1552
1553Theorem CHOICE_NOT_IN_REST:
1554 !s:'a set. ~(CHOICE s IN REST s)
1555Proof
1556 REWRITE_TAC [IN_DELETE,REST_DEF]
1557QED
1558
1559Theorem CHOICE_INSERT_REST:
1560 !s:'a set. ~(s = EMPTY) ==> ((CHOICE s) INSERT (REST s) = s)
1561Proof
1562 REPEAT GEN_TAC THEN STRIP_TAC THEN
1563 REWRITE_TAC [EXTENSION,IN_INSERT,REST_DEF,IN_DELETE] THEN
1564 GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL
1565 [IMP_RES_TAC CHOICE_DEF THEN ASM_REWRITE_TAC [],
1566 ASM_REWRITE_TAC [EXCLUDED_MIDDLE]]
1567QED
1568
1569Theorem REST_SUBSET:
1570 !s:'a set. (REST s) SUBSET s
1571Proof
1572 REWRITE_TAC [SUBSET_DEF,REST_DEF,IN_DELETE] THEN REPEAT STRIP_TAC
1573QED
1574
1575val lemma =
1576 TAC_PROOF(([], (“(P /\ Q <=> P) <=> (P ==> Q)”)),
1577 BOOL_CASES_TAC (“P:bool”) THEN REWRITE_TAC[]);
1578
1579Theorem REST_PSUBSET:
1580 !s:'a set. ~(s = EMPTY) ==> (REST s) PSUBSET s
1581Proof
1582 REWRITE_TAC [PSUBSET_DEF,REST_SUBSET] THEN
1583 GEN_TAC THEN STRIP_TAC THEN
1584 REWRITE_TAC [EXTENSION,REST_DEF,IN_DELETE] THEN
1585 CONV_TAC NOT_FORALL_CONV THEN
1586 REWRITE_TAC [DE_MORGAN_THM,lemma,NOT_IMP] THEN
1587 EXISTS_TAC (“CHOICE (s:'a set)”) THEN
1588 IMP_RES_TAC CHOICE_DEF THEN
1589 ASM_REWRITE_TAC []
1590QED
1591
1592(* ===================================================================== *)
1593(* Singleton set. *)
1594(* ===================================================================== *)
1595
1596val SING_DEF =
1597 new_definition
1598 ("SING_DEF", (“SING s = ?x:'a. s = {x}”));
1599val _ = ot0 "SING" "singleton"
1600
1601Theorem SING[simp]:
1602 !x:'a. SING {x}
1603Proof
1604 PURE_ONCE_REWRITE_TAC [SING_DEF] THEN
1605 GEN_TAC THEN EXISTS_TAC (“x:'a”) THEN REFL_TAC
1606QED
1607
1608Theorem SING_EMPTY[simp]:
1609 SING {} = F
1610Proof
1611 SRW_TAC [][SING_DEF]
1612QED
1613
1614Theorem SING_INSERT[simp]:
1615 SING (x INSERT s) <=> (s = {}) \/ (s = {x})
1616Proof
1617 SRW_TAC [][SimpLHS, SING_DEF, EXTENSION] THEN
1618 SRW_TAC [][EQ_IMP_THM, DISJ_IMP_THM, FORALL_AND_THM, EXTENSION] THEN
1619 METIS_TAC []
1620QED
1621
1622Theorem SING_UNION:
1623 SING (s UNION t) <=> SING s /\ (t = {}) \/ SING t /\ (s = {}) \/
1624 SING s /\ SING t /\ (s = t)
1625Proof
1626 SRW_TAC [][SING_DEF, EXTENSION, EQ_IMP_THM, FORALL_AND_THM,
1627 DISJ_IMP_THM] THEN METIS_TAC []
1628QED
1629
1630Theorem IN_SING:
1631 !x y. x IN {y:'a} <=> (x = y)
1632Proof REWRITE_TAC [IN_INSERT,NOT_IN_EMPTY]
1633QED
1634
1635Theorem NOT_SING_EMPTY:
1636 !x:'a. ~({x} = EMPTY)
1637Proof
1638 REWRITE_TAC [EXTENSION,IN_SING,NOT_IN_EMPTY] THEN
1639 CONV_TAC (ONCE_DEPTH_CONV NOT_FORALL_CONV) THEN
1640 GEN_TAC THEN EXISTS_TAC (“x:'a”) THEN REWRITE_TAC[]
1641QED
1642
1643Theorem NOT_EMPTY_SING:
1644 !x:'a. ~(EMPTY = {x})
1645Proof
1646 REWRITE_TAC [EXTENSION,IN_SING,NOT_IN_EMPTY] THEN
1647 CONV_TAC (ONCE_DEPTH_CONV NOT_FORALL_CONV) THEN
1648 GEN_TAC THEN EXISTS_TAC (“x:'a”) THEN REWRITE_TAC[]
1649QED
1650
1651Theorem EQUAL_SING[simp]:
1652 !x:'a. !y. ({x} = {y}) = (x = y)
1653Proof
1654 REWRITE_TAC [EXTENSION,IN_SING] THEN
1655 REPEAT GEN_TAC THEN EQ_TAC THENL
1656 [DISCH_THEN (fn th => REWRITE_TAC [SYM(SPEC_ALL th)]),
1657 DISCH_THEN SUBST1_TAC THEN GEN_TAC THEN REFL_TAC]
1658QED
1659
1660Theorem DISJOINT_SING_EMPTY:
1661 !x:'a. DISJOINT {x} EMPTY
1662Proof
1663 REWRITE_TAC [DISJOINT_DEF,INTER_EMPTY]
1664QED
1665
1666Theorem INSERT_SING_UNION:
1667 !s. !x:'a. x INSERT s = {x} UNION s
1668Proof
1669 REWRITE_TAC [EXTENSION,IN_INSERT,IN_UNION,NOT_IN_EMPTY]
1670QED
1671
1672Theorem SING_DELETE[simp]:
1673 !x:'a. {x} DELETE x = EMPTY
1674Proof
1675 REWRITE_TAC [EXTENSION,NOT_IN_EMPTY,IN_DELETE,IN_INSERT] THEN
1676 PURE_ONCE_REWRITE_TAC [CONJ_SYM] THEN
1677 REWRITE_TAC [DE_MORGAN_THM,EXCLUDED_MIDDLE]
1678QED
1679
1680Theorem DELETE_EQ_SING:
1681 !s. !x:'a. (x IN s) ==> ((s DELETE x = EMPTY) = (s = {x}))
1682Proof
1683 PURE_ONCE_REWRITE_TAC [EXTENSION] THEN
1684 REWRITE_TAC [NOT_IN_EMPTY,DE_MORGAN_THM,IN_INSERT,IN_DELETE] THEN
1685 REPEAT STRIP_TAC THEN EQ_TAC THENL
1686 [DISCH_TAC THEN GEN_TAC THEN
1687 FIRST_ASSUM (fn th=>fn g => STRIP_ASSUME_TAC (SPEC (“x':'a”) th) g)
1688 THEN ASM_REWRITE_TAC [] THEN DISCH_THEN SUBST_ALL_TAC THEN RES_TAC,
1689 let val th = PURE_ONCE_REWRITE_RULE [DISJ_SYM] EXCLUDED_MIDDLE
1690 in DISCH_TAC THEN GEN_TAC THEN ASM_REWRITE_TAC [th]
1691 end]
1692QED
1693
1694Theorem CHOICE_SING[simp]:
1695 !x:'a. CHOICE {x} = x
1696Proof
1697 GEN_TAC THEN
1698 MP_TAC (MATCH_MP CHOICE_DEF (SPEC (“x:'a”) NOT_SING_EMPTY)) THEN
1699 REWRITE_TAC [IN_SING]
1700QED
1701
1702Theorem REST_SING[simp]:
1703 !x:'a. REST {x} = EMPTY
1704Proof
1705 REWRITE_TAC [CHOICE_SING,REST_DEF,SING_DELETE]
1706QED
1707
1708Theorem SING_IFF_EMPTY_REST:
1709 !s:'a set. SING s <=> s <> EMPTY /\ REST s = EMPTY
1710Proof
1711 PURE_ONCE_REWRITE_TAC [SING_DEF] THEN
1712 GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL
1713 [ASM_REWRITE_TAC [REST_SING] THEN
1714 REWRITE_TAC [EXTENSION,NOT_IN_EMPTY,IN_INSERT] THEN
1715 CONV_TAC NOT_FORALL_CONV THEN
1716 EXISTS_TAC (“x:'a”) THEN REWRITE_TAC [],
1717 EXISTS_TAC (“CHOICE s:'a”) THEN
1718 IMP_RES_THEN (SUBST1_TAC o SYM) CHOICE_INSERT_REST THEN
1719 ASM_REWRITE_TAC [EXTENSION,IN_SING,CHOICE_SING]]
1720QED
1721
1722(* Theorem: A non-empty set with all elements equal to a is the singleton {a} *)
1723(* Proof: by singleton definition. *)
1724Theorem ONE_ELEMENT_SING:
1725 !s a. s <> {} /\ (!k. k IN s ==> (k = a)) ==> (s = {a})
1726Proof
1727 rw[EXTENSION, EQ_IMP_THM] >>
1728 metis_tac[]
1729QED
1730
1731(* Theorem: !x. x IN s ==> s INTER {x} = {x} *)
1732(* Proof:
1733 s INTER {x}
1734 = {x | x IN s /\ x IN {x}} by INTER_DEF
1735 = {x' | x' IN s /\ x' = x} by IN_SING
1736 = {x} by EXTENSION
1737*)
1738Theorem INTER_SING:
1739 !s x. x IN s ==> (s INTER {x} = {x})
1740Proof
1741 rw[INTER_DEF, EXTENSION, EQ_IMP_THM]
1742QED
1743
1744(* Theorem: {x} INTER s = if x IN s then {x} else {} *)
1745(* Proof: by EXTENSION *)
1746Theorem SING_INTER:
1747 !s x. {x} INTER s = if x IN s then {x} else {}
1748Proof
1749 rw[EXTENSION] >>
1750 metis_tac[]
1751QED
1752
1753(* Theorem: s <> {} ==> (SING s <=> !x y. x IN s /\ y IN s ==> (x = y)) *)
1754(* Proof:
1755 If part: SING s ==> !x y. x IN s /\ y IN s ==> (x = y))
1756 SING s ==> ?t. s = {t} by SING_DEF
1757 x IN s ==> x = t by IN_SING
1758 y IN s ==> y = t by IN_SING
1759 Hence x = y
1760 Only-if part: !x y. x IN s /\ y IN s ==> (x = y)) ==> SING s
1761 True by ONE_ELEMENT_SING
1762*)
1763Theorem SING_ONE_ELEMENT:
1764 !s. s <> {} ==> (SING s <=> !x y. x IN s /\ y IN s ==> (x = y))
1765Proof
1766 metis_tac[SING_DEF, IN_SING, ONE_ELEMENT_SING]
1767QED
1768
1769(* Theorem: SING s ==> (!x y. x IN s /\ y IN s ==> (x = y)) *)
1770(* Proof:
1771 Note SING s <=> ?z. s = {z} by SING_DEF
1772 and x IN {z} <=> x = z by IN_SING
1773 and y IN {z} <=> y = z by IN_SING
1774 Thus x = y
1775*)
1776Theorem SING_ELEMENT:
1777 !s. SING s ==> (!x y. x IN s /\ y IN s ==> (x = y))
1778Proof
1779 metis_tac[SING_DEF, IN_SING]
1780QED
1781(* Note: the converse really needs s <> {} *)
1782
1783(* Theorem: SING s <=> s <> {} /\ (!x y. x IN s /\ y IN s ==> (x = y)) *)
1784(* Proof:
1785 If part: SING s ==> s <> {} /\ (!x y. x IN s /\ y IN s ==> (x = y))
1786 True by SING_EMPTY, SING_ELEMENT.
1787 Only-if part: s <> {} /\ (!x y. x IN s /\ y IN s ==> (x = y)) ==> SING s
1788 True by SING_ONE_ELEMENT.
1789*)
1790Theorem SING_TEST:
1791 !s. SING s <=> s <> {} /\ (!x y. x IN s /\ y IN s ==> (x = y))
1792Proof
1793 metis_tac[SING_EMPTY, SING_ELEMENT, SING_ONE_ELEMENT]
1794QED
1795
1796(* ===================================================================== *)
1797(* The image of a function on a set. *)
1798(* ===================================================================== *)
1799
1800val IMAGE_DEF =
1801 new_definition
1802 ("IMAGE_DEF", (“IMAGE (f:'a->'b) s = {f x | x IN s}”));
1803
1804val _ = ot0 "IMAGE" "image"
1805
1806Theorem IN_IMAGE[simp]:
1807 !y:'b. !s f. y IN (IMAGE f s) <=> ?x:'a. y = f x /\ x IN s
1808Proof
1809 PURE_ONCE_REWRITE_TAC [IMAGE_DEF] THEN
1810 CONV_TAC (ONCE_DEPTH_CONV SET_SPEC_CONV) THEN
1811 REPEAT GEN_TAC THEN REFL_TAC
1812QED
1813
1814Theorem IMAGE_IN:
1815 !x s. (x IN s) ==> !(f:'a->'b). f x IN (IMAGE f s)
1816Proof
1817 PURE_ONCE_REWRITE_TAC [IN_IMAGE] THEN
1818 REPEAT STRIP_TAC THEN
1819 EXISTS_TAC (“x:'a”) THEN
1820 CONJ_TAC THENL [REFL_TAC, FIRST_ASSUM ACCEPT_TAC]
1821QED
1822
1823Theorem IMAGE_EMPTY[simp]:
1824 !f:'a->'b. IMAGE f EMPTY = EMPTY
1825Proof
1826 REWRITE_TAC[EXTENSION,IN_IMAGE,NOT_IN_EMPTY]
1827QED
1828
1829Theorem IMAGE_ID:
1830 !s:'a set. IMAGE (\x:'a.x) s = s
1831Proof
1832 REWRITE_TAC [EXTENSION,IN_IMAGE] THEN
1833 CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) THEN
1834 REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL
1835 [ALL_TAC,EXISTS_TAC (“x:'a”)] THEN
1836 ASM_REWRITE_TAC []
1837QED
1838
1839Theorem IMAGE_I[simp]:
1840 IMAGE I s = s
1841Proof
1842 full_simp_tac(srw_ss())[EXTENSION]
1843QED
1844
1845Theorem IMAGE_o :
1846 !(f :'b -> 'c) (g :'a -> 'b) s. IMAGE (f o g) s = IMAGE f (IMAGE g s)
1847Proof
1848 REWRITE_TAC[EXTENSION, IN_IMAGE, o_THM] THEN MESON_TAC[]
1849QED
1850
1851Theorem IMAGE_II:
1852 IMAGE I = I
1853Proof
1854 RW_TAC std_ss [FUN_EQ_THM]
1855 >> METIS_TAC [SPECIFICATION, IN_IMAGE, I_THM]
1856QED
1857
1858Theorem IMAGE_COMPOSE:
1859 !f:'b->'c. !g:'a->'b. !s. IMAGE (f o g) s = IMAGE f (IMAGE g s)
1860Proof
1861 PURE_REWRITE_TAC [EXTENSION,IN_IMAGE,o_THM] THEN
1862 REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL
1863 [EXISTS_TAC (“g (x':'a):'b”) THEN
1864 CONJ_TAC THENL [ALL_TAC,EXISTS_TAC (“x':'a”)] THEN
1865 ASM_REWRITE_TAC [],
1866 EXISTS_TAC (“x'':'a”) THEN ASM_REWRITE_TAC[]]
1867QED
1868
1869Theorem IMAGE_INSERT[simp]:
1870 !(f:'a->'b) x s. IMAGE f (x INSERT s) = f x INSERT (IMAGE f s)
1871Proof
1872 PURE_REWRITE_TAC [EXTENSION,IN_INSERT,IN_IMAGE] THEN
1873 REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL
1874 [ALL_TAC,DISJ2_TAC THEN EXISTS_TAC (“x'':'a”),
1875 EXISTS_TAC (“x:'a”),EXISTS_TAC (“x'':'a”)] THEN
1876 ASM_REWRITE_TAC[]
1877QED
1878
1879(* |- (!f. IMAGE f {} = {}) /\
1880 !f x s. IMAGE f (x INSERT s) = f x INSERT IMAGE f s
1881
1882 This is for HOL-Light compatibility.
1883 *)
1884Theorem IMAGE_CLAUSES = CONJ IMAGE_EMPTY IMAGE_INSERT
1885
1886Theorem IMAGE_EQ_EMPTY[simp]:
1887 !s (f:'a->'b). (IMAGE f s = {} <=> s = {}) /\ ({} = IMAGE f s <=> s = {})
1888Proof
1889 GEN_TAC THEN
1890 STRIP_ASSUME_TAC (SPEC (“s:'a set”) SET_CASES) THEN
1891 ASM_REWRITE_TAC [IMAGE_EMPTY,IMAGE_INSERT,NOT_INSERT_EMPTY, NOT_EMPTY_INSERT]
1892QED
1893
1894Theorem IMAGE_DELETE:
1895 !(f:'a->'b) x s. ~(x IN s) ==> (IMAGE f (s DELETE x) = (IMAGE f s))
1896Proof
1897 REPEAT GEN_TAC THEN STRIP_TAC THEN
1898 PURE_REWRITE_TAC [EXTENSION,IN_DELETE,IN_IMAGE] THEN
1899 REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN
1900 EXISTS_TAC (“x'':'a”) THEN ASM_REWRITE_TAC [] THEN
1901 DISCH_THEN SUBST_ALL_TAC THEN RES_TAC
1902QED
1903
1904Theorem IMAGE_UNION:
1905 !(f:'a->'b) s t. IMAGE f (s UNION t) = (IMAGE f s) UNION (IMAGE f t)
1906Proof
1907 PURE_REWRITE_TAC [EXTENSION,IN_UNION,IN_IMAGE] THEN
1908 REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL
1909 [DISJ1_TAC,DISJ2_TAC,ALL_TAC,ALL_TAC] THEN
1910 EXISTS_TAC (“x':'a”) THEN ASM_REWRITE_TAC []
1911QED
1912
1913Theorem IMAGE_SUBSET:
1914 !s t. (s SUBSET t) ==> !f:'a->'b. (IMAGE f s) SUBSET (IMAGE f t)
1915Proof
1916 PURE_REWRITE_TAC [SUBSET_DEF,IN_IMAGE] THEN
1917 REPEAT STRIP_TAC THEN RES_TAC THEN
1918 EXISTS_TAC (“x':'a”) THEN ASM_REWRITE_TAC []
1919QED
1920
1921Theorem IMAGE_INTER:
1922 !(f:'a->'b) s t. IMAGE f (s INTER t) SUBSET (IMAGE f s INTER IMAGE f t)
1923Proof
1924 REPEAT GEN_TAC THEN
1925 REWRITE_TAC [SUBSET_DEF,IN_IMAGE,IN_INTER] THEN
1926 REPEAT STRIP_TAC THEN
1927 EXISTS_TAC (“x':'a”) THEN
1928 CONJ_TAC THEN FIRST_ASSUM ACCEPT_TAC
1929QED
1930
1931Theorem IMAGE_11:
1932 (!x y. (f x = f y) <=> (x = y)) ==>
1933 ((IMAGE f s1 = IMAGE f s2) <=> (s1 = s2))
1934Proof
1935 STRIP_TAC THEN SIMP_TAC (srw_ss()) [EQ_IMP_THM] THEN
1936 SRW_TAC [boolSimps.DNF_ss][EXTENSION, EQ_IMP_THM]
1937QED
1938
1939Theorem DISJOINT_IMAGE:
1940 (!x y. (f x = f y) <=> (x = y)) ==>
1941 (DISJOINT (IMAGE f s1) (IMAGE f s2) <=> DISJOINT s1 s2)
1942Proof
1943 simp[DISJOINT_DEF, EQ_IMP_THM, EXTENSION] >> METIS_TAC[]
1944QED
1945
1946Theorem IMAGE_CONG[defncong]:
1947 !f s f' s'. (s = s') /\ (!x. x IN s' ==> (f x = f' x)) ==>
1948 IMAGE f s = IMAGE f' s'
1949Proof
1950 SRW_TAC[][EXTENSION] THEN METIS_TAC[]
1951QED
1952
1953Theorem GSPEC_IMAGE:
1954 GSPEC f = IMAGE (FST o f) (SND o f)
1955Proof
1956 REWRITE_TAC [EXTENSION, IN_IMAGE, GSPECIFICATION] THEN
1957 GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN
1958 Q.EXISTS_TAC `x'` THEN Cases_on `f x'` THEN
1959 FULL_SIMP_TAC bool_ss [EXTENSION, SPECIFICATION,
1960 o_THM, FST, SND, PAIR_EQ]
1961QED
1962
1963Theorem IMAGE_IMAGE:
1964 !f g s. IMAGE f (IMAGE g s) = IMAGE (f o g) s
1965Proof
1966 RW_TAC std_ss [EXTENSION, IN_IMAGE, o_THM]
1967 >> PROVE_TAC []
1968QED
1969
1970Theorem FORALL_IN_IMAGE:
1971 !P f s. (!y. y IN IMAGE f s ==> P y) <=> (!x. x IN s ==> P(f x))
1972Proof
1973 REWRITE_TAC [IN_IMAGE] THEN PROVE_TAC []
1974QED
1975
1976Theorem EXISTS_IN_IMAGE:
1977 !P f s. (?y. y IN IMAGE f s /\ P y) <=> ?x. x IN s /\ P(f x)
1978Proof
1979 REWRITE_TAC [IN_IMAGE] THEN PROVE_TAC []
1980QED
1981
1982Theorem IMAGE_SING[simp]: !f x. IMAGE f {x} = {f x}
1983Proof
1984 RW_TAC std_ss [EXTENSION,IN_SING,IN_IMAGE] >> METIS_TAC []
1985QED
1986
1987Theorem SUBSET_IMAGE : (* from topologyTheory *)
1988 !f:'a->'b s t. s SUBSET (IMAGE f t) <=> ?u. u SUBSET t /\ (s = IMAGE f u)
1989Proof
1990 REPEAT GEN_TAC THEN EQ_TAC THENL [ALL_TAC, MESON_TAC[IMAGE_SUBSET]] THEN
1991 DISCH_TAC THEN EXISTS_TAC ``{x | x IN t /\ (f:'a->'b) x IN s}`` THEN
1992 POP_ASSUM MP_TAC THEN
1993 SIMP_TAC std_ss [EXTENSION, SUBSET_DEF, IN_IMAGE, GSPECIFICATION] THEN
1994 MESON_TAC[]
1995QED
1996
1997Theorem IMAGE_CONST : (* from HOL-Light *)
1998 !(s:'a->bool) (c:'b). IMAGE (\x. c) s = if s = {} then {} else {c}
1999Proof
2000 REPEAT GEN_TAC THEN COND_CASES_TAC THEN
2001 ASM_REWRITE_TAC[IMAGE_CLAUSES] THEN
2002 REWRITE_TAC[EXTENSION, IN_IMAGE, IN_SING] THEN
2003 ASM_MESON_TAC[MEMBER_NOT_EMPTY]
2004QED
2005
2006(* ===================================================================== *)
2007(* Injective functions on a set. *)
2008(* ===================================================================== *)
2009
2010val INJ_DEF =
2011 new_definition
2012 ("INJ_DEF",
2013 (“INJ (f:'a->'b) s t <=>
2014 (!x. x IN s ==> (f x) IN t) /\
2015 (!x y. (x IN s /\ y IN s) ==> (f x = f y) ==> (x = y))”));
2016
2017Theorem INJ_IFF:
2018 INJ (f:'a -> 'b) s t <=>
2019 (!x. x IN s ==> f x IN t) /\
2020 (!x y. x IN s /\ y IN s ==> ((f x = f y) <=> (x = y)))
2021Proof
2022 METIS_TAC[INJ_DEF]
2023QED
2024
2025Theorem INJ_ID:
2026 !s. INJ (\x:'a.x) s s
2027Proof
2028 PURE_ONCE_REWRITE_TAC [INJ_DEF] THEN
2029 CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) THEN
2030 REPEAT STRIP_TAC
2031QED
2032
2033Theorem INJ_COMPOSE:
2034 !f:'a->'b. !g:'b->'c.
2035 !s t u. (INJ f s t /\ INJ g t u) ==> INJ (g o f) s u
2036Proof
2037 PURE_REWRITE_TAC [INJ_DEF,o_THM] THEN
2038 REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL
2039 [FIRST_ASSUM MATCH_MP_TAC THEN RES_TAC,
2040 RES_TAC THEN RES_TAC]
2041QED
2042
2043Theorem INJ_EMPTY[simp]:
2044 !f:'a->'b. (!s. INJ f {} s) /\ (!s. INJ f s {} = (s = {}))
2045Proof
2046 REWRITE_TAC [INJ_DEF,NOT_IN_EMPTY,EXTENSION] THEN
2047 REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN RES_TAC
2048QED
2049
2050Theorem INJ_DELETE:
2051 !f s t. INJ f s t ==> !e. e IN s ==> INJ f (s DELETE e) (t DELETE (f e))
2052Proof
2053 RW_TAC bool_ss [INJ_DEF, DELETE_DEF] THENL
2054 [`~(e = x)` by FULL_SIMP_TAC bool_ss
2055 [DIFF_DEF,DIFF_INSERT, DIFF_EMPTY, IN_DELETE] THEN
2056 FULL_SIMP_TAC bool_ss [DIFF_DEF,DIFF_INSERT, DIFF_EMPTY, IN_DELETE] THEN
2057 METIS_TAC [],
2058 METIS_TAC [IN_DIFF]]
2059QED
2060
2061Theorem INJ_INSERT:
2062 !f x s t. INJ f (x INSERT s) t <=>
2063 INJ f s t /\ (f x) IN t /\
2064 (!y. y IN s /\ (f x = f y) ==> (x = y))
2065Proof
2066 SRW_TAC[][INJ_DEF] THEN METIS_TAC[]
2067QED
2068
2069Theorem INJ_EXTEND:
2070 !b s t x y.
2071 INJ b s t /\ x NOTIN s /\ y NOTIN t ==>
2072 INJ ((x =+ y) b) (x INSERT s) (y INSERT t)
2073Proof
2074 rpt GEN_TAC \\
2075 fs[INJ_DEF,APPLY_UPDATE_THM] >> METIS_TAC []
2076QED
2077
2078Theorem INJ_SUBSET:
2079 !f s t s0 t0. INJ f s t /\ s0 SUBSET s /\ t SUBSET t0 ==> INJ f s0 t0
2080Proof
2081SRW_TAC[][INJ_DEF,SUBSET_DEF]
2082QED
2083
2084Theorem INJ_IMAGE:
2085 !f s t. INJ f s t ==> INJ f s (IMAGE f s)
2086Proof
2087 REPEAT GEN_TAC THEN
2088 REWRITE_TAC [INJ_DEF, IN_IMAGE] THEN
2089 REPEAT DISCH_TAC THEN ASM_REWRITE_TAC [] THEN
2090 REPEAT STRIP_TAC THEN Q.EXISTS_TAC `x` THEN ASM_REWRITE_TAC []
2091QED
2092
2093Theorem INJ_IMAGE_SUBSET:
2094 !f s t. INJ f s t ==> IMAGE f s SUBSET t
2095Proof
2096 REPEAT GEN_TAC THEN
2097 REWRITE_TAC [INJ_DEF, SUBSET_DEF, IN_IMAGE] THEN
2098 REPEAT STRIP_TAC THEN BasicProvers.VAR_EQ_TAC THEN RES_TAC
2099QED
2100
2101(* ===================================================================== *)
2102(* Surjective functions on a set. *)
2103(* ===================================================================== *)
2104
2105val SURJ_DEF =
2106 new_definition
2107 ("SURJ_DEF",
2108 (“SURJ (f:'a->'b) s t <=>
2109 (!x. x IN s ==> (f x) IN t) /\
2110 (!x. (x IN t) ==> ?y. y IN s /\ (f y = x))”));
2111
2112Theorem SURJ_ID:
2113 !s. SURJ (\x:'a.x) s s
2114Proof
2115 PURE_ONCE_REWRITE_TAC [SURJ_DEF] THEN
2116 CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) THEN
2117 REPEAT STRIP_TAC THEN
2118 EXISTS_TAC (“x:'a”) THEN
2119 ASM_REWRITE_TAC []
2120QED
2121
2122Theorem SURJ_COMPOSE:
2123 !f:'a->'b. !g:'b->'c.
2124 !s t u. (SURJ f s t /\ SURJ g t u) ==> SURJ (g o f) s u
2125Proof
2126 PURE_REWRITE_TAC [SURJ_DEF,o_THM] THEN
2127 REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL
2128 [FIRST_ASSUM MATCH_MP_TAC THEN RES_TAC,
2129 RES_TAC THEN RES_TAC THEN
2130 EXISTS_TAC (“y'':'a”) THEN
2131 ASM_REWRITE_TAC []]
2132QED
2133
2134Theorem SURJ_EMPTY:
2135 !f:'a->'b. (!s. SURJ f {} s = (s = {})) /\ (!s. SURJ f s {} = (s = {}))
2136Proof
2137 REWRITE_TAC [SURJ_DEF,NOT_IN_EMPTY,EXTENSION]
2138QED
2139
2140Theorem IMAGE_SURJ:
2141 !f:'a->'b. !s t. SURJ f s t = ((IMAGE f s) = t)
2142Proof
2143 PURE_REWRITE_TAC [SURJ_DEF,EXTENSION,IN_IMAGE] THEN
2144 REPEAT GEN_TAC THEN EQ_TAC THENL
2145 [REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL
2146 [RES_TAC THEN ASM_REWRITE_TAC [],
2147 MAP_EVERY PURE_ONCE_REWRITE_TAC [[CONJ_SYM],[EQ_SYM_EQ]] THEN
2148 FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC],
2149 DISCH_THEN (ASSUME_TAC o CONV_RULE (ONCE_DEPTH_CONV SYM_CONV)) THEN
2150 ASM_REWRITE_TAC [] THEN REPEAT STRIP_TAC THENL
2151 [EXISTS_TAC (“x:'a”) THEN ASM_REWRITE_TAC [],
2152 EXISTS_TAC (“x':'a”) THEN ASM_REWRITE_TAC []]]
2153QED
2154
2155Theorem SURJ_IMAGE[simp]:
2156 SURJ f s (IMAGE f s)
2157Proof
2158 REWRITE_TAC[IMAGE_SURJ]
2159QED
2160
2161Theorem SURJ_IMP_INJ:
2162 !s t. (?f. SURJ f s t) ==> (?g. INJ g t s)
2163Proof
2164 RW_TAC std_ss [SURJ_DEF, INJ_DEF]
2165 >> Suff `?g. !x. x IN t ==> g x IN s /\ (f (g x) = x)`
2166 >- PROVE_TAC []
2167 >> Q.EXISTS_TAC `\y. @x. x IN s /\ (f x = y)`
2168 >> POP_ASSUM MP_TAC
2169 >> RW_TAC std_ss [EXISTS_DEF]
2170QED
2171
2172(* ===================================================================== *)
2173(* Bijective functions on a set. *)
2174(* ===================================================================== *)
2175
2176val BIJ_DEF =
2177 new_definition
2178 ("BIJ_DEF",
2179 (“BIJ (f:'a->'b) s t <=> INJ f s t /\ SURJ f s t”));
2180
2181Theorem BIJ_ID:
2182 !s. BIJ (\x:'a.x) s s
2183Proof
2184 REWRITE_TAC [BIJ_DEF,INJ_ID,SURJ_ID]
2185QED
2186
2187Theorem BIJ_IMP_11:
2188 BIJ f UNIV UNIV ==> !x y. (f x = f y) = (x = y)
2189Proof
2190 FULL_SIMP_TAC (srw_ss())[BIJ_DEF,INJ_DEF] \\ METIS_TAC []
2191QED
2192
2193Theorem BIJ_EMPTY[simp]:
2194 !f:'a->'b. (!s. BIJ f {} s = (s = {})) /\ (!s. BIJ f s {} = (s = {}))
2195Proof
2196 REWRITE_TAC [BIJ_DEF,INJ_EMPTY,SURJ_EMPTY]
2197QED
2198
2199Theorem BIJ_COMPOSE:
2200 !f:'a->'b. !g:'b->'c.
2201 !s t u. (BIJ f s t /\ BIJ g t u) ==> BIJ (g o f) s u
2202Proof
2203 PURE_REWRITE_TAC [BIJ_DEF] THEN
2204 REPEAT STRIP_TAC THENL
2205 [IMP_RES_TAC INJ_COMPOSE,IMP_RES_TAC SURJ_COMPOSE]
2206QED
2207
2208Theorem BIJ_DELETE:
2209 !s t f. BIJ f s t ==> !e. e IN s ==> BIJ f (s DELETE e) (t DELETE (f e))
2210Proof
2211RW_TAC bool_ss [BIJ_DEF, SURJ_DEF, INJ_DELETE, DELETE_DEF, INJ_DEF] THENL
2212[FULL_SIMP_TAC bool_ss [DIFF_DEF,DIFF_INSERT, DIFF_EMPTY, IN_DELETE] THEN
2213 METIS_TAC [],
2214 `?y. y IN s /\ (f y = x)` by METIS_TAC [IN_DIFF] THEN
2215 Q.EXISTS_TAC `y` THEN RW_TAC bool_ss [] THEN
2216 `~(y = e)` by (FULL_SIMP_TAC bool_ss [DIFF_DEF, DIFF_INSERT, DIFF_EMPTY,
2217 IN_DELETE] THEN
2218 METIS_TAC [IN_DIFF]) THEN
2219 FULL_SIMP_TAC bool_ss [DIFF_DEF, DIFF_INSERT, DIFF_EMPTY, IN_DELETE]]
2220QED
2221
2222Theorem INJ_IMAGE_BIJ:
2223 !s f. (?t. INJ f s t) ==> BIJ f s (IMAGE f s)
2224Proof
2225 RW_TAC std_ss [INJ_DEF, BIJ_DEF, SURJ_DEF, IN_IMAGE]
2226 >> PROVE_TAC []
2227QED
2228
2229Theorem INJ_BIJ_SUBSET:
2230 s0 SUBSET s /\ INJ f s t ==> BIJ f s0 (IMAGE f s0)
2231Proof
2232 SIMP_TAC std_ss [SUBSET_DEF, INJ_DEF, IMAGE_SURJ, BIJ_DEF, IN_IMAGE]
2233 >> METIS_TAC []
2234QED
2235
2236Theorem BIJ_SYM_IMP:
2237 !s t. (?f. BIJ f s t) ==> (?g. BIJ g t s)
2238Proof
2239 RW_TAC std_ss [BIJ_DEF, SURJ_DEF, INJ_DEF]
2240 >> Suff `?(g : 'b -> 'a). !x. x IN t ==> g x IN s /\ (f (g x) = x)`
2241 >- (rpt STRIP_TAC
2242 >> Q.EXISTS_TAC `g`
2243 >> RW_TAC std_ss []
2244 >> PROVE_TAC [])
2245 >> POP_ASSUM (MP_TAC o ONCE_REWRITE_RULE [EXISTS_DEF])
2246 >> RW_TAC std_ss []
2247 >> Q.EXISTS_TAC `\x. @y. y IN s /\ (f y = x)`
2248 >> RW_TAC std_ss []
2249QED
2250
2251Theorem BIJ_SYM:
2252 !s t. (?f. BIJ f s t) = (?g. BIJ g t s)
2253Proof
2254 PROVE_TAC [BIJ_SYM_IMP]
2255QED
2256
2257Theorem BIJ_TRANS:
2258 !s t u.
2259 (?f. BIJ f s t) /\ (?g. BIJ g t u) ==> (?h : 'a -> 'b. BIJ h s u)
2260Proof
2261 RW_TAC std_ss []
2262 >> Q.EXISTS_TAC `g o f`
2263 >> PROVE_TAC [BIJ_COMPOSE]
2264QED
2265
2266Theorem BIJ_INV: !f s t. BIJ f s t ==>
2267 ?g.
2268 BIJ g t s /\
2269 (!x. x IN s ==> ((g o f) x = x)) /\
2270 (!x. x IN t ==> ((f o g) x = x))
2271Proof
2272 RW_TAC std_ss []
2273 >> FULL_SIMP_TAC std_ss [BIJ_DEF, INJ_DEF, SURJ_DEF, o_THM]
2274 >> POP_ASSUM
2275 (MP_TAC o
2276 CONV_RULE
2277 (DEPTH_CONV RIGHT_IMP_EXISTS_CONV
2278 THENC SKOLEM_CONV
2279 THENC REWRITE_CONV [EXISTS_DEF]
2280 THENC DEPTH_CONV BETA_CONV))
2281 >> Q.SPEC_TAC (`@y. !x. x IN t ==> y x IN s /\ (f (y x) = x)`, `g`)
2282 >> RW_TAC std_ss []
2283 >> Q.EXISTS_TAC `g`
2284 >> RW_TAC std_ss []
2285 >> PROVE_TAC []
2286QED
2287
2288(* Theorem: (!x. x IN s ==> (f x = g x)) ==> (INJ f s t <=> INJ g s t) *)
2289(* Proof: by INJ_DEF *)
2290Theorem INJ_CONG:
2291 !f g s t. (!x. x IN s ==> (f x = g x)) ==> (INJ f s t <=> INJ g s t)
2292Proof
2293 rw[INJ_DEF]
2294QED
2295
2296(* Theorem: (!x. x IN s ==> (f x = g x)) ==> (SURJ f s t <=> SURJ g s t) *)
2297(* Proof: by SURJ_DEF *)
2298Theorem SURJ_CONG:
2299 !f g s t. (!x. x IN s ==> (f x = g x)) ==> (SURJ f s t <=> SURJ g s t)
2300Proof
2301 rw[SURJ_DEF] >>
2302 metis_tac[]
2303QED
2304
2305(* Theorem: (!x. x IN s ==> (f x = g x)) ==> (BIJ f s t <=> BIJ g s t) *)
2306(* Proof: by BIJ_DEF, INJ_CONG, SURJ_CONG *)
2307Theorem BIJ_CONG:
2308 !f g s t. (!x. x IN s ==> (f x = g x)) ==> (BIJ f s t <=> BIJ g s t)
2309Proof
2310 rw[BIJ_DEF] >>
2311 metis_tac[INJ_CONG, SURJ_CONG]
2312QED
2313
2314(*
2315BIJ_LINV_BIJ |- !f s t. BIJ f s t ==> BIJ (LINV f s) t s
2316Cannot prove |- !f s t. BIJ f s t <=> BIJ (LINV f s) t s
2317because LINV f s depends on f!
2318*)
2319
2320(* Theorem: INJ f s t /\ x IN s ==> f x IN t *)
2321(* Proof: by INJ_DEF *)
2322Theorem INJ_ELEMENT:
2323 !f s t x. INJ f s t /\ x IN s ==> f x IN t
2324Proof
2325 rw_tac std_ss[INJ_DEF]
2326QED
2327
2328(* Theorem: SURJ f s t /\ x IN s ==> f x IN t *)
2329(* Proof: by SURJ_DEF *)
2330Theorem SURJ_ELEMENT:
2331 !f s t x. SURJ f s t /\ x IN s ==> f x IN t
2332Proof
2333 rw_tac std_ss[SURJ_DEF]
2334QED
2335
2336(* Theorem: BIJ f s t /\ x IN s ==> f x IN t *)
2337(* Proof: by BIJ_DEF *)
2338Theorem BIJ_ELEMENT:
2339 !f s t x. BIJ f s t /\ x IN s ==> f x IN t
2340Proof
2341 rw_tac std_ss[BIJ_DEF, INJ_DEF]
2342QED
2343
2344(* Theorem: INJ f UNIV UNIV ==> INJ f s UNIV *)
2345(* Proof:
2346 Note s SUBSET univ(:'a) by SUBSET_UNIV
2347 and univ(:'b) SUBSET univ('b) by SUBSET_REFL
2348 so INJ f univ(:'a) univ(:'b) ==> INJ f s univ(:'b) by INJ_SUBSET
2349*)
2350Theorem INJ_SUBSET_UNIV:
2351 !(f:'a -> 'b) (s:'a -> bool). INJ f UNIV UNIV ==> INJ f s UNIV
2352Proof
2353 metis_tac[INJ_SUBSET, SUBSET_UNIV, SUBSET_REFL]
2354QED
2355
2356(* Theorem: INJ f P univ(:'b) ==>
2357 !s t. s SUBSET P /\ t SUBSET P ==> ((IMAGE f s = IMAGE f t) <=> (s = t)) *)
2358(* Proof:
2359 If part: IMAGE f s = IMAGE f t ==> s = t
2360 Claim: s SUBSET t
2361 Proof: by SUBSET_DEF, this is to show: x IN s ==> x IN t
2362 x IN s
2363 ==> f x IN (IMAGE f s) by INJ_DEF, IN_IMAGE
2364 or f x IN (IMAGE f t) by given
2365 ==> ?x'. x' IN t /\ (f x' = f x) by IN_IMAGE
2366 But x IN P /\ x' IN P by SUBSET_DEF
2367 Thus f x' = f x ==> x' = x by INJ_DEF
2368
2369 Claim: t SUBSET s
2370 Proof: similar to above by INJ_DEF, IN_IMAGE, SUBSET_DEF
2371
2372 Hence s = t by SUBSET_ANTISYM
2373
2374 Only-if part: s = t ==> IMAGE f s = IMAGE f t
2375 This is trivially true.
2376*)
2377Theorem INJ_IMAGE_EQ:
2378 !P f. INJ f P univ(:'b) ==>
2379 !s t. s SUBSET P /\ t SUBSET P ==> ((IMAGE f s = IMAGE f t) <=> (s = t))
2380Proof
2381 rw[EQ_IMP_THM] >>
2382 (irule SUBSET_ANTISYM >> rpt conj_tac) >| [
2383 rw[SUBSET_DEF] >>
2384 `?x'. x' IN t /\ (f x' = f x)` by metis_tac[IMAGE_IN, IN_IMAGE] >>
2385 metis_tac[INJ_DEF, SUBSET_DEF],
2386 rw[SUBSET_DEF] >>
2387 `?x'. x' IN s /\ (f x' = f x)` by metis_tac[IMAGE_IN, IN_IMAGE] >>
2388 metis_tac[INJ_DEF, SUBSET_DEF]
2389 ]
2390QED
2391
2392(* Theorem: INJ f P univ(:'b) ==>
2393 !s t. s SUBSET P /\ t SUBSET P ==> (IMAGE f (s INTER t) = (IMAGE f s) INTER (IMAGE f t)) *)
2394(* Proof: by EXTENSION, INJ_DEF, SUBSET_DEF *)
2395Theorem INJ_IMAGE_INTER:
2396 !P f. INJ f P univ(:'b) ==>
2397 !s t. s SUBSET P /\ t SUBSET P ==> (IMAGE f (s INTER t) = (IMAGE f s) INTER (IMAGE f t))
2398Proof
2399 rw[EXTENSION] >>
2400 metis_tac[INJ_DEF, SUBSET_DEF]
2401QED
2402
2403(* Theorem: INJ f P univ(:'b) ==>
2404 !s t. s SUBSET P /\ t SUBSET P ==> (DISJOINT s t <=> DISJOINT (IMAGE f s) (IMAGE f t)) *)
2405(* Proof:
2406 DISJOINT (IMAGE f s) (IMAGE f t)
2407 <=> (IMAGE f s) INTER (IMAGE f t) = {} by DISJOINT_DEF
2408 <=> IMAGE f (s INTER t) = {} by INJ_IMAGE_INTER, INJ f P univ(:'b)
2409 <=> s INTER t = {} by IMAGE_EQ_EMPTY
2410 <=> DISJOINT s t by DISJOINT_DEF
2411*)
2412Theorem INJ_IMAGE_DISJOINT:
2413 !P f. INJ f P univ(:'b) ==>
2414 !s t. s SUBSET P /\ t SUBSET P ==> (DISJOINT s t <=> DISJOINT (IMAGE f s) (IMAGE f t))
2415Proof
2416 metis_tac[DISJOINT_DEF, INJ_IMAGE_INTER, IMAGE_EQ_EMPTY]
2417QED
2418
2419(* Theorem: INJ I s univ(:'a) *)
2420(* Proof:
2421 Note !x. I x = x by I_THM
2422 so !x. x IN s ==> I x IN univ(:'a) by IN_UNIV
2423 and !x y. x IN s /\ y IN s ==> (I x = I y) ==> (x = y) by above
2424 Hence INJ I s univ(:'b) by INJ_DEF
2425*)
2426Theorem INJ_I:
2427 !s:'a -> bool. INJ I s univ(:'a)
2428Proof
2429 rw[INJ_DEF]
2430QED
2431
2432(* Theorem: INJ I (IMAGE f s) univ(:'b) *)
2433(* Proof:
2434 Since !x. x IN (IMAGE f s) ==> x IN univ(:'b) by IN_UNIV
2435 and !x y. x IN (IMAGE f s) /\ y IN (IMAGE f s) ==>
2436 (I x = I y) ==> (x = y) by I_THM
2437 Hence INJ I (IMAGE f s) univ(:'b) by INJ_DEF
2438*)
2439Theorem INJ_I_IMAGE:
2440 !s f. INJ I (IMAGE f s) univ(:'b)
2441Proof
2442 rw[INJ_DEF]
2443QED
2444
2445(* Theorem: BIJ f s t ==> !x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y) *)
2446(* Proof: by BIJ_DEF, INJ_DEF *)
2447Theorem BIJ_IS_INJ:
2448 !f s t. BIJ f s t ==> !x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)
2449Proof
2450 rw[BIJ_DEF, INJ_DEF]
2451QED
2452
2453(* Theorem: BIJ f s t ==> !x. x IN t ==> ?y. y IN s /\ f y = x *)
2454(* Proof: by BIJ_DEF, SURJ_DEF. *)
2455Theorem BIJ_IS_SURJ:
2456 !f s t. BIJ f s t ==> !x. x IN t ==> ?y. y IN s /\ f y = x
2457Proof
2458 simp[BIJ_DEF, SURJ_DEF]
2459QED
2460
2461(* Theorem: INJ f s s /\ x IN s /\ y IN s ==> ((f x = f y) <=> (x = y)) *)
2462(* Proof: by INJ_DEF *)
2463Theorem INJ_EQ_11:
2464 !f s x y. INJ f s s /\ x IN s /\ y IN s ==> ((f x = f y) <=> (x = y))
2465Proof
2466 metis_tac[INJ_DEF]
2467QED
2468
2469(* Theorem: INJ f univ(:'a) univ(:'b) ==> !x y. f x = f y <=> x = y *)
2470(* Proof: by INJ_DEF, IN_UNIV. *)
2471Theorem INJ_IMP_11:
2472 !f. INJ f univ(:'a) univ(:'b) ==> !x y. f x = f y <=> x = y
2473Proof
2474 metis_tac[INJ_DEF, IN_UNIV]
2475QED
2476(* This is better than INJ_EQ_11 above. *)
2477
2478(* Theorem: BIJ I s s *)
2479(* Proof: by definitions. *)
2480Theorem BIJ_I_SAME:
2481 !s. BIJ I s s
2482Proof
2483 rw[BIJ_DEF, INJ_DEF, SURJ_DEF]
2484QED
2485
2486(* ===================================================================== *)
2487(* Fun set and Schroeder Bernstein Theorems (from util_probTheory) *)
2488(* ===================================================================== *)
2489
2490(* f:P->Q := f IN (FUNSET P Q) *)
2491Definition FUNSET[nocompute]:
2492 FUNSET (P :'a -> bool) (Q :'b -> bool) = \f. !x. x IN P ==> f x IN Q
2493End
2494
2495Definition DFUNSET[nocompute]:
2496 DFUNSET (P :'a -> bool) (Q :'a -> 'b -> bool) =
2497 \f. !x. x IN P ==> f x IN Q x
2498End
2499
2500Theorem IN_FUNSET:
2501 !(f :'a -> 'b) P Q. f IN (FUNSET P Q) <=> !x. x IN P ==> f x IN Q
2502Proof RW_TAC std_ss [SPECIFICATION, FUNSET]
2503QED
2504
2505Theorem IN_DFUNSET:
2506 !(f :'a -> 'b) (P :'a -> bool) Q.
2507 f IN (DFUNSET P Q) <=> !x. x IN P ==> f x IN Q x
2508Proof RW_TAC std_ss [SPECIFICATION, DFUNSET]
2509QED
2510
2511Theorem FUNSET_THM: !s t (f :'a -> 'b) x. f IN (FUNSET s t) /\ x IN s ==> f x IN t
2512Proof
2513 RW_TAC std_ss [IN_FUNSET] >> PROVE_TAC []
2514QED
2515
2516Theorem UNIV_FUNSET_UNIV: FUNSET (UNIV :'a -> bool) (UNIV :'b -> bool) = UNIV
2517Proof
2518 RW_TAC std_ss [EXTENSION, IN_UNIV, IN_FUNSET]
2519QED
2520
2521Theorem FUNSET_DFUNSET: !(x :'a -> bool) (y :'b -> bool). FUNSET x y = DFUNSET x (K y)
2522Proof
2523 RW_TAC std_ss [EXTENSION, GSPECIFICATION, IN_FUNSET, IN_DFUNSET, K_DEF]
2524QED
2525
2526Theorem EMPTY_FUNSET: !s. FUNSET {} s = (UNIV :('a -> 'b) -> bool)
2527Proof
2528 RW_TAC std_ss [EXTENSION, GSPECIFICATION, IN_FUNSET, NOT_IN_EMPTY, IN_UNIV]
2529QED
2530
2531Theorem FUNSET_EMPTY:
2532 !s (f :'a -> 'b). f IN (FUNSET s {}) <=> (s = {})
2533Proof
2534 RW_TAC std_ss [IN_FUNSET, NOT_IN_EMPTY, EXTENSION, GSPECIFICATION]
2535QED
2536
2537Theorem FUNSET_INTER:
2538 !a b c. FUNSET a (b INTER c) = (FUNSET a b) INTER (FUNSET a c)
2539Proof
2540 RW_TAC std_ss [EXTENSION, IN_FUNSET, IN_INTER]
2541 >> PROVE_TAC []
2542QED
2543
2544(* (schroeder_close f s) is a set defined as a closure of f^n on set s *)
2545Definition schroeder_close_def[nocompute]:
2546 schroeder_close f s x = ?n. x IN FUNPOW (IMAGE f) n s
2547End
2548
2549(* fundamental property by definition *)
2550Theorem SCHROEDER_CLOSE:
2551 !f s. x IN (schroeder_close f s) <=> (?n. x IN FUNPOW (IMAGE f) n s)
2552Proof
2553 RW_TAC std_ss [SPECIFICATION, schroeder_close_def]
2554QED
2555
2556Theorem SCHROEDER_CLOSED:
2557 !f s. (IMAGE f (schroeder_close f s)) SUBSET (schroeder_close f s)
2558Proof
2559 RW_TAC std_ss [SCHROEDER_CLOSE, IN_IMAGE, SUBSET_DEF]
2560 >> Q.EXISTS_TAC `SUC n`
2561 >> RW_TAC std_ss [FUNPOW_SUC, IN_IMAGE]
2562 >> PROVE_TAC []
2563QED
2564
2565Theorem SCHROEDER_CLOSE_SUBSET: !f s. s SUBSET (schroeder_close f s)
2566Proof
2567 RW_TAC std_ss [SCHROEDER_CLOSE, IN_IMAGE, SUBSET_DEF]
2568 >> Q.EXISTS_TAC `0`
2569 >> RW_TAC std_ss [FUNPOW]
2570QED
2571
2572Theorem SCHROEDER_CLOSE_SET:
2573 !f s t. f IN (FUNSET s s) /\ t SUBSET s ==> (schroeder_close f t) SUBSET s
2574Proof
2575 RW_TAC std_ss [SCHROEDER_CLOSE, SUBSET_DEF, IN_FUNSET]
2576 >> POP_ASSUM MP_TAC
2577 >> Q.SPEC_TAC (`x`, `x`)
2578 >> Induct_on `n` >- RW_TAC std_ss [FUNPOW]
2579 >> RW_TAC std_ss [FUNPOW_SUC, IN_IMAGE]
2580 >> PROVE_TAC []
2581QED
2582
2583Theorem SCHROEDER_BERNSTEIN_AUTO:
2584 !s t. t SUBSET s /\ (?f. INJ f s t) ==> ?g. BIJ g s t
2585Proof
2586 RW_TAC std_ss [INJ_DEF]
2587 >> Q.EXISTS_TAC `\x. if x IN (schroeder_close f (s DIFF t)) then f x else x`
2588 >> Know `(s DIFF (schroeder_close f (s DIFF t))) SUBSET t`
2589 >- ( RW_TAC std_ss [SUBSET_DEF, IN_DIFF] \\
2590 Suff `~(x IN s DIFF t)` >- RW_TAC std_ss [IN_DIFF] \\
2591 PROVE_TAC [SCHROEDER_CLOSE_SUBSET, SUBSET_DEF] )
2592 >> Know `schroeder_close f (s DIFF t) SUBSET s`
2593 >- ( MATCH_MP_TAC SCHROEDER_CLOSE_SET \\
2594 RW_TAC std_ss [SUBSET_DEF, IN_DIFF, IN_FUNSET] \\
2595 PROVE_TAC [SUBSET_DEF] )
2596 >> Q.PAT_X_ASSUM `t SUBSET s` MP_TAC
2597 >> RW_TAC std_ss [SUBSET_DEF, IN_DIFF]
2598 >> RW_TAC std_ss [BIJ_DEF] (* 2 sub-goals here, first is easy *)
2599 >- ( BasicProvers.NORM_TAC std_ss [INJ_DEF] \\ (* 2 sub-goals, same tactical *)
2600 PROVE_TAC [SCHROEDER_CLOSED, SUBSET_DEF, IN_IMAGE] )
2601 >> RW_TAC std_ss [SURJ_DEF] (* 2 sub-goals here *)
2602 >| [ (* goal 1 (of 2) *)
2603 REVERSE (Cases_on `x IN (schroeder_close f (s DIFF t))`) >- PROVE_TAC [] \\
2604 POP_ASSUM MP_TAC >> RW_TAC std_ss [SCHROEDER_CLOSE],
2605 (* goal 2 (of 2) *)
2606 REVERSE (Cases_on `x IN (schroeder_close f (s DIFF t))`) >- PROVE_TAC [] \\
2607 POP_ASSUM MP_TAC >> RW_TAC std_ss [SCHROEDER_CLOSE] \\
2608 Cases_on `n` >- (POP_ASSUM MP_TAC >> RW_TAC std_ss [FUNPOW, IN_DIFF]) \\
2609 POP_ASSUM MP_TAC >> RW_TAC std_ss [FUNPOW_SUC, IN_IMAGE] \\
2610 Q.EXISTS_TAC `x'` >> POP_ASSUM MP_TAC \\
2611 Q.SPEC_TAC (`n'`, `n`) >> CONV_TAC FORALL_IMP_CONV \\
2612 REWRITE_TAC [GSYM SCHROEDER_CLOSE] \\
2613 RW_TAC std_ss [] ]
2614QED
2615
2616Theorem SCHROEDER_BERNSTEIN:
2617 !s t. (?f. INJ f s t) /\ (?g. INJ g t s) ==> (?h. BIJ h s t)
2618Proof
2619 REPEAT STRIP_TAC
2620 >> MATCH_MP_TAC (INST_TYPE [``:'c`` |-> ``:'a``] BIJ_TRANS)
2621 >> Q.EXISTS_TAC `IMAGE g t` >> CONJ_TAC (* 2 sub-goals here *)
2622 >| [ (* goal 1 (of 2) *)
2623 MATCH_MP_TAC SCHROEDER_BERNSTEIN_AUTO \\
2624 CONJ_TAC >| (* 2 sub-goals here *)
2625 [ (* goal 1.1 (of 2) *)
2626 POP_ASSUM MP_TAC \\
2627 RW_TAC std_ss [INJ_DEF, SUBSET_DEF, IN_IMAGE] \\
2628 PROVE_TAC [],
2629 (* goal 1.2 (of 2) *)
2630 Q.EXISTS_TAC `g o f` >> rpt (POP_ASSUM MP_TAC) \\
2631 RW_TAC std_ss [INJ_DEF, SUBSET_DEF, IN_IMAGE, o_DEF] \\
2632 PROVE_TAC [] ],
2633 (* goal 2 (of 2) *)
2634 MATCH_MP_TAC BIJ_SYM_IMP \\
2635 Q.EXISTS_TAC `g` >> PROVE_TAC [INJ_IMAGE_BIJ] ]
2636QED
2637
2638Theorem BIJ_INJ_SURJ:
2639 !s t. (?f. INJ f s t) /\ (?g. SURJ g s t) ==> (?h. BIJ h s t)
2640Proof
2641 REPEAT STRIP_TAC
2642 >> MATCH_MP_TAC SCHROEDER_BERNSTEIN
2643 >> CONJ_TAC >- PROVE_TAC []
2644 >> PROVE_TAC [SURJ_IMP_INJ]
2645QED
2646
2647Theorem BIJ_ALT:
2648 !f s t. BIJ f s t <=>
2649 f IN (FUNSET s t) /\ (!y. y IN t ==> ?!x. x IN s /\ (y = f x))
2650Proof
2651 RW_TAC std_ss [BIJ_DEF, INJ_DEF, SURJ_DEF, EXISTS_UNIQUE_ALT]
2652 >> RW_TAC std_ss [IN_FUNSET, IN_DFUNSET, GSYM CONJ_ASSOC]
2653 >> Know `!a b c. (a ==> (b = c)) ==> (a /\ b <=> a /\ c)` >- PROVE_TAC []
2654 >> DISCH_THEN MATCH_MP_TAC
2655 >> REPEAT (STRIP_TAC ORELSE EQ_TAC) (* 4 sub-goals here *)
2656 >| [ (* goal 1 (of 4) *)
2657 PROVE_TAC [],
2658 (* goal 2 (of 4) *)
2659 Q.PAT_X_ASSUM `!x. P x`
2660 (fn th =>
2661 MP_TAC (Q.SPEC `(f :'a-> 'b) x` th) \\
2662 MP_TAC (Q.SPEC `(f:'a->'b) y` th)) \\
2663 impl_tac >- PROVE_TAC [] \\
2664 STRIP_TAC \\
2665 impl_tac >- PROVE_TAC [] \\
2666 STRIP_TAC >> PROVE_TAC [],
2667 (* goal 3 (of 4) *)
2668 PROVE_TAC [],
2669 (* goal 4 (of 4) *)
2670 PROVE_TAC [] ]
2671QED
2672
2673(* Theorem: BIJ f s t <=> (!x. x IN s ==> f x IN t) /\ (!y. y IN t ==> ?!x. x IN s /\ (f x = y)) *)
2674(* Proof:
2675 This is to prove:
2676 (1) y IN t ==> ?!x. x IN s /\ (f x = y)
2677 x exists by SURJ_DEF, and x is unique by INJ_DEF.
2678 (2) x IN s /\ y IN s /\ f x = f y ==> x = y
2679 true by INJ_DEF.
2680 (3) x IN t ==> ?y. y IN s /\ (f y = x)
2681 true by SURJ_DEF.
2682*)
2683Theorem BIJ_THM:
2684 !f s t. BIJ f s t <=> (!x. x IN s ==> f x IN t) /\ (!y. y IN t ==> ?!x. x IN s /\ (f x = y))
2685Proof
2686 RW_TAC std_ss [BIJ_DEF, INJ_DEF, SURJ_DEF, EQ_IMP_THM] >> metis_tac[]
2687QED
2688
2689Theorem BIJ_INSERT_IMP:
2690 !f e s t.
2691 ~(e IN s) /\ BIJ f (e INSERT s) t ==>
2692 ?u. (f e INSERT u = t) /\ ~(f e IN u) /\ BIJ f s u
2693Proof
2694 RW_TAC std_ss [BIJ_ALT]
2695 >> Q.EXISTS_TAC `t DELETE f e`
2696 >> FULL_SIMP_TAC std_ss [IN_FUNSET, INSERT_DELETE, ELT_IN_DELETE, IN_INSERT,
2697 DISJ_IMP_THM]
2698 >> SIMP_TAC std_ss [IN_DELETE]
2699 >> REPEAT STRIP_TAC (* 3 sub-goals here *)
2700 >> METIS_TAC [IN_INSERT]
2701QED
2702
2703Theorem BIJ_IMAGE:
2704 !f s t. BIJ f s t ==> (t = IMAGE f s)
2705Proof
2706 RW_TAC std_ss [BIJ_DEF, SURJ_DEF, EXTENSION, IN_IMAGE]
2707 >> PROVE_TAC []
2708QED
2709
2710(* ===================================================================== *)
2711(* Left and right inverses. *)
2712(* ===================================================================== *)
2713
2714(* Left inverse, to option type, result is NONE outside image of domain *)
2715Definition LINV_OPT_def[nocompute]:
2716 LINV_OPT f s y =
2717 if y IN IMAGE f s then SOME (@x. x IN s /\ (f x = y)) else NONE
2718End
2719
2720Theorem SELECT_EQ_AX[local]:
2721 ($@ P = x) ==> $? P ==> P x
2722Proof
2723 DISCH_THEN (fn th => REWRITE_TAC [SYM th]) THEN DISCH_TAC THEN
2724 irule SELECT_AX THEN ASM_REWRITE_TAC [ETA_AX]
2725QED
2726
2727Theorem IN_IMAGE'[local]:
2728 y IN IMAGE f s <=> ?x. x IN s /\ (f x = y)
2729Proof
2730 mesonLib.MESON_TAC [IN_IMAGE]
2731QED
2732
2733Theorem LINV_OPT_THM:
2734 (LINV_OPT f s y = SOME x) ==> x IN s /\ (f x = y)
2735Proof
2736 REWRITE_TAC [LINV_OPT_def, IN_IMAGE'] THEN COND_CASES_TAC THEN
2737 REWRITE_TAC [SOME_11, NOT_NONE_SOME] THEN
2738 RULE_ASSUM_TAC (BETA_RULE o
2739 Ho_Rewrite.ONCE_REWRITE_RULE [GSYM SELECT_THM]) THEN
2740 DISCH_TAC THEN BasicProvers.VAR_EQ_TAC THEN FIRST_ASSUM ACCEPT_TAC
2741QED
2742
2743Theorem INJ_LINV_OPT_IMAGE:
2744 INJ (LINV_OPT f s) (IMAGE f s) (IMAGE SOME s)
2745Proof
2746 REWRITE_TAC [INJ_DEF, LINV_OPT_def] THEN
2747 CONJ_TAC THEN REPEAT GEN_TAC THEN DISCH_TAC THEN
2748 ASM_REWRITE_TAC [SOME_11] THEN
2749 RULE_L_ASSUM_TAC (CONJUNCTS o Ho_Rewrite.REWRITE_RULE [IN_IMAGE',
2750 GSYM SELECT_THM, BETA_THM])
2751 THENL [
2752 irule IMAGE_IN THEN FIRST_ASSUM ACCEPT_TAC,
2753 DISCH_THEN (MP_TAC o Q.AP_TERM `f`) THEN ASM_REWRITE_TAC []]
2754QED
2755
2756Theorem INJ_LINV_OPT:
2757 INJ f s t ==> !x:'a. !y:'b.
2758 (LINV_OPT f s y = SOME x) <=> (y = f x) /\ x IN s /\ y IN t
2759Proof
2760 REWRITE_TAC [LINV_OPT_def, INJ_DEF, IN_IMAGE] THEN
2761 REPEAT STRIP_TAC THEN
2762 REVERSE COND_CASES_TAC THEN FULL_SIMP_TAC std_ss [] THEN
2763 EQ_TAC THENL [
2764 DISCH_THEN (ASSUME_TAC o MATCH_MP SELECT_EQ_AX) THEN
2765 VALIDATE (POP_ASSUM (fn th => REWRITE_TAC [BETA_RULE (UNDISCH th)])) THEN
2766 Q.EXISTS_TAC `x'` THEN ASM_REWRITE_TAC [],
2767 DISCH_TAC THEN irule SELECT_UNIQUE THEN
2768 BETA_TAC THEN GEN_TAC THEN EQ_TAC
2769 THENL [
2770 FIRST_X_ASSUM (ASSUME_TAC o Q.SPECL [`y'`, `x`]) THEN
2771 REPEAT STRIP_TAC THEN RES_TAC THEN FULL_SIMP_TAC bool_ss [],
2772 REPEAT STRIP_TAC THEN ASM_REWRITE_TAC []]]
2773QED
2774
2775(* LINV was previously "defined" by new_specification, giving LINV_DEF *)
2776Definition LINV_LO[nocompute]:
2777 LINV f s y = THE (LINV_OPT f s y)
2778End
2779
2780(* --------------------------------------------------------------------- *)
2781(* LINV_DEF: *)
2782(* |- !f s t. INJ f s t ==> (!x. x IN s ==> (LINV f s(f x) = x)) *)
2783(* --------------------------------------------------------------------- *)
2784
2785Theorem LINV_DEF:
2786 !f s t. INJ f s t ==> (!x. x IN s ==> (LINV f s (f x) = x))
2787Proof
2788 REWRITE_TAC [LINV_LO] THEN REPEAT GEN_TAC THEN
2789 DISCH_THEN (fn th => ASSUME_TAC th THEN
2790 ASSUME_TAC (MATCH_MP INJ_LINV_OPT th)) THEN
2791 GEN_TAC THEN POP_ASSUM (ASSUME_TAC o Q.SPECL [`x`, `f x`]) THEN
2792 DISCH_TAC THEN FULL_SIMP_TAC std_ss [INJ_DEF] THEN
2793 RES_TAC THEN FULL_SIMP_TAC std_ss []
2794QED
2795
2796Theorem BIJ_LINV_INV:
2797 !f s t. BIJ f s t ==> !x. x IN t ==> (f (LINV f s x) = x)
2798Proof
2799RW_TAC bool_ss [BIJ_DEF] THEN
2800IMP_RES_TAC LINV_DEF THEN FULL_SIMP_TAC bool_ss [INJ_DEF, SURJ_DEF] THEN
2801METIS_TAC []
2802QED
2803
2804Theorem BIJ_LINV_BIJ:
2805 !f s t. BIJ f s t ==> BIJ (LINV f s) t s
2806Proof
2807RW_TAC bool_ss [BIJ_DEF] THEN
2808IMP_RES_TAC LINV_DEF THEN FULL_SIMP_TAC bool_ss [INJ_DEF, SURJ_DEF] THEN
2809METIS_TAC []
2810QED
2811
2812Theorem BIJ_IFF_INV:
2813 !f s t. BIJ f s t <=>
2814 (!x. x IN s ==> f x IN t) /\
2815 ?g. (!x. x IN t ==> g x IN s) /\
2816 (!x. x IN s ==> (g (f x) = x)) /\
2817 (!x. x IN t ==> (f (g x) = x))
2818Proof
2819REPEAT GEN_TAC THEN
2820EQ_TAC THEN STRIP_TAC THEN1 (
2821 CONJ_TAC THEN1 METIS_TAC [BIJ_DEF,INJ_DEF] THEN
2822 Q.EXISTS_TAC `LINV f s` THEN
2823 IMP_RES_TAC BIJ_LINV_BIJ THEN
2824 CONJ_TAC THEN1 METIS_TAC [BIJ_DEF,INJ_DEF] THEN
2825 CONJ_TAC THEN1 METIS_TAC [BIJ_DEF,LINV_DEF] THEN
2826 METIS_TAC [BIJ_LINV_INV] ) THEN
2827SRW_TAC [][BIJ_DEF,INJ_DEF,SURJ_DEF] THEN
2828METIS_TAC []
2829QED
2830
2831Theorem BIJ_support:
2832 !f s' s.
2833 BIJ f s' s' /\ s' SUBSET s /\ (!x. x NOTIN s' ==> (f x = x)) ==>
2834 BIJ f s s
2835Proof
2836 rw[BIJ_IFF_INV,SUBSET_DEF] >- METIS_TAC[]
2837 \\ Q.EXISTS_TAC ‘\x. if x IN s' then g x else x’
2838 \\ rw[] \\ METIS_TAC[]
2839QED
2840
2841Theorem BIJ_INSERT:
2842 !f e s t. BIJ f (e INSERT s) t <=>
2843 e NOTIN s /\ f e IN t /\ BIJ f s (t DELETE f e) \/
2844 e IN s /\ BIJ f s t
2845Proof
2846 REPEAT GEN_TAC THEN
2847 Cases_on `e IN s` THEN1
2848 (SRW_TAC [][ABSORPTION |> SPEC_ALL |> EQ_IMP_RULE |> #1]) THEN
2849 SRW_TAC [][] THEN SRW_TAC [][BIJ_IFF_INV] THEN EQ_TAC THENL [
2850 SRW_TAC [][DISJ_IMP_THM, FORALL_AND_THM] THEN METIS_TAC [],
2851 SRW_TAC [][DISJ_IMP_THM, FORALL_AND_THM] THEN
2852 Q.EXISTS_TAC `\x. if x = f e then e else g x` THEN
2853 SRW_TAC [][]
2854 ]
2855QED
2856
2857(* RINV was previously "defined" by new_specification, giving RINV_DEF *)
2858Definition RINV_LO[nocompute]:
2859 RINV f s y = THE (LINV_OPT f s y)
2860End
2861
2862(* --------------------------------------------------------------------- *)
2863(* RINV_DEF: *)
2864(* |- !f s t. SURJ f s t ==> (!x. x IN t ==> (f(RINV f s x) = x)) *)
2865(* --------------------------------------------------------------------- *)
2866
2867Theorem RINV_DEF:
2868 !f s t. SURJ f s t ==> (!x. x IN t ==> (f (RINV f s x) = x))
2869Proof
2870 REPEAT GEN_TAC THEN
2871 DISCH_THEN (fn th => ASSUME_TAC th THEN
2872 ASSUME_TAC (REWRITE_RULE [IMAGE_SURJ] th)) THEN
2873 REPEAT STRIP_TAC THEN
2874 FULL_SIMP_TAC std_ss [RINV_LO, SURJ_DEF, LINV_OPT_def, THE_DEF] THEN
2875 RES_TAC THEN
2876 irule (BETA_RULE (Q.SPECL [`P`, `\y. f y = x`] SELECT_ELIM_THM)) THEN
2877 CONJ_TAC THEN1 SIMP_TAC std_ss [] THEN
2878 Q.EXISTS_TAC `y` THEN ASM_SIMP_TAC std_ss []
2879QED
2880
2881Theorem SURJ_INJ_INV:
2882 SURJ f s t ==> ?g. INJ g t s /\ !y. y IN t ==> (f (g y) = y)
2883Proof
2884 REWRITE_TAC [IMAGE_SURJ] THEN
2885 DISCH_TAC THEN Q.EXISTS_TAC `THE o LINV_OPT f s` THEN
2886 BasicProvers.VAR_EQ_TAC THEN REPEAT STRIP_TAC
2887 THENL [
2888 irule INJ_COMPOSE THEN Q.EXISTS_TAC `IMAGE SOME s` THEN
2889 REWRITE_TAC [INJ_LINV_OPT_IMAGE] THEN REWRITE_TAC [INJ_DEF, IN_IMAGE] THEN
2890 REPEAT STRIP_TAC THEN REPEAT BasicProvers.VAR_EQ_TAC THEN
2891 FULL_SIMP_TAC std_ss [THE_DEF],
2892 ASM_REWRITE_TAC [LINV_OPT_def, o_THM, THE_DEF] THEN
2893 RULE_ASSUM_TAC (Ho_Rewrite.REWRITE_RULE
2894 [IN_IMAGE', GSYM SELECT_THM, BETA_THM]) THEN ASM_REWRITE_TAC [] ]
2895QED
2896
2897(* ===================================================================== *)
2898(* Finiteness *)
2899(* ===================================================================== *)
2900
2901val FINITE_DEF =
2902 new_definition
2903 ("FINITE_DEF",
2904 (“!s:'a set.
2905 FINITE s = !P. P EMPTY /\ (!s. P s ==> !e. P (e INSERT s)) ==> P s”));
2906val _ = ot0 "FINITE" "finite"
2907
2908Theorem FINITE_EMPTY:
2909 FINITE (EMPTY:'a set)
2910Proof
2911 PURE_ONCE_REWRITE_TAC [FINITE_DEF] THEN
2912 REPEAT STRIP_TAC
2913QED
2914
2915val FINITE_INSERT =
2916 TAC_PROOF
2917 (([], (“!s. FINITE s ==> !x:'a. FINITE (x INSERT s)”)),
2918 PURE_ONCE_REWRITE_TAC [FINITE_DEF] THEN
2919 REPEAT STRIP_TAC THEN SPEC_TAC ((“x:'a”),(“x:'a”)) THEN
2920 REPEAT (FIRST_ASSUM MATCH_MP_TAC) THEN
2921 CONJ_TAC THEN FIRST_ASSUM MATCH_ACCEPT_TAC);
2922
2923(* |- FINITE {} /\ !x s. FINITE (x INSERT s) <=> FINITE s *)
2924Theorem FINITE_RULES = CONJ FINITE_EMPTY FINITE_INSERT
2925
2926Theorem SIMPLE_FINITE_INDUCT:
2927 !P. P EMPTY /\ (!s. P s ==> (!e:'a. P(e INSERT s)))
2928 ==>
2929 !s. FINITE s ==> P s
2930Proof
2931 GEN_TAC THEN STRIP_TAC THEN
2932 PURE_ONCE_REWRITE_TAC [FINITE_DEF] THEN
2933 GEN_TAC THEN DISCH_THEN MATCH_MP_TAC THEN
2934 ASM_REWRITE_TAC []
2935QED
2936
2937val lemma =
2938 let val tac = ASM_CASES_TAC (“P:bool”) THEN ASM_REWRITE_TAC[]
2939 val lem = TAC_PROOF(([],(“(P ==> P /\ Q) = (P ==> Q)”)), tac)
2940 val th1 = SPEC (“\s:'a set. FINITE s /\ P s”)
2941 SIMPLE_FINITE_INDUCT
2942 in REWRITE_RULE [lem,FINITE_EMPTY] (BETA_RULE th1)
2943 end;
2944
2945Theorem FINITE_INDUCT[rule_induction]:
2946 !P. P {} /\ (!s. FINITE s /\ P s ==> (!e. ~(e IN s) ==> P(e INSERT s))) ==>
2947 !s:'a set. FINITE s ==> P s
2948Proof
2949 GEN_TAC THEN STRIP_TAC THEN
2950 MATCH_MP_TAC lemma THEN
2951 ASM_REWRITE_TAC [] THEN
2952 REPEAT STRIP_TAC THENL
2953 [IMP_RES_THEN MATCH_ACCEPT_TAC FINITE_INSERT,
2954 ASM_CASES_TAC (“(e:'a) IN s”) THENL
2955 [IMP_RES_THEN SUBST1_TAC ABSORPTION, RES_TAC] THEN
2956 ASM_REWRITE_TAC []]
2957QED
2958
2959(* HOL-Light compatible name. It's not stronger than the above FINITE_INDUCT. *)
2960Theorem FINITE_INDUCT_STRONG :
2961 !P. P {} /\ (!x s. P s /\ ~(x IN s) /\ FINITE s ==> P (x INSERT s))
2962 ==> (!s. FINITE s ==> P s)
2963Proof
2964 GEN_TAC >> STRIP_TAC
2965 >> MATCH_MP_TAC FINITE_INDUCT >> rw []
2966QED
2967
2968(* --------------------------------------------------------------------- *)
2969(* Load the set induction tactic in... *)
2970(* --------------------------------------------------------------------- *)
2971
2972val SET_INDUCT_TAC = PSet_ind.SET_INDUCT_TAC FINITE_INDUCT;
2973
2974val set_tyinfo = TypeBasePure.mk_nondatatype_info
2975 (``:'a set``,
2976 {nchotomy = SOME SET_CASES,
2977 induction= SOME FINITE_INDUCT,
2978 size=NONE,
2979 encode=NONE});
2980
2981val _ = TypeBase.export [set_tyinfo];
2982
2983val FINITE_DELETE =
2984 TAC_PROOF
2985 (([], “!s. FINITE s ==> !x:'a. FINITE (s DELETE x)”),
2986 SET_INDUCT_TAC THENL
2987 [REWRITE_TAC [EMPTY_DELETE,FINITE_EMPTY],
2988 PURE_ONCE_REWRITE_TAC [DELETE_INSERT] THEN
2989 REPEAT STRIP_TAC THEN
2990 COND_CASES_TAC THENL
2991 [FIRST_ASSUM MATCH_ACCEPT_TAC,
2992 FIRST_ASSUM (fn th => fn g => ASSUME_TAC (SPEC (“x:'a”) th) g) THEN
2993 IMP_RES_TAC FINITE_INSERT THEN
2994 FIRST_ASSUM MATCH_ACCEPT_TAC]]);
2995
2996val INSERT_FINITE =
2997 TAC_PROOF
2998 (([], (“!x:'a. !s. FINITE(x INSERT s) ==> FINITE s”)),
2999 REPEAT GEN_TAC THEN ASM_CASES_TAC (“(x:'a) IN s”) THENL
3000 [IMP_RES_TAC ABSORPTION THEN ASM_REWRITE_TAC [],
3001 DISCH_THEN (MP_TAC o SPEC (“x:'a”) o MATCH_MP FINITE_DELETE) THEN
3002 REWRITE_TAC [DELETE_INSERT] THEN
3003 IMP_RES_TAC DELETE_NON_ELEMENT THEN ASM_REWRITE_TAC[]]);
3004
3005Theorem FINITE_INSERT:
3006 !x:'a. !s. FINITE(x INSERT s) = FINITE s
3007Proof
3008 REPEAT GEN_TAC THEN EQ_TAC THENL
3009 [MATCH_ACCEPT_TAC INSERT_FINITE,
3010 DISCH_THEN (MATCH_ACCEPT_TAC o MATCH_MP FINITE_INSERT)]
3011QED
3012
3013val _ = export_rewrites ["FINITE_EMPTY", "FINITE_INSERT"]
3014
3015val DELETE_FINITE =
3016 TAC_PROOF
3017 (([], (“!x:'a. !s. FINITE (s DELETE x) ==> FINITE s”)),
3018 REPEAT GEN_TAC THEN ASM_CASES_TAC (“(x:'a) IN s”) THEN
3019 DISCH_TAC THENL
3020 [IMP_RES_THEN (SUBST1_TAC o SYM) INSERT_DELETE THEN
3021 ASM_REWRITE_TAC [FINITE_INSERT],
3022 IMP_RES_THEN (SUBST1_TAC o SYM) DELETE_NON_ELEMENT THEN
3023 FIRST_ASSUM ACCEPT_TAC]);
3024
3025
3026Theorem FINITE_DELETE[simp]:
3027 !x:'a. !s. FINITE(s DELETE x) <=> FINITE s
3028Proof
3029 REPEAT GEN_TAC THEN EQ_TAC THENL
3030 [MATCH_ACCEPT_TAC DELETE_FINITE,
3031 DISCH_THEN (MATCH_ACCEPT_TAC o MATCH_MP FINITE_DELETE)]
3032QED
3033
3034Theorem FINITE_REST:
3035 !s:'a set. FINITE s ==> FINITE (REST s)
3036Proof
3037 REWRITE_TAC [REST_DEF, FINITE_DELETE]
3038QED
3039
3040Theorem FINITE_REST_EQ:
3041 !s. FINITE (REST s) = FINITE s
3042Proof
3043 RW_TAC std_ss [REST_DEF, FINITE_DELETE]
3044QED
3045
3046Theorem UNION_FINITE[local]:
3047 !s:'a set. FINITE s ==> !t. FINITE t ==> FINITE (s UNION t)
3048Proof
3049 SET_INDUCT_TAC THENL [
3050 REWRITE_TAC [UNION_EMPTY],
3051 SET_INDUCT_TAC THENL [
3052 IMP_RES_TAC FINITE_INSERT THEN ASM_REWRITE_TAC [UNION_EMPTY],
3053 `(e INSERT s) UNION (e' INSERT s') =
3054 s UNION (e INSERT e' INSERT s')` by
3055 SIMP_TAC bool_ss [IN_UNION, EXTENSION, IN_INSERT, NOT_IN_EMPTY,
3056 EQ_IMP_THM, FORALL_AND_THM, DISJ_IMP_THM] THEN
3057 ASM_SIMP_TAC bool_ss [FINITE_INSERT, FINITE_EMPTY]
3058 ]
3059 ]
3060QED
3061
3062val FINITE_UNION_LEMMA = TAC_PROOF(([],
3063“!s:'a set. FINITE s ==> !t. FINITE (s UNION t) ==> FINITE t”),
3064 SET_INDUCT_TAC THENL
3065 [REWRITE_TAC [UNION_EMPTY],
3066 GEN_TAC THEN ASM_REWRITE_TAC [INSERT_UNION] THEN
3067 COND_CASES_TAC THENL
3068 [FIRST_ASSUM MATCH_ACCEPT_TAC,
3069 DISCH_THEN (MP_TAC o MATCH_MP INSERT_FINITE) THEN
3070 FIRST_ASSUM MATCH_ACCEPT_TAC]]);
3071
3072Theorem FINITE_UNION[local]:
3073 !s:'a set. !t. FINITE(s UNION t) ==> (FINITE s /\ FINITE t)
3074Proof
3075 REPEAT STRIP_TAC THEN IMP_RES_THEN MATCH_MP_TAC FINITE_UNION_LEMMA THEN
3076 PROVE_TAC [UNION_COMM, UNION_ASSOC, UNION_IDEMPOT]
3077QED
3078
3079Theorem FINITE_UNION[simp]:
3080 !s:'a set. !t. FINITE(s UNION t) <=> FINITE s /\ FINITE t
3081Proof
3082 REPEAT STRIP_TAC THEN EQ_TAC THENL
3083 [REPEAT STRIP_TAC THEN IMP_RES_TAC FINITE_UNION,
3084 REPEAT STRIP_TAC THEN IMP_RES_TAC UNION_FINITE]
3085QED
3086
3087Theorem INTER_FINITE:
3088 !s:'a set. FINITE s ==> !t. FINITE (s INTER t)
3089Proof
3090 SET_INDUCT_TAC THENL
3091 [REWRITE_TAC [INTER_EMPTY,FINITE_EMPTY],
3092 REWRITE_TAC [INSERT_INTER] THEN GEN_TAC THEN
3093 COND_CASES_TAC THENL
3094 [FIRST_ASSUM (fn th => fn g => ASSUME_TAC (SPEC (“t:'a set”) th) g
3095 handle _ => NO_TAC g) THEN
3096 IMP_RES_TAC FINITE_INSERT THEN
3097 FIRST_ASSUM MATCH_ACCEPT_TAC,
3098 FIRST_ASSUM MATCH_ACCEPT_TAC]]
3099QED
3100
3101Theorem SUBSET_FINITE:
3102 !s:'a set. FINITE s ==> (!t. t SUBSET s ==> FINITE t)
3103Proof
3104 SET_INDUCT_TAC THENL
3105 [PURE_ONCE_REWRITE_TAC [SUBSET_EMPTY] THEN
3106 REPEAT STRIP_TAC THEN ASM_REWRITE_TAC [FINITE_EMPTY],
3107 GEN_TAC THEN ASM_CASES_TAC (“(e:'a) IN t”) THENL
3108 [REWRITE_TAC [SUBSET_INSERT_DELETE] THEN
3109 STRIP_TAC THEN RES_TAC THEN IMP_RES_TAC DELETE_FINITE,
3110 IMP_RES_TAC SUBSET_INSERT THEN ASM_REWRITE_TAC []]]
3111QED
3112
3113Theorem SUBSET_FINITE_I:
3114 !s t. FINITE s /\ t SUBSET s ==> FINITE t
3115Proof
3116 METIS_TAC [SUBSET_FINITE]
3117QED
3118
3119
3120Theorem PSUBSET_FINITE:
3121 !s:'a set. FINITE s ==> (!t. t PSUBSET s ==> FINITE t)
3122Proof
3123 PURE_ONCE_REWRITE_TAC [PSUBSET_DEF] THEN
3124 REPEAT STRIP_TAC THEN IMP_RES_TAC SUBSET_FINITE
3125QED
3126
3127Theorem FINITE_DIFF[simp]:
3128 !s:'a set. FINITE s ==> !t. FINITE(s DIFF t)
3129Proof
3130 SET_INDUCT_TAC THENL
3131 [REWRITE_TAC [EMPTY_DIFF,FINITE_EMPTY],
3132 ASM_REWRITE_TAC [INSERT_DIFF] THEN
3133 GEN_TAC THEN COND_CASES_TAC THENL
3134 [FIRST_ASSUM MATCH_ACCEPT_TAC,
3135 FIRST_ASSUM (fn th => fn g => ASSUME_TAC (SPEC (“t:'a set”)th) g)
3136 THEN IMP_RES_THEN MATCH_ACCEPT_TAC FINITE_INSERT]]
3137QED
3138
3139Theorem FINITE_DIFF_down:
3140 !P Q. FINITE (P DIFF Q) /\ FINITE Q ==> FINITE P
3141Proof
3142 Induct_on ‘FINITE Q’ >>
3143 SRW_TAC [][DIFF_EMPTY] >>
3144 PROVE_TAC [DIFF_INSERT, FINITE_DELETE]
3145QED
3146
3147Theorem FINITE_SING[simp]:
3148 !x:'a. FINITE {x}
3149Proof
3150 GEN_TAC THEN MP_TAC FINITE_EMPTY THEN
3151 SUBST1_TAC (SYM (SPEC (“x:'a”) SING_DELETE)) THEN
3152 DISCH_TAC THEN IMP_RES_THEN MATCH_ACCEPT_TAC FINITE_INSERT
3153QED
3154
3155Theorem SING_FINITE:
3156 !s:'a set. SING s ==> FINITE s
3157Proof
3158 PURE_ONCE_REWRITE_TAC [SING_DEF] THEN
3159 GEN_TAC THEN DISCH_THEN (STRIP_THM_THEN SUBST1_TAC) THEN
3160 MATCH_ACCEPT_TAC FINITE_SING
3161QED
3162
3163Theorem IMAGE_FINITE:
3164 !s. FINITE s ==> !f:'a->'b. FINITE(IMAGE f s)
3165Proof
3166 SET_INDUCT_TAC THENL
3167 [REWRITE_TAC [IMAGE_EMPTY,FINITE_EMPTY],
3168 ASM_REWRITE_TAC [IMAGE_INSERT,FINITE_INSERT]]
3169QED
3170
3171Theorem FINITELY_INJECTIVE_IMAGE_FINITE:
3172 !f. (!x. FINITE { y | x = f y }) ==> !s. FINITE (IMAGE f s) = FINITE s
3173Proof
3174 GEN_TAC THEN STRIP_TAC THEN
3175 SIMP_TAC (srw_ss()) [EQ_IMP_THM, FORALL_AND_THM, IMAGE_FINITE] THEN
3176 Induct_on ‘FINITE’ THEN
3177 SRW_TAC [][] THEN
3178 Q.RENAME_TAC [‘IMAGE f P = e INSERT Q’] THEN
3179 `Q = IMAGE f (P DIFF { y | e = f y})`
3180 by (POP_ASSUM MP_TAC THEN
3181 SRW_TAC [][EXTENSION, IN_IMAGE, GSPECIFICATION] THEN
3182 PROVE_TAC []) THEN
3183 `FINITE (P DIFF { y | e = f y})` by PROVE_TAC [] THEN
3184 METIS_TAC [FINITE_DIFF_down]
3185QED
3186
3187Theorem image_eq_empty[local] :
3188 ({} = IMAGE f Q) <=> (Q = {})
3189Proof
3190 METIS_TAC[IMAGE_EQ_EMPTY]
3191QED
3192
3193Theorem FINITE_IMAGE_INJ' :
3194 (!x y. x IN s /\ y IN s ==> ((f x = f y) <=> (x = y))) ==>
3195 (FINITE (IMAGE f s) <=> FINITE s)
3196Proof
3197 STRIP_TAC THEN EQ_TAC THEN SIMP_TAC (srw_ss()) [IMAGE_FINITE] THEN
3198 `!P. FINITE P ==> !Q. Q SUBSET s /\ (P = IMAGE f Q) ==> FINITE Q`
3199 suffices_by METIS_TAC[SUBSET_REFL] THEN
3200 Induct_on `FINITE` THEN SIMP_TAC (srw_ss())[image_eq_empty] THEN
3201 Q.X_GEN_TAC `P` THEN STRIP_TAC THEN Q.X_GEN_TAC `e` THEN STRIP_TAC THEN
3202 Q.X_GEN_TAC `Q` THEN STRIP_TAC THEN
3203 `e IN IMAGE f Q` by METIS_TAC [IN_INSERT] THEN
3204 `?d. d IN Q /\ (e = f d)`
3205 by (POP_ASSUM MP_TAC THEN SIMP_TAC (srw_ss())[] THEN METIS_TAC[]) THEN
3206 `P = IMAGE f (Q DELETE d)`
3207 by (Q.UNDISCH_THEN `e INSERT P = IMAGE f Q` MP_TAC THEN
3208 SIMP_TAC (srw_ss()) [EXTENSION] THEN STRIP_TAC THEN
3209 Q.X_GEN_TAC `e0` THEN EQ_TAC THEN1
3210 (STRIP_TAC THEN `e0 <> e` by METIS_TAC[] THEN
3211 `?d0. (e0 = f d0) /\ d0 IN Q` by METIS_TAC[] THEN
3212 Q.EXISTS_TAC `d0` THEN ASM_SIMP_TAC (srw_ss()) [] THEN
3213 STRIP_TAC THEN METIS_TAC [SUBSET_DEF]) THEN
3214 DISCH_THEN (Q.X_CHOOSE_THEN `d0` STRIP_ASSUME_TAC) THEN
3215 METIS_TAC [SUBSET_DEF]) THEN
3216 `Q DELETE d SUBSET s` by FULL_SIMP_TAC(srw_ss())[SUBSET_DEF] THEN
3217 `FINITE (Q DELETE d)` by METIS_TAC[] THEN
3218 `Q = d INSERT (Q DELETE d)`
3219 by (SIMP_TAC (srw_ss()) [EXTENSION] THEN METIS_TAC[]) THEN
3220 POP_ASSUM SUBST1_TAC THEN ASM_SIMP_TAC (srw_ss())[]
3221QED
3222
3223Theorem FINITE_IMAGE_INJ_EQ :
3224 !(f:'a->'b) s.
3225 (!x y. x IN s /\ y IN s /\ (f(x) = f(y)) ==> (x = y)) ==>
3226 (FINITE(IMAGE f s) <=> FINITE s)
3227Proof
3228 metis_tac[FINITE_IMAGE_INJ']
3229QED
3230
3231Theorem INJECTIVE_IMAGE_FINITE[simp] :
3232 !f. (!x y. (f x = f y) = (x = y)) ==>
3233 !s. FINITE (IMAGE f s) = FINITE s
3234Proof
3235 rpt STRIP_TAC
3236 >> MATCH_MP_TAC FINITE_IMAGE_INJ_EQ
3237 >> RW_TAC std_ss []
3238QED
3239
3240Theorem lem[local]:
3241 !t. FINITE t ==> !s f. INJ f s t ==> FINITE s
3242Proof
3243 SET_INDUCT_TAC
3244 THEN RW_TAC bool_ss [INJ_EMPTY,FINITE_EMPTY]
3245 THEN Cases_on `?a. a IN s' /\ (f a = e)`
3246 THEN POP_ASSUM (STRIP_ASSUME_TAC o SIMP_RULE bool_ss []) THENL
3247 [RW_TAC bool_ss []
3248 THEN IMP_RES_TAC INJ_DELETE
3249 THEN FULL_SIMP_TAC bool_ss [DELETE_INSERT]
3250 THEN METIS_TAC [DELETE_NON_ELEMENT,FINITE_DELETE],
3251 Q.PAT_X_ASSUM `INJ x y z` MP_TAC
3252 THEN RW_TAC bool_ss [INJ_DEF]
3253 THEN `!x. x IN s' ==> f x IN s` by METIS_TAC [IN_INSERT]
3254 THEN `INJ f s' s` by METIS_TAC [INJ_DEF]
3255 THEN METIS_TAC[]]
3256QED
3257
3258Theorem FINITE_INJ:
3259 !(f:'a->'b) s t. INJ f s t /\ FINITE t ==> FINITE s
3260Proof
3261 METIS_TAC [lem]
3262QED
3263
3264Definition REL_RESTRICT_DEF[nocompute]:
3265 REL_RESTRICT R s x y <=> x IN s /\ y IN s /\ R x y
3266End
3267
3268Theorem REL_RESTRICT_EMPTY[simp]:
3269 REL_RESTRICT R {} = REMPTY
3270Proof
3271 SRW_TAC [][REL_RESTRICT_DEF, FUN_EQ_THM]
3272QED
3273
3274Theorem REL_RESTRICT_SUBSET:
3275 s1 SUBSET s2 ==> REL_RESTRICT R s1 RSUBSET REL_RESTRICT R s2
3276Proof
3277 SRW_TAC [][RSUBSET, REL_RESTRICT_DEF, SUBSET_DEF]
3278QED
3279
3280(* =====================================================================*)
3281(* Cardinality *)
3282(* =====================================================================*)
3283
3284(* --------------------------------------------------------------------- *)
3285(* card_rel_def: defining equations for a relation `R s n`, which means *)
3286(* that the finite s has cardinality n. *)
3287(* --------------------------------------------------------------------- *)
3288
3289val card_rel_def =
3290 (“(!s. R s 0 = (s = EMPTY)) /\
3291 (!s n. R s (SUC n) = ?x:'a. x IN s /\ R (s DELETE x) n)”);
3292
3293(* ---------------------------------------------------------------------*)
3294(* Prove that such a relation exists. *)
3295(* ---------------------------------------------------------------------*)
3296
3297val CARD_REL_EXISTS = prove_rec_fn_exists num_Axiom card_rel_def;
3298
3299(* ---------------------------------------------------------------------*)
3300(* Now, prove that it doesn't matter which element we delete *)
3301(* Proof modified for Version 12 IMP_RES_THEN [TFM 91.01.23] *)
3302(* ---------------------------------------------------------------------*)
3303
3304val CARD_REL_DEL_LEMMA =
3305 TAC_PROOF
3306 ((strip_conj card_rel_def,
3307 (“!(n:num) s (x:'a).
3308 x IN s ==>
3309 R (s DELETE x) n ==>
3310 !y:'a. y IN s ==> R (s DELETE y) n”)),
3311 INDUCT_TAC THENL
3312 [REPEAT GEN_TAC THEN DISCH_TAC THEN
3313 IMP_RES_TAC DELETE_EQ_SING THEN ASM_REWRITE_TAC [] THEN
3314 DISCH_THEN SUBST1_TAC THEN REWRITE_TAC [IN_SING] THEN
3315 GEN_TAC THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC [SING_DELETE],
3316 ASM_REWRITE_TAC [] THEN REPEAT STRIP_TAC THEN
3317 let val th = (SPEC (“y:'a = x'”) EXCLUDED_MIDDLE)
3318 in DISJ_CASES_THEN2 SUBST_ALL_TAC ASSUME_TAC th
3319 end
3320 THENL
3321 [MP_TAC (SPECL [(“s:'a set”),(“x:'a”),(“x':'a”)]
3322 IN_DELETE_EQ) THEN
3323 ASM_REWRITE_TAC [] THEN DISCH_TAC THEN
3324 PURE_ONCE_REWRITE_TAC [DELETE_COMM] THEN
3325 EXISTS_TAC (“x:'a”) THEN ASM_REWRITE_TAC[],
3326 let val th = (SPEC (“x:'a = y”) EXCLUDED_MIDDLE)
3327 in DISJ_CASES_THEN2 SUBST_ALL_TAC ASSUME_TAC th
3328 end
3329 THENL
3330 [EXISTS_TAC (“x':'a”) THEN ASM_REWRITE_TAC [],
3331 EXISTS_TAC (“x:'a”) THEN ASM_REWRITE_TAC [IN_DELETE] THEN
3332 RES_THEN (TRY o IMP_RES_THEN ASSUME_TAC) THEN
3333 PURE_ONCE_REWRITE_TAC [DELETE_COMM] THEN
3334 FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC [IN_DELETE] THEN
3335 CONV_TAC (ONCE_DEPTH_CONV SYM_CONV) THEN FIRST_ASSUM ACCEPT_TAC]]]);
3336
3337
3338(* --------------------------------------------------------------------- *)
3339(* So `R s` specifies a unique number. *)
3340(* --------------------------------------------------------------------- *)
3341
3342val CARD_REL_UNIQUE =
3343 TAC_PROOF
3344 ((strip_conj card_rel_def,
3345 (“!n:num. !s:'a set. R s n ==> (!m. R s m ==> (n = m))”)),
3346 INDUCT_TAC THEN ASM_REWRITE_TAC [] THENL
3347 [GEN_TAC THEN STRIP_TAC THEN INDUCT_TAC THEN
3348 CONV_TAC (ONCE_DEPTH_CONV SYM_CONV) THENL
3349 [STRIP_TAC THEN REFL_TAC, ASM_REWRITE_TAC[NOT_SUC,NOT_IN_EMPTY]],
3350 GEN_TAC THEN STRIP_TAC THEN INDUCT_TAC THENL
3351 [ASM_REWRITE_TAC [NOT_SUC,SYM(SPEC_ALL MEMBER_NOT_EMPTY)] THEN
3352 EXISTS_TAC (“x:'a”) THEN FIRST_ASSUM ACCEPT_TAC,
3353 ASM_REWRITE_TAC [INV_SUC_EQ] THEN STRIP_TAC THEN
3354 IMP_RES_TAC CARD_REL_DEL_LEMMA THEN RES_TAC]]);
3355
3356(* --------------------------------------------------------------------- *)
3357(* Now, ?n. R s n if s is finite. *)
3358(* --------------------------------------------------------------------- *)
3359
3360val CARD_REL_EXISTS_LEMMA = TAC_PROOF
3361((strip_conj card_rel_def,
3362 (“!s:'a set. FINITE s ==> ?n:num. R s n”)),
3363 SET_INDUCT_TAC THENL
3364 [EXISTS_TAC (“0”) THEN ASM_REWRITE_TAC[],
3365 FIRST_ASSUM (fn th => fn g => CHOOSE_THEN ASSUME_TAC th g) THEN
3366 EXISTS_TAC (“SUC n”) THEN ASM_REWRITE_TAC [] THEN
3367 EXISTS_TAC (“e:'a”) THEN IMP_RES_TAC DELETE_NON_ELEMENT THEN
3368 ASM_REWRITE_TAC [DELETE_INSERT,IN_INSERT]]);
3369
3370(* ---------------------------------------------------------------------*)
3371(* So (@n. R s n) = m iff R s m (\s.@n.R s n defines a function) *)
3372(* Proof modified for Version 12 IMP_RES_THEN [TFM 91.01.23] *)
3373(* ---------------------------------------------------------------------*)
3374
3375val CARD_REL_THM =
3376 TAC_PROOF
3377 ((strip_conj card_rel_def,
3378 (“!m s. FINITE s ==> (((@n:num. R (s:'a set) n) = m) = R s m)”)),
3379 REPEAT STRIP_TAC THEN
3380 IMP_RES_TAC CARD_REL_EXISTS_LEMMA THEN
3381 EQ_TAC THENL
3382 [DISCH_THEN (SUBST1_TAC o SYM) THEN CONV_TAC SELECT_CONV THEN
3383 EXISTS_TAC (“n:num”) THEN FIRST_ASSUM MATCH_ACCEPT_TAC,
3384 STRIP_TAC THEN
3385 IMP_RES_THEN ASSUME_TAC CARD_REL_UNIQUE THEN
3386 CONV_TAC SYM_CONV THEN
3387 FIRST_ASSUM MATCH_MP_TAC THEN
3388 CONV_TAC SELECT_CONV THEN
3389 EXISTS_TAC (“n:num”) THEN FIRST_ASSUM MATCH_ACCEPT_TAC]);
3390
3391(* ---------------------------------------------------------------------*)
3392(* Now, prove the existence of the required cardinality function. *)
3393(* ---------------------------------------------------------------------*)
3394
3395val CARD_EXISTS = TAC_PROOF(([],
3396(“ ?CARD.
3397 (CARD EMPTY = 0) /\
3398 (!s. FINITE s ==>
3399 !x:'a. CARD(x INSERT s) = (if x IN s then CARD s else SUC(CARD s)))”)),
3400 STRIP_ASSUME_TAC CARD_REL_EXISTS THEN
3401 EXISTS_TAC (“\s:'a set. @n:num. R s n”) THEN
3402 CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) THEN CONJ_TAC THENL
3403 [ASSUME_TAC FINITE_EMPTY THEN IMP_RES_TAC CARD_REL_THM THEN
3404 FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC [],
3405 REPEAT STRIP_TAC THEN COND_CASES_TAC THENL
3406 [IMP_RES_THEN SUBST1_TAC ABSORPTION THEN REFL_TAC,
3407 IMP_RES_THEN (ASSUME_TAC o SPEC (“x:'a”)) FINITE_INSERT THEN
3408 IMP_RES_THEN (TRY o MATCH_MP_TAC) CARD_REL_THM THEN
3409 ASM_REWRITE_TAC [] THEN EXISTS_TAC (“x:'a”) THEN
3410 IMP_RES_TAC DELETE_NON_ELEMENT THEN
3411 ASM_REWRITE_TAC [IN_INSERT,DELETE_INSERT] THEN
3412 CONV_TAC SELECT_CONV THEN
3413 IMP_RES_THEN (TRY o MATCH_ACCEPT_TAC) CARD_REL_EXISTS_LEMMA]]);
3414
3415(* ---------------------------------------------------------------------*)
3416(* Finally, introduce the CARD function via a constant specification. *)
3417(* ---------------------------------------------------------------------*)
3418
3419val CARD_DEF = new_specification ("CARD_DEF", ["CARD"], CARD_EXISTS);
3420
3421(* ---------------------------------------------------------------------*)
3422(* Various cardinality results. *)
3423(* ---------------------------------------------------------------------*)
3424
3425Theorem CARD_EMPTY[simp] = CONJUNCT1 CARD_DEF;
3426
3427Theorem CARD_INSERT[simp] = CONJUNCT2 CARD_DEF;
3428
3429(* |- CARD {} = 0 /\
3430 !s. FINITE s ==> !x. CARD (x INSERT s) =
3431 if x IN s then CARD s else SUC (CARD s)
3432 *)
3433Theorem CARD_CLAUSES = CONJ CARD_EMPTY CARD_INSERT
3434
3435Theorem CARD_EQ_0:
3436 !s:'a set. FINITE s ==> ((CARD s = 0) = (s = EMPTY))
3437Proof
3438 SET_INDUCT_TAC THENL
3439 [REWRITE_TAC [CARD_EMPTY],
3440 IMP_RES_TAC CARD_INSERT THEN
3441 ASM_REWRITE_TAC [NOT_INSERT_EMPTY,NOT_SUC]]
3442QED
3443
3444Theorem CARD_DELETE:
3445 !s. FINITE s ==>
3446 !x:'a. CARD(s DELETE x) = if x IN s then CARD s - 1 else CARD s
3447Proof
3448 SET_INDUCT_TAC THENL
3449 [REWRITE_TAC [EMPTY_DELETE,NOT_IN_EMPTY],
3450 PURE_REWRITE_TAC [DELETE_INSERT,IN_INSERT] THEN
3451 REPEAT GEN_TAC THEN ASM_CASES_TAC (“x:'a = e”) THENL
3452 [IMP_RES_TAC CARD_DEF THEN ASM_REWRITE_TAC [SUC_SUB1],
3453 SUBST1_TAC (SPECL [(“e:'a”),(“x:'a”)] EQ_SYM_EQ) THEN
3454 IMP_RES_THEN (ASSUME_TAC o SPEC (“x:'a”)) FINITE_DELETE THEN
3455 IMP_RES_TAC CARD_DEF THEN ASM_REWRITE_TAC [IN_DELETE,SUC_SUB1] THEN
3456 COND_CASES_TAC THEN ASM_REWRITE_TAC [] THEN
3457 STRIP_ASSUME_TAC (SPEC (“CARD(s:'a set)”) num_CASES) THENL
3458 [let fun tac th g = SUBST_ALL_TAC th g handle _ => ASSUME_TAC th g
3459 in REPEAT_GTCL IMP_RES_THEN tac CARD_EQ_0
3460 end THEN IMP_RES_TAC NOT_IN_EMPTY,
3461 ASM_REWRITE_TAC [SUC_SUB1]]]]
3462QED
3463
3464
3465val lemma1 =
3466 TAC_PROOF
3467 (([], (“!n m. (SUC n <= SUC m) = (n <= m)”)),
3468 REWRITE_TAC [LESS_OR_EQ,INV_SUC_EQ,LESS_MONO_EQ]);
3469
3470val lemma2 =
3471 TAC_PROOF
3472 (([], (“!n m. (n <= SUC m) = (n <= m \/ (n = SUC m))”)),
3473 REWRITE_TAC [LESS_OR_EQ,LESS_THM] THEN
3474 REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN ASM_REWRITE_TAC[]);
3475
3476Theorem CARD_INTER_LESS_EQ:
3477 !s:'a set. FINITE s ==> !t. CARD (s INTER t) <= CARD s
3478Proof
3479 SET_INDUCT_TAC THENL
3480 [REWRITE_TAC [CARD_DEF,INTER_EMPTY,LESS_EQ_REFL],
3481 PURE_ONCE_REWRITE_TAC [INSERT_INTER] THEN
3482 GEN_TAC THEN COND_CASES_TAC THENL
3483 [IMP_RES_THEN (ASSUME_TAC o SPEC (“t:'a set”)) INTER_FINITE THEN
3484 IMP_RES_TAC CARD_DEF THEN ASM_REWRITE_TAC [IN_INTER,lemma1],
3485 IMP_RES_TAC CARD_DEF THEN ASM_REWRITE_TAC [lemma2]]]
3486QED
3487
3488Theorem CARD_UNION:
3489 !s:'a set.
3490 FINITE s ==>
3491 !t. FINITE t ==>
3492 (CARD (s UNION t) + CARD (s INTER t) = CARD s + CARD t)
3493Proof
3494 SET_INDUCT_TAC THENL
3495 [REWRITE_TAC [UNION_EMPTY,INTER_EMPTY,CARD_DEF,ADD_CLAUSES],
3496 REPEAT STRIP_TAC THEN REWRITE_TAC [INSERT_UNION,INSERT_INTER] THEN
3497 ASM_CASES_TAC (“(e:'a) IN t”) THENL
3498 [IMP_RES_THEN (ASSUME_TAC o SPEC (“t:'a set”)) INTER_FINITE THEN
3499 IMP_RES_TAC CARD_DEF THEN RES_TAC THEN
3500 ASM_REWRITE_TAC [IN_INTER,ADD_CLAUSES],
3501 IMP_RES_TAC UNION_FINITE THEN
3502 IMP_RES_TAC CARD_DEF THEN RES_TAC THEN
3503 ASM_REWRITE_TAC [ADD_CLAUSES, INV_SUC_EQ, IN_UNION]]]
3504QED
3505
3506Theorem CARD_UNION_EQN:
3507 !s:'a set t.
3508 FINITE s /\ FINITE t ==>
3509 (CARD (s UNION t) = CARD s + CARD t - CARD (s INTER t))
3510Proof
3511 REPEAT STRIP_TAC THEN
3512 `CARD (s INTER t) <= CARD s`
3513 by SRW_TAC [][CARD_INTER_LESS_EQ] THEN
3514 `CARD (s INTER t) <= CARD s + CARD t` by SRW_TAC [ARITH_ss][] THEN
3515 SRW_TAC [][GSYM ADD_EQ_SUB, CARD_UNION]
3516QED
3517
3518val lemma =
3519 TAC_PROOF
3520 (([], (“!n m. (n <= SUC m) = (n <= m \/ (n = SUC m))”)),
3521 REWRITE_TAC [LESS_OR_EQ,LESS_THM] THEN
3522 REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN ASM_REWRITE_TAC[]);
3523
3524Theorem CARD_SUBSET:
3525 !s:'a set.
3526 FINITE s ==> !t. t SUBSET s ==> CARD t <= CARD s
3527Proof
3528 SET_INDUCT_TAC THENL
3529 [REWRITE_TAC [SUBSET_EMPTY,CARD_EMPTY] THEN
3530 GEN_TAC THEN DISCH_THEN SUBST1_TAC THEN
3531 REWRITE_TAC [CARD_DEF,LESS_EQ_REFL],
3532 IMP_RES_THEN (ASSUME_TAC o SPEC (“e:'a”)) FINITE_INSERT THEN
3533 IMP_RES_TAC CARD_INSERT THEN
3534 ASM_REWRITE_TAC [SUBSET_INSERT_DELETE] THEN
3535 REPEAT STRIP_TAC THEN RES_THEN MP_TAC THEN
3536 IMP_RES_TAC SUBSET_FINITE THEN
3537 IMP_RES_TAC DELETE_FINITE THEN
3538 IMP_RES_TAC CARD_DELETE THEN
3539 ASM_REWRITE_TAC [] THEN COND_CASES_TAC THENL
3540 [let val th = SPEC (“CARD (t:'a set)”) num_CASES
3541 in STRIP_ALL_THEN SUBST_ALL_TAC th
3542 end THENL
3543 [REWRITE_TAC [LESS_OR_EQ,LESS_0],
3544 REWRITE_TAC [SUC_SUB1,LESS_OR_EQ,LESS_MONO_EQ,INV_SUC_EQ]],
3545 STRIP_TAC THEN ASM_REWRITE_TAC [lemma]]]
3546QED
3547
3548Theorem CARD_PSUBSET:
3549 !s:'a set.
3550 FINITE s ==> !t. t PSUBSET s ==> CARD t < CARD s
3551Proof
3552 REPEAT STRIP_TAC THEN IMP_RES_TAC PSUBSET_DEF THEN
3553 IMP_RES_THEN (IMP_RES_THEN MP_TAC) CARD_SUBSET THEN
3554 PURE_ONCE_REWRITE_TAC [LESS_OR_EQ] THEN
3555 DISCH_THEN (STRIP_THM_THEN
3556 (fn th => fn g => ACCEPT_TAC th g handle _ => MP_TAC th g)) THEN
3557 IMP_RES_THEN STRIP_ASSUME_TAC PSUBSET_INSERT_SUBSET THEN
3558 IMP_RES_THEN (IMP_RES_THEN MP_TAC) CARD_SUBSET THEN
3559 IMP_RES_TAC INSERT_SUBSET THEN
3560 IMP_RES_TAC SUBSET_FINITE THEN
3561 IMP_RES_TAC CARD_INSERT THEN
3562 ASM_REWRITE_TAC [LESS_EQ] THEN
3563 REPEAT STRIP_TAC THEN FIRST_ASSUM ACCEPT_TAC
3564QED
3565
3566Theorem SUBSET_EQ_CARD:
3567 !s. FINITE s ==> !t. FINITE t /\ (CARD s = CARD t) /\ s SUBSET t ==> (s=t)
3568Proof
3569SET_INDUCT_TAC THEN RW_TAC bool_ss [EXTENSION] THENL
3570[PROVE_TAC [CARD_DEF, CARD_EQ_0], ALL_TAC] THEN
3571 EQ_TAC THEN RW_TAC bool_ss [] THENL
3572 [FULL_SIMP_TAC bool_ss [SUBSET_DEF], ALL_TAC] THEN
3573 Q.PAT_X_ASSUM `!t. FINITE t /\ (CARD s = CARD t) /\ s SUBSET t ==> (s = t)`
3574 (MP_TAC o Q.SPEC `t DELETE e`) THEN
3575 RW_TAC arith_ss [FINITE_DELETE, CARD_DELETE, SUBSET_DELETE] THENL
3576 [ALL_TAC, FULL_SIMP_TAC bool_ss [INSERT_SUBSET]] THEN
3577 `CARD t = SUC (CARD s)` by PROVE_TAC [CARD_INSERT] THEN
3578 `s SUBSET t` by FULL_SIMP_TAC bool_ss [INSERT_SUBSET] THEN
3579 FULL_SIMP_TAC arith_ss [] THEN
3580 RW_TAC bool_ss [INSERT_DEF, DELETE_DEF, GSPECIFICATION,IN_DIFF,NOT_IN_EMPTY]
3581QED
3582
3583Theorem CARD_SING:
3584 !x:'a. CARD {x} = 1
3585Proof
3586 CONV_TAC (ONCE_DEPTH_CONV num_CONV) THEN
3587 GEN_TAC THEN ASSUME_TAC FINITE_EMPTY THEN
3588 IMP_RES_THEN (ASSUME_TAC o SPEC (“x:'a”)) FINITE_INSERT THEN
3589 IMP_RES_TAC CARD_DEF THEN ASM_REWRITE_TAC [NOT_IN_EMPTY,CARD_DEF]
3590QED
3591
3592(* Theorem: SING s ==> (CARD s = 1) *)
3593(* Proof:
3594 Note s = {x} for some x by SING_DEF
3595 so CARD s = 1 by CARD_SING
3596*)
3597Theorem SING_CARD_1:
3598 !s. SING s ==> (CARD s = 1)
3599Proof
3600 metis_tac[SING_DEF, CARD_SING]
3601QED
3602(* Note: SING s <=> (CARD s = 1) cannot be proved.
3603Only SING_IFF_CARD1 |- !s. SING s <=> (CARD s = 1) /\ FINITE s
3604That is: FINITE s /\ (CARD s = 1) ==> SING s
3605*)
3606
3607Theorem SING_IFF_CARD1:
3608 !s:'a set. SING s <=> CARD s = 1 /\ FINITE s
3609Proof
3610 REWRITE_TAC [SING_DEF,ONE] THEN
3611 GEN_TAC THEN EQ_TAC THENL
3612 [DISCH_THEN (CHOOSE_THEN SUBST1_TAC) THEN
3613 CONJ_TAC THENL
3614 [ASSUME_TAC FINITE_EMPTY THEN
3615 IMP_RES_TAC CARD_INSERT THEN
3616 ASM_REWRITE_TAC [CARD_EMPTY,NOT_IN_EMPTY],
3617 REWRITE_TAC [FINITE_INSERT,FINITE_EMPTY]],
3618 STRIP_ASSUME_TAC (SPEC (“s:'a set”) SET_CASES) THENL
3619 [ASM_REWRITE_TAC [CARD_EMPTY,NOT_EQ_SYM(SPEC_ALL NOT_SUC)],
3620 ASM_REWRITE_TAC [FINITE_INSERT] THEN
3621 DISCH_THEN (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
3622 IMP_RES_TAC CARD_INSERT THEN
3623 IMP_RES_TAC CARD_EQ_0 THEN
3624 ASM_REWRITE_TAC [INV_SUC_EQ] THEN
3625 DISCH_TAC THEN EXISTS_TAC (“x:'a”) THEN
3626 ASM_REWRITE_TAC []]]
3627QED
3628
3629(* ---------------------------------------------------------------------*)
3630(* A theorem from homeier@aero.uniblab (Peter Homeier) *)
3631(* ---------------------------------------------------------------------*)
3632Theorem CARD_DIFF:
3633 !t:'a set.
3634 FINITE t ==>
3635 !s:'a set. FINITE s ==>
3636 (CARD (s DIFF t) = (CARD s - CARD (s INTER t)))
3637Proof
3638 SET_INDUCT_TAC THEN REPEAT STRIP_TAC THENL
3639 [REWRITE_TAC [DIFF_EMPTY,INTER_EMPTY,CARD_EMPTY,SUB_0],
3640 PURE_ONCE_REWRITE_TAC [INTER_COMM] THEN
3641 PURE_ONCE_REWRITE_TAC [INSERT_INTER] THEN
3642 COND_CASES_TAC THENL
3643 [let val th = SPEC (“s':'a set”)
3644 (UNDISCH (SPEC (“s:'a set”) INTER_FINITE))
3645 in PURE_ONCE_REWRITE_TAC [MATCH_MP CARD_INSERT th]
3646 end THEN
3647 IMP_RES_THEN (ASSUME_TAC o SPEC (“e:'a”)) FINITE_DELETE THEN
3648 IMP_RES_TAC CARD_DELETE THEN
3649 RES_TAC THEN ASM_REWRITE_TAC [IN_INTER,DIFF_INSERT] THEN
3650 PURE_ONCE_REWRITE_TAC [SYM (SPEC_ALL SUB_PLUS)] THEN
3651 REWRITE_TAC [ONE,ADD_CLAUSES,DELETE_INTER] THEN
3652 MP_TAC (SPECL [(“s':'a set”),(“s:'a set”),(“e:'a”)]
3653 IN_INTER) THEN
3654 ASM_REWRITE_TAC [DELETE_NON_ELEMENT] THEN
3655 DISCH_THEN SUBST1_TAC THEN
3656 SUBST1_TAC (SPECL [(“s:'a set”),(“s':'a set”)] INTER_COMM)
3657 THEN REFL_TAC,
3658 IMP_RES_TAC DELETE_NON_ELEMENT THEN
3659 PURE_ONCE_REWRITE_TAC [INTER_COMM] THEN
3660 RES_TAC THEN ASM_REWRITE_TAC [DIFF_INSERT]]]
3661QED
3662
3663(* Improved version of the above - DIFF's second argument can be infinite *)
3664Theorem CARD_DIFF_EQN :
3665 !t s. FINITE s ==> (CARD (s DIFF t) = CARD s - CARD (s INTER t))
3666Proof
3667 GEN_TAC THEN
3668 Induct_on `FINITE` THEN SRW_TAC [][] THEN
3669 Cases_on `e IN t` THEN
3670 SRW_TAC [][INSERT_INTER, INSERT_DIFF, INTER_FINITE] THEN
3671 `CARD (s INTER t) <= CARD s`
3672 by METIS_TAC [CARD_INTER_LESS_EQ] THEN
3673 SRW_TAC [numSimps.ARITH_ss][]
3674QED
3675
3676(* ---------------------------------------------------------------------*)
3677(* A theorem from homeier@aero.uniblab (Peter Homeier) *)
3678(* ---------------------------------------------------------------------*)
3679Theorem LESS_CARD_DIFF:
3680 !t:'a set. FINITE t ==>
3681 !s. FINITE s ==> (CARD t < CARD s) ==> (0 < CARD(s DIFF t))
3682Proof
3683 REPEAT STRIP_TAC THEN
3684 REPEAT_GTCL IMP_RES_THEN SUBST1_TAC CARD_DIFF THEN
3685 PURE_REWRITE_TAC [GSYM SUB_LESS_0] THEN
3686 let val th1 = UNDISCH (SPEC (“s:'a set”) CARD_INTER_LESS_EQ)
3687 val th2 = SPEC (“t:'a set”)
3688 (PURE_ONCE_REWRITE_RULE [LESS_OR_EQ] th1)
3689 in DISJ_CASES_THEN2 ACCEPT_TAC (SUBST_ALL_TAC o SYM) th2
3690 end THEN
3691 let val th3 = SPEC (“s:'a set”)
3692 (UNDISCH(SPEC(“t:'a set”) CARD_INTER_LESS_EQ))
3693 val th4 = PURE_ONCE_REWRITE_RULE [INTER_COMM] th3
3694 in
3695 IMP_RES_TAC (PURE_ONCE_REWRITE_RULE [GSYM NOT_LESS] th4)
3696 end
3697QED
3698
3699Theorem BIJ_FINITE:
3700 !f s t. BIJ f s t /\ FINITE s ==> FINITE t
3701Proof
3702 Induct_on `FINITE s` THEN SRW_TAC[][BIJ_EMPTY, BIJ_INSERT] THEN
3703 METIS_TAC [FINITE_DELETE]
3704QED
3705
3706Theorem BIJ_FINITE_SUBSET:
3707 !(f : num -> 'a) s t.
3708 BIJ f UNIV s /\ FINITE t /\ t SUBSET s ==>
3709 ?N. !n. N <= n ==> ~(f n IN t)
3710Proof
3711 Induct_on ‘FINITE’
3712 >> RW_TAC std_ss [EMPTY_SUBSET, NOT_IN_EMPTY, INSERT_SUBSET, IN_INSERT]
3713 >> Know `?!k. f k = e`
3714 >- ( Q.PAT_X_ASSUM `BIJ a b c` MP_TAC \\
3715 RW_TAC std_ss [BIJ_ALT] \\
3716 ASSUME_TAC (INST_TYPE [``:'a`` |-> ``:num``] IN_UNIV) \\
3717 PROVE_TAC [] )
3718 >> CONV_TAC (DEPTH_CONV EXISTS_UNIQUE_CONV)
3719 >> RW_TAC std_ss []
3720 >> RES_TAC
3721 >> Q.EXISTS_TAC `MAX N (SUC k)`
3722 >> `!m n k. MAX m n <= k <=> m <= k /\ n <= k` by RW_TAC arith_ss [MAX_DEF]
3723 >> RW_TAC std_ss []
3724 >> STRIP_TAC
3725 >> Know `n = k` >- PROVE_TAC []
3726 >> DECIDE_TAC
3727QED
3728
3729Theorem FINITE_BIJ:
3730 !f s t. FINITE s /\ BIJ f s t ==> FINITE t /\ (CARD s = CARD t)
3731Proof
3732 Induct_on ‘FINITE’
3733 >> CONJ_TAC
3734 >- ( RW_TAC std_ss [BIJ_ALT, FINITE_EMPTY, CARD_EMPTY, IN_FUNSET, NOT_IN_EMPTY,
3735 EXISTS_UNIQUE_ALT] \\ (* 2 sub-goals here, same tacticals *)
3736 FULL_SIMP_TAC std_ss [NOT_IN_EMPTY] \\
3737 `t = {}` by RW_TAC std_ss [EXTENSION, NOT_IN_EMPTY] \\
3738 RW_TAC std_ss [FINITE_EMPTY, CARD_EMPTY] )
3739 >> NTAC 7 STRIP_TAC
3740 >> MP_TAC (Q.SPECL [`f`, `e`, `s`, `t`] BIJ_INSERT_IMP)
3741 >> ASM_REWRITE_TAC []
3742 >> STRIP_TAC
3743 >> Know `FINITE u` >- PROVE_TAC []
3744 >> STRIP_TAC
3745 >> CONJ_TAC >- PROVE_TAC [FINITE_INSERT]
3746 >> Q.PAT_X_ASSUM `f e INSERT u = t` (fn th => RW_TAC std_ss [SYM th])
3747 >> RW_TAC std_ss [CARD_INSERT]
3748 >> PROVE_TAC []
3749QED
3750
3751Theorem FINITE_BIJ_CARD:
3752 !f s t. FINITE s /\ BIJ f s t ==> (CARD s = CARD t)
3753Proof
3754 PROVE_TAC [FINITE_BIJ]
3755QED
3756
3757(* Idea: improve FINITE_BIJ with iff of finiteness of s and t. *)
3758
3759(* Theorem: BIJ f s t ==> (FINITE s <=> FINITE t) *)
3760(* Proof:
3761 If part: FINITE s ==> FINITE t
3762 This is true by FINITE_BIJ
3763 Only-if part: FINITE t ==> FINITE s
3764 Note BIJ (LINV f s) t s by BIJ_LINV_BIJ
3765 Thus FINITE s by FINITE_BIJ
3766*)
3767Theorem BIJ_FINITE_IFF:
3768 !f s t. BIJ f s t ==> (FINITE s <=> FINITE t)
3769Proof
3770 metis_tac[FINITE_BIJ, BIJ_LINV_BIJ]
3771QED
3772
3773Theorem FINITE_BIJ_CARD_EQ:
3774 !S. FINITE S ==> !t f. BIJ f S t /\ FINITE t ==> (CARD S = CARD t)
3775Proof
3776SET_INDUCT_TAC THEN RW_TAC bool_ss [BIJ_EMPTY, CARD_EMPTY] THEN
3777`BIJ f s (t DELETE (f e))` by
3778 METIS_TAC [DELETE_NON_ELEMENT, IN_INSERT, DELETE_INSERT, BIJ_DELETE] THEN
3779RW_TAC bool_ss [CARD_INSERT] THEN
3780Q.PAT_X_ASSUM `$! m` (MP_TAC o Q.SPECL [`t DELETE f e`, `f`]) THEN
3781RW_TAC bool_ss [FINITE_DELETE] THEN
3782`f e IN t` by (Q.PAT_X_ASSUM `BIJ f (e INSERT s) t` MP_TAC THEN
3783 RW_TAC (bool_ss++SET_SPEC_ss) [BIJ_DEF,INJ_DEF,INSERT_DEF]) THEN
3784RW_TAC arith_ss [CARD_DELETE] THEN
3785`~(CARD t = 0)` by METIS_TAC [EMPTY_DEF, IN_DEF, CARD_EQ_0] THEN
3786RW_TAC arith_ss []
3787QED
3788
3789Theorem CARD_INJ_IMAGE:
3790 !f s. (!x y. (f x = f y) <=> (x = y)) /\ FINITE s ==>
3791 (CARD (IMAGE f s) = CARD s)
3792Proof
3793 Induct_on ‘FINITE’ >> SRW_TAC[][]
3794QED
3795
3796Theorem CARD_IMAGE:
3797 !s. FINITE s ==> (CARD (IMAGE f s) <= CARD s)
3798Proof
3799 SET_INDUCT_TAC THEN
3800 ASM_SIMP_TAC bool_ss [CARD_DEF, IMAGE_INSERT, IMAGE_FINITE,
3801 IMAGE_EMPTY, ZERO_LESS_EQ] THEN
3802 COND_CASES_TAC THEN ASM_SIMP_TAC arith_ss []
3803QED
3804
3805(* |- !f s. FINITE s ==> CARD (IMAGE f s) <= CARD s *)
3806Theorem CARD_IMAGE_LE = GEN_ALL CARD_IMAGE
3807
3808Theorem SURJ_CARD:
3809 !s. FINITE s ==> !t. SURJ f s t ==> FINITE t /\ CARD t <= CARD s
3810Proof
3811 REWRITE_TAC [IMAGE_SURJ] THEN REPEAT STRIP_TAC THEN
3812 BasicProvers.VAR_EQ_TAC THENL
3813 [irule IMAGE_FINITE, irule CARD_IMAGE] THEN
3814 FIRST_ASSUM ACCEPT_TAC
3815QED
3816
3817Theorem FINITE_SURJ:
3818 FINITE s /\ SURJ f s t ==> FINITE t
3819Proof
3820 SRW_TAC[][] THEN IMP_RES_TAC SURJ_INJ_INV THEN IMP_RES_TAC FINITE_INJ
3821QED
3822
3823Theorem FINITE_SURJ_BIJ:
3824 FINITE s /\ SURJ f s t /\ (CARD t = CARD s) ==> BIJ f s t
3825Proof
3826 SRW_TAC[][BIJ_DEF,INJ_DEF] >- fs[SURJ_DEF]
3827 \\ CCONTR_TAC
3828 \\ `SURJ f (s DELETE x) t` by (fs[SURJ_DEF] \\ METIS_TAC[])
3829 \\ `FINITE (s DELETE x)` by METIS_TAC[FINITE_DELETE]
3830 \\ IMP_RES_TAC SURJ_CARD
3831 \\ REV_FULL_SIMP_TAC (srw_ss()) [CARD_DELETE]
3832 \\ Cases_on`CARD s` \\ REV_FULL_SIMP_TAC (srw_ss())[CARD_EQ_0] >> fs[]
3833QED
3834
3835Theorem FINITE_COMPLETE_INDUCTION:
3836 !P. (!x. (!y. y PSUBSET x ==> P y) ==> FINITE x ==> P x)
3837 ==>
3838 !x. FINITE x ==> P x
3839Proof
3840 GEN_TAC THEN STRIP_TAC THEN
3841 MATCH_MP_TAC ((BETA_RULE o
3842 Q.ISPEC `\x. FINITE x ==> P x` o
3843 REWRITE_RULE [WF_measure] o
3844 Q.ISPEC `measure CARD`)
3845 WF_INDUCTION_THM) THEN
3846 REPEAT STRIP_TAC THEN
3847 RULE_ASSUM_TAC (REWRITE_RULE [AND_IMP_INTRO]) THEN
3848 Q.PAT_X_ASSUM `!x. (!y. y PSUBSET x ==> P y) /\ FINITE x ==>
3849 P x` MATCH_MP_TAC THEN
3850 ASM_REWRITE_TAC [] THEN REPEAT STRIP_TAC THEN
3851 FIRST_X_ASSUM MATCH_MP_TAC THEN
3852 ASM_REWRITE_TAC [measure_def,
3853 inv_image_def] THEN
3854 BETA_TAC THEN mesonLib.ASM_MESON_TAC [PSUBSET_FINITE, CARD_PSUBSET]
3855QED
3856
3857Theorem FINITE_LEAST_MEASURE_INDUCTION:
3858 !f P.
3859 P {} /\
3860 (!a s. a NOTIN s /\ (!b. b IN s ==> f a <= f b) /\ P s ==>
3861 P (a INSERT s)) ==>
3862 !s. FINITE s ==> P s
3863Proof
3864 rpt gen_tac >> strip_tac >> Induct_on ‘CARD s’ >> rpt strip_tac >>
3865 fs[CARD_EQ_0] >> ‘s <> {}’ by (strip_tac >> fs[]) >>
3866 Q.SPECL_THEN [‘λa. a IN s’, ‘f’] mp_tac arithmeticTheory.WOP_measure >>
3867 impl_tac >- fs[MEMBER_NOT_EMPTY] >>
3868 rw[] >> Q.RENAME_TAC [‘a IN s’] >>
3869 drule_then (Q.X_CHOOSE_THEN ‘s0’ strip_assume_tac) (iffLR DECOMPOSITION) >>
3870 fs[]
3871QED
3872
3873
3874val CARD_INSERT' = SPEC_ALL (UNDISCH (SPEC_ALL CARD_INSERT)) ;
3875
3876Theorem INJ_CARD_IMAGE:
3877 !s. FINITE s ==> INJ f s t ==> (CARD (IMAGE f s) = CARD s)
3878Proof
3879 HO_MATCH_MP_TAC FINITE_INDUCT THEN
3880 REWRITE_TAC [IMAGE_EMPTY, CARD_EMPTY, IMAGE_INSERT] THEN
3881 REPEAT STRIP_TAC THEN
3882 VALIDATE (CONV_TAC (DEPTH_CONV (REWR_CONV_A CARD_INSERT'))) THEN1
3883 (irule IMAGE_FINITE THEN FIRST_ASSUM ACCEPT_TAC) THEN
3884 ASM_REWRITE_TAC [IN_IMAGE] THEN
3885 RULE_L_ASSUM_TAC (CONJUNCTS o REWRITE_RULE [INJ_INSERT]) THEN
3886 REVERSE COND_CASES_TAC THEN1
3887 (RES_TAC THEN ASM_REWRITE_TAC [INV_SUC_EQ]) THEN
3888 FIRST_X_ASSUM CHOOSE_TAC THEN
3889 RULE_L_ASSUM_TAC CONJUNCTS THEN RES_TAC THEN
3890 BasicProvers.VAR_EQ_TAC THEN FULL_SIMP_TAC std_ss []
3891QED
3892
3893Theorem INJ_CARD:
3894 !(f:'a->'b) s t. INJ f s t /\ FINITE t ==> CARD s <= CARD t
3895Proof
3896 REPEAT GEN_TAC THEN
3897 DISCH_THEN (fn th => ASSUME_TAC (MATCH_MP FINITE_INJ th) THEN
3898 ASSUME_TAC (CONJUNCT1 th) THEN
3899 IMP_RES_TAC (GSYM INJ_CARD_IMAGE) THEN
3900 ASSUME_TAC (CONJUNCT2 th)) THEN
3901 ASM_REWRITE_TAC [] THEN
3902 irule CARD_SUBSET THEN CONJ_TAC THEN1 FIRST_ASSUM ACCEPT_TAC THEN
3903 IMP_RES_TAC INJ_IMAGE_SUBSET
3904QED
3905
3906Theorem PHP:
3907 !(f:'a->'b) s t. FINITE t /\ CARD t < CARD s ==> ~INJ f s t
3908Proof
3909 METIS_TAC [INJ_CARD, AP ``x < y <=> ~(y <= x)``]
3910QED
3911
3912Theorem INJ_CARD_IMAGE_EQ:
3913 INJ f s t ==> FINITE s ==> (CARD (IMAGE f s) = CARD s)
3914Proof
3915 REPEAT STRIP_TAC THEN IMP_RES_TAC INJ_CARD_IMAGE
3916QED
3917
3918(* Theorem: For a 1-1 map f: s -> s, s and (IMAGE f s) are of the same size. *)
3919(* Proof:
3920 By finite induction on the set s:
3921 Base case: CARD (IMAGE f {}) = CARD {}
3922 True by IMAGE f {} = {} by IMAGE_EMPTY
3923 Step case: !s. FINITE s /\ (CARD (IMAGE f s) = CARD s) ==> !e. e NOTIN s ==> (CARD (IMAGE f (e INSERT s)) = CARD (e INSERT s))
3924 CARD (IMAGE f (e INSERT s))
3925 = CARD (f e INSERT IMAGE f s) by IMAGE_INSERT
3926 = SUC (CARD (IMAGE f s)) by CARD_INSERT: e NOTIN s, f e NOTIN s, for 1-1 map
3927 = SUC (CARD s) by induction hypothesis
3928 = CARD (e INSERT s) by CARD_INSERT: e NOTIN s.
3929*)
3930Theorem FINITE_CARD_IMAGE:
3931 !s f. (!x y. (f x = f y) <=> (x = y)) /\ FINITE s ==>
3932 (CARD (IMAGE f s) = CARD s)
3933Proof
3934 Induct_on ‘FINITE’ >> rw[]
3935QED
3936
3937(* Theorem: !s. FINITE s ==> CARD (IMAGE SUC s)) = CARD s *)
3938(* Proof:
3939 Since !n m. SUC n = SUC m <=> n = m by numTheory.INV_SUC
3940 This is true by FINITE_CARD_IMAGE.
3941*)
3942Theorem CARD_IMAGE_SUC:
3943 !s. FINITE s ==> (CARD (IMAGE SUC s) = CARD s)
3944Proof
3945 rw[FINITE_CARD_IMAGE]
3946QED
3947
3948(* Theorem: FINITE s /\ FINITE t /\ DISJOINT s t ==> (CARD (s UNION t) = CARD s + CARD t) *)
3949(* Proof: by CARD_UNION_EQN, DISJOINT_DEF, CARD_EMPTY *)
3950Theorem CARD_UNION_DISJOINT:
3951 !s t. FINITE s /\ FINITE t /\ DISJOINT s t ==> (CARD (s UNION t) = CARD s + CARD t)
3952Proof
3953 rw_tac std_ss[CARD_UNION_EQN, DISJOINT_DEF, CARD_EMPTY]
3954QED
3955
3956(* ------------------------------------------------------------------------- *)
3957(* Relational form of CARD (from cardinalTheory) *)
3958(* ------------------------------------------------------------------------- *)
3959
3960val _ = set_fixity "HAS_SIZE" (Infix(NONASSOC, 450));
3961
3962Definition HAS_SIZE[nocompute]:
3963 s HAS_SIZE n <=> FINITE s /\ (CARD s = n)
3964End
3965
3966Theorem HAS_SIZE_CARD :
3967 !s n. s HAS_SIZE n ==> (CARD s = n)
3968Proof
3969 SIMP_TAC std_ss [HAS_SIZE]
3970QED
3971
3972Theorem HAS_SIZE_0:
3973 !(s:'a->bool). s HAS_SIZE 0:num <=> (s = {})
3974Proof
3975 simp [HAS_SIZE, EQ_IMP_THM]
3976 >> ‘!s. FINITE s ==> (CARD s = 0 ==> s = {})’ suffices_by (METIS_TAC [])
3977 >> Induct_on ‘FINITE’ >> simp []
3978QED
3979
3980Theorem HAS_SIZE_SUC :
3981 !(s:'a->bool) n. s HAS_SIZE (SUC n) <=>
3982 s <> {} /\ !a. a IN s ==> (s DELETE a) HAS_SIZE n
3983Proof
3984 rpt GEN_TAC THEN REWRITE_TAC[HAS_SIZE]
3985 >> ASM_CASES_TAC ``s:'a->bool = {}``
3986 >> ASM_REWRITE_TAC [CARD_DEF, FINITE_EMPTY, FINITE_INSERT,
3987 NOT_IN_EMPTY, SUC_NOT]
3988 >> REWRITE_TAC [FINITE_DELETE]
3989 >> ASM_CASES_TAC ``FINITE(s:'a->bool)``
3990 >> RW_TAC std_ss [NOT_FORALL_THM, MEMBER_NOT_EMPTY]
3991 >> EQ_TAC >> rpt STRIP_TAC
3992 >| [ ASM_SIMP_TAC std_ss [CARD_DELETE],
3993 KNOW_TAC ``?x. x IN s`` THENL
3994 [ FULL_SIMP_TAC std_ss [MEMBER_NOT_EMPTY], ALL_TAC] \\
3995 DISCH_THEN (X_CHOOSE_TAC ``a:'a``) \\
3996 ASSUME_TAC CARD_INSERT \\
3997 POP_ASSUM (MP_TAC o Q.SPEC `s DELETE a`) \\
3998 FULL_SIMP_TAC std_ss [FINITE_DELETE] >> STRIP_TAC \\
3999 POP_ASSUM (MP_TAC o Q.SPEC `a`) \\
4000 FULL_SIMP_TAC std_ss [INSERT_DELETE] \\
4001 ASM_REWRITE_TAC [IN_DELETE] ]
4002QED
4003
4004Theorem FINITE_HAS_SIZE :
4005 !s. FINITE s <=> s HAS_SIZE CARD s
4006Proof
4007 REWRITE_TAC [HAS_SIZE]
4008QED
4009
4010(* The next 3 theorems (up to HAS_SIZE_INDEX) were moved here from fcpTheory *)
4011val CARD_CLAUSES =
4012 CONJ CARD_EMPTY
4013 (PROVE [CARD_INSERT]
4014 ``!x s.
4015 FINITE s ==>
4016 (CARD (x INSERT s) = (if x IN s then CARD s else SUC (CARD s)))``);
4017
4018val IMAGE_CLAUSES = CONJ IMAGE_EMPTY IMAGE_INSERT;
4019val LT = CONJ (DECIDE ``!m. ~(m < 0)``) LESS_THM;
4020val LT_REFL = LESS_REFL;
4021
4022Theorem CARD_IMAGE_INJ:
4023 !(f:'a->'b) s. (!x y. x IN s /\ y IN s /\ (f(x) = f(y)) ==> (x = y)) /\
4024 FINITE s ==> (CARD (IMAGE f s) = CARD s)
4025Proof
4026 GEN_TAC THEN ONCE_REWRITE_TAC [CONJ_SYM] THEN
4027 REWRITE_TAC[GSYM AND_IMP_INTRO] THEN GEN_TAC THEN
4028 KNOW_TAC “
4029 (!(x :'a) (y :'a).
4030 x IN s ==> y IN s ==> ((f :'a -> 'b) x = f y) ==> (x = y)) ==>
4031 (CARD (IMAGE f s) = CARD s) <=>
4032 (\s. (!(x :'a) (y :'a).
4033 x IN s ==> y IN s ==> ((f :'a -> 'b) x = f y) ==> (x = y)) ==>
4034 (CARD (IMAGE f s) = CARD s)) (s:'a->bool)” THENL
4035 [FULL_SIMP_TAC std_ss[], DISCH_TAC THEN ONCE_ASM_REWRITE_TAC []
4036 THEN MATCH_MP_TAC FINITE_INDUCT THEN BETA_TAC THEN
4037 REWRITE_TAC[NOT_IN_EMPTY, IMAGE_EMPTY, IMAGE_INSERT] THEN
4038 REPEAT STRIP_TAC THENL
4039 [ASM_SIMP_TAC std_ss [CARD_DEF, IMAGE_FINITE, IN_IMAGE],
4040 ASM_SIMP_TAC std_ss [CARD_DEF, IMAGE_FINITE, IN_IMAGE] THEN
4041 COND_CASES_TAC THENL [ASM_MESON_TAC[IN_INSERT], ASM_MESON_TAC[IN_INSERT]]]]
4042QED
4043
4044Theorem HAS_SIZE_IMAGE_INJ :
4045 !(f:'a->'b) s n.
4046 (!x y. x IN s /\ y IN s /\ f(x) = f(y) ==> x = y) /\ (s HAS_SIZE n)
4047 ==> ((IMAGE f s) HAS_SIZE n)
4048Proof
4049 SIMP_TAC std_ss [HAS_SIZE, IMAGE_FINITE] THEN PROVE_TAC[CARD_IMAGE_INJ]
4050QED
4051
4052Theorem HAS_SIZE_INDEX :
4053 !s n.
4054 (s HAS_SIZE n) ==>
4055 ?f:num->'a. (!m. m < n ==> f(m) IN s) /\
4056 (!x. x IN s ==> ?!m. m < n /\ (f m = x))
4057Proof
4058 CONV_TAC SWAP_VARS_CONV
4059 THEN numLib.INDUCT_TAC
4060 THEN SIMP_TAC std_ss [HAS_SIZE_0, HAS_SIZE_SUC, LT, NOT_IN_EMPTY]
4061 THEN Q.X_GEN_TAC `s:'a->bool`
4062 THEN REWRITE_TAC [EXTENSION, NOT_IN_EMPTY]
4063 THEN SIMP_TAC std_ss [NOT_FORALL_THM]
4064 THEN DISCH_THEN
4065 (CONJUNCTS_THEN2 (Q.X_CHOOSE_TAC `a:'a`) (MP_TAC o Q.SPEC `a:'a`))
4066 THEN ASM_REWRITE_TAC[]
4067 THEN DISCH_TAC
4068 THEN FIRST_X_ASSUM (MP_TAC o Q.SPEC `s DELETE (a:'a)`)
4069 THEN ASM_REWRITE_TAC []
4070 THEN DISCH_THEN (Q.X_CHOOSE_THEN `f:num->'a` STRIP_ASSUME_TAC)
4071 THEN Q.EXISTS_TAC `\m:num. if m < n then f(m) else a:'a`
4072 THEN CONJ_TAC
4073 THEN1 (
4074 GEN_TAC
4075 THEN REWRITE_TAC []
4076 THEN BETA_TAC
4077 THEN COND_CASES_TAC
4078 THEN PROVE_TAC [IN_DELETE]
4079 )
4080 THEN Q.X_GEN_TAC `x:'a`
4081 THEN DISCH_TAC
4082 THEN ASM_REWRITE_TAC []
4083 THEN FIRST_X_ASSUM (MP_TAC o Q.SPEC `x:'a`)
4084 THEN ASM_SIMP_TAC (std_ss++boolSimps.COND_elim_ss) [IN_DELETE]
4085 THEN Q.ASM_CASES_TAC `a:'a = x`
4086 THEN ASM_SIMP_TAC std_ss []
4087 THEN PROVE_TAC [LT_REFL, IN_DELETE]
4088QED
4089
4090Theorem HAS_SIZE_UNION :
4091 !(s:'a->bool) t m n.
4092 s HAS_SIZE m /\ t HAS_SIZE n /\ DISJOINT s t
4093 ==> (s UNION t) HAS_SIZE (m + n)
4094Proof
4095 RW_TAC std_ss[HAS_SIZE, FINITE_UNION, DISJOINT_DEF]
4096 >> MP_TAC (Q.SPEC ‘t’ (MATCH_MP (Q.SPEC ‘s’ CARD_UNION)
4097 (ASSUME “FINITE (s :'a set)”)))
4098 >> simp []
4099QED
4100
4101(* ------------------------------------------------------------------------- *)
4102(* Cardinality of product. *)
4103(* ------------------------------------------------------------------------- *)
4104
4105Theorem IMP_CONJ[local] :
4106 !p q r. p /\ q ==> r <=> p ==> q ==> r
4107Proof
4108 REWRITE_TAC [AND_IMP_INTRO]
4109QED
4110
4111Theorem HAS_SIZE_PRODUCT_DEPENDENT :
4112 !s m t n.
4113 s HAS_SIZE m /\ (!x. x IN s ==> t(x) HAS_SIZE n)
4114 ==> {(x:'a,y:'b) | x IN s /\ y IN t(x)} HAS_SIZE (m * n)
4115Proof
4116 GEN_REWRITE_TAC (funpow 4 BINDER_CONV o funpow 2 LAND_CONV)
4117 empty_rewrites [HAS_SIZE] THEN
4118 SIMP_TAC pure_ss[IMP_CONJ, RIGHT_FORALL_IMP_THM] THEN
4119 HO_MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
4120 SIMP_TAC std_ss[CARD_CLAUSES, NOT_IN_EMPTY, IN_INSERT] THEN CONJ_TAC
4121 >- (REWRITE_TAC[HAS_SIZE_0] THEN rw [Once EXTENSION]) THEN
4122 rpt GEN_TAC THEN STRIP_TAC THEN
4123 rpt GEN_TAC THEN
4124 REWRITE_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN
4125 SIMP_TAC std_ss[FORALL_AND_THM, LEFT_FORALL_IMP_THM, EXISTS_REFL] THEN
4126 STRIP_TAC THEN
4127 rename1 ‘t a HAS_SIZE n’ THEN
4128 REWRITE_TAC[MULT_CLAUSES] THEN
4129 Suff ‘{(x,y) | (x = a \/ x IN s) /\ y IN t(x)} =
4130 {(x,y) | x IN s /\ y IN t(x)} UNION
4131 IMAGE (\y. (a,y)) (t a)’
4132 >- (Rewr' \\
4133 MATCH_MP_TAC HAS_SIZE_UNION >> simp [] \\
4134 CONJ_TAC
4135 >- (MATCH_MP_TAC HAS_SIZE_IMAGE_INJ >> simp []) \\
4136 rw [DISJOINT_ALT] >> PROVE_TAC []) THEN
4137 rw [Once EXTENSION] >> EQ_TAC >> rw []
4138QED
4139
4140Theorem FINITE_PRODUCT_DEPENDENT :
4141 !f:'a->'b->'c s t.
4142 FINITE s /\ (!x. x IN s ==> FINITE(t x))
4143 ==> FINITE {f x y | x IN s /\ y IN (t x)}
4144Proof
4145 REPEAT STRIP_TAC THEN KNOW_TAC ``{f x y | x IN s /\ y IN (t x)} SUBSET
4146 IMAGE (\(x,y). (f:'a->'b->'c) x y) {x,y | x IN s /\ y IN t x}`` THENL
4147 [SRW_TAC [][SUBSET_DEF, IN_IMAGE, EXISTS_PROD], ALL_TAC] THEN
4148 KNOW_TAC ``FINITE (IMAGE (\(x,y). (f:'a->'b->'c) x y)
4149 {x,y | x IN s /\ y IN t x})`` THENL
4150 [MATCH_MP_TAC IMAGE_FINITE THEN MAP_EVERY UNDISCH_TAC
4151 [``!x:'a. x IN s ==> FINITE(t x :'b->bool)``, ``FINITE(s:'a->bool)``]
4152 THEN MAP_EVERY (fn t => SPEC_TAC(t,t)) [``t:'a->'b->bool``, ``s:'a->bool``]
4153 THEN SIMP_TAC std_ss [RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN
4154 KNOW_TAC ``(!(t:'a->'b->bool). (!x. x IN s ==> FINITE (t x)) ==>
4155 FINITE {(x,y) | x IN s /\ y IN t x}) =
4156 (\s. !(t:'a->'b->bool). (!x. x IN s ==> FINITE (t x)) ==>
4157 FINITE {(x,y) | x IN s /\ y IN t x}) (s:'a->bool)`` THENL
4158 [FULL_SIMP_TAC std_ss [], ALL_TAC] THEN DISCH_TAC THEN
4159 ONCE_ASM_REWRITE_TAC [] THEN MATCH_MP_TAC FINITE_INDUCT THEN BETA_TAC
4160 THEN CONJ_TAC THENL [GEN_TAC THEN
4161 SUBGOAL_THEN ``{(x:'a,y:'b) | x IN {} /\ y IN (t x)} = {}``
4162 (fn th => REWRITE_TAC[th, FINITE_EMPTY]) THEN SRW_TAC [][],
4163 SIMP_TAC std_ss [GSYM RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN
4164 SUBGOAL_THEN ``{(x:'a, y:'b) | x IN (e INSERT s') /\ y IN (t x)} =
4165 IMAGE (\y. e,y) (t e) UNION {(x,y) | x IN s' /\ y IN (t x)}``
4166 (fn th => ASM_SIMP_TAC std_ss [IN_INSERT, IMAGE_FINITE, FINITE_UNION, th])
4167 THEN SRW_TAC [][EXTENSION, IN_IMAGE, IN_INSERT, IN_UNION] THEN MESON_TAC[]],
4168 PROVE_TAC [SUBSET_FINITE]] THEN
4169 rw [Once EXTENSION, NOT_IN_EMPTY]
4170QED
4171
4172Theorem FINITE_PRODUCT :
4173 !s t. FINITE s /\ FINITE t ==> FINITE {(x:'a,y:'b) | x IN s /\ y IN t}
4174Proof
4175 SIMP_TAC std_ss [FINITE_PRODUCT_DEPENDENT]
4176QED
4177
4178Theorem CARD_PRODUCT :
4179 !s t. FINITE s /\ FINITE t
4180 ==> (CARD {(x:'a,y:'b) | x IN s /\ y IN t} = CARD s * CARD t)
4181Proof
4182 REPEAT STRIP_TAC THEN
4183 MP_TAC(Q.SPECL [`s`, `CARD s`, `\x. (t :'b set)`, `CARD (t :'b set)`]
4184 HAS_SIZE_PRODUCT_DEPENDENT) THEN
4185 ASM_SIMP_TAC std_ss[HAS_SIZE]
4186QED
4187
4188Theorem HAS_SIZE_PRODUCT :
4189 !s m t n. s HAS_SIZE m /\ t HAS_SIZE n
4190 ==> {(x:'a,y:'b) | x IN s /\ y IN t} HAS_SIZE (m * n)
4191Proof
4192 SIMP_TAC std_ss[HAS_SIZE, CARD_PRODUCT, FINITE_PRODUCT]
4193QED
4194
4195(* ====================================================================== *)
4196(* Sets of size n. *)
4197(* ====================================================================== *)
4198
4199Definition count_def[nocompute]: count (n:num) = {m | m < n}
4200End
4201
4202Theorem IN_COUNT[simp]:
4203 !m n. m IN count n <=> m < n
4204Proof
4205 RW_TAC bool_ss [GSPECIFICATION, count_def]
4206QED
4207
4208Theorem COUNT_ZERO[simp] :
4209 count 0 = {}
4210Proof
4211 RW_TAC bool_ss [EXTENSION, IN_COUNT, NOT_IN_EMPTY]
4212 >> CONV_TAC Arith.ARITH_CONV
4213QED
4214
4215Theorem COUNT_SUC :
4216 !n. count (SUC n) = n INSERT count n
4217Proof
4218 RW_TAC bool_ss [EXTENSION, IN_INSERT, IN_COUNT]
4219 >> CONV_TAC Arith.ARITH_CONV
4220QED
4221
4222(* This lemma may appear at the induction base of ‘!n. P (count (SUC n))’ *)
4223Theorem COUNT_ONE :
4224 count 1 = {0}
4225Proof
4226 RW_TAC bool_ss [ONE, COUNT_SUC, COUNT_ZERO]
4227QED
4228
4229Theorem FINITE_COUNT[simp]:
4230 !n. FINITE (count n)
4231Proof
4232 Induct THENL
4233 [RW_TAC bool_ss [COUNT_ZERO, FINITE_EMPTY],
4234 RW_TAC bool_ss [COUNT_SUC, FINITE_INSERT]]
4235QED
4236
4237Theorem CARD_COUNT[simp]:
4238 !n. CARD (count n) = n
4239Proof
4240 Induct THENL
4241 [RW_TAC bool_ss [COUNT_ZERO, CARD_EMPTY],
4242 RW_TAC bool_ss [COUNT_SUC, CARD_INSERT, FINITE_COUNT, IN_COUNT]
4243 THEN POP_ASSUM MP_TAC
4244 THEN CONV_TAC Arith.ARITH_CONV]
4245QED
4246
4247Theorem COUNT_11[simp]: !n1 n2. (count n1 = count n2) <=> (n1 = n2)
4248Proof
4249 SRW_TAC [] [EQ_IMP_THM, EXTENSION]
4250 >> METIS_TAC [numLib.ARITH_PROVE ``x:num < y <=> ~(y <= x)``,
4251 LESS_EQ_REFL, LESS_EQUAL_ANTISYM]
4252QED
4253
4254Theorem COUNT_DELETE[simp]: !n. count n DELETE n = count n
4255Proof
4256 SRW_TAC [] [EQ_IMP_THM, EXTENSION]
4257QED
4258
4259Theorem COUNT_MONO: !m n. m <= n ==> (count m) SUBSET (count n)
4260Proof
4261 SRW_TAC [] [count_def, SUBSET_DEF, GSPECIFICATION]
4262 >> RW_TAC arith_ss []
4263QED
4264
4265Theorem COUNT_NOT_EMPTY: !n. 0 < n <=> count n <> {}
4266Proof
4267 RW_TAC arith_ss [Once EXTENSION, IN_COUNT, NOT_IN_EMPTY]
4268 >> EQ_TAC >> STRIP_TAC
4269 >- (Q.EXISTS_TAC `0` >> ASM_REWRITE_TAC [])
4270 >> `0 <= x` by RW_TAC arith_ss []
4271 >> MATCH_MP_TAC LESS_EQ_LESS_TRANS
4272 >> Q.EXISTS_TAC `x` >> ASM_REWRITE_TAC []
4273QED
4274
4275(* Theorem: (count n = {}) <=> (n = 0) *)
4276(* Proof:
4277 Since FINITE (count n) by FINITE_COUNT
4278 and CARD (count n) = n by CARD_COUNT
4279 so count n = {} <=> n = 0 by CARD_EQ_0
4280*)
4281Theorem COUNT_EQ_EMPTY[simp]:
4282 (count n = {}) <=> (n = 0)
4283Proof
4284 metis_tac[FINITE_COUNT, CARD_COUNT, CARD_EQ_0]
4285QED
4286
4287(* =====================================================================*)
4288(* Infiniteness *)
4289(* =====================================================================*)
4290
4291Overload INFINITE = ``\s. ~FINITE s``
4292
4293Theorem NOT_IN_FINITE:
4294 INFINITE (UNIV:'a set)
4295 =
4296 !s:'a set. FINITE s ==> ?x. ~(x IN s)
4297Proof
4298 EQ_TAC THENL
4299 [CONV_TAC CONTRAPOS_CONV THEN
4300 CONV_TAC (ONCE_DEPTH_CONV NOT_FORALL_CONV) THEN
4301 REWRITE_TAC [NOT_IMP] THEN
4302 CONV_TAC (ONCE_DEPTH_CONV NOT_EXISTS_CONV) THEN
4303 REWRITE_TAC [EQ_UNIV] THEN
4304 CONV_TAC (ONCE_DEPTH_CONV SYM_CONV) THEN
4305 REPEAT STRIP_TAC THEN ASM_REWRITE_TAC [],
4306 REPEAT STRIP_TAC THEN RES_THEN STRIP_ASSUME_TAC THEN
4307 ASSUME_TAC (SPEC (“x:'a”) IN_UNIV) THEN RES_TAC]
4308QED
4309
4310Theorem INFINITE_INHAB:
4311 !P. INFINITE P ==> ?x. x IN P
4312Proof
4313 REWRITE_TAC [MEMBER_NOT_EMPTY] THEN REPEAT STRIP_TAC THEN
4314 FIRST_X_ASSUM SUBST_ALL_TAC THEN POP_ASSUM MP_TAC THEN
4315 REWRITE_TAC [FINITE_EMPTY]
4316QED
4317
4318val INVERSE_LEMMA =
4319 TAC_PROOF
4320 (([], (“!f:'a->'b. (!x y. (f x = f y) ==> (x = y)) ==>
4321 ((\x:'b. @y:'a. x = f y) o f = \x:'a.x)”)),
4322 REPEAT STRIP_TAC THEN CONV_TAC FUN_EQ_CONV THEN
4323 PURE_ONCE_REWRITE_TAC [o_THM] THEN
4324 CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) THEN
4325 GEN_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN
4326 CONV_TAC (SYM_CONV THENC SELECT_CONV) THEN
4327 EXISTS_TAC (“x:'a”) THEN REFL_TAC);
4328
4329Theorem IMAGE_11_INFINITE:
4330 !f:'a->'b. (!x y. (f x = f y) ==> (x = y)) ==>
4331 !s:'a set. INFINITE s ==> INFINITE (IMAGE f s)
4332Proof
4333 METIS_TAC [INJECTIVE_IMAGE_FINITE]
4334QED
4335
4336Theorem INFINITE_SUBSET:
4337 !s:'a set. INFINITE s ==> (!t. s SUBSET t ==> INFINITE t)
4338Proof
4339 REPEAT STRIP_TAC THEN IMP_RES_TAC SUBSET_FINITE THEN RES_TAC
4340QED
4341
4342Theorem IN_INFINITE_NOT_FINITE:
4343 !s t. INFINITE s /\ FINITE t ==> ?x:'a. x IN s /\ ~(x IN t)
4344Proof
4345 CONV_TAC (ONCE_DEPTH_CONV CONTRAPOS_CONV) THEN
4346 CONV_TAC (ONCE_DEPTH_CONV NOT_EXISTS_CONV) THEN
4347 PURE_ONCE_REWRITE_TAC [DE_MORGAN_THM] THEN
4348 REWRITE_TAC [SYM(SPEC_ALL IMP_DISJ_THM)] THEN
4349 PURE_ONCE_REWRITE_TAC [SYM(SPEC_ALL SUBSET_DEF)] THEN
4350 REPEAT STRIP_TAC THEN IMP_RES_TAC INFINITE_SUBSET
4351QED
4352
4353Theorem INFINITE_INJ:
4354 !f s t. INJ f s t /\ INFINITE s ==> INFINITE t
4355Proof
4356 PROVE_TAC [FINITE_INJ]
4357QED
4358
4359Theorem num_FINITE :
4360 !s:num->bool. FINITE s <=> ?a. !x. x IN s ==> x <= a
4361Proof
4362 GEN_TAC THEN EQ_TAC THENL
4363 [SPEC_TAC(``s:num->bool``,``s:num->bool``) THEN GEN_TAC THEN
4364 KNOW_TAC ``(?a. !x. x IN s ==> x <= a) =
4365 (\s. ?a. !x. x IN s ==> x <= a) (s:num->bool)`` THENL
4366 [FULL_SIMP_TAC std_ss [], ALL_TAC] THEN DISC_RW_KILL THEN
4367 MATCH_MP_TAC FINITE_INDUCT THEN BETA_TAC THEN
4368 REWRITE_TAC[IN_INSERT, NOT_IN_EMPTY] THEN MESON_TAC[LESS_EQ_CASES, LESS_EQ_TRANS],
4369 DISCH_THEN(X_CHOOSE_TAC ``n:num``) THEN
4370 KNOW_TAC ``s SUBSET {m:num | m <= n}`` THENL [REWRITE_TAC [SUBSET_DEF] THEN
4371 RW_TAC std_ss [GSPECIFICATION], ALL_TAC] THEN MATCH_MP_TAC SUBSET_FINITE THEN
4372 KNOW_TAC ``{m:num | m <= n} = {m | m < n} UNION {n}``
4373 THENL [SIMP_TAC std_ss [UNION_DEF, EXTENSION, GSPECIFICATION, IN_SING, LESS_OR_EQ],
4374 SIMP_TAC std_ss [FINITE_UNION, FINITE_SING, GSYM count_def, FINITE_COUNT]]]
4375QED
4376
4377Theorem num_FINITE_AVOID :
4378 !s:num->bool. FINITE(s) ==> ?a. ~(a IN s)
4379Proof
4380 MESON_TAC[num_FINITE, LESS_THM, NOT_LESS]
4381QED
4382
4383Theorem num_INFINITE :
4384 INFINITE univ(:num)
4385Proof
4386 MESON_TAC[num_FINITE_AVOID, IN_UNIV]
4387QED
4388
4389(* ---------------------------------------------------------------------- *)
4390(* The next series of lemmas are used for proving that if UNIV: set *)
4391(* is INFINITE then :'a satisfies an axiom of infinity. *)
4392(* *)
4393(* The function g:num->'a set defines a series of sets: *)
4394(* *)
4395(* {}, {x1}, {x1,x2}, {x1,x2,x3},... *)
4396(* *)
4397(* and one then defines an f:'a->'a such that f(xi)=xi+1. *)
4398(* ---------------------------------------------------------------------- *)
4399
4400(* ---------------------------------------------------------------------*)
4401(* Defining equations for g *)
4402(* ---------------------------------------------------------------------*)
4403
4404val gdef = map Term
4405 [ `g 0 = ({}:'a set)`,
4406 `!n. g (SUC n) =
4407 case some x. x IN s /\ x NOTIN g n of
4408 NONE => g n
4409 | SOME x => x INSERT g n`]
4410
4411(* ---------------------------------------------------------------------*)
4412(* Lemma: g n is finite for all n. *)
4413(* ---------------------------------------------------------------------*)
4414
4415val rand_case =
4416 prove_case_rand_thm {case_def = option_case_def, nchotomy = option_CASES};
4417
4418Theorem optcase_elim[local]:
4419 option_CASE optv n fv:bool <=>
4420 (optv = NONE) /\ n \/ ?x. (optv = SOME x) /\ fv x
4421Proof
4422 Cases_on `optv` >> simp[]
4423QED
4424
4425val g_finite =
4426 TAC_PROOF
4427 ((gdef, ``!n:num. FINITE (g n:'a set)``),
4428 INDUCT_TAC >> simp[rand_case, optcase_elim] >> METIS_TAC[option_CASES]);
4429
4430(* ---------------------------------------------------------------------*)
4431(* Lemma: g n is contained in g (n+i) for all i. *)
4432(* ---------------------------------------------------------------------*)
4433
4434val g_subset =
4435 TAC_PROOF
4436 ((gdef, ``!n. !x:'a. x IN (g n) ==> !i. x IN (g (n+i))``),
4437 REPEAT GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN
4438 ASM_REWRITE_TAC [ADD_CLAUSES,IN_INSERT] >>
4439 simp[optcase_elim, rand_case] >> METIS_TAC[option_CASES]);
4440
4441(* ---------------------------------------------------------------------*)
4442(* Lemma: if x is in g(n) then {x} = g(n+1)-g(n) for some n. *)
4443(* ---------------------------------------------------------------------*)
4444
4445val lemma =
4446 TAC_PROOF(([], (“((A \/ B) /\ ~B) = (A /\ ~B)”)),
4447 BOOL_CASES_TAC (“B:bool”) THEN REWRITE_TAC[]);
4448
4449val g_cases =
4450 TAC_PROOF
4451 ((gdef, (“!x:'a. (?n. x IN (g n)) ==>
4452 (?m. (x IN (g (SUC m))) /\ ~(x IN (g m)))”)),
4453 GEN_TAC >>
4454 DISCH_THEN (STRIP_THM_THEN MP_TAC o
4455 CONV_RULE numLib.EXISTS_LEAST_CONV) >>
4456 Cases_on ‘n’ >- simp[] >> Q.RENAME_TAC [‘x IN g (SUC N)’] >>
4457 STRIP_TAC >> Q.EXISTS_TAC ‘N’ >> conj_tac >- first_assum ACCEPT_TAC >>
4458 first_x_assum MATCH_MP_TAC >> simp[]);
4459
4460val g_in_s = TAC_PROOF(
4461 (gdef, “!n:num. g n SUBSET (s:'a set)”),
4462 Induct >> simp[] >> DEEP_INTRO_TAC some_intro >> simp[] >>
4463 SRW_TAC[][INSERT_SUBSET]);
4464
4465val inf = “INFINITE (s:'a set)”
4466val infinite_g_grows = TAC_PROOF(
4467 (inf::gdef, “!n. ?e:'a. e IN g (SUC n) /\ e NOTIN g n”),
4468 rpt strip_tac >> simp[] >> ONCE_REWRITE_TAC [rand_case] >>
4469 simp_tac (srw_ss() ++ boolSimps.DNF_ss) [optcase_elim] >>
4470 simp_tac (srw_ss() ++ boolSimps.CONJ_ss) [] >>
4471 DEEP_INTRO_TAC some_intro >> simp[] >>
4472 METIS_TAC [IN_INFINITE_NOT_FINITE, g_finite])
4473
4474val enum_exists = infinite_g_grows |> CONV_RULE SKOLEM_CONV
4475val enum_def = subst[“e:num->'a” |-> “enum: num -> 'a”]
4476 (enum_exists |> concl |> dest_exists |> #2)
4477
4478val enum_11 = TAC_PROOF(
4479 (enum_def::inf::gdef, “!m:num n. (enum m:'a = enum n) <=> (m = n)”),
4480 simp[EQ_IMP_THM] >> SPOSE_NOT_THEN strip_assume_tac >>
4481 wlogLib.wlog_tac ‘m < n’ [‘m’, ‘n’] >- METIS_TAC[NOT_LESS, LESS_OR_EQ] >>
4482 `enum m NOTIN g m /\ enum m IN (g (SUC m))` by simp[] >>
4483 ‘?i. n = SUC m + i’ by METIS_TAC[LESS_EQ_EXISTS,LESS_OR] >>
4484 ‘enum m IN g n’ by METIS_TAC[g_subset] >> METIS_TAC[])
4485
4486val enum_in_s = TAC_PROOF(
4487 (enum_def::inf::gdef, “!n:num. enum n : 'a IN s”),
4488 strip_tac >> ‘enum n IN g (SUC n)’ by simp[] >>
4489 ‘g (SUC n) SUBSET s’ by simp[g_in_s] >> METIS_TAC[SUBSET_DEF]);
4490
4491(* "define" injection *)
4492val inj_def =
4493 “!x. inj (x:'a) = case some n. enum n = x of
4494 NONE => x
4495 | SOME n => enum (n + 1)”
4496
4497val result_part1_0 = TAC_PROOF(
4498 (inj_def::enum_def::inf::gdef, “INJ inj (s:'a set) s /\ ~SURJ inj s s”),
4499 simp_tac (srw_ss()) [INJ_DEF, SURJ_DEF] >> rpt strip_tac
4500 >- (simp[] >> DEEP_INTRO_TAC some_intro >> simp[enum_in_s])
4501 >- (pop_assum mp_tac >> simp[] >> DEEP_INTRO_TAC some_intro >>
4502 DEEP_INTRO_TAC some_intro >> simp[enum_11])
4503 >- (disj2_tac >> Q.EXISTS_TAC ‘enum 0’ >> conj_tac >- simp[enum_in_s] >>
4504 Q.X_GEN_TAC ‘y’ >> Cases_on ‘y IN s’ >> simp[] >>
4505 DEEP_INTRO_TAC some_intro >> simp[enum_11]))
4506
4507val gexists =
4508 num_Axiom
4509 |> INST_TYPE [alpha |-> ``:'a set``]
4510 |> SPECL [“EMPTY : 'a set”,
4511 “\n:num r:'a set.
4512 case some x. x IN s /\ x NOTIN r of
4513 NONE => r
4514 | SOME x => x INSERT r”]
4515 |> SIMP_RULE bool_ss []
4516
4517val result_part1 =
4518 result_part1_0
4519 |> EXISTS (mk_exists(“inj:'a -> 'a”, concl result_part1_0), “inj:'a -> 'a”)
4520 |> DISCH inj_def
4521 |> INST [“inj:'a -> 'a” |-> “\x:'a. ^(inj_def |> dest_forall |> #2 |> rhs)”]
4522 |> SIMP_RULE bool_ss []
4523 |> CHOOSE(``enum:num->'a``, enum_exists)
4524 |> itlist PROVE_HYP (CONJUNCTS (ASSUME (list_mk_conj gdef)))
4525 |> CHOOSE(``g:num ->'a set``, gexists)
4526 |> DISCH_ALL
4527
4528Theorem result_part2[local]:
4529 !s. FINITE s ==> !f. INJ f s s ==> SURJ f s s
4530Proof
4531 ho_match_mp_tac FINITE_COMPLETE_INDUCTION >>
4532 simp[INJ_IFF, SURJ_DEF] >>
4533 rpt strip_tac >> SPOSE_NOT_THEN strip_assume_tac >>
4534 Q.RENAME_TAC [‘x IN s’] >>
4535 Q.ABBREV_TAC ‘s0 = s DELETE x’ >>
4536 ‘INJ f s s0’ by simp[INJ_DEF, Abbr‘s0’] >>
4537 ‘FINITE s0’ by simp[Abbr‘s0’] >>
4538 ‘CARD s0 < CARD s’ suffices_by METIS_TAC[PHP] >>
4539 simp[Abbr‘s0’, CARD_DELETE] >> Cases_on ‘s’ >> fs[]
4540QED
4541
4542(* ---------------------------------------------------------------------*)
4543(* Finally, we can prove the desired theorem. *)
4544(* ---------------------------------------------------------------------*)
4545
4546Theorem INFINITE_INJ_NOT_SURJ:
4547 !s. INFINITE s <=> ?f. INJ f s s /\ ~SURJ f s s
4548Proof
4549 METIS_TAC[result_part1, result_part2]
4550QED
4551
4552(* and applying to the UNIV set *)
4553Theorem INFINITE_UNIV:
4554 INFINITE (UNIV:'a set)
4555 =
4556 ?f:'a->'a. (!x y. (f x = f y) ==> (x = y)) /\ (?y. !x. ~(f x = y))
4557Proof
4558
4559 simp[INFINITE_INJ_NOT_SURJ, INJ_DEF, SURJ_DEF]
4560QED
4561
4562Theorem INFINITE_NUM_UNIV[simp] = num_INFINITE
4563
4564Theorem FINITE_PSUBSET_INFINITE:
4565 !s. INFINITE (s:'a set) =
4566 !t. FINITE (t:'a set) ==> ((t SUBSET s) ==> (t PSUBSET s))
4567Proof
4568 PURE_REWRITE_TAC [PSUBSET_DEF] THEN
4569 GEN_TAC THEN EQ_TAC THENL
4570 [REPEAT STRIP_TAC THENL
4571 [FIRST_ASSUM ACCEPT_TAC,
4572 FIRST_ASSUM (fn th => fn g => SUBST_ALL_TAC th g handle _ => NO_TAC g)
4573 THEN RES_TAC],
4574 REPEAT STRIP_TAC THEN RES_TAC THEN
4575 ASSUME_TAC (SPEC (“s:'a set”) SUBSET_REFL) THEN
4576 ASSUME_TAC (REFL (“s:'a set”)) THEN RES_TAC]
4577QED
4578
4579Theorem FINITE_PSUBSET_UNIV:
4580 INFINITE (UNIV:'a set) = !s:'a set. FINITE s ==> s PSUBSET UNIV
4581Proof
4582 PURE_ONCE_REWRITE_TAC [FINITE_PSUBSET_INFINITE] THEN
4583 REWRITE_TAC [PSUBSET_DEF,SUBSET_UNIV]
4584QED
4585
4586Theorem INFINITE_DIFF_FINITE' :
4587 !s:'a->bool t. INFINITE(s) /\ FINITE(t) ==> INFINITE(s DIFF t)
4588Proof
4589 REPEAT GEN_TAC THEN
4590 MATCH_MP_TAC(TAUT `(b /\ ~c ==> ~a) ==> a /\ b ==> c`) THEN
4591 REWRITE_TAC [] THEN STRIP_TAC THEN
4592 MATCH_MP_TAC SUBSET_FINITE_I THEN
4593 EXISTS_TAC ``(t:'a->bool) UNION (s DIFF t)`` THEN
4594 ASM_REWRITE_TAC[FINITE_UNION] THEN
4595 rw [SUBSET_DEF]
4596QED
4597
4598Theorem INFINITE_DIFF_FINITE :
4599 !s t. (INFINITE s /\ FINITE t) ==> ~(s DIFF t = ({}:'a set))
4600Proof
4601 PROVE_TAC [INFINITE_DIFF_FINITE', INFINITE_INHAB, MEMBER_NOT_EMPTY]
4602QED
4603
4604val FINITE_INDUCT' =
4605 Ho_Rewrite.REWRITE_RULE [PULL_FORALL] FINITE_INDUCT ;
4606
4607Theorem NOT_IN_COUNT[local]:
4608 ~ (m IN count m)
4609Proof
4610 REWRITE_TAC [IN_COUNT, LESS_REFL]
4611QED
4612
4613Theorem FINITE_BIJ_COUNT_EQ:
4614 !s. FINITE s = ?c n. BIJ c (count n) s
4615Proof
4616 RW_TAC std_ss []
4617 >> REVERSE EQ_TAC >- PROVE_TAC [FINITE_COUNT, FINITE_BIJ]
4618 >> Induct_on ‘FINITE’
4619 >> RW_TAC std_ss [BIJ_DEF, INJ_DEF, SURJ_DEF, NOT_IN_EMPTY]
4620 >- (Q.EXISTS_TAC `c`
4621 >> Q.EXISTS_TAC `0`
4622 >> RW_TAC std_ss [COUNT_ZERO, NOT_IN_EMPTY])
4623 >> Q.EXISTS_TAC `\m. if m = n then e else c m`
4624 >> Q.EXISTS_TAC `SUC n`
4625 >> Know `!x. x IN count n ==> ~(x = n)`
4626 >- RW_TAC arith_ss [IN_COUNT]
4627 >> RW_TAC std_ss [COUNT_SUC, IN_INSERT]
4628 >> PROVE_TAC []
4629QED
4630
4631Theorem FINITE_BIJ_COUNT:
4632 !s. FINITE s ==> ?f b. BIJ f (count b) s
4633Proof
4634 RW_TAC std_ss [FINITE_BIJ_COUNT_EQ]
4635QED
4636
4637fun drop_forall th = if is_forall (concl th) then [] else [th] ;
4638
4639val FINITE_BIJ_CARD_EQ' =
4640 Ho_Rewrite.REWRITE_RULE [PULL_FORALL, AND_IMP_INTRO] FINITE_BIJ_CARD_EQ ;
4641
4642Theorem FINITE_ISO_NUM:
4643 !s:'a set.
4644 FINITE s ==>
4645 ?f. (!n m. (n < CARD s /\ m < CARD s) ==> (f n = f m) ==> (n = m)) /\
4646 (s = {f n | n < CARD s})
4647Proof
4648 REPEAT STRIP_TAC THEN
4649 IMP_RES_TAC FINITE_BIJ_COUNT THEN
4650 ASSUME_TAC (Q.SPEC `b` FINITE_COUNT) THEN
4651 IMP_RES_TAC FINITE_BIJ_CARD_EQ' THEN
4652 ASSUME_TAC (Q.ISPECL [`count b`, `s : 'a -> bool`] FINITE_BIJ_CARD_EQ') THEN
4653 RES_TAC THEN Q.EXISTS_TAC `f` THEN
4654 (* omitting next step multiplies proof time by 40! *)
4655 RULE_L_ASSUM_TAC drop_forall THEN
4656 RULE_L_ASSUM_TAC (CONJUNCTS o
4657 REWRITE_RULE [BIJ_DEF, INJ_DEF, SURJ_DEF, IN_COUNT]) THEN
4658 FIRST_ASSUM (fn th => REWRITE_TAC [SYM th, CARD_COUNT]) THEN
4659 CONJ_TAC THEN1 FIRST_ASSUM ACCEPT_TAC THEN
4660 REWRITE_TAC [EXTENSION] THEN
4661 GEN_TAC THEN EQ_TAC
4662 THENL [
4663 DISCH_TAC THEN RES_TAC THEN
4664 HO_MATCH_MP_TAC IN_GSPEC THEN
4665 Q.EXISTS_TAC `y` THEN ASM_REWRITE_TAC [],
4666 SIMP_TAC std_ss [GSPECIFICATION] THEN
4667 REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC [] ]
4668QED
4669
4670Theorem FINITE_WEAK_ENUMERATE:
4671 !s. FINITE s = ?f b. !e. e IN s <=> ?n. n < b /\ (e = f n)
4672Proof
4673 GEN_TAC THEN EQ_TAC
4674 THENL [
4675 DISCH_TAC THEN IMP_RES_TAC FINITE_BIJ_COUNT THEN
4676 RULE_L_ASSUM_TAC (CONJUNCTS o
4677 REWRITE_RULE [BIJ_DEF, SURJ_DEF, IN_COUNT]) THEN
4678 Q.EXISTS_TAC `f` THEN Q.EXISTS_TAC `b` THEN
4679 GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN RES_TAC
4680 THENL [Q.EXISTS_TAC `y`, ALL_TAC] THEN ASM_REWRITE_TAC [],
4681 STRIP_TAC THEN irule SUBSET_FINITE THEN
4682 Q.EXISTS_TAC `IMAGE f (count b)` THEN CONJ_TAC
4683 THENL [ irule IMAGE_FINITE THEN irule FINITE_COUNT,
4684 ASM_SIMP_TAC std_ss [IMAGE_DEF, SUBSET_DEF, count_def,
4685 GSPECIFICATION] THEN
4686 REPEAT STRIP_TAC THEN Q.EXISTS_TAC `n` THEN ASM_REWRITE_TAC [] ]]
4687QED
4688
4689Theorem lem[local]:
4690 !s R.
4691 FINITE s /\ (!e. e IN s <=> (?y. R e y) \/ (?x. R x e)) /\
4692 (!n. R (f (SUC n)) (f n)) ==>
4693 ?x. R^+ x x
4694Proof
4695 REPEAT STRIP_TAC THEN `!n. f n IN s` by METIS_TAC [] THEN
4696 Cases_on `?n m. (f n = f m) /\ n <> m` THENL [
4697 POP_ASSUM STRIP_ASSUME_TAC THEN
4698 Cases_on `n < m` THENL [
4699 ALL_TAC,
4700 `m < n` by DECIDE_TAC
4701 ] THEN
4702 Q.ISPECL_THEN [`inv R^+`, `f`] MP_TAC transitive_monotone THEN
4703 SRW_TAC [][inv_DEF, transitive_inv] THEN
4704 METIS_TAC [TC_SUBSET],
4705
4706 `!n m. (f n = f m) = (n = m)` by METIS_TAC [] THEN
4707 `IMAGE f univ(:num) SUBSET s`
4708 by (SRW_TAC [][SUBSET_DEF, IN_IMAGE] THEN METIS_TAC []) THEN
4709 `FINITE (IMAGE f univ(:num))` by METIS_TAC [SUBSET_FINITE] THEN
4710 POP_ASSUM MP_TAC THEN SRW_TAC [][INJECTIVE_IMAGE_FINITE]
4711 ]
4712QED
4713
4714Theorem FINITE_WF_noloops:
4715 !s. FINITE s ==>
4716 (WF (REL_RESTRICT R s) <=> irreflexive (REL_RESTRICT R s)^+)
4717Proof
4718 Q_TAC SUFF_TAC
4719 `!s. FINITE s ==>
4720 irreflexive (TC (REL_RESTRICT R s)) ==> WF (REL_RESTRICT R s)`
4721 THEN1 METIS_TAC [irreflexive_def, WF_noloops] THEN
4722 REWRITE_TAC [WF_IFF_WELLFOUNDED, wellfounded_def] THEN
4723 REPEAT STRIP_TAC THEN
4724 Q.SPECL_THEN [`f`,
4725 `{x | x IN s /\ ((?y. R x y /\ y IN s) \/
4726 (?x'. R x' x /\ x' IN s))}`,
4727 `REL_RESTRICT R s`] MP_TAC (GEN_ALL lem) THEN
4728 ASM_SIMP_TAC (srw_ss() ++ DNF_ss) [REL_RESTRICT_DEF] THEN
4729 FULL_SIMP_TAC (srw_ss()) [irreflexive_def] THEN
4730 CONJ_TAC THENL [
4731 MATCH_MP_TAC SUBSET_FINITE_I THEN Q.EXISTS_TAC `s` THEN
4732 SRW_TAC [][SUBSET_DEF],
4733 METIS_TAC []
4734 ]
4735QED
4736
4737Theorem FINITE_StrongOrder_WF:
4738 !R s. FINITE s /\ StrongOrder (REL_RESTRICT R s) ==>
4739 WF (REL_RESTRICT R s)
4740Proof
4741 SRW_TAC [][FINITE_WF_noloops, StrongOrder,
4742 transitive_TC_identity]
4743QED
4744
4745(* ===================================================================== *)
4746(* Big union (union of set of sets) *)
4747(* ===================================================================== *)
4748
4749Definition BIGUNION[nocompute]:
4750 BIGUNION P = { x | ?s. s IN P /\ x IN s}
4751End
4752val _ = ot0 "BIGUNION" "bigUnion"
4753
4754(* N-ARY UNION (it's not any bigger but a different symbol)
4755val _ = Unicode.unicode_version {u = UTF8.chr 0x22C3, tmnm = "BIGUNION"};
4756val _ = TeX_notation {hol = UTF8.chr 0x22C3, TeX = ("\\HOLTokenBigUnion{}", 1)};
4757 *)
4758val _ = TeX_notation {hol = "BIGUNION", TeX = ("\\HOLTokenBigUnion{}", 1)};
4759
4760Theorem IN_BIGUNION[simp]:
4761 !x sos. x IN BIGUNION sos <=> ?s. x IN s /\ s IN sos
4762Proof
4763 SIMP_TAC bool_ss [GSPECIFICATION, BIGUNION, pairTheory.PAIR_EQ] THEN
4764 MESON_TAC []
4765QED
4766
4767Theorem BIGUNION_GSPEC:
4768 (!P f. BIGUNION {f x | P x} = {a | ?x. P x /\ a IN (f x)}) /\
4769 (!P f. BIGUNION {f x y | P x y} = {a | ?x y. P x y /\ a IN (f x y)}) /\
4770 (!P f. BIGUNION {f x y z | P x y z} =
4771 {a | ?x y z. P x y z /\ a IN (f x y z)})
4772Proof
4773 REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC [EXTENSION] THEN
4774 SIMP_TAC std_ss [IN_BIGUNION, GSPECIFICATION, EXISTS_PROD] THEN MESON_TAC[]
4775QED
4776
4777(* from util_prob *)
4778Theorem IN_BIGUNION_IMAGE:
4779 !f s y. (y IN BIGUNION (IMAGE f s)) = (?x. x IN s /\ y IN f x)
4780Proof
4781 RW_TAC std_ss [EXTENSION, IN_BIGUNION, IN_IMAGE] >> PROVE_TAC []
4782QED
4783
4784Theorem BIGUNION_IMAGE:
4785 !f s. BIGUNION (IMAGE f s) = {y | ?x. x IN s /\ y IN f x}
4786Proof
4787 simp[Once EXTENSION, PULL_EXISTS] >> METIS_TAC[]
4788QED
4789
4790Theorem BIGUNION_EMPTY[simp]:
4791 BIGUNION EMPTY = EMPTY
4792Proof
4793 SIMP_TAC bool_ss [EXTENSION, IN_BIGUNION, NOT_IN_EMPTY]
4794QED
4795
4796Theorem BIGUNION_EQ_EMPTY[simp]:
4797 !P. (BIGUNION P = {} <=> P = {} \/ P = {{}}) /\
4798 ({} = BIGUNION P <=> P = {} \/ P = {{}})
4799Proof
4800 SRW_TAC [][EXTENSION, IN_BIGUNION, EQ_IMP_THM, FORALL_AND_THM] THEN
4801 METIS_TAC [EXTENSION]
4802QED
4803
4804Theorem BIGUNION_SING:
4805 !x. BIGUNION {x} = x
4806Proof
4807 SIMP_TAC bool_ss [EXTENSION, IN_BIGUNION, IN_INSERT, NOT_IN_EMPTY] THEN
4808 SIMP_TAC bool_ss [GSYM EXTENSION]
4809QED
4810
4811Theorem BIGUNION_PAIR:
4812 !s t. BIGUNION {s; t} = s UNION t
4813Proof
4814 RW_TAC std_ss [EXTENSION, IN_BIGUNION, IN_UNION, IN_INSERT, NOT_IN_EMPTY]
4815 >> PROVE_TAC []
4816QED
4817
4818Theorem BIGUNION_UNION:
4819 !s1 s2. BIGUNION (s1 UNION s2) = (BIGUNION s1) UNION (BIGUNION s2)
4820Proof
4821 SIMP_TAC bool_ss [EXTENSION, IN_UNION, IN_BIGUNION, LEFT_AND_OVER_OR,
4822 EXISTS_OR_THM]
4823QED
4824
4825Theorem DISJOINT_BIGUNION_lemma[local]:
4826 !s t. DISJOINT (BIGUNION s) t = !s'. s' IN s ==> DISJOINT s' t
4827Proof
4828 REPEAT GEN_TAC THEN EQ_TAC THEN
4829 SIMP_TAC bool_ss [DISJOINT_DEF, EXTENSION, IN_BIGUNION, IN_INTER,
4830 NOT_IN_EMPTY] THEN MESON_TAC []
4831QED
4832
4833(* above with DISJOINT x y both ways round *)
4834Theorem DISJOINT_BIGUNION =
4835 CONJ DISJOINT_BIGUNION_lemma
4836 (ONCE_REWRITE_RULE [DISJOINT_SYM] DISJOINT_BIGUNION_lemma);
4837
4838Theorem BIGUNION_INSERT[simp]:
4839 !s P. BIGUNION (s INSERT P) = s UNION (BIGUNION P)
4840Proof
4841 SIMP_TAC bool_ss [EXTENSION, IN_BIGUNION, IN_UNION, IN_INSERT] THEN
4842 MESON_TAC []
4843QED
4844
4845Theorem BIGUNION_SUBSET:
4846 !X P. BIGUNION P SUBSET X <=> (!Y. Y IN P ==> Y SUBSET X)
4847Proof
4848 REPEAT STRIP_TAC THEN EQ_TAC THEN
4849 FULL_SIMP_TAC bool_ss [IN_BIGUNION, SUBSET_DEF] THEN
4850 PROVE_TAC []
4851QED
4852
4853Theorem BIGUNION_IMAGE_SUBSET :
4854 !f s t. BIGUNION (IMAGE f s) SUBSET t <=> !x. x IN s ==> f x SUBSET t
4855Proof
4856 RW_TAC std_ss [BIGUNION_SUBSET, IN_IMAGE]
4857 >> reverse EQ_TAC >> rw []
4858 >- (FIRST_X_ASSUM MATCH_MP_TAC >> art [])
4859 >> FIRST_X_ASSUM MATCH_MP_TAC
4860 >> Q.EXISTS_TAC ‘x’ >> art []
4861QED
4862
4863Theorem BIGUNION_IMAGE_UNIV:
4864 !f N.
4865 (!n. N <= n ==> (f n = {})) ==>
4866 (BIGUNION (IMAGE f UNIV) = BIGUNION (IMAGE f (count N)))
4867Proof
4868 RW_TAC std_ss [EXTENSION, IN_BIGUNION, IN_IMAGE, IN_UNIV, IN_COUNT,
4869 NOT_IN_EMPTY]
4870 >> REVERSE EQ_TAC >- PROVE_TAC []
4871 >> RW_TAC std_ss []
4872 >> PROVE_TAC [NOT_LESS]
4873QED
4874
4875Theorem FINITE_BIGUNION:
4876 !P. FINITE P /\ (!s. s IN P ==> FINITE s) ==> FINITE (BIGUNION P)
4877Proof
4878 Induct_on ‘FINITE’ THEN
4879 SIMP_TAC bool_ss [NOT_IN_EMPTY, FINITE_EMPTY, BIGUNION_EMPTY,
4880 IN_INSERT, DISJ_IMP_THM, FORALL_AND_THM,
4881 BIGUNION_INSERT, FINITE_UNION]
4882QED
4883
4884Theorem FINITE_BIGUNION_EQ[simp]:
4885 !P. FINITE (BIGUNION P) <=> FINITE P /\ (!s. s IN P ==> FINITE s)
4886Proof
4887 SIMP_TAC (srw_ss()) [EQ_IMP_THM, FORALL_AND_THM, FINITE_BIGUNION] THEN
4888 Induct_on ‘FINITE’ >>
4889 SIMP_TAC (srw_ss()) [DISJ_IMP_THM] THEN
4890 REPEAT (GEN_TAC ORELSE DISCH_THEN STRIP_ASSUME_TAC) THEN
4891 Q.RENAME_TAC [‘BIGUNION Q = e INSERT P’] THEN
4892 `BIGUNION (IMAGE (\s. s DELETE e) Q) = P`
4893 by (REWRITE_TAC [EXTENSION] THEN
4894 ASM_SIMP_TAC (srw_ss() ++ DNF_ss)
4895 [IN_BIGUNION, IN_IMAGE, IN_DELETE] THEN
4896 Q.X_GEN_TAC `x` THEN EQ_TAC THEN STRIP_TAC THENL [
4897 `x IN BIGUNION Q` by (SRW_TAC [][] THEN METIS_TAC []) THEN
4898 POP_ASSUM MP_TAC THEN METIS_TAC[IN_INSERT],
4899 `x IN (e INSERT P)` by SRW_TAC [][] THEN
4900 `~(x = e)` by PROVE_TAC [] THEN
4901 `x IN BIGUNION Q` by METIS_TAC[] THEN
4902 POP_ASSUM MP_TAC THEN SRW_TAC [][]
4903 ]) THEN
4904 `FINITE (IMAGE (\s. s DELETE e) Q) /\
4905 !s. s IN IMAGE (\s. s DELETE e) Q ==> FINITE s` by PROVE_TAC [] THEN
4906 CONJ_TAC THENL [
4907 Q_TAC SUFF_TAC `!x. FINITE { y | x = (\s. s DELETE e) y }` THEN1
4908 METIS_TAC [FINITELY_INJECTIVE_IMAGE_FINITE] THEN
4909 GEN_TAC THEN SIMP_TAC (srw_ss()) [] THEN
4910 Cases_on `e IN x` THENL [
4911 Q_TAC SUFF_TAC `{y | x = y DELETE e} = {}` THEN1 SRW_TAC [][] THEN
4912 SRW_TAC [][EXTENSION, IN_DELETE, GSPECIFICATION] THEN
4913 PROVE_TAC [],
4914 Q_TAC SUFF_TAC `{y | x = y DELETE e} = {x; e INSERT x}` THEN1
4915 SRW_TAC [][] THEN
4916 SRW_TAC [][EXTENSION, IN_DELETE, GSPECIFICATION] THEN METIS_TAC []
4917 ],
4918 REPEAT STRIP_TAC THEN
4919 `(s DELETE e) IN IMAGE (\s. s DELETE e) Q`
4920 by (SRW_TAC [][IN_IMAGE] THEN PROVE_TAC []) THEN
4921 `FINITE (s DELETE e)` by PROVE_TAC [] THEN
4922 PROVE_TAC [FINITE_DELETE]
4923 ]
4924QED
4925
4926Theorem SUBSET_BIGUNION_I:
4927 !x P. x IN P ==> x SUBSET BIGUNION P
4928Proof
4929 SRW_TAC [][BIGUNION, SUBSET_DEF] THEN METIS_TAC []
4930QED
4931
4932Theorem SUBSET_BIGUNION_SUBSET_I:
4933 B SUBSET A /\ A IN As ==> B SUBSET BIGUNION As
4934Proof
4935 simp[SUBSET_DEF] >> METIS_TAC[]
4936QED
4937
4938Theorem CARD_BIGUNION_SAME_SIZED_SETS:
4939 !n s.
4940 FINITE s /\ (!e. e IN s ==> FINITE e /\ (CARD e = n)) /\
4941 (!e1 e2. e1 IN s /\ e2 IN s /\ e1 <> e2 ==> DISJOINT e1 e2) ==>
4942 (CARD (BIGUNION s) = CARD s * n)
4943Proof
4944 GEN_TAC THEN
4945 SIMP_TAC bool_ss [RIGHT_FORALL_IMP_THM, GSYM AND_IMP_INTRO] THEN
4946 Induct_on `FINITE` THEN SRW_TAC [][] THEN
4947 SRW_TAC [][CARD_UNION_EQN] THEN
4948 `e INTER BIGUNION s = {}`
4949 suffices_by SRW_TAC [ARITH_ss][MULT_CLAUSES] THEN
4950 ASM_SIMP_TAC (srw_ss()) [EXTENSION] THEN
4951 Q.X_GEN_TAC `x` THEN Cases_on `x IN e` THEN
4952 ASM_SIMP_TAC (srw_ss()) [] THEN
4953 Q.X_GEN_TAC `e1` THEN Cases_on `e1 IN s` THEN SRW_TAC [][] THEN
4954 STRIP_TAC THEN
4955 `~DISJOINT e e1`
4956 by (SRW_TAC [][DISJOINT_DEF, EXTENSION] THEN METIS_TAC[]) THEN
4957 METIS_TAC[]
4958QED
4959
4960Theorem DISJOINT_COUNT:
4961 !f.
4962 (!m n : num. ~(m = n) ==> DISJOINT (f m) (f n)) ==>
4963 (!n. DISJOINT (f n) (BIGUNION (IMAGE f (count n))))
4964Proof
4965 RW_TAC arith_ss [DISJOINT_DEF, EXTENSION, IN_INTER, NOT_IN_EMPTY,
4966 IN_BIGUNION, IN_IMAGE, IN_COUNT]
4967 >> REVERSE (Cases_on `x IN f n`) >- PROVE_TAC []
4968 >> RW_TAC std_ss []
4969 >> REVERSE (Cases_on `x IN s`) >- PROVE_TAC []
4970 >> RW_TAC std_ss []
4971 >> REVERSE (Cases_on `x' < n`) >- PROVE_TAC []
4972 >> RW_TAC std_ss []
4973 >> Know `~(x':num = n)` >- DECIDE_TAC
4974 >> PROVE_TAC []
4975QED
4976
4977Theorem FORALL_IN_BIGUNION : (* from iterateTheory *)
4978 !P s. (!x. x IN BIGUNION s ==> P x) <=> !t x. t IN s /\ x IN t ==> P x
4979Proof
4980 REWRITE_TAC [IN_BIGUNION] >> PROVE_TAC []
4981QED
4982
4983Theorem INTER_BIGUNION : (* from probabilityTheory *)
4984 (!s t. BIGUNION s INTER t = BIGUNION {x INTER t | x IN s}) /\
4985 (!s t. t INTER BIGUNION s = BIGUNION {t INTER x | x IN s})
4986Proof
4987 ONCE_REWRITE_TAC [EXTENSION]
4988 >> SIMP_TAC std_ss [IN_BIGUNION, GSPECIFICATION, IN_INTER]
4989 >> MESON_TAC [IN_INTER]
4990QED
4991
4992Theorem SUBSET_BIGUNION : (* from real_topologyTheory *)
4993 !f g. f SUBSET g ==> BIGUNION f SUBSET BIGUNION g
4994Proof
4995 RW_TAC std_ss [SUBSET_DEF, IN_BIGUNION]
4996 >> Q.EXISTS_TAC `s` >> ASM_REWRITE_TAC []
4997 >> FIRST_X_ASSUM MATCH_MP_TAC
4998 >> ASM_REWRITE_TAC []
4999QED
5000
5001(* ----------------------------------------------------------------------
5002 BIGINTER (intersection of a set of sets)
5003 ---------------------------------------------------------------------- *)
5004
5005Definition BIGINTER[nocompute]:
5006 BIGINTER P = { x | !s. s IN P ==> x IN s}
5007End
5008val _ = ot0 "BIGINTER" "bigIntersect"
5009
5010(* N-ARY INTERSECTION (it's not any bigger but a different symbol)
5011val _ = Unicode.unicode_version {u = UTF8.chr 0x22C2, tmnm = "BIGINTER"};
5012val _ = TeX_notation {hol = UTF8.chr 0x22C2, TeX = ("\\HOLTokenBigInter{}", 1)};
5013 *)
5014val _ = TeX_notation {hol = "BIGINTER", TeX = ("\\HOLTokenBigInter{}", 1)};
5015
5016Theorem IN_BIGINTER[simp]:
5017 x IN BIGINTER B <=> !P. P IN B ==> x IN P
5018Proof
5019 SIMP_TAC bool_ss [BIGINTER, GSPECIFICATION, pairTheory.PAIR_EQ]
5020QED
5021
5022Theorem BIGINTER_GSPEC:
5023 (!P f. BIGINTER {f x | P x} = {a | !x. P x ==> a IN (f x)}) /\
5024 (!P f. BIGINTER {f x y | P x y} = {a | !x y. P x y ==> a IN (f x y)}) /\
5025 (!P f. BIGINTER {f x y z | P x y z} =
5026 {a | !x y z. P x y z ==> a IN (f x y z)})
5027Proof
5028 REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC [EXTENSION] THEN
5029 SIMP_TAC std_ss [IN_BIGINTER, GSPECIFICATION, EXISTS_PROD] THEN MESON_TAC[]
5030QED
5031
5032Theorem IN_BIGINTER_IMAGE:
5033 !x f s. (x IN BIGINTER (IMAGE f s)) = (!y. y IN s ==> x IN f y)
5034Proof RW_TAC std_ss [IN_BIGINTER, IN_IMAGE] >> PROVE_TAC []
5035QED
5036
5037Theorem BIGINTER_IMAGE:
5038 !f s. BIGINTER (IMAGE f s) = {y | !x. x IN s ==> y IN f x}
5039Proof simp[Once EXTENSION, PULL_EXISTS] >> METIS_TAC[]
5040QED
5041
5042Theorem BIGINTER_INSERT[simp]:
5043 !P B. BIGINTER (P INSERT B) = P INTER BIGINTER B
5044Proof
5045 REPEAT GEN_TAC THEN CONV_TAC (REWR_CONV EXTENSION) THEN
5046 SIMP_TAC bool_ss [IN_BIGINTER, IN_INSERT, IN_INTER, DISJ_IMP_THM,
5047 FORALL_AND_THM]
5048QED
5049
5050Theorem BIGINTER_EMPTY[simp]:
5051 BIGINTER {} = UNIV
5052Proof
5053 REWRITE_TAC [EXTENSION, IN_BIGINTER, NOT_IN_EMPTY, IN_UNIV]
5054QED
5055
5056Theorem BIGINTER_INTER[simp]:
5057 !P Q. BIGINTER {P; Q} = P INTER Q
5058Proof REWRITE_TAC [BIGINTER_EMPTY, BIGINTER_INSERT, INTER_UNIV]
5059QED
5060
5061Theorem BIGINTER_2 = BIGINTER_INTER
5062
5063Theorem BIGINTER_SING:
5064 !P. BIGINTER {P} = P
5065Proof
5066 SIMP_TAC bool_ss [EXTENSION, IN_BIGINTER, IN_SING] THEN
5067 SIMP_TAC bool_ss [GSYM EXTENSION]
5068QED
5069
5070Theorem SUBSET_BIGINTER:
5071 !X P. X SUBSET BIGINTER P <=> !Y. Y IN P ==> X SUBSET Y
5072Proof
5073 REPEAT STRIP_TAC THEN FULL_SIMP_TAC bool_ss [IN_BIGINTER, SUBSET_DEF] THEN
5074 PROVE_TAC []
5075QED
5076
5077Theorem DISJOINT_BIGINTER:
5078 !X Y P. Y IN P /\ DISJOINT Y X ==>
5079 DISJOINT X (BIGINTER P) /\ DISJOINT (BIGINTER P) X
5080Proof
5081 SIMP_TAC bool_ss [DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER,
5082 IN_BIGINTER] THEN PROVE_TAC []
5083QED
5084
5085Theorem BIGINTER_UNION:
5086 !s1 s2. BIGINTER (s1 UNION s2) = BIGINTER s1 INTER BIGINTER s2
5087Proof
5088 SIMP_TAC bool_ss [IN_BIGINTER, IN_UNION, IN_INTER, EXTENSION] THEN
5089 PROVE_TAC []
5090QED
5091
5092Theorem BIGINTER_SUBSET:
5093 !sp s t. t IN s /\ t SUBSET sp ==> (BIGINTER s) SUBSET sp
5094Proof
5095 RW_TAC std_ss [SUBSET_DEF,IN_BIGINTER]
5096QED
5097
5098Theorem DIFF_BIGINTER1:
5099 !sp s. sp DIFF (BIGINTER s) = BIGUNION (IMAGE (\u. sp DIFF u) s)
5100Proof
5101 (* SRW_TAC [] [EXTENSION] *)
5102 RW_TAC std_ss [EXTENSION, BIGINTER, BIGUNION, DIFF_DEF, IMAGE_DEF, IN_IMAGE,
5103 GSPECIFICATION, PAIR_EQ]
5104 >> EQ_TAC >- METIS_TAC [IN_DIFF]
5105 >> RW_TAC std_ss []
5106 >> METIS_TAC []
5107QED
5108
5109Theorem DIFF_BIGINTER:
5110 !sp s. (!t. t IN s ==> t SUBSET sp) /\ s <> {} ==>
5111 (BIGINTER s = sp DIFF (BIGUNION (IMAGE (\u. sp DIFF u) s)))
5112Proof
5113 RW_TAC std_ss []
5114 >> ‘BIGINTER s SUBSET sp’ by METIS_TAC[MEMBER_NOT_EMPTY, BIGINTER_SUBSET]
5115 >> ASSUME_TAC (Q.SPECL [`sp`,`s`] DIFF_BIGINTER1)
5116 >> `sp DIFF (sp DIFF (BIGINTER s)) = (BIGINTER s)`
5117 by RW_TAC std_ss [DIFF_DIFF_SUBSET]
5118 >> METIS_TAC []
5119QED
5120
5121Theorem FINITE_BIGINTER:
5122 (?s. s IN P /\ FINITE s) ==> FINITE (BIGINTER P)
5123Proof
5124 simp[PULL_EXISTS, Once DECOMPOSITION, INTER_FINITE]
5125QED
5126
5127(* ====================================================================== *)
5128(* Cross product of sets *)
5129(* ====================================================================== *)
5130
5131
5132Definition CROSS_DEF[nocompute]:
5133 CROSS P Q = { p | FST p IN P /\ SND p IN Q }
5134End
5135val _ = set_fixity "CROSS" (Infixr 601);
5136val _ = Unicode.unicode_version {tmnm = "CROSS", u = UTF8.chr 0xD7}
5137val _ = TeX_notation {hol = "CROSS", TeX = ("\\ensuremath{\\times}", 1)}
5138val _ = TeX_notation {hol = UTF8.chr 0xD7, TeX = ("\\ensuremath{\\times}", 1)}
5139
5140Theorem IN_CROSS[simp]:
5141 !P Q x. x IN (P CROSS Q) <=> FST x IN P /\ SND x IN Q
5142Proof
5143 SIMP_TAC bool_ss [GSPECIFICATION, CROSS_DEF, PAIR_EQ]
5144QED
5145
5146Theorem CROSS_EMPTY[simp]:
5147 !P. (P CROSS {} = {}) /\ ({} CROSS P = {})
5148Proof
5149 SIMP_TAC bool_ss [EXTENSION, IN_CROSS, NOT_IN_EMPTY]
5150QED
5151
5152Theorem CROSS_EMPTY_EQN:
5153 (s CROSS t = {}) <=> (s = {}) \/ (t = {})
5154Proof
5155 SRW_TAC[][EQ_IMP_THM] THEN SRW_TAC[][CROSS_EMPTY] THEN
5156 FULL_SIMP_TAC(srw_ss())[EXTENSION,pairTheory.FORALL_PROD] THEN
5157 METIS_TAC[]
5158QED
5159
5160Theorem CROSS_INSERT_LEFT:
5161 !P Q x. (x INSERT P) CROSS Q = ({x} CROSS Q) UNION (P CROSS Q)
5162Proof
5163 SIMP_TAC bool_ss [EXTENSION, IN_CROSS, IN_UNION, IN_INSERT,
5164 NOT_IN_EMPTY] THEN
5165 MESON_TAC []
5166QED
5167
5168Theorem CROSS_INSERT_RIGHT:
5169 !P Q x. P CROSS (x INSERT Q) = (P CROSS {x}) UNION (P CROSS Q)
5170Proof
5171 SIMP_TAC bool_ss [EXTENSION, IN_CROSS, IN_UNION, IN_INSERT,
5172 NOT_IN_EMPTY] THEN
5173 MESON_TAC []
5174QED
5175
5176Theorem FINITE_CROSS:
5177 !P Q. FINITE P /\ FINITE Q ==> FINITE (P CROSS Q)
5178Proof
5179 SIMP_TAC bool_ss [GSYM AND_IMP_INTRO, RIGHT_FORALL_IMP_THM] THEN
5180 HO_MATCH_MP_TAC FINITE_INDUCT THEN
5181 SIMP_TAC bool_ss [CROSS_EMPTY, FINITE_EMPTY] THEN
5182 REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC [CROSS_INSERT_LEFT] THEN
5183 ASM_SIMP_TAC bool_ss [FINITE_UNION] THEN
5184 REWRITE_TAC [FINITE_WEAK_ENUMERATE] THEN
5185 `?f b. !x. x IN Q <=> ?n. n < b /\ (x = f n)`
5186 by ASM_MESON_TAC [FINITE_WEAK_ENUMERATE] THEN
5187 Q.EXISTS_TAC `\m. (e, f m)` THEN Q.EXISTS_TAC `b` THEN
5188 ASM_SIMP_TAC bool_ss [IN_CROSS, IN_INSERT, NOT_IN_EMPTY] THEN
5189 GEN_TAC THEN Cases_on `e'` THEN
5190 SIMP_TAC bool_ss [PAIR_EQ, FST, SND] THEN MESON_TAC []
5191QED
5192
5193Theorem CROSS_SINGS[simp]:
5194 !x y. {x} CROSS {y} = {(x,y)}
5195Proof
5196 SIMP_TAC bool_ss [EXTENSION, IN_INSERT, IN_CROSS, NOT_IN_EMPTY] THEN
5197 MESON_TAC [PAIR, FST, SND]
5198QED
5199
5200Theorem CARD_SING_CROSS:
5201 !x P. FINITE P ==> (CARD ({x} CROSS P) = CARD P)
5202Proof
5203 GEN_TAC THEN HO_MATCH_MP_TAC FINITE_INDUCT THEN
5204 SIMP_TAC bool_ss [CROSS_EMPTY, CARD_EMPTY] THEN REPEAT STRIP_TAC THEN
5205 ONCE_REWRITE_TAC [CROSS_INSERT_RIGHT] THEN
5206 ASM_SIMP_TAC bool_ss [CROSS_SINGS, GSYM INSERT_SING_UNION] THEN
5207 `FINITE ({x} CROSS P)` by ASM_MESON_TAC [FINITE_SING, FINITE_CROSS] THEN
5208 `~((x,e) IN ({x} CROSS P))`
5209 by ASM_MESON_TAC [IN_CROSS, FST, SND, IN_SING] THEN
5210 ASM_SIMP_TAC bool_ss [CARD_INSERT]
5211QED
5212
5213Theorem CARD_CROSS:
5214 !P Q. FINITE P /\ FINITE Q ==> (CARD (P CROSS Q) = CARD P * CARD Q)
5215Proof
5216 SIMP_TAC bool_ss [GSYM AND_IMP_INTRO, RIGHT_FORALL_IMP_THM] THEN
5217 HO_MATCH_MP_TAC FINITE_INDUCT THEN
5218 SIMP_TAC bool_ss [CROSS_EMPTY, CARD_EMPTY, CARD_INSERT,
5219 MULT_CLAUSES] THEN
5220 ONCE_REWRITE_TAC [CROSS_INSERT_LEFT] THEN
5221 REPEAT STRIP_TAC THEN
5222 `FINITE (P CROSS Q)` by ASM_MESON_TAC [FINITE_CROSS] THEN
5223 `FINITE ({e} CROSS Q)` by ASM_MESON_TAC [FINITE_CROSS, FINITE_SING] THEN
5224 Q.SUBGOAL_THEN `({e} CROSS Q) INTER (P CROSS Q) = {}` ASSUME_TAC THENL [
5225 SIMP_TAC bool_ss [IN_INTER, EXTENSION, IN_CROSS, IN_SING,
5226 NOT_IN_EMPTY] THEN
5227 ASM_MESON_TAC [],
5228 ALL_TAC
5229 ] THEN
5230 CONV_TAC (LHS_CONV (REWR_CONV (GSYM ADD_0))) THEN
5231 POP_ASSUM (SUBST1_TAC o GSYM o REWRITE_RULE [CARD_EMPTY] o
5232 Q.AP_TERM `CARD`) THEN
5233 ASM_SIMP_TAC bool_ss [CARD_UNION, CARD_SING_CROSS, ADD_COMM]
5234QED
5235
5236Theorem CROSS_SUBSET:
5237 !P Q P0 Q0. (P0 CROSS Q0) SUBSET (P CROSS Q) <=>
5238 (P0 = {}) \/ (Q0 = {}) \/ P0 SUBSET P /\ Q0 SUBSET Q
5239Proof
5240 SIMP_TAC bool_ss [IN_CROSS, SUBSET_DEF, FORALL_PROD, FST, SND,
5241 NOT_IN_EMPTY, EXTENSION] THEN
5242 MESON_TAC []
5243QED
5244
5245
5246Theorem FINITE_CROSS_EQ_lemma0[local]:
5247 !x. FINITE x ==>
5248 !P Q. (x = P CROSS Q) ==>
5249 (P = {}) \/ (Q = {}) \/ FINITE P /\ FINITE Q
5250Proof
5251 HO_MATCH_MP_TAC FINITE_COMPLETE_INDUCTION THEN
5252 REPEAT STRIP_TAC THEN POP_ASSUM SUBST_ALL_TAC THEN
5253 `(P = {}) \/ ?p P0. (P = p INSERT P0) /\ ~(p IN P0)` by
5254 MESON_TAC [SET_CASES] THEN
5255 `(Q = {}) \/ ?q Q0. (Q = q INSERT Q0) /\ ~(q IN Q0)` by
5256 MESON_TAC [SET_CASES] THEN
5257 ASM_SIMP_TAC bool_ss [NOT_INSERT_EMPTY, FINITE_INSERT] THEN
5258 REPEAT (FIRST_X_ASSUM SUBST_ALL_TAC) THEN
5259 Q.PAT_X_ASSUM `FINITE X` MP_TAC THEN
5260 ONCE_REWRITE_TAC [CROSS_INSERT_LEFT] THEN
5261 ONCE_REWRITE_TAC [CROSS_INSERT_RIGHT] THEN
5262 SIMP_TAC bool_ss [FINITE_UNION, FINITE_SING, CROSS_SINGS] THEN
5263 REPEAT STRIP_TAC THENL [
5264 Q.SUBGOAL_THEN
5265 `(P0 CROSS {q}) PSUBSET ((p INSERT P0) CROSS (q INSERT Q0)) \/
5266 (P0 = {})`
5267 STRIP_ASSUME_TAC THENL [
5268 ASM_SIMP_TAC bool_ss [PSUBSET_DEF, CROSS_SUBSET, SUBSET_INSERT,
5269 SUBSET_REFL, EXTENSION, IN_CROSS, IN_INSERT,
5270 FORALL_PROD, FST, SND, NOT_IN_EMPTY,
5271 SUBSET_DEF, IN_SING] THEN
5272 ASM_MESON_TAC [],
5273 POP_ASSUM (ANTE_RES_THEN (MP_TAC o Q.SPECL [`P0`, `{q}`])) THEN
5274 MESON_TAC [FINITE_EMPTY, NOT_INSERT_EMPTY],
5275 ASM_SIMP_TAC bool_ss [FINITE_EMPTY]
5276 ],
5277 Q.SUBGOAL_THEN
5278 `({p} CROSS Q0) PSUBSET ((p INSERT P0) CROSS (q INSERT Q0)) \/
5279 (Q0 = {})`
5280 STRIP_ASSUME_TAC THENL [
5281 ASM_SIMP_TAC bool_ss [PSUBSET_DEF, CROSS_SUBSET, SUBSET_INSERT,
5282 SUBSET_REFL, EXTENSION, IN_CROSS, IN_INSERT,
5283 FORALL_PROD, FST, SND, NOT_IN_EMPTY,
5284 SUBSET_DEF, IN_SING] THEN
5285 ASM_MESON_TAC [],
5286 POP_ASSUM (ANTE_RES_THEN (MP_TAC o Q.SPECL [`{p}`, `Q0`])) THEN
5287 MESON_TAC [FINITE_EMPTY, NOT_INSERT_EMPTY],
5288 ASM_SIMP_TAC bool_ss [FINITE_EMPTY]
5289 ]
5290 ]
5291QED
5292
5293val FINITE_CROSS_EQ_lemma =
5294 SIMP_RULE bool_ss [GSYM RIGHT_FORALL_IMP_THM] FINITE_CROSS_EQ_lemma0
5295
5296Theorem FINITE_CROSS_EQ[simp]:
5297 !P Q. FINITE (P CROSS Q)
5298 <=>
5299 (P = {}) \/ (Q = {}) \/ FINITE P /\ FINITE Q
5300Proof
5301 REPEAT GEN_TAC THEN EQ_TAC THEN
5302 MESON_TAC [FINITE_CROSS_EQ_lemma, FINITE_CROSS, FINITE_EMPTY,
5303 CROSS_EMPTY]
5304QED
5305
5306Theorem CROSS_UNIV:
5307 univ(:'a # 'b) = univ(:'a) CROSS univ(:'b)
5308Proof
5309 SRW_TAC [][EXTENSION]
5310QED
5311
5312Theorem INFINITE_PAIR_UNIV[simp]:
5313 FINITE univ(:'a # 'b) <=> FINITE univ(:'a) /\ FINITE univ(:'b)
5314Proof
5315 FULL_SIMP_TAC (srw_ss()) [CROSS_UNIV]
5316QED
5317
5318Theorem INTER_CROSS :
5319 !A B C D. (A CROSS B) INTER (C CROSS D) = (A INTER C) CROSS (B INTER D)
5320Proof
5321 RW_TAC std_ss [Once EXTENSION, IN_INTER, IN_CROSS]
5322 >> PROVE_TAC []
5323QED
5324
5325Theorem BIGUNION_CROSS :
5326 !f s t. (BIGUNION (IMAGE f s)) CROSS t = BIGUNION (IMAGE (\n. f n CROSS t) s)
5327Proof
5328 RW_TAC std_ss [EXTENSION, IN_BIGUNION_IMAGE, IN_CROSS]
5329 >> EQ_TAC >> RW_TAC std_ss []
5330 >- (Q.EXISTS_TAC ‘n’ >> ASM_REWRITE_TAC [])
5331 >> ASM_REWRITE_TAC []
5332QED
5333
5334Theorem CROSS_BIGUNION :
5335 !f s t. s CROSS (BIGUNION (IMAGE f t)) = BIGUNION (IMAGE (\n. s CROSS f n) t)
5336Proof
5337 RW_TAC std_ss [EXTENSION, IN_BIGUNION_IMAGE, IN_CROSS]
5338 >> EQ_TAC >> RW_TAC std_ss []
5339 >- ASM_REWRITE_TAC []
5340 >> Q.EXISTS_TAC ‘n’ >> ASM_REWRITE_TAC []
5341QED
5342
5343Theorem SUBSET_CROSS :
5344 !a b c d. a SUBSET b /\ c SUBSET d ==> (a CROSS c) SUBSET (b CROSS d)
5345Proof
5346 RW_TAC std_ss [SUBSET_DEF, IN_CROSS]
5347QED
5348
5349Theorem IMAGE_FST_CROSS :
5350 !s t. t <> {} ==> IMAGE FST (s CROSS t) = s
5351Proof
5352 rw [EXTENSION]
5353 >> EQ_TAC >> rw [] >> rw []
5354 >> Q.RENAME_TAC [‘y IN s’]
5355 >> Q.EXISTS_TAC ‘(y,x)’ >> rw []
5356QED
5357
5358Theorem IMAGE_SND_CROSS :
5359 !s t. s <> {} ==> IMAGE SND (s CROSS t) = t
5360Proof
5361 rw [EXTENSION]
5362 >> EQ_TAC >> rw [] >> rw []
5363 >> Q.RENAME_TAC [‘y IN t’]
5364 >> Q.EXISTS_TAC ‘(x,y)’ >> rw []
5365QED
5366
5367(* sums *)
5368
5369Theorem SUM_UNIV:
5370 univ(:'a + 'b) = IMAGE INL univ(:'a) UNION IMAGE INR univ(:'b)
5371Proof
5372 SRW_TAC[][EQ_IMP_THM, EXTENSION] THEN METIS_TAC [sumTheory.sum_CASES]
5373QED
5374
5375Theorem INJ_INL:
5376 (!x. x IN s ==> INL x IN t) ==> INJ INL s t
5377Proof
5378 SIMP_TAC (srw_ss()) [INJ_DEF]
5379QED
5380Theorem INJ_INR:
5381 (!x. x IN s ==> INR x IN t) ==> INJ INR s t
5382Proof
5383 SIMP_TAC (srw_ss()) [INJ_DEF]
5384QED
5385
5386Definition disjUNION_def[nocompute]:
5387 disjUNION A B = {INL a | a IN A} UNION {INR b | b IN B}
5388End
5389
5390val _ = set_mapped_fixity {fixity = Infixl 500,
5391 term_name = "disjUNION",
5392 tok = "<+>"}
5393val _ = set_mapped_fixity {fixity = Infixl 500,
5394 term_name = "disjUNION",
5395 tok = UTF8.chr 0x2294}
5396
5397Theorem disjUNION_UNIV:
5398 univ(:'a + 'b) = UNIV <+> UNIV
5399Proof
5400 simp[EXTENSION, disjUNION_def] >> METIS_TAC[sumTheory.sum_CASES]
5401QED
5402
5403Theorem IN_disjUNION[simp]:
5404 (INL a IN A <+> B <=> a IN A) /\ (INR b IN A <+> B <=> b IN B)
5405Proof
5406 simp[disjUNION_def]
5407QED
5408
5409Theorem CARD_disjUNION[simp]:
5410 FINITE (s:'a set) /\ FINITE (t:'b set) ==>
5411 CARD (s <+> t) = CARD s + CARD t
5412Proof
5413 simp[disjUNION_def] >> strip_tac >>
5414 Q.MATCH_ABBREV_TAC ‘CARD (X UNION Y) = _’ >>
5415 ‘X = IMAGE INL s /\ Y = IMAGE INR t’ by simp[Abbr‘X’, Abbr‘Y’, EXTENSION] >>
5416 simp[CARD_UNION_EQN, CARD_INJ_IMAGE] >>
5417 ‘X INTER Y = {}’ suffices_by simp[Abbr‘X’, Abbr‘Y’] >>
5418 simp[EXTENSION, sumTheory.FORALL_SUM]
5419QED
5420
5421Theorem disjUNION_EQ_EMPTY[simp]:
5422 x <+> y = {} <=> x = {} /\ y = {}
5423Proof
5424 simp[disjUNION_def, EXTENSION, EQ_IMP_THM]
5425QED
5426
5427
5428
5429
5430(* ====================================================================== *)
5431(* Set complements. *)
5432(* ====================================================================== *)
5433
5434Definition COMPL_DEF[nocompute]: COMPL P = UNIV DIFF P
5435End
5436
5437Theorem IN_COMPL[simp]:
5438 !(x:'a) s. x IN COMPL s <=> x NOTIN s
5439Proof SIMP_TAC bool_ss [COMPL_DEF, IN_DIFF, IN_UNIV]
5440QED
5441
5442Theorem COMPL_COMPL:
5443 !(s:'a->bool). COMPL (COMPL s) = s
5444Proof
5445 SIMP_TAC bool_ss [EXTENSION, IN_COMPL]
5446QED
5447
5448Theorem COMPL_CLAUSES:
5449 !(s:'a->bool). (COMPL s INTER s = {})
5450 /\ (COMPL s UNION s = UNIV)
5451Proof
5452 SIMP_TAC bool_ss [EXTENSION, IN_COMPL, IN_INTER, IN_UNION, NOT_IN_EMPTY,
5453 IN_UNIV]
5454QED
5455
5456Theorem COMPL_SPLITS:
5457 !(p:'a->bool) q. p INTER q UNION COMPL p INTER q = q
5458Proof
5459 SIMP_TAC bool_ss [EXTENSION, IN_COMPL, IN_INTER, IN_UNION, NOT_IN_EMPTY,
5460 IN_UNIV]
5461 THEN MESON_TAC []
5462QED
5463
5464Theorem INTER_UNION_COMPL:
5465 !(s:'a->bool) t. s INTER t
5466 = COMPL (COMPL s UNION COMPL t)
5467Proof
5468 SIMP_TAC bool_ss [EXTENSION, IN_COMPL, IN_INTER, IN_UNION, NOT_IN_EMPTY,
5469 IN_UNIV]
5470QED
5471
5472Theorem COMPL_EMPTY:
5473 COMPL {} = UNIV
5474Proof
5475 SIMP_TAC bool_ss [EXTENSION, IN_COMPL, NOT_IN_EMPTY, IN_UNIV]
5476QED
5477
5478Theorem COMPL_INTER[simp]:
5479 (x INTER COMPL x = {}) /\ (COMPL x INTER x = {})
5480Proof
5481 SRW_TAC [][EXTENSION]
5482QED
5483
5484Theorem COMPL_UNION:
5485 COMPL (s UNION t) = COMPL s INTER COMPL t
5486Proof
5487SRW_TAC [][EXTENSION,COMPL_DEF]
5488QED
5489
5490Theorem DIFF_INTER_COMPL: !s t. s DIFF t = s INTER (COMPL t)
5491Proof
5492 RW_TAC std_ss [EXTENSION, IN_DIFF, IN_INTER, IN_COMPL]
5493QED
5494
5495(*---------------------------------------------------------------------------
5496 A "fold"-like operation for sets.
5497 ---------------------------------------------------------------------------*)
5498
5499Definition ITSET_def[induction=ITSET_IND,schematic]:
5500 ITSET (s:'a->bool) (b:'b) =
5501 if FINITE s then
5502 if s={} then b
5503 else ITSET (REST s) (f (CHOICE s) b)
5504 else ARB
5505Termination
5506 TotalDefn.WF_REL_TAC ‘measure (CARD o FST)’ THEN
5507 METIS_TAC [CARD_PSUBSET, REST_PSUBSET]
5508End
5509
5510(*---------------------------------------------------------------------------
5511 Desired recursion equation.
5512
5513 |- FINITE s ==> ITSET f s b = if s = {} then b
5514 else ITSET f (REST s) (f (CHOICE s) b)
5515 ---------------------------------------------------------------------------*)
5516
5517Theorem ITSET_THM =
5518W (GENL o rev o free_vars o concl)
5519 (DISCH_ALL(ASM_REWRITE_RULE [ASSUME ``FINITE s``] (SPEC_ALL ITSET_def)));
5520
5521Theorem ITSET_EMPTY[simp] =
5522 REWRITE_RULE []
5523 (MATCH_MP (SPEC ``{}`` ITSET_THM) FINITE_EMPTY);
5524
5525(* Could also prove by
5526
5527 PROVE_TAC [FINITE_INSERT,ITSET_THM,NOT_INSERT_EMPTY]);
5528*)
5529Theorem ITSET_INSERT:
5530 !s. FINITE s ==>
5531 !f x b. ITSET f (x INSERT s) b =
5532 ITSET f (REST (x INSERT s)) (f (CHOICE (x INSERT s)) b)
5533Proof
5534 REPEAT STRIP_TAC THEN
5535 POP_ASSUM (fn th =>
5536 `FINITE (x INSERT s)` by PROVE_TAC [th, FINITE_INSERT]) THEN
5537 IMP_RES_TAC ITSET_THM THEN
5538 POP_ASSUM (fn th => CONV_TAC (LAND_CONV (ONCE_REWRITE_CONV [th]))) THEN
5539 SIMP_TAC bool_ss [NOT_INSERT_EMPTY]
5540QED
5541
5542val absorption = #1 (EQ_IMP_RULE (SPEC_ALL ABSORPTION))
5543val delete_non_element = #1 (EQ_IMP_RULE (SPEC_ALL DELETE_NON_ELEMENT))
5544
5545Theorem COMMUTING_ITSET_INSERT:
5546 !f s. (!x y z. f x (f y z) = f y (f x z)) /\
5547 FINITE s ==>
5548 !x b. ITSET f (x INSERT s) b = ITSET f (s DELETE x) (f x b)
5549Proof
5550 REPEAT GEN_TAC THEN STRIP_TAC THEN
5551 completeInduct_on `CARD s` THEN
5552 POP_ASSUM (ASSUME_TAC o SIMP_RULE bool_ss
5553 [GSYM RIGHT_FORALL_IMP_THM, AND_IMP_INTRO]) THEN
5554 GEN_TAC THEN SIMP_TAC bool_ss [ITSET_INSERT] THEN
5555 REPEAT STRIP_TAC THEN
5556 Q.ABBREV_TAC `t = REST (x INSERT s)` THEN
5557 Q.ABBREV_TAC `y = CHOICE (x INSERT s)` THEN
5558 `~(y IN t)` by PROVE_TAC [CHOICE_NOT_IN_REST] THEN
5559 Cases_on `x IN s` THENL [
5560 FULL_SIMP_TAC bool_ss [absorption] THEN
5561 Cases_on `x = y` THENL [
5562 POP_ASSUM SUBST_ALL_TAC THEN
5563 Q_TAC SUFF_TAC `t = s DELETE y` THEN1 SRW_TAC [][] THEN
5564 `s = y INSERT t` by PROVE_TAC [NOT_IN_EMPTY, CHOICE_INSERT_REST] THEN
5565 SRW_TAC [][DELETE_INSERT, delete_non_element],
5566 `s = y INSERT t` by PROVE_TAC [NOT_IN_EMPTY, CHOICE_INSERT_REST] THEN
5567 `x IN t` by PROVE_TAC [IN_INSERT] THEN
5568 Q.ABBREV_TAC `u = t DELETE x` THEN
5569 `t = x INSERT u` by SRW_TAC [][INSERT_DELETE, Abbr`u`] THEN
5570 `~(x IN u)` by PROVE_TAC [IN_DELETE] THEN
5571 `s = x INSERT (y INSERT u)` by simp[INSERT_COMM] THEN
5572 POP_ASSUM SUBST_ALL_TAC THEN
5573 FULL_SIMP_TAC bool_ss [FINITE_INSERT, CARD_INSERT, DELETE_INSERT,
5574 IN_INSERT] THEN
5575 ASM_SIMP_TAC arith_ss [delete_non_element]
5576 ],
5577 ALL_TAC
5578 ] THEN (* ~(x IN s) *)
5579 ASM_SIMP_TAC bool_ss [delete_non_element] THEN
5580 `x INSERT s = y INSERT t`
5581 by PROVE_TAC [NOT_EMPTY_INSERT, CHOICE_INSERT_REST] THEN
5582 Cases_on `x = y` THENL [
5583 POP_ASSUM SUBST_ALL_TAC THEN
5584 Q_TAC SUFF_TAC `t = s` THEN1 SRW_TAC [][] THEN
5585 FULL_SIMP_TAC bool_ss [EXTENSION, IN_INSERT] THEN PROVE_TAC [],
5586 ALL_TAC
5587 ] THEN (* ~(x = y) *)
5588 `x IN t /\ y IN s` by PROVE_TAC [IN_INSERT] THEN
5589 Q.ABBREV_TAC `u = s DELETE y` THEN
5590 `~(y IN u)` by PROVE_TAC [IN_DELETE] THEN
5591 `s = y INSERT u` by SRW_TAC [][INSERT_DELETE, Abbr`u`] THEN
5592 POP_ASSUM SUBST_ALL_TAC THEN
5593 FULL_SIMP_TAC bool_ss [IN_INSERT, FINITE_INSERT, CARD_INSERT,
5594 DELETE_INSERT, delete_non_element] THEN
5595 `t = x INSERT u` by
5596 (FULL_SIMP_TAC bool_ss [EXTENSION, IN_INSERT] THEN PROVE_TAC []) THEN
5597 ASM_SIMP_TAC arith_ss [delete_non_element]
5598QED
5599
5600Theorem COMMUTING_ITSET_RECURSES:
5601 !f e s b. (!x y z. f x (f y z) = f y (f x z)) /\ FINITE s ==>
5602 (ITSET f (e INSERT s) b = f e (ITSET f (s DELETE e) b))
5603Proof
5604 Q_TAC SUFF_TAC
5605 `!f. (!x y z. f x (f y z) = f y (f x z)) ==>
5606 !s. FINITE s ==>
5607 !e b. ITSET f (e INSERT s) b = f e (ITSET f (s DELETE e) b)` THEN1
5608 PROVE_TAC [] THEN
5609 GEN_TAC THEN STRIP_TAC THEN
5610 ASM_SIMP_TAC (srw_ss()) [COMMUTING_ITSET_INSERT] THEN
5611 Q_TAC SUFF_TAC
5612 `!s. FINITE s ==> !e b. ITSET f s (f e b) = f e (ITSET f s b)` THEN1
5613 PROVE_TAC [FINITE_DELETE] THEN
5614 HO_MATCH_MP_TAC FINITE_INDUCT THEN CONJ_TAC THENL [
5615 SIMP_TAC bool_ss [ITSET_THM, FINITE_EMPTY],
5616 ASM_SIMP_TAC bool_ss [COMMUTING_ITSET_INSERT, delete_non_element]
5617 ]
5618QED
5619
5620(* Corollary *)
5621Theorem ITSET_SING[simp]:
5622 !f x a. ITSET f {x} a = f x a
5623Proof
5624 rw[] >> fs[ITSET_THM]
5625QED
5626
5627(* Theorem: FINITE s /\ s <> {} ==> (ITSET f s b = ITSET f (REST s) (f (CHOICE s) b)) *)
5628(* Proof: by ITSET_THM. *)
5629Theorem ITSET_PROPERTY:
5630 !s f b. FINITE s /\ s <> {} ==> (ITSET f s b = ITSET f (REST s) (f (CHOICE s) b))
5631Proof
5632 rw[ITSET_THM]
5633QED
5634
5635(* Theorem: (f = g) ==> (ITSET f = ITSET g) *)
5636(* Proof: by congruence rule *)
5637Theorem ITSET_CONG:
5638 !f g. (f = g) ==> (ITSET f = ITSET g)
5639Proof
5640 rw[]
5641QED
5642
5643(* Reduction of ITSET *)
5644
5645(* Theorem: (!x y z. f x (f y z) = f y (f x z)) ==>
5646 !s x b. FINITE s /\ x NOTIN s ==> (ITSET f (x INSERT s) b = f x (ITSET f s b)) *)
5647(* Proof:
5648 Since x NOTIN s ==> s DELETE x = s by DELETE_NON_ELEMENT
5649 The result is true by COMMUTING_ITSET_RECURSES
5650*)
5651Theorem ITSET_REDUCTION:
5652 !f. (!x y z. f x (f y z) = f y (f x z)) ==>
5653 !s x b. FINITE s /\ x NOTIN s ==> (ITSET f (x INSERT s) b = f x (ITSET f s b))
5654Proof
5655 rw[COMMUTING_ITSET_RECURSES, DELETE_NON_ELEMENT]
5656QED
5657
5658(* ------------------------------------------------------------------------- *)
5659(* Rework of ITSET Theorems *)
5660(* ------------------------------------------------------------------------- *)
5661
5662(* Define a function that gives closure and is commute_associative *)
5663Definition closure_comm_assoc_fun_def:
5664 closure_comm_assoc_fun f s <=>
5665 (!x y. x IN s /\ y IN s ==> f x y IN s) /\ (* closure *)
5666 (!x y z. x IN s /\ y IN s /\ z IN s ==> (f x (f y z) = f y (f x z))) (* comm_assoc *)
5667End
5668
5669(* Theorem: FINITE s /\ s SUBSET t /\ closure_comm_assoc_fun f t ==>
5670 !(x b):: t. ITSET f (x INSERT s) b = ITSET f (s DELETE x) (f x b) *)
5671(* Proof:
5672 By complete induction on CARD s.
5673 The goal is to show:
5674 ITSET f (x INSERT s) b = ITSET f (s DELETE x) (f x b) [1]
5675 Applying ITSET_INSERT to LHS, this is to prove:
5676 ITSET f z (f y b) = ITSET f (s DELETE x) (f x b)
5677 | |
5678 | y = CHOICE (x INSERT s)
5679 +--- z = REST (x INSERT s)
5680 Note y NOTIN z by CHOICE_NOT_IN_REST
5681 If x IN s,
5682 then x INSERT s = s by ABSORPTION
5683 thus y = CHOICE s, z = REST s by x INSERT s = s
5684
5685 If x = y,
5686 Since s = CHOICE s INSERT REST s by CHOICE_INSERT_REST
5687 = y INSERT z by above y, z
5688 Hence z = s DELETE y by DELETE_INSERT
5689 Since CARD z < CARD s, apply induction:
5690 ITSET f (y INSERT z) b = ITSET f (z DELETE y) (f y b) [2a]
5691 For the original goal [1],
5692 LHS = ITSET f (x INSERT s) b
5693 = ITSET f s b by x INSERT s = s
5694 = ITSET f (y INSERT z) b by s = y INSERT z
5695 = ITSET f (z DELETE y) (f y b) by induction hypothesis [2a]
5696 = ITSET f z (f y b) by DELETE_NON_ELEMENT, y NOTIN z
5697 = ITSET f (s DELETE y) (f y b) by z = s DELETE y
5698 = ITSET f (s DELETE x) (f x b) by x = y
5699 = RHS
5700
5701 If x <> y, let u = z DELETE x.
5702 Note REST s = z = x INSERT u by INSERT_DELETE
5703 Now s = x INSERT (y INSERT u)
5704 = x INSERT v, where v = y INSERT u, and x NOTIN z.
5705 Therefore (s DELETE x) = v by DELETE_INSERT
5706 Since CARD v < CARD s, apply induction:
5707 ITSET f (x INSERT v) b = ITSET f (v DELETE x) (f x b) [2b]
5708 For the original goal [1],
5709 LHS = ITSET f (x INSERT s) b
5710 = ITSET f s b by x INSERT s = s
5711 = ITSET f (x INSERT v) b by s = x INSERT v
5712 = ITSET f (v DELETE x) (f x b) by induction hypothesis [2b]
5713 = ITSET f v (f x b) by x NOTIN v
5714 = ITSET f (s DELETE x) (f x b) by v = s DELETE x
5715 = RHS
5716
5717 If x NOTIN s,
5718 then s DELETE x = x by DELETE_NON_ELEMENT
5719 To prove: ITSET f (x INSERT s) b = ITSET f s (f x b) by [1]
5720 The CHOICE/REST of (x INSERT s) cannot be simplified, but can be replaced by:
5721 Note (x INSERT s) <> {} by NOT_EMPTY_INSERT
5722 y INSERT z
5723 = CHOICE (x INSERT s) INSERT (REST (x INSERT s)) by y = CHOICE (x INSERT s), z = REST (x INSERT s)
5724 = x INSERT s by CHOICE_INSERT_REST
5725
5726 If y = x,
5727 Then z = s by DELETE_INSERT, y INSERT z = x INSERT s, y = x.
5728 because s = s DELETE x by DELETE_NON_ELEMENT, x NOTIN s.
5729 = (x INSERT s) DELETE x by DELETE_INSERT
5730 = (y INSERT z) DELETE x by above
5731 = (y INSERT z) DELETE y by y = x
5732 = z DELETE y by DELETE_INSERT
5733 = z by DELETE_NON_ELEMENT, y NOTIN z.
5734 For the modified goal [1],
5735 LHS = ITSET f (x INSERT s) b
5736 = ITSET f (REST (x INSERT s)) (f (CHOICE (x INSERT s)) b) by ITSET_PROPERTY
5737 = ITSET f z (f y b) by y = CHOICE (x INSERT s), z = REST (x INSERT s)
5738 = ITSET f s (f x b) by z = s, y = x
5739 = RHS
5740
5741 If y <> x,
5742 Then x IN z and y IN s by IN_INSERT, x INSERT s = y INSERT z and x <> y.
5743 and s = y INSERT (s DELETE y) by INSERT_DELETE, y IN s
5744 = y INSERT u where u = s DELETE y
5745 Then y NOTIN u by IN_DELETE
5746 and z = x INSERT u,
5747 because x INSERT u
5748 = x INSERT (s DELETE y) by u = s DELETE y
5749 = (x INSERT s) DELETE y by DELETE_INSERT, x <> y
5750 = (y INSERT z) DELETE y by x INSERT s = y INSERT z
5751 = z by INSERT_DELETE
5752 and x NOTIN u by IN_DELETE, u = s DELETE y, but x NOTIN s.
5753 Thus CARD u < CARD s by CARD_INSERT, s = y INSERT u.
5754 Apply induction:
5755 !x b. ITSET f (x INSERT u) b = ITSET f (u DELETE x) (f x b) [2c]
5756
5757 For the modified goal [1],
5758 LHS = ITSET f (x INSERT s) b
5759 = ITSET f (REST (x INSERT s)) (f (CHOICE (x INSERT s)) b) by ITSET_PROPERTY
5760 = ITSET f z (f y b) by z = REST (x INSERT s), y = CHOICE (x INSERT s)
5761 = ITSET f (x INSERT u) (f y b) by z = x INSERT u
5762 = ITSET f (u DELETE x) (f x (f y b)) by induction hypothesis, [2c]
5763 = ITSET f u (f x (f y b)) by x NOTIN u
5764 RHS = ITSET f s (f x b)
5765 = ITSET f (y INSERT u) (f x b) by s = y INSERT u
5766 = ITSET f (u DELETE y) (f y (f x b)) by induction hypothesis, [2c]
5767 = ITSET f u (f y (f x b)) by y NOTIN u
5768 Applying the commute_associativity of f, LHS = RHS.
5769*)
5770Theorem SUBSET_COMMUTING_ITSET_INSERT:
5771 !f s t. FINITE s /\ s SUBSET t /\ closure_comm_assoc_fun f t ==>
5772 !(x b)::t. ITSET f (x INSERT s) b = ITSET f (s DELETE x) (f x b)
5773Proof
5774 completeInduct_on `CARD s` >>
5775 rule_assum_tac(SIMP_RULE bool_ss[GSYM RIGHT_FORALL_IMP_THM, AND_IMP_INTRO]) >>
5776 rw[RES_FORALL_THM] >>
5777 rw[ITSET_INSERT] >>
5778 qabbrev_tac `y = CHOICE (x INSERT s)` >>
5779 qabbrev_tac `z = REST (x INSERT s)` >>
5780 `y NOTIN z` by metis_tac[CHOICE_NOT_IN_REST] >>
5781 `!x s. x IN s ==> (x INSERT s = s)` by rw[ABSORPTION] >>
5782 `!x s. x NOTIN s ==> (s DELETE x = s)` by rw[DELETE_NON_ELEMENT] >>
5783 Cases_on `x IN s` >| [
5784 `s = y INSERT z` by metis_tac[NOT_IN_EMPTY, CHOICE_INSERT_REST] >>
5785 `FINITE z` by metis_tac[REST_SUBSET, SUBSET_FINITE] >>
5786 `CARD s = SUC (CARD z)` by rw[] >>
5787 `CARD z < CARD s` by decide_tac >>
5788 `z = s DELETE y` by metis_tac[DELETE_INSERT] >>
5789 `z SUBSET t` by metis_tac[DELETE_SUBSET, SUBSET_TRANS] >>
5790 Cases_on `x = y` >- metis_tac[] >>
5791 `x IN z` by metis_tac[IN_INSERT] >>
5792 qabbrev_tac `u = z DELETE x` >>
5793 `z = x INSERT u` by rw[INSERT_DELETE, Abbr`u`] >>
5794 `x NOTIN u` by metis_tac[IN_DELETE] >>
5795 qabbrev_tac `v = y INSERT u` >>
5796 `s = x INSERT v` by simp[INSERT_COMM, Abbr `v`] >>
5797 `x NOTIN v` by rw[Abbr `v`] >>
5798 `FINITE v` by metis_tac[FINITE_INSERT] >>
5799 `CARD s = SUC (CARD v)` by metis_tac[CARD_INSERT] >>
5800 `CARD v < CARD s` by decide_tac >>
5801 `v SUBSET t` by metis_tac[INSERT_SUBSET, SUBSET_TRANS] >>
5802 `s DELETE x = v` by rw[DELETE_INSERT, Abbr `v`] >>
5803 `v = s DELETE x` by rw[] >>
5804 `y IN t` by metis_tac[NOT_INSERT_EMPTY, CHOICE_DEF, SUBSET_DEF] >>
5805 metis_tac[],
5806 `x INSERT s <> {}` by rw[] >>
5807 `y INSERT z = x INSERT s` by rw[CHOICE_INSERT_REST, Abbr`y`, Abbr`z`] >>
5808 Cases_on `x = y` >- metis_tac[DELETE_INSERT, ITSET_PROPERTY] >>
5809 `x IN z /\ y IN s` by metis_tac[IN_INSERT] >>
5810 qabbrev_tac `u = s DELETE y` >>
5811 `s = y INSERT u` by rw[INSERT_DELETE, Abbr`u`] >>
5812 `y NOTIN u` by metis_tac[IN_DELETE] >>
5813 `z = x INSERT u` by metis_tac[DELETE_INSERT, INSERT_DELETE] >>
5814 `x NOTIN u` by metis_tac[IN_DELETE] >>
5815 `FINITE u` by metis_tac[FINITE_DELETE, SUBSET_FINITE] >>
5816 `CARD u < CARD s` by rw[] >>
5817 `u SUBSET t` by metis_tac[DELETE_SUBSET, SUBSET_TRANS] >>
5818 `y IN t` by metis_tac[CHOICE_DEF, SUBSET_DEF] >>
5819 `f y b IN t /\ f x b IN t` by prove_tac[closure_comm_assoc_fun_def] >>
5820 `ITSET f z (f y b) = ITSET f (x INSERT u) (f y b)` by rw[] >>
5821 `_ = ITSET f (u DELETE x) (f x (f y b))` by metis_tac[] >>
5822 `_ = ITSET f u (f x (f y b))` by rw[] >>
5823 `ITSET f s (f x b) = ITSET f (y INSERT u) (f x b)` by rw[] >>
5824 `_ = ITSET f (u DELETE y) (f y (f x b))` by metis_tac[] >>
5825 `_ = ITSET f u (f y (f x b))` by rw[] >>
5826 `f x (f y b) = f y (f x b)` by prove_tac[closure_comm_assoc_fun_def] >>
5827 metis_tac[]
5828 ]
5829QED
5830
5831(* This is a generalisation of COMMUTING_ITSET_INSERT, removing the requirement
5832 of commuting everywhere. *)
5833
5834(* Theorem: FINITE s /\ s SUBSET t /\ closure_comm_assoc_fun f t ==>
5835 !(x b)::t. ITSET f s (f x b) = f x (ITSET f s b) *)
5836(* Proof:
5837 By complete induction on CARD s.
5838 The goal is to show: ITSET f s (f x b) = f x (ITSET f s b)
5839 Base: s = {},
5840 LHS = ITSET f {} (f x b)
5841 = f x b by ITSET_EMPTY
5842 = f x (ITSET f {} b) by ITSET_EMPTY
5843 = RHS
5844 Step: s <> {},
5845 Let s = y INSERT z, where y = CHOICE s, z = REST s.
5846 Then y NOTIN z by CHOICE_NOT_IN_REST
5847 But y IN t by CHOICE_DEF, SUBSET_DEF
5848 and z SUBSET t by REST_SUBSET, SUBSET_TRANS
5849 Also FINITE z by REST_SUBSET, SUBSET_FINITE
5850 Thus CARD s = SUC (CARD z) by CARD_INSERT
5851 or CARD z < CARD s
5852 Note f x b IN t /\ f y b IN t by closure_comm_assoc_fun_def
5853
5854 LHS = ITSET f s (f x b)
5855 = ITSET f (y INSERT z) (f x b) by s = y INSERT z
5856 = ITSET f (z DELETE y) (f y (f x b)) by SUBSET_COMMUTING_ITSET_INSERT, y, f x b IN t
5857 = ITSET f z (f y (f x b)) by DELETE_NON_ELEMENT, y NOTIN z
5858 = ITSET f z (f x (f y b)) by closure_comm_assoc_fun_def, x, y, b IN t
5859 = f x (ITSET f z (f y b)) by inductive hypothesis, CARD z < CARD s, x, f y b IN t
5860 = f x (ITSET f (z DELETE y) (f y b)) by DELETE_NON_ELEMENT, y NOTIN z
5861 = f x (ITSET f (y INSERT z) b) by SUBSET_COMMUTING_ITSET_INSERT, y, f y b IN t
5862 = f x (ITSET f s b) by s = y INSERT z
5863 = RHS
5864*)
5865Theorem SUBSET_COMMUTING_ITSET_REDUCTION:
5866 !f s t. FINITE s /\ s SUBSET t /\ closure_comm_assoc_fun f t ==>
5867 !(x b)::t. ITSET f s (f x b) = f x (ITSET f s b)
5868Proof
5869 completeInduct_on `CARD s` >>
5870 rule_assum_tac(SIMP_RULE bool_ss [GSYM RIGHT_FORALL_IMP_THM, AND_IMP_INTRO]) >>
5871 rw[RES_FORALL_THM] >>
5872 Cases_on `s = {}` >-
5873 rw[ITSET_EMPTY] >>
5874 `?y z. (y = CHOICE s) /\ (z = REST s) /\ (s = y INSERT z)` by rw[CHOICE_INSERT_REST] >>
5875 `y NOTIN z` by metis_tac[CHOICE_NOT_IN_REST] >>
5876 `y IN t` by metis_tac[CHOICE_DEF, SUBSET_DEF] >>
5877 `z SUBSET t` by metis_tac[REST_SUBSET, SUBSET_TRANS] >>
5878 `FINITE z` by metis_tac[REST_SUBSET, SUBSET_FINITE] >>
5879 `CARD s = SUC (CARD z)` by rw[] >>
5880 `CARD z < CARD s` by decide_tac >>
5881 `f x b IN t /\ f y b IN t /\ (f y (f x b) = f x (f y b))`
5882 by prove_tac[closure_comm_assoc_fun_def] >>
5883 metis_tac[SUBSET_COMMUTING_ITSET_INSERT, DELETE_NON_ELEMENT]
5884QED
5885
5886(* This helps to prove the next generalisation. *)
5887
5888(* Theorem: FINITE s /\ s SUBSET t /\ closure_comm_assoc_fun f t ==>
5889 !(x b):: t. ITSET f (x INSERT s) b = f x (ITSET f (s DELETE x) b) *)
5890(* Proof:
5891 Note (s DELETE x) SUBSET t by DELETE_SUBSET, SUBSET_TRANS
5892 and FINITE (s DELETE x) by FINITE_DELETE, FINITE s
5893 ITSET f (x INSERT s) b
5894 = ITSET f (s DELETE x) (f x b) by SUBSET_COMMUTING_ITSET_INSERT
5895 = f x (ITSET f (s DELETE x) b) by SUBSET_COMMUTING_ITSET_REDUCTION, (s DELETE x) SUBSET t
5896*)
5897Theorem SUBSET_COMMUTING_ITSET_RECURSES:
5898 !f s t. FINITE s /\ s SUBSET t /\ closure_comm_assoc_fun f t ==>
5899 !(x b):: t. ITSET f (x INSERT s) b = f x (ITSET f (s DELETE x) b)
5900Proof
5901 rw[RES_FORALL_THM] >>
5902 `(s DELETE x) SUBSET t` by metis_tac[DELETE_SUBSET, SUBSET_TRANS] >>
5903 `FINITE (s DELETE x)` by rw[] >>
5904 metis_tac[SUBSET_COMMUTING_ITSET_INSERT, SUBSET_COMMUTING_ITSET_REDUCTION]
5905QED
5906
5907(* ----------------------------------------------------------------------
5908 SUM_IMAGE
5909
5910 This constant is the same as standard mathematics \Sigma operator:
5911
5912 \Sigma_{x\in P}{f(x)} = SUM_IMAGE f P
5913
5914 Where f's range is the natural numbers and P is finite.
5915 ---------------------------------------------------------------------- *)
5916
5917Definition SUM_IMAGE_DEF[nocompute]:
5918 SUM_IMAGE f s = ITSET (\e acc. f e + acc) s 0
5919End
5920
5921Overload SIGMA = ``SUM_IMAGE``
5922val _ = Unicode.unicode_version {u = UTF8.chr 0x2211, tmnm = "SIGMA"};
5923val _ = TeX_notation {hol = UTF8.chr 0x2211, TeX = ("\\HOLTokenSum{}", 1)};
5924val _ = TeX_notation {hol = "SIGMA", TeX = ("\\HOLTokenSum{}", 1)};
5925
5926Theorem SUM_IMAGE_THM:
5927 !f. (SUM_IMAGE f {} = 0) /\
5928 (!e s. FINITE s ==>
5929 (SUM_IMAGE f (e INSERT s) =
5930 f e + SUM_IMAGE f (s DELETE e)))
5931Proof
5932 REPEAT STRIP_TAC THENL [
5933 SIMP_TAC (srw_ss()) [ITSET_THM, SUM_IMAGE_DEF],
5934 SIMP_TAC (srw_ss()) [SUM_IMAGE_DEF] THEN
5935 Q.ABBREV_TAC `g = \e acc. f e + acc` THEN
5936 Q_TAC SUFF_TAC `ITSET g (e INSERT s) 0 =
5937 g e (ITSET g (s DELETE e) 0)` THEN1
5938 SRW_TAC [][Abbr`g`] THEN
5939 MATCH_MP_TAC COMMUTING_ITSET_RECURSES THEN
5940 SRW_TAC [ARITH_ss][Abbr`g`]
5941 ]
5942QED
5943
5944(* Theorem: SIGMA f {} = 0 *)
5945(* Proof: by SUM_IMAGE_THM *)
5946Theorem SUM_IMAGE_EMPTY:
5947 !f. SIGMA f {} = 0
5948Proof
5949 rw[SUM_IMAGE_THM]
5950QED
5951
5952(* Theorem: FINITE s ==> !e. e NOTIN s ==> (SIGMA f (e INSERT s) = f e + (SIGMA f s)) *)
5953(* Proof:
5954 SIGMA f (e INSERT s)
5955 = f e + SIGMA f (s DELETE e) by SUM_IMAGE_THM
5956 = f e + SIGMA f s by DELETE_NON_ELEMENT
5957*)
5958Theorem SUM_IMAGE_INSERT:
5959 !f s. FINITE s ==> !e. e NOTIN s ==> (SIGMA f (e INSERT s) = f e + (SIGMA f s))
5960Proof
5961 rw[SUM_IMAGE_THM, DELETE_NON_ELEMENT]
5962QED
5963
5964Theorem SUM_IMAGE_SING:
5965 !f e. SUM_IMAGE f {e} = f e
5966Proof
5967 SRW_TAC [][SUM_IMAGE_THM]
5968QED
5969
5970Theorem SUM_IMAGE_SUBSET_LE:
5971 !f s t. FINITE s /\ t SUBSET s ==> SUM_IMAGE f t <= SUM_IMAGE f s
5972Proof
5973 GEN_TAC THEN
5974 Q_TAC SUFF_TAC `!s. FINITE s ==>
5975 !t. t SUBSET s ==> SUM_IMAGE f t <= SUM_IMAGE f s` THEN1
5976 PROVE_TAC [] THEN
5977 HO_MATCH_MP_TAC FINITE_INDUCT THEN
5978 SIMP_TAC (srw_ss()) [SUM_IMAGE_THM, delete_non_element] THEN
5979 REPEAT STRIP_TAC THEN Cases_on `e IN t` THENL [
5980 Q.ABBREV_TAC `u = t DELETE e` THEN
5981 `t = e INSERT u` by SRW_TAC [][INSERT_DELETE, Abbr`u`] THEN
5982 `FINITE u` by PROVE_TAC [FINITE_DELETE, SUBSET_FINITE, FINITE_INSERT] THEN
5983 `~(e IN u)` by PROVE_TAC [IN_DELETE] THEN
5984 ASM_SIMP_TAC arith_ss [SUM_IMAGE_THM, delete_non_element] THEN
5985 FIRST_X_ASSUM MATCH_MP_TAC THEN
5986 FULL_SIMP_TAC bool_ss [SUBSET_INSERT_DELETE],
5987 FULL_SIMP_TAC bool_ss [SUBSET_INSERT] THEN
5988 RES_TAC THEN ASM_SIMP_TAC arith_ss []
5989 ]
5990QED
5991
5992Theorem SUM_IMAGE_IN_LE:
5993 !f s e. FINITE s /\ e IN s ==> f e <= SUM_IMAGE f s
5994Proof
5995 REPEAT STRIP_TAC THEN
5996 `{e} SUBSET s` by SRW_TAC [][SUBSET_DEF] THEN
5997 PROVE_TAC [SUM_IMAGE_SING, SUM_IMAGE_SUBSET_LE]
5998QED
5999
6000Theorem SUM_IMAGE_DELETE:
6001 !f s. FINITE s ==>
6002 !e. SUM_IMAGE f (s DELETE e) = if e IN s then SUM_IMAGE f s - f e
6003 else SUM_IMAGE f s
6004Proof
6005 GEN_TAC THEN HO_MATCH_MP_TAC FINITE_INDUCT THEN
6006 SRW_TAC [][SUM_IMAGE_THM, DELETE_INSERT] THEN
6007 COND_CASES_TAC THENL [
6008 POP_ASSUM SUBST_ALL_TAC THEN ASM_SIMP_TAC arith_ss [],
6009 ASM_SIMP_TAC bool_ss [SUM_IMAGE_THM, FINITE_DELETE, IN_DELETE,
6010 delete_non_element] THEN
6011 COND_CASES_TAC THEN REWRITE_TAC [] THEN
6012 `f e' <= SUM_IMAGE f s` by PROVE_TAC [SUM_IMAGE_IN_LE] THEN
6013 FULL_SIMP_TAC arith_ss []
6014 ]
6015QED
6016
6017Theorem SUM_IMAGE_UNION:
6018 !f s t. FINITE s /\ FINITE t ==>
6019 (SUM_IMAGE f (s UNION t) =
6020 SUM_IMAGE f s + SUM_IMAGE f t - SUM_IMAGE f (s INTER t))
6021Proof
6022 GEN_TAC THEN
6023 Q_TAC SUFF_TAC
6024 `!s. FINITE s ==>
6025 !t. FINITE t ==>
6026 (SUM_IMAGE f (s UNION t) =
6027 SUM_IMAGE f s + SUM_IMAGE f t - SUM_IMAGE f (s INTER t))` THEN1
6028 PROVE_TAC [] THEN
6029 HO_MATCH_MP_TAC FINITE_INDUCT THEN CONJ_TAC THEN1
6030 SRW_TAC [ARITH_ss][SUM_IMAGE_THM] THEN
6031 SIMP_TAC (srw_ss()) [INSERT_UNION_EQ, SUM_IMAGE_THM, INSERT_INTER] THEN
6032 REPEAT STRIP_TAC THEN
6033 Cases_on `e IN t` THEN
6034 ASM_SIMP_TAC arith_ss [INSERT_INTER, INTER_FINITE, FINITE_INSERT,
6035 SUM_IMAGE_THM, IN_UNION, delete_non_element]
6036 THENL [
6037 `s UNION t DELETE e = s UNION (t DELETE e)` by
6038 (SRW_TAC [][EXTENSION, IN_UNION, IN_DELETE] THEN PROVE_TAC []) THEN
6039 ASM_SIMP_TAC bool_ss [FINITE_DELETE, SUM_IMAGE_DELETE, INTER_FINITE,
6040 IN_INTER] THEN
6041 `s INTER (t DELETE e) = s INTER t DELETE e` by
6042 (SRW_TAC [][EXTENSION, IN_DELETE] THEN PROVE_TAC []) THEN
6043 ASM_SIMP_TAC bool_ss [SUM_IMAGE_DELETE, INTER_FINITE, IN_INTER] THEN
6044 `f e <= SUM_IMAGE f t` by PROVE_TAC [SUM_IMAGE_IN_LE] THEN
6045 `s INTER t SUBSET t` by PROVE_TAC [INTER_SUBSET] THEN
6046 `SUM_IMAGE f (s INTER t) <= SUM_IMAGE f t` by
6047 PROVE_TAC [SUM_IMAGE_SUBSET_LE] THEN
6048 Q_TAC SUFF_TAC `f e + SUM_IMAGE f (s INTER t) <= SUM_IMAGE f t` THEN1
6049 ASM_SIMP_TAC arith_ss [] THEN
6050 Q_TAC SUFF_TAC
6051 `f e + SUM_IMAGE f (s INTER t) =
6052 SUM_IMAGE f (e INSERT s INTER t)` THEN1
6053 ASM_SIMP_TAC bool_ss [SUM_IMAGE_SUBSET_LE,
6054 SUBSET_DEF, IN_INTER, IN_INSERT,
6055 DISJ_IMP_THM, FORALL_AND_THM] THEN
6056 ASM_SIMP_TAC bool_ss [INTER_FINITE, SUM_IMAGE_THM, IN_INTER,
6057 delete_non_element],
6058 `s INTER t SUBSET t` by PROVE_TAC [INTER_SUBSET] THEN
6059 `SUM_IMAGE f (s INTER t) <= SUM_IMAGE f t`
6060 by PROVE_TAC [SUM_IMAGE_SUBSET_LE] THEN
6061 ASM_SIMP_TAC arith_ss []
6062 ]
6063QED
6064
6065Theorem SUM_IMAGE_lower_bound:
6066 !s. FINITE s ==>
6067 !n. (!x. x IN s ==> n <= f x) ==>
6068 CARD s * n <= SUM_IMAGE f s
6069Proof
6070 HO_MATCH_MP_TAC FINITE_INDUCT THEN
6071 SRW_TAC [][DISJ_IMP_THM, FORALL_AND_THM, SUM_IMAGE_THM,
6072 MULT_CLAUSES, CARD_EMPTY, CARD_INSERT] THEN
6073 `s DELETE e = s` by (SRW_TAC [][EXTENSION, IN_DELETE] THEN PROVE_TAC []) THEN
6074 SRW_TAC [][] THEN
6075 PROVE_TAC [LESS_EQ_LESS_EQ_MONO, ADD_COMM]
6076QED
6077
6078Theorem SUM_IMAGE_upper_bound:
6079 !s. FINITE s ==>
6080 !n. (!x. x IN s ==> f x <= n) ==>
6081 SUM_IMAGE f s <= CARD s * n
6082Proof
6083 HO_MATCH_MP_TAC FINITE_INDUCT THEN
6084 SRW_TAC [][DISJ_IMP_THM, FORALL_AND_THM, SUM_IMAGE_THM,
6085 MULT_CLAUSES, CARD_EMPTY, CARD_INSERT] THEN
6086 `s DELETE e = s` by (SRW_TAC [][EXTENSION, IN_DELETE] THEN PROVE_TAC []) THEN
6087 SRW_TAC [][] THEN
6088 PROVE_TAC [LESS_EQ_LESS_EQ_MONO, ADD_COMM]
6089QED
6090
6091Theorem DISJ_BIGUNION_CARD[local]:
6092 !P. FINITE P
6093 ==> (!s. s IN P ==> FINITE s) /\
6094 (!s t. s IN P /\ t IN P /\ ~(s = t) ==> DISJOINT s t)
6095 ==> (CARD (BIGUNION P) = SUM_IMAGE CARD P)
6096Proof
6097 SET_INDUCT_TAC THEN
6098 RW_TAC bool_ss [CARD_EMPTY,BIGUNION_EMPTY,SUM_IMAGE_THM,
6099 BIGUNION_INSERT] THEN
6100 `FINITE (BIGUNION s) /\ FINITE e`
6101 by METIS_TAC [FINITE_BIGUNION, IN_INSERT] THEN
6102 `!s'. s' IN s ==> DISJOINT e s'` by METIS_TAC [IN_INSERT] THEN
6103 `CARD (e INTER (BIGUNION s)) = 0`
6104 by METIS_TAC [DISJOINT_DEF,DISJOINT_BIGUNION,CARD_EMPTY] THEN
6105 `CARD (e UNION BIGUNION s) = CARD (e UNION BIGUNION s) +
6106 CARD (e INTER (BIGUNION s))`
6107 by RW_TAC arith_ss [] THEN
6108 ONCE_ASM_REWRITE_TAC [] THEN
6109 FULL_SIMP_TAC arith_ss [CARD_UNION, DELETE_NON_ELEMENT] THEN
6110 METIS_TAC [IN_INSERT]
6111QED
6112
6113Theorem SUM_SAME_IMAGE:
6114 !P. FINITE P
6115 ==> !f p. p IN P /\ (!q. q IN P ==> (f p = f q))
6116 ==> (SUM_IMAGE f P = CARD P * f p)
6117Proof
6118 SET_INDUCT_TAC THEN
6119 RW_TAC arith_ss [CARD_EMPTY, SUM_IMAGE_THM, CARD_INSERT, ADD1] THEN
6120 SRW_TAC [][delete_non_element] THEN
6121 `(s = {}) \/ (?x t. s = x INSERT t)`
6122 by METIS_TAC [TypeBase.nchotomy_of ``:'a set``]
6123 THENL [
6124 SRW_TAC [][SUM_IMAGE_THM],
6125 `(f e = f x) /\ (f p = f x)`
6126 by (FULL_SIMP_TAC (srw_ss()) [] THEN METIS_TAC []) THEN
6127 Q_TAC SUFF_TAC `SIGMA f s = CARD s * f x`
6128 THEN1 SRW_TAC [ARITH_ss][] THEN
6129 FULL_SIMP_TAC (srw_ss() ++ DNF_ss) []
6130 ]
6131QED
6132
6133Theorem SUM_IMAGE_CONG[defncong]:
6134 s1 = s2 /\ (!x. x IN s2 ==> (f1 x = f2 x)) ==> SIGMA f1 s1 = SIGMA f2 s2
6135Proof
6136SRW_TAC [][] THEN
6137REVERSE (Cases_on `FINITE s1`) THEN1 (
6138 SRW_TAC [][SUM_IMAGE_DEF,Once ITSET_def] THEN
6139 SRW_TAC [][Once ITSET_def] ) THEN
6140Q.PAT_X_ASSUM `!x.P` MP_TAC THEN
6141POP_ASSUM MP_TAC THEN
6142Q.ID_SPEC_TAC `s1` THEN
6143HO_MATCH_MP_TAC FINITE_INDUCT THEN
6144SRW_TAC [][SUM_IMAGE_THM,SUM_IMAGE_DELETE]
6145QED
6146
6147(* Theorem: (!x. x IN s ==> (f1 x = f2 x)) ==> (SIGMA f1 s = SIGMA f2 s) *)
6148Theorem SIGMA_CONG:
6149 !s f1 f2. (!x. x IN s ==> (f1 x = f2 x)) ==> (SIGMA f1 s = SIGMA f2 s)
6150Proof
6151 rw[SUM_IMAGE_CONG]
6152QED
6153
6154Theorem SUM_IMAGE_ZERO:
6155 !s. FINITE s ==> ((SIGMA f s = 0) <=> (!x. x IN s ==> (f x = 0)))
6156Proof
6157 HO_MATCH_MP_TAC FINITE_INDUCT THEN
6158 CONJ_TAC THEN1 SIMP_TAC bool_ss [SUM_IMAGE_THM,NOT_IN_EMPTY] THEN
6159 SIMP_TAC bool_ss [SUM_IMAGE_THM,DELETE_NON_ELEMENT,ADD_EQ_0,IN_INSERT] THEN
6160 METIS_TAC []
6161QED
6162
6163(* Theorem: FINITE s ==> (CARD s = SIGMA (\x. 1) s) *)
6164(* Proof:
6165 By finite induction:
6166 Base case: CARD {} = SIGMA (\x. 1) {}
6167 LHS = CARD {}
6168 = 0 by CARD_EMPTY
6169 RHS = SIGMA (\x. 1) {}
6170 = 0 = LHS by SUM_IMAGE_THM
6171 Step case: (CARD s = SIGMA (\x. 1) s) ==>
6172 !e. e NOTIN s ==> (CARD (e INSERT s) = SIGMA (\x. 1) (e INSERT s))
6173 CARD (e INSERT s)
6174 = SUC (CARD s) by CARD_DEF
6175 = SUC (SIGMA (\x. 1) s) by induction hypothesis
6176 = 1 + SIGMA (\x. 1) s by ADD1, ADD_COMM
6177 = (\x. 1) e + SIGMA (\x. 1) s by function application
6178 = (\x. 1) e + SIGMA (\x. 1) (s DELETE e) by DELETE_NON_ELEMENT
6179 = SIGMA (\x. 1) (e INSERT s) by SUM_IMAGE_THM
6180*)
6181Theorem CARD_AS_SIGMA:
6182 !s. FINITE s ==> (CARD s = SIGMA (\x. 1) s)
6183Proof
6184 ho_match_mp_tac FINITE_INDUCT >>
6185 conj_tac >-
6186 rw[SUM_IMAGE_THM] >>
6187 rpt strip_tac >>
6188 `CARD (e INSERT s) = SUC (SIGMA (\x. 1) s)` by rw[] >>
6189 `_ = 1 + SIGMA (\x. 1) s` by rw_tac std_ss[ADD1, ADD_COMM] >>
6190 `_ = (\x. 1) e + SIGMA (\x. 1) s` by rw[] >>
6191 `_ = (\x. 1) e + SIGMA (\x. 1) (s DELETE e)` by metis_tac[DELETE_NON_ELEMENT] >>
6192 `_ = SIGMA (\x. 1) (e INSERT s)` by rw[SUM_IMAGE_THM] >>
6193 decide_tac
6194QED
6195
6196(* Theorem: FINITE s ==> (CARD s = SIGMA (K 1) s) *)
6197(* Proof: by CARD_AS_SIGMA, SIGMA_CONG *)
6198Theorem CARD_EQ_SIGMA:
6199 !s. FINITE s ==> (CARD s = SIGMA (K 1) s)
6200Proof
6201 rw[CARD_AS_SIGMA, SIGMA_CONG]
6202QED
6203
6204Theorem ABS_DIFF_SUM_IMAGE:
6205 !s. FINITE s ==>
6206 (ABS_DIFF (SIGMA f s) (SIGMA g s) <= SIGMA (\x. ABS_DIFF (f x) (g x)) s)
6207Proof
6208 HO_MATCH_MP_TAC FINITE_INDUCT THEN
6209 SRW_TAC [][] THEN1 (
6210 SRW_TAC [][SUM_IMAGE_THM,ABS_DIFF_EQS] ) THEN
6211 SRW_TAC [][SUM_IMAGE_THM] THEN
6212 FULL_SIMP_TAC (srw_ss()) [DELETE_NON_ELEMENT] THEN
6213 MATCH_MP_TAC LESS_EQ_TRANS THEN
6214 Q.EXISTS_TAC `ABS_DIFF (f e) (g e) + ABS_DIFF (SIGMA f s) (SIGMA g s)` THEN
6215 SRW_TAC [][ABS_DIFF_SUMS]
6216QED
6217
6218Theorem SUM_IMAGE_MONO_LESS_EQ:
6219 !s. FINITE s ==>
6220 (!x. x IN s ==> f x <= g x) ==> SUM_IMAGE f s <= SUM_IMAGE g s
6221Proof
6222 HO_MATCH_MP_TAC FINITE_INDUCT THEN
6223 SRW_TAC [][SUM_IMAGE_THM] THEN
6224 FULL_SIMP_TAC (srw_ss()) [DELETE_NON_ELEMENT] THEN
6225 MATCH_MP_TAC LESS_EQ_LESS_EQ_MONO THEN
6226 SRW_TAC [][]
6227QED
6228
6229Theorem SUM_IMAGE_MONO_LESS:
6230 !s. FINITE s ==> (?x. x IN s /\ f x < g x) /\ (!x. x IN s ==> f x <= g x) ==>
6231 SUM_IMAGE f s < SUM_IMAGE g s
6232Proof
6233 HO_MATCH_MP_TAC FINITE_INDUCT THEN
6234 SRW_TAC [][SUM_IMAGE_THM] THEN
6235 FULL_SIMP_TAC (srw_ss()) [DELETE_NON_ELEMENT] THEN1 (
6236 MATCH_MP_TAC LESS_LESS_EQ_TRANS THEN
6237 Q.EXISTS_TAC `g e + SIGMA f s` THEN
6238 SRW_TAC [][] THEN
6239 MATCH_MP_TAC (MP_CANON SUM_IMAGE_MONO_LESS_EQ) THEN
6240 SRW_TAC [][] ) THEN
6241 `SIGMA f s < SIGMA g s` by METIS_TAC [] THEN
6242 MATCH_MP_TAC LESS_LESS_EQ_TRANS THEN
6243 Q.EXISTS_TAC `f e + SIGMA g s` THEN
6244 SRW_TAC [][]
6245QED
6246
6247Theorem SUM_IMAGE_INJ_o:
6248 !s. FINITE s ==> !g. INJ g s univ(:'a) ==>
6249 !f. SIGMA f (IMAGE g s) = SIGMA (f o g) s
6250Proof
6251 HO_MATCH_MP_TAC FINITE_INDUCT THEN
6252 REPEAT STRIP_TAC THEN1
6253 SRW_TAC[][SUM_IMAGE_THM] THEN
6254 `INJ g s univ(:'a) /\ g e IN univ(:'a) /\
6255 !y. y IN s /\ (g e = g y) ==> (e = y)`
6256 by METIS_TAC[INJ_INSERT] THEN
6257 `g e NOTIN (IMAGE g s)` by METIS_TAC[IN_IMAGE] THEN
6258 `(s DELETE e = s) /\ (IMAGE g s DELETE g e = IMAGE g s)`
6259 by METIS_TAC[DELETE_NON_ELEMENT] THEN
6260 SRW_TAC[][SUM_IMAGE_THM, IMAGE_FINITE]
6261QED
6262
6263Overload PERMUTES = ``\f s. BIJ f s s``
6264val _ = set_fixity "PERMUTES" (Infix(NONASSOC, 450)); (* same as relation *)
6265
6266Theorem SUM_IMAGE_PERMUTES:
6267 !s. FINITE s ==> !g. g PERMUTES s ==> !f. SIGMA (f o g) s = SIGMA f s
6268Proof
6269 REPEAT STRIP_TAC THEN
6270 `INJ g s s /\ SURJ g s s` by METIS_TAC[BIJ_DEF] THEN
6271 `IMAGE g s = s` by SRW_TAC[][GSYM IMAGE_SURJ] THEN
6272 `s SUBSET univ(:'a)` by SRW_TAC[][SUBSET_UNIV] THEN
6273 `INJ g s univ(:'a)` by METIS_TAC[INJ_SUBSET, SUBSET_REFL] THEN
6274 `SIGMA (f o g) s = SIGMA f (IMAGE g s)` by SRW_TAC[][SUM_IMAGE_INJ_o] THEN
6275 SRW_TAC[][]
6276QED
6277
6278Theorem SUM_IMAGE_ADD:
6279 !s. FINITE s ==> SIGMA (\x. f x + g x) s = SIGMA f s + SIGMA g s
6280Proof
6281 ho_match_mp_tac FINITE_INDUCT
6282 \\ rw[SUM_IMAGE_THM]
6283 \\ fs[DELETE_NON_ELEMENT]
6284QED
6285
6286(* Theorem: FINITE s ==> !f k. (!x. x IN s ==> (f x = k)) ==> (SIGMA f s = k * CARD s) *)
6287(* Proof:
6288 By finite induction on s.
6289 Base: SIGMA f {} = k * CARD {}
6290 SIGMA f {}
6291 = 0 by SUM_IMAGE_EMPTY
6292 = k * 0 by MULT_0
6293 = k * CARD {} by CARD_EMPTY
6294 Step: SIGMA f s = k * CARD s /\ e NOTIN s /\ !x. x IN e INSERT s /\ f x = k ==>
6295 SIGMA f (e INSERT s) = k * CARD (e INSERT s)
6296 Note f e = k /\ !x. x IN s ==> f x = k by IN_INSERT
6297 SIGMA f (e INSERT s)
6298 = f e + SIGMA f (s DELETE e) by SUM_IMAGE_THM
6299 = k + SIGMA f s by DELETE_NON_ELEMENT, f e = k
6300 = k + k * CARD s by induction hypothesis
6301 = k * (1 + CARD s) by LEFT_ADD_DISTRIB
6302 = k * SUC (CARD s) by SUC_ONE_ADD
6303 = k * CARD (e INSERT s) by CARD_INSERT
6304*)
6305Theorem SIGMA_CONSTANT:
6306 !s. FINITE s ==> !f k. (!x. x IN s ==> (f x = k)) ==> (SIGMA f s = k * CARD s)
6307Proof
6308 ho_match_mp_tac FINITE_INDUCT >>
6309 rpt strip_tac >-
6310 rw[SUM_IMAGE_EMPTY] >>
6311 `(f e = k) /\ !x. x IN s ==> (f x = k)` by rw[] >>
6312 `SIGMA f (e INSERT s) = f e + SIGMA f (s DELETE e)` by rw[SUM_IMAGE_THM] >>
6313 `_ = k + SIGMA f s` by metis_tac[DELETE_NON_ELEMENT] >>
6314 `_ = k + k * CARD s` by rw[] >>
6315 `_ = k * (1 + CARD s)` by rw[] >>
6316 `_ = k * SUC (CARD s)` by rw[ADD1] >>
6317 `_ = k * CARD (e INSERT s)` by rw[CARD_INSERT] >>
6318 rw[]
6319QED
6320
6321(* Theorem: FINITE s ==> !c. SIGMA (K c) s = c * CARD s *)
6322(* Proof: by SIGMA_CONSTANT. *)
6323Theorem SUM_IMAGE_CONSTANT:
6324 !s. FINITE s ==> !c. SIGMA (K c) s = c * CARD s
6325Proof
6326 rw[SIGMA_CONSTANT]
6327QED
6328
6329(* Idea: If !e. e IN s, CARD e = n, SIGMA CARD s = n * CARD s. *)
6330
6331(* Theorem: FINITE s /\ (!e. e IN s ==> CARD e = n) ==> SIGMA CARD s = n * CARD s *)
6332(* Proof: by SIGMA_CONSTANT, take f = CARD. *)
6333Theorem SIGMA_CARD_CONSTANT:
6334 !n s. FINITE s /\ (!e. e IN s ==> CARD e = n) ==> SIGMA CARD s = n * CARD s
6335Proof
6336 simp[SIGMA_CONSTANT]
6337QED
6338
6339(* Theorem alias, or rename SIGMA_CARD_CONSTANT *)
6340Theorem SIGMA_CARD_SAME_SIZE_SETS = SIGMA_CARD_CONSTANT;
6341(* val SIGMA_CARD_SAME_SIZE_SETS =
6342 |- !n s. FINITE s /\ (!e. e IN s ==> CARD e = n) ==> SIGMA CARD s = n * CARD s: thm *)
6343
6344(* Theorem: FINITE s ==> !f g. (!x. x IN s ==> f x <= g x) ==> (SIGMA f s <= SIGMA g s) *)
6345(* Proof:
6346 By finite induction:
6347 Base case: !f g. (!x. x IN {} ==> f x <= g x) ==> SIGMA f {} <= SIGMA g {}
6348 True since SIGMA f {} = 0 by SUM_IMAGE_THM
6349 Step case: !f g. (!x. x IN s ==> f x <= g x) ==> SIGMA f s <= SIGMA g s ==>
6350 e NOTIN s ==>
6351 !x. x IN e INSERT s ==> f x <= g x ==> !f g. SIGMA f (e INSERT s) <= SIGMA g (e INSERT s)
6352 SIGMA f (e INSERT s) <= SIGMA g (e INSERT s)
6353 means f e + SIGMA f (s DELETE e) <= g e + SIGMA g (s DELETE e) by SUM_IMAGE_THM
6354 or f e + SIGMA f s <= g e + SIGMA g s by DELETE_NON_ELEMENT
6355 Now, x IN e INSERT s ==> (x = e) or (x IN s) by IN_INSERT
6356 Therefore f e <= g e, and !x IN s, f x <= g x by x IN (e INSERT s) implication
6357 or f e <= g e, and SIGMA f s <= SIGMA g s by induction hypothesis
6358 Hence f e + SIGMA f s <= g e + SIGMA g s by arithmetic
6359*)
6360Theorem SIGMA_LE_SIGMA:
6361 !s. FINITE s ==> !f g. (!x. x IN s ==> f x <= g x) ==> (SIGMA f s <= SIGMA g s)
6362Proof
6363 ho_match_mp_tac FINITE_INDUCT >>
6364 conj_tac >-
6365 rw[SUM_IMAGE_THM] >>
6366 rw[SUM_IMAGE_THM, DELETE_NON_ELEMENT] >>
6367 `f e <= g e /\ SIGMA f s <= SIGMA g s` by rw[] >>
6368 decide_tac
6369QED
6370
6371(* Theorem: FINITE s /\ FINITE t ==> !f. SIGMA f (s UNION t) + SIGMA f (s INTER t) = SIGMA f s + SIGMA f t *)
6372(* Proof:
6373 Note SIGMA f (s UNION t)
6374 = SIGMA f s + SIGMA f t - SIGMA f (s INTER t) by SUM_IMAGE_UNION
6375 now s INTER t SUBSET s /\ s INTER t SUBSET t by INTER_SUBSET
6376 so SIGMA f (s INTER t) <= SIGMA f s by SUM_IMAGE_SUBSET_LE
6377 and SIGMA f (s INTER t) <= SIGMA f t by SUM_IMAGE_SUBSET_LE
6378 thus SIGMA f (s INTER t) <= SIGMA f s + SIGMA f t by arithmetic
6379 The result follows by ADD_EQ_SUB
6380*)
6381Theorem SUM_IMAGE_UNION_EQN:
6382 !s t. FINITE s /\ FINITE t ==> !f. SIGMA f (s UNION t) + SIGMA f (s INTER t) = SIGMA f s + SIGMA f t
6383Proof
6384 rpt strip_tac >>
6385 `SIGMA f (s UNION t) = SIGMA f s + SIGMA f t - SIGMA f (s INTER t)` by rw[SUM_IMAGE_UNION] >>
6386 `SIGMA f (s INTER t) <= SIGMA f s` by rw[SUM_IMAGE_SUBSET_LE, INTER_SUBSET] >>
6387 `SIGMA f (s INTER t) <= SIGMA f t` by rw[SUM_IMAGE_SUBSET_LE, INTER_SUBSET] >>
6388 `SIGMA f (s INTER t) <= SIGMA f s + SIGMA f t` by decide_tac >>
6389 rw[ADD_EQ_SUB]
6390QED
6391
6392(* Theorem: FINITE s /\ FINITE t /\ DISJOINT s t ==> !f. SIGMA f (s UNION t) = SIGMA f s + SIGMA f t *)
6393(* Proof:
6394 SIGMA f (s UNION t)
6395 = SIGMA f s + SIGMA f t - SIGMA f (s INTER t) by SUM_IMAGE_UNION
6396 = SIGMA f s + SIGMA f t - SIGMA f {} by DISJOINT_DEF
6397 = SIGMA f s + SIGMA f t - 0 by SUM_IMAGE_EMPTY
6398 = SIGMA f s + SIGMA f t by arithmetic
6399*)
6400Theorem SUM_IMAGE_DISJOINT:
6401 !s t. FINITE s /\ FINITE t /\ DISJOINT s t ==> !f. SIGMA f (s UNION t) = SIGMA f s + SIGMA f t
6402Proof
6403 rw_tac std_ss[SUM_IMAGE_UNION, DISJOINT_DEF, SUM_IMAGE_EMPTY]
6404QED
6405
6406(* Theorem: FINITE s /\ s <> {} ==> !f g. (!x. x IN s ==> f x < g x) ==> SIGMA f s < SIGMA g s *)
6407(* Proof:
6408 Note s <> {} ==> ?x. x IN s by MEMBER_NOT_EMPTY
6409 Thus ?x. x IN s /\ f x < g x by implication
6410 and !x. x IN s ==> f x <= g x by LESS_IMP_LESS_OR_EQ
6411 ==> SIGMA f s < SIGMA g s by SUM_IMAGE_MONO_LESS
6412*)
6413Theorem SUM_IMAGE_MONO_LT:
6414 !s. FINITE s /\ s <> {} ==> !f g. (!x. x IN s ==> f x < g x) ==> SIGMA f s < SIGMA g s
6415Proof
6416 metis_tac[SUM_IMAGE_MONO_LESS, LESS_IMP_LESS_OR_EQ, MEMBER_NOT_EMPTY]
6417QED
6418
6419(*---------------------------------------------------------------------------*)
6420(* SUM_SET sums the elements of a set of natural numbers *)
6421(*---------------------------------------------------------------------------*)
6422
6423Definition SUM_SET_DEF[nocompute]: SUM_SET = SUM_IMAGE I
6424End
6425
6426Theorem SUM_SET_THM:
6427 (SUM_SET {} = 0) /\
6428 (!x s. FINITE s ==> (SUM_SET (x INSERT s) = x + SUM_SET (s DELETE x)))
6429Proof
6430 SRW_TAC [][SUM_SET_DEF, SUM_IMAGE_THM]
6431QED
6432
6433Theorem SUM_SET_EMPTY[simp] = CONJUNCT1 SUM_SET_THM;
6434
6435Theorem SUM_SET_SING[simp]:
6436 !n. SUM_SET {n} = n
6437Proof
6438 SRW_TAC [][SUM_SET_DEF, SUM_IMAGE_SING]
6439QED
6440
6441(* Theorem: FINITE s /\ x NOTIN s ==> (SUM_SET (x INSERT s) = x + SUM_SET s) *)
6442(* Proof:
6443 SUM_SET (x INSERT s)
6444 = x + SUM_SET (s DELETE x) by SUM_SET_THM
6445 = x + SUM_SET s by DELETE_NON_ELEMENT
6446*)
6447Theorem SUM_SET_INSERT:
6448 !s x. FINITE s /\ x NOTIN s ==> (SUM_SET (x INSERT s) = x + SUM_SET s)
6449Proof
6450 rw[SUM_SET_THM, DELETE_NON_ELEMENT]
6451QED
6452
6453Theorem SUM_SET_SUBSET_LE:
6454 !s t. FINITE t /\ s SUBSET t ==> SUM_SET s <= SUM_SET t
6455Proof
6456 SRW_TAC [][SUM_SET_DEF, SUM_IMAGE_SUBSET_LE]
6457QED
6458
6459Theorem SUM_SET_IN_LE:
6460 !x s. FINITE s /\ x IN s ==> x <= SUM_SET s
6461Proof
6462 SRW_TAC [][SUM_SET_DEF] THEN
6463 PROVE_TAC [I_THM, SUM_IMAGE_IN_LE]
6464QED
6465
6466Theorem SUM_SET_DELETE:
6467 !s. FINITE s ==> !e. SUM_SET (s DELETE e) = if e IN s then SUM_SET s - e
6468 else SUM_SET s
6469Proof
6470 SIMP_TAC (srw_ss()) [SUM_SET_DEF, SUM_IMAGE_DELETE]
6471QED
6472
6473Theorem SUM_SET_UNION:
6474 !s t. FINITE s /\ FINITE t ==>
6475 (SUM_SET (s UNION t) =
6476 SUM_SET s + SUM_SET t - SUM_SET (s INTER t))
6477Proof
6478 SRW_TAC [][SUM_SET_DEF, SUM_IMAGE_UNION]
6479QED
6480
6481Theorem SUM_SET_count_2:
6482 !n. 2 * SUM_SET (count n) = n * (n - 1)
6483Proof
6484 Induct >>
6485 rw [
6486 COUNT_SUC, SUM_SET_THM, LEFT_ADD_DISTRIB, SUM_SET_DELETE, ADD1,
6487 LEFT_SUB_DISTRIB, RIGHT_ADD_DISTRIB, SUM_SQUARED
6488 ] >>
6489 `n <= n ** 2` by rw[] >>
6490 rw[]
6491QED
6492
6493Theorem SUM_SET_count:
6494 SUM_SET (count n) = n * (n - 1) DIV 2
6495Proof
6496 Q.MATCH_ABBREV_TAC `a = b` >>
6497 ‘2 * a = 2 * b’ suffices_by simp[] >>
6498 markerLib.UNABBREV_ALL_TAC >>
6499 REWRITE_TAC[SUM_SET_count_2] >>
6500 Q.SPEC_THEN ‘2’ mp_tac DIVISION >> simp[] >>
6501 disch_then (Q.SPEC_THEN ‘n * (n - 1)’ assume_tac) >>
6502 Q.MATCH_ABBREV_TAC ‘(a = 2 * (a DIV 2))’ >>
6503 ‘a MOD 2 = 0’ suffices_by (strip_tac >> fs[]) >>
6504 simp[Abbr`a`,GSYM EVEN_MOD2, LEFT_SUB_DISTRIB, EVEN_SUB, EVEN_EXP_IFF]
6505QED
6506
6507(* ----------------------------------------------------------------------
6508 PROD_IMAGE
6509
6510 This construct is the same as standard mathematics \Pi operator:
6511
6512 \Pi_{x\in P}{f(x)} = PROD_IMAGE f P
6513
6514 Where f's range is the natural numbers and P is finite.
6515 ---------------------------------------------------------------------- *)
6516
6517(* Define PROD_IMAGE similar to SUM_IMAGE *)
6518Definition PROD_IMAGE_DEF[nocompute]:
6519 PROD_IMAGE f s = ITSET (\e acc. f e * acc) s 1
6520End
6521
6522(* Theorem: property of PROD_IMAGE *)
6523Theorem PROD_IMAGE_THM:
6524 !f. (PROD_IMAGE f {} = 1) /\
6525 (!e s. FINITE s ==>
6526 (PROD_IMAGE f (e INSERT s) = f e * PROD_IMAGE f (s DELETE e)))
6527Proof
6528 REPEAT STRIP_TAC THEN1
6529 SIMP_TAC (srw_ss()) [ITSET_THM, PROD_IMAGE_DEF] THEN
6530 SIMP_TAC (srw_ss()) [PROD_IMAGE_DEF] THEN
6531 Q.ABBREV_TAC `g = \e acc. f e * acc` THEN
6532 Q_TAC SUFF_TAC `ITSET g (e INSERT s) 1 =
6533 g e (ITSET g (s DELETE e) 1)` THEN1 SRW_TAC [][Abbr`g`] THEN
6534 MATCH_MP_TAC COMMUTING_ITSET_RECURSES THEN
6535 SRW_TAC [ARITH_ss][Abbr`g`]
6536QED
6537
6538Overload PI = ``PROD_IMAGE``
6539val _ = Unicode.unicode_version {tmnm = "PROD_IMAGE", u = UnicodeChars.Pi}
6540
6541Theorem PROD_IMAGE_EQ_0:
6542 !s. FINITE s ==>
6543 (PROD_IMAGE f s = 0 <=> ?x. x IN s /\ f x = 0)
6544Proof
6545 ho_match_mp_tac FINITE_INDUCT
6546 \\ rw[PROD_IMAGE_THM, DELETE_NON_ELEMENT]
6547 \\ METIS_TAC[]
6548QED
6549
6550Theorem PROD_IMAGE_EQ_1:
6551 !s. FINITE s ==>
6552 (PROD_IMAGE f s = 1 <=> IMAGE f s SUBSET {1})
6553Proof
6554 ho_match_mp_tac FINITE_INDUCT
6555 \\ rw[PROD_IMAGE_THM, DELETE_NON_ELEMENT,
6556 SUBSET_INSERT, NOT_IN_EMPTY, INSERT_SUBSET]
6557QED
6558
6559Theorem prime_PROD_IMAGE:
6560 !f s. FINITE s ==>
6561 (prime (PROD_IMAGE f s) <=>
6562 ?p. IMAGE f s SUBSET {1; p} /\ prime p /\
6563 ?!x. x IN s /\ f x = p)
6564Proof
6565 gen_tac \\ ho_match_mp_tac FINITE_INDUCT
6566 \\ simp[PROD_IMAGE_THM]
6567 \\ rw[DELETE_NON_ELEMENT]
6568 \\ simp[prime_MULT]
6569 \\ Cases_on`PROD_IMAGE f s = 0` \\ simp[]
6570 >- (
6571 REV_FULL_SIMP_TAC(srw_ss())[PROD_IMAGE_EQ_0]
6572 \\ rw[SUBSET_DEF, PULL_EXISTS]
6573 \\ METIS_TAC[NOT_PRIME_0, DECIDE``1 <> 0``])
6574 \\ Cases_on`f e = 0` \\ simp[INSERT_SUBSET]
6575 \\ Cases_on`PROD_IMAGE f s = 1` \\ simp[]
6576 >- (
6577 REV_FULL_SIMP_TAC(srw_ss())[PROD_IMAGE_EQ_1]
6578 \\ fs[SUBSET_DEF, PULL_EXISTS]
6579 \\ Cases_on`f e = 1` \\ simp[]
6580 \\ METIS_TAC[NOT_PRIME_1])
6581 \\ Cases_on`f e = 1` \\ simp[]
6582 >- METIS_TAC[NOT_PRIME_1]
6583 \\ CCONTR_TAC \\ fs[]
6584 \\ REV_FULL_SIMP_TAC(srw_ss())[PROD_IMAGE_EQ_1]
6585 \\ REV_FULL_SIMP_TAC(srw_ss())[SUBSET_DEF, PULL_EXISTS]
6586 \\ METIS_TAC[DELETE_NON_ELEMENT]
6587QED
6588
6589(* Theorem: PI f {} = 1 *)
6590(* Proof: by PROD_IMAGE_THM *)
6591Theorem PROD_IMAGE_EMPTY:
6592 !f. PI f {} = 1
6593Proof
6594 rw[PROD_IMAGE_THM]
6595QED
6596
6597(* Theorem: FINITE s ==> !f e. e NOTIN s ==> (PI f (e INSERT s) = (f e) * PI f s) *)
6598(* Proof: by PROD_IMAGE_THM, DELETE_NON_ELEMENT *)
6599Theorem PROD_IMAGE_INSERT:
6600 !s. FINITE s ==> !f e. e NOTIN s ==> (PI f (e INSERT s) = (f e) * PI f s)
6601Proof
6602 rw[PROD_IMAGE_THM, DELETE_NON_ELEMENT]
6603QED
6604
6605(* Theorem: FINITE s ==> !f e. 0 < f e ==>
6606 (PI f (s DELETE e) = if e IN s then ((PI f s) DIV (f e)) else PI f s) *)
6607(* Proof:
6608 If e IN s,
6609 Note PI f (e INSERT s) = (f e) * PI f (s DELETE e) by PROD_IMAGE_THM
6610 Thus PI f (s DELETE e) = PI f (e INSERT s) DIV (f e) by DIV_SOLVE_COMM, 0 < f e
6611 = (PI f s) DIV (f e) by ABSORPTION, e IN s.
6612 If e NOTIN s,
6613 PI f (s DELETE e) = PI f e by DELETE_NON_ELEMENT
6614*)
6615Theorem PROD_IMAGE_DELETE:
6616 !s. FINITE s ==> !f e. 0 < f e ==>
6617 (PI f (s DELETE e) = if e IN s then ((PI f s) DIV (f e)) else PI f s)
6618Proof
6619 rpt strip_tac >>
6620 rw_tac std_ss[] >-
6621 metis_tac[PROD_IMAGE_THM, DIV_SOLVE_COMM, ABSORPTION] >>
6622 metis_tac[DELETE_NON_ELEMENT]
6623QED
6624(* The original proof of SUM_IMAGE_DELETE is clumsy. *)
6625
6626(* Theorem: (!x. x IN s ==> (f1 x = f2 x)) ==> (PI f1 s = PI f2 s) *)
6627(* Proof:
6628 If INFINITE s,
6629 PI f1 s
6630 = ITSET (\e acc. f e * acc) s 1 by PROD_IMAGE_DEF
6631 = ARB by ITSET_def
6632 Similarly, PI f2 s = ARB = PI f1 s.
6633 If FINITE s,
6634 Apply finite induction on s.
6635 Base: PI f1 {} = PI f2 {}, true by PROD_IMAGE_EMPTY
6636 Step: !f1 f2. (!x. x IN s ==> (f1 x = f2 x)) ==> (PI f1 s = PI f2 s) ==>
6637 e NOTIN s /\ !x. x IN e INSERT s ==> (f1 x = f2 x) ==> PI f1 (e INSERT s) = PI f2 (e INSERT s)
6638 Note !x. x IN e INSERT s ==> (f1 x = f2 x)
6639 ==> (f1 e = f2 e) \/ !x. s IN s ==> (f1 x = f2 x) by IN_INSERT
6640 PI f1 (e INSERT s)
6641 = (f1 e) * (PI f1 s) by PROD_IMAGE_INSERT, e NOTIN s
6642 = (f1 e) * (PI f2 s) by induction hypothesis
6643 = (f2 e) * (PI f2 s) by f1 e = f2 e
6644 = PI f2 (e INSERT s) by PROD_IMAGE_INSERT, e NOTIN s
6645*)
6646Theorem PROD_IMAGE_CONG:
6647 !s f1 f2. (!x. x IN s ==> (f1 x = f2 x)) ==> (PI f1 s = PI f2 s)
6648Proof
6649 rpt strip_tac >>
6650 reverse (Cases_on `FINITE s`) >| [
6651 rw[PROD_IMAGE_DEF, Once ITSET_def] >>
6652 rw[Once ITSET_def],
6653 pop_assum mp_tac >>
6654 pop_assum mp_tac >>
6655 qid_spec_tac `s` >>
6656 `!s. FINITE s ==> !f1 f2. (!x. x IN s ==> (f1 x = f2 x)) ==> (PI f1 s = PI f2 s)` suffices_by rw[] >>
6657 Induct_on `FINITE` >>
6658 rpt strip_tac >-
6659 rw[PROD_IMAGE_EMPTY] >>
6660 metis_tac[PROD_IMAGE_INSERT, IN_INSERT]
6661 ]
6662QED
6663
6664(* Theorem: FINITE s ==> !f k. (!x. x IN s ==> (f x = k)) ==> (PI f s = k ** CARD s) *)
6665(* Proof:
6666 By finite induction on s.
6667 Base: PI f {} = k ** CARD {}
6668 PI f {}
6669 = 1 by PROD_IMAGE_THM
6670 = c ** 0 by EXP
6671 = c ** CARD {} by CARD_DEF
6672 Step: !f k. (!x. x IN s ==> (f x = k)) ==> (PI f s = k ** CARD s) ==>
6673 e NOTIN s ==> PI f (e INSERT s) = k ** CARD (e INSERT s)
6674 PI f (e INSERT s)
6675 = ((f e) * PI (K c) (s DELETE e) by PROD_IMAGE_THM
6676 = c * PI (K c) (s DELETE e) by function application
6677 = c * PI (K c) s by DELETE_NON_ELEMENT
6678 = c * c ** CARD s by induction hypothesis
6679 = c ** (SUC (CARD s)) by EXP
6680 = c ** CARD (e INSERT s) by CARD_INSERT, e NOTIN s
6681*)
6682Theorem PI_CONSTANT:
6683 !s. FINITE s ==> !f k. (!x. x IN s ==> (f x = k)) ==> (PI f s = k ** CARD s)
6684Proof
6685 Induct_on `FINITE` >>
6686 rpt strip_tac >-
6687 rw[PROD_IMAGE_THM] >>
6688 rw[PROD_IMAGE_THM, CARD_INSERT] >>
6689 fs[] >>
6690 metis_tac[DELETE_NON_ELEMENT, EXP]
6691QED
6692
6693(* Theorem: FINITE s ==> !c. PI (K c) s = c ** (CARD s) *)
6694(* Proof: by PI_CONSTANT. *)
6695Theorem PROD_IMAGE_CONSTANT:
6696 !s. FINITE s ==> !c. PI (K c) s = c ** (CARD s)
6697Proof
6698 rw[PI_CONSTANT]
6699QED
6700
6701(*---------------------------------------------------------------------------*)
6702(* PROD_SET multiplies the elements of a set of natural numbers *)
6703(*---------------------------------------------------------------------------*)
6704
6705(* Define PROD_SET similar to SUM_SET *)
6706Definition PROD_SET_DEF[nocompute]: PROD_SET = PROD_IMAGE I
6707End
6708
6709(* Theorem: Product Set property *)
6710Theorem PROD_SET_THM:
6711 (PROD_SET {} = 1) /\
6712 (!x s. FINITE s ==> (PROD_SET (x INSERT s) = x * PROD_SET (s DELETE x)))
6713Proof
6714 SRW_TAC [][PROD_SET_DEF, PROD_IMAGE_THM]
6715QED
6716
6717Theorem PROD_SET_EMPTY = CONJUNCT1 PROD_SET_THM;
6718
6719(* Theorem: PROD_SET (IMAGE f (x INSERT s)) = (f x) * PROD_SET (IMAGE f s) *)
6720(* Proof:
6721 PROD_SET (IMAGE f (x INSERT s))
6722 = PROD_SET (f x INSERT IMAGE f s) by IMAGE_INSERT
6723 = f x * PROD_SET (IMAGE f s) DELETE (f x) by PROD_SET_THM, assume FINITE (IMAGE f s)
6724 = f x * PROD_SET (IMAGE f s) by (f x) not in (IMAGE f s)
6725*)
6726Theorem PROD_SET_IMAGE_REDUCTION:
6727 !f s x. FINITE (IMAGE f s) /\ f x NOTIN IMAGE f s ==>
6728 (PROD_SET (IMAGE f (x INSERT s)) = (f x) * PROD_SET (IMAGE f s))
6729Proof
6730 METIS_TAC [DELETE_NON_ELEMENT, IMAGE_INSERT, PROD_SET_THM]
6731QED
6732
6733(* PROD_SET_IMAGE_REDUCTION |> ISPEC ``I:num -> num``; *)
6734
6735(* Theorem: FINITE s /\ x NOTIN s ==> (PROD_SET (x INSERT s) = x * PROD_SET s) *)
6736(* Proof:
6737 Since !x. I x = x by I_THM
6738 and !s. IMAGE I s = s by IMAGE_I
6739 thus the result follows by PROD_SET_IMAGE_REDUCTION
6740*)
6741Theorem PROD_SET_INSERT:
6742 !x s. FINITE s /\ x NOTIN s ==> (PROD_SET (x INSERT s) = x * PROD_SET s)
6743Proof
6744 metis_tac[PROD_SET_IMAGE_REDUCTION, combinTheory.I_THM, IMAGE_I]
6745QED
6746
6747(* ------------------------------------------------------------------------- *)
6748(* Maximum and Minimum of a Set *)
6749(* ------------------------------------------------------------------------- *)
6750
6751(* every finite, non-empty set of natural numbers has a maximum element *)
6752Theorem max_lemma[local]:
6753 !s. FINITE s ==> ?x. (s <> {} ==> x IN s /\ !y. y IN s ==> y <= x) /\
6754 ((s = {}) ==> (x = 0))
6755Proof
6756 HO_MATCH_MP_TAC FINITE_INDUCT THEN
6757 SIMP_TAC bool_ss [NOT_INSERT_EMPTY, IN_INSERT] THEN
6758 REPEAT STRIP_TAC THEN
6759 Q.ISPEC_THEN `s` STRIP_ASSUME_TAC SET_CASES THENL [
6760 ASM_SIMP_TAC arith_ss [NOT_IN_EMPTY],
6761 `~(s = {})` by PROVE_TAC [NOT_INSERT_EMPTY] THEN
6762 `?m. m IN s /\ !y. y IN s ==> y <= m` by PROVE_TAC [] THEN
6763 Cases_on `e <= m` THENL [
6764 PROVE_TAC [],
6765 `m <= e` by RW_TAC arith_ss [] THEN
6766 PROVE_TAC [LESS_EQ_REFL, LESS_EQ_TRANS]
6767 ]
6768 ]
6769QED
6770
6771(* |- !s. FINITE s ==>
6772 (s <> {} ==> MAX_SET s IN s /\ !y. y IN s ==> y <= MAX_SET s) /\
6773 (s = {} ==> MAX_SET s = 0)
6774 *)
6775val MAX_SET_DEF = new_specification (
6776 "MAX_SET_DEF", ["MAX_SET"],
6777 CONV_RULE (BINDER_CONV RIGHT_IMP_EXISTS_CONV THENC
6778 SKOLEM_CONV) max_lemma);
6779
6780Theorem MAX_SET_THM:
6781 (MAX_SET {} = 0) /\
6782 (!e s. FINITE s ==> (MAX_SET (e INSERT s) = MAX e (MAX_SET s)))
6783Proof
6784 CONJ_TAC THENL [
6785 STRIP_ASSUME_TAC (SIMP_RULE bool_ss [FINITE_EMPTY]
6786 (Q.SPEC `{}` MAX_SET_DEF)),
6787 REPEAT STRIP_TAC THEN
6788 Q.ISPEC_THEN `e INSERT s` MP_TAC MAX_SET_DEF THEN
6789 ASM_SIMP_TAC bool_ss [FINITE_INSERT, NOT_INSERT_EMPTY,
6790 IN_INSERT, FORALL_AND_THM, DISJ_IMP_THM] THEN
6791 STRIP_TAC THEN
6792 Q.ISPEC_THEN `s` MP_TAC MAX_SET_DEF THEN
6793 ASM_REWRITE_TAC [] THEN
6794 STRIP_TAC THEN
6795 Q.ABBREV_TAC `m1 = MAX_SET (e INSERT s)` THEN
6796 Q.ABBREV_TAC `m2 = MAX_SET s` THEN
6797 NTAC 2 (POP_ASSUM (K ALL_TAC)) THEN
6798 Q.ASM_CASES_TAC `s = {}` THEN FULL_SIMP_TAC (srw_ss()) [] THEN
6799 RES_TAC THEN ASM_SIMP_TAC arith_ss [MAX_DEF]
6800 ]
6801QED
6802
6803Theorem in_max_set:
6804 !s. FINITE s ==> !x. x IN s ==> x <= MAX_SET s
6805Proof
6806 HO_MATCH_MP_TAC FINITE_INDUCT THEN
6807 SRW_TAC [] [MAX_SET_THM] THEN
6808 SRW_TAC [] []
6809QED
6810
6811Theorem X_LE_MAX_SET = in_max_set
6812
6813Theorem MAX_SET_REWRITES[simp]:
6814 (MAX_SET {} = 0) /\ (MAX_SET {e} = e)
6815Proof
6816 SRW_TAC[][MAX_SET_THM]
6817QED
6818
6819Theorem MAX_SET_ELIM:
6820 !P Q. FINITE P /\ ((P = {}) ==> Q 0) /\ (!x. (!y. y IN P ==> y <= x) /\ x IN P ==> Q x) ==>
6821 Q (MAX_SET P)
6822Proof
6823 PROVE_TAC [MAX_SET_DEF]
6824QED
6825
6826(* NOTE: “MIN_SET {}” is undefined *)
6827Definition MIN_SET_DEF[nocompute]: MIN_SET = $LEAST
6828End
6829
6830Theorem MIN_SET_ELIM:
6831 !P Q. ~(P = {}) /\ (!x. (!y. y IN P ==> x <= y) /\ x IN P ==> Q x) ==>
6832 Q (MIN_SET P)
6833Proof
6834 REWRITE_TAC [MIN_SET_DEF] THEN REPEAT STRIP_TAC THEN
6835 MATCH_MP_TAC LEAST_ELIM THEN CONJ_TAC THENL [
6836 `?x. P x` by PROVE_TAC [SET_CASES, IN_INSERT, SPECIFICATION] THEN
6837 PROVE_TAC [],
6838 FULL_SIMP_TAC arith_ss [SPECIFICATION] THEN
6839 PROVE_TAC [NOT_LESS]
6840 ]
6841QED
6842
6843Theorem MIN_SET_THM:
6844 (!e. MIN_SET {e} = e) /\
6845 (!s e1 e2. MIN_SET (e1 INSERT e2 INSERT s) =
6846 MIN e1 (MIN_SET (e2 INSERT s)))
6847Proof
6848 CONJ_TAC THENL [
6849 GEN_TAC THEN
6850 Q.SPECL_THEN [`{e}`, `\x. x = e`] (MATCH_MP_TAC o BETA_RULE)
6851 MIN_SET_ELIM THEN
6852 SIMP_TAC bool_ss [IN_INSERT, NOT_INSERT_EMPTY, DISJ_IMP_THM,
6853 NOT_IN_EMPTY],
6854 REPEAT GEN_TAC THEN
6855 Q.SPECL_THEN [`e1 INSERT e2 INSERT s`,
6856 `\x. x = MIN e1 (MIN_SET (e2 INSERT s))`]
6857 (MATCH_MP_TAC o BETA_RULE)
6858 MIN_SET_ELIM THEN
6859 SIMP_TAC bool_ss [IN_INSERT, NOT_INSERT_EMPTY, DISJ_IMP_THM,
6860 FORALL_AND_THM] THEN
6861 REPEAT STRIP_TAC THEN
6862 Q.SPECL_THEN [`e2 INSERT s`, `\y. x = MIN e1 y`]
6863 (MATCH_MP_TAC o BETA_RULE)
6864 MIN_SET_ELIM THEN
6865 SIMP_TAC bool_ss [IN_INSERT, NOT_INSERT_EMPTY, DISJ_IMP_THM,
6866 FORALL_AND_THM] THEN
6867 REPEAT STRIP_TAC THEN RES_TAC THEN ASM_SIMP_TAC arith_ss [MIN_DEF]
6868 ]
6869QED
6870
6871(* This version of MIN_SET_THM may be more useful when doing induction on s *)
6872Theorem MIN_SET_THM' :
6873 (!e. MIN_SET {e} = e) /\
6874 (!e s. s <> {} ==> MIN_SET (e INSERT s) = MIN e (MIN_SET s))
6875Proof
6876 CONJ_TAC >- REWRITE_TAC [MIN_SET_THM]
6877 >> rpt GEN_TAC
6878 >> DISCH_THEN (fn th =>
6879 ONCE_REWRITE_TAC [SYM (MATCH_MP CHOICE_INSERT_REST th)])
6880 >> REWRITE_TAC [MIN_SET_THM]
6881QED
6882
6883Theorem MIN_SET_LEM:
6884 !s. ~(s={}) ==> (MIN_SET s IN s) /\ !x. x IN s ==> MIN_SET s <= x
6885Proof
6886 METIS_TAC [GSYM MEMBER_NOT_EMPTY,MIN_SET_DEF,
6887 IN_DEF,WhileTheory.FULL_LEAST_INTRO]
6888QED
6889
6890Theorem SUBSET_MIN_SET:
6891 !I J. ~(I={}) /\ ~(J={}) /\ I SUBSET J ==> MIN_SET J <= MIN_SET I
6892Proof
6893 METIS_TAC [SUBSET_DEF,MIN_SET_LEM]
6894QED
6895
6896Theorem SUBSET_MAX_SET:
6897 !I J. FINITE I /\ FINITE J /\ I SUBSET J ==> MAX_SET I <= MAX_SET J
6898Proof
6899 MAP_EVERY Q.X_GEN_TAC [`s1`, `s2`] THEN STRIP_TAC THEN
6900 Q.ASM_CASES_TAC `s1 = {}` THEN1 ASM_SIMP_TAC (srw_ss()) [] THEN
6901 Q.ASM_CASES_TAC `s2 = {}` THEN1 FULL_SIMP_TAC (srw_ss()) [] THEN
6902 METIS_TAC [SUBSET_DEF,MAX_SET_DEF]
6903QED
6904
6905Theorem MIN_SET_LEQ_MAX_SET:
6906 !s. ~(s={}) /\ FINITE s ==> MIN_SET s <= MAX_SET s
6907Proof
6908 RW_TAC arith_ss [MIN_SET_DEF] THEN
6909METIS_TAC [FULL_LEAST_INTRO,MAX_SET_DEF,IN_DEF]
6910QED
6911
6912Theorem MIN_SET_UNION:
6913 !A B. FINITE A /\ FINITE B /\ ~(A={}) /\ ~(B={})
6914 ==>
6915 (MIN_SET (A UNION B) = MIN (MIN_SET A) (MIN_SET B))
6916Proof
6917 let val lem = Q.prove
6918 (`!A. FINITE A ==>
6919 !B. FINITE B /\ ~(A={}) /\ ~(B={})
6920 ==> (MIN_SET (A UNION B) = MIN (MIN_SET A) (MIN_SET B))`,
6921 SET_INDUCT_TAC THEN RW_TAC (srw_ss()) []
6922 THEN `?b t. (B = b INSERT t) /\ ~(b IN t)` by METIS_TAC [SET_CASES]
6923 THEN RW_TAC (srw_ss()) []
6924 THEN `(e INSERT s) UNION (b INSERT t) = e INSERT b INSERT (s UNION t)`
6925 by METIS_TAC [INSERT_UNION,INSERT_UNION_EQ, UNION_COMM, UNION_ASSOC]
6926 THEN POP_ASSUM SUBST_ALL_TAC
6927 THEN `FINITE (s UNION t)` by METIS_TAC [FINITE_INSERT,FINITE_UNION]
6928 THEN RW_TAC (srw_ss()) [MIN_SET_THM]
6929 THEN Cases_on `s={}` THEN RW_TAC (srw_ss()) [MIN_SET_THM]
6930 THEN `b INSERT (s UNION t) = s UNION (b INSERT t)`
6931 by METIS_TAC [INSERT_UNION,INSERT_UNION_EQ, UNION_COMM, UNION_ASSOC]
6932 THEN POP_ASSUM SUBST_ALL_TAC
6933 THEN `MIN_SET (s UNION (b INSERT t)) = MIN (MIN_SET s) (MIN_SET (b INSERT t))`
6934 by METIS_TAC [] THEN POP_ASSUM SUBST_ALL_TAC
6935 THEN `MIN_SET (e INSERT s) = MIN (MIN_SET s) (MIN_SET {e})`
6936 by METIS_TAC [FINITE_SING,NOT_EMPTY_INSERT,
6937 UNION_COMM,INSERT_UNION_EQ,UNION_EMPTY]
6938 THEN RW_TAC (srw_ss()) [MIN_SET_THM, AC MIN_COMM MIN_ASSOC])
6939 in METIS_TAC [lem]
6940 end
6941QED
6942
6943Theorem MAX_SET_UNION:
6944 !A B. FINITE A /\ FINITE B
6945 ==>
6946 (MAX_SET (A UNION B) = MAX (MAX_SET A) (MAX_SET B))
6947Proof
6948 Q_TAC SUFF_TAC `
6949 !A. FINITE A ==> !B. FINITE B ==>
6950 (MAX_SET (A UNION B) = MAX (MAX_SET A) (MAX_SET B))
6951 ` THEN1 METIS_TAC[] THEN
6952 SET_INDUCT_TAC THEN RW_TAC (srw_ss()) []
6953 THEN `(B = {}) \/ ?b t. (B = b INSERT t) /\ ~(b IN t)`
6954 by METIS_TAC [SET_CASES]
6955 THEN SRW_TAC [][]
6956 THEN `(e INSERT s) UNION (b INSERT t) = e INSERT b INSERT (s UNION t)`
6957 by SRW_TAC[][EXTENSION,AC DISJ_COMM DISJ_ASSOC]
6958 THEN FULL_SIMP_TAC (srw_ss()) [MAX_SET_THM, AC MAX_COMM MAX_ASSOC]
6959QED
6960
6961Theorem FINITE_INTER :
6962 !s1 s2. ((FINITE s1) \/ (FINITE s2)) ==> FINITE (s1 INTER s2)
6963Proof
6964 METIS_TAC[INTER_COMM, INTER_FINITE]
6965QED
6966
6967Theorem MAX_SET_INTER :
6968 !A B. FINITE A /\ FINITE B ==>
6969 MAX_SET (A INTER B) <= MIN (MAX_SET A) (MAX_SET B)
6970Proof
6971 Q_TAC SUFF_TAC
6972 ‘!A. FINITE A ==> !B. FINITE B ==>
6973 MAX_SET (A INTER B) <= MIN (MAX_SET A) (MAX_SET B)’
6974 >- METIS_TAC []
6975 >> SET_INDUCT_TAC >> simp []
6976 >> rpt STRIP_TAC (* 2 subgoals, same tactics *)
6977 >> MATCH_MP_TAC SUBSET_MAX_SET
6978 >> rw [FINITE_INTER, INTER_SUBSET]
6979QED
6980
6981val set_ss = arith_ss ++ SET_SPEC_ss ++
6982 rewrites [CARD_INSERT,CARD_EMPTY,FINITE_EMPTY,FINITE_INSERT,
6983 NOT_IN_EMPTY];
6984
6985Theorem SUBSET_count_MAX_SET:
6986 FINITE s ==> s SUBSET count (MAX_SET s + 1)
6987Proof
6988 simp[SUBSET_DEF, DECIDE “x < y + 1 <=> x <= y”, X_LE_MAX_SET]
6989QED
6990
6991Theorem CARD_LE_MAX_SET:
6992 FINITE s ==> CARD s <= MAX_SET s + 1
6993Proof
6994 strip_tac >> CCONTR_TAC >>
6995 ‘s SUBSET count (MAX_SET s + 1)’ by simp[SUBSET_count_MAX_SET] >>
6996 ‘CARD s <= CARD (count (MAX_SET s + 1))’ by simp[CARD_SUBSET] >>
6997 full_simp_tac (srw_ss()) []
6998QED
6999
7000(* Theorem: FINITE s /\ MAX_SET s < n ==> !x. x IN s ==> x < n *)
7001(* Proof:
7002 Since x IN s, s <> {} by MEMBER_NOT_EMPTY
7003 Hence x <= MAX_SET s by MAX_SET_DEF
7004 Thus x < n by LESS_EQ_LESS_TRANS
7005*)
7006Theorem MAX_SET_LESS:
7007 !s n. FINITE s /\ MAX_SET s < n ==> !x. x IN s ==> x < n
7008Proof
7009 metis_tac[MEMBER_NOT_EMPTY, MAX_SET_DEF, LESS_EQ_LESS_TRANS]
7010QED
7011
7012(* Theorem: FINITE s /\ s <> {} ==> !x. x IN s /\ (!y. y IN s ==> y <= x) ==> (x = MAX_SET s) *)
7013(* Proof:
7014 Let m = MAX_SET s.
7015 Since m IN s /\ x <= m by MAX_SET_DEF
7016 and m IN s ==> m <= x by implication
7017 Hence x = m.
7018*)
7019Theorem MAX_SET_TEST:
7020 !s. FINITE s /\ s <> {} ==> !x. x IN s /\ (!y. y IN s ==> y <= x) ==> (x = MAX_SET s)
7021Proof
7022 rpt strip_tac >>
7023 qabbrev_tac `m = MAX_SET s` >>
7024 `m IN s /\ x <= m` by rw[MAX_SET_DEF, Abbr`m`] >>
7025 `m <= x` by rw[] >>
7026 decide_tac
7027QED
7028
7029(* Theorem: s <> {} ==> !x. x IN s /\ (!y. y IN s ==> x <= y) ==> (x = MIN_SET s) *)
7030(* Proof:
7031 Let m = MIN_SET s.
7032 Since m IN s /\ m <= x by MIN_SET_LEM
7033 and m IN s ==> x <= m by implication
7034 Hence x = m.
7035*)
7036Theorem MIN_SET_TEST:
7037 !s. s <> {} ==> !x. x IN s /\ (!y. y IN s ==> x <= y) ==> (x = MIN_SET s)
7038Proof
7039 rpt strip_tac >>
7040 qabbrev_tac `m = MIN_SET s` >>
7041 `m IN s /\ m <= x` by rw[MIN_SET_LEM, Abbr`m`] >>
7042 `x <= m` by rw[] >>
7043 decide_tac
7044QED
7045
7046(* Theorem: FINITE s /\ s <> {} ==> !x. x IN s ==> ((MAX_SET s = x) <=> (!y. y IN s ==> y <= x)) *)
7047(* Proof:
7048 Let m = MAX_SET s.
7049 If part: y IN s ==> y <= m, true by MAX_SET_DEF
7050 Only-if part: !y. y IN s ==> y <= x ==> m = x
7051 Note m IN s /\ x <= m by MAX_SET_DEF
7052 and m IN s ==> m <= x by implication
7053 Hence x = m.
7054*)
7055Theorem MAX_SET_TEST_IFF:
7056 !s. FINITE s /\ s <> {} ==>
7057 !x. x IN s ==> ((MAX_SET s = x) <=> (!y. y IN s ==> y <= x))
7058Proof
7059 rpt strip_tac >>
7060 qabbrev_tac `m = MAX_SET s` >>
7061 rw[EQ_IMP_THM] >- rw[MAX_SET_DEF, Abbr‘m’] >>
7062 `m IN s /\ x <= m` by rw[MAX_SET_DEF, Abbr`m`] >>
7063 `m <= x` by rw[] >>
7064 decide_tac
7065QED
7066
7067(* Theorem: s <> {} ==> !x. x IN s ==> ((MIN_SET s = x) <=> (!y. y IN s ==> x <= y)) *)
7068(* Proof:
7069 Let m = MIN_SET s.
7070 If part: y IN s ==> m <= y, true by MIN_SET_LEM
7071 Only-if part: !y. y IN s ==> x <= y ==> m = x
7072 Note m IN s /\ m <= x by MIN_SET_LEM
7073 and m IN s ==> x <= m by implication
7074 Hence x = m.
7075*)
7076Theorem MIN_SET_TEST_IFF:
7077 !s. s <> {} ==> !x. x IN s ==> ((MIN_SET s = x) <=> (!y. y IN s ==> x <= y))
7078Proof
7079 rpt strip_tac >>
7080 qabbrev_tac `m = MIN_SET s` >>
7081 rw[EQ_IMP_THM] >- rw[MIN_SET_LEM, Abbr‘m’] >>
7082 `m IN s /\ m <= x` by rw[MIN_SET_LEM, Abbr`m`] >>
7083 `x <= m` by rw[] >> decide_tac
7084QED
7085
7086(* Theorem: MAX_SET {} = 0 *)
7087(* Proof: by MAX_SET_REWRITES *)
7088Theorem MAX_SET_EMPTY = MAX_SET_REWRITES |> CONJUNCT1;
7089(* val MAX_SET_EMPTY = |- MAX_SET {} = 0: thm *)
7090
7091(* Theorem: MAX_SET {e} = e *)
7092(* Proof: by MAX_SET_REWRITES *)
7093Theorem MAX_SET_SING = MAX_SET_REWRITES |> CONJUNCT2 |> GEN_ALL;
7094(* val MAX_SET_SING = |- !e. MAX_SET {e} = e: thm *)
7095
7096(* Theorem: FINITE s /\ s <> {} ==> MAX_SET s IN s *)
7097(* Proof: by MAX_SET_DEF *)
7098Theorem MAX_SET_IN_SET:
7099 !s. FINITE s /\ s <> {} ==> MAX_SET s IN s
7100Proof
7101 rw[MAX_SET_DEF]
7102QED
7103
7104(* Theorem: FINITE s ==> !x. x IN s ==> x <= MAX_SET s *)
7105(* Proof: by in_max_set *)
7106Theorem MAX_SET_PROPERTY = in_max_set;
7107(* val MAX_SET_PROPERTY = |- !s. FINITE s ==> !x. x IN s ==> x <= MAX_SET s: thm *)
7108
7109(* Note: MIN_SET {} is undefined. *)
7110
7111(* Theorem: MIN_SET {e} = e *)
7112(* Proof: by MIN_SET_THM *)
7113Theorem MIN_SET_SING = MIN_SET_THM |> CONJUNCT1;
7114(* val MIN_SET_SING = |- !e. MIN_SET {e} = e: thm *)
7115
7116(* Theorem: s <> {} ==> MIN_SET s IN s *)
7117(* Proof: by MIN_SET_LEM *)
7118Theorem MIN_SET_IN_SET =
7119 MIN_SET_LEM |> SPEC_ALL |> UNDISCH |> CONJUNCT1 |> DISCH_ALL |> GEN_ALL;
7120(* val MIN_SET_IN_SET = |- !s. s <> {} ==> MIN_SET s IN s: thm *)
7121
7122(* Theorem: s <> {} ==> !x. x IN s ==> MIN_SET s <= x *)
7123(* Proof: by MIN_SET_LEM *)
7124Theorem MIN_SET_PROPERTY =
7125 MIN_SET_LEM |> SPEC_ALL |> UNDISCH |> CONJUNCT2 |> DISCH_ALL |> GEN_ALL;
7126(* val MIN_SET_PROPERTY =|- !s. s <> {} ==> !x. x IN s ==> MIN_SET s <= x: thm *)
7127
7128(* Theorem: FINITE s ==> ((MAX_SET s = 0) <=> (s = {}) \/ (s = {0})) *)
7129(* Proof:
7130 If part: MAX_SET s = 0 ==> (s = {}) \/ (s = {0})
7131 By contradiction, suppose s <> {} /\ s <> {0}.
7132 Then ?x. x IN s /\ x <> 0 by ONE_ELEMENT_SING
7133 Thus x <= MAX_SET s by in_max_set
7134 so MAX_SET s <> 0 by x <> 0
7135 This contradicts MAX_SET s = 0.
7136 Only-if part: (s = {}) \/ (s = {0}) ==> MAX_SET s = 0
7137 If s = {}, MAX_SET s = 0 by MAX_SET_EMPTY
7138 If s = {0}, MAX_SET s = 0 by MAX_SET_SING
7139*)
7140Theorem MAX_SET_EQ_0:
7141 !s. FINITE s ==> ((MAX_SET s = 0) <=> (s = {}) \/ (s = {0}))
7142Proof
7143 (rw[EQ_IMP_THM] >> simp[]) >>
7144 CCONTR_TAC >>
7145 `s <> {} /\ s <> {0}` by metis_tac[] >>
7146 `?x. x IN s /\ x <> 0` by metis_tac[ONE_ELEMENT_SING] >>
7147 `x <= MAX_SET s` by rw[in_max_set] >>
7148 decide_tac
7149QED
7150
7151(* Theorem: s <> {} ==> ((MIN_SET s = 0) <=> 0 IN s) *)
7152(* Proof:
7153 If part: MIN_SET s = 0 ==> 0 IN s
7154 This is true by MIN_SET_IN_SET.
7155 Only-if part: 0 IN s ==> MIN_SET s = 0
7156 Note MIN_SET s <= 0 by MIN_SET_LEM, 0 IN s
7157 Thus MIN_SET s = 0 by arithmetic
7158*)
7159Theorem MIN_SET_EQ_0:
7160 !s. s <> {} ==> ((MIN_SET s = 0) <=> 0 IN s)
7161Proof
7162 rw[EQ_IMP_THM] >-
7163 metis_tac[MIN_SET_IN_SET] >>
7164 `MIN_SET s <= 0` by rw[MIN_SET_LEM] >>
7165 decide_tac
7166QED
7167
7168(*---------------------------------------------------------------------------*)
7169(* POW s is the powerset of s *)
7170(*---------------------------------------------------------------------------*)
7171
7172Definition POW_DEF[nocompute]:
7173 POW set = {s | s SUBSET set}
7174End
7175
7176Theorem IN_POW:
7177 !set e. e IN POW set <=> e SUBSET set
7178Proof
7179 RW_TAC bool_ss [POW_DEF,GSPECIFICATION]
7180QED
7181
7182Theorem UNIV_FUN_TO_BOOL:
7183 univ(:'a -> bool) = POW univ(:'a)
7184Proof
7185 SIMP_TAC (srw_ss()) [EXTENSION, IN_POW]
7186QED
7187
7188Theorem SUBSET_POW:
7189 !s1 s2. s1 SUBSET s2 ==> (POW s1) SUBSET (POW s2)
7190Proof
7191 RW_TAC set_ss [POW_DEF,SUBSET_DEF]
7192QED
7193
7194Theorem SUBSET_INSERT_RIGHT:
7195 !e s1 s2. s1 SUBSET s2 ==> s1 SUBSET (e INSERT s2)
7196Proof
7197 RW_TAC set_ss [SUBSET_DEF,IN_INSERT]
7198QED
7199
7200Theorem SUBSET_DELETE_BOTH:
7201 !s1 s2 x. s1 SUBSET s2 ==> (s1 DELETE x) SUBSET (s2 DELETE x)
7202Proof
7203 RW_TAC set_ss [SUBSET_DEF,SUBSET_DELETE,IN_DELETE]
7204QED
7205
7206Theorem POW_EMPTY[simp]:
7207 !s. POW s <> {}
7208Proof
7209 SRW_TAC[][EXTENSION,IN_POW] THEN
7210 METIS_TAC[EMPTY_SUBSET]
7211QED
7212
7213Theorem EMPTY_IN_POW[simp]: !s. {} IN POW s
7214Proof
7215 RW_TAC std_ss [IN_POW, EMPTY_SUBSET]
7216QED
7217
7218(*---------------------------------------------------------------------------*)
7219(* Recursion equations for POW *)
7220(*---------------------------------------------------------------------------*)
7221
7222Theorem POW_INSERT:
7223 !e s. POW (e INSERT s) = IMAGE ($INSERT e) (POW s) UNION (POW s)
7224Proof
7225 RW_TAC set_ss [EXTENSION,IN_UNION,IN_POW] THEN
7226 Cases_on `e IN x` THENL
7227 [EQ_TAC THEN RW_TAC set_ss [] THENL
7228 [DISJ1_TAC
7229 THEN RW_TAC set_ss [IN_IMAGE,IN_POW]
7230 THEN Q.EXISTS_TAC `x DELETE e`
7231 THEN RW_TAC set_ss [INSERT_DELETE]
7232 THEN IMP_RES_TAC SUBSET_DELETE_BOTH
7233 THEN POP_ASSUM (MP_TAC o Q.SPEC `e`)
7234 THEN RW_TAC set_ss [DELETE_INSERT]
7235 THEN METIS_TAC [DELETE_SUBSET,SUBSET_TRANS],
7236 FULL_SIMP_TAC set_ss
7237 [IN_IMAGE,IN_POW,SUBSET_INSERT_RIGHT,INSERT_SUBSET,IN_INSERT],
7238 FULL_SIMP_TAC set_ss [SUBSET_DEF]
7239 THEN METIS_TAC [IN_INSERT]],
7240 RW_TAC set_ss [SUBSET_INSERT]
7241 THEN EQ_TAC THEN RW_TAC set_ss [IN_IMAGE]
7242 THEN METIS_TAC [IN_INSERT]]
7243QED
7244
7245Theorem POW_EQNS:
7246 (POW {} = {{}} : 'a set set) /\
7247 (!e:'a.
7248 !s. POW (e INSERT s) = let ps = POW s
7249 in (IMAGE ($INSERT e) ps) UNION ps)
7250Proof
7251 CONJ_TAC THENL
7252 [RW_TAC set_ss [POW_DEF,SUBSET_EMPTY,EXTENSION,NOT_IN_EMPTY,IN_INSERT],
7253 METIS_TAC [POW_INSERT,LET_THM]]
7254QED
7255
7256Theorem FINITE_POW:
7257 !s. FINITE s ==> FINITE (POW s)
7258Proof
7259 HO_MATCH_MP_TAC FINITE_INDUCT
7260 THEN CONJ_TAC THENL
7261 [METIS_TAC [POW_EQNS,FINITE_EMPTY,FINITE_INSERT],
7262 RW_TAC set_ss [POW_EQNS,LET_THM,FINITE_UNION,IMAGE_FINITE]]
7263QED
7264
7265Theorem FINITE_POW_EQN[simp]:
7266 FINITE (POW s) <=> FINITE s
7267Proof
7268 ‘FINITE (POW s) ==> FINITE s’ suffices_by METIS_TAC[FINITE_POW] >>
7269 CONV_TAC CONTRAPOS_CONV >> strip_tac >>
7270 ‘?t. INFINITE t /\ t SUBSET POW s’ suffices_by METIS_TAC[SUBSET_FINITE] >>
7271 Q.EXISTS_TAC ‘IMAGE (\e. {e}) s’ >> reverse conj_tac
7272 >- simp[SUBSET_DEF, PULL_EXISTS, IN_POW] >>
7273 ‘!x y. (\e. {e}) x = (\e. {e}) y <=> x = y’
7274 suffices_by (strip_tac >> drule INJECTIVE_IMAGE_FINITE >> simp[]) >>
7275 simp[]
7276QED
7277
7278Theorem lem[local]:
7279 !n. 2 * 2**n = 2**n + 2**n
7280Proof
7281 RW_TAC arith_ss [EXP]
7282QED
7283
7284(*---------------------------------------------------------------------------*)
7285(* Cardinality of the power set of a finite set *)
7286(*---------------------------------------------------------------------------*)
7287
7288Theorem CARD_POW:
7289 !s. FINITE s ==> (CARD (POW s) = 2 EXP (CARD s))
7290Proof
7291 SET_INDUCT_TAC
7292 THEN RW_TAC set_ss [POW_EQNS,LET_THM,EXP]
7293 THEN `FINITE (POW s) /\
7294 FINITE (IMAGE ($INSERT e) (POW s))`
7295 by METIS_TAC[FINITE_POW,IMAGE_FINITE]
7296 THEN `CARD (IMAGE ($INSERT e) (POW s) UNION POW s) =
7297 CARD (IMAGE ($INSERT e) (POW s)) + CARD(POW s)`
7298 by
7299 (`CARD ((IMAGE ($INSERT e) (POW s)) INTER (POW s)) = 0`
7300 by (RW_TAC set_ss [CARD_EQ_0,INTER_FINITE] THEN
7301 RW_TAC set_ss [EXTENSION,IN_INTER,IN_POW,IN_IMAGE] THEN
7302 RW_TAC set_ss [SUBSET_DEF,IN_INSERT] THEN METIS_TAC[])
7303 THEN METIS_TAC [CARD_UNION,ADD_CLAUSES])
7304 THEN POP_ASSUM SUBST_ALL_TAC
7305 THEN Q.PAT_X_ASSUM `X = 2 ** (CARD s)` (ASSUME_TAC o SYM)
7306 THEN ASM_REWRITE_TAC [lem, EQ_ADD_RCANCEL]
7307 THEN `BIJ ($INSERT e) (POW s) (IMAGE ($INSERT e) (POW s))`
7308 by (RW_TAC set_ss [BIJ_DEF,INJ_DEF,SURJ_DEF,IN_IMAGE,IN_POW]
7309 THENL
7310 [METIS_TAC [IN_POW],
7311 `~(e IN x) /\ ~(e IN y)` by METIS_TAC [SUBSET_DEF]
7312 THEN FULL_SIMP_TAC set_ss [EXTENSION, IN_INSERT]
7313 THEN METIS_TAC[],
7314 METIS_TAC [IN_POW],METIS_TAC[]])
7315 THEN METIS_TAC [FINITE_BIJ_CARD_EQ]
7316QED
7317
7318
7319(* ----------------------------------------------------------------------
7320 Simple lemmas about GSPECIFICATIONs
7321 ---------------------------------------------------------------------- *)
7322
7323val sspec_tac = CONV_TAC (DEPTH_CONV SET_SPEC_CONV)
7324
7325Theorem GSPEC_F:
7326 { x | F} = {}
7327Proof
7328 SRW_TAC [][EXTENSION] THEN sspec_tac THEN REWRITE_TAC []
7329QED
7330
7331Theorem GSPEC_T:
7332 {x | T} = UNIV
7333Proof
7334 SRW_TAC [][EXTENSION, IN_UNIV] THEN sspec_tac
7335QED
7336
7337Theorem GSPEC_ID:
7338 {x | x IN y} = y
7339Proof
7340 SRW_TAC [][EXTENSION] THEN sspec_tac THEN REWRITE_TAC []
7341QED
7342
7343Theorem GSPEC_EQ:
7344 { x | x = y} = {y}
7345Proof
7346 SRW_TAC [][EXTENSION] THEN sspec_tac THEN REWRITE_TAC []
7347QED
7348
7349Theorem GSPEC_EQ2:
7350 { x | y = x} = {y}
7351Proof
7352 SRW_TAC [][EXTENSION] THEN sspec_tac THEN EQ_TAC THEN STRIP_TAC THEN
7353 ASM_REWRITE_TAC []
7354QED
7355
7356val _ = export_rewrites ["GSPEC_F", "GSPEC_T", "GSPEC_ID", "GSPEC_EQ",
7357 "GSPEC_EQ2"]
7358
7359(* Following rewrites are useful, but probably not suitable for
7360 automatic application. Sadly even those above fail in the presence
7361 of more complicated GSPEC expressions, such as { (x,y) | F }.
7362
7363 We could cope with that particular example using the conditional
7364 rewrite below, but again, this is probably not suitable for
7365 automatic inclusion in rewrite sets *)
7366
7367Theorem GSPEC_F_COND:
7368 !f. (!x. ~SND (f x)) ==> (GSPEC f = {})
7369Proof
7370 SRW_TAC [][EXTENSION, GSPECIFICATION] THEN
7371 POP_ASSUM (Q.SPEC_THEN `x'` MP_TAC) THEN
7372 Cases_on `f x'` THEN SRW_TAC [][]
7373QED
7374
7375Theorem GSPEC_AND:
7376 !P Q. {x | P x /\ Q x} = {x | P x} INTER {x | Q x}
7377Proof
7378 SRW_TAC [][EXTENSION] THEN sspec_tac THEN REWRITE_TAC []
7379QED
7380
7381Theorem GSPEC_OR:
7382 !P Q. {x | P x \/ Q x} = {x | P x} UNION {x | Q x}
7383Proof
7384 SRW_TAC [][EXTENSION, IN_UNION] THEN sspec_tac THEN REWRITE_TAC []
7385QED
7386
7387(* ----------------------------------------------------------------------
7388 partition a set according to an equivalence relation (or at least
7389 a relation that is reflexive, symmetric and transitive over that set)
7390 ---------------------------------------------------------------------- *)
7391
7392Definition equiv_on_def[nocompute]:
7393 (equiv_on) R s <=>
7394 (!x. x IN s ==> R x x) /\
7395 (!x y. x IN s /\ y IN s ==> (R x y = R y x)) /\
7396 (!x y z. x IN s /\ y IN s /\ z IN s /\ R x y /\ R y z ==> R x z)
7397End
7398val _ = set_fixity "equiv_on" (Infix(NONASSOC, 425))
7399
7400Theorem inv_image_equiv_on:
7401 !R Y f. R equiv_on Y ==>
7402 inv_image R f equiv_on { x | f x IN Y }
7403Proof
7404 rw[equiv_on_def]
7405 \\ METIS_TAC[]
7406QED
7407
7408(* Theorem: R equiv_on s /\ t SUBSET s ==> R equiv_on t *)
7409(* Proof: by equiv_on_def, SUBSET_DEF *)
7410Theorem equiv_on_subset:
7411 !R s t. R equiv_on s /\ t SUBSET s ==> R equiv_on t
7412Proof
7413 rw_tac std_ss[equiv_on_def, SUBSET_DEF] >>
7414 METIS_TAC[]
7415QED
7416
7417(* Overload equivalence class of a relation *)
7418Overload "equiv_class" = ``\R s x. {y | y IN s /\ R x y}``
7419
7420(* Theorem: R equiv_on s /\ x IN s /\ y IN s ==>
7421 ((equiv_class R s x = equiv_class R s y) <=> R x y) *)
7422(* Proof: by equiv_on_def, EXTENSION. *)
7423Theorem equiv_class_eq:
7424 !R s x y. R equiv_on s /\ x IN s /\ y IN s ==>
7425 ((equiv_class R s x = equiv_class R s y) <=> R x y)
7426Proof
7427 rw[equiv_on_def, EXTENSION] >>
7428 METIS_TAC[]
7429QED
7430
7431Definition partition_def[nocompute]:
7432 partition R s =
7433 { t | ?x. x IN s /\ (t = { y | y IN s /\ R x y})}
7434End
7435
7436Theorem BIGUNION_partition:
7437 R equiv_on s ==> (BIGUNION (partition R s) = s)
7438Proof
7439 STRIP_TAC THEN
7440 SRW_TAC [][EXTENSION, IN_BIGUNION, partition_def] THEN
7441 EQ_TAC THEN STRIP_TAC THENL[
7442 METIS_TAC [equiv_on_def],
7443 Q.EXISTS_TAC `{ y | R x y /\ y IN s}` THEN
7444 `R x x` by METIS_TAC [equiv_on_def] THEN SRW_TAC [][] THEN
7445 METIS_TAC []
7446 ]
7447QED
7448
7449Theorem EMPTY_NOT_IN_partition:
7450 R equiv_on s ==> ~({} IN partition R s)
7451Proof
7452 SRW_TAC [][partition_def, EXTENSION] THEN
7453 METIS_TAC [equiv_on_def]
7454QED
7455
7456(* Invocation(s) of PROVE_TAC are slow, but METIS seems to be
7457 possibly slower
7458*)
7459Theorem partition_elements_disjoint:
7460 R equiv_on s ==>
7461 !t1 t2. t1 IN partition R s /\ t2 IN partition R s /\ ~(t1 = t2) ==>
7462 DISJOINT t1 t2
7463Proof
7464 STRIP_TAC THEN SIMP_TAC (srw_ss()) [partition_def] THEN
7465 REPEAT GEN_TAC THEN
7466 DISCH_THEN (CONJUNCTS_THEN2
7467 (Q.X_CHOOSE_THEN `a` MP_TAC)
7468 (CONJUNCTS_THEN2
7469 (Q.X_CHOOSE_THEN `b` MP_TAC) MP_TAC)) THEN
7470 MAP_EVERY Q.ID_SPEC_TAC [`t1`, `t2`] THEN SIMP_TAC (srw_ss()) [] THEN
7471 SRW_TAC [][DISJOINT_DEF] THEN
7472 SIMP_TAC (srw_ss()) [EXTENSION] THEN
7473 Q.X_GEN_TAC `c` THEN Cases_on `c IN s` THEN SRW_TAC [][] THEN
7474 Cases_on `R a c` THEN SRW_TAC [][] THEN
7475 STRIP_TAC THEN
7476 `R a b` by PROVE_TAC [equiv_on_def] THEN
7477 Q.PAT_X_ASSUM `S1 <> S2` MP_TAC THEN SRW_TAC [][] THEN
7478 SRW_TAC [][EXTENSION] THEN PROVE_TAC [equiv_on_def]
7479QED
7480
7481Theorem partition_elements_interrelate:
7482 R equiv_on s ==> !t. t IN partition R s ==>
7483 !x y. x IN t /\ y IN t ==> R x y
7484Proof
7485 SIMP_TAC (srw_ss()) [partition_def, GSYM LEFT_FORALL_IMP_THM] THEN
7486 PROVE_TAC [equiv_on_def]
7487QED
7488
7489Theorem partition_SUBSET:
7490 !R s t. t IN partition R s ==> t SUBSET s
7491Proof
7492 SRW_TAC [][partition_def, EXTENSION, EQ_IMP_THM] THEN
7493 METIS_TAC [SUBSET_DEF]
7494QED
7495
7496Theorem FINITE_partition:
7497 !R s. FINITE s ==>
7498 FINITE (partition R s) /\
7499 !t. t IN partition R s ==> FINITE t
7500Proof
7501 REPEAT GEN_TAC THEN STRIP_TAC THEN
7502 `!t. t IN partition R s ==> t SUBSET s` by METIS_TAC [partition_SUBSET] THEN
7503 `!t. t IN partition R s ==> t IN POW s` by SRW_TAC [][POW_DEF] THEN
7504 METIS_TAC [FINITE_POW, SUBSET_FINITE, SUBSET_DEF]
7505QED
7506
7507Theorem partition_CARD:
7508 !R s. R equiv_on s /\ FINITE s
7509 ==>
7510 (CARD s = SUM_IMAGE CARD (partition R s))
7511Proof
7512METIS_TAC [FINITE_partition, BIGUNION_partition, DISJ_BIGUNION_CARD,
7513 partition_elements_disjoint, FINITE_BIGUNION, partition_def]
7514QED
7515
7516Theorem partition_rel_eq:
7517 !R1 R2 Y.
7518 R1 equiv_on Y /\ R2 equiv_on Y /\
7519 partition R1 Y = partition R2 Y ==>
7520 (!x y. x IN Y /\ y IN Y ==> R1 x y = R2 x y)
7521Proof
7522 rpt gen_tac
7523 \\ Q.HO_MATCH_ABBREV_TAC`P R1 R2 ==> _`
7524 \\ `!R1 R2 x y. P R1 R2 /\ x IN Y /\ y IN Y /\ R1 x y ==> R2 x y`
7525 suffices_by (simp[Abbr`P`] \\ PROVE_TAC[])
7526 \\ ASM_SIMP_TAC(srw_ss()++boolSimps.DNF_ss)
7527 [Abbr`P`, partition_def, Once SET_EQ_SUBSET, SUBSET_DEF]
7528 \\ rw[]
7529 \\ last_assum drule
7530 \\ disch_then(Q.X_CHOOSE_THEN`z`strip_assume_tac)
7531 \\ `x IN equiv_class R1 Y y` by ( simp[] \\ METIS_TAC[equiv_on_def] )
7532 \\ `y IN equiv_class R1 Y y` by ( simp[] \\ METIS_TAC[equiv_on_def] )
7533 \\ `z IN equiv_class R2 Y z` by ( simp[] \\ METIS_TAC[equiv_on_def] )
7534 \\ `x IN equiv_class R2 Y z` by METIS_TAC[]
7535 \\ `y IN equiv_class R2 Y z` by METIS_TAC[]
7536 \\ fs[] \\ PROVE_TAC[equiv_on_def]
7537QED
7538
7539Definition partitions_def:
7540 partitions X Y = ?R. R equiv_on Y /\ X = partition R Y
7541End
7542
7543val _ = set_fixity "partitions" (Infix(NONASSOC, 425));
7544
7545Theorem partitions_thm:
7546 !X Y. X partitions Y <=>
7547 ((!x. x IN X ==> x <> {} /\ x SUBSET Y) /\
7548 (!y. y IN Y ==> ?!x. x IN X /\ y IN x))
7549Proof
7550 rpt gen_tac \\ simp[partitions_def]
7551 \\ eq_tac \\ strip_tac
7552 >- (
7553 simp[partition_def]
7554 \\ conj_tac
7555 >- (
7556 CCONTR_TAC \\ fs[]
7557 \\ pop_assum mp_tac
7558 \\ simp[GSYM MEMBER_NOT_EMPTY, SUBSET_DEF]
7559 \\ METIS_TAC[equiv_on_def] )
7560 \\ rpt strip_tac
7561 \\ simp[EXISTS_UNIQUE_THM, PULL_EXISTS]
7562 \\ Q.EXISTS_TAC`y`
7563 \\ rw[]
7564 >- METIS_TAC[equiv_on_def]
7565 \\ METIS_TAC[equiv_class_eq])
7566 \\ fs[EXISTS_UNIQUE_ALT]
7567 \\ fs[Once (GSYM RIGHT_EXISTS_IMP_THM)]
7568 \\ fs[SKOLEM_THM]
7569 \\ Q.EXISTS_TAC`\y z. f y = f z`
7570 \\ simp[equiv_on_def]
7571 \\ conj_tac >- METIS_TAC[]
7572 \\ simp[partition_def, Once EXTENSION]
7573 \\ rw[EQ_IMP_THM]
7574 >- (
7575 `?a. a IN x /\ a IN Y` by METIS_TAC[MEMBER_NOT_EMPTY, SUBSET_DEF]
7576 \\ Q.EXISTS_TAC`a` \\ simp[]
7577 \\ `f a = x` by METIS_TAC[]
7578 \\ simp[EXTENSION]
7579 \\ METIS_TAC[SUBSET_DEF] )
7580 \\ `f y IN X /\ y IN f y` by METIS_TAC[]
7581 \\ Q.MATCH_ABBREV_TAC `z IN X`
7582 \\ `z = f y` suffices_by rw[]
7583 \\ rw[Abbr`z`, EXTENSION]
7584 \\ reverse(Cases_on`x IN Y`) \\ simp[]
7585 >- METIS_TAC[SUBSET_DEF]
7586 \\ METIS_TAC[]
7587QED
7588
7589Theorem partitions_FINITE:
7590 !X Y. X partitions Y /\ FINITE Y ==>
7591 FINITE X /\ (!s. s IN X ==> FINITE s)
7592Proof
7593 rw[partitions_def]
7594 \\ METIS_TAC[FINITE_partition]
7595QED
7596
7597Theorem partitions_DISJOINT:
7598 !v w s1 s2.
7599 v partitions w /\ s1 IN v /\ s2 IN v /\ s1 <> s2 ==>
7600 DISJOINT s1 s2
7601Proof
7602 rw[partitions_thm, IN_DISJOINT]
7603 \\ fs[EXISTS_UNIQUE_ALT, SUBSET_DEF]
7604 \\ METIS_TAC[]
7605QED
7606
7607Theorem partitions_empty[simp]:
7608 !v. v partitions {} <=> v = {}
7609Proof
7610 rw[partitions_thm, EQ_IMP_THM]
7611 \\ CCONTR_TAC
7612 \\ fs[GSYM MEMBER_NOT_EMPTY]
7613 \\ res_tac \\ fs[]
7614QED
7615
7616Theorem empty_partitions[simp]:
7617 !s. {} partitions s <=> s = {}
7618Proof
7619 rw[partitions_thm, EXTENSION]
7620QED
7621
7622Theorem partitions_inj:
7623 !x w1 w2. x partitions w1 /\ x partitions w2 ==> w1 = w2
7624Proof
7625 rw[partitions_thm]
7626 \\ rw[SET_EQ_SUBSET]
7627 \\ fs[SUBSET_DEF, EXISTS_UNIQUE_THM] \\ REV_FULL_SIMP_TAC(srw_ss())[]
7628QED
7629
7630Theorem partitions_covers:
7631 !x y. x partitions y ==> BIGUNION x = y
7632Proof
7633 rw[partitions_def]
7634 \\ irule BIGUNION_partition
7635 \\ rw[]
7636QED
7637
7638Theorem partitions_PAIR_DISJOINT:
7639 !x y. x partitions y <=>
7640 {} NOTIN x /\
7641 (!s t. s IN x /\ t IN x /\ ~(s = t) ==> DISJOINT s t) /\
7642 BIGUNION x = y
7643Proof
7644 rw[EQ_IMP_THM]
7645 >- METIS_TAC[partitions_thm]
7646 >- METIS_TAC[partitions_DISJOINT]
7647 >- METIS_TAC[partitions_covers]
7648 \\ rw[partitions_thm]
7649 >- METIS_TAC[]
7650 >- (simp[SUBSET_DEF, PULL_EXISTS] \\ METIS_TAC[])
7651 \\ simp[EXISTS_UNIQUE_THM]
7652 \\ conj_tac >- METIS_TAC[]
7653 \\ METIS_TAC[IN_DISJOINT]
7654QED
7655
7656Theorem partitions_SING:
7657 !v x. SING x ==>
7658 (v partitions x <=> v = {{CHOICE x}})
7659Proof
7660 rw[SING_DEF, partitions_thm, SUBSET_DEF] \\ rw[]
7661 \\ rw[EQ_IMP_THM, EXISTS_UNIQUE_THM]
7662 \\ rw[Once EXTENSION]
7663 \\ rw[EQ_IMP_THM]
7664 \\ res_tac \\ fs[]
7665 \\ simp[Once EXTENSION]
7666 \\ rw[EQ_IMP_THM]
7667 \\ fs[GSYM MEMBER_NOT_EMPTY]
7668 \\ res_tac \\ fs[] \\ rw[]
7669 \\ Q.MATCH_RENAME_TAC`{a} IN v`
7670 \\ `{a} = x` suffices_by rw[]
7671 \\ rw[Once EXTENSION, EQ_IMP_THM]
7672 \\ res_tac \\ fs[]
7673QED
7674
7675Theorem SING_partitions:
7676 !x w. {x} partitions w <=> x = w /\ w <> {}
7677Proof
7678 rw[partitions_thm]
7679 \\ rw[EQ_IMP_THM]
7680 >- ( rw[SET_EQ_SUBSET] \\ rw[SUBSET_DEF] \\ fs[EXISTS_UNIQUE_THM] )
7681 >- ( strip_tac \\ fs[] )
7682 \\ simp[EXISTS_UNIQUE_THM]
7683QED
7684
7685Theorem INJ_IMAGE_equiv_class:
7686 !f s t x. INJ f s t /\ x IN s ==>
7687 IMAGE f (equiv_class R s x) =
7688 equiv_class (inv_image R (LINV f s)) (IMAGE f s) (f x)
7689Proof
7690 rw[Once EXTENSION]
7691 \\ imp_res_tac LINV_DEF
7692 \\ rw[EQ_IMP_THM]
7693 \\ METIS_TAC[LINV_DEF]
7694QED
7695
7696Theorem IMAGE_IMAGE_partition:
7697 !R f s t. INJ f s t ==>
7698 IMAGE (IMAGE f) (partition R s) =
7699 partition (inv_image R (LINV f s)) (IMAGE f s)
7700Proof
7701 rw[partition_def, Once EXTENSION]
7702 \\ rw[Once EQ_IMP_THM]
7703 >- (
7704 imp_res_tac INJ_IMAGE_equiv_class
7705 \\ fs[] \\ METIS_TAC[] )
7706 \\ simp[PULL_EXISTS]
7707 \\ imp_res_tac INJ_IMAGE_equiv_class
7708 \\ simp[]
7709 \\ simp[Once EXTENSION]
7710 \\ METIS_TAC[LINV_DEF]
7711QED
7712
7713Theorem BIJ_IMAGE_partitions:
7714 !f x y v. BIJ f x y /\ v partitions x ==>
7715 IMAGE (IMAGE f) v partitions y
7716Proof
7717 rw[partitions_def]
7718 \\ Q.EXISTS_TAC`inv_image R (LINV f x)`
7719 \\ fs[BIJ_DEF]
7720 \\ fs[IMAGE_SURJ]
7721 \\ imp_res_tac IMAGE_IMAGE_partition
7722 \\ fs[] \\ REV_FULL_SIMP_TAC(srw_ss())[]
7723 \\ drule inv_image_equiv_on
7724 \\ disch_then(Q.SPEC_THEN`LINV f x`strip_assume_tac)
7725 \\ irule equiv_on_subset
7726 \\ goal_assum(first_assum o mp_then Any mp_tac)
7727 \\ rw[SUBSET_DEF]
7728 \\ METIS_TAC[LINV_DEF]
7729QED
7730
7731Theorem partitions_INSERT:
7732 !x w v. x NOTIN w ==>
7733 (v partitions (x INSERT w) <=>
7734 (?u s. u partitions w /\ v = (x INSERT s) INSERT (u DELETE s) /\
7735 (s <> {} ==> s IN u)))
7736Proof
7737 rw[partitions_thm]
7738 \\ EQ_TAC \\ strip_tac
7739 >- (
7740 pop_assum mp_tac \\ ASM_SIMP_TAC(srw_ss()++boolSimps.DNF_ss)[]
7741 \\ strip_tac
7742 \\ fs[EXISTS_UNIQUE_ALT]
7743 \\ Q.MATCH_ASMSUB_RENAME_TAC`_ <=> s = _`
7744 \\ `x IN s /\ s IN v` by METIS_TAC[]
7745 \\ Q.EXISTS_TAC`if SING s then v DELETE s
7746 else (s DELETE x) INSERT (v DELETE s)`
7747 \\ Q.EXISTS_TAC`s DELETE x`
7748 \\ IF_CASES_TAC \\ fs[SING_DEF]
7749 \\ ASM_SIMP_TAC(srw_ss()++boolSimps.DNF_ss)[] \\ fs[]
7750 >- (
7751 fs[SUBSET_DEF, PULL_EXISTS]
7752 \\ rw[]
7753 \\ TRY (`y NOTIN {x}` by (strip_tac \\ fs[]))
7754 \\ simp[Once EXTENSION]
7755 \\ METIS_TAC[])
7756 \\ fs[SUBSET_DEF, PULL_EXISTS, GSYM CONJ_ASSOC]
7757 \\ REV_FULL_SIMP_TAC(srw_ss())[]
7758 \\ conj_tac >- METIS_TAC[DELETE_EQ_SING]
7759 \\ conj_tac >- METIS_TAC[]
7760 \\ conj_tac >- METIS_TAC[]
7761 \\ conj_tac >- METIS_TAC[]
7762 \\ reverse conj_tac
7763 >- (
7764 ASM_SIMP_TAC(srw_ss()++boolSimps.DNF_ss)[Once EXTENSION]
7765 \\ rw[EQ_IMP_THM] \\ rw[INSERT_DELETE]
7766 \\ CCONTR_TAC \\ fs[] \\ REV_FULL_SIMP_TAC(srw_ss())[]
7767 \\ pop_assum mp_tac
7768 \\ FULL_SIMP_TAC(srw_ss()++boolSimps.DNF_ss)[Once EQ_IMP_THM]
7769 \\ `s <> {x}` by METIS_TAC[]
7770 \\ `s DELETE x <> {}` by (fs[EXTENSION] \\ METIS_TAC[])
7771 \\ `?z. z IN s DELETE x` by METIS_TAC[MEMBER_NOT_EMPTY]
7772 \\ `z <> x` by fs[]
7773 \\ `z IN w` by METIS_TAC[IN_DELETE]
7774 \\ first_x_assum drule
7775 \\ strip_tac
7776 \\ `z IN s` by fs[]
7777 \\ METIS_TAC[])
7778 \\ rw[] \\ rw[INSERT_SUBSET, NOT_EMPTY_INSERT]
7779 \\ first_x_assum drule
7780 \\ disch_then(Q.X_CHOOSE_THEN`z`strip_assume_tac)
7781 \\ ASM_SIMP_TAC(srw_ss()++boolSimps.DNF_ss)[EQ_IMP_THM]
7782 \\ `y <> x` by METIS_TAC[] \\ fs[]
7783 \\ Cases_on`y IN s` \\ fs[]
7784 >- ( disj1_tac \\ rw[] \\ METIS_TAC[] )
7785 \\ Q.EXISTS_TAC`z`
7786 \\ METIS_TAC[])
7787 \\ ASM_SIMP_TAC(srw_ss()++boolSimps.DNF_ss)[]
7788 \\ fs[SUBSET_DEF, GSYM CONJ_ASSOC]
7789 \\ conj_tac >- METIS_TAC[NOT_IN_EMPTY]
7790 \\ conj_tac >- METIS_TAC[]
7791 \\ fs[EXISTS_UNIQUE_THM, GSYM CONJ_ASSOC]
7792 \\ conj_tac >- ASM_SIMP_TAC(srw_ss()++boolSimps.DNF_ss)[]
7793 \\ conj_tac >- (
7794 rw[] \\ REV_FULL_SIMP_TAC(srw_ss())[GSYM MEMBER_NOT_EMPTY, PULL_EXISTS]
7795 \\ METIS_TAC[] )
7796 \\ rw[] \\ ASM_SIMP_TAC(srw_ss()++boolSimps.DNF_ss)[]
7797 \\ REV_FULL_SIMP_TAC(srw_ss())[GSYM MEMBER_NOT_EMPTY, PULL_EXISTS]
7798 \\ METIS_TAC[]
7799QED
7800
7801Theorem FINITE_partitions:
7802 !x. FINITE x ==> FINITE { v | v partitions x }
7803Proof
7804 ho_match_mp_tac FINITE_INDUCT
7805 \\ rw[partitions_empty, partitions_INSERT]
7806 \\ Q.MATCH_ASSUM_ABBREV_TAC`FINITE px`
7807 \\ Q.ABBREV_TAC`ss = {} INSERT BIGUNION px`
7808 \\ `FINITE (px CROSS ss)` by (
7809 simp[Abbr`ss`, Abbr`px`]
7810 \\ METIS_TAC[partitions_FINITE])
7811 \\ `FINITE (IMAGE (\(u,s). (e INSERT s) INSERT u DELETE s) (px CROSS ss))`
7812 by simp[FINITE_CROSS, IMAGE_FINITE]
7813 \\ irule SUBSET_FINITE
7814 \\ goal_assum(first_assum o mp_then Any mp_tac)
7815 \\ simp[SUBSET_DEF, PULL_EXISTS, EXISTS_PROD]
7816 \\ simp[Abbr`px`, Abbr`ss`]
7817 \\ METIS_TAC[]
7818QED
7819
7820Definition part_def:
7821 part v x = @s. x IN s /\ s IN v
7822End
7823
7824Theorem part_in_partition:
7825 !w v x. v partitions w /\ x IN w ==>
7826 part v x IN v
7827Proof
7828 rw[part_def]
7829 \\ SELECT_ELIM_TAC
7830 \\ fs[partitions_thm, EXISTS_UNIQUE_THM]
7831 \\ METIS_TAC[]
7832QED
7833
7834Theorem part_partition:
7835 !R w y. y IN w /\ R equiv_on w ==>
7836 part (partition R w) y = { x | x IN w /\ R x y }
7837Proof
7838 strip_tac
7839 \\ rw[part_def]
7840 \\ SELECT_ELIM_TAC
7841 \\ simp[partition_def, PULL_EXISTS]
7842 \\ Q.EXISTS_TAC`y`
7843 \\ conj_tac >- fs[equiv_on_def]
7844 \\ simp[]
7845 \\ simp[Once EXTENSION]
7846 \\ Q.X_GEN_TAC`x` \\ strip_tac
7847 \\ fs[equiv_on_def]
7848 \\ METIS_TAC[]
7849QED
7850
7851Theorem part_unique:
7852 !w v x s. v partitions w /\ x IN w /\ x IN s /\ s IN v ==>
7853 s = part v x
7854Proof
7855 rw[part_def]
7856 \\ SELECT_ELIM_TAC
7857 \\ fs[partitions_thm, EXISTS_UNIQUE_THM]
7858 \\ METIS_TAC[]
7859QED
7860
7861Theorem in_part:
7862 !w v x. v partitions w /\ x IN w ==>
7863 x IN part v x
7864Proof
7865 rw[part_def, partitions_thm]
7866 \\ SELECT_ELIM_TAC
7867 \\ METIS_TAC[EXISTS_UNIQUE_THM]
7868QED
7869
7870Theorem part_SING:
7871 !x w. x IN w ==> part {w} x = w
7872Proof
7873 rw[part_def] \\ METIS_TAC[]
7874QED
7875
7876Theorem equivalence_same_part:
7877 equivalence (\x y. part v x = part v y)
7878Proof
7879 rw[ALT_equivalence]
7880 \\ rw[Once FUN_EQ_THM, SimpRHS]
7881 \\ rw[EQ_IMP_THM]
7882QED
7883
7884Definition refines_def:
7885 refines v1 v2 <=>
7886 !s1. s1 IN v1 ==> ?s2. s2 IN v2 /\ s1 SUBSET s2
7887End
7888
7889val _ = set_fixity "refines" (Infix(NONASSOC, 425));
7890
7891Theorem empty_refines[simp]:
7892 !v. {} refines v
7893Proof
7894 rw[refines_def]
7895QED
7896
7897Theorem refines_grows_parts:
7898 !w v1 v2. v1 partitions w /\ v2 partitions w ==>
7899 (v1 refines v2 <=>
7900 (!x y. x IN w /\ y IN w /\ part v1 x = part v1 y ==>
7901 part v2 x = part v2 y))
7902Proof
7903 rpt gen_tac \\ strip_tac
7904 \\ rw[refines_def]
7905 \\ rw[EQ_IMP_THM]
7906 >- (
7907 `part v1 x IN v1` by METIS_TAC[part_in_partition]
7908 \\ `?s2. s2 IN v2 /\ part v1 x SUBSET s2` by METIS_TAC[]
7909 \\ `x IN part v1 x` by METIS_TAC[in_part]
7910 \\ `x IN s2` by METIS_TAC[SUBSET_DEF]
7911 \\ `s2 = part v2 x` by METIS_TAC[part_unique]
7912 \\ `y IN part v1 y` by METIS_TAC[in_part]
7913 \\ `y IN s2` by METIS_TAC[SUBSET_DEF]
7914 \\ METIS_TAC[part_unique])
7915 \\ `s1 <> {}` by METIS_TAC[partitions_thm]
7916 \\ `?x. x IN s1` by METIS_TAC[MEMBER_NOT_EMPTY]
7917 \\ Q.EXISTS_TAC`part v2 x`
7918 \\ `x IN w` by METIS_TAC[partitions_thm, SUBSET_DEF]
7919 \\ conj_asm1_tac >- METIS_TAC[part_in_partition]
7920 \\ simp[SUBSET_DEF]
7921 \\ Q.X_GEN_TAC`y`
7922 \\ strip_tac
7923 \\ `s1 = part v1 x` by METIS_TAC[part_unique]
7924 \\ `y IN w` by METIS_TAC[partitions_thm, SUBSET_DEF]
7925 \\ `s1 = part v1 y` by METIS_TAC[part_unique]
7926 \\ METIS_TAC[in_part]
7927QED
7928
7929Theorem refines_refl[simp]:
7930 !v. v refines v
7931Proof
7932 rw[refines_def]
7933 \\ METIS_TAC[SUBSET_REFL]
7934QED
7935
7936Theorem refines_transitive:
7937 !v1 v2 v3. v1 refines v2 /\ v2 refines v3 ==> v1 refines v3
7938Proof
7939 rw[refines_def]
7940 \\ METIS_TAC[SUBSET_TRANS]
7941QED
7942
7943Theorem refines_antisym:
7944 !w v1 v2. v1 partitions w /\ v2 partitions w /\
7945 v1 refines v2 /\ v2 refines v1 ==> v1 = v2
7946Proof
7947 rpt gen_tac \\ Q.HO_MATCH_ABBREV_TAC`P v1 v2 ==> v1 = v2`
7948 \\ `!v1 v2. P v1 v2 ==> v1 SUBSET v2` suffices_by (
7949 simp[Abbr`P`] \\ METIS_TAC[SET_EQ_SUBSET])
7950 \\ rw[Abbr`P`, SUBSET_DEF]
7951 \\ fs[refines_def]
7952 \\ `?a. a IN w /\ a IN x`
7953 by METIS_TAC[partitions_thm, MEMBER_NOT_EMPTY, SUBSET_DEF]
7954 \\ `x = part v1 a` by METIS_TAC[part_unique]
7955 \\ res_tac
7956 \\ `a IN s2` by METIS_TAC[SUBSET_DEF]
7957 \\ `s2 = part v2 a` by METIS_TAC[part_unique]
7958 \\ `?y. y IN v1 /\ s2 SUBSET y` by METIS_TAC[]
7959 \\ `a IN y` by METIS_TAC[SUBSET_DEF]
7960 \\ `y = part v1 a` by METIS_TAC[part_unique]
7961 \\ `s2 = part v1 a` by METIS_TAC[SUBSET_ANTISYM]
7962 \\ METIS_TAC[part_in_partition]
7963QED
7964
7965(* ----------------------------------------------------------------------
7966 Assert a predicate on all pairs of elements in a set.
7967 Take the RC of the P argument to consider only pairs of distinct elements.
7968 ---------------------------------------------------------------------- *)
7969
7970Definition pairwise_def[nocompute]:
7971 pairwise P s = !e1 e2. e1 IN s /\ e2 IN s ==> P e1 e2
7972End
7973
7974Theorem pairwise_UNION:
7975 pairwise R (s1 UNION s2) <=>
7976 pairwise R s1 /\ pairwise R s2 /\ (!x y. x IN s1 /\ y IN s2 ==> R x y /\ R y x)
7977Proof
7978SRW_TAC [boolSimps.DNF_ss][pairwise_def] THEN METIS_TAC []
7979QED
7980
7981Theorem pairwise_SUBSET:
7982 !R s t. pairwise R t /\ s SUBSET t ==> pairwise R s
7983Proof
7984SRW_TAC [][SUBSET_DEF,pairwise_def]
7985QED
7986
7987Theorem pairwise_EMPTY :
7988 !r. pairwise r {}
7989Proof
7990 REWRITE_TAC[pairwise_def, NOT_IN_EMPTY] THEN MESON_TAC[]
7991QED
7992
7993(* ------------------------------------------------------------------------- *)
7994(* Disjoint system of sets (‘disjoint’, originally from Isabelle/HOL) *)
7995(* ------------------------------------------------------------------------- *)
7996
7997Definition disjoint :
7998 disjoint = pairwise (RC DISJOINT)
7999End
8000
8001Theorem disjoint_def :
8002 !A. disjoint A = !a b. a IN A /\ b IN A /\ (a <> b) ==> DISJOINT a b
8003Proof
8004 RW_TAC std_ss [disjoint, pairwise_def, RC_DEF]
8005 >> METIS_TAC []
8006QED
8007
8008Theorem disjointI :
8009 !A. (!a b . a IN A ==> b IN A ==> (a <> b) ==> DISJOINT a b) ==> disjoint A
8010Proof
8011 METIS_TAC [disjoint_def]
8012QED
8013
8014Theorem disjointD :
8015 !A a b. disjoint A ==> a IN A ==> b IN A ==> (a <> b) ==> DISJOINT a b
8016Proof
8017 METIS_TAC [disjoint_def]
8018QED
8019
8020Theorem disjoint_empty :
8021 disjoint {}
8022Proof
8023 rw [disjoint, pairwise_EMPTY]
8024QED
8025
8026Theorem disjoint_sing :
8027 !a. disjoint {a}
8028Proof
8029 rw [disjoint_def]
8030QED
8031
8032Theorem disjoint_same :
8033 !s t. (s = t) ==> disjoint {s; t}
8034Proof
8035 RW_TAC std_ss [IN_INSERT, IN_SING, disjoint_def]
8036QED
8037
8038Theorem disjoint_two :
8039 !s t. s <> t /\ DISJOINT s t ==> disjoint {s; t}
8040Proof
8041 RW_TAC std_ss [IN_INSERT, IN_SING, disjoint_def]
8042 >> ASM_REWRITE_TAC [DISJOINT_SYM]
8043QED
8044
8045Theorem disjoint_union :
8046 !A B. disjoint A /\ disjoint B /\ (BIGUNION A INTER BIGUNION B = {}) ==>
8047 disjoint (A UNION B)
8048Proof
8049 rw [disjoint_def, DISJOINT_DEF] >> rw []
8050 >> (Q.PAT_X_ASSUM ‘_ = {}’ MP_TAC >>
8051 rw [Once EXTENSION, IN_BIGUNION] \\
8052 rw [Once EXTENSION] >> METIS_TAC [])
8053QED
8054
8055Theorem disjoint_image :
8056 !f. (!i j. i <> j ==> DISJOINT (f i) (f j)) ==> disjoint (IMAGE f UNIV)
8057Proof
8058 rw [disjoint_def, DISJOINT_DEF]
8059 >> FIRST_X_ASSUM MATCH_MP_TAC
8060 >> CCONTR_TAC >> fs []
8061QED
8062
8063Theorem disjoint_insert_imp :
8064 !e c. disjoint (e INSERT c) ==> disjoint c
8065Proof
8066 rw [disjoint_def, DISJOINT_DEF]
8067QED
8068
8069Theorem disjoint_insert_notin :
8070 !e c. disjoint (e INSERT c) /\ e NOTIN c ==> !s. s IN c ==> DISJOINT e s
8071Proof
8072 rw [disjoint_def, DISJOINT_DEF]
8073 >> FIRST_X_ASSUM MATCH_MP_TAC >> rw []
8074 >> CCONTR_TAC >> fs []
8075QED
8076
8077Theorem disjoint_insert :
8078 !e c. disjoint c /\ (!x. x IN c ==> DISJOINT x e) ==> disjoint (e INSERT c)
8079Proof
8080 rw [disjoint_def, DISJOINT_DEF] >> rw []
8081 >> ONCE_REWRITE_TAC [INTER_COMM]
8082 >> FIRST_X_ASSUM MATCH_MP_TAC >> rw []
8083QED
8084
8085Theorem disjoint_restrict :
8086 !e c. disjoint c ==> disjoint (IMAGE ($INTER e) c)
8087Proof
8088 rw [disjoint_def, o_DEF, DISJOINT_DEF]
8089 >> ‘x <> x'’ by (CCONTR_TAC >> fs [])
8090 >> ‘e INTER x INTER (e INTER x') = e INTER (x INTER x')’
8091 by METIS_TAC [INTER_ASSOC, INTER_COMM, INTER_IDEMPOT]
8092 >> POP_ASSUM (fn th => ONCE_REWRITE_TAC [th])
8093 >> SUFF_TAC “x INTER x' = {}” >- rw []
8094 >> FIRST_X_ASSUM MATCH_MP_TAC >> rw []
8095QED
8096
8097(* ----------------------------------------------------------------------
8098 A proof of Kőnig's Lemma
8099 ---------------------------------------------------------------------- *)
8100
8101(* a counting exercise for R-trees. If x0 has finitely many successors, and
8102 each of these successors has finite trees underneath, then x0's tree is
8103 also finite *)
8104Theorem KL_lemma1[local]:
8105 FINITE { x | R x0 x} /\
8106 (!y. R x0 y ==> FINITE { x | RTC R y x }) ==>
8107 FINITE { x | RTC R x0 x}
8108Proof
8109 REPEAT STRIP_TAC THEN
8110 `{ x | RTC R x0 x} =
8111 x0 INSERT BIGUNION (IMAGE (\x. {y | RTC R x y}) {x | R x0 x})`
8112 by (REWRITE_TAC [EXTENSION] THEN
8113 SRW_TAC [][GSYM RIGHT_EXISTS_AND_THM, IN_BIGUNION, IN_IMAGE,
8114 GSPECIFICATION] THEN
8115 PROVE_TAC [RTC_CASES1]) THEN
8116 POP_ASSUM SUBST_ALL_TAC THEN SRW_TAC [][IN_IMAGE] THENL [
8117 SRW_TAC [][IMAGE_FINITE, IN_IMAGE, GSPECIFICATION],
8118 RES_TAC
8119 ]
8120QED
8121
8122
8123(*---------------------------------------------------------------------------*)
8124(* Effectively taking the contrapositive of the above, saying that if R is *)
8125(* finitely branching, and we're on top of an infinite R tree, then one of *)
8126(* the immediate children is on top of an infinite R tree *)
8127(*---------------------------------------------------------------------------*)
8128
8129Theorem KL_lemma2[local]:
8130 (!x. FINITE {y | R x y}) ==>
8131 !y. ~ FINITE {x | RTC R y x} ==> ?z. R y z /\ ~FINITE { x | RTC R z x}
8132Proof
8133 METIS_TAC [KL_lemma1]
8134QED
8135
8136(*---------------------------------------------------------------------------*)
8137(* Now throw in the unavoidable use of the axiom of choice, and say that *)
8138(* there's a function to do this for us. *)
8139(*---------------------------------------------------------------------------*)
8140
8141val KL_lemma3 =
8142 CONV_RULE (ONCE_DEPTH_CONV RIGHT_IMP_EXISTS_CONV THENC
8143 ONCE_DEPTH_CONV SKOLEM_CONV) KL_lemma2
8144
8145Theorem KoenigsLemma:
8146 !R. (!x. FINITE {y | R x y}) ==>
8147 !x. ~FINITE {y | RTC R x y} ==>
8148 ?f. (f 0 = x) /\ !n. R (f n) (f (SUC n))
8149Proof
8150 REPEAT STRIP_TAC THEN
8151 `?g. !y. ~FINITE { x | RTC R y x} ==>
8152 R y (g y) /\ ~FINITE {x | RTC R (g y) x}`
8153 by METIS_TAC [KL_lemma3] THEN
8154 Q.SPECL_THEN [`x`, `\n r. g r`]
8155 (Q.X_CHOOSE_THEN `f` STRIP_ASSUME_TAC o BETA_RULE)
8156 (TypeBase.axiom_of ``:num``) THEN
8157 Q.EXISTS_TAC `f` THEN ASM_REWRITE_TAC [] THEN
8158 Q_TAC SUFF_TAC
8159 `!n. R (f n) (g (f n)) /\ ~FINITE { x | RTC R (f n) x}` THEN1
8160 METIS_TAC [] THEN
8161 Induct THEN METIS_TAC []
8162QED
8163
8164Theorem KoenigsLemma_WF:
8165 !R. (!x. FINITE {y | R x y}) /\ WF (inv R) ==> !x. FINITE {y | RTC R x y}
8166Proof
8167 SRW_TAC [][WF_IFF_WELLFOUNDED, wellfounded_def, inv_DEF] THEN
8168 METIS_TAC [KoenigsLemma]
8169QED
8170
8171Theorem PSUBSET_EQN:
8172 !s1 s2. s1 PSUBSET s2 <=> s1 SUBSET s2 /\ ~(s2 SUBSET s1)
8173Proof PROVE_TAC [PSUBSET_DEF,SET_EQ_SUBSET]
8174QED
8175
8176Theorem PSUBSET_SUBSET_TRANS:
8177 !s t u. s PSUBSET t /\ t SUBSET u ==> s PSUBSET u
8178Proof
8179 PROVE_TAC [SUBSET_DEF,PSUBSET_EQN]
8180QED
8181
8182Theorem SUBSET_PSUBSET_TRANS:
8183 !s t u. s SUBSET t /\ t PSUBSET u ==> s PSUBSET u
8184Proof
8185 PROVE_TAC [SUBSET_DEF,PSUBSET_EQN]
8186QED
8187
8188Theorem CROSS_EQNS:
8189 !(s1:'a set) (s2:'b set).
8190 (({}:'a set) CROSS s2 = ({}:('a#'b) set)) /\
8191 ((a INSERT s1) CROSS s2 = (IMAGE (\y.(a,y)) s2) UNION (s1 CROSS s2))
8192Proof
8193RW_TAC set_ss [CROSS_EMPTY,Once CROSS_INSERT_LEFT]
8194 THEN MATCH_MP_TAC (PROVE [] (Term`(a=b) ==> (f a c = f b c)`))
8195 THEN RW_TAC set_ss [CROSS_DEF,IMAGE_DEF,EXTENSION]
8196 THEN METIS_TAC [ABS_PAIR_THM,IN_SING,FST,SND]
8197QED
8198
8199Theorem count_EQN:
8200 !n. count n = if n = 0 then {} else
8201 let p = PRE n in p INSERT (count p)
8202Proof
8203 REWRITE_TAC [count_def]
8204 THEN Induct
8205 THEN RW_TAC arith_ss [GSPEC_F]
8206 THEN RW_TAC set_ss [EXTENSION,IN_SING,IN_INSERT]
8207QED
8208
8209(* Theorems about countability added by Scott Owens on 2009-03-20, plus a few
8210* misc. theorems *)
8211
8212fun FSTAC thms = FULL_SIMP_TAC (srw_ss()) thms;
8213fun RWTAC thms = SRW_TAC [] thms;
8214
8215Theorem UNIQUE_MEMBER_SING:
8216 !x s. x IN s /\ (!y. y IN s ==> (x = y)) <=> (s = {x})
8217Proof
8218 SRW_TAC [] [EXTENSION] THEN METIS_TAC []
8219QED
8220
8221Theorem inj_surj:
8222 !f s t. INJ f s t ==> (s = {}) \/ ?f'. SURJ f' t s
8223Proof
8224RWTAC [INJ_DEF, SURJ_DEF, tautLib.TAUT ‘a \/ b <=> ~a ==> b’] THEN
8225`!x. ?y. y IN s /\ (x IN IMAGE f s ==> (f y = x))`
8226 by (RWTAC [] THEN
8227 Cases_on `x IN IMAGE f s` THEN
8228 FSTAC [IMAGE_DEF] THEN1
8229 METIS_TAC [] THEN
8230 Q.EXISTS_TAC `CHOICE s` THEN
8231 RWTAC [CHOICE_DEF] THEN
8232 METIS_TAC []) THEN
8233 FSTAC [SKOLEM_THM, IN_IMAGE] THEN
8234 METIS_TAC []
8235QED
8236
8237Theorem infinite_rest:
8238 !s. INFINITE s ==> INFINITE (REST s)
8239Proof
8240RWTAC [] THEN
8241CCONTR_TAC THEN
8242FSTAC [REST_DEF]
8243QED
8244
8245Definition chooser_def:
8246 (chooser s 0 = CHOICE s) /\
8247 (chooser s (SUC n) = chooser (REST s) n)
8248End
8249
8250Theorem chooser_lem1[local]:
8251 !n s t. INFINITE s /\ s SUBSET t ==> chooser s n IN t
8252Proof
8253Induct THEN
8254RWTAC [chooser_def, SUBSET_DEF] THENL [
8255 `s <> {}` by (RWTAC [EXTENSION] THEN METIS_TAC [INFINITE_INHAB]) THEN
8256 METIS_TAC [CHOICE_DEF],
8257 `REST s SUBSET s` by RWTAC [REST_SUBSET] THEN
8258 METIS_TAC [infinite_rest]
8259]
8260QED
8261
8262Theorem chooser_lem2[local]:
8263 !n s. INFINITE s ==> chooser (REST s) n <> CHOICE s
8264Proof
8265RWTAC [] THEN
8266IMP_RES_TAC infinite_rest THEN
8267`chooser (REST s) n IN (REST s)`
8268 by METIS_TAC [chooser_lem1, SUBSET_REFL] THEN
8269FSTAC [REST_DEF, IN_DELETE]
8270QED
8271
8272Theorem chooser_lem3[local]:
8273 !x y s. INFINITE s /\ (chooser s x = chooser s y) ==> (x = y)
8274Proof
8275Induct_on `x` THEN
8276RWTAC [chooser_def] THEN
8277Cases_on `y` THEN
8278FSTAC [chooser_def] THEN
8279RWTAC [] THEN
8280METIS_TAC [chooser_lem2, infinite_rest]
8281QED
8282
8283Theorem infinite_num_inj_lem[local]:
8284 !s. FINITE s ==> ~?f. INJ f (UNIV:num set) s
8285Proof
8286HO_MATCH_MP_TAC FINITE_INDUCT THEN
8287RWTAC [] THEN
8288FSTAC [INJ_DEF] THEN
8289CCONTR_TAC THEN
8290FSTAC [IN_UNIV] THEN
8291Q.PAT_X_ASSUM `!f. (?x. f x NOTIN s) \/ P f` MP_TAC THEN
8292RWTAC [] THEN
8293Cases_on `?y. f y = e` THEN
8294FSTAC [] THEN
8295RWTAC [] THENL [
8296 Q.EXISTS_TAC `\x. if x < y then f x else f (SUC x)` THEN
8297 RWTAC [] THEN
8298 FSTAC [DISJ_EQ_IMP] THEN
8299 RWTAC [] THENL [
8300 `x <> y` by DECIDE_TAC THEN METIS_TAC [],
8301 `SUC x <> y` by DECIDE_TAC THEN METIS_TAC [],
8302 `x = SUC y'` by METIS_TAC [] THEN DECIDE_TAC,
8303 `SUC x = y'` by METIS_TAC [] THEN DECIDE_TAC,
8304 `SUC x = SUC y'` by METIS_TAC [] THEN DECIDE_TAC
8305 ],
8306 METIS_TAC []
8307]
8308QED
8309
8310Theorem infinite_num_inj:
8311 !s. INFINITE s = ?f. INJ f (UNIV:num set) s
8312Proof
8313RWTAC [] THEN
8314EQ_TAC THEN
8315RWTAC [] THENL
8316[Q.EXISTS_TAC `chooser s` THEN
8317 RWTAC [INJ_DEF] THEN
8318 METIS_TAC [chooser_lem1, chooser_lem3, SUBSET_REFL],
8319 METIS_TAC [infinite_num_inj_lem]]
8320QED
8321
8322Definition countable_def:
8323 countable s = ?f. INJ f s (UNIV:num set)
8324End
8325
8326(* for HOL-Light compatibility, moved here from cardinalTheory *)
8327Overload COUNTABLE[inferior] = “countable”
8328
8329Theorem countable_image_nats[simp]:
8330 countable (IMAGE f univ(:num))
8331Proof SIMP_TAC
8332 (srw_ss())[countable_def] THEN METIS_TAC[SURJ_IMAGE, SURJ_INJ_INV]
8333QED
8334
8335Theorem countable_surj:
8336 !s. countable s <=> (s = {}) \/ ?f. SURJ f (UNIV:num set) s
8337Proof
8338RWTAC [countable_def] THEN
8339EQ_TAC THEN
8340RWTAC [] THENL
8341[METIS_TAC [inj_surj],
8342 RWTAC [INJ_DEF],
8343 Cases_on `s = {}` THEN
8344 FSTAC [INJ_DEF, SURJ_DEF] THEN
8345 METIS_TAC []]
8346QED
8347
8348Theorem num_countable:
8349 countable (UNIV:num set)
8350Proof
8351RWTAC [countable_def, INJ_DEF] THEN
8352Q.EXISTS_TAC `\x.x` THEN
8353RWTAC []
8354QED
8355
8356Theorem INJ_SUBSET[local]:
8357 !f s t s'. INJ f s t /\ s' SUBSET s ==> INJ f s' t
8358Proof
8359RWTAC [INJ_DEF, SUBSET_DEF]
8360QED
8361
8362Theorem subset_countable:
8363 !s t. countable s /\ t SUBSET s ==> countable t
8364Proof
8365RWTAC [countable_def] THEN
8366METIS_TAC [INJ_SUBSET]
8367QED
8368
8369Theorem image_countable:
8370 !f s. countable s ==> countable (IMAGE f s)
8371Proof
8372RWTAC [countable_surj, SURJ_DEF] THEN
8373Cases_on `s = {}` THEN
8374FSTAC [IN_IMAGE, IN_UNIV] THEN
8375Q.EXISTS_TAC `f o f'` THEN
8376RWTAC [] THEN
8377METIS_TAC []
8378QED
8379
8380(* an alternative definition from util_probTheory *)
8381Theorem COUNTABLE_ALT:
8382 !s. countable s = ?f. !x : 'a. x IN s ==> ?n :num. f n = x
8383Proof
8384 GEN_TAC
8385 >> EQ_TAC (* 2 sub-goals here *)
8386 >| [ (* goal 1 (of 2) *)
8387 REWRITE_TAC [countable_surj] \\
8388 rpt STRIP_TAC >- RW_TAC std_ss [NOT_IN_EMPTY] \\
8389 Q.EXISTS_TAC `f` \\
8390 POP_ASSUM MP_TAC \\
8391 REWRITE_TAC [SURJ_DEF] >> METIS_TAC [],
8392 (* goal 2 (of 2) *)
8393 rpt STRIP_TAC \\
8394 ASSUME_TAC num_countable \\
8395 `countable (IMAGE f (UNIV :num set))` by PROVE_TAC [image_countable] \\
8396 ASSUME_TAC (INST_TYPE [``:'a`` |-> ``:num``] IN_UNIV) \\
8397 Know `s SUBSET (IMAGE f (UNIV :num set))` >| (* 2 sub-goals here *)
8398 [ (* goal 2.1 (of 2) *)
8399 REWRITE_TAC [SUBSET_DEF, IN_IMAGE] \\
8400 rpt STRIP_TAC >> PROVE_TAC [],
8401 (* goal 2.2 (of 2) *)
8402 PROVE_TAC [subset_countable] ] ]
8403QED
8404
8405Theorem COUNTABLE_SUBSET:
8406 !s t. s SUBSET t /\ countable t ==> countable s
8407Proof
8408 RW_TAC std_ss [COUNTABLE_ALT, SUBSET_DEF]
8409 >> Q.EXISTS_TAC `f`
8410 >> PROVE_TAC []
8411QED
8412
8413Theorem finite_countable:
8414 !s. FINITE s ==> countable s
8415Proof
8416 REWRITE_TAC [COUNTABLE_ALT]
8417 >> HO_MATCH_MP_TAC FINITE_INDUCT
8418 >> RW_TAC std_ss [NOT_IN_EMPTY]
8419 >> Q.EXISTS_TAC `\n. if n = 0 then e else f (n - 1)`
8420 >> RW_TAC std_ss [IN_INSERT] >- PROVE_TAC []
8421 >> Q.PAT_X_ASSUM `!x. P x` (MP_TAC o Q.SPEC `x`)
8422 >> RW_TAC std_ss []
8423 >> Q.EXISTS_TAC `SUC n`
8424 >> RW_TAC std_ss [SUC_SUB1]
8425QED
8426
8427Theorem COUNTABLE_COUNT[simp]:
8428 !n. countable (count n)
8429Proof PROVE_TAC [FINITE_COUNT, finite_countable]
8430QED
8431
8432Theorem COUNTABLE_NUM[simp]:
8433 !s :num -> bool. countable s
8434Proof
8435 RW_TAC std_ss [COUNTABLE_ALT]
8436 >> Q.EXISTS_TAC `I`
8437 >> RW_TAC std_ss [I_THM]
8438QED
8439
8440Theorem COUNTABLE_IMAGE_NUM[simp]:
8441 !f :num -> 'a. !s. countable (IMAGE f s)
8442Proof
8443 PROVE_TAC [COUNTABLE_NUM, image_countable]
8444QED
8445
8446Definition num_to_pair_def: num_to_pair n = (nfst n, nsnd n)
8447End
8448Definition pair_to_num_def: pair_to_num (m,n) = m *, n
8449End
8450
8451Theorem pair_to_num_formula:
8452 !x y. pair_to_num (x, y) = (x + y + 1) * (x + y) DIV 2 + y
8453Proof
8454 SRW_TAC [][pair_to_num_def, tri_formula, npair_def, MULT_COMM]
8455QED
8456
8457Theorem pair_to_num_inv:
8458 (!x. pair_to_num (num_to_pair x) = x) /\
8459 (!x y. num_to_pair (pair_to_num (x, y)) = (x, y))
8460Proof
8461 SRW_TAC [][pair_to_num_def, num_to_pair_def]
8462QED
8463
8464(* More generally applicable version of the above *)
8465Theorem pair_to_num_inv'[simp]:
8466 (!x. pair_to_num (num_to_pair x) = x) /\
8467 (!x. num_to_pair (pair_to_num x) = x)
8468Proof
8469 simp[FORALL_PROD,pair_to_num_inv]
8470QED
8471
8472Theorem num_cross_countable[local]:
8473 countable (UNIV:num set CROSS UNIV:num set)
8474Proof
8475 RWTAC [countable_surj, SURJ_DEF, CROSS_DEF] THEN
8476 METIS_TAC [PAIR, pair_to_num_inv]
8477QED
8478
8479Theorem cross_countable:
8480 !s t. countable s /\ countable t ==> countable (s CROSS t)
8481Proof
8482RWTAC [] THEN
8483POP_ASSUM (MP_TAC o SIMP_RULE bool_ss [countable_surj]) THEN
8484POP_ASSUM (MP_TAC o SIMP_RULE bool_ss [countable_surj]) THEN
8485RWTAC [SURJ_DEF] THEN
8486RWTAC [CROSS_EMPTY, FINITE_EMPTY, finite_countable] THEN
8487`s CROSS t = IMAGE (\(x, y). (f x, f' y)) (UNIV:num set CROSS UNIV:num set)`
8488 by (RWTAC [CROSS_DEF, IMAGE_DEF, EXTENSION] THEN
8489 EQ_TAC THEN
8490 RWTAC [] THENL
8491 [Cases_on `x` THEN
8492 FSTAC [] THEN
8493 RES_TAC THEN
8494 Q.EXISTS_TAC `(y', y)` THEN
8495 RWTAC [],
8496 Cases_on `x'` THEN
8497 FSTAC [],
8498 Cases_on `x'` THEN
8499 FSTAC []]) THEN
8500METIS_TAC [num_cross_countable, image_countable]
8501QED
8502
8503Theorem inter_countable:
8504 !s t. countable s \/ countable t ==> countable (s INTER t)
8505Proof
8506METIS_TAC [INTER_SUBSET, subset_countable]
8507QED
8508
8509Theorem inj_countable:
8510 !f s t. countable t /\ INJ f s t ==> countable s
8511Proof
8512RWTAC [countable_def, INJ_DEF] THEN
8513Q.EXISTS_TAC `f' o f` THEN
8514RWTAC []
8515QED
8516
8517Theorem bigunion_countable:
8518 !s. countable s /\ (!x. x IN s ==> countable x) ==> countable (BIGUNION s)
8519Proof
8520RWTAC [] THEN
8521`!x. ?f. x IN s ==> INJ f x (UNIV:num set)`
8522 by (RWTAC [RIGHT_EXISTS_IMP_THM] THEN
8523 FSTAC [countable_def]) THEN
8524`!a. ?x. a IN BIGUNION s ==> a IN x /\ x IN s`
8525 by (RWTAC [IN_BIGUNION] THEN
8526 METIS_TAC []) THEN
8527FSTAC [SKOLEM_THM] THEN
8528`?g. INJ g s (UNIV:num set)`
8529 by (FSTAC [countable_def] THEN
8530 METIS_TAC []) THEN
8531`INJ (\a. (g (f' a), f (f' a) a)) (BIGUNION s)
8532 (UNIV:num set CROSS UNIV:num set)`
8533 by (FSTAC [INJ_DEF] THEN
8534 RWTAC [] THEN
8535 `f' a = f' a'` by METIS_TAC [] THEN
8536 FSTAC [] THEN
8537 METIS_TAC []) THEN
8538METIS_TAC [inj_countable, num_cross_countable]
8539QED
8540
8541Theorem union_countable:
8542 !s t. countable s /\ countable t ==> countable (s UNION t)
8543Proof
8544RWTAC [] THEN
8545`!x. x IN {s; t} ==> countable x` by ASM_SIMP_TAC (srw_ss() ++ DNF_ss) [] THEN
8546`FINITE {s; t}` by RWTAC [] THEN
8547`s UNION t = BIGUNION {s; t}`
8548 by (RWTAC [EXTENSION, IN_UNION, IN_BIGUNION] THEN
8549 METIS_TAC []) THEN
8550METIS_TAC [bigunion_countable, finite_countable]
8551QED
8552
8553Theorem union_countable_IFF[simp]:
8554 countable (s UNION t) <=> countable s /\ countable t
8555Proof
8556 METIS_TAC [union_countable, SUBSET_UNION, subset_countable]
8557QED
8558
8559Theorem inj_image_countable_IFF:
8560 INJ f s (IMAGE f s) ==> (countable (IMAGE f s) <=> countable s)
8561Proof
8562 SRW_TAC[][EQ_IMP_THM, image_countable] THEN
8563 METIS_TAC[countable_def, INJ_COMPOSE]
8564QED
8565
8566Theorem pow_no_surj:
8567 !s. ~?f. SURJ f s (POW s)
8568Proof
8569RWTAC [SURJ_DEF, POW_DEF, DISJ_EQ_IMP] THEN
8570Q.EXISTS_TAC `{a | a IN s /\ a NOTIN f a}` THEN
8571RWTAC [EXTENSION, SUBSET_DEF] THEN
8572METIS_TAC []
8573QED
8574
8575Theorem infinite_pow_uncountable:
8576 !s. INFINITE s ==> ~countable (POW s)
8577Proof
8578RWTAC [countable_surj, infinite_num_inj] THEN
8579IMP_RES_TAC inj_surj THEN
8580FSTAC [UNIV_NOT_EMPTY] THEN
8581METIS_TAC [pow_no_surj, SURJ_COMPOSE]
8582QED
8583
8584Theorem countable_Usum[simp]:
8585 countable univ(:'a + 'b) <=>
8586 countable univ(:'a) /\ countable univ(:'b)
8587Proof
8588 SRW_TAC [][SUM_UNIV, inj_image_countable_IFF, INJ_INL, INJ_INR]
8589QED
8590
8591Theorem countable_EMPTY[simp]:
8592 countable {}
8593Proof
8594 SIMP_TAC (srw_ss()) [countable_def, INJ_EMPTY]
8595QED
8596
8597Theorem countable_INSERT[simp]:
8598 countable (x INSERT s) <=> countable s
8599Proof
8600 Cases_on `x IN s` THEN1 ASM_SIMP_TAC (srw_ss()) [ABSORPTION_RWT] THEN
8601 SIMP_TAC (srw_ss()) [countable_def] THEN EQ_TAC THEN
8602 DISCH_THEN (Q.X_CHOOSE_THEN `f` ASSUME_TAC) THENL [
8603 Q.EXISTS_TAC `f` THEN MATCH_MP_TAC INJ_SUBSET THEN
8604 Q.EXISTS_TAC `x INSERT s` THEN ASM_SIMP_TAC (srw_ss()) [SUBSET_DEF],
8605 Q.EXISTS_TAC `\y. if y IN s then f y + 1 else 0` THEN
8606 FULL_SIMP_TAC (srw_ss() ++ DNF_ss) [INJ_DEF]
8607 ]
8608QED
8609
8610Theorem cross_countable_IFF:
8611 countable (s CROSS t) <=>
8612 (s = {}) \/ (t = {}) \/ countable s /\ countable t
8613Proof
8614 SIMP_TAC (srw_ss()) [EQ_IMP_THM, DISJ_IMP_THM, cross_countable] THEN
8615 STRIP_TAC THEN
8616 `(s = {}) \/ ?a s0. (s = a INSERT s0) /\ a NOTIN s0`
8617 by METIS_TAC [SET_CASES] THEN1 SRW_TAC [][] THEN
8618 `(t = {}) \/ ?b t0. (t = b INSERT t0) /\ b NOTIN t0`
8619 by METIS_TAC [SET_CASES] THEN1 SRW_TAC [][] THEN
8620 `?fg:'a # 'b -> num.
8621 !xy1 xy2. xy1 IN s CROSS t /\ xy2 IN s CROSS t ==>
8622 ((fg xy1 = fg xy2) <=> (xy1 = xy2))`
8623 by (Q.UNDISCH_THEN `countable (s CROSS t)` MP_TAC THEN
8624 SIMP_TAC bool_ss [countable_def, INJ_DEF, IN_UNIV] THEN
8625 METIS_TAC[]) THEN
8626 `countable s`
8627 by (SIMP_TAC (srw_ss()) [countable_def] THEN
8628 Q.EXISTS_TAC `\x. fg (x,b)` THEN
8629 SIMP_TAC (srw_ss()) [INJ_DEF] THEN
8630 MAP_EVERY Q.X_GEN_TAC [`a1`, `a2`] THEN
8631 STRIP_TAC THEN
8632 FIRST_X_ASSUM (Q.SPECL_THEN [`(a1,b)`, `(a2,b)`] MP_TAC) THEN
8633 NTAC 2 (POP_ASSUM MP_TAC) THEN
8634 ASM_SIMP_TAC (srw_ss()) []) THEN
8635 `countable t`
8636 by (SIMP_TAC (srw_ss()) [countable_def] THEN
8637 Q.EXISTS_TAC `\y. fg (a,y)` THEN
8638 SIMP_TAC (srw_ss()) [INJ_DEF] THEN
8639 MAP_EVERY Q.X_GEN_TAC [`b1`, `b2`] THEN
8640 STRIP_TAC THEN
8641 FIRST_X_ASSUM (Q.SPECL_THEN [`(a,b1)`, `(a,b2)`] MP_TAC) THEN
8642 NTAC 2 (POP_ASSUM MP_TAC) THEN
8643 ASM_SIMP_TAC (srw_ss()) []) THEN
8644 SRW_TAC [][]
8645QED
8646
8647Theorem countable_Uprod:
8648 countable univ(:'a # 'b) <=> countable univ(:'a) /\ countable univ(:'b)
8649Proof
8650 SIMP_TAC (srw_ss()) [CROSS_UNIV, cross_countable_IFF]
8651QED
8652
8653Theorem EXPLICIT_ENUMERATE_MONO:
8654 !n s. FUNPOW REST n s SUBSET s
8655Proof
8656 Induct >- RW_TAC std_ss [FUNPOW, SUBSET_DEF]
8657 >> RW_TAC std_ss [FUNPOW_SUC]
8658 >> PROVE_TAC [SUBSET_TRANS, REST_SUBSET]
8659QED
8660
8661Theorem EXPLICIT_ENUMERATE_NOT_EMPTY:
8662 !n s. INFINITE s ==> ~(FUNPOW REST n s = {})
8663Proof
8664 REWRITE_TAC []
8665 >> Induct >- (RW_TAC std_ss [FUNPOW] >> PROVE_TAC [FINITE_EMPTY])
8666 >> RW_TAC std_ss [FUNPOW]
8667 >> Q.PAT_X_ASSUM `!s. P s` (MP_TAC o Q.SPEC `REST s`)
8668 >> PROVE_TAC [FINITE_REST_EQ]
8669QED
8670
8671Theorem INFINITE_EXPLICIT_ENUMERATE:
8672 !s. INFINITE s ==> INJ (\n :num. CHOICE (FUNPOW REST n s)) UNIV s
8673Proof
8674 RW_TAC std_ss [INJ_DEF, IN_UNIV]
8675 >- (Suff `CHOICE (FUNPOW REST n s) IN FUNPOW REST n s`
8676 >- PROVE_TAC [SUBSET_DEF, EXPLICIT_ENUMERATE_MONO]
8677 >> RW_TAC std_ss [GSYM CHOICE_DEF, EXPLICIT_ENUMERATE_NOT_EMPTY])
8678 >> rpt (POP_ASSUM MP_TAC)
8679 >> Q.SPEC_TAC (`s`, `s`)
8680 >> Q.SPEC_TAC (`n'`, `y`)
8681 >> Q.SPEC_TAC (`n`, `x`)
8682 >> (Induct >> Cases) >|
8683 [PROVE_TAC [],
8684 rpt STRIP_TAC
8685 >> Suff `~(CHOICE (FUNPOW REST 0 s) IN FUNPOW REST (SUC n) s)`
8686 >- (RW_TAC std_ss []
8687 >> MATCH_MP_TAC CHOICE_DEF
8688 >> PROVE_TAC [EXPLICIT_ENUMERATE_NOT_EMPTY])
8689 >> POP_ASSUM K_TAC
8690 >> RW_TAC std_ss [FUNPOW]
8691 >> Suff `~(CHOICE s IN REST s)`
8692 >- PROVE_TAC [SUBSET_DEF, EXPLICIT_ENUMERATE_MONO]
8693 >> PROVE_TAC [CHOICE_NOT_IN_REST],
8694 rpt STRIP_TAC
8695 >> POP_ASSUM (ASSUME_TAC o ONCE_REWRITE_RULE [EQ_SYM_EQ])
8696 >> Suff `~(CHOICE (FUNPOW REST 0 s) IN FUNPOW REST (SUC x) s)`
8697 >- (RW_TAC std_ss []
8698 >> MATCH_MP_TAC CHOICE_DEF
8699 >> PROVE_TAC [EXPLICIT_ENUMERATE_NOT_EMPTY])
8700 >> POP_ASSUM K_TAC
8701 >> RW_TAC std_ss [FUNPOW]
8702 >> Suff `~(CHOICE s IN REST s)`
8703 >- PROVE_TAC [SUBSET_DEF, EXPLICIT_ENUMERATE_MONO]
8704 >> PROVE_TAC [CHOICE_NOT_IN_REST],
8705 RW_TAC std_ss [FUNPOW]
8706 >> Q.PAT_X_ASSUM `!y. P y` (MP_TAC o Q.SPECL [`n`, `REST s`])
8707 >> PROVE_TAC [FINITE_REST_EQ]]
8708QED
8709
8710Theorem BIJ_NUM_COUNTABLE:
8711 !s. (?f :num -> 'a. BIJ f UNIV s) ==> countable s
8712Proof
8713 RW_TAC std_ss [COUNTABLE_ALT, BIJ_DEF, SURJ_DEF, IN_UNIV]
8714 >> PROVE_TAC []
8715QED
8716
8717(** enumerate functions as BIJ from univ(:num) to countable sets, from util_prob *)
8718Definition enumerate_def[nocompute]:
8719 enumerate s = @f :num -> 'a. BIJ f UNIV s
8720End
8721
8722Theorem ENUMERATE:
8723 !s. (?f :num -> 'a. BIJ f UNIV s) = BIJ (enumerate s) UNIV s
8724Proof
8725 RW_TAC std_ss [EXISTS_DEF, enumerate_def]
8726QED
8727
8728Theorem COUNTABLE_ALT_BIJ:
8729 !s. countable s <=> FINITE s \/ BIJ (enumerate s) UNIV s
8730Proof
8731 rpt STRIP_TAC
8732 >> REVERSE EQ_TAC >- PROVE_TAC [finite_countable, BIJ_NUM_COUNTABLE]
8733 >> RW_TAC std_ss [COUNTABLE_ALT]
8734 >> Cases_on `FINITE s` >- PROVE_TAC []
8735 >> RW_TAC std_ss [GSYM ENUMERATE]
8736 >> MATCH_MP_TAC BIJ_INJ_SURJ
8737 >> REVERSE CONJ_TAC
8738 >- (Know `~(s = {})` >- PROVE_TAC [FINITE_EMPTY]
8739 >> RW_TAC std_ss [GSYM MEMBER_NOT_EMPTY]
8740 >> Q.EXISTS_TAC `\n. if f n IN s then f n else x`
8741 >> RW_TAC std_ss [SURJ_DEF, IN_UNIV]
8742 >> PROVE_TAC [])
8743 >> MP_TAC (Q.SPEC `s` INFINITE_EXPLICIT_ENUMERATE)
8744 >> RW_TAC std_ss []
8745 >> PROVE_TAC []
8746QED
8747
8748Theorem COUNTABLE_ENUM:
8749 !c. countable c <=> c = {} \/ ?f :num -> 'a. c = IMAGE f UNIV
8750Proof
8751 RW_TAC std_ss []
8752 >> REVERSE EQ_TAC
8753 >- (NTAC 2 (RW_TAC std_ss [countable_EMPTY])
8754 >> RW_TAC std_ss [COUNTABLE_ALT]
8755 >> Q.EXISTS_TAC `f`
8756 >> RW_TAC std_ss [IN_IMAGE, IN_UNIV]
8757 >> PROVE_TAC [])
8758 >> REVERSE (RW_TAC std_ss [COUNTABLE_ALT_BIJ])
8759 >- (DISJ2_TAC
8760 >> Q.EXISTS_TAC `enumerate c`
8761 >> POP_ASSUM MP_TAC
8762 >> RW_TAC std_ss [IN_UNIV, IN_IMAGE, BIJ_DEF, SURJ_DEF, EXTENSION]
8763 >> PROVE_TAC [])
8764 >> POP_ASSUM MP_TAC
8765 >> Q.SPEC_TAC (`c`, `c`)
8766 >> HO_MATCH_MP_TAC FINITE_INDUCT
8767 >> RW_TAC std_ss []
8768 >- (DISJ2_TAC
8769 >> Q.EXISTS_TAC `K e`
8770 >> RW_TAC std_ss [EXTENSION, IN_SING, IN_IMAGE, IN_UNIV, K_THM])
8771 >> DISJ2_TAC
8772 >> Q.EXISTS_TAC `\n. num_CASE n e f`
8773 >> RW_TAC std_ss [IN_INSERT, IN_IMAGE, EXTENSION, IN_UNIV]
8774 >> EQ_TAC >|
8775 [RW_TAC std_ss [] >|
8776 [Q.EXISTS_TAC `0`
8777 >> RW_TAC std_ss [num_case_def],
8778 Q.EXISTS_TAC `SUC x'`
8779 >> RW_TAC std_ss [num_case_def]],
8780 RW_TAC std_ss [] >>
8781 METIS_TAC [num_case_def, TypeBase.nchotomy_of ``:num``]]
8782QED
8783
8784(* END countability theorems *)
8785
8786
8787(* Misc theorems added by Thomas Tuerk on 2009-03-24 *)
8788
8789Theorem IMAGE_BIGUNION:
8790 !f M. IMAGE f (BIGUNION M) =
8791 BIGUNION (IMAGE (IMAGE f) M)
8792Proof
8793
8794ONCE_REWRITE_TAC [EXTENSION] THEN
8795SIMP_TAC bool_ss [IN_BIGUNION, IN_IMAGE,
8796 GSYM LEFT_EXISTS_AND_THM,
8797 GSYM RIGHT_EXISTS_AND_THM] THEN
8798METIS_TAC[]
8799QED
8800
8801
8802Theorem SUBSET_DIFF:
8803 !s1 s2 s3. (s1 SUBSET (s2 DIFF s3)) <=> s1 SUBSET s2 /\ DISJOINT s1 s3
8804Proof
8805 SIMP_TAC bool_ss [SUBSET_DEF, IN_DIFF, DISJOINT_DEF, EXTENSION, IN_INTER,
8806 NOT_IN_EMPTY]
8807 >> METIS_TAC []
8808QED
8809
8810Theorem INTER_SUBSET_EQN:
8811 ((A INTER B = A) = (A SUBSET B)) /\
8812 ((A INTER B = B) = (B SUBSET A))
8813Proof
8814 SIMP_TAC bool_ss [EXTENSION, IN_INTER, SUBSET_DEF]
8815 >> METIS_TAC []
8816QED
8817
8818Theorem PSUBSET_SING:
8819 !s x. x PSUBSET {s} <=> (x = EMPTY)
8820Proof
8821SIMP_TAC bool_ss [PSUBSET_DEF, SUBSET_DEF, EXTENSION,
8822 IN_SING, NOT_IN_EMPTY] THEN
8823METIS_TAC[]
8824QED
8825
8826
8827Theorem INTER_UNION:
8828 ((A UNION B) INTER A = A) /\
8829 ((B UNION A) INTER A = A) /\
8830 (A INTER (A UNION B) = A) /\
8831 (A INTER (B UNION A) = A)
8832Proof
8833SIMP_TAC bool_ss [INTER_SUBSET_EQN, SUBSET_UNION]
8834QED
8835
8836
8837Theorem UNION_DELETE:
8838 !A B x. (A UNION B) DELETE x =
8839 ((A DELETE x) UNION (B DELETE x))
8840Proof
8841
8842SIMP_TAC bool_ss [EXTENSION, IN_UNION, IN_DELETE] THEN
8843REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THEN
8844ASM_SIMP_TAC bool_ss []
8845QED
8846
8847Theorem DELETE_SUBSET_INSERT:
8848 !s e s2. s DELETE e SUBSET s2 <=> s SUBSET e INSERT s2
8849Proof REWRITE_TAC [GSYM SUBSET_INSERT_DELETE]
8850QED
8851
8852Theorem IN_INSERT_EXPAND:
8853 !x y P. x IN y INSERT P <=> (x = y) \/ x <> y /\ x IN P
8854Proof
8855 SIMP_TAC bool_ss [IN_INSERT] THEN
8856 METIS_TAC[]
8857QED
8858
8859(* END misc thms *)
8860
8861(*---------------------------------------------------------------------------*)
8862(* Various lemmas from the CakeML project https://cakeml.org *)
8863(*---------------------------------------------------------------------------*)
8864
8865Theorem INSERT_EQ_SING:
8866 !s x y. (x INSERT s = {y}) <=> ((x = y) /\ s SUBSET {y})
8867Proof
8868 SRW_TAC [] [SUBSET_DEF,EXTENSION] THEN METIS_TAC []
8869QED
8870
8871Theorem CARD_UNION_LE:
8872 FINITE s /\ FINITE t ==> CARD (s UNION t) <= CARD s + CARD t
8873Proof
8874 SRW_TAC [][] THEN IMP_RES_TAC CARD_UNION THEN FULL_SIMP_TAC (srw_ss()++ARITH_ss) []
8875QED
8876
8877Theorem IMAGE_SUBSET_gen:
8878 !f s u t. s SUBSET u /\ (IMAGE f u SUBSET t) ==> IMAGE f s SUBSET t
8879Proof
8880 SIMP_TAC (srw_ss())[SUBSET_DEF] THEN METIS_TAC[]
8881QED
8882
8883Theorem CARD_REST:
8884 !s. FINITE s /\ s <> {} ==> (CARD (REST s) = CARD s - 1)
8885Proof
8886 SRW_TAC[][] THEN
8887 IMP_RES_TAC CHOICE_INSERT_REST THEN
8888 POP_ASSUM (fn th => CONV_TAC (RAND_CONV (REWRITE_CONV [Once(SYM th)]))) THEN
8889 Q.SPEC_THEN`REST s`MP_TAC CARD_INSERT THEN SRW_TAC[][] THEN
8890 FULL_SIMP_TAC(srw_ss())[REST_DEF]
8891QED
8892
8893Theorem SUBSET_DIFF_EMPTY:
8894 !s t. (s DIFF t = {}) = (s SUBSET t)
8895Proof
8896 SRW_TAC[][EXTENSION,SUBSET_DEF] THEN PROVE_TAC[]
8897QED
8898
8899Theorem DIFF_INTER_SUBSET:
8900 !r s t. r SUBSET s ==> (r DIFF s INTER t = r DIFF t)
8901Proof
8902 SRW_TAC[][EXTENSION,SUBSET_DEF] THEN PROVE_TAC[]
8903QED
8904
8905Theorem UNION_DIFF_2:
8906 !s t. (s UNION (s DIFF t) = s)
8907Proof
8908 SRW_TAC[][EXTENSION] THEN PROVE_TAC[]
8909QED
8910
8911Theorem count_add:
8912 !n m. count (n + m) = count n UNION IMAGE ($+ n) (count m)
8913Proof
8914 SRW_TAC[ARITH_ss][EXTENSION,EQ_IMP_THM] THEN
8915 Cases_on `x < n` THEN SRW_TAC[ARITH_ss][] THEN
8916 Q.EXISTS_TAC `x - n` THEN
8917 SRW_TAC[ARITH_ss][]
8918QED
8919
8920Theorem IMAGE_EQ_SING:
8921 (IMAGE f s = {z}) <=> (s <> {}) /\ !x. x IN s ==> (f x = z)
8922Proof
8923 EQ_TAC THEN
8924 SRW_TAC[DNF_ss][EXTENSION] THEN
8925 PROVE_TAC[]
8926QED
8927
8928Theorem count_add1:
8929 !n. count (n + 1) = n INSERT count n
8930Proof
8931METIS_TAC [COUNT_SUC, ADD1]
8932QED
8933
8934Theorem compl_insert:
8935 !s x. COMPL (x INSERT s) = COMPL s DELETE x
8936Proof
8937 SRW_TAC [] [EXTENSION, IN_COMPL] THEN
8938 METIS_TAC []
8939QED
8940
8941(* end CakeML lemmas *)
8942
8943(*---------------------------------------------------------------------------*)
8944(* PREIMAGE lemmas from util_probTheory *)
8945(*---------------------------------------------------------------------------*)
8946
8947Definition PREIMAGE_def:
8948 PREIMAGE f s = {x | f x IN s}
8949End
8950
8951Theorem PREIMAGE_ALT:
8952 !f s. PREIMAGE f s = s o f
8953Proof
8954 Know `!x f s. x IN (s o f) <=> f x IN s`
8955 >- RW_TAC std_ss [SPECIFICATION, o_THM]
8956 >> RW_TAC std_ss [PREIMAGE_def, EXTENSION, GSPECIFICATION]
8957QED
8958
8959Theorem PREIMAGE_o:
8960 !f g s. PREIMAGE (f o g) s = PREIMAGE g (s o f)
8961Proof
8962 REWRITE_TAC [PREIMAGE_ALT, GSYM o_ASSOC]
8963QED
8964
8965Theorem IN_PREIMAGE[simp]:
8966 !f s x. x IN PREIMAGE f s <=> f x IN s
8967Proof
8968 RW_TAC std_ss [PREIMAGE_def, GSPECIFICATION]
8969QED
8970
8971Theorem PREIMAGE_EMPTY[simp]:
8972 !f. PREIMAGE f {} = {}
8973Proof RW_TAC std_ss [EXTENSION, IN_PREIMAGE, NOT_IN_EMPTY]
8974QED
8975
8976Theorem PREIMAGE_UNIV[simp]:
8977 !f. PREIMAGE f UNIV = UNIV
8978Proof RW_TAC std_ss [EXTENSION, IN_PREIMAGE, IN_UNIV]
8979QED
8980
8981Theorem PREIMAGE_COMPL:
8982 !f s. PREIMAGE f (COMPL s) = COMPL (PREIMAGE f s)
8983Proof
8984 RW_TAC std_ss [EXTENSION, IN_PREIMAGE, IN_COMPL]
8985QED
8986
8987Theorem PREIMAGE_UNION:
8988 !f s t. PREIMAGE f (s UNION t) = PREIMAGE f s UNION PREIMAGE f t
8989Proof RW_TAC std_ss [EXTENSION, IN_PREIMAGE, IN_UNION]
8990QED
8991
8992Theorem PREIMAGE_INTER:
8993 !f s t. PREIMAGE f (s INTER t) = PREIMAGE f s INTER PREIMAGE f t
8994Proof RW_TAC std_ss [EXTENSION, IN_PREIMAGE, IN_INTER]
8995QED
8996
8997Theorem PREIMAGE_BIGUNION:
8998 !f s. PREIMAGE f (BIGUNION s) = BIGUNION (IMAGE (PREIMAGE f) s)
8999Proof
9000 RW_TAC std_ss [EXTENSION, IN_PREIMAGE, IN_BIGUNION_IMAGE]
9001 >> RW_TAC std_ss [IN_BIGUNION]
9002 >> PROVE_TAC []
9003QED
9004
9005Theorem PREIMAGE_COMP:
9006 !f g s. PREIMAGE f (PREIMAGE g s) = PREIMAGE (g o f) s
9007Proof
9008 RW_TAC std_ss [EXTENSION, IN_PREIMAGE, o_THM]
9009QED
9010
9011Theorem PREIMAGE_DIFF:
9012 !f s t. PREIMAGE f (s DIFF t) = PREIMAGE f s DIFF PREIMAGE f t
9013Proof
9014 RW_TAC std_ss [Once EXTENSION, IN_PREIMAGE, IN_DIFF]
9015QED
9016
9017Theorem PREIMAGE_I[simp]:
9018 PREIMAGE I = I /\ PREIMAGE (λx. x) = (λx. x)
9019Proof
9020 METIS_TAC [EXTENSION, IN_PREIMAGE, I_THM]
9021QED
9022
9023Theorem PREIMAGE_K:
9024 !x s. PREIMAGE (K x) s = if x IN s then UNIV else {}
9025Proof
9026 RW_TAC std_ss [EXTENSION, IN_PREIMAGE, K_THM, IN_UNIV, NOT_IN_EMPTY]
9027QED
9028
9029Theorem PREIMAGE_DISJOINT:
9030 !f s t. DISJOINT s t ==> DISJOINT (PREIMAGE f s) (PREIMAGE f t)
9031Proof
9032 RW_TAC std_ss [DISJOINT_DEF, GSYM PREIMAGE_INTER, PREIMAGE_EMPTY]
9033QED
9034
9035Theorem PREIMAGE_SUBSET:
9036 !f s t. s SUBSET t ==> PREIMAGE f s SUBSET PREIMAGE f t
9037Proof
9038 RW_TAC std_ss [SUBSET_DEF, PREIMAGE_def, GSPECIFICATION]
9039QED
9040
9041Theorem PREIMAGE_CROSS:
9042 !f a b.
9043 PREIMAGE f (a CROSS b) =
9044 PREIMAGE (FST o f) a INTER PREIMAGE (SND o f) b
9045Proof
9046 RW_TAC std_ss [EXTENSION, IN_PREIMAGE, IN_CROSS, IN_INTER, o_THM]
9047QED
9048
9049Theorem PREIMAGE_COMPL_INTER: !f t sp. PREIMAGE f (COMPL t) INTER sp = sp DIFF (PREIMAGE f t)
9050Proof
9051 RW_TAC std_ss [COMPL_DEF]
9052 >> MP_TAC (REWRITE_RULE [PREIMAGE_UNIV] (Q.SPECL [`f`,`UNIV`,`t`] PREIMAGE_DIFF))
9053 >> STRIP_TAC
9054 >> `(PREIMAGE f (UNIV DIFF t)) INTER sp = (UNIV DIFF PREIMAGE f t) INTER sp` by METIS_TAC []
9055 >> METIS_TAC [DIFF_INTER,INTER_UNIV]
9056QED
9057
9058Theorem PREIMAGE_IMAGE:
9059 !f s. s SUBSET PREIMAGE f (IMAGE f s)
9060Proof
9061 RW_TAC std_ss [SUBSET_DEF, IN_PREIMAGE, IN_IMAGE]
9062 >> PROVE_TAC []
9063QED
9064
9065Theorem IMAGE_PREIMAGE:
9066 !f s. IMAGE f (PREIMAGE f s) SUBSET s
9067Proof
9068 RW_TAC std_ss [SUBSET_DEF, IN_PREIMAGE, IN_IMAGE]
9069 >> PROVE_TAC []
9070QED
9071
9072Theorem FINITE_PREIMAGE:
9073 (!x y. f x = f y <=> x = y) /\ FINITE s ==> FINITE (PREIMAGE f s)
9074Proof
9075 Induct_on ‘FINITE’ >> simp[PREIMAGE_EMPTY] >> rw[] >> fs[] >>
9076 simp[Once INSERT_SING_UNION, PREIMAGE_UNION] >>
9077 simp[PREIMAGE_def] >>
9078 Cases_on ‘?x. f x = e’ >> fs[] >>
9079 ‘!y. f y = e <=> y = x’ by METIS_TAC[] >> simp[]
9080QED
9081
9082(* ------------------------------------------------------------------------- *)
9083(* Miscellaneous bijections *)
9084(* ------------------------------------------------------------------------- *)
9085
9086Theorem BIJ_NUM_TO_PAIR:
9087 BIJ num_to_pair UNIV (UNIV CROSS UNIV)
9088Proof
9089 simp[BIJ_IFF_INV] >> Q.EXISTS_TAC ‘pair_to_num’ >> simp[]
9090QED
9091
9092Theorem BIJ_PAIR_TO_NUM:
9093 BIJ pair_to_num (UNIV CROSS UNIV) UNIV
9094Proof
9095 simp[BIJ_IFF_INV] >> Q.EXISTS_TAC ‘num_to_pair’ >> simp[]
9096QED
9097
9098Theorem BIJ_SWAP:
9099 BIJ SWAP (UNIV CROSS UNIV) (UNIV CROSS UNIV)
9100Proof
9101 simp[BIJ_IFF_INV] >> Q.EXISTS_TAC ‘SWAP’ >> simp[]
9102QED
9103
9104Theorem X_LE_MAX[local] = cj 1 MAX_LE
9105Theorem MAX_LE_X[local] = cj 2 MAX_LE
9106
9107(* moved here from seqTheory (originally from util_probTheory) *)
9108Theorem NUM_2D_BIJ_BIG_SQUARE :
9109 !(f : num -> num # num) N.
9110 BIJ f UNIV (UNIV CROSS UNIV) ==>
9111 ?k. IMAGE f (count N) SUBSET count k CROSS count k
9112Proof
9113 RW_TAC std_ss [IN_CROSS, IN_COUNT, SUBSET_DEF, IN_IMAGE, IN_COUNT]
9114 >> Induct_on `N` >- RW_TAC arith_ss []
9115 >> POP_ASSUM STRIP_ASSUME_TAC
9116 >> Cases_on `f N`
9117 >> REWRITE_TAC [prim_recTheory.LESS_THM]
9118 >> Q.EXISTS_TAC `SUC (MAX k (MAX q r))`
9119 >> Know `!a b. a < SUC b <=> a <= b`
9120 >- (KILL_TAC >> DECIDE_TAC)
9121 >> RW_TAC std_ss []
9122 >> RW_TAC std_ss []
9123 >> PROVE_TAC [X_LE_MAX, LESS_EQ_REFL, LESS_IMP_LESS_OR_EQ]
9124QED
9125
9126Theorem NUM_2D_BIJ_SMALL_SQUARE :
9127 !(f : num -> num # num) k.
9128 BIJ f UNIV (UNIV CROSS UNIV) ==>
9129 ?N. count k CROSS count k SUBSET IMAGE f (count N)
9130Proof
9131 rpt STRIP_TAC
9132 >> (MP_TAC o
9133 Q.SPECL [`f`, `UNIV CROSS UNIV`, `count k CROSS count k`] o
9134 INST_TYPE [``:'a`` |-> ``:num # num``]) BIJ_FINITE_SUBSET
9135 >> RW_TAC std_ss [CROSS_SUBSET, SUBSET_UNIV, FINITE_CROSS, FINITE_COUNT]
9136 >> Q.EXISTS_TAC `N`
9137 >> RW_TAC std_ss [SUBSET_DEF, IN_IMAGE, IN_COUNT]
9138 >> Q.PAT_X_ASSUM `BIJ a b c` MP_TAC
9139 >> RW_TAC std_ss [BIJ_DEF, SURJ_DEF, IN_UNIV, IN_CROSS]
9140 >> POP_ASSUM (MP_TAC o Q.SPEC `x`)
9141 >> RW_TAC std_ss []
9142 >> Q.EXISTS_TAC `y`
9143 >> RW_TAC std_ss []
9144 >> Suff `~(N <= y)` >- DECIDE_TAC
9145 >> PROVE_TAC []
9146QED
9147
9148(* NOTE: The original proofs by Joe Hurd depend on “ind_type$NUMPAIR” *)
9149Theorem NUM_2D_BIJ :
9150 ?f. BIJ f ((UNIV : num -> bool) CROSS (UNIV : num -> bool))
9151 (UNIV : num -> bool)
9152Proof
9153 Q.EXISTS_TAC ‘pair_to_num’
9154 >> REWRITE_TAC [BIJ_PAIR_TO_NUM]
9155QED
9156
9157Theorem NUM_2D_BIJ_INV :
9158 ?f. BIJ f (UNIV : num -> bool)
9159 ((UNIV : num -> bool) CROSS (UNIV : num -> bool))
9160Proof
9161 PROVE_TAC [NUM_2D_BIJ, BIJ_SYM]
9162QED
9163
9164Theorem NUM_2D_BIJ_NZ :
9165 ?f. BIJ f ((UNIV : num -> bool) CROSS ((UNIV : num -> bool) DIFF {0}))
9166 (UNIV : num -> bool)
9167Proof
9168 MATCH_MP_TAC BIJ_INJ_SURJ
9169 >> reverse CONJ_TAC
9170 >- (Q.EXISTS_TAC `FST` \\
9171 RW_TAC std_ss [SURJ_DEF, IN_UNIV, IN_CROSS, DIFF_DEF, GSPECIFICATION, IN_SING] \\
9172 Q.EXISTS_TAC `(x, 1)` \\
9173 RW_TAC std_ss [FST])
9174 >> Q.EXISTS_TAC ‘UNCURRY npair’
9175 >> RW_TAC std_ss [INJ_DEF, IN_UNIV, IN_CROSS]
9176 >> Cases_on `x`
9177 >> Cases_on `y`
9178 >> POP_ASSUM MP_TAC
9179 >> RW_TAC std_ss [UNCURRY_DEF, npair_11]
9180QED
9181
9182Theorem NUM_2D_BIJ_NZ_INV :
9183 ?f. BIJ f (UNIV : num -> bool)
9184 ((UNIV : num -> bool) CROSS ((UNIV : num -> bool) DIFF {0}))
9185Proof
9186 PROVE_TAC [NUM_2D_BIJ_NZ, BIJ_SYM]
9187QED
9188
9189Theorem NUM_2D_BIJ_NZ_ALT:
9190 ?f. BIJ f ((UNIV : num -> bool) CROSS (UNIV : num -> bool))
9191 ((UNIV : num -> bool) DIFF {0})
9192Proof
9193 MATCH_MP_TAC BIJ_INJ_SURJ >> reverse CONJ_TAC
9194 >- (Q.EXISTS_TAC ‘(\(x,y). x + 1:num)’ \\
9195 simp[SURJ_DEF, FORALL_PROD, EXISTS_PROD] \\
9196 simp[Once FORALL_NUM, ADD1])
9197 >> Q.EXISTS_TAC ‘\(m,n). m *, n + 1’
9198 >> simp[INJ_IFF, FORALL_PROD]
9199QED
9200
9201Theorem NUM_2D_BIJ_NZ_ALT_INV :
9202 ?f. BIJ f ((UNIV : num -> bool) DIFF {0})
9203 ((UNIV : num -> bool) CROSS (UNIV : num -> bool))
9204Proof
9205 PROVE_TAC [NUM_2D_BIJ_NZ_ALT, BIJ_SYM]
9206QED
9207
9208Theorem NUM_2D_BIJ_NZ_ALT2 :
9209 ?f. BIJ f (((UNIV : num -> bool) DIFF {0}) CROSS ((UNIV : num -> bool) DIFF {0}))
9210 (UNIV : num -> bool)
9211Proof
9212 MATCH_MP_TAC BIJ_INJ_SURJ
9213 >> reverse CONJ_TAC
9214 >- (Q.EXISTS_TAC `(\(x,y). x - 1:num)` \\
9215 RW_TAC std_ss [SURJ_DEF, IN_UNIV, IN_CROSS] \\
9216 Q.EXISTS_TAC `(x+1,1)` \\
9217 RW_TAC std_ss [DIFF_DEF, GSPECIFICATION, IN_UNIV, IN_SING])
9218 >> Q.EXISTS_TAC ‘UNCURRY npair’
9219 >> RW_TAC std_ss [INJ_DEF, IN_UNIV, IN_CROSS]
9220 >> Cases_on `x`
9221 >> Cases_on `y`
9222 >> POP_ASSUM MP_TAC
9223 >> RW_TAC std_ss [UNCURRY_DEF, npair_11]
9224QED
9225
9226Theorem NUM_2D_BIJ_NZ_ALT2_INV :
9227 ?f. BIJ f (UNIV : num -> bool)
9228 (((UNIV : num -> bool) DIFF {0}) CROSS ((UNIV : num -> bool) DIFF {0}))
9229Proof
9230 PROVE_TAC [NUM_2D_BIJ_NZ_ALT2, BIJ_SYM]
9231QED
9232
9233(* "<<=" is overloaded in listTheory, cardinalTheory and maybe others,
9234 we put its Unicode and TeX definitions here to make sure by loading any of the
9235 theories user could see the Unicode representations. *)
9236
9237val _ = set_fixity "<<=" (Infix(NONASSOC, 450));
9238
9239val _ = Unicode.unicode_version {u = UTF8.chr 0x227C, tmnm = "<<="};
9240 (* in tex input mode in emacs, produce U+227C with \preceq *)
9241 (* tempting to add a not-isprefix macro keyed to U+22E0 \npreceq, but
9242 hard to know what the ASCII version should be. *)
9243
9244val _ = TeX_notation {hol = "<<=", TeX = ("\\HOLTokenIsPrefix{}", 1)};
9245val _ = TeX_notation {hol = UTF8.chr 0x227C, TeX = ("\\HOLTokenIsPrefix{}", 1)};
9246
9247Definition is_measure_maximal_def[nocompute]:
9248 is_measure_maximal m s x <=> x IN s /\ !y. y IN s ==> m y <= m x
9249End
9250
9251(* cf. arithmeticTheory.WOP_measure for the "is_measure_minimal" of s *)
9252Theorem FINITE_is_measure_maximal :
9253 !m s. FINITE s /\ s <> {} ==> ?x. is_measure_maximal m s x
9254Proof
9255 Q.X_GEN_TAC ‘m’ \\
9256 ‘!s. FINITE s ==> s <> {} ==> ?x. is_measure_maximal m s x’
9257 suffices_by METIS_TAC[] >>
9258 Induct_on ‘FINITE’ >> simp[] >> rpt strip_tac >> Cases_on ‘s = {}’ >> simp[]
9259 >- (Q.RENAME_TAC [‘{e}’] >> Q.EXISTS_TAC ‘e’ >>
9260 simp[is_measure_maximal_def]) >>
9261 fs[is_measure_maximal_def] >> Q.RENAME_TAC [‘m _ <= m e0’, ‘e NOTIN s’] >>
9262 Cases_on ‘m e0 <= m e’
9263 >- (Q.EXISTS_TAC ‘e’ >> SRW_TAC[][] >> simp[] >>
9264 METIS_TAC[LESS_EQ_TRANS]) >>
9265 Q.EXISTS_TAC ‘e0’ >> simp[DISJ_IMP_THM]
9266QED
9267
9268Theorem is_measure_maximal_SING[simp]:
9269 is_measure_maximal m {x} y <=> (y = x)
9270Proof
9271 simp[is_measure_maximal_def, EQ_IMP_THM]
9272QED
9273
9274Theorem is_measure_maximal_INSERT:
9275 !x s m e y.
9276 x IN s /\ m e < m x ==>
9277 (is_measure_maximal m (e INSERT s) y <=> is_measure_maximal m s y)
9278Proof
9279 simp[is_measure_maximal_def] >> rpt strip_tac >> eq_tac >> SRW_TAC[][]
9280 >- METIS_TAC[DECIDE “(x <= y /\ y < z ==> x < z) /\ ~(a < a)”]
9281 >- METIS_TAC[DECIDE “x < y /\ y <= z ==> x <= z”]
9282 >- METIS_TAC[]
9283QED
9284
9285val _ = export_rewrites
9286 [
9287 (* BIGUNION/BIGINTER theorems *)
9288 "DISJOINT_BIGUNION",
9289 "BIGUNION_UNION", "BIGINTER_UNION",
9290 "DISJOINT_BIGUNION",
9291 (* cardinality theorems *)
9292 "CARD_DIFF", "CARD_EQ_0",
9293 "CARD_INTER_LESS_EQ", "CARD_DELETE", "CARD_DIFF",
9294 (* complement theorems *)
9295 "COMPL_CLAUSES", "COMPL_COMPL", "COMPL_EMPTY",
9296 (* "DELETE" theorems *)
9297 "DELETE_DELETE", "DELETE_EQ_SING", "DELETE_SUBSET",
9298 (* "DIFF" theorems *)
9299 "DIFF_DIFF", "DIFF_EMPTY", "DIFF_EQ_EMPTY", "DIFF_UNIV",
9300 "DIFF_SUBSET",
9301 (* "DISJOINT" theorems *)
9302 "DISJOINT_EMPTY", "DISJOINT_UNION_BOTH",
9303 "DISJOINT_EMPTY_REFL_RWT",
9304 (* "IMAGE" theorems *)
9305 "IMAGE_DELETE", "IMAGE_FINITE", "IMAGE_ID", "IMAGE_IN",
9306 "IMAGE_SUBSET", "IMAGE_UNION",
9307 (* "INSERT" theorems *)
9308 "INSERT_DELETE", "INSERT_DIFF", "INSERT_INSERT", "INSERT_SUBSET",
9309 (* "INTER" theorems *)
9310 "INTER_FINITE", "INTER_IDEMPOT",
9311 "INTER_SUBSET", "INTER_UNIV", "SUBSET_INTER",
9312 (* "REST" *)
9313 "REST_PSUBSET", "REST_SUBSET", "FINITE_REST",
9314 (* "SUBSET" *)
9315 "SUBSET_INSERT",
9316 (* "UNION" *)
9317 "UNION_IDEMPOT", "UNION_SUBSET",
9318 "SUBSET_UNION"
9319];
9320
9321(* ------------------------------------------------------------------------- *)
9322(* More theorems about EXTENSIONAL and RESTRICTION *)
9323(* *)
9324(* (Ported from HOL-Light's sets.ml by Chun Tian) *)
9325(* ------------------------------------------------------------------------- *)
9326
9327Theorem EXTENSIONAL :
9328 !s. EXTENSIONAL s = {f :'a->'b | !x. x NOTIN s ==> f x = ARB}
9329Proof
9330 RW_TAC std_ss [IN_APP, EXTENSIONAL_def, Once EXTENSION, GSPECIFICATION]
9331QED
9332
9333Theorem EXTENSIONAL_EMPTY :
9334 EXTENSIONAL {} = {\x:'a. ARB:'b}
9335Proof
9336 RW_TAC std_ss [EXTENSION, IN_EXTENSIONAL, IN_SING, NOT_IN_EMPTY] THEN
9337 REWRITE_TAC[FUN_EQ_THM]
9338QED
9339
9340Theorem EXTENSIONAL_UNIV :
9341 !f. EXTENSIONAL univ(:'a) f
9342Proof
9343 RW_TAC std_ss [EXTENSIONAL_def, IN_UNIV]
9344QED
9345
9346Theorem EXTENSIONAL_EQ :
9347 !s f (g :'a->'b).
9348 f IN EXTENSIONAL s /\ g IN EXTENSIONAL s /\ (!x. x IN s ==> f x = g x)
9349 ==> f = g
9350Proof
9351 REPEAT STRIP_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN
9352 ASM_CASES_TAC “(x :'a) IN s” THENL
9353 [ASM_SIMP_TAC std_ss [],
9354 ASM_MESON_TAC[IN_EXTENSIONAL_UNDEFINED]]
9355QED
9356
9357Theorem RESTRICTION_IN_EXTENSIONAL :
9358 !s (f :'a->'b). RESTRICTION s f IN EXTENSIONAL s
9359Proof
9360 SIMP_TAC std_ss [IN_EXTENSIONAL, RESTRICTION]
9361QED
9362
9363Theorem RESTRICTION_EXTENSION :
9364 !s f (g :'a->'b). RESTRICTION s f = RESTRICTION s g <=>
9365 (!x. x IN s ==> f x = g x)
9366Proof
9367 REPEAT GEN_TAC THEN REWRITE_TAC [RESTRICTION, FUN_EQ_THM] THEN
9368 EQ_TAC >> RW_TAC std_ss [] THEN
9369 Q.PAT_X_ASSUM ‘!x. P’ (MP_TAC o (Q.SPEC ‘x’)) THEN
9370 RW_TAC std_ss []
9371QED
9372
9373Theorem RESTRICTION_FIXPOINT :
9374 !s (f :'a->'b). RESTRICTION s f = f <=> f IN EXTENSIONAL s
9375Proof
9376 REWRITE_TAC[IN_EXTENSIONAL, FUN_EQ_THM, RESTRICTION]
9377 >> rpt GEN_TAC >> EQ_TAC >> RW_TAC std_ss []
9378 >- (Q.PAT_X_ASSUM ‘!x. P’ (MP_TAC o (Q.SPEC ‘x’)) \\
9379 RW_TAC std_ss [])
9380 >> Cases_on ‘x IN s’ >> RW_TAC std_ss []
9381QED
9382
9383Theorem RESTRICTION_RESTRICTION :
9384 !s t (f :'a->'b).
9385 s SUBSET t ==> RESTRICTION s (RESTRICTION t f) = RESTRICTION s f
9386Proof
9387 REWRITE_TAC [FUN_EQ_THM, RESTRICTION]
9388 >> RW_TAC std_ss [SUBSET_DEF]
9389QED
9390
9391Theorem RESTRICTION_IDEMP :
9392 !s (f :'a->'b). RESTRICTION s (RESTRICTION s f) = RESTRICTION s f
9393Proof
9394 REWRITE_TAC[RESTRICTION_FIXPOINT, RESTRICTION_IN_EXTENSIONAL]
9395QED
9396
9397Theorem IMAGE_RESTRICTION :
9398 !(f :'a->'b) s t. s SUBSET t ==> IMAGE (RESTRICTION t f) s = IMAGE f s
9399Proof
9400 RW_TAC std_ss [Once EXTENSION, IN_IMAGE, RESTRICTION, SUBSET_DEF]
9401 >> EQ_TAC
9402 >| [ (* goal 1 (of 2) *)
9403 DISCH_THEN (X_CHOOSE_THEN “y :'a” MP_TAC) \\
9404 RW_TAC std_ss []
9405 >- (Q.EXISTS_TAC ‘y’ >> ASM_REWRITE_TAC []) \\
9406 Q.PAT_X_ASSUM ‘!x. P’ (MP_TAC o (Q.SPEC ‘y’)) \\
9407 ASM_REWRITE_TAC [],
9408 (* goal 2 (of 2) *)
9409 DISCH_THEN (X_CHOOSE_THEN “y :'a” MP_TAC) \\
9410 RW_TAC std_ss [] \\
9411 Q.EXISTS_TAC ‘y’ >> RW_TAC std_ss [] ]
9412QED
9413
9414Theorem RESTRICTION_COMPOSE_RIGHT :
9415 !(f :'a->'b) (g :'b->'c) s.
9416 RESTRICTION s (g o RESTRICTION s f) =
9417 RESTRICTION s (g o f)
9418Proof
9419 RW_TAC std_ss [FUN_EQ_THM, o_DEF, RESTRICTION]
9420QED
9421
9422Theorem RESTRICTION_COMPOSE_LEFT :
9423 !(f :'a->'b) (g :'b->'c) s t.
9424 IMAGE f s SUBSET t
9425 ==> RESTRICTION s (RESTRICTION t g o f) =
9426 RESTRICTION s (g o f)
9427Proof
9428 RW_TAC std_ss [FUN_EQ_THM, o_DEF, RESTRICTION, IN_IMAGE, SUBSET_DEF]
9429 >> Cases_on ‘x IN s’
9430 >> ASM_REWRITE_TAC []
9431 >> ‘f x IN t’ by (FIRST_X_ASSUM MATCH_MP_TAC \\
9432 Q.EXISTS_TAC ‘x’ >> ASM_REWRITE_TAC [])
9433 >> ASM_SIMP_TAC std_ss []
9434QED
9435
9436Theorem RESTRICTION_COMPOSE :
9437 !(f :'a->'b) (g :'b->'c) s t.
9438 IMAGE f s SUBSET t
9439 ==> RESTRICTION s (RESTRICTION t g o RESTRICTION s f) =
9440 RESTRICTION s (g o f)
9441Proof
9442 SIMP_TAC std_ss [RESTRICTION_COMPOSE_LEFT, RESTRICTION_COMPOSE_RIGHT]
9443QED
9444
9445Theorem RESTRICTION_UNIQUE :
9446 !s (f :'a->'b) g.
9447 RESTRICTION s f = g <=> EXTENSIONAL s g /\ !x. x IN s ==> f x = g x
9448Proof
9449 RW_TAC std_ss [FUN_EQ_THM, RESTRICTION, EXTENSIONAL_def]
9450 >> EQ_TAC
9451 >> RW_TAC std_ss []
9452 >| [ (* goal 1 (of 3) *)
9453 Q.PAT_X_ASSUM ‘!x. P’ (MP_TAC o (Q.SPEC ‘x’)) \\
9454 RW_TAC std_ss [],
9455 (* goal 2 (of 3) *)
9456 Q.PAT_X_ASSUM ‘!x. P’ (MP_TAC o (Q.SPEC ‘x’)) \\
9457 RW_TAC std_ss [],
9458 (* goal 3 (of 3) *)
9459 Cases_on ‘x IN s’ >> RW_TAC std_ss [] ]
9460QED
9461
9462Theorem RESTRICTION_UNIQUE_ALT :
9463 !s (f :'a->'b) g.
9464 f = RESTRICTION s g <=> EXTENSIONAL s f /\ !x. x IN s ==> f x = g x
9465Proof
9466 RW_TAC std_ss [FUN_EQ_THM, RESTRICTION, EXTENSIONAL_def]
9467 >> EQ_TAC
9468 >> RW_TAC std_ss []
9469 >> Cases_on ‘x IN s’
9470 >> RW_TAC std_ss []
9471QED
9472
9473(* ------------------------------------------------------------------------- *)
9474(* Classic result on function of finite set into itself. *)
9475(* ------------------------------------------------------------------------- *)
9476
9477Theorem SURJECTIVE_IFF_INJECTIVE_GEN :
9478 !s t f:'a->'b.
9479 FINITE s /\ FINITE t /\ (CARD s = CARD t) /\ (IMAGE f s) SUBSET t
9480 ==> ((!y. y IN t ==> ?x. x IN s /\ (f x = y)) <=>
9481 (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)))
9482Proof
9483 REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL
9484 [ASM_CASES_TAC ``x:'a = y`` THENL [ASM_REWRITE_TAC[],
9485 SUBGOAL_THEN ``CARD s <= CARD (IMAGE (f:'a->'b) (s DELETE y))`` MP_TAC THENL
9486 [ASM_REWRITE_TAC[] THEN KNOW_TAC ``(!(s :'b -> bool).
9487 FINITE s ==> !(t :'b -> bool). t SUBSET s ==> CARD t <= CARD s)``
9488 THENL [METIS_TAC [CARD_SUBSET], DISCH_TAC THEN
9489 POP_ASSUM (MP_TAC o Q.SPEC `IMAGE (f:'a->'b) ((s:'a->bool) DELETE y)`) THEN
9490 KNOW_TAC ``FINITE (IMAGE (f :'a -> 'b) ((s :'a -> bool) DELETE (y :'a)))``
9491 THENL [FULL_SIMP_TAC std_ss [IMAGE_FINITE, FINITE_DELETE], DISCH_TAC
9492 THEN FULL_SIMP_TAC std_ss [] THEN DISCH_TAC THEN POP_ASSUM (MP_TAC o Q.SPEC `t:'b->bool`)
9493 THEN KNOW_TAC ``(t :'b -> bool) SUBSET IMAGE (f :'a -> 'b) ((s :'a -> bool) DELETE (y :'a))``
9494 THENL [REWRITE_TAC[SUBSET_DEF, IN_IMAGE, IN_DELETE] THEN ASM_MESON_TAC[], ASM_MESON_TAC[]]]],
9495 FULL_SIMP_TAC std_ss [] THEN REWRITE_TAC[NOT_LESS_EQUAL] THEN
9496 MATCH_MP_TAC LESS_EQ_LESS_TRANS THEN EXISTS_TAC ``CARD(s DELETE (y:'a))`` THEN
9497 CONJ_TAC THENL [ASM_SIMP_TAC std_ss [CARD_IMAGE_LE, FINITE_DELETE],
9498 KNOW_TAC ``!x. x - 1 < x:num <=> ~(x = 0)`` THENL [ARITH_TAC, DISCH_TAC
9499 THEN ASM_SIMP_TAC std_ss [CARD_DELETE] THEN
9500 ASM_MESON_TAC[CARD_EQ_0, MEMBER_NOT_EMPTY]]]]],
9501 SUBGOAL_THEN ``IMAGE (f:'a->'b) s = t`` MP_TAC THENL
9502 [ALL_TAC, ASM_MESON_TAC[EXTENSION, IN_IMAGE]] THEN
9503 METIS_TAC [CARD_IMAGE_INJ, SUBSET_EQ_CARD, IMAGE_FINITE]]
9504QED
9505
9506Theorem SURJECTIVE_IFF_INJECTIVE :
9507 !s f:'a->'a. FINITE s /\ (IMAGE f s) SUBSET s
9508 ==> ((!y. y IN s ==> ?x. x IN s /\ (f x = y)) <=>
9509 (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)))
9510Proof
9511 SIMP_TAC std_ss [SURJECTIVE_IFF_INJECTIVE_GEN]
9512QED
9513
9514(*---------------------------------------------------------------------------*)
9515
9516Theorem FUNPOW_INJ:
9517 INJ f UNIV UNIV ==> INJ (FUNPOW f n) UNIV UNIV
9518Proof
9519 Induct_on ‘n’>>rw[]>>
9520 fs[FUNPOW_SUC,INJ_DEF]
9521QED
9522
9523Theorem FUNPOW_eq_elim:
9524 INJ f UNIV UNIV ==>
9525 (FUNPOW f n t = FUNPOW f n t' <=> t = t')
9526Proof
9527 Induct_on ‘n’>>rw[EQ_IMP_THM]>>
9528 fs[FUNPOW_SUC,INJ_DEF]
9529QED
9530
9531Theorem FUNPOW_min_cancel:
9532 (n <= n' /\ INJ f UNIV UNIV) ==>
9533 (FUNPOW f n X = FUNPOW f n' X' <=>
9534 X = FUNPOW f (n' - n) X')
9535Proof
9536 Induct_on ‘n'-n’>>rw[FUNPOW_SUC,EQ_IMP_THM]>>
9537 IMP_RES_TAC FUNPOW_INJ>>
9538 ‘FUNPOW f n' X' = FUNPOW f n (FUNPOW f (n' - n) X')’
9539 by simp[GSYM FUNPOW_ADD]>>fs[]>>
9540 FIRST_ASSUM $ Q.SPEC_THEN ‘n’ ASSUME_TAC>>
9541 IMP_RES_TAC (iffLR FUNPOW_eq_elim)
9542QED
9543
9544(* ------------------------------------------------------------------------- *)
9545(* Segment of natural numbers starting at a specific number. *)
9546(* ------------------------------------------------------------------------- *)
9547
9548Definition from_def :
9549 from n = {m:num | n <= m}
9550End
9551
9552Theorem FROM_0 :
9553 from 0 = univ(:num)
9554Proof
9555 REWRITE_TAC [from_def, ZERO_LESS_EQ, GSPEC_T]
9556QED
9557
9558Theorem IN_FROM :
9559 !m n. m IN from n <=> n <= m
9560Proof
9561 SIMP_TAC std_ss [from_def, GSPECIFICATION]
9562QED
9563
9564Theorem DISJOINT_COUNT_FROM :
9565 !n. DISJOINT (count n) (from n)
9566Proof
9567 RW_TAC arith_ss [from_def, count_def, DISJOINT_DEF, Once EXTENSION,
9568 NOT_IN_EMPTY, GSPECIFICATION, IN_INTER]
9569QED
9570
9571Theorem DISJOINT_FROM_COUNT :
9572 !n. DISJOINT (from n) (count n)
9573Proof
9574 RW_TAC std_ss [Once DISJOINT_SYM, DISJOINT_COUNT_FROM]
9575QED
9576
9577Theorem UNION_COUNT_FROM :
9578 !n. (count n) UNION (from n) = UNIV
9579Proof
9580 RW_TAC arith_ss [from_def, count_def, Once EXTENSION, NOT_IN_EMPTY,
9581 GSPECIFICATION, IN_UNION, IN_UNIV]
9582QED
9583
9584Theorem UNION_FROM_COUNT :
9585 !n. (from n) UNION (count n) = UNIV
9586Proof
9587 RW_TAC std_ss [Once UNION_COMM, UNION_COUNT_FROM]
9588QED
9589
9590Theorem FROM_NOT_EMPTY :
9591 !n. from n <> {}
9592Proof
9593 RW_TAC std_ss [GSYM MEMBER_NOT_EMPTY, from_def, GSPECIFICATION]
9594 >> Q.EXISTS_TAC `n` >> REWRITE_TAC [LESS_EQ_REFL]
9595QED
9596
9597Theorem COUNTABLE_FROM :
9598 !n. COUNTABLE (from n)
9599Proof
9600 PROVE_TAC [COUNTABLE_NUM]
9601QED
9602
9603(* END *)