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